Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM75
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM75	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM75	(revision 286)
@@ -0,0 +1,501 @@
+DENSITY AND THICKNESS DATA OF THE ATMOSPHERE AT AN ZENITH ANGLE OF 75.0 DEGREES
+ 0.000000000E+00 3.942178358E+03 1.229805824E-03 3.942178358E+03 0.000000000E+00
+ 1.538785467E+04 3.923210341E+03 1.224888913E-03 3.926593032E+03 1.265841161E+04
+ 3.077570935E+04 3.904464325E+03 1.219991235E-03 3.911007706E+03 2.542251648E+04
+ 4.616356402E+04 3.885714529E+03 1.215112717E-03 3.895422380E+03 3.821958731E+04
+ 6.155141870E+04 3.867039768E+03 1.210253284E-03 3.879837054E+03 5.100302998E+04
+ 7.693927337E+04 3.848507569E+03 1.205412865E-03 3.864251728E+03 6.388464095E+04
+ 9.232712805E+04 3.829821910E+03 1.200591386E-03 3.848666402E+03 7.680906445E+04
+ 1.077149827E+05 3.811529649E+03 1.195788775E-03 3.833081076E+03 8.972023553E+04
+ 1.231028374E+05 3.793151139E+03 1.191004961E-03 3.817495749E+03 1.027313362E+05
+ 1.384906921E+05 3.774753215E+03 1.186239870E-03 3.801910423E+03 1.157856577E+05
+ 1.538785467E+05 3.756682287E+03 1.181493432E-03 3.786325097E+03 1.288272313E+05
+ 1.692664014E+05 3.738525754E+03 1.176765576E-03 3.770739771E+03 1.419695436E+05
+ 1.846542561E+05 3.720438949E+03 1.172056229E-03 3.755154445E+03 1.551563877E+05
+ 2.000421108E+05 3.702135641E+03 1.167365322E-03 3.739569119E+03 1.683311457E+05
+ 2.154299654E+05 3.684389355E+03 1.162692784E-03 3.723983793E+03 1.816675781E+05
+ 2.308178201E+05 3.666679410E+03 1.158038544E-03 3.708398467E+03 1.949321334E+05
+ 2.462056748E+05 3.648880533E+03 1.153402533E-03 3.692813141E+03 2.083002206E+05
+ 2.615935295E+05 3.631152140E+03 1.148784681E-03 3.677227815E+03 2.217143283E+05
+ 2.769813841E+05 3.613563077E+03 1.144184918E-03 3.661642488E+03 2.350377547E+05
+ 2.923692388E+05 3.595815425E+03 1.139603175E-03 3.646057162E+03 2.486829449E+05
+ 3.077570935E+05 3.578459230E+03 1.135039384E-03 3.630471836E+03 2.621785199E+05
+ 3.231449482E+05 3.560945238E+03 1.130493475E-03 3.614886510E+03 2.757800916E+05
+ 3.385328028E+05 3.543686035E+03 1.125965380E-03 3.599301184E+03 2.894295516E+05
+ 3.539206575E+05 3.526378398E+03 1.121455030E-03 3.583715858E+03 3.029038133E+05
+ 3.693085122E+05 3.509139991E+03 1.116962359E-03 3.568130532E+03 3.168728909E+05
+ 3.846963669E+05 3.491682016E+03 1.112487298E-03 3.552545206E+03 3.306118606E+05
+ 4.000842215E+05 3.474777327E+03 1.108029780E-03 3.536959880E+03 3.444956402E+05
+ 4.154720762E+05 3.457906381E+03 1.103589737E-03 3.521374554E+03 3.583888538E+05
+ 4.308599309E+05 3.440942014E+03 1.099167103E-03 3.505789228E+03 3.721900770E+05
+ 4.462477856E+05 3.424045536E+03 1.094761811E-03 3.490203901E+03 3.863252366E+05
+ 4.616356402E+05 3.407285110E+03 1.090373795E-03 3.474618575E+03 4.002257412E+05
+ 4.770234949E+05 3.390363128E+03 1.086002988E-03 3.459033249E+03 4.144643438E+05
+ 4.924113496E+05 3.373831501E+03 1.081649324E-03 3.443447923E+03 4.285491357E+05
+ 5.077992043E+05 3.357203722E+03 1.077312738E-03 3.427862597E+03 4.428079747E+05
+ 5.231870589E+05 3.340642515E+03 1.072993165E-03 3.412277271E+03 4.569121874E+05
+ 5.385749136E+05 3.324215724E+03 1.068690538E-03 3.396691945E+03 4.713599259E+05
+ 5.539627683E+05 3.307786594E+03 1.064404794E-03 3.381106619E+03 4.856528115E+05
+ 5.693506230E+05 3.291423955E+03 1.060135867E-03 3.365521293E+03 5.001255770E+05
+ 5.847384776E+05 3.275194533E+03 1.055883693E-03 3.349935967E+03 5.144398820E+05
+ 6.001263323E+05 3.258801489E+03 1.051648208E-03 3.334350640E+03 5.291032397E+05
+ 6.155141870E+05 3.242794058E+03 1.047429348E-03 3.318765314E+03 5.435253405E+05
+ 6.309020417E+05 3.226691119E+03 1.043227049E-03 3.303179988E+03 5.582984384E+05
+ 6.462898963E+05 3.210664023E+03 1.039041247E-03 3.287594662E+03 5.729793547E+05
+ 6.616777510E+05 3.194757973E+03 1.034871879E-03 3.272009336E+03 5.877153254E+05
+ 6.770656057E+05 3.178847591E+03 1.030718883E-03 3.256424010E+03 6.025075439E+05
+ 6.924534604E+05 3.163000836E+03 1.026582194E-03 3.240838684E+03 6.173561525E+05
+ 7.078413150E+05 3.146929324E+03 1.022461752E-03 3.225253358E+03 6.323262924E+05
+ 7.232291697E+05 3.131405841E+03 1.018357493E-03 3.209668032E+03 6.471473472E+05
+ 7.386170244E+05 3.115909264E+03 1.014269356E-03 3.194082706E+03 6.623212479E+05
+ 7.540048791E+05 3.100314978E+03 1.010197278E-03 3.178497380E+03 6.774006757E+05
+ 7.693927337E+05 3.084783086E+03 1.006141198E-03 3.162912053E+03 6.925387456E+05
+ 7.847805884E+05 3.069381448E+03 1.002101054E-03 3.147326727E+03 7.074575539E+05
+ 8.001684431E+05 3.053976365E+03 9.980767857E-04 3.131741401E+03 7.229040969E+05
+ 8.155562978E+05 3.038630280E+03 9.940683317E-04 3.116156075E+03 7.383771319E+05
+ 8.309441524E+05 3.023414182E+03 9.900756313E-04 3.100570749E+03 7.537552695E+05
+ 8.463320071E+05 3.008030425E+03 9.860986241E-04 3.084985423E+03 7.691944667E+05
+ 8.617198618E+05 2.993028093E+03 9.821372497E-04 3.069400097E+03 7.847622462E+05
+ 8.771077165E+05 2.977638426E+03 9.781914482E-04 3.053814771E+03 8.003280278E+05
+ 8.924955711E+05 2.962793486E+03 9.742611596E-04 3.038229445E+03 8.159537739E+05
+ 9.078834258E+05 2.947973387E+03 9.703463245E-04 3.022644119E+03 8.317106462E+05
+ 9.232712805E+05 2.933052529E+03 9.664468834E-04 3.007058792E+03 8.474632175E+05
+ 9.386591352E+05 2.918191559E+03 9.625627773E-04 2.991473466E+03 8.632800959E+05
+ 9.540469898E+05 2.903435950E+03 9.586939471E-04 2.975888140E+03 8.792309271E+05
+ 9.694348445E+05 2.888693852E+03 9.548403343E-04 2.960302814E+03 8.951778435E+05
+ 9.848226992E+05 2.874079144E+03 9.510018802E-04 2.944717488E+03 9.110965994E+05
+ 1.000210554E+06 2.859454805E+03 9.471785267E-04 2.929132162E+03 9.273391892E+05
+ 1.015598409E+06 2.844889190E+03 9.433702157E-04 2.913546836E+03 9.434322577E+05
+ 1.030986263E+06 2.830451055E+03 9.395768893E-04 2.897961510E+03 9.597461194E+05
+ 1.046374118E+06 2.815841745E+03 9.357984900E-04 2.882376184E+03 9.760982159E+05
+ 1.061761973E+06 2.801610827E+03 9.320349604E-04 2.866790858E+03 9.924352215E+05
+ 1.077149827E+06 2.786989206E+03 9.282862433E-04 2.851205532E+03 1.008772479E+06
+ 1.092537682E+06 2.773001839E+03 9.245522817E-04 2.835620205E+03 1.025429717E+06
+ 1.107925537E+06 2.758853845E+03 9.208330189E-04 2.820034879E+03 1.042061219E+06
+ 1.123313391E+06 2.744692251E+03 9.171283984E-04 2.804449553E+03 1.058388057E+06
+ 1.138701246E+06 2.730494905E+03 9.134383637E-04 2.788864227E+03 1.075467314E+06
+ 1.154089101E+06 2.716607498E+03 9.097628589E-04 2.773278901E+03 1.092242619E+06
+ 1.169476955E+06 2.702616261E+03 9.061018279E-04 2.757693575E+03 1.109166075E+06
+ 1.184864810E+06 2.688680599E+03 9.024552151E-04 2.742108249E+03 1.126160854E+06
+ 1.200252665E+06 2.674868872E+03 8.988229651E-04 2.726522923E+03 1.143230672E+06
+ 1.215640519E+06 2.661044794E+03 8.952050225E-04 2.710937597E+03 1.160301383E+06
+ 1.231028374E+06 2.647276202E+03 8.916013323E-04 2.695352271E+03 1.177522615E+06
+ 1.246416229E+06 2.633642490E+03 8.880118396E-04 2.679766944E+03 1.194644012E+06
+ 1.261804083E+06 2.619983915E+03 8.844364897E-04 2.664181618E+03 1.212119688E+06
+ 1.277191938E+06 2.606380276E+03 8.808752283E-04 2.648596292E+03 1.229571934E+06
+ 1.292579793E+06 2.592899889E+03 8.773280010E-04 2.633010966E+03 1.247115771E+06
+ 1.307967647E+06 2.579244910E+03 8.737947538E-04 2.617425640E+03 1.264726588E+06
+ 1.323355502E+06 2.565965273E+03 8.702754329E-04 2.601840314E+03 1.282341090E+06
+ 1.338743357E+06 2.552290683E+03 8.667699846E-04 2.586254988E+03 1.300112505E+06
+ 1.354131211E+06 2.539154127E+03 8.632783555E-04 2.570669662E+03 1.317966418E+06
+ 1.369519066E+06 2.526035187E+03 8.598004924E-04 2.555084336E+03 1.335720408E+06
+ 1.384906921E+06 2.512520952E+03 8.563363422E-04 2.539499010E+03 1.353843480E+06
+ 1.400294775E+06 2.499547053E+03 8.528858521E-04 2.523913684E+03 1.371945974E+06
+ 1.415682630E+06 2.486587691E+03 8.494489695E-04 2.508328357E+03 1.390133123E+06
+ 1.431070485E+06 2.473231845E+03 8.460256419E-04 2.492743031E+03 1.408409080E+06
+ 1.446458339E+06 2.460506212E+03 8.426158170E-04 2.477157705E+03 1.426768242E+06
+ 1.461846194E+06 2.447611700E+03 8.392194429E-04 2.461572379E+03 1.445214774E+06
+ 1.477234049E+06 2.434413084E+03 8.358364677E-04 2.445987053E+03 1.463749200E+06
+ 1.492621903E+06 2.421751114E+03 8.324668397E-04 2.430401727E+03 1.482373298E+06
+ 1.508009758E+06 2.409105020E+03 8.291105074E-04 2.414816401E+03 1.501086375E+06
+ 1.523397613E+06 2.396060711E+03 8.257674197E-04 2.399231075E+03 1.519890238E+06
+ 1.538785467E+06 2.383645749E+03 8.224375253E-04 2.383645749E+03 1.538785467E+06
+ 1.561621862E+06 2.364607238E+03 8.211630008E-04 2.369952887E+03 1.555191418E+06
+ 1.584458257E+06 2.346052404E+03 8.156058225E-04 2.356260024E+03 1.571691972E+06
+ 1.607294652E+06 2.327632771E+03 8.100855488E-04 2.342567162E+03 1.588683501E+06
+ 1.630131047E+06 2.308967731E+03 8.046019396E-04 2.328874300E+03 1.605344490E+06
+ 1.652967442E+06 2.290457238E+03 7.991547561E-04 2.315181438E+03 1.622508330E+06
+ 1.675803837E+06 2.272387077E+03 7.937437612E-04 2.301488576E+03 1.639333289E+06
+ 1.698640232E+06 2.254452989E+03 7.883687193E-04 2.287795714E+03 1.656265107E+06
+ 1.721476627E+06 2.236300538E+03 7.830293962E-04 2.274102852E+03 1.673667441E+06
+ 1.744313022E+06 2.218604600E+03 7.777255593E-04 2.260409990E+03 1.691186004E+06
+ 1.767149417E+06 2.201037916E+03 7.724569773E-04 2.246717128E+03 1.708349740E+06
+ 1.789985812E+06 2.183241993E+03 7.672234206E-04 2.233024266E+03 1.725617941E+06
+ 1.812822207E+06 2.165915471E+03 7.620246610E-04 2.219331404E+03 1.743389713E+06
+ 1.835658602E+06 2.148709349E+03 7.568604716E-04 2.205638541E+03 1.761275632E+06
+ 1.858494997E+06 2.131262097E+03 7.517306272E-04 2.191945679E+03 1.778793849E+06
+ 1.881331392E+06 2.114284443E+03 7.466349039E-04 2.178252817E+03 1.796421383E+06
+ 1.904167787E+06 2.097431239E+03 7.415730792E-04 2.164559955E+03 1.814579464E+06
+ 1.927004182E+06 2.080326494E+03 7.365449320E-04 2.150867093E+03 1.832847211E+06
+ 1.949840577E+06 2.063366292E+03 7.315502428E-04 2.137174231E+03 1.850735921E+06
+ 1.972676972E+06 2.046831368E+03 7.265887932E-04 2.123481369E+03 1.868739152E+06
+ 1.995513367E+06 2.030422076E+03 7.216603665E-04 2.109788507E+03 1.887280984E+06
+ 2.018349762E+06 2.013789745E+03 7.167647472E-04 2.096095645E+03 1.905944238E+06
+ 2.041186157E+06 1.997598190E+03 7.119017213E-04 2.082402783E+03 1.924222193E+06
+ 2.064022552E+06 1.981525605E+03 7.070710760E-04 2.068709921E+03 1.942620271E+06
+ 2.086858947E+06 1.965220260E+03 7.022725999E-04 2.055017058E+03 1.961571051E+06
+ 2.109695342E+06 1.949389670E+03 6.975060832E-04 2.041324196E+03 1.980645524E+06
+ 2.132531737E+06 1.933649022E+03 6.927713170E-04 2.027631334E+03 1.999332047E+06
+ 2.155368132E+06 1.917660874E+03 6.880680942E-04 2.013938472E+03 2.018144726E+06
+ 2.178204527E+06 1.902129057E+03 6.833962086E-04 2.000245610E+03 2.037517365E+06
+ 2.201040922E+06 1.886711795E+03 6.787554557E-04 1.986552748E+03 2.057019559E+06
+ 2.223877317E+06 1.871037774E+03 6.741456320E-04 1.972859886E+03 2.076135881E+06
+ 2.246713712E+06 1.855826445E+03 6.695665355E-04 1.959167024E+03 2.095392743E+06
+ 2.269550107E+06 1.840726191E+03 6.650179654E-04 1.945474162E+03 2.115238327E+06
+ 2.292386502E+06 1.825359913E+03 6.604997222E-04 1.931781300E+03 2.135189739E+06
+ 2.315222897E+06 1.810127074E+03 6.560116077E-04 1.918088438E+03 2.154754963E+06
+ 2.338059292E+06 1.795308883E+03 6.515534249E-04 1.904395575E+03 2.174936838E+06
+ 2.360895687E+06 1.780605768E+03 6.471249782E-04 1.890702713E+03 2.194737454E+06
+ 2.383732082E+06 1.765667273E+03 6.427260731E-04 1.877009851E+03 2.215153843E+06
+ 2.406568477E+06 1.751165635E+03 6.383565163E-04 1.863316989E+03 2.235196367E+06
+ 2.429404872E+06 1.736765277E+03 6.340161161E-04 1.849624127E+03 2.255855479E+06
+ 2.452241266E+06 1.722119973E+03 6.297046816E-04 1.835931265E+03 2.276655563E+06
+ 2.475077661E+06 1.707910422E+03 6.254220233E-04 1.822238403E+03 2.297048904E+06
+ 2.497914056E+06 1.693806302E+03 6.211679529E-04 1.808545541E+03 2.317603990E+06
+ 2.520750451E+06 1.679449151E+03 6.169422834E-04 1.794852679E+03 2.338749881E+06
+ 2.543586846E+06 1.665533242E+03 6.127448289E-04 1.781159817E+03 2.360052393E+06
+ 2.566423241E+06 1.651719501E+03 6.085754047E-04 1.767466954E+03 2.380970736E+06
+ 2.589259636E+06 1.637644643E+03 6.044338272E-04 1.753774092E+03 2.402544310E+06
+ 2.612096031E+06 1.624013852E+03 6.003199141E-04 1.740081230E+03 2.424260968E+06
+ 2.634932426E+06 1.610484565E+03 5.962334843E-04 1.726388368E+03 2.445565637E+06
+ 2.657768821E+06 1.596686573E+03 5.921743577E-04 1.712695506E+03 2.467552275E+06
+ 2.680605216E+06 1.583012015E+03 5.881423556E-04 1.699002644E+03 2.489696316E+06
+ 2.703441611E+06 1.569846504E+03 5.841373001E-04 1.685309782E+03 2.511405150E+06
+ 2.726278006E+06 1.556680126E+03 5.801590148E-04 1.671616920E+03 2.533299482E+06
+ 2.749114401E+06 1.543255990E+03 5.762073243E-04 1.657924058E+03 2.555838662E+06
+ 2.771950796E+06 1.530263827E+03 5.722820541E-04 1.644231196E+03 2.578548728E+06
+ 2.794787191E+06 1.517368729E+03 5.683830311E-04 1.630538334E+03 2.600864028E+06
+ 2.817623586E+06 1.504208917E+03 5.645100833E-04 1.616845471E+03 2.623868745E+06
+ 2.840459981E+06 1.491485772E+03 5.606630396E-04 1.603152609E+03 2.647042804E+06
+ 2.863296376E+06 1.478856574E+03 5.568417303E-04 1.589459747E+03 2.669808209E+06
+ 2.886132771E+06 1.465955710E+03 5.530459865E-04 1.575766885E+03 2.693488516E+06
+ 2.908969166E+06 1.453493509E+03 5.492756405E-04 1.562074023E+03 2.717157434E+06
+ 2.931805561E+06 1.441124757E+03 5.455305257E-04 1.548381161E+03 2.740372467E+06
+ 2.954641956E+06 1.428477891E+03 5.418104765E-04 1.534688299E+03 2.764359834E+06
+ 2.977478351E+06 1.416279766E+03 5.381153285E-04 1.520995437E+03 2.788528401E+06
+ 3.000314746E+06 1.404166646E+03 5.344449183E-04 1.507302575E+03 2.812237272E+06
+ 3.023151141E+06 1.391767968E+03 5.307990834E-04 1.493609713E+03 2.836740127E+06
+ 3.045987536E+06 1.379483888E+03 5.271776625E-04 1.479916851E+03 2.861428367E+06
+ 3.068823931E+06 1.367593103E+03 5.235804954E-04 1.466223988E+03 2.885655845E+06
+ 3.091660326E+06 1.355797216E+03 5.200074227E-04 1.452531126E+03 2.910690315E+06
+ 3.114496721E+06 1.343755691E+03 5.164582862E-04 1.438838264E+03 2.935919452E+06
+ 3.137333116E+06 1.332111229E+03 5.129329287E-04 1.425145402E+03 2.960692944E+06
+ 3.160169511E+06 1.320558753E+03 5.094311940E-04 1.411452540E+03 2.986296372E+06
+ 3.183005906E+06 1.308749312E+03 5.059529268E-04 1.397759678E+03 3.012090179E+06
+ 3.205842301E+06 1.297349244E+03 5.024979730E-04 1.384066816E+03 3.037437653E+06
+ 3.228678696E+06 1.286035163E+03 4.990661793E-04 1.370373954E+03 3.063610115E+06
+ 3.251515091E+06 1.274458851E+03 4.956573935E-04 1.356681092E+03 3.089992817E+06
+ 3.274351486E+06 1.263322329E+03 4.922714643E-04 1.342988230E+03 3.115958436E+06
+ 3.297187881E+06 1.252243651E+03 4.889082415E-04 1.329295368E+03 3.143405561E+06
+ 3.320024276E+06 1.240892493E+03 4.855675758E-04 1.315602505E+03 3.169728764E+06
+ 3.342860671E+06 1.229959841E+03 4.822493187E-04 1.301909643E+03 3.196950842E+06
+ 3.365697066E+06 1.219109977E+03 4.789533230E-04 1.288216781E+03 3.224397957E+06
+ 3.388533460E+06 1.207982878E+03 4.756794421E-04 1.274523919E+03 3.251386156E+06
+ 3.411369855E+06 1.197277322E+03 4.724275306E-04 1.260831057E+03 3.279318628E+06
+ 3.434206250E+06 1.186651707E+03 4.691974439E-04 1.247138195E+03 3.307433528E+06
+ 3.457042645E+06 1.175744117E+03 4.659890383E-04 1.233445333E+03 3.335788213E+06
+ 3.479879040E+06 1.165258405E+03 4.628021712E-04 1.219752471E+03 3.364384791E+06
+ 3.502715435E+06 1.154852391E+03 4.596367008E-04 1.206059609E+03 3.392501801E+06
+ 3.525551830E+06 1.144160173E+03 4.564924862E-04 1.192366747E+03 3.421569568E+06
+ 3.548388225E+06 1.133898103E+03 4.533693874E-04 1.178673884E+03 3.450888219E+06
+ 3.571224620E+06 1.123707649E+03 4.502672653E-04 1.164981022E+03 3.480465665E+06
+ 3.594061015E+06 1.113225778E+03 4.471859819E-04 1.151288160E+03 3.510304514E+06
+ 3.616897410E+06 1.103169340E+03 4.441253998E-04 1.137595298E+03 3.539690202E+06
+ 3.639733805E+06 1.093189626E+03 4.410853827E-04 1.123902436E+03 3.570802247E+06
+ 3.662570200E+06 1.082914793E+03 4.380657949E-04 1.110209574E+03 3.600671787E+06
+ 3.685406595E+06 1.073067657E+03 4.350665020E-04 1.096516712E+03 3.631580423E+06
+ 3.708242990E+06 1.063294465E+03 4.320873701E-04 1.082823850E+03 3.662773283E+06
+ 3.731079385E+06 1.053222471E+03 4.291282664E-04 1.069130988E+03 3.694259751E+06
+ 3.753915780E+06 1.043577639E+03 4.261890587E-04 1.055438126E+03 3.726037314E+06
+ 3.776752175E+06 1.034006664E+03 4.232696159E-04 1.041745264E+03 3.758115677E+06
+ 3.799588570E+06 1.024133719E+03 4.203698077E-04 1.028052401E+03 3.790498618E+06
+ 3.822424965E+06 1.014359539E+03 4.174895046E-04 1.014359539E+03 3.822424965E+06
+ 3.932558984E+06 9.684817897E+02 4.070689815E-04 1.004322897E+03 3.846088983E+06
+ 4.042693003E+06 9.246635357E+02 3.888389263E-04 9.942862546E+02 3.870000823E+06
+ 4.152827022E+06 8.828079775E+02 3.714149589E-04 9.842496123E+02 3.894139970E+06
+ 4.262961040E+06 8.428233401E+02 3.547619065E-04 9.742129699E+02 3.918523662E+06
+ 4.373095059E+06 8.046371459E+02 3.388461097E-04 9.641763275E+02 3.943156910E+06
+ 4.483229078E+06 7.681592491E+02 3.236353584E-04 9.541396852E+02 3.968059491E+06
+ 4.593363097E+06 7.333229790E+02 3.090988305E-04 9.441030428E+02 3.993208299E+06
+ 4.703497116E+06 7.000534971E+02 2.952070328E-04 9.340664004E+02 4.018636656E+06
+ 4.813631135E+06 6.682742380E+02 2.819317444E-04 9.240297580E+02 4.044323152E+06
+ 4.923765153E+06 6.379299107E+02 2.692459631E-04 9.139931157E+02 4.070286941E+06
+ 5.033899172E+06 6.089513077E+02 2.571238528E-04 9.039564733E+02 4.096534087E+06
+ 5.144033191E+06 5.812779477E+02 2.455406945E-04 8.939198309E+02 4.123086192E+06
+ 5.254167210E+06 5.548462471E+02 2.344728384E-04 8.838831886E+02 4.149934439E+06
+ 5.364301229E+06 5.296058817E+02 2.238976582E-04 8.738465462E+02 4.177071814E+06
+ 5.474435248E+06 5.055097447E+02 2.137935077E-04 8.638099038E+02 4.204519089E+06
+ 5.584569266E+06 4.825012936E+02 2.041396790E-04 8.537732614E+02 4.232283441E+06
+ 5.694703285E+06 4.605329604E+02 1.949163619E-04 8.437366191E+02 4.260388655E+06
+ 5.804837304E+06 4.395513537E+02 1.861046062E-04 8.336999767E+02 4.288754266E+06
+ 5.914971323E+06 4.195237707E+02 1.776862843E-04 8.236633343E+02 4.317589249E+06
+ 6.025105342E+06 4.003968837E+02 1.696440565E-04 8.136266919E+02 4.346701036E+06
+ 6.135239361E+06 3.821413184E+02 1.619613369E-04 8.035900496E+02 4.376186530E+06
+ 6.245373379E+06 3.647129441E+02 1.546222613E-04 7.935534072E+02 4.406022589E+06
+ 6.355507398E+06 3.480743359E+02 1.476116559E-04 7.835167648E+02 4.436250782E+06
+ 6.465641417E+06 3.321850528E+02 1.409150082E-04 7.734801225E+02 4.466848335E+06
+ 6.575775436E+06 3.170220097E+02 1.345184382E-04 7.634434801E+02 4.497841003E+06
+ 6.685909455E+06 3.025418879E+02 1.284086712E-04 7.534068377E+02 4.529248950E+06
+ 6.796043474E+06 2.887278196E+02 1.225730122E-04 7.433701953E+02 4.561085008E+06
+ 6.906177492E+06 2.755392716E+02 1.169993203E-04 7.333335530E+02 4.593328897E+06
+ 7.016311511E+06 2.629503905E+02 1.116759854E-04 7.232969106E+02 4.626030365E+06
+ 7.126445530E+06 2.509292595E+02 1.065919050E-04 7.132602682E+02 4.659166307E+06
+ 7.236579549E+06 2.394606379E+02 1.017364625E-04 7.032236259E+02 4.692785323E+06
+ 7.346713568E+06 2.285090506E+02 9.709950618E-05 6.931869835E+02 4.726864401E+06
+ 7.456847587E+06 2.180637080E+02 9.267132893E-05 6.831503411E+02 4.761454258E+06
+ 7.566981605E+06 2.080917088E+02 8.844264935E-05 6.731136987E+02 4.796532074E+06
+ 7.677115624E+06 1.985764635E+02 8.440459319E-05 6.630770564E+02 4.832151160E+06
+ 7.787249643E+06 1.894958292E+02 8.054867573E-05 6.530404140E+02 4.868288407E+06
+ 7.897383662E+06 1.808246173E+02 7.686678494E-05 6.430037716E+02 4.904999870E+06
+ 8.007517681E+06 1.725552196E+02 7.335116534E-05 6.329671293E+02 4.942262965E+06
+ 8.117651700E+06 1.646643557E+02 6.999440253E-05 6.229304869E+02 4.980136718E+06
+ 8.227785718E+06 1.571344850E+02 6.678940840E-05 6.128938445E+02 5.018619519E+06
+ 8.337919737E+06 1.499495442E+02 6.372940698E-05 6.028572021E+02 5.057710972E+06
+ 8.448053756E+06 1.430938218E+02 6.080792086E-05 5.928205598E+02 5.097451560E+06
+ 8.558187775E+06 1.365480410E+02 5.801875824E-05 5.827839174E+02 5.137888138E+06
+ 8.668321794E+06 1.303068785E+02 5.535600048E-05 5.727472750E+02 5.179019447E+06
+ 8.778455813E+06 1.243522668E+02 5.281399023E-05 5.627106326E+02 5.220848180E+06
+ 8.888589831E+06 1.186711342E+02 5.038732007E-05 5.526739903E+02 5.263446398E+06
+ 8.998723850E+06 1.132455995E+02 4.807082158E-05 5.426373479E+02 5.306817993E+06
+ 9.108857869E+06 1.080750989E+02 4.585955494E-05 5.326007055E+02 5.350967856E+06
+ 9.218991888E+06 1.031422803E+02 4.374879896E-05 5.225640632E+02 5.395975072E+06
+ 9.329125907E+06 9.839968061E+01 4.173404152E-05 5.125274208E+02 5.441847003E+06
+ 9.439259926E+06 9.394762757E+01 3.981097046E-05 5.024907784E+02 5.488592463E+06
+ 9.549393944E+06 8.966391875E+01 3.797546481E-05 4.924541360E+02 5.536299183E+06
+ 9.659527963E+06 8.557932599E+01 3.622358644E-05 4.824174937E+02 5.584979640E+06
+ 9.769661982E+06 8.168324100E+01 3.455157209E-05 4.723808513E+02 5.634646947E+06
+ 9.879796001E+06 7.796698271E+01 3.295582562E-05 4.623442089E+02 5.685432591E+06
+ 9.989930020E+06 7.442260608E+01 3.143291079E-05 4.523075666E+02 5.737263257E+06
+ 1.010006404E+07 7.104183093E+01 2.997954419E-05 4.422709242E+02 5.790275332E+06
+ 1.021019806E+07 6.781187172E+01 2.859258853E-05 4.322342818E+02 5.844494381E+06
+ 1.032033208E+07 6.473670760E+01 2.726904625E-05 4.221976394E+02 5.899946241E+06
+ 1.043046610E+07 6.180386061E+01 2.600605336E-05 4.121609971E+02 5.956784262E+06
+ 1.054060011E+07 5.900781095E+01 2.480087358E-05 4.021243547E+02 6.014949384E+06
+ 1.065073413E+07 5.634043090E+01 2.365089271E-05 3.920877123E+02 6.074605264E+06
+ 1.076086815E+07 5.379677917E+01 2.255361328E-05 3.820510700E+02 6.135796353E+06
+ 1.087100217E+07 5.137109653E+01 2.150664935E-05 3.720144276E+02 6.198605828E+06
+ 1.098113619E+07 4.905823016E+01 2.050772167E-05 3.619777852E+02 6.263119172E+06
+ 1.109127021E+07 4.685257344E+01 1.955465291E-05 3.519411428E+02 6.329433687E+06
+ 1.120140423E+07 4.474945292E+01 1.864536319E-05 3.419045005E+02 6.397653352E+06
+ 1.131153825E+07 4.274407047E+01 1.777786580E-05 3.318678581E+02 6.467929907E+06
+ 1.142167226E+07 4.083347182E+01 1.695026303E-05 3.218312157E+02 6.540272901E+06
+ 1.153180628E+07 3.900873747E+01 1.616074225E-05 3.117945733E+02 6.614973564E+06
+ 1.164194030E+07 3.727051873E+01 1.540757219E-05 3.017579310E+02 6.692018115E+06
+ 1.175207432E+07 3.561332221E+01 1.468909927E-05 2.917212886E+02 6.771763077E+06
+ 1.186220834E+07 3.403332584E+01 1.400374421E-05 2.816846462E+02 6.854219108E+06
+ 1.197234236E+07 3.252723090E+01 1.334999870E-05 2.716480039E+02 6.939647625E+06
+ 1.208247638E+07 3.109655378E+01 1.272642228E-05 2.616113615E+02 7.028323532E+06
+ 1.219261040E+07 2.972762604E+01 1.213163932E-05 2.515747191E+02 7.120402775E+06
+ 1.230274442E+07 2.842259283E+01 1.156433611E-05 2.415380767E+02 7.216210824E+06
+ 1.241287843E+07 2.717940246E+01 1.102325818E-05 2.315014344E+02 7.316123496E+06
+ 1.252301245E+07 2.599350729E+01 1.050720756E-05 2.214647920E+02 7.420462896E+06
+ 1.263314647E+07 2.486311158E+01 1.001504038E-05 2.114281496E+02 7.529528236E+06
+ 1.274328049E+07 2.378556206E+01 9.545664373E-06 2.013915073E+02 7.643967450E+06
+ 1.285341451E+07 2.275864635E+01 9.098036615E-06 1.913548649E+02 7.764239415E+06
+ 1.296354853E+07 2.177962245E+01 8.671161323E-06 1.813182225E+02 7.890978577E+06
+ 1.307368255E+07 2.084649684E+01 8.264087742E-06 1.712815801E+02 8.024923367E+06
+ 1.318381657E+07 1.995705084E+01 7.875908143E-06 1.612449378E+02 8.167034478E+06
+ 1.329395058E+07 1.911313114E+01 7.505755896E-06 1.512082954E+02 8.318276955E+06
+ 1.340408460E+07 1.830517476E+01 7.152803636E-06 1.411716530E+02 8.479832264E+06
+ 1.351421862E+07 1.753516536E+01 6.816261504E-06 1.311350107E+02 8.653433216E+06
+ 1.362435264E+07 1.680123924E+01 6.495375470E-06 1.210983683E+02 8.840886333E+06
+ 1.373448666E+07 1.610197521E+01 6.189425729E-06 1.110617259E+02 9.044633191E+06
+ 1.384462068E+07 1.543531895E+01 5.897725166E-06 1.010250835E+02 9.267917362E+06
+ 1.395475470E+07 1.480561710E+01 5.619617892E-06 9.098844116E+01 9.514708220E+06
+ 1.406488872E+07 1.420111686E+01 5.354477841E-06 8.095179879E+01 9.791024907E+06
+ 1.417502274E+07 1.362416051E+01 5.101707431E-06 7.091515642E+01 1.010428023E+07
+ 1.428515675E+07 1.307968705E+01 4.860736286E-06 6.087851405E+01 1.046643935E+07
+ 1.439529077E+07 1.255579996E+01 4.631020015E-06 5.084187168E+01 1.089562332E+07
+ 1.450542479E+07 1.205672548E+01 4.412039036E-06 4.080522930E+01 1.142332945E+07
+ 1.461555881E+07 1.158090833E+01 4.203297468E-06 3.076858693E+01 1.210819166E+07
+ 1.472569283E+07 1.112748155E+01 4.004322058E-06 2.073194456E+01 1.308740478E+07
+ 1.483582685E+07 1.069530219E+01 3.814661162E-06 1.069530219E+01 1.483582685E+07
+ 1.503932542E+07 9.923144549E+00 3.655823457E-06 1.058839028E+01 1.486312289E+07
+ 1.524282398E+07 9.206045234E+00 3.395063050E-06 1.048147836E+01 1.489069219E+07
+ 1.544632255E+07 8.540132404E+00 3.152659086E-06 1.037456645E+01 1.491854033E+07
+ 1.564982112E+07 7.921772708E+00 2.927337014E-06 1.026765454E+01 1.494667146E+07
+ 1.585331968E+07 7.347629573E+00 2.717909510E-06 1.016074263E+01 1.497509319E+07
+ 1.605681825E+07 6.814592393E+00 2.523270598E-06 1.005383072E+01 1.500381007E+07
+ 1.626031682E+07 6.319744852E+00 2.342390159E-06 9.946918806E+00 1.503282977E+07
+ 1.646381538E+07 5.860380306E+00 2.174308807E-06 9.840006894E+00 1.506216180E+07
+ 1.666731395E+07 5.433994559E+00 2.018133106E-06 9.733094982E+00 1.509180995E+07
+ 1.687081252E+07 5.038244505E+00 1.873031104E-06 9.626183071E+00 1.512178114E+07
+ 1.707431109E+07 4.670976935E+00 1.738228160E-06 9.519271159E+00 1.515208256E+07
+ 1.727780965E+07 4.330136869E+00 1.613003064E-06 9.412359247E+00 1.518272160E+07
+ 1.748130822E+07 4.013886131E+00 1.496684395E-06 9.305447335E+00 1.521370593E+07
+ 1.768480679E+07 3.720423830E+00 1.388647145E-06 9.198535424E+00 1.524503693E+07
+ 1.788830535E+07 3.448197177E+00 1.288309551E-06 9.091623512E+00 1.527673848E+07
+ 1.809180392E+07 3.195650880E+00 1.195130148E-06 8.984711600E+00 1.530880641E+07
+ 1.829530249E+07 2.961314776E+00 1.108605021E-06 8.877799688E+00 1.534125233E+07
+ 1.849880106E+07 2.743984353E+00 1.028265236E-06 8.770887777E+00 1.537408457E+07
+ 1.870229962E+07 2.542430763E+00 9.536744488E-07 8.663975865E+00 1.540731726E+07
+ 1.890579819E+07 2.355489623E+00 8.844266728E-07 8.557063953E+00 1.544095704E+07
+ 1.910929676E+07 2.182126936E+00 8.201441969E-07 8.450152041E+00 1.547501408E+07
+ 1.931279532E+07 2.021392381E+00 7.604756451E-07 8.343240129E+00 1.550949535E+07
+ 1.951629389E+07 1.872334324E+00 7.050941665E-07 8.236328218E+00 1.554441896E+07
+ 1.971979246E+07 1.734144535E+00 6.536957486E-07 8.129416306E+00 1.557978912E+07
+ 1.992329102E+07 1.606033704E+00 6.059976437E-07 8.022504394E+00 1.561562125E+07
+ 2.012678959E+07 1.487269996E+00 5.617369034E-07 7.915592482E+00 1.565193322E+07
+ 2.033028816E+07 1.377190062E+00 5.206690115E-07 7.808680571E+00 1.568873045E+07
+ 2.053378673E+07 1.275162854E+00 4.825666103E-07 7.701768659E+00 1.572602626E+07
+ 2.073728529E+07 1.180631480E+00 4.472183138E-07 7.594856747E+00 1.576383069E+07
+ 2.094078386E+07 1.092963686E+00 4.144276015E-07 7.487944835E+00 1.580217162E+07
+ 2.114428243E+07 1.011759303E+00 3.840117877E-07 7.381032924E+00 1.584105655E+07
+ 2.134778099E+07 9.365231680E-01 3.558010613E-07 7.274121012E+00 1.588050123E+07
+ 2.155127956E+07 8.668070290E-01 3.296375910E-07 7.167209100E+00 1.592052215E+07
+ 2.175477813E+07 8.022362397E-01 3.053746922E-07 7.060297188E+00 1.596113651E+07
+ 2.195827669E+07 7.424073466E-01 2.828760508E-07 6.953385277E+00 1.600236230E+07
+ 2.216177526E+07 6.870028290E-01 2.620150000E-07 6.846473365E+00 1.604421835E+07
+ 2.236527383E+07 6.356755843E-01 2.426738470E-07 6.739561453E+00 1.608671668E+07
+ 2.256877240E+07 5.881396963E-01 2.247432464E-07 6.632649541E+00 1.612989106E+07
+ 2.277227096E+07 5.440966438E-01 2.081216157E-07 6.525737629E+00 1.617375568E+07
+ 2.297576953E+07 5.033399146E-01 1.927145924E-07 6.418825718E+00 1.621833952E+07
+ 2.317926810E+07 4.655954580E-01 1.784345275E-07 6.311913806E+00 1.626366222E+07
+ 2.338276666E+07 4.306500807E-01 1.652000145E-07 6.205001894E+00 1.630974410E+07
+ 2.358626523E+07 3.982982838E-01 1.529354508E-07 6.098089982E+00 1.635661664E+07
+ 2.378976380E+07 3.683611855E-01 1.415706298E-07 5.991178071E+00 1.640431166E+07
+ 2.399326236E+07 3.406165445E-01 1.310403606E-07 5.884266159E+00 1.645285407E+07
+ 2.419676093E+07 3.149589434E-01 1.212841149E-07 5.777354247E+00 1.650226943E+07
+ 2.440025950E+07 2.912136212E-01 1.122456978E-07 5.670442335E+00 1.655259072E+07
+ 2.460375807E+07 2.692178849E-01 1.038729420E-07 5.563530424E+00 1.660386745E+07
+ 2.480725663E+07 2.488823438E-01 9.611742244E-08 5.456618512E+00 1.665612592E+07
+ 2.501075520E+07 2.300803718E-01 8.893419222E-08 5.349706600E+00 1.670940475E+07
+ 2.521425377E+07 2.126592849E-01 8.228153556E-08 5.242794688E+00 1.676373799E+07
+ 2.541775233E+07 1.965462854E-01 7.612073881E-08 5.135882777E+00 1.681918115E+07
+ 2.562125090E+07 1.816458746E-01 7.041587730E-08 5.028970865E+00 1.687576849E+07
+ 2.582474947E+07 1.678638832E-01 6.513361702E-08 4.922058953E+00 1.693356423E+07
+ 2.602824804E+07 1.551169861E-01 6.024303029E-08 4.815147041E+00 1.699261242E+07
+ 2.623174660E+07 1.433262731E-01 5.571542439E-08 4.708235130E+00 1.705296274E+07
+ 2.643524517E+07 1.324165470E-01 5.152418209E-08 4.601323218E+00 1.711467471E+07
+ 2.663874374E+07 1.223286571E-01 4.764461359E-08 4.494411306E+00 1.717783438E+07
+ 2.684224230E+07 1.130204714E-01 4.405381869E-08 4.387499394E+00 1.724248299E+07
+ 2.704574087E+07 1.043743102E-01 4.073055883E-08 4.280587482E+00 1.730870558E+07
+ 2.724923944E+07 9.641540916E-02 3.765513807E-08 4.173675571E+00 1.737658953E+07
+ 2.745273800E+07 8.904210876E-02 3.480929250E-08 4.066763659E+00 1.744621051E+07
+ 2.765623657E+07 8.224076367E-02 3.217608746E-08 3.959851747E+00 1.751764861E+07
+ 2.785973514E+07 7.593577469E-02 2.973982208E-08 3.852939835E+00 1.759102775E+07
+ 2.806323371E+07 7.011535203E-02 2.748594053E-08 3.746027924E+00 1.766642925E+07
+ 2.826673227E+07 6.472759558E-02 2.540094958E-08 3.639116012E+00 1.774400495E+07
+ 2.847023084E+07 5.976261199E-02 2.347234204E-08 3.532204100E+00 1.782386362E+07
+ 2.867372941E+07 5.519968042E-02 2.168852563E-08 3.425292188E+00 1.790614473E+07
+ 2.887722797E+07 5.091851845E-02 2.003875688E-08 3.318380277E+00 1.799100094E+07
+ 2.908072654E+07 4.700854981E-02 1.851307981E-08 3.211468365E+00 1.807859988E+07
+ 2.928422511E+07 4.338746585E-02 1.710226889E-08 3.104556453E+00 1.816908662E+07
+ 2.948772367E+07 4.004109261E-02 1.579777620E-08 2.997644541E+00 1.826273377E+07
+ 2.969122224E+07 3.694229646E-02 1.459168220E-08 2.890732630E+00 1.835973870E+07
+ 2.989472081E+07 3.409254972E-02 1.347665020E-08 2.783820718E+00 1.846034015E+07
+ 3.009821938E+07 3.145703232E-02 1.244588395E-08 2.676908806E+00 1.856484151E+07
+ 3.030171794E+07 2.902384246E-02 1.149308835E-08 2.569996894E+00 1.867353493E+07
+ 3.050521651E+07 2.676841986E-02 1.061243295E-08 2.463084982E+00 1.878680536E+07
+ 3.070871508E+07 2.470004087E-02 9.798518107E-09 2.356173071E+00 1.890503775E+07
+ 3.091221364E+07 2.278353142E-02 9.046343502E-09 2.249261159E+00 1.902866470E+07
+ 3.111571221E+07 2.102700011E-02 8.351279019E-09 2.142349247E+00 1.915823428E+07
+ 3.131921078E+07 1.938177020E-02 7.709037655E-09 2.035437335E+00 1.929438650E+07
+ 3.152270934E+07 1.788030150E-02 7.115650414E-09 1.928525424E+00 1.943775766E+07
+ 3.172620791E+07 1.647165357E-02 6.567443004E-09 1.821613512E+00 1.958920664E+07
+ 3.192970648E+07 1.519657383E-02 6.061014227E-09 1.714701600E+00 1.974969934E+07
+ 3.213320505E+07 1.401051345E-02 5.593215930E-09 1.607789688E+00 1.992039424E+07
+ 3.233670361E+07 1.292040271E-02 5.161134407E-09 1.500877777E+00 2.010266781E+07
+ 3.254020218E+07 1.190561551E-02 4.762073155E-09 1.393965865E+00 2.029825193E+07
+ 3.274370075E+07 1.097456547E-02 4.393536878E-09 1.287053953E+00 2.050925084E+07
+ 3.294719931E+07 1.011834572E-02 4.053216655E-09 1.180142041E+00 2.073838026E+07
+ 3.315069788E+07 9.330949925E-03 3.738976190E-09 1.073230130E+00 2.098884739E+07
+ 3.335419645E+07 8.594155208E-03 3.448839060E-09 9.663182178E-01 2.126533235E+07
+ 3.355769502E+07 7.915518341E-03 3.180976898E-09 8.594063060E-01 2.157385351E+07
+ 3.376119358E+07 7.299527832E-03 2.933698431E-09 7.524943943E-01 2.192287132E+07
+ 3.396469215E+07 6.745024272E-03 2.705439324E-09 6.455824825E-01 2.232473465E+07
+ 3.416819072E+07 6.198550817E-03 2.494752773E-09 5.386705707E-01 2.279849325E+07
+ 3.437168928E+07 5.710533582E-03 2.300300771E-09 4.317586590E-01 2.337605771E+07
+ 3.457518785E+07 5.246698445E-03 2.120846032E-09 3.248467472E-01 2.411644276E+07
+ 3.477868642E+07 4.850519230E-03 1.955244492E-09 2.179348354E-01 2.515132098E+07
+ 3.498218498E+07 4.461043889E-03 1.802438374E-09 1.110229237E-01 2.688820942E+07
+ 3.518568355E+07 4.111011908E-03 1.661449755E-09 4.111011908E-03 3.518568400E+07
+ 3.522679367E+07 4.069901789E-03 1.000000000E-09 4.069901789E-03 3.522679368E+07
+ 3.526790379E+07 4.028791670E-03 1.000000000E-09 4.028791670E-03 3.526790379E+07
+ 3.530901391E+07 3.987681551E-03 1.000000000E-09 3.987681551E-03 3.530901391E+07
+ 3.535012403E+07 3.946571431E-03 1.000000000E-09 3.946571431E-03 3.535012403E+07
+ 3.539123415E+07 3.905461312E-03 1.000000000E-09 3.905461312E-03 3.539123400E+07
+ 3.543234427E+07 3.864351193E-03 1.000000000E-09 3.864351193E-03 3.543234427E+07
+ 3.547345438E+07 3.823241074E-03 1.000000000E-09 3.823241074E-03 3.547345438E+07
+ 3.551456450E+07 3.782130955E-03 1.000000000E-09 3.782130955E-03 3.551456462E+07
+ 3.555567462E+07 3.741020836E-03 1.000000000E-09 3.741020836E-03 3.555567462E+07
+ 3.559678474E+07 3.699910717E-03 1.000000000E-09 3.699910717E-03 3.559678400E+07
+ 3.563789486E+07 3.658800598E-03 1.000000000E-09 3.658800598E-03 3.563789486E+07
+ 3.567900498E+07 3.617690479E-03 1.000000000E-09 3.617690479E-03 3.567900494E+07
+ 3.572011510E+07 3.576580360E-03 1.000000000E-09 3.576580360E-03 3.572011500E+07
+ 3.576122522E+07 3.535470241E-03 1.000000000E-09 3.535470241E-03 3.576122522E+07
+ 3.580233534E+07 3.494360122E-03 1.000000000E-09 3.494360122E-03 3.580236800E+07
+ 3.584344546E+07 3.453250003E-03 1.000000000E-09 3.453250003E-03 3.584344550E+07
+ 3.588455558E+07 3.412139883E-03 1.000000000E-09 3.412139883E-03 3.588455500E+07
+ 3.592566569E+07 3.371029764E-03 1.000000000E-09 3.371029764E-03 3.592566569E+07
+ 3.596677581E+07 3.329919645E-03 1.000000000E-09 3.329919645E-03 3.596677400E+07
+ 3.600788593E+07 3.288809526E-03 1.000000000E-09 3.288809526E-03 3.600789296E+07
+ 3.604899605E+07 3.247699407E-03 1.000000000E-09 3.247699407E-03 3.604899606E+07
+ 3.609010617E+07 3.206589288E-03 1.000000000E-09 3.206589288E-03 3.609011200E+07
+ 3.613121629E+07 3.165479169E-03 1.000000000E-09 3.165479169E-03 3.613121629E+07
+ 3.617232641E+07 3.124369050E-03 1.000000000E-09 3.124369050E-03 3.617232700E+07
+ 3.621343653E+07 3.083258931E-03 1.000000000E-09 3.083258931E-03 3.621343700E+07
+ 3.625454665E+07 3.042148812E-03 1.000000000E-09 3.042148812E-03 3.625454600E+07
+ 3.629565677E+07 3.001038693E-03 1.000000000E-09 3.001038693E-03 3.629566400E+07
+ 3.633676689E+07 2.959928574E-03 1.000000000E-09 2.959928574E-03 3.633676689E+07
+ 3.637787700E+07 2.918818455E-03 1.000000000E-09 2.918818455E-03 3.637787700E+07
+ 3.641898712E+07 2.877708335E-03 1.000000000E-09 2.877708335E-03 3.641898719E+07
+ 3.646009724E+07 2.836598216E-03 1.000000000E-09 2.836598216E-03 3.646009725E+07
+ 3.650120736E+07 2.795488097E-03 1.000000000E-09 2.795488097E-03 3.650121600E+07
+ 3.654231748E+07 2.754377978E-03 1.000000000E-09 2.754377978E-03 3.654231749E+07
+ 3.658342760E+07 2.713267859E-03 1.000000000E-09 2.713267859E-03 3.658342780E+07
+ 3.662453772E+07 2.672157740E-03 1.000000000E-09 2.672157740E-03 3.662454400E+07
+ 3.666564784E+07 2.631047621E-03 1.000000000E-09 2.631047621E-03 3.666564800E+07
+ 3.670675796E+07 2.589937502E-03 1.000000000E-09 2.589937502E-03 3.670676800E+07
+ 3.674786808E+07 2.548827383E-03 1.000000000E-09 2.548827383E-03 3.674786808E+07
+ 3.678897820E+07 2.507717264E-03 1.000000000E-09 2.507717264E-03 3.678898100E+07
+ 3.683008831E+07 2.466607145E-03 1.000000000E-09 2.466607145E-03 3.683008837E+07
+ 3.687119843E+07 2.425497026E-03 1.000000000E-09 2.425497026E-03 3.687119922E+07
+ 3.691230855E+07 2.384386906E-03 1.000000000E-09 2.384386906E-03 3.691230856E+07
+ 3.695341867E+07 2.343276787E-03 1.000000000E-09 2.343276787E-03 3.695342134E+07
+ 3.699452879E+07 2.302166668E-03 1.000000000E-09 2.302166668E-03 3.699452881E+07
+ 3.703563891E+07 2.261056549E-03 1.000000000E-09 2.261056549E-03 3.703566400E+07
+ 3.707674903E+07 2.219946430E-03 1.000000000E-09 2.219946430E-03 3.707674903E+07
+ 3.711785915E+07 2.178836311E-03 1.000000000E-09 2.178836311E-03 3.711784957E+07
+ 3.715896927E+07 2.137726192E-03 1.000000000E-09 2.137726192E-03 3.715896927E+07
+ 3.720007939E+07 2.096616073E-03 1.000000000E-09 2.096616073E-03 3.720008509E+07
+ 3.724118951E+07 2.055505954E-03 1.000000000E-09 2.055505954E-03 3.724120000E+07
+ 3.728229962E+07 2.014395835E-03 1.000000000E-09 2.014395835E-03 3.728230181E+07
+ 3.732340974E+07 1.973285716E-03 1.000000000E-09 1.973285716E-03 3.732341000E+07
+ 3.736451986E+07 1.932175597E-03 1.000000000E-09 1.932175597E-03 3.736451987E+07
+ 3.740562998E+07 1.891065478E-03 1.000000000E-09 1.891065478E-03 3.740560000E+07
+ 3.744674010E+07 1.849955358E-03 1.000000000E-09 1.849955358E-03 3.744676800E+07
+ 3.748785022E+07 1.808845239E-03 1.000000000E-09 1.808845239E-03 3.748785022E+07
+ 3.752896034E+07 1.767735120E-03 1.000000000E-09 1.767735120E-03 3.752896034E+07
+ 3.757007046E+07 1.726625001E-03 1.000000000E-09 1.726625001E-03 3.757007046E+07
+ 3.761118058E+07 1.685514882E-03 1.000000000E-09 1.685514882E-03 3.761117900E+07
+ 3.765229070E+07 1.644404763E-03 1.000000000E-09 1.644404763E-03 3.765229070E+07
+ 3.769340082E+07 1.603294644E-03 1.000000000E-09 1.603294644E-03 3.769340075E+07
+ 3.773451093E+07 1.562184525E-03 1.000000000E-09 1.562184525E-03 3.773448320E+07
+ 3.777562105E+07 1.521074406E-03 1.000000000E-09 1.521074406E-03 3.777562105E+07
+ 3.781673117E+07 1.479964287E-03 1.000000000E-09 1.479964287E-03 3.781673117E+07
+ 3.785784129E+07 1.438854168E-03 1.000000000E-09 1.438854168E-03 3.785784100E+07
+ 3.789895141E+07 1.397744049E-03 1.000000000E-09 1.397744049E-03 3.789896076E+07
+ 3.794006153E+07 1.356633930E-03 1.000000000E-09 1.356633930E-03 3.794006153E+07
+ 3.798117165E+07 1.315523810E-03 1.000000000E-09 1.315523810E-03 3.798117156E+07
+ 3.802228177E+07 1.274413691E-03 1.000000000E-09 1.274413691E-03 3.802228188E+07
+ 3.806339189E+07 1.233303572E-03 1.000000000E-09 1.233303572E-03 3.806339187E+07
+ 3.810450201E+07 1.192193453E-03 1.000000000E-09 1.192193453E-03 3.810453839E+07
+ 3.814561213E+07 1.151083334E-03 1.000000000E-09 1.151083334E-03 3.814561219E+07
+ 3.818672224E+07 1.109973215E-03 1.000000000E-09 1.109973215E-03 3.818672225E+07
+ 3.822783236E+07 1.068863096E-03 1.000000000E-09 1.068863096E-03 3.822783236E+07
+ 3.826894248E+07 1.027752977E-03 1.000000000E-09 1.027752977E-03 3.826894300E+07
+ 3.831005260E+07 9.866428579E-04 1.000000000E-09 9.866428579E-04 3.831005260E+07
+ 3.835116272E+07 9.455327388E-04 1.000000000E-09 9.455327388E-04 3.835114305E+07
+ 3.839227284E+07 9.044226197E-04 1.000000000E-09 9.044226197E-04 3.839227722E+07
+ 3.843338296E+07 8.633125006E-04 1.000000000E-09 8.633125006E-04 3.843338296E+07
+ 3.847449308E+07 8.222023816E-04 1.000000000E-09 8.222023816E-04 3.847449454E+07
+ 3.851560320E+07 7.810922625E-04 1.000000000E-09 7.810922625E-04 3.851561600E+07
+ 3.855671332E+07 7.399821434E-04 1.000000000E-09 7.399821434E-04 3.855671332E+07
+ 3.859782343E+07 6.988720243E-04 1.000000000E-09 6.988720243E-04 3.859784000E+07
+ 3.863893355E+07 6.577619052E-04 1.000000000E-09 6.577619052E-04 3.863893356E+07
+ 3.868004367E+07 6.166517862E-04 1.000000000E-09 6.166517862E-04 3.868004400E+07
+ 3.872115379E+07 5.755416671E-04 1.000000000E-09 5.755416671E-04 3.872115200E+07
+ 3.876226391E+07 5.344315480E-04 1.000000000E-09 5.344315480E-04 3.876224000E+07
+ 3.880337403E+07 4.933214289E-04 1.000000000E-09 4.933214289E-04 3.880337403E+07
+ 3.884448415E+07 4.522113099E-04 1.000000000E-09 4.522113099E-04 3.884449007E+07
+ 3.888559427E+07 4.111011908E-04 1.000000000E-09 4.111011908E-04 3.888559431E+07
+ 3.892670439E+07 3.699910717E-04 1.000000000E-09 3.699910717E-04 3.892670400E+07
+ 3.896781451E+07 3.288809526E-04 1.000000000E-09 3.288809526E-04 3.896781451E+07
+ 3.900892463E+07 2.877708335E-04 1.000000000E-09 2.877708335E-04 3.900892463E+07
+ 3.905003474E+07 2.466607145E-04 1.000000000E-09 2.466607145E-04 3.905003475E+07
+ 3.909114486E+07 2.055505954E-04 1.000000000E-09 2.055505954E-04 3.909114493E+07
+ 3.913225498E+07 1.644404763E-04 1.000000000E-09 1.644404763E-04 3.913225600E+07
+ 3.917336510E+07 1.233303572E-04 1.000000000E-09 1.233303572E-04 3.917337055E+07
+ 3.921447522E+07 8.222023816E-05 1.000000000E-09 8.222023816E-05 3.921447761E+07
+ 3.925558534E+07 4.111011908E-05 1.000000000E-09 4.111011908E-05 3.925561526E+07
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM80
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM80	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM80	(revision 286)
@@ -0,0 +1,501 @@
+DENSITY AND THICKNESS DATA OF THE ATMOSPHERE AT AN ZENITH ANGLE OF 80.0 DEGREES
+ 0.000000000E+00 5.765903360E+03 1.229805824E-03 5.765903360E+03 0.000000000E+00
+ 2.280718661E+04 5.737951241E+03 1.224916044E-03 5.742795274E+03 1.853810628E+04
+ 4.561437322E+04 5.709670730E+03 1.220044735E-03 5.719687188E+03 3.771805360E+04
+ 6.842155983E+04 5.681936964E+03 1.215191830E-03 5.696579102E+03 5.637636632E+04
+ 9.122874644E+04 5.654314121E+03 1.210357264E-03 5.673471016E+03 7.567536530E+04
+ 1.140359330E+05 5.627081126E+03 1.205540972E-03 5.650362930E+03 9.446116176E+04
+ 1.368431197E+05 5.599239596E+03 1.200742889E-03 5.627254844E+03 1.138934268E+05
+ 1.596503063E+05 5.571944612E+03 1.195962949E-03 5.604146758E+03 1.330241617E+05
+ 1.824574929E+05 5.545034837E+03 1.191201089E-03 5.581038672E+03 1.523608295E+05
+ 2.052646795E+05 5.517960403E+03 1.186457244E-03 5.557930585E+03 1.713917927E+05
+ 2.280718661E+05 5.490994070E+03 1.181731349E-03 5.534822499E+03 1.910850220E+05
+ 2.508790527E+05 5.463703726E+03 1.177023341E-03 5.511714413E+03 2.104730303E+05
+ 2.736862393E+05 5.436948477E+03 1.172333156E-03 5.488606327E+03 2.300698823E+05
+ 2.964934259E+05 5.410579074E+03 1.167660731E-03 5.465498241E+03 2.493704128E+05
+ 3.193006125E+05 5.384040069E+03 1.163006002E-03 5.442390155E+03 2.693314427E+05
+ 3.421077991E+05 5.357163356E+03 1.158368905E-03 5.419282069E+03 2.889839566E+05
+ 3.649149857E+05 5.331107000E+03 1.153749379E-03 5.396173983E+03 3.088491121E+05
+ 3.877221724E+05 5.304883695E+03 1.149147360E-03 5.373065897E+03 3.284043614E+05
+ 4.105293590E+05 5.278765576E+03 1.144562786E-03 5.349957811E+03 3.485479934E+05
+ 4.333365456E+05 5.252309294E+03 1.139995594E-03 5.326849725E+03 3.683312727E+05
+ 4.561437322E+05 5.226398857E+03 1.135445723E-03 5.303741638E+03 3.887046417E+05
+ 4.789509188E+05 5.200589024E+03 1.130913111E-03 5.280633552E+03 4.089166945E+05
+ 5.017581054E+05 5.175161622E+03 1.126397695E-03 5.257525466E+03 4.288115546E+05
+ 5.245652920E+05 5.149560741E+03 1.121899415E-03 5.234417380E+03 4.494063585E+05
+ 5.473724786E+05 5.123618498E+03 1.117418209E-03 5.211309294E+03 4.694434287E+05
+ 5.701796652E+05 5.098493199E+03 1.112954016E-03 5.188201208E+03 4.901787659E+05
+ 5.929868518E+05 5.073197350E+03 1.108506775E-03 5.165093122E+03 5.107497904E+05
+ 6.157940384E+05 5.048003138E+03 1.104076426E-03 5.141985036E+03 5.309984453E+05
+ 6.386012251E+05 5.022909839E+03 1.099662908E-03 5.118876950E+03 5.519595591E+05
+ 6.614084117E+05 4.997749624E+03 1.095266161E-03 5.095768864E+03 5.723567551E+05
+ 6.842155983E+05 4.972913837E+03 1.090886125E-03 5.072660778E+03 5.934651210E+05
+ 7.070227849E+05 4.948120400E+03 1.086522740E-03 5.049552691E+03 6.144078355E+05
+ 7.298299715E+05 4.922980377E+03 1.082175946E-03 5.026444605E+03 6.350258945E+05
+ 7.526371581E+05 4.898381594E+03 1.077845684E-03 5.003336519E+03 6.562146843E+05
+ 7.754443447E+05 4.874160512E+03 1.073531895E-03 4.980228433E+03 6.771921275E+05
+ 7.982515313E+05 4.849761319E+03 1.069234519E-03 4.957120347E+03 6.986902104E+05
+ 8.210587179E+05 4.825017128E+03 1.064953498E-03 4.934012261E+03 7.200192715E+05
+ 8.438659045E+05 4.800809642E+03 1.060688773E-03 4.910904175E+03 7.412691513E+05
+ 8.666730911E+05 4.776975549E+03 1.056440286E-03 4.887796089E+03 7.627555739E+05
+ 8.894802778E+05 4.752968151E+03 1.052207978E-03 4.864688003E+03 7.843238410E+05
+ 9.122874644E+05 4.729053772E+03 1.047991791E-03 4.841579917E+03 8.055593874E+05
+ 9.350946510E+05 4.704791664E+03 1.043791667E-03 4.818471831E+03 8.272841394E+05
+ 9.579018376E+05 4.681065350E+03 1.039607550E-03 4.795363744E+03 8.493529671E+05
+ 9.807090242E+05 4.657435250E+03 1.035439380E-03 4.772255658E+03 8.708349446E+05
+ 1.003516211E+06 4.634178376E+03 1.031287101E-03 4.749147572E+03 8.930663434E+05
+ 1.026323397E+06 4.610739744E+03 1.027150656E-03 4.726039486E+03 9.151273752E+05
+ 1.049130584E+06 4.586951022E+03 1.023029988E-03 4.702931400E+03 9.372738679E+05
+ 1.071937771E+06 4.563971013E+03 1.018925040E-03 4.679823314E+03 9.590825277E+05
+ 1.094744957E+06 4.540826915E+03 1.014835756E-03 4.656715228E+03 9.813960811E+05
+ 1.117552144E+06 4.517761862E+03 1.010762079E-03 4.633607142E+03 1.004062913E+06
+ 1.140359330E+06 4.494789882E+03 1.006703952E-03 4.610499056E+03 1.026554627E+06
+ 1.163166517E+06 4.471464693E+03 1.002661321E-03 4.587390970E+03 1.048705706E+06
+ 1.185973704E+06 4.448674298E+03 9.986341293E-04 4.564282884E+03 1.071635680E+06
+ 1.208780890E+06 4.425974966E+03 9.946223212E-04 4.541174797E+03 1.094406705E+06
+ 1.231588077E+06 4.403646840E+03 9.906258412E-04 4.518066711E+03 1.117254592E+06
+ 1.254395264E+06 4.381132333E+03 9.866446344E-04 4.494958625E+03 1.139760215E+06
+ 1.277202450E+06 4.358266832E+03 9.826786455E-04 4.471850539E+03 1.162786435E+06
+ 1.300009637E+06 4.336204777E+03 9.787278198E-04 4.448742453E+03 1.185906306E+06
+ 1.322816823E+06 4.313960079E+03 9.747921026E-04 4.425634367E+03 1.209119021E+06
+ 1.345624010E+06 4.291805289E+03 9.708714393E-04 4.402526281E+03 1.232703900E+06
+ 1.368431197E+06 4.269739723E+03 9.669657757E-04 4.379418195E+03 1.256108846E+06
+ 1.391238383E+06 4.247319625E+03 9.630750577E-04 4.356310109E+03 1.279613207E+06
+ 1.414045570E+06 4.225428219E+03 9.591992312E-04 4.333202023E+03 1.302762200E+06
+ 1.436852756E+06 4.203625332E+03 9.553382427E-04 4.310093937E+03 1.326486948E+06
+ 1.459659943E+06 4.182188877E+03 9.514920384E-04 4.286985850E+03 1.350521379E+06
+ 1.482467130E+06 4.160435895E+03 9.476605649E-04 4.263877764E+03 1.374411637E+06
+ 1.505274316E+06 4.138911145E+03 9.438437691E-04 4.240769678E+03 1.398402584E+06
+ 1.528081503E+06 4.117459322E+03 9.400415980E-04 4.217661592E+03 1.422493337E+06
+ 1.550888689E+06 4.096094343E+03 9.362539985E-04 4.194553506E+03 1.446685767E+06
+ 1.573695876E+06 4.074815536E+03 9.324809182E-04 4.171445420E+03 1.470980381E+06
+ 1.596503063E+06 4.053179286E+03 9.287223044E-04 4.148337334E+03 1.494975049E+06
+ 1.619310249E+06 4.032068709E+03 9.249781048E-04 4.125229248E+03 1.519474454E+06
+ 1.642117436E+06 4.011043631E+03 9.212482673E-04 4.102121162E+03 1.544079164E+06
+ 1.664924622E+06 3.990381655E+03 9.175327399E-04 4.079013076E+03 1.568789765E+06
+ 1.687731809E+06 3.969531742E+03 9.138314708E-04 4.055904990E+03 1.593608170E+06
+ 1.710538996E+06 3.948320071E+03 9.101444084E-04 4.032796903E+03 1.618533676E+06
+ 1.733346182E+06 3.927631778E+03 9.064715012E-04 4.009688817E+03 1.643568224E+06
+ 1.756153369E+06 3.907302083E+03 9.028126980E-04 3.986580731E+03 1.668712455E+06
+ 1.778960556E+06 3.886782722E+03 8.991679475E-04 3.963472645E+03 1.693971045E+06
+ 1.801767742E+06 3.866347271E+03 8.955371990E-04 3.940364559E+03 1.719337955E+06
+ 1.824574929E+06 3.845993724E+03 8.919204017E-04 3.917256473E+03 1.744817885E+06
+ 1.847382115E+06 3.825279332E+03 8.883175049E-04 3.894148387E+03 1.770411535E+06
+ 1.870189302E+06 3.805087027E+03 8.847284582E-04 3.871040301E+03 1.796120971E+06
+ 1.892996489E+06 3.784989839E+03 8.811532114E-04 3.847932215E+03 1.821945570E+06
+ 1.915803675E+06 3.765239261E+03 8.775917144E-04 3.824824129E+03 1.847887435E+06
+ 1.938610862E+06 3.745293584E+03 8.740439174E-04 3.801716043E+03 1.874438260E+06
+ 1.961418048E+06 3.725428577E+03 8.705097705E-04 3.778607956E+03 1.900633842E+06
+ 1.984225235E+06 3.705199618E+03 8.669892242E-04 3.755499870E+03 1.926933399E+06
+ 2.007032422E+06 3.685766733E+03 8.634822291E-04 3.732391784E+03 1.953354540E+06
+ 2.029839608E+06 3.666141063E+03 8.599887359E-04 3.709283698E+03 1.979898063E+06
+ 2.052646795E+06 3.646595159E+03 8.565086956E-04 3.686175612E+03 2.006566306E+06
+ 2.075453981E+06 3.627128373E+03 8.530420594E-04 3.663067526E+03 2.033045506E+06
+ 2.098261168E+06 3.607744172E+03 8.495887784E-04 3.639959440E+03 2.059964691E+06
+ 2.121068355E+06 3.587989701E+03 8.461488040E-04 3.616851354E+03 2.087524234E+06
+ 2.143875541E+06 3.568756017E+03 8.427220880E-04 3.593743268E+03 2.114698220E+06
+ 2.166682728E+06 3.549600243E+03 8.393085819E-04 3.570635182E+03 2.141679573E+06
+ 2.189489914E+06 3.530801290E+03 8.359082379E-04 3.547527096E+03 2.169116105E+06
+ 2.212297101E+06 3.511802564E+03 8.325210078E-04 3.524419009E+03 2.196686359E+06
+ 2.235104288E+06 3.492881167E+03 8.291468441E-04 3.501310923E+03 2.224909507E+06
+ 2.257911474E+06 3.473591928E+03 8.257856991E-04 3.478202837E+03 2.252745803E+06
+ 2.280718661E+06 3.455094751E+03 8.224375253E-04 3.455094751E+03 2.280718661E+06
+ 2.314116442E+06 3.427730581E+03 8.212061309E-04 3.435054083E+03 2.305314029E+06
+ 2.347514223E+06 3.400082863E+03 8.156906349E-04 3.415013415E+03 2.329445578E+06
+ 2.380912004E+06 3.373078330E+03 8.102106190E-04 3.394972747E+03 2.353716237E+06
+ 2.414309786E+06 3.346263674E+03 8.047658660E-04 3.374932078E+03 2.378650797E+06
+ 2.447707567E+06 3.319164144E+03 7.993561599E-04 3.354891410E+03 2.403732458E+06
+ 2.481105348E+06 3.292279679E+03 7.939812860E-04 3.334850742E+03 2.428342800E+06
+ 2.514503129E+06 3.266006141E+03 7.886410307E-04 3.314810074E+03 2.453098473E+06
+ 2.547900910E+06 3.240046948E+03 7.833351818E-04 3.294769405E+03 2.478001230E+06
+ 2.581298692E+06 3.214126355E+03 7.780635283E-04 3.274728737E+03 2.503573626E+06
+ 2.614696473E+06 3.187913893E+03 7.728258604E-04 3.254688069E+03 2.528727515E+06
+ 2.648094254E+06 3.162334297E+03 7.676219694E-04 3.234647401E+03 2.554717474E+06
+ 2.681492035E+06 3.136935202E+03 7.624516480E-04 3.214606733E+03 2.580689128E+06
+ 2.714889816E+06 3.111243917E+03 7.573146901E-04 3.194566064E+03 2.606195402E+06
+ 2.748287598E+06 3.086180864E+03 7.522108906E-04 3.174525396E+03 2.631859003E+06
+ 2.781685379E+06 3.061293210E+03 7.471400457E-04 3.154484728E+03 2.658208769E+06
+ 2.815083160E+06 3.036113115E+03 7.421019528E-04 3.134444060E+03 2.684718670E+06
+ 2.848480941E+06 3.011553082E+03 7.370964106E-04 3.114403391E+03 2.710768057E+06
+ 2.881878722E+06 2.987166803E+03 7.321232186E-04 3.094362723E+03 2.737558040E+06
+ 2.915276504E+06 2.962488510E+03 7.271821779E-04 3.074322055E+03 2.763888665E+06
+ 2.948674285E+06 2.938432230E+03 7.222730904E-04 3.054281387E+03 2.790958412E+06
+ 2.982072066E+06 2.914538021E+03 7.173957594E-04 3.034240719E+03 2.817577465E+06
+ 3.015469847E+06 2.890351080E+03 7.125499892E-04 3.014200050E+03 2.844936136E+06
+ 3.048867628E+06 2.866771604E+03 7.077355853E-04 2.994159382E+03 2.872464682E+06
+ 3.082265410E+06 2.843359375E+03 7.029523544E-04 2.974118714E+03 2.899503180E+06
+ 3.115663191E+06 2.819655588E+03 6.982001041E-04 2.954078046E+03 2.926720999E+06
+ 3.149060972E+06 2.796553568E+03 6.934786434E-04 2.934037377E+03 2.954686341E+06
+ 3.182458753E+06 2.773613985E+03 6.887877822E-04 2.913996709E+03 2.982816540E+06
+ 3.215856534E+06 2.750384084E+03 6.841273316E-04 2.893956041E+03 3.010474701E+06
+ 3.249254316E+06 2.727746821E+03 6.794971038E-04 2.873915373E+03 3.038915530E+06
+ 3.282652097E+06 2.705270531E+03 6.748969121E-04 2.853874705E+03 3.067537083E+06
+ 3.316049878E+06 2.682505837E+03 6.703265709E-04 2.833834036E+03 3.095653313E+06
+ 3.349447659E+06 2.660362193E+03 6.657858956E-04 2.813793368E+03 3.123965352E+06
+ 3.382845440E+06 2.638342092E+03 6.612747028E-04 2.793752700E+03 3.153049280E+06
+ 3.416243222E+06 2.616029489E+03 6.567928101E-04 2.773712032E+03 3.182318373E+06
+ 3.449641003E+06 2.594299737E+03 6.523400361E-04 2.753671363E+03 3.211113612E+06
+ 3.483038784E+06 2.572724911E+03 6.479162006E-04 2.733630695E+03 3.240718081E+06
+ 3.516436565E+06 2.550860252E+03 6.435211244E-04 2.713590027E+03 3.270515465E+06
+ 3.549834346E+06 2.530039966E+03 6.391546293E-04 2.693549359E+03 3.299813472E+06
+ 3.583232128E+06 2.508433425E+03 6.348165382E-04 2.673508691E+03 3.330015200E+06
+ 3.616629909E+06 2.487447132E+03 6.305066750E-04 2.653468022E+03 3.360362093E+06
+ 3.650027690E+06 2.466610931E+03 6.262248648E-04 2.633427354E+03 3.390178005E+06
+ 3.683425471E+06 2.445438430E+03 6.219709334E-04 2.613386686E+03 3.420217526E+06
+ 3.716823252E+06 2.424886447E+03 6.177447079E-04 2.593346018E+03 3.451083347E+06
+ 3.750221033E+06 2.404472894E+03 6.135460162E-04 2.573305350E+03 3.482155979E+06
+ 3.783618815E+06 2.383725254E+03 6.093746875E-04 2.553264681E+03 3.512750112E+06
+ 3.817016596E+06 2.363581119E+03 6.052305517E-04 2.533224013E+03 3.544202547E+06
+ 3.850414377E+06 2.343581412E+03 6.011134399E-04 2.513183345E+03 3.575865898E+06
+ 3.883812158E+06 2.323251729E+03 5.970231840E-04 2.493142677E+03 3.607038552E+06
+ 3.917209939E+06 2.303517818E+03 5.929596172E-04 2.473102008E+03 3.639093284E+06
+ 3.950607721E+06 2.283923874E+03 5.889225733E-04 2.453061340E+03 3.671368396E+06
+ 3.984005502E+06 2.264004125E+03 5.849118874E-04 2.433020672E+03 3.703145759E+06
+ 4.017403283E+06 2.244668857E+03 5.809273953E-04 2.412980004E+03 3.735841332E+06
+ 4.050801064E+06 2.225472557E+03 5.769689341E-04 2.392939336E+03 3.768751677E+06
+ 4.084198845E+06 2.205955294E+03 5.730363415E-04 2.372898667E+03 3.801160048E+06
+ 4.117596627E+06 2.187168367E+03 5.691294563E-04 2.352857999E+03 3.834493217E+06
+ 4.150994408E+06 2.168369732E+03 5.652481184E-04 2.332817331E+03 3.868062105E+06
+ 4.184392189E+06 2.149229012E+03 5.613921685E-04 2.312776663E+03 3.901132907E+06
+ 4.217789970E+06 2.130678637E+03 5.575614482E-04 2.292735994E+03 3.935924332E+06
+ 4.251187751E+06 2.112261983E+03 5.537558000E-04 2.272695326E+03 3.969398348E+06
+ 4.284585533E+06 2.093508876E+03 5.499750676E-04 2.252654658E+03 4.003900409E+06
+ 4.317983314E+06 2.075337239E+03 5.462190953E-04 2.232613990E+03 4.038652528E+06
+ 4.351381095E+06 2.057295072E+03 5.424877286E-04 2.212573322E+03 4.072841732E+06
+ 4.384778876E+06 2.038922140E+03 5.387808136E-04 2.192532653E+03 4.107511963E+06
+ 4.418176657E+06 2.021118280E+03 5.350981976E-04 2.172491985E+03 4.143839563E+06
+ 4.451574439E+06 2.003443063E+03 5.314397286E-04 2.152451317E+03 4.178749342E+06
+ 4.484972220E+06 1.985443436E+03 5.278052557E-04 2.132410649E+03 4.214738014E+06
+ 4.518370001E+06 1.968010295E+03 5.241946287E-04 2.112369980E+03 4.250996261E+06
+ 4.551767782E+06 1.950695169E+03 5.206076983E-04 2.092329312E+03 4.286696047E+06
+ 4.585165563E+06 1.933060843E+03 5.170443164E-04 2.072288644E+03 4.323472415E+06
+ 4.618563345E+06 1.916442064E+03 5.135043353E-04 2.052247976E+03 4.360526305E+06
+ 4.651961126E+06 1.899011782E+03 5.099876084E-04 2.032207308E+03 4.397866075E+06
+ 4.685358907E+06 1.882174841E+03 5.064939901E-04 2.012166639E+03 4.435493883E+06
+ 4.718756688E+06 1.865458321E+03 5.030233355E-04 1.992125971E+03 4.472538426E+06
+ 4.752154469E+06 1.848382937E+03 4.995755006E-04 1.972085303E+03 4.510739028E+06
+ 4.785552251E+06 1.831887282E+03 4.961503422E-04 1.952044635E+03 4.549224233E+06
+ 4.818950032E+06 1.815511466E+03 4.927477181E-04 1.932003966E+03 4.588015853E+06
+ 4.852347813E+06 1.798784604E+03 4.893674867E-04 1.911963298E+03 4.627116484E+06
+ 4.885745594E+06 1.782663168E+03 4.860095075E-04 1.891922630E+03 4.665630568E+06
+ 4.919143375E+06 1.766623092E+03 4.826736408E-04 1.871881962E+03 4.705338195E+06
+ 4.952541157E+06 1.750233729E+03 4.793597475E-04 1.851841294E+03 4.745365905E+06
+ 4.985938938E+06 1.734405574E+03 4.760676895E-04 1.831800625E+03 4.785723503E+06
+ 5.019336719E+06 1.718692684E+03 4.727973296E-04 1.811759957E+03 4.826414197E+06
+ 5.052734500E+06 1.702639052E+03 4.695485313E-04 1.791719289E+03 4.866546343E+06
+ 5.086132281E+06 1.687135470E+03 4.663211589E-04 1.771678621E+03 4.908902580E+06
+ 5.119530062E+06 1.671743291E+03 4.631150775E-04 1.751637952E+03 4.949667698E+06
+ 5.152927844E+06 1.656018973E+03 4.599301532E-04 1.731597284E+03 4.991725690E+06
+ 5.186325625E+06 1.641296977E+03 4.567662526E-04 1.711556616E+03 5.034144645E+06
+ 5.219723406E+06 1.625752126E+03 4.536232433E-04 1.691515948E+03 5.076936031E+06
+ 5.253121187E+06 1.610794455E+03 4.505009936E-04 1.671475280E+03 5.120096728E+06
+ 5.286518968E+06 1.595937365E+03 4.473993727E-04 1.651434611E+03 5.163638571E+06
+ 5.319916750E+06 1.580710916E+03 4.443182504E-04 1.631393943E+03 5.207566135E+06
+ 5.353314531E+06 1.566050096E+03 4.412574975E-04 1.611353275E+03 5.251908340E+06
+ 5.386712312E+06 1.551496599E+03 4.382169853E-04 1.591312607E+03 5.296629912E+06
+ 5.420110093E+06 1.536583756E+03 4.351965862E-04 1.571271939E+03 5.340778425E+06
+ 5.453507874E+06 1.522224256E+03 4.321961731E-04 1.551231270E+03 5.387303783E+06
+ 5.486905656E+06 1.507968321E+03 4.292156196E-04 1.531190602E+03 5.432266197E+06
+ 5.520303437E+06 1.493363094E+03 4.262548005E-04 1.511149934E+03 5.479672111E+06
+ 5.553701218E+06 1.479295434E+03 4.233135908E-04 1.491109266E+03 5.525485638E+06
+ 5.587098999E+06 1.465330974E+03 4.203918666E-04 1.471068597E+03 5.573790754E+06
+ 5.620496780E+06 1.451027929E+03 4.174895046E-04 1.451027929E+03 5.620496780E+06
+ 5.775249443E+06 1.386524284E+03 4.076561568E-04 1.436661838E+03 5.654366132E+06
+ 5.930002105E+06 1.324820556E+03 3.899500888E-04 1.422295746E+03 5.688584894E+06
+ 6.084754767E+06 1.265798479E+03 3.729917896E-04 1.407929655E+03 5.723141788E+06
+ 6.239507430E+06 1.209339177E+03 3.567506351E-04 1.393563563E+03 5.758027551E+06
+ 6.394260092E+06 1.155338174E+03 3.411972131E-04 1.379197472E+03 5.793265501E+06
+ 6.549012754E+06 1.103699944E+03 3.263032777E-04 1.364831381E+03 5.828862895E+06
+ 6.703765416E+06 1.054317277E+03 3.120417045E-04 1.350465289E+03 5.864845978E+06
+ 6.858518079E+06 1.007094225E+03 2.983864476E-04 1.336099198E+03 5.901203632E+06
+ 7.013270741E+06 9.619392473E+02 2.853124988E-04 1.321733106E+03 5.937927150E+06
+ 7.168023403E+06 9.187569013E+02 2.727958472E-04 1.307367015E+03 5.975041711E+06
+ 7.322776066E+06 8.774768590E+02 2.608134413E-04 1.293000923E+03 6.012555821E+06
+ 7.477528728E+06 8.380039601E+02 2.493431518E-04 1.278634832E+03 6.050497936E+06
+ 7.632281390E+06 8.002750806E+02 2.383637362E-04 1.264268741E+03 6.088857659E+06
+ 7.787034052E+06 7.642133494E+02 2.278548047E-04 1.249902649E+03 6.127626483E+06
+ 7.941786715E+06 7.297309484E+02 2.177967868E-04 1.235536558E+03 6.166832045E+06
+ 8.096539377E+06 6.967783228E+02 2.081708999E-04 1.221170466E+03 6.206484405E+06
+ 8.251292039E+06 6.652757564E+02 1.989591186E-04 1.206804375E+03 6.246618424E+06
+ 8.406044702E+06 6.351750626E+02 1.901441453E-04 1.192438283E+03 6.287217269E+06
+ 8.560797364E+06 6.064090771E+02 1.817093819E-04 1.178072192E+03 6.328276605E+06
+ 8.715550026E+06 5.789196437E+02 1.736389024E-04 1.163706101E+03 6.369826952E+06
+ 8.870302688E+06 5.526519186E+02 1.659174267E-04 1.149340009E+03 6.411901621E+06
+ 9.025055351E+06 5.275529468E+02 1.585302954E-04 1.134973918E+03 6.454471654E+06
+ 9.179808013E+06 5.035663698E+02 1.514634455E-04 1.120607826E+03 6.497591942E+06
+ 9.334560675E+06 4.806552766E+02 1.447033868E-04 1.106241735E+03 6.541233738E+06
+ 9.489313338E+06 4.587674040E+02 1.382371795E-04 1.091875643E+03 6.585431544E+06
+ 9.644066000E+06 4.378509951E+02 1.320524125E-04 1.077509552E+03 6.630223723E+06
+ 9.798818662E+06 4.178778873E+02 1.261371826E-04 1.063143460E+03 6.675601979E+06
+ 9.953571324E+06 3.988002721E+02 1.204800745E-04 1.048777369E+03 6.721560340E+06
+ 1.010832399E+07 3.805784954E+02 1.150701412E-04 1.034411278E+03 6.768136608E+06
+ 1.026307665E+07 3.631754654E+02 1.098968858E-04 1.020045186E+03 6.815372888E+06
+ 1.041782931E+07 3.465552302E+02 1.049502434E-04 1.005679095E+03 6.863262731E+06
+ 1.057258197E+07 3.306799630E+02 1.002205640E-04 9.913130033E+02 6.911801333E+06
+ 1.072733464E+07 3.155242733E+02 9.569859587E-05 9.769469119E+02 6.961056826E+06
+ 1.088208730E+07 3.010525293E+02 9.137547000E-05 9.625808204E+02 7.011023384E+06
+ 1.103683996E+07 2.872349611E+02 8.724268439E-05 9.482147290E+02 7.061699450E+06
+ 1.119159262E+07 2.740354750E+02 8.329208961E-05 9.338486376E+02 7.113129922E+06
+ 1.134634529E+07 2.614409446E+02 7.951587463E-05 9.194825461E+02 7.165365176E+06
+ 1.150109795E+07 2.494197315E+02 7.590655320E-05 9.051164547E+02 7.218403345E+06
+ 1.165585061E+07 2.379473713E+02 7.245695084E-05 8.907503633E+02 7.272243891E+06
+ 1.181060327E+07 2.269850814E+02 6.916019224E-05 8.763842718E+02 7.326966513E+06
+ 1.196535593E+07 2.165285450E+02 6.600968924E-05 8.620181804E+02 7.382572079E+06
+ 1.212010860E+07 2.065485462E+02 6.299912922E-05 8.476520890E+02 7.439063137E+06
+ 1.227486126E+07 1.970242292E+02 6.012246395E-05 8.332859975E+02 7.496525343E+06
+ 1.242961392E+07 1.879347606E+02 5.737389885E-05 8.189199061E+02 7.554963599E+06
+ 1.258436658E+07 1.792610882E+02 5.474788276E-05 8.045538147E+02 7.614383738E+06
+ 1.273911925E+07 1.709845511E+02 5.223909800E-05 7.901877232E+02 7.674848254E+06
+ 1.289387191E+07 1.630886268E+02 4.984245089E-05 7.758216318E+02 7.736450152E+06
+ 1.304862457E+07 1.555540062E+02 4.755306261E-05 7.614555404E+02 7.799154800E+06
+ 1.320337723E+07 1.483584154E+02 4.536626042E-05 7.470894489E+02 7.862995664E+06
+ 1.335812989E+07 1.415008086E+02 4.327756926E-05 7.327233575E+02 7.928079791E+06
+ 1.351288256E+07 1.349589998E+02 4.128270362E-05 7.183572661E+02 7.994423514E+06
+ 1.366763522E+07 1.287191467E+02 3.937755981E-05 7.039911746E+02 8.062043906E+06
+ 1.382238788E+07 1.227670733E+02 3.755820845E-05 6.896250832E+02 8.131061863E+06
+ 1.397714054E+07 1.170901532E+02 3.582088732E-05 6.752589918E+02 8.201500129E+06
+ 1.413189321E+07 1.116758531E+02 3.416199447E-05 6.608929003E+02 8.273419692E+06
+ 1.428664587E+07 1.065175217E+02 3.257808162E-05 6.465268089E+02 8.346884996E+06
+ 1.444139853E+07 1.015935200E+02 3.106584778E-05 6.321607175E+02 8.421927427E+06
+ 1.459615119E+07 9.689819391E+01 2.962213318E-05 6.177946260E+02 8.498735031E+06
+ 1.475090386E+07 9.242106130E+01 2.824391340E-05 6.034285346E+02 8.577232227E+06
+ 1.490565652E+07 8.815256527E+01 2.692829378E-05 5.890624432E+02 8.657618951E+06
+ 1.506040918E+07 8.408263467E+01 2.567250399E-05 5.746963517E+02 8.739947942E+06
+ 1.521516184E+07 8.020257603E+01 2.447389287E-05 5.603302603E+02 8.824317209E+06
+ 1.536991450E+07 7.650361739E+01 2.332992348E-05 5.459641689E+02 8.910831055E+06
+ 1.552466717E+07 7.297880814E+01 2.223816828E-05 5.315980774E+02 8.999603483E+06
+ 1.567941983E+07 6.961773900E+01 2.119630461E-05 5.172319860E+02 9.090757170E+06
+ 1.583417249E+07 6.642141335E+01 2.020211027E-05 5.028658946E+02 9.184433310E+06
+ 1.598892515E+07 6.336837965E+01 1.925345931E-05 4.884998031E+02 9.280760756E+06
+ 1.614367782E+07 6.045841099E+01 1.834831798E-05 4.741337117E+02 9.379954313E+06
+ 1.629843048E+07 5.768525053E+01 1.748474088E-05 4.597676203E+02 9.482037357E+06
+ 1.645318314E+07 5.504250597E+01 1.666086720E-05 4.454015288E+02 9.587402150E+06
+ 1.660793580E+07 5.252621334E+01 1.587491716E-05 4.310354374E+02 9.696098632E+06
+ 1.676268847E+07 5.012412549E+01 1.512518862E-05 4.166693460E+02 9.808406748E+06
+ 1.691744113E+07 4.784540186E+01 1.441005376E-05 4.023032545E+02 9.924640947E+06
+ 1.707219379E+07 4.566723048E+01 1.372795593E-05 3.879371631E+02 1.004495945E+07
+ 1.722694645E+07 4.359201210E+01 1.307740666E-05 3.735710717E+02 1.016979566E+07
+ 1.738169911E+07 4.162234573E+01 1.245698273E-05 3.592049802E+02 1.029937277E+07
+ 1.753645178E+07 3.973915419E+01 1.186532340E-05 3.448388888E+02 1.043420995E+07
+ 1.769120444E+07 3.792886666E+01 1.130112777E-05 3.304727974E+02 1.057464792E+07
+ 1.784595710E+07 3.623664141E+01 1.076315221E-05 3.161067059E+02 1.072125944E+07
+ 1.800070976E+07 3.461035069E+01 1.025020789E-05 3.017406145E+02 1.087457238E+07
+ 1.815546243E+07 3.306025771E+01 9.761158484E-06 2.873745231E+02 1.103524218E+07
+ 1.831021509E+07 3.159128992E+01 9.294917866E-06 2.730084316E+02 1.120401984E+07
+ 1.846496775E+07 3.018577299E+01 8.850447996E-06 2.586423402E+02 1.138168595E+07
+ 1.861972041E+07 2.885399622E+01 8.426756833E-06 2.442762488E+02 1.156952719E+07
+ 1.877447307E+07 2.757936898E+01 8.022896360E-06 2.299101573E+02 1.176862878E+07
+ 1.892922574E+07 2.636558571E+01 7.637960685E-06 2.155440659E+02 1.198038961E+07
+ 1.908397840E+07 2.521477206E+01 7.271084221E-06 2.011779745E+02 1.220646324E+07
+ 1.923873106E+07 2.411442327E+01 6.921439948E-06 1.868118830E+02 1.244921224E+07
+ 1.939348372E+07 2.306682255E+01 6.588237740E-06 1.724457916E+02 1.271117641E+07
+ 1.954823639E+07 2.206932173E+01 6.270722765E-06 1.580797002E+02 1.299588867E+07
+ 1.970298905E+07 2.112736656E+01 5.968173955E-06 1.437136087E+02 1.330750253E+07
+ 1.985774171E+07 2.023052922E+01 5.679902536E-06 1.293475173E+02 1.365175543E+07
+ 2.001249437E+07 1.937024922E+01 5.405250623E-06 1.149814259E+02 1.403679337E+07
+ 2.016724704E+07 1.855248594E+01 5.143589875E-06 1.006153344E+02 1.447293993E+07
+ 2.032199970E+07 1.777289447E+01 4.894320201E-06 8.624924299E+01 1.497712990E+07
+ 2.047675236E+07 1.703814528E+01 4.656868528E-06 7.188315156E+01 1.557442311E+07
+ 2.063150502E+07 1.633224375E+01 4.430687620E-06 5.751706013E+01 1.630800881E+07
+ 2.078625768E+07 1.566722333E+01 4.215254938E-06 4.315096869E+01 1.726113014E+07
+ 2.094101035E+07 1.502765679E+01 4.010071566E-06 2.878487726E+01 1.862783761E+07
+ 2.109576301E+07 1.441878583E+01 3.814661162E-06 1.441878583E+01 2.109576301E+07
+ 2.136218891E+07 1.340638158E+01 3.666650033E-06 1.427464960E+01 2.113256071E+07
+ 2.162861480E+07 1.246341498E+01 3.414995751E-06 1.413051337E+01 2.116972062E+07
+ 2.189504070E+07 1.158520513E+01 3.180176711E-06 1.398637714E+01 2.120725367E+07
+ 2.216146659E+07 1.076744235E+01 2.961097659E-06 1.384224091E+01 2.124516298E+07
+ 2.242789249E+07 1.000605737E+01 2.756732444E-06 1.369810468E+01 2.128345732E+07
+ 2.269431839E+07 9.297281819E+00 2.566119800E-06 1.355396845E+01 2.132215100E+07
+ 2.296074428E+07 8.637560343E+00 2.388359385E-06 1.340983222E+01 2.136124791E+07
+ 2.322717018E+07 8.023587954E+00 2.222608042E-06 1.326569598E+01 2.140075666E+07
+ 2.349359607E+07 7.452251147E+00 2.068076291E-06 1.312155975E+01 2.144068614E+07
+ 2.376002197E+07 6.920682860E+00 1.924025021E-06 1.297742352E+01 2.148104127E+07
+ 2.402644787E+07 6.426165956E+00 1.789762386E-06 1.283328729E+01 2.152184006E+07
+ 2.429287376E+07 5.966191276E+00 1.664640874E-06 1.268915106E+01 2.156308806E+07
+ 2.455929966E+07 5.538410972E+00 1.548054564E-06 1.254501483E+01 2.160479541E+07
+ 2.482572555E+07 5.140586901E+00 1.439436535E-06 1.240087860E+01 2.164697261E+07
+ 2.509215145E+07 4.770734304E+00 1.338256442E-06 1.225674237E+01 2.168963050E+07
+ 2.535857735E+07 4.426889929E+00 1.244018225E-06 1.211260614E+01 2.173278033E+07
+ 2.562500324E+07 4.107277395E+00 1.156257965E-06 1.196846991E+01 2.177642756E+07
+ 2.589142914E+07 3.810235395E+00 1.074541870E-06 1.182433368E+01 2.182059535E+07
+ 2.615785503E+07 3.534223603E+00 9.984643750E-07 1.168019745E+01 2.186529034E+07
+ 2.642428093E+07 3.277729427E+00 9.276463648E-07 1.153606122E+01 2.191052648E+07
+ 2.669070683E+07 3.039480492E+00 8.617335022E-07 1.139192499E+01 2.195631921E+07
+ 2.695713272E+07 2.818162759E+00 8.003946584E-07 1.124778876E+01 2.200267387E+07
+ 2.722355862E+07 2.612591785E+00 7.433204391E-07 1.110365253E+01 2.204961802E+07
+ 2.748998451E+07 2.421726245E+00 6.902218014E-07 1.095951630E+01 2.209716021E+07
+ 2.775641041E+07 2.244494880E+00 6.408287561E-07 1.081538007E+01 2.214531607E+07
+ 2.802283631E+07 2.079953576E+00 5.948891490E-07 1.067124384E+01 2.219409764E+07
+ 2.828926220E+07 1.927223702E+00 5.521675185E-07 1.052710761E+01 2.224353030E+07
+ 2.855568810E+07 1.785463855E+00 5.124440231E-07 1.038297138E+01 2.229362747E+07
+ 2.882211399E+07 1.653897716E+00 4.755134365E-07 1.023883515E+01 2.234440242E+07
+ 2.908853989E+07 1.531855487E+00 4.411842040E-07 1.009469892E+01 2.239587959E+07
+ 2.935496579E+07 1.418604456E+00 4.092775590E-07 9.950562695E+00 2.244807857E+07
+ 2.962139168E+07 1.313567900E+00 3.796266940E-07 9.806426465E+00 2.250102524E+07
+ 2.988781758E+07 1.216140600E+00 3.520759839E-07 9.662290235E+00 2.255473641E+07
+ 3.015424347E+07 1.125788520E+00 3.264802579E-07 9.518154005E+00 2.260923478E+07
+ 3.042066937E+07 1.042017765E+00 3.027041176E-07 9.374017775E+00 2.266454412E+07
+ 3.068709527E+07 9.643410214E-01 2.806212979E-07 9.229881545E+00 2.272068263E+07
+ 3.095352116E+07 8.923562005E-01 2.601140686E-07 9.085745315E+00 2.277768793E+07
+ 3.121994706E+07 8.256065454E-01 2.410726736E-07 8.941609085E+00 2.283558106E+07
+ 3.148637295E+07 7.637509192E-01 2.233948062E-07 8.797472855E+00 2.289439184E+07
+ 3.175279885E+07 7.064609646E-01 2.069851176E-07 8.653336625E+00 2.295414435E+07
+ 3.201922475E+07 6.533652837E-01 1.917547570E-07 8.509200395E+00 2.301488429E+07
+ 3.228565064E+07 6.041932869E-01 1.776209410E-07 8.365064165E+00 2.307663630E+07
+ 3.255207654E+07 5.586329600E-01 1.645065508E-07 8.220927935E+00 2.313943148E+07
+ 3.281850243E+07 5.164466182E-01 1.523397551E-07 8.076791705E+00 2.320330850E+07
+ 3.308492833E+07 4.773664473E-01 1.410536575E-07 7.932655475E+00 2.326831270E+07
+ 3.335135423E+07 4.412177046E-01 1.305859672E-07 7.788519245E+00 2.333447448E+07
+ 3.361778012E+07 4.077241880E-01 1.208786896E-07 7.644383015E+00 2.340183621E+07
+ 3.388420602E+07 3.767267616E-01 1.118778388E-07 7.500246785E+00 2.347045951E+07
+ 3.415063191E+07 3.480591462E-01 1.035331676E-07 7.356110555E+00 2.354038173E+07
+ 3.441705781E+07 3.215068474E-01 9.579791547E-08 7.211974325E+00 2.361165370E+07
+ 3.468348371E+07 2.969622443E-01 8.862857319E-08 7.067838095E+00 2.368432927E+07
+ 3.494990960E+07 2.742353081E-01 8.198466263E-08 6.923701865E+00 2.375845310E+07
+ 3.521633550E+07 2.532360371E-01 7.582853123E-08 6.779565635E+00 2.383410379E+07
+ 3.548276139E+07 2.337971721E-01 7.012515989E-08 6.635429405E+00 2.391133666E+07
+ 3.574918729E+07 2.158284759E-01 6.484198359E-08 6.491293175E+00 2.399023547E+07
+ 3.601561319E+07 1.991922958E-01 5.994872392E-08 6.347156945E+00 2.407086031E+07
+ 3.628203908E+07 1.838483518E-01 5.541723258E-08 6.203020715E+00 2.415328988E+07
+ 3.654846498E+07 1.696537083E-01 5.122134547E-08 6.058884485E+00 2.423760656E+07
+ 3.681489087E+07 1.565302044E-01 4.733674633E-08 5.914748255E+00 2.432390645E+07
+ 3.708131677E+07 1.444032220E-01 4.374083959E-08 5.770612025E+00 2.441227980E+07
+ 3.734774267E+07 1.332043126E-01 4.041263170E-08 5.626475795E+00 2.450284479E+07
+ 3.761416856E+07 1.228473043E-01 3.733262039E-08 5.482339565E+00 2.459569217E+07
+ 3.788059446E+07 1.132843346E-01 3.448269143E-08 5.338203335E+00 2.469095742E+07
+ 3.814702035E+07 1.044400635E-01 3.184602225E-08 5.194067105E+00 2.478877024E+07
+ 3.841344625E+07 9.628861406E-02 2.940699218E-08 5.049930875E+00 2.488925973E+07
+ 3.867987215E+07 8.876798646E-02 2.715109869E-08 4.905794645E+00 2.499259748E+07
+ 3.894629804E+07 8.181732224E-02 2.506487931E-08 4.761658415E+00 2.509894025E+07
+ 3.921272394E+07 7.540350248E-02 2.313583889E-08 4.617522185E+00 2.520846905E+07
+ 3.947914983E+07 6.947843114E-02 2.135238176E-08 4.473385955E+00 2.532138828E+07
+ 3.974557573E+07 6.400975365E-02 1.970374860E-08 4.329249725E+00 2.543791698E+07
+ 4.001200163E+07 5.896658175E-02 1.817995753E-08 4.185113495E+00 2.555830397E+07
+ 4.027842752E+07 5.430382031E-02 1.677174931E-08 4.040977265E+00 2.568280657E+07
+ 4.054485342E+07 5.002562864E-02 1.547053630E-08 3.896841035E+00 2.581170330E+07
+ 4.081127931E+07 4.605895191E-02 1.426835483E-08 3.752704805E+00 2.594537387E+07
+ 4.107770521E+07 4.240288961E-02 1.315782105E-08 3.608568575E+00 2.608414093E+07
+ 4.134413111E+07 3.904021514E-02 1.213208961E-08 3.464432344E+00 2.622842475E+07
+ 4.161055700E+07 3.594067169E-02 1.118481537E-08 3.320296114E+00 2.637869803E+07
+ 4.187698290E+07 3.307300327E-02 1.031011770E-08 3.176159884E+00 2.653548000E+07
+ 4.214340879E+07 3.044779672E-02 9.502547241E-09 3.032023654E+00 2.669936382E+07
+ 4.240983469E+07 2.800652695E-02 8.757055035E-09 2.887887424E+00 2.687104179E+07
+ 4.267626059E+07 2.576821002E-02 8.068963772E-09 2.743751194E+00 2.705131560E+07
+ 4.294268648E+07 2.369841533E-02 7.433941068E-09 2.599614964E+00 2.724106223E+07
+ 4.320911238E+07 2.179778872E-02 6.847974607E-09 2.455478734E+00 2.744140412E+07
+ 4.347553827E+07 2.005049716E-02 6.307349037E-09 2.311342504E+00 2.765356337E+07
+ 4.374196417E+07 1.842716772E-02 5.808624490E-09 2.167206274E+00 2.787912024E+07
+ 4.400839007E+07 1.695304688E-02 5.348616613E-09 2.023070044E+00 2.811974587E+07
+ 4.427481596E+07 1.558076542E-02 4.924378020E-09 1.878933814E+00 2.837779437E+07
+ 4.454124186E+07 1.433727451E-02 4.533181047E-09 1.734797584E+00 2.865595124E+07
+ 4.480766775E+07 1.314881917E-02 4.172501745E-09 1.590661354E+00 2.895769110E+07
+ 4.507409365E+07 1.210087277E-02 3.840004994E-09 1.446525124E+00 2.928740710E+07
+ 4.534051955E+07 1.112534471E-02 3.533530696E-09 1.302388894E+00 2.965095635E+07
+ 4.560694544E+07 1.021563614E-02 3.251080939E-09 1.158252664E+00 3.005613801E+07
+ 4.587337134E+07 9.385828042E-03 2.990808092E-09 1.014116434E+00 3.051405107E+07
+ 4.613979723E+07 8.608879839E-03 2.751003742E-09 8.699802044E-01 3.104057449E+07
+ 4.640622313E+07 7.915955918E-03 2.530088437E-09 7.258439744E-01 3.166031783E+07
+ 4.667264903E+07 7.265980477E-03 2.326602156E-09 5.817077443E-01 3.241454382E+07
+ 4.693907492E+07 6.671958352E-03 2.139195479E-09 4.375715143E-01 3.337942697E+07
+ 4.720550082E+07 6.120572470E-03 1.966621382E-09 2.934352843E-01 3.472346336E+07
+ 4.747192671E+07 5.614994271E-03 1.807727636E-09 1.492990543E-01 3.697090427E+07
+ 4.773835261E+07 5.162824316E-03 1.661449755E-09 5.162824316E-03 4.773835200E+07
+ 4.778998085E+07 5.111196073E-03 1.000000000E-09 5.111196073E-03 4.778998086E+07
+ 4.784160910E+07 5.059567830E-03 1.000000000E-09 5.059567830E-03 4.784160910E+07
+ 4.789323734E+07 5.007939587E-03 1.000000000E-09 5.007939587E-03 4.789323700E+07
+ 4.794486558E+07 4.956311344E-03 1.000000000E-09 4.956311344E-03 4.794486558E+07
+ 4.799649383E+07 4.904683100E-03 1.000000000E-09 4.904683100E-03 4.799649382E+07
+ 4.804812207E+07 4.853054857E-03 1.000000000E-09 4.853054857E-03 4.804812100E+07
+ 4.809975031E+07 4.801426614E-03 1.000000000E-09 4.801426614E-03 4.809975100E+07
+ 4.815137856E+07 4.749798371E-03 1.000000000E-09 4.749798371E-03 4.815137600E+07
+ 4.820300680E+07 4.698170128E-03 1.000000000E-09 4.698170128E-03 4.820299200E+07
+ 4.825463504E+07 4.646541885E-03 1.000000000E-09 4.646541885E-03 4.825463504E+07
+ 4.830626329E+07 4.594913641E-03 1.000000000E-09 4.594913641E-03 4.830627200E+07
+ 4.835789153E+07 4.543285398E-03 1.000000000E-09 4.543285398E-03 4.835789000E+07
+ 4.840951977E+07 4.491657155E-03 1.000000000E-09 4.491657155E-03 4.840952000E+07
+ 4.846114801E+07 4.440028912E-03 1.000000000E-09 4.440028912E-03 4.846114801E+07
+ 4.851277626E+07 4.388400669E-03 1.000000000E-09 4.388400669E-03 4.851277700E+07
+ 4.856440450E+07 4.336772426E-03 1.000000000E-09 4.336772426E-03 4.856440450E+07
+ 4.861603274E+07 4.285144182E-03 1.000000000E-09 4.285144182E-03 4.861603275E+07
+ 4.866766099E+07 4.233515939E-03 1.000000000E-09 4.233515939E-03 4.866766094E+07
+ 4.871928923E+07 4.181887696E-03 1.000000000E-09 4.181887696E-03 4.871928919E+07
+ 4.877091747E+07 4.130259453E-03 1.000000000E-09 4.130259453E-03 4.877091744E+07
+ 4.882254572E+07 4.078631210E-03 1.000000000E-09 4.078631210E-03 4.882254573E+07
+ 4.887417396E+07 4.027002967E-03 1.000000000E-09 4.027002967E-03 4.887417498E+07
+ 4.892580220E+07 3.975374723E-03 1.000000000E-09 3.975374723E-03 4.892580200E+07
+ 4.897743045E+07 3.923746480E-03 1.000000000E-09 3.923746480E-03 4.897743000E+07
+ 4.902905869E+07 3.872118237E-03 1.000000000E-09 3.872118237E-03 4.902905600E+07
+ 4.908068693E+07 3.820489994E-03 1.000000000E-09 3.820489994E-03 4.908068700E+07
+ 4.913231518E+07 3.768861751E-03 1.000000000E-09 3.768861751E-03 4.913231518E+07
+ 4.918394342E+07 3.717233508E-03 1.000000000E-09 3.717233508E-03 4.918394712E+07
+ 4.923557166E+07 3.665605264E-03 1.000000000E-09 3.665605264E-03 4.923554287E+07
+ 4.928719991E+07 3.613977021E-03 1.000000000E-09 3.613977021E-03 4.928716800E+07
+ 4.933882815E+07 3.562348778E-03 1.000000000E-09 3.562348778E-03 4.933882815E+07
+ 4.939045639E+07 3.510720535E-03 1.000000000E-09 3.510720535E-03 4.939045619E+07
+ 4.944208463E+07 3.459092292E-03 1.000000000E-09 3.459092292E-03 4.944208469E+07
+ 4.949371288E+07 3.407464049E-03 1.000000000E-09 3.407464049E-03 4.949371288E+07
+ 4.954534112E+07 3.355835806E-03 1.000000000E-09 3.355835806E-03 4.954534112E+07
+ 4.959696936E+07 3.304207562E-03 1.000000000E-09 3.304207562E-03 4.959696937E+07
+ 4.964859761E+07 3.252579319E-03 1.000000000E-09 3.252579319E-03 4.964859761E+07
+ 4.970022585E+07 3.200951076E-03 1.000000000E-09 3.200951076E-03 4.970022600E+07
+ 4.975185409E+07 3.149322833E-03 1.000000000E-09 3.149322833E-03 4.975185409E+07
+ 4.980348234E+07 3.097694590E-03 1.000000000E-09 3.097694590E-03 4.980351263E+07
+ 4.985511058E+07 3.046066347E-03 1.000000000E-09 3.046066347E-03 4.985514636E+07
+ 4.990673882E+07 2.994438103E-03 1.000000000E-09 2.994438103E-03 4.990673900E+07
+ 4.995836707E+07 2.942809860E-03 1.000000000E-09 2.942809860E-03 4.995836707E+07
+ 5.000999531E+07 2.891181617E-03 1.000000000E-09 2.891181617E-03 5.000999531E+07
+ 5.006162355E+07 2.839553374E-03 1.000000000E-09 2.839553374E-03 5.006162355E+07
+ 5.011325180E+07 2.787925131E-03 1.000000000E-09 2.787925131E-03 5.011325181E+07
+ 5.016488004E+07 2.736296888E-03 1.000000000E-09 2.736296888E-03 5.016488100E+07
+ 5.021650828E+07 2.684668644E-03 1.000000000E-09 2.684668644E-03 5.021653651E+07
+ 5.026813653E+07 2.633040401E-03 1.000000000E-09 2.633040401E-03 5.026813676E+07
+ 5.031976477E+07 2.581412158E-03 1.000000000E-09 2.581412158E-03 5.031976487E+07
+ 5.037139301E+07 2.529783915E-03 1.000000000E-09 2.529783915E-03 5.037140800E+07
+ 5.042302126E+07 2.478155672E-03 1.000000000E-09 2.478155672E-03 5.042302126E+07
+ 5.047464950E+07 2.426527429E-03 1.000000000E-09 2.426527429E-03 5.047464950E+07
+ 5.052627774E+07 2.374899185E-03 1.000000000E-09 2.374899185E-03 5.052627800E+07
+ 5.057790598E+07 2.323270942E-03 1.000000000E-09 2.323270942E-03 5.057790600E+07
+ 5.062953423E+07 2.271642699E-03 1.000000000E-09 2.271642699E-03 5.062953423E+07
+ 5.068116247E+07 2.220014456E-03 1.000000000E-09 2.220014456E-03 5.068116247E+07
+ 5.073279071E+07 2.168386213E-03 1.000000000E-09 2.168386213E-03 5.073281753E+07
+ 5.078441896E+07 2.116757970E-03 1.000000000E-09 2.116757970E-03 5.078441896E+07
+ 5.083604720E+07 2.065129726E-03 1.000000000E-09 2.065129726E-03 5.083604800E+07
+ 5.088767544E+07 2.013501483E-03 1.000000000E-09 2.013501483E-03 5.088767772E+07
+ 5.093930369E+07 1.961873240E-03 1.000000000E-09 1.961873240E-03 5.093934784E+07
+ 5.099093193E+07 1.910244997E-03 1.000000000E-09 1.910244997E-03 5.099093100E+07
+ 5.104256017E+07 1.858616754E-03 1.000000000E-09 1.858616754E-03 5.104256018E+07
+ 5.109418842E+07 1.806988511E-03 1.000000000E-09 1.806988511E-03 5.109418842E+07
+ 5.114581666E+07 1.755360267E-03 1.000000000E-09 1.755360267E-03 5.114581700E+07
+ 5.119744490E+07 1.703732024E-03 1.000000000E-09 1.703732024E-03 5.119744500E+07
+ 5.124907315E+07 1.652103781E-03 1.000000000E-09 1.652103781E-03 5.124911257E+07
+ 5.130070139E+07 1.600475538E-03 1.000000000E-09 1.600475538E-03 5.130070200E+07
+ 5.135232963E+07 1.548847295E-03 1.000000000E-09 1.548847295E-03 5.135232982E+07
+ 5.140395788E+07 1.497219052E-03 1.000000000E-09 1.497219052E-03 5.140395788E+07
+ 5.145558612E+07 1.445590809E-03 1.000000000E-09 1.445590809E-03 5.145558612E+07
+ 5.150721436E+07 1.393962565E-03 1.000000000E-09 1.393962565E-03 5.150721600E+07
+ 5.155884260E+07 1.342334322E-03 1.000000000E-09 1.342334322E-03 5.155885152E+07
+ 5.161047085E+07 1.290706079E-03 1.000000000E-09 1.290706079E-03 5.161047542E+07
+ 5.166209909E+07 1.239077836E-03 1.000000000E-09 1.239077836E-03 5.166214590E+07
+ 5.171372733E+07 1.187449593E-03 1.000000000E-09 1.187449593E-03 5.171372733E+07
+ 5.176535558E+07 1.135821350E-03 1.000000000E-09 1.135821350E-03 5.176535558E+07
+ 5.181698382E+07 1.084193106E-03 1.000000000E-09 1.084193106E-03 5.181698382E+07
+ 5.186861206E+07 1.032564863E-03 1.000000000E-09 1.032564863E-03 5.186861206E+07
+ 5.192024031E+07 9.809366201E-04 1.000000000E-09 9.809366201E-04 5.192024031E+07
+ 5.197186855E+07 9.293083769E-04 1.000000000E-09 9.293083769E-04 5.197186855E+07
+ 5.202349679E+07 8.776801337E-04 1.000000000E-09 8.776801337E-04 5.202349838E+07
+ 5.207512504E+07 8.260518906E-04 1.000000000E-09 8.260518906E-04 5.207512504E+07
+ 5.212675328E+07 7.744236474E-04 1.000000000E-09 7.744236474E-04 5.212675328E+07
+ 5.217838152E+07 7.227954043E-04 1.000000000E-09 7.227954043E-04 5.217836800E+07
+ 5.223000977E+07 6.711671611E-04 1.000000000E-09 6.711671611E-04 5.223000977E+07
+ 5.228163801E+07 6.195389179E-04 1.000000000E-09 6.195389179E-04 5.228163200E+07
+ 5.233326625E+07 5.679106748E-04 1.000000000E-09 5.679106748E-04 5.233326625E+07
+ 5.238489450E+07 5.162824316E-04 1.000000000E-09 5.162824316E-04 5.238489450E+07
+ 5.243652274E+07 4.646541885E-04 1.000000000E-09 4.646541885E-04 5.243652274E+07
+ 5.248815098E+07 4.130259453E-04 1.000000000E-09 4.130259453E-04 5.248815098E+07
+ 5.253977922E+07 3.613977021E-04 1.000000000E-09 3.613977021E-04 5.253978000E+07
+ 5.259140747E+07 3.097694590E-04 1.000000000E-09 3.097694590E-04 5.259145960E+07
+ 5.264303571E+07 2.581412158E-04 1.000000000E-09 2.581412158E-04 5.264304000E+07
+ 5.269466395E+07 2.065129726E-04 1.000000000E-09 2.065129726E-04 5.269466395E+07
+ 5.274629220E+07 1.548847295E-04 1.000000000E-09 1.548847295E-04 5.274629220E+07
+ 5.279792044E+07 1.032564863E-04 1.000000000E-09 1.032564863E-04 5.279792044E+07
+ 5.284954868E+07 5.162824316E-05 1.000000000E-09 5.162824316E-05 5.284959510E+07
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM84
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM84	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM84	(revision 286)
@@ -0,0 +1,501 @@
+DENSITY AND THICKNESS DATA OF THE ATMOSPHERE AT AN ZENITH ANGLE OF 84.0 DEGREES
+ 0.000000000E+00 9.091060108E+03 1.229805824E-03 9.091060108E+03 0.000000000E+00
+ 3.723783039E+04 9.045548428E+03 1.224999006E-03 9.053288909E+03 3.080360606E+04
+ 7.447566078E+04 8.999987223E+03 1.220208334E-03 9.015517710E+03 6.170739853E+04
+ 1.117134912E+05 8.954604273E+03 1.215433765E-03 8.977746511E+03 9.271024615E+04
+ 1.489513216E+05 8.909398538E+03 1.210675256E-03 8.939975311E+03 1.238138784E+05
+ 1.861891519E+05 8.864603698E+03 1.205932766E-03 8.902204112E+03 1.550185976E+05
+ 2.234269823E+05 8.819749677E+03 1.201206253E-03 8.864432913E+03 1.863292030E+05
+ 2.606648127E+05 8.775071538E+03 1.196495673E-03 8.826661714E+03 2.175484329E+05
+ 2.979026431E+05 8.730568238E+03 1.191800985E-03 8.788890515E+03 2.490593525E+05
+ 3.351404735E+05 8.686240535E+03 1.187122148E-03 8.751119316E+03 2.806741388E+05
+ 3.723783039E+05 8.642085604E+03 1.182459118E-03 8.713348117E+03 3.122051272E+05
+ 4.096161343E+05 8.598104204E+03 1.177811855E-03 8.675576918E+03 3.440292848E+05
+ 4.468539647E+05 8.554295311E+03 1.173180316E-03 8.637805719E+03 3.759587720E+05
+ 4.840917950E+05 8.510734253E+03 1.168564459E-03 8.600034520E+03 4.079954123E+05
+ 5.213296254E+05 8.467268595E+03 1.163964244E-03 8.562263321E+03 4.401395777E+05
+ 5.585674558E+05 8.423974145E+03 1.159379627E-03 8.524492122E+03 4.724578705E+05
+ 5.958052862E+05 8.381076919E+03 1.154810568E-03 8.486720923E+03 5.048202429E+05
+ 6.330431166E+05 8.338121031E+03 1.150257026E-03 8.448949723E+03 5.372927847E+05
+ 6.702809470E+05 8.295334624E+03 1.145718958E-03 8.411178524E+03 5.696792062E+05
+ 7.075187774E+05 8.252716681E+03 1.141196323E-03 8.373407325E+03 6.023733813E+05
+ 7.447566078E+05 8.210500475E+03 1.136689080E-03 8.335636126E+03 6.351789965E+05
+ 7.819944381E+05 8.168216662E+03 1.132197188E-03 8.297864927E+03 6.680979971E+05
+ 8.192322685E+05 8.126100049E+03 1.127720605E-03 8.260093728E+03 7.011308174E+05
+ 8.564700989E+05 8.084149621E+03 1.123259290E-03 8.222322529E+03 7.342825859E+05
+ 8.937079293E+05 8.042366153E+03 1.118813203E-03 8.184551330E+03 7.675459495E+05
+ 9.309457597E+05 8.000746852E+03 1.114382302E-03 8.146780131E+03 8.009260388E+05
+ 9.681835901E+05 7.959292497E+03 1.109966546E-03 8.109008932E+03 8.342239677E+05
+ 1.005421420E+06 7.918002090E+03 1.105565895E-03 8.071237733E+03 8.678385105E+05
+ 1.042659251E+06 7.877120156E+03 1.101180307E-03 8.033466534E+03 9.015732169E+05
+ 1.079897081E+06 7.836154919E+03 1.096809742E-03 7.995695335E+03 9.354270557E+05
+ 1.117134912E+06 7.795351950E+03 1.092454158E-03 7.957924136E+03 9.694020903E+05
+ 1.154372742E+06 7.754712027E+03 1.088113517E-03 7.920152936E+03 1.003498851E+06
+ 1.191610572E+06 7.714461159E+03 1.083787776E-03 7.882381737E+03 1.037735258E+06
+ 1.228848403E+06 7.674140949E+03 1.079476896E-03 7.844610538E+03 1.072078722E+06
+ 1.266086233E+06 7.633980797E+03 1.075180835E-03 7.806839339E+03 1.106547132E+06
+ 1.303324064E+06 7.593985083E+03 1.070899554E-03 7.769068140E+03 1.141141063E+06
+ 1.340561894E+06 7.554143830E+03 1.066633013E-03 7.731296941E+03 1.175862691E+06
+ 1.377799724E+06 7.514461450E+03 1.062381170E-03 7.693525742E+03 1.210711021E+06
+ 1.415037555E+06 7.474936958E+03 1.058143986E-03 7.655754543E+03 1.245688258E+06
+ 1.452275385E+06 7.435797410E+03 1.053921421E-03 7.617983344E+03 1.280795027E+06
+ 1.489513216E+06 7.396586035E+03 1.049713434E-03 7.580212145E+03 1.316245776E+06
+ 1.526751046E+06 7.357530920E+03 1.045519986E-03 7.542440946E+03 1.351615494E+06
+ 1.563988876E+06 7.318410593E+03 1.041341037E-03 7.504669747E+03 1.387117822E+06
+ 1.601226707E+06 7.279971250E+03 1.037176547E-03 7.466898548E+03 1.422755092E+06
+ 1.638464537E+06 7.241381747E+03 1.033026475E-03 7.429127348E+03 1.458526314E+06
+ 1.675702367E+06 7.202946816E+03 1.028890783E-03 7.391356149E+03 1.494433853E+06
+ 1.712940198E+06 7.164892895E+03 1.024769431E-03 7.353584950E+03 1.530695376E+06
+ 1.750178028E+06 7.126763076E+03 1.020662379E-03 7.315813751E+03 1.566668125E+06
+ 1.787415859E+06 7.088786241E+03 1.016569587E-03 7.278042552E+03 1.603062790E+06
+ 1.824653689E+06 7.051191183E+03 1.012491017E-03 7.240271353E+03 1.639525845E+06
+ 1.861891519E+06 7.013521046E+03 1.008426628E-03 7.202500154E+03 1.676130999E+06
+ 1.899129350E+06 6.975997270E+03 1.004376381E-03 7.164728955E+03 1.713098076E+06
+ 1.936367180E+06 6.938624380E+03 1.000340238E-03 7.126957756E+03 1.749989788E+06
+ 1.973605011E+06 6.901401407E+03 9.963181580E-04 7.089186557E+03 1.787027214E+06
+ 2.010842841E+06 6.864329163E+03 9.923101031E-04 7.051415358E+03 1.824435274E+06
+ 2.048080671E+06 6.827404919E+03 9.883160339E-04 7.013644159E+03 1.861771081E+06
+ 2.085318502E+06 6.790855523E+03 9.843359113E-04 6.975872960E+03 1.899251457E+06
+ 2.122556332E+06 6.754245204E+03 9.803696964E-04 6.938101761E+03 1.936882647E+06
+ 2.159794162E+06 6.717541270E+03 9.764173504E-04 6.900330561E+03 1.974665554E+06
+ 2.197031993E+06 6.681658301E+03 9.724788344E-04 6.862559362E+03 2.012602860E+06
+ 2.234269823E+06 6.645467944E+03 9.685541097E-04 6.824788163E+03 2.050920153E+06
+ 2.271507654E+06 6.609424745E+03 9.646431376E-04 6.787016964E+03 2.089165680E+06
+ 2.308745484E+06 6.573525934E+03 9.607458796E-04 6.749245765E+03 2.127587710E+06
+ 2.345983314E+06 6.537772367E+03 9.568622970E-04 6.711474566E+03 2.166510338E+06
+ 2.383221145E+06 6.502163095E+03 9.529923515E-04 6.673703367E+03 2.205100928E+06
+ 2.420458975E+06 6.466702426E+03 9.491360045E-04 6.635932168E+03 2.243983065E+06
+ 2.457696806E+06 6.431606296E+03 9.452932178E-04 6.598160969E+03 2.283029608E+06
+ 2.494934636E+06 6.396425554E+03 9.414639531E-04 6.560389770E+03 2.322472295E+06
+ 2.532172466E+06 6.361388433E+03 9.376481721E-04 6.522618571E+03 2.361846792E+06
+ 2.569410297E+06 6.326720489E+03 9.338458369E-04 6.484847372E+03 2.401630814E+06
+ 2.606648127E+06 6.291964008E+03 9.300569091E-04 6.447076173E+03 2.441340321E+06
+ 2.643885958E+06 6.257348326E+03 9.262813510E-04 6.409304973E+03 2.481221111E+06
+ 2.681123788E+06 6.222950162E+03 9.225191245E-04 6.371533774E+03 2.521274400E+06
+ 2.718361618E+06 6.188614372E+03 9.187701917E-04 6.333762575E+03 2.561739125E+06
+ 2.755599449E+06 6.154418360E+03 9.150345149E-04 6.295991376E+03 2.602382526E+06
+ 2.792837279E+06 6.120361195E+03 9.113120563E-04 6.258220177E+03 2.642958494E+06
+ 2.830075109E+06 6.086669552E+03 9.076027783E-04 6.220448978E+03 2.683795704E+06
+ 2.867312940E+06 6.052887195E+03 9.039066432E-04 6.182677779E+03 2.724731401E+06
+ 2.904550770E+06 6.019242226E+03 9.002236136E-04 6.144906580E+03 2.766092475E+06
+ 2.941788601E+06 5.985967514E+03 8.965536519E-04 6.107135381E+03 2.807641944E+06
+ 2.979026431E+06 5.952594157E+03 8.928967208E-04 6.069364182E+03 2.849125589E+06
+ 3.016264261E+06 5.919357190E+03 8.892527829E-04 6.031592983E+03 2.890798091E+06
+ 3.053502092E+06 5.886255687E+03 8.856218010E-04 5.993821784E+03 2.932912392E+06
+ 3.090739922E+06 5.853290498E+03 8.820037378E-04 5.956050585E+03 2.975215753E+06
+ 3.127977753E+06 5.820685893E+03 8.783985563E-04 5.918279385E+03 3.017457913E+06
+ 3.165215583E+06 5.787986425E+03 8.748062194E-04 5.880508186E+03 3.059896312E+06
+ 3.202453413E+06 5.755439724E+03 8.712266901E-04 5.842736987E+03 3.102783388E+06
+ 3.239691244E+06 5.723236873E+03 8.676599315E-04 5.804965788E+03 3.145870793E+06
+ 3.276929074E+06 5.690935198E+03 8.641059067E-04 5.767194589E+03 3.188902244E+06
+ 3.314166905E+06 5.658765674E+03 8.605645789E-04 5.729423390E+03 3.232414452E+06
+ 3.351404735E+06 5.626729177E+03 8.570359115E-04 5.691652191E+03 3.276112619E+06
+ 3.388642565E+06 5.594823008E+03 8.535198677E-04 5.653880992E+03 3.319755131E+06
+ 3.425880396E+06 5.563048046E+03 8.500164110E-04 5.616109793E+03 3.363869679E+06
+ 3.463118226E+06 5.531633312E+03 8.465255049E-04 5.578338594E+03 3.408196163E+06
+ 3.500356056E+06 5.500116403E+03 8.430471129E-04 5.540567395E+03 3.452469545E+06
+ 3.537593887E+06 5.468958924E+03 8.395811987E-04 5.502796196E+03 3.497229258E+06
+ 3.574831717E+06 5.437698457E+03 8.361277259E-04 5.465024997E+03 3.542203079E+06
+ 3.612069548E+06 5.406567796E+03 8.326866583E-04 5.427253798E+03 3.587127791E+06
+ 3.649307378E+06 5.375564231E+03 8.292579597E-04 5.389482598E+03 3.632544019E+06
+ 3.686545208E+06 5.344688664E+03 8.258415941E-04 5.351711399E+03 3.678185143E+06
+ 3.723783039E+06 5.313940200E+03 8.224375253E-04 5.313940200E+03 3.723783039E+06
+ 3.776245924E+06 5.270252372E+03 8.213250183E-04 5.282383480E+03 3.761637270E+06
+ 3.828708810E+06 5.227461929E+03 8.159244415E-04 5.250826760E+03 3.800429526E+06
+ 3.881171695E+06 5.184911579E+03 8.105554389E-04 5.219270040E+03 3.839369885E+06
+ 3.933634581E+06 5.142645748E+03 8.052178548E-04 5.187713320E+03 3.877753241E+06
+ 3.986097466E+06 5.100661621E+03 7.999115342E-04 5.156156600E+03 3.916357015E+06
+ 4.038560352E+06 5.058370351E+03 7.946363224E-04 5.124599880E+03 3.955831985E+06
+ 4.091023237E+06 5.016931462E+03 7.893920654E-04 5.093043160E+03 3.995517943E+06
+ 4.143486123E+06 4.975767218E+03 7.841786100E-04 5.061486440E+03 4.034680730E+06
+ 4.195949008E+06 4.934879242E+03 7.789958032E-04 5.029929720E+03 4.074754308E+06
+ 4.248411894E+06 4.894264762E+03 7.738434927E-04 4.998373000E+03 4.115041779E+06
+ 4.300874780E+06 4.853335845E+03 7.687215268E-04 4.966816280E+03 4.154782548E+06
+ 4.353337665E+06 4.813259412E+03 7.636297543E-04 4.935259560E+03 4.195466466E+06
+ 4.405800551E+06 4.773440962E+03 7.585680247E-04 4.903702841E+03 4.236372809E+06
+ 4.458263436E+06 4.733890728E+03 7.535361879E-04 4.872146121E+03 4.276712092E+06
+ 4.510726322E+06 4.694605980E+03 7.485340944E-04 4.840589401E+03 4.318042584E+06
+ 4.563189207E+06 4.654999711E+03 7.435615953E-04 4.809032681E+03 4.359587099E+06
+ 4.615652093E+06 4.616228540E+03 7.386185422E-04 4.777475961E+03 4.400545075E+06
+ 4.668114978E+06 4.577716043E+03 7.337047873E-04 4.745919241E+03 4.441758979E+06
+ 4.720577864E+06 4.539463908E+03 7.288201833E-04 4.714362521E+03 4.483917510E+06
+ 4.773040749E+06 4.501469446E+03 7.239645836E-04 4.682805801E+03 4.526313157E+06
+ 4.825503635E+06 4.463149302E+03 7.191378419E-04 4.651249081E+03 4.568179139E+06
+ 4.877966520E+06 4.425687081E+03 7.143398128E-04 4.619692361E+03 4.611018295E+06
+ 4.930429406E+06 4.388645412E+03 7.095703511E-04 4.588135641E+03 4.654098669E+06
+ 4.982892291E+06 4.351658918E+03 7.048293124E-04 4.556578921E+03 4.696641102E+06
+ 5.035355177E+06 4.314327062E+03 7.001165527E-04 4.525022201E+03 4.740176801E+06
+ 5.087818062E+06 4.277824779E+03 6.954319286E-04 4.493465481E+03 4.783963790E+06
+ 5.140280948E+06 4.241569575E+03 6.907752974E-04 4.461908761E+03 4.827209118E+06
+ 5.192743833E+06 4.205563450E+03 6.861465166E-04 4.430352041E+03 4.871517716E+06
+ 5.245206719E+06 4.169799117E+03 6.815454446E-04 4.398795321E+03 4.915454667E+06
+ 5.297669604E+06 4.133688114E+03 6.769719401E-04 4.367238601E+03 4.960272586E+06
+ 5.350132490E+06 4.098393462E+03 6.724258625E-04 4.335681881E+03 5.005292752E+06
+ 5.402595375E+06 4.063338540E+03 6.679070717E-04 4.304125161E+03 5.049766648E+06
+ 5.455058261E+06 4.028534708E+03 6.634154281E-04 4.272568441E+03 5.096140364E+06
+ 5.507521146E+06 3.993956299E+03 6.589507928E-04 4.241011721E+03 5.141078089E+06
+ 5.559984032E+06 3.959030139E+03 6.545130271E-04 4.209455001E+03 5.187150907E+06
+ 5.612446918E+06 3.925506505E+03 6.501019932E-04 4.177898281E+03 5.233499059E+06
+ 5.664909803E+06 3.891016937E+03 6.457175537E-04 4.146341561E+03 5.279237248E+06
+ 5.717372689E+06 3.857361174E+03 6.413595717E-04 4.114784841E+03 5.326115161E+06
+ 5.769835574E+06 3.823932887E+03 6.370279109E-04 4.083228121E+03 5.373280960E+06
+ 5.822298460E+06 3.790158705E+03 6.327224354E-04 4.051671401E+03 5.419854294E+06
+ 5.874761345E+06 3.757762172E+03 6.284430101E-04 4.020114681E+03 5.467587167E+06
+ 5.927224231E+06 3.724411201E+03 6.241895002E-04 3.988557961E+03 5.515601610E+06
+ 5.979687116E+06 3.691923798E+03 6.199617716E-04 3.957001241E+03 5.563045097E+06
+ 6.032150002E+06 3.659612182E+03 6.157596905E-04 3.925444521E+03 5.612540811E+06
+ 6.084612887E+06 3.626951317E+03 6.115831239E-04 3.893887801E+03 5.660526109E+06
+ 6.137075773E+06 3.595654188E+03 6.074319392E-04 3.862331081E+03 5.709737953E+06
+ 6.189538658E+06 3.563403471E+03 6.033060043E-04 3.830774361E+03 5.759261859E+06
+ 6.242001544E+06 3.531959689E+03 5.992051877E-04 3.799217641E+03 5.808183533E+06
+ 6.294464429E+06 3.500729788E+03 5.951293583E-04 3.767660921E+03 5.858318164E+06
+ 6.346927315E+06 3.469715760E+03 5.910783858E-04 3.736104201E+03 5.908780056E+06
+ 6.399390200E+06 3.438915121E+03 5.870521402E-04 3.704547481E+03 5.959655053E+06
+ 6.451853086E+06 3.407738501E+03 5.830504919E-04 3.672990761E+03 6.010788001E+06
+ 6.504315971E+06 3.377358912E+03 5.790733123E-04 3.641434041E+03 6.061294425E+06
+ 6.556778857E+06 3.347178087E+03 5.751204727E-04 3.609877321E+03 6.113081508E+06
+ 6.609241742E+06 3.317206589E+03 5.711918455E-04 3.578320601E+03 6.165217005E+06
+ 6.661704628E+06 3.287441988E+03 5.672873032E-04 3.546763881E+03 6.217711122E+06
+ 6.714167513E+06 3.257307406E+03 5.634067191E-04 3.515207161E+03 6.270558851E+06
+ 6.766630399E+06 3.228533150E+03 5.595499668E-04 3.483650441E+03 6.322787189E+06
+ 6.819093284E+06 3.198778413E+03 5.557169206E-04 3.452093721E+03 6.376338187E+06
+ 6.871556170E+06 3.169817379E+03 5.519074552E-04 3.420537001E+03 6.430261433E+06
+ 6.924019056E+06 3.141056922E+03 5.481214458E-04 3.388980281E+03 6.484583411E+06
+ 6.976481941E+06 3.111935421E+03 5.443587682E-04 3.357423561E+03 6.539268671E+06
+ 7.028944827E+06 3.083746561E+03 5.406192987E-04 3.325866841E+03 6.594343518E+06
+ 7.081407712E+06 3.055572894E+03 5.369029141E-04 3.294310121E+03 6.649811313E+06
+ 7.133870598E+06 3.027595982E+03 5.332094917E-04 3.262753401E+03 6.704652335E+06
+ 7.186333483E+06 2.999813462E+03 5.295389092E-04 3.231196681E+03 6.761956486E+06
+ 7.238796369E+06 2.971651557E+03 5.258910450E-04 3.199639961E+03 6.817567733E+06
+ 7.291259254E+06 2.944831512E+03 5.222657780E-04 3.168083241E+03 6.874647597E+06
+ 7.343722140E+06 2.917025973E+03 5.186629873E-04 3.136526522E+03 6.932150296E+06
+ 7.396185025E+06 2.889998249E+03 5.150825530E-04 3.104969802E+03 6.989338917E+06
+ 7.448647911E+06 2.863158929E+03 5.115243553E-04 3.073413082E+03 7.048829714E+06
+ 7.501110796E+06 2.836519729E+03 5.079882750E-04 3.041856362E+03 7.106578294E+06
+ 7.553573682E+06 2.810055032E+03 5.044741935E-04 3.010299642E+03 7.166917912E+06
+ 7.606036567E+06 2.783192612E+03 5.009819927E-04 2.978742922E+03 7.225541612E+06
+ 7.658499453E+06 2.757681329E+03 4.975115548E-04 2.947186202E+03 7.286838055E+06
+ 7.710962338E+06 2.731159817E+03 4.940627628E-04 2.915629482E+03 7.346369487E+06
+ 7.763425224E+06 2.705419492E+03 4.906354999E-04 2.884072762E+03 7.408639368E+06
+ 7.815888109E+06 2.679857190E+03 4.872296500E-04 2.852516042E+03 7.469114352E+06
+ 7.868350995E+06 2.654475138E+03 4.838450974E-04 2.820959322E+03 7.532412790E+06
+ 7.920813880E+06 2.629271026E+03 4.804817270E-04 2.789402602E+03 7.593762780E+06
+ 7.973276766E+06 2.603655790E+03 4.771394240E-04 2.757845882E+03 7.658175441E+06
+ 8.025739651E+06 2.578839806E+03 4.738180742E-04 2.726289162E+03 7.720649507E+06
+ 8.078202537E+06 2.554152805E+03 4.705175640E-04 2.694732442E+03 7.786026125E+06
+ 8.130665422E+06 2.529640437E+03 4.672377801E-04 2.663175722E+03 7.849563276E+06
+ 8.183128308E+06 2.505300452E+03 4.639786098E-04 2.631619002E+03 7.916029186E+06
+ 8.235591194E+06 2.480559473E+03 4.607399408E-04 2.600062282E+03 7.980675709E+06
+ 8.288054079E+06 2.457138009E+03 4.575216614E-04 2.568505562E+03 8.048374993E+06
+ 8.340516965E+06 2.432712272E+03 4.543236603E-04 2.536948842E+03 8.115359961E+06
+ 8.392979850E+06 2.409041377E+03 4.511458267E-04 2.505392122E+03 8.182934836E+06
+ 8.445442736E+06 2.385537468E+03 4.479880503E-04 2.473835402E+03 8.251118585E+06
+ 8.497905621E+06 2.362212247E+03 4.448502212E-04 2.442278682E+03 8.319910678E+06
+ 8.550368507E+06 2.339040438E+03 4.417322302E-04 2.410721962E+03 8.389330923E+06
+ 8.602831392E+06 2.315458200E+03 4.386339683E-04 2.379165242E+03 8.459389682E+06
+ 8.655294278E+06 2.293189375E+03 4.355553271E-04 2.347608522E+03 8.531430854E+06
+ 8.707757163E+06 2.269908616E+03 4.324961987E-04 2.316051802E+03 8.601504643E+06
+ 8.760220049E+06 2.247378685E+03 4.294564757E-04 2.284495082E+03 8.674827727E+06
+ 8.812682934E+06 2.225006208E+03 4.264360511E-04 2.252938362E+03 8.747564429E+06
+ 8.865145820E+06 2.202793455E+03 4.234348183E-04 2.221381642E+03 8.821003031E+06
+ 8.917608705E+06 2.180738253E+03 4.204526713E-04 2.189824922E+03 8.896537661E+06
+ 8.970071591E+06 2.158268202E+03 4.174895046E-04 2.158268202E+03 8.970071591E+06
+ 9.191535981E+06 2.065815333E+03 4.089058710E-04 2.136876104E+03 9.020519625E+06
+ 9.413000372E+06 1.977107454E+03 3.923202599E-04 2.115484006E+03 9.071424693E+06
+ 9.634464762E+06 1.892002319E+03 3.763625414E-04 2.094091909E+03 9.122838779E+06
+ 9.855929153E+06 1.810363731E+03 3.610109053E-04 2.072699811E+03 9.174729107E+06
+ 1.007739354E+07 1.732059682E+03 3.462442171E-04 2.051307713E+03 9.227126465E+06
+ 1.029885793E+07 1.656956673E+03 3.320420005E-04 2.029915615E+03 9.280065199E+06
+ 1.052032232E+07 1.584940320E+03 3.183844193E-04 2.008523517E+03 9.333531260E+06
+ 1.074178672E+07 1.515895887E+03 3.052522613E-04 1.987131419E+03 9.387515558E+06
+ 1.096325111E+07 1.449701671E+03 2.926269212E-04 1.965739322E+03 9.442050360E+06
+ 1.118471550E+07 1.386249061E+03 2.804903844E-04 1.944347224E+03 9.497170968E+06
+ 1.140617989E+07 1.325431608E+03 2.688252108E-04 1.922955126E+03 9.552843636E+06
+ 1.162764428E+07 1.267147215E+03 2.576145197E-04 1.901563028E+03 9.609127080E+06
+ 1.184910867E+07 1.211296363E+03 2.468419737E-04 1.880170930E+03 9.665987828E+06
+ 1.207057306E+07 1.157764242E+03 2.364917642E-04 1.858778832E+03 9.723461840E+06
+ 1.229203745E+07 1.106518739E+03 2.265485967E-04 1.837386734E+03 9.781588831E+06
+ 1.251350184E+07 1.057404327E+03 2.169976759E-04 1.815994637E+03 9.840357499E+06
+ 1.273496623E+07 1.010370221E+03 2.078246923E-04 1.794602539E+03 9.899759125E+06
+ 1.295643062E+07 9.653270365E+02 1.990158080E-04 1.773210441E+03 9.959832381E+06
+ 1.317789501E+07 9.221954879E+02 1.905576433E-04 1.751818343E+03 1.002062001E+07
+ 1.339935940E+07 8.808997659E+02 1.824372636E-04 1.730426245E+03 1.008211225E+07
+ 1.362082379E+07 8.413657522E+02 1.746421666E-04 1.709034147E+03 1.014430123E+07
+ 1.384228818E+07 8.035231758E+02 1.671602695E-04 1.687642050E+03 1.020722904E+07
+ 1.406375257E+07 7.673038355E+02 1.599798969E-04 1.666249952E+03 1.027094986E+07
+ 1.428521696E+07 7.326330410E+02 1.530897688E-04 1.644857854E+03 1.033544018E+07
+ 1.450668135E+07 6.994727637E+02 1.464789888E-04 1.623465756E+03 1.040070155E+07
+ 1.472814575E+07 6.677399507E+02 1.401370327E-04 1.602073658E+03 1.046677971E+07
+ 1.494961014E+07 6.373828283E+02 1.340537374E-04 1.580681560E+03 1.053371217E+07
+ 1.517107453E+07 6.083450623E+02 1.282192900E-04 1.559289463E+03 1.060152499E+07
+ 1.539253892E+07 5.805730259E+02 1.226242171E-04 1.537897365E+03 1.067021768E+07
+ 1.561400331E+07 5.540140069E+02 1.172593745E-04 1.516505267E+03 1.073979128E+07
+ 1.583546770E+07 5.286184288E+02 1.121159371E-04 1.495113169E+03 1.081032825E+07
+ 1.605693209E+07 5.043380622E+02 1.071853890E-04 1.473721071E+03 1.088182586E+07
+ 1.627839648E+07 4.811282852E+02 1.024595142E-04 1.452328973E+03 1.095428278E+07
+ 1.649986087E+07 4.589415797E+02 9.793038665E-05 1.430936876E+03 1.102775502E+07
+ 1.672132526E+07 4.377368269E+02 9.359036185E-05 1.409544778E+03 1.110230610E+07
+ 1.694278965E+07 4.174728220E+02 8.943206748E-05 1.388152680E+03 1.117793497E+07
+ 1.716425404E+07 3.981105490E+02 8.544839496E-05 1.366760582E+03 1.125464246E+07
+ 1.738571843E+07 3.796113608E+02 8.163249103E-05 1.345368484E+03 1.133252796E+07
+ 1.760718282E+07 3.619392523E+02 7.797774957E-05 1.323976386E+03 1.141159445E+07
+ 1.782864721E+07 3.450591381E+02 7.447780362E-05 1.302584289E+03 1.149184575E+07
+ 1.805011160E+07 3.289421396E+02 7.112651767E-05 1.281192191E+03 1.157339098E+07
+ 1.827157599E+07 3.135470708E+02 6.791798010E-05 1.259800093E+03 1.165623433E+07
+ 1.849304038E+07 2.988560047E+02 6.484649587E-05 1.238407995E+03 1.174038499E+07
+ 1.871450478E+07 2.848213478E+02 6.190657941E-05 1.217015897E+03 1.182599636E+07
+ 1.893596917E+07 2.714141997E+02 5.909294768E-05 1.195623799E+03 1.191297366E+07
+ 1.915743356E+07 2.586335718E+02 5.640051347E-05 1.174231702E+03 1.200147478E+07
+ 1.937889795E+07 2.464300592E+02 5.382437886E-05 1.152839604E+03 1.209151698E+07
+ 1.960036234E+07 2.347829638E+02 5.135982884E-05 1.131447506E+03 1.218311871E+07
+ 1.982182673E+07 2.236788861E+02 4.900232521E-05 1.110055408E+03 1.227641657E+07
+ 2.004329112E+07 2.130766014E+02 4.674750055E-05 1.088663310E+03 1.237143508E+07
+ 2.026475551E+07 2.029622270E+02 4.459115241E-05 1.067271212E+03 1.246824803E+07
+ 2.048621990E+07 1.933038386E+02 4.252923770E-05 1.045879114E+03 1.256691260E+07
+ 2.070768429E+07 1.841228074E+02 4.055786721E-05 1.024487017E+03 1.266746837E+07
+ 2.092914868E+07 1.753501878E+02 3.867330026E-05 1.003094919E+03 1.277012260E+07
+ 2.115061307E+07 1.669840651E+02 3.687193963E-05 9.817028210E+02 1.287478941E+07
+ 2.137207746E+07 1.590079075E+02 3.515032650E-05 9.603107231E+02 1.298168847E+07
+ 2.159354185E+07 1.514042749E+02 3.350513562E-05 9.389186253E+02 1.309087257E+07
+ 2.181500624E+07 1.441662561E+02 3.193317066E-05 9.175265274E+02 1.320244539E+07
+ 2.203647063E+07 1.372591130E+02 3.043135960E-05 8.961344296E+02 1.331651711E+07
+ 2.225793502E+07 1.306857006E+02 2.899675037E-05 8.747423318E+02 1.343320814E+07
+ 2.247939941E+07 1.244113956E+02 2.762650655E-05 8.533502339E+02 1.355264127E+07
+ 2.270086381E+07 1.184448924E+02 2.631790324E-05 8.319581361E+02 1.367500608E+07
+ 2.292232820E+07 1.127529384E+02 2.506832307E-05 8.105660383E+02 1.380029639E+07
+ 2.314379259E+07 1.073311526E+02 2.387525230E-05 7.891739404E+02 1.392887934E+07
+ 2.336525698E+07 1.021677144E+02 2.273627707E-05 7.677818426E+02 1.406076701E+07
+ 2.358672137E+07 9.725943687E+01 2.164907977E-05 7.463897447E+02 1.419619843E+07
+ 2.380818576E+07 9.257723660E+01 2.061143553E-05 7.249976469E+02 1.433534659E+07
+ 2.402965015E+07 8.812975134E+01 1.962120878E-05 7.036055491E+02 1.447759342E+07
+ 2.425111454E+07 8.388622759E+01 1.867635002E-05 6.822134512E+02 1.462591259E+07
+ 2.447257893E+07 7.984693688E+01 1.777489256E-05 6.608213534E+02 1.477773157E+07
+ 2.469404332E+07 7.600230193E+01 1.691494953E-05 6.394292556E+02 1.493437703E+07
+ 2.491550771E+07 7.235329480E+01 1.609471081E-05 6.180371577E+02 1.509609965E+07
+ 2.513697210E+07 6.888100021E+01 1.531244022E-05 5.966450599E+02 1.526318689E+07
+ 2.535843649E+07 6.556896006E+01 1.456647271E-05 5.752529620E+02 1.543608465E+07
+ 2.557990088E+07 6.242050712E+01 1.385521167E-05 5.538608642E+02 1.561530856E+07
+ 2.580136527E+07 5.942959930E+01 1.317712636E-05 5.324687664E+02 1.580126948E+07
+ 2.602282966E+07 5.657881384E+01 1.253074938E-05 5.110766685E+02 1.599450945E+07
+ 2.624429405E+07 5.387694345E+01 1.191467423E-05 4.896845707E+02 1.619565510E+07
+ 2.646575845E+07 5.130822917E+01 1.132755303E-05 4.682924728E+02 1.640537306E+07
+ 2.668722284E+07 4.885722972E+01 1.076809421E-05 4.469003750E+02 1.662446723E+07
+ 2.690868723E+07 4.652688572E+01 1.023506034E-05 4.255082772E+02 1.685384121E+07
+ 2.713015162E+07 4.432237911E+01 9.727266047E-06 4.041161793E+02 1.709454318E+07
+ 2.735161601E+07 4.222577531E+01 9.243575978E-06 3.827240815E+02 1.734777756E+07
+ 2.757308040E+07 4.022484020E+01 8.782902831E-06 3.613319837E+02 1.761508548E+07
+ 2.779454479E+07 3.833255240E+01 8.344205480E-06 3.399398858E+02 1.789778843E+07
+ 2.801600918E+07 3.653446083E+01 7.926487150E-06 3.185477880E+02 1.819860021E+07
+ 2.823747357E+07 3.481793207E+01 7.528793660E-06 2.971556901E+02 1.851929841E+07
+ 2.845893796E+07 3.318678275E+01 7.150211735E-06 2.757635923E+02 1.886304362E+07
+ 2.868040235E+07 3.164382352E+01 6.789867371E-06 2.543714945E+02 1.923367858E+07
+ 2.890186674E+07 3.019029128E+01 6.446924268E-06 2.329793966E+02 1.963572808E+07
+ 2.912333113E+07 2.879294575E+01 6.120582308E-06 2.115872988E+02 2.007519582E+07
+ 2.934479552E+07 2.747505548E+01 5.810076106E-06 1.901952010E+02 2.056020919E+07
+ 2.956625991E+07 2.620391667E+01 5.514673595E-06 1.688031031E+02 2.110165724E+07
+ 2.978772430E+07 2.502736357E+01 5.233674679E-06 1.474110053E+02 2.171451166E+07
+ 3.000918869E+07 2.390184334E+01 4.966409930E-06 1.260189074E+02 2.242139519E+07
+ 3.023065308E+07 2.283240794E+01 4.712239330E-06 1.046268096E+02 2.325842902E+07
+ 3.045211748E+07 2.180888860E+01 4.470551067E-06 8.323471176E+01 2.428595146E+07
+ 3.067358187E+07 2.084668699E+01 4.240760373E-06 6.184261393E+01 2.562148876E+07
+ 3.089504626E+07 1.993362983E+01 4.022308402E-06 4.045051609E+01 2.754776466E+07
+ 3.111651065E+07 1.905841825E+01 3.814661162E-06 1.905841825E+01 3.111651065E+07
+ 3.145378661E+07 1.777406178E+01 3.682366664E-06 1.886789584E+01 3.116514473E+07
+ 3.179106257E+07 1.657271660E+01 3.444034360E-06 1.867737342E+01 3.121424957E+07
+ 3.212833853E+07 1.544923499E+01 3.220404867E-06 1.848685100E+01 3.126383564E+07
+ 3.246561449E+07 1.439882717E+01 3.010620749E-06 1.829632859E+01 3.131391467E+07
+ 3.280289045E+07 1.341695582E+01 2.813871283E-06 1.810580617E+01 3.136448818E+07
+ 3.314016641E+07 1.249933745E+01 2.629390134E-06 1.791528376E+01 3.141557955E+07
+ 3.347744236E+07 1.164198825E+01 2.456453114E-06 1.772476134E+01 3.146719302E+07
+ 3.381471832E+07 1.084112143E+01 2.294376057E-06 1.753423893E+01 3.151933963E+07
+ 3.415199428E+07 1.009316869E+01 2.142512780E-06 1.734371651E+01 3.157203081E+07
+ 3.448927024E+07 9.394807919E+00 2.000253140E-06 1.715319410E+01 3.162527553E+07
+ 3.482654620E+07 8.742890357E+00 1.867021182E-06 1.696267168E+01 3.167908519E+07
+ 3.516382216E+07 8.134454397E+00 1.742273369E-06 1.677214927E+01 3.173348472E+07
+ 3.550109812E+07 7.566727892E+00 1.625496897E-06 1.658162685E+01 3.178847600E+07
+ 3.583837408E+07 7.037119809E+00 1.516208087E-06 1.639110443E+01 3.184407245E+07
+ 3.617565004E+07 6.543185092E+00 1.413950854E-06 1.620058202E+01 3.190029134E+07
+ 3.651292600E+07 6.082603816E+00 1.318295248E-06 1.601005960E+01 3.195713940E+07
+ 3.685020196E+07 5.653204959E+00 1.228836067E-06 1.581953719E+01 3.201464648E+07
+ 3.718747792E+07 5.253032456E+00 1.145191533E-06 1.562901477E+01 3.207281986E+07
+ 3.752475388E+07 4.880116939E+00 1.067002034E-06 1.543849236E+01 3.213167555E+07
+ 3.786202984E+07 4.532709010E+00 9.939289286E-07 1.524796994E+01 3.219123016E+07
+ 3.819930580E+07 4.209119841E+00 9.256534088E-07 1.505744753E+01 3.225150091E+07
+ 3.853658176E+07 3.907801886E+00 8.618754164E-07 1.486692511E+01 3.231249919E+07
+ 3.887385772E+07 3.627268712E+00 8.023126164E-07 1.467640270E+01 3.237425653E+07
+ 3.921113368E+07 3.366151420E+00 7.466994210E-07 1.448588028E+01 3.243678416E+07
+ 3.954840964E+07 3.123149698E+00 6.947860619E-07 1.429535786E+01 3.250009988E+07
+ 3.988568560E+07 2.897091690E+00 6.463377104E-07 1.410483545E+01 3.256423366E+07
+ 4.022296156E+07 2.686812169E+00 6.011336422E-07 1.391431303E+01 3.262919348E+07
+ 4.056023752E+07 2.491254504E+00 5.589664449E-07 1.372379062E+01 3.269501855E+07
+ 4.089751348E+07 2.309442860E+00 5.196412666E-07 1.353326820E+01 3.276172404E+07
+ 4.123478944E+07 2.140436396E+00 4.829751034E-07 1.334274579E+01 3.282933444E+07
+ 4.157206540E+07 1.983370232E+00 4.487961241E-07 1.315222337E+01 3.289786350E+07
+ 4.190934136E+07 1.837443710E+00 4.169430305E-07 1.296170096E+01 3.296736434E+07
+ 4.224661732E+07 1.701864988E+00 3.872644513E-07 1.277117854E+01 3.303784695E+07
+ 4.258389328E+07 1.575967206E+00 3.596183685E-07 1.258065612E+01 3.310933421E+07
+ 4.292116924E+07 1.459084821E+00 3.338715740E-07 1.239013371E+01 3.318186856E+07
+ 4.325844520E+07 1.350572598E+00 3.098991560E-07 1.219961129E+01 3.325548501E+07
+ 4.359572116E+07 1.249852701E+00 2.875840125E-07 1.200908888E+01 3.333021057E+07
+ 4.393299712E+07 1.156399938E+00 2.668163919E-07 1.181856646E+01 3.340607270E+07
+ 4.427027308E+07 1.069713126E+00 2.474934581E-07 1.162804405E+01 3.348312244E+07
+ 4.460754904E+07 9.892948876E-01 2.295188797E-07 1.143752163E+01 3.356139075E+07
+ 4.494482500E+07 9.147438823E-01 2.128024424E-07 1.124699922E+01 3.364091778E+07
+ 4.528210096E+07 8.456286141E-01 1.972596817E-07 1.105647680E+01 3.372174570E+07
+ 4.561937692E+07 7.815571479E-01 1.828115377E-07 1.086595439E+01 3.380390833E+07
+ 4.595665287E+07 7.222008459E-01 1.693840277E-07 1.067543197E+01 3.388746761E+07
+ 4.629392883E+07 6.671924532E-01 1.569079382E-07 1.048490955E+01 3.397247012E+07
+ 4.663120479E+07 6.162582088E-01 1.453185344E-07 1.029438714E+01 3.405895789E+07
+ 4.696848075E+07 5.690795563E-01 1.345552856E-07 1.010386472E+01 3.414700428E+07
+ 4.730575671E+07 5.253836202E-01 1.245616068E-07 9.913342308E+00 3.423664826E+07
+ 4.764303267E+07 4.849826211E-01 1.152846153E-07 9.722819893E+00 3.432795860E+07
+ 4.798030863E+07 4.475595913E-01 1.066749007E-07 9.532297477E+00 3.442101191E+07
+ 4.831758459E+07 4.129406355E-01 9.868630915E-08 9.341775062E+00 3.451585430E+07
+ 4.865486055E+07 3.809171962E-01 9.127573946E-08 9.151252646E+00 3.461256174E+07
+ 4.899213651E+07 3.513033766E-01 8.440295156E-08 8.960730231E+00 3.471123274E+07
+ 4.932941247E+07 3.239354372E-01 7.803038615E-08 8.770207815E+00 3.481193563E+07
+ 4.966668843E+07 2.986402795E-01 7.212299502E-08 8.579685400E+00 3.491474698E+07
+ 5.000396439E+07 2.752289679E-01 6.664808149E-08 8.389162984E+00 3.501977485E+07
+ 5.034124035E+07 2.536346311E-01 6.157515040E-08 8.198640569E+00 3.512711797E+07
+ 5.067851631E+07 2.336612523E-01 5.687576708E-08 8.008118153E+00 3.523687065E+07
+ 5.101579227E+07 2.152357399E-01 5.252342485E-08 7.817595738E+00 3.534917079E+07
+ 5.135306823E+07 1.981765807E-01 4.849342056E-08 7.627073322E+00 3.546410734E+07
+ 5.169034419E+07 1.824766469E-01 4.476273767E-08 7.436550907E+00 3.558185658E+07
+ 5.202762015E+07 1.679718515E-01 4.130993655E-08 7.246028492E+00 3.570250486E+07
+ 5.236489611E+07 1.545993851E-01 3.811505147E-08 7.055506076E+00 3.582626184E+07
+ 5.270217207E+07 1.422299540E-01 3.515949394E-08 6.864983661E+00 3.595326755E+07
+ 5.303944803E+07 1.308407942E-01 3.242596210E-08 6.674461245E+00 3.608370141E+07
+ 5.337672399E+07 1.203170206E-01 2.989835566E-08 6.483938830E+00 3.621773203E+07
+ 5.371399995E+07 1.106415023E-01 2.756169630E-08 6.293416414E+00 3.635560018E+07
+ 5.405127591E+07 1.017306840E-01 2.540205290E-08 6.102893999E+00 3.649755799E+07
+ 5.438855187E+07 9.349676141E-02 2.340647160E-08 5.912371583E+00 3.664381671E+07
+ 5.472582783E+07 8.591678600E-02 2.156291031E-08 5.721849168E+00 3.679468047E+07
+ 5.506310379E+07 7.893747352E-02 1.986017724E-08 5.531326752E+00 3.695043509E+07
+ 5.540037975E+07 7.248543543E-02 1.828787355E-08 5.340804337E+00 3.711145185E+07
+ 5.573765571E+07 6.658947497E-02 1.683633953E-08 5.150281921E+00 3.727805314E+07
+ 5.607493167E+07 6.113743363E-02 1.549660431E-08 4.959759506E+00 3.745068286E+07
+ 5.641220763E+07 5.611067009E-02 1.426033882E-08 4.769237090E+00 3.762982485E+07
+ 5.674948359E+07 5.150195804E-02 1.311981179E-08 4.578714675E+00 3.781596666E+07
+ 5.708675955E+07 4.725840824E-02 1.206784864E-08 4.388192259E+00 3.800969461E+07
+ 5.742403551E+07 4.335776374E-02 1.109779303E-08 4.197669844E+00 3.821169331E+07
+ 5.776131147E+07 3.974020120E-02 1.020347100E-08 4.007147428E+00 3.842269914E+07
+ 5.809858742E+07 3.646564123E-02 9.379157369E-09 3.816625013E+00 3.864355910E+07
+ 5.843586338E+07 3.342039360E-02 8.619544475E-09 3.626102598E+00 3.887531162E+07
+ 5.877313934E+07 3.064609416E-02 7.919712929E-09 3.435580182E+00 3.911907453E+07
+ 5.911041530E+07 2.807954757E-02 7.275104339E-09 3.245057767E+00 3.937617445E+07
+ 5.944769126E+07 2.573491078E-02 6.681495860E-09 3.054535351E+00 3.964825593E+07
+ 5.978496722E+07 2.356595268E-02 6.134976462E-09 2.864012936E+00 3.993715818E+07
+ 6.012224318E+07 2.158885582E-02 5.631924796E-09 2.673490520E+00 4.024518041E+07
+ 6.045951914E+07 1.975467240E-02 5.168988563E-09 2.482968105E+00 4.057508940E+07
+ 6.079679510E+07 1.808705432E-02 4.743065292E-09 2.292445689E+00 4.093034797E+07
+ 6.113407106E+07 1.655744080E-02 4.351284421E-09 2.101923274E+00 4.131520198E+07
+ 6.147134702E+07 1.516358209E-02 3.990990616E-09 1.911400858E+00 4.173525600E+07
+ 6.180862298E+07 1.386892373E-02 3.659728240E-09 1.720878443E+00 4.219782722E+07
+ 6.214589894E+07 1.268527453E-02 3.355226885E-09 1.530356027E+00 4.271253601E+07
+ 6.248317490E+07 1.158534261E-02 3.075387917E-09 1.339833612E+00 4.329316951E+07
+ 6.282045086E+07 1.060731488E-02 2.818271954E-09 1.149311196E+00 4.395965903E+07
+ 6.315772682E+07 9.684155050E-03 2.582087220E-09 9.587887809E-01 4.474257466E+07
+ 6.349500278E+07 8.867991403E-03 2.365178712E-09 7.682663654E-01 4.569272190E+07
+ 6.383227874E+07 8.092160122E-03 2.166018136E-09 5.777439500E-01 4.690462611E+07
+ 6.416955470E+07 7.404817042E-03 1.983194546E-09 3.872215345E-01 4.858646548E+07
+ 6.450683066E+07 6.763704666E-03 1.815405655E-09 1.966991190E-01 5.138395451E+07
+ 6.484410662E+07 6.176703533E-03 1.661449755E-09 6.176703533E-03 6.484410662E+07
+ 6.490587365E+07 6.114936498E-03 1.000000000E-09 6.114936498E-03 6.490587362E+07
+ 6.496764069E+07 6.053169462E-03 1.000000000E-09 6.053169462E-03 6.496764062E+07
+ 6.502940773E+07 5.991402427E-03 1.000000000E-09 5.991402427E-03 6.502940700E+07
+ 6.509117476E+07 5.929635392E-03 1.000000000E-09 5.929635392E-03 6.509117400E+07
+ 6.515294180E+07 5.867868356E-03 1.000000000E-09 5.867868356E-03 6.515294180E+07
+ 6.521470883E+07 5.806101321E-03 1.000000000E-09 5.806101321E-03 6.521470900E+07
+ 6.527647587E+07 5.744334286E-03 1.000000000E-09 5.744334286E-03 6.527647200E+07
+ 6.533824290E+07 5.682567250E-03 1.000000000E-09 5.682567250E-03 6.533824100E+07
+ 6.540000994E+07 5.620800215E-03 1.000000000E-09 5.620800215E-03 6.540000993E+07
+ 6.546177697E+07 5.559033180E-03 1.000000000E-09 5.559033180E-03 6.546177600E+07
+ 6.552354401E+07 5.497266144E-03 1.000000000E-09 5.497266144E-03 6.552354406E+07
+ 6.558531104E+07 5.435499109E-03 1.000000000E-09 5.435499109E-03 6.558531105E+07
+ 6.564707808E+07 5.373732074E-03 1.000000000E-09 5.373732074E-03 6.564708800E+07
+ 6.570884511E+07 5.311965038E-03 1.000000000E-09 5.311965038E-03 6.570884500E+07
+ 6.577061215E+07 5.250198003E-03 1.000000000E-09 5.250198003E-03 6.577061212E+07
+ 6.583237918E+07 5.188430968E-03 1.000000000E-09 5.188430968E-03 6.583237700E+07
+ 6.589414622E+07 5.126663932E-03 1.000000000E-09 5.126663932E-03 6.589414625E+07
+ 6.595591326E+07 5.064896897E-03 1.000000000E-09 5.064896897E-03 6.595591326E+07
+ 6.601768029E+07 5.003129862E-03 1.000000000E-09 5.003129862E-03 6.601768012E+07
+ 6.607944733E+07 4.941362826E-03 1.000000000E-09 4.941362826E-03 6.607944000E+07
+ 6.614121436E+07 4.879595791E-03 1.000000000E-09 4.879595791E-03 6.614118400E+07
+ 6.620298140E+07 4.817828756E-03 1.000000000E-09 4.817828756E-03 6.620298137E+07
+ 6.626474843E+07 4.756061720E-03 1.000000000E-09 4.756061720E-03 6.626474837E+07
+ 6.632651547E+07 4.694294685E-03 1.000000000E-09 4.694294685E-03 6.632652800E+07
+ 6.638828250E+07 4.632527650E-03 1.000000000E-09 4.632527650E-03 6.638828250E+07
+ 6.645004954E+07 4.570760614E-03 1.000000000E-09 4.570760614E-03 6.645004800E+07
+ 6.651181657E+07 4.508993579E-03 1.000000000E-09 4.508993579E-03 6.651181657E+07
+ 6.657358361E+07 4.447226544E-03 1.000000000E-09 4.447226544E-03 6.657356800E+07
+ 6.663535064E+07 4.385459508E-03 1.000000000E-09 4.385459508E-03 6.663535100E+07
+ 6.669711768E+07 4.323692473E-03 1.000000000E-09 4.323692473E-03 6.669711762E+07
+ 6.675888471E+07 4.261925438E-03 1.000000000E-09 4.261925438E-03 6.675888469E+07
+ 6.682065175E+07 4.200158402E-03 1.000000000E-09 4.200158402E-03 6.682065175E+07
+ 6.688241879E+07 4.138391367E-03 1.000000000E-09 4.138391367E-03 6.688241879E+07
+ 6.694418582E+07 4.076624332E-03 1.000000000E-09 4.076624332E-03 6.694418582E+07
+ 6.700595286E+07 4.014857296E-03 1.000000000E-09 4.014857296E-03 6.700595287E+07
+ 6.706771989E+07 3.953090261E-03 1.000000000E-09 3.953090261E-03 6.706772000E+07
+ 6.712948693E+07 3.891323226E-03 1.000000000E-09 3.891323226E-03 6.712948700E+07
+ 6.719125396E+07 3.829556190E-03 1.000000000E-09 3.829556190E-03 6.719125600E+07
+ 6.725302100E+07 3.767789155E-03 1.000000000E-09 3.767789155E-03 6.725302106E+07
+ 6.731478803E+07 3.706022120E-03 1.000000000E-09 3.706022120E-03 6.731478800E+07
+ 6.737655507E+07 3.644255084E-03 1.000000000E-09 3.644255084E-03 6.737655500E+07
+ 6.743832210E+07 3.582488049E-03 1.000000000E-09 3.582488049E-03 6.743833600E+07
+ 6.750008914E+07 3.520721014E-03 1.000000000E-09 3.520721014E-03 6.750008914E+07
+ 6.756185617E+07 3.458953978E-03 1.000000000E-09 3.458953978E-03 6.756185617E+07
+ 6.762362321E+07 3.397186943E-03 1.000000000E-09 3.397186943E-03 6.762363200E+07
+ 6.768539024E+07 3.335419908E-03 1.000000000E-09 3.335419908E-03 6.768539024E+07
+ 6.774715728E+07 3.273652872E-03 1.000000000E-09 3.273652872E-03 6.774715728E+07
+ 6.780892432E+07 3.211885837E-03 1.000000000E-09 3.211885837E-03 6.780896878E+07
+ 6.787069135E+07 3.150118802E-03 1.000000000E-09 3.150118802E-03 6.787069135E+07
+ 6.793245839E+07 3.088351766E-03 1.000000000E-09 3.088351766E-03 6.793245839E+07
+ 6.799422542E+07 3.026584731E-03 1.000000000E-09 3.026584731E-03 6.799422400E+07
+ 6.805599246E+07 2.964817696E-03 1.000000000E-09 2.964817696E-03 6.805599246E+07
+ 6.811775949E+07 2.903050660E-03 1.000000000E-09 2.903050660E-03 6.811775949E+07
+ 6.817952653E+07 2.841283625E-03 1.000000000E-09 2.841283625E-03 6.817952653E+07
+ 6.824129356E+07 2.779516590E-03 1.000000000E-09 2.779516590E-03 6.824129356E+07
+ 6.830306060E+07 2.717749554E-03 1.000000000E-09 2.717749554E-03 6.830310400E+07
+ 6.836482763E+07 2.655982519E-03 1.000000000E-09 2.655982519E-03 6.836482763E+07
+ 6.842659467E+07 2.594215484E-03 1.000000000E-09 2.594215484E-03 6.842659467E+07
+ 6.848836170E+07 2.532448448E-03 1.000000000E-09 2.532448448E-03 6.848836170E+07
+ 6.855012874E+07 2.470681413E-03 1.000000000E-09 2.470681413E-03 6.855012878E+07
+ 6.861189577E+07 2.408914378E-03 1.000000000E-09 2.408914378E-03 6.861190400E+07
+ 6.867366281E+07 2.347147342E-03 1.000000000E-09 2.347147342E-03 6.867366275E+07
+ 6.873542985E+07 2.285380307E-03 1.000000000E-09 2.285380307E-03 6.873542985E+07
+ 6.879719688E+07 2.223613272E-03 1.000000000E-09 2.223613272E-03 6.879719700E+07
+ 6.885896392E+07 2.161846236E-03 1.000000000E-09 2.161846236E-03 6.885896392E+07
+ 6.892073095E+07 2.100079201E-03 1.000000000E-09 2.100079201E-03 6.892073100E+07
+ 6.898249799E+07 2.038312166E-03 1.000000000E-09 2.038312166E-03 6.898252800E+07
+ 6.904426502E+07 1.976545131E-03 1.000000000E-09 1.976545131E-03 6.904426500E+07
+ 6.910603206E+07 1.914778095E-03 1.000000000E-09 1.914778095E-03 6.910603206E+07
+ 6.916779909E+07 1.853011060E-03 1.000000000E-09 1.853011060E-03 6.916781155E+07
+ 6.922956613E+07 1.791244025E-03 1.000000000E-09 1.791244025E-03 6.922956800E+07
+ 6.929133316E+07 1.729476989E-03 1.000000000E-09 1.729476989E-03 6.929133319E+07
+ 6.935310020E+07 1.667709954E-03 1.000000000E-09 1.667709954E-03 6.935315810E+07
+ 6.941486723E+07 1.605942919E-03 1.000000000E-09 1.605942919E-03 6.941486700E+07
+ 6.947663427E+07 1.544175883E-03 1.000000000E-09 1.544175883E-03 6.947663463E+07
+ 6.953840130E+07 1.482408848E-03 1.000000000E-09 1.482408848E-03 6.953840131E+07
+ 6.960016834E+07 1.420641813E-03 1.000000000E-09 1.420641813E-03 6.960016834E+07
+ 6.966193538E+07 1.358874777E-03 1.000000000E-09 1.358874777E-03 6.966193525E+07
+ 6.972370241E+07 1.297107742E-03 1.000000000E-09 1.297107742E-03 6.972370271E+07
+ 6.978546945E+07 1.235340707E-03 1.000000000E-09 1.235340707E-03 6.978553472E+07
+ 6.984723648E+07 1.173573671E-03 1.000000000E-09 1.173573671E-03 6.984724800E+07
+ 6.990900352E+07 1.111806636E-03 1.000000000E-09 1.111806636E-03 6.990905116E+07
+ 6.997077055E+07 1.050039601E-03 1.000000000E-09 1.050039601E-03 6.997077728E+07
+ 7.003253759E+07 9.882725653E-04 1.000000000E-09 9.882725653E-04 7.003253759E+07
+ 7.009430462E+07 9.265055299E-04 1.000000000E-09 9.265055299E-04 7.009430462E+07
+ 7.015607166E+07 8.647384946E-04 1.000000000E-09 8.647384946E-04 7.015607167E+07
+ 7.021783869E+07 8.029714593E-04 1.000000000E-09 8.029714593E-04 7.021783875E+07
+ 7.027960573E+07 7.412044239E-04 1.000000000E-09 7.412044239E-04 7.027960575E+07
+ 7.034137276E+07 6.794373886E-04 1.000000000E-09 6.794373886E-04 7.034137276E+07
+ 7.040313980E+07 6.176703533E-04 1.000000000E-09 6.176703533E-04 7.040313980E+07
+ 7.046490683E+07 5.559033180E-04 1.000000000E-09 5.559033180E-04 7.046490687E+07
+ 7.052667387E+07 4.941362826E-04 1.000000000E-09 4.941362826E-04 7.052667500E+07
+ 7.058844090E+07 4.323692473E-04 1.000000000E-09 4.323692473E-04 7.058844100E+07
+ 7.065020794E+07 3.706022120E-04 1.000000000E-09 3.706022120E-04 7.065020797E+07
+ 7.071197498E+07 3.088351766E-04 1.000000000E-09 3.088351766E-04 7.071196800E+07
+ 7.077374201E+07 2.470681413E-04 1.000000000E-09 2.470681413E-04 7.077374400E+07
+ 7.083550905E+07 1.853011060E-04 1.000000000E-09 1.853011060E-04 7.083552000E+07
+ 7.089727608E+07 1.235340707E-04 1.000000000E-09 1.235340707E-04 7.089727608E+07
+ 7.095904312E+07 6.176703533E-05 1.000000000E-09 6.176703533E-05 7.095904312E+07
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM85
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM85	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM85	(revision 286)
@@ -0,0 +1,501 @@
+DENSITY AND THICKNESS DATA OF THE ATMOSPHERE AT AN ZENITH ANGLE OF 85.0 DEGREES
+ 0.000000000E+00 1.057187280E+04 1.229805824E-03 1.057187280E+04 0.000000000E+00
+ 4.415350366E+04 1.051822822E+04 1.225052902E-03 1.052705791E+04 3.651026867E+04
+ 8.830700732E+04 1.046415664E+04 1.220314621E-03 1.048224302E+04 7.313671395E+04
+ 1.324605110E+05 1.040996117E+04 1.215590953E-03 1.043742813E+04 1.098797731E+05
+ 1.766140146E+05 1.035688695E+04 1.210881871E-03 1.039261323E+04 1.467413670E+05
+ 2.207675183E+05 1.030304621E+04 1.206187347E-03 1.034779834E+04 1.837204698E+05
+ 2.649210219E+05 1.024981057E+04 1.201507353E-03 1.030298345E+04 2.208190221E+05
+ 3.090745256E+05 1.019743061E+04 1.196841861E-03 1.025816856E+04 2.580374936E+05
+ 3.532280293E+05 1.014471411E+04 1.192190844E-03 1.021335367E+04 2.953930266E+05
+ 3.973815329E+05 1.009127700E+04 1.187554273E-03 1.016853877E+04 3.328543301E+05
+ 4.415350366E+05 1.003980282E+04 1.182932122E-03 1.012372388E+04 3.706444160E+05
+ 4.856885402E+05 9.987192763E+03 1.178324361E-03 1.007890899E+04 4.077007505E+05
+ 5.298420439E+05 9.935183969E+03 1.173730964E-03 1.003409410E+04 4.459790761E+05
+ 5.739955475E+05 9.884004673E+03 1.169151902E-03 9.989279205E+03 4.839364933E+05
+ 6.181490512E+05 9.832062342E+03 1.164587147E-03 9.944464313E+03 5.220203965E+05
+ 6.623025549E+05 9.780603397E+03 1.160036671E-03 9.899649421E+03 5.602313324E+05
+ 7.064560585E+05 9.729630448E+03 1.155500447E-03 9.854834528E+03 5.985744841E+05
+ 7.506095622E+05 9.678626515E+03 1.150978446E-03 9.810019636E+03 6.370427092E+05
+ 7.947630658E+05 9.628452281E+03 1.146470640E-03 9.765204744E+03 6.756412110E+05
+ 8.389165695E+05 9.577839199E+03 1.141977002E-03 9.720389852E+03 7.143705824E+05
+ 8.830700732E+05 9.527424856E+03 1.137497502E-03 9.675574960E+03 7.532329730E+05
+ 9.272235768E+05 9.476956381E+03 1.133032114E-03 9.630760068E+03 7.922274553E+05
+ 9.713770805E+05 9.427514961E+03 1.128580808E-03 9.585945176E+03 8.319023474E+05
+ 1.015530584E+06 9.377297774E+03 1.124143558E-03 9.541130283E+03 8.711658541E+05
+ 1.059684088E+06 9.327674806E+03 1.119720334E-03 9.496315391E+03 9.100866135E+05
+ 1.103837591E+06 9.278871164E+03 1.115311108E-03 9.451500499E+03 9.501750415E+05
+ 1.147991095E+06 9.229295117E+03 1.110915853E-03 9.406685607E+03 9.898498295E+05
+ 1.192144599E+06 9.180833768E+03 1.106534540E-03 9.361870715E+03 1.029663586E+06
+ 1.236298102E+06 9.131584692E+03 1.102167141E-03 9.317055823E+03 1.069320328E+06
+ 1.280451606E+06 9.082927623E+03 1.097813628E-03 9.272240931E+03 1.109714111E+06
+ 1.324605110E+06 9.035090093E+03 1.093473972E-03 9.227426039E+03 1.149654903E+06
+ 1.368758613E+06 8.986474477E+03 1.089148145E-03 9.182611146E+03 1.190557780E+06
+ 1.412912117E+06 8.938967789E+03 1.084836119E-03 9.137796254E+03 1.231083530E+06
+ 1.457065621E+06 8.890672350E+03 1.080537865E-03 9.092981362E+03 1.271400522E+06
+ 1.501219124E+06 8.842985958E+03 1.076253356E-03 9.048166470E+03 1.312220421E+06
+ 1.545372628E+06 8.796099827E+03 1.071982562E-03 9.003351578E+03 1.353189784E+06
+ 1.589526132E+06 8.748427083E+03 1.067725456E-03 8.958536686E+03 1.394882272E+06
+ 1.633679635E+06 8.701231449E+03 1.063482010E-03 8.913721794E+03 1.436148940E+06
+ 1.677833139E+06 8.654904028E+03 1.059252194E-03 8.868906901E+03 1.477567371E+06
+ 1.721986643E+06 8.607739153E+03 1.055035981E-03 8.824092009E+03 1.518849043E+06
+ 1.766140146E+06 8.561787118E+03 1.050833341E-03 8.779277117E+03 1.560526664E+06
+ 1.810293650E+06 8.515387364E+03 1.046644248E-03 8.734462225E+03 1.602991991E+06
+ 1.854447154E+06 8.468780303E+03 1.042468672E-03 8.689647333E+03 1.644665417E+06
+ 1.898600657E+06 8.423377883E+03 1.038306584E-03 8.644832441E+03 1.686863776E+06
+ 1.942754161E+06 8.377135343E+03 1.034157957E-03 8.600017549E+03 1.729812774E+06
+ 1.986907665E+06 8.332102139E+03 1.030022762E-03 8.555202656E+03 1.772328429E+06
+ 2.031061168E+06 8.286275369E+03 1.025900970E-03 8.510387764E+03 1.814694763E+06
+ 2.075214672E+06 8.241306808E+03 1.021792554E-03 8.465572872E+03 1.858086181E+06
+ 2.119368176E+06 8.195884145E+03 1.017697484E-03 8.420757980E+03 1.900716746E+06
+ 2.163521679E+06 8.151570300E+03 1.013615732E-03 8.375943088E+03 1.943893231E+06
+ 2.207675183E+06 8.106469358E+03 1.009547269E-03 8.331128196E+03 1.987840943E+06
+ 2.251828687E+06 8.062463789E+03 1.005492068E-03 8.286313304E+03 2.031024648E+06
+ 2.295982190E+06 8.017662383E+03 1.001450100E-03 8.241498411E+03 2.075029553E+06
+ 2.340135694E+06 7.974069881E+03 9.974213350E-04 8.196683519E+03 2.118592271E+06
+ 2.384289198E+06 7.930014740E+03 9.934057460E-04 8.151868627E+03 2.163231234E+06
+ 2.428442701E+06 7.885808686E+03 9.894033040E-04 8.107053735E+03 2.207103557E+06
+ 2.472596205E+06 7.842687310E+03 9.854139805E-04 8.062238843E+03 2.252049419E+06
+ 2.516749708E+06 7.798770582E+03 9.814377469E-04 8.017423951E+03 2.296217298E+06
+ 2.560903212E+06 7.756057930E+03 9.774745748E-04 7.972609059E+03 2.341580565E+06
+ 2.605056716E+06 7.712880623E+03 9.735244356E-04 7.927794166E+03 2.386494807E+06
+ 2.649210219E+06 7.669491834E+03 9.695873006E-04 7.882979274E+03 2.431212450E+06
+ 2.693363723E+06 7.627314965E+03 9.656631415E-04 7.838164382E+03 2.476730869E+06
+ 2.737517227E+06 7.584267960E+03 9.617519295E-04 7.793349490E+03 2.522840735E+06
+ 2.781670730E+06 7.542050628E+03 9.578536362E-04 7.748534598E+03 2.568155850E+06
+ 2.825824234E+06 7.500105431E+03 9.539682330E-04 7.703719706E+03 2.614592254E+06
+ 2.869977738E+06 7.458210876E+03 9.500956912E-04 7.658904814E+03 2.660228504E+06
+ 2.914131241E+06 7.415844385E+03 9.462359825E-04 7.614089921E+03 2.707130050E+06
+ 2.958284745E+06 7.374048362E+03 9.423890780E-04 7.569275029E+03 2.753669059E+06
+ 3.002438249E+06 7.333053263E+03 9.385549494E-04 7.524460137E+03 2.800427604E+06
+ 3.046591752E+06 7.291254194E+03 9.347335680E-04 7.479645245E+03 2.846843912E+06
+ 3.090745256E+06 7.250538563E+03 9.309249053E-04 7.434830353E+03 2.894521360E+06
+ 3.134898760E+06 7.209019325E+03 9.271289326E-04 7.390015461E+03 2.941339266E+06
+ 3.179052263E+06 7.168694988E+03 9.233456214E-04 7.345200569E+03 2.989018572E+06
+ 3.223205767E+06 7.127561575E+03 9.195749431E-04 7.300385677E+03 3.037319517E+06
+ 3.267359271E+06 7.087270229E+03 9.158168692E-04 7.255570784E+03 3.084748122E+06
+ 3.311512774E+06 7.047134284E+03 9.120713710E-04 7.210755892E+03 3.133051456E+06
+ 3.355666278E+06 7.006441676E+03 9.083384201E-04 7.165941000E+03 3.181991411E+06
+ 3.399819782E+06 6.966945510E+03 9.046179878E-04 7.121126108E+03 3.230050945E+06
+ 3.443973285E+06 6.926973746E+03 9.009100455E-04 7.076311216E+03 3.279509609E+06
+ 3.488126789E+06 6.886778168E+03 8.972145647E-04 7.031496324E+03 3.328684758E+06
+ 3.532280293E+06 6.847370011E+03 8.935315169E-04 6.986681432E+03 3.377449330E+06
+ 3.576433796E+06 6.807896808E+03 8.898608734E-04 6.941866539E+03 3.427004252E+06
+ 3.620587300E+06 6.769208769E+03 8.862026057E-04 6.897051647E+03 3.477278499E+06
+ 3.664740804E+06 6.729711691E+03 8.825566853E-04 6.852236755E+03 3.527352903E+06
+ 3.708894307E+06 6.691292707E+03 8.789230836E-04 6.807421863E+03 3.576959962E+06
+ 3.753047811E+06 6.652059367E+03 8.753017721E-04 6.762606971E+03 3.627925740E+06
+ 3.797201315E+06 6.614014605E+03 8.716927222E-04 6.717792079E+03 3.678257663E+06
+ 3.841354818E+06 6.575490130E+03 8.680959053E-04 6.672977187E+03 3.729707489E+06
+ 3.885508322E+06 6.536758963E+03 8.645112931E-04 6.628162294E+03 3.780957172E+06
+ 3.929661826E+06 6.498789157E+03 8.609388568E-04 6.583347402E+03 3.832449225E+06
+ 3.973815329E+06 6.460745090E+03 8.573785681E-04 6.538532510E+03 3.883549090E+06
+ 4.017968833E+06 6.423484857E+03 8.538303984E-04 6.493717618E+03 3.935466563E+06
+ 4.062122336E+06 6.385413283E+03 8.502943192E-04 6.448902726E+03 3.988145460E+06
+ 4.106275840E+06 6.348014539E+03 8.467703020E-04 6.404087834E+03 4.040180614E+06
+ 4.150429344E+06 6.310597907E+03 8.432583183E-04 6.359272942E+03 4.092983544E+06
+ 4.194582847E+06 6.273959536E+03 8.397583396E-04 6.314458049E+03 4.145922100E+06
+ 4.238736351E+06 6.236505165E+03 8.362703375E-04 6.269643157E+03 4.199640616E+06
+ 4.282889855E+06 6.200121244E+03 8.327942834E-04 6.224828265E+03 4.252702627E+06
+ 4.327043358E+06 6.162917394E+03 8.293301490E-04 6.180013373E+03 4.306558210E+06
+ 4.371196862E+06 6.126893062E+03 8.258779058E-04 6.135198481E+03 4.360551592E+06
+ 4.415350366E+06 6.090383589E+03 8.224375253E-04 6.090383589E+03 4.415350366E+06
+ 4.476111095E+06 6.039736629E+03 8.213932606E-04 6.053783545E+03 4.459227693E+06
+ 4.536871823E+06 5.990120109E+03 8.160586635E-04 6.017183500E+03 4.504110462E+06
+ 4.597632552E+06 5.940763975E+03 8.107534122E-04 5.980583456E+03 4.549207081E+06
+ 4.658393281E+06 5.891765835E+03 8.054773855E-04 5.943983412E+03 4.593705128E+06
+ 4.719154010E+06 5.843074205E+03 8.002304619E-04 5.907383368E+03 4.638495941E+06
+ 4.779914738E+06 5.794096495E+03 7.950125203E-04 5.870783323E+03 4.684210563E+06
+ 4.840675467E+06 5.746647368E+03 7.898234401E-04 5.834183279E+03 4.730146787E+06
+ 4.901436196E+06 5.698235404E+03 7.846631004E-04 5.797583235E+03 4.775574332E+06
+ 4.962196925E+06 5.650882841E+03 7.795313810E-04 5.760983191E+03 4.821961474E+06
+ 5.022957653E+06 5.603747038E+03 7.744281616E-04 5.724383147E+03 4.868579311E+06
+ 5.083718382E+06 5.556945002E+03 7.693533223E-04 5.687783102E+03 4.914680628E+06
+ 5.144479111E+06 5.510439614E+03 7.643067434E-04 5.651183058E+03 4.961801546E+06
+ 5.205239840E+06 5.463631713E+03 7.592883054E-04 5.614583014E+03 5.009151254E+06
+ 5.266000569E+06 5.418351126E+03 7.542978890E-04 5.577982970E+03 5.055944809E+06
+ 5.326761297E+06 5.372128104E+03 7.493353751E-04 5.541382926E+03 5.103747802E+06
+ 5.387522026E+06 5.326829005E+03 7.444006451E-04 5.504782881E+03 5.151795169E+06
+ 5.448282755E+06 5.281808752E+03 7.394935803E-04 5.468182837E+03 5.199312165E+06
+ 5.509043484E+06 5.237132062E+03 7.346140625E-04 5.431582793E+03 5.247857824E+06
+ 5.569804212E+06 5.192727780E+03 7.297619734E-04 5.394982749E+03 5.296652218E+06
+ 5.630564941E+06 5.148013204E+03 7.249371954E-04 5.358382705E+03 5.344919527E+06
+ 5.691325670E+06 5.104803160E+03 7.201396108E-04 5.321782660E+03 5.394225607E+06
+ 5.752086399E+06 5.060651002E+03 7.153691023E-04 5.285182616E+03 5.443775929E+06
+ 5.812847127E+06 5.017408435E+03 7.106255528E-04 5.248582572E+03 5.492837833E+06
+ 5.873607856E+06 4.974430615E+03 7.059088453E-04 5.211982528E+03 5.543794315E+06
+ 5.934368585E+06 4.931760942E+03 7.012188634E-04 5.175382483E+03 5.593295770E+06
+ 5.995129314E+06 4.889387038E+03 6.965554905E-04 5.138782439E+03 5.643971625E+06
+ 6.055890043E+06 4.846688886E+03 6.919186108E-04 5.102182395E+03 5.694917904E+06
+ 6.116650771E+06 4.804895836E+03 6.873081081E-04 5.065582351E+03 5.745277125E+06
+ 6.177411500E+06 4.763531816E+03 6.827238671E-04 5.028982307E+03 5.796745516E+06
+ 6.238172229E+06 4.722264253E+03 6.781657723E-04 4.992382262E+03 5.848550305E+06
+ 6.298932958E+06 4.681285595E+03 6.736337086E-04 4.955782218E+03 5.899772749E+06
+ 6.359693686E+06 4.640570343E+03 6.691275612E-04 4.919182174E+03 5.952129261E+06
+ 6.420454415E+06 4.599520259E+03 6.646472156E-04 4.882582130E+03 6.004761562E+06
+ 6.481215144E+06 4.559962918E+03 6.601925574E-04 4.845982086E+03 6.056899793E+06
+ 6.541975873E+06 4.519391559E+03 6.557634726E-04 4.809382041E+03 6.110204648E+06
+ 6.602736601E+06 4.479795255E+03 6.513598474E-04 4.772781997E+03 6.164066146E+06
+ 6.663497330E+06 4.440402243E+03 6.469815682E-04 4.736181953E+03 6.217965453E+06
+ 6.724258059E+06 4.401308976E+03 6.426285218E-04 4.699581909E+03 6.271280161E+06
+ 6.785018788E+06 4.362478690E+03 6.383005953E-04 4.662981865E+03 6.325798562E+06
+ 6.845779517E+06 4.323900544E+03 6.339976759E-04 4.626381820E+03 6.380616694E+06
+ 6.906540245E+06 4.285583113E+03 6.297196511E-04 4.589781776E+03 6.435821735E+06
+ 6.967300974E+06 4.246910225E+03 6.254664088E-04 4.553181732E+03 6.491344229E+06
+ 7.028061703E+06 4.209729478E+03 6.212378370E-04 4.516581688E+03 6.546271077E+06
+ 7.088822432E+06 4.171551661E+03 6.170338241E-04 4.479981643E+03 6.602454267E+06
+ 7.149583160E+06 4.134255265E+03 6.128542588E-04 4.443381599E+03 6.658956669E+06
+ 7.210343889E+06 4.097191428E+03 6.086990300E-04 4.406781555E+03 6.715883784E+06
+ 7.271104618E+06 4.060465304E+03 6.045680267E-04 4.370181511E+03 6.773133970E+06
+ 7.331865347E+06 4.023926087E+03 6.004611386E-04 4.333581467E+03 6.829793923E+06
+ 7.392626075E+06 3.987032862E+03 5.963782554E-04 4.296981422E+03 6.886087691E+06
+ 7.453386804E+06 3.951594816E+03 5.923192669E-04 4.260381378E+03 6.946082627E+06
+ 7.514147533E+06 3.915177150E+03 5.882840637E-04 4.223781334E+03 7.004764654E+06
+ 7.574908262E+06 3.880251810E+03 5.842725362E-04 4.187181290E+03 7.063876540E+06
+ 7.635668991E+06 3.844303739E+03 5.802845752E-04 4.150581246E+03 7.123360158E+06
+ 7.696429719E+06 3.809209313E+03 5.763200720E-04 4.113981201E+03 7.183236682E+06
+ 7.757190448E+06 3.774375726E+03 5.723789180E-04 4.077381157E+03 7.242516605E+06
+ 7.817951177E+06 3.739805760E+03 5.684610048E-04 4.040781113E+03 7.304285613E+06
+ 7.878711906E+06 3.705449248E+03 5.645662245E-04 4.004181069E+03 7.364326288E+06
+ 7.939472634E+06 3.671329712E+03 5.606944693E-04 3.967581025E+03 7.425813664E+06
+ 8.000233363E+06 3.637444465E+03 5.568456319E-04 3.930980980E+03 7.487687524E+06
+ 8.060994092E+06 3.603174984E+03 5.530196050E-04 3.894380936E+03 7.550028730E+06
+ 8.121754821E+06 3.570376432E+03 5.492162818E-04 3.857780892E+03 7.612817850E+06
+ 8.182515549E+06 3.536552236E+03 5.454355558E-04 3.821180848E+03 7.676029011E+06
+ 8.243276278E+06 3.503584787E+03 5.416773206E-04 3.784580803E+03 7.739685544E+06
+ 8.304037007E+06 3.470824061E+03 5.379414704E-04 3.747980759E+03 7.802758172E+06
+ 8.364797736E+06 3.437890588E+03 5.342278993E-04 3.711380715E+03 7.868387738E+06
+ 8.425558465E+06 3.406256077E+03 5.305365020E-04 3.674780671E+03 7.932356171E+06
+ 8.486319193E+06 3.373574984E+03 5.268671734E-04 3.638180627E+03 7.998934345E+06
+ 8.547079922E+06 3.342356341E+03 5.232198087E-04 3.601580582E+03 8.063833347E+06
+ 8.607840651E+06 3.310102658E+03 5.195943033E-04 3.564980538E+03 8.131409132E+06
+ 8.668601380E+06 3.278699669E+03 5.159905530E-04 3.528380494E+03 8.197272272E+06
+ 8.729362108E+06 3.247491584E+03 5.124084540E-04 3.491780450E+03 8.265863245E+06
+ 8.790122837E+06 3.216522081E+03 5.088479025E-04 3.455180406E+03 8.332727254E+06
+ 8.850883566E+06 3.185779186E+03 5.053087953E-04 3.418580361E+03 8.401607618E+06
+ 8.911644295E+06 3.155252716E+03 5.017910293E-04 3.381980317E+03 8.470644104E+06
+ 8.972405023E+06 3.124926396E+03 4.982945018E-04 3.345380273E+03 8.540220240E+06
+ 9.033165752E+06 3.094206647E+03 4.948191103E-04 3.308780229E+03 8.610342952E+06
+ 9.093926481E+06 3.064908922E+03 4.913647528E-04 3.272180185E+03 8.682223735E+06
+ 9.154687210E+06 3.034594226E+03 4.879313273E-04 3.235580140E+03 8.752274920E+06
+ 9.215447939E+06 3.005731536E+03 4.845187323E-04 3.198980096E+03 8.825290719E+06
+ 9.276208667E+06 2.975816665E+03 4.811268667E-04 3.162380052E+03 8.896510024E+06
+ 9.336969396E+06 2.946736026E+03 4.777556294E-04 3.125780008E+03 8.970725135E+06
+ 9.397730125E+06 2.917838385E+03 4.744049199E-04 3.089179963E+03 9.044204413E+06
+ 9.458490854E+06 2.889217275E+03 4.710746378E-04 3.052579919E+03 9.118562435E+06
+ 9.519251582E+06 2.860757134E+03 4.677646831E-04 3.015979875E+03 9.193402726E+06
+ 9.580012311E+06 2.832486787E+03 4.644749562E-04 2.979379831E+03 9.268943861E+06
+ 9.640773040E+06 2.804415097E+03 4.612053574E-04 2.942779787E+03 9.346395091E+06
+ 9.701533769E+06 2.775936935E+03 4.579557879E-04 2.906179742E+03 9.421920753E+06
+ 9.762294497E+06 2.748867870E+03 4.547261488E-04 2.869579698E+03 9.500798007E+06
+ 9.823055226E+06 2.720768443E+03 4.515163415E-04 2.832979654E+03 9.578973108E+06
+ 9.883815955E+06 2.694100471E+03 4.483262680E-04 2.796379610E+03 9.657829250E+06
+ 9.944576684E+06 2.666375469E+03 4.451558302E-04 2.759779566E+03 9.737481613E+06
+ 1.000533741E+07 2.639479787E+03 4.420049307E-04 2.723179521E+03 9.817820490E+06
+ 1.006609814E+07 2.612762577E+03 4.388734722E-04 2.686579477E+03 9.900235409E+06
+ 1.012685887E+07 2.586214905E+03 4.357613577E-04 2.649979433E+03 9.982091419E+06
+ 1.018761960E+07 2.559875814E+03 4.326684906E-04 2.613379389E+03 1.006472212E+07
+ 1.024838033E+07 2.533727058E+03 4.295947745E-04 2.576779345E+03 1.014953728E+07
+ 1.030914106E+07 2.507772628E+03 4.265401134E-04 2.540179300E+03 1.023373425E+07
+ 1.036990179E+07 2.481992368E+03 4.235044116E-04 2.503579256E+03 1.031873362E+07
+ 1.043066251E+07 2.456395219E+03 4.204875737E-04 2.466979212E+03 1.040612297E+07
+ 1.049142324E+07 2.430379168E+03 4.174895046E-04 2.430379168E+03 1.049142324E+07
+ 1.073654908E+07 2.327979160E+03 4.094568117E-04 2.406279675E+03 1.054822818E+07
+ 1.098167492E+07 2.229587945E+03 3.933674175E-04 2.382180182E+03 1.060556276E+07
+ 1.122680076E+07 2.135077252E+03 3.778549150E-04 2.358080689E+03 1.066346113E+07
+ 1.147192659E+07 2.044300240E+03 3.629010139E-04 2.333981196E+03 1.072191051E+07
+ 1.171705243E+07 1.957122026E+03 3.484879052E-04 2.309881703E+03 1.078090036E+07
+ 1.196217827E+07 1.873412626E+03 3.345982522E-04 2.285782210E+03 1.084046360E+07
+ 1.220730411E+07 1.793045068E+03 3.212151824E-04 2.261682717E+03 1.090061198E+07
+ 1.245242994E+07 1.715887991E+03 3.083222779E-04 2.237583225E+03 1.096138725E+07
+ 1.269755578E+07 1.641842494E+03 2.959035674E-04 2.213483732E+03 1.102276846E+07
+ 1.294268162E+07 1.570784460E+03 2.839435169E-04 2.189384239E+03 1.108474964E+07
+ 1.318780746E+07 1.502606098E+03 2.724270217E-04 2.165284746E+03 1.114736700E+07
+ 1.343293329E+07 1.437201586E+03 2.613393969E-04 2.141185253E+03 1.121066039E+07
+ 1.367805913E+07 1.374457245E+03 2.506663697E-04 2.117085760E+03 1.127461847E+07
+ 1.392318497E+07 1.314279746E+03 2.403940703E-04 2.092986267E+03 1.133923196E+07
+ 1.416831081E+07 1.256572380E+03 2.305090236E-04 2.068886774E+03 1.140453971E+07
+ 1.441343665E+07 1.201242255E+03 2.209981407E-04 2.044787282E+03 1.147058493E+07
+ 1.465856248E+07 1.148198515E+03 2.118487107E-04 2.020687789E+03 1.153735694E+07
+ 1.490368832E+07 1.097354500E+03 2.030483923E-04 1.996588296E+03 1.160484756E+07
+ 1.514881416E+07 1.048625969E+03 1.945852057E-04 1.972488803E+03 1.167309899E+07
+ 1.539394000E+07 1.001924074E+03 1.864475243E-04 1.948389310E+03 1.174215813E+07
+ 1.563906583E+07 9.571858074E+02 1.786240669E-04 1.924289817E+03 1.181201583E+07
+ 1.588419167E+07 9.143278777E+02 1.711038897E-04 1.900190324E+03 1.188266470E+07
+ 1.612931751E+07 8.732863993E+02 1.638763780E-04 1.876090831E+03 1.195418107E+07
+ 1.637444335E+07 8.339727734E+02 1.569312392E-04 1.851991338E+03 1.202652794E+07
+ 1.661956918E+07 7.963275666E+02 1.502584946E-04 1.827891846E+03 1.209978497E+07
+ 1.686469502E+07 7.602856185E+02 1.438484717E-04 1.803792353E+03 1.217391717E+07
+ 1.710982086E+07 7.257835409E+02 1.376917974E-04 1.779692860E+03 1.224900712E+07
+ 1.735494670E+07 6.927576411E+02 1.317793898E-04 1.755593367E+03 1.232504946E+07
+ 1.760007254E+07 6.611546520E+02 1.261024516E-04 1.731493874E+03 1.240204026E+07
+ 1.784519837E+07 6.309152237E+02 1.206524626E-04 1.707394381E+03 1.248006638E+07
+ 1.809032421E+07 6.019845882E+02 1.154211727E-04 1.683294888E+03 1.255912470E+07
+ 1.833545005E+07 5.743199183E+02 1.104005951E-04 1.659195395E+03 1.263921406E+07
+ 1.858057589E+07 5.478511831E+02 1.055829991E-04 1.635095903E+03 1.272042620E+07
+ 1.882570172E+07 5.225392271E+02 1.009609040E-04 1.610996410E+03 1.280276146E+07
+ 1.907082756E+07 4.983368731E+02 9.652707183E-05 1.586896917E+03 1.288622125E+07
+ 1.931595340E+07 4.752004773E+02 9.227450134E-05 1.562797424E+03 1.297086957E+07
+ 1.956107924E+07 4.530833134E+02 8.819642141E-05 1.538697931E+03 1.305678875E+07
+ 1.980620507E+07 4.319450377E+02 8.428628483E-05 1.514598438E+03 1.314396227E+07
+ 2.005133091E+07 4.117451088E+02 8.053776219E-05 1.490498945E+03 1.323240434E+07
+ 2.029645675E+07 3.924451168E+02 7.694473578E-05 1.466399452E+03 1.332220953E+07
+ 2.054158259E+07 3.740166366E+02 7.350129377E-05 1.442299960E+03 1.341342633E+07
+ 2.078670843E+07 3.564048123E+02 7.020172431E-05 1.418200467E+03 1.350607167E+07
+ 2.103183426E+07 3.395745484E+02 6.704050995E-05 1.394100974E+03 1.360019820E+07
+ 2.127696010E+07 3.235277770E+02 6.401232201E-05 1.370001481E+03 1.369585661E+07
+ 2.152208594E+07 3.081923787E+02 6.111201512E-05 1.345901988E+03 1.379306203E+07
+ 2.176721178E+07 2.935620102E+02 5.833462194E-05 1.321802495E+03 1.389194641E+07
+ 2.201233761E+07 2.795885516E+02 5.567534789E-05 1.297703002E+03 1.399252976E+07
+ 2.225746345E+07 2.662553459E+02 5.312956605E-05 1.273603509E+03 1.409487454E+07
+ 2.250258929E+07 2.535272262E+02 5.069281218E-05 1.249504016E+03 1.419904611E+07
+ 2.274771513E+07 2.413955599E+02 4.836077981E-05 1.225404524E+03 1.430507188E+07
+ 2.299284096E+07 2.298138152E+02 4.612931548E-05 1.201305031E+03 1.441315269E+07
+ 2.323796680E+07 2.187668892E+02 4.399441407E-05 1.177205538E+03 1.452319464E+07
+ 2.348309264E+07 2.082320315E+02 4.195221423E-05 1.153106045E+03 1.463540833E+07
+ 2.372821848E+07 1.981960078E+02 3.999899398E-05 1.129006552E+03 1.474983910E+07
+ 2.397334432E+07 1.886185334E+02 3.813116630E-05 1.104907059E+03 1.486658068E+07
+ 2.421847015E+07 1.794995290E+02 3.634527493E-05 1.080807566E+03 1.498573140E+07
+ 2.446359599E+07 1.707978011E+02 3.463799026E-05 1.056708073E+03 1.510739764E+07
+ 2.470872183E+07 1.625051135E+02 3.300610524E-05 1.032608581E+03 1.523169227E+07
+ 2.495384767E+07 1.546031991E+02 3.144653150E-05 1.008509088E+03 1.535874488E+07
+ 2.519897350E+07 1.470849484E+02 2.995629550E-05 9.844095948E+02 1.548866811E+07
+ 2.544409934E+07 1.399138038E+02 2.853253482E-05 9.603101019E+02 1.562160946E+07
+ 2.568922518E+07 1.330930608E+02 2.717249448E-05 9.362106090E+02 1.575771819E+07
+ 2.593435102E+07 1.265951419E+02 2.587352348E-05 9.121111161E+02 1.589721067E+07
+ 2.617947685E+07 1.204019132E+02 2.463307127E-05 8.880116232E+02 1.604009516E+07
+ 2.642460269E+07 1.145056121E+02 2.344868445E-05 8.639121303E+02 1.618678439E+07
+ 2.666972853E+07 1.089027314E+02 2.231800353E-05 8.398126375E+02 1.633731248E+07
+ 2.691485437E+07 1.035606662E+02 2.123875970E-05 8.157131446E+02 1.649195285E+07
+ 2.715998020E+07 9.848649557E+01 2.020877179E-05 7.916136517E+02 1.665101280E+07
+ 2.740510604E+07 9.364932322E+01 1.922594325E-05 7.675141588E+02 1.681463084E+07
+ 2.765023188E+07 8.904882826E+01 1.828825929E-05 7.434146659E+02 1.698315355E+07
+ 2.789535772E+07 8.468100100E+01 1.739378398E-05 7.193151731E+02 1.715696914E+07
+ 2.814048356E+07 8.052692326E+01 1.654065754E-05 6.952156802E+02 1.733633641E+07
+ 2.838560939E+07 7.656791498E+01 1.572709370E-05 6.711161873E+02 1.752160816E+07
+ 2.863073523E+07 7.281271100E+01 1.495137705E-05 6.470166944E+02 1.771333624E+07
+ 2.887586107E+07 6.924281960E+01 1.421186058E-05 6.229172015E+02 1.791192154E+07
+ 2.912098691E+07 6.584322448E+01 1.350696323E-05 5.988177086E+02 1.811789228E+07
+ 2.936611274E+07 6.261607294E+01 1.283516750E-05 5.747182158E+02 1.833184596E+07
+ 2.961123858E+07 5.954297290E+01 1.219501721E-05 5.506187229E+02 1.855435833E+07
+ 2.985636442E+07 5.663248726E+01 1.158511522E-05 5.265192300E+02 1.878645238E+07
+ 3.010149026E+07 5.386796458E+01 1.100412133E-05 5.024197371E+02 1.902872801E+07
+ 3.034661609E+07 5.123264836E+01 1.045075016E-05 4.783202442E+02 1.928227790E+07
+ 3.059174193E+07 4.873907520E+01 9.923769150E-06 4.542207514E+02 1.954821006E+07
+ 3.083686777E+07 4.637277761E+01 9.421996582E-06 4.301212585E+02 1.982786423E+07
+ 3.108199361E+07 4.411559504E+01 8.944299709E-06 4.060217656E+02 2.012291676E+07
+ 3.132711945E+07 4.198194392E+01 8.489592910E-06 3.819222727E+02 2.043508632E+07
+ 3.157224528E+07 3.995711154E+01 8.056835917E-06 3.578227798E+02 2.076657228E+07
+ 3.181737112E+07 3.802590984E+01 7.645032101E-06 3.337232869E+02 2.112008765E+07
+ 3.206249696E+07 3.620259486E+01 7.253226814E-06 3.096237941E+02 2.149874801E+07
+ 3.230762280E+07 3.446984805E+01 6.880505781E-06 2.855243012E+02 2.190662038E+07
+ 3.255274863E+07 3.282892246E+01 6.525993550E-06 2.614248083E+02 2.234902766E+07
+ 3.279787447E+07 3.127266602E+01 6.188851994E-06 2.373253154E+02 2.283241118E+07
+ 3.304300031E+07 2.979710238E+01 5.868278863E-06 2.132258225E+02 2.336565575E+07
+ 3.328812615E+07 2.838821702E+01 5.563506382E-06 1.891263297E+02 2.396007627E+07
+ 3.353325198E+07 2.707094103E+01 5.273799902E-06 1.650268368E+02 2.463309219E+07
+ 3.377837782E+07 2.580566304E+01 4.998456596E-06 1.409273439E+02 2.540881768E+07
+ 3.402350366E+07 2.461377671E+01 4.736804199E-06 1.168278510E+02 2.632692549E+07
+ 3.426862950E+07 2.348416041E+01 4.488199790E-06 9.272835813E+01 2.745305434E+07
+ 3.451375534E+07 2.241417016E+01 4.252028624E-06 6.862886524E+01 2.891895907E+07
+ 3.475888117E+07 2.140013490E+01 4.027702998E-06 4.452937236E+01 3.103648197E+07
+ 3.500400701E+07 2.042987948E+01 3.814661162E-06 2.042987948E+01 3.500400701E+07
+ 3.536061969E+07 1.907099778E+01 3.687310803E-06 2.022564490E+01 3.505613962E+07
+ 3.571723237E+07 1.779822735E+01 3.453194515E-06 2.002141032E+01 3.510876837E+07
+ 3.607384505E+07 1.660642255E+01 3.233128983E-06 1.981717573E+01 3.516191666E+07
+ 3.643045773E+07 1.549069159E+01 3.026326196E-06 1.961294115E+01 3.521558754E+07
+ 3.678707041E+07 1.444648999E+01 2.832038724E-06 1.940870657E+01 3.526979171E+07
+ 3.714368309E+07 1.346942223E+01 2.649557859E-06 1.920447199E+01 3.532454019E+07
+ 3.750029578E+07 1.255542147E+01 2.478211822E-06 1.900023740E+01 3.537984435E+07
+ 3.785690846E+07 1.170063534E+01 2.317364043E-06 1.879600282E+01 3.543571593E+07
+ 3.821352114E+07 1.090145512E+01 2.166411502E-06 1.859176824E+01 3.549216705E+07
+ 3.857013382E+07 1.015439931E+01 2.024783147E-06 1.838753366E+01 3.554921023E+07
+ 3.892674650E+07 9.456256890E+00 1.891938367E-06 1.818329908E+01 3.560685122E+07
+ 3.928335918E+07 8.804024993E+00 1.767365530E-06 1.797906449E+01 3.566511627E+07
+ 3.963997186E+07 8.194822243E+00 1.650580586E-06 1.777482991E+01 3.572401240E+07
+ 3.999658454E+07 7.625930810E+00 1.541125717E-06 1.757059533E+01 3.578355503E+07
+ 4.035319722E+07 7.094805208E+00 1.438568056E-06 1.736636075E+01 3.584376123E+07
+ 4.070980990E+07 6.599151940E+00 1.342498454E-06 1.716212616E+01 3.590463636E+07
+ 4.106642258E+07 6.136587081E+00 1.252530299E-06 1.695789158E+01 3.596621134E+07
+ 4.142303526E+07 5.705120553E+00 1.168298389E-06 1.675365700E+01 3.602849504E+07
+ 4.177964794E+07 5.302704402E+00 1.089457854E-06 1.654942242E+01 3.609150446E+07
+ 4.213626062E+07 4.927490593E+00 1.015683124E-06 1.634518783E+01 3.615525395E+07
+ 4.249287330E+07 4.577721559E+00 9.466669439E-07 1.614095325E+01 3.621976490E+07
+ 4.284948598E+07 4.251768128E+00 8.821194339E-07 1.593671867E+01 3.628505854E+07
+ 4.320609867E+07 3.948073881E+00 8.217671884E-07 1.573248409E+01 3.635115089E+07
+ 4.356271135E+07 3.665196769E+00 7.653524210E-07 1.552824951E+01 3.641806501E+07
+ 4.391932403E+07 3.401770018E+00 7.126321455E-07 1.532401492E+01 3.648581328E+07
+ 4.427593671E+07 3.156517596E+00 6.633773969E-07 1.511978034E+01 3.655443501E+07
+ 4.463254939E+07 2.928224609E+00 6.173724876E-07 1.491554576E+01 3.662394376E+07
+ 4.498916207E+07 2.715830136E+00 5.744142996E-07 1.471131118E+01 3.669436342E+07
+ 4.534577475E+07 2.518214567E+00 5.343116100E-07 1.450707659E+01 3.676571889E+07
+ 4.570238743E+07 2.334414280E+00 4.968844490E-07 1.430284201E+01 3.683802375E+07
+ 4.605900011E+07 2.163527085E+00 4.619634889E-07 1.409860743E+01 3.691133466E+07
+ 4.641561279E+07 2.004642682E+00 4.293894631E-07 1.389437285E+01 3.698565591E+07
+ 4.677222547E+07 1.857013080E+00 3.990126133E-07 1.369013827E+01 3.706101927E+07
+ 4.712883815E+07 1.719836360E+00 3.706921640E-07 1.348590368E+01 3.713746601E+07
+ 4.748545083E+07 1.592396901E+00 3.442958243E-07 1.328166910E+01 3.721501253E+07
+ 4.784206351E+07 1.474053432E+00 3.196993128E-07 1.307743452E+01 3.729371165E+07
+ 4.819867619E+07 1.364183340E+00 2.967859083E-07 1.287319994E+01 3.737358897E+07
+ 4.855528888E+07 1.262198538E+00 2.754460225E-07 1.266896535E+01 3.745466786E+07
+ 4.891190156E+07 1.167532734E+00 2.555767946E-07 1.246473077E+01 3.753701738E+07
+ 4.926851424E+07 1.079749061E+00 2.370817074E-07 1.226049619E+01 3.762065407E+07
+ 4.962512692E+07 9.982964563E-01 2.198702229E-07 1.205626161E+01 3.770562398E+07
+ 4.998173960E+07 9.227857791E-01 2.038574368E-07 1.185202702E+01 3.779197510E+07
+ 5.033835228E+07 8.527814677E-01 1.889637522E-07 1.164779244E+01 3.787976172E+07
+ 5.069496496E+07 7.878879791E-01 1.751145692E-07 1.144355786E+01 3.796902613E+07
+ 5.105157764E+07 7.277640299E-01 1.622399923E-07 1.123932328E+01 3.805981200E+07
+ 5.140819032E+07 6.720688897E-01 1.502745531E-07 1.103508870E+01 3.815219097E+07
+ 5.176480300E+07 6.204871507E-01 1.391569475E-07 1.083085411E+01 3.824621260E+07
+ 5.212141568E+07 5.727269397E-01 1.288297882E-07 1.062661953E+01 3.834193808E+07
+ 5.247802836E+07 5.285099885E-01 1.192393699E-07 1.042238495E+01 3.843941769E+07
+ 5.283464104E+07 4.876150762E-01 1.103354479E-07 1.021815037E+01 3.853874050E+07
+ 5.319125372E+07 4.497401878E-01 1.020710291E-07 1.001391578E+01 3.863996836E+07
+ 5.354786640E+07 4.147322425E-01 9.440217383E-08 9.809681202E+00 3.874319537E+07
+ 5.390447909E+07 3.823485342E-01 8.728781015E-08 9.605446619E+00 3.884848190E+07
+ 5.426109177E+07 3.524108480E-01 8.068955734E-08 9.401212037E+00 3.895592829E+07
+ 5.461770445E+07 3.247196423E-01 7.457156026E-08 9.196977455E+00 3.906562230E+07
+ 5.497431713E+07 2.991742034E-01 6.890033281E-08 8.992742873E+00 3.917764909E+07
+ 5.533092981E+07 2.755497306E-01 6.364461049E-08 8.788508290E+00 3.929214669E+07
+ 5.568754249E+07 2.537347995E-01 5.877521146E-08 8.584273708E+00 3.940920943E+07
+ 5.604415517E+07 2.335852393E-01 5.426490570E-08 8.380039126E+00 3.952894576E+07
+ 5.640076785E+07 2.149881755E-01 5.008829181E-08 8.175804543E+00 3.965150724E+07
+ 5.675738053E+07 1.978145910E-01 4.622168103E-08 7.971569961E+00 3.977701659E+07
+ 5.711399321E+07 1.819934935E-01 4.264298814E-08 7.767335379E+00 3.990562550E+07
+ 5.747060589E+07 1.673689792E-01 3.933162882E-08 7.563100797E+00 4.003750644E+07
+ 5.782721857E+07 1.539079609E-01 3.626842322E-08 7.358866214E+00 4.017283540E+07
+ 5.818383125E+07 1.414731868E-01 3.343550520E-08 7.154631632E+00 4.031179238E+07
+ 5.854044393E+07 1.300357908E-01 3.081623715E-08 6.950397050E+00 4.045457686E+07
+ 5.889705661E+07 1.194992013E-01 2.839512993E-08 6.746162467E+00 4.060144312E+07
+ 5.925366929E+07 1.097641009E-01 2.615776773E-08 6.541927885E+00 4.075261600E+07
+ 5.961028198E+07 1.008104554E-01 2.409073753E-08 6.337693303E+00 4.090833339E+07
+ 5.996689466E+07 9.255985583E-02 2.218156288E-08 6.133458721E+00 4.106892106E+07
+ 6.032350734E+07 8.496997911E-02 2.041864182E-08 5.929224138E+00 4.123471122E+07
+ 6.068012002E+07 7.798252894E-02 1.879118865E-08 5.724989556E+00 4.140605498E+07
+ 6.103673270E+07 7.155312486E-02 1.728917936E-08 5.520754974E+00 4.158330973E+07
+ 6.139334538E+07 6.562473882E-02 1.590330047E-08 5.316520391E+00 4.176698078E+07
+ 6.174995806E+07 6.017585064E-02 1.462490113E-08 5.112285809E+00 4.195749665E+07
+ 6.210657074E+07 5.519748962E-02 1.344594824E-08 4.908051227E+00 4.215541327E+07
+ 6.246318342E+07 5.059042574E-02 1.235898445E-08 4.703816645E+00 4.236138864E+07
+ 6.281979610E+07 4.637148602E-02 1.135708884E-08 4.499582062E+00 4.257609780E+07
+ 6.317640878E+07 4.248595900E-02 1.043384017E-08 4.295347480E+00 4.280031660E+07
+ 6.353302146E+07 3.891505069E-02 9.583282445E-09 4.091112898E+00 4.303498656E+07
+ 6.388963414E+07 3.563920514E-02 8.799892787E-09 3.886878315E+00 4.328112563E+07
+ 6.424624682E+07 3.263407545E-02 8.078551371E-09 3.682643733E+00 4.353996337E+07
+ 6.460285950E+07 2.987545074E-02 7.414513342E-09 3.478409151E+00 4.381293924E+07
+ 6.495947219E+07 2.735608605E-02 6.803382583E-09 3.274174569E+00 4.410166935E+07
+ 6.531608487E+07 2.501914724E-02 6.241087230E-09 3.069939986E+00 4.440817965E+07
+ 6.567269755E+07 2.288281928E-02 5.723856805E-09 2.865705404E+00 4.473488835E+07
+ 6.602931023E+07 2.093038850E-02 5.248200885E-09 2.661470822E+00 4.508470843E+07
+ 6.638592291E+07 1.913732965E-02 4.810889205E-09 2.457236239E+00 4.546124672E+07
+ 6.674253559E+07 1.749051046E-02 4.408933099E-09 2.253001657E+00 4.586908291E+07
+ 6.709914827E+07 1.599101795E-02 4.039568199E-09 2.048767075E+00 4.631396611E+07
+ 6.745576095E+07 1.460807387E-02 3.700238314E-09 1.844532493E+00 4.680361651E+07
+ 6.781237363E+07 1.334513517E-02 3.388580411E-09 1.640297910E+00 4.734830286E+07
+ 6.816898631E+07 1.219073288E-02 3.102410622E-09 1.436063328E+00 4.796244526E+07
+ 6.852559899E+07 1.112850060E-02 2.839711222E-09 1.231828746E+00 4.866674527E+07
+ 6.888221167E+07 1.016127150E-02 2.598618505E-09 1.027594163E+00 4.949377835E+07
+ 6.923882435E+07 9.261638043E-03 2.377411505E-09 8.233595811E-01 5.049660476E+07
+ 6.959543703E+07 8.465927221E-03 2.174501497E-09 6.191249989E-01 5.177457657E+07
+ 6.995204971E+07 7.722946446E-03 1.988422249E-09 4.148904166E-01 5.354618799E+07
+ 7.030866240E+07 7.038553472E-03 1.817820944E-09 2.106558343E-01 5.648779782E+07
+ 7.066527508E+07 6.421251995E-03 1.661449755E-09 6.421251995E-03 7.066527400E+07
+ 7.072948760E+07 6.357039475E-03 1.000000000E-09 6.357039475E-03 7.072948756E+07
+ 7.079370012E+07 6.292826955E-03 1.000000000E-09 6.292826955E-03 7.079369600E+07
+ 7.085791264E+07 6.228614435E-03 1.000000000E-09 6.228614435E-03 7.085790400E+07
+ 7.092212516E+07 6.164401915E-03 1.000000000E-09 6.164401915E-03 7.092211200E+07
+ 7.098633768E+07 6.100189395E-03 1.000000000E-09 6.100189395E-03 7.098633769E+07
+ 7.105055020E+07 6.035976875E-03 1.000000000E-09 6.035976875E-03 7.105053408E+07
+ 7.111476272E+07 5.971764355E-03 1.000000000E-09 5.971764355E-03 7.111475200E+07
+ 7.117897524E+07 5.907551835E-03 1.000000000E-09 5.907551835E-03 7.117897519E+07
+ 7.124318776E+07 5.843339315E-03 1.000000000E-09 5.843339315E-03 7.124318700E+07
+ 7.130740028E+07 5.779126795E-03 1.000000000E-09 5.779126795E-03 7.130740031E+07
+ 7.137161280E+07 5.714914276E-03 1.000000000E-09 5.714914276E-03 7.137161300E+07
+ 7.143582532E+07 5.650701756E-03 1.000000000E-09 5.650701756E-03 7.143582525E+07
+ 7.150003784E+07 5.586489236E-03 1.000000000E-09 5.586489236E-03 7.150003800E+07
+ 7.156425036E+07 5.522276716E-03 1.000000000E-09 5.522276716E-03 7.156424000E+07
+ 7.162846287E+07 5.458064196E-03 1.000000000E-09 5.458064196E-03 7.162846200E+07
+ 7.169267539E+07 5.393851676E-03 1.000000000E-09 5.393851676E-03 7.169267500E+07
+ 7.175688791E+07 5.329639156E-03 1.000000000E-09 5.329639156E-03 7.175688800E+07
+ 7.182110043E+07 5.265426636E-03 1.000000000E-09 5.265426636E-03 7.182110037E+07
+ 7.188531295E+07 5.201214116E-03 1.000000000E-09 5.201214116E-03 7.188531200E+07
+ 7.194952547E+07 5.137001596E-03 1.000000000E-09 5.137001596E-03 7.194952550E+07
+ 7.201373799E+07 5.072789076E-03 1.000000000E-09 5.072789076E-03 7.201373800E+07
+ 7.207795051E+07 5.008576556E-03 1.000000000E-09 5.008576556E-03 7.207795100E+07
+ 7.214216303E+07 4.944364036E-03 1.000000000E-09 4.944364036E-03 7.214216304E+07
+ 7.220637555E+07 4.880151516E-03 1.000000000E-09 4.880151516E-03 7.220637600E+07
+ 7.227058807E+07 4.815938996E-03 1.000000000E-09 4.815938996E-03 7.227059200E+07
+ 7.233480059E+07 4.751726476E-03 1.000000000E-09 4.751726476E-03 7.233480200E+07
+ 7.239901311E+07 4.687513956E-03 1.000000000E-09 4.687513956E-03 7.239901200E+07
+ 7.246322563E+07 4.623301436E-03 1.000000000E-09 4.623301436E-03 7.246322600E+07
+ 7.252743815E+07 4.559088916E-03 1.000000000E-09 4.559088916E-03 7.252743800E+07
+ 7.259165067E+07 4.494876396E-03 1.000000000E-09 4.494876396E-03 7.259165000E+07
+ 7.265586319E+07 4.430663877E-03 1.000000000E-09 4.430663877E-03 7.265586300E+07
+ 7.272007571E+07 4.366451357E-03 1.000000000E-09 4.366451357E-03 7.272007575E+07
+ 7.278428823E+07 4.302238837E-03 1.000000000E-09 4.302238837E-03 7.278428806E+07
+ 7.284850075E+07 4.238026317E-03 1.000000000E-09 4.238026317E-03 7.284850000E+07
+ 7.291271327E+07 4.173813797E-03 1.000000000E-09 4.173813797E-03 7.291271300E+07
+ 7.297692579E+07 4.109601277E-03 1.000000000E-09 4.109601277E-03 7.297692600E+07
+ 7.304113831E+07 4.045388757E-03 1.000000000E-09 4.045388757E-03 7.304115200E+07
+ 7.310535083E+07 3.981176237E-03 1.000000000E-09 3.981176237E-03 7.310535000E+07
+ 7.316956335E+07 3.916963717E-03 1.000000000E-09 3.916963717E-03 7.316955200E+07
+ 7.323377587E+07 3.852751197E-03 1.000000000E-09 3.852751197E-03 7.323377600E+07
+ 7.329798839E+07 3.788538677E-03 1.000000000E-09 3.788538677E-03 7.329798800E+07
+ 7.336220091E+07 3.724326157E-03 1.000000000E-09 3.724326157E-03 7.336220000E+07
+ 7.342641343E+07 3.660113637E-03 1.000000000E-09 3.660113637E-03 7.342641600E+07
+ 7.349062595E+07 3.595901117E-03 1.000000000E-09 3.595901117E-03 7.349062595E+07
+ 7.355483847E+07 3.531688597E-03 1.000000000E-09 3.531688597E-03 7.355483847E+07
+ 7.361905099E+07 3.467476077E-03 1.000000000E-09 3.467476077E-03 7.361905600E+07
+ 7.368326351E+07 3.403263557E-03 1.000000000E-09 3.403263557E-03 7.368326600E+07
+ 7.374747603E+07 3.339051037E-03 1.000000000E-09 3.339051037E-03 7.374747603E+07
+ 7.381168855E+07 3.274838517E-03 1.000000000E-09 3.274838517E-03 7.381171200E+07
+ 7.387590107E+07 3.210625997E-03 1.000000000E-09 3.210625997E-03 7.387588800E+07
+ 7.394011359E+07 3.146413478E-03 1.000000000E-09 3.146413478E-03 7.394013183E+07
+ 7.400432611E+07 3.082200958E-03 1.000000000E-09 3.082200958E-03 7.400432700E+07
+ 7.406853863E+07 3.017988438E-03 1.000000000E-09 3.017988438E-03 7.406853863E+07
+ 7.413275115E+07 2.953775918E-03 1.000000000E-09 2.953775918E-03 7.413275115E+07
+ 7.419696367E+07 2.889563398E-03 1.000000000E-09 2.889563398E-03 7.419699200E+07
+ 7.426117619E+07 2.825350878E-03 1.000000000E-09 2.825350878E-03 7.426124800E+07
+ 7.432538871E+07 2.761138358E-03 1.000000000E-09 2.761138358E-03 7.432538871E+07
+ 7.438960123E+07 2.696925838E-03 1.000000000E-09 2.696925838E-03 7.438961600E+07
+ 7.445381375E+07 2.632713318E-03 1.000000000E-09 2.632713318E-03 7.445381388E+07
+ 7.451802627E+07 2.568500798E-03 1.000000000E-09 2.568500798E-03 7.451802627E+07
+ 7.458223879E+07 2.504288278E-03 1.000000000E-09 2.504288278E-03 7.458223940E+07
+ 7.464645131E+07 2.440075758E-03 1.000000000E-09 2.440075758E-03 7.464645233E+07
+ 7.471066383E+07 2.375863238E-03 1.000000000E-09 2.375863238E-03 7.471066400E+07
+ 7.477487635E+07 2.311650718E-03 1.000000000E-09 2.311650718E-03 7.477487635E+07
+ 7.483908887E+07 2.247438198E-03 1.000000000E-09 2.247438198E-03 7.483908887E+07
+ 7.490330139E+07 2.183225678E-03 1.000000000E-09 2.183225678E-03 7.490330139E+07
+ 7.496751391E+07 2.119013158E-03 1.000000000E-09 2.119013158E-03 7.496751400E+07
+ 7.503172643E+07 2.054800638E-03 1.000000000E-09 2.054800638E-03 7.503172650E+07
+ 7.509593895E+07 1.990588118E-03 1.000000000E-09 1.990588118E-03 7.509593900E+07
+ 7.516015147E+07 1.926375598E-03 1.000000000E-09 1.926375598E-03 7.516015147E+07
+ 7.522436399E+07 1.862163079E-03 1.000000000E-09 1.862163079E-03 7.522441699E+07
+ 7.528857651E+07 1.797950559E-03 1.000000000E-09 1.797950559E-03 7.528857600E+07
+ 7.535278903E+07 1.733738039E-03 1.000000000E-09 1.733738039E-03 7.535275200E+07
+ 7.541700155E+07 1.669525519E-03 1.000000000E-09 1.669525519E-03 7.541704478E+07
+ 7.548121407E+07 1.605312999E-03 1.000000000E-09 1.605312999E-03 7.548121407E+07
+ 7.554542659E+07 1.541100479E-03 1.000000000E-09 1.541100479E-03 7.554542659E+07
+ 7.560963911E+07 1.476887959E-03 1.000000000E-09 1.476887959E-03 7.560963911E+07
+ 7.567385163E+07 1.412675439E-03 1.000000000E-09 1.412675439E-03 7.567385163E+07
+ 7.573806415E+07 1.348462919E-03 1.000000000E-09 1.348462919E-03 7.573806500E+07
+ 7.580227667E+07 1.284250399E-03 1.000000000E-09 1.284250399E-03 7.580228234E+07
+ 7.586648919E+07 1.220037879E-03 1.000000000E-09 1.220037879E-03 7.586654730E+07
+ 7.593070171E+07 1.155825359E-03 1.000000000E-09 1.155825359E-03 7.593075289E+07
+ 7.599491423E+07 1.091612839E-03 1.000000000E-09 1.091612839E-03 7.599491462E+07
+ 7.605912675E+07 1.027400319E-03 1.000000000E-09 1.027400319E-03 7.605912675E+07
+ 7.612333927E+07 9.631877992E-04 1.000000000E-09 9.631877992E-04 7.612333927E+07
+ 7.618755179E+07 8.989752793E-04 1.000000000E-09 8.989752793E-04 7.618756180E+07
+ 7.625176431E+07 8.347627593E-04 1.000000000E-09 8.347627593E-04 7.625176466E+07
+ 7.631597683E+07 7.705502394E-04 1.000000000E-09 7.705502394E-04 7.631603026E+07
+ 7.638018935E+07 7.063377194E-04 1.000000000E-09 7.063377194E-04 7.638026449E+07
+ 7.644440187E+07 6.421251995E-04 1.000000000E-09 6.421251995E-04 7.644440894E+07
+ 7.650861439E+07 5.779126795E-04 1.000000000E-09 5.779126795E-04 7.650862400E+07
+ 7.657282691E+07 5.137001596E-04 1.000000000E-09 5.137001596E-04 7.657282694E+07
+ 7.663703943E+07 4.494876396E-04 1.000000000E-09 4.494876396E-04 7.663702400E+07
+ 7.670125195E+07 3.852751197E-04 1.000000000E-09 3.852751197E-04 7.670125248E+07
+ 7.676546447E+07 3.210625997E-04 1.000000000E-09 3.210625997E-04 7.676546600E+07
+ 7.682967699E+07 2.568500798E-04 1.000000000E-09 2.568500798E-04 7.682967700E+07
+ 7.689388951E+07 1.926375598E-04 1.000000000E-09 1.926375598E-04 7.689394990E+07
+ 7.695810203E+07 1.284250399E-04 1.000000000E-09 1.284250399E-04 7.695810203E+07
+ 7.702231455E+07 6.421251995E-05 1.000000000E-09 6.421251995E-05 7.702231728E+07
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM86
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM86	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM86	(revision 286)
@@ -0,0 +1,501 @@
+DENSITY AND THICKNESS DATA OF THE ATMOSPHERE AT AN ZENITH ANGLE OF 86.0 DEGREES
+ 0.000000000E+00 1.257227632E+04 1.229805824E-03 1.257227632E+04 0.000000000E+00
+ 5.407056438E+04 1.250599927E+04 1.225146177E-03 1.251731968E+04 4.472087596E+04
+ 1.081411288E+05 1.243997348E+04 1.220498579E-03 1.246236303E+04 8.959486043E+04
+ 1.622116932E+05 1.237394086E+04 1.215863026E-03 1.240740639E+04 1.348505565E+05
+ 2.162822575E+05 1.230856290E+04 1.211239514E-03 1.235244974E+04 1.797219257E+05
+ 2.703528219E+05 1.224269969E+04 1.206628042E-03 1.229749310E+04 2.252645153E+05
+ 3.244233863E+05 1.217777809E+04 1.202028605E-03 1.224253645E+04 2.704867748E+05
+ 3.784939507E+05 1.211297871E+04 1.197441199E-03 1.218757981E+04 3.163397417E+05
+ 4.325645151E+05 1.204844536E+04 1.192865821E-03 1.213262316E+04 3.620567689E+05
+ 4.866350795E+05 1.198390494E+04 1.188302467E-03 1.207766652E+04 4.081985843E+05
+ 5.407056438E+05 1.191986361E+04 1.183751134E-03 1.202270987E+04 4.542103289E+05
+ 5.947762082E+05 1.185672039E+04 1.179211816E-03 1.196775323E+04 5.003040955E+05
+ 6.488467726E+05 1.179226763E+04 1.174684509E-03 1.191279658E+04 5.462410009E+05
+ 7.029173370E+05 1.172896049E+04 1.170169209E-03 1.185783994E+04 5.938378229E+05
+ 7.569879014E+05 1.166589743E+04 1.165665911E-03 1.180288329E+04 6.399076568E+05
+ 8.110584658E+05 1.160282268E+04 1.161174611E-03 1.174792665E+04 6.866748151E+05
+ 8.651290301E+05 1.154024380E+04 1.156695303E-03 1.169297000E+04 7.338815653E+05
+ 9.191995945E+05 1.147790701E+04 1.152227982E-03 1.163801336E+04 7.809465521E+05
+ 9.732701589E+05 1.141557640E+04 1.147772644E-03 1.158305671E+04 8.281259386E+05
+ 1.027340723E+06 1.135372011E+04 1.143329282E-03 1.152810007E+04 8.757377858E+05
+ 1.081411288E+06 1.129183618E+04 1.138897892E-03 1.147314342E+04 9.232893780E+05
+ 1.135481852E+06 1.123006024E+04 1.134478466E-03 1.141818678E+04 9.710205705E+05
+ 1.189552416E+06 1.116933167E+04 1.130071001E-03 1.136323013E+04 1.018911567E+06
+ 1.243622981E+06 1.110843001E+04 1.125675489E-03 1.130827349E+04 1.067154289E+06
+ 1.297693545E+06 1.104751429E+04 1.121291925E-03 1.125331685E+04 1.114629068E+06
+ 1.351764110E+06 1.098708515E+04 1.116920302E-03 1.119836020E+04 1.163949168E+06
+ 1.405834674E+06 1.092689218E+04 1.112560614E-03 1.114340356E+04 1.212484581E+06
+ 1.459905238E+06 1.086667944E+04 1.108212855E-03 1.108844691E+04 1.261205037E+06
+ 1.513975803E+06 1.080695507E+04 1.103877017E-03 1.103349027E+04 1.310291591E+06
+ 1.568046367E+06 1.074746490E+04 1.099553094E-03 1.097853362E+04 1.358940822E+06
+ 1.622116932E+06 1.068803780E+04 1.095241079E-03 1.092357698E+04 1.408780904E+06
+ 1.676187496E+06 1.062909331E+04 1.090940965E-03 1.086862033E+04 1.458173604E+06
+ 1.730258060E+06 1.056951929E+04 1.086652745E-03 1.081366369E+04 1.508040884E+06
+ 1.784328625E+06 1.051140315E+04 1.082376411E-03 1.075870704E+04 1.557712830E+06
+ 1.838399189E+06 1.045315155E+04 1.078111956E-03 1.070375040E+04 1.607430012E+06
+ 1.892469753E+06 1.039497046E+04 1.073859372E-03 1.064879375E+04 1.658044785E+06
+ 1.946540318E+06 1.033684659E+04 1.069618651E-03 1.059383711E+04 1.708328492E+06
+ 2.000610882E+06 1.027920240E+04 1.065389786E-03 1.053888046E+04 1.759100282E+06
+ 2.054681447E+06 1.022178654E+04 1.061172768E-03 1.048392382E+04 1.809269630E+06
+ 2.108752011E+06 1.016434287E+04 1.056967590E-03 1.042896717E+04 1.860748077E+06
+ 2.162822575E+06 1.010738012E+04 1.052774243E-03 1.037401053E+04 1.911789075E+06
+ 2.216893140E+06 1.005064377E+04 1.048592719E-03 1.031905388E+04 1.963224764E+06
+ 2.270963704E+06 9.993898519E+03 1.044423008E-03 1.026409724E+04 2.014865832E+06
+ 2.325034269E+06 9.937611628E+03 1.040265103E-03 1.020914059E+04 2.066461172E+06
+ 2.379104833E+06 9.881549185E+03 1.036118994E-03 1.015418395E+04 2.118565347E+06
+ 2.433175397E+06 9.825474584E+03 1.031984674E-03 1.009922730E+04 2.170057072E+06
+ 2.487245962E+06 9.769839573E+03 1.027862131E-03 1.004427066E+04 2.222898597E+06
+ 2.541316526E+06 9.714445071E+03 1.023751358E-03 9.989314015E+03 2.275618746E+06
+ 2.595387090E+06 9.659358456E+03 1.019652346E-03 9.934357370E+03 2.328125009E+06
+ 2.649457655E+06 9.603623850E+03 1.015565083E-03 9.879400725E+03 2.381153044E+06
+ 2.703528219E+06 9.549338586E+03 1.011489562E-03 9.824444080E+03 2.434465943E+06
+ 2.757598784E+06 9.494907826E+03 1.007425772E-03 9.769487436E+03 2.487584360E+06
+ 2.811669348E+06 9.440535677E+03 1.003373704E-03 9.714530791E+03 2.541233836E+06
+ 2.865739912E+06 9.386204620E+03 9.993333473E-04 9.659574146E+03 2.595178250E+06
+ 2.919810477E+06 9.332442110E+03 9.953046921E-04 9.604617501E+03 2.648926068E+06
+ 2.973881041E+06 9.278546392E+03 9.912877283E-04 9.549660856E+03 2.703213610E+06
+ 3.027951606E+06 9.225122423E+03 9.872824456E-04 9.494704212E+03 2.757798306E+06
+ 3.082022170E+06 9.171915789E+03 9.832888335E-04 9.439747567E+03 2.812444710E+06
+ 3.136092734E+06 9.118686753E+03 9.793068814E-04 9.384790922E+03 2.867136765E+06
+ 3.190163299E+06 9.066809174E+03 9.753365788E-04 9.329834277E+03 2.922396940E+06
+ 3.244233863E+06 9.013330216E+03 9.713779149E-04 9.274877632E+03 2.977553559E+06
+ 3.298304427E+06 8.961059626E+03 9.674308787E-04 9.219920988E+03 3.032705975E+06
+ 3.352374992E+06 8.908180169E+03 9.634954593E-04 9.164964343E+03 3.089001720E+06
+ 3.406445556E+06 8.856660435E+03 9.595716455E-04 9.110007698E+03 3.145080730E+06
+ 3.460516121E+06 8.804945314E+03 9.556594261E-04 9.055051053E+03 3.202049695E+06
+ 3.514586685E+06 8.753441169E+03 9.517587897E-04 9.000094409E+03 3.258028521E+06
+ 3.568657249E+06 8.701913382E+03 9.478697248E-04 8.945137764E+03 3.314733885E+06
+ 3.622727814E+06 8.650828264E+03 9.439922199E-04 8.890181119E+03 3.371517275E+06
+ 3.676798378E+06 8.599687176E+03 9.401262633E-04 8.835224474E+03 3.428307711E+06
+ 3.730868943E+06 8.549366432E+03 9.362718432E-04 8.780267829E+03 3.486280853E+06
+ 3.784939507E+06 8.498164513E+03 9.324289476E-04 8.725311185E+03 3.544063103E+06
+ 3.839010071E+06 8.448317865E+03 9.285975645E-04 8.670354540E+03 3.602073222E+06
+ 3.893080636E+06 8.398276313E+03 9.247776818E-04 8.615397895E+03 3.660341127E+06
+ 3.947151200E+06 8.348435963E+03 9.209692873E-04 8.560441250E+03 3.718854293E+06
+ 4.001221764E+06 8.298563595E+03 9.171723685E-04 8.505484605E+03 3.777628943E+06
+ 4.055292329E+06 8.249114865E+03 9.133869130E-04 8.450527961E+03 3.836663072E+06
+ 4.109362893E+06 8.199887443E+03 9.096129083E-04 8.395571316E+03 3.895965267E+06
+ 4.163433458E+06 8.150610852E+03 9.058503416E-04 8.340614671E+03 3.955527178E+06
+ 4.217504022E+06 8.101873057E+03 9.020992003E-04 8.285658026E+03 4.015358010E+06
+ 4.271574586E+06 8.053253626E+03 8.983594713E-04 8.230701381E+03 4.075457988E+06
+ 4.325645151E+06 8.004917029E+03 8.946311418E-04 8.175744737E+03 4.135346637E+06
+ 4.379715715E+06 7.956620493E+03 8.909141985E-04 8.120788092E+03 4.196574131E+06
+ 4.433786280E+06 7.908348255E+03 8.872086284E-04 8.065831447E+03 4.257503161E+06
+ 4.487856844E+06 7.860535623E+03 8.835144181E-04 8.010874802E+03 4.318733717E+06
+ 4.541927408E+06 7.812917092E+03 8.798315542E-04 7.955918157E+03 4.380492455E+06
+ 4.595997973E+06 7.765577724E+03 8.761600232E-04 7.900961513E+03 4.442365160E+06
+ 4.650068537E+06 7.717615398E+03 8.724998115E-04 7.846004868E+03 4.504356927E+06
+ 4.704139101E+06 7.670995847E+03 8.688509055E-04 7.791048223E+03 4.566726291E+06
+ 4.758209666E+06 7.624167037E+03 8.652132912E-04 7.736091578E+03 4.629392905E+06
+ 4.812280230E+06 7.577555620E+03 8.615869548E-04 7.681134933E+03 4.692649249E+06
+ 4.866350795E+06 7.530882116E+03 8.579718824E-04 7.626178289E+03 4.755920212E+06
+ 4.920421359E+06 7.484174561E+03 8.543680598E-04 7.571221644E+03 4.819522642E+06
+ 4.974491923E+06 7.438572476E+03 8.507754728E-04 7.516264999E+03 4.882944369E+06
+ 5.028562488E+06 7.392717211E+03 8.471941071E-04 7.461308354E+03 4.948001624E+06
+ 5.082633052E+06 7.347054814E+03 8.436239484E-04 7.406351709E+03 5.012429702E+06
+ 5.136703617E+06 7.301670727E+03 8.400649822E-04 7.351395065E+03 5.077569746E+06
+ 5.190774181E+06 7.255610767E+03 8.365171939E-04 7.296438420E+03 5.142741656E+06
+ 5.244844745E+06 7.210968538E+03 8.329805689E-04 7.241481775E+03 5.208237027E+06
+ 5.298915310E+06 7.166072440E+03 8.294550923E-04 7.186525130E+03 5.274366935E+06
+ 5.352985874E+06 7.121365414E+03 8.259407495E-04 7.131568485E+03 5.340530351E+06
+ 5.407056438E+06 7.076611841E+03 8.224375253E-04 7.076611841E+03 5.407056438E+06
+ 5.478677311E+06 7.017613429E+03 8.214976992E-04 7.033382220E+03 5.459704069E+06
+ 5.550298184E+06 6.959009269E+03 8.162640988E-04 6.990152599E+03 5.511809715E+06
+ 5.621919056E+06 6.900778138E+03 8.110564537E-04 6.946922979E+03 5.564957445E+06
+ 5.693539929E+06 6.842922197E+03 8.058746931E-04 6.903693358E+03 5.618364559E+06
+ 5.765160801E+06 6.785432855E+03 8.007187459E-04 6.860463738E+03 5.671212164E+06
+ 5.836781674E+06 6.727654103E+03 7.955885407E-04 6.817234117E+03 5.725116030E+06
+ 5.908402546E+06 6.671547213E+03 7.904840060E-04 6.774004497E+03 5.779283640E+06
+ 5.980023419E+06 6.614498683E+03 7.854050698E-04 6.730774876E+03 5.832899213E+06
+ 6.051644291E+06 6.559143334E+03 7.803516602E-04 6.687545256E+03 5.887576314E+06
+ 6.123265164E+06 6.502806212E+03 7.753237048E-04 6.644315635E+03 5.942550573E+06
+ 6.194886036E+06 6.447493456E+03 7.703211311E-04 6.601086015E+03 5.996939543E+06
+ 6.266506909E+06 6.392537179E+03 7.653438663E-04 6.557856394E+03 6.053273898E+06
+ 6.338127781E+06 6.337939371E+03 7.603918373E-04 6.514626773E+03 6.108194464E+06
+ 6.409748654E+06 6.283691855E+03 7.554649711E-04 6.471397153E+03 6.164242898E+06
+ 6.481369526E+06 6.229796631E+03 7.505631941E-04 6.428167532E+03 6.220566708E+06
+ 6.552990399E+06 6.176250605E+03 7.456864327E-04 6.384937912E+03 6.276332012E+06
+ 6.624611272E+06 6.123109291E+03 7.408346131E-04 6.341708291E+03 6.333227967E+06
+ 6.696232144E+06 6.070257915E+03 7.360076613E-04 6.298478671E+03 6.390417997E+06
+ 6.767853017E+06 6.017751655E+03 7.312055029E-04 6.255249050E+03 6.447046784E+06
+ 6.839473889E+06 5.965587386E+03 7.264280636E-04 6.212019430E+03 6.505692456E+06
+ 6.911094762E+06 5.913112089E+03 7.216752687E-04 6.168789809E+03 6.562884245E+06
+ 6.982715634E+06 5.862273050E+03 7.169470434E-04 6.125560189E+03 6.621343149E+06
+ 7.054336507E+06 5.810475776E+03 7.122433127E-04 6.082330568E+03 6.680029196E+06
+ 7.125957379E+06 5.760315495E+03 7.075640014E-04 6.039100947E+03 6.738147862E+06
+ 7.197578252E+06 5.709179673E+03 7.029090342E-04 5.995871327E+03 6.797457083E+06
+ 7.269199124E+06 5.659707303E+03 6.982783356E-04 5.952641706E+03 6.857114468E+06
+ 7.340819997E+06 5.609224593E+03 6.936718299E-04 5.909412086E+03 6.917055453E+06
+ 7.412440869E+06 5.560406448E+03 6.890894412E-04 5.866182465E+03 6.977334281E+06
+ 7.484061742E+06 5.510571803E+03 6.845310935E-04 5.822952845E+03 7.037035213E+06
+ 7.555682615E+06 5.461736897E+03 6.799967107E-04 5.779723224E+03 7.097975600E+06
+ 7.627303487E+06 5.413222302E+03 6.754862164E-04 5.736493604E+03 7.159283454E+06
+ 7.698924360E+06 5.365030084E+03 6.709995342E-04 5.693263983E+03 7.220907809E+06
+ 7.770545232E+06 5.317157257E+03 6.665365875E-04 5.650034363E+03 7.282874754E+06
+ 7.842166105E+06 5.269646161E+03 6.620972995E-04 5.606804742E+03 7.344266990E+06
+ 7.913786977E+06 5.221936465E+03 6.576815934E-04 5.563575121E+03 7.406938131E+06
+ 7.985407850E+06 5.175710073E+03 6.532893921E-04 5.520345501E+03 7.469972129E+06
+ 8.057028722E+06 5.128451380E+03 6.489206185E-04 5.477115880E+03 7.533405011E+06
+ 8.128649595E+06 5.082805241E+03 6.445751953E-04 5.433886260E+03 7.597153582E+06
+ 8.200270467E+06 5.036162148E+03 6.402530452E-04 5.390656639E+03 7.660347041E+06
+ 8.271891340E+06 4.991142566E+03 6.359540906E-04 5.347427019E+03 7.725824549E+06
+ 8.343512212E+06 4.945108362E+03 6.316782540E-04 5.304197398E+03 7.789756193E+06
+ 8.415133085E+06 4.900703123E+03 6.274254575E-04 5.260967778E+03 7.855108498E+06
+ 8.486753958E+06 4.855271801E+03 6.231956233E-04 5.217738157E+03 7.921141249E+06
+ 8.558374830E+06 4.811490643E+03 6.189886736E-04 5.174508536E+03 7.987221041E+06
+ 8.629995703E+06 4.766654260E+03 6.148045303E-04 5.131278916E+03 8.052727730E+06
+ 8.701616575E+06 4.722787872E+03 6.106431151E-04 5.088049295E+03 8.120636342E+06
+ 8.773237448E+06 4.679217551E+03 6.065043500E-04 5.044819675E+03 8.186934376E+06
+ 8.844858320E+06 4.635945464E+03 6.023881566E-04 5.001590054E+03 8.254673887E+06
+ 8.916479193E+06 4.592963662E+03 5.982944565E-04 4.958360434E+03 8.322837205E+06
+ 8.988100065E+06 4.550274327E+03 5.942231711E-04 4.915130813E+03 8.391435913E+06
+ 9.059720938E+06 4.507874577E+03 5.901742220E-04 4.871901193E+03 8.460473899E+06
+ 9.131341810E+06 4.465818817E+03 5.861475305E-04 4.828671572E+03 8.530008678E+06
+ 9.202962683E+06 4.423994845E+03 5.821430179E-04 4.785441952E+03 8.599917209E+06
+ 9.274583555E+06 4.382456945E+03 5.781606054E-04 4.742212331E+03 8.670314130E+06
+ 9.346204428E+06 4.341220258E+03 5.742002141E-04 4.698982710E+03 8.740561511E+06
+ 9.417825301E+06 4.300251062E+03 5.702617652E-04 4.655753090E+03 8.812513818E+06
+ 9.489446173E+06 4.259559284E+03 5.663451796E-04 4.612523469E+03 8.884325686E+06
+ 9.561067046E+06 4.219147276E+03 5.624503785E-04 4.569293849E+03 8.956624395E+06
+ 9.632687918E+06 4.178994179E+03 5.585772826E-04 4.526064228E+03 9.029414899E+06
+ 9.704308791E+06 4.139148994E+03 5.547258129E-04 4.482834608E+03 9.101622455E+06
+ 9.775929663E+06 4.099564352E+03 5.508958902E-04 4.439604987E+03 9.176602239E+06
+ 9.847550536E+06 4.060253271E+03 5.470874352E-04 4.396375367E+03 9.249810569E+06
+ 9.919171408E+06 4.021212888E+03 5.433003688E-04 4.353145746E+03 9.325756036E+06
+ 9.990792281E+06 3.982445660E+03 5.395346117E-04 4.309916126E+03 9.401131507E+06
+ 1.006241315E+07 3.943943407E+03 5.357900845E-04 4.266686505E+03 9.477041212E+06
+ 1.013403403E+07 3.905708599E+03 5.320667079E-04 4.223456884E+03 9.553500750E+06
+ 1.020565490E+07 3.867738390E+03 5.283644025E-04 4.180227264E+03 9.630516687E+06
+ 1.027727577E+07 3.829392800E+03 5.246830889E-04 4.136997643E+03 9.708155791E+06
+ 1.034889664E+07 3.792816110E+03 5.210226878E-04 4.093768023E+03 9.786282582E+06
+ 1.042051752E+07 3.754973718E+03 5.173831195E-04 4.050538402E+03 9.865028247E+06
+ 1.049213839E+07 3.718709334E+03 5.137643048E-04 4.007308782E+03 9.944368529E+06
+ 1.056375926E+07 3.681383537E+03 5.101661642E-04 3.964079161E+03 1.002432061E+07
+ 1.063538013E+07 3.645636352E+03 5.065886181E-04 3.920849541E+03 1.010488358E+07
+ 1.070700101E+07 3.608821230E+03 5.030315872E-04 3.877619920E+03 1.018728445E+07
+ 1.077862188E+07 3.573579760E+03 4.994949919E-04 3.834390300E+03 1.026790470E+07
+ 1.085024275E+07 3.537270118E+03 4.959787527E-04 3.791160679E+03 1.035201524E+07
+ 1.092186362E+07 3.502544664E+03 4.924827902E-04 3.747931058E+03 1.043391542E+07
+ 1.099348450E+07 3.466733313E+03 4.890070249E-04 3.704701438E+03 1.051895177E+07
+ 1.106510537E+07 3.431195631E+03 4.855513774E-04 3.661471817E+03 1.060343754E+07
+ 1.113672624E+07 3.397174571E+03 4.821157682E-04 3.618242197E+03 1.068861518E+07
+ 1.120834711E+07 3.363425165E+03 4.787001178E-04 3.575012576E+03 1.077581006E+07
+ 1.127996799E+07 3.328597202E+03 4.753043470E-04 3.531782956E+03 1.086112134E+07
+ 1.135158886E+07 3.295329040E+03 4.719283761E-04 3.488553335E+03 1.094977808E+07
+ 1.142320973E+07 3.260984911E+03 4.685721260E-04 3.445323715E+03 1.103786135E+07
+ 1.149483060E+07 3.228253732E+03 4.652355173E-04 3.402094094E+03 1.112671200E+07
+ 1.156645148E+07 3.194380880E+03 4.619184706E-04 3.358864474E+03 1.121768450E+07
+ 1.163807235E+07 3.162069251E+03 4.586209066E-04 3.315634853E+03 1.130810774E+07
+ 1.170969322E+07 3.128669692E+03 4.553427462E-04 3.272405232E+03 1.139932504E+07
+ 1.178131409E+07 3.096826677E+03 4.520839100E-04 3.229175612E+03 1.149289155E+07
+ 1.185293497E+07 3.063894874E+03 4.488443189E-04 3.185945991E+03 1.158438833E+07
+ 1.192455584E+07 3.032509360E+03 4.456238939E-04 3.142716371E+03 1.167949673E+07
+ 1.199617671E+07 3.000040515E+03 4.424225557E-04 3.099486750E+03 1.177556099E+07
+ 1.206779758E+07 2.969123049E+03 4.392402254E-04 3.056257130E+03 1.187105553E+07
+ 1.213941846E+07 2.937110335E+03 4.360768239E-04 3.013027509E+03 1.196745430E+07
+ 1.221103933E+07 2.906629003E+03 4.329322724E-04 2.969797889E+03 1.206629584E+07
+ 1.228266020E+07 2.875069101E+03 4.298064919E-04 2.926568268E+03 1.216457863E+07
+ 1.235428107E+07 2.845033166E+03 4.266994036E-04 2.883338648E+03 1.226383085E+07
+ 1.242590195E+07 2.813920733E+03 4.236109287E-04 2.840109027E+03 1.236558843E+07
+ 1.249752282E+07 2.784329468E+03 4.205409886E-04 2.796879406E+03 1.246683290E+07
+ 1.256914369E+07 2.753649786E+03 4.174895046E-04 2.753649786E+03 1.256914369E+07
+ 1.284091454E+07 2.640023302E+03 4.101451555E-04 2.726331373E+03 1.263355310E+07
+ 1.311268539E+07 2.530671858E+03 3.946776761E-04 2.699012961E+03 1.269852752E+07
+ 1.338445624E+07 2.425454066E+03 3.797249673E-04 2.671694548E+03 1.276410114E+07
+ 1.365622709E+07 2.324231174E+03 3.652728290E-04 2.644376136E+03 1.283031143E+07
+ 1.392799794E+07 2.226869514E+03 3.513073338E-04 2.617057723E+03 1.289714511E+07
+ 1.419976879E+07 2.133238536E+03 3.378148261E-04 2.589739311E+03 1.296459145E+07
+ 1.447153964E+07 2.043213248E+03 3.247819218E-04 2.562420898E+03 1.303268665E+07
+ 1.474331049E+07 1.956667231E+03 3.121955073E-04 2.535102486E+03 1.310147042E+07
+ 1.501508134E+07 1.873482620E+03 3.000427383E-04 2.507784073E+03 1.317093070E+07
+ 1.528685219E+07 1.793543125E+03 2.883110388E-04 2.480465661E+03 1.324105733E+07
+ 1.555862304E+07 1.716736451E+03 2.769880990E-04 2.453147248E+03 1.331188904E+07
+ 1.583039389E+07 1.642952379E+03 2.660618744E-04 2.425828836E+03 1.338346955E+07
+ 1.610216474E+07 1.572085162E+03 2.555205833E-04 2.398510424E+03 1.345578558E+07
+ 1.637393559E+07 1.504031603E+03 2.453527052E-04 2.371192011E+03 1.352882890E+07
+ 1.664570644E+07 1.438681469E+03 2.355469783E-04 2.343873599E+03 1.360264128E+07
+ 1.691747729E+07 1.375961457E+03 2.260923978E-04 2.316555186E+03 1.367726896E+07
+ 1.718924814E+07 1.315768655E+03 2.169782126E-04 2.289236774E+03 1.375270180E+07
+ 1.746101899E+07 1.258000453E+03 2.081939236E-04 2.261918361E+03 1.382893134E+07
+ 1.773278984E+07 1.202575878E+03 1.997292802E-04 2.234599949E+03 1.390603238E+07
+ 1.800456069E+07 1.149409280E+03 1.915742784E-04 2.207281536E+03 1.398399643E+07
+ 1.827633154E+07 1.098418316E+03 1.837191569E-04 2.179963124E+03 1.406281707E+07
+ 1.854810239E+07 1.049521969E+03 1.761543949E-04 2.152644711E+03 1.414254220E+07
+ 1.881987324E+07 1.002653223E+03 1.688707086E-04 2.125326299E+03 1.422322524E+07
+ 1.909164408E+07 9.577182268E+02 1.618590482E-04 2.098007886E+03 1.430485925E+07
+ 1.936341493E+07 9.146691309E+02 1.551105944E-04 2.070689474E+03 1.438743869E+07
+ 1.963518578E+07 8.733832056E+02 1.486167553E-04 2.043371061E+03 1.447105386E+07
+ 1.990695663E+07 8.338462983E+02 1.423691629E-04 2.016052649E+03 1.455568993E+07
+ 2.017872748E+07 7.959750537E+02 1.363596700E-04 1.988734236E+03 1.464134918E+07
+ 2.045049833E+07 7.597149417E+02 1.305803459E-04 1.961415824E+03 1.472808823E+07
+ 2.072226918E+07 7.249852980E+02 1.250234738E-04 1.934097411E+03 1.481600239E+07
+ 2.099404003E+07 6.917362655E+02 1.196815465E-04 1.906778999E+03 1.490499443E+07
+ 2.126581088E+07 6.599172988E+02 1.145472631E-04 1.879460586E+03 1.499515766E+07
+ 2.153758173E+07 6.294594846E+02 1.096135253E-04 1.852142174E+03 1.508659419E+07
+ 2.180935258E+07 6.003159779E+02 1.048734339E-04 1.824823761E+03 1.517920545E+07
+ 2.208112343E+07 5.724349260E+02 1.003202848E-04 1.797505349E+03 1.527312661E+07
+ 2.235289428E+07 5.457668750E+02 9.594756537E-05 1.770186936E+03 1.536836252E+07
+ 2.262466513E+07 5.202628416E+02 9.174895099E-05 1.742868524E+03 1.546491856E+07
+ 2.289643598E+07 4.958870344E+02 8.771830106E-05 1.715550111E+03 1.556290626E+07
+ 2.316820683E+07 4.725759526E+02 8.384965540E-05 1.688231699E+03 1.566233149E+07
+ 2.343997768E+07 4.502930988E+02 8.013723053E-05 1.660913286E+03 1.576320469E+07
+ 2.371174853E+07 4.290083965E+02 7.657541591E-05 1.633594874E+03 1.586564654E+07
+ 2.398351938E+07 4.086619272E+02 7.315877033E-05 1.606276461E+03 1.596967019E+07
+ 2.425529023E+07 3.892250884E+02 6.988201814E-05 1.578958049E+03 1.607528897E+07
+ 2.452706108E+07 3.706597529E+02 6.674004565E-05 1.551639636E+03 1.618267619E+07
+ 2.479883193E+07 3.529406080E+02 6.372789744E-05 1.524321224E+03 1.629173216E+07
+ 2.507060278E+07 3.360023542E+02 6.084077278E-05 1.497002811E+03 1.640263608E+07
+ 2.534237363E+07 3.198583397E+02 5.807402201E-05 1.469684399E+03 1.651541305E+07
+ 2.561414448E+07 3.044442891E+02 5.542314297E-05 1.442365986E+03 1.663008781E+07
+ 2.588591533E+07 2.897258273E+02 5.288377747E-05 1.415047574E+03 1.674687371E+07
+ 2.615768618E+07 2.756825063E+02 5.045170783E-05 1.387729161E+03 1.686565066E+07
+ 2.642945703E+07 2.622886077E+02 4.812285336E-05 1.360410749E+03 1.698662385E+07
+ 2.670122788E+07 2.495181850E+02 4.589326694E-05 1.333092336E+03 1.710991412E+07
+ 2.697299873E+07 2.373334836E+02 4.375913168E-05 1.305773924E+03 1.723545639E+07
+ 2.724476958E+07 2.257262554E+02 4.171675753E-05 1.278455511E+03 1.736353163E+07
+ 2.751654043E+07 2.146522152E+02 3.976257799E-05 1.251137099E+03 1.749405565E+07
+ 2.778831127E+07 2.041070723E+02 3.789314688E-05 1.223818686E+03 1.762732732E+07
+ 2.806008212E+07 1.940489315E+02 3.610513508E-05 1.196500274E+03 1.776326788E+07
+ 2.833185297E+07 1.844656079E+02 3.439532742E-05 1.169181861E+03 1.790220001E+07
+ 2.860362382E+07 1.753485658E+02 3.276061952E-05 1.141863449E+03 1.804410745E+07
+ 2.887539467E+07 1.666638895E+02 3.119801477E-05 1.114545036E+03 1.818917820E+07
+ 2.914716552E+07 1.583844902E+02 2.970462126E-05 1.087226624E+03 1.833756649E+07
+ 2.941893637E+07 1.505018978E+02 2.827764889E-05 1.059908211E+03 1.848943566E+07
+ 2.969070722E+07 1.430081623E+02 2.691440639E-05 1.032589799E+03 1.864501887E+07
+ 2.996247807E+07 1.358761517E+02 2.561229850E-05 1.005271386E+03 1.880433561E+07
+ 3.023424892E+07 1.290868964E+02 2.436882315E-05 9.779529740E+02 1.896782348E+07
+ 3.050601977E+07 1.226209297E+02 2.318156872E-05 9.506345615E+02 1.913553784E+07
+ 3.077779062E+07 1.164800260E+02 2.204821134E-05 9.233161490E+02 1.930775885E+07
+ 3.104956147E+07 1.106303212E+02 2.096651223E-05 8.959977365E+02 1.948482662E+07
+ 3.132133232E+07 1.050772715E+02 1.993431512E-05 8.686793240E+02 1.966689903E+07
+ 3.159310317E+07 9.978807508E+01 1.894954373E-05 8.413609115E+02 1.985442220E+07
+ 3.186487402E+07 9.477199431E+01 1.801019927E-05 8.140424991E+02 2.004760539E+07
+ 3.213664487E+07 9.000323724E+01 1.711435802E-05 7.867240866E+02 2.024697205E+07
+ 3.240841572E+07 8.546222989E+01 1.626016894E-05 7.594056741E+02 2.045286581E+07
+ 3.268018657E+07 8.115816420E+01 1.544585140E-05 7.320872616E+02 2.066567879E+07
+ 3.295195742E+07 7.706953027E+01 1.466969284E-05 7.047688491E+02 2.088607930E+07
+ 3.322372827E+07 7.317674864E+01 1.393004664E-05 6.774504366E+02 2.111448260E+07
+ 3.349549912E+07 6.949290324E+01 1.322532990E-05 6.501320241E+02 2.135177199E+07
+ 3.376726997E+07 6.598999793E+01 1.255402136E-05 6.228136116E+02 2.159846713E+07
+ 3.403904082E+07 6.266796941E+01 1.191465935E-05 5.954951991E+02 2.185545707E+07
+ 3.431081167E+07 5.950537207E+01 1.130583978E-05 5.681767866E+02 2.212368116E+07
+ 3.458258252E+07 5.652444228E+01 1.072621420E-05 5.408583742E+02 2.240432851E+07
+ 3.485435337E+07 5.367693342E+01 1.017448786E-05 5.135399617E+02 2.269843098E+07
+ 3.512612422E+07 5.098545885E+01 9.649417931E-06 4.862215492E+02 2.300764981E+07
+ 3.539789507E+07 4.843456108E+01 9.149811650E-06 4.589031367E+02 2.333347562E+07
+ 3.566966592E+07 4.600426413E+01 8.674524587E-06 4.315847242E+02 2.367810789E+07
+ 3.594143677E+07 4.371991209E+01 8.222458943E-06 4.042663117E+02 2.404383752E+07
+ 3.621320762E+07 4.153568297E+01 7.792561892E-06 3.769478992E+02 2.443370500E+07
+ 3.648497847E+07 3.947482458E+01 7.383823976E-06 3.496294867E+02 2.485094968E+07
+ 3.675674931E+07 3.752200056E+01 6.995277538E-06 3.223110742E+02 2.530017420E+07
+ 3.702852016E+07 3.566891033E+01 6.625995208E-06 2.949926617E+02 2.578714658E+07
+ 3.730029101E+07 3.392649241E+01 6.275088430E-06 2.676742492E+02 2.631861607E+07
+ 3.757206186E+07 3.225707168E+01 5.941706032E-06 2.403558368E+02 2.690448481E+07
+ 3.784383271E+07 3.069585776E+01 5.625032841E-06 2.130374243E+02 2.755745488E+07
+ 3.811560356E+07 2.919839310E+01 5.324288336E-06 1.857190118E+02 2.829562974E+07
+ 3.838737441E+07 2.779186625E+01 5.038725349E-06 1.584005993E+02 2.914662493E+07
+ 3.865914526E+07 2.645903760E+01 4.767628803E-06 1.310821868E+02 3.015289084E+07
+ 3.893091611E+07 2.520771327E+01 4.510314484E-06 1.037637743E+02 3.138729983E+07
+ 3.920268696E+07 2.400500793E+01 4.266127862E-06 7.644536181E+01 3.299438773E+07
+ 3.947445781E+07 2.288622238E+01 4.034442944E-06 4.912694932E+01 3.532256077E+07
+ 3.974622866E+07 2.180853683E+01 3.814661162E-06 2.180853683E+01 3.974622866E+07
+ 4.012156422E+07 2.037733563E+01 3.692367427E-06 2.159051792E+01 3.980187931E+07
+ 4.049689978E+07 1.903499310E+01 3.462575543E-06 2.137249900E+01 3.985805529E+07
+ 4.087223533E+07 1.777642220E+01 3.246176892E-06 2.115448008E+01 3.991478078E+07
+ 4.124757089E+07 1.659662434E+01 3.042451846E-06 2.093646116E+01 3.997205998E+07
+ 4.162290645E+07 1.549100921E+01 2.850715517E-06 2.071844224E+01 4.002990419E+07
+ 4.199824200E+07 1.445523897E+01 2.670316320E-06 2.050042332E+01 4.008832505E+07
+ 4.237357756E+07 1.348515654E+01 2.500634581E-06 2.028240441E+01 4.014733167E+07
+ 4.274891312E+07 1.257682691E+01 2.341081195E-06 2.006438549E+01 4.020693564E+07
+ 4.312424868E+07 1.172657953E+01 2.191096324E-06 1.984636657E+01 4.026716258E+07
+ 4.349958423E+07 1.093089582E+01 2.050148137E-06 1.962834765E+01 4.032801413E+07
+ 4.387491979E+07 1.018652125E+01 1.917731597E-06 1.941032873E+01 4.038950393E+07
+ 4.425025535E+07 9.490310217E+00 1.793367280E-06 1.919230981E+01 4.045164111E+07
+ 4.462559090E+07 8.839329518E+00 1.676600250E-06 1.897429090E+01 4.051445766E+07
+ 4.500092646E+07 8.230853112E+00 1.566998958E-06 1.875627198E+01 4.057795873E+07
+ 4.537626202E+07 7.662180623E+00 1.464154188E-06 1.853825306E+01 4.064215992E+07
+ 4.575159757E+07 7.130947585E+00 1.367678047E-06 1.832023414E+01 4.070707738E+07
+ 4.612693313E+07 6.634770994E+00 1.277202979E-06 1.810221522E+01 4.077272783E+07
+ 4.650226869E+07 6.171476109E+00 1.192380828E-06 1.788419630E+01 4.083912859E+07
+ 4.687760425E+07 5.738997368E+00 1.112881932E-06 1.766617739E+01 4.090629759E+07
+ 4.725293980E+07 5.335434676E+00 1.038394247E-06 1.744815847E+01 4.097425345E+07
+ 4.762827536E+07 4.958934749E+00 9.686225168E-07 1.723013955E+01 4.104300558E+07
+ 4.800361092E+07 4.607772559E+00 9.032874647E-07 1.701212063E+01 4.111259086E+07
+ 4.837894647E+07 4.280329022E+00 8.421250231E-07 1.679410171E+01 4.118302317E+07
+ 4.875428203E+07 3.975125068E+00 7.848855937E-07 1.657608279E+01 4.125432671E+07
+ 4.912961759E+07 3.690680055E+00 7.313333371E-07 1.635806388E+01 4.132651251E+07
+ 4.950495315E+07 3.425717603E+00 6.812454924E-07 1.614004496E+01 4.139962121E+07
+ 4.988028870E+07 3.178883064E+00 6.344117261E-07 1.592202604E+01 4.147366841E+07
+ 5.025562426E+07 2.949082802E+00 5.906335076E-07 1.570400712E+01 4.154867563E+07
+ 5.063095982E+07 2.735158608E+00 5.497235122E-07 1.548598820E+01 4.162466810E+07
+ 5.100629537E+07 2.536084198E+00 5.115050501E-07 1.526796928E+01 4.170168955E+07
+ 5.138163093E+07 2.350854245E+00 4.758115202E-07 1.504995037E+01 4.177975058E+07
+ 5.175696649E+07 2.178610626E+00 4.424858884E-07 1.483193145E+01 4.185888417E+07
+ 5.213230205E+07 2.018432152E+00 4.113801892E-07 1.461391253E+01 4.193912436E+07
+ 5.250763760E+07 1.869530342E+00 3.823550499E-07 1.439589361E+01 4.202051021E+07
+ 5.288297316E+07 1.731167703E+00 3.552792370E-07 1.417787469E+01 4.210306917E+07
+ 5.325830872E+07 1.602614188E+00 3.300292226E-07 1.395985577E+01 4.218683672E+07
+ 5.363364427E+07 1.483203291E+00 3.064887722E-07 1.374183686E+01 4.227183586E+07
+ 5.400897983E+07 1.372338885E+00 2.845485509E-07 1.352381794E+01 4.235813718E+07
+ 5.438431539E+07 1.269423018E+00 2.641057492E-07 1.330579902E+01 4.244575668E+07
+ 5.475965094E+07 1.173887439E+00 2.450637264E-07 1.308778010E+01 4.253474431E+07
+ 5.513498650E+07 1.085296362E+00 2.273316707E-07 1.286976118E+01 4.262513730E+07
+ 5.551032206E+07 1.003094154E+00 2.108242770E-07 1.265174226E+01 4.271700112E+07
+ 5.588565762E+07 9.268915280E-01 1.954614400E-07 1.243372335E+01 4.281037441E+07
+ 5.626099317E+07 8.562410908E-01 1.811679621E-07 1.221570443E+01 4.290529394E+07
+ 5.663632873E+07 7.907660591E-01 1.678732768E-07 1.199768551E+01 4.300184916E+07
+ 5.701166429E+07 7.300879429E-01 1.555111859E-07 1.177966659E+01 4.310007069E+07
+ 5.738699984E+07 6.739294264E-01 1.440196094E-07 1.156164767E+01 4.320002563E+07
+ 5.776233540E+07 6.218942092E-01 1.333403488E-07 1.134362875E+01 4.330177605E+07
+ 5.813767096E+07 5.737272501E-01 1.234188630E-07 1.112560984E+01 4.340540460E+07
+ 5.851300652E+07 5.291580988E-01 1.142040552E-07 1.090759092E+01 4.351096376E+07
+ 5.888834207E+07 4.879181962E-01 1.056480711E-07 1.068957200E+01 4.361854895E+07
+ 5.926367763E+07 4.497708620E-01 9.770610846E-08 1.047155308E+01 4.372823184E+07
+ 5.963901319E+07 4.144866956E-01 9.033623585E-08 1.025353416E+01 4.384009855E+07
+ 6.001434874E+07 3.818786855E-01 8.349922197E-08 1.003551524E+01 4.395421973E+07
+ 6.038968430E+07 3.517572449E-01 7.715837373E-08 9.817496326E+00 4.407073028E+07
+ 6.076501986E+07 3.239156340E-01 7.127938341E-08 9.599477408E+00 4.418970806E+07
+ 6.114035542E+07 2.982009282E-01 6.583018406E-08 9.381458490E+00 4.431128822E+07
+ 6.151569097E+07 2.744296554E-01 6.078081302E-08 9.163439571E+00 4.443555531E+07
+ 6.189102653E+07 2.525094936E-01 5.610328300E-08 8.945420653E+00 4.456268177E+07
+ 6.226636209E+07 2.322818294E-01 5.177146035E-08 8.727401735E+00 4.469276083E+07
+ 6.264169764E+07 2.136143251E-01 4.776095031E-08 8.509382817E+00 4.482595701E+07
+ 6.301703320E+07 1.964026225E-01 4.404898868E-08 8.291363898E+00 4.496244195E+07
+ 6.339236876E+07 1.805208925E-01 4.061433977E-08 8.073344980E+00 4.510235550E+07
+ 6.376770432E+07 1.658840788E-01 3.743720018E-08 7.855326062E+00 4.524590503E+07
+ 6.414303987E+07 1.523879706E-01 3.449910821E-08 7.637307143E+00 4.539327787E+07
+ 6.451837543E+07 1.399544263E-01 3.178285849E-08 7.419288225E+00 4.554471488E+07
+ 6.489371099E+07 1.285049262E-01 2.927242171E-08 7.201269307E+00 4.570041544E+07
+ 6.526904654E+07 1.179423457E-01 2.695286902E-08 6.983250388E+00 4.586065425E+07
+ 6.564438210E+07 1.082537066E-01 2.481030097E-08 6.765231470E+00 4.602571977E+07
+ 6.601971766E+07 9.931271682E-02 2.283178068E-08 6.547212552E+00 4.619592740E+07
+ 6.639505321E+07 9.109298072E-02 2.100527108E-08 6.329193633E+00 4.637157788E+07
+ 6.677038877E+07 8.353019407E-02 1.931957588E-08 6.111174715E+00 4.655308212E+07
+ 6.714572433E+07 7.655922366E-02 1.776428420E-08 5.893155797E+00 4.674083585E+07
+ 6.752105989E+07 7.015876018E-02 1.632971855E-08 5.675136878E+00 4.693530722E+07
+ 6.789639544E+07 6.429988566E-02 1.500688606E-08 5.457117960E+00 4.713701433E+07
+ 6.827173100E+07 5.890811916E-02 1.378743270E-08 5.239099042E+00 4.734652993E+07
+ 6.864706656E+07 5.393128117E-02 1.266360037E-08 5.021080123E+00 4.756449711E+07
+ 6.902240211E+07 4.937277399E-02 1.162818669E-08 4.803061205E+00 4.779163725E+07
+ 6.939773767E+07 4.520570565E-02 1.067450729E-08 4.585042287E+00 4.802883751E+07
+ 6.977307323E+07 4.136884662E-02 9.796360551E-09 4.367023368E+00 4.827698373E+07
+ 7.014840879E+07 3.781946717E-02 8.987994549E-09 4.149004450E+00 4.853723728E+07
+ 7.052374434E+07 3.460403425E-02 8.244076129E-09 3.930985532E+00 4.881081306E+07
+ 7.089907990E+07 3.163588281E-02 7.559661982E-09 3.712966613E+00 4.909922568E+07
+ 7.127441546E+07 2.890716754E-02 6.930171596E-09 3.494947695E+00 4.940427732E+07
+ 7.164975101E+07 2.643361061E-02 6.351361960E-09 3.276928777E+00 4.972797865E+07
+ 7.202508657E+07 2.415326599E-02 5.819303937E-09 3.058909859E+00 5.007286771E+07
+ 7.240042213E+07 2.205843790E-02 5.330360184E-09 2.840890940E+00 5.044207650E+07
+ 7.277575769E+07 2.014457747E-02 4.881164545E-09 2.622872022E+00 5.083933950E+07
+ 7.315109324E+07 1.840202039E-02 4.468602801E-09 2.404853104E+00 5.126940811E+07
+ 7.352642880E+07 1.678158958E-02 4.089794720E-09 2.186834185E+00 5.173840926E+07
+ 7.390176436E+07 1.534194125E-02 3.742077305E-09 1.968815267E+00 5.225435567E+07
+ 7.427709991E+07 1.397772766E-02 3.422989182E-09 1.750796349E+00 5.282802351E+07
+ 7.465243547E+07 1.274217315E-02 3.130256042E-09 1.532777430E+00 5.347441303E+07
+ 7.502777103E+07 1.160182287E-02 2.861777076E-09 1.314758512E+00 5.421552710E+07
+ 7.540310658E+07 1.057898329E-02 2.615612347E-09 1.096739594E+00 5.508486822E+07
+ 7.577844214E+07 9.629310794E-03 2.389971023E-09 8.787206753E-01 5.613833969E+07
+ 7.615377770E+07 8.790768808E-03 2.183200433E-09 6.607017570E-01 5.747982882E+07
+ 7.652911326E+07 8.009390659E-03 1.993775877E-09 4.426828387E-01 5.933682020E+07
+ 7.690444881E+07 7.299705269E-03 1.820291154E-09 2.246639204E-01 6.241648699E+07
+ 7.727978437E+07 6.645002072E-03 1.661449755E-09 6.645002072E-03 7.727978450E+07
+ 7.734623439E+07 6.578552051E-03 1.000000000E-09 6.578552051E-03 7.734623444E+07
+ 7.741268441E+07 6.512102031E-03 1.000000000E-09 6.512102031E-03 7.741268400E+07
+ 7.747913443E+07 6.445652010E-03 1.000000000E-09 6.445652010E-03 7.747913400E+07
+ 7.754558445E+07 6.379201989E-03 1.000000000E-09 6.379201989E-03 7.754565623E+07
+ 7.761203447E+07 6.312751969E-03 1.000000000E-09 6.312751969E-03 7.761203200E+07
+ 7.767848449E+07 6.246301948E-03 1.000000000E-09 6.246301948E-03 7.767848450E+07
+ 7.774493452E+07 6.179851927E-03 1.000000000E-09 6.179851927E-03 7.774496000E+07
+ 7.781138454E+07 6.113401906E-03 1.000000000E-09 6.113401906E-03 7.781138454E+07
+ 7.787783456E+07 6.046951886E-03 1.000000000E-09 6.046951886E-03 7.787783500E+07
+ 7.794428458E+07 5.980501865E-03 1.000000000E-09 5.980501865E-03 7.794428400E+07
+ 7.801073460E+07 5.914051844E-03 1.000000000E-09 5.914051844E-03 7.801073400E+07
+ 7.807718462E+07 5.847601824E-03 1.000000000E-09 5.847601824E-03 7.807718462E+07
+ 7.814363464E+07 5.781151803E-03 1.000000000E-09 5.781151803E-03 7.814363475E+07
+ 7.821008466E+07 5.714701782E-03 1.000000000E-09 5.714701782E-03 7.821008700E+07
+ 7.827653468E+07 5.648251761E-03 1.000000000E-09 5.648251761E-03 7.827653468E+07
+ 7.834298470E+07 5.581801741E-03 1.000000000E-09 5.581801741E-03 7.834298469E+07
+ 7.840943472E+07 5.515351720E-03 1.000000000E-09 5.515351720E-03 7.840943473E+07
+ 7.847588474E+07 5.448901699E-03 1.000000000E-09 5.448901699E-03 7.847588500E+07
+ 7.854233476E+07 5.382451678E-03 1.000000000E-09 5.382451678E-03 7.854233500E+07
+ 7.860878478E+07 5.316001658E-03 1.000000000E-09 5.316001658E-03 7.860879239E+07
+ 7.867523481E+07 5.249551637E-03 1.000000000E-09 5.249551637E-03 7.867523481E+07
+ 7.874168483E+07 5.183101616E-03 1.000000000E-09 5.183101616E-03 7.874168487E+07
+ 7.880813485E+07 5.116651596E-03 1.000000000E-09 5.116651596E-03 7.880813485E+07
+ 7.887458487E+07 5.050201575E-03 1.000000000E-09 5.050201575E-03 7.887458600E+07
+ 7.894103489E+07 4.983751554E-03 1.000000000E-09 4.983751554E-03 7.894103494E+07
+ 7.900748491E+07 4.917301533E-03 1.000000000E-09 4.917301533E-03 7.900748800E+07
+ 7.907393493E+07 4.850851513E-03 1.000000000E-09 4.850851513E-03 7.907393493E+07
+ 7.914038495E+07 4.784401492E-03 1.000000000E-09 4.784401492E-03 7.914038500E+07
+ 7.920683497E+07 4.717951471E-03 1.000000000E-09 4.717951471E-03 7.920683481E+07
+ 7.927328499E+07 4.651501451E-03 1.000000000E-09 4.651501451E-03 7.927328500E+07
+ 7.933973501E+07 4.585051430E-03 1.000000000E-09 4.585051430E-03 7.933973512E+07
+ 7.940618503E+07 4.518601409E-03 1.000000000E-09 4.518601409E-03 7.940618500E+07
+ 7.947263505E+07 4.452151388E-03 1.000000000E-09 4.452151388E-03 7.947264000E+07
+ 7.953908507E+07 4.385701368E-03 1.000000000E-09 4.385701368E-03 7.953908512E+07
+ 7.960553510E+07 4.319251347E-03 1.000000000E-09 4.319251347E-03 7.960553700E+07
+ 7.967198512E+07 4.252801326E-03 1.000000000E-09 4.252801326E-03 7.967198512E+07
+ 7.973843514E+07 4.186351305E-03 1.000000000E-09 4.186351305E-03 7.973843800E+07
+ 7.980488516E+07 4.119901285E-03 1.000000000E-09 4.119901285E-03 7.980489600E+07
+ 7.987133518E+07 4.053451264E-03 1.000000000E-09 4.053451264E-03 7.987132800E+07
+ 7.993778520E+07 3.987001243E-03 1.000000000E-09 3.987001243E-03 7.993778520E+07
+ 8.000423522E+07 3.920551223E-03 1.000000000E-09 3.920551223E-03 8.000423525E+07
+ 8.007068524E+07 3.854101202E-03 1.000000000E-09 3.854101202E-03 8.007068524E+07
+ 8.013713526E+07 3.787651181E-03 1.000000000E-09 3.787651181E-03 8.013713563E+07
+ 8.020358528E+07 3.721201160E-03 1.000000000E-09 3.721201160E-03 8.020352000E+07
+ 8.027003530E+07 3.654751140E-03 1.000000000E-09 3.654751140E-03 8.027005765E+07
+ 8.033648532E+07 3.588301119E-03 1.000000000E-09 3.588301119E-03 8.033649066E+07
+ 8.040293534E+07 3.521851098E-03 1.000000000E-09 3.521851098E-03 8.040293534E+07
+ 8.046938536E+07 3.455401078E-03 1.000000000E-09 3.455401078E-03 8.046939200E+07
+ 8.053583539E+07 3.388951057E-03 1.000000000E-09 3.388951057E-03 8.053584000E+07
+ 8.060228541E+07 3.322501036E-03 1.000000000E-09 3.322501036E-03 8.060228600E+07
+ 8.066873543E+07 3.256051015E-03 1.000000000E-09 3.256051015E-03 8.066873600E+07
+ 8.073518545E+07 3.189600995E-03 1.000000000E-09 3.189600995E-03 8.073518600E+07
+ 8.080163547E+07 3.123150974E-03 1.000000000E-09 3.123150974E-03 8.080163556E+07
+ 8.086808549E+07 3.056700953E-03 1.000000000E-09 3.056700953E-03 8.086813765E+07
+ 8.093453551E+07 2.990250932E-03 1.000000000E-09 2.990250932E-03 8.093453551E+07
+ 8.100098553E+07 2.923800912E-03 1.000000000E-09 2.923800912E-03 8.100098600E+07
+ 8.106743555E+07 2.857350891E-03 1.000000000E-09 2.857350891E-03 8.106743556E+07
+ 8.113388557E+07 2.790900870E-03 1.000000000E-09 2.790900870E-03 8.113388500E+07
+ 8.120033559E+07 2.724450850E-03 1.000000000E-09 2.724450850E-03 8.120035980E+07
+ 8.126678561E+07 2.658000829E-03 1.000000000E-09 2.658000829E-03 8.126678600E+07
+ 8.133323563E+07 2.591550808E-03 1.000000000E-09 2.591550808E-03 8.133323582E+07
+ 8.139968565E+07 2.525100787E-03 1.000000000E-09 2.525100787E-03 8.139968583E+07
+ 8.146613568E+07 2.458650767E-03 1.000000000E-09 2.458650767E-03 8.146613568E+07
+ 8.153258570E+07 2.392200746E-03 1.000000000E-09 2.392200746E-03 8.153258585E+07
+ 8.159903572E+07 2.325750725E-03 1.000000000E-09 2.325750725E-03 8.159903572E+07
+ 8.166548574E+07 2.259300705E-03 1.000000000E-09 2.259300705E-03 8.166553600E+07
+ 8.173193576E+07 2.192850684E-03 1.000000000E-09 2.192850684E-03 8.173193576E+07
+ 8.179838578E+07 2.126400663E-03 1.000000000E-09 2.126400663E-03 8.179838581E+07
+ 8.186483580E+07 2.059950642E-03 1.000000000E-09 2.059950642E-03 8.186483600E+07
+ 8.193128582E+07 1.993500622E-03 1.000000000E-09 1.993500622E-03 8.193130691E+07
+ 8.199773584E+07 1.927050601E-03 1.000000000E-09 1.927050601E-03 8.199773892E+07
+ 8.206418586E+07 1.860600580E-03 1.000000000E-09 1.860600580E-03 8.206418586E+07
+ 8.213063588E+07 1.794150559E-03 1.000000000E-09 1.794150559E-03 8.213063588E+07
+ 8.219708590E+07 1.727700539E-03 1.000000000E-09 1.727700539E-03 8.219708590E+07
+ 8.226353592E+07 1.661250518E-03 1.000000000E-09 1.661250518E-03 8.226353592E+07
+ 8.232998595E+07 1.594800497E-03 1.000000000E-09 1.594800497E-03 8.232998800E+07
+ 8.239643597E+07 1.528350477E-03 1.000000000E-09 1.528350477E-03 8.239643597E+07
+ 8.246288599E+07 1.461900456E-03 1.000000000E-09 1.461900456E-03 8.246288599E+07
+ 8.252933601E+07 1.395450435E-03 1.000000000E-09 1.395450435E-03 8.252939651E+07
+ 8.259578603E+07 1.329000414E-03 1.000000000E-09 1.329000414E-03 8.259584000E+07
+ 8.266223605E+07 1.262550394E-03 1.000000000E-09 1.262550394E-03 8.266231802E+07
+ 8.272868607E+07 1.196100373E-03 1.000000000E-09 1.196100373E-03 8.272868607E+07
+ 8.279513609E+07 1.129650352E-03 1.000000000E-09 1.129650352E-03 8.279513609E+07
+ 8.286158611E+07 1.063200332E-03 1.000000000E-09 1.063200332E-03 8.286158611E+07
+ 8.292803613E+07 9.967503108E-04 1.000000000E-09 9.967503108E-04 8.292808207E+07
+ 8.299448615E+07 9.303002901E-04 1.000000000E-09 9.303002901E-04 8.299453661E+07
+ 8.306093617E+07 8.638502694E-04 1.000000000E-09 8.638502694E-04 8.306093619E+07
+ 8.312738619E+07 7.974002487E-04 1.000000000E-09 7.974002487E-04 8.312738110E+07
+ 8.319383621E+07 7.309502279E-04 1.000000000E-09 7.309502279E-04 8.319383621E+07
+ 8.326028624E+07 6.645002072E-04 1.000000000E-09 6.645002072E-04 8.326028800E+07
+ 8.332673626E+07 5.980501865E-04 1.000000000E-09 5.980501865E-04 8.332672000E+07
+ 8.339318628E+07 5.316001658E-04 1.000000000E-09 5.316001658E-04 8.339323314E+07
+ 8.345963630E+07 4.651501451E-04 1.000000000E-09 4.651501451E-04 8.345963630E+07
+ 8.352608632E+07 3.987001243E-04 1.000000000E-09 3.987001243E-04 8.352608632E+07
+ 8.359253634E+07 3.322501036E-04 1.000000000E-09 3.322501036E-04 8.359249217E+07
+ 8.365898636E+07 2.658000829E-04 1.000000000E-09 2.658000829E-04 8.365898918E+07
+ 8.372543638E+07 1.993500622E-04 1.000000000E-09 1.993500622E-04 8.372545600E+07
+ 8.379188640E+07 1.329000414E-04 1.000000000E-09 1.329000414E-04 8.379188640E+07
+ 8.385833642E+07 6.645002072E-05 1.000000000E-09 6.645002072E-05 8.385833642E+07
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM87
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM87	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM87	(revision 286)
@@ -0,0 +1,501 @@
+DENSITY AND THICKNESS DATA OF THE ATMOSPHERE AT AN ZENITH ANGLE OF 87.0 DEGREES
+ 0.000000000E+00 1.538097327E+04 1.229805824E-03 1.538097327E+04 1.862645149E-09
+ 6.925906751E+04 1.529592814E+04 1.225325567E-03 1.531040571E+04 5.756453625E+04
+ 1.385181350E+05 1.521146705E+04 1.220852410E-03 1.523983814E+04 1.150788823E+05
+ 2.077772025E+05 1.512676353E+04 1.216386395E-03 1.516927058E+04 1.729891659E+05
+ 2.770362700E+05 1.504292369E+04 1.211927564E-03 1.509870301E+04 2.310807971E+05
+ 3.462953375E+05 1.495848937E+04 1.207475956E-03 1.502813544E+04 2.891190426E+05
+ 4.155544050E+05 1.487560821E+04 1.203031614E-03 1.495756788E+04 3.470512482E+05
+ 4.848134726E+05 1.479241071E+04 1.198594577E-03 1.488700031E+04 4.061845486E+05
+ 5.540725401E+05 1.470951938E+04 1.194164886E-03 1.481643275E+04 4.647594120E+05
+ 6.233316076E+05 1.462695701E+04 1.189742579E-03 1.474586518E+04 5.232292578E+05
+ 6.925906751E+05 1.454467736E+04 1.185327698E-03 1.467529761E+04 5.827051642E+05
+ 7.618497426E+05 1.446270382E+04 1.180920281E-03 1.460473005E+04 6.420594496E+05
+ 8.311088101E+05 1.438103335E+04 1.176520366E-03 1.453416248E+04 7.010800216E+05
+ 9.003678776E+05 1.429994163E+04 1.172127993E-03 1.446359492E+04 7.611029484E+05
+ 9.696269451E+05 1.421825993E+04 1.167743199E-03 1.439302735E+04 8.210227463E+05
+ 1.038886013E+06 1.413812226E+04 1.163366023E-03 1.432245978E+04 8.806096607E+05
+ 1.108145080E+06 1.405766477E+04 1.158996502E-03 1.425189222E+04 9.414463075E+05
+ 1.177404148E+06 1.397750772E+04 1.154634673E-03 1.418132465E+04 1.001711944E+06
+ 1.246663215E+06 1.389765233E+04 1.150280574E-03 1.411075709E+04 1.061880284E+06
+ 1.315922283E+06 1.381816938E+04 1.145934240E-03 1.404018952E+04 1.123304264E+06
+ 1.385181350E+06 1.373864537E+04 1.141595709E-03 1.396962195E+04 1.184162636E+06
+ 1.454440418E+06 1.366006027E+04 1.137265016E-03 1.389905439E+04 1.245457366E+06
+ 1.523699485E+06 1.358140401E+04 1.132942197E-03 1.382848682E+04 1.306493840E+06
+ 1.592958553E+06 1.350304753E+04 1.128627287E-03 1.375791926E+04 1.368483635E+06
+ 1.662217620E+06 1.342498773E+04 1.124320322E-03 1.368735169E+04 1.430480088E+06
+ 1.731476688E+06 1.334750010E+04 1.120021336E-03 1.361678412E+04 1.492359812E+06
+ 1.800735755E+06 1.326941700E+04 1.115730364E-03 1.354621656E+04 1.554926328E+06
+ 1.869994823E+06 1.319286949E+04 1.111447439E-03 1.347564899E+04 1.617225645E+06
+ 1.939253890E+06 1.311599667E+04 1.107172595E-03 1.340508143E+04 1.679978130E+06
+ 2.008512958E+06 1.303941778E+04 1.102905867E-03 1.333451386E+04 1.742946052E+06
+ 2.077772025E+06 1.296341012E+04 1.098647287E-03 1.326394629E+04 1.806136613E+06
+ 2.147031093E+06 1.288716677E+04 1.094396888E-03 1.319337873E+04 1.869541787E+06
+ 2.216290160E+06 1.281174475E+04 1.090154703E-03 1.312281116E+04 1.932873137E+06
+ 2.285549228E+06 1.273572045E+04 1.085920763E-03 1.305224360E+04 1.997018758E+06
+ 2.354808295E+06 1.266010517E+04 1.081695102E-03 1.298167603E+04 2.060531797E+06
+ 2.424067363E+06 1.258640951E+04 1.077477749E-03 1.291110846E+04 2.125416485E+06
+ 2.493326430E+06 1.251188632E+04 1.073268738E-03 1.284054090E+04 2.189697805E+06
+ 2.562585498E+06 1.243792375E+04 1.069068098E-03 1.276997333E+04 2.254709941E+06
+ 2.631844565E+06 1.236370092E+04 1.064875860E-03 1.269940577E+04 2.319454639E+06
+ 2.701103633E+06 1.229031624E+04 1.060692055E-03 1.262883820E+04 2.383819369E+06
+ 2.770362700E+06 1.221694602E+04 1.056516713E-03 1.255827063E+04 2.450151925E+06
+ 2.839621768E+06 1.214395659E+04 1.052349863E-03 1.248770307E+04 2.516118832E+06
+ 2.908880835E+06 1.207116226E+04 1.048191536E-03 1.241713550E+04 2.581813211E+06
+ 2.978139903E+06 1.199865494E+04 1.044041759E-03 1.234656794E+04 2.648263557E+06
+ 3.047398970E+06 1.192671083E+04 1.039900563E-03 1.227600037E+04 2.714446869E+06
+ 3.116658038E+06 1.185415225E+04 1.035767974E-03 1.220543280E+04 2.781392216E+06
+ 3.185917105E+06 1.178313026E+04 1.031644023E-03 1.213486524E+04 2.848160318E+06
+ 3.255176173E+06 1.171176504E+04 1.027528736E-03 1.206429767E+04 2.915613269E+06
+ 3.324435240E+06 1.164068389E+04 1.023422140E-03 1.199373011E+04 2.982801580E+06
+ 3.393694308E+06 1.157016285E+04 1.019324265E-03 1.192316254E+04 3.050769688E+06
+ 3.462953375E+06 1.149902492E+04 1.015235135E-03 1.185259497E+04 3.118144439E+06
+ 3.532212443E+06 1.142943693E+04 1.011154778E-03 1.178202741E+04 3.186973091E+06
+ 3.601471510E+06 1.135948576E+04 1.007083221E-03 1.171145984E+04 3.255469572E+06
+ 3.670730578E+06 1.128981566E+04 1.003020489E-03 1.164089228E+04 3.324234106E+06
+ 3.739989645E+06 1.122070254E+04 9.989666082E-04 1.157032471E+04 3.393537508E+06
+ 3.809248713E+06 1.115097008E+04 9.949216037E-04 1.149975714E+04 3.462240588E+06
+ 3.878507780E+06 1.108276610E+04 9.908855009E-04 1.142918958E+04 3.532453998E+06
+ 3.947766848E+06 1.101421394E+04 9.868583245E-04 1.135862201E+04 3.602318473E+06
+ 4.017025915E+06 1.094593981E+04 9.828400991E-04 1.128805445E+04 3.672464664E+06
+ 4.086284983E+06 1.087821844E+04 9.788308488E-04 1.121748688E+04 3.743167659E+06
+ 4.155544050E+06 1.081049755E+04 9.748305976E-04 1.114691931E+04 3.813885712E+06
+ 4.224803118E+06 1.074285942E+04 9.708393691E-04 1.107635175E+04 3.884899804E+06
+ 4.294062185E+06 1.067598500E+04 9.668571865E-04 1.100578418E+04 3.956476864E+06
+ 4.363321253E+06 1.060909107E+04 9.628840730E-04 1.093521661E+04 4.028075826E+06
+ 4.432580321E+06 1.054212159E+04 9.589200512E-04 1.086464905E+04 4.099973347E+06
+ 4.501839388E+06 1.047640030E+04 9.549651434E-04 1.079408148E+04 4.172451503E+06
+ 4.571098456E+06 1.041033179E+04 9.510193719E-04 1.072351392E+04 4.245060274E+06
+ 4.640357523E+06 1.034453033E+04 9.470827583E-04 1.065294635E+04 4.317874565E+06
+ 4.709616591E+06 1.027927609E+04 9.431553243E-04 1.058237878E+04 4.391001574E+06
+ 4.778875658E+06 1.021339659E+04 9.392370910E-04 1.051181122E+04 4.464725544E+06
+ 4.848134726E+06 1.014902885E+04 9.353280794E-04 1.044124365E+04 4.538771402E+06
+ 4.917393793E+06 1.008433299E+04 9.314283100E-04 1.037067609E+04 4.612858800E+06
+ 4.986652861E+06 1.001988377E+04 9.275378032E-04 1.030010852E+04 4.687267483E+06
+ 5.055911928E+06 9.955976460E+03 9.236565789E-04 1.022954095E+04 4.762292231E+06
+ 5.125170996E+06 9.891017774E+03 9.197846570E-04 1.015897339E+04 4.837652186E+06
+ 5.194430063E+06 9.828417756E+03 9.159220568E-04 1.008840582E+04 4.913081550E+06
+ 5.263689131E+06 9.765318290E+03 9.120687976E-04 1.001783826E+04 4.988828352E+06
+ 5.332948198E+06 9.701584417E+03 9.082248980E-04 9.947270691E+03 5.065208963E+06
+ 5.402207266E+06 9.639354307E+03 9.043903768E-04 9.876703125E+03 5.140728908E+06
+ 5.471466333E+06 9.577046956E+03 9.005652521E-04 9.806135559E+03 5.219027127E+06
+ 5.540725401E+06 9.514103806E+03 8.967495420E-04 9.735567993E+03 5.296176080E+06
+ 5.609984468E+06 9.452760605E+03 8.929432641E-04 9.665000427E+03 5.373302531E+06
+ 5.679243536E+06 9.390965465E+03 8.891464358E-04 9.594432860E+03 5.451467892E+06
+ 5.748502603E+06 9.329432647E+03 8.853590742E-04 9.523865294E+03 5.530380730E+06
+ 5.817761671E+06 9.268437235E+03 8.815811961E-04 9.453297728E+03 5.609391728E+06
+ 5.887020738E+06 9.207425581E+03 8.778128181E-04 9.382730162E+03 5.688679823E+06
+ 5.956279806E+06 9.146679931E+03 8.740539564E-04 9.312162596E+03 5.768043129E+06
+ 6.025538873E+06 9.086463801E+03 8.703046270E-04 9.241595030E+03 5.848097752E+06
+ 6.094797941E+06 9.025610574E+03 8.665648455E-04 9.171027464E+03 5.927852654E+06
+ 6.164057008E+06 8.966255114E+03 8.628346274E-04 9.100459898E+03 6.008871037E+06
+ 6.233316076E+06 8.906813129E+03 8.591139876E-04 9.029892332E+03 6.090323992E+06
+ 6.302575143E+06 8.846751068E+03 8.554029411E-04 8.959324766E+03 6.171971393E+06
+ 6.371834211E+06 8.788167712E+03 8.517015024E-04 8.888757200E+03 6.254028048E+06
+ 6.441093278E+06 8.729495290E+03 8.480096857E-04 8.818189634E+03 6.336525976E+06
+ 6.510352346E+06 8.670524673E+03 8.443275051E-04 8.747622068E+03 6.419418555E+06
+ 6.579611413E+06 8.612356026E+03 8.406549742E-04 8.677054502E+03 6.502737898E+06
+ 6.648870481E+06 8.554173537E+03 8.369921064E-04 8.606486936E+03 6.586486775E+06
+ 6.718129548E+06 8.495889565E+03 8.333389149E-04 8.535919370E+03 6.670678059E+06
+ 6.787388616E+06 8.438829464E+03 8.296954125E-04 8.465351804E+03 6.755304720E+06
+ 6.856647683E+06 8.381673600E+03 8.260616119E-04 8.394784238E+03 6.840379874E+06
+ 6.925906751E+06 8.324216672E+03 8.224375253E-04 8.324216672E+03 6.925906751E+06
+ 7.011777879E+06 8.253414240E+03 8.216607600E-04 8.272213056E+03 6.988319714E+06
+ 7.097649008E+06 8.183047258E+03 8.165848979E-04 8.220209439E+03 7.052703016E+06
+ 7.183520136E+06 8.113129296E+03 8.115297445E-04 8.168205823E+03 7.115647858E+06
+ 7.269391265E+06 8.043629195E+03 8.064953041E-04 8.116202206E+03 7.179773980E+06
+ 7.355262393E+06 7.974560603E+03 8.014815801E-04 8.064198590E+03 7.244182922E+06
+ 7.441133522E+06 7.905920370E+03 7.964885752E-04 8.012194973E+03 7.308021633E+06
+ 7.527004650E+06 7.837710833E+03 7.915162911E-04 7.960191356E+03 7.373015133E+06
+ 7.612875779E+06 7.769923376E+03 7.865647289E-04 7.908187740E+03 7.438317284E+06
+ 7.698746907E+06 7.702560338E+03 7.816338887E-04 7.856184123E+03 7.503936463E+06
+ 7.784618036E+06 7.635618596E+03 7.767237697E-04 7.804180507E+03 7.569867129E+06
+ 7.870489164E+06 7.569335024E+03 7.718343706E-04 7.752176890E+03 7.635219937E+06
+ 7.956360293E+06 7.503230500E+03 7.669656890E-04 7.700173274E+03 7.701768738E+06
+ 8.042231421E+06 7.437543305E+03 7.621177218E-04 7.648169657E+03 7.768642628E+06
+ 8.128102550E+06 7.372270296E+03 7.572904651E-04 7.596166041E+03 7.834981968E+06
+ 8.213973678E+06 7.307413791E+03 7.524839143E-04 7.544162424E+03 7.903709364E+06
+ 8.299844807E+06 7.242965214E+03 7.476980639E-04 7.492158808E+03 7.970644334E+06
+ 8.385715935E+06 7.178926887E+03 7.429329076E-04 7.440155191E+03 8.038843004E+06
+ 8.471587064E+06 7.115295703E+03 7.381884383E-04 7.388151575E+03 8.107384712E+06
+ 8.557458192E+06 7.052802794E+03 7.334646484E-04 7.336147958E+03 8.175369400E+06
+ 8.643329321E+06 6.989263579E+03 7.287615292E-04 7.284144342E+03 8.245519629E+06
+ 8.729200449E+06 6.927554259E+03 7.240790713E-04 7.232140725E+03 8.314169131E+06
+ 8.815071578E+06 6.864828184E+03 7.194172648E-04 7.180137109E+03 8.384105317E+06
+ 8.900942706E+06 6.803911336E+03 7.147760987E-04 7.128133492E+03 8.454404369E+06
+ 8.986813835E+06 6.741991377E+03 7.101555615E-04 7.076129876E+03 8.525090971E+06
+ 9.072684963E+06 6.681854131E+03 7.055556409E-04 7.024126259E+03 8.596130443E+06
+ 9.158556092E+06 6.620774805E+03 7.009763239E-04 6.972122643E+03 8.667547268E+06
+ 9.244427220E+06 6.561431582E+03 6.964175966E-04 6.920119026E+03 8.739343950E+06
+ 9.330298349E+06 6.501776277E+03 6.918794446E-04 6.868115410E+03 8.810554583E+06
+ 9.416169477E+06 6.442508638E+03 6.873618526E-04 6.816111793E+03 8.884102869E+06
+ 9.502040606E+06 6.383631146E+03 6.828648047E-04 6.764108177E+03 8.956063920E+06
+ 9.587911734E+06 6.325135060E+03 6.783882843E-04 6.712104560E+03 9.029414528E+06
+ 9.673782863E+06 6.267022816E+03 6.739322741E-04 6.660100944E+03 9.103168842E+06
+ 9.759653991E+06 6.209291305E+03 6.694967560E-04 6.608097327E+03 9.177416803E+06
+ 9.845525120E+06 6.151953623E+03 6.650817114E-04 6.556093711E+03 9.251996631E+06
+ 9.931396248E+06 6.094979601E+03 6.606871207E-04 6.504090094E+03 9.326997355E+06
+ 1.001726738E+07 6.039098242E+03 6.563129640E-04 6.452086478E+03 9.402422215E+06
+ 1.010313851E+07 5.982159080E+03 6.519592205E-04 6.400082861E+03 9.477278531E+06
+ 1.018900963E+07 5.927014812E+03 6.476258688E-04 6.348079245E+03 9.554574485E+06
+ 1.027488076E+07 5.870832044E+03 6.433128868E-04 6.296075628E+03 9.630285582E+06
+ 1.036075189E+07 5.816412055E+03 6.390202518E-04 6.244072012E+03 9.708490026E+06
+ 1.044662302E+07 5.760979475E+03 6.347479403E-04 6.192068395E+03 9.785082086E+06
+ 1.053249415E+07 5.706644266E+03 6.304959284E-04 6.140064779E+03 9.864241735E+06
+ 1.061836528E+07 5.653555101E+03 6.262641915E-04 6.088061162E+03 9.941739566E+06
+ 1.070423640E+07 5.599198813E+03 6.220527041E-04 6.036057546E+03 1.002183523E+07
+ 1.079010753E+07 5.546595273E+03 6.178614403E-04 5.984053929E+03 1.010026940E+07
+ 1.087597866E+07 5.493657653E+03 6.136903737E-04 5.932050313E+03 1.018134797E+07
+ 1.096184979E+07 5.441073561E+03 6.095394771E-04 5.880046696E+03 1.026074782E+07
+ 1.104772092E+07 5.388845606E+03 6.054087226E-04 5.828043080E+03 1.034282494E+07
+ 1.113359205E+07 5.336970667E+03 6.012980820E-04 5.776039463E+03 1.042322228E+07
+ 1.121946318E+07 5.285462062E+03 5.972075261E-04 5.724035847E+03 1.050529528E+07
+ 1.130533430E+07 5.234289292E+03 5.931370255E-04 5.672032230E+03 1.058818712E+07
+ 1.139120543E+07 5.183465802E+03 5.890865500E-04 5.620028614E+03 1.067124401E+07
+ 1.147707656E+07 5.132988564E+03 5.850560688E-04 5.568024997E+03 1.075483935E+07
+ 1.156294769E+07 5.083564977E+03 5.810455506E-04 5.516021381E+03 1.083897914E+07
+ 1.164881882E+07 5.033071310E+03 5.770549635E-04 5.464017764E+03 1.092482906E+07
+ 1.173468995E+07 4.984314006E+03 5.730842750E-04 5.412014148E+03 1.100893428E+07
+ 1.182056107E+07 4.935260154E+03 5.691334522E-04 5.360010531E+03 1.109590605E+07
+ 1.190643220E+07 4.886482985E+03 5.652024615E-04 5.308006915E+03 1.118117056E+07
+ 1.199230333E+07 4.838043226E+03 5.612912687E-04 5.256003298E+03 1.126932354E+07
+ 1.207817446E+07 4.789937850E+03 5.573998391E-04 5.203999682E+03 1.135691307E+07
+ 1.216404559E+07 4.742169273E+03 5.535281376E-04 5.151996065E+03 1.144510923E+07
+ 1.224991672E+07 4.694728984E+03 5.496761284E-04 5.099992449E+03 1.153392898E+07
+ 1.233578785E+07 4.648338225E+03 5.458437752E-04 5.047988832E+03 1.162337114E+07
+ 1.242165897E+07 4.600837616E+03 5.420310413E-04 4.995985216E+03 1.171467219E+07
+ 1.250753010E+07 4.555098317E+03 5.382378894E-04 4.943981599E+03 1.180418423E+07
+ 1.259340123E+07 4.508266044E+03 5.344642816E-04 4.891977983E+03 1.189687133E+07
+ 1.267927236E+07 4.463143494E+03 5.307101797E-04 4.839974366E+03 1.198891859E+07
+ 1.276514349E+07 4.417652626E+03 5.269755447E-04 4.787970750E+03 1.208164778E+07
+ 1.285101462E+07 4.372478323E+03 5.232603375E-04 4.735967133E+03 1.217507839E+07
+ 1.293688575E+07 4.327623161E+03 5.195645181E-04 4.683963517E+03 1.226921115E+07
+ 1.302275687E+07 4.283084137E+03 5.158880464E-04 4.631959900E+03 1.236530879E+07
+ 1.310862800E+07 4.239096740E+03 5.122308816E-04 4.579956284E+03 1.246089888E+07
+ 1.319449913E+07 4.195183069E+03 5.085929824E-04 4.527952667E+03 1.255720874E+07
+ 1.328037026E+07 4.151581997E+03 5.049743072E-04 4.475949051E+03 1.265559328E+07
+ 1.336624139E+07 4.108290557E+03 5.013748138E-04 4.423945434E+03 1.275341650E+07
+ 1.345211252E+07 4.066018239E+03 4.977944596E-04 4.371941818E+03 1.285202231E+07
+ 1.353798364E+07 4.022635378E+03 4.942332016E-04 4.319938201E+03 1.295143468E+07
+ 1.362385477E+07 3.980952052E+03 4.906909962E-04 4.267934585E+03 1.305166741E+07
+ 1.370972590E+07 3.938889925E+03 4.871677995E-04 4.215930968E+03 1.315450701E+07
+ 1.379559703E+07 3.897114942E+03 4.836635671E-04 4.163927352E+03 1.325638029E+07
+ 1.388146816E+07 3.855641282E+03 4.801782544E-04 4.111923735E+03 1.335912319E+07
+ 1.396733929E+07 3.814465962E+03 4.767118159E-04 4.059920119E+03 1.346413402E+07
+ 1.405321042E+07 3.774309109E+03 4.732642061E-04 4.007916502E+03 1.356862847E+07
+ 1.413908154E+07 3.733009344E+03 4.698353790E-04 3.955912886E+03 1.367404805E+07
+ 1.422495267E+07 3.693417528E+03 4.664252881E-04 3.903909269E+03 1.378182548E+07
+ 1.431082380E+07 3.652727179E+03 4.630338865E-04 3.851905653E+03 1.388910511E+07
+ 1.439669493E+07 3.613756141E+03 4.596611271E-04 3.799902036E+03 1.399737162E+07
+ 1.448256606E+07 3.574330024E+03 4.563069621E-04 3.747898420E+03 1.410802767E+07
+ 1.456843719E+07 3.535191183E+03 4.529713436E-04 3.695894803E+03 1.421975176E+07
+ 1.465430832E+07 3.496342108E+03 4.496542231E-04 3.643891187E+03 1.433111495E+07
+ 1.474017944E+07 3.457774473E+03 4.463555519E-04 3.591887570E+03 1.444342605E+07
+ 1.482605057E+07 3.420195320E+03 4.430752809E-04 3.539883954E+03 1.455829095E+07
+ 1.491192170E+07 3.381488248E+03 4.398133606E-04 3.487880337E+03 1.467431454E+07
+ 1.499779283E+07 3.344461033E+03 4.365697410E-04 3.435876720E+03 1.478986773E+07
+ 1.508366396E+07 3.307005571E+03 4.333443720E-04 3.383873104E+03 1.490660591E+07
+ 1.516953509E+07 3.269826536E+03 4.301372031E-04 3.331869487E+03 1.502605696E+07
+ 1.525540621E+07 3.232926457E+03 4.269481832E-04 3.279865871E+03 1.514672306E+07
+ 1.534127734E+07 3.196297033E+03 4.237772613E-04 3.227862254E+03 1.526866413E+07
+ 1.542714847E+07 3.160644007E+03 4.206243857E-04 3.175858638E+03 1.539017013E+07
+ 1.551301960E+07 3.123855021E+03 4.174895046E-04 3.123855021E+03 1.551301960E+07
+ 1.581339608E+07 2.998143127E+03 4.109646463E-04 3.092847497E+03 1.558611732E+07
+ 1.611377256E+07 2.876921329E+03 3.962403868E-04 3.061839973E+03 1.565986310E+07
+ 1.641414904E+07 2.760055549E+03 3.819592699E-04 3.030832448E+03 1.573424713E+07
+ 1.671452552E+07 2.647413976E+03 3.681115296E-04 2.999824924E+03 1.580930550E+07
+ 1.701490200E+07 2.538875367E+03 3.546874699E-04 2.968817400E+03 1.588507796E+07
+ 1.731527848E+07 2.434299155E+03 3.416774710E-04 2.937809875E+03 1.596155245E+07
+ 1.761565496E+07 2.333569840E+03 3.290719946E-04 2.906802351E+03 1.603871875E+07
+ 1.791603144E+07 2.236567149E+03 3.168615891E-04 2.875794827E+03 1.611661551E+07
+ 1.821640792E+07 2.143174355E+03 3.050368953E-04 2.844787302E+03 1.619528569E+07
+ 1.851678440E+07 2.053276145E+03 2.935886504E-04 2.813779778E+03 1.627471749E+07
+ 1.881716087E+07 1.966761312E+03 2.825076929E-04 2.782772253E+03 1.635490159E+07
+ 1.911753735E+07 1.883520725E+03 2.717849669E-04 2.751764729E+03 1.643587981E+07
+ 1.941791383E+07 1.803450013E+03 2.614115255E-04 2.720757205E+03 1.651769832E+07
+ 1.971829031E+07 1.726441990E+03 2.513785347E-04 2.689749680E+03 1.660034676E+07
+ 2.001866679E+07 1.652397576E+03 2.416772772E-04 2.658742156E+03 1.668381604E+07
+ 2.031904327E+07 1.581229257E+03 2.322991549E-04 2.627734632E+03 1.676815172E+07
+ 2.061941975E+07 1.512819455E+03 2.232356919E-04 2.596727107E+03 1.685342507E+07
+ 2.091979623E+07 1.447085830E+03 2.144785375E-04 2.565719583E+03 1.693958513E+07
+ 2.122017271E+07 1.383937494E+03 2.060194683E-04 2.534712059E+03 1.702664619E+07
+ 2.152054919E+07 1.323289106E+03 1.978503903E-04 2.503704534E+03 1.711465676E+07
+ 2.182092567E+07 1.265045284E+03 1.899633411E-04 2.472697010E+03 1.720367113E+07
+ 2.212130215E+07 1.209143754E+03 1.823504912E-04 2.441689485E+03 1.729368246E+07
+ 2.242167863E+07 1.155477726E+03 1.750041460E-04 2.410681961E+03 1.738468488E+07
+ 2.272205511E+07 1.103979092E+03 1.679167466E-04 2.379674437E+03 1.747676526E+07
+ 2.302243159E+07 1.054581981E+03 1.610808715E-04 2.348666912E+03 1.756991848E+07
+ 2.332280807E+07 1.007190657E+03 1.544892366E-04 2.317659388E+03 1.766414097E+07
+ 2.362318455E+07 9.617434617E+02 1.481346969E-04 2.286651864E+03 1.775952416E+07
+ 2.392356103E+07 9.181700217E+02 1.420102462E-04 2.255644339E+03 1.785606565E+07
+ 2.422393751E+07 8.764041793E+02 1.361090182E-04 2.224636815E+03 1.795376407E+07
+ 2.452431399E+07 8.363763100E+02 1.304242859E-04 2.193629291E+03 1.805271797E+07
+ 2.482469046E+07 7.980349242E+02 1.249494623E-04 2.162621766E+03 1.815292497E+07
+ 2.512506694E+07 7.612970025E+02 1.196781000E-04 2.131614242E+03 1.825438765E+07
+ 2.542544342E+07 7.261224501E+02 1.146038908E-04 2.100606717E+03 1.835721013E+07
+ 2.572581990E+07 6.924330715E+02 1.097206655E-04 2.069599193E+03 1.846139606E+07
+ 2.602619638E+07 6.601822824E+02 1.050223934E-04 2.038591669E+03 1.856694923E+07
+ 2.632657286E+07 6.293228306E+02 1.005031813E-04 2.007584144E+03 1.867398293E+07
+ 2.662694934E+07 5.997873293E+02 9.615727315E-05 1.976576620E+03 1.878250365E+07
+ 2.692732582E+07 5.715317845E+02 9.197904875E-05 1.945569096E+03 1.889255706E+07
+ 2.722770230E+07 5.445175464E+02 8.796302296E-05 1.914561571E+03 1.900419011E+07
+ 2.752807878E+07 5.186749347E+02 8.410384450E-05 1.883554047E+03 1.911741479E+07
+ 2.782845526E+07 4.939789060E+02 8.039629478E-05 1.852546523E+03 1.923236525E+07
+ 2.812883174E+07 4.703639752E+02 7.683528654E-05 1.821538998E+03 1.934904494E+07
+ 2.842920822E+07 4.477988346E+02 7.341586250E-05 1.790531474E+03 1.946751764E+07
+ 2.872958470E+07 4.262381360E+02 7.013319388E-05 1.759523949E+03 1.958784350E+07
+ 2.902996118E+07 4.056542258E+02 6.698257883E-05 1.728516425E+03 1.971004503E+07
+ 2.933033766E+07 3.859973406E+02 6.395944086E-05 1.697508901E+03 1.983427080E+07
+ 2.963071414E+07 3.672192273E+02 6.105932713E-05 1.666501376E+03 1.996054956E+07
+ 2.993109062E+07 3.492940808E+02 5.827790673E-05 1.635493852E+03 2.008895593E+07
+ 3.023146710E+07 3.321866866E+02 5.561096888E-05 1.604486328E+03 2.021956801E+07
+ 3.053184358E+07 3.158801693E+02 5.305442109E-05 1.573478803E+03 2.035247059E+07
+ 3.083222006E+07 3.003193038E+02 5.060428730E-05 1.542471279E+03 2.048774738E+07
+ 3.113259653E+07 2.854687522E+02 4.825670596E-05 1.511463754E+03 2.062549315E+07
+ 3.143297301E+07 2.713079765E+02 4.600792802E-05 1.480456230E+03 2.076580614E+07
+ 3.173334949E+07 2.578109862E+02 4.385431500E-05 1.449448706E+03 2.090879143E+07
+ 3.203372597E+07 2.449515563E+02 4.179233697E-05 1.418441181E+03 2.105455908E+07
+ 3.233410245E+07 2.327013165E+02 3.981857048E-05 1.387433657E+03 2.120322821E+07
+ 3.263447893E+07 2.210307443E+02 3.792969652E-05 1.356426133E+03 2.135492464E+07
+ 3.293485541E+07 2.099049877E+02 3.612249845E-05 1.325418608E+03 2.150979793E+07
+ 3.323523189E+07 1.993202699E+02 3.439385991E-05 1.294411084E+03 2.166796311E+07
+ 3.353560837E+07 1.892430238E+02 3.274076273E-05 1.263403560E+03 2.182956941E+07
+ 3.383598485E+07 1.796426530E+02 3.116028482E-05 1.232396035E+03 2.199488039E+07
+ 3.413636133E+07 1.705150325E+02 2.964959807E-05 1.201388511E+03 2.216393745E+07
+ 3.443673781E+07 1.618306740E+02 2.820596626E-05 1.170380986E+03 2.233698994E+07
+ 3.473711429E+07 1.535603264E+02 2.682674294E-05 1.139373462E+03 2.251430600E+07
+ 3.503749077E+07 1.457047331E+02 2.550936933E-05 1.108365938E+03 2.269598899E+07
+ 3.533786725E+07 1.382355181E+02 2.425137225E-05 1.077358413E+03 2.288233926E+07
+ 3.563824373E+07 1.311324077E+02 2.305036205E-05 1.046350889E+03 2.307368879E+07
+ 3.593862021E+07 1.243743682E+02 2.190403050E-05 1.015343365E+03 2.327018890E+07
+ 3.623899669E+07 1.179630673E+02 2.081014881E-05 9.843358403E+02 2.347228746E+07
+ 3.653937317E+07 1.118728545E+02 1.976656552E-05 9.533283159E+02 2.368018872E+07
+ 3.683974965E+07 1.060776957E+02 1.877120453E-05 9.223207916E+02 2.389440863E+07
+ 3.714012613E+07 1.005954229E+02 1.782206309E-05 8.913132672E+02 2.411530150E+07
+ 3.744050260E+07 9.537238093E+01 1.691720983E-05 8.603057428E+02 2.434322391E+07
+ 3.774087908E+07 9.042317500E+01 1.605478279E-05 8.292982185E+02 2.457884337E+07
+ 3.804125556E+07 8.572656861E+01 1.523298752E-05 7.982906941E+02 2.482264506E+07
+ 3.834163204E+07 8.126066327E+01 1.445009516E-05 7.672831697E+02 2.507525993E+07
+ 3.864200852E+07 7.704475403E+01 1.370444056E-05 7.362756454E+02 2.533738439E+07
+ 3.894238500E+07 7.302641182E+01 1.299442045E-05 7.052681210E+02 2.560981409E+07
+ 3.924276148E+07 6.922431406E+01 1.231849160E-05 6.742605966E+02 2.589344364E+07
+ 3.954313796E+07 6.562401215E+01 1.167516905E-05 6.432530723E+02 2.618925853E+07
+ 3.984351444E+07 6.221030223E+01 1.106302433E-05 6.122455479E+02 2.649861126E+07
+ 4.014389092E+07 5.897612686E+01 1.048068376E-05 5.812380235E+02 2.682270775E+07
+ 4.044426740E+07 5.591194142E+01 9.926826711E-06 5.502304992E+02 2.716300517E+07
+ 4.074464388E+07 5.300992130E+01 9.400183996E-06 5.192229748E+02 2.752157219E+07
+ 4.104502036E+07 5.026362691E+01 8.899536192E-06 4.882154504E+02 2.790045845E+07
+ 4.134539684E+07 4.766211711E+01 8.423712065E-06 4.572079261E+02 2.830228129E+07
+ 4.164577332E+07 4.519965232E+01 7.971586995E-06 4.262004017E+02 2.873012208E+07
+ 4.194614980E+07 4.286981013E+01 7.542081452E-06 3.951928774E+02 2.918799662E+07
+ 4.224652628E+07 4.066516013E+01 7.134159493E-06 3.641853530E+02 2.968052217E+07
+ 4.254690276E+07 3.857596285E+01 6.746827301E-06 3.331778286E+02 3.021369867E+07
+ 4.284727924E+07 3.661465281E+01 6.379131754E-06 3.021703043E+02 3.079560853E+07
+ 4.314765572E+07 3.474985786E+01 6.030159027E-06 2.711627799E+02 3.143612340E+07
+ 4.344803219E+07 3.298724942E+01 5.699033234E-06 2.401552555E+02 3.214982090E+07
+ 4.374840867E+07 3.132100859E+01 5.384915100E-06 2.091477312E+02 3.295580004E+07
+ 4.404878515E+07 2.974631359E+01 5.087000662E-06 1.781402068E+02 3.388424688E+07
+ 4.434916163E+07 2.827079243E+01 4.804520012E-06 1.471326824E+02 3.498156963E+07
+ 4.464953811E+07 2.686569907E+01 4.536736066E-06 1.161251581E+02 3.632807855E+07
+ 4.494991459E+07 2.553893158E+01 4.282943374E-06 8.511763370E+01 3.808110963E+07
+ 4.525029107E+07 2.429605216E+01 4.042466953E-06 5.411010934E+01 4.062900544E+07
+ 4.555066755E+07 2.310258497E+01 3.814661162E-06 2.310258497E+01 4.555066755E+07
+ 4.594294223E+07 2.160584147E+01 3.697171616E-06 2.287162749E+01 4.560961883E+07
+ 4.633521692E+07 2.020021621E+01 3.471499937E-06 2.264067000E+01 4.566912968E+07
+ 4.672749160E+07 1.888061079E+01 3.258605604E-06 2.240971252E+01 4.572921127E+07
+ 4.711976628E+07 1.764210258E+01 3.057831537E-06 2.217875504E+01 4.578987508E+07
+ 4.751204097E+07 1.648009101E+01 2.868550227E-06 2.194779755E+01 4.585113296E+07
+ 4.790431565E+07 1.539016227E+01 2.690162659E-06 2.171684007E+01 4.591298718E+07
+ 4.829659033E+07 1.436815896E+01 2.522097263E-06 2.148588258E+01 4.597547272E+07
+ 4.868886501E+07 1.341018481E+01 2.363808890E-06 2.125492510E+01 4.603858765E+07
+ 4.908113970E+07 1.251244332E+01 2.214777809E-06 2.102396761E+01 4.610234538E+07
+ 4.947341438E+07 1.167142112E+01 2.074508735E-06 2.079301013E+01 4.616676237E+07
+ 4.986568906E+07 1.088379106E+01 1.942529871E-06 2.056205264E+01 4.623185527E+07
+ 5.025796375E+07 1.014640564E+01 1.818391988E-06 2.033109516E+01 4.629762875E+07
+ 5.065023843E+07 9.456191900E+00 1.701667519E-06 2.010013767E+01 4.636411347E+07
+ 5.104251311E+07 8.810430291E+00 1.591949687E-06 1.986918019E+01 4.643131758E+07
+ 5.143478779E+07 8.206379749E+00 1.488851652E-06 1.963822271E+01 4.649925743E+07
+ 5.182706248E+07 7.641533376E+00 1.392005685E-06 1.940726522E+01 4.656794664E+07
+ 5.221933716E+07 7.113516539E+00 1.301062368E-06 1.917630774E+01 4.663740181E+07
+ 5.261161184E+07 6.620049469E+00 1.215689817E-06 1.894535025E+01 4.670765560E+07
+ 5.300388653E+07 6.159059078E+00 1.135572931E-06 1.871439277E+01 4.677871374E+07
+ 5.339616121E+07 5.728503193E+00 1.060412666E-06 1.848343528E+01 4.685059007E+07
+ 5.378843589E+07 5.326478770E+00 9.899253279E-07 1.825247780E+01 4.692331599E+07
+ 5.418071057E+07 4.951276928E+00 9.238418954E-07 1.802152031E+01 4.699691537E+07
+ 5.457298526E+07 4.601159470E+00 8.619073632E-07 1.779056283E+01 4.707140434E+07
+ 5.496525994E+07 4.274536874E+00 8.038801079E-07 1.755960534E+01 4.714680551E+07
+ 5.535753462E+07 3.969998469E+00 7.495312772E-07 1.732864786E+01 4.722314238E+07
+ 5.574980930E+07 3.686044706E+00 6.986442011E-07 1.709769038E+01 4.730043936E+07
+ 5.614208399E+07 3.421459434E+00 6.510138241E-07 1.686673289E+01 4.737872186E+07
+ 5.653435867E+07 3.174894662E+00 6.064461599E-07 1.663577541E+01 4.745800522E+07
+ 5.692663335E+07 2.945284313E+00 5.647577654E-07 1.640481792E+01 4.753833910E+07
+ 5.731890804E+07 2.731454599E+00 5.257752360E-07 1.617386044E+01 4.761973485E+07
+ 5.771118272E+07 2.532450956E+00 4.893347205E-07 1.594290295E+01 4.770223490E+07
+ 5.810345740E+07 2.347233279E+00 4.552814548E-07 1.571194547E+01 4.778585438E+07
+ 5.849573208E+07 2.174969362E+00 4.234693149E-07 1.548098798E+01 4.787064534E+07
+ 5.888800677E+07 2.014755957E+00 3.937603880E-07 1.525003050E+01 4.795663203E+07
+ 5.928028145E+07 1.865779509E+00 3.660245615E-07 1.501907301E+01 4.804384573E+07
+ 5.967255613E+07 1.727342660E+00 3.401391289E-07 1.478811553E+01 4.813232607E+07
+ 6.006483082E+07 1.598708900E+00 3.159884127E-07 1.455715805E+01 4.822211952E+07
+ 6.045710550E+07 1.479216013E+00 2.934634040E-07 1.432620056E+01 4.831325511E+07
+ 6.084938018E+07 1.368272116E+00 2.724614167E-07 1.409524308E+01 4.840577481E+07
+ 6.124165486E+07 1.265281625E+00 2.528857581E-07 1.386428559E+01 4.849974189E+07
+ 6.163392955E+07 1.169677925E+00 2.346454136E-07 1.363332811E+01 4.859519112E+07
+ 6.202620423E+07 1.081028723E+00 2.176547454E-07 1.340237062E+01 4.869217183E+07
+ 6.241847891E+07 9.987776939E-01 2.018332060E-07 1.317141314E+01 4.879071996E+07
+ 6.281075360E+07 9.225106945E-01 1.871050636E-07 1.294045565E+01 4.889092568E+07
+ 6.320302828E+07 8.518556418E-01 1.733991415E-07 1.270949817E+01 4.899281476E+07
+ 6.359530296E+07 7.863717168E-01 1.606485686E-07 1.247854068E+01 4.909645521E+07
+ 6.398757764E+07 7.256999022E-01 1.487905434E-07 1.224758320E+01 4.920192742E+07
+ 6.437985233E+07 6.695416535E-01 1.377661073E-07 1.201662572E+01 4.930928668E+07
+ 6.477212701E+07 6.175022509E-01 1.275199310E-07 1.178566823E+01 4.941858714E+07
+ 6.516440169E+07 5.693636170E-01 1.180001100E-07 1.155471075E+01 4.952994293E+07
+ 6.555667638E+07 5.248272174E-01 1.091579706E-07 1.132375326E+01 4.964340357E+07
+ 6.594895106E+07 4.836560311E-01 1.009478859E-07 1.109279578E+01 4.975904928E+07
+ 6.634122574E+07 4.455771629E-01 9.332710084E-08 1.086183829E+01 4.987700156E+07
+ 6.673350042E+07 4.103700105E-01 8.625556615E-08 1.063088081E+01 4.999732773E+07
+ 6.712577511E+07 3.778375421E-01 7.969578099E-08 1.039992332E+01 5.012015090E+07
+ 6.751804979E+07 3.477626592E-01 7.361264364E-08 1.016896584E+01 5.024556931E+07
+ 6.791032447E+07 3.200252840E-01 6.797331006E-08 9.938008354E+00 5.037369909E+07
+ 6.830259916E+07 2.943974406E-01 6.274705992E-08 9.707050870E+00 5.050464105E+07
+ 6.869487384E+07 2.707506866E-01 5.790516977E-08 9.476093385E+00 5.063856980E+07
+ 6.908714852E+07 2.489213840E-01 5.342079302E-08 9.245135901E+00 5.077559887E+07
+ 6.947942320E+07 2.288098294E-01 4.926884640E-08 9.014178416E+00 5.091590162E+07
+ 6.987169789E+07 2.102236102E-01 4.542590268E-08 8.783220931E+00 5.105963108E+07
+ 7.026397257E+07 1.931206223E-01 4.187008922E-08 8.552263447E+00 5.120696863E+07
+ 7.065624725E+07 1.773352772E-01 3.858099223E-08 8.321305962E+00 5.135809592E+07
+ 7.104852193E+07 1.628113121E-01 3.553956629E-08 8.090348478E+00 5.151325154E+07
+ 7.144079662E+07 1.494088417E-01 3.272804906E-08 7.859390993E+00 5.167262286E+07
+ 7.183307130E+07 1.371034845E-01 3.012988078E-08 7.628433509E+00 5.183648166E+07
+ 7.222534598E+07 1.257807015E-01 2.772962840E-08 7.397476024E+00 5.200508292E+07
+ 7.261762067E+07 1.153323416E-01 2.551291405E-08 7.166518540E+00 5.217873334E+07
+ 7.300989535E+07 1.057352104E-01 2.346634767E-08 6.935561055E+00 5.235775602E+07
+ 7.340217003E+07 9.690376642E-02 2.157746364E-08 6.704603571E+00 5.254246882E+07
+ 7.379444471E+07 8.877105166E-02 1.983466106E-08 6.473646086E+00 5.273332785E+07
+ 7.418671940E+07 8.132240806E-02 1.822714760E-08 6.242688601E+00 5.293073013E+07
+ 7.457899408E+07 7.446427722E-02 1.674488670E-08 6.011731117E+00 5.313511237E+07
+ 7.497126876E+07 6.817475385E-02 1.537854800E-08 5.780773632E+00 5.334707453E+07
+ 7.536354345E+07 6.238741395E-02 1.411946066E-08 5.549816148E+00 5.356719764E+07
+ 7.575581813E+07 5.708199020E-02 1.295956960E-08 5.318858663E+00 5.379613972E+07
+ 7.614809281E+07 5.223231337E-02 1.189139445E-08 5.087901179E+00 5.403473049E+07
+ 7.654036749E+07 4.773133391E-02 1.090799093E-08 4.856943694E+00 5.428375574E+07
+ 7.693264218E+07 4.363800552E-02 1.000291475E-08 4.625986210E+00 5.454425007E+07
+ 7.732491686E+07 3.985916839E-02 9.170187677E-09 4.395028725E+00 5.481736870E+07
+ 7.771719154E+07 3.643254962E-02 8.404265772E-09 4.164071240E+00 5.510440782E+07
+ 7.810946623E+07 3.328147683E-02 7.700009658E-09 3.933113756E+00 5.540695624E+07
+ 7.850174091E+07 3.038358187E-02 7.052656645E-09 3.702156271E+00 5.572679151E+07
+ 7.889401559E+07 2.772877590E-02 6.457794667E-09 3.471198787E+00 5.606618811E+07
+ 7.928629027E+07 2.532040132E-02 5.911337889E-09 3.240241302E+00 5.642766446E+07
+ 7.967856496E+07 2.308307476E-02 5.409503903E-09 3.009283818E+00 5.681445373E+07
+ 8.007083964E+07 2.106544766E-02 4.948792408E-09 2.778326333E+00 5.723052601E+07
+ 8.046311432E+07 1.919106518E-02 4.525965293E-09 2.547368849E+00 5.768077327E+07
+ 8.085538901E+07 1.750653052E-02 4.138028036E-09 2.316411364E+00 5.817160281E+07
+ 8.124766369E+07 1.595841749E-02 3.782212333E-09 2.085453880E+00 5.871132921E+07
+ 8.163993837E+07 1.453793939E-02 3.455959895E-09 1.854496395E+00 5.931120857E+07
+ 8.203221305E+07 1.323024999E-02 3.156907332E-09 1.623538910E+00 5.998676306E+07
+ 8.242448774E+07 1.205617561E-02 2.882872048E-09 1.392581426E+00 6.076092257E+07
+ 8.281676242E+07 1.097338617E-02 2.631839114E-09 1.161623941E+00 6.166842896E+07
+ 8.320903710E+07 9.995999765E-03 2.401949019E-09 9.306664568E-01 6.276745439E+07
+ 8.360131179E+07 9.091169818E-03 2.191486271E-09 6.997089723E-01 6.416521051E+07
+ 8.399358647E+07 8.247817850E-03 1.998868788E-09 4.687514877E-01 6.609881557E+07
+ 8.438586115E+07 7.517357167E-03 1.822638018E-09 2.377940032E-01 6.929970765E+07
+ 8.477813583E+07 6.836518606E-03 1.661449755E-09 6.836518606E-03 8.477813581E+07
+ 8.484650102E+07 6.768153420E-03 1.000000000E-09 6.768153420E-03 8.484650102E+07
+ 8.491486621E+07 6.699788234E-03 1.000000000E-09 6.699788234E-03 8.491486621E+07
+ 8.498323139E+07 6.631423048E-03 1.000000000E-09 6.631423048E-03 8.498323144E+07
+ 8.505159658E+07 6.563057862E-03 1.000000000E-09 6.563057862E-03 8.505159656E+07
+ 8.511996176E+07 6.494692676E-03 1.000000000E-09 6.494692676E-03 8.511996187E+07
+ 8.518832695E+07 6.426327490E-03 1.000000000E-09 6.426327490E-03 8.518832700E+07
+ 8.525669214E+07 6.357962304E-03 1.000000000E-09 6.357962304E-03 8.525673600E+07
+ 8.532505732E+07 6.289597118E-03 1.000000000E-09 6.289597118E-03 8.532505737E+07
+ 8.539342251E+07 6.221231932E-03 1.000000000E-09 6.221231932E-03 8.539348288E+07
+ 8.546178769E+07 6.152866746E-03 1.000000000E-09 6.152866746E-03 8.546178770E+07
+ 8.553015288E+07 6.084501560E-03 1.000000000E-09 6.084501560E-03 8.553017600E+07
+ 8.559851807E+07 6.016136373E-03 1.000000000E-09 6.016136373E-03 8.559851806E+07
+ 8.566688325E+07 5.947771187E-03 1.000000000E-09 5.947771187E-03 8.566688319E+07
+ 8.573524844E+07 5.879406001E-03 1.000000000E-09 5.879406001E-03 8.573526400E+07
+ 8.580361362E+07 5.811040815E-03 1.000000000E-09 5.811040815E-03 8.580360000E+07
+ 8.587197881E+07 5.742675629E-03 1.000000000E-09 5.742675629E-03 8.587201047E+07
+ 8.594034400E+07 5.674310443E-03 1.000000000E-09 5.674310443E-03 8.594032000E+07
+ 8.600870918E+07 5.605945257E-03 1.000000000E-09 5.605945257E-03 8.600870918E+07
+ 8.607707437E+07 5.537580071E-03 1.000000000E-09 5.537580071E-03 8.607707437E+07
+ 8.614543955E+07 5.469214885E-03 1.000000000E-09 5.469214885E-03 8.614543200E+07
+ 8.621380474E+07 5.400849699E-03 1.000000000E-09 5.400849699E-03 8.621380481E+07
+ 8.628216993E+07 5.332484513E-03 1.000000000E-09 5.332484513E-03 8.628217000E+07
+ 8.635053511E+07 5.264119327E-03 1.000000000E-09 5.264119327E-03 8.635053512E+07
+ 8.641890030E+07 5.195754141E-03 1.000000000E-09 5.195754141E-03 8.641889965E+07
+ 8.648726549E+07 5.127388955E-03 1.000000000E-09 5.127388955E-03 8.648726549E+07
+ 8.655563067E+07 5.059023769E-03 1.000000000E-09 5.059023769E-03 8.655563200E+07
+ 8.662399586E+07 4.990658583E-03 1.000000000E-09 4.990658583E-03 8.662399700E+07
+ 8.669236104E+07 4.922293396E-03 1.000000000E-09 4.922293396E-03 8.669236200E+07
+ 8.676072623E+07 4.853928210E-03 1.000000000E-09 4.853928210E-03 8.676072700E+07
+ 8.682909142E+07 4.785563024E-03 1.000000000E-09 4.785563024E-03 8.682908800E+07
+ 8.689745660E+07 4.717197838E-03 1.000000000E-09 4.717197838E-03 8.689747200E+07
+ 8.696582179E+07 4.648832652E-03 1.000000000E-09 4.648832652E-03 8.696582100E+07
+ 8.703418697E+07 4.580467466E-03 1.000000000E-09 4.580467466E-03 8.703418687E+07
+ 8.710255216E+07 4.512102280E-03 1.000000000E-09 4.512102280E-03 8.710255212E+07
+ 8.717091735E+07 4.443737094E-03 1.000000000E-09 4.443737094E-03 8.717091700E+07
+ 8.723928253E+07 4.375371908E-03 1.000000000E-09 4.375371908E-03 8.723928200E+07
+ 8.730764772E+07 4.307006722E-03 1.000000000E-09 4.307006722E-03 8.730764600E+07
+ 8.737601290E+07 4.238641536E-03 1.000000000E-09 4.238641536E-03 8.737601294E+07
+ 8.744437809E+07 4.170276350E-03 1.000000000E-09 4.170276350E-03 8.744437809E+07
+ 8.751274328E+07 4.101911164E-03 1.000000000E-09 4.101911164E-03 8.751276800E+07
+ 8.758110846E+07 4.033545978E-03 1.000000000E-09 4.033545978E-03 8.758110400E+07
+ 8.764947365E+07 3.965180792E-03 1.000000000E-09 3.965180792E-03 8.764948800E+07
+ 8.771783883E+07 3.896815606E-03 1.000000000E-09 3.896815606E-03 8.771783800E+07
+ 8.778620402E+07 3.828450419E-03 1.000000000E-09 3.828450419E-03 8.778624000E+07
+ 8.785456921E+07 3.760085233E-03 1.000000000E-09 3.760085233E-03 8.785456921E+07
+ 8.792293439E+07 3.691720047E-03 1.000000000E-09 3.691720047E-03 8.792298795E+07
+ 8.799129958E+07 3.623354861E-03 1.000000000E-09 3.623354861E-03 8.799129979E+07
+ 8.805966476E+07 3.554989675E-03 1.000000000E-09 3.554989675E-03 8.805966600E+07
+ 8.812802995E+07 3.486624489E-03 1.000000000E-09 3.486624489E-03 8.812802995E+07
+ 8.819639514E+07 3.418259303E-03 1.000000000E-09 3.418259303E-03 8.819639500E+07
+ 8.826476032E+07 3.349894117E-03 1.000000000E-09 3.349894117E-03 8.826476032E+07
+ 8.833312551E+07 3.281528931E-03 1.000000000E-09 3.281528931E-03 8.833305600E+07
+ 8.840149069E+07 3.213163745E-03 1.000000000E-09 3.213163745E-03 8.840149200E+07
+ 8.846985588E+07 3.144798559E-03 1.000000000E-09 3.144798559E-03 8.846985588E+07
+ 8.853822107E+07 3.076433373E-03 1.000000000E-09 3.076433373E-03 8.853822107E+07
+ 8.860658625E+07 3.008068187E-03 1.000000000E-09 3.008068187E-03 8.860660800E+07
+ 8.867495144E+07 2.939703001E-03 1.000000000E-09 2.939703001E-03 8.867501172E+07
+ 8.874331663E+07 2.871337815E-03 1.000000000E-09 2.871337815E-03 8.874331600E+07
+ 8.881168181E+07 2.802972629E-03 1.000000000E-09 2.802972629E-03 8.881168181E+07
+ 8.888004700E+07 2.734607442E-03 1.000000000E-09 2.734607442E-03 8.888004800E+07
+ 8.894841218E+07 2.666242256E-03 1.000000000E-09 2.666242256E-03 8.894841218E+07
+ 8.901677737E+07 2.597877070E-03 1.000000000E-09 2.597877070E-03 8.901683200E+07
+ 8.908514256E+07 2.529511884E-03 1.000000000E-09 2.529511884E-03 8.908513600E+07
+ 8.915350774E+07 2.461146698E-03 1.000000000E-09 2.461146698E-03 8.915350400E+07
+ 8.922187293E+07 2.392781512E-03 1.000000000E-09 2.392781512E-03 8.922187293E+07
+ 8.929023811E+07 2.324416326E-03 1.000000000E-09 2.324416326E-03 8.929023819E+07
+ 8.935860330E+07 2.256051140E-03 1.000000000E-09 2.256051140E-03 8.935859200E+07
+ 8.942696849E+07 2.187685954E-03 1.000000000E-09 2.187685954E-03 8.942696900E+07
+ 8.949533367E+07 2.119320768E-03 1.000000000E-09 2.119320768E-03 8.949533400E+07
+ 8.956369886E+07 2.050955582E-03 1.000000000E-09 2.050955582E-03 8.956369886E+07
+ 8.963206404E+07 1.982590396E-03 1.000000000E-09 1.982590396E-03 8.963200000E+07
+ 8.970042923E+07 1.914225210E-03 1.000000000E-09 1.914225210E-03 8.970041600E+07
+ 8.976879442E+07 1.845860024E-03 1.000000000E-09 1.845860024E-03 8.976879721E+07
+ 8.983715960E+07 1.777494838E-03 1.000000000E-09 1.777494838E-03 8.983715961E+07
+ 8.990552479E+07 1.709129652E-03 1.000000000E-09 1.709129652E-03 8.990553600E+07
+ 8.997388997E+07 1.640764465E-03 1.000000000E-09 1.640764465E-03 8.997388997E+07
+ 9.004225516E+07 1.572399279E-03 1.000000000E-09 1.572399279E-03 9.004225516E+07
+ 9.011062035E+07 1.504034093E-03 1.000000000E-09 1.504034093E-03 9.011062044E+07
+ 9.017898553E+07 1.435668907E-03 1.000000000E-09 1.435668907E-03 9.017907200E+07
+ 9.024735072E+07 1.367303721E-03 1.000000000E-09 1.367303721E-03 9.024735000E+07
+ 9.031571590E+07 1.298938535E-03 1.000000000E-09 1.298938535E-03 9.031571590E+07
+ 9.038408109E+07 1.230573349E-03 1.000000000E-09 1.230573349E-03 9.038415173E+07
+ 9.045244628E+07 1.162208163E-03 1.000000000E-09 1.162208163E-03 9.045251449E+07
+ 9.052081146E+07 1.093842977E-03 1.000000000E-09 1.093842977E-03 9.052082173E+07
+ 9.058917665E+07 1.025477791E-03 1.000000000E-09 1.025477791E-03 9.058918400E+07
+ 9.065754184E+07 9.571126049E-04 1.000000000E-09 9.571126049E-04 9.065754200E+07
+ 9.072590702E+07 8.887474188E-04 1.000000000E-09 8.887474188E-04 9.072590702E+07
+ 9.079427221E+07 8.203822327E-04 1.000000000E-09 8.203822327E-04 9.079427260E+07
+ 9.086263739E+07 7.520170467E-04 1.000000000E-09 7.520170467E-04 9.086263750E+07
+ 9.093100258E+07 6.836518606E-04 1.000000000E-09 6.836518606E-04 9.093100800E+07
+ 9.099936777E+07 6.152866746E-04 1.000000000E-09 6.152866746E-04 9.099941382E+07
+ 9.106773295E+07 5.469214885E-04 1.000000000E-09 5.469214885E-04 9.106773295E+07
+ 9.113609814E+07 4.785563024E-04 1.000000000E-09 4.785563024E-04 9.113609814E+07
+ 9.120446332E+07 4.101911164E-04 1.000000000E-09 4.101911164E-04 9.120446366E+07
+ 9.127282851E+07 3.418259303E-04 1.000000000E-09 3.418259303E-04 9.127282900E+07
+ 9.134119370E+07 2.734607442E-04 1.000000000E-09 2.734607442E-04 9.134119369E+07
+ 9.140955888E+07 2.050955582E-04 1.000000000E-09 2.050955582E-04 9.140948344E+07
+ 9.147792407E+07 1.367303721E-04 1.000000000E-09 1.367303721E-04 9.147792500E+07
+ 9.154628925E+07 6.836518606E-05 1.000000000E-09 6.836518606E-05 9.154636800E+07
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM88
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM88	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM88	(revision 286)
@@ -0,0 +1,501 @@
+DENSITY AND THICKNESS DATA OF THE ATMOSPHERE AT AN ZENITH ANGLE OF 88.0 DEGREES
+ 0.000000000E+00 1.951080220E+04 1.229805824E-03 1.951080220E+04 0.000000000E+00
+ 9.454607940E+04 1.939476143E+04 1.225722340E-03 1.941394463E+04 7.882695671E+04
+ 1.890921588E+05 1.927910492E+04 1.221635194E-03 1.931708705E+04 1.580804497E+05
+ 2.836382382E+05 1.916356553E+04 1.217544511E-03 1.922022948E+04 2.373330830E+05
+ 3.781843176E+05 1.904905602E+04 1.213450420E-03 1.912337190E+04 3.169680468E+05
+ 4.727303970E+05 1.893427102E+04 1.209353048E-03 1.902651433E+04 3.965881654E+05
+ 5.672764764E+05 1.882015963E+04 1.205252520E-03 1.892965675E+04 4.767439999E+05
+ 6.618225558E+05 1.870643403E+04 1.201148964E-03 1.883279918E+04 5.569691433E+05
+ 7.563686352E+05 1.859319470E+04 1.197042506E-03 1.873594160E+04 6.372695907E+05
+ 8.509147146E+05 1.848024394E+04 1.192933271E-03 1.863908403E+04 7.178834941E+05
+ 9.454607940E+05 1.836768197E+04 1.188821385E-03 1.854222645E+04 7.987367770E+05
+ 1.040006873E+06 1.825550677E+04 1.184706973E-03 1.844536888E+04 8.800384819E+05
+ 1.134552953E+06 1.814337697E+04 1.180590160E-03 1.834851131E+04 9.613660445E+05
+ 1.229099032E+06 1.803196493E+04 1.176471070E-03 1.825165373E+04 1.043226986E+06
+ 1.323645112E+06 1.792095496E+04 1.172349827E-03 1.815479616E+04 1.124966345E+06
+ 1.418191191E+06 1.781033265E+04 1.168226555E-03 1.805793858E+04 1.207250143E+06
+ 1.512737270E+06 1.770010480E+04 1.164101378E-03 1.796108101E+04 1.289618421E+06
+ 1.607283350E+06 1.759026051E+04 1.159974419E-03 1.786422343E+04 1.372078633E+06
+ 1.701829429E+06 1.748080658E+04 1.155845799E-03 1.776736586E+04 1.455110503E+06
+ 1.796375509E+06 1.737174092E+04 1.151715643E-03 1.767050828E+04 1.538160443E+06
+ 1.890921588E+06 1.726316265E+04 1.147584071E-03 1.757365071E+04 1.621785649E+06
+ 1.985467667E+06 1.715460255E+04 1.143451205E-03 1.747679313E+04 1.705266842E+06
+ 2.080013747E+06 1.704669417E+04 1.139317167E-03 1.737993556E+04 1.789334113E+06
+ 2.174559826E+06 1.693918697E+04 1.135182078E-03 1.728307798E+04 1.873190151E+06
+ 2.269105906E+06 1.683207525E+04 1.131046057E-03 1.718622041E+04 1.957856979E+06
+ 2.363651985E+06 1.672534803E+04 1.126909224E-03 1.708936283E+04 2.042726370E+06
+ 2.458198064E+06 1.661901201E+04 1.122771700E-03 1.699250526E+04 2.127623112E+06
+ 2.552744144E+06 1.651306503E+04 1.118633604E-03 1.689564768E+04 2.213122589E+06
+ 2.647290223E+06 1.640753169E+04 1.114495054E-03 1.679879011E+04 2.298505161E+06
+ 2.741836303E+06 1.630245870E+04 1.110356168E-03 1.670193253E+04 2.384471252E+06
+ 2.836382382E+06 1.619768356E+04 1.106217066E-03 1.660507496E+04 2.470734728E+06
+ 2.930928461E+06 1.609329754E+04 1.102077863E-03 1.650821738E+04 2.557032597E+06
+ 3.025474541E+06 1.598930739E+04 1.097938678E-03 1.641135981E+04 2.643632518E+06
+ 3.120020620E+06 1.588570183E+04 1.093799627E-03 1.631450223E+04 2.730782485E+06
+ 3.214566700E+06 1.578212313E+04 1.089660826E-03 1.621764466E+04 2.818198081E+06
+ 3.309112779E+06 1.567966243E+04 1.085522390E-03 1.612078708E+04 2.905925709E+06
+ 3.403658858E+06 1.557686387E+04 1.081384436E-03 1.602392951E+04 2.993955312E+06
+ 3.498204938E+06 1.547489205E+04 1.077247077E-03 1.592707193E+04 3.082037630E+06
+ 3.592751017E+06 1.537332836E+04 1.073110429E-03 1.583021436E+04 3.170746287E+06
+ 3.687297097E+06 1.527206338E+04 1.068974605E-03 1.573335678E+04 3.259720577E+06
+ 3.781843176E+06 1.517118937E+04 1.064839719E-03 1.563649921E+04 3.348656859E+06
+ 3.876389255E+06 1.507070404E+04 1.060705883E-03 1.553964163E+04 3.438299899E+06
+ 3.970935335E+06 1.497061391E+04 1.056573210E-03 1.544278406E+04 3.527969393E+06
+ 4.065481414E+06 1.487090781E+04 1.052441812E-03 1.534592648E+04 3.618277722E+06
+ 4.160027494E+06 1.477159223E+04 1.048311800E-03 1.524906891E+04 3.708840128E+06
+ 4.254573573E+06 1.467266485E+04 1.044183286E-03 1.515221134E+04 3.799736133E+06
+ 4.349119652E+06 1.457414990E+04 1.040056379E-03 1.505535376E+04 3.890967224E+06
+ 4.443665732E+06 1.447600062E+04 1.035931190E-03 1.495849619E+04 3.982543294E+06
+ 4.538211811E+06 1.437824128E+04 1.031807828E-03 1.486163861E+04 4.074457545E+06
+ 4.632757891E+06 1.428086948E+04 1.027686402E-03 1.476478104E+04 4.166720000E+06
+ 4.727303970E+06 1.418390405E+04 1.023567021E-03 1.466792346E+04 4.259333594E+06
+ 4.821850049E+06 1.408758242E+04 1.019449792E-03 1.457106589E+04 4.352051137E+06
+ 4.916396129E+06 1.399137605E+04 1.015334823E-03 1.447420831E+04 4.445376054E+06
+ 5.010942208E+06 1.389555506E+04 1.011222221E-03 1.437735074E+04 4.539064953E+06
+ 5.105488288E+06 1.379993426E+04 1.007112091E-03 1.428049316E+04 4.633119826E+06
+ 5.200034367E+06 1.370488989E+04 1.003004541E-03 1.418363559E+04 4.727563202E+06
+ 5.294580447E+06 1.361051967E+04 9.988996738E-04 1.408677801E+04 4.822629654E+06
+ 5.389126526E+06 1.351624737E+04 9.947975955E-04 1.398992044E+04 4.917811276E+06
+ 5.483672605E+06 1.342236859E+04 9.906984098E-04 1.389306286E+04 5.013377140E+06
+ 5.578218685E+06 1.332887047E+04 9.866022205E-04 1.379620529E+04 5.109427611E+06
+ 5.672764764E+06 1.323575949E+04 9.825091304E-04 1.369934771E+04 5.205773918E+06
+ 5.767310844E+06 1.314303313E+04 9.784192421E-04 1.360249014E+04 5.302520398E+06
+ 5.861856923E+06 1.305071572E+04 9.743326575E-04 1.350563256E+04 5.399668323E+06
+ 5.956403002E+06 1.295875984E+04 9.702494778E-04 1.340877499E+04 5.497229194E+06
+ 6.050949082E+06 1.286718987E+04 9.661698038E-04 1.331191741E+04 5.595209341E+06
+ 6.145495161E+06 1.277600326E+04 9.620937358E-04 1.321505984E+04 5.693595688E+06
+ 6.240041241E+06 1.268520631E+04 9.580213733E-04 1.311820226E+04 5.792793345E+06
+ 6.334587320E+06 1.259480002E+04 9.539528154E-04 1.302134469E+04 5.891933055E+06
+ 6.429133399E+06 1.250476586E+04 9.498881604E-04 1.292448711E+04 5.991892552E+06
+ 6.523679479E+06 1.241511368E+04 9.458275063E-04 1.282762954E+04 6.091995727E+06
+ 6.618225558E+06 1.232594709E+04 9.417709504E-04 1.273077196E+04 6.192549902E+06
+ 6.712771638E+06 1.223733077E+04 9.377185892E-04 1.263391439E+04 6.293937945E+06
+ 6.807317717E+06 1.214882511E+04 9.336705190E-04 1.253705681E+04 6.395293370E+06
+ 6.901863796E+06 1.206069980E+04 9.296268352E-04 1.244019924E+04 6.497503708E+06
+ 6.996409876E+06 1.197296114E+04 9.255876326E-04 1.234334166E+04 6.600089087E+06
+ 7.090955955E+06 1.188559755E+04 9.215530056E-04 1.224648409E+04 6.702840646E+06
+ 7.185502035E+06 1.179861530E+04 9.175230478E-04 1.214962652E+04 6.806470790E+06
+ 7.280048114E+06 1.171202415E+04 9.134978523E-04 1.205276894E+04 6.910283799E+06
+ 7.374594193E+06 1.162582305E+04 9.094775116E-04 1.195591137E+04 7.014608552E+06
+ 7.469140273E+06 1.153997768E+04 9.054621175E-04 1.185905379E+04 7.119699073E+06
+ 7.563686352E+06 1.145487468E+04 9.014517612E-04 1.176219622E+04 7.225308306E+06
+ 7.658232432E+06 1.136969614E+04 8.974465334E-04 1.166533864E+04 7.331558638E+06
+ 7.752778511E+06 1.128498321E+04 8.934465240E-04 1.156848107E+04 7.437788998E+06
+ 7.847324590E+06 1.120066078E+04 8.894518224E-04 1.147162349E+04 7.544956061E+06
+ 7.941870670E+06 1.111697240E+04 8.854625174E-04 1.137476592E+04 7.652359790E+06
+ 8.036416749E+06 1.103348537E+04 8.814786970E-04 1.127790834E+04 7.760902898E+06
+ 8.130962829E+06 1.095027404E+04 8.775004488E-04 1.118105077E+04 7.869376520E+06
+ 8.225508908E+06 1.086744008E+04 8.735278596E-04 1.108419319E+04 7.978717894E+06
+ 8.320054987E+06 1.078497943E+04 8.695610156E-04 1.098733562E+04 8.088729852E+06
+ 8.414601067E+06 1.070289819E+04 8.656000024E-04 1.089047804E+04 8.198901613E+06
+ 8.509147146E+06 1.062119718E+04 8.616449050E-04 1.079362047E+04 8.310263247E+06
+ 8.603693226E+06 1.054022206E+04 8.576958076E-04 1.069676289E+04 8.421603157E+06
+ 8.698239305E+06 1.045925143E+04 8.537527939E-04 1.059990532E+04 8.534149668E+06
+ 8.792785384E+06 1.037858274E+04 8.498159470E-04 1.050304774E+04 8.646680869E+06
+ 8.887331464E+06 1.029835522E+04 8.458853492E-04 1.040619017E+04 8.760474606E+06
+ 8.981877543E+06 1.021878319E+04 8.419610822E-04 1.030933259E+04 8.874659935E+06
+ 9.076423623E+06 1.013929423E+04 8.380432272E-04 1.021247502E+04 8.989258395E+06
+ 9.170969702E+06 1.006018017E+04 8.341318646E-04 1.011561744E+04 9.104612116E+06
+ 9.265515781E+06 9.981429241E+03 8.302270740E-04 1.001875987E+04 9.220608749E+06
+ 9.360061861E+06 9.903059964E+03 8.263289348E-04 9.921902294E+03 9.337606387E+06
+ 9.454607940E+06 9.825044719E+03 8.224375253E-04 9.825044719E+03 9.454607940E+06
+ 9.558372614E+06 9.739385033E+03 8.219073602E-04 9.761891375E+03 9.531266123E+06
+ 9.662137287E+06 9.654976198E+03 8.170701679E-04 9.698738032E+03 9.608290689E+06
+ 9.765901961E+06 9.569590532E+03 8.122458588E-04 9.635584689E+03 9.685634671E+06
+ 9.869666634E+06 9.486143693E+03 8.074345419E-04 9.572431345E+03 9.762438154E+06
+ 9.973431308E+06 9.402480047E+03 8.026363246E-04 9.509278002E+03 9.841343460E+06
+ 1.007719598E+07 9.320913013E+03 7.978513130E-04 9.446124658E+03 9.918807117E+06
+ 1.018096065E+07 9.237398661E+03 7.930796120E-04 9.382971315E+03 9.997520499E+06
+ 1.028472533E+07 9.154482219E+03 7.883213247E-04 9.319817972E+03 1.007855087E+07
+ 1.038849000E+07 9.073581123E+03 7.835765531E-04 9.256664628E+03 1.015600877E+07
+ 1.049225468E+07 8.992380128E+03 7.788453977E-04 9.193511285E+03 1.023577951E+07
+ 1.059601935E+07 8.911668941E+03 7.741279578E-04 9.130357942E+03 1.031601417E+07
+ 1.069978402E+07 8.831465618E+03 7.694243309E-04 9.067204598E+03 1.039653972E+07
+ 1.080354870E+07 8.751735422E+03 7.647346135E-04 9.004051255E+03 1.047652745E+07
+ 1.090731337E+07 8.673220206E+03 7.600589005E-04 8.940897911E+03 1.055872228E+07
+ 1.101107804E+07 8.593737493E+03 7.553972855E-04 8.877744568E+03 1.063945072E+07
+ 1.111484272E+07 8.516176273E+03 7.507498607E-04 8.814591225E+03 1.072244530E+07
+ 1.121860739E+07 8.438385895E+03 7.461167169E-04 8.751437881E+03 1.080393367E+07
+ 1.132237206E+07 8.361064450E+03 7.414979435E-04 8.688284538E+03 1.088676886E+07
+ 1.142613674E+07 8.284958731E+03 7.368936286E-04 8.625131195E+03 1.097000611E+07
+ 1.152990141E+07 8.207865108E+03 7.323038587E-04 8.561977851E+03 1.105367082E+07
+ 1.163366608E+07 8.132680202E+03 7.277287193E-04 8.498824508E+03 1.113772886E+07
+ 1.173743076E+07 8.057513648E+03 7.231682940E-04 8.435671164E+03 1.122220569E+07
+ 1.184119543E+07 7.982557325E+03 7.186226656E-04 8.372517821E+03 1.130710456E+07
+ 1.194496011E+07 7.908088589E+03 7.140919151E-04 8.309364478E+03 1.139243649E+07
+ 1.204872478E+07 7.834078414E+03 7.095761223E-04 8.246211134E+03 1.147819728E+07
+ 1.215248945E+07 7.761268893E+03 7.050753657E-04 8.183057791E+03 1.156439816E+07
+ 1.225625413E+07 7.688181479E+03 7.005897222E-04 8.119904448E+03 1.165104280E+07
+ 1.236001880E+07 7.615559020E+03 6.961192676E-04 8.056751104E+03 1.173847253E+07
+ 1.246378347E+07 7.543430895E+03 6.916640762E-04 7.993597761E+03 1.182602522E+07
+ 1.256754815E+07 7.471739026E+03 6.872242209E-04 7.930444417E+03 1.191404102E+07
+ 1.267131282E+07 7.401235430E+03 6.827997735E-04 7.867291074E+03 1.200252398E+07
+ 1.277507749E+07 7.330453407E+03 6.783908041E-04 7.804137731E+03 1.209148656E+07
+ 1.287884217E+07 7.260125551E+03 6.739973817E-04 7.740984387E+03 1.218092297E+07
+ 1.298260684E+07 7.190269946E+03 6.696195738E-04 7.677831044E+03 1.227084962E+07
+ 1.308637151E+07 7.120857429E+03 6.652574467E-04 7.614677701E+03 1.236126931E+07
+ 1.319013619E+07 7.052683523E+03 6.609110654E-04 7.551524357E+03 1.245221171E+07
+ 1.329390086E+07 6.984160112E+03 6.565804933E-04 7.488371014E+03 1.254365801E+07
+ 1.339766553E+07 6.916086000E+03 6.522657927E-04 7.425217670E+03 1.263560276E+07
+ 1.350143021E+07 6.848479044E+03 6.479670246E-04 7.362064327E+03 1.272806892E+07
+ 1.360519488E+07 6.781304294E+03 6.436842486E-04 7.298910984E+03 1.282107016E+07
+ 1.370895956E+07 6.715293461E+03 6.394175229E-04 7.235757640E+03 1.291460393E+07
+ 1.381272423E+07 6.649006115E+03 6.351669045E-04 7.172604297E+03 1.300976083E+07
+ 1.391648890E+07 6.583159963E+03 6.309324490E-04 7.109450954E+03 1.310331727E+07
+ 1.402025358E+07 6.517743930E+03 6.267142110E-04 7.046297610E+03 1.319967026E+07
+ 1.412401825E+07 6.452730171E+03 6.225122433E-04 6.983144267E+03 1.329542734E+07
+ 1.422778292E+07 6.388938628E+03 6.183265978E-04 6.919990923E+03 1.339175940E+07
+ 1.433154760E+07 6.324817673E+03 6.141573250E-04 6.856837580E+03 1.348870483E+07
+ 1.443531227E+07 6.261144973E+03 6.100044740E-04 6.793684237E+03 1.358622227E+07
+ 1.453907694E+07 6.197939501E+03 6.058680929E-04 6.730530893E+03 1.368548551E+07
+ 1.464284162E+07 6.135357947E+03 6.017482281E-04 6.667377550E+03 1.378308469E+07
+ 1.474660629E+07 6.072923491E+03 5.976449252E-04 6.604224207E+03 1.388358331E+07
+ 1.485037096E+07 6.011696555E+03 5.935582283E-04 6.541070863E+03 1.398356483E+07
+ 1.495413564E+07 5.950149702E+03 5.894881801E-04 6.477917520E+03 1.408421141E+07
+ 1.505790031E+07 5.889013368E+03 5.854348223E-04 6.414764176E+03 1.418549954E+07
+ 1.516166498E+07 5.829026795E+03 5.813981953E-04 6.351610833E+03 1.428744834E+07
+ 1.526542966E+07 5.768731362E+03 5.773783381E-04 6.288457490E+03 1.439122206E+07
+ 1.536919433E+07 5.708838664E+03 5.733752887E-04 6.225304146E+03 1.449339169E+07
+ 1.547295901E+07 5.649378971E+03 5.693890837E-04 6.162150803E+03 1.459900161E+07
+ 1.557672368E+07 5.590322934E+03 5.654197585E-04 6.098997460E+03 1.470371548E+07
+ 1.568048835E+07 5.532391924E+03 5.614673473E-04 6.035844116E+03 1.480913692E+07
+ 1.578425303E+07 5.474143037E+03 5.575318831E-04 5.972690773E+03 1.491529456E+07
+ 1.588801770E+07 5.416318943E+03 5.536133977E-04 5.909537429E+03 1.502338023E+07
+ 1.599178237E+07 5.359682799E+03 5.497119217E-04 5.846384086E+03 1.513104446E+07
+ 1.609554705E+07 5.302642468E+03 5.458274844E-04 5.783230743E+03 1.523946405E+07
+ 1.619931172E+07 5.246006585E+03 5.419601141E-04 5.720077399E+03 1.534991144E+07
+ 1.630307639E+07 5.189792908E+03 5.381098378E-04 5.656924056E+03 1.545991388E+07
+ 1.640684107E+07 5.133966374E+03 5.342766813E-04 5.593770713E+03 1.557071713E+07
+ 1.651060574E+07 5.079248006E+03 5.304606692E-04 5.530617369E+03 1.568359850E+07
+ 1.661437041E+07 5.024214874E+03 5.266618252E-04 5.467464026E+03 1.579607170E+07
+ 1.671813509E+07 4.969577948E+03 5.228801715E-04 5.404310682E+03 1.590932698E+07
+ 1.682189976E+07 4.916048458E+03 5.191157293E-04 5.341157339E+03 1.602495542E+07
+ 1.692566444E+07 4.862170259E+03 5.153685187E-04 5.278003996E+03 1.614004055E+07
+ 1.702942911E+07 4.808694826E+03 5.116385586E-04 5.214850652E+03 1.625602352E+07
+ 1.713319378E+07 4.756336219E+03 5.079258668E-04 5.151697309E+03 1.637422332E+07
+ 1.723695846E+07 4.702891662E+03 5.042304600E-04 5.088543966E+03 1.649339550E+07
+ 1.734072313E+07 4.651523401E+03 5.005523537E-04 5.025390622E+03 1.661217581E+07
+ 1.744448780E+07 4.599558861E+03 4.968915624E-04 4.962237279E+03 1.673195114E+07
+ 1.754825248E+07 4.547991540E+03 4.932480994E-04 4.899083935E+03 1.685403651E+07
+ 1.765201715E+07 4.497530063E+03 4.896219769E-04 4.835930592E+03 1.697721977E+07
+ 1.775578182E+07 4.446691142E+03 4.860132061E-04 4.772777249E+03 1.709997109E+07
+ 1.785954650E+07 4.396229124E+03 4.824217970E-04 4.709623905E+03 1.722383516E+07
+ 1.796331117E+07 4.346173015E+03 4.788477588E-04 4.646470562E+03 1.735063375E+07
+ 1.806707584E+07 4.296464840E+03 4.752910992E-04 4.583317219E+03 1.747664966E+07
+ 1.817084052E+07 4.247827561E+03 4.717518252E-04 4.520163875E+03 1.760520766E+07
+ 1.827460519E+07 4.198857679E+03 4.682299427E-04 4.457010532E+03 1.773349945E+07
+ 1.837836986E+07 4.150242179E+03 4.647254563E-04 4.393857188E+03 1.786439798E+07
+ 1.848213454E+07 4.102703010E+03 4.612383699E-04 4.330703845E+03 1.799653802E+07
+ 1.858589921E+07 4.054859682E+03 4.577686861E-04 4.267550502E+03 1.812992834E+07
+ 1.868966389E+07 4.007331301E+03 4.543164067E-04 4.204397158E+03 1.826297965E+07
+ 1.879342856E+07 3.960876202E+03 4.508815323E-04 4.141243815E+03 1.839889593E+07
+ 1.889719323E+07 3.914038399E+03 4.474640626E-04 4.078090472E+03 1.853457802E+07
+ 1.900095791E+07 3.867570581E+03 4.440639962E-04 4.014937128E+03 1.867326089E+07
+ 1.910472258E+07 3.822177854E+03 4.406813310E-04 3.951783785E+03 1.881318552E+07
+ 1.920848725E+07 3.776403118E+03 4.373160634E-04 3.888630441E+03 1.895457069E+07
+ 1.931225193E+07 3.730978176E+03 4.339681894E-04 3.825477098E+03 1.909740212E+07
+ 1.941601660E+07 3.686631517E+03 4.306377036E-04 3.762323755E+03 1.924006875E+07
+ 1.951978127E+07 3.641878367E+03 4.273245998E-04 3.699170411E+03 1.938586528E+07
+ 1.962354595E+07 3.597482075E+03 4.240288710E-04 3.636017068E+03 1.953320043E+07
+ 1.972731062E+07 3.554163437E+03 4.207505089E-04 3.572863725E+03 1.968215787E+07
+ 1.983107529E+07 3.509710381E+03 4.174895046E-04 3.509710381E+03 1.983107530E+07
+ 2.015920146E+07 3.372237885E+03 4.118397231E-04 3.474855133E+03 1.991322870E+07
+ 2.048732763E+07 3.239398378E+03 3.979124732E-04 3.439999885E+03 1.999606355E+07
+ 2.081545380E+07 3.111066077E+03 3.843546920E-04 3.405144638E+03 2.007964399E+07
+ 2.114357997E+07 2.987133114E+03 3.711608385E-04 3.370289390E+03 2.016393303E+07
+ 2.147170614E+07 2.867459825E+03 3.583252770E-04 3.335434142E+03 2.024899680E+07
+ 2.179983231E+07 2.751940520E+03 3.458422863E-04 3.300578894E+03 2.033479805E+07
+ 2.212795848E+07 2.640459646E+03 3.337060682E-04 3.265723646E+03 2.042140955E+07
+ 2.245608465E+07 2.532904860E+03 3.219107568E-04 3.230868398E+03 2.050878491E+07
+ 2.278421081E+07 2.429165103E+03 3.104504266E-04 3.196013151E+03 2.059699871E+07
+ 2.311233698E+07 2.329138905E+03 2.993191010E-04 3.161157903E+03 2.068601351E+07
+ 2.344046315E+07 2.232704629E+03 2.885107602E-04 3.126302655E+03 2.077590203E+07
+ 2.376858932E+07 2.139764644E+03 2.780193492E-04 3.091447407E+03 2.086665424E+07
+ 2.409671549E+07 2.050215785E+03 2.678387853E-04 3.056592159E+03 2.095826144E+07
+ 2.442484166E+07 1.963957564E+03 2.579629656E-04 3.021736911E+03 2.105079873E+07
+ 2.475296783E+07 1.880890127E+03 2.483857737E-04 2.986881663E+03 2.114425735E+07
+ 2.508109400E+07 1.800916998E+03 2.391010871E-04 2.952026416E+03 2.123863040E+07
+ 2.540922017E+07 1.723955849E+03 2.301027834E-04 2.917171168E+03 2.133396582E+07
+ 2.573734633E+07 1.649888396E+03 2.213847469E-04 2.882315920E+03 2.143031714E+07
+ 2.606547250E+07 1.578636335E+03 2.129408746E-04 2.847460672E+03 2.152767682E+07
+ 2.639359867E+07 1.510121193E+03 2.047650823E-04 2.812605424E+03 2.162603832E+07
+ 2.672172484E+07 1.444235409E+03 1.968513097E-04 2.777750176E+03 2.172548859E+07
+ 2.704985101E+07 1.380903595E+03 1.891935265E-04 2.742894928E+03 2.182601960E+07
+ 2.737797718E+07 1.320043221E+03 1.817857369E-04 2.708039681E+03 2.192762793E+07
+ 2.770610335E+07 1.261573057E+03 1.746219847E-04 2.673184433E+03 2.203040372E+07
+ 2.803422952E+07 1.205417222E+03 1.676963582E-04 2.638329185E+03 2.213434364E+07
+ 2.836235569E+07 1.151500200E+03 1.610029941E-04 2.603473937E+03 2.223944498E+07
+ 2.869048186E+07 1.099734245E+03 1.545360822E-04 2.568618689E+03 2.234580376E+07
+ 2.901860802E+07 1.050064862E+03 1.482898689E-04 2.533763441E+03 2.245341847E+07
+ 2.934673419E+07 1.002398916E+03 1.422586610E-04 2.498908194E+03 2.256228886E+07
+ 2.967486036E+07 9.566876123E+02 1.364368293E-04 2.464052946E+03 2.267251742E+07
+ 3.000298653E+07 9.128423814E+02 1.308188119E-04 2.429197698E+03 2.278410585E+07
+ 3.033111270E+07 8.708075445E+02 1.253991168E-04 2.394342450E+03 2.289705605E+07
+ 3.065923887E+07 8.305208987E+02 1.201723252E-04 2.359487202E+03 2.301150385E+07
+ 3.098736504E+07 7.919275505E+02 1.151330938E-04 2.324631954E+03 2.312740357E+07
+ 3.131549121E+07 7.549571176E+02 1.102761572E-04 2.289776706E+03 2.324478733E+07
+ 3.164361738E+07 7.195410299E+02 1.055963304E-04 2.254921459E+03 2.336377152E+07
+ 3.197174354E+07 6.856314489E+02 1.010885102E-04 2.220066211E+03 2.348436646E+07
+ 3.229986971E+07 6.531842035E+02 9.674767780E-05 2.185210963E+03 2.360662123E+07
+ 3.262799588E+07 6.221183993E+02 9.256889951E-05 2.150355715E+03 2.373058604E+07
+ 3.295612205E+07 5.924156868E+02 8.854732888E-05 2.115500467E+03 2.385627600E+07
+ 3.328424822E+07 5.637444909E+02 8.467820767E-05 2.080645219E+03 2.398382426E+07
+ 3.361237439E+07 5.368292241E+02 8.095686695E-05 2.045789971E+03 2.411325078E+07
+ 3.394050056E+07 5.108507517E+02 7.737872808E-05 2.010934724E+03 2.424461896E+07
+ 3.426862673E+07 4.859968572E+02 7.393930345E-05 1.976079476E+03 2.437799021E+07
+ 3.459675290E+07 4.623231554E+02 7.063419708E-05 1.941224228E+03 2.451343442E+07
+ 3.492487906E+07 4.396665080E+02 6.745910512E-05 1.906368980E+03 2.465102317E+07
+ 3.525300523E+07 4.180287798E+02 6.440981615E-05 1.871513732E+03 2.479078825E+07
+ 3.558113140E+07 3.973824660E+02 6.148221140E-05 1.836658484E+03 2.493294149E+07
+ 3.590925757E+07 3.776773753E+02 5.867226479E-05 1.801803237E+03 2.507738944E+07
+ 3.623738374E+07 3.588643031E+02 5.597604289E-05 1.766947989E+03 2.522440092E+07
+ 3.656550991E+07 3.409285049E+02 5.338970474E-05 1.732092741E+03 2.537388767E+07
+ 3.689363608E+07 3.238010134E+02 5.090950155E-05 1.697237493E+03 2.552614288E+07
+ 3.722176225E+07 3.075102691E+02 4.853177633E-05 1.662382245E+03 2.568106831E+07
+ 3.754988842E+07 2.919550742E+02 4.625296338E-05 1.627526997E+03 2.583897557E+07
+ 3.787801458E+07 2.771425988E+02 4.406958770E-05 1.592671749E+03 2.599983960E+07
+ 3.820614075E+07 2.630338603E+02 4.197826432E-05 1.557816502E+03 2.616383494E+07
+ 3.853426692E+07 2.495905175E+02 3.997569752E-05 1.522961254E+03 2.633109769E+07
+ 3.886239309E+07 2.367825988E+02 3.805868003E-05 1.488106006E+03 2.650177233E+07
+ 3.919051926E+07 2.246006471E+02 3.622409205E-05 1.453250758E+03 2.667606947E+07
+ 3.951864543E+07 2.130076531E+02 3.446890032E-05 1.418395510E+03 2.685398972E+07
+ 3.984677160E+07 2.019667171E+02 3.279015704E-05 1.383540262E+03 2.703593189E+07
+ 4.017489777E+07 1.914751927E+02 3.118499878E-05 1.348685014E+03 2.722191994E+07
+ 4.050302394E+07 1.815001457E+02 2.965064528E-05 1.313829767E+03 2.741221414E+07
+ 4.083115011E+07 1.720044781E+02 2.818439830E-05 1.278974519E+03 2.760709930E+07
+ 4.115927627E+07 1.630006612E+02 2.678364027E-05 1.244119271E+03 2.780671088E+07
+ 4.148740244E+07 1.544248802E+02 2.544583309E-05 1.209264023E+03 2.801133371E+07
+ 4.181552861E+07 1.462882108E+02 2.416851670E-05 1.174408775E+03 2.822131405E+07
+ 4.214365478E+07 1.385607679E+02 2.294930775E-05 1.139553527E+03 2.843693401E+07
+ 4.247178095E+07 1.312207656E+02 2.178589819E-05 1.104698280E+03 2.865844059E+07
+ 4.279990712E+07 1.242568175E+02 2.067605386E-05 1.069843032E+03 2.888633783E+07
+ 4.312803329E+07 1.176482542E+02 1.961761297E-05 1.034987784E+03 2.912095808E+07
+ 4.345615946E+07 1.113791042E+02 1.860848473E-05 1.000132536E+03 2.936274729E+07
+ 4.378428563E+07 1.054327176E+02 1.764664775E-05 9.652772881E+02 2.961211287E+07
+ 4.411241179E+07 9.979596557E+01 1.673014864E-05 9.304220403E+02 2.986974888E+07
+ 4.444053796E+07 9.445078699E+01 1.585710043E-05 8.955667924E+02 3.013618117E+07
+ 4.476866413E+07 8.938511767E+01 1.502568107E-05 8.607115446E+02 3.041209623E+07
+ 4.509679030E+07 8.458579378E+01 1.423413193E-05 8.258562967E+02 3.069821869E+07
+ 4.542491647E+07 8.003938997E+01 1.348075626E-05 7.910010489E+02 3.099541094E+07
+ 4.575304264E+07 7.573385264E+01 1.276391766E-05 7.561458010E+02 3.130472706E+07
+ 4.608116881E+07 7.164964316E+01 1.208203855E-05 7.212905532E+02 3.162707977E+07
+ 4.640929498E+07 6.779903408E+01 1.143359869E-05 6.864353053E+02 3.196380220E+07
+ 4.673742115E+07 6.414809063E+01 1.081713366E-05 6.515800575E+02 3.231645526E+07
+ 4.706554731E+07 6.069451802E+01 1.023123333E-05 6.167248096E+02 3.268657912E+07
+ 4.739367348E+07 5.742768300E+01 9.674540411E-06 5.818695618E+02 3.307620830E+07
+ 4.772179965E+07 5.434953659E+01 9.145748968E-06 5.470143139E+02 3.348763387E+07
+ 4.804992582E+07 5.142049480E+01 8.643602951E-06 5.121590661E+02 3.392363098E+07
+ 4.837805199E+07 4.867174965E+01 8.166894762E-06 4.773038182E+02 3.438768980E+07
+ 4.870617816E+07 4.606468497E+01 7.714463819E-06 4.424485704E+02 3.488380734E+07
+ 4.903430433E+07 4.360152529E+01 7.285195153E-06 4.075933225E+02 3.541703179E+07
+ 4.936243050E+07 4.128614737E+01 6.878018015E-06 3.727380747E+02 3.599382855E+07
+ 4.969055667E+07 3.908676547E+01 6.491904508E-06 3.378828268E+02 3.662289837E+07
+ 5.001868283E+07 3.702436889E+01 6.125868240E-06 3.030275790E+02 3.731458827E+07
+ 5.034680900E+07 3.506851260E+01 5.778963001E-06 2.681723311E+02 3.808450982E+07
+ 5.067493517E+07 3.322269210E+01 5.450281458E-06 2.333170833E+02 3.895414895E+07
+ 5.100306134E+07 3.149235071E+01 5.138953878E-06 1.984618354E+02 3.995457420E+07
+ 5.133118751E+07 2.985234033E+01 4.844146880E-06 1.636065876E+02 4.113637773E+07
+ 5.165931368E+07 2.830439233E+01 4.565062199E-06 1.287513397E+02 4.258615873E+07
+ 5.198743985E+07 2.685635680E+01 4.300935491E-06 9.389609186E+01 4.447540514E+07
+ 5.231556602E+07 2.548139089E+01 4.051035150E-06 5.904084401E+01 4.722989361E+07
+ 5.264369219E+07 2.418559616E+01 3.814661162E-06 2.418559616E+01 5.264369219E+07
+ 5.304968425E+07 2.263565252E+01 3.701222298E-06 2.394381004E+01 5.270540264E+07
+ 5.345567631E+07 2.117852388E+01 3.479033440E-06 2.370202392E+01 5.276769145E+07
+ 5.386166837E+07 1.980907596E+01 3.269109343E-06 2.346023780E+01 5.283058291E+07
+ 5.426766043E+07 1.852245163E+01 3.070843845E-06 2.321845168E+01 5.289407747E+07
+ 5.467365249E+07 1.731408195E+01 2.883656283E-06 2.297666556E+01 5.295818740E+07
+ 5.507964456E+07 1.617959074E+01 2.706990683E-06 2.273487944E+01 5.302292541E+07
+ 5.548563662E+07 1.511470096E+01 2.540314974E-06 2.249309332E+01 5.308831377E+07
+ 5.589162868E+07 1.411559052E+01 2.383120198E-06 2.225130720E+01 5.315435051E+07
+ 5.629762074E+07 1.317844003E+01 2.234919743E-06 2.200952108E+01 5.322106514E+07
+ 5.670361280E+07 1.229971029E+01 2.095248579E-06 2.176773496E+01 5.328846515E+07
+ 5.710960487E+07 1.147603829E+01 1.963662510E-06 2.152594884E+01 5.335656543E+07
+ 5.751559693E+07 1.070419758E+01 1.839737442E-06 2.128416271E+01 5.342538130E+07
+ 5.792158899E+07 9.981224696E+00 1.723068661E-06 2.104237659E+01 5.349492863E+07
+ 5.832758105E+07 9.304180369E+00 1.613270127E-06 2.080059047E+01 5.356521283E+07
+ 5.873357311E+07 8.670369126E+00 1.509973780E-06 2.055880435E+01 5.363627559E+07
+ 5.913956517E+07 8.077263507E+00 1.412828866E-06 2.031701823E+01 5.370811520E+07
+ 5.954555724E+07 7.522404879E+00 1.321501275E-06 2.007523211E+01 5.378075546E+07
+ 5.995154930E+07 7.003488288E+00 1.235672898E-06 1.983344599E+01 5.385421777E+07
+ 6.035754136E+07 6.518339068E+00 1.155040996E-06 1.959165987E+01 5.392851049E+07
+ 6.076353342E+07 6.064948619E+00 1.079317585E-06 1.934987375E+01 5.400367077E+07
+ 6.116952548E+07 5.641339522E+00 1.008228847E-06 1.910808763E+01 5.407971113E+07
+ 6.157551754E+07 5.245668283E+00 9.415145406E-07 1.886630151E+01 5.415665330E+07
+ 6.198150961E+07 4.876282107E+00 8.789274450E-07 1.862451539E+01 5.423451623E+07
+ 6.238750167E+07 4.531490931E+00 8.202328088E-07 1.838272927E+01 5.431332544E+07
+ 6.279349373E+07 4.209750071E+00 7.652078207E-07 1.814094315E+01 5.439311203E+07
+ 6.319948579E+07 3.909691312E+00 7.136410952E-07 1.789915703E+01 5.447389302E+07
+ 6.360547785E+07 3.629850186E+00 6.653321739E-07 1.765737091E+01 5.455568857E+07
+ 6.401146992E+07 3.369046155E+00 6.200910443E-07 1.741558479E+01 5.463854775E+07
+ 6.441746198E+07 3.125959690E+00 5.777376732E-07 1.717379867E+01 5.472248672E+07
+ 6.482345404E+07 2.899535876E+00 5.381015565E-07 1.693201255E+01 5.480753521E+07
+ 6.522944610E+07 2.688679373E+00 5.010212848E-07 1.669022643E+01 5.489372421E+07
+ 6.563543816E+07 2.492404682E+00 4.663441234E-07 1.644844031E+01 5.498108602E+07
+ 6.604143022E+07 2.309709297E+00 4.339256086E-07 1.620665419E+01 5.506965437E+07
+ 6.644742229E+07 2.139780624E+00 4.036291577E-07 1.596486807E+01 5.515945227E+07
+ 6.685341435E+07 1.981694737E+00 3.753256941E-07 1.572308195E+01 5.525053737E+07
+ 6.725940641E+07 1.834763072E+00 3.488932865E-07 1.548129582E+01 5.534293961E+07
+ 6.766539847E+07 1.698165044E+00 3.242168020E-07 1.523950970E+01 5.543669181E+07
+ 6.807139053E+07 1.571286017E+00 3.011875729E-07 1.499772358E+01 5.553185413E+07
+ 6.847738259E+07 1.453420115E+00 2.797030765E-07 1.475593746E+01 5.562846007E+07
+ 6.888337466E+07 1.343958131E+00 2.596666286E-07 1.451415134E+01 5.572654097E+07
+ 6.928936672E+07 1.242377464E+00 2.409870882E-07 1.427236522E+01 5.582617927E+07
+ 6.969535878E+07 1.148128685E+00 2.235785763E-07 1.403057910E+01 5.592739940E+07
+ 7.010135084E+07 1.060677869E+00 2.073602050E-07 1.378879298E+01 5.603025896E+07
+ 7.050734290E+07 9.796110310E-01 1.922558194E-07 1.354700686E+01 5.613481811E+07
+ 7.091333496E+07 9.044301143E-01 1.781937499E-07 1.330522074E+01 5.624114444E+07
+ 7.131932703E+07 8.347650328E-01 1.651065757E-07 1.306343462E+01 5.634929270E+07
+ 7.172531909E+07 7.702257432E-01 1.529308995E-07 1.282164850E+01 5.645931171E+07
+ 7.213131115E+07 7.104821119E-01 1.416071308E-07 1.257986238E+01 5.657131026E+07
+ 7.253730321E+07 6.551329489E-01 1.310792812E-07 1.233807626E+01 5.668532760E+07
+ 7.294329527E+07 6.039585604E-01 1.212947672E-07 1.209629014E+01 5.680145005E+07
+ 7.334928734E+07 5.565772280E-01 1.122042237E-07 1.185450402E+01 5.691977848E+07
+ 7.375527940E+07 5.127559285E-01 1.037613253E-07 1.161271790E+01 5.704038741E+07
+ 7.416127146E+07 4.722331650E-01 9.592261731E-08 1.137093178E+01 5.716335138E+07
+ 7.456726352E+07 4.347843848E-01 8.864735354E-08 1.112914566E+01 5.728881176E+07
+ 7.497325558E+07 4.001813766E-01 8.189734332E-08 1.088735954E+01 5.741683484E+07
+ 7.537924764E+07 3.682206706E-01 7.563680538E-08 1.064557342E+01 5.754754636E+07
+ 7.578523971E+07 3.386865056E-01 6.983222924E-08 1.040378730E+01 5.768108265E+07
+ 7.619123177E+07 3.114650446E-01 6.445224362E-08 1.016200118E+01 5.781754714E+07
+ 7.659722383E+07 2.863193499E-01 5.946749156E-08 9.920215055E+00 5.795710059E+07
+ 7.700321589E+07 2.631225175E-01 5.485051198E-08 9.678428935E+00 5.809987913E+07
+ 7.740920795E+07 2.417137856E-01 5.057562741E-08 9.436642815E+00 5.824601598E+07
+ 7.781520001E+07 2.219982482E-01 4.661883761E-08 9.194856694E+00 5.839570993E+07
+ 7.822119208E+07 2.038361014E-01 4.295771889E-08 8.953070574E+00 5.854916521E+07
+ 7.862718414E+07 1.871040900E-01 3.957132873E-08 8.711284453E+00 5.870653417E+07
+ 7.903317620E+07 1.716768456E-01 3.644011569E-08 8.469498333E+00 5.886808054E+07
+ 7.943916826E+07 1.574768754E-01 3.354583406E-08 8.227712212E+00 5.903398907E+07
+ 7.984516032E+07 1.444089112E-01 3.087146341E-08 7.985926092E+00 5.920456470E+07
+ 8.025115239E+07 1.323578674E-01 2.840113243E-08 7.744139972E+00 5.938003218E+07
+ 8.065714445E+07 1.213127611E-01 2.612004711E-08 7.502353851E+00 5.956075049E+07
+ 8.106313651E+07 1.111530303E-01 2.401442300E-08 7.260567731E+00 5.974699678E+07
+ 8.146912857E+07 1.018040506E-01 2.207142128E-08 7.018781610E+00 5.993917853E+07
+ 8.187512063E+07 9.319960697E-02 2.027908849E-08 6.776995490E+00 6.013769423E+07
+ 8.228111269E+07 8.531987584E-02 1.862629980E-08 6.535209370E+00 6.034295181E+07
+ 8.268710476E+07 7.807681010E-02 1.710270556E-08 6.293423249E+00 6.055551886E+07
+ 8.309309682E+07 7.138336709E-02 1.569868095E-08 6.051637129E+00 6.077588076E+07
+ 8.349908888E+07 6.530836159E-02 1.440527868E-08 5.809851008E+00 6.100467537E+07
+ 8.390508094E+07 5.969924787E-02 1.321418451E-08 5.568064888E+00 6.124264744E+07
+ 8.431107300E+07 5.455582551E-02 1.211767532E-08 5.326278767E+00 6.149054072E+07
+ 8.471706506E+07 4.984785037E-02 1.110857994E-08 5.084492647E+00 6.174925559E+07
+ 8.512305713E+07 4.552999529E-02 1.018024214E-08 4.842706527E+00 6.201984002E+07
+ 8.552904919E+07 4.155821308E-02 9.326486071E-09 4.600920406E+00 6.230344850E+07
+ 8.593504125E+07 3.794352481E-02 8.541583724E-09 4.359134286E+00 6.260149485E+07
+ 8.634103331E+07 3.463068997E-02 7.820224499E-09 4.117348165E+00 6.291553627E+07
+ 8.674702537E+07 3.158254146E-02 7.157486635E-09 3.875562045E+00 6.324750051E+07
+ 8.715301743E+07 2.879161237E-02 6.548810470E-09 3.633775925E+00 6.359957931E+07
+ 8.755900950E+07 2.624694956E-02 5.989973386E-09 3.391989804E+00 6.397458050E+07
+ 8.796500156E+07 2.393960251E-02 5.477066370E-09 3.150203684E+00 6.437564190E+07
+ 8.837099362E+07 2.179617390E-02 5.006472087E-09 2.908417563E+00 6.480700217E+07
+ 8.877698568E+07 1.987624575E-02 4.574844365E-09 2.666631443E+00 6.527365448E+07
+ 8.918297774E+07 1.806982847E-02 4.179089031E-09 2.424845322E+00 6.578219252E+07
+ 8.958896981E+07 1.647454079E-02 3.816346002E-09 2.183059202E+00 6.634125745E+07
+ 8.999496187E+07 1.500127329E-02 3.483972563E-09 1.941273082E+00 6.696223379E+07
+ 9.040095393E+07 1.363854676E-02 3.179527754E-09 1.699486961E+00 6.766132089E+07
+ 9.080694599E+07 1.238932110E-02 2.900757810E-09 1.457700841E+00 6.846209152E+07
+ 9.121293805E+07 1.128264367E-02 2.645582576E-09 1.215914720E+00 6.940029702E+07
+ 9.161893011E+07 1.025012560E-02 2.412082849E-09 9.741286000E-01 7.053595832E+07
+ 9.202492218E+07 9.303173360E-03 2.198488574E-09 7.323424796E-01 7.197912687E+07
+ 9.243091424E+07 8.465908542E-03 2.003167865E-09 4.905563592E-01 7.397373233E+07
+ 9.283690630E+07 7.695217058E-03 1.824616771E-09 2.487702388E-01 7.727194417E+07
+ 9.324289836E+07 6.984118339E-03 1.661449755E-09 6.984118339E-03 9.324289800E+07
+ 9.331273954E+07 6.914277156E-03 1.000000000E-09 6.914277156E-03 9.331273950E+07
+ 9.338258073E+07 6.844435972E-03 1.000000000E-09 6.844435972E-03 9.338258081E+07
+ 9.345242191E+07 6.774594789E-03 1.000000000E-09 6.774594789E-03 9.345242187E+07
+ 9.352226309E+07 6.704753606E-03 1.000000000E-09 6.704753606E-03 9.352226312E+07
+ 9.359210428E+07 6.634912422E-03 1.000000000E-09 6.634912422E-03 9.359210400E+07
+ 9.366194546E+07 6.565071239E-03 1.000000000E-09 6.565071239E-03 9.366194544E+07
+ 9.373178664E+07 6.495230056E-03 1.000000000E-09 6.495230056E-03 9.373178800E+07
+ 9.380162783E+07 6.425388872E-03 1.000000000E-09 6.425388872E-03 9.380162900E+07
+ 9.387146901E+07 6.355547689E-03 1.000000000E-09 6.355547689E-03 9.387146901E+07
+ 9.394131019E+07 6.285706505E-03 1.000000000E-09 6.285706505E-03 9.394131012E+07
+ 9.401115138E+07 6.215865322E-03 1.000000000E-09 6.215865322E-03 9.401122468E+07
+ 9.408099256E+07 6.146024139E-03 1.000000000E-09 6.146024139E-03 9.408100828E+07
+ 9.415083375E+07 6.076182955E-03 1.000000000E-09 6.076182955E-03 9.415091200E+07
+ 9.422067493E+07 6.006341772E-03 1.000000000E-09 6.006341772E-03 9.422067500E+07
+ 9.429051611E+07 5.936500588E-03 1.000000000E-09 5.936500588E-03 9.429060206E+07
+ 9.436035730E+07 5.866659405E-03 1.000000000E-09 5.866659405E-03 9.436035700E+07
+ 9.443019848E+07 5.796818222E-03 1.000000000E-09 5.796818222E-03 9.443019848E+07
+ 9.450003966E+07 5.726977038E-03 1.000000000E-09 5.726977038E-03 9.450006400E+07
+ 9.456988085E+07 5.657135855E-03 1.000000000E-09 5.657135855E-03 9.456994699E+07
+ 9.463972203E+07 5.587294671E-03 1.000000000E-09 5.587294671E-03 9.463972200E+07
+ 9.470956321E+07 5.517453488E-03 1.000000000E-09 5.517453488E-03 9.470956319E+07
+ 9.477940440E+07 5.447612305E-03 1.000000000E-09 5.447612305E-03 9.477940400E+07
+ 9.484924558E+07 5.377771121E-03 1.000000000E-09 5.377771121E-03 9.484924500E+07
+ 9.491908676E+07 5.307929938E-03 1.000000000E-09 5.307929938E-03 9.491908676E+07
+ 9.498892795E+07 5.238088754E-03 1.000000000E-09 5.238088754E-03 9.498892800E+07
+ 9.505876913E+07 5.168247571E-03 1.000000000E-09 5.168247571E-03 9.505876919E+07
+ 9.512861031E+07 5.098406388E-03 1.000000000E-09 5.098406388E-03 9.512861000E+07
+ 9.519845150E+07 5.028565204E-03 1.000000000E-09 5.028565204E-03 9.519845200E+07
+ 9.526829268E+07 4.958724021E-03 1.000000000E-09 4.958724021E-03 9.526829300E+07
+ 9.533813386E+07 4.888882837E-03 1.000000000E-09 4.888882837E-03 9.533813600E+07
+ 9.540797505E+07 4.819041654E-03 1.000000000E-09 4.819041654E-03 9.540797500E+07
+ 9.547781623E+07 4.749200471E-03 1.000000000E-09 4.749200471E-03 9.547781623E+07
+ 9.554765741E+07 4.679359287E-03 1.000000000E-09 4.679359287E-03 9.554765600E+07
+ 9.561749860E+07 4.609518104E-03 1.000000000E-09 4.609518104E-03 9.561749869E+07
+ 9.568733978E+07 4.539676921E-03 1.000000000E-09 4.539676921E-03 9.568733978E+07
+ 9.575718096E+07 4.469835737E-03 1.000000000E-09 4.469835737E-03 9.575718200E+07
+ 9.582702215E+07 4.399994554E-03 1.000000000E-09 4.399994554E-03 9.582702215E+07
+ 9.589686333E+07 4.330153370E-03 1.000000000E-09 4.330153370E-03 9.589686331E+07
+ 9.596670451E+07 4.260312187E-03 1.000000000E-09 4.260312187E-03 9.596675663E+07
+ 9.603654570E+07 4.190471004E-03 1.000000000E-09 4.190471004E-03 9.603654400E+07
+ 9.610638688E+07 4.120629820E-03 1.000000000E-09 4.120629820E-03 9.610638675E+07
+ 9.617622806E+07 4.050788637E-03 1.000000000E-09 4.050788637E-03 9.617622400E+07
+ 9.624606925E+07 3.980947453E-03 1.000000000E-09 3.980947453E-03 9.624607000E+07
+ 9.631591043E+07 3.911106270E-03 1.000000000E-09 3.911106270E-03 9.631591043E+07
+ 9.638575161E+07 3.841265087E-03 1.000000000E-09 3.841265087E-03 9.638572800E+07
+ 9.645559280E+07 3.771423903E-03 1.000000000E-09 3.771423903E-03 9.645559256E+07
+ 9.652543398E+07 3.701582720E-03 1.000000000E-09 3.701582720E-03 9.652543400E+07
+ 9.659527516E+07 3.631741536E-03 1.000000000E-09 3.631741536E-03 9.659526400E+07
+ 9.666511635E+07 3.561900353E-03 1.000000000E-09 3.561900353E-03 9.666512000E+07
+ 9.673495753E+07 3.492059170E-03 1.000000000E-09 3.492059170E-03 9.673495753E+07
+ 9.680479871E+07 3.422217986E-03 1.000000000E-09 3.422217986E-03 9.680486400E+07
+ 9.687463990E+07 3.352376803E-03 1.000000000E-09 3.352376803E-03 9.687463975E+07
+ 9.694448108E+07 3.282535619E-03 1.000000000E-09 3.282535619E-03 9.694448000E+07
+ 9.701432226E+07 3.212694436E-03 1.000000000E-09 3.212694436E-03 9.701432231E+07
+ 9.708416345E+07 3.142853253E-03 1.000000000E-09 3.142853253E-03 9.708416372E+07
+ 9.715400463E+07 3.073012069E-03 1.000000000E-09 3.073012069E-03 9.715400000E+07
+ 9.722384581E+07 3.003170886E-03 1.000000000E-09 3.003170886E-03 9.722384587E+07
+ 9.729368700E+07 2.933329702E-03 1.000000000E-09 2.933329702E-03 9.729368600E+07
+ 9.736352818E+07 2.863488519E-03 1.000000000E-09 2.863488519E-03 9.736352900E+07
+ 9.743336936E+07 2.793647336E-03 1.000000000E-09 2.793647336E-03 9.743336000E+07
+ 9.750321055E+07 2.723806152E-03 1.000000000E-09 2.723806152E-03 9.750323200E+07
+ 9.757305173E+07 2.653964969E-03 1.000000000E-09 2.653964969E-03 9.757305200E+07
+ 9.764289291E+07 2.584123786E-03 1.000000000E-09 2.584123786E-03 9.764289300E+07
+ 9.771273410E+07 2.514282602E-03 1.000000000E-09 2.514282602E-03 9.771273600E+07
+ 9.778257528E+07 2.444441419E-03 1.000000000E-09 2.444441419E-03 9.778257600E+07
+ 9.785241646E+07 2.374600235E-03 1.000000000E-09 2.374600235E-03 9.785241650E+07
+ 9.792225765E+07 2.304759052E-03 1.000000000E-09 2.304759052E-03 9.792230400E+07
+ 9.799209883E+07 2.234917869E-03 1.000000000E-09 2.234917869E-03 9.799209800E+07
+ 9.806194002E+07 2.165076685E-03 1.000000000E-09 2.165076685E-03 9.806194000E+07
+ 9.813178120E+07 2.095235502E-03 1.000000000E-09 2.095235502E-03 9.813178200E+07
+ 9.820162238E+07 2.025394318E-03 1.000000000E-09 2.025394318E-03 9.820160000E+07
+ 9.827146357E+07 1.955553135E-03 1.000000000E-09 1.955553135E-03 9.827148800E+07
+ 9.834130475E+07 1.885711952E-03 1.000000000E-09 1.885711952E-03 9.834130481E+07
+ 9.841114593E+07 1.815870768E-03 1.000000000E-09 1.815870768E-03 9.841114500E+07
+ 9.848098712E+07 1.746029585E-03 1.000000000E-09 1.746029585E-03 9.848098600E+07
+ 9.855082830E+07 1.676188401E-03 1.000000000E-09 1.676188401E-03 9.855083200E+07
+ 9.862066948E+07 1.606347218E-03 1.000000000E-09 1.606347218E-03 9.862067200E+07
+ 9.869051067E+07 1.536506035E-03 1.000000000E-09 1.536506035E-03 9.869051000E+07
+ 9.876035185E+07 1.466664851E-03 1.000000000E-09 1.466664851E-03 9.876035200E+07
+ 9.883019303E+07 1.396823668E-03 1.000000000E-09 1.396823668E-03 9.883019200E+07
+ 9.890003422E+07 1.326982484E-03 1.000000000E-09 1.326982484E-03 9.890003200E+07
+ 9.896987540E+07 1.257141301E-03 1.000000000E-09 1.257141301E-03 9.896987500E+07
+ 9.903971658E+07 1.187300118E-03 1.000000000E-09 1.187300118E-03 9.903971650E+07
+ 9.910955777E+07 1.117458934E-03 1.000000000E-09 1.117458934E-03 9.910955600E+07
+ 9.917939895E+07 1.047617751E-03 1.000000000E-09 1.047617751E-03 9.917939894E+07
+ 9.924924013E+07 9.777765675E-04 1.000000000E-09 9.777765675E-04 9.924924013E+07
+ 9.931908132E+07 9.079353841E-04 1.000000000E-09 9.079353841E-04 9.931908100E+07
+ 9.938892250E+07 8.380942007E-04 1.000000000E-09 8.380942007E-04 9.938892800E+07
+ 9.945876368E+07 7.682530173E-04 1.000000000E-09 7.682530173E-04 9.945881600E+07
+ 9.952860487E+07 6.984118339E-04 1.000000000E-09 6.984118339E-04 9.952870400E+07
+ 9.959844605E+07 6.285706505E-04 1.000000000E-09 6.285706505E-04 9.959844605E+07
+ 9.966828723E+07 5.587294671E-04 1.000000000E-09 5.587294671E-04 9.966825600E+07
+ 9.973812842E+07 4.888882837E-04 1.000000000E-09 4.888882837E-04 9.973812900E+07
+ 9.980796960E+07 4.190471004E-04 1.000000000E-09 4.190471004E-04 9.980795200E+07
+ 9.987781078E+07 3.492059170E-04 1.000000000E-09 3.492059170E-04 9.987781300E+07
+ 9.994765197E+07 2.793647336E-04 1.000000000E-09 2.793647336E-04 9.994765100E+07
+ 1.000174932E+08 2.095235502E-04 1.000000000E-09 2.095235502E-04 1.000174720E+08
+ 1.000873343E+08 1.396823668E-04 1.000000000E-09 1.396823668E-04 1.000873280E+08
+ 1.001571755E+08 6.984118339E-05 1.000000000E-09 6.984118339E-05 1.001571840E+08
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM89
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM89	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM89	(revision 286)
@@ -0,0 +1,501 @@
+DENSITY AND THICKNESS DATA OF THE ATMOSPHERE AT AN ZENITH ANGLE OF 89.0 DEGREES
+ 0.000000000E+00 2.591861042E+04 1.229805824E-03 2.591861042E+04 0.000000000E+00
+ 1.404929790E+05 2.574645821E+04 1.226757405E-03 2.577262533E+04 1.187275815E+05
+ 2.809859579E+05 2.557376821E+04 1.223678416E-03 2.562664024E+04 2.377044762E+05
+ 4.214789369E+05 2.540188315E+04 1.220569124E-03 2.548065515E+04 3.575586417E+05
+ 5.619719158E+05 2.523072451E+04 1.217429800E-03 2.533467006E+04 4.769432246E+05
+ 7.024648948E+05 2.506012139E+04 1.214260719E-03 2.518868497E+04 5.966820582E+05
+ 8.429578737E+05 2.489015310E+04 1.211062154E-03 2.504269987E+04 7.166854705E+05
+ 9.834508527E+05 2.471992684E+04 1.207834383E-03 2.489671478E+04 8.375909077E+05
+ 1.123943832E+06 2.455030467E+04 1.204577685E-03 2.475072969E+04 9.581910993E+05
+ 1.264436811E+06 2.438151002E+04 1.201292341E-03 2.460474460E+04 1.078697416E+06
+ 1.404929790E+06 2.421258683E+04 1.197978635E-03 2.445875951E+04 1.200429777E+06
+ 1.545422768E+06 2.404472107E+04 1.194636851E-03 2.431277442E+04 1.321800209E+06
+ 1.685915747E+06 2.387732341E+04 1.191267276E-03 2.416678933E+04 1.443311949E+06
+ 1.826408726E+06 2.370980762E+04 1.187870198E-03 2.402080424E+04 1.565263808E+06
+ 1.966901705E+06 2.354338068E+04 1.184445908E-03 2.387481915E+04 1.687998183E+06
+ 2.107394684E+06 2.337741488E+04 1.180994697E-03 2.372883406E+04 1.810541768E+06
+ 2.247887663E+06 2.321134101E+04 1.177516860E-03 2.358284897E+04 1.933411055E+06
+ 2.388380642E+06 2.304634991E+04 1.174012692E-03 2.343686388E+04 2.057215736E+06
+ 2.528873621E+06 2.288184915E+04 1.170482489E-03 2.329087879E+04 2.180528220E+06
+ 2.669366600E+06 2.271724194E+04 1.166926550E-03 2.314489370E+04 2.304319782E+06
+ 2.809859579E+06 2.255477676E+04 1.163345175E-03 2.299890861E+04 2.428922503E+06
+ 2.950352558E+06 2.239083941E+04 1.159738665E-03 2.285292352E+04 2.553356102E+06
+ 3.090845537E+06 2.222774843E+04 1.156107323E-03 2.270693843E+04 2.678782198E+06
+ 3.231338516E+06 2.206576414E+04 1.152451453E-03 2.256095334E+04 2.804605644E+06
+ 3.371831495E+06 2.190429094E+04 1.148771361E-03 2.241496825E+04 2.929247014E+06
+ 3.512324474E+06 2.174274128E+04 1.145067353E-03 2.226898316E+04 3.055539602E+06
+ 3.652817453E+06 2.158232452E+04 1.141339737E-03 2.212299807E+04 3.181679679E+06
+ 3.793310432E+06 2.142241040E+04 1.137588823E-03 2.197701298E+04 3.308174502E+06
+ 3.933803411E+06 2.126243213E+04 1.133814921E-03 2.183102788E+04 3.435695160E+06
+ 4.074296390E+06 2.110357547E+04 1.130018342E-03 2.168504279E+04 3.562778017E+06
+ 4.214789369E+06 2.094524917E+04 1.126199400E-03 2.153905770E+04 3.690881355E+06
+ 4.355282348E+06 2.078764721E+04 1.122358407E-03 2.139307261E+04 3.818851325E+06
+ 4.495775326E+06 2.063020750E+04 1.118495678E-03 2.124708752E+04 3.947880936E+06
+ 4.636268305E+06 2.047272162E+04 1.114611530E-03 2.110110243E+04 4.076463210E+06
+ 4.776761284E+06 2.031655445E+04 1.110706277E-03 2.095511734E+04 4.206116955E+06
+ 4.917254263E+06 2.016112815E+04 1.106780238E-03 2.080913225E+04 4.335650427E+06
+ 5.057747242E+06 2.000588025E+04 1.102833731E-03 2.066314716E+04 4.465945865E+06
+ 5.198240221E+06 1.985077619E+04 1.098867075E-03 2.051716207E+04 4.596988348E+06
+ 5.338733200E+06 1.969684301E+04 1.094880589E-03 2.037117698E+04 4.727591343E+06
+ 5.479226179E+06 1.954344777E+04 1.090874594E-03 2.022519189E+04 4.859316928E+06
+ 5.619719158E+06 1.939080285E+04 1.086849410E-03 2.007920680E+04 4.990940519E+06
+ 5.760212137E+06 1.923775879E+04 1.082805360E-03 1.993322171E+04 5.123696867E+06
+ 5.900705116E+06 1.908605555E+04 1.078742765E-03 1.978723662E+04 5.256058603E+06
+ 6.041198095E+06 1.893510772E+04 1.074661949E-03 1.964125153E+04 5.389542937E+06
+ 6.181691074E+06 1.878387339E+04 1.070563234E-03 1.949526644E+04 5.523660959E+06
+ 6.322184053E+06 1.863388634E+04 1.066446944E-03 1.934928135E+04 5.657370654E+06
+ 6.462677032E+06 1.848448298E+04 1.062313403E-03 1.920329626E+04 5.792253146E+06
+ 6.603170011E+06 1.833565468E+04 1.058162935E-03 1.905731117E+04 5.927792070E+06
+ 6.743662990E+06 1.818759865E+04 1.053995865E-03 1.891132608E+04 6.063017643E+06
+ 6.884155969E+06 1.803918108E+04 1.049812519E-03 1.876534099E+04 6.199363076E+06
+ 7.024648948E+06 1.789210378E+04 1.045613220E-03 1.861935590E+04 6.335666545E+06
+ 7.165141927E+06 1.774561796E+04 1.041398296E-03 1.847337080E+04 6.473025444E+06
+ 7.305634906E+06 1.759972868E+04 1.037168070E-03 1.832738571E+04 6.610899115E+06
+ 7.446127884E+06 1.745383750E+04 1.032922870E-03 1.818140062E+04 6.749477016E+06
+ 7.586620863E+06 1.730912868E+04 1.028663019E-03 1.803541553E+04 6.887704009E+06
+ 7.727113842E+06 1.716509393E+04 1.024388845E-03 1.788943044E+04 7.027177504E+06
+ 7.867606821E+06 1.702139614E+04 1.020100673E-03 1.774344535E+04 7.167204809E+06
+ 8.008099800E+06 1.687848690E+04 1.015798828E-03 1.759746026E+04 7.307797176E+06
+ 8.148592779E+06 1.673618013E+04 1.011483637E-03 1.745147517E+04 7.449133058E+06
+ 8.289085758E+06 1.659467230E+04 1.007155424E-03 1.730549008E+04 7.590118740E+06
+ 8.429578737E+06 1.645280051E+04 1.002814515E-03 1.715950499E+04 7.732507964E+06
+ 8.570071716E+06 1.631231135E+04 9.984612344E-04 1.701351990E+04 7.875240918E+06
+ 8.710564695E+06 1.617245764E+04 9.940959075E-04 1.686753481E+04 8.018759037E+06
+ 8.851057674E+06 1.603319324E+04 9.897188585E-04 1.672154972E+04 8.162891473E+06
+ 8.991550653E+06 1.589472754E+04 9.853304118E-04 1.657556463E+04 8.307655387E+06
+ 9.132043632E+06 1.575651207E+04 9.809308909E-04 1.642957954E+04 8.453050070E+06
+ 9.272536611E+06 1.561850315E+04 9.765206192E-04 1.628359445E+04 8.599272573E+06
+ 9.413029590E+06 1.548179725E+04 9.720999197E-04 1.613760936E+04 8.745809920E+06
+ 9.553522569E+06 1.534561361E+04 9.676691147E-04 1.599162427E+04 8.893359649E+06
+ 9.694015548E+06 1.521005274E+04 9.632285261E-04 1.584563918E+04 9.041221296E+06
+ 9.834508527E+06 1.507511891E+04 9.587784752E-04 1.569965409E+04 9.190139016E+06
+ 9.975001506E+06 1.494099010E+04 9.543192827E-04 1.555366900E+04 9.339384895E+06
+ 1.011549448E+07 1.480652413E+04 9.498512687E-04 1.540768391E+04 9.490590968E+06
+ 1.025598746E+07 1.467348031E+04 9.453747526E-04 1.526169881E+04 9.640502649E+06
+ 1.039648044E+07 1.454104164E+04 9.408900530E-04 1.511571372E+04 9.792299531E+06
+ 1.053697342E+07 1.440923013E+04 9.363974879E-04 1.496972863E+04 9.944473541E+06
+ 1.067746640E+07 1.427805429E+04 9.318973744E-04 1.482374354E+04 1.009759596E+07
+ 1.081795938E+07 1.414750420E+04 9.273900289E-04 1.467775845E+04 1.025151894E+07
+ 1.095845236E+07 1.401776955E+04 9.228757668E-04 1.453177336E+04 1.040620907E+07
+ 1.109894534E+07 1.388811033E+04 9.183549027E-04 1.438578827E+04 1.056251757E+07
+ 1.123943832E+07 1.375945683E+04 9.138277501E-04 1.423980318E+04 1.071863696E+07
+ 1.137993130E+07 1.363162085E+04 9.092946219E-04 1.409381809E+04 1.087578234E+07
+ 1.152042427E+07 1.350405702E+04 9.047558297E-04 1.394783300E+04 1.103420736E+07
+ 1.166091725E+07 1.337749443E+04 9.002116842E-04 1.380184791E+04 1.119306386E+07
+ 1.180141023E+07 1.325122022E+04 8.956624949E-04 1.365586282E+04 1.135280010E+07
+ 1.194190321E+07 1.312593164E+04 8.911085703E-04 1.350987773E+04 1.151407883E+07
+ 1.208239619E+07 1.300031694E+04 8.865502179E-04 1.336389264E+04 1.167562222E+07
+ 1.222288917E+07 1.287612074E+04 8.819877438E-04 1.321790755E+04 1.183812281E+07
+ 1.236338215E+07 1.275255921E+04 8.774214531E-04 1.307192246E+04 1.200219357E+07
+ 1.250387513E+07 1.262963566E+04 8.728516494E-04 1.292593737E+04 1.216658429E+07
+ 1.264436811E+07 1.250745048E+04 8.682786355E-04 1.277995228E+04 1.233282016E+07
+ 1.278486108E+07 1.238580834E+04 8.637027125E-04 1.263396719E+04 1.249898169E+07
+ 1.292535406E+07 1.226481170E+04 8.591241803E-04 1.248798210E+04 1.266715530E+07
+ 1.306584704E+07 1.214444993E+04 8.545433375E-04 1.234199701E+04 1.283558698E+07
+ 1.320634002E+07 1.202473080E+04 8.499604813E-04 1.219601192E+04 1.300597916E+07
+ 1.334683300E+07 1.190567610E+04 8.453759076E-04 1.205002683E+04 1.317634462E+07
+ 1.348732598E+07 1.178724008E+04 8.407899106E-04 1.190404173E+04 1.334873806E+07
+ 1.362781896E+07 1.166944442E+04 8.362027833E-04 1.175805664E+04 1.352224212E+07
+ 1.376831194E+07 1.155248122E+04 8.316148169E-04 1.161207155E+04 1.369620852E+07
+ 1.390880492E+07 1.143578627E+04 8.270263015E-04 1.146608646E+04 1.387204027E+07
+ 1.404929790E+07 1.132010137E+04 8.224375253E-04 1.132010137E+04 1.404929790E+07
+ 1.417161059E+07 1.121901363E+04 8.222122041E-04 1.124519076E+04 1.413919718E+07
+ 1.429392329E+07 1.111848690E+04 8.176702494E-04 1.117028015E+04 1.423131037E+07
+ 1.441623599E+07 1.101782868E+04 8.131316864E-04 1.109536954E+04 1.432194034E+07
+ 1.453854869E+07 1.091952415E+04 8.085967381E-04 1.102045893E+04 1.441302928E+07
+ 1.466086139E+07 1.082143247E+04 8.040656262E-04 1.094554832E+04 1.450671030E+07
+ 1.478317409E+07 1.072237173E+04 7.995385710E-04 1.087063771E+04 1.459941944E+07
+ 1.490548679E+07 1.062566461E+04 7.950157908E-04 1.079572710E+04 1.469251920E+07
+ 1.502779949E+07 1.052845322E+04 7.904975028E-04 1.072081649E+04 1.478510116E+07
+ 1.515011218E+07 1.043257611E+04 7.859839223E-04 1.064590588E+04 1.487905275E+07
+ 1.527242488E+07 1.033570759E+04 7.814752631E-04 1.057099527E+04 1.497461728E+07
+ 1.539473758E+07 1.024090007E+04 7.769717373E-04 1.049608465E+04 1.506837268E+07
+ 1.551705028E+07 1.014667411E+04 7.724735555E-04 1.042117404E+04 1.516446439E+07
+ 1.563936298E+07 1.005145027E+04 7.679809265E-04 1.034626343E+04 1.525905427E+07
+ 1.576167568E+07 9.958301713E+03 7.634940575E-04 1.027135282E+04 1.535600025E+07
+ 1.588398838E+07 9.864941469E+03 7.590131541E-04 1.019644221E+04 1.545144762E+07
+ 1.600630108E+07 9.772135386E+03 7.545384201E-04 1.012153160E+04 1.554925995E+07
+ 1.612861377E+07 9.680615204E+03 7.500700578E-04 1.004662099E+04 1.564657203E+07
+ 1.625092647E+07 9.588891725E+03 7.456082674E-04 9.971710379E+03 1.574431211E+07
+ 1.637323917E+07 9.497720290E+03 7.411532477E-04 9.896799768E+03 1.584250796E+07
+ 1.649555187E+07 9.407892663E+03 7.367051958E-04 9.821889157E+03 1.594116363E+07
+ 1.661786457E+07 9.317796894E+03 7.322643069E-04 9.746978547E+03 1.604029118E+07
+ 1.674017727E+07 9.228250847E+03 7.278307744E-04 9.672067936E+03 1.613988705E+07
+ 1.686248997E+07 9.139989368E+03 7.234047901E-04 9.597157325E+03 1.623996358E+07
+ 1.698480267E+07 9.051515790E+03 7.189865440E-04 9.522246714E+03 1.634052538E+07
+ 1.710711537E+07 8.963589394E+03 7.145762243E-04 9.447336104E+03 1.644166317E+07
+ 1.722942806E+07 8.876953782E+03 7.101740172E-04 9.372425493E+03 1.654321720E+07
+ 1.735174076E+07 8.790093763E+03 7.057801075E-04 9.297514882E+03 1.664630737E+07
+ 1.747405346E+07 8.703778195E+03 7.013946779E-04 9.222604271E+03 1.674785377E+07
+ 1.759636616E+07 8.618735252E+03 6.970179093E-04 9.147693660E+03 1.685196673E+07
+ 1.771867886E+07 8.534254862E+03 6.926499809E-04 9.072783050E+03 1.695558312E+07
+ 1.784099156E+07 8.448767128E+03 6.882910701E-04 8.997872439E+03 1.705973421E+07
+ 1.796330426E+07 8.365577521E+03 6.839413522E-04 8.922961828E+03 1.716445023E+07
+ 1.808561696E+07 8.281909102E+03 6.796010009E-04 8.848051217E+03 1.726969630E+07
+ 1.820792965E+07 8.198779088E+03 6.752701879E-04 8.773140607E+03 1.737656674E+07
+ 1.833024235E+07 8.116928755E+03 6.709490832E-04 8.698229996E+03 1.748293295E+07
+ 1.845255505E+07 8.034846128E+03 6.666378548E-04 8.623319385E+03 1.758986971E+07
+ 1.857486775E+07 7.953298618E+03 6.623366689E-04 8.548408774E+03 1.769739241E+07
+ 1.869718045E+07 7.873031252E+03 6.580456898E-04 8.473498164E+03 1.780550799E+07
+ 1.881949315E+07 7.792523527E+03 6.537650798E-04 8.398587553E+03 1.791458927E+07
+ 1.894180585E+07 7.712547449E+03 6.494949995E-04 8.323676942E+03 1.802391469E+07
+ 1.906411855E+07 7.633827551E+03 6.452356075E-04 8.248766331E+03 1.813495948E+07
+ 1.918643125E+07 7.555653536E+03 6.409870606E-04 8.173855720E+03 1.824552494E+07
+ 1.930874394E+07 7.477274524E+03 6.367495135E-04 8.098945110E+03 1.835672613E+07
+ 1.943105664E+07 7.399354793E+03 6.325231192E-04 8.024034499E+03 1.846972523E+07
+ 1.955336934E+07 7.322726179E+03 6.283080287E-04 7.949123888E+03 1.858109617E+07
+ 1.967568204E+07 7.245831599E+03 6.241043911E-04 7.874213277E+03 1.869540758E+07
+ 1.979799474E+07 7.169456739E+03 6.199123536E-04 7.799302667E+03 1.880925778E+07
+ 1.992030744E+07 7.094356506E+03 6.157320615E-04 7.724392056E+03 1.892380256E+07
+ 2.004262014E+07 7.019010465E+03 6.115636580E-04 7.649481445E+03 1.904019533E+07
+ 2.016493284E+07 6.944167766E+03 6.074072846E-04 7.574570834E+03 1.915614005E+07
+ 2.028724553E+07 6.870582968E+03 6.032630809E-04 7.499660223E+03 1.927281505E+07
+ 2.040955823E+07 6.796748503E+03 5.991311843E-04 7.424749613E+03 1.939149787E+07
+ 2.053187093E+07 6.723425740E+03 5.950117305E-04 7.349839002E+03 1.950964095E+07
+ 2.065418363E+07 6.651341509E+03 5.909048532E-04 7.274928391E+03 1.962855294E+07
+ 2.077649633E+07 6.579062629E+03 5.868106843E-04 7.200017780E+03 1.974944137E+07
+ 2.089880903E+07 6.508259929E+03 5.827293535E-04 7.125107170E+03 1.986990064E+07
+ 2.102112173E+07 6.436910467E+03 5.786609887E-04 7.050196559E+03 1.999117106E+07
+ 2.114343443E+07 6.366068485E+03 5.746057160E-04 6.975285948E+03 2.011448659E+07
+ 2.126574712E+07 6.296488917E+03 5.705636594E-04 6.900375337E+03 2.023738736E+07
+ 2.138805982E+07 6.226627755E+03 5.665349409E-04 6.825464727E+03 2.036114536E+07
+ 2.151037252E+07 6.157269592E+03 5.625196809E-04 6.750554116E+03 2.048697137E+07
+ 2.163268522E+07 6.089162594E+03 5.585179976E-04 6.675643505E+03 2.061371646E+07
+ 2.175499792E+07 6.020775201E+03 5.545300072E-04 6.600732894E+03 2.073884016E+07
+ 2.187731062E+07 5.953636740E+03 5.505558242E-04 6.525822283E+03 2.086783332E+07
+ 2.199962332E+07 5.886212551E+03 5.465955611E-04 6.450911673E+03 2.099602241E+07
+ 2.212193602E+07 5.820043669E+03 5.426493284E-04 6.376001062E+03 2.112641413E+07
+ 2.224424872E+07 5.753641399E+03 5.387172348E-04 6.301090451E+03 2.125781172E+07
+ 2.236656141E+07 5.687664595E+03 5.347993869E-04 6.226179840E+03 2.138883840E+07
+ 2.248887411E+07 5.622922362E+03 5.308958896E-04 6.151269230E+03 2.152088626E+07
+ 2.261118681E+07 5.557896528E+03 5.270068458E-04 6.076358619E+03 2.165526697E+07
+ 2.273349951E+07 5.493354742E+03 5.231323563E-04 6.001448008E+03 2.179069384E+07
+ 2.285581221E+07 5.430019271E+03 5.192725203E-04 5.926537397E+03 2.192581823E+07
+ 2.297812491E+07 5.367193518E+03 5.154274350E-04 5.851626786E+03 2.206337788E+07
+ 2.310043761E+07 5.304037677E+03 5.115971955E-04 5.776716176E+03 2.220067370E+07
+ 2.322275031E+07 5.241362252E+03 5.077818953E-04 5.701805565E+03 2.234056609E+07
+ 2.334506300E+07 5.179908508E+03 5.039816258E-04 5.626894954E+03 2.248152029E+07
+ 2.346737570E+07 5.118156513E+03 5.001964766E-04 5.551984343E+03 2.262367473E+07
+ 2.358968840E+07 5.056879822E+03 4.964265355E-04 5.477073733E+03 2.276553422E+07
+ 2.371200110E+07 4.997050361E+03 4.926718881E-04 5.402163122E+03 2.290866207E+07
+ 2.383431380E+07 4.936674627E+03 4.889326185E-04 5.327252511E+03 2.305445236E+07
+ 2.395662650E+07 4.877517725E+03 4.852088088E-04 5.252341900E+03 2.320150913E+07
+ 2.407893920E+07 4.818045801E+03 4.815005391E-04 5.177431290E+03 2.334989114E+07
+ 2.420125190E+07 4.759793403E+03 4.778078879E-04 5.102520679E+03 2.349961395E+07
+ 2.432356459E+07 4.701234366E+03 4.741309316E-04 5.027610068E+03 2.364968948E+07
+ 2.444587729E+07 4.643122802E+03 4.704697449E-04 4.952699457E+03 2.380216278E+07
+ 2.456818999E+07 4.586196630E+03 4.668244007E-04 4.877788846E+03 2.395607829E+07
+ 2.469050269E+07 4.529738758E+03 4.631949699E-04 4.802878236E+03 2.410990617E+07
+ 2.481281539E+07 4.472936138E+03 4.595815216E-04 4.727967625E+03 2.426674934E+07
+ 2.493512809E+07 4.416589341E+03 4.559841234E-04 4.653057014E+03 2.442516055E+07
+ 2.505744079E+07 4.361493897E+03 4.524028406E-04 4.578146403E+03 2.458511583E+07
+ 2.517975349E+07 4.306015833E+03 4.488377371E-04 4.503235793E+03 2.474668859E+07
+ 2.530206619E+07 4.251733258E+03 4.452888747E-04 4.428325182E+03 2.490990556E+07
+ 2.542437888E+07 4.197117671E+03 4.417563137E-04 4.353414571E+03 2.507495025E+07
+ 2.554669158E+07 4.143694532E+03 4.382401124E-04 4.278503960E+03 2.524159371E+07
+ 2.566900428E+07 4.089950011E+03 4.347403273E-04 4.203593349E+03 2.541002213E+07
+ 2.579131698E+07 4.037381623E+03 4.312570134E-04 4.128682739E+03 2.558026922E+07
+ 2.591362968E+07 3.984468831E+03 4.277902238E-04 4.053772128E+03 2.575242376E+07
+ 2.603594238E+07 3.932749013E+03 4.243400096E-04 3.978861517E+03 2.592647085E+07
+ 2.615825508E+07 3.880676905E+03 4.209064206E-04 3.903950906E+03 2.610250431E+07
+ 2.628056778E+07 3.829040296E+03 4.174895046E-04 3.829040296E+03 2.628056778E+07
+ 2.663016416E+07 3.682442385E+03 4.125712281E-04 3.790999045E+03 2.637019151E+07
+ 2.697976054E+07 3.540533853E+03 3.993129010E-04 3.752957793E+03 2.646059055E+07
+ 2.732935693E+07 3.403206445E+03 3.863646992E-04 3.714916542E+03 2.655175175E+07
+ 2.767895331E+07 3.270362503E+03 3.737242205E-04 3.676875291E+03 2.664366403E+07
+ 2.802854970E+07 3.141872972E+03 3.613888674E-04 3.638834040E+03 2.673639596E+07
+ 2.837814608E+07 3.017644622E+03 3.493558568E-04 3.600792789E+03 2.682993630E+07
+ 2.872774246E+07 2.897568599E+03 3.376222294E-04 3.562751538E+03 2.692427503E+07
+ 2.907733885E+07 2.781542677E+03 3.261848589E-04 3.524710287E+03 2.701945439E+07
+ 2.942693523E+07 2.669474644E+03 3.150404618E-04 3.486669036E+03 2.711552237E+07
+ 2.977653162E+07 2.561241443E+03 3.041856061E-04 3.448627784E+03 2.721246582E+07
+ 3.012612800E+07 2.456752390E+03 2.936167209E-04 3.410586533E+03 2.731027631E+07
+ 3.047572439E+07 2.355908667E+03 2.833301052E-04 3.372545282E+03 2.740902985E+07
+ 3.082532077E+07 2.258612060E+03 2.733219367E-04 3.334504031E+03 2.750871718E+07
+ 3.117491715E+07 2.164773913E+03 2.635882810E-04 3.296462780E+03 2.760933011E+07
+ 3.152451354E+07 2.074283303E+03 2.541250999E-04 3.258421529E+03 2.771094773E+07
+ 3.187410992E+07 1.987054204E+03 2.449282600E-04 3.220380278E+03 2.781356201E+07
+ 3.222370631E+07 1.903005798E+03 2.359935410E-04 3.182339027E+03 2.791716647E+07
+ 3.257330269E+07 1.822024103E+03 2.273166438E-04 3.144297775E+03 2.802184344E+07
+ 3.292289907E+07 1.744042166E+03 2.188931986E-04 3.106256524E+03 2.812758713E+07
+ 3.327249546E+07 1.668950473E+03 2.107187726E-04 3.068215273E+03 2.823439243E+07
+ 3.362209184E+07 1.596675293E+03 2.027888776E-04 3.030174022E+03 2.834235112E+07
+ 3.397168823E+07 1.527128272E+03 1.950989774E-04 2.992132771E+03 2.845144881E+07
+ 3.432128461E+07 1.460228173E+03 1.876444950E-04 2.954091520E+03 2.856168793E+07
+ 3.467088099E+07 1.395905198E+03 1.804208193E-04 2.916050269E+03 2.867315928E+07
+ 3.502047738E+07 1.334066973E+03 1.734233124E-04 2.878009018E+03 2.878586152E+07
+ 3.537007376E+07 1.274625559E+03 1.666473155E-04 2.839967766E+03 2.889979361E+07
+ 3.571967015E+07 1.217514611E+03 1.600881558E-04 2.801926515E+03 2.901505287E+07
+ 3.606926653E+07 1.162662362E+03 1.537411520E-04 2.763885264E+03 2.913163975E+07
+ 3.641886292E+07 1.109997186E+03 1.476016206E-04 2.725844013E+03 2.924955560E+07
+ 3.676845930E+07 1.059434845E+03 1.416648814E-04 2.687802762E+03 2.936890496E+07
+ 3.711805568E+07 1.010924323E+03 1.359262627E-04 2.649761511E+03 2.948969134E+07
+ 3.746765207E+07 9.643859488E+02 1.303811067E-04 2.611720260E+03 2.961191832E+07
+ 3.781724845E+07 9.197418764E+02 1.250247745E-04 2.573679009E+03 2.973573647E+07
+ 3.816684484E+07 8.769377787E+02 1.198526504E-04 2.535637757E+03 2.986104236E+07
+ 3.851644122E+07 8.359113489E+02 1.148601469E-04 2.497596506E+03 2.998798950E+07
+ 3.886603760E+07 7.966097568E+02 1.100427084E-04 2.459555255E+03 3.011658889E+07
+ 3.921563399E+07 7.589616386E+02 1.053958158E-04 2.421514004E+03 3.024688995E+07
+ 3.956523037E+07 7.228978173E+02 1.009149898E-04 2.383472753E+03 3.037894310E+07
+ 3.991482676E+07 6.883832911E+02 9.659579486E-05 2.345431502E+03 3.051276375E+07
+ 4.026442314E+07 6.553397126E+02 9.243384232E-05 2.307390251E+03 3.064848517E+07
+ 4.061401952E+07 6.237349960E+02 8.842479366E-05 2.269349000E+03 3.078612752E+07
+ 4.096361591E+07 5.935022867E+02 8.456436341E-05 2.231307748E+03 3.092573320E+07
+ 4.131321229E+07 5.645860012E+02 8.084832192E-05 2.193266497E+03 3.106745346E+07
+ 4.166280868E+07 5.369551494E+02 7.727249788E-05 2.155225246E+03 3.121120143E+07
+ 4.201240506E+07 5.105505196E+02 7.383278062E-05 2.117183995E+03 3.135717730E+07
+ 4.236200145E+07 4.853138823E+02 7.052512233E-05 2.079142744E+03 3.150541593E+07
+ 4.271159783E+07 4.612218739E+02 6.734553995E-05 2.041101493E+03 3.165599732E+07
+ 4.306119421E+07 4.382102603E+02 6.429011698E-05 2.003060242E+03 3.180900447E+07
+ 4.341079060E+07 4.162546666E+02 6.135500505E-05 1.965018991E+03 3.196452640E+07
+ 4.376038698E+07 3.952934467E+02 5.853642538E-05 1.926977739E+03 3.212265649E+07
+ 4.410998337E+07 3.753200700E+02 5.583067001E-05 1.888936488E+03 3.228349579E+07
+ 4.445957975E+07 3.562511197E+02 5.323410287E-05 1.850895237E+03 3.244714523E+07
+ 4.480917613E+07 3.380820260E+02 5.074316077E-05 1.812853986E+03 3.261376595E+07
+ 4.515877252E+07 3.207425890E+02 4.835435417E-05 1.774812735E+03 3.278333192E+07
+ 4.550836890E+07 3.042615275E+02 4.606426778E-05 1.736771484E+03 3.295616403E+07
+ 4.585796529E+07 2.885352492E+02 4.386956112E-05 1.698730233E+03 3.313224682E+07
+ 4.620756167E+07 2.735819755E+02 4.176696885E-05 1.660688982E+03 3.331177239E+07
+ 4.655715805E+07 2.593291845E+02 3.975330104E-05 1.622647730E+03 3.349490197E+07
+ 4.690675444E+07 2.457695798E+02 3.782544325E-05 1.584606479E+03 3.368178002E+07
+ 4.725635082E+07 2.328725871E+02 3.598035657E-05 1.546565228E+03 3.387264550E+07
+ 4.760594721E+07 2.206063043E+02 3.421507748E-05 1.508523977E+03 3.406757587E+07
+ 4.795554359E+07 2.089328189E+02 3.252671766E-05 1.470482726E+03 3.426682431E+07
+ 4.830513998E+07 1.978581003E+02 3.091246366E-05 1.432441475E+03 3.447066724E+07
+ 4.865473636E+07 1.873130030E+02 2.936957650E-05 1.394400224E+03 3.467922294E+07
+ 4.900433274E+07 1.773078494E+02 2.789539117E-05 1.356358973E+03 3.489279497E+07
+ 4.935392913E+07 1.678044119E+02 2.648731604E-05 1.318317721E+03 3.511172446E+07
+ 4.970352551E+07 1.587822224E+02 2.514283221E-05 1.280276470E+03 3.533624468E+07
+ 5.005312190E+07 1.502186548E+02 2.385949278E-05 1.242235219E+03 3.556661218E+07
+ 5.040271828E+07 1.420933131E+02 2.263492204E-05 1.204193968E+03 3.580323891E+07
+ 5.075231466E+07 1.343825316E+02 2.146681461E-05 1.166152717E+03 3.604660495E+07
+ 5.110191105E+07 1.270736761E+02 2.035293453E-05 1.128111466E+03 3.629699964E+07
+ 5.145150743E+07 1.201557963E+02 1.929111424E-05 1.090070215E+03 3.655495063E+07
+ 5.180110382E+07 1.135788021E+02 1.827925361E-05 1.052028964E+03 3.682094907E+07
+ 5.215070020E+07 1.073683339E+02 1.731531884E-05 1.013987713E+03 3.709556121E+07
+ 5.250029658E+07 1.014645602E+02 1.639734133E-05 9.759464614E+02 3.737942144E+07
+ 5.284989297E+07 9.589761358E+01 1.552341658E-05 9.379052103E+02 3.767322740E+07
+ 5.319948935E+07 9.061582141E+01 1.469170295E-05 8.998639591E+02 3.797777210E+07
+ 5.354908574E+07 8.561775864E+01 1.390042052E-05 8.618227080E+02 3.829394271E+07
+ 5.389868212E+07 8.088896451E+01 1.314784977E-05 8.237814569E+02 3.862285795E+07
+ 5.424827851E+07 7.641638305E+01 1.243233039E-05 7.857402058E+02 3.896544705E+07
+ 5.459787489E+07 7.218524801E+01 1.175225997E-05 7.476989546E+02 3.932312638E+07
+ 5.494747127E+07 6.820085859E+01 1.110609275E-05 7.096577035E+02 3.969752571E+07
+ 5.529706766E+07 6.442363319E+01 1.049233824E-05 6.716164524E+02 4.009029293E+07
+ 5.564666404E+07 6.085556395E+01 9.909559996E-06 6.335752013E+02 4.050349405E+07
+ 5.599626043E+07 5.749631880E+01 9.356374244E-06 5.955339502E+02 4.093964995E+07
+ 5.634585681E+07 5.430465816E+01 8.831448577E-06 5.574926990E+02 4.140149709E+07
+ 5.669545319E+07 5.131277902E+01 8.333500635E-06 5.194514479E+02 4.189262164E+07
+ 5.704504958E+07 4.848945548E+01 7.861296780E-06 4.814101968E+02 4.241748789E+07
+ 5.739464596E+07 4.581637401E+01 7.413650777E-06 4.433689457E+02 4.298130933E+07
+ 5.774424235E+07 4.329491237E+01 6.989422486E-06 4.053276945E+02 4.359115817E+07
+ 5.809383873E+07 4.092516177E+01 6.587516552E-06 3.672864434E+02 4.425507749E+07
+ 5.844343511E+07 3.868417445E+01 6.206881115E-06 3.292451923E+02 4.498536005E+07
+ 5.879303150E+07 3.658355922E+01 5.846506524E-06 2.912039412E+02 4.579751344E+07
+ 5.914262788E+07 3.459460937E+01 5.505424066E-06 2.531626900E+02 4.671379783E+07
+ 5.949222427E+07 3.273204273E+01 5.182704710E-06 2.151214389E+02 4.776804275E+07
+ 5.984182065E+07 3.096970941E+01 4.877457866E-06 1.770801878E+02 4.901247165E+07
+ 6.019141704E+07 2.932010244E+01 4.588830158E-06 1.390389367E+02 5.053896880E+07
+ 6.054101342E+07 2.776852452E+01 4.316004222E-06 1.009976856E+02 5.252874441E+07
+ 6.089060980E+07 2.629843637E+01 4.058197519E-06 6.295643443E+01 5.543817248E+07
+ 6.124020619E+07 2.491518330E+01 3.814661162E-06 2.491518330E+01 6.124020619E+07
+ 6.165521000E+07 2.333024990E+01 3.703961714E-06 2.466610225E+01 6.130378017E+07
+ 6.207021380E+07 2.183911425E+01 3.484132821E-06 2.441702119E+01 6.136794385E+07
+ 6.248521761E+07 2.043673201E+01 3.276225524E-06 2.416794013E+01 6.143272350E+07
+ 6.290022142E+07 1.911825962E+01 3.079667162E-06 2.391885907E+01 6.149812414E+07
+ 6.331522523E+07 1.787910981E+01 2.893907961E-06 2.366977801E+01 6.156415835E+07
+ 6.373022903E+07 1.671488325E+01 2.718420394E-06 2.342069696E+01 6.163083911E+07
+ 6.414523284E+07 1.562145388E+01 2.552698549E-06 2.317161590E+01 6.169817673E+07
+ 6.456023665E+07 1.459484545E+01 2.396257493E-06 2.292253484E+01 6.176618416E+07
+ 6.497524046E+07 1.363130660E+01 2.248632641E-06 2.267345378E+01 6.183488924E+07
+ 6.539024426E+07 1.272731817E+01 2.109379136E-06 2.242437272E+01 6.190429445E+07
+ 6.580524807E+07 1.187940091E+01 1.978071221E-06 2.217529166E+01 6.197441495E+07
+ 6.622025188E+07 1.108444711E+01 1.854301632E-06 2.192621061E+01 6.204526650E+07
+ 6.663525569E+07 1.033934318E+01 1.737680986E-06 2.167712955E+01 6.211686782E+07
+ 6.705025949E+07 9.641244158E+00 1.627837183E-06 2.142804849E+01 6.218924118E+07
+ 6.746526330E+07 8.987327812E+00 1.524414820E-06 2.117896743E+01 6.226239859E+07
+ 6.788026711E+07 8.375111430E+00 1.427074604E-06 2.092988637E+01 6.233635802E+07
+ 6.829527092E+07 7.802067571E+00 1.335492784E-06 2.068080532E+01 6.241113808E+07
+ 6.871027473E+07 7.265888689E+00 1.249360591E-06 2.043172426E+01 6.248674634E+07
+ 6.912527853E+07 6.764367712E+00 1.168383684E-06 2.018264320E+01 6.256322908E+07
+ 6.954028234E+07 6.295441203E+00 1.092281617E-06 1.993356214E+01 6.264058942E+07
+ 6.995528615E+07 5.857126555E+00 1.020787309E-06 1.968448108E+01 6.271884882E+07
+ 7.037028996E+07 5.447558102E+00 9.536465279E-07 1.943540002E+01 6.279803258E+07
+ 7.078529376E+07 5.065021000E+00 8.906173899E-07 1.918631897E+01 6.287815754E+07
+ 7.120029757E+07 4.707817866E+00 8.314698679E-07 1.893723791E+01 6.295926287E+07
+ 7.161530138E+07 4.374376522E+00 7.759853140E-07 1.868815685E+01 6.304136450E+07
+ 7.203030519E+07 4.063266472E+00 7.239559939E-07 1.843907579E+01 6.312448834E+07
+ 7.244530899E+07 3.773052842E+00 6.751846352E-07 1.818999473E+01 6.320865748E+07
+ 7.286031280E+07 3.502440799E+00 6.294839872E-07 1.794091368E+01 6.329390215E+07
+ 7.327531661E+07 3.250180689E+00 5.866763947E-07 1.769183262E+01 6.338025872E+07
+ 7.369032042E+07 3.015105021E+00 5.465933841E-07 1.744275156E+01 6.346774880E+07
+ 7.410532422E+07 2.796136868E+00 5.090752623E-07 1.719367050E+01 6.355639748E+07
+ 7.452032803E+07 2.592241481E+00 4.739707283E-07 1.694458944E+01 6.364626090E+07
+ 7.493533184E+07 2.402431185E+00 4.411364982E-07 1.669550838E+01 6.373736039E+07
+ 7.535033565E+07 2.225809616E+00 4.104369415E-07 1.644642733E+01 6.382973199E+07
+ 7.576533945E+07 2.061474525E+00 3.817437307E-07 1.619734627E+01 6.392341334E+07
+ 7.618034326E+07 1.908695898E+00 3.549355030E-07 1.594826521E+01 6.401844381E+07
+ 7.659534707E+07 1.766643702E+00 3.298975334E-07 1.569918415E+01 6.411485162E+07
+ 7.701035088E+07 1.634635173E+00 3.065214211E-07 1.545010309E+01 6.421270203E+07
+ 7.742535469E+07 1.512011430E+00 2.847047857E-07 1.520102204E+01 6.431203117E+07
+ 7.784035849E+07 1.398136209E+00 2.643509764E-07 1.495194098E+01 6.441287852E+07
+ 7.825536230E+07 1.292392027E+00 2.453687916E-07 1.470285992E+01 6.451531290E+07
+ 7.867036611E+07 1.194303670E+00 2.276722099E-07 1.445377886E+01 6.461937522E+07
+ 7.908536992E+07 1.103269106E+00 2.111801312E-07 1.420469780E+01 6.472510448E+07
+ 7.950037372E+07 1.018844251E+00 1.958161290E-07 1.395561674E+01 6.483259432E+07
+ 7.991537753E+07 9.405965762E-01 1.815082126E-07 1.370653569E+01 6.494187729E+07
+ 8.033038134E+07 8.680770172E-01 1.681885991E-07 1.345745463E+01 6.505301329E+07
+ 8.074538515E+07 8.008724741E-01 1.557934951E-07 1.320837357E+01 6.516609900E+07
+ 8.116038895E+07 7.386230221E-01 1.442628882E-07 1.295929251E+01 6.528118927E+07
+ 8.157539276E+07 6.810370615E-01 1.335403471E-07 1.271021145E+01 6.539835958E+07
+ 8.199039657E+07 6.276793324E-01 1.235728307E-07 1.246113040E+01 6.551767609E+07
+ 8.240540038E+07 5.783650358E-01 1.143105062E-07 1.221204934E+01 6.563924625E+07
+ 8.282040418E+07 5.327027569E-01 1.057065746E-07 1.196296828E+01 6.576315091E+07
+ 8.323540799E+07 4.905422032E-01 9.771710509E-08 1.171388722E+01 6.588947558E+07
+ 8.365041180E+07 4.515471919E-01 9.030087678E-08 1.146480616E+01 6.601834542E+07
+ 8.406541561E+07 4.155177210E-01 8.341922794E-08 1.121572510E+01 6.614983448E+07
+ 8.448041942E+07 3.822362429E-01 7.703591246E-08 1.096664405E+01 6.628410244E+07
+ 8.489542322E+07 3.515056487E-01 7.111696333E-08 1.071756299E+01 6.642122678E+07
+ 8.531042703E+07 3.231564192E-01 6.563056269E-08 1.046848193E+01 6.656136427E+07
+ 8.572543084E+07 2.969878395E-01 6.054691842E-08 1.021940087E+01 6.670466110E+07
+ 8.614043465E+07 2.728577734E-01 5.583814683E-08 9.970319813E+00 6.685124555E+07
+ 8.655543845E+07 2.505814445E-01 5.147816135E-08 9.721238755E+00 6.700130411E+07
+ 8.697044226E+07 2.300705271E-01 4.744256687E-08 9.472157697E+00 6.715497842E+07
+ 8.738544607E+07 2.111691900E-01 4.370855957E-08 9.223076639E+00 6.731248634E+07
+ 8.780044988E+07 1.937594828E-01 4.025483196E-08 8.973995581E+00 6.747401582E+07
+ 8.821545368E+07 1.777124836E-01 3.706148294E-08 8.724914522E+00 6.763981179E+07
+ 8.863045749E+07 1.629423834E-01 3.410993266E-08 8.475833464E+00 6.781007629E+07
+ 8.904546130E+07 1.493790491E-01 3.138284195E-08 8.226752406E+00 6.798509636E+07
+ 8.946046511E+07 1.368766055E-01 2.886403614E-08 7.977671348E+00 6.816513557E+07
+ 8.987546891E+07 1.253941350E-01 2.653843301E-08 7.728590290E+00 6.835053845E+07
+ 9.029047272E+07 1.148199120E-01 2.439197480E-08 7.479509232E+00 6.854160063E+07
+ 9.070547653E+07 1.051020309E-01 2.241156397E-08 7.230428173E+00 6.873870287E+07
+ 9.112048034E+07 9.620121750E-02 2.058500258E-08 6.981347115E+00 6.894230971E+07
+ 9.153548415E+07 8.801701792E-02 1.890093511E-08 6.732266057E+00 6.915281782E+07
+ 9.195048795E+07 8.048700610E-02 1.734879462E-08 6.483184999E+00 6.937074034E+07
+ 9.236549176E+07 7.359993825E-02 1.591875191E-08 6.234103941E+00 6.959670174E+07
+ 9.278049557E+07 6.725286255E-02 1.460166775E-08 5.985022882E+00 6.983126370E+07
+ 9.319549938E+07 6.146569295E-02 1.338904788E-08 5.735941824E+00 7.007515735E+07
+ 9.361050318E+07 5.613812492E-02 1.227300065E-08 5.486860766E+00 7.032923763E+07
+ 9.402550699E+07 5.127018185E-02 1.124619723E-08 5.237779708E+00 7.059436676E+07
+ 9.444051080E+07 4.678909533E-02 1.030183419E-08 4.988698650E+00 7.087161412E+07
+ 9.485551461E+07 4.270785401E-02 9.433598379E-09 4.739617592E+00 7.116217849E+07
+ 9.527051841E+07 3.894366802E-02 8.635633929E-09 4.490536533E+00 7.146746937E+07
+ 9.568552222E+07 3.553931187E-02 7.902511290E-09 4.241455475E+00 7.178912003E+07
+ 9.610052603E+07 3.239319708E-02 7.229198209E-09 3.992374417E+00 7.212905853E+07
+ 9.651552984E+07 2.952244943E-02 6.611032508E-09 3.743293359E+00 7.248955783E+07
+ 9.693053364E+07 2.689800087E-02 6.043696580E-09 3.494212301E+00 7.287336850E+07
+ 9.734553745E+07 2.448219003E-02 5.523193511E-09 3.245131242E+00 7.328393167E+07
+ 9.776054126E+07 2.231179531E-02 5.045824717E-09 2.996050184E+00 7.372530753E+07
+ 9.817554507E+07 2.028801100E-02 4.608169032E-09 2.746969126E+00 7.420274274E+07
+ 9.859054887E+07 1.847666254E-02 4.207063146E-09 2.497888068E+00 7.472289915E+07
+ 9.900555268E+07 1.679898015E-02 3.839583316E-09 2.248807010E+00 7.529455760E+07
+ 9.942055649E+07 1.528536708E-02 3.503028291E-09 1.999725952E+00 7.592949041E+07
+ 9.983556030E+07 1.390487877E-02 3.194903351E-09 1.750644893E+00 7.664407339E+07
+ 1.002505641E+08 1.263088986E-02 2.912905424E-09 1.501563835E+00 7.746219043E+07
+ 1.006655679E+08 1.150409223E-02 2.654909191E-09 1.252482777E+00 7.842054602E+07
+ 1.010805717E+08 1.040376172E-02 2.418954133E-09 1.003401719E+00 7.957987361E+07
+ 1.014955755E+08 9.470523106E-03 2.203232454E-09 7.543206606E-01 8.105279440E+07
+ 1.019105793E+08 8.600547326E-03 2.006077836E-09 5.052396024E-01 8.308727481E+07
+ 1.023255831E+08 7.802371159E-03 1.825954960E-09 2.561585442E-01 8.644835059E+07
+ 1.027405870E+08 7.077486047E-03 1.661449755E-09 7.077486047E-03 1.027405880E+08
+ 1.028113618E+08 7.006711187E-03 1.000000000E-09 7.006711187E-03 1.028113617E+08
+ 1.028821367E+08 6.935936326E-03 1.000000000E-09 6.935936326E-03 1.028821367E+08
+ 1.029529115E+08 6.865161466E-03 1.000000000E-09 6.865161466E-03 1.029529600E+08
+ 1.030236864E+08 6.794386605E-03 1.000000000E-09 6.794386605E-03 1.030236160E+08
+ 1.030944613E+08 6.723611745E-03 1.000000000E-09 6.723611745E-03 1.030944610E+08
+ 1.031652361E+08 6.652836884E-03 1.000000000E-09 6.652836884E-03 1.031651840E+08
+ 1.032360110E+08 6.582062024E-03 1.000000000E-09 6.582062024E-03 1.032360110E+08
+ 1.033067858E+08 6.511287163E-03 1.000000000E-09 6.511287163E-03 1.033067870E+08
+ 1.033775607E+08 6.440512303E-03 1.000000000E-09 6.440512303E-03 1.033775607E+08
+ 1.034483356E+08 6.369737442E-03 1.000000000E-09 6.369737442E-03 1.034483360E+08
+ 1.035191104E+08 6.298962582E-03 1.000000000E-09 6.298962582E-03 1.035191100E+08
+ 1.035898853E+08 6.228187722E-03 1.000000000E-09 6.228187722E-03 1.035898853E+08
+ 1.036606601E+08 6.157412861E-03 1.000000000E-09 6.157412861E-03 1.036606600E+08
+ 1.037314350E+08 6.086638001E-03 1.000000000E-09 6.086638001E-03 1.037314340E+08
+ 1.038022099E+08 6.015863140E-03 1.000000000E-09 6.015863140E-03 1.038022080E+08
+ 1.038729847E+08 5.945088280E-03 1.000000000E-09 5.945088280E-03 1.038729760E+08
+ 1.039437596E+08 5.874313419E-03 1.000000000E-09 5.874313419E-03 1.039437596E+08
+ 1.040145344E+08 5.803538559E-03 1.000000000E-09 5.803538559E-03 1.040145344E+08
+ 1.040853093E+08 5.732763698E-03 1.000000000E-09 5.732763698E-03 1.040853070E+08
+ 1.041560842E+08 5.661988838E-03 1.000000000E-09 5.661988838E-03 1.041560842E+08
+ 1.042268590E+08 5.591213977E-03 1.000000000E-09 5.591213977E-03 1.042268590E+08
+ 1.042976339E+08 5.520439117E-03 1.000000000E-09 5.520439117E-03 1.042977280E+08
+ 1.043684087E+08 5.449664256E-03 1.000000000E-09 5.449664256E-03 1.043684160E+08
+ 1.044391836E+08 5.378889396E-03 1.000000000E-09 5.378889396E-03 1.044391840E+08
+ 1.045099585E+08 5.308114535E-03 1.000000000E-09 5.308114535E-03 1.045099585E+08
+ 1.045807333E+08 5.237339675E-03 1.000000000E-09 5.237339675E-03 1.045807987E+08
+ 1.046515082E+08 5.166564814E-03 1.000000000E-09 5.166564814E-03 1.046515082E+08
+ 1.047222830E+08 5.095789954E-03 1.000000000E-09 5.095789954E-03 1.047223575E+08
+ 1.047930579E+08 5.025015093E-03 1.000000000E-09 5.025015093E-03 1.047930720E+08
+ 1.048638328E+08 4.954240233E-03 1.000000000E-09 4.954240233E-03 1.048638328E+08
+ 1.049346076E+08 4.883465373E-03 1.000000000E-09 4.883465373E-03 1.049346560E+08
+ 1.050053825E+08 4.812690512E-03 1.000000000E-09 4.812690512E-03 1.050053810E+08
+ 1.050761573E+08 4.741915652E-03 1.000000000E-09 4.741915652E-03 1.050762240E+08
+ 1.051469322E+08 4.671140791E-03 1.000000000E-09 4.671140791E-03 1.051469461E+08
+ 1.052177071E+08 4.600365931E-03 1.000000000E-09 4.600365931E-03 1.052177070E+08
+ 1.052884819E+08 4.529591070E-03 1.000000000E-09 4.529591070E-03 1.052884800E+08
+ 1.053592568E+08 4.458816210E-03 1.000000000E-09 4.458816210E-03 1.053592568E+08
+ 1.054300316E+08 4.388041349E-03 1.000000000E-09 4.388041349E-03 1.054300160E+08
+ 1.055008065E+08 4.317266489E-03 1.000000000E-09 4.317266489E-03 1.055008065E+08
+ 1.055715814E+08 4.246491628E-03 1.000000000E-09 4.246491628E-03 1.055715810E+08
+ 1.056423562E+08 4.175716768E-03 1.000000000E-09 4.175716768E-03 1.056423562E+08
+ 1.057131311E+08 4.104941907E-03 1.000000000E-09 4.104941907E-03 1.057131360E+08
+ 1.057839060E+08 4.034167047E-03 1.000000000E-09 4.034167047E-03 1.057839060E+08
+ 1.058546808E+08 3.963392186E-03 1.000000000E-09 3.963392186E-03 1.058546810E+08
+ 1.059254557E+08 3.892617326E-03 1.000000000E-09 3.892617326E-03 1.059254557E+08
+ 1.059962305E+08 3.821842465E-03 1.000000000E-09 3.821842465E-03 1.059962560E+08
+ 1.060670054E+08 3.751067605E-03 1.000000000E-09 3.751067605E-03 1.060670050E+08
+ 1.061377803E+08 3.680292745E-03 1.000000000E-09 3.680292745E-03 1.061377920E+08
+ 1.062085551E+08 3.609517884E-03 1.000000000E-09 3.609517884E-03 1.062085551E+08
+ 1.062793300E+08 3.538743024E-03 1.000000000E-09 3.538743024E-03 1.062793310E+08
+ 1.063501048E+08 3.467968163E-03 1.000000000E-09 3.467968163E-03 1.063501048E+08
+ 1.064208797E+08 3.397193303E-03 1.000000000E-09 3.397193303E-03 1.064208796E+08
+ 1.064916546E+08 3.326418442E-03 1.000000000E-09 3.326418442E-03 1.064916560E+08
+ 1.065624294E+08 3.255643582E-03 1.000000000E-09 3.255643582E-03 1.065624300E+08
+ 1.066332043E+08 3.184868721E-03 1.000000000E-09 3.184868721E-03 1.066332043E+08
+ 1.067039791E+08 3.114093861E-03 1.000000000E-09 3.114093861E-03 1.067039810E+08
+ 1.067747540E+08 3.043319000E-03 1.000000000E-09 3.043319000E-03 1.067747540E+08
+ 1.068455289E+08 2.972544140E-03 1.000000000E-09 2.972544140E-03 1.068455324E+08
+ 1.069163037E+08 2.901769279E-03 1.000000000E-09 2.901769279E-03 1.069163040E+08
+ 1.069870786E+08 2.830994419E-03 1.000000000E-09 2.830994419E-03 1.069871622E+08
+ 1.070578534E+08 2.760219558E-03 1.000000000E-09 2.760219558E-03 1.070578534E+08
+ 1.071286283E+08 2.689444698E-03 1.000000000E-09 2.689444698E-03 1.071286283E+08
+ 1.071994032E+08 2.618669837E-03 1.000000000E-09 2.618669837E-03 1.071994032E+08
+ 1.072701780E+08 2.547894977E-03 1.000000000E-09 2.547894977E-03 1.072701785E+08
+ 1.073409529E+08 2.477120117E-03 1.000000000E-09 2.477120117E-03 1.073409600E+08
+ 1.074117277E+08 2.406345256E-03 1.000000000E-09 2.406345256E-03 1.074117277E+08
+ 1.074825026E+08 2.335570396E-03 1.000000000E-09 2.335570396E-03 1.074825030E+08
+ 1.075532775E+08 2.264795535E-03 1.000000000E-09 2.264795535E-03 1.075532800E+08
+ 1.076240523E+08 2.194020675E-03 1.000000000E-09 2.194020675E-03 1.076240523E+08
+ 1.076948272E+08 2.123245814E-03 1.000000000E-09 2.123245814E-03 1.076948272E+08
+ 1.077656020E+08 2.052470954E-03 1.000000000E-09 2.052470954E-03 1.077656271E+08
+ 1.078363769E+08 1.981696093E-03 1.000000000E-09 1.981696093E-03 1.078363769E+08
+ 1.079071518E+08 1.910921233E-03 1.000000000E-09 1.910921233E-03 1.079071519E+08
+ 1.079779266E+08 1.840146372E-03 1.000000000E-09 1.840146372E-03 1.079780298E+08
+ 1.080487015E+08 1.769371512E-03 1.000000000E-09 1.769371512E-03 1.080486400E+08
+ 1.081194763E+08 1.698596651E-03 1.000000000E-09 1.698596651E-03 1.081194822E+08
+ 1.081902512E+08 1.627821791E-03 1.000000000E-09 1.627821791E-03 1.081902080E+08
+ 1.082610261E+08 1.557046930E-03 1.000000000E-09 1.557046930E-03 1.082610865E+08
+ 1.083318009E+08 1.486272070E-03 1.000000000E-09 1.486272070E-03 1.083318009E+08
+ 1.084025758E+08 1.415497209E-03 1.000000000E-09 1.415497209E-03 1.084025758E+08
+ 1.084733506E+08 1.344722349E-03 1.000000000E-09 1.344722349E-03 1.084733600E+08
+ 1.085441255E+08 1.273947488E-03 1.000000000E-09 1.273947488E-03 1.085441254E+08
+ 1.086149004E+08 1.203172628E-03 1.000000000E-09 1.203172628E-03 1.086149004E+08
+ 1.086856752E+08 1.132397768E-03 1.000000000E-09 1.132397768E-03 1.086856752E+08
+ 1.087564501E+08 1.061622907E-03 1.000000000E-09 1.061622907E-03 1.087564500E+08
+ 1.088272250E+08 9.908480466E-04 1.000000000E-09 9.908480466E-04 1.088272160E+08
+ 1.088979998E+08 9.200731861E-04 1.000000000E-09 9.200731861E-04 1.088980480E+08
+ 1.089687747E+08 8.492983257E-04 1.000000000E-09 8.492983257E-04 1.089687750E+08
+ 1.090395495E+08 7.785234652E-04 1.000000000E-09 7.785234652E-04 1.090395495E+08
+ 1.091103244E+08 7.077486047E-04 1.000000000E-09 7.077486047E-04 1.091103040E+08
+ 1.091810993E+08 6.369737442E-04 1.000000000E-09 6.369737442E-04 1.091810993E+08
+ 1.092518741E+08 5.661988838E-04 1.000000000E-09 5.661988838E-04 1.092518720E+08
+ 1.093226490E+08 4.954240233E-04 1.000000000E-09 4.954240233E-04 1.093226560E+08
+ 1.093934238E+08 4.246491628E-04 1.000000000E-09 4.246491628E-04 1.093934240E+08
+ 1.094641987E+08 3.538743024E-04 1.000000000E-09 3.538743024E-04 1.094642046E+08
+ 1.095349736E+08 2.830994419E-04 1.000000000E-09 2.830994419E-04 1.095349760E+08
+ 1.096057484E+08 2.123245814E-04 1.000000000E-09 2.123245814E-04 1.096057600E+08
+ 1.096765233E+08 1.415497209E-04 1.000000000E-09 1.415497209E-04 1.096765240E+08
+ 1.097472981E+08 7.077486047E-05 1.000000000E-09 7.077486047E-05 1.097472000E+08
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM90
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM90	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ATM90	(revision 286)
@@ -0,0 +1,501 @@
+DENSITY AND THICKNESS DATA OF THE ATMOSPHERE AT AN ZENITH ANGLE OF 90.0 DEGREES
+ 0.000000000E+00 3.647801283E+04 1.229805824E-03 3.647801283E+04 1.862645149E-09
+ 2.257786527E+05 3.620047529E+04 1.229756329E-03 3.623349251E+04 1.986485072E+05
+ 4.515573053E+05 3.592233153E+04 1.229607858E-03 3.598897218E+04 3.978072130E+05
+ 6.773359580E+05 3.564482409E+04 1.229360446E-03 3.574445185E+04 5.964810255E+05
+ 9.031146107E+05 3.536738572E+04 1.229014152E-03 3.549993153E+04 7.952009557E+05
+ 1.128893263E+06 3.509002814E+04 1.228569061E-03 3.525541120E+04 9.944409075E+05
+ 1.354671916E+06 3.481249366E+04 1.228025281E-03 3.501089087E+04 1.193184521E+06
+ 1.580450569E+06 3.453537186E+04 1.227382941E-03 3.476637054E+04 1.392539537E+06
+ 1.806229221E+06 3.425857461E+04 1.226642199E-03 3.452185022E+04 1.592005948E+06
+ 2.032007874E+06 3.398178012E+04 1.225803232E-03 3.427732989E+04 1.791070364E+06
+ 2.257786527E+06 3.370520603E+04 1.224866243E-03 3.403280956E+04 1.990247190E+06
+ 2.483565179E+06 3.342882608E+04 1.223831459E-03 3.378828924E+04 2.190030741E+06
+ 2.709343832E+06 3.315209033E+04 1.222699128E-03 3.354376891E+04 2.389476632E+06
+ 2.935122485E+06 3.287621068E+04 1.221469524E-03 3.329924858E+04 2.589058350E+06
+ 3.160901137E+06 3.260061412E+04 1.220142942E-03 3.305472825E+04 2.789281141E+06
+ 3.386679790E+06 3.232649477E+04 1.218719702E-03 3.281020793E+04 2.989683530E+06
+ 3.612458443E+06 3.205046302E+04 1.217200147E-03 3.256568760E+04 3.189852328E+06
+ 3.838237095E+06 3.177585566E+04 1.215584640E-03 3.232116727E+04 3.391010767E+06
+ 4.064015748E+06 3.150160836E+04 1.213873571E-03 3.207664695E+04 3.591130218E+06
+ 4.289794401E+06 3.122778353E+04 1.212067349E-03 3.183212662E+04 3.792355959E+06
+ 4.515573053E+06 3.095434864E+04 1.210166408E-03 3.158760629E+04 3.993308323E+06
+ 4.741351706E+06 3.068135365E+04 1.208171202E-03 3.134308596E+04 4.194540935E+06
+ 4.967130359E+06 3.040881020E+04 1.206082209E-03 3.109856564E+04 4.396503283E+06
+ 5.192909011E+06 3.013716643E+04 1.203899926E-03 3.085404531E+04 4.598757024E+06
+ 5.418687664E+06 2.986559857E+04 1.201624876E-03 3.060952498E+04 4.800792242E+06
+ 5.644466317E+06 2.959455475E+04 1.199257599E-03 3.036500466E+04 5.003143177E+06
+ 5.870244969E+06 2.932404589E+04 1.196798660E-03 3.012048433E+04 5.206639801E+06
+ 6.096023622E+06 2.905412219E+04 1.194248642E-03 2.987596400E+04 5.409494553E+06
+ 6.321802275E+06 2.878475481E+04 1.191608151E-03 2.963144367E+04 5.613478962E+06
+ 6.547580927E+06 2.851599369E+04 1.188877811E-03 2.938692335E+04 5.817186788E+06
+ 6.773359580E+06 2.824784927E+04 1.186058270E-03 2.914240302E+04 6.021781217E+06
+ 6.999138233E+06 2.798045018E+04 1.183150192E-03 2.889788269E+04 6.226755758E+06
+ 7.224916885E+06 2.771360870E+04 1.180154263E-03 2.865336236E+04 6.432143581E+06
+ 7.450695538E+06 2.744745347E+04 1.177071189E-03 2.840884204E+04 6.637433274E+06
+ 7.676474191E+06 2.718199435E+04 1.173901694E-03 2.816432171E+04 6.843256516E+06
+ 7.902252843E+06 2.691727996E+04 1.170646522E-03 2.791980138E+04 7.049943168E+06
+ 8.128031496E+06 2.665328099E+04 1.167306433E-03 2.767528106E+04 7.257096129E+06
+ 8.353810149E+06 2.639004574E+04 1.163882210E-03 2.743076073E+04 7.464744659E+06
+ 8.579588801E+06 2.612758355E+04 1.160374649E-03 2.718624040E+04 7.672891569E+06
+ 8.805367454E+06 2.586582042E+04 1.156784567E-03 2.694172007E+04 7.881578012E+06
+ 9.031146107E+06 2.560497113E+04 1.153112798E-03 2.669719975E+04 8.090113023E+06
+ 9.256924759E+06 2.534501434E+04 1.149360192E-03 2.645267942E+04 8.300005712E+06
+ 9.482703412E+06 2.508644683E+04 1.145527617E-03 2.620815909E+04 8.510322876E+06
+ 9.708482065E+06 2.482815270E+04 1.141615956E-03 2.596363877E+04 8.721287521E+06
+ 9.934260717E+06 2.457074137E+04 1.137626110E-03 2.571911844E+04 8.932797106E+06
+ 1.016003937E+07 2.431409340E+04 1.133558994E-03 2.547459811E+04 9.144325458E+06
+ 1.038581802E+07 2.405928725E+04 1.129415539E-03 2.523007778E+04 9.357078989E+06
+ 1.061159668E+07 2.380464287E+04 1.125196691E-03 2.498555746E+04 9.570509386E+06
+ 1.083737533E+07 2.355095038E+04 1.120903412E-03 2.474103713E+04 9.784623912E+06
+ 1.106315398E+07 2.329781906E+04 1.116536676E-03 2.449651680E+04 9.999434069E+06
+ 1.128893263E+07 2.304660331E+04 1.112097472E-03 2.425199648E+04 1.021498475E+07
+ 1.151471129E+07 2.279589101E+04 1.107586803E-03 2.400747615E+04 1.043125499E+07
+ 1.174048994E+07 2.254619063E+04 1.103005685E-03 2.376295582E+04 1.064829071E+07
+ 1.196626859E+07 2.229814709E+04 1.098355147E-03 2.351843549E+04 1.086610500E+07
+ 1.219204724E+07 2.205053206E+04 1.093636229E-03 2.327391517E+04 1.108481234E+07
+ 1.241782590E+07 2.180460573E+04 1.088849986E-03 2.302939484E+04 1.130425839E+07
+ 1.264360455E+07 2.155913727E+04 1.083997481E-03 2.278487451E+04 1.152455875E+07
+ 1.286938320E+07 2.131440968E+04 1.079079790E-03 2.254035419E+04 1.174626558E+07
+ 1.309516185E+07 2.107193280E+04 1.074098002E-03 2.229583386E+04 1.196835270E+07
+ 1.332094051E+07 2.082980649E+04 1.069053212E-03 2.205131353E+04 1.219134012E+07
+ 1.354671916E+07 2.058882465E+04 1.063946529E-03 2.180679320E+04 1.241583872E+07
+ 1.377249781E+07 2.034901745E+04 1.058779070E-03 2.156227288E+04 1.264074315E+07
+ 1.399827647E+07 2.011095966E+04 1.053551961E-03 2.131775255E+04 1.286631755E+07
+ 1.422405512E+07 1.987347446E+04 1.048266337E-03 2.107323222E+04 1.309396534E+07
+ 1.444983377E+07 1.963790216E+04 1.042923342E-03 2.082871190E+04 1.332195329E+07
+ 1.467561242E+07 1.940281347E+04 1.037524128E-03 2.058419157E+04 1.355102711E+07
+ 1.490139108E+07 1.916895290E+04 1.032069854E-03 2.033967124E+04 1.378123279E+07
+ 1.512716973E+07 1.893632950E+04 1.026561687E-03 2.009515091E+04 1.401311809E+07
+ 1.535294838E+07 1.870556787E+04 1.021000799E-03 1.985063059E+04 1.424618889E+07
+ 1.557872703E+07 1.847526864E+04 1.015388371E-03 1.960611026E+04 1.447998045E+07
+ 1.580450569E+07 1.824718656E+04 1.009725588E-03 1.936158993E+04 1.471492228E+07
+ 1.603028434E+07 1.801959685E+04 1.004013641E-03 1.911706961E+04 1.495170613E+07
+ 1.625606299E+07 1.779379729E+04 9.982537272E-04 1.887254928E+04 1.518980483E+07
+ 1.648184164E+07 1.756879718E+04 9.924470467E-04 1.862802895E+04 1.542868350E+07
+ 1.670762030E+07 1.734512379E+04 9.865948052E-04 1.838350862E+04 1.566950360E+07
+ 1.693339895E+07 1.712335728E+04 9.806982119E-04 1.813898830E+04 1.591174555E+07
+ 1.715917760E+07 1.690295969E+04 9.747584795E-04 1.789446797E+04 1.615492632E+07
+ 1.738495626E+07 1.668325737E+04 9.687768237E-04 1.764994764E+04 1.639993032E+07
+ 1.761073491E+07 1.646492167E+04 9.627544630E-04 1.740542732E+04 1.664649816E+07
+ 1.783651356E+07 1.624863851E+04 9.566926180E-04 1.716090699E+04 1.689498699E+07
+ 1.806229221E+07 1.603284820E+04 9.505925112E-04 1.691638666E+04 1.714495094E+07
+ 1.828807087E+07 1.581938273E+04 9.444553667E-04 1.667186633E+04 1.739657076E+07
+ 1.851384952E+07 1.560652427E+04 9.382824094E-04 1.642734601E+04 1.764991831E+07
+ 1.873962817E+07 1.539568052E+04 9.320748649E-04 1.618282568E+04 1.790513438E+07
+ 1.896540682E+07 1.518544165E+04 9.258339590E-04 1.593830535E+04 1.816189503E+07
+ 1.919118548E+07 1.497755474E+04 9.195609175E-04 1.569378503E+04 1.842088820E+07
+ 1.941696413E+07 1.477030942E+04 9.132569655E-04 1.544926470E+04 1.868228995E+07
+ 1.964274278E+07 1.456489196E+04 9.069233273E-04 1.520474437E+04 1.894501319E+07
+ 1.986852143E+07 1.436109558E+04 9.005612257E-04 1.496022404E+04 1.920979444E+07
+ 2.009430009E+07 1.415873704E+04 8.941718818E-04 1.471570372E+04 1.947711353E+07
+ 2.032007874E+07 1.395722363E+04 8.877565147E-04 1.447118339E+04 1.974616830E+07
+ 2.054585739E+07 1.375714742E+04 8.813163411E-04 1.422666306E+04 2.001811643E+07
+ 2.077163605E+07 1.355894809E+04 8.748525746E-04 1.398214274E+04 2.029241462E+07
+ 2.099741470E+07 1.336254013E+04 8.683664259E-04 1.373762241E+04 2.056837933E+07
+ 2.122319335E+07 1.316692785E+04 8.618591019E-04 1.349310208E+04 2.084749308E+07
+ 2.144897200E+07 1.297327874E+04 8.553318056E-04 1.324858175E+04 2.112856804E+07
+ 2.167475066E+07 1.278110216E+04 8.487857357E-04 1.300406143E+04 2.141282640E+07
+ 2.190052931E+07 1.258981891E+04 8.422220864E-04 1.275954110E+04 2.169979731E+07
+ 2.212630796E+07 1.240058428E+04 8.356420466E-04 1.251502077E+04 2.198958331E+07
+ 2.235208661E+07 1.221284366E+04 8.290468003E-04 1.227050045E+04 2.228223542E+07
+ 2.257786527E+07 1.202598012E+04 8.224375253E-04 1.202598012E+04 2.257786527E+07
+ 2.270915804E+07 1.191743436E+04 8.223778136E-04 1.194530131E+04 2.267562183E+07
+ 2.284045080E+07 1.180947370E+04 8.179963415E-04 1.186462249E+04 2.277376141E+07
+ 2.297174357E+07 1.170284350E+04 8.136131888E-04 1.178394368E+04 2.287230905E+07
+ 2.310303634E+07 1.159679791E+04 8.092286341E-04 1.170326487E+04 2.297123079E+07
+ 2.323432911E+07 1.149054269E+04 8.048429544E-04 1.162258605E+04 2.307055184E+07
+ 2.336562188E+07 1.138486290E+04 8.004564254E-04 1.154190724E+04 2.317027535E+07
+ 2.349691465E+07 1.128053375E+04 7.960693214E-04 1.146122843E+04 2.327041194E+07
+ 2.362820742E+07 1.117527456E+04 7.916819151E-04 1.138054962E+04 2.337095762E+07
+ 2.375950019E+07 1.107248084E+04 7.872944779E-04 1.129987080E+04 2.347192321E+07
+ 2.389079295E+07 1.096909972E+04 7.829072796E-04 1.121919199E+04 2.357331228E+07
+ 2.402208572E+07 1.086630396E+04 7.785205884E-04 1.113851318E+04 2.367426531E+07
+ 2.415337849E+07 1.076432566E+04 7.741346712E-04 1.105783436E+04 2.377791669E+07
+ 2.428467126E+07 1.066349275E+04 7.697497931E-04 1.097715555E+04 2.388061116E+07
+ 2.441596403E+07 1.056319480E+04 7.653662176E-04 1.089647674E+04 2.398375155E+07
+ 2.454725680E+07 1.046267494E+04 7.609842068E-04 1.081579792E+04 2.408740816E+07
+ 2.467854957E+07 1.036274321E+04 7.566040208E-04 1.073511911E+04 2.419179506E+07
+ 2.480984234E+07 1.026415717E+04 7.522259183E-04 1.065444030E+04 2.429630982E+07
+ 2.494113510E+07 1.016538217E+04 7.478501562E-04 1.057376149E+04 2.440129686E+07
+ 2.507242787E+07 1.006716975E+04 7.434769898E-04 1.049308267E+04 2.450676075E+07
+ 2.520372064E+07 9.970293111E+03 7.391066726E-04 1.041240386E+04 2.461372160E+07
+ 2.533501341E+07 9.873229549E+03 7.347394563E-04 1.033172505E+04 2.471915342E+07
+ 2.546630618E+07 9.776740527E+03 7.303755908E-04 1.025104623E+04 2.482708154E+07
+ 2.559759895E+07 9.681574657E+03 7.260153243E-04 1.017036742E+04 2.493454391E+07
+ 2.572889172E+07 9.586285182E+03 7.216589031E-04 1.008968861E+04 2.504248840E+07
+ 2.586018449E+07 9.492265052E+03 7.173065718E-04 1.000900980E+04 2.515095312E+07
+ 2.599147725E+07 9.398050891E+03 7.129585731E-04 9.928330983E+03 2.525994364E+07
+ 2.612277002E+07 9.305179477E+03 7.086151476E-04 9.847652170E+03 2.537050647E+07
+ 2.625406279E+07 9.212098392E+03 7.042765343E-04 9.766973357E+03 2.548056126E+07
+ 2.638535556E+07 9.119591972E+03 6.999429702E-04 9.686294544E+03 2.559117318E+07
+ 2.651664833E+07 9.028430252E+03 6.956146903E-04 9.605615732E+03 2.570242338E+07
+ 2.664794110E+07 8.937052828E+03 6.912919277E-04 9.524936919E+03 2.581415030E+07
+ 2.677923387E+07 8.846255943E+03 6.869749137E-04 9.444258106E+03 2.592752000E+07
+ 2.691052664E+07 8.756765330E+03 6.826638773E-04 9.363579293E+03 2.603934174E+07
+ 2.704181940E+07 8.667855386E+03 6.783590458E-04 9.282900480E+03 2.615386323E+07
+ 2.717311217E+07 8.578180446E+03 6.740606443E-04 9.202221667E+03 2.626792673E+07
+ 2.730440494E+07 8.490437792E+03 6.697688960E-04 9.121542854E+03 2.638260038E+07
+ 2.743569771E+07 8.403215622E+03 6.654840221E-04 9.040864041E+03 2.649899204E+07
+ 2.756699048E+07 8.315780096E+03 6.612062415E-04 8.960185228E+03 2.661490493E+07
+ 2.769828325E+07 8.228909224E+03 6.569357714E-04 8.879506415E+03 2.673144835E+07
+ 2.782957602E+07 8.143357795E+03 6.526728265E-04 8.798827603E+03 2.684976058E+07
+ 2.796086879E+07 8.057615215E+03 6.484176199E-04 8.718148790E+03 2.696760129E+07
+ 2.809216155E+07 7.973182827E+03 6.441703621E-04 8.637469977E+03 2.708610385E+07
+ 2.822345432E+07 7.888532983E+03 6.399312618E-04 8.556791164E+03 2.720567091E+07
+ 2.835474709E+07 7.805211131E+03 6.357005255E-04 8.476112351E+03 2.732554174E+07
+ 2.848603986E+07 7.721672805E+03 6.314783576E-04 8.395433538E+03 2.744724137E+07
+ 2.861733263E+07 7.638695840E+03 6.272649603E-04 8.314754725E+03 2.756852153E+07
+ 2.874862540E+07 7.557082215E+03 6.230605335E-04 8.234075912E+03 2.769051702E+07
+ 2.887991817E+07 7.475973169E+03 6.188652753E-04 8.153397099E+03 2.781439336E+07
+ 2.901121094E+07 7.394631212E+03 6.146793811E-04 8.072718287E+03 2.793788774E+07
+ 2.914250370E+07 7.313843227E+03 6.105030447E-04 7.992039474E+03 2.806211705E+07
+ 2.927379647E+07 7.234365886E+03 6.063364572E-04 7.911360661E+03 2.818828406E+07
+ 2.940508924E+07 7.154682253E+03 6.021798078E-04 7.830681848E+03 2.831406156E+07
+ 2.953638201E+07 7.076295936E+03 5.980332834E-04 7.750003035E+03 2.844064667E+07
+ 2.966767478E+07 6.997679952E+03 5.938970686E-04 7.669324222E+03 2.856920365E+07
+ 2.979896755E+07 6.920375043E+03 5.897713458E-04 7.588645409E+03 2.869873300E+07
+ 2.993026032E+07 6.842844467E+03 5.856562953E-04 7.507966596E+03 2.882776220E+07
+ 3.006155309E+07 6.765864158E+03 5.815520950E-04 7.427287783E+03 2.895765279E+07
+ 3.019284585E+07 6.690471874E+03 5.774589205E-04 7.346608970E+03 2.908965094E+07
+ 3.032413862E+07 6.614545710E+03 5.733769455E-04 7.265930158E+03 2.922129029E+07
+ 3.045543139E+07 6.539925169E+03 5.693063409E-04 7.185251345E+03 2.935511077E+07
+ 3.058672416E+07 6.465067619E+03 5.652472759E-04 7.104572532E+03 2.948856212E+07
+ 3.071801693E+07 6.391510181E+03 5.611999169E-04 7.023893719E+03 2.962422328E+07
+ 3.084930970E+07 6.317707873E+03 5.571644285E-04 6.943214906E+03 2.975956575E+07
+ 3.098060247E+07 6.245216238E+03 5.531409726E-04 6.862536093E+03 2.989715915E+07
+ 3.111189524E+07 6.172473219E+03 5.491297092E-04 6.781857280E+03 3.003445558E+07
+ 3.124318800E+07 6.101019531E+03 5.451307957E-04 6.701178467E+03 3.017318908E+07
+ 3.137448077E+07 6.029322606E+03 5.411443874E-04 6.620499654E+03 3.031391081E+07
+ 3.150577354E+07 5.958914878E+03 5.371706372E-04 6.539820842E+03 3.045561180E+07
+ 3.163706631E+07 5.888316158E+03 5.332096959E-04 6.459142029E+03 3.059840686E+07
+ 3.176835908E+07 5.818941133E+03 5.292617118E-04 6.378463216E+03 3.074091549E+07
+ 3.189965185E+07 5.749315970E+03 5.253268309E-04 6.297784403E+03 3.088457076E+07
+ 3.203094462E+07 5.680972592E+03 5.214051971E-04 6.217105590E+03 3.103070282E+07
+ 3.216223739E+07 5.612375746E+03 5.174969518E-04 6.136426777E+03 3.117799667E+07
+ 3.229353015E+07 5.545072367E+03 5.136022343E-04 6.055747964E+03 3.132649205E+07
+ 3.242482292E+07 5.477488836E+03 5.097211814E-04 5.975069151E+03 3.147622353E+07
+ 3.255611569E+07 5.411184366E+03 5.058539277E-04 5.894390338E+03 3.162586327E+07
+ 3.268740846E+07 5.345398982E+03 5.020006055E-04 5.813711525E+03 3.177808622E+07
+ 3.281870123E+07 5.279320553E+03 4.981613449E-04 5.733032713E+03 3.193017493E+07
+ 3.294999400E+07 5.213758215E+03 4.943362736E-04 5.652353900E+03 3.208500247E+07
+ 3.308128677E+07 5.149722322E+03 4.905255170E-04 5.571675087E+03 3.224118840E+07
+ 3.321257954E+07 5.085153045E+03 4.867291982E-04 5.490996274E+03 3.239879648E+07
+ 3.334387231E+07 5.021096179E+03 4.829474381E-04 5.410317461E+03 3.255779900E+07
+ 3.347516507E+07 4.958275456E+03 4.791803554E-04 5.329638648E+03 3.271824998E+07
+ 3.360645784E+07 4.895960918E+03 4.754280662E-04 5.248959835E+03 3.288019393E+07
+ 3.373775061E+07 4.833378384E+03 4.716906846E-04 5.168281022E+03 3.304263495E+07
+ 3.386904338E+07 4.772038992E+03 4.679683224E-04 5.087602209E+03 3.320763958E+07
+ 3.400033615E+07 4.710418163E+03 4.642610890E-04 5.006923397E+03 3.337424524E+07
+ 3.413162892E+07 4.650048075E+03 4.605690918E-04 4.926244584E+03 3.354247816E+07
+ 3.426292169E+07 4.590165775E+03 4.568924355E-04 4.845565771E+03 3.371241612E+07
+ 3.439421446E+07 4.530047505E+03 4.532312231E-04 4.764886958E+03 3.388403812E+07
+ 3.452550722E+07 4.470356370E+03 4.495855549E-04 4.684208145E+03 3.405742562E+07
+ 3.465679999E+07 4.411893680E+03 4.459555291E-04 4.603529332E+03 3.423261169E+07
+ 3.478809276E+07 4.353915967E+03 4.423412418E-04 4.522850519E+03 3.440978711E+07
+ 3.491938553E+07 4.295639785E+03 4.387427867E-04 4.442171706E+03 3.458872897E+07
+ 3.505067830E+07 4.238617335E+03 4.351602554E-04 4.361492893E+03 3.477133745E+07
+ 3.518197107E+07 4.181276641E+03 4.315937372E-04 4.280814080E+03 3.495423363E+07
+ 3.531326384E+07 4.125167299E+03 4.280433191E-04 4.200135268E+03 3.513924265E+07
+ 3.544455661E+07 4.069531719E+03 4.245090862E-04 4.119456455E+03 3.532632759E+07
+ 3.557584937E+07 4.013575618E+03 4.209911212E-04 4.038777642E+03 3.551560826E+07
+ 3.570714214E+07 3.958098829E+03 4.174895046E-04 3.958098829E+03 3.570714214E+07
+ 3.606505324E+07 3.807971952E+03 4.128673352E-04 3.918769579E+03 3.579982364E+07
+ 3.642296433E+07 3.662532992E+03 3.998804754E-04 3.879440329E+03 3.589326744E+07
+ 3.678087543E+07 3.521690586E+03 3.871803030E-04 3.840111078E+03 3.598746309E+07
+ 3.713878653E+07 3.385342933E+03 3.747655865E-04 3.800781828E+03 3.608247904E+07
+ 3.749669762E+07 3.253398228E+03 3.626348677E-04 3.761452578E+03 3.617830374E+07
+ 3.785460872E+07 3.125733761E+03 3.507864708E-04 3.722123328E+03 3.627492720E+07
+ 3.821251981E+07 3.002259492E+03 3.392185115E-04 3.682794078E+03 3.637239145E+07
+ 3.857043091E+07 2.882877325E+03 3.279289063E-04 3.643464827E+03 3.647074315E+07
+ 3.892834201E+07 2.767484402E+03 3.169153814E-04 3.604135577E+03 3.656997104E+07
+ 3.928625310E+07 2.655984225E+03 3.061754822E-04 3.564806327E+03 3.667006530E+07
+ 3.964416420E+07 2.548279139E+03 2.957065825E-04 3.525477077E+03 3.677110182E+07
+ 4.000207529E+07 2.444284665E+03 2.855058933E-04 3.486147827E+03 3.687307118E+07
+ 4.035998639E+07 2.343881759E+03 2.755704718E-04 3.446818577E+03 3.697596472E+07
+ 4.071789748E+07 2.246998643E+03 2.658972309E-04 3.407489326E+03 3.707986239E+07
+ 4.107580858E+07 2.153516965E+03 2.564829476E-04 3.368160076E+03 3.718475376E+07
+ 4.143371968E+07 2.063372913E+03 2.473242717E-04 3.328830826E+03 3.729063310E+07
+ 4.179163077E+07 1.976450830E+03 2.384177351E-04 3.289501576E+03 3.739758244E+07
+ 4.214954187E+07 1.892671578E+03 2.297597597E-04 3.250172326E+03 3.750559541E+07
+ 4.250745296E+07 1.811947437E+03 2.213466660E-04 3.210843075E+03 3.761466666E+07
+ 4.286536406E+07 1.734201850E+03 2.131746816E-04 3.171513825E+03 3.772488265E+07
+ 4.322327516E+07 1.659327246E+03 2.052399489E-04 3.132184575E+03 3.783623835E+07
+ 4.358118625E+07 1.587252395E+03 1.975385333E-04 3.092855325E+03 3.794873030E+07
+ 4.393909735E+07 1.517901891E+03 1.900664310E-04 3.053526075E+03 3.806244968E+07
+ 4.429700844E+07 1.451174259E+03 1.828195764E-04 3.014196825E+03 3.817739422E+07
+ 4.465491954E+07 1.387000337E+03 1.757938495E-04 2.974867574E+03 3.829356173E+07
+ 4.501283063E+07 1.325313604E+03 1.689850832E-04 2.935538324E+03 3.841105519E+07
+ 4.537074173E+07 1.266013927E+03 1.623890700E-04 2.896209074E+03 3.852986328E+07
+ 4.572865283E+07 1.209048467E+03 1.560015693E-04 2.856879824E+03 3.864999191E+07
+ 4.608656392E+07 1.154324399E+03 1.498183134E-04 2.817550574E+03 3.877154484E+07
+ 4.644447502E+07 1.101781936E+03 1.438350142E-04 2.778221323E+03 3.889452486E+07
+ 4.680238611E+07 1.051338036E+03 1.380473692E-04 2.738892073E+03 3.901897107E+07
+ 4.716029721E+07 1.002931004E+03 1.324510674E-04 2.699562823E+03 3.914492282E+07
+ 4.751820831E+07 9.565049271E+02 1.270417949E-04 2.660233573E+03 3.927238686E+07
+ 4.787611940E+07 9.119812592E+02 1.218152405E-04 2.620904323E+03 3.940147836E+07
+ 4.823403050E+07 8.692851985E+02 1.167671009E-04 2.581575073E+03 3.953220710E+07
+ 4.859194159E+07 8.283641841E+02 1.118930856E-04 2.542245822E+03 3.966462247E+07
+ 4.894985269E+07 7.891702340E+02 1.071889217E-04 2.502916572E+03 3.979877107E+07
+ 4.930776378E+07 7.516280288E+02 1.026503585E-04 2.463587322E+03 3.993466823E+07
+ 4.966567488E+07 7.156700578E+02 9.827317176E-05 2.424258072E+03 4.007248401E+07
+ 5.002358598E+07 6.812617781E+02 9.405316785E-05 2.384928822E+03 4.021212130E+07
+ 5.038149707E+07 6.483247988E+02 8.998618753E-05 2.345599572E+03 4.035375627E+07
+ 5.073940817E+07 6.168275628E+02 8.606810967E-05 2.306270321E+03 4.049741245E+07
+ 5.109731926E+07 5.867030888E+02 8.229485468E-05 2.266941071E+03 4.064315633E+07
+ 5.145523036E+07 5.578957849E+02 7.866238772E-05 2.227611821E+03 4.079105716E+07
+ 5.181314146E+07 5.303751987E+02 7.516672169E-05 2.188282571E+03 4.094116790E+07
+ 5.217105255E+07 5.040819496E+02 7.180392007E-05 2.148953321E+03 4.109361278E+07
+ 5.252896365E+07 4.789573424E+02 6.857009949E-05 2.109624070E+03 4.124843800E+07
+ 5.288687474E+07 4.549788179E+02 6.546143216E-05 2.070294820E+03 4.140573641E+07
+ 5.324478584E+07 4.320925938E+02 6.247414804E-05 2.030965570E+03 4.156559803E+07
+ 5.360269693E+07 4.102412583E+02 5.960453691E-05 1.991636320E+03 4.172811858E+07
+ 5.396060803E+07 3.894075986E+02 5.684895015E-05 1.952307070E+03 4.189339800E+07
+ 5.431851913E+07 3.695404569E+02 5.420380243E-05 1.912977820E+03 4.206159105E+07
+ 5.467643022E+07 3.505889088E+02 5.166557320E-05 1.873648569E+03 4.223266812E+07
+ 5.503434132E+07 3.325495159E+02 4.923080795E-05 1.834319319E+03 4.240694442E+07
+ 5.539225241E+07 3.153466366E+02 4.689611941E-05 1.794990069E+03 4.258439724E+07
+ 5.575016351E+07 2.989565664E+02 4.465818853E-05 1.755660819E+03 4.276521301E+07
+ 5.610807461E+07 2.833723208E+02 4.251376530E-05 1.716331569E+03 4.294953757E+07
+ 5.646598570E+07 2.685171412E+02 4.045966946E-05 1.677002318E+03 4.313752445E+07
+ 5.682389680E+07 2.543839105E+02 3.849279104E-05 1.637673068E+03 4.332939522E+07
+ 5.718180789E+07 2.409556214E+02 3.661009080E-05 1.598343818E+03 4.352522744E+07
+ 5.753971899E+07 2.281784341E+02 3.480860048E-05 1.559014568E+03 4.372524587E+07
+ 5.789763008E+07 2.160320614E+02 3.308542299E-05 1.519685318E+03 4.392972244E+07
+ 5.825554118E+07 2.044882018E+02 3.143773248E-05 1.480356068E+03 4.413876305E+07
+ 5.861345228E+07 1.935096833E+02 2.986277421E-05 1.441026817E+03 4.435265929E+07
+ 5.897136337E+07 1.831061550E+02 2.835786444E-05 1.401697567E+03 4.457173178E+07
+ 5.932927447E+07 1.732049367E+02 2.692039013E-05 1.362368317E+03 4.479619865E+07
+ 5.968718556E+07 1.638284165E+02 2.554780857E-05 1.323039067E+03 4.502629477E+07
+ 6.004509666E+07 1.549100847E+02 2.423764696E-05 1.283709817E+03 4.526240799E+07
+ 6.040300776E+07 1.464712964E+02 2.298750182E-05 1.244380566E+03 4.550496892E+07
+ 6.076091885E+07 1.384472489E+02 2.179503840E-05 1.205051316E+03 4.575430014E+07
+ 6.111882995E+07 1.308587120E+02 2.065798999E-05 1.165722066E+03 4.601085027E+07
+ 6.147674104E+07 1.236595215E+02 1.957415714E-05 1.126392816E+03 4.627494375E+07
+ 6.183465214E+07 1.168392329E+02 1.854140685E-05 1.087063566E+03 4.654735141E+07
+ 6.219256323E+07 1.103790650E+02 1.755767172E-05 1.047734316E+03 4.682851562E+07
+ 6.255047433E+07 1.042623917E+02 1.662094892E-05 1.008405065E+03 4.711909176E+07
+ 6.290838543E+07 9.847442039E+01 1.572929931E-05 9.690758152E+02 4.741979449E+07
+ 6.326629652E+07 9.300680082E+01 1.488084634E-05 9.297465650E+02 4.773143061E+07
+ 6.362420762E+07 8.781294333E+01 1.407377501E-05 8.904173148E+02 4.805499274E+07
+ 6.398211871E+07 8.292345201E+01 1.330633076E-05 8.510880646E+02 4.839132161E+07
+ 6.434002981E+07 7.828992274E+01 1.257681829E-05 8.117588145E+02 4.874179090E+07
+ 6.469794091E+07 7.391369442E+01 1.188360046E-05 7.724295643E+02 4.910750733E+07
+ 6.505585200E+07 6.978378760E+01 1.122509705E-05 7.331003141E+02 4.949023167E+07
+ 6.541376310E+07 6.587568854E+01 1.059978355E-05 6.937710639E+02 4.989165455E+07
+ 6.577167419E+07 6.219664197E+01 1.000618993E-05 6.544418137E+02 5.031386505E+07
+ 6.612958529E+07 5.870200399E+01 9.442899417E-06 6.151125636E+02 5.075933990E+07
+ 6.648749639E+07 5.542588904E+01 8.908547184E-06 5.757833134E+02 5.123113194E+07
+ 6.684540748E+07 5.232630342E+01 8.401819136E-06 5.364540632E+02 5.173262338E+07
+ 6.720331858E+07 4.941238704E+01 7.921450608E-06 4.971248130E+02 5.226843569E+07
+ 6.756122967E+07 4.665489525E+01 7.466225093E-06 4.577955628E+02 5.284402042E+07
+ 6.791914077E+07 4.406639199E+01 7.034972974E-06 4.184663127E+02 5.346613099E+07
+ 6.827705186E+07 4.161154469E+01 6.626570238E-06 3.791370625E+02 5.414339108E+07
+ 6.863496296E+07 3.931696029E+01 6.239937213E-06 3.398078123E+02 5.488816988E+07
+ 6.899287406E+07 3.715466992E+01 5.874037301E-06 3.004785621E+02 5.571623000E+07
+ 6.935078515E+07 3.510910516E+01 5.527875723E-06 2.611493119E+02 5.665065328E+07
+ 6.970869625E+07 3.318314771E+01 5.200498269E-06 2.218200618E+02 5.772494462E+07
+ 7.006660734E+07 3.138392820E+01 4.890990068E-06 1.824908116E+02 5.899302921E+07
+ 7.042451844E+07 2.969020130E+01 4.598474364E-06 1.431615614E+02 6.054793929E+07
+ 7.078242954E+07 2.808732981E+01 4.322111307E-06 1.038323112E+02 6.257691024E+07
+ 7.114034063E+07 2.659103730E+01 4.061096769E-06 6.450306104E+01 6.554439540E+07
+ 7.149825173E+07 2.517381086E+01 3.814661162E-06 2.517381086E+01 7.149825173E+07
+ 7.191640645E+07 2.357663597E+01 3.704934214E-06 2.492214384E+01 7.156248281E+07
+ 7.233456117E+07 2.207361090E+01 3.485944007E-06 2.467047683E+01 7.162731612E+07
+ 7.275271589E+07 2.065967114E+01 3.278754248E-06 2.441880981E+01 7.169276583E+07
+ 7.317087061E+07 1.932998948E+01 3.082803992E-06 2.416714280E+01 7.175883456E+07
+ 7.358902533E+07 1.807999810E+01 2.897554276E-06 2.391547579E+01 7.182554975E+07
+ 7.400718005E+07 1.690530021E+01 2.722487544E-06 2.366380877E+01 7.189291711E+07
+ 7.442533477E+07 1.580182808E+01 2.557107063E-06 2.341214176E+01 7.196095016E+07
+ 7.484348949E+07 1.476548915E+01 2.400936340E-06 2.316047475E+01 7.202965764E+07
+ 7.526164421E+07 1.379266104E+01 2.253518541E-06 2.290880773E+01 7.209905912E+07
+ 7.567979893E+07 1.287970456E+01 2.114415911E-06 2.265714072E+01 7.216917719E+07
+ 7.609795365E+07 1.202324869E+01 1.983209195E-06 2.240547370E+01 7.224001677E+07
+ 7.651610837E+07 1.122008537E+01 1.859497070E-06 2.215380669E+01 7.231159363E+07
+ 7.693426310E+07 1.046713022E+01 1.742895570E-06 2.190213968E+01 7.238392790E+07
+ 7.735241782E+07 9.761552539E+00 1.633037531E-06 2.165047266E+01 7.245702791E+07
+ 7.777057254E+07 9.100532799E+00 1.529572030E-06 2.139880565E+01 7.253092788E+07
+ 7.818872726E+07 8.481487417E+00 1.432163841E-06 2.114713863E+01 7.260563677E+07
+ 7.860688198E+07 7.901992245E+00 1.340492890E-06 2.089547162E+01 7.268117331E+07
+ 7.902503670E+07 7.359682488E+00 1.254253727E-06 2.064380461E+01 7.275755695E+07
+ 7.944319142E+07 6.852339811E+00 1.173155003E-06 2.039213759E+01 7.283480780E+07
+ 7.986134614E+07 6.377869220E+00 1.096918956E-06 2.014047058E+01 7.291293474E+07
+ 8.027950086E+07 5.934335961E+00 1.025280909E-06 1.988880356E+01 7.299198635E+07
+ 8.069765558E+07 5.519829218E+00 9.579887769E-07 1.963713655E+01 7.307196406E+07
+ 8.111581030E+07 5.132567006E+00 8.948025843E-07 1.938546954E+01 7.315289730E+07
+ 8.153396502E+07 4.770954072E+00 8.354939961E-07 1.913380252E+01 7.323481306E+07
+ 8.195211974E+07 4.433351422E+00 7.798458575E-07 1.888213551E+01 7.331772433E+07
+ 8.237027446E+07 4.118261876E+00 7.276517457E-07 1.863046849E+01 7.340167568E+07
+ 8.278842918E+07 3.824350219E+00 6.787155342E-07 1.837880148E+01 7.348668505E+07
+ 8.320658391E+07 3.550225215E+00 6.328509674E-07 1.812713447E+01 7.357277676E+07
+ 8.362473863E+07 3.294709567E+00 5.898812484E-07 1.787546745E+01 7.365997914E+07
+ 8.404289335E+07 3.056527721E+00 5.496386378E-07 1.762380044E+01 7.374834022E+07
+ 8.446104807E+07 2.834637453E+00 5.119640646E-07 1.737213343E+01 7.383787289E+07
+ 8.487920279E+07 2.628036880E+00 4.767067490E-07 1.712046641E+01 7.392860711E+07
+ 8.529735751E+07 2.435670290E+00 4.437238368E-07 1.686879940E+01 7.402060117E+07
+ 8.571551223E+07 2.256639972E+00 4.128800462E-07 1.661713238E+01 7.411387796E+07
+ 8.613366695E+07 2.090093034E+00 3.840473251E-07 1.636546537E+01 7.420847544E+07
+ 8.655182167E+07 1.935200937E+00 3.571045212E-07 1.611379836E+01 7.430443326E+07
+ 8.696997639E+07 1.791209856E+00 3.319370624E-07 1.586213134E+01 7.440179293E+07
+ 8.738813111E+07 1.657362460E+00 3.084366496E-07 1.561046433E+01 7.450058472E+07
+ 8.780628583E+07 1.533012971E+00 2.865009592E-07 1.535879731E+01 7.460087672E+07
+ 8.822444055E+07 1.417579818E+00 2.660333580E-07 1.510713030E+01 7.470270745E+07
+ 8.864259527E+07 1.310356084E+00 2.469426277E-07 1.485546329E+01 7.480611896E+07
+ 8.906074999E+07 1.210849184E+00 2.291427005E-07 1.460379627E+01 7.491118337E+07
+ 8.947890472E+07 1.118529197E+00 2.125524044E-07 1.435212926E+01 7.501794447E+07
+ 8.989705944E+07 1.032909137E+00 1.970952198E-07 1.410046224E+01 7.512644421E+07
+ 9.031521416E+07 9.535699617E-01 1.826990442E-07 1.384879523E+01 7.523678051E+07
+ 9.073336888E+07 8.800052572E-01 1.692959679E-07 1.359712822E+01 7.534898913E+07
+ 9.115152360E+07 8.118686256E-01 1.568220588E-07 1.334546120E+01 7.546313389E+07
+ 9.156967832E+07 7.487408122E-01 1.452171555E-07 1.309379419E+01 7.557931648E+07
+ 9.198783304E+07 6.902960022E-01 1.344246701E-07 1.284212717E+01 7.569759599E+07
+ 9.240598776E+07 6.362087300E-01 1.243913996E-07 1.259046016E+01 7.581805296E+07
+ 9.282414248E+07 5.861683975E-01 1.150673449E-07 1.233879315E+01 7.594075863E+07
+ 9.324229720E+07 5.398834593E-01 1.064055387E-07 1.208712613E+01 7.606582676E+07
+ 9.366045192E+07 4.970942871E-01 9.836188079E-08 1.183545912E+01 7.619334430E+07
+ 9.407860664E+07 4.575443651E-01 9.089498100E-08 1.158379210E+01 7.632340335E+07
+ 9.449676136E+07 4.210029837E-01 8.396600950E-08 1.133212509E+01 7.645613695E+07
+ 9.491491608E+07 3.872553024E-01 7.753855416E-08 1.108045808E+01 7.659163403E+07
+ 9.533307080E+07 3.560909521E-01 7.157848476E-08 1.082879106E+01 7.673003589E+07
+ 9.575122553E+07 3.273254655E-01 6.605382365E-08 1.057712405E+01 7.687145648E+07
+ 9.616938025E+07 3.007888107E-01 6.093462292E-08 1.032545704E+01 7.701607196E+07
+ 9.658753497E+07 2.763205372E-01 5.619284748E-08 1.007379002E+01 7.716400098E+07
+ 9.700568969E+07 2.537494465E-01 5.180226410E-08 9.822123008E+00 7.731543165E+07
+ 9.742384441E+07 2.329707783E-01 4.773833603E-08 9.570455994E+00 7.747052745E+07
+ 9.784199913E+07 2.137837580E-01 4.397812305E-08 9.318788980E+00 7.762945681E+07
+ 9.826015385E+07 1.961248658E-01 4.050018662E-08 9.067121966E+00 7.779245490E+07
+ 9.867830857E+07 1.798581646E-01 3.728450007E-08 8.815454952E+00 7.795972786E+07
+ 9.909646329E+07 1.649152953E-01 3.431236349E-08 8.563787938E+00 7.813153375E+07
+ 9.951461801E+07 1.511403426E-01 3.156632314E-08 8.312120924E+00 7.830812051E+07
+ 9.993277273E+07 1.384862772E-01 2.903009527E-08 8.060453910E+00 7.848975469E+07
+ 1.003509275E+08 1.268439719E-01 2.668849401E-08 7.808786896E+00 7.867680495E+07
+ 1.007690822E+08 1.161202998E-01 2.452736327E-08 7.557119882E+00 7.886956119E+07
+ 1.011872369E+08 1.063126412E-01 2.253351242E-08 7.305452868E+00 7.906841972E+07
+ 1.016053916E+08 9.727468126E-02 2.069465551E-08 7.053785854E+00 7.927379054E+07
+ 1.020235463E+08 8.900241843E-02 1.899935399E-08 6.802118841E+00 7.948612947E+07
+ 1.024417011E+08 8.134263122E-02 1.743696268E-08 6.550451827E+00 7.970598352E+07
+ 1.028598558E+08 7.438052097E-02 1.599757878E-08 6.298784813E+00 7.993387293E+07
+ 1.032780105E+08 6.797052319E-02 1.467199394E-08 6.047117799E+00 8.017048774E+07
+ 1.036961652E+08 6.210816152E-02 1.345164906E-08 5.795450785E+00 8.041646766E+07
+ 1.041143199E+08 5.669101714E-02 1.232859177E-08 5.543783771E+00 8.067269821E+07
+ 1.045324747E+08 5.177599034E-02 1.129543647E-08 5.292116757E+00 8.094008018E+07
+ 1.049506294E+08 4.723006937E-02 1.034532668E-08 5.040449743E+00 8.121964882E+07
+ 1.053687841E+08 4.311052898E-02 9.471899811E-09 4.788782729E+00 8.151266023E+07
+ 1.057869388E+08 3.933196550E-02 8.669253913E-09 4.537115715E+00 8.182048307E+07
+ 1.062050935E+08 3.585029353E-02 7.931916595E-09 4.285448701E+00 8.214480869E+07
+ 1.066232483E+08 3.267803956E-02 7.254815799E-09 4.033781687E+00 8.248752921E+07
+ 1.070414030E+08 2.977620595E-02 6.633252421E-09 3.782114674E+00 8.285095656E+07
+ 1.074595577E+08 2.712343522E-02 6.062874642E-09 3.530447660E+00 8.323792398E+07
+ 1.078777124E+08 2.469851027E-02 5.539653890E-09 3.278780646E+00 8.365180963E+07
+ 1.082958671E+08 2.247963800E-02 5.059862326E-09 3.027113632E+00 8.409666553E+07
+ 1.087140219E+08 2.046130576E-02 4.620051782E-09 2.775446618E+00 8.457784769E+07
+ 1.091321766E+08 1.861555333E-02 4.217034058E-09 2.523779604E+00 8.510206859E+07
+ 1.095503313E+08 1.691212894E-02 3.847862500E-09 2.272112590E+00 8.567814583E+07
+ 1.099684860E+08 1.538427972E-02 3.509814791E-09 2.020445576E+00 8.631792844E+07
+ 1.103866407E+08 1.399117513E-02 3.200376871E-09 1.768778562E+00 8.703789791E+07
+ 1.108047955E+08 1.271743953E-02 2.917227932E-09 1.517111548E+00 8.786209101E+07
+ 1.112229502E+08 1.156945769E-02 2.658226413E-09 1.265444534E+00 8.882748420E+07
+ 1.116411049E+08 1.048608937E-02 2.421396944E-09 1.013777521E+00 8.999507030E+07
+ 1.120592596E+08 9.532136316E-03 2.204918164E-09 7.621105066E-01 9.147828248E+07
+ 1.124774144E+08 8.642979626E-03 2.007111383E-09 5.104434927E-01 9.352654443E+07
+ 1.128955691E+08 7.839148949E-03 1.826430019E-09 2.587764788E-01 9.690940557E+07
+ 1.133137238E+08 7.109464853E-03 1.661449755E-09 7.109464853E-03 1.133137579E+08
+ 1.133848184E+08 7.038370204E-03 1.000000000E-09 7.038370204E-03 1.133848170E+08
+ 1.134559131E+08 6.967275555E-03 1.000000000E-09 6.967275555E-03 1.134559130E+08
+ 1.135270077E+08 6.896180907E-03 1.000000000E-09 6.896180907E-03 1.135270077E+08
+ 1.135981024E+08 6.825086258E-03 1.000000000E-09 6.825086258E-03 1.135981024E+08
+ 1.136691970E+08 6.753991610E-03 1.000000000E-09 6.753991610E-03 1.136691980E+08
+ 1.137402917E+08 6.682896961E-03 1.000000000E-09 6.682896961E-03 1.137402890E+08
+ 1.138113863E+08 6.611802313E-03 1.000000000E-09 6.611802313E-03 1.138114080E+08
+ 1.138824810E+08 6.540707664E-03 1.000000000E-09 6.540707664E-03 1.138824810E+08
+ 1.139535756E+08 6.469613016E-03 1.000000000E-09 6.469613016E-03 1.139535520E+08
+ 1.140246703E+08 6.398518367E-03 1.000000000E-09 6.398518367E-03 1.140246702E+08
+ 1.140957649E+08 6.327423719E-03 1.000000000E-09 6.327423719E-03 1.140957760E+08
+ 1.141668596E+08 6.256329070E-03 1.000000000E-09 6.256329070E-03 1.141668594E+08
+ 1.142379542E+08 6.185234422E-03 1.000000000E-09 6.185234422E-03 1.142379520E+08
+ 1.143090489E+08 6.114139773E-03 1.000000000E-09 6.114139773E-03 1.143090490E+08
+ 1.143801435E+08 6.043045125E-03 1.000000000E-09 6.043045125E-03 1.143801435E+08
+ 1.144512382E+08 5.971950476E-03 1.000000000E-09 5.971950476E-03 1.144512380E+08
+ 1.145223328E+08 5.900855828E-03 1.000000000E-09 5.900855828E-03 1.145223310E+08
+ 1.145934275E+08 5.829761179E-03 1.000000000E-09 5.829761179E-03 1.145934270E+08
+ 1.146645221E+08 5.758666531E-03 1.000000000E-09 5.758666531E-03 1.146645440E+08
+ 1.147356168E+08 5.687571882E-03 1.000000000E-09 5.687571882E-03 1.147356480E+08
+ 1.148067114E+08 5.616477233E-03 1.000000000E-09 5.616477233E-03 1.148067110E+08
+ 1.148778061E+08 5.545382585E-03 1.000000000E-09 5.545382585E-03 1.148778060E+08
+ 1.149489007E+08 5.474287936E-03 1.000000000E-09 5.474287936E-03 1.149489008E+08
+ 1.150199954E+08 5.403193288E-03 1.000000000E-09 5.403193288E-03 1.150199977E+08
+ 1.150910900E+08 5.332098639E-03 1.000000000E-09 5.332098639E-03 1.150912000E+08
+ 1.151621847E+08 5.261003991E-03 1.000000000E-09 5.261003991E-03 1.151622763E+08
+ 1.152332793E+08 5.189909342E-03 1.000000000E-09 5.189909342E-03 1.152332960E+08
+ 1.153043740E+08 5.118814694E-03 1.000000000E-09 5.118814694E-03 1.153043739E+08
+ 1.153754686E+08 5.047720045E-03 1.000000000E-09 5.047720045E-03 1.153754720E+08
+ 1.154465632E+08 4.976625397E-03 1.000000000E-09 4.976625397E-03 1.154465636E+08
+ 1.155176579E+08 4.905530748E-03 1.000000000E-09 4.905530748E-03 1.155176579E+08
+ 1.155887525E+08 4.834436100E-03 1.000000000E-09 4.834436100E-03 1.155887526E+08
+ 1.156598472E+08 4.763341451E-03 1.000000000E-09 4.763341451E-03 1.156598400E+08
+ 1.157309418E+08 4.692246803E-03 1.000000000E-09 4.692246803E-03 1.157309418E+08
+ 1.158020365E+08 4.621152154E-03 1.000000000E-09 4.621152154E-03 1.158020365E+08
+ 1.158731311E+08 4.550057506E-03 1.000000000E-09 4.550057506E-03 1.158731310E+08
+ 1.159442258E+08 4.478962857E-03 1.000000000E-09 4.478962857E-03 1.159442250E+08
+ 1.160153204E+08 4.407868209E-03 1.000000000E-09 4.407868209E-03 1.160153190E+08
+ 1.160864151E+08 4.336773560E-03 1.000000000E-09 4.336773560E-03 1.160864075E+08
+ 1.161575097E+08 4.265678912E-03 1.000000000E-09 4.265678912E-03 1.161575100E+08
+ 1.162286044E+08 4.194584263E-03 1.000000000E-09 4.194584263E-03 1.162286044E+08
+ 1.162996990E+08 4.123489614E-03 1.000000000E-09 4.123489614E-03 1.162996989E+08
+ 1.163707937E+08 4.052394966E-03 1.000000000E-09 4.052394966E-03 1.163708000E+08
+ 1.164418883E+08 3.981300317E-03 1.000000000E-09 3.981300317E-03 1.164418880E+08
+ 1.165129830E+08 3.910205669E-03 1.000000000E-09 3.910205669E-03 1.165129920E+08
+ 1.165840776E+08 3.839111020E-03 1.000000000E-09 3.839111020E-03 1.165840760E+08
+ 1.166551723E+08 3.768016372E-03 1.000000000E-09 3.768016372E-03 1.166551680E+08
+ 1.167262669E+08 3.696921723E-03 1.000000000E-09 3.696921723E-03 1.167262690E+08
+ 1.167973616E+08 3.625827075E-03 1.000000000E-09 3.625827075E-03 1.167974400E+08
+ 1.168684562E+08 3.554732426E-03 1.000000000E-09 3.554732426E-03 1.168684550E+08
+ 1.169395509E+08 3.483637778E-03 1.000000000E-09 3.483637778E-03 1.169396634E+08
+ 1.170106455E+08 3.412543129E-03 1.000000000E-09 3.412543129E-03 1.170106560E+08
+ 1.170817402E+08 3.341448481E-03 1.000000000E-09 3.341448481E-03 1.170817410E+08
+ 1.171528348E+08 3.270353832E-03 1.000000000E-09 3.270353832E-03 1.171528348E+08
+ 1.172239295E+08 3.199259184E-03 1.000000000E-09 3.199259184E-03 1.172239295E+08
+ 1.172950241E+08 3.128164535E-03 1.000000000E-09 3.128164535E-03 1.172950250E+08
+ 1.173661188E+08 3.057069887E-03 1.000000000E-09 3.057069887E-03 1.173661189E+08
+ 1.174372134E+08 2.985975238E-03 1.000000000E-09 2.985975238E-03 1.174372150E+08
+ 1.175083081E+08 2.914880590E-03 1.000000000E-09 2.914880590E-03 1.175083200E+08
+ 1.175794027E+08 2.843785941E-03 1.000000000E-09 2.843785941E-03 1.175794027E+08
+ 1.176504974E+08 2.772691292E-03 1.000000000E-09 2.772691292E-03 1.176505920E+08
+ 1.177215920E+08 2.701596644E-03 1.000000000E-09 2.701596644E-03 1.177215920E+08
+ 1.177926867E+08 2.630501995E-03 1.000000000E-09 2.630501995E-03 1.177927680E+08
+ 1.178637813E+08 2.559407347E-03 1.000000000E-09 2.559407347E-03 1.178637920E+08
+ 1.179348759E+08 2.488312698E-03 1.000000000E-09 2.488312698E-03 1.179348800E+08
+ 1.180059706E+08 2.417218050E-03 1.000000000E-09 2.417218050E-03 1.180059713E+08
+ 1.180770652E+08 2.346123401E-03 1.000000000E-09 2.346123401E-03 1.180770652E+08
+ 1.181481599E+08 2.275028753E-03 1.000000000E-09 2.275028753E-03 1.181481599E+08
+ 1.182192545E+08 2.203934104E-03 1.000000000E-09 2.203934104E-03 1.182192640E+08
+ 1.182903492E+08 2.132839456E-03 1.000000000E-09 2.132839456E-03 1.182904320E+08
+ 1.183614438E+08 2.061744807E-03 1.000000000E-09 2.061744807E-03 1.183614438E+08
+ 1.184325385E+08 1.990650159E-03 1.000000000E-09 1.990650159E-03 1.184325940E+08
+ 1.185036331E+08 1.919555510E-03 1.000000000E-09 1.919555510E-03 1.185037048E+08
+ 1.185747278E+08 1.848460862E-03 1.000000000E-09 1.848460862E-03 1.185747278E+08
+ 1.186458224E+08 1.777366213E-03 1.000000000E-09 1.777366213E-03 1.186458224E+08
+ 1.187169171E+08 1.706271565E-03 1.000000000E-09 1.706271565E-03 1.187169225E+08
+ 1.187880117E+08 1.635176916E-03 1.000000000E-09 1.635176916E-03 1.187880160E+08
+ 1.188591064E+08 1.564082268E-03 1.000000000E-09 1.564082268E-03 1.188591067E+08
+ 1.189302010E+08 1.492987619E-03 1.000000000E-09 1.492987619E-03 1.189302010E+08
+ 1.190012957E+08 1.421892971E-03 1.000000000E-09 1.421892971E-03 1.190012960E+08
+ 1.190723903E+08 1.350798322E-03 1.000000000E-09 1.350798322E-03 1.190723903E+08
+ 1.191434850E+08 1.279703673E-03 1.000000000E-09 1.279703673E-03 1.191434880E+08
+ 1.192145796E+08 1.208609025E-03 1.000000000E-09 1.208609025E-03 1.192145760E+08
+ 1.192856743E+08 1.137514376E-03 1.000000000E-09 1.137514376E-03 1.192857600E+08
+ 1.193567689E+08 1.066419728E-03 1.000000000E-09 1.066419728E-03 1.193567689E+08
+ 1.194278636E+08 9.953250794E-04 1.000000000E-09 9.953250794E-04 1.194278678E+08
+ 1.194989582E+08 9.242304308E-04 1.000000000E-09 9.242304308E-04 1.194989582E+08
+ 1.195700529E+08 8.531357823E-04 1.000000000E-09 8.531357823E-04 1.195700530E+08
+ 1.196411475E+08 7.820411338E-04 1.000000000E-09 7.820411338E-04 1.196412606E+08
+ 1.197122422E+08 7.109464853E-04 1.000000000E-09 7.109464853E-04 1.197122720E+08
+ 1.197833368E+08 6.398518367E-04 1.000000000E-09 6.398518367E-04 1.197833804E+08
+ 1.198544315E+08 5.687571882E-04 1.000000000E-09 5.687571882E-04 1.198544320E+08
+ 1.199255261E+08 4.976625397E-04 1.000000000E-09 4.976625397E-04 1.199255040E+08
+ 1.199966208E+08 4.265678912E-04 1.000000000E-09 4.265678912E-04 1.199966720E+08
+ 1.200677154E+08 3.554732426E-04 1.000000000E-09 3.554732426E-04 1.200677154E+08
+ 1.201388101E+08 2.843785941E-04 1.000000000E-09 2.843785941E-04 1.201388160E+08
+ 1.202099047E+08 2.132839456E-04 1.000000000E-09 2.132839456E-04 1.202099200E+08
+ 1.202809993E+08 1.421892971E-04 1.000000000E-09 1.421892971E-04 1.202809993E+08
+ 1.203520940E+08 7.109464853E-05 1.000000000E-09 7.109464853E-05 1.203520950E+08
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/EGSDAT2
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/EGSDAT2	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/EGSDAT2	(revision 286)
@@ -0,0 +1,2621 @@
+ MEDIUM=AIR-NTP                 ,STERNCID=AIR-NTP                 
+ MIXT,RHO= 1.2250E-09,NE= 4,GASP= 1.0000E-06
+ ASYM=N ,Z= 7.,A=   14.007,PZ= 5.39228E-02,RHOZ= 7.55280E-01
+ ASYM=O ,Z= 8.,A=   15.999,PZ= 1.44793E-02,RHOZ= 2.31660E-01
+ ASYM=AR,Z=18.,A=   39.948,PZ= 3.20917E-04,RHOZ= 1.28200E-02
+ ASYM=C ,Z= 6.,A=   12.011,PZ= 3.33024E-06,RHOZ= 4.00000E-05
+    2.98933E+10   3.51200E+00   3.00000E+00   1.00000E+14   1.00000E+14
+     0  500    0  500    0    0    0    0    0
+    9.99982E-01  -2.10419E-01   4.82862E-02   9.95879E-01  -2.25858E-01
+    9.52000E-01   1.00022E+00  -1.78214E-01   3.43565E-02   1.01413E+00
+   -2.29996E-01   9.52000E-01   1.00034E+00  -1.61665E-01   2.48128E-02
+    1.02350E+00  -2.32123E-01   9.52000E-01   9.99982E-01  -2.10592E-01
+    4.83260E-02   9.95876E-01  -2.26044E-01   9.52000E-01   1.00022E+00
+   -1.78364E-01   3.43853E-02   1.01414E+00  -2.30189E-01   9.52000E-01
+    1.00034E+00  -1.61802E-01   2.48338E-02   1.02352E+00  -2.32319E-01
+    9.52000E-01
+    3.56389E+01   9.41131E-01   8.53760E-01   2.28015E+00   9.41145E-01
+    8.53757E-01   2.27175E+00
+    9.00118E-02   7.50905E-05   2.66396E+05   4.89667E+00
+   -1.46083E+01   1.59637E+01
+   -8.04319E-02   7.32113E-02   8.78001E-01   9.98452E-02   5.71660E+01
+    7.57054E+00   5.79697E+01   5.34237E+00   1.00000E+00   0.00000E+00
+   -8.13948E-02   7.40878E-02  -8.38576E-01   7.63096E-01  -2.52360E-02
+    5.46241E-02  -8.04319E-02   7.32113E-02   8.78001E-01   9.98452E-02
+    5.71660E+01   7.57054E+00   5.79697E+01   5.34237E+00   1.00000E+00
+    0.00000E+00  -8.13948E-02   7.40878E-02  -8.38576E-01   7.63096E-01
+   -2.52360E-02   5.46241E-02  -1.28801E-01   1.17063E-01   8.68294E-01
+    1.08651E-01   5.71195E+01   7.61280E+00   5.78330E+01   5.46541E+00
+    1.00000E+00   0.00000E+00  -1.29414E-01   1.17622E-01  -8.29965E-01
+    7.55290E-01  -2.88402E-02   5.78915E-02  -2.11881E-01   1.88336E-01
+    8.50618E-01   1.23813E-01   5.70182E+01   7.69978E+00   5.75838E+01
+    5.67923E+00   1.00000E+00   0.00000E+00  -2.10144E-01   1.86878E-01
+   -8.09705E-01   7.37909E-01  -3.65706E-02   6.45233E-02  -2.86440E-01
+    2.49036E-01   8.29874E-01   1.40702E-01   5.68593E+01   7.82911E+00
+    5.73008E+01   5.90965E+00   1.00000E+00   0.00000E+00  -2.79696E-01
+    2.43502E-01  -7.88228E-01   7.20424E-01  -4.56900E-02   7.19476E-02
+   -3.58949E-01   3.05203E-01   8.00491E-01   1.63464E-01   5.65925E+01
+    8.03579E+00   5.69322E+01   6.19513E+00   1.00000E+00   0.00000E+00
+   -3.43803E-01   2.93161E-01  -7.69622E-01   7.06011E-01  -5.64218E-02
+    8.02606E-02  -4.27723E-01   3.56011E-01   7.65057E-01   1.89640E-01
+    5.64529E+01   8.13884E+00   5.67119E+01   6.35798E+00   1.00000E+00
+    0.00000E+00  -4.00029E-01   3.34700E-01  -7.50508E-01   6.91891E-01
+   -6.90261E-02   8.95724E-02  -4.95102E-01   4.03588E-01   7.22093E-01
+    2.19978E-01   5.63226E+01   8.23090E+00   5.65191E+01   6.49401E+00
+    1.00000E+00   0.00000E+00  -4.49712E-01   3.69781E-01  -7.31039E-01
+    6.78143E-01  -8.37993E-02   1.00004E-01  -5.61721E-01   4.48634E-01
+    6.71887E-01   2.53925E-01   5.62048E+01   8.31056E+00   5.63565E+01
+    6.60399E+00   1.00000E+00   0.00000E+00  -4.92509E-01   3.98719E-01
+   -7.10057E-01   6.63956E-01  -1.01088E-01   1.11694E-01  -6.27845E-01
+    4.91530E-01   6.14993E-01   2.90834E-01   5.61031E+01   8.37657E+00
+    5.62252E+01   6.68912E+00   1.00000E+00   0.00000E+00  -5.27830E-01
+    4.21633E-01  -6.86358E-01   6.48582E-01  -1.21286E-01   1.24797E-01
+   -7.07618E-01   5.41258E-01   5.38069E-01   3.38787E-01   5.58319E+01
+    8.54562E+00   5.59397E+01   6.86706E+00   1.00000E+00   0.00000E+00
+   -5.65617E-01   4.45188E-01  -6.66702E-01   6.36328E-01  -1.44850E-01
+    1.39486E-01  -7.93028E-01   5.92500E-01   4.49878E-01   3.91697E-01
+    5.55841E+01   8.69422E+00   5.56903E+01   7.01676E+00   1.00000E+00
+    0.00000E+00  -5.97460E-01   4.64293E-01  -6.43743E-01   6.22555E-01
+   -1.72306E-01   1.55958E-01  -8.71197E-01   6.37699E-01   3.64030E-01
+    4.41335E-01   5.54914E+01   8.74780E+00   5.56074E+01   7.06473E+00
+    1.00000E+00   0.00000E+00  -6.13586E-01   4.73617E-01  -6.10277E-01
+    6.03204E-01  -2.04256E-01   1.74433E-01  -4.14056E+00   2.46203E+00
+    2.72448E-01   4.92440E-01   6.52966E+01   3.27648E+00   5.55521E+01
+    7.09555E+00   8.49034E+00  -4.17967E+00  -6.20722E-01   4.77599E-01
+   -5.71328E-01   5.81470E-01  -2.41396E-01   1.95157E-01  -3.71529E+00
+    2.23274E+00   1.76037E-01   5.44420E-01   6.42928E+01   3.81774E+00
+    5.55232E+01   7.11115E+00   3.76246E+00  -1.63058E+00  -6.18869E-01
+    4.76600E-01  -5.26940E-01   5.57538E-01  -2.84524E-01   2.18410E-01
+   -3.38023E+00   2.05799E+00   7.57934E-02   5.96701E-01   6.35076E+01
+    4.22720E+00   5.55201E+01   7.11272E+00   2.12844E+00  -7.78363E-01
+   -6.08299E-01   4.71087E-01  -4.77448E-01   5.31725E-01  -3.34555E-01
+    2.44503E-01  -3.11316E+00   1.92311E+00  -2.73045E-02   6.48771E-01
+    6.28874E+01   4.54033E+00   5.55416E+01   7.10188E+00   1.36403E+00
+   -3.92297E-01  -5.89545E-01   4.61615E-01  -4.23433E-01   5.04444E-01
+   -3.92545E-01   2.73791E-01  -2.89821E+00   1.81788E+00  -1.32161E-01
+    7.00105E-01   6.23955E+01   4.78124E+00   5.55860E+01   7.08009E+00
+    9.43861E-01  -1.86601E-01  -5.63350E-01   4.48791E-01  -3.65639E-01
+    4.76151E-01  -4.59702E-01   3.06668E-01  -2.72381E+00   1.73504E+00
+   -2.37763E-01   7.50265E-01   6.20041E+01   4.96720E+00   5.56533E+01
+    7.04828E+00   6.89268E-01  -6.56702E-02  -5.30602E-01   4.33237E-01
+   -3.04926E-01   4.47313E-01  -5.37413E-01   3.43581E-01  -2.58124E+00
+    1.66928E+00  -3.42978E-01   7.98797E-01   6.16940E+01   5.11021E+00
+    5.57400E+01   7.00824E+00   5.25232E-01   9.99372E-03  -4.92305E-01
+    4.15571E-01  -2.42201E-01   4.18380E-01  -6.27275E-01   3.85031E-01
+   -2.46373E+00   1.61659E+00  -4.46775E-01   8.45331E-01   6.14497E+01
+    5.21980E+00   5.58455E+01   6.96095E+00   4.15512E-01   5.91828E-02
+   -4.49469E-01   3.96367E-01  -1.78354E-01   3.89757E-01  -7.31112E-01
+    4.31582E-01  -2.40027E+00   1.58892E+00  -5.82382E-01   9.04464E-01
+    6.11101E+01   5.36780E+00   5.58172E+01   6.97316E+00   3.29390E-01
+    9.67373E-02  -4.14589E-01   3.81157E-01  -1.20033E-01   3.64325E-01
+   -8.51020E-01   4.83870E-01  -2.36780E+00   1.57514E+00  -7.30064E-01
+    9.67152E-01   6.07783E+01   5.50872E+00   5.57668E+01   6.99460E+00
+    2.65125E-01   1.24016E-01  -3.79204E-01   3.66138E-01  -6.25048E-02
+    3.39905E-01  -9.89403E-01   5.42610E-01  -2.30867E+00   1.55069E+00
+   -8.34780E-01   1.01045E+00   6.06217E+01   5.57339E+00   5.58661E+01
+    6.95355E+00   2.31725E-01   1.37826E-01  -3.27775E-01   3.44872E-01
+    1.43298E-03   3.13469E-01  -1.14902E+00   6.08606E-01  -2.26246E+00
+    1.53206E+00  -9.38141E-01   1.05211E+00   6.04885E+01   5.62708E+00
+    5.59682E+01   6.91236E+00   2.09686E-01   1.46709E-01  -2.76247E-01
+    3.24105E-01   6.32867E-02   2.88540E-01  -1.33301E+00   6.82764E-01
+   -2.23126E+00   1.51980E+00  -1.04391E+00   1.09369E+00   6.03961E+01
+    5.66337E+00   5.60944E+01   6.86279E+00   1.95120E-01   1.52435E-01
+   -2.26189E-01   3.04426E-01   1.22322E-01   2.65332E-01  -1.54501E+00
+    7.66102E-01  -2.20936E+00   1.51140E+00  -1.14773E+00   1.13352E+00
+    6.03296E+01   5.68885E+00   5.62308E+01   6.81044E+00   1.87164E-01
+    1.55487E-01  -1.76869E-01   2.85504E-01   1.78850E-01   2.43644E-01
+   -1.78915E+00   8.59770E-01  -2.19407E+00   1.50567E+00  -1.24803E+00
+    1.17110E+00   6.02829E+01   5.70639E+00   5.63743E+01   6.75673E+00
+    1.84572E-01   1.56459E-01  -1.28433E-01   2.67357E-01   2.32804E-01
+    2.23430E-01  -2.07017E+00   9.65058E-01  -2.18397E+00   1.50197E+00
+   -1.34436E+00   1.20636E+00   6.02490E+01   5.71881E+00   5.65199E+01
+    6.70339E+00   1.86188E-01   1.55867E-01  -8.12286E-02   2.50077E-01
+    2.84026E-01   2.04679E-01  -2.39350E+00   1.08342E+00  -2.17695E+00
+    1.49946E+00  -1.43541E+00   1.23895E+00   6.02298E+01   5.72573E+00
+    5.66690E+01   6.65002E+00   1.91295E-01   1.54040E-01  -3.53637E-02
+    2.33664E-01   3.32518E-01   1.87326E-01  -2.76536E+00   1.21650E+00
+   -2.17277E+00   1.49800E+00  -1.52160E+00   1.26911E+00   6.02178E+01
+    5.72989E+00   5.68181E+01   6.59791E+00   1.99024E-01   1.51334E-01
+    8.77293E-03   2.18215E-01   3.78161E-01   1.71350E-01  -3.19286E+00
+    1.36613E+00  -2.16981E+00   1.49698E+00  -1.60203E+00   1.29666E+00
+    6.02144E+01   5.73109E+00   5.69669E+01   6.54686E+00   2.08902E-01
+    1.47951E-01   5.11645E-02   2.03696E-01   4.21038E-01   1.56665E-01
+   -3.68411E+00   1.53438E+00  -2.16779E+00   1.49631E+00  -1.67686E+00
+    1.32175E+00   6.02161E+01   5.73050E+00   5.71138E+01   6.49768E+00
+    2.20406E-01   1.44093E-01   9.16210E-02   1.90130E-01   4.61163E-01
+    1.43209E-01  -4.24847E+00   1.72362E+00  -2.16629E+00   1.49581E+00
+   -1.74615E+00   1.34451E+00   6.02217E+01   5.72867E+00   5.72580E+01
+    6.45030E+00   2.33139E-01   1.39912E-01   1.30068E-01   1.77503E-01
+    4.98622E-01   1.30907E-01  -4.89652E+00   1.93645E+00  -2.16489E+00
+    1.49537E+00  -1.80999E+00   1.36505E+00   6.02303E+01   5.72585E+00
+    5.73988E+01   6.40497E+00   2.46760E-01   1.35528E-01   1.66495E-01
+    1.65782E-01   5.33525E-01   1.19676E-01  -5.64046E+00   2.17585E+00
+   -2.16337E+00   1.49488E+00  -1.86846E+00   1.38349E+00   6.02415E+01
+    5.72234E+00   5.75369E+01   6.36139E+00   2.61022E-01   1.31030E-01
+    2.00891E-01   1.54932E-01   5.65982E-01   1.09438E-01  -6.49420E+00
+    2.44515E+00  -2.16144E+00   1.49429E+00  -1.92168E+00   1.39996E+00
+    6.02554E+01   5.71806E+00   5.76712E+01   6.31984E+00   2.75709E-01
+    1.26487E-01   2.33306E-01   1.44905E-01   5.96135E-01   1.00111E-01
+   -7.47366E+00   2.74812E+00  -2.15897E+00   1.49354E+00  -1.96984E+00
+    1.41457E+00   6.02687E+01   5.71406E+00   5.78002E+01   6.28064E+00
+    2.90649E-01   1.21953E-01   2.63801E-01   1.35651E-01   6.24111E-01
+    9.16219E-02  -8.59696E+00   3.08898E+00  -2.15609E+00   1.49268E+00
+   -2.01335E+00   1.42753E+00   6.02843E+01   5.70943E+00   5.79274E+01
+    6.24276E+00   3.05663E-01   1.17483E-01   2.92411E-01   1.27131E-01
+    6.50053E-01   8.38966E-02  -9.88493E+00   3.47251E+00  -2.15268E+00
+    1.49168E+00  -2.05239E+00   1.43894E+00   6.02987E+01   5.70515E+00
+    5.80485E+01   6.20742E+00   3.20666E-01   1.13097E-01   3.19246E-01
+    1.19288E-01   6.74097E-01   7.68675E-02  -1.13613E+01   3.90409E+00
+   -2.14833E+00   1.49044E+00  -2.08684E+00   1.44883E+00   6.03150E+01
+    5.70054E+00   5.81666E+01   6.17359E+00   3.35571E-01   1.08817E-01
+    3.44405E-01   1.12064E-01   6.96377E-01   7.04718E-02  -1.30530E+01
+    4.38975E+00  -2.14302E+00   1.48894E+00  -2.11685E+00   1.45729E+00
+    6.03306E+01   5.69616E+00   5.82806E+01   6.14143E+00   3.50339E-01
+    1.04653E-01   3.67987E-01   1.05414E-01   7.17024E-01   6.46495E-02
+   -1.49913E+01   4.93634E+00  -2.13709E+00   1.48729E+00  -2.14308E+00
+    1.46456E+00   6.03465E+01   5.69163E+00   5.83905E+01   6.11096E+00
+    3.64850E-01   1.00632E-01   3.90069E-01   9.92955E-02   7.36155E-01
+    5.93484E-02  -1.72112E+01   5.55151E+00  -2.13073E+00   1.48556E+00
+   -2.16582E+00   1.47076E+00   6.03618E+01   5.68751E+00   5.84949E+01
+    6.08248E+00   3.79071E-01   9.67582E-02   4.10706E-01   9.36744E-02
+    7.53871E-01   5.45225E-02  -1.97535E+01   6.24396E+00  -2.12399E+00
+    1.48375E+00  -2.18543E+00   1.47601E+00   6.03764E+01   5.68361E+00
+    5.85968E+01   6.05520E+00   3.92966E-01   9.30378E-02   4.30026E-01
+    8.85010E-02   7.70298E-01   5.01227E-02  -2.26638E+01   7.02337E+00
+   -2.11615E+00   1.48169E+00  -2.20136E+00   1.48020E+00   6.03913E+01
+    5.67957E+00   5.86935E+01   6.02973E+00   4.06552E-01   8.94588E-02
+    4.48130E-01   8.37317E-02   7.85530E-01   4.61110E-02  -2.59950E+01
+    7.90078E+00  -1.96844E+00   1.44342E+00  -2.07495E+00   1.44745E+00
+    6.05835E+01   5.62990E+00   5.89651E+01   5.95935E+00   4.28949E-01
+    8.36559E-02   4.73738E-01   7.70962E-02   8.00971E-01   4.21110E-02
+   -2.98071E+01   8.88855E+00  -2.09734E+00   1.47628E+00  -2.22289E+00
+    1.48517E+00   6.04181E+01   5.67214E+00   5.88757E+01   5.98223E+00
+    4.32327E-01   8.27945E-02   4.80663E-01   7.53308E-02   8.12656E-01
+    3.91307E-02  -3.41686E+01   1.00006E+01  -2.08833E+00   1.47402E+00
+   -2.23086E+00   1.48717E+00   6.04305E+01   5.66900E+00   5.89597E+01
+    5.96106E+00   4.44809E-01   7.96615E-02   4.95551E-01   7.15936E-02
+    8.24838E-01   3.60737E-02  -3.91576E+01   1.12527E+01  -2.07840E+00
+    1.47157E+00  -2.23588E+00   1.48841E+00   6.04436E+01   5.66571E+00
+    5.90430E+01   5.94047E+00   4.56954E-01   7.66613E-02   5.09538E-01
+    6.81377E-02   8.36146E-01   3.32791E-02  -4.48636E+01   1.26626E+01
+   -2.06807E+00   1.46905E+00  -2.23879E+00   1.48911E+00   6.04558E+01
+    5.66262E+00   5.91215E+01   5.92131E+00   4.68718E-01   7.37986E-02
+    5.22684E-01   6.49392E-02   8.46663E-01   3.07193E-02  -5.13880E+01
+    1.42501E+01  -2.05730E+00   1.46648E+00  -2.23948E+00   1.48928E+00
+    6.04685E+01   5.65974E+00   5.91979E+01   5.90308E+00   4.80132E-01
+    7.10626E-02   5.35035E-01   6.19795E-02   8.56451E-01   2.83750E-02
+   -5.88474E+01   1.60378E+01  -2.04622E+00   1.46386E+00  -2.23838E+00
+    1.48902E+00   6.04792E+01   5.65718E+00   5.92700E+01   5.88603E+00
+    4.91155E-01   6.84593E-02   5.46651E-01   5.92363E-02   8.65548E-01
+    2.62265E-02  -5.34629E+01   1.47664E+01  -2.03474E+00   1.46119E+00
+   -2.23540E+00   1.48832E+00   6.04904E+01   5.65450E+00   5.93387E+01
+    5.87008E+00   5.01861E-01   6.59692E-02   5.57601E-01   5.66891E-02
+    8.74020E-01   2.42559E-02   1.00000E+01   0.00000E+00  -2.02332E+00
+    1.45857E+00  -2.23116E+00   1.48736E+00   6.05021E+01   5.65195E+00
+    5.94055E+01   5.85473E+00   5.12176E-01   6.36028E-02   5.67900E-01
+    5.43265E-02   8.81914E-01   2.24452E-02   1.00000E+01   0.00000E+00
+   -2.01130E+00   1.45585E+00  -2.22517E+00   1.48600E+00   6.05109E+01
+    5.64987E+00   5.94683E+01   5.84048E+00   5.22189E-01   6.13401E-02
+    5.77655E-01   5.21219E-02   8.89267E-01   2.07820E-02   9.99997E+00
+    0.00000E+00  -1.99906E+00   1.45312E+00  -2.21777E+00   1.48435E+00
+    6.05216E+01   5.64756E+00   5.95297E+01   5.82696E+00   5.31857E-01
+    5.91849E-02   5.86846E-01   5.00723E-02   8.96125E-01   1.92538E-02
+    9.99997E+00   0.00000E+00  -1.98706E+00   1.45048E+00  -2.20952E+00
+    1.48254E+00   6.05308E+01   5.64549E+00   5.95867E+01   5.81430E+00
+    5.41204E-01   5.71297E-02   5.95543E-01   4.81598E-02   9.02535E-01
+    1.78456E-02   1.00000E+01   0.00000E+00  -1.97349E+00   1.44754E+00
+   -2.19884E+00   1.48023E+00   6.05396E+01   5.64362E+00   5.96423E+01
+    5.80232E+00   5.50285E-01   5.51596E-02   6.03828E-01   4.63639E-02
+    9.08511E-01   1.65486E-02   1.00000E+01   0.00000E+00  -1.96304E+00
+    1.44531E+00  -2.19042E+00   1.47842E+00   6.05479E+01   5.64184E+00
+    5.96953E+01   5.79091E+00   5.58948E-01   5.33065E-02   6.11574E-01
+    4.47067E-02   9.14075E-01   1.53564E-02   9.99997E+00   0.00000E+00
+   -1.94946E+00   1.44244E+00  -2.17800E+00   1.47580E+00   6.05567E+01
+    5.64001E+00   5.97450E+01   5.78044E+00   5.67443E-01   5.15129E-02
+    6.19026E-01   4.31329E-02   9.19304E-01   1.42536E-02   1.00000E+01
+    0.00000E+00  -1.93680E+00   1.43980E+00  -2.16587E+00   1.47327E+00
+    6.05650E+01   5.63826E+00   5.97928E+01   5.77041E+00   5.75618E-01
+    4.98093E-02   6.26086E-01   4.16616E-02   9.24177E-01   1.32383E-02
+    1.00000E+01   0.00000E+00  -1.92412E+00   1.43719E+00  -2.15306E+00
+    1.47064E+00   6.05703E+01   5.63709E+00   5.98386E+01   5.76107E+00
+    5.83520E-01   4.81836E-02   6.32808E-01   4.02784E-02   9.28743E-01
+    1.22992E-02   9.99997E+00   0.00000E+00  -1.91149E+00   1.43463E+00
+   -2.13967E+00   1.46792E+00   6.05781E+01   5.63550E+00   5.98824E+01
+    5.75218E+00   5.91170E-01   4.66297E-02   6.39210E-01   3.89786E-02
+    9.33021E-01   1.14296E-02   9.99997E+00   0.00000E+00  -1.89852E+00
+    1.43202E+00  -2.12539E+00   1.46505E+00   6.05844E+01   5.63428E+00
+    5.99233E+01   5.74402E+00   5.98577E-01   4.51444E-02   6.45322E-01
+    3.77531E-02   9.37002E-01   1.06312E-02   1.00000E+01   0.00000E+00
+   -1.88682E+00   1.42971E+00  -2.11196E+00   1.46239E+00   6.05917E+01
+    5.63282E+00   5.99638E+01   5.73598E+00   6.05717E-01   4.37314E-02
+    6.51146E-01   3.66008E-02   9.40755E-01   9.88810E-03   1.00000E+01
+    0.00000E+00  -1.87388E+00   1.42718E+00  -2.09680E+00   1.45943E+00
+    6.05981E+01   5.63161E+00   6.00018E+01   5.72855E+00   6.12651E-01
+    4.23736E-02   6.56748E-01   3.55047E-02   9.44272E-01   9.20111E-03
+    9.99997E+00   0.00000E+00  -1.86151E+00   1.42478E+00  -2.08189E+00
+    1.45655E+00   6.06035E+01   5.63059E+00   6.00369E+01   5.72169E+00
+    6.19368E-01   4.10774E-02   6.62094E-01   3.44701E-02   9.47561E-01
+    8.56544E-03   1.00000E+01   0.00000E+00  -1.84907E+00   1.42241E+00
+   -2.06650E+00   1.45361E+00   6.06083E+01   5.62953E+00   6.00705E+01
+    5.71540E+00   6.25858E-01   3.98369E-02   6.67238E-01   3.34894E-02
+    9.50651E-01   7.97557E-03   9.99997E+00   0.00000E+00  -1.83704E+00
+    1.42014E+00  -2.05131E+00   1.45074E+00   6.06132E+01   5.62868E+00
+    6.01036E+01   5.70907E+00   6.32153E-01   3.86494E-02   6.72163E-01
+    3.25598E-02   9.53543E-01   7.43035E-03   1.00000E+01   0.00000E+00
+   -1.82474E+00   1.41785E+00  -2.03553E+00   1.44780E+00   6.06190E+01
+    5.62759E+00   6.01343E+01   5.70334E+00   6.38251E-01   3.75124E-02
+    6.76913E-01   3.16749E-02   9.56261E-01   6.92319E-03   9.99997E+00
+    0.00000E+00  -1.81302E+00   1.41569E+00  -2.02016E+00   1.44496E+00
+    6.06244E+01   5.62661E+00   6.01635E+01   5.69798E+00   6.44150E-01
+    3.64257E-02   6.81472E-01   3.08337E-02   9.58811E-01   6.45220E-03
+    1.00000E+01   0.00000E+00  -1.80174E+00   1.41363E+00  -2.00495E+00
+    1.44219E+00   6.06278E+01   5.62596E+00   6.01933E+01   5.69258E+00
+    6.49862E-01   3.53845E-02   6.85844E-01   3.00361E-02   9.61209E-01
+    6.01636E-03   1.00000E+01   0.00000E+00  -1.78915E+00   1.41137E+00
+   -1.98828E+00   1.43920E+00   6.06327E+01   5.62515E+00   6.02176E+01
+    5.68812E+00   6.55439E-01   3.43790E-02   6.90127E-01   2.92656E-02
+    9.63462E-01   5.61011E-03   9.99997E+00   0.00000E+00  -1.77806E+00
+    1.40939E+00  -1.97299E+00   1.43647E+00   6.06366E+01   5.62442E+00
+    6.02439E+01   5.68349E+00   6.60821E-01   3.34209E-02   6.94222E-01
+    2.85358E-02   9.65571E-01   5.23331E-03   9.99997E+00   0.00000E+00
+   -1.76734E+00   1.40750E+00  -1.95795E+00   1.43381E+00   6.06404E+01
+    5.62381E+00   6.02682E+01   5.67923E+00   6.66035E-01   3.25027E-02
+    6.98165E-01   2.78403E-02   9.67565E-01   4.88411E-03   1.00000E+01
+    0.00000E+00  -1.75596E+00   1.40552E+00  -1.94224E+00   1.43108E+00
+    6.06453E+01   5.62296E+00   6.02916E+01   5.67521E+00   6.71112E-01
+    3.16178E-02   7.02025E-01   2.71694E-02   9.69437E-01   4.55679E-03
+    1.00000E+01   0.00000E+00  -1.74554E+00   1.40372E+00  -1.92732E+00
+    1.42851E+00   6.06473E+01   5.62259E+00   6.03121E+01   5.67168E+00
+    6.76022E-01   3.07709E-02   7.05724E-01   2.65300E-02   9.71188E-01
+    4.25421E-03   9.99997E+00   0.00000E+00  -1.73439E+00   1.40182E+00
+   -1.91159E+00   1.42582E+00   6.06507E+01   5.62194E+00   6.03340E+01
+    5.66774E+00   6.80812E-01   2.99533E-02   7.09342E-01   2.59142E-02
+    9.72848E-01   3.97253E-03   1.00000E+01   0.00000E+00  -1.72417E+00
+    1.40010E+00  -1.89681E+00   1.42334E+00   6.06551E+01   5.62125E+00
+    6.03530E+01   5.66461E+00   6.85461E-01   2.91705E-02   7.12842E-01
+    2.53235E-02   9.74401E-01   3.70994E-03   9.99997E+00   0.00000E+00
+   -1.71406E+00   1.39841E+00  -1.88220E+00   1.42089E+00   6.06551E+01
+    5.62113E+00   6.03715E+01   5.66169E+00   6.89975E-01   2.84159E-02
+    7.16244E-01   2.47545E-02   9.75870E-01   3.46445E-03   1.00000E+01
+    0.00000E+00  -1.70407E+00   1.39676E+00  -1.86758E+00   1.41847E+00
+    6.06619E+01   5.62016E+00   6.03891E+01   5.65864E+00   6.94359E-01
+    2.76918E-02   7.19540E-01   2.42093E-02   9.77240E-01   3.23799E-03
+    9.99997E+00   0.00000E+00  -1.69439E+00   1.39517E+00  -1.85327E+00
+    1.41614E+00   6.06629E+01   5.61991E+00   6.04056E+01   5.65584E+00
+    6.98607E-01   2.69963E-02   7.22760E-01   2.36841E-02   9.78542E-01
+    3.02485E-03   1.00000E+01   0.00000E+00  -1.68488E+00   1.39364E+00
+   -1.83931E+00   1.41387E+00   6.06643E+01   5.61963E+00   6.04217E+01
+    5.65324E+00   7.02773E-01   2.63224E-02   7.25906E-01   2.31739E-02
+    9.79775E-01   2.82597E-03   1.00000E+01   0.00000E+00  -1.67551E+00
+    1.39213E+00  -1.82532E+00   1.41163E+00   6.06677E+01   5.61918E+00
+    6.04368E+01   5.65097E+00   7.06805E-01   2.56756E-02   7.28956E-01
+    2.26859E-02   9.80909E-01   2.64330E-03   9.99997E+00   0.00000E+00
+   -1.66662E+00   1.39071E+00  -1.81192E+00   1.40951E+00   6.06707E+01
+    5.61882E+00   6.04514E+01   5.64853E+00   7.10725E-01   2.50542E-02
+    7.31940E-01   2.22130E-02   9.81997E-01   2.47107E-03   9.99997E+00
+    0.00000E+00  -1.65767E+00   1.38931E+00  -1.79852E+00   1.40741E+00
+    6.06716E+01   5.61845E+00   6.04651E+01   5.64634E+00   7.14562E-01
+    2.44519E-02   7.34848E-01   2.17553E-02   9.83025E-01   2.30932E-03
+    1.00001E+01   0.00000E+00  -1.64908E+00   1.38797E+00  -1.78555E+00
+    1.40538E+00   6.06755E+01   5.61796E+00   6.04777E+01   5.64439E+00
+    7.18292E-01   2.38715E-02   7.37687E-01   2.13138E-02   9.83992E-01
+    2.15993E-03   9.99997E+00   0.00000E+00  -1.64074E+00   1.38669E+00
+   -1.77295E+00   1.40344E+00   6.06755E+01   5.61796E+00   6.04914E+01
+    5.64245E+00   7.21900E-01   2.33149E-02   7.40458E-01   2.08866E-02
+    9.84890E-01   2.02101E-03   9.99997E+00   0.00000E+00  -1.63293E+00
+    1.38550E+00  -1.76081E+00   1.40160E+00   6.06790E+01   5.61743E+00
+    6.05016E+01   5.64082E+00   7.25442E-01   2.27752E-02   7.43170E-01
+    2.04726E-02   9.85750E-01   1.88969E-03   1.00000E+01   0.00000E+00
+   -1.62454E+00   1.38423E+00  -1.74828E+00   1.39970E+00   6.06804E+01
+    5.61723E+00   6.05128E+01   5.63916E+00   7.28895E-01   2.22530E-02
+    7.45840E-01   2.00693E-02   9.86557E-01   1.76791E-03   9.99997E+00
+    0.00000E+00  -1.61711E+00   1.38312E+00  -1.73665E+00   1.39796E+00
+    6.06823E+01   5.61699E+00   6.05255E+01   5.63721E+00   7.32237E-01
+    2.17515E-02   7.48420E-01   1.96830E-02   9.87311E-01   1.65468E-03
+    9.99997E+00   0.00000E+00  -1.60944E+00   1.38198E+00  -1.72496E+00
+    1.39622E+00   6.06823E+01   5.61687E+00   6.05323E+01   5.63623E+00
+    7.35526E-01   2.12644E-02   7.50978E-01   1.93043E-02   9.88034E-01
+    1.54811E-03   1.00001E+01   0.00000E+00  -1.60286E+00   1.38102E+00
+   -1.71455E+00   1.39469E+00   6.06843E+01   5.61662E+00   6.05440E+01
+    5.63453E+00   7.38715E-01   2.07962E-02   7.53467E-01   1.89379E-02
+    9.88704E-01   1.44820E-03   9.99997E+00   0.00000E+00  -1.59646E+00
+    1.38009E+00  -1.70430E+00   1.39320E+00   6.06868E+01   5.61622E+00
+    6.05504E+01   5.63351E+00   7.41808E-01   2.03451E-02   7.55890E-01
+    1.85848E-02   9.89343E-01   1.35684E-03   1.00000E+01   0.00000E+00
+   -1.58654E+00   1.37866E+00  -1.69061E+00   1.39122E+00   6.06882E+01
+    5.61614E+00   6.05615E+01   5.63197E+00   7.44904E-01   1.98980E-02
+    7.58339E-01   1.82310E-02   9.89952E-01   1.26836E-03   9.99997E+00
+    0.00000E+00  -1.58179E+00   1.37797E+00  -1.68209E+00   1.39000E+00
+    6.06892E+01   5.61589E+00   6.05693E+01   5.63087E+00   7.47857E-01
+    1.94765E-02   7.60661E-01   1.78998E-02   9.90508E-01   1.18844E-03
+    9.99997E+00   0.00000E+00  -1.57540E+00   1.37707E+00  -1.67216E+00
+    1.38860E+00   6.06911E+01   5.61577E+00   6.05761E+01   5.62990E+00
+    7.50757E-01   1.90645E-02   7.62960E-01   1.75725E-02   9.91048E-01
+    1.11232E-03   1.00001E+01   0.00000E+00  -1.56931E+00   1.37620E+00
+   -1.66248E+00   1.38724E+00   6.06901E+01   5.61577E+00   6.05830E+01
+    5.62893E+00   7.53589E-01   1.86667E-02   7.65236E-01   1.72537E-02
+    9.91551E-01   1.04190E-03   9.99997E+00   0.00000E+00  -1.56467E+00
+    1.37557E+00  -1.65461E+00   1.38614E+00   6.06946E+01   5.61524E+00
+    6.05922E+01   5.62754E+00   7.56331E-01   1.82850E-02   7.67430E-01
+    1.69482E-02   9.92015E-01   9.76243E-04   1.00000E+01   0.00000E+00
+   -1.55737E+00   1.37456E+00  -1.64397E+00   1.38467E+00   6.06931E+01
+    5.61541E+00   6.05956E+01   5.62710E+00   7.59055E-01   1.79084E-02
+    7.69643E-01   1.66419E-02   9.92472E-01   9.13451E-04   9.99997E+00
+    0.00000E+00  -1.54994E+00   1.37354E+00  -1.63313E+00   1.38319E+00
+    6.06940E+01   5.61516E+00   6.06034E+01   5.62612E+00   7.61734E-01
+    1.75421E-02   7.71797E-01   1.63479E-02   9.92906E-01   8.54457E-04
+    9.99997E+00   0.00000E+00  -1.54623E+00   1.37304E+00  -1.62655E+00
+    1.38229E+00   6.06960E+01   5.61504E+00   6.06083E+01   5.62539E+00
+    7.64299E-01   1.71938E-02   7.73906E-01   1.60606E-02   9.93294E-01
+    8.01172E-04   9.99997E+00   0.00000E+00  -1.54105E+00   1.37234E+00
+   -1.61803E+00   1.38115E+00   6.06970E+01   5.61480E+00   6.06151E+01
+    5.62454E+00   7.66834E-01   1.68532E-02   7.75953E-01   1.57856E-02
+    9.93667E-01   7.51694E-04   1.00001E+01   0.00000E+00  -1.53617E+00
+    1.37167E+00  -1.61034E+00   1.38012E+00   6.06965E+01   5.61500E+00
+    6.06186E+01   5.62413E+00   7.69302E-01   1.65229E-02   7.78010E-01
+    1.55105E-02   9.94025E-01   7.03161E-04   9.99989E+00   0.00000E+00
+   -1.53204E+00   1.37113E+00  -1.60329E+00   1.37919E+00   6.06979E+01
+    5.61468E+00   6.06258E+01   5.62308E+00   7.71721E-01   1.62033E-02
+    7.79988E-01   1.52489E-02   9.94375E-01   6.57494E-04   1.00001E+01
+    0.00000E+00  -1.52558E+00   1.37028E+00  -1.59403E+00   1.37797E+00
+    6.06999E+01   5.61455E+00   6.06297E+01   5.62259E+00   7.74111E-01
+    1.58893E-02   7.81990E-01   1.49863E-02   9.94672E-01   6.18482E-04
+    9.99997E+00   0.00000E+00  -1.52169E+00   1.36980E+00  -1.58758E+00
+    1.37713E+00   6.06979E+01   5.61468E+00   6.06327E+01   5.62223E+00
+    7.76433E-01   1.55867E-02   7.83916E-01   1.47351E-02   9.94984E-01
+    5.77567E-04   9.99997E+00   0.00000E+00  -1.51779E+00   1.36928E+00
+   -1.58100E+00   1.37630E+00   6.07028E+01   5.61419E+00   6.06404E+01
+    5.62125E+00   7.78694E-01   1.52955E-02   7.85826E-01   1.44887E-02
+    9.95258E-01   5.42361E-04   1.00001E+01   0.00000E+00  -1.51280E+00
+    1.36865E+00  -1.57381E+00   1.37535E+00   6.06989E+01   5.61455E+00
+    6.06414E+01   5.62113E+00   7.80932E-01   1.50091E-02   7.87714E-01
+    1.42470E-02   9.95532E-01   5.07155E-04   9.99997E+00   0.00000E+00
+   -1.50925E+00   1.36819E+00  -1.56747E+00   1.37457E+00   6.07014E+01
+    5.61427E+00   6.06449E+01   5.62060E+00   7.83118E-01   1.47312E-02
+    7.89558E-01   1.40128E-02   9.95768E-01   4.76703E-04   1.00000E+01
+    0.00000E+00  -1.50598E+00   1.36777E+00  -1.56188E+00   1.37386E+00
+    6.07028E+01   5.61407E+00   6.06492E+01   5.62004E+00   7.85240E-01
+    1.44630E-02   7.91376E-01   1.37836E-02   9.96019E-01   4.45307E-04
+    9.99997E+00   0.00000E+00  -1.50063E+00   1.36711E+00  -1.55422E+00
+    1.37290E+00   6.07023E+01   5.61423E+00   6.06536E+01   5.61959E+00
+    7.87355E-01   1.41986E-02   7.93163E-01   1.35591E-02   9.96240E-01
+    4.18668E-04   9.99992E+00   0.00000E+00  -1.49755E+00   1.36673E+00
+   -1.54919E+00   1.37227E+00   6.07029E+01   5.61398E+00   6.06561E+01
+    5.61922E+00   7.89392E-01   1.39461E-02   7.94949E-01   1.33390E-02
+    9.96438E-01   3.92017E-04   1.00001E+01   0.00000E+00  -1.49504E+00
+    1.36642E+00  -1.54436E+00   1.37169E+00   6.07037E+01   5.61403E+00
+    6.06589E+01   5.61890E+00   7.91403E-01   1.36982E-02   7.96663E-01
+    1.31272E-02   9.96651E-01   3.66337E-04   1.00000E+01   0.00000E+00
+   -1.48988E+00   1.36579E+00  -1.53737E+00   1.37081E+00   6.07048E+01
+    5.61386E+00   6.06629E+01   5.61837E+00   7.93403E-01   1.34532E-02
+    7.98412E-01   1.29137E-02   9.96833E-01   3.43490E-04   9.99994E+00
+    0.00000E+00  -1.48819E+00   1.36558E+00  -1.53362E+00   1.37037E+00
+    6.07018E+01   5.61419E+00   6.06638E+01   5.61833E+00   7.95311E-01
+    1.32222E-02   8.00068E-01   1.27122E-02   9.97016E-01   3.23514E-04
+    1.00001E+01   0.00000E+00  -1.48393E+00   1.36506E+00  -1.52729E+00
+    1.36961E+00   6.07067E+01   5.61358E+00   6.06687E+01   5.61772E+00
+    7.97237E-01   1.29900E-02   8.01751E-01   1.25105E-02   9.97184E-01
+    3.02581E-04   9.99997E+00   0.00000E+00  -1.48125E+00   1.36476E+00
+   -1.52303E+00   1.36909E+00   6.07057E+01   5.61382E+00   6.06697E+01
+    5.61760E+00   7.99094E-01   1.27683E-02   8.03380E-01   1.23154E-02
+    9.97336E-01   2.83550E-04   9.99997E+00   0.00000E+00  -1.47869E+00
+    1.36445E+00  -1.51876E+00   1.36859E+00   6.07067E+01   5.61370E+00
+    6.06716E+01   5.61736E+00   8.00906E-01   1.25533E-02   8.04994E-01
+    1.21242E-02   9.97488E-01   2.65472E-04   1.00001E+01   0.00000E+00
+   -1.47577E+00   1.36410E+00  -1.51401E+00   1.36803E+00   6.07057E+01
+    5.61382E+00   6.06736E+01   5.61711E+00   8.02725E-01   1.23392E-02
+    8.06592E-01   1.19358E-02   9.97625E-01   2.49296E-04   9.99997E+00
+    0.00000E+00  -1.47297E+00   1.36378E+00  -1.50975E+00   1.36753E+00
+    6.07067E+01   5.61358E+00   6.06775E+01   5.61662E+00   8.04476E-01
+    1.21346E-02   8.08145E-01   1.17540E-02   9.97762E-01   2.34072E-04
+    9.99997E+00   0.00000E+00  -1.47088E+00   1.36353E+00  -1.50595E+00
+    1.36709E+00   6.07048E+01   5.61374E+00   6.06756E+01   5.61678E+00
+    8.06222E-01   1.19318E-02   8.09708E-01   1.15731E-02   9.97899E-01
+    2.18844E-04   1.00001E+01   0.00000E+00  -1.46751E+00   1.36315E+00
+   -1.50100E+00   1.36653E+00   6.07086E+01   5.61342E+00   6.06813E+01
+    5.61622E+00   8.07914E-01   1.17371E-02   8.11225E-01   1.13983E-02
+    9.98006E-01   2.06481E-04   9.99988E+00   0.00000E+00  -1.46576E+00
+    1.36294E+00  -1.49804E+00   1.36618E+00   6.07058E+01   5.61374E+00
+    6.06805E+01   5.61630E+00   8.09587E-01   1.15464E-02   8.12738E-01
+    1.12258E-02   9.98143E-01   1.91251E-04   1.00001E+01   0.00000E+00
+   -1.46386E+00   1.36274E+00  -1.49467E+00   1.36580E+00   6.07096E+01
+    5.61330E+00   6.06833E+01   5.61598E+00   8.11233E-01   1.13593E-02
+    8.14217E-01   1.10586E-02   9.98219E-01   1.80790E-04   1.00000E+01
+    0.00000E+00  -1.46247E+00   1.36257E+00  -1.49207E+00   1.36550E+00
+    6.07038E+01   5.61386E+00   6.06843E+01   5.61581E+00   8.12837E-01
+    1.11791E-02   8.15653E-01   1.08946E-02   9.98310E-01   1.70318E-04
+    9.99994E+00   0.00000E+00  -1.45750E+00   1.36202E+00  -1.48576E+00
+    1.36479E+00   6.07077E+01   5.61346E+00   6.06862E+01   5.61565E+00
+    8.14448E-01   1.09985E-02   8.17127E-01   1.07302E-02   9.98432E-01
+    1.57951E-04   1.00001E+01   0.00000E+00  -1.45750E+00   1.36202E+00
+   -1.48454E+00   1.36466E+00   6.07087E+01   5.61334E+00   6.06882E+01
+    5.61541E+00   8.15985E-01   1.08272E-02   8.18543E-01   1.05741E-02
+    9.98508E-01   1.49387E-04   9.99997E+00   0.00000E+00  -1.45482E+00
+    1.36173E+00  -1.48052E+00   1.36422E+00   6.07106E+01   5.61321E+00
+    6.06901E+01   5.61516E+00   8.17538E-01   1.06560E-02   8.19944E-01
+    1.04190E-02   9.98599E-01   1.39872E-04   9.99997E+00   0.00000E+00
+   -1.45348E+00   1.36157E+00  -1.47808E+00   1.36395E+00   6.07048E+01
+    5.61370E+00   6.06882E+01   5.61541E+00   8.19030E-01   1.04923E-02
+    8.21314E-01   1.02678E-02   9.98676E-01   1.30357E-04   1.00001E+01
+    0.00000E+00  -1.45202E+00   1.36141E+00  -1.47553E+00   1.36368E+00
+    6.07096E+01   5.61334E+00   6.06921E+01   5.61492E+00   8.20507E-01
+    1.03315E-02   8.22684E-01   1.01193E-02   9.98736E-01   1.23696E-04
+    9.99997E+00   0.00000E+00  -1.45007E+00   1.36121E+00  -1.47285E+00
+    1.36339E+00   6.07096E+01   5.61321E+00   6.06940E+01   5.61492E+00
+    8.21953E-01   1.01745E-02   8.24039E-01   9.97279E-03   9.98828E-01
+    1.14181E-04   9.99997E+00   0.00000E+00  -1.44812E+00   1.36100E+00
+   -1.46944E+00   1.36302E+00   6.07077E+01   5.61346E+00   6.06940E+01
+    5.61492E+00   8.23415E-01   1.00175E-02   8.25348E-01   9.83196E-03
+    9.98873E-01   1.09424E-04   9.99997E+00   0.00000E+00  -1.44640E+00
+    1.36081E+00  -1.46686E+00   1.36274E+00   6.07087E+01   5.61337E+00
+    6.06951E+01   5.61471E+00   8.24803E-01   9.86987E-03   8.26660E-01
+    9.69290E-03   9.98950E-01   1.01810E-04   1.00001E+01   0.00000E+00
+   -1.44557E+00   1.36072E+00  -1.46517E+00   1.36256E+00   6.07096E+01
+    5.61334E+00   6.06940E+01   5.61468E+00   8.26201E-01   9.72064E-03
+    8.27967E-01   9.55412E-03   9.99010E-01   9.51511E-05   9.99997E+00
+    0.00000E+00  -1.44532E+00   1.36071E+00  -1.46432E+00   1.36247E+00
+    6.07096E+01   5.61334E+00   6.06960E+01   5.61455E+00   8.27525E-01
+    9.58076E-03   8.29215E-01   9.42091E-03   9.99071E-01   8.75390E-05
+    9.99997E+00   0.00000E+00  -1.44191E+00   1.36034E+00  -1.45969E+00
+    1.36199E+00   6.07096E+01   5.61334E+00   6.06999E+01   5.61431E+00
+    8.28926E-01   9.43518E-03   8.30479E-01   9.28960E-03   9.99102E-01
+    8.46845E-05   9.99997E+00   0.00000E+00  -1.44021E+00   1.36016E+00
+   -1.45750E+00   1.36176E+00   6.07116E+01   5.61309E+00   6.06979E+01
+    5.61443E+00   8.30220E-01   9.30102E-03   8.31742E-01   9.15829E-03
+    9.99178E-01   7.80239E-05   1.00001E+01   0.00000E+00  -1.44009E+00
+    1.36016E+00  -1.45641E+00   1.36165E+00   6.07096E+01   5.61321E+00
+    6.06999E+01   5.61419E+00   8.31529E-01   9.16495E-03   8.32930E-01
+    9.03460E-03   9.99193E-01   7.42179E-05   9.99997E+00   0.00000E+00
+   -1.43838E+00   1.35998E+00  -1.45397E+00   1.36141E+00   6.07096E+01
+    5.61334E+00   6.06999E+01   5.61431E+00   8.32823E-01   9.03365E-03
+    8.34163E-01   8.90900E-03   9.99254E-01   6.85088E-05   9.99997E+00
+    0.00000E+00  -1.43814E+00   1.35995E+00  -1.45300E+00   1.36130E+00
+    6.07096E+01   5.61334E+00   6.06999E+01   5.61407E+00   8.34072E-01
+    8.90519E-03   8.35351E-01   8.78816E-03   9.99300E-01   6.47027E-05
+    1.00001E+01   0.00000E+00  -1.43668E+00   1.35981E+00  -1.45092E+00
+    1.36109E+00   6.07116E+01   5.61309E+00   6.07018E+01   5.61407E+00
+    8.35320E-01   8.77864E-03   8.36538E-01   8.66827E-03   9.99330E-01
+    6.08967E-05   9.99997E+00   0.00000E+00  -1.43558E+00   1.35969E+00
+   -1.44898E+00   1.36090E+00   6.07096E+01   5.61334E+00   6.06999E+01
+    5.61419E+00   8.36538E-01   8.65590E-03   8.37695E-01   8.55218E-03
+    9.99376E-01   5.70907E-05   9.99997E+00   0.00000E+00  -1.43446E+00
+    1.35959E+00  -1.44737E+00   1.36073E+00   6.07087E+01   5.61337E+00
+    6.07029E+01   5.61386E+00   8.37758E-01   8.53492E-03   8.38824E-01
+    8.43882E-03   9.99406E-01   5.42353E-05   1.00001E+01   0.00000E+00
+   -1.43400E+00   1.35953E+00  -1.44630E+00   1.36063E+00   6.07135E+01
+    5.61297E+00   6.07018E+01   5.61395E+00   8.38943E-01   8.41707E-03
+    8.39979E-01   8.32477E-03   9.99437E-01   5.04301E-05   9.99997E+00
+    0.00000E+00  -1.43302E+00   1.35944E+00  -1.44471E+00   1.36048E+00
+    6.07096E+01   5.61321E+00   6.07018E+01   5.61395E+00   8.40116E-01
+    8.30098E-03   8.41075E-01   8.21439E-03   9.99482E-01   4.66240E-05
+    9.99997E+00   0.00000E+00  -1.43180E+00   1.35932E+00  -1.44325E+00
+    1.36033E+00   6.07096E+01   5.61321E+00   6.07038E+01   5.61370E+00
+    8.41273E-01   8.18775E-03   8.42201E-01   8.10497E-03   9.99513E-01
+    4.37695E-05   9.99997E+00   0.00000E+00  -1.43034E+00   1.35917E+00
+   -1.44106E+00   1.36010E+00   6.07135E+01   5.61297E+00   6.07057E+01
+    5.61358E+00   8.42399E-01   8.07738E-03   8.43282E-01   7.99935E-03
+    9.99528E-01   4.18665E-05   9.99997E+00   0.00000E+00  -1.43059E+00
+    1.35918E+00  -1.44082E+00   1.36008E+00   6.07077E+01   5.61346E+00
+    6.07038E+01   5.61395E+00   8.43526E-01   7.96795E-03   8.44363E-01
+    7.89469E-03   9.99559E-01   3.80604E-05   1.00001E+01   0.00000E+00
+   -1.42937E+00   1.35909E+00  -1.43911E+00   1.35991E+00   6.07116E+01
+    5.61321E+00   6.07077E+01   5.61358E+00   8.44637E-01   7.86043E-03
+    8.45398E-01   7.79478E-03   9.99574E-01   3.71089E-05   9.99997E+00
+    0.00000E+00  -1.42864E+00   1.35902E+00  -1.43789E+00   1.35981E+00
+    6.07116E+01   5.61309E+00   6.07057E+01   5.61370E+00   8.45718E-01
+    7.75672E-03   8.46464E-01   7.69297E-03   9.99589E-01   3.52059E-05
+    9.99997E+00   0.00000E+00  -1.42742E+00   1.35889E+00  -1.43643E+00
+    1.35966E+00   6.07135E+01   5.61285E+00   6.07077E+01   5.61346E+00
+    8.46799E-01   7.65491E-03   8.47515E-01   7.59306E-03   9.99635E-01
+    3.13999E-05   1.00001E+01   0.00000E+00  -1.42742E+00   1.35888E+00
+   -1.43570E+00   1.35960E+00   6.07077E+01   5.61334E+00   6.07057E+01
+    5.61358E+00   8.47865E-01   7.55405E-03   8.48504E-01   7.49791E-03
+    9.99650E-01   3.04484E-05   9.99997E+00   0.00000E+00  -1.42718E+00
+    1.35888E+00  -1.43521E+00   1.35955E+00   6.07096E+01   5.61321E+00
+    6.07057E+01   5.61370E+00   8.48900E-01   7.45604E-03   8.49524E-01
+    7.40276E-03   9.99665E-01   2.85453E-05   9.99997E+00   0.00000E+00
+   -1.42594E+00   1.35875E+00  -1.43349E+00   1.35941E+00   6.07107E+01
+    5.61325E+00   6.07068E+01   5.61349E+00   8.49938E-01   7.35887E-03
+    8.50547E-01   7.30749E-03   9.99711E-01   2.56904E-05   1.00001E+01
+    0.00000E+00  -1.42571E+00   1.35874E+00  -1.43302E+00   1.35934E+00
+    6.07116E+01   5.61309E+00   6.07077E+01   5.61346E+00   8.50955E-01
+    7.26479E-03   8.51503E-01   7.21816E-03   9.99696E-01   2.56908E-05
+    9.99997E+00   0.00000E+00  -1.42498E+00   1.35868E+00  -1.43229E+00
+    1.35929E+00   6.07116E+01   5.61309E+00   6.07077E+01   5.61346E+00
+    8.51945E-01   7.17344E-03   8.52493E-01   7.12682E-03   9.99726E-01
+    2.28363E-05   9.99997E+00   0.00000E+00  -1.42450E+00   1.35864E+00
+   -1.43107E+00   1.35918E+00   6.07116E+01   5.61309E+00   6.07077E+01
+    5.61346E+00   8.52950E-01   7.08019E-03   8.53452E-01   7.03833E-03
+    9.99756E-01   2.09332E-05   9.99997E+00   0.00000E+00  -1.42376E+00
+    1.35856E+00  -1.42985E+00   1.35906E+00   6.07135E+01   5.61309E+00
+    6.07096E+01   5.61334E+00   8.53924E-01   6.99170E-03   8.54381E-01
+    6.95269E-03   9.99741E-01   2.18848E-05   9.99997E+00   0.00000E+00
+   -1.42328E+00   1.35851E+00  -1.42937E+00   1.35902E+00   6.07096E+01
+    5.61321E+00   6.07077E+01   5.61334E+00   8.54883E-01   6.90416E-03
+    8.55340E-01   6.86705E-03   9.99772E-01   1.90302E-05   1.00001E+01
+    0.00000E+00  -1.42303E+00   1.35850E+00  -1.42888E+00   1.35897E+00
+    6.07135E+01   5.61297E+00   6.07077E+01   5.61346E+00   8.55812E-01
+    6.81948E-03   8.56269E-01   6.78332E-03   9.99772E-01   1.80787E-05
+    9.99997E+00   0.00000E+00  -1.42255E+00   1.35845E+00  -1.42791E+00
+    1.35888E+00   6.07116E+01   5.61321E+00   6.07077E+01   5.61346E+00
+    8.56786E-01   6.73289E-03   8.57182E-01   6.70054E-03   9.99802E-01
+    1.71272E-05   9.99997E+00   0.00000E+00  -1.42206E+00   1.35839E+00
+   -1.42718E+00   1.35882E+00   6.07116E+01   5.61321E+00   6.07077E+01
+    5.61334E+00   8.57715E-01   6.65106E-03   8.58080E-01   6.61966E-03
+    9.99802E-01   1.61757E-05   1.00001E+01   0.00000E+00  -1.42182E+00
+    1.35838E+00  -1.42669E+00   1.35877E+00   6.07116E+01   5.61297E+00
+    6.07116E+01   5.61309E+00   8.58613E-01   6.57018E-03   8.58978E-01
+    6.54069E-03   9.99817E-01   1.42727E-05   9.99997E+00   0.00000E+00
+   -1.42133E+00   1.35835E+00  -1.42620E+00   1.35873E+00   6.07116E+01
+    5.61309E+00   6.07077E+01   5.61346E+00   8.59511E-01   6.49026E-03
+    8.59861E-01   6.46266E-03   9.99833E-01   1.42727E-05   9.99997E+00
+    0.00000E+00  -1.42131E+00   1.35834E+00  -1.42569E+00   1.35869E+00
+    6.07146E+01   5.61289E+00   6.07087E+01   5.61325E+00   8.60396E-01
+    6.41213E-03   8.60731E-01   6.38644E-03   9.99833E-01   1.33210E-05
+    1.00001E+01   0.00000E+00  -1.42084E+00   1.35829E+00  -1.42523E+00
+    1.35864E+00   6.07096E+01   5.61334E+00   6.07096E+01   5.61321E+00
+    8.61293E-01   6.33516E-03   8.61612E-01   6.30947E-03   9.99848E-01
+    1.23696E-05   9.99997E+00   0.00000E+00  -1.42060E+00   1.35827E+00
+   -1.42450E+00   1.35857E+00   6.07135E+01   5.61297E+00   6.07096E+01
+    5.61321E+00   8.62160E-01   6.25904E-03   8.62434E-01   6.23715E-03
+    9.99848E-01   1.14181E-05   9.99997E+00   0.00000E+00  -1.42011E+00
+    1.35822E+00  -1.42376E+00   1.35851E+00   6.07116E+01   5.61321E+00
+    6.07077E+01   5.61346E+00   8.63013E-01   6.18482E-03   8.63272E-01
+    6.16484E-03   9.99848E-01   1.14181E-05   9.99997E+00   0.00000E+00
+   -1.41987E+00   1.35821E+00  -1.42376E+00   1.35851E+00   6.07116E+01
+    5.61309E+00   6.07116E+01   5.61309E+00   8.63865E-01   6.11251E-03
+    8.64139E-01   6.09062E-03   9.99878E-01   9.51511E-06   9.99997E+00
+    0.00000E+00  -1.41962E+00   1.35819E+00  -1.42303E+00   1.35844E+00
+    6.07096E+01   5.61321E+00   6.07096E+01   5.61334E+00   8.64703E-01
+    6.04019E-03   8.64931E-01   6.02306E-03   9.99878E-01   1.04666E-05
+    1.00001E+01   0.00000E+00  -1.41914E+00   1.35815E+00  -1.42279E+00
+    1.35844E+00   6.07135E+01   5.61297E+00   6.07077E+01   5.61334E+00
+    8.65525E-01   5.97168E-03   8.65768E-01   5.95075E-03   9.99893E-01
+    8.56360E-06   9.99997E+00   0.00000E+00  -1.41914E+00   1.35815E+00
+   -1.42206E+00   1.35838E+00   6.07135E+01   5.61297E+00   6.07135E+01
+    5.61297E+00   8.66332E-01   5.90127E-03   8.66545E-01   5.88510E-03
+    9.99878E-01   8.56360E-06   9.99997E+00   0.00000E+00  -1.41865E+00
+    1.35810E+00  -1.42133E+00   1.35832E+00   6.07096E+01   5.61334E+00
+    6.07116E+01   5.61321E+00   8.67154E-01   5.83276E-03   8.67352E-01
+    5.81754E-03   9.99909E-01   7.61209E-06   1.00001E+01   0.00000E+00
+   -1.41865E+00   1.35810E+00  -1.42182E+00   1.35835E+00   6.07135E+01
+    5.61297E+00   6.07096E+01   5.61321E+00   8.67930E-01   5.76711E-03
+    8.68159E-01   5.75093E-03   9.99909E-01   7.61209E-06   9.99997E+00
+    0.00000E+00  -1.41816E+00   1.35807E+00  -1.42060E+00   1.35826E+00
+    6.07135E+01   5.61297E+00   6.07096E+01   5.61321E+00   8.68752E-01
+    5.70050E-03   8.68905E-01   5.68813E-03   9.99909E-01   7.61209E-06
+    9.99997E+00   0.00000E+00  -1.41838E+00   1.35807E+00  -1.42058E+00
+    1.35827E+00   6.07068E+01   5.61337E+00   6.07107E+01   5.61313E+00
+    8.69500E-01   5.63762E-03   8.69683E-01   5.62334E-03   9.99909E-01
+    6.66048E-06   1.00001E+01   0.00000E+00  -1.41841E+00   1.35807E+00
+   -1.42084E+00   1.35827E+00   6.07135E+01   5.61297E+00   6.07096E+01
+    5.61321E+00   8.70275E-01   5.57300E-03   8.70442E-01   5.55968E-03
+    9.99924E-01   5.70907E-06   9.99997E+00   0.00000E+00  -1.41743E+00
+    1.35801E+00  -1.41987E+00   1.35819E+00   6.07135E+01   5.61297E+00
+    6.07096E+01   5.61321E+00   8.71036E-01   5.51115E-03   8.71203E-01
+    5.49878E-03   9.99939E-01   4.75755E-06   9.99997E+00   0.00000E+00
+   -1.41768E+00   1.35803E+00  -1.41962E+00   1.35818E+00   6.07116E+01
+    5.61297E+00   6.07135E+01   5.61297E+00   8.71782E-01   5.44930E-03
+    8.71934E-01   5.43884E-03   9.99924E-01   5.70907E-06   9.99997E+00
+    0.00000E+00  -1.41743E+00   1.35801E+00  -1.41938E+00   1.35816E+00
+    6.07116E+01   5.61321E+00   6.07096E+01   5.61321E+00   8.72543E-01
+    5.38936E-03   8.72665E-01   5.37984E-03   9.99924E-01   5.70907E-06
+    9.99997E+00   0.00000E+00  -1.41694E+00   1.35797E+00  -1.41889E+00
+    1.35812E+00   6.07096E+01   5.61321E+00   6.07057E+01   5.61346E+00
+    8.73259E-01   5.33036E-03   8.73381E-01   5.32085E-03   9.99924E-01
+    5.70907E-06   1.00001E+01   0.00000E+00  -1.41743E+00   1.35800E+00
+   -1.41889E+00   1.35812E+00   6.07135E+01   5.61297E+00   6.07135E+01
+    5.61297E+00   8.73990E-01   5.27137E-03   8.74111E-01   5.26281E-03
+    9.99954E-01   3.80604E-06   9.99997E+00   0.00000E+00  -1.41670E+00
+    1.35795E+00  -1.41841E+00   1.35809E+00   6.07135E+01   5.61297E+00
+    6.07096E+01   5.61321E+00   8.74705E-01   5.21523E-03   8.74827E-01
+    5.20572E-03   9.99924E-01   4.75755E-06   9.99997E+00   0.00000E+00
+   -1.41694E+00   1.35795E+00  -1.41889E+00   1.35810E+00   6.07135E+01
+    5.61297E+00   6.07135E+01   5.61297E+00   8.75421E-01   5.15814E-03
+    8.75542E-01   5.14863E-03   9.99954E-01   2.85453E-06   1.00001E+01
+    0.00000E+00  -1.41670E+00   1.35795E+00  -1.41816E+00   1.35804E+00
+    6.07096E+01   5.61321E+00   6.07096E+01   5.61321E+00   8.76121E-01
+    5.10200E-03   8.76197E-01   5.09629E-03   9.99939E-01   3.80604E-06
+    9.99997E+00   0.00000E+00  -1.41644E+00   1.35793E+00  -1.41814E+00
+    1.35805E+00   6.07107E+01   5.61313E+00   6.07107E+01   5.61313E+00
+    8.76793E-01   5.04864E-03   8.76914E-01   5.04008E-03   9.99939E-01
+    3.80599E-06   9.99994E+00   0.00000E+00  -1.41621E+00   1.35792E+00
+   -1.41768E+00   1.35803E+00   6.07135E+01   5.61297E+00   6.07135E+01
+    5.61297E+00   8.77491E-01   4.99448E-03   8.77582E-01   4.98782E-03
+    9.99954E-01   2.85453E-06   1.00001E+01   0.00000E+00  -1.41621E+00
+    1.35792E+00  -1.41768E+00   1.35801E+00   6.07096E+01   5.61321E+00
+    6.07057E+01   5.61346E+00   8.78191E-01   4.94025E-03   8.78267E-01
+    4.93454E-03   9.99954E-01   2.85453E-06   9.99997E+00   0.00000E+00
+   -1.41646E+00   1.35794E+00  -1.41768E+00   1.35803E+00   6.07116E+01
+    5.61321E+00   6.07135E+01   5.61297E+00   8.78846E-01   4.88982E-03
+    8.78907E-01   4.88411E-03   9.99954E-01   3.80604E-06   9.99997E+00
+    0.00000E+00  -1.41573E+00   1.35787E+00  -1.41743E+00   1.35800E+00
+    6.07135E+01   5.61297E+00   6.07096E+01   5.61321E+00   8.79485E-01
+    4.83938E-03   8.79592E-01   4.83177E-03   9.99970E-01   2.85453E-06
+    9.99997E+00   0.00000E+00  -1.41621E+00   1.35791E+00  -1.41694E+00
+    1.35797E+00   6.07135E+01   5.61297E+00   6.07116E+01   5.61297E+00
+    8.80171E-01   4.78705E-03   8.80231E-01   4.78229E-03   9.99970E-01
+    1.90302E-06   9.99997E+00   0.00000E+00  -1.41621E+00   1.35791E+00
+   -1.41743E+00   1.35800E+00   6.07096E+01   5.61321E+00   6.07096E+01
+    5.61321E+00   8.80825E-01   4.73662E-03   8.80886E-01   4.73186E-03
+    9.99970E-01   1.90302E-06   9.99997E+00   0.00000E+00  -1.41524E+00
+    1.35784E+00  -1.41670E+00   1.35794E+00   6.07135E+01   5.61297E+00
+    6.07135E+01   5.61297E+00   8.81434E-01   4.69095E-03   8.81510E-01
+    4.68429E-03   9.99970E-01   1.90302E-06   9.99997E+00   0.00000E+00
+   -1.41573E+00   1.35787E+00  -1.41646E+00   1.35794E+00   6.07116E+01
+    5.61321E+00   6.07096E+01   5.61321E+00   8.82104E-01   4.64052E-03
+    8.82134E-01   4.63766E-03   9.99970E-01   1.90302E-06   1.00002E+01
+    0.00000E+00  -1.41573E+00   1.35787E+00  -1.41670E+00   1.35794E+00
+    6.07135E+01   5.61297E+00   6.07135E+01   5.61297E+00   8.82728E-01
+    4.59294E-03   8.82789E-01   4.58914E-03   9.99970E-01   1.90302E-06
+    9.99997E+00   0.00000E+00  -1.41548E+00   1.35784E+00  -1.41646E+00
+    1.35794E+00   6.07096E+01   5.61321E+00   6.07096E+01   5.61321E+00
+    8.83322E-01   4.54822E-03   8.83398E-01   4.54251E-03   9.99970E-01
+    1.90302E-06   9.99997E+00   0.00000E+00  -1.41546E+00   1.35785E+00
+   -1.41644E+00   1.35791E+00   6.07146E+01   5.61289E+00   6.07146E+01
+    5.61289E+00   8.83948E-01   4.50153E-03   8.84009E-01   4.49772E-03
+    9.99970E-01   1.90299E-06   1.00001E+01   0.00000E+00  -1.41573E+00
+    1.35787E+00  -1.41597E+00   1.35787E+00   6.07135E+01   5.61297E+00
+    6.07096E+01   5.61321E+00   8.84585E-01   4.45402E-03   8.84601E-01
+    4.45402E-03   9.99970E-01   2.85453E-06   9.99997E+00   0.00000E+00
+   -1.41500E+00   1.35781E+00  -1.41621E+00   1.35791E+00   6.07135E+01
+    5.61297E+00   6.07135E+01   5.61297E+00   8.85149E-01   4.41216E-03
+    8.85240E-01   4.40645E-03   9.99970E-01   1.90302E-06   9.99997E+00
+    0.00000E+00  -1.41573E+00   1.35787E+00  -1.41621E+00   1.35791E+00
+    6.07096E+01   5.61321E+00   6.07096E+01   5.61321E+00   8.85758E-01
+    4.36744E-03   8.85788E-01   4.36553E-03   9.99985E-01   1.90302E-06
+    9.99997E+00   0.00000E+00  -1.41475E+00   1.35781E+00  -1.41573E+00
+    1.35787E+00   6.07096E+01   5.61321E+00   6.07096E+01   5.61321E+00
+    8.86336E-01   4.32462E-03   8.86397E-01   4.32081E-03   1.00000E+00
+    0.00000E+00   9.99997E+00   0.00000E+00  -1.41524E+00   1.35784E+00
+   -1.41621E+00   1.35791E+00   6.07174E+01   5.61273E+00   6.07135E+01
+    5.61297E+00   8.86945E-01   4.28085E-03   8.86976E-01   4.27799E-03
+    9.99970E-01   1.90302E-06   9.99997E+00   0.00000E+00  -1.41451E+00
+    1.35778E+00  -1.41500E+00   1.35781E+00   6.07057E+01   5.61346E+00
+    6.07096E+01   5.61321E+00   8.87509E-01   4.23993E-03   8.87539E-01
+    4.23803E-03   9.99970E-01   1.90302E-06   9.99997E+00   0.00000E+00
+   -1.41524E+00   1.35784E+00  -1.41621E+00   1.35791E+00   6.07135E+01
+    5.61297E+00   6.07135E+01   5.61297E+00   8.88087E-01   4.19807E-03
+    8.88133E-01   4.19426E-03   1.00000E+00   0.00000E+00   1.00002E+01
+    0.00000E+00  -1.41475E+00   1.35781E+00  -1.41548E+00   1.35784E+00
+    6.07135E+01   5.61297E+00   6.07135E+01   5.61297E+00   8.88650E-01
+    4.15715E-03   8.88666E-01   4.15620E-03   9.99970E-01   1.90302E-06
+    9.99997E+00   0.00000E+00  -1.41500E+00   1.35781E+00  -1.41524E+00
+    1.35784E+00   6.07096E+01   5.61321E+00   6.07096E+01   5.61321E+00
+    8.89214E-01   4.11719E-03   8.89229E-01   4.11528E-03   1.00000E+00
+    0.00000E+00   9.99997E+00   0.00000E+00  -1.41546E+00   1.35785E+00
+   -1.41546E+00   1.35785E+00   6.07146E+01   5.61289E+00   6.07107E+01
+    5.61313E+00   8.89779E-01   4.07621E-03   8.89779E-01   4.07621E-03
+    9.99970E-01   1.90299E-06   1.00001E+01   0.00000E+00  -1.41500E+00
+    1.35781E+00  -1.41573E+00   1.35787E+00   6.07135E+01   5.61297E+00
+    6.07135E+01   5.61297E+00   8.90310E-01   4.03916E-03   8.90371E-01
+    4.03441E-03   1.00000E+00   0.00000E+00   9.99997E+00   0.00000E+00
+   -1.41475E+00   1.35781E+00  -1.41500E+00   1.35781E+00   6.07096E+01
+    5.61321E+00   6.07096E+01   5.61321E+00   8.90843E-01   4.00015E-03
+    8.90858E-01   4.00015E-03   9.99985E-01   9.51511E-07   9.99997E+00
+    0.00000E+00  -1.41451E+00   1.35778E+00  -1.41475E+00   1.35781E+00
+    6.07135E+01   5.61297E+00   6.07135E+01   5.61297E+00   8.91391E-01
+    3.96209E-03   8.91421E-01   3.96019E-03   9.99985E-01   9.51511E-07
+    9.99997E+00   0.00000E+00  -1.41475E+00   1.35781E+00  -1.41621E+00
+    1.35787E+00   6.07096E+01   5.61321E+00   6.07135E+01   5.61297E+00
+    8.91924E-01   3.92498E-03   8.91969E-01   3.92213E-03   1.00000E+00
+    0.00000E+00   9.99997E+00   0.00000E+00  -1.41475E+00   1.35781E+00
+   -1.41475E+00   1.35781E+00   6.07096E+01   5.61321E+00   6.07135E+01
+    5.61297E+00   8.92456E-01   3.88787E-03   8.92441E-01   3.88787E-03
+    9.99985E-01   9.51511E-07   9.99997E+00   0.00000E+00  -1.41427E+00
+    1.35778E+00  -1.41475E+00   1.35781E+00   6.07135E+01   5.61297E+00
+    6.07096E+01   5.61321E+00   8.92974E-01   3.85172E-03   8.93004E-01
+    3.84981E-03   1.00000E+00   0.00000E+00   9.99997E+00   0.00000E+00
+   -1.41427E+00   1.35778E+00  -1.41475E+00   1.35778E+00   6.07135E+01
+    5.61297E+00   6.07096E+01   5.61321E+00   8.93507E-01   3.81556E-03
+    8.93492E-01   3.81556E-03   9.99970E-01   1.90302E-06   9.99997E+00
+    0.00000E+00  -1.41524E+00   1.35781E+00  -1.41524E+00   1.35784E+00
+    6.07096E+01   5.61321E+00   6.07135E+01   5.61297E+00   8.94009E-01
+    3.78035E-03   8.94040E-01   3.77845E-03   1.00000E+00   0.00000E+00
+    9.99997E+00   0.00000E+00  -1.41427E+00   1.35778E+00  -1.41475E+00
+    1.35781E+00   6.07135E+01   5.61297E+00   6.07135E+01   5.61297E+00
+    8.94512E-01   3.74515E-03   8.94542E-01   3.74420E-03   1.00000E+00
+    0.00000E+00   1.00002E+01   0.00000E+00  -1.41427E+00   1.35778E+00
+   -1.41475E+00   1.35781E+00   6.07135E+01   5.61297E+00   6.07096E+01
+    5.61321E+00   8.95014E-01   3.71184E-03   8.95029E-01   3.70994E-03
+    1.00000E+00   0.00000E+00   9.99997E+00   0.00000E+00  -1.41473E+00
+    1.35779E+00  -1.41473E+00   1.35779E+00   6.07087E+01   5.61313E+00
+    6.07126E+01   5.61289E+00   8.95533E-01   3.67658E-03   8.95518E-01
+    3.67658E-03   9.99970E-01   1.90299E-06   9.99982E+00   0.00000E+00
+   -1.41475E+00   1.35781E+00  -1.41573E+00   1.35784E+00   6.07096E+01
+    5.61321E+00   6.07135E+01   5.61297E+00   8.96004E-01   3.64429E-03
+    8.96019E-01   3.64238E-03   1.00000E+00   0.00000E+00   1.00002E+01
+    0.00000E+00  -1.41329E+00   1.35772E+00  -1.41378E+00   1.35775E+00
+    6.07135E+01   5.61297E+00   6.07057E+01   5.61346E+00   8.96491E-01
+    3.61098E-03   8.96521E-01   3.60908E-03   9.99985E-01   0.00000E+00
+    9.99997E+00   0.00000E+00  -1.41524E+00   1.35784E+00  -1.41573E+00
+    1.35787E+00   6.07096E+01   5.61321E+00   6.07135E+01   5.61297E+00
+    8.96963E-01   3.57863E-03   8.97008E-01   3.57673E-03   1.00000E+00
+    0.00000E+00   9.99997E+00   0.00000E+00  -1.41427E+00   1.35775E+00
+   -1.41329E+00   1.35772E+00   6.07135E+01   5.61297E+00   6.07135E+01
+    5.61297E+00   8.97465E-01   3.54533E-03   8.97435E-01   3.54818E-03
+    9.99970E-01   1.90302E-06   9.99997E+00   0.00000E+00  -1.41524E+00
+    1.35781E+00  -1.41524E+00   1.35784E+00   6.07135E+01   5.61297E+00
+    6.07135E+01   5.61297E+00   8.97937E-01   3.51488E-03   8.97968E-01
+    3.51298E-03   1.00000E+00   0.00000E+00   9.99997E+00   0.00000E+00
+   -1.41427E+00   1.35775E+00  -1.41378E+00   1.35775E+00   6.07135E+01
+    5.61297E+00   6.07096E+01   5.61321E+00   8.98409E-01   3.48348E-03
+    8.98409E-01   3.48348E-03   1.00000E+00   0.00000E+00   9.99997E+00
+    0.00000E+00  -1.41475E+00   1.35778E+00  -1.41475E+00   1.35781E+00
+    6.07135E+01   5.61297E+00   6.07135E+01   5.61297E+00   8.98881E-01
+    3.45208E-03   8.98911E-01   3.45018E-03   1.00000E+00   0.00000E+00
+    9.99997E+00   0.00000E+00  -1.41427E+00   1.35778E+00  -1.41524E+00
+    1.35781E+00   6.07096E+01   5.61321E+00   6.07096E+01   5.61321E+00
+    8.99338E-01   3.42259E-03   8.99353E-01   3.42068E-03   1.00000E+00
+    0.00000E+00   1.00002E+01   0.00000E+00  -1.41427E+00   1.35778E+00
+   -1.41427E+00   1.35778E+00   6.07135E+01   5.61297E+00   6.07135E+01
+    5.61297E+00   8.99794E-01   3.39214E-03   8.99794E-01   3.39214E-03
+    1.00000E+00   0.00000E+00   9.99997E+00   0.00000E+00  -1.41427E+00
+    1.35775E+00  -1.41378E+00   1.35775E+00   6.07096E+01   5.61321E+00
+    6.07096E+01   5.61321E+00   9.00266E-01   3.36169E-03   9.00236E-01
+    3.36264E-03   9.99970E-01   1.90302E-06   9.99997E+00   0.00000E+00
+   -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00   6.07126E+01
+    5.61313E+00   6.07165E+01   5.61289E+00   9.00694E-01   3.33404E-03
+    9.00694E-01   3.33309E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41378E+00   1.35775E+00  -1.41475E+00   1.35778E+00
+    6.07135E+01   5.61297E+00   6.07096E+01   5.61321E+00   9.01165E-01
+    3.30365E-03   9.01165E-01   3.30269E-03   1.00000E+00   0.00000E+00
+    9.99997E+00   0.00000E+00  -1.41475E+00   1.35778E+00  -1.41475E+00
+    1.35778E+00   6.07096E+01   5.61321E+00   6.07096E+01   5.61321E+00
+    9.01591E-01   3.27605E-03   9.01576E-01   3.27605E-03   1.00000E+00
+    0.00000E+00   9.99997E+00   0.00000E+00  -1.41427E+00   1.35778E+00
+   -1.41427E+00   1.35778E+00   6.07135E+01   5.61297E+00   6.07174E+01
+    5.61273E+00   9.02017E-01   3.24751E-03   9.02017E-01   3.24751E-03
+    1.00000E+00   0.00000E+00   9.99997E+00   0.00000E+00  -1.41475E+00
+    1.35778E+00  -1.41475E+00   1.35781E+00   6.07135E+01   5.61297E+00
+    6.07096E+01   5.61321E+00   9.02459E-01   3.21991E-03   9.02489E-01
+    3.21801E-03   1.00000E+00   0.00000E+00   9.99997E+00   0.00000E+00
+   -1.41475E+00   1.35778E+00  -1.41475E+00   1.35778E+00   6.07135E+01
+    5.61297E+00   6.07135E+01   5.61297E+00   9.02870E-01   3.19327E-03
+    9.02870E-01   3.19327E-03   1.00000E+00   0.00000E+00   9.99997E+00
+    0.00000E+00  -1.41427E+00   1.35775E+00  -1.41427E+00   1.35775E+00
+    6.07096E+01   5.61321E+00   6.07096E+01   5.61321E+00   9.03327E-01
+    3.16473E-03   9.03327E-01   3.16473E-03   1.00000E+00   0.00000E+00
+    9.99997E+00   0.00000E+00  -1.41427E+00   1.35775E+00  -1.41427E+00
+    1.35778E+00   6.07135E+01   5.61297E+00   6.07135E+01   5.61297E+00
+    9.03722E-01   3.13903E-03   9.03753E-01   3.13713E-03   1.00000E+00
+    0.00000E+00   9.99997E+00   0.00000E+00  -1.41427E+00   1.35778E+00
+   -1.41378E+00   1.35775E+00   6.07096E+01   5.61321E+00   6.07096E+01
+    5.61321E+00   9.04149E-01   3.11239E-03   9.04118E-01   3.11430E-03
+    9.99985E-01   9.51511E-07   9.99997E+00   0.00000E+00  -1.41526E+00
+    1.35783E+00  -1.41526E+00   1.35783E+00   6.07145E+01   5.61306E+00
+    6.07145E+01   5.61306E+00   9.04558E-01   3.08675E-03   9.04558E-01
+    3.08675E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41424E+00   1.35776E+00  -1.41473E+00   1.35779E+00   6.07087E+01
+    5.61313E+00   6.07087E+01   5.61313E+00   9.04987E-01   3.06001E-03
+    9.05003E-01   3.05906E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41424E+00   1.35779E+00  -1.41424E+00   1.35779E+00
+    6.07165E+01   5.61289E+00   6.07165E+01   5.61289E+00   9.05398E-01
+    3.03527E-03   9.05398E-01   3.03527E-03   1.00000E+00   0.00000E+00
+    9.99982E+00   0.00000E+00  -1.41331E+00   1.35771E+00  -1.41331E+00
+    1.35771E+00   6.07067E+01   5.61330E+00   6.07067E+01   5.61330E+00
+    9.05791E-01   3.01063E-03   9.05807E-01   3.00968E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41522E+00   1.35782E+00
+   -1.41522E+00   1.35782E+00   6.07165E+01   5.61289E+00   6.07165E+01
+    5.61289E+00   9.06205E-01   2.98484E-03   9.06190E-01   2.98580E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41327E+00
+    1.35770E+00  -1.41376E+00   1.35773E+00   6.07126E+01   5.61313E+00
+    6.07126E+01   5.61313E+00   9.06601E-01   2.96106E-03   9.06632E-01
+    2.95915E-03   1.00000E+00   0.00000E+00   9.99982E+00   0.00000E+00
+   -1.41477E+00   1.35780E+00  -1.41477E+00   1.35780E+00   6.07106E+01
+    5.61306E+00   6.07106E+01   5.61306E+00   9.06994E-01   2.93641E-03
+    9.06994E-01   2.93641E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41429E+00   1.35777E+00  -1.41429E+00   1.35777E+00
+    6.07145E+01   5.61306E+00   6.07145E+01   5.61306E+00   9.07390E-01
+    2.91262E-03   9.07390E-01   2.91262E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41376E+00   1.35773E+00  -1.41376E+00
+    1.35773E+00   6.07087E+01   5.61313E+00   6.07087E+01   5.61313E+00
+    9.07773E-01   2.88969E-03   9.07773E-01   2.88969E-03   1.00000E+00
+    0.00000E+00   9.99982E+00   0.00000E+00  -1.41424E+00   1.35776E+00
+   -1.41424E+00   1.35776E+00   6.07126E+01   5.61313E+00   6.07126E+01
+    5.61313E+00   9.08154E-01   2.86591E-03   9.08154E-01   2.86591E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41380E+00
+    1.35774E+00  -1.41380E+00   1.35774E+00   6.07106E+01   5.61306E+00
+    6.07106E+01   5.61306E+00   9.08532E-01   2.84316E-03   9.08547E-01
+    2.84221E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41380E+00   1.35774E+00  -1.41429E+00   1.35777E+00   6.07067E+01
+    5.61330E+00   6.07067E+01   5.61330E+00   9.08928E-01   2.81937E-03
+    9.08928E-01   2.81937E-03   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41420E+00   1.35778E+00  -1.41420E+00   1.35778E+00
+    6.07185E+01   5.61271E+00   6.07185E+01   5.61271E+00   9.09283E-01
+    2.79827E-03   9.09298E-01   2.79731E-03   1.00000E+00   9.51468E-07
+    1.00000E+01   0.00000E+00  -1.41429E+00   1.35777E+00  -1.41429E+00
+    1.35777E+00   6.07145E+01   5.61306E+00   6.07145E+01   5.61306E+00
+    9.09658E-01   2.77560E-03   9.09658E-01   2.77560E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41380E+00   1.35774E+00
+   -1.41380E+00   1.35774E+00   6.07106E+01   5.61306E+00   6.07106E+01
+    5.61306E+00   9.10024E-01   2.75276E-03   9.10024E-01   2.75371E-03
+    1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00  -1.41473E+00
+    1.35779E+00  -1.41473E+00   1.35779E+00   6.07126E+01   5.61313E+00
+    6.07126E+01   5.61313E+00   9.10392E-01   2.73270E-03   9.10392E-01
+    2.73175E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41376E+00   1.35773E+00  -1.41376E+00   1.35773E+00   6.07087E+01
+    5.61313E+00   6.07087E+01   5.61313E+00   9.10757E-01   2.70986E-03
+    9.10788E-01   2.70986E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41429E+00   1.35777E+00  -1.41380E+00   1.35774E+00
+    6.07106E+01   5.61306E+00   6.07106E+01   5.61306E+00   9.11120E-01
+    2.68901E-03   9.11089E-01   2.69091E-03   9.99970E-01   9.51525E-07
+    9.99988E+00   0.00000E+00  -1.41376E+00   1.35773E+00  -1.41376E+00
+    1.35773E+00   6.07087E+01   5.61313E+00   6.07087E+01   5.61313E+00
+    9.11488E-01   2.66895E-03   9.11488E-01   2.66800E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41477E+00   1.35780E+00
+   -1.41526E+00   1.35783E+00   6.07106E+01   5.61330E+00   6.07106E+01
+    5.61330E+00   9.11851E-01   2.64714E-03   9.11851E-01   2.64714E-03
+    1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00  -1.41327E+00
+    1.35773E+00  -1.41327E+00   1.35773E+00   6.07204E+01   5.61264E+00
+    6.07204E+01   5.61264E+00   9.12188E-01   2.62708E-03   9.12188E-01
+    2.62708E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41477E+00   1.35780E+00  -1.41477E+00   1.35780E+00   6.07067E+01
+    5.61330E+00   6.07067E+01   5.61330E+00   9.12551E-01   2.60718E-03
+    9.12551E-01   2.60623E-03   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41376E+00   1.35773E+00  -1.41376E+00   1.35773E+00
+    6.07126E+01   5.61313E+00   6.07126E+01   5.61313E+00   9.12858E-01
+    2.58712E-03   9.12889E-01   2.58712E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41429E+00   1.35777E+00  -1.41429E+00
+    1.35777E+00   6.07145E+01   5.61281E+00   6.07145E+01   5.61281E+00
+    9.13221E-01   2.56722E-03   9.13221E-01   2.56722E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41424E+00   1.35776E+00
+   -1.41424E+00   1.35776E+00   6.07126E+01   5.61313E+00   6.07126E+01
+    5.61313E+00   9.13558E-01   2.54811E-03   9.13558E-01   2.54811E-03
+    1.00000E+00   0.00000E+00   9.99982E+00   0.00000E+00  -1.41380E+00
+    1.35774E+00  -1.41380E+00   1.35774E+00   6.07067E+01   5.61330E+00
+    6.07067E+01   5.61330E+00   9.13891E-01   2.52820E-03   9.13921E-01
+    2.52820E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41424E+00   1.35776E+00  -1.41424E+00   1.35776E+00   6.07126E+01
+    5.61313E+00   6.07126E+01   5.61313E+00   9.14259E-01   2.50910E-03
+    9.14228E-01   2.50910E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41429E+00   1.35777E+00  -1.41429E+00   1.35777E+00
+    6.07183E+01   5.61281E+00   6.07183E+01   5.61281E+00   9.14591E-01
+    2.49014E-03   9.14561E-01   2.49109E-03   1.00000E+00   0.00000E+00
+    9.99988E+00   0.00000E+00  -1.41473E+00   1.35779E+00  -1.41473E+00
+    1.35779E+00   6.07087E+01   5.61313E+00   6.07087E+01   5.61313E+00
+    9.14898E-01   2.47199E-03   9.14898E-01   2.47199E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41376E+00   1.35776E+00
+   -1.41376E+00   1.35776E+00   6.07087E+01   5.61313E+00   6.07087E+01
+    5.61313E+00   9.15203E-01   2.45391E-03   9.15233E-01   2.45296E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41380E+00
+    1.35774E+00  -1.41380E+00   1.35774E+00   6.07183E+01   5.61281E+00
+    6.07183E+01   5.61281E+00   9.15565E-01   2.43495E-03   9.15565E-01
+    2.43495E-03   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41376E+00   1.35773E+00  -1.41376E+00   1.35773E+00   6.07087E+01
+    5.61313E+00   6.07087E+01   5.61313E+00   9.15872E-01   2.41680E-03
+    9.15872E-01   2.41680E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41429E+00   1.35777E+00  -1.41429E+00   1.35777E+00
+    6.07106E+01   5.61330E+00   6.07106E+01   5.61330E+00   9.16205E-01
+    2.39880E-03   9.16205E-01   2.39975E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41424E+00   1.35776E+00  -1.41424E+00
+    1.35776E+00   6.07087E+01   5.61313E+00   6.07087E+01   5.61313E+00
+    9.16512E-01   2.38160E-03   9.16512E-01   2.38160E-03   1.00000E+00
+    0.00000E+00   9.99982E+00   0.00000E+00  -1.41429E+00   1.35777E+00
+   -1.41429E+00   1.35777E+00   6.07145E+01   5.61281E+00   6.07145E+01
+    5.61281E+00   9.16814E-01   2.36454E-03   9.16844E-01   2.36359E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41424E+00
+    1.35776E+00  -1.41424E+00   1.35776E+00   6.07126E+01   5.61313E+00
+    6.07126E+01   5.61313E+00   9.17121E-01   2.34734E-03   9.17151E-01
+    2.34734E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41429E+00   1.35777E+00  -1.41429E+00   1.35777E+00   6.07067E+01
+    5.61330E+00   6.07067E+01   5.61330E+00   9.17484E-01   2.32933E-03
+    9.17453E-01   2.32933E-03   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41376E+00   1.35773E+00  -1.41424E+00   1.35776E+00
+    6.07165E+01   5.61264E+00   6.07165E+01   5.61264E+00   9.17760E-01
+    2.31309E-03   9.17791E-01   2.31214E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41429E+00   1.35777E+00  -1.41429E+00
+    1.35777E+00   6.07067E+01   5.61330E+00   6.07067E+01   5.61330E+00
+    9.18062E-01   2.29603E-03   9.18062E-01   2.29603E-03   1.00000E+00
+    0.00000E+00   9.99988E+00   0.00000E+00  -1.41376E+00   1.35773E+00
+   -1.41376E+00   1.35773E+00   6.07087E+01   5.61313E+00   6.07087E+01
+    5.61313E+00   9.18369E-01   2.27979E-03   9.18369E-01   2.27979E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41376E+00
+    1.35776E+00  -1.41376E+00   1.35776E+00   6.07087E+01   5.61313E+00
+    6.07087E+01   5.61313E+00   9.18674E-01   2.26361E-03   9.18674E-01
+    2.26361E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41331E+00   1.35771E+00  -1.41331E+00   1.35771E+00   6.07145E+01
+    5.61281E+00   6.07145E+01   5.61281E+00   9.18976E-01   2.24655E-03
+    9.18976E-01   2.24655E-03   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41424E+00   1.35776E+00  -1.41424E+00   1.35776E+00
+    6.07126E+01   5.61313E+00   6.07126E+01   5.61313E+00   9.19252E-01
+    2.23126E-03   9.19252E-01   2.23126E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41380E+00   1.35774E+00  -1.41380E+00
+    1.35774E+00   6.07067E+01   5.61330E+00   6.07067E+01   5.61330E+00
+    9.19554E-01   2.21515E-03   9.19554E-01   2.21515E-03   1.00000E+00
+    0.00000E+00   9.99988E+00   0.00000E+00  -1.41424E+00   1.35776E+00
+   -1.41424E+00   1.35776E+00   6.07126E+01   5.61313E+00   6.07126E+01
+    5.61313E+00   9.19861E-01   2.19986E-03   9.19861E-01   2.19986E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41477E+00
+    1.35780E+00  -1.41477E+00   1.35780E+00   7.18725E+02  -2.94472E+01
+    7.18725E+02  -2.94472E+01   9.20133E-01   2.18470E-03   9.20133E-01
+    2.18470E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41424E+00   1.35776E+00  -1.41424E+00   1.35776E+00   1.64214E+02
+    0.00000E+00   1.64214E+02   0.00000E+00   9.20470E-01   2.16846E-03
+    9.20470E-01   2.16846E-03   1.00000E+00   0.00000E+00   9.99982E+00
+    0.00000E+00  -1.41380E+00   1.35774E+00  -1.41380E+00   1.35774E+00
+    1.64223E+02  -4.87181E-04   1.64223E+02  -4.87181E-04   9.20711E-01
+    2.15425E-03   9.20711E-01   2.15425E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41376E+00   1.35773E+00  -1.41376E+00
+    1.35773E+00   1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00
+    9.20988E-01   2.13896E-03   9.20988E-01   2.13896E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41522E+00   1.35782E+00
+   -1.41522E+00   1.35782E+00   1.64214E+02   0.00000E+00   1.64214E+02
+    0.00000E+00   9.21292E-01   2.12374E-03   9.21292E-01   2.12374E-03
+    1.00000E+00   0.00000E+00   9.99982E+00   0.00000E+00  -1.41331E+00
+    1.35771E+00  -1.41331E+00   1.35771E+00   1.64215E+02   0.00000E+00
+    1.64215E+02   0.00000E+00   9.21594E-01   2.10858E-03   9.21594E-01
+    2.10858E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00   1.64214E+02
+    0.00000E+00   1.64214E+02   0.00000E+00   9.21840E-01   2.09520E-03
+    9.21840E-01   2.09520E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41380E+00   1.35774E+00  -1.41380E+00   1.35774E+00
+    1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00   9.22142E-01
+    2.08003E-03   9.22142E-01   2.08003E-03   1.00000E+00   0.00000E+00
+    9.99988E+00   0.00000E+00  -1.41424E+00   1.35776E+00  -1.41424E+00
+    1.35776E+00   1.64226E+02  -4.87166E-04   1.64226E+02  -4.87166E-04
+    9.22419E-01   2.06570E-03   9.22419E-01   2.06570E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41380E+00   1.35774E+00
+   -1.41380E+00   1.35774E+00   1.64215E+02   0.00000E+00   1.64215E+02
+    0.00000E+00   9.22690E-01   2.05244E-03   9.22690E-01   2.05244E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41473E+00
+    1.35779E+00  -1.41473E+00   1.35779E+00   1.64214E+02   0.00000E+00
+    1.64214E+02   0.00000E+00   9.22936E-01   2.03715E-03   9.22936E-01
+    2.03715E-03   1.00000E+00   0.00000E+00   9.99982E+00   0.00000E+00
+   -1.41380E+00   1.35774E+00  -1.41380E+00   1.35774E+00   1.64215E+02
+    0.00000E+00   1.64215E+02   0.00000E+00   9.23208E-01   2.02485E-03
+    9.23208E-01   2.02485E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41376E+00   1.35776E+00  -1.41376E+00   1.35776E+00
+    1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00   9.23484E-01
+    2.01051E-03   9.23484E-01   2.01051E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41380E+00   1.35774E+00  -1.41380E+00
+    1.35774E+00   1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00
+    9.23756E-01   1.99630E-03   9.23756E-01   1.99630E-03   1.00000E+00
+    0.00000E+00   9.99988E+00   0.00000E+00  -1.41473E+00   1.35779E+00
+   -1.41473E+00   1.35779E+00   1.64226E+02  -4.87166E-04   1.64226E+02
+   -4.87166E-04   9.24002E-01   1.98387E-03   9.24002E-01   1.98387E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41376E+00
+    1.35773E+00  -1.41376E+00   1.35773E+00   1.64214E+02   0.00000E+00
+    1.64214E+02   0.00000E+00   9.24276E-01   1.96960E-03   9.24276E-01
+    1.96960E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41429E+00   1.35777E+00  -1.41429E+00   1.35777E+00   1.64215E+02
+    0.00000E+00   1.64215E+02   0.00000E+00   9.24517E-01   1.95729E-03
+    9.24517E-01   1.95729E-03   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41424E+00   1.35776E+00  -1.41424E+00   1.35776E+00
+    1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00   9.24794E-01
+    1.94391E-03   9.24794E-01   1.94391E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41282E+00   1.35771E+00  -1.41282E+00
+    1.35771E+00   1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00
+    9.25035E-01   1.93160E-03   9.25035E-01   1.93160E-03   1.00000E+00
+    0.00000E+00   9.99988E+00   0.00000E+00  -1.41473E+00   1.35782E+00
+   -1.41473E+00   1.35782E+00   1.64214E+02   0.00000E+00   1.64214E+02
+    0.00000E+00   9.25311E-01   1.91822E-03   9.25311E-01   1.91822E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41380E+00
+    1.35774E+00  -1.41380E+00   1.35774E+00   1.64227E+02  -4.87181E-04
+    1.64227E+02  -4.87181E-04   9.25553E-01   1.90591E-03   9.25553E-01
+    1.90591E-03   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41376E+00   1.35776E+00  -1.41376E+00   1.35776E+00   1.64214E+02
+    0.00000E+00   1.64214E+02   0.00000E+00   9.25798E-01   1.89348E-03
+    9.25798E-01   1.89348E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41380E+00   1.35774E+00  -1.41380E+00   1.35774E+00
+    1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00   9.26040E-01
+    1.88117E-03   9.26040E-01   1.88117E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41376E+00   1.35773E+00  -1.41376E+00
+    1.35773E+00   1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00
+    9.26286E-01   1.86874E-03   9.26286E-01   1.86874E-03   1.00000E+00
+    0.00000E+00   9.99982E+00   0.00000E+00  -1.41477E+00   1.35780E+00
+   -1.41477E+00   1.35780E+00   1.64215E+02   0.00000E+00   1.64215E+02
+    0.00000E+00   9.26557E-01   1.85643E-03   9.26557E-01   1.85643E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41376E+00
+    1.35773E+00  -1.41376E+00   1.35773E+00   1.64214E+02   0.00000E+00
+    1.64214E+02   0.00000E+00   9.26803E-01   1.84400E-03   9.26803E-01
+    1.84400E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00   1.64226E+02
+   -4.87166E-04   1.64226E+02  -4.87166E-04   9.27047E-01   1.83258E-03
+    9.27047E-01   1.83258E-03   1.00000E+00   0.00000E+00   9.99982E+00
+    0.00000E+00  -1.41477E+00   1.35777E+00  -1.41477E+00   1.35777E+00
+    1.64203E+02   4.87181E-04   1.64203E+02   4.87181E-04   9.27258E-01
+    1.82122E-03   9.27258E-01   1.82122E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41376E+00   1.35773E+00  -1.41376E+00
+    1.35773E+00   1.64222E+02  -4.87166E-04   1.64222E+02  -4.87166E-04
+    9.27534E-01   1.80879E-03   9.27534E-01   1.80879E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41380E+00   1.35777E+00
+   -1.41380E+00   1.35777E+00   1.64215E+02   0.00000E+00   1.64215E+02
+    0.00000E+00   9.27745E-01   1.79838E-03   9.27745E-01   1.79838E-03
+    1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00  -1.41278E+00
+    1.35770E+00  -1.41278E+00   1.35770E+00   1.64214E+02   0.00000E+00
+    1.64214E+02   0.00000E+00   9.27991E-01   1.78596E-03   9.27991E-01
+    1.78596E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41477E+00   1.35780E+00  -1.41477E+00   1.35780E+00   1.64211E+02
+    0.00000E+00   1.64211E+02   0.00000E+00   9.28232E-01   1.77460E-03
+    9.28232E-01   1.77460E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41376E+00   1.35776E+00  -1.41376E+00   1.35776E+00
+    1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00   9.28447E-01
+    1.76407E-03   9.28447E-01   1.76407E-03   1.00000E+00   0.00000E+00
+    9.99982E+00   0.00000E+00  -1.41477E+00   1.35780E+00  -1.41477E+00
+    1.35780E+00   1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00
+    9.28719E-01   1.75176E-03   9.28719E-01   1.75176E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41278E+00   1.35773E+00
+   -1.41278E+00   1.35773E+00   1.64222E+02  -4.87166E-04   1.64222E+02
+   -4.87166E-04   9.28904E-01   1.74219E-03   9.28904E-01   1.74219E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41380E+00
+    1.35774E+00  -1.41380E+00   1.35774E+00   1.64211E+02   0.00000E+00
+    1.64211E+02   0.00000E+00   9.29146E-01   1.72987E-03   9.29146E-01
+    1.72987E-03   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41570E+00   1.35779E+00  -1.41570E+00   1.35779E+00   1.64214E+02
+    0.00000E+00   1.64214E+02   0.00000E+00   9.29361E-01   1.72031E-03
+    9.29361E-01   1.72031E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41278E+00   1.35770E+00  -1.41278E+00   1.35770E+00
+    1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00   9.29604E-01
+    1.70889E-03   9.29604E-01   1.70889E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41477E+00   1.35780E+00  -1.41477E+00
+    1.35780E+00   1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00
+    9.29815E-01   1.69847E-03   9.29815E-01   1.69847E-03   1.00000E+00
+    0.00000E+00   9.99988E+00   0.00000E+00  -1.41376E+00   1.35776E+00
+   -1.41376E+00   1.35776E+00   1.64214E+02   0.00000E+00   1.64214E+02
+    0.00000E+00   9.30031E-01   1.68795E-03   9.30031E-01   1.68795E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41380E+00
+    1.35774E+00  -1.41380E+00   1.35774E+00   1.64215E+02   0.00000E+00
+    1.64215E+02   0.00000E+00   9.30272E-01   1.67659E-03   9.30272E-01
+    1.67659E-03   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41376E+00   1.35776E+00  -1.41376E+00   1.35776E+00   1.64214E+02
+    0.00000E+00   1.64214E+02   0.00000E+00   9.30487E-01   1.66797E-03
+    9.30487E-01   1.66797E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41380E+00   1.35774E+00  -1.41380E+00   1.35774E+00
+    1.64211E+02   0.00000E+00   1.64211E+02   0.00000E+00   9.30729E-01
+    1.65661E-03   9.30729E-01   1.65661E-03   1.00000E+00   0.00000E+00
+    9.99988E+00   0.00000E+00  -1.41473E+00   1.35779E+00  -1.41473E+00
+    1.35779E+00   1.64222E+02  -4.87166E-04   1.64222E+02  -4.87166E-04
+    9.30914E-01   1.64704E-03   9.30914E-01   1.64704E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41477E+00   1.35777E+00
+   -1.41477E+00   1.35777E+00   1.64211E+02   0.00000E+00   1.64211E+02
+    0.00000E+00   9.31125E-01   1.63662E-03   9.31125E-01   1.63662E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41278E+00
+    1.35770E+00  -1.41278E+00   1.35770E+00   1.64214E+02   0.00000E+00
+    1.64214E+02   0.00000E+00   9.31370E-01   1.62611E-03   9.31370E-01
+    1.62611E-03   1.00000E+00   0.00000E+00   9.99982E+00   0.00000E+00
+   -1.41477E+00   1.35780E+00  -1.41477E+00   1.35780E+00   1.64215E+02
+    0.00000E+00   1.64215E+02   0.00000E+00   9.31551E-01   1.61759E-03
+    9.31551E-01   1.61759E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41278E+00   1.35770E+00  -1.41278E+00   1.35770E+00
+    1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00   9.31766E-01
+    1.60708E-03   9.31766E-01   1.60708E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41570E+00   1.35782E+00  -1.41570E+00
+    1.35782E+00   1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00
+    9.32010E-01   1.59756E-03   9.32010E-01   1.59756E-03   1.00000E+00
+    0.00000E+00   9.99982E+00   0.00000E+00  -1.41282E+00   1.35771E+00
+   -1.41282E+00   1.35771E+00   1.64227E+02  -4.87181E-04   1.64227E+02
+   -4.87181E-04   9.32221E-01   1.58714E-03   9.32221E-01   1.58714E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41376E+00
+    1.35776E+00  -1.41376E+00   1.35776E+00   1.64214E+02   0.00000E+00
+    1.64214E+02   0.00000E+00   9.32406E-01   1.57853E-03   9.32406E-01
+    1.57853E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41575E+00   1.35780E+00  -1.41575E+00   1.35780E+00   1.64215E+02
+    0.00000E+00   1.64215E+02   0.00000E+00   9.32617E-01   1.56907E-03
+    9.32617E-01   1.56907E-03   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41278E+00   1.35770E+00  -1.41278E+00   1.35770E+00
+    1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00   9.32832E-01
+    1.55950E-03   9.32832E-01   1.55950E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41477E+00   1.35780E+00  -1.41477E+00
+    1.35780E+00   1.64227E+02  -4.87181E-04   1.64227E+02  -4.87181E-04
+    9.33043E-01   1.55003E-03   9.33043E-01   1.55003E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41376E+00   1.35776E+00
+   -1.41376E+00   1.35776E+00   1.64202E+02   4.87166E-04   1.64202E+02
+    4.87166E-04   9.33197E-01   1.54142E-03   9.33197E-01   1.54142E-03
+    1.00000E+00   0.00000E+00   9.99982E+00   0.00000E+00  -1.41477E+00
+    1.35777E+00  -1.41477E+00   1.35777E+00   1.64223E+02  -4.87181E-04
+    1.64223E+02  -4.87181E-04   9.33439E-01   1.53196E-03   9.33439E-01
+    1.53196E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41278E+00   1.35773E+00  -1.41278E+00   1.35773E+00   1.64210E+02
+    0.00000E+00   1.64210E+02   0.00000E+00   9.33624E-01   1.52335E-03
+    9.33624E-01   1.52335E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41477E+00   1.35777E+00  -1.41477E+00   1.35777E+00
+    1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00   9.33865E-01
+    1.51388E-03   9.33865E-01   1.51388E-03   1.00000E+00   0.00000E+00
+    9.99988E+00   0.00000E+00  -1.41376E+00   1.35773E+00  -1.41376E+00
+    1.35773E+00   1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00
+    9.34019E-01   1.50527E-03   9.34019E-01   1.50527E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41570E+00   1.35779E+00
+   -1.41570E+00   1.35779E+00   1.64226E+02  -4.87166E-04   1.64226E+02
+   -4.87166E-04   9.34233E-01   1.49670E-03   9.34233E-01   1.49670E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41380E+00
+    1.35774E+00  -1.41380E+00   1.35774E+00   1.64203E+02   4.87181E-04
+    1.64203E+02   4.87181E-04   9.34413E-01   1.48819E-03   9.34413E-01
+    1.48819E-03   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41376E+00   1.35776E+00  -1.41376E+00   1.35776E+00   1.64226E+02
+   -4.87166E-04   1.64226E+02  -4.87166E-04   9.34628E-01   1.47863E-03
+    9.34628E-01   1.47863E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41380E+00   1.35774E+00  -1.41380E+00   1.35774E+00
+    1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00   9.34809E-01
+    1.47106E-03   9.34809E-01   1.47106E-03   1.00000E+00   0.00000E+00
+    9.99988E+00   0.00000E+00  -1.41473E+00   1.35779E+00  -1.41473E+00
+    1.35779E+00   1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00
+    9.35024E-01   1.46150E-03   9.35024E-01   1.46150E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41380E+00   1.35774E+00
+   -1.41380E+00   1.35774E+00   1.64211E+02   0.00000E+00   1.64211E+02
+    0.00000E+00   9.35205E-01   1.45393E-03   9.35205E-01   1.45393E-03
+    1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00  -1.41473E+00
+    1.35779E+00  -1.41473E+00   1.35779E+00   1.64214E+02   0.00000E+00
+    1.64214E+02   0.00000E+00   9.35390E-01   1.44532E-03   9.35390E-01
+    1.44532E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41380E+00   1.35771E+00  -1.41380E+00   1.35771E+00   1.64215E+02
+    0.00000E+00   1.64215E+02   0.00000E+00   9.35570E-01   1.43775E-03
+    9.35570E-01   1.43775E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41473E+00   1.35776E+00  -1.41473E+00   1.35776E+00
+    1.64226E+02  -4.87166E-04   1.64226E+02  -4.87166E-04   9.35785E-01
+    1.42820E-03   9.35785E-01   1.42820E-03   1.00000E+00   0.00000E+00
+    9.99982E+00   0.00000E+00  -1.41477E+00   1.35780E+00  -1.41477E+00
+    1.35780E+00   1.64203E+02   4.87181E-04   1.64203E+02   4.87181E-04
+    9.35936E-01   1.42158E-03   9.35936E-01   1.42158E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41278E+00   1.35773E+00
+   -1.41278E+00   1.35773E+00   1.64226E+02  -4.87166E-04   1.64226E+02
+   -4.87166E-04   9.36151E-01   1.41202E-03   9.36151E-01   1.41202E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41473E+00
+    1.35779E+00  -1.41473E+00   1.35779E+00   1.64214E+02   0.00000E+00
+    1.64214E+02   0.00000E+00   9.36333E-01   1.40536E-03   9.36333E-01
+    1.40536E-03   1.00000E+00   0.00000E+00   9.99982E+00   0.00000E+00
+   -1.41282E+00   1.35771E+00  -1.41282E+00   1.35771E+00   1.64211E+02
+    0.00000E+00   1.64211E+02   0.00000E+00   9.36514E-01   1.39684E-03
+    9.36514E-01   1.39684E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41473E+00   1.35776E+00  -1.41473E+00   1.35776E+00
+    1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00   9.36699E-01
+    1.38918E-03   9.36699E-01   1.38918E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41380E+00   1.35774E+00  -1.41380E+00
+    1.35774E+00   1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00
+    9.36880E-01   1.38066E-03   9.36880E-01   1.38066E-03   1.00000E+00
+    0.00000E+00   9.99988E+00   0.00000E+00  -1.41473E+00   1.35779E+00
+   -1.41473E+00   1.35779E+00   1.64214E+02   0.00000E+00   1.64214E+02
+    0.00000E+00   9.37034E-01   1.37396E-03   9.37034E-01   1.37396E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41380E+00
+    1.35777E+00  -1.41380E+00   1.35777E+00   1.64227E+02  -4.87181E-04
+    1.64227E+02  -4.87181E-04   9.37245E-01   1.36544E-03   9.37245E-01
+    1.36544E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41473E+00   1.35776E+00  -1.41473E+00   1.35776E+00   1.64214E+02
+    0.00000E+00   1.64214E+02   0.00000E+00   9.37399E-01   1.35874E-03
+    9.37399E-01   1.35874E-03   1.00000E+00   0.00000E+00   9.99982E+00
+    0.00000E+00  -1.41282E+00   1.35771E+00  -1.41282E+00   1.35771E+00
+    1.64211E+02   0.00000E+00   1.64211E+02   0.00000E+00   9.37610E-01
+    1.35021E-03   9.37610E-01   1.35021E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41473E+00   1.35779E+00  -1.41473E+00
+    1.35779E+00   1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00
+    9.37765E-01   1.34351E-03   9.37765E-01   1.34351E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41376E+00   1.35776E+00
+   -1.41376E+00   1.35776E+00   1.64214E+02   0.00000E+00   1.64214E+02
+    0.00000E+00   9.37947E-01   1.33590E-03   9.37947E-01   1.33590E-03
+    1.00000E+00   0.00000E+00   9.99982E+00   0.00000E+00  -1.41477E+00
+    1.35777E+00  -1.41477E+00   1.35777E+00   1.64215E+02   0.00000E+00
+    1.64215E+02   0.00000E+00   9.38098E-01   1.32928E-03   9.38098E-01
+    1.32928E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41278E+00   1.35773E+00  -1.41278E+00   1.35773E+00   1.64226E+02
+   -4.87166E-04   1.64226E+02  -4.87166E-04   9.38282E-01   1.32068E-03
+    9.38282E-01   1.32068E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41380E+00   1.35777E+00  -1.41380E+00   1.35777E+00
+    1.64203E+02   4.87181E-04   1.64203E+02   4.87181E-04   9.38463E-01
+    1.31406E-03   9.38463E-01   1.31406E-03   1.00000E+00   0.00000E+00
+    9.99988E+00   0.00000E+00  -1.41376E+00   1.35773E+00  -1.41376E+00
+    1.35773E+00   1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00
+    9.38617E-01   1.30736E-03   9.38617E-01   1.30736E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41477E+00   1.35777E+00
+   -1.41477E+00   1.35777E+00   1.64223E+02  -4.87181E-04   1.64223E+02
+   -4.87181E-04   9.38798E-01   1.29978E-03   9.38798E-01   1.29978E-03
+    1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00  -1.41473E+00
+    1.35779E+00  -1.41473E+00   1.35779E+00   1.64202E+02   4.87166E-04
+    1.64202E+02   4.87166E-04   9.38982E-01   1.29213E-03   9.38982E-01
+    1.29213E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41088E+00   1.35765E+00  -1.41088E+00   1.35765E+00   1.64227E+02
+   -4.87181E-04   1.64227E+02  -4.87181E-04   9.39133E-01   1.28646E-03
+    9.39133E-01   1.28646E-03   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00
+    1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00   9.39317E-01
+    1.27881E-03   9.39317E-01   1.27881E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41380E+00   1.35774E+00  -1.41380E+00
+    1.35774E+00   1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00
+    9.39498E-01   1.27124E-03   9.39498E-01   1.27124E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41376E+00   1.35776E+00
+   -1.41376E+00   1.35776E+00   1.64226E+02  -4.87166E-04   1.64226E+02
+   -4.87166E-04   9.39652E-01   1.26549E-03   9.39652E-01   1.26549E-03
+    1.00000E+00   0.00000E+00   9.99982E+00   0.00000E+00  -1.41473E+00
+    1.35776E+00  -1.41473E+00   1.35776E+00   1.64214E+02   0.00000E+00
+    1.64214E+02   0.00000E+00   9.39835E-01   1.25788E-03   9.39835E-01
+    1.25788E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41380E+00   1.35774E+00  -1.41380E+00   1.35774E+00   1.64215E+02
+    0.00000E+00   1.64215E+02   0.00000E+00   9.39955E-01   1.25221E-03
+    9.39955E-01   1.25221E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41473E+00   1.35776E+00  -1.41473E+00   1.35776E+00
+    1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00   9.40139E-01
+    1.24456E-03   9.40139E-01   1.24456E-03   1.00000E+00   0.00000E+00
+    9.99982E+00   0.00000E+00  -1.41575E+00   1.35783E+00  -1.41575E+00
+    1.35783E+00   1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00
+    9.40320E-01   1.23793E-03   9.40320E-01   1.23793E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41181E+00   1.35767E+00
+   -1.41181E+00   1.35767E+00   1.64214E+02   0.00000E+00   1.64214E+02
+    0.00000E+00   9.40444E-01   1.23219E-03   9.40444E-01   1.23219E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41575E+00
+    1.35783E+00  -1.41575E+00   1.35783E+00   1.64211E+02   0.00000E+00
+    1.64211E+02   0.00000E+00   9.40625E-01   1.22461E-03   9.40625E-01
+    1.22461E-03   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41278E+00   1.35773E+00  -1.41278E+00   1.35773E+00   1.64214E+02
+    0.00000E+00   1.64214E+02   0.00000E+00   9.40779E-01   1.21887E-03
+    9.40779E-01   1.21887E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41380E+00   1.35777E+00  -1.41380E+00   1.35777E+00
+    1.64227E+02  -4.87181E-04   1.64227E+02  -4.87181E-04   9.40899E-01
+    1.21320E-03   9.40899E-01   1.21320E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41278E+00   1.35773E+00  -1.41278E+00
+    1.35773E+00   1.64214E+02   0.00000E+00   1.64214E+02   0.00000E+00
+    9.41083E-01   1.20650E-03   9.41083E-01   1.20650E-03   1.00000E+00
+    0.00000E+00   9.99982E+00   0.00000E+00  -1.41380E+00   1.35777E+00
+   -1.41380E+00   1.35777E+00   1.64215E+02   0.00000E+00   1.64215E+02
+    0.00000E+00   9.41264E-01   1.19987E-03   9.41264E-01   1.19987E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41376E+00
+    1.35773E+00  -1.41376E+00   1.35773E+00   1.64226E+02  -4.87166E-04
+    1.64226E+02  -4.87166E-04   9.41388E-01   1.19413E-03   9.41388E-01
+    1.19413E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00   1.64202E+02
+    4.87166E-04   1.64202E+02   4.87166E-04   9.41571E-01   1.18747E-03
+    9.41571E-01   1.18747E-03   1.00000E+00   0.00000E+00   9.99982E+00
+    0.00000E+00  -1.41477E+00   1.35777E+00  -1.41477E+00   1.35777E+00
+    1.64223E+02  -4.87181E-04   1.64223E+02  -4.87181E-04   9.41751E-01
+    1.17989E-03   9.41751E-01   1.17989E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41278E+00   1.35773E+00  -1.41278E+00
+    1.35773E+00   1.64210E+02   0.00000E+00   1.64210E+02   0.00000E+00
+    9.41845E-01   1.17605E-03   9.41845E-01   1.17605E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41380E+00   1.35777E+00
+   -1.41380E+00   1.35777E+00   1.64215E+02   0.00000E+00   1.64215E+02
+    0.00000E+00   9.42025E-01   1.16847E-03   9.42025E-01   1.16847E-03
+    1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00  -1.41376E+00
+    1.35773E+00  -1.41376E+00   1.35773E+00   1.64218E+02   0.00000E+00
+    1.64218E+02   0.00000E+00   9.42179E-01   1.16273E-03   9.42179E-01
+    1.16273E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41575E+00   1.35783E+00  -1.41575E+00   1.35783E+00   1.64207E+02
+    0.00000E+00   1.64207E+02   0.00000E+00   9.42330E-01   1.15706E-03
+    9.42330E-01   1.15706E-03   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00
+    1.64218E+02   0.00000E+00   1.64218E+02   0.00000E+00   9.42484E-01
+    1.15131E-03   9.42484E-01   1.15131E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41088E+00   1.35765E+00  -1.41088E+00
+    1.35765E+00   1.64231E+02  -4.87181E-04   1.64231E+02  -4.87181E-04
+    9.42634E-01   1.14564E-03   9.42634E-01   1.14564E-03   1.00000E+00
+    0.00000E+00   9.99988E+00   0.00000E+00  -1.41570E+00   1.35779E+00
+   -1.41570E+00   1.35779E+00   1.64202E+02   4.87166E-04   1.64202E+02
+    4.87166E-04   9.42819E-01   1.13894E-03   9.42819E-01   1.13894E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41477E+00
+    1.35777E+00  -1.41477E+00   1.35777E+00   1.64223E+02  -4.87181E-04
+    1.64223E+02  -4.87181E-04   9.42908E-01   1.13422E-03   9.42908E-01
+    1.13422E-03   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00   1.64218E+02
+    0.00000E+00   1.64218E+02   0.00000E+00   9.43093E-01   1.12752E-03
+    9.43093E-01   1.12752E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41376E+00   1.35773E+00  -1.41376E+00   1.35773E+00
+    1.64210E+02   0.00000E+00   1.64210E+02   0.00000E+00   9.43215E-01
+    1.12277E-03   9.43215E-01   1.12277E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41282E+00   1.35771E+00  -1.41282E+00
+    1.35771E+00   1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00
+    9.43396E-01   1.11614E-03   9.43396E-01   1.11614E-03   1.00000E+00
+    0.00000E+00   9.99988E+00   0.00000E+00  -1.41570E+00   1.35779E+00
+   -1.41570E+00   1.35779E+00   1.64226E+02  -4.87166E-04   1.64226E+02
+   -4.87166E-04   9.43519E-01   1.11135E-03   9.43519E-01   1.11135E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41477E+00
+    1.35777E+00  -1.41477E+00   1.35777E+00   1.64199E+02   4.87181E-04
+    1.64199E+02   4.87181E-04   9.43639E-01   1.10567E-03   9.43639E-01
+    1.10567E-03   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41376E+00   1.35773E+00  -1.41376E+00   1.35773E+00   1.64226E+02
+   -4.87166E-04   1.64226E+02  -4.87166E-04   9.43854E-01   1.09898E-03
+    9.43854E-01   1.09898E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41380E+00   1.35777E+00  -1.41380E+00   1.35777E+00
+    1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00   9.43944E-01
+    1.09521E-03   9.43944E-01   1.09521E-03   1.00000E+00   0.00000E+00
+    1.00004E+01   0.00000E+00  -1.41473E+00   1.35779E+00  -1.41473E+00
+    1.35779E+00   1.64218E+02   0.00000E+00   1.64218E+02   0.00000E+00
+    9.44098E-01   1.08851E-03   9.44098E-01   1.08851E-03   1.00000E+00
+    0.00000E+00   9.99957E+00   0.00000E+00  -1.41282E+00   1.35771E+00
+   -1.41282E+00   1.35771E+00   1.64207E+02   0.00000E+00   1.64207E+02
+    0.00000E+00   9.44218E-01   1.08379E-03   9.44218E-01   1.08379E-03
+    1.00000E+00   0.00000E+00   1.00004E+01   0.00000E+00  -1.41570E+00
+    1.35779E+00  -1.41570E+00   1.35779E+00   1.64218E+02   0.00000E+00
+    1.64218E+02   0.00000E+00   9.44402E-01   1.07805E-03   9.44402E-01
+    1.07805E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41380E+00   1.35777E+00  -1.41380E+00   1.35777E+00   1.64215E+02
+    0.00000E+00   1.64215E+02   0.00000E+00   9.44522E-01   1.07332E-03
+    9.44522E-01   1.07332E-03   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00
+    1.64226E+02  -4.87166E-04   1.64226E+02  -4.87166E-04   9.44646E-01
+    1.06758E-03   9.44646E-01   1.06758E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41278E+00   1.35773E+00  -1.41278E+00
+    1.35773E+00   1.64218E+02   0.00000E+00   1.64218E+02   0.00000E+00
+    9.44828E-01   1.06187E-03   9.44828E-01   1.06187E-03   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41477E+00   1.35777E+00
+   -1.41477E+00   1.35777E+00   1.64215E+02   0.00000E+00   1.64215E+02
+    0.00000E+00   9.44949E-01   1.05714E-03   9.44949E-01   1.05714E-03
+    1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00  -1.41181E+00
+    1.35767E+00  -1.41181E+00   1.35767E+00   1.64210E+02   0.00000E+00
+    1.64210E+02   0.00000E+00   9.45042E-01   1.05236E-03   9.45042E-01
+    1.05236E-03   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41672E+00   1.35783E+00  -1.41672E+00   1.35783E+00   1.64215E+02
+    0.00000E+00   1.64215E+02   0.00000E+00   9.45223E-01   1.04668E-03
+    9.45223E-01   1.04668E-03   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41376E+00   1.35773E+00  -1.41376E+00   1.35773E+00
+    1.64210E+02   0.00000E+00   1.64210E+02   0.00000E+00   9.45316E-01
+    1.04189E-03   9.45316E-01   1.04189E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41477E+00   1.35777E+00  -1.41477E+00
+    1.35777E+00   1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00
+    9.45466E-01   1.03621E-03   9.45466E-01   1.03621E-03   1.00000E+00
+    0.00000E+00   9.99988E+00   0.00000E+00  -1.41278E+00   1.35773E+00
+   -1.41278E+00   1.35773E+00   1.64218E+02   0.00000E+00   1.64218E+02
+    0.00000E+00   9.45590E-01   1.03237E-03   9.45590E-01   1.03237E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41282E+00
+    1.35771E+00  -1.41282E+00   1.35771E+00   1.64231E+02  -4.87181E-04
+    1.64231E+02  -4.87181E-04   9.45771E-01   1.02574E-03   9.45771E-01
+    1.02574E-03   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41668E+00   1.35785E+00  -1.41668E+00   1.35785E+00   1.64210E+02
+    0.00000E+00   1.64210E+02   0.00000E+00   9.45864E-01   1.02191E-03
+    9.45864E-01   1.02191E-03   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41376E+00   1.35773E+00  -1.41376E+00   1.35773E+00
+    1.64202E+02   4.87166E-04   1.64202E+02   4.87166E-04   9.45955E-01
+    1.01905E-03   9.45955E-01   1.01905E-03   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41282E+00   1.35771E+00  -1.41282E+00
+    1.35771E+00   1.64223E+02  -4.87181E-04   1.64223E+02  -4.87181E-04
+    9.46197E-01   1.00957E-03   9.46197E-01   1.00957E-03   1.00000E+00
+    0.00000E+00   9.99988E+00   0.00000E+00  -1.41570E+00   1.35779E+00
+   -1.41570E+00   1.35779E+00   1.64210E+02   0.00000E+00   1.64210E+02
+    0.00000E+00   9.46259E-01   1.00763E-03   9.46259E-01   1.00763E-03
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41282E+00
+    1.35771E+00  -1.41282E+00   1.35771E+00   1.64215E+02   0.00000E+00
+    1.64215E+02   0.00000E+00   9.46441E-01   1.00196E-03   9.46441E-01
+    1.00196E-03   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41668E+00   1.35785E+00  -1.41668E+00   1.35785E+00   1.64226E+02
+   -4.87166E-04   1.64226E+02  -4.87166E-04   9.46534E-01   9.98120E-04
+    9.46534E-01   9.98120E-04   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41672E+00   1.35783E+00  -1.41672E+00   1.35783E+00
+    1.64199E+02   4.87181E-04   1.64199E+02   4.87181E-04   9.46654E-01
+    9.92441E-04   9.46654E-01   9.92441E-04   1.00000E+00   0.00000E+00
+    1.00004E+01   0.00000E+00  -1.41278E+00   1.35773E+00  -1.41278E+00
+    1.35773E+00   1.64210E+02   0.00000E+00   1.64210E+02   0.00000E+00
+    9.46777E-01   9.88605E-04   9.46777E-01   9.88605E-04   1.00000E+00
+    0.00000E+00   9.99957E+00   0.00000E+00  -1.41477E+00   1.35777E+00
+   -1.41477E+00   1.35777E+00   1.64223E+02  -4.87181E-04   1.64223E+02
+   -4.87181E-04   9.46928E-01   9.82926E-04   9.46928E-01   9.82926E-04
+    1.00000E+00   0.00000E+00   1.00004E+01   0.00000E+00  -1.41473E+00
+    1.35779E+00  -1.41473E+00   1.35779E+00   1.64202E+02   4.87166E-04
+    1.64202E+02   4.87166E-04   9.47021E-01   9.79090E-04   9.47021E-01
+    9.79090E-04   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41575E+00   1.35783E+00  -1.41575E+00   1.35783E+00   1.64231E+02
+   -4.87181E-04   1.64231E+02  -4.87181E-04   9.47171E-01   9.74362E-04
+    9.47171E-01   9.74362E-04   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41181E+00   1.35767E+00  -1.41181E+00   1.35767E+00
+    1.64210E+02   0.00000E+00   1.64210E+02   0.00000E+00   9.47325E-01
+    9.69575E-04   9.47325E-01   9.69575E-04   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41278E+00   1.35773E+00  -1.41278E+00
+    1.35773E+00   1.64218E+02   0.00000E+00   1.64218E+02   0.00000E+00
+    9.47447E-01   9.64817E-04   9.47447E-01   9.64817E-04   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41477E+00   1.35777E+00
+   -1.41477E+00   1.35777E+00   1.64231E+02  -4.87181E-04   1.64231E+02
+   -4.87181E-04   9.47567E-01   9.60089E-04   9.47567E-01   9.60089E-04
+    1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00  -1.41473E+00
+    1.35779E+00  -1.41473E+00   1.35779E+00   1.64210E+02   0.00000E+00
+    1.64210E+02   0.00000E+00   9.47660E-01   9.56254E-04   9.47660E-01
+    9.56254E-04   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41477E+00   1.35777E+00  -1.41477E+00   1.35777E+00   1.64215E+02
+    0.00000E+00   1.64215E+02   0.00000E+00   9.47811E-01   9.51525E-04
+    9.47811E-01   9.51525E-04   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41278E+00   1.35773E+00  -1.41278E+00   1.35773E+00
+    1.64226E+02  -4.87166E-04   1.64226E+02  -4.87166E-04   9.47904E-01
+    9.47691E-04   9.47904E-01   9.47691E-04   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41477E+00   1.35777E+00  -1.41477E+00
+    1.35777E+00   1.64207E+02   4.87181E-04   1.64207E+02   4.87181E-04
+    9.48054E-01   9.42010E-04   9.48054E-01   9.42010E-04   1.00000E+00
+    0.00000E+00   9.99988E+00   0.00000E+00  -1.41473E+00   1.35773E+00
+   -1.41473E+00   1.35773E+00   1.64226E+02  -4.87166E-04   1.64226E+02
+   -4.87166E-04   9.48178E-01   9.39127E-04   9.48178E-01   9.39127E-04
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41282E+00
+    1.35771E+00  -1.41282E+00   1.35771E+00   1.64199E+02   4.87181E-04
+    1.64199E+02   4.87181E-04   9.48298E-01   9.33447E-04   9.48298E-01
+    9.33447E-04   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41668E+00   1.35785E+00  -1.41668E+00   1.35785E+00   1.64226E+02
+   -4.87166E-04   1.64226E+02  -4.87166E-04   9.48421E-01   9.30564E-04
+    9.48421E-01   9.30564E-04   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41088E+00   1.35771E+00  -1.41088E+00   1.35771E+00
+    1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00   9.48572E-01
+    9.24883E-04   9.48572E-01   9.24883E-04   1.00000E+00   0.00000E+00
+    9.99988E+00   0.00000E+00  -1.41668E+00   1.35779E+00  -1.41668E+00
+    1.35779E+00   1.64210E+02   0.00000E+00   1.64210E+02   0.00000E+00
+    9.48634E-01   9.22000E-04   9.48634E-01   9.22000E-04   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41668E+00   1.35779E+00
+   -1.41668E+00   1.35779E+00   1.64218E+02   0.00000E+00   1.64218E+02
+    0.00000E+00   9.48787E-01   9.17243E-04   9.48787E-01   9.17243E-04
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41282E+00
+    1.35771E+00  -1.41282E+00   1.35771E+00   1.64231E+02  -4.87181E-04
+    1.64231E+02  -4.87181E-04   9.48907E-01   9.12513E-04   9.48907E-01
+    9.12513E-04   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00   1.64195E+02
+    4.87166E-04   1.64195E+02   4.87166E-04   9.49030E-01   9.08679E-04
+    9.49030E-01   9.08679E-04   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41477E+00   1.35777E+00  -1.41477E+00   1.35777E+00
+    1.64231E+02  -4.87181E-04   1.64231E+02  -4.87181E-04   9.49120E-01
+    9.04901E-04   9.49120E-01   9.04901E-04   1.00000E+00   0.00000E+00
+    9.99988E+00   0.00000E+00  -1.41473E+00   1.35773E+00  -1.41473E+00
+    1.35773E+00   1.64218E+02   0.00000E+00   1.64218E+02   0.00000E+00
+    9.49274E-01   9.00116E-04   9.49274E-01   9.00116E-04   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41282E+00   1.35771E+00
+   -1.41282E+00   1.35771E+00   1.64207E+02   0.00000E+00   1.64207E+02
+    0.00000E+00   9.49333E-01   8.97289E-04   9.49333E-01   8.97289E-04
+    1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00  -1.41668E+00
+    1.35785E+00  -1.41668E+00   1.35785E+00   1.64218E+02   0.00000E+00
+    1.64218E+02   0.00000E+00   9.49487E-01   8.92504E-04   9.49487E-01
+    8.92504E-04   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41282E+00   1.35771E+00  -1.41282E+00   1.35771E+00   1.64215E+02
+    0.00000E+00   1.64215E+02   0.00000E+00   9.49638E-01   8.87773E-04
+    9.49638E-01   8.87773E-04   1.00000E+00   0.00000E+00   1.00004E+01
+    0.00000E+00  -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00
+    1.64210E+02   0.00000E+00   1.64210E+02   0.00000E+00   9.49700E-01
+    8.84892E-04   9.49700E-01   8.84892E-04   1.00000E+00   0.00000E+00
+    9.99957E+00   0.00000E+00  -1.41088E+00   1.35765E+00  -1.41088E+00
+    1.35765E+00   1.64231E+02  -4.87181E-04   1.64231E+02  -4.87181E-04
+    9.49851E-01   8.80161E-04   9.49851E-01   8.80161E-04   1.00000E+00
+    0.00000E+00   1.00004E+01   0.00000E+00  -1.41473E+00   1.35779E+00
+   -1.41473E+00   1.35779E+00   1.64210E+02   0.00000E+00   1.64210E+02
+    0.00000E+00   9.49913E-01   8.77280E-04   9.49913E-01   8.77280E-04
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41668E+00
+    1.35785E+00  -1.41668E+00   1.35785E+00   1.64218E+02   0.00000E+00
+    1.64218E+02   0.00000E+00   9.50065E-01   8.72522E-04   9.50065E-01
+    8.72522E-04   1.00000E+00   0.00000E+00   9.99957E+00   0.00000E+00
+   -1.41477E+00   1.35777E+00  -1.41477E+00   1.35777E+00   1.64215E+02
+    0.00000E+00   1.64215E+02   0.00000E+00   9.50155E-01   8.68743E-04
+    9.50155E-01   8.68743E-04   1.00000E+00   0.00000E+00   1.00004E+01
+    0.00000E+00  -1.41278E+00   1.35773E+00  -1.41278E+00   1.35773E+00
+    1.64210E+02   0.00000E+00   1.64210E+02   0.00000E+00   9.50309E-01
+    8.64910E-04   9.50309E-01   8.64910E-04   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41088E+00   1.35771E+00  -1.41088E+00
+    1.35771E+00   1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00
+    9.50399E-01   8.61131E-04   9.50399E-01   8.61131E-04   1.00000E+00
+    0.00000E+00   9.99988E+00   0.00000E+00  -1.41473E+00   1.35779E+00
+   -1.41473E+00   1.35779E+00   1.64226E+02  -4.87166E-04   1.64226E+02
+   -4.87166E-04   9.50492E-01   8.57298E-04   9.50492E-01   8.57298E-04
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41477E+00
+    1.35777E+00  -1.41477E+00   1.35777E+00   1.64199E+02   4.87181E-04
+    1.64199E+02   4.87181E-04   9.50612E-01   8.53518E-04   9.50612E-01
+    8.53518E-04   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00   1.64226E+02
+   -4.87166E-04   1.64226E+02  -4.87166E-04   9.50735E-01   8.49686E-04
+    9.50735E-01   8.49686E-04   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41282E+00   1.35771E+00  -1.41282E+00   1.35771E+00
+    1.64207E+02   0.00000E+00   1.64207E+02   0.00000E+00   9.50856E-01
+    8.45906E-04   9.50856E-01   8.45906E-04   1.00000E+00   0.00000E+00
+    9.99988E+00   0.00000E+00  -1.41278E+00   1.35773E+00  -1.41278E+00
+    1.35773E+00   1.64218E+02   0.00000E+00   1.64218E+02   0.00000E+00
+    9.50948E-01   8.42074E-04   9.50948E-01   8.42074E-04   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41672E+00   1.35783E+00
+   -1.41672E+00   1.35783E+00   1.64215E+02   0.00000E+00   1.64215E+02
+    0.00000E+00   9.51038E-01   8.39246E-04   9.51038E-01   8.39246E-04
+    1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00  -1.41473E+00
+    1.35779E+00  -1.41473E+00   1.35779E+00   1.64210E+02   0.00000E+00
+    1.64210E+02   0.00000E+00   9.51162E-01   8.35414E-04   9.51162E-01
+    8.35414E-04   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41278E+00   1.35767E+00  -1.41278E+00   1.35767E+00   1.64210E+02
+    0.00000E+00   1.64210E+02   0.00000E+00   9.51283E-01   8.30656E-04
+    9.51283E-01   8.30656E-04   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41477E+00   1.35777E+00  -1.41477E+00   1.35777E+00
+    1.64223E+02  -4.87181E-04   1.64223E+02  -4.87181E-04   9.51404E-01
+    8.27827E-04   9.51404E-01   8.27827E-04   1.00000E+00   0.00000E+00
+    9.99988E+00   0.00000E+00  -1.41473E+00   1.35779E+00  -1.41473E+00
+    1.35779E+00   1.64218E+02   0.00000E+00   1.64218E+02   0.00000E+00
+    9.51466E-01   8.24947E-04   9.51466E-01   8.24947E-04   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41282E+00   1.35771E+00
+   -1.41282E+00   1.35771E+00   1.64215E+02   0.00000E+00   1.64215E+02
+    0.00000E+00   9.51586E-01   8.20215E-04   9.51586E-01   8.20215E-04
+    1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00  -1.41473E+00
+    1.35779E+00  -1.41473E+00   1.35779E+00   1.64210E+02   0.00000E+00
+    1.64210E+02   0.00000E+00   9.51710E-01   8.17336E-04   9.51710E-01
+    8.17336E-04   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41477E+00   1.35777E+00  -1.41477E+00   1.35777E+00   1.64215E+02
+    0.00000E+00   1.64215E+02   0.00000E+00   9.51830E-01   8.13554E-04
+    9.51830E-01   8.13554E-04   1.00000E+00   0.00000E+00   1.00004E+01
+    0.00000E+00  -1.41668E+00   1.35785E+00  -1.41668E+00   1.35785E+00
+    1.64195E+02   4.87166E-04   1.64195E+02   4.87166E-04   9.51923E-01
+    8.09724E-04   9.51923E-01   8.09724E-04   1.00000E+00   0.00000E+00
+    9.99957E+00   0.00000E+00  -1.41282E+00   1.35777E+00  -1.41282E+00
+    1.35777E+00   1.64231E+02  -4.87181E-04   1.64231E+02  -4.87181E-04
+    9.52013E-01   8.06894E-04   9.52013E-01   8.06894E-04   1.00000E+00
+    0.00000E+00   1.00004E+01   0.00000E+00  -1.41473E+00   1.35773E+00
+   -1.41473E+00   1.35773E+00   1.64210E+02   0.00000E+00   1.64210E+02
+    0.00000E+00   9.52105E-01   8.03063E-04   9.52105E-01   8.03063E-04
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41477E+00
+    1.35777E+00  -1.41477E+00   1.35777E+00   1.64223E+02  -4.87181E-04
+    1.64223E+02  -4.87181E-04   9.52226E-01   8.00233E-04   9.52226E-01
+    8.00233E-04   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41473E+00   1.35773E+00  -1.41473E+00   1.35773E+00   1.64218E+02
+    0.00000E+00   1.64218E+02   0.00000E+00   9.52319E-01   7.96403E-04
+    9.52319E-01   7.96403E-04   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00
+    1.64195E+02   4.87166E-04   1.64195E+02   4.87166E-04   9.52440E-01
+    7.92597E-04   9.52440E-01   7.92597E-04   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41477E+00   1.35777E+00  -1.41477E+00
+    1.35777E+00   1.64246E+02  -9.74362E-04   1.64246E+02  -9.74362E-04
+    9.52530E-01   7.89766E-04   9.52530E-01   7.89766E-04   1.00000E+00
+    0.00000E+00   9.99988E+00   0.00000E+00  -1.41083E+00   1.35767E+00
+   -1.41083E+00   1.35767E+00   1.64195E+02   4.87166E-04   1.64195E+02
+    4.87166E-04   9.52654E-01   7.85936E-04   9.52654E-01   7.85936E-04
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41672E+00
+    1.35783E+00  -1.41672E+00   1.35783E+00   1.64231E+02  -4.87181E-04
+    1.64231E+02  -4.87181E-04   9.52743E-01   7.83105E-04   9.52743E-01
+    7.83105E-04   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+   -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00   1.64218E+02
+    0.00000E+00   1.64218E+02   0.00000E+00   9.52836E-01   7.80227E-04
+    9.52836E-01   7.80227E-04   1.00000E+00   0.00000E+00   1.00001E+01
+    0.00000E+00  -1.41477E+00   1.35777E+00  -1.41477E+00   1.35777E+00
+    1.64207E+02   0.00000E+00   1.64207E+02   0.00000E+00   9.52987E-01
+    7.75493E-04   9.52987E-01   7.75493E-04   1.00000E+00   0.00000E+00
+    9.99988E+00   0.00000E+00  -1.41278E+00   1.35773E+00  -1.41278E+00
+    1.35773E+00   1.64218E+02   0.00000E+00   1.64218E+02   0.00000E+00
+    9.53049E-01   7.73567E-04   9.53049E-01   7.73567E-04   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41477E+00   1.35777E+00
+   -1.41477E+00   1.35777E+00   1.64215E+02   0.00000E+00   1.64215E+02
+    0.00000E+00   9.53139E-01   7.69784E-04   9.53139E-01   7.69784E-04
+    1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00  -1.41278E+00
+    1.35773E+00  -1.41278E+00   1.35773E+00   1.64210E+02   0.00000E+00
+    1.64210E+02   0.00000E+00   9.53232E-01   7.66906E-04   9.53232E-01
+    7.66906E-04   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41477E+00   1.35783E+00  -1.41477E+00   1.35783E+00   1.64231E+02
+   -4.87181E-04   1.64231E+02  -4.87181E-04   9.53352E-01   7.63123E-04
+    9.53352E-01   7.63123E-04   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41083E+00   1.35767E+00  -1.41083E+00   1.35767E+00
+    1.64195E+02   4.87166E-04   1.64195E+02   4.87166E-04   9.53415E-01
+    7.60246E-04   9.53415E-01   7.60246E-04   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41278E+00   1.35773E+00  -1.41278E+00
+    1.35773E+00   1.64218E+02   0.00000E+00   1.64218E+02   0.00000E+00
+    9.53537E-01   7.57391E-04   9.53537E-01   7.57391E-04   1.00000E+00
+    0.00000E+00   1.00001E+01   0.00000E+00  -1.41867E+00   1.35790E+00
+   -1.41867E+00   1.35790E+00   1.64223E+02  -4.87181E-04   1.64223E+02
+   -4.87181E-04   9.53626E-01   7.54560E-04   9.53626E-01   7.54560E-04
+    1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00  -1.41278E+00
+    1.35773E+00  -1.41278E+00   1.35773E+00   1.64218E+02   0.00000E+00
+    1.64218E+02   0.00000E+00   9.53719E-01   7.50731E-04   9.53719E-01
+    7.50731E-04   1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00
+   -1.41282E+00   1.35771E+00  -1.41282E+00   1.35771E+00   1.64215E+02
+    0.00000E+00   1.64215E+02   0.00000E+00   9.53840E-01   7.47899E-04
+    9.53840E-01   7.47899E-04   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00
+    1.64210E+02   0.00000E+00   1.64210E+02   0.00000E+00   9.53963E-01
+    7.44070E-04   9.53963E-01   7.44070E-04   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41282E+00   1.35771E+00  -1.41282E+00
+    1.35771E+00   1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00
+    9.53992E-01   7.42190E-04   9.53992E-01   7.42190E-04   1.00000E+00
+    0.00000E+00   9.99988E+00   0.00000E+00  -1.41668E+00   1.35785E+00
+   -1.41668E+00   1.35785E+00   1.64226E+02  -4.87166E-04   1.64226E+02
+   -4.87166E-04   9.54115E-01   7.38361E-04   9.54115E-01   7.38361E-04
+    1.00000E+00   0.00000E+00   1.00001E+01   0.00000E+00  -1.41282E+00
+    1.35771E+00  -1.41282E+00   1.35771E+00   1.64199E+02   4.87181E-04
+    1.64199E+02   4.87181E-04   9.54205E-01   7.35529E-04   9.54205E-01
+    7.35529E-04   1.00000E+00   0.00000E+00   1.00004E+01   0.00000E+00
+   -1.41278E+00   1.35773E+00  -1.41278E+00   1.35773E+00   1.64210E+02
+    0.00000E+00   1.64210E+02   0.00000E+00   9.54328E-01   7.32652E-04
+    9.54328E-01   7.32652E-04   1.00000E+00   0.00000E+00   9.99957E+00
+    0.00000E+00  -1.41473E+00   1.35779E+00  -1.41473E+00   1.35779E+00
+    1.64233E+02  -4.87166E-04   1.64233E+02  -4.87166E-04   9.54389E-01
+    7.29798E-04   9.54389E-01   7.29798E-04   1.00000E+00   0.00000E+00
+    1.00001E+01   0.00000E+00  -1.41477E+00   1.35777E+00  -1.41477E+00
+    1.35777E+00   1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00
+    9.54509E-01   7.26965E-04   9.54509E-01   7.26965E-04   1.00000E+00
+    0.00000E+00   1.00004E+01   0.00000E+00  -1.41473E+00   1.35779E+00
+   -1.41473E+00   1.35779E+00   1.64210E+02   0.00000E+00   1.64210E+02
+    0.00000E+00   9.54602E-01   7.23137E-04   9.54602E-01   7.23137E-04
+    1.00000E+00   0.00000E+00   9.99957E+00   0.00000E+00  -1.41672E+00
+    1.35783E+00  -1.41672E+00   1.35783E+00   1.64231E+02  -4.87181E-04
+    1.64231E+02  -4.87181E-04   9.54662E-01   7.21256E-04   9.54662E-01
+    7.21256E-04   1.00000E+00   0.00000E+00   1.00004E+01   0.00000E+00
+   -1.41282E+00   1.35777E+00  -1.41282E+00   1.35777E+00   1.64192E+02
+    4.87181E-04   1.64192E+02   4.87181E-04   9.54814E-01   7.17450E-04
+    9.54814E-01   7.17450E-04   1.00000E+00   0.00000E+00   9.99988E+00
+    0.00000E+00  -1.41469E+00   1.35775E+00  -1.41469E+00   1.35775E+00
+    1.64236E+02  -4.87151E-04   1.64236E+02  -4.87151E-04   9.54847E-01
+    7.15504E-04   9.54847E-01   7.15504E-04   1.00000E+00   0.00000E+00
+    9.99976E+00   0.00000E+00  -1.41477E+00   1.35777E+00  -1.41477E+00
+    1.35777E+00   1.64215E+02   0.00000E+00   1.64215E+02   0.00000E+00
+    9.54997E-01   7.11741E-04   9.54997E-01   7.11741E-04   1.00000E+00
+    0.00000E+00   1.00004E+01   0.00000E+00  -1.41477E+00   1.35777E+00
+   -1.41477E+00   1.35777E+00   1.64215E+02   0.00000E+00   1.64215E+02
+    0.00000E+00   9.55027E-01   7.09838E-04   9.55027E-01   7.09838E-04
+    1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00  -1.41477E+00
+    1.35777E+00  -1.41477E+00   1.35777E+00   1.64215E+02   0.00000E+00
+    1.64215E+02   0.00000E+00   9.55027E-01   7.09838E-04   9.55027E-01
+    7.09838E-04   1.00000E+00   0.00000E+00   9.99988E+00   0.00000E+00
+    0.00000E+00  -1.55707E+01   1.59935E+01
+    3.16675E-01   4.07263E-01  -6.86695E-02   9.15897E-02   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    3.16675E-01   4.07263E-01  -6.86695E-02   9.15897E-02   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    3.00450E-01   4.21237E-01  -7.51237E-02   9.71482E-02   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.83249E-01   4.35294E-01  -8.22346E-02   1.02959E-01   1.00000E+00
+   -9.53289E-07   1.00000E+00  -9.53289E-07   1.00000E+00  -9.53289E-07
+    2.65119E-01   4.49391E-01  -9.00322E-02   1.09022E-01   9.99998E-01
+    9.53289E-07   9.99998E-01   9.53289E-07   9.99998E-01   9.53289E-07
+    2.52986E-01   4.58387E-01  -1.05663E-01   1.20612E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.45720E-01   4.63536E-01  -1.26758E-01   1.35559E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.28027E-01   4.75541E-01  -1.37680E-01   1.42970E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.10204E-01   4.87142E-01  -1.49389E-01   1.50592E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.07127E-01   4.89067E-01  -1.74811E-01   1.66492E-01   1.00000E+00
+   -9.53289E-07   1.00000E+00  -9.53289E-07   1.00000E+00  -9.53289E-07
+    1.94873E-01   4.96442E-01  -1.91367E-01   1.76458E-01   9.99998E-01
+    9.53289E-07   9.99998E-01   9.53289E-07   9.99998E-01   9.53289E-07
+    1.80483E-01   5.04790E-01  -2.05946E-01   1.84915E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.90602E-01   4.99125E-01  -2.39370E-01   2.03625E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.83886E-01   5.02757E-01  -2.57514E-01   2.13439E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.76991E-01   5.06366E-01  -2.74383E-01   2.22264E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.72404E-01   5.08690E-01  -2.91607E-01   2.30990E-01   1.00000E+00
+   -9.53289E-07   1.00000E+00  -9.53289E-07   1.00000E+00  -9.53289E-07
+    1.76168E-01   5.06841E-01  -3.12774E-01   2.41383E-01   9.99996E-01
+    9.53289E-07   9.99996E-01   9.53289E-07   9.99996E-01   9.53289E-07
+    1.91409E-01   4.99579E-01  -3.38806E-01   2.53786E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.97804E-01   4.96622E-01  -3.56357E-01   2.61905E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.07931E-01   4.92067E-01  -3.73597E-01   2.69656E-01   1.00000E+00
+   -9.53289E-07   1.00000E+00  -9.53289E-07   1.00000E+00  -9.53289E-07
+    2.54928E-01   4.71514E-01  -4.08146E-01   2.84766E-01   9.99996E-01
+    9.53289E-07   9.99996E-01   9.53289E-07   9.99996E-01   9.53289E-07
+    2.88405E-01   4.57264E-01  -4.30323E-01   2.94207E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    3.15409E-01   4.46065E-01  -4.45139E-01   3.00350E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    3.47165E-01   4.33232E-01  -4.58683E-01   3.05824E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    3.83760E-01   4.18805E-01  -4.70736E-01   3.10576E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    4.25251E-01   4.02843E-01  -4.81091E-01   3.14560E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    4.75844E-01   3.83834E-01  -4.91312E-01   3.18399E-01   1.00000E+00
+   -9.53289E-07   1.00000E+00  -9.53289E-07   1.00000E+00  -9.53289E-07
+    5.40050E-01   3.60265E-01  -5.02667E-01   3.22568E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    5.96751E-01   3.39920E-01  -5.06570E-01   3.23969E-01   9.99996E-01
+    9.53289E-07   9.99996E-01   9.53289E-07   9.99996E-01   9.53289E-07
+    6.57815E-01   3.18488E-01  -5.08061E-01   3.24491E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    7.22967E-01   2.96114E-01  -5.07031E-01   3.24138E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    8.17579E-01   2.64305E-01  -5.11695E-01   3.25705E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    9.04709E-01   2.35615E-01  -5.09178E-01   3.24877E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    9.81247E-01   2.10921E-01  -4.99399E-01   3.21722E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.06006E+00   1.85994E-01  -4.86888E-01   3.17766E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.14067E+00   1.60993E-01  -4.71710E-01   3.13058E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.22257E+00   1.36078E-01  -4.53912E-01   3.07643E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.29130E+00   1.15558E-01  -4.30294E-01   3.00592E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.30618E+00   1.11199E-01  -3.92412E-01   2.89490E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.38790E+00   8.76778E-02  -3.69178E-01   2.82804E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.46929E+00   6.46692E-02  -3.43901E-01   2.75657E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.54995E+00   4.22614E-02  -3.16749E-01   2.68114E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.65874E+00   1.25548E-02  -2.93361E-01   2.61728E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.75883E+00  -1.43165E-02  -2.66387E-01   2.54485E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.83439E+00  -3.42688E-02  -2.33712E-01   2.45857E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    4.77793E+00  -7.98881E-01  -6.60099E-01   3.56615E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.82866E+00  -4.50257E-02  -1.18784E-01   2.18252E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.87905E+00  -5.77004E-02  -8.36107E-02   2.09402E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.92593E+00  -6.93142E-02  -4.81148E-02   2.00610E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    1.96924E+00  -7.98755E-02  -1.24765E-02   1.91918E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.00893E+00  -8.94135E-02   2.31765E-02   1.83352E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.04504E+00  -9.79611E-02   5.86688E-02   1.74951E-01   1.00001E+00
+   -9.53282E-07   1.00001E+00  -9.53282E-07   1.00001E+00  -9.53282E-07
+    2.07751E+00  -1.05534E-01   9.38692E-02   1.66741E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.10646E+00  -1.12190E-01   1.28685E-01   1.58738E-01   9.99992E-01
+    9.53282E-07   9.99992E-01   9.53282E-07   9.99992E-01   9.53282E-07
+    2.13191E+00  -1.17957E-01   1.62976E-01   1.50966E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.15400E+00  -1.22891E-01   1.96681E-01   1.43434E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.17274E+00  -1.27025E-01   2.29680E-01   1.36161E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.18837E+00  -1.30421E-01   2.61956E-01   1.29145E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.19706E+00  -1.32284E-01   2.93712E-01   1.22335E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.20880E+00  -1.34770E-01   3.24111E-01   1.15900E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.21599E+00  -1.36273E-01   3.53785E-01   1.09704E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.22047E+00  -1.37195E-01   3.82536E-01   1.03775E-01   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.19201E+00  -1.31401E-01   4.12347E-01   9.77054E-02   1.00000E+00
+    0.00000E+00   1.00000E+00   0.00000E+00   1.00000E+00   0.00000E+00
+    2.40302E+00  -1.73813E-01   6.27112E-01   5.45386E-02   1.20134E+00
+   -4.04690E-02   1.20134E+00  -4.04690E-02   1.00000E+00   0.00000E+00
+    2.21710E+00  -1.36908E-01   5.08294E-01   7.81249E-02   1.04455E+00
+   -9.34509E-03   1.04455E+00  -9.34509E-03   1.00000E+00   0.00000E+00
+    2.21390E+00  -1.36282E-01   5.27687E-01   7.43222E-02   1.03910E+00
+   -8.27645E-03   1.03910E+00  -8.27645E-03   1.00000E+00   0.00000E+00
+    2.21247E+00  -1.36004E-01   5.52435E-01   6.95291E-02   1.04014E+00
+   -8.48046E-03   1.04014E+00  -8.48046E-03   1.00000E+00   0.00000E+00
+    2.21269E+00  -1.36046E-01   5.79813E-01   6.42888E-02   1.04490E+00
+   -9.38990E-03   1.04490E+00  -9.38990E-03   1.00000E+00   0.00000E+00
+    2.21589E+00  -1.36652E-01   6.09937E-01   5.85929E-02   1.05348E+00
+   -1.10114E-02   1.05348E+00  -1.10114E-02   1.00000E+00   0.00000E+00
+    2.22347E+00  -1.38069E-01   6.43775E-01   5.22688E-02   1.06686E+00
+   -1.35138E-02   1.06686E+00  -1.35138E-02   1.00000E+00   0.00000E+00
+    2.24124E+00  -1.41352E-01   6.82532E-01   4.51087E-02   1.08644E+00
+   -1.71306E-02   1.08644E+00  -1.71306E-02   1.00000E+00   0.00000E+00
+    2.26157E+00  -1.45064E-01   7.27070E-01   3.69733E-02   1.11265E+00
+   -2.19161E-02   1.11265E+00  -2.19161E-02   1.00000E+00   0.00000E+00
+    2.28623E+00  -1.49516E-01   7.72172E-01   2.88303E-02   1.14025E+00
+   -2.69009E-02   1.14025E+00  -2.69009E-02   1.00000E+00   0.00000E+00
+    2.27928E+00  -1.48276E-01   7.97293E-01   2.43432E-02   1.14739E+00
+   -2.81764E-02   1.14739E+00  -2.81764E-02   1.00000E+00   0.00000E+00
+    2.17690E+00  -1.30198E-01   7.59985E-01   3.09323E-02   1.08962E+00
+   -1.79752E-02   1.08962E+00  -1.79752E-02   1.00000E+00   0.00000E+00
+    1.96010E+00  -9.23298E-02   6.45384E-01   5.09485E-02   9.52092E-01
+    6.04576E-03   9.52092E-01   6.04576E-03   1.00000E+00   0.00000E+00
+    1.76049E+00  -5.78418E-02   5.38906E-01   6.93441E-02   8.25083E-01
+    2.79895E-02   8.25083E-01   2.79895E-02   1.00001E+00  -9.53289E-07
+    1.70108E+00  -4.76911E-02   5.23218E-01   7.20257E-02   7.94578E-01
+    3.32031E-02   7.94578E-01   3.32031E-02   9.99992E-01   9.53289E-07
+    1.73817E+00  -5.39619E-02   5.71737E-01   6.38198E-02   8.31825E-01
+    2.69047E-02   8.31825E-01   2.69047E-02   1.00001E+00  -9.53289E-07
+    1.79331E+00  -6.31878E-02   6.32099E-01   5.37188E-02   8.81731E-01
+    1.85529E-02   8.81731E-01   1.85529E-02   1.00001E+00  -1.90658E-06
+    1.83298E+00  -6.97598E-02   6.82959E-01   4.52955E-02   9.22021E-01
+    1.18808E-02   9.22021E-01   1.18808E-02   1.00002E+00  -2.85987E-06
+    1.85588E+00  -7.35125E-02   7.22385E-01   3.88325E-02   9.50810E-01
+    7.16116E-03   9.50810E-01   7.16116E-03   1.00000E+00  -9.53296E-07
+    1.86774E+00  -7.54395E-02   7.53769E-01   3.37407E-02   9.71722E-01
+    3.76835E-03   9.71722E-01   3.76835E-03   1.00002E+00  -1.90658E-06
+    1.87357E+00  -7.63756E-02   7.81056E-01   2.93584E-02   9.88827E-01
+    1.02097E-03   9.88827E-01   1.02097E-03   1.00002E+00  -3.81316E-06
+    1.87970E+00  -7.73499E-02   8.08038E-01   2.50658E-02   1.00608E+00
+   -1.72355E-03   1.00608E+00  -1.72355E-03   1.00002E+00  -3.81316E-06
+    1.89152E+00  -7.92088E-02   8.38940E-01   2.02011E-02   1.02776E+00
+   -5.13727E-03   1.02776E+00  -5.13727E-03   1.00002E+00  -2.85987E-06
+    1.91239E+00  -8.24652E-02   8.74982E-01   1.45815E-02   1.05515E+00
+   -9.40705E-03   1.05515E+00  -9.40705E-03   1.00002E+00  -3.81316E-06
+    1.90675E+00  -8.15939E-02   8.93125E-01   1.17798E-02   1.06452E+00
+   -1.08541E-02   1.06452E+00  -1.08541E-02   1.00001E+00  -1.90658E-06
+    1.79304E+00  -6.42021E-02   8.32984E-01   2.09781E-02   9.94265E-01
+   -1.09628E-04   9.94265E-01  -1.09628E-04   1.00003E+00  -4.76644E-06
+    1.66042E+00  -4.41106E-02   7.58665E-01   3.22364E-02   9.10223E-01
+    1.26215E-02   9.10223E-01   1.26215E-02   1.00002E+00  -2.85987E-06
+    1.65746E+00  -4.36644E-02   7.75214E-01   2.97531E-02   9.19619E-01
+    1.12126E-02   9.19619E-01   1.12126E-02   1.00002E+00  -3.81316E-06
+    1.70117E+00  -5.01659E-02   8.24694E-01   2.23956E-02   9.62883E-01
+    4.77979E-03   9.62883E-01   4.77979E-03   1.00002E+00  -3.81316E-06
+    1.74345E+00  -5.63928E-02   8.73152E-01   1.52583E-02   1.00532E+00
+   -1.47188E-03   1.00532E+00  -1.47188E-03   1.00002E+00  -3.81316E-06
+    1.75236E+00  -5.76930E-02   8.97388E-01   1.17207E-02   1.02331E+00
+   -4.09819E-03   1.02331E+00  -4.09819E-03   1.00003E+00  -4.76644E-06
+    1.64237E+00  -4.17865E-02   8.34753E-01   2.07807E-02   9.53357E-01
+    6.02097E-03   9.53357E-01   6.02097E-03   1.00003E+00  -3.81316E-06
+    1.59690E+00  -3.52679E-02   8.17907E-01   2.31954E-02   9.30364E-01
+    9.31649E-03   9.30364E-01   9.31649E-03   1.00002E+00  -3.81316E-06
+    1.62195E+00  -3.88236E-02   8.51943E-01   1.83594E-02   9.59329E-01
+    5.20210E-03   9.59329E-01   5.20210E-03   1.00003E+00  -4.76644E-06
+    1.63208E+00  -4.02517E-02   8.74562E-01   1.51745E-02   9.76923E-01
+    2.72355E-03   9.76923E-01   2.72355E-03   1.00002E+00  -3.81316E-06
+    1.62942E+00  -3.98818E-02   8.87504E-01   1.33680E-02   9.84938E-01
+    1.60534E-03   9.84938E-01   1.60534E-03   1.00002E+00  -3.81316E-06
+    1.62151E+00  -3.87855E-02   8.96099E-01   1.21773E-02   9.88812E-01
+    1.06959E-03   9.88812E-01   1.06959E-03   1.00003E+00  -5.71973E-06
+    1.61135E+00  -3.73918E-02   9.02650E-01   1.12793E-02   9.90810E-01
+    7.95043E-04   9.90810E-01   7.95043E-04   1.00003E+00  -4.76644E-06
+    1.60081E+00  -3.59581E-02   9.08111E-01   1.05367E-02   9.91947E-01
+    6.40610E-04   9.91947E-01   6.40610E-04   1.00002E+00  -2.85987E-06
+    1.58958E+00  -3.44442E-02   9.12946E-01   9.88465E-03   9.92671E-01
+    5.43375E-04   9.92671E-01   5.43375E-04   1.00004E+00  -5.71973E-06
+    1.57863E+00  -3.29800E-02   9.17285E-01   9.30315E-03   9.93075E-01
+    4.88084E-04   9.93075E-01   4.88084E-04   1.00002E+00  -2.85987E-06
+    1.56757E+00  -3.15119E-02   9.21312E-01   8.77026E-03   9.93380E-01
+    4.48046E-04   9.93380E-01   4.48046E-04   1.00005E+00  -6.67302E-06
+    1.55691E+00  -3.01106E-02   9.25026E-01   8.28122E-03   9.93556E-01
+    4.25167E-04   9.93556E-01   4.25167E-04   1.00002E+00  -3.81316E-06
+    1.54660E+00  -2.87645E-02   9.28557E-01   7.82078E-03   9.93716E-01
+    4.04194E-04   9.93716E-01   4.04194E-04   1.00004E+00  -5.71973E-06
+    1.53647E+00  -2.74528E-02   9.31836E-01   7.39561E-03   9.93777E-01
+    3.95615E-04   9.93777E-01   3.95615E-04   1.00002E+00  -2.85987E-06
+    1.52680E+00  -2.62135E-02   9.34993E-01   6.99047E-03   9.93891E-01
+    3.81316E-04   9.93891E-01   3.81316E-04   1.00003E+00  -4.76644E-06
+    1.51707E+00  -2.49724E-02   9.37960E-01   6.61296E-03   9.93945E-01
+    3.74643E-04   9.93945E-01   3.74643E-04   1.00004E+00  -5.71973E-06
+    1.50803E+00  -2.38303E-02   9.40744E-01   6.26120E-03   9.93990E-01
+    3.68923E-04   9.93990E-01   3.68923E-04   1.00002E+00  -3.81316E-06
+    1.49926E+00  -2.27302E-02   9.43443E-01   5.92278E-03   9.94051E-01
+    3.61296E-04   9.94051E-01   3.61296E-04   1.00004E+00  -4.76644E-06
+    1.49059E+00  -2.16513E-02   9.45982E-01   5.60538E-03   9.94128E-01
+    3.52720E-04   9.94128E-01   3.52720E-04   1.00003E+00  -4.76648E-06
+    1.48237E+00  -2.06389E-02   9.48400E-01   5.30700E-03   9.94158E-01
+    3.47953E-04   9.94158E-01   3.47953E-04   1.00003E+00  -4.76648E-06
+    1.47463E+00  -1.96891E-02   9.50704E-01   5.02570E-03   9.94219E-01
+    3.42228E-04   9.94219E-01   3.42228E-04   1.00003E+00  -4.76641E-06
+    1.46667E+00  -1.87225E-02   9.52915E-01   4.75592E-03   9.94265E-01
+    3.34602E-04   9.94265E-01   3.34602E-04   1.00002E+00  -3.81313E-06
+    1.45949E+00  -1.78552E-02   9.55020E-01   4.50242E-03   9.94341E-01
+    3.26027E-04   9.94341E-01   3.26027E-04   1.00005E+00  -5.71978E-06
+    1.45230E+00  -1.69954E-02   9.57018E-01   4.26409E-03   9.94387E-01
+    3.21261E-04   9.94387E-01   3.21261E-04   1.00002E+00  -2.85989E-06
+    1.44554E+00  -1.61905E-02   9.58940E-01   4.03524E-03   9.94463E-01
+    3.11723E-04   9.94463E-01   3.11723E-04   1.00003E+00  -4.76641E-06
+    1.43906E+00  -1.54260E-02   9.60771E-01   3.81980E-03   9.94540E-01
+    3.02190E-04   9.94540E-01   3.02190E-04   1.00003E+00  -4.76641E-06
+    1.43246E+00  -1.46541E-02   9.62509E-01   3.61490E-03   9.94601E-01
+    2.94569E-04   9.94601E-01   2.94569E-04   1.00005E+00  -5.71978E-06
+    1.42645E+00  -1.39563E-02   9.64156E-01   3.42519E-03   9.94662E-01
+    2.87895E-04   9.94662E-01   2.87895E-04   1.00002E+00  -2.85989E-06
+    1.42094E+00  -1.33193E-02   9.65758E-01   3.23925E-03   9.94768E-01
+    2.76452E-04   9.94768E-01   2.76452E-04   1.00003E+00  -4.76641E-06
+    1.41504E+00  -1.26424E-02   9.67299E-01   3.06385E-03   9.94860E-01
+    2.65012E-04   9.94860E-01   2.65012E-04   1.00003E+00  -5.71969E-06
+    1.40973E+00  -1.20401E-02   9.68732E-01   2.90088E-03   9.94921E-01
+    2.59297E-04   9.94921E-01   2.59297E-04   1.00003E+00  -4.76648E-06
+    1.40462E+00  -1.14624E-02   9.70105E-01   2.74454E-03   9.95012E-01
+    2.48810E-04   9.95012E-01   2.48810E-04   1.00003E+00  -3.81318E-06
+    1.39968E+00  -1.09074E-02   9.71447E-01   2.59483E-03   9.95104E-01
+    2.37367E-04   9.95104E-01   2.37367E-04   1.00005E+00  -5.71969E-06
+    1.39519E+00  -1.04079E-02   9.72698E-01   2.45565E-03   9.95180E-01
+    2.28788E-04   9.95180E-01   2.28788E-04   1.00000E+00  -2.85984E-06
+    1.38975E+00  -9.80560E-03   9.73903E-01   2.32223E-03   9.95256E-01
+    2.19258E-04   9.95256E-01   2.19258E-04   1.00003E+00  -4.76648E-06
+    1.38588E+00  -9.38043E-03   9.75062E-01   2.19449E-03   9.95363E-01
+    2.08772E-04   9.95363E-01   2.08772E-04   1.00003E+00  -4.76648E-06
+    1.38175E+00  -8.93034E-03   9.76160E-01   2.07339E-03   9.95455E-01
+    1.98283E-04   9.95455E-01   1.98283E-04   1.00003E+00  -4.76641E-06
+    1.37758E+00  -8.47671E-03   9.77197E-01   1.96284E-03   9.95531E-01
+    1.89706E-04   9.95531E-01   1.89706E-04   1.00003E+00  -3.81318E-06
+    1.37472E+00  -8.16962E-03   9.78219E-01   1.85127E-03   9.95638E-01
+    1.78264E-04   9.95638E-01   1.78264E-04   1.00003E+00  -4.76641E-06
+    1.36912E+00  -7.57108E-03   9.79150E-01   1.75216E-03   9.95699E-01
+    1.71593E-04   9.95699E-01   1.71593E-04   1.00002E+00  -2.85989E-06
+    1.36652E+00  -7.29451E-03   9.80096E-01   1.65204E-03   9.95821E-01
+    1.59198E-04   9.95821E-01   1.59198E-04   1.00005E+00  -5.71969E-06
+    1.36312E+00  -6.93618E-03   9.80965E-01   1.55959E-03   9.95912E-01
+    1.49667E-04   9.95912E-01   1.49667E-04   1.00003E+00  -3.81318E-06
+    1.35988E+00  -6.59671E-03   9.81804E-01   1.47282E-03   9.96004E-01
+    1.41086E-04   9.96004E-01   1.41086E-04   1.00002E+00  -3.81313E-06
+    1.35688E+00  -6.28413E-03   9.82597E-01   1.38991E-03   9.96095E-01
+    1.31555E-04   9.96095E-01   1.31555E-04   1.00003E+00  -4.76648E-06
+    1.35413E+00  -5.99995E-03   9.83360E-01   1.31076E-03   9.96172E-01
+    1.22973E-04   9.96172E-01   1.22973E-04   1.00002E+00  -2.85984E-06
+    1.35039E+00  -5.61491E-03   9.84091E-01   1.23452E-03   9.96263E-01
+    1.12489E-04   9.96263E-01   1.12489E-04   1.00003E+00  -4.76648E-06
+    1.34817E+00  -5.38795E-03   9.84793E-01   1.16396E-03   9.96355E-01
+    1.04861E-04   9.96355E-01   1.04861E-04   1.00003E+00  -3.81313E-06
+    1.34586E+00  -5.15352E-03   9.85464E-01   1.09629E-03   9.96446E-01
+    9.53296E-05   9.96446E-01   9.53296E-05   1.00000E+00  -2.85989E-06
+    1.34277E+00  -4.84076E-03   9.86105E-01   1.03145E-03   9.96522E-01
+    8.67486E-05   9.96522E-01   8.67486E-05   1.00003E+00  -4.76641E-06
+    1.34116E+00  -4.68068E-03   9.86700E-01   9.71409E-04   9.96599E-01
+    7.91236E-05   9.96599E-01   7.91236E-05   1.00002E+00  -3.81318E-06
+    1.33841E+00  -4.40607E-03   9.87279E-01   9.13244E-04   9.96705E-01
+    6.95896E-05   9.96705E-01   6.95896E-05   1.00003E+00  -3.81313E-06
+    1.33565E+00  -4.13349E-03   9.87828E-01   8.58920E-04   9.96766E-01
+    6.38708E-05   9.96766E-01   6.38708E-05   1.00002E+00  -2.85989E-06
+    1.33411E+00  -3.98090E-03   9.88378E-01   8.05523E-04   9.96858E-01
+    5.33838E-05   9.96858E-01   5.33838E-05   1.00003E+00  -3.81313E-06
+    1.33211E+00  -3.78649E-03   9.88850E-01   7.58824E-04   9.96904E-01
+    4.86181E-05   9.96904E-01   4.86181E-05   1.00000E+00  -1.90659E-06
+    1.33028E+00  -3.60912E-03   9.89369E-01   7.08288E-04   9.97011E-01
+    3.90845E-05   9.97011E-01   3.90845E-05   1.00003E+00  -4.76641E-06
+    1.32859E+00  -3.44521E-03   9.89826E-01   6.64447E-04   9.97102E-01
+    3.05055E-05   9.97102E-01   3.05055E-05   1.00002E+00  -3.81318E-06
+    1.32636E+00  -3.22972E-03   9.90254E-01   6.23446E-04   9.97148E-01
+    2.57386E-05   9.97148E-01   2.57386E-05   1.00002E+00  -1.90656E-06
+    1.32499E+00  -3.10012E-03   9.90696E-01   5.81511E-04   9.97239E-01
+    1.71593E-05   9.97239E-01   1.71593E-05   1.00002E+00  -3.81318E-06
+    1.32344E+00  -2.95327E-03   9.91077E-01   5.45277E-04   9.97300E-01
+    1.14394E-05   9.97300E-01   1.14394E-05   1.00002E+00  -2.85984E-06
+    1.32170E+00  -2.78934E-03   9.91474E-01   5.08107E-04   9.97377E-01
+    4.76648E-06   9.97377E-01   4.76648E-06   1.00000E+00  -1.90659E-06
+    1.32070E+00  -2.69588E-03   9.91855E-01   4.71874E-04   9.97468E-01
+   -3.81313E-06   9.97468E-01  -3.81313E-06   1.00002E+00  -3.81313E-06
+    1.31901E+00  -2.53767E-03   9.92191E-01   4.41376E-04   9.97499E-01
+   -7.62637E-06   9.97499E-01  -7.62637E-06   1.00002E+00  -1.90659E-06
+    1.31742E+00  -2.39083E-03   9.92526E-01   4.09911E-04   9.97575E-01
+   -1.33459E-05   9.97575E-01  -1.33459E-05   1.00000E+00  -1.90656E-06
+    1.31646E+00  -2.30316E-03   9.92877E-01   3.78459E-04   9.97651E-01
+   -2.19258E-05   9.97651E-01  -2.19258E-05   1.00002E+00  -3.81318E-06
+    1.31536E+00  -2.20208E-03   9.93167E-01   3.51761E-04   9.97697E-01
+   -2.57386E-05   9.97697E-01  -2.57386E-05   1.00000E+00  -2.85984E-06
+    1.31395E+00  -2.07247E-03   9.93441E-01   3.25074E-04   9.97758E-01
+   -3.14588E-05   9.97758E-01  -3.14588E-05   9.99985E-01  -9.53296E-07
+    1.31316E+00  -2.00189E-03   9.93746E-01   2.99330E-04   9.97834E-01
+   -3.81313E-05   9.97834E-01  -3.81313E-05   1.00002E+00  -2.85984E-06
+    1.31186E+00  -1.88371E-03   9.94021E-01   2.74549E-04   9.97910E-01
+   -4.38516E-05   9.97910E-01  -4.38516E-05   1.00002E+00  -2.85989E-06
+    1.31100E+00  -1.80745E-03   9.94265E-01   2.51670E-04   9.97956E-01
+   -4.86181E-05   9.97956E-01  -4.86181E-05   1.00002E+00  -2.85989E-06
+    1.31008E+00  -1.72544E-03   9.94509E-01   2.30694E-04   9.98002E-01
+   -5.33838E-05   9.98002E-01  -5.33838E-05   1.00000E+00  -1.90656E-06
+    1.30923E+00  -1.65111E-03   9.94738E-01   2.09725E-04   9.98048E-01
+   -5.71978E-05   9.98048E-01  -5.71978E-05   9.99985E-01  -9.53296E-07
+    1.30822E+00  -1.56148E-03   9.94967E-01   1.89703E-04   9.98109E-01
+   -6.29166E-05   9.98109E-01  -6.29166E-05   1.00000E+00  -1.90656E-06
+    1.30750E+00  -1.49667E-03   9.95195E-01   1.69687E-04   9.98185E-01
+   -6.86373E-05   9.98185E-01  -6.86373E-05   1.00002E+00  -3.81318E-06
+    1.30654E+00  -1.41467E-03   9.95394E-01   1.52525E-04   9.98215E-01
+   -7.14961E-05   9.98215E-01  -7.14961E-05   9.99985E-01   0.00000E+00
+    1.30592E+00  -1.36131E-03   9.95577E-01   1.36321E-04   9.98292E-01
+   -7.72170E-05   9.98292E-01  -7.72170E-05   1.00002E+00  -2.85989E-06
+    1.30542E+00  -1.31744E-03   9.95775E-01   1.19160E-04   9.98322E-01
+   -8.19822E-05   9.98322E-01  -8.19822E-05   9.99985E-01  -9.53282E-07
+    1.30461E+00  -1.24882E-03   9.95943E-01   1.05816E-04   9.98353E-01
+   -8.29368E-05   9.98353E-01  -8.29368E-05   9.99985E-01  -9.53296E-07
+    1.30381E+00  -1.18016E-03   9.96141E-01   8.86552E-05   9.98444E-01
+   -9.05617E-05   9.98444E-01  -9.05617E-05   1.00000E+00  -1.90656E-06
+    1.30325E+00  -1.13252E-03   9.96294E-01   7.53104E-05   9.98475E-01
+   -9.34230E-05   9.98475E-01  -9.34230E-05   1.00002E+00  -2.85989E-06
+    1.30270E+00  -1.08674E-03   9.96431E-01   6.29166E-05   9.98490E-01
+   -9.62814E-05   9.98490E-01  -9.62814E-05   9.99969E-01   0.00000E+00
+    1.30223E+00  -1.04672E-03   9.96599E-01   4.95714E-05   9.98566E-01
+   -1.01049E-04   9.98566E-01  -1.01049E-04   1.00000E+00  -1.90659E-06
+    1.30182E+00  -1.01239E-03   9.96751E-01   3.71780E-05   9.98627E-01
+   -1.05814E-04   9.98627E-01  -1.05814E-04   1.00000E+00  -1.90656E-06
+    1.30120E+00  -9.60923E-04   9.96888E-01   2.47857E-05   9.98643E-01
+   -1.07722E-04   9.98643E-01  -1.07722E-04   9.99985E-01  -9.53296E-07
+    1.30063E+00  -9.13244E-04   9.97026E-01   1.42992E-05   9.98704E-01
+   -1.12487E-04   9.98704E-01  -1.12487E-04   9.99985E-01  -9.53282E-07
+    1.30019E+00  -8.77032E-04   9.97132E-01   5.71978E-06   9.98719E-01
+   -1.14396E-04   9.98719E-01  -1.14396E-04   1.00000E+00  -9.53296E-07
+    1.30009E+00  -8.69393E-04   9.97255E-01  -5.71969E-06   9.98749E-01
+   -1.17254E-04   9.98749E-01  -1.17254E-04   9.99985E-01   0.00000E+00
+    1.29944E+00  -8.17928E-04   9.97392E-01  -1.62060E-05   9.98826E-01
+   -1.22975E-04   9.98826E-01  -1.22975E-04   1.00002E+00  -2.85989E-06
+    1.29892E+00  -7.75971E-04   9.97499E-01  -2.47853E-05   9.98871E-01
+   -1.25833E-04   9.98871E-01  -1.25833E-04   9.99985E-01  -9.53282E-07
+    1.29853E+00  -7.43571E-04   9.97605E-01  -3.24121E-05   9.98871E-01
+   -1.26788E-04   9.98871E-01  -1.26788E-04   9.99969E-01   0.00000E+00
+    1.29838E+00  -7.30214E-04   9.97712E-01  -4.19444E-05   9.98932E-01
+   -1.31553E-04   9.98932E-01  -1.31553E-04   1.00002E+00  -2.85984E-06
+    1.29801E+00  -7.03533E-04   9.97819E-01  -5.05247E-05   9.98963E-01
+   -1.34415E-04   9.98963E-01  -1.34415E-04   9.99985E-01   0.00000E+00
+    1.29771E+00  -6.76830E-04   9.97895E-01  -5.62436E-05   9.98978E-01
+   -1.36319E-04   9.98978E-01  -1.36319E-04   1.00000E+00  -9.53282E-07
+    1.29746E+00  -6.59681E-04   9.98002E-01  -6.48241E-05   9.99024E-01
+   -1.39181E-04   9.99024E-01  -1.39181E-04   9.99985E-01  -9.53296E-07
+    1.29720E+00  -6.36792E-04   9.98093E-01  -7.14961E-05   9.99085E-01
+   -1.43946E-04   9.99085E-01  -1.43946E-04   9.99985E-01  -9.53282E-07
+    1.29682E+00  -6.08203E-04   9.98170E-01  -7.81703E-05   9.99085E-01
+   -1.42994E-04   9.99085E-01  -1.42994E-04   9.99985E-01   0.00000E+00
+    1.29677E+00  -6.04381E-04   9.98276E-01  -8.57953E-05   9.99161E-01
+   -1.49665E-04   9.99161E-01  -1.49665E-04   1.00000E+00  -1.90656E-06
+    1.29636E+00  -5.70071E-04   9.98322E-01  -8.96098E-05   9.99161E-01
+   -1.49667E-04   9.99161E-01  -1.49667E-04   9.99969E-01   0.00000E+00
+    1.29619E+00  -5.58623E-04   9.98414E-01  -9.62814E-05   9.99192E-01
+   -1.52525E-04   9.99192E-01  -1.52525E-04   1.00000E+00  -9.53282E-07
+    1.29596E+00  -5.41472E-04   9.98475E-01  -1.01049E-04   9.99222E-01
+   -1.54434E-04   9.99222E-01  -1.54434E-04   9.99969E-01   0.00000E+00
+    1.29575E+00  -5.26219E-04   9.98597E-01  -1.10582E-04   9.99298E-01
+   -1.59200E-04   9.99298E-01  -1.59200E-04   9.99985E-01  -9.53296E-07
+    1.29552E+00  -5.07146E-04   9.98597E-01  -1.09627E-04   9.99253E-01
+   -1.57291E-04   9.99253E-01  -1.57291E-04   9.99985E-01   0.00000E+00
+    1.29529E+00  -4.91901E-04   9.98719E-01  -1.20115E-04   9.99359E-01
+   -1.64920E-04   9.99359E-01  -1.64920E-04   1.00000E+00  -1.90659E-06
+    1.29524E+00  -4.86174E-04   9.98719E-01  -1.20113E-04   9.99329E-01
+   -1.62058E-04   9.99329E-01  -1.62058E-04   9.99954E-01   1.90656E-06
+    1.29505E+00  -4.72835E-04   9.98826E-01  -1.27742E-04   9.99405E-01
+   -1.67780E-04   9.99405E-01  -1.67780E-04   1.00002E+00  -2.85989E-06
+    1.29494E+00  -4.65201E-04   9.98871E-01  -1.31553E-04   9.99405E-01
+   -1.68731E-04   9.99405E-01  -1.68731E-04   9.99954E-01   9.53282E-07
+    1.29474E+00  -4.49956E-04   9.98917E-01  -1.34415E-04   9.99436E-01
+   -1.69687E-04   9.99436E-01  -1.69687E-04   1.00000E+00  -9.53296E-07
+    1.29472E+00  -4.48042E-04   9.99009E-01  -1.41086E-04   9.99512E-01
+   -1.75404E-04   9.99512E-01  -1.75404E-04   9.99985E-01  -9.53282E-07
+    1.29456E+00  -4.38516E-04   9.99039E-01  -1.43948E-04   9.99481E-01
+   -1.74453E-04   9.99481E-01  -1.74453E-04   9.99985E-01   0.00000E+00
+    1.29436E+00  -4.21350E-04   9.99070E-01  -1.45852E-04   9.99512E-01
+   -1.76357E-04   9.99512E-01  -1.76357E-04   9.99969E-01   0.00000E+00
+    1.29426E+00  -4.13731E-04   9.99176E-01  -1.53481E-04   9.99573E-01
+   -1.80173E-04   9.99573E-01  -1.80173E-04   9.99985E-01  -9.53296E-07
+    1.29414E+00  -4.06098E-04   9.99161E-01  -1.52525E-04   9.99573E-01
+   -1.80170E-04   9.99573E-01  -1.80170E-04   9.99985E-01   0.00000E+00
+    1.29410E+00  -4.02291E-04   9.99237E-01  -1.58247E-04   9.99603E-01
+   -1.82080E-04   9.99603E-01  -1.82080E-04   9.99969E-01   9.53296E-07
+    1.29393E+00  -3.90845E-04   9.99283E-01  -1.62058E-04   9.99649E-01
+   -1.85890E-04   9.99649E-01  -1.85890E-04   1.00000E+00  -1.90656E-06
+    1.29392E+00  -3.90851E-04   9.99329E-01  -1.64920E-04   9.99664E-01
+   -1.86846E-04   9.99664E-01  -1.86846E-04   9.99985E-01  -9.53296E-07
+    1.29381E+00  -3.81313E-04   9.99344E-01  -1.66824E-04   9.99664E-01
+   -1.86843E-04   9.99664E-01  -1.86843E-04   9.99954E-01   1.90656E-06
+    1.29380E+00  -3.81318E-04   9.99420E-01  -1.71593E-04   9.99725E-01
+   -1.91613E-04   9.99725E-01  -1.91613E-04   1.00000E+00  -1.90659E-06
+    1.29372E+00  -3.73686E-04   9.99466E-01  -1.75404E-04   9.99756E-01
+   -1.93516E-04   9.99756E-01  -1.93516E-04   1.00000E+00  -9.53282E-07
+    1.29362E+00  -3.69879E-04   9.99466E-01  -1.74453E-04   9.99756E-01
+   -1.93519E-04   9.99756E-01  -1.93519E-04   9.99969E-01   0.00000E+00
+    1.29353E+00  -3.64154E-04   9.99527E-01  -1.79217E-04   9.99786E-01
+   -1.95423E-04   9.99786E-01  -1.95423E-04   9.99985E-01   0.00000E+00
+    1.29355E+00  -3.64159E-04   9.99558E-01  -1.81126E-04   9.99817E-01
+   -1.97332E-04   9.99817E-01  -1.97332E-04   9.99969E-01   0.00000E+00
+    1.29335E+00  -3.50808E-04   9.99588E-01  -1.83030E-04   9.99802E-01
+   -1.97329E-04   9.99802E-01  -1.97329E-04   9.99985E-01   0.00000E+00
+    1.29346E+00  -3.56533E-04   9.99664E-01  -1.87799E-04   9.99863E-01
+   -2.01145E-04   9.99863E-01  -2.01145E-04   9.99969E-01   0.00000E+00
+    1.29335E+00  -3.48901E-04   9.99664E-01  -1.88750E-04   9.99893E-01
+   -2.03049E-04   9.99893E-01  -2.03049E-04   1.00000E+00  -9.53282E-07
+    1.29334E+00  -3.48906E-04   9.99710E-01  -1.91613E-04   9.99893E-01
+   -2.03052E-04   9.99893E-01  -2.03052E-04   9.99954E-01   9.53296E-07
+    1.29326E+00  -3.43181E-04   9.99756E-01  -1.94469E-04   9.99939E-01
+   -2.05909E-04   9.99939E-01  -2.05909E-04   9.99985E-01   0.00000E+00
+    1.29322E+00  -3.41280E-04   9.99771E-01  -1.95426E-04   9.99939E-01
+   -2.05912E-04   9.99939E-01  -2.05912E-04   9.99969E-01   0.00000E+00
+    1.29323E+00  -3.41275E-04   9.99802E-01  -1.97329E-04   9.99969E-01
+   -2.08769E-04   9.99969E-01  -2.08769E-04   1.00000E+00  -9.53282E-07
+    1.29316E+00  -3.37467E-04   9.99832E-01  -2.00192E-04   9.99985E-01
+   -2.09725E-04   9.99985E-01  -2.09725E-04   9.99954E-01   9.53296E-07
+    1.29320E+00  -3.39368E-04   9.99909E-01  -2.04956E-04   1.00006E+00
+   -2.13535E-04   1.00006E+00  -2.13535E-04   1.00002E+00  -1.90656E-06
+    1.29316E+00  -3.35560E-04   9.99893E-01  -2.04005E-04   1.00005E+00
+   -2.13538E-04   1.00005E+00  -2.13538E-04   9.99969E-01   0.00000E+00
+    1.29310E+00  -3.33654E-04   9.99924E-01  -2.05912E-04   1.00006E+00
+   -2.13538E-04   1.00006E+00  -2.13538E-04   9.99985E-01   0.00000E+00
+    1.29314E+00  -3.35555E-04   9.99969E-01  -2.08769E-04   1.00009E+00
+   -2.16395E-04   1.00009E+00  -2.16395E-04   9.99969E-01   0.00000E+00
+    1.29307E+00  -3.31747E-04   1.00000E+00  -2.10678E-04   1.00011E+00
+   -2.17352E-04   1.00011E+00  -2.17352E-04   9.99985E-01   0.00000E+00
+    1.29302E+00  -3.27929E-04   1.00000E+00  -2.10675E-04   1.00012E+00
+   -2.18301E-04   1.00012E+00  -2.18301E-04   9.99954E-01   9.53282E-07
+    1.29307E+00  -3.29840E-04   1.00006E+00  -2.14492E-04   1.00017E+00
+   -2.21165E-04   1.00017E+00  -2.21165E-04   1.00000E+00  -9.53296E-07
+    1.29305E+00  -3.29835E-04   1.00009E+00  -2.17348E-04   1.00018E+00
+   -2.23068E-04   1.00018E+00  -2.23068E-04   9.99985E-01  -9.53282E-07
+    1.29297E+00  -3.26027E-04   1.00008E+00  -2.15445E-04   1.00018E+00
+   -2.22118E-04   1.00018E+00  -2.22118E-04   9.99969E-01   9.53296E-07
+    1.29308E+00  -3.31742E-04   1.00015E+00  -2.20208E-04   1.00023E+00
+   -2.24974E-04   1.00023E+00  -2.24974E-04   9.99954E-01   9.53282E-07
+    1.29301E+00  -3.26027E-04   1.00017E+00  -2.21165E-04   1.00023E+00
+   -2.25931E-04   1.00023E+00  -2.25931E-04   1.00000E+00  -9.53296E-07
+    1.29311E+00  -3.31742E-04   1.00020E+00  -2.24021E-04   1.00029E+00
+   -2.28788E-04   1.00029E+00  -2.28788E-04   9.99954E-01   9.53282E-07
+    1.29304E+00  -3.29840E-04   1.00024E+00  -2.25931E-04   1.00031E+00
+   -2.30698E-04   1.00031E+00  -2.30698E-04   1.00002E+00  -1.90659E-06
+    1.29302E+00  -3.27929E-04   1.00021E+00  -2.24974E-04   1.00029E+00
+   -2.28788E-04   1.00029E+00  -2.28788E-04   9.99969E-01   0.00000E+00
+    1.29301E+00  -3.27934E-04   1.00026E+00  -2.27838E-04   1.00037E+00
+   -2.33558E-04   1.00037E+00  -2.33558E-04   9.99985E-01   0.00000E+00
+    1.29305E+00  -3.29835E-04   1.00029E+00  -2.29741E-04   1.00035E+00
+   -2.32601E-04   1.00035E+00  -2.32601E-04   9.99969E-01   0.00000E+00
+    1.29310E+00  -3.31747E-04   1.00034E+00  -2.32604E-04   1.00041E+00
+   -2.36417E-04   1.00041E+00  -2.36417E-04   9.99985E-01  -9.53296E-07
+    1.29302E+00  -3.27929E-04   1.00034E+00  -2.31647E-04   1.00040E+00
+   -2.35461E-04   1.00040E+00  -2.35461E-04   9.99969E-01   9.53282E-07
+    1.29307E+00  -3.29840E-04   1.00037E+00  -2.34511E-04   1.00041E+00
+   -2.36417E-04   1.00041E+00  -2.36417E-04   1.00000E+00   0.00000E+00
+    1.29301E+00  -3.27934E-04   1.00037E+00  -2.34511E-04   1.00046E+00
+   -2.39277E-04   1.00046E+00  -2.39277E-04   9.99969E-01   0.00000E+00
+    1.29306E+00  -3.31737E-04   1.00043E+00  -2.38317E-04   1.00046E+00
+   -2.40223E-04   1.00046E+00  -2.40223E-04   9.99969E-01   0.00000E+00
+    1.29313E+00  -3.33654E-04   1.00046E+00  -2.39277E-04   1.00049E+00
+   -2.41184E-04   1.00049E+00  -2.41184E-04   9.99969E-01   0.00000E+00
+    1.29304E+00  -3.29840E-04   1.00046E+00  -2.40231E-04   1.00052E+00
+   -2.43091E-04   1.00052E+00  -2.43091E-04   1.00000E+00   0.00000E+00
+    1.29309E+00  -3.31737E-04   1.00052E+00  -2.42130E-04   1.00055E+00
+   -2.44990E-04   1.00055E+00  -2.44990E-04   1.00000E+00  -9.53267E-07
+    1.29311E+00  -3.33664E-04   1.00049E+00  -2.42145E-04   1.00052E+00
+   -2.44051E-04   1.00052E+00  -2.44051E-04   9.99969E-01   9.53325E-07
+    1.29315E+00  -3.35550E-04   1.00055E+00  -2.44990E-04   1.00058E+00
+   -2.47849E-04   1.00058E+00  -2.47849E-04   9.99969E-01   0.00000E+00
+    1.29316E+00  -3.37467E-04   1.00058E+00  -2.47857E-04   1.00061E+00
+   -2.48810E-04   1.00061E+00  -2.48810E-04   1.00000E+00  -9.53296E-07
+    1.29407E+00  -3.90851E-04   1.00055E+00  -2.45950E-04   1.00061E+00
+   -2.48810E-04   1.00061E+00  -2.48810E-04   9.99939E-01   9.53296E-07
+    1.29223E+00  -2.82167E-04   1.00067E+00  -2.51663E-04   1.00067E+00
+   -2.52616E-04   1.00067E+00  -2.52616E-04   9.99969E-01   0.00000E+00
+    1.29520E+00  -4.59489E-04   1.00061E+00  -2.48810E-04   1.00061E+00
+   -2.50717E-04   1.00061E+00  -2.50717E-04   9.99969E-01   0.00000E+00
+    1.29114E+00  -2.17352E-04   1.00067E+00  -2.53577E-04   1.00070E+00
+   -2.55483E-04   1.00070E+00  -2.55483E-04   1.00000E+00  -9.53296E-07
+    1.29324E+00  -3.41270E-04   1.00067E+00  -2.53569E-04   1.00070E+00
+   -2.54522E-04   1.00070E+00  -2.54522E-04   9.99969E-01   0.00000E+00
+    1.29402E+00  -3.87050E-04   1.00070E+00  -2.55491E-04   1.00073E+00
+   -2.56444E-04   1.00073E+00  -2.56444E-04   1.00000E+00   0.00000E+00
+    1.29248E+00  -2.95513E-04   1.00073E+00  -2.55476E-04   1.00076E+00
+   -2.57382E-04   1.00076E+00  -2.57382E-04   9.99939E-01   1.90653E-06
+    1.29328E+00  -3.43187E-04   1.00073E+00  -2.56437E-04   1.00076E+00
+   -2.58343E-04   1.00076E+00  -2.58343E-04   1.00000E+00  -9.53296E-07
+    1.29331E+00  -3.47000E-04   1.00079E+00  -2.60250E-04   1.00079E+00
+   -2.61203E-04   1.00079E+00  -2.61203E-04   1.00000E+00  -9.53296E-07
+    1.29413E+00  -3.92758E-04   1.00079E+00  -2.61203E-04   1.00082E+00
+   -2.62156E-04   1.00082E+00  -2.62156E-04   9.99939E-01   9.53296E-07
+    1.29251E+00  -2.99326E-04   1.00082E+00  -2.62148E-04   1.00085E+00
+   -2.63102E-04   1.00085E+00  -2.63102E-04   1.00000E+00  -9.53267E-07
+    1.29380E+00  -3.73692E-04   1.00082E+00  -2.62156E-04   1.00085E+00
+   -2.63110E-04   1.00085E+00  -2.63110E-04   9.99969E-01   9.53296E-07
+    1.29301E+00  -3.27934E-04   1.00088E+00  -2.65016E-04   1.00092E+00
+   -2.66923E-04   1.00092E+00  -2.66923E-04   1.00000E+00  -9.53296E-07
+    1.29407E+00  -3.88945E-04   1.00092E+00  -2.66923E-04   1.00088E+00
+   -2.65970E-04   1.00088E+00  -2.65970E-04   9.99939E-01   9.53296E-07
+    1.29272E+00  -3.12672E-04   1.00088E+00  -2.65962E-04   1.00095E+00
+   -2.67868E-04   1.00095E+00  -2.67868E-04   9.99969E-01   0.00000E+00
+    1.29407E+00  -3.88945E-04   1.00098E+00  -2.69783E-04   1.00098E+00
+   -2.70736E-04   1.00098E+00  -2.70736E-04   9.99969E-01   0.00000E+00
+    1.29365E+00  -3.64159E-04   1.00098E+00  -2.70736E-04   1.00098E+00
+   -2.70736E-04   1.00098E+00  -2.70736E-04   9.99969E-01   9.53296E-07
+    1.29307E+00  -3.31747E-04   1.00101E+00  -2.73596E-04   1.00107E+00
+   -2.74549E-04   1.00107E+00  -2.74549E-04   1.00000E+00  -2.85989E-06
+    1.29327E+00  -3.43176E-04   1.00101E+00  -2.72634E-04   1.00104E+00
+   -2.73588E-04   1.00104E+00  -2.73588E-04   9.99969E-01   9.53267E-07
+    1.29358E+00  -3.60346E-04   1.00104E+00  -2.74549E-04   1.00104E+00
+   -2.74549E-04   1.00104E+00  -2.74549E-04   9.99969E-01   0.00000E+00
+    1.29395E+00  -3.81318E-04   1.00107E+00  -2.76456E-04   1.00110E+00
+   -2.77409E-04   1.00110E+00  -2.77409E-04   1.00000E+00  -9.53296E-07
+    1.29365E+00  -3.66066E-04   1.00107E+00  -2.75503E-04   1.00110E+00
+   -2.76456E-04   1.00110E+00  -2.76456E-04   9.99969E-01   0.00000E+00
+    1.29361E+00  -3.62241E-04   1.00116E+00  -2.81214E-04   1.00116E+00
+   -2.81214E-04   1.00116E+00  -2.81214E-04   9.99969E-01   0.00000E+00
+    1.29346E+00  -3.54626E-04   1.00110E+00  -2.77409E-04   1.00113E+00
+   -2.79316E-04   1.00113E+00  -2.79316E-04   9.99939E-01   9.53296E-07
+    1.29377E+00  -3.71785E-04   1.00122E+00  -2.83129E-04   1.00119E+00
+   -2.82176E-04   1.00119E+00  -2.82176E-04   1.00000E+00  -9.53296E-07
+    1.29358E+00  -3.60346E-04   1.00119E+00  -2.82176E-04   1.00119E+00
+   -2.83129E-04   1.00119E+00  -2.83129E-04   9.99969E-01   9.53296E-07
+    1.29370E+00  -3.67961E-04   1.00122E+00  -2.84074E-04   1.00122E+00
+   -2.84074E-04   1.00122E+00  -2.84074E-04   9.99969E-01   0.00000E+00
+    1.29404E+00  -3.85132E-04   1.00128E+00  -2.85989E-04   1.00128E+00
+   -2.85989E-04   1.00128E+00  -2.85989E-04   1.00000E+00   0.00000E+00
+    1.29358E+00  -3.60346E-04   1.00128E+00  -2.86942E-04   1.00131E+00
+   -2.87895E-04   1.00131E+00  -2.87895E-04   9.99969E-01   0.00000E+00
+    1.29380E+00  -3.73692E-04   1.00128E+00  -2.87895E-04   1.00128E+00
+   -2.87895E-04   1.00128E+00  -2.87895E-04   9.99969E-01   0.00000E+00
+    1.29412E+00  -3.90839E-04   1.00134E+00  -2.90746E-04   1.00137E+00
+   -2.91700E-04   1.00137E+00  -2.91700E-04   9.99969E-01  -9.53267E-07
+    1.29386E+00  -3.75599E-04   1.00134E+00  -2.90755E-04   1.00134E+00
+   -2.90755E-04   1.00134E+00  -2.90755E-04   9.99969E-01   9.53296E-07
+    1.29413E+00  -3.90851E-04   1.00137E+00  -2.92662E-04   1.00137E+00
+   -2.92662E-04   1.00137E+00  -2.92662E-04   9.99969E-01   0.00000E+00
+    1.29365E+00  -3.64159E-04   1.00140E+00  -2.93615E-04   1.00140E+00
+   -2.93615E-04   1.00140E+00  -2.93615E-04   9.99969E-01   9.53296E-07
+    1.29403E+00  -3.85120E-04   1.00143E+00  -2.95513E-04   1.00143E+00
+   -2.96466E-04   1.00143E+00  -2.96466E-04   1.00000E+00  -1.90653E-06
+    1.29401E+00  -3.83225E-04   1.00143E+00  -2.96475E-04   1.00149E+00
+   -2.97428E-04   1.00149E+00  -2.97428E-04   9.99969E-01   9.53296E-07
+    1.29410E+00  -3.88945E-04   1.00149E+00  -2.99335E-04   1.00149E+00
+   -2.98382E-04   1.00149E+00  -2.98382E-04   9.99969E-01   0.00000E+00
+    1.29407E+00  -3.87038E-04   1.00149E+00  -2.99335E-04   1.00153E+00
+   -2.99335E-04   1.00153E+00  -2.99335E-04   9.99969E-01   0.00000E+00
+    1.29412E+00  -3.90839E-04   1.00153E+00  -3.01232E-04   1.00153E+00
+   -3.01232E-04   1.00153E+00  -3.01232E-04   9.99969E-01   0.00000E+00
+    1.29432E+00  -4.00384E-04   1.00156E+00  -3.02195E-04   1.00159E+00
+   -3.04101E-04   1.00159E+00  -3.04101E-04   1.00000E+00   0.00000E+00
+    1.29404E+00  -3.87038E-04   1.00162E+00  -3.05055E-04   1.00159E+00
+   -3.04101E-04   1.00159E+00  -3.04101E-04   1.00000E+00  -9.53296E-07
+    1.29441E+00  -4.04198E-04   1.00162E+00  -3.05055E-04   1.00162E+00
+   -3.05055E-04   1.00162E+00  -3.05055E-04   9.99969E-01   0.00000E+00
+    1.29419E+00  -3.94665E-04   1.00162E+00  -3.05055E-04   1.00165E+00
+   -3.06008E-04   1.00165E+00  -3.06008E-04   9.99969E-01   9.53296E-07
+    1.29425E+00  -3.96559E-04   1.00171E+00  -3.09812E-04   1.00168E+00
+   -3.08859E-04   1.00168E+00  -3.08859E-04   9.99969E-01   0.00000E+00
+    1.29438E+00  -4.04198E-04   1.00168E+00  -3.09821E-04   1.00171E+00
+   -3.10775E-04   1.00171E+00  -3.10775E-04   1.00000E+00   0.00000E+00
+    1.29438E+00  -4.04198E-04   1.00174E+00  -3.11728E-04   1.00174E+00
+   -3.11728E-04   1.00174E+00  -3.11728E-04   9.99969E-01   0.00000E+00
+    1.29438E+00  -4.04198E-04   1.00177E+00  -3.12681E-04   1.00177E+00
+   -3.12681E-04   1.00177E+00  -3.12681E-04   1.00000E+00  -9.53296E-07
+    1.29443E+00  -4.06092E-04   1.00177E+00  -3.13625E-04   1.00177E+00
+   -3.12672E-04   1.00177E+00  -3.12672E-04   9.99969E-01   9.53267E-07
+    1.29441E+00  -4.04198E-04   1.00180E+00  -3.15541E-04   1.00183E+00
+   -3.16494E-04   1.00183E+00  -3.16494E-04   1.00000E+00   0.00000E+00
+    1.29462E+00  -4.15637E-04   1.00186E+00  -3.17448E-04   1.00186E+00
+   -3.18401E-04   1.00186E+00  -3.18401E-04   1.00000E+00  -9.53296E-07
+    1.29450E+00  -4.09917E-04   1.00186E+00  -3.18401E-04   1.00189E+00
+   -3.18401E-04   1.00189E+00  -3.18401E-04   1.00000E+00   0.00000E+00
+    1.29458E+00  -4.13718E-04   1.00189E+00  -3.19344E-04   1.00189E+00
+   -3.19344E-04   1.00189E+00  -3.19344E-04   9.99969E-01   9.53267E-07
+    1.29462E+00  -4.15637E-04   1.00192E+00  -3.21261E-04   1.00192E+00
+   -3.21261E-04   1.00192E+00  -3.21261E-04   1.00000E+00   0.00000E+00
+    1.29465E+00  -4.17544E-04   1.00195E+00  -3.23167E-04   1.00198E+00
+   -3.23167E-04   1.00198E+00  -3.23167E-04   9.99969E-01   0.00000E+00
+    1.29477E+00  -4.23263E-04   1.00201E+00  -3.25074E-04   1.00201E+00
+   -3.25074E-04   1.00201E+00  -3.25074E-04   9.99969E-01   0.00000E+00
+    1.29467E+00  -4.17531E-04   1.00204E+00  -3.26017E-04   1.00201E+00
+   -3.26017E-04   1.00201E+00  -3.26017E-04   9.99969E-01   0.00000E+00
+    1.29480E+00  -4.25170E-04   1.00201E+00  -3.26027E-04   1.00201E+00
+   -3.26027E-04   1.00201E+00  -3.26027E-04   9.99969E-01   9.53296E-07
+    1.29484E+00  -4.27077E-04   1.00214E+00  -3.30794E-04   1.00210E+00
+   -3.30794E-04   1.00210E+00  -3.30794E-04   9.99969E-01  -9.53296E-07
+    1.29493E+00  -4.30890E-04   1.00210E+00  -3.30794E-04   1.00210E+00
+   -3.30794E-04   1.00210E+00  -3.30794E-04   1.00000E+00  -9.53296E-07
+    1.29486E+00  -4.27064E-04   1.00214E+00  -3.31737E-04   1.00214E+00
+   -3.31737E-04   1.00214E+00  -3.31737E-04   9.99969E-01   9.53267E-07
+    1.29487E+00  -4.28983E-04   1.00217E+00  -3.32700E-04   1.00214E+00
+   -3.31747E-04   1.00214E+00  -3.31747E-04   9.99969E-01   9.53296E-07
+    1.29502E+00  -4.34703E-04   1.00226E+00  -3.36514E-04   1.00223E+00
+   -3.36514E-04   1.00223E+00  -3.36514E-04   9.99969E-01  -9.53296E-07
+    1.29499E+00  -4.34703E-04   1.00223E+00  -3.35560E-04   1.00223E+00
+   -3.36514E-04   1.00223E+00  -3.36514E-04   9.99969E-01   0.00000E+00
+    1.29510E+00  -4.38503E-04   1.00229E+00  -3.38410E-04   1.00226E+00
+   -3.38410E-04   1.00226E+00  -3.38410E-04   9.99969E-01   0.00000E+00
+    1.29511E+00  -4.40423E-04   1.00232E+00  -3.41280E-04   1.00232E+00
+   -3.40327E-04   1.00232E+00  -3.40327E-04   9.99969E-01   0.00000E+00
+    1.29517E+00  -4.42329E-04   1.00232E+00  -3.41280E-04   1.00235E+00
+   -3.41280E-04   1.00235E+00  -3.41280E-04   1.00000E+00   0.00000E+00
+    1.29511E+00  -4.40423E-04   1.00235E+00  -3.41280E-04   1.00238E+00
+   -3.43187E-04   1.00238E+00  -3.43187E-04   9.99969E-01   0.00000E+00
+    1.29522E+00  -4.46129E-04   1.00238E+00  -3.44129E-04   1.00238E+00
+   -3.44129E-04   1.00238E+00  -3.44129E-04   9.99969E-01   0.00000E+00
+    1.29523E+00  -4.46143E-04   1.00244E+00  -3.47000E-04   1.00244E+00
+   -3.47000E-04   1.00244E+00  -3.47000E-04   9.99969E-01   0.00000E+00
+    1.29532E+00  -4.49956E-04   1.00247E+00  -3.47000E-04   1.00247E+00
+   -3.47000E-04   1.00247E+00  -3.47000E-04   9.99969E-01   9.53296E-07
+    1.29535E+00  -4.51862E-04   1.00250E+00  -3.49860E-04   1.00250E+00
+   -3.49860E-04   1.00250E+00  -3.49860E-04   1.00000E+00  -9.53296E-07
+    1.29538E+00  -4.53755E-04   1.00253E+00  -3.50802E-04   1.00253E+00
+   -3.50802E-04   1.00253E+00  -3.50802E-04   9.99969E-01   0.00000E+00
+    1.29545E+00  -4.55676E-04   1.00256E+00  -3.52720E-04   1.00256E+00
+   -3.52720E-04   1.00256E+00  -3.52720E-04   9.99969E-01   0.00000E+00
+    1.29545E+00  -4.55676E-04   1.00256E+00  -3.52720E-04   1.00256E+00
+   -3.52720E-04   1.00256E+00  -3.52720E-04   9.99969E-01   9.53296E-07
+    1.29554E+00  -4.59489E-04   1.00265E+00  -3.56533E-04   1.00265E+00
+   -3.56533E-04   1.00265E+00  -3.56533E-04   9.99969E-01  -9.53296E-07
+    1.29560E+00  -4.63302E-04   1.00268E+00  -3.57486E-04   1.00268E+00
+   -3.57486E-04   1.00268E+00  -3.57486E-04   9.99969E-01   0.00000E+00
+    1.29562E+00  -4.65194E-04   1.00268E+00  -3.58428E-04   1.00268E+00
+   -3.58428E-04   1.00268E+00  -3.58428E-04   9.99969E-01   0.00000E+00
+    1.29563E+00  -4.65209E-04   1.00275E+00  -3.60346E-04   1.00275E+00
+   -3.60346E-04   1.00275E+00  -3.60346E-04   9.99969E-01   9.53296E-07
+    1.29572E+00  -4.69022E-04   1.00278E+00  -3.63206E-04   1.00278E+00
+   -3.63206E-04   1.00278E+00  -3.63206E-04   9.99969E-01  -9.53296E-07
+    1.29572E+00  -4.69022E-04   1.00281E+00  -3.63206E-04   1.00281E+00
+   -3.63206E-04   1.00281E+00  -3.63206E-04   9.99969E-01   0.00000E+00
+    1.29580E+00  -4.72820E-04   1.00284E+00  -3.66055E-04   1.00284E+00
+   -3.66055E-04   1.00284E+00  -3.66055E-04   9.99969E-01   0.00000E+00
+    1.29584E+00  -4.74741E-04   1.00287E+00  -3.67019E-04   1.00287E+00
+   -3.67019E-04   1.00287E+00  -3.67019E-04   9.99969E-01   0.00000E+00
+    1.29581E+00  -4.72835E-04   1.00293E+00  -3.67972E-04   1.00293E+00
+   -3.67972E-04   1.00293E+00  -3.67972E-04   9.99969E-01   9.53296E-07
+    1.29599E+00  -4.82368E-04   1.00296E+00  -3.70832E-04   1.00296E+00
+   -3.70832E-04   1.00296E+00  -3.70832E-04   1.00000E+00   0.00000E+00
+    1.29592E+00  -4.78540E-04   1.00299E+00  -3.71774E-04   1.00299E+00
+   -3.71774E-04   1.00299E+00  -3.71774E-04   9.99969E-01   0.00000E+00
+    1.29606E+00  -4.84274E-04   1.00305E+00  -3.74645E-04   1.00305E+00
+   -3.74645E-04   1.00305E+00  -3.74645E-04   1.00000E+00  -9.53296E-07
+    1.29609E+00  -4.86181E-04   1.00308E+00  -3.76552E-04   1.00308E+00
+   -3.76552E-04   1.00308E+00  -3.76552E-04   1.00000E+00  -9.53296E-07
+    1.29612E+00  -4.86181E-04   1.00311E+00  -3.77505E-04   1.00311E+00
+   -3.77505E-04   1.00311E+00  -3.77505E-04   9.99939E-01   9.53296E-07
+    1.29620E+00  -4.89979E-04   1.00314E+00  -3.78447E-04   1.00314E+00
+   -3.78447E-04   1.00314E+00  -3.78447E-04   9.99939E-01   9.53267E-07
+    1.29621E+00  -4.89994E-04   1.00317E+00  -3.80365E-04   1.00317E+00
+   -3.80365E-04   1.00317E+00  -3.80365E-04   9.99969E-01   0.00000E+00
+    1.29633E+00  -4.97621E-04   1.00323E+00  -3.83225E-04   1.00323E+00
+   -3.83225E-04   1.00323E+00  -3.83225E-04   1.00000E+00  -9.53296E-07
+    1.29636E+00  -4.97621E-04   1.00323E+00  -3.84178E-04   1.00323E+00
+   -3.84178E-04   1.00323E+00  -3.84178E-04   9.99969E-01   0.00000E+00
+    1.29635E+00  -4.97605E-04   1.00329E+00  -3.86073E-04   1.00329E+00
+   -3.86073E-04   1.00329E+00  -3.86073E-04   9.99969E-01   0.00000E+00
+    1.29636E+00  -4.97621E-04   1.00333E+00  -3.87038E-04   1.00333E+00
+   -3.87038E-04   1.00333E+00  -3.87038E-04   9.99939E-01   9.53296E-07
+    1.29654E+00  -5.05247E-04   1.00339E+00  -3.89898E-04   1.00339E+00
+   -3.89898E-04   1.00339E+00  -3.89898E-04   9.99969E-01   0.00000E+00
+    1.29651E+00  -5.05247E-04   1.00342E+00  -3.90851E-04   1.00342E+00
+   -3.90851E-04   1.00342E+00  -3.90851E-04   9.99969E-01   0.00000E+00
+    1.29669E+00  -5.12858E-04   1.00348E+00  -3.94653E-04   1.00348E+00
+   -3.94653E-04   1.00348E+00  -3.94653E-04   1.00000E+00  -9.53267E-07
+    1.29657E+00  -5.07154E-04   1.00348E+00  -3.94665E-04   1.00348E+00
+   -3.94665E-04   1.00348E+00  -3.94665E-04   9.99969E-01   0.00000E+00
+    1.29670E+00  -5.12873E-04   1.00354E+00  -3.96571E-04   1.00354E+00
+   -3.96571E-04   1.00354E+00  -3.96571E-04   9.99969E-01   0.00000E+00
+    1.29679E+00  -5.16686E-04   1.00357E+00  -3.97524E-04   1.00357E+00
+   -3.97524E-04   1.00357E+00  -3.97524E-04   9.99969E-01   9.53296E-07
+    1.29675E+00  -5.14764E-04   1.00363E+00  -4.01325E-04   1.00363E+00
+   -4.01325E-04   1.00363E+00  -4.01325E-04   1.00000E+00  -9.53267E-07
+    1.29685E+00  -5.18593E-04   1.00366E+00  -4.01338E-04   1.00366E+00
+   -4.01338E-04   1.00366E+00  -4.01338E-04   9.99969E-01   0.00000E+00
+    1.29691E+00  -5.22406E-04   1.00369E+00  -4.04198E-04   1.00369E+00
+   -4.04198E-04   1.00369E+00  -4.04198E-04   9.99939E-01   9.53296E-07
+    1.29694E+00  -5.24313E-04   1.00372E+00  -4.05151E-04   1.00372E+00
+   -4.05151E-04   1.00372E+00  -4.05151E-04   1.00000E+00  -9.53296E-07
+    1.29700E+00  -5.26219E-04   1.00381E+00  -4.08964E-04   1.00381E+00
+   -4.08964E-04   1.00381E+00  -4.08964E-04   9.99969E-01   0.00000E+00
+    1.29708E+00  -5.30016E-04   1.00381E+00  -4.08952E-04   1.00381E+00
+   -4.08952E-04   1.00381E+00  -4.08952E-04   9.99969E-01   0.00000E+00
+    1.29709E+00  -5.30033E-04   1.00387E+00  -4.10871E-04   1.00387E+00
+   -4.10871E-04   1.00387E+00  -4.10871E-04   9.99969E-01   0.00000E+00
+    1.29715E+00  -5.33846E-04   1.00390E+00  -4.12777E-04   1.00390E+00
+   -4.12777E-04   1.00390E+00  -4.12777E-04   9.99969E-01   9.53296E-07
+    1.29728E+00  -5.37659E-04   1.00397E+00  -4.15637E-04   1.00397E+00
+   -4.15637E-04   1.00397E+00  -4.15637E-04   1.00000E+00  -9.53296E-07
+    1.29721E+00  -5.35736E-04   1.00397E+00  -4.15624E-04   1.00397E+00
+   -4.15624E-04   1.00397E+00  -4.15624E-04   9.99939E-01   9.53267E-07
+    1.29743E+00  -5.43379E-04   1.00409E+00  -4.19450E-04   1.00409E+00
+   -4.19450E-04   1.00409E+00  -4.19450E-04   1.00000E+00  -9.53296E-07
+    1.29740E+00  -5.43379E-04   1.00412E+00  -4.20404E-04   1.00412E+00
+   -4.20404E-04   1.00412E+00  -4.20404E-04   9.99969E-01   9.53296E-07
+    1.29749E+00  -5.47192E-04   1.00418E+00  -4.24217E-04   1.00418E+00
+   -4.24217E-04   1.00418E+00  -4.24217E-04   1.00000E+00  -9.53296E-07
+    1.29745E+00  -5.45269E-04   1.00418E+00  -4.23251E-04   1.00418E+00
+   -4.23251E-04   1.00418E+00  -4.23251E-04   9.99939E-01   9.53267E-07
+    1.29761E+00  -5.52912E-04   1.00421E+00  -4.26123E-04   1.00421E+00
+   -4.26123E-04   1.00421E+00  -4.26123E-04   9.99969E-01   0.00000E+00
+    1.29767E+00  -5.54818E-04   1.00430E+00  -4.29937E-04   1.00430E+00
+   -4.29937E-04   1.00430E+00  -4.29937E-04   1.00000E+00  -9.53296E-07
+    1.29776E+00  -5.58632E-04   1.00430E+00  -4.28983E-04   1.00430E+00
+   -4.28983E-04   1.00430E+00  -4.28983E-04   1.00000E+00   0.00000E+00
+    1.29772E+00  -5.56708E-04   1.00439E+00  -4.32783E-04   1.00439E+00
+   -4.32783E-04   1.00439E+00  -4.32783E-04   9.99969E-01   0.00000E+00
+    1.29782E+00  -5.60538E-04   1.00439E+00  -4.33750E-04   1.00439E+00
+   -4.33750E-04   1.00439E+00  -4.33750E-04   9.99939E-01   9.53296E-07
+    1.29782E+00  -5.60538E-04   1.00445E+00  -4.35656E-04   1.00445E+00
+   -4.35656E-04   1.00445E+00  -4.35656E-04   9.99969E-01   0.00000E+00
+    1.29798E+00  -5.68165E-04   1.00451E+00  -4.38516E-04   1.00451E+00
+   -4.38516E-04   1.00451E+00  -4.38516E-04   9.99969E-01   0.00000E+00
+    1.29800E+00  -5.68147E-04   1.00458E+00  -4.40409E-04   1.00458E+00
+   -4.40409E-04   1.00458E+00  -4.40409E-04   1.00000E+00  -9.53267E-07
+    1.29813E+00  -5.73884E-04   1.00461E+00  -4.42329E-04   1.00461E+00
+   -4.42329E-04   1.00461E+00  -4.42329E-04   9.99969E-01   0.00000E+00
+    1.29810E+00  -5.71978E-04   1.00467E+00  -4.44236E-04   1.00467E+00
+   -4.44236E-04   1.00467E+00  -4.44236E-04   9.99939E-01   9.53296E-07
+    1.29819E+00  -5.75791E-04   1.00470E+00  -4.45189E-04   1.00470E+00
+   -4.45189E-04   1.00470E+00  -4.45189E-04   1.00000E+00  -9.53296E-07
+    1.29827E+00  -5.79586E-04   1.00479E+00  -4.48989E-04   1.00479E+00
+   -4.48989E-04   1.00479E+00  -4.48989E-04   9.99969E-01   9.53267E-07
+    1.29840E+00  -5.85324E-04   1.00482E+00  -4.50909E-04   1.00482E+00
+   -4.50909E-04   1.00482E+00  -4.50909E-04   1.00000E+00  -9.53296E-07
+    1.29831E+00  -5.81511E-04   1.00485E+00  -4.51862E-04   1.00485E+00
+   -4.51862E-04   1.00485E+00  -4.51862E-04   9.99969E-01   0.00000E+00
+    1.29834E+00  -5.83417E-04   1.00488E+00  -4.52816E-04   1.00488E+00
+   -4.52816E-04   1.00488E+00  -4.52816E-04   9.99969E-01   9.53296E-07
+    1.29864E+00  -5.94839E-04   1.00494E+00  -4.56615E-04   1.00494E+00
+   -4.56615E-04   1.00494E+00  -4.56615E-04   1.00000E+00  -9.53267E-07
+    1.29856E+00  -5.91044E-04   1.00503E+00  -4.58535E-04   1.00503E+00
+   -4.58535E-04   1.00503E+00  -4.58535E-04   9.99969E-01   0.00000E+00
+    1.29859E+00  -5.92950E-04   1.00506E+00  -4.60442E-04   1.00506E+00
+   -4.60442E-04   1.00506E+00  -4.60442E-04   9.99939E-01   9.53296E-07
+    1.29868E+00  -5.96763E-04   1.00509E+00  -4.61395E-04   1.00509E+00
+   -4.61395E-04   1.00509E+00  -4.61395E-04   9.99969E-01   0.00000E+00
+    1.29882E+00  -6.00558E-04   1.00519E+00  -4.65194E-04   1.00519E+00
+   -4.65194E-04   1.00519E+00  -4.65194E-04   1.00000E+00   0.00000E+00
+    1.29892E+00  -6.04390E-04   1.00528E+00  -4.68068E-04   1.00528E+00
+   -4.68068E-04   1.00528E+00  -4.68068E-04   1.00000E+00  -9.53296E-07
+    1.29892E+00  -6.06296E-04   1.00528E+00  -4.69022E-04   1.00528E+00
+   -4.69022E-04   1.00528E+00  -4.69022E-04   9.99969E-01   0.00000E+00
+    1.29892E+00  -6.06296E-04   1.00531E+00  -4.69975E-04   1.00531E+00
+   -4.69975E-04   1.00531E+00  -4.69975E-04   9.99969E-01   0.00000E+00
+    1.29911E+00  -6.12016E-04   1.00537E+00  -4.72835E-04   1.00537E+00
+   -4.72835E-04   1.00537E+00  -4.72835E-04   9.99969E-01   9.53296E-07
+    1.29913E+00  -6.13904E-04   1.00543E+00  -4.74727E-04   1.00543E+00
+   -4.74727E-04   1.00543E+00  -4.74727E-04   1.00000E+00   0.00000E+00
+    1.29923E+00  -6.17736E-04   1.00552E+00  -4.78555E-04   1.00552E+00
+   -4.78555E-04   1.00552E+00  -4.78555E-04   9.99969E-01   0.00000E+00
+    1.29923E+00  -6.19642E-04   1.00552E+00  -4.79508E-04   1.00552E+00
+   -4.79508E-04   1.00552E+00  -4.79508E-04   1.00000E+00  -9.53296E-07
+    1.29941E+00  -6.23456E-04   1.00561E+00  -4.82368E-04   1.00561E+00
+   -4.82368E-04   1.00561E+00  -4.82368E-04   1.00000E+00   0.00000E+00
+    1.29937E+00  -6.23437E-04   1.00561E+00  -4.82353E-04   1.00561E+00
+   -4.82353E-04   1.00561E+00  -4.82353E-04   9.99969E-01   9.53267E-07
+    1.29953E+00  -6.29175E-04   1.00574E+00  -4.87134E-04   1.00574E+00
+   -4.87134E-04   1.00574E+00  -4.87134E-04   1.00000E+00  -9.53296E-07
+    1.29947E+00  -6.29175E-04   1.00574E+00  -4.87134E-04   1.00574E+00
+   -4.87134E-04   1.00574E+00  -4.87134E-04   9.99939E-01   9.53296E-07
+    1.29966E+00  -6.34895E-04   1.00583E+00  -4.90948E-04   1.00583E+00
+   -4.90948E-04   1.00583E+00  -4.90948E-04   1.00000E+00  -9.53296E-07
+    1.29968E+00  -6.34876E-04   1.00586E+00  -4.91886E-04   1.00586E+00
+   -4.91886E-04   1.00586E+00  -4.91886E-04   9.99969E-01   9.53267E-07
+    1.29984E+00  -6.40615E-04   1.00598E+00  -4.95714E-04   1.00598E+00
+   -4.95714E-04   1.00598E+00  -4.95714E-04   9.99969E-01   0.00000E+00
+    1.29984E+00  -6.42522E-04   1.00598E+00  -4.96667E-04   1.00598E+00
+   -4.96667E-04   1.00598E+00  -4.96667E-04   9.99969E-01   0.00000E+00
+    1.29990E+00  -6.44428E-04   1.00604E+00  -4.99527E-04   1.00604E+00
+   -4.99527E-04   1.00604E+00  -4.99527E-04   9.99969E-01   0.00000E+00
+    1.30004E+00  -6.48222E-04   1.00610E+00  -5.01418E-04   1.00610E+00
+   -5.01418E-04   1.00610E+00  -5.01418E-04   1.00000E+00   0.00000E+00
+    1.30008E+00  -6.52055E-04   1.00619E+00  -5.04294E-04   1.00619E+00
+   -5.04294E-04   1.00619E+00  -5.04294E-04   9.99969E-01   0.00000E+00
+    1.30008E+00  -6.52055E-04   1.00622E+00  -5.05247E-04   1.00622E+00
+   -5.05247E-04   1.00622E+00  -5.05247E-04   9.99969E-01   0.00000E+00
+    1.30027E+00  -6.57774E-04   1.00628E+00  -5.09060E-04   1.00628E+00
+   -5.09060E-04   1.00628E+00  -5.09060E-04   9.99969E-01   0.00000E+00
+    1.30035E+00  -6.61567E-04   1.00638E+00  -5.11904E-04   1.00638E+00
+   -5.11904E-04   1.00638E+00  -5.11904E-04   1.00003E+00  -9.53267E-07
+    1.30045E+00  -6.65401E-04   1.00638E+00  -5.11920E-04   1.00638E+00
+   -5.11920E-04   1.00638E+00  -5.11920E-04   9.99969E-01   0.00000E+00
+    1.30033E+00  -6.61588E-04   1.00647E+00  -5.14780E-04   1.00647E+00
+   -5.14780E-04   1.00647E+00  -5.14780E-04   9.99939E-01   9.53296E-07
+    1.30057E+00  -6.69214E-04   1.00653E+00  -5.17640E-04   1.00653E+00
+   -5.17640E-04   1.00653E+00  -5.17640E-04   9.99969E-01   0.00000E+00
+    1.30059E+00  -6.71100E-04   1.00659E+00  -5.19531E-04   1.00659E+00
+   -5.19531E-04   1.00659E+00  -5.19531E-04   9.99939E-01   9.53267E-07
+    1.30069E+00  -6.74934E-04   1.00665E+00  -5.22406E-04   1.00665E+00
+   -5.22406E-04   1.00665E+00  -5.22406E-04   1.00003E+00  -9.53296E-07
+    1.30094E+00  -6.84467E-04   1.00674E+00  -5.26219E-04   1.00674E+00
+   -5.26219E-04   1.00674E+00  -5.26219E-04   9.99969E-01   0.00000E+00
+    1.30075E+00  -6.76840E-04   1.00674E+00  -5.26219E-04   1.00674E+00
+   -5.26219E-04   1.00674E+00  -5.26219E-04   9.99969E-01   0.00000E+00
+    1.30090E+00  -6.82539E-04   1.00683E+00  -5.29063E-04   1.00683E+00
+   -5.29063E-04   1.00683E+00  -5.29063E-04   9.99969E-01   0.00000E+00
+    1.30100E+00  -6.86373E-04   1.00692E+00  -5.31939E-04   1.00692E+00
+   -5.31939E-04   1.00692E+00  -5.31939E-04   9.99969E-01   9.53296E-07
+    1.30112E+00  -6.90186E-04   1.00699E+00  -5.33846E-04   1.00699E+00
+   -5.33846E-04   1.00699E+00  -5.33846E-04   1.00000E+00  -9.53296E-07
+    1.30130E+00  -6.95906E-04   1.00708E+00  -5.38612E-04   1.00708E+00
+   -5.38612E-04   1.00708E+00  -5.38612E-04   1.00000E+00  -9.53296E-07
+    1.30126E+00  -6.95885E-04   1.00708E+00  -5.38596E-04   1.00708E+00
+   -5.38596E-04   1.00708E+00  -5.38596E-04   9.99969E-01   9.53267E-07
+    1.30142E+00  -7.01626E-04   1.00714E+00  -5.40519E-04   1.00714E+00
+   -5.40519E-04   1.00714E+00  -5.40519E-04   1.00000E+00   0.00000E+00
+    1.30130E+00  -6.97813E-04   1.00723E+00  -5.43379E-04   1.00723E+00
+   -5.43379E-04   1.00723E+00  -5.43379E-04   9.99969E-01   0.00000E+00
+    1.30167E+00  -7.09252E-04   1.00735E+00  -5.48145E-04   1.00735E+00
+   -5.48145E-04   1.00735E+00  -5.48145E-04   9.99969E-01   0.00000E+00
+    1.30161E+00  -7.07346E-04   1.00732E+00  -5.47192E-04   1.00732E+00
+   -5.47192E-04   1.00732E+00  -5.47192E-04   9.99969E-01   0.00000E+00
+    1.30181E+00  -7.16857E-04   1.00747E+00  -5.52895E-04   1.00747E+00
+   -5.52895E-04   1.00747E+00  -5.52895E-04   1.00000E+00   0.00000E+00
+    1.30167E+00  -7.11159E-04   1.00744E+00  -5.51958E-04   1.00744E+00
+   -5.51958E-04   1.00744E+00  -5.51958E-04   9.99969E-01   0.00000E+00
+    1.30191E+00  -7.18785E-04   1.00757E+00  -5.56725E-04   1.00757E+00
+   -5.56725E-04   1.00757E+00  -5.56725E-04   9.99939E-01   9.53296E-07
+    1.30191E+00  -7.20692E-04   1.00760E+00  -5.57678E-04   1.00760E+00
+   -5.57678E-04   1.00760E+00  -5.57678E-04   9.99969E-01   0.00000E+00
+    1.30212E+00  -7.26389E-04   1.00775E+00  -5.62428E-04   1.00775E+00
+   -5.62428E-04   1.00775E+00  -5.62428E-04   1.00000E+00  -9.53267E-07
+    1.30222E+00  -7.32131E-04   1.00778E+00  -5.64351E-04   1.00778E+00
+   -5.64351E-04   1.00778E+00  -5.64351E-04   9.99969E-01   0.00000E+00
+    1.30222E+00  -7.30225E-04   1.00781E+00  -5.64351E-04   1.00781E+00
+   -5.64351E-04   1.00781E+00  -5.64351E-04   9.99939E-01   9.53296E-07
+    1.30234E+00  -7.34038E-04   1.00796E+00  -5.71024E-04   1.00796E+00
+   -5.71024E-04   1.00796E+00  -5.71024E-04   1.00000E+00  -9.53296E-07
+    1.30236E+00  -7.35922E-04   1.00799E+00  -5.71007E-04   1.00799E+00
+   -5.71007E-04   1.00799E+00  -5.71007E-04   9.99939E-01   9.53267E-07
+    1.30258E+00  -7.43571E-04   1.00805E+00  -5.73884E-04   1.00805E+00
+   -5.73884E-04   1.00805E+00  -5.73884E-04   1.00000E+00   0.00000E+00
+    1.30264E+00  -7.45478E-04   1.00814E+00  -5.76744E-04   1.00814E+00
+   -5.76744E-04   1.00814E+00  -5.76744E-04   1.00000E+00  -9.53296E-07
+    1.30271E+00  -7.47384E-04   1.00818E+00  -5.78651E-04   1.00818E+00
+   -5.78651E-04   1.00818E+00  -5.78651E-04   9.99939E-01   9.53296E-07
+    1.30279E+00  -7.51174E-04   1.00830E+00  -5.82446E-04   1.00830E+00
+   -5.82446E-04   1.00830E+00  -5.82446E-04   1.00000E+00  -9.53267E-07
+    1.30289E+00  -7.55011E-04   1.00833E+00  -5.84371E-04   1.00833E+00
+   -5.84371E-04   1.00833E+00  -5.84371E-04   1.00000E+00   0.00000E+00
+    1.30307E+00  -7.60730E-04   1.00845E+00  -5.87230E-04   1.00845E+00
+   -5.87230E-04   1.00845E+00  -5.87230E-04   9.99969E-01   0.00000E+00
+    1.30307E+00  -7.60730E-04   1.00851E+00  -5.90090E-04   1.00851E+00
+   -5.90090E-04   1.00851E+00  -5.90090E-04   9.99969E-01   0.00000E+00
+    1.30315E+00  -7.64520E-04   1.00854E+00  -5.91979E-04   1.00854E+00
+   -5.91979E-04   1.00854E+00  -5.91979E-04   9.99939E-01   9.53267E-07
+    1.30332E+00  -7.70263E-04   1.00863E+00  -5.94857E-04   1.00863E+00
+   -5.94857E-04   1.00863E+00  -5.94857E-04   9.99969E-01   0.00000E+00
+    1.30332E+00  -7.70263E-04   1.00872E+00  -5.97717E-04   1.00872E+00
+   -5.97717E-04   1.00872E+00  -5.97717E-04   1.00000E+00   0.00000E+00
+    1.30356E+00  -7.77890E-04   1.00882E+00  -6.00577E-04   1.00882E+00
+   -6.00577E-04   1.00882E+00  -6.00577E-04   9.99969E-01   0.00000E+00
+    1.30358E+00  -7.79772E-04   1.00891E+00  -6.03418E-04   1.00891E+00
+   -6.03418E-04   1.00891E+00  -6.03418E-04   9.99969E-01   0.00000E+00
+    1.30368E+00  -7.81703E-04   1.00894E+00  -6.05343E-04   1.00894E+00
+   -6.05343E-04   1.00894E+00  -6.05343E-04   9.99969E-01   0.00000E+00
+    1.30387E+00  -7.87423E-04   1.00906E+00  -6.09156E-04   1.00906E+00
+   -6.09156E-04   1.00906E+00  -6.09156E-04   1.00000E+00  -9.53296E-07
+    1.30387E+00  -7.89329E-04   1.00912E+00  -6.11063E-04   1.00912E+00
+   -6.11063E-04   1.00912E+00  -6.11063E-04   9.99969E-01   0.00000E+00
+    1.30401E+00  -7.93118E-04   1.00918E+00  -6.13904E-04   1.00918E+00
+   -6.13904E-04   1.00918E+00  -6.13904E-04   9.99939E-01   9.53267E-07
+    1.30417E+00  -7.98862E-04   1.00930E+00  -6.17736E-04   1.00930E+00
+   -6.17736E-04   1.00930E+00  -6.17736E-04   1.00000E+00  -9.53296E-07
+    1.30417E+00  -7.98862E-04   1.00933E+00  -6.18689E-04   1.00933E+00
+   -6.18689E-04   1.00933E+00  -6.18689E-04   9.99969E-01   0.00000E+00
+    1.30429E+00  -8.04582E-04   1.00946E+00  -6.23456E-04   1.00946E+00
+   -6.23456E-04   1.00946E+00  -6.23456E-04   9.99969E-01   0.00000E+00
+    1.30448E+00  -8.08395E-04   1.00949E+00  -6.24409E-04   1.00949E+00
+   -6.24409E-04   1.00949E+00  -6.24409E-04   9.99969E-01   0.00000E+00
+    1.30450E+00  -8.10277E-04   1.00958E+00  -6.27250E-04   1.00958E+00
+   -6.27250E-04   1.00958E+00  -6.27250E-04   9.99939E-01   9.53267E-07
+    1.30460E+00  -8.16021E-04   1.00970E+00  -6.31082E-04   1.00970E+00
+   -6.31082E-04   1.00970E+00  -6.31082E-04   1.00003E+00  -9.53296E-07
+    1.30472E+00  -8.19835E-04   1.00979E+00  -6.34895E-04   1.00979E+00
+   -6.34895E-04   1.00979E+00  -6.34895E-04   9.99969E-01   0.00000E+00
+    1.30472E+00  -8.17928E-04   1.00976E+00  -6.33942E-04   1.00976E+00
+   -6.33942E-04   1.00976E+00  -6.33942E-04   9.99939E-01   9.53296E-07
+    1.30505E+00  -8.29342E-04   1.00997E+00  -6.40595E-04   1.00997E+00
+   -6.40595E-04   1.00997E+00  -6.40595E-04   1.00000E+00  -9.53267E-07
+    1.30502E+00  -8.29368E-04   1.01004E+00  -6.42522E-04   1.01004E+00
+   -6.42522E-04   1.01004E+00  -6.42522E-04   9.99969E-01   9.53296E-07
+    1.30515E+00  -8.33181E-04   1.01010E+00  -6.44428E-04   1.01010E+00
+   -6.44428E-04   1.01010E+00  -6.44428E-04   9.99969E-01   0.00000E+00
+    1.30527E+00  -8.36994E-04   1.01019E+00  -6.48241E-04   1.01019E+00
+   -6.48241E-04   1.01019E+00  -6.48241E-04   9.99969E-01   0.00000E+00
+    1.30541E+00  -8.42688E-04   1.01028E+00  -6.52035E-04   1.01028E+00
+   -6.52035E-04   1.01028E+00  -6.52035E-04   1.00000E+00  -9.53267E-07
+    1.30545E+00  -8.42714E-04   1.01031E+00  -6.52055E-04   1.01031E+00
+   -6.52055E-04   1.01031E+00  -6.52055E-04   9.99969E-01   9.53296E-07
+    1.30557E+00  -8.48434E-04   1.01049E+00  -6.57774E-04   1.01049E+00
+   -6.57774E-04   1.01049E+00  -6.57774E-04   1.00000E+00  -9.53296E-07
+    1.30570E+00  -8.52247E-04   1.01052E+00  -6.59681E-04   1.01052E+00
+   -6.59681E-04   1.01052E+00  -6.59681E-04   9.99939E-01   9.53296E-07
+    1.30584E+00  -8.56034E-04   1.01062E+00  -6.62521E-04   1.01062E+00
+   -6.62521E-04   1.01062E+00  -6.62521E-04   9.99969E-01   0.00000E+00
+    1.30606E+00  -8.61780E-04   1.01071E+00  -6.65401E-04   1.01071E+00
+   -6.65401E-04   1.01071E+00  -6.65401E-04   1.00000E+00  -9.53296E-07
+    1.30606E+00  -8.61780E-04   1.01080E+00  -6.68261E-04   1.01080E+00
+   -6.68261E-04   1.01080E+00  -6.68261E-04   9.99969E-01   9.53296E-07
+    1.30624E+00  -8.69406E-04   1.01089E+00  -6.72074E-04   1.01089E+00
+   -6.72074E-04   1.01089E+00  -6.72074E-04   9.99939E-01   9.53296E-07
+    1.30633E+00  -8.73193E-04   1.01101E+00  -6.75866E-04   1.01101E+00
+   -6.75866E-04   1.01101E+00  -6.75866E-04   1.00003E+00  -1.90653E-06
+    1.30637E+00  -8.73219E-04   1.01104E+00  -6.76840E-04   1.01104E+00
+   -6.76840E-04   1.01104E+00  -6.76840E-04   9.99969E-01   9.53296E-07
+    1.30655E+00  -8.80846E-04   1.01117E+00  -6.80653E-04   1.01117E+00
+   -6.80653E-04   1.01117E+00  -6.80653E-04   1.00000E+00   0.00000E+00
+    1.30667E+00  -8.84659E-04   1.01129E+00  -6.84467E-04   1.01129E+00
+   -6.84467E-04   1.01129E+00  -6.84467E-04   9.99969E-01   0.00000E+00
+    1.30675E+00  -8.86538E-04   1.01135E+00  -6.86352E-04   1.01135E+00
+   -6.86352E-04   1.01135E+00  -6.86352E-04   9.99969E-01   0.00000E+00
+    1.30698E+00  -8.92285E-04   1.01144E+00  -6.90186E-04   1.01144E+00
+   -6.90186E-04   1.01144E+00  -6.90186E-04   1.00000E+00  -9.53296E-07
+    1.30704E+00  -8.96098E-04   1.01153E+00  -6.93046E-04   1.01153E+00
+   -6.93046E-04   1.01153E+00  -6.93046E-04   1.00000E+00   0.00000E+00
+    1.30710E+00  -8.98005E-04   1.01159E+00  -6.94953E-04   1.01159E+00
+   -6.94953E-04   1.01159E+00  -6.94953E-04   9.99939E-01   9.53296E-07
+    1.30718E+00  -9.01791E-04   1.01174E+00  -6.99698E-04   1.01174E+00
+   -6.99698E-04   1.01174E+00  -6.99698E-04   9.99939E-01   9.53267E-07
+    1.30746E+00  -9.09444E-04   1.01184E+00  -7.02579E-04   1.01184E+00
+   -7.02579E-04   1.01184E+00  -7.02579E-04   1.00000E+00  -9.53296E-07
+    1.30759E+00  -9.13258E-04   1.01190E+00  -7.04486E-04   1.01190E+00
+   -7.04486E-04   1.01190E+00  -7.04486E-04   9.99969E-01   9.53296E-07
+    1.30759E+00  -9.13258E-04   1.01205E+00  -7.09252E-04   1.01205E+00
+   -7.09252E-04   1.01205E+00  -7.09252E-04   1.00000E+00  -9.53296E-07
+    1.30779E+00  -9.20856E-04   1.01211E+00  -7.12090E-04   1.01211E+00
+   -7.12090E-04   1.01211E+00  -7.12090E-04   9.99969E-01   0.00000E+00
+    1.30789E+00  -9.24697E-04   1.01223E+00  -7.15925E-04   1.01223E+00
+   -7.15925E-04   1.01223E+00  -7.15925E-04   1.00000E+00  -9.53296E-07
+    1.30801E+00  -9.26604E-04   1.01226E+00  -7.16879E-04   1.01226E+00
+   -7.16879E-04   1.01226E+00  -7.16879E-04   9.99939E-01   1.90659E-06
+    1.30820E+00  -9.34230E-04   1.01248E+00  -7.23552E-04   1.01248E+00
+   -7.23552E-04   1.01248E+00  -7.23552E-04   1.00000E+00  -9.53296E-07
+    1.30820E+00  -9.34230E-04   1.01251E+00  -7.24505E-04   1.01251E+00
+   -7.24505E-04   1.01251E+00  -7.24505E-04   9.99969E-01   0.00000E+00
+    1.30846E+00  -9.41828E-04   1.01260E+00  -7.27343E-04   1.01260E+00
+   -7.27343E-04   1.01260E+00  -7.27343E-04   9.99969E-01   0.00000E+00
+    1.30856E+00  -9.43763E-04   1.01269E+00  -7.30225E-04   1.01269E+00
+   -7.30225E-04   1.01269E+00  -7.30225E-04   9.99969E-01   9.53296E-07
+    1.30875E+00  -9.49483E-04   1.01284E+00  -7.34991E-04   1.01284E+00
+   -7.34991E-04   1.01284E+00  -7.34991E-04   9.99969E-01   0.00000E+00
+    1.30887E+00  -9.53296E-04   1.01290E+00  -7.37851E-04   1.01290E+00
+   -7.37851E-04   1.01290E+00  -7.37851E-04   1.00000E+00  -9.53296E-07
+    1.30889E+00  -9.57080E-04   1.01303E+00  -7.40688E-04   1.01303E+00
+   -7.40688E-04   1.01303E+00  -7.40688E-04   9.99939E-01   9.53267E-07
+    1.30911E+00  -9.62829E-04   1.01318E+00  -7.45478E-04   1.01318E+00
+   -7.45478E-04   1.01318E+00  -7.45478E-04   9.99969E-01   0.00000E+00
+    1.30923E+00  -9.66642E-04   1.01321E+00  -7.47384E-04   1.01321E+00
+   -7.47384E-04   1.01321E+00  -7.47384E-04   1.00003E+00  -9.53296E-07
+    1.30942E+00  -9.72362E-04   1.01333E+00  -7.51197E-04   1.01333E+00
+   -7.51197E-04   1.01333E+00  -7.51197E-04   9.99969E-01   0.00000E+00
+    1.30944E+00  -9.74239E-04   1.01351E+00  -7.55941E-04   1.01351E+00
+   -7.55941E-04   1.01351E+00  -7.55941E-04   9.99969E-01   0.00000E+00
+    1.30960E+00  -9.78082E-04   1.01351E+00  -7.56917E-04   1.01351E+00
+   -7.56917E-04   1.01351E+00  -7.56917E-04   9.99969E-01   0.00000E+00
+    1.30972E+00  -9.81895E-04   1.01364E+00  -7.59777E-04   1.01364E+00
+   -7.59777E-04   1.01364E+00  -7.59777E-04   9.99969E-01   9.53296E-07
+    1.30997E+00  -9.89521E-04   1.01379E+00  -7.65497E-04   1.01379E+00
+   -7.65497E-04   1.01379E+00  -7.65497E-04   9.99969E-01   0.00000E+00
+    1.31005E+00  -9.93304E-04   1.01394E+00  -7.69286E-04   1.01394E+00
+   -7.69286E-04   1.01394E+00  -7.69286E-04   1.00000E+00  -9.53267E-07
+    1.31021E+00  -9.97148E-04   1.01400E+00  -7.71217E-04   1.01400E+00
+   -7.71217E-04   1.01400E+00  -7.71217E-04   9.99969E-01   0.00000E+00
+    1.31031E+00  -1.00099E-03   1.01412E+00  -7.75053E-04   1.01412E+00
+   -7.75053E-04   1.01412E+00  -7.75053E-04   1.00000E+00   0.00000E+00
+    1.31041E+00  -1.00474E-03   1.01425E+00  -7.78819E-04   1.01425E+00
+   -7.78819E-04   1.01425E+00  -7.78819E-04   9.99939E-01   0.00000E+00
+    1.31060E+00  -1.01046E-03   1.01428E+00  -7.80726E-04   1.01428E+00
+   -7.80726E-04   1.01428E+00  -7.80726E-04   1.00000E+00   0.00000E+00
+    1.31060E+00  -1.01046E-03   1.01428E+00  -7.80726E-04   1.01428E+00
+   -7.80726E-04   1.01428E+00  -7.80726E-04   1.00000E+00   0.00000E+00
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/FILES
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/FILES	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/FILES	(revision 286)
@@ -0,0 +1,166 @@
+FILES
+ATM75
+ATM80
+ATM84
+ATM85
+ATM86
+ATM87
+ATM88
+ATM89
+ATM90
+EGSDAT2
+NUCNUCCS
+VENUSDAT
+GHEISHA.f
+QGSJET.f
+SIBYLL.f
+VENUS.f
+addang.f
+addani.f
+age.f
+amoeba.f
+amotry.f
+annih.f
+ausgab.f
+ausgb2.f
+avage.f
+avept.f
+bhabha.f
+block1.f
+box2.f
+box3.f
+box60.f
+box61.f
+box62.f
+box63.f
+box65.f
+box66.f
+box67.f
+box68.f
+box69.f
+box70.f
+box71.f
+box72.f
+box73.f
+box74.f
+brems.f
+cerenkov.f
+cghei.f
+cghini.f
+cghsig.f
+chisq.f
+compt.f
+coorin.f
+datac.f
+decay1.f
+decay6.f
+difrac.f
+dpfunc.f
+egs4.f
+egs4bd.f
+egsini.f
+electr.f
+em.f
+etadec.f
+flpsor.f
+fstack.f
+gam.f
+garndm.f
+gbrsgm.f
+gprsgm.f
+granor.f
+grndm.f
+hatch.f
+hdpm.f
+heigh.f
+hmeson.f
+howfar.f
+ininkg.f
+inprm.f
+isobar.f
+istack.f
+jadach.f
+kdecay.f
+leaddf.f
+ledeny.f
+lepacx.f
+longft.f
+lowup.f
+lpm.f
+main.f
+mitage.f
+mmol4.f
+mmolie.f
+moller.f
+mpoiss.f
+mpprop.f
+mscat.f
+mubrem.f
+mucoul.f
+mudecy.f
+mupair.f
+muprpr.f
+mutrac.f
+nihila.f
+nkg.f
+nsd.f
+nucint.f
+outend.f
+output.f
+pair.f
+pamaf.f
+parnum.f
+parrap.f
+pcl.f
+photo.f
+photon.f
+pi0dec.f
+pigen.f
+pigen1.f
+pigen2.f
+pparam.f
+prange.f
+prtime.f
+ptram.f
+ptran.f
+ptrans.f
+rangen.f
+rannor.f
+resdec.f
+rhof.f
+rmmaq.f
+rmmar.f
+rnegbi.f
+sdpm.f
+selcor.f
+shower.f
+single.f
+sobseq.f
+staend.f
+stankg.f
+start.f
+strdec.f
+tarint.f
+thick.f
+tobuf.f
+tstack.f
+tstend.f
+tstini.f
+tstout.f
+ucopy.f
+update.f
+uphi.f
+utqsea.f
+utqval.f
+vapor.f
+vendat.f
+venini.f
+venlnk.f
+vhmeso.f
+vstore.f
+vzero.f
+jcio.c
+jcdate.c
+Makefile
+c-script.sh
+magic-mc.daemon.tpl
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/GHEISHA.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/GHEISHA.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/GHEISHA.f	(revision 286)
@@ -0,0 +1,17506 @@
+*-- AUTHOR :
+      SUBROUTINE ADD(K,L,M)
+C
+C *** VARIOUS VECTOR OPERATIONS ***
+C
+C COPIED FROM F14BLO.PAMLIB 23.4.82
+C AUTHOR: V.BLOBEL (UNIVERSITY OF HAMBURG)
+C DESYLIB
+C
+C *** BLANK COMMON REPLACED BY /VECUTY/ TO MATCH GEANT/GHEISHA CODE ***
+C *** NOTE THAT P(10,100) HAS BECOME PV(10,200) DUE TO THIS         ***
+C
+C UN-USED ENTRIES REMOVED :
+C     "PCOP" "PEXC" "PZER" "PWRT" "DOT4" "IMPU" "IMPULI" "ADD3"
+C     "SUB3" "CROSS" "DOT" "SMUL" "NORZ" "PARPER" "PUNIT" "TRAP"
+C
+C *** ALL ENTRIES RE-WRITTEN AS SUBROUTINES USING ONLY NECESSARY ***
+C *** "DOUBLE PRECISION" STMTS. AND ALL SPECIFIC FUNCTIONS HAVE  ***
+C *** BEEN CHANGED TO THEIR GENERIC EQUIVALENCES                 ***
+C *** NVE 29-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (22-JUNE-1984)
+C
+C
+C --- PV-ARRAY ---
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DOUBLE PRECISION A,B
+C
+      A=PV(4,K)+PV(4,L)
+      PV(4,M)=A
+      B=A*A
+      DO 2 I=1,3
+      A=PV(I,K)+PV(I,L)
+      B=B-A*A
+      PV(I,M)=A
+ 2    CONTINUE
+      PV(5,M)=SIGN(SQRT(ABS(B)),B)
+      RETURN
+      END
+C---------------------------------------------------------------------
+      SUBROUTINE ADD3(K,L,M)
+C
+C --- PV-ARRAY ---
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DOUBLE PRECISION A
+C
+      DO 2 I=1,3
+      A=PV(I,K)+PV(I,L)
+      PV(I,M)=A
+    2 CONTINUE
+      RETURN
+      END
+C---------------------------------------------------------------------
+      SUBROUTINE SUB3(K,L,M)
+C
+C --- PV-ARRAY ---
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DOUBLE PRECISION A
+C
+      DO 2 I=1,3
+      A=PV(I,K)-PV(I,L)
+      PV(I,M)=A
+    2 CONTINUE
+      RETURN
+      END
+C---------------------------------------------------------------------
+      SUBROUTINE CROSS3(K,L,M)
+C
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+      DIMENSION G(3)
+      DOUBLE PRECISION A,B,G
+C
+      A=PV(2,K)*PV(3,L)
+      B=PV(3,K)*PV(2,L)
+      G(1)=A-B
+      A=PV(3,K)*PV(1,L)
+      B=PV(1,K)*PV(3,L)
+      G(2)=A-B
+      A=PV(1,K)*PV(2,L)
+      B=PV(2,K)*PV(1,L)
+      G(3)=A-B
+      DO 26 I=1,3
+   26 PV(I,M)=G(I)
+      RETURN
+      END
+C---------------------------------------------------------------------
+      SUBROUTINE SUB(K,L,M)
+C
+C --- PV-ARRAY ---
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DOUBLE PRECISION A,B
+C
+      A=PV(4,K)-PV(4,L)
+      PV(4,M)=A
+      B=A*A
+      DO 4 I=1,3
+      A=PV(I,K)-PV(I,L)
+      B=B-A*A
+      PV(I,M)=A
+ 4    CONTINUE
+      PV(5,M)=SIGN(SQRT(ABS(B)),B)
+      RETURN
+      END
+C---------------------------------------------------------------------
+      SUBROUTINE LOR(K,L,M)
+C
+C --- PV-ARRAY ---
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DOUBLE PRECISION A,B,C
+C
+      A=0.0
+      DO 6 I=1,3
+      A=A+PV(I,K)*PV(I,L)
+ 6    CONTINUE
+      A=(A/(PV(4,L)+PV(5,L))-PV(4,K))/PV(5,L)
+      B=PV(5,K)*PV(5,K)
+      DO 8 I=1,3
+      C=PV(I,K)+A*PV(I,L)
+      B=B+C*C
+      PV(I,M)=C
+ 8    CONTINUE
+      PV(4,M)=SQRT(B)
+      PV(5,M)=PV(5,K)
+      RETURN
+      END
+C---------------------------------------------------------------------
+      SUBROUTINE LENGTX(K,U)
+C
+C --- PV-ARRAY ---
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DOUBLE PRECISION A,B
+C
+      A=0.0
+      DO 36 I=1,3
+      A=A+PV(I,K)*PV(I,K)
+ 36   CONTINUE
+      B=SQRT(A)
+      U=B
+      RETURN
+      END
+C---------------------------------------------------------------------
+      SUBROUTINE ANG(K,L,U,V)
+C
+C --- PV-ARRAY ---
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DOUBLE PRECISION A,B,C,D
+C
+      A=0.0
+      B=0.0
+      C=0.0
+      DO 38 I=1,3
+      A=A+PV(I,K)*PV(I,K)
+      B=B+PV(I,L)*PV(I,L)
+      C=C+PV(I,K)*PV(I,L)
+ 38   CONTINUE
+      D=SQRT(A*B)
+      IF (D .NE. 0.0) D=C/D
+      IF (ABS(D) .GT. 1.D0) D=SIGN(1.D0,D)
+      U=D
+      V=ACOS(D)
+      RETURN
+      END
+C---------------------------------------------------------------------
+      SUBROUTINE DEFS(K,L,M)
+C
+C --- PV-ARRAY ---
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DOUBLE PRECISION A,B
+C
+      MX=M
+      MY=M+1
+      MZ=M+2
+      DO 52 I=1,3
+      F=PV(I,K)
+      H=PV(I,L)
+      PV(I,MY)=F
+      PV(I,MZ)=H
+ 52   CONTINUE
+      A=PV(2,MY)*PV(3,MZ)
+      B=PV(3,MY)*PV(2,MZ)
+      PV(1,MX)=A-B
+      A=PV(3,MY)*PV(1,MZ)
+      B=PV(1,MY)*PV(3,MZ)
+      PV(2,MX)=A-B
+      A=PV(1,MY)*PV(2,MZ)
+      B=PV(2,MY)*PV(1,MZ)
+      PV(3,MX)=A-B
+      A=PV(2,MZ)*PV(3,MX)
+      B=PV(3,MZ)*PV(2,MX)
+      PV(1,MY)=A-B
+      A=PV(3,MZ)*PV(1,MX)
+      B=PV(1,MZ)*PV(3,MX)
+      PV(2,MY)=A-B
+      A=PV(1,MZ)*PV(2,MX)
+      B=PV(2,MZ)*PV(1,MX)
+      PV(3,MY)=A-B
+      DO 58 J=MX,MZ
+      A=0.0
+      DO 54 I=1,3
+      A=A+PV(I,J)*PV(I,J)
+ 54   CONTINUE
+      B=SQRT(A)
+      IF (B .NE. 0.0) B=1.0/B
+      DO 56 I=1,3
+      PV(I,J)=B*PV(I,J)
+ 56   CONTINUE
+ 58   CONTINUE
+      RETURN
+      END
+C---------------------------------------------------------------------
+      SUBROUTINE TRAC(K,L,M)
+C
+C --- PV-ARRAY ---
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DOUBLE PRECISION B,G(3)
+C
+      N=L
+      DO 62 J=1,3
+      B=0.0
+      DO 60 I=1,3
+      B=B+PV(I,N)*PV(I,K)
+ 60   CONTINUE
+      G(J)=B
+      N=N+1
+ 62   CONTINUE
+      DO 64 I=1,3
+      PV(I,M)=G(I)
+ 64   CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      REAL FUNCTION ATOMAS(A,Z)
+C
+C *** DETERMINATION OF THE ATOMIC MASS ***
+C *** NVE 19-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (02-DEC-1986)
+C
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+C
+      DOUBLE PRECISION AA,ZZ,MASS
+C
+C --- GET ATOMIC (= ELECTRONS INCL.) MASSES (IN MEV) FROM RMASS ARRAY ---
+C --- ELECTRON ---
+      RMEL=RMASS(4)*1000.
+C --- PROTON ---
+      RMP=RMASS(14)*1000.
+C --- NEUTRON ---
+      RMN=RMASS(16)*1000.
+C --- DEUTERON ---
+      RMD=RMASS(30)*1000.+RMEL
+C --- ALPHA ---
+      RMA=RMASS(32)*1000.+2.*RMEL
+C
+      ATOMAS = 0.
+      AA = A * 1.D0
+      ZZ = Z * 1.D0
+      IA = IFIX(A + 0.5)
+      IF(IA.LT.1) RETURN
+      IZ = IFIX(Z + 0.5)
+      IF(IZ.LT.0) RETURN
+      IF(IZ.GT.IA) RETURN
+      IF(IA.GT.4) GOTO 50
+      MASS=0.D0
+      GOTO (10,20,50,40),IA
+   10 IF(IZ.EQ.0) MASS=RMN
+      IF(IZ.EQ.1) MASS=RMP+RMEL
+      GOTO 60
+   20 IF(IZ.NE.1) GOTO 50
+      MASS=RMD
+      GOTO 60
+   40 IF(IZ.NE.2) GOTO 50
+      MASS=RMA
+      GOTO 60
+   50 MASS=(AA-ZZ)*RMN + ZZ*RMP +ZZ*RMEL - 15.67*AA
+     *     + 17.23*(AA**0.6666667) + 93.15*((AA/2.-ZZ)**2)/AA
+     *     +0.6984523*ZZ**2/(AA**0.3333333)
+      IPP=MOD(IA-IZ,2)
+      IZZ=MOD(IZ,2)
+      IF(IPP.NE.IZZ) GOTO 60
+      MASS = MASS + (IPP+IZZ- 1)*12.00*(AA**(-0.5))
+   60 ATOMAS = MASS*0.001
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CAPTUR(NOPT)
+C
+C *** ROUTINE FOR CAPTURE OF NEUTRAL BARYONS ***
+C *** NVE 04-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (02-DEC-1986)
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DIMENSION RNDM(3)
+C
+      NOPT=1
+      IER(81)=IER(81)+1
+      PV(1,1)=PX*P
+      PV(2,1)=PY*P
+      PV(3,1)=PZ*P
+      PV(4,1)=EN
+      PV(5,1)=ABS(AMAS)
+      PV(6,1)=NCH
+      PV(7,1)=TOF
+      PV(8,1)=IPART
+      PV(9,1)=0.
+      PV(10,1)=USERW
+      ND=IND+1
+      PV(1,2)=0.
+      PV(2,2)=0.
+      PV(3,2)=0.
+      PV(4,2)=ATOMAS(ATNO(ND),ZNO(ND))
+      PV(5,2)=PV(4,2)
+      PV(6,2)=ZNO(ND)
+      PV(7,2)=TOF
+      PV(8,2)=0.
+      PV(9,2)=0.
+      PV(10,2)=0.
+      CALL ADD(1,2,MXGKPV)
+      PV(1,MXGKPV)=-PV(1,MXGKPV)
+      PV(2,MXGKPV)=-PV(2,MXGKPV)
+      PV(3,MXGKPV)=-PV(3,MXGKPV)
+      CALL NORMAL(RAN)
+      P=0.0065+RAN*0.0010
+      CALL GRNDM(RNDM,3)
+      COST=-1.+RNDM(1)*2.
+      SINT=SQRT(ABS(1.-COST*COST))
+      PHI=TWPI*RNDM(2)
+      PV(1,3)=P*SINT*SIN(PHI)
+      PV(2,3)=P*SINT*COS(PHI)
+      PV(3,3)=P*COST
+      PV(4,3)=P
+      PV(5,3)=0.
+      PV(6,3)=0.
+      PV(8,3)=1.
+      PV(9,3)=0.
+      PV(10,3)=0.
+      RAN=RNDM(3)
+      TOF=TOF-480.*LOG(RAN)
+      PV(7,3)=TOF
+      CALL LOR(3,MXGKPV,3)
+      NT=3
+      XP=0.008-P
+      IF(XP.LT.0.) GOTO 9
+      NT=4
+      CALL GRNDM(RNDM,2)
+      COST=-1.+RNDM(1)*2.
+      SINT=SQRT(ABS(1.-COST*COST))
+      PHI=TWPI*RNDM(2)
+      PV(1,4)=XP*SINT*SIN(PHI)
+      PV(2,4)=XP*SINT*COS(PHI)
+      PV(3,4)=XP*COST
+      PV(4,4)=XP
+      PV(5,4)=0.
+      PV(6,4)=0.
+      PV(7,4)=TOF
+      PV(8,4)=1.
+      PV(9,4)=0.
+      PV(10,4)=0.
+      CALL LOR(4,MXGKPV,4)
+    9 INTCT=INTCT+1.
+      CALL SETCUR(3)
+      NTK=NTK+1
+      IF(NT.EQ.4) CALL SETTRK(4)
+      IF(NPRT(4))
+     *WRITE(NEWBCD,1002) XEND,YEND,ZEND,EN,XP
+1002  FORMAT(' *CAPTUR* NEUTRON CAPTURE   POSITION',3(2X,F8.2),2X,
+     * 'PHOTON ENERGIES',2X,2F8.4)
+C
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CASAL0(K,INT,NFL)
+C
+C *** CASCADE OF ANTI-LAMBDA ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (13-SEP-1987)
+C
+C L0B UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL1(2,1200),PMUL2(2,400),ANORM1(2,60),ANORM2(2,60),
+     $          CECH(10),ANHL(25),IIPA(10,2),B(2)
+      DIMENSION RNDM(2)
+      SAVE PMUL1,ANORM1,PMUL2,ANORM2
+      DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
+      DATA ANHL/1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,0.97,0.88
+     $         ,0.85,0.81,0.75,0.64,0.64,0.55,0.55,0.45,0.47,0.40
+     $         ,0.39,0.36,0.33,0.10,0.01/
+      DATA IIPA/24,25,14,14,16,23,24,16,16,14,
+     $          14,16,19,24,25,14,16,19,24,23/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(1) ---
+      IF (KGINIT(1) .NE. 0) GO TO 10
+      KGINIT(1)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL1(I,J)=0.0
+      IF (J .LE. 400) PMUL2(I,J)=0.0
+      IF (J .LE. 60) ANORM1(I,J)=0.0
+      IF (J .LE. 60) ANORM2(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR P AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 1 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL1(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM1(1,NT)=ANORM1(1,NT)+PMUL1(1,L)
+    1 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LT.1) NMM1=1
+      NPP1=NP1+2
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL1(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM1(2,NT)=ANORM1(2,NT)+PMUL1(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM1(1,I).GT.0.) ANORM1(1,I)=1./ANORM1(1,I)
+      IF(ANORM1(2,I).GT.0.) ANORM1(2,I)=1./ANORM1(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 9
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM1(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL1(NFL,I),I=1,1200)
+    4 CONTINUE
+C** DO THE SAME FOR ANNIHILATION CHANNELS
+C** FOR P AS TARGET
+C
+    9 L=0
+      DO 5 NP1=2,20
+      NP=NP1-1
+      NM=NP-1
+      DO 5 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 5
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 5
+      PMUL2(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM2(1,NT)=ANORM2(1,NT)+PMUL2(1,L)
+    5 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 6 NP1=1,20
+      NP=NP1-1
+      NM=NP
+      DO 6 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 6
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 6
+      PMUL2(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM2(2,NT)=ANORM2(2,NT)+PMUL2(2,L)
+    6 CONTINUE
+      DO 7 I=1,60
+      IF(ANORM2(1,I).GT.0.) ANORM2(1,I)=1./ANORM2(1,I)
+      IF(ANORM2(2,I).GT.0.) ANORM2(2,I)=1./ANORM2(2,I)
+    7 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,3001)
+      DO 8 NFL=1,2
+      WRITE(NEWBCD,3002) NFL
+      WRITE(NEWBCD,3003) (ANORM2(NFL,I),I=1,60)
+      WRITE(NEWBCD,3003) (PMUL2(NFL,I),I=1,400)
+    8 CONTINUE
+C** CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-ABS(RMASS(19))
+C**  ELASTIC SCATTERING
+      NP=0
+      NM=0
+      NZ=0
+      IPA(1)=19
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      N=0.
+      IF(INT.EQ.2) GOTO 20
+      IPLAB=IFIX(P*2.5)+1
+      IF(IPLAB.GT.10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 120
+C** INTRODUCE CHARGE AND STRANGENESS EXCHANGE REACTION
+C** LB P --> S0B P, LB P --> S-B N, LB N --> S+B P, LB N --> S0B N
+C** LB P --> P LB, LB P --> P S0B, LB P --> N S-B
+C** LB N --> N LB, LB N --> N S0B, LB N --> P S+B
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IRN=IFIX(RAN/0.2)+1
+      IF(IRN.GT.5) IRN=5
+      IRN=IRN+(NFL-1)*5
+      IPA(1)=IIPA(IRN,1)
+      IPA(2)=IIPA(IRN,2)
+      GOTO 120
+C** ANNIHILATION CHANNELS
+   20 IPLAB=IFIX(P*10.)+1
+      IF(IPLAB.GT.10) IPLAB=IFIX((P-1.)*5.)+11
+      IF(IPLAB.GT.15) IPLAB=IFIX( P-2.    )+16
+      IF(IPLAB.GT.23) IPLAB=IFIX((P-10.)/10.)+24
+      IF(IPLAB.GT.25) IPLAB=25
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.ANHL(IPLAB)) GOTO 19
+      EAB=RS
+      IF (EAB .LE. RMASS(7)+RMASS(10)) GOTO 55
+      GOTO 222
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+   19 IF (EAB .LE. RMASS(7)) GOTO 55
+      ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (30,40),NFL
+C** FOR P AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 31 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL1(1,L)*ANORM1(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   31 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LT.1) NMM1=1
+      NPP1=NP1+2
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL1(2,L)*ANORM1(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   41 CONTINUE
+      GOTO 80
+C** ANNIHILATION CHANNELS
+  222 IPA(1)=0
+      IPA(2)=0
+      ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 221 NT=2,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+  221 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (230,240),NFL
+C** FOR P AS TARGET
+  230 L=0
+      DO 231 NP1=2,20
+      NP=NP1-1
+      NM=NP-1
+      DO 231 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 231
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 231
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL2(1,L)*ANORM2(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 120
+  231 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+  240 L=0
+      DO 241 NP1=1,20
+      NP=NP1-1
+      NM=NP
+      DO 241 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 241
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 241
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL2(2,L)*ANORM2(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 120
+  241 CONTINUE
+      GOTO 80
+   50 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      IF(INT.EQ.1) CALL TWOB(19,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(19,NFL,N)
+      GO TO 9999
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND,ASSUME ELASTIC SCATTERING
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004) RS,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+      IPA(1)=19
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      GOTO 120
+  100 DO 101 I=1,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+      GOTO (102,112),NFL
+  102 NCHT=NP-NM
+      NCHT=NCHT+2
+      IF(NCHT.LE.0) NCHT=1
+      IF(NCHT.GT.4) NCHT=4
+      GOTO(103,104,105,106),NCHT
+  103 IPA(1)=25
+      IPA(2)=14
+      GOTO 120
+  104 IPA(1)=19
+      IPA(2)=14
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) IPA(1)=24
+      IF(RNDM(2).LT.0.5) GOTO 120
+      IPA(1)=25
+      IPA(2)=16
+      GOTO 120
+  105 IPA(1)=19
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) IPA(1)=24
+      IPA(2)=16
+      IF(RNDM(2).LT.0.5) GOTO 120
+      IPA(1)=23
+      IPA(2)=14
+      GOTO 120
+  106 IPA(1)=23
+      IPA(2)=16
+      GOTO 120
+  112 NCHT=NP-NM
+      NCHT=NCHT+3
+      IF(NCHT.LE.0) NCHT=1
+      IF(NCHT.GT.4) NCHT=4
+      GOTO(113,114,115,116),NCHT
+  113 IPA(1)=25
+      IPA(2)=14
+      GOTO 120
+  114 IPA(1)=19
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) IPA(1)=24
+      IPA(2)=14
+      IF(RNDM(2).LT.0.5) GOTO 120
+      IPA(1)=25
+      IPA(2)=16
+      GOTO 120
+  115 IPA(1)=19
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) IPA(1)=24
+      IPA(2)=16
+      IF(RNDM(2).LT.0.5) GOTO 120
+      IPA(1)=23
+      IPA(2)=14
+      GOTO 120
+  116 IPA(1)=23
+      IPA(2)=16
+  120 NT=2
+      IF(IPA(1).NE.0) GOTO 119
+      IF(NZ.EQ.0) GOTO 118
+      IF(NM.EQ.0) GOTO 117
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 118
+  117 IPA(3)=12
+      NZ=NZ-1
+      NT=3
+      GOTO 119
+  118 IF(NM.EQ.0) GOTO 119
+      IPA(3)=13
+      NM=NM-1
+      NT=3
+  119 IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      GOTO 50
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASAL0* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003  FORMAT(' *CASAL0* ANTILAMBDA-INDUCED CASCADE,',
+     $ 'AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASAL0* ANTILAMBDA-INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION',
+     $' NOT FOUND  TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASAL0* TABLES FOR MULT. DATA ANTILAMBDA INDUCED ',
+     $ 'REACTION  FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASAL0* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASAL0* ',I3,2X,'PARTICLES, MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASAL0* NO PARTICLES PRODUCED')
+3001  FORMAT(' *CASAL0* TABLES FOR MULT. DATA ANTIPROTON INDUCED ',
+     $ 'ANNIHILATION REACTION  FOR DEFINITION OF NUMBERS SEE FORTRAN',
+     $ ' CODING')
+3002  FORMAT(' *CASAL0* TARGET PARTICLE FLAG',2X,I5)
+3003  FORMAT(1H ,10E12.4)
+C
+ 9999 CONTINUE
+      RETURN
+      END
+      SUBROUTINE CASAOM(K,INT,NFL)
+C
+C *** CASCADE OF OMEGA-  BAR ***
+C *** NVE 17-JAN-1989 CERN GENEVA ***
+C
+C OMEGA- BAR UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT, ASSUME NUCLEAR EXCITATION OCCURS, DEGRADE INPUT PARTICLE
+C IN ENERGY AND NO OTHER PARTICLES ARE PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C
+C *** NOT YET FINISHED ==> TAKE OMEGA- CASCADE INSTEAD ***
+C
+C --- INITIALIZATION INDICATED BY KGINIT(24) ---
+      KGINIT(24)=1
+C
+      IF (NPRT(4)) PRINT 1000
+ 1000 FORMAT(' *CASAOM* NOT WRITTEN YET ==> CASOM CALLED INSTEAD')
+C
+      CALL CASOM(K,INT,NFL)
+C
+ 9999 CONTINUE
+      END
+*-- AUTHOR :
+      SUBROUTINE CASASM(K,INT,NFL)
+C
+C *** CASCADE OF ANTI SIGMA- ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (13-SEP-1987)
+C
+C S-B UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL1(2,1200),PMUL2(2,400),ANORM1(2,60),ANORM2(2,60),
+     $          CECH(10),ANHL(25),IIPA(10,2),B(2)
+      DIMENSION RNDM(2)
+      SAVE PMUL1,ANORM1,PMUL2,ANORM2
+      DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
+      DATA ANHL/1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,0.97,0.88
+     $         ,0.85,0.81,0.75,0.64,0.64,0.55,0.55,0.45,0.47,0.40
+     $         ,0.39,0.36,0.33,0.10,0.01/
+      DATA IIPA/14,14,14,14,14,19,24,16,14,14,
+     $          25,25,25,25,25,14,14,25,19,24/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(2) ---
+      IF (KGINIT(2) .NE. 0) GO TO 10
+      KGINIT(2)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL1(I,J)=0.0
+      IF (J .LE. 400) PMUL2(I,J)=0.0
+      IF (J .LE. 60) ANORM1(I,J)=0.0
+      IF (J .LE. 60) ANORM2(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR P AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1
+      DO 1 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL1(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM1(1,NT)=ANORM1(1,NT)+PMUL1(1,L)
+    1 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LT.1) NMM1=1
+      NPP1=NP1+1
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL1(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM1(2,NT)=ANORM1(2,NT)+PMUL1(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM1(1,I).GT.0.) ANORM1(1,I)=1./ANORM1(1,I)
+      IF(ANORM1(2,I).GT.0.) ANORM1(2,I)=1./ANORM1(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 9
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM1(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL1(NFL,I),I=1,1200)
+    4 CONTINUE
+C** DO THE SAME FOR ANNIHILATION CHANNELS
+C** FOR P AS TARGET
+C
+    9 L=0
+      DO 5 NP1=3,20
+      NP=NP1-1
+      NM=NP-2
+      DO 5 NZ1=1,20
+      NZ=NZ1-1
+      IF(NM+NZ.EQ.0) GOTO 5
+      L=L+1
+      IF(L.GT.400) GOTO 5
+      NT=NP+NM+NZ
+      IF(NT.LE.2.OR.NT.GT.60) GOTO 5
+      PMUL2(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM2(1,NT)=ANORM2(1,NT)+PMUL2(1,L)
+    5 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 6 NP1=2,20
+      NP=NP1-1
+      NM=NP-1
+      DO 6 NZ1=1,20
+      NZ=NZ1-1
+      IF(NM+NZ.EQ.0) GOTO 6
+      L=L+1
+      IF(L.GT.400) GOTO 6
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 6
+      PMUL2(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM2(2,NT)=ANORM2(2,NT)+PMUL2(2,L)
+    6 CONTINUE
+      DO 7 I=1,60
+      IF(ANORM2(1,I).GT.0.) ANORM2(1,I)=1./ANORM2(1,I)
+      IF(ANORM2(2,I).GT.0.) ANORM2(2,I)=1./ANORM2(2,I)
+    7 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,3001)
+      DO 8 NFL=1,2
+      WRITE(NEWBCD,3002) NFL
+      WRITE(NEWBCD,3003) (ANORM2(NFL,I),I=1,60)
+      WRITE(NEWBCD,3003) (PMUL2(NFL,I),I=1,400)
+    8 CONTINUE
+C** CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-ABS(RMASS(25))
+C**  ELASTIC SCATTERING
+      NP=0
+      NM=0
+      NZ=0
+      IPA(1)=25
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      N=0.
+      IF(INT.EQ.2) GOTO 20
+      IPLAB=IFIX(P*2.5)+1
+      IF(IPLAB.GT.10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 120
+C** INTRODUCE CHARGE AND STRANGENESS EXCHANGE REACTION
+C** S-B N --> LB P, S-B N --> S0B P,
+C**                                  S-B P --> P S-B
+C** S-B N --> N S-B, S-B N --> P LB, S-B N --> P S0B
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IRN=IFIX(RAN/0.2)+1
+      IF(IRN.GT.5) IRN=5
+      IRN=IRN+(NFL-1)*5
+      IPA(1)=IIPA(IRN,1)
+      IPA(2)=IIPA(IRN,2)
+      GOTO 120
+C** ANNIHILATION CHANNELS
+   20 IPLAB=IFIX(P*10.)+1
+      IF(IPLAB.GT.10) IPLAB=IFIX((P-1.)*5.)+11
+      IF(IPLAB.GT.15) IPLAB=IFIX( P-2.    )+16
+      IF(IPLAB.GT.23) IPLAB=IFIX((P-10.)/10.)+24
+      IF(IPLAB.GT.25) IPLAB=25
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.ANHL(IPLAB)) GOTO 19
+      EAB=RS
+      IF (EAB .LE. RMASS(7)+RMASS(10)) GOTO 55
+      GOTO 222
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+   19 IF (EAB .LE. RMASS(7)) GOTO 55
+      ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (30,40),NFL
+C** FOR P AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1
+      DO 31 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL1(1,L)*ANORM1(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   31 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LT.1) NMM1=1
+      NPP1=NP1+1
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL1(2,L)*ANORM1(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   41 CONTINUE
+      GOTO 80
+C** ANNIHILATION CHANNELS
+  222 IPA(1)=0
+      IPA(2)=0
+      ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 221 NT=2,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+  221 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (230,240),NFL
+C** FOR P AS TARGET
+  230 L=0
+      DO 231 NP1=3,20
+      NP=NP1-1
+      NM=NP-2
+      DO 231 NZ1=1,20
+      NZ=NZ1-1
+      IF(NM+NZ.EQ.0) GOTO 231
+      L=L+1
+      IF(L.GT.400) GOTO 231
+      NT=NP+NM+NZ
+      IF(NT.LE.2.OR.NT.GT.60) GOTO 231
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL2(1,L)*ANORM2(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 120
+  231 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+  240 L=0
+      DO 241 NP1=2,20
+      NP=NP1-1
+      NM=NP-1
+      DO 241 NZ1=1,20
+      NZ=NZ1-1
+      IF(NM+NZ.EQ.0) GOTO 241
+      L=L+1
+      IF(L.GT.400) GOTO 241
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 241
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL2(2,L)*ANORM2(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 120
+  241 CONTINUE
+      GOTO 80
+   50 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      IF(INT.EQ.1) CALL TWOB(25,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(25,NFL,N)
+      GO TO 9999
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND,ASSUME ELASTIC SCATTERING
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004) RS,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+      IPA(1)=25
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      GOTO 120
+  100 DO 101 I=1,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+      GOTO (102,112),NFL
+  102 NCHT=NP-NM
+      NCHT=NCHT+1
+      IF(NCHT.LE.0) NCHT=1
+      IF(NCHT.GT.3) NCHT=3
+      GOTO(103,104,105),NCHT
+  103 IPA(1)=25
+      IPA(2)=14
+      GOTO 120
+  104 IPA(1)=25
+      IPA(2)=16
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) GOTO 120
+      IPA(1)=24
+      IF(RNDM(2).LT.0.5) IPA(1)=19
+      IPA(2)=14
+      GOTO 120
+  105 IPA(1)=24
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) IPA(1)=19
+      IPA(2)=16
+      GOTO 120
+  112 NCHT=NP-NM
+      NCHT=NCHT+2
+      IF(NCHT.LE.0) NCHT=1
+      IF(NCHT.GT.3) NCHT=3
+      GOTO(113,114,115),NCHT
+  113 IPA(1)=25
+      IPA(2)=14
+      GOTO 120
+  114 IPA(1)=24
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) IPA(1)=19
+      IPA(2)=14
+      IF(RNDM(2).LT.0.5) GOTO 120
+      IPA(1)=25
+      IPA(2)=16
+      GOTO 120
+  115 IPA(1)=24
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) IPA(1)=19
+      IPA(2)=16
+  120 NT=2
+      IF(IPA(1).NE.0) GOTO 119
+      IF(NZ.EQ.0) GOTO 118
+      IF(NM.EQ.0) GOTO 117
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 118
+  117 IPA(3)=12
+      NZ=NZ-1
+      NT=3
+      GOTO 119
+  118 IF(NM.EQ.0) GOTO 119
+      IPA(3)=13
+      NM=NM-1
+      NT=3
+  119 IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      GOTO 50
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASASM* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003  FORMAT(' *CASASM* ANTISIGMA- -INDUCED CASCADE',
+     $ ' AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASASM* ANTISIGMA- -INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION',
+     $' NOT FOUND  TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASASM* TABLES FOR MULT. DATA ANTISIGMA- INDUCED ',
+     $ 'REACTION  FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASASM* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASASM* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASASM* NO PARTICLES PRODUCED')
+3001  FORMAT(' *CASASM* TABLES FOR MULT. DATA ANTISIGMA- INDUCED ',
+     * 'ANNIHILATION REACTION  FOR DEFINITION OF NUMBERS SEE FORTRAN',
+     * ' CODING')
+3002  FORMAT(' *CASASM* TARGET PARTICLE FLAG',2X,I5)
+3003  FORMAT(1H ,10E12.4)
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CASASP(K,INT,NFL)
+C
+C *** CASCADE OF ANTI SIGMA+ ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (13-SEP-1987)
+C
+C S+B UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL1(2,1200),PMUL2(2,400),ANORM1(2,60),ANORM2(2,60),
+     $          CECH(10),ANHL(25),IIPA(10,2),B(2)
+      DIMENSION RNDM(2)
+      SAVE PMUL1,ANORM1,PMUL2,ANORM2
+      DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
+      DATA ANHL/1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,0.97,0.88
+     $         ,0.85,0.81,0.75,0.64,0.64,0.55,0.55,0.45,0.47,0.40
+     $         ,0.39,0.36,0.33,0.10,0.01/
+      DATA IIPA/19,24,16,16,14,16,16,16,16,16,
+     $          16,16,19,24,23,23,23,23,23,23/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(3) ---
+      IF (KGINIT(3) .NE. 0) GO TO 10
+      KGINIT(3)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL1(I,J)=0.0
+      IF (J .LE. 400) PMUL2(I,J)=0.0
+      IF (J .LE. 60) ANORM1(I,J)=0.0
+      IF (J .LE. 60) ANORM2(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR P AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 1 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL1(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM1(1,NT)=ANORM1(1,NT)+PMUL1(1,L)
+    1 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1
+      IF(NMM1.LT.1) NMM1=1
+      NPP1=NP1+2
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL1(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM1(2,NT)=ANORM1(2,NT)+PMUL1(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM1(1,I).GT.0.) ANORM1(1,I)=1./ANORM1(1,I)
+      IF(ANORM1(2,I).GT.0.) ANORM1(2,I)=1./ANORM1(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 9
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM1(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL1(NFL,I),I=1,1200)
+    4 CONTINUE
+C** DO THE SAME FOR ANNIHILATION CHANNELS
+C** FOR P AS TARGET
+C
+    9 L=0
+      DO 5 NP1=2,20
+      NP=NP1-1
+      NM=NP
+      DO 5 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 5
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 5
+      PMUL2(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM2(1,NT)=ANORM2(1,NT)+PMUL2(1,L)
+    5 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 6 NP1=1,20
+      NP=NP1-1
+      NM=NP+1
+      DO 6 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 6
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 6
+      PMUL2(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM2(2,NT)=ANORM2(2,NT)+PMUL2(2,L)
+    6 CONTINUE
+      DO 7 I=1,60
+      IF(ANORM2(1,I).GT.0.) ANORM2(1,I)=1./ANORM2(1,I)
+      IF(ANORM2(2,I).GT.0.) ANORM2(2,I)=1./ANORM2(2,I)
+    7 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,3001)
+      DO 8 NFL=1,2
+      WRITE(NEWBCD,3002) NFL
+      WRITE(NEWBCD,3003) (ANORM2(NFL,I),I=1,60)
+      WRITE(NEWBCD,3003) (PMUL2(NFL,I),I=1,400)
+    8 CONTINUE
+C** CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-ABS(RMASS(23))
+C**  ELASTIC SCATTERING
+      NP=0
+      NM=0
+      NZ=0
+      IPA(1)=23
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      N=0.
+      IF(INT.EQ.2) GOTO 20
+      IPLAB=IFIX(P*2.5)+1
+      IF(IPLAB.GT.10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 120
+C** INTRODUCE CHARGE AND STRANGENESS EXCHANGE REACTION
+C** S+B P --> LB N, S+B P --> S0B N,
+C** S+B P --> N LB, S+B P --> N S0B, S+B P --> P S+B
+C** S+B N --> N S+B
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IRN=IFIX(RAN/0.2)+1
+      IF(IRN.GT.5) IRN=5
+      IRN=IRN+(NFL-1)*5
+      IPA(1)=IIPA(IRN,1)
+      IPA(2)=IIPA(IRN,2)
+      GOTO 120
+C** ANNIHILATION CHANNELS
+   20 IPLAB=IFIX(P*10.)+1
+      IF(IPLAB.GT.10) IPLAB=IFIX((P-1.)*5.)+11
+      IF(IPLAB.GT.15) IPLAB=IFIX( P-2.    )+16
+      IF(IPLAB.GT.23) IPLAB=IFIX((P-10.)/10.)+24
+      IF(IPLAB.GT.25) IPLAB=25
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.ANHL(IPLAB)) GOTO 19
+      EAB=RS
+      IF (EAB .LE. RMASS(7)+RMASS(10)) GOTO 55
+      GOTO 222
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+   19 IF (EAB .LE. RMASS(7)) GOTO 55
+      ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (30,40),NFL
+C** FOR P AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 31 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL1(1,L)*ANORM1(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   31 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1
+      IF(NMM1.LT.1) NMM1=1
+      NPP1=NP1+2
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL1(2,L)*ANORM1(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   41 CONTINUE
+      GOTO 80
+C** ANNIHILATION CHANNELS
+  222 IPA(1)=0
+      IPA(2)=0
+      ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 221 NT=2,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+  221 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (230,240),NFL
+C** FOR P AS TARGET
+  230 L=0
+      DO 231 NP1=2,20
+      NP=NP1-1
+      NM=NP
+      DO 231 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 231
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 231
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL2(1,L)*ANORM2(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 120
+  231 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+  240 L=0
+      DO 241 NP1=1,20
+      NP=NP1-1
+      NM=NP+1
+      DO 241 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 241
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 241
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL2(2,L)*ANORM2(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 120
+  241 CONTINUE
+      GOTO 80
+   50 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      IF(INT.EQ.1) CALL TWOB(23,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(23,NFL,N)
+      GO TO 9999
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND,ASSUME ELASTIC SCATTERING
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004) RS,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+      IPA(1)=23
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      GOTO 120
+  100 DO 101 I=1,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+      GOTO (102,112),NFL
+  102 NCHT=NP-NM
+      NCHT=NCHT+2
+      IF(NCHT.LE.0) NCHT=1
+      IF(NCHT.GT.3) NCHT=3
+      GOTO(103,104,105),NCHT
+  103 IPA(1)=24
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) IPA(1)=19
+      IPA(2)=14
+      GOTO 120
+  104 IPA(1)=23
+      IPA(2)=14
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) GOTO 120
+      IPA(1)=24
+      IF(RNDM(2).LT.0.5) IPA(1)=19
+      IPA(2)=16
+      GOTO 120
+  105 IPA(1)=23
+      IPA(2)=16
+      GOTO 120
+  112 NCHT=NP-NM
+      NCHT=NCHT+3
+      IF(NCHT.LE.0) NCHT=1
+      IF(NCHT.GT.3) NCHT=3
+      GOTO(113,114,115),NCHT
+  113 IPA(1)=24
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) IPA(1)=19
+      IPA(2)=14
+      GOTO 120
+  114 IPA(1)=24
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) IPA(1)=19
+      IPA(2)=16
+      IF(RNDM(2).LT.0.5) GOTO 120
+      IPA(1)=23
+      IPA(2)=14
+      GOTO 120
+  115 IPA(1)=23
+      IPA(2)=16
+  120 NT=2
+      IF(IPA(1).NE.0) GOTO 119
+      IF(NZ.EQ.0) GOTO 118
+      IF(NM.EQ.0) GOTO 117
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 118
+  117 IPA(3)=12
+      NZ=NZ-1
+      NT=3
+      GOTO 119
+  118 IF(NM.EQ.0) GOTO 119
+      IPA(3)=13
+      NM=NM-1
+      NT=3
+  119 IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      GOTO 50
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASASP* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003  FORMAT(' *CASASP* ANTISIGMA+ -INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASASP* ANTISIGMA+ -INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION',
+     $' NOT FOUND  TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASASP* TABLES FOR MULT. DATA ANTISIGMA+ INDUCED ',
+     $ 'REACTION  FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASASP* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASASP* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASASP* NO PARTICLES PRODUCED')
+3001  FORMAT(' *CASASP* TABLES FOR MULT. DATA ANTIPROTON INDUCED ',
+     $ 'ANNIHILATION REACTION  FOR DEFINITION OF NUMBERS SEE FORTRAN',
+     $ ' CODING')
+3002  FORMAT(' *CASASP* TARGET PARTICLE FLAG',2X,I5)
+3003  FORMAT(1H ,10E12.4)
+C
+ 9999 CONTINUE
+      RETURN
+      END
+      SUBROUTINE CASAXM(K,INT,NFL)
+C
+C *** CASCADE OF XI- BAR ***
+C *** NVE 17-JAN-1989 CERN GENEVA ***
+C
+C XI- BAR UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT, ASSUME NUCLEAR EXCITATION OCCURS, DEGRADE INPUT PARTICLE
+C IN ENERGY AND NO OTHER PARTICLES ARE PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C
+C *** NOT YET FINISHED ==> TAKE XI- CASCADE INSTEAD ***
+C
+C --- INITIALIZATION INDICATED BY KGINIT(22) ---
+      KGINIT(22)=1
+C
+      IF (NPRT(4)) PRINT 1000
+ 1000 FORMAT(' *CASAXM* NOT WRITTEN YET ==> CASXM CALLED INSTEAD')
+C
+      CALL CASXM(K,INT,NFL)
+C
+ 9999 CONTINUE
+      END
+      SUBROUTINE CASAX0(K,INT,NFL)
+C
+C *** CASCADE OF XI0 BAR ***
+C *** NVE 17-JAN-1989 CERN GENEVA ***
+C
+C XI0 BAR UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT, ASSUME NUCLEAR EXCITATION OCCURS, DEGRADE INPUT PARTICLE
+C IN ENERGY AND NO OTHER PARTICLES ARE PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C
+C *** NOT YET FINISHED ==> TAKE XI0 CASCADE INSTEAD ***
+C
+C --- INITIALIZATION INDICATED BY KGINIT(23) ---
+      KGINIT(23)=1
+C
+      IF (NPRT(4)) PRINT 1000
+ 1000 FORMAT(' *CASAX0* NOT WRITTEN YET ==> CASX0 CALLED INSTEAD')
+C
+      CALL CASX0(K,INT,NFL)
+C
+ 9999 CONTINUE
+      END
+*-- AUTHOR :
+      SUBROUTINE CASFRG(NUCFLG,INT,NFL)
+C
+C *** CASCADE OF HEAVY FRAGMENTS ***
+C *** NVE 11-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (02-DEC-1986)
+C
+C --- NUCFLG IS A FLAG TO DENOTE THE NUCREC ACTION ---
+C NUCFLG = 0 ==> NO ACTION TAKEN BY NUCREC
+C          1 ==> ACTION TAKEN BY NUCREC
+      NUCFLG=1
+      CALL NUCREC(NOPT,2)
+      IF (NOPT .NE. 0) GO TO 9999
+C
+      NUCFLG=0
+      CALL COSCAT
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CASKM(K,INT,NFL)
+C
+C *** CASCADE OF K- ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (13-SEP-1987)
+C
+C K-  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL(2,1200),ANORM(2,60),CECH(10),CNK0(20),PIY1(4),
+     $          PIY2(3),IPIY1(2,4),IPIY2(2,3),IPIY3(2,3),B(2)
+      DIMENSION RNDM(1)
+      SAVE PMUL,ANORM
+      DATA CECH/1.,1.,1.,0.70,0.60,0.55,0.35,0.25,0.18,0.15/
+      DATA CNK0/0.17,0.18,0.17,0.24,0.26,0.20,0.22,0.21,0.34,0.45
+     $         ,0.58,0.55,0.36,0.29,0.29,0.32,0.32,0.33,0.33,0.33/
+      DATA PIY1/0.67,0.78,0.89,1.00/,PIY2/0.68,0.84,1.00/
+      DATA IPIY1/8,18,9,20,8,21,7,22/
+      DATA IPIY2/9,18,9,21,8,22/,IPIY3/7,18,8,20,7,21/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(4) ---
+      IF (KGINIT(4) .NE. 0) GO TO 10
+      KGINIT(4)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL(I,J)=0.0
+      IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR P AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 1 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+    1 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NPP1=NP1+2
+      DO 2 NM1=NP1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
+      IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+    4 CONTINUE
+C**  CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-RMASS(13)
+C
+C**  ELASTIC SCATTERING
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=13
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      IF(INT.EQ.2) GOTO 20
+      GOTO 100
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+   20 IPLAB=IFIX(P*5.)+1
+      IF(IPLAB.GT.10) GOTO 22
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.CECH(IPLAB)) GOTO 19
+      IF (EAB .LT. RMASS(7)) GOTO 55
+      GOTO 22
+C** CHARGE EXCHANGE REACTION (IS INCLUDED IN INELASTIC CROSS SECTION)
+   19 IPLAB=IFIX(P*10.)+1
+      IF(IPLAB.GT.20) IPLAB=20
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CNK0(IPLAB)) GOTO 24
+      IF(NFL.EQ.1) GOTO 23
+C** FOR K- N REACTION NO K N STRANGENESS EXCHANGE POSSIBLE
+      INT=1
+      IPA(1)=13
+      IPA(2)=16
+      GOTO 100
+   23 INT=1
+      IPA(1)=12
+      IPA(2)=16
+      GOTO 100
+C** P L, P S REACTIONS
+   24 CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IF(RAN.LT.0.25) GOTO 25
+      IF(RAN.LT.0.50) GOTO 26
+      IF(RAN.LT.0.75) GOTO 27
+C** K- P --> PI0 L OR K- N --> PI- L
+      IPA(1)=8
+      IF(NFL.EQ.2) IPA(1)=9
+      IPA(2)=18
+      GOTO 100
+C** K- P --> PI- S+
+   25 IPA(1)=9
+      IPA(2)=20
+      IF(NFL.EQ.1) GOTO 100
+      IPA(1)=13
+      IPA(2)=16
+      GOTO 100
+C** K- P --> PI0 S0  OR K- N --> PI- S0
+   26 IPA(1)=8
+      IF(NFL.EQ.2) IPA(1)=9
+      IPA(2)=21
+      GOTO 100
+C** K- P --> PI+ S-  OR K- N --> PI0 S-
+   27 IPA(1)=7
+      IF(NFL.EQ.2) IPA(1)=8
+      IPA(2)=22
+      GOTO 100
+C
+   22 ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (30,40),NFL
+C** FOR P AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 31 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 50
+   31 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NPP1=NP1+2
+      DO 41 NM1=NP1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 50
+   41 CONTINUE
+      GOTO 80
+   50 GOTO (60,65),NFL
+   60 IF(NP.EQ.NM) GOTO 61
+      IF(NP.EQ.1+NM) GOTO 63
+      IPA(1)=12
+      IPA(2)=14
+      GOTO 90
+   61 CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.75) GOTO 62
+      IPA(1)=12
+      IPA(2)=16
+      GOTO 90
+   62 IPA(1)=13
+      IPA(2)=14
+      GOTO 90
+   63 IPA(1)=13
+      IPA(2)=16
+      GOTO 90
+   65 IF(NP.EQ.-1+NM) GOTO 66
+      IF(NP.EQ.NM) GOTO 68
+      IPA(1)=12
+      IPA(2)=16
+      GOTO 90
+   66 CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.50) GOTO 67
+      IPA(1)=12
+      IPA(2)=16
+      GOTO 90
+   67 IPA(1)=13
+      IPA(2)=14
+      GOTO 90
+   68 IPA(1)=13
+      IPA(2)=16
+C**  PI Y PRODUCTION INSTEAD OF K N
+   90 CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 100
+      IF(IPA(1).EQ.13.AND.IPA(2).EQ.16) GOTO 95
+      IF(IPA(1).EQ.11.AND.IPA(2).EQ.14) GOTO 95
+      IF(IPA(1).EQ.12.AND.IPA(2).EQ.14) GOTO 95
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      DO 91 I=1,4
+      IF(RAN.LT.PIY1(I)) GOTO 92
+   91 CONTINUE
+      GOTO 100
+   92 IPA(1)=IPIY1(1,I)
+      IPA(2)=IPIY1(2,I)
+      GOTO 100
+   95 CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      DO 96 I=1,3
+      IF(RAN.LT.PIY2(I)) GOTO 97
+   96 CONTINUE
+      GOTO 100
+   97 IF(IPA(2).EQ.14) GOTO 98
+      IPA(1)=IPIY2(1,I)
+      IPA(2)=IPIY2(2,I)
+      GOTO 100
+   98 IPA(1)=IPIY3(1,I)
+      IPA(2)=IPIY3(2,I)
+      GOTO 100
+   70 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      CALL STPAIR
+      IF(INT.EQ.1) CALL TWOB(13,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(13,NFL,N)
+      GO TO 9999
+C** NUCLEAR EXCITATION
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004) RS,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=13
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+  100 DO 101 I=3,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+  120 NT=2
+      IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      DO 132 I=1,NT
+      IF(IPA(I).NE.12) GOTO 132
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 132
+      IPA(I)=11
+  132 CONTINUE
+      GOTO 70
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASKM* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003  FORMAT(' *CASKM* KAON- -INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASKM* KAON- -INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION NOT FOUND',
+     $ ' TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASKM* TABLES FOR MULT. DATA KAON-  INDUCED REACTION',
+     $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASKM* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASKM* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASKM* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CASKP(K,INT,NFL)
+C
+C *** CASCADE OF K+ ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (13-SEP-1987)
+C
+C K+  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL(2,1200),ANORM(2,60),SUPP(10),CECH(10),B(2)
+      DIMENSION RNDM(1)
+      SAVE PMUL,ANORM
+      DATA SUPP/0.,0.4,0.55,0.65,0.75,0.82,0.86,0.90,0.94,0.98/
+      DATA CECH/0.33,0.27,0.29,0.31,0.27,0.18,0.13,0.10,0.09,0.07/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(5) ---
+      IF (KGINIT(5) .NE. 0) GO TO 10
+      KGINIT(5)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL(I,J)=0.0
+      IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR P AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      DO 1 NM1=NMM1,NP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+    1 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
+      IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+    4 CONTINUE
+C**  CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-RMASS(10)
+C
+C**  ELASTIC SCATTERING
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=10
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      IF(INT.EQ.2) GOTO 20
+C**  FOR K+ N REACTIONS CHANGE SOME OF THE ELASTIC CROSS SECTION
+C**  TO K+ N --> K0 P
+      IF(NFL.EQ.1) GOTO 100
+      IPLAB=IFIX(P   *5.)+1
+      IF(IPLAB.GT.10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 100
+      IPA(1)=11
+      IPA(2)=14
+      GOTO 100
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+  20  IF (EAB .LE. RMASS(7)) GOTO 55
+C**  SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM
+      IEAB=IFIX(EAB*5.)+1
+      IF(IEAB.GT.10) GOTO 22
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SUPP(IEAB)) GOTO 22
+      N=1.
+      GOTO (23,24),NFL
+ 23   CONTINUE
+      TEST=-(1+B(1))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      W0=EXP(TEST)
+      WP=EXP(TEST)
+      WP=WP*2.0
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF(RAN.LT.W0/(W0+WP)) GOTO 50
+      NP=1
+      NM=0
+      NZ=0
+      GOTO 50
+ 24   CONTINUE
+      TEST=-(1+B(2))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      W0=EXP(TEST)
+      WP=EXP(TEST)
+      TEST=-(-1+B(2))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      WM=EXP(TEST)
+      WT=W0+WP+WM
+      WP=W0+WP
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF(RAN.LT.W0/WT) GOTO 50
+      NP=1
+      NM=0
+      NZ=0
+      IF(RAN.LT.WP/WT) GOTO 50
+      NP=0
+      NM=1
+      NZ=0
+      GOTO 50
+C
+   22 ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (30,40),NFL
+C** FOR P AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      DO 31 NM1=NMM1,NP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 50
+   31 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 50
+   41 CONTINUE
+      GOTO 80
+   50 GOTO (60,65),NFL
+   60 IF(NP.EQ.1+NM) GOTO 61
+      IF(NP.EQ.2+NM) GOTO 63
+      IPA(1)=10
+      IPA(2)=14
+      GOTO 100
+   61 CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 62
+      IPA(1)=10
+      IPA(2)=16
+      GOTO 100
+   62 IPA(1)=11
+      IPA(2)=14
+      GOTO 100
+   63 IPA(1)=11
+      IPA(2)=16
+      GOTO 100
+   65 IF(NP.EQ.NM) GOTO 66
+      IF(NP.EQ.1+NM) GOTO 68
+      IPA(1)=10
+      IPA(2)=14
+      GOTO 100
+   66 CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.25) GOTO 67
+      IPA(1)=10
+      IPA(2)=16
+      GOTO 100
+   67 IPA(1)=11
+      IPA(2)=14
+      GOTO 100
+   68 IPA(1)=11
+      IPA(2)=16
+      GOTO 100
+   70 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      CALL STPAIR
+      IF(INT.EQ.1) CALL TWOB(10,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(10,NFL,N)
+      GO TO 9999
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004) RS,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=10
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+  100 DO 101 I=3,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+  120 NT=2
+      IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      DO 132 I=1,NT
+      IF(IPA(I).NE.11) GOTO 132
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 132
+      IPA(I)=12
+  132 CONTINUE
+      GOTO 70
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASKP* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003  FORMAT(' *CASKP* KAON+ -INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASKP* KAON+ -INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION NOT FOUND',
+     $ 'TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASKP* TABLES FOR MULT. DATA KAON+  INDUCED REACTION',
+     $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASKP* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASKP* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASKP* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CASK0(K,INT,NFL)
+C
+C *** CASCADE OF K0 ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (13-SEP-1987)
+C
+C K0  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL(2,1200),ANORM(2,60),SUPP(10),CECH(10),B(2)
+      DIMENSION RNDM(1)
+      SAVE PMUL,ANORM
+      DATA SUPP/0.,0.4,0.55,0.65,0.75,0.82,0.86,0.90,0.94,0.98/
+      DATA CECH/0.33,0.27,0.29,0.31,0.27,0.18,0.13,0.10,0.09,0.07/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(6) ---
+      IF (KGINIT(6) .NE. 0) GO TO 10
+      KGINIT(6)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL(I,J)=0.0
+      IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR P AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 1 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+    1 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      DO 2 NM1=NMM1,NP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
+      IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+    4 CONTINUE
+C**  CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-RMASS(11)
+C
+C**  ELASTIC SCATTERING
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=11
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      IF(INT.EQ.2) GOTO 20
+C**  FOR K0 P REACTIONS CHANGE SOME OF THE ELASTIC CROSS SECTION
+C**  TO K0 P --> K+ N
+      IF(NFL.EQ.2) GOTO 100
+      IPLAB=IFIX(P   *5.)+1
+      IF(IPLAB.GT.10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 100
+      IPA(1)=10
+      IPA(2)=16
+      GOTO 100
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+  20  IF (EAB .LE. RMASS(7)) GOTO 55
+C**  SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM
+      IEAB=IFIX(EAB*5.)+1
+      IF(IEAB.GT.10) GOTO 22
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SUPP(IEAB)) GOTO 22
+      N=1.
+      GOTO (24,23),NFL
+ 23   CONTINUE
+      TEST=-(1+B(1))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      W0=EXP(TEST)
+      TEST=-(-1+B(1))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      WM=EXP(TEST)
+      W0=W0/2.0
+      WM=WM*1.5
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF(RAN.LT.W0/(W0+WM)) GOTO 50
+      NP=0
+      NM=1
+      NZ=0
+      GOTO 50
+ 24   CONTINUE
+      TEST=-(1+B(2))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      W0=EXP(TEST)
+      WP=EXP(TEST)
+      TEST=-(-1+B(2))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      WM=EXP(TEST)
+      WT=W0+WP+WM
+      WP=W0+WP
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF(RAN.LT.W0/WT) GOTO 50
+      NP=1
+      NM=0
+      NZ=0
+      IF(RAN.LT.WP/WT) GOTO 50
+      NP=0
+      NM=1
+      NZ=0
+      GOTO 50
+C
+   22 ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (30,40),NFL
+C** FOR P AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 31 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 50
+   31 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      DO 41 NM1=NMM1,NP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 50
+   41 CONTINUE
+      GOTO 80
+   50 GOTO (65,60),NFL
+   60 IF(NP.EQ.1+NM) GOTO 61
+      IF(NP.EQ.2+NM) GOTO 63
+      IPA(1)=11
+      IPA(2)=16
+      GOTO 100
+   61 CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 62
+      IPA(1)=11
+      IPA(2)=14
+      GOTO 100
+   62 IPA(1)=10
+      IPA(2)=16
+      GOTO 100
+   63 IPA(1)=10
+      IPA(2)=14
+      GOTO 100
+   65 IF(NP.EQ.NM) GOTO 66
+      IF(NP.EQ.1+NM) GOTO 68
+      IPA(1)=11
+      IPA(2)=16
+      GOTO 100
+   66 CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.25) GOTO 67
+      IPA(1)=11
+      IPA(2)=14
+      GOTO 100
+   67 IPA(1)=10
+      IPA(2)=16
+      GOTO 100
+   68 IPA(1)=11
+      IPA(2)=16
+      GOTO 100
+   70 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      CALL STPAIR
+      IF(INT.EQ.1) CALL TWOB(11,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(11,NFL,N)
+      GO TO 9999
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004) RS,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=11
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+  100 DO 101 I=3,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+  120 NT=2
+      IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      DO 132 I=1,NT
+      IF(IPA(I).NE.11) GOTO 132
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 132
+      IPA(I)=12
+  132 CONTINUE
+      GOTO 70
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASK0* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003  FORMAT(' *CASK0* K0 -INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASK0* K0 -INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION NOT FOUND',
+     $ ' TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASK0* TABLES FOR MULT. DATA K0  INDUCED REACTION',
+     $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASK0* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASK0* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASK0* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CASK0B(K,INT,NFL)
+C
+C *** CASCADE OF ANTI K0 ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (13-SEP-1987)
+C
+C K0B UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL(2,1200),ANORM(2,60),CECH(10),CNK0(20),PIY1(4),
+     $          PIY2(3),IPIY1(2,4),IPIY2(2,3),IPIY3(2,3),B(2)
+      DIMENSION RNDM(1)
+      SAVE PMUL,ANORM
+      DATA CECH/1.,1.,1.,0.70,0.60,0.55,0.35,0.25,0.18,0.15/
+      DATA CNK0/0.17,0.18,0.17,0.24,0.26,0.20,0.22,0.21,0.34,0.45
+     $         ,0.58,0.55,0.36,0.29,0.29,0.32,0.32,0.33,0.33,0.33/
+      DATA PIY1/0.67,0.78,0.89,1.00/,PIY2/0.68,0.84,1.00/
+      DATA IPIY1/8,18,9,20,8,21,7,22/
+      DATA IPIY2/9,18,9,21,8,22/,IPIY3/7,18,8,20,7,21/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(7) ---
+      IF (KGINIT(7) .NE. 0) GO TO 10
+      KGINIT(7)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL(I,J)=0.0
+      IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR P AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      DO 1 NM1=NMM1,NP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+    1 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LT.1) NMM1=1
+      NPP1=NP1+1
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
+      IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+    4 CONTINUE
+C**  CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-ABS(RMASS(12))
+C
+C**  ELASTIC SCATTERING
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=12
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      IF(INT.EQ.2) GOTO 20
+      GOTO 100
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+   20 IPLAB=IFIX(P*5.)+1
+      IF(IPLAB.GT.10) GOTO 22
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.CECH(IPLAB)) GOTO 19
+      IF (EAB .LT. RMASS(7)) GOTO 55
+      GOTO 22
+C** CHARGE EXCHANGE REACTION (IS INCLUDED IN INELASTIC CROSS SECTION)
+   19 IPLAB=IFIX(P*10.)+1
+      IF(IPLAB.GT.20) IPLAB=20
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CNK0(IPLAB)) GOTO 24
+      IF(NFL.EQ.2) GOTO 23
+C** FOR K0B P REACTION NO K N STRANGENESS EXCHANGE POSSIBLE
+      INT=1
+      IPA(1)=12
+      IPA(2)=14
+      GOTO 100
+   23 INT=1
+      IPA(1)=13
+      IPA(2)=14
+      GOTO 100
+C** P L, P S REACTIONS
+   24 CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IF(RAN.LT.0.25) GOTO 25
+      IF(RAN.LT.0.50) GOTO 26
+      IF(RAN.LT.0.75) GOTO 27
+C** K0B P --> PI+ L OR K0B N --> PI0 L
+      IPA(1)=7
+      IF(NFL.EQ.2) IPA(1)=8
+      IPA(2)=18
+      GOTO 100
+C** K0B N --> PI- S+
+   25 IPA(1)=9
+      IPA(2)=20
+      IF(NFL.EQ.2) GOTO 100
+      IPA(1)=12
+      IPA(2)=14
+      GOTO 100
+C** K0B P --> PI+ S0  OR K0B N --> PI0 S0
+   26 IPA(1)=7
+      IF(NFL.EQ.2) IPA(1)=8
+      IPA(2)=21
+      GOTO 100
+C** K0B N --> PI+ S-
+   27 IPA(1)=7
+      IPA(2)=22
+      IF(NFL.EQ.2) GOTO 100
+      IPA(1)=12
+      IPA(2)=14
+      GOTO 100
+C
+   22 ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (30,40),NFL
+C** FOR P AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      DO 31 NM1=NMM1,NP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 50
+   31 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LT.1) NMM1=1
+      NPP1=NP1+1
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 50
+   41 CONTINUE
+      GOTO 80
+   50 GOTO (65,60),NFL
+   60 IF(NP.EQ.NM) GOTO 61
+      IF(NP.EQ.1+NM) GOTO 63
+      IPA(1)=12
+      IPA(2)=14
+      GOTO 90
+   61 CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.75) GOTO 62
+      IPA(1)=13
+      IPA(2)=14
+      GOTO 90
+   62 IPA(1)=13
+      IPA(2)=14
+      GOTO 90
+   63 IPA(1)=13
+      IPA(2)=16
+      GOTO 90
+   65 IF(NP.EQ.1+NM) GOTO 66
+      IF(NP.EQ.NM) GOTO 68
+      IPA(1)=13
+      IPA(2)=16
+      GOTO 90
+   66 CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.50) GOTO 67
+      IPA(1)=12
+      IPA(2)=16
+      GOTO 90
+   67 IPA(1)=13
+      IPA(2)=14
+      GOTO 90
+   68 IPA(1)=12
+      IPA(2)=14
+C**  PI Y PRODUCTION INSTEAD OF K N
+   90 CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 100
+      IF(IPA(1).EQ.13.AND.IPA(2).EQ.16) GOTO 95
+      IF(IPA(1).EQ.11.AND.IPA(2).EQ.14) GOTO 95
+      IF(IPA(1).EQ.12.AND.IPA(2).EQ.14) GOTO 95
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      DO 91 I=1,4
+      IF(RAN.LT.PIY1(I)) GOTO 92
+   91 CONTINUE
+      GOTO 100
+   92 IPA(1)=IPIY1(1,I)
+      IPA(2)=IPIY1(2,I)
+      GOTO 100
+   95 CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      DO 96 I=1,3
+      IF(RAN.LT.PIY2(I)) GOTO 97
+   96 CONTINUE
+      GOTO 100
+   97 IF(IPA(2).EQ.14) GOTO 98
+      IPA(1)=IPIY2(1,I)
+      IPA(2)=IPIY2(2,I)
+      GOTO 100
+   98 IPA(1)=IPIY3(1,I)
+      IPA(2)=IPIY3(2,I)
+      GOTO 100
+   70 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      CALL STPAIR
+      IF(INT.EQ.1) CALL TWOB(12,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(12,NFL,N)
+      GO TO 9999
+C** NUCLEAR EXCITATION
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004) RS,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=12
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+  100 DO 101 I=3,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+  120 NT=2
+      IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      DO 132 I=1,NT
+      IF(IPA(I).NE.12) GOTO 132
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 132
+      IPA(I)=11
+  132 CONTINUE
+      GOTO 70
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASK0B* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003  FORMAT(' *CASK0B* K0B -INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASK0B* K0B -INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION NOT FOUND',
+     $ ' TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASK0B* TABLES FOR MULT. DATA K0B  INDUCED REACTION',
+     $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASK0B* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASK0B* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASK0B* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CASL0(K,INT,NFL)
+C
+C *** CASCADE OF LAMBDA ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (13-SEP-1987)
+C
+C L0  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL(2,1200),ANORM(2,60),CECH(10),IIPA(10,2),B(2)
+      DIMENSION RNDM(2)
+      SAVE PMUL,ANORM
+      DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
+      DATA IIPA/20,21,14,14,16,21,22,16,16,14,
+     *          16,14,18,21,20,16,14,18,21,22/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(8) ---
+      IF (KGINIT(8) .NE. 0) GO TO 10
+      KGINIT(8)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL(I,J)=0.0
+      IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR N AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.0) NMM1=1
+      NPP1=NP1+2
+      DO 1 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+    1 CONTINUE
+C** FOR P AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
+      IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+    4 CONTINUE
+C**  CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-RMASS(18)
+C**  ELASTIC SCATTERING
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=18
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      IF(INT.EQ.2) GOTO 20
+C** INTRODUCE CHARGE AND STRANGENESS EXCHANGE REACTIONS
+C** LP --> S+N, LP --> S0 P , LN --> S0 N , LN --> S- P
+C** LP --> P L, LP --> P S0 , LP --> N S+
+C** LN --> N L, LN --> N S0 , LN --> P S-
+      IPLAB=IFIX(P*2.5)+1
+      IF(IPLAB.GT.10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 120
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IRN=IFIX(RAN/0.2)+1
+      IF(IRN.GT.5) IRN=5
+      IRN=IRN+(NFL-1)*5
+      IPA(1)=IIPA(IRN,1)
+      IPA(2)=IIPA(IRN,2)
+      GOTO 120
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+  20  IF (EAB .LE. RMASS(7)) GOTO 55
+      ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-MP-MSM
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (40,30),NFL
+C** FOR N AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.0) NMM1=1
+      NPP1=NP1+2
+      DO 31 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   31 CONTINUE
+      GOTO 80
+C** FOR P AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   41 CONTINUE
+      GOTO 80
+   50 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      IF(INT.EQ.1) CALL TWOB(18,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(18,NFL,N)
+      GO TO 9999
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004) RS,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+      IPA(1)=18
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      GOTO 120
+  100 DO 101 I=1,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+      GOTO (112,102),NFL
+  102 NCHT=NP-NM
+      NCHT=NCHT+3
+      IF(NCHT.LE.0) NCHT=1
+      IF(NCHT.GT.4) NCHT=4
+      GOTO (103,104,105,106),NCHT
+  103 IPA(1)=20
+      IPA(2)=14
+      GOTO 120
+  104 IPA(1)=18
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) IPA(1)=21
+      IPA(2)=14
+      IF(RNDM(2).LT.0.5) GOTO 120
+      IPA(1)=20
+      IPA(2)=16
+      GOTO 120
+  105 IPA(1)=18
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) IPA(1)=21
+      IPA(2)=16
+      IF(RNDM(2).LT.0.5) GOTO 120
+      IPA(1)=22
+      IPA(2)=14
+      GOTO 120
+  106 IPA(1)=22
+      IPA(2)=16
+      GOTO 120
+  112 NCHT=NP-NM
+      NCHT=NCHT+2
+      IF(NCHT.LE.0) NCHT=1
+      IF(NCHT.GT.4) NCHT=4
+      GOTO (113,114,115,116),NCHT
+  113 IPA(1)=20
+      IPA(2)=14
+      GOTO 120
+  114 IPA(1)=18
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) IPA(1)=21
+      IPA(2)=14
+      IF(RNDM(2).LT.0.5) GOTO 120
+      IPA(1)=20
+      IPA(2)=16
+      GOTO 120
+  115 IPA(1)=18
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) IPA(1)=21
+      IPA(2)=16
+      IF(RNDM(2).LT.0.5) GOTO 120
+      IPA(1)=22
+      IPA(2)=14
+      GOTO 120
+  116 IPA(1)=22
+      IPA(2)=16
+  120 NT=2
+      IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      GOTO 50
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASL0* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003  FORMAT(' *CASL0* LAMBDA-INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASL0* LAMBDA-INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION NOT FOUND',
+     $ ' TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASL0* TABLES FOR MULT. DATA LAMBDA INDUCED REACTION',
+     $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASL0* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASL0* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASL0* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CASN(K,INT,NFL)
+C
+C *** CASCADE OF NEUTRON ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (13-SEP-1987)
+C
+C N  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C
+      REAL N
+      DIMENSION PMUL(2,1200),ANORM(2,60),SUPP(10),CECH(10),B(2)
+      DIMENSION RNDM(1)
+      SAVE PMUL,ANORM
+      DATA SUPP/0.,0.4,0.55,0.65,0.75,0.82,0.86,0.90,0.94,0.98/
+      DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
+      DATA B/0.35,0.0/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(17) ---
+      IF (KGINIT(17) .NE. 0) GO TO 10
+      KGINIT(17)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL(I,J)=0.0
+      IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR N AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NPP1=NP1+2
+      DO 1 NM1=NP1,NPP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NPROT= -NP+NM
+      NNEUT=2-NPROT
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      NPROTF=NFAC(NPROT)
+      NNEUTF=NFAC(NNEUT)
+      PMUL(1,L)=PMUL(1,L)/(NPROTF*NNEUTF)
+      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+    1 CONTINUE
+C** FOR P AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NPROT=1-NP+NM
+      NNEUT=2-NPROT
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      NPROTF=NFAC(NPROT)
+      NNEUTF=NFAC(NNEUT)
+      PMUL(2,L)=PMUL(2,L)/(NPROTF*NNEUTF)
+      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
+      IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+    4 CONTINUE
+C**  CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-RMASS(16)
+C**  ELASTIC SCATTERING
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      NCECH=0
+      IF(INT.EQ.2) GOTO 20
+C** INTRODUCE CHARGE EXCHANGE REACTION PN --> NP
+      IF(NFL.EQ.2) GOTO 100
+      IPLAB=IFIX(P*2.5)+1
+      IF(IPLAB.GT.10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 100
+      NCECH=1
+      GOTO 100
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+  20  IF (EAB .LE. RMASS(7)) GOTO 55
+C**  SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM
+      IEAB=IFIX(EAB*5.)+1
+      IF(IEAB.GT.10) GOTO 22
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SUPP(IEAB)) GOTO 22
+      N=1.
+      GOTO (24,23),NFL
+ 23   CONTINUE
+      TEST=-(1+B(2))**2/(2.0*C**2)
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      W0=EXP(TEST)/2.0
+      WM=EXP(TEST)
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF(RAN.LT.W0/(W0+WM)) GOTO 100
+      NP=0
+      NM=1
+      NZ=0
+      GOTO 100
+ 24   CONTINUE
+      TEST=-(1+B(1))**2/(2.0*C**2)
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      W0=EXP(TEST)
+      WP=EXP(TEST)/2.0
+      TEST=-(-1+B(1))**2/(2.0*C**2)
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      WM=EXP(TEST)/2.0
+      WT=W0+WP+WM
+      WP=W0+WP
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF(RAN.LT.W0/WT) GOTO 100
+      NP=1
+      NM=0
+      NZ=0
+      IF(RAN.LT.WP/WT) GOTO 100
+      NP=0
+      NM=1
+      NZ=0
+      GOTO 100
+C
+   22 ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      ANPN=ANPN+PI*NT*EXP(TEST)/(2.0*N*N)
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (40,30),NFL
+C** FOR N AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NPP1=NP1+2
+      DO 31 NM1=NP1,NPP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   31 CONTINUE
+      GOTO 80
+C** FOR P AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   41 CONTINUE
+      GOTO 80
+   50 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      CALL STPAIR
+      IF(INT.EQ.1) CALL TWOB(16,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(16,NFL,N)
+      GO TO 9999
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004) RS,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+  100 DO 101 I=1,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+      NPROT=1-NP+NM+(1-NFL)
+      NNEUT=2-NPROT
+      GOTO (112,102),NFL
+  102 GOTO (103,104),INT
+  103 IPA(1)=16
+      IPA(2)=16
+      NT=2
+      GOTO 130
+  104 IF(NNEUT.EQ.1) GOTO 105
+      IF(NNEUT.EQ.2) GOTO 106
+      IPA(1)=14
+      IPA(2)=14
+      GOTO 120
+  105 IPA(1)=14
+      IPA(2)=16
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 120
+      IPA(1)=16
+      IPA(2)=14
+      GOTO 120
+  106 IPA(1)=16
+      IPA(2)=16
+      GOTO 120
+  112 GOTO (113,114),INT
+  113 IPA(1)=16
+      IPA(2)=14
+      NT=2
+      IF(NCECH.EQ.0) GOTO 130
+      IPA(1)=14
+      IPA(2)=16
+      GOTO 130
+  114 IF(NNEUT.EQ.1) GOTO 115
+      IF(NNEUT.EQ.2) GOTO 116
+      IPA(1)=14
+      IPA(2)=14
+      GOTO 120
+  115 IPA(1)=14
+      IPA(2)=16
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.33) GOTO 120
+      IPA(1)=16
+      IPA(2)=14
+      GOTO 120
+  116 IPA(1)=16
+      IPA(2)=16
+  120 NT=2
+      IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      GOTO 50
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASN* CASCADE ENERGETICALLY NOT POSSIBLE NUCLEAR',
+     * ' EXCITATION',2X,F8.4,2X,'INCIDENT ENERGY LOST')
+1003  FORMAT(' *CASN* NEUTRON-INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASN* NEUTRON-INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION NOT FOUND',
+     $ ' TRY ELASTIC SCATTERING',/,'    AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASN* TABLES FOR MULT. DATA NEUTRON INDUCED REACTION',
+     $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASN* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASN* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASN* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CASNB(K,INT,NFL)
+C
+C *** CASCADE OF ANTI NEUTRON ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (13-SEP-1987)
+C
+C NB  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL1(2,1200),PMUL2(2,400),ANORM1(2,60),ANORM2(2,60),
+     *          SUPP(10),CECH(10),ANHL(25),B(2)
+      DIMENSION RNDM(1)
+      SAVE PMUL1,ANORM1,PMUL2,ANORM2
+      DATA SUPP/0.,0.4,0.55,0.65,0.75,0.82,0.86,0.90,0.94,0.98/
+      DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
+      DATA ANHL/1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,0.97,0.88
+     *         ,0.85,0.81,0.75,0.64,0.64,0.55,0.55,0.45,0.47,0.40
+     *         ,0.39,0.36,0.33,0.10,0.01/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(9) ---
+      IF (KGINIT(9) .NE. 0) GO TO 10
+      KGINIT(9)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL1(I,J)=0.0
+      IF (J .LE. 400) PMUL2(I,J)=0.0
+      IF (J .LE. 60) ANORM1(I,J)=0.0
+      IF (J .LE. 60) ANORM2(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR P AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      DO 1 NM1=NMM1,NP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL1(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM1(1,NT)=ANORM1(1,NT)+PMUL1(1,L)
+    1 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LT.1) NMM1=1
+      NPP1=NP1+1
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL1(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM1(2,NT)=ANORM1(2,NT)+PMUL1(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM1(1,I).GT.0.) ANORM1(1,I)=1./ANORM1(1,I)
+      IF(ANORM1(2,I).GT.0.) ANORM1(2,I)=1./ANORM1(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 9
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM1(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL1(NFL,I),I=1,1200)
+    4 CONTINUE
+C** DO THE SAME FOR ANNIHILATION CHANNELS
+C** FOR P AS TARGET
+C
+    9 L=0
+      DO 5 NP1=2,20
+      NP=NP1-1
+      NM=NP-1
+      DO 5 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 5
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 5
+      PMUL2(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM2(1,NT)=ANORM2(1,NT)+PMUL2(1,L)
+    5 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 6 NP1=1,20
+      NP=NP1-1
+      NM=NP
+      DO 6 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 6
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 6
+      PMUL2(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM2(2,NT)=ANORM2(2,NT)+PMUL2(2,L)
+    6 CONTINUE
+      DO 7 I=1,60
+      IF(ANORM2(1,I).GT.0.) ANORM2(1,I)=1./ANORM2(1,I)
+      IF(ANORM2(2,I).GT.0.) ANORM2(2,I)=1./ANORM2(2,I)
+    7 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,3001)
+      DO 8 NFL=1,2
+      WRITE(NEWBCD,3002) NFL
+      WRITE(NEWBCD,3003) (ANORM2(NFL,I),I=1,60)
+      WRITE(NEWBCD,3003) (PMUL2(NFL,I),I=1,400)
+    8 CONTINUE
+C** CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-ABS(RMASS(17))
+C**  ELASTIC SCATTERING
+      NCECH=0
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IF(INT.EQ.2) GOTO 20
+C** INTRODUCE CHARGE EXCHANGE REACTION NB N --> PB P
+      IF(NFL.EQ.1) GOTO 100
+      IPLAB=IFIX(P*2.5)+1
+      IF(IPLAB.GT.10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.75) GOTO 100
+      NCECH=1
+      GOTO 100
+C** ANNIHILATION CHANNELS
+   20 IPLAB=IFIX(P*10.)+1
+      IF(IPLAB.GT.10) IPLAB=IFIX((P-1.)*5.)+11
+      IF(IPLAB.GT.15) IPLAB=IFIX( P-2.    )+16
+      IF(IPLAB.GT.23) IPLAB=IFIX((P-10.)/10.)+24
+      IF(IPLAB.GT.25) IPLAB=25
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.ANHL(IPLAB)) GOTO 19
+      EAB=RS
+      IF (EAB .LE. 2.0*RMASS(7)) GOTO 55
+      GOTO 222
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+   19 IF (EAB .LE. RMASS(7)) GOTO 55
+C**  SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM
+      IEAB=IFIX(EAB*5.)+1
+      IF(IEAB.GT.10) GOTO 22
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SUPP(IEAB)) GOTO 22
+      N=1.
+      GOTO (23,24),NFL
+ 23   CONTINUE
+      TEST=-(1+B(1))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      W0=EXP(TEST)
+      WP=EXP(TEST)
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF(RAN.LT.W0/(W0+WP)) GOTO 100
+      NP=1
+      NM=0
+      NZ=0
+      GOTO 100
+ 24   CONTINUE
+      TEST=-(1+B(2))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      W0=EXP(TEST)
+      WP=EXP(TEST)
+      TEST=-(-1+B(2))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      WM=EXP(TEST)
+      WT=W0+WP+WM
+      WP=W0+WP
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF(RAN.LT.W0/WT) GOTO 100
+      NP=1
+      NM=0
+      NZ=0
+      IF(RAN.LT.WP/WT) GOTO 100
+      NP=0
+      NM=1
+      NZ=0
+      GOTO 100
+C
+   22 ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (30,40),NFL
+C** FOR P AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      DO 31 NM1=NMM1,NP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL1(1,L)*ANORM1(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   31 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LT.1) NMM1=1
+      NPP1=NP1+1
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL1(2,L)*ANORM1(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   41 CONTINUE
+      GOTO 80
+C** ANNIHILATION CHANNELS
+  222 IPA(1)=0
+      IPA(2)=0
+      ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 221 NT=2,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+  221 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (230,240),NFL
+C** FOR P AS TARGET
+  230 L=0
+      DO 231 NP1=2,20
+      NP=NP1-1
+      NM=NP-1
+      DO 231 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 231
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 231
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL2(1,L)*ANORM2(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 120
+  231 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+  240 L=0
+      DO 241 NP1=1,20
+      NP=NP1-1
+      NM=NP
+      DO 241 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 241
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 241
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL2(2,L)*ANORM2(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 120
+  241 CONTINUE
+      GOTO 80
+   50 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      CALL STPAIR
+      IF(INT.EQ.1) CALL TWOB(17,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(17,NFL,N)
+      GO TO 9999
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND,ASSUME ELASTIC SCATTERING
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004) RS,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+  100 DO 101 I=1,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+      GOTO (102,112),NFL
+  102 GOTO (103,104),INT
+  103 IPA(1)=17
+      IPA(2)=14
+      NT=2
+      GOTO 130
+  104 IF(NP.EQ.1+NM) GOTO 105
+      IF(NP.EQ.2+NM) GOTO 106
+      IPA(1)=17
+      IPA(2)=14
+      GOTO 120
+  105 IPA(1)=15
+      IPA(2)=14
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 120
+      IPA(1)=17
+      IPA(2)=16
+      GOTO 120
+  106 IPA(1)=15
+      IPA(2)=16
+      GOTO 120
+  112 GOTO (113,114),INT
+  113 IPA(1)=17
+      IPA(2)=16
+      NT=2
+      IF(NCECH.EQ.0) GOTO 130
+      IPA(1)=15
+      IPA(2)=14
+      GOTO 130
+  114 IF(NP.EQ.  NM) GOTO 115
+      IF(NP.EQ.1+NM) GOTO 116
+      IPA(1)=17
+      IPA(2)=14
+      GOTO 120
+  115 IPA(1)=15
+      IPA(2)=14
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.33) GOTO 120
+      IPA(1)=17
+      IPA(2)=16
+      GOTO 120
+  116 IPA(1)=15
+      IPA(2)=16
+  120 NT=2
+      IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      GOTO 50
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASNB* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI- ELASTIC SCATTERING')
+1003  FORMAT(' *CASNB* ANTINEUTRON-INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASNB* ANTINEUTRON-INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION',
+     $ ' NOT FOUND  TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASNB* TABLES FOR MULT. DATA ANTINEUTRON INDUCED ',
+     * 'REACTION  FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASNB* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASNB* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASNB* NO PARTICLES PRODUCED')
+3001  FORMAT(' *CASNB* TABLES FOR MULT. DATA ANTIPROTON INDUCED ',
+     $ 'ANNIHILATION REACTION  FOR DEFINITION OF NUMBERS SEE FORTRAN',
+     $ ' CODING')
+3002  FORMAT(' *CASNB* TARGET PARTICLE FLAG',2X,I5)
+3003  FORMAT(1H ,10E12.4)
+C
+ 9999 CONTINUE
+      RETURN
+      END
+      SUBROUTINE CASOM(K,INT,NFL)
+C
+C *** CASCADE OF OMEGA- ***
+C *** NVE 31-JAN-1989 CERN GENEVA ***
+C
+C OMEGA- UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT, ASSUME NUCLEAR EXCITATION OCCURS, DEGRADE INPUT PARTICLE
+C IN ENERGY AND NO OTHER PARTICLES ARE PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL(2,1200),ANORM(2,60),CECH(10),IIPA(14,2),B(2)
+      DIMENSION RNDM(1)
+      SAVE PMUL,ANORM
+      DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
+C --- ARRAY IIPA DENOTES THE STRANGENESS AND CHARGE EXCHAGE REACTIONS ---
+C OM- P --> XI0 S0,  OM- P --> S0 XI0
+C OM- P --> XI0 L0,  OM- P --> L0 XI0
+C OM- P --> XI- S+,  OM- P --> S+ XI-
+C XI- P --> P OM-
+C OM- N --> XI0 S-,  OM- N --> S- XI0
+C OM- N --> XI- L0,  OM- N --> L0 XI-
+C OM- N --> XI- S0,  OM- N --> S0 XI-
+C OM- N --> N OM-
+      DATA IIPA/26,21,26,18,27,20,14, 26,22,27,18,27,21,16,
+     $          21,26,18,26,20,27,33, 22,26,18,27,21,27,33/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(21) ---
+      IF (KGINIT(21) .NE. 0) GO TO 10
+      KGINIT(21)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL(I,J)=0.0
+      IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C *** COMPUTE NORMALIZATION CONSTANTS ***
+C
+C --- FOR P TARGET ---
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF (NMM1 .LE. 0) NMM1=1
+      NPP1=NP1+1
+      DO 1 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 1
+      NT=NP+NM+NZ
+      IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 1
+      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+ 1    CONTINUE
+C --- FOR N TARGET ---
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1
+      NPP1=NP1+2
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 2
+      NT=NP+NM+NZ
+      IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 2
+      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+ 2    CONTINUE
+C
+      DO 3 I=1,60
+      IF (ANORM(1,I) .GT. 0.) ANORM(1,I)=1./ANORM(1,I)
+      IF (ANORM(2,I) .GT. 0.) ANORM(2,I)=1./ANORM(2,I)
+ 3    CONTINUE
+C
+      IF (.NOT. NPRT(10)) GO TO 10
+C
+      WRITE(NEWBCD,2001)
+ 2001 FORMAT(' *CASOM* TABLES FOR MULT. DATA OM- INDUCED REACTION',
+     $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+ 2002 FORMAT(' *CASOM* TARGET PARTICLE FLAG',2X,I5)
+      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+ 2003 FORMAT(1H ,10E12.4)
+ 4    CONTINUE
+C
+C --- SELECT TARGET NUCLEON ---
+ 10   CONTINUE
+      NFL=2
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .LT. (ZNO2/ATNO2)) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-RMASS(33)
+C
+C --- RESET STRANGENESS FIXING FLAG ---
+      NVEFIX=0
+C
+C *** ELASTIC SCATTERING ***
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=33
+      IPA(2)=14
+      IF (NFL .EQ. 2) IPA(2)=16
+C
+      IF (INT .EQ. 2) GO TO 20
+C
+C *** INTRODUCE CHARGE AND STRANGENESS EXCHANGE REACTIONS ***
+      IPLAB=IFIX(P*2.5)+1
+      IF (IPLAB .GT. 10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .GT. (CECH(IPLAB)/ATNO2**0.42)) GO TO 120
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IRN=IFIX(RAN*7.)+1
+      IF (NFL .EQ. 2) IRN=7+IFIX(RAN*7.)+1
+      IF (NFL .EQ. 1) IRN=MAX(IRN,7)
+      IF (NFL .EQ. 2) IRN=MAX(IRN,14)
+      IPA(1)=IIPA(IRN,1)
+      IPA(2)=IIPA(IRN,2)
+      GO TO 120
+C
+C --- CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION ---
+ 20   CONTINUE
+      IF (EAB .LE. RMASS(7)) GO TO 55
+C
+C --- NO. OF TOTAL PARTICLES VS SQRT(S)-MP-MSM ---
+      ALEAB=LOG(EAB)
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C
+C --- NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION ---
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+ 21   CONTINUE
+      ANPN=1./ANPN
+C
+C --- CHECK FOR TARGET NUCLEON TYPE ---
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GO TO (30,40),NFL
+C
+C --- PROTON TARGET ---
+ 30   CONTINUE
+      L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF (NMM1 .LE. 0) NMM1=1
+      NPP1=NP1+1
+      DO 31 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 31
+      NT=NP+NM+NZ
+      IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF (RAN .LT. EXCS) GO TO 100
+   31 CONTINUE
+      GO TO 80
+C
+C --- NEUTRON TARGET ---
+ 40   CONTINUE
+      L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1
+      NPP1=NP1+2
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 41
+      NT=NP+NM+NZ
+      IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF (RAN .LT. EXCS) GO TO 100
+   41 CONTINUE
+      GO TO 80
+C
+ 50   CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+ 1003 FORMAT(' *CASOM* OM- -INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,
+     $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+      IF (INT .EQ. 1) CALL TWOB(33,NFL,N)
+      IF (INT .EQ. 2) CALL GENXPT(33,NFL,N)
+      GO TO 9999
+C
+C *** ENERGETICALLY NOT POSSIBLE TO PRODUCE ONE EXTRA PION ***
+ 55   CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,1001)
+ 1001 FORMAT(' *CASOM* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+      GO TO 53
+C
+C *** EXCLUSIVE REACTION NOT FOUND ***
+ 80   CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,1004) RS,N
+ 1004 FORMAT(' *CASOM* OM- -INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION NOT FOUND',
+     $ ' TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,2X,
+     $ '<NTOT>',2X,F8.4)
+C
+ 53   CONTINUE
+      INT=1
+      NP=0
+      NM=0
+      NZ=0
+      IPA(1)=33
+      IPA(2)=14
+      IF (NFL .EQ. 2) IPA(2)=16
+      GO TO 120
+C
+C *** INELASTIC INTERACTION HAS OCCURRED ***
+C *** NUMBER OF SECONDARY MESONS DETERMINED BY KNO DISTRIBUTION ***
+ 100  CONTINUE
+      DO 101 I=1,60
+      IPA(I)=0
+ 101  CONTINUE
+C
+      IF (INT .LE. 0) GO TO 131
+C
+C --- TAKE TARGET NUCLEON TYPE INTO ACCOUNT ---
+      GO TO (102,112),NFL
+C
+C --- PROTON TARGET ---
+ 102  CONTINUE
+C --- CHECK FOR TOTAL CHARGE OF FINAL STATE MESONS TO DETERMINE ---
+C --- THE KIND OF BARYONS TO BE PRODUCED TAKING INTO ACCOUNT    ---
+C --- CHARGE AND STRANGENESS CONSERVATION                       ---
+      NCHT=NP-NM
+      IF (NCHT .LT. 0) GO TO 103
+      IF (NCHT .EQ. 0) GO TO 104
+      IF (NCHT .GT. 0) GO TO 105
+C
+ 103  CONTINUE
+C --- STRANGENESS MISMATCH ==> TAKE A XI0 AND CORRECT THE STRANGENESS ---
+C --- BY REPLACING A PI- BY K- ---
+C --- XI0 P ---
+      IPA(1)=26
+      IPA(2)=14
+      NVEFIX=1
+      IF (NCHT .EQ. -1) GO TO 120
+C --- CHARGE MISMATCH ==> TAKE A S+ AND CORRECT THE STRANGENESS ---
+C --- BY REPLACING 2 PI- BY K- ---
+C --- S+ P ---
+      IPA(1)=20
+      IPA(2)=14
+      NVEFIX=2
+      GO TO 120
+C
+ 104  CONTINUE
+C --- OM- P ---
+      IPA(1)=33
+      IPA(2)=14
+C
+ 105  CONTINUE
+C --- OM- N ---
+      IPA(1)=33
+      IPA(2)=16
+      GO TO 120
+C
+C --- NEUTRON TARGET ---
+ 112  CONTINUE
+C --- CHECK FOR TOTAL CHARGE OF FINAL STATE MESONS TO DETERMINE ---
+C --- THE KIND OF BARYONS TO BE PRODUCED TAKING INTO ACCOUNT    ---
+C --- CHARGE AND STRANGENESS CONSERVATION                       ---
+      NCHT=NP-NM
+      IF (NCHT .LT. -1) GO TO 113
+      IF (NCHT .EQ. -1) GO TO 114
+      IF (NCHT .GT. -1) GO TO 115
+C
+ 113  CONTINUE
+C --- STRANGENESS MISMATCH ==> TAKE A XI0 AND CORRECT THE STRANGENESS ---
+C --- BY REPLACING A PI- BY K- ---
+C --- XI0 P ---
+      IPA(1)=26
+      IPA(2)=14
+      NVEFIX=1
+      IF (NCHT .EQ. -2) GO TO 120
+C --- CHARGE MISMATCH ==> TAKE A S+ AND CORRECT THE STRANGENESS ---
+C --- BY REPLACING 2 PI- BY K- ---
+C --- S+ P ---
+      IPA(1)=20
+      IPA(2)=14
+      NVEFIX=2
+      GO TO 120
+C
+ 114  CONTINUE
+C --- OM- P ---
+      IPA(1)=33
+      IPA(2)=14
+      GO TO 120
+C
+ 115  CONTINUE
+C --- OM- N ---
+      IPA(1)=33
+      IPA(2)=16
+C
+C --- TAKE PIONS FOR ALL SECONDARY MESONS ---
+ 120  CONTINUE
+      NT=2
+C
+      IF (NP .EQ. 0) GO TO 122
+C
+C --- PI+ ---
+      DO 121 I=1,NP
+      NT=NT+1
+      IPA(NT)=7
+ 121  CONTINUE
+C
+ 122  CONTINUE
+      IF (NM .EQ. 0) GO TO 124
+C
+C --- PI- ---
+      DO 123 I=1,NM
+      NT=NT+1
+      IPA(NT)=9
+      IF (NVEFIX .GE. 1) IPA(NT)=13
+      IF (NPRT(4) .AND. (NVEFIX .GE. 1)) PRINT 3000
+ 3000 FORMAT(' *CASOM* K- INTRODUCED')
+      NVEFIX=NVEFIX-1
+ 123  CONTINUE
+C
+ 124  CONTINUE
+      IF (NZ .EQ. 0) GO TO 130
+C
+C --- PI0 ---
+      DO 125 I=1,NZ
+      NT=NT+1
+      IPA(NT)=8
+ 125  CONTINUE
+C
+C --- ALL SECONDARY PARTICLES HAVE BEEN DEFINED ---
+C --- NOW GO FOR MOMENTA AND X VALUES ---
+ 130  CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,2004) NT,(IPA(I),I=1,60)
+ 2004 FORMAT(' *CASOM* ',I3,' PARTICLES PRODUCED. MASS INDEX ARRAY : '/
+     $ 3(1H ,20(I3,1X)/))
+      GO TO 50
+C
+ 131  CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,2005)
+ 2005 FORMAT(' *CASOM* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+      END
+*-- AUTHOR :
+      SUBROUTINE CASSM(K,INT,NFL)
+C
+C *** CASCADE OF SIGMA- ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (13-SEP-1987)
+C
+C S-  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL(2,1200),ANORM(2,60),CECH(10),IIPA(10,2),B(2)
+      DIMENSION RNDM(2)
+      SAVE PMUL,ANORM
+      DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
+      DATA IIPA/21,18,14,16,16,16,16,16,16,16,
+     *          16,16,22,21,18,22,22,22,22,22/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(12) ---
+      IF (KGINIT(12) .NE. 0) GO TO 10
+      KGINIT(12)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL(I,J)=0.0
+      IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR P AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.0) NMM1=1
+      NPP1=NP1+1
+      DO 1 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+    1 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1
+      NPP1=NP1+2
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
+      IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+    4 CONTINUE
+C**  CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-RMASS(22)
+C**  ELASTIC SCATTERING
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=22
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      IF(INT.EQ.2) GOTO 20
+C** INTRODUCE CHARGE AND STRANGENESS EXCHANGE REACTIONS
+C** S-P --> S0N, S-P --> L N  ,
+C** S-P --> PS-, S-P --> N S0 , S-P --> N L
+C** S-N --> NS-,
+      IPLAB=IFIX(P*2.5)+1
+      IF(IPLAB.GT.10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 120
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IRN=IFIX(RAN/0.2)+1
+      IF(IRN.GT.5) IRN=5
+      IRN=IRN+(NFL-1)*5
+      IPA(1)=IIPA(IRN,1)
+      IPA(2)=IIPA(IRN,2)
+      GOTO 120
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+  20  IF (EAB .LE. RMASS(7)) GOTO 55
+      ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-MP-MSM
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (30,40),NFL
+C** FOR P AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.0) NMM1=1
+      NPP1=NP1+1
+      DO 31 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   31 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1
+      NPP1=NP1+2
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   41 CONTINUE
+      GOTO 80
+   50 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      IF(INT.EQ.1) CALL TWOB(22,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(22,NFL,N)
+      GO TO 9999
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004) RS,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+      IPA(1)=22
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      GOTO 120
+  100 DO 101 I=1,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+      GOTO (102,112),NFL
+  102 NCHT=NP-NM
+      NCHT=NCHT+2
+      IF(NCHT.LE.0) NCHT=1
+      IF(NCHT.GT.3) NCHT=3
+      GOTO (103,104,105),NCHT
+  103 IPA(1)=21
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) IPA(1)=18
+      IPA(2)=14
+      GOTO 120
+  104 IPA(1)=22
+      IPA(2)=14
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) GOTO 120
+      IPA(1)=21
+      IF(RNDM(2).LT.0.5) IPA(1)=18
+      IPA(2)=16
+      GOTO 120
+  105 IPA(1)=22
+      IPA(2)=16
+      GOTO 120
+  112 NCHT=NP-NM
+      NCHT=NCHT+3
+      IF(NCHT.LE.0) NCHT=1
+      IF(NCHT.GT.3) NCHT=3
+      GOTO (113,114,115),NCHT
+  113 IPA(1)=21
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) IPA(1)=18
+      IPA(2)=14
+      GOTO 120
+  114 IPA(1)=21
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) IPA(1)=18
+      IPA(2)=16
+      IF(RNDM(2).LT.0.5) GOTO 120
+      IPA(1)=22
+      IPA(2)=14
+      GOTO 120
+  115 IPA(1)=22
+      IPA(2)=16
+  120 NT=2
+      IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      GOTO 50
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASSM* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003  FORMAT(' *CASSM* SIGMA- -INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASSM* SIGMA- -INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION NOT FOUND',
+     $ ' TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASSM* TABLES FOR MULT. DATA SIGMA- INDUCED REACTION',
+     $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASSM* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASSM* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASSM* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CASSP(K,INT,NFL)
+C
+C *** CASCADE OF SIGMA+ ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (30-NOV-1987)
+C
+C S+  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL(2,1200),ANORM(2,60),CECH(10),IIPA(10,2),B(2)
+      DIMENSION RNDM(2)
+      SAVE PMUL,ANORM
+      DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
+      DATA IIPA/14,14,14,14,14,21,18,16,14,14,
+     *          20,20,20,20,20,14,14,20,21,18/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(13) ---
+      IF (KGINIT(13) .NE. 0) GO TO 10
+      KGINIT(13)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL(I,J)=0.0
+      IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR P AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1
+      IF(NMM1.LE.0) NMM1=1
+      NPP1=NP1+2
+      DO 1 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+    1 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
+      IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+    4 CONTINUE
+C**  CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-RMASS(20)
+C**  ELASTIC SCATTERING
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=20
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      IF(INT.EQ.2) GOTO 20
+C** INTRODUCE CHARGE AND STRANGENESS EXCHANGE REACTIONS
+C**                             S+N --> S0 P ,S+N --> L P,
+C** S+P --> PS+,
+C** S+N --> NS+, S+N --> P S0 , S+N --> P L
+      IPLAB=IFIX(P*2.5)+1
+      IF(IPLAB.GT.10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 120
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IRN=IFIX(RAN/0.2)+1
+      IF(IRN.GT.5) IRN=5
+      IRN=IRN+(NFL-1)*5
+      IPA(1)=IIPA(IRN,1)
+      IPA(2)=IIPA(IRN,2)
+      GOTO 120
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+  20  IF (EAB .LE. RMASS(7)) GOTO 55
+      ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-MP-MSM
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (30,40),NFL
+C** FOR P AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1
+      IF(NMM1.LE.0) NMM1=1
+      NPP1=NP1+2
+      DO 31 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   31 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   41 CONTINUE
+      GOTO 80
+   50 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      IF(INT.EQ.1) CALL TWOB(20,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(20,NFL,N)
+      GO TO 9999
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004) RS,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+      IPA(1)=20
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      GOTO 120
+  100 DO 101 I=1,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+      GOTO (102,112),NFL
+  102 NCHT=NP-NM
+      NCHT=NCHT+3
+      IF(NCHT.LE.0) NCHT=1
+      IF(NCHT.GT.3) NCHT=3
+      GOTO (103,104,105),NCHT
+  103 IPA(1)=21
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) IPA(1)=18
+      IPA(2)=16
+      GOTO 120
+  104 IPA(1)=20
+      IPA(2)=16
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) GOTO 120
+      IPA(1)=21
+      IF(RNDM(2).LT.0.5) IPA(1)=18
+      IPA(2)=14
+      GOTO 120
+  105 IPA(1)=20
+      IPA(2)=14
+      GOTO 120
+  112 NCHT=NP-NM
+      NCHT=NCHT+2
+      IF(NCHT.LE.0) NCHT=1
+      IF(NCHT.GT.3) NCHT=3
+      GOTO (113,114,115),NCHT
+  113 IPA(1)=20
+      IPA(2)=14
+      GOTO 120
+  114 IPA(1)=21
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).LT.0.5) IPA(1)=18
+      IPA(2)=14
+      IF(RNDM(2).LT.0.5) GOTO 120
+      IPA(1)=20
+      IPA(2)=16
+      GOTO 120
+  115 IPA(1)=21
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) IPA(1)=18
+      IPA(2)=16
+  120 NT=2
+      IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      GOTO 50
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASSP* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003  FORMAT(' *CASSP* SIGMA+ -INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASSP* SIGMA+ -INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION NOT FOUND',
+     $ ' TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASSP* TABLES FOR MULT. DATA SIGMA+ INDUCED REACTION',
+     $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASSP* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASSP* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASSP* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CASP(K,INT,NFL)
+C
+C *** CASCADE OF PROTON ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (13-SEP-1987)
+C
+C P  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL(2,1200),ANORM(2,60),SUPP(10),CECH(10),B(2)
+      DIMENSION RNDM(1)
+      SAVE PMUL,ANORM
+      DATA SUPP/0.,0.4,0.55,0.65,0.75,0.82,0.86,0.90,0.94,0.98/
+      DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
+      DATA B/0.70,0.35/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(10) ---
+      IF (KGINIT(10) .NE. 0) GO TO 10
+      KGINIT(10)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL(I,J)=0.0
+      IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR P AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      DO 1 NM1=NMM1,NP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NPROT=2-NP+NM
+      NNEUT=2-NPROT
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      NPROTF=NFAC(NPROT)
+      NNEUTF=NFAC(NNEUT)
+      PMUL(1,L)=PMUL(1,L)/(NPROTF*NNEUTF)
+      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+    1 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NPROT=1-NP+NM
+      NNEUT=2-NPROT
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      NPROTF=NFAC(NPROT)
+      NNEUTF=NFAC(NNEUT)
+      PMUL(2,L)=PMUL(2,L)/(NPROTF*NNEUTF)
+      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
+      IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+    4 CONTINUE
+C** CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-RMASS(14)
+C**  ELASTIC SCATTERING
+      NCECH=0
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IF(INT.EQ.2) GOTO 20
+C** INTRODUCE CHARGE EXCHANGE REACTION PN --> NP
+      IF(NFL.EQ.1) GOTO 100
+      IPLAB=IFIX(P*2.5)+1
+      IF(IPLAB.GT.10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 100
+      NCECH=1
+      GOTO 100
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+  20  IF (EAB .LE. RMASS(7)) GOTO 55
+C**  SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM
+      IEAB=IFIX(EAB*5.)+1
+      IF(IEAB.GT.10) GOTO 22
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SUPP(IEAB)) GOTO 22
+      N=1.
+      GOTO (23,24),NFL
+ 23   CONTINUE
+      TEST=-(1+B(1))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      W0=EXP(TEST)/2.0
+      WP=EXP(TEST)
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF(RAN.LT.W0/(W0+WP)) GOTO 100
+      NP=1
+      NM=0
+      NZ=0
+      GOTO 100
+ 24   CONTINUE
+      TEST=-(1+B(2))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      W0=EXP(TEST)
+      WP=EXP(TEST)/2.0
+      TEST=-(-1+B(2))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      WM=EXP(TEST)/2.0
+      WT=W0+WP+WM
+      WP=W0+WP
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF(RAN.LT.W0/WT) GOTO 100
+      NP=1
+      NM=0
+      NZ=0
+      IF(RAN.LT.WP/WT) GOTO 100
+      NP=0
+      NM=1
+      NZ=0
+      GOTO 100
+C
+   22 ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (30,40),NFL
+C** FOR P AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      DO 31 NM1=NMM1,NP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   31 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   41 CONTINUE
+      GOTO 80
+   50 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      CALL STPAIR
+      IF(INT.EQ.1) CALL TWOB(14,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(14,NFL,N)
+      GO TO 9999
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND,ASSUME ELASTIC SCATTERING
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004) RS,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+  100 DO 101 I=1,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+      NPROT=2-NP+NM+(1-NFL)
+      NNEUT=2-NPROT
+      GOTO (102,112),NFL
+  102 GOTO (103,104),INT
+  103 IPA(1)=14
+      IPA(2)=14
+      NT=2
+      GOTO 130
+  104 IF(NNEUT.EQ.1) GOTO 105
+      IF(NNEUT.EQ.2) GOTO 106
+      IPA(1)=14
+      IPA(2)=14
+      GOTO 120
+  105 IPA(1)=14
+      IPA(2)=16
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 120
+      IPA(1)=16
+      IPA(2)=14
+      GOTO 120
+  106 IPA(1)=16
+      IPA(2)=16
+      GOTO 120
+  112 GOTO (113,114),INT
+  113 IPA(1)=14
+      IPA(2)=16
+      NT=2
+      IF(NCECH.EQ.0) GOTO 130
+      IPA(1)=16
+      IPA(2)=14
+      GOTO 130
+  114 IF(NNEUT.EQ.1) GOTO 115
+      IF(NNEUT.EQ.2) GOTO 116
+      IPA(1)=14
+      IPA(2)=14
+      GOTO 120
+  115 IPA(1)=16
+      IPA(2)=14
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.33) GOTO 120
+      IPA(1)=14
+      IPA(2)=16
+      GOTO 120
+  116 IPA(1)=16
+      IPA(2)=16
+  120 NT=2
+      IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      GOTO 50
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASP* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003  FORMAT(' *CASP* PROTON-INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASP* PROTON-INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION NOT FOUND',
+     $ ' TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASP* TABLES FOR MULT. DATA PROTON INDUCED REACTION',
+     $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASP* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASP* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASP* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CASPB(K,INT,NFL)
+C
+C *** CASCADE OF ANTI PROTON ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (13-SEP-1987)
+C
+C PB  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL1(2,1200),PMUL2(2,400),ANORM1(2,60),ANORM2(2,60),
+     $          SUPP(10),CECH(20),ANHL(29),B(2)
+      DIMENSION RNDM(1)
+      SAVE PMUL1,ANORM1,PMUL2,ANORM2
+      DATA SUPP/0.,0.4,0.55,0.65,0.75,0.82,0.86,0.90,0.94,0.98/
+      DATA CECH/0.14,0.17,0.18,0.18,0.18,0.17,0.17,0.16,0.155,0.145,
+     *          0.11,0.082,0.065,0.050,0.041,0.035,0.028,0.024,0.010
+     *         ,0.0/
+      DATA ANHL/1.00,1.00,1.00,1.00,1.0,1.00,1.0,1.00,1.00,0.90
+     *         ,0.6,0.52,0.47,0.44,0.41,0.39,0.37,0.35,0.34,0.24
+     *         ,0.19,0.15,0.12,0.10,0.09,0.07,0.06,0.05,0./
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(11) ---
+      IF (KGINIT(11) .NE. 0) GO TO 10
+      KGINIT(11)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL1(I,J)=0.0
+      IF (J .LE. 400) PMUL2(I,J)=0.0
+      IF (J .LE. 60) ANORM1(I,J)=0.0
+      IF (J .LE. 60) ANORM2(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR P AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 1 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL1(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM1(1,NT)=ANORM1(1,NT)+PMUL1(1,L)
+    1 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NPP1=NP1+2
+      DO 2 NM1=NP1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL1(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM1(2,NT)=ANORM1(2,NT)+PMUL1(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM1(1,I).GT.0.) ANORM1(1,I)=1./ANORM1(1,I)
+      IF(ANORM1(2,I).GT.0.) ANORM1(2,I)=1./ANORM1(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 9
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM1(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL1(NFL,I),I=1,1200)
+    4 CONTINUE
+C** DO THE SAME FOR ANNIHILATION CHANNELS
+C** FOR P AS TARGET
+C
+    9 L=0
+      DO 5 NP1=1,20
+      NP=NP1-1
+      NM=NP
+      DO 5 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 5
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 5
+      PMUL2(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM2(1,NT)=ANORM2(1,NT)+PMUL2(1,L)
+    5 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 6 NP1=1,20
+      NP=NP1-1
+      NM=NP+1
+      DO 6 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 6
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 6
+      PMUL2(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM2(2,NT)=ANORM2(2,NT)+PMUL2(2,L)
+    6 CONTINUE
+      DO 7 I=1,60
+      IF(ANORM2(1,I).GT.0.) ANORM2(1,I)=1./ANORM2(1,I)
+      IF(ANORM2(2,I).GT.0.) ANORM2(2,I)=1./ANORM2(2,I)
+    7 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,3001)
+      DO 8 NFL=1,2
+      WRITE(NEWBCD,3002) NFL
+      WRITE(NEWBCD,3003) (ANORM2(NFL,I),I=1,60)
+      WRITE(NEWBCD,3003) (PMUL2(NFL,I),I=1,400)
+    8 CONTINUE
+C** CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-ABS(RMASS(15))
+C**  ELASTIC SCATTERING
+      NCECH=0
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IF(INT.EQ.2) GOTO 20
+C** INTRODUCE CHARGE EXCHANGE REACTION PB P --> NB N
+      IF(NFL.EQ.2) GOTO 100
+      IPLAB=IFIX(P*10.)+1
+      IF(IPLAB.GT.10) IPLAB=IFIX(P)+10
+      IF(IPLAB.GT.20) IPLAB=20
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.75) GOTO 100
+      NCECH=1
+      GOTO 100
+C** ANNIHILATION CHANNELS
+   20 IPLAB=IFIX(P*10.)+1
+      IF(IPLAB.GT.10) IPLAB=IFIX(P)+10
+      IF(IPLAB.GT.19) IPLAB=IFIX(P/10.)+19
+      IF(IPLAB.GT.28) IPLAB=29
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.ANHL(IPLAB)) GOTO 19
+      EAB=RS
+      IF (EAB .LE. 2.0*RMASS(7)) GOTO 55
+      GOTO 222
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+   19 IF (EAB .LE. RMASS(7)) GOTO 55
+C**  SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM
+      IEAB=IFIX(EAB*5.)+1
+      IF(IEAB.GT.10) GOTO 22
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SUPP(IEAB)) GOTO 22
+      N=1.
+      GOTO (24,23),NFL
+ 23   CONTINUE
+      TEST=-(1+B(1))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      W0=EXP(TEST)
+      TEST=-(-1+B(1))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      WM=EXP(TEST)
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF(RAN.LT.W0/(W0+WM)) GOTO 100
+      NP=0
+      NM=1
+      NZ=0
+      GOTO 100
+ 24   CONTINUE
+      TEST=-(1+B(2))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      W0=EXP(TEST)
+      WP=EXP(TEST)
+      TEST=-(-1+B(2))**2/(2.0*C**2)
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      WM=EXP(TEST)
+      WT=W0+WP+WM
+      WP=W0+WP
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF(RAN.LT.W0/WT) GOTO 100
+      NP=1
+      NM=0
+      NZ=0
+      IF(RAN.LT.WP/WT) GOTO 100
+      NP=0
+      NM=1
+      NZ=0
+      GOTO 100
+C
+   22 ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (30,40),NFL
+C** FOR P AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 31 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL1(1,L)*ANORM1(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   31 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NPP1=NP1+2
+      DO 41 NM1=NP1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL1(2,L)*ANORM1(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 100
+   41 CONTINUE
+      GOTO 80
+C** ANNIHILATION CHANNELS
+  222 IPA(1)=0
+      IPA(2)=0
+      ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 221 NT=2,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+  221 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (230,240),NFL
+C** FOR P AS TARGET
+  230 L=0
+      DO 231 NP1=1,20
+      NP=NP1-1
+      NM=NP
+      DO 231 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 231
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 231
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL2(1,L)*ANORM2(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 120
+  231 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+  240 L=0
+      DO 241 NP1=1,20
+      NP=NP1-1
+      NM=NP+1
+      DO 241 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.400) GOTO 241
+      NT=NP+NM+NZ
+      IF(NT.LE.1.OR.NT.GT.60) GOTO 241
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL2(2,L)*ANORM2(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 120
+  241 CONTINUE
+      GOTO 80
+   50 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      CALL STPAIR
+      IF(INT.EQ.1) CALL TWOB(15,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(15,NFL,N)
+      GO TO 9999
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND,ASSUME ELASTIC SCATTERING
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004)EAB,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+  100 DO 101 I=1,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+      GOTO (112,102),NFL
+  102 GOTO (103,104),INT
+  103 IPA(1)=15
+      IPA(2)=16
+      NT=2
+      GOTO 130
+  104 IF(NP.EQ.-1+NM) GOTO 105
+      IF(NP.EQ.   NM) GOTO 106
+      IPA(1)=17
+      IPA(2)=14
+      GOTO 120
+  105 IPA(1)=15
+      IPA(2)=14
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 120
+      IPA(1)=17
+      IPA(2)=16
+      GOTO 120
+  106 IPA(1)=15
+      IPA(2)=16
+      GOTO 120
+  112 GOTO (113,114),INT
+  113 IPA(1)=15
+      IPA(2)=14
+      NT=2
+      IF(NCECH.EQ.0) GOTO 130
+      IPA(1)=17
+      IPA(2)=16
+      GOTO 130
+  114 IF(NP.EQ.  NM) GOTO 115
+      IF(NP.EQ.1+NM) GOTO 116
+      IPA(1)=17
+      IPA(2)=14
+      GOTO 120
+  115 IPA(1)=17
+      IPA(2)=16
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.33) GOTO 120
+      IPA(1)=15
+      IPA(2)=14
+      GOTO 120
+  116 IPA(1)=15
+      IPA(2)=16
+  120 NT=2
+      IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      GOTO 50
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASPB* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003  FORMAT(' *CASPB* ANTIPROTON-INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASPB* ANTIPROTON-INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION',
+     $ ' NOT FOUND  TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASPB* TABLES FOR MULT. DATA ANTIPROTON INDUCED ',
+     $ 'REACTION  FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASPB* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASPB* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASPB* NO PARTICLES PRODUCED')
+3001  FORMAT(' *CASPB* TABLES FOR MULT. DATA ANTIPROTON INDUCED ',
+     $ ' ANNIHILATION REACTION  FOR DEFINITION OF NUMBERS SEE FORTRAN',
+     $ ' CODING')
+3002  FORMAT(' *CASPB* TARGET PARTICLE FLAG',2X,I5)
+3003  FORMAT(1H ,10E12.4)
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CASPIM(K,INT,NFL)
+C
+C *** CASCADE OF PI- ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT 13-SEP-1987
+C
+C PI-  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C
+      REAL N
+      DIMENSION PMUL(2,1200),ANORM(2,60),SUPP(10),CECH(10),B(2)
+      DIMENSION RNDM(1)
+      SAVE PMUL,ANORM
+      DATA SUPP/0.,0.4,0.55,0.65,0.75,0.82,0.86,0.90,0.94,0.98/
+      DATA CECH/1.,0.95,0.79,0.32,0.19,0.16,0.14,0.12,0.10,0.08/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(16) ---
+      IF (KGINIT(16) .NE. 0) GO TO 10
+      KGINIT(16)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL(I,J)=0.0
+      IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C *** COMPUTATION OF NORMALIZATION CONSTANTS ***
+C
+C --- P TARGET ---
+      L=0
+      DO 1100 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF (NMM1 .LE. 1) NMM1=1
+      NPP1=NP1+1
+C
+      DO 1101 NM1=NMM1,NPP1
+      NM=NM1-1
+C
+      DO 1102 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GOTO 1199
+      NT=NP+NM+NZ
+      IF (NT .LE. 0) GO TO 1102
+      IF (NT .GT. 60) GO TO 1102
+      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+ 1102 CONTINUE
+C
+ 1101 CONTINUE
+C
+ 1100 CONTINUE
+C
+ 1199 CONTINUE
+C
+C --- N TARGET ---
+      L=0
+      DO 1200 NP1=1,20
+      NP=NP1-1
+      NPP1=NP1+2
+C
+      DO 1201 NM1=NP1,NPP1
+      NM=NM1-1
+C
+      DO 1202 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 1299
+      NT=NP+NM+NZ
+      IF (NT .LE. 0) GO TO 1202
+      IF (NT .GT. 60) GO TO 1202
+      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+ 1202 CONTINUE
+C
+ 1201 CONTINUE
+C
+ 1200 CONTINUE
+C
+ 1299 CONTINUE
+C
+      DO 3 I=1,60
+      IF (ANORM(1,I) .GT. 0.0) ANORM(1,I)=1.0/ANORM(1,I)
+      IF (ANORM(2,I) .GT. 0.0) ANORM(2,I)=1.0/ANORM(2,I)
+    3 CONTINUE
+C
+      IF (.NOT. NPRT(10)) GO TO 10
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+    4 CONTINUE
+C
+C --- CHOOSE PROTON OR NEUTRON AS TARGET ---
+ 10   CONTINUE
+      NFL=2
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .LT. ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-RMASS(9)
+C
+C --- ELASTIC SCATTERING ---
+      NP=0
+      NM=0
+      NZ=0
+      N=0.0
+      IPA(1)=9
+      IPA(2)=14
+      IF (NFL .EQ. 2) IPA(2)=16
+      IF (INT .EQ. 2) GOTO 20
+      GOTO 100
+C
+C --- CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+ 20   CONTINUE
+      IF (EAB .LE. RMASS(9)) GO TO 55
+C
+C --- SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM ---
+      IEAB=IFIX(EAB*5.0)+1
+      IF (IEAB .GT. 10) GO TO 22
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .LT. SUPP(IEAB)) GO TO 22
+C
+C --- CHARGE EXCHANGE REACTION (IS INCLUDED IN INELASTIC CROSS SECTION)
+      IPLAB=IFIX(P*5.0)+1
+      IF (IPLAB .GT. 10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .GT. CECH(IPLAB)) GO TO 23
+C
+      IF (NFL .EQ. 1) GOTO 24
+C
+C --- N TARGET ---
+      INT=1
+      IPA(1)=9
+      IPA(2)=16
+      GO TO 100
+C
+C --- P TARGET ---
+ 24   CONTINUE
+      IPA(1)=8
+      IPA(2)=16
+      GO TO 100
+C
+ 23   CONTINUE
+      N=1.0
+C
+      IF (NFL .EQ. 1) GO TO 26
+C
+C --- N TARGET ---
+      DUM=-(1+B(2))**2/(2.0*C**2)
+      IF (DUM .LT. EXPXL) DUM=EXPXL
+      IF (DUM .GT. EXPXU) DUM=EXPXU
+      W0=EXP(DUM)
+      DUM=-(-1+B(2))**2/(2.0*C**2)
+      IF (DUM .LT. EXPXL) DUM=EXPXL
+      IF (DUM .GT. EXPXU) DUM=EXPXU
+      WM=EXP(DUM)
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF (RAN .LT. W0/(W0+WM)) GO TO 50
+      NP=0
+      NM=1
+      NZ=0
+      GO TO 50
+C
+C --- P TARGET ---
+ 26   CONTINUE
+      DUM=-(1+B(1))**2/(2.0*C**2)
+      IF (DUM .LT. EXPXL) DUM=EXPXL
+      IF (DUM .GT. EXPXU) DUM=EXPXU
+      W0=EXP(DUM)
+      WP=EXP(DUM)
+      DUM=-(-1+B(1))**2/(2.0*C**2)
+      IF (DUM .LT. EXPXL) DUM=EXPXL
+      IF (DUM .GT. EXPXU) DUM=EXPXU
+      WM=EXP(DUM)
+      WP=WP*10.
+      WT=W0+WP+WM
+      WP=W0+WP
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF (RAN .LT. W0/WT) GO TO 50
+      NP=1
+      NM=0
+      NZ=0
+      IF (RAN .LT. WP/WT) GO TO 50
+      NP=0
+      NM=1
+      NZ=0
+      GOTO 50
+C
+ 22   CONTINUE
+      ALEAB=LOG(EAB)
+C
+C --- NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP ---
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     $ +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.0
+C
+C --- NORMALIZATION CONSTANT FOR KNO-DISTRIBUTION ---
+      ANPN=0.0
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1.0/ANPN
+C
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.0
+      IF (NFL .EQ. 2) GO TO 40
+C
+C --- P TARGET ---
+      L=0
+      DO 310 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF (NMM1 .LE. 1) NMM1=1
+      NPP1=NP1+1
+C
+      DO 311 NM1=NMM1,NPP1
+      NM=NM1-1
+C
+      DO 312 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 80
+      NT=NP+NM+NZ
+      IF (NT .LE. 0) GO TO 312
+      IF (NT .GT. 60) GO TO 312
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF (RAN .LT. EXCS) GOTO 50
+ 312  CONTINUE
+C
+ 311  CONTINUE
+C
+ 310  CONTINUE
+      GOTO 80
+C
+C --- N TARGET ---
+ 40   CONTINUE
+      L=0
+      DO 410 NP1=1,20
+      NP=NP1-1
+      NPP1=NP1+2
+C
+      DO 411 NM1=NP1,NPP1
+      NM=NM1-1
+C
+      DO 412 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 80
+      NT=NP+NM+NZ
+      IF (NT .LE. 0) GO TO 412
+      IF (NT .GT. 60) GO TO 412
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF (RAN .LT. EXCS) GOTO 50
+ 412  CONTINUE
+C
+ 411  CONTINUE
+C
+ 410  CONTINUE
+      GO TO 80
+C
+ 50   CONTINUE
+      IF (NFL .EQ. 2) GO TO 65
+C
+C --- P TARGET ---
+      IF (NP .EQ. NM) GO TO 61
+      IF (NP .EQ. 1+NM) GO TO 63
+      IPA(1)=8
+      IPA(2)=14
+      GO TO 100
+C
+ 61   CONTINUE
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .LT. 0.75) GO TO 62
+      IPA(1)=8
+      IPA(2)=16
+      GO TO 100
+C
+ 62   CONTINUE
+      IPA(1)=9
+      IPA(2)=14
+      GO TO 100
+C
+ 63   CONTINUE
+      IPA(1)=9
+      IPA(2)=16
+      GO TO 100
+C
+C --- N TARGET ---
+ 65   CONTINUE
+      IF (NP .EQ. -1+NM) GO TO 66
+      IF (NP .EQ. NM) GO TO 68
+      IPA(1)=8
+      IPA(2)=16
+      GO TO 100
+C
+ 66   CONTINUE
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .LT. 0.50) GO TO 67
+      IPA(1)=8
+      IPA(2)=16
+      GO TO 100
+C
+ 67   CONTINUE
+      IPA(1)=9
+      IPA(2)=14
+      GO TO 100
+C
+ 68   CONTINUE
+      IPA(1)=9
+      IPA(2)=16
+      GO TO 100
+C
+ 70   CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      CALL STPAIR
+      IF (INT .EQ. 1) CALL TWOB(9,NFL,N)
+      IF (INT .EQ. 2) CALL GENXPT(9,NFL,N)
+      GO TO 9999
+C
+C --- ENERGETICALLY NOT POSSIBLE TO PRODUCE CASCADE-PARTICLES ---
+C --- CONTINUE WITH QUASI-ELASTIC SCATTERING ---
+ 55   CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,1001)
+      GO TO 53
+C
+C --- EXCLUSIVE REACTION NOT FOUND ---
+ 80   CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,1004) RS,N
+C
+ 53   CONTINUE
+      INT=1
+      NP=0
+      NM=0
+      NZ=0
+      N=0.0
+      IPA(1)=9
+      IPA(2)=14
+      IF (NFL .EQ. 2) IPA(2)=16
+C
+ 100  CONTINUE
+      DO 101 I=3,60
+      IPA(I)=0
+ 101  CONTINUE
+      IF (INT .LE. 0) GO TO 131
+C
+ 120  CONTINUE
+      NT=2
+      IF (NP .EQ. 0) GO TO 122
+      DO 121 I=1,NP
+      NT=NT+1
+      IPA(NT)=7
+ 121  CONTINUE
+C
+ 122  CONTINUE
+      IF (NM .EQ. 0) GO TO 124
+      DO 123 I=1,NM
+      NT=NT+1
+      IPA(NT)=9
+ 123  CONTINUE
+C
+ 124  CONTINUE
+      IF (NZ .EQ. 0) GO TO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+      IPA(NT)=8
+ 125  CONTINUE
+C
+ 130  CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      IF (IPA(1) .EQ. 7) NP=NP+1
+      IF (IPA(1) .EQ. 8) NZ=NZ+1
+      IF (IPA(1) .EQ. 9) NM=NM+1
+      GO TO 70
+C
+ 131  CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASPIM* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003  FORMAT(' *CASPIM* PION- -INDUCED CASCADE, AVAIL. ENERGY',2X,F8.4,
+     $ /,2X,'    <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASPIM* PION- -INDUCED CASCADE, EXCLUSIVE REACTION',
+     $ ' NOT FOUND TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     * '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASPIM* TABLES FOR MULTIPLICITY DATA PION- INDUCED',
+     $ 'REACTION FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASPIM* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASPIM* ',I3,'  PARTICLES, MASS INDEX ARRAY  ',20I4)
+2005  FORMAT(' *CASPIM* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CASPIP(K,INT,NFL)
+C
+C *** CASCADE OF PI+ ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (18-SEP-1987)
+C
+C PI+  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C
+      REAL N
+      DIMENSION PMUL(2,1200),ANORM(2,60),SUPP(10),CECH(10),B(2)
+      DIMENSION RNDM(1)
+      SAVE PMUL,ANORM
+      DATA SUPP/0.,0.2,0.45,0.55,0.65,0.75,0.85,0.90,0.94,0.98/
+      DATA CECH/0.33,0.27,0.29,0.31,0.27,0.18,0.13,0.10,0.09,0.07/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(18) ---
+      IF (KGINIT(18) .NE. 0) GO TO 10
+      KGINIT(18)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL(I,J)=0.0
+      IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR P AS TARGET
+C
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      DO 1 NM1=NMM1,NP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 1
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+    1 CONTINUE
+C** FOR N AS TARGET
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 2
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+    2 CONTINUE
+      DO 3 I=1,60
+      IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
+      IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
+    3 CONTINUE
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,2001)
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+    4 CONTINUE
+C**  CHOOSE PROTON OR NEUTRON AS TARGET
+   10 NFL=2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-RMASS(7)
+C
+C**  ELASTIC SCATTERING
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=7
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      IF(INT.EQ.2) GOTO 20
+C**  FOR PI+ N REACTIONS CHANGE SOME OF THE ELASTIC CROSS SECTION
+C**  TO PI+ N --> PI0 P
+      IF(NFL.EQ.1) GOTO 100
+      IPLAB=IFIX(P   *5.)+1
+      IF(IPLAB.GT.10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 100
+      IPA(1)=8
+      IPA(2)=14
+      GOTO 100
+C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+  20  IF (EAB .LE. RMASS(7)) GOTO 55
+C**  SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM
+      IEAB=IFIX(EAB*5.)+1
+      IF(IEAB.GT.10) GOTO 22
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SUPP(IEAB)) GOTO 22
+      N=1.
+      GOTO (23,24),NFL
+ 23   CONTINUE
+      TEST=-(1+B(1))**2/(2.0*C**2)
+      IF (TEST .LE. EXPXL) TEST=EXPXL
+      IF (TEST .GE. EXPXU) TEST=EXPXU
+      W0=EXP(TEST)
+      WP=EXP(TEST)
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF(RAN.LT.W0/(W0+WP)) GOTO 50
+      NP=1
+      NM=0
+      NZ=0
+      GOTO 50
+ 24   CONTINUE
+      TEST=-(1+B(2))**2/(2.0*C**2)
+      IF (TEST .LE. EXPXL) TEST=EXPXL
+      IF (TEST .GE. EXPXU) TEST=EXPXU
+      W0=EXP(TEST)
+      WP=EXP(TEST)
+      TEST=-(-1+B(2))**2/(2.0*C**2)
+      IF (TEST .LE. EXPXL) TEST=EXPXL
+      IF (TEST .GE. EXPXU) TEST=EXPXU
+      WM=EXP(TEST)
+      WT=W0+WP+WM
+      WP=W0+WP
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NP=0
+      NM=0
+      NZ=1
+      IF(RAN.LT.W0/WT) GOTO 50
+      NP=1
+      NM=0
+      NZ=0
+      IF(RAN.LT.WP/WT) GOTO 50
+      NP=0
+      NM=1
+      NZ=0
+      GOTO 50
+C
+   22 ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LE. EXPXL) TEST=EXPXL
+      IF (TEST .GE. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+   21 CONTINUE
+      ANPN=1./ANPN
+C** P OR N AS TARGET
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GOTO (30,40),NFL
+C** FOR P AS TARGET
+   30 L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF(NMM1.LE.1) NMM1=1
+      DO 31 NM1=NMM1,NP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 31
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LE. EXPXL) TEST=EXPXL
+      IF (TEST .GE. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 50
+   31 CONTINUE
+      GOTO 80
+C** FOR N AS TARGET
+   40 L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF(NMM1.LE.1) NMM1=1
+      NPP1=NP1+1
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF(L.GT.1200) GOTO 41
+      NT=NP+NM+NZ
+      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LE. EXPXL) TEST=EXPXL
+      IF (TEST .GE. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF(RAN.LT.EXCS) GOTO 50
+   41 CONTINUE
+      GOTO 80
+   50 GOTO (60,65),NFL
+   60 IF(NP.EQ.1+NM) GOTO 61
+      IF(NP.EQ.2+NM) GOTO 63
+      IPA(1)=7
+      IPA(2)=14
+      GOTO 100
+   61 CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 62
+      IPA(1)=7
+      IPA(2)=16
+      GOTO 100
+   62 IPA(1)=8
+      IPA(2)=14
+      GOTO 100
+   63 IPA(1)=8
+      IPA(2)=16
+      GOTO 100
+   65 IF(NP.EQ.NM) GOTO 66
+      IF(NP.EQ.1+NM) GOTO 68
+      IPA(1)=7
+      IPA(2)=14
+      GOTO 100
+   66 CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.25) GOTO 67
+      IPA(1)=7
+      IPA(2)=16
+      GOTO 100
+   67 IPA(1)=8
+      IPA(2)=14
+      GOTO 100
+   68 IPA(1)=8
+      IPA(2)=16
+      GOTO 100
+   70 IF(NPRT(4))
+     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+      CALL STPAIR
+      IF(INT.EQ.1) CALL TWOB(7,NFL,N)
+      IF(INT.EQ.2) CALL GENXPT(7,NFL,N)
+      GO TO 9999
+   55 IF(NPRT(4))
+     *WRITE(NEWBCD,1001)
+      GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND
+   80 IF(NPRT(4))
+     *WRITE(NEWBCD,1004) RS,N
+   53 INT=1
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=7
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+  100 DO 101 I=3,60
+  101 IPA(I)=0
+      IF(INT.LE.0) GOTO 131
+  120 NT=2
+      IF(NP.EQ.0) GOTO 122
+      DO 121 I=1,NP
+      NT=NT+1
+  121 IPA(NT)=7
+  122 IF(NM.EQ.0) GOTO 124
+      DO 123 I=1,NM
+      NT=NT+1
+  123 IPA(NT)=9
+  124 IF(NZ.EQ.0) GOTO 130
+      DO 125 I=1,NZ
+      NT=NT+1
+  125 IPA(NT)=8
+  130 IF(NPRT(4))
+     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+      IF(IPA(1).EQ.7) NP=NP+1
+      IF(IPA(1).EQ.8) NZ=NZ+1
+      IF(IPA(1).EQ.9) NM=NM+1
+      GOTO 70
+  131 IF(NPRT(4))
+     *WRITE(NEWBCD,2005)
+C
+1001  FORMAT(' *CASPIP* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003  FORMAT(' *CASPIP* PION+ -INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,/,
+     $ 2X,'   <NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004  FORMAT(' *CASPIP* PION+ -INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION NOT FOUND',
+     $ ' TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,/,2X,
+     $ '    <NTOT>',2X,F8.4)
+2001  FORMAT(' *CASPIP* TABLES FOR MULT. DATA PION+  INDUCED REACTION',
+     $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002  FORMAT(' *CASPIP* TARGET PARTICLE FLAG',2X,I5)
+2003  FORMAT(1H ,10E12.4)
+2004  FORMAT(' *CASPIP* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005  FORMAT(' *CASPIP* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+      RETURN
+      END
+      SUBROUTINE CASXM(K,INT,NFL)
+C
+C *** CASCADE OF XI- ***
+C *** NVE 17-JAN-1989 CERN GENEVA ***
+C
+C XI-  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT, ASSUME NUCLEAR EXCITATION OCCURS, DEGRADE INPUT PARTICLE
+C IN ENERGY AND NO OTHER PARTICLES ARE PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL(2,1200),ANORM(2,60),CECH(10),IIPA(12,2),B(2)
+      DIMENSION RNDM(1)
+      SAVE PMUL,ANORM
+      DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
+C --- ARRAY IIPA DENOTES THE STRANGENESS AND CHARGE EXCHAGE REACTIONS ---
+C XI- P --> XI0 N,  XI- P --> N XI0
+C XI- P --> S0 S0,  XI- P --> L0 L0
+C XI- P --> S0 L0,  XI- P --> L0 S0
+C XI- P --> P XI-
+C XI- N --> N XI-
+C XI- N --> S0 S-,  XI- N --> S- S0
+C XI- N --> L0 S-,  XI- N --> S- L0
+      DATA IIPA/26,16,21,18,21,18,14, 16,21,22,18,22,
+     *          16,26,21,18,18,21,27, 27,22,21,22,18/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(19) ---
+      IF (KGINIT(19) .NE. 0) GO TO 10
+      KGINIT(19)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL(I,J)=0.0
+      IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C *** COMPUTE NORMALIZATION CONSTANTS ***
+C
+C --- FOR P TARGET ---
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF (NMM1 .LE. 0) NMM1=1
+      NPP1=NP1+1
+      DO 1 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 1
+      NT=NP+NM+NZ
+      IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 1
+      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+ 1    CONTINUE
+C --- FOR N TARGET ---
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1
+      NPP1=NP1+2
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 2
+      NT=NP+NM+NZ
+      IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 2
+      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+ 2    CONTINUE
+C
+      DO 3 I=1,60
+      IF (ANORM(1,I) .GT. 0.) ANORM(1,I)=1./ANORM(1,I)
+      IF (ANORM(2,I) .GT. 0.) ANORM(2,I)=1./ANORM(2,I)
+ 3    CONTINUE
+C
+      IF (.NOT. NPRT(10)) GO TO 10
+C
+      WRITE(NEWBCD,2001)
+ 2001 FORMAT(' *CASXM* TABLES FOR MULT. DATA XI- INDUCED REACTION',
+     $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+ 2002 FORMAT(' *CASXM* TARGET PARTICLE FLAG',2X,I5)
+      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+ 2003 FORMAT(1H ,10E12.4)
+ 4    CONTINUE
+C
+C --- SELECT TARGET NUCLEON ---
+ 10   CONTINUE
+      NFL=2
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .LT. (ZNO2/ATNO2)) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-RMASS(27)
+C
+C --- RESET STRANGENESS FIXING FLAG ---
+      NVEFIX=0
+C
+C *** ELASTIC SCATTERING ***
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=27
+      IPA(2)=14
+      IF (NFL .EQ. 2) IPA(2)=16
+C
+      IF (INT .EQ. 2) GO TO 20
+C
+C *** INTRODUCE CHARGE AND STRANGENESS EXCHANGE REACTIONS ***
+      IPLAB=IFIX(P*2.5)+1
+      IF (IPLAB .GT. 10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .GT. (CECH(IPLAB)/ATNO2**0.42)) GO TO 120
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IRN=IFIX(RAN*7.)+1
+      IF (NFL .EQ. 2) IRN=7+IFIX(RAN*5.)+1
+      IF (NFL .EQ. 1) IRN=MAX(IRN,7)
+      IF (NFL .EQ. 2) IRN=MAX(IRN,12)
+      IPA(1)=IIPA(IRN,1)
+      IPA(2)=IIPA(IRN,2)
+      GO TO 120
+C
+C --- CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION ---
+ 20   CONTINUE
+      IF (EAB .LE. RMASS(7)) GO TO 55
+C
+C --- NO. OF TOTAL PARTICLES VS SQRT(S)-MP-MSM ---
+      ALEAB=LOG(EAB)
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C
+C --- NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION ---
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+ 21   CONTINUE
+      ANPN=1./ANPN
+C
+C --- CHECK FOR TARGET NUCLEON TYPE ---
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GO TO (30,40),NFL
+C
+C --- PROTON TARGET ---
+ 30   CONTINUE
+      L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF (NMM1 .LE. 0) NMM1=1
+      NPP1=NP1+1
+      DO 31 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 31
+      NT=NP+NM+NZ
+      IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF (RAN .LT. EXCS) GO TO 100
+   31 CONTINUE
+      GO TO 80
+C
+C --- NEUTRON TARGET ---
+ 40   CONTINUE
+      L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1
+      NPP1=NP1+2
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 41
+      NT=NP+NM+NZ
+      IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF (RAN .LT. EXCS) GO TO 100
+   41 CONTINUE
+      GO TO 80
+C
+ 50   CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+ 1003 FORMAT(' *CASXM* XI- -INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,
+     $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+      IF (INT .EQ. 1) CALL TWOB(27,NFL,N)
+      IF (INT .EQ. 2) CALL GENXPT(27,NFL,N)
+      GO TO 9999
+C
+C *** ENERGETICALLY NOT POSSIBLE TO PRODUCE ONE EXTRA PION ***
+ 55   CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,1001)
+ 1001 FORMAT(' *CASXM* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+      GO TO 53
+C
+C *** EXCLUSIVE REACTION NOT FOUND ***
+ 80   CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,1004) RS,N
+ 1004 FORMAT(' *CASXM* XI- -INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION NOT FOUND',
+     $ ' TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,2X,
+     $ '<NTOT>',2X,F8.4)
+C
+ 53   CONTINUE
+      INT=1
+      NP=0
+      NM=0
+      NZ=0
+      IPA(1)=27
+      IPA(2)=14
+      IF (NFL .EQ. 2) IPA(2)=16
+      GO TO 120
+C
+C *** INELASTIC INTERACTION HAS OCCURRED ***
+C *** NUMBER OF SECONDARY MESONS DETERMINED BY KNO DISTRIBUTION ***
+ 100  CONTINUE
+      DO 101 I=1,60
+      IPA(I)=0
+ 101  CONTINUE
+C
+      IF (INT .LE. 0) GO TO 131
+C
+C --- TAKE TARGET NUCLEON TYPE INTO ACCOUNT ---
+      GO TO (102,112),NFL
+C
+C --- PROTON TARGET ---
+ 102  CONTINUE
+C --- CHECK FOR TOTAL CHARGE OF FINAL STATE MESONS TO DETERMINE ---
+C --- THE KIND OF BARYONS TO BE PRODUCED TAKING INTO ACCOUNT    ---
+C --- CHARGE AND STRANGENESS CONSERVATION                       ---
+      NCHT=NP-NM
+      IF (NCHT .LT. 0) GO TO 103
+      IF (NCHT .EQ. 0) GO TO 104
+      IF (NCHT .GT. 0) GO TO 105
+C
+ 103  CONTINUE
+C --- XI0 P ---
+      IPA(1)=26
+      IPA(2)=14
+      IF (NCHT .EQ. -1) GO TO 120
+C --- CHARGE MISMATCH ==> TAKE A S+ AND CORRECT THE STRANGENESS ---
+C --- BY REPLACING A PI- BY K- ---
+C --- S+ P ---
+      IPA(1)=20
+      IPA(2)=14
+      NVEFIX=1
+      GO TO 120
+C
+ 104  CONTINUE
+C --- XI- P ---
+      IPA(1)=27
+      IPA(2)=14
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .LT. 0.5) GO TO 120
+C --- XI0 N ---
+      IPA(1)=26
+      IPA(2)=16
+      GO TO 120
+C
+ 105  CONTINUE
+C --- XI- N ---
+      IPA(1)=27
+      IPA(2)=16
+      GO TO 120
+C
+C --- NEUTRON TARGET ---
+ 112  CONTINUE
+C --- CHECK FOR TOTAL CHARGE OF FINAL STATE MESONS TO DETERMINE ---
+C --- THE KIND OF BARYONS TO BE PRODUCED TAKING INTO ACCOUNT    ---
+C --- CHARGE AND STRANGENESS CONSERVATION                       ---
+      NCHT=NP-NM
+      IF (NCHT .LT. -1) GO TO 113
+      IF (NCHT .EQ. -1) GO TO 114
+      IF (NCHT .GT. -1) GO TO 115
+C
+ 113  CONTINUE
+C --- XI0 P ---
+      IPA(1)=26
+      IPA(2)=14
+      IF (NCHT .EQ. -2) GO TO 120
+C --- CHARGE MISMATCH ==> TAKE A S+ AND CORRECT THE STRANGENESS ---
+C --- BY REPLACING A PI- BY K- ---
+C --- S+ P ---
+      IPA(1)=20
+      IPA(2)=14
+      NVEFIX=1
+      GO TO 120
+C
+ 114  CONTINUE
+C --- XI0 N ---
+      IPA(1)=26
+      IPA(2)=16
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .LT. 0.5) GO TO 120
+C --- XI- P ---
+      IPA(1)=27
+      IPA(2)=14
+      GO TO 120
+C
+ 115  CONTINUE
+C --- XI- N ---
+      IPA(1)=27
+      IPA(2)=16
+C
+C --- TAKE PIONS FOR ALL SECONDARY MESONS ---
+ 120  CONTINUE
+      NT=2
+C
+      IF (NP .EQ. 0) GO TO 122
+C
+C --- PI+ ---
+      DO 121 I=1,NP
+      NT=NT+1
+      IPA(NT)=7
+ 121  CONTINUE
+C
+ 122  CONTINUE
+      IF (NM .EQ. 0) GO TO 124
+C
+C --- PI- ---
+      DO 123 I=1,NM
+      NT=NT+1
+      IPA(NT)=9
+      IF (NVEFIX .GE. 1) IPA(NT)=13
+      IF (NPRT(4) .AND. (NVEFIX .GE. 1)) PRINT 3000
+ 3000 FORMAT(' *CASXM* K- INTRODUCED')
+      NVEFIX=NVEFIX-1
+ 123  CONTINUE
+C
+ 124  CONTINUE
+      IF (NZ .EQ. 0) GO TO 130
+C
+C --- PI0 ---
+      DO 125 I=1,NZ
+      NT=NT+1
+      IPA(NT)=8
+ 125  CONTINUE
+C
+C --- ALL SECONDARY PARTICLES HAVE BEEN DEFINED ---
+C --- NOW GO FOR MOMENTA AND X VALUES ---
+ 130  CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,2004) NT,(IPA(I),I=1,60)
+ 2004 FORMAT(' *CASXM* ',I3,' PARTICLES PRODUCED. MASS INDEX ARRAY : '/
+     $ 3(1H ,20(I3,1X)/))
+      GO TO 50
+C
+ 131  CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,2005)
+ 2005 FORMAT(' *CASXM* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+      END
+      SUBROUTINE CASX0(K,INT,NFL)
+C
+C *** CASCADE OF XI0 ***
+C *** NVE 20-JAN-1989 CERN GENEVA ***
+C
+C XI0  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT, ASSUME NUCLEAR EXCITATION OCCURS, DEGRADE INPUT PARTICLE
+C IN ENERGY AND NO OTHER PARTICLES ARE PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      REAL N
+      DIMENSION PMUL(2,1200),ANORM(2,60),CECH(10),IIPA(12,2),B(2)
+      DIMENSION RNDM(1)
+      SAVE PMUL,ANORM
+      DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
+C --- ARRAY IIPA DENOTES THE STRANGENESS AND CHARGE EXCHAGE REACTIONS ---
+C XI0 P --> S+ S0,  XI0 P --> S0 S+
+C XI0 P --> S+ L0,  XI0 P --> L0 S+
+C XI0 P --> P XI0
+C XI0 N --> S0 S0
+C XI0 N --> L0 L0
+C XI0 N --> XI- P,  XI0 N --> P XI-
+C XI0 N --> S+ S-,  XI0 N --> S- S+
+C XI0 N --> N XI0
+      DATA IIPA/20,21,20,18,14, 21,18,27,14,20,22,16,
+     *          21,20,18,20,26, 21,18,14,27,22,20,26/
+      DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(20) ---
+      IF (KGINIT(20) .NE. 0) GO TO 10
+      KGINIT(20)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+      DO 9000 J=1,1200
+      DO 9001 I=1,2
+      PMUL(I,J)=0.0
+      IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C *** COMPUTE NORMALIZATION CONSTANTS ***
+C
+C --- FOR P TARGET ---
+      L=0
+      DO 1 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF (NMM1 .LE. 0) NMM1=1
+      NPP1=NP1+1
+      DO 1 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 1 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 1
+      NT=NP+NM+NZ
+      IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 1
+      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+ 1    CONTINUE
+C --- FOR N TARGET ---
+      L=0
+      DO 2 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF (NMM1 .LE. 0) NMM1=1
+      NPP1=NP1+2
+      DO 2 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 2 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 2
+      NT=NP+NM+NZ
+      IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 2
+      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+ 2    CONTINUE
+C
+      DO 3 I=1,60
+      IF (ANORM(1,I) .GT. 0.) ANORM(1,I)=1./ANORM(1,I)
+      IF (ANORM(2,I) .GT. 0.) ANORM(2,I)=1./ANORM(2,I)
+ 3    CONTINUE
+C
+      IF (.NOT. NPRT(10)) GO TO 10
+C
+      WRITE(NEWBCD,2001)
+ 2001 FORMAT(' *CASX0* TABLES FOR MULT. DATA XI0 INDUCED REACTION',
+     $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+      DO 4 NFL=1,2
+      WRITE(NEWBCD,2002) NFL
+ 2002 FORMAT(' *CASX0* TARGET PARTICLE FLAG',2X,I5)
+      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+ 2003 FORMAT(1H ,10E12.4)
+ 4    CONTINUE
+C
+C --- SELECT TARGET NUCLEON ---
+ 10   CONTINUE
+      NFL=2
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .LT. (ZNO2/ATNO2)) NFL=1
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EAB=RS-TARMAS-RMASS(26)
+C
+C --- RESET STRANGENESS FIXING FLAG ---
+      NVEFIX=0
+C
+C *** ELASTIC SCATTERING ***
+      NP=0
+      NM=0
+      NZ=0
+      N=0.
+      IPA(1)=26
+      IPA(2)=14
+      IF (NFL .EQ. 2) IPA(2)=16
+C
+      IF (INT .EQ. 2) GO TO 20
+C
+C *** INTRODUCE CHARGE AND STRANGENESS EXCHANGE REACTIONS ***
+      IPLAB=IFIX(P*2.5)+1
+      IF (IPLAB .GT. 10) IPLAB=10
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .GT. (CECH(IPLAB)/ATNO2**0.42)) GO TO 120
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IRN=IFIX(RAN*5.)+1
+      IF (NFL .EQ. 2) IRN=5+IFIX(RAN*7.)+1
+      IF (NFL .EQ. 1) IRN=MAX(IRN,5)
+      IF (NFL .EQ. 2) IRN=MAX(IRN,12)
+      IPA(1)=IIPA(IRN,1)
+      IPA(2)=IIPA(IRN,2)
+      GO TO 120
+C
+C --- CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION ---
+ 20   CONTINUE
+      IF (EAB .LE. RMASS(7)) GO TO 55
+C
+C --- NO. OF TOTAL PARTICLES VS SQRT(S)-MP-MSM ---
+      ALEAB=LOG(EAB)
+      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+      N=N-2.
+C
+C --- NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION ---
+      ANPN=0.
+      DO 21 NT=1,60
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=PI*NT/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      ANPN=ANPN+ADDNVE
+ 21   CONTINUE
+      ANPN=1./ANPN
+C
+C --- CHECK FOR TARGET NUCLEON TYPE ---
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      EXCS=0.
+      GO TO (30,40),NFL
+C
+C --- PROTON TARGET ---
+ 30   CONTINUE
+      L=0
+      DO 31 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-2
+      IF (NMM1 .LE. 0) NMM1=1
+      NPP1=NP1+1
+      DO 31 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 31 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 31
+      NT=NP+NM+NZ
+      IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 31
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF (RAN .LT. EXCS) GO TO 100
+   31 CONTINUE
+      GO TO 80
+C
+C --- NEUTRON TARGET ---
+ 40   CONTINUE
+      L=0
+      DO 41 NP1=1,20
+      NP=NP1-1
+      NMM1=NP1-1
+      IF (NMM1 .LE. 0) NMM1=1
+      NPP1=NP1+2
+      DO 41 NM1=NMM1,NPP1
+      NM=NM1-1
+      DO 41 NZ1=1,20
+      NZ=NZ1-1
+      L=L+1
+      IF (L .GT. 1200) GO TO 41
+      NT=NP+NM+NZ
+      IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 41
+      TEST=-(PI/4.0)*(NT/N)**2
+      IF (TEST .LT. EXPXL) TEST=EXPXL
+      IF (TEST .GT. EXPXU) TEST=EXPXU
+      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+      DUM2=ABS(DUM1)
+      DUM3=EXP(TEST)
+      ADDNVE=0.0
+      IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+      EXCS=EXCS+ADDNVE
+      IF (RAN .LT. EXCS) GO TO 100
+   41 CONTINUE
+      GO TO 80
+C
+ 50   CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+ 1003 FORMAT(' *CASX0* XI0 -INDUCED CASCADE,',
+     $ ' AVAIL. ENERGY',2X,F8.4,
+     $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+      IF (INT .EQ. 1) CALL TWOB(27,NFL,N)
+      IF (INT .EQ. 2) CALL GENXPT(27,NFL,N)
+      GO TO 9999
+C
+C *** ENERGETICALLY NOT POSSIBLE TO PRODUCE ONE EXTRA PION ***
+ 55   CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,1001)
+ 1001 FORMAT(' *CASX0* CASCADE ENERGETICALLY NOT POSSIBLE',
+     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+      GO TO 53
+C
+C *** EXCLUSIVE REACTION NOT FOUND ***
+ 80   CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,1004) RS,N
+ 1004 FORMAT(' *CASX0* XI0 -INDUCED CASCADE,',
+     $ ' EXCLUSIVE REACTION NOT FOUND',
+     $ ' TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,2X,
+     $ '<NTOT>',2X,F8.4)
+C
+ 53   CONTINUE
+      INT=1
+      NP=0
+      NM=0
+      NZ=0
+      IPA(1)=26
+      IPA(2)=14
+      IF (NFL .EQ. 2) IPA(2)=16
+      GO TO 120
+C
+C *** INELASTIC INTERACTION HAS OCCURRED ***
+C *** NUMBER OF SECONDARY MESONS DETERMINED BY KNO DISTRIBUTION ***
+ 100  CONTINUE
+      DO 101 I=1,60
+      IPA(I)=0
+ 101  CONTINUE
+C
+      IF (INT .LE. 0) GO TO 131
+C
+C --- TAKE TARGET NUCLEON TYPE INTO ACCOUNT ---
+      GO TO (102,112),NFL
+C
+C --- PROTON TARGET ---
+ 102  CONTINUE
+C --- CHECK FOR TOTAL CHARGE OF FINAL STATE MESONS TO DETERMINE ---
+C --- THE KIND OF BARYONS TO BE PRODUCED TAKING INTO ACCOUNT    ---
+C --- CHARGE AND STRANGENESS CONSERVATION                       ---
+      NCHT=NP-NM
+      IF (NCHT .LT. 1) GO TO 103
+      IF (NCHT .EQ. 1) GO TO 104
+      IF (NCHT .GT. 1) GO TO 105
+C
+ 103  CONTINUE
+C --- XI0 P ---
+      IPA(1)=26
+      IPA(2)=14
+      IF (NCHT .EQ. 0) GO TO 120
+C --- CHARGE MISMATCH ==> TAKE A S+ AND CORRECT THE STRANGENESS ---
+C --- BY REPLACING A PI- BY K- ---
+C --- S+ P ---
+      IPA(1)=20
+      IPA(2)=14
+      NVEFIX=1
+      GO TO 120
+C
+ 104  CONTINUE
+C --- XI0 N ---
+      IPA(1)=26
+      IPA(2)=16
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .LT. 0.5) GO TO 120
+C --- XI- P ---
+      IPA(1)=27
+      IPA(2)=14
+      GO TO 120
+C
+ 105  CONTINUE
+C --- XI- N ---
+      IPA(1)=27
+      IPA(2)=16
+      GO TO 120
+C
+C --- NEUTRON TARGET ---
+ 112  CONTINUE
+C --- CHECK FOR TOTAL CHARGE OF FINAL STATE MESONS TO DETERMINE ---
+C --- THE KIND OF BARYONS TO BE PRODUCED TAKING INTO ACCOUNT    ---
+C --- CHARGE AND STRANGENESS CONSERVATION                       ---
+      NCHT=NP-NM
+      IF (NCHT .LT. 0) GO TO 113
+      IF (NCHT .EQ. 0) GO TO 114
+      IF (NCHT .GT. 0) GO TO 115
+C
+ 113  CONTINUE
+C --- XI0 P ---
+      IPA(1)=26
+      IPA(2)=14
+      IF (NCHT .EQ. -1) GO TO 120
+C --- CHARGE MISMATCH ==> TAKE A S+ AND CORRECT THE STRANGENESS ---
+C --- BY REPLACING A PI- BY K- ---
+C --- S+ P ---
+      IPA(1)=20
+      IPA(2)=14
+      NVEFIX=1
+      GO TO 120
+C
+ 114  CONTINUE
+C --- XI0 N ---
+      IPA(1)=26
+      IPA(2)=16
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .LT. 0.5) GO TO 120
+C --- XI- P ---
+      IPA(1)=27
+      IPA(2)=14
+      GO TO 120
+C
+ 115  CONTINUE
+C --- XI- N ---
+      IPA(1)=27
+      IPA(2)=16
+C
+C --- TAKE PIONS FOR ALL SECONDARY MESONS ---
+C --- REPLACE PI BY K IN CASE OF STRANGENESS TO BE FIXED ---
+ 120  CONTINUE
+      NT=2
+C
+      IF (NP .EQ. 0) GO TO 122
+C
+C --- PI+ ---
+      DO 121 I=1,NP
+      NT=NT+1
+      IPA(NT)=7
+ 121  CONTINUE
+C
+ 122  CONTINUE
+      IF (NM .EQ. 0) GO TO 124
+C
+C --- PI- ---
+      DO 123 I=1,NM
+      NT=NT+1
+      IPA(NT)=9
+      IF (NVEFIX .GE. 1) IPA(NT)=13
+      IF (NPRT(4) .AND. (NVEFIX .GE. 1)) PRINT 3000
+ 3000 FORMAT(' *CASX0* K- INTRODUCED')
+      NVEFIX=NVEFIX-1
+ 123  CONTINUE
+C
+ 124  CONTINUE
+      IF (NZ .EQ. 0) GO TO 130
+C
+C --- PI0 ---
+      DO 125 I=1,NZ
+      NT=NT+1
+      IPA(NT)=8
+ 125  CONTINUE
+C
+C --- ALL SECONDARY PARTICLES HAVE BEEN DEFINED ---
+C --- NOW GO FOR MOMENTA AND X VALUES ---
+ 130  CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,2004) NT,(IPA(I),I=1,60)
+ 2004 FORMAT(' *CASX0* ',I3,' PARTICLES PRODUCED. MASS INDEX ARRAY : '/
+     $ 3(1H ,20(I3,1X)/))
+      GO TO 50
+C
+ 131  CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,2005)
+ 2005 FORMAT(' *CASX0* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+      END
+*-- AUTHOR :
+      FUNCTION CINEMA(EK1)
+C
+C *** INELASTICITY IN NUCLEAR INTERACTIONS AS A FUNCTION ***
+C *** OF ATOMIC NUMBER ATNO2 AND KINETIC ENERGY EK1 ***
+C *** NVE 12-JUL-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (14-OCT-1987)
+C
+C THE FUNCTIONAL DEPENDENCE AND THE PARAMETERS HAVE BEEN OBTAINED
+C BY STUDY OF VARIOUS NUCLEAR STRUCTURE MODELS.
+C BUT: IT IS OF COURSE AN INTERPOLATION AS FUNCTION OF ATOMIC
+C      NUMBER, FOR CERTAIN NUCLEI A DIFFERENT DESCRIPTION MAY BE
+C      MORE ADEQUATE. DETAILED TESTS HAVE BEEN PERFORMED FOR
+C      FE, CU, PB ,U AND SOME MIXTURES LIKE NAI, BGO, CONCRETE.
+C
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      CINEMA=0.0
+      ND=IND+1
+      ALA=LOG(ATNO2)
+      ALEK1=LOG(EK1)
+      SIG1=0.50
+      SIG2=0.50
+      EM=0.2390+0.0408*ALA**2
+      IF (EM. GT. 1.0) EM=1.0
+      CINEM=0.0019*ALA**3
+      IF(CINEM.GT.0.15) CINEM=0.15
+      IF (PARMAT(ND,10) .GE. 0.01) CINEM=CINEM*PARMAT(ND,10)
+C
+      IF (ALEK1 .GT. EM) GO TO 1
+C
+      CORR=-(ALEK1-EM)**2/(2.0*SIG1**2)
+      IF (CORR .LT. EXPXL) CORR=EXPXL
+      IF (CORR .GT. EXPXU) CORR=EXPXU
+      DUM1=-EK1*CINEM
+      DUM2=ABS(DUM1)
+      DUM3=EXP(CORR)
+      CINEMA=0.0
+      IF (DUM2 .GE. 1.0) CINEMA=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) CINEMA=DUM1*DUM3
+      GO TO 2
+C
+ 1    CONTINUE
+      CORR=-(ALEK1-EM)**2/(2.0*SIG2**2)
+      IF (CORR .LT. EXPXL) CORR=EXPXL
+      IF (CORR .GT. EXPXU) CORR=EXPXU
+      DUM1=-EK1*CINEM
+      DUM2=ABS(DUM1)
+      DUM3=EXP(CORR)
+      CINEMA=0.0
+      IF (DUM2 .GE. 1.0) CINEMA=DUM1*DUM3
+      IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) CINEMA=DUM1*DUM3
+C
+ 2    CONTINUE
+      IF (CINEMA .LT. -EK1) CINEMA=-EK1
+C
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE COHERT(IPPP,NFL,AVERN)
+C
+C *** GENERATION OF X- AND PT- VALUES FOR ALL PRODUCED PARTICLES ***
+C
+C
+C GENERATION OF DIFFRACTION DISSOCIATION AT HIGH ENERGIES
+C (NOT USED IN STANDARD VERSION)
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      COMMON/GENIN /TECM,AMASS(18),NPG,KGENEV
+      COMMON/GENOUT/PCM(5,18),WGT
+C
+C
+      REAL NUCSUP
+      DIMENSION SIDE(200),C1PAR(5),G1PAR(5),NUCSUP(5)
+      DIMENSION RNDM(3)
+      DATA C1PAR/0.6,0.6,0.35,0.15,0.10/
+      DATA G1PAR/2.6,2.6,1.8,1.30,1.20/
+      DATA NUCSUP/1.0,0.8,0.6,0.5,0.4/
+C     DATA CB/3.0/
+      DATA CB/0.01/
+      BPP(X)=5.000+0.300*LOG(X)
+
+C
+      MX =MXGKPV-20
+      MX1=MX+1
+      MX2=MX+2
+      MX3=MX+3
+      MX4=MX+4
+      MX5=MX+5
+      MX6=MX+6
+      MX7=MX+7
+      MX8=MX+8
+      EK=ENP(5)
+      EN=ENP(6)
+      P=ENP(7)
+      S=ENP(8)
+      RS=ENP(9)
+      CFA=0.025*((ATNO2-1.)/120.)*EXP(-(ATNO2-1.)/120.)
+      IF(P.LT.0.001) GOTO 60
+      NT=0
+C**
+      IREHMF=4
+      IF(IABS(IPA(1)).NE.IPART) IREHMF=5
+
+C** CHECK MASS-INDICES FOR ALL PARTICLES
+C**
+      DO 1 I=1,100
+      IF(IPA(I).EQ.0) GOTO 1
+      NT=NT+1
+      IPA(NT)=IPA(I)
+    1 CONTINUE
+      CALL VZERO(IPA(NT+1),MXGKCU-NT)
+C**
+C** SET THE EFFECTICE 4-MOMENTUM-VECTOR FOR INTERACTION
+C**
+      PV( 1,MXGKPV-1)=P*PX
+      PV( 2,MXGKPV-1)=P*PY
+      PV( 3,MXGKPV-1)=P*PZ
+      PV( 4,MXGKPV-1)=EN
+      PV( 5,MXGKPV-1)=AMAS
+      PV( 6,MXGKPV-1)=NCH
+      PV( 7,MXGKPV-1)=TOF
+      PV( 8,MXGKPV-1)=IPART
+      PV( 9,MXGKPV-1)=0.
+      PV(10,MXGKPV-1)=USERW
+      IER(48)=IER(48)+1
+C**
+C** DISTRIBUTE PARTICLES IN FORWARD AND BACKWARD HEMISPHERE OF CMS
+C** OF THE HADRON NUCLEON INTERACTION
+C**
+      SIDE(1)= 1.
+      SIDE(2)=-1.
+      TARG=0.
+      IFOR=1
+      IBACK=1
+      DO 3 I=1,NT
+      IF (I .LE. 2) GO TO 78
+      SIDE(I)= -1.
+      IF (SIDE(I) .LT. 0.) GO TO 76
+C
+C --- PARTICLE IN FORWARD HEMISPHERE ---
+ 77   CONTINUE
+      IFOR=IFOR+1
+      IF (IFOR .LE. 18) GO TO 78
+C
+C --- CHANGE IT TO BACKWARD ---
+      SIDE(I)=-1.
+      IFOR=IFOR-1
+      IBACK=IBACK+1
+      GO TO 78
+C
+C --- PARTICLE IN BACKWARD HEMISPHERE ---
+ 76   CONTINUE
+      IBACK=IBACK+1
+      IF (IBACK .LE. 18) GO TO 78
+C
+C --- CHANGE IT TO FORWARD ---
+      SIDE(I)=1.
+      IBACK=IBACK-1
+      IFOR=IFOR+1
+C**
+C** SUPPRESSION OF CHARGED PIONS FOR VARIOUS REASONS
+C**
+   78 IF(IPART.EQ.15.OR.IPART.GE.17) GOTO 3
+      IF(ABS(IPA(I)).GE.10) GOTO 3
+      IF(ABS(IPA(I)).EQ. 8) GOTO 3
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.(10.-P)/6.) GOTO 3
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.ATNO2/300.) GOTO 3
+      IPA(I)=14
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.ZNO2/ATNO2) IPA(I)=16
+      TARG=TARG+1.
+    3 CONTINUE
+      TB=2.*IBACK
+      CALL GRNDM(RNDM,1)
+      IF(RS.LT.(2.0+RNDM(1))) TB=(2.*IBACK+NT)/2.
+C**
+C** NUCLEONS + SOME PIONS FROM INTRANUCLEAR CASCADE
+C**
+      AFC=0.312+0.200*LOG(LOG(S))
+      XTARG=AFC*(ATNO2**0.33-1.0)*TB
+      IF(XTARG.LE.0.) XTARG=0.01
+      CALL POISSO(XTARG,NTARG)
+      NT2=NT+NTARG
+      IF(NT2.LE.MXGKPV-30) GOTO 2
+      NT2=MXGKPV-30
+      NTARG=NT2-NT
+    2 CONTINUE
+      IF(NPRT(4))
+     *WRITE(NEWBCD,3001) NTARG,NT
+      NT1=NT+1
+      IF(NTARG.EQ.0) GOTO 51
+      IPX=IFIX(P/3.)+1
+      IF(IPX.GT.5) IPX=5
+      DO 4 I=NT1,NT2
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IF(RAN.LT.NUCSUP(IPX)) GOTO 52
+      CALL GRNDM(RNDM,1)
+      IPA(I)=-(7+IFIX(RNDM(1)*3.0))
+      GOTO 4
+   52 IPA(I)=-16
+      PNRAT=1.-ZNO2/ATNO2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.PNRAT) IPA(I)=-14
+      TARG=TARG+1.
+    4 SIDE(I)=-2.
+      NT=NT2
+C**
+C** CHOOSE MASSES AND CHARGES FOR ALL PARTICLES
+C**
+   51 DO 5 I=1,NT
+      IPA1=ABS(IPA(I))
+      PV(5,I)=RMASS(IPA1)
+      PV(6,I)=RCHARG(IPA1)
+      PV(7,I)=1.
+      IF(PV(5,I).LT.0.) PV(7,I)=-1.
+      PV(5,I)=ABS(PV(5,I))
+    5 CONTINUE
+C**
+C** MARK LEADING STRANGE PARTICLES
+C**
+      LEAD=0
+      IF(IPART.LT.10.OR.IPART.EQ.14.OR.IPART.EQ.16) GOTO 6
+      IPA1=ABS(IPA(1))
+      IF(IPA1.LT.10.OR.IPA1.EQ.14.OR.IPA1.EQ.16) GOTO 531
+      LEAD=IPA1
+      GOTO 6
+  531 IPA1=ABS(IPA(2))
+      IF(IPA1.LT.10.OR.IPA1.EQ.14.OR.IPA1.EQ.16) GOTO 6
+      LEAD=IPA1
+C**
+C** CHECK AVAILABLE KINETIC ENERGY , CHANGE HEMISPHERE FOR PARTICLES
+C** UNTIL IT FITS
+C**
+    6 IF(NT.LE.1) GOTO 60
+      TAVAI=0.
+      DO 7 I=1,NT
+      IF(SIDE(I).LT.-1.5) GOTO 7
+      TAVAI=TAVAI+ABS(PV(5,I))
+    7 CONTINUE
+CJOK MODIFIED ACCORDING TO D.HECK
+      IF(TAVAI.LT.RS-0.00001) GOTO 12
+      IF(NPRT(4))
+     $ WRITE(NEWBCD,3002) (IPA(I),I=1,20),(SIDE(I),I=1,20),TAVAI,RS
+ 3002 FORMAT(' *COHERT* CHECK AVAILABLE ENERGIES'/
+     $ 1H ,20I5/1H ,20F5.0/1H ,'TAVAI,RS ',2F10.3)
+      DO 10 I=1,NT
+      II=NT-I+1
+      IF(SIDE(II).LT.-1.5) GOTO 10
+      IF(II.EQ.NT) GOTO 11
+      NT1=II+1
+      NT2=NT
+      DO 8 J=NT1,NT2
+      IPA(J-1)=IPA(J)
+      SIDE(J-1)=SIDE(J)
+      DO 8 K=1,10
+    8 PV(K,J-1)=PV(K,J)
+      GOTO 11
+   10 CONTINUE
+   11 SIDE(NT)=0.
+      IPA(NT)=0
+      NT=NT-1
+      GOTO 6
+   12 IF(NT.LE.1) GOTO 60
+      B=BPP(ATNO2)
+      IF(B.LT.CB) B=CB
+C**
+C** CHOOSE MASSES FOR THE 3 CLUSTER: 1. FORWARD CLUSTER
+C**   2. BACKWARD MESON CLUSTER  3. BACKWARD NUCLEON CLUSTER
+C**
+      RMC0=0.
+      RMD0=0.
+      RME0=0.
+      NTC=0
+      NTD=0
+      NTE=0
+      DO 31 I=1,NT
+      IF(SIDE(I).GT.0.) RMC0=RMC0+ABS(PV(5,I))
+      IF(SIDE(I).GT.0.) NTC =NTC +1
+      IF(SIDE(I).LT.0..AND.SIDE(I).GT.-1.5) RMD0=RMD0+ABS(PV(5,I))
+      IF(                  SIDE(I).LT.-1.5) RME0=RME0+ABS(PV(5,I))
+      IF(SIDE(I).LT.0..AND.SIDE(I).GT.-1.5) NTD =NTD +1
+      IF(                  SIDE(I).LT.-1.5) NTE =NTE +1
+   31 CONTINUE
+   32 CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      RMC=RMC0
+      IF(NTC.LE.1) GOTO 33
+      NTC1=NTC
+      IF(NTC1.GT.5) NTC1=5
+      RMC=-LOG(1.-RAN)
+      GPAR=G1PAR(NTC1)
+      CPAR=C1PAR(NTC1)
+      DUMNVE=GPAR
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      RMC=RMC0+RMC**CPAR/DUMNVE
+   33 RMD=RMD0
+      IF(NTD.LE.1) GOTO 34
+      NTD1=NTD
+      IF(NTD1.GT.5) NTD1=5
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      RMD=-LOG(1.-RAN)
+      GPAR=G1PAR(NTD1)
+      CPAR=C1PAR(NTD1)
+      DUMNVE=GPAR
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      RMD=RMD0+RMD**CPAR/DUMNVE
+   34 IF(RMC+RMD.LT.RS) GOTO 35
+      IF (RMC.LE.RMC0.AND.RMD.LE.RMD0) THEN
+         HNRMDC = 0.999*RS/(RMC+RMD)
+         RMD = RMD*HNRMDC
+         RMC = RMC*HNRMDC
+      ELSE
+         RMC=0.1*RMC0+0.9*RMC
+         RMD=0.1*RMD0+0.9*RMD
+      ENDIF
+      GOTO 34
+   35 IF(NTE.LE.0) GOTO 38
+      RME=RME0
+      IF(NTE.EQ.1) GOTO 38
+      NTE1=NTE
+      IF(NTE1.GT.5) NTE1=5
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      RME=-LOG(1.-RAN)
+      GPAR=G1PAR(NTE1)
+      CPAR=C1PAR(NTE1)
+      DUMNVE=GPAR
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      RME=RME0+RME**CPAR/DUMNVE
+C**
+C** SET BEAM , TARGET OF FIRST INTERACTION IN CMS
+C**
+   38 PV(1,MX1)=0.
+      PV(2,MX1)=0.
+      PV(3,MX1)=P
+      PV(5,MX1)=ABS(AMAS)
+      PV(4,MX1)=SQRT(P*P+AMAS*AMAS)
+      PV(1,MX2)=0.
+      PV(2,MX2)=0.
+      PV(3,MX2)=0.
+      PV(4,MX2)=MP
+      PV(5,MX2)=MP
+
+C** TRANSFORM INTO CMS.
+
+      CALL ADD(MX1,MX2,MX )
+      CALL LOR(MX1,MX ,MX1)
+      CALL LOR(MX2,MX ,MX2)
+      PF=(S+RMD*RMD-RMC*RMC)**2 - 4*S*RMD*RMD
+      IF(PF.LT.0.0001) PF=0.0001
+      DUMNVE=2.0*RS
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      PF=SQRT(PF)/DUMNVE
+      IF(NPRT(4)) WRITE(6,2002) PF,RMC,RMD,RS
+C**
+C** SET FINAL STATE MASSES AND ENERGIES IN CMS
+C**
+      PV(5,MX3)=RMC
+      PV(5,MX4)=RMD
+      PV(4,MX3)=SQRT(PF*PF+PV(5,MX3)*PV(5,MX3))
+      PV(4,MX4)=SQRT(PF*PF+PV(5,MX4)*PV(5,MX4))
+C**
+C** SET |T| AND |TMIN|
+C**
+      T=-1.0E10
+      CALL GRNDM(RNDM,1)
+      IF (B .NE. 0.0) T=LOG(1.-RNDM(1))/B
+      CALL LENGTX(MX1,PIN)
+      TACMIN=(PV(4,MX1)-PV(4,MX3))**2-(PIN-PF)**2
+C**
+C** CACULATE (SIN(TETA/2.)**2 AND COS(TETA), SET AZIMUTH ANGLE PHI
+C**
+      DUMNVE=4.0*PIN*PF
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      CTET=-(T-TACMIN)/DUMNVE
+      CTET=1.0-2.0*CTET
+      IF (CTET .GT. 1.0) CTET=1.0
+      IF (CTET .LT. -1.0) CTET=-1.0
+      DUMNVE=1.0-CTET*CTET
+      IF (DUMNVE .LT. 0.0) DUMNVE=0.0
+      STET=SQRT(DUMNVE)
+      CALL GRNDM(RNDM,1)
+      PHI=RNDM(1)*TWPI
+C**
+C** CALCULATE FINAL STATE MOMENTA IN CMS
+C**
+      PV(1,MX3)=PF*STET*SIN(PHI)
+      PV(2,MX3)=PF*STET*COS(PHI)
+      PV(3,MX3)=PF*CTET
+      PV(1,MX4)=-PV(1,MX3)
+      PV(2,MX4)=-PV(2,MX3)
+      PV(3,MX4)=-PV(3,MX3)
+C**
+C** SIMULATE BACKWARD NUCLEON CLUSTER IN LAB. SYSTEM AND TRANSFORM IN
+C** CMS.
+C**
+      IF(NTE.EQ.0) GOTO 28
+      GA=1.2
+      EKIT1=0.04
+      EKIT2=0.6
+      IF(EK.GT.5.) GOTO 666
+      EKIT1=EKIT1*EK**2/25.
+      EKIT2=EKIT2*EK**2/25.
+  666 A=(1.-GA)/(EKIT2**(1.-GA)-EKIT1**(1.-GA))
+      DO 29 I=1,NT
+      IF(SIDE(I).GT.-1.5) GOTO 29
+      CALL GRNDM(RNDM,3)
+      RAN=RNDM(1)
+      EKIT=(RAN*(1.-GA)/A+EKIT1**(1.-GA))**(1./(1.-GA))
+      PV(4,I)=EKIT+PV(5,I)
+      DUMNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP=SQRT(DUMNVE)
+      RAN=RNDM(2)
+      COST=LOG(2.23*RAN+0.383)/0.96
+      IF (COST .LT. -1.0) COST=-1.0
+      IF (COST .GT. 1.0) COST=1.0
+      DUMNVE=1.0-COST*COST
+      IF (DUMNVE .LT. 0.0) DUMNVE=0.0
+      SINT=SQRT(DUMNVE)
+      PHI=TWPI*RNDM(3)
+      PV(1,I)=PP*SINT*SIN(PHI)
+      PV(2,I)=PP*SINT*COS(PHI)
+      PV(3,I)=PP*COST
+      CALL LOR(I,MX ,I)
+   29 CONTINUE
+C**
+C** FRAGMENTATION OF FORWARD CLUSTER AND BACKWARD MESON CLUSTER
+C**
+   28 PV(1,1)=PV(1,MX3)
+      PV(2,1)=PV(2,MX3)
+      PV(3,1)=PV(3,MX3)
+      PV(4,1)=PV(4,MX3)
+      PV(1,2)=PV(1,MX4)
+      PV(2,2)=PV(2,MX4)
+      PV(3,2)=PV(3,MX4)
+      PV(4,2)=PV(4,MX4)
+      DO 17 I=MX5,MX6
+      DO 16 J=1,3
+   16 PV(J,I)=-PV(J,I-2)
+      DO 17 J=4,5
+   17 PV(J,I)= PV(J,I-2)
+      KGENEV=1
+      IF(NTC.LE.1) GOTO 26
+      TECM= PV(5,MX3)
+      NPG=0
+      DO 18 I=1,NT
+      IF(SIDE(I).LT.0.) GOTO 18
+      NPG=NPG+1
+      AMASS(NPG)=ABS(PV(5,I))
+   18 CONTINUE
+      IF(NPRT(4)) WRITE(NEWBCD,2004) TECM,NPG,(AMASS(I),I=1,NPG)
+      CALL PHASP
+      NPG=0
+      DO 19 I=1,NT
+      IF(SIDE(I).LT.0.) GOTO 19
+      NPG=NPG+1
+      PV(1,I)=PCM(1,NPG)
+      PV(2,I)=PCM(2,NPG)
+      PV(3,I)=PCM(3,NPG)
+      PV(4,I)=PCM(4,NPG)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      CALL LOR(I,MX5,I)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+   19 CONTINUE
+   26 IF(NTD.LE.1) GOTO 27
+      TECM= PV(5,MX4)
+      NPG=0
+      DO 20 I=1,NT
+      IF(SIDE(I).GT.0..OR.SIDE(I).LT.-1.5) GOTO 20
+      NPG=NPG+1
+      AMASS(NPG)=ABS(PV(5,I))
+   20 CONTINUE
+      IF(NPRT(4)) WRITE(NEWBCD,2004) TECM,NPG,(AMASS(I),I=1,NPG)
+      CALL PHASP
+      NPG=0
+      DO 21 I=1,NT
+      IF(SIDE(I).GT.0..OR.SIDE(I).LT.-1.5) GOTO 21
+      NPG=NPG+1
+      PV(1,I)=PCM(1,NPG)
+      PV(2,I)=PCM(2,NPG)
+      PV(3,I)=PCM(3,NPG)
+      PV(4,I)=PCM(4,NPG)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      CALL LOR(I,MX6,I)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+   21 CONTINUE
+C**
+C** LORENTZ TRANSFORMATION IN LAB SYSTEM
+C**
+   27 TARG=0.
+      DO 36 I=1,NT
+      IF(PV(5,I).GT.0.5) TARG=TARG+1.
+      CALL LOR(I,MX2,I)
+   36 CONTINUE
+      IF(TARG.LT.0.5) TARG=1.
+C**
+C** SOMETIMES THE LEADING STRANGE PARTICLES ARE LOST , SET THEM BACK
+C**
+      IF(LEAD.EQ.0) GOTO 6085
+      DO 6081 I=1,NT
+      IF(ABS(IPA(I)).EQ.LEAD) GOTO 6085
+ 6081 CONTINUE
+      I=1
+      IF(LEAD.GE.14.AND.ABS(IPA(2)).GE.14) I=2
+      IF(LEAD.LT.14.AND.ABS(IPA(2)).LT.14) I=2
+      IPA(I)=LEAD
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      PV(5,I)=RMASS(LEAD)
+      PV(7,I)=1.
+      IF(PV(5,I).LT.0.) PV(7,I)=-1.
+      PV(5,I)=ABS(PV(5,I))
+      PV(6,I)=RCHARG(LEAD)
+      PV(4,I)=PV(5,I)+EKIN
+      CALL LENGTX(I,PP)
+      DUMNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP1=SQRT(DUMNVE)
+C
+      IF (PP .GE. 1.0E-6) GO TO 8000
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP1*COS(RTHNVE)
+      GO TO 8001
+ 8000 CONTINUE
+      PV(1,I)=PV(1,I)*PP1/PP
+      PV(2,I)=PV(2,I)*PP1/PP
+      PV(3,I)=PV(3,I)*PP1/PP
+ 8001 CONTINUE
+C
+C** FOR VARIOUS REASONS, THE ENERGY BALANCE IS NOT SUFFICIENT,
+C** CHECK THAT,  ENERGY BALANCE, ANGLE OF FINAL SYSTEM E.T.C.
+ 6085 KGENEV=1
+      PV(1,MX4)=0.
+      PV(2,MX4)=0.
+      PV(3,MX4)=P
+      PV(4,MX4)=SQRT(P*P+AMAS*AMAS)
+      PV(5,MX4)=ABS(AMAS)
+      EKIN0=PV(4,MX4)-PV(5,MX4)
+      PV(1,MX5)=0.
+      PV(2,MX5)=0.
+      PV(3,MX5)=0.
+      PV(4,MX5)=MP*TARG
+      PV(5,MX5)=PV(4,MX5)
+      EKIN=PV(4,MX4)+PV(4,MX5)
+      I=MX4
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      I=MX5
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      CALL ADD(MX4,MX5,MX6)
+      CALL LOR(MX4,MX6,MX4)
+      CALL LOR(MX5,MX6,MX5)
+      TECM=PV(4,MX4)+PV(4,MX5)
+      NPG=NT
+      PV(1,MX8)=0.
+      PV(2,MX8)=0.
+      PV(3,MX8)=0.
+      PV(4,MX8)=0.
+      PV(5,MX8)=0.
+      EKIN1=0.
+      DO 598 I=1,NPG
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+      CALL ADD(MX8,I,MX8)
+      EKIN1=EKIN1+PV(4,I)-PV(5,I)
+      EKIN=EKIN-PV(5,I)
+      IF(I.GT.18) GOTO 598
+      AMASS(I)=PV(5,I)
+  598 CONTINUE
+      IF(NPG.GT.18) GOTO 597
+      CALL PHASP
+      EKIN=0.
+      DO 599 I=1,NPG
+      PV(1,MX7)=PCM(1,I)
+      PV(2,MX7)=PCM(2,I)
+      PV(3,MX7)=PCM(3,I)
+      PV(4,MX7)=PCM(4,I)
+      PV(5,MX7)=AMASS(I)
+      CALL LOR(MX7,MX5,MX7)
+  599 EKIN=EKIN+PV(4,MX7)-PV(5,MX7)
+      CALL ANG(MX8,MX4,COST,TETA)
+      IF(NPRT(4)) WRITE(NEWBCD,2003) TETA,EKIN0,EKIN1,EKIN
+C**
+C** MAKE SHURE, THAT  KINETIC ENERGIES ARE CORRECT
+C** THE 3. CLUSTER IS NOT PRODUCED WITHIN PROPER KINEMATICS!!!
+C** EKIN= KINETIC ENERGY THEORETICALLY
+C** EKIN1= KINETIC ENERGY SIMULATED
+C**
+  597 EKIN1=0.
+      IF(EKIN1.EQ.0.) GOTO 600
+      PV(1,MX7)=0.
+      PV(2,MX7)=0.
+      PV(3,MX7)=0.
+      PV(4,MX7)=0.
+      PV(5,MX7)=0.
+      WGT=EKIN/EKIN1
+      EKIN1=0.
+      DO 602 I=1,NT
+      EKIN=PV(4,I)-PV(5,I)
+      EKIN=EKIN*WGT
+      PV(4,I)=EKIN+PV(5,I)
+      DUMNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP=SQRT(DUMNVE)
+      CALL LENGTX(I,PP1)
+C
+      IF (PP1 .GE. 1.0E-6) GO TO 8002
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP*COS(RTHNVE)
+      GO TO 8003
+ 8002 CONTINUE
+      PV(1,I)=PV(1,I)*PP/PP1
+      PV(2,I)=PV(2,I)*PP/PP1
+      PV(3,I)=PV(3,I)*PP/PP1
+ 8003 CONTINUE
+C
+      EKIN1=EKIN1+EKIN
+      CALL ADD(MX7,I,MX7)
+  602 CONTINUE
+      CALL ANG(MX7,MX4,COST,TETA)
+      IF(NPRT(4)) WRITE(NEWBCD,2003) TETA,EKIN0,EKIN1
+C**
+C** ROTATE IN DIRECTION OF Z-AXIS, SEE COMMENTS IN 'GENXPT'
+C**
+  600 PV(1,MX7)=0.
+      PV(2,MX7)=0.
+      PV(3,MX7)=0.
+      PV(4,MX7)=0.
+      PV(5,MX7)=0.
+      DO 596 I=1,NT
+      CALL ADD(MX7,I,MX7)
+  596 CONTINUE
+*          CALL RANNOR(RAN1,RAN2)
+      CALL GRNDM(RNDM,2)
+      RY=RNDM(1)
+      RZ=RNDM(2)
+      RX=6.283185*RZ
+      A1=SQRT(-2.*LOG(RY))
+      RAN1=A1*SIN(RX)
+      RAN2=A1*COS(RX)
+      PV(1,MX7)=PV(1,MX7)+RAN1*0.020*TARG
+      PV(2,MX7)=PV(2,MX7)+RAN2*0.020*TARG
+      CALL DEFS(MX4,MX7,MX8)
+      PV(1,MX7)=0.
+      PV(2,MX7)=0.
+      PV(3,MX7)=0.
+      PV(4,MX7)=0.
+      PV(5,MX7)=0.
+C     DO 595 I=1,NT
+C     CALL TRAC(I,MX8,I)
+C 595 CALL ADD(MX7,I,MX7)
+C     CALL ANG(MX7,MX4,COST,TETA)
+      IF(NPRT(4)) WRITE(NEWBCD,2003) TETA
+C**
+C** ROTATE IN DIRECTION OF PRIMARY PARTICLE
+C**
+      DEKIN=0.
+      NPIONS=0
+      EK1=0.
+      DO 25 I=1,NT
+      CALL DEFS1(I,MXGKPV-1,I)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+      IF(ATNO2.LT.1.5) GOTO 25
+      CALL LENGTX(I,PP)
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      CALL NORMAL(RAN)
+      EKIN=EKIN-CFA*(1.+0.5*RAN)
+      IF (EKIN .LT. 1.0E-6) EKIN=1.0E-6
+      CALL STEEQ(XXH,I)
+      DEKIN=DEKIN+EKIN*(1.-XXH)
+      EKIN=EKIN*XXH
+      IF(ABS(IPA(I)).GE.7.AND.ABS(IPA(I)).LE.9) NPIONS=NPIONS+1
+      IF(ABS(IPA(I)).GE.7.AND.ABS(IPA(I)).LE.9) EK1=EK1+EKIN
+      PP1=SQRT(EKIN*(EKIN+2.*ABS(PV(5,I))))
+      PV(4,I)=EKIN+ABS(PV(5,I))
+C
+      IF (PP .GE. 1.0E-6) GO TO 8004
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP1*COS(RTHNVE)
+      GO TO 8005
+ 8004 CONTINUE
+      PV(1,I)=PV(1,I)*PP1/PP
+      PV(2,I)=PV(2,I)*PP1/PP
+      PV(3,I)=PV(3,I)*PP1/PP
+ 8005 CONTINUE
+C
+   25 CONTINUE
+      EK1=0.
+      IF(EK1.EQ.0.) GOTO 23
+      IF(NPIONS.LE.0) GOTO 23
+      DEKIN=1.+DEKIN/EK1
+      DO 22 I=1,NT
+      IF(ABS(IPA(I)).LT.7.OR.ABS(IPA(I)).GT.9) GOTO 22
+      CALL LENGTX(I,PP)
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      EKIN=EKIN*DEKIN
+      IF (EKIN .LT. 1.0E-6) EKIN=1.0E-6
+      PP1=SQRT(EKIN*(EKIN+2.*ABS(PV(5,I))))
+      PV(4,I)=EKIN+ABS(PV(5,I))
+C
+      IF (PP .GE. 1.0E-6) GO TO 8006
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP1*COS(RTHNVE)
+      GO TO 8007
+ 8006 CONTINUE
+      PV(1,I)=PV(1,I)*PP1/PP
+      PV(2,I)=PV(2,I)*PP1/PP
+      PV(3,I)=PV(3,I)*PP1/PP
+ 8007 CONTINUE
+C
+   22 CONTINUE
+   23 IGEN=0
+      IF(ATNO2.LT.1.5) GOTO 40
+C**
+C** ADD BLACK TRACK PARTICLES
+C**
+      CALL HIGHAB(SPROB)
+      TEX=ENP(1)
+      SPALL=TARG
+      IF(TEX.LT.0.001) GOTO 445
+      BLACK=(1.5+1.25*TARG)*ENP(1)/(ENP(1)+ENP(3))
+      CALL POISSO(BLACK,NBL)
+      IF(NPRT(4))
+     *WRITE(NEWBCD,3003) NBL,TEX
+      IF(IFIX(TARG)+NBL.GT.ATNO2) NBL=ATNO2-TARG
+      IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
+      IF(NBL.LE.0) GOTO 445
+      EKIN=TEX/NBL
+      EKIN2=0.
+      CALL STEEP(XX)
+      DO 441 I=1,NBL
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SPROB) GOTO 441
+      IF(NT.EQ.MXGKPV-2) GOTO 441
+      IF(EKIN2.GT.TEX) GOTO 443
+      CALL GRNDM(RNDM,1)
+      RAN1=RNDM(1)
+      CALL NORMAL(RAN2)
+      EKIN1=-EKIN*LOG(RAN1)-CFA*(1.+0.5*RAN2)
+      IF(EKIN1.LT.0.0) EKIN1=-0.010*LOG(RAN1)
+      EKIN1=EKIN1*XX
+      EKIN2=EKIN2+EKIN1
+      IF(EKIN2.GT.TEX) EKIN1=TEX-(EKIN2-EKIN1)
+      IF (EKIN1 .LT. 0.0) EKIN1=1.0E-6
+      IPA1=16
+      PNRAT=1.-ZNO2/ATNO2
+      CALL GRNDM(RNDM,3)
+      IF(RNDM(1).GT.PNRAT) IPA1=14
+      NT=NT+1
+      SPALL=SPALL+1.
+      COST=-1.0+RNDM(2)*2.0
+      DUMNVE=1.0-COST*COST
+      IF (DUMNVE .LT. 0.0) DUMNVE=0.0
+      SINT=SQRT(DUMNVE)
+      PHI=TWPI*RNDM(3)
+      IPA(NT)=-IPA1
+      SIDE(NT)=-4.
+      PV(5,NT)=ABS(RMASS(IPA1))
+      PV(6,NT)=RCHARG(IPA1)
+      PV(7,NT)=1.
+      PV(4,NT)=EKIN1+PV(5,NT)
+      DUMNVE=ABS(PV(4,NT)**2-PV(5,NT)**2)
+      PP=SQRT(DUMNVE)
+      PV(1,NT)=PP*SINT*SIN(PHI)
+      PV(2,NT)=PP*SINT*COS(PHI)
+      PV(3,NT)=PP*COST
+  441 CONTINUE
+  443 IF(ATNO2.LT.10.) GOTO 445
+      IF(EK.GT.2.0) GOTO 445
+      II=NT+1
+      KK=0
+      EKA=EK
+      IF(EKA.GT.1.) EKA=EKA*EKA
+      IF(EKA.LT.0.1) EKA=0.1
+      IKA=3.6*EXP((ZNO2**2/ATNO2-35.56)/6.45)/EKA
+      IF(IKA.LE.0) GO TO 445
+      DO 444 I=1,NT
+      II=II-1
+      IF(IPA(II).NE.-14) GOTO 444
+      IPA(II)=-16
+      IPA1  = 16
+      PV(5,II)=ABS(RMASS(IPA1))
+      PV(6,II)=RCHARG(IPA1)
+      KK=KK+1
+      IF(KK.GT.IKA) GOTO 445
+  444 CONTINUE
+  445 TEX=ENP(3)
+      IF(TEX.LT.0.001) GOTO 40
+      BLACK=(1.5+1.25*TARG)*ENP(3)/(ENP(1)+ENP(3))
+      CALL POISSO(BLACK,NBL)
+      IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
+      IF(NBL.LE.0) GOTO 40
+      EKIN=TEX/NBL
+      EKIN2=0.
+      CALL STEEP(XX)
+      IF(NPRT(4))
+     *WRITE(NEWBCD,3004) NBL,TEX
+      DO 442 I=1,NBL
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SPROB) GOTO 442
+      IF(NT.EQ.MXGKPV-2) GOTO 442
+      IF(EKIN2.GT.TEX) GOTO 40
+      CALL GRNDM(RNDM,1)
+      RAN1=RNDM(1)
+      CALL NORMAL(RAN2)
+      EKIN1=-EKIN*LOG(RAN1)-CFA*(1.+0.5*RAN2)
+      IF(EKIN1.LT.0.0) EKIN1=-0.005*LOG(RAN1)
+      EKIN1=EKIN1*XX
+      EKIN2=EKIN2+EKIN1
+      IF(EKIN2.GT.TEX) EKIN1=TEX-(EKIN2-EKIN1)
+      IF (EKIN1 .LT. 0.0) EKIN1=1.0E-6
+      CALL GRNDM(RNDM,3)
+      COST=-1.0+RNDM(1)*2.0
+      DUMNVE=1.0-COST*COST
+      IF (DUMNVE .LT. 0.0) DUMNVE=0.0
+      SINT=SQRT(DUMNVE)
+      PHI=TWPI*RNDM(2)
+      RAN=RNDM(3)
+      IPA(NT+1)=-30
+      IF(RAN.GT.0.60) IPA(NT+1)=-31
+      IF(RAN.GT.0.90) IPA(NT+1)=-32
+      SIDE(NT+1)=-4.
+      PV(5,NT+1)=(ABS(IPA(NT+1))-28)*MP
+      SPALL=SPALL+PV(5,NT+1)*1.066
+      IF(SPALL.GT.ATNO2) GOTO 40
+      NT=NT+1
+      PV(6,NT)=1.
+      IF(IPA(NT).EQ.-32) PV(6,NT)=2.
+      PV(7,NT)=1.
+      PV(4,NT)=PV(5,NT)+EKIN1
+      DUMNVE=ABS(PV(4,NT)**2-PV(5,NT)**2)
+      PP=SQRT(DUMNVE)
+      PV(1,NT)=PP*SINT*SIN(PHI)
+      PV(2,NT)=PP*SINT*COS(PHI)
+      PV(3,NT)=PP*COST
+  442 CONTINUE
+C**
+C** STORE ON EVENT COMMON
+C**
+   40 CALL GRNDM(RNDM,1)
+      IF(RS.GT.(4.+RNDM(1)*1.)) GOTO 42
+      DO 41 I=1,NT
+      CALL LENGTX(I,ETB)
+      IF(ETB.LT.P) GOTO 41
+      ETF=P
+      PV(4,I)=SQRT(PV(5,I)**2+ETF**2)
+      DUMNVE=ETB
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      ETF=ETF/DUMNVE
+      PV(1,I)=PV(1,I)*ETF
+      PV(2,I)=PV(2,I)*ETF
+      PV(3,I)=PV(3,I)*ETF
+   41 CONTINUE
+   42 EKIN=PV(4,MXGKPV)-ABS(PV(5,MXGKPV))
+      EKIN1=PV(4,MXGKPV-1)-ABS(PV(5,MXGKPV-1))
+      EKIN2=0.
+      CALL TDELAY(TOF1)
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      TOF=TOF-TOF1*LOG(RAN)
+      DO 44 I=1,NT
+      EKIN2=EKIN2+PV(4,I)-ABS(PV(5,I))
+      IF(PV(7,I).LT.0.) PV(5,I)=-PV(5,I)
+      PV(7,I)=TOF
+      PV(8,I)=ABS(IPA(I))
+      PV(9,I)=0.
+   44 PV(10,I)=0.
+      IF(NPRT(4)) WRITE(NEWBCD,2006) NT,EKIN,ENP(1),ENP(3),EKIN1,EKIN2
+      INTCT=INTCT+1.
+      NMODE=3
+      IF(SPALL.LT.0.5.AND.ATNO2.GT.1.5) NMODE=14
+      CALL SETCUR(NT)
+      NTK=NTK+1
+      IF(NT.EQ.1) GOTO 300
+      DO 50 II=2,NT
+      I=II-1
+      IF(NTOT.LT.NSIZE/12) GOTO 43
+      GO TO 9999
+   43 CALL SETTRK(I)
+   50 CONTINUE
+ 300  CONTINUE
+      GO TO 9999
+C**
+C** IT IS NOT POSSIBLE TO PRODUCE A PROPER TWO CLUSTER FINAL STATE.
+C** CONTINUE WITH QUASI ELASTIC SCATTERING
+C**
+   60 IF(NPRT(4)) WRITE(NEWBCD,2005)
+      DO 61 I=3,MXGKCU
+   61 IPA(I)=0
+      IPA(1)=IPART
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      CALL TWOB(IPPP,NFL,AVERN)
+      GO TO 9999
+C
+ 2000 FORMAT(' *COHERT* CMS PARAMETERS OF FINAL STATE PARTICLES',
+     $ ' AFTER ',I3,' TRIALS')
+ 2001 FORMAT(' *COHERT* TRACK',2X,I3,2X,10F8.2,2X,I3,2X,F3.0)
+ 2002 FORMAT(' *COHERT* MOMENTUM ',F8.3,' MASSES ',2F8.4,' RS ',F8.4)
+ 2003 FORMAT(' *COHERT* TETA,EKIN0,EKIN1,EKIN ',4F10.4)
+ 2004 FORMAT(' *COHERT* TECM,NPB,MASSES: ',F10.4,1X,I3,1X,8F10.4/
+     $ 1H ,26X,15X,8F10.4)
+ 2005 FORMAT(' *COHERT* NUMBER OF FINAL STATE PARTICLES',
+     $ ' LESS THAN 2 ==> CONTINUE WITH 2-BODY SCATTERING')
+ 2006 FORMAT(' *COHERT*  COMP.',1X,I5,1X,5F7.2)
+ 3001 FORMAT(' *COHERT* NUCLEAR EXCITATION ',I5,' PARTICLES PRODUCED',
+     $ ' IN ADDITION TO',I5,' NORMAL PARTICLES')
+ 3003 FORMAT(' *COHERT* ',I3,' BLACK TRACK PARTICLES PRODUCED',
+     $ ' WITH TOTAL KINETIC ENERGY OF ',F8.3,' GEV')
+ 3004 FORMAT(' *COHERT* ',I5,' HEAVY FRAGMENTS WITH TOTAL ENERGY OF ',
+     $ F8.4,' GEV')
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE CORANH(NIHIL,NFL)
+C
+C *** NUCLEAR INTERACTIONS FOR HEAVY FRAGMENTS ***
+C *** NVE 06-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (09-JULY-1987)
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+C
+      NIHIL=0
+      IF(AMAS.GT.0.)   GO TO 9999
+      IF(IPART.LT.14)  GO TO 9999
+      IF(IPA(1).GE.14) GO TO 9999
+      IF(IPA(2).GE.14) GO TO 9999
+      NIHIL=1
+C**
+C**  DO NOT BE CONFUSED, THIS HAS NOTHING TO DO WITH RELATIVISTIC
+C**  KINEMATIC
+C
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      EKCOR=1.
+      IF(EK.GT.1.) EKCOR=1./EK
+      EK=2.*TARMAS+EK*(1.+EKCOR/ATNO2)
+      EN=EK+ABS(AMAS)
+      P =SQRT(ABS(EN*EN-AMAS*AMAS))
+      S =AMAS*AMAS+TARMAS**2+2.0*TARMAS*EN
+      RS=SQRT(S)
+      ENP(5)=EK
+      ENP(6)=EN
+      ENP(7)=P
+      ENP(8)=S
+      ENP(9)=RS
+C**
+C**  EVAPORATION
+C**
+      TKIN=EXNU(EK)
+      ENP(5)=EK-TKIN
+      IF(ENP(5).LT.0.0001) ENP(5)=0.0001
+      ENP(6)=ENP(5)+ABS(AMAS)
+      ENP(7)=ENP(6)*ENP(6)-AMASQ
+      ENP(7)=SQRT(ABS(ENP(7)))
+      ENP(8)=AMASQ+RMASS(14)**2+2.*RMASS(14)*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+C**  CHECK AVAILABLE ENERGY FOR FIRST INTERACTION
+      IF(ENP(5).GT.CENG(3)) GO TO 9999
+      ENP(5)=0.
+      ENP(6)=ABS(AMAS)
+      ENP(7)=0.
+      ENP(8)=4.*RMASS(14)**2
+      ENP(9)=2.*RMASS(14)
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE COSCAT
+C
+C *** MOMENTUM GENERATION FOR COHERENT ELASTIC SCATTERING ***
+C *** NVE 13-JUL-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (03-DEC-1986)
+C
+C APPROXIMATION OF BESSEL FUNCTION FOR TETA(LAB)<=20 DEG.
+C IS USED . THE NUCLEAR RADIUS IS TAKEN AS R=1.25*E-13*(A)**1/3FM
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      COMMON/COSCOM/AA,BB,CC,DD,RR
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C
+      EXTERNAL FCTCOS
+      DIMENSION FF(20),ATNOX(3)
+      DIMENSION RNDM(1)
+C
+      DATA ATNOX/9.,56.,207./
+C
+C --- INITIALIZATION INDICATED BY KGINIT(14) ---
+      IF (KGINIT(14) .NE. 0) GO TO 10
+      KGINIT(14)=1
+C
+      IF(.NOT.NPRT(10)) GOTO 10
+      WRITE(NEWBCD,2001)
+ 2001 FORMAT(1H ,'*COSCAT* DS/DT FOR COHERENT ELASTIC SCATTERING')
+      DO 3 L=1,3
+      WRITE(NEWBCD,2003) ATNOX(L),P
+ 2003 FORMAT(1H ,'*COSCAT* CALCULATED CROSS SECTIONS FOR A=',
+     *             F5.1,' AND P=',F8.2)
+      DO 2 I=1,20
+      TETA=(I-1)*PI/360.
+      T=2.*P**2*(1.-COS(TETA*1.D0))
+      IF(ATNOX(L).GT.62.) GOTO 4
+      FF(I)=TWPI*ATNOX(L)**1.63*EXP(-14.5D0*ATNOX(L)**0.65*T)
+     *     +TWPI*1.4*ATNOX(L)**0.33*EXP(-10.D0*T)
+      GOTO 2
+    4 FF(I)=TWPI*ATNOX(L)**1.33*EXP(-60.0D0*ATNOX(L)**0.33*T)
+     *     +TWPI*0.4*ATNOX(L)**0.40*EXP(-10.D0*T)
+    2 CONTINUE
+      WRITE(NEWBCD,2004) FF
+ 2004 FORMAT(1H ,10E12.3)
+    3 CONTINUE
+   10 IF(P.LT.0.01) GO TO 9999
+      IF(ATNO2.LT.0.5) GO TO 9999
+      IER(46)=IER(46)+1
+      RAN=RANRES(DUM)
+      CALL VZERO(IPA(1),MXGKCU)
+      IPA(1)=IPART
+      IF(ATNO2.GT.62.) GOTO 11
+      AA=ATNO2**1.63
+      BB=14.5*ATNO2**0.66
+      CC=1.4*ATNO2**0.33
+      DD=10.
+      AA=AA/BB
+      CC=CC/DD
+      RR=(AA+CC)*RAN
+      GOTO 12
+   11 AA=ATNO2**1.33
+      BB=60.*ATNO2**0.33
+      CC=0.4*ATNO2**0.40
+      DD=10.
+      AA=AA/BB
+      CC=CC/DD
+      RR=(AA+CC)*RAN
+   12 T1=-LOG(RAN)/BB
+      T2=-LOG(RAN)/DD
+      EPS=0.001
+      IND1=10
+      CALL RTMI(T,VAL,FCTCOS,T1,T2,EPS,IND1,IER1)
+      IF(IER1.EQ.0) GOTO 14
+      T=0.25*(3.*T1+T2)
+      IER(68)=IER(68)+1
+   14 CALL GRNDM(RNDM,1)
+      PHI=RNDM(1)*TWPI
+      RR=0.5*T/P**2
+      IF(RR.GT.1.) RR=0.
+      COST=1.-RR
+*     SINT=SQRT(MAX((1.-COST)*(1.+COST),0.))
+      SINT=SQRT(MAX(RR*(2.-RR),0.))
+      IF(SINT.NE.0.) THEN
+      PV( 1,MXGKPV-1)=P*PX
+      PV( 2,MXGKPV-1)=P*PY
+      PV( 3,MXGKPV-1)=P*PZ
+      PV( 4,MXGKPV-1)=EN
+      PV( 5,MXGKPV-1)=AMAS
+      PV( 6,MXGKPV-1)=NCH
+      PV( 7,MXGKPV-1)=TOF
+      PV( 8,MXGKPV-1)=IPART
+      PV( 9,MXGKPV-1)=0.
+      PV(10,MXGKPV-1)=USERW
+      PV(1,1)=P*SINT*SIN(PHI)
+      PV(2,1)=P*SINT*COS(PHI)
+      PV(3,1)=P*COST
+      PV(4,1)=EN
+      PV(5,1)=AMAS
+      PV(6,1)=NCH
+      PV(7,1)=TOF
+      PV(8,1)=IPART
+      PV(9,1)=0.
+      PV(10,1)=0.
+      CALL DEFS1(1,MXGKPV-1,1)
+      SINL1=SINL
+      COSL1=COSL
+      SINP1=SINP
+      COSP1=COSP
+      CALL SETCUR(1)
+      ELSE
+      SINL1=SINL
+      COSL1=COSL
+      SINP1=SINP
+      COSP1=COSP
+      ENDIF
+      IF(NPRT(4))
+     *WRITE(NEWBCD,1004) AMAS,P,SINL1,COSL1,SINP1,COSP1,SINL,COSL,
+     *                   SINP,COSP,T1,T,T2,IER1
+C
+ 1004 FORMAT(1H ,'*COSCAT* COHERENT ELASTIC SCATTERING    MASS '
+     * ,F8.3,' MOMENTUM '
+     * ,F8.3/,'   DIRECTION ',4F10.4,' CHANGED TO ',4F10.4/
+     *1H ,'T1,T,T2 ',3E10.3,' IER1 ',I2)
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE DEFS1(I,J,K)
+C
+C *** NVE 16-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (15-JAN-1984)
+C
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DATA PI/3.141592653589793/
+      PX=PV(1,I)
+      PY=PV(2,I)
+      PZ=PV(3,I)
+      PT2 = PV(1,J)**2+PV(2,J)**2
+      IF(PT2.GT.0.) THEN
+      CALL LENGTX(J,P)
+      COST=PV(3,J)/P
+      SINT1=SQRT(ABS((1.-COST)*(1.+COST)))
+      SINT2=SQRT(PT2)/P
+      SINT=0.5*(SINT1+SINT2)
+      PH=PI*0.5
+      IF(PV(2,J).LT.0.) PH=PI*1.5
+      IF(ABS(PV(1,J)).GT.1.E-6) PH=ATAN2(PV(2,J),PV(1,J))
+      COSP=COS(PH)
+      SINP=SIN(PH)
+      PV(1,K)= COST*COSP*PX-     SINP*PY+SINT*COSP*PZ
+      PV(2,K)= COST*SINP*PX+     COSP*PY+SINT*SINP*PZ
+      PV(3,K)=-SINT     *PX             +COST     *PZ
+      ELSE
+      PV(1,K)=PX
+      PV(2,K)=PY
+      PV(3,K)=PZ
+C --- TAKE THE CASE OF THETA=PI INTO ACCOUNT (MR/NVE 27-SEP-1990) ---
+      IF (PV(3,J) .LT. 0.) PV(3,K)=-PZ
+      ENDIF
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE DLPNUC(A,N)
+C
+C CALLED BY : PHPNUC
+C ORIGIN    : H.FESEFELDT
+C
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+C
+      DIMENSION A(N)
+      DIMENSION LT(20),RT(20)
+      INTEGER R,RT
+C
+      LEVEL=1
+      LT(1)=1
+      RT(1)=N
+   10 L=LT(LEVEL)
+      R=RT(LEVEL)
+      LEVEL=LEVEL-1
+   20 IF(R.LE.L) IF(LEVEL) 50,50,10
+C
+C   SUBDIVIDE THE INTERVAL L,R
+C     L : LOWER LIMIT OF THE INTERVAL (INPUT)
+C     R : UPPER LIMIT OF THE INTERVAL (INPUT)
+C     J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT)
+C     I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT)
+C
+      I=L
+      J=R
+      M=(L+R)/2
+      X=A(M)
+  220 IF(A(I).GE.X) GO TO 230
+      I=I+1
+      GO TO 220
+  230 IF(A(J).LE.X) GO TO 231
+      J=J-1
+      GO TO 230
+C
+  231 IF(I.GT.J) GO TO 232
+      W=A(I)
+      A(I)=A(J)
+      A(J)=W
+      I=I+1
+      J=J-1
+      IF(I.LE.J) GO TO 220
+C
+  232 LEVEL=LEVEL+1
+      IF((R-I).GE.(J-L)) GO TO 30
+      LT(LEVEL)=L
+      RT(LEVEL)=J
+      L=I
+      GO TO 20
+   30 LT(LEVEL)=I
+      RT(LEVEL)=R
+      R=J
+      GO TO 20
+   50 RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE DOTNUC(C,S,C2,S2,PR,I)
+C
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      DIMENSION PR(50)
+      K1 = 5*I - 4
+      K2 = K1 + 1
+      SA = PR(K1)
+      SB = PR(K2)
+      A      = SA*C - SB*S
+      PR(K2) = SA*S + SB*C
+      K2 = K2 + 1
+      B = PR(K2)
+      PR(K1) = A*C2 - B*S2
+      PR(K2) = A*S2 + B*C2
+      RETURN
+      END
+*-- AUTHOR :
+      FUNCTION DPDNUC(A,B,C)
+C
+C CALLED BY : PHPNUC
+C ORIGIN    : H.FESEFELDT
+C
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+C
+C     DPDK = SQRT(A*A+(B*B-C*C)**2/(A*A) - 2.0*(B*B+C*C))/2.0
+      A2 = A*A
+      B2 = B*B
+      C2 = C*C
+      IF(A2) 21,21,61
+   61 CONTINUE
+      ARG=A2+(B2-C2)**2/A2-2.0*(B2+C2)
+      IF (ARG) 21,21,31
+   21 DPDNUC=0.0
+      GOTO 41
+   31 CONTINUE
+      DPDNUC = 0.5*SQRT(A2 + (B2-C2)**2/A2 - 2.0*(B2+C2))
+   41 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      FUNCTION EXNU(EK1)
+C
+C *** NUCLEAR EVAPORATION AS FUNCTION OF ATOMIC NUMBER ATNO ***
+C *** AND KINETIC ENERGY EKIN OF PRIMARY PARTICLE ***
+C *** NVE 04-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (10-DEC-1986)
+C
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DIMENSION RNDM(2)
+C
+      EXNU=0.
+      IF(ATNO2.LT.1.5) GO TO 9999
+      MAGIC=0
+      IF(INT(ZNO2+0.1).EQ.82) MAGIC=1
+      EKIN1=EK1
+      IF(EKIN1.LT.0.1) EKIN1=0.1
+      IF(EKIN1.GT.4.) EKIN1=4.
+C**   0.35 VALUE AT 1 GEV
+C**   0.05 VALUE AT 0.1 GEV
+      CFA=(0.35-0.05)/2.3
+      CFA= 0.35+CFA*LOG(EKIN1)
+      IF(CFA.LT.0.15) CFA=0.15
+      EXNU=7.716*CFA*EXP(-CFA)
+      ATNO3=ATNO2
+      IF(ATNO3.GT.120.) ATNO3=120.
+      CFA=((ATNO3-1.)/120.)*EXP(-(ATNO3-1.)/120.)
+      EXNU=EXNU*CFA
+      FPDIV=1.-0.25*EKIN1**2
+      IF(FPDIV.LT.0.50) FPDIV=0.50
+      GFA=2.0*((ATNO2-1.)/70.)*EXP(-(ATNO2-1.)/70.)
+      ENP(1)=EXNU*FPDIV
+      ENP(3)=EXNU-ENP(1)
+    4 CALL NORMAL(RAN1)
+      CALL NORMAL(RAN2)
+      IF(MAGIC.EQ.1) THEN
+         RAN1=0.
+         RAN2=0.
+      ENDIF
+      ENP(1)=ENP(1)*(1.+RAN1*GFA)
+      IF(ENP(1).LT.0.) ENP(1)=0.
+      ENP(3)=ENP(3)*(1.+RAN2*GFA)
+      IF(ENP(3).LT.0.) ENP(3)=0.
+    5 EXNU=ENP(1)+ENP(3)
+      IF(EXNU.LT.EK1) GOTO 10
+      CALL GRNDM(RNDM,2)
+      ENP(1)=ENP(1)*(1.-0.5*RNDM(1))
+      ENP(3)=ENP(3)*(1.-0.5*RNDM(2))
+      GOTO 5
+ 10   CONTINUE
+      IF (NPRT(4))
+     $ WRITE(NEWBCD,1001) XEND,YEND,ZEND,EXNU,ENP(1),ENP(3)
+ 1001 FORMAT(' *EXNU* NUCLEAR EXCITATION AT X,Y,Z = ',3(G12.5,1X)/
+     $ 1H ,7X,'EXNU,ENP(1),ENP(3) = ',3(G12.5,1X))
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      REAL FUNCTION FCTCOS(T)
+C
+C *** NVE 01-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (27-OCT-1983)
+C
+      COMMON/COSCOM/AA,BB,CC,DD,RR
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      DOUBLE PRECISION TEST1,TEST2
+C
+      TEST1=-BB*T*1.0D0
+      IF (TEST1 .GT. EXPXU) TEST1=EXPXU
+      IF (TEST1 .LT. EXPXL) TEST1=EXPXL
+      TEST2=-DD*T*1.0D0
+      IF (TEST2 .GT. EXPXU) TEST2=EXPXU
+      IF (TEST2 .LT. EXPXL) TEST2=EXPXL
+C
+      FCTCOS=AA*EXP(TEST1)+CC*EXP(TEST2)-RR
+C
+      RETURN
+      END
+*-- AUTHOR :
+      FUNCTION FERMI(EK1)
+C
+C *** NVE 16-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (23-AUG-1985)
+C
+      FERMI=0.
+      RETURN
+      END
+*-- AUTHOR :
+      FUNCTION FISSIO(EK1)
+C
+C *** GENERATION OF PHOTONS AND NEUTRONS BY FISSION ***
+C *** NVE 04-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (21-MAR-1987)
+C
+C THE PHYSICS IS BASED ON U(238)
+C FOR OTHER MATERIALS EXTRAPOLATIONS ARE USED
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+C
+C
+      DIMENSION SPNEUT(10)
+      DIMENSION RNDM(2)
+      SAVE SPNEUT
+      DATA SPNEUT/10*0./
+C
+C --- INITIALIZATION INDICATED BY KGINIT(15) ---
+      IF (KGINIT(15) .NE. 0) GO TO 10
+      KGINIT(15)=1
+C
+      XX=1.-0.5
+      XXX=SQRT(2.29*XX)
+      SPNEUT(1)=EXP(-XX/0.965)*(EXP(XXX)-EXP(-XXX))/2.
+      DO 1 I=2,10
+      XX=I*1.-0.5
+      XXX=SQRT(2.29*XX)
+    1 SPNEUT(I)=SPNEUT(I-1)+EXP(-XX/0.965)*(EXP(XXX)-EXP(-XXX))/2.
+      DO 2 I=1,10
+    2 SPNEUT(I)=SPNEUT(I)/SPNEUT(10)
+C** IN THIS ROUTINE WE USE MEV AS UNIT FOR ENERGY AND MOMENTUM
+   10 NT=0
+      IER(82)=IER(82)+1
+      ND=IND+1
+      PV( 1,MXGKPV)=PX*P
+      PV( 2,MXGKPV)=PY*P
+      PV( 3,MXGKPV)=PZ*P
+      PV( 4,MXGKPV)=EN
+      PV( 5,MXGKPV)=ABS(AMAS)
+      PV( 6,MXGKPV)=NCH
+      PV( 7,MXGKPV)=TOF
+      PV( 8,MXGKPV)=IPART
+      PV( 9,MXGKPV)=0.
+      PV(10,MXGKPV)=USERW
+      PV( 1,MXGKPV-1)=0.
+      PV( 2,MXGKPV-1)=0.
+      PV( 3,MXGKPV-1)=0.
+      PV( 4,MXGKPV-1)=ATOMAS(ATNO(ND),ZNO(ND))
+      PV( 5,MXGKPV-1)=PV(4,MXGKPV-1)
+      PV( 6,MXGKPV-1)=ZNO(ND)
+      PV( 7,MXGKPV-1)=TOF
+      PV( 8,MXGKPV-1)=0.
+      PV( 9,MXGKPV-1)=0.
+      PV(10,MXGKPV-1)=0.
+      CALL ADD(MXGKPV,MXGKPV-1,MXGKPV-2)
+      PV(1,MXGKPV-2)=-PV(1,MXGKPV-2)
+      PV(2,MXGKPV-2)=-PV(2,MXGKPV-2)
+      PV(3,MXGKPV-2)=-PV(3,MXGKPV-2)
+C** NUMBER OF NEUTRONS AND PHOTONS
+      FISSIO=0.
+      E1=EK1*1000.
+      IF(E1.LT.1.0) E1=1.0
+      AVERN=2.569+0.559*LOG(E1)
+C**   TAKE THE FOLLOWING VALUE IF PHOTOFISSION IS NOT INCLUDED
+      IF(IFIX(PARMAT(IND+1,8)).EQ.0)
+     *AVERN=2.569+0.900*LOG(E1)
+      AVERG=9.500+0.600*LOG(E1)
+      CALL NORMAL(RAN)
+      NN=IFIX(AVERN+RAN*1.23+0.5)
+      CALL NORMAL(RAN)
+      NG=IFIX(AVERG+RAN*3.+0.5)
+      IF(NN.LT.1) NN=1
+      IF(NG.LT.1) NG=1
+      EXN=0.
+      EXG=0.
+C** DISTRIBUTE KINETIC ENERGY
+      DO 15 I=1,NN
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      DO 11 J=1,10
+      IF(RAN.LT.SPNEUT(J)) GOTO 12
+   11 CONTINUE
+      J=10
+   12 CALL GRNDM(RNDM,1)
+      EKIN=(J-1)*1.+RNDM(1)
+      EXN=EXN+EKIN
+      PV(4,I)=EKIN+RMASS(16)*1000.
+      PV(5,I)=RMASS(16)*1000.
+      PV(6,I)=0.
+C** EMISSION TIME FOR NEUTRONS =0.
+      PV(7,I)=TOF
+      PV(8,I)=16.
+      PV(9,I)=0.
+      PV(10,I)=0.
+   15 CONTINUE
+      NT=NN
+      DO 20 I=1,NG
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      NT=NT+1
+      PV(4,NT)=-0.87*LOG(RAN)
+      EXG=EXG+PV(4,NT)
+      PV(5,NT)=0.
+      PV(6,NT)=0.
+C     RAN=RNDM(1)
+C** EMISSION TIME FOR PHOTONS= 2.5 E-8 SEC
+C     PV(7,NT)=TOF-500.*LOG(RAN)
+C** CHANGED 30.7.85
+      PV(7,NT)=TOF
+      PV(8,NT)=1.
+      PV(9,NT)=0.
+      PV(10,NT)=0.
+   20 CONTINUE
+      IF(NT.EQ.0) GO TO 9999
+      EX=EXN+EXG
+      IF(NPRT(4))
+     *WRITE(NEWBCD,2000) ATNO(IND+1),NN,NG,EX
+      FISSIO=EX/1000.
+      DO 49 I=1,NT
+      PV(5,I)=PV(5,I)/1000.
+      PV(4,I)=PV(4,I)/1000.
+      CALL GRNDM(RNDM,2)
+      COST=-1.+2.*RNDM(1)
+      SINT=SQRT(ABS(1.-COST*COST))
+      PHI=RNDM(2)*TWPI
+      PP=SQRT(ABS(PV(4,I)**2-PV(5,I)**2))
+      PV(1,I)=PP*SINT*SIN(PHI)
+      PV(2,I)=PP*SINT*COS(PHI)
+      PV(3,I)=PP*COST
+      CALL LOR(I,MXGKPV-2,I)
+   49 CONTINUE
+      INTCT=INTCT+1.
+      DO 50 I=1,NT
+      IF(NTOT.LT.NSIZE/12) GOTO 43
+      IER(39)=IER(39)+1
+      GO TO 9999
+   43 CALL SETTRK(I)
+   50 CONTINUE
+C
+ 2000 FORMAT(1H ,'*FISSIO* NUCLEAR FISSION ON MATERIAL ',F6.1,/,
+     *'         NEUTRONS, PHOTONS PRODUCED= ',2I3,' WITH ',F8.4,
+     *' MEV TOTAL ENERGY')
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE GENXPT(IPPP,NFL,AVERN)
+C
+C *** GENERATION OF X- AND PT- VALUES FOR ALL PRODUCED PARTICLES ***
+C *** NVE 02-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT 11-OCT-1987
+C
+C A SIMPLE SINGLE VARIABLE DESCRIPTION E D3S/DP3= F(Q) WITH
+C Q**2 = (M*X)**2 + PT**2 IS USED. FINAL STATE KINEMATIC IS PRODUCED
+C BY AN FF-TYPE ITERATIVE CASCADE METHOD
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      COMMON/GENIN /TECM,AMASS(18),NPG,KGENEV
+      COMMON/GENOUT/PCM(5,18),WGT
+C
+C
+      REAL MASPAR,LAMB,NUCSUP
+      DIMENSION MASPAR(8),BP(8),PTEX(8),C1PAR(5),G1PAR(5),TAVAI(2),
+     $          SIDE(MXGKCU),IAVAI(2),BINL(20),DNDL(20),TWSUP(8),
+     $          NUCSUP(6),PSUP(6),IPAX(100)
+      DIMENSION RNDM(3)
+      DATA MASPAR/0.75,0.70,0.65,0.60,0.50,0.40,0.75,0.20/
+      DATA     BP/3.50,3.50,3.50,6.00,5.00,4.00,3.50,3.50/
+      DATA   PTEX/1.70,1.70,1.50,1.70,1.40,1.20,1.70,1.20/
+      DATA  C1PAR/0.6,0.6,0.35,0.15,0.10/
+      DATA  G1PAR/2.6,2.6,1.80,1.30,1.20/
+      DATA BINL/0.,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0,1.11,1.25
+     $         ,1.43,1.67,2.0,2.5,3.33,5.00,10.00/
+      DATA TWSUP/1.,1.,0.7,0.5,0.3,0.2,0.1,0.0/
+      DATA NUCSUP/1.00,0.7,0.5,0.4,0.35,0.3/
+      DATA   PSUP/3.,6.,20.,50.,100.,1000./
+C
+C**
+      CALL HIGSEL(ISEL)
+      IF(ISEL.EQ.1) THEN
+         CALL HIGXPT(IPPP,NFL,AVERN)
+         RETURN
+      ENDIF
+C**
+C**  FOR ANNIHILATION INTERACTIONS INTRODUCE PROPER KINEMATICS
+C**
+      CALL CORANH(NIHIL,NFL)
+C**
+C**
+C** CHECK FIRST MASS-INDICES
+C**
+      EK=ENP(5)
+      EN=ENP(6)
+      P=ENP(7)
+      S=ENP(8)
+      RS=ENP(9)
+      NT=0
+      DO 1 I=1,100
+      IF(IPA(I).EQ.0) GOTO 1
+      NT=NT+1
+      IPA(NT)=IPA(I)
+    1 CONTINUE
+      CALL VZERO(IPA(NT+1),MXGKCU-NT)
+      CALL UCOPY(IPA(1),IPAX(1),100)
+C**
+C** FOR LOW MULTIPLICITY USE TWO-BODY RESONANCE MODEL OR SINGLE/DOUBLE
+C** DIFFRACTION MODEL (--> TWOCLU (--> TWOB (--> COSCAT)))
+C**
+      CFA=0.025*((ATNO2-1.)/120.)*EXP(-(ATNO2-1.)/120.)
+      IF(NIHIL.GT.0) GOTO 200
+      IF(NT.GE.8) GOTO 200
+      IF(EK.LT.1.) GOTO 60
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IF(IPART.GE.10.AND.IPART.LE.13.AND.RAN.LT.0.5) GOTO 200
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      WSUP=TWSUP(NT)
+      IF(RAN.GT.WSUP) GOTO 200
+   60 CALL UCOPY(IPAX,IPA,100)
+      CALL TWOCLU(IPPP,NFL,AVERN)
+      GO TO 9999
+C**
+C** SET EFFECTIVE 4-MOMENTUM OF PRIMARY PARTICLE
+C**
+  200 MX =MXGKPV-20
+      MX1=MX+1
+      MX2=MX+2
+      MX3=MX+3
+      MX4=MX+4
+      MX5=MX+5
+      MX6=MX+6
+      MX7=MX+7
+      MX8=MX+8
+      MX9=MX+9
+      PV( 1,MXGKPV-1)=P*PX
+      PV( 2,MXGKPV-1)=P*PY
+      PV( 3,MXGKPV-1)=P*PZ
+      PV( 4,MXGKPV-1)=EN
+      PV( 5,MXGKPV-1)=AMAS
+      PV( 6,MXGKPV-1)=NCH
+      PV( 7,MXGKPV-1)=TOF
+      PV( 8,MXGKPV-1)=IPART
+      PV( 9,MXGKPV-1)=0.
+      PV(10,MXGKPV-1)=USERW
+      IER(49)=IER(49)+1
+C**
+C** SOME RANDOMISATION OF ORDER OF FINAL STATE PARTICLES
+C**
+      DO 201 I=3,NT
+      CALL GRNDM(RNDM,1)
+      IPX=IFIX(3.+RNDM(1)*(NT-2.))
+      IF(IPX.GT.NT) IPX=NT
+      IPA1=IPA(IPX)
+      IPA(IPX)=IPA(I)
+  201 IPA(I)  =IPA1
+C**
+C** DISTRIBUTE IN FORWARD AND BACKWARD HEMISPHERE IN CMS
+C**
+      SIDE(1)= 1.
+      SIDE(2)=-1.
+      NTB=1
+      TARG=0.
+      IF(IPART.LT.10.OR.IPART.GT.13) GOTO 53
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.7) GOTO 53
+      IPA1=IPA(1)
+      IPA(1)=IPA(2)
+      IPA(2)=IPA1
+   53 LEAD=0
+      IF(IPART.LT.10.OR.IPART.EQ.14.OR.IPART.EQ.16) GOTO 532
+      IPA1=ABS(IPA(1))
+      IF(IPA1.LT.10.OR.IPA1.EQ.14.OR.IPA1.EQ.16) GOTO 531
+      LEAD=IPA1
+      GOTO 532
+  531 IPA1=ABS(IPA(2))
+      IF(IPA1.LT.10.OR.IPA1.EQ.14.OR.IPA1.EQ.16) GOTO 532
+      LEAD=IPA1
+  532 DO 3 I=1,NT
+      IF(I.LE.2) GOTO 54
+      SIDE(I)= 1.
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) SIDE(I)=-1.
+      IF(SIDE(I).LT.-0.5) NTB=NTB+1
+   54 CONTINUE
+    3 CONTINUE
+      TB=2.*NTB
+      CALL GRNDM(RNDM,1)
+      IF(RS.LT.(2.0+RNDM(1))) TB=(2.*NTB+NT)/2.
+C**
+C** ADD PARTICLES FROM INTRANUCLEAR CASCADE
+C**
+      AFC=0.312+0.200*LOG(LOG(S))+S**1.5/6000.
+      IF(AFC.GT.0.75) AFC=0.75
+      XTARG=AFC*(ATNO2**0.33 -1.0)*TB
+      IF(XTARG.LE.0.) XTARG=0.01
+      CALL POISSO(XTARG,NTARG)
+      NT2=NT+NTARG
+      IF(NT2.LE.MX) GOTO 2
+      NT2=MX
+      NTARG=NT2-NT
+    2 CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,3001) NTARG,NT
+      NT1=NT+1
+      IF(NTARG.EQ.0) GOTO 51
+C**
+C** CHECK NUMBER OF EXTRA NUCLEONS AND PIONS
+C**
+      DO 881 IPX=1,6
+      IF(P.LE.PSUP(IPX)) GOTO 882
+  881 CONTINUE
+      IPX=6
+  882 DO 4 I=NT1,NT2
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IF(RAN.LT.NUCSUP(IPX)) GOTO 52
+      CALL GRNDM(RNDM,1)
+      IPA(I)=-(7+IFIX(RNDM(1)*3.0))
+      GOTO 4
+   52 IPA(I)=-16
+      PNRAT=1.-ZNO2/ATNO2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.PNRAT) IPA(I)=-14
+      TARG=TARG+1.
+    4 SIDE(I)=-2.
+      NT=NT2
+C**
+C** CHOOSE MASSES AND CHARGES FOR ALL PARTICLES
+C**
+   51 DO 5 I=1,NT
+      IPA1=ABS(IPA(I))
+      PV(5,I)=RMASS(IPA1)
+      PV(6,I)=RCHARG(IPA1)
+      PV(7,I)=1.
+      IF(PV(5,I).LT.0.) PV(7,I)=-1.
+      PV(5,I)=ABS(PV(5,I))
+    5 CONTINUE
+C**
+C** CHECK AVAILABLE KINETIC ENERGY, IN THIS MODEL CONSERVATION OF
+C** KINETIC ENERGY IN FORWARD AND BACKWARD HEMISPHERE IS ASSUMED
+C**
+    6 IF(NT.LE.1) GOTO 60
+      TAVAI(1)=RS/2.
+      TAVAI(2)=(TARG+1.)*RS/2.
+      IAVAI(1)=0
+      IAVAI(2)=0
+      DO 7 I=1,NT
+      L=1
+      IF(SIDE(I).LT.0.) L=2
+      IAVAI(L)=IAVAI(L)+1
+      TAVAI(L)=TAVAI(L)-ABS(PV(5,I))
+    7 CONTINUE
+      NTH=NT
+      IF(NTH.GT.10) NTH=10
+      IF (NPRT(4))
+     $ WRITE(NEWBCD,3002) TAVAI,IAVAI,(IPA(I),SIDE(I),I=1,NTH)
+      IF(IAVAI(1).LE.0) GOTO 60
+      IF(IAVAI(2).LE.0) GOTO 60
+      IF(TAVAI(1).GT.0.) GOTO 11
+      CALL GRNDM(RNDM,1)
+      ISKIP=IFIX(RNDM(1)*(IAVAI(1)-1))+1
+      IS=0
+      DO 10  I=1,NT
+      II=NT-I+1
+      IF(SIDE(II).LT.0.) GOTO 10
+      IS=IS+1
+      IF(IS.NE.ISKIP) GOTO 10
+      IF(II.EQ.NT) GOTO 9
+      NT1=II+1
+      NT2=NT
+      DO 8 J=NT1,NT2
+      IPA(J-1)=IPA(J)
+      SIDE(J-1)=SIDE(J)
+      DO 71 K=1,10
+   71 PV(K,J-1)=PV(K,J)
+    8 CONTINUE
+      GOTO 9
+   10 CONTINUE
+    9 IPA(NT)=0
+      SIDE(NT)=0.
+      NT=NT-1
+      GOTO 6
+   11 IF(TAVAI(2).GT.0.) GOTO 15
+      CALL GRNDM(RNDM,1)
+      ISKIP=IFIX(RNDM(1)*(IAVAI(2)-1))+1
+      IS=0
+      DO 14  I=1,NT
+      II=NT-I+1
+      IF(SIDE(II).GT.0.) GOTO 14
+      IS=IS+1
+      IF(IS.NE.ISKIP) GOTO 14
+      IF(SIDE(II).LT.-1.5) NTARG=NTARG-1
+      IF(NTARG.LT.0) NTARG=0
+      IF(II.EQ.NT) GOTO 13
+      NT1=II+1
+      NT2=NT
+      DO 12 J=NT1,NT2
+      IPA(J-1)=IPA(J)
+      SIDE(J-1)=SIDE(J)
+      DO 74 K=1,10
+   74 PV(K,J-1)=PV(K,J)
+   12 CONTINUE
+      GOTO 13
+   14 CONTINUE
+   13 IPA(NT)=0
+      SIDE(NT)=0.
+      NT=NT-1
+      GOTO 6
+   15 IF(NT.LE.1) GOTO 60
+      IF(NT.EQ.MX) GOTO 29
+      NT1=NT+1
+      NT2=MX
+      DO 28 I=NT1,NT2
+   28 IPA(I)=0
+   29 CONTINUE
+C**
+C** NOW THE PREPARATION IS FINISHED.
+C** DEFINE INITIAL STATE VECTORS FOR LORENTZ TRANSFORMATIONS.
+C**
+      PV( 1,MX1)=0.
+      PV( 2,MX1)=0.
+      PV( 3,MX1)=P
+      PV( 4,MX1)=SQRT(P*P+AMAS*AMAS)
+      PV( 5,MX1)=ABS(AMAS)
+      PV( 1,MX2)=0.
+      PV( 2,MX2)=0.
+      PV( 3,MX2)=0.
+      PV( 4,MX2)=MP
+      PV( 5,MX2)=MP
+      PV( 1,MX4)=0.
+      PV( 2,MX4)=0.
+      PV( 3,MX4)=0.
+      PV( 4,MX4)=MP*(1.+TARG)
+      PV( 5,MX4)=PV(4,MX4)
+      PV( 1,MX8)=0.
+      PV( 2,MX8)=0.
+      PV( 3,MX8)=0.
+      PV( 1,MX9)=1.
+      PV( 2,MX9)=0.
+      PV( 3,MX9)=0.
+      CALL ADD(MX1,MX2,MX3)
+      CALL ADD(MX4,MX1,MX4)
+      CALL LOR(MX1,MX3,MX1)
+      CALL LOR(MX2,MX3,MX2)
+C**
+C** MAIN LOOP FOR 4-MOMENTUM GENERATION , SEE PITHA-REPORT (AACHEN)
+C** FOR A DETAILED DESCRIPTION OF THE METHOD.
+C**
+      CALL GRNDM(RNDM,1)
+      PHI=RNDM(1)*TWPI
+      EKIN1=0.
+      EKIN2=0.
+      DO 39 J=1,10
+      PV(J,MX5)=0.
+   39 PV(J,MX6)=0.
+      NPG=0
+      TARG1=0.
+      DO 16 III=1,NT
+      I=NT-III+1
+      IPA1=ABS(IPA(I))
+C**
+C** COUNT NUMBER OF BACKWARD NUCLEONS
+C**
+      IF(I.EQ.2) GOTO 301
+      IF(SIDE(I).LT.-1.5.AND.IPA1.GE.14) GOTO 301
+      GOTO 38
+  301 NPG=NPG+1
+      IF(NPG.GT.18) GOTO 38
+      SIDE(I)=-3.
+      TARG1=TARG1+1.
+      GOTO 16
+   38 J=3
+      IF(IPA1.LT.14) J=2
+      IF(IPA1.LT.10) J=1
+      IF(I.LE.2) J=J+3
+      IF(SIDE(I).LT.-1.5) J=7
+      IF(J.EQ.7.AND.IPA1.GE.14) J=8
+C**
+C** SET PT - AND PHI VALUES, THEY ARE CHANGED SOMEWHAT IN THE ITERATION
+C** LOOP, SET MASS PARAMETER FOR LAMBDA FRAGMENTATION MODEL
+C**
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      BPP=BP(J)
+      BPE=PTEX(J)
+      PT2=-LOG(1.-RAN)/BPP
+      ASPAR=MASPAR(J)
+      PT2=PT2**BPE
+      PT =SQRT(PT2)
+      IF(PT.LT.0.001) PT=0.001
+      PV(1,I)=PT*COS(PHI)
+      PV(2,I)=PT*SIN(PHI)
+      PV(10,I)=PT
+      BINL(1)=0.
+      RLMAX=1./PV(10,I)
+      DO 73 J=2,20
+   73 BINL(J)=RLMAX*(J-1)/19.
+      ET=PV(4,MX1)
+      IF(SIDE(I).LT.0.) THEN
+         ET=PV(4,MX2)
+      ENDIF
+      DNDL(1)=0.
+      NTRIAL=0
+C**
+C** START OF BIG ITERATION LOOP
+C**
+   30 NTRIAL=NTRIAL+1
+      IF(NTRIAL.GT. 2) GOTO 169
+      DO 17 L=2,20
+      DNDL(L)=0.
+      X=(BINL(L)+BINL(L-1))/2.
+      IF(PV(10,I).LT.0.001) PV(10,I)=0.001
+      IF(X.GT.1./PV(10,I)) GOTO 17
+      DX=BINL(L)-BINL(L-1)
+      DNDL(L)=ASPAR/SQRT((1.+(ASPAR*X)**2)**3)
+      DNDL(L)=ET*DNDL(L)/SQRT((X*PV(10,I)*ET)**2+PV(10,I)**2
+     *                             +PV(5,I)**2)
+      DNDL(L)=DNDL(L)*DX
+   17 DNDL(L)=DNDL(L-1)+DNDL(L)
+      NTRI=0
+   31 CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)*DNDL(20)
+      DO 18 L=2,20
+      IF(RAN.LT.DNDL(L)) GOTO 19
+   18 CONTINUE
+C**
+C** START OF SMALL ITERATION LOOP
+C**
+   19 NTRI=NTRI+1
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      DX=BINL(L)-BINL(L-1)
+      LAMB=BINL(L-1)+RAN*DX/2.
+      X=PV(10,I)*LAMB
+      IF(X.GT.1.) X=1.
+      X=X*SIDE(I)/ABS(SIDE(I))
+      PV(3,I)=X*ET
+      PV(4,I)=PV(3,I)**2+PV(10,I)**2+PV(5,I)**2
+      PV(4,I)=SQRT(PV(4,I))
+      IF(SIDE(I).LT.0.) GOTO 165
+      IF(I.GT.2) GOTO 20
+      EKIN=TAVAI(1)-EKIN1
+      CALL NORMAL(RAN)
+      IF(EKIN.LT.0.) EKIN=0.04*ABS(RAN)
+      PV(4,I)=ABS(PV(5,I))+EKIN
+      RNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP=SQRT(RNVE)
+      CALL LENGTX(I,PP1)
+C
+      IF (PP1 .GE. 1.0E-6) GO TO 8000
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP*COS(RTHNVE)
+      GO TO 8001
+ 8000 CONTINUE
+      PV(1,I)=PV(1,I)*PP/PP1
+      PV(2,I)=PV(2,I)*PP/PP1
+      PV(3,I)=PV(3,I)*PP/PP1
+ 8001 CONTINUE
+C
+      CALL ADD(MX5,I,MX5)
+      GOTO 16
+   20 EKIN=EKIN1+PV(4,I)-ABS(PV(5,I))
+      IF(EKIN.LT.0.95*TAVAI(1)) GOTO 161
+      IF(NTRI.GT. 5) GOTO 167
+      PV(10,I)=PV(10,I)*0.9
+      PV( 1,I)=PV( 1,I)*0.9
+      PV( 2,I)=PV( 2,I)*0.9
+      DNDL(20)=DNDL(20)*0.9
+      IF((TAVAI(2)-ABS(PV(5,I))).LT.0.) GOTO 31
+      SIDE(I)=-1.
+      TAVAI(1)=TAVAI(1)+ABS(PV(5,I))
+      TAVAI(2)=TAVAI(2)-ABS(PV(5,I))
+      GOTO 31
+  161 CALL ADD(MX5,I,MX5)
+      EKIN1=EKIN1+PV(4,I)-ABS(PV(5,I))
+      GOTO 163
+  165 EKIN=EKIN2+PV(4,I)-ABS(PV(5,I))
+      XXX=0.95+0.05*TARG/20.
+      IF(XXX.GT.0.999) X=0.999
+      IF(EKIN.LT.XXX*TAVAI(2)) GOTO 166
+      IF(NTRI.GT. 5) GOTO 167
+      PV(10,I)=PV(10,I)*0.9
+      PV( 1,I)=PV( 1,I)*0.9
+      PV( 2,I)=PV( 2,I)*0.9
+      DNDL(20)=DNDL(20)*0.9
+      IF((TAVAI(1)-ABS(PV(5,I))).LT.0.) GOTO 31
+      SIDE(I)=+1.
+      TAVAI(1)=TAVAI(1)-ABS(PV(5,I))
+      TAVAI(2)=TAVAI(2)+ABS(PV(5,I))
+      GOTO 31
+  166 CALL ADD(MX6,I,MX6)
+      EKIN2=EKIN2+PV(4,I)-ABS(PV(5,I))
+  163 CALL ADD(MX5,MX6,MX7)
+      PV(3,MX7)=0.
+      CALL ANG(MX7,MX9,COST,PHIS)
+      IF(PV(2,MX7).LT.0.) PHIS=TWPI-PHIS
+      CALL NORMAL(RAN)
+      RAN=RAN*PI/12.
+      PHI=PHIS+PI+RAN
+      IF(PHI.GT.TWPI) PHI=PHI-TWPI
+      IF(PHI.LT.0.) PHI=TWPI-PHI
+      GOTO 16
+C**
+C** PARTICLE MOMENTUM ZERO, REDUCE KINETIC ENERGY OF ALL OTHER
+C**
+  167 EKIN1=0.
+      EKIN2=0.
+      DO 162 J=1,10
+      PV(J,MX5)=0.
+  162 PV(J,MX6)=0.
+      II=I+1
+      DO 168 L=II,NT
+      IF(ABS(IPA(L)).GE.14.AND.SIDE(L).LT.0.) GOTO 168
+      PV(4,L)=PV(4,L)*0.95+0.05*ABS(PV(5,L))
+      IF(PV(4,L).LT.ABS(PV(5,L))) PV(4,L)=ABS(PV(5,L))
+      RNVE=ABS(PV(4,L)**2-PV(5,L)**2)
+      PP=SQRT(RNVE)
+      CALL LENGTX(L,PP1)
+C
+      IF (PP1 .GE. 1.0E-6) GO TO 8002
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,L)=PP*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,L)=PP*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,L)=PP*COS(RTHNVE)
+      GO TO 8003
+ 8002 CONTINUE
+      PV(1,L)=PV(1,L)*PP/PP1
+      PV(2,L)=PV(2,L)*PP/PP1
+      PV(3,L)=PV(3,L)*PP/PP1
+ 8003 CONTINUE
+C
+      PV(10,L)=SQRT(PV(1,L)**2+PV(2,L)**2)
+      IF(SIDE(L).LT.0.) GOTO 164
+      EKIN1=EKIN1+PV(4,L)-ABS(PV(5,L))
+      CALL ADD(MX5,L,MX5)
+      GOTO 168
+  164 EKIN2=EKIN2+PV(4,L)-ABS(PV(5,L))
+      CALL ADD(MX6,L,MX6)
+  168 CONTINUE
+C *** NEXT STMT. CHANGED TO PREVENT FROM INFINITE LOOPING ***
+C*************      GOTO 38
+      GO TO 30
+C**
+C** SKIP PARTICLE, IF NOT ENOUGH ENERGY
+C**
+  169 IPA(I)=0
+      DO 170 J=1,10
+  170 PV(J,I)=0.
+      GOTO 163
+   16 CONTINUE
+      NTRI=0
+      II=0
+      DO 320 I=1,NT
+      IF(IPA(I).EQ.0) GOTO 320
+      II=II+1
+      IPA(II)=IPA(I)
+      SIDE(II)=SIDE(I)
+      DO 321 J=1,10
+  321 PV(J,II)=PV(J,I)
+  320 CONTINUE
+      NT=II
+C**
+C** BACKWARD NUCLEONS PRODUCED WITH A CLUSTER MODEL
+C**
+      CALL LOR(MX4,MX3,MX7)
+      CALL SUB(MX7,MX5,MX7)
+      CALL SUB(MX7,MX6,MX7)
+      IF(TARG1.GT.1.5) GOTO 310
+  322 I=2
+      CALL NORMAL(RAN)
+      EKIN=TAVAI(2)-EKIN2
+      EKINM=RS/2.-MP
+      IF(EKIN.GT.EKINM) EKIN=EKINM
+      CALL NORMAL(RAN)
+      IF(EKIN.LT.0.04) EKIN=0.04*ABS(RAN)
+      PV(4,I)=ABS(PV(5,I))+EKIN
+      RNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP=SQRT(RNVE)
+      CALL LENGTX(MX7,PP1)
+C
+      IF (PP1 .GE. 1.0E-6) GO TO 8004
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP*COS(RTHNVE)
+      GO TO 8005
+ 8004 CONTINUE
+      PV(1,I)=PV(1,MX7)*PP/PP1
+      PV(2,I)=PV(2,MX7)*PP/PP1
+      PV(3,I)=PV(3,MX7)*PP/PP1
+ 8005 CONTINUE
+C
+      CALL ADD(MX6,I,MX6)
+      GOTO 330
+  310 ITARG1=IFIX(TARG1+0.1)
+      IF(ITARG1.GT.5) ITARG1=5
+      RMB0=0.
+      NPG=0
+      DO 311 I=1,NT
+      IF(SIDE(I).GT.-2.5) GOTO 311
+      NPG=NPG+1
+      RMB0=RMB0+ABS(PV(5,I))
+  311 CONTINUE
+      IF(NPG.LT.2) GOTO 322
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      RMB=-LOG(1.-RAN)
+      GPAR=G1PAR(ITARG1)
+      CPAR=C1PAR(ITARG1)
+      RMB=RMB0+RMB**CPAR/GPAR
+      PV(5,MX7)=RMB
+      IF(PV(5,MX7).GT.PV(4,MX7)) PV(5,MX7)=PV(4,MX7)
+      RNVE=ABS(PV(4,MX7)**2-PV(5,MX7)**2)
+      PP=SQRT(RNVE)
+      CALL LENGTX(MX7,PP1)
+C
+      IF (PP1 .GE. 1.0E-6) GO TO 8006
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,MX7)=PP*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,MX7)=PP*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,MX7)=PP*COS(RTHNVE)
+      GO TO 8007
+ 8006 CONTINUE
+      PV(1,MX7)=PV(1,MX7)*PP/PP1
+      PV(2,MX7)=PV(2,MX7)*PP/PP1
+      PV(3,MX7)=PV(3,MX7)*PP/PP1
+ 8007 CONTINUE
+C
+      I=MX7
+      IF (NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      PV(1,MX7)=-PV(1,MX7)
+      PV(2,MX7)=-PV(2,MX7)
+      PV(3,MX7)=-PV(3,MX7)
+      KGENEV=1
+      TECM=PV(5,MX7)
+      NPG=0
+      DO 312 I=1,NT
+      IF(SIDE(I).GT.-2.5)GOTO 312
+      NPG=NPG+1
+      AMASS(NPG)=ABS(PV(5,I))
+  312 CONTINUE
+      CALL PHASP
+      NPG=0
+      DO 314 I=1,NT
+      IF(SIDE(I).GT.-2.5) GOTO 314
+      NPG=NPG+1
+      PV(1,I)=PCM(1,NPG)
+      PV(2,I)=PCM(2,NPG)
+      PV(3,I)=PCM(3,NPG)
+      PV(4,I)=PCM(4,NPG)
+      CALL LOR(I,MX7,I)
+      CALL ADD(MX6,I,MX6)
+  314 CONTINUE
+  330 IF (NPRT(4))
+     $ WRITE(NEWBCD,2002) NTRIAL,EKIN1,EKIN2,TAVAI(1),TAVAI(2)
+  175 IF (.NOT.NPRT(4)) GOTO 36
+      CALL ADD(MX5,MX6,MX7)
+      EKIN1=PV(4,MX1)+PV(4,MX2)
+      EKIN2=PV(4,MX5)+PV(4,MX6)
+      WRITE(NEWBCD,2000) EKIN1,EKIN2
+      I=MX1
+      WRITE(NEWBCD,2001) I,(PV(J,I),J=1,4)
+      I=MX2
+      WRITE(NEWBCD,2001) I,(PV(J,I),J=1,4)
+      I=MX5
+      WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      I=MX6
+      WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      DO 37 I=1,NT
+   37 WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+C**
+C** LORENTZ TRANSFORMATION IN LAB SYSTEM
+C**
+   36 IF(NT.LE.2) GOTO 60
+      TARG=0.
+      DO 601 I=1,NT
+      IF(PV(5,I).GT.0.5) TARG=TARG+1.
+      CALL LOR(I,MX2,I)
+  601 CONTINUE
+      IF(TARG.LT.0.5) TARG=1.
+      IF(LEAD.EQ.0) GOTO 6085
+      DO 6081 I=1,NT
+      IF(ABS(IPA(I)).EQ.LEAD) GOTO 6085
+ 6081 CONTINUE
+      I=1
+      IF(LEAD.GE.14.AND.ABS(IPA(2)).GE.14) I=2
+      IF(LEAD.LT.14.AND.ABS(IPA(2)).LT.14) I=2
+      IPA(I)=LEAD
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      PV(5,I)=RMASS(LEAD)
+      PV(7,I)=1.
+      IF(PV(5,I).LT.0.) PV(7,I)=-1.
+      PV(5,I)=ABS(PV(5,I))
+      PV(6,I)=RCHARG(LEAD)
+      PV(4,I)=PV(5,I)+EKIN
+      CALL LENGTX(I,PP)
+      RNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP1=SQRT(RNVE)
+      PV(1,I)=PP1*PV(1,I)/PP
+      PV(2,I)=PP1*PV(2,I)/PP
+      PV(3,I)=PP1*PV(3,I)/PP
+ 6085 KGENEV=1
+      PV(1,MX4)=0.
+      PV(2,MX4)=0.
+      PV(3,MX4)=P
+      PV(4,MX4)=SQRT(P*P+AMAS*AMAS)
+      PV(5,MX4)=ABS(AMAS)
+      EKIN0=PV(4,MX4)-PV(5,MX4)
+      PV(1,MX5)=0.
+      PV(2,MX5)=0.
+      PV(3,MX5)=0.
+      PV(4,MX5)=MP*TARG
+      PV(5,MX5)=PV(4,MX5)
+      EKIN=PV(4,MX4)+PV(4,MX5)
+      I=MX4
+      IF (NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      I=MX5
+      IF (NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      CALL ADD(MX4,MX5,MX6)
+      CALL LOR(MX4,MX6,MX4)
+      CALL LOR(MX5,MX6,MX5)
+      TECM=PV(4,MX4)+PV(4,MX5)
+      NPG=NT
+      PV(1,MX8)=0.
+      PV(2,MX8)=0.
+      PV(3,MX8)=0.
+      PV(4,MX8)=0.
+      PV(5,MX8)=0.
+      EKIN1=0.
+      DO 598 I=1,NPG
+      IF (NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+      CALL ADD(MX8,I,MX8)
+      EKIN1=EKIN1+PV(4,I)-PV(5,I)
+      EKIN=EKIN-PV(5,I)
+      IF(I.GT.18) GOTO 598
+      AMASS(I)=PV(5,I)
+  598 CONTINUE
+      IF(NPG.GT.18) GOTO 597
+      CALL PHASP
+      EKIN=0.
+      DO 599 I=1,NPG
+      PV(1,MX7)=PCM(1,I)
+      PV(2,MX7)=PCM(2,I)
+      PV(3,MX7)=PCM(3,I)
+      PV(4,MX7)=PCM(4,I)
+      PV(5,MX7)=AMASS(I)
+      CALL LOR(MX7,MX5,MX7)
+  599 EKIN=EKIN+PV(4,MX7)-PV(5,MX7)
+      CALL ANG(MX8,MX4,COST,TETA)
+      IF (NPRT(4)) WRITE(NEWBCD,2003) TETA,EKIN0,EKIN1,EKIN
+C**
+C** MAKE SHURE, THAT  KINETIC ENERGIES ARE CORRECT.
+C** EKIN= KINETIC ENERGY THEORETICALLY
+C** EKIN1= KINETIC ENERGY SIMULATED
+C**
+  597 IF(EKIN1.EQ.0.) GOTO 600
+      PV(1,MX7)=0.
+      PV(2,MX7)=0.
+      PV(3,MX7)=0.
+      PV(4,MX7)=0.
+      PV(5,MX7)=0.
+      WGT=EKIN/EKIN1
+      EKIN1=0.
+      DO 602 I=1,NT
+      EKIN=PV(4,I)-PV(5,I)
+      EKIN=EKIN*WGT
+      PV(4,I)=EKIN+PV(5,I)
+      RNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP=SQRT(RNVE)
+      CALL LENGTX(I,PP1)
+C
+      IF (PP1 .GE. 1.0E-6) GO TO 8008
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP*COS(RTHNVE)
+      GO TO 8009
+ 8008 CONTINUE
+      PV(1,I)=PV(1,I)*PP/PP1
+      PV(2,I)=PV(2,I)*PP/PP1
+      PV(3,I)=PV(3,I)*PP/PP1
+ 8009 CONTINUE
+C
+      EKIN1=EKIN1+EKIN
+      CALL ADD(MX7,I,MX7)
+  602 CONTINUE
+      CALL ANG(MX7,MX4,COST,TETA)
+      IF (NPRT(4)) WRITE(NEWBCD,2003) TETA,EKIN0,EKIN1
+C**
+C** ROTATE IN DIRECTION OF Z-AXIS, THIS DOES DISTURB IN SOME WAY OUR
+C** INCLUSIVE DISTRIBUTIONS, BUT IT IS NESSACARY FOR MOMENTUM CONSER-
+C** VATION.
+C**
+  600 PV(1,MX7)=0.
+      PV(2,MX7)=0.
+      PV(3,MX7)=0.
+      PV(4,MX7)=0.
+      PV(5,MX7)=0.
+      DO 596 I=1,NT
+      CALL ADD(MX7,I,MX7)
+  596 CONTINUE
+C**
+C** SOME SMEARING IN TRANSVERSE DIRECTION FROM FERMI MOTION
+C**
+*          CALL RANNOR(RAN1,RAN2)
+      CALL GRNDM(RNDM,2)
+      RY=RNDM(1)
+      RZ=RNDM(2)
+      RX=6.283185*RZ
+      A1=SQRT(-2.*LOG(RY))
+      RAN1=A1*SIN(RX)
+      RAN2=A1*COS(RX)
+      PV(1,MX7)=PV(1,MX7)+RAN1*0.020*TARG
+      PV(2,MX7)=PV(2,MX7)+RAN2*0.020*TARG
+      CALL DEFS(MX4,MX7,MX8)
+      PV(1,MX7)=0.
+      PV(2,MX7)=0.
+      PV(3,MX7)=0.
+      PV(4,MX7)=0.
+      PV(5,MX7)=0.
+      DO 595 I=1,NT
+      CALL TRAC(I,MX8,I)
+      CALL ADD(MX7,I,MX7)
+  595 CONTINUE
+      CALL ANG(MX7,MX4,COST,TETA)
+      IF (NPRT(4)) WRITE(NEWBCD,2003) TETA
+C**
+C** ROTATE IN DIRECTION OF PRIMARY PARTICLE, SUBTRACT BINDING ENERGIES
+C** AND MAKE SOME FURTHER CORRECTIONS IF REQUIRED (STEEP, STEEQ)
+C**
+      DEKIN=0.
+      NPIONS=0
+      EK1=0.
+      DO 21 I=1,NT
+      CALL DEFS1(I,MXGKPV-1,I)
+      IF (NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+      IF(ATNO2.LT.1.5) GOTO 21
+      CALL LENGTX(I,PP)
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      CALL NORMAL(RAN)
+      EKIN=EKIN-CFA*(1.+0.5*RAN)
+      IF (EKIN .LT. 1.0E-6) EKIN=1.0E-6
+      CALL STEEQ(XXH,I)
+      DEKIN=DEKIN+EKIN*(1.-XXH)
+      EKIN=EKIN*XXH
+      IF(ABS(IPA(I)).GE.7.AND.ABS(IPA(I)).LE.9) NPIONS=NPIONS+1
+      IF(ABS(IPA(I)).GE.7.AND.ABS(IPA(I)).LE.9) EK1=EK1+EKIN
+      PP1=SQRT(EKIN*(EKIN+2.*ABS(PV(5,I))))
+      PV(4,I)=EKIN+ABS(PV(5,I))
+C
+      IF (PP .GE. 1.0E-6) GO TO 8010
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP1*COS(RTHNVE)
+      GO TO 8011
+ 8010 CONTINUE
+      PV(1,I)=PV(1,I)*PP1/PP
+      PV(2,I)=PV(2,I)*PP1/PP
+      PV(3,I)=PV(3,I)*PP1/PP
+ 8011 CONTINUE
+C
+   21 CONTINUE
+      IF(EK1.EQ.0.) GOTO 23
+      IF(NPIONS.EQ.0) GOTO 23
+      DEKIN=1.+DEKIN/EK1
+      DO 22 I=1,NT
+      IF(ABS(IPA(I)).LT.7.OR.ABS(IPA(I)).GT.9) GOTO 22
+      CALL LENGTX(I,PP)
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      EKIN=EKIN*DEKIN
+      IF (EKIN .LT. 1.0E-6) EKIN=1.0E-6
+      PP1=SQRT(EKIN*(EKIN+2.*ABS(PV(5,I))))
+      PV(4,I)=EKIN+ABS(PV(5,I))
+C
+      IF (PP .GE. 1.0E-6) GO TO 8012
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP1*COS(RTHNVE)
+      GO TO 8013
+ 8012 CONTINUE
+      PV(1,I)=PV(1,I)*PP1/PP
+      PV(2,I)=PV(2,I)*PP1/PP
+      PV(3,I)=PV(3,I)*PP1/PP
+ 8013 CONTINUE
+C
+   22 CONTINUE
+C**
+C** ADD BLACK TRACK PARTICLES, THE TOTAL NUMBER OF PARTICLES PRODUCED
+C** IS RESTRICTED TO 198, THIS MAY HAVE INFLUENCE ON VERY HIGH ENERGY
+C** FIRST PROTONS AND NEUTRONS
+C**
+   23 IF(ATNO2.LT.1.5) GOTO 40
+      CALL SELFAB(SPROB)
+      TEX=ENP(1)
+      SPALL=TARG
+      IF(TEX.LT.0.001) GOTO 445
+      BLACK=(1.5+1.25*TARG)*ENP(1)/(ENP(1)+ENP(3))
+      CALL POISSO(BLACK,NBL)
+      IF (NPRT(4)) WRITE(NEWBCD,3003) NBL,TEX
+      IF(IFIX(TARG)+NBL.GT.ATNO2) NBL=ATNO2-TARG
+      IF(NT+NBL.GT.MXGKPV-10) NBL=MXGKPV-10-NT
+      IF(NBL.LE.0) GOTO 445
+      EKIN=TEX/NBL
+      EKIN2=0.
+      CALL STEEP(XX)
+      DO 441 I=1,NBL
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SPROB) GOTO 441
+      IF(NT.EQ.MXGKPV-10) GOTO 441
+      IF(EKIN2.GT.TEX) GOTO 443
+      CALL GRNDM(RNDM,1)
+      RAN1=RNDM(1)
+      CALL NORMAL(RAN2)
+      EKIN1=-EKIN*LOG(RAN1)-CFA*(1.+0.5*RAN2)
+      IF(EKIN1.LT.0.0) EKIN1=-0.010*LOG(RAN1)
+      EKIN1=EKIN1*XX
+      EKIN2=EKIN2+EKIN1
+      IF(EKIN2.GT.TEX) EKIN1=TEX-(EKIN2-EKIN1)
+      IF (EKIN1 .LT. 0.0) EKIN1=1.0E-6
+      IPA1=16
+      PNRAT=1.-ZNO2/ATNO2
+      CALL GRNDM(RNDM,3)
+      IF(RNDM(1).GT.PNRAT) IPA1=14
+      NT=NT+1
+      SPALL=SPALL+1.
+      COST=-1.+RNDM(2)*2.
+      SINT=SQRT(ABS(1.-COST*COST))
+      PHI=TWPI*RNDM(3)
+      IPA(NT)=-IPA1
+      SIDE(NT)=-4.
+      PV(5,NT)=ABS(RMASS(IPA1))
+      PV(6,NT)=RCHARG(IPA1)
+      PV(7,NT)=1.
+      PV(4,NT)=EKIN1+PV(5,NT)
+      RNVE=ABS(PV(4,NT)**2-PV(5,NT)**2)
+      PP=SQRT(RNVE)
+      PV(1,NT)=PP*SINT*SIN(PHI)
+      PV(2,NT)=PP*SINT*COS(PHI)
+      PV(3,NT)=PP*COST
+  441 CONTINUE
+  443 IF(ATNO2.LT.10.) GOTO 445
+      IF(EK.GT.2.0) GOTO 445
+      II=NT+1
+      KK=0
+      EKA=EK
+      IF(EKA.GT.1.) EKA=EKA*EKA
+      IF(EKA.LT.0.1) EKA=0.1
+      IKA=3.6*EXP((ZNO2**2/ATNO2-35.56)/6.45)/EKA
+      IF(IKA.LE.0) GO TO 445
+      DO 444 I=1,NT
+      II=II-1
+      IF(IPA(II).NE.-14) GOTO 444
+      IPA(II)=-16
+      IPA1  = 16
+      PV(5,II)=ABS(RMASS(IPA1))
+      PV(6,II)=RCHARG(IPA1)
+      KK=KK+1
+      IF(KK.GT.IKA) GOTO 445
+  444 CONTINUE
+C**
+C** THEN ALSO DEUTERONS, TRITONS AND ALPHAS
+C**
+  445 TEX=ENP(3)
+      IF(TEX.LT.0.001) GOTO 40
+      BLACK=(1.5+1.25*TARG)*ENP(3)/(ENP(1)+ENP(3))
+      CALL POISSO(BLACK,NBL)
+      IF(NT+NBL.GT.MXGKPV-10) NBL=MXGKPV-10-NT
+      IF(NBL.LE.0) GOTO 40
+      EKIN=TEX/NBL
+      EKIN2=0.
+      CALL STEEP(XX)
+      IF (NPRT(4)) WRITE(NEWBCD,3004) NBL,TEX
+      DO 442 I=1,NBL
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SPROB) GOTO 442
+      IF(NT.EQ.MXGKPV-10) GOTO 442
+      IF(EKIN2.GT.TEX) GOTO 40
+      CALL GRNDM(RNDM,1)
+      RAN1=RNDM(1)
+      CALL NORMAL(RAN2)
+      EKIN1=-EKIN*LOG(RAN1)-CFA*(1.+0.5*RAN2)
+      IF(EKIN1.LT.0.0) EKIN1=-0.010*LOG(RAN1)
+      EKIN1=EKIN1*XX
+      EKIN2=EKIN2+EKIN1
+      IF(EKIN2.GT.TEX) EKIN1=TEX-(EKIN2-EKIN1)
+      IF (EKIN1 .LT. 0.0) EKIN1=1.0E-6
+      CALL GRNDM(RNDM,3)
+      COST=-1.+RNDM(1)*2.
+      SINT=SQRT(ABS(1.-COST*COST))
+      PHI=TWPI*RNDM(2)
+      RAN=RNDM(3)
+      IPA(NT+1)=-30
+      IF(RAN.GT.0.60) IPA(NT+1)=-31
+      IF(RAN.GT.0.90) IPA(NT+1)=-32
+      SIDE(NT+1)=-4.
+      PV(5,NT+1)=(ABS(IPA(NT+1))-28)*MP
+      SPALL=SPALL+PV(5,NT+1)*1.066
+      IF(SPALL.GT.ATNO2) GOTO 40
+      NT=NT+1
+      PV(6,NT)=1.
+      IF(IPA(NT).EQ.-32) PV(6,NT)=2.
+      PV(7,NT)=1.
+      PV(4,NT)=PV(5,NT)+EKIN1
+      RNVE=ABS(PV(4,NT)**2-PV(5,NT)**2)
+      PP=SQRT(RNVE)
+      PV(1,NT)=PP*SINT*SIN(PHI)
+      PV(2,NT)=PP*SINT*COS(PHI)
+      PV(3,NT)=PP*COST
+  442 CONTINUE
+C**
+C** STORE ON EVENT COMMON
+C**
+   40 CALL GRNDM(RNDM,1)
+      IF(RS.GT.(4.+RNDM(1))) GOTO 42
+      DO 41 I=1,NT
+      CALL LENGTX(I,ETB)
+      IF(ETB.LT.P) GOTO 41
+      ETF=P
+      PV(4,I)=SQRT(PV(5,I)**2+ETF**2)
+      ETF=ETF/ETB
+      PV(1,I)=PV(1,I)*ETF
+      PV(2,I)=PV(2,I)*ETF
+      PV(3,I)=PV(3,I)*ETF
+   41 CONTINUE
+   42 EKIN=PV(4,MXGKPV)-ABS(PV(5,MXGKPV))
+      EKIN1=PV(4,MXGKPV-1)-ABS(PV(5,MXGKPV-1))
+      EKIN2=0.
+      CALL TDELAY(TOF1)
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      TOF=TOF-TOF1*LOG(RAN)
+      DO 44 I=1,NT
+      EKIN2=EKIN2+PV(4,I)-ABS(PV(5,I))
+      IF(PV(7,I).LT.0.) PV(5,I)=-PV(5,I)
+      PV(7,I)=TOF
+      PV(8,I)=ABS(IPA(I))
+      PV(9,I)=0.
+   44 PV(10,I)=0.
+      IF (NPRT(4)) WRITE(NEWBCD,2006) NT,EKIN,ENP(1),ENP(3),EKIN1,EKIN2
+      INTCT=INTCT+1.
+      CALL SETCUR(NT)
+      NTK=NTK+1
+      IF(NT.EQ.1) GO TO 9999
+      DO 50 II=2,NT
+      I=II-1
+      IF(NTOT.LT.NSIZE/12) GOTO 43
+      GO TO 9999
+   43 CALL SETTRK(I)
+   50 CONTINUE
+C
+ 2002 FORMAT(' *GENXPT* PRODUCTION OF FINAL STATE KINEMATIC AFTER ',I3,
+     $ ' TRIALS.',/,'      KINETIC ENERGIES ',2F6.2,' OUT OF ',2F6.2)
+ 2000 FORMAT(' *GENXPT* CMS PARAMETERS OF FINAL STATE PARTICLES,',/,
+     $ '           ENERGIES IN INITIAL AND FINAL STATE ',2F6.2)
+ 2001 FORMAT(' *GENXPT* TRACK',2X,I3,2X,10F8.3,2X,I3,2X,F4.0)
+ 2003 FORMAT(' *GENXPT* TETA,EKIN0,EKIN1,EKIN ',4F10.4)
+ 2006 FORMAT(' *GENXPT* COMP.',1X,I5,1X,5F7.2)
+ 3001 FORMAT(' *GENXPT* NUCLEAR EXCITATION',I5,
+     $ ' PARTICLES PRODUCED IN ADDITION  TO ',I5,' NORMAL PARTICLES')
+ 3002 FORMAT(' *GENXPT* AVAILABLE ENERGIES ',2F10.4,
+     $ ' FOR ',2I3,' PARTICLES IN BEAM/TARGET FRAGM. REGION',
+     $ ' WITH IPA/SIDE ARRAY '/
+     $ 1H ,5X,10(I3,2X,F3.0,4X))
+ 3003 FORMAT(' *GENXPT* ',I3,' BLACK TRACK PARTICLES PRODUCED',
+     $ ' WITH TOTAL KINETIC ENERGY OF ',F8.3,' GEV')
+ 3004 FORMAT(' *GENXPT* ',I5,' HEAVY FRAGMENTS PRODUCED',
+     $ ' WITH TOTAL ENERGY OF',F8.4,' GEV')
+C
+ 9999 CONTINUE
+C
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE GHEPEC(LEDPAR)
+C**
+C** MOMENTUM CONSERVATION AT HIGH ENERGIES
+C**
+      PARAMETER (MXGKGH=100)
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DOUBLE PRECISION AHMF,BHMF
+C**
+      IF(LEDPAR.LE.0) RETURN
+C**
+      MX=MXGKPV-10
+      MX5=MX+5
+      MX6=MX+6
+      MX7=MX+7
+      MX9=MX+9
+C**
+C** APPLY CORRECTION ON LEADING PARTICLE
+C**
+        IF(NPRT(4))
+     $     WRITE(NEWBCD,1002) LEDPAR,(PV(J,LEDPAR),J=1,10)
+C**
+        CALL SUB3(MX9,MXGKPV,MX5)
+        CALL ANG(MXGKPV,LEDPAR,COST,TETA)
+        CALL LENGTX(LEDPAR,PPP)
+        PTLED=PPP*SQRT(1.-COST**2)
+        CALL SUB3(LEDPAR,MX5,LEDPAR)
+        CALL ANG(MXGKPV,LEDPAR,COST,TETA)
+        CALL LENGTX(LEDPAR,PPP)
+        PPP=PPP*COST
+        CALL LENGTX(MXGKPV,PBEAM)
+        PV(1,MX6)=PV(1,MXGKPV)*PPP/PBEAM
+        PV(2,MX6)=PV(2,MXGKPV)*PPP/PBEAM
+        PV(3,MX6)=PV(3,MXGKPV)*PPP/PBEAM
+        CALL CROSS3(MXGKPV,LEDPAR,MX7)
+        CALL CROSS3(MX7,MXGKPV,MX7)
+        CALL LENGTX(MX7,PPP)
+CDH  TO AVOID DIVISION BY 0, SET PPP TO A SMALL POSITIVE VALUE
+        IF ( PPP .LE. 0. ) PPP = 1.E-20
+        PV(1,MX7)=PV(1,MX7)*PTLED/PPP
+        PV(2,MX7)=PV(2,MX7)*PTLED/PPP
+        PV(3,MX7)=PV(3,MX7)*PTLED/PPP
+        CALL ADD3(MX6,MX7,LEDPAR)
+        CALL LENGTX(LEDPAR,PPP)
+        AHMF=PPP
+        BHMF=PV(5,LEDPAR)
+        PV(4,LEDPAR)=DSQRT(AHMF**2+BHMF**2)
+C**
+      IF(NPRT(4)) THEN
+         WRITE(NEWBCD,1003) LEDPAR,(PV(J,LEDPAR),J=1,10)
+      ENDIF
+C**
+      RETURN
+ 1002 FORMAT(1H ,'*GHEPEC* LEADING PARTICLE ',I3,2X,10F8.3)
+ 1003 FORMAT(1H ,'*GHEPEC* CORRECTED 4-VECT ',I3,2X,10F8.3)
+
+      END
+*-- AUTHOR :
+      SUBROUTINE GHETUN(NT)
+C**
+C** TUNING OF THE HIGH ENERGY COLLISION MODEL:
+C**
+C** 1. AVOID THAT PI0 IS LEADING PARTICLE.
+C** 2. SOME FINE-TUNING FOR THE NUMBER OF PRODUCED PROTONS AND
+C**    NEUTRONS.
+C** 3. INTRODUCE A FLAVOUR DEPENDENT CORRECTION FOR SINGLE PARTICLE
+C**    SPECTRA.
+C** 4. FINE-TUNING OF LEADING PARTICLE SPECTRA AND MOMENTUM
+C**    CONSERVATION.
+C**
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+C
+      DOUBLE PRECISION AHMF,BHMF
+      DIMENSION RNDM(4),SNUM(34),BNUM(34),REDDEC(7)
+      DATA SNUM/9*0.,1.,0.,0.,-1.,4*0.,-1.,1.,-1.,-1.,-1.,1.,1.,1.,
+     $          -2.,-2.,2.,2.,3*0.,-3.,3./
+      DATA BNUM/13*0.,1.,-1.,1.,-1.,1.,-1.,1.,1.,1.,-1.,-1.,-1.,
+     $          1.,1.,-1.,-1.,2.,3.,4.,1.,-1./
+C**
+      MX=MXGKPV-10
+      MX1=MX+1
+      MX2=MX+2
+      MX3=MX+3
+      MX4=MX+4
+      MX5=MX+5
+      MX6=MX+6
+      MX7=MX+7
+      MX8=MX+8
+      MX9=MX+9
+      NT1=NT
+      IF(NT1.GT.MXGKPV-10) NT1=MXGKPV-10
+      NT=NT1
+C
+      CALL GRNDM(RNDM,1)
+      IF(EK.LT.(25.+RNDM(1)*75.)) GOTO 15
+C
+C**  IF PI0 IS THE HIGHEST MOMENTUM PARTICLE, INTERCHANGE IT WITH A
+C**  CHARGED PION.
+C
+      CALL GRNDM(RNDM,4)
+      REDEN = -0.7 + 0.29*LOG10(EK)
+      REDAT = 1. - 0.4000*LOG10(ATNO2)
+      PMAX  = -200.
+      PMAPIP= -200.
+      PMAPI0= -200.
+      PMAPIM= -200.
+      IPMAX = 0
+      MAXPIP= 0
+      MAXPI0= 0
+      MAXPIM= 0
+      IF(RNDM(1).GT.(ATNO2/100.-0.28).AND.ABS(NCH).GT.0.5) THEN
+         DO 46 I=1,NT1
+            IPHMF=IFIX(PV(8,I)+0.1)
+            CALL LENGTX(I,PPP)
+            IF(PPP.GT.PMAX) THEN
+               PMAX=PPP
+               IPMAX=I
+            ENDIF
+            IF(IPHMF.EQ.7) THEN
+               IF(PPP.GT.PMAPIP) THEN
+                  PMAPIP=PPP
+                  MAXPIP=I
+               ENDIF
+            ENDIF
+            IF(IPHMF.EQ.8) THEN
+               IF(PPP.GT.PMAPI0) THEN
+                  PMAPI0=PPP
+                  MAXPI0=I
+               ENDIF
+            ENDIF
+            IF(IPHMF.EQ.9) THEN
+               IF(PPP.GT.PMAPIM) THEN
+                  PMAPIM=PPP
+                  MAXPIM=I
+               ENDIF
+            ENDIF
+   46    CONTINUE
+      ENDIF
+C**
+C**   SOME ADDITIONAL TUNING OF THE NUMBER OF GREY TRACK PARTICLES
+C**
+      IF(NT1.GT.2) THEN
+      DO 47 I=3,NT1
+         IPHMF=IFIX(PV(8,I)+0.1)
+         IF(IPHMF.EQ.14.OR.IPHMF.EQ.16.OR.IPHMF.GE.30) THEN
+            CALL LENGTX(I,PPP)
+            IF(PPP.LT.1.5) THEN
+               IF(RNDM(2).LT.REDEN.OR.RNDM(3).LT.REDAT) THEN
+                  PV(1,I) = 0.
+                  PV(2,I) = 0.
+                  PV(3,I) = 0.
+                  PV(4,I) = ABS(PV(5,I))
+               ENDIF
+            ENDIF
+         ENDIF
+   47 CONTINUE
+      ENDIF
+C**
+      IF(MAXPI0.EQ.0)    GOTO 10
+      IF(PMAPI0.LT.PMAX) GOTO 10
+      IF(RNDM(4).LT.PMAPI0/P) THEN
+      IF(NCH.GT.0.5.AND.MAXPIP.NE.0) THEN
+         DO 49 J=5,10
+           PV(J,MX1)=PV(J,MAXPI0)
+           PV(J,MAXPI0)=PV(J,MAXPIP)
+           PV(J,MAXPIP)=PV(J,MX1)
+   49    CONTINUE
+      ENDIF
+      IF(NCH.LT.-0.5.AND.MAXPIM.NE.0) THEN
+         DO 56 J=5,10
+           PV(J,MX1)=PV(J,MAXPI0)
+           PV(J,MAXPI0)=PV(J,MAXPIM)
+           PV(J,MAXPIM)=PV(J,MX1)
+   56    CONTINUE
+      ENDIF
+      ENDIF
+C
+   10 CONTINUE
+C**
+C** CHECK TOTAL BARYON- NUMBER AND
+C** SKIP ZERO MOMENTUM PARTICLES
+C**
+      BNTOT=-BNUM(IPART)-ATNO2
+      DO 57 I=1,NT1
+         IPHMF=IFIX(PV(8,I)+0.1)
+         BNTOT=BNTOT+BNUM(IPHMF)
+   57 CONTINUE
+      BNTOT=1.+BNTOT/ATNO2
+      IF(ATNO2.LT.1.5) BNTOT=0.
+      CALL GRNDM(RNDM,1)
+      IF(ATNO2.GT.(75.+RNDM(1)*25.)) BNTOT=0.
+C**
+      II=0
+      DO 12 I=1,NT1
+         CALL LENGTX(I,PPP)
+         IF(PPP.GT.1.E-6) THEN
+            IPHMF=IFIX(PV(8,I)+0.1)
+            IF(BNTOT.GT.0.3) THEN
+            IF(IPHMF.EQ.14.OR.IPHMF.EQ.16.OR.IPHMF.GE.30) THEN
+               CALL GRNDM(RNDM,1)
+               IF(RNDM(1).LT.0.5.AND.PPP.LT.1.2) GOTO 12
+            ENDIF
+            ENDIF
+            II=II+1
+            DO 11 J=1,10
+               PV(J,II)=PV(J,I)
+   11       CONTINUE
+         ENDIF
+   12 CONTINUE
+      NT1=II
+      NT=NT1
+C**
+C**   EXACT MOMENTUM CONSERVATION AND SOME CORRECTIONS FOR SINGLE
+C**   PARTICLE SPECTRA AT HIGH ENERGIES ONLY
+C
+   15 PV(1,MX1) = P*PX
+      PV(2,MX1) = P*PY
+      PV(3,MX1) = P*PZ
+      PV(4,MX1) = EN
+      PV(5,MX1) = ABS(AMAS)
+      PV(6,MX1) = NCH
+      PV(1,MX2) = 0.
+      PV(2,MX2) = 0.
+      PV(3,MX2) = 0.
+      PV(4,MX2) = MP
+      PV(5,MX2) = MP
+      PV(6,MX2) = 0.
+C
+      IF(NPRT(4)) THEN
+         WRITE(NEWBCD,2000)
+         WRITE(NEWBCD,2001) MX1,(PV(J,MX1),J=1,6)
+         WRITE(NEWBCD,2001) MX2,(PV(J,MX2),J=1,6)
+      ENDIF
+C
+      DO 58 J=1,10
+         PV(J,MX9) = 0.
+   58 CONTINUE
+      CALL ADD(MX1,MX2,MX3)
+      CALL LOR(MX1,MX3,MX4)
+      CALL LOR(MX2,MX3,MX5)
+      LEDPAR=0
+      REDPAR=0.
+      GESPAR=0.
+      SNUM1=SNUM(IPART)
+      IF(IPART.EQ.11.OR.IPART.EQ.12) THEN
+        CALL GRNDM(RNDM,1)
+        SNUM1=1.
+        IF(RNDM(1).LT.0.5) SNUM1=-1.
+      ENDIF
+      DO 20 I=1,NT1
+         IPHMF=IFIX(PV(8,I)+0.1)
+         IF(IPHMF.LE.6.OR.IPHMF.GT.32) GOTO 19
+         CALL LENGTX(I,PPP)
+         IF(PPP.LT.1.E-3) GOTO 19
+         CALL LOR(I,MX3,MX6)
+         CALL ANG(MX4,MX6,COST,TETA)
+         SNUM2=SNUM(IPHMF)
+         IF(IPHMF.EQ.11.OR.IPHMF.EQ.12) THEN
+            CALL GRNDM(RNDM,1)
+            SNUM2=1.
+            IF(RNDM(1).LT.0.5) SNUM2=-1.
+         ENDIF
+         IF(COST.GT.0.) THEN
+            HFMAS=ABS(AMAS)
+            REDDEC(1)=ABS(HFMAS    -ABS(PV(5,I)))
+            REDDEC(2)=ABS(NCH-PV(6,I))
+            REDDEC(3)=ABS(SNUM1      -SNUM2)
+            REDDEC(4)=ABS(BNUM(IPART)-BNUM(IPHMF))
+         ELSE
+            HFMAS=MP
+            REDDEC(1)=ABS(HFMAS     -ABS(PV(5,I)))
+            REDDEC(2)=ABS(ZNO2/ATNO2-PV(6,I))
+            REDDEC(3)=ABS(SNUM2)
+            REDDEC(4)=ABS(1.-BNUM(IPHMF))
+         ENDIF
+         REDDEC(6)=REDDEC(1)+REDDEC(2)+REDDEC(3)+REDDEC(4)
+         SBQWGT=REDDEC(6)
+         IF(HFMAS.LT.0.2) THEN
+            SBQWGT=(SBQWGT-2.5)*0.10
+            IF(IPHMF.EQ.8) SBQWGT=0.15
+         ELSE IF (HFMAS.LT.0.6) THEN
+            SBQWGT=(SBQWGT-3.0)*0.10
+         ELSE
+            SBQWGT=(SBQWGT-2.0)*0.10
+            IF(IPHMF.EQ.8) SBQWGT=0.15
+         ENDIF
+         CALL LENGTX(MX6,PPP)
+         IF(SBQWGT.GT.0. .AND. PPP.GT.1.E-6) THEN
+         PLHMF=PPP*COST
+         PTHMF=PPP*SQRT(1.-COST*COST)
+         PLHMF=PLHMF*(1.-SBQWGT)
+         CALL CROSS3(MX4,MX6,MX8)
+         CALL CROSS3(MX8,MX4,MX8)
+         CALL LENGTX(MX4,PPP)
+         PV(1,MX7)=PV(1,MX4)*PLHMF/PPP
+         PV(2,MX7)=PV(2,MX4)*PLHMF/PPP
+         PV(3,MX7)=PV(3,MX4)*PLHMF/PPP
+         CALL LENGTX(MX8,PPP)
+         PV(1,MX8)=PV(1,MX8)*PTHMF/PPP
+         PV(2,MX8)=PV(2,MX8)*PTHMF/PPP
+         PV(3,MX8)=PV(3,MX8)*PTHMF/PPP
+         CALL ADD3(MX7,MX8,MX6)
+         CALL LENGTX(MX6,PPP)
+         AHMF=PPP
+         BHMF=PV(5,I)
+         PV(4,MX6)=DSQRT(AHMF**2+BHMF**2)
+C
+         IF(NPRT(4))
+     $      WRITE(NEWBCD,3001) I,(PV(J,I),J=1,8),SBQWGT
+C
+         CALL LOR(MX6,MX5,I)
+C
+         IF(NPRT(4))
+     $      WRITE(NEWBCD,3001) I,(PV(J,I),J=1,8),SBQWGT
+         ENDIF
+C
+         IF(IPHMF.EQ.8) GOTO 19
+         CALL SUB3(MXGKPV,I,MX8)
+         CALL LENGTX(MX8,PPP)
+         REDDEC(5) = PPP/P
+         REDDEC(7)=REDDEC(5)*2./3. + REDDEC(6)/12.
+         REDDEC(7) =  1.-REDDEC(7)
+         IF(REDDEC(7) .LT.  0.) REDDEC(7) =  0.
+         GESPAR=GESPAR+REDDEC(7)
+         IF(REDDEC(6).LE.3.75) THEN
+          IF(REDDEC(7) .GT.  REDPAR) THEN
+             LEDPAR=I
+             REDPAR=REDDEC(7)
+          ENDIF
+         ENDIF
+         IF(NPRT(4))
+     $      WRITE(NEWBCD,2001) I,(PV(J,I),J=1,6),PV(8,I),REDDEC
+C
+  19     CALL ADD3(MX9,I,MX9)
+C
+  20  CONTINUE
+      IF(NPRT(4))
+     $   WRITE(NEWBCD,1001) LEDPAR,REDPAR,GESPAR
+C**
+C** APPLY CORRECTION ON LEADING PARTICLE
+C**
+      CALL GHEPEC(LEDPAR)
+C**
+      RETURN
+ 1001 FORMAT(1H ,'*GHETUN* ',
+     $ 'SEARCH FOR LEADING PARTICLE, WEIGHT, TOTAL WEIGHT ',
+     $ I5,3X,2F10.4)
+ 2000 FORMAT(1H ,'*GHETUN* MOMENTUM CONSERVATION AT HIGH ENERGIES: ')
+ 2001 FORMAT(1H ,I3,2X,7F8.3/1H ,5X,7F8.3)
+ 3001 FORMAT(1H ,I3,2X,5F8.3,F5.1,F8.3,F5.1,F8.3)
+      END
+*-- AUTHOR :
+      SUBROUTINE GNSLWD(NUCFLG,INT,NFL,TEKLOW)
+C
+C *** NEUTRON TRACKING ROUTINE FOR ENERGIES BELOW THE CUT-OFF. ***
+C *** TAKE ONLY ELASTIC SCATTERING, NEUTRON CAPTURE            ***
+C *** AND NUCLEAR FISSION.                                     ***
+C *** NVE 11-MAY-1988 CERN GENEVA ***
+C
+C CALLED BY : GHEISH
+C ORIGIN : H.FESEFELDT (ROUTINE NSLDOW 20-OCT-1987)
+C
+      PARAMETER (MAXMEC=30)
+      COMMON/GCTRAK/VECT(7),GETOT,GEKIN,VOUT(7),NMEC,LMEC(MAXMEC)
+     + ,NAMEC(MAXMEC),NSTEP ,MAXNST,DESTEP,DESTEL,SAFETY,SLENG
+     + ,STEP  ,SNEXT ,SFIELD,TOFG  ,GEKRAT,UPWGHT,IGNEXT,INWVOL
+     + ,ISTOP ,IGAUTO,IEKBIN, ILOSL, IMULL,INGOTO,NLDOWN,NLEVIN
+     + ,NLVSAV,ISTORY
+      PARAMETER (MAXME1=30)
+      COMMON/GCTPOL/POLAR(3), NAMEC1(MAXME1)
+C
+C --- GHEISHA COMMONS ---
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      DIMENSION RNDM(2)
+C
+C --- FLAGS TO INDICATE THE NUCREC ACTION ---
+C NUCFLG = 0 ==> NO ACTION BY NUCREC
+C          1 ==> ACTION BY NUCREC ==> SPECIAL TREATMENT IN GHEISH
+      NOPT=0
+      NUCFLG=0
+C
+C --- IN ORDER TO AVOID TROUBLES CAUSED BY ARITHMETIC INCERTAINTIES, ---
+C --- RECALCULATE SOME QUANTITIES. TAKE KINETIC ENERGY EK AS MOST ---
+C --- RELEVANT QUANTITY. ---
+C
+C --- VERY LOW KINETIC ENERGY ==> NEUTRON CAPTURE ---
+      IF (EK .LT. 1.E-9) GO TO 22
+C
+      EN=EK+ABS(AMAS)
+      P=SQRT(ABS(EN*EN-AMAS*AMAS))
+      PU=SQRT(PX**2+PY**2+PZ**2)
+      IF (PU .GE. 1.E-9) GO TO 7
+C
+      PX=0.0
+      PY=0.0
+      PZ=0.0
+      GO TO 22
+C
+ 7    CONTINUE
+      PX=PX/PU
+      PY=PY/PU
+      PZ=PZ/PU
+C
+C --- SELECT PROCESS ACCORDING TO "INT" ---
+      GO TO (23,23,21,22), INT
+C
+C *** NUCLEAR FISSION ***
+ 21   CONTINUE
+      ISTOP=1
+      TKIN=FISSIO(EK)
+      GO TO 9999
+C
+C *** NEUTRON CAPTURE ***
+ 22   CONTINUE
+      ISTOP=1
+      CALL CAPTUR(NOPT)
+      GO TO 9999
+C
+C *** ELASTIC AND INELASTIC SCATTERING ***
+ 23   CONTINUE
+      PV( 1,MXGKPV)=P*PX
+      PV( 2,MXGKPV)=P*PY
+      PV( 3,MXGKPV)=P*PZ
+      PV( 4,MXGKPV)=EN
+      PV( 5,MXGKPV)=AMAS
+      PV( 6,MXGKPV)=NCH
+      PV( 7,MXGKPV)=TOF
+      PV( 8,MXGKPV)=IPART
+      PV( 9,MXGKPV)=0.0
+      PV(10,MXGKPV)=USERW
+C
+C --- SPECIAL TREATMENT FOR INELASTIC SCATTERING IN HEAVY MEDIA ---
+      IF ((INT .EQ. 2) .AND. (ATNO2 .GE. 1.5)) GO TO 29
+C
+C *** ELASTIC SCATTERING ***
+ 30   CONTINUE
+C
+      IF (NPRT(9)) PRINT 1000
+ 1000 FORMAT(' *GNSLWD* ELASTIC SCATTERING')
+C
+      DO 24 J=4,9
+      PV(J,1)=PV(J,MXGKPV)
+ 24   CONTINUE
+      PV(10,1)=0.0
+C
+C --- VERY SIMPLE SIMULATION OF SCATTERING ANGLE AND ENERGY ---
+C --- NONRELATIVISTIC APPROXIMATION WITH ISOTROPIC ANGULAR ---
+C --- DISTRIBUTION IN THE CMS SYSTEM ---
+  25  CALL GRNDM(RNDM,2)
+      RAN=RNDM(1)
+      COST1=-1.0+2.0*RAN
+      EKA=1.0+2.0*COST1*ATNO2+ATNO2**2
+      IF(EKA.LE.0.) GOTO 25
+      COST=(ATNO2*COST1+1.0)/SQRT(EKA)
+      IF (COST .LT. -1.0) COST=-1.0
+      IF (COST .GT. 1.0) COST=1.0
+      EKA=EKA/(1.0+ATNO2)**2
+      EK=EK*EKA
+      EN=EK+ABS(AMAS)
+      P=SQRT(ABS(EN*EN-AMAS*AMAS))
+      SINT=SQRT(ABS(1.0-COST*COST))
+      PHI=RNDM(2)*TWPI
+      PV(1,2)=SINT*SIN(PHI)
+      PV(2,2)=SINT*COS(PHI)
+      PV(3,2)=COST
+      CALL DEFS1(2,MXGKPV,2)
+      PU=SQRT(PV(1,2)**2+PV(2,2)**2+PV(3,2)**2)
+      PX=PV(1,2)/PU
+      PY=PV(2,2)/PU
+      PZ=PV(3,2)/PU
+      PV(1,1)=PX*P
+      PV(2,1)=PY*P
+      PV(3,1)=PZ*P
+      PV(4,1)=EN
+C
+C --- STORE BACKSCATTERED PARTICLE FOR ATNO < 4.5 ---
+      IF (ATNO2 .GT. 4.5) GO TO 27
+C
+      IF (NPRT(9)) PRINT 1001,ATNO2
+ 1001 FORMAT(' *GNSLWD* BACKSCATTERED PARTICLE STORED FOR ATNO ',G12.5)
+C
+      PV(1,2)=PV(1,MXGKPV)-PV(1,1)
+      PV(2,2)=PV(2,MXGKPV)-PV(2,1)
+      PV(3,2)=PV(3,MXGKPV)-PV(3,1)
+      CALL LENGTX(2,PP)
+      PV(9,2)=0.0
+      PV(10,2)=0.0
+      PV(7,2)=TOF
+C
+      IF (ATNO2 .GT. 3.5) GO TO 274
+      IF (ATNO2 .GT. 2.5) GO TO 273
+      IF (ATNO2 .GT. 1.5) GO TO 272
+C
+ 271  CONTINUE
+      PV(5,2)=RMASS(14)
+      PV(4,2)=SQRT(PP*PP+PV(5,2)*PV(5,2))
+      PV(6,2)=RCHARG(14)
+      PV(8,2)=14.0
+      GO TO 275
+C
+ 272  CONTINUE
+      PV(5,2)=RMASS(30)
+      PV(4,2)=SQRT(PP*PP+PV(5,2)*PV(5,2))
+      PV(6,2)=RCHARG(30)
+      PV(8,2)=30.0
+      GO TO 275
+C
+ 273  CONTINUE
+      PV(5,2)=RMASS(31)
+      PV(4,2)=SQRT(PP*PP+PV(5,2)*PV(5,2))
+      PV(6,2)=RCHARG(31)
+      PV(8,2)=31.0
+      GO TO 275
+C
+ 274  CONTINUE
+      PV(5,2)=RMASS(32)
+      PV(4,2)=SQRT(PP*PP+PV(5,2)*PV(5,2))
+      PV(6,2)=RCHARG(32)
+      PV(8,2)=32.0
+C
+ 275  CONTINUE
+      INTCT=INTCT+1.0
+      CALL SETCUR(1)
+      NTK=NTK+1
+      CALL SETTRK(2)
+      GO TO 9999
+C
+C --- PUT QUANTITIES IN COMMON /RESULT/ ---
+ 27   CONTINUE
+      IF (PV(10,1) .NE. 0.0) USERW=PV(10,1)
+      SINL=PZ
+      COSL=SQRT(ABS(1.0-SINL*SINL))
+      IF (ABS(COSL) .LT. 1.E-10) GO TO 28
+C
+      SINP=PY/COSL
+      COSP=PX/COSL
+      GO TO 9999
+C
+ 28   CONTINUE
+      CALL GRNDM(RNDM,1)
+      PHI=RNDM(1)*TWPI
+      SINP=SIN(PHI)
+      COSP=COS(PHI)
+      GO TO 9999
+C
+C *** INELASTIC SCATTERING ON HEAVY NUCLEI ***
+ 29   CONTINUE
+C
+      IF (NPRT(9)) PRINT 1002
+ 1002 FORMAT(' *GNSLWD* INELASTIC SCATTERING ON HEAVY NUCLEUS')
+C
+C --- DECIDE BETWEEN SPALLATION OR SIMPLE NUCLEAR REACTION ---
+      CALL GRNDM(RNDM,1)
+      TEST1=RNDM(1)
+      TEST2=4.5*(EK-0.01)
+      IF (TEST1 .GT. TEST2) GO TO 40
+C
+C *** SPALLATION ***
+C
+      IF (NPRT(9)) PRINT 1003
+ 1003 FORMAT(' *GNSLWD* SPALLATION')
+C
+      PV( 1,MXGKPV)=P*PX
+      PV( 2,MXGKPV)=P*PY
+      PV( 3,MXGKPV)=P*PZ
+      PV( 4,MXGKPV)=EN
+      PV( 5,MXGKPV)=AMAS
+      PV( 6,MXGKPV)=NCH
+      PV( 7,MXGKPV)=TOF
+      PV( 8,MXGKPV)=IPART
+      PV( 9,MXGKPV)=0.0
+      PV(10,MXGKPV)=USERW
+C
+C --- FERMI-MOTION AND EVAPORATION ---
+      TKIN=CINEMA(EK)
+      ENP(5)=EK+TKIN
+C --- CHECK FOR LOWERBOUND OF EKIN IN CROSS-SECTION TABLES ---
+      IF (ENP(5) .LE. TEKLOW) ENP(5)=TEKLOW
+      ENP(6)=ENP(5)+ABS(AMAS)
+      ENP(7)=ENP(6)*ENP(6)-AMASQ
+      ENP(7)=SQRT(ENP(7))
+      TKIN=FERMI(ENP(5))
+      ENP(5)=ENP(5)+TKIN
+C --- CHECK FOR LOWERBOUND OF EKIN IN CROSS-SECTION TABLES ---
+      IF (ENP(5) .LE. TEKLOW) ENP(5)=TEKLOW
+      ENP(6)=ENP(5)+ABS(AMAS)
+      ENP(7)=ENP(6)*ENP(6)-AMASQ
+      ENP(7)=SQRT(ENP(7))
+      TKIN=EXNU(ENP(5))
+      ENP(5)=ENP(5)-TKIN
+C --- CHECK FOR LOWERBOUND OF EKIN IN CROSS-SECTION TABLES ---
+      IF (ENP(5) .LE. TEKLOW) ENP(5)=TEKLOW
+      ENP(6)=ENP(5)+ABS(AMAS)
+      ENP(7)=ENP(6)*ENP(6)-AMASQ
+      ENP(7)=SQRT(ENP(7))
+C
+C --- NEUTRON CASCADE ---
+      K=2
+      CALL VZERO(IPA(1),MXGKCU)
+      CALL CASN(K,INT,NFL)
+      GO TO 9999
+C
+ 40   CONTINUE
+      IF (NPRT(9)) PRINT 1004
+ 1004 FORMAT(' *GNSLWD* NUCLEAR REACTION')
+      CALL NUCREC(NOPT,1)
+      IF (NOPT .NE. 0) NUCFLG=1
+      IF (NOPT .EQ. 0) GO TO 30
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      FUNCTION GPDK(A,B,C)
+C
+C *** NVE 16-MAR-1988 CERN GENEVA ***
+C
+C CALLED BY : PHASP
+C ORIGIN : H.FESEFELDT (27-OCT-1983)
+C
+C     GPDK = SQRT(A*A+(B*B-C*C)**2/(A*A) - 2.0*(B*B+C*C))/2.0
+C
+      A2 = A*A
+      B2 = B*B
+      C2 = C*C
+      IF(A2) 21,21,61
+   61 CONTINUE
+      ARG=A2+(B2-C2)**2/A2-2.0*(B2+C2)
+      IF (ARG) 21,21,31
+   21 GPDK=0.0
+      GOTO 41
+   31 CONTINUE
+      GPDK = 0.5*SQRT(ABS(A2 + (B2-C2)**2/A2 - 2.0*(B2+C2)))
+   41 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE HIGCLU(IPPP,NFL,AVERN)
+C
+C *** GENERATION OF X- AND PT- VALUES FOR ALL PRODUCED PARTICLES ***
+C *** NVE 01-AUG-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (11-OCT-1987)
+C
+C A SIMPLE TWO CLUSTER MODEL IS USED
+C THIS SHOULD BE SUFFICIENT FOR LOW ENERGY INTERACTIONS
+C
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      COMMON/GENIN /TECM,AMASS(18),NPG,KGENEV
+      COMMON/GENOUT/PCM(5,18),WGT
+C
+C
+      REAL NUCSUP
+      DIMENSION SIDE(MXGKCU),C1PAR(5),G1PAR(5),NUCSUP(6)
+      DIMENSION RNDM(3)
+      DIMENSION PSUP(6)
+      DATA C1PAR/0.6,0.6,0.35,0.15,0.10/
+      DATA G1PAR/2.6,2.6,1.8,1.30,1.20/
+      DATA NUCSUP/1.0,0.7,0.5,0.4,0.35,0.3/
+      DATA PSUP/3.,6.,20.,50.,100.,1000./
+C     DATA CB/3.0/
+      DATA CB/0.01/
+      BPP(X)=4.000+1.600*LOG(X)
+C
+      MX =MXGKPV-20
+      MX1=MX+1
+      MX2=MX+2
+      MX3=MX+3
+      MX4=MX+4
+      MX5=MX+5
+      MX6=MX+6
+      MX7=MX+7
+      MX8=MX+8
+      EK=ENP(5)
+      EN=ENP(6)
+      P=ENP(7)
+      S=ENP(8)
+      RS=ENP(9)
+      CFA=0.025*((ATNO2-1.)/120.)*EXP(-(ATNO2-1.)/120.)
+      IF(P.LT.0.001) GOTO 60
+      NT=0
+C**
+C** CHECK MASS-INDICES FOR ALL PARTICLES
+C**
+      DO 1 I=1,100
+      IF(IPA(I).EQ.0) GOTO 1
+      NT=NT+1
+      IPA(NT)=IPA(I)
+    1 CONTINUE
+      CALL VZERO(IPA(NT+1),MXGKCU-NT)
+C**
+C** SET THE EFFECTICE 4-MOMENTUM-VECTOR FOR INTERACTION
+C**
+      PV( 1,MXGKPV-1)=P*PX
+      PV( 2,MXGKPV-1)=P*PY
+      PV( 3,MXGKPV-1)=P*PZ
+      PV( 4,MXGKPV-1)=EN
+      PV( 5,MXGKPV-1)=AMAS
+      PV( 6,MXGKPV-1)=NCH
+      PV( 7,MXGKPV-1)=TOF
+      PV( 8,MXGKPV-1)=IPART
+      PV( 9,MXGKPV-1)=0.
+      PV(10,MXGKPV-1)=USERW
+      IER(48)=IER(48)+1
+C**
+C** DISTRIBUTE PARTICLES IN FORWARD AND BACKWARD HEMISPHERE OF CMS
+C** OF THE HADRON NUCLEON INTERACTION
+C**
+      SIDE(1)= 1.
+      SIDE(2)=-1.
+      TARG=0.
+      IFOR=1
+      IBACK=1
+      DO 3 I=1,NT
+      IF (I .LE. 2) GO TO 78
+      SIDE(I)=1.
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .LT. 0.5) SIDE(I)=-1.
+      IF (SIDE(I) .LT. 0.) GO TO 76
+C
+C --- PARTICLE IN FORWARD HEMISPHERE ---
+ 77   CONTINUE
+      IFOR=IFOR+1
+      IF (IFOR .LE. 18) GO TO 78
+C
+C --- CHANGE IT TO BACKWARD ---
+      SIDE(I)=-1.
+      IFOR=IFOR-1
+      IBACK=IBACK+1
+      GO TO 78
+C
+C --- PARTICLE IN BACKWARD HEMISPHERE ---
+ 76   CONTINUE
+      IBACK=IBACK+1
+      IF (IBACK .LE. 18) GO TO 78
+C
+C --- CHANGE IT TO FORWARD ---
+      SIDE(I)=1.
+      IBACK=IBACK-1
+      IFOR=IFOR+1
+C**
+C** SUPPRESSION OF CHARGED PIONS FOR VARIOUS REASONS
+C**
+   78 IF(IPART.EQ.15.OR.IPART.GE.17) GOTO 3
+      IF(ABS(IPA(I)).GE.10) GOTO 3
+      IF(ABS(IPA(I)).EQ. 8) GOTO 3
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.(10.-P)/6.) GOTO 3
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.ATNO2/300.) GOTO 3
+      IPA(I)=14
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.ZNO2/ATNO2) IPA(I)=16
+      TARG=TARG+1.
+    3 CONTINUE
+      TB=2.*IBACK
+      CALL GRNDM(RNDM,1)
+      IF(RS.LT.(2.0+RNDM(1))) TB=(2.*IBACK+NT)/2.
+C**
+C** NUCLEONS + SOME PIONS FROM INTRANUCLEAR CASCADE
+C**
+      AFC=0.312+0.200*LOG(LOG(S))+S**1.5/6000.
+      IF(AFC.GT.0.50) AFC= 0.50
+      XTARG=AFC*(ATNO2**0.33-1.0)*TB
+      IF(XTARG.LE.0.) XTARG=0.01
+      DO 881 IPX=1,6
+         IF(P.LE.PSUP(IPX)) GOTO 882
+  881 CONTINUE
+      IPX=6
+  882 XPNHMF = XTARG*NUCSUP(IPX)
+      XSHHMF = XTARG - XPNHMF
+      IF(XSHHMF.LT.0.01) XSHHMF=0.01
+      IF(XPNHMF.LT.0.01) XPNHMF=0.01
+      SSHHMF=0.5*XSHHMF
+      SPNHMF=0.9*XPNHMF
+      RSHHMF=SSHHMF**2/XSHHMF
+      RPNHMF=SPNHMF**2/XPNHMF
+      IF(RSHHMF.LT.1.1) THEN
+        CALL POISSO(XSHHMF,NSHHMF)
+        GOTO 541
+      ELSE
+        RSHHMF=XSHHMF/(RSHHMF-1.)
+        IF(RSHHMF.LE.20.) THEN
+          CALL SVGAM7(RSHHMF,XHMF)
+        ELSE
+          KRSHMF=IFIX(RSHHMF+0.5)
+          CALL SVERL2(KRSHMF,XHMF)
+        ENDIF
+        XSHHMF=XHMF*XSHHMF/RSHHMF
+        CALL POISSO(XSHHMF,NSHHMF)
+      ENDIF
+  541 IF(RPNHMF.LE.1.1) THEN
+        CALL POISSO(XPNHMF,NPNHMF)
+        GOTO 542
+      ELSE
+        RPNHMF=XPNHMF/(RPNHMF-1.)
+        IF(RPNHMF.LE.20.) THEN
+           CALL SVGAM7(RPNHMF,XHMF)
+        ELSE
+           KRPHMF=IFIX(RPNHMF+0.5)
+           CALL SVERL2(KRPHMF,XHMF)
+        ENDIF
+        XPNHMF=XHMF*XPNHMF/RPNHMF
+        CALL POISSO(XPNHMF,NPNHMF)
+      ENDIF
+  542 NTARG=NSHHMF+NPNHMF
+      NT2=NT+NTARG
+      IF(NT2.LE.MXGKPV-30) GOTO 2
+      NT2=MXGKPV-30
+      NTARG=NT2-NT
+    2 CONTINUE
+      IF(NPRT(4))
+     *WRITE(NEWBCD,3001) NTARG,NT
+      NT1=NT+1
+      IF(NTARG.EQ.0) GOTO 51
+      DO 4 I=NT1,NT2
+      IF(NPNHMF.GT.0) GOTO 52
+      CALL GRNDM(RNDM,1)
+      IPA(I)=-(7+IFIX(RNDM(1)*3.0))
+CJOK
+      SIDE(I)=-2.
+CJOK
+      GOTO 4
+   52 IPA(I)=-16
+      PNRAT=1.-ZNO2/ATNO2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.PNRAT) IPA(I)=-14
+      TARG=TARG+1.
+      SIDE(I)=-2.
+      NPNHMF=NPNHMF-1
+    4 CONTINUE
+      NT=NT2
+C**
+C** CHOOSE MASSES AND CHARGES FOR ALL PARTICLES
+C**
+   51 DO 5 I=1,NT
+      IPA1=ABS(IPA(I))
+      PV(5,I)=RMASS(IPA1)
+      PV(6,I)=RCHARG(IPA1)
+      PV(7,I)=1.
+      IF(PV(5,I).LT.0.) PV(7,I)=-1.
+      PV(5,I)=ABS(PV(5,I))
+    5 CONTINUE
+C**
+C** MARK LEADING STRANGE PARTICLES
+C**
+      LEAD=0
+      IF(IPART.LT.10.OR.IPART.EQ.14.OR.IPART.EQ.16) GOTO 6
+      IPA1=ABS(IPA(1))
+      IF(IPA1.LT.10.OR.IPA1.EQ.14.OR.IPA1.EQ.16) GOTO 531
+      LEAD=IPA1
+      GOTO 6
+  531 IPA1=ABS(IPA(2))
+      IF(IPA1.LT.10.OR.IPA1.EQ.14.OR.IPA1.EQ.16) GOTO 6
+      LEAD=IPA1
+C**
+C** CHECK AVAILABLE KINETIC ENERGY , CHANGE HEMISPHERE FOR PARTICLES
+C** UNTIL IT FITS
+C**
+    6 IF(NT.LE.1) GOTO 60
+      TAVAI=0.
+      DO 7 I=1,NT
+      IF(SIDE(I).LT.-1.5) GOTO 7
+      TAVAI=TAVAI+ABS(PV(5,I))
+    7 CONTINUE
+CJOK MODIFIED ACCORDING TO D.HECK
+      IF(TAVAI.LT.RS-0.00001) GOTO 12
+      IF(NPRT(4))
+     $ WRITE(NEWBCD,3002) (IPA(I),I=1,20),(SIDE(I),I=1,20),TAVAI,RS
+ 3002 FORMAT(' *HIGCLU* CHECK AVAILABLE ENERGIES'/
+     $ 1H ,20I5/1H ,20F5.0/1H ,'TAVAI,RS ',2F10.3)
+      DO 10 I=1,NT
+      II=NT-I+1
+      IF(SIDE(II).LT.-1.5) GOTO 10
+      IF(II.EQ.NT) GOTO 11
+      NT1=II+1
+      NT2=NT
+      DO 8 J=NT1,NT2
+      IPA(J-1)=IPA(J)
+      SIDE(J-1)=SIDE(J)
+      DO 8 K=1,10
+    8 PV(K,J-1)=PV(K,J)
+      GOTO 11
+   10 CONTINUE
+   11 SIDE(NT)=0.
+      IPA(NT)=0
+      NT=NT-1
+      GOTO 6
+   12 IF(NT.LE.1) GOTO 60
+      B=BPP(P)
+      IF(B.LT.CB) B=CB
+C**
+C** CHOOSE MASSES FOR THE 3 CLUSTER: 1. FORWARD CLUSTER
+C**   2. BACKWARD MESON CLUSTER  3. BACKWARD NUCLEON CLUSTER
+C**
+      RMC0=0.
+      RMD0=0.
+      RME0=0.
+      NTC=0
+      NTD=0
+      NTE=0
+      DO 31 I=1,NT
+      IF(SIDE(I).GT.0.) RMC0=RMC0+ABS(PV(5,I))
+      IF(SIDE(I).GT.0.) NTC =NTC +1
+      IF(SIDE(I).LT.0..AND.SIDE(I).GT.-1.5) RMD0=RMD0+ABS(PV(5,I))
+      IF(                  SIDE(I).LT.-1.5) RME0=RME0+ABS(PV(5,I))
+      IF(SIDE(I).LT.0..AND.SIDE(I).GT.-1.5) NTD =NTD +1
+      IF(                  SIDE(I).LT.-1.5) NTE =NTE +1
+   31 CONTINUE
+   32 CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      RMC=RMC0
+      IF(NTC.LE.1) GOTO 33
+      NTC1=NTC
+      IF(NTC1.GT.5) NTC1=5
+      RMC=-LOG(1.-RAN)
+      GPAR=G1PAR(NTC1)
+      CPAR=C1PAR(NTC1)
+      DUMNVE=GPAR
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      RMC=RMC0+RMC**CPAR/DUMNVE
+   33 RMD=RMD0
+      IF(NTD.LE.1) GOTO 34
+      NTD1=NTD
+      IF(NTD1.GT.5) NTD1=5
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      RMD=-LOG(1.-RAN)
+      GPAR=G1PAR(NTD1)
+      CPAR=C1PAR(NTD1)
+      DUMNVE=GPAR
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      RMD=RMD0+RMD**CPAR/DUMNVE
+   34 IF(RMC+RMD.LE.RS) GOTO 35
+      IF (RMC.LE.RMC0.AND.RMD.LE.RMD0) THEN
+         HNRMDC = 0.999*RS/(RMC+RMD)
+         RMD = RMD*HNRMDC
+         RMC = RMC*HNRMDC
+      ELSE
+         RMC=0.1*RMC0+0.9*RMC
+         RMD=0.1*RMD0+0.9*RMD
+      ENDIF
+      GOTO 34
+   35 IF(NTE.LE.0) GOTO 38
+      RME=RME0
+      IF(NTE.EQ.1) GOTO 38
+      NTE1=NTE
+      IF(NTE1.GT.5) NTE1=5
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      RME=-LOG(1.-RAN)
+      GPAR=G1PAR(NTE1)
+      CPAR=C1PAR(NTE1)
+      DUMNVE=GPAR
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      RME=RME0+RME**CPAR/DUMNVE
+C**
+C** SET BEAM , TARGET OF FIRST INTERACTION IN CMS
+C**
+   38 PV( 1,MX1) =0.
+      PV( 2,MX1) =0.
+      PV( 3,MX1) =P
+      PV( 5,MX1) =ABS(AMAS)
+      PV( 4,MX1) =SQRT(P*P+AMAS*AMAS)
+      PV( 1,MX2) =0.
+      PV( 2,MX2) =0.
+      PV( 3,MX2) =0.
+      PV( 4,MX2) =MP
+      PV( 5,MX2) =MP
+
+C** TRANSFORM INTO CMS.
+
+      CALL ADD(MX1,MX2,MX)
+      CALL LOR(MX1,MX,MX1)
+      CALL LOR(MX2,MX,MX2)
+      PF=(S+RMD*RMD-RMC*RMC)**2 - 4*S*RMD*RMD
+      IF(PF.LT.0.0001) PF=0.0001
+      DUMNVE=2.0*RS
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      PF=SQRT(PF)/DUMNVE
+      IF(NPRT(4)) WRITE(6,2002) PF,RMC,RMD,RS
+C**
+C** SET FINAL STATE MASSES AND ENERGIES IN CMS
+C**
+      PV(5,MX3) =RMC
+      PV(5,MX4) =RMD
+      PV(4,MX3) =SQRT(PF*PF+RMC*RMC)
+      PV(4,MX4) =SQRT(PF*PF+RMD*RMD)
+C**
+C** SET |T| AND |TMIN|
+C**
+      T=-1.0E10
+      CALL GRNDM(RNDM,1)
+      IF (B .NE. 0.0) T=LOG(1.-RNDM(1))/B
+      CALL LENGTX(MX1,PIN)
+      TACMIN=(PV(4,MX1) -PV(4,MX3))**2 -(PIN-PF)**2
+C**
+C** CACULATE (SIN(TETA/2.)**2 AND COS(TETA), SET AZIMUTH ANGLE PHI
+C**
+      DUMNVE=4.0*PIN*PF
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      CTET=-(T-TACMIN)/DUMNVE
+      CTET=1.0-2.0*CTET
+      IF (CTET .GT. 1.0) CTET=1.0
+      IF (CTET .LT. -1.0) CTET=-1.0
+      DUMNVE=1.0-CTET*CTET
+      IF (DUMNVE .LT. 0.0) DUMNVE=0.0
+      STET=SQRT(DUMNVE)
+      CALL GRNDM(RNDM,1)
+      PHI=RNDM(1)*TWPI
+C**
+C** CALCULATE FINAL STATE MOMENTA IN CMS
+C**
+      PV(1,MX3) =PF*STET*SIN(PHI)
+      PV(2,MX3) =PF*STET*COS(PHI)
+      PV(3,MX3) =PF*CTET
+      PV(1,MX4) =-PV(1,MX3)
+      PV(2,MX4) =-PV(2,MX3)
+      PV(3,MX4) =-PV(3,MX3)
+C**
+C** SIMULATE BACKWARD NUCLEON CLUSTER IN LAB. SYSTEM AND TRANSFORM IN
+C** CMS.
+C**
+      IF(NTE.EQ.0) GOTO 28
+      GA=1.2
+      EKIT1=0.04
+      EKIT2=0.6
+      IF(EK.GT.5.) GOTO 666
+      EKIT1=EKIT1*EK**2/25.
+      EKIT2=EKIT2*EK**2/25.
+  666 A=(1.-GA)/(EKIT2**(1.-GA)-EKIT1**(1.-GA))
+      DO 29 I=1,NT
+      IF(SIDE(I).GT.-1.5) GOTO 29
+      CALL GRNDM(RNDM,3)
+      RAN=RNDM(1)
+      EKIT=(RAN*(1.-GA)/A+EKIT1**(1.-GA))**(1./(1.-GA))
+      PV(4,I)=EKIT+PV(5,I)
+      DUMNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP=SQRT(DUMNVE)
+      RAN=RNDM(2)
+      COST=LOG(2.23*RAN+0.383)/0.96
+      IF (COST .LT. -1.0) COST=-1.0
+      IF (COST .GT. 1.0) COST=1.0
+      DUMNVE=1.0-COST*COST
+      IF (DUMNVE .LT. 0.0) DUMNVE=0.0
+      SINT=SQRT(DUMNVE)
+      PHI=TWPI*RNDM(3)
+      PV(1,I)=PP*SINT*SIN(PHI)
+      PV(2,I)=PP*SINT*COS(PHI)
+      PV(3,I)=PP*COST
+      CALL LOR(I,MX,I)
+   29 CONTINUE
+C**
+C** FRAGMENTATION OF FORWARD CLUSTER AND BACKWARD MESON CLUSTER
+C**
+   28 PV(1,1)=PV(1,MX3)
+      PV(2,1)=PV(2,MX3)
+      PV(3,1)=PV(3,MX3)
+      PV(4,1)=PV(4,MX3)
+      PV(1,2)=PV(1,MX4)
+      PV(2,2)=PV(2,MX4)
+      PV(3,2)=PV(3,MX4)
+      PV(4,2)=PV(4,MX4)
+      DO 17 I=MX5,MX6
+      DO 16 J=1,3
+   16 PV(J,I)=-PV(J,I-2)
+      DO 17 J=4,5
+   17 PV(J,I)= PV(J,I-2)
+      KGENEV=1
+      IF(NTC.LE.1) GOTO 26
+      TECM=PV(5,MX3)
+      NPG=0
+      DO 18 I=1,NT
+      IF(SIDE(I).LT.0.) GOTO 18
+      IF(NPG.EQ.18) THEN
+         SIDE(I)=-SIDE(I)
+         GOTO 18
+      ENDIF
+      NPG=NPG+1
+      AMASS(NPG)=ABS(PV(5,I))
+   18 CONTINUE
+      IF(NPRT(4)) WRITE(NEWBCD,2004) TECM,NPG,(AMASS(I),I=1,NPG)
+      CALL PHASP
+      NPG=0
+      DO 19 I=1,NT
+      IF(SIDE(I).LT.0.) GOTO 19
+      NPG=NPG+1
+      PV(1,I)=PCM(1,NPG)
+      PV(2,I)=PCM(2,NPG)
+      PV(3,I)=PCM(3,NPG)
+      PV(4,I)=PCM(4,NPG)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      CALL LOR(I,MX5,I)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+   19 CONTINUE
+   26 IF(NTD.LE.1) GOTO 27
+      TECM=PV(5,MX4)
+      NPG=0
+      DO 20 I=1,NT
+      IF(SIDE(I).GT.0..OR.SIDE(I).LT.-1.5) GOTO 20
+      IF(NPG.EQ.18) THEN
+         SIDE(I)=-2.
+         PV(4,I)=ABS(PV(5,I))
+         DO 48 J=1,3
+            PV(J,I)=0.
+   48    CONTINUE
+         GOTO 20
+      ENDIF
+      NPG=NPG+1
+      AMASS(NPG)=ABS(PV(5,I))
+   20 CONTINUE
+      IF(NPRT(4)) WRITE(NEWBCD,2004) TECM,NPG,(AMASS(I),I=1,NPG)
+      CALL PHASP
+      NPG=0
+      DO 21 I=1,NT
+      IF(SIDE(I).GT.0..OR.SIDE(I).LT.-1.5) GOTO 21
+      NPG=NPG+1
+      PV(1,I)=PCM(1,NPG)
+      PV(2,I)=PCM(2,NPG)
+      PV(3,I)=PCM(3,NPG)
+      PV(4,I)=PCM(4,NPG)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      CALL LOR(I,MX6,I)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+   21 CONTINUE
+C**
+C** LORENTZ TRANSFORMATION IN LAB SYSTEM
+C**
+   27 TARG=0.
+      DO 36 I=1,NT
+      IF(PV(5,I).GT.0.5) TARG=TARG+1.
+      CALL LOR(I,MX2,I)
+   36 CONTINUE
+      IF(TARG.LT.0.5) TARG=1.
+C**
+C** SOMETIMES THE LEADING STRANGE PARTICLES ARE LOST , SET THEM BACK
+C**
+      IF(LEAD.EQ.0) GOTO 6085
+      DO 6081 I=1,NT
+      IF(ABS(IPA(I)).EQ.LEAD) GOTO 6085
+ 6081 CONTINUE
+      I=1
+      IF(LEAD.GE.14.AND.ABS(IPA(2)).GE.14) I=2
+      IF(LEAD.LT.14.AND.ABS(IPA(2)).LT.14) I=2
+      IPA(I)=LEAD
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      PV(5,I)=RMASS(LEAD)
+      PV(7,I)=1.
+      IF(PV(5,I).LT.0.) PV(7,I)=-1.
+      PV(5,I)=ABS(PV(5,I))
+      PV(6,I)=RCHARG(LEAD)
+      PV(4,I)=PV(5,I)+EKIN
+      CALL LENGTX(I,PP)
+      DUMNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP1=SQRT(DUMNVE)
+C
+      IF (PP .GE. 1.0E-6) GO TO 8000
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP1*COS(RTHNVE)
+      GO TO 8001
+ 8000 CONTINUE
+      PV(1,I)=PV(1,I)*PP1/PP
+      PV(2,I)=PV(2,I)*PP1/PP
+      PV(3,I)=PV(3,I)*PP1/PP
+ 8001 CONTINUE
+C
+C** FOR VARIOUS REASONS, THE ENERGY BALANCE IS NOT SUFFICIENT,
+C** CHECK THAT,  ENERGY BALANCE, ANGLE OF FINAL SYSTEM E.T.C.
+ 6085 KGENEV=1
+      PV(1,MX4) =0.
+      PV(2,MX4) =0.
+      PV(3,MX4) =P
+      PV(4,MX4) =SQRT(P*P+AMAS*AMAS)
+      PV(5,MX4) =ABS(AMAS)
+      EKIN0=PV(4,MX4) -PV(5,MX4)
+      PV(1,MX5) =0.
+      PV(2,MX5) =0.
+      PV(3,MX5) =0.
+      PV(4,MX5) =MP*TARG
+      PV(5,MX5) =PV(4,MX5)
+      EKIN=PV(4,MX4) +PV(4,MX5)
+      I=MX4
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      I=MX5
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      CALL ADD(MX4,MX5,MX6)
+      CALL LOR(MX4,MX6,MX4)
+      CALL LOR(MX5,MX6,MX5)
+      TECM=PV(4,MX4) +PV(4,MX5)
+      NPG=NT
+      PV(1,MX8) =0.
+      PV(2,MX8) =0.
+      PV(3,MX8) =0.
+      PV(4,MX8) =0.
+      PV(5,MX8) =0.
+      EKIN1=0.
+      DO 598 I=1,NPG
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+      CALL ADD(MX8,I,MX8)
+      EKIN1=EKIN1+PV(4,I)-PV(5,I)
+      EKIN=EKIN-PV(5,I)
+      IF(I.GT.18) GOTO 598
+      AMASS(I)=PV(5,I)
+  598 CONTINUE
+      IF(NPG.GT.18) GOTO 597
+      CALL PHASP
+      EKIN=0.
+      DO 599 I=1,NPG
+      PV(1,MX7)=PCM(1,I)
+      PV(2,MX7)=PCM(2,I)
+      PV(3,MX7)=PCM(3,I)
+      PV(4,MX7)=PCM(4,I)
+      PV(5,MX7)=AMASS(I)
+      CALL LOR(MX7,MX5,MX7)
+  599 EKIN=EKIN+PV(4,MX7)-PV(5,MX7)
+      CALL ANG(MX8,MX4,COST,TETA)
+      IF(NPRT(4)) WRITE(NEWBCD,2003) TETA,EKIN0,EKIN1,EKIN
+C**
+C** MAKE SHURE, THAT  KINETIC ENERGIES ARE CORRECT
+C** THE 3. CLUSTER IS NOT PRODUCED WITHIN PROPER KINEMATICS!!!
+C** EKIN= KINETIC ENERGY THEORETICALLY
+C** EKIN1= KINETIC ENERGY SIMULATED
+C**
+  597 IF(EKIN1.EQ.0.) GOTO 600
+      PV(1,MX7) =0.
+      PV(2,MX7) =0.
+      PV(3,MX7) =0.
+      PV(4,MX7) =0.
+      PV(5,MX7) =0.
+      WGT=EKIN/EKIN1
+      EKIN1=0.
+      DO 602 I=1,NT
+      EKIN=PV(4,I)-PV(5,I)
+      EKIN=EKIN*WGT
+      PV(4,I)=EKIN+PV(5,I)
+      DUMNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP=SQRT(DUMNVE)
+      CALL LENGTX(I,PP1)
+C
+      IF (PP1 .GE. 1.0E-6) GO TO 8002
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP*COS(RTHNVE)
+      GO TO 8003
+ 8002 CONTINUE
+      PV(1,I)=PV(1,I)*PP/PP1
+      PV(2,I)=PV(2,I)*PP/PP1
+      PV(3,I)=PV(3,I)*PP/PP1
+ 8003 CONTINUE
+C
+      EKIN1=EKIN1+EKIN
+      CALL ADD(MX7,I,MX7)
+  602 CONTINUE
+      CALL ANG(MX7,MX4,COST,TETA)
+      IF(NPRT(4)) WRITE(NEWBCD,2003) TETA,EKIN0,EKIN1
+C**
+C** ROTATE IN DIRECTION OF Z-AXIS, SEE COMMENTS IN 'GENXPT'
+C**
+  600 PV(1,MX7)=0.
+      PV(2,MX7)=0.
+      PV(3,MX7)=0.
+      PV(4,MX7)=0.
+      PV(5,MX7)=0.
+      DO 596 I=1,NT
+      CALL ADD(MX7,I,MX7)
+  596 CONTINUE
+*          CALL RANNOR(RAN1,RAN2)
+      CALL GRNDM(RNDM,2)
+      RY=RNDM(1)
+      RZ=RNDM(2)
+      RX=6.283185*RZ
+      A1=SQRT(-2.*LOG(RY))
+      RAN1=A1*SIN(RX)
+      RAN2=A1*COS(RX)
+      PV(1,MX7)=PV(1,MX7)+RAN1*0.020*TARG
+      PV(2,MX7)=PV(2,MX7)+RAN2*0.020*TARG
+      CALL DEFS(MX4,MX7,MX8)
+      PV(1,MX7)=0.
+      PV(2,MX7)=0.
+      PV(3,MX7)=0.
+      PV(4,MX7)=0.
+      PV(5,MX7)=0.
+      DO 595 I=1,NT
+      CALL TRAC(I,MX8,I)
+      CALL ADD(MX7,I,MX7)
+  595 CONTINUE
+      CALL ANG(MX7,MX4,COST,TETA)
+      IF(NPRT(4)) WRITE(NEWBCD,2003) TETA
+C**
+C** ROTATE IN DIRECTION OF PRIMARY PARTICLE
+C**
+      DEKIN=0.
+      NPIONS=0
+      EK1=0.
+      DO 25 I=1,NT
+      CALL DEFS1(I,MXGKPV-1,I)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+      IF(ATNO2.LT.1.5) GOTO 25
+      CALL LENGTX(I,PP)
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      CALL NORMAL(RAN)
+      EKIN=EKIN-CFA*(1.+0.5*RAN)
+      IF (EKIN .LT. 1.0E-6) EKIN=1.0E-6
+      CALL STEEQ(XXH,I)
+      DEKIN=DEKIN+EKIN*(1.-XXH)
+      EKIN=EKIN*XXH
+      IF(ABS(IPA(I)).GE.7.AND.ABS(IPA(I)).LE.9) NPIONS=NPIONS+1
+      IF(ABS(IPA(I)).GE.7.AND.ABS(IPA(I)).LE.9) EK1=EK1+EKIN
+      PP1=SQRT(EKIN*(EKIN+2.*ABS(PV(5,I))))
+      PV(4,I)=EKIN+ABS(PV(5,I))
+C
+      IF (PP .GE. 1.0E-6) GO TO 8004
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP1*COS(RTHNVE)
+      GO TO 8005
+ 8004 CONTINUE
+      PV(1,I)=PV(1,I)*PP1/PP
+      PV(2,I)=PV(2,I)*PP1/PP
+      PV(3,I)=PV(3,I)*PP1/PP
+ 8005 CONTINUE
+C
+   25 CONTINUE
+      IF(EK1.EQ.0.) GOTO 23
+      IF(NPIONS.LE.0) GOTO 23
+      DEKIN=1.+DEKIN/EK1
+      DO 22 I=1,NT
+      IF(ABS(IPA(I)).LT.7.OR.ABS(IPA(I)).GT.9) GOTO 22
+      CALL LENGTX(I,PP)
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      EKIN=EKIN*DEKIN
+      IF (EKIN .LT. 1.0E-6) EKIN=1.0E-6
+      PP1=SQRT(EKIN*(EKIN+2.*ABS(PV(5,I))))
+      PV(4,I)=EKIN+ABS(PV(5,I))
+C
+      IF (PP .GE. 1.0E-6) GO TO 8006
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP1*COS(RTHNVE)
+      GO TO 8007
+ 8006 CONTINUE
+      PV(1,I)=PV(1,I)*PP1/PP
+      PV(2,I)=PV(2,I)*PP1/PP
+      PV(3,I)=PV(3,I)*PP1/PP
+ 8007 CONTINUE
+C
+   22 CONTINUE
+   23 IF(ATNO2.LT.1.5) GOTO 40
+C**
+C** ADD BLACK TRACK PARTICLES
+C**
+      CALL HIGHAB(SPROB)
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SPROB) GOTO 40
+      TEX=ENP(1)
+      SPALL=TARG
+      IF(TEX.LT.0.001) GOTO 445
+      BLACK=(1.5+1.25*TARG)*ENP(1)/(ENP(1)+ENP(3))
+      CALL POISSO(BLACK,NBL)
+      IF(NPRT(4))
+     *WRITE(NEWBCD,3003) NBL,TEX
+      IF(IFIX(TARG)+NBL.GT.ATNO2) NBL=ATNO2-TARG
+      IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
+      IF(NBL.LE.0) GOTO 445
+      EKIN=TEX/NBL
+      EKIN2=0.
+      CALL STEEP(XX)
+      DO 441 I=1,NBL
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SPROB) GOTO 441
+      IF(NT.EQ.MXGKPV-2) GOTO 441
+      IF(EKIN2.GT.TEX) GOTO 443
+      CALL GRNDM(RNDM,1)
+      RAN1=RNDM(1)
+      CALL NORMAL(RAN2)
+      EKIN1=-EKIN*LOG(RAN1)-CFA*(1.+0.5*RAN2)
+      IF(EKIN1.LT.0.0) EKIN1=-0.010*LOG(RAN1)
+      EKIN1=EKIN1*XX
+      EKIN2=EKIN2+EKIN1
+      IF(EKIN2.GT.TEX) EKIN1=TEX-(EKIN2-EKIN1)
+      IF (EKIN1 .LT. 0.0) EKIN1=1.0E-6
+      IPA1=16
+      PNRAT=1.-ZNO2/ATNO2
+      CALL GRNDM(RNDM,3)
+      IF(RNDM(1).GT.PNRAT) IPA1=14
+      NT=NT+1
+      SPALL=SPALL+1.
+      COST=-1.0+RNDM(2)*2.0
+      DUMNVE=1.0-COST*COST
+      IF (DUMNVE .LT. 0.0) DUMNVE=0.0
+      SINT=SQRT(DUMNVE)
+      PHI=TWPI*RNDM(3)
+      IPA(NT)=-IPA1
+      SIDE(NT)=-4.
+      PV(5,NT)=ABS(RMASS(IPA1))
+      PV(6,NT)=RCHARG(IPA1)
+      PV(7,NT)=1.
+      PV(4,NT)=EKIN1+PV(5,NT)
+      DUMNVE=ABS(PV(4,NT)**2-PV(5,NT)**2)
+      PP=SQRT(DUMNVE)
+      PV(1,NT)=PP*SINT*SIN(PHI)
+      PV(2,NT)=PP*SINT*COS(PHI)
+      PV(3,NT)=PP*COST
+  441 CONTINUE
+  443 IF(ATNO2.LT.10.) GOTO 445
+      IF(EK.GT.2.0) GOTO 445
+      II=NT+1
+      KK=0
+      EKA=EK
+      IF(EKA.GT.1.) EKA=EKA*EKA
+      IF(EKA.LT.0.1) EKA=0.1
+      IKA=3.6*EXP((ZNO2**2/ATNO2-35.56)/6.45)/EKA
+      IF(IKA.LE.0) GO TO 445
+      DO 444 I=1,NT
+      II=II-1
+      IF(IPA(II).NE.-14) GOTO 444
+      IPA(II)=-16
+      IPA1  = 16
+      PV(5,II)=ABS(RMASS(IPA1))
+      PV(6,II)=RCHARG(IPA1)
+      KK=KK+1
+      IF(KK.GT.IKA) GOTO 445
+  444 CONTINUE
+  445 TEX=ENP(3)
+      IF(TEX.LT.0.001) GOTO 40
+      BLACK=(1.5+1.25*TARG)*ENP(3)/(ENP(1)+ENP(3))
+      CALL POISSO(BLACK,NBL)
+      IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
+      IF(NBL.LE.0) GOTO 40
+      EKIN=TEX/NBL
+      EKIN2=0.
+      CALL STEEP(XX)
+      IF(NPRT(4))
+     *WRITE(NEWBCD,3004) NBL,TEX
+      DO 442 I=1,NBL
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SPROB) GOTO 442
+      IF(NT.EQ.MXGKPV-2) GOTO 442
+      IF(EKIN2.GT.TEX) GOTO 40
+      CALL GRNDM(RNDM,1)
+      RAN1=RNDM(1)
+      CALL NORMAL(RAN2)
+      EKIN1=-EKIN*LOG(RAN1)-CFA*(1.+0.5*RAN2)
+      IF(EKIN1.LT.0.0) EKIN1=-0.005*LOG(RAN1)
+      EKIN1=EKIN1*XX
+      EKIN2=EKIN2+EKIN1
+      IF(EKIN2.GT.TEX) EKIN1=TEX-(EKIN2-EKIN1)
+      IF (EKIN1 .LT. 0.0) EKIN1=1.0E-6
+      CALL GRNDM(RNDM,3)
+      COST=-1.0+RNDM(1)*2.0
+      DUMNVE=1.0-COST*COST
+      IF (DUMNVE .LT. 0.0) DUMNVE=0.0
+      SINT=SQRT(DUMNVE)
+      PHI=TWPI*RNDM(2)
+      RAN=RNDM(3)
+      IPA(NT+1)=-30
+      IF(RAN.GT.0.60) IPA(NT+1)=-31
+      IF(RAN.GT.0.90) IPA(NT+1)=-32
+      SIDE(NT+1)=-4.
+      PV(5,NT+1)=(ABS(IPA(NT+1))-28)*MP
+      SPALL=SPALL+PV(5,NT+1)*1.066
+      IF(SPALL.GT.ATNO2) GOTO 40
+      NT=NT+1
+      PV(6,NT)=1.
+      IF(IPA(NT).EQ.-32) PV(6,NT)=2.
+      PV(7,NT)=1.
+      PV(4,NT)=PV(5,NT)+EKIN1
+      DUMNVE=ABS(PV(4,NT)**2-PV(5,NT)**2)
+      PP=SQRT(DUMNVE)
+      PV(1,NT)=PP*SINT*SIN(PHI)
+      PV(2,NT)=PP*SINT*COS(PHI)
+      PV(3,NT)=PP*COST
+  442 CONTINUE
+C**
+C** STORE ON EVENT COMMON
+C**
+   40 CALL GRNDM(RNDM,1)
+      IF(RS.GT.(4.+RNDM(1)*1.)) GOTO 42
+      DO 41 I=1,NT
+      CALL LENGTX(I,ETB)
+      IF(ETB.LT.P) GOTO 41
+      ETF=P
+      PV(4,I)=SQRT(PV(5,I)**2+ETF**2)
+      DUMNVE=ETB
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      ETF=ETF/DUMNVE
+      PV(1,I)=PV(1,I)*ETF
+      PV(2,I)=PV(2,I)*ETF
+      PV(3,I)=PV(3,I)*ETF
+   41 CONTINUE
+   42 EKIN=PV(4,MXGKPV)-ABS(PV(5,MXGKPV))
+      EKIN1=PV(4,MXGKPV-1)-ABS(PV(5,MXGKPV-1))
+      EKIN2=0.
+      CALL TDELAY(TOF1)
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      TOF=TOF-TOF1*LOG(RAN)
+      DO 44 I=1,NT
+      IF(PV(7,I).LT.0.) PV(5,I)=-PV(5,I)
+      PV(7,I)=TOF
+      PV(8,I)=ABS(IPA(I))
+      PV(9,I)=0.
+   44 PV(10,I)=0.
+      CALL GHETUN(NT)
+      DO 45 I=1,NT
+         EKIN2=EKIN2+PV(4,I)-ABS(PV(5,I))
+   45 CONTINUE
+      EKIN2=(EKIN2-EKIN)/EKIN
+      IF(NPRT(4))
+     $            WRITE(NEWBCD,2006) NT,EKIN,ENP(1),ENP(3),EKIN1,EKIN2
+      IF(EKIN2.GT.0.2) GOTO 60
+      INTCT=INTCT+1.
+      NMODE=3
+      IF(SPALL.LT.0.5.AND.ATNO2.GT.1.5) NMODE=14
+      CALL SETCUR(NT)
+      NTK=NTK+1
+      IF(NT.EQ.1) GOTO 300
+      DO 50 II=2,NT
+      I=II-1
+      IF(NTOT.LT.NSIZE/12) GOTO 43
+      GO TO 9999
+   43 CALL SETTRK(I)
+   50 CONTINUE
+ 300  CONTINUE
+      GO TO 9999
+C**
+C** IT IS NOT POSSIBLE TO PRODUCE A PROPER TWO CLUSTER FINAL STATE.
+C** CONTINUE WITH QUASI ELASTIC SCATTERING
+C**
+   60 IF(NPRT(4)) WRITE(NEWBCD,2005)
+      DO 61 I=3,MXGKCU
+   61 IPA(I)=0
+      IPA(1)=IPART
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      CALL TWOB(IPPP,NFL,AVERN)
+      GO TO 9999
+C
+ 2000 FORMAT(' *HIGCLU* CMS PARAMETERS OF FINAL STATE PARTICLES',
+     $ ' AFTER ',I3,' TRIALS')
+ 2001 FORMAT(' *HIGCLU* TRACK',2X,I3,2X,10F8.2,2X,I3,2X,F3.0)
+ 2002 FORMAT(' *HIGCLU* MOMENTUM ',F8.3,' MASSES ',2F8.4,' RS ',F8.4)
+ 2003 FORMAT(' *HIGCLU* TETA,EKIN0,EKIN1,EKIN ',4F10.4)
+ 2004 FORMAT(' *HIGCLU* TECM,NPB,MASSES: ',F10.4,1X,I3,1X,8F10.4/
+     $ 1H ,26X,15X,8F10.4)
+ 2005 FORMAT(' *HIGCLU* NUMBER OF FINAL STATE PARTICLES',
+     $ ' LESS THAN 2 ==> CONTINUE WITH 2-BODY SCATTERING')
+ 2006 FORMAT(' *HIGCLU*  COMP.',1X,I5,1X,5F7.2)
+ 3001 FORMAT(' *HIGCLU* NUCLEAR EXCITATION ',I5,' PARTICLES PRODUCED',
+     $ ' IN ADDITION TO',I5,' NORMAL PARTICLES')
+ 3003 FORMAT(' *HIGCLU* ',I3,' BLACK TRACK PARTICLES PRODUCED',
+     $ ' WITH TOTAL KINETIC ENERGY OF ',F8.3,' GEV')
+ 3004 FORMAT(' *HIGCLU* ',I5,' HEAVY FRAGMENTS WITH TOTAL ENERGY OF ',
+     $ F8.4,' GEV')
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE HIGHAB(SPROB)
+C
+C *** SELF-ABSORBTION IN HEAVY MOLECULES ***
+C *** NVE 16-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (11-OCT-1987)
+C
+C
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      SPROB=0.
+      EKW=PV(4,MXGKPV)-ABS(PV(5,MXGKPV))
+      IF(EKW.LT.5.) RETURN
+      ALEKW=LOG(EKW-4.)
+      BLEKW=0.25-0.02*LOG(ATNO2)
+      SPROB=BLEKW*ALEKW
+      IF(SPROB.GT.1.) SPROB=1.
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE HIGSEL(ISEL)
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+C
+      DIMENSION RNDM(1)
+      CALL GRNDM(RNDM,1)
+      ISEL=1
+      IF(P.LT.25.+RNDM(1)*25.) ISEL=0
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE HIGXPT(IPPP,NFL,AVERN)
+C
+C *** GENERATION OF X- AND PT- VALUES FOR ALL PRODUCED PARTICLES ***
+C *** NVE 02-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT 11-OCT-1987
+C
+C A SIMPLE SINGLE VARIABLE DESCRIPTION E D3S/DP3= F(Q) WITH
+C Q**2 = (M*X)**2 + PT**2 IS USED. FINAL STATE KINEMATIC IS PRODUCED
+C BY AN FF-TYPE ITERATIVE CASCADE METHOD
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      COMMON/GENIN /TECM,AMASS(18),NPG,KGENEV
+      COMMON/GENOUT/PCM(5,18),WGT
+C
+C
+C
+      REAL MASPAR,LAMB,NUCSUP
+      DIMENSION MASPAR(8),BP(8),PTEX(8),C1PAR(5),G1PAR(5),TAVAI(2),
+     $          SIDE(MXGKCU),IAVAI(2),BINL(20),DNDL(20),TWSUP(8),
+     $          NUCSUP(6),PSUP(6),IPAX(100)
+      DIMENSION RNDM(3)
+      DATA MASPAR/0.75,0.70,0.65,0.60,0.50,0.40,0.20,0.10/
+      DATA     BP/4.00,2.50,2.20,3.00,3.00,1.70,3.50,3.50/
+      DATA   PTEX/1.70,1.70,1.50,1.70,1.40,1.20,1.70,1.20/
+      DATA  C1PAR/0.6,0.6,0.35,0.15,0.10/
+      DATA  G1PAR/2.6,2.6,1.80,1.30,1.20/
+      DATA BINL/0.,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0,1.11,1.25
+     $         ,1.43,1.67,2.0,2.5,3.33,5.00,10.00/
+      DATA TWSUP/1.,1.,0.7,0.5,0.3,0.2,0.1,0.0/
+      DATA NUCSUP/1.00,0.7,0.5,0.4,0.5,0.5/
+      DATA   PSUP/3.,6.,20.,50.,100.,1000./
+C
+C**
+C**  FOR ANNIHILATION INTERACTIONS INTRODUCE PROPER KINEMATICS
+C**
+      CALL CORANH(NIHIL,NFL)
+C**
+C**
+C** CHECK FIRST MASS-INDICES
+C**
+      EK=ENP(5)
+      EN=ENP(6)
+      P=ENP(7)
+      S=ENP(8)
+      RS=ENP(9)
+      NT=0
+      DO 1 I=1,100
+      IF(IPA(I).EQ.0) GOTO 1
+      NT=NT+1
+      IPA(NT)=IPA(I)
+    1 CONTINUE
+      CALL VZERO(IPA(NT+1),MXGKCU-NT)
+      CALL UCOPY(IPA(1),IPAX(1),100)
+C**
+C** FOR LOW MULTIPLICITY USE TWO-BODY RESONANCE MODEL OR SINGLE/DOUBLE
+C** DIFFRACTION MODEL (--> HIGCLU (--> TWOB (--> COSCAT)))
+C**
+      CFA=0.025*((ATNO2-1.)/120.)*EXP(-(ATNO2-1.)/120.)
+      IF(NIHIL.GT.0) GOTO 200
+      IF(NT.GE.8) GOTO 200
+      IF(EK.LT.1.) GOTO 60
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IF(IPART.GE.10.AND.IPART.LE.13.AND.RAN.LT.0.5) GOTO 200
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      WSUP=TWSUP(NT)
+      IF(RAN.GT.WSUP) GOTO 200
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)*200.+50.
+      IF(EK.GT.RAN) GOTO 200
+   60 CALL UCOPY(IPAX,IPA,100)
+      CALL HIGCLU(IPPP,NFL,AVERN)
+      GO TO 9999
+C**
+C** SET EFFECTIVE 4-MOMENTUM OF PRIMARY PARTICLE
+C**
+  200 MX =MXGKPV-20
+      MX1=MX+1
+      MX2=MX+2
+      MX3=MX+3
+      MX4=MX+4
+      MX5=MX+5
+      MX6=MX+6
+      MX7=MX+7
+      MX8=MX+8
+      MX9=MX+9
+      PV( 1,MXGKPV-1)=P*PX
+      PV( 2,MXGKPV-1)=P*PY
+      PV( 3,MXGKPV-1)=P*PZ
+      PV( 4,MXGKPV-1)=EN
+      PV( 5,MXGKPV-1)=AMAS
+      PV( 6,MXGKPV-1)=NCH
+      PV( 7,MXGKPV-1)=TOF
+      PV( 8,MXGKPV-1)=IPART
+      PV( 9,MXGKPV-1)=0.
+      PV(10,MXGKPV-1)=USERW
+      IER(49)=IER(49)+1
+C**
+C** SOME RANDOMISATION OF ORDER OF FINAL STATE PARTICLES
+C**
+      DO 201 I=3,NT
+      CALL GRNDM(RNDM,1)
+      IPX=IFIX(3.+RNDM(1)*(NT-2.))
+      IF(IPX.GT.NT) IPX=NT
+      IPA1=IPA(IPX)
+      IPA(IPX)=IPA(I)
+  201 IPA(I)  =IPA1
+C**
+C** DISTRIBUTE IN FORWARD AND BACKWARD HEMISPHERE IN CMS
+C**
+      SIDE(1)= 1.
+      SIDE(2)=-1.
+      NTB=1
+      TARG=0.
+      IF(IPART.LT.10.OR.IPART.GT.13) GOTO 53
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.9) GOTO 53
+      IPA1=IPA(1)
+      IPA(1)=IPA(2)
+      IPA(2)=IPA1
+   53 LEAD=0
+      IF(IPART.LT.10.OR.IPART.EQ.14.OR.IPART.EQ.16) GOTO 532
+      IPA1=ABS(IPA(1))
+      IF(IPA1.LT.10.OR.IPA1.EQ.14.OR.IPA1.EQ.16) GOTO 531
+      LEAD=IPA1
+      GOTO 532
+  531 IPA1=ABS(IPA(2))
+      IF(IPA1.LT.10.OR.IPA1.EQ.14.OR.IPA1.EQ.16) GOTO 532
+      LEAD=IPA1
+  532 DO 3 I=1,NT
+      IF(I.LE.2) GOTO 54
+      SIDE(I)= 1.
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) SIDE(I)=-1.
+      IF(SIDE(I).LT.-0.5) NTB=NTB+1
+   54 CONTINUE
+    3 CONTINUE
+      TB=2.*NTB
+      CALL GRNDM(RNDM,1)
+      IF(RS.LT.(2.0+RNDM(1))) TB=(2.*NTB+NT)/2.
+C**
+C** ADD PARTICLES FROM INTRANUCLEAR CASCADE
+C**
+      AFC=0.312+0.200*LOG(LOG(S))+S**1.5/6000.
+      IF(AFC.GT.0.5) AFC=0.5
+      XTARG=AFC*(ATNO2**0.33 -1.0)*TB
+      IF(XTARG.LE.0.) XTARG=0.01
+C** SOME EXTRA STRANGE PARTICLES
+      XSTRAN=0.030*XTARG
+      CALL POISSO(XSTRAN,NSTRAN)
+C** NUCLEONS AND PIONS
+      DO 881 IPX=1,6
+         IF(P.LE.PSUP(IPX)) GOTO 882
+  881 CONTINUE
+      IPX = 6
+  882 XPNHMF = XTARG*NUCSUP(IPX)
+      XSHHMF = XTARG - XPNHMF
+      IF(XSHHMF.LT.0.01) XSHHMF=0.01
+      IF(XPNHMF.LT.0.01) XPNHMF=0.01
+      SSHHMF=0.5*XSHHMF
+      SPNHMF=0.9*XPNHMF
+      RSHHMF=SSHHMF**2/XSHHMF
+      RPNHMF=SPNHMF**2/XPNHMF
+      IF(RSHHMF.LT.1.1) THEN
+        CALL POISSO(XSHHMF,NSHHMF)
+        GOTO 541
+      ELSE
+        RSHHMF=XSHHMF/(RSHHMF-1.)
+        IF(RSHHMF.LE.20.) THEN
+           CALL SVGAM7(RSHHMF,XHMF)
+        ELSE
+           KRSHMF=IFIX(RSHHMF+0.5)
+           CALL SVERL2(KRSHMF,XHMF)
+        ENDIF
+        XSHHMF=XHMF*XSHHMF/RSHHMF
+        CALL POISSO(XSHHMF,NSHHMF)
+      ENDIF
+  541 IF(RPNHMF.LE.1.1) THEN
+        CALL POISSO(XPNHMF,NPNHMF)
+        GOTO 542
+      ELSE
+        RPNHMF=XPNHMF/(RPNHMF-1.)
+        IF(RPNHMF.LE.20.) THEN
+           CALL SVGAM7(RPNHMF,XHMF)
+        ELSE
+           KRPHMF=IFIX(RPNHMF+0.5)
+           CALL SVERL2(KRPHMF,XHMF)
+        ENDIF
+        XPNHMF=XHMF*XPNHMF/RPNHMF
+        CALL POISSO(XPNHMF,NPNHMF)
+      ENDIF
+  542 NTARG=NSHHMF+NPNHMF+NSTRAN
+      NT2=NT+NTARG
+      IF(NT2.LE.MX) GOTO 2
+      NT2=MX
+      NTARG=NT2-NT
+    2 CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,3001) NTARG,NT
+      NT1=NT+1
+      IF(NTARG.EQ.0) GOTO 51
+C**
+C** CHECK NUMBER OF EXTRA NUCLEONS AND PIONS
+C**
+      DO 4 I=NT1,NT2
+      IF(NPNHMF.GT.0) GOTO 52
+      IF(NSTRAN.GT.0) GOTO 59
+      CALL GRNDM(RNDM,2)
+      IPA(I)=-(7+IFIX(RNDM(1)*3.0))
+      SIDE(I)=-2.
+      IF(RNDM(2).LT.0.2) THEN
+        IPA(I)=IABS(IPA(I))
+        SIDE(I)=1.
+        NTARG=NTARG-1
+      ENDIF
+      GOTO 4
+   52 IPA(I)=-16
+      PNRAT=1.-ZNO2/ATNO2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.PNRAT) IPA(I)=-14
+      TARG=TARG+1.
+      SIDE(I)=-2.
+      NPNHMF=NPNHMF-1
+      GOTO 4
+   59 CALL GRNDM(RNDM,2)
+      IPA(I)=-18
+      IF(RNDM(1).GT.0.14) IPA(I)=-21
+      IF(RNDM(1).GT.0.20) IPA(I)=-10
+      IF(RNDM(1).GT.0.43) IPA(I)=-11
+      IF(RNDM(1).GT.0.66) IPA(I)=-12
+      IF(RNDM(1).GT.0.89) IPA(I)=-13
+      SIDE(I)=-2.
+      IF(RNDM(2).LT.0.2) THEN
+        IPA(I)=IABS(IPA(I))
+        SIDE(I)=1.
+        NTARG=NTARG-1
+      ENDIF
+      NSTRAN=NSTRAN-1
+    4 CONTINUE
+      NT=NT2
+C**
+C** CHOOSE MASSES AND CHARGES FOR ALL PARTICLES
+C**
+   51 DO 5 I=1,NT
+      IPA1=ABS(IPA(I))
+      PV(5,I)=RMASS(IPA1)
+      PV(6,I)=RCHARG(IPA1)
+      PV(7,I)=1.
+      IF(PV(5,I).LT.0.) PV(7,I)=-1.
+      PV(5,I)=ABS(PV(5,I))
+    5 CONTINUE
+C**
+C** CHECK AVAILABLE KINETIC ENERGY, IN THIS MODEL CONSERVATION OF
+C** KINETIC ENERGY IN FORWARD AND BACKWARD HEMISPHERE IS ASSUMED
+C**
+    6 IF(NT.LE.1) GOTO 60
+      TAVAI(1)=RS/2.
+      TAVAI(2)=(TARG+1.)*RS/2.
+      IAVAI(1)=0
+      IAVAI(2)=0
+      DO 7 I=1,NT
+      L=1
+      IF(SIDE(I).LT.0.) L=2
+      IAVAI(L)=IAVAI(L)+1
+      TAVAI(L)=TAVAI(L)-ABS(PV(5,I))
+    7 CONTINUE
+      NTH=NT
+      IF(NTH.GT.10) NTH=10
+      IF (NPRT(4))
+     $ WRITE(NEWBCD,3002) TAVAI,IAVAI,(IPA(I),SIDE(I),I=1,NTH)
+      IF(IAVAI(1).LE.0) GOTO 60
+      IF(IAVAI(2).LE.0) GOTO 60
+      IF(TAVAI(1).GT.0.) GOTO 11
+      CALL GRNDM(RNDM,1)
+      ISKIP=IFIX(RNDM(1)*(IAVAI(1)-1))+1
+      IS=0
+      DO 10  I=1,NT
+      II=NT-I+1
+      IF(SIDE(II).LT.0.) GOTO 10
+      IS=IS+1
+      IF(IS.NE.ISKIP) GOTO 10
+      IF(II.EQ.NT) GOTO 9
+      NT1=II+1
+      NT2=NT
+      DO 8 J=NT1,NT2
+      IPA(J-1)=IPA(J)
+      SIDE(J-1)=SIDE(J)
+      DO 71 K=1,10
+   71 PV(K,J-1)=PV(K,J)
+    8 CONTINUE
+      GOTO 9
+   10 CONTINUE
+    9 IPA(NT)=0
+      SIDE(NT)=0.
+      NT=NT-1
+      GOTO 6
+   11 IF(TAVAI(2).GT.0.) GOTO 15
+      CALL GRNDM(RNDM,1)
+      ISKIP=IFIX(RNDM(1)*(IAVAI(2)-1))+1
+      IS=0
+      DO 14  I=1,NT
+      II=NT-I+1
+      IF(SIDE(II).GT.0.) GOTO 14
+      IS=IS+1
+      IF(IS.NE.ISKIP) GOTO 14
+      IF(SIDE(II).LT.-1.5) NTARG=NTARG-1
+      IF(NTARG.LT.0) NTARG=0
+      IF(II.EQ.NT) GOTO 13
+      NT1=II+1
+      NT2=NT
+      DO 12 J=NT1,NT2
+      IPA(J-1)=IPA(J)
+      SIDE(J-1)=SIDE(J)
+      DO 74 K=1,10
+   74 PV(K,J-1)=PV(K,J)
+   12 CONTINUE
+      GOTO 13
+   14 CONTINUE
+   13 IPA(NT)=0
+      SIDE(NT)=0.
+      NT=NT-1
+      GOTO 6
+   15 IF(NT.LE.1) GOTO 60
+      IF(NT.EQ.MX) GOTO 29
+      NT1=NT+1
+      NT2=MX
+      DO 28 I=NT1,NT2
+   28 IPA(I)=0
+   29 CONTINUE
+C**
+C** NOW THE PREPARATION IS FINISHED.
+C** DEFINE INITIAL STATE VECTORS FOR LORENTZ TRANSFORMATIONS.
+C**
+      PV( 1,MX1)=0.
+      PV( 2,MX1)=0.
+      PV( 3,MX1)=P
+      PV( 4,MX1)=SQRT(P*P+AMAS*AMAS)
+      PV( 5,MX1)=ABS(AMAS)
+      PV( 1,MX2)=0.
+      PV( 2,MX2)=0.
+      PV( 3,MX2)=0.
+      PV( 4,MX2)=MP
+      PV( 5,MX2)=MP
+      PV( 1,MX4)=0.
+      PV( 2,MX4)=0.
+      PV( 3,MX4)=0.
+      PV( 4,MX4)=MP*(1.+TARG)
+      PV( 5,MX4)=PV(4,MX4)
+      PV( 1,MX8)=0.
+      PV( 2,MX8)=0.
+      PV( 3,MX8)=0.
+      PV( 1,MX9)=1.
+      PV( 2,MX9)=0.
+      PV( 3,MX9)=0.
+      CALL ADD(MX1,MX2,MX3)
+      CALL ADD(MX4,MX1,MX4)
+      CALL LOR(MX1,MX3,MX1)
+      CALL LOR(MX2,MX3,MX2)
+C**
+C** MAIN LOOP FOR 4-MOMENTUM GENERATION , SEE PITHA-REPORT (AACHEN)
+C** FOR A DETAILED DESCRIPTION OF THE METHOD.
+C**
+      CALL GRNDM(RNDM,1)
+      PHI=RNDM(1)*TWPI
+      EKIN1=0.
+      EKIN2=0.
+      DO 39 J=1,10
+      PV(J,MX5)=0.
+   39 PV(J,MX6)=0.
+      NPG=0
+      RMG0=0.
+      TARG1=0.
+      DO 16 III=1,NT
+      I=NT-III+1
+      IPA1=ABS(IPA(I))
+C**
+C** COUNT NUMBER OF BACKWARD NUCLEONS
+C**
+      IF(I.EQ.2) THEN
+         IF(IPA1.GT.16) THEN
+            CALL GRNDM(RNDM,1)
+            IF(RNDM(1).LT.0.2) GOTO 301
+         ELSE IF(IPA1.GE.14) THEN
+            GOTO 301
+         ENDIF
+      ENDIF
+      IF(SIDE(I).GT.-1.5) GOTO 38
+      IF(IPA1.EQ.14.OR.IPA1.EQ.16) GOTO 301
+      GOTO 38
+  301 NPG=NPG+1
+      IF(NPG.GT.18) GOTO 38
+      RMG0=RMG0+ABS(PV(5,I))
+      SIDE(I)=-3.
+      TARG1=TARG1+1.
+      GOTO 16
+   38 J=3
+      IF(IPA1.LT.14) J=2
+      IF(IPA1.LT.10) J=1
+      IF(I.LE.2) J=J+3
+      IF(SIDE(I).LT.-1.5) J=7
+      IF(J.EQ.7.AND.IPA1.GE.14) J=8
+C**
+C** SET PT - AND PHI VALUES, THEY ARE CHANGED SOMEWHAT IN THE ITERATION
+C** LOOP, SET MASS PARAMETER FOR LAMBDA FRAGMENTATION MODEL
+C**
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      BPP=BP(J)
+      BPE=PTEX(J)
+      PT2=-LOG(1.-RAN)/BPP
+      ASPAR=MASPAR(J)
+      PT2=PT2**BPE
+      PT =SQRT(PT2)
+      IF(PT.LT.0.05) THEN
+        CALL GRNDM(RNDM,1)
+        PT=0.3*RNDM(1)
+      ENDIF
+      IF(PT.LT.0.001) PT=0.001
+      PV(1,I)=PT*COS(PHI)
+      PV(2,I)=PT*SIN(PHI)
+      PV(10,I)=PT
+      BINL(1)=0.
+      RLMAX=1./PV(10,I)
+      DO 73 J=2,20
+   73 BINL(J)=RLMAX*(J-1)/19.
+      ET=PV(4,MX1)
+      IF(SIDE(I).LT.0.) THEN
+         ET=PV(4,MX2)
+      ENDIF
+      DNDL(1)=0.
+      NTRIAL=0
+C**
+C** START OF BIG ITERATION LOOP
+C**
+   30 NTRIAL=NTRIAL+1
+      IF(NTRIAL.GT. 2) GOTO 169
+      DO 17 L=2,20
+      DNDL(L)=0.
+      X=(BINL(L)+BINL(L-1))/2.
+      IF(PV(10,I).LT.0.001) PV(10,I)=0.001
+      IF(X.GT.1./PV(10,I)) GOTO 17
+      DX=BINL(L)-BINL(L-1)
+      DNDL(L)=ASPAR/SQRT((1.+(ASPAR*X)**2)**3)
+      DNDL(L)=ET*DNDL(L)/SQRT((X*PV(10,I)*ET)**2+PV(10,I)**2
+     *                             +PV(5,I)**2)
+      DNDL(L)=DNDL(L)*DX
+   17 DNDL(L)=DNDL(L-1)+DNDL(L)
+      NTRI=0
+   31 CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)*DNDL(20)
+      DO 18 L=2,20
+      IF(RAN.LT.DNDL(L)) GOTO 19
+   18 CONTINUE
+C**
+C** START OF SMALL ITERATION LOOP
+C**
+   19 NTRI=NTRI+1
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      DX=BINL(L)-BINL(L-1)
+      LAMB=BINL(L-1)+RAN*DX/2.
+      X=PV(10,I)*LAMB
+      IF(X.GT.1.) X=1.
+      X=X*SIDE(I)/ABS(SIDE(I))
+      PV(3,I)=X*ET
+      PV(4,I)=PV(3,I)**2+PV(10,I)**2+PV(5,I)**2
+      PV(4,I)=SQRT(PV(4,I))
+      IF(SIDE(I).LT.0.) GOTO 165
+      IF(I.GT.2) GOTO 20
+      EKIN=TAVAI(1)-EKIN1
+      CALL NORMAL(RAN)
+      IF(EKIN.LT.0.) EKIN=0.04*ABS(RAN)
+      PV(4,I)=ABS(PV(5,I))+EKIN
+      RNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP=SQRT(RNVE)
+      CALL LENGTX(I,PP1)
+C
+      IF (PP1 .GE. 1.0E-6) GO TO 8000
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP*COS(RTHNVE)
+      GO TO 8001
+ 8000 CONTINUE
+      PV(3,I) = PP**2 - PV(10,I)**2
+      IF(PV(3,I).LT.0.) PV(3,I)=0.
+      PV(3,I) = SQRT(PV(3,I))*SIDE(I)/ABS(SIDE(I))
+ 8001 CONTINUE
+C
+      CALL ADD(MX5,I,MX5)
+      GOTO 16
+   20 EKIN=EKIN1+PV(4,I)-ABS(PV(5,I))
+      IF(EKIN.LT.0.95*TAVAI(1)) GOTO 161
+      IF(NTRI.GT. 5) GOTO 167
+      PV(10,I)=PV(10,I)*0.9
+      PV( 1,I)=PV( 1,I)*0.9
+      PV( 2,I)=PV( 2,I)*0.9
+      DNDL(20)=DNDL(20)*0.9
+      IF((TAVAI(2)-ABS(PV(5,I))).LT.0.) GOTO 31
+      SIDE(I)=-1.
+      TAVAI(1)=TAVAI(1)+ABS(PV(5,I))
+      TAVAI(2)=TAVAI(2)-ABS(PV(5,I))
+      GOTO 31
+  161 CALL ADD(MX5,I,MX5)
+      EKIN1=EKIN1+PV(4,I)-ABS(PV(5,I))
+      GOTO 163
+  165 EKIN=EKIN2+PV(4,I)-ABS(PV(5,I))
+      XXX=0.95+0.05*TARG/20.
+      IF(XXX.GT.0.999) X=0.999
+      IF(EKIN.LT.XXX*TAVAI(2)) GOTO 166
+      IF(NTRI.GT. 5) GOTO 167
+      PV(10,I)=PV(10,I)*0.9
+      PV( 1,I)=PV( 1,I)*0.9
+      PV( 2,I)=PV( 2,I)*0.9
+      DNDL(20)=DNDL(20)*0.9
+      IF((TAVAI(1)-ABS(PV(5,I))).LT.0.) GOTO 31
+      SIDE(I)=+1.
+      TAVAI(1)=TAVAI(1)-ABS(PV(5,I))
+      TAVAI(2)=TAVAI(2)+ABS(PV(5,I))
+      GOTO 31
+  166 CALL ADD(MX6,I,MX6)
+      EKIN2=EKIN2+PV(4,I)-ABS(PV(5,I))
+  163 CALL ADD(MX5,MX6,MX7)
+      PV(3,MX7)=0.
+      CALL ANG(MX7,MX9,COST,PHIS)
+      IF(PV(2,MX7).LT.0.) PHIS=TWPI-PHIS
+      CALL NORMAL(RAN)
+      RAN=RAN*PI/12.
+      PHI=PHIS+PI+RAN
+      IF(PHI.GT.TWPI) PHI=PHI-TWPI
+      IF(PHI.LT.0.) PHI=TWPI-PHI
+      GOTO 16
+C**
+C** PARTICLE MOMENTUM ZERO, REDUCE KINETIC ENERGY OF ALL OTHER
+C**
+  167 EKIN1=0.
+      EKIN2=0.
+      DO 162 J=1,10
+      PV(J,MX5)=0.
+  162 PV(J,MX6)=0.
+      II=I+1
+      DO 168 L=II,NT
+      IF(ABS(IPA(L)).GE.14.AND.SIDE(L).LT.0.) GOTO 168
+      PV(4,L)=PV(4,L)*0.95+0.05*ABS(PV(5,L))
+      IF(PV(4,L).LT.ABS(PV(5,L))) PV(4,L)=ABS(PV(5,L))
+      RNVE=ABS(PV(4,L)**2-PV(5,L)**2)
+      PP=SQRT(RNVE)
+      CALL LENGTX(L,PP1)
+C
+      IF (PP1 .GE. 1.0E-6) GO TO 8002
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,L)=PP*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,L)=PP*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,L)=PP*COS(RTHNVE)
+      GO TO 8003
+ 8002 CONTINUE
+      PV(1,L)=PV(1,L)*PP/PP1
+      PV(2,L)=PV(2,L)*PP/PP1
+      PV(3,L)=PV(3,L)*PP/PP1
+ 8003 CONTINUE
+C
+      PV(10,L)=SQRT(PV(1,L)**2+PV(2,L)**2)
+      IF(SIDE(L).LT.0.) GOTO 164
+      EKIN1=EKIN1+PV(4,L)-ABS(PV(5,L))
+      CALL ADD(MX5,L,MX5)
+      GOTO 168
+  164 EKIN2=EKIN2+PV(4,L)-ABS(PV(5,L))
+      CALL ADD(MX6,L,MX6)
+  168 CONTINUE
+C *** NEXT STMT. CHANGED TO PREVENT FROM INFINITE LOOPING ***
+C*************      GOTO 38
+      GO TO 30
+C**
+C** SKIP PARTICLE, IF NOT ENOUGH ENERGY
+C**
+  169 IPA(I)=0
+      DO 170 J=1,10
+  170 PV(J,I)=0.
+      GOTO 163
+   16 CONTINUE
+      NTRI=0
+      II=0
+      DO 320 I=1,NT
+      IF(IPA(I).EQ.0) GOTO 320
+      II=II+1
+      IPA(II)=IPA(I)
+      SIDE(II)=SIDE(I)
+      DO 321 J=1,10
+  321 PV(J,II)=PV(J,I)
+  320 CONTINUE
+      NT=II
+C**
+C** BACKWARD NUCLEONS PRODUCED WITH A CLUSTER MODEL
+C**
+      IF(NPG.EQ.0) GOTO 330
+      RMG=RMG0
+      IF(NPG.EQ.1) GOTO 310
+      NPG1=NPG
+      IF(NPG1.GT.5) NPG1=5
+      CALL GRNDM(RNDM,1)
+      RMG=-LOG(1.-RNDM(1))
+      GPAR=G1PAR(NPG1)
+      CPAR=C1PAR(NPG1)
+      DUMNVE=GPAR
+      IF(DUMNVE.EQ.0.) DUMNVE=1.0E-10
+      RMG=RMG0+RMG**CPAR/DUMNVE
+  310 GA=1.2
+      EKIT1=0.04
+      EKIT2=0.6
+      IF(EK.GT.5.) GOTO 311
+      EKIT1=EKIT1*EK**2/25.
+      EKIT2=EKIT2*EK**2/25.
+  311 A=(1.-GA)/(EKIT2**(1.-GA)-EKIT1**(1.-GA))
+      DO 312 I=1,NT
+         IF(SIDE(I).GT.-2.5) GOTO 312
+         CALL GRNDM(RNDM,3)
+         EKIT=(RNDM(1)*(1.-GA)/A+EKIT1**(1.-GA))**(1./(1.-GA))
+         PV(4,I)=EKIT+PV(5,I)
+         DUMNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+         PP=SQRT(DUMNVE)
+         COST=LOG(2.23*RNDM(2)+0.383)/0.96
+         IF(COST.LT.-1.) COST=-1.
+         IF(COST.GT. 1.) COST= 1.
+         DUMNVE=1.0-COST*COST
+         IF(DUMNVE.LT.0.0) DUMNVE=0.0
+         SINT=SQRT(DUMNVE)
+         PHI=TWPI*RNDM(3)
+         PV(1,I)=PP*SINT*SIN(PHI)
+         PV(2,I)=PP*SINT*COS(PHI)
+         PV(3,I)=PP*COST
+         CALL LOR(I,MX3,I)
+         CALL ADD(MX6,I,MX6)
+  312 CONTINUE
+  330 IF (NPRT(4))
+     $ WRITE(NEWBCD,2002) NTRIAL,EKIN1,EKIN2,TAVAI(1),TAVAI(2)
+  175 IF (.NOT.NPRT(4)) GOTO 36
+      CALL ADD(MX5,MX6,MX7)
+      EKIN1=PV(4,MX1)+PV(4,MX2)
+      EKIN2=PV(4,MX5)+PV(4,MX6)
+      WRITE(NEWBCD,2000) EKIN1,EKIN2
+      I=MX1
+      WRITE(NEWBCD,2001) I,(PV(J,I),J=1,4)
+      I=MX2
+      WRITE(NEWBCD,2001) I,(PV(J,I),J=1,4)
+      I=MX5
+      WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      I=MX6
+      WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      DO 37 I=1,NT
+   37 WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+C**
+C** LORENTZ TRANSFORMATION IN LAB SYSTEM
+C**
+   36 IF(NT.LE.2) GOTO 60
+      TARG=0.
+      DO 601 I=1,NT
+      IF(PV(5,I).GT.0.5) TARG=TARG+1.
+      CALL LOR(I,MX2,I)
+  601 CONTINUE
+      IF(TARG.LT.0.5) TARG=1.
+      IF(LEAD.EQ.0) GOTO 6085
+      DO 6081 I=1,NT
+      IF(ABS(IPA(I)).EQ.LEAD) GOTO 6085
+ 6081 CONTINUE
+      I=1
+      IF(LEAD.GE.14.AND.ABS(IPA(2)).GE.14) I=2
+      IF(LEAD.LT.14.AND.ABS(IPA(2)).LT.14) I=2
+      IPA(I)=LEAD
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      PV(5,I)=RMASS(LEAD)
+      PV(7,I)=1.
+      IF(PV(5,I).LT.0.) PV(7,I)=-1.
+      PV(5,I)=ABS(PV(5,I))
+      PV(6,I)=RCHARG(LEAD)
+      PV(4,I)=PV(5,I)+EKIN
+      CALL LENGTX(I,PP)
+      RNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP1=SQRT(RNVE)
+      PV(1,I)=PP1*PV(1,I)/PP
+      PV(2,I)=PP1*PV(2,I)/PP
+      PV(3,I)=PP1*PV(3,I)/PP
+ 6085 KGENEV=1
+      PV(1,MX4)=0.
+      PV(2,MX4)=0.
+      PV(3,MX4)=P
+      PV(4,MX4)=SQRT(P*P+AMAS*AMAS)
+      PV(5,MX4)=ABS(AMAS)
+      EKIN0=PV(4,MX4)-PV(5,MX4)
+      PV(1,MX5)=0.
+      PV(2,MX5)=0.
+      PV(3,MX5)=0.
+      PV(4,MX5)=MP*TARG
+      PV(5,MX5)=PV(4,MX5)
+      EKIN=PV(4,MX4)+PV(4,MX5)
+      I=MX4
+      IF (NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      I=MX5
+      IF (NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      CALL ADD(MX4,MX5,MX6)
+      CALL LOR(MX4,MX6,MX4)
+      CALL LOR(MX5,MX6,MX5)
+      TECM=PV(4,MX4)+PV(4,MX5)
+      NPG=NT
+      PV(1,MX8)=0.
+      PV(2,MX8)=0.
+      PV(3,MX8)=0.
+      PV(4,MX8)=0.
+      PV(5,MX8)=0.
+      EKIN1=0.
+      DO 598 I=1,NPG
+      IF (NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+      CALL ADD(MX8,I,MX8)
+      EKIN1=EKIN1+PV(4,I)-PV(5,I)
+      EKIN=EKIN-PV(5,I)
+      IF(I.GT.18) GOTO 598
+      AMASS(I)=PV(5,I)
+  598 CONTINUE
+      IF(NPG.GT.18) GOTO 597
+      CALL PHASP
+      EKIN=0.
+      DO 599 I=1,NPG
+      PV(1,MX7)=PCM(1,I)
+      PV(2,MX7)=PCM(2,I)
+      PV(3,MX7)=PCM(3,I)
+      PV(4,MX7)=PCM(4,I)
+      PV(5,MX7)=AMASS(I)
+      CALL LOR(MX7,MX5,MX7)
+  599 EKIN=EKIN+PV(4,MX7)-PV(5,MX7)
+      CALL ANG(MX8,MX4,COST,TETA)
+      IF (NPRT(4)) WRITE(NEWBCD,2003) TETA,EKIN0,EKIN1,EKIN
+C**
+C** MAKE SHURE, THAT  KINETIC ENERGIES ARE CORRECT.
+C** EKIN= KINETIC ENERGY THEORETICALLY
+C** EKIN1= KINETIC ENERGY SIMULATED
+C**
+  597 IF(EKIN1.EQ.0.) GOTO 600
+      PV(1,MX7)=0.
+      PV(2,MX7)=0.
+      PV(3,MX7)=0.
+      PV(4,MX7)=0.
+      PV(5,MX7)=0.
+      WGT=EKIN/EKIN1
+      EKIN1=0.
+      DO 602 I=1,NT
+      EKIN=PV(4,I)-PV(5,I)
+      EKIN=EKIN*WGT
+      PV(4,I)=EKIN+PV(5,I)
+      RNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP=SQRT(RNVE)
+      CALL LENGTX(I,PP1)
+C
+      IF (PP1 .GE. 1.0E-6) GO TO 8008
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP*COS(RTHNVE)
+      GO TO 8009
+ 8008 CONTINUE
+      PV(1,I)=PV(1,I)*PP/PP1
+      PV(2,I)=PV(2,I)*PP/PP1
+      PV(3,I)=PV(3,I)*PP/PP1
+ 8009 CONTINUE
+C
+      EKIN1=EKIN1+EKIN
+      CALL ADD(MX7,I,MX7)
+  602 CONTINUE
+      CALL ANG(MX7,MX4,COST,TETA)
+      IF (NPRT(4)) WRITE(NEWBCD,2003) TETA,EKIN0,EKIN1
+C**
+C** ROTATE IN DIRECTION OF Z-AXIS, THIS DOES DISTURB IN SOME WAY OUR
+C** INCLUSIVE DISTRIBUTIONS, BUT IT IS NESSACARY FOR MOMENTUM CONSER-
+C** VATION.
+C**
+  600 PV(1,MX7)=0.
+      PV(2,MX7)=0.
+      PV(3,MX7)=0.
+      PV(4,MX7)=0.
+      PV(5,MX7)=0.
+      DO 596 I=1,NT
+      CALL ADD(MX7,I,MX7)
+  596 CONTINUE
+C**
+C** SOME SMEARING IN TRANSVERSE DIRECTION FROM FERMI MOTION
+C**
+*          CALL RANNOR(RAN1,RAN2)
+      CALL GRNDM(RNDM,2)
+      RY=RNDM(1)
+      RZ=RNDM(2)
+      RX=6.283185*RZ
+      A1=SQRT(-2.*LOG(RY))
+      RAN1=A1*SIN(RX)
+      RAN2=A1*COS(RX)
+      PV(1,MX7)=PV(1,MX7)+RAN1*0.020*TARG
+      PV(2,MX7)=PV(2,MX7)+RAN2*0.020*TARG
+      CALL DEFS(MX4,MX7,MX8)
+      PV(1,MX7)=0.
+      PV(2,MX7)=0.
+      PV(3,MX7)=0.
+      PV(4,MX7)=0.
+      PV(5,MX7)=0.
+      DO 595 I=1,NT
+      CALL TRAC(I,MX8,I)
+      CALL ADD(MX7,I,MX7)
+  595 CONTINUE
+      CALL ANG(MX7,MX4,COST,TETA)
+      IF (NPRT(4)) WRITE(NEWBCD,2003) TETA
+C**
+C** ROTATE IN DIRECTION OF PRIMARY PARTICLE, SUBTRACT BINDING ENERGIES
+C** AND MAKE SOME FURTHER CORRECTIONS IF REQUIRED (STEEP, STEEQ)
+C**
+      DEKIN=0.
+      NPIONS=0
+      EK1=0.
+      EK2=0.
+      DO 21 I=1,NT
+      CALL DEFS1(I,MXGKPV-1,I)
+      IF (NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+      IF(ATNO2.LT.1.5) GOTO 21
+      CALL LENGTX(I,PP)
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      CALL NORMAL(RAN)
+      EKIN=EKIN-CFA*(1.+0.5*RAN)
+      IF (EKIN .LT. 1.0E-6) EKIN=1.0E-6
+      CALL STEEQ(XXH,I)
+      DEKIN=DEKIN+EKIN*(1.-XXH)
+      EKIN=EKIN*XXH
+      IF(ABS(IPA(I)).GE.7.AND.ABS(IPA(I)).LE.9) NPIONS=NPIONS+1
+      IF(ABS(IPA(I)).GE.7.AND.ABS(IPA(I)).LE.9) EK1=EK1+EKIN
+      PP1=SQRT(EKIN*(EKIN+2.*ABS(PV(5,I))))
+      PV(4,I)=EKIN+ABS(PV(5,I))
+C
+      IF (PP .GE. 1.0E-6) GO TO 8010
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP1*COS(RTHNVE)
+      GO TO 8011
+ 8010 CONTINUE
+      PV(1,I)=PV(1,I)*PP1/PP
+      PV(2,I)=PV(2,I)*PP1/PP
+      PV(3,I)=PV(3,I)*PP1/PP
+ 8011 CONTINUE
+C
+   21 CONTINUE
+      IF(EK1.EQ.0.) GOTO 23
+      IF(NPIONS.EQ.0) GOTO 23
+      DEKIN=1.+DEKIN/EK1
+      DO 22 I=1,NT
+      IF(ABS(IPA(I)).LT.7.OR.ABS(IPA(I)).GT.9) GOTO 22
+      CALL LENGTX(I,PP)
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      EKIN=EKIN*DEKIN
+      IF (EKIN .LT. 1.0E-6) EKIN=1.0E-6
+      PP1=SQRT(EKIN*(EKIN+2.*ABS(PV(5,I))))
+      PV(4,I)=EKIN+ABS(PV(5,I))
+C
+      IF (PP .GE. 1.0E-6) GO TO 8012
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP1*COS(RTHNVE)
+      GO TO 8013
+ 8012 CONTINUE
+      PV(1,I)=PV(1,I)*PP1/PP
+      PV(2,I)=PV(2,I)*PP1/PP
+      PV(3,I)=PV(3,I)*PP1/PP
+ 8013 CONTINUE
+C
+   22 CONTINUE
+C**
+C** ADD BLACK TRACK PARTICLES, THE TOTAL NUMBER OF PARTICLES PRODUCED
+C** IS RESTRICTED TO 198, THIS MAY HAVE INFLUENCE ON VERY HIGH ENERGY
+C** FIRST PROTONS AND NEUTRONS
+C**
+   23 IF(ATNO2.LT.1.5) GOTO 40
+      CALL HIGHAB(SPROB)
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SPROB) GOTO 40
+      TEX=ENP(1)
+      SPALL=TARG
+      IF(TEX.LT.0.001) GOTO 445
+      BLACK=(1.5+1.25*TARG)*ENP(1)/(ENP(1)+ENP(3))
+      CALL POISSO(BLACK,NBL)
+      IF (NPRT(4)) WRITE(NEWBCD,3003) NBL,TEX
+      IF(IFIX(TARG)+NBL.GT.ATNO2) NBL=ATNO2-TARG
+      IF(NT+NBL.GT.MXGKPV-10) NBL=MXGKPV-10-NT
+      IF(NBL.LE.0) GOTO 445
+      EKIN=TEX/NBL
+      EKIN2=0.
+      CALL STEEP(XX)
+      DO 441 I=1,NBL
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SPROB) GOTO 441
+      IF(NT.EQ.MXGKPV-10) GOTO 441
+      IF(EKIN2.GT.TEX) GOTO 443
+      CALL GRNDM(RNDM,1)
+      RAN1=RNDM(1)
+      CALL NORMAL(RAN2)
+      EKIN1=-EKIN*LOG(RAN1)-CFA*(1.+0.5*RAN2)
+      IF(EKIN1.LT.0.0) EKIN1=-0.010*LOG(RAN1)
+      EKIN1=EKIN1*XX
+      EKIN2=EKIN2+EKIN1
+      IF(EKIN2.GT.TEX) EKIN1=TEX-(EKIN2-EKIN1)
+      IF (EKIN1 .LT. 0.0) EKIN1=1.0E-6
+      IPA1=16
+      PNRAT=1.-ZNO2/ATNO2
+      CALL GRNDM(RNDM,3)
+      IF(RNDM(1).GT.PNRAT) IPA1=14
+      NT=NT+1
+      SPALL=SPALL+1.
+      COST=-1.+RNDM(2)*2.
+      SINT=SQRT(ABS(1.-COST*COST))
+      PHI=TWPI*RNDM(3)
+      IPA(NT)=-IPA1
+      SIDE(NT)=-4.
+      PV(5,NT)=ABS(RMASS(IPA1))
+      PV(6,NT)=RCHARG(IPA1)
+      PV(7,NT)=1.
+      PV(4,NT)=EKIN1+PV(5,NT)
+      RNVE=ABS(PV(4,NT)**2-PV(5,NT)**2)
+      PP=SQRT(RNVE)
+      PV(1,NT)=PP*SINT*SIN(PHI)
+      PV(2,NT)=PP*SINT*COS(PHI)
+      PV(3,NT)=PP*COST
+  441 CONTINUE
+  443 IF(ATNO2.LT.10.) GOTO 445
+      IF(EK.GT.2.0) GOTO 445
+      II=NT+1
+      KK=0
+      EKA=EK
+      IF(EKA.GT.1.) EKA=EKA*EKA
+      IF(EKA.LT.0.1) EKA=0.1
+      IKA=3.6*EXP((ZNO2**2/ATNO2-35.56)/6.45)/EKA
+      IF(IKA.LE.0) GO TO 445
+      DO 444 I=1,NT
+      II=II-1
+      IF(IPA(II).NE.-14) GOTO 444
+      IPA(II)=-16
+      IPA1  = 16
+      PV(5,II)=ABS(RMASS(IPA1))
+      PV(6,II)=RCHARG(IPA1)
+      KK=KK+1
+      IF(KK.GT.IKA) GOTO 445
+  444 CONTINUE
+C**
+C** THEN ALSO DEUTERONS, TRITONS AND ALPHAS
+C**
+  445 TEX=ENP(3)
+      IF(TEX.LT.0.001) GOTO 40
+      BLACK=(1.5+1.25*TARG)*ENP(3)/(ENP(1)+ENP(3))
+      CALL POISSO(BLACK,NBL)
+      IF(NT+NBL.GT.MXGKPV-10) NBL=MXGKPV-10-NT
+      IF(NBL.LE.0) GOTO 40
+      EKIN=TEX/NBL
+      EKIN2=0.
+      CALL STEEP(XX)
+      IF (NPRT(4)) WRITE(NEWBCD,3004) NBL,TEX
+      DO 442 I=1,NBL
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SPROB) GOTO 442
+      IF(NT.EQ.MXGKPV-10) GOTO 442
+      IF(EKIN2.GT.TEX) GOTO 40
+      CALL GRNDM(RNDM,1)
+      RAN1=RNDM(1)
+      CALL NORMAL(RAN2)
+      EKIN1=-EKIN*LOG(RAN1)-CFA*(1.+0.5*RAN2)
+      IF(EKIN1.LT.0.0) EKIN1=-0.010*LOG(RAN1)
+      EKIN1=EKIN1*XX
+      EKIN2=EKIN2+EKIN1
+      IF(EKIN2.GT.TEX) EKIN1=TEX-(EKIN2-EKIN1)
+      IF (EKIN1 .LT. 0.0) EKIN1=1.0E-6
+      CALL GRNDM(RNDM,3)
+      COST=-1.+RNDM(1)*2.
+      SINT=SQRT(ABS(1.-COST*COST))
+      PHI=TWPI*RNDM(2)
+      RAN=RNDM(3)
+      IPA(NT+1)=-30
+      IF(RAN.GT.0.60) IPA(NT+1)=-31
+      IF(RAN.GT.0.90) IPA(NT+1)=-32
+      SIDE(NT+1)=-4.
+      PV(5,NT+1)=(ABS(IPA(NT+1))-28)*MP
+      SPALL=SPALL+PV(5,NT+1)*1.066
+      IF(SPALL.GT.ATNO2) GOTO 40
+      NT=NT+1
+      PV(6,NT)=1.
+      IF(IPA(NT).EQ.-32) PV(6,NT)=2.
+      PV(7,NT)=1.
+      PV(4,NT)=PV(5,NT)+EKIN1
+      RNVE=ABS(PV(4,NT)**2-PV(5,NT)**2)
+      PP=SQRT(RNVE)
+      PV(1,NT)=PP*SINT*SIN(PHI)
+      PV(2,NT)=PP*SINT*COS(PHI)
+      PV(3,NT)=PP*COST
+  442 CONTINUE
+C**
+C** STORE ON EVENT COMMON
+C**
+   40 CALL GRNDM(RNDM,1)
+      IF(RS.GT.(4.+RNDM(1))) GOTO 42
+      DO 41 I=1,NT
+      CALL LENGTX(I,ETB)
+      IF(ETB.LT.P) GOTO 41
+      ETF=P
+      PV(4,I)=SQRT(PV(5,I)**2+ETF**2)
+      ETF=ETF/ETB
+      PV(1,I)=PV(1,I)*ETF
+      PV(2,I)=PV(2,I)*ETF
+      PV(3,I)=PV(3,I)*ETF
+   41 CONTINUE
+   42 EKIN=PV(4,MXGKPV)-ABS(PV(5,MXGKPV))
+      EKIN1=PV(4,MXGKPV-1)-ABS(PV(5,MXGKPV-1))
+      EKIN2=0.
+      CALL TDELAY(TOF1)
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      TOF=TOF-TOF1*LOG(RAN)
+      DO 44 I=1,NT
+      IF(PV(7,I).LT.0.) PV(5,I)=-PV(5,I)
+      PV(7,I)=TOF
+      PV(8,I)=ABS(IPA(I))
+      PV(9,I)=0.
+   44 PV(10,I)=0.
+      CALL GHETUN(NT)
+      DO 55 I=1,NT
+         EKIN2=EKIN2+PV(4,I)-ABS(PV(5,I))
+   55 CONTINUE
+      EKIN2=(EKIN2-EKIN)/EKIN
+      IF(NPRT(4))
+     $             WRITE(NEWBCD,2006) NT,EKIN,ENP(1),ENP(3),EKIN1,EKIN2
+      IF(EKIN2.GT.0.2) GOTO 60
+C**
+      INTCT=INTCT+1.
+      CALL SETCUR(NT)
+      NTK=NTK+1
+      IF(NT.EQ.1) GO TO 9999
+      DO 50 II=2,NT
+      I=II-1
+      IF(NTOT.LT.NSIZE/12) GOTO 43
+      GO TO 9999
+   43 CALL SETTRK(I)
+   50 CONTINUE
+C
+ 2002 FORMAT(' *HIGXPT* PRODUCTION OF FINAL STATE KINEMATIC AFTER ',I3,
+     $ ' TRIALS.  KINETIC ENERGIES ',2F6.2,' OUT OF ',2F6.2)
+ 2000 FORMAT(' *HIGXPT* CMS PARAMETERS OF FINAL STATE PARTICLES,',
+     $ ' ENERGIES IN INITIAL AND FINAL STATE ',2F6.2)
+ 2001 FORMAT(' *HIGXPT* TRACK',2X,I3,2X,10F8.3,2X,I3,2X,F4.0)
+ 2003 FORMAT(' *HIGXPT* TETA,EKIN0,EKIN1,EKIN ',4F10.4)
+ 2006 FORMAT(' *HIGXPT* COMP.',1X,I5,1X,5F7.2)
+ 3001 FORMAT(' *HIGXPT* NUCLEAR EXCITATION',I5,
+     $ ' PARTICLES PRODUCED IN ADDITION  TO ',I5,' NORMAL PARTICLES')
+ 3002 FORMAT(' *HIGXPT* AVAILABLE ENERGIES ',2F10.4,
+     $ ' FOR ',2I3,' PARTICLES IN BEAM/TARGET FRAGM. REGION',
+     $ ' WITH IPA/SIDE ARRAY '/
+     $ 1H ,5X,10(I3,2X,F3.0,4X))
+ 3003 FORMAT(' *HIGXPT* ',I3,' BLACK TRACK PARTICLES PRODUCED',
+     $ ' WITH TOTAL KINETIC ENERGY OF ',F8.3,' GEV')
+ 3004 FORMAT(' *HIGXPT* ',I5,' HEAVY FRAGMENTS PRODUCED',
+     $ ' WITH TOTAL ENERGY OF',F8.4,' GEV')
+C
+ 9999 CONTINUE
+C
+      RETURN
+      END
+*-- AUTHOR :
+      INTEGER FUNCTION NFAC(N)
+C
+C *** NVE 16-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (27-OCT-1983)
+C
+      NFAC=1.
+      M=N
+      IF(M.LE.1) RETURN
+      IF(M.GT.10) M=10
+      DO 1 I=2,M
+    1 NFAC=NFAC*I
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE NORMAL(RAN)
+C
+C *** NVE 14-APR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (27-OCT-1983)
+C
+      DIMENSION RNDM(12)
+      RAN=-6.
+      CALL GRNDM(RNDM,12)
+      DO 1 I=1,12
+      RAN=RAN+RNDM(I)
+ 1    CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE NUCREC(NOPT,IREC)
+C
+C *** NUCLEAR REACTION KINEMATICS AT LOW ENERGIES ***
+C *** NVE 18-MAY-1988 CERN GENEVA ***
+C
+C CALLED BY : GHEISH, GNSLWD
+C ORIGIN    : H.FESEFELDT (12-FEB-1987)
+C
+C NOPT=1   N M(A,Z) --> G (G) M(A+1,Z  )    NEUTRON CAPTURE
+C NOPT=2   N M(A,Z) --> N (G) M(A  ,Z  )    INELASTIC NEUTRON SCATT.
+C NOPT=3   N M(A,Z) --> P (G) M(A  ,Z-1)
+C NOPT=4   N M(A,Z) --> D (G) M(A-1,Z-1)
+C NOPT=5   N M(A,Z) --> T (G) M(A-2,Z-1)
+C NOPT=6   N M(A,Z) --> ALP.  M(A-3,Z-2)
+C NOPT=7   N M(A,Z) --> N N   M(A-1,Z  )
+C NOPT=8   N M(A,Z) --> N P   M(A-1,Z-1)
+C NOPT=9   N M(A,Z) --> P P   M(A-1,Z-2)
+C NOPT=11  P M(A,Z) --> G (G) M(A+1,Z+1)    PROTON CAPTURE
+C NOPT=12  P M(A,Z) --> N (G) M(A  ,Z  )    INELASTIC PROTON SCATT.
+C NOPT=13  P M(A,Z) --> P (G) M(A  ,Z+1)
+C NOPT=14  P M(A,Z) --> D (G) M(A-1,Z  )
+C NOPT=15  P M(A,Z) --> T (G) M(A-2,Z  )
+C NOPT=16  P M(A,Z) --> ALP.  M(A-3,Z-1)
+C NOPT=17  P M(A,Z) --> N N   M(A-1,Z+1)
+C NOPT=18  P M(A,Z) --> N P   M(A-1,Z  )
+C NOPT=19  P M(A,Z) --> P P   M(A-1,Z-1)
+C SIMILAR FOR D,T,ALPHA SCATTERING ON NUCLEI
+C
+C NOTE : DOUBLE PRECISION CALCULATIONS ARE VITAL FOR THESE LOW
+C        ENERGY PROCESSES
+C        THEREFORE THE VARS OF /GENIO/ ARE DECLARED DOUBLE PRECISION
+C        ALSO A DOUBLE PRECISION VERSION OF THE PHASE SPACE PACKAGE
+C        "PHPNUC" HAS BEEN INTRODUCED
+C *** HMF 29-AUG-1989 RWTH AACHEN ***
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      COMMON/NUCIN /TECM,AMASS(18),NPG,KGENEV
+      COMMON/NUCOUT/PCM(5,18),WGT
+      DOUBLE PRECISION TECM,AMASS,PCM,WGT
+C
+C
+C
+      DIMENSION QVAL(10),TCH(10)
+      DIMENSION RNDM(2)
+C
+C** PROGRAM RETURNS WITH NOPT=0, IF INELASTIC SCATTERING ENERGETICALLY
+C** NOT POSSIBLE, OR IF WRONG PARTICLES ENTER THIS ROUTINE: ONLY FOR
+C** PROTONS,NEUTRONS, DEUTERIUM, TRITIUM AND ALPHAS.
+C** IF EK > 100 MEV, THIS ROUTINE IS CERTAINLY NOT ADEQUATE.
+C
+      NOPT=0
+      IF (IREC .EQ. 0) GO TO 9999
+C
+      IF (NPRT(9) .AND. (EK .GT. 0.1)) PRINT 9000,EK,IPART
+ 9000 FORMAT(' *NUCREC* ENERGY TOO HIGH EK = ',G12.5,' GEV ',
+     $ ' KPART = ',I3)
+      IF (EK .GT. 0.1) GO TO 9999
+C
+C%%%      IF(IPART.EQ.16) GOTO 2
+C%%%      IF(IPART.EQ.14) GOTO 3
+C%%%      IF(IPART.EQ.30) GOTO 4
+C%%%      IF(IPART.EQ.31) GOTO 5
+C%%%      IF(IPART.EQ.32) GOTO 6
+C%%%      GO TO 9999
+C%%%    2 AMAS = ATOMAS(1.,0.)
+C%%%      GOTO 8
+C%%%    3 AMAS = ATOMAS(1.,1.)
+C%%%      GOTO 8
+C%%%    4 AMAS = ATOMAS(2.,1.)
+C%%%      GOTO 8
+C%%%    5 AMAS = ATOMAS(3.,1.)
+C%%%      GOTO 8
+C%%%    6 AMAS = ATOMAS(4.,2.)
+C
+      IF (IPART .EQ. 16) GO TO 8
+      IF (IPART .EQ. 14) GO TO 8
+      IF (IPART .EQ. 30) GO TO 8
+      IF (IPART .EQ. 31) GO TO 8
+      IF( IPART .EQ. 32) GO TO 8
+      GO TO 9999
+C** SET BEAM PARTICLE, TAKE EK AS FUNDAMENTAL QUANTITY
+C** DUE TO THE DIFFICULT KINEMATIC, ALL MASSES HAVE TO BE ASSIGNED
+C** THE BEST MEASURED VALUES.
+ 8    CONTINUE
+      CALL VZERO(QVAL,10)
+      CALL VZERO(TCH ,10)
+C --- GET MASS WHICH MATCHES GEANT ---
+      AMAS=RMASS(IPART)
+      EN=EK+ABS(AMAS)
+      P =SQRT(ABS(EN*EN-AMAS*AMAS))
+      PP=SQRT(PX*PX+PY*PY+PZ*PZ)
+      IF (PP .GT. 1.0E-6) GO TO 8000
+      CALL GRNDM(RNDM,2)
+      PHINVE=TWPI*RNDM(1)
+      COST=-1.+2.*RNDM(2)
+      IF (COST .LE. -1.) COST=-1.
+      IF (COST .GE.  1.) COST= 1.
+      RTHNVE=ACOS(COST)
+      PX=SIN(RTHNVE)*COS(PHINVE)
+      PY=SIN(RTHNVE)*SIN(PHINVE)
+      PZ=COS(RTHNVE)
+      PP=1.
+ 8000 CONTINUE
+      PX=PX/PP
+      PY=PY/PP
+      PZ=PZ/PP
+      CALL VZERO(PV,10*MXGKPV)
+      PV(1,1) =PX*P
+      PV(2,1) =PY*P
+      PV(3,1) =PZ*P
+      PV(4,1) =EN
+      PV(5,1) =AMAS
+      PV(6,1) =NCH
+      PV(7,1) =TOF
+      PV(8,1) =IPART
+      PV(9,1) =0.
+      PV(10,1)=USERW
+      PV(1,2) =0.
+      PV(2,2) =0.
+      PV(3,2) =0.
+      PV(4,2) =0.
+      PV(5,2) =ATOMAS(ATNO2,ZNO2)
+      PV(6,2) =ZNO2
+      PV(7,2) =TOF
+      PV(8,2) =0.
+      PV(9,2) =0.
+      PV(10,2)=0.
+C** CALCULATE Q-VALUE OF REACTIONS
+      IF(IPART.EQ.16) GOTO 20
+      IF(IPART.EQ.14) GOTO 30
+      IF(IPART.EQ.30) GOTO 40
+      IF(IPART.EQ.31) GOTO 50
+      IF(IPART.EQ.32) GOTO 60
+   20 PV(5,11)=ATOMAS(ATNO2+1.,ZNO2   )
+      PV(6,11)=ZNO2
+      PV(5,21)=0.
+      PV(6,21)=0.
+      PV(8,21)=1.
+      PV(5,31)=0.
+      PV(6,31)=0.
+      PV(8,31)=1.
+C
+      PV(5,12)=PV(5,2)
+      PV(6,12)=PV(6,2)
+      PV(5,22)=RMASS(16)
+      PV(6,22)=0.
+      PV(8,22)=16.
+      PV(5,32)=0.
+      PV(6,32)=0.
+      PV(8,32)=1.
+C
+      PV(5,13)=ATOMAS(ATNO2   ,ZNO2-1.)
+      PV(6,13)=ZNO2-1.
+      PV(5,23)=RMASS(14)
+      PV(6,23)=1.
+      PV(8,23)=14.
+      PV(5,33)=0.
+      PV(6,33)=0.
+      PV(8,33)=1.
+C
+      PV(5,14)=ATOMAS(ATNO2-1.,ZNO2-1.)
+      PV(6,14)=ZNO2-1.
+      PV(5,24)=RMASS(30)
+      PV(6,24)=1.
+      PV(8,24)=30.
+      PV(5,34)=0.
+      PV(6,34)=0.
+      PV(8,34)=1.
+C
+      PV(5,15)=ATOMAS(ATNO2-2.,ZNO2-1.)
+      PV(6,15)=ZNO2-1.
+      PV(5,25)=RMASS(31)
+      PV(6,25)=1.
+      PV(8,25)=31.
+      PV(5,35)=0.
+      PV(6,35)=0.
+      PV(8,35)=1.
+C
+      PV(5,16)=ATOMAS(ATNO2-3.,ZNO2-2.)
+      PV(6,16)=ZNO2-2.
+      PV(5,26)=RMASS(32)
+      PV(6,26)=2.
+      PV(8,26)=32.
+      PV(5,36)=0.
+      PV(6,36)=0.
+      PV(8,36)=1.
+C
+      PV(5,17)=ATOMAS(ATNO2-1.,ZNO2   )
+      PV(6,17)=ZNO2
+      PV(5,27)=PV(5,22)
+      PV(6,27)=0.
+      PV(8,27)=16.
+      PV(5,37)=PV(5,22)
+      PV(6,37)=0.
+      PV(8,37)=16.
+C
+      PV(5,18)=PV(5,14)
+      PV(6,18)=PV(6,14)
+      PV(5,28)=PV(5,22)
+      PV(6,28)=0.
+      PV(8,28)=16.
+      PV(5,38)=PV(5,23)
+      PV(6,38)=1.
+      PV(8,38)=14.
+C
+      PV(5,19)=ATOMAS(ATNO2-1.,ZNO2-2.)
+      PV(6,19)=ZNO2-2.
+      PV(5,29)=PV(5,23)
+      PV(6,29)=1.
+      PV(8,29)=14.
+      PV(5,39)=PV(5,23)
+      PV(6,39)=1.
+      PV(8,39)=14.
+C
+      GOTO 70
+   30 PV(5,11)=ATOMAS(ATNO2+1.,ZNO2+1.)
+      PV(6,11)=ZNO2+1.
+      PV(5,21)=0.
+      PV(6,21)=0.
+      PV(8,21)=1.
+      PV(5,31)=0.
+      PV(6,31)=0.
+      PV(8,31)=1.
+C
+      PV(5,12)=ATOMAS(ATNO2   ,ZNO2+1.)
+      PV(6,12)=ZNO2+1.
+      PV(5,22)=RMASS(16)
+      PV(6,22)=0.
+      PV(8,22)=16.
+      PV(5,32)=0.
+      PV(6,32)=0.
+      PV(8,32)=1.
+C
+      PV(5,13)=PV(5,2)
+      PV(6,13)=PV(6,2)
+      PV(5,23)=RMASS(14)
+      PV(6,23)=1.
+      PV(8,23)=14.
+      PV(5,33)=0.
+      PV(6,33)=0.
+      PV(8,33)=1.
+C
+      PV(5,14)=ATOMAS(ATNO2-1.,ZNO2   )
+      PV(6,14)=ZNO2
+      PV(5,24)=RMASS(30)
+      PV(6,24)=1.
+      PV(8,24)=30.
+      PV(5,34)=0.
+      PV(6,34)=0.
+      PV(8,34)=1.
+C
+      PV(5,15)=ATOMAS(ATNO2-2.,ZNO2   )
+      PV(6,15)=ZNO2
+      PV(5,25)=RMASS(31)
+      PV(6,25)=1.
+      PV(8,25)=31.
+      PV(5,35)=0.
+      PV(6,35)=0.
+      PV(8,35)=1.
+C
+      PV(5,16)=ATOMAS(ATNO2-3.,ZNO2-1.)
+      PV(6,16)=ZNO2-1.
+      PV(5,26)=RMASS(32)
+      PV(6,26)=2.
+      PV(8,26)=32.
+      PV(5,36)=0.
+      PV(6,36)=0.
+      PV(8,36)=1.
+C
+      PV(5,17)=ATOMAS(ATNO2-1.,ZNO2+1.)
+      PV(6,17)=ZNO2+1.
+      PV(5,27)=PV(5,22)
+      PV(6,27)=0.
+      PV(8,27)=16.
+      PV(5,37)=PV(5,22)
+      PV(6,37)=0.
+      PV(8,37)=16.
+C
+      PV(5,18)=PV(5,14)
+      PV(6,18)=PV(6,14)
+      PV(5,28)=PV(5,22)
+      PV(6,28)=0.
+      PV(8,28)=16.
+      PV(5,38)=PV(5,23)
+      PV(6,38)=1.
+      PV(8,38)=14.
+C
+      PV(5,19)=ATOMAS(ATNO2-1.,ZNO2-1.)
+      PV(6,19)=ZNO2-1.
+      PV(5,29)=PV(5,23)
+      PV(6,29)=1.
+      PV(8,29)=14.
+      PV(5,39)=PV(5,23)
+      PV(6,39)=1.
+      PV(8,39)=14.
+C
+      NOPT=10
+      GOTO 70
+   40 PV(5,11)=ATOMAS(ATNO2+2.,ZNO2+1.)
+      PV(6,11)=ZNO2+1.
+      PV(5,21)=0.
+      PV(6,21)=0.
+      PV(8,21)=1.
+      PV(5,31)=0.
+      PV(6,31)=0.
+      PV(8,31)=1.
+C
+      PV(5,12)=ATOMAS(ATNO2+1.,ZNO2+1.)
+      PV(6,12)=ZNO2+1.
+      PV(5,22)=RMASS(16)
+      PV(6,22)=0.
+      PV(8,22)=16.
+      PV(5,32)=0.
+      PV(6,32)=0.
+      PV(8,32)=1.
+C
+      PV(5,13)=ATOMAS(ATNO2+1.,ZNO2   )
+      PV(6,13)=ZNO2
+      PV(5,23)=RMASS(14)
+      PV(6,23)=1.
+      PV(8,23)=14.
+      PV(5,33)=0.
+      PV(6,33)=0.
+      PV(8,33)=1.
+C
+      PV(5,14)=PV(5,2)
+      PV(6,14)=PV(6,2)
+      PV(5,24)=RMASS(30)
+      PV(6,24)=1.
+      PV(8,24)=30.
+      PV(5,34)=0.
+      PV(6,34)=0.
+      PV(8,34)=1.
+C
+      PV(5,15)=ATOMAS(ATNO2-1.,ZNO2   )
+      PV(6,15)=ZNO2
+      PV(5,25)=RMASS(31)
+      PV(6,25)=1.
+      PV(8,25)=31.
+      PV(5,35)=0.
+      PV(6,35)=0.
+      PV(8,35)=1.
+C
+      PV(5,16)=ATOMAS(ATNO2-2.,ZNO2-1.)
+      PV(6,16)=ZNO2-1.
+      PV(5,26)=RMASS(32)
+      PV(6,26)=2.
+      PV(8,26)=32.
+      PV(5,36)=0.
+      PV(6,36)=0.
+      PV(8,36)=1.
+C
+      PV(5,17)=ATOMAS(ATNO2   ,ZNO2+1.)
+      PV(6,17)=ZNO2+1.
+      PV(5,27)=PV(5,22)
+      PV(6,27)=0.
+      PV(8,27)=16.
+      PV(5,37)=PV(5,22)
+      PV(6,37)=0.
+      PV(8,37)=16.
+C
+      PV(5,18)=PV(5,14)
+      PV(6,18)=PV(6,14)
+      PV(5,28)=PV(5,22)
+      PV(6,28)=0.
+      PV(8,28)=16.
+      PV(5,38)=PV(5,23)
+      PV(6,38)=1.
+      PV(8,38)=14.
+C
+      PV(5,19)=ATOMAS(ATNO2   ,ZNO2-1.)
+      PV(6,19)=ZNO2-1.
+      PV(5,29)=PV(5,23)
+      PV(6,29)=1.
+      PV(8,29)=14.
+      PV(5,39)=PV(5,23)
+      PV(6,39)=1.
+      PV(8,39)=14.
+C
+      NOPT=20
+      GOTO 70
+   50 PV(5,11)=ATOMAS(ATNO2+3.,ZNO2+1.)
+      PV(6,11)=ZNO2+1.
+      PV(5,21)=0.
+      PV(6,21)=0.
+      PV(8,21)=1.
+      PV(5,31)=0.
+      PV(6,31)=0.
+      PV(8,31)=1.
+C
+      PV(5,12)=ATOMAS(ATNO2+2.,ZNO2+1.)
+      PV(6,12)=ZNO2+1.
+      PV(5,22)=RMASS(16)
+      PV(6,22)=0.
+      PV(8,22)=16.
+      PV(5,32)=0.
+      PV(6,32)=0.
+      PV(8,32)=1.
+C
+      PV(5,13)=ATOMAS(ATNO2+2.,ZNO2   )
+      PV(6,13)=ZNO2
+      PV(5,23)=RMASS(14)
+      PV(6,23)=1.
+      PV(8,23)=14.
+      PV(5,33)=0.
+      PV(6,33)=0.
+      PV(8,33)=1.
+C
+      PV(5,14)=ATOMAS(ATNO2+1.,ZNO2   )
+      PV(6,14)=ZNO2
+      PV(5,24)=RMASS(30)
+      PV(6,24)=1.
+      PV(8,24)=30.
+      PV(5,34)=0.
+      PV(6,34)=0.
+      PV(8,34)=1.
+C
+      PV(5,15)=PV(5,2)
+      PV(6,15)=PV(6,2)
+      PV(5,25)=RMASS(31)
+      PV(6,25)=1.
+      PV(8,25)=31.
+      PV(5,35)=0.
+      PV(6,35)=0.
+      PV(8,35)=1.
+C
+      PV(5,16)=ATOMAS(ATNO2-1.,ZNO2-1.)
+      PV(6,16)=ZNO2-1.
+      PV(5,26)=RMASS(32)
+      PV(6,26)=2.
+      PV(8,26)=32.
+      PV(5,36)=0.
+      PV(6,36)=0.
+      PV(8,36)=1.
+C
+      PV(5,17)=ATOMAS(ATNO2+1.,ZNO2+1.)
+      PV(6,17)=ZNO2+1.
+      PV(5,27)=PV(5,22)
+      PV(6,27)=0.
+      PV(8,27)=16.
+      PV(5,37)=PV(5,22)
+      PV(6,37)=0.
+      PV(8,37)=16.
+C
+      PV(5,18)=PV(5,14)
+      PV(6,18)=PV(6,14)
+      PV(5,28)=PV(5,22)
+      PV(6,28)=0.
+      PV(8,28)=16.
+      PV(5,38)=PV(5,23)
+      PV(6,38)=1.
+      PV(8,38)=14.
+C
+      PV(5,19)=ATOMAS(ATNO2+1.,ZNO2-1.)
+      PV(6,19)=ZNO2-1.
+      PV(5,29)=PV(5,23)
+      PV(6,29)=1.
+      PV(8,29)=14.
+      PV(5,39)=PV(5,23)
+      PV(6,39)=1.
+      PV(8,39)=14.
+C
+      NOPT=30
+      GOTO 70
+   60 PV(5,11)=ATOMAS(ATNO2+4.,ZNO2+2.)
+      PV(6,11)=ZNO2+2.
+      PV(5,21)=0.
+      PV(6,21)=0.
+      PV(8,21)=1.
+      PV(5,31)=0.
+      PV(6,31)=0.
+      PV(8,31)=1.
+C
+      PV(5,12)=ATOMAS(ATNO2+3.,ZNO2+2.)
+      PV(6,12)=ZNO2+2.
+      PV(5,22)=RMASS(16)
+      PV(6,22)=0.
+      PV(8,22)=16.
+      PV(5,32)=0.
+      PV(6,32)=0.
+      PV(8,32)=1.
+C
+      PV(5,13)=ATOMAS(ATNO2+3.,ZNO2+1.)
+      PV(6,13)=ZNO2+1.
+      PV(5,23)=RMASS(14)
+      PV(6,23)=1.
+      PV(8,23)=14.
+      PV(5,33)=0.
+      PV(6,33)=0.
+      PV(8,33)=1.
+C
+      PV(5,14)=ATOMAS(ATNO2+2.,ZNO2+1.)
+      PV(6,14)=ZNO2+1.
+      PV(5,24)=RMASS(30)
+      PV(6,24)=1.
+      PV(8,24)=30.
+      PV(5,34)=0.
+      PV(6,34)=0.
+      PV(8,34)=1.
+C
+      PV(5,15)=ATOMAS(ATNO2+1.,ZNO2+1.)
+      PV(6,15)=ZNO2+1.
+      PV(5,25)=RMASS(31)
+      PV(6,25)=1.
+      PV(8,25)=31.
+      PV(5,35)=0.
+      PV(6,35)=0.
+      PV(8,35)=1.
+C
+      PV(5,16)=PV(5,2)
+      PV(6,16)=PV(6,2)
+      PV(5,26)=RMASS(32)
+      PV(6,26)=2.
+      PV(8,26)=32.
+      PV(5,36)=0.
+      PV(6,36)=0.
+      PV(8,36)=1.
+C
+      PV(5,17)=ATOMAS(ATNO2+2.,ZNO2+2.)
+      PV(6,17)=ZNO2+2.
+      PV(5,27)=PV(5,22)
+      PV(6,27)=0.
+      PV(8,27)=16.
+      PV(5,37)=PV(5,22)
+      PV(6,37)=0.
+      PV(8,37)=16.
+C
+      PV(5,18)=PV(5,14)
+      PV(6,18)=PV(6,14)
+      PV(5,28)=PV(5,22)
+      PV(6,28)=0.
+      PV(8,28)=16.
+      PV(5,38)=PV(5,23)
+      PV(6,38)=1.
+      PV(8,38)=14.
+C
+      PV(5,19)=ATOMAS(ATNO2+2.,ZNO2   )
+      PV(6,19)=ZNO2
+      PV(5,29)=PV(5,23)
+      PV(6,29)=1.
+      PV(8,29)=14.
+      PV(5,39)=PV(5,23)
+      PV(6,39)=1.
+      PV(8,39)=14.
+C
+      NOPT=40
+   70 QV     =EK+PV(5,2)+PV(5,1)
+      TC     =   PV(6,2)+PV(6,1)
+      QVAL(1)=QV - PV(5,11)
+      TCH (1)=TC - PV(6,11)
+      QVAL(2)=QV - PV(5,12) - PV(5,22)
+      TCH (2)=TC - PV(6,12) - PV(6,22)
+      QVAL(3)=QV - PV(5,13) - PV(5,23)
+      TCH (3)=TC - PV(6,13) - PV(6,23)
+      QVAL(4)=QV - PV(5,14) - PV(5,24)
+      TCH (4)=TC - PV(6,14) - PV(6,24)
+      QVAL(5)=QV - PV(5,15) - PV(5,25)
+      TCH (5)=TC - PV(6,15) - PV(6,25)
+      QVAL(6)=QV - PV(5,16) - PV(5,26)
+      TCH (6)=TC - PV(6,16) - PV(6,26)
+      QVAL(7)=QV - PV(5,17) - PV(5,27) - PV(5,37)
+      TCH (7)=TC - PV(6,17) - PV(6,27) - PV(6,37)
+      QVAL(8)=QV - PV(5,18) - PV(5,28) - PV(5,38)
+      TCH (8)=TC - PV(6,18) - PV(6,28) - PV(6,38)
+      QVAL(9)=QV - PV(5,19) - PV(5,29) - PV(5,39)
+      TCH (9)=TC - PV(6,19) - PV(6,29) - PV(6,39)
+   74 QV = 0
+      IF(IREC.EQ.2) QVAL(1)=0.
+      IF(IPART.NE.16) GOTO 75
+      CALL GRNDM(RNDM,2)
+      IF(RNDM(1).GT.((ATNO2-1.)/230.)**2) QVAL(1)=0.
+      EKA=7.9254/ATNO2
+      IF(RNDM(2).LT.EK/EKA) GOTO 75
+      QVAL(3)=0.
+      QVAL(4)=0.
+      QVAL(5)=0.
+      QVAL(6)=0.
+      QVAL(9)=0.
+   75 DO 71 I=1,9
+      IF(PV(5,10+I).LT.0.5) QVAL(I)=0.
+      IF(QVAL(I).LT.0.    ) QVAL(I)=0.
+      IF(ABS(TCH(I)-0.1).GT.0.5 ) QVAL(I)=0.
+      QV=QV+QVAL(I)
+   71 CONTINUE
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      QV1=0.
+      DO 72 I=1,9
+      IF(QVAL(I).EQ.0.) GOTO 72
+      QV1=QV1+QVAL(I)/QV
+      IF(RAN.LE.QV1) GOTO 73
+   72 CONTINUE
+C** REACTION KINEMATICALLY NOT POSSIBLE
+      NOPT=0
+      GO TO 9999
+   73 NOPT=NOPT+I
+      PV(5,3)=PV(5,10+I)
+      PV(6,3)=PV(6,10+I)
+      PV(8,3)=0.
+      PV(5,4)=PV(5,20+I)
+      PV(6,4)=PV(6,20+I)
+      PV(8,4)=PV(8,20+I)
+      PV(5,5)=PV(5,30+I)
+      PV(6,5)=PV(6,30+I)
+      PV(8,5)=PV(8,30+I)
+      NT=2
+      RAN=EK*10.
+      IF(RAN.GT.0.5) RAN=0.5
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.RAN) NT=3
+      IF(MOD(NOPT,10).GE.7) NT=3
+C** CALCULATE CMS ENERGY
+   80 PV(4,2)=PV(5,2)
+      CALL ADD(1,2,MXGKPV)
+      PV(1,MXGKPV)=-PV(1,MXGKPV)
+      PV(2,MXGKPV)=-PV(2,MXGKPV)
+      PV(3,MXGKPV)=-PV(3,MXGKPV)
+C** SET QUANTITIES FOR PHASE SPACE ROUTINE IN CMS
+      TECM=PV(5,MXGKPV)
+      NPG=NT
+      KGENEV=1
+      DO 81 I=1,NPG
+   81 AMASS(I)=PV(5,2+I)
+C --- INVOKE DOUBLE PRECISION VERSION OF THE PHASE SPACE PACKAGE ---
+      CALL PHPNUC
+      DO 83 I=1,NPG
+      DO 82 J=1,4
+   82 PV(J,2+I)=PCM(J,I)
+C** TRANSFORM INTO LAB.SYSTEM
+      CALL LOR(2+I,MXGKPV,2+I)
+      PV(7,2+I)=TOF
+   83 CONTINUE
+C** SET CHARGES AND PARTICLE INDEX FOR LOW MASS FRAGMENTS
+      IF (ABS(PV(5,3)-RMASS(14)) .LT. 0.0001) GO TO 84
+      IF (ABS(PV(5,3)-RMASS(16)) .LT. 0.0001) GO TO 85
+      IF (ABS(PV(5,3)-RMASS(30)) .LT. 0.0001) GO TO 86
+      IF (ABS(PV(5,3)-RMASS(31)) .LT. 0.0001) GO TO 87
+      IF (ABS(PV(5,3)-RMASS(32)) .LT. 0.0001) GO TO 88
+      GOTO 89
+   84 PV(6,3)=1.
+      PV(8,3)=14.
+      GOTO 89
+   85 PV(6,3)=0.
+      PV(8,3)=16.
+      GOTO 89
+   86 PV(6,3)=1.
+      PV(8,3)=30.
+      GOTO 89
+   87 PV(6,3)=1.
+      PV(8,3)=31.
+      GOTO 89
+   88 PV(6,3)=2.
+      PV(8,3)=32.
+   89 NTT=2+NT
+      DO 90 I=1,NTT
+      IPP=IFIX(PV(8,I)+0.01)
+      IF(IPP.EQ.0) GOTO 90
+      EK=PV(4,I)-PV(5,I)
+      IF(I.LT.3) GOTO 92
+      IF(IPP.LT.30) GOTO 92
+      CALL GRNDM(RNDM,1)
+      EK=EK*0.5*RNDM(1)
+   92 IF(EK.LT.1.E-6) EK=1.E-6
+      PV(5,I)=RMASS(IPP)
+      PV(4,I)=EK+PV(5,I)
+      P=SQRT(ABS(PV(4,I)**2-PV(5,I)**2))
+      PP=SQRT(PV(1,I)**2+PV(2,I)**2+PV(3,I)**2)
+      IF(PP.GT.1.E-6) GOTO 91
+      CALL GRNDM(RNDM,2)
+      PHINVE=TWPI*RNDM(1)
+      COST=-1.+2.*RNDM(2)
+      IF (COST .LE. -1.) COST=-1.
+      IF (COST .GE.  1.) COST= 1.
+      RTHNVE=ACOS(COST)
+      PV(1,I)=SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=COS(RTHNVE)
+      PP=1.
+   91 PV(1,I)=PV(1,I)*P/PP
+      PV(2,I)=PV(2,I)*P/PP
+      PV(3,I)=PV(3,I)*P/PP
+   90 CONTINUE
+      IF(.NOT.NPRT(4)) GOTO 100
+      WRITE(NEWBCD,1000) XEND,YEND,ZEND,IND,NOPT
+ 1000 FORMAT(' *NUCREC* NUCLEAR REACTION AT (X,Y,Z) ',3(G12.5,1X)
+     $,/,'         MATERIAL ',I5,' NOPT ',I5)
+      DO 95 I=1,NTT
+         WRITE(NEWBCD,1001) I,(PV(J,I),J=1,10)
+   95 CONTINUE
+ 1001 FORMAT(1H ,I3,1X,10(G10.3,1X))
+  100 INTCT=INTCT+1.
+C** SET INTERACTION MODE ACCORDING TO GHEISHA-CONVENTION
+C** N-CAPTURE
+      IF(PV(8,3).GT.0.) GOTO 110
+      CALL SETCUR(4)
+      NTK=NTK+1
+      IF(NT.EQ.3) CALL SETTRK(5)
+      GO TO 9999
+ 110  CONTINUE
+      CALL SETCUR(4)
+      NTK=NTK+1
+      CALL SETTRK(3)
+      IF(NT.EQ.3) CALL SETTRK(5)
+      CALL SETTRK(3)
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE PHASP
+C
+C *** NVE 29-MAR-1988 CERN GENEVA ***
+C
+C CALLED BY : NUCREC TWOCLU GENXPT
+C ORIGIN : H.FESEFELDT (02-DEC-1986)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/GENIN /TECM,AMASS(18),NPG,KGENEV
+      COMMON/GENOUT/PCM(5,18),WGT
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+C
+      DOUBLE PRECISION WTMAX,WTMAXQ,WTFC,TWGT,ONE,TEXPXL,TEXPXU
+      PARAMETER (ONE=1.D0)
+      LOGICAL LZERO
+      DIMENSION EMM(18)
+      DIMENSION RNO(50)
+      DIMENSION EM(18),PD(18),EMS(18),SM(18),FFQ(18),PCM1(90)
+      EQUIVALENCE (NT,NPG),(AMASS(1),EM(1)),(PCM1(1),PCM(1,1))
+      SAVE KNT
+C
+      DATA  FFQ/0.,3.141592, 19.73921, 62.01255, 129.8788, 204.0131,
+     $                       256.3704, 268.4705, 240.9780, 189.2637,
+     $                       132.1308,  83.0202,  47.4210,  24.8295,
+     $                        12.0006,   5.3858,   2.2560,   0.8859/
+      DATA  KNT , TWOPI /  1 , 6.2831853073 /
+C
+C --- INITIALISE LOCAL ARRAYS AND THE RESULT ARRAY PCM ---
+      DO 10 JZERO=1,18
+         PCM(1,JZERO)=0.
+         PCM(2,JZERO)=0.
+         PCM(3,JZERO)=0.
+         PCM(4,JZERO)=0.
+         PCM(5,JZERO)=0.
+         EMM(JZERO)  =0.
+         PD(JZERO)   =0.
+         EMS(JZERO)  =0.
+         SM(JZERO)   =0.
+  10  CONTINUE
+C
+      KNT = KNT + 1
+      IF (.NOT.NPRT(3).AND..NOT.NPRT(4)) GOTO 100
+      WRITE(NEWBCD,1200) NPG,TECM,(AMASS(JK),JK=1,NPG)
+  100 CONTINUE
+  150 IF (NT .LT. 2)  GO TO 1001
+      IF (NT .GT. 18)  GO TO 1002
+      NTM1=NT-1
+      NTM2=NT-2
+      NTNM4 = 3*NT - 4
+      EMM(1)=EM(1)
+      TM=0.0
+      DO 200 I=1,NT
+      EMS(I)=EM(I)**2
+      TM=TM+EM(I)
+ 200  SM(I)=TM
+      WGT=1.
+ 210  TECMTM=TECM-TM
+      IF (TECMTM .LE. 0.0)  GO TO 1000
+      EMM(NT)=TECM
+      IF (KGENEV.GT.1) GO TO 400
+      EMMAX=TECMTM+EM(1)
+      EMMIN=0.0
+C
+C          FOR WEIGHT CALCULATION, FORM SUM OF LOG'S OF TERMS
+C          INSTEAD OF PRODUCT OF TERMS. NOTE THAT THEREBY WTMAX
+C          AND WTMAXQ ARE CHANGED IN THEIR CONTENTS; THEY ARE
+C          CURRENTLY NOT USED OUTSIDE THE RANGE FROM HERE TO
+C          LABEL 531. WE ALSO NEED TO CHECK FOR ZERO FACTORS NOW.
+C          NEGATIVE VALUES CANNOT APPEAR AS GPDK ALWAYS RETURNS A
+C          NONNEGATIVE NUMBER. AS CODED, EVEN THE EXOTIC CASES
+C          NT<2 (FIRST LOOP NOT EXECUTED) AND NTM1<1 (SECOND LOOP
+C          NOT EXECUTED) SHOULD BE SAFE AND GIVE THE SAME RESULT
+C          FOR WTG IN THE END AS THE OLD CODE.
+C
+      WTMAX=0.0
+      LZERO=.TRUE.
+      DO 350 I=2,NT
+      EMMIN=EMMIN+EM(I-1)
+      EMMAX=EMMAX+EM(I)
+      WTFC=GPDK(EMMAX,EMMIN,EM(I))
+      IF(WTFC.LE.0.) THEN
+      LZERO=.FALSE.
+      GOTO 351
+      ENDIF
+      WTMAX=WTMAX+LOG(WTFC)
+ 350  CONTINUE
+ 351  WTMAXQ= EXPXU
+      IF(LZERO) WTMAXQ= -WTMAX
+      GO TO 455
+  400 WTMAXQ=LOG(ONE*TECMTM**NTM2*FFQ(NT) / TECM)
+  455 CONTINUE
+      CALL GRNDM(RNO,NTNM4)
+      IF(NTM2) 900,509,460
+  460 CONTINUE
+      CALL FLPSOR(RNO,NTM2)
+      DO 508 J=2,NTM1
+  508 EMM(J)=RNO(J-1)*TECMTM+SM(J)
+  509 TWGT=WTMAXQ
+      IR=NTM2
+      LZERO=.TRUE.
+      DO 530 I=1,NTM1
+      PD(I)=GPDK(EMM(I+1),EMM(I),EM(I+1))
+      IF(PD(I).LE.0.0) THEN
+      LZERO=.FALSE.
+      ELSE
+      TWGT=TWGT+LOG(ONE*PD(I))
+      ENDIF
+  530 CONTINUE
+  531 WGT=0.0
+      IF(LZERO) THEN
+      TEXPXU=EXPXU
+      TEXPXL=EXPXL
+      WGT=EXP(MAX(MIN(TWGT,TEXPXU),TEXPXL))
+      ENDIF
+      PCM(1,1)=0.0
+      PCM(2,1)=PD(1)
+      PCM(3,1)=0.0
+      DO 570 I=2,NT
+      PCM(1,I)=0.0
+      PCM(2,I) = -PD(I-1)
+      PCM(3,I)=0.0
+      IR=IR+1
+      BANG=TWOPI*RNO(IR)
+      CB=COS(BANG)
+      SB=SIN(BANG)
+      IR=IR+1
+      C=2.0*RNO(IR)-1.0
+      S=SQRT(ABS(1.0-C*C))
+      IF(I.EQ.NT) GO TO 1567
+      ESYS=SQRT(PD(I)**2+EMM(I)**2)
+      BETA=PD(I)/ESYS
+      GAMA=ESYS/EMM(I)
+      DO 568 J=1,I
+      NDX = 5*J - 5
+      AA= PCM1(NDX+1)**2 + PCM1(NDX+2)**2 + PCM1(NDX+3)**2
+      PCM1(NDX+5) = SQRT(AA)
+      PCM1(NDX+4) = SQRT(AA+EMS(J))
+      CALL ROTES2(C,S,CB,SB,PCM,J)
+      PSAVE = GAMA*(PCM(2,J)+BETA*PCM(4,J))
+  568 PCM(2,J)=PSAVE
+      GO TO 570
+ 1567 DO 1568 J=1,I
+      AA=PCM(1,J)**2 + PCM(2,J)**2 + PCM(3,J)**2
+      PCM(5,J)=SQRT(AA)
+      PCM(4,J)=SQRT(AA+EMS(J))
+      CALL ROTES2(C,S,CB,SB,PCM,J)
+ 1568 CONTINUE
+  570 CONTINUE
+  900 CONTINUE
+      RETURN
+ 1000 DO 212 I=1,NPG
+      PCM(1,I)=0.
+      PCM(2,I)=0.
+      PCM(3,I)=0.
+      PCM(4,I)=AMASS(I)
+  212 PCM(5,I)=AMASS(I)
+      WGT=0.
+      RETURN
+ 1001 IF(NPRT(3).OR.NPRT(4)) WRITE(NEWBCD,1101)
+      GO TO 1050
+ 1002 WRITE(NEWBCD,1102)
+ 1050 WRITE(NEWBCD,1150) KNT
+      WRITE(NEWBCD,1200) NPG,TECM,(AMASS(JK),JK=1,NPG)
+      RETURN
+ 1100 FORMAT(1H ,'*PHASP* AVAILABLE ENERGY NEGATIVE')
+ 1101 FORMAT(1H ,'*PHASP* LESS THAN 2 OUTGOING PARTICLES')
+ 1102 FORMAT(1H ,'*PHASP* MORE THAN 18 OUTGOING PARTICLES')
+ 1150 FORMAT(1H ,'*PHASP* ABOVE ERROR DETECTED IN PHASP AT CALL NUMBER'
+     $ ,I7)
+ 1200 FORMAT(1H ,'*PHASP* INPUT DATA TO PHASP.         NPG= ' ,I6/
+     $ 2X,9H   TECM=  ,D15.7,18H  PARTICLE MASSES=,5D15.7/(42X,5D15.7)
+     $ )
+      END
+*-- AUTHOR :
+      SUBROUTINE PHPNUC
+C
+C *** DOUBLE PRECISION VERSION OF THE PHASE SPACE ROUTINE "PHASP"
+C *** THIS ROUTINE MUST BE CALLED BY THE NUCLEAR INTERACTION ROUTINE
+C *** "NUCREC" (SEE ALSO COMMENTS THEREIN). THE REASON IS SIMPLY THAT
+C *** ENERGY-MOMENTUM CALCULATIONS ARE NOT POSSIBLE WITHIN ONLY
+C *** 6 DIGITS OF ACCURACY FOR TOTAL ENERGIES
+C *** IN THE ORDER OF HUNDREDS OF GEV (URANIUM NUCLEUS), COMPARED WITH
+C *** KINETIC ENERGIES IN THE ORDER OF MEV (NEUTRONS, PROTONS AND
+C *** PHOTONS IN THE REACTIONS A(X,Y(GAMMA,GAMMA))A'). IN THE ORIGINAL
+C *** GHEISHA8 CODE ALL THESE CALCULATIONS ARE DONE IN DOUBLE PRECISION
+C *** HMF 29-AUG-1989 RWTH AACHEN
+C
+C CALLED BY : NUCREC
+C ORIGIN    : H.FESEFELDT
+C
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      REAL RNDM(1)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/NUCIN /TECM,AMASS(18),NPG,KGENEV
+      COMMON/NUCOUT/PCM(5,18),WGT
+      DOUBLE PRECISION TECM,AMASS,PCM,WGT
+C
+C
+      SAVE  KNT, TWOPI, FFQ
+      DIMENSION EMM(18)
+      DIMENSION RNO(50)
+      DIMENSION EM(18),PD(18),EMS(18),SM(18),FFQ(18),PCM1(90)
+      EQUIVALENCE (NT,NPG),(AMASS(1),EM(1)),(PCM1(1),PCM(1,1))
+      DATA  FFQ/0.,3.141592, 19.73921, 62.01255, 129.8788, 204.0131,
+     2                       256.3704, 268.4705, 240.9780, 189.2637,
+     3                       132.1308,  83.0202,  47.4210,  24.8295,
+     4                        12.0006,   5.3858,   2.2560,   0.8859/
+      DATA  KNT , TWOPI /  1 , 6.2831853073 /
+C
+C --- INITIALISE LOCAL ARRAYS AND THE RESULT ARRAY PCM ---
+CJOK  CALL VZERO(PCM,90)
+      DO 80 JZERO=1,18
+        DO 8080 IJK=1,5
+          PCM(IJK,JZERO) = 0.D0
+ 8080   CONTINUE
+        EMM(JZERO)=0.
+        PD(JZERO) =0.
+        EMS(JZERO)=0.
+        SM(JZERO) =0.
+  80  CONTINUE
+C
+      KNT = KNT + 1
+      IF (.NOT.NPRT(3).AND..NOT.NPRT(4)) GOTO 100
+      WRITE(NEWBCD,1200) NPG,TECM,(AMASS(JK),JK=1,NPG)
+  100 CONTINUE
+  150 IF (NT .LT. 2)  GO TO 1001
+      IF (NT .GT. 18)  GO TO 1002
+      NTM1=NT-1
+      NTM2=NT-2
+      NTP1=NT+1
+      NTNM4 = 3*NT - 4
+      EMM(1)=EM(1)
+      TM=0.0
+      DO 200 I=1,NT
+      EMS(I)=EM(I)**2
+      TM=TM+EM(I)
+ 200  SM(I)=TM
+      WGT=1.
+ 210  TECMTM=TECM-TM
+      IF (TECMTM .LE. 0.0)  GO TO 1000
+      EMM(NT)=TECM
+      IF (KGENEV.GT.1) GO TO 400
+      EMMAX=TECMTM+EM(1)
+      EMMIN=0.0
+      WTMAX=1.0
+      DO 350 I=2,NT
+      EMMIN=EMMIN+EM(I-1)
+      EMMAX=EMMAX+EM(I)
+  350 WTMAX=WTMAX*DPDNUC(EMMAX,EMMIN,EM(I))
+      WTMAXQ=1.0/WTMAX
+      GO TO 455
+  400 WTMAXQ=TECMTM**NTM2*FFQ(NT) / TECM
+  455 CONTINUE
+      DO 457 I= 1, NTNM4
+      CALL GRNDM(RNDM,1)
+  457 RNO(I) = DBLE(RNDM(1))
+      IF(NTM2) 900,509,460
+  460 CONTINUE
+      CALL DLPNUC(RNO,NTM2)
+      DO 508 J=2,NTM1
+  508 EMM(J)=RNO(J-1)*(TECMTM)+SM(J)
+  509 WGT=WTMAXQ
+      IR=NTM2
+      DO 530 I=1,NTM1
+      PD(I)=DPDNUC(EMM(I+1),EMM(I),EM(I+1))
+  530 WGT=WGT*PD(I)
+      PCM(1,1)=0.0
+      PCM(2,1)=PD(1)
+      PCM(3,1)=0.0
+      DO 570 I=2,NT
+      PCM(1,I)=0.0
+      PCM(2,I) = -PD(I-1)
+      PCM(3,I)=0.0
+      IR=IR+1
+      BANG=TWOPI*RNO(IR)
+      CB=COS(BANG)
+      SB=SIN(BANG)
+      IR=IR+1
+      C=2.0*RNO(IR)-1.0
+      S=SQRT(1.0-C*C)
+      IF(I.EQ.NT) GO TO 1567
+      ESYS=SQRT(PD(I)**2+EMM(I)**2)
+      BETA=PD(I)/ESYS
+      GAMA=ESYS/EMM(I)
+      DO 568 J=1,I
+      NDX = 5*J - 5
+      AA= PCM1(NDX+1)**2 + PCM1(NDX+2)**2 + PCM1(NDX+3)**2
+      PCM1(NDX+5) = SQRT(AA)
+      PCM1(NDX+4) = SQRT(AA+EMS(J))
+      CALL DOTNUC(C,S,CB,SB,PCM,J)
+      PSAVE = GAMA*(PCM(2,J)+BETA*PCM(4,J))
+  568 PCM(2,J)=PSAVE
+      GO TO 570
+ 1567 DO 1568 J=1,I
+      AA=PCM(1,J)**2 + PCM(2,J)**2 + PCM(3,J)**2
+      PCM(5,J)=SQRT(AA)
+      PCM(4,J)=SQRT(AA+EMS(J))
+      CALL DOTNUC(C,S,CB,SB,PCM,J)
+ 1568 CONTINUE
+  570 CONTINUE
+  900 CONTINUE
+      RETURN
+ 1000 DO 212 I=1,NPG
+      PCM(1,I)=0.
+      PCM(2,I)=0.
+      PCM(3,I)=0.
+      PCM(4,I)=AMASS(I)
+  212 PCM(5,I)=AMASS(I)
+      WGT=0.
+      RETURN
+ 1001 IF(NPRT(3).OR.NPRT(4)) WRITE(NEWBCD,1101)
+      GO TO 1050
+ 1002 WRITE(NEWBCD,1102)
+ 1050 WRITE(NEWBCD,1150) KNT
+      WRITE(NEWBCD,1200) NPG,TECM,(AMASS(JK),JK=1,NPG)
+      STOP
+ 1100 FORMAT(' *PHPNUC* AVAILABLE ENERGY NEGATIVE')
+ 1101 FORMAT(' *PHPNUC* LESS THAN 2 OUTGOING PARTICLES')
+ 1102 FORMAT(' *PHPNUC* MORE THAN 18 OUTGOING PARTICLES')
+ 1150 FORMAT(' *PHPNUC* ABOVE ERROR DETECTED IN PHASP',
+     $ ' AT CALL NUMBER ',I7)
+ 1200 FORMAT(' *PHPNUC* INPUT DATA TO PHPNUC. NPG = ',I6/
+     $ ' TECM = ',E15.7,' PARTICLE MASSES = ',5E15.7/(42X,5E15.7))
+      END
+*-- AUTHOR :
+      FUNCTION PMLTPC(NP,NM,NZ,N,B,C)
+C
+C *** NVE 03-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (14-SEP-1987)
+C
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+C
+      RLNNPF=0.
+      IF(NP.LE.1) GOTO 2
+      DO 1 I=2,NP
+    1 RLNNPF=RLNNPF+LOG(I*1.)
+    2 RLNNMF=0.
+      IF(NM.LE.1) GOTO 4
+      DO 3 I=2,NM
+    3 RLNNMF=RLNNMF+LOG(I*1.)
+    4 RLNNZF=0.
+      IF(NZ.LE.1) GOTO 6
+      DO 5 I=2,NZ
+    5 RLNNZF=RLNNZF+LOG(I*1.)
+    6 PMLTPC=-(NP-NM+NZ+B)**2/(2*(C*N)**2)-RLNNPF-RLNNMF-RLNNZF
+      IF(PMLTPC.LT.EXPXL) PMLTPC=EXPXL
+      PMLTPC=EXP(PMLTPC)
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE POISSO(XAV,IRAN)
+C
+C *** GENERATION OF POISSON DISTRIBUTION ***
+C *** NVE 16-MAR-1988 CERN GENEVA ***
+C
+      DIMENSION RNDM(1)
+C ORIGIN : H.FESEFELDT (27-OCT-1983)
+C
+C --- USE NORMAL DISTRIBUTION FOR <X> > 9.9 ---
+      IF(XAV.GT.9.9) GOTO 2
+C
+      MM=IFIX(5.*XAV)
+      IRAN=0
+      IF(MM.LE.0) GOTO 3
+      R=EXP(-XAV)
+      CALL GRNDM(RNDM,1)
+      RAN1=RNDM(1)
+      IF(RAN1.LE.R) RETURN
+      RR=R
+      DO 1 I=1,MM
+      IRAN=IRAN+1
+      IF(I.LE.5) RRR=XAV**I/NFAC(I)
+C** STIRLING' S FORMULA FOR LARGE NUMBERS
+      IF(I.GT.5) RRR=EXP(I*LOG(XAV)-(I+0.5)*LOG(I*1.)+I-0.9189385)
+      RR=RR+R*RRR
+      IF(RAN1.LE.RR) RETURN
+    1 CONTINUE
+      RETURN
+C** NORMAL DISTRIBUTION WITH SIGMA**2 = <X>
+    2 CALL NORMAL(RAN1)
+      RAN1=XAV+RAN1*SQRT(XAV)
+      IRAN=IFIX(RAN1)
+      IF(IRAN.LT.0) IRAN=0
+      RETURN
+C** FOR VERY SMALL XAV TRY IRAN=1,2,3
+    3 P1=XAV*EXP(-XAV)
+      P2=XAV*P1/2.
+      P3=XAV*P2/3.
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IRAN=3
+      IF(RAN.LT.P3) RETURN
+      IRAN=2
+      IF(RAN.LT.P2) RETURN
+      IRAN=1
+      IF(RAN.LT.P1) RETURN
+      IRAN=0
+      RETURN
+      END
+*-- AUTHOR :
+      FUNCTION RANRES(X)
+C
+C *** RESTRICTED RANDOM NUMBERS TO BE USED AS ARGUMENT IN LOG ETC... ***
+C *** NVE 13-JUL-1988 CERN GENEVA ***
+C
+C NOTE : 0 < RANRES < 1
+      DIMENSION RNDM(1)
+C
+ 1    CONTINUE
+      CALL GRNDM(RNDM,1)
+      RANRES=RNDM(1)
+      IF ((RANRES .LE. 0.) .OR. (RANRES .GE. 1.)) GO TO 1
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE ROTES2(C,S,C2,S2,PR,I)
+C
+C *** NVE 16-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (27-OCT-1983)
+C
+      DIMENSION PR(*)
+      K1 = 5*I - 4
+      K2 = K1 + 1
+      SA = PR(K1)
+      SB = PR(K2)
+      A      = SA*C - SB*S
+      PR(K2) = SA*S + SB*C
+      K2 = K2 + 1
+      B = PR(K2)
+      PR(K1) = A*C2 - B*S2
+      PR(K2) = A*S2 + B*C2
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE RTMI(X,F,FCT,XLI,XRI,EPS,IEND,IER)
+C
+C *** NVE 16-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (27-OCT-1983)
+C COPIED FROM R01UTL.SSP.S  23.4.82
+C
+      EXTERNAL FCT
+C --- PREPARE ITERATION ---
+      IER=0
+      XL=XLI
+      XR=XRI
+      X=XL
+      TOL=X
+      F=FCT(TOL)
+      IF(F)1,16,1
+    1 FL=F
+      X=XR
+      TOL=X
+      F=FCT(TOL)
+      IF(F)2,16,2
+    2 FR=F
+      IF(SIGN(1.,FL)+SIGN(1.,FR))25,3,25
+C
+C     BASIC ASSUMPTION FL*FR LESS THAN 0 IS SATISFIED.
+C     GENERATE TOLERANCE FOR FUNCTION VALUES.
+    3 I=0
+      TOLF=100.*EPS
+C
+C
+C     START ITERATION LOOP
+    4 I=I+1
+C
+C     START BISECTION LOOP
+      DO 13 K=1,IEND
+      X=.5*(XL+XR)
+      TOL=X
+      F=FCT(TOL)
+      IF(F)5,16,5
+    5 IF(SIGN(1.,F)+SIGN(1.,FR))7,6,7
+C
+C     INTERCHANGE XL AND XR IN ORDER TO GET THE SAME SIGN IN F AND FR
+    6 TOL=XL
+      XL=XR
+      XR=TOL
+      TOL=FL
+      FL=FR
+      FR=TOL
+    7 TOL=F-FL
+      A=F*TOL
+      A=A+A
+      IF(A-FR*(FR-FL))8,9,9
+    8 IF(I-IEND)17,17,9
+    9 XR=X
+      FR=F
+C
+C     TEST ON SATISFACTORY ACCURACY IN BISECTION LOOP
+      TOL=EPS
+      A=ABS(XR)
+      IF(A-1.)11,11,10
+   10 TOL=TOL*A
+   11 IF(ABS(XR-XL)-TOL)12,12,13
+   12 IF(ABS(FR-FL)-TOLF)14,14,13
+   13 CONTINUE
+C     END OF BISECTION LOOP
+C
+C     NO CONVERGENCE AFTER IEND ITERATION STEPS FOLLOWED BY IEND
+C     SUCCESSIVE STEPS OF BISECTION OR STEADILY INCREASING FUNCTION
+C     VALUES AT RIGHT BOUNDS. ERROR RETURN.
+      IER=1
+   14 IF(ABS(FR)-ABS(FL))16,16,15
+   15 X=XL
+      F=FL
+   16 RETURN
+C
+C     COMPUTATION OF ITERATED X-VALUE BY INVERSE PARABOLIC INTERPOLATION
+   17 A=FR-F
+      DX=(X-XL)*FL*(1.+F*(A-TOL)/(A*(FR-FL)))/TOL
+      XM=X
+      FM=F
+      X=XL-DX
+      TOL=X
+      F=FCT(TOL)
+      IF(F)18,16,18
+C
+C     TEST ON SATISFACTORY ACCURACY IN ITERATION LOOP
+   18 TOL=EPS
+      A=ABS(X)
+      IF(A-1.)20,20,19
+   19 TOL=TOL*A
+   20 IF(ABS(DX)-TOL)21,21,22
+   21 IF(ABS(F)-TOLF)16,16,22
+C
+C     PREPARATION OF NEXT BISECTION LOOP
+   22 IF(SIGN(1.,F)+SIGN(1.,FL))24,23,24
+   23 XR=X
+      FR=F
+      GO TO 4
+   24 XL=X
+      FL=F
+      XR=XM
+      FR=FM
+      GO TO 4
+C     END OF ITERATION LOOP
+C
+C
+C     ERROR RETURN IN CASE OF WRONG INPUT DATA
+   25 IER=2
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE SELFAB(SPROB)
+C
+C *** SELF-ABSORBTION IN HEAVY MOLECULES ***
+C *** NVE 16-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (11-OCT-1987)
+C
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      SPROB=0.
+      EKW=PV(4,MXGKPV)-ABS(PV(5,MXGKPV))
+      IF(EKW.LT.5.) RETURN
+      ALEKW=LOG(EKW-4.)
+      SPROB=0.6*ALEKW
+      IF(SPROB.GT.1.) SPROB=1.
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE SETCUR(NTR)
+C
+C *** STORAGE OF CURRENT TRACK PARAMETERS ***
+C *** NVE 16-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (26-JAN-1984)
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DIMENSION RNDM(1)
+C
+      CALL LENGTX(NTR,P)
+      AMAS=PV(5,NTR)
+      AMASQ=AMAS*AMAS
+      NCH=PV(6,NTR)
+      TOF=PV(7,NTR)
+      IPART=IFIX(PV(8,NTR)+0.1)
+      IF(PV(10,NTR).NE.0.) USERW=PV(10,NTR)
+      PX=0.
+      PY=0.
+      PZ=0.
+      IF(P.LT.1.E-10) GOTO 4
+      PX=PV(1,NTR)/P
+      PY=PV(2,NTR)/P
+      PZ=PV(3,NTR)/P
+    4 EN=PV(4,NTR)
+      EK=EN-ABS(AMAS)
+      SINL=PZ
+      COSL=SQRT(ABS(1.-SINL*SINL))
+      IF(ABS(COSL).LT.1.E-10) GOTO 1
+      SINP=PY/COSL
+      COSP=PX/COSL
+      GOTO 2
+    1 CALL GRNDM(RNDM,1)
+      PHI=RNDM(1)*TWPI
+      SINP=SIN(PHI)
+      COSP=COS(PHI)
+    2 IF(NPRT(3).OR.NPRT(4).OR.NPRT(5))
+     *WRITE(NEWBCD,1001) XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,LCALO,ICEL,
+     *SINL,COSL,SINP,COSP
+      RETURN
+ 1001 FORMAT(1H ,'*SETCUR* ','TRACK PARAMETER CHANGED: ',
+     $ 3F13.2,1X,2F7.0,1X,F8.3,1X,/,'       ',
+     $ F3.0,1X,F6.0,1X,3F6.3,1X,F10.0,1X,F5.0/10X,4F8.3,1X,F8.5,1X,6I5,
+     $ 4F8.3)
+      END
+*-- AUTHOR :
+      SUBROUTINE SETTRK(NTR)
+C
+C *** FILL THE STACK VIA COMMON /EVENT/ ***
+C *** INSTEAD OF THE USERWORD, THE PARTICLE INDEX IS STORED ***
+C *** NVE 01-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (10-NOV-1983)
+C
+      INTEGER MXGKIN
+      PARAMETER (MXGKIN=100)
+      COMMON/GCKING/KCASE,NGKINE,GKIN(5,MXGKIN),
+     +                           TOFD(MXGKIN),IFLGK(MXGKIN)
+      INTEGER       KCASE,NGKINE ,IFLGK,MXPHOT,NGPHOT
+      REAL          GKIN,TOFD,XPHOT
+C
+      PARAMETER (MXPHOT=800)
+      COMMON/GCKIN2/NGPHOT,XPHOT(11,MXPHOT)
+C
+      COMMON/GCKIN3/GPOS(3,MXGKIN)
+      REAL          GPOS
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+C
+C --- CHECK PV ARRAY BOUNDARY ---
+      IF(NTR .LE. MXGKPV) GOTO 10
+      PRINT 1000,NTR
+ 1000 FORMAT(' *SETTRK* NTR = ',I3,' WOULD ADRESS OUTSIDE PV ARRAY'/
+     $ ' ===> TRACK WILL NOT BE PUT ON STACK AND WILL BE LOST')
+      GO TO 9999
+C
+C --- CHECK TOTAL NUMBER OF PRODUCED PARTICLES ---
+ 10   CONTINUE
+      NVEDUM=NTOT+1
+      IF(NVEDUM .LE. MXEVEN) GOTO 20
+      IF(NVEDUM .EQ. MXEVEN+1) PRINT 1001, NVEDUM,MXEVEN
+ 1001 FORMAT(' *SETTRK* STORAGE OF PARTICLE NO. ',I4, 'NOT ALLOWED'/
+     $ ' MAXIMUM NUMBER OF GENERATED PARTICLES IS ',I4/
+     $ ' ===> FROM NOW ON ALL GENERATED PARTICLES WILL BE DISCARDED')
+      GO TO 9999
+C
+C --- STORE GENERATED PARTICLE ON THE STACK ---
+ 20   CONTINUE
+      EVE(NEXT   )=XEND
+      EVE(NEXT+ 1)=YEND
+      EVE(NEXT+ 2)=ZEND
+      EVE(NEXT+ 3)=RCA
+      EVE(NEXT+ 4)=RCE
+      EVE(NEXT+ 5)=PV(5,NTR)
+      EVE(NEXT+ 6)=PV(6,NTR)
+      EVE(NEXT+ 7)=PV(7,NTR)
+      EVE(NEXT+ 8)=PV(1,NTR)
+      EVE(NEXT+ 9)=PV(2,NTR)
+      EVE(NEXT+10)=PV(3,NTR)
+      EVE(NEXT+11)=PV(8,NTR)
+      NEXT=NEXT+12
+      NTOT=NTOT+1
+      NEXT1=NEXT-12
+      NEXT2=NEXT-1
+      NTOT1=NTOT-1
+      IF(NPRT(3).OR.NPRT(4).OR.NPRT(5))
+     $ WRITE(NEWBCD,2000) NTOT1,(EVE(I),I=NEXT1,NEXT2)
+ 2000 FORMAT(' *SETTRK* TRACK ON STACK:',I5,/,
+     $ 12X,3F12.2,1X,2F7.0,1X,
+     $ F8.3,1X,F3.0,1X,F6.0,1X,3F8.3,1X,F10.0)
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE STEEP(XX)
+C
+C *** NVE 16-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (22-FEB-1985)
+C
+      XX=1.
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE STEEQ(XXH,IPV)
+C
+C *** CORRECTIONS FOR SINGLE PARTICLE SPECTRA (SHOWER PARTICLES) ***
+C *** NVE 16-MAR-1988 CERN GENEVA
+C
+C ORIGIN : H.FESEFELDT (06-SEP-1985)
+C
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+C
+      DIMENSION ALEM(7),VAL0(7)
+      DIMENSION RNDM(1)
+C**   DATA   EM/ 4.0 , 10.  , 15.  , 20.  ,  30. , 100. , 1000./
+      DATA ALEM/ 1.40, 2.30 , 2.70 , 3.00 , 3.40 , 4.60 , 7.00 /
+      DATA VAL0/ 0.00, 0.40 , 0.48 , 0.51 , 0.54 , 0.60 , 0.65 /
+C
+      XXH=1.
+C
+      IF ((IPART .NE. 7) .AND. (IPART .NE. 9)) GO TO 9999
+      IF (ABS(IPA(IPV)) .NE. 8) GO TO 9999
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .GT. LOG(ATNO2)) GO TO 9999
+      EKW=PV(4,MXGKPV)-ABS(PV(5,MXGKPV))
+      ALEKW=LOG(EKW)
+      IF (ALEKW .LE. ALEM(1)) GO TO 9999
+C
+C --- GET ENERGY BIN ---
+      DO 1 I=2,7
+      IF (ALEKW .LT. ALEM(I)) GO TO 2
+ 1    CONTINUE
+      XXH=VAL0(7)
+      GO TO 3
+C
+C *** USE LINEAR INTERPOLATION OR EXTRAPOLATION BY Y=RC*X+B ***
+ 2    CONTINUE
+      I1=I-1
+      I2=I
+      DXNVE=ALEM(I2)-ALEM(I1)
+      DYNVE=VAL0(I2)-VAL0(I1)
+      RCNVE=DYNVE/DXNVE
+      BNVE=VAL0(I1)-RCNVE*ALEM(I1)
+      XXH=RCNVE*ALEKW+BNVE
+C
+ 3    CONTINUE
+      XXH=1.-XXH
+C
+ 9999 CONTINUE
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE STPAIR
+C
+C *** STRANGE PARTICLE PAIR PRODUCTION ***
+C *** NVE 14-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT 16-DEC-1987
+C
+C THE SAME FORMULA FOR <K KB> VS AVAILABLE ENERGY
+C                  AND <K Y>  VS AVAILABLE ENERGY
+C FOR ALL REACTIONS.
+C CHOOSE CHARGE COMBINATIONS K+ K- , K+ K0B, K0 K0B OR K0 K-
+C                            K+ Y0, K0 Y+, K0 Y-
+C FOR ANTIBARYON INDUCED REACTIONS HALF OF THE CROSS SECTIONS
+C KB YB PAIRS ARE PRODUCED
+C CHARGE IS NOT CONSERVED , NO EXPERIMENTAL DATA AVAILABLE FOR
+C EXCLUSIVE REACTIONS, THEREFORE SOME AVERAGE BEHAVIOUR ASSUMED.
+C THE RATIO L/SIGMA IS TAKEN AS 3:1 (FROM EXPERIMENTAL LOW ENERGY)
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+C
+      REAL KKB,KY
+      DIMENSION KKB(9),KY(12),IPAKKB(2,9),IPAKY(2,12),IPAKYB(2,12)
+      DIMENSION AVKKB(12),AVKY(12),AVNNB(12),AVRS(12)
+      DIMENSION RNDM(1)
+      DATA KKB/0.2500,0.3750,0.5000,0.5625,0.6250,0.6875,0.7500,
+     *         0.8750,1.000/
+      DATA KY /0.200,0.300,0.400,0.550,0.625,0.700,0.800,0.850,
+     *         0.900,0.950,0.975,1.000/
+      DATA IPAKKB/10,13,10,11,10,12,11,11,11,12,12,11,12,12,
+     *            11,13,12,13/
+      DATA IPAKY /18,10,18,11,18,12,20,10,20,11,20,12,21,10,
+     *            21,11,21,12,22,10,22,11,22,12/
+      DATA IPAKYB/19,13,19,12,19,11,23,13,23,12,23,11,24,13,
+     *            24,12,24,11,25,13,25,12,25,11/
+      DATA AVRS/3.,4.,5.,6.,7.,8.,9.,10.,20.,30.,40.,50./
+      DATA AVKKB/0.0015,0.005,0.012,0.0285,0.0525,0.075,0.0975,
+     *           0.123,0.28,0.398,0.495,0.573/
+      DATA AVKY /0.005,0.03,0.064,0.095,0.115,0.13,0.145,0.155,
+     *           0.20,0.205,0.210,0.212/
+      DATA AVNNB/0.00001,0.0001,0.0006,0.0025,0.01,0.02,0.04,
+     $           0.05,0.12,0.15,0.18,0.20/
+C
+      IF(IPA(3).LE.0) GO TO 9999
+      IER(50)=IER(50)+1
+      IPA1=ABS(IPA(1))
+      IPA2=ABS(IPA(2))
+C --- PROTECTION AGAINST ANNIHILATION PROCESSES ---
+      IF ((IPA1 .EQ. 0) .OR. (IPA2 .EQ. 0)) GO TO 9999
+      EAB=RS-ABS(RMASS(IPA1))-ABS(RMASS(IPA2))
+      IF(EAB.LT.1.) GO TO 9999
+C**
+C** CHOOSE RANDOM REPLACEMENT OF PRODUCED KAONS (16.12.87)
+      DO 111 I=1,60
+      IF(IPA(I).EQ.0) GOTO 112
+  111 CONTINUE
+  112 I=I-3
+      CALL GRNDM(RNDM,1)
+      I3=3+IFIX(RNDM(1)*I)
+  114 CALL GRNDM(RNDM,1)
+      I4=3+IFIX(RNDM(1)*I)
+      IF(I.EQ.1) I4=4
+      IF(I3.EQ.I4) GOTO 114
+C
+C *** CHOOSE RANDOM REPLACEMENT OF PRODUCED KAONS (16.12.87) ***
+C --- GET RS BIN ---
+      DO 1 I=2,12
+      IF (RS .LE. AVRS(I)) GO TO 2
+ 1    CONTINUE
+      I1=11
+      I2=12
+      GO TO 3
+C
+ 2    CONTINUE
+      I1=I-1
+      I2=I
+C
+C *** USE LINEAR INTERPOLATION OR EXTRAPOLATION BY Y=RC*X+B ***
+ 3    CONTINUE
+      DXNVE=AVRS(I2)-AVRS(I1)
+      DYNVE=LOG(AVKKB(I2))-LOG(AVKKB(I1))
+      RCNVE=DYNVE/DXNVE
+      BNVE=LOG(AVKKB(I1))-RCNVE*AVRS(I1)
+      AVK=RCNVE*RS+BNVE
+      DYNVE=LOG(AVKY(I2))-LOG(AVKY(I1))
+      RCNVE=DYNVE/DXNVE
+      BNVE=LOG(AVKY(I1))-RCNVE*AVRS(I1)
+      AVY=RCNVE*RS+BNVE
+      DYNVE=LOG(AVNNB(I2))-LOG(AVNNB(I1))
+      RCNVE=DYNVE/DXNVE
+      BNVE =LOG(AVNNB(I1))-RCNVE*AVRS(I1)
+      AVN  =RCNVE*RS+BNVE
+C
+      AVK=EXP(AVK)
+      AVY=EXP(AVY)
+      AVN=EXP(AVN)
+      IF(AVK+AVY+AVN.LE.0.) GOTO 9999
+      IF(IPA1.LT.14) AVY=AVY/2.
+      IF(IPA2.LT.14) AVY=0.
+      AVY=AVY+AVK+AVN
+      AVK=    AVK+AVN
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IF(RAN.LT.AVN) GOTO 5
+      IF(RAN.LT.AVK) GOTO 10
+      IF(RAN.LT.AVY) GOTO 20
+      GO TO 9999
+    5 IF((EAB-2.).LT.0.) GO TO 9999
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GO TO 6
+      IPA(I3)=14
+      IPA(I4)=15
+      GOTO 30
+    6 IPA(I3)=16
+      IPA(I4)=17
+      GOTO 30
+   10 IF((EAB-1.).LT.0.) GO TO 9999
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      DO 11 I=1,9
+      IF(RAN.LT.KKB(I)) GOTO 12
+   11 CONTINUE
+      GO TO 9999
+   12 IPA(I3)=IPAKKB(1,I)
+      IPA(I4)=IPAKKB(2,I)
+      GOTO 30
+   20 IF((EAB-1.6).LT.0.) GO TO 9999
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      DO 21 I=1,12
+      IF(RAN.LT.KY(I)) GOTO 22
+   21 CONTINUE
+      GO TO 9999
+   22 IF(IPA(1).LT.14) GOTO 23
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) GOTO 23
+      IPA1=ABS(IPA(1))
+      IPA(1)=IPAKY(1,I)
+      IF(IPA1.EQ.15) GOTO 25
+      IF(IPA1.EQ.17) GOTO 25
+      IF(IPA1.EQ.19) GOTO 25
+      IF(IPA1.GT.22) GOTO 25
+      GOTO 24
+   25 IPA(1)=IPAKYB(1,I)
+      IPA(I3)=IPAKYB(2,I)
+      GOTO 30
+   23 IPA(2)=IPAKY(1,I)
+   24 IPA(I3)=IPAKY(2,I)
+C** CHECK THE AVAILABLE ENERGY
+   30 EAB=RS
+      IJ=0
+      DO 31 I=1,60
+      IF(IPA(I).EQ.0) GOTO 31
+      IPA1=ABS(IPA(I))
+      EAB=EAB-ABS(RMASS(IPA1))
+      IJ=IJ+1
+      IF(EAB.LT.0.) GOTO 35
+   31 CONTINUE
+      IF (NPRT(4)) WRITE(NEWBCD,1003) (IPA(J),J=1,IJ)
+      GO TO 9999
+   35 I=I-1
+      L=I-1
+      IF(L.LE.0) GO TO 9999
+      DO 36 J=I,60
+   36 IPA(J)=0
+      IF (NPRT(4)) WRITE(NEWBCD,1002) (IPA(J),J=1,L)
+C
+ 1002 FORMAT(' *STPAIR* KKB/KY PAIR PRODUCTION NOT ENOUGH ENERGY',
+     $/,'      REDUCE NUMBER OF PARTICLES ',2X,20I3)
+ 1003 FORMAT(' *STPAIR* KKB/KY PAIR PRODUCTION ENERGY SUFFICIENT',
+     $/ '      NUMBER OF PARTICLES ',2X,20I3)
+C
+ 9999 CONTINUE
+C
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE SVERL2(M,X)
+      DIMENSION U(2)
+      CALL GRNDM(U,2)
+      X=0.62666*LOG((1.+U(1))/(1.-U(1)))
+      IF(U(2).LT.0.5) X=-X
+      X=M+X*SQRT(M*1.)
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE SVGAM7(A,X)
+      DIMENSION U(2)
+      REAL LA
+      GA=A-1.
+      LA=SQRT(2.*A-1.)
+      EP=1.570796327+ATAN(GA/LA)
+      RO=1.570796327-EP
+    1 CALL GRNDM(U,2)
+      X=GA+LA*TAN(EP*U(1)+RO)
+CDH
+      IF(X.LE.0.) GOTO 1
+CDH
+      Y=LOG(1.+((X-GA)/LA)**2) +GA*LOG(X/GA)-X+GA
+      IF(LOG(U(2)).GT.Y) GOTO 1
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE TDELAY(X)
+C
+C *** TIME DELAY FOR NUCLEAR REACTIONS ***
+C *** NVE 16-MAR-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (01-FEB-1984)
+C
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+C
+      X=0.
+      IF(ATNO2.LT.1.5) RETURN
+      IF(ATNO2.GT.230.) RETURN
+      IF(EK.GT.0.2) RETURN
+      X=500.*EXP(-EK/0.04)
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE TWOB(IPPP,NFL,AVERN)
+C
+C *** GENERATION OF MOMENTA FOR ELAST. AND QUASI ELAST. 2 BODY REACT. ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT 15-SEP-1987
+C
+C THE SIMPLE FORMULA DS/D|T| = S0* EXP(-B*|T|) IS USED.
+C THE B VALUES ARE PARAMETRIZATIONS FROM EXPERIMENTAL DATA .
+C NOT AVAILABLE VALUES ARE TAKEN FROM THOSE OF SIMILAR REACTIONS
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      DIMENSION RNDM(3)
+C
+C     DATA CB/3./
+      DATA CB/0.01/
+C
+C --- STATEMENT FUNCTIONS ---
+      BPP(X)=4.225+1.795*LOG(X)
+C
+C**
+C**  FOR DIFFRACTION SCATTERING ON HEAVY NUCLEI USE BETTER ROUTINE
+C**  "COSCAT"
+C
+      TARMAS=RMASS(14)
+      IF (NFL .EQ. 2) TARMAS=RMASS(16)
+      ENP(8)=RMASS(IPPP)**2+TARMAS**2+2.0*TARMAS*ENP(6)
+      ENP(9)=SQRT(ENP(8))
+      EK=ENP(5)
+      EN=ENP(6)
+      P=ENP(7)
+      S=ENP(8)
+      RS=ENP(9)
+      CFA=0.025*((ATNO2-1.)/120.)*EXP(-(ATNO2-1.)/120.)
+      IF(ATNO2.LT.1.5) GOTO 500
+      IPA1=ABS(IPA(1))
+      IPA2=ABS(IPA(2))
+      RMC=RMASS(IPA1)
+      RMD=RMASS(IPA2)
+      RCHC=RCHARG(IPA1)
+      RCHD=RCHARG(IPA2)
+      IF(ABS(RMC-AMAS).GT.0.001) GOTO 500
+      RMNVE=RMASS(14)
+      IF (NFL .EQ. 2) RMNVE=RMASS(16)
+      IF(ABS(RMD-RMNVE).GT.0.001) GOTO 500
+      IF(ABS(RCHC-NCH).GT.0.5) GOTO 500
+      IF(NFL.EQ.1.AND.RCHD.LT.0.5) GOTO 500
+      IF(NFL.EQ.2.AND.ABS(RCHD).GT.0.5) GOTO 500
+      IF(ENP(1).GT.0.0001.OR.ENP(3).GT.0.0001) GOTO 500
+      CALL COSCAT
+      GO TO 9999
+C**
+C**  SET EFFECTIVE 4-MOMENTUM OF INITIAL PARTICLE
+C**
+  500 PV( 1,MXGKPV-1)=P*PX
+      PV( 2,MXGKPV-1)=P*PY
+      PV( 3,MXGKPV-1)=P*PZ
+      PV( 4,MXGKPV-1)=EN
+      PV( 5,MXGKPV-1)=AMAS
+      PV( 6,MXGKPV-1)=NCH
+      PV( 7,MXGKPV-1)=TOF
+      PV( 8,MXGKPV-1)=IPART
+      PV( 9,MXGKPV-1)=0.
+      PV(10,MXGKPV-1)=USERW
+      IER(47)=IER(47)+1
+      IF(NPRT(4))
+     $  WRITE(NEWBCD,4001) (PV(J,MXGKPV-1),J=1,10),IPA(1),IPA(2)
+      DO 2 J=1,6
+    2 PV(J,1)=PV(J,MXGKPV-1)
+      PV(7,1)=1.
+      IF(PV(5,1).LT.0.) PV(7,1)=-1.
+      PV(5,1)=ABS(PV(5,1))
+      NT=1
+C**
+C** TWO-BODY SCATTERING POSSIBLE?? IF NOT, CONTINUE WITH ORIGINAL
+C** PARTICLE, BUT SPEND THE NUCLEAR EVAPORATION ENERGY
+C**
+      IF(P.LT.0.1) GOTO 200
+      IF(RS.LT.0.01) GOTO 200
+C**
+C** CALCULATE SLOPE B FOR ELASTIC SCATTERING ON PROTON/NEUTRON
+C**
+      B=BPP(P)
+      IF(B.LT.CB) B=CB
+      IF(ABS(IPA(2)).GT.13) GOTO 9
+      IPA(2)=14
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.0.5) IPA(2)=16
+C**
+C** SET MASSES AND MOMENTA FOR FINAL STATE PARTICLES
+C**
+    9 RMC=RMASS(ABS(IPA(1)))
+      RMD=RMASS(ABS(IPA(2)))
+      PV(6,1)=RCHARG(ABS(IPA(1)))
+      PV(6,2)=RCHARG(ABS(IPA(2)))
+      PF=(S+RMD*RMD-RMC*RMC)**2 - 4*S*RMD*RMD
+      IF(NPRT(4)) WRITE(NEWBCD,4002) RMC,RMD,PV(6,1),PV(6,2),RS,S,PF
+      IF(PF.LT.0.001) GO TO 9999
+      PF=SQRT(PF)/(2.*RS)
+C**
+C** SET BEAM AND TARGET IN CMS
+C**
+      PV(1,3)=0.
+      PV(2,3)=0.
+      PV(3,3)=P
+      PV(5,3)=ABS(AMAS)
+      PV(4,3)=SQRT(P*P+AMAS*AMAS)
+      PV(1,4)=0.
+      PV(2,4)=0.
+      PV(3,4)=0.
+      RMNVE=RMASS(14)
+      IF (NFL .EQ. 2) RMNVE=RMASS(16)
+      PV(4,4)=RMNVE
+      PV(5,4)=RMNVE
+C**
+C** TRANSFORM INTO CMS.
+C**
+      CALL ADD(3,4,10)
+      CALL LOR(3,10,3)
+      CALL LOR(4,10,4)
+C**
+C** SET FINAL STATE MASSES AND ENERGIES IN CMS
+C**
+      PV(5,1)=ABS(RMC)
+      PV(5,2)=ABS(RMD)
+      PV(7,1)=1.
+      PV(7,2)=1.
+      IF(RMC.LT.0.) PV(7,1)=-1.
+      IF(RMD.LT.0.) PV(7,2)=-1.
+      PV(4,1)=SQRT(PF*PF+PV(5,1)*PV(5,1))
+      PV(4,2)=SQRT(PF*PF+PV(5,2)*PV(5,2))
+C**
+C** SET |T| AND |TMIN|
+C**
+      CALL GRNDM(RNDM,2)
+      CALL LENGTX(3,PIN)
+      BTRANG=B*4.*PIN*PF
+C**
+C** SIMPLY A PROTECTION AGAINST EXPONENT OVERFLOW 1.E20 IS BIG ENOUGH
+C**
+      EXINDT=-1.
+      IF(BTRANG.LT.46) EXINDT=EXINDT+EXP(-BTRANG)
+      TDN=LOG(1.+RNDM(1)*EXINDT)/BTRANG
+C**
+C** CACULATE (SIN(TETA/2.)**2 AND COS(TETA), SET AZIMUTH ANGLE PHI
+C**
+      CTET=1.+2.*TDN
+      IF(ABS(CTET).GT.1.) CTET=SIGN(1.,CTET)
+      STET=SQRT((1.-CTET)*(1.+CTET))
+      PHI=RNDM(2)*TWPI
+C**
+C** CALCULATE FINAL STATE MOMENTA IN CMS
+C**
+      PV(1,1)=PF*STET*SIN(PHI)
+      PV(2,1)=PF*STET*COS(PHI)
+      PV(3,1)=PF*CTET
+      PV(1,2)=-PV(1,1)
+      PV(2,2)=-PV(2,1)
+      PV(3,2)=-PV(3,1)
+C**
+C** TRANSFORM INTO LAB
+C**
+      DO 11 I=1,2
+      CALL LOR(I,4,I)
+      CALL DEFS1(I,MXGKPV-1,I)
+      IF(ATNO2.LT.1.5) GOTO 11
+      CALL LENGTX(I,PP)
+      IF(PP.LT.0.001) GOTO 11
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      CALL NORMAL(RAN)
+      EKIN=EKIN-CFA*(1.+0.5*RAN)
+      IF(EKIN.LT.0.0001) EKIN=0.0001
+      PP1=SQRT(EKIN*(EKIN+2.*ABS(PV(5,I))))
+      PV(4,I)=EKIN+ABS(PV(5,I))
+      PV(1,I)=PV(1,I)*PP1/PP
+      PV(2,I)=PV(2,I)*PP1/PP
+      PV(3,I)=PV(3,I)*PP1/PP
+   11 CONTINUE
+      NT=2
+C**
+C** ADD BLACK TRACK PARTICLES .
+C** HERE THE PROCEDURE IS SOMEWHAT DIFFERENT AS IN 'TWOCLU' AND 'GENXPT'
+C** THE REASON IS, THAT WE HAVE TO SIMULATE ALSO THE NUCLEAR REACTIONS
+C** AT LOW ENERGIES LIKE A(H,P)B, A(H,P P)B, A(H,N)B E.T.C.
+C**
+  200 IF(ENP(1).LE.0.0001.AND.ENP(3).LE.0.0001) GOTO 40
+      SPALL=0.
+      TEX=ENP(1)
+      IF(TEX.LT.0.0001) GOTO 445
+      BLACK=TEX/0.02
+      CALL POISSO(BLACK,NBL)
+      IF(NBL.GT.ATNO2) NBL=ATNO2
+      IF(ENP(1).GT.0.0001.AND.NBL.LE.0) NBL=1
+      IF (NPRT(4)) WRITE(NEWBCD,3003) NBL,TEX
+      IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
+      IF(NBL.LE.0) GOTO 445
+      EKIN=TEX/NBL
+      EKIN2=0.
+      CALL STEEP(XX)
+      DO 441 I=1,NBL
+      IF(NT.EQ.MXGKPV-2) GOTO 441
+      IF(EKIN2.GT.TEX) GOTO 443
+      CALL GRNDM(RNDM,1)
+      RAN1=RNDM(1)
+      CALL NORMAL(RAN2)
+      EKIN1=-EKIN*LOG(RAN1)-CFA*(1.+0.5*RAN2)
+      IF(EKIN1.LT.0.0) EKIN1=-0.010*LOG(RAN1)
+      EKIN1=EKIN1*XX
+      EKIN2=EKIN2+EKIN1
+      IF(EKIN2.GT.TEX) EKIN1=TEX-(EKIN2-EKIN1)
+      IF(EKIN1.LT.0.) EKIN1=0.0001
+      IPA1=16
+      PNRAT=1.-ZNO2/ATNO2
+      CALL GRNDM(RNDM,3)
+      IF(RNDM(1).GT.PNRAT) IPA1=14
+      NT=NT+1
+      SPALL=SPALL+1.
+      COST=-1.+RNDM(2)*2.
+      SINT=SQRT(ABS(1.-COST*COST))
+      PHI=TWPI*RNDM(3)
+      IPA(NT)=-IPA1
+      PV(5,NT)=ABS(RMASS(IPA1))
+      PV(6,NT)=RCHARG(IPA1)
+      PV(7,NT)=2.
+      PV(4,NT)=EKIN1+PV(5,NT)
+      PP=SQRT(ABS(PV(4,NT)**2-PV(5,NT)**2))
+      PV(1,NT)=PP*SINT*SIN(PHI)
+      PV(2,NT)=PP*SINT*COS(PHI)
+      PV(3,NT)=PP*COST
+  441 CONTINUE
+  443 IF(ATNO2.LT.10.) GOTO 445
+      IF(EK.GT.2.0) GOTO 445
+      II=NT+1
+      KK=0
+      EKA=EK
+      IF(EKA.GT.1.) EKA=EKA*EKA
+      IF(EKA.LT.0.1) EKA=0.1
+      IKA=3.6*EXP((ZNO2**2/ATNO2-35.56)/6.45)/EKA
+      IF(IKA.LE.0) GO TO 445
+      DO 444 I=1,NT
+      II=II-1
+      IF(IPA(II).NE.-14) GOTO 444
+      IPA(II)=-16
+      IPA1  = 16
+      PV(5,II)=ABS(RMASS(IPA1))
+      PV(6,II)=RCHARG(IPA1)
+      KK=KK+1
+      IF(KK.GT.IKA) GOTO 445
+  444 CONTINUE
+  445 TEX=ENP(3)
+      IF(TEX.LT.0.0001) GOTO 40
+      NBL=IFIX(2.*LOG(ATNO2))
+      IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
+      IF(NBL.LE.0) GOTO 40
+      EKIN=TEX/NBL
+      EKIN2=0.
+      CALL STEEP(XX)
+      IF (NPRT(4)) WRITE(NEWBCD,3004) NBL,TEX
+      DO 442 I=1,NBL
+      IF(NT.EQ.MXGKPV-2) GOTO 442
+      IF(EKIN2.GT.TEX) GOTO 40
+      CALL GRNDM(RNDM,1)
+      RAN1=RNDM(1)
+      CALL NORMAL(RAN2)
+      EKIN1=-EKIN*LOG(RAN1)-CFA*(1.+0.5*RAN2)
+      IF(EKIN1.LT.0.0) EKIN1=-0.010*LOG(RAN1)
+      EKIN1=EKIN1*XX
+      EKIN2=EKIN2+EKIN1
+      IF(EKIN2.GT.TEX) EKIN1=TEX-(EKIN2-EKIN1)
+      IF(EKIN1.LT.0.) EKIN1=0.0001
+      CALL GRNDM(RNDM,3)
+      COST=-1.+RNDM(1)*2.
+      SINT=SQRT(ABS(1.-COST*COST))
+      PHI=TWPI*RNDM(2)
+      RAN=RNDM(3)
+      IPA(NT+1)=-30
+      IF(RAN.GT.0.60) IPA(NT+1)=-31
+      IF(RAN.GT.0.90) IPA(NT+1)=-32
+      INVE=ABS(IPA(NT+1))
+      PV(5,NT+1)=RMASS(INVE)
+      SPALL=SPALL+PV(5,NT+1)*1.066
+      IF(SPALL.GT.ATNO2) GOTO 40
+      NT=NT+1
+      PV(6,NT)=RCHARG(INVE)
+      PV(7,NT)=2.
+      PV(4,NT)=PV(5,NT)+EKIN1
+      PP=SQRT(ABS(PV(4,NT)**2-PV(5,NT)**2))
+      PV(1,NT)=PP*SINT*SIN(PHI)
+      PV(2,NT)=PP*SINT*COS(PHI)
+      PV(3,NT)=PP*COST
+  442 CONTINUE
+C**
+C** STORE ON EVENT COMMON
+C**
+   40 EKIN=PV(4,MXGKPV)-ABS(PV(5,MXGKPV))
+      EKIN1=PV(4,MXGKPV-1)-ABS(PV(5,MXGKPV-1))
+      EKIN2=0.
+      CALL TDELAY(TOF1)
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      TOF=TOF-TOF1*LOG(RAN)
+      DO 1 I=1,NT
+      EKIN2=EKIN2+PV(4,I)-ABS(PV(5,I))
+      IF(PV(7,I).LT.0.) PV(5,I)=-PV(5,I)
+      PV(7,I)=TOF
+      PV(8,I)=ABS(IPA(I))
+      PV(9,I)=0.
+    1 PV(10,I)=0.
+      IF (NPRT(4)) WRITE(NEWBCD,1003) NT,EKIN,EKIN1,EKIN2
+      INTCT=INTCT+1.
+      CALL SETCUR(NT)
+      NTK=NTK+1
+      IF(NT.EQ.1) GO TO 9999
+      DO 50 II=2,NT
+      I=II-1
+      IF(NTOT.LT.NSIZE/12) GOTO 43
+      RETURN
+   43 CALL SETTRK(I)
+   50 CONTINUE
+C
+ 1002 FORMAT(' *TWOB* ',5F10.4,10X,5F10.4/1H ,7X,5F10.4,10X,5F10.4/
+     $ ' LAB SYSTEM FINAL STATE FOUR VECTORS')
+ 1003 FORMAT(' *TWOB* COMPARISON',2X,I5,2X,3F10.4)
+ 4001 FORMAT(' *TWOB* ',10F10.4,2X,2I3)
+ 4002 FORMAT(' *TWOB* ',7F10.4)
+ 3003 FORMAT(' *TWOB* ',I3,' BLACK TRACK PARTICLES PRODUCED',
+     $ ' WITH TOTAL KINETIC ENERGY OF ',F8.3,' GEV')
+ 3004 FORMAT(' *TWOB* ',I5,' HEAVY FRAGMENTS PRODUCED',
+     $ ' WITH TOTAL ENERGY OF',F8.4,' GEV')
+C
+ 9999 CONTINUE
+C
+      RETURN
+      END
+*-- AUTHOR :
+      SUBROUTINE TWOCLU(IPPP,NFL,AVERN)
+C
+C *** GENERATION OF X- AND PT- VALUES FOR ALL PRODUCED PARTICLES ***
+C *** NVE 01-AUG-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (11-OCT-1987)
+C
+C A SIMPLE TWO CLUSTER MODEL IS USED
+C THIS SHOULD BE SUFFICIENT FOR LOW ENERGY INTERACTIONS
+C
+      PARAMETER (MXGKGH=100)
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+C
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+C
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG,
+     *              ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     *              RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     *              ATNO2,ZNO2
+C
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+C
+      COMMON/MAT   / LMAT,
+     *               DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21),
+     *               CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     *               MATID(21),MATID1(21,24),PARMAT(21,10),
+     *               IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     *               ATNO1(21,10),ZNO1(21,10)
+C
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+C
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+C
+      COMMON/ERRCOM/ IER(100)
+C
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+C
+C
+      COMMON/GENIN /TECM,AMASS(18),NPG,KGENEV
+      COMMON/GENOUT/PCM(5,18),WGT
+C
+C
+      REAL NUCSUP
+      DIMENSION SIDE(MXGKCU),C1PAR(5),G1PAR(5),NUCSUP(5)
+      DIMENSION RNDM(3)
+      DATA C1PAR/0.6,0.6,0.35,0.15,0.10/
+      DATA G1PAR/2.6,2.6,1.8,1.30,1.20/
+      DATA NUCSUP/1.0,0.8,0.6,0.5,0.4/
+C     DATA CB/3.0/
+      DATA CB/0.01/
+      BPP(X)=4.000+1.600*LOG(X)
+C
+      MX =MXGKPV-20
+      MX1=MX+1
+      MX2=MX+2
+      MX3=MX+3
+      MX4=MX+4
+      MX5=MX+5
+      MX6=MX+6
+      MX7=MX+7
+      MX8=MX+8
+      EK=ENP(5)
+      EN=ENP(6)
+      P=ENP(7)
+      S=ENP(8)
+      RS=ENP(9)
+      CFA=0.025*((ATNO2-1.)/120.)*EXP(-(ATNO2-1.)/120.)
+      IF(P.LT.0.001) GOTO 60
+      NT=0
+C**
+C** CHECK MASS-INDICES FOR ALL PARTICLES
+C**
+      DO 1 I=1,100
+      IF(IPA(I).EQ.0) GOTO 1
+      NT=NT+1
+      IPA(NT)=IPA(I)
+    1 CONTINUE
+      CALL VZERO(IPA(NT+1),MXGKCU-NT)
+C**
+C** SET THE EFFECTICE 4-MOMENTUM-VECTOR FOR INTERACTION
+C**
+      PV( 1,MXGKPV-1)=P*PX
+      PV( 2,MXGKPV-1)=P*PY
+      PV( 3,MXGKPV-1)=P*PZ
+      PV( 4,MXGKPV-1)=EN
+      PV( 5,MXGKPV-1)=AMAS
+      PV( 6,MXGKPV-1)=NCH
+      PV( 7,MXGKPV-1)=TOF
+      PV( 8,MXGKPV-1)=IPART
+      PV( 9,MXGKPV-1)=0.
+      PV(10,MXGKPV-1)=USERW
+      IER(48)=IER(48)+1
+C**
+C** DISTRIBUTE PARTICLES IN FORWARD AND BACKWARD HEMISPHERE OF CMS
+C** OF THE HADRON NUCLEON INTERACTION
+C**
+      SIDE(1)= 1.
+      SIDE(2)=-1.
+      TARG=0.
+      IFOR=1
+      IBACK=1
+      DO 3 I=1,NT
+      IF (I .LE. 2) GO TO 78
+      SIDE(I)=1.
+      CALL GRNDM(RNDM,1)
+      IF (RNDM(1) .LT. 0.5) SIDE(I)=-1.
+      IF (SIDE(I) .LT. 0.) GO TO 76
+C
+C --- PARTICLE IN FORWARD HEMISPHERE ---
+ 77   CONTINUE
+      IFOR=IFOR+1
+      IF (IFOR .LE. 18) GO TO 78
+C
+C --- CHANGE IT TO BACKWARD ---
+      SIDE(I)=-1.
+      IFOR=IFOR-1
+      IBACK=IBACK+1
+      GO TO 78
+C
+C --- PARTICLE IN BACKWARD HEMISPHERE ---
+ 76   CONTINUE
+      IBACK=IBACK+1
+      IF (IBACK .LE. 18) GO TO 78
+C
+C --- CHANGE IT TO FORWARD ---
+      SIDE(I)=1.
+      IBACK=IBACK-1
+      IFOR=IFOR+1
+C**
+C** SUPPRESSION OF CHARGED PIONS FOR VARIOUS REASONS
+C**
+   78 IF(IPART.EQ.15.OR.IPART.GE.17) GOTO 3
+      IF(ABS(IPA(I)).GE.10) GOTO 3
+      IF(ABS(IPA(I)).EQ. 8) GOTO 3
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.(10.-P)/6.) GOTO 3
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.ATNO2/300.) GOTO 3
+      IPA(I)=14
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.ZNO2/ATNO2) IPA(I)=16
+      TARG=TARG+1.
+    3 CONTINUE
+      TB=2.*IBACK
+      CALL GRNDM(RNDM,1)
+      IF(RS.LT.(2.0+RNDM(1))) TB=(2.*IBACK+NT)/2.
+C**
+C** NUCLEONS + SOME PIONS FROM INTRANUCLEAR CASCADE
+C**
+      AFC=0.312+0.200*LOG(LOG(S))
+      XTARG=AFC*(ATNO2**0.33-1.0)*TB
+      IF(XTARG.LE.0.) XTARG=0.01
+      CALL POISSO(XTARG,NTARG)
+      NT2=NT+NTARG
+      IF(NT2.LE.MXGKPV-30) GOTO 2
+      NT2=MXGKPV-30
+      NTARG=NT2-NT
+    2 CONTINUE
+      IF(NPRT(4))
+     *WRITE(NEWBCD,3001) NTARG,NT
+      NT1=NT+1
+      IF(NTARG.EQ.0) GOTO 51
+      IPX=IFIX(P/3.)+1
+      IF(IPX.GT.5) IPX=5
+      DO 4 I=NT1,NT2
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      IF(RAN.LT.NUCSUP(IPX)) GOTO 52
+      CALL GRNDM(RNDM,1)
+      IPA(I)=-(7+IFIX(RNDM(1)*3.0))
+      GOTO 4
+   52 IPA(I)=-16
+      PNRAT=1.-ZNO2/ATNO2
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).GT.PNRAT) IPA(I)=-14
+      TARG=TARG+1.
+    4 SIDE(I)=-2.
+      NT=NT2
+C**
+C** CHOOSE MASSES AND CHARGES FOR ALL PARTICLES
+C**
+   51 DO 5 I=1,NT
+      IPA1=ABS(IPA(I))
+      PV(5,I)=RMASS(IPA1)
+      PV(6,I)=RCHARG(IPA1)
+      PV(7,I)=1.
+      IF(PV(5,I).LT.0.) PV(7,I)=-1.
+      PV(5,I)=ABS(PV(5,I))
+    5 CONTINUE
+C**
+C** MARK LEADING STRANGE PARTICLES
+C**
+      LEAD=0
+      IF(IPART.LT.10.OR.IPART.EQ.14.OR.IPART.EQ.16) GOTO 6
+      IPA1=ABS(IPA(1))
+      IF(IPA1.LT.10.OR.IPA1.EQ.14.OR.IPA1.EQ.16) GOTO 531
+      LEAD=IPA1
+      GOTO 6
+  531 IPA1=ABS(IPA(2))
+      IF(IPA1.LT.10.OR.IPA1.EQ.14.OR.IPA1.EQ.16) GOTO 6
+      LEAD=IPA1
+C**
+C** CHECK AVAILABLE KINETIC ENERGY , CHANGE HEMISPHERE FOR PARTICLES
+C** UNTIL IT FITS
+C**
+    6 IF(NT.LE.1) GOTO 60
+      TAVAI=0.
+      DO 7 I=1,NT
+      IF(SIDE(I).LT.-1.5) GOTO 7
+      TAVAI=TAVAI+ABS(PV(5,I))
+    7 CONTINUE
+CJOK MODIFIED ACCORDING TO D.HECK
+      IF(TAVAI.LT.RS-0.00001) GOTO 12
+      IF(NPRT(4))
+     $ WRITE(NEWBCD,3002) (IPA(I),I=1,20),(SIDE(I),I=1,20),TAVAI,RS
+ 3002 FORMAT(' *TWOCLU* CHECK AVAILABLE ENERGIES'/
+     $       1H ,20I5/1H ,20F5.0/1H ,'TAVAI,RS ',2F10.3)
+      DO 10 I=1,NT
+      II=NT-I+1
+      IF(SIDE(II).LT.-1.5) GOTO 10
+      IF(II.EQ.NT) GOTO 11
+      NT1=II+1
+      NT2=NT
+      DO 8 J=NT1,NT2
+      IPA(J-1)=IPA(J)
+      SIDE(J-1)=SIDE(J)
+      DO 8 K=1,10
+    8 PV(K,J-1)=PV(K,J)
+      GOTO 11
+   10 CONTINUE
+   11 SIDE(NT)=0.
+      IPA(NT)=0
+      NT=NT-1
+      GOTO 6
+   12 IF(NT.LE.1) GOTO 60
+      B=BPP(P)
+      IF(B.LT.CB) B=CB
+C**
+C** CHOOSE MASSES FOR THE 3 CLUSTER: 1. FORWARD CLUSTER
+C**   2. BACKWARD MESON CLUSTER  3. BACKWARD NUCLEON CLUSTER
+C**
+      RMC0=0.
+      RMD0=0.
+      RME0=0.
+      NTC=0
+      NTD=0
+      NTE=0
+      DO 31 I=1,NT
+      IF(SIDE(I).GT.0.) RMC0=RMC0+ABS(PV(5,I))
+      IF(SIDE(I).GT.0.) NTC =NTC +1
+      IF(SIDE(I).LT.0..AND.SIDE(I).GT.-1.5) RMD0=RMD0+ABS(PV(5,I))
+      IF(                  SIDE(I).LT.-1.5) RME0=RME0+ABS(PV(5,I))
+      IF(SIDE(I).LT.0..AND.SIDE(I).GT.-1.5) NTD =NTD +1
+      IF(                  SIDE(I).LT.-1.5) NTE =NTE +1
+   31 CONTINUE
+   32 CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      RMC=RMC0
+      IF(NTC.LE.1) GOTO 33
+      NTC1=NTC
+      IF(NTC1.GT.5) NTC1=5
+      RMC=-LOG(1.-RAN)
+      GPAR=G1PAR(NTC1)
+      CPAR=C1PAR(NTC1)
+      DUMNVE=GPAR
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      RMC=RMC0+RMC**CPAR/DUMNVE
+   33 RMD=RMD0
+      IF(NTD.LE.1) GOTO 34
+      NTD1=NTD
+      IF(NTD1.GT.5) NTD1=5
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      RMD=-LOG(1.-RAN)
+      GPAR=G1PAR(NTD1)
+      CPAR=C1PAR(NTD1)
+      DUMNVE=GPAR
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      RMD=RMD0+RMD**CPAR/DUMNVE
+   34 IF(RMC+RMD.LE.RS) GOTO 35
+      IF (RMC.LE.RMC0.AND.RMD.LE.RMD0) THEN
+         HNRMDC = 0.999*RS/(RMC+RMD)
+         RMD = RMD*HNRMDC
+         RMC = RMC*HNRMDC
+      ELSE
+         RMC=0.1*RMC0+0.9*RMC
+         RMD=0.1*RMD0+0.9*RMD
+      ENDIF
+      GOTO 34
+   35 CONTINUE
+      IF(NTE.LE.0) GOTO 38
+      RME=RME0
+      IF(NTE.EQ.1) GOTO 38
+      NTE1=NTE
+      IF(NTE1.GT.5) NTE1=5
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      RME=-LOG(1.-RAN)
+      GPAR=G1PAR(NTE1)
+      CPAR=C1PAR(NTE1)
+      DUMNVE=GPAR
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      RME=RME0+RME**CPAR/DUMNVE
+C**
+C** SET BEAM , TARGET OF FIRST INTERACTION IN CMS
+C**
+   38 PV( 1,MX1) =0.
+      PV( 2,MX1) =0.
+      PV( 3,MX1) =P
+      PV( 5,MX1) =ABS(AMAS)
+      PV( 4,MX1) =SQRT(P*P+AMAS*AMAS)
+      PV( 1,MX2) =0.
+      PV( 2,MX2) =0.
+      PV( 3,MX2) =0.
+      PV( 4,MX2) =MP
+      PV( 5,MX2) =MP
+
+C** TRANSFORM INTO CMS.
+
+      CALL ADD(MX1,MX2,MX)
+      CALL LOR(MX1,MX,MX1)
+      CALL LOR(MX2,MX,MX2)
+      PF=(S+RMD*RMD-RMC*RMC)**2 - 4*S*RMD*RMD
+      IF(PF.LT.0.0001) PF=0.0001
+      DUMNVE=2.0*RS
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      PF=SQRT(PF)/DUMNVE
+      IF(NPRT(4)) WRITE(6,2002) PF,RMC,RMD,RS
+C**
+C** SET FINAL STATE MASSES AND ENERGIES IN CMS
+C**
+      PV(5,MX3) =RMC
+      PV(5,MX4) =RMD
+      PV(4,MX3) =SQRT(PF*PF+RMC*RMC)
+      PV(4,MX4) =SQRT(PF*PF+RMD*RMD)
+C**
+C** SET |T| AND |TMIN|
+C**
+      T=-1.0E10
+      CALL GRNDM(RNDM,1)
+      IF (B .NE. 0.0) T=LOG(1.-RNDM(1))/B
+      CALL LENGTX(MX1,PIN)
+      TACMIN=(PV(4,MX1) -PV(4,MX3))**2 -(PIN-PF)**2
+C**
+C** CACULATE (SIN(TETA/2.)**2 AND COS(TETA), SET AZIMUTH ANGLE PHI
+C**
+      DUMNVE=4.0*PIN*PF
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      CTET=-(T-TACMIN)/DUMNVE
+      CTET=1.0-2.0*CTET
+      IF (CTET .GT. 1.0) CTET=1.0
+      IF (CTET .LT. -1.0) CTET=-1.0
+      DUMNVE=1.0-CTET*CTET
+      IF (DUMNVE .LT. 0.0) DUMNVE=0.0
+      STET=SQRT(DUMNVE)
+      CALL GRNDM(RNDM,1)
+      PHI=RNDM(1)*TWPI
+C**
+C** CALCULATE FINAL STATE MOMENTA IN CMS
+C**
+      PV(1,MX3) =PF*STET*SIN(PHI)
+      PV(2,MX3) =PF*STET*COS(PHI)
+      PV(3,MX3) =PF*CTET
+      PV(1,MX4) =-PV(1,MX3)
+      PV(2,MX4) =-PV(2,MX3)
+      PV(3,MX4) =-PV(3,MX3)
+C**
+C** SIMULATE BACKWARD NUCLEON CLUSTER IN LAB. SYSTEM AND TRANSFORM IN
+C** CMS.
+C**
+      IF(NTE.EQ.0) GOTO 28
+      GA=1.2
+      EKIT1=0.04
+      EKIT2=0.6
+      IF(EK.GT.5.) GOTO 666
+      EKIT1=EKIT1*EK**2/25.
+      EKIT2=EKIT2*EK**2/25.
+  666 A=(1.-GA)/(EKIT2**(1.-GA)-EKIT1**(1.-GA))
+      DO 29 I=1,NT
+      IF(SIDE(I).GT.-1.5) GOTO 29
+      CALL GRNDM(RNDM,3)
+      RAN=RNDM(1)
+      EKIT=(RAN*(1.-GA)/A+EKIT1**(1.-GA))**(1./(1.-GA))
+      PV(4,I)=EKIT+PV(5,I)
+      DUMNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP=SQRT(DUMNVE)
+      RAN=RNDM(2)
+      COST=LOG(2.23*RAN+0.383)/0.96
+      IF (COST .LT. -1.0) COST=-1.0
+      IF (COST .GT. 1.0) COST=1.0
+      DUMNVE=1.0-COST*COST
+      IF (DUMNVE .LT. 0.0) DUMNVE=0.0
+      SINT=SQRT(DUMNVE)
+      PHI=TWPI*RNDM(3)
+      PV(1,I)=PP*SINT*SIN(PHI)
+      PV(2,I)=PP*SINT*COS(PHI)
+      PV(3,I)=PP*COST
+      CALL LOR(I,MX,I)
+   29 CONTINUE
+C**
+C** FRAGMENTATION OF FORWARD CLUSTER AND BACKWARD MESON CLUSTER
+C**
+   28 PV(1,1)=PV(1,MX3)
+      PV(2,1)=PV(2,MX3)
+      PV(3,1)=PV(3,MX3)
+      PV(4,1)=PV(4,MX3)
+      PV(1,2)=PV(1,MX4)
+      PV(2,2)=PV(2,MX4)
+      PV(3,2)=PV(3,MX4)
+      PV(4,2)=PV(4,MX4)
+      DO 17 I=MX5,MX6
+      DO 16 J=1,3
+   16 PV(J,I)=-PV(J,I-2)
+      DO 17 J=4,5
+   17 PV(J,I)= PV(J,I-2)
+      KGENEV=1
+      IF(NTC.LE.1) GOTO 26
+      TECM=PV(5,MX3)
+      NPG=0
+      DO 18 I=1,NT
+      IF(SIDE(I).LT.0.) GOTO 18
+      IF(NPG.EQ.18) THEN
+         SIDE(I)=-SIDE(I)
+         GOTO 18
+      ENDIF
+      NPG=NPG+1
+      AMASS(NPG)=ABS(PV(5,I))
+   18 CONTINUE
+      IF(NPRT(4)) WRITE(NEWBCD,2004) TECM,NPG,(AMASS(I),I=1,NPG)
+      CALL PHASP
+      NPG=0
+      DO 19 I=1,NT
+      IF(SIDE(I).LT.0.) GOTO 19
+      NPG=NPG+1
+      PV(1,I)=PCM(1,NPG)
+      PV(2,I)=PCM(2,NPG)
+      PV(3,I)=PCM(3,NPG)
+      PV(4,I)=PCM(4,NPG)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      CALL LOR(I,MX5,I)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+   19 CONTINUE
+   26 IF(NTD.LE.1) GOTO 27
+      TECM=PV(5,MX4)
+      NPG=0
+      DO 20 I=1,NT
+      IF(SIDE(I).GT.0..OR.SIDE(I).LT.-1.5) GOTO 20
+      IF(NPG.EQ.18) THEN
+         SIDE(I)=-2.
+         PV(4,I)=ABS(PV(5,I))
+         DO 24 J=1,3
+            PV(J,I)=0.
+   24    CONTINUE
+         GOTO 20
+      ENDIF
+      NPG=NPG+1
+      AMASS(NPG)=ABS(PV(5,I))
+   20 CONTINUE
+      IF(NPRT(4)) WRITE(NEWBCD,2004) TECM,NPG,(AMASS(I),I=1,NPG)
+      CALL PHASP
+      NPG=0
+      DO 21 I=1,NT
+      IF(SIDE(I).GT.0..OR.SIDE(I).LT.-1.5) GOTO 21
+      NPG=NPG+1
+      PV(1,I)=PCM(1,NPG)
+      PV(2,I)=PCM(2,NPG)
+      PV(3,I)=PCM(3,NPG)
+      PV(4,I)=PCM(4,NPG)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      CALL LOR(I,MX6,I)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+   21 CONTINUE
+C**
+C** LORENTZ TRANSFORMATION IN LAB SYSTEM
+C**
+   27 TARG=0.
+      DO 36 I=1,NT
+      IF(PV(5,I).GT.0.5) TARG=TARG+1.
+      CALL LOR(I,MX2,I)
+   36 CONTINUE
+      IF(TARG.LT.0.5) TARG=1.
+C**
+C** SOMETIMES THE LEADING STRANGE PARTICLES ARE LOST , SET THEM BACK
+C**
+      IF(LEAD.EQ.0) GOTO 6085
+      DO 6081 I=1,NT
+      IF(ABS(IPA(I)).EQ.LEAD) GOTO 6085
+ 6081 CONTINUE
+      I=1
+      IF(LEAD.GE.14.AND.ABS(IPA(2)).GE.14) I=2
+      IF(LEAD.LT.14.AND.ABS(IPA(2)).LT.14) I=2
+      IPA(I)=LEAD
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      PV(5,I)=RMASS(LEAD)
+      PV(7,I)=1.
+      IF(PV(5,I).LT.0.) PV(7,I)=-1.
+      PV(5,I)=ABS(PV(5,I))
+      PV(6,I)=RCHARG(LEAD)
+      PV(4,I)=PV(5,I)+EKIN
+      CALL LENGTX(I,PP)
+      DUMNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP1=SQRT(DUMNVE)
+C
+      IF (PP .GE. 1.0E-6) GO TO 8000
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP1*COS(RTHNVE)
+      GO TO 8001
+ 8000 CONTINUE
+      PV(1,I)=PV(1,I)*PP1/PP
+      PV(2,I)=PV(2,I)*PP1/PP
+      PV(3,I)=PV(3,I)*PP1/PP
+ 8001 CONTINUE
+C
+C** FOR VARIOUS REASONS, THE ENERGY BALANCE IS NOT SUFFICIENT,
+C** CHECK THAT,  ENERGY BALANCE, ANGLE OF FINAL SYSTEM E.T.C.
+ 6085 KGENEV=1
+      PV(1,MX4) =0.
+      PV(2,MX4) =0.
+      PV(3,MX4) =P
+      PV(4,MX4) =SQRT(P*P+AMAS*AMAS)
+      PV(5,MX4) =ABS(AMAS)
+      EKIN0=PV(4,MX4) -PV(5,MX4)
+      PV(1,MX5) =0.
+      PV(2,MX5) =0.
+      PV(3,MX5) =0.
+      PV(4,MX5) =MP*TARG
+      PV(5,MX5) =PV(4,MX5)
+      EKIN=PV(4,MX4) +PV(4,MX5)
+      I=MX4
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      I=MX5
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
+      CALL ADD(MX4,MX5,MX6)
+      CALL LOR(MX4,MX6,MX4)
+      CALL LOR(MX5,MX6,MX5)
+      TECM=PV(4,MX4) +PV(4,MX5)
+      NPG=NT
+      PV(1,MX8) =0.
+      PV(2,MX8) =0.
+      PV(3,MX8) =0.
+      PV(4,MX8) =0.
+      PV(5,MX8) =0.
+      EKIN1=0.
+      DO 598 I=1,NPG
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+      CALL ADD(MX8,I,MX8)
+      EKIN1=EKIN1+PV(4,I)-PV(5,I)
+      EKIN=EKIN-PV(5,I)
+      IF(I.GT.18) GOTO 598
+      AMASS(I)=PV(5,I)
+  598 CONTINUE
+      IF(NPG.GT.18) GOTO 597
+      CALL PHASP
+      EKIN=0.
+      DO 599 I=1,NPG
+      PV(1,MX7)=PCM(1,I)
+      PV(2,MX7)=PCM(2,I)
+      PV(3,MX7)=PCM(3,I)
+      PV(4,MX7)=PCM(4,I)
+      PV(5,MX7)=AMASS(I)
+      CALL LOR(MX7,MX5,MX7)
+  599 EKIN=EKIN+PV(4,MX7)-PV(5,MX7)
+      CALL ANG(MX8,MX4,COST,TETA)
+      IF(NPRT(4)) WRITE(NEWBCD,2003) TETA,EKIN0,EKIN1,EKIN
+C**
+C** MAKE SHURE, THAT  KINETIC ENERGIES ARE CORRECT
+C** THE 3. CLUSTER IS NOT PRODUCED WITHIN PROPER KINEMATICS!!!
+C** EKIN= KINETIC ENERGY THEORETICALLY
+C** EKIN1= KINETIC ENERGY SIMULATED
+C**
+  597 IF(EKIN1.EQ.0.) GOTO 600
+      PV(1,MX7) =0.
+      PV(2,MX7) =0.
+      PV(3,MX7) =0.
+      PV(4,MX7) =0.
+      PV(5,MX7) =0.
+      WGT=EKIN/EKIN1
+      EKIN1=0.
+      DO 602 I=1,NT
+      EKIN=PV(4,I)-PV(5,I)
+      EKIN=EKIN*WGT
+      PV(4,I)=EKIN+PV(5,I)
+      DUMNVE=ABS(PV(4,I)**2-PV(5,I)**2)
+      PP=SQRT(DUMNVE)
+      CALL LENGTX(I,PP1)
+C
+      IF (PP1 .GE. 1.0E-6) GO TO 8002
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP*COS(RTHNVE)
+      GO TO 8003
+ 8002 CONTINUE
+      PV(1,I)=PV(1,I)*PP/PP1
+      PV(2,I)=PV(2,I)*PP/PP1
+      PV(3,I)=PV(3,I)*PP/PP1
+ 8003 CONTINUE
+C
+      EKIN1=EKIN1+EKIN
+      CALL ADD(MX7,I,MX7)
+  602 CONTINUE
+      CALL ANG(MX7,MX4,COST,TETA)
+      IF(NPRT(4)) WRITE(NEWBCD,2003) TETA,EKIN0,EKIN1
+C**
+C** ROTATE IN DIRECTION OF Z-AXIS, SEE COMMENTS IN 'GENXPT'
+C**
+  600 PV(1,MX7)=0.
+      PV(2,MX7)=0.
+      PV(3,MX7)=0.
+      PV(4,MX7)=0.
+      PV(5,MX7)=0.
+      DO 596 I=1,NT
+      CALL ADD(MX7,I,MX7)
+  596 CONTINUE
+*          CALL RANNOR(RAN1,RAN2)
+      CALL GRNDM(RNDM,2)
+      RY=RNDM(1)
+      RZ=RNDM(2)
+      RX=6.283185*RZ
+      A1=SQRT(-2.*LOG(RY))
+      RAN1=A1*SIN(RX)
+      RAN2=A1*COS(RX)
+      PV(1,MX7)=PV(1,MX7)+RAN1*0.020*TARG
+      PV(2,MX7)=PV(2,MX7)+RAN2*0.020*TARG
+      CALL DEFS(MX4,MX7,MX8)
+      PV(1,MX7)=0.
+      PV(2,MX7)=0.
+      PV(3,MX7)=0.
+      PV(4,MX7)=0.
+      PV(5,MX7)=0.
+      DO 595 I=1,NT
+      CALL TRAC(I,MX8,I)
+      CALL ADD(MX7,I,MX7)
+  595 CONTINUE
+      CALL ANG(MX7,MX4,COST,TETA)
+      IF(NPRT(4)) WRITE(NEWBCD,2003) TETA
+C**
+C** ROTATE IN DIRECTION OF PRIMARY PARTICLE
+C**
+      DEKIN=0.
+      NPIONS=0
+      EK1=0.
+      DO 25 I=1,NT
+      CALL DEFS1(I,MXGKPV-1,I)
+      IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
+      IF(ATNO2.LT.1.5) GOTO 25
+      CALL LENGTX(I,PP)
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      CALL NORMAL(RAN)
+      EKIN=EKIN-CFA*(1.+0.5*RAN)
+      IF (EKIN .LT. 1.0E-6) EKIN=1.0E-6
+      CALL STEEQ(XXH,I)
+      DEKIN=DEKIN+EKIN*(1.-XXH)
+      EKIN=EKIN*XXH
+      IF(ABS(IPA(I)).GE.7.AND.ABS(IPA(I)).LE.9) NPIONS=NPIONS+1
+      IF(ABS(IPA(I)).GE.7.AND.ABS(IPA(I)).LE.9) EK1=EK1+EKIN
+      PP1=SQRT(EKIN*(EKIN+2.*ABS(PV(5,I))))
+      PV(4,I)=EKIN+ABS(PV(5,I))
+C
+      IF (PP .GE. 1.0E-6) GO TO 8004
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP1*COS(RTHNVE)
+      GO TO 8005
+ 8004 CONTINUE
+      PV(1,I)=PV(1,I)*PP1/PP
+      PV(2,I)=PV(2,I)*PP1/PP
+      PV(3,I)=PV(3,I)*PP1/PP
+ 8005 CONTINUE
+C
+   25 CONTINUE
+      IF(EK1.EQ.0.) GOTO 23
+      IF(NPIONS.LE.0) GOTO 23
+      DEKIN=1.+DEKIN/EK1
+      DO 22 I=1,NT
+      IF(ABS(IPA(I)).LT.7.OR.ABS(IPA(I)).GT.9) GOTO 22
+      CALL LENGTX(I,PP)
+      EKIN=PV(4,I)-ABS(PV(5,I))
+      EKIN=EKIN*DEKIN
+      IF (EKIN .LT. 1.0E-6) EKIN=1.0E-6
+      PP1=SQRT(EKIN*(EKIN+2.*ABS(PV(5,I))))
+      PV(4,I)=EKIN+ABS(PV(5,I))
+C
+      IF (PP .GE. 1.0E-6) GO TO 8006
+      CALL GRNDM(RNDM,2)
+      RTHNVE=PI*RNDM(1)
+      PHINVE=TWPI*RNDM(2)
+      PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
+      PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
+      PV(3,I)=PP1*COS(RTHNVE)
+      GO TO 8007
+ 8006 CONTINUE
+      PV(1,I)=PV(1,I)*PP1/PP
+      PV(2,I)=PV(2,I)*PP1/PP
+      PV(3,I)=PV(3,I)*PP1/PP
+ 8007 CONTINUE
+C
+   22 CONTINUE
+   23 IF(ATNO2.LT.1.5) GOTO 40
+C**
+C** ADD BLACK TRACK PARTICLES
+C**
+      CALL SELFAB(SPROB)
+      TEX=ENP(1)
+      SPALL=TARG
+      IF(TEX.LT.0.001) GOTO 445
+      BLACK=(1.5+1.25*TARG)*ENP(1)/(ENP(1)+ENP(3))
+      CALL POISSO(BLACK,NBL)
+      IF(NPRT(4))
+     *WRITE(NEWBCD,3003) NBL,TEX
+      IF(IFIX(TARG)+NBL.GT.ATNO2) NBL=ATNO2-TARG
+      IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
+      IF(NBL.LE.0) GOTO 445
+      EKIN=TEX/NBL
+      EKIN2=0.
+      CALL STEEP(XX)
+      DO 441 I=1,NBL
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SPROB) GOTO 441
+      IF(NT.EQ.MXGKPV-2) GOTO 441
+      IF(EKIN2.GT.TEX) GOTO 443
+      CALL GRNDM(RNDM,1)
+      RAN1=RNDM(1)
+      CALL NORMAL(RAN2)
+      EKIN1=-EKIN*LOG(RAN1)-CFA*(1.+0.5*RAN2)
+      IF(EKIN1.LT.0.0) EKIN1=-0.010*LOG(RAN1)
+      EKIN1=EKIN1*XX
+      EKIN2=EKIN2+EKIN1
+      IF(EKIN2.GT.TEX) EKIN1=TEX-(EKIN2-EKIN1)
+      IF (EKIN1 .LT. 0.0) EKIN1=1.0E-6
+      IPA1=16
+      PNRAT=1.-ZNO2/ATNO2
+      CALL GRNDM(RNDM,3)
+      IF(RNDM(1).GT.PNRAT) IPA1=14
+      NT=NT+1
+      SPALL=SPALL+1.
+      COST=-1.0+RNDM(2)*2.0
+      DUMNVE=1.0-COST*COST
+      IF (DUMNVE .LT. 0.0) DUMNVE=0.0
+      SINT=SQRT(DUMNVE)
+      PHI=TWPI*RNDM(3)
+      IPA(NT)=-IPA1
+      SIDE(NT)=-4.
+      PV(5,NT)=ABS(RMASS(IPA1))
+      PV(6,NT)=RCHARG(IPA1)
+      PV(7,NT)=1.
+      PV(4,NT)=EKIN1+PV(5,NT)
+      DUMNVE=ABS(PV(4,NT)**2-PV(5,NT)**2)
+      PP=SQRT(DUMNVE)
+      PV(1,NT)=PP*SINT*SIN(PHI)
+      PV(2,NT)=PP*SINT*COS(PHI)
+      PV(3,NT)=PP*COST
+  441 CONTINUE
+  443 IF(ATNO2.LT.10.) GOTO 445
+      IF(EK.GT.2.0) GOTO 445
+      II=NT+1
+      KK=0
+      EKA=EK
+      IF(EKA.GT.1.) EKA=EKA*EKA
+      IF(EKA.LT.0.1) EKA=0.1
+      IKA=3.6*EXP((ZNO2**2/ATNO2-35.56)/6.45)/EKA
+      IF(IKA.LE.0) GO TO 445
+      DO 444 I=1,NT
+      II=II-1
+      IF(IPA(II).NE.-14) GOTO 444
+      IPA(II)=-16
+      IPA1  = 16
+      PV(5,II)=ABS(RMASS(IPA1))
+      PV(6,II)=RCHARG(IPA1)
+      KK=KK+1
+      IF(KK.GT.IKA) GOTO 445
+  444 CONTINUE
+  445 TEX=ENP(3)
+      IF(TEX.LT.0.001) GOTO 40
+      BLACK=(1.5+1.25*TARG)*ENP(3)/(ENP(1)+ENP(3))
+      CALL POISSO(BLACK,NBL)
+      IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
+      IF(NBL.LE.0) GOTO 40
+      EKIN=TEX/NBL
+      EKIN2=0.
+      CALL STEEP(XX)
+      IF(NPRT(4))
+     *WRITE(NEWBCD,3004) NBL,TEX
+      DO 442 I=1,NBL
+      CALL GRNDM(RNDM,1)
+      IF(RNDM(1).LT.SPROB) GOTO 442
+      IF(NT.EQ.MXGKPV-2) GOTO 442
+      IF(EKIN2.GT.TEX) GOTO 40
+      CALL GRNDM(RNDM,1)
+      RAN1=RNDM(1)
+      CALL NORMAL(RAN2)
+      EKIN1=-EKIN*LOG(RAN1)-CFA*(1.+0.5*RAN2)
+      IF(EKIN1.LT.0.0) EKIN1=-0.005*LOG(RAN1)
+      EKIN1=EKIN1*XX
+      EKIN2=EKIN2+EKIN1
+      IF(EKIN2.GT.TEX) EKIN1=TEX-(EKIN2-EKIN1)
+      IF (EKIN1 .LT. 0.0) EKIN1=1.0E-6
+      CALL GRNDM(RNDM,3)
+      COST=-1.0+RNDM(1)*2.0
+      DUMNVE=1.0-COST*COST
+      IF (DUMNVE .LT. 0.0) DUMNVE=0.0
+      SINT=SQRT(DUMNVE)
+      PHI=TWPI*RNDM(2)
+      RAN=RNDM(3)
+      IPA(NT+1)=-30
+      IF(RAN.GT.0.60) IPA(NT+1)=-31
+      IF(RAN.GT.0.90) IPA(NT+1)=-32
+      SIDE(NT+1)=-4.
+      PV(5,NT+1)=(ABS(IPA(NT+1))-28)*MP
+      SPALL=SPALL+PV(5,NT+1)*1.066
+      IF(SPALL.GT.ATNO2) GOTO 40
+      NT=NT+1
+      PV(6,NT)=1.
+      IF(IPA(NT).EQ.-32) PV(6,NT)=2.
+      PV(7,NT)=1.
+      PV(4,NT)=PV(5,NT)+EKIN1
+      DUMNVE=ABS(PV(4,NT)**2-PV(5,NT)**2)
+      PP=SQRT(DUMNVE)
+      PV(1,NT)=PP*SINT*SIN(PHI)
+      PV(2,NT)=PP*SINT*COS(PHI)
+      PV(3,NT)=PP*COST
+  442 CONTINUE
+C**
+C** STORE ON EVENT COMMON
+C**
+   40 CALL GRNDM(RNDM,1)
+      IF(RS.GT.(4.+RNDM(1)*1.)) GOTO 42
+      DO 41 I=1,NT
+      CALL LENGTX(I,ETB)
+      IF(ETB.LT.P) GOTO 41
+      ETF=P
+      PV(4,I)=SQRT(PV(5,I)**2+ETF**2)
+      DUMNVE=ETB
+      IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
+      ETF=ETF/DUMNVE
+      PV(1,I)=PV(1,I)*ETF
+      PV(2,I)=PV(2,I)*ETF
+      PV(3,I)=PV(3,I)*ETF
+   41 CONTINUE
+   42 EKIN=PV(4,MXGKPV)-ABS(PV(5,MXGKPV))
+      EKIN1=PV(4,MXGKPV-1)-ABS(PV(5,MXGKPV-1))
+      EKIN2=0.
+      CALL TDELAY(TOF1)
+      CALL GRNDM(RNDM,1)
+      RAN=RNDM(1)
+      TOF=TOF-TOF1*LOG(RAN)
+      DO 44 I=1,NT
+      EKIN2=EKIN2+PV(4,I)-ABS(PV(5,I))
+      IF(PV(7,I).LT.0.) PV(5,I)=-PV(5,I)
+      PV(7,I)=TOF
+      PV(8,I)=ABS(IPA(I))
+      PV(9,I)=0.
+   44 PV(10,I)=0.
+      IF(NPRT(4)) WRITE(NEWBCD,2006) NT,EKIN,ENP(1),ENP(3),EKIN1,EKIN2
+      INTCT=INTCT+1.
+      CALL SETCUR(NT)
+      NTK=NTK+1
+      IF(NT.EQ.1) GOTO 300
+      DO 50 II=2,NT
+      I=II-1
+      IF(NTOT.LT.NSIZE/12) GOTO 43
+      GO TO 9999
+   43 CALL SETTRK(I)
+   50 CONTINUE
+ 300  CONTINUE
+      GO TO 9999
+C**
+C** IT IS NOT POSSIBLE TO PRODUCE A PROPER TWO CLUSTER FINAL STATE.
+C** CONTINUE WITH QUASI ELASTIC SCATTERING
+C**
+   60 IF(NPRT(4)) WRITE(NEWBCD,2005)
+      DO 61 I=3,MXGKCU
+   61 IPA(I)=0
+      IPA(1)=IPART
+      IPA(2)=14
+      IF(NFL.EQ.2) IPA(2)=16
+      CALL TWOB(IPPP,NFL,AVERN)
+      GO TO 9999
+C
+ 2000 FORMAT(' *TWOCLU* CMS PARAMETERS OF FINAL STATE PARTICLES',
+     $ ' AFTER ',I3,' TRIALS')
+ 2001 FORMAT(' *TWOCLU* TRACK',2X,I3,2X,10F8.2,2X,I3,2X,F3.0)
+ 2002 FORMAT(' *TWOCLU* MOMENTUM ',F8.3,' MASSES ',2F8.4,' RS ',F8.4)
+ 2003 FORMAT(' *TWOCLU* TETA,EKIN0,EKIN1,EKIN ',4F10.4)
+ 2004 FORMAT(' *TWOCLU* TECM,NPB,MASSES: ',F10.4,1X,I3,1X,8F10.4/
+     $ 1H ,26X,15X,8F10.4)
+ 2005 FORMAT(' *TWOCLU* NUMBER OF FINAL STATE PARTICLES',
+     $ ' LESS THAN 2 ==> CONTINUE WITH 2-BODY SCATTERING')
+ 2006 FORMAT(' *TWOCLU*  COMP.',1X,I5,1X,5F7.2)
+ 3001 FORMAT(' *TWOCLU* NUCLEAR EXCITATION ',I5,' PARTICLES PRODUCED',
+     $ ' IN ADDITION TO',I5,' NORMAL PARTICLES')
+ 3003 FORMAT(' *TWOCLU* ',I3,' BLACK TRACK PARTICLES PRODUCED',
+     $ ' WITH TOTAL KINETIC ENERGY OF ',F8.3,' GEV')
+ 3004 FORMAT(' *TWOCLU* ',I5,' HEAVY FRAGMENTS WITH TOTAL ENERGY OF ',
+     $ F8.4,' GEV')
+C
+ 9999 CONTINUE
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/Makefile
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/Makefile	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/Makefile	(revision 286)
@@ -0,0 +1,154 @@
+#============================================================
+# Makefile to compile modified 5.20 version of CORSIKA.
+#
+# Copyright (c) J C Gonzalez, 1998
+#============================================================
+
+DESTDIR = .
+
+F77 = f77
+CC = cc
+CERNDIR = CERN
+ADDFLAGS =
+
+EXE_VERSION = c520
+
+###
+#   compiler & linker options section
+###
+
+# machine dependencies
+SYSTEM = GENERIC
+
+## generic (alpha)
+GENERIC_CFLAGS   = -I. -I/usr/include -DJC_UNDERSCORES ${ADDFLAGS}
+GENERIC_FFLAGS   = ${GENERIC_CFLAGS}
+GENERIC_EXE      = ${EXE_VERSION}-generic
+GENERIC_LIBS     = -lm -lc
+GENERIC_CC       = cc
+GENERIC_F77      = f77
+
+## osf (alpha)
+OSF_CFLAGS   = -I. -I/usr/include -DJC_UNDERSCORES ${ADDFLAGS}
+OSF_FFLAGS   = ${OSF_CFLAGS}
+OSF_EXE      = ${EXE_VERSION}-osf
+OSF_LIBS     = -lm -lc
+OSF_CC       = cc
+OSF_F77      = f77
+
+## linux
+LINUX_CFLAGS = -I. -I/usr/include -funderscoring -DJC_UNDERSCORES \
+		-m486 -DCPU=686 ${ADDFLAGS}
+LINUX_FFLAGS = ${LINUX_CFLAGS}
+LINUX_EXE    = ${EXE_VERSION}-linux
+LINUX_LIBS   = -lm -lc
+LINUX_CC     = gcc
+LINUX_F77    = g77
+
+## aix (ibm rs6000)
+AIX_CFLAGS   = -I. -I/usr/include -DJC_NO_UNDERSCORES ${ADDFLAGS}
+AIX_FFLAGS   = ${AIX_CFLAGS}
+AIX_EXE      = ${EXE_VERSION}-aix
+AIX_LIBS     = -lm -lc -lbsd
+AIX_CC       = cc
+AIX_F77      = xlf
+
+# choose this machine values
+F77    = ${${SYSTEM}_F77}
+CC     = ${${SYSTEM}_CC}
+CFLAGS = ${${SYSTEM}_CFLAGS}
+FFLAGS = ${${SYSTEM}_FFLAGS}
+LIBS   = ${${SYSTEM}_LIBS}
+
+###
+#   miscelanea
+###
+
+CERNDIR = CERN
+
+###
+#   files section
+###
+
+HEADERS =
+
+FSRCS = \
+	GHEISHA.f VENUS.f addang.f addani.f age.f amoeba.f  \
+	amotry.f annih.f ausgab.f ausgb2.f avage.f avept.f  \
+	bhabha.f block1.f box2.f box3.f box60.f box61.f  \
+	box62.f box63.f box65.f box66.f box67.f box68.f  \
+	box69.f box70.f box71.f box72.f box73.f box74.f  \
+	brems.f cerenkov.f cghei.f cghini.f cghsig.f  \
+	chisq.f compt.f coorin.f datac.f decay1.f decay6.f  \
+	difrac.f dpfunc.f egs4.f egs4bd.f egsini.f electr.f  \
+	em.f etadec.f flpsor.f fstack.f gam.f garndm.f  \
+	gbrsgm.f gprsgm.f granor.f grndm.f hatch.f hdpm.f  \
+	heigh.f hmeson.f howfar.f ininkg.f inprm.f isobar.f  \
+	istack.f jadach.f kdecay.f leaddf.f ledeny.f  \
+	lepacx.f longft.f lowup.f lpm.f main.f mitage.f  \
+	mmol4.f mmolie.f moller.f mpoiss.f mpprop.f mscat.f  \
+	mubrem.f mucoul.f mudecy.f mupair.f muprpr.f  \
+	mutrac.f nihila.f nkg.f nsd.f nucint.f outend.f  \
+	output.f pair.f pamaf.f parnum.f parrap.f pcl.f  \
+	photo.f photon.f pi0dec.f pigen.f pigen1.f pigen2.f  \
+	pparam.f prange.f prtime.f ptram.f ptran.f ptrans.f  \
+	rangen.f rannor.f resdec.f rhof.f rmmaq.f rmmar.f  \
+	rnegbi.f sdpm.f selcor.f shower.f single.f sobseq.f  \
+	staend.f stankg.f start.f strdec.f tarint.f thick.f  \
+	tobuf.f tstack.f tstend.f tstini.f tstout.f ucopy.f  \
+	update.f uphi.f utqsea.f utqval.f vapor.f vendat.f  \
+	venini.f venlnk.f vhmeso.f vstore.f vzero.f
+
+CSRCS = \
+	jcio.c jcdate.c
+
+ALLOBJS = ${FSRCS:.f=.o} ${CSRCS:.c=.o}
+
+PROGRAM = ${${SYSTEM}_EXE}
+
+help:
+	@echo ''
+	@echo 'Usage::'
+	@echo ''
+	@echo '  make help              shows this help            or' 
+	@echo '  make clean             cleans-up garbage          or'
+	@echo '  make all [ SYSTEM = { OSF | LINUX | AIX | GENERIC} ]'
+	@echo '                         compiles with pre-defined flags for'
+	@echo '                         OSF, Linux or AIX flavour of Unix'
+	@echo ''
+	@echo 'Additionally, you can add to your command line ADDFLAGS=<flags>"
+	@echo 'to include any new flag you want.'
+	@echo ''
+	@echo 'In case of problems, please contact to <gonzalez@mppmu.mpg.de>'
+	@echo ''
+
+all: message ${PROGRAM} 
+
+message:
+	@echo "============================================================"
+	@echo " Compilation of CORSIKA ("${EXE_VERSION}")"
+	@echo " Target machine => `uname -a`"
+	@echo " System choosed => "${SYSTEM}
+	@echo " Date: `date`"
+	@echo "============================================================"
+	@echo ''
+
+${PROGRAM}: ${ALLOBJS}
+	@echo -n "   . . . and linking -> "${PROGRAM}" . . . "
+	$(F77) ${FFLAGS} -o ${PROGRAM} ${ALLOBJS} ${LIBS} ${XLIB}
+	@echo "done."
+
+.f.o:
+	@echo "Compiling "$<" . . ."
+	$(F77) -c $(FFLAGS) $< -o $@
+
+.c.o:
+	@echo "Compiling "$<" . . ."
+	$(CC) -c $(CFLAGS) $< -o $@
+
+script:
+	@sh ./c-script.sh
+
+clean: 
+	@echo "Cleaning . . ."
+	@rm *.o *~ core *.BAK > /dev/null 2>&1 || echo "...already clean."
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/NUCNUCCS
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/NUCNUCCS	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/NUCNUCCS	(revision 286)
@@ -0,0 +1,2873 @@
+ .2364000000E+03 .4192455465E+03 .4869287370E+03 .5033423627E+03 .0000000000E+00
+ .7340329246E+03 .7372974817E+03 .0000000000E+00 .8270120942E+03 .8362345422E+03
+ .8517021299E+03 .8859238526E+03 .8970539414E+03 .9429513425E+03 .9809473505E+03
+ .1035655313E+04 .1028833214E+04 .1064293860E+04 .1134839684E+04 .1158022931E+04
+ .1123861966E+04 .1150858032E+04 .1178502930E+04 .1206812065E+04 .1221328328E+04
+ .1212237443E+04 .1221910612E+04 .1271085324E+04 .1271661610E+04 .1308604233E+04
+ .1341535033E+04 .1367527954E+04 .1394024048E+04 .1421033569E+04 .1448566980E+04
+ .1401984750E+04 .1463388968E+04 .1483764648E+04 .1504424402E+04 .1498792169E+04
+ .1511763184E+04 .1524847778E+04 .1538044678E+04 .1551355713E+04 .1564781860E+04
+ .1578325317E+04 .1591985962E+04 .1605764042E+04 .1639553955E+04 .1674055420E+04
+ .1610349161E+04 .1669523211E+04 .1698150284E+04 .1733824641E+04 .1690624557E+04
+ .1750644689E+04 .2988000000E+03 .5151232717E+03 .5816478896E+03 .5915378260E+03
+ .0000000000E+00 .8537041607E+03 .8515776262E+03 .0000000000E+00 .9475330648E+03
+ .9548342237E+03 .9697707891E+03 .1006302071E+04 .1016764987E+04 .1066593752E+04
+ .1107425824E+04 .1166785778E+04 .1157591538E+04 .1195443423E+04 .1271671837E+04
+ .1297543314E+04 .1257348445E+04 .1285877930E+04 .1315056030E+04 .1344896220E+04
+ .1361194278E+04 .1348583995E+04 .1360535416E+04 .1411374495E+04 .1410733474E+04
+ .1451247403E+04 .1486545507E+04 .1514613037E+04 .1543208008E+04 .1572344849E+04
+ .1602031407E+04 .1547334726E+04 .1615979591E+04 .1636914795E+04 .1658121889E+04
+ .1651913041E+04 .1665506226E+04 .1679210937E+04 .1693029541E+04 .1706960693E+04
+ .1721006348E+04 .1735168945E+04 .1749446899E+04 .1763843999E+04 .1800036377E+04
+ .1836971786E+04 .1764793072E+04 .1829835412E+04 .1861060657E+04 .1900326700E+04
+ .1852989091E+04 .1916282473E+04 .3498000000E+03 .5902901864E+03 .6564631910E+03
+ .6622844790E+03 .0000000000E+00 .9466567719E+03 .9411527612E+03 .0000000000E+00
+ .1041597871E+04 .1047773834E+04 .1062481566E+04 .1100618132E+04 .1110740598E+04
+ .1163140249E+04 .1205769033E+04 .1267879825E+04 .1257342194E+04 .1296545497E+04
+ .1375631674E+04 .1406938982E+04 .1362635150E+04 .1392301025E+04 .1422613525E+04
+ .1453585407E+04 .1471273446E+04 .1456237897E+04 .1469912083E+04 .1521904393E+04
+ .1520476433E+04 .1563597672E+04 .1600578924E+04 .1630183105E+04 .1660335327E+04
+ .1691044189E+04 .1722321828E+04 .1661944757E+04 .1735731109E+04 .1757088013E+04
+ .1778706844E+04 .1772195265E+04 .1786275757E+04 .1800468262E+04 .1814773682E+04
+ .1829192627E+04 .1843726196E+04 .1858375244E+04 .1873140625E+04 .1888023690E+04
+ .1925959595E+04 .1964658810E+04 .1886519843E+04 .1955752712E+04 .1988855784E+04
+ .2030704840E+04 .1980467561E+04 .2046118139E+04 .2716000000E+03 .4700201601E+03
+ .5462645754E+03 .5685367473E+03 .0000000000E+00 .8098696423E+03 .8159294428E+03
+ .0000000000E+00 .9111460402E+03 .9224263586E+03 .9398161389E+03 .9758561309E+03
+ .9885875496E+03 .1035961536E+04 .1075229385E+04 .1130877826E+04 .1125339419E+04
+ .1161608864E+04 .1232165962E+04 .1264631243E+04 .1230968046E+04 .1259349365E+04
+ .1288386230E+04 .1318091577E+04 .1333405051E+04 .1325343879E+04 .1335301915E+04
+ .1386657727E+04 .1388070373E+04 .1426185237E+04 .1460244545E+04 .1487285156E+04
+ .1514825317E+04 .1542876465E+04 .1571447499E+04 .1525453057E+04 .1587745343E+04
+ .1609147217E+04 .1630837274E+04 .1625571969E+04 .1639243896E+04 .1653029785E+04
+ .1666932617E+04 .1680953369E+04 .1695089966E+04 .1709346558E+04 .1723723022E+04
+ .1738220454E+04 .1773049316E+04 .1808576343E+04 .1744922232E+04 .1805087228E+04
+ .1834410006E+04 .1870804444E+04 .1827099646E+04 .1889047855E+04 .3426000000E+03
+ .5749447318E+03 .6499914687E+03 .6657299443E+03 .0000000000E+00 .9380060686E+03
+ .9388017284E+03 .0000000000E+00 .1039842068E+04 .1049240755E+04 .1066068889E+04
+ .1104195355E+04 .1116243225E+04 .1167126690E+04 .1208825804E+04 .1268365777E+04
+ .1260683455E+04 .1298821196E+04 .1373688038E+04 .1413765211E+04 .1374098629E+04
+ .1404057373E+04 .1434668457E+04 .1465947538E+04 .1482971817E+04 .1471484020E+04
+ .1483567732E+04 .1536798966E+04 .1537023937E+04 .1578682701E+04 .1615132240E+04
+ .1644245850E+04 .1673884644E+04 .1704057617E+04 .1734775083E+04 .1680841769E+04
+ .1750257075E+04 .1772274780E+04 .1794570080E+04 .1788680473E+04 .1802980225E+04
+ .1817394287E+04 .1831925049E+04 .1846570557E+04 .1861333252E+04 .1876215088E+04
+ .1891213501E+04 .1906334966E+04 .1943578369E+04 .1981550311E+04 .1909583526E+04
+ .1975539069E+04 .2007422338E+04 .2047345196E+04 .1999490853E+04 .2064818897E+04
+ .3997000000E+03 .6565616744E+03 .7312411780E+03 .7429428142E+03 .0000000000E+00
+ .1036679985E+04 .1034252783E+04 .0000000000E+00 .1139270151E+04 .1147587019E+04
+ .1164145632E+04 .1203605489E+04 .1215288496E+04 .1268240345E+04 .1311262853E+04
+ .1372691947E+04 .1363908231E+04 .1402806888E+04 .1479046363E+04 .1530123851E+04
+ .1486363864E+04 .1517487183E+04 .1549262939E+04 .1581704494E+04 .1600069425E+04
+ .1586216775E+04 .1599923164E+04 .1654448749E+04 .1653906020E+04 .1698150713E+04
+ .1736302173E+04 .1766951172E+04 .1798140625E+04 .1829880859E+04 .1862180971E+04
+ .1802687790E+04 .1877165447E+04 .1899643311E+04 .1922390041E+04 .1916161496E+04
+ .1930951538E+04 .1945856201E+04 .1960875977E+04 .1976011719E+04 .1991264038E+04
+ .2006634277E+04 .2022123047E+04 .2037732028E+04 .2076722900E+04 .2116459947E+04
+ .2038656068E+04 .2108739605E+04 .2142469317E+04 .2184922414E+04 .2134173787E+04
+ .2201918377E+04 .5065000000E+03 .7857980391E+03 .8664114439E+03 .8721725227E+03
+ .0000000000E+00 .1203015806E+04 .1195258303E+04 .0000000000E+00 .1310815639E+04
+ .1316649206E+04 .1332643992E+04 .1376591018E+04 .1387278975E+04 .1448688337E+04
+ .1498841402E+04 .1573568526E+04 .1559092518E+04 .1606230522E+04 .1705227875E+04
+ .1732777215E+04 .1689660865E+04 .1722626099E+04 .1756234497E+04 .1790499760E+04
+ .1807561710E+04 .1788432878E+04 .1803917060E+04 .1861415012E+04 .1857422331E+04
+ .1905625505E+04 .1946635017E+04 .1979545532E+04 .2013014160E+04 .2047047119E+04
+ .2081657447E+04 .2013157446E+04 .2094626954E+04 .2118005371E+04 .2141646658E+04
+ .2133820878E+04 .2149218262E+04 .2164727051E+04 .2180349121E+04 .2196082520E+04
+ .2211927979E+04 .2227889404E+04 .2243967285E+04 .2260159621E+04 .2302171143E+04
+ .2344964467E+04 .2256113614E+04 .2333932030E+04 .2370755866E+04 .2417515836E+04
+ .2361223486E+04 .2433566823E+04 .5986000000E+03 .9119966706E+03 .9871783096E+03
+ .9831529581E+03 .0000000000E+00 .1349952643E+04 .1335045244E+04 .0000000000E+00
+ .1457295592E+04 .1460468510E+04 .1475554825E+04 .1522104023E+04 .1531784025E+04
+ .1597934688E+04 .1651618981E+04 .1732576201E+04 .1714777664E+04 .1765250898E+04
+ .1873078719E+04 .1896297180E+04 .1871661754E+04 .1905733398E+04 .1940425415E+04
+ .1975750074E+04 .1991821492E+04 .1967831436E+04 .1986249350E+04 .2044060845E+04
+ .2035727794E+04 .2087444640E+04 .2129442323E+04 .2164314941E+04 .2199757080E+04
+ .2235779297E+04 .2272393564E+04 .2197254377E+04 .2279729181E+04 .2302878906E+04
+ .2326263732E+04 .2318134243E+04 .2333981934E+04 .2349939941E+04 .2366005371E+04
+ .2382182373E+04 .2398468262E+04 .2414867187E+04 .2431376465E+04 .2448000457E+04
+ .2490516846E+04 .2533773595E+04 .2434431683E+04 .2519537019E+04 .2558544570E+04
+ .2609119894E+04 .2548090572E+04 .2623814694E+04 .6698000000E+03 .1008844387E+04
+ .1081626462E+04 .1071726419E+04 .0000000000E+00 .1464110178E+04 .1444648382E+04
+ .0000000000E+00 .1572008303E+04 .1573555377E+04 .1588192603E+04 .1636690403E+04
+ .1645815196E+04 .1715376736E+04 .1771639251E+04 .1857065733E+04 .1837057961E+04
+ .1889977425E+04 .2004113377E+04 .2024710745E+04 .2019860538E+04 .2054869873E+04
+ .2090486572E+04 .2126721111E+04 .2143905203E+04 .2116192549E+04 .2137538986E+04
+ .2195481145E+04 .2185326995E+04 .2239870180E+04 .2282800963E+04 .2319211426E+04
+ .2356200684E+04 .2393781494E+04 .2431959896E+04 .2351527778E+04 .2435918685E+04
+ .2459008057E+04 .2482316450E+04 .2474194852E+04 .2490401611E+04 .2506714844E+04
+ .2523134766E+04 .2539662354E+04 .2556298340E+04 .2573042969E+04 .2589899170E+04
+ .2606861783E+04 .2649013916E+04 .2691846198E+04 .2584857913E+04 .2675864704E+04
+ .2715618830E+04 .2768477779E+04 .2703602090E+04 .2782486391E+04
+ .6505744621E+00 .4916157708E+00 .7999651792E+00 .4013802989E+00 .6433631874E+00
+ .8470697844E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .3776118115E+00 .5878626461E+00 .7457607779E+00 .8739412365E+00 .9637804410E+00
+ .3458821034E+00 .5349612453E+00 .6750290658E+00 .7932319916E+00 .8950571984E+00
+ .9691065292E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .0000000000E+00 .0000000000E+00 .0000000000E+00 .3194229914E+00 .4904556202E+00
+ .6132635165E+00 .7137729773E+00 .8022406194E+00 .8813573260E+00 .9461227083E+00
+ .9865259212E+00 .3052164481E+00 .4673741148E+00 .5826706543E+00 .6758939354E+00
+ .7572897988E+00 .8316643353E+00 .8993104230E+00 .9546657723E+00 .9887981872E+00
+ .2945087630E+00 .4500729517E+00 .5598421946E+00 .6477153899E+00 .7235544351E+00
+ .7924703191E+00 .8568284411E+00 .9155359339E+00 .9628070408E+00 .9910734884E+00
+ .2878109856E+00 .4392941175E+00 .5455393822E+00 .6299285301E+00 .7020338489E+00
+ .7668423383E+00 .8271485331E+00 .8836972273E+00 .9341091923E+00 .9725988645E+00
+ .9938830827E+00 .2796461156E+00 .4262525519E+00 .5285807762E+00 .6093612846E+00
+ .6778462418E+00 .7388374702E+00 .7952148393E+00 .8486103296E+00 .8989929955E+00
+ .9435989046E+00 .9770126865E+00 .9949919134E+00 .2760136152E+00 .4205887192E+00
+ .5210919721E+00 .6000353339E+00 .6665420307E+00 .7253016892E+00 .7791113632E+00
+ .8296990721E+00 .8777000433E+00 .9219941492E+00 .9591430941E+00 .9846802714E+00
+ .9969815285E+00 .2720102844E+00 .4144402784E+00 .5131194091E+00 .5903117447E+00
+ .6550138973E+00 .7118197159E+00 .7634514548E+00 .8116533926E+00 .8573899419E+00
+ .9005214933E+00 .9392043308E+00 .9699413048E+00 .9895107663E+00 .9980993322E+00
+ .2695821775E+00 .4111341035E+00 .5089264566E+00 .5851606578E+00 .6487920895E+00
+ .7043705562E+00 .7545692842E+00 .8011005238E+00 .8450017573E+00 .8865051438E+00
+ .9246215158E+00 .9569321523E+00 .9804651193E+00 .9938534001E+00 .9990099457E+00
+ .2630441770E+00 .4006008826E+00 .4954008629E+00 .5690897917E+00 .6303843701E+00
+ .6836988096E+00 .7316172056E+00 .7758171648E+00 .8174472088E+00 .8572018501E+00
+ .8951151974E+00 .9301425880E+00 .9599604819E+00 .9817633139E+00 .9942288653E+00
+ .9990631674E+00 .2599104139E+00 .3960607374E+00 .4896938882E+00 .5622928452E+00
+ .6225016228E+00 .6746860826E+00 .7213888869E+00 .7642498904E+00 .8044001816E+00
+ .8425993872E+00 .8791608814E+00 .9136706082E+00 .9446758740E+00 .9698441664E+00
+ .9870838273E+00 .9961933071E+00 .9994288701E+00 .2586415060E+00 .3953753350E+00
+ .4892497388E+00 .5618746590E+00 .6219499385E+00 .6738609044E+00 .7201509062E+00
+ .7624472175E+00 .8018583685E+00 .8391235406E+00 .8745793556E+00 .9079667208E+00
+ .9382082404E+00 .9634923291E+00 .9820107839E+00 .9931601953E+00 .9982380612E+00
+ .9997717891E+00 .2502535115E+00 .3810073497E+00 .4719552753E+00 .5431373917E+00
+ .6026386708E+00 .6545537899E+00 .7012698986E+00 .7443218845E+00 .7847566077E+00
+ .8232640626E+00 .8601398175E+00 .8951106488E+00 .9271467461E+00 .9545369861E+00
+ .9754962768E+00 .9891749810E+00 .9963646215E+00 .9991826628E+00 .9999084336E+00
+ .2421278549E+00 .3685097464E+00 .4563833446E+00 .5251116592E+00 .5825000338E+00
+ .6324970842E+00 .6774005938E+00 .7186876606E+00 .7573823422E+00 .7942261104E+00
+ .8297272659E+00 .8640936388E+00 .8970496113E+00 .9276271114E+00 .9541754732E+00
+ .9748706279E+00 .9886733636E+00 .9961087232E+00 .9991028918E+00 .9998967304E+00
+ .2389925330E+00 .3626560178E+00 .4495273511E+00 .5175753158E+00 .5743730353E+00
+ .6237959987E+00 .6681065278E+00 .7087572963E+00 .7467517608E+00 .7828168461E+00
+ .8174693676E+00 .8509744293E+00 .8832373583E+00 .9136466765E+00 .9410018370E+00
+ .9637762352E+00 .9807141821E+00 .9915167618E+00 .9971307946E+00 .9993413678E+00
+ .9999235544E+00 .2358572111E+00 .3581753090E+00 .4440950439E+00 .5113714584E+00
+ .5674841085E+00 .6162590120E+00 .6599269020E+00 .6999165923E+00 .7372118058E+00
+ .7725258812E+00 .8063801798E+00 .8391093298E+00 .8707489052E+00 .9009718673E+00
+ .9288857842E+00 .9531630495E+00 .9724540028E+00 .9860094941E+00 .9941328885E+00
+ .9981012099E+00 .9995796613E+00 .9999524376E+00 .2327218892E+00 .3548885373E+00
+ .4399007223E+00 .5063262983E+00 .5616717641E+00 .6097343045E+00 .6527163551E+00
+ .6920234002E+00 .7286202206E+00 .7632073206E+00 .7963072910E+00 .8282870411E+00
+ .8593136825E+00 .8892427563E+00 .9174810019E+00 .9429440612E+00 .9642690284E+00
+ .9803291970E+00 .9908280292E+00 .9965513763E+00 .9990267018E+00 .9998177974E+00
+ .9999831114E+00 .2330224700E+00 .3542500804E+00 .4381708841E+00 .5034709281E+00
+ .5576729271E+00 .6045695590E+00 .6463527636E+00 .6844149818E+00 .7197066082E+00
+ .7529147250E+00 .7845571679E+00 .8150249600E+00 .8445776197E+00 .8732835821E+00
+ .9009092571E+00 .9268067259E+00 .9499151551E+00 .9690028772E+00 .9831509428E+00
+ .9922454869E+00 .9971213625E+00 .9991972784E+00 .9998513537E+00 .9999863509E+00
+ .2259484982E+00 .3442119778E+00 .4263445501E+00 .4903908128E+00 .5436355729E+00
+ .5897581229E+00 .6308872991E+00 .6683762861E+00 .7031488794E+00 .7358734739E+00
+ .7670570525E+00 .7970942299E+00 .8262800466E+00 .8547801641E+00 .8825498303E+00
+ .9092158896E+00 .9339899999E+00 .9557340634E+00 .9732726279E+00 .9858866730E+00
+ .9937142760E+00 .9977494958E+00 .9993964506E+00 .9998927699E+00 .9999905722E+00
+ .2287020159E+00 .3467863590E+00 .4281333057E+00 .4911599022E+00 .5432574528E+00
+ .5881420455E+00 .6279540989E+00 .6640468784E+00 .6973378027E+00 .7284847457E+00
+ .7579824691E+00 .7862178768E+00 .8134989466E+00 .8400585146E+00 .8660247565E+00
+ .8913491239E+00 .9157014848E+00 .9383880134E+00 .9583957654E+00 .9746533364E+00
+ .9864654026E+00 .9938905628E+00 .9977781219E+00 .9993934417E+00 .9998900826E+00
+ .9999901245E+00 .2222539261E+00 .3388217882E+00 .4197767511E+00 .4828606620E+00
+ .5352450713E+00 .5805527720E+00 .6208781498E+00 .6575495780E+00 .6914702818E+00
+ .7232897214E+00 .7534970827E+00 .7824735199E+00 .8105163326E+00 .8378350973E+00
+ .8645129750E+00 .8904312055E+00 .9151791726E+00 .9380127638E+00 .9579483582E+00
+ .9740379286E+00 .9857471894E+00 .9932318413E+00 .9973140122E+00 .9991493382E+00
+ .9997993275E+00 .9999687676E+00 .9999976014E+00 .2188088385E+00 .3336382129E+00
+ .4133865931E+00 .4755136743E+00 .5270798046E+00 .5716519043E+00 .6112914648E+00
+ .6473049758E+00 .6805795117E+00 .7117515390E+00 .7412994642E+00 .7695969407E+00
+ .7969420204E+00 .8235653936E+00 .8496130627E+00 .8750965208E+00 .8998136008E+00
+ .9232710744E+00 .9446757755E+00 .9630690866E+00 .9776192348E+00 .9879647500E+00
+ .9944111809E+00 .9978337324E+00 .9993304874E+00 .9998459489E+00 .9999766194E+00
+ .9999982491E+00 .2192208589E+00 .3337689209E+00 .4131503169E+00 .4748919425E+00
+ .5260660060E+00 .5702400533E+00 .6094730963E+00 .6450679778E+00 .6779074968E+00
+ .7086233195E+00 .7376885384E+00 .7654712949E+00 .7922652430E+00 .8183015628E+00
+ .8437398869E+00 .8686320883E+00 .8928582195E+00 .9160534394E+00 .9375747152E+00
+ .9565732967E+00 .9722084804E+00 .9839496197E+00 .9918183304E+00 .9964148214E+00
+ .9986935783E+00 .9996215461E+00 .9999185691E+00 .9999884634E+00 .9999991946E+00
+ .2179886631E+00 .3321001016E+00 .4111846978E+00 .4726733325E+00 .5236076540E+00
+ .5675412631E+00 .6065250027E+00 .6418557822E+00 .6744112759E+00 .7048181674E+00
+ .7335443467E+00 .7609525425E+00 .7873316053E+00 .8129111915E+00 .8378588902E+00
+ .8622549239E+00 .8860417419E+00 .9089589207E+00 .9304975687E+00 .9499287615E+00
+ .9664500172E+00 .9794341796E+00 .9886802028E+00 .9945243467E+00 .9977312352E+00
+ .9992205254E+00 .9997875748E+00 .9999570731E+00 .9999942953E+00 .9999996267E+00
+ .2172533451E+00 .3298693802E+00 .4084235894E+00 .4695398337E+00 .5201451645E+00
+ .5637633473E+00 .6024336779E+00 .6374467625E+00 .6696756446E+00 .6997428637E+00
+ .7281122770E+00 .7551282775E+00 .7810903540E+00 .8062324076E+00 .8307235150E+00
+ .8546587275E+00 .8780213950E+00 .9006308737E+00 .9220996625E+00 .9418372337E+00
+ .9591384217E+00 .9733357626E+00 .9840480992E+00 .9914082806E+00 .9959161928E+00
+ .9983283694E+00 .9994291163E+00 .9998443407E+00 .9999683230E+00 .9999957344E+00
+ .9999997156E+00 .2165180270E+00 .3282725846E+00 .4063241799E+00 .4670289348E+00
+ .5172627471E+00 .5605300912E+00 .5988598993E+00 .6335358511E+00 .6654256025E+00
+ .6951470219E+00 .7231595172E+00 .7498174296E+00 .7754021815E+00 .8001403310E+00
+ .8242092030E+00 .8477281627E+00 .8707323675E+00 .8930728737E+00 .9144743816E+00
+ .9344298074E+00 .9522923593E+00 .9674197918E+00 .9793662946E+00 .9880408879E+00
+ .9937515155E+00 .9971092892E+00 .9988424058E+00 .9996107021E+00 .9998947039E+00
+ .9999785852E+00 .9999970980E+00 .9999998041E+00 .2157827089E+00 .3272520848E+00
+ .4048263237E+00 .4650840518E+00 .5149076790E+00 .5577919904E+00 .5957566265E+00
+ .6300777846E+00 .6616170191E+00 .6909870067E+00 .7186425065E+00 .7449336063E+00
+ .7701146893E+00 .7944441071E+00 .8180970677E+00 .8411975530E+00 .8637963718E+00
+ .8858339822E+00 .9070966097E+00 .9271895361E+00 .9455578564E+00 .9615792708E+00
+ .9747199219E+00 .9846193511E+00 .9914689855E+00 .9957448914E+00 .9981217080E+00
+ .9992808983E+00 .9997677365E+00 .9999392466E+00 .9999879497E+00 .9999983931E+00
+ .9999998924E+00 .2150473908E+00 .3267570380E+00 .4038769497E+00 .4636552445E+00
+ .5130334397E+00 .5555053633E+00 .5930823516E+00 .6270326093E+00 .6582109563E+00
+ .6872243956E+00 .7145228084E+00 .7404519945E+00 .7652861134E+00 .7892473687E+00
+ .8125156955E+00 .8352277603E+00 .8574623447E+00 .8792098110E+00 .9003293840E+00
+ .9205101458E+00 .9392648980E+00 .9559883360E+00 .9700900132E+00 .9811698392E+00
+ .9891635226E+00 .9943822323E+00 .9974192802E+00 .9989693917E+00 .9996505130E+00
+ .9999023864E+00 .9999784824E+00 .9999964956E+00 .9999996256E+00 .9999999803E+00
+ .2059353022E+00 .3140837798E+00 .3891556159E+00 .4475634652E+00 .4959479695E+00
+ .5376633095E+00 .5746456033E+00 .6081183469E+00 .6389078084E+00 .6676018161E+00
+ .6946369526E+00 .7203496511E+00 .7450078141E+00 .7688308708E+00 .7920016067E+00
+ .8146701850E+00 .8369482602E+00 .8588895683E+00 .8804550479E+00 .9014677567E+00
+ .9215755689E+00 .9402518671E+00 .9568638527E+00 .9708139194E+00 .9817161707E+00
+ .9895335074E+00 .9946036343E+00 .9975345327E+00 .9990206668E+00 .9996695893E+00
+ .9999081527E+00 .9999798415E+00 .9999967297E+00 .9999996518E+00 .9999999818E+00
+ .2102814847E+00 .3198352173E+00 .3955255425E+00 .4542010976E+00 .5026547817E+00
+ .5443088401E+00 .5811342006E+00 .6143735011E+00 .6448637728E+00 .6731985256E+00
+ .6998166334E+00 .7250543864E+00 .7491775939E+00 .7724020113E+00 .7949058338E+00
+ .8168352182E+00 .8383015903E+00 .8593679942E+00 .8800224210E+00 .9001409093E+00
+ .9194528192E+00 .9375314278E+00 .9538359875E+00 .9678169103E+00 .9790633296E+00
+ .9874381440E+00 .9931361846E+00 .9966318175E+00 .9985388356E+00 .9994499315E+00
+ .9998243745E+00 .9999538512E+00 .9999904335E+00 .9999985350E+00 .9999998528E+00
+ .9999999927E+00 .2078590099E+00 .3160447042E+00 .3912201598E+00 .4495983542E+00
+ .4978460671E+00 .5393420660E+00 .5760374379E+00 .6091640143E+00 .6395521633E+00
+ .6677908226E+00 .6943154038E+00 .7194593712E+00 .7434860616E+00 .7666089418E+00
+ .7890041473E+00 .8108164507E+00 .8321578358E+00 .8530965612E+00 .8736350099E+00
+ .8936782888E+00 .9130029652E+00 .9312440091E+00 .9479215623E+00 .9625201934E+00
+ .9746100726E+00 .9839716846E+00 .9906718566E+00 .9950535187E+00 .9976409773E+00
+ .9990032213E+00 .9996334624E+00 .9998853043E+00 .9999703526E+00 .9999939306E+00
+ .9999990784E+00 .9999999078E+00 .9999999955E+00 .2054365352E+00 .3131968739E+00
+ .3878713407E+00 .4458652391E+00 .4938153788E+00 .5350723196E+00 .5715683729E+00
+ .6045229311E+00 .6347578130E+00 .6628557607E+00 .6892474331E+00 .7142624832E+00
+ .7381610812E+00 .7611540867E+00 .7834158936E+00 .8050913582E+00 .8262963445E+00
+ .8471099830E+00 .8675564086E+00 .8875760599E+00 .9069927329E+00 .9254913425E+00
+ .9426277689E+00 .9578885387E+00 .9707995789E+00 .9810550714E+00 .9886161133E+00
+ .9937327063E+00 .9968754875E+00 .9986075901E+00 .9994535164E+00 .9998144347E+00
+ .9999466837E+00 .9999874147E+00 .9999976594E+00 .9999996787E+00 .9999999711E+00
+ .9999999987E+00 .2047279880E+00 .3115476335E+00 .3853844678E+00 .4426249991E+00
+ .4898817847E+00 .5304878972E+00 .5663632225E+00 .5987179966E+00 .6283669474E+00
+ .6558870216E+00 .6817039328E+00 .7061429456E+00 .7294601984E+00 .7518628843E+00
+ .7735225209E+00 .7945831382E+00 .8151646791E+00 .8353605970E+00 .8552276568E+00
+ .8747663261E+00 .8938930794E+00 .9124119061E+00 .9299995880E+00 .9462231590E+00
+ .9606022931E+00 .9727116502E+00 .9822945400E+00 .9893438804E+00 .9941130265E+00
+ .9970486304E+00 .9986742751E+00 .9994742394E+00 .9998191360E+00 .9999472163E+00
+ .9999873110E+00 .9999975904E+00 .9999996614E+00 .9999999687E+00 .9999999986E+00
+ .2036434490E+00 .3090528796E+00 .3823924716E+00 .4393057268E+00 .4862910816E+00
+ .5266497547E+00 .5622726291E+00 .5943542542E+00 .6237478291E+00 .6510212911E+00
+ .6765943765E+00 .7007878786E+00 .7238460903E+00 .7459790578E+00 .7673619426E+00
+ .7881359319E+00 .8084196986E+00 .8283089018E+00 .8478656634E+00 .8671132116E+00
+ .8860035863E+00 .9043953942E+00 .9220362596E+00 .9385614011E+00 .9535100819E+00
+ .9664821070E+00 .9771607025E+00 .9854185873E+00 .9913594095E+00 .9952883895E+00
+ .9976579281E+00 .9989537087E+00 .9995860417E+00 .9998575185E+00 .9999582951E+00
+ .9999898806E+00 .9999980509E+00 .9999997214E+00 .9999999738E+00 .9999999988E+00
+ .2025589101E+00 .3068199167E+00 .3796796368E+00 .4362546669E+00 .4829553544E+00
+ .5230556714E+00 .5584510741E+00 .5903261603E+00 .6194537052E+00 .6464727776E+00
+ .6717968661E+00 .6957421660E+00 .7185576503E+00 .7404443259E+00 .7615627499E+00
+ .7820512935E+00 .8020407327E+00 .8216284368E+00 .8408882860E+00 .8598603362E+00
+ .8785341655E+00 .8968045807E+00 .9144586051E+00 .9312006420E+00 .9466376182E+00
+ .9603507600E+00 .9719797967E+00 .9813098403E+00 .9882922262E+00 .9931674699E+00
+ .9963229616E+00 .9981938161E+00 .9991999038E+00 .9996849939E+00 .9998917560E+00
+ .9999679669E+00 .9999921186E+00 .9999984579E+00 .9999997754E+00 .9999999784E+00
+ .9999999990E+00 .2014743712E+00 .3048300056E+00 .3772260208E+00 .4334526630E+00
+ .4798563876E+00 .5196881873E+00 .5548323000E+00 .5864793476E+00 .6154312962E+00
+ .6422187655E+00 .6672890779E+00 .6909837542E+00 .7135480056E+00 .7351797627E+00
+ .7560424139E+00 .7762468800E+00 .7959481935E+00 .8152411211E+00 .8341985372E+00
+ .8528776889E+00 .8712819219E+00 .8893513536E+00 .9069421043E+00 .9238135412E+00
+ .9396343066E+00 .9540158863E+00 .9665053929E+00 .9768523172E+00 .9849523917E+00
+ .9907806770E+00 .9947396993E+00 .9972268018E+00 .9986615385E+00 .9994152318E+00
+ .9997706700E+00 .9999202414E+00 .9999761410E+00 .9999940485E+00 .9999988150E+00
+ .9999998240E+00 .9999999827E+00 .9999999992E+00 .2003898323E+00 .3030662043E+00
+ .3750135367E+00 .4308823405E+00 .4769776603E+00 .5165315196E+00 .5514174775E+00
+ .5828193721E+00 .6115344031E+00 .6381266141E+00 .6630110903E+00 .6864765489E+00
+ .7087401773E+00 .7300883907E+00 .7506770841E+00 .7706383244E+00 .7900854117E+00
+ .8091152669E+00 .8278078049E+00 .8462210790E+00 .8643812651E+00 .8822669662E+00
+ .8997629202E+00 .9166533781E+00 .9326611343E+00 .9474241091E+00 .9605662436E+00
+ .9717692962E+00 .9808432589E+00 .9877725431E+00 .9927218871E+00 .9960000069E+00
+ .9979937937E+00 .9990548088E+00 .9995885193E+00 .9998383077E+00 .9999436407E+00
+ .9999829842E+00 .9999956918E+00 .9999991259E+00 .9999998674E+00 .9999999867E+00
+ .9999999993E+00 .1993052933E+00 .3015130984E+00 .3730257567E+00 .4285279012E+00
+ .4743041728E+00 .5135712827E+00 .5481926980E+00 .5793453267E+00 .6078214449E+00
+ .6341631957E+00 .6587500812E+00 .6819730622E+00 .7040686618E+00 .7252283524E+00
+ .7456103376E+00 .7653414118E+00 .7845339051E+00 .8033002560E+00 .8217159455E+00
+ .8398455813E+00 .8577347704E+00 .8753752899E+00 .8926991209E+00 .9095608193E+00
+ .9257282784E+00 .9408907550E+00 .9546904641E+00 .9667193405E+00 .9767051192E+00
+ .9845755604E+00 .9903643461E+00 .9943588012E+00 .9969349772E+00 .9984694740E+00
+ .9993058998E+00 .9997182876E+00 .9998921295E+00 .9999624746E+00 .9999885872E+00
+ .9999970681E+00 .9999993936E+00 .9999999060E+00 .9999999903E+00 .9999999995E+00
+ .1982207544E+00 .3001566526E+00 .3712476853E+00 .4263749393E+00 .4718222223E+00
+ .5107943968E+00 .5451452858E+00 .5760448313E+00 .6042350363E+00 .6303011604E+00
+ .6546944367E+00 .6777163937E+00 .6996046447E+00 .7205507063E+00 .7407123251E+00
+ .7602219435E+00 .7791728067E+00 .7976907996E+00 .8158578385E+00 .8337406543E+00
+ .8513850014E+00 .8688052904E+00 .8859694358E+00 .9027618185E+00 .9189764575E+00
+ .9343464473E+00 .9485329999E+00 .9611864557E+00 .9720106107E+00 .9808256977E+00
+ .9876102435E+00 .9924320985E+00 .9956757557E+00 .9977048387E+00 .9988781204E+00
+ .9995004434E+00 .9998001556E+00 .9999294432E+00 .9999770468E+00 .9999930327E+00
+ .9999981951E+00 .9999996210E+00 .9999999401E+00 .9999999937E+00 .9999999997E+00
+ .1971362155E+00 .2989840214E+00 .3696656554E+00 .4244103452E+00 .4695193307E+00
+ .5081888756E+00 .5422636811E+00 .5728778573E+00 .6008257641E+00 .6266958830E+00
+ .6508862626E+00 .6737007641E+00 .6953776394E+00 .7161082476E+00 .7360348306E+00
+ .7553074502E+00 .7740398841E+00 .7923279877E+00 .8102546643E+00 .8278893538E+00
+ .8452822126E+00 .8624571568E+00 .8794031462E+00 .8960468881E+00 .9122421439E+00
+ .9277625079E+00 .9423107327E+00 .9555247606E+00 .9670812891E+00 .9767475749E+00
+ .9844219124E+00 .9901661351E+00 .9941924818E+00 .9968118786E+00 .9983668441E+00
+ .9992300584E+00 .9996690493E+00 .9998718724E+00 .9999560393E+00 .9999869182E+00
+ .9999963961E+00 .9999990892E+00 .9999998107E+00 .9999999701E+00 .9999999969E+00
+ .9999999998E+00 .1960516766E+00 .2979834712E+00 .3682671506E+00 .4226220644E+00
+ .4673840643E+00 .5057438090E+00 .5395372906E+00 .5699201602E+00 .5976686719E+00
+ .6233309695E+00 .6473098007E+00 .6699107941E+00 .6913725039E+00 .7118859482E+00
+ .7316075454E+00 .7506679701E+00 .7691784774E+00 .7872353014E+00 .8049221922E+00
+ .8223108367E+00 .8394584676E+00 .8564015746E+00 .8731448163E+00 .8896454590E+00
+ .9057960845E+00 .9214114582E+00 .9362279031E+00 .9499231463E+00 .9621597258E+00
+ .9726460827E+00 .9811998420E+00 .9877927992E+00 .9925608538E+00 .9957742686E+00
+ .9977787124E+00 .9989278736E+00 .9995289127E+00 .9998133749E+00 .9999340856E+00
+ .9999795210E+00 .9999944950E+00 .9999987467E+00 .9999997652E+00 .9999999653E+00
+ .9999999962E+00 .9999999997E+00 .1000000000E+01 .1955208940E+00 .2968454942E+00
+ .3669506250E+00 .4212130582E+00 .4659146780E+00 .5042306152E+00 .5379906074E+00
+ .5683472335E+00 .5960750236E+00 .6217209419E+00 .6456869070E+00 .6682780443E+00
+ .6897325357E+00 .7102410288E+00 .7299596441E+00 .7490188743E+00 .7675298242E+00
+ .7855885178E+00 .8032783857E+00 .8206705915E+00 .8378214803E+00 .8547661768E+00
+ .8715076341E+00 .8880016810E+00 .9041409572E+00 .9197434848E+00 .9345535699E+00
+ .9482618954E+00 .9605468169E+00 .9711307900E+00 .9798377567E+00 .9866336396E+00
+ .9916358389E+00 .9950880632E+00 .9973092743E+00 .9986339904E+00 .9993618550E+00
+ .9997278538E+00 .9998950180E+00 .9999637633E+00 .9999889543E+00 .9999970751E+00
+ .9999993414E+00 .9999998775E+00 .9999999819E+00 .9999999980E+00 .9999999999E+00
+ .1000000000E+01 .1949901115E+00 .2963741383E+00 .3663081222E+00 .4204152539E+00
+ .4649909350E+00 .5032052156E+00 .5368821357E+00 .5671699260E+00 .5948399780E+00
+ .6204368735E+00 .6443607227E+00 .6669153488E+00 .6883379232E+00 .7088182102E+00
+ .7285115903E+00 .7475479961E+00 .7660381247E+00 .7840777706E+00 .8017504919E+00
+ .8191282821E+00 .8362695098E+00 .8532131003E+00 .8699680444E+00 .8864983572E+00
+ .9027058779E+00 .9184164075E+00 .9333772607E+00 .9472742765E+00 .9597719517E+00
+ .9705718849E+00 .9794752552E+00 .9864296805E+00 .9915436175E+00 .9950624820E+00
+ .9973149888E+00 .9986486289E+00 .9993746747E+00 .9997358772E+00 .9998989844E+00
+ .9999653363E+00 .9999894415E+00 .9999971821E+00 .9999993516E+00 .9999998740E+00
+ .9999999799E+00 .9999999975E+00 .9999999998E+00 .1000000000E+01 .1000000000E+01
+ .1883070435E+00 .2870917914E+00 .3554878960E+00 .4085214986E+00 .4522767946E+00
+ .4898265524E+00 .5229425196E+00 .5527418351E+00 .5799757929E+00 .6051751313E+00
+ .6287301379E+00 .6509373447E+00 .6720281017E+00 .6921873640E+00 .7115665386E+00
+ .7302921760E+00 .7484719881E+00 .7661993118E+00 .7835563850E+00 .8006163141E+00
+ .8174434277E+00 .8340914176E+00 .8505982519E+00 .8669767775E+00 .8832007044E+00
+ .8991875820E+00 .9147832533E+00 .9297551047E+00 .9438023688E+00 .9565888473E+00
+ .9677961791E+00 .9771863398E+00 .9846549763E+00 .9902571315E+00 .9941954536E+00
+ .9967747816E+00 .9983392720E+00 .9992128464E+00 .9996590659E+00 .9998661524E+00
+ .9999528079E+00 .9999852174E+00 .9999959394E+00 .9999990376E+00 .9999998073E+00
+ .9999999683E+00 .9999999959E+00 .9999999996E+00 .1000000000E+01 .1000000000E+01
+ .1906928381E+00 .2902208128E+00 .3589764014E+00 .4122121033E+00 .4560872146E+00
+ .4937073201E+00 .5268608959E+00 .5566744570E+00 .5839051255E+00 .6090874123E+00
+ .6326139050E+00 .6547826422E+00 .6758261284E+00 .6959300748E+00 .7152462082E+00
+ .7339011523E+00 .7520025808E+00 .7696436147E+00 .7869059721E+00 .8038618310E+00
+ .8205740187E+00 .8370938604E+00 .8534557634E+00 .8696676781E+00 .8856974492E+00
+ .9014569876E+00 .9167888709E+00 .9314623296E+00 .9451858916E+00 .9576406946E+00
+ .9685315404E+00 .9776444363E+00 .9848937445E+00 .9903429512E+00 .9941912921E+00
+ .9967307227E+00 .9982881040E+00 .9991710028E+00 .9996311121E+00 .9998502193E+00
+ .9999449413E+00 .9999818412E+00 .9999946835E+00 .9999986359E+00 .9999996982E+00
+ .9999999436E+00 .9999999913E+00 .9999999990E+00 .9999999999E+00 .1000000000E+01
+ .1000000000E+01 .1912676070E+00 .2908349045E+00 .3595285316E+00 .4126676486E+00
+ .4564305398E+00 .4939298269E+00 .5269569243E+00 .5566395473E+00 .5837352720E+00
+ .6087787015E+00 .6321622017E+00 .6541833965E+00 .6750743308E+00 .6950201801E+00
+ .7141719793E+00 .7326555349E+00 .7505776382E+00 .7680304665E+00 .7850947483E+00
+ .8018417760E+00 .8183339554E+00 .8346233137E+00 .8507471511E+00 .8667199947E+00
+ .8825216172E+00 .8980824134E+00 .9132697651E+00 .9278813631E+00 .9416523620E+00
+ .9542811936E+00 .9654733529E+00 .9749949343E+00 .9827214777E+00 .9886664936E+00
+ .9929795874E+00 .9959145408E+00 .9977782619E+00 .9988771250E+00 .9994756273E+00
+ .9997751408E+00 .9999120646E+00 .9999688797E+00 .9999901217E+00 .9999972171E+00
+ .9999993130E+00 .9999998538E+00 .9999999737E+00 .9999999961E+00 .9999999995E+00
+ .1000000000E+01 .1000000000E+01 .1000000000E+01 .1925827137E+00 .2924402082E+00
+ .3612013543E+00 .4143222274E+00 .4580240722E+00 .4954372347E+00 .5283616606E+00
+ .5579295073E+00 .5849007860E+00 .6098115079E+00 .6330547631E+00 .6549284096E+00
+ .6756644705E+00 .6954479363E+00 .7144294476E+00 .7327342085E+00 .7504682706E+00
+ .7677229696E+00 .7845780993E+00 .8011040085E+00 .8173623988E+00 .8334053190E+00
+ .8492716280E+00 .8649801420E+00 .8805191079E+00 .8958328748E+00 .9108086535E+00
+ .9252684582E+00 .9389725270E+00 .9516393016E+00 .9629827075E+00 .9727608606E+00
+ .9808241111E+00 .9871478863E+00 .9918392532E+00 .9951146830E+00 .9972564686E+00
+ .9985619421E+00 .9993001631E+00 .9996855610E+00 .9998703543E+00 .9999512760E+00
+ .9999834351E+00 .9999949503E+00 .9999986340E+00 .9999996763E+00 .9999999338E+00
+ .9999999886E+00 .9999999984E+00 .9999999998E+00 .1000000000E+01 .1000000000E+01
+ .1000000000E+01 .1909929133E+00 .2899185882E+00 .3579477117E+00 .4104320701E+00
+ .4535516556E+00 .4904157593E+00 .5228117616E+00 .5518635811E+00 .5783253571E+00
+ .6027284510E+00 .6254621313E+00 .6468210978E+00 .6670345094E+00 .6862845012E+00
+ .7047188727E+00 .7224600407E+00 .7396112131E+00 .7562607261E+00 .7724853371E+00
+ .7883527613E+00 .8039233933E+00 .8192510814E+00 .8343826971E+00 .8493559438E+00
+ .8641946082E+00 .8789005761E+00 .8934426702E+00 .9077438281E+00 .9216701353E+00
+ .9350270238E+00 .9475683175E+00 .9590215772E+00 .9691281800E+00 .9776902091E+00
+ .9846114213E+00 .9899192445E+00 .9937600382E+00 .9963689010E+00 .9980240233E+00
+ .9989998954E+00 .9995319138E+00 .9997986632E+00 .9999209574E+00 .9999718948E+00
+ .9999910293E+00 .9999974567E+00 .9999993677E+00 .9999998643E+00 .9999999754E+00
+ .9999999963E+00 .9999999996E+00 .1000000000E+01 .1000000000E+01 .1000000000E+01
+ .1886998981E+00 .2869838669E+00 .3548078557E+00 .4072784191E+00 .4504896905E+00
+ .4875124689E+00 .5201143455E+00 .5494079717E+00 .5761407293E+00 .6008401063E+00
+ .6238930937E+00 .6455928970E+00 .6661679793E+00 .6858006147E+00 .7046392112E+00
+ .7228070051E+00 .7404083440E+00 .7575331524E+00 .7742600996E+00 .7906588184E+00
+ .8067911415E+00 .8227109732E+00 .8384621922E+00 .8540738547E+00 .8695521044E+00
+ .8848688827E+00 .8999489731E+00 .9146588802E+00 .9288027685E+00 .9421310094E+00
+ .9543647295E+00 .9652349919E+00 .9745292217E+00 .9821328462E+00 .9880535623E+00
+ .9924202344E+00 .9954566632E+00 .9974387515E+00 .9986482183E+00 .9993351976E+00
+ .9996968517E+00 .9998725083E+00 .9999508367E+00 .9999827295E+00 .9999945141E+00
+ .9999984379E+00 .9999996054E+00 .9999999127E+00 .9999999833E+00 .9999999973E+00
+ .9999999996E+00 .1000000000E+01 .1000000000E+01 .1000000000E+01 .1000000000E+01
+ .5697614876E+00 .4276250300E+00 .7177325737E+00 .3545906286E+00 .5703467898E+00
+ .7686532633E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .3326349646E+00 .5189542657E+00 .6618018412E+00 .7905547689E+00 .9131727737E+00
+ .3074456896E+00 .4761358366E+00 .6015919660E+00 .7101546182E+00 .8150814079E+00
+ .9205625798E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .0000000000E+00 .0000000000E+00 .0000000000E+00 .2852661271E+00 .4387806273E+00
+ .5491237102E+00 .6397109446E+00 .7208181864E+00 .7988056799E+00 .8775746579E+00
+ .9526526750E+00 .2737275734E+00 .4198543592E+00 .5238404887E+00 .6080074243E+00
+ .6818142565E+00 .7507648975E+00 .8190480396E+00 .8893814784E+00 .9571101916E+00
+ .2648934564E+00 .4054955855E+00 .5047880768E+00 .5843286061E+00 .6530700094E+00
+ .7159410236E+00 .7764339993E+00 .8375954184E+00 .9012339731E+00 .9621873931E+00
+ .2591017873E+00 .3962542853E+00 .4925232584E+00 .5690329231E+00 .6344540236E+00
+ .6934024466E+00 .7489152040E+00 .8034672391E+00 .8592732789E+00 .9168783702E+00
+ .9697412653E+00 .2523402987E+00 .3853885350E+00 .4783257220E+00 .5517338523E+00
+ .6140006623E+00 .6695036954E+00 .7209915706E+00 .7705407942E+00 .8200480903E+00
+ .8712829015E+00 .9243702583E+00 .9727517349E+00 .2488626608E+00 .3801868901E+00
+ .4715468901E+00 .5433448073E+00 .6038583442E+00 .6573542705E+00 .7064337474E+00
+ .7529463721E+00 .7984425305E+00 .8443897307E+00 .8918549805E+00 .9395478726E+00
+ .9798534496E+00 .2451052290E+00 .3746245925E+00 .4644260812E+00 .5347069442E+00
+ .5936391385E+00 .6454011967E+00 .6924935406E+00 .7366264778E+00 .7791434390E+00
+ .8212564152E+00 .8640821028E+00 .9080489575E+00 .9508276217E+00 .9846538467E+00
+ .2422394809E+00 .3710466507E+00 .4601063889E+00 .5295624621E+00 .5875564659E+00
+ .6382288141E+00 .6840269753E+00 .7265829678E+00 .7671198986E+00 .8066723476E+00
+ .8461827458E+00 .8863234010E+00 .9265906732E+00 .9634461052E+00 .9896754775E+00
+ .2371212589E+00 .3625404560E+00 .4490435729E+00 .5163128728E+00 .5722875201E+00
+ .6209899877E+00 .6647786020E+00 .7051997609E+00 .7433771533E+00 .7802215802E+00
+ .8165620067E+00 .8532039524E+00 .8907600579E+00 .9288121320E+00 .9641069635E+00
+ .9896893771E+00 .2339608780E+00 .3582147911E+00 .4437396107E+00 .5100792902E+00
+ .5651153614E+00 .6128302984E+00 .6555454504E+00 .6947653240E+00 .7315593358E+00
+ .7667620373E+00 .8010945188E+00 .8352400464E+00 .8698327557E+00 .9051613257E+00
+ .9402264047E+00 .9713042135E+00 .9922817729E+00 .2313207825E+00 .3561509659E+00
+ .4419565680E+00 .5083637861E+00 .5633116157E+00 .6108038183E+00 .6531643134E+00
+ .6918868701E+00 .7280170016E+00 .7623486677E+00 .7955385000E+00 .8281741326E+00
+ .8607822764E+00 .8936761052E+00 .9264433168E+00 .9570474044E+00 .9814435496E+00
+ .9956391489E+00 .2275734012E+00 .3461419563E+00 .4283969887E+00 .4926093997E+00
+ .5461446688E+00 .5927286451E+00 .6345305616E+00 .6729486357E+00 .7089633409E+00
+ .7433188289E+00 .7766270434E+00 .8094287898E+00 .8422048397E+00 .8752714883E+00
+ .9084312988E+00 .9403317177E+00 .9679848724E+00 .9876199054E+00 .9974580416E+00
+ .2208378062E+00 .3357279301E+00 .4153829023E+00 .4775132582E+00 .5292512180E+00
+ .5742001002E+00 .6144526027E+00 .6513511387E+00 .6858287667E+00 .7185831767E+00
+ .7501760381E+00 .7810964521E+00 .8118031476E+00 .8427351662E+00 .8742318145E+00
+ .9062290366E+00 .9376231925E+00 .9656230577E+00 .9862578431E+00 .9970658450E+00
+ .2179952765E+00 .3304040462E+00 .4091395796E+00 .4706409685E+00 .5218301078E+00
+ .5662446971E+00 .6059459270E+00 .6422542931E+00 .6760825172E+00 .7081054369E+00
+ .7388560519E+00 .7687801043E+00 .7983011163E+00 .8278140590E+00 .8576483946E+00
+ .8879259721E+00 .9182078185E+00 .9470027644E+00 .9715860391E+00 .9888948248E+00
+ .9976532006E+00 .2151527468E+00 .3263365979E+00 .4042002635E+00 .4649913033E+00
+ .5155477836E+00 .5593632537E+00 .5984708369E+00 .6341695554E+00 .6673527897E+00
+ .6986753135E+00 .7286467801E+00 .7576892719E+00 .7861688110E+00 .8144667110E+00
+ .8429050067E+00 .8717128680E+00 .9008198865E+00 .9294748924E+00 .9558760724E+00
+ .9773494548E+00 .9915663595E+00 .9983001949E+00 .2123102172E+00 .3233617084E+00
+ .4003948641E+00 .4604048024E+00 .5102557065E+00 .5534157057E+00 .5918927779E+00
+ .6269648948E+00 .6595069936E+00 .6901561343E+00 .7194033725E+00 .7476495768E+00
+ .7752422009E+00 .8025006589E+00 .8297287918E+00 .8571959870E+00 .8850392903E+00
+ .9130179895E+00 .9401229839E+00 .9643091050E+00 .9829392993E+00 .9942679612E+00
+ .9989990476E+00 .2130285612E+00 .3234869368E+00 .3997330291E+00 .4589012394E+00
+ .5078836266E+00 .5501514430E+00 .5877080566E+00 .6218233871E+00 .6533619600E+00
+ .6829480523E+00 .7110569234E+00 .7380696227E+00 .7643084713E+00 .7900619102E+00
+ .8156020656E+00 .8411906440E+00 .8670533563E+00 .8932773321E+00 .9195733209E+00
+ .9449221229E+00 .9673711282E+00 .9845060497E+00 .9948278346E+00 .9991018528E+00
+ .2066923036E+00 .3144671088E+00 .3890707816E+00 .4470665939E+00 .4951346044E+00
+ .5366448101E+00 .5735440164E+00 .6070664384E+00 .6380516318E+00 .6671046908E+00
+ .6946843672E+00 .7211559415E+00 .7468252881E+00 .7719623561E+00 .7968188548E+00
+ .8216405059E+00 .8466662501E+00 .8720903677E+00 .8979389241E+00 .9238113264E+00
+ .9485411972E+00 .9700854670E+00 .9861348625E+00 .9955056972E+00 .9992457743E+00
+ .2097269301E+00 .3176839229E+00 .3918638408E+00 .4492013700E+00 .4964873614E+00
+ .5371332816E+00 .5731021737E+00 .6056330813E+00 .6355642071E+00 .6634951414E+00
+ .6898755720E+00 .7150581724E+00 .7393321738E+00 .7629457438E+00 .7861226085E+00
+ .8090754685E+00 .8320157123E+00 .8551536831E+00 .8786698745E+00 .9026140940E+00
+ .9266809544E+00 .9498865807E+00 .9703989075E+00 .9859980465E+00 .9953477644E+00
+ .9991964744E+00 .2033133364E+00 .3095355366E+00 .3830575855E+00 .4401680397E+00
+ .4874448799E+00 .5282073522E+00 .5643716711E+00 .5971506478E+00 .6273661159E+00
+ .6556065882E+00 .6823140157E+00 .7078348260E+00 .7324524191E+00 .7564091871E+00
+ .7799221761E+00 .8031948608E+00 .8264244296E+00 .8497978845E+00 .8734590638E+00
+ .8974144228E+00 .9213491771E+00 .9443921210E+00 .9650177307E+00 .9813886415E+00
+ .9922369072E+00 .9977685038E+00 .9996718685E+00 .2003340164E+00 .3050561279E+00
+ .3775380724E+00 .4338241437E+00 .4803962780E+00 .5205255470E+00 .5560999165E+00
+ .5883136433E+00 .6179748856E+00 .6456609581E+00 .6718039528E+00 .6967407325E+00
+ .7207445077E+00 .7440462990E+00 .7668499467E+00 .7893433810E+00 .8117074345E+00
+ .8341200930E+00 .8567480867E+00 .8797066523E+00 .9029564206E+00 .9261175300E+00
+ .9482561005E+00 .9678406185E+00 .9831397964E+00 .9930854114E+00 .9980493106E+00
+ .9997188614E+00 .2008785745E+00 .3054140922E+00 .3776045153E+00 .4335705203E+00
+ .4798104839E+00 .5195988091E+00 .5548226698E+00 .5866740635E+00 .6159583043E+00
+ .6432490335E+00 .6689739013E+00 .6934647582E+00 .7169887572E+00 .7397693301E+00
+ .7620009689E+00 .7838599673E+00 .8055127388E+00 .8271212458E+00 .8488410141E+00
+ .8707999707E+00 .8930362146E+00 .9153711142E+00 .9372283466E+00 .9575019420E+00
+ .9746796310E+00 .9873791493E+00 .9951160406E+00 .9987083247E+00 .9998264043E+00
+ .1996539731E+00 .3037628949E+00 .3756703964E+00 .4314009246E+00 .4774224833E+00
+ .5169959497E+00 .5520007915E+00 .5836236022E+00 .6126655061E+00 .6396962708E+00
+ .6651393247E+00 .6893219609E+00 .7125062210E+00 .7349092880E+00 .7567179347E+00
+ .7780989726E+00 .7992071014E+00 .8201906055E+00 .8411926352E+00 .8623409692E+00
+ .8837116282E+00 .9052459519E+00 .9266130191E+00 .9470620744E+00 .9653970556E+00
+ .9802434583E+00 .9906297415E+00 .9965712383E+00 .9991469986E+00 .9998926121E+00
+ .1991050041E+00 .3018965043E+00 .3733507338E+00 .4287625409E+00 .4744993867E+00
+ .5137970741E+00 .5485258358E+00 .5798672990E+00 .6086189517E+00 .6353474250E+00
+ .6604729117E+00 .6843049979E+00 .7071152591E+00 .7291226351E+00 .7505067848E+00
+ .7714263451E+00 .7920266786E+00 .8124449908E+00 .8328130339E+00 .8532521680E+00
+ .8738523351E+00 .8946196453E+00 .9153693257E+00 .9356167655E+00 .9545089234E+00
+ .9709127461E+00 .9837398324E+00 .9924227052E+00 .9972593555E+00 .9993206890E+00
+ .9999140126E+00 .1985560350E+00 .3006106401E+00 .3716362071E+00 .4266931456E+00
+ .4721063566E+00 .5110960932E+00 .5455243575E+00 .5765672106E+00 .6050177616E+00
+ .6314389517E+00 .6562473641E+00 .6797627426E+00 .7022389088E+00 .7238836914E+00
+ .7448725401E+00 .7653584935E+00 .7854795997E+00 .8053578312E+00 .8251381562E+00
+ .8449363319E+00 .8648493087E+00 .8849207854E+00 .9050732193E+00 .9250087591E+00
+ .9441180982E+00 .9614810981E+00 .9760470150E+00 .9869933125E+00 .9941041460E+00
+ .9979167629E+00 .9994920787E+00 .9999362113E+00 .1980070659E+00 .2998525269E+00
+ .3704718120E+00 .4251410273E+00 .4701952152E+00 .5088477531E+00 .5429533215E+00
+ .5736818802E+00 .6018214608E+00 .6279307744E+00 .6524226150E+00 .6756129742E+00
+ .6977291636E+00 .7190076159E+00 .7396173208E+00 .7597051140E+00 .7794025869E+00
+ .7988315202E+00 .8181072953E+00 .8373401836E+00 .8566297794E+00 .8760466654E+00
+ .8955903217E+00 .9151136460E+00 .9342081810E+00 .9521626886E+00 .9680217695E+00
+ .9808345352E+00 .9900259498E+00 .9956842018E+00 .9985462553E+00 .9996613750E+00
+ .9999591353E+00 .1974580969E+00 .2995756048E+00 .3698090140E+00 .4240605457E+00
+ .4687234520E+00 .5070121226E+00 .5407747541E+00 .5711747140E+00 .5989943363E+00
+ .6247876018E+00 .6489633101E+00 .6718337136E+00 .6936451655E+00 .7145980005E+00
+ .7348596451E+00 .7545740064E+00 .7738686529E+00 .7928602268E+00 .8116584417E+00
+ .8303684800E+00 .8490897999E+00 .8679063820E+00 .8868597811E+00 .9058949570E+00
+ .9247773601E+00 .9430064594E+00 .9597908399E+00 .9741690223E+00 .9853059040E+00
+ .9928572484E+00 .9971718189E+00 .9991502971E+00 .9998287657E+00 .9999827209E+00
+ .1891286131E+00 .2879808978E+00 .3563234313E+00 .4092958822E+00 .4530171995E+00
+ .4905744323E+00 .5237472443E+00 .5536579505E+00 .5810622661E+00 .6064963356E+00
+ .6303563630E+00 .6529448251E+00 .6745003399E+00 .6952172787E+00 .7152580925E+00
+ .7347620087E+00 .7538521435E+00 .7726409988E+00 .7912344634E+00 .8097349744E+00
+ .8282434669E+00 .8468576459E+00 .8656612749E+00 .8846955498E+00 .9039022332E+00
+ .9230371482E+00 .9415802630E+00 .9587094998E+00 .9734246202E+00 .9848519095E+00
+ .9926198894E+00 .9970702335E+00 .9991171206E+00 .9998214583E+00 .9999819113E+00
+ .1931814080E+00 .2933861012E+00 .3623598846E+00 .4156449504E+00 .4595014272E+00
+ .4970798968E+00 .5301928046E+00 .5599812366E+00 .5872120622E+00 .6124276564E+00
+ .6360278467E+00 .6583172156E+00 .6795347221E+00 .6998735022E+00 .7194938612E+00
+ .7385319897E+00 .7571066251E+00 .7753243627E+00 .7932836392E+00 .8110777215E+00
+ .8287967300E+00 .8465273614E+00 .8643468813E+00 .8823052071E+00 .9003868308E+00
+ .9184477683E+00 .9361385684E+00 .9528538530E+00 .9677748242E+00 .9800564456E+00
+ .9891278685E+00 .9949585744E+00 .9981030374E+00 .9994600195E+00 .9998971325E+00
+ .9999902033E+00 .1909013154E+00 .2898128230E+00 .3582834293E+00 .4112665812E+00
+ .4549054666E+00 .4923103191E+00 .5252750549E+00 .5549307085E+00 .5820380526E+00
+ .6071350865E+00 .6306182632E+00 .6527896879E+00 .6738861668E+00 .6940985228E+00
+ .7135847304E+00 .7324787374E+00 .7508968056E+00 .7689425503E+00 .7867109234E+00
+ .8042911872E+00 .8217689021E+00 .8392261731E+00 .8567377685E+00 .8743585815E+00
+ .8920961461E+00 .9098633528E+00 .9274157922E+00 .9442976452E+00 .9598420722E+00
+ .9732746951E+00 .9839277423E+00 .9914917250E+00 .9961659814E+00 .9985950680E+00
+ .9996092298E+00 .9999269459E+00 .9999931380E+00 .1886212228E+00 .2871104433E+00
+ .3550918940E+00 .4076946576E+00 .4510335626E+00 .4881925164E+00 .5209478508E+00
+ .5504190609E+00 .5773591246E+00 .6023001979E+00 .6256342133E+00 .6476599296E+00
+ .6686113468E+00 .6886765032E+00 .7080107052E+00 .7267454283E+00 .7449943638E+00
+ .7628581881E+00 .7804285342E+00 .7977910285E+00 .8150274319E+00 .8322166787E+00
+ .8494333733E+00 .8667404135E+00 .8841703510E+00 .9016894366E+00 .9191428352E+00
+ .9361935080E+00 .9522892885E+00 .9667081589E+00 .9787151965E+00 .9878019370E+00
+ .9938987308E+00 .9974249814E+00 .9991240848E+00 .9997758439E+00 .9999617791E+00
+ .9999967532E+00 .1883041310E+00 .2861018757E+00 .3534398803E+00 .4054550417E+00
+ .4482495149E+00 .4848958580E+00 .5171617692E+00 .5461602173E+00 .5726389223E+00
+ .5971256626E+00 .6200087881E+00 .6415839485E+00 .6620821007E+00 .6816882317E+00
+ .7005547096E+00 .7188100861E+00 .7365648495E+00 .7539160383E+00 .7709512414E+00
+ .7877516330E+00 .8043941304E+00 .8209529984E+00 .8375004344E+00 .8541043670E+00
+ .8708202109E+00 .8876717453E+00 .9046161289E+00 .9214928279E+00 .9379691682E+00
+ .9535141449E+00 .9674441331E+00 .9790682317E+00 .9879062683E+00 .9938833152E+00
+ .9973808427E+00 .9990927911E+00 .9997626915E+00 .9999584789E+00 .9999963666E+00
+ .1873815005E+00 .2839227321E+00 .3508335708E+00 .4025718411E+00 .4451373786E+00
+ .4815749521E+00 .5136262518E+00 .5423900148E+00 .5686504013E+00 .5929273709E+00
+ .6156039260E+00 .6369718433E+00 .6572512078E+00 .6766301012E+00 .6952646288E+00
+ .7132802609E+00 .7307847255E+00 .7478722523E+00 .7646238875E+00 .7811219100E+00
+ .7974398355E+00 .8136475503E+00 .8298128824E+00 .8460011174E+00 .8622720216E+00
+ .8786618721E+00 .8951643999E+00 .9116925211E+00 .9280320268E+00 .9437925493E+00
+ .9584110843E+00 .9712603705E+00 .9817655472E+00 .9895958806E+00 .9947981471E+00
+ .9977855163E+00 .9992326688E+00 .9997981717E+00 .9999643049E+00 .9999968265E+00
+ .1864588701E+00 .2819837023E+00 .3484823568E+00 .3999329083E+00 .4422567239E+00
+ .4784749339E+00 .5103344772E+00 .5389254943E+00 .5649574192E+00 .5890171139E+00
+ .6114819890E+00 .6326397515E+00 .6527159007E+00 .6718907699E+00 .6903059832E+00
+ .7080829805E+00 .7253404622E+00 .7421699757E+00 .7586530038E+00 .7748636649E+00
+ .7908714162E+00 .8067400317E+00 .8225399964E+00 .8383375967E+00 .8541908870E+00
+ .8701467656E+00 .8862252767E+00 .9023921505E+00 .9185112975E+00 .9343023328E+00
+ .9493353903E+00 .9630532784E+00 .9748692284E+00 .9843167021E+00 .9912000908E+00
+ .9956372119E+00 .9981514281E+00 .9993601788E+00 .9998309842E+00 .9999698181E+00
+ .9999972773E+00 .1855362397E+00 .2802675989E+00 .3463680148E+00 .3975207969E+00
+ .4395910137E+00 .4755800008E+00 .5072251867E+00 .5356228906E+00 .5615106308E+00
+ .5853742668E+00 .6076227372E+00 .6285677103E+00 .6484316643E+00 .6673926457E+00
+ .6855957474E+00 .7031349889E+00 .7201513531E+00 .7367308348E+00 .7529472630E+00
+ .7688832299E+00 .7846045338E+00 .8001737429E+00 .8156512200E+00 .8310957538E+00
+ .8465639571E+00 .8621069219E+00 .8777652756E+00 .8935377661E+00 .9093613299E+00
+ .9250565783E+00 .9402975256E+00 .9546177437E+00 .9674589227E+00 .9782854787E+00
+ .9866961771E+00 .9926201502E+00 .9963842521E+00 .9984813417E+00 .9994762016E+00
+ .9998613210E+00 .9999750410E+00 .9999977198E+00 .1846136093E+00 .2787588827E+00
+ .3444740172E+00 .3953196836E+00 .4371252494E+00 .4728758686E+00 .5042999276E+00
+ .5324879288E+00 .5581733641E+00 .5818742204E+00 .6039699963E+00 .6247223429E+00
+ .6443259872E+00 .6630434010E+00 .6810130747E+00 .6983511812E+00 .7151575571E+00
+ .7315193373E+00 .7475134806E+00 .7632091346E+00 .7786700253E+00 .7939562163E+00
+ .8091224683E+00 .8242328374E+00 .8393469818E+00 .8545156187E+00 .8697798721E+00
+ .8851584510E+00 .9006258019E+00 .9160815008E+00 .9313166965E+00 .9459909401E+00
+ .9596389858E+00 .9715759201E+00 .9813500845E+00 .9887637682E+00 .9938835052E+00
+ .9970527535E+00 .9987777714E+00 .9995815403E+00 .9998893532E+00 .9999799936E+00
+ .9999981545E+00 .1836909789E+00 .2774434157E+00 .3427853524E+00 .3933151805E+00
+ .4348458135E+00 .4703495177E+00 .5015461497E+00 .5295202439E+00 .5550010502E+00
+ .5784865318E+00 .6003227886E+00 .6208676033E+00 .6403357686E+00 .6589003708E+00
+ .6767026663E+00 .6938531892E+00 .7104492610E+00 .7265925689E+00 .7423518470E+00
+ .7577962643E+00 .7729993323E+00 .7880182103E+00 .8029076504E+00 .8177207360E+00
+ .8325093202E+00 .8473235051E+00 .8622088842E+00 .8772033000E+00 .8923127195E+00
+ .9074853909E+00 .9225758466E+00 .9373117325E+00 .9513034797E+00 .9640688537E+00
+ .9751160353E+00 .9840572173E+00 .9906208006E+00 .9950104001E+00 .9976480550E+00
+ .9990430046E+00 .9996769219E+00 .9999152390E+00 .9999846946E+00 .9999985820E+00
+ .1827683484E+00 .2763083247E+00 .3412883176E+00 .3914941679E+00 .4327402658E+00
+ .4679891098E+00 .4989524154E+00 .5267086976E+00 .5519406736E+00 .5751864763E+00
+ .5968600600E+00 .6172360361E+00 .6365301996E+00 .6549159835E+00 .6725347364E+00
+ .6895032631E+00 .7059001317E+00 .7218389060E+00 .7373935982E+00 .7526302061E+00
+ .7676085759E+00 .7823844191E+00 .7970107284E+00 .8115365385E+00 .8260173888E+00
+ .8405056011E+00 .8550467749E+00 .8696786383E+00 .8844206171E+00 .8992560411E+00
+ .9141065309E+00 .9287894949E+00 .9429990451E+00 .9563188552E+00 .9682695030E+00
+ .9784026179E+00 .9864140545E+00 .9922336385E+00 .9960099118E+00 .9981750515E+00
+ .9992791138E+00 .9997630123E+00 .9999391211E+00 .9999891606E+00 .9999990028E+00
+ .1818457180E+00 .2753418278E+00 .3399704239E+00 .3898447064E+00 .4307972778E+00
+ .4657837967E+00 .4965082939E+00 .5240164612E+00 .5490397267E+00 .5721199078E+00
+ .5936220368E+00 .6138230134E+00 .6329391623E+00 .6511440087E+00 .6685643409E+00
+ .6853340058E+00 .7015525385E+00 .7173036792E+00 .7326612138E+00 .7476907018E+00
+ .7624493298E+00 .7769909111E+00 .7913719358E+00 .8056415578E+00 .8198475066E+00
+ .8340365025E+00 .8482538279E+00 .8625421803E+00 .8769325394E+00 .8914300839E+00
+ .9059954350E+00 .9205169371E+00 .9347836544E+00 .9484682541E+00 .9611193304E+00
+ .9722733359E+00 .9815273314E+00 .9886554442E+00 .9936804189E+00 .9968701500E+00
+ .9986381871E+00 .9994880009E+00 .9998404155E+00 .9999611303E+00 .9999934069E+00
+ .9999994172E+00 .1809230876E+00 .2745331632E+00 .3388202339E+00 .3883558181E+00
+ .4290064695E+00 .4637237043E+00 .4942042266E+00 .5215141382E+00 .5463684452E+00
+ .5692719178E+00 .5905944094E+00 .6106145911E+00 .6295489513E+00 .6475708740E+00
+ .6648215607E+00 .6814169329E+00 .6974539592E+00 .7130162105E+00 .7281772298E+00
+ .7430021409E+00 .7575491131E+00 .7718712991E+00 .7860186150E+00 .8000388304E+00
+ .8139781927E+00 .8278819359E+00 .8417944270E+00 .8557580145E+00 .8698091412E+00
+ .8839698058E+00 .8982322496E+00 .9125358107E+00 .9267384276E+00 .9405914761E+00
+ .9537332711E+00 .9657185777E+00 .9760929895E+00 .9845005617E+00 .9907887372E+00
+ .9950630245E+00 .9976593429E+00 .9990415437E+00 .9996714060E+00 .9999096868E+00
+ .9999813859E+00 .9999974477E+00 .9999998257E+00 .1804508555E+00 .2734904362E+00
+ .3375965804E+00 .3870271265E+00 .4276000615E+00 .4622529165E+00 .4926767625E+00
+ .5199353140E+00 .5447419521E+00 .5675996964E+00 .5888775666E+00 .6088543661E+00
+ .6277461822E+00 .6457251352E+00 .6629315786E+00 .6794815412E+00 .6954721015E+00
+ .7109861656E+00 .7260962580E+00 .7408668527E+00 .7553558219E+00 .7696158575E+00
+ .7836960114E+00 .7976429812E+00 .8115019392E+00 .8253169935E+00 .8391311967E+00
+ .8529854450E+00 .8669149773E+00 .8809416956E+00 .8950604551E+00 .9092185062E+00
+ .9232902962E+00 .9370549556E+00 .9501891908E+00 .9622899471E+00 .9729346561E+00
+ .9817711212E+00 .9886100662E+00 .9934829732E+00 .9966365483E+00 .9984623731E+00
+ .9993913439E+00 .9997975622E+00 .9999457835E+00 .9999890563E+00 .9999985224E+00
+ .9999999001E+00 .1799786234E+00 .2730659875E+00 .3369987024E+00 .3862671594E+00
+ .4267031510E+00 .4612398324E+00 .4915631120E+00 .5187331258E+00 .5434603897E+00
+ .5662451125E+00 .5874545188E+00 .6073667945E+00 .6261972162E+00 .6441163642E+00
+ .6612633290E+00 .6777537901E+00 .6936847124E+00 .7091383331E+00 .7241861021E+00
+ .7388916122E+00 .7533121922E+00 .7674999770E+00 .7815031664E+00 .7953673728E+00
+ .8091366510E+00 .8228540827E+00 .8365619252E+00 .8503009540E+00 .8641079576E+00
+ .8780096941E+00 .8920112822E+00 .9060775315E+00 .9201080660E+00 .9339118311E+00
+ .9471926672E+00 .9595614409E+00 .9705865769E+00 .9798806496E+00 .9871998297E+00
+ .9925173512E+00 .9960354178E+00 .9981257392E+00 .9992239945E+00 .9997250422E+00
+ .9999191132E+00 .9999810682E+00 .9999966998E+00 .9999996196E+00 .9999999783E+00
+ .1737908653E+00 .2645026840E+00 .3270468003E+00 .3753567767E+00 .4150682286E+00
+ .4490241504E+00 .4788627235E+00 .5056157513E+00 .5299746744E+00 .5524270326E+00
+ .5733322469E+00 .5929625111E+00 .6115272365E+00 .6291922378E+00 .6460938316E+00
+ .6623459221E+00 .6780432496E+00 .6932652595E+00 .7080809279E+00 .7225521484E+00
+ .7367348621E+00 .7506794727E+00 .7644319798E+00 .7780356414E+00 .7915322574E+00
+ .8049627888E+00 .8183677085E+00 .8317873297E+00 .8452617029E+00 .8588290734E+00
+ .8725214354E+00 .8863552674E+00 .9003154769E+00 .9143319492E+00 .9282519312E+00
+ .9418176254E+00 .9546642131E+00 .9663539556E+00 .9764520297E+00 .9846295065E+00
+ .9907576350E+00 .9949507764E+00 .9975333362E+00 .9989425555E+00 .9996113653E+00
+ .9998812259E+00 .9999710788E+00 .9999947485E+00 .9999993688E+00 .9999999624E+00
+ .1760702459E+00 .2674887044E+00 .3303711206E+00 .3788684783E+00 .4186886637E+00
+ .4527062992E+00 .4825750415E+00 .5093357814E+00 .5336865414E+00 .5561182220E+00
+ .5769911503E+00 .5965790643E+00 .6150939206E+00 .6327026942E+00 .6495409171E+00
+ .6657217891E+00 .6813406769E+00 .6964779621E+00 .7112025251E+00 .7255752592E+00
+ .7396511989E+00 .7534803500E+00 .7671083815E+00 .7805777811E+00 .7939291141E+00
+ .8072018928E+00 .8204350188E+00 .8336669539E+00 .8469354066E+00 .8602757157E+00
+ .8737165703E+00 .8872713396E+00 .9009234024E+00 .9146052204E+00 .9281742281E+00
+ .9413937071E+00 .9539314653E+00 .9653892774E+00 .9753678168E+00 .9835554525E+00
+ .9898119678E+00 .9942118121E+00 .9970243456E+00 .9986368776E+00 .9994536906E+00
+ .9998127716E+00 .9999467553E+00 .9999879572E+00 .9999979718E+00 .9999997742E+00
+ .9999999875E+00 .1766783538E+00 .2681705974E+00 .3310215263E+00 .3794504079E+00
+ .4191851503E+00 .4531081977E+00 .4828764476E+00 .5095321968E+00 .5337745973E+00
+ .5560950970E+00 .5768535397E+00 .5963231991E+00 .6147163430E+00 .6322001736E+00
+ .6489095456E+00 .6649566457E+00 .6804363770E+00 .6954290782E+00 .7100032644E+00
+ .7242188961E+00 .7381299148E+00 .7517854254E+00 .7652302706E+00 .7785058745E+00
+ .7916513897E+00 .8047046748E+00 .8177028562E+00 .8306825621E+00 .8436797967E+00
+ .8567289346E+00 .8698597689E+00 .8830911329E+00 .8964195281E+00 .9098019247E+00
+ .9231341707E+00 .9362304719E+00 .9488140040E+00 .9605308991E+00 .9709958978E+00
+ .9798662247E+00 .9869242818E+00 .9921385249E+00 .9956749186E+00 .9978508572E+00
+ .9990499101E+00 .9996330171E+00 .9998789154E+00 .9999668773E+00 .9999927987E+00
+ .9999988348E+00 .9999998754E+00 .9999999934E+00 .1779908188E+00 .2697988844E+00
+ .3327447119E+00 .3811829052E+00 .4208842067E+00 .4547490899E+00 .4844431674E+00
+ .5110131223E+00 .5351609361E+00 .5573800953E+00 .5780311486E+00 .5973872974E+00
+ .6156611932E+00 .6330207525E+00 .6496008514E+00 .6655129316E+00 .6808512682E+00
+ .6956961025E+00 .7101158796E+00 .7241699878E+00 .7379114001E+00 .7513882671E+00
+ .7646446134E+00 .7777209603E+00 .7906552575E+00 .8034838604E+00 .8162422061E+00
+ .8289651307E+00 .8416868486E+00 .8544402966E+00 .8672550452E+00 .8801525431E+00
+ .8931372625E+00 .9061826925E+00 .9192126599E+00 .9320815261E+00 .9445608746E+00
+ .9563432959E+00 .9670726532E+00 .9764024145E+00 .9840704509E+00 .9899662136E+00
+ .9941630091E+00 .9968993326E+00 .9985150234E+00 .9993682409E+00 .9997654609E+00
+ .9999256998E+00 .9999805019E+00 .9999959360E+00 .9999993699E+00 .9999999355E+00
+ .9999999967E+00 .1766654880E+00 .2677324884E+00 .3301125399E+00 .3780686005E+00
+ .4173360833E+00 .4507975261E+00 .4801081904E+00 .5063086571E+00 .5300962477E+00
+ .5519602113E+00 .5722584110E+00 .5912628448E+00 .6091846242E+00 .6261891356E+00
+ .6424090006E+00 .6579546096E+00 .6729196732E+00 .6873831954E+00 .7014115835E+00
+ .7150621450E+00 .7283862517E+00 .7414306836E+00 .7542377579E+00 .7668457056E+00
+ .7792897840E+00 .7916035011E+00 .8038193319E+00 .8159689804E+00 .8280835885E+00
+ .8401940178E+00 .8523308641E+00 .8645235620E+00 .8767977111E+00 .8891694525E+00
+ .9016355107E+00 .9141580018E+00 .9266449960E+00 .9389313419E+00 .9507684738E+00
+ .9618343318E+00 .9717717729E+00 .9802540253E+00 .9870613087E+00 .9921412951E+00
+ .9956266789E+00 .9977991555E+00 .9990134579E+00 .9996131676E+00 .9998702914E+00
+ .9999639037E+00 .9999920084E+00 .9999986820E+00 .9999998562E+00 .9999999922E+00
+ .1744025656E+00 .2647500997E+00 .3268203491E+00 .3746456404E+00 .4138796805E+00
+ .4473683904E+00 .4767476642E+00 .5030458469E+00 .5269534302E+00 .5489567332E+00
+ .5694105392E+00 .5885828306E+00 .6066828556E+00 .6238769730E+00 .6402984895E+00
+ .6560563027E+00 .6712422376E+00 .6859352950E+00 .7002034284E+00 .7141051065E+00
+ .7276916422E+00 .7410094308E+00 .7541011829E+00 .7670063668E+00 .7797616534E+00
+ .7924017040E+00 .8049600333E+00 .8174695957E+00 .8299630016E+00 .8424723459E+00
+ .8550283387E+00 .8676579648E+00 .8803795128E+00 .8931937233E+00 .9060703014E+00
+ .9189305787E+00 .9316298946E+00 .9439466849E+00 .9555874935E+00 .9662155987E+00
+ .9755039969E+00 .9832023629E+00 .9891973710E+00 .9935432073E+00 .9964481998E+00
+ .9982212663E+00 .9991989473E+00 .9996802179E+00 .9998887957E+00 .9999670475E+00
+ .9999919203E+00 .9999984279E+00 .9999997726E+00 .9999999783E+00 .9999999990E+00
+ .5180308273E+00 .3911409433E+00 .6623065771E+00 .3275839077E+00 .5276830711E+00
+ .7154100900E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .3064829269E+00 .4790404367E+00 .6116645349E+00 .7335119896E+00 .8644633765E+00
+ .2847780314E+00 .4417229868E+00 .5585875942E+00 .6599588880E+00 .7598329290E+00
+ .8732626067E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .0000000000E+00 .0000000000E+00 .0000000000E+00 .2646878980E+00 .4080337687E+00
+ .5111711389E+00 .5959093218E+00 .6718722435E+00 .7454229644E+00 .8231646462E+00
+ .9124178201E+00 .2546033114E+00 .3913489905E+00 .4887573172E+00 .5676597540E+00
+ .6368986717E+00 .7016670220E+00 .7663178755E+00 .8362788136E+00 .9181661252E+00
+ .2467729378E+00 .3785679295E+00 .4717338221E+00 .5464216594E+00 .6110104604E+00
+ .6701223172E+00 .7270866420E+00 .7852449699E+00 .8492767395E+00 .9248928954E+00
+ .2413825414E+00 .3700834490E+00 .4605077067E+00 .5324218467E+00 .5939494757E+00
+ .6494196758E+00 .7016924582E+00 .7531846666E+00 .8066605495E+00 .8661287676E+00
+ .9354167189E+00 .2353858201E+00 .3603992909E+00 .4478085379E+00 .5168975524E+00
+ .5755345234E+00 .6278290414E+00 .6763648641E+00 .7231065900E+00 .7699437594E+00
+ .8192703167E+00 .8747318121E+00 .9396919885E+00 .2318174748E+00 .3552985933E+00
+ .4412849551E+00 .5089020020E+00 .5659213984E+00 .6163516407E+00 .6626384852E+00
+ .7065253223E+00 .7494994205E+00 .7931440602E+00 .8395760654E+00 .8917652882E+00
+ .9506868735E+00 .2280253825E+00 .3499059512E+00 .4344956591E+00 .5007362468E+00
+ .5563073008E+00 .6051378190E+00 .6495803708E+00 .6912459849E+00 .7314072774E+00
+ .7712593419E+00 .8121779568E+00 .8560463960E+00 .9051956201E+00 .9587821006E+00
+ .2245887789E+00 .3458772700E+00 .4298365568E+00 .4953495830E+00 .5500747730E+00
+ .5979089372E+00 .6411566811E+00 .6813559051E+00 .7196623147E+00 .7570716078E+00
+ .7945952227E+00 .8334553746E+00 .8752474667E+00 .9212871218E+00 .9682970367E+00
+ .2203696922E+00 .3385897732E+00 .4202174709E+00 .4837300552E+00 .5366022091E+00
+ .5826230187E+00 .6240149915E+00 .6622362636E+00 .6983473300E+00 .7332105254E+00
+ .7676266955E+00 .8024665650E+00 .8388430885E+00 .8782888896E+00 .9222485013E+00
+ .9680627395E+00 .2169762745E+00 .3341782833E+00 .4149508010E+00 .4776367867E+00
+ .5296633747E+00 .5747854170E+00 .6151924615E+00 .6523042279E+00 .6871304816E+00
+ .7204603416E+00 .7529806730E+00 .7853714334E+00 .8184116299E+00 .8531180059E+00
+ .8908055821E+00 .9322363945E+00 .9735146960E+00 .2129798830E+00 .3307772795E+00
+ .4119065804E+00 .4747251279E+00 .5267224541E+00 .5716785253E+00 .6117881187E+00
+ .6484624944E+00 .6826898748E+00 .7152215099E+00 .7466820384E+00 .7776482663E+00
+ .8087217518E+00 .8406107084E+00 .8741895741E+00 .9102598341E+00 .9480824823E+00
+ .9818461334E+00 .2139559932E+00 .3253326980E+00 .4025195312E+00 .4627106869E+00
+ .5128367731E+00 .5564023578E+00 .5954463265E+00 .6312809155E+00 .6648241637E+00
+ .6967707176E+00 .7276914416E+00 .7581014754E+00 .7885175352E+00 .8195166552E+00
+ .8517844312E+00 .8860318974E+00 .9223521780E+00 .9583491078E+00 .9869886422E+00
+ .2079887342E+00 .3160756060E+00 .3909294150E+00 .4492484121E+00 .4977554813E+00
+ .5398458104E+00 .5774899214E+00 .6119499535E+00 .6441013436E+00 .6745966142E+00
+ .7039586604E+00 .7326417265E+00 .7610780817E+00 .7897231857E+00 .8191099582E+00
+ .8499084239E+00 .8829025517E+00 .9184917022E+00 .9548828945E+00 .9852817476E+00
+ .2053290422E+00 .3110796618E+00 .3850640717E+00 .4427848696E+00 .4907680501E+00
+ .5323475860E+00 .5694647521E+00 .6033616675E+00 .6348950656E+00 .6646965414E+00
+ .6932628432E+00 .7210067758E+00 .7483236611E+00 .7756045724E+00 .8032679181E+00
+ .8318115679E+00 .8618299525E+00 .8938685005E+00 .9277564161E+00 .9610530422E+00
+ .9875563221E+00 .2026693502E+00 .3072688845E+00 .3804297756E+00 .4374769293E+00
+ .4848586120E+00 .5258677867E+00 .5624196457E+00 .5957366454E+00 .6266577687E+00
+ .6557961481E+00 .6836272434E+00 .7105427681E+00 .7368800330E+00 .7630008922E+00
+ .7892477772E+00 .8160095373E+00 .8437527799E+00 .8730058214E+00 .9041221108E+00
+ .9364829019E+00 .9670799404E+00 .9899924800E+00 .2000096582E+00 .3044886928E+00
+ .3768659533E+00 .4331738723E+00 .4798865577E+00 .5202735907E+00 .5562267683E+00
+ .5889492285E+00 .6192630631E+00 .6477650166E+00 .6749135953E+00 .7010811363E+00
+ .7265885076E+00 .7517316518E+00 .7768044908E+00 .8021229083E+00 .8280527939E+00
+ .8550328267E+00 .8835331792E+00 .9137562384E+00 .9447413003E+00 .9729823242E+00
+ .9925691421E+00 .2009209231E+00 .3049795503E+00 .3767231016E+00 .4323320859E+00
+ .4783138555E+00 .5179447010E+00 .5531144115E+00 .5850204042E+00 .6144767624E+00
+ .6420697806E+00 .6682448301E+00 .6933577339E+00 .7177077049E+00 .7415616369E+00
+ .7651735794E+00 .7888027981E+00 .8127345111E+00 .8373044910E+00 .8629169855E+00
+ .8899975254E+00 .9186965195E+00 .9480400284E+00 .9746682844E+00 .9930500128E+00
+ .1950278135E+00 .2965775128E+00 .3667754917E+00 .4212724084E+00 .4663790175E+00
+ .5052777129E+00 .5398053947E+00 .5711262208E+00 .6000313286E+00 .6270887019E+00
+ .6527277199E+00 .6772894705E+00 .7010573458E+00 .7242793157E+00 .7471860423E+00
+ .7700058156E+00 .7929801123E+00 .8163832259E+00 .8405454006E+00 .8658656536E+00
+ .8927467810E+00 .9212572114E+00 .9502426509E+00 .9761588165E+00 .9936149257E+00
+ .1981493393E+00 .3000435369E+00 .3699869467E+00 .4239962432E+00 .4684934776E+00
+ .5067038993E+00 .5404821860E+00 .5709991533E+00 .5990466215E+00 .6251891085E+00
+ .6498493917E+00 .6733592307E+00 .6959891513E+00 .7179695971E+00 .7395080424E+00
+ .7608015978E+00 .7820482312E+00 .8034605522E+00 .8252832100E+00 .8478142060E+00
+ .8714219924E+00 .8965054713E+00 .9232251572E+00 .9507099706E+00 .9758346487E+00
+ .9933261384E+00 .1918523917E+00 .2919378681E+00 .3611117165E+00 .4147679900E+00
+ .4591221511E+00 .4973096518E+00 .5311395274E+00 .5617553572E+00 .5899318563E+00
+ .6162231841E+00 .6410434223E+00 .6647158949E+00 .6875045421E+00 .7096333869E+00
+ .7313010535E+00 .7526934381E+00 .7739943771E+00 .7953961026E+00 .8171120253E+00
+ .8393913493E+00 .8625269540E+00 .8868205263E+00 .9124036129E+00 .9387531249E+00
+ .9639228774E+00 .9842769057E+00 .9962620033E+00 .1891368960E+00 .2878567004E+00
+ .3560840151E+00 .4089901348E+00 .4527029471E+00 .4903140861E+00 .5236071506E+00
+ .5537086472E+00 .5813806528E+00 .6071677410E+00 .6314753992E+00 .6546179238E+00
+ .6768501633E+00 .6983865770E+00 .7194140022E+00 .7401033237E+00 .7606194826E+00
+ .7811297224E+00 .8018129682E+00 .8228719623E+00 .8445464562E+00 .8671177437E+00
+ .8908657385E+00 .9158759663E+00 .9415491496E+00 .9658783142E+00 .9853048038E+00
+ .9965567872E+00 .1897512283E+00 .2883371174E+00 .3563151762E+00 .4089378592E+00
+ .4523520190E+00 .4896538068E+00 .5226272357E+00 .5523977642E+00 .5797245497E+00
+ .6051487501E+00 .6290729850E+00 .6518073829E+00 .6736007022E+00 .6946608010E+00
+ .7151669718E+00 .7352797093E+00 .7551500484E+00 .7749273151E+00 .7947662182E+00
+ .8148356043E+00 .8353290343E+00 .8564732770E+00 .8785184708E+00 .9016592439E+00
+ .9257844309E+00 .9499749992E+00 .9719834790E+00 .9885613375E+00 .9974876627E+00
+ .1885403501E+00 .2867053477E+00 .3544064628E+00 .4068006979E+00 .4500049805E+00
+ .4871020405E+00 .5198682532E+00 .5494245001E+00 .5765259981E+00 .6017096043E+00
+ .6253745074E+00 .6478276517E+00 .6693130347E+00 .6900326013E+00 .7101594360E+00
+ .7298463578E+00 .7492338560E+00 .7684575132E+00 .7876541903E+00 .8069684231E+00
+ .8265603996E+00 .8466142291E+00 .8673395800E+00 .8889431317E+00 .9115113196E+00
+ .9347182434E+00 .9573628599E+00 .9770964553E+00 .9911234228E+00 .9981667646E+00
+ .1880971549E+00 .2850501090E+00 .3523426140E+00 .4044492002E+00 .4473945285E+00
+ .4842390828E+00 .5167510963E+00 .5460472575E+00 .5728801402E+00 .5977836681E+00
+ .6211537207E+00 .6432808891E+00 .6644190254E+00 .6847717649E+00 .7045055210E+00
+ .7237661784E+00 .7426860184E+00 .7613897674E+00 .7800006438E+00 .7986454717E+00
+ .8174605108E+00 .8366014861E+00 .8562490308E+00 .8765809374E+00 .8977331030E+00
+ .9196425426E+00 .9417617197E+00 .9627329469E+00 .9803804800E+00 .9925129028E+00
+ .9984631190E+00 .1876539596E+00 .2839427303E+00 .3508494646E+00 .4026340915E+00
+ .4452836783E+00 .4818454096E+00 .5140803304E+00 .5431002628E+00 .5696543472E+00
+ .5942732360E+00 .6173491723E+00 .6391831310E+00 .6600128835E+00 .6800315577E+00
+ .6994015831E+00 .7182641883E+00 .7367454210E+00 .7549522917E+00 .7730203297E+00
+ .7910626147E+00 .8091981288E+00 .8275570948E+00 .8462859276E+00 .8655461712E+00
+ .8854913793E+00 .9061877992E+00 .9274352811E+00 .9484936019E+00 .9678768013E+00
+ .9835659608E+00 .9939007698E+00 .9987755429E+00 .1872107644E+00 .2833334059E+00
+ .3498751401E+00 .4013066228E+00 .4436270211E+00 .4798783670E+00 .5118153825E+00
+ .5405444188E+00 .5668104432E+00 .5911404952E+00 .6139230329E+00 .6354555870E+00
+ .6559510123E+00 .6756303028E+00 .6946497298E+00 .7131447026E+00 .7312357131E+00
+ .7490330280E+00 .7666410413E+00 .7841629713E+00 .8017045100E+00 .8193781551E+00
+ .8373075468E+00 .8556461302E+00 .8745362825E+00 .8941009870E+00 .9143377216E+00
+ .9349203048E+00 .9549421488E+00 .9728149887E+00 .9866618706E+00 .9952871511E+00
+ .9991025673E+00 .1867675692E+00 .2831781957E+00 .3493738681E+00 .4004237691E+00
+ .4423844896E+00 .4783003184E+00 .5099204512E+00 .5383452145E+00 .5643147437E+00
+ .5883521470E+00 .6108419232E+00 .6320778886E+00 .6522920826E+00 .6716716651E+00
+ .6903713535E+00 .7085237616E+00 .7262461578E+00 .7436444842E+00 .7608172756E+00
+ .7778600003E+00 .7948688254E+00 .8119439757E+00 .8291936435E+00 .8467380888E+00
+ .8647106847E+00 .8832464988E+00 .9024363065E+00 .9222097786E+00 .9421247667E+00
+ .9611324047E+00 .9775656571E+00 .9896761221E+00 .9966722100E+00 .9994429128E+00
+ .1789174416E+00 .2722468287E+00 .3366538183E+00 .3864887097E+00 .4275498560E+00
+ .4627620146E+00 .4938093339E+00 .5217531537E+00 .5473095208E+00 .5709848723E+00
+ .5931504119E+00 .6140902723E+00 .6340303073E+00 .6531524104E+00 .6716053392E+00
+ .6895161622E+00 .7069980140E+00 .7241529862E+00 .7410745858E+00 .7578521206E+00
+ .7745750099E+00 .7913356571E+00 .8082323327E+00 .8253733998E+00 .8428819463E+00
+ .8608973786E+00 .8795647927E+00 .8989896592E+00 .9191195260E+00 .9395252319E+00
+ .9591466548E+00 .9762552813E+00 .9889846035E+00 .9964164427E+00 .9993938692E+00
+ .1827783213E+00 .2774143240E+00 .3424452454E+00 .3926036599E+00 .4338219039E+00
+ .4690850622E+00 .5001094980E+00 .5279744359E+00 .5534055339E+00 .5769162829E+00
+ .5988832486E+00 .6195921345E+00 .6392681953E+00 .6580935787E+00 .6762173307E+00
+ .6937644996E+00 .7108442966E+00 .7275547305E+00 .7439849092E+00 .7602179234E+00
+ .7763345243E+00 .7924161411E+00 .8085472361E+00 .8248181547E+00 .8413286330E+00
+ .8581902397E+00 .8755229650E+00 .8934338655E+00 .9119536579E+00 .9309020757E+00
+ .9496866989E+00 .9671468540E+00 .9816892384E+00 .9919169731E+00 .9975151029E+00
+ .9996051389E+00 .1805971966E+00 .2739919426E+00 .3385315793E+00 .3883898436E+00
+ .4293879716E+00 .4644724902E+00 .4953424011E+00 .5230676324E+00 .5483673999E+00
+ .5717508323E+00 .5935922318E+00 .6141751454E+00 .6337217487E+00 .6524117088E+00
+ .6703928576E+00 .6877886851E+00 .7047055138E+00 .7212381094E+00 .7374727401E+00
+ .7534892756E+00 .7693639094E+00 .7851721593E+00 .8009913545E+00 .8169029029E+00
+ .8329949349E+00 .8493647105E+00 .8661178850E+00 .8833574275E+00 .9011474063E+00
+ .9194300516E+00 .9378844551E+00 .9557667229E+00 .9718658297E+00 .9847665897E+00
+ .9934711366E+00 .9980477487E+00 .9996969924E+00 .1784160718E+00 .2713958753E+00
+ .3354582551E+00 .3849428531E+00 .4256437505E+00 .4604821659E+00 .4911406922E+00
+ .5186785687E+00 .5438068814E+00 .5670290077E+00 .5887159611E+00 .6091483658E+00
+ .6285447286E+00 .6470817240E+00 .6649055884E+00 .6821381588E+00 .6988829501E+00
+ .7152314903E+00 .7312672140E+00 .7470670710E+00 .7627033273E+00 .7782463675E+00
+ .7937673637E+00 .8093402788E+00 .8250439268E+00 .8409644246E+00 .8571966713E+00
+ .8738408177E+00 .8909845463E+00 .9086541427E+00 .9267144134E+00 .9447193207E+00
+ .9617823478E+00 .9766254418E+00 .9879640337E+00 .9951544004E+00 .9986567350E+00
+ .9998093251E+00 .1782989297E+00 .2707192639E+00 .3342415761E+00 .3832267932E+00
+ .4234622310E+00 .4578611360E+00 .4880995236E+00 .5152311252E+00 .5399626977E+00
+ .5627944211E+00 .5840944648E+00 .6041404426E+00 .6231480096E+00 .6412915943E+00
+ .6587155019E+00 .6755391840E+00 .6918630822E+00 .7077755030E+00 .7233568576E+00
+ .7386807739E+00 .7538151856E+00 .7688250234E+00 .7837750978E+00 .7987318806E+00
+ .8137648913E+00 .8289487898E+00 .8443658696E+00 .8601071476E+00 .8762682329E+00
+ .8929314691E+00 .9101187687E+00 .9276975177E+00 .9452420175E+00 .9619124016E+00
+ .9764932225E+00 .9877388088E+00 .9949763691E+00 .9985752725E+00 .9997919273E+00
+ .1774688962E+00 .2687227483E+00 .3318571131E+00 .3805930949E+00 .4206227854E+00
+ .4548337785E+00 .4848776930E+00 .5117955485E+00 .5363290502E+00 .5589702962E+00
+ .5800826097E+00 .5999412323E+00 .6187515040E+00 .6366896607E+00 .6539035742E+00
+ .6705110361E+00 .6866108219E+00 .7022882315E+00 .7176163750E+00 .7326708902E+00
+ .7475176032E+00 .7622176368E+00 .7768306968E+00 .7914173642E+00 .8060420282E+00
+ .8207709196E+00 .8356758322E+00 .8508357921E+00 .8663362731E+00 .8822649534E+00
+ .8986810361E+00 .9155543180E+00 .9326826829E+00 .9495710525E+00 .9653605662E+00
+ .9788764186E+00 .9890829773E+00 .9955488335E+00 .9987361034E+00 .9998138388E+00
+ .1766388627E+00 .2669531337E+00 .3297132464E+00 .3781893645E+00 .4180008852E+00
+ .4520136923E+00 .4818847231E+00 .5086476331E+00 .5329733245E+00 .5554169173E+00
+ .5763364212E+00 .5960044268E+00 .6146321714E+00 .6323876020E+00 .6494037929E+00
+ .6657956488E+00 .6816739393E+00 .6971212651E+00 .7122111502E+00 .7270113624E+00
+ .7415848899E+00 .7559860644E+00 .7702758303E+00 .7845149592E+00 .7987603515E+00
+ .8130714098E+00 .8275114881E+00 .8421497817E+00 .8570694468E+00 .8723505762E+00
+ .8880619788E+00 .9042352743E+00 .9208002368E+00 .9374917236E+00 .9537530666E+00
+ .9686402942E+00 .9811169262E+00 .9903489680E+00 .9960930036E+00 .9988920867E+00
+ .9998358861E+00 .1758088292E+00 .2653941782E+00 .3277927883E+00 .3759991769E+00
+ .4155809889E+00 .4493860492E+00 .4790625158E+00 .5056505571E+00 .5298486441E+00
+ .5521148977E+00 .5728368944E+00 .5923113184E+00 .6107473331E+00 .6283100696E+00
+ .6451353486E+00 .6613118778E+00 .6769731024E+00 .6921966807E+00 .7070474894E+00
+ .7216018461E+00 .7359197440E+00 .7500568503E+00 .7640654205E+00 .7779965265E+00
+ .7919020312E+00 .8058356301E+00 .8198582026E+00 .8340304572E+00 .8484180673E+00
+ .8631123569E+00 .8781775860E+00 .8936735881E+00 .9096081337E+00 .9258700073E+00
+ .9421241373E+00 .9577059369E+00 .9717235633E+00 .9832249072E+00 .9915423355E+00
+ .9966109268E+00 .9990435669E+00 .9998580587E+00 .1749787957E+00 .2640311979E+00
+ .3260801506E+00 .3740076351E+00 .4133490009E+00 .4469374454E+00 .4764127530E+00
+ .5028100288E+00 .5268245155E+00 .5489450466E+00 .5695305307E+00 .5888302998E+00
+ .6070277082E+00 .6243685433E+00 .6409814876E+00 .6569767591E+00 .6724490931E+00
+ .6874786308E+00 .7021340706E+00 .7164773575E+00 .7305666503E+00 .7444563703E+00
+ .7581921284E+00 .7718287077E+00 .7854209161E+00 .7990181188E+00 .8126717691E+00
+ .8264363695E+00 .8403709200E+00 .8545399470E+00 .8690124265E+00 .8838556111E+00
+ .8991187936E+00 .9148184286E+00 .9307625279E+00 .9465369208E+00 .9614584830E+00
+ .9746371687E+00 .9852096241E+00 .9926681605E+00 .9971044071E+00 .9991908590E+00
+ .9998803499E+00 .1741487623E+00 .2628508326E+00 .3245611749E+00 .3722011936E+00
+ .4112921234E+00 .4446556637E+00 .4739236747E+00 .5001259268E+00 .5239542851E+00
+ .5458785831E+00 .5662252605E+00 .5853352330E+00 .6034126392E+00 .6206186888E+00
+ .6370835544E+00 .6529108224E+00 .6681935984E+00 .6830276831E+00 .6974736155E+00
+ .7115922740E+00 .7254514509E+00 .7391032291E+00 .7525960973E+00 .7659755281E+00
+ .7792859757E+00 .7925727190E+00 .8058826455E+00 .8192685463E+00 .8327866171E+00
+ .8464931216E+00 .8604591621E+00 .8747499796E+00 .8894194696E+00 .9044920044E+00
+ .9199142547E+00 .9354890525E+00 .9507741185E+00 .9650328602E+00 .9773926054E+00
+ .9870795075E+00 .9937310367E+00 .9975751269E+00 .9993342477E+00 .9999027503E+00
+ .1733187288E+00 .2618409176E+00 .3232229373E+00 .3705675007E+00 .4093986653E+00
+ .4425295959E+00 .4715845634E+00 .4975878350E+00 .5211876711E+00 .5428923618E+00
+ .5630925481E+00 .5820495021E+00 .5999692459E+00 .6170143171E+00 .6333146683E+00
+ .6489791030E+00 .6640823588E+00 .6787327047E+00 .6929972856E+00 .7069341783E+00
+ .7205967478E+00 .7340359092E+00 .7472995943E+00 .7604286590E+00 .7734700275E+00
+ .7864707993E+00 .7994745861E+00 .8125267732E+00 .8256751140E+00 .8389709651E+00
+ .8524702650E+00 .8662474463E+00 .8803554554E+00 .8948410310E+00 .9097076895E+00
+ .9248654651E+00 .9400639417E+00 .9548328934E+00 .9684408912E+00 .9800004890E+00
+ .9888421674E+00 .9947351840E+00 .9980245947E+00 .9994739940E+00 .9999252523E+00
+ .1724886953E+00 .2609903194E+00 .3220536587E+00 .3690953160E+00 .4076579802E+00
+ .4405490623E+00 .4693856453E+00 .4951608959E+00 .5185701051E+00 .5401257092E+00
+ .5601710536E+00 .5789689846E+00 .5967268934E+00 .6136086273E+00 .6297299338E+00
+ .6452148461E+00 .6601580679E+00 .6746399825E+00 .6887288667E+00 .7024826216E+00
+ .7159512052E+00 .7291829406E+00 .7422298748E+00 .7551353443E+00 .7679398275E+00
+ .7806828913E+00 .7934050176E+00 .8061491947E+00 .8189610533E+00 .8318872187E+00
+ .8449783302E+00 .8582894923E+00 .8718790715E+00 .8858039928E+00 .9001096292E+00
+ .9147724417E+00 .9296686174E+00 .9444997378E+00 .9587439233E+00 .9716764473E+00
+ .9824703838E+00 .9905046101E+00 .9956844065E+00 .9984542063E+00 .9996103353E+00
+ .9999478502E+00 .1716586618E+00 .2602888683E+00 .3210425518E+00 .3677743042E+00
+ .4060603128E+00 .4387047975E+00 .4673179633E+00 .4929123872E+00 .5161686652E+00
+ .5375646057E+00 .5574473264E+00 .5760805869E+00 .5936727383E+00 .6103889245E+00
+ .6263589448E+00 .6416882481E+00 .6564682988E+00 .6707802788E+00 .6846936992E+00
+ .6982664270E+00 .7115487502E+00 .7245880351E+00 .7374301470E+00 .7501181793E+00
+ .7626917562E+00 .7751884932E+00 .7876462564E+00 .8001043975E+00 .8126039069E+00
+ .8251876807E+00 .8379015549E+00 .8507955500E+00 .8639241404E+00 .8773439157E+00
+ .8911055977E+00 .9052349752E+00 .9196959972E+00 .9343332560E+00 .9488052750E+00
+ .9625444617E+00 .9748004935E+00 .9848111392E+00 .9920732559E+00 .9965822201E+00
+ .9988652181E+00 .9997434906E+00 .9999705375E+00 .1712286725E+00 .2593166536E+00
+ .3198930272E+00 .3665172071E+00 .4047198849E+00 .4372927168E+00 .4658415819E+00
+ .4913758461E+00 .5145733266E+00 .5359119515E+00 .5557400837E+00 .5743198474E+00
+ .5918562500E+00 .6085138901E+00 .6244250470E+00 .6396963381E+00 .6544168608E+00
+ .6686646587E+00 .6825087369E+00 .6960086622E+00 .7092155633E+00 .7221752638E+00
+ .7349311408E+00 .7475248645E+00 .7599958453E+00 .7723813030E+00 .7847175475E+00
+ .7970415176E+00 .8093916679E+00 .8218083516E+00 .8343343581E+00 .8470157437E+00
+ .8599022206E+00 .8730455984E+00 .8864937304E+00 .9002757919E+00 .9143735975E+00
+ .9286760350E+00 .9429232967E+00 .9566650851E+00 .9692740952E+00 .9800535740E+00
+ .9884369079E+00 .9942056031E+00 .9976003319E+00 .9992329309E+00 .9998323459E+00
+ .9999812683E+00 .1707986832E+00 .2589324325E+00 .3193389515E+00 .3658018629E+00
+ .4038655700E+00 .4363182232E+00 .4647618718E+00 .4902016669E+00 .5133113244E+00
+ .5345675839E+00 .5543193291E+00 .5728269071E+00 .5902915891E+00 .6068764312E+00
+ .6227154154E+00 .6379165233E+00 .6525671218E+00 .6667420751E+00 .6805090108E+00
+ .6939284679E+00 .7070525968E+00 .7199263908E+00 .7325910508E+00 .7450864365E+00
+ .7574512270E+00 .7697222188E+00 .7819345922E+00 .7941232718E+00 .8063242858E+00
+ .8185754692E+00 .8309168485E+00 .8433912231E+00 .8560447757E+00 .8689266536E+00
+ .8820855235E+00 .8955596850E+00 .9093557006E+00 .9234107188E+00 .9375395606E+00
+ .9513822210E+00 .9643872384E+00 .9758758203E+00 .9852076622E+00 .9920045190E+00
+ .9963175394E+00 .9986200715E+00 .9996074637E+00 .9999249703E+00 .9999927985E+00
+ .1649111334E+00 .2507977032E+00 .3098998750E+00 .3554679488E+00 .3928591565E+00
+ .4247768616E+00 .4527768086E+00 .4778354135E+00 .5006102683E+00 .5215689783E+00
+ .5410511671E+00 .5593076943E+00 .5765347773E+00 .5928951361E+00 .6085222084E+00
+ .6235200151E+00 .6379706050E+00 .6519459542E+00 .6655139974E+00 .6787361793E+00
+ .6916635279E+00 .7043378705E+00 .7167972181E+00 .7290797854E+00 .7412237839E+00
+ .7532651843E+00 .7652370222E+00 .7771711024E+00 .7891002244E+00 .8010591814E+00
+ .8130846915E+00 .8252154997E+00 .8374932738E+00 .8499637860E+00 .8626773184E+00
+ .8756868803E+00 .8890416487E+00 .9027708841E+00 .9168520778E+00 .9311599020E+00
+ .9454041437E+00 .9590859749E+00 .9715218744E+00 .9819781728E+00 .9899039245E+00
+ .9951616131E+00 .9981067447E+00 .9994358794E+00 .9998867515E+00 .9999885572E+00
+ .1671234511E+00 .2536960143E+00 .3131247755E+00 .3588727265E+00 .3963672632E+00
+ .4283414788E+00 .4563679370E+00 .4814335943E+00 .5041990295E+00 .5251325558E+00
+ .5445789416E+00 .5627948972E+00 .5799760649E+00 .5962804222E+00 .6118405676E+00
+ .6267652888E+00 .6411407703E+00 .6550376064E+00 .6685191786E+00 .6816446877E+00
+ .6944669360E+00 .7070304180E+00 .7193732637E+00 .7315312025E+00 .7435398115E+00
+ .7554340012E+00 .7672467761E+00 .7790093694E+00 .7907527354E+00 .8025090127E+00
+ .8143121294E+00 .8261979418E+00 .8382046369E+00 .8503734686E+00 .8627490881E+00
+ .8753781179E+00 .8883037478E+00 .9015526694E+00 .9151095534E+00 .9288761217E+00
+ .9426200461E+00 .9559343763E+00 .9682442562E+00 .9788974459E+00 .9873409440E+00
+ .9933223273E+00 .9970048382E+00 .9989088361E+00 .9996986482E+00 .9999441347E+00
+ .9999948033E+00 .1677447873E+00 .2544092120E+00 .3138223582E+00 .3595164508E+00
+ .3969395118E+00 .4288322289E+00 .4567708151E+00 .4817450145E+00 .5044160782E+00
+ .5252510543E+00 .5445949250E+00 .5627066473E+00 .5797825355E+00 .5959781929E+00
+ .6114239939E+00 .6262294955E+00 .6404831015E+00 .6542556851E+00 .6676083352E+00
+ .6805978685E+00 .6932767205E+00 .7056904135E+00 .7178773997E+00 .7298720576E+00
+ .7417078430E+00 .7534180888E+00 .7650349846E+00 .7765889061E+00 .7881091782E+00
+ .7996255440E+00 .8111691724E+00 .8227729645E+00 .8344717361E+00 .8463027165E+00
+ .8583060693E+00 .8705244771E+00 .8830001967E+00 .8957669659E+00 .9088328931E+00
+ .9221504998E+00 .9355741400E+00 .9488153393E+00 .9614213489E+00 .9728115455E+00
+ .9823941849E+00 .9897435474E+00 .9947622899E+00 .9977318758E+00 .9992041111E+00
+ .9997886953E+00 .9999624021E+00 .9999966474E+00 .1690448842E+00 .2560372350E+00
+ .3155587637E+00 .3612758500E+00 .3986794172E+00 .4305277941E+00 .4584055810E+00
+ .4833081221E+00 .5059000921E+00 .5266488126E+00 .5458990925E+00 .5639120172E+00
+ .5808862568E+00 .5969767685E+00 .6123113854E+00 .6269989197E+00 .6411296671E+00
+ .6547762089E+00 .6679987953E+00 .6808517934E+00 .6933861293E+00 .7056476930E+00
+ .7176757978E+00 .7295044917E+00 .7411655685E+00 .7526904931E+00 .7641102438E+00
+ .7754544131E+00 .7867511967E+00 .7980284524E+00 .8093148867E+00 .8206406624E+00
+ .8320375869E+00 .8435393872E+00 .8551821575E+00 .8670044004E+00 .8790454888E+00
+ .8913406478E+00 .9039095140E+00 .9167347100E+00 .9297285406E+00 .9426921998E+00
+ .9552832006E+00 .9670182798E+00 .9773393530E+00 .9857471722E+00 .9919629942E+00
+ .9960396434E+00 .9983496620E+00 .9994440080E+00 .9998585501E+00 .9999759201E+00
+ .9999979482E+00 .1678526733E+00 .2541968556E+00 .3132334887E+00 .3585430461E+00
+ .3955834513E+00 .4270972446E+00 .4546605062E+00 .4792616247E+00 .5015598465E+00
+ .5220210643E+00 .5409901319E+00 .5587252304E+00 .5754203026E+00 .5912283892E+00
+ .6062790495E+00 .6206825648E+00 .6345273433E+00 .6478819922E+00 .6608041153E+00
+ .6733482188E+00 .6855665287E+00 .6975049174E+00 .7092005590E+00 .7206844633E+00
+ .7319861453E+00 .7431360328E+00 .7541644315E+00 .7650994620E+00 .7759666577E+00
+ .7867905060E+00 .7975962572E+00 .8084106179E+00 .8192614993E+00 .8301778585E+00
+ .8411902225E+00 .8523315995E+00 .8636380919E+00 .8751485527E+00 .8869023013E+00
+ .8989328038E+00 .9112537375E+00 .9238333815E+00 .9365560984E+00 .9491782011E+00
+ .9612993492E+00 .9723823406E+00 .9818486773E+00 .9892421867E+00 .9943980672E+00
+ .9975210256E+00 .9991092924E+00 .9997574161E+00 .9999556489E+00 .9999959303E+00
+ .1656458112E+00 .2512502469E+00 .3099369454E+00 .3550671967E+00 .3920215223E+00
+ .4235062479E+00 .4510771826E+00 .4757136417E+00 .4980706855E+00 .5186067371E+00
+ .5376589105E+00 .5554855060E+00 .5722856452E+00 .5882122109E+00 .6033872899E+00
+ .6179152577E+00 .6318869017E+00 .6453775421E+00 .6584473260E+00 .6711466123E+00
+ .6835220343E+00 .6956183327E+00 .7074762765E+00 .7191307785E+00 .7306119347E+00
+ .7419479177E+00 .7531669871E+00 .7642974383E+00 .7753666150E+00 .7864006286E+00
+ .7974251982E+00 .8084668220E+00 .8195534797E+00 .8307148402E+00 .8419824178E+00
+ .8533898698E+00 .8649730016E+00 .8767684403E+00 .8888093132E+00 .9011154766E+00
+ .9136753538E+00 .9264176571E+00 .9391759974E+00 .9516581743E+00 .9634415684E+00
+ .9740183359E+00 .9828994468E+00 .9897537882E+00 .9945240116E+00 .9974540763E+00
+ .9990028958E+00 .9996853127E+00 .9999252011E+00 .9999881289E+00 .9999990586E+00
+ .6441321461E+00 .4869430259E+00 .7949981370E+00 .3996743476E+00 .6410416300E+00
+ .8451421048E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .3706064816E+00 .5779282459E+00 .7345329894E+00 .8642184611E+00 .9591373438E+00
+ .3405739657E+00 .5273909345E+00 .6660161608E+00 .7837352698E+00 .8871216454E+00
+ .9653643800E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .0000000000E+00 .0000000000E+00 .0000000000E+00 .3138584252E+00 .4827765839E+00
+ .6041517169E+00 .7036430573E+00 .7916792157E+00 .8716674655E+00 .9394161352E+00
+ .9840366059E+00 .3002759554E+00 .4605948748E+00 .5746439129E+00 .6669301268E+00
+ .7476636742E+00 .8219008799E+00 .8906043383E+00 .9488234084E+00 .9866953744E+00
+ .2898869628E+00 .4437819402E+00 .5524213183E+00 .6394378879E+00 .7146078143E+00
+ .7830900512E+00 .8475520874E+00 .9075328332E+00 .9576559077E+00 .9893048496E+00
+ .2829882405E+00 .4328329246E+00 .5379719323E+00 .6215209701E+00 .6929549326E+00
+ .7572488468E+00 .8173256279E+00 .8743258587E+00 .9264686481E+00 .9680501453E+00
+ .9924613647E+00 .2750900629E+00 .4201897655E+00 .5215028650E+00 .6015135501E+00
+ .6693790927E+00 .7298635220E+00 .7858697579E+00 .8391885514E+00 .8901883587E+00
+ .9366186617E+00 .9729964930E+00 .9937825821E+00 .2709008651E+00 .4139318522E+00
+ .5133991576E+00 .5915568050E+00 .6574298736E+00 .7156637523E+00 .7690540111E+00
+ .8194122100E+00 .8676345511E+00 .9130656261E+00 .9526045287E+00 .9812895824E+00
+ .9960774729E+00 .2664704564E+00 .4073612262E+00 .5050134274E+00 .5814274526E+00
+ .6455017489E+00 .7017832449E+00 .7529788129E+00 .8008676809E+00 .8465633539E+00
+ .8902640280E+00 .9305659786E+00 .9640584210E+00 .9867212890E+00 .9974269346E+00
+ .2631653347E+00 .4031407343E+00 .4998941188E+00 .5753415623E+00 .6383384338E+00
+ .6933860296E+00 .7431374534E+00 .7893225034E+00 .8330792960E+00 .8748940278E+00
+ .9141801155E+00 .9488063027E+00 .9754786174E+00 .9917640815E+00 .9985707461E+00
+ .2571779713E+00 .3932928047E+00 .4871408959E+00 .5601099711E+00 .6208247764E+00
+ .6736538189E+00 .7211567405E+00 .7650037785E+00 .8063680405E+00 .8460444357E+00
+ .8843051082E+00 .9204698800E+00 .9524633355E+00 .9771727514E+00 .9923047674E+00
+ .9986573772E+00 .2535555174E+00 .3882783569E+00 .4809795151E+00 .5528744276E+00
+ .6125166076E+00 .6642268710E+00 .7105229628E+00 .7530332392E+00 .7928972112E+00
+ .8309300417E+00 .8675993222E+00 .9027806452E+00 .9353534163E+00 .9630453414E+00
+ .9832214255E+00 .9947064100E+00 .9991426989E+00 .2508486559E+00 .3861022720E+00
+ .4790453242E+00 .5509682534E+00 .6104792377E+00 .6619184109E+00 .7078041738E+00
+ .7497523022E+00 .7888790325E+00 .8259743806E+00 .8615135240E+00 .8954984598E+00
+ .9271724747E+00 .9548627673E+00 .9764130486E+00 .9903917262E+00 .9973244993E+00
+ .9996226299E+00 .2476807555E+00 .3768702919E+00 .4665584794E+00 .5366206496E+00
+ .5950733492E+00 .6459738098E+00 .6916853336E+00 .7337295289E+00 .7731600797E+00
+ .8107237811E+00 .8468761740E+00 .8816526400E+00 .9144310013E+00 .9437757524E+00
+ .9677125764E+00 .9846302856E+00 .9943819284E+00 .9986134588E+00 .9998282969E+00
+ .2402333746E+00 .3654102106E+00 .4522591124E+00 .5200414617E+00 .5765203934E+00
+ .6256202808E+00 .6696218291E+00 .7099889453E+00 .7477377054E+00 .7836166813E+00
+ .8181836995E+00 .8517883458E+00 .8844372722E+00 .9155544404E+00 .9437908627E+00
+ .9672110889E+00 .9840991911E+00 .9940623727E+00 .9984991558E+00 .9998092258E+00
+ .2372142839E+00 .3596905855E+00 .4455308112E+00 .5126207692E+00 .5684954786E+00
+ .6170077977E+00 .6604038637E+00 .7001236040E+00 .7371617470E+00 .7722471356E+00
+ .8059280631E+00 .8385724194E+00 .8703081859E+00 .9008484443E+00 .9293114503E+00
+ .9542529827E+00 .9740678518E+00 .9877381975E+00 .9955024036E+00 .9988713607E+00
+ .9998557713E+00 .2341951931E+00 .3553384264E+00 .4402228089E+00 .5065321103E+00
+ .5617112226E+00 .6095650241E+00 .6523089092E+00 .6913593451E+00 .7276906269E+00
+ .7620136054E+00 .7948666608E+00 .8266476902E+00 .8575553756E+00 .8875379335E+00
+ .9160415296E+00 .9419628183E+00 .9638342341E+00 .9803682602E+00 .9911345031E+00
+ .9968902986E+00 .9992495382E+00 .9999069085E+00 .2311761024E+00 .3521753747E+00
+ .4361498469E+00 .5016017554E+00 .5560057986E+00 .6031394079E+00 .6451904865E+00
+ .6835525310E+00 .7191802349E+00 .7527678857E+00 .7848437511E+00 .8158124610E+00
+ .8459469101E+00 .8753159021E+00 .9036458874E+00 .9301754105E+00 .9536527541E+00
+ .9726495486E+00 .9861848266E+00 .9943197487E+00 .9982328502E+00 .9996329118E+00
+ .9999620385E+00 .2311494540E+00 .3511896748E+00 .4341159391E+00 .4985108969E+00
+ .5518548188E+00 .5979171075E+00 .6388742876E+00 .6761070761E+00 .7105562201E+00
+ .7429012780E+00 .7736577038E+00 .8032289790E+00 .8319234637E+00 .8599286746E+00
+ .8872294272E+00 .9134763147E+00 .9378715779E+00 .9592133569E+00 .9762304895E+00
+ .9881546731E+00 .9951969505E+00 .9985261774E+00 .9996978423E+00 .9999691306E+00
+ .2247441756E+00 .3420696504E+00 .4233357934E+00 .4865486615E+00 .5389740440E+00
+ .5842787135E+00 .6245816733E+00 .6612273655E+00 .6951312880E+00 .7269539344E+00
+ .7571961490E+00 .7862533798E+00 .8144421595E+00 .8419970810E+00 .8690258067E+00
+ .8954111135E+00 .9206795753E+00 .9439215903E+00 .9639031699E+00 .9794586456E+00
+ .9900423927E+00 .9960856344E+00 .9988388663E+00 .9997704224E+00 .9999774247E+00
+ .2268279382E+00 .3438535952E+00 .4243434660E+00 .4866025143E+00 .5379797784E+00
+ .5821696936E+00 .6212991848E+00 .6567117590E+00 .6893169939E+00 .7197659836E+00
+ .7485476149E+00 .7760449120E+00 .8025683543E+00 .8283711365E+00 .8536418096E+00
+ .8784619479E+00 .9027180431E+00 .9259828986E+00 .9474386377E+00 .9659654726E+00
+ .9804828018E+00 .9904478494E+00 .9962015381E+00 .9988580112E+00 .9997707315E+00
+ .9999770680E+00 .2210740672E+00 .3366678491E+00 .4167221027E+00 .4789435245E+00
+ .5304846546E+00 .5749555515E+00 .6144408551E+00 .6502605524E+00 .6833100816E+00
+ .7142314596E+00 .7435072041E+00 .7715149487E+00 .7985586138E+00 .8248801390E+00
+ .8506470080E+00 .8759056900E+00 .9004974109E+00 .9239605967E+00 .9454904287E+00
+ .9640530633E+00 .9786996456E+00 .9889772986E+00 .9951923647E+00 .9983144438E+00
+ .9995571357E+00 .9999228452E+00 .9999933400E+00 .2178648986E+00 .3318297870E+00
+ .4107485356E+00 .4720664926E+00 .5228330196E+00 .5666062750E+00 .6054403685E+00
+ .6406349958E+00 .6730705982E+00 .7033770085E+00 .7320260664E+00 .7593859367E+00
+ .7857538152E+00 .8113732966E+00 .8364353538E+00 .8610556519E+00 .8852191360E+00
+ .9086939238E+00 .9309477034E+00 .9511406836E+00 .9682786240E+00 .9815382606E+00
+ .9906350221E+00 .9960023545E+00 .9986298288E+00 .9996483329E+00 .9999401776E+00
+ .9999949588E+00 .2179975083E+00 .3316172603E+00 .4101491350E+00 .4710785395E+00
+ .5214584490E+00 .5648443281E+00 .6032863074E+00 .6380798063E+00 .6701007707E+00
+ .6999742298E+00 .7281667786E+00 .7550408132E+00 .7808875386E+00 .8059458213E+00
+ .8304075155E+00 .8544043881E+00 .8779687246E+00 .9009649937E+00 .9230106123E+00
+ .9434374168E+00 .9613669933E+00 .9759412171E+00 .9866485262E+00 .9935759025E+00
+ .9974104845E+00 .9991649526E+00 .9997989381E+00 .9999679855E+00 .9999974791E+00
+ .2167316546E+00 .3298584630E+00 .4080510417E+00 .4686952644E+00 .5188109416E+00
+ .5619380865E+00 .6001178169E+00 .6346392570E+00 .6663731859E+00 .6959398052E+00
+ .7238007954E+00 .7503133012E+00 .7757630028E+00 .8003838699E+00 .8243664071E+00
+ .8478514335E+00 .8709030041E+00 .8934558439E+00 .9152456157E+00 .9357559835E+00
+ .9542411564E+00 .9698755217E+00 .9820182571E+00 .9904830235E+00 .9956517674E+00
+ .9983415697E+00 .9994954197E+00 .9998856244E+00 .9999828834E+00 .9999987347E+00
+ .2159120505E+00 .3275372039E+00 .4052040340E+00 .4654840003E+00 .5152802681E+00
+ .5581023719E+00 .5959796837E+00 .6301950286E+00 .6616146938E+00 .6908549235E+00
+ .7183735364E+00 .7445088013E+00 .7695567188E+00 .7937539033E+00 .8172868572E+00
+ .8402984442E+00 .8628698165E+00 .8849816344E+00 .9064597679E+00 .9269248801E+00
+ .9457861604E+00 .9622988759E+00 .9757644760E+00 .9858585338E+00 .9926628192E+00
+ .9966991265E+00 .9987533536E+00 .9996220059E+00 .9999140356E+00 .9999870064E+00
+ .9999990238E+00 .2150924464E+00 .3258480444E+00 .4030160833E+00 .4628921533E+00
+ .5123260979E+00 .5548074550E+00 .5923549971E+00 .6262445971E+00 .6573372627E+00
+ .6862447281E+00 .7134205149E+00 .7392134203E+00 .7639005022E+00 .7877077640E+00
+ .8108219259E+00 .8333932745E+00 .8555267399E+00 .8772255481E+00 .8984074932E+00
+ .9187837988E+00 .9378638152E+00 .9550022359E+00 .9695371755E+00 .9809888274E+00
+ .9892351951E+00 .9945719426E+00 .9976184168E+00 .9991181353E+00 .9997360978E+00
+ .9999403314E+00 .9999909680E+00 .9999993159E+00 .2142728422E+00 .3247335207E+00
+ .4014272839E+00 .4608634285E+00 .5098960326E+00 .5520041821E+00 .5891970893E+00
+ .6227430908E+00 .6534971738E+00 .6820660193E+00 .7088986310E+00 .7343395768E+00
+ .7586376984E+00 .7820500892E+00 .8047580970E+00 .8269098011E+00 .8486135360E+00
+ .8699177291E+00 .8907744027E+00 .9109935621E+00 .9302070992E+00 .9478756678E+00
+ .9633671438E+00 .9760305366E+00 .9856089586E+00 .9921903856E+00 .9962350065E+00
+ .9984212803E+00 .9994401847E+00 .9998388313E+00 .9999647042E+00 .9999947827E+00
+ .9999996108E+00 .2134532381E+00 .3241429364E+00 .4003847766E+00 .4593481409E+00
+ .5079438376E+00 .5496491813E+00 .5864647810E+00 .6196509017E+00 .6500558515E+00
+ .6782807565E+00 .7047698548E+00 .7298634522E+00 .7538306303E+00 .7768901603E+00
+ .7992236402E+00 .8209819541E+00 .8422836858E+00 .8632020463E+00 .8837366630E+00
+ .9037711000E+00 .9230282796E+00 .9410511303E+00 .9572435645E+00 .9709919402E+00
+ .9818446762E+00 .9896782038E+00 .9947612961E+00 .9976737230E+00 .9991179907E+00
+ .9997232738E+00 .9999312085E+00 .9999873239E+00 .9999984635E+00 .9999999082E+00
+ .2053791509E+00 .3128720467E+00 .3872555849E+00 .4449612530E+00 .4926329767E+00
+ .5336237477E+00 .5698669187E+00 .6025825485E+00 .6325931181E+00 .6604821773E+00
+ .6866814430E+00 .7115220076E+00 .7352660295E+00 .7581272156E+00 .7802843542E+00
+ .8018896232E+00 .8230714795E+00 .8439299560E+00 .8645204589E+00 .8848225464E+00
+ .9046954806E+00 .9238341820E+00 .9417539015E+00 .9578378383E+00 .9714645906E+00
+ .9821890049E+00 .9899028254E+00 .9948898192E+00 .9977368756E+00 .9991440044E+00
+ .9997319867E+00 .9999334826E+00 .9999877570E+00 .9999985170E+00 .9999999114E+00
+ .2089859989E+00 .3176226001E+00 .3924938466E+00 .4503961692E+00 .4981007328E+00
+ .5390173704E+00 .5751085587E+00 .6076104448E+00 .6373546458E+00 .6649297650E+00
+ .6907698785E+00 .7152064697E+00 .7385005599E+00 .7608634260E+00 .7824703086E+00
+ .8034691354E+00 .8239845181E+00 .8441156204E+00 .8639249439E+00 .8834148637E+00
+ .9024920009E+00 .9209279951E+00 .9383372505E+00 .9542000876E+00 .9679517411E+00
+ .9791277770E+00 .9875160994E+00 .9932434550E+00 .9967457956E+00 .9986320880E+00
+ .9995099505E+00 .9998549172E+00 .9999659964E+00 .9999940954E+00 .9999993257E+00
+ .9999999621E+00 .2067350976E+00 .3140405085E+00 .3884039468E+00 .4460049247E+00
+ .4934939972E+00 .5342397840E+00 .5701860358E+00 .6025587030E+00 .6321830704E+00
+ .6596433925E+00 .6853704693E+00 .7096930732E+00 .7328698134E+00 .7551096977E+00
+ .7765857439E+00 .7974437612E+00 .8178067790E+00 .8377741390E+00 .8574129717E+00
+ .8767394470E+00 .8956894097E+00 .9140841824E+00 .9316065927E+00 .9478095990E+00
+ .9621768663E+00 .9742353906E+00 .9836896595E+00 .9905229471E+00 .9950151727E+00
+ .9976635989E+00 .9990422134E+00 .9996644279E+00 .9999025114E+00 .9999774952E+00
+ .9999961357E+00 .9999995619E+00 .9999999754E+00 .2044841962E+00 .3113980429E+00
+ .3852684783E+00 .4424827477E+00 .4896665700E+00 .5301625307E+00 .5658967029E+00
+ .5980832192E+00 .6275391702E+00 .6548428735E+00 .6804205950E+00 .7045974294E+00
+ .7276288525E+00 .7497211039E+00 .7710447412E+00 .7917436386E+00 .8119401780E+00
+ .8317360537E+00 .8512068232E+00 .8703875090E+00 .8892474966E+00 .9076573793E+00
+ .9253586424E+00 .9419560717E+00 .9569551016E+00 .9698540436E+00 .9802737412E+00
+ .9880778596E+00 .9934277873E+00 .9967408498E+00 .9985687844E+00 .9994536669E+00
+ .9998228289E+00 .9999526364E+00 .9999899951E+00 .9999984364E+00 .9999998395E+00
+ .9999999919E+00 .2037126614E+00 .3097428738E+00 .3828420223E+00 .4393690176E+00
+ .4859240871E+00 .5258324956E+00 .5610083428E+00 .5926570755E+00 .6215891673E+00
+ .6483776395E+00 .6734442849E+00 .6971102384E+00 .7196273403E+00 .7411983816E+00
+ .7619906232E+00 .7821450296E+00 .8017822915E+00 .8210056833E+00 .8398998069E+00
+ .8585232604E+00 .8768928994E+00 .8949588957E+00 .9125744276E+00 .9294712757E+00
+ .9452595001E+00 .9594693059E+00 .9716403656E+00 .9814395503E+00 .9887644724E+00
+ .9937853818E+00 .9969014318E+00 .9986287966E+00 .9994712496E+00 .9998263462E+00
+ .9999528631E+00 .9999898636E+00 .9999983831E+00 .9999998301E+00 .9999999912E+00
+ .2026463810E+00 .3072877374E+00 .3799067560E+00 .4361216718E+00 .4824194451E+00
+ .5220940090E+00 .5570307633E+00 .5884196204E+00 .6171098710E+00 .6436657325E+00
+ .6685032774E+00 .6919394484E+00 .7142141110E+00 .7355330897E+00 .7560676305E+00
+ .7759555141E+00 .7953146864E+00 .8142467083E+00 .8328335257E+00 .8511436158E+00
+ .8692089071E+00 .8870093360E+00 .9044484204E+00 .9213263489E+00 .9373134903E+00
+ .9520166618E+00 .9650010077E+00 .9758914481E+00 .9844708087E+00 .9907350441E+00
+ .9949320300E+00 .9974947304E+00 .9988977608E+00 .9995762704E+00 .9998609539E+00
+ .9999620264E+00 .9999917383E+00 .9999986621E+00 .9999998568E+00 .9999999924E+00
+ .2015801006E+00 .3050931568E+00 .3772487494E+00 .4331401040E+00 .4791668683E+00
+ .5185962121E+00 .5533184965E+00 .5845140532E+00 .6129514807E+00 .6392665871E+00
+ .6638694327E+00 .6870726287E+00 .7091213094E+00 .7302124849E+00 .7505022135E+00
+ .7701245249E+00 .7892089160E+00 .8078551272E+00 .8261489653E+00 .8441600386E+00
+ .8619355040E+00 .8794767735E+00 .8967242946E+00 .9135387290E+00 .9296693792E+00
+ .9447667819E+00 .9584210267E+00 .9702343758E+00 .9798674448E+00 .9872425505E+00
+ .9925040182E+00 .9959595921E+00 .9980269181E+00 .9991399858E+00 .9996715692E+00
+ .9998914824E+00 .9999700582E+00 .9999934038E+00 .9999989146E+00 .9999998816E+00
+ .9999999936E+00 .2005138202E+00 .3031404815E+00 .3748481960E+00 .4304053315E+00
+ .4761483490E+00 .5153218859E+00 .5498053880E+00 .5807855390E+00 .6090607505E+00
+ .6351578071E+00 .6595207768E+00 .6824881089E+00 .7043013883E+00 .7251547215E+00
+ .7452075562E+00 .7645651247E+00 .7833808923E+00 .8017493460E+00 .8197504073E+00
+ .8374656072E+00 .8549454146E+00 .8722105614E+00 .8892351305E+00 .9059254865E+00
+ .9221006996E+00 .9374842318E+00 .9516655631E+00 .9642677610E+00 .9749572371E+00
+ .9834068898E+00 .9897139784E+00 .9940857987E+00 .9968765747E+00 .9985023540E+00
+ .9993535482E+00 .9997515567E+00 .9999174918E+00 .9999770392E+00 .9999948751E+00
+ .9999991425E+00 .9999999047E+00 .9999999947E+00 .1994475399E+00 .3014128493E+00
+ .3726871320E+00 .4279001376E+00 .4733475550E+00 .5122554654E+00 .5464929144E+00
+ .5772400312E+00 .6052906709E+00 .6312056565E+00 .6553970196E+00 .6781498793E+00
+ .6996765476E+00 .7202610904E+00 .7400556044E+00 .7591883352E+00 .7777692859E+00
+ .7958941174E+00 .8136465122E+00 .8310984382E+00 .8483077061E+00 .8653114702E+00
+ .8821021645E+00 .8986159642E+00 .9147199613E+00 .9301807535E+00 .9446810934E+00
+ .9578540882E+00 .9693437713E+00 .9788792424E+00 .9863402651E+00 .9917914077E+00
+ .9954712881E+00 .9976671714E+00 .9988921491E+00 .9995242222E+00 .9998181763E+00
+ .9999395357E+00 .9999830428E+00 .9999961657E+00 .9999993477E+00 .9999999261E+00
+ .9999999958E+00 .1983812595E+00 .2998949185E+00 .3707492414E+00 .4256088673E+00
+ .4707496579E+00 .5093827638E+00 .5433673931E+00 .5738769516E+00 .6017005675E+00
+ .6273771915E+00 .6512828262E+00 .6738058929E+00 .6951797204E+00 .7155922935E+00
+ .7351981768E+00 .7541199034E+00 .7724654850E+00 .7903458620E+00 .8078369006E+00
+ .8250126463E+00 .8419446014E+00 .8586734847E+00 .8752122157E+00 .8915305783E+00
+ .9075368077E+00 .9230611536E+00 .9378494193E+00 .9515351283E+00 .9637397112E+00
+ .9741625052E+00 .9825494062E+00 .9889072165E+00 .9934256554E+00 .9964025729E+00
+ .9982038468E+00 .9991934500E+00 .9996634684E+00 .9998729122E+00 .9999578842E+00
+ .9999881357E+00 .9999972879E+00 .9999995315E+00 .9999999460E+00 .9999999969E+00
+ .1973149791E+00 .2985727200E+00 .3690196309E+00 .4235172458E+00 .4683411113E+00
+ .5066908817E+00 .5404163547E+00 .5706841529E+00 .5982331393E+00 .6236454541E+00
+ .6473696275E+00 .6697044270E+00 .6908844712E+00 .7110979548E+00 .7304991084E+00
+ .7492167308E+00 .7673390695E+00 .7849900964E+00 .8022511473E+00 .8191939280E+00
+ .8358799806E+00 .8523577675E+00 .8686560301E+00 .8847635037E+00 .9006170459E+00
+ .9160891736E+00 .9309636016E+00 .9449481447E+00 .9577042840E+00 .9688998152E+00
+ .9782741086E+00 .9856156407E+00 .9910553310E+00 .9948155914E+00 .9972237222E+00
+ .9986410698E+00 .9994001256E+00 .9997652599E+00 .9999165555E+00 .9999727839E+00
+ .9999923785E+00 .9999982530E+00 .9999996955E+00 .9999999644E+00 .9999999979E+00
+ .1962486987E+00 .2974334689E+00 .3674847266E+00 .4216122821E+00 .4661095795E+00
+ .5041679983E+00 .5376284274E+00 .5676217665E+00 .5949394606E+00 .6201672446E+00
+ .6437004238E+00 .6658402279E+00 .6868221084E+00 .7068342581E+00 .7260149988E+00
+ .7445111327E+00 .7624328988E+00 .7798728866E+00 .7969123089E+00 .8136229371E+00
+ .8300654997E+00 .8462905129E+00 .8623374465E+00 .8782138700E+00 .8938865907E+00
+ .9092648381E+00 .9241856297E+00 .9383934679E+00 .9515770887E+00 .9634063117E+00
+ .9735831813E+00 .9819099562E+00 .9883376208E+00 .9929744158E+00 .9960510901E+00
+ .9979528767E+00 .9990306034E+00 .9995856785E+00 .9998426354E+00 .9999479669E+00
+ .9999844595E+00 .9999958268E+00 .9999990713E+00 .9999998409E+00 .9999999816E+00
+ .9999999989E+00 .1951824184E+00 .2964654870E+00 .3661320972E+00 .4198820316E+00
+ .4640437592E+00 .5018033542E+00 .5349931900E+00 .5647659034E+00 .5918951363E+00
+ .6169263751E+00 .6402596777E+00 .6621981570E+00 .6829777538E+00 .7027864660E+00
+ .7217774025E+00 .7400778122E+00 .7577953817E+00 .7750227917E+00 .7918410812E+00
+ .8083219100E+00 .8245285309E+00 .8405149958E+00 .8563227147E+00 .8719732053E+00
+ .8874561891E+00 .9027135652E+00 .9176223926E+00 .9319832797E+00 .9455228994E+00
+ .9579183876E+00 .9688454965E+00 .9780424093E+00 .9853712781E+00 .9908557600E+00
+ .9946790887E+00 .9971420001E+00 .9985959198E+00 .9993754966E+00 .9997514558E+00
+ .9999127060E+00 .9999733982E+00 .9999931170E+00 .9999985311E+00 .9999997520E+00
+ .9999999690E+00 .9999999974E+00 .9999999999E+00 .1946013215E+00 .2952601664E+00
+ .3647362121E+00 .4183831245E+00 .4624741958E+00 .5001794689E+00 .5333248630E+00
+ .5630597474E+00 .5901558501E+00 .6151574653E+00 .6384637793E+00 .6603771798E+00
+ .6811330665E+00 .7009190384E+00 .7198878141E+00 .7381662317E+00 .7558616065E+00
+ .7730662869E+00 .7898609551E+00 .8063168505E+00 .8224967376E+00 .8384541141E+00
+ .8542298208E+00 .8698450257E+00 .8852899016E+00 .9005086381E+00 .9153838306E+00
+ .9297261680E+00 .9432772095E+00 .9557319157E+00 .9667822664E+00 .9761747089E+00
+ .9837659537E+00 .9895585728E+00 .9937029686E+00 .9964642350E+00 .9981656185E+00
+ .9991280398E+00 .9996238533E+00 .9998543753E+00 .9999500750E+00 .9999850931E+00
+ .9999962056E+00 .9999992001E+00 .9999998660E+00 .9999999833E+00 .9999999986E+00
+ .9999999999E+00 .1940202246E+00 .2947212972E+00 .3640146997E+00 .4174963645E+00
+ .4614519454E+00 .4990459172E+00 .5320983091E+00 .5617539606E+00 .5887812852E+00
+ .6137221903E+00 .6369740438E+00 .6588377648E+00 .6795476090E+00 .6992902862E+00
+ .7182177356E+00 .7364560667E+00 .7541119467E+00 .7712771700E+00 .7880319552E+00
+ .8044472412E+00 .8205858798E+00 .8365022557E+00 .8522395246E+00 .8678233941E+00
+ .8832515239E+00 .8984786881E+00 .9134001083E+00 .9278384624E+00 .9415426275E+00
+ .9542060622E+00 .9655081130E+00 .9751726991E+00 .9830291878E+00 .9890552190E+00
+ .9933850340E+00 .9962791596E+00 .9980663822E+00 .9990788820E+00 .9996012061E+00
+ .9998445900E+00 .9999460919E+00 .9999835760E+00 .9999956769E+00 .9999990376E+00
+ .9999998239E+00 .9999999746E+00 .9999999973E+00 .9999999998E+00 .1000000000E+01
+ .1881384766E+00 .2865114597E+00 .3544143737E+00 .4069184241E+00 .4501225799E+00
+ .4871050505E+00 .5196393421E+00 .5488424490E+00 .5754649170E+00 .6000364625E+00
+ .6229456038E+00 .6444866438E+00 .6648888077E+00 .6843347560E+00 .7029729593E+00
+ .7209265163E+00 .7382994782E+00 .7551812932E+00 .7716500548E+00 .7877750098E+00
+ .8036183767E+00 .8192362712E+00 .8346783703E+00 .8499856306E+00 .8651850210E+00
+ .8802801918E+00 .8952377628E+00 .9099707845E+00 .9243237962E+00 .9380667848E+00
+ .9509063162E+00 .9625191220E+00 .9726058865E+00 .9809531674E+00 .9874842222E+00
+ .9922800324E+00 .9955615376E+00 .9976390422E+00 .9988472477E+00 .9994878408E+00
+ .9997949491E+00 .9999268499E+00 .9999770579E+00 .9999937781E+00 .9999985716E+00
+ .9999997303E+00 .9999999598E+00 .9999999956E+00 .9999999997E+00 .1000000000E+01
+ .1900833807E+00 .2890576310E+00 .3572469285E+00 .4099084653E+00 .4532027837E+00
+ .4902348653E+00 .5227918972E+00 .5519986150E+00 .5786101503E+00 .6031591592E+00
+ .6260362009E+00 .6475368680E+00 .6678911190E+00 .6872821221E+00 .7058587203E+00
+ .7237441438E+00 .7410423376E+00 .7578425222E+00 .7742224813E+00 .7902510025E+00
+ .8059896129E+00 .8214934348E+00 .8368107357E+00 .8519804846E+00 .8670269667E+00
+ .8819505785E+00 .8967147292E+00 .9112305967E+00 .9253441101E+00 .9388319387E+00
+ .9514137438E+00 .9627848380E+00 .9726664396E+00 .9808621627E+00 .9873035249E+00
+ .9920682150E+00 .9953636158E+00 .9974810447E+00 .9987368848E+00 .9994198258E+00
+ .9997579314E+00 .9999091184E+00 .9999696339E+00 .9999910887E+00 .9999977405E+00
+ .9999995153E+00 .9999999145E+00 .9999999881E+00 .9999999988E+00 .9999999999E+00
+ .1000000000E+01 .1904805627E+00 .2894442076E+00 .3575502724E+00 .4101057970E+00
+ .4532847821E+00 .4901968434E+00 .5226309092E+00 .5517123315E+00 .5781963050E+00
+ .6026152940E+00 .6253595911E+00 .6467244252E+00 .6669392648E+00 .6861867470E+00
+ .7046151827E+00 .7223472025E+00 .7394860424E+00 .7561201347E+00 .7723264243E+00
+ .7881728069E+00 .8037199020E+00 .8190220727E+00 .8341273469E+00 .8490756596E+00
+ .8638945918E+00 .8785917426E+00 .8931433960E+00 .9074805470E+00 .9214755925E+00
+ .9349353604E+00 .9476072719E+00 .9592036892E+00 .9694441921E+00 .9781079080E+00
+ .9850814596E+00 .9903865718E+00 .9941769399E+00 .9967048491E+00 .9982691260E+00
+ .9991617639E+00 .9996284855E+00 .9998505344E+00 .9999459220E+00 .9999825945E+00
+ .9999950813E+00 .9999987993E+00 .9999997521E+00 .9999999579E+00 .9999999944E+00
+ .9999999994E+00 .1000000000E+01 .1000000000E+01 .1915290602E+00 .2907064429E+00
+ .3588461202E+00 .4113670910E+00 .4544780613E+00 .4913027907E+00 .5236369104E+00
+ .5526092722E+00 .5789769541E+00 .6032734058E+00 .6258894485E+00 .6471205501E+00
+ .6671961449E+00 .6862986513E+00 .7045760789E+00 .7221506683E+00 .7391251272E+00
+ .7555872321E+00 .7716131851E+00 .7872700648E+00 .8026176149E+00 .8177093614E+00
+ .8325927882E+00 .8473080728E+00 .8618846640E+00 .8763348975E+00 .8906441863E+00
+ .9047584129E+00 .9185710300E+00 .9319145814E+00 .9445627664E+00 .9562483510E+00
+ .9666982553E+00 .9756806238E+00 .9830521560E+00 .9887909883E+00 .9930034906E+00
+ .9959019873E+00 .9977608668E+00 .9988657278E+00 .9994707973E+00 .9997742261E+00
+ .9999126242E+00 .9999696056E+00 .9999905983E+00 .9999974474E+00 .9999994015E+00
+ .9999998813E+00 .9999999807E+00 .9999999975E+00 .9999999998E+00 .1000000000E+01
+ .1000000000E+01 .1900687978E+00 .2883811977E+00 .3558443859E+00 .4077807389E+00
+ .4503604125E+00 .4866874636E+00 .5185458724E+00 .5470567923E+00 .5729718445E+00
+ .5968204390E+00 .6189901335E+00 .6397735608E+00 .6593977150E+00 .6780428781E+00
+ .6958549972E+00 .7129541965E+00 .7294410483E+00 .7454011938E+00 .7609086275E+00
+ .7760281049E+00 .7908170493E+00 .8053270478E+00 .8196048350E+00 .8336926092E+00
+ .8476273862E+00 .8614388380E+00 .8751448364E+00 .8887439860E+00 .9022050482E+00
+ .9154544972E+00 .9283654122E+00 .9407528310E+00 .9523813512E+00 .9629888694E+00
+ .9723254697E+00 .9801998972E+00 .9865207407E+00 .9913186738E+00 .9947413712E+00
+ .9970222693E+00 .9984337424E+00 .9992399055E+00 .9996621625E+00 .9998635925E+00
+ .9999504298E+00 .9999839628E+00 .9999954410E+00 .9999988796E+00 .9999997669E+00
+ .9999999601E+00 .9999999946E+00 .9999999995E+00 .1000000000E+01 .1000000000E+01
+ .1879571048E+00 .2856632510E+00 .3529172447E+00 .4048175858E+00 .4474558379E+00
+ .4839006679E+00 .5159176326E+00 .5446174980E+00 .5707456079E+00 .5948273056E+00
+ .6172476494E+00 .6382978831E+00 .6582041163E+00 .6771460459E+00 .6952695001E+00
+ .7126949371E+00 .7295234729E+00 .7458413945E+00 .7617235458E+00 .7772358027E+00
+ .7924368813E+00 .8073796091E+00 .8221115460E+00 .8366745997E+00 .8511030859E+00
+ .8654195280E+00 .8796275363E+00 .8937016340E+00 .9075751101E+00 .9211288083E+00
+ .9341855802E+00 .9465158788E+00 .9578584696E+00 .9679560340E+00 .9765995143E+00
+ .9836698703E+00 .9891644011E+00 .9931985608E+00 .9959822321E+00 .9977782211E+00
+ .9988561858E+00 .9994549706E+00 .9997611258E+00 .9999043678E+00 .9999652985E+00
+ .9999886888E+00 .9999967229E+00 .9999991669E+00 .9999998171E+00 .9999999661E+00
+ .9999999948E+00 .9999999994E+00 .9999999999E+00 .1000000000E+01 .1000000000E+01
+ .5633596892E+00 .4235470933E+00 .7123019817E+00 .3529771612E+00 .5680046648E+00
+ .7662228666E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .3264031686E+00 .5103746276E+00 .6516433313E+00 .7798075886E+00 .9052116818E+00
+ .3026030729E+00 .4694927123E+00 .5937064713E+00 .7013601301E+00 .8060422940E+00
+ .9138710076E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .0000000000E+00 .0000000000E+00 .0000000000E+00 .2799075011E+00 .4317812338E+00
+ .5410057046E+00 .6307344790E+00 .7111607406E+00 .7887435338E+00 .8681238255E+00
+ .9467192316E+00 .2688828988E+00 .4135717964E+00 .5165804840E+00 .5999993829E+00
+ .6732012212E+00 .7416655853E+00 .8097022797E+00 .8807233473E+00 .9517477229E+00
+ .2602787193E+00 .3995737111E+00 .4979802380E+00 .5768442642E+00 .6450384153E+00
+ .7074543719E+00 .7675857752E+00 .8286240686E+00 .8930728697E+00 .9572705588E+00
+ .2541775087E+00 .3900624124E+00 .4854783971E+00 .5613378193E+00 .6262331435E+00
+ .6847420105E+00 .7398849763E+00 .7941627752E+00 .8500027756E+00 .9087506169E+00
+ .9651667688E+00 .2476176938E+00 .3794997752E+00 .4716538014E+00 .5444656512E+00
+ .6062509287E+00 .6613513902E+00 .7124965029E+00 .7617571540E+00 .8110657465E+00
+ .8624153687E+00 .9167067511E+00 .9685286875E+00 .2434311283E+00 .3735853202E+00
+ .4641715637E+00 .5353815831E+00 .5954208817E+00 .6485202846E+00 .6972610388E+00
+ .7434826440E+00 .7887418790E+00 .8345826590E+00 .8824128180E+00 .9318315270E+00
+ .9759953721E+00 .2390939745E+00 .3674660450E+00 .4565229014E+00 .5262392627E+00
+ .5847168386E+00 .6360992063E+00 .6828671588E+00 .7267197177E+00 .7689970403E+00
+ .8109322693E+00 .8537668749E+00 .8983723786E+00 .9433219498E+00 .9811987813E+00
+ .2351105073E+00 .3627682994E+00 .4511142442E+00 .5200314340E+00 .5775927043E+00
+ .6279045888E+00 .6733954398E+00 .7156859263E+00 .7559936730E+00 .7953599575E+00
+ .8347825690E+00 .8751577511E+00 .9165725955E+00 .9562897281E+00 .9867583398E+00
+ .2305505748E+00 .3549146289E+00 .4407560177E+00 .5075254184E+00 .5630986004E+00
+ .6114666186E+00 .6549699740E+00 .6951442299E+00 .7331064668E+00 .7697647971E+00
+ .8059555743E+00 .8425342236E+00 .8803134763E+00 .9194120476E+00 .9573366230E+00
+ .9868890546E+00 .2267221837E+00 .3499443709E+00 .4348475921E+00 .5007192709E+00
+ .5553803468E+00 .6027835898E+00 .6452334686E+00 .6842241622E+00 .7208185938E+00
+ .7558476581E+00 .7900332366E+00 .8240756551E+00 .8586902357E+00 .8944356680E+00
+ .9309053006E+00 .9649717135E+00 .9898655197E+00 .2222660667E+00 .3460335353E+00
+ .4312817963E+00 .4972745139E+00 .5518923458E+00 .5991121286E+00 .6412425308E+00
+ .6797679942E+00 .7157281495E+00 .7499135497E+00 .7829808737E+00 .8155290147E+00
+ .8481379961E+00 .8812995427E+00 .9150259486E+00 .9478840313E+00 .9759345010E+00
+ .9938471366E+00 .2254601925E+00 .3427898547E+00 .4240749730E+00 .4874465882E+00
+ .5402130236E+00 .5860697383E+00 .6271666987E+00 .6648879233E+00 .7002020151E+00
+ .7338422406E+00 .7664109479E+00 .7984467686E+00 .8304617796E+00 .8629099400E+00
+ .8959624715E+00 .9289091694E+00 .9592974094E+00 .9828896008E+00 .9961131889E+00
+ .2192667925E+00 .3332137130E+00 .4120922334E+00 .4735241098E+00 .5246058343E+00
+ .5689213232E+00 .6085505188E+00 .6448259175E+00 .6786718756E+00 .7107775828E+00
+ .7416958098E+00 .7719065296E+00 .8018632159E+00 .8320235389E+00 .8628313245E+00
+ .8945355740E+00 .9266421482E+00 .9569859321E+00 .9813560051E+00 .9956046439E+00
+ .2165439227E+00 .3280334204E+00 .4059924426E+00 .4667891829E+00 .5173138921E+00
+ .5610863629E+00 .6001558239E+00 .6358334945E+00 .6690239745E+00 .7003942962E+00
+ .7304693729E+00 .7596858043E+00 .7884600116E+00 .8171937231E+00 .8462711710E+00
+ .8759940956E+00 .9063185839E+00 .9363203310E+00 .9636146724E+00 .9845856441E+00
+ .9964089351E+00 .2138210529E+00 .3241039085E+00 .4011923329E+00 .4612745411E+00
+ .5111604299E+00 .5543270208E+00 .5927962221E+00 .6278583914E+00 .6603993132E+00
+ .6910665342E+00 .7203623141E+00 .7487008249E+00 .7764388727E+00 .8039553350E+00
+ .8315917761E+00 .8596682590E+00 .8883621407E+00 .9173853325E+00 .9454632418E+00
+ .9700150427E+00 .9878627897E+00 .9973027647E+00 .2110981831E+00 .3212620377E+00
+ .3975223786E+00 .4568210292E+00 .5059969489E+00 .5485030159E+00 .5863367015E+00
+ .6207678979E+00 .6526644247E+00 .6826565937E+00 .7112286525E+00 .7387741190E+00
+ .7656325459E+00 .7921163294E+00 .8185305447E+00 .8451790004E+00 .8723257402E+00
+ .9000391712E+00 .9278291367E+00 .9541406490E+00 .9762167880E+00 .9911812732E+00
+ .9982744519E+00 .2114771818E+00 .3210015973E+00 .3964884683E+00 .4549819392E+00
+ .5033379998E+00 .5450086000E+00 .5819849890E+00 .6155285928E+00 .6464970631E+00
+ .6755085944E+00 .7030327506E+00 .7294447325E+00 .7550606378E+00 .7801624809E+00
+ .8050175327E+00 .8298926261E+00 .8550545837E+00 .8807251018E+00 .9069214531E+00
+ .9331090311E+00 .9577503998E+00 .9782441651E+00 .9919946713E+00 .9984453865E+00
+ .2057360379E+00 .3128030574E+00 .3867678975E+00 .4441610629E+00 .4916474684E+00
+ .5325874424E+00 .5689206967E+00 .6018760385E+00 .6322880774E+00 .6607568710E+00
+ .6877362326E+00 .7135860967E+00 .7386061499E+00 .7630593920E+00 .7871900332E+00
+ .8112382400E+00 .8354504096E+00 .8600729807E+00 .8852936068E+00 .9110596479E+00
+ .9367167120E+00 .9605990027E+00 .9800983550E+00 .9928523861E+00 .9986514748E+00
+ .2081133507E+00 .3152150215E+00 .3887270633E+00 .4454823053E+00 .4922342263E+00
+ .5323753766E+00 .5678574072E+00 .5999120364E+00 .6293718177E+00 .6568313749E+00
+ .6827362674E+00 .7074351948E+00 .7312130424E+00 .7543135320E+00 .7769556667E+00
+ .7993469949E+00 .8216954592E+00 .8442183005E+00 .8671382522E+00 .8906363744E+00
+ .9146976083E+00 .9387847822E+00 .9614302215E+00 .9802078746E+00 .9927489436E+00
+ .9985989850E+00 .2024041067E+00 .3078968028E+00 .3807561454E+00 .4372425373E+00
+ .4839192760E+00 .5240960977E+00 .5596821031E+00 .5918844380E+00 .6215203852E+00
+ .6491740565E+00 .6752827978E+00 .7001884846E+00 .7241696176E+00 .7474629227E+00
+ .7702791394E+00 .7928152869E+00 .8152645949E+00 .8378226498E+00 .8606809300E+00
+ .8839835980E+00 .9077036622E+00 .9314020010E+00 .9539360062E+00 .9734080029E+00
+ .9877694011E+00 .9960664255E+00 .9993447071E+00 .1996273325E+00 .3037123807E+00
+ .3755903927E+00 .4312955665E+00 .4773020690E+00 .5168748998E+00 .5518968771E+00
+ .5835576945E+00 .6126618880E+00 .6397832636E+00 .6653498563E+00 .6896944991E+00
+ .7130862800E+00 .7357512975E+00 .7578876932E+00 .7796771577E+00 .8012942532E+00
+ .8229141887E+00 .8447164884E+00 .8668741994E+00 .8895031817E+00 .9125294702E+00
+ .9354493027E+00 .9570688279E+00 .9755184806E+00 .9889048900E+00 .9964912708E+00
+ .9994261899E+00 .1998987644E+00 .3037323386E+00 .3752963560E+00 .4306750478E+00
+ .4763509166E+00 .5155889746E+00 .5502698789E+00 .5815803001E+00 .6103212895E+00
+ .6370629894E+00 .6622292601E+00 .6861479059E+00 .7090821595E+00 .7312511279E+00
+ .7528441753E+00 .7740318762E+00 .7949746771E+00 .8158300441E+00 .8367574039E+00
+ .8579156731E+00 .8794387581E+00 .9013604670E+00 .9234564640E+00 .9450171600E+00
+ .9646975498E+00 .9807341706E+00 .9917142504E+00 .9975321124E+00 .9996222749E+00
+ .1986693915E+00 .3020335150E+00 .3732802192E+00 .4283962932E+00 .4738320677E+00
+ .5128377894E+00 .5472857333E+00 .5783568828E+00 .6068476621E+00 .6333241403E+00
+ .6582062613E+00 .6818174639E+00 .7044159606E+00 .7262150862E+00 .7473971931E+00
+ .7681240416E+00 .7885449796E+00 .8088035483E+00 .8290425920E+00 .8494055122E+00
+ .8700255437E+00 .8909849876E+00 .9122172691E+00 .9333379808E+00 .9534610981E+00
+ .9711803386E+00 .9849479828E+00 .9938493931E+00 .9982703194E+00 .9997513175E+00
+ .1980316815E+00 .3000683185E+00 .3708634747E+00 .4256664467E+00 .4708247503E+00
+ .5095627828E+00 .5437432504E+00 .5745421758E+00 .6027524182E+00 .6289368019E+00
+ .6535121851E+00 .6767844742E+00 .6990215550E+00 .7204387640E+00 .7412117682E+00
+ .7614946337E+00 .7814277181E+00 .8011434791E+00 .8207715446E+00 .8404409764E+00
+ .8602760079E+00 .8803762018E+00 .9007521459E+00 .9212072823E+00 .9412042301E+00
+ .9597687348E+00 .9756006526E+00 .9874970451E+00 .9949636282E+00 .9985934639E+00
+ .9997973028E+00 .1973939714E+00 .2986821644E+00 .3690496196E+00 .4235027630E+00
+ .4683442004E+00 .5067819696E+00 .5406701782E+00 .5711792311E+00 .5990976831E+00
+ .6249845891E+00 .6492532577E+00 .6722202813E+00 .6941360348E+00 .7152048020E+00
+ .7355984161E+00 .7554658281E+00 .7749404111E+00 .7941368640E+00 .8131981525E+00
+ .8322418403E+00 .8513838499E+00 .8707269652E+00 .8903256839E+00 .9101114761E+00
+ .9297760414E+00 .9486544618E+00 .9657131527E+00 .9797642453E+00 .9899153690E+00
+ .9960401489E+00 .9989161221E+00 .9998456874E+00 .1967562613E+00 .2978224125E+00
+ .3677838537E+00 .4218537872E+00 .4663425402E+00 .5044504322E+00 .5380238514E+00
+ .5682269965E+00 .5958434231E+00 .6214279033E+00 .6453899315E+00 .6680425878E+00
+ .6896096695E+00 .7103243298E+00 .7303520966E+00 .7498360426E+00 .7689034423E+00
+ .7876713839E+00 .8062509577E+00 .8247509190E+00 .8432787770E+00 .8619371070E+00
+ .8808065420E+00 .8999104435E+00 .9190999880E+00 .9379618401E+00 .9557265158E+00
+ .9713273697E+00 .9836944143E+00 .9922148391E+00 .9970823884E+00 .9992383343E+00
+ .9998962521E+00 .1961185513E+00 .2974426215E+00 .3670178227E+00 .4206741058E+00
+ .4647775237E+00 .5025285360E+00 .5357666223E+00 .5656492353E+00 .5929543142E+00
+ .6182318735E+00 .6418873107E+00 .6642301413E+00 .6855038275E+00 .7059053661E+00
+ .7255988322E+00 .7447247185E+00 .7634066561E+00 .7817567806E+00 .7998801684E+00
+ .8178783860E+00 .8358519199E+00 .8538998629E+00 .8721120817E+00 .8905442888E+00
+ .9091626430E+00 .9277504447E+00 .9457984711E+00 .9624537739E+00 .9766405231E+00
+ .9874117814E+00 .9944059432E+00 .9980933743E+00 .9995601465E+00 .9999488058E+00
+ .1887432101E+00 .2871357633E+00 .3549955436E+00 .4074793968E+00 .4507103245E+00
+ .4877755850E+00 .5204532734E+00 .5498641744E+00 .5767626066E+00 .6016821562E+00
+ .6250163880E+00 .6470661690E+00 .6680680802E+00 .6882131525E+00 .7076603232E+00
+ .7265456023E+00 .7449882552E+00 .7630958047E+00 .7809684416E+00 .7987026304E+00
+ .8163940203E+00 .8341395645E+00 .8520370463E+00 .8701769858E+00 .8886171400E+00
+ .9073258589E+00 .9260862833E+00 .9443824643E+00 .9613427953E+00 .9758572865E+00
+ .9869328957E+00 .9941642209E+00 .9979997633E+00 .9995356256E+00 .9999455709E+00
+ .1921193091E+00 .2916224587E+00 .3599885626E+00 .4127123549E+00 .4560349985E+00
+ .4930969270E+00 .5257038449E+00 .5549919187E+00 .5817246153E+00 .6064412057E+00
+ .6295382822E+00 .6513179384E+00 .6720171183E+00 .6918263376E+00 .7109028071E+00
+ .7293798110E+00 .7473731273E+00 .7649857688E+00 .7823120008E+00 .7994407406E+00
+ .8164582834E+00 .8334503486E+00 .8505025784E+00 .8676965189E+00 .8850947342E+00
+ .9027049894E+00 .9204140240E+00 .9378958032E+00 .9545342705E+00 .9694425762E+00
+ .9816607751E+00 .9905177525E+00 .9959759577E+00 .9986953042E+00 .9997145395E+00
+ .9999685605E+00 .1900102405E+00 .2882611356E+00 .3561363907E+00 .4085601533E+00
+ .4516619569E+00 .4885440453E+00 .5209948047E+00 .5501408991E+00 .5767398481E+00
+ .6013269789E+00 .6242958888E+00 .6459460125E+00 .6665120333E+00 .6861825373E+00
+ .7051126849E+00 .7234334067E+00 .7412579750E+00 .7586866880E+00 .7758105843E+00
+ .7927146422E+00 .8094804443E+00 .8261881858E+00 .8429175201E+00 .8597453892E+00
+ .8767365620E+00 .8939196975E+00 .9112408857E+00 .9284934969E+00 .9452439106E+00
+ .9608040402E+00 .9743192769E+00 .9850049622E+00 .9924611710E+00 .9968861005E+00
+ .9990149037E+00 .9997888988E+00 .9999771183E+00 .1879011718E+00 .2857674954E+00
+ .3531663739E+00 .4052126070E+00 .4480123169E+00 .4846434964E+00 .5168781623E+00
+ .5458319606E+00 .5722547488E+00 .5966764811E+00 .6194866304E+00 .6409811075E+00
+ .6613916929E+00 .6809045768E+00 .6996725597E+00 .7178240369E+00 .7354696888E+00
+ .7527071271E+00 .7696243429E+00 .7863027149E+00 .8028196477E+00 .8192506618E+00
+ .8356707444E+00 .8521540445E+00 .8687692004E+00 .8855649161E+00 .9025380157E+00
+ .9195778222E+00 .9363927358E+00 .9524508513E+00 .9669950934E+00 .9791919373E+00
+ .9884072593E+00 .9944888277E+00 .9978675243E+00 .9993740099E+00 .9998766996E+00
+ .9999878298E+00 .1874852662E+00 .2846914762E+00 .3514911430E+00 .4029954247E+00
+ .4452956500E+00 .4814582148E+00 .5132466035E+00 .5417700467E+00 .5677734951E+00
+ .5917829456E+00 .6141844142E+00 .6352707451E+00 .6552710319E+00 .6743689308E+00
+ .6927145856E+00 .7104335775E+00 .7276336959E+00 .7444094821E+00 .7608454264E+00
+ .7770188255E+00 .7930023960E+00 .8088663578E+00 .8246800102E+00 .8405127047E+00
+ .8564330877E+00 .8725037712E+00 .8887663548E+00 .9052099366E+00 .9217183585E+00
+ .9380029044E+00 .9535503059E+00 .9676401998E+00 .9794836160E+00 .9884762317E+00
+ .9944600365E+00 .9978248307E+00 .9993496592E+00 .9998690218E+00 .9999867284E+00
+ .1865738463E+00 .2825399162E+00 .3489253249E+00 .4001640253E+00 .4422456744E+00
+ .4782091676E+00 .5097922880E+00 .5380903739E+00 .5638847168E+00 .5876934739E+00
+ .6098978293E+00 .6307870455E+00 .6505788623E+00 .6694600096E+00 .6875850356E+00
+ .7050768160E+00 .7220402991E+00 .7385672541E+00 .7547356567E+00 .7706246628E+00
+ .7863039107E+00 .8018392917E+00 .8172952445E+00 .8327359815E+00 .8482273019E+00
+ .8638298690E+00 .8795932200E+00 .8955360661E+00 .9116110701E+00 .9276494704E+00
+ .9432994285E+00 .9580205749E+00 .9711247658E+00 .9819290083E+00 .9899792028E+00
+ .9952233927E+00 .9981300148E+00 .9994396214E+00 .9998862384E+00 .9999883135E+00
+ .1856624263E+00 .2806274393E+00 .3466130546E+00 .3975749395E+00 .4394248745E+00
+ .4751783911E+00 .5065787695E+00 .5347131856E+00 .5602880678E+00 .5838883514E+00
+ .6058900964E+00 .6265788891E+00 .6461777566E+00 .6648654628E+00 .6827823804E+00
+ .7000476671E+00 .7167774158E+00 .7330606598E+00 .7489766262E+00 .7645966130E+00
+ .7799864474E+00 .7952046663E+00 .8103175811E+00 .8253900164E+00 .8404814261E+00
+ .8556505959E+00 .8709513673E+00 .8864212213E+00 .9020591438E+00 .9177734762E+00
+ .9333412542E+00 .9483685589E+00 .9622914391E+00 .9744550942E+00 .9842750324E+00
+ .9913760386E+00 .9959222819E+00 .9984112576E+00 .9995236339E+00 .9999026832E+00
+ .9999898833E+00 .1847510064E+00 .2789369321E+00 .3445362194E+00 .3952108606E+00
+ .4368168780E+00 .4723502702E+00 .5035450054E+00 .5314947901E+00 .5569343661E+00
+ .5803472173E+00 .6021412672E+00 .6226266316E+00 .6420231394E+00 .6605069701E+00
+ .6782224123E+00 .6952613320E+00 .7117624660E+00 .7278089628E+00 .7434719003E+00
+ .7588320723E+00 .7739520134E+00 .7888905107E+00 .8037041460E+00 .8184484603E+00
+ .8331787380E+00 .8479502520E+00 .8628214619E+00 .8778376377E+00 .8930224742E+00
+ .9083576352E+00 .9237092844E+00 .9388108193E+00 .9532265365E+00 .9663770916E+00
+ .9776039687E+00 .9863938014E+00 .9926407047E+00 .9965612993E+00 .9986702630E+00
+ .9996021255E+00 .9999184111E+00 .9999914388E+00 .1838395864E+00 .2774529220E+00
+ .3426783917E+00 .3930560916E+00 .4344068358E+00 .4697106898E+00 .5006927315E+00
+ .5284411520E+00 .5536868244E+00 .5769453449E+00 .5985952676E+00 .6188971031E+00
+ .6380424183E+00 .6562918185E+00 .6737829904E+00 .6906311198E+00 .7069337832E+00
+ .7227753497E+00 .7382305035E+00 .7533663528E+00 .7682439547E+00 .7829198939E+00
+ .7974435221E+00 .8118748234E+00 .8262724187E+00 .8406880617E+00 .8551729732E+00
+ .8697745492E+00 .8845277465E+00 .8994379203E+00 .9144525416E+00 .9294229034E+00
+ .9440650799E+00 .9578400823E+00 .9701403844E+00 .9804222515E+00 .9883199573E+00
+ .9937933852E+00 .9971446270E+00 .9989085858E+00 .9996754773E+00 .9999334722E+00
+ .9999929812E+00 .1829281665E+00 .2761613316E+00 .3410246510E+00 .3910963600E+00
+ .4321812658E+00 .4672467844E+00 .4980095710E+00 .5255521174E+00 .5506012826E+00
+ .5736525037E+00 .5950506967E+00 .6151529586E+00 .6341719771E+00 .6522782841E+00
+ .6696119204E+00 .6862828078E+00 .7023863660E+00 .7180217222E+00 .7332547769E+00
+ .7481525102E+00 .7627866255E+00 .7772111250E+00 .7914771106E+00 .8056340499E+00
+ .8197306613E+00 .8338155109E+00 .8479372105E+00 .8621474272E+00 .8764912829E+00
+ .8909923894E+00 .9056399253E+00 .9203396874E+00 .9348866680E+00 .9489381236E+00
+ .9620183353E+00 .9735788605E+00 .9830175955E+00 .9900789461E+00 .9948416873E+00
+ .9976760708E+00 .9991276334E+00 .9997440423E+00 .9999479118E+00 .9999945113E+00
+ .1820167466E+00 .2750493430E+00 .3395613777E+00 .3893186509E+00 .4301278519E+00
+ .4649468562E+00 .4954842442E+00 .5228167259E+00 .5476249179E+00 .5704442486E+00
+ .5916873764E+00 .6116285361E+00 .6304819378E+00 .6484183716E+00 .6655775512E+00
+ .6820758939E+00 .6979904098E+00 .7134325041E+00 .7284735193E+00 .7431774704E+00
+ .7576023503E+00 .7718012539E+00 .7858237508E+00 .7997140567E+00 .8135239292E+00
+ .8273042064E+00 .8411008648E+00 .8549595523E+00 .8689232083E+00 .8830256854E+00
+ .8972785935E+00 .9116516240E+00 .9260154275E+00 .9401284713E+00 .9536131199E+00
+ .9659793105E+00 .9767041342E+00 .9853573651E+00 .9916818818E+00 .9957925963E+00
+ .9981590752E+00 .9993286953E+00 .9998081384E+00 .9999617716E+00 .9999960298E+00
+ .1811053266E+00 .2741052251E+00 .3382761587E+00 .3877111205E+00 .4282353784E+00
+ .4628001854E+00 .4931064644E+00 .5201983322E+00 .5448054084E+00 .5674667869E+00
+ .5885458863E+00 .6083195120E+00 .6270030053E+00 .6447672272E+00 .6617366482E+00
+ .6780447067E+00 .6937904364E+00 .7090555891E+00 .7239111807E+00 .7384205229E+00
+ .7526389570E+00 .7666178516E+00 .7804109013E+00 .7940637106E+00 .8076205159E+00
+ .8211249930E+00 .8346208056E+00 .8481528112E+00 .8617654104E+00 .8754966873E+00
+ .8893717014E+00 .9033859763E+00 .9174802174E+00 .9315069327E+00 .9451869477E+00
+ .9581124211E+00 .9697846233E+00 .9797075887E+00 .9875202251E+00 .9931144397E+00
+ .9966524437E+00 .9985968041E+00 .9995129400E+00 .9998680579E+00 .9999750892E+00
+ .9999975377E+00 .1801939067E+00 .2733182619E+00 .3371576260E+00 .3862628787E+00
+ .4264935687E+00 .4607970149E+00 .4908668048E+00 .5177676272E+00 .5422131620E+00
+ .5647053822E+00 .5856121000E+00 .6052121426E+00 .6237216931E+00 .6413115117E+00
+ .6581200485E+00 .6742625432E+00 .6898360657E+00 .7049227578E+00 .7195932878E+00
+ .7339102010E+00 .7479300225E+00 .7617042133E+00 .7752800324E+00 .7887018065E+00
+ .8020122147E+00 .8152531650E+00 .8284663316E+00 .8416935268E+00 .8549765971E+00
+ .8683558225E+00 .8818650798E+00 .8955212957E+00 .9093054805E+00 .9231342642E+00
+ .9368259517E+00 .9500737499E+00 .9624473300E+00 .9734442800E+00 .9825969726E+00
+ .9896084112E+00 .9944594912E+00 .9974270541E+00 .9989921530E+00 .9996814425E+00
+ .9999240665E+00 .9999878995E+00 .9999990354E+00 .1796722612E+00 .2722124186E+00
+ .3358625543E+00 .3848563582E+00 .4250035087E+00 .4592371140E+00 .4892450044E+00
+ .5160886995E+00 .5404802581E+00 .5629209145E+00 .5837774326E+00 .6033273849E+00
+ .6217865141E+00 .6393257293E+00 .6560830573E+00 .6721726428E+00 .6876907722E+00
+ .7027194969E+00 .7173293993E+00 .7315823490E+00 .7455338556E+00 .7592345443E+00
+ .7727310530E+00 .7860669386E+00 .7992837456E+00 .8124219760E+00 .8255217614E+00
+ .8386232201E+00 .8517663195E+00 .8649895079E+00 .8783256500E+00 .8917931244E+00
+ .9053797650E+00 .9190186331E+00 .9325585824E+00 .9457393575E+00 .9581879162E+00
+ .9694539282E+00 .9790917186E+00 .9867727882E+00 .9923879857E+00 .9960900896E+00
+ .9982491711E+00 .9993372290E+00 .9997968628E+00 .9999528388E+00 .9999926420E+00
+ .9999994225E+00 .1791506157E+00 .2717244023E+00 .3351930575E+00 .3840186229E+00
+ .4240233123E+00 .4581356402E+00 .4880381859E+00 .5147881202E+00 .5390945534E+00
+ .5614568929E+00 .5822400669E+00 .6017197369E+00 .6201105736E+00 .6375831704E+00
+ .6542749331E+00 .6702987829E+00 .6857499479E+00 .7007100629E+00 .7152494788E+00
+ .7294294271E+00 .7433044119E+00 .7569240976E+00 .7703343516E+00 .7835779277E+00
+ .7966953046E+00 .8097256567E+00 .8227076574E+00 .8356799634E+00 .8486812919E+00
+ .8617496479E+00 .8749195692E+00 .8882154682E+00 .9016386284E+00 .9151459448E+00
+ .9286213573E+00 .9418469590E+00 .9544885943E+00 .9661153853E+00 .9762667455E+00
+ .9845601360E+00 .9908048413E+00 .9950698881E+00 .9976666065E+00 .9990483712E+00
+ .9996758683E+00 .9999117185E+00 .9999820152E+00 .9999975686E+00 .9999998367E+00
+ .1737220000E+00 .2641688159E+00 .3263810467E+00 .3743318262E+00 .4136704025E+00
+ .4472456728E+00 .4766971090E+00 .5030563908E+00 .5270168276E+00 .5490666699E+00
+ .5695622022E+00 .5887731874E+00 .6069106485E+00 .6241420080E+00 .6406011443E+00
+ .6563979035E+00 .6716256389E+00 .6863648017E+00 .7006842575E+00 .7146432091E+00
+ .7282941344E+00 .7416851101E+00 .7548606636E+00 .7678619826E+00 .7807275548E+00
+ .7934942962E+00 .8061985642E+00 .8188767428E+00 .8315655866E+00 .8443024728E+00
+ .8571251897E+00 .8700702553E+00 .8831681059E+00 .8964328200E+00 .9098438800E+00
+ .9233191147E+00 .9366828339E+00 .9496411565E+00 .9617840708E+00 .9726335248E+00
+ .9817417626E+00 .9888154878E+00 .9938146288E+00 .9969726960E+00 .9987203449E+00
+ .9995473179E+00 .9998717156E+00 .9999727644E+00 .9999961574E+00 .9999997303E+00
+ .1755799312E+00 .2666013149E+00 .3290846864E+00 .3771826021E+00 .4166034870E+00
+ .4502220500E+00 .4796913036E+00 .5060501656E+00 .5299958070E+00 .5520197716E+00
+ .5724811244E+00 .5916504239E+00 .6097383708E+00 .6269130534E+00 .6433098561E+00
+ .6590391514E+00 .6741934300E+00 .6888522874E+00 .7030846927E+00 .7169502962E+00
+ .7305013640E+00 .7437850327E+00 .7568448140E+00 .7697211827E+00 .7824519779E+00
+ .7950731410E+00 .8076196344E+00 .8201261635E+00 .8326275898E+00 .8451590846E+00
+ .8577557939E+00 .8704512169E+00 .8832728396E+00 .8962330094E+00 .9093129889E+00
+ .9224395622E+00 .9354575301E+00 .9481078434E+00 .9600272540E+00 .9707856417E+00
+ .9799660704E+00 .9872705033E+00 .9926116951E+00 .9961465075E+00 .9982285305E+00
+ .9992991362E+00 .9997686310E+00 .9999389652E+00 .9999879625E+00 .9999984250E+00
+ .9999998976E+00 .1760144460E+00 .2670609020E+00 .3294910285E+00 .3775097826E+00
+ .4168402951E+00 .4503626186E+00 .4797321509E+00 .5059888277E+00 .5298298890E+00
+ .5517469155E+00 .5720993316E+00 .5911575880E+00 .6091315938E+00 .6261888854E+00
+ .6424649637E+00 .6580702355E+00 .6730965192E+00 .6876224439E+00 .7017164007E+00
+ .7154378171E+00 .7288385387E+00 .7419648217E+00 .7548590856E+00 .7675607937E+00
+ .7801068170E+00 .7925319364E+00 .8048696300E+00 .8171528426E+00 .8294144911E+00
+ .8416876956E+00 .8540056656E+00 .8664007529E+00 .8789016009E+00 .8915267504E+00
+ .9042727803E+00 .9170956818E+00 .9298866588E+00 .9424483837E+00 .9544836828E+00
+ .9656118704E+00 .9754232574E+00 .9835670742E+00 .9898469299E+00 .9942839419E+00
+ .9971144435E+00 .9987184852E+00 .9995109430E+00 .9998444728E+00 .9999605180E+00
+ .9999925129E+00 .9999990587E+00 .9999999412E+00 .1770663795E+00 .2683546956E+00
+ .3308457617E+00 .3788562808E+00 .4181444177E+00 .4516046168E+00 .4808993380E+00
+ .5070724101E+00 .5308229707E+00 .5526435602E+00 .5728946123E+00 .5918473214E+00
+ .6097114506E+00 .6266540515E+00 .6428106723E+00 .6582920740E+00 .6731899175E+00
+ .6875820711E+00 .7015362095E+00 .7151114556E+00 .7283594343E+00 .7413258218E+00
+ .7540520936E+00 .7665766982E+00 .7789355626E+00 .7911624559E+00 .8032895888E+00
+ .8153483395E+00 .8273698291E+00 .8393852307E+00 .8514257771E+00 .8635221919E+00
+ .8757027838E+00 .8879889108E+00 .9003861367E+00 .9128695997E+00 .9253636166E+00
+ .9377190267E+00 .9496968362E+00 .9609709796E+00 .9711622529E+00 .9799060634E+00
+ .9869395774E+00 .9921773606E+00 .9957410546E+00 .9979252964E+00 .9991124792E+00
+ .9996742546E+00 .9999004959E+00 .9999757617E+00 .9999955931E+00 .9999994691E+00
+ .9999999683E+00 .1758581709E+00 .2664553039E+00 .3284189613E+00 .3759813026E+00
+ .4148675317E+00 .4479556796E+00 .4768985049E+00 .5027332925E+00 .5261550430E+00
+ .5476536527E+00 .5675868875E+00 .5862232219E+00 .6037707584E+00 .6203958792E+00
+ .6362331620E+00 .6513915496E+00 .6659608488E+00 .6800178532E+00 .6936296852E+00
+ .7068546016E+00 .7197426950E+00 .7323378237E+00 .7446798503E+00 .7568058435E+00
+ .7687502167E+00 .7805447857E+00 .7922193714E+00 .8038027006E+00 .8153230789E+00
+ .8268087027E+00 .8382878457E+00 .8497890679E+00 .8613412229E+00 .8729726711E+00
+ .8847087631E+00 .8965662293E+00 .9085427594E+00 .9206004318E+00 .9326436985E+00
+ .9444968657E+00 .9558915219E+00 .9664779406E+00 .9758713433E+00 .9837309651E+00
+ .9898503827E+00 .9942227228E+00 .9970475025E+00 .9986708984E+00 .9994852613E+00
+ .9998336896E+00 .9999570598E+00 .9999917096E+00 .9999989378E+00 .9999999324E+00
+ .1737723885E+00 .2636970230E+00 .3253620744E+00 .3727892655E+00 .4116291012E+00
+ .4447253360E+00 .4737129101E+00 .4996193173E+00 .5231327275E+00 .5447378120E+00
+ .5647899984E+00 .5835572379E+00 .6012460268E+00 .6180200622E+00 .6340127438E+00
+ .6493340020E+00 .6640745795E+00 .6783105039E+00 .6921074258E+00 .7055232509E+00
+ .7186090613E+00 .7314097728E+00 .7439654483E+00 .7563128398E+00 .7684863811E+00
+ .7805185477E+00 .7924400969E+00 .8042805551E+00 .8160688615E+00 .8278338870E+00
+ .8396046856E+00 .8514104210E+00 .8632797088E+00 .8752386789E+00 .8873065903E+00
+ .8994875341E+00 .9117570087E+00 .9240435321E+00 .9362084356E+00 .9480311964E+00
+ .9592111584E+00 .9693959285E+00 .9782392491E+00 .9854773656E+00 .9909989911E+00
+ .9948795050E+00 .9973614442E+00 .9987871078E+00 .9995116285E+00 .9998316357E+00
+ .9999517746E+00 .9999889995E+00 .9999981291E+00 .9999997894E+00 .9999999882E+00
+ .5119724156E+00 .3874081833E+00 .6569267245E+00 .3260460061E+00 .5253800226E+00
+ .7127712695E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .3003816381E+00 .4709825511E+00 .6022386036E+00 .7231347997E+00 .8549817939E+00
+ .2799538226E+00 .4353779888E+00 .5511817810E+00 .6517306811E+00 .7510266867E+00
+ .8652446706E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .0000000000E+00 .0000000000E+00 .0000000000E+00 .2590912326E+00 .4010896013E+00
+ .5033119849E+00 .5873439682E+00 .6627324555E+00 .7358203442E+00 .8133992683E+00
+ .9043940737E+00 .2494729236E+00 .3850372100E+00 .4816440498E+00 .5599288628E+00
+ .6286653312E+00 .6930150226E+00 .7573315152E+00 .8272263632E+00 .9107769497E+00
+ .2418159207E+00 .3725417327E+00 .4649849800E+00 .5391165772E+00 .6032531243E+00
+ .6619865954E+00 .7186328546E+00 .7765451150E+00 .8405979527E+00 .9179171245E+00
+ .2359985203E+00 .3636770429E+00 .4534220373E+00 .5248149223E+00 .5859196253E+00
+ .6410359336E+00 .6930087183E+00 .7442500410E+00 .7975495554E+00 .8571769264E+00
+ .9285152601E+00 .2301619008E+00 .3542394895E+00 .4410290303E+00 .5096425032E+00
+ .5678936619E+00 .6198650728E+00 .6681258727E+00 .7146333507E+00 .7612771765E+00
+ .8104810456E+00 .8661534585E+00 .9331500825E+00 .2257034090E+00 .3482627862E+00
+ .4336630927E+00 .5008327517E+00 .5574906380E+00 .6076191431E+00 .6536496185E+00
+ .6973175352E+00 .7401070899E+00 .7836068601E+00 .8299880289E+00 .8826087675E+00
+ .9441338488E+00 .2211645211E+00 .3421525329E+00 .4262029026E+00 .4920338341E+00
+ .5472751269E+00 .5958314341E+00 .6400417541E+00 .6815093468E+00 .7215029141E+00
+ .7612175155E+00 .8020400765E+00 .8459383089E+00 .8957490487E+00 .9523906251E+00
+ .2163469298E+00 .3367455281E+00 .4202298000E+00 .4853863672E+00 .5398269062E+00
+ .5874264602E+00 .6304774920E+00 .6705108600E+00 .7086784715E+00 .7459749374E+00
+ .7834151298E+00 .8222460616E+00 .8642177097E+00 .9113608285E+00 .9621563281E+00
+ .2127191056E+00 .3301279628E+00 .4113114778E+00 .4744891962E+00 .5270930798E+00
+ .5728919442E+00 .6140968562E+00 .6521591391E+00 .6881353043E+00 .7228857759E+00
+ .7572115129E+00 .7919871037E+00 .8283472168E+00 .8679570327E+00 .9128968803E+00
+ .9621783974E+00 .2084740352E+00 .3248801320E+00 .4052658897E+00 .4676634483E+00
+ .5194603323E+00 .5643936302E+00 .6046428671E+00 .6416217609E+00 .6763364997E+00
+ .7095743332E+00 .7420217413E+00 .7743601558E+00 .8073750794E+00 .8421172020E+00
+ .8800874474E+00 .9228007422E+00 .9679218139E+00 .2022848383E+00 .3192137602E+00
+ .4000666473E+00 .4626911785E+00 .5145380106E+00 .5593742892E+00 .5993877622E+00
+ .6359855621E+00 .6701535511E+00 .7026418784E+00 .7340751757E+00 .7650315222E+00
+ .7961165211E+00 .8280548362E+00 .8618024933E+00 .8985081778E+00 .9384137085E+00
+ .9768161798E+00 .2120904704E+00 .3223853102E+00 .3987342745E+00 .4582073523E+00
+ .5076847086E+00 .5506442060E+00 .5891081273E+00 .6243771084E+00 .6573598251E+00
+ .6887424688E+00 .7190874997E+00 .7489007771E+00 .7786885306E+00 .8090195693E+00
+ .8406002346E+00 .8743076696E+00 .9108457515E+00 .9490758207E+00 .9825761504E+00
+ .2065944908E+00 .3138611297E+00 .3880480562E+00 .4457741119E+00 .4937308585E+00
+ .5352963987E+00 .5724302219E+00 .6063867563E+00 .6380347392E+00 .6680203267E+00
+ .6968602047E+00 .7250014412E+00 .7528676868E+00 .7809039058E+00 .8096317221E+00
+ .8397268101E+00 .8720877593E+00 .9076208269E+00 .9457634228E+00 .9806888742E+00
+ .2040536841E+00 .3090104125E+00 .3823312036E+00 .4394561751E+00 .4868838338E+00
+ .5279326829E+00 .5645337087E+00 .5979215801E+00 .6289469602E+00 .6582356416E+00
+ .6862785900E+00 .7134820924E+00 .7402337997E+00 .7669160696E+00 .7939370091E+00
+ .8217894008E+00 .8511048527E+00 .8826343849E+00 .9168292272E+00 .9523397283E+00
+ .9833775220E+00 .2015128774E+00 .3053393638E+00 .3778407814E+00 .4342907101E+00
+ .4811132113E+00 .5215872450E+00 .5576184856E+00 .5904221798E+00 .6208316951E+00
+ .6494549715E+00 .6767620600E+00 .7031392044E+00 .7289166568E+00 .7544489187E+00
+ .7800690715E+00 .8061559976E+00 .8331769643E+00 .8617242521E+00 .8924327825E+00
+ .9254136087E+00 .9586791763E+00 .9862360465E+00 .1989720707E+00 .3026941193E+00
+ .3744168184E+00 .4301274064E+00 .4762785893E+00 .5161272821E+00 .5515565586E+00
+ .5837625693E+00 .6135620935E+00 .6415473335E+00 .6681717138E+00 .6938024217E+00
+ .7187549869E+00 .7433187439E+00 .7677795040E+00 .7924434822E+00 .8176670570E+00
+ .8438949113E+00 .8716838527E+00 .9015804894E+00 .9334552994E+00 .9648127165E+00
+ .9892422865E+00 .1995441354E+00 .3027894911E+00 .3738799852E+00 .4289149153E+00
+ .4743694671E+00 .5135031036E+00 .5481952410E+00 .5796355644E+00 .6086325224E+00
+ .6357682912E+00 .6614838272E+00 .6861304569E+00 .7100033497E+00 .7333646767E+00
+ .7564626262E+00 .7795497098E+00 .8029031435E+00 .8268516589E+00 .8518099107E+00
+ .8782959679E+00 .9068021661E+00 .9371450962E+00 .9668762673E+00 .9899111529E+00
+ .1942036339E+00 .2951512883E+00 .3648099631E+00 .4188024312E+00 .4634266115E+00
+ .5018569451E+00 .5359251202E+00 .5667902992E+00 .5952391722E+00 .6218372056E+00
+ .6470106709E+00 .6710961142E+00 .6943730827E+00 .7170857215E+00 .7394590806E+00
+ .7617145337E+00 .7840855145E+00 .8068362205E+00 .8302876543E+00 .8548503221E+00
+ .8810334488E+00 .9092878700E+00 .9393038812E+00 .9684292022E+00 .9905681100E+00
+ .1966856383E+00 .2978232748E+00 .3671846626E+00 .4206925777E+00 .4647348370E+00
+ .5025198107E+00 .5358927793E+00 .5660172855E+00 .5936794662E+00 .6194412139E+00
+ .6437225589E+00 .6668509083E+00 .6890937579E+00 .7106795634E+00 .7318121949E+00
+ .7526841700E+00 .7734891384E+00 .7944344383E+00 .8157576516E+00 .8377507210E+00
+ .8607917883E+00 .8853633651E+00 .9119379718E+00 .9403775191E+00 .9684249648E+00
+ .9903246258E+00 .1910838734E+00 .2905526801E+00 .3591691081E+00 .4123042748E+00
+ .4561616482E+00 .4938685815E+00 .5272283424E+00 .5573806570E+00 .5850960099E+00
+ .6109244898E+00 .6352779600E+00 .6584772140E+00 .6807820433E+00 .7024126349E+00
+ .7235642174E+00 .7444179434E+00 .7651514443E+00 .7859498459E+00 .8070181036E+00
+ .8285971700E+00 .8509840780E+00 .8745417502E+00 .8996334287E+00 .9262998775E+00
+ .9534286991E+00 .9776807196E+00 .9940166847E+00 .1885533210E+00 .2867399663E+00
+ .3544623603E+00 .4068853996E+00 .4501314274E+00 .4872870691E+00 .5201316025E+00
+ .5497891102E+00 .5770185770E+00 .6023603714E+00 .6262179866E+00 .6489045459E+00
+ .6706713146E+00 .6917285917E+00 .7122604552E+00 .7324344169E+00 .7524100513E+00
+ .7723483144E+00 .7924210524E+00 .8128222386E+00 .8337835007E+00 .8555927781E+00
+ .8785997867E+00 .9031396194E+00 .9291938977E+00 .9555680607E+00 .9789147239E+00
+ .9944189044E+00 .1888989369E+00 .2868867787E+00 .3543365370E+00 .4064684533E+00
+ .4494157190E+00 .4862666006E+00 .5187990091E+00 .5481345861E+00 .5750299577E+00
+ .6000222990E+00 .6235107504E+00 .6458042267E+00 .6671494757E+00 .6877503266E+00
+ .7077825692E+00 .7274040319E+00 .7467617950E+00 .7659996398E+00 .7852660600E+00
+ .8047226729E+00 .8245547967E+00 .8449854105E+00 .8662877274E+00 .8887704357E+00
+ .9126509648E+00 .9376468554E+00 .9621947265E+00 .9828795445E+00 .9957296001E+00
+ .1876976527E+00 .2852292527E+00 .3523726329E+00 .4042526081E+00 .4469708386E+00
+ .4836013555E+00 .5159140537E+00 .5450248500E+00 .5716862683E+00 .5964321681E+00
+ .6196576546E+00 .6416673171E+00 .6627040060E+00 .6829668088E+00 .7026249155E+00
+ .7218282252E+00 .7407143758E+00 .7594146138E+00 .7780603506E+00 .7967900918E+00
+ .8157570740E+00 .8351391168E+00 .8551501305E+00 .8760440101E+00 .8980748184E+00
+ .9213191995E+00 .9452242817E+00 .9679342416E+00 .9861351691E+00 .9967336499E+00
+ .1871631460E+00 .2834707176E+00 .3502057735E+00 .4018025211E+00 .4442679497E+00
+ .4806528420E+00 .5127188975E+00 .5415777430E+00 .5679786246E+00 .5924528941E+00
+ .6153931841E+00 .6370869488E+00 .6577863325E+00 .6776931990E+00 .6969708161E+00
+ .7157617483E+00 .7341954553E+00 .7523933285E+00 .7704740112E+00 .7885588676E+00
+ .8067780470E+00 .8252805788E+00 .8442448357E+00 .8638695134E+00 .8843765013E+00
+ .9059324391E+00 .9284305593E+00 .9510710656E+00 .9719147999E+00 .9880594135E+00
+ .9972106209E+00 .1866286394E+00 .2822587976E+00 .3486076321E+00 .3998862487E+00
+ .4420616031E+00 .4781701285E+00 .5099661894E+00 .5385565416E+00 .5646864405E+00
+ .5888840629E+00 .6115391662E+00 .6329494921E+00 .6533504634E+00 .6729339646E+00
+ .6918602190E+00 .7102670204E+00 .7282774352E+00 .7459945851E+00 .7635511296E+00
+ .7810551809E+00 .7986201531E+00 .8163701626E+00 .8344465406E+00 .8530148198E+00
+ .8722658030E+00 .8923891555E+00 .9134695959E+00 .9352371634E+00 .9566782795E+00
+ .9757792109E+00 .9899850722E+00 .9977167247E+00 .1860941327E+00 .2815438002E+00
+ .3475265145E+00 .3984552757E+00 .4403066680E+00 .4761108781E+00 .5076157147E+00
+ .5359225430E+00 .5617719586E+00 .5856883228E+00 .6080582973E+00 .6291764206E+00
+ .6492524391E+00 .6685059898E+00 .6870918780E+00 .7051426762E+00 .7227756531E+00
+ .7400983756E+00 .7572122974E+00 .7742165568E+00 .7912118249E+00 .8083050176E+00
+ .8256139326E+00 .8432874474E+00 .8614795285E+00 .8803683698E+00 .9001110701E+00
+ .9207154204E+00 .9417666447E+00 .9620677013E+00 .9795380518E+00 .9919119869E+00
+ .9982492987E+00 .1855596260E+00 .2812818850E+00 .3469168069E+00 .3974667836E+00
+ .4389633225E+00 .4744377335E+00 .5056319882E+00 .5336415846E+00 .5592018634E+00
+ .5828327803E+00 .6049176622E+00 .6257479736E+00 .6455520993E+00 .6645152169E+00
+ .6827914394E+00 .7005113554E+00 .7177887560E+00 .7347266452E+00 .7514212124E+00
+ .7679646760E+00 .7844486689E+00 .8009682306E+00 .8176259067E+00 .8345363911E+00
+ .8518319629E+00 .8696659395E+00 .8882031320E+00 .9075679148E+00 .9276956199E+00
+ .9480435024E+00 .9672585490E+00 .9832006503E+00 .9938400958E+00 .9988060231E+00
+ .1786157958E+00 .2715714191E+00 .3355831213E+00 .3850192456E+00 .4256824787E+00
+ .4604975171E+00 .4911489725E+00 .5186978599E+00 .5438565845E+00 .5671297363E+00
+ .5888903339E+00 .6094214548E+00 .6289438747E+00 .6476369731E+00 .6656508348E+00
+ .6831119790E+00 .7001291616E+00 .7168002676E+00 .7332168362E+00 .7494659189E+00
+ .7656323325E+00 .7818024645E+00 .7980682386E+00 .8145307955E+00 .8313051275E+00
+ .8485260722E+00 .8663527417E+00 .8849606878E+00 .9044926363E+00 .9249113669E+00
+ .9457031198E+00 .9655165009E+00 .9821383667E+00 .9933765824E+00 .9986994641E+00
+ .1818359477E+00 .2758699365E+00 .3403866912E+00 .3900757408E+00 .4308524247E+00
+ .4656921703E+00 .4963055212E+00 .5237687285E+00 .5488038273E+00 .5719202036E+00
+ .5934933154E+00 .6138088603E+00 .6330891591E+00 .6515125239E+00 .6692270506E+00
+ .6863580574E+00 .7030127042E+00 .7192852883E+00 .7352622414E+00 .7510249577E+00
+ .7666515069E+00 .7822191503E+00 .7978076092E+00 .8135022124E+00 .8293971903E+00
+ .8455998552E+00 .8622348306E+00 .8794434754E+00 .8973641047E+00 .9160604809E+00
+ .9353514796E+00 .9545336608E+00 .9721522008E+00 .9862124981E+00 .9951547442E+00
+ .9991051146E+00 .1798232751E+00 .2726581093E+00 .3366980308E+00 .3860912399E+00
+ .4266471943E+00 .4613051674E+00 .4917590315E+00 .5190759354E+00 .5439727388E+00
+ .5669550270E+00 .5883947236E+00 .6085751539E+00 .6277173434E+00 .6459977093E+00
+ .6635615638E+00 .6805319395E+00 .6970144420E+00 .7131011873E+00 .7288751807E+00
+ .7444138829E+00 .7597912726E+00 .7750795751E+00 .7903516966E+00 .8056840926E+00
+ .8211596369E+00 .8368707797E+00 .8529230212E+00 .8694364643E+00 .8865378511E+00
+ .9043249051E+00 .9227714852E+00 .9415463127E+00 .9597838527E+00 .9759972651E+00
+ .9884450282E+00 .9960501818E+00 .9992881104E+00 .1778106025E+00 .2702694344E+00
+ .3338467866E+00 .3828713419E+00 .4231302895E+00 .4575399615E+00 .4877784084E+00
+ .5149022487E+00 .5396216081E+00 .5624369019E+00 .5837153994E+00 .6037372210E+00
+ .6227215276E+00 .6408424934E+00 .6582423851E+00 .6750416690E+00 .6913442523E+00
+ .7072402317E+00 .7228094992E+00 .7381258394E+00 .7532594947E+00 .7682783994E+00
+ .7832498149E+00 .7982428583E+00 .8133311675E+00 .8285954742E+00 .8441265597E+00
+ .8600281555E+00 .8764163565E+00 .8934056972E+00 .9110605005E+00 .9292797206E+00
+ .9476016445E+00 .9650049602E+00 .9799365199E+00 .9908362753E+00 .9970689894E+00
+ .9995129737E+00 .1775786369E+00 .2694974131E+00 .3325685209E+00 .3811297321E+00
+ .4209590884E+00 .4549642410E+00 .4848165370E+00 .5115676007E+00 .5359235097E+00
+ .5583811281E+00 .5793048061E+00 .5989723920E+00 .6176009331E+00 .6353621759E+00
+ .6523957994E+00 .6688200102E+00 .6847367170E+00 .7002335821E+00 .7153872387E+00
+ .7302677599E+00 .7449415655E+00 .7594722478E+00 .7739214858E+00 .7883512657E+00
+ .8028264764E+00 .8174170220E+00 .8321999968E+00 .8472625891E+00 .8627048411E+00
+ .8786386272E+00 .8951735329E+00 .9123698628E+00 .9301298805E+00 .9480149942E+00
+ .9650571182E+00 .9797722115E+00 .9906324540E+00 .9969466945E+00 .9994800534E+00
+ .1767557912E+00 .2675220333E+00 .3302161965E+00 .3785377579E+00 .4181699322E+00
+ .4519952293E+00 .4816610818E+00 .5082057789E+00 .5323703507E+00 .5546449704E+00
+ .5753892717E+00 .5948769891E+00 .6133146774E+00 .6308781644E+00 .6477114141E+00
+ .6639291832E+00 .6796305432E+00 .6949015651E+00 .7098131895E+00 .7244372747E+00
+ .7388370764E+00 .7530725000E+00 .7672013624E+00 .7812805887E+00 .7953696097E+00
+ .8095305725E+00 .8238305771E+00 .8383440996E+00 .8531554541E+00 .8683637839E+00
+ .8840744586E+00 .9003706377E+00 .9172679534E+00 .9345987502E+00 .9518515544E+00
+ .9680041421E+00 .9816676161E+00 .9915696835E+00 .9972560683E+00 .9995298443E+00
+ .1759329455E+00 .2657726427E+00 .3281031002E+00 .3761740392E+00 .4155963315E+00
+ .4492311983E+00 .4787318709E+00 .5051288733E+00 .5290920752E+00 .5511760660E+00
+ .5717356504E+00 .5910403494E+00 .6093019230E+00 .6266897694E+00 .6433346709E+00
+ .6593466514E+00 .6748352501E+00 .6898848066E+00 .7045688138E+00 .7189515577E+00
+ .7330921637E+00 .7470427026E+00 .7608631956E+00 .7746123326E+00 .7883427951E+00
+ .8021095923E+00 .8159717455E+00 .8299937875E+00 .8442538809E+00 .8588345214E+00
+ .8738251581E+00 .8893187634E+00 .9053815362E+00 .9219884432E+00 .9389094131E+00
+ .9555269052E+00 .9708044006E+00 .9834701219E+00 .9924684451E+00 .9975587701E+00
+ .9995805012E+00 .1751100998E+00 .2642330649E+00 .3262121423E+00 .3740222733E+00
+ .4132228869E+00 .4466574834E+00 .4759709933E+00 .5022002217E+00 .5260420802E+00
+ .5479552784E+00 .5683252061E+00 .5874440246E+00 .6055202813E+00 .6227218315E+00
+ .6391840255E+00 .6549901712E+00 .6702707792E+00 .6851046219E+00 .6995580186E+00
+ .7137052948E+00 .7276022552E+00 .7413019039E+00 .7548556356E+00 .7683132108E+00
+ .7817233228E+00 .7951353814E+00 .8086048684E+00 .8221888847E+00 .8359488120E+00
+ .8499707826E+00 .8643262662E+00 .8791030902E+00 .8943852200E+00 .9102194673E+00
+ .9265452553E+00 .9430424983E+00 .9590287976E+00 .9734683387E+00 .9851863203E+00
+ .9933315327E+00 .9978552727E+00 .9996319601E+00 .1742872542E+00 .2628886749E+00
+ .3245278231E+00 .3720676740E+00 .4110356318E+00 .4442608292E+00 .4733803001E+00
+ .4994257177E+00 .5230903032E+00 .5448638630E+00 .5651045418E+00 .5840566202E+00
+ .6019006616E+00 .6188858049E+00 .6351420363E+00 .6507757146E+00 .6658768929E+00
+ .6805251328E+00 .6947913849E+00 .7087377199E+00 .7224186840E+00 .7358846230E+00
+ .7491787819E+00 .7623554594E+00 .7754680023E+00 .7885617946E+00 .8016840320E+00
+ .8148851910E+00 .8282200571E+00 .8417490536E+00 .8555399403E+00 .8696687003E+00
+ .8842173514E+00 .8993018152E+00 .9149253562E+00 .9309550964E+00 .9470145758E+00
+ .9623771286E+00 .9760054884E+00 .9868222522E+00 .9941613882E+00 .9981460102E+00
+ .9996841705E+00 .1734644085E+00 .2617261663E+00 .3230360646E+00 .3702967967E+00
+ .4090218854E+00 .4420291535E+00 .4709481857E+00 .4968054069E+00 .5202901242E+00
+ .5418732513E+00 .5618813135E+00 .5806508121E+00 .5983821491E+00 .6152381145E+00
+ .6313522754E+00 .6468265556E+00 .6617476876E+00 .6762088455E+00 .6902729031E+00
+ .7040025494E+00 .7174632669E+00 .7307027247E+00 .7437667314E+00 .7567001843E+00
+ .7695466680E+00 .7823486306E+00 .7951488359E+00 .8079951150E+00 .8209397725E+00
+ .8340353382E+00 .8473480253E+00 .8609451939E+00 .8748984393E+00 .8892828785E+00
+ .9041556673E+00 .9195139456E+00 .9352251596E+00 .9508394934E+00 .9655822808E+00
+ .9784245272E+00 .9883833746E+00 .9949603038E+00 .9984313741E+00 .9997370780E+00
+ .1726415628E+00 .2607334231E+00 .3217240166E+00 .3686973817E+00 .4071700637E+00
+ .4399514707E+00 .4686640730E+00 .4943290223E+00 .5175914963E+00 .5389604410E+00
+ .5588276489E+00 .5774511430E+00 .5950320739E+00 .6117330174E+00 .6276878750E+00
+ .6430058751E+00 .6577561358E+00 .6720425820E+00 .6859330575E+00 .6994886172E+00
+ .7127625074E+00 .7258015367E+00 .7386494238E+00 .7513451180E+00 .7639355122E+00
+ .7764664963E+00 .7889779121E+00 .8015109358E+00 .8141095013E+00 .8268211199E+00
+ .8396976273E+00 .8528093452E+00 .8662157670E+00 .8799883480E+00 .8941952198E+00
+ .9088771790E+00 .9239983210E+00 .9393668757E+00 .9545270025E+00 .9686538849E+00
+ .9807332706E+00 .9898747110E+00 .9957303264E+00 .9987117241E+00 .9997906344E+00
+ .1718187171E+00 .2598993566E+00 .3205799668E+00 .3672582723E+00 .4054696174E+00
+ .4380177137E+00 .4665183161E+00 .4919618874E+00 .5150398796E+00 .5362647991E+00
+ .5559824777E+00 .5744537880E+00 .5918802493E+00 .6084238238E+00 .6242042907E+00
+ .6393482294E+00 .6539465788E+00 .6680738253E+00 .6817966962E+00 .6951759950E+00
+ .7082634634E+00 .7211046302E+00 .7337471002E+00 .7462315589E+00 .7585981330E+00
+ .7708858441E+00 .7831326225E+00 .7953770625E+00 .8076609136E+00 .8200272598E+00
+ .8325228112E+00 .8451988530E+00 .8581127359E+00 .8713296588E+00 .8849269214E+00
+ .8989595672E+00 .9134533065E+00 .9283424374E+00 .9433859362E+00 .9580792569E+00
+ .9716005781E+00 .9829389285E+00 .9913007702E+00 .9964733607E+00 .9989873869E+00
+ .9998448006E+00 .1709958714E+00 .2592138380E+00 .3195931894E+00 .3659692100E+00
+ .4039108807E+00 .4362187194E+00 .4645020754E+00 .4897712684E+00 .5127023267E+00
+ .5337724594E+00 .5533325224E+00 .5716458383E+00 .5889140104E+00 .6052980163E+00
+ .6209314885E+00 .6359250333E+00 .6503681594E+00 .6643347603E+00 .6778902603E+00
+ .6910950265E+00 .7040032372E+00 .7166615465E+00 .7291108987E+00 .7413901072E+00
+ .7535378382E+00 .7655921415E+00 .7775896020E+00 .7895659934E+00 .8015580671E+00
+ .8136050171E+00 .8257491387E+00 .8380364216E+00 .8505177167E+00 .8632500796E+00
+ .8762968595E+00 .8897237695E+00 .9035854652E+00 .9178934215E+00 .9325552030E+00
+ .9472860987E+00 .9615249973E+00 .9744303870E+00 .9850481135E+00 .9926657359E+00
+ .9971911060E+00 .9992586656E+00 .9998995366E+00 .1705147924E+00 .2581781175E+00
+ .3183732752E+00 .3646368286E+00 .4024914901E+00 .4347244058E+00 .4629392793E+00
+ .4881443714E+00 .5110148067E+00 .5320256368E+00 .5515257059E+00 .5697789301E+00
+ .5869883456E+00 .6033137711E+00 .6188858105E+00 .6338139429E+00 .6481894155E+00
+ .6620876066E+00 .6755725921E+00 .6887018517E+00 .7015281168E+00 .7140987333E+00
+ .7264554403E+00 .7386360984E+00 .7506770762E+00 .7626143959E+00 .7744835273E+00
+ .7863192144E+00 .7981562668E+00 .8100309189E+00 .8219819430E+00 .8340513736E+00
+ .8462852735E+00 .8587346811E+00 .8714559345E+00 .8845082869E+00 .8979447720E+00
+ .9117895970E+00 .9259940898E+00 .9403688995E+00 .9545092244E+00 .9677609591E+00
+ .9792972370E+00 .9883461459E+00 .9945080948E+00 .9979789837E+00 .9994861641E+00
+ .9999325945E+00 .1700337134E+00 .2577298847E+00 .3177484381E+00 .3638459386E+00
+ .4015580958E+00 .4336678104E+00 .4617735538E+00 .4868803454E+00 .5096612803E+00
+ .5305883774E+00 .5500075065E+00 .5681822072E+00 .5853165329E+00 .6015692966E+00
+ .6170679955E+00 .6319202232E+00 .6462181820E+00 .6600387768E+00 .6734454046E+00
+ .6864929561E+00 .6992321750E+00 .7117103570E+00 .7239699532E+00 .7360484590E+00
+ .7479804619E+00 .7597998974E+00 .7715407661E+00 .7832367246E+00 .7949210463E+00
+ .8066275547E+00 .8183919104E+00 .8302525712E+00 .8422514738E+00 .8544348036E+00
+ .8668536814E+00 .8795635126E+00 .8926191655E+00 .9060607456E+00 .9198822503E+00
+ .9339765282E+00 .9480614818E+00 .9616187441E+00 .9739069089E+00 .9841125800E+00
+ .9916341754E+00 .9963678090E+00 .9987889609E+00 .9997260031E+00 .9999686139E+00
+ .1648856522E+00 .2505701807E+00 .3094080061E+00 .3546881658E+00 .3917811949E+00
+ .4233937432E+00 .4510841501E+00 .4758341377E+00 .4983002412E+00 .5189425363E+00
+ .5381007274E+00 .5560351899E+00 .5729453289E+00 .5889838955E+00 .6042745761E+00
+ .6189247545E+00 .6330272517E+00 .6466573333E+00 .6598746538E+00 .6727308882E+00
+ .6852758850E+00 .6975575361E+00 .7096181913E+00 .7214934194E+00 .7332148862E+00
+ .7448141478E+00 .7563238887E+00 .7677766707E+00 .7792037979E+00 .7906359942E+00
+ .8021051986E+00 .8136459283E+00 .8252957633E+00 .8370957150E+00 .8490911670E+00
+ .8613331455E+00 .8738787936E+00 .8867889383E+00 .9001185409E+00 .9138925131E+00
+ .9280575965E+00 .9424074235E+00 .9565005043E+00 .9696280278E+00 .9809122033E+00
+ .9895745467E+00 .9952834417E+00 .9983546129E+00 .9996091016E+00 .9999528378E+00
+ .1666847844E+00 .2529293363E+00 .3120303105E+00 .3574522671E+00 .3946239644E+00
+ .4262777176E+00 .4539838380E+00 .4787305753E+00 .5011808221E+00 .5217987976E+00
+ .5409233427E+00 .5588134684E+00 .5756717581E+00 .5916556053E+00 .6068886716E+00
+ .6214740859E+00 .6355022748E+00 .6490509982E+00 .6621837446E+00 .6749525382E+00
+ .6874039193E+00 .6995826584E+00 .7115309614E+00 .7232861500E+00 .7348806185E+00
+ .7463443649E+00 .7577074677E+00 .7690005706E+00 .7802540276E+00 .7914975393E+00
+ .8027610231E+00 .8140759733E+00 .8254763988E+00 .8369993049E+00 .8486852477E+00
+ .8605791442E+00 .8727306639E+00 .8851925178E+00 .8980134191E+00 .9112201678E+00
+ .9247817087E+00 .9385514895E+00 .9521989128E+00 .9651669740E+00 .9767161704E+00
+ .9861004852E+00 .9928429559E+00 .9969683135E+00 .9990156485E+00 .9997834421E+00
+ .9999759053E+00 .1671335250E+00 .2534225924E+00 .3124865727E+00 .3578437426E+00
+ .3949383060E+00 .4265086399E+00 .4541274364E+00 .4787834696E+00 .5011405368E+00
+ .5216641822E+00 .5406928101E+00 .5584835942E+00 .5752388717E+00 .5911178665E+00
+ .6062451284E+00 .6207219443E+00 .6346362620E+00 .6480655661E+00 .6610750173E+00
+ .6737175573E+00 .6860383507E+00 .6980797634E+00 .7098827060E+00 .7214847581E+00
+ .7329187148E+00 .7442137589E+00 .7553980395E+00 .7665002101E+00 .7775491839E+00
+ .7885733922E+00 .7996009315E+00 .8106606421E+00 .8217832420E+00 .8330019813E+00
+ .8443530564E+00 .8558761935E+00 .8676152485E+00 .8796178216E+00 .8919318024E+00
+ .9045950849E+00 .9176127319E+00 .9309159548E+00 .9443039630E+00 .9573869920E+00
+ .9695725833E+00 .9801476548E+00 .9884763820E+00 .9942506247E+00 .9976476165E+00
+ .9992642193E+00 .9998444096E+00 .9999833903E+00 .1681743394E+00 .2547197125E+00
+ .3138589426E+00 .3592216212E+00 .3962870429E+00 .4278084118E+00 .4553657040E+00
+ .4799509004E+00 .5022297518E+00 .5226702428E+00 .5416121078E+00 .5593114984E+00
+ .5759697227E+00 .5917472981E+00 .6067708151E+00 .6211413510E+00 .6349445020E+00
+ .6482561794E+00 .6611423815E+00 .6736577166E+00 .6858473957E+00 .6977519016E+00
+ .7094101482E+00 .7208591243E+00 .7321320595E+00 .7432581249E+00 .7542642383E+00
+ .7651771278E+00 .7760239894E+00 .7868319551E+00 .7976277158E+00 .8084380580E+00
+ .8192909207E+00 .8302162454E+00 .8412464442E+00 .8524168085E+00 .8637660282E+00
+ .8753363344E+00 .8871719217E+00 .8993131109E+00 .9117820677E+00 .9245548013E+00
+ .9375165616E+00 .9504076190E+00 .9627846593E+00 .9740406356E+00 .9835213475E+00
+ .9907300181E+00 .9955338540E+00 .9982409703E+00 .9994717954E+00 .9998930054E+00
+ .9999890784E+00 .1670987390E+00 .2530386565E+00 .3117240397E+00 .3567056204E+00
+ .3934325200E+00 .4246426356E+00 .4519068882E+00 .4762125054E+00 .4982221284E+00
+ .5183996568E+00 .5370813152E+00 .5545228284E+00 .5709264146E+00 .5864512124E+00
+ .6012201439E+00 .6153317210E+00 .6288720095E+00 .6419186095E+00 .6545374568E+00
+ .6667806613E+00 .6786904146E+00 .6903057586E+00 .7016659350E+00 .7128084796E+00
+ .7237658473E+00 .7345649628E+00 .7452300996E+00 .7557860072E+00 .7662586361E+00
+ .7766737944E+00 .7870559725E+00 .7974287661E+00 .8078163542E+00 .8182446694E+00
+ .8287417076E+00 .8393375272E+00 .8500646572E+00 .8609589828E+00 .8720605568E+00
+ .8834134597E+00 .8950632038E+00 .9070486161E+00 .9193829401E+00 .9320181158E+00
+ .9447909196E+00 .9573643253E+00 .9692007321E+00 .9796196271E+00 .9879711861E+00
+ .9938824785E+00 .9974425199E+00 .9991808775E+00 .9998222800E+00 .9999805000E+00
+ .1650591103E+00 .2503095152E+00 .3086618050E+00 .3534665584E+00 .3901011987E+00
+ .4212713566E+00 .4485313067E+00 .4728566407E+00 .4949022529E+00 .5151304550E+00
+ .5338774153E+00 .5513940951E+00 .5678763277E+00 .5834828502E+00 .5983417391E+00
+ .6125540125E+00 .6262012858E+00 .6393547960E+00 .6520794216E+00 .6644319827E+00
+ .6764591662E+00 .6881994239E+00 .6996875870E+00 .7109579264E+00 .7220436648E+00
+ .7329748943E+00 .7437779238E+00 .7544768387E+00 .7650956055E+00 .7756589338E+00
+ .7861918139E+00 .7967189506E+00 .8072650293E+00 .8178556497E+00 .8285182197E+00
+ .8392824584E+00 .8501807142E+00 .8612483356E+00 .8725238169E+00 .8840476713E+00
+ .8958580130E+00 .9079795649E+00 .9204018005E+00 .9330431751E+00 .9457049169E+00
+ .9580311512E+00 .9695074184E+00 .9795326683E+00 .9875733361E+00 .9933516945E+00
+ .9969692505E+00 .9988754992E+00 .9996830795E+00 .9999399304E+00 .9999942765E+00
+ .4947759637E+00 .3551678249E+00 .6395497183E+00 .2860091524E+00 .4808520903E+00
+ .6931686001E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .2777543836E+00 .4413818114E+00 .5744454374E+00 .7046652787E+00 .8522728402E+00
+ .2551499062E+00 .4018124348E+00 .5166935097E+00 .6220023455E+00 .7326205456E+00
+ .8642402640E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .0000000000E+00 .0000000000E+00 .0000000000E+00 .2387339286E+00 .3713055478E+00
+ .4702336707E+00 .5546792362E+00 .6334882591E+00 .7133529976E+00 .8021269817E+00
+ .9061118914E+00 .2286790323E+00 .3543357560E+00 .4468885461E+00 .5245409149E+00
+ .5951917986E+00 .6638903101E+00 .7356643748E+00 .8172611756E+00 .9137174789E+00
+ .2213122875E+00 .3418765058E+00 .4297347015E+00 .5024720338E+00 .5674873593E+00
+ .6290320400E+00 .6906122337E+00 .7563964131E+00 .8322849037E+00 .9218460029E+00
+ .2173780894E+00 .3349915804E+00 .4198900896E+00 .4893590565E+00 .5505883538E+00
+ .6074622953E+00 .6627521410E+00 .7191970446E+00 .7803735182E+00 .8511972580E+00
+ .9328816611E+00 .2116946447E+00 .3255719521E+00 .4072126774E+00 .4734610821E+00
+ .5312731086E+00 .5842900745E+00 .6348913262E+00 .6851326782E+00 .7373326213E+00
+ .7947057158E+00 .8616276548E+00 .9383657756E+00 .2102629617E+00 .3228951955E+00
+ .4031182154E+00 .4676607628E+00 .5234369826E+00 .5740257870E+00 .6216226328E+00
+ .6679114504E+00 .7145534148E+00 .7635536576E+00 .8176960953E+00 .8802549767E+00
+ .9490625263E+00 .2083351205E+00 .3195304369E+00 .3983365001E+00 .4613167724E+00
+ .5153151196E+00 .5638655402E+00 .6090654456E+00 .6523848448E+00 .6951270149E+00
+ .7387142859E+00 .7849309838E+00 .8361890391E+00 .8947994966E+00 .9569197661E+00
+ .2081026339E+00 .3188270960E+00 .3969796190E+00 .4590700753E+00 .5119166703E+00
+ .5590535912E+00 .6025655744E+00 .6438291068E+00 .6839351589E+00 .7239646076E+00
+ .7651709028E+00 .8091300428E+00 .8577412389E+00 .9119178141E+00 .9659214366E+00
+ .2029801128E+00 .3106586752E+00 .3864260829E+00 .4464112793E+00 .4972537176E+00
+ .5423867107E+00 .5838269463E+00 .6228700805E+00 .6604723792E+00 .6974983572E+00
+ .7348813032E+00 .7737464673E+00 .8155476972E+00 .8620760447E+00 .9142272434E+00
+ .9665861764E+00 .2016651809E+00 .3083781797E+00 .3832612765E+00 .4423230661E+00
+ .4921395858E+00 .5361125530E+00 .5762536196E+00 .6138439368E+00 .6497710962E+00
+ .6847557946E+00 .7195097242E+00 .7548468417E+00 .7917827174E+00 .8316326415E+00
+ .8758792096E+00 .9246716890E+00 .9717761716E+00 .2031079734E+00 .3102856988E+00
+ .3853190100E+00 .4442977697E+00 .4938106567E+00 .5372611284E+00 .5766754189E+00
+ .6133601616E+00 .6482025927E+00 .6818647682E+00 .7149254738E+00 .7479743891E+00
+ .7816812947E+00 .8168781767E+00 .8546230812E+00 .8958817391E+00 .9396962342E+00
+ .9789750069E+00 .1904600253E+00 .2919475424E+00 .3638432100E+00 .4210281119E+00
+ .4695175481E+00 .5123682249E+00 .5513726855E+00 .5877001487E+00 .6221806324E+00
+ .6554563972E+00 .6880728914E+00 .7205397609E+00 .7533882755E+00 .7872376591E+00
+ .8228677851E+00 .8612077215E+00 .9027974894E+00 .9457082908E+00 .9820597707E+00
+ .1838662398E+00 .2816176551E+00 .3509060578E+00 .4060464235E+00 .4528098582E+00
+ .4941203161E+00 .5316867750E+00 .5666213397E+00 .5997034154E+00 .6315241382E+00
+ .6625749206E+00 .6932968437E+00 .7241237057E+00 .7555317674E+00 .7880986900E+00
+ .8225777528E+00 .8599152257E+00 .9008003823E+00 .9436787246E+00 .9809544280E+00
+ .1816584226E+00 .2774147412E+00 .3459089058E+00 .4004453162E+00 .4466325221E+00
+ .4873466319E+00 .5242708302E+00 .5584947367E+00 .5907799699E+00 .6216943778E+00
+ .6516952364E+00 .6811781773E+00 .7105297508E+00 .7401411026E+00 .7704489903E+00
+ .8019909106E+00 .8354465894E+00 .8715536843E+00 .9104960789E+00 .9501043208E+00
+ .9833256847E+00 .1794506054E+00 .2742308314E+00 .3419804795E+00 .3958639375E+00
+ .4414275078E+00 .4815166749E+00 .5177929608E+00 .5513247083E+00 .5828568678E+00
+ .6129391070E+00 .6420024354E+00 .6704124959E+00 .6985029040E+00 .7266185650E+00
+ .7551049653E+00 .7843652300E+00 .8149004989E+00 .8473306065E+00 .8822458969E+00
+ .9194800802E+00 .9563523468E+00 .9859381889E+00 .1772427881E+00 .2719330174E+00
+ .3389813782E+00 .3921692908E+00 .4370679893E+00 .4765073663E+00 .5121308093E+00
+ .5449864682E+00 .5758036283E+00 .6051181493E+00 .6333417314E+00 .6608163580E+00
+ .6878462092E+00 .7147158414E+00 .7417125405E+00 .7691527126E+00 .7974110457E+00
+ .8269556794E+00 .8583581340E+00 .8921152210E+00 .9278451419E+00 .9624460258E+00
+ .9887604688E+00 .1783736970E+00 .2726537805E+00 .3389880908E+00 .3913555250E+00
+ .4353791256E+00 .4739045370E+00 .5085792163E+00 .5404463945E+00 .5702276788E+00
+ .5984518290E+00 .6255181956E+00 .6517503865E+00 .6774317336E+00 .7028199576E+00
+ .7281629124E+00 .7537208087E+00 .7797880475E+00 .8067191704E+00 .8349620431E+00
+ .8650609243E+00 .8974637429E+00 .9317144465E+00 .9646972154E+00 .9895312148E+00
+ .1722984724E+00 .2638470872E+00 .3285111406E+00 .3797079396E+00 .4228367902E+00
+ .4606357087E+00 .4946950177E+00 .5260140960E+00 .5552816794E+00 .5830087869E+00
+ .6095782085E+00 .6352901562E+00 .6604051276E+00 .6851596645E+00 .7097728347E+00
+ .7344631454E+00 .7594682220E+00 .7850620109E+00 .8115782354E+00 .8394395021E+00
+ .8691486865E+00 .9010729017E+00 .9346195925E+00 .9665648442E+00 .9902264300E+00
+ .1758691309E+00 .2678701940E+00 .3322145701E+00 .3827758131E+00 .4251027852E+00
+ .4619972338E+00 .4950781520E+00 .5253550412E+00 .5535208481E+00 .5800899961E+00
+ .6054425913E+00 .6298683395E+00 .6536160335E+00 .6769109738E+00 .6999546283E+00
+ .7229376864E+00 .7460606709E+00 .7695473620E+00 .7936586665E+00 .8187181940E+00
+ .8451434987E+00 .8734411360E+00 .9040030810E+00 .9363092509E+00 .9672782219E+00
+ .9903824535E+00 .1699679020E+00 .2604476004E+00 .3242806807E+00 .3747150469E+00
+ .4170975872E+00 .4541279994E+00 .4873817117E+00 .5178580506E+00 .5462247371E+00
+ .5729690216E+00 .5984685219E+00 .6230138170E+00 .6468369880E+00 .6701428607E+00
+ .6931204048E+00 .7159450202E+00 .7387890123E+00 .7618361262E+00 .7852931465E+00
+ .8094033709E+00 .8344651991E+00 .8608390351E+00 .8888721713E+00 .9185502225E+00
+ .9486091029E+00 .9753874439E+00 .9933986167E+00 .1672340286E+00 .2562593759E+00
+ .3190720161E+00 .3686958814E+00 .4103874230E+00 .4467955106E+00 .4794678482E+00
+ .5093908477E+00 .5372169120E+00 .5634163854E+00 .5883591017E+00 .6123316906E+00
+ .6355552922E+00 .6582196497E+00 .6805015539E+00 .7025639943E+00 .7245598260E+00
+ .7466453256E+00 .7689918947E+00 .7917944977E+00 .8152847441E+00 .8397484288E+00
+ .8655275453E+00 .8929344949E+00 .9218904938E+00 .9510534385E+00 .9767780630E+00
+ .9938455836E+00 .1683673279E+00 .2574727367E+00 .3201207496E+00 .3694788913E+00
+ .4108536802E+00 .4469121895E+00 .4792002739E+00 .5087108396E+00 .5361052539E+00
+ .5618461868E+00 .5862927576E+00 .6097326228E+00 .6323879787E+00 .6544386464E+00
+ .6760480832E+00 .6973697026E+00 .7185451186E+00 .7397113518E+00 .7610128509E+00
+ .7826097001E+00 .8046852275E+00 .8274584749E+00 .8511964260E+00 .8761992366E+00
+ .9026746858E+00 .9303233105E+00 .9575092590E+00 .9805737263E+00 .9950881713E+00
+ .1675997599E+00 .2565182791E+00 .3190157783E+00 .3682056505E+00 .4093872082E+00
+ .4452309338E+00 .4772754124E+00 .5065096288E+00 .5336031475E+00 .5590186557E+00
+ .5831041710E+00 .6061428550E+00 .6283600218E+00 .6499324982E+00 .6710128672E+00
+ .6917446536E+00 .7122619133E+00 .7326899876E+00 .7531546082E+00 .7737912931E+00
+ .7947512964E+00 .8162091832E+00 .8383740268E+00 .8614947256E+00 .8858253791E+00
+ .9114581379E+00 .9378683790E+00 .9631686138E+00 .9837848916E+00 .9960885569E+00
+ .1674579039E+00 .2553771391E+00 .3175044097E+00 .3663989025E+00 .4072913963E+00
+ .4428419450E+00 .4745858723E+00 .5035033086E+00 .5302628564E+00 .5553322151E+00
+ .5790544515E+00 .6016904538E+00 .6234753124E+00 .6445925724E+00 .6651878438E+00
+ .6853929834E+00 .7053327184E+00 .7251238508E+00 .7448789566E+00 .7647141099E+00
+ .7847556834E+00 .8051487849E+00 .8260657896E+00 .8476983908E+00 .8702662942E+00
+ .8939507799E+00 .9186919190E+00 .9437532142E+00 .9671673052E+00 .9857295757E+00
+ .9965753970E+00 .1673160478E+00 .2547117089E+00 .3164940324E+00 .3650704380E+00
+ .4056493032E+00 .4408874524E+00 .4723185265E+00 .5009140898E+00 .5273395708E+00
+ .5520664923E+00 .5754352504E+00 .5977095955E+00 .6191084667E+00 .6398108900E+00
+ .6599599607E+00 .6796788251E+00 .6990839317E+00 .7182798657E+00 .7373880811E+00
+ .7565100507E+00 .7757540232E+00 .7952393521E+00 .8151010691E+00 .8354966251E+00
+ .8566097074E+00 .8786329875E+00 .9016837499E+00 .9255725050E+00 .9493818106E+00
+ .9710635662E+00 .9877029582E+00 .9971077595E+00 .1671741918E+00 .2544787421E+00
+ .3159391086E+00 .3641767896E+00 .4044196907E+00 .4393279645E+00 .4704350012E+00
+ .4987040701E+00 .5247953932E+00 .5491832005E+00 .5722074406E+00 .5941240505E+00
+ .6151268785E+00 .6354212211E+00 .6551480815E+00 .6744247468E+00 .6933587957E+00
+ .7120534257E+00 .7306057464E+00 .7491084845E+00 .7676556875E+00 .7863485771E+00
+ .8052987493E+00 .8246486046E+00 .8445403276E+00 .8651455241E+00 .8866316362E+00
+ .9090599625E+00 .9321319249E+00 .9547774613E+00 .9748667287E+00 .9897023940E+00
+ .9976814883E+00 .1670323357E+00 .2546400854E+00 .3157994569E+00 .3636795931E+00
+ .4035661719E+00 .4381286348E+00 .4689014360E+00 .4968397932E+00 .5225968842E+00
+ .5466486228E+00 .5693364975E+00 .5909097444E+00 .6115725618E+00 .6315021950E+00
+ .6508433936E+00 .6697108033E+00 .6882049292E+00 .7064232097E+00 .7244589113E+00
+ .7423986786E+00 .7603267208E+00 .7783314602E+00 .7965093179E+00 .8149672091E+00
+ .8338270851E+00 .8532311018E+00 .8733389753E+00 .8942947322E+00 .9161108983E+00
+ .9383985688E+00 .9599607217E+00 .9785850229E+00 .9917256444E+00 .9982929537E+00
+ .1585249168E+00 .2426109500E+00 .3017493822E+00 .3482992139E+00 .3872391281E+00
+ .4211031592E+00 .4513468014E+00 .4788657312E+00 .5042820661E+00 .5280618430E+00
+ .5505339634E+00 .5719267025E+00 .5924285691E+00 .6122137723E+00 .6314278042E+00
+ .6501792670E+00 .6685571829E+00 .6866502239E+00 .7045479012E+00 .7223328487E+00
+ .7400807308E+00 .7578680761E+00 .7757783311E+00 .7939032638E+00 .8123447180E+00
+ .8312197059E+00 .8506659790E+00 .8708403385E+00 .8918893988E+00 .9138428471E+00
+ .9363535065E+00 .9582817532E+00 .9774320518E+00 .9911523766E+00 .9981421322E+00
+ .1632319790E+00 .2490914042E+00 .3090811124E+00 .3560531545E+00 .3951705625E+00
+ .4290436349E+00 .4591838230E+00 .4865262766E+00 .5116980430E+00 .5351649360E+00
+ .5572739492E+00 .5782701848E+00 .5983394542E+00 .6176465145E+00 .6363379668E+00
+ .6545303469E+00 .6723142907E+00 .6897719094E+00 .7069861203E+00 .7240369143E+00
+ .7409972805E+00 .7579369518E+00 .7749290700E+00 .7920534043E+00 .8093972830E+00
+ .8270583765E+00 .8451495683E+00 .8638016602E+00 .8831539270E+00 .9033068346E+00
+ .9241856606E+00 .9452655842E+00 .9652315154E+00 .9819444367E+00 .9932693518E+00
+ .9986677826E+00 .1612185066E+00 .2459655186E+00 .3055128516E+00 .3522118954E+00
+ .3911264358E+00 .4248259449E+00 .4548064212E+00 .4820032543E+00 .5070358529E+00
+ .5303556326E+00 .5523077399E+00 .5731456091E+00 .5930550701E+00 .6121901561E+00
+ .6306902086E+00 .6486743181E+00 .6662366845E+00 .6834557447E+00 .7004065118E+00
+ .7171637013E+00 .7337980939E+00 .7503756355E+00 .7669617427E+00 .7836260238E+00
+ .8004443411E+00 .8175001412E+00 .8348874114E+00 .8527141137E+00 .8711007924E+00
+ .8901616580E+00 .9099399940E+00 .9302548205E+00 .9504431211E+00 .9691188681E+00
+ .9842994183E+00 .9942691269E+00 .9988862732E+00 .1592050342E+00 .2435623545E+00
+ .3026810870E+00 .3490456153E+00 .3876929169E+00 .4211622029E+00 .4509360605E+00
+ .4779494945E+00 .5028115609E+00 .5259580485E+00 .5477323178E+00 .5683954180E+00
+ .5881323601E+00 .6070864678E+00 .6253897746E+00 .6431632985E+00 .6605046557E+00
+ .6774894518E+00 .6941855848E+00 .7106625058E+00 .7269888445E+00 .7432278269E+00
+ .7594389369E+00 .7756834509E+00 .7920278772E+00 .8085446856E+00 .8253136652E+00
+ .8424251955E+00 .8599828709E+00 .8780993202E+00 .8968706748E+00 .9162986722E+00
+ .9361198612E+00 .9555479807E+00 .9730965625E+00 .9868514224E+00 .9954414191E+00
+ .9991695174E+00 .1591098551E+00 .2428133467E+00 .3012903593E+00 .3470637614E+00
+ .3851636748E+00 .4181222172E+00 .4474177267E+00 .4739773270E+00 .4984011489E+00
+ .5211206351E+00 .5424793222E+00 .5627380437E+00 .5820772798E+00 .6006333423E+00
+ .6185342422E+00 .6359018093E+00 .6528348977E+00 .6694060053E+00 .6856765272E+00
+ .7017107011E+00 .7175750692E+00 .7333309965E+00 .7490331328E+00 .7647351723E+00
+ .7804952867E+00 .7963771182E+00 .8124493940E+00 .8287878719E+00 .8454790868E+00
+ .8626225317E+00 .8803257613E+00 .8986788924E+00 .9176791771E+00 .9370679274E+00
+ .9560858182E+00 .9733015275E+00 .9868599351E+00 .9953977915E+00 .9991498223E+00
+ .1584162142E+00 .2410746466E+00 .2991712093E+00 .3446790865E+00 .3825515771E+00
+ .4152978722E+00 .4443695231E+00 .4706874480E+00 .4948895158E+00 .5173948523E+00
+ .5385334559E+00 .5585662311E+00 .5776751106E+00 .5959998538E+00 .6136631840E+00
+ .6307789085E+00 .6474477507E+00 .6637470744E+00 .6797328577E+00 .6954659827E+00
+ .7110074662E+00 .7264168146E+00 .7417476385E+00 .7570492435E+00 .7723732592E+00
+ .7877755642E+00 .8033164006E+00 .8190609074E+00 .8350814307E+00 .8514635000E+00
+ .8683028646E+00 .8856905222E+00 .9036888169E+00 .9222451449E+00 .9410356745E+00
+ .9592331077E+00 .9754335824E+00 .9879868820E+00 .9957989284E+00 .9992194920E+00
+ .1577225734E+00 .2395359338E+00 .2972667525E+00 .3425027564E+00 .3801396236E+00
+ .4126677659E+00 .4415384232E+00 .4676689324E+00 .4916433109E+00 .5139318685E+00
+ .5348503371E+00 .5546577360E+00 .5735509121E+00 .5916675977E+00 .6091093992E+00
+ .6259784298E+00 .6423890844E+00 .6584237918E+00 .6741421053E+00 .6895934989E+00
+ .7048312463E+00 .7199092736E+00 .7348862264E+00 .7498130088E+00 .7647341155E+00
+ .7796979435E+00 .7947576402E+00 .8099702269E+00 .8254024411E+00 .8411240977E+00
+ .8572128054E+00 .8737559946E+00 .8908359670E+00 .9084907368E+00 .9266249200E+00
+ .9448364215E+00 .9622366835E+00 .9774745686E+00 .9890778224E+00 .9961969448E+00
+ .9992919956E+00 .1570289325E+00 .2381828924E+00 .2955616516E+00 .3405198903E+00
+ .3779135160E+00 .4102180019E+00 .4388720817E+00 .4648003231E+00 .4886193584E+00
+ .5107128648E+00 .5314111693E+00 .5509937859E+00 .5696644768E+00 .5875644955E+00
+ .6047940872E+00 .6214237843E+00 .6375859220E+00 .6533637700E+00 .6688148016E+00
+ .6839954039E+00 .6989520057E+00 .7137366284E+00 .7284013546E+00 .7429924527E+00
+ .7575511590E+00 .7721191701E+00 .7867453746E+00 .8014809272E+00 .8163790030E+00
+ .8315134498E+00 .8469429089E+00 .8627438117E+00 .8789981488E+00 .8957776956E+00
+ .9131049582E+00 .9308295967E+00 .9484694215E+00 .9651067668E+00 .9794309358E+00
+ .9901353908E+00 .9965920581E+00 .9993671271E+00 .1563352917E+00 .2370025804E+00
+ .2940419966E+00 .3387169922E+00 .3758602861E+00 .4079360197E+00 .4363709996E+00
+ .4620854119E+00 .4856996642E+00 .5076273684E+00 .5281657263E+00 .5475445058E+00
+ .5659523872E+00 .5836090649E+00 .6006094174E+00 .6170373669E+00 .6329827333E+00
+ .6485325827E+00 .6637555546E+00 .6786996221E+00 .6934049610E+00 .7079167199E+00
+ .7222811544E+00 .7365519707E+00 .7507748061E+00 .7649868397E+00 .7792285967E+00
+ .7935450167E+00 .8079841955E+00 .8225972702E+00 .8374403532E+00 .8525768202E+00
+ .8680782399E+00 .8840586806E+00 .9005641993E+00 .9175676899E+00 .9348715917E+00
+ .9519505701E+00 .9678526958E+00 .9813086108E+00 .9911618524E+00 .9969844730E+00
+ .9994447122E+00 .1556416508E+00 .2359832224E+00 .2926951537E+00 .3370817898E+00
+ .3739681602E+00 .4058103701E+00 .4340239071E+00 .4595229809E+00 .4829310671E+00
+ .5046484600E+00 .5249391751E+00 .5441086777E+00 .5623607455E+00 .5798508730E+00
+ .5966821007E+00 .6129245528E+00 .6286563541E+00 .6439800403E+00 .6589642249E+00
+ .6736601796E+00 .6881153231E+00 .7023686186E+00 .7164657906E+00 .7304532508E+00
+ .7443716545E+00 .7582561544E+00 .7721417102E+00 .7860703891E+00 .8000886287E+00
+ .8142412930E+00 .8285830240E+00 .8431687593E+00 .8580585807E+00 .8733209664E+00
+ .8890236656E+00 .9052126984E+00 .9218770493E+00 .9387622858E+00 .9552901223E+00
+ .9704829729E+00 .9831129406E+00 .9921593622E+00 .9973743713E+00 .9995245791E+00
+ .1549480099E+00 .2351140970E+00 .2915095901E+00 .3356030928E+00 .3722263817E+00
+ .4038306436E+00 .4318205331E+00 .4571028772E+00 .4802678764E+00 .5017551488E+00
+ .5218845094E+00 .5408809567E+00 .5589473790E+00 .5762476618E+00 .5928920187E+00
+ .6089548322E+00 .6244902911E+00 .6396057794E+00 .6543781604E+00 .6688644313E+00
+ .6831023993E+00 .6971249385E+00 .7109718268E+00 .7246856595E+00 .7383134744E+00
+ .7518942443E+00 .7654594827E+00 .7790434953E+00 .7926849702E+00 .8064255246E+00
+ .8203086121E+00 .8343927239E+00 .8487249917E+00 .8633658401E+00 .8783802955E+00
+ .8938282713E+00 .9097380824E+00 .9260497648E+00 .9425117016E+00 .9584976144E+00
+ .9730052407E+00 .9848488613E+00 .9931298283E+00 .9977619227E+00 .9996065716E+00
+ .1542543691E+00 .2343853906E+00 .2904747952E+00 .3342707184E+00 .3706251563E+00
+ .4019873001E+00 .4297515109E+00 .4547935067E+00 .4777496624E+00 .4990715362E+00
+ .5190348611E+00 .5378561942E+00 .5557357528E+00 .5728450858E+00 .5892902150E+00
+ .6051604147E+00 .6205214495E+00 .6354472011E+00 .6500157302E+00 .6642908267E+00
+ .6783128023E+00 .6921112500E+00 .7057248778E+00 .7191949528E+00 .7325637148E+00
+ .7458676852E+00 .7591376790E+00 .7724046033E+00 .7857039023E+00 .7990734001E+00
+ .8125531005E+00 .8261849193E+00 .8400146890E+00 .8540952104E+00 .8684930071E+00
+ .8832640698E+00 .8984616535E+00 .9140991905E+00 .9300863465E+00 .9461261000E+00
+ .9615815766E+00 .9754265618E+00 .9865207780E+00 .9940750470E+00 .9981472800E+00
+ .9996905571E+00 .1535607282E+00 .2337881398E+00 .2895811428E+00 .3330753020E+00
+ .3691555088E+00 .4002716573E+00 .4278082568E+00 .4526532966E+00 .4754353295E+00
+ .4965842325E+00 .5163771750E+00 .5350214404E+00 .5527129786E+00 .5696303252E+00
+ .5859021515E+00 .6016040520E+00 .6167909818E+00 .6315288394E+00 .6458962423E+00
+ .6599638582E+00 .6737788851E+00 .6873701607E+00 .7007651370E+00 .7140004547E+00
+ .7271186131E+00 .7401585071E+00 .7531512211E+00 .7661239806E+00 .7791063450E+00
+ .7921325187E+00 .8052396670E+00 .8184662161E+00 .8318526731E+00 .8454439911E+00
+ .8592912777E+00 .8734515244E+00 .8879835981E+00 .9029348371E+00 .9183064621E+00
+ .9339830013E+00 .9496228988E+00 .9645499554E+00 .9777534197E+00 .9881327993E+00
+ .9949965921E+00 .9985305902E+00 .9997764066E+00 .1534015421E+00 .2332572024E+00
+ .2889513250E+00 .3323827494E+00 .3683983244E+00 .3994508299E+00 .4269361418E+00
+ .4517266829E+00 .4744320270E+00 .4954941249E+00 .5152148339E+00 .5338013002E+00
+ .5514254192E+00 .5682500065E+00 .5844138904E+00 .6000133568E+00 .6151101154E+00
+ .6297577144E+00 .6440188187E+00 .6579604006E+00 .6716385070E+00 .6850913795E+00
+ .6983467073E+00 .7114335141E+00 .7243870530E+00 .7372447342E+00 .7500400888E+00
+ .7628015279E+00 .7755559910E+00 .7883328813E+00 .8011650197E+00 .8140874762E+00
+ .8271369593E+00 .8403528863E+00 .8537790877E+00 .8674645119E+00 .8814613486E+00
+ .8958173608E+00 .9105551539E+00 .9256271411E+00 .9408380618E+00 .9557480677E+00
+ .9696139438E+00 .9814698745E+00 .9904243048E+00 .9960946869E+00 .9988899525E+00
+ .9998360774E+00 .1532423559E+00 .2332392992E+00 .2888410700E+00 .3321645669E+00
+ .3680688026E+00 .3990170582E+00 .4264174726E+00 .4511265059E+00 .4737331228E+00
+ .4946887664E+00 .5143190071E+00 .5328326807E+00 .5503794007E+00 .5671047753E+00
+ .5831541063E+00 .5986425829E+00 .6136407351E+00 .6281932064E+00 .6423476748E+00
+ .6561649982E+00 .6697070013E+00 .6830207345E+00 .6961362702E+00 .7090774444E+00
+ .7218726839E+00 .7345564604E+00 .7471633961E+00 .7597232985E+00 .7722618833E+00
+ .7848049682E+00 .7973813912E+00 .8100229096E+00 .8227629969E+00 .8356368269E+00
+ .8486826243E+00 .8619430027E+00 .8754648448E+00 .8892959242E+00 .9034739225E+00
+ .9179991346E+00 .9327798538E+00 .9475477965E+00 .9617705216E+00 .9746356389E+00
+ .9852062493E+00 .9927745164E+00 .9972517329E+00 .9992820003E+00 .9999040494E+00
+ .1467459402E+00 .2241006569E+00 .2781704159E+00 .3204570007E+00 .3556063744E+00
+ .3859907846E+00 .4129395929E+00 .4372579945E+00 .4595350193E+00 .4802317360E+00
+ .4996540527E+00 .5179765503E+00 .5353333178E+00 .5518799449E+00 .5677773556E+00
+ .5831426673E+00 .5980332455E+00 .6124778315E+00 .6265173921E+00 .6402172721E+00
+ .6536478568E+00 .6668600877E+00 .6798800092E+00 .6927232378E+00 .7054121777E+00
+ .7179807512E+00 .7304664761E+00 .7429009368E+00 .7553079068E+00 .7677087114E+00
+ .7801280016E+00 .7925950214E+00 .8051413784E+00 .8177992835E+00 .8306023102E+00
+ .8435875438E+00 .8567971482E+00 .8702784924E+00 .8840821586E+00 .8982545920E+00
+ .9128173492E+00 .9277206061E+00 .9427617615E+00 .9574830767E+00 .9711121872E+00
+ .9826576366E+00 .9912374456E+00 .9965357250E+00 .9990552724E+00 .9998677334E+00
+ .1495251926E+00 .2278766648E+00 .2824415890E+00 .3250091262E+00 .3603094519E+00
+ .3907514002E+00 .4177218946E+00 .4420517987E+00 .4643003565E+00 .4849107776E+00
+ .5042221326E+00 .5224498475E+00 .5397266628E+00 .5561738718E+00 .5719302539E+00
+ .5871256978E+00 .6018468002E+00 .6161367714E+00 .6300259050E+00 .6435590407E+00
+ .6567967924E+00 .6697969289E+00 .6825985582E+00 .6952233662E+00 .7076891176E+00
+ .7200208538E+00 .7322510859E+00 .7444124100E+00 .7565316930E+00 .7686308065E+00
+ .7807314210E+00 .7928585147E+00 .8050403094E+00 .8173065345E+00 .8296878089E+00
+ .8422167968E+00 .8549298269E+00 .8678675944E+00 .8810741048E+00 .8945920150E+00
+ .9084493297E+00 .9226285372E+00 .9370090437E+00 .9512853543E+00 .9648947127E+00
+ .9770299412E+00 .9868213021E+00 .9936832559E+00 .9976469382E+00 .9993989245E+00
+ .9999215607E+00 .1504204413E+00 .2289956338E+00 .2836095034E+00 .3261567988E+00
+ .3613990946E+00 .3917513215E+00 .4186180758E+00 .4428474572E+00 .4649896670E+00
+ .4854710766E+00 .5046364869E+00 .5227229213E+00 .5398715915E+00 .5561899538E+00
+ .5717992937E+00 .5868282061E+00 .6013772851E+00 .6155024260E+00 .6292329378E+00
+ .6426021113E+00 .6556608155E+00 .6684669754E+00 .6810670695E+00 .6934887501E+00
+ .7057489238E+00 .7178668149E+00 .7298698292E+00 .7417895677E+00 .7536546792E+00
+ .7654880468E+00 .7773096756E+00 .7891411260E+00 .8010073575E+00 .8129356844E+00
+ .8249543554E+00 .8370926797E+00 .8493824160E+00 .8618590127E+00 .8745616606E+00
+ .8875312529E+00 .9008036951E+00 .9143927303E+00 .9282537412E+00 .9422227485E+00
+ .9559406400E+00 .9688049158E+00 .9800229914E+00 .9888259463E+00 .9947974619E+00
+ .9981236010E+00 .9995372078E+00 .9999418211E+00 .1520362107E+00 .2310961291E+00
+ .2858950548E+00 .3285029695E+00 .3637422706E+00 .3940431087E+00 .4208263079E+00
+ .4449652452E+00 .4670134797E+00 .4873795481E+00 .5064032005E+00 .5243402289E+00
+ .5413500146E+00 .5575360411E+00 .5730010946E+00 .5878633905E+00 .6022312798E+00
+ .6161760481E+00 .6297338002E+00 .6429310670E+00 .6558070112E+00 .6684141747E+00
+ .6808030646E+00 .6930087568E+00 .7050513181E+00 .7169467301E+00 .7287166468E+00
+ .7403893452E+00 .7519939017E+00 .7635549081E+00 .7750923874E+00 .7866255522E+00
+ .7981760948E+00 .8097686062E+00 .8214292088E+00 .8331847455E+00 .8450634576E+00
+ .8570963063E+00 .8693176978E+00 .8817647950E+00 .8944741610E+00 .9074723606E+00
+ .9207542195E+00 .9342414822E+00 .9477208573E+00 .9607797919E+00 .9727885011E+00
+ .9829940849E+00 .9907547244E+00 .9958320165E+00 .9985492572E+00 .9996556674E+00
+ .9999584400E+00 .1506550414E+00 .2289172930E+00 .2831179533E+00 .3252241822E+00
+ .3600162602E+00 .3899221049E+00 .4163511865E+00 .4401437304E+00 .4618424479E+00
+ .4818780359E+00 .5006060645E+00 .5182672035E+00 .5349936461E+00 .5508792112E+00
+ .5660398764E+00 .5806120334E+00 .5947091906E+00 .6083924181E+00 .6216829909E+00
+ .6345996902E+00 .6471846083E+00 .6594989714E+00 .6715998810E+00 .6835222197E+00
+ .6952800324E+00 .7068822747E+00 .7183471585E+00 .7297041873E+00 .7409856943E+00
+ .7522178338E+00 .7634187806E+00 .7746037396E+00 .7857907560E+00 .7970024657E+00
+ .8082639907E+00 .8196005039E+00 .8310370621E+00 .8426003468E+00 .8543204151E+00
+ .8662313345E+00 .8783707719E+00 .8907782337E+00 .9034894007E+00 .9165207934E+00
+ .9298364773E+00 .9432905745E+00 .9565532156E+00 .9690579186E+00 .9800414155E+00
+ .9887389501E+00 .9947034183E+00 .9980673821E+00 .9995171164E+00 .9999384241E+00
+ .1487189977E+00 .2263910981E+00 .2803537538E+00 .3223792718E+00 .3571801768E+00
+ .3871193669E+00 .4135891068E+00 .4374688895E+00 .4593054324E+00 .4794721565E+00
+ .4982849384E+00 .5160139130E+00 .5328462982E+00 .5488878270E+00 .5642136176E+00
+ .5789144555E+00 .5930980546E+00 .6068578927E+00 .6202496225E+00 .6332978045E+00
+ .6460221957E+00 .6584575410E+00 .6706522752E+00 .6826528311E+00 .6944906783E+00
+ .7061826679E+00 .7177414765E+00 .7291853044E+00 .7405393764E+00 .7518305843E+00
+ .7630819406E+00 .7743117186E+00 .7855367061E+00 .7967756784E+00 .8080503225E+00
+ .8193840617E+00 .8308009415E+00 .8423258729E+00 .8539857848E+00 .8658105162E+00
+ .8778326288E+00 .8900853703E+00 .9025967391E+00 .9153752563E+00 .9283813382E+00
+ .9414804345E+00 .9543851093E+00 .9666148646E+00 .9775244356E+00 .9864456200E+00
+ .9929266162E+00 .9969536583E+00 .9989912512E+00 .9997730114E+00 .9999740990E+00
+ .4242682527E+00 .3118318689E+00 .5573192349E+00 .2564309048E+00 .4265397270E+00
+ .6082971026E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .2498266272E+00 .3954425755E+00 .5125397531E+00 .6264643813E+00 .7660440755E+00
+ .2312441904E+00 .3628153360E+00 .4647408573E+00 .5572385640E+00 .6537128592E+00
+ .7783980600E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .0000000000E+00 .0000000000E+00 .0000000000E+00 .2175109663E+00 .3375483770E+00
+ .4263481231E+00 .5015240337E+00 .5712296425E+00 .6413449623E+00 .7196681507E+00
+ .8251176560E+00 .2091027841E+00 .3233747108E+00 .4068532838E+00 .4762983716E+00
+ .5390987112E+00 .5998050901E+00 .6626760351E+00 .7346105423E+00 .8335743247E+00
+ .2028964798E+00 .3129134317E+00 .3924949585E+00 .4578169161E+00 .5158289293E+00
+ .5705039093E+00 .6248551338E+00 .6823607572E+00 .7493876701E+00 .8429805239E+00
+ .1995081188E+00 .3070508796E+00 .3842251490E+00 .4468740217E+00 .5016996216E+00
+ .5524059136E+00 .6015134556E+00 .6512976562E+00 .7048125164E+00 .7680131193E+00
+ .8566633313E+00 .1946893203E+00 .2990782320E+00 .3735306535E+00 .4334966162E+00
+ .4854322262E+00 .5328283884E+00 .5779386737E+00 .6225179671E+00 .6684299307E+00
+ .7184813802E+00 .7783761303E+00 .8632836990E+00 .1933808595E+00 .2966779391E+00
+ .3699876319E+00 .4286170685E+00 .4789168284E+00 .5242670817E+00 .5668094599E+00
+ .6080910832E+00 .6494708297E+00 .6925768647E+00 .7400243239E+00 .7971909494E+00
+ .8776737523E+00 .1916891182E+00 .2937189291E+00 .3658460816E+00 .4232187239E+00
+ .4720917608E+00 .5157466100E+00 .5562321095E+00 .5949895277E+00 .6331520148E+00
+ .6718289934E+00 .7124892441E+00 .7576087089E+00 .8122859651E+00 .8887237573E+00
+ .1914522305E+00 .2930005117E+00 .3645656605E+00 .4212411383E+00 .4692361706E+00
+ .5117747969E+00 .5508328507E+00 .5877918554E+00 .6237016208E+00 .6594555739E+00
+ .6960139730E+00 .7347307592E+00 .7779342461E+00 .8303776195E+00 .9025335953E+00
+ .1870901541E+00 .2860559353E+00 .3555924633E+00 .4104735250E+00 .4567683446E+00
+ .4976007557E+00 .5348562716E+00 .5698370453E+00 .6035137765E+00 .6366586808E+00
+ .6699935030E+00 .7043835086E+00 .7411107360E+00 .7823914797E+00 .8328051102E+00
+ .9029063342E+00 .1859608627E+00 .2840469172E+00 .3528067819E+00 .4069145587E+00
+ .4523826168E+00 .4922974006E+00 .5284895790E+00 .5622045112E+00 .5943754557E+00
+ .6257318536E+00 .6568866703E+00 .6884569502E+00 .7212262530E+00 .7563884509E+00
+ .7960372135E+00 .8444932546E+00 .9111961270E+00 .1872286741E+00 .2856314586E+00
+ .3544540945E+00 .4084896618E+00 .4537401392E+00 .4932940075E+00 .5289676408E+00
+ .5619624685E+00 .5931719824E+00 .6233064758E+00 .6529465606E+00 .6826086431E+00
+ .7128475957E+00 .7443920419E+00 .7783428764E+00 .8166108890E+00 .8631093698E+00
+ .9252995312E+00 .1760399982E+00 .2691470778E+00 .3347107278E+00 .3865961617E+00
+ .4303939524E+00 .4689422863E+00 .5039135847E+00 .5363842207E+00 .5671130353E+00
+ .5967008855E+00 .6256523682E+00 .6544275725E+00 .6835139071E+00 .7134886765E+00
+ .7451137272E+00 .7795459820E+00 .8188132095E+00 .8668752072E+00 .9299637391E+00
+ .1704933925E+00 .2603568411E+00 .3236228672E+00 .3736905964E+00 .4159356721E+00
+ .4530828275E+00 .4867461374E+00 .5179455589E+00 .5473831552E+00 .5756239220E+00
+ .6031342457E+00 .6303042150E+00 .6575260482E+00 .6852481953E+00 .7140081525E+00
+ .7445331020E+00 .7779549965E+00 .8162828992E+00 .8635447594E+00 .9267206452E+00
+ .1684204463E+00 .2564330137E+00 .3189819187E+00 .3685141155E+00 .4102622777E+00
+ .4468999911E+00 .4800056021E+00 .5105971965E+00 .5393660015E+00 .5668338379E+00
+ .5934383823E+00 .6195480250E+00 .6455068063E+00 .6716747080E+00 .6984646330E+00
+ .7263876445E+00 .7561547530E+00 .7888866017E+00 .8265610914E+00 .8728678647E+00
+ .9329701133E+00 .1663475001E+00 .2534593045E+00 .3153333605E+00 .3642792835E+00
+ .4054803279E+00 .4415777176E+00 .4741155584E+00 .5041050443E+00 .5322339063E+00
+ .5589923344E+00 .5847859256E+00 .6099692227E+00 .6348429227E+00 .6597167702E+00
+ .6849159065E+00 .7108234825E+00 .7379238239E+00 .7669050903E+00 .7988584349E+00
+ .8357046838E+00 .8809180882E+00 .9386446961E+00 .1642745539E+00 .2513117899E+00
+ .3125477487E+00 .3608632867E+00 .4014735460E+00 .4370037742E+00 .4689650730E+00
+ .4983574086E+00 .5258714263E+00 .5519756606E+00 .5770408012E+00 .6014072725E+00
+ .6253661500E+00 .6491648583E+00 .6730636017E+00 .6973680093E+00 .7224365997E+00
+ .7487267371E+00 .7768976516E+00 .8079956222E+00 .8438615863E+00 .8878615286E+00
+ .9438193900E+00 .1656737865E+00 .2525634599E+00 .3133268688E+00 .3610464905E+00
+ .4009960133E+00 .4358255255E+00 .4670441791E+00 .4956441305E+00 .5223233479E+00
+ .5475480700E+00 .5716626153E+00 .5949863536E+00 .6178050596E+00 .6403453004E+00
+ .6628177701E+00 .6854691426E+00 .7085851960E+00 .7324972731E+00 .7576408959E+00
+ .7846546259E+00 .8145549768E+00 .8491359216E+00 .8916717548E+00 .9458129310E+00
+ .1601686539E+00 .2445370910E+00 .3037298463E+00 .3503192153E+00 .3893887968E+00
+ .4235010615E+00 .4540922199E+00 .4821079709E+00 .5082441067E+00 .5329621248E+00
+ .5565664782E+00 .5793397190E+00 .6015667141E+00 .6234752380E+00 .6452404182E+00
+ .6670548160E+00 .6891583277E+00 .7118205434E+00 .7353561957E+00 .7601924638E+00
+ .7869613999E+00 .8166687994E+00 .8510863032E+00 .8934100313E+00 .9470117858E+00
+ .1638722990E+00 .2489640080E+00 .3081238715E+00 .3543655118E+00 .3929211238E+00
+ .4264140636E+00 .4563049155E+00 .4835509418E+00 .5088613659E+00 .5327041044E+00
+ .5553695794E+00 .5771211302E+00 .5982418147E+00 .6189624611E+00 .6394362441E+00
+ .6598117822E+00 .6802893349E+00 .7010985801E+00 .7224780513E+00 .7447193823E+00
+ .7682368574E+00 .7936428581E+00 .8219129036E+00 .8547840847E+00 .8954504671E+00
+ .9475369783E+00 .1579255808E+00 .2412961391E+00 .2997449433E+00 .3456763551E+00
+ .3840849496E+00 .4175297991E+00 .4474742774E+00 .4748003727E+00 .5001431154E+00
+ .5240087883E+00 .5467441613E+00 .5685707035E+00 .5896934841E+00 .6103389991E+00
+ .6307040715E+00 .6509330981E+00 .6711668600E+00 .6915857068E+00 .7124012775E+00
+ .7338477658E+00 .7562169856E+00 .7799175407E+00 .8055531711E+00 .8340845296E+00
+ .8671657545E+00 .9074632418E+00 .9563369170E+00 .1555266093E+00 .2376145050E+00
+ .2951630899E+00 .3403801313E+00 .3781705253E+00 .4110571487E+00 .4404940477E+00
+ .4673367319E+00 .4921864999E+00 .5155487013E+00 .5377889991E+00 .5591200954E+00
+ .5797098192E+00 .5997639130E+00 .6194895829E+00 .6390351108E+00 .6585112191E+00
+ .6780555081E+00 .6978490006E+00 .7180902521E+00 .7389977724E+00 .7608556441E+00
+ .7840670272E+00 .8092259895E+00 .8372786838E+00 .8698520737E+00 .9095361743E+00
+ .9575053811E+00 .1567118014E+00 .2389573876E+00 .2964160864E+00 .3414526235E+00
+ .3790108700E+00 .4116066560E+00 .4407273817E+00 .4672622326E+00 .4917782443E+00
+ .5147411235E+00 .5365425884E+00 .5574375630E+00 .5775779900E+00 .5971184367E+00
+ .6162499542E+00 .6351441661E+00 .6539177857E+00 .6726724551E+00 .6915451765E+00
+ .7107069808E+00 .7303409114E+00 .7506554541E+00 .7719283130E+00 .7945523513E+00
+ .8191056897E+00 .8465080315E+00 .8783079562E+00 .9167676748E+00 .9620487923E+00
+ .1558571872E+00 .2378981563E+00 .2952121190E+00 .3401072689E+00 .3775220712E+00
+ .4099422592E+00 .4388513986E+00 .4651771211E+00 .4894856939E+00 .5121947100E+00
+ .5336823774E+00 .5542432114E+00 .5740512041E+00 .5932278839E+00 .6119237386E+00
+ .6303113619E+00 .6485290089E+00 .6666716074E+00 .6848381767E+00 .7031648061E+00
+ .7218118881E+00 .7409497716E+00 .7607802780E+00 .7815765363E+00 .8037232655E+00
+ .8277867215E+00 .8546654663E+00 .8858320994E+00 .9232164014E+00 .9660354469E+00
+ .1558244324E+00 .2369927611E+00 .2940079673E+00 .3386629464E+00 .3758474516E+00
+ .4080349447E+00 .4366843971E+00 .4627306242E+00 .4867689213E+00 .5092050731E+00
+ .5303768671E+00 .5505661809E+00 .5699935065E+00 .5887942083E+00 .6070842525E+00
+ .6250044890E+00 .6426976055E+00 .6602740816E+00 .6778208324E+00 .6954374748E+00
+ .7132533764E+00 .7314197036E+00 .7501054109E+00 .7695045715E+00 .7898869150E+00
+ .8116318650E+00 .8352988861E+00 .8617628865E+00 .8923683190E+00 .9285627673E+00
+ .9688098826E+00 .1557916775E+00 .2365295653E+00 .2932669654E+00 .3376580835E+00
+ .3745863362E+00 .4065221820E+00 .4349022180E+00 .4606616407E+00 .4844210120E+00
+ .5065843915E+00 .5274567253E+00 .5473168378E+00 .5663978112E+00 .5848500676E+00
+ .6027698688E+00 .6202646600E+00 .6374718162E+00 .6545140954E+00 .6714918334E+00
+ .6884803632E+00 .7055811641E+00 .7229214325E+00 .7406395911E+00 .7588898981E+00
+ .7778675686E+00 .7978380749E+00 .8191738070E+00 .8424242198E+00 .8684395326E+00
+ .8984635814E+00 .9335817406E+00 .9715922728E+00 .1557589227E+00 .2364683688E+00
+ .2929470149E+00 .3370527411E+00 .3737011420E+00 .4053681102E+00 .4334698844E+00
+ .4589358655E+00 .4824084436E+00 .5042990882E+00 .5248869281E+00 .5444273878E+00
+ .5631458672E+00 .5812388686E+00 .5988056570E+00 .6159300854E+00 .6327226168E+00
+ .6493074855E+00 .6657858898E+00 .6822302733E+00 .6987141579E+00 .7153373237E+00
+ .7322202954E+00 .7495068014E+00 .7673369128E+00 .7859021128E+00 .8054626939E+00
+ .8263824223E+00 .8491978085E+00 .8747336548E+00 .9041580155E+00 .9383029903E+00
+ .9743817701E+00 .1557261679E+00 .2367737060E+00 .2930109696E+00 .3368116691E+00
+ .3731587070E+00 .4045410864E+00 .4323565330E+00 .4575230178E+00 .4807016376E+00
+ .5023195953E+00 .5226365717E+00 .5418754414E+00 .5602763085E+00 .5780417810E+00
+ .5952867319E+00 .6120731777E+00 .6284819000E+00 .6446322704E+00 .6606411452E+00
+ .6765873792E+00 .6925274198E+00 .7085346814E+00 .7247126737E+00 .7411783257E+00
+ .7580524358E+00 .7754762733E+00 .7936371870E+00 .8127896004E+00 .8332871238E+00
+ .8556507407E+00 .8806790073E+00 .9094870066E+00 .9427529409E+00 .9771778724E+00
+ .1478600131E+00 .2256003288E+00 .2798989934E+00 .3223924973E+00 .3578042320E+00
+ .3884720817E+00 .4156957546E+00 .4403728820E+00 .4631698669E+00 .4844845295E+00
+ .5045253012E+00 .5234893565E+00 .5416311485E+00 .5591784454E+00 .5762463876E+00
+ .5928671862E+00 .6090892622E+00 .6250258065E+00 .6408120723E+00 .6565408647E+00
+ .6722560167E+00 .6880013068E+00 .7038593406E+00 .7199420433E+00 .7363622062E+00
+ .7532320673E+00 .7706902608E+00 .7889268062E+00 .8081986226E+00 .8288606970E+00
+ .8514372848E+00 .8767391009E+00 .9059341024E+00 .9398866302E+00 .9756181042E+00
+ .1522291179E+00 .2316848958E+00 .2868691491E+00 .3298514124E+00 .3655046812E+00
+ .3962878122E+00 .4235616877E+00 .4481880228E+00 .4708200996E+00 .4919264344E+00
+ .5117748982E+00 .5305330760E+00 .5483902305E+00 .5655652012E+00 .5822263151E+00
+ .5984493100E+00 .6142668938E+00 .6297435625E+00 .6449905831E+00 .6601187546E+00
+ .6751968433E+00 .6902637412E+00 .7053713892E+00 .7206051547E+00 .7360675199E+00
+ .7518591290E+00 .7680865950E+00 .7848868285E+00 .8024449073E+00 .8210084419E+00
+ .8409210522E+00 .8626901769E+00 .8870820255E+00 .9151033723E+00 .9471248932E+00
+ .9794386977E+00 .1502866889E+00 .2286670680E+00 .2834177234E+00 .3261319063E+00
+ .3615735095E+00 .3921769379E+00 .4193107605E+00 .4438120384E+00 .4662937612E+00
+ .4872306286E+00 .5069322746E+00 .5255760067E+00 .5433101118E+00 .5603147760E+00
+ .5767687569E+00 .5927886350E+00 .6084246564E+00 .6237150877E+00 .6387334185E+00
+ .6535813710E+00 .6683480172E+00 .6830882369E+00 .6978420423E+00 .7126667029E+00
+ .7276456229E+00 .7428734056E+00 .7584452688E+00 .7744674400E+00 .7910771835E+00
+ .8084577903E+00 .8268544386E+00 .8466085390E+00 .8682196202E+00 .8924120949E+00
+ .9200255309E+00 .9510128375E+00 .9813297032E+00 .1483442599E+00 .2263283246E+00
+ .2806579843E+00 .3230460355E+00 .3582134623E+00 .3885838300E+00 .4155354897E+00
+ .4398761502E+00 .4621762625E+00 .4829174550E+00 .5024507463E+00 .5209631573E+00
+ .5385635042E+00 .5553923330E+00 .5716338162E+00 .5874422984E+00 .6028899255E+00
+ .6179964007E+00 .6327988256E+00 .6473827822E+00 .6618511954E+00 .6762780760E+00
+ .6907012737E+00 .7051554037E+00 .7197020108E+00 .7344270200E+00 .7494204091E+00
+ .7647705958E+00 .7805806759E+00 .7969875047E+00 .8141726412E+00 .8323773115E+00
+ .8519378820E+00 .8733458342E+00 .8973027684E+00 .9245615189E+00 .9547879509E+00
+ .9834393601E+00 .1485598308E+00 .2260933584E+00 .2799343821E+00 .3218522677E+00
+ .3565803974E+00 .3865401360E+00 .4130954592E+00 .4370478618E+00 .4589719276E+00
+ .4793516426E+00 .4985349059E+00 .5167023509E+00 .5339541154E+00 .5504235967E+00
+ .5662962852E+00 .5817363213E+00 .5968226082E+00 .6115671167E+00 .6259882694E+00
+ .6401587511E+00 .6541855667E+00 .6681556033E+00 .6821094603E+00 .6960665283E+00
+ .7100669355E+00 .7241847822E+00 .7385075941E+00 .7531158247E+00 .7680888108E+00
+ .7835272764E+00 .7995684370E+00 .8163915533E+00 .8342326476E+00 .8534217741E+00
+ .8744425211E+00 .8979870913E+00 .9248128097E+00 .9546645743E+00 .9832127048E+00
+ .1479694263E+00 .2245616905E+00 .2780767999E+00 .3197758666E+00 .3543139578E+00
+ .3840846256E+00 .4104485505E+00 .4342119393E+00 .4559571086E+00 .4761359471E+00
+ .4951035827E+00 .5130758815E+00 .5301572670E+00 .5464509194E+00 .5621107346E+00
+ .5772997053E+00 .5921300842E+00 .6066421390E+00 .6208403709E+00 .6347642613E+00
+ .6484971016E+00 .6621331812E+00 .6757373078E+00 .6893381240E+00 .7029576634E+00
+ .7166431756E+00 .7304689483E+00 .7445152604E+00 .7588557683E+00 .7735705721E+00
+ .7887632405E+00 .8045663778E+00 .8211559321E+00 .8387638010E+00 .8577139535E+00
+ .8784991217E+00 .9017571648E+00 .9280802345E+00 .9569493145E+00 .9840954243E+00
+ .1473790217E+00 .2232163367E+00 .2764176999E+00 .3178906656E+00 .3522311254E+00
+ .3818075796E+00 .4079980087E+00 .4316217743E+00 .4531844943E+00 .4731625218E+00
+ .4919131246E+00 .5096839039E+00 .5266029279E+00 .5427465236E+00 .5582144104E+00
+ .5731589496E+00 .5877350594E+00 .6020126887E+00 .6159992956E+00 .6296987304E+00
+ .6431616273E+00 .6564795450E+00 .6697469315E+00 .6830075585E+00 .6962738954E+00
+ .7095704726E+00 .7229531294E+00 .7364972422E+00 .7502817385E+00 .7643725072E+00
+ .7788428575E+00 .7937948158E+00 .8093628178E+00 .8257189630E+00 .8430906599E+00
+ .8618347791E+00 .8823966188E+00 .9053662244E+00 .9312067105E+00 .9591653705E+00
+ .9849974315E+00 .1467886172E+00 .2220439599E+00 .2749429032E+00 .3161830086E+00
+ .3503187832E+00 .3796962304E+00 .4056959943E+00 .4291603029E+00 .4506126049E+00
+ .4704140191E+00 .4889463011E+00 .5065097008E+00 .5232524025E+00 .5392356923E+00
+ .5545302034E+00 .5692493375E+00 .5835776879E+00 .5976119421E+00 .6113727826E+00
+ .6248589577E+00 .6380933359E+00 .6511469868E+00 .6641099403E+00 .6770487164E+00
+ .6899902032E+00 .7029434853E+00 .7159377422E+00 .7290355794E+00 .7423113856E+00
+ .7558466463E+00 .7696915182E+00 .7839206435E+00 .7986365997E+00 .8139720900E+00
+ .8301090927E+00 .8472904431E+00 .8658196975E+00 .8861463177E+00 .9088256613E+00
+ .9342025248E+00 .9613176060E+00 .9859172869E+00 .1461982126E+00 .2210325028E+00
+ .2736395498E+00 .3146405100E+00 .3485650346E+00 .3777390373E+00 .4035431559E+00
+ .4268324384E+00 .4481251046E+00 .4677872442E+00 .4861595827E+00 .5035262460E+00
+ .5200451952E+00 .5358411444E+00 .5509609874E+00 .5655055855E+00 .5796179684E+00
+ .5934224451E+00 .6069763734E+00 .6202774458E+00 .6333174698E+00 .6461330814E+00
+ .6588070702E+00 .6714360106E+00 .6840662570E+00 .6967056643E+00 .7093652959E+00
+ .7220847873E+00 .7349289187E+00 .7479661904E+00 .7612549197E+00 .7748505671E+00
+ .7888244915E+00 .8033196054E+00 .8184586680E+00 .8343979614E+00 .8513631718E+00
+ .8696707083E+00 .8897585633E+00 .9121459590E+00 .9370765716E+00 .9634104913E+00
+ .9868539136E+00 .1456078081E+00 .2201709954E+00 .2724959601E+00 .3132519076E+00
+ .3469590787E+00 .3759254810E+00 .4015293204E+00 .4246381014E+00 .4457701031E+00
+ .4652576552E+00 .4834020968E+00 .5005615530E+00 .5169360752E+00 .5326124438E+00
+ .5476201949E+00 .5620112504E+00 .5759122542E+00 .5894858081E+00 .6028148978E+00
+ .6159068361E+00 .6287513133E+00 .6413604326E+00 .6537968721E+00 .6661476597E+00
+ .6784805491E+00 .6908218049E+00 .7031726543E+00 .7155492595E+00 .7280032039E+00
+ .7406015997E+00 .7534136015E+00 .7664895870E+00 .7798817339E+00 .7936659364E+00
+ .8079437967E+00 .8228413188E+00 .8385610764E+00 .8553119026E+00 .8733968313E+00
+ .8932427774E+00 .9153365695E+00 .9398372743E+00 .9654480553E+00 .9878060679E+00
+ .1450174035E+00 .2194494490E+00 .2715014719E+00 .3120069318E+00 .3454910476E+00
+ .3742459972E+00 .3996452162E+00 .4225684011E+00 .4435049422E+00 .4628070585E+00
+ .4808050944E+00 .4977885664E+00 .5139850241E+00 .5295062912E+00 .5443794700E+00
+ .5586368102E+00 .5723637114E+00 .5857271392E+00 .5988400092E+00 .6117438140E+00
+ .6244221331E+00 .6368566794E+00 .6490773283E+00 .6611636442E+00 .6732097896E+00
+ .6852641210E+00 .6973318926E+00 .7094125511E+00 .7215312873E+00 .7337436651E+00
+ .7461151771E+00 .7587129356E+00 .7715760670E+00 .7847601663E+00 .7983432534E+00
+ .8124270847E+00 .8271366636E+00 .8426293161E+00 .8591448386E+00 .8770065010E+00
+ .8966074041E+00 .9184062309E+00 .9424921131E+00 .9674340022E+00 .9887726654E+00
+ .1444269990E+00 .2188587212E+00 .2706463682E+00 .3108962376E+00 .3441519563E+00
+ .3726918208E+00 .3978823884E+00 .4205939823E+00 .4413678704E+00 .4605478128E+00
+ .4783970950E+00 .4952016355E+00 .5112136287E+00 .5265732521E+00 .5412994753E+00
+ .5554184081E+00 .5690006215E+00 .5821754019E+00 .5950755535E+00 .6077744315E+00
+ .6202704914E+00 .6325339301E+00 .6445736380E+00 .6564467574E+00 .6682383855E+00
+ .6800170717E+00 .6918094597E+00 .7036135513E+00 .7154354305E+00 .7273111304E+00
+ .7393002478E+00 .7514631400E+00 .7638476787E+00 .7764978193E+00 .7894781406E+00
+ .8028626430E+00 .8167530581E+00 .8312729882E+00 .8465796049E+00 .8628845345E+00
+ .8805072179E+00 .8998602668E+00 .9213627175E+00 .9450481008E+00 .9693716955E+00
+ .9897528616E+00 .1438365944E+00 .2183904614E+00 .2699217499E+00 .3099112314E+00
+ .3429335712E+00 .3712549743E+00 .3962330886E+00 .4187710743E+00 .4394154414E+00
+ .4584677002E+00 .4761660627E+00 .4927888888E+00 .5086104114E+00 .5238022646E+00
+ .5384073898E+00 .5524140030E+00 .5658548333E+00 .5788440920E+00 .5915311263E+00
+ .6040222043E+00 .6163400712E+00 .6284503687E+00 .6403265353E+00 .6519978512E+00
+ .6635455488E+00 .6750574505E+00 .6865834042E+00 .6981277653E+00 .7096800063E+00
+ .7212524617E+00 .7328925876E+00 .7446645964E+00 .7566239670E+00 .7688108527E+00
+ .7812653486E+00 .7940458514E+00 .8072342794E+00 .8209318461E+00 .8352603995E+00
+ .8503763675E+00 .8664930207E+00 .8839060084E+00 .9030085561E+00 .9242133005E+00
+ .9475114213E+00 .9712642607E+00 .9907457505E+00 .1436951619E+00 .2179028828E+00
+ .2693394358E+00 .3092558004E+00 .3422252580E+00 .3705176276E+00 .3954405413E+00
+ .4178736988E+00 .4384188544E+00 .4574345858E+00 .4751348545E+00 .4917193180E+00
+ .5074210900E+00 .5224522004E+00 .5369330742E+00 .5508899130E+00 .5643215923E+00
+ .5772714105E+00 .5898434293E+00 .6021585933E+00 .6142958993E+00 .6262692488E+00
+ .6380549078E+00 .6496422814E+00 .6610658096E+00 .6723960231E+00 .6837028710E+00
+ .6950247880E+00 .7063678625E+00 .7177314372E+00 .7291349641E+00 .7406238173E+00
+ .7522539575E+00 .7640744775E+00 .7761254499E+00 .7884504984E+00 .8011098102E+00
+ .8141836333E+00 .8277705946E+00 .8419914499E+00 .8570024179E+00 .8730146855E+00
+ .8903136570E+00 .9092527909E+00 .9301195492E+00 .9526250791E+00 .9748067424E+00
+ .9921652317E+00 .1435537294E+00 .2178987769E+00 .2692459547E+00 .3090452522E+00
+ .3419166078E+00 .3701429902E+00 .3949823831E+00 .4172853850E+00 .4377040909E+00
+ .4566575168E+00 .4743442003E+00 .4908879036E+00 .5064715021E+00 .5213340908E+00
+ .5356694965E+00 .5495520921E+00 .5629626445E+00 .5758805953E+00 .5883563495E+00
+ .6005084046E+00 .6124603106E+00 .6242775778E+00 .6359548494E+00 .6474566832E+00
+ .6587732759E+00 .6699465623E+00 .6810514881E+00 .6921543953E+00 .7032852726E+00
+ .7144439925E+00 .7256298329E+00 .7368659712E+00 .7481998901E+00 .7596853475E+00
+ .7713671492E+00 .7832829186E+00 .7954767610E+00 .8080099623E+00 .8209621775E+00
+ .8344300305E+00 .8485324622E+00 .8634243389E+00 .8793142324E+00 .8964790949E+00
+ .9152427451E+00 .9357971553E+00 .9576179864E+00 .9784035611E+00 .9937108173E+00
+ .1374691422E+00 .2093255086E+00 .2592107724E+00 .2980366653E+00 .3302129817E+00
+ .3578627421E+00 .3821982547E+00 .4041227599E+00 .4242911370E+00 .4430332620E+00
+ .4604664887E+00 .4767222816E+00 .4920527960E+00 .5067476448E+00 .5209881355E+00
+ .5347923881E+00 .5480899869E+00 .5608474812E+00 .5731398226E+00 .5851232479E+00
+ .5969461833E+00 .6086735560E+00 .6202779149E+00 .6316948555E+00 .6428949549E+00
+ .6539193892E+00 .6648593784E+00 .6758024770E+00 .6867897219E+00 .6978138307E+00
+ .7088537602E+00 .7199136721E+00 .7310355306E+00 .7422806842E+00 .7537025183E+00
+ .7653361329E+00 .7772109626E+00 .7893702111E+00 .8018789829E+00 .8148199410E+00
+ .8282897196E+00 .8424061245E+00 .8573241540E+00 .8732552634E+00 .8904872428E+00
+ .9093838282E+00 .9302585045E+00 .9528476778E+00 .9751295618E+00 .9924128514E+00
+ .1401120401E+00 .2129399293E+00 .2633322008E+00 .3024288454E+00 .3347488099E+00
+ .3625318619E+00 .3869832812E+00 .4089094582E+00 .4289682469E+00 .4476164309E+00
+ .4650622138E+00 .4813855467E+00 .4967107267E+00 .5112608853E+00 .5252719058E+00
+ .5388783062E+00 .5520834174E+00 .5648302465E+00 .5771028796E+00 .5889763295E+00
+ .6005859810E+00 .6120521790E+00 .6234223597E+00 .6346706810E+00 .6457478760E+00
+ .6566391521E+00 .6673880150E+00 .6780741082E+00 .6887681106E+00 .6995004661E+00
+ .7102653375E+00 .7210513349E+00 .7318709866E+00 .7427663063E+00 .7537912342E+00
+ .7649912041E+00 .7763987863E+00 .7880460828E+00 .7999792244E+00 .8122627352E+00
+ .8249760025E+00 .8382127285E+00 .8520892202E+00 .8667587078E+00 .8824273293E+00
+ .8993653971E+00 .9178781237E+00 .9381114406E+00 .9594598809E+00 .9795673198E+00
+ .9941348565E+00 .1410029112E+00 .2140777057E+00 .2645532780E+00 .3036562532E+00
+ .3359302760E+00 .3636614134E+00 .3880766571E+00 .4099412420E+00 .4298794546E+00
+ .4483839505E+00 .4657266085E+00 .4820002805E+00 .4972769758E+00 .5117196355E+00
+ .5255558590E+00 .5389685845E+00 .5520200613E+00 .5646726174E+00 .5768776673E+00
+ .5886553337E+00 .6001072447E+00 .6113637647E+00 .6225140057E+00 .6335716522E+00
+ .6444963343E+00 .6552482798E+00 .6658335973E+00 .6763098910E+00 .6867541387E+00
+ .6972216228E+00 .7077273532E+00 .7182604214E+00 .7288153113E+00 .7394134537E+00
+ .7501003208E+00 .7609258966E+00 .7719290021E+00 .7831386555E+00 .7945877288E+00
+ .8063243283E+00 .8184130097E+00 .8309311671E+00 .8439703261E+00 .8576453288E+00
+ .8721076912E+00 .8875592449E+00 .9042574102E+00 .9224688042E+00 .9422424344E+00
+ .9628055767E+00 .9816964749E+00 .9949078057E+00 .1425865404E+00 .2161637073E+00
+ .2668590437E+00 .3060592550E+00 .3383460235E+00 .3660517582E+00 .3904520892E+00
+ .4122942293E+00 .4321506228E+00 .4505173854E+00 .4677312067E+00 .4839336153E+00
+ .4991742701E+00 .5135492201E+00 .5272432445E+00 .5404590650E+00 .5533197841E+00
+ .5658357740E+00 .5779563834E+00 .5896557248E+00 .6009841701E+00 .6120535346E+00
+ .6229767235E+00 .6338116286E+00 .6445486058E+00 .6551447746E+00 .6655752848E+00
+ .6758638570E+00 .6860743930E+00 .6962753487E+00 .7065064975E+00 .7167719888E+00
+ .7270608465E+00 .7373751607E+00 .7477432957E+00 .7582110479E+00 .7688229822E+00
+ .7796122117E+00 .7906059391E+00 .8018385608E+00 .8133596016E+00 .8252327855E+00
+ .8375332158E+00 .8503503882E+00 .8637976661E+00 .8780242943E+00 .8932262181E+00
+ .9096436118E+00 .9274940623E+00 .9467129135E+00 .9663532033E+00 .9838853157E+00
+ .9956707121E+00 .1413958080E+00 .2143084439E+00 .2645051027E+00 .3032925878E+00
+ .3352466197E+00 .3626554047E+00 .3867334602E+00 .4082482477E+00 .4278426108E+00
+ .4460227097E+00 .4630547949E+00 .4790116610E+00 .4939464583E+00 .5080188090E+00
+ .5214723473E+00 .5345155008E+00 .5472272577E+00 .5595636914E+00 .5714478814E+00
+ .5828668183E+00 .5939068199E+00 .6047125784E+00 .6154086509E+00 .6260410986E+00
+ .6365754178E+00 .6469453536E+00 .6571149182E+00 .6671120493E+00 .6770157605E+00
+ .6869112341E+00 .6968469005E+00 .7068223015E+00 .7168110863E+00 .7267983541E+00
+ .7368038187E+00 .7468764251E+00 .7570697317E+00 .7674211035E+00 .7779510271E+00
+ .7886792698E+00 .7996409235E+00 .8108896198E+00 .8224908008E+00 .8345174378E+00
+ .8470554485E+00 .8602155139E+00 .8741455912E+00 .8890434725E+00 .9051652612E+00
+ .9227918731E+00 .9420308219E+00 .9622418276E+00 .9811216203E+00 .9946373816E+00
+ .1394722935E+00 .2117349179E+00 .2616394039E+00 .3002855612E+00 .3321279392E+00
+ .3594669544E+00 .3835959320E+00 .4052302439E+00 .4248619949E+00 .4429564309E+00
+ .4599093312E+00 .4759382866E+00 .4910946680E+00 .5053943809E+00 .5189354289E+00
+ .5319046520E+00 .5444905813E+00 .5567923238E+00 .5687992057E+00 .5804478376E+00
+ .5917051216E+00 .6026158213E+00 .6132876148E+00 .6238330389E+00 .6343135469E+00
+ .6447228935E+00 .6550158789E+00 .6651577233E+00 .6751589156E+00 .6850745566E+00
+ .6949737489E+00 .7049042683E+00 .7148777387E+00 .7248827271E+00 .7349120541E+00
+ .7449821409E+00 .7551316923E+00 .7654052354E+00 .7758382404E+00 .7864560704E+00
+ .7972847610E+00 .8083619497E+00 .8197395747E+00 .8314806469E+00 .8436581761E+00
+ .8563605054E+00 .8697008460E+00 .8838272568E+00 .8989289747E+00 .9152213079E+00
+ .9328484756E+00 .9515832639E+00 .9702515987E+00 .9862678322E+00 .9964787457E+00
+ .3856332881E+00 .2882381345E+00 .5115142184E+00 .2396823560E+00 .3968244418E+00
+ .5616751620E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .2336081440E+00 .3691901731E+00 .4774996536E+00 .5821837851E+00 .7109926971E+00
+ .2171561063E+00 .3402765761E+00 .4350540227E+00 .5205239917E+00 .6091416591E+00
+ .7239036409E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00 .0000000000E+00
+ .0000000000E+00 .0000000000E+00 .0000000000E+00 .2047659832E+00 .3175827483E+00
+ .4007714555E+00 .4708149321E+00 .5354224557E+00 .6001853486E+00 .6721854373E+00
+ .7703907559E+00 .1972343043E+00 .3048859432E+00 .3833241840E+00 .4482589595E+00
+ .5066494829E+00 .5628829320E+00 .6209689691E+00 .6870435822E+00 .7791508694E+00
+ .1916470240E+00 .2954660881E+00 .3704175327E+00 .4316911892E+00 .4858056208E+00
+ .5365672129E+00 .5869215184E+00 .6400579616E+00 .7015719870E+00 .7887975725E+00
+ .1885584863E+00 .2901074781E+00 .3628958746E+00 .4218122562E+00 .4731336922E+00
+ .5203439926E+00 .5659137192E+00 .6120563020E+00 .6615071081E+00 .7195172735E+00
+ .8027004259E+00 .1842090998E+00 .2829051375E+00 .3532382107E+00 .4097497526E+00
+ .4585065292E+00 .5027625897E+00 .5446953222E+00 .5860725921E+00 .6286537023E+00
+ .6748761550E+00 .7297530826E+00 .8094551496E+00 .1830003954E+00 .2806370278E+00
+ .3499161388E+00 .4052316498E+00 .4525652176E+00 .4950613888E+00 .5347174621E+00
+ .5730713859E+00 .6115015980E+00 .6515085493E+00 .6953433332E+00 .7478084095E+00
+ .8243279549E+00 .1814734738E+00 .2779057126E+00 .3460864222E+00 .4002619079E+00
+ .4463234246E+00 .4873463379E+00 .5252089149E+00 .5612825878E+00 .5967391613E+00
+ .6327037151E+00 .6704930718E+00 .7122128902E+00 .7624906512E+00 .8360640576E+00
+ .1812900723E+00 .2772171470E+00 .3448282208E+00 .3983570404E+00 .4436249533E+00
+ .4836741201E+00 .5203270794E+00 .5548392614E+00 .5882352824E+00 .6214611263E+00
+ .6554815149E+00 .6914975733E+00 .7315087742E+00 .7799325266E+00 .8506087067E+00
+ .1773407017E+00 .2709358181E+00 .3367235743E+00 .3886313281E+00 .4323532934E+00
+ .4708576582E+00 .5058982942E+00 .5386421626E+00 .5700014568E+00 .6007891394E+00
+ .6317776232E+00 .6637893157E+00 .6979325907E+00 .7361449735E+00 .7827322504E+00
+ .8512645053E+00 .1763515343E+00 .2691168890E+00 .3341533092E+00 .3853451145E+00
+ .4283109148E+00 .4659787338E+00 .5000833217E+00 .5317468700E+00 .5617969272E+00
+ .5909470001E+00 .6198694066E+00 .6492257129E+00 .6797554789E+00 .7124993029E+00
+ .7493116236E+00 .7943443528E+00 .8605357945E+00 .1775661957E+00 .2706126452E+00
+ .3356159067E+00 .3866862606E+00 .4294447888E+00 .4667759536E+00 .5004096743E+00
+ .5314677937E+00 .5607361911E+00 .5888447075E+00 .6163754729E+00 .6439032144E+00
+ .6720166392E+00 .7014026100E+00 .7330619508E+00 .7687949001E+00 .8125998015E+00
+ .8765986564E+00 .1672555456E+00 .2554103571E+00 .3173040706E+00 .3661474230E+00
+ .4072818928E+00 .4434156045E+00 .4761058259E+00 .5063870992E+00 .5350139133E+00
+ .5625282495E+00 .5893789812E+00 .6160244386E+00 .6429327951E+00 .6706211265E+00
+ .6997949690E+00 .7315405265E+00 .7677726239E+00 .8127143053E+00 .8787853556E+00
+ .1623076665E+00 .2475172416E+00 .3073100342E+00 .3544736126E+00 .3941782940E+00
+ .4290299123E+00 .4604950336E+00 .4895704905E+00 .5170011217E+00 .5432782392E+00
+ .5687731843E+00 .5938947360E+00 .6190601159E+00 .6446542072E+00 .6711481629E+00
+ .6992389025E+00 .7299880929E+00 .7652779598E+00 .8093078830E+00 .8747119414E+00
+ .1603255738E+00 .2437690243E+00 .3028853147E+00 .3495568432E+00 .3887906883E+00
+ .4231605593E+00 .4541394099E+00 .4826709456E+00 .5094563240E+00 .5350195015E+00
+ .5597283838E+00 .5838958323E+00 .6078857032E+00 .6320625786E+00 .6567831351E+00
+ .6825068388E+00 .7099124829E+00 .7400555613E+00 .7748463114E+00 .8185822835E+00
+ .8832035902E+00 .1583434810E+00 .2409280693E+00 .2994062166E+00 .3455367140E+00
+ .3842530234E+00 .4181049295E+00 .4485772025E+00 .4765777411E+00 .5027561385E+00
+ .5276452157E+00 .5516305466E+00 .5749801720E+00 .5979737504E+00 .6209546624E+00
+ .6442303334E+00 .6681278213E+00 .6930955320E+00 .7197927750E+00 .7492475807E+00
+ .7833378811E+00 .8262851240E+00 .8895778163E+00 .1563613883E+00 .2388760425E+00
+ .2967493961E+00 .3422962814E+00 .3804544364E+00 .4137568986E+00 .4437049225E+00
+ .4711856892E+00 .4967903974E+00 .5210399974E+00 .5443561761E+00 .5669978589E+00
+ .5891694729E+00 .6111431880E+00 .6332218959E+00 .6556722561E+00 .6787905553E+00
+ .7030147204E+00 .7289831483E+00 .7576782837E+00 .7908930429E+00 .8326214548E+00
+ .8941108476E+00 .1578739023E+00 .2403681926E+00 .2978869027E+00 .3429558052E+00
+ .3805701037E+00 .4132701136E+00 .4425772352E+00 .4693977768E+00 .4942952596E+00
+ .5177570092E+00 .5402209084E+00 .5619674755E+00 .5831616153E+00 .6040095183E+00
+ .6247909336E+00 .6457612790E+00 .6671356440E+00 .6891999852E+00 .7123893147E+00
+ .7373140168E+00 .7649181459E+00 .7969473067E+00 .8372985583E+00 .8969599038E+00
+ .1527197324E+00 .2328316965E+00 .2888527805E+00 .3328492099E+00 .3696163508E+00
+ .4015898627E+00 .4302701223E+00 .4565520559E+00 .4809374290E+00 .5038555631E+00
+ .5257590613E+00 .5469710908E+00 .5676323140E+00 .5878660204E+00 .6079090198E+00
+ .6280372023E+00 .6484536335E+00 .6693406897E+00 .6909919003E+00 .7138485546E+00
+ .7385105493E+00 .7659167319E+00 .7978177027E+00 .8381123301E+00 .8977213246E+00
+ .1564331923E+00 .2373795737E+00 .2934982367E+00 .3372824162E+00 .3736710596E+00
+ .4051592074E+00 .4332795323E+00 .4589489043E+00 .4826666549E+00 .5048435048E+00
+ .5259347722E+00 .5462891180E+00 .5660465073E+00 .5852815900E+00 .6041843041E+00
+ .6230311895E+00 .6420321129E+00 .6613094580E+00 .6810387572E+00 .7015380815E+00
+ .7232310098E+00 .7466700555E+00 .7727544166E+00 .8031808723E+00 .8417345107E+00
+ .8991902707E+00 .1505438979E+00 .2297059257E+00 .2850140453E+00 .3283701590E+00
+ .3645731426E+00 .3959763710E+00 .4239753906E+00 .4495509248E+00 .4733144562E+00
+ .4955891170E+00 .5166548569E+00 .5368613471E+00 .5565057681E+00 .5757239168E+00
+ .5945790387E+00 .6132151710E+00 .6318636513E+00 .6507298227E+00 .6699572081E+00
+ .6897243933E+00 .7103290190E+00 .7321847819E+00 .7558571251E+00 .7822592517E+00
+ .8130959715E+00 .8521280020E+00 .9092550108E+00 .1483377912E+00 .2263200088E+00
+ .2807958968E+00 .3234871261E+00 .3591325899E+00 .3900372629E+00 .4175473641E+00
+ .4426430121E+00 .4659670419E+00 .4878307486E+00 .5084521361E+00 .5281474967E+00
+ .5472517378E+00 .5659467478E+00 .5842704313E+00 .6022890800E+00 .6201943165E+00
+ .6382168247E+00 .6565115689E+00 .6751883533E+00 .6944338390E+00 .7145571200E+00
+ .7359603207E+00 .7591921690E+00 .7851577114E+00 .8155494102E+00 .8540937063E+00
+ .9105639231E+00 .1495392785E+00 .2277166654E+00 .2821500711E+00 .3246801794E+00
+ .3601113589E+00 .3908124488E+00 .4180853494E+00 .4428478896E+00 .4658040831E+00
+ .4873586967E+00 .5076970334E+00 .5270192319E+00 .5456274639E+00 .5637916540E+00
+ .5816238089E+00 .5991425948E+00 .6164322381E+00 .6336870124E+00 .6511085682E+00
+ .6688233394E+00 .6869383111E+00 .7056468544E+00 .7252500677E+00 .7461325322E+00
+ .7688304699E+00 .7942349741E+00 .8240067565E+00 .8617789578E+00 .9166980662E+00
+ .1486414131E+00 .2265974929E+00 .2808951734E+00 .3232882756E+00 .3585545085E+00
+ .3891091390E+00 .4162548933E+00 .4408279415E+00 .4635149945E+00 .4848105642E+00
+ .5049518302E+00 .5240653980E+00 .5423562447E+00 .5601039679E+00 .5775129259E+00
+ .5946428032E+00 .6115096960E+00 .6282173616E+00 .6449564818E+00 .6618992791E+00
+ .6791503481E+00 .6968187244E+00 .7151039378E+00 .7342985363E+00 .7547725469E+00
+ .7770536136E+00 .8020230713E+00 .8313184656E+00 .8684963708E+00 .9221088042E+00
+ .1486680791E+00 .2258213056E+00 .2798588803E+00 .3220535976E+00 .3571083642E+00
+ .3874322218E+00 .4143681751E+00 .4387393533E+00 .4611663295E+00 .4821421968E+00
+ .5019820504E+00 .5208350665E+00 .5388435465E+00 .5562169714E+00 .5731754818E+00
+ .5898549389E+00 .6062979850E+00 .6225443023E+00 .6387075037E+00 .6549532520E+00
+ .6714242751E+00 .6882223385E+00 .7054706055E+00 .7233653742E+00 .7421886426E+00
+ .7623039515E+00 .7842404236E+00 .8088829632E+00 .8378770787E+00 .8747120112E+00
+ .9269157091E+00 .1486947452E+00 .2254666193E+00 .2792623139E+00 .3212353165E+00
+ .3560561680E+00 .3861293436E+00 .4128347317E+00 .4369941824E+00 .4591723157E+00
+ .4798432602E+00 .4993754526E+00 .5179741852E+00 .5357392066E+00 .5527970828E+00
+ .5693507215E+00 .5855964435E+00 .6016271895E+00 .6174410494E+00 .6331010741E+00
+ .6487425991E+00 .6645240314E+00 .6805604686E+00 .6969380162E+00 .7137818237E+00
+ .7312945270E+00 .7497483760E+00 .7694978992E+00 .7910685148E+00 .8153393599E+00
+ .8439423774E+00 .8802893062E+00 .9312235926E+00 .1487214113E+00 .2254951153E+00
+ .2790655049E+00 .3207955891E+00 .3553621140E+00 .3851665078E+00 .4116224538E+00
+ .4355612224E+00 .4575007219E+00 .4778801365E+00 .4970990294E+00 .5154164052E+00
+ .5329144334E+00 .5496943733E+00 .5659055431E+00 .5817447913E+00 .5973573059E+00
+ .6127906152E+00 .6280533989E+00 .6432075315E+00 .6583878463E+00 .6737385043E+00
+ .6893560895E+00 .7053297589E+00 .7217832918E+00 .7389216021E+00 .7570077903E+00
+ .7763850662E+00 .7975704230E+00 .8214289409E+00 .8495592515E+00 .8852861871E+00
+ .9350775745E+00 .1487480774E+00 .2258729883E+00 .2792331857E+00 .3207010152E+00
+ .3549946086E+00 .3845137165E+00 .4107030084E+00 .4344129275E+00 .4561231090E+00
+ .4762232177E+00 .4951236560E+00 .5131455925E+00 .5304226219E+00 .5469795307E+00
+ .5628942288E+00 .5783538020E+00 .5935597133E+00 .6086115757E+00 .6235056608E+00
+ .6382404243E+00 .6529029887E+00 .6676459903E+00 .6825999616E+00 .6978370387E+00
+ .7134261332E+00 .7295023786E+00 .7462732551E+00 .7639933990E+00 .7829925230E+00
+ .8037749775E+00 .8271840741E+00 .8547672837E+00 .8897540309E+00 .9385179246E+00
+ .1412887110E+00 .2152511186E+00 .2667587394E+00 .3069698110E+00 .3403119368E+00
+ .3691016789E+00 .3947511217E+00 .4180204005E+00 .4393057974E+00 .4589981098E+00
+ .4775592505E+00 .4953321930E+00 .5124132440E+00 .5287646068E+00 .5444277699E+00
+ .5596043458E+00 .5745431711E+00 .5893781108E+00 .6040902326E+00 .6186209527E+00
+ .6330074203E+00 .6474026355E+00 .6619766579E+00 .6768223102E+00 .6919712653E+00
+ .7074899049E+00 .7235365446E+00 .7403325272E+00 .7581283266E+00 .7772502302E+00
+ .7982117028E+00 .8218728671E+00 .8498068159E+00 .8853228913E+00 .9352449195E+00
+ .1454365324E+00 .2210613862E+00 .2734270984E+00 .3141395044E+00 .3478101440E+00
+ .3767492278E+00 .4023823438E+00 .4256108939E+00 .4469125518E+00 .4665821084E+00
+ .4849593613E+00 .5024162433E+00 .5191946955E+00 .5353446056E+00 .5508443400E+00
+ .5657618034E+00 .5802864438E+00 .5946183784E+00 .6088476097E+00 .6229496471E+00
+ .6368918069E+00 .6507326262E+00 .6646157995E+00 .6786804669E+00 .6929976569E+00
+ .7076025149E+00 .7225749677E+00 .7380727565E+00 .7543004301E+00 .7714925200E+00
+ .7899670150E+00 .8102250546E+00 .8331000054E+00 .8601141166E+00 .8944089657E+00
+ .9418668294E+00 .1435506327E+00 .2181320734E+00 .2700662361E+00 .3105036192E+00
+ .3439851010E+00 .3727699598E+00 .3982266587E+00 .4212732005E+00 .4424499699E+00
+ .4620480623E+00 .4803242203E+00 .4975942566E+00 .5141440057E+00 .5301141628E+00
+ .5455133411E+00 .5603438858E+00 .5747042577E+00 .5887715842E+00 .6026981898E+00
+ .6165355129E+00 .6302589593E+00 .6438606924E+00 .6574137028E+00 .6710487656E+00
+ .6848808120E+00 .6989709838E+00 .7133632026E+00 .7281470150E+00 .7434772407E+00
+ .7595498119E+00 .7765970956E+00 .7949406642E+00 .8150843017E+00 .8378640473E+00
+ .8648014236E+00 .8989235720E+00 .9452746670E+00 .1416647330E+00 .2158544146E+00
+ .2673680703E+00 .3074738971E+00 .3407102915E+00 .3692912711E+00 .3945260683E+00
+ .4173527670E+00 .4383758011E+00 .4578810485E+00 .4760416946E+00 .4931142706E+00
+ .5094207869E+00 .5251895366E+00 .5404690457E+00 .5552110636E+00 .5694252915E+00
+ .5832487359E+00 .5968756116E+00 .6104330017E+00 .6239281942E+00 .6373115014E+00
+ .6505836785E+00 .6638410938E+00 .6772236266E+00 .6908321748E+00 .7047078040E+00
+ .7188885046E+00 .7334719397E+00 .7486188322E+00 .7645200961E+00 .7813999899E+00
+ .7995768200E+00 .8195516392E+00 .8421507970E+00 .8688748850E+00 .9027013457E+00
+ .9483449488E+00 .1420373674E+00 .2158823006E+00 .2669922153E+00 .3067059187E+00
+ .3395591478E+00 .3677689768E+00 .3926593063E+00 .4151627692E+00 .4358647386E+00
+ .4550444024E+00 .4728802102E+00 .4896308672E+00 .5056163816E+00 .5210674779E+00
+ .5360376143E+00 .5504731561E+00 .5643640323E+00 .5778286638E+00 .5910643633E+00
+ .6042234281E+00 .6173351032E+00 .6303409274E+00 .6432030813E+00 .6559820994E+00
+ .6688163967E+00 .6818341383E+00 .6950920665E+00 .7086017477E+00 .7224074125E+00
+ .7366281555E+00 .7514313754E+00 .7669960948E+00 .7835340282E+00 .8013599635E+00
+ .8209725068E+00 .8431878792E+00 .8694871063E+00 .9028248581E+00 .9480227894E+00
+ .1415054644E+00 .2144711683E+00 .2652870842E+00 .3047968756E+00 .3374776369E+00
+ .3655432369E+00 .3902749941E+00 .4125669361E+00 .4330610249E+00 .4520805856E+00
+ .4698012882E+00 .4864195986E+00 .5021950227E+00 .5173855551E+00 .5321194701E+00
+ .5463880041E+00 .5601543520E+00 .5734598237E+00 .5864409552E+00 .5992752521E+00
+ .6120602291E+00 .6247894871E+00 .6374112744E+00 .6499167654E+00 .6623845143E+00
+ .6749475996E+00 .6877086707E+00 .7007081649E+00 .7139609458E+00 .7275238627E+00
+ .7415218609E+00 .7561127645E+00 .7714680445E+00 .7877973633E+00 .8054144693E+00
+ .8248397458E+00 .8468891887E+00 .8730299936E+00 .9060721205E+00 .9501164267E+00
+ .1409735614E+00 .2132378078E+00 .2637710485E+00 .3030700102E+00 .3355686603E+00
+ .3634809025E+00 .3880755700E+00 .4102086318E+00 .4304859516E+00 .4493334377E+00
+ .4669306895E+00 .4834215070E+00 .4990175122E+00 .5139712015E+00 .5284678515E+00
+ .5425570724E+00 .5561944554E+00 .5693553199E+00 .5821208304E+00 .5946569961E+00
+ .6071193187E+00 .6195647948E+00 .6319430532E+00 .6441985862E+00 .6563561279E+00
+ .6685232730E+00 .6808265813E+00 .6933447983E+00 .7061034704E+00 .7191145702E+00
+ .7324457136E+00 .7462255787E+00 .7606071850E+00 .7757532554E+00 .7918703178E+00
+ .8093091899E+00 .8285564817E+00 .8504248942E+00 .8763800379E+00 .9091096307E+00
+ .9521154840E+00 .1404416584E+00 .2121694936E+00 .2624305996E+00 .3015123108E+00
+ .3338198920E+00 .3615702828E+00 .3860129930E+00 .4079809845E+00 .4281043550E+00
+ .4467874424E+00 .4642535096E+00 .4806213951E+00 .4960482707E+00 .5107773343E+00
+ .5250398897E+00 .5389188241E+00 .5524050693E+00 .5654392391E+00 .5780311332E+00
+ .5903254883E+00 .6024869373E+00 .6146221561E+00 .6267382607E+00 .6387780430E+00
+ .6507013684E+00 .6625481530E+00 .6744384678E+00 .6864989975E+00 .6987858404E+00
+ .7113117827E+00 .7240843276E+00 .7371868780E+00 .7507528781E+00 .7649279361E+00
+ .7798784613E+00 .7958266427E+00 .8130783912E+00 .8321334087E+00 .8538067171E+00
+ .8795512583E+00 .9119522994E+00 .9540265635E+00 .1399097554E+00 .2112547213E+00
+ .2612534861E+00 .3001119764E+00 .3322201529E+00 .3598008115E+00 .3840890589E+00
+ .4058874298E+00 .4258230359E+00 .4443559079E+00 .4617251781E+00 .4779928129E+00
+ .4932341979E+00 .5077417525E+00 .5217506109E+00 .5354078025E+00 .5487296955E+00
+ .5616543385E+00 .5741441063E+00 .5862599707E+00 .5981532531E+00 .6099833953E+00
+ .6218250411E+00 .6336350386E+00 .6453428591E+00 .6569403296E+00 .6685060823E+00
+ .6801631450E+00 .6920093832E+00 .7040797928E+00 .7163712442E+00 .7289049030E+00
+ .7417667196E+00 .7551339761E+00 .7691372989E+00 .7839115652E+00 .7996659832E+00
+ .8167234587E+00 .8355803125E+00 .8570454376E+00 .8825558821E+00 .9146137551E+00
+ .9558562816E+00 .1393778524E+00 .2104830236E+00 .2602285804E+00 .2988582762E+00
+ .3307592933E+00 .3581628567E+00 .3822943130E+00 .4039269833E+00 .4236771108E+00
+ .4420154952E+00 .4591807018E+00 .4753214081E+00 .4905057528E+00 .5048858571E+00
+ .5186911804E+00 .5321266214E+00 .5452725775E+00 .5580793087E+00 .5704561323E+00
+ .5824135344E+00 .5940866529E+00 .6056383004E+00 .6171840831E+00 .6287412137E+00
+ .6402491265E+00 .6516455153E+00 .6629408838E+00 .6742385981E+00 .6856712699E+00
+ .6973141740E+00 .7091837064E+00 .7212681502E+00 .7336041026E+00 .7462934624E+00
+ .7594673168E+00 .7732528492E+00 .7878289464E+00 .8033909278E+00 .8202527529E+00
+ .8389061053E+00 .8601507781E+00 .8854054065E+00 .9171063197E+00 .9576098338E+00
+ .1388459494E+00 .2098448700E+00 .2593457247E+00 .2977414251E+00 .3294280407E+00
+ .3566476615E+00 .3806201384E+00 .4020907814E+00 .4216275106E+00 .4397444056E+00
+ .4567701979E+00 .4728118768E+00 .4879085090E+00 .5021648412E+00 .5157893162E+00
+ .5290123015E+00 .5419486932E+00 .5546017078E+00 .5668876762E+00 .5787573601E+00
+ .5902665148E+00 .6015659498E+00 .6128199234E+00 .6241117444E+00 .6354048860E+00
+ .6466160446E+00 .6577066613E+00 .6687280187E+00 .6797979216E+00 .6910308875E+00
+ .7024796142E+00 .7141468677E+00 .7260224229E+00 .7381600711E+00 .7506678831E+00
+ .7636711696E+00 .7772897965E+00 .7916598119E+00 .8070090442E+00 .8236740935E+00
+ .8421187752E+00 .8631317207E+00 .8881100887E+00 .9194412829E+00 .9592922735E+00
+ .1383140464E+00 .2093315371E+00 .2585956616E+00 .2967525192E+00 .3282179518E+00
+ .3552471998E+00 .3790586770E+00 .4003512562E+00 .4197071286E+00 .4376539509E+00
+ .4545287231E+00 .4704632638E+00 .4854745906E+00 .4996196676E+00 .5130662866E+00
+ .5260644318E+00 .5387884562E+00 .5512768960E+00 .5634572127E+00 .5752432603E+00
+ .5866326170E+00 .5977405656E+00 .6087372120E+00 .6197460100E+00 .6307912769E+00
+ .6418108937E+00 .6527286481E+00 .6635333849E+00 .6743079408E+00 .6851747922E+00
+ .6962275055E+00 .7074934342E+00 .7189574313E+00 .7306240438E+00 .7425669767E+00
+ .7548955044E+00 .7677290535E+00 .7811792615E+00 .7953818432E+00 .8105419302E+00
+ .8269944330E+00 .8452257225E+00 .8659962679E+00 .8906794850E+00 .9216289147E+00
+ .9609084406E+00 .1377821435E+00 .2089350573E+00 .2579699128E+00 .2958833704E+00
+ .3271212896E+00 .3539541678E+00 .3776027276E+00 .3987593760E+00 .4179652070E+00
+ .4357325973E+00 .4524455148E+00 .4682653021E+00 .4831935634E+00 .4972391012E+00
+ .5105362499E+00 .5233248212E+00 .5358284653E+00 .5481414873E+00 .5602114876E+00
+ .5719233967E+00 .5832174975E+00 .5941573652E+00 .6049057744E+00 .6156324289E+00
+ .6264215181E+00 .6372426507E+00 .6480017036E+00 .6586318811E+00 .6691585495E+00
+ .6796928643E+00 .6903637551E+00 .7012450124E+00 .7123364080E+00 .7236109475E+00
+ .7350827475E+00 .7468342905E+00 .7589857829E+00 .7716503669E+00 .7849306180E+00
+ .7989608045E+00 .8139521880E+00 .8302202856E+00 .8482337491E+00 .8687518950E+00
+ .8931221034E+00 .9236786773E+00 .9624624515E+00 .1376568516E+00 .2084741428E+00
+ .2574221944E+00 .2952935548E+00 .3264655050E+00 .3531957540E+00 .3767820477E+00
+ .3979543562E+00 .4171702339E+00 .4348404832E+00 .4513622648E+00 .4670166484E+00
+ .4819062680E+00 .4960227485E+00 .5093820887E+00 .5221082531E+00 .5344049873E+00
+ .5464536070E+00 .5583253971E+00 .5699741284E+00 .5813082151E+00 .5922859992E+00
+ .6029673076E+00 .6134901470E+00 .6239943704E+00 .6345481896E+00 .6451277517E+00
+ .6556607573E+00 .6661000798E+00 .6764737076E+00 .6868768040E+00 .6974162750E+00
+ .7081544539E+00 .7190973248E+00 .7302337098E+00 .7415876582E+00 .7532375191E+00
+ .7652917476E+00 .7778569809E+00 .7910390683E+00 .8049780745E+00 .8198860891E+00
+ .8360761845E+00 .8540165228E+00 .8744649509E+00 .8987305065E+00 .9288785761E+00
+ .9659766401E+00 .1375315598E+00 .2084775491E+00 .2573430667E+00 .2951317424E+00
+ .3261971494E+00 .3527859200E+00 .3762724313E+00 .3974324833E+00 .4166475525E+00
+ .4342196341E+00 .4505402777E+00 .4659991332E+00 .4808103157E+00 .4949732047E+00
+ .5084028331E+00 .5211003056E+00 .5332212910E+00 .5450055901E+00 .5566413510E+00
+ .5681725663E+00 .5795113226E+00 .5905356877E+00 .6011988595E+00 .6115763187E+00
+ .6218262003E+00 .6320973341E+00 .6424507438E+00 .6528462077E+00 .6631980309E+00
+ .6734565495E+00 .6836565217E+00 .6939007423E+00 .7042970374E+00 .7149016266E+00
+ .7257137306E+00 .7367209774E+00 .7479514441E+00 .7594866848E+00 .7714331416E+00
+ .7838925954E+00 .7969686117E+00 .8108024144E+00 .8256064866E+00 .8416909597E+00
+ .8595190861E+00 .8798406171E+00 .9039350242E+00 .9337028085E+00 .9694536047E+00
+ .1317020897E+00 .2002641972E+00 .2477483653E+00 .2845677323E+00 .3148968722E+00
+ .3409868717E+00 .3641310532E+00 .3849330895E+00 .4037202962E+00 .4209087043E+00
+ .4370108554E+00 .4524020935E+00 .4671677609E+00 .4811871747E+00 .4943560955E+00
+ .5067525017E+00 .5186328034E+00 .5302898560E+00 .5418928385E+00 .5534195118E+00
+ .5647139606E+00 .5756195135E+00 .5860972334E+00 .5962599229E+00 .6063097014E+00
+ .6164257668E+00 .6266745773E+00 .6369956055E+00 .6472661562E+00 .6573994766E+00
+ .6674115741E+00 .6774154163E+00 .6875516449E+00 .6979088373E+00 .7084920983E+00
+ .7192602312E+00 .7301969423E+00 .7413554262E+00 .7528432581E+00 .7647728124E+00
+ .7772343522E+00 .7903200331E+00 .8041710371E+00 .8190070666E+00 .8351437854E+00
+ .8530473546E+00 .8734765607E+00 .8977614190E+00 .9280746606E+00 .9656756342E+00
+ .1342603285E+00 .2037636785E+00 .2517261429E+00 .2888669550E+00 .3194115330E+00
+ .3455421098E+00 .3686368549E+00 .3894918154E+00 .4084591494E+00 .4257690315E+00
+ .4417683896E+00 .4568776393E+00 .4713905199E+00 .4853604273E+00 .4986776241E+00
+ .5112527234E+00 .5231517305E+00 .5345924682E+00 .5458263070E+00 .5570024942E+00
+ .5681078437E+00 .5790125053E+00 .5895820595E+00 .5997803527E+00 .6097015467E+00
+ .6195187437E+00 .6293879170E+00 .6393697107E+00 .6494161590E+00 .6594260786E+00
+ .6693293113E+00 .6791434109E+00 .6889673242E+00 .6989213548E+00 .7090804437E+00
+ .7194507364E+00 .7300039018E+00 .7407367207E+00 .7517046792E+00 .7630059311E+00
+ .7747412612E+00 .7869970820E+00 .7998693512E+00 .8135022252E+00 .8281120771E+00
+ .8440077829E+00 .8616486888E+00 .8817798710E+00 .9056659082E+00 .9351413373E+00
+ .9703257802E+00 .1351434622E+00 .2049031729E+00 .2529486601E+00 .2901151406E+00
+ .3206706901E+00 .3467592122E+00 .3697451428E+00 .3905017828E+00 .4094497266E+00
+ .4267784624E+00 .4427294354E+00 .4576731626E+00 .4719628639E+00 .4857636510E+00
+ .4990303080E+00 .5116395856E+00 .5235558688E+00 .5349056744E+00 .5459229738E+00
+ .5568210103E+00 .5676849997E+00 .5784524938E+00 .5889845807E+00 .5991754435E+00
+ .6090307886E+00 .6186713651E+00 .6282662835E+00 .6379420953E+00 .6477245741E+00
+ .6575464840E+00 .6673120484E+00 .6769737573E+00 .6865713861E+00 .6962103524E+00
+ .7059989797E+00 .7159925354E+00 .7261848681E+00 .7365500525E+00 .7470964140E+00
+ .7578878581E+00 .7690206779E+00 .7805873441E+00 .7926684362E+00 .8053601349E+00
+ .8188085377E+00 .8332287187E+00 .8489252410E+00 .8663520791E+00 .8862438027E+00
+ .9098221303E+00 .9387319809E+00 .9725589811E+00 .1366984541E+00 .2069680990E+00
+ .2552333897E+00 .2925012569E+00 .3231259268E+00 .3492392965E+00 .3721609858E+00
+ .3928105288E+00 .4117096189E+00 .4290685809E+00 .4450377199E+00 .4598876990E+00
+ .4739696249E+00 .4875462915E+00 .5006814672E+00 .5132823450E+00 .5252457016E+00
+ .5365875740E+00 .5474686835E+00 .5581133541E+00 .5686894959E+00 .5792315448E+00
+ .5896501520E+00 .5998141960E+00 .6096492018E+00 .6191924826E+00 .6285764587E+00
+ .6379562048E+00 .6474288463E+00 .6569938890E+00 .6665757987E+00 .6760907786E+00
+ .6855129293E+00 .6948974771E+00 .7043490456E+00 .7139610712E+00 .7237718314E+00
+ .7337682553E+00 .7439304279E+00 .7542776520E+00 .7648789077E+00 .7758259722E+00
+ .7872030722E+00 .7990866344E+00 .8115739091E+00 .8248121451E+00 .8390138831E+00
+ .8544786257E+00 .8716540436E+00 .8912609495E+00 .9144659318E+00 .9426884429E+00
+ .9749480802E+00 .1356037107E+00 .2052708444E+00 .2531096369E+00 .2900285281E+00
+ .3203081791E+00 .3461134179E+00 .3688325792E+00 .3893355069E+00 .4080181924E+00
+ .4250536915E+00 .4406896993E+00 .4553182589E+00 .4693139899E+00 .4828508125E+00
+ .4958737622E+00 .5082335771E+00 .5198638902E+00 .5308729613E+00 .5415027352E+00
+ .5520008575E+00 .5624967148E+00 .5729557425E+00 .5832303043E+00 .5931685231E+00
+ .6027149046E+00 .6119481946E+00 .6210412868E+00 .6301715435E+00 .6394346402E+00
+ .6488095426E+00 .6581911554E+00 .6674682729E+00 .6765993673E+00 .6856416708E+00
+ .6947185921E+00 .7039494481E+00 .7133893935E+00 .7230195811E+00 .7327914572E+00
+ .7426893367E+00 .7527627695E+00 .7631072443E+00 .7738176856E+00 .7849623879E+00
+ .7966015439E+00 .8088283143E+00 .8217941329E+00 .8357129915E+00 .8508788360E+00
+ .8677307517E+00 .8869866831E+00 .9098625465E+00 .9381036745E+00 .9717550211E+00
+ .1337198350E+00 .2027298863E+00 .2502219537E+00 .2869418928E+00 .3171762707E+00
+ .3429813643E+00 .3655828893E+00 .3859012345E+00 .4045529034E+00 .4217995302E+00
+ .4377136913E+00 .4524277481E+00 .4662290518E+00 .4794520471E+00 .4923059990E+00
+ .5047979144E+00 .5168010926E+00 .5282021467E+00 .5390170341E+00 .5494059300E+00
+ .5595918040E+00 .5697449700E+00 .5799066327E+00 .5899919861E+00 .5998632916E+00
+ .6094253160E+00 .6186880003E+00 .6277644570E+00 .6368108163E+00 .6459462567E+00
+ .6552000642E+00 .6645143498E+00 .6737972730E+00 .6829919680E+00 .6921183673E+00
+ .7012637997E+00 .7105322729E+00 .7199896247E+00 .7296431187E+00 .7394674280E+00
+ .7494533624E+00 .7596394314E+00 .7701040891E+00 .7809334686E+00 .7922007921E+00
+ .8039780615E+00 .8163661362E+00 .8295166778E+00 .8436428042E+00 .8590430561E+00
+ .8761650884E+00 .8957230660E+00 .9188238772E+00 .9466043281E+00 .9773882864E+00
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/QGSJET.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/QGSJET.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/QGSJET.f	(revision 286)
@@ -0,0 +1,7156 @@
+
+C======================================================================C
+C                                                                      C
+C      QQQ         GGG       SSSS     JJJJJJJ    EEEEEEE    TTTTTTT    C
+C     Q   Q       G   G     S    S          J    E             T       C
+C    Q     Q     G          S               J    E             T       C
+C    Q     Q     G   GGG     SSSS           J    EEEEE         T       C
+C    Q   Q Q     G     G         S          J    E             T       C
+C     Q   Q       G   G     S    S     J   J     E             T       C
+C      QQQ QQ      GGG       SSSS       JJJ      EEEEEEE       T       C
+C                                                                      C
+C                                                                      C
+C----------------------------------------------------------------------C
+C                                                                      C
+C                    QUARK - GLUON - STRING - MODEL                    C
+C                                                                      C
+C                HIGH ENERGY HADRON INTERACTION PROGRAM                C
+C                                                                      C
+C                                  BY                                  C
+C                                                                      C
+C                 N. N. KALMYKOV AND S. S. OSTAPCHENKO                 C
+C                                                                      C
+C               MOSCOW STATE UNIVERSITY,  MOSCOW, RUSSIA               C
+C                      e-mail: serg@eas.npi.msu.su                     C
+C----------------------------------------------------------------------C
+C                 SUBROUTINE VERSION TO BE LINKED WITH                 C
+C                             C O R S I K A                            C
+C               KARLSRUHE  AIR SHOWER SIMULATION PROGRAM               C
+C                          WITH MODIFICATIONS                          C
+C                                  BY                                  C
+C                      D. HECK  IK3 FZK KARLSRUHE                      C
+C----------------------------------------------------------------------C
+C             last modification:  feb  21, 1997                        C
+C----------------------------------------------------------------------C
+ 
+C=======================================================================
+
+      SUBROUTINE PSAINI
+c Common initialization procedure
+c-----------------------------------------------------------------------
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      INTEGER DEBUG
+      CHARACTER *7 TY
+      LOGICAL LCALC,LSECT
+********************************************
+      DIMENSION EQ(17),MIJ(17,17,4),NIJ(17,17,4),CSJET(17,17,68),
+     *CS1(17,17,68),GZ0(2),GZ1(3)
+      COMMON /XSECT/  GSECT(10,5,4)
+      COMMON /AREA1/  IA(2),ICZ,ICP
+      COMMON /AREA5/  RD(2),CR1(2),CR2(2),CR3(2)
+********************************************
+      COMMON /AREA6/  PI,BM,AM
+      COMMON /AREA7/  RP1
+      COMMON /AREA10/ STMASS,AM0,AMN,AMK,AMC,AMLAMC,AMLAM,AMETA
+      COMMON /AREA15/ FP(5),RQ(5),CD(5)
+      COMMON /AREA16/ CC(5)
+      COMMON /AREA17/ DEL,RS,RS0,FS,ALFP,RR,SH,DELH
+      COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+      COMMON /AREA19/ AHL(5)
+********************************************
+      COMMON /AREA22/ SJV0,FJS0(5,3)
+********************************************
+      COMMON /AREA23/ RJV(50)
+      COMMON /AREA24/ RJS(50,5,10)
+      COMMON /AREA27/ FP0(5)
+      COMMON /AREA28/ ARR(4)
+      COMMON /AREA29/ CSTOT(17,17,68)
+      COMMON /AREA30/ CS0(17,17,68)
+      COMMON /AREA31/ CSBORN(17,68)
+      COMMON /AREA32/ CSQ(17,2,2),CSBQ(17,2,2)
+      COMMON /AREA33/ FSUD(10,2)
+      COMMON /AREA34/ QRT(10,101,2)
+      COMMON /AREA35/ SJV(10,5),FJS(10,5,15)
+      COMMON /AREA39/ JCALC
+      COMMON /AREA41/ TY(5)
+      COMMON /AREA43/ MONIOU
+      COMMON /DEBUG/  DEBUG
+********************************************
+      COMMON /AREA44/ GZ(10,5,4)
+c Auxiliary common blocks to calculate hadron-nucleus cross-sections
+      COMMON /AR1/    ANORM
+      COMMON /AR2/    RRR,RRRM
+********************************************
+
+c-------------------------------------------------
+        WRITE(MONIOU,100)
+ 100    FORMAT(' ',
+     *           '====================================================',
+     *     /,' ','|                                                  |',
+     *     /,' ','|           QUARK GLUON STRING JET MODEL           |',
+     *     /,' ','|                                                  |',
+     *     /,' ','|         HADRONIC INTERACTION MONTE CARLO         |',
+     *     /,' ','|                        BY                        |',
+     *     /,' ','|        N.N. KALMYKOV AND S.S. OSTAPCHENKO        |',
+     *     /,' ','|                                                  |',
+     *     /,' ','|            e-mail: serg@eas.npi.msu.su           |',
+     *     /,' ','|                                                  |',
+     *     /,' ','| last modification:  feb. 21, 1997  by    D. Heck |',
+     *     /,' ','====================================================',
+     *     /)
+        IF(DEBUG.GE.1)WRITE (MONIOU,210)
+210     FORMAT(2X,'PSAINI - MAIN INITIALIZATION PROCEDURE')
+
+c AHL(i) - parameter for the energy sharing procedure (govern leading hadronic state
+c inelasticity for primary pion, nucleon, kaon, D-meson, Lambda_C correspondingly)
+      AHL(1)=1.D0-2.D0*ARR(1)
+      AHL(2)=1.D0-ARR(1)-ARR(2)
+      AHL(3)=1.D0-ARR(1)-ARR(3)
+      AHL(4)=1.D0-ARR(1)-ARR(4)
+      AHL(5)=AHL(2)+ARR(1)-ARR(4)
+
+c-------------------------------------------------
+c 1/CC(i) = C_i - shower enhancement coefficients for one vertex
+c (C_ab=C_a*C_b) (i - ICZ)
+      CC(2)=1.D0/DSQRT(CD(2))
+      CC(1)=1.D0/CC(2)/CD(1)
+      CC(3)=1.D0/CC(2)/CD(3)
+      CC(4)=1.D0/CC(2)/CD(4)
+      CC(5)=1.D0/CC(2)/CD(5)
+
+c FP0(i) - vertex constant (FP_ij=FP0_i*FP0_j) for pomeron-hadron interaction (i - ICZ)
+      FP0(2)=DSQRT(FP(2))
+      FP0(1)=FP(1)/FP0(2)
+      FP0(3)=FP(3)/FP0(2)
+      FP0(4)=FP(4)/FP0(2)
+      FP0(5)=FP(5)/FP0(2)
+
+c SH - hard interaction effective squared (SH=pi*R_h>2, R_h>2=4/Q0>2)
+      SH=4.D0/QT0*PI
+c Auxiliary constants for the hard interaction
+      AQT0=DLOG(4.D0*QT0)
+      QLOG=DLOG(QT0/ALM)
+      QLL=DLOG(QLOG)
+
+********************************************
+      INQUIRE(FILE='QGSDATA4',EXIST=LCALC)
+      IF(LCALC)then
+        IF(DEBUG.GE.1)WRITE (MONIOU,211)
+211     FORMAT(2X,'PSAINI: HARD CROSS SECTION RATIOS READOUT FROM THE'
+     *   '  FILE QGSDATA4')
+        OPEN(1,FILE='QGSDATA4',STATUS='OLD')
+        READ (1,*)CSBORN,CS0,CSTOT,CSQ,CSBQ,
+     *  FSUD,QRT,SJV,FJS,RJV,RJS,GZ,GSECT
+        CLOSE(1)
+      ELSE
+********************************************
+
+        IF(DEBUG.GE.1)WRITE (MONIOU,201)
+201     FORMAT(2X,'PSAINI: HARD CROSS SECTIONS CALCULATION')
+c--------------------------------------------------
+c Hard pomeron inclusive cross sections calculation
+c--------------------------------------------------
+c EQ(I) - energy squared tabulation (Q0>2, 4*Q0>2, ...)
+      DO 1 I=1,17
+1     EQ(I)=QT0*4.D0**FLOAT(I-1)
+
+      DO 2 I=1,17
+c QI - effective momentum (Qt**2/(1-z)**2) cutoff for the Born process
+      QI=EQ(I)
+c M, L define parton types (1-g, 2-q)
+      DO 2 M=1,2
+      DO 2 L=1,2
+c K defines c.m. energy squared for the process (for current energy tabulation)
+      DO 2 K=1,17
+      K1=K+17*(M-1)+34*(L-1)
+      IF(K.LE.I.OR.K.EQ.2)THEN
+        CSBORN(I,K1)=0.D0
+      ELSE
+c SK - c.m. energy squared for the hard interaction
+        SK=EQ(K)
+c CSBORN(I,K1) - Born cross-section (2->2 process) - procedure PSBORN
+        CSBORN(I,K1)=PSBORN(QI,SK,M-1,L-1)
+      ENDIF
+2     CONTINUE
+
+c Cross-sections initialization
+      DO 3 I=1,17
+      DO 3 J=1,17
+      N=MAX(I,J)
+      DO 3 M=1,2
+      DO 3 L=1,2
+      ML=M+2*L-2
+      DO 3 K=1,17
+      K1=K+17*(M-1)+34*(L-1)
+      CSJET(I,J,K1)=0.D0
+      IF(K.LE.N.OR.K.EQ.2)THEN
+        CSTOT(I,J,K1)=-80.D0
+        CS0(I,J,K1)=-80.D0
+        MIJ(I,J,ML)=K+1
+        NIJ(I,J,ML)=K+1
+      ELSE
+        CSTOT(I,J,K1)=DLOG(CSBORN(N,K1))
+        CS0(I,J,K1)=CSTOT(I,J,K1)
+      ENDIF
+3     CONTINUE
+
+c N-maximal number of ladder runs taken into account
+      N=2
+4     CONTINUE
+        IF(DEBUG.GE.2)WRITE (MONIOU,202)N,EQ(MIJ(1,1,1)),EQ(NIJ(1,1,1))
+202     FORMAT(2X,'PSAINI: NUMBER OF LADDER RUNS TO BE CONSIDERED:',I2/
+     *  4X,'MINIMAL MASSES SQUARED FOR THE UNORDERED AND STRICTLY',
+     *  ' ORDERED LADDERS:'/4X,E10.3,3X,E10.3)
+      DO 6 I=1,17
+c QI - effective momentum cutoff for upper end of the ladder
+      QI=EQ(I)
+      DO 6 J=1,17
+c QJ - effective momentum cutoff for lower end of the ladder
+      QJ=EQ(J)
+c QQ - maximal effective momentum cutoff
+      QQ=MAX(QI,QJ)
+c S2MIN - minimal energy squared for 2->2 subprocess
+      S2MIN=MAX(QQ,4.D0*QT0)
+      SM=DSQRT(QT0/S2MIN)
+c SMIN - minimal energy squared for 2->3 subprocess
+      SMIN=S2MIN*(1.D0+SM)/(1.D0-SM)
+
+c M, L define parton types (1-g, 2-q)
+      DO 6 M=1,2
+      DO 6 L=1,2
+      ML=M+2*L-2
+c KMIN corresponds to minimal energy at which more runs are to be considered -
+c stored in array NIJ(I,J,ML) - for strictly ordered ladder
+      KMIN=NIJ(I,J,ML)
+      IF(KMIN.LE.17)THEN
+        DO 5 K=KMIN,17
+        SK=EQ(K)
+        IF(SK.LE.SMIN)THEN
+          NIJ(I,J,ML)=NIJ(I,J,ML)+1
+        ELSE
+          K1=K+17*(M-1)+34*(L-1)
+c CS1(I,J,K1) - cross-section for strictly ordered ladder (highest virtuality run
+c is the lowest one) - procedure PSJET1
+          CS1(I,J,K1)=PSJET1(QI,QJ,SK,S2MIN,M-1,L)
+        ENDIF
+5       CONTINUE
+      ENDIF
+6     CONTINUE
+
+      DO 8 I=1,17
+      DO 8 J=1,17
+      DO 8 M=1,2
+      DO 8 L=1,2
+      ML=M+2*L-2
+      KMIN=NIJ(I,J,ML)
+      IF(KMIN.LE.17)THEN
+        DO 7 K=KMIN,17
+        K1=K+17*(M-1)+34*(L-1)
+c CSJ - cross-section for strictly ordered ladder (highest virtuality run is the
+c lowest one) - Born contribution is added
+        CSJ=CS1(I,J,K1)+CSBORN(MAX(I,J),K1)
+        IF(DEBUG.GE.2)WRITE (MONIOU,204)CSJ,EXP(CS0(I,J,K1))
+204     FORMAT(2X,'PSAINI: NEW AND OLD VALUES OF THE CONTRIBUTION',
+     *  ' OF THE STRICTLY ORDERED LADDER:'/4X,E10.3,3X,E10.3)
+        IF(CSJ.EQ.0.D0.OR.ABS(1.D0-EXP(CS0(I,J,K1))/CSJ).LT.1.D-2)THEN
+     	  NIJ(I,J,ML)=NIJ(I,J,ML)+1
+        ELSE
+c CS0(I,J,K1) - cross-section logarithm for strictly ordered ladder
+          CS0(I,J,K1)=DLOG(CSJ)
+        ENDIF
+7       CONTINUE
+      ENDIF
+8     CONTINUE
+
+      DO 10 I=1,17
+      QI=EQ(I)
+      DO 10 J=1,17
+      QJ=EQ(J)
+      QQ=MAX(QI,QJ)
+      S2MIN=MAX(QQ,4.D0*QT0)
+      SM=DSQRT(QT0/S2MIN)
+c SMIN - minimal energy squared for 2->3 subprocess
+      SMIN=S2MIN*(1.D0+SM)/(1.D0-SM)
+
+      DO 10 M=1,2
+      DO 10 L=1,2
+      ML=M+2*L-2
+c KMIN corresponds to minimal energy at which more runs are to be considered
+c stored in array MIJ(I,J,ML) - for any ordering in the ladder
+      KMIN=MIJ(I,J,ML)
+      IF(KMIN.LE.17)THEN
+        DO 9 K=KMIN,17
+        SK=EQ(K)
+        IF(SK.LE.SMIN)THEN
+          MIJ(I,J,ML)=MIJ(I,J,ML)+1
+        ELSE
+          K1=K+17*(M-1)+34*(L-1)
+c CS1(I,J,K1) - cross-section for any ordering in the ladder (highest virtuality
+c run is somewhere in the middle; runs above and below it are strictly ordered
+c towards highest effective momentum run) - procedure PSJET
+          CS1(I,J,K1)=PSJET(QI,QJ,SK,S2MIN,M-1,L)
+        ENDIF
+9       CONTINUE
+      ENDIF
+10    CONTINUE
+
+      DO 12 I=1,17
+      DO 12 J=1,17
+      DO 12 M=1,2
+      DO 12 L=1,2
+      ML=M+2*L-2
+c KMIN corresponds to minimal energy at which more runs are to be considered
+      KMIN=MIJ(I,J,ML)
+      IF(KMIN.LE.17)THEN
+        DO 11 K=KMIN,17
+        K1=K+17*(M-1)+34*(L-1)
+        K2=K+17*(L-1)+34*(M-1)
+        CSJ=CS1(I,J,K1)+EXP(CS0(J,I,K2))
+        IF(CSJ.EQ.0.D0.OR.ABS(1.D0-EXP(CSTOT(I,J,K1))/CSJ).LT.1.D-2)
+     *  MIJ(I,J,ML)=MIJ(I,J,ML)+1
+        IF(DEBUG.GE.2)WRITE (MONIOU,203)CSJ,EXP(CSTOT(I,J,K1))
+203     FORMAT(2X,'PSAINI: NEW AND OLD VALUES OF THE UNORDERED LADDER',
+     *  ' CROSS SECTION:'/4X,E10.3,3X,E10.3)
+11      CSTOT(I,J,K1)=DLOG(CSJ)
+      ENDIF
+12    CONTINUE
+
+c One more run
+      N=N+1
+      DO 13 L=1,4
+13    IF(MIJ(1,1,L).LE.17.OR.NIJ(1,1,L).LE.17)GOTO 4
+
+c Logarithms of the Born cross-section are calculated - to be interpolated in the
+c PSBINT procedure
+      DO 14 I=1,17
+      DO 14 K=1,17
+      DO 14 M=1,2
+      DO 14 L=1,2
+      K1=K+17*(M-1)+34*(L-1)
+      IF(K.LE.I.OR.K.EQ.2)THEN
+        CSBORN(I,K1)=-80.D0
+      ELSE
+        CSBORN(I,K1)=DLOG(CSBORN(I,K1))
+      ENDIF
+14    CONTINUE
+
+c Total and Born hard cross-sections logarithms for minimal cutoff (QT0) - to be
+c interpolated in the PSJINT0 procedure
+      DO 15 M=1,2
+      DO 15 L=1,2
+      DO 15 K=1,17
+      IF(K.LE.2)THEN
+        CSQ(K,M,L)=-80.D0
+        CSBQ(K,M,L)=-80.D0
+      ELSE
+        K1=K+17*(M-1)+34*(L-1)
+        CSBQ(K,M,L)=CSBORN(1,K1)
+        CSQ(K,M,L)=CSTOT(1,1,K1)
+      ENDIF
+15    CONTINUE
+
+c-------------------------------------------------
+c FSUD(K,M)=-ln(SUD) - timelike Sudakov formfactor logarithm - procedure
+c PSUDT(QMAX,M-1), M=1 - g, M=2 - q
+      DO 17 M=1,2
+      FSUD(1,M)=0.D0
+      DO 17 K=2,10
+c QMAX is the maximal effective momentum ( Qt**2/z**2/(1-z)**2 in case of the timelike
+c evolution )
+      QMAX=QTF*4.D0**(1.D0+K)
+17    FSUD(K,M)=PSUDT(QMAX,M-1)
+
+c QRT(K,L,M) - effective momentum logarithm for timelike branching ( ln QQ/16/QTF )
+c for given QMAX (defined by K, QLMAX = ln QMAX/16/QTF ) and a number
+c of random number values (defined by L) - to be interpolated by the PSQINT
+c procedure; M=1 - g, M=2 - q
+      DO 18 M=1,2
+      DO 18 K=1,10
+      QLMAX=1.38629D0*(K-1)
+      QRT(K,1,M)=0.D0
+      QRT(K,101,M)=QLMAX
+      DO 18 I=1,99
+      IF(K.EQ.1)THEN
+        QRT(K,I+1,M)=0.D0
+      ELSE
+        QRT(K,I+1,M)=PSROOT(QLMAX,.01D0*I,M)
+      ENDIF
+18    CONTINUE
+c-------------------------------------------------
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,205)
+205     FORMAT(2X,'PSAINI: PRETABULATION OF THE INTERACTION EIKONALS')
+c-------------------------------------------------
+************************************************************************
+c-------------------------------------------------
+c Interaction cross sections
+c Factors for interaction eikonals calculation
+c (convolution of the hard cross-sections with partons structure functions)
+c - to be used in the PSPSFAZ procedure
+c-------------------------------------------------
+      IA(1)=1          
+c-------------------------------------------------
+      DO 21 IE=1,10
+c Energy of the interaction (per nucleon)
+      E0N=10.D0**IE
+c-------------------------------------------------
+c Energy dependent factors:
+c WP0, WM0 - initial light cone momenta for the interaction (E+-p)
+      S=2.D0*E0N*AMN
+c Y0 - total rapidity range for the interaction
+      Y0=DLOG(S)
+
+c Type of the incident hadron (icz = 1: pion, 2: nucleon, 3: kaon, etc
+      DO 21 ICZ=1,5
+c RS - soft pomeron elastic scattering slope (lambda_ab)
+      RS=RQ(ICZ)+ALFP*Y0
+c RS0 - initial slope (sum of the pomeron-hadron vertices slopes squared - R_ab)
+      RS0=RQ(ICZ)
+c FS - factor for pomeron eikonal calculation 
+c                            (gamma_ab * s**del /lambda_ab * C_ab
+      FS=FP(ICZ)*EXP(Y0*DEL)/RS*CD(ICZ)
+c RP1 - factor for the impact parameter dependence of the eikonal ( in fm>2 )
+      RP1=RS*4.D0*.0391D0/AM**2
+c Factor for cross-sections calculation ( in mb )
+      G0=PI*RP1/CD(ICZ)*AM**2*10.D0
+c SJV - valence-valence cross-section (divided by 8*pi*lambda_ab)
+      SJV(IE,ICZ)=PSHARD(S,ICZ)
+      SJV0=SJV(IE,ICZ)
+
+      DO 19 I=1,5
+      DO 19 M=1,3
+      Z=.2D0*I
+c Eikonals for gluon-gluon and valence-gluon semihard interactions
+c (m=1 - gg, 2 - qg, 3 - gq);
+c Z - impact parameter factor ( exp(-b**2/R_p) )
+      M1=M+3*(ICZ-1)
+      FJS(IE,I,M1)=DLOG(PSFSH(S,Z,ICZ,M-1)/Z)
+      FJS0(I,M)=FJS(IE,I,M1)
+19    CONTINUE	
+
+      DO 20 IIA=1,4
+c Target mass number IA(2)
+      IA(2)=4**(IIA-1)
+      IF(DEBUG.GE.1)WRITE (MONIOU,206)E0N,TY(ICZ),IA(2)
+206   FORMAT(2X,'PSAINI: INITIAL PARTICLE ENERGY:',E10.3,2X,
+     *'ITS TYPE:',A7,2X,'TARGET MASS NUMBER:',I2)
+c-------------------------------------------------
+c Nuclear radii 
+      IF(IA(2).GT.10)THEN
+c RD - Wood-Saxon density radius (fit to the data of Murthy et al.)
+        RD(2)=0.7D0*FLOAT(IA(2))**.446/AM
+      ELSE
+c RD - gaussian density radius (for light nucleus)
+        RD(2)=.9D0*FLOAT(IA(2))**.3333/AM
+      ENDIF
+      
+      IF(IA(2).EQ.1)THEN
+c Hadron-proton interaction
+c BM - impact parameter cutoff value
+        BM=2.D0*DSQRT(RP1)
+c XXFZ - impact parameter integration for the hadron-nucleon interaction eikonal;
+c GZ0 - total and absorptive cross-sections (up to a factor); first parameter is
+c used only in case of hadron-nucleus interaction (to make convolution with target
+c nucleus profile function)
+        CALL XXFZ(0.D0,GZ0)
+        write (*,*)gz0
+c GTOT - total cross-section
+        GTOT=G0*GZ0(1)
+c GABS - cut pomerons cross-section
+        GABS=G0*GZ0(2)*.5D0
+c GD0 - cross-section for the cut between pomerons
+        GD0=GTOT-GABS
+c GDP - projectile diffraction cross section
+        GDP=(1.D0-CC(ICZ))*CC(2)*GD0
+c GDT - target diffraction cross section
+        GDT=(1.D0-CC(2))*CC(ICZ)*GD0
+c  GDD - double diffractive cross section
+        GDD=(1.D0-CC(ICZ))*(1.D0-CC(2))*GD0
+c GIN - inelastic cross section
+        GIN=GABS+GDP+GDT+GDD
+        GEL=GD0*CC(ICZ)*CC(2)
+c
+        IF(DEBUG.GE.1)WRITE (MONIOU,225)GTOT,GIN,GEL,GDP,GDT,GDD
+c
+225     FORMAT(2X,'PSAINI: HADRON-PROTON CROSS SECTIONS:'/
+     *  4X,'GTOT=',E10.3,2X,'GIN=',E10.3,2X,'GEL=',E10.3/4X,
+     *  'GDIFR_PROJ=',E10.3,2X,'GDIFR_TARG=',E10.3,2X,
+     *  'G_DOUBLE_DIFR',E10.3)
+c GZ - probability to have target diffraction
+        GZ(IE,ICZ,IIA)=GDT/GIN
+C??????
+        GSECT(IE,ICZ,IIA)=LOG(GIN)
+C??????
+      ELSE
+
+c Hadron-nucleus interaction
+c BM - impact parameter cutoff value
+        BM=RD(2)+DLOG(29.D0)
+c RRR - Wood-Saxon radius for the target nucleus
+        RRR=RD(2)
+c RRRM - auxiliary parameter for numerical integration
+        RRRM=RRR+DLOG(9.D0)
+c ANORM - nuclear density normalization factor multiplied by RP1
+        ANORM=1.5D0/PI/RRR**3/(1.D0+(PI/RRR)**2)*RP1
+
+c GAU(GZ) - cross sections calculation ( integration over impact parameters less than
+c BM )
+        CALL XXGAU(GZ1)
+c GAU1(GZ) - cross sections calculation ( integration over impact 
+c parameters greater than BM )
+        CALL XXGAU1(GZ1)
+c GIN - total inelastic cross section
+        GIN=GZ1(1)+GZ1(2)+GZ1(3)
+c
+        IF(DEBUG.GE.1)WRITE (MONIOU,224)
+     *  GIN*10.D0,GZ1(1)*10.D0,GZ1(2)*10.D0
+c
+224     FORMAT(2X,'PSAINI: HADRON-NUCLEUS CROSS SECTIONS:'/
+     *  4X,'GIN=',E10.3,2X,'GDIFR_TARG=',E10.3,2X,
+     *  'GDIFR_PROJ=',E10.3)
+c GZ - probability to have target diffraction
+        GZ(IE,ICZ,IIA)=GZ1(1)/GIN
+C??????
+        GIN=GIN*10.
+        GSECT(IE,ICZ,IIA)=LOG(GIN)
+C??????
+      ENDIF
+20    CONTINUE
+21    CONTINUE
+
+c Rejection functions calculation - to be interpolated in the RJINT procedure
+      DO 23 I=1,50
+c Rapidity range tabulation for the hard interaction
+      YJ=AQT0+.5D0*I
+c Rejection function for valence quark energy distribution
+      RJV(I)=PSREJV(EXP(YJ))
+
+      DO 22 J=1,5
+      DO 22 M=1,2
+      Z=.2D0*J
+      DO 22 ICZ=1,5
+c RS0 - initial slope (sum of the pomeron-hadron vertices slopes squared - R_ab)
+      RS0=RQ(ICZ)
+      M1=M+2*(ICZ-1)
+c Rejection function for semihard block energy distribution  (m=1 - gg,
+c 2 - qg)
+      RJS(I,J,M1)=PSREJS(EXP(YJ),Z,M-1)
+22    CONTINUE
+23    CONTINUE
+
+        IF(DEBUG.GE.1)WRITE (MONIOU,212)
+212     FORMAT(2X,'PSAINI: HARD CROSS SECTIONS ARE WRITTEN TO THE FILE'
+     *  ,' QGSDATA4')
+        OPEN(1,FILE='QGSDATA4',STATUS='unknown')
+        WRITE (1,*)CSBORN,CS0,CSTOT,CSQ,CSBQ,
+     *  FSUD,QRT,SJV,FJS,RJV,RJS,GZ,GSECT
+        CLOSE(1)
+      ENDIF
+************************************************************************
+
+      IF(DEBUG.GE.3)WRITE (MONIOU,218)
+218   FORMAT(2X,'PSAINI - END')
+      RETURN
+      END
+C=======================================================================
+
+        FUNCTION PSAPINT(X,J,L)
+c PSAPINT - integrated Altarelli-Parisi function
+c X - light cone momentum share value,
+c J - type of initial parton (0 - g, 1 - q)
+c L - type of final parton (0 - g, 1 - q)
+C-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)X,J,L
+201     FORMAT(2X,'PSAPINT: X=',E10.3,2X,'J= ',I1,2X,'L= ',I1)
+        IF(J.EQ.0)THEN
+          IF(L.EQ.0)THEN
+            PSAPINT=6.D0*(DLOG(X/(1.D0-X))-X**3/3.D0+X**2/2.D0-2.D0*X)
+          ELSE
+            PSAPINT=3.D0*(X+X**3/1.5D0-X*X)
+          ENDIF
+        ELSE
+          IF(L.EQ.0)THEN
+            PSAPINT=(DLOG(X)-X+.25D0*X*X)/.375D0
+          ELSE
+            Z=1.D0-X
+            PSAPINT=-(DLOG(Z)-Z+.25D0*Z*Z)/.375D0
+          ENDIF
+        ENDIF
+        IF(DEBUG.GE.2)WRITE (MONIOU,202)PSAPINT
+202     FORMAT(2X,'PSAPINT=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+      SUBROUTINE PSASET
+c Common model parameters setting
+c-----------------------------------------------------------------------
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      INTEGER DEBUG
+      CHARACTER*7 TY
+      COMMON /AREA15/ FP(5),RQ(5),CD(5)
+      COMMON /AREA17/ DEL,RS,RS0,FS,ALFP,RR,SH,DELH
+      COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+      COMMON /AREA25/ AHV(5)
+      COMMON /AREA26/ FACTORK
+      COMMON /AREA41/ TY(5)
+      COMMON /AREA43/ MONIOU
+      COMMON /DEBUG/  DEBUG
+        IF(DEBUG.GE.1)WRITE (MONIOU,210)
+210     FORMAT(2X,'PSASET - COMMON MODEL PARAMETERS SETTING')
+
+c Soft pomeron parameters:
+c DEL - overcriticity,
+c ALFP - trajectory slope;
+c FP(i) - vertices for pomeron-hadrons interaction (gamma(i)*gamma(proton)),
+c RQ(i) - vertices slopes (R(i)**2+R(proton)**2),
+c CD(i) - shower enhancement coefficients
+c (i=1,...5 - pion,proton,kaon,D-meson,Lambda_C ),
+c (Kaidalov et al., Sov.J.Nucl.Phys.,1984 - proton and pion parameters)
+      DEL=.07D0
+      ALFP=.21D0
+
+      FP(1)=2.43D0
+      RQ(1)=2.4D0
+      CD(1)=1.6D0
+
+      FP(2)=3.64D0
+      RQ(2)=3.56D0
+      CD(2)=1.5D0
+
+      FP(3)=1.75D0
+      RQ(3)=2.D0
+      CD(3)=1.7D0
+
+      FP(4)=1.21D0
+      RQ(4)=1.78D0
+      CD(4)=2.0D0
+
+      FP(5)=2.43D0
+      RQ(5)=2.4D0
+      CD(5)=2.0D0
+
+c-------------------------------------------------
+c Hard interaction parameters:
+c ALM  - Lambda_QCD squared,
+c QT0  - Q**2 cutoff,
+c RR   - vertex constant square for soft pomeron interaction with the hard block (r**2),;
+c BET  - gluon structure function parameter for the soft pomeron ((1-x)**BET),
+c AMJ0 - jet mass,
+c QTF  - Q**2 cutoff for the timelike evolution,
+c FACTORK - K-factor value;
+c DELH is not a parameter of the model; it is used only for energy sharing
+c procedure - initially energy is shared according to s**DELH dependence
+c for the hard interaction cross-section and then rejection is used according
+c to real Sigma_hard(s) dependence.
+      ALM=.04D0
+      RR=.35D0
+      QT0=4.D0
+      BET=1.D0
+      DELH=0.25D0
+      AMJ0=0.D0
+      QTF=.5D0
+      FACTORK=2.D0
+
+c-------------------------------------------------
+c Valence quark structure functions for the hard scattering
+c (~1/sqrt(x)*(1-x)**AHV(i), i=1,...5 corresponds to pion, nucleon etc.)
+      AHV(1)=1.5D0
+      AHV(2)=2.5D0
+      AHV(3)=2.D0
+      AHV(4)=4.D0
+      AHV(5)=5.D0
+c Initial particle types
+      TY(1)='pion   '
+      TY(2)='nucleon'
+      TY(3)='kaon   '
+      TY(4)='D-meson'
+      TY(5)='LambdaC'
+      RETURN
+      END
+C=======================================================================
+
+        FUNCTION PSBINT(QQ,S,M,L)
+C PSBINT - Born cross-section interpolation
+c QQ - effective momentum cutoff for the scattering,
+c S - total c.m. energy squared for the scattering,
+c M - parton type at current end of the ladder (1 - g, 2 - q)
+c L - parton type at opposite end of the ladder (1 - g, 2 - q)
+C-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION WI(3),WK(3)
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA31/ CSJ(17,68)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)QQ,S,M,L
+201     FORMAT(2X,'PSBINT: QQ=',E10.3,2X,'S= ',E10.3,2X,'M= ',I1,2X,
+     *  'L= ',I1)
+        PSBINT=0.D0
+        IF(S.LE.MAX(4.D0*QT0,QQ))THEN
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSBINT
+202     FORMAT(2X,'PSBINT=',E10.3)
+          RETURN
+        ENDIF
+
+        ML=17*(M-1)+34*(L-1)
+        QLI=DLOG(QQ/QT0)/1.38629d0
+        SL=DLOG(S/QT0)/1.38629d0
+        SQL=SL-QLI
+        I=INT(QLI)
+        K=INT(SL)
+        IF(I.GT.13)I=13
+
+        IF(SQL.GT.10.D0)THEN
+          IF(K.GT.14)K=14
+          WI(2)=QLI-I
+          WI(3)=WI(2)*(WI(2)-1.D0)*.5D0
+          WI(1)=1.D0-WI(2)+WI(3)
+          WI(2)=WI(2)-2.D0*WI(3)
+          WK(2)=SL-K
+          WK(3)=WK(2)*(WK(2)-1.D0)*.5D0
+          WK(1)=1.D0-WK(2)+WK(3)
+          WK(2)=WK(2)-2.D0*WK(3)
+
+          DO 1 I1=1,3
+          DO 1 K1=1,3
+1         PSBINT=PSBINT+CSJ(I+I1,K+K1+ML)*WI(I1)*WK(K1)
+          PSBINT=EXP(PSBINT)
+        ELSEIF(SQL.LT.1.D0.AND.I.NE.0)THEN
+          SQ=(S/QQ-1.D0)/3.D0
+          WI(2)=QLI-I
+          WI(3)=WI(2)*(WI(2)-1.D0)*.5D0
+          WI(1)=1.D0-WI(2)+WI(3)
+          WI(2)=WI(2)-2.D0*WI(3)
+
+          DO 2 I1=1,3
+          I2=I+I1
+          K2=I2+1+ML
+2         PSBINT=PSBINT+CSJ(I2,K2)*WI(I1)
+          PSBINT=EXP(PSBINT)*SQ
+        ELSEIF(K.EQ.1)THEN
+          SQ=(S/QT0/4.D0-1.D0)/3.D0
+          WI(2)=QLI
+          WI(1)=1.D0-QLI
+
+          DO 3 I1=1,2
+3         PSBINT=PSBINT+CSJ(I1,3+ML)*WI(I1)
+          PSBINT=EXP(PSBINT)*SQ
+        ELSEIF(K.LT.15)THEN
+          KL=INT(SQL)
+          IF(I+KL.GT.12)I=12-KL
+          IF(I+KL.EQ.1)KL=2
+          WI(2)=QLI-I
+          WI(3)=WI(2)*(WI(2)-1.D0)*.5D0
+          WI(1)=1.D0-WI(2)+WI(3)
+          WI(2)=WI(2)-2.D0*WI(3)
+          WK(2)=SQL-KL
+          WK(3)=WK(2)*(WK(2)-1.D0)*.5D0
+          WK(1)=1.D0-WK(2)+WK(3)
+          WK(2)=WK(2)-2.D0*WK(3)
+
+          DO 4 I1=1,3
+          I2=I+I1
+          DO 4 K1=1,3
+          K2=I2+KL+K1-1+ML
+4         PSBINT=PSBINT+CSJ(I2,K2)*WI(I1)*WK(K1)
+          PSBINT=EXP(PSBINT)
+
+        ELSE
+          K=15
+          IF(I.GT.K-3)I=K-3
+          WI(2)=QLI-I
+          WI(3)=WI(2)*(WI(2)-1.D0)*.5D0
+          WI(1)=1.D0-WI(2)+WI(3)
+          WI(2)=WI(2)-2.D0*WI(3)
+          WK(2)=SL-K
+          WK(1)=1.D0-WK(2)
+
+          DO 5 I1=1,3
+          DO 5 K1=1,2
+5         PSBINT=PSBINT+CSJ(I+I1,K+K1+ML)*WI(I1)*WK(K1)
+          PSBINT=EXP(PSBINT)
+        ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSBINT
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSBORN(QQ,S,IQ1,IQ2)
+c PSFBORN -hard 2->2 parton scattering Born cross-section
+c S is the c.m. energy square for the scattering process,
+c IQ1 - parton type at current end of the ladder (0 - g, 1,2 - q)
+c IQ2 - parton type at opposite end of the ladder (0 - g, 1,2 - q)
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA6/  PI,BM,AM
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA26/ FACTORK
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        COMMON /AR3/  X1(7),A1(7)
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)QQ,S,IQ1,IQ2
+201     FORMAT(2X,'PSBORN: QQ=',E10.3,2X,'S= ',E10.3,2X,'IQ1= ',I1,2X,
+     *  'IQ2= ',I1)
+        TMIN=S*(.5D0-DSQRT(.25D0-QT0/S))
+        TMIN=MAX(TMIN,S*QQ/(S+QQ))
+
+        IF(IQ1*IQ2.EQ.0)THEN
+          IQ=IQ2
+        ELSE
+          IQ=2
+        ENDIF
+
+        PSBORN=0.D0
+        DO 1 I=1,7
+        DO 1 M=1,2
+        T=2.D0*TMIN/(1.D0+2.D0*TMIN/S-X1(I)*(2*M-3)*(1.D0-2.D0*TMIN/S))
+        QT=T*(1.D0-T/S)
+        FB=PSFBORN(S,T,IQ1,IQ)+PSFBORN(S,S-T,IQ1,IQ)
+1       PSBORN=PSBORN+A1(I)*FB/DLOG(QT/ALM)**2*T**2
+        PSBORN=PSBORN*(.5D0/TMIN-1.D0/S)*FACTORK*PI**3/2.25D0**2/S**2
+        IF(IQ1.EQ.0.AND.IQ2.EQ.0)PSBORN=PSBORN*.5D0
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSBORN
+202     FORMAT(2X,'PSBORN=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE PSCAJET(QQ,IQ1,QV,ZV,QM,IQV,LDAU,LPAR,JQ)
+c Final state emission process (all branchings as well as parton masses
+c are determined)
+C-----------------------------------------------------------------------
+c QQ - maximal effective momentum transfer for the first branching
+c IQ1, IQ2 - initial jet flavours in forward and backward direction
+c (0 - for gluon)
+c QV(i,j) - effective momentum for the branching of the parton in i-th row
+c on j-th level (0 - in case of no branching)  - to be determined
+c ZV(i,j) - Z-value for the branching of the parton in i-th row
+c on j-th level - to be determined
+c QM(i,j) - mass squared for the parton in i-th row
+c on j-th level - to be determined
+c IQV(i,j) - flavour for the parton in i-th row on j-th level 
+c - to be determined
+c LDAU(i,j) - first daughter row for the branching of the parton in i-th row
+c on j-th level - to be determined
+c LPAR(i,j) - the parent row for the parton in i-th row
+c on j-th level - to be determined
+	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION QMAX(30,50),IQM(2),LNV(50),
+     *  QV(30,50),ZV(30,50),QM(30,50),IQV(30,50),
+     *  LDAU(30,49),LPAR(30,50)
+
+        COMMON /AREA11/ B10
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)QQ,IQ1,JQ
+201     FORMAT(2X,'PSCAJET: QQ=',E10.3,2X,'IQ1= ',I1,2X,'JQ=',I1)
+
+        DO 1 I=2,20
+1	LNV(I)=0
+        LNV(1)=1
+        QMAX(1,1)=QQ
+        IQV(1,1)=IQ1
+        NLEV=1
+        NROW=1
+
+2        QLMAX=DLOG(QMAX(NROW,NLEV)/QTF/16.D0)
+         IQ=MIN(1,IABS(IQV(NROW,NLEV)))+1
+
+        IF(PSRAN(B10).GT.PSUDINT(QLMAX,IQ))THEN
+          Q=PSQINT(QLMAX,PSRAN(B10),IQ)
+          Z=PSZSIM(Q,IQ)
+
+          LL=LNV(NLEV+1)+1
+          LDAU(NROW,NLEV)=LL
+          LPAR(LL,NLEV+1)=NROW
+          LPAR(LL+1,NLEV+1)=NROW
+          LNV(NLEV+1)=LL+1
+
+          IF(IQ.NE.1)THEN
+            IF((3-2*JQ)*IQV(NROW,NLEV).GT.0)THEN
+              IQM(1)=0
+              IQM(2)=IQV(NROW,NLEV)
+            ELSE
+              IQM(2)=0
+              IQM(1)=IQV(NROW,NLEV)
+              Z=1.D0-Z
+            ENDIF
+          ELSE
+*********************************************************
+            WG=PSFAP(Z,0,0)
+*********************************************************
+            WG=WG/(WG+PSFAP(Z,0,1))
+            IF(PSRAN(B10).LT.WG)THEN
+              IQM(1)=0
+              IQM(2)=0
+            ELSE
+              IQM(1)=INT(3.D0*PSRAN(B10)+1.D0)*(3-2*JQ)
+              IQM(2)=-IQM(1)
+            ENDIF
+            IF(PSRAN(B10).LT..5D0)Z=1.D0-Z
+          ENDIF
+
+          QV(NROW,NLEV)=Q
+          ZV(NROW,NLEV)=Z
+        
+          NROW=LL
+          NLEV=NLEV+1
+          QMAX(NROW,NLEV)=Q*Z**2
+          QMAX(NROW+1,NLEV)=Q*(1.D0-Z)**2
+          IQV(NROW,NLEV)=IQM(1)
+          IQV(NROW+1,NLEV)=IQM(2)
+        IF(DEBUG.GE.3)WRITE (MONIOU,203)NLEV,NROW,Q,Z
+203     FORMAT(2X,'PSCAJET: NEW BRANCHING AT LEVEL NLEV=',I2,
+     *  ' NROW=',I2/4X,' EFFECTIVE MOMENTUM Q=',E10.3,2X,' Z=',E10.3)
+          GOTO 2
+        ELSE
+
+          QV(NROW,NLEV)=0.D0
+          ZV(NROW,NLEV)=0.D0
+          QM(NROW,NLEV)=AMJ0
+        IF(DEBUG.GE.3)WRITE (MONIOU,204)NLEV,NROW
+204     FORMAT(2X,'PSCAJET: NEW FINAL JET AT LEVEL NLEV=',I2,
+     *  ' NROW=',I2)
+        ENDIF
+
+4       CONTINUE
+      IF(NLEV.EQ.1)THEN
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'PSCAJET - END')
+        RETURN
+      ENDIF
+        LPROW=LPAR(NROW,NLEV)
+
+        IF(LDAU(LPROW,NLEV-1).EQ.NROW)THEN
+          NROW=NROW+1
+          GOTO 2
+        ELSE
+          Z=ZV(LPROW,NLEV-1)
+          QM(LPROW,NLEV-1)=Z*(1.D0-Z)*QV(LPROW,NLEV-1)
+     *	  +QM(NROW-1,NLEV)/Z+QM(NROW,NLEV)/(1.D0-Z)
+          NROW=LPROW
+          NLEV=NLEV-1
+        IF(DEBUG.GE.3)WRITE (MONIOU,205)NLEV,NROW,QM(LPROW,NLEV)
+205     FORMAT(2X,'PSCAJET: JET MASS AT LEVEL NLEV=',I2,
+     *  ' NROW=',I2,' - QM=',E10.3)
+          GOTO 4
+        ENDIF
+        END
+C=======================================================================
+
+      SUBROUTINE PSCONF
+c Simulation of the interaction configuration: impact parameter, nucleons positions,
+c numbers of cut soft pomerons and semihard blocks, their connections.
+c-----------------------------------------------------------------------
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      INTEGER DEBUG
+c XA(56,3),XB(56,3) - arrays for projectile and target nucleons positions recording,
+c FHARD(i) give the factors to the scattering amplitude due to
+c valence quark-gluon (i=1),  gluon-valence quark (i=2) and
+c valence quark-valence quark (i=3) interactions
+      DIMENSION XA(56,3),XB(56,3),FHARD(3)
+      COMMON /AREA1/  IA(2),ICZ,ICP
+      COMMON /AREA2/  S,Y0,WP0,WM0
+      COMMON /AREA6/  PI,BM,AM
+c Arrays for interaction configuration recording:
+c LQA(i) (LQB(j)) - numbers of cut soft pomerons, connected to i-th projectile
+c (j-th target) nucleon (hadron);
+c LHA(i) (LHB(j)) - the same for hard pomerons numbers;
+c IAS(k) (IBS(k)) - number (position in array) of the projectile (target) nucleon,
+c connected to k-th block of soft pomerons;
+c NQS(k) - number of soft pomerons in k-th block;
+c IAH(k) (IBH(k)) - number (position in array) of the projectile (target) nucleon,
+c connected to k-th hard pomeron;
+c ZH(k) - impact parameter between the two nucleons connected to k-th hard pomeron
+c (more exactly exp(-b**2/RP1));
+c LVA(i)=1 if valence quark from i-th nucleon (i=1 for hadron) is involved into
+c the hard interaction and LVA(i)=0 otherwise, LVB(j) - similar.
+      COMMON /AREA9/  LQA(56),LQB(56),NQS(1000),IAS(1000),IBS(1000),
+     *                LHA(56),LHB(56),ZH(1000),IAH(1000),IBH(1000),
+     *                IQH(1000),LVA(56),LVB(56)
+      COMMON /AREA11/ B10
+c NSP - number of secondary particles
+      COMMON /AREA12/ NSP
+      COMMON /AREA16/ CC(5)
+      COMMON /AREA40/ JDIFR
+      COMMON /AREA43/ MONIOU
+**************************************************
+      COMMON /AREA45/ GDT
+**************************************************
+      COMMON /AREA99/ NWT
+      COMMON /DEBUG/  DEBUG
+      SAVE
+      DIMENSION IWT(56)
+
+        IF(DEBUG.GE.1)WRITE (MONIOU,201)
+201     FORMAT(2X,'PSCONF - CONFIGURATION OF THE INTERACTION')
+
+        NSP=0
+
+        IF(IA(1).EQ.1)THEN
+**************************************************
+          IF(JDIFR.EQ.1.AND.PSRAN(B10).LT.GDT)THEN
+c Target diffraction
+            IF(IA(2).NE.1)THEN
+c ICT - partner target nucleon type (proton - 2 or neutron - 3)
+              ICT=INT(2.5+PSRAN(B10))
+            ELSE
+c Target proton
+              ICT=2
+            ENDIF
+            WPI=WP0
+            WMI=WM0
+c              write (*,*)'difr'
+            CALL XXDTG(WPI,WMI,ICP,ICT,0)
+            RETURN
+          ENDIF
+**************************************************
+c For hadron projectile we have given position in transverse plane;
+c initially primary hadron is positioned at (X,Y)=(0,0)
+          DO 1 I=1,3
+1          XA(1,I)=0.D0
+      ENDIF
+
+c-------------------------------------------------
+c Inelastic interaction at B<BM (usual case)
+c-------------------------------------------------
+c NW - number of wounded nucleons in the primary (NW=1 for hadron);
+c NT - number of target nucleons being in their active diffractive state;
+c LS - number of cut soft pomeron blocks (froissarons);
+c NHP - number of cut pomerons having hard block (referred below as hard blocks);
+c NQS(k) - number of cut soft pomerons in k-th block;
+c IAS(k) (IBS(k)) - number (position in array) of the projectile (target) nucleon,
+c connected to k-th block of soft pomerons;
+c IAH(k) (IBH(k)) - number 3(position in array) of the projectile (target) nucleon,
+c connected to k-th hard pomeron;
+c ZH(k) - impact parameter between the two nucleons connected to k-th hard pomeron
+c (more exactly exp(-b**2/RP1));
+c LQA(i) (LQB(j)) - total number of cut soft pomerons, connected to i-th projectile
+c (j-th target) nucleon (hadron);
+c LHA(i) (LHB(j)) - total number of cut hard blocks, connected to i-th projectile
+c (j-th target) nucleon (hadron);
+c LVA(i)=1 if valence quark from i-th nucleon (i=1 for hadron) is involved into
+c the hard interaction and LVA(i)=0 otherwise, LVB(j) - similar.
+c-------------------------------------------------
+c Initialization
+2         DO 3 I=1,IA(1)
+          LHA(I)=0
+        LVA(I)=0
+3       LQA(I)=0
+        DO 4 I=1,IA(2)
+        LHB(I)=0
+        LVB(I)=0
+4       LQB(I)=0
+
+c-------------------------------------------------
+c The beginning
+5       CONTINUE
+**************************************************
+        IF(IA(2).NE.1)THEN
+c For target nucleus number of target nucleons being in their active
+c diffractive state is simulated (for each nucleon probability equals
+c 1./C_n,  - shower enhancenment coefficient)
+          NT=0
+          DO 6 I=1,IA(2)
+6         NT=NT+INT(CC(2)+PSRAN(B10))
+c In case of no active target nucleon the event is rejected
+          IF(NT.EQ.0)GOTO 5
+        IF(DEBUG.GE.3)WRITE (MONIOU,203)NT
+203     FORMAT(2X,'PSCONF: NUMBER OF ACTIVE TARGET NUCLEONS NT=',
+     *  I2)
+c PSGEA(NT,XB,2) - target nucleons positions simulation:
+          CALL PSGEA(NT,XB,2)
+c NT - number of target nucleons being in their active diffractive state;
+c XB(i,n) - n-th nucleon coordinates (i=1,2,3 corresponds to x,y,z);
+c parameter 2 means target
+        ELSE
+          NT=1
+          XB(1,1)=0.D0
+          XB(1,2)=0.D0
+        ENDIF
+**************************************************
+
+c-------------------------------------------------
+c Impact parameter  square is simulated uniformly (B**2<BM**2)
+        B=BM*DSQRT(PSRAN(B10))
+        IF(DEBUG.GE.2)WRITE (MONIOU,204)B*AM
+204     FORMAT(2X,'PSCONF: IMPACT PARAMETER FOR THE INTERACTION:',
+     *  E10.3,' FM')
+c PSGEA(IA(1),XA,1) - projectile nucleons positions simulation:
+c IA(1) - projectile nucleus mass number;
+c XA(i,n) - n-th nucleon coordinates (i=1,2,3 corresponds to x,y,z);
+c parameter 1 means projectile
+        IF(IA(1).GT.1)CALL PSGEA(IA(1),XA,1)
+
+        NW=0
+        LS=0
+        NS=0
+        NHP=0
+        DO 101 IT = 1,NT
+          IWT(IT) = 0
+ 101    CONTINUE
+
+c-------------------------------------------------
+c Cycle over all projectile nucleons ( for projectile hadron we have only IN=1 )
+        DO 14 IN=1,IA(1)
+        IF(DEBUG.GE.2.AND.ICZ.EQ.2)WRITE (MONIOU,205)IN
+205     FORMAT(2X,'PSCONF: ',I2,'-TH PROJECTILE NUCLEON')
+c Only nucleons in their active diffractive state are considered (for each nucleon
+c probability equals 1./C_n, C_n = 1./CC(2) - shower enhancenment coefficient)
+        IF(IA(1).NE.1.AND.PSRAN(B10).GT.CC(2))GOTO 12
+c Projectile nucleons positions are shifted according the to impact parameter B
+        X=XA(IN,1)+B
+        Y=XA(IN,2)
+
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+c Projectile diffraction
+c For each projectile nucleon (hadron) diffractive dissociation probability is
+c (1.D0-CC(ICZ))*PSV(X,Y,XB,NT);
+c XXV(X,Y,XB,NT) - nucleon-nucleus scattering eikonal factor
+c ( (1-eikonal)**2 ) for given nucleons positions
+c (For projectile hadron only in case of JPERI=0, otherwise it was considered
+c before at any impact parameter )
+        IF(JDIFR.EQ.1.
+     *  AND.PSRAN(B10).LT.(1.D0-CC(ICZ))*PSV(X,Y,XB,NT))THEN
+**************************************************
+          IF(IA(2).NE.1)THEN
+c ICT - partner target nucleon type (proton - 2 or neutron - 3)
+            ICT=INT(2.5+PSRAN(B10))
+          ELSE
+c Target proton
+            ICT=2
+          ENDIF
+          IF(IA(1).EQ.1)THEN
+c Projectile hadron 
+        IF(DEBUG.GE.2)WRITE (MONIOU,206)
+206     FORMAT(2X,'PROJECTILE HADRON DIFFRACTION')
+            ICP0=ICP
+          ELSE
+c Projectile nucleon 
+        IF(DEBUG.GE.2)WRITE(MONIOU,207)IN
+207     FORMAT(2X,I2,'-TH PROJECTILE NUCLEON DIFFRACTION')
+            ICP0=INT(2.5+PSRAN(B10))
+          ENDIF
+          WPI=WP0
+          WMI=WM0
+          IF(IA(2).EQ.1)THEN
+            LQ=0
+          ELSE
+            LQ=1
+          ENDIF
+          CALL XXDPR(WPI,WMI,ICP0,ICT,LQ)
+          GOTO 14
+        ENDIF
+**************************************************
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+
+        IQS=0
+        NW=NW+1
+c-------------------------------------------------
+c Cycle over all target nucleons in active state
+        DO 11 M=1,NT
+c Z - b-factor for pomeron eikonal calculation (exp(-R_ij/R_p))
+        Z=PSDR(X-XB(M,1),Y-XB(M,2))
+c VV - eikonal for nucleon-nucleon (hadron-nucleon) interaction
+c (sum of the soft and semihard eikonals)
+        VV=2.D0*PSFAZ(Z,FSOFT,FHARD,FSHARD)
+        EV=EXP(-VV)
+c EH - eikonal contribution of valence quarks hard interactions
+        EH=FHARD(1)+FHARD(2)+FHARD(3)
+c	eh=0.d0
+        AKS=PSRAN(B10)
+c 1.-EXP(-VV)*(1.D0-2.D0*EH) is the probability for inelastic nucleon-nucleon
+c (hadron-nucleon) interaction (for given nucleons positions)
+        IF(AKS.GT.1.D0-EV*(1.D0-2.D0*EH))GOTO 11
+        IF(DEBUG.GE.2)WRITE (MONIOU,208)M
+208     FORMAT(2X,'PSCONF: INTERACTION WITH',I2,'-TH TARGET NUCLEON')
+C  INCREMENT THE NUMBER IWT OF WOUNDED TARGET NUCLEONS
+        IWT(M) = 1
+
+c-------------------------------------------------
+c IQV - type of the hard interaction: 0 - gg, 1 - qg, 2 - gq, 3 - qq
+        IQV=0
+
+c 2*EH*EV = 2*EH*EXP(-VV) - probability for only valence quarks hard interactions
+c (with no one soft or semihard)
+        SUM=2.D0*EH*EV
+
+c-------------------------------------------------
+        IF(AKS.LT.SUM)THEN
+          AKS1=EH*PSRAN(B10)
+          IF(AKS1.LT.FHARD(1))THEN
+c Rejection in case of valence quark already involved into the interaction
+            IF(LVA(NW).NE.0)GOTO 11
+c LVA(NW)=1 - valence quark-gluon interaction
+            LVA(NW)=1
+            IQV=1
+          ELSEIF(AKS1.LT.FHARD(1)+FHARD(2))THEN
+c Rejection in case of valence quark already involved into the interaction
+            IF(LVB(M).NE.0)GOTO 11
+c LVB(M)=1 - gluon-valence quark interaction
+            LVB(M)=1
+            IQV=2
+          ELSE
+c Rejection in case of valence quarks already involved into the interaction
+            IF(LVA(NW)+LVB(M).NE.0)GOTO 11
+c LVA(NW)=LVB(M)=1 - valence quark-valence quark interaction
+            LVA(NW)=1
+            LVB(M)=1
+            IQV=3
+          ENDIF
+          N=1
+c LNH - number of new hard blocks (resulted from current nucleon-nucleon interaction)
+          LNH=1
+          GOTO 22
+        ENDIF
+c-------------------------------------------------
+
+c LNH - number of new hard blocks - initialization
+        LNH=0
+c WH - probability to have semihard interaction
+        WH=2.D0*FSHARD/VV
+c N - number of cut pomerons (both soft ones and having hard blocks) for the
+c nucleon-nucleon (hadron-nucleon) interaction - is determined according to Poisson
+c with average value VV (twice the eikonal)
+        DO 7 N=1,45
+        EV=EV*VV/N
+        SUM=SUM+EV
+7       IF(AKS.LT.SUM)GOTO 8
+
+c LNH - number of hard blocks for nucleon-nucleon (hadron-nucleon)
+c interaction (according to WH probability)
+8       DO 9 I=1,N
+9       LNH=LNH+INT(WH+PSRAN(B10))
+
+c-------------------------------------------------
+        AKS1=.5D0*PSRAN(B10)
+c EH is the probability to have valence quarks interactions in addition to the
+c soft and semihard
+        IF(AKS1.LT.EH)THEN
+          IF(AKS1.LT.FHARD(1))THEN
+            IF(LVA(NW).NE.0)GOTO 22
+c Valence quark-gluon interaction
+            LVA(NW)=1
+            IQV=1
+          ELSEIF(AKS1.LT.FHARD(1)+FHARD(2))THEN
+            IF(LVB(M).NE.0)GOTO 22
+c Gluon-valence quark interaction
+            LVB(M)=1
+            IQV=2
+          ELSE
+            IF(LVA(NW)+LVB(M).NE.0)GOTO 22
+c Valence quark-valence quark interaction
+            LVA(NW)=1
+            LVB(M)=1
+            IQV=3
+          ENDIF
+          N=N+1
+          LNH=LNH+1
+        ENDIF
+
+22      IQS=1
+        IF(LNH.NE.0)THEN
+c-------------------------------------------------
+c New hard blocks recording:
+c LNH - number of new hard blocks,
+c LHA(i) (LHB(j)) - total number of cut hard blocks, connected to i-th projectile
+c (j-th target) nucleon (hadron);
+c IAH(k) (IBH(k)) - number (position in array) of the projectile (target) nucleon,
+c connected to k-th hard block;
+c ZH(k) - factor exp(-R_ij/R_p) for k-th hard block;
+c IQH(k) - type of the hard interaction: 0 - gg, 1 - qg, 2 - gq, 3 - qq
+c-------------------------------------------------
+c N - number of cut soft pomerons
+          N=N-LNH
+          LHA(NW)=LHA(NW)+LNH
+          LHB(M)=LHB(M)+LNH
+          DO 10 I=1,LNH
+          I1=NHP+I
+          IF(I.EQ.1.AND.IQV.NE.0)THEN
+            IQH(I1)=IQV
+          ELSE
+            IQH(I1)=0
+          ENDIF
+        IF(DEBUG.GE.2)WRITE (MONIOU,209)I1,NW,M,IQH(I1)
+209     FORMAT(2X,'PSCONF: ',I3,'-TH HARD BLOCK IS CONNECTED TO',1X,
+     *  I2,'-TH PROJECTILE NUCLEON (HADRON) AND'/4X,I2,
+     *  '-TH TARGET NUCLEON; TYPE OF THE SEMIHARD INTERACTION:',I1)
+          ZH(I1)=Z
+          IAH(I1)=NW
+10        IBH(I1)=M
+c-------------------------------------------------
+c NHP - total number of hard blocks
+          NHP=NHP+LNH
+        ENDIF
+
+c-------------------------------------------------
+        IF(N.GT.0)THEN
+c One more block of soft pomerons; soft block characteristics recording
+          LS=LS+1
+          IAS(LS)=NW
+          IBS(LS)=M
+          LQA(NW)=LQA(NW)+N
+          LQB(M)=LQB(M)+N
+          NQS(LS)=N
+        IF(DEBUG.GE.2)WRITE (MONIOU,210)LS,NW,M,N
+210     FORMAT(2X,'PSCONF: ',I3,'-TH SOFT BLOCK IS CONNECTED TO',1X,
+     *  I2,'-TH PROJECTILE NUCLEON (HADRON) AND'/4X,I2,
+     *  '-TH TARGET NUCLEON; NUMBER OF POMERONS IN THE BLOCK NP=',
+     *  I2)
+        ENDIF
+11      CONTINUE
+c-------------------------------------------------
+
+        IF(IQS.NE.0)GOTO 14
+c No interaction for projectile nucleon considered
+        NW=NW-1
+12      CONTINUE
+
+c One more projectile spectator (noninteracting) nucleon (spectator positions
+c are recorded to simulate nuclear fragmentation)
+        NS=NS+1
+        IF(NS.NE.IN)THEN
+          DO 13 L=1,3
+13          XA(NS,L)=XA(IN,L)
+        ENDIF
+14      CONTINUE
+
+c In case of no one interacting (or D-diffracted) nucleon the event is
+c rejected, new impact parameter is generated and all the procedure is
+c repeated
+      IF(NS.EQ.IA(1))THEN
+        IF(DEBUG.GE.3)WRITE (MONIOU,211)
+211     FORMAT(2X,'PSCONF: NO ONE NUCLEON (HADRON) INTERACTS - ',
+     *  'REJECTION')
+         GOTO 5
+      ENDIF
+c-------------------------------------------------
+      NWT = 0
+C  number of interacting target nucleons
+      DO 102 IT = 1,NT
+        NWT = NWT + IWT(IT)
+ 102  CONTINUE
+
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+c Fragmentation of the spectator part of the nucleus
+      CALL XXFRAGM(NS,XA)
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+
+c Inelastic interaction - energy sharing procedure
+20      IF(NW.NE.0)CALL PSSHAR(LS,NHP,NW,NT)
+        IF(DEBUG.GE.3)WRITE (MONIOU,212)
+212     FORMAT(2X,'PSCONF - END')
+        RETURN
+        END
+C=======================================================================
+
+       SUBROUTINE PSCS(C,S)
+c C,S - COS and SIN generation for uniformly distributed angle 0<fi<2*pi
+c-----------------------------------------------------------------------
+       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+       COMMON /AREA11/ B10
+       COMMON /AREA43/ MONIOU
+       COMMON /DEBUG/  DEBUG
+       SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)
+201     FORMAT(2X,'PSCS - COS(FI) AND SIN(FI) ARE GENERATED',
+     *  ' (0<FI<2*PI)')
+1      S1=2.D0*PSRAN(B10)-1.D0
+       S2=2.D0*PSRAN(B10)-1.D0
+       S3=S1*S1+S2*S2
+       IF(S3.GT.1.D0)GOTO 1
+       S3=DSQRT(S3)
+       C=S1/S3
+       S=S2/S3
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)C,S
+202     FORMAT(2X,'PSCS: C=',E10.3,2X,'S=',E10.3)
+       RETURN
+       END
+C=======================================================================
+
+        SUBROUTINE PSDEFTR(S,EP,EY)
+c Determination of the parameters for the Lorentz transform to the rest frame
+c system for 4-vector EP
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EY(3),EP(4)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)EP,S
+201     FORMAT(2X,'PSDEFTR - LORENTZ BOOST PARAMETERS:'/
+     *  4X,'4-VECTOR EP=',4E10.3/4X,'4-VECTOR SQUARED S=',E10.3)
+        DO 2 I=1,3
+        IF(EP(I+1).EQ.0.D0)THEN
+          EY(I)=1.D0
+        ELSE
+            WP=EP(1)+EP(I+1)
+          WM=EP(1)-EP(I+1)
+          IF(WM/WP.LT.1.D-8)THEN
+            WW=S
+            DO 1 L=1,3
+1            IF(L.NE.I)WW=WW+EP(L+1)**2
+            WM=WW/WP
+          ENDIF
+          EY(I)=DSQRT(WM/WP)
+          EP(1)=WP*EY(I)
+          EP(I+1)=0.D0
+        ENDIF
+2       CONTINUE
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)EY
+202     FORMAT(2X,'PSDEFTR: LORENTZ BOOST PARAMETERS EY(I)=',2X,3E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE PSDEFROT(EP,S0X,C0X,S0,C0)
+c Determination of the parameters the spacial rotation to the lab. system
+c for 4-vector EP
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EP(4)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)EP
+201     FORMAT(2X,'PSDEFROT - SPACIAL ROTATION PARAMETERS'/4X,
+     *  '4-VECTOR EP=',2X,4(E10.3,1X))
+c Transverse momentum square for the current parton (EP)
+        PT2=EP(3)**2+EP(4)**2
+        IF(PT2.NE.0.D0)THEN
+          PT=DSQRT(PT2)
+c System rotation to get Pt=0 - Euler angles are determined (C0X = cos theta,
+c S0X = sin theta, C0 = cos phi, S0 = sin phi)
+          C0X=EP(3)/PT
+          S0X=EP(4)/PT
+c Total momentum for the gluon
+          PL=DSQRT(PT2+EP(2)**2)
+          S0=PT/PL
+          C0=EP(2)/PL
+        ELSE
+          C0X=1.D0
+          S0X=0.D0
+          PL=ABS(EP(2))
+          S0=0.D0
+          C0=EP(2)/PL
+        ENDIF
+
+        EP(2)=PL
+        EP(3)=0.D0
+        EP(4)=0.D0
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)S0X,C0X,S0,C0,EP
+202     FORMAT(2X,'PSDEFROT: SPACIAL ROTATION PARAMETERS'/
+     *  4X,'S0X=',E10.3,2X,'C0X=',E10.3,2X,'S0=',E10.3,2X,'C0=',E10.3/
+     *  4X,'ROTATED 4-VECTOR EP=',4(E10.3,1X))
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSDR(X,Y)
+c PSDR - impact parameter factor for eikonals calculation (exp(-Rij/Rp)=Z)
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA7/  RP
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)X,Y
+201     FORMAT(2X,'PSDR: NUCLEON COORDINATES - X=',E10.3,2X,'Y=',E10.3)
+        PSDR=EXP(-(X*X+Y*Y)/RP)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSDR
+202     FORMAT(2X,'PSDR=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSFAP(X,J,L)
+C PSFAP - Altarelli-Parisi function (multiplied by X)
+c X - light cone momentum share value,
+c J - type of the parent parton (0-g,1-q)
+c L - type of the daughter parton (0-g,1-q)
+C-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)X,J,L
+201     FORMAT(2X,'PSFAP - ALTARELLI-PARISI FUNCTION:',2X,
+     *  'X=',E10.3,2X,'J=',I1,2X,'L=',I1)
+        IF(J.EQ.0)THEN
+          IF(L.EQ.0)THEN
+            PSFAP=((1.D0-X)/X+X/(1.D0-X)+X*(1.D0-X))*6.d0
+          ELSE
+            PSFAP=(X**2+(1.D0-X)**2)*3.d0
+          ENDIF
+        ELSE
+          IF(l.EQ.0)THEN
+            PSFAP=(1.D0+(1.D0-X)**2)/X/.75D0
+          ELSE
+            PSFAP=(X**2+1.D0)/(1.D0-X)/.75D0
+          ENDIF
+        ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSFAP
+202     FORMAT(2X,'PSFAP=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSFAZ(Z,FSOFT,FHARD,FSHARD)
+c Interaction eikonal for hadron-nucleon (nucleon-nucleon) scattering
+c Z - impact parameter factor, Z=exp(-b**2/Rp),
+c FSOFT - soft pomeron eikonal - to be determined,
+c FSHARD - semihard interaction eikonal (gg) - to be determined,
+c FHARD(k) - hard interaction eikonal (k=1 - qg, 2 - gq, 3 - qq) -
+c to be determined,
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION FHARD(3)
+        COMMON /AREA17/ DEL,RS,RS0,FS,ALF,RR,SH,DELH
+        COMMON /AREA22/ SJV,FJS(5,3)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)Z
+201     FORMAT(2X,'PSFAZ - HADRON-NUCLEON (NUCLEON-NUCLEON)',
+     *  ' INTERACTION EIKONAL; Z=',E10.3)
+        FSOFT=FS*Z
+        FHARD(3)=SJV*Z**(RS/RS0)
+
+        JZ=INT(5.D0*Z)
+        IF(JZ.GT.3)JZ=3
+        WZ=5.D0*Z-JZ
+
+        DO 1 I=1,3
+        IF(JZ.EQ.0)THEN
+          FSR=(EXP(FJS(1,I))*WZ+(EXP(FJS(2,I))-2.D0*
+     *    EXP(FJS(1,I)))*WZ*(WZ-1.D0)*.5D0)*Z
+        ELSE
+          FSR=EXP(FJS(JZ,I)+(FJS(JZ+1,I)-FJS(JZ,I))*WZ
+     *    +(FJS(JZ+2,I)+FJS(JZ,I)-2.D0*FJS(JZ+1,I))
+     *    *WZ*(WZ-1.D0)*.5D0)*Z
+        ENDIF
+        IF(I.NE.1)THEN
+          FHARD(I-1)=FSR
+        ELSE
+          FSHARD=FSR
+        ENDIF
+1       CONTINUE
+
+        PSFAZ=FSOFT+FSHARD
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSFAZ,FSOFT,FSHARD,FHARD
+202     FORMAT(2X,'PSFAZ=',E10.3,2X,'FSOFT=',E10.3,2X,'FSHARD=',E10.3/4x,
+     *  'FHARD=',3E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSFBORN(S,T,IQ1,IQ2)
+c PSFBORN - integrand for the Born cross-section (matrix element squared)
+c S - total c.m. energy squared for the scattering,
+c T - invariant variable for the scattering abs[(p1-p3)**2],
+c IQ1 - parton type at current end of the ladder (0 - g, 1,2 - q)
+c IQ2 - parton type at opposite end of the ladder (0 - g, 1,2 - q)
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)S,T,IQ1,IQ2
+201     FORMAT(2X,'PSFBORN - HARD SCATTERING MATRIX ELEMENT SQUARED:'/
+     *  4X,'S=',E10.3,2X,'|T|=',E10.3,2X,'IQ1=',I2,2X,'IQ2=',I2)
+        U=S-T
+        IF(IQ1.EQ.0.AND.IQ2.EQ.0)THEN
+c Gluon-gluon
+          PSFBORN=(3.D0-T*U/S**2+S*U/T**2+S*T/U**2)*4.5D0
+        ELSEIF(IQ1*IQ2.EQ.0)THEN
+c Gluon-quark
+          PSFBORN=(S**2+U**2)/T**2+(S/U+U/S)/2.25D0
+        ELSEIF(IQ1.EQ.IQ2)THEN
+c Quark-quark (of the same flavor)
+          PSFBORN=((S**2+U**2)/T**2+(S**2+T**2)/U**2)/2.25D0
+     *	  -S**2/T/U/3.375D0
+        ELSEIF(IQ1+IQ2.EQ.0)THEN
+c Quark-antiquark (of the same flavor)
+          PSFBORN=((S**2+U**2)/T**2+(U**2+T**2)/S**2)/2.25D0
+     *	  -U**2/T/S/3.375D0
+        ELSE
+c Quark-quark (different flavors)
+          PSFBORN=(S**2+U**2)/T**2/2.25D0
+        ENDIF
+        IF(DEBUG.GE.2)WRITE (MONIOU,202)PSFBORN
+202     FORMAT(2X,'PSFBORN=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSFSH(S,Z,ICZ,IQQ)
+c PSFSH - semihard interaction eikonal
+c S - energy squared for the interaction (hadron-hadron),
+c ICZ - type of the primaty hadron (nucleon)
+c Z - impact parameter factor, Z=exp(-b**2/Rp),
+c IQQ - type of the hard interaction (0 - gg, 1 - qg, 2 - gq)
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA6/  PI,BM,AM
+        COMMON /AREA15/ FP(5),RQ(5),CD(5)
+        COMMON /AREA17/ DEL,RS,RS0,FS,ALF,RR,SH,DELH
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA19/ AHL(5)
+        COMMON /AREA25/ AHV(5)
+        COMMON /AREA27/ FP0(5)
+        COMMON /AR3/    X1(7),A1(7)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)S,Z,IQQ,ICZ
+201     FORMAT(2X,'PSFSH - SEMIHARD INTERACTION EIKONAL:'/
+     *  4X,'S=',E10.3,2X,'Z=',E10.3,2X,'IQQ=',I1,2X,'ICZ=',I1)
+        XMIN=4.D0*QT0/S
+        XMIN=XMIN**(DELH-DEL)
+        PSFSH=0.D0
+        IF(IQQ.EQ.1)THEN
+          ICV=ICZ
+          ICQ=2
+        ELSEIF(IQQ.EQ.2)THEN
+          ICV=2
+          ICQ=ICZ
+        ENDIF
+        IQ=(IQQ+1)/2
+
+c Numerical integration over Z1
+        DO 3 I=1,7
+        DO 3 M=1,2
+        Z1=(.5D0*(1.D0+XMIN-(2*M-3)*X1(I)*(1.D0-XMIN)))**(1.D0/
+     *  (DELH-DEL))
+c SJ is the DLA inclusive hard partonic (gluon-gluon) interaction
+c cross-section (inclusive cut ladder cross section) for minimal
+c 4-momentum transfer squre QT0 and c.m. energy square s_hard = exp YJ;
+c SJB - Born cross-section
+        CALL PSJINT0(Z1*S,SJ,SJB,IQ,0)
+c GY= Sigma_hard_tot(YJ,QT0) - total hard partonic (gluon-gluon)
+c interaction cross-section for minimal 4-momentum transfer square QT0 and
+c c.m. energy square s_hard = exp YJ; SH=pi*R_hard**2 (R_hard**2=4/QT0)
+        GY=2.D0*SH*PSGINT((SJ-SJB)/SH*.5D0)+SJB
+        IF(DEBUG.GE.3)WRITE (MONIOU,203)Z1*S,GY
+203     FORMAT(2X,'PSFSH:',2X,'S_HARD=',E10.3,2X,'SIGMA_HARD=',E10.3)
+
+        IF(IQQ.EQ.0)THEN
+          ST2=0.D0
+          DO 1 J=1,7
+          DO 1 K=1,2
+          XX=.5D0*(1.D0+X1(J)*(2*K-3))
+1         ST2=ST2+A1(J)*PSFTILD(Z1**XX,ICZ)*
+     *    PSFTILD(Z1**(1.D0-XX),2)
+
+          RH=RS0-ALF*DLOG(Z1)
+          PSFSH=PSFSH-A1(I)*DLOG(Z1)*GY/Z1**DELH*Z**(RS/RH)/RH*ST2
+        ELSE
+
+          ST2=0.D0
+          DO 2 J=1,7
+          DO 2 K=1,2
+          XX=.5D0*(1.D0+X1(J)*(2*K-3))
+          XAM=Z1**(DEL+.5D0)
+          XA=(XAM+(1.D0-XAM)*XX)**(1.D0/(DEL+.5D0))
+          RH=RS0+ALF*DLOG(XA/Z1)
+2         ST2=ST2+A1(J)*(1.D0-XA)**AHV(ICV)*Z**(RS/RH)/RH*
+     *    PSFTILD(Z1/XA,ICQ)
+          ST2=ST2*(1.D0-XAM)
+
+          PSFSH=PSFSH+A1(I)*GY/Z1**DELH*ST2
+        ENDIF
+3       CONTINUE
+
+        IF(IQQ.EQ.0)THEN
+          PSFSH=PSFSH*.125D0*RR*(1.D0-XMIN)/(DELH-DEL)*FP0(ICZ)*FP0(2)
+     *    *CD(ICZ)
+        ELSE
+          PSFSH=PSFSH*DSQRT(RR)/16.D0*FP0(ICQ)*(1.D0-XMIN)/(DELH-DEL)/
+     *    (DEL+.5D0)*GAMFUN(AHV(ICV)+1.5D0)
+     *    /GAMFUN(AHV(ICV)+1.D0)/PI*CD(ICZ)
+          IF(ICZ.EQ.2.OR.IQQ.EQ.2)THEN
+            PSFSH=PSFSH*3.D0
+          ELSEIF((ICZ-1)*(ICZ-3)*(ICZ-5).EQ.0)THEN
+            PSFSH=PSFSH*2.D0
+          ENDIF
+        ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSFSH
+202     FORMAT(2X,'PSFSH=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSFTILD(Z,ICZ)
+c PSFTILD - auxilliary function for semihard eikonals calculation -
+c integration over semihard block light cone momentum share x
+c Z - x-cutoff from below,
+c ICZ - type of the hadron to which the semihard block is connected
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA17/ DEL,RS,RS0,FS,ALFP,RR,SH,DELH
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA19/ AHL(5)
+        COMMON /AR3/  X1(7),A1(7)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)Z,ICZ
+201     FORMAT(2X,'PSFTILD:',2X,'Z=',E10.3,2X,'ICZ=',I1)
+        PSFTILD=0.
+        DO 1 I=1,7
+        DO 1 M=1,2
+        XB=1.D0-(1.D0-Z)*(.5D0*(1.D0+(2*M-3)*X1(I)))**(1.D0/
+     *  (AHL(ICZ)+1.D0))
+1       PSFTILD=PSFTILD+A1(I)*XB**DEL*(1.D0-Z/XB)**BET
+        PSFTILD=PSFTILD*.5D0*(1.D0-Z)**(AHL(ICZ)+1.D0)/(AHL(ICZ)+1.D0)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSFTILD
+202     FORMAT(2X,'PSFTILD=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+      SUBROUTINE PSGEA(IA,XA,JJ)
+c PSGEA - nuclear configuration simulation (nucleons positions)
+c IA - number of nucleons to be considered
+c-----------------------------------------------------------------------
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      INTEGER DEBUG
+      DIMENSION XA(56,3)
+      COMMON /AREA5/  RD(2),CA1(2),CA2(2),CA3(2)
+      COMMON /AREA11/ B10
+      COMMON /AREA43/ MONIOU
+      COMMON /DEBUG/  DEBUG
+      SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)JJ,IA
+201     FORMAT(2X,'PSGEA - CONFIGURATION OF THE NUCLEUS ',I1,';',2X,
+     *  'COORDINATES FOR ',I2,' NUCLEONS')
+        IF(JJ.EQ.2.OR.IA.GE.10)THEN
+
+          DO 7 I=1,IA
+1         ZUK=PSRAN(B10)*CA1(JJ)-1.D0
+          IF(ZUK)2,2,3
+2         TT=RD(JJ)*(PSRAN(B10)**.3333D0-1.D0)
+          GOTO 6
+3         IF(ZUK.GT.CA2(JJ))GOTO 4
+          TT=-DLOG(PSRAN(B10))
+          GOTO 6
+4         IF(ZUK.GT.CA3(JJ))GOTO 5
+          TT=-DLOG(PSRAN(B10))-DLOG(PSRAN(B10))
+          GOTO 6
+5         TT=-DLOG(PSRAN(B10))-DLOG(PSRAN(B10))-DLOG(PSRAN(B10))
+6         IF(PSRAN(B10).GT.1.D0/(1.D0+EXP(-ABS(TT))))GOTO 1
+          RIM=TT+RD(JJ)
+          Z=RIM*(2.D0*PSRAN(B10)-1.D0)
+          RIM=DSQRT(RIM*RIM-Z*Z)
+          XA(I,3)=Z
+          CALL PSCS(C,S)
+          XA(I,1)=RIM*C
+7         XA(I,2)=RIM*S
+        ELSE
+
+          DO 9 L=1,3
+          SUMM=0.D0
+          DO 8 I=1,IA-1
+          J=IA-I
+          AKS=RD(JJ)*(PSRAN(B10)+PSRAN(B10)+PSRAN(B10)-1.5D0)
+          K=J+1
+          XA(K,L)=SUMM-AKS*SQRT(FLOAT(J)/K)
+8         SUMM=SUMM+AKS/SQRT(FLOAT(J*K))
+9         XA(1,L)=SUMM
+        ENDIF
+        IF(DEBUG.GE.3)THEN
+          WRITE (MONIOU,203)
+          DO 206 I=1,IA
+206       WRITE (MONIOU,204)I,(XA(I,L),L=1,3)
+          WRITE (MONIOU,202)
+        ENDIF
+202     FORMAT(2X,'PSGEA - END')
+203     FORMAT(2X,'PSGEA:  POSITIONS OF THE NUCLEONS')
+204     FORMAT(2X,'PSGEA: ',I2,' - ',3(E10.3,1X))
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSGINT(Z)
+c Auxiliary function for eikonal cross-sections calculation
+c GINT = int(dt) [0<t<Z] (1-exp(-t))/t
+c-----------------------------------------------------------------------
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      INTEGER DEBUG
+      COMMON /AR3/  X1(7),A1(7)
+      COMMON /AREA43/ MONIOU
+      COMMON /DEBUG/  DEBUG
+        F(Z,X)=(1.-EXP(-.5*Z*(1.+X)))/(1.+X)
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)Z
+201     FORMAT(2X,'PSGINT:',2X,'Z=',E10.3)
+        PSGINT=0.
+        DO 5 I=1,7
+5       PSGINT=PSGINT+A1(I)*(F(Z,X1(I))+F(Z,-X1(I)))
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSGINT
+202     FORMAT(2X,'PSGINT=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSHARD(S,ICZ)
+c PSHARD - hard quark-quark interaction cross-section
+c S - energy squared for the interaction (hadron-hadron),
+c ICZ - type of the primaty hadron (nucleon)
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AR3/    X1(7),A1(7)
+        COMMON /AREA6/  PI,BM,AM
+        COMMON /AREA15/ FP(5),RQ(5),CD(5)
+        COMMON /AREA17/ DEL,RS,RS0,FS,ALF,RR,SH,DELH
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA19/ AHL(5)
+        COMMON /AREA25/ AHV(5)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)S,ICZ
+201     FORMAT(2X,'PSHARD - HARD QUARK-QUARK INTERACTION CROSS',
+     *  ' SECTION:',
+     *  2X,'S=',E10.3,2X,'ICZ=',I1)
+        XMIN=4.D0*QT0/S
+        XMIN=XMIN**(DELH+.5D0)
+        PSHARD=0.D0
+
+c Numerical integration over Z1
+        DO 2 I=1,7
+        DO 2 M=1,2
+        Z1=(.5D0*(1.D0+XMIN-(2*M-3)*X1(I)*(1.D0-XMIN)))**(1.D0/
+     *  (DELH+.5D0))
+
+        ST2=0.D0
+        DO 1 J=1,7
+        DO 1 K=1,2
+        XX=.5D0*(1.D0+X1(J)*(2*K-3))
+        ST2=ST2+A1(J)*(1.D0-Z1**XX)**AHV(ICZ)*
+     *  (1.D0-Z1**(1.D0-XX))**AHV(2)
+1       CONTINUE
+
+c SJ is the DLA inclusive hard partonic (gluon-gluon) interaction
+c cross-section (inclusive cut ladder cross section) for minimal
+c 4-momentum transfer squre QT0 and c.m. energy square s_hard = exp YJ;
+c SJB - Born cross-section
+        CALL PSJINT0(Z1*S,SJ,SJB,1,1)
+c GY= Sigma_hard_tot(YJ,QT0) - total hard partonic (quark-quark)
+c interaction cross-section for minimal 4-momentum transfer square QT0 and
+c c.m. energy square s_hard = exp YJ; SH=pi*R_hard**2 (R_hard**2=4/QT0)
+        GY=2.D0*SH*PSGINT((SJ-SJB)/SH*.5D0)+SJB
+
+        IF(DEBUG.GE.3)WRITE (MONIOU,203)Z1*S,GY
+203     FORMAT(2X,'PSHARD:',2X,'S_HARD=',E10.3,2X,'SIGMA_HARD=',E10.3)
+        PSHARD=PSHARD-A1(I)*DLOG(Z1)*GY/Z1**DELH*ST2
+2       CONTINUE
+
+        PSHARD=PSHARD*(1.D0-XMIN)/(.5D0+DELH)*.25D0
+        PSHARD=PSHARD/(GAMFUN(AHV(ICZ)+1.D0)*GAMFUN(AHV(2)+1.D0)*PI)*
+     *  GAMFUN(AHV(ICZ)+1.5D0)*GAMFUN(AHV(2)+1.5D0)
+
+        IF(ICZ.EQ.2)THEN
+          PSHARD=PSHARD*9.D0
+        ELSEIF((ICZ-1)*(ICZ-3)*(ICZ-5).EQ.0)THEN
+          PSHARD=PSHARD*6.D0
+        ELSE
+          PSHARD=PSHARD*3.D0
+        ENDIF
+
+c Hard cross-section is divided by Regge radius RS0 and multiplied by
+c shower enhancement coefficient CD(ICZ) - to be used for the eikonal
+c calculation
+        PSHARD=PSHARD/(8.D0*PI*RS0)*CD(ICZ)
+        IF(DEBUG.GE.2)WRITE (MONIOU,202)PSHARD
+202     FORMAT(2X,'PSHARD=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE PSHOT(WP0,WM0,Z,IPC,EPC,IZP,IZT,ICZ,IQQ)
+c Semihard jets production simulation (resulted from parton-parton
+c interaction);
+c WP0,WM0 - light cone momenta shares (E+-P_l) for the initial partons
+c IZP, IZT - types for target and projectile nucleons (hadron)
+c WPQ - light cone momenta for the soft preevolution - to be determined below
+c IQQ - type of the hard interaction: 0 - gg, 1 - qg, 2 - gq, 3 - qq
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        CHARACTER*2 TYQ
+        DIMENSION EP(4,2),EPT(4),EPT0(4),EP3(4),EPJ(4),EPJ1(4),EY(3),
+     *  QMIN(2),WP(2),IQC(2),IQP(2),
+     *  IPC(2,2),EPC(8,2),IQJ(2),EQJ(4,2),IPQ(2,2),EPQ(8,2),
+     *  ebal(4),
+     *  QV1(30,50),ZV1(30,50),QM1(30,50),IQV1(2,30,50),
+     *  LDAU1(30,49),LPAR1(30,50),
+     *  QV2(30,50),ZV2(30,50),QM2(30,50),IQV2(2,30,50),
+     *  LDAU2(30,49),LPAR2(30,50)
+        COMMON /AREA6/  PI,BM,AMMM
+        COMMON /AREA8/  WWM,BE(4),DC(5),DETA,ALMPT
+        COMMON /AREA10/ STMASS,AM(7)
+        COMMON /AREA11/ B10
+        COMMON /AREA17/ DEL,RS,RS0,FS,ALF,RR,SH,DELH
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA42/ TYQ(15)
+        COMMON /AREA43/ MONIOU
+        COMMON /AREA46/ EPJET(4,2,1000),IPJET(2,1000)
+        COMMON /AREA47/ NJTOT
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.1)WRITE (MONIOU,201)IQQ,WP0,WM0
+201     FORMAT(2X,'PSHOT - SEMIHARD INTERACTION SIMULATION:'/
+     *  4X,'TYPE OF THE INTERACTION:',I2/
+     *  4X,'INITIAL LIGHT CONE MOMENTA:',2E10.3)
+c S - total energy squared for the semihard interaction (including preevolution)
+        NJTOT0=NJTOT
+        IZP0=IZP
+        IZT0=IZT
+        
+301     S=WP0*WM0
+        NJTOT=NJTOT0
+        IZP=IZP0
+        IZT=IZT0
+
+        IF(IQQ.EQ.3)THEN
+c WPI,WMI - light cone momenta for the hard interaction
+          WPI=WP0
+          WMI=WM0
+c PSJINT0(S,SJ,SJB,1,1) - cross-sections interpolation:
+c SJ - inclusive hard quark-quark interaction
+c cross-section (inclusive cut ladder cross section) for minimal
+c 4-momentum transfer square QT0 and c.m. energy square s_hard = S;
+c SJB - Born cross-section
+          CALL PSJINT0(S,SJ,SJB,1,1)
+c GY= Sigma_hard_tot(YJ,QT0) - total hard quark-quark
+c interaction cross-section for minimal 4-momentum transfer square QT0 and
+c c.m. energy square s_hard = S
+          GY=2.D0*SH*PSGINT((SJ-SJB)/SH*.5D0)+SJB
+
+        ELSE
+c-------------------------------------------------
+c Rejection function normalization
+c-------------------------------------------------
+c XMIN corresponds to minimal energy squared for the hard interaction - 4.D0*(QT0+AMJ0)
+c AMJ0 - jet mass squared (could be put equal zero)
+          XMIN=4.D0*(QT0+AMJ0)/S
+          XMIN1=XMIN**(DELH-DEL)
+c S - maximal available energy for the rejection function normalization
+c Auxilliary type of parton (1 - gluon, 2 - (anti-)quark)
+          IQ=(IQQ+1)/2
+c Rejection function initialization (corresponding to maximal preevolution - minimal x):
+c Ysoft = - ln x, (1-x)**bet is due to gluon structure function in the soft pomeron
+          IF(IQQ.EQ.0)THEN
+             GB0=-DLOG(XMIN)*(1.D0-DSQRT(XMIN))**(2.D0*BET)
+          ELSE
+             GB0=(1.D0-XMIN)**BET
+          ENDIF
+
+c SJ0 is the inclusive hard (parton IQ - gluon) interaction
+c cross-section (inclusive cut ladder cross section) for minimal
+c 4-momentum transfer square QT0 and c.m. energy square s_hard = SI;
+c SJB0 - Born cross-section
+          CALL PSJINT0(S,SJ,SJB,IQ,0)
+c GY= Sigma_hard_tot(YJ,QT0) - total hard  (parton IQ - gluon)
+c interaction cross-section for minimal 4-momentum transfer square QT0 and
+c c.m. energy square s_hard = SI
+          GY0=2.D0*SH*PSGINT((SJ-SJB)/SH*.5D0)+SJB
+          GB0=GB0*GY0/S**DELH/RS0*Z
+c-------------------------------------------------
+c End of rejection function normalization
+c-------------------------------------------------
+
+c-------------------------------------------------
+c The sharing of the light cone momenta between soft preevolution and
+c hard interaction:
+c ( first energy-momentum is shared according to
+c f_hard(YJ)~ZPM**(DELH-DEL-1) and then rejected as
+c W_rej ~Sigma_hard_tot(YJ) / exp(DELH*YJ)
+c ZPM = s_hard / S
+c YJ = ln s_hard - rapidity range for the hard parton-parton interaction;
+c-------------------------------------------------
+1         ZPM=(XMIN1+PSRAN(B10)*(1.D0-XMIN1))**(1.D0/(DELH-DEL))
+c SJ is the DLA inclusive hard partonic (gluon-gluon) interaction
+c cross-section (inclusive cut ladder cross section) for minimal
+c 4-momentum transfer square QT0 and c.m. energy square s_hard = exp YJ;
+c SJB - Born cross-section
+          CALL PSJINT0(ZPM*S,SJ,SJB,IQ,0)
+          YJ=DLOG(ZPM*S)
+c RH - interaction radius due to soft preevolution
+          RH=RS0-ALF*DLOG(ZPM)
+
+          IF(IQQ.EQ.0)THEN
+c XP, XM - light cone momunta shares for the hard interaction
+            XP=ZPM**PSRAN(B10)
+            XM=ZPM/XP
+c Ysoft = - ln ZPM - part of rejection function,
+c (1-XP)**bet*(1-XM)**bet is due to gluon structure function in the soft pomeron
+            GBYJ=-DLOG(ZPM)*((1.-XP)*(1.-XM))**BET
+c WPI,WMI - light cone momenta for the hard interaction
+            WPI=WP0*XP
+            WMI=WM0*XM
+          ELSE
+            IF(IQQ.EQ.1)THEN
+              WPI=WP0
+              WMI=WM0*ZPM
+            ELSE
+              WPI=WP0*ZPM
+              WMI=WM0
+            ENDIF
+            GBYJ=(1.D0-ZPM)**BET
+          ENDIF
+
+c GY= Sigma_hard_tot(YJ,QT0) - total hard partonic
+c interaction cross-section for minimal 4-momentum transfer square QT0 and
+c c.m. energy square s_hard = exp YJ
+          GY=2.D0*SH*PSGINT((SJ-SJB)/SH*.5D0)+SJB
+
+c-------------------------------------------------
+c GBYJ - rejection function for the YJ (ZPM) simulation:
+c GBYJ ~  Sigma_hard_tot(YJ,QT0) / exp(DELH*YJ) * exp(-b**2/RH) / RH,
+          GBYJ=GBYJ*GY*EXP(-DELH*YJ)/GB0*Z**(RS/RH)/RH
+          IF(PSRAN(B10).GT.GBYJ)GOTO 1
+        ENDIF
+c-------------------------------------------------
+        S=WPI*WMI
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,203)S
+203     FORMAT(2X,'PSHOT: MASS SQUARED FOR THE HARD PARTON-PARTON',
+     *  ' INTERACTION:',E10.3)
+
+c In case of valence quark hard interaction the type of quark is determined by the
+c procedure PSVDEF - flavor combinatorics (not good here); IQC(1) - flavor
+c for the upper quark (0 in case of gluon),
+c IQC(2) - the same for the lower one
+        DO 302 I=1,8
+        DO 302 M=1,2
+302     EPC(I,M)=0.D0
+
+        IF((IQQ-1)*(IQQ-3).EQ.0)THEN
+          CALL PSVDEF(IZP,IC1,ICZ)
+          IQC(1)=IC1
+          IPC(1,1)=0
+          IPC(2,1)=0
+        ELSE
+          IQC(1)=0
+          IPC(1,1)=-INT(2.D0*PSRAN(B10)+1.D0)
+          IPC(2,1)=-IPC(1,1)
+          WP1=WP0-WPI
+          WP2=WP1*PSRAN(B10)
+          WP1=WP1-WP2
+          EPC(1,1)=.5D0*WP1
+          EPC(2,1)=EPC(1,1)
+          EPC(5,1)=.5D0*WP2
+          EPC(6,1)=EPC(5,1)
+       	ENDIF
+       	
+        IF((IQQ-2)*(IQQ-3).EQ.0)THEN
+          CALL PSVDEF(IZT,IC1,2)
+          IQC(2)=IC1
+          IPC(1,2)=0
+          IPC(2,2)=0
+        ELSE
+          IQC(2)=0
+          IPC(1,2)=-INT(2.D0*PSRAN(B10)+1.D0)
+          IPC(2,2)=-IPC(1,2)
+          WM1=WM0-WMI
+          WM2=WM1*PSRAN(B10)
+          WM1=WM1-WM2
+          EPC(1,2)=.5D0*WM1
+          EPC(2,2)=-EPC(1,2)
+          EPC(5,2)=.5D0*WM2
+          EPC(6,2)=-EPC(5,2)
+        ENDIF
+
+        EPT(1)=.5D0*(WPI+WMI)
+        EPT(2)=.5D0*(WPI-WMI)
+        EPT(3)=0.D0
+        EPT(4)=0.D0
+c Minimal 4-momentum transfer squares above and below current ladder run
+        QMIN(1)=QT0
+        QMIN(2)=QT0
+        DO 303 L=1,2
+        DO 303 M=1,2
+      	IPQ(L,M)=IPC(L,M)
+        DO 303 I=1,4
+303     EPQ(I+4*(L-1),M)=EPC(I+4*(L-1),M)
+c Minimal 4-momentum transfer square for gluon-gluon (virtual) interaction
+          QMINN=MAX(QMIN(1),QMIN(2))
+          SI=PSNORM(EPT)
+	  
+5         CONTINUE
+c 4-momentum squared (c.m. energy square for gluon-gluon (virtual)
+c interaction)
+        IF(DEBUG.GE.2)WRITE (MONIOU,208)ILAD, SI,IQC,EPT
+208     FORMAT(2X,'PSHOT: ',I2,'-TH HARD LADDER;',
+     *  ' MASS SQUARED FOR THE LADDDER:',E10.3/
+     *  4X,'LADDER END FLAVORS:',2I3/4X,
+     *  'LADDER 4-MOMENTUM: ',4E10.3)
+
+        ebal(1)=.5*(wp0+wm0)-ept(1)
+        ebal(2)=.5*(wp0-wm0)-ept(2)
+        ebal(3)=0.d0-ept(3)
+        ebal(4)=0.d0-ept(4)
+        do 503 l=1,4
+        do 501 m=1,2
+        ebal(l)=ebal(l)-epq(l,m)
+501     if(iqc(m).eq.0)   ebal(l)=ebal(l)-epq(l+4,m)
+        if(njtot.ne.0)then
+           do 502 i=1,njtot
+           do 502 m=1,2
+502        ebal(l)=ebal(l)-epjet(l,m,i)
+        endif
+503        continue
+c            write (*,*)'ebal',ebal,si,njtot
+            
+          PT2=EPT(3)**2+EPT(4)**2
+          PT=DSQRT(PT2)
+          WW=SI+PT2
+          SWW=DSQRT(WW)
+          
+          IQP(1)=MIN(1,IABS(IQC(1)))
+          IQP(2)=MIN(1,IABS(IQC(2)))
+
+c Longitudinal momenta for the interaction
+          WP(1)=EPT(1)+EPT(2)
+          WP(2)=EPT(1)-EPT(2)
+
+          S2MIN=MAX(QMINN,4.D0*(QT0+AMJ0))
+c WWMIN is the minimal energy square needed for triple s-channel gluons
+c production with transverse momentum squares q_t**2 above QMIN(JJ),QMINN
+          WWMIN=(S2MIN+(PT-DSQRT(QT0))**2+(QT0+AMJ0)*(DSQRT(S2MIN/QT0)-
+     *	  1.D0))/(1.D0-DSQRT(QT0/S2MIN))
+c SJB/SJ is the probability for the last pair of gluons production
+c (SJB is the Born cross-section and SJ is the inclusive interaction
+c (cut ladder) cross-section)
+          SJ=PSJINT(QMIN(1),QMIN(2),SI,IQP(1)+1,IQP(2)+1)
+          SJB=PSBINT(QMINN,SI,IQP(1)+1,IQP(2)+1)
+          
+        IF(DEBUG.GE.2)WRITE (MONIOU,251)S2MIN,WWMIN,SJ,SJB
+251     FORMAT(2X,'PSHOT: KINEMATICAL BOUNDS S2MIN=',E10.3,
+     *   2X,'WWMIN=',E10.3/4X,'JET CROSS SETION SJ=',E10.3,
+     *   2X,'BORN CROSS SECTION SJB=',E10.3)
+     
+          IF(PSRAN(B10).LT.SJB/SJ.
+     *	  OR.WW.LT.1.2D0*WWMIN)GOTO 12
+
+          IF((SJ-SJB)/SJ.GT..1D0)THEN
+            SJ1=PSJINT1(QMIN(1),QMIN(2),SI,IQP(1)+1,IQP(2)+1)
+            SJ2=PSJINT1(QMIN(2),QMIN(1),SI,IQP(2)+1,IQP(1)+1)
+            DSJ=(SJ2-SJ1)/(SJ-SJB)*.5D0
+          ELSE
+            DSJ=0.D0
+          ENDIF
+c Current s-channel gluon is simulated either above the run (JJ=1) or
+c below it (JJ=2)
+          JJ=INT(1.5D0+DSJ+PSRAN(B10))
+
+          AQ=-(SI+AMJ0+2.D0*PT*DSQRT(QT0))/WW
+          BQ=(QT0+AMJ0)/WW
+          CQ=QT0/WW
+          PQ=-AQ**2/3.D0+BQ
+          QQ=AQ**3/13.5D0-AQ*BQ/3.D0+CQ
+          PQ=DSQRT(-PQ/3.D0)
+          COSQ=-.5D0*QQ/PQ**3
+          FQ=ATAN(1.D0/COSQ**2-1.D0)
+          IF(COSQ.LT.0.D0)FQ=PI-FQ
+          FQ=FQ/3.D0
+
+c XMIN is the minimal longitudinal momentum transfer share in current
+c ladder run (corresponding to minimal 4-momentum transfer square QMIN(JJ))
+          XMIN=1.D0+AQ/3.D0-2.D0*PQ*COS(FQ)
+          XMAX=1.D0+AQ/3.D0-PQ*(DSQRT(3.D0)*SIN(FQ)-COS(FQ))
+c QQMAX is the maximal 4-momentum transfer square in the current run
+c (corresponding to X=XMIN and 4-momentum transfer at next simulation
+c step to be equal QMAX)
+          QQMAX=QT0/(1.D0-XMAX)**2
+          QQMIN=QT0/(1.D0-XMIN)**2
+
+          IF(QQMIN.LT.S2MIN)THEN
+            XMM=(SI-S2MIN+AMJ0+2.D0*PT*DSQRT(QT0))/WW*.5D0
+            XMIN=1.D0-XMM-DSQRT(XMM*XMM-(QT0+AMJ0)/WW)
+            QQMIN=QT0/(1.D0-XMIN)**2
+
+            IF(QQMIN.LT.QMIN(JJ))THEN
+              QQMIN=QMIN(JJ)
+              XMM1=WW-2.D0*PT*DSQRT(QQMIN)+QQMIN
+              XMM=(SI-S2MIN+AMJ0)/XMM1*.5D0
+              XMIN=1.D0-XMM-DSQRT(XMM*XMM-AMJ0/XMM1)
+            ENDIF
+          ENDIF
+
+*********************************************************
+          XM0=MAX(.5D0,1.D0-DSQRT(QT0/QMIN(JJ)))
+          IF(XM0.GT..95D0*XMAX.OR.XM0.LT.1.05D0*XMIN)
+     *    XM0=.5D0*(XMAX+XMIN)
+          QM0=QT0/(1.D0-XM0)**2
+          S2MAX=XM0*WW
+
+          SJ0=PSJINT(QM0,QMIN(3-JJ),S2MAX,1,IQP(3-JJ)+1)*
+     *    PSFAP(XM0,IQP(JJ),0)+
+     *    PSJINT(QM0,QMIN(3-JJ),S2MAX,2,IQP(3-JJ)+1)
+     *    *PSFAP(XM0,IQP(JJ),1)
+
+          GB0=SJ0*QM0/QLOG*PSUDS(QM0,IQP(JJ))*1.5D0
+          IF(XM0.LE..5D0)THEN
+            GB0=GB0*XM0**(1.D0-DELH)
+          ELSE
+            GB0=GB0*(1.D0-XM0)*2.D0**DELH
+          ENDIF
+c XMIN, XMAX are put into power DELH to simulate X value below
+          XMIN2=MAX(.5D0,XMIN)
+          XMIN1=XMIN**DELH
+          XMAX1=MIN(XMAX,.5D0)**DELH
+          IF(XMIN.GE..5D0)THEN
+            DJL=1.D0 
+          ELSEIF(XMAX.LT..5D0)THEN
+            DJL=0.D0 
+          ELSE
+            DJL=1.D0/(1.D0+((2.D0*XMIN)**DELH-1.D0)/DELH/
+     *      DLOG(2.D0*(1.D0-XMAX)))
+          ENDIF
+
+7         CONTINUE
+c Simulation of the longitudinal momentum transfer share in current
+c ladder run - from XMIN to XMAX according to dX * X**(DELH-1)
+          IF(PSRAN(B10).GT.DJL)THEN
+            X=(XMIN1+PSRAN(B10)*(XMAX1-XMIN1))**(1.D0/DELH)
+          ELSE
+            X=1.D0-(1.D0-XMIN2)*((1.D0-XMAX)/(1.D0-XMIN2))**PSRAN(B10)
+          ENDIF
+*********************************************************
+
+c Effective momentum squared QQ in the ladder run is simulated
+c first as dq**2/q**4 from QMIN(J) to QMAX
+          QQ=QQMIN/(1.D0+PSRAN(B10)*(QQMIN/QQMAX-1.D0))
+	  
+        IF(DEBUG.GE.2)WRITE (MONIOU,253)QQ,QQMIN,QQMAX
+253     FORMAT(2X,'PSHOT: QQ=',E10.3,2X,'QQMIN=',E10.3,2X,
+     *  'QQMAX=',E10.3)
+
+          QT2=QQ*(1.D0-X)**2
+          IF(QT2.LT.QT0)GOTO 7
+
+          IF(QQ.GT.QMINN)THEN
+            QMIN2=QQ
+          ELSE
+            QMIN2=QMINN
+          ENDIF
+
+          QT=DSQRT(QT2)
+          CALL PSCS(CCOS,SSIN)
+c EP3 is now 4-vector for s-channel gluon produced in current ladder run
+          EP3(3)=QT*CCOS
+          EP3(4)=QT*SSIN
+          PT2=(EPT(3)-EP3(3))**2+(EPT(4)-EP3(4))**2
+          S2MIN2=MAX(S2MIN,QMIN2)
+
+          ZMIN=(QT2+AMJ0)/WW/(1.D0-X)
+c S2 is the maximal c.m. energy square for the parton-parton interaction
+c in the next ladder run
+          S2=X*(1.D0-ZMIN)*WW-PT2
+c Rejection in case of too low WW2 (insufficient for elastic gluon-gluon
+c scattering with transverse momentum square q_t**2 above QMIN2)
+          IF(S2.LT.S2MIN2)GOTO 7
+
+          SJ1=PSJINT(QQ,QMIN(3-JJ),S2,1,IQP(3-jj)+1)
+     *    *PSFAP(X,IQP(JJ),0)
+          SJ2=PSJINT(QQ,QMIN(3-JJ),S2,2,IQP(3-jj)+1)
+     *    *PSFAP(X,IQP(JJ),1)
+
+c GB7 is the rejection function for X and Q**2 simulation. It consists
+c from factor
+c Q**2/Qmin**2 * ln(Qmin**2/Lambda_qcd**2)/ln(Q**2/Lambda_qcd**2)
+c from Q**2 simulation and factor SJ/(X*WW)**DELH * const from X simulation
+          GB7=(SJ1+SJ2)/DLOG(QT2/ALM)*QQ*PSUDS(QQ,IQP(JJ))/GB0
+
+*********************************************************
+          IF(X.LE..5D0)THEN
+            GB7=GB7*X**(1.D0-DELH)
+          ELSE
+            GB7=GB7*(1.D0-X)*2.D0**DELH
+          ENDIF
+*********************************************************
+          IF(PSRAN(B10).GT.GB7)GOTO 7
+
+           IF(PSRAN(B10).LT.SJ1/(SJ1+SJ2))THEN
+             IF(IQC(JJ).EQ.0)THEN
+               JT=1
+               JQ=INT(1.5D0+PSRAN(B10))
+               IQJ(1)=IPQ(JQ,JJ)
+               IQJ(2)=0
+               DO 31 I=1,4
+               EQJ(I,1)=EPQ(I+4*(JQ-1),JJ)
+31            EQJ(I,2)=0.D0
+            ELSE
+              JT=2
+              IF(IQC(JJ).GT.0)THEN
+                JQ=1
+              ELSE
+                JQ=2
+              ENDIF
+              IQJ(1)=0
+              DO 32 I=1,4
+32            EQJ(I,1)=0.D0
+
+              IPQ(JQ,JJ)=IPQ(1,JJ)
+              DO 135 I=1,4
+135           EPQ(I+4*(JQ-1),JJ)=EPQ(I,JJ)
+            ENDIF
+            IQ1=IQC(JJ)
+            IQC(JJ)=0
+            
+          ELSE
+            IF(IQP(JJ).NE.0)THEN
+              IQ1=0
+              JT=3
+              IF(IQC(JJ).GT.0)THEN
+                JQ=1
+              ELSE
+                JQ=2
+              ENDIF
+              IQJ(1)=IPQ(1,JJ)
+              IQJ(2)=0
+              DO 33 I=1,4
+              EQJ(I,1)=EPQ(I,JJ)
+33            EQJ(I,2)=0.D0
+
+            ELSE
+              IQ1=INT(3.D0*PSRAN(B10)+1.D0)*(2*INT(.5D0+PSRAN(B10))-1)
+              IQC(JJ)=-IQ1
+              JT=4
+              IF(IQ1.GT.0)THEN
+                JQ=1
+              ELSE
+                JQ=2
+              ENDIF
+              IQJ(1)=IPQ(JQ,JJ)
+              DO 34 I=1,4
+34            EQJ(I,1)=EPQ(I+4*(JQ-1),JJ)
+            ENDIF
+          ENDIF
+          IF(DEBUG.GE.3)WRITE (MONIOU,240)JT
+
+          CALL PSCAJET(QT2,IQ1,QV1,ZV1,QM1,IQV1,
+     *	  LDAU1,LPAR1,JQ)
+          Z=(QT2+QM1(1,1))/WW/(1.D0-X)
+          SI=X*(1.D0-Z)*WW-PT2
+
+          IF(SI.GT.S2MIN2)THEN
+            IQ=MIN(1,IABS(IQC(JJ)))+1
+            GB=PSJINT(QQ,QMIN(3-JJ),SI,IQ,IQP(3-JJ)+1)/
+     *      PSJINT(QQ,QMIN(3-JJ),S2,IQ,IQP(3-JJ)+1)
+            IF(PSRAN(B10).GT.GB)GOTO 301
+          ELSE
+            GOTO 301
+          ENDIF
+
+          WP3=WP(JJ)*(1.D0-X)
+          WM3=(QT2+QM1(1,1))/WP3
+          EP3(1)=.5D0*(WP3+WM3)
+          EP3(2)=.5D0*(WP3-WM3)*(3-2*JJ)
+
+          PT3=DSQRT(EP3(3)**2+EP3(4)**2)
+
+          CALL PSREC(EP3,QV1,ZV1,QM1,IQV1,LDAU1,LPAR1,IQJ,EQJ,JFL,JQ)
+          IF(JFL.EQ.0)GOTO 301
+	  
+          IF(JT.EQ.1)THEN
+            IPQ(JQ,JJ)=IQJ(2)
+            DO 35 I=1,4
+35          EPQ(I+4*(JQ-1),JJ)=EQJ(I,2)
+
+            IF(IPC(JQ,JJ).EQ.0)THEN	  
+              IPC(JQ,JJ)=IQJ(1)
+              DO 36 I=1,4
+36            EPC(I+4*(JQ-1),JJ)=EQJ(I,1)
+            ENDIF
+
+          ELSEIF(JT.EQ.2)THEN
+            IPQ(3-JQ,JJ)=IQJ(1)
+            DO 37 I=1,4
+37          EPQ(I+4*(2-JQ),JJ)=EQJ(I,1)
+
+          ELSEIF(JT.EQ.3)THEN
+            IPQ(1,JJ)=IQJ(2)
+            DO 38 I=1,4
+38          EPQ(I,JJ)=EQJ(I,2)
+
+            IF(IPC(JQ,JJ).EQ.0)THEN	  
+              IPC(JQ,JJ)=IQJ(1)
+              DO 39 I=1,4
+39            EPC(I+4*(JQ-1),JJ)=EQJ(I,1)
+            ENDIF
+	    
+          ELSEIF(JT.EQ.4)THEN
+            IF(IPC(JQ,JJ).EQ.0)THEN	  
+               IPC(JQ,JJ)=IQJ(1)
+               DO 40 I=1,4
+40            EPC(I+4*(JQ-1),JJ)=EQJ(I,1)
+            ENDIF
+            IF(JQ.EQ.1)THEN	  
+              IPQ(1,JJ)=IPQ(2,JJ)
+              DO 30 I=1,4
+30            EPQ(I,JJ)=EPQ(I+4,JJ)
+            ENDIF
+          ENDIF
+	  
+          IF(IABS(IQ1).EQ.3)THEN
+            IQQQ=8+IQ1/3*4
+          ELSE
+            IQQQ=8+IQ1
+          ENDIF
+        IF(DEBUG.GE.2)WRITE (MONIOU,209)TYQ(IQQQ),QT2,EP3
+209     FORMAT(2X,'PSHOT: NEW JET FLAVOR:',A2,
+     *  ' PT SQUARED FOR THE JET:',E10.3/
+     *  4X,'JET 4-MOMENTUM:',4E10.3)
+          DO 8 I=1,4
+8         EPT(I)=EPT(I)-EP3(I)
+c C.m. energy square, minimal  4-momentum transfer square and gluon 4-vector
+c for the next ladder run
+          QMIN(JJ)=QQ
+          QMINN=QMIN2
+	  
+c Next simulation step will be considered for current ladder
+          GOTO 5
+C------------------------------------------------
+
+C------------------------------------------------
+c The last gluon pair production (elastic scattering) in the ladder
+c is simulated
+12        CONTINUE
+          IF(DEBUG.GE.2)WRITE (MONIOU,211)SI
+211     FORMAT(2X,'PSHOT: HIGHEST VIRTUALITY SUBPROCESS IN THE LADDER'/
+     *  4X,'MASS SQUARED FOR THE PROCESS:',E10.3)
+
+          XMIN=QMINN/(QMINN+SI)
+          XMIN1=.5D0-DSQRT(.25D0-(QT0+AMJ0)/SI)
+          XMIN=MAX(XMIN,XMIN1)
+          TMIN=SI*XMIN
+
+          IF(IQC(1).NE.0.OR.IQC(2).NE.0)THEN
+            GB0=TMIN**2/DLOG(TMIN*(1.D0-XMIN)/ALM)**2*
+     *      PSFBORN(SI,TMIN,IQC(1),IQC(2))
+          ELSE
+            GB0=.25D0*SI**2/DLOG(TMIN*(1.D0-XMIN)/ALM)**2*
+     *      PSFBORN(SI,.5D0*SI,IQC(1),IQC(2))
+          ENDIF
+
+C------------------------------------------------
+c 4-momentum transfer squared is simulated first as dq_t**2/q_t**4 from
+c tmin to s/2
+13        Q2=TMIN/(1.D0-PSRAN(B10)*(1.D0-2.D0*TMIN/SI))
+          Z=Q2/SI
+          QT2=Q2*(1.D0-Z)
+          IF(PSRAN(B10).LT..5D0)THEN
+            JM=2
+            TQ=SI-Q2
+          ELSE
+            JM=1
+            TQ=Q2
+          ENDIF
+
+          GB=Q2**2/DLOG(QT2/ALM)**2/GB0*
+     *    PSFBORN(SI,TQ,IQC(1),IQC(2))
+          IF(DEBUG.GE.3)WRITE (MONIOU,241)Q2,GB
+241     FORMAT(2X,'PSHOT: Q2=',E10.3,' GB=',E10.3)
+
+          IF(PSRAN(B10).GT.GB)GOTO 13
+
+          IF(IQC(1).EQ.0.AND.IQC(2).EQ.0)THEN
+            JQ=INT(1.5D0+PSRAN(B10))
+            IQJ(1)=IPQ(JQ,JM)
+            DO 51 I=1,4
+51          EQJ(I,1)=EPQ(I+4*(JQ-1),JM)
+
+            IF(PSRAN(B10).LT..5D0)THEN
+              JT=1
+              IF(IPQ(3-JQ,JM)*IPQ(JQ,3-JM).NE.0)THEN
+                IPJ=IPQ(3-JQ,JM)
+                IPJ1=IPQ(JQ,3-JM)
+                IF(IABS(IPJ).EQ.3)IPJ=IPJ*4/3
+                IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                DO 52 I=1,4
+                EPJ(I)=EPQ(I+4*(2-JQ),JM)
+52              EPJ1(I)=EPQ(I+4*(JQ-1),3-JM)
+                CALL PSJDEF(IPJ,IPJ1,EPJ,EPJ1,JFL)
+                IF(JFL.EQ.0)GOTO 301
+              ELSEIF(IPQ(3-JQ,JM).NE.0)THEN
+                IPC(JQ,3-JM)=IPQ(3-JQ,JM)
+                DO 53 I=1,4
+53   	        EPC(I+4*(JQ-1),3-JM)=EPQ(I+4*(2-JQ),JM)
+              ELSEIF(IPQ(JQ,3-JM).NE.0)THEN
+                IPC(3-JQ,JM)=IPQ(JQ,3-JM)
+                DO 54 I=1,4
+54              EPC(I+4*(2-JQ),JM)=EPQ(I+4*(JQ-1),3-JM)
+              ENDIF
+ 	      
+              IQJ(2)=0
+       	      DO 55 I=1,4
+55            EQJ(I,2)=0.D0
+ 	    
+            ELSE
+              JT=2
+              IQJ(2)=IPQ(3-JQ,3-JM)
+              DO 56 I=1,4
+56            EQJ(I,2)=EPQ(I+4*(2-JQ),3-JM)
+            ENDIF
+              
+          ELSEIF(IQC(1)*IQC(2).EQ.0)THEN
+            IF(IQC(1)+IQC(2).GT.0)THEN
+              JQ=1
+            ELSE
+              JQ=2
+            ENDIF
+
+            IF(PSRAN(B10).LT..5D0)THEN
+              IF(IQC(JM).EQ.0)THEN
+                JT=3
+                IQJ(1)=IPQ(JQ,JM)
+                IQJ(2)=0
+                DO 57 I=1,4
+                EQJ(I,1)=EPQ(I+4*(JQ-1),JM)
+57              EQJ(I,2)=0.D0
+
+                IF(IPQ(3-JQ,JM)*IPQ(1,3-JM).NE.0)THEN
+                  IPJ=IPQ(3-JQ,JM)
+                  IPJ1=IPQ(1,3-JM)
+                  IF(IABS(IPJ).EQ.3)IPJ=IPJ*4/3
+                  IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                  DO 58 I=1,4
+                  EPJ(I)=EPQ(I+4*(2-JQ),JM)
+58                EPJ1(I)=EPQ(I,3-JM)
+                  CALL PSJDEF(IPJ,IPJ1,EPJ,EPJ1,JFL)
+                  IF(JFL.EQ.0)GOTO 301
+                ELSEIF(IPQ(3-JQ,JM).NE.0)THEN
+                  IPC(JQ,3-JM)=IPQ(3-JQ,JM)
+                  DO 59 I=1,4
+59                EPC(I+4*(JQ-1),3-JM)=EPQ(I+4*(2-JQ),JM)
+                ELSEIF(IPQ(1,3-JM).NE.0)THEN
+                  IPC(3-JQ,JM)=IPQ(1,3-JM)
+                  DO 60 I=1,4
+60                EPC(I+4*(2-JQ),JM)=EPQ(I,3-JM)
+                ENDIF
+ 	      
+              ELSE
+                JT=4
+                IQJ(1)=0
+                DO 61 I=1,4
+61              EQJ(I,1)=0.D0
+
+                IF(IPQ(1,JM)*IPQ(3-JQ,3-JM).NE.0)THEN
+                  IPJ=IPQ(1,JM)
+                  IPJ1=IPQ(3-JQ,3-JM)
+                  IF(IABS(IPJ).EQ.3)IPJ=IPJ*4/3
+                  IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                  DO 62 I=1,4
+                  EPJ(I)=EPQ(I,JM)
+62                EPJ1(I)=EPQ(I+4*(2-JQ),3-JM)
+                  CALL PSJDEF(IPJ,IPJ1,EPJ,EPJ1,JFL)
+                  IF(JFL.EQ.0)GOTO 301
+                ELSEIF(IPQ(3-JQ,3-JM).NE.0)THEN
+                  IPC(JQ,JM)=IPQ(3-JQ,3-JM)
+                  DO 63 I=1,4
+63                EPC(I+4*(JQ-1),JM)=EPQ(I+4*(2-JQ),3-JM)
+                ELSEIF(IPQ(1,JM).NE.0)THEN
+                  IPC(3-JQ,3-JM)=IPQ(1,JM)
+                  DO 64 I=1,4
+64                EPC(I+4*(2-JQ),3-JM)=EPQ(I,JM)
+                ENDIF
+              ENDIF
+            
+            ELSE
+              IF(IQC(JM).EQ.0)THEN
+                JT=5
+                IQJ(2)=IPQ(3-JQ,JM)
+                IQJ(1)=IPQ(1,3-JM)
+                DO 65 I=1,4
+                EQJ(I,2)=EPQ(I+4*(2-JQ),JM)
+65              EQJ(I,1)=EPQ(I,3-JM)
+              ELSE
+                JT=6
+                IQJ(1)=IPQ(JQ,3-JM)
+                DO 66 I=1,4
+66              EQJ(I,1)=EPQ(I+4*(JQ-1),3-JM)
+              ENDIF
+            ENDIF
+
+          ELSEIF(IQC(1)*IQC(2).GT.0)THEN
+            JT=7
+            IF(IQC(1).GT.0)THEN
+              JQ=1
+            ELSE
+              JQ=2
+            ENDIF
+            IQJ(1)=IPQ(1,3-JM)
+            DO 67 I=1,4
+67          EQJ(I,1)=EPQ(I,3-JM)
+
+          ELSE
+            JT=8
+            IF(IQC(JM).GT.0)THEN
+              JQ=1
+            ELSE
+              JQ=2
+            ENDIF
+            IQJ(1)=0
+            DO 68 I=1,4
+68          EQJ(I,1)=0.D0
+
+            IF(IPQ(1,JM)*IPQ(1,3-JM).NE.0)THEN
+              IPJ=IPQ(1,JM)
+              IPJ1=IPQ(1,3-JM)
+              IF(IABS(IPJ).EQ.3)IPJ=IPJ*4/3
+              IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+              DO 69 I=1,4
+              EPJ(I)=EPQ(I,JM)
+69            EPJ1(I)=EPQ(I,3-JM)
+              CALL PSJDEF(IPJ,IPJ1,EPJ,EPJ1,JFL)
+              IF(JFL.EQ.0)GOTO 301
+            ELSEIF(IPQ(1,3-JM).NE.0)THEN
+              IPC(JQ,JM)=IPQ(1,3-JM)
+              DO 70 I=1,4
+70            EPC(I+4*(JQ-1),JM)=EPQ(I,3-JM)
+            ELSEIF(IPQ(1,JM).NE.0)THEN
+              IPC(3-JQ,3-JM)=IPQ(1,JM)
+              DO 71 I=1,4
+71            EPC(I+4*(2-JQ),3-JM)=EPQ(I,JM)
+            ENDIF
+          ENDIF
+          IF(JT.NE.8)THEN
+            JQ2=JQ
+          ELSE
+            JQ2=3-JQ
+          ENDIF
+          IF(DEBUG.GE.3)WRITE (MONIOU,240)JT
+240       FORMAT(2X,'PSHOT: COLOUR CONNECTION JT=:',I1)
+       	       	      
+          CALL PSCAJET(QT2,IQC(JM),QV1,ZV1,QM1,IQV1,
+     *    LDAU1,LPAR1,JQ)
+          CALL PSCAJET(QT2,IQC(3-JM),QV2,ZV2,QM2,IQV2,
+     *    LDAU2,LPAR2,JQ2)
+
+          AMT1=QT2+QM1(1,1)
+          AMT2=QT2+QM2(1,1)
+
+          IF(DSQRT(SI).GT.DSQRT(AMT1)+DSQRT(AMT2))THEN
+            Z=XXTWDEC(SI,AMT1,AMT2)
+          ELSE
+            GOTO 301
+          ENDIF
+
+          CALL PSDEFTR(SI,EPT,EY)
+
+          WP3=Z*DSQRT(SI)
+          WM3=(QT2+QM1(1,1))/WP3
+          EP3(1)=.5D0*(WP3+WM3)
+          EP3(2)=.5D0*(WP3-WM3)
+          QT=DSQRT(QT2)
+          CALL PSCS(CCOS,SSIN)
+c ep3 is now 4-vector for first s-channel gluon produced in the ladder run
+          EP3(3)=QT*CCOS
+          EP3(4)=QT*SSIN
+
+          CALL PSTRANS(EP3,EY)
+          PT3=DSQRT(EP3(3)**2+EP3(4)**2)
+
+          CALL PSREC(EP3,QV1,ZV1,QM1,IQV1,LDAU1,LPAR1,IQJ,EQJ,JFL,JQ)
+          IF(JFL.EQ.0)GOTO 301
+          
+          if(iabs(IQC(JM)).eq.3)then
+            iqqq=8+IQC(JM)/3*4
+          else
+            iqqq=8+IQC(JM)
+          endif
+          IF(DEBUG.GE.2)WRITE (MONIOU,209)TYQ(IQQQ),QT2
+
+          WP3=(1.D0-Z)*DSQRT(SI)
+          WM3=(QT2+QM2(1,1))/WP3
+          EP3(1)=.5D0*(WP3+WM3)
+          EP3(2)=.5D0*(WP3-WM3)
+          EP3(3)=-QT*CCOS
+          EP3(4)=-QT*SSIN
+          CALL PSTRANS(EP3,EY)
+          PT3=DSQRT(EP3(3)**2+EP3(4)**2)
+
+          IF(JT.EQ.1)THEN
+            IF(IPC(JQ,JM).EQ.0)THEN
+              IPC(JQ,JM)=IQJ(1)
+              DO 72 I=1,4
+72            EPC(I+4*(JQ-1),JM)=EQJ(I,1)
+            ENDIF
+            
+            IQJ(1)=IQJ(2)
+            IQJ(2)=IPQ(3-JQ,3-JM)
+            DO 73 I=1,4
+            EQJ(I,1)=EQJ(I,2)
+73          EQJ(I,2)=EPQ(I+4*(2-JQ),3-JM)
+
+          ELSEIF(JT.EQ.2)THEN
+            IF(IPC(JQ,JM).EQ.0)THEN
+              IPC(JQ,JM)=IQJ(1)
+              DO 74 I=1,4
+74            EPC(I+4*(JQ-1),JM)=EQJ(I,1)
+            ENDIF
+            IF(IPC(3-JQ,3-JM).EQ.0)THEN
+              IPC(3-JQ,3-JM)=IQJ(2)
+              DO 75 I=1,4
+75            EPC(I+4*(2-JQ),3-JM)=EQJ(I,2)
+            ENDIF
+            
+            IQJ(2)=IPQ(3-JQ,JM)
+            IQJ(1)=IPQ(JQ,3-JM)
+            DO 76 I=1,4
+            EQJ(I,2)=EPQ(I+4*(2-JQ),JM)
+76          EQJ(I,1)=EPQ(I+4*(JQ-1),3-JM)
+
+          ELSEIF(JT.EQ.3)THEN
+            IF(IPC(JQ,JM).EQ.0)THEN
+              IPC(JQ,JM)=IQJ(1)
+              DO 77 I=1,4
+77            EPC(I+4*(JQ-1),JM)=EQJ(I,1)
+            ENDIF
+            IQJ(1)=IQJ(2)
+            DO 78 I=1,4
+78          EQJ(I,1)= EQJ(I,2)
+
+          ELSEIF(JT.EQ.4)THEN
+            IQJ(2)=IQJ(1)
+            IQJ(1)=IPQ(JQ,3-JM)
+            DO 79 I=1,4
+            EQJ(I,2)=EQJ(I,1)
+79          EQJ(I,1)=EPQ(I+4*(JQ-1),3-JM)
+
+          ELSEIF(JT.EQ.5)THEN
+            IF(IPC(3-JQ,JM).EQ.0)THEN
+              IPC(3-JQ,JM)=IQJ(2)
+              DO 80 I=1,4
+80            EPC(I+4*(2-JQ),JM)=EQJ(I,2)
+            ENDIF
+            IF(IPC(JQ,3-JM).EQ.0)THEN
+              IPC(JQ,3-JM)=IQJ(1)
+              DO 81 I=1,4
+81            EPC(I+4*(JQ-1),3-JM)=EQJ(I,1)
+            ENDIF
+            
+            IQJ(1)=IPQ(JQ,JM)
+            DO 82 I=1,4
+82          EQJ(I,1)=EPQ(I+4*(JQ-1),JM)
+
+          ELSEIF(JT.EQ.6)THEN
+            IF(IPC(JQ,3-JM).EQ.0)THEN
+              IPC(JQ,3-JM)=IQJ(1)
+              DO 83 I=1,4
+83            EPC(I+4*(JQ-1),3-JM)=EQJ(I,1)
+            ENDIF
+            
+            IQJ(2)=IPQ(3-JQ,3-JM)
+            IQJ(1)=IPQ(1,JM)
+            DO 84 I=1,4
+            EQJ(I,2)=EPQ(I+4*(2-JQ),3-JM)
+84          EQJ(I,1)=EPQ(I,JM)
+
+          ELSEIF(JT.EQ.7)THEN
+            IF(IPC(JQ,3-JM).EQ.0)THEN
+              IPC(JQ,3-JM)=IQJ(1)
+              DO 85 I=1,4
+85            EPC(I+4*(JQ-1),3-JM)=EQJ(I,1)
+            ENDIF
+            IQJ(1)=IPQ(1,JM)
+            DO 86 I=1,4
+86          EQJ(I,1)= EPQ(I,JM)
+          ENDIF
+
+          CALL PSREC(EP3,QV2,ZV2,QM2,IQV2,LDAU2,LPAR2,IQJ,EQJ,JFL,JQ2)
+          IF(JFL.EQ.0)GOTO 301
+
+          if(iabs(IQC(3-JM)).eq.3)then
+            iqqq=8+IQC(3-JM)/3*4
+          else
+            iqqq=8+IQC(3-JM)
+          endif
+          IF(DEBUG.GE.2)WRITE (MONIOU,209)TYQ(IQQQ),QT2
+          IF(DEBUG.GE.2)WRITE (MONIOU,212)NJTOT
+212       FORMAT(2X,'PSHOT: TOTAL NUMBER OF JETS:',I2)
+
+          IF(JT.EQ.1)THEN
+            IF(IPC(3-JQ,3-JM).EQ.0)THEN
+              IPC(3-JQ,3-JM)=IQJ(2)
+              DO 87 I=1,4
+87            EPC(I+4*(2-JQ),3-JM)=EQJ(I,2)
+            ENDIF
+            
+          ELSEIF(JT.EQ.2)THEN
+            IF(IPC(3-JQ,JM).EQ.0)THEN
+              IPC(3-JQ,JM)=IQJ(2)
+              DO 88 I=1,4
+88            EPC(I+4*(2-JQ),JM)=EQJ(I,2)
+            ENDIF
+            IF(IPC(JQ,3-JM).EQ.0)THEN
+              IPC(JQ,3-JM)=IQJ(1)
+              DO 89 I=1,4
+89            EPC(I+4*(JQ-1),3-JM)=EQJ(I,1)
+            ENDIF
+
+          ELSEIF(JT.EQ.4)THEN
+            IF(IPC(JQ,3-JM).EQ.0)THEN
+              IPC(JQ,3-JM)=IQJ(1)
+              DO 90 I=1,4
+90            EPC(I+4*(JQ-1),3-JM)=EQJ(I,1)
+            ENDIF
+
+          ELSEIF(JT.EQ.5)THEN
+            IF(IPC(JQ,JM).EQ.0)THEN
+              IPC(JQ,JM)=IQJ(1)
+              DO 91 I=1,4
+91            EPC(I+4*(JQ-1),JM)=EQJ(I,1)
+            ENDIF
+
+          ELSEIF(JT.EQ.6)THEN
+            IF(IPC(3-JQ,3-JM).EQ.0)THEN
+              IPC(3-JQ,3-JM)=IQJ(2)
+              DO 92 I=1,4
+92            EPC(I+4*(2-JQ),3-JM)=EQJ(I,2)
+            ENDIF
+            IF(IPC(JQ,JM).EQ.0)THEN
+              IPC(JQ,JM)=IQJ(1)
+              DO 93 I=1,4
+93            EPC(I+4*(JQ-1),JM)=EQJ(I,1)
+            ENDIF
+
+          ELSEIF(JT.EQ.7)THEN
+            IF(IPC(JQ,JM).EQ.0)THEN
+              IPC(JQ,JM)=IQJ(1)
+              DO 94 I=1,4
+94            EPC(I+4*(JQ-1),JM)=EQJ(I,1)
+            ENDIF
+          ENDIF
+C------------------------------------------------
+
+        IF(DEBUG.GE.3)WRITE (MONIOU,217)
+217     FORMAT(2X,'PSHOT - END')
+        ebal(1)=.5*(wp0+wm0)
+        ebal(2)=.5*(wp0-wm0)
+        ebal(3)=0.d0
+        ebal(4)=0.d0
+        do 500 i=1,njtot
+        do 500 m=1,2
+        do 500 l=1,4
+500        ebal(l)=ebal(l)-epjet(l,m,i)
+c            write (*,*)'ebal',ebal
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE PSJDEF(IPJ,IPJ1,EPJ,EPJ1,JFL)
+c Procedure for jet hadronization - each gluon is
+c considered to be splitted into quark-antiquark pair and usual soft
+c strings are assumed to be formed between quark and antiquark
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EPJ(4),EPJ1(4),EPT(4)
+        COMMON /AREA10/ STMASS,AM(7)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        COMMON /AREA46/ EPJET(4,2,1000),IPJET(2,1000)
+        COMMON /AREA47/ NJTOT
+c        if(ipj*ipj1.gt.0.and.iabs(ipj).ne.3.and.iabs(ipj).le.4.
+c     *  and.iabs(ipj1).ne.3.and.iabs(ipj1).le.4.or.
+c     *  ipj*ipj1.lt.0.and.(iabs(ipj).eq.3.or.iabs(ipj).gt.4.
+c     *  or.iabs(ipj1).eq.3.or.iabs(ipj1).eq.4))then
+c      write (*,*)'ipj,ipj1',ipj,ipj1
+c           read (*,*)
+c        endif
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)IPJ,IPJ1,EPJ,EPJ1
+201     FORMAT(2X,'PSJDEF: PARTON FLAVORS',
+     *  ': IPJ=',I2,2X,'IPJ1=',I2/
+     *  4X,'PARTON 4-MOMENTA:',2X,4(E10.3,1X))
+        DO 1 I=1,4
+1       EPT(I)=EPJ(I)+EPJ1(I)
+
+c Invariant mass squared for the jet
+        WW=PSNORM(EPt)
+c Minimal mass squared for the jet
+        IF(IABS(IPJ).LE.2)THEN
+          AM1=AM(1)
+        ELSEIF(IABS(IPJ).EQ.4)THEN
+          AM1=AM(3)
+        ELSE
+          AM1=AM(2)
+        ENDIF
+        IF(IABS(IPJ1).LE.2)THEN
+          AM2=AM(1)
+        ELSEIF(IABS(IPJ1).EQ.4)THEN
+          AM2=AM(3)
+        ELSE
+          AM2=AM(2)
+        ENDIF
+        AMJ=(AM1+AM2)**2
+        
+        IF(AMJ.GT.WW)THEN
+          JFL=0
+          RETURN
+        ELSE
+          JFL=1
+        ENDIF
+        
+        NJTOT=NJTOT+1        
+        IPJET(1,NJTOT)=IPJ
+        IPJET(2,NJTOT)=IPJ1
+        DO 2 I=1,4
+        EPJET(I,1,NJTOT)=EPJ(I)
+2       EPJET(I,2,NJTOT)=EPJ1(I)
+        
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'PSJDEF - END')
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSJET(Q1,Q2,S,S2MIN,J,L)
+C PSJET - inclusive hard cross-section calculation (one more run is added
+c to the ladder) - for any ordering
+c Q1 - effective momentum cutoff for current end of the ladder,
+c Q2 - effective momentum cutoff for opposide end of the ladder,
+c S - total c.m. energy squared for the ladder,
+c S2MIN - minimal c.m. energy squared for BORN process (above Q1 and Q2)
+c J - parton type at current end of the ladder (0 - g, 1 - q)
+c L - parton type at opposite end of the ladder (1 - g, 2 - q)
+C-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA6/  PI,BM,AM
+        COMMON /AREA17/ DEL,RS,RS0,FS,ALF,RR,SH,DELH
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON/AR3/X1(7),A1(7)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)S,Q1,Q2,S2MIN,J,L
+201     FORMAT(2X,'PSJET - UNORDERED LADDER CROSS SECTION:'/
+     *  4X,'S=',E10.3,2X,'Q1=',E10.3,2X,'Q2=',E10.3,2X,'S2MIN=',
+     *  E10.3,2X,'J=',I1,2X,'L=',I1)
+        PSJET=0.D0
+
+        P=DSQRT(1.D0-3.D0*QT0/S)
+        COSF=(1.D0-18.D0*QT0/S)/P**3
+        FI=ATAN(1.D0/COSF**2-1.D0)
+        IF(COSF.LT.0.D0)FI=PI-FI
+        FI=FI/3.D0
+        ZMAX=(2.D0-P*(DSQRT(3.D0)*SIN(FI)-COS(FI)))/3.D0
+        ZMIN=(1.D0-P*COS(FI))/1.5D0
+
+        IF(QT0/(1.D0-ZMIN)**2.LT.S2MIN)
+     *  ZMIN=.5D0*(1.D0+S2MIN/S-DSQRT((1.D0-S2MIN/S)**2-4.D0*QT0/S))
+
+***********************************************************
+        IF(1.D0-ZMIN.LT.DSQRT(QT0/Q1))THEN
+          QMIN=QT0/(1.D0-ZMIN)**2
+        ELSE
+          QMIN=Q1
+        ENDIF
+
+        QMAX=QT0/(1.D0-ZMAX)**2
+        SUD0=PSUDS(QMIN,J)
+***********************************************************
+
+        IF(DEBUG.GE.3)WRITE (MONIOU,203)QMIN,QMAX
+203     FORMAT(2X,'PSJET:',2X,'QMIN=',E10.3,2X,'QMAX=',E10.3)
+        IF(QMAX.GT.QMIN)THEN
+
+c Numerical integration over transverse momentum square;
+c Gaussian integration is used
+          DO 3 I=1,7
+          DO 3 M=1,2
+          QI=2.D0*QMIN/(1.D0+QMIN/QMAX+(2*M-3)*X1(I)*(1.D0-QMIN/QMAX))
+
+          ZMAX=(1.D0-DSQRT(QT0/QI))**DELH
+          ZMIN=((QI+MAX(QI,S2MIN))/(QI+S))**DELH
+
+          FSJ=0.D0
+
+        IF(DEBUG.GE.3)WRITE (MONIOU,204)QI,ZMIN,ZMAX
+204     FORMAT(2X,'PSJET:',2X,'QI=',E10.3,2X,'ZMIN=',E10.3,2X,
+     *  'ZMAX=',E10.3)
+          IF(ZMAX.GT.ZMIN)THEN
+            DO 2 I1=1,7
+            DO 2 M1=1,2
+            Z=(.5D0*(ZMAX+ZMIN+(2*M1-3)*X1(I1)*(ZMAX-ZMIN)))**
+     *      (1.D0/DELH)
+            QT=QI*(1.D0-Z)**2
+            S2=Z*S-QI*(1.D0-Z)
+
+            SJ=0.D0
+            DO 1 K=1,2
+1           SJ=SJ+PSJINT(QI,Q2,S2,K,L)*PSFAP(Z,J,K-1)*Z
+2           FSJ=FSJ+A1(I1)*SJ/DLOG(QT/ALM)/Z**DELH
+            FSJ=FSJ*(ZMAX-ZMIN)
+          ENDIF
+
+3         PSJET=PSJET+A1(I)*FSJ*QI*PSUDS(QI,J)
+          PSJET=PSJET*(1.D0/QMIN-1.D0/QMAX)/SUD0/DELH/18.D0
+        ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSJET
+202     FORMAT(2X,'PSJET=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSJET1(Q1,Q2,S,S2MIN,J,L)
+C PSJET1 - inclusive hard cross-section calculation (one more run is added
+c to the ladder) - for strict ordering
+c Q1 - effective momentum cutoff for current end of the ladder,
+c Q2 - effective momentum cutoff for opposide end of the ladder,
+c S - total c.m. energy squared for the ladder,
+c S2MIN - minimal c.m. energy squared for BORN process (above Q1 and Q2)
+c J - parton type at current end of the ladder (0 - g, 1 - q)
+c L - parton type at opposite end of the ladder (1 - g, 2 - q)
+C-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA6/  PI,BM,AM
+        COMMON /AREA17/ DEL,RS,RS0,FS,ALF,RR,SH,DELH
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON/AR3/X1(7),A1(7)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)S,Q1,Q2,S2MIN,J,L
+201     FORMAT(2X,'PSJET1 - STRICTLY ORDERED LADDER CROSS SECTION:'/
+     *  4X,'S=',E10.3,2X,'Q1=',E10.3,2X,'Q2=',E10.3,2X,'S2MIN=',
+     *  E10.3,2X,'J=',I1,2X,'L=',I1)
+        PSJET1=0.D0
+
+        P=DSQRT(1.D0-3.D0*QT0/S)
+        COSF=(1.D0-18.D0*QT0/S)/P**3
+        FI=ATAN(1.D0/COSF**2-1.D0)
+        IF(COSF.LT.0.D0)FI=PI-FI
+        FI=FI/3.D0
+        ZMAX=(2.D0-P*(DSQRT(3.D0)*SIN(FI)-COS(FI)))/3.D0
+        ZMIN=(1.D0-P*COS(FI))/1.5D0
+
+        IF(QT0/(1.D0-ZMIN)**2.LT.S2MIN)
+     *  ZMIN=.5D0*(1.D0+S2MIN/S-DSQRT((1.D0-S2MIN/S)**2-4.D0*QT0/S))
+
+***********************************************************
+        IF(1.D0-ZMIN.LT.DSQRT(QT0/Q1))THEN
+          QMIN=QT0/(1.D0-ZMIN)**2
+        ELSE
+          QMIN=Q1
+        ENDIF
+
+        QMAX=QT0/(1.D0-ZMAX)**2
+        SUD0=PSUDS(QMIN,J)
+***********************************************************
+
+        IF(DEBUG.GE.3)WRITE (MONIOU,203)QMIN,QMAX
+203     FORMAT(2X,'PSJET1:',2X,'QMIN=',E10.3,2X,'QMAX=',E10.3)
+        IF(QMAX.GT.QMIN)THEN
+
+c Numerical integration over transverse momentum square;
+c Gaussian integration is used
+          DO 3 I=1,7
+          DO 3 M=1,2
+          QI=2.D0*QMIN/(1.D0+QMIN/QMAX+(2*M-3)*X1(I)*(1.D0-QMIN/QMAX))
+
+          ZMAX=(1.D0-DSQRT(QT0/QI))**DELH
+          ZMIN=((QI+MAX(QI,S2MIN))/(QI+S))**DELH
+
+          FSJ=0.D0
+
+        IF(DEBUG.GE.3)WRITE (MONIOU,204)QI,ZMIN,ZMAX
+204     FORMAT(2X,'PSJET1:',2X,'QI=',E10.3,2X,'ZMIN=',E10.3,2X,
+     *  'ZMAX=',E10.3)
+          IF(ZMAX.GT.ZMIN)THEN
+            DO 2 I1=1,7
+            DO 2 M1=1,2
+            Z=(.5D0*(ZMAX+ZMIN+(2*M1-3)*X1(I1)*(ZMAX-ZMIN)))**
+     *      (1.D0/DELH)
+            QT=QI*(1.D0-Z)**2
+            S2=Z*S-QI*(1.D0-Z)
+
+            SJ=0.D0
+            DO 1 K=1,2
+1           SJ=SJ+PSJINT1(QI,Q2,S2,K,L)*PSFAP(Z,J,K-1)*Z
+
+2           FSJ=FSJ+A1(I1)*SJ/DLOG(QT/ALM)/Z**DELH
+            FSJ=FSJ*(ZMAX-ZMIN)
+          ENDIF
+
+3         PSJET1=PSJET1+A1(I)*FSJ*QI*PSUDS(QI,J)
+          PSJET1=PSJET1*(1.D0/QMIN-1.D0/QMAX)/SUD0/DELH/18.D0
+        ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSJET1
+202     FORMAT(2X,'PSJET1=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSJINT(Q1,Q2,S,M,L)
+C PSJINT - inclusive hard cross-section interpolation - for any ordering
+c in the ladder
+c Q1 - effective momentum cutoff for current end of the ladder,
+c Q2 - effective momentum cutoff for opposide end of the ladder,
+c S - total c.m. energy squared for the ladder,
+c M - parton type at current end of the ladder (1 - g, 2 - q)
+c L - parton type at opposite end of the ladder (1 - g, 2 - q)
+C-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION WI(3),WJ(3),WK(3)
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA29/ CSJ(17,17,68)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)S,Q1,Q2,M,L
+201     FORMAT(2X,'PSJINT - UNORDERED LADDER CROSS SECTION INTERPOL.:'/
+     *  4X,'S=',E10.3,2X,'Q1=',E10.3,2X,'Q2=',E10.3,2X,
+     *  2X,'M=',I1,2X,'L=',I1)
+        PSJINT=0.D0
+        QQ=MAX(Q1,Q2)
+      IF(S.LE.MAX(4.D0*QT0,QQ))THEN
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSJINT
+202     FORMAT(2X,'PSJINT=',E10.3)
+        RETURN
+      ENDIF
+
+        ML=17*(M-1)+34*(L-1)
+        QLI=DLOG(Q1/QT0)/1.38629D0
+        QLJ=DLOG(Q2/QT0)/1.38629D0
+        SL=DLOG(S/QT0)/1.38629D0
+        SQL=SL-MAX(QLI,QLJ)
+        I=INT(QLI)
+        J=INT(QLJ)
+        K=INT(SL)
+        IF(I.GT.13)I=13
+        IF(J.GT.13)J=13
+        
+        IF(SQL.GT.10.D0)THEN
+          IF(K.GT.14)K=14
+          IF(I.GT.K-3)I=K-3
+          IF(J.GT.K-3)J=K-3
+          WI(2)=QLI-I
+          WI(3)=WI(2)*(WI(2)-1.D0)*.5D0
+          WI(1)=1.D0-WI(2)+WI(3)
+          WI(2)=WI(2)-2.D0*WI(3)
+          WJ(2)=QLJ-J
+          WJ(3)=WJ(2)*(WJ(2)-1.D0)*.5D0
+          WJ(1)=1.D0-WJ(2)+WJ(3)
+          WJ(2)=WJ(2)-2.D0*WJ(3)
+          WK(2)=SL-K
+          WK(3)=WK(2)*(WK(2)-1.D0)*.5D0
+          WK(1)=1.D0-WK(2)+WK(3)
+          WK(2)=WK(2)-2.D0*WK(3)
+        
+          DO 1 I1=1,3
+          DO 1 J1=1,3
+          DO 1 K1=1,3
+1         PSJINT=PSJINT+CSJ(I+I1,J+J1,K+K1+ML)*WI(I1)*WJ(J1)*WK(K1)
+          PSJINT=EXP(PSJINT)
+        ELSEIF(SQL.LT.1.D0.AND.I+J.NE.0)THEN
+          SQ=(S/MAX(Q1,Q2)-1.D0)/3.D0
+          WI(2)=QLI-I
+          WI(3)=WI(2)*(WI(2)-1.D0)*.5D0
+          WI(1)=1.D0-WI(2)+WI(3)
+          WI(2)=WI(2)-2.D0*WI(3)
+          WJ(2)=QLJ-J
+          WJ(3)=WJ(2)*(WJ(2)-1.D0)*.5D0
+          WJ(1)=1.D0-WJ(2)+WJ(3)
+          WJ(2)=WJ(2)-2.D0*WJ(3)
+
+          DO 2 I1=1,3
+          I2=I+I1
+          DO 2 J1=1,3
+          J2=J+J1
+          K2=MAX(I2,J2)+1+ML
+2         PSJINT=PSJINT+CSJ(I2,J2,K2)*WI(I1)*WJ(J1)
+          PSJINT=EXP(PSJINT)*SQ
+        ELSEIF(K.EQ.1)THEN
+          SQ=(S/QT0/4.D0-1.D0)/3.D0
+          WI(2)=QLI
+          WI(1)=1.D0-QLI
+          WJ(2)=QLJ
+          WJ(1)=1.D0-QLJ
+
+          DO 3 I1=1,2
+          DO 3 J1=1,2
+3         PSJINT=PSJINT+CSJ(I1,J1,3+ML)*WI(I1)*WJ(J1)
+          PSJINT=EXP(PSJINT)*SQ
+        ELSEIF(K.LT.15)THEN
+          KL=INT(SQL)
+          IF(I+KL.GT.12)I=12-KL
+          IF(J+KL.GT.12)J=12-KL
+          IF(I+J+KL.EQ.1)KL=2
+          WI(2)=QLI-I
+          WI(3)=WI(2)*(WI(2)-1.D0)*.5D0
+          WI(1)=1.D0-WI(2)+WI(3)
+          WI(2)=WI(2)-2.D0*WI(3)
+          WJ(2)=QLJ-J
+          WJ(3)=WJ(2)*(WJ(2)-1.D0)*.5D0
+          WJ(1)=1.D0-WJ(2)+WJ(3)
+          WJ(2)=WJ(2)-2.D0*WJ(3)
+          WK(2)=SQL-KL
+          WK(3)=WK(2)*(WK(2)-1.D0)*.5D0
+          WK(1)=1.D0-WK(2)+WK(3)
+          WK(2)=WK(2)-2.D0*WK(3)
+        
+          DO 4 I1=1,3
+          I2=I+I1
+          DO 4 J1=1,3
+          J2=J+J1
+          DO 4 K1=1,3
+          K2=MAX(I2,J2)+KL+K1-1+ML
+4         PSJINT=PSJINT+CSJ(I2,J2,K2)*WI(I1)*WJ(J1)*WK(K1)
+          PSJINT=EXP(PSJINT)
+        ELSE
+          K=15
+          IF(I.GT.K-3)I=K-3
+          IF(J.GT.K-3)J=K-3
+          WI(2)=QLI-I
+          WI(3)=WI(2)*(WI(2)-1.D0)*.5D0
+          WI(1)=1.D0-WI(2)+WI(3)
+          WI(2)=WI(2)-2.D0*WI(3)
+          WJ(2)=QLJ-J
+          WJ(3)=WJ(2)*(WJ(2)-1.D0)*.5D0
+          WJ(1)=1.D0-WJ(2)+WJ(3)
+          WJ(2)=WJ(2)-2.D0*WJ(3)
+          WK(2)=SL-K
+          WK(1)=1.D0-WK(2)
+        
+          DO 5 I1=1,3
+          DO 5 J1=1,3
+          DO 5 K1=1,2
+5         PSJINT=PSJINT+CSJ(I+I1,J+J1,K+K1+ML)*WI(I1)*WJ(J1)*WK(K1)
+          PSJINT=EXP(PSJINT)
+        ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSJINT
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE PSJINT0(S,SJ,SJB,M,L)
+C PSJINT0 - inclusive hard cross-section interpolation - for minimal
+c effective momentum cutoff in the ladder
+c S - total c.m. energy squared for the ladder,
+c SJ - inclusive jet cross-section,
+c SJB - Born cross-section,
+c M - parton type at current end of the ladder (0 - g, 1 - q)
+c L - parton type at opposite end of the ladder (0 - g, 1 - q)
+C-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION WK(3)
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA32/ CSJ(17,2,2),CSB(17,2,2)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)S,M,L
+201     FORMAT(2X,'PSJINT0 - HARD CROSS SECTION INTERPOLATION:'/
+     *  4X,'S=',E10.3,2X,'M=',I1,2X,'L=',I1)
+        SJ=0.D0
+        SJB=0.D0
+      IF(S.LE.4.D0*QT0)THEN
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)SJ,SJB
+202     FORMAT(2X,'PSJINT0: SJ=',E10.3,2X,'SJB=',E10.3)
+        RETURN
+      ENDIF
+
+        SL=DLOG(S/QT0)/1.38629d0
+        K=INT(SL)
+        IF(K.EQ.1)THEN
+          SQ=(S/QT0/4.D0-1.D0)/3.D0
+          SJB=EXP(CSB(3,M+1,L+1))*SQ
+          SJ=EXP(CSJ(3,M+1,L+1))*SQ
+        ELSE
+          IF(K.GT.14)K=14
+          WK(2)=SL-K
+          WK(3)=WK(2)*(WK(2)-1.D0)*.5D0
+          WK(1)=1.D0-WK(2)+WK(3)
+          WK(2)=WK(2)-2.D0*WK(3)
+
+          DO 1 K1=1,3
+          SJ=SJ+CSJ(K+K1,M+1,L+1)*WK(K1)
+1         SJB=SJB+CSB(K+K1,M+1,L+1)*WK(K1)
+          SJB=EXP(SJB)
+          SJ=EXP(SJ)
+        ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)SJ,SJB
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSJINT1(Q1,Q2,S,M,L)
+C PSJINT1 - inclusive hard cross-section interpolation - for strict ordering
+c in the ladder
+c Q1 - effective momentum cutoff for current end of the ladder,
+c Q2 - effective momentum cutoff for opposide end of the ladder,
+c S - total c.m. energy squared for the ladder,
+c M - parton type at current end of the ladder (1 - g, 2 - q)
+c L - parton type at opposite end of the ladder (1 - g, 2 - q)
+C-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION WI(3),WJ(3),WK(3)
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA30/ CSJ(17,17,68)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)S,Q1,Q2,M,L
+201     FORMAT(2X,'PSJINT1 - STRICTLY ORDERED LADDER CROSS SECTION',
+     *  ' INTERPOLATION:'/
+     *  4X,'S=',E10.3,2X,'Q1=',E10.3,2X,'Q2=',E10.3,2X,
+     *  4X,'M=',I1,2X,'L=',I1)
+        PSJINT1=0.D0
+        QQ=MAX(Q1,Q2)
+      IF(S.LE.MAX(4.D0*QT0,QQ))THEN
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSJINT1
+202     FORMAT(2X,'PSJINT1=',E10.3)
+        RETURN
+      ENDIF
+
+        ML=17*(M-1)+34*(L-1)
+        QLI=DLOG(Q1/QT0)/1.38629d0
+        QLJ=DLOG(Q2/QT0)/1.38629d0
+        SL=DLOG(S/QT0)/1.38629d0
+        SQL=SL-MAX(QLI,QLJ)
+        I=INT(QLI)
+        J=INT(QLJ)
+        K=INT(SL)
+        IF(I.GT.13)I=13
+        IF(J.GT.13)J=13
+        
+        IF(SQL.GT.10.D0)THEN
+          IF(K.GT.14)K=14
+          IF(I.GT.K-3)I=K-3
+          IF(J.GT.K-3)J=K-3
+          WI(2)=QLI-I
+          WI(3)=WI(2)*(WI(2)-1.D0)*.5D0
+          WI(1)=1.D0-WI(2)+WI(3)
+          WI(2)=WI(2)-2.D0*WI(3)
+          WJ(2)=QLJ-J
+          WJ(3)=WJ(2)*(WJ(2)-1.D0)*.5D0
+          WJ(1)=1.D0-WJ(2)+WJ(3)
+          WJ(2)=WJ(2)-2.D0*WJ(3)
+          WK(2)=SL-K
+          WK(3)=WK(2)*(WK(2)-1.D0)*.5D0
+          WK(1)=1.D0-WK(2)+WK(3)
+          WK(2)=WK(2)-2.D0*WK(3)
+        
+          DO 1 I1=1,3
+          DO 1 J1=1,3
+          DO 1 K1=1,3
+1         PSJINT1=PSJINT1+CSJ(I+I1,J+J1,K+K1+ML)*WI(I1)*WJ(J1)*WK(K1)
+          PSJINT1=EXP(PSJINT1)
+        ELSEIF(SQL.LT.1.D0.AND.I+J.NE.0)THEN
+          SQ=(S/MAX(Q1,Q2)-1.D0)/3.D0
+          WI(2)=QLI-I
+          WI(3)=WI(2)*(WI(2)-1.D0)*.5D0
+          WI(1)=1.D0-WI(2)+WI(3)
+          WI(2)=WI(2)-2.D0*WI(3)
+          WJ(2)=QLJ-J
+          WJ(3)=WJ(2)*(WJ(2)-1.D0)*.5D0
+          WJ(1)=1.D0-WJ(2)+WJ(3)
+          WJ(2)=WJ(2)-2.D0*WJ(3)
+        
+          DO 2 I1=1,3
+          I2=I+I1
+          DO 2 J1=1,3
+          J2=J+J1
+          K2=MAX(I2,J2)+1+ML
+2         PSJINT1=PSJINT1+CSJ(I2,J2,K2)*WI(I1)*WJ(J1)
+          PSJINT1=EXP(PSJINT1)*SQ
+        ELSEIF(K.EQ.1)THEN
+          SQ=(S/QT0/4.D0-1.D0)/3.D0
+          WI(2)=QLI
+          WI(1)=1.D0-QLI
+          WJ(2)=QLJ
+          WJ(1)=1.D0-QLJ
+
+          DO 3 I1=1,2
+          DO 3 J1=1,2
+3         PSJINT1=PSJINT1+CSJ(I1,J1,3+ML)*WI(I1)*WJ(J1)
+          PSJINT1=EXP(PSJINT1)*SQ
+        ELSEIF(K.LT.15)THEN
+          KL=INT(SQL)
+          IF(I+KL.GT.12)I=12-KL
+          IF(J+KL.GT.12)J=12-KL
+          IF(I+J+KL.EQ.1)KL=2
+        
+          WI(2)=QLI-I
+          WI(3)=WI(2)*(WI(2)-1.D0)*.5D0
+          WI(1)=1.D0-WI(2)+WI(3)
+          WI(2)=WI(2)-2.D0*WI(3)
+          WJ(2)=QLJ-J
+          WJ(3)=WJ(2)*(WJ(2)-1.D0)*.5D0
+          WJ(1)=1.D0-WJ(2)+WJ(3)
+          WJ(2)=WJ(2)-2.D0*WJ(3)
+          WK(2)=SQL-KL
+          WK(3)=WK(2)*(WK(2)-1.D0)*.5D0
+          WK(1)=1.D0-WK(2)+WK(3)
+          WK(2)=WK(2)-2.D0*WK(3)
+        
+          DO 4 I1=1,3
+          I2=I+I1
+          DO 4 J1=1,3
+          J2=J+J1
+          DO 4 K1=1,3
+          K2=MAX(I2,J2)+KL+K1-1+ML
+4         PSJINT1=PSJINT1+CSJ(I2,J2,K2)*WI(I1)*WJ(J1)*WK(K1)
+          PSJINT1=EXP(PSJINT1)
+        ELSE
+          K=15
+          IF(I.GT.K-3)I=K-3
+          IF(J.GT.K-3)J=K-3
+          WI(2)=QLI-I
+          WI(3)=WI(2)*(WI(2)-1.D0)*.5D0
+          WI(1)=1.D0-WI(2)+WI(3)
+          WI(2)=WI(2)-2.D0*WI(3)
+          WJ(2)=QLJ-J
+          WJ(3)=WJ(2)*(WJ(2)-1.D0)*.5D0
+          WJ(1)=1.D0-WJ(2)+WJ(3)
+          WJ(2)=WJ(2)-2.D0*WJ(3)
+          WK(2)=SL-K
+          WK(1)=1.D0-WK(2)
+        
+          DO 5 I1=1,3
+          DO 5 J1=1,3
+          DO 5 K1=1,2
+5         PSJINT1=PSJINT1+CSJ(I+I1,J+J1,K+K1+ML)*WI(I1)*WJ(J1)*WK(K1)
+          PSJINT1=EXP(PSJINT1)
+        ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSJINT1
+        RETURN
+        END
+C=======================================================================
+
+       FUNCTION PSLAM(S,A,B)
+c Kinematical function for two particle decay - maximal Pt-value
+c A - first particle mass squared,
+C B - second particle mass squared,
+C S - two particle invariant mass
+c-----------------------------------------------------------------------
+       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+       COMMON /AREA43/ MONIOU
+       COMMON /DEBUG/  DEBUG
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)S,A,B
+201     FORMAT(2X,'PSLAM - KINEMATICAL FUNCTION S=',E10.3,2X,'A=',
+     *  E10.3,2X,'B=',E10.3)
+       PSLAM=.25D0/S*(S+A-B)**2-A
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSLAM
+202     FORMAT(2X,'PSLAM=',E10.3)
+       RETURN
+       END
+C=======================================================================
+
+        FUNCTION PSNORM(EP)
+c 4-vector squared calculation
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EP(4)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)EP
+201     FORMAT(2X,'PSNORM - 4-VECTOR SQUARED FOR ',
+     *  'EP=',4(E10.3,1X))
+        PSNORM=EP(1)**2
+        DO 1 I=1,3
+1       PSNORM=PSNORM-EP(I+1)**2
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSNORM
+202     FORMAT(2X,'PSNORM=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE PSREC(EP,QV,ZV,QM,IQV,LDAU,LPAR,IQJ,EQJ,JFL,JQ)
+c Jet reconstructuring procedure - 4-momenta for all final jets are determined
+c EP(i) - jet 4-momentum
+C-----------------------------------------------------------------------
+c QV(i,j) - effective momentum for the branching of the parton in i-th row
+c on j-th level (0 - in case of no branching)
+c ZV(i,j) - Z-value for the branching of the parton in i-th row
+c on j-th level
+c QM(i,j) - mass squared for the parton in i-th row
+c on j-th level
+c IQV(i,j) - flavours for the parton in i-th row on j-th level
+c LDAU(i,j) - first daughter row for the branching of the parton in i-th row
+c on j-th level
+c LPAR(i,j) - the parent row for the parton in i-th row on j-th level
+C-----------------------------------------------------------------------
+       	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EP(4),EP3(4),EPV(4,30,50),
+     *  QV(30,50),ZV(30,50),QM(30,50),IQV(30,50),
+     *  LDAU(30,49),LPAR(30,50),
+     *  IQJ(2),EQJ(4,2),IPQ(2,30,50),EPQ(8,30,50),
+     *  EPJ(4),EPJ1(4)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)JQ,EP,IQJ
+201     FORMAT(2X,'PSREC - JET RECONSTRUCTURING: JQ=',I1/
+     *  4X,'JET 4-MOMENTUM EP=',4(E10.3,1X)/4X,'IQJ=',2I2)
+        JFL = 1
+        DO 1 I=1,4
+        EPV(I,1,1)=EP(I)
+1       EPQ(I,1,1)=EQJ(I,1)
+        IPQ(1,1,1)=IQJ(1)
+
+        IF(IQV(1,1).EQ.0)THEN
+          DO 2 I=1,4
+2         EPQ(I+4,1,1)=EQJ(I,2)
+          IPQ(2,1,1)=IQJ(2)
+        ENDIF
+
+        NLEV=1
+        NROW=1
+
+3       CONTINUE
+
+        IF(QV(NROW,NLEV).EQ.0.D0)THEN
+           IPJ=IQV(NROW,NLEV)
+           IF(IPJ.NE.0)THEN
+             IF(EPQ(1,NROW,NLEV).NE.0.D0)THEN
+               IF(IABS(IPJ).EQ.3)IPJ=IPJ*4/3
+              DO 4 I=1,4
+              EPJ(I)=EPV(I,NROW,NLEV)
+4             EPJ1(I)=EPQ(I,NROW,NLEV)
+              IPJ1=IPQ(1,NROW,NLEV)
+              IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+              CALL PSJDEF(IPJ,IPJ1,EPJ,EPJ1,JFL)
+        IF(DEBUG.GE.3)WRITE (MONIOU,211)IPJ,IPJ1,JFL
+211     FORMAT(2X,'PSREC - NEW STRING FLAVOURS: ',2I3,' JFL=',I1)
+              IF(JFL.EQ.0)RETURN
+            ELSE
+              IPQ(1,NROW,NLEV)=IPJ
+              DO 5 I=1,4
+5             EPQ(I,NROW,NLEV)=EPV(I,NROW,NLEV)
+        IF(DEBUG.GE.3)WRITE (MONIOU,212)IPJ,
+     *  (EPV(I,NROW,NLEV),I=1,4),JFL
+212     FORMAT(2X,'PSREC: NEW FINAL JET FLAVOR: ',I3,2X,
+     *         'JET 4-MOMENTUM:', 4(E10.3,1X),' JFL=',I1)
+            ENDIF
+            
+           ELSE
+             IPJ=INT(2.D0*PSRAN(B10)+1.D0)*(3-2*JQ)
+            DO 6 I=1,4
+6           EPJ(I)=.5D0*EPV(I,NROW,NLEV)
+ 	      
+            DO 9 M=1,2
+            IF(EPQ(1+4*(M-1),NROW,NLEV).NE.0.D0)THEN
+              DO 7 I=1,4
+7             EPJ1(I)=EPQ(4*(M-1)+I,NROW,NLEV)
+              IPJ1=IPQ(M,NROW,NLEV)
+              IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+              CALL PSJDEF(IPJ,IPJ1,EPJ,EPJ1,JFL)
+              IF(JFL.EQ.0)RETURN
+            ELSE
+              IPQ(M,NROW,NLEV)=IPJ
+              DO 8 I=1,4
+8             EPQ(4*(M-1)+I,NROW,NLEV)=EPJ(I)
+            ENDIF
+9           IPJ=-IPJ
+          ENDIF
+
+        IF(DEBUG.GE.3)WRITE (MONIOU,204)NLEV,NROW,IQV(NROW,NLEV),
+     *  (EPV(I,NROW,NLEV),I=1,4)
+204     FORMAT(2X,'PSREC: FINAL JET AT LEVEL NLEV=',I2,
+     *  ' NROW=',I2/4X,'JET FLAVOR: ',I3,2X,'JET 4-MOMENTUM:',
+     *  4(E10.3,1X))
+         ELSE
+
+          DO 10 I=1,4
+10        EP3(I)=EPV(I,NROW,NLEV)
+          CALL PSDEFROT(EP3,S0X,C0X,S0,C0)
+          Z=ZV(NROW,NLEV)
+          QT2=(Z*(1.D0-Z))**2*QV(NROW,NLEV)
+          LDROW=LDAU(NROW,NLEV)
+
+          WP0=EP3(1)+EP3(2)
+          WPI=Z*WP0
+          WMI=(QT2+QM(LDROW,NLEV+1))/WPI
+          EP3(1)=.5D0*(WPI+WMI)
+          EP3(2)=.5D0*(WPI-WMI)
+          QT=DSQRT(QT2)
+          CALL PSCS(C,S)
+          EP3(3)=QT*C
+          EP3(4)=QT*S
+          CALL PSROTAT(EP3,S0X,C0X,S0,C0)
+
+          DO 11 I=1,4
+11        EPV(I,LDROW,NLEV+1)=EP3(I)
+        IF(DEBUG.GE.3)WRITE (MONIOU,206)NLEV+1,LDROW,EP3
+206     FORMAT(2X,'PSREC: JET AT LEVEL NLEV=',I2,
+     *  ' NROW=',I2/4X,'JET 4-MOMENTUM:',4(E10.3,1X))
+
+          WPI=(1.D0-Z)*WP0
+          WMI=(QT2+QM(LDROW+1,NLEV+1))/WPI
+          EP3(1)=.5D0*(WPI+WMI)
+          EP3(2)=.5D0*(WPI-WMI)
+          EP3(3)=-QT*C
+          EP3(4)=-QT*S
+          CALL PSROTAT(EP3,S0X,C0X,S0,C0)
+        IF(DEBUG.GE.3)WRITE (MONIOU,206)NLEV+1,LDROW+1,EP3
+
+          DO 12 I=1,4
+12        EPV(I,LDROW+1,NLEV+1)=EP3(I)
+
+          IF(IQV(NROW,NLEV).EQ.0)THEN
+            IF(IQV(LDROW,NLEV+1).NE.0)THEN
+              IPQ(1,LDROW,NLEV+1)=IPQ(1,NROW,NLEV)
+              IPQ(1,LDROW+1,NLEV+1)=IPQ(2,NROW,NLEV)
+              DO 13 I=1,4
+              EPQ(I,LDROW,NLEV+1)=EPQ(I,NROW,NLEV)
+13            EPQ(I,LDROW+1,NLEV+1)=EPQ(I+4,NROW,NLEV)
+            ELSE
+              IPQ(1,LDROW,NLEV+1)=IPQ(1,NROW,NLEV)
+              IPQ(2,LDROW,NLEV+1)=0
+              IPQ(1,LDROW+1,NLEV+1)=0
+              IPQ(2,LDROW+1,NLEV+1)=IPQ(2,NROW,NLEV)
+              DO 14 I=1,4
+              EPQ(I,LDROW,NLEV+1)=EPQ(I,NROW,NLEV)
+              EPQ(I+4,LDROW,NLEV+1)=0.D0
+              EPQ(I,LDROW+1,NLEV+1)=0.D0
+14            EPQ(I+4,LDROW+1,NLEV+1)=EPQ(I+4,NROW,NLEV)
+            ENDIF
+          ELSE
+            IF(IQV(LDROW,NLEV+1).EQ.0)THEN
+              IPQ(1,LDROW,NLEV+1)=IPQ(1,NROW,NLEV)
+              IPQ(2,LDROW,NLEV+1)=0
+              IPQ(1,LDROW+1,NLEV+1)=0
+              DO 15 I=1,4
+              EPQ(I,LDROW,NLEV+1)=EPQ(I,NROW,NLEV)
+              EPQ(I+4,LDROW,NLEV+1)=0.D0
+15            EPQ(I,LDROW+1,NLEV+1)=0.D0
+            ELSE
+              IPQ(1,LDROW,NLEV+1)=0
+              IPQ(1,LDROW+1,NLEV+1)=0
+              IPQ(2,LDROW+1,NLEV+1)=IPQ(1,NROW,NLEV)
+              DO 16 I=1,4
+              EPQ(I,LDROW,NLEV+1)=0.D0
+              EPQ(I,LDROW+1,NLEV+1)=0.D0
+16            EPQ(I+4,LDROW+1,NLEV+1)=EPQ(I,NROW,NLEV)
+            ENDIF
+          ENDIF
+
+          NROW=LDROW
+          NLEV=NLEV+1
+          GOTO 3
+        ENDIF
+
+17      CONTINUE
+        IF(NLEV.EQ.1)THEN
+          IQJ(1)=IPQ(1,1,1)
+          DO 18 I=1,4
+18        EQJ(I,1)=EPQ(I,1,1)
+          IF(IQV(1,1).EQ.0)THEN
+            IQJ(2)=IPQ(2,1,1)
+            DO 19 I=1,4
+19          EQJ(I,2)=EPQ(I+4,1,1)
+          ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)iqj
+202     FORMAT(2X,'PSREC - END',2x,'iqj=',2i2)
+        RETURN
+      ENDIF
+
+        LPROW=LPAR(NROW,NLEV)
+
+        IF(LDAU(LPROW,NLEV-1).EQ.NROW)THEN
+           IF(IQV(NROW,NLEV).EQ.0)THEN
+             IF(EPQ(1,LPROW,NLEV-1).EQ.0.D0)THEN
+              IPQ(1,LPROW,NLEV-1)=IPQ(1,NROW,NLEV)
+              DO 20 I=1,4
+20            EPQ(I,LPROW,NLEV-1)=EPQ(I,NROW,NLEV)
+            ENDIF
+            IPQ(1,NROW+1,NLEV)=IPQ(2,NROW,NLEV)
+            DO 21 I=1,4
+21          EPQ(I,NROW+1,NLEV)=EPQ(I+4,NROW,NLEV)
+          ELSE
+            IF(IQV(LPROW,NLEV-1).EQ.0)THEN
+              IF(EPQ(1,LPROW,NLEV-1).EQ.0.D0)THEN
+                IPQ(1,LPROW,NLEV-1)=IPQ(1,NROW,NLEV)
+                DO 22 I=1,4
+22              EPQ(I,LPROW,NLEV-1)=EPQ(I,NROW,NLEV)
+              ENDIF
+            ELSE
+              IPQ(1,NROW+1,NLEV)=IPQ(1,NROW,NLEV)
+              DO 23 I=1,4
+23            EPQ(I,NROW+1,NLEV)=EPQ(I,NROW,NLEV)
+            ENDIF
+          ENDIF
+          NROW=NROW+1
+          GOTO 3
+
+        ELSE
+          IF(IQV(NROW,NLEV).EQ.0)THEN
+            IF(IQV(LPROW,NLEV-1).EQ.0)THEN
+              IF(EPQ(5,LPROW,NLEV-1).EQ.0.D0)THEN
+                IPQ(2,LPROW,NLEV-1)=IPQ(2,NROW,NLEV)
+                DO 24 I=1,4
+24              EPQ(I+4,LPROW,NLEV-1)=EPQ(I+4,NROW,NLEV)
+              ENDIF
+            ELSE
+              IF(EPQ(1,LPROW,NLEV-1).EQ.0.D0)THEN
+                IPQ(1,LPROW,NLEV-1)=IPQ(2,NROW,NLEV)
+                DO 25 I=1,4
+25              EPQ(I,LPROW,NLEV-1)=EPQ(I+4,NROW,NLEV)
+              ENDIF
+            ENDIF
+          ELSE
+            IF(IQV(LPROW,NLEV-1).EQ.0.AND.
+     *      EPQ(5,LPROW,NLEV-1).EQ.0.D0)THEN
+                IPQ(2,LPROW,NLEV-1)=IPQ(1,NROW,NLEV)
+                DO 26 I=1,4
+26              EPQ(I+4,LPROW,NLEV-1)=EPQ(I,NROW,NLEV)
+            ENDIF
+          ENDIF
+
+          NROW=LPROW
+          NLEV=NLEV-1
+          GOTO 17
+        ENDIF
+        END
+C=======================================================================
+
+      FUNCTION PSREJS(S,Z,IQQ)
+c PSREJS - rejection function for the energy sharing for semihard
+c interaction (Hi_semihard(S)/S**delh)
+c S - energy squared for the semihard interaction,
+c Z - impact parameter factor, Z=exp(-b**2/Rp),
+c IQQ - type of the hard interaction (0 - gg, 1 - qg, 2 - gq)
+c-----------------------------------------------------------------------
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+      COMMON /AREA17/ DEL,RS,RS0,FS,ALF,RR,SH,DELH
+      COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+      COMMON /AR3/    X1(7),A1(7)
+      COMMON /AREA43/ MONIOU
+      COMMON /DEBUG/  DEBUG
+      SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)S,Z,IQQ
+201     FORMAT(2X,'PSREJS - REJECTION FUNCTION TABULATION: '/
+     *  4X,'S=',E10.3,2X,'Z=',E10.3,2X,'IQQ=',I1)
+      XMIN=4.D0*(QT0+AMJ0)/S
+      XMIN=XMIN**(DELH-DEL)
+      PSREJS=0.D0
+
+c Numerical integration over Z1
+      DO 2 I=1,7
+      DO 2 M=1,2
+      Z1=(.5D0*(1.D0+XMIN-(2*M-3)*X1(I)*(1.D0-XMIN)))**(1.D0/
+     *(DELH-DEL))
+
+c SJ is the inclusive hard partonic interaction
+c cross-section (inclusive cut ladder cross section) for minimal
+c 4-momentum transfer squre QT0 and c.m. energy square s_hard = exp YJ;
+c SJB - Born cross-section
+      YJ=DLOG(Z1*S)
+      CALL PSJINT0(Z1*S,SJ,SJB,IQQ,0)
+c GY= Sigma_hard_tot(YJ,QT0) - total hard partonic
+c interaction cross-section for minimal 4-momentum transfer square QT0 and
+c c.m. energy square s_hard = exp YJ; SH=pi*R_hard**2 (R_hard**2=4/QT0)
+      GY=2.D0*SH*PSGINT((SJ-SJB)/SH*.5D0)+SJB
+      RH=RS0-ALF*DLOG(Z1)
+
+      IF(IQQ.NE.0)THEN
+        PSREJS=PSREJS+A1(I)*GY/(Z1*S)**DELH*Z**(RS0/RH)/RH*
+     *  (1.D0-Z1)*BET
+      ELSE
+        ST2=0.D0
+        DO 1 J=1,7
+1       ST2=ST2+A1(J)*((1.D0-Z1**(.5D0*(1.D0+X1(J))))*
+     *  (1.D0-Z1**(.5D0*(1.D0-X1(J)))))**BET
+
+        PSREJS=PSREJS-A1(I)*DLOG(Z1)*GY/(Z1*S)**DELH*Z**(RS0/RH)/RH*ST2
+      ENDIF
+2     CONTINUE
+      PSREJS=DLOG(PSREJS*(1.D0-XMIN)/Z)
+        IF(DEBUG.GE.2)WRITE (MONIOU,202)PSREJS
+202     FORMAT(2X,'PSREJS=',E10.3)
+      RETURN
+      END
+C=======================================================================
+
+        FUNCTION PSREJV(S)
+c PSREJV - rejection function for the energy sharing for quark-quark hard
+c interaction (sigma_hard(S)/S**delh)
+c S - energy squared for the hard interaction
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA17/ DEL,RS,RS0,FS,ALF,RR,SH,DELH
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)S
+201     FORMAT(2X,'PSREJV - REJECTION FUNCTION TABULATION: ',
+     *  'S=',E10.3)
+c SJ is the inclusive hard QUARK-QUARK interaction
+c cross-section (inclusive cut ladder cross section) for minimal
+c 4-momentum transfer squre QT0 and c.m. energy square s;
+c SJB - Born cross-section
+        CALL PSJINT0(S,SJ,SJB,1,1)
+
+c GY= Sigma_hard_tot(YJ,QT0) - total hard partonic (quark-quark)
+c interaction cross-section for minimal 4-momentum transfer square QT0 and
+c c.m. energy square s; SH=pi*R_hard**2 (R_hard**2=4/QT0)
+        GY=2.D0*SH*PSGINT((SJ-SJB)/SH*.5D0)+SJB
+        PSREJV=DLOG(GY/S**DELH)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSREJV
+202     FORMAT(2X,'PSREJV=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSRJINT(YJ,Z0,IQQ)
+c PSRJINT - Rejection function for the energy sharing (Hi_semih(S)/S**delh)
+c YJ=ln S,
+c Z0 - impact parameter factor, Z0=exp(-b**2/Rp),
+c IQQ - type of hard interaction (0 - gg; 1 - qg, 2 - gq; 3 - qq)
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION A(3)
+        COMMON /AREA1/  IA(2),ICZ,ICP
+        COMMON /AREA17/ DEL,RS,RS0,FS,ALF,RR,SH,DELH
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA23/ RJV(50)
+        COMMON /AREA24/ RJS(50,5,10)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)YJ,Z0,IQQ
+201     FORMAT(2X,'PSRJINT - REJECTION FUNCTION INTERPOLATION:'/
+     *  4X,'YJ=',E10.3,2X,'Z0=',E10.3,2X,'IQQ=',I1)
+        YY=(YJ-AQT0)*2.D0
+        JY=INT(YY)
+
+        IF(IQQ.EQ.3)THEN
+          IF(JY.EQ.0)THEN
+            PSRJINT=EXP(RJV(1))*YY+(EXP(RJV(2))-2.D0*
+     *      EXP(RJV(1)))*YY*(YY-1.D0)*.5D0
+          ELSE
+            PSRJINT=EXP(RJV(JY)+(RJV(JY+1)-RJV(JY))*(YY-JY)
+     *      +(RJV(JY+2)+RJV(JY)-2.D0*RJV(JY+1))*(YY-JY)*
+     *      (YY-JY-1.D0)*.5D0)
+          ENDIF
+        ELSE
+          Z=Z0**(RS/RS0)
+          IQ=(IQQ+1)/2+1+2*(ICZ-1)
+          JZ=INT(5.D0*Z)
+          IF(JZ.GT.3)JZ=3
+          WZ=5.D0*Z-JZ
+
+          IF(JZ.EQ.0)THEN
+            I1=2
+          ELSE
+            I1=1
+          ENDIF
+
+          DO 1 I=I1,3
+          J1=JZ+I-1
+          IF(JY.EQ.0)THEN
+            A(I)=EXP(RJS(1,J1,IQ))*YY+(EXP(RJS(2,J1,IQ))-2.D0*
+     *      EXP(RJS(1,J1,IQ)))*YY*(YY-1.D0)*.5D0
+            IF(A(I).GT.0.D0)THEN
+              A(I)=DLOG(A(I))
+            ELSE
+              A(I)=-80.D0
+            ENDIF
+          ELSE
+            A(I)=RJS(JY,J1,IQ)+(RJS(JY+1,J1,IQ)-
+     *      RJS(JY,J1,IQ))*(YY-JY)
+     *      +(RJS(JY+2,J1,IQ)+RJS(JY,J1,IQ)-2.D0*
+     *      RJS(JY+1,J1,IQ))*(YY-JY)*(YY-JY-1.D0)*.5D0
+          ENDIF
+1         CONTINUE
+
+          IF(JZ.NE.0)THEN
+            PSRJINT=EXP(A(1)+(A(2)-A(1))*WZ+(A(3)+A(1)-2.D0*A(2))*WZ*
+     *      (WZ-1.D0)*.5D0)*Z
+          ELSE
+            PSRJINT=(EXP(A(2))*WZ+(EXP(A(3))-2.D0*EXP(A(2)))*WZ*
+     *      (WZ-1.D0)*.5D0)*Z
+            IF(PSRJINT.LE.0.D0)PSRJINT=1.D-10
+          ENDIF
+        ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSRJINT
+202     FORMAT(2X,'PSRJINT=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSROOT(QLMAX,G,J)
+c PSROOT - effective momentum tabulation for given set of random number
+c values and maximal effective momentum QMAX values - according to the
+c probability of branching: (1 - timelike Sudakov formfactor)
+c QLMAX - ln QMAX/16/QTF,
+c G - dzeta number (some function of ksi)
+c J - type of the parton (1-g,2-q)
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)QLMAX,G,J
+201     FORMAT(2X,'PSQINT - BRANCHING MOMENTUM TABULATION:'/
+     *  4X,'QLMAX=',E10.3,2X,'G=',E10.3,2X,'J=',I1)
+        QL0=0.D0
+        QL1=QLMAX
+        F0=-G
+        F1=1.D0-G
+        SUD0=-DLOG(PSUDINT(QLMAX,J))
+
+1       QL2=QL1-(QL1-QL0)*F1/(F1-F0)
+        IF(QL2.LT.0.D0)THEN
+          QL2=0.D0
+          F2=-G
+        ELSEIF(QL2.GT.QLMAX)THEN
+          QL2=QLMAX
+          F2=1.D0-G
+        ELSE
+          F2=-DLOG(PSUDINT(QL2,J))/SUD0-G
+        ENDIF
+
+        IF(ABS(F2).GT.1.D-3)THEN
+          QL0=QL1
+          QL1=QL2
+          F0=F1
+          F1=F2
+          GOTO 1
+        ELSE
+          PSROOT=QL2
+        ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSROOT
+202     FORMAT(2X,'PSROOT=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE PSROTAT(EP,S0X,C0X,S0,C0)
+c Spacial rotation to the lab. system for 4-vector EP
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EP(4),EP1(3)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)EP,S0X,C0X,S0,C0
+201     FORMAT(2X,'PSROTAT - SPACIAL ROTATION:'/4X,
+     *  '4-VECTOR EP=',4(E10.3,1X)/4X,'S0X=',E10.3,'C0X=',E10.3,
+     *  2X,'S0=',E10.3,'C0=',E10.3)
+        EP1(3)=EP(4)
+        EP1(2)=EP(2)*S0+EP(3)*C0
+        EP1(1)=EP(2)*C0-EP(3)*S0
+
+        EP(2)=EP1(1)
+        EP(4)=EP1(2)*S0X+EP1(3)*C0X
+        EP(3)=EP1(2)*C0X-EP1(3)*S0X
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)EP
+202     FORMAT(2X,'PSROTAT: ROTATED 4-VECTOR EP=',
+     *  2X,4E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSQINT(QLMAX,G,J)
+c PSQINT - effective momentum interpolation for given random number G
+c and maximal effective momentum QMAX
+c QLMAX - ln QMAX/16/QTF,
+c G - random number (0<G<1)
+c J - type of the parton (1-g,2-q)
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION WI(3),WK(3)
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA34/ QRT(10,101,2)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)QLMAX,G,J
+201     FORMAT(2X,'PSQINT - BRANCHING MOMENTUM INTERPOLATION:'/
+     *  4X,'QLMAX=',E10.3,2X,'G=',E10.3,2X,'J=',I1)
+        QLI=QLMAX/1.38629d0
+        SUD0=1.D0/PSUDINT(QLMAX,J)
+        SL=100.D0*DLOG(1.D0-G*(1.D0-SUD0))/DLOG(SUD0)
+        I=INT(QLI)
+        K=INT(SL)
+        IF(K.GT.98)K=98
+        WK(2)=SL-K
+        WK(3)=WK(2)*(WK(2)-1.D0)*.5D0
+        WK(1)=1.D0-WK(2)+WK(3)
+        WK(2)=WK(2)-2.D0*WK(3)
+        PSQINT=0.D0
+
+        IF(I.GT.7)I=7
+        WI(2)=QLI-I
+        WI(3)=WI(2)*(WI(2)-1.D0)*.5D0
+        WI(1)=1.D0-WI(2)+WI(3)
+        WI(2)=WI(2)-2.D0*WI(3)
+
+        DO 1 K1=1,3
+        DO 1 I1=1,3
+1       PSQINT=PSQINT+QRT(I+I1,K+K1,J)*WI(I1)*WK(K1)
+        IF(PSQINT.LE.0.D0)PSQINT=0.D0
+        PSQINT=16.D0*QTF*EXP(PSQINT)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSQINT
+202     FORMAT(2X,'PSQINT=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE PSSHAR(LS,NHP,NW,NT)
+c Inelastic interaction - energy sharing procedure:
+c LS - total number of  cut soft pomeron blocks (froissarons),
+c NHP - total number of hard pomerons,
+c NW - number of interacting projectile nucleons (excluding diffracted),
+c NT - number of target nucleons in active state
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        REAL*16 GBH,GBH0
+        DIMENSION WP(56),WM(56),WHA(1000),WHB(1000),LHA0(56),
+     *  LHB0(56),IZP(56),IZT(56),WP0H(56),WM0H(56),
+     *  WPP(2),WMM(2),EP3(4),LQA0(56),LQB0(56),IPC(2,2),EPC(8,2),
+     *  ILA(56),ILB(56),ELA(4,56),ELB(4,56),EP(4),EP1(4)
+        COMMON /AREA1/  IA(2),ICZ,ICP
+        COMMON /AREA2/  S,Y0,WP0,WM0
+        COMMON /AREA9/  LQA(56),LQB(56),NQS(1000),IAS(1000),
+     *  IBS(1000),LHA(56),LHB(56),ZH(1000),IAH(1000),IBH(1000),
+     *  IQH(1000),LVA(56),LVB(56)
+        COMMON /AREA10/ STMASS,AM(7)
+        COMMON /AREA11/ B10
+        COMMON /AREA12/ NSH
+        COMMON /AREA17/ DEL,RS,RS0,FS,ALFP,RR,SH,DELH
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA19/ AHL(5)
+        COMMON /AREA20/ WPPP
+        COMMON /AREA25/ AHV(5)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        COMMON /AREA47/ NJTOT
+        SAVE
+        IF(DEBUG.GE.1)WRITE (MONIOU,201)NW,NT,NHP,LS
+201     FORMAT(2X,'PSSHARE - ENERGY SHARING PROCEDURE'/
+     *  4X,'NUMBER OF WOUNDED PROJECTILE NUCLEONS(HADRONS) NW=',I2/
+     *  4X,'NUMBER OF TARGET NUCLEONS IN THE ACTIVE STATE NT=',I2/
+     *  4X,'NUMBER OF SEMIHARD BLOCKS NHP=',I3/
+     *  4X,'NUMBER OF SOFT POMERON BLOCKS LS=',I3)
+        NSH1=NSH
+        DO 101 I=1,NW
+101     LQA0(I)=LQA(I)
+        DO 102 I=1,NT
+102     LQB0(I)=LQB(I)
+
+100     NSH=NSH1
+        NJTOT=0
+        DO 103 I=1,NW
+103     LQA(I)=LQA0(I)
+        DO 104 I=1,NT
+104     LQB(I)=LQB0(I)
+c-------------------------------------------------
+c Initial nucleons (hadrons) types recording
+        IF(IA(1).NE.1)THEN
+c IZP(i) - i-th projectile nucleons type (proton - 2, neutron - 3)
+          DO 1 I=1,NW
+1         IZP(I)=INT(2.5+PSRAN(B10))
+        ELSE
+c IZP(1)=ICP - projectile hadron type
+          IZP(1)=ICP
+        ENDIF
+        IF(IA(2).NE.1)THEN
+c IZT(j) - j-th target nucleon type (proton - 2 or neutron - 3)
+          DO 2 I=1,NT
+2         IZT(I)=INT(2.5+PSRAN(B10))
+        ELSE
+c Target proton
+         IZT(1)=2
+        ENDIF
+c-------------------------------------------------
+
+c WREJ - parameter for energy sharing (to minimise rejection)
+        WREJ=.0001D0
+
+3       CONTINUE
+
+        IF(NHP.NE.0)THEN
+        IF(DEBUG.GE.3)WRITE (MONIOU,211)NHP
+211     FORMAT(2X,'PSSHARE: NUMBER OF HARD POMERONS NHP=',I3)
+c-------------------------------------------------
+c-------------------------------------------------
+c Rejection function initialization:
+c-------------------------------------------------
+c energy-momentum will be shared between pomerons
+c according to s**DEL dependence for soft pomeron and
+c according to s**DELH dependence for pomeron with hard block,
+c then rejection is used according to real Sigma_hard(s) dependence.
+c Rejection is expected to be minimal for the uniform energy
+c distribution between pomerons ( s_hard = s / LHA(I) / LHB(J) )
+          GBH0=.6D0
+c NREJ - total number of rejections
+          NREJ=0
+          NHP1=NHP
+
+          DO 5 IH=1,NHP1
+        IF(DEBUG.GE.3)WRITE (MONIOU,212)IH
+212     FORMAT(2X,'PSSHARE: GBH-INI; CONTRIBUTION FROM ',I3,
+     *   '-TH HARD POMERON')
+c-------------------------------------------------
+c LHA(i) (LHB(j)) - total number of cut hard blocks, connected to i-th projectile
+c (j-th target) nucleon (hadron);
+c IAH(ih) (IBH(ih)) - number (position in array) of the projectile (target) nucleon,
+c connected to ih-th hard block;
+c ZH(ih) - factor exp(-R_ij/R_p) for ih-th hard block;
+c IQH(ih) - type of the hard interaction: 0 - gg, 1 - qg, 2 - gq, 3 - qq
+          IQQ=IQH(IH)
+          Z=ZH(IH)
+          I=IAH(IH)
+          J=IBH(IH)
+
+c Uniform energy distribution between hard pomerons
+          ZA=1.D0/LHA(I)
+          ZB=1.D0/LHB(J)
+c SI - c.m. energy squared for one hard block
+          SI=ZA*ZB*S
+
+          IF(SI.LT.4.D0*(QT0+AMJ0))THEN
+c-------------------------------------------------
+c One hard pomeron is removed (the energy is insufficient to simulate
+c great number of pomerons)
+c-------------------------------------------------
+            NHP=NHP-1
+            LHA(I)=LHA(I)-1
+            LHB(J)=LHB(J)-1
+
+            IF(IQQ.EQ.1)THEN
+              LVA(I)=0
+            ELSEIF(IQQ.EQ.2)THEN
+              LVB(J)=0
+            ELSEIF(IQQ.EQ.3)THEN
+              LVA(I)=0
+              LVB(J)=0
+            ENDIF
+c Rewriting of other hard pomerons characteristics
+            IF(NHP.GE.IH)THEN
+              DO 4 IH1=IH,NHP
+              IQH(IH1)=IQH(IH1+1)
+              ZH(IH1)=ZH(IH1+1)
+              IAH(IH1)=IAH(IH1+1)
+4             IBH(IH1)=IBH(IH1+1)
+            ENDIF
+c End of removing - event will be simulated from the very beginning
+c-------------------------------------------------
+            GOTO 3
+          ENDIF
+
+c Total rapidity for the interaction (for one hard block)
+          YI=DLOG(SI)
+          IF(YI.GT.17.D0)YI=17.D0
+c Rejection function normalization (on maximal available energy)
+          GBH0=GBH0/PSRJINT(YI,Z,IQQ)
+5         CONTINUE
+        IF(DEBUG.GE.3)WRITE (MONIOU,213)
+213     FORMAT(2X,'PSSHARE: GBH-INI - END')
+c-------------------------------------------------
+c End of rejection function normalization
+c-------------------------------------------------
+
+c-------------------------------------------------
+c LHA0(i), LHB0(j) arrays are used for energy sharing procedure
+c (they define number of remained cut hard blocks connected to given nucleon from
+c projectile or target respectively);
+c WP, WM - arrays for the rest of light cone momenta (E+-P_l) for those
+c nucleons (hadrons)
+c Hard pomerons connected to valence quarks are excluded from LHA0(i), LHB0(j)
+c (to be considered separetely)
+6         DO 7 I=1,NW
+          LHA0(I)=LHA(I)-LVA(I)
+7         WP(I)=WP0
+
+          DO 8 I=1,NT
+          LHB0(I)=LHB(I)-LVB(I)
+8         WM(I)=WM0
+
+c-------------------------------------------------
+c Projectile valence quarks light cone momenta are choosen according to
+c 1/sqrt(x) * x**delh * (1-x)**AHV(ICZ), ICZ is the type of the projectile
+          DO 10 I=1,NW
+          IF(LVA(I).NE.0)THEN
+9           XW=PSRAN(B10)**(1.D0/(.5D0+DELH))
+            IF(PSRAN(B10).GT.(1.D0-XW)**AHV(ICZ))GOTO 9
+        IF(DEBUG.GE.3)WRITE (MONIOU,214)I,XW
+214     FORMAT(2X,'PSSHARE: ',I2,'-TH PROJ. NUCLEON (HADRON); LIGHT',
+     *  ' CONE MOMENTUM SHARE XW=',E10.3)
+c WP0H(i) -  valence quark light cone momentum for i-th projectile nucleon
+            WP0H(I)=XW*WP(I)
+c WP(i) - the remainder of the light cone momentum for i-th projectile nucleon
+            WP(I)=WP(I)*(1.D0-XW)
+          ENDIF
+10        CONTINUE
+
+c Target valence quarks light cone momenta are choosen according to
+c 1/sqrt(x) * x**delh * (1-x)**AHV(2) (target nucleon)
+          DO 12 I=1,NT
+          IF(LVB(I).NE.0)THEN
+11          XW=PSRAN(B10)**(1.D0/(.5D0+DELH))
+            IF(PSRAN(B10).GT.(1.D0-XW)**AHV(2))GOTO 11
+        IF(DEBUG.GE.3)WRITE (MONIOU,215)I,XW
+215     FORMAT(2X,'PSSHARE: ',I2,'-TH TARGET NUCLEON (HADRON); LIGHT',
+     *  ' CONE MOMENTUM SHARE XW=',E10.3)
+c WM0H(i) -  valence quark light cone momentum for i-th target nucleon
+            WM0H(I)=XW*WM(I)
+c WM(i) - the remainder of the light cone momentum for i-th target nucleon
+            WM(I)=WM(I)*(1.D0-XW)
+          ENDIF
+12        CONTINUE
+c-------------------------------------------------
+
+          GBH=GBH0
+c-------------------------------------------------
+c Cycle over all cut hard blocks
+c-------------------------------------------------
+          DO 18 IH=1,NHP1
+c-------------------------------------------------
+c IAH(ih) (IBH(ih)) - number (position in array) of the projectile (target) nucleon,
+c connected to ih-th hard block;
+c ZH(ih) - factor exp(-R_ij/R_p) for ih-th hard block;
+c IQH(ih) - type of the hard interaction: 0 - gg, 1 - qg, 2 - gq, 3 - qq
+          IQQ=IQH(IH)
+          Z=ZH(IH)
+          I=IAH(IH)
+          J=IBH(IH)
+
+          IF((IQQ-3)*(IQQ-1).EQ.0)THEN
+c WHA(ih) - light cone momentum (E+P_l) for ih-th hard block
+c Read out of the valence quark light cone momentum
+            WHA(IH)=WP0H(I)
+          ELSE
+c LHA0(i) - number of remained cut hard blocks connected to i-th projectile nucleon
+            LHA0(I)=LHA0(I)-1
+c Energy is shared between pomerons according to s**DEL dependence for soft
+c pomeron and according to s**DELH dependence for the hard block;
+c AHL(ICZ) determines energetic spectrum of the leading hadronic state of
+c type ICZ
+            BPI=1.D0/(1.D0+AHL(ICZ)+
+     *      (1.D0+DELH)*LHA0(I))
+c            BPI=1.D0/(1.D0+AHL(ICZ)+(1.D0+DEL)*LQA(I)+
+c     *      (1.D0+DELH)*LHA0(I))
+15          XW=1.-PSRAN(B10)**BPI
+c Rejection according to XW**DELH
+            IF(PSRAN(B10).GT.XW**DELH)GOTO 15
+c WHA(ih) - light cone momentum (E+P_l) for ih-th hard block
+            WHA(IH)=WP(I)*XW
+c WP(i) - the remainder of the light cone momentum for i-th projectile nucleon
+            WP(I)=WP(I)*(1.D0-XW)
+          ENDIF
+
+          IF((IQQ-3)*(IQQ-2).EQ.0)THEN
+c WHB(ih) - light cone momentum (E-P_l) for ih-th hard block
+c Read out of the valence quark light cone momentum
+            WHB(IH)=WM0H(J)
+          ELSE
+c Energy is shared between pomerons - in the same way as above
+            LHB0(J)=LHB0(J)-1
+            BPI=1.D0/(1.D0+AHL(2)+(1.D0+DELH)
+     *      *LHB0(J))
+c            BPI=1.D0/(1.D0+AHL(2)+(1.D0+DEL)*LQB(J)+(1.D0+DELH)
+c     *      *LHB0(J))
+16          XW=1.-PSRAN(B10)**BPI
+            IF(PSRAN(B10).GT.XW**DELH)GOTO 16
+c WHB(ih) - light cone momentum (E-P_l) for ih-th hard block
+            WHB(IH)=WM(J)*XW
+c WM(j) - the remainder of the light cone momentum for j-th target nucleon
+            WM(J)=WM(J)*(1.D0-XW)
+          ENDIF
+
+c Invariant mass for ih-th hard block
+          SW=WHA(IH)*WHB(IH)
+          IF(SW.LT.4.D0*(QT0+AMJ0))THEN
+c Rejection in case of insufficient mass
+            NREJ=NREJ+1
+
+            IF(NREJ.GT.30)THEN
+c-------------------------------------------------
+c In case of great number of rejections number of hard blocks is put down
+c-------------------------------------------------
+c Number of remained hard blocks
+              NHP=NHP-1
+              LHA(I)=LHA(I)-1
+              LHB(J)=LHB(J)-1
+
+              IF(IQQ.EQ.1)THEN
+                LVA(I)=0
+              ELSEIF(IQQ.EQ.2)THEN
+                LVB(J)=0
+              ELSEIF(IQQ.EQ.3)THEN
+                LVA(I)=0
+                LVB(J)=0
+              ENDIF
+
+              IF(NHP.GE.IH)THEN
+                DO 17 IH1=IH,NHP
+                IQH(IH1)=IQH(IH1+1)
+                ZH(IH1)=ZH(IH1+1)
+                IAH(IH1)=IAH(IH1+1)
+17              IBH(IH1)=IBH(IH1+1)
+              ENDIF
+              GOTO 3
+c-------------------------------------------------
+c End of removing - event will be simulated from the very beginning
+c-------------------------------------------------
+
+            ELSE
+              GOTO 6
+            ENDIF
+          ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,216)IH,WHA(IH),WHB(IH),WP(I),WM(J)
+216     FORMAT(2X,'PSSHARE: ',I3,'-TH SEMIHARD BLOCK; LIGHT',
+     *  ' CONE MOMENTA SHARES:',2E10.3/
+     *  4X,'REMAINED LIGHT CONE MOMENTA:',2E10.3)
+
+          YH=DLOG(SW)
+c PSRINT(YH,Z,IQQ) - phi_hard(s_hard) / s_hard ** DELH;
+c YH = ln s_hard;
+c Z - factor exp(-R_ij/R_p) for the hard block;
+c IQQ - type of the hard interaction: 0 - gg, 1 - qg, 2 - gq, 3 - qq
+c Rejection function is multiplied by PSRINT(YH,Z,IQQ) for the ih-th block
+          GBH=GBH*PSRJINT(YH,Z,IQQ)
+18        CONTINUE
+c End of the loop for rejection function determination
+c-------------------------------------------------
+
+c-------------------------------------------------
+c Rejection procedure (due to the deviation of the  phi_hard(s_hard)
+c dependence from pure powerlike  s_hard ** DELH law)
+        IF(DEBUG.GE.2)WRITE (MONIOU,217)1.D0-GBH,NHP
+217     FORMAT(2X,'PSSHARE: REJECTION PROBABILITY:',E10.3,
+     *  2X,'NUMBER OF SEMIHARD BLOCKS:',I3)
+          IF(PSRAN(B10).GT.GBH)THEN
+            NREJ=NREJ+1
+
+            IF(NREJ.GT.30)THEN
+        IF(DEBUG.GE.2)WRITE (MONIOU,218)
+218     FORMAT(2X,'PSSHARE: MORE THAN 30 REJECTIONS - HARD POMERON',
+     *  ' NUMBER IS PUT DOWN')
+c-------------------------------------------------
+c In case of great number of rejections number of hard blocks is put down
+c LNH - number of hard blocks to be removed
+c-------------------------------------------------
+              LNH=1+NHP/20
+              DO 19 IHP=NHP-LNH+1,NHP
+              IIH=IAH(IHP)
+              JIH=IBH(IHP)
+              IQQ=IQH(IHP)
+
+              IF(IQQ.EQ.1)THEN
+                LVA(IIH)=0
+              ELSEIF(IQQ.EQ.2)THEN
+                LVB(JIH)=0
+              ELSEIF(IQQ.EQ.3)THEN
+                LVA(IIH)=0
+                LVB(JIH)=0
+              ENDIF
+
+              LHA(IIH)=LHA(IIH)-1
+19            LHB(JIH)=LHB(JIH)-1
+
+              NHP=NHP-LNH
+              GOTO 3
+c-------------------------------------------------
+c End of removing - event will be simulated from the very beginning
+c-------------------------------------------------
+            ELSE
+              GOTO 6
+            ENDIF
+          ENDIF
+
+***********************************************************************
+          DO 31 I=1,NW
+31        LHA0(I)=LHA(I)
+          DO 32 I=1,NT
+32        LHB0(I)=LHB(I)
+***********************************************************************
+
+c-------------------------------------------------
+c Particle production for all cut pomerons with hard blocks
+c-------------------------------------------------
+          DO 20 IH=1,NHP
+          IQQ=IQH(IH)
+          Z=ZH(IH)
+          I=IAH(IH)
+          J=IBH(IH)
+***********************************************************************
+          LHA0(I)=LHA0(I)-1
+          LHB0(J)=LHB0(J)-1
+***********************************************************************
+c WPI, WMI - light cone momenta for current (ih-th) hard pomeron
+          WPI=WHA(IH)
+          WMI=WHB(IH)
+        IF(DEBUG.GE.2)WRITE (MONIOU,219)IH,IQQ,WPI,WMI,WP(I),WM(J)
+219     FORMAT(2X,'PSSHARE: ',I3,
+     *  '-TH HARD BLOCK; TYPE OF THE INTERACTION:',I1/
+     *  4X,'INITIAL LIGHT CONE MOMENTA:',2E10.3/
+     *  4X,'REMAINED LIGHT CONE MOMENTA:',2E10.3)
+c-------------------------------------------------
+c PSHOT procedure is used for hard partonic interaction -
+c initial jets simulation
+          CALL PSHOT(WPI,WMI,Z,IPC,EPC,IZP(I),IZT(J),ICZ,IQQ)
+          IF(IQQ.EQ.1.OR.IQQ.EQ.3)THEN
+            IF((IABS(IZP(I)).GT.5.OR.IABS(IZP(I)).EQ.3).AND.
+     *      IZP(I).GT.0.OR.IABS(IZP(I)).NE.3.AND.
+     *      IABS(IZP(I)).LE.5.AND.IZP(I).LT.0)THEN
+              JQ=1
+            ELSE
+              JQ=2
+            ENDIF       
+            ILA(I)=IPC(JQ,1)
+            DO 330 L=1,4
+330         ELA(L,I)=EPC(L+4*(JQ-1),1)
+          ENDIF
+          IF(IQQ.EQ.2.OR.IQQ.EQ.3)THEN
+            IF((IABS(IZT(J)).GT.5.OR.IABS(IZT(J)).EQ.3).AND.
+     *      IZT(J).GT.0.OR.IABS(IZT(J)).NE.3.AND.
+     *      IABS(IZT(J)).LE.5.AND.IZT(J).LT.0)THEN
+              JQ=1
+            ELSE
+              JQ=2
+            ENDIF       
+            ILB(J)=IPC(JQ,2)
+            DO 331 L=1,4
+331         ELB(L,J)=EPC(L+4*(JQ-1),2)
+          ENDIF
+          IF(IQQ.EQ.3.AND.ILA(I)+ILB(J).EQ.0)NIAS=J
+c-------------------------------------------------
+c          SW=WP(I)*WM(J)
+c          IF(WP(I).LT.0.D0.OR.WM(J).LT.0.D0.OR.
+c     *    SW.LT.(AM(ICZ)+AM(2))**2)THEN
+c            NREJ=NREJ+1
+c          write (*,*)'i,j,WP(I),WM(J),sw',i,j,WP(I),WM(J),sw
+c            GOTO 100
+c          ENDIF
+
+c Leading hadronic state fragmentation is treated in the same way as low mass
+c diffraction (exhitation mass is determined by secodary reggeon intercept
+c dM**2~M**(-3))
+          IF(LQA(I)+LHA0(I).EQ.0.AND.LQB(J)+LHB0(J).EQ.0)THEN
+            IF(LVA(I).EQ.0.AND.LVB(J).EQ.0)THEN
+              CALL XXDDFR(WP(I),WM(J),IZP(I),IZT(J))
+            ELSEIF(LVA(I).EQ.0)THEN
+              CALL XXDPR(WP(I),WM(J),IZP(I),IZT(J),1)
+              IF(ILB(J).NE.0)THEN
+                DO 341 L=1,4
+341             EP1(L)=ELB(L,J)
+                EP(1)=.5D0*WM(J)
+                EP(2)=-EP(1)
+                EP(3)=0.D0
+                EP(4)=0.D0
+                IPJ1=ILB(J)
+                IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                CALL PSJDEF(IZT(J),IPJ1,EP,EP1,JFL)
+                IF(JFL.EQ.0)GOTO 100
+              ENDIF
+            ELSEIF(LVB(J).EQ.0)THEN
+              CALL XXDTG(WP(I),WM(J),IZP(I),IZT(J),1)
+              IF(ILA(I).NE.0)THEN
+                DO 342 L=1,4
+342             EP1(L)=ELA(L,I)
+                EP(1)=.5D0*WP(I)
+                EP(2)=EP(1)
+                EP(3)=0.D0
+                EP(4)=0.D0
+                IPJ1=ILA(I)
+                IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                CALL PSJDEF(IZP(I),IPJ1,EP,EP1,JFL)
+                IF(JFL.EQ.0)GOTO 100
+              ENDIF
+            ELSE
+              IF(ILA(I).NE.0)THEN
+                DO 343 L=1,4
+343             EP1(L)=ELA(L,I)
+                EP(1)=.5D0*WP(I)
+                EP(2)=EP(1)
+                EP(3)=0.D0
+                EP(4)=0.D0
+                IPJ1=ILA(I)
+                IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                CALL PSJDEF(IZP(I),IPJ1,EP,EP1,JFL)
+                IF(JFL.EQ.0)GOTO 100
+              ENDIF
+              IF(ILB(J).NE.0)THEN
+                DO 351 L=1,4
+351             EP1(L)=ELB(L,J)
+                EP(1)=.5D0*WM(J)
+                EP(2)=-EP(1)
+                EP(3)=0.D0
+                EP(4)=0.D0
+                IPJ1=ILB(J)
+                IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                CALL PSJDEF(IZT(J),IPJ1,EP,EP1,JFL)
+                IF(JFL.EQ.0)GOTO 100
+              ENDIF
+            ENDIF
+          ELSEIF(LQA(I)+LHA0(I).EQ.0)THEN
+            IF(LVA(I).EQ.0)THEN
+              CALL XXDPR(WP(I),WM(J),IZP(I),IZT(J),LQB(J)+LHB0(J))
+            ELSE
+              IF(ILA(I).NE.0)THEN
+                DO 344 L=1,4
+344             EP1(L)=ELA(L,I)
+                EP(1)=.5D0*WP(I)
+                EP(2)=EP(1)
+                EP(3)=0.D0
+                EP(4)=0.D0
+                IPJ1=ILA(I)
+                IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                CALL PSJDEF(IZP(I),IPJ1,EP,EP1,JFL)
+                IF(JFL.EQ.0)GOTO 100
+              ENDIF
+            ENDIF
+          ELSEIF(LQB(J)+LHB0(J).EQ.0)THEN
+            IF(LVB(J).EQ.0)THEN
+              CALL XXDTG(WP(I),WM(J),IZP(I),IZT(J),LQA(I)+LHA0(I))
+            ELSE
+              IF(ILB(J).NE.0)THEN
+                DO 345 L=1,4
+345             EP1(L)=ELB(L,J)
+                EP(1)=.5D0*WM(J)
+                EP(2)=-EP(1)
+                EP(3)=0.D0
+                EP(4)=0.D0
+                IPJ1=ILB(J)
+                IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                CALL PSJDEF(IZT(J),IPJ1,EP,EP1,JFL)
+                IF(JFL.EQ.0)GOTO 100
+              ENDIF
+            ENDIF
+          ENDIF
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+20        CONTINUE
+c-------------------------------------------------
+c End of the hard blocks loop
+c-------------------------------------------------
+
+        ELSE
+c-------------------------------------------------
+c Initial light cone momenta initialization in case of no one cut hard block
+          DO 21 I=1,NW
+21        WP(I)=WP0
+          DO 22 I=1,NT
+22        WM(I)=WM0
+        ENDIF
+
+        IF(LS.NE.0)THEN
+c-------------------------------------------------
+c The loop for all cut froissarons (blocks of soft pomerons)
+c-------------------------------------------------
+          DO 28 IS=1,LS
+c NP=NQS(is) - number of cut pomerons in is-th block;
+c IAS(is) (IBS(is)) - number (position in array) of the projectile (target) nucleon,
+c connected to is-th block of soft pomerons;
+c LQA(i) (LQB(j)) - total number of cut soft pomerons, connected to i-th projectile
+c (j-th target) nucleon (hadron);
+c WP(i) (WM(j)) - the remainder of the light cone momentum for i-th projectile
+c (j-th target) nucleon (hadron);
+c NP=NQS(is) - number of cut pomerons in is-th block;
+c LQ1, LQ2 define the numbers of the remained cut pomerons  connected
+c to given nucleons (hadrons)
+          I=IAS(IS)
+          J=IBS(IS)
+          LQ1=LQA(I)
+          LQ2=LQB(J)
+          WPN=WP(I)
+          WMN=WM(J)
+          NP=NQS(IS)
+      IF(DEBUG.GE.3)WRITE (MONIOU,222)IS,I,J,NP
+222   FORMAT(2X,'PSSHARE: ',I3,'-TH SOFT POMERON BLOCK IS',
+     *      ' CONNECTED TO ',I2,
+     *      '-TH PROJECTILE NUCLEON'/4x,'(HADRON) AND ',I2,
+     *      '-TH TARGET NUCLEON'/
+     *      4X,'NUMBER OF CUT SOFT POMERONS IN THE BLOCK:',I2)
+c-------------------------------------------------
+c The loop for all cut pomerons in the block
+          DO 27 IP=1,NP
+
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+c High mass diffraction - probability WPPP
+14        JPP=0
+          IF(LQ1.EQ.1.AND.WPN.EQ.WP0.AND.PSRAN(B10).LT.WPPP)THEN
+c In case of only one cut soft pomeron high mass diffraction is simulated with the
+c probability WPPP/2 or triple pomeron contribution - also WPPP/2 to have AGK cancell.
+c - only for projectile hadron (nucleons) (for target - neglected)
+c YW is the branching point position (in rapidity)
+            YW=1.D0+PSRAN(B10)*(Y0-2.D0)
+      IF(DEBUG.GE.3)WRITE (MONIOU,223)YW
+223   FORMAT(2X,'PSSHARE: TRIPLE POMERON CONTRIBUTION YW=',E10.3)
+c Light cone momentum (E+P_l) for the diffractive state (which is just usual cut
+c pomeron)
+            XPW=EXP(-YW)
+            JPP=1
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+
+          ELSE
+            LQ1=LQ1-1
+c Energy-momentum is shared between pomerons according to s**DEL dependence for soft
+c pomeron; AHL(ICZ) determines energy spectrum of leading hadronic
+c state of type ICZ
+            BPI=1.D0/(1.D0+AHL(ICZ)+(1.D0+DEL)*LQ1)
+23          XPW=1.-PSRAN(B10)**BPI
+c Rejection according to XW**DEL
+            IF(PSRAN(B10).GT.XPW**DEL)GOTO 23
+          ENDIF
+
+          LQ2=LQ2-1
+c Energy-momentum is shared between pomerons according to s**DEL dependence for soft
+c pomeron - similar to projectile case
+          BPI=1.D0/(1.D0+AHL(2)+(1.D0+DEL)*LQ2)
+24        XMW=1.-PSRAN(B10)**BPI
+c Rejection according to XW**DEL
+          IF(PSRAN(B10).GT.XMW**DEL)GOTO 24
+c-------------------------------------------------
+
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+c High mass diffraction is rejected in case of insufficient energy
+         IF(JPP.EQ.1.AND.XPW*XMW*WPN*WMN.LT.2.72D0)THEN
+            LQ2=LQ2+1
+            GOTO 14
+          ENDIF
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+
+c WPI is the light cone momentum (E+P_l) for the pomeron;
+c WPN is the remainder of the light cone momentum for given nucleon (hadron)
+          WPI=WPN*XPW
+          WPN=WPN-WPI
+          WMI=WMN*XMW
+          WMN=WMN-WMI
+
+************************************************************************
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+        IF(LQ1.EQ.0.AND.LVA(I).EQ.0)THEN
+          CALL IXXDEF(IZP(I),IC11,IC12,ICZ)
+        ELSE
+          IC11=0
+          IC12=0
+        ENDIF
+        IF(LQ2.EQ.0.AND.LVB(J).EQ.0)THEN
+          CALL IXXDEF(IZT(J),IC21,IC22,2)
+        ELSE
+          IC21=0
+          IC22=0
+        ENDIF
+
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+c Fragmentation process for the pomeron ( quarks and antiquarks types at the
+c ends of the two strings are determined, energy-momentum is shared
+c between them and strings fragmentation is simulated )
+      IF(DEBUG.GE.3)WRITE (MONIOU,224)IP,WPI,WMI
+224   FORMAT(2X,'PSSHARE: ',I2,'-TH SOFT POMERON IN THE BLOCK'/
+     *      4X,'LIGHT CONE MOMENTA FOR THE POMERON:',2E10.3)
+          CALL XXSTR(WPI,WMI,WPN,WMN,IC11,IC12,IC22,IC21)
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+c Triple pomeron contribution simulation 
+          IF(JPP.EQ.1)THEN
+            IF(PSRAN(B10).LT..5D0)THEN
+              SW=WPN*WMN
+              IF(WPN.LT.0.D0.OR.WMN.LT.0.D0.OR.
+     *        SW.LT.(AM(ICZ)+AM(2))**2)THEN
+          write (*,*)'difr,i,j,WPn,WMn,sw,lq1,lq2',
+     *      i,j,WPn,WMn,sw,lq1,lq2
+                NREJ=NREJ+1
+                GOTO 100
+              ENDIF
+
+              IF(LQ2.EQ.0)THEN
+                CALL XXDTG(WPN,WMN,IZP(I),IZT(J),0)
+              ELSE
+                WP1=WPN
+                WM1=AM(ICZ)**2/WP1
+                EP3(1)=.5D0*(WP1+WM1)
+                EP3(2)=.5D0*(WP1-WM1)
+                EP3(3)=0.D0
+                EP3(4)=0.D0
+                CALL XXREG(EP3,IZP(I))
+                WMN=WMN-WM1
+                WPN=0.D0
+              ENDIF
+              GOTO 30
+            ELSE
+
+c Triple pomeron contribution simulation (both pomerons are cut)	    	    
+      IF(DEBUG.GE.3)WRITE (MONIOU,225)
+225   FORMAT(2X,'PSSHARE: TRIPLE POMERON CONRITRIBUTION WITH 3 CUT',
+     *' POMERONS')
+              WMM(1)=1.D0/WPI
+              WMN=WMN-WMM(1)
+c Light cone momentum (E-P_l) sharing for the two pomerons
+              WMM(2)=WMM(1)*PSRAN(B10)
+              WMM(1)=WMM(1)-WMM(2)
+              LQ1=2
+              DO 26 L=1,2
+              LQ1=LQ1-1
+c Light cone momentum (E+P_l) sharing for the two pomerons
+              BPI=(1.D0+DEL)*LQ1+1.D0+AHL(ICZ)
+              BPI=1.D0/BPI
+25            XPW=1.-PSRAN(B10)**BPI
+              IF(PSRAN(B10).GT.XPW**DEL)GOTO 25
+              WPP(L)=WPN*XPW
+              WPN=WPN*(1.D0-XPW)
+c Fragmentation process for the pomerons
+26            CALL XXSTR(WPP(L),WMM(L),WPN,WMN,0,0,0,0)
+              SW=WPN*WMN
+              IF(WPN.LT.0.D0.OR.WMN.LT.0.D0.OR.
+     *        SW.LT.(AM(ICZ)+AM(2))**2)THEN
+                NREJ=NREJ+1
+                GOTO 100
+              ENDIF
+            ENDIF
+          ENDIF
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+27        CONTINUE
+c End of the pomeron loop
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+c          SW=WPN*WMN
+c          IF(WPN.LT.0.D0.OR.WMN.LT.0.D0.OR.
+c     *    SW.LT.(AM(ICZ)+AM(2))**2)THEN
+c            NREJ=NREJ+1
+c            GOTO 100
+c          ENDIF
+
+c Leading hadronic state fragmentation is treated in the same way as low mass
+c diffraction (exhitation mass is determined by secodary reggeon intercept
+c dM**2~M**(-3))
+          IF(LQ1.EQ.0.AND.LQ2.EQ.0)THEN
+            IF(LVA(I).EQ.0.AND.LVB(J).EQ.0)THEN
+              CALL XXDDFR(WPN,WMN,IZP(I),IZT(J))
+            ELSEIF(LVA(I).EQ.0)THEN
+              CALL XXDPR(WPN,WMN,IZP(I),IZT(J),1)
+              IF(ILB(J).NE.0)THEN
+                DO 346 L=1,4
+346             EP1(L)=ELB(L,J)
+                EP(1)=.5D0*WMN
+                EP(2)=-EP(1)
+                EP(3)=0.D0
+                EP(4)=0.D0
+                IPJ1=ILB(J)
+                IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                CALL PSJDEF(IZT(J),IPJ1,EP,EP1,JFL)
+                IF(JFL.EQ.0)GOTO 100
+              ENDIF
+            ELSEIF(LVB(J).EQ.0)THEN
+              CALL XXDTG(WPN,WMN,IZP(I),IZT(J),1)
+              IF(ILA(I).NE.0)THEN
+                DO 347 L=1,4
+347             EP1(L)=ELA(L,I)
+                EP(1)=.5D0*WPN
+                EP(2)=EP(1)
+                EP(3)=0.D0
+                EP(4)=0.D0
+                IPJ1=ILA(I)
+                IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                CALL PSJDEF(IZP(I),IPJ1,EP,EP1,JFL)
+               IF(JFL.EQ.0)GOTO 100
+              ENDIF
+            ELSE
+              IF(ILA(I).NE.0)THEN
+                DO 348 L=1,4
+348             EP1(L)=ELA(L,I)
+                EP(1)=.5D0*WPN
+                EP(2)=EP(1)
+                EP(3)=0.D0
+                EP(4)=0.D0
+                IPJ1=ILA(I)
+                IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                CALL PSJDEF(IZP(I),IPJ1,EP,EP1,JFL)
+                IF(JFL.EQ.0)GOTO 100
+              ENDIF
+              IF(ILB(J).NE.0)THEN
+                DO 349 L=1,4
+349             EP1(L)=ELB(L,J)
+                EP(1)=.5D0*WMN
+                EP(2)=-EP(1)
+                EP(3)=0.D0
+                EP(4)=0.D0
+                IPJ1=ILB(J)
+                IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                CALL PSJDEF(IZT(J),IPJ1,EP,EP1,JFL)
+                IF(JFL.EQ.0)GOTO 100
+              ENDIF
+            ENDIF
+            
+          ELSEIF(LQ1.EQ.0)THEN
+            IF(LVA(I).EQ.0)THEN
+              CALL XXDPR(WPN,WMN,IZP(I),IZT(J),LQ2)
+            ELSE
+              IF(ILA(I).NE.0)THEN
+                DO 350 L=1,4
+350             EP1(L)=ELA(L,I)
+                EP(1)=.5D0*WPN
+                EP(2)=EP(1)
+                EP(3)=0.D0
+                EP(4)=0.D0
+                IPJ1=ILA(I)
+                IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                CALL PSJDEF(IZP(I),IPJ1,EP,EP1,JFL)
+                IF(JFL.EQ.0)GOTO 100
+              ENDIF
+            ENDIF
+            
+          ELSEIF(LQ2.EQ.0)THEN
+            IF(LVB(J).EQ.0)THEN
+              CALL XXDTG(WPN,WMN,IZP(I),IZT(J),LQ1)
+            ELSE
+              IF(ILB(J).NE.0)THEN
+                DO 352 L=1,4
+352             EP1(L)=ELB(L,J)
+                EP(1)=.5D0*WMN
+                EP(2)=-EP(1)
+                EP(3)=0.D0
+                EP(4)=0.D0
+                IPJ1=ILB(J)
+                IF(IABS(IPJ1).EQ.3)IPJ1=IPJ1*4/3
+                CALL PSJDEF(IZT(J),IPJ1,EP,EP1,JFL)
+                IF(JFL.EQ.0)GOTO 100
+              ENDIF
+            ENDIF
+          ENDIF
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+c-------------------------------------------------
+c The numbers of the remained cut pomerons connected to given nucleons (hadrons)
+c as well as the rest of the longitudinal momenta for these nucleons are
+c recorded
+30        LQA(I)=LQ1
+          LQB(J)=LQ2
+          WP(I)=WPN
+28        WM(J)=WMN
+        ENDIF
+c-------------------------------------------------
+c End of the soft blocks loop
+c-------------------------------------------------
+        IF(IA(1).EQ.1.AND.LVA(1).NE.0.AND.ILA(1).EQ.0)THEN
+          EP(1)=.5D0*WP(1)
+          EP(2)=EP(1)
+          EP(3)=0.D0
+          EP(4)=0.D0
+          EP1(1)=.5D0*WM(NIAS)
+          EP1(2)=-EP1(1)
+          EP1(3)=0.D0
+          EP1(4)=0.D0
+          CALL PSJDEF(IZP(1),IZT(NIAS),EP,EP1,JFL)
+          IF(JFL.EQ.0)GOTO 100
+        ENDIF
+cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+        CALL XXJETSIM
+************************************************************************
+      IF(DEBUG.GE.3)WRITE (MONIOU,227)
+227   FORMAT(2X,'PSSHARE - END')
+        RETURN
+        END
+C=======================================================================
+
+      SUBROUTINE PSTRANS(EP,EY)
+c Lorentz transform according to parameters EY ( determining Lorentz shift
+c along the Z,X,Y-axis respectively (EY(1),EY(2),EY(3)))
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EY(3),EP(4)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)EP,EY
+201     FORMAT(2X,'PSTRANS - LORENTZ BOOST FOR 4-VECTOR'/4X,'EP=',
+     *  2X,4(E10.3,1X)/4X,'BOOST PARAMETERS EY=',3E10.3)
+c Lorentz transform to lab. system according to 1/EY(i) parameters
+        DO 1 I=1,3
+        IF(EY(4-I).NE.1.D0)THEN
+          WP=(EP(1)+EP(5-I))/EY(4-I)
+          WM=(EP(1)-EP(5-I))*EY(4-I)
+          EP(1)=.5D0*(WP+WM)
+          EP(5-I)=.5D0*(WP-WM)
+        ENDIF
+1       CONTINUE
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)EP
+202     FORMAT(2X,'PSTRANS: TRANSFORMED 4-VECTOR EP=',
+     *  2X,4(E10.3,1X))
+        RETURN
+        END
+C=======================================================================
+
+      SUBROUTINE PSTRANS1(EP,EY)
+c Lorentz transform according to parameters EY ( determining Lorentz shift
+c along the Z,X,Y-axis respectively (EY(1),EY(2),EY(3)))
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EY(3),EP(4)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)EP,EY
+201     FORMAT(2X,'PSTRANS1 - LORENTZ BOOST FOR 4-VECTOR'/4X,'EP=',
+     *  2X,4(E10.3,1X)/4X,'BOOST PARAMETERS EY=',3E10.3)
+c Lorentz transform to lab. system according to 1/EY(i) parameters
+          DO 2 I=1,3
+          IF(EY(I).NE.1.D0)THEN
+            WP=(EP(1)+EP(I+1))*EY(I)
+            WM=(EP(1)-EP(I+1))/EY(I)
+            EP(1)=.5D0*(WP+WM)
+            EP(I+1)=.5D0*(WP-WM)
+          ENDIF
+2         CONTINUE
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)EP
+202     FORMAT(2X,'PSTRANS1: TRANSFORMED 4-VECTOR EP=',
+     *  2X,4(E10.3,1X))
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSUDINT(QLMAX,J)
+c PSUDINT - timelike Sudakov formfactor interpolation
+c QLMAX - ln QMAX/16/QTF,
+c J - type of the parton (0-g,1-q)
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION WK(3)
+        COMMON /AREA33/ FSUD(10,2)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)J,QLMAX
+201     FORMAT(2X,'PSUDINT - SPACELIKE FORM FACTOR INTERPOLATION:'/
+     *  4X,'PARTON TYPE J=',
+     *  I1,2X,'MOMENTUM LOGARITHM QLMAX=',E10.3)
+        QL=QLMAX/1.38629d0
+
+        IF(QL.LE.0.D0)THEN
+          PSUDINT=1.D0
+        ELSE
+          K=INT(QL)
+          IF(K.GT.7)K=7
+          WK(2)=QL-K
+          WK(3)=WK(2)*(WK(2)-1.D0)*.5D0
+          WK(1)=1.D0-WK(2)+WK(3)
+          WK(2)=WK(2)-2.D0*WK(3)
+
+          PSUDINT=0.D0
+          DO 1 K1=1,3
+1         PSUDINT=PSUDINT+FSUD(K+K1,J)*WK(K1)
+          IF(PSUDINT.LE.0.D0)PSUDINT=0.D0
+          PSUDINT=EXP(-PSUDINT)
+        ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSUDINT
+202     FORMAT(2X,'PSUDINT=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSUDS(Q,J)
+c PSUDS - spacelike Sudakov formfactor
+c Q - maximal value of the effective momentum,
+c J - type of parton (0 - g, 1 - q)
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA6/  PI,BM,AM
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)J,Q
+201     FORMAT(2X,'PSUDS - SPACELIKE FORM FACTOR: PARTON TYPE J=',
+     *  I1,2X,'MOMENTUM Q=',E10.3)
+        IF(Q.GT.QT0)THEN
+          QLM=DLOG(Q/ALM)
+          PSUDS=(QLM*DLOG(QLM/QLOG)-DLOG(Q/QT0))/9.D0
+
+          IF(J.EQ.0)THEN
+            PSUDS=PSUDS*6.D0
+          ELSE
+            PSUDS=PSUDS/.375D0
+          ENDIF
+          PSUDS=EXP(-PSUDS)
+
+        ELSE
+          PSUDS=1.D0
+        ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSUDS
+202     FORMAT(2X,'PSUDS=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSUDT(QMAX,J)
+c PSUDT - timelike Sudakov formfactor
+c QMAX - maximal value of the effective momentum,
+c J - type of parton (0 - g, 1 - q)
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON/AR3/X1(7),A1(7)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)J,QMAX
+201     FORMAT(2X,'PSUDT - TIMELIKE FORM FACTOR: PARTON TYPE J=',
+     *  I1,2X,'MOMENTUM QMAX=',E10.3)
+        PSUDT=0.D0
+        QLMAX=DLOG(DLOG(QMAX/16.D0/ALM))
+        QFL=DLOG(DLOG(QTF/ALM))
+
+c Numerical integration over transverse momentum square;
+c Gaussian integration is used
+          DO 1 I=1,7
+          DO 1 M=1,2
+          QTL=.5D0*(QLMAX+QFL+(2*M-3)*X1(I)*(QLMAX-QFL))
+          QT=ALM*EXP(EXP(QTL))
+          IF(QT.GE.QMAX/16.D0)QT=QMAX/16.0001D0
+          ZMIN=.5D0-DSQRT((.25D0-DSQRT(QT/QMAX)))
+          ZMAX=1.D0-ZMIN
+          IF(J.EQ.0)THEN
+******************************************************
+            AP=(PSAPINT(ZMAX,0,0)-PSAPINT(ZMIN,0,0)+
+     *      PSAPINT(ZMAX,0,1)-PSAPINT(ZMIN,0,1))*.5D0
+******************************************************
+          ELSE
+            AP=PSAPINT(ZMAX,1,0)-PSAPINT(ZMIN,1,0)
+          ENDIF
+1         PSUDT=PSUDT+A1(I)*AP
+          PSUDT=PSUDT*(QLMAX-QFL)/9.D0
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSUDT
+202     FORMAT(2X,'PSUDT=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSV(X,Y,XB,IB)
+c XXV - eikonal dependent factor for hadron-nucleus interaction
+c (used for total and diffractive hadron-nucleus cross-sections calculation)
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION XB(56,3),FHARD(3)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)X,Y,IB
+201     FORMAT(2X,'PSV - EIKONAL FACTOR: NUCLEON COORDINATES X=',
+     *  E10.3,2X,'Y=',E10.3/4X,'NUMBER OF ACTIVE TARGET NUCLEONS IB='
+     *  ,I2)
+        DV=0.D0
+c????????????????????????????????????????????
+        DO 1 M=1,IB
+        Z=PSDR(X-XB(M,1),Y-XB(M,2))
+        DV=DV+PSFAZ(Z,FSOFT,FHARD,FSHARD)+FHARD(1)+FHARD(2)+FHARD(3)
+1       CONTINUE
+        PSV=(1.D0-EXP(-DV))**2
+
+C       DH=1.D0
+C       DO 1 M=1,IB
+C       Z=PSDR(X-XB(M,1),Y-XB(M,2))
+C       DV=DV+PSFAZ(Z,FSOFT,FHARD,FSHARD)
+C 1     DH=DH*(1.D0-FHARD(1)-FHARD(2)-FHARD(3))
+c????????????????????????????????????????????????
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSV
+202     FORMAT(2X,'PSV=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE PSVDEF(ICH,IC1,ICZ)
+c Determination of valence quark flavour -
+c for valence quark hard scattering
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA11/ B10
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+      SAVE
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)ICH,ICZ
+201     FORMAT(2X,'PSVDEF: HADRON TYPE ICH=',I2,' AUXILLIARY TYPE ICZ='
+     *  ,I1)
+     
+        IS=IABS(ICH)/ICH
+        IF(ICZ.EQ.1)THEN
+          IC1=ICH*(1-3*INT(.5+PSRAN(B10)))
+          ICH=-IC1-ICH
+        ELSEIF(ICZ.EQ.2)THEN
+          IF(PSRAN(B10).GT..33333D0.OR.ICH.LT.0)THEN
+            IC1=ICH-IS
+            ICH=3*IS
+          ELSE
+            IC1=4*IS-ICH
+            ICH=ICH+4*IS
+          ENDIF
+        ELSEIF(ICZ.EQ.3)THEN
+          IC1=ICH-3*IS
+          ICH=-4*IS
+        ELSEIF(ICZ.EQ.4)THEN
+          IC1=ICH-9*IS
+          ICH=5*IS
+        ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)IC1,ICH
+202     FORMAT(2X,'PSVDEF-END: QUARK FLAVOR IC1=',I2,
+     *  'DIQUARK TYPE ICH=',I2)
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION PSZSIM(QQ,J)
+c PSZSIM - light cone momentum share simulation (for the timelike
+c branching)
+c QQ - effective momentum value,
+c J - type of the parent parton (0-g,1-q)
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA11/ B10
+        COMMON /AREA18/ ALM,QT0,QLOG,QLL,AQT0,QTF,BET,AMJ0
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)QQ,J
+201     FORMAT(2X,'PSZSIM - Z-SHARE SIMULATION: QQ=',E10.3,2X,'J=',I1)
+        ZMIN=.5D0-DSQRT(.25D0-DSQRT(QTF/QQ))
+        QLF=DLOG(QTF/ALM)
+
+1       CONTINUE
+        IF(J.EQ.1)THEN
+          PSZSIM=.5D0*(2.D0*ZMIN)**PSRAN(B10)
+******************************************************
+          GB=PSZSIM*(PSFAP(PSZSIM,0,0)+PSFAP(PSZSIM,0,1))/7.5D0
+******************************************************
+        ELSE
+          PSZSIM=ZMIN*((1.D0-ZMIN)/ZMIN)**PSRAN(B10)
+          GB=PSZSIM*PSFAP(PSZSIM,1,0)*.375D0
+        ENDIF
+        QT=QQ*(PSZSIM*(1.D0-PSZSIM))**2
+        GB=GB/DLOG(QT/ALM)*QLF
+        IF(DEBUG.GE.3)WRITE (MONIOU,203)QT,GB
+203     FORMAT(2X,'PSZSIM: QT=',E10.3,2X,'GB=',E10.3)
+        IF(PSRAN(B10).GT.GB)GOTO 1
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)PSZSIM
+202     FORMAT(2X,'PSZSIM=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE IXXDEF(ICH,IC1,IC2,ICZ)
+c Determination of parton flavours in forward and backward direction -
+c for valence quark hard scattering
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA11/ B10
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+      SAVE
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)ICH,ICZ
+201     FORMAT(2X,'IXXDEF: HADRON TYPE ICH=',I2,' AUXILLIARY TYPE ICZ='
+     *  ,I1)
+        IS=IABS(ICH)/ICH
+        IF(ICZ.EQ.1)THEN
+          IC1=ICH*(1-3*INT(.5+PSRAN(B10)))
+          ICH1=ICH*INT(.5D0+PSRAN(B10))
+          IC2=-IC1*IABS(ICH1)-(ICH+IC1)*IABS(ICH-ICH1)
+
+        ELSEIF(ICZ.EQ.2)THEN
+c Valence quark type simulation ( for the proton )
+          IC1=INT(1.3333+PSRAN(B10))
+c Leading nucleon type simulation ( flavors combinatorics )
+          ICH1=(2-IC1)*INT(PSRAN(B10)+.5)+2
+c The type of the parton at the end of the rest string ( after the
+c leading nucleon ejection )
+          IC2=(3-ICH1)*(2-IC1)-2
+
+          IF(IABS(ICH).EQ.3)THEN
+            IC1=3-IC1
+            IC2=-3-IC2
+            ICH1=5-ICH1
+          ENDIF
+          IF(ICH.LT.0)THEN
+            IC1=-IC1
+            IC2=-IC2
+            ICH1=-ICH1
+          ENDIF
+
+        ELSEIF(ICZ.EQ.3)THEN
+          IC1=ICH-3*IS
+          IC2=-IS*INT(1.5+PSRAN(B10))
+          ICH1=3*IS-IC2
+        ELSEIF(ICZ.EQ.4)THEN
+          IC1=ICH-9*IS
+          IC2=IS*INT(1.5+PSRAN(B10))
+          ICH1=9*IS-IC2
+        ELSEIF(ICZ.EQ.5)THEN
+          IC1=IS*INT(1.5+PSRAN(B10))
+          IC2=-IC1
+          ICH1=ICH
+        ENDIF
+
+        ICH=ICH1
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)IC1,IC2,ICH
+202     FORMAT(2X,'IXXDEF-END: PARTON FLAVORS IC1=',I2,' IC2=',I2,
+     *  'NEW HADRON TYPE ICH=',I2)
+        RETURN
+        END
+C=======================================================================
+
+      FUNCTION IXXSON(NS,AW,G)
+c Poisson distribution:
+c AW - average value,
+c NS-1 - maximal allowed value,
+c G - random number
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)NS-1,AW,G
+201     FORMAT(2X,'IXXSON - POISSON DITR.: AVERAGE AW=',E10.3,
+     *  ' MAXIMAL VALUE NS=',I2,' RANDOM NUMBER G=',E10.3)
+      W=EXP(-AW)
+        SUMM=W
+        DO 1 I=1,NS
+        IF(G.LT.SUMM)GOTO 2
+        W=W*AW/I
+1       SUMM=SUMM+W
+2       IXXSON=I-1
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)IXXSON
+202     FORMAT(2X,'IXXSON=',I2)
+        RETURN
+        END
+C=======================================================================
+
+      SUBROUTINE XXAINI(E0N,ICP0,IAP,IAT)
+c Additional initialization procedure
+c-----------------------------------------------------------------------
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      INTEGER DEBUG
+******************************************************
+      DIMENSION WK(3),WA(3)
+******************************************************
+      COMMON /AREA1/  IA(2),ICZ,ICP
+      COMMON /AREA2/  S,Y0,WP0,WM0
+      COMMON /AREA4/  EY0(3)
+      COMMON /AREA5/  RD(2),CR1(2),CR2(2),CR3(2)
+      COMMON /AREA6/  PI,BM,AM
+      COMMON /AREA7/  RP1
+      COMMON /AREA10/ STMASS,AM0,AMN,AMK,AMC,AMLAMC,AMLAM,AMETA
+      COMMON /AREA15/ FP(5),RQ(5),CD(5)
+      COMMON /AREA17/ DEL,RS,RS0,FS,ALFP,RR,SH,DELH
+      COMMON /AREA22/ SJV,FJS(5,3)
+      COMMON /AREA35/  SJV0(10,5),FJS0(10,5,15)
+      COMMON /AREA43/ MONIOU
+******************************************************
+      COMMON /AREA44/ GZ(10,5,4)
+      COMMON /AREA45/ GDT
+******************************************************
+      COMMON /DEBUG/  DEBUG
+
+        IF(DEBUG.GE.1)WRITE (MONIOU,201)ICP0,IAP,IAT,E0N
+201     FORMAT(2X,'XXAINI - MINIINITIALIZATION: PARTICLE TYPE ICP0=',
+     *  I1,2X,'PROJECTILE MASS NUMBER IAP=',I2/4X,
+     *  'TARGET MASS NUMBER IAT=',I2,' INTERACTION ENERGY E0N=',E10.3)
+      ICP=ICP0
+      IA(1)=IAP
+      IA(2)=IAT
+c ICZ - auxiliary type for the primary particle (1- pion, 2 - nucleon, 3 - kaon,
+c 4 - D-meson, 5 - Lambda_C)
+      IF(IABS(ICP).LT.6)THEN
+        ICZ=IABS(ICP)/2+1
+      ELSE
+        ICZ=(IABS(ICP)+1)/2
+      ENDIF
+
+c Energy dependent factors:
+c WP0, WM0 - initial light cone momenta for the interaction (E+-p)
+      S=2.D0*E0N*AMN
+      WP0=DSQRT(S)
+      WM0=WP0
+c Y0 - total rapidity range for the interaction
+      Y0=DLOG(S)
+c RS - soft pomeron elastic scattering slope (lambda_ab)
+      RS=RQ(ICZ)+ALFP*Y0
+c RS0 - initial slope (sum of the pomeron-hadron vertices slopes squared - R_ab)
+      RS0=RQ(ICZ)
+c FS - factor for pomeron eikonal calculation (gamma_ab * s**del /lambda_ab * C_ab
+      FS=FP(ICZ)*EXP(Y0*DEL)/RS*CD(ICZ)
+c RP1 - factor for the impact parameter dependence of the eikonal ( in fm>2 )
+      RP1=RS*4.D0*.0391D0/AM**2
+
+      EY0(2)=1.D0
+      EY0(3)=1.D0
+      EY0(1)=DSQRT(AMN/E0N/2.D0)
+
+c-------------------------------------------------
+c Nuclear radii and weights for nuclear configurations simulation - procedure GEA
+      DO 1 I=1,2
+c RD(I) - Wood-Saxon density radius (fit to the data of Murthy et al.)
+      RD(I)=0.7D0*FLOAT(IA(I))**.446/AM
+      CR1(I)=1.D0+3.D0/RD(I)+6.D0/RD(I)**2+6.D0/RD(I)**3
+      CR2(I)=3.D0/RD(I)
+      CR3(I)=3.D0/RD(I)+6.D0/RD(I)**2
+      IF(IA(I).LT.10.AND.IA(I).NE.1)THEN
+c RD(I) - gaussian density radius (for light nucleus)
+        RD(I)=.9D0*FLOAT(IA(I))**.3333/AM
+        IF(IA(I).EQ.2)RD(I)=3.16D0
+c RD -> RD * A / (A-1) - to use Van Hove simulation method - procedure GEA
+        RD(I)=RD(I)*DSQRT(2.D0*IA(I)/(IA(I)-1.))
+      ENDIF
+1     CONTINUE
+
+      GDT=0.D0
+c-------------------------------------------------
+c Impact parameter cutoff setting
+c-------------------------------------------------
+      IF(IA(1).NE.1)THEN
+c Primary nucleus:
+c Impact parameter cutoff value ( only impact parameters less than BM are
+c simulated; probability to have larger impact parameter is less than 1% )
+        BM=RD(1)+RD(2)+5.D0
+      ELSE
+c Hadron-nucleus interaction
+c BM - impact parameter cutoff value
+        BM=RD(2)+5.D0
+      ENDIF
+
+      YE=DLOG10(E0N)
+      IF(YE.LT.1.D0)YE=1.D0
+      JE=INT(YE)
+      IF(JE.GT.8)JE=8
+
+******************************************************
+      WK(2)=YE-JE
+      WK(3)=WK(2)*(WK(2)-1.D0)*.5D0
+      WK(1)=1.D0-WK(2)+WK(3)
+      WK(2)=WK(2)-2.D0*WK(3)
+
+      SJV=SJV0(JE,ICZ)*WK(1)+SJV0(JE+1,ICZ)*WK(2)+SJV0(JE+2,ICZ)*WK(3)
+
+      DO 2 I=1,5
+      DO 2 M=1,3
+      M1=M+3*(ICZ-1)
+2     FJS(I,M)=FJS0(JE,I,M1)*WK(1)+FJS0(JE+1,I,M1)*WK(2)+
+     *FJS0(JE+2,I,M1)*WK(3)
+
+      GDT=0.D0
+      IF(IA(1).EQ.1)THEN
+        YA=IA(2)
+        YA=DLOG(YA)/1.38629D0+1.D0
+        JA=MIN(INT(YA),2)
+        WA(2)=YA-JA
+        WA(3)=WA(2)*(WA(2)-1.D0)*.5D0
+        WA(1)=1.D0-WA(2)+WA(3)
+        WA(2)=WA(2)-2.D0*WA(3)
+        DO 3 I=1,3
+        DO 3 M=1,3
+3       GDT=GDT+GZ(JE+I-1,ICZ,JA+M-1)*WK(I)*WA(M)
+      ENDIF
+c        write (*,*)'gdt=',gdt
+******************************************************
+
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'XXAINI - END')
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE XXASET
+c Particular model parameters setting
+c-----------------------------------------------------------------------
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      INTEGER DEBUG
+      CHARACTER *2 TYQ
+      COMMON /AREA3/  RMIN,EMAX,EEV
+      COMMON /AREA6/  PI,BM,AM
+      COMMON /AREA8/  WWM,BE(4),DC(5),DETA,ALMPT
+      COMMON /AREA10/ STMASS,AM0,AMN,AMK,AMC,AMLAMC,AMLAM,AMETA
+      COMMON /AREA11/ B10
+      COMMON /AREA20/ WPPP
+      COMMON /AREA21/ DMMIN(5)
+      COMMON /AREA28/ ARR(4)
+      COMMON /AREA40/ JDIFR
+      COMMON /AREA42/ TYQ(15)
+      COMMON /AREA43/ MONIOU
+      COMMON /DEBUG/  DEBUG
+
+        IF(DEBUG.GE.1)WRITE (MONIOU,201)
+201     FORMAT(2X,'XXASET - HADRONIZATION PARAMETERS SETTING')
+c Regge intercepts for the uu~, qqq~q~, us~, uc~ trajectories
+      ARR(1)=0.5D0
+      ARR(2)=-.5D0
+      ARR(3)=0.D0
+      ARR(4)=-2.D0
+c WPPP - Triple pomeron interaction probability (for two cut pomerons and cut
+c between them)
+      WPPP=0.4d0
+c      WPPP=0.d0
+c JDIFR - flag for the low mass diffraction (for JDIFR=0 not considered)
+      JDIFR=1
+
+c-------------------------------------------------
+c Parameters for the soft fragmentation:
+c DC(i) - relative probabilities for udu~d~(i=1), ss~(i=2), cc~(i=3)-pairs creation
+c from the vacuum for the quark (u,d,u~,d~) fragmentation;
+c ss~(i=4), cc~(i=5) - for the diquark (ud, u~d~) fragmentation
+      DC(1)=.06D0
+      DC(2)=.10D0
+*     DC(3)=.0003D0     ! To switch off charmed particles set to 0.000
+      DC(3)=.000D0
+      DC(4)=.36D0
+*     DC(5)=.01D0     ! To switch off charmed particles set to 0.000
+      DC(5)=.0D0
+cc  DETA - ratio of etas production density to all pions production density (1/9)
+      DETA=.11111D0
+c WWM defines mass threshold for string to decay into three or more hadrons
+c ( ajustable parameter for string fragmentation )
+      WWM=.53D0
+c BE(i) - parameter for Pt distribution (exponential) for uu~(dd~), ss~, qqq~q~,
+c cc~ pairs respectively (for the soft fragmentation)
+      BE(1)=.22D0
+      BE(2)=.35D0
+      BE(3)=.29D0
+      BE(4)=.40D0
+c ALMPT - parameter for the fragmentation functions (soft ones):
+c ALMPT = 1 + 2 * alfa_R * <pt**2> (Kaidalov proposed 0.5 value for ALMPT-1,
+c Sov.J.Nucl.Phys.,1987))
+      ALMPT=1.7D0
+
+c-------------------------------------------------
+c Parameters for nuclear spectator part fragmentation:
+c RMIN - coupling radius squared (fm>2),
+c EMAX - relative critical energy ( divided per mean excitation energy (~12.5 Mev)),
+c EEV - relative evaporation energy ( divided per mean excitation energy (~12.5 Mev))
+      RMIN=3.35D0
+      EMAX=.11D0
+      EEV=.25D0
+
+c-------------------------------------------------
+c DMMIN(i) - minimal diffractive mass for low-mass diffraction for pion, nucleon,
+c kaon, D-meson, Lambda_C corresp.
+      DMMIN(1)=.76D0
+      DMMIN(2)=1.24D0
+      DMMIN(3)=.89D0
+      DMMIN(4)=2.01D0
+      DMMIN(5)=2.45D0
+c Proton, kaon, pion, D-meson, Lambda, Lambda_C, eta masses
+      AMN=.939D0
+      AMK=.496D0
+      AM0=.14D0
+      AMC=1.868D0
+      AMLAM=1.116D0
+      AMLAMC=2.27D0
+      AMETA=.548D0
+
+c-------------------------------------------------
+c B10 - initial value of the pseudorandom number,
+c PI  - pi-number
+c AM  - diffusive radius for the Saxon-Wood nuclear density parametrization
+      B10=.43876194D0
+      PI=3.1416D0
+      AM=.523D0
+
+C STMASS - minimal string mass to produce secondary particles
+      STMASS=4.D0*AM0**2
+c Here and below all radii, distances and so on are divided by AM.
+      RMIN=RMIN/AM**2
+
+      TYQ(1)='DD'
+      TYQ(2)='UU'
+      TYQ(3)='C '
+      TYQ(4)='S '
+      TYQ(5)='UD '
+      TYQ(6)='D '
+      TYQ(7)='U '
+      TYQ(8)='G '
+      TYQ(9)='u '
+      TYQ(10)='d '
+      TYQ(11)='ud'
+      TYQ(12)='s '
+      TYQ(13)='c '
+      TYQ(14)='uu'
+      TYQ(15)='dd'
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'XXASET - END')
+      RETURN
+      END
+C=======================================================================
+
+        SUBROUTINE XXDDFR(WP0,WM0,ICP,ICT)
+c Double diffractive dissociation
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EP3(4),EP1(4),EP2(4),EY(3)
+        COMMON /AREA1/  IA(2),ICZ,ICP0
+        COMMON /AREA2/  S,Y0,WP00,WM00
+        COMMON /AREA8/  WWM,BE(4),DC(5),DETA,ALMPT
+        COMMON /AREA10/ STMASS,AM(7)
+        COMMON /AREA11/ B10
+        COMMON /AREA21/ DMMIN(5)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)ICP,ICT,WP0,WM0
+201     FORMAT(2X,'XXDDFR - LEADING CLUSTERS HADRONIZATION:'
+     *  /4X,'CLUSTER TYPES ICP=',I2,2X,
+     *  'ICT=',I2/4X,'AVAILABLE LIGHT CONE MOMENTA: WP0=',E10.3,
+     *  ' WM0=',E10.3)
+        DO 100 I=1,3
+100     EY(I)=1.D0
+
+        SD0=WP0*WM0
+        IF(SD0.LT.0.D0)SD0=0.D0
+        DDMIN1=DMMIN(ICZ)
+        DDMIN2=DMMIN(2)
+        DDMAX1=MIN(5.D0,DSQRT(SD0)-DDMIN2)
+
+        IF(DDMAX1.LT.DDMIN1)THEN
+c Registration of too slow "leading" hadron if its energy is insufficient for
+c diffractive exhitation
+          IF(DSQRT(SD0).LT.AM(ICZ)+AM(2))THEN
+            IF(WP0.GT.0.D0.AND.(AM(ICZ)+AM(2))**2/WP0.LT..5D0*WM00)THEN
+              SD0=(AM(ICZ)+AM(2))**2
+              WM0=SD0/WP0
+            ELSE
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+              RETURN
+            ENDIF
+          ENDIF
+
+          EP3(3)=0.D0
+          EP3(4)=0.D0
+          XW=XXTWDEC(SD0,AM(ICZ)**2,AM(2)**2)
+          WP1=XW*WP0
+          WM1=AM(ICZ)**2/WP1
+          EP3(1)=.5D0*(WP1+WM1)
+          EP3(2)=.5D0*(WP1-WM1)
+          CALL XXREG(EP3,ICP)
+          WM2=WM0-WM1
+          WP2=AM(2)**2/WM2
+          EP3(1)=.5D0*(WP2+WM2)
+          EP3(2)=.5D0*(WP2-WM2)
+          CALL XXREG(EP3,ICT)
+          WP0=0.D0
+          WM0=0.D0
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+          RETURN
+        ENDIF
+
+        DMASS1=(DDMIN1/(1.D0-PSRAN(B10)*(1.D0-DDMIN1/DDMAX1)))**2
+        DDMAX2=MIN(5.D0,DSQRT(SD0)-DSQRT(DMASS1))
+        DMASS2=(DDMIN2/(1.D0-PSRAN(B10)*(1.D0-DDMIN2/DDMAX2)))**2
+
+        WPD1=WP0*XXTWDEC(SD0,DMASS1,DMASS2)
+        WMD1=DMASS1/WPD1
+        WMD2=WM0-WMD1
+        WPD2=DMASS2/WMD2
+
+        IF(ICP.NE.0)IS=IABS(ICP)/ICP
+        IF(ICZ.EQ.5)THEN
+          ICH1=ICP
+          ICH2=0
+          AMH1=AM(5)**2
+          AMH2=AM(1)**2
+
+          PTMAX=PSLAM(DMASS1,AMH1,AMH2)
+          IF(PTMAX.LT.0.)PTMAX=0.
+          IF(PTMAX.LT.BE(4)**2)THEN
+1           PTI=PTMAX*PSRAN(B10)
+            IF(PSRAN(B10).GT.EXP(-DSQRT(PTI)/BE(4)))GOTO 1
+          ELSE
+2           PTI=(BE(4)*DLOG(PSRAN(B10)*PSRAN(B10)))**2
+            IF(PTI.GT.PTMAX)GOTO 2
+          ENDIF
+          AMT1=AMH1+PTI
+          AMT2=AMH2+PTI
+          Z=XXTWDEC(DMASS1,AMT1,AMT2)
+          WP1=WPD1*Z
+          WM1=AMT1/WP1
+          EP3(1)=.5D0*(WP1+WM1)
+          EP3(2)=.5D0*(WP1-WM1)
+          PT=DSQRT(PTI)
+          CALL PSCS(C,S)
+          EP3(3)=PT*C
+          EP3(4)=PT*S
+          CALL XXREG(EP3,ICH1)
+
+          WP1=WPD1*(1.D0-Z)
+          WM1=AMT2/WP1
+          EP3(1)=.5D0*(WP1+WM1)
+          EP3(2)=.5D0*(WP1-WM1)
+          EP3(3)=-PT*C
+          EP3(4)=-PT*S
+          CALL XXREG(EP3,ICH2)
+          GOTO 3
+        ENDIF
+
+        IF(ICZ.EQ.1)THEN
+          IF(ICP.NE.0)THEN
+            IC1=ICP*(1-3*INT(.5D0+PSRAN(B10)))
+            IC2=-ICP-IC1
+          ELSE
+            IC1=INT(1.5D0+PSRAN(B10))*(2*INT(.5D0+PSRAN(B10))-1)
+            IC2=-IC1
+          ENDIF
+        ELSEIF(ICZ.EQ.2)THEN
+          IF(PSRAN(B10).GT..33333D0)THEN
+            IC1=3*IS
+            IC2=ICP-IS
+          ELSE
+            IC1=ICP+4*IS
+            IC2=4*IS-ICP
+          ENDIF
+        ELSEIF(ICZ.EQ.3)THEN
+          IC1=-4*IS
+          IC2=ICP-3*IS
+        ELSEIF(ICZ.EQ.4)THEN
+          IC1=5*IS
+          IC2=ICP-9*IS
+        ENDIF
+        CALL XXGENER(WPD1,WMD1,EY,0.D0,1.D0,0.D0,1.D0,IC1,IC2)
+
+3       CONTINUE
+        IS=IABS(ICT)/ICT
+        IF(PSRAN(B10).GT..33333D0)THEN
+          IC1=3*IS
+          IC2=ICT-IS
+        ELSE
+          IC1=ICT+4*IS
+          IC2=4*IS-ICT
+        ENDIF
+        CALL XXGENER(WPD2,WMD2,EY,0.D0,1.D0,0.D0,1.D0,IC2,IC1)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'XXDDFR - END')
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE XXDEC2(EP,EP1,EP2,WW,A,B)
+c Two particle decay
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        dimension ep(4),ep1(4),ep2(4),EY(3)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        COMMON /AREA11/ B10
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)
+201     FORMAT(2X,'XXDEC2 - TWO PARTICLE DECAY')
+
+        PL=PSLAM(WW,A,B)
+        EP1(1)=DSQRT(PL+A)
+        EP2(1)=DSQRT(PL+B)
+        PL=DSQRT(PL)
+        COSZ=2.D0*PSRAN(B10)-1.D0
+        PT=PL*DSQRT(1.D0-COSZ**2)
+        EP1(2)=PL*COSZ
+        CALL PSCS(C,S)
+        EP1(3)=PT*C
+        EP1(4)=PT*S
+        do 1 I=2,4
+1       EP2(I)=-EP1(I)
+        CALL PSDEFTR(WW,EP,EY)
+        CALL PSTRANS(EP1,EY)
+        CALL PSTRANS(EP2,EY)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'XXDEC2 - END')
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE XXDEC3(EP,EP1,EP2,EP3,SWW,AM1,AM2,AM3)
+
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EP(4),EP1(4),EP2(4),EP3(4),EPT(4),EY(3)
+        COMMON/AREA11/B10
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)
+201     FORMAT(2X,'XXDEC3 - THREE PARTICLE DECAY')
+        AM12=AM1**2
+        AM23=(AM2+AM3)**2
+        AM32=(AM2-AM3)**2
+        S23MAX=(SWW-AM1)**2
+        EMAX=.25D0*(SWW+(AM12-AM23)/SWW)**2
+        GB0=DSQRT((EMAX-AM12)/EMAX*(1.D0-AM23/S23MAX)
+     *  *(1.D0-AM32/S23MAX))
+1       P1=PSRAN(B10)*(EMAX-AM12)
+        E1=DSQRT(P1+AM12)
+        S23=SWW**2+AM12-2.D0*E1*SWW
+        GB=DSQRT(P1*(1.D0-AM23/S23)*(1.D0-AM32/S23))/E1/GB0
+        IF(PSRAN(B10).GT.GB)GOTO 1
+
+        P1=DSQRT(P1)
+        EP1(1)=E1
+        COSZ=2.D0*PSRAN(B10)-1.D0
+        PT=P1*DSQRT(1.D0-COSZ**2)
+        EP1(2)=P1*COSZ
+        CALL PSCS(C,S)
+        EP1(3)=PT*C
+        EP1(4)=PT*S
+        do 2 I=2,4
+2       EPT(I)=-EP1(I)
+        EPT(1)=SWW-EP1(1)
+        CALL PSDEFTR(SWW**2,EP,EY)
+        CALL PSTRANS(EP1,EY)
+        CALL PSTRANS(EPT,EY)
+
+        CALL XXDEC2(EPT,EP2,EP3,S23,AM2**2,AM3**2)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'XXDEC3 - END')
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE XXDPR(WP0,WM0,ICP,ICT,LQ2)
+c Projectile hadron dissociation
+c Leading hadronic state hadronization
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EP3(4),EP1(4),EP2(4),EY(3)
+        COMMON /AREA1/  IA(2),ICZ,ICP0
+        COMMON /AREA2/  S,Y0,WP00,WM00
+        COMMON /AREA8/  WWM,BE(4),DC(5),DETA,ALMPT
+        COMMON /AREA10/ STMASS,AM(7)
+        COMMON /AREA11/ B10
+        COMMON /AREA17/ DEL,RS,RS0,FS,ALFP,RR,SH,DELH
+        COMMON /AREA21/ DMMIN(5)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)ICP,ICT,WP0,WM0
+201     FORMAT(2X,'XXDPR - LEADING (PROJECTILE) CLUSTER HADRONIZATION:'
+     *  /4X,'CLUSTER TYPE ICP=',I2,2X,'TARGET TYPE ',
+     *  'ICT=',I2/4X,'AVAILABLE LIGHT CONE MOMENTA: WP0=',E10.3,
+     *  ' WM0=',E10.3)
+        DO 100 I=1,3
+100     EY(I)=1.D0
+
+        SD0=WP0*WM0
+        IF(SD0.LT.0.D0)SD0=0.D0
+        DDMAX=MIN(5.D0,DSQRT(SD0)-AM(2))
+        DDMIN=DMMIN(ICZ)
+
+        IF(DDMAX.LT.DDMIN)THEN
+c Registration of too slow "leading" hadron if its energy is insufficient for
+c diffractive exhitation
+          EP3(3)=0.D0
+          EP3(4)=0.D0
+
+          IF(LQ2.NE.0)THEN
+            WPI=WP0
+            IF(AM(ICZ)**2.GT.WPI*WM0)THEN
+              IF(WPI.GT.0.D0.AND.AM(ICZ)**2/WPI.LT..5D0*WM00)THEN
+                WMI=AM(ICZ)**2/WPI
+                WM0=WMI
+              ELSE
+                RETURN
+              ENDIF
+            ENDIF
+            WM0=WM0-WMI
+            WP0=0.D0
+            EP3(1)=.5D0*(WPI+WMI)
+            EP3(2)=.5D0*(WPI-WMI)
+            CALL XXREG(EP3,ICP)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+            RETURN
+          ELSE
+
+            IF(DSQRT(SD0).LT.AM(ICZ)+AM(2))THEN
+              IF(WP0.GT.0.D0.AND.(AM(ICZ)+AM(2))**2/WP0.LT..5D0*WM00)
+     *        THEN
+                SD0=(AM(ICZ)+AM(2))**2
+                WM0=SD0/WP0
+              ELSE
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+                RETURN
+              ENDIF
+            ENDIF
+            XW=XXTWDEC(SD0,AM(ICZ)**2,AM(2)**2)
+            WP1=XW*WP0
+            WM1=AM(ICZ)**2/WP1
+            EP3(1)=.5D0*(WP1+WM1)
+            EP3(2)=.5D0*(WP1-WM1)
+            CALL XXREG(EP3,ICP)
+            WM2=WM0-WM1
+            WP2=AM(2)**2/WM2
+            EP3(1)=.5D0*(WP2+WM2)
+            EP3(2)=.5D0*(WP2-WM2)
+            CALL XXREG(EP3,ICT)
+            WP0=0.D0
+            WM0=0.D0
+          ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+          RETURN
+        ENDIF
+
+        IF(ICP.NE.0)IS=IABS(ICP)/ICP
+
+        DMASS=DDMIN**2/(1.D0-PSRAN(B10)*(1.D0-(DDMIN/DDMAX)))**2
+
+        IF(LQ2.NE.0)THEN
+          WPD=WP0
+          WMD=DMASS/WPD
+          WM0=WM0-WMD
+          WP0=0.D0
+        ELSE
+        IF(ICZ.EQ.5)THEN
+          WPD=WP0*XXTWDEC(SD0,DMASS,AM(2)**2)
+          WMD=DMASS/WPD
+          WM2=WM0-WMD
+          WP2=AM(2)**2/WM2
+          EP3(1)=.5D0*(WP2+WM2)
+          EP3(2)=.5D0*(WP2-WM2)
+          EP3(3)=0.D0
+          EP3(4)=0.D0
+          CALL XXREG(EP3,ICT)
+        ELSE
+          PTMAX=PSLAM(SD0,DMASS,AM(2)**2)
+          IF(PTMAX.LT.0.)PTMAX=0.
+          PTI=-1.D0/RS*DLOG(1.D0-PSRAN(B10)*(1.D0-EXP(-RS*PTMAX)))
+
+          AMT1=DMASS+PTI
+          AMT2=AM(2)**2+PTI
+          WPD=WP0*XXTWDEC(SD0,AMT1,AMT2)
+          WMD=AMT1/WPD
+          WM2=WM0-WMD
+          WP2=AMT2/WM2
+          PT=DSQRT(PTI)
+          CALL PSCS(CCOS,SSIN)
+          EP3(3)=PT*CCOS
+          EP3(4)=PT*SSIN
+          EP3(1)=.5D0*(WP2+WM2)
+          EP3(2)=.5D0*(WP2-WM2)
+          CALL XXREG(EP3,ICT)
+          EP3(3)=-EP3(3)
+          EP3(4)=-EP3(4)
+          EP3(1)=.5D0*(WPD+WMD)
+          EP3(2)=.5D0*(WPD-WMD)
+          CALL PSDEFTR(DMASS,EP3,EY)
+          WPD=DSQRT(DMASS)
+          WMD=WPD
+        ENDIF
+          WP0=0.D0
+          WM0=0.D0
+        ENDIF
+
+        IF(ICZ.EQ.5)THEN
+          ICH1=ICP
+          ICH2=0
+          AMH1=AM(5)**2
+          AMH2=AM(1)**2
+
+          PTMAX=PSLAM(DMASS,AMH1,AMH2)
+          IF(PTMAX.LT.0.)PTMAX=0.
+          IF(PTMAX.LT.BE(4)**2)THEN
+1           PTI=PTMAX*PSRAN(B10)
+            IF(PSRAN(B10).GT.EXP(-DSQRT(PTI)/BE(4)))GOTO 1
+          ELSE
+2           PTI=(BE(4)*DLOG(PSRAN(B10)*PSRAN(B10)))**2
+            IF(PTI.GT.PTMAX)GOTO 2
+          ENDIF
+          AMT1=AMH1+PTI
+          AMT2=AMH2+PTI
+          Z=XXTWDEC(DMASS,AMT1,AMT2)
+          WP1=WPD*Z
+          WM1=AMT1/WP1
+          EP3(1)=.5D0*(WP1+WM1)
+          EP3(2)=.5D0*(WP1-WM1)
+          PT=DSQRT(PTI)
+          CALL PSCS(C,S)
+          EP3(3)=PT*C
+          EP3(4)=PT*S
+          CALL XXREG(EP3,ICH1)
+
+          WP1=WPD*(1.D0-Z)
+          WM1=AMT2/WP1
+          EP3(1)=.5D0*(WP1+WM1)
+          EP3(2)=.5D0*(WP1-WM1)
+          EP3(3)=-PT*C
+          EP3(4)=-PT*S
+          CALL XXREG(EP3,ICH2)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+          RETURN
+        ENDIF
+
+        IF(ICZ.EQ.1)THEN
+          IF(ICP.NE.0)THEN
+            IC1=ICP*(1-3*INT(.5D0+PSRAN(B10)))
+            IC2=-ICP-IC1
+          ELSE
+            IC1=INT(1.5D0+PSRAN(B10))*(2*INT(.5D0+PSRAN(B10))-1)
+            IC2=-IC1
+          ENDIF
+        ELSEIF(ICZ.EQ.2)THEN
+          IF(PSRAN(B10).GT..33333D0)THEN
+            IC1=3*IS
+            IC2=ICP-IS
+          ELSE
+            IC1=ICP+4*IS
+            IC2=4*IS-ICP
+          ENDIF
+        ELSEIF(ICZ.EQ.3)THEN
+          IC1=-4*IS
+          IC2=ICP-3*IS
+        ELSEIF(ICZ.EQ.4)THEN
+          IC1=5*IS
+          IC2=ICP-9*IS
+        ENDIF
+        CALL XXGENER(WPD,WMD,EY,0.D0,1.D0,0.D0,1.D0,
+     *  IC1,IC2)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'XXDPR - END')
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE XXDTG(WP0,WM0,ICP,ICT,LQ1)
+c Target nucleon dissociation 
+c Leading hadronic state hadronization
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EP3(4),EY(3)
+        COMMON /AREA1/  IA(2),ICZ,ICP0
+        COMMON /AREA2/  S,Y0,WP00,WM00
+        COMMON /AREA10/ STMASS,AM(7)
+        COMMON /AREA11/ B10
+        COMMON /AREA17/ DEL,RS,RS0,FS,ALFP,RR,SH,DELH
+        COMMON /AREA21/ DMMIN(5)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)ICT,ICP,WP0,WM0
+201     FORMAT(2X,'XXDTG - LEADING (TARGET) CLUSTER HADRONIZATION:'
+     *  /4X,'CLUSTER TYPE ICT=',I2,2X,'PROJECTILE TYPE ',
+     *  'ICP=',I2/4X,'AVAILABLE LIGHT CONE MOMENTA: WP0=',E10.3,
+     *  ' WM0=',E10.3)
+        DO 100 I=1,3
+100     EY(I)=1.D0
+
+        SD0=WP0*WM0
+        IF(SD0.LT.0.D0)SD0=0.D0
+        DDMIN=DMMIN(2)
+        DDMAX=MIN(5.D0,DSQRT(SD0)-AM(ICZ))
+
+        IF(DDMAX.LT.DDMIN)THEN
+c Registration of too slow "leading" hadron if its energy is insufficient for
+c diffractive exhitation
+          EP3(3)=0.D0
+          EP3(4)=0.D0
+
+          IF(LQ1.NE.0)THEN
+            WMI=WM0
+            IF( WP0.LE.0.D0.OR.AM(2)**2.GT.WMI*WP0)RETURN
+            WPI=AM(2)**2/WMI
+            WP0=WP0-WPI
+            WM0=0.D0
+            EP3(1)=.5D0*(WPI+WMI)
+            EP3(2)=.5D0*(WPI-WMI)
+            CALL XXREG(EP3,ICT)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+            RETURN
+          ELSE
+
+            IF(DSQRT(SD0).LT.AM(ICZ)+AM(2))THEN
+              IF(WP0.GT.0.D0.AND.(AM(ICZ)+AM(2))**2/WP0.LT..5D0*WM00)
+     *        THEN
+                SD0=(AM(ICZ)+AM(2))**2
+                WM0=SD0/WP0
+              ELSE
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+                RETURN
+              ENDIF
+            ENDIF
+            XW=XXTWDEC(SD0,AM(ICZ)**2,AM(2)**2)
+            WP1=XW*WP0
+            WM1=AM(ICZ)**2/WP1
+            EP3(1)=.5D0*(WP1+WM1)
+            EP3(2)=.5D0*(WP1-WM1)
+            CALL XXREG(EP3,ICP)
+            WM2=WM0-WM1
+            WP2=AM(2)**2/WM2
+            EP3(1)=.5D0*(WP2+WM2)
+            EP3(2)=.5D0*(WP2-WM2)
+            CALL XXREG(EP3,ICT)
+            WP0=0.D0
+            WM0=0.D0
+          ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+          RETURN
+        ENDIF
+
+        DMASS=(DDMIN/(1.D0-PSRAN(B10)*(1.D0-DDMIN/DDMAX)))**2
+        IF(LQ1.NE.0)THEN
+          WMD=WM0
+          WPD=DMASS/WMD
+          WP0=WP0-WPD
+          WM0=0.D0
+        ELSE
+          PTMAX=PSLAM(SD0,DMASS,AM(ICZ)**2)
+          IF(PTMAX.LT.0.)PTMAX=0.
+          PTI=-1.D0/RS*DLOG(1.D0-PSRAN(B10)*(1.D0-EXP(-RS*PTMAX)))
+
+          AMT1=DMASS+PTI
+          AMT2=AM(ICZ)**2+PTI
+          WMD=WM0*XXTWDEC(SD0,AMT1,AMT2)
+          WPD=AMT1/WMD
+          WP2=WP0-WPD
+          WM2=AMT2/WP2
+          PT=DSQRT(PTI)
+          CALL PSCS(CCOS,SSIN)
+          EP3(3)=PT*CCOS
+          EP3(4)=PT*SSIN
+          EP3(1)=.5D0*(WP2+WM2)
+          EP3(2)=.5D0*(WP2-WM2)
+          CALL XXREG(EP3,ICP)
+          EP3(3)=-EP3(3)
+          EP3(4)=-EP3(4)
+          EP3(1)=.5D0*(WPD+WMD)
+          EP3(2)=.5D0*(WPD-WMD)
+          CALL PSDEFTR(DMASS,EP3,EY)
+          WPD=DSQRT(DMASS)
+          WMD=WPD
+          WP0=0.D0
+          WM0=0.D0
+        ENDIF
+
+        IS=IABS(ICT)/ICT
+        IF(PSRAN(B10).GT..33333D0)THEN
+          IC1=3*IS
+          IC2=ICT-IS
+        ELSE
+          IC1=ICT+4*IS
+          IC2=4*IS-ICT
+        ENDIF
+        CALL XXGENER(WPD,WMD,EY,
+     *  0.D0,1.D0,0.D0,1.D0,IC2,IC1)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'XXDTG - END')
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE XXFAU(B,GZ)
+c Integrands for hadron-hadron and hadron-nucleus cross-sections calculation
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION GZ(3),GZ0(2)
+        COMMON /AREA1/  IA(2),ICZ,ICP
+        COMMON /AREA16/ CC(5)
+        COMMON /AR1/    ANORM
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)
+201     FORMAT(2X,'XXFAU - INTEGRANDS FOR HADRON-HADRON AND '
+     *  'HADRON-NUCLEUS CROSS-SECTIONS CALCULATION')
+
+        CALL XXFZ(B,GZ0)
+        DO 1 L=1,2
+1       GZ0(L)=GZ0(L)*CC(2)*ANORM*.5D0
+
+        AB=FLOAT(IA(2))
+
+        GZ1=(1.D0-GZ0(1))**AB
+        GZ2=(1.D0-GZ0(2))**AB
+        GZ3=(1.D0-CC(2)*GZ0(2)-2.D0*(1.D0-CC(2))*GZ0(1))**AB
+
+
+        GZ(1)=CC(ICZ)**2*(GZ2-GZ3)
+        GZ(2)=CC(ICZ)*(1.D0-CC(ICZ))*(1.D0+GZ2-2.D0*GZ1)
+        GZ(3)=CC(ICZ)*(1.D0-GZ2)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'XXFAU - END')
+        RETURN
+        END
+C=======================================================================
+
+         SUBROUTINE XXFRAG(SA,NA,RC)
+c Connected nucleon clasters extraction - used for the nuclear spectator part
+c multifragmentation:
+c-----------------------------------------------------------------------
+         IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+         INTEGER DEBUG
+         DIMENSION SA(56,3)
+         COMMON /AREA13/ NSF,IAF(56)
+         COMMON /AREA43/ MONIOU
+         COMMON /DEBUG/  DEBUG
+         SAVE
+         IF(DEBUG.GE.2)WRITE (MONIOU,201)NA
+201      FORMAT(2X,'XXFRAG-MULTIFRAGMENTATION: NUCLEUS MASS NUMBER: NA='
+     *   ,I2)
+         IF(DEBUG.GE.3)THEN
+           WRITE (MONIOU,203)
+203        FORMAT(2X,'NUCLEONS COORDINATES:')
+204        FORMAT(2X,3E10.3)
+           DO 205 I=1,NA
+205        WRITE (MONIOU,204)(SA(I,L),L=1,3)
+         ENDIF
+
+         NI=1
+         NG=1
+         J=0
+1        J=J+1
+         J1=NI+1
+         DO 4 I=J1,NA
+         RI=0.D0
+         DO 2 M=1,3
+2        RI=RI+(SA(J,M)-SA(I,M))**2
+         IF(RI.GT.RC)GOTO 4
+         NI=NI+1
+         NG=NG+1
+         IF(I.EQ.NI)GOTO 4
+         DO 3 M=1,3
+         S0=SA(NI,M)
+         SA(NI,M)=SA(I,M)
+3        SA(I,M)=S0
+4        CONTINUE
+         IF(J.LT.NI.AND.NA-NI.GT.0)GOTO 1
+         NSF=NSF+1
+         IAF(NSF)=NG
+         IF(DEBUG.GE.3)WRITE (MONIOU,206)NSF,IAF(NSF)
+206      FORMAT(2X,'XXFRAG: FRAGMENT N',I2,2X,'FRAGMENT MASS - ',I2)
+         NG=1
+         J=NI
+         NI=NI+1
+         IF(NA-NI)6,5,1
+5        NSF=NSF+1
+         IAF(NSF)=1
+         IF(DEBUG.GE.3)WRITE (MONIOU,206)NSF,IAF(NSF)
+6        CONTINUE
+         IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202      FORMAT(2X,'XXFRAG - END')
+         RETURN
+         END
+C=======================================================================
+
+      SUBROUTINE XXFRAGM(NS,XA)
+c Fragmentation of the spectator part of the nucleus
+c XA(56,3) - arrays for spectator nucleons positions
+c NS - total number of spectators
+c-----------------------------------------------------------------------
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      DIMENSION XA(56,3)
+      INTEGER DEBUG
+      COMMON /AREA1/  IA(2),ICZ,ICP
+      COMMON /AREA3/  RMIN,EMAX,EEV
+      COMMON /AREA11/ B10
+c NSF - number of secondary fragments;
+c IAF(i) - mass of the i-th fragment
+      COMMON /AREA13/ NSF,IAF(56)
+      COMMON /AREA43/ MONIOU
+      COMMON /DEBUG/  DEBUG
+      SAVE
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)NS
+201     FORMAT(2X,'XXFRAGM: NUMBER OF SPECTATORS: NS=',I2)
+
+        NSF=0
+
+        IF(NS-1)6,1,2
+c Single spectator nucleon is recorded
+1     NSF=NSF+1
+      IAF(NSF)=1
+        IF(DEBUG.GE.3)WRITE (MONIOU,205)
+205     FORMAT(2X,'XXFRAGM - SINGLE SPECTATOR')
+        GOTO 6
+2       EEX=0.D0
+c EEX - spectator part excitation energy; calculated as the sum of excitations
+c from all wounded nucleons ( including diffractively excited )
+        DO 3 I=1,IA(1)-NS
+c Partial excitation is simulated according to distribution f(E) ~ 1/sqrt(E)
+c * exp(-E/(2*<E>)), for sqrt(E) we have then normal distribution
+3     EEX=EEX+(PSRAN(B10)+PSRAN(B10)+PSRAN(B10)+
+     *      PSRAN(B10)+PSRAN(B10)-2.5D0)**2*2.4D0
+        IF(DEBUG.GE.3)WRITE (MONIOU,203)EEX
+203     FORMAT(2X,'XXFRAGM: EXCITATION ENERGY: EEX=',E10.3)
+
+c If the excitation energy per spectator is larger than EMAX
+c multifragmentation takes place ( percolation algorithm is used for it )
+        IF(EEX/NS.GT.EMAX)THEN
+c Multifragmentation
+          CALL XXFRAG(XA,NS,RMIN)
+        ELSE
+
+c Otherwise average number of eveporated nucleons equals EEX/EEV, where
+c EEV - mean excitation energy carried out by one nucleon
+          NF=IXXSON(NS,EEX/EEV,PSRAN(B10))
+          NSF=NSF+1
+c Recording of the fragment produced
+          IAF(NSF)=NS-NF
+        IF(DEBUG.GE.3)WRITE (MONIOU,206)IAF(NSF)
+206     FORMAT(2X,'XXFRAGM - EVAPORATION: MASS NUMBER OF THE FRAGMENT:'
+     *  ,I2)
+
+c Some part of excitation energy is carried out by alphas; we determine the
+c number of alphas simply as NF/4
+          NAL=NF/4
+          IF(NAL.NE.0)THEN
+c Recording of the evaporated alphas
+            DO 4 I=1,NAL
+            NSF=NSF+1
+4           IAF(NSF)=4
+          ENDIF
+
+          NF=NF-4*NAL
+          IF(NF.NE.0)THEN
+c Recording of the evaporated nucleons
+            DO 5 I=1,NF
+            NSF=NSF+1
+5           IAF(NSF)=1
+          ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,204)NF,NAL
+204     FORMAT(2X,'XXFRAGM - EVAPORATION: NUMBER OF NUCLEONS NF=',I2,
+     *  'NUMBER OF ALPHAS NAL=',I2)
+        ENDIF
+6       CONTINUE
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'XXFRAGM - END')
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE XXFZ(B,GZ)
+c Hadron-hadron and hadron-nucleus cross sections calculation
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION GZ(2),FHARD(3)
+        COMMON /AREA1/  IA(2),ICZ,ICP
+        COMMON /AREA2/  S,Y0,WP0,WM0
+        COMMON /AREA7/  RP1
+        COMMON /AR3/    X1(7),A1(7)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)
+201     FORMAT(2X,'XXFZ - HADRONIC CROSS-SECTIONS CALCULATION')
+
+        DO 1 L=1,2
+1       GZ(L)=0.D0
+        E1=EXP(-1.D0)
+
+        DO 2 I1=1,7
+        DO 2 M=1,2
+        Z=.5D0+X1(I1)*(M-1.5D0)
+        S1=DSQRT(RP1*Z)
+        ZV1=EXP(-Z)
+        S2=DSQRT(RP1*(1.D0-DLOG(Z)))
+        ZV2=E1*Z
+C??????????
+C       VV1=EXP(-PSFAZ(ZV1,FSOFT,FHARD,FSHARD))*(1.D0-FHARD(1)
+C    *  -FHARD(2)-FHARD(3))
+C       VV2=EXP(-PSFAZ(ZV2,FSOFT,FHARD,FSHARD))*(1.D0-FHARD(1)
+C    *  -FHARD(2)-FHARD(3))
+
+        VV1=EXP(-PSFAZ(ZV1,FSOFT,FHARD,FSHARD)-FHARD(1)
+     *  -FHARD(2)-FHARD(3))
+        VV2=EXP(-PSFAZ(ZV2,FSOFT,FHARD,FSHARD)-FHARD(1)
+     *  -FHARD(2)-FHARD(3))
+c???????????
+
+        IF(IA(2).EQ.1)THEN
+          CG1=1.D0
+          CG2=1.D0
+        ELSE
+          CG1=XXROT(B,S1)
+          CG2=XXROT(B,S2)
+        ENDIF
+
+        DO 2 L=1,2
+2       GZ(L)=GZ(L)+ A1(I1)*(CG1*(1.D0-VV1**L)+CG2*(1.D0-VV2**L)/Z)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'XXFZ - END')
+        RETURN
+        END
+C=======================================================================
+
+      SUBROUTINE XXGAU(GZ)
+c Impact parameter integration for impact parameters <BM -
+c for hadron-hadron and hadron-nucleus cross-sections calculation
+c-----------------------------------------------------------------------
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      INTEGER DEBUG
+      DIMENSION GZ(3),GZ0(3)
+      COMMON /AREA6/ PI,BM,AM
+      COMMON /AR3/   X1(7),A1(7)
+      COMMON /AR2/   R,RM
+      COMMON /AREA43/ MONIOU
+      COMMON /DEBUG/  DEBUG
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)
+201     FORMAT(2X,'XXGAU - NUCLEAR CROSS-SECTIONS CALCULATION')
+
+      DO 1 I=1,3
+1     GZ(I)=0.D0
+
+      DO 2 I=1,7
+      DO 2 M=1,2
+      B=BM*DSQRT(.5D0+X1(I)*(M-1.5D0))
+      CALL XXFAU(B,GZ0)
+      DO 2 L=1,3
+2     GZ(L)=GZ(L)+GZ0(L)*A1(I)
+      DO 3 L=1,3
+3     GZ(L)=GZ(L)*(BM*AM)**2*PI*.5D0
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'XXGAU - END')
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE XXGAU1(GZ)
+c Impact parameter integration for impact parameters >BM -
+c for hadron-hadron and hadron-nucleus cross-sections calculation
+c-----------------------------------------------------------------------
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      INTEGER DEBUG
+      DIMENSION GZ(3),GZ0(3)
+      COMMON /AREA6/ PI,BM,AM
+      COMMON /AR5/   X5(2),A5(2)
+      COMMON /AR2/   R,RM
+      COMMON /AREA43/ MONIOU
+      COMMON /DEBUG/  DEBUG
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)
+201     FORMAT(2X,'XXGAU1 - NUCLEAR CROSS-SECTIONS CALCULATION')
+
+      DO 1 I=1,2
+      B=BM+X5(I)
+      CALL XXFAU(B,GZ0)
+      DO 1 L=1,3
+1     GZ(L)=GZ(L)+GZ0(L)*A5(I)*EXP(X5(I))*B*2.D0*PI*AM*AM
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'XXGAU1 - END')
+      RETURN
+      END
+C=======================================================================
+
+        SUBROUTINE XXGENER(WP0,WM0,EY0,S0X,C0X,S0,C0,IC1,IC2)
+c To simulate the fragmentation of the string into secondary hadrons
+c The algorithm conserves energy-momentum;
+c WP0, WM0 are initial longitudinal momenta ( E+p, E-p ) of the quarks
+c at the ends of the string; IC1, IC2 - their types
+c The following partons types are used: 1 - u, -1 - U, 2 - d, -2 - D,
+c 3 - ud, -3 - UD, 4 - s, -4 - S, 5 - c, -5 - C,
+c  6 - uu, 7 - dd, -6 - UU, -7 - DD
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        CHARACTER *2 TYQ
+        DIMENSION WP(2),IC(2),EPT(4),EP(4),EY(3),EY0(3)
+c WP(1), WP(2) - current longitudinal momenta of the partons at the string
+c ends, IC(1), IC(2) - their types
+        COMMON /AREA8/  WWM,BEP,BEN,BEK,BEC,DC(5),DETA,ALMPT
+        COMMON /AREA10/ STMASS,AM0,AMN,AMK,AMC,AMLAMC,AMLAM,AMETA
+        COMMON /AREA11/ B10
+        COMMON /AREA19/ AHL(5)
+********************************************************
+        COMMON /AREA21/ DMMIN(5)
+********************************************************
+        COMMON /AREA28/ ARR(4)
+        COMMON /AREA42/ TYQ(15)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)TYQ(8+IC1),TYQ(8+IC2),
+     *  WP0,WM0,EY0,S0X,C0X,S0,C0
+201     FORMAT(2X,'XXGENER: PARTON FLAVORS AT THE ENDS OF THE STRING:',
+     *  2X,A2,2X,A2/4X,'LIGHT CONE MOMENTA OF THE STRING: ',E10.3,
+     *  2X,E10.3/4X,'EY0=',3E10.3/4X,
+     *  'S0X=',E10.3,2X,'C0X=',E10.3,2X,'S0=',E10.3,2X,'C0=',E10.3)
+
+        WW=WP0*WM0
+        EPT(1)=.5D0*(WP0+WM0)
+        EPT(2)=.5D0*(WP0-WM0)
+        EPT(3)=0.D0
+        EPT(4)=0.D0
+        IC(1)=IC1
+        IC(2)=IC2
+
+1     SWW=DSQRT(WW)
+      CALL PSDEFTR(WW,EPT,EY)
+      J=INT(2.D0*PSRAN(B10))+1
+      IF(DEBUG.GE.3)THEN
+        IQT=8+IC(J)
+        WRITE (MONIOU,203)J,TYQ(IQT),WW
+203     FORMAT(2X,'XXGENER: CURRENT PARTON FLAVOR AT THE END ',I1,
+     *  ' OF THE STRING: ',A2/4X,' STRING MASS: ',E10.3)
+      ENDIF
+
+      IAB=IABS(IC(J))
+      IS=IC(J)/IAB
+      IF(IAB.GT.5)IAB=3
+      IAJ=IABS(IC(3-J))
+      IF(IAJ.GT.5)IAJ=3
+      IF(IAJ.EQ.3)THEN
+        RESTM=AMN
+      ELSEIF(IAJ.EQ.4)THEN
+          RESTM=AMK
+      ELSEIF(IAJ.EQ.5)THEN
+        RESTM=AMC
+      ELSE
+        RESTM=AM0
+      ENDIF
+
+      IF(IAB.LE.2.AND.SWW.GT.RESTM+2.D0*AM0+WWM.OR.
+     *IAB.EQ.3.AND.SWW.GT.RESTM+AM0+AMN+WWM.OR.
+     *IAB.EQ.4.AND.SWW.GT.RESTM+AM0+AMK+WWM.OR.
+     *IAB.EQ.5.AND.SWW.GT.RESTM+AM0+AMC+WWM)THEN
+
+        IF(IAB.LE.2)THEN
+          IF(SWW.GT.RESTM+2.D0*AMC.AND.PSRAN(B10).LT.DC(3))THEN
+c D-meson generation
+            RESTM=(RESTM+AMC)**2
+            BET=BEC
+            AMI=AMC**2
+            ALF=ALMPT-ARR(4)
+            BLF=AHL(4)
+            IC0=IC(J)-9*IS
+            IC(J)=5*IS
+          ELSEIF(SWW.GT.RESTM+2.D0*AMN.AND.PSRAN(B10).LT.DC(1))THEN
+c Nucleon generation
+            RESTM=(RESTM+AMN)**2
+            BET=BEN
+            AMI=AMN**2
+            ALF=ALMPT-ARR(2)
+            BLF=AHL(2)
+            IC0=IC(J)+IS
+            IC(J)=-3*IS
+          ELSEIF(SWW.GT.RESTM+2.D0*AMK.AND.PSRAN(B10).LT.DC(2))THEN
+c Kaon generation
+            RESTM=(RESTM+AMK)**2
+            BET=BEK
+            AMI=AMK**2
+            ALF=ALMPT-ARR(3)
+            BLF=AHL(3)
+            IC0=IC(J)+3*IS
+            IC(J)=4*IS
+          ELSEIF(SWW.GT.RESTM+AMETA+AM0.AND.PSRAN(B10).LT.DETA)THEN
+c Eta generation
+            RESTM=(RESTM+AM0)**2
+            BET=BEK
+            AMI=AMETA**2
+            ALF=ALMPT-ARR(1)
+            BLF=AHL(1)
+            IC0=10
+          ELSE
+c Pion generation
+            RESTM=(RESTM+AM0)**2
+            BET=BEP
+            AMI=AM0**2
+            ALF=ALMPT-ARR(1)
+            BLF=AHL(1)
+
+            IF(PSRAN(B10).LT..3333D0)THEN
+              IC0=0
+            ELSE
+              IC0=3*IS-2*IC(J)
+              IC(J)=3*IS-IC(J)
+            ENDIF
+          ENDIF
+
+        ELSEIF(IAB.EQ.3)THEN
+          IF(SWW.GT.RESTM+AMC+AMLAMC.AND.PSRAN(B10).LT.DC(5).AND.
+     *    IABS(IC(J)).EQ.3)THEN
+c Lambda_C generation
+            RESTM=(RESTM+AMC)**2
+            BET=BEC
+            AMI=AMLAMC**2
+            ALF=ALMPT-ARR(4)
+            BLF=AHL(5)
+            IC0=9*IS
+            IC(J)=-5*IS
+          ELSEIF(SWW.GT.RESTM+AMK+AMLAM.AND.PSRAN(B10).LT.DC(4).AND.
+     *    IABS(IC(J)).EQ.3)THEN
+c Lambda generation
+            RESTM=(RESTM+AMK)**2
+            BET=BEK
+            AMI=AMLAM**2
+            ALF=ALMPT-ARR(3)
+            BLF=AHL(2)+ARR(1)-ARR(3)
+            IC0=6*IS
+            IC(J)=-4*IS
+          ELSE
+c Nucleon generation
+            RESTM=(RESTM+AM0)**2
+            BET=BEN
+            AMI=AMN**2
+            ALF=ALMPT-ARR(1)
+            BLF=AHL(2)
+            IF(IABS(IC(J)).EQ.3)THEN
+              IC0=IS*INT(2.5D0+PSRAN(B10))
+              IC(J)=IS-IC0
+            ELSE
+              IC0=IC(J)-4*IS
+              IC(J)=IC0-4*IS
+            ENDIF
+          ENDIF
+
+        ELSEIF(IAB.EQ.4)THEN
+          IF(SWW.GT.RESTM+AMN+AMLAM.AND.PSRAN(B10).LT.DC(1))THEN
+c Lambda generation
+            RESTM=(RESTM+AMN)**2
+            BET=BEN
+            AMI=AMLAM**2
+            ALF=ALMPT-ARR(2)
+            BLF=AHL(2)+ARR(1)-ARR(3)
+            IC0=6*IS
+            IC(J)=-3*IS
+          ELSE
+c Kaon generation
+            RESTM=(RESTM+AM0)**2
+            BET=BEP
+            AMI=AMK**2
+            ALF=ALMPT-ARR(1)
+            BLF=AHL(3)
+            IC(J)=IS*INT(1.5D0+PSRAN(B10))
+            IC0=-3*IS-IC(J)
+          ENDIF
+
+        ELSEIF(IAB.EQ.5)THEN
+          IF(SWW.GT.RESTM+AMN+AMLAMC.AND.PSRAN(B10).LT.DC(1))THEN
+c Lambda_C generation
+            RESTM=(RESTM+AMN)**2
+            BET=BEN
+            AMI=AMLAMC**2
+            ALF=ALMPT-ARR(2)
+            BLF=AHL(5)
+            IC0=9*IS
+            IC(J)=-3*IS
+          ELSE
+c D-meson generation
+            RESTM=(RESTM+AM0)**2
+            BET=BEP
+            AMI=AMC**2
+            ALF=ALMPT-ARR(1)
+            BLF=AHL(4)
+            IC(J)=IS*INT(1.5D0+PSRAN(B10))
+            IC0=9*IS-IC(J)
+          ENDIF
+        ENDIF
+
+********************************************************
+        PTMAX=PSLAM(WW,RESTM,AMI)
+        IF(PTMAX.LT.0.)PTMAX=0.
+
+        IF(PTMAX.LT.BET**2)THEN
+2         PTI=PTMAX*PSRAN(B10)
+          IF(PSRAN(B10).GT.EXP(-DSQRT(PTI)/BET))GOTO 2
+        ELSE
+3         PTI=(BET*DLOG(PSRAN(B10)*PSRAN(B10)))**2
+          IF(PTI.GT.PTMAX)GOTO 3
+        ENDIF
+
+        AMT=AMI+PTI
+        RESTM1=RESTM+PTI
+********************************************************
+c        ALF=ALF+2.*PTI
+
+        ZMIN=DSQRT(AMT/WW)
+        ZMAX=XXTWDEC(WW,AMT,RESTM1)
+        Z1=(1.-ZMAX)**ALF
+        Z2=(1.-ZMIN)**ALF
+4       Z=1.-(Z1+(Z2-Z1)*PSRAN(B10))**(1./ALF)
+        IF(PSRAN(B10).GT.(Z/ZMAX)**BLF)GOTO 4
+        WP(J)=Z*SWW
+        WP(3-J)=AMT/WP(J)
+        EP(1)=.5D0*(WP(1)+WP(2))
+        EP(2)=.5D0*(WP(1)-WP(2))
+        PTI=DSQRT(PTI)
+        CALL PSCS(C,S)
+        EP(3)=PTI*C
+        EP(4)=PTI*S
+
+        EPT(1)=SWW-EP(1)
+        DO 5 I=2,4
+5       EPT(I)=-EP(I)
+        WW=PSNORM(EPT)
+        IF(WW.LT.RESTM)GOTO 4
+
+        CALL PSTRANS(EP,EY)
+        CALL PSTRANS(EPT,EY)
+
+        IF(S0X.NE.0.D0.OR.S0.NE.0.D0)THEN
+          CALL PSROTAT(EP,S0X,C0X,S0,C0)
+        ENDIF
+        
+        IF(EY0(1)*EY0(2)*EY0(3).NE.1.D0)THEN
+          CALL PSTRANS(EP,EY0)
+        ENDIF
+        CALL XXREG(EP,IC0)
+      ELSE
+
+
+        AMI2=RESTM**2
+        BET=BEP
+        IF(IAB.LE.2.AND.IAJ.LE.2)THEN
+          AMI=AM0**2
+          IC0=-IC(1)-IC(2)
+          IF(IC0.NE.0)THEN
+            IC(J)=IC0*INT(.5D0+PSRAN(B10))
+            IC(3-J)=IC0-IC(J)
+          ELSE
+            IF(PSRAN(B10).LT..2D0)THEN
+              IC(J)=0
+              IC(3-J)=0
+            ELSE
+              IC(J)=3*IS-2*IC(J)
+              IC(3-J)=-IC(J)
+            ENDIF
+          ENDIF
+
+        ELSEIF(IAB.EQ.3.OR.IAJ.EQ.3)THEN
+          IF(IAB.EQ.3)THEN
+            AMI=AMN**2
+            IF(IABS(IC(J)).EQ.3)THEN
+              IF(IAJ.EQ.3)THEN
+                IF(IABS(IC(3-J)).EQ.3)THEN
+                  IC(J)=IS*INT(2.5D0+PSRAN(B10))
+                  IC(3-J)=-IC(J)
+	        ELSE
+                  IC(3-J)=IC(3-J)+4*IS
+                  IC(J)=5*IS+IC(3-J)
+	        ENDIF
+              ELSEIF(IAJ.LT.3)THEN
+                IF(PSRAN(B10).LT..3333D0)THEN
+                  IC(J)=IC(3-J)+IS
+                  IC(3-J)=0
+                ELSE
+                  IC(J)=IS*(4-IAJ)
+                  IC(3-J)=IS*(3-2*IAJ)
+                ENDIF
+              ELSEIF(IAJ.EQ.4)THEN
+                IC(J)=IS*INT(2.5D0+PSRAN(B10))
+                IC(3-J)=-IC(J)-2*IS
+              ELSEIF(IAJ.EQ.5)THEN
+                IC(J)=IS*INT(2.5D0+PSRAN(B10))
+                IC(3-J)=-IC(J)+10*IS
+              ENDIF
+            ELSE
+              IC(J)=IC(J)-4*IS
+              IC0=IC(J)-4*IS
+              IF(IAJ.EQ.3)THEN
+                IC(3-J)=IC0-IS
+              ELSEIF(IAJ.LT.3)THEN
+                IC(3-J)=-IC(3-J)-IC0
+              ELSEIF(IAJ.EQ.4)THEN
+                IC(3-J)=IC0-3*IS
+              ELSEIF(IAJ.EQ.5)THEN
+                IC(3-J)=IC0+9*IS
+              ENDIF
+            ENDIF
+          ELSE
+            IF(IABS(IC(3-J)).EQ.3)THEN
+              IF(IAB.LT.3)THEN
+                AMI=AM0**2
+                IF(PSRAN(B10).LT..3333D0)THEN
+                  IC(3-J)=IC(J)+IS
+                  IC(J)=0
+                ELSE
+                  IC(3-J)=IS*(4-IAB)
+                  IC(J)=IS*(3-2*IAB)
+                ENDIF
+              ELSEIF(IAB.EQ.4)THEN
+                AMI=AMK**2
+                IC(3-J)=IS*INT(2.5D0+PSRAN(B10))
+                IC(J)=-IC(3-J)-2*IS
+              ELSEIF(IAB.EQ.5)THEN
+                AMI=AMC**2
+                IC(3-J)=IS*INT(2.5D0+PSRAN(B10))
+                IC(J)=-IC(3-J)+10*IS
+              ENDIF
+            ELSE
+              IC(3-J)=IC(3-J)-4*IS
+              IC0=IC(3-J)-4*IS
+              IF(IAB.LT.3)THEN
+                AMI=AM0**2
+                IC(J)=-IC0-IC(J)
+              ELSEIF(IAB.EQ.4)THEN
+                AMI=AMK**2
+                IC(J)=IC0-3*IS
+              ELSEIF(IAB.EQ.5)THEN
+                AMI=AMC**2
+                IC(J)=IC0+9*IS
+              ENDIF
+            ENDIF
+          ENDIF
+
+        ELSEIF(IAB.EQ.4.OR.IAJ.EQ.4)THEN
+
+          IF(IAB.EQ.4)THEN
+            AMI=AMK**2
+
+            IF(IAJ.EQ.4)THEN
+              IC(J)=-IS*INT(4.5D0+PSRAN(B10))
+              IC(3-J)=-IC(J)
+            ELSEIF(IAJ.EQ.5)THEN
+              IC(J)=-IS*INT(4.5D0+PSRAN(B10))
+              IC(3-J)=-IC(J)-12*IS
+            ELSE
+              IC0=IC(3-J)+INT(.6667D0+PSRAN(B10))*(-3*IS-2*IC(3-J))
+              IC(J)=IC0-3*IS
+              IC(3-J)=IC0-IC(3-J)
+            ENDIF
+          ELSE
+            IF(IAB.LE.2)THEN
+              AMI=AM0**2
+              IC0=IC(J)+INT(.6667D0+PSRAN(B10))*(3*IS-2*IC(J))
+              IC(J)=IC0-IC(J)
+              IC(3-J)=IC0+3*IS
+            ELSEIF(IAB.EQ.5)THEN
+              AMI=AMC**2
+              IC(3-J)=IS*INT(4.5D0+PSRAN(B10))
+              IC(J)=-IC(3-J)+12*IS
+            ENDIF
+          ENDIF
+
+        ELSEIF(IAB.EQ.5.OR.IAJ.EQ.5)THEN
+
+          IF(IAB.EQ.5)THEN
+            AMI=AMC**2
+
+            IF(IAJ.EQ.5)THEN
+              IC(J)=IS*INT(7.5D0+PSRAN(B10))
+              IC(3-J)=-IC(J)
+            ELSE
+              IC0=IC(3-J)+INT(.6667D0+PSRAN(B10))*(-3*IS-2*IC(3-J))
+              IC(J)=IC0+9*IS
+              IC(3-J)=IC0-IC(3-J)
+            ENDIF
+          ELSE
+            AMI=AM0**2
+            IC0=IC(J)+INT(.6667D0+PSRAN(B10))*(3*IS-2*IC(J))
+            IC(J)=IC0-IC(J)
+            IC(3-J)=IC0-9*IS
+          ENDIF
+        ENDIF
+
+        PTMAX=PSLAM(WW,AMI2,AMI)
+        IF(PTMAX.LT.0.)PTMAX=0.
+        IF(PTMAX.LT.BET**2)THEN
+6         PTI=PTMAX*PSRAN(B10)
+          IF(PSRAN(B10).GT.EXP(-DSQRT(PTI)/BET))GOTO 6
+        ELSE
+7         PTI=(BET*DLOG(PSRAN(B10)*PSRAN(B10)))**2
+          IF(PTI.GT.PTMAX)GOTO 7
+        ENDIF
+
+        AMT1=AMI+PTI
+        AMT2=AMI2+PTI
+
+        Z=XXTWDEC(WW,AMT1,AMT2)
+        WP(J)=Z*SWW
+        WP(3-J)=AMT1/WP(J)
+        EP(1)=.5D0*(WP(1)+WP(2))
+        EP(2)=.5D0*(WP(1)-WP(2))
+        PTI=DSQRT(PTI)
+        CALL PSCS(C,S)
+        EP(3)=PTI*C
+        EP(4)=PTI*S
+
+        EPT(1)=SWW-EP(1)
+        DO 8 I=2,4
+8       EPT(I)=-EP(I)
+
+        CALL PSTRANS(EP,EY)
+        CALL PSTRANS(EPT,EY)
+
+        IF(S0X.NE.0.D0.OR.S0.NE.0.D0)THEN
+          CALL PSROTAT(EP,S0X,C0X,S0,C0)
+          CALL PSROTAT(EPT,S0X,C0X,S0,C0)
+        ENDIF
+        IF(EY0(1)*EY0(2)*EY0(3).NE.1.D0)THEN
+          CALL PSTRANS(EP,EY0)
+          CALL PSTRANS(EPT,EY0)
+        ENDIF
+        
+        CALL XXREG(EP,IC(J))
+        CALL XXREG(EPT,IC(3-J))
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'XXGENER - END')
+        RETURN
+      ENDIF
+      GOTO 1
+      END
+C=======================================================================
+
+        SUBROUTINE XXJETSIM
+c Procedure for jet hadronization - each gluon is
+c considered to be splitted into quark-antiquark pair and usual soft
+c strings are assumed to be formed between quark and antiquark
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EP(4),EP1(4),ey(3)
+        COMMON /AREA10/ STMASS,AM(7)
+        COMMON /AREA11/ B10
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        COMMON /AREA46/ EPJET(4,2,1000),IPJET(2,1000)
+        COMMON /AREA47/ NJTOT
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)NJTOT
+201     FORMAT(2X,'XXJETSIM: TOTAL NUMBER OF JETS NJTOT=',I4)
+        IF(NJTOT.EQ.0)RETURN     
+        DO 2 NJ=1,NJTOT
+        DO 1 I=1,4
+        EP1(I)=EPJET(I,1,NJ)
+1       EP(I)=EP1(I)+EPJET(I,2,NJ)
+        PT3=DSQRT(EP1(3)**2+EP1(4)**2)
+        PT4=DSQRT(EPJET(3,2,NJ)**2+EPJET(4,2,NJ)**2)
+
+c Invariant mass square for the jet
+        WW=PSNORM(EP)
+        SWW=DSQRT(WW)
+	
+        CALL PSDEFTR(WW,EP,EY)
+        CALL PSTRANS1(EP1,EY)
+        CALL PSDEFROT(EP1,S0X,C0X,S0,C0)
+
+2       CALL XXGENER(SWW,SWW,EY,S0X,C0X,S0,C0,IPJET(1,NJ),IPJET(2,NJ))
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)
+202     FORMAT(2X,'XXJETSIM - END')
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE XXREG(EP0,IC)
+c Registration of the produced hadron;
+c EP - 4-momentum,
+c IC - hadron type
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EP(4),EP0(4)
+        COMMON /AREA4/  EY0(3)
+        COMMON /AREA10/ STMASS,AM0,AMN,AMK,AMC,AMLAMC,AMLAM,AMETA
+        COMMON /AREA11/ B10
+        COMMON /AREA12/ NSH
+        COMMON /AREA14/ ESP(4,15000),ICH(15000)
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)IC,EP0
+201     FORMAT(2X,'XXREG: IC=',I2,2X,'C.M. 4-MOMENTUM:',2X,4(E10.3,1X))
+         pt=dsqrt(ep0(3)**2+ep0(4)**2)
+c         if(pt.gt.11.d0)write (MONIOU,*)'pt,ic,ep',pt,ic,ep0
+c         if(pt.gt.11.d0)write (*,*)'pt,ic,ep',pt,ic,ep0
+
+        NSH=NSH+1
+        IF (NSH .GT. 15000) THEN
+          WRITE(MONIOU,*)'XXREG: TOO MUCH SECONDARY PARTICLES'
+          WRITE(MONIOU,*)'XXREG: NSH = ',NSH
+          STOP
+        ENDIF
+        DO 4 I=1,4
+4       EP(I)=EP0(I)
+        CALL PSTRANS(EP,EY0)
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)EP
+202     FORMAT(2X,'XXREG: LAB. 4-MOMENTUM:',2X,4(E10.3,1X))
+
+        ICH(NSH)=IC
+        DO 3 I=1,4
+3       ESP(I,NSH)=EP(I)
+
+        IF(DEBUG.GE.3)WRITE (MONIOU,203)
+203     FORMAT(2X,'XXREG - END')
+        RETURN
+        END
+C=======================================================================
+
+        FUNCTION XXROT(S,B)
+c Convolution of nuclear profile functions (axial angle integration)
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AR8/  X2(4),A2
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)B
+201     FORMAT(2X,'XXROT - AXIAL ANGLE INTEGRATION OF THE ',
+     *  'NUCLEAR PROFILE FUNCTION'/4X,
+     *  'IMPACT PARAMETER B=',E10.3,2X,'NUCLEON COORDINATE S=',E10.3)
+
+        XXROT=0.
+        DO 1 I=1,4
+        SB1=B**2+S**2-2.*B*S*(2.*X2(I)-1.)
+        SB2=B**2+S**2-2.*B*S*(1.-2.*X2(I))
+1       XXROT=XXROT+(XXT(SB1)+XXT(SB2))
+        XXROT=XXROT*A2
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)XXROT
+202     FORMAT(2X,'XXROT=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+        SUBROUTINE XXSTR(WPI0,WMI0,WP0,WM0,IC10,IC120,IC210,IC20)
+**************************************************
+c Fragmentation process for the pomeron ( quarks and antiquarks types at the
+c ends of the two strings are determined, energy-momentum is shared
+c between them and strings fragmentation is simulated )
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        DIMENSION EY(3)
+        COMMON /AREA6/  PI,BM,AMMM
+        COMMON /AREA10/ STMASS,AM(7)
+        COMMON /AREA11/ B10
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+        SAVE
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)WPI0,WMI0,WP0,WM0
+201     FORMAT(2X,'XXSTR: WPI0=',E10.3,2X,'WMI0=',E10.3,2X,
+     *  'WP0=',E10.3,2X,'WM0=',E10.3)
+         DO 1 I=1,3
+1        EY(I)=1.D0
+
+         WPI=WPI0
+         WMI=WMI0
+c Quark-antiquark types (1 - u, 2 - d, -1 - u~, -2 - d~); s- and d- quarks are
+c taken into consideration at the fragmentation step
+**************************************************
+        IF(IC10.EQ.0)THEN
+          IC1=INT(1.5+PSRAN(B10))
+          IC12=-IC1
+        ELSEIF(IC10.GT.0)THEN
+          IC1=IC10
+          IC12=IC120
+        ELSE
+          IC1=IC120
+          IC12=IC10
+        ENDIF
+        IF(IC20.EQ.0)THEN
+          IC2=INT(1.5+PSRAN(B10))
+          IC21=-IC2
+        ELSEIF(IC20.gt.0)THEN
+          IC2=IC20
+          IC21=IC210
+        ELSE
+          IC2=IC210
+          IC21=IC20
+        ENDIF
+**************************************************
+
+c Longitudinal momenta for the strings
+        WP1=WPI*COS(PI*PSRAN(B10))**2
+        WM1=WMI*COS(PI*PSRAN(B10))**2
+        WPI=WPI-WP1
+        WMI=WMI-WM1
+c String masses
+        SM1=WP1*WM1
+        SM2=WPI*WMI
+c Too short strings are neglected (energy is given to partner string or to the hadron
+c (nucleon) to which the pomeron is connected)
+        IF(SM1.GT.STMASS.AND.SM2.GT.STMASS)THEN
+c Strings fragmentation is simulated - GENER
+          CALL XXGENER(WP1,WM1,EY,0.D0,1.D0,0.D0,1.D0,IC1,IC21)
+          CALL XXGENER(WPI,WMI,EY,0.D0,1.D0,0.D0,1.D0,IC12,IC2)
+        ELSEIF(SM1.GT.STMASS)THEN
+          CALL XXGENER(WP1+WPI,WM1+WMI,EY,0.D0,1.D0,0.D0,1.D0,IC1,IC21)
+        ELSEIF(SM2.GT.STMASS)THEN
+          CALL XXGENER(WPI+WP1,WMI+WM1,EY,0.D0,1.D0,0.D0,1.D0,IC12,IC2)
+        ELSE
+          WP0=WP0+WP1+WPI
+          WM0=WM0+WM1+WMI
+        ENDIF
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)WP0,WM0
+202     FORMAT(2X,'XXSTR - RETURNED LIGHT CONE MOMENTA:',
+     *  2X,'WP0=',E10.3,2X,'WM0=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+      FUNCTION XXT(B)
+c Nuclear profile function value at impact parameter squared B
+c-----------------------------------------------------------------------
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      INTEGER DEBUG
+      COMMON /AREA6/ PI,BM,AM
+      COMMON /AR2/   R,RM
+      COMMON /AR5/   X5(2),A5(2)
+      COMMON /AR9/   X9(3),A9(3)
+      COMMON /AREA43/ MONIOU
+      COMMON /DEBUG/  DEBUG
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)B
+201     FORMAT(2X,'XXT - NUCLEAR PROFILE FUNCTION VALUE AT IMPACT',
+     *  ' PARAMETER SQUARED B=',E10.3)
+      XXT=0.
+      ZM=RM**2-B
+      IF(ZM.GT.4.*B)THEN
+        ZM=DSQRT(ZM)
+      ELSE
+        ZM=2.*DSQRT(B)
+      ENDIF
+
+      DO 1 I=1,3
+      Z1=ZM*(1.+X9(I))*0.5
+      Z2=ZM*(1.-X9(I))*0.5
+      QUQ=DSQRT(B+Z1**2)-R
+      IF (QUQ.LT.85.)XXT=XXT+A9(I)/(1.+EXP(QUQ))
+      QUQ=DSQRT(B+Z2**2)-R
+      IF (QUQ.LT.85.)XXT=XXT+A9(I)/(1.+EXP(QUQ))
+1     CONTINUE
+      XXT=XXT*ZM*0.5
+      DT=0.
+      DO 2 I=1,2
+      Z1=X5(I)+ZM
+      QUQ=DSQRT(B+Z1**2)-R-X5(I)
+      IF (QUQ.LT.85.)DT=DT+A5(I)/(EXP(-X5(I))+EXP(QUQ))
+2     CONTINUE
+      XXT=XXT+DT
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)XXROT
+202     FORMAT(2X,'XXT=',E10.3)
+      RETURN
+      END
+C=======================================================================
+
+        FUNCTION XXTWDEC(S,A,B)
+c Kinematical function for two particle decay -
+C light cone momentum share for
+c the particle of mass squared A,
+C B - partner's mass squared,
+C S - two particle invariant mass
+c-----------------------------------------------------------------------
+        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+        INTEGER DEBUG
+        COMMON /AREA43/ MONIOU
+        COMMON /DEBUG/  DEBUG
+
+        IF(DEBUG.GE.2)WRITE (MONIOU,201)S,A,B
+201     FORMAT(2X,'XXTWDEC: S=',E10.3,2X,'A=',E10.3,2X,'B=',E10.3)
+
+        X=.5D0*(1.D0+(A-B)/S)
+        DX=(X*X-A/S)
+        IF(DX.GT.0.D0)THEN
+          X=X+DSQRT(DX)
+        ELSE
+          X=DSQRT(A/S)
+        ENDIF
+        XXTWDEC=X
+        IF(DEBUG.GE.3)WRITE (MONIOU,202)XXTWDEC
+202     FORMAT(2X,'XXTWDEC=',E10.3)
+        RETURN
+        END
+C=======================================================================
+
+      DOUBLE PRECISION FUNCTION GAMFUN(Y)
+C     Gamma function : See Abramowitz, page 257, form. 6.4.40
+c-----------------------------------------------------------------------
+      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
+      DOUBLE PRECISION
+     +     Y,R,S,T,AFSPL,X,
+     +     COEF(10),PI,ZEROD,HALFD,ONED,TWOD,TEND
+C
+      DATA COEF/8.3333333333333334D-02,-2.7777777777777778D-03,
+     .          7.9365079365079365D-04,-5.9523809523809524D-04,
+     .          8.4175084175084175D-04,-1.9175269175269175D-03,
+     .          6.4102564102564103D-03,-2.9550653594771242D-02,
+     .          0.1796443723688306    ,-0.6962161084529506    /
+      DATA PI/  3.141592653589793D0/
+      DATA ZEROD/0.D0/,HALFD/0.5D0/,ONED/1.D0/,TWOD/2.D0/,TEND/10.D0/
+C
+      X=Y
+      AFSPL=ONED
+      N=INT(TEND-Y)
+      DO 10 I=0,N
+        AFSPL=AFSPL*X
+        X=X+ONED
+10    CONTINUE
+      R=(X-HALFD)* LOG(X)-X+HALFD* LOG(TWOD*PI)
+      S=X
+      T=ZEROD
+      DO 20 I=1,10
+        T=T+COEF(I)/S
+        S=S*X**2
+20    CONTINUE
+      GAMFUN = EXP(R+T)/AFSPL
+      END
+C=======================================================================
+
+       BLOCK DATA PSDATA
+c Constants for numerical integration (Gaussian weights)
+c-----------------------------------------------------------------------
+       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+       COMMON /AR3/ X1(7),A1(7)
+       COMMON /AR5/ X5(2),A5(2)
+       COMMON /AR8/ X2(4),A2
+       COMMON /AR9/ X9(3),A9(3)
+
+       DATA X1/.9862838D0,.9284349D0,.8272013D0,.6872929D0,.5152486D0,
+     * .3191124D0,.1080549D0/
+       DATA A1/.03511946D0,.08015809D0,.1215186D0,.1572032D0,
+     * .1855384D0,.2051985D0,.2152639D0/
+       DATA X2/.00960736D0,.0842652D0,.222215D0,.402455D0/
+       DATA A2/.392699D0/
+       DATA X5/.585786D0,3.41421D0/
+       DATA A5/.853553D0,.146447D0/
+       DATA X9/.93247D0,.661209D0,.238619D0/
+       DATA A9/.171324D0,.360762D0,.467914D0/
+       END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/SIBYLL.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/SIBYLL.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/SIBYLL.f	(revision 286)
@@ -0,0 +1,5779 @@
+C============================================================
+C    SSSSSS   IIIIIII  BBBBB   YY      YY   L        L
+C   S            I     B    B    YY  YY     L        L
+C    SSSSS       I     BBBBB       YY       L        L
+C         S      I     B    B      YY       L        L
+C   SSSSSS    IIIIIII  BBBBB       YY       LLLLLLL  LLLLLLL
+C=============================================================
+C  Code for SIBYLL:  hadronic interaction Montecarlo
+C=============================================================
+C
+C   Version 1.6   
+C
+C       By   R.S. Fletcher
+C            T.K. Gaisser
+C            Paolo Lipari
+C            Todor Stanev
+C
+C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+C*****  Please  have people who want this code contact one of the authors.
+C*****  Please report any problems.       *******
+C
+C      For a correct copy contact:
+C      Decnet   6360::Gaisser
+C               6360::Stanev
+C               JHUP::Fletcher
+C               40808::Lipari
+C
+C      Internet  Gaisser@brivs2.bartol.udel.edu
+C                Stanev@udbri.bartol.udel.edu
+C                Fletcher@JHUP.pha.jhu.edu
+C                Lipari@roma1.infn.it
+C
+C       16-4-97  Bug in IFLAV eliminated by D.H.
+C 
+C       15-4-97  Bugs in PART_INT eliminated by D.H.
+C 
+C       17-3-97  Bounds_check fixed in FPNI, NJETR, SIB_SIGMA_HAIR,
+C                SIB_SIGMA_PIP, SIB_SIGMA_PP, SIGMA_PIP,SIGMA_PP by D.H.
+C
+C       18-6-96  Bugs in ZSAMPLE and NUC_CONF eliminated by D.H.
+C
+C       10-5-96  Bug in treatment of antinucleons eliminated
+C
+C       15-9-95  random  number generator  as RNDM(0)
+C                minor corrections
+C
+C       6-15-94: minor changes suggested by  O. Palamara 
+C                for compatiblility with 
+C                MACRO codes. Parameter statements made standard. 
+C                Bug in Parton found by S. Kashahara fixed.
+C                NUCLIB code moved to the end of the file for 
+C                easy removal.
+C       
+C      2-4-94: Bug fix to avoid infinite loop  at low energies. BEAM_SPLIT
+C      
+C      4-93 This version is the first to include the NUCLIB like
+C      treatment of the wounded nucleon distributions.
+C
+C=============================================================
+C==========SIBYLL=============================================
+C=============================================================
+C+++++ Code for SIBYLL:  hadronic interaction Montecarlo
+C=============================================================
+C
+C      SIBYLL is an hadronic interaction Monte Carlo simulation
+C      based on  the dual parton Model, String Fragmentation
+c      and the minijet model. It reproduces data 
+C      resonably well from around 200. GeV up.
+C      The program runs from Sqrt(s)=Sqrt(2.*Mp*E_beam)= 10 GeV
+C      up to sqrt(s)=10**6 GeV (around 10**21 eV in the laboratory system).
+C
+C      The program gets inefficient at low energies 
+C      (below sqrt[s] = 20 GeV or so)
+C      Results at very high energy are subject to all the  usual
+C      problems associated with extrapolating over several 
+C      orders of magnitude in energy.
+C===========================================================================
+      function A_pip (b)
+C...Convolution of parton distribution for pip interaction
+      IMPLICIT REAL*4 (A-Z)
+      COMMON /S_CH0CNV/ NU2, MU2, NUPI2, NU, MU, NUPI
+      data pi / 3.1415926/
+
+      eta = nu2/nupi2
+      c = nu2/(2.*pi) * 1./(1.-eta)
+
+      if (b .gt. 0.)  then
+         b1 = b*nu
+         b2 = b*nupi
+         f1 = 0.5*b1 * bessk1(b1)
+         f2 = eta/(1.-eta)*(bessk0(b2)- bessk0(b1))
+         A_pip = c*(f1+f2)
+      else
+         A_pip = c*(0.5 + eta/(1.-eta)*log(nu/nupi))
+      endif
+      return
+      end
+      function A_pp (b)
+C...Convolution of parton distribution for pp interaction
+      IMPLICIT REAL*4 (A-Z)
+      COMMON /S_CH0CNV/ NU2, MU2, NUPI2, NU, MU, NUPI
+      data pi / 3.1415926/
+      c = nu**5/(96.*pi)
+      if (b .gt. 0.)  then
+         A_pp = c*b**3 * bessk (3, b*nu)
+      else
+         A_pp = nu**2/(12.*pi)
+      endif
+      return
+      end
+      REAL FUNCTION BDIFFRACT(SQS,ipart)
+C
+C    INPUT    SQS (GeV)
+C             ipart is the code for the scattering particle(p,pi)
+C    OUTPUT:  DIFFRACT is the single diffractive cross
+C            section parameterized with a log.
+c            in mB
+C                                    RSF
+C......................................................
+      real a(2),b(2)
+      data a/0.0,1.2/
+      data b/1.56,0.66/
+      BDIFFRACT = (a(ipart)+b(ipart)*log(sqs))/2.0
+      RETURN
+      END
+      SUBROUTINE BEAM_SPLIT (L, NW, XX, IFL, XJET, LXBAD,stringmas0)
+C...This subroutine split a hadron of code L
+C.  into 2*NW partons, each of energy XX(j) and
+C.  flavor IFL.  The minimum fractional energy of
+C.  each parton is X_min = 2*stringmas0/sqrt(s)
+c.
+c.  Variable qmas changed to stringmas0 to agree with name in SIBYLL
+c.      and added to calling sequenceto insure symetry.
+c      Also a factor of (1-xjet) is added to the def. of xmin for nw=1
+c.                               RSF  Apr-2-92
+C---------------------------------------------------------------------
+      COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
+      DIMENSION XX(30), IFL(30)
+      DATA AC /-0.2761856692/             ! log(2) - gamma(Eulero)
+      DATA GAMMA /2./
+      DATA NBAD / 0 /
+c-------
+c  New code to handle low energy p nuc problem.
+c------
+      LXBAD = 0
+      XMIN = 2.*stringmas0/SQS
+      IF (1.-XJET .LT. FLOAT(2*NW)*XMIN)  THEN
+         NBAD = NBAD + 1
+         LXBAD = 1
+         IF (NBAD .LE. 100) THEN
+           WRITE (6, *) 'BEAM_SPLIT: kinematically forbidden situation'
+           WRITE (6, 5)  NBAD, SQS, XJET, NW
+         ENDIF
+ 5       FORMAT(1X,'NBAD = ',I3,3X,'sqs = ',E10.3,
+     &            3X, 'x_jet = ', F9.3, 3X, ' NW = ',I2)
+         IF (NBAD .eq. 100) THEN
+           WRITE (6, *)
+     &     ' BEAM_SPLIT : Last warning about bad splittings '
+           WRITE (6, *) ' The energy threshold is probably too low.'
+         ENDIF
+         RETURN
+      ENDIF
+
+      IF (NW .EQ. 1)  THEN
+         XVAL = 1.-XJET
+         GOTO 200
+      ENDIF
+
+C...Choose total energy of sea partons
+      N = 2*(NW-1)
+      Z1 = LOG(FLOAT(N))
+      Z2 = LOG(0.5*SQS*(1.-XJET)/stringmas0-2.)
+100   R=RNDM(0)
+      Z=(Z1+AC)*(1.+R*(((Z2+AC)/(Z1+AC))**N-1.))**(1./FLOAT(N))-AC
+      XSEA = XMIN*EXP(Z)
+      IF ( (1.-XSEA)**GAMMA .LT. RNDM(0)) GOTO 100
+C...Split the energy  of sea partons among the different partons
+      XREM = XSEA - FLOAT(N)*XMIN
+      DO J=3,N+1
+         XA = XREM*RNDM(0)
+         XREM = XREM - XA
+         XX(J) = XMIN + XA
+      ENDDO
+      XX(N+2) = XMIN + XREM
+      XVAL = 1.-XSEA-XJET
+C...Flavor of sea partons
+      DO J=1,N/2
+         J1 =  3 + (J-1)*2
+         IFL(J1) = INT(1.+1.99*RNDM(0))
+         IFL(J1+1) = -IFL(J1)
+      ENDDO
+C...Prepare the valence partons
+200   CALL HSPLI (L,IFL(1),IFL(2))
+      CHI = CHIDIS(L,IFL(1),IFL(2))
+      XX(1) = MAX(CHI*XVAL,XMIN)
+      XX(1) = MIN(XX(1),XVAL-XMIN)
+C      FOR MESONS, SPLIT ENERGY SYMETRICALLY.
+C????? SPLIT K'S WITH ENERGY TO S QUARK?
+C
+      if (abs(l).le.12.and.RNDM(0).le.0.5) xx(1)=XVAL-XX(1)
+      XX(2) = XVAL-XX(1)
+      RETURN
+      END
+
+      FUNCTION BESSI0(X)
+C----------------------------------------------------------------------------
+C  Bessel functions
+C----------------------------------------------------------------------------
+      REAL*8 Y,P1,P2,P3,P4,P5,P6,P7,
+     *    Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9
+      DATA P1,P2,P3,P4,P5,P6,P7/1.0D0,3.5156229D0,3.0899424D0,
+     *    1.2067492D0,
+     *    0.2659732D0,0.360768D-1,0.45813D-2/
+      DATA Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9/0.39894228D0,0.1328592D-1,
+     *    0.225319D-2,-0.157565D-2,0.916281D-2,-0.2057706D-1,
+     *    0.2635537D-1,-0.1647633D-1,0.392377D-2/
+      IF (ABS(X).LT.3.75) THEN
+        Y=(X/3.75)**2
+        BESSI0=P1+Y*(P2+Y*(P3+Y*(P4+Y*(P5+Y*(P6+Y*P7)))))
+      ELSE
+        AX=ABS(X)
+        Y=3.75/AX
+        BESSI0=(EXP(AX)/SQRT(AX))*(Q1+Y*(Q2+Y*(Q3+Y*(Q4
+     *      +Y*(Q5+Y*(Q6+Y*(Q7+Y*(Q8+Y*Q9))))))))
+      ENDIF
+      RETURN
+      END
+      FUNCTION BESSI1(X)
+C----------------------------------------------------------------------------
+C  Bessel functions
+C----------------------------------------------------------------------------
+      REAL*8 Y,P1,P2,P3,P4,P5,P6,P7,
+     *    Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9
+      DATA P1,P2,P3,P4,P5,P6,P7/0.5D0,0.87890594D0,0.51498869D0,
+     *    0.15084934D0,0.2658733D-1,0.301532D-2,0.32411D-3/
+      DATA Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9/0.39894228D0,-0.3988024D-1,
+     *    -0.362018D-2,0.163801D-2,-0.1031555D-1,0.2282967D-1,
+     *    -0.2895312D-1,0.1787654D-1,-0.420059D-2/
+      IF (ABS(X).LT.3.75) THEN
+        Y=(X/3.75)**2
+        BESSI1=X*(P1+Y*(P2+Y*(P3+Y*(P4+Y*(P5+Y*(P6+Y*P7))))))
+      ELSE
+        AX=ABS(X)
+        Y=3.75/AX
+        BESSI1=(EXP(AX)/SQRT(AX))*(Q1+Y*(Q2+Y*(Q3+Y*(Q4+
+     *      Y*(Q5+Y*(Q6+Y*(Q7+Y*(Q8+Y*Q9))))))))
+      ENDIF
+      RETURN
+      END
+      FUNCTION BESSK(N,X)
+C----------------------------------------------------------------------------
+C  Bessel functions
+C----------------------------------------------------------------------------
+      IF (N.LT.2) PAUSE 'bad argument N in BESSK'
+      TOX=2.0/X
+      BKM=BESSK0(X)
+      BK=BESSK1(X)
+      DO 11 J=1,N-1
+        BKP=BKM+J*TOX*BK
+        BKM=BK
+        BK=BKP
+11    CONTINUE
+      BESSK=BK
+      RETURN
+      END
+      FUNCTION BESSK0(X)
+C----------------------------------------------------------------------------
+C  Bessel functions
+C----------------------------------------------------------------------------
+      REAL*8 Y,P1,P2,P3,P4,P5,P6,P7,
+     *    Q1,Q2,Q3,Q4,Q5,Q6,Q7
+      DATA P1,P2,P3,P4,P5,P6,P7/-0.57721566D0,0.42278420D0,
+     *    0.23069756D0,0.3488590D-1,0.262698D-2,0.10750D-3,0.74D-5/
+      DATA Q1,Q2,Q3,Q4,Q5,Q6,Q7/1.25331414D0,-0.7832358D-1,
+     * 0.2189568D-1,-0.1062446D-1,0.587872D-2,-0.251540D-2,0.53208D-3/
+      IF (X.LE.2.0) THEN
+        Y=X*X/4.0
+        BESSK0=(-LOG(X/2.0)*BESSI0(X))+(P1+Y*(P2+Y*(P3+
+     *        Y*(P4+Y*(P5+Y*(P6+Y*P7))))))
+      ELSE
+        Y=(2.0/X)
+        BESSK0=(EXP(-X)/SQRT(X))*(Q1+Y*(Q2+Y*(Q3+
+     *        Y*(Q4+Y*(Q5+Y*(Q6+Y*Q7))))))
+      ENDIF
+      RETURN
+      END
+      FUNCTION BESSK1(X)
+C----------------------------------------------------------------------------
+C  Bessel functions
+C----------------------------------------------------------------------------
+      REAL*8 Y,P1,P2,P3,P4,P5,P6,P7,
+     *    Q1,Q2,Q3,Q4,Q5,Q6,Q7
+      DATA P1,P2,P3,P4,P5,P6,P7/1.0D0,0.15443144D0,-0.67278579D0,
+     *    -0.18156897D0,-0.1919402D-1,-0.110404D-2,-0.4686D-4/
+      DATA Q1,Q2,Q3,Q4,Q5,Q6,Q7/1.25331414D0,0.23498619D0,
+     *    -0.3655620D-1,0.1504268D-1,-0.780353D-2,0.325614D-2,
+     *    -0.68245D-3/
+      IF (X.LE.2.0) THEN
+        Y=X*X/4.0
+        BESSK1=(LOG(X/2.0)*BESSI1(X))+(1.0/X)*(P1+Y*(P2+
+     *      Y*(P3+Y*(P4+Y*(P5+Y*(P6+Y*P7))))))
+      ELSE
+        Y=2.0/X
+        BESSK1=(EXP(-X)/SQRT(X))*(Q1+Y*(Q2+Y*(Q3+
+     *      Y*(Q4+Y*(Q5+Y*(Q6+Y*Q7))))))
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE BLOCK(SQS,SIG1,SIG2,SLOP1,SLOP2,
+     +                 RHO1,RHO2,SIGEL1,SIGEL2)
+C------------------------------------------------------------------------
+C.  Fit of Block and Cahn to pp and pbar-p cross sections
+C------------------------------------------------------------------------
+C...p-p and pbar-p cross sections
+C.  Parametrization of  Block and Cahn
+C
+C.  INPUT  : SQS   (GeV)  = c.m. energy
+C.
+C.  OUPUT : SIG1 (mbarn)    = pp  total  cross section
+C.          SLOP1 (GeV**2)  = slope of elastic scattering
+C.          RHO1            = Real/Imaginary part of the amplitude
+C.                            for forward elastic  scattering (pp)
+C.          SIGEL1 (mbarn)  = pp  elastic scattering  cross section
+C.          [1 -> 2   : pp -> pbar p]
+C-----------------------------------------------------------------------
+      DATA PI /3.1415926/
+      DATA CMBARN /0.389385/
+      S = SQS*SQS
+      CALL FPLUS  (S, FR, FI)
+      CALL FMINUS (S, GR, GI)
+      SIG1 = FI-GI
+      SIG2 = FI+GI
+      RHO1 = (FR-GR)/(FI-GI)
+      RHO2 = (FR+GR)/(FI+GI)
+      CALL SSLOPE (S, BP, BM)
+      SLOP1 = BP - GI/FI*(BM-BP)
+      SLOP2 = BP + GI/FI*(BM-BP)
+      SIGEL1 = SIG1**2*(1.+RHO1**2)/(16.*PI*SLOP1)/CMBARN
+      SIGEL2 = SIG2**2*(1.+RHO2**2)/(16.*PI*SLOP2)/CMBARN
+      RETURN
+      END
+
+      SUBROUTINE BLOCK_INI
+C...Parameters of fit IFIT=1 of Block and Cahn
+      COMMON /BLOCKC/ AA, BETA, S0, CC, AMU, DD, ALPHA, A0
+      COMMON /BLOCKD/ CP, DP, EP, CM, DM
+      AA = 41.74
+      BETA = 0.66
+      S0 = 338.5
+      CC = 0.
+      AMU = 0.
+      DD = -39.37
+      ALPHA = 0.48
+      A0 = 0.
+      CP = 10.90
+      DP = -0.08
+      EP = 0.043
+      CM = 23.27
+      DM = 0.93
+      RETURN
+      END
+
+      FUNCTION CHIDIS (KPARTin, IFL1, IFL2)
+C...Generate CHI (fraction of energy of a hadron carried by
+C.                the valence quark, or diquark, as specified by IFL1)
+C.  INPUT KPART = code of particle
+C.        IFL1, IFL2 = codes of partons (3, 3bar of color)
+C.........................................................
+      COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
+      COMMON /S_CPSPL/ CCHIK(3,7:14)
+      COMMON/S_cutof/stringmas0
+C O. Palamara 27/8/1993
+C      parameter QMAS=0.35
+      parameter (QMAS=0.35)
+      kpart=IABS(kpartin)
+      IFQ=IABS(IFL1)
+      IF (IFQ.GT.10) IFQ=IABS(IFL2)
+c      CUT=2.*QMAS/SQS
+      CUT=2.*stringmas0/SQS
+100      CHIDIS=RNDM(0)**2
+      if (chidis.lt.cut) goto 100
+      if (chidis.gt.(1.-cut)) goto 100
+c      IF((CHIDIS**2/(CHIDIS**2+CUT**2))**0.25
+      IF((CHIDIS**2/(CHIDIS**2+CUT**2))**0.5
+     +   *(1.-CHIDIS)**CCHIK(IFQ,KPART).LT.RNDM(0)) GOTO 100
+      CHIDIS = MAX(0.5*CUT,CHIDIS)
+      CHIDIS = MIN(1.-CUT,CHIDIS)
+      IF (IABS(IFL1).GT.10)  CHIDIS=1.-CHIDIS
+      RETURN
+      END
+      REAL FUNCTION DDIFFRACT(SQS,ipart)
+C... This routine only includes pp scattering.
+C    INPUT    SQS (GeV)
+C             ipart is the code for the scattering particle(p,pi)
+C    OUTPUT:  dDIFFRACT is the Double Diffractive cross
+C            section parameterized with a log.
+C            in mb.
+C                                    RSF
+C......................................................
+      real a(2),b(2)
+      data a/-1.23,.41/
+      data b/.7,0.12/
+      DDIFFRACT =( a(ipart)+b(ipart)*log(sqs))
+      RETURN
+      END
+      FUNCTION DENSA (Z)
+C....Woods Saxon nuclear density (normalised to 1)
+C.   for a nucleus of mass number A.
+C.   INPUT z = z coordinate (fm)
+C.         JA = integer mass number
+C.         B (in common /CC01/)  impact parameter  (fm)
+C.  OUTPUT (fm**-3)
+C--------------------------------------------------------
+      COMMON /CC01/  B
+      COMMON /CCDA/ JA
+      COMMON /CWOOD/ RR0(19:56), AA0(19:56), CC0(19:56)
+      R = SQRT (Z*Z + B*B)
+      DENSA = CC0(JA)/(1.+EXP((R-RR0(JA))/AA0(JA)))
+      RETURN
+      END
+
+      FUNCTION DENS_NUC (R, JA)
+C===========================================================================
+C.   Code about nuclear densities
+C===========================================================================
+C....Nuclear density (normalised to 1)
+C.   for a nucleus of mass number JA
+C.   INPUT R = radial coordinate  (fm)
+C.         JA = integer mass number
+C.  OUTPUT (fm**-3)
+C--------------------------------------------------------
+      COMMON /CWOOD/ RR0(19:56), AA0(19:56), CC0(19:56)
+      IF (JA .GT. 18)  THEN
+         DENS_NUC = WOOD_SAXON(R,JA)
+      ELSE IF (JA .NE. 4)  THEN
+         DENS_NUC = HELIUM(R)
+      ELSE
+         DENS_NUC = SHELL(R,JA)
+      ENDIF
+      RETURN
+      END
+
+      SUBROUTINE DIFDEC (L0, P0)
+C..."decay" of an excited state with the quantum numbers
+C.   of particle L0 and the 5-momentum P0
+C........................................................
+      COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
+      COMMON /S_MASS1/ AM(49), AM2(49)
+      COMMON /S_CHP/ ICHP(49), ISTR(49), IBAR(49)
+      DIMENSION P0(5), LL(10), PD(10,5), BE(3), LCON(7:14)
+      DATA EMIN /0.7/
+      DATA LCON /6,6,11,11,9,9,14,13/
+      DATA PCHEX /0.33/            ! probability of charge exchange
+
+      LA = IABS(L0)
+      DELTAE = P0(5) - AM(LA)
+
+C..."string-like" decay
+      IF (DELTAE .GT. EMIN)  THEN
+           N1 = NP+1
+         CALL HSPLI(L0,IFL1,IFL2)
+         IF (P0(3) .GT. 0.)  THEN
+            IFLA = IFL2
+            IFL2 = IFL1
+            IFL1 = IFLA
+         ENDIF
+10         CALL STRING_FRAG (P0(5), IFL1, IFL2, 0.,0.,0.,0.,IFBAD)
+         IF (IFBAD .EQ. 1)  GOTO 10
+         DO J=1,3
+            BE(J)=P0(J)/P0(4)
+         ENDDO
+         GA=P0(4)/P0(5)
+         DO I=N1,NP
+            BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
+            DO J=1,3
+               P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J)
+            ENDDO
+            P(I,4)=GA*(P(I,4)+BEP)
+         ENDDO
+
+C...Phase space decay of the excited state
+      ELSE
+        AV = 2.*SQRT(DELTAE)
+100        NPI = AV*(1.+0.5*GASDEV(0))
+        IF(NPI.LE.0.OR.NPI.GT.9.OR.AM(LA)+NPI*AM(7)+0.02
+     .            .GT.P0(5))  GOTO 100
+        IF (RNDM(0).LT.PCHEX)  THEN
+         LL(NPI+1) = LCON(LA)*ISIGN(1,L0)
+         IF(L0 .EQ. 11)  LL(NPI+1) = LL(NPI+1)+INT(2.*RNDM(0))
+        ELSE
+            LL(NPI+1) = L0
+        ENDIF
+        JQQ = ICHP(LA)*ISIGN(1,L0)-
+     .            ICHP(IABS(LL(NPI+1)))*ISIGN(1,LL(NPI+1))
+120        JQTOT = 0.
+        DO K=1,NPI-1
+           LL(K) = 6+INT(RNDM(0)*2.99999)
+           JQTOT = JQTOT + ICHP(LL(K))
+        ENDDO
+        JQR = JQQ-JQTOT
+        IF (JQR.LT.-1.OR.JQR.GT.1)  GOTO 120
+        LL(NPI) = 6+JQR
+        IF (LL(NPI) .EQ. 5)  LL(NPI)=8
+        CALL DECPAR (0,P0,NPI+1,LL, PD)
+        DO J=1,NPI+1
+           NP = NP+1
+           LLIST(NP) = LL(J)
+           DO K=1,5
+              P(NP,K) = PD(J,K)
+           ENDDO
+        ENDDO
+      ENDIF
+      RETURN
+      END
+
+
+      SUBROUTINE DIFF_GEN (L0, JDIF)
+C----------------------------------------------------------------------------
+C  Code for diffraction
+C----------------------------------------------------------------------------
+C...Single diffractive interaction
+C.  INPUT L0 = index of "beam particle"
+C.             the target is assumed to be a proton.
+C.        JDIF = 1  "beam diffraction"
+C.             = 2  "target diffraction"
+C.             = 3  "double diffraction"
+C......................................................
+      COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
+      COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
+      COMMON /S_MASS1/ AM(49), AM2(49)
+      COMMON /S_CHIST/ NW,NJET,NNJET(15),XX1JET(100)
+     +   ,XX2JET(100),PPTJET(100),PHIJET(100),NNPJET(100),NNPSTR(30)
+     +   , JJDIF, XMB, XMT
+      DIMENSION XM2MIN(3), ALXMIN(3)
+      DIMENSION P0(5)
+      DIMENSION KK(7:14)
+
+      DATA PI /3.1415926/
+      DATA KK /2*2,4*3,2*1/
+      DATA XM2MIN /1.5, 0.2, 0.6/                  ! M_x**2(min) GeV**2
+      DATA ALXMIN /0.405465,-1.6094379,-0.5108256/      ! log[M_x**2(min)]
+      DATA SLOP0 /6.5/            ! b (slope_ for Mx**2 > 5 GeV**2
+      DATA ASLOP /31.10362/            ! fit to the slope parameter.
+      DATA BSLOP /-15.29012/
+
+      LA = IABS(L0)
+      XM2MAX = 0.10*S
+
+C...Double diffraction
+      IF (JDIF .EQ. 3)   THEN
+         K = KK(LA)
+         AL = LOG(XM2MAX/XM2MIN(K))
+         ALX = ALXMIN(K) + AL*RNDM(0)
+         XMB2 = EXP(ALX)
+         XMB = SQRT (XMB2)
+         AL = LOG(XM2MAX/XM2MIN(1))
+         ALX = ALXMIN(1) + AL*RNDM(0)
+         XMT2 = EXP(ALX)
+         XMT = SQRT (XMT2)
+         X1 = 1.+(XMB2-XMT2)/S
+         X2 = 2.-X1
+         SLOPE = MAX(SLOP0, ASLOP+BSLOP*ALX)
+50       T = -LOG(RNDM(0))/SLOPE
+         PT = SQRT(T)
+         PZ1 = 0.25*S*X1*X1-XMB2-PT*PT
+         PZ2 = 0.25*S*X2*X2-XMT2-PT*PT
+         IF (PZ1.LT.0. .OR. PZ2.LT.0.)   GOTO 50
+         PHI = PI*RNDM(0)
+         P0(5) = XMB
+         P0(4) = 0.5*SQS*X1
+         P0(1) = PT*COS(PHI)
+         P0(2) = PT*SIN(PHI)
+         P0(3) = SQRT(PZ1)
+         CALL DIFDEC (L0, P0)
+         P0(5) = XMT
+         P0(4) = 0.5*SQS*X2
+         P0(1) = -P0(1)
+         P0(2) = -P0(2)
+         P0(3) = -SQRT(PZ2)
+         CALL DIFDEC (13, P0)
+         RETURN
+      ENDIF
+
+C...Single diffraction
+      IF (JDIF.EQ. 1)  THEN
+         K = KK(LA)
+         EM  = AM(13)
+         EM2 = AM2(13)
+         L = 13
+         ZD = -1.
+      ELSE
+         K = 1
+         EM  = AM(LA)
+         EM2 = AM2(LA)
+         L = L0
+         ZD = +1.
+      ENDIF
+C      Generate the mass of the diffracted system Mx (1/Mx**2 distribution)
+      AL = LOG(XM2MAX/XM2MIN(K))
+      ALX = ALXMIN(K) + AL*RNDM(0)
+      XM2 = EXP(ALX)
+      XM = SQRT (XM2)
+      XMB = XM
+      XMT = XM
+C      Generate the Kinematics of the pseudoelastic hadron
+      X = 1.-(XM2-EM2)/S
+      NP = NP+1
+      P(NP,4) = 0.5*SQS*X
+      SLOPE = MAX(SLOP0, ASLOP+BSLOP*ALX)
+60      T = -LOG(MAX(1.E-10,RNDM(0)))/SLOPE
+      PT = SQRT(T*X)
+      PZ2 = P(NP,4)**2-EM2 - PT*PT
+      IF (PZ2 .LT.0.)   GOTO 60
+      PHI = PI*RNDM(0)
+      P(NP,3) = SQRT(PZ2)*ZD
+      P(NP,1) = PT*COS(PHI)
+      P(NP,2) = PT*SIN(PHI)
+      P(NP,5) = EM
+      LLIST(NP) = L
+C      Generating the hadronic system recoling against the produced particle
+      P0(5) = SQRT(XM2)
+      P0(4) = 0.5*SQS*(2.-X)
+      DO J=1,3
+         P0(J) = -P(NP,J)
+      ENDDO
+      CALL DIFDEC (L0, P0)
+      RETURN
+      END
+      function estar(ap,at,b)
+      implicit real*8(a-h,o-z)
+      real*4 ap,at,b,estar
+      sigma=4.5  !total n-n cross section in fm**2
+      rt=.82*at**.3333 !target radius
+      rp=.82*ap**.3333 !projectile radius
+      alpha=rt**2/rp**2
+      beta=b**2/rt**2
+      f=at*sigma/(3.14159*rt**2)
+      alf = log(f)
+      alalf = log(alpha)
+      gfac=0
+      gfac1=0
+      s1=0.
+      s2=0.
+      s3=0.
+      ii=1
+      do n=0,10 ! This limit may not need to be so high.
+         if(n.ge.2) then
+            gfac1=gfac
+            gfac=gfac+log(float(n))
+         endif
+         g0=n*alf -n*beta*alpha/(n+alpha)+alalf
+         g1=g0-log(alpha+n)-gfac
+         g2=(n+2)*log(f)-(n+2)*beta*alpha/(n+2+alpha)
+     >      +log(n+2+alpha+beta*alpha**2)-3*log(n+2+alpha)-gfac
+         g3=g0-2*log(n+alpha)-gfac1
+         ii=-ii
+         s1=s1+ii*exp(g1)
+         s2=s2+ii*exp(g2)
+         if(n.ge.1) s3=s3+ii*exp(g3)
+      enddo
+
+      pb=s1
+      e1b=197.**2/(2*938.*rp**2*pb) *s2
+c      a=b*(s3/pb-1)
+c      a=-b*s3/pb
+c      e2b=-.5* 938. * (41./(ap**.333))**2 * a**2 /(197.**2)
+c      estar=e1b+e2b
+      estar = e1b
+      return
+      end
+
+      FUNCTION ESTARP (NPF, NW)
+C CONTRIBUTION TO E* FROM ENERGY DEPOSITED BY SECONDARIES
+C VERY NAIVE VERSION INCORPORATING HUEFFNER'S IDEAS
+      APF = NPF
+      F1 = 15.3/APF**0.666666666
+C AVERAGE KINETIC ENERGY/NUCLEON IN PREFRAGMENT (MeV)
+C PER PATHLENGTH EQUAL TO THE PREFRAGMENT RADIUS
+      ESTARP = 0.
+      DO I=1,NW
+      IF (RNDM(0) .GT. 0.5) THEN
+      F2 = F1*RDIS(0)
+      ESTARP = ESTARP + F2
+      ENDIF
+      ENDDO
+C SAMPLE RANDOMLY PER WOUNDED NUCLEON, x NW
+      RETURN
+      END
+      SUBROUTINE ESUM(N1,N2,ETOT,PXT,PYT,PZT,NF)
+C...Return the energy,px,py,pz and the number of stable
+C.  particles in the list between N1 and N2
+      COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
+      NF=0
+      ETOT=0.
+      PXT=0.
+      PYT=0.
+      PZT=0.
+      DO J=N1,N2
+         L = LLIST(J)
+         IF (IABS(L) .LT. 10000)  THEN
+           NF = NF+1
+           ETOT = ETOT + P(J,4)
+           PXT = PXT + P(J,1)
+           PYT = PYT + P(J,2)
+           PZT = PZT + P(J,3)
+         ENDIF
+      ENDDO
+      RETURN
+      END
+      subroutine evap(npf,eb,eps,nnuc,nalp)
+      eps=7.5+sqrt(8*eb)
+      n=min(npf*int(eb/eps),npf)
+      nalp=n/5
+      nnuc=n-4*nalp
+      return
+      end
+      SUBROUTINE FACT_INI
+      COMMON /S_CFACT/ FACT (0:20), CO_BIN(0:20,0:20)
+      FACT(0) = 1.
+      DO J=1,20
+         FACT(J) = FACT(J-1)*FLOAT(J)
+      ENDDO
+      DO J=0,20
+         DO K=0,J
+            CO_BIN(J,K) = FACT(J)/(FACT(K)*FACT(J-K))
+         ENDDO
+      ENDDO
+      RETURN
+      END
+      REAL FUNCTION FDIFFRACT(SQS,ipart)
+C==================================================================
+C..Diffractive cross sections
+C==================================================================
+C... This routine only includes pp scattering.
+C    INPUT    SQS (GeV)
+C             ipart is the code for the scattering particle(p,pi)
+C    OUTPUT:  DIFFRACT is the single diffractive cross
+C            section parameterized with a log.
+c            in mb.
+C                                    RSF
+C......................................................
+      real a(2),b(2)
+      data a/0.0,1.42/
+      data b/1.56,0.72/
+      FDIFFRACT =( a(ipart)+b(ipart)*log(sqs))/2.0
+      RETURN
+      END
+      FUNCTION FERMK(A)
+      DIMENSION AA(6), FK(6)
+      DATA AA/4., 6., 12., 24., 40., 57./
+      DATA FK/130.,169.,221.,235.,251.,260./
+      DO I=2,4
+      IF (A .LT. AA(I)) GO TO 25
+      ENDDO
+      I = 5
+   25      F11 = AA(I-1)
+      F12 = AA(I)
+      F13 = AA(I+1)
+      F21 = FK(I-1)
+      F22 = FK(I)
+      F23 = FK(I+1)
+      FERMK = QUAD_INT(A,F11,F12,F13, F21,F22,F23)
+      RETURN
+      END
+
+      SUBROUTINE FMINUS (S, FR, FI)
+      COMMON /BLOCKC/ AA, BETA, S0, CC, AMU, DD, ALPHA, A0
+      DATA PI /3.1415926/
+      F1 = S**(ALPHA-1.)
+      F2 = 0.5*PI*(1.-ALPHA)
+      FR = -DD*F1*COS(F2)
+      FI = -DD*F1*SIN(F2)
+      RETURN
+      END
+
+      SUBROUTINE FPLUS (S, FR, FI)
+      COMMON /BLOCKC/ AA, BETA, S0, CC, AMU, DD, ALPHA, A0
+      COMPLEX Z1, Z2, Z3
+      DATA PI /3.1415926/
+      F1 = LOG(S/S0)
+      Z1 = CMPLX(F1,-PI/2.)
+      Z1 = Z1*Z1
+      Z2 = 1. + A0*Z1
+      Z3 = Z1/Z2
+      F2 = CC*S**(AMU-1.)
+      F3 = 0.5*PI*(1.-AMU)
+      FI = AA + F2*COS(F3) + BETA*REAL(Z3)
+      FR = -BETA*AIMAG(Z3)+F2*SIN(F3)
+      RETURN
+      END
+
+      FUNCTION FPNI (E,L)
+C...This function  returns the interaction length
+C.  of an hadronic particle travelling in air
+C.  INPUT:   E (TeV)   particle energy
+C.           L         particle code
+C.  OUTPUT:  FPNI      (g cm-2)
+C...................................................
+        COMMON /CSAIR/ NSQS, ASQSMIN, ASQSMAX, DASQS,
+     +           SSIG0(41,2),SSIGA(41,2),ALINT(41,2)
+      DIMENSION KK(7:14)
+      DATA KK /6*2, 2*1/
+      SQS = SQRT(2000.*E*0.937)                        ! GeV
+      AL = LOG10 (SQS)
+      T = (AL-ASQSMIN)/DASQS
+      J = INT(T)
+C D.H.
+      J = MIN(J,39)
+      J = MAX(J,0)
+
+      T = T-FLOAT(J)
+      FPNI = (1.-T)*ALINT(J+1,KK(L)) + T*ALINT(J+2,KK(L))      ! g cm-2
+      RETURN
+      END
+
+      SUBROUTINE FRAGM (IAT,IAP, NW,B, NF, IAF)
+C...Nuclear Fragmentation, Abrasion-ablation model,
+C...Based on Jon Engel's routines ABRABL
+C...This most recent version adds for all prefragment
+C...masses > 10 the model calculation for the fragment
+C...mass distribution and the energy carried by the fragment
+C...of W. Friedmann
+C...The average values are used to implement the model
+C...in the montecarlo fashion / TSS, Dec '91
+C...Needs INITFRAG to fill in the model data from INITFRAG.TAB
+C.
+C.  INPUT: IAP = mass of incident nucleus
+C.         IAT = mass of target   nucleus
+C.         NW = number of wounded nucleons in the beam nucleus
+C.         B  = impact parameter in the interaction
+C.
+C.  OUTPUT : NF = number of fragments  of the spectator nucleus
+C.           IAF(1:NF) = mass number of each fragment
+C.           PF(3,60) in common block /FRAGMENTS/ contains
+C.           the three momentum components (MeV/c) of each
+C.           fragment in the projectile frame
+C..............................................................
+      COMMON /FRAGMENTS/ PPP(3,60)
+      COMMON /FRAGMOD/A(10,10,20),AE(10,10,20),ERES(10,10),NFLAGG(10,10)
+      DIMENSION IAF(60)
+      DIMENSION AA(10), EAA(10)
+      DATA AA/10.,15.,20.,25.,30.,35.,40.,45.,50.,56./
+      DATA EAA/1.,2.,4.,6.,8.,10.,12.,16.,20.,30/
+      AP=IAP
+      AT=IAT
+      NPF = IAP - NW
+      IF (NPF .EQ. 0) THEN
+         NF = 0
+         RETURN
+      ENDIF
+
+      EB = ESTAR(AP,AT, B)
+      EBP = ESTARP (NPF, NW)
+C CONTRIBUTION TO E* FROM ENERGY DEPOSITED BY SECONDARIES
+      EB = EB + EBP
+C TOTAL E* IS THE SUM OF THE TWO COMPONENTS
+
+C.....Prefragment transverse momentum (MeV/nucleon)...
+            FK = FERMK(AP)
+C FERMI MOMENTUM OF THE PROJECTILE NUCLEUS
+            IF (NW .LT. IAP) THEN
+            SIG = FK*SQRT(NW*NPF/(AP-1.))/3.162
+C GAUSSIAN SIGMA IN ALL THREE DIRECTION
+            ELSE
+            SIG = FK/3.162
+C THIS IS NOT CORRECT, TOO LARGE !!!!!!!!!!!!!!
+            ENDIF
+             PPFX = SIG*GASDEV(0)/NPF
+             PPFY = SIG*GASDEV(0)/NPF
+C THREE MOMENTUM COMPONENTS PER NUCLEON FOR THE PREFRAGMENT
+
+C.............Crude model for small prefragment mass .......
+            IF (NPF .LT. 10) THEN
+                 CALL EVAP(NPF, EB, EPS, NNUC, NALP)
+C                  EPS IS THE KINETIC ENERGY CARRIED BY THE EVAPORATED NUCLEONS
+               ETOT = 938. + EPS
+                 PP = SQRT((ETOT*ETOT - 8.79844E5)/3.)
+C                  AVERAGE MOMENTUM OF EVAPORATED NUCLEONS IN EACH DIRECTION
+                 NUC = NPF - NNUC - 4*NALP
+                 NF = 0
+                 IF (NUC .GT. 0) THEN
+                    NF = NF + 1
+                    IAF(NF) = NUC
+                    PPP(1,NF) = NUC*PPFX
+                    PPP(2,NF) = NUC*PPFY
+                 ENDIF
+                 IF (NALP .NE. 0) THEN
+                 DO I=1,NALP
+                   NF = NF + 1
+                    IAF(NF) = 4
+                   CALL SINCO(S1,C1)
+                   CALL SINCO(S2,C2)
+                   PXE = 4.*PP*S1*S2
+                   PYE = 4.*PP*S1*C2
+                   PPP(1,NF) = 4.*PPFX + PXE
+                   PPP(2,NF) = 4.*PPFY + PYE
+                   PPP(1,1) = PPP(1,1) - PXE
+                   PPP(2,1) = PPP(2,1) - PYE
+                 ENDDO
+                 ENDIF
+                 IF (NNUC .NE. 0) THEN
+                 DO I=1,NNUC
+                    NF = NF + 1
+                    IAF(NF) = 1
+                    CALL SINCO(S1,C1)
+                    CALL SINCO(S2,C2)
+                    PXE = PP*S1*S2
+                    PYE = PP*S1*C2
+                    PPP(1,NF) = 4.*PPFX + PXE
+                    PPP(2,NF) = 4.*PPFY + PYE
+                    PPP(1,1) = PPP(1,1) - PXE
+                    PPP(2,1) = PPP(2,1) - PYE
+                 ENDDO
+                 ENDIF
+                 RETURN
+            ENDIF
+
+C.........More refined model calculation .............
+      JA = NPF/5 -1
+      IF (JA .LT. 10) THEN
+      IF ((NPF - AA(JA)) .GT. (AA(JA+1)-NPF)) JA = JA + 1
+      ENDIF
+      ARAT = FLOAT(NPF)/AA(JA)
+      DO J=1,10
+      IF (EB .LT. EAA(J)) GO TO 29
+      ENDDO
+      JE = 10
+      GO TO 39
+   29      JE = J
+   39      IF (JE .GT. 1 .AND. JE .NE. 10) THEN
+      IF ((EB - EAA(J-1)) .LT. (EAA(J)-EB)) JE = J - 1
+      ENDIF
+      ERAT = EB/EAA(JE)
+        IF (EB .LT. 1.) THEN
+        ERAT = EB
+        ENDIF
+C INTERPOLATE BETWEEN EB=0. (NOTHING HAPPENS) AND EB = 1. MeV
+
+         IF (JA .EQ. 10 .AND. JE .GT. 6) THEN
+         WRITE(*,*)' JA=',JA,',   JE=',JE
+         ENDIF
+   43      ESUM = 0.
+      NSUM = 0
+      JF = 0
+      DO J=20,1,-1
+      FR =  A(JA, JE, J)*ARAT*ERAT
+      N1 = 1 + FR
+      FR1 = FR/FLOAT(N1)
+      DO K=1, N1
+      IF (RNDM(0) .LT. FR1) THEN
+      JF = JF + 1
+      IAF(JF) = J
+      NSUM = NSUM + J
+      EKIN = ERAT*AE(JA,JE, J)
+         IF (EKIN .GT. 0.) THEN
+         ESUM = ESUM + EKIN
+         ETOT = 938.*IAF(JF) + EKIN
+           PP = SQRT(2.*(ETOT*ETOT - IAF(JF)**2*8.79844E5)/3.)
+         CALL SINCO(S1,C1)
+         CALL SINCO(S2,C2)
+         PPP(1,JF) = PP*S1*S2 + IAF(JF)*PPFX
+         PPP(2,JF) = PP*S1*C2 + IAF(JF)*PPFY
+         ENDIF
+        IF (NSUM .GT. NPF) THEN
+C        WRITE(*,*)' WARNING, NSUM=', NSUM,',  NPF=',NPF
+C        WRITE(*,*)'  ARAT =', ARAT
+        GO TO 43
+        ELSE
+        IF (NSUM .EQ. NPF) THEN
+        GO TO 44
+        ENDIF
+        ENDIF
+      ENDIF
+      ENDDO
+      ENDDO
+      IF (NFLAGG(JA,JE) .EQ. 0) THEN
+C 'THE RESIDUE' IS A NUCLEAR FRAGMENT
+      JF = JF + 1
+      IAF(JF) = NPF - NSUM
+      F1 = NPF*EB - ESUM
+      IF (F1 .LT. 0.) F1 = 0.
+C GIVE THE REST OF EB TO THE FRAGMENT
+      EKIN = F1
+         IF (EKIN .GT. 0.) THEN
+         ETOT = 938.*IAF(JF) + EKIN
+           PP = SQRT(2.*(ETOT*ETOT - IAF(JF)**2*8.79844E5)/3.)
+         CALL SINCO(S1,C1)
+         CALL SINCO(S2,C2)
+         PPP(1,JF) = PP*S1*S2 + IAF(JF)*PPFX
+         PPP(2,JF) = PP*S1*C2 + IAF(JF)*PPFY
+         ENDIF
+      ELSE
+C 'THE RESIDUE' CONSISTS OF SPECTATOR NUCLEONS
+      N1 = NPF - NSUM
+      DO K=1,N1
+      JF = JF + 1
+      IAF(JF) = 1
+      EKIN = ERAT*ERES(JA,JE)
+         IF (EKIN .GT. 0.) THEN
+         ETOT = 938.*IAF(JF) + EKIN
+           PP = SQRT(2.*(ETOT*ETOT - IAF(JF)**2*8.79844E5)/3.)
+         CALL SINCO(S1,C1)
+         CALL SINCO(S2,C2)
+         PPP(1,JF) = PP*S1*S2 + PPFX
+         PPP(2,JF) = PP*S1*C2 + PPFY
+         ENDIF
+      ENDDO
+      ENDIF
+   44      NF = JF
+      RETURN
+      END
+      SUBROUTINE FRAGM1 (IA,NW, NF, IAF)
+C...Nuclear Fragmentation
+C.  total dissolution of nucleus
+C..........................................
+      DIMENSION IAF(60)
+      NF = IA-NW
+      DO J=1,NF
+         IAF(J) = 1
+      ENDDO
+      RETURN
+      END
+      SUBROUTINE FRAGM2 (IA,NW, NF, IAF)
+C...Nuclear Fragmentation
+C.  Spectator in one single fragment
+C..........................................
+      DIMENSION IAF(60)
+      IF (IA-NW .GT. 0)  THEN
+         NF = 1
+         IAF(1) = IA-NW
+      ELSE
+         NF = 0
+      ENDIF
+      RETURN
+      END
+      BLOCK DATA FRAG_DATA
+C====================================================================
+C...Code of fragmentation  of spectator nucleons
+C.  based on Jon Engel  abrasion-ablation algorithms
+C...Data for the fragmentation of  nucleus  projectiles
+      COMMON /FRAGMOD/A(10,10,20),AE(10,10,20),ERES(10,10),NFLAGG(10,10)
+      DATA (NFLAGG(I, 1),I=1,10)  /
+     +    0,  0,  0,  0,  0,  0,  0,  0,  0,  0 /
+      DATA (NFLAGG(I, 2),I=1,10)  /
+     +    0,  0,  0,  0,  0,  0,  0,  0,  0,  0 /
+      DATA (NFLAGG(I, 3),I=1,10)  /
+     +    0,  0,  0,  0,  0,  0,  0,  0,  0,  0 /
+      DATA (NFLAGG(I, 4),I=1,10)  /
+     +    0,  0,  0,  0,  0,  0,  0,  0,  0,  0 /
+      DATA (NFLAGG(I, 5),I=1,10)  /
+     +    0,  0,  0,  0,  0,  0,  0,  0,  0,  0 /
+      DATA (NFLAGG(I, 6),I=1,10)  /
+     +    0,  0,  0,  0,  0,  0,  0,  1,  1,  1 /
+      DATA (NFLAGG(I, 7),I=1,10)  /
+     +    1,  1,  1,  1,  1,  1,  1,  1,  1,  1 /
+      DATA (NFLAGG(I, 8),I=1,10)  /
+     +    1,  1,  1,  1,  1,  1,  1,  1,  1,  1 /
+      DATA (NFLAGG(I, 9),I=1,10)  /
+     +    1,  1,  1,  1,  1,  1,  1,  1,  1,  1 /
+      DATA (NFLAGG(I,10),I=1,10)  /
+     +    1,  1,  1,  1,  1,  1,  1,  1,  1,  1 /
+      DATA (A(I, 1, 1),I=1,10)  /
+     +  .438E-01,.172    ,.283    ,.511    ,.715    ,.920    ,1.19    ,
+     +  1.37    ,1.65    ,2.14     /
+      DATA (A(I, 1, 2),I=1,10)  /
+     +  .147E-01,.249E-01,.439E-01,.592E-01,.776E-01,.886E-01,.108    ,
+     +  .117    ,.126    ,.128     /
+      DATA (A(I, 1, 3),I=1,10)  /
+     +  .216E-02,.627E-02,.834E-02,.108E-01,.144E-01,.152E-01,.196E-01,
+     +  .200E-01,.210E-01,.224E-01 /
+      DATA (A(I, 1, 4),I=1,10)  /
+     +  .593E-01,.653E-01,.116    ,.145    ,.184    ,.204    ,.234    ,
+     +  .257    ,.271    ,.248     /
+      DATA (A(I, 1, 5),I=1,10)  /
+     +  .000E+00,.918E-02,.362E-02,.805E-02,.436E-02,.728E-02,.466E-02,
+     +  .707E-02,.932E-02,.130E-01 /
+      DATA (A(I, 1, 6),I=1,10)  /
+     +  .000E+00,.180E-02,.247E-02,.208E-02,.224E-02,.214E-02,.226E-02,
+     +  .233E-02,.230E-02,.194E-02 /
+      DATA (A(I, 1, 7),I=1,10)  /
+     +  .000E+00,.106E-02,.703E-03,.687E-03,.739E-03,.674E-03,.819E-03,
+     +  .768E-03,.756E-03,.720E-03 /
+      DATA (A(I, 1, 8),I=1,10)  /
+     +  .000E+00,.000E+00,.188E-02,.130E-02,.138E-02,.117E-02,.124E-02,
+     +  .119E-02,.111E-02,.829E-03 /
+      DATA (A(I, 1, 9),I=1,10)  /
+     +  .000E+00,.000E+00,.302E-03,.258E-03,.249E-03,.208E-03,.248E-03,
+     +  .222E-03,.210E-03,.187E-03 /
+      DATA (A(I, 1,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.235E-03,.222E-03,.172E-03,.181E-03,
+     +  .166E-03,.152E-03,.124E-03 /
+      DATA (A(I, 1,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.238E-03,.179E-03,.145E-03,.156E-03,
+     +  .138E-03,.129E-03,.111E-03 /
+      DATA (A(I, 1,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.368E-03,.400E-03,.255E-03,.262E-03,
+     +  .221E-03,.182E-03,.112E-03 /
+      DATA (A(I, 1,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.753E-04,.712E-04,.527E-04,
+     +  .537E-04,.538E-04,.487E-04 /
+      DATA (A(I, 1,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.103E-03,.589E-04,.578E-04,
+     +  .468E-04,.385E-04,.269E-04 /
+      DATA (A(I, 1,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.444E-04,.372E-04,
+     +  .318E-04,.284E-04,.218E-04 /
+      DATA (A(I, 1,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.487E-04,.473E-04,
+     +  .338E-04,.243E-04,.122E-04 /
+      DATA (A(I, 1,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.121E-04,.117E-04,
+     +  .932E-05,.792E-05,.583E-05 /
+      DATA (A(I, 1,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.147E-04,
+     +  .101E-04,.756E-05,.496E-05 /
+      DATA (A(I, 1,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.755E-05,
+     +  .612E-05,.505E-05,.341E-05 /
+      DATA (A(I, 1,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  .630E-05,.444E-05,.282E-05 /
+      DATA (A(I, 2, 1),I=1,10)  /
+     +  .269    ,.510    ,.738    ,1.12    ,1.46    ,1.83    ,2.22    ,
+     +  2.57    ,3.00    ,3.67     /
+      DATA (A(I, 2, 2),I=1,10)  /
+     +  .121    ,.133    ,.190    ,.234    ,.293    ,.332    ,.395    ,
+     +  .431    ,.468    ,.502     /
+      DATA (A(I, 2, 3),I=1,10)  /
+     +  .227E-01,.374E-01,.474E-01,.578E-01,.722E-01,.794E-01,.960E-01,
+     +  .102    ,.110    ,.120     /
+      DATA (A(I, 2, 4),I=1,10)  /
+     +  .287    ,.196    ,.270    ,.314    ,.373    ,.408    ,.462    ,
+     +  .498    ,.529    ,.523     /
+      DATA (A(I, 2, 5),I=1,10)  /
+     +  .000E+00,.433E-01,.218E-01,.384E-01,.263E-01,.385E-01,.298E-01,
+     +  .405E-01,.504E-01,.671E-01 /
+      DATA (A(I, 2, 6),I=1,10)  /
+     +  .000E+00,.151E-01,.177E-01,.159E-01,.173E-01,.173E-01,.187E-01,
+     +  .196E-01,.201E-01,.191E-01 /
+      DATA (A(I, 2, 7),I=1,10)  /
+     +  .000E+00,.457E-02,.607E-02,.610E-02,.677E-02,.670E-02,.784E-02,
+     +  .787E-02,.806E-02,.803E-02 /
+      DATA (A(I, 2, 8),I=1,10)  /
+     +  .000E+00,.000E+00,.702E-02,.536E-02,.558E-02,.510E-02,.554E-02,
+     +  .546E-02,.538E-02,.489E-02 /
+      DATA (A(I, 2, 9),I=1,10)  /
+     +  .000E+00,.000E+00,.190E-02,.199E-02,.205E-02,.191E-02,.221E-02,
+     +  .214E-02,.213E-02,.204E-02 /
+      DATA (A(I, 2,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.226E-02,.219E-02,.195E-02,.208E-02,
+     +  .204E-02,.203E-02,.194E-02 /
+      DATA (A(I, 2,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.213E-02,.195E-02,.175E-02,.191E-02,
+     +  .183E-02,.179E-02,.166E-02 /
+      DATA (A(I, 2,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.588E-03,.186E-02,.137E-02,.141E-02,
+     +  .128E-02,.117E-02,.947E-03 /
+      DATA (A(I, 2,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.554E-03,.562E-03,.454E-03,
+     +  .485E-03,.505E-03,.509E-03 /
+      DATA (A(I, 2,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.490E-03,.533E-03,.531E-03,
+     +  .476E-03,.437E-03,.369E-03 /
+      DATA (A(I, 2,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.427E-03,.382E-03,
+     +  .358E-03,.340E-03,.294E-03 /
+      DATA (A(I, 2,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.239E-03,.298E-03,
+     +  .238E-03,.196E-03,.134E-03 /
+      DATA (A(I, 2,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.299E-04,.893E-04,
+     +  .796E-04,.744E-04,.683E-04 /
+      DATA (A(I, 2,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.127E-03,
+     +  .107E-03,.916E-04,.720E-04 /
+      DATA (A(I, 2,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.397E-04,
+     +  .630E-04,.565E-04,.461E-04 /
+      DATA (A(I, 2,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  .511E-04,.459E-04,.402E-04 /
+      DATA (A(I, 3, 1),I=1,10)  /
+     +  .708    ,1.02    ,1.41    ,1.91    ,2.42    ,3.00    ,3.53    ,
+     +  4.09    ,4.71    ,5.57     /
+      DATA (A(I, 3, 2),I=1,10)  /
+     +  .397    ,.410    ,.539    ,.648    ,.795    ,.910    ,1.06    ,
+     +  1.17    ,1.29    ,1.42     /
+      DATA (A(I, 3, 3),I=1,10)  /
+     +  .845E-01,.122    ,.157    ,.190    ,.232    ,.262    ,.307    ,
+     +  .335    ,.366    ,.402     /
+      DATA (A(I, 3, 4),I=1,10)  /
+     +  .210    ,.379    ,.450    ,.490    ,.574    ,.636    ,.709    ,
+     +  .769    ,.820    ,.849     /
+      DATA (A(I, 3, 5),I=1,10)  /
+     +  .000E+00,.102    ,.675E-01,.104    ,.858E-01,.115    ,.102    ,
+     +  .129    ,.154    ,.194     /
+      DATA (A(I, 3, 6),I=1,10)  /
+     +  .000E+00,.392E-01,.615E-01,.593E-01,.649E-01,.674E-01,.735E-01,
+     +  .779E-01,.817E-01,.828E-01 /
+      DATA (A(I, 3, 7),I=1,10)  /
+     +  .000E+00,.539E-02,.222E-01,.238E-01,.269E-01,.280E-01,.320E-01,
+     +  .334E-01,.350E-01,.361E-01 /
+      DATA (A(I, 3, 8),I=1,10)  /
+     +  .000E+00,.000E+00,.838E-02,.130E-01,.133E-01,.131E-01,.141E-01,
+     +  .144E-01,.149E-01,.152E-01 /
+      DATA (A(I, 3, 9),I=1,10)  /
+     +  .000E+00,.000E+00,.228E-02,.647E-02,.688E-02,.687E-02,.772E-02,
+     +  .786E-02,.811E-02,.824E-02 /
+      DATA (A(I, 3,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.664E-02,.828E-02,.802E-02,.845E-02,
+     +  .869E-02,.902E-02,.930E-02 /
+      DATA (A(I, 3,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.338E-02,.735E-02,.710E-02,.767E-02,
+     +  .767E-02,.776E-02,.756E-02 /
+      DATA (A(I, 3,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.280E-03,.262E-02,.349E-02,.342E-02,
+     +  .322E-02,.312E-02,.291E-02 /
+      DATA (A(I, 3,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.618E-03,.161E-02,.138E-02,
+     +  .148E-02,.155E-02,.166E-02 /
+      DATA (A(I, 3,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.313E-03,.128E-02,.161E-02,
+     +  .150E-02,.144E-02,.134E-02 /
+      DATA (A(I, 3,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.645E-03,.118E-02,
+     +  .115E-02,.111E-02,.103E-02 /
+      DATA (A(I, 3,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.117E-03,.497E-03,
+     +  .581E-03,.501E-03,.401E-03 /
+      DATA (A(I, 3,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.115E-04,.997E-04,
+     +  .202E-03,.203E-03,.206E-03 /
+      DATA (A(I, 3,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.877E-04,
+     +  .242E-03,.263E-03,.226E-03 /
+      DATA (A(I, 3,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.158E-04,
+     +  .881E-04,.152E-03,.136E-03 /
+      DATA (A(I, 3,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  .358E-04,.997E-04,.117E-03 /
+      DATA (A(I, 4, 1),I=1,10)  /
+     +  .945    ,1.29    ,1.40    ,1.98    ,2.73    ,3.17    ,3.77    ,
+     +  4.29    ,4.78    ,5.54     /
+      DATA (A(I, 4, 2),I=1,10)  /
+     +  .581    ,.599    ,.645    ,.839    ,1.10    ,1.25    ,1.47    ,
+     +  1.64    ,1.78    ,1.99     /
+      DATA (A(I, 4, 3),I=1,10)  /
+     +  .127    ,.182    ,.202    ,.264    ,.344    ,.387    ,.455    ,
+     +  .504    ,.549    ,.611     /
+      DATA (A(I, 4, 4),I=1,10)  /
+     +  .183    ,.464    ,.351    ,.444    ,.642    ,.659    ,.772    ,
+     +  .830    ,.882    ,.930     /
+      DATA (A(I, 4, 5),I=1,10)  /
+     +  .000E+00,.122    ,.803E-01,.136    ,.134    ,.173    ,.164    ,
+     +  .203    ,.239    ,.300     /
+      DATA (A(I, 4, 6),I=1,10)  /
+     +  .000E+00,.393E-01,.766E-01,.872E-01,.108    ,.111    ,.123    ,
+     +  .132    ,.139    ,.145     /
+      DATA (A(I, 4, 7),I=1,10)  /
+     +  .000E+00,.416E-02,.289E-01,.360E-01,.454E-01,.477E-01,.549E-01,
+     +  .583E-01,.618E-01,.654E-01 /
+      DATA (A(I, 4, 8),I=1,10)  /
+     +  .000E+00,.000E+00,.761E-02,.157E-01,.214E-01,.205E-01,.233E-01,
+     +  .241E-01,.255E-01,.271E-01 /
+      DATA (A(I, 4, 9),I=1,10)  /
+     +  .000E+00,.000E+00,.238E-02,.803E-02,.123E-01,.123E-01,.140E-01,
+     +  .145E-01,.153E-01,.160E-01 /
+      DATA (A(I, 4,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.695E-02,.150E-01,.154E-01,.166E-01,
+     +  .172E-01,.181E-01,.192E-01 /
+      DATA (A(I, 4,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.355E-02,.104E-01,.143E-01,.156E-01,
+     +  .158E-01,.164E-01,.165E-01 /
+      DATA (A(I, 4,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.112E-03,.276E-02,.568E-02,.736E-02,
+     +  .684E-02,.691E-02,.661E-02 /
+      DATA (A(I, 4,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.740E-03,.222E-02,.339E-02,
+     +  .352E-02,.382E-02,.409E-02 /
+      DATA (A(I, 4,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.369E-03,.160E-02,.322E-02,
+     +  .375E-02,.375E-02,.355E-02 /
+      DATA (A(I, 4,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.750E-03,.190E-02,
+     +  .298E-02,.319E-02,.299E-02 /
+      DATA (A(I, 4,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.260E-03,.673E-03,
+     +  .117E-02,.156E-02,.126E-02 /
+      DATA (A(I, 4,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.283E-05,.131E-03,
+     +  .363E-03,.618E-03,.690E-03 /
+      DATA (A(I, 4,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.205E-03,
+     +  .378E-03,.709E-03,.844E-03 /
+      DATA (A(I, 4,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.654E-05,
+     +  .150E-03,.341E-03,.527E-03 /
+      DATA (A(I, 4,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  .957E-04,.197E-03,.406E-03 /
+      DATA (A(I, 5, 1),I=1,10)  /
+     +  1.16    ,1.70    ,2.19    ,2.79    ,3.33    ,3.90    ,4.49    ,
+     +  5.07    ,5.66    ,6.38     /
+      DATA (A(I, 5, 2),I=1,10)  /
+     +  .779    ,.899    ,1.09    ,1.28    ,1.51    ,1.71    ,1.96    ,
+     +  2.18    ,2.39    ,2.62     /
+      DATA (A(I, 5, 3),I=1,10)  /
+     +  .167    ,.263    ,.334    ,.408    ,.482    ,.548    ,.632    ,
+     +  .700    ,.767    ,.840     /
+      DATA (A(I, 5, 4),I=1,10)  /
+     +  .203    ,.565    ,.845    ,.867    ,.906    ,.961    ,1.08    ,
+     +  1.13    ,1.21    ,1.25     /
+      DATA (A(I, 5, 5),I=1,10)  /
+     +  .000E+00,.129    ,.152    ,.237    ,.208    ,.268    ,.258    ,
+     +  .312    ,.368    ,.450     /
+      DATA (A(I, 5, 6),I=1,10)  /
+     +  .000E+00,.460E-01,.126    ,.174    ,.182    ,.188    ,.208    ,
+     +  .219    ,.233    ,.239     /
+      DATA (A(I, 5, 7),I=1,10)  /
+     +  .000E+00,.289E-02,.380E-01,.611E-01,.788E-01,.845E-01,.974E-01,
+     +  .103    ,.111    ,.117     /
+      DATA (A(I, 5, 8),I=1,10)  /
+     +  .000E+00,.000E+00,.137E-01,.223E-01,.374E-01,.436E-01,.488E-01,
+     +  .488E-01,.524E-01,.547E-01 /
+      DATA (A(I, 5, 9),I=1,10)  /
+     +  .000E+00,.000E+00,.162E-02,.114E-01,.198E-01,.263E-01,.315E-01,
+     +  .323E-01,.348E-01,.364E-01 /
+      DATA (A(I, 5,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.149E-01,.240E-01,.320E-01,.428E-01,
+     +  .436E-01,.469E-01,.493E-01 /
+      DATA (A(I, 5,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.562E-02,.194E-01,.290E-01,.408E-01,
+     +  .460E-01,.492E-01,.500E-01 /
+      DATA (A(I, 5,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.476E-04,.106E-01,.134E-01,.191E-01,
+     +  .227E-01,.264E-01,.253E-01 /
+      DATA (A(I, 5,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.281E-02,.679E-02,.879E-02,
+     +  .123E-01,.165E-01,.190E-01 /
+      DATA (A(I, 5,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.542E-04,.847E-02,.125E-01,
+     +  .144E-01,.173E-01,.192E-01 /
+      DATA (A(I, 5,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.652E-02,.982E-02,
+     +  .129E-01,.159E-01,.192E-01 /
+      DATA (A(I, 5,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.109E-03,.688E-02,
+     +  .751E-02,.845E-02,.905E-02 /
+      DATA (A(I, 5,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.823E-06,.237E-02,
+     +  .318E-02,.446E-02,.569E-02 /
+      DATA (A(I, 5,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.604E-03,
+     +  .610E-02,.673E-02,.827E-02 /
+      DATA (A(I, 5,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.716E-06,
+     +  .412E-02,.519E-02,.617E-02 /
+      DATA (A(I, 5,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  .710E-03,.543E-02,.674E-02 /
+      DATA (A(I, 6, 1),I=1,10)  /
+     +  1.36    ,2.08    ,2.67    ,3.30    ,3.94    ,4.62    ,5.18    ,
+     +  3.60    ,3.64    ,3.95     /
+      DATA (A(I, 6, 2),I=1,10)  /
+     +  1.07    ,1.33    ,1.58    ,1.82    ,2.10    ,2.44    ,2.74    ,
+     +  1.78    ,1.73    ,1.80     /
+      DATA (A(I, 6, 3),I=1,10)  /
+     +  .158    ,.276    ,.402    ,.506    ,.609    ,.700    ,.802    ,
+     +  .638    ,.629    ,.658     /
+      DATA (A(I, 6, 4),I=1,10)  /
+     +  .308    ,.739    ,1.02    ,1.12    ,1.26    ,1.35    ,1.57    ,
+     +  1.94    ,1.71    ,1.55     /
+      DATA (A(I, 6, 5),I=1,10)  /
+     +  .000E+00,.217    ,.183    ,.324    ,.276    ,.395    ,.393    ,
+     +  .558    ,.602    ,.681     /
+      DATA (A(I, 6, 6),I=1,10)  /
+     +  .000E+00,.658E-01,.251    ,.267    ,.299    ,.326    ,.386    ,
+     +  .452    ,.475    ,.409     /
+      DATA (A(I, 6, 7),I=1,10)  /
+     +  .000E+00,.198E-02,.774E-01,.136    ,.149    ,.164    ,.187    ,
+     +  .210    ,.238    ,.256     /
+      DATA (A(I, 6, 8),I=1,10)  /
+     +  .000E+00,.000E+00,.290E-01,.122    ,.139    ,.128    ,.129    ,
+     +  .137    ,.147    ,.167     /
+      DATA (A(I, 6, 9),I=1,10)  /
+     +  .000E+00,.000E+00,.699E-03,.617E-01,.750E-01,.801E-01,.905E-01,
+     +  .974E-01,.105    ,.122     /
+      DATA (A(I, 6,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.310E-01,.112    ,.127    ,.140    ,
+     +  .143    ,.155    ,.176     /
+      DATA (A(I, 6,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.277E-02,.889E-01,.143    ,.150    ,
+     +  .175    ,.184    ,.208     /
+      DATA (A(I, 6,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.202E-04,.343E-01,.959E-01,.109    ,
+     +  .115    ,.112    ,.116     /
+      DATA (A(I, 6,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.186E-02,.435E-01,.512E-01,
+     +  .744E-01,.856E-01,.103     /
+      DATA (A(I, 6,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.144E-04,.427E-01,.786E-01,
+     +  .911E-01,.993E-01,.108     /
+      DATA (A(I, 6,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.466E-02,.518E-01,
+     +  .848E-01,.109    ,.119     /
+      DATA (A(I, 6,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.655E-05,.330E-01,
+     +  .586E-01,.617E-01,.594E-01 /
+      DATA (A(I, 6,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.228E-06,.328E-02,
+     +  .190E-01,.301E-01,.454E-01 /
+      DATA (A(I, 6,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.218E-04,
+     +  .272E-01,.501E-01,.707E-01 /
+      DATA (A(I, 6,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.146E-06,
+     +  .441E-02,.378E-01,.556E-01 /
+      DATA (A(I, 6,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  .160E-03,.204E-01,.679E-01 /
+      DATA (A(I, 7, 1),I=1,10)  /
+     +  .522    ,.862    ,1.14    ,1.40    ,1.70    ,1.94    ,2.26    ,
+     +  2.48    ,2.72    ,3.95     /
+      DATA (A(I, 7, 2),I=1,10)  /
+     +  .314    ,.450    ,.588    ,.692    ,.834    ,.936    ,1.09    ,
+     +  1.18    ,1.28    ,1.80     /
+      DATA (A(I, 7, 3),I=1,10)  /
+     +  .814E-01,.147    ,.189    ,.226    ,.272    ,.302    ,.351    ,
+     +  .378    ,.406    ,.658     /
+      DATA (A(I, 7, 4),I=1,10)  /
+     +  .252    ,.864    ,1.01    ,.851    ,.837    ,.774    ,.763    ,
+     +  .757    ,.748    ,1.55     /
+      DATA (A(I, 7, 5),I=1,10)  /
+     +  .000E+00,.225    ,.180    ,.276    ,.193    ,.240    ,.190    ,
+     +  .228    ,.259    ,.681     /
+      DATA (A(I, 7, 6),I=1,10)  /
+     +  .000E+00,.485E-01,.272    ,.273    ,.253    ,.216    ,.206    ,
+     +  .197    ,.191    ,.409     /
+      DATA (A(I, 7, 7),I=1,10)  /
+     +  .000E+00,.137E-02,.752E-01,.137    ,.152    ,.134    ,.125    ,
+     +  .119    ,.116    ,.256     /
+      DATA (A(I, 7, 8),I=1,10)  /
+     +  .000E+00,.000E+00,.220E-01,.155    ,.175    ,.155    ,.116    ,
+     +  .977E-01,.858E-01,.167     /
+      DATA (A(I, 7, 9),I=1,10)  /
+     +  .000E+00,.000E+00,.326E-03,.695E-01,.881E-01,.106    ,.897E-01,
+     +  .782E-01,.706E-01,.122     /
+      DATA (A(I, 7,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.261E-01,.124    ,.131    ,.156    ,
+     +  .141    ,.121    ,.176     /
+      DATA (A(I, 7,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.785E-03,.864E-01,.130    ,.170    ,
+     +  .182    ,.172    ,.208     /
+      DATA (A(I, 7,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.896E-05,.225E-01,.105    ,.126    ,
+     +  .126    ,.135    ,.116     /
+      DATA (A(I, 7,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.542E-03,.427E-01,.553E-01,
+     +  .744E-01,.980E-01,.103     /
+      DATA (A(I, 7,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.515E-05,.377E-01,.831E-01,
+     +  .985E-01,.104    ,.108     /
+      DATA (A(I, 7,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.285E-02,.495E-01,
+     +  .871E-01,.106    ,.119     /
+      DATA (A(I, 7,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.110E-05,.284E-01,
+     +  .588E-01,.657E-01,.594E-01 /
+      DATA (A(I, 7,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.722E-07,.176E-02,
+     +  .170E-01,.305E-01,.454E-01 /
+      DATA (A(I, 7,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.148E-05,
+     +  .213E-01,.492E-01,.707E-01 /
+      DATA (A(I, 7,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.323E-07,
+     +  .722E-02,.359E-01,.556E-01 /
+      DATA (A(I, 7,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  .461E-05,.155E-01,.679E-01 /
+      DATA (A(I, 8, 1),I=1,10)  /
+     +  .630    ,.974    ,1.29    ,1.58    ,1.89    ,2.16    ,2.49    ,
+     +  2.75    ,3.02    ,3.95     /
+      DATA (A(I, 8, 2),I=1,10)  /
+     +  .328    ,.459    ,.613    ,.735    ,.879    ,.994    ,1.15    ,
+     +  1.27    ,1.38    ,1.80     /
+      DATA (A(I, 8, 3),I=1,10)  /
+     +  .748E-01,.121    ,.164    ,.197    ,.235    ,.265    ,.310    ,
+     +  .339    ,.370    ,.658     /
+      DATA (A(I, 8, 4),I=1,10)  /
+     +  .194    ,.211    ,.337    ,.344    ,.339    ,.351    ,.390    ,
+     +  .419    ,.442    ,1.55     /
+      DATA (A(I, 8, 5),I=1,10)  /
+     +  .000E+00,.869E-01,.725E-01,.113    ,.810E-01,.106    ,.951E-01,
+     +  .120    ,.143    ,.681     /
+      DATA (A(I, 8, 6),I=1,10)  /
+     +  .000E+00,.288E-01,.102    ,.922E-01,.857E-01,.845E-01,.932E-01,
+     +  .983E-01,.102    ,.409     /
+      DATA (A(I, 8, 7),I=1,10)  /
+     +  .000E+00,.668E-03,.533E-01,.575E-01,.493E-01,.482E-01,.539E-01,
+     +  .558E-01,.582E-01,.256     /
+      DATA (A(I, 8, 8),I=1,10)  /
+     +  .000E+00,.000E+00,.205E-01,.808E-01,.510E-01,.409E-01,.406E-01,
+     +  .394E-01,.389E-01,.167     /
+      DATA (A(I, 8, 9),I=1,10)  /
+     +  .000E+00,.000E+00,.999E-04,.647E-01,.385E-01,.325E-01,.325E-01,
+     +  .316E-01,.314E-01,.122     /
+      DATA (A(I, 8,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.169E-01,.834E-01,.611E-01,.565E-01,
+     +  .533E-01,.519E-01,.176     /
+      DATA (A(I, 8,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.107E-03,.769E-01,.922E-01,.805E-01,
+     +  .745E-01,.711E-01,.208     /
+      DATA (A(I, 8,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.180E-05,.143E-01,.983E-01,.775E-01,
+     +  .627E-01,.541E-01,.116     /
+      DATA (A(I, 8,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.157E-04,.346E-01,.507E-01,
+     +  .479E-01,.455E-01,.103     /
+      DATA (A(I, 8,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.752E-06,.248E-01,.721E-01,
+     +  .728E-01,.611E-01,.108     /
+      DATA (A(I, 8,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.686E-04,.356E-01,
+     +  .731E-01,.791E-01,.119     /
+      DATA (A(I, 8,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.838E-07,.151E-01,
+     +  .470E-01,.567E-01,.594E-01 /
+      DATA (A(I, 8,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.759E-08,.400E-04,
+     +  .193E-01,.313E-01,.454E-01 /
+      DATA (A(I, 8,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.385E-07,
+     +  .921E-02,.353E-01,.707E-01 /
+      DATA (A(I, 8,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.219E-08,
+     +  .348E-03,.226E-01,.556E-01 /
+      DATA (A(I, 8,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  .212E-07,.149E-01,.679E-01 /
+      DATA (A(I, 9, 1),I=1,10)  /
+     +  .736    ,1.13    ,1.49    ,1.82    ,2.20    ,2.49    ,2.86    ,
+     +  3.17    ,3.49    ,3.95     /
+      DATA (A(I, 9, 2),I=1,10)  /
+     +  .339    ,.492    ,.658    ,.789    ,.958    ,1.08    ,1.25    ,
+     +  1.37    ,1.50    ,1.80     /
+      DATA (A(I, 9, 3),I=1,10)  /
+     +  .680E-01,.110    ,.150    ,.180    ,.222    ,.247    ,.289    ,
+     +  .318    ,.349    ,.658     /
+      DATA (A(I, 9, 4),I=1,10)  /
+     +  .110    ,.104    ,.157    ,.156    ,.210    ,.205    ,.246    ,
+     +  .274    ,.300    ,1.55     /
+      DATA (A(I, 9, 5),I=1,10)  /
+     +  .000E+00,.379E-01,.347E-01,.477E-01,.486E-01,.576E-01,.569E-01,
+     +  .732E-01,.893E-01,.681     /
+      DATA (A(I, 9, 6),I=1,10)  /
+     +  .000E+00,.223E-01,.354E-01,.312E-01,.436E-01,.400E-01,.489E-01,
+     +  .548E-01,.600E-01,.409     /
+      DATA (A(I, 9, 7),I=1,10)  /
+     +  .000E+00,.338E-03,.149E-01,.142E-01,.215E-01,.188E-01,.248E-01,
+     +  .278E-01,.307E-01,.256     /
+      DATA (A(I, 9, 8),I=1,10)  /
+     +  .000E+00,.000E+00,.553E-02,.862E-02,.150E-01,.106E-01,.145E-01,
+     +  .165E-01,.181E-01,.167     /
+      DATA (A(I, 9, 9),I=1,10)  /
+     +  .000E+00,.000E+00,.375E-04,.641E-02,.111E-01,.792E-02,.112E-01,
+     +  .127E-01,.140E-01,.122     /
+      DATA (A(I, 9,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.112E-01,.200E-01,.127E-01,.176E-01,
+     +  .200E-01,.220E-01,.176     /
+      DATA (A(I, 9,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.244E-04,.261E-01,.162E-01,.232E-01,
+     +  .263E-01,.287E-01,.208     /
+      DATA (A(I, 9,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.455E-06,.635E-02,.121E-01,.186E-01,
+     +  .201E-01,.207E-01,.116     /
+      DATA (A(I, 9,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.146E-05,.922E-02,.116E-01,
+     +  .145E-01,.165E-01,.103     /
+      DATA (A(I, 9,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.135E-06,.128E-01,.202E-01,
+     +  .215E-01,.220E-01,.108     /
+      DATA (A(I, 9,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.237E-05,.229E-01,
+     +  .259E-01,.271E-01,.119     /
+      DATA (A(I, 9,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.100E-07,.534E-02,
+     +  .210E-01,.193E-01,.594E-01 /
+      DATA (A(I, 9,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.915E-09,.847E-06,
+     +  .119E-01,.125E-01,.454E-01 /
+      DATA (A(I, 9,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.298E-08,
+     +  .101E-01,.242E-01,.707E-01 /
+      DATA (A(I, 9,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.196E-09,
+     +  .243E-05,.234E-01,.556E-01 /
+      DATA (A(I, 9,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  .575E-09,.364E-02,.679E-01 /
+      DATA (A(I,10, 1),I=1,10)  /
+     +  .959    ,1.46    ,1.92    ,2.34    ,2.80    ,3.24    ,3.64    ,
+     +  4.05    ,4.48    ,3.95     /
+      DATA (A(I,10, 2),I=1,10)  /
+     +  .343    ,.516    ,.692    ,.836    ,1.01    ,1.16    ,1.31    ,
+     +  1.46    ,1.61    ,1.80     /
+      DATA (A(I,10, 3),I=1,10)  /
+     +  .512E-01,.837E-01,.115    ,.138    ,.169    ,.195    ,.220    ,
+     +  .245    ,.270    ,.658     /
+      DATA (A(I,10, 4),I=1,10)  /
+     +  .274E-01,.361E-01,.510E-01,.562E-01,.703E-01,.828E-01,.877E-01,
+     +  .996E-01,.111    ,1.55     /
+      DATA (A(I,10, 5),I=1,10)  /
+     +  .000E+00,.850E-02,.875E-02,.118E-01,.124E-01,.170E-01,.154E-01,
+     +  .194E-01,.237E-01,.681     /
+      DATA (A(I,10, 6),I=1,10)  /
+     +  .000E+00,.345E-02,.519E-02,.533E-02,.691E-02,.842E-02,.844E-02,
+     +  .987E-02,.113E-01,.409     /
+      DATA (A(I,10, 7),I=1,10)  /
+     +  .000E+00,.722E-04,.130E-02,.135E-02,.189E-02,.240E-02,.235E-02,
+     +  .281E-02,.331E-02,.256     /
+      DATA (A(I,10, 8),I=1,10)  /
+     +  .000E+00,.000E+00,.283E-03,.272E-03,.394E-03,.557E-03,.480E-03,
+     +  .616E-03,.775E-03,.167     /
+      DATA (A(I,10, 9),I=1,10)  /
+     +  .000E+00,.000E+00,.457E-05,.122E-03,.192E-03,.275E-03,.225E-03,
+     +  .292E-03,.373E-03,.122     /
+      DATA (A(I,10,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.119E-03,.185E-03,.278E-03,.201E-03,
+     +  .274E-03,.364E-03,.176     /
+      DATA (A(I,10,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.140E-05,.129E-03,.200E-03,.137E-03,
+     +  .188E-03,.252E-03,.208     /
+      DATA (A(I,10,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.207E-07,.307E-04,.518E-04,.278E-04,
+     +  .421E-04,.608E-04,.116     /
+      DATA (A(I,10,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.306E-07,.252E-04,.111E-04,
+     +  .188E-04,.295E-04,.103     /
+      DATA (A(I,10,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.321E-08,.220E-04,.104E-04,
+     +  .162E-04,.243E-04,.108     /
+      DATA (A(I,10,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.770E-08,.632E-05,
+     +  .105E-04,.162E-04,.119     /
+      DATA (A(I,10,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.117E-09,.199E-05,
+     +  .321E-05,.492E-05,.594E-01 /
+      DATA (A(I,10,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.888E-11,.323E-09,
+     +  .106E-05,.192E-05,.454E-01 /
+      DATA (A(I,10,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.174E-10,
+     +  .131E-05,.218E-05,.707E-01 /
+      DATA (A(I,10,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.994E-12,
+     +  .233E-09,.104E-05,.556E-01 /
+      DATA (A(I,10,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  .144E-11,.724E-06,.679E-01 /
+      DATA (AE(I, 1, 1),I=1,10)  /
+     +  7.27    ,6.29    ,7.76    ,6.70    ,8.17    ,7.34    ,8.70    ,
+     +  8.02    ,7.37    ,6.18     /
+      DATA (AE(I, 1, 2),I=1,10)  /
+     +  7.41    ,7.52    ,8.14    ,8.20    ,8.96    ,9.05    ,9.96    ,
+     +  10.0    ,10.1    ,9.86     /
+      DATA (AE(I, 1, 3),I=1,10)  /
+     +  7.72    ,7.69    ,9.17    ,8.99    ,10.6    ,10.5    ,12.1    ,
+     +  12.1    ,12.0    ,11.5     /
+      DATA (AE(I, 1, 4),I=1,10)  /
+     +  7.90    ,8.48    ,9.50    ,9.94    ,10.8    ,11.4    ,12.2    ,
+     +  12.8    ,13.3    ,13.8     /
+      DATA (AE(I, 1, 5),I=1,10)  /
+     +  .000E+00,8.52    ,9.59    ,10.1    ,11.1    ,11.8    ,12.7    ,
+     +  13.3    ,13.8    ,14.4     /
+      DATA (AE(I, 1, 6),I=1,10)  /
+     +  .000E+00,9.00    ,10.7    ,11.7    ,13.2    ,14.2    ,15.6    ,
+     +  16.5    ,17.3    ,18.0     /
+      DATA (AE(I, 1, 7),I=1,10)  /
+     +  .000E+00,9.01    ,11.1    ,11.9    ,14.3    ,15.0    ,17.4    ,
+     +  18.0    ,18.6    ,18.8     /
+      DATA (AE(I, 1, 8),I=1,10)  /
+     +  .000E+00,.000E+00,11.2    ,12.4    ,14.5    ,15.7    ,17.6    ,
+     +  18.8    ,19.9    ,20.9     /
+      DATA (AE(I, 1, 9),I=1,10)  /
+     +  .000E+00,.000E+00,11.4    ,12.7    ,15.5    ,16.6    ,19.3    ,
+     +  20.2    ,21.1    ,21.7     /
+      DATA (AE(I, 1,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,13.2    ,15.8    ,17.3    ,19.9    ,
+     +  21.2    ,22.4    ,23.2     /
+      DATA (AE(I, 1,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,13.2    ,16.3    ,17.8    ,20.8    ,
+     +  22.1    ,23.3    ,24.2     /
+      DATA (AE(I, 1,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,13.4    ,16.2    ,18.2    ,21.0    ,
+     +  22.8    ,24.4    ,25.9     /
+      DATA (AE(I, 1,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,16.5    ,18.4    ,21.6    ,
+     +  23.2    ,24.8    ,26.2     /
+      DATA (AE(I, 1,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,16.7    ,19.0    ,22.3    ,
+     +  24.3    ,26.1    ,27.4     /
+      DATA (AE(I, 1,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,19.1    ,22.8    ,
+     +  24.7    ,26.6    ,28.2     /
+      DATA (AE(I, 1,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,19.2    ,23.0    ,
+     +  25.3    ,27.5    ,29.5     /
+      DATA (AE(I, 1,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,19.6    ,23.3    ,
+     +  25.6    ,27.8    ,29.6     /
+      DATA (AE(I, 1,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,23.6    ,
+     +  26.2    ,28.5    ,30.4     /
+      DATA (AE(I, 1,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,23.7    ,
+     +  26.3    ,28.8    ,31.0     /
+      DATA (AE(I, 1,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  26.5    ,29.2    ,31.5     /
+      DATA (AE(I, 2, 1),I=1,10)  /
+     +  8.74    ,8.16    ,9.25    ,8.45    ,9.46    ,8.90    ,9.83    ,
+     +  9.38    ,8.96    ,8.15     /
+      DATA (AE(I, 2, 2),I=1,10)  /
+     +  8.96    ,9.30    ,9.95    ,10.0    ,10.8    ,10.9    ,11.7    ,
+     +  11.8    ,11.9    ,11.8     /
+      DATA (AE(I, 2, 3),I=1,10)  /
+     +  9.44    ,9.66    ,11.0    ,11.0    ,12.3    ,12.5    ,13.7    ,
+     +  13.9    ,14.0    ,13.8     /
+      DATA (AE(I, 2, 4),I=1,10)  /
+     +  8.86    ,9.81    ,10.8    ,11.2    ,12.0    ,12.6    ,13.4    ,
+     +  14.0    ,14.5    ,15.1     /
+      DATA (AE(I, 2, 5),I=1,10)  /
+     +  .000E+00,10.2    ,11.4    ,12.0    ,12.9    ,13.6    ,14.5    ,
+     +  15.1    ,15.7    ,16.3     /
+      DATA (AE(I, 2, 6),I=1,10)  /
+     +  .000E+00,10.7    ,12.5    ,13.5    ,15.1    ,16.0    ,17.5    ,
+     +  18.3    ,19.2    ,19.9     /
+      DATA (AE(I, 2, 7),I=1,10)  /
+     +  .000E+00,11.5    ,12.9    ,13.9    ,16.1    ,17.0    ,19.1    ,
+     +  19.8    ,20.6    ,21.0     /
+      DATA (AE(I, 2, 8),I=1,10)  /
+     +  .000E+00,.000E+00,12.4    ,13.8    ,15.9    ,17.2    ,19.1    ,
+     +  20.3    ,21.4    ,22.3     /
+      DATA (AE(I, 2, 9),I=1,10)  /
+     +  .000E+00,.000E+00,13.4    ,14.5    ,17.1    ,18.3    ,20.9    ,
+     +  21.9    ,23.0    ,23.7     /
+      DATA (AE(I, 2,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,14.9    ,17.5    ,19.1    ,21.6    ,
+     +  22.9    ,24.1    ,25.0     /
+      DATA (AE(I, 2,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,15.0    ,18.0    ,19.6    ,22.4    ,
+     +  23.8    ,25.2    ,26.2     /
+      DATA (AE(I, 2,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,16.2    ,17.3    ,19.4    ,22.2    ,
+     +  24.0    ,25.7    ,27.2     /
+      DATA (AE(I, 2,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,17.8    ,19.8    ,22.9    ,
+     +  24.6    ,26.2    ,27.7     /
+      DATA (AE(I, 2,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,19.1    ,20.4    ,23.7    ,
+     +  25.7    ,27.6    ,29.1     /
+      DATA (AE(I, 2,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,20.5    ,24.1    ,
+     +  26.1    ,28.1    ,29.9     /
+      DATA (AE(I, 2,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,20.9    ,23.9    ,
+     +  26.4    ,28.7    ,30.7     /
+      DATA (AE(I, 2,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,22.4    ,24.2    ,
+     +  26.7    ,29.0    ,30.9     /
+      DATA (AE(I, 2,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,24.8    ,
+     +  27.3    ,29.7    ,31.8     /
+      DATA (AE(I, 2,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,26.1    ,
+     +  27.3    ,29.9    ,32.3     /
+      DATA (AE(I, 2,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  27.4    ,30.1    ,32.6     /
+      DATA (AE(I, 3, 1),I=1,10)  /
+     +  11.0    ,11.0    ,11.7    ,11.3    ,11.9    ,11.4    ,12.1    ,
+     +  11.7    ,11.5    ,11.0     /
+      DATA (AE(I, 3, 2),I=1,10)  /
+     +  11.2    ,12.0    ,12.7    ,12.9    ,13.6    ,13.7    ,14.4    ,
+     +  14.6    ,14.7    ,14.6     /
+      DATA (AE(I, 3, 3),I=1,10)  /
+     +  12.1    ,12.6    ,13.7    ,13.9    ,15.0    ,15.2    ,16.3    ,
+     +  16.5    ,16.7    ,16.7     /
+      DATA (AE(I, 3, 4),I=1,10)  /
+     +  12.6    ,11.3    ,12.4    ,13.0    ,13.8    ,14.2    ,15.0    ,
+     +  15.6    ,16.1    ,16.6     /
+      DATA (AE(I, 3, 5),I=1,10)  /
+     +  .000E+00,12.6    ,13.7    ,14.4    ,15.3    ,16.0    ,16.8    ,
+     +  17.5    ,18.1    ,18.6     /
+      DATA (AE(I, 3, 6),I=1,10)  /
+     +  .000E+00,14.0    ,14.6    ,15.8    ,17.4    ,18.4    ,19.8    ,
+     +  20.6    ,21.5    ,22.2     /
+      DATA (AE(I, 3, 7),I=1,10)  /
+     +  .000E+00,16.0    ,15.2    ,16.3    ,18.3    ,19.3    ,21.1    ,
+     +  22.0    ,22.8    ,23.5     /
+      DATA (AE(I, 3, 8),I=1,10)  /
+     +  .000E+00,.000E+00,15.6    ,15.1    ,17.2    ,18.6    ,20.6    ,
+     +  21.8    ,22.9    ,23.8     /
+      DATA (AE(I, 3, 9),I=1,10)  /
+     +  .000E+00,.000E+00,17.8    ,16.3    ,18.8    ,20.1    ,22.5    ,
+     +  23.6    ,24.7    ,25.6     /
+      DATA (AE(I, 3,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,17.5    ,19.0    ,20.7    ,23.1    ,
+     +  24.5    ,25.8    ,26.8     /
+      DATA (AE(I, 3,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,19.2    ,19.4    ,21.1    ,23.8    ,
+     +  25.4    ,26.8    ,28.0     /
+      DATA (AE(I, 3,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,20.7    ,19.6    ,19.7    ,22.4    ,
+     +  24.4    ,26.2    ,27.9     /
+      DATA (AE(I, 3,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,21.6    ,20.4    ,23.2    ,
+     +  25.1    ,26.9    ,28.5     /
+      DATA (AE(I, 3,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,23.5    ,22.0    ,23.8    ,
+     +  26.1    ,28.1    ,29.9     /
+      DATA (AE(I, 3,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,23.7    ,24.2    ,
+     +  26.3    ,28.5    ,30.4     /
+      DATA (AE(I, 3,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,25.4    ,24.8    ,
+     +  25.6    ,28.1    ,30.5     /
+      DATA (AE(I, 3,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,26.9    ,26.8    ,
+     +  26.1    ,28.4    ,30.8     /
+      DATA (AE(I, 3,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,28.8    ,
+     +  27.6    ,29.0    ,31.5     /
+      DATA (AE(I, 3,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,30.5    ,
+     +  29.2    ,28.9    ,31.5     /
+      DATA (AE(I, 3,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  31.0    ,30.0    ,31.7     /
+      DATA (AE(I, 4, 1),I=1,10)  /
+     +  13.0    ,13.2    ,14.8    ,14.2    ,14.2    ,14.1    ,14.5    ,
+     +  14.4    ,14.3    ,14.0     /
+      DATA (AE(I, 4, 2),I=1,10)  /
+     +  13.5    ,14.5    ,16.1    ,15.9    ,16.0    ,16.3    ,16.8    ,
+     +  17.0    ,17.1    ,17.2     /
+      DATA (AE(I, 4, 3),I=1,10)  /
+     +  14.9    ,15.3    ,17.2    ,17.1    ,17.5    ,17.8    ,18.6    ,
+     +  18.9    ,19.1    ,19.3     /
+      DATA (AE(I, 4, 4),I=1,10)  /
+     +  15.1    ,13.5    ,16.4    ,16.7    ,16.4    ,17.3    ,17.8    ,
+     +  18.5    ,19.0    ,19.6     /
+      DATA (AE(I, 4, 5),I=1,10)  /
+     +  .000E+00,15.6    ,17.5    ,17.7    ,17.8    ,18.6    ,19.2    ,
+     +  19.9    ,20.3    ,21.1     /
+      DATA (AE(I, 4, 6),I=1,10)  /
+     +  .000E+00,18.0    ,18.4    ,19.2    ,19.8    ,20.9    ,22.0    ,
+     +  23.1    ,23.6    ,24.7     /
+      DATA (AE(I, 4, 7),I=1,10)  /
+     +  .000E+00,27.4    ,19.1    ,19.8    ,20.7    ,21.8    ,23.2    ,
+     +  24.4    ,24.9    ,25.9     /
+      DATA (AE(I, 4, 8),I=1,10)  /
+     +  .000E+00,.000E+00,18.9    ,18.9    ,19.3    ,21.1    ,22.5    ,
+     +  24.0    ,24.7    ,26.0     /
+      DATA (AE(I, 4, 9),I=1,10)  /
+     +  .000E+00,.000E+00,21.1    ,19.7    ,20.7    ,22.3    ,24.0    ,
+     +  25.6    ,26.3    ,27.7     /
+      DATA (AE(I, 4,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,21.0    ,21.1    ,22.9    ,24.6    ,
+     +  26.5    ,27.3    ,29.0     /
+      DATA (AE(I, 4,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,21.3    ,22.4    ,23.1    ,25.0    ,
+     +  27.1    ,27.9    ,29.8     /
+      DATA (AE(I, 4,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,36.6    ,21.5    ,22.2    ,23.1    ,
+     +  25.6    ,26.8    ,29.1     /
+      DATA (AE(I, 4,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,22.9    ,23.1    ,23.7    ,
+     +  26.2    ,27.3    ,29.6     /
+      DATA (AE(I, 4,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,30.5    ,23.6    ,25.0    ,
+     +  26.9    ,28.2    ,30.7     /
+      DATA (AE(I, 4,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,25.4    ,26.2    ,
+     +  27.2    ,28.3    ,31.0     /
+      DATA (AE(I, 4,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,24.5    ,25.9    ,
+     +  27.4    ,27.6    ,30.7     /
+      DATA (AE(I, 4,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,43.3    ,28.4    ,
+     +  27.5    ,27.9    ,30.9     /
+      DATA (AE(I, 4,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,27.2    ,
+     +  29.1    ,29.0    ,31.4     /
+      DATA (AE(I, 4,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,51.3    ,
+     +  30.6    ,29.5    ,31.4     /
+      DATA (AE(I, 4,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  28.8    ,30.6    ,32.4     /
+      DATA (AE(I, 5, 1),I=1,10)  /
+     +  15.0    ,14.9    ,15.5    ,15.4    ,15.9    ,15.8    ,16.2    ,
+     +  16.2    ,16.1    ,15.9     /
+      DATA (AE(I, 5, 2),I=1,10)  /
+     +  15.4    ,16.1    ,17.0    ,17.4    ,18.0    ,18.2    ,18.7    ,
+     +  18.9    ,19.0    ,19.1     /
+      DATA (AE(I, 5, 3),I=1,10)  /
+     +  17.1    ,17.2    ,18.3    ,18.7    ,19.3    ,19.6    ,20.3    ,
+     +  20.6    ,20.8    ,20.9     /
+      DATA (AE(I, 5, 4),I=1,10)  /
+     +  14.7    ,14.8    ,15.0    ,16.0    ,17.0    ,17.7    ,18.1    ,
+     +  19.0    ,19.4    ,20.0     /
+      DATA (AE(I, 5, 5),I=1,10)  /
+     +  .000E+00,16.7    ,17.6    ,18.1    ,18.6    ,19.2    ,19.7    ,
+     +  20.4    ,20.8    ,21.2     /
+      DATA (AE(I, 5, 6),I=1,10)  /
+     +  .000E+00,17.8    ,18.2    ,19.2    ,20.0    ,21.0    ,21.9    ,
+     +  23.0    ,23.6    ,24.3     /
+      DATA (AE(I, 5, 7),I=1,10)  /
+     +  .000E+00,35.2    ,18.9    ,20.3    ,20.6    ,21.5    ,22.6    ,
+     +  23.7    ,24.2    ,24.7     /
+      DATA (AE(I, 5, 8),I=1,10)  /
+     +  .000E+00,.000E+00,16.4    ,18.9    ,18.8    ,19.6    ,20.7    ,
+     +  22.3    ,23.1    ,23.9     /
+      DATA (AE(I, 5, 9),I=1,10)  /
+     +  .000E+00,.000E+00,33.9    ,19.8    ,20.3    ,20.7    ,21.9    ,
+     +  23.4    ,24.1    ,24.8     /
+      DATA (AE(I, 5,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,18.0    ,20.0    ,21.4    ,22.0    ,
+     +  23.8    ,24.6    ,25.4     /
+      DATA (AE(I, 5,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,26.4    ,20.4    ,21.2    ,22.3    ,
+     +  23.8    ,24.7    ,25.5     /
+      DATA (AE(I, 5,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,41.7    ,18.2    ,19.8    ,21.1    ,
+     +  22.6    ,23.4    ,24.6     /
+      DATA (AE(I, 5,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,22.5    ,20.0    ,21.7    ,
+     +  22.8    ,23.7    ,24.7     /
+      DATA (AE(I, 5,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,54.1    ,19.9    ,21.9    ,
+     +  23.2    ,24.3    ,25.3     /
+      DATA (AE(I, 5,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,21.2    ,22.2    ,
+     +  23.6    ,24.9    ,25.5     /
+      DATA (AE(I, 5,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,44.9    ,21.9    ,
+     +  23.8    ,25.2    ,25.6     /
+      DATA (AE(I, 5,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,47.8    ,22.7    ,
+     +  23.8    ,24.9    ,26.3     /
+      DATA (AE(I, 5,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,35.5    ,
+     +  23.9    ,25.9    ,26.6     /
+      DATA (AE(I, 5,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,64.3    ,
+     +  24.1    ,25.7    ,27.1     /
+      DATA (AE(I, 5,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  34.0    ,25.7    ,27.7     /
+      DATA (AE(I, 6, 1),I=1,10)  /
+     +  16.6    ,16.5    ,16.8    ,16.7    ,17.0    ,16.5    ,16.7    ,
+     +  18.3    ,18.9    ,19.0     /
+      DATA (AE(I, 6, 2),I=1,10)  /
+     +  16.2    ,16.6    ,17.2    ,17.4    ,17.9    ,17.4    ,17.7    ,
+     +  20.7    ,22.0    ,22.6     /
+      DATA (AE(I, 6, 3),I=1,10)  /
+     +  18.9    ,18.7    ,18.8    ,18.6    ,18.9    ,18.6    ,18.9    ,
+     +  21.0    ,22.3    ,22.9     /
+      DATA (AE(I, 6, 4),I=1,10)  /
+     +  18.3    ,12.7    ,14.2    ,15.0    ,15.7    ,16.1    ,16.3    ,
+     +  16.5    ,17.9    ,19.0     /
+      DATA (AE(I, 6, 5),I=1,10)  /
+     +  .000E+00,15.7    ,15.1    ,15.3    ,16.5    ,16.4    ,16.4    ,
+     +  17.0    ,18.3    ,19.4     /
+      DATA (AE(I, 6, 6),I=1,10)  /
+     +  .000E+00,22.9    ,14.9    ,15.2    ,16.2    ,16.9    ,17.4    ,
+     +  18.2    ,19.5    ,21.1     /
+      DATA (AE(I, 6, 7),I=1,10)  /
+     +  .000E+00,40.7    ,18.4    ,15.9    ,17.1    ,17.7    ,18.9    ,
+     +  19.5    ,20.3    ,21.1     /
+      DATA (AE(I, 6, 8),I=1,10)  /
+     +  .000E+00,.000E+00,23.3    ,16.2    ,16.3    ,17.3    ,18.7    ,
+     +  19.5    ,20.3    ,21.1     /
+      DATA (AE(I, 6, 9),I=1,10)  /
+     +  .000E+00,.000E+00,49.2    ,19.0    ,19.1    ,19.4    ,20.2    ,
+     +  20.8    ,21.6    ,22.0     /
+      DATA (AE(I, 6,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,27.2    ,21.2    ,20.8    ,21.4    ,
+     +  22.3    ,22.8    ,23.3     /
+      DATA (AE(I, 6,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,45.6    ,25.0    ,22.8    ,23.9    ,
+     +  23.6    ,24.3    ,24.4     /
+      DATA (AE(I, 6,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,45.8    ,29.7    ,25.1    ,25.3    ,
+     +  25.3    ,26.0    ,26.3     /
+      DATA (AE(I, 6,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,42.7    ,29.0    ,28.0    ,
+     +  27.0    ,27.2    ,27.6     /
+      DATA (AE(I, 6,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,62.0    ,32.0    ,30.0    ,
+     +  29.8    ,29.5    ,29.6     /
+      DATA (AE(I, 6,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,44.5    ,34.4    ,
+     +  32.7    ,31.5    ,31.8     /
+      DATA (AE(I, 6,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,75.6    ,37.1    ,
+     +  34.6    ,34.4    ,34.4     /
+      DATA (AE(I, 6,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,51.2    ,45.2    ,
+     +  39.0    ,37.5    ,36.4     /
+      DATA (AE(I, 6,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,74.9    ,
+     +  42.3    ,39.9    ,38.3     /
+      DATA (AE(I, 6,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,69.5    ,
+     +  50.7    ,42.3    ,41.4     /
+      DATA (AE(I, 6,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  66.3    ,48.0    ,43.4     /
+      DATA (AE(I, 7, 1),I=1,10)  /
+     +  27.0    ,25.8    ,26.3    ,26.2    ,26.7    ,26.7    ,27.1    ,
+     +  27.1    ,27.2    ,19.0     /
+      DATA (AE(I, 7, 2),I=1,10)  /
+     +  29.1    ,28.9    ,29.7    ,30.3    ,31.0    ,31.4    ,32.0    ,
+     +  32.3    ,32.7    ,22.6     /
+      DATA (AE(I, 7, 3),I=1,10)  /
+     +  31.6    ,29.7    ,30.9    ,31.4    ,32.5    ,33.1    ,34.0    ,
+     +  34.6    ,35.1    ,22.9     /
+      DATA (AE(I, 7, 4),I=1,10)  /
+     +  27.4    ,19.9    ,20.8    ,22.8    ,24.6    ,26.4    ,28.2    ,
+     +  29.6    ,30.8    ,19.0     /
+      DATA (AE(I, 7, 5),I=1,10)  /
+     +  .000E+00,24.6    ,24.1    ,25.0    ,27.2    ,28.7    ,30.7    ,
+     +  31.8    ,32.9    ,19.4     /
+      DATA (AE(I, 7, 6),I=1,10)  /
+     +  .000E+00,35.6    ,25.2    ,25.6    ,27.9    ,30.4    ,32.7    ,
+     +  34.6    ,36.3    ,21.1     /
+      DATA (AE(I, 7, 7),I=1,10)  /
+     +  .000E+00,45.4    ,30.9    ,28.2    ,29.0    ,31.2    ,34.0    ,
+     +  35.8    ,37.4    ,21.1     /
+      DATA (AE(I, 7, 8),I=1,10)  /
+     +  .000E+00,.000E+00,38.2    ,29.6    ,29.4    ,30.3    ,33.2    ,
+     +  35.5    ,37.6    ,21.1     /
+      DATA (AE(I, 7, 9),I=1,10)  /
+     +  .000E+00,.000E+00,59.3    ,34.5    ,33.7    ,32.9    ,35.4    ,
+     +  37.6    ,39.6    ,22.0     /
+      DATA (AE(I, 7,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,44.5    ,37.8    ,37.5    ,37.2    ,
+     +  39.0    ,41.4    ,23.3     /
+      DATA (AE(I, 7,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,67.0    ,43.6    ,42.0    ,40.8    ,
+     +  41.4    ,43.0    ,24.4     /
+      DATA (AE(I, 7,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,49.9    ,50.9    ,44.6    ,43.9    ,
+     +  44.2    ,44.2    ,26.3     /
+      DATA (AE(I, 7,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,67.2    ,50.5    ,48.7    ,
+     +  48.1    ,47.2    ,27.6     /
+      DATA (AE(I, 7,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,68.1    ,55.2    ,52.3    ,
+     +  51.5    ,51.6    ,29.6     /
+      DATA (AE(I, 7,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,68.7    ,58.6    ,
+     +  56.5    ,55.7    ,31.8     /
+      DATA (AE(I, 7,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,89.3    ,62.9    ,
+     +  60.0    ,59.1    ,34.4     /
+      DATA (AE(I, 7,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,56.0    ,72.9    ,
+     +  66.3    ,64.2    ,36.4     /
+      DATA (AE(I, 7,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,105.    ,
+     +  71.3    ,68.3    ,38.3     /
+      DATA (AE(I, 7,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,73.4    ,
+     +  76.8    ,72.4    ,41.4     /
+      DATA (AE(I, 7,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  107.    ,79.9    ,43.4     /
+      DATA (AE(I, 8, 1),I=1,10)  /
+     +  35.5    ,35.3    ,35.7    ,35.7    ,36.3    ,36.3    ,36.7    ,
+     +  36.7    ,36.7    ,19.0     /
+      DATA (AE(I, 8, 2),I=1,10)  /
+     +  40.6    ,41.4    ,41.9    ,42.3    ,43.2    ,43.5    ,44.0    ,
+     +  44.3    ,44.5    ,22.6     /
+      DATA (AE(I, 8, 3),I=1,10)  /
+     +  45.4    ,45.7    ,46.4    ,47.0    ,48.1    ,48.7    ,49.4    ,
+     +  49.8    ,50.2    ,22.9     /
+      DATA (AE(I, 8, 4),I=1,10)  /
+     +  43.9    ,44.3    ,43.4    ,45.1    ,47.3    ,48.7    ,49.6    ,
+     +  50.5    ,51.3    ,19.0     /
+      DATA (AE(I, 8, 5),I=1,10)  /
+     +  .000E+00,49.3    ,49.6    ,50.5    ,53.2    ,54.2    ,55.4    ,
+     +  56.1    ,56.8    ,19.4     /
+      DATA (AE(I, 8, 6),I=1,10)  /
+     +  .000E+00,59.1    ,53.0    ,55.4    ,58.0    ,60.0    ,61.2    ,
+     +  62.5    ,63.6    ,21.1     /
+      DATA (AE(I, 8, 7),I=1,10)  /
+     +  .000E+00,54.5    ,57.1    ,59.2    ,62.3    ,64.4    ,66.0    ,
+     +  67.3    ,68.5    ,21.1     /
+      DATA (AE(I, 8, 8),I=1,10)  /
+     +  .000E+00,.000E+00,65.9    ,62.1    ,65.1    ,67.6    ,69.4    ,
+     +  71.1    ,72.6    ,21.1     /
+      DATA (AE(I, 8, 9),I=1,10)  /
+     +  .000E+00,.000E+00,72.2    ,67.1    ,70.5    ,73.1    ,75.1    ,
+     +  76.8    ,78.4    ,22.0     /
+      DATA (AE(I, 8,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,80.1    ,75.0    ,78.0    ,80.0    ,
+     +  82.1    ,83.9    ,23.3     /
+      DATA (AE(I, 8,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,94.5    ,82.2    ,82.8    ,85.1    ,
+     +  87.3    ,89.2    ,24.4     /
+      DATA (AE(I, 8,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,56.8    ,92.5    ,87.2    ,89.4    ,
+     +  91.9    ,94.1    ,26.3     /
+      DATA (AE(I, 8,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,116.    ,96.2    ,94.4    ,
+     +  97.0    ,99.2    ,27.6     /
+      DATA (AE(I, 8,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,78.1    ,104.    ,102.    ,
+     +  102.    ,105.    ,29.6     /
+      DATA (AE(I, 8,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,128.    ,111.    ,
+     +  109.    ,110.    ,31.8     /
+      DATA (AE(I, 8,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,104.    ,118.    ,
+     +  117.    ,115.    ,34.4     /
+      DATA (AE(I, 8,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,64.4    ,138.    ,
+     +  124.    ,122.    ,36.4     /
+      DATA (AE(I, 8,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,133.    ,
+     +  133.    ,132.    ,38.3     /
+      DATA (AE(I, 8,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,83.6    ,
+     +  146.    ,139.    ,41.4     /
+      DATA (AE(I, 8,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  166.    ,147.    ,43.4     /
+      DATA (AE(I, 9, 1),I=1,10)  /
+     +  43.3    ,43.2    ,43.6    ,43.8    ,44.1    ,44.3    ,44.7    ,
+     +  44.8    ,44.8    ,19.0     /
+      DATA (AE(I, 9, 2),I=1,10)  /
+     +  50.9    ,51.4    ,52.0    ,52.6    ,53.1    ,53.6    ,54.2    ,
+     +  54.5    ,54.7    ,22.6     /
+      DATA (AE(I, 9, 3),I=1,10)  /
+     +  58.0    ,58.4    ,59.3    ,60.1    ,60.7    ,61.5    ,62.3    ,
+     +  62.7    ,63.1    ,22.9     /
+      DATA (AE(I, 9, 4),I=1,10)  /
+     +  62.0    ,63.9    ,63.7    ,65.7    ,65.5    ,67.5    ,68.2    ,
+     +  68.9    ,69.7    ,19.0     /
+      DATA (AE(I, 9, 5),I=1,10)  /
+     +  .000E+00,72.2    ,72.5    ,74.2    ,74.2    ,76.1    ,77.0    ,
+     +  77.8    ,78.6    ,19.4     /
+      DATA (AE(I, 9, 6),I=1,10)  /
+     +  .000E+00,80.4    ,80.5    ,83.1    ,83.0    ,85.5    ,86.8    ,
+     +  88.1    ,89.2    ,21.1     /
+      DATA (AE(I, 9, 7),I=1,10)  /
+     +  .000E+00,63.4    ,88.5    ,91.3    ,91.1    ,94.0    ,95.8    ,
+     +  97.3    ,98.6    ,21.1     /
+      DATA (AE(I, 9, 8),I=1,10)  /
+     +  .000E+00,.000E+00,98.8    ,98.6    ,97.8    ,102.    ,104.    ,
+     +  106.    ,108.    ,21.1     /
+      DATA (AE(I, 9, 9),I=1,10)  /
+     +  .000E+00,.000E+00,84.1    ,107.    ,107.    ,111.    ,113.    ,
+     +  116.    ,117.    ,22.0     /
+      DATA (AE(I, 9,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,116.    ,115.    ,119.    ,122.    ,
+     +  125.    ,127.    ,23.3     /
+      DATA (AE(I, 9,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,111.    ,123.    ,127.    ,131.    ,
+     +  134.    ,137.    ,24.4     /
+      DATA (AE(I, 9,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,65.6    ,136.    ,135.    ,140.    ,
+     +  143.    ,146.    ,26.3     /
+      DATA (AE(I, 9,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,146.    ,144.    ,149.    ,
+     +  152.    ,155.    ,27.6     /
+      DATA (AE(I, 9,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,88.7    ,152.    ,158.    ,
+     +  162.    ,165.    ,29.6     /
+      DATA (AE(I, 9,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,181.    ,167.    ,
+     +  171.    ,174.    ,31.8     /
+      DATA (AE(I, 9,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,117.    ,174.    ,
+     +  180.    ,183.    ,34.4     /
+      DATA (AE(I, 9,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,72.0    ,201.    ,
+     +  189.    ,192.    ,36.4     /
+      DATA (AE(I, 9,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,151.    ,
+     +  198.    ,201.    ,38.3     /
+      DATA (AE(I, 9,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,95.2    ,
+     +  220.    ,210.    ,41.4     /
+      DATA (AE(I, 9,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  192.    ,217.    ,43.4     /
+      DATA (AE(I,10, 1),I=1,10)  /
+     +  62.1    ,62.1    ,62.6    ,62.9    ,63.3    ,63.3    ,64.0    ,
+     +  64.0    ,64.0    ,19.0     /
+      DATA (AE(I,10, 2),I=1,10)  /
+     +  75.1    ,75.4    ,76.3    ,76.8    ,77.6    ,77.9    ,78.8    ,
+     +  79.0    ,79.3    ,22.6     /
+      DATA (AE(I,10, 3),I=1,10)  /
+     +  87.5    ,88.3    ,89.4    ,90.2    ,91.3    ,91.9    ,93.0    ,
+     +  93.5    ,93.9    ,22.9     /
+      DATA (AE(I,10, 4),I=1,10)  /
+     +  104.    ,104.    ,105.    ,106.    ,107.    ,108.    ,109.    ,
+     +  110.    ,110.    ,19.0     /
+      DATA (AE(I,10, 5),I=1,10)  /
+     +  .000E+00,122.    ,122.    ,123.    ,124.    ,125.    ,126.    ,
+     +  127.    ,128.    ,19.4     /
+      DATA (AE(I,10, 6),I=1,10)  /
+     +  .000E+00,138.    ,139.    ,140.    ,142.    ,143.    ,144.    ,
+     +  146.    ,147.    ,21.1     /
+      DATA (AE(I,10, 7),I=1,10)  /
+     +  .000E+00,85.3    ,158.    ,159.    ,161.    ,162.    ,164.    ,
+     +  166.    ,167.    ,21.1     /
+      DATA (AE(I,10, 8),I=1,10)  /
+     +  .000E+00,.000E+00,176.    ,177.    ,179.    ,181.    ,183.    ,
+     +  184.    ,186.    ,21.1     /
+      DATA (AE(I,10, 9),I=1,10)  /
+     +  .000E+00,.000E+00,114.    ,199.    ,201.    ,202.    ,205.    ,
+     +  206.    ,207.    ,22.0     /
+      DATA (AE(I,10,10),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,218.    ,219.    ,220.    ,224.    ,
+     +  225.    ,226.    ,23.3     /
+      DATA (AE(I,10,11),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,150.    ,238.    ,238.    ,243.    ,
+     +  244.    ,245.    ,24.4     /
+      DATA (AE(I,10,12),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,85.8    ,255.    ,255.    ,261.    ,
+     +  262.    ,263.    ,26.3     /
+      DATA (AE(I,10,13),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,195.    ,272.    ,279.    ,
+     +  279.    ,280.    ,27.6     /
+      DATA (AE(I,10,14),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,115.    ,290.    ,296.    ,
+     +  297.    ,298.    ,29.6     /
+      DATA (AE(I,10,15),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,263.    ,313.    ,
+     +  314.    ,315.    ,31.8     /
+      DATA (AE(I,10,16),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,150.    ,330.    ,
+     +  331.    ,332.    ,34.4     /
+      DATA (AE(I,10,17),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,90.0    ,319.    ,
+     +  349.    ,349.    ,36.4     /
+      DATA (AE(I,10,18),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,196.    ,
+     +  366.    ,367.    ,38.3     /
+      DATA (AE(I,10,19),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,122.    ,
+     +  387.    ,384.    ,41.4     /
+      DATA (AE(I,10,20),I=1,10)  /
+     +  .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
+     +  247.    ,401.    ,43.4     /
+      DATA (ERES(I, 1),I=1,10)  / 10*0./
+      DATA (ERES(I, 2),I=1,10)  / 10*0./
+      DATA (ERES(I, 3),I=1,10)  / 10*0./
+      DATA (ERES(I, 4),I=1,10)  / 10*0./
+      DATA (ERES(I, 5),I=1,10)  / 10*0./
+      DATA (ERES(I, 6),I=1,10)  /
+     +     0.000,   0.000,   0.000,   0.000,   0.000,   0.000,   0.000,
+     +     2.780,   2.880,   2.890 /
+      DATA (ERES(I, 7),I=1,10)  /
+     +     1.500,   2.460,   2.510,   2.610,   2.700,   2.920,   3.070,
+     +     3.200,   3.330,   2.890 /
+      DATA (ERES(I, 8),I=1,10)  /
+     +     4.470,   4.350,   4.390,   4.550,   4.660,   4.890,   4.980,
+     +     5.100,   5.220,   2.890 /
+      DATA (ERES(I, 9),I=1,10)  /
+     +     7.480,   7.380,   7.370,   7.480,   7.510,   7.630,   7.660,
+     +     7.750,   7.820,   2.890 /
+      DATA (ERES(I,10),I=1,10)  /
+     +    15.270,  15.190,  15.200,  15.370,  15.380,  15.430,  15.540,
+     +    15.590,  15.630,   2.890 /
+      END
+      FUNCTION GASDEV(IDUMMY)
+C...Gaussian deviation
+      SAVE GSET
+      DATA ISET/0/
+      IF (ISET.EQ.0) THEN
+1       V1=2.*RNDM(0)-1.
+        V2=2.*RNDM(0)-1.
+        R=V1**2+V2**2
+        IF(R.GE.1.)GO TO 1
+        FAC=SQRT(-2.*LOG(R)/R)
+        GSET=V1*FAC
+        GASDEV=V2*FAC
+        ISET=1
+      ELSE
+        GASDEV=GSET
+        ISET=0
+      ENDIF
+      RETURN
+      END
+
+      FUNCTION GAUSS (FUN, A,B)
+C...Returns the  8 points Gauss-Legendre integral
+C.  of function FUN from A to B
+C...........................................................
+      DIMENSION X(8), W(8)
+      DATA X / .0950125098, .2816035507, .4580167776, .6178762444
+     1          ,.7554044083, .8656312023, .9445750230, .9894009349/
+      DATA W / .1894506104, .1826034150, .1691565193, .1495959888
+     1          ,.1246289712, .0951585116, .0622535239, .0271524594/
+      XM = 0.5*(B+A)
+      XR = 0.5*(B-A)
+      SS = 0.
+      DO J=1,8
+        DX = XR*X(J)
+        SS = SS + W(J) * (FUN(XM+DX) + FUN(XM-DX))
+      ENDDO
+      GAUSS = XR*SS
+      RETURN
+      END
+
+      SUBROUTINE GG_FRAG (E0)
+C...This routine fragments a  gluon-gluon system
+C.  of mass E0 (GeV)
+C.  the particles produced are in the  jet-jet frame
+C.  oriented along the z axis
+C...........................................................
+      COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
+      COMMON /S_MASS1/ AM(49), AM2(49)
+      DIMENSION WW(2,2),PTOT(4),PX(3),PY(3),IFL(3),PMQ(3)
+
+C...Generate the 'forward' leading particle.
+100   I = NP+1
+      I0 = -1 + 2.*INT(1.9999*RNDM(0))
+      CALL IFLAV(I0,0,IFL1, LDUM)
+      CALL IFLAV(IFL1,0,IFL2, LLIST(I))
+      CALL PTDIS(IFL1,PX1,PY1)
+      CALL PTDIS(IFL2,PX2,PY2)
+      P(I,1) = PX1+PX2
+      P(I,2) = PY1+PY2
+      P(I,5) = AM(IABS(LLIST(I)))
+      XM1 = P(I,5)**2+P(I,1)**2+P(I,2)**2
+      Z1 = ZDIS (IFL1,1,0.25*XM1)
+      Z2 = ZDIS (IFL2,1,0.25*XM1)
+      T1  = 4.*XM1/(E0*E0*(Z1+Z2))
+      P(I,4) = 0.25*E0*(Z1+Z2 + T1)
+      P(I,3) = 0.25*E0*(Z1+Z2 - T1)
+
+C...Generate the 'backward' leading particle.
+      I = I+1
+      CALL IFLAV(-I0,0,IFL3, LDUM)
+      CALL IFLAV(IFL3,0,IFL4, LLIST(I))
+      CALL PTDIS(IFL3,PX3,PY3)
+      CALL PTDIS(IFL4,PX4,PY4)
+      P(I,1) = PX3+PX4
+      P(I,2) = PY3+PY4
+      P(I,5) = AM(IABS(LLIST(I)))
+      XM2 = P(I,5)**2+P(I,1)**2+P(I,2)**2
+      Z3 = ZDIS (IFL3,1,0.25*XM2)
+      Z4 = ZDIS (IFL4,1,0.25*XM2)
+      T2  = 4.*XM2/(E0*E0*(Z3+Z4))
+      P(I,4) = 0.25*E0*( Z3+Z4 + T2)
+      P(I,3) = 0.25*E0*(-Z3-Z4 + T2)
+
+C...Fragment the two remaning strings
+      N0 = 0
+      DO KS=1,2
+
+      NTRY = 0
+200      NTRY = NTRY+1
+      I = NP+2+N0
+      IF (NTRY .GT. 30)  GOTO 100
+
+      IF (KS .EQ. 1)  THEN
+         WW(1,1) = 0.5 * (1 - Z1 - 0.5*T2)
+         WW(2,1) = 0.5 * (1 - Z3 - 0.5*T1)
+         PX(1) = -PX1
+         PY(1) = -PY1
+         PX(2) = -PX3
+         PY(2) = -PY3
+         IFL(1) = -IFL1
+         IFL(2) = -IFL3
+      ELSE
+         WW(1,1) = 0.5 * (1 - Z2 - 0.5*T2)
+         WW(2,1) = 0.5 * (1 - Z4 - 0.5*T1)
+         PX(1) = -PX2
+         PY(1) = -PY2
+         PX(2) = -PX4
+         PY(2) = -PY4
+         IFL(1) = -IFL2
+         IFL(2) = -IFL4
+      ENDIF
+      PX(3) = 0.
+      PY(3) = 0.
+      PTOT (1) = PX(1)+PX(2)
+      PTOT (2) = PY(1)+PY(2)
+      PTOT (3) = 0.5*E0*(WW(1,1)-WW(2,1))
+      PTOT (4) = 0.5*E0*(WW(1,1)+WW(2,1))
+
+      PMQ(1) = QMASS(IFL(1))
+      PMQ(2) = QMASS(IFL(2))
+
+C...produce new particle: side, pT
+300      I=I+1
+      JT=1.5+RNDM(0)
+      JR=3-JT
+c      CALL PTDIS (IFL(JT), PX(3),PY(3))
+
+C...particle ID
+      CALL IFLAV (IFL(JT), 0, IFL(3), LLIST(I))
+      PMQ(3) = QMASS(IFL(3))
+      P(I,5) = AM(IABS(LLIST(I)))
+
+      CALL PTDIS (IFL(3), PX(3),PY(3))
+
+C...test end of fragmentation
+      WREM2 = PTOT(4)**2-PTOT(1)**2-PTOT(2)**2-PTOT(3)**2
+      IF (WREM2 .LT. 0.1)  GOTO 200
+      WMIN = PMQ(1)+PMQ(2)+2.*PMQ(3)+1.1 + (2.*RNDM(0)-1.)*0.2
+      IF (WREM2 .LT. WMIN**2)  GOTO 400
+
+C...fill transverse momentum
+      P(I,1) = PX(JT) + PX(3)
+      P(I,2) = PY(JT) + PY(3)
+
+C...Choose z
+      XMT2 = P(I,5)**2+P(I,1)**2+P(I,2)**2
+      Z = ZDIS (ifl(3),IFL(JT), XMT2)
+
+      WW(JT,2) = Z*WW(JT,1)
+      WW(JR,2) = XMT2/(WW(JT,2)*E0**2)
+
+      P(I,3) = WW(1,2)*0.5*E0 - WW(2,2)*0.5*E0
+      P(I,4) = WW(1,2)*0.5*E0 + WW(2,2)*0.5*E0
+
+      DO J=1,4
+         PTOT (J) = PTOT(J) - P(I,J)
+      ENDDO
+      DO K=1,2
+         WW(K,1) = WW(K,1) - WW(K,2)
+      ENDDO
+
+C...Reset pT and flavor at ends of the string
+      PX(JT) = -PX(3)
+      PY(JT) = -PY(3)
+      IFL(JT) =-IFL(3)
+      PMQ(JT) = PMQ(3)
+      GOTO 300
+
+C...Final two hadrons
+400   IF (IFL(JR)*IFL(3) .GT. 100)  GOTO 200
+      CALL IFLAV (IFL(JR), -IFL(3), IFLA, LLIST(I+1))
+      P(I+1,5) = AM(IABS(LLIST(I+1)))
+      P(I,1)   = PX(JT)+PX(3)
+      P(I,2)   = PY(JT)+PY(3)
+      I1 = I+1
+      P(I1,1) = PX(JR)-PX(3)
+      P(I1,2) = PY(JR)-PY(3)
+      XM1 = P(I,5)**2+P(I,1)**2+P(I,2)**2
+      XM2 = P(I1,5)**2+P(I1,1)**2+P(I1,2)**2
+      IF (SQRT(XM1)+SQRT(XM2) .GT. SQRT(WREM2)) GOTO 200
+      if (ptot(4).le.0) goto 200
+      WREM = SQRT(WREM2)
+      EA1 = (WREM2+XM1-XM2)/(2.*WREM)
+      PA2 = (EA1**2-XM1)
+      if (pa2.ge.0.0) then
+        PA = SQRT(pa2)
+      else
+       goto 200
+      endif
+      BA = PTOT(3)/PTOT(4)
+      GA = PTOT(4)/WREM
+      S = FLOAT(3-2*JT)
+      P(I,3) = GA*(BA*EA1+S*PA)
+      P(I,4) = GA*(EA1+BA*S*PA)
+      P(I+1,3) = PTOT(3)-P(I,3)
+      P(I+1,4) = PTOT(4)-P(I,4)
+      N0 = I-NP-1
+      ENDDO                  ! loop on two `remaining strings'
+      NP = I+1
+      RETURN
+      END
+      SUBROUTINE GLAUBER(JA,SSIG,SLOPE,ALPHA,SIGT,SIGEL,SIGQEL)
+C...Subroutine to compute hadron-Nucleus cross sections
+C.  according to:
+C.  R.J. Glauber and G.Matthiae  Nucl.Phys. B21, 135, (1970)
+C.
+C.  This formulas assume that the target nucleus  density is
+C.  modeled by a shell-model form.  A reasonable range of models
+C   is  4 < JA < 18
+C.
+C.  INPUT :  A = mass number of the nucleus
+C.           SSIG  (mbarn) total pp cross section
+C.           SLOPE (GeV**-2)  elastic scattering slope for pp
+C.           ALPHA    real/imaginary part of the forward pp elastic
+C.                                               scattering amplitude
+C.  OUTPUT : SIGT  = Total cross section
+C.           SIGEL = Elastic cross section
+C.           SIGQEL  = Elastic + Quasi elastic cross section
+C.
+C. Internally  everything is computed in GeV (length = GeV**-1)
+C......................................................................
+      COMMON /CA0SH/ R0, R02
+      COMPLEX  ZZ, ZS, ZP, ZC
+      DIMENSION RR(18)
+      DATA CMBARN /0.389385/
+      DATA PI /3.1415926/
+      DATA BMAX /50./            ! GeV**-1
+      DATA NB /100/
+C...data on Sqrt[<r**2>] (fm). (A=5,8 are not correct). From Barett and Jackson
+      DATA RR /0.81,2.095,1.88,1.674, 2.56,2.56,2.41,2.5,2.519,2.45
+     +          ,2.37, 2.460, 2.440, 2.54, 2.58, 2.718, 2.662,2.789 /
+      A = FLOAT(JA)
+C...Parameter of shell model density
+      R0 = RR(JA)/0.197/SQRT(5./2. - 4./A)         ! GeV**-1
+      R02 = R0*R0
+      SIG = SSIG/CMBARN                           ! GeV**-2
+      DB = BMAX/FLOAT(NB)
+      SUM = 0.
+      SUM1 = 0.
+      SUM2 = 0.
+      DO JB=1,NB
+         B = DB*(FLOAT(JB)-0.5)
+         GS = GLAUBGS (B,SLOPE, SIG)
+         GP = GLAUBGP (B,SLOPE, SIG)
+         XS = (1.- GS)
+         YS =  GS*ALPHA
+         ZS = CMPLX(XS,YS)
+         XP = (1.- GP)
+         YP =  GP*ALPHA
+         ZP = CMPLX(XP,YP)
+         ZZ = ZS**4. * ZP**(A-4.)
+         X = REAL (ZZ)
+         Y = AIMAG(ZZ)
+         ZC = CMPLX(X,-Y)
+         SUM = SUM + (1.-X)*B
+         SUM1 = SUM1 + ((1.-X)**2 + Y**2)*B
+         OMS = OMEGAS(B,SIG,SLOPE,ALPHA)
+         OMP = OMEGAP(B,SIG,SLOPE,ALPHA)
+         OM = (1.- 2.*GS + OMS)**4. * (1. -2.*GP + OMP)**(A-4.)
+         SUM2 = SUM2 + (1.-2.*X + OM)*B
+      ENDDO
+      SIGT =   SUM  * DB * 4.*PI * CMBARN
+      SIGEL =  SUM1 * DB * 2.*PI * CMBARN
+      SIGQEL = SUM2 * DB * 2.*PI * CMBARN
+      RETURN
+      END
+      FUNCTION GLAUBGP (B,SLOPE, SIG)
+      COMMON /CA0SH/ A0, A02
+      DATA PI /3.1415926/
+      GAMMA2 = A02/4. + 0.5*SLOPE
+      ARG = B**2/(4.*GAMMA2)
+      C1 = 1.- A02/(6.*GAMMA2)*(1.-ARG)
+      GLAUBGP = SIG/(8.*PI*GAMMA2) *  C1 * EXP(-ARG)
+      RETURN
+      END
+      FUNCTION GLAUBGS (B,SLOPE, SIG)
+      COMMON /CA0SH/ A0, A02
+      DATA PI /3.1415926/
+      GAMMA2 = A02/4. + 0.5*SLOPE
+      ARG = B**2/(4.*GAMMA2)
+      GLAUBGS = SIG/(8.*PI*GAMMA2) * EXP(-ARG)
+      RETURN
+      END
+      SUBROUTINE HAD_CONV
+C----------------------------------------------------------------------------
+C  Code for the convolution of hadrons
+C----------------------------------------------------------------------------
+C...Convolution of hadrons profile
+C.  [function A(b) of Durand and Pi]
+C.  precalculate and put  in COMMON block
+C.........................................
+      COMMON /S_CHDCNV/NB,DB,ABPP(200),ABPIP(200),ABPPH(200),
+     +        ABPIPH(200)
+      REAL*4 NU2, MU2, NUPI2, NU, MU, NUPI
+
+      COMMON /S_CH0CNV/ NU2, MU2, NUPI2, NU, MU, NUPI
+
+      NU2 = 0.71
+      MU2 = 0.88
+      NUPI2 = 0.54
+
+      NU = SQRT(NU2)
+      MU = SQRT(MU2)
+      NUPI = SQRT(NUPI2)
+
+C...integration constants
+      BMAX = 15.
+      NB  = 200
+      DB = BMAX/FLOAT(NB)
+
+      DO JB=1,NB
+         B = DB*FLOAT(JB-1)
+         ABPP(JB)    = A_PP(B)
+         ABPIP(JB)   = A_PIP(B)
+      ENDDO
+      NU2 = 0.71
+      MU2 = 0.88
+      NUPI2 = 0.54
+
+      NU = SQRT(NU2)
+      MU = SQRT(MU2)
+      NUPI = SQRT(NUPI2)
+
+      DB = BMAX/FLOAT(NB)
+      DO JB=1,NB
+         B = DB*FLOAT(JB-1)
+         ABPPh(JB)    = A_PP(B)
+         ABPIPh(JB)   = A_PIP(B)
+      ENDDO
+      RETURN
+      END
+      FUNCTION HELIUM (R)
+C... Helium density from Barrett and Jackson
+C.   INPUT R = r coordinate (fm)
+C.   OUTPUT (fm**-3)
+C........................................................
+      DATA R0 /0.964/, CA /0.322/   ! fm
+      DATA W /0.517/, CC /5.993224E-02/
+      HELIUM = CC*(1.+W*(R/R0)**2)/(1. + EXP((R-R0)/CA))
+      RETURN
+      END
+
+      SUBROUTINE HSPLI (KF, KP1,KP2)
+C...This subroutine splits one hadron of code KF
+C.  into 2 partons of code KP1 and KP2
+C.  KP1 refers to a color triplet [q or (qq)bar]
+C.  KP2 to a a color anti-triplet [qbar or (qq)]
+C.  allowed inputs:
+C.  KF = 7:14 pi+-,k+-,k0L,k0s, p,n
+C.     = -13,-14  pbar,nbar
+C.................................................
+
+      L = IABS(KF)-6
+      GOTO (100,200,300,400,500,500,600,700), L
+
+100      KP1 = 1                  ! pi+
+      KP2 = -2
+      RETURN
+200      KP1 = 2                  ! pi-
+      KP2 = -1
+      RETURN
+300      KP1 = 1                  ! k+
+      KP2 = -3
+      RETURN
+400      KP1 = 3                  ! k-
+      KP2 = -1
+      RETURN
+500      KP1 = 2                  ! k0l, k0s
+      KP2 = -3
+      IF (RNDM(0).GT. 0.5)  THEN
+        KP1 = 3
+        KP2 = -2
+      ENDIF
+      return       ! bug fix 5-91
+600      R = 6.*RNDM(0)            ! p/pbar
+      IF (R .LT.3.)       THEN
+        KP1 = 1
+        KP2 = 12
+      ELSEIF (R .LT. 4.)  THEN
+        KP1 = 1
+        KP2 = 21
+      ELSE
+        KP1 = 2
+        KP2 = 11
+      ENDIF
+      IF (KF .LT. 0)      THEN
+        KPP = KP1
+        KP1 = -KP2
+        KP2 = -KPP
+      ENDIF
+      RETURN
+
+700      R = 6.*RNDM(0)                  ! n/nbar
+      IF (R .LT.3.)       THEN
+         KP1 = 2
+         KP2 = 12
+      ELSEIF (R .LT. 4.)  THEN
+        KP1 = 2
+        KP2 = 21
+      ELSE
+        KP1 = 1
+        KP2 = 22
+      ENDIF
+      IF (KF .LT. 0)      THEN
+        KPP = KP1
+        KP1 = -KP2
+        KP2 = -KPP
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE IFLAV (IFL1,IFL2A, IFL2, KF)
+C...This subroutine receives as input IFL1 the flavor code
+C.  of a quark (antiquark) and  generates the antiquark (quark)
+C.  of flavor code IFL2 that combine with the original parton
+C.  to compose an hadron of code KF. ONLY 3 FLAVORS
+C.  If (IFL2A.NE.0) returns an hadron KF composed of IFL1 and IFL2A
+C...................................................................
+      COMMON /S_CFLAFR/ PAR(8)
+      DIMENSION KFLA(3,3,2), CDIAG(12), KDIAG(6)
+      DIMENSION KBAR(30), CFR(12), KFR(80)
+      DATA KFLA /0,8,10,7,0,22,9,21,0,0,26,29,25,0,31,28,30,0/
+      DATA CDIAG /0.5,0.25,0.5,0.25,1.,0.5,0.5,0.,0.5,0.,1.,1./
+      DATA KDIAG /6,23,24,27,32,33/
+      DATA KBAR /13,14,34,35,36,37,38,9*0,39,3*0,40,41,42,43,44,
+     +             45,46,47,48,49/
+      DATA CFR /0.75,0.,0.5,0.,0.,1.,0.1667,0.3333,0.0833,0.6667,
+     +            0.1667,0.3333/
+      DATA KFR/0,16,17,19,100,104,109,115,0,26,27,29,122,126,131,137
+     +  ,0,40,42,47,144,158,178,205,0,1,3,6,10,15,21,28,0,0,56,57,240,
+     +  246,256,271,0,0,1,3,6,10,15,21,60,61,64,70,292,307,328,356,
+     +  0,1,3,6,10,15,21,28,16*0/
+
+
+      IFLA = IABS(IFL1)
+      IF (IFL2A .NE. 0)  THEN
+         IFL2A = MOD(IFL2A,100)
+         IFL2 = IFL2A
+         IFLB = IABS(IFL2A)
+         MB = 0
+         IF (IFLB .GT. 10)   MB=1
+         IF (IFLA .GT. 10)   MB=2
+      ELSE
+          MB = 2
+         IF (IFLA .LT. 10)   THEN
+             MB = 1
+             IF ((1.+PAR(1))*RNDM(0).LT. 1.)  MB=0
+         ENDIF
+      ENDIF
+
+      IF (MB .EQ. 0)  THEN
+         IF (IFL2A.EQ.0)
+     +        IFL2=ISIGN(1+INT((2.+PAR(2))*RNDM(0)),-IFL1)
+         IFLD = MAX(IFL1,IFL2)
+         IFLE = MIN(IFL1,IFL2)
+         GOTO 100
+      ENDIF
+
+C...Decide if the diquark must be split
+      IF (MB .EQ. 2 .AND. IFLA .GT. 100)   THEN
+         IFLA = MOD(IFLA,100)
+           GOTO 200
+      ENDIF
+      IF (MB .EQ. 2 .AND. IFLA .EQ. 0)   THEN
+          IF (RNDM(0) .LT. PAR(8))  THEN
+             MB = 0
+             IFLG = MOD(IFL1,10)
+             IFLH =(IFL1-IFLG)/10
+             IF (RNDM(0) .GT. 0.5)  THEN
+                IFLDUM = IFLG
+                IFLG = IFLH
+                IFLH = IFLDUM
+             ENDIF
+             IFL11=IFLG
+             IFL22=ISIGN(1+INT((2.+PAR(2))*RNDM(0)),-IFL1)
+             IFLD = MAX(IFL11,IFL22)
+             IFLE = MIN(IFL11,IFL22)
+             IFL2 = -IFLH*10+IFL22
+             IF (RNDM(0) .GT. 0.5)  IFL2 = IFL22*10-IFLH
+             IFL2 = IFL2+ISIGN(100,IFL2)
+          ENDIF
+      ENDIF
+
+C...Form a meson: consider spin and flavor mixing for the diagonal states
+100      IF (MB .EQ. 0)  THEN
+         IF1 = IABS(IFLD)
+         IF2 = IABS(IFLE)
+         IFLC = MAX(IF1,IF2)
+         KSP = INT(PAR(5)+RNDM(0))
+         IF (IFLC.EQ.3)  KSP = INT(PAR(6)+RNDM(0))
+C D.H.
+         KSP = MIN(KSP,1)
+
+         IF (IF1 .NE. IF2)   THEN
+            KF = KFLA(IF1,IF2,KSP+1)
+         ELSE
+            R = RNDM(0)
+            JF=1+INT(R+CDIAG(6*KSP+2*IF1-1))+
+     +             INT(R+CDIAG(6*KSP+2*IF1))
+C D.H.
+            JF = MIN(JF,3)
+
+            KF=KDIAG(JF+3*KSP)
+         ENDIF
+         RETURN
+      ENDIF
+
+C...Form a baryon
+200      IF (IFL2A .NE. 0)   THEN
+          IF (MB .EQ. 1)  THEN
+             IFLD = IFLA
+             IFLE = IFLB/10
+             IFLF = MOD(IFLB,10)
+          ELSE
+             IFLD = IFLB
+             IFLE = IFLA/10
+             IFLF = MOD(IFLA,10)
+          ENDIF
+          LFR = 3+2*((2*(IFLE-IFLF))/(1+IABS(IFLE-IFLF)))
+          IF(IFLD.NE.IFLE.AND.IFLD.NE.IFLF)  LFR=LFR+1
+      ELSE
+110          CONTINUE
+          IF(MB.EQ.1)   THEN            ! generate diquark
+             IFLD = IFLA
+120             IFLE = 1+INT((2.+PAR(2)*PAR(3))*RNDM(0))
+             IFLF = 1+INT((2.+PAR(2)*PAR(3))*RNDM(0))
+             IF(IFLE.GE.IFLF.AND.PAR(4).LT.RNDM(0))    GOTO 120
+             IF(IFLE.LT.IFLF.AND.PAR(4)*RNDM(0).GT.1.) GOTO 120
+             IFL2=ISIGN(10*IFLE+IFLF,IFL1)
+          ELSE                  ! generate quark
+             IFL2=ISIGN(1+INT((2.+PAR(2))*RNDM(0)),IFL1)
+             IFLD=IABS(IFL2)
+             IFLE=IFLA/10
+             IFLF=MOD(IFLA,10)
+          ENDIF
+C...SU(6) factors for baryon formation
+             LFR=3+2*((2*(IFLE-IFLF))/(1+IABS(IFLE-IFLF)))
+          IF(IFLD.NE.IFLE.AND.IFLD.NE.IFLF)  LFR=LFR+1
+          WT = CFR(2*LFR-1)+PAR(7)*CFR(2*LFR)
+          IF(IFLE.LT.IFLF)   WT=WT/3.
+          IF (WT.LT.RNDM(0)) GOTO 110
+      ENDIF
+
+C...Form Baryon
+      IFLG=MAX(IFLD,IFLE,IFLF)
+      IFLI=MIN(IFLD,IFLE,IFLF)
+      IFLH=IFLD+IFLE+IFLF-IFLG-IFLI
+      KSP=2+2*INT(1.-CFR(2*LFR-1)+(CFR(2*LFR-1)+PAR(7)*
+     1       CFR(2*LFR))*RNDM(0))
+
+C...Distinguish Lambda- and Sigma- like particles
+      IF (KSP.EQ.2.AND.IFLG.GT.IFLH.AND.IFLH.GT.IFLI)  THEN
+      IF(IFLE.GT.IFLF.AND.IFLD.NE.IFLG) KSP=2+INT(0.75+RNDM(0))
+       IF(IFLE.LT.IFLF.AND.IFLD.EQ.IFLG) KSP=3
+       IF(IFLE.LT.IFLF.AND.IFLD.NE.IFLG) KSP=2+INT(0.25+RNDM(0))
+      ENDIF
+      KF=KFR(16*KSP-16+IFLG)+KFR(16*KSP-8+IFLH)+IFLI
+      KF=ISIGN(KBAR(KF-40),IFL1)
+
+      RETURN
+      END
+      SUBROUTINE INI_WRITE (LUN)
+C...This subroutine prints on unit LUN
+C.  a table of the cross sections  used in the program
+C.  and of the average number of jets, and the average
+C.  number of wounded nucleons in a hadron-air interaction
+C---------------------------------------------------------
+      COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
+     +    SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
+      DIMENSION PJ(2), PW(2)
+      DATA ATARG /14.514/
+C      CALL PARAM_PRINT(LUN)
+      WRITE (LUN, 10)
+      WRITE (LUN, 15)
+      WRITE (LUN, 16)
+      WRITE (LUN, 18)
+10    FORMAT(//,' Table of cross sections, and average number',
+     +         ' of minijets and wounded nucleons ')
+15    FORMAT('        [sqrt(s) in GeV, cross sections in mbarn]. ')
+16    FORMAT(' sqrt(s)  sig(pp) sig(pAir)  <n_j>  <n_w>   ',
+     +    ' sig(pip) sig(piAir) <n_j> <n_w> ')
+18    FORMAT(1X,77('-') )
+      DO J=1,51,1
+         SQS = 10.**(ASQSMIN + DASQS*FLOAT(J-1))
+         DO K=1,2
+            PW(K) = ATARG*SSIG(J,K)/SSIGN(J,K)
+            PJ(K) = 0.
+            DO JJ=1,20
+              PJ(K)=PJ(K)+FLOAT(JJ)*(PJETC(JJ,J,K)-PJETC(JJ-1,J,K))
+            ENDDO
+         ENDDO
+         WRITE(LUN,20) SQS,SSIG(J,1),SSIGN(J,1),PJ(1),PW(1)
+     +                      ,SSIG(J,2),SSIGN(J,2),PJ(2),PW(2)
+      ENDDO
+      WRITE (LUN, 18)
+20    FORMAT (1X,E8.2, 2(2F8.1,2X,2F7.2,3X))
+      RETURN
+      END
+      SUBROUTINE INT_H_NUC (IA, SIGT, SLOPE, RHO)
+C...Compute with a montecarlo method the "multiple interaction structure"
+C.  of an hadron-nucleus collision.
+C.
+C.
+C.  INPUT : IA               = mass of target nucleus
+C.          SIGT (mbarn)     = total hp cross section
+C.          SLOPE (GeV**-2)  = slope of hp elastic scattering
+C.          RHO              = real/imaginary part of forward elastic
+C.                             scattering amplitude
+C.
+C.  OUTPUT : in COMMON block /CNCMS0/
+C.           B = impact parameter (fm)
+C.           BMAX = maximum impact parameter for generation
+C.           NTRY = number of "trials" before one interaction
+C.           NA = number of wounded nucleons in A
+C. Author : P.Lipari  (may 1993)
+C---------------------------------------------------------------------------
+C D.H.PARAMETER (IAMAX=110)
+      PARAMETER (IAMAX=56)
+      COMMON /S_CNCM0/ B, BMAX, NTRY, NA
+      DIMENSION XA(IAMAX), YA(IAMAX)
+      DATA PI /3.1415926/
+      DATA CMBARN /0.389385/
+      CC = SIGT/(4.*PI*SLOPE*CMBARN)
+      DEN = 2.*SLOPE*CMBARN*0.1
+      BMAX = 10.                             ! fm
+      NTRY = 0
+      CALL NUC_CONF (IA, XA, YA)
+1000  B = BMAX*SQRT(RNDM(0))
+      PHI = 2.*PI*RNDM(0)
+      BX = B*COS(PHI)
+      BY = B*SIN(PHI)
+      NTRY = NTRY+1
+      NA = 0
+      DO JA=1,IA
+         S = (XA(JA)-BX)**2 + (YA(JA)-BY)**2
+         F = EXP(-S/DEN)
+         PEL = CC*CC*(1.+RHO*RHO)*F*F
+         PINEL  = 2.*CC*F-PEL
+         R = RNDM(0)
+         IF (R .LT. PINEL)  THEN
+            NA = NA + 1
+         ENDIF
+      ENDDO
+      IF (NA .EQ. 0)  GOTO 1000
+      RETURN
+      END
+
+      SUBROUTINE INT_NUC (IA, IB, SIG0, SIGEL)
+C========================================================================
+C. Multiple interaction structure
+C========================================================================
+C...Compute with a montecarlo code  the  "multiple interaction structure"
+C.  of a nucleus-nucleus interaction
+C.
+C.  INPUT : IA            = mass of target nucleus
+C.          IB            = mass of projectile nucleus
+C.          SIG0 (mbarn)  = inelastic pp cross section
+C.          SIGEL(mbarn)  = elastic pp cross section
+C.
+C.  OUTPUT : in common block /CNUCMS/
+C.           B = impact parameter (fm)
+C.           BMAX = maximum impact parameter for generation
+C.           NTRY = number of "trials" before one interaction
+C.           NA = number of wounded nucleons in A
+C.           NB =    "        "        "     in B
+C.           NI = number of nucleon-nucleon inelastic interactions
+C.           NAEL = number of elastically scattered nucleons in  A
+C.           NBEL =    "         "           "          "    in  B
+C.           JJA(J)  [J=1:IA]   = number of inelastic interactions
+C.                                of J-th nucleon of nucleus A
+C.           JJB(J)  [J=1:IB]   = number of inelastic interactions
+C.                                of J-th nucleon of nucleus B
+C.           JJAEL(J)  [J=1:IA]   = number of elastic interactions
+C.                                of J-th nucleon of nucleus A
+C.           JJBEL(J)  [J=1:IB]   = number of elastic interactions
+C.                                of J-th nucleon of nucleus B
+C.           JJINT(J,K)  [J=1:NB, K=1:NA]  (0 = no interaction)
+C.                                         (1 = interaction )
+C.                                         between nucleon J of A and K of B
+C-----------------------------------------------------------------------------
+      PARAMETER (IAMAX=56)
+      COMMON /CNUCMS/ B, BMAX, NTRY, NA, NB, NI, NAEL, NBEL
+     +         ,JJA(IAMAX), JJB(IAMAX), JJINT(IAMAX,IAMAX)
+     +         ,JJAEL(IAMAX), JJBEL(IAMAX)
+      DIMENSION XA(IAMAX), YA(IAMAX), XB(IAMAX), YB(IAMAX)
+      DATA PI /3.1415926/
+      SIGT = SIG0 + SIGEL
+      R2  = 0.1 * SIG0/PI
+      R2T = 0.1 * SIGT/PI
+      BMAX = 15.                             ! fm
+      NTRY = 0
+      CALL NUC_CONF (IA, XA, YA)
+      CALL NUC_CONF (IB, XB, YB)
+      NI = 0
+      NIEL = 0
+      DO JA=1,IA
+         JJA(JA) = 0
+         JJAEL(JA) = 0
+      ENDDO
+      DO JB=1,IB
+         JJB(JB) = 0
+         JJBEL(JB) = 0
+         DO JA=1,IA
+            JJINT(JB,JA) = 0
+         ENDDO
+      ENDDO
+1000      B = BMAX*SQRT(RNDM(0))
+      PHI = 2.*PI*RNDM(0)
+      BX = B*COS(PHI)
+      BY = B*SIN(PHI)
+      NTRY = NTRY+1
+      DO JA=1,IA
+         DO JB=1,IB
+            S = (XA(JA)-XB(JB)-BX)**2 + (YA(JA)-YB(JB)-BY)**2
+            IF (S .LT. R2)  THEN
+               NI = NI + 1
+               JJA(JA) = JJA(JA)+1
+               JJB(JB) = JJB(JB)+1
+               JJINT(JB,JA) = 1
+            ELSE IF (S .LT. R2T)  THEN
+               NIEL = NIEL + 1
+               JJAEL(JA) = JJAEL(JA)+1
+               JJBEL(JB) = JJBEL(JB)+1
+            ENDIF
+         ENDDO
+      ENDDO
+      IF (NI + NIEL .EQ. 0)  GOTO 1000
+      NA = 0
+      NB = 0
+      NAEL = 0
+      NBEL = 0
+      DO JA=1,IA
+         IF (JJA(JA) .GT. 0)  THEN
+            NA = NA + 1
+         ELSE
+            IF (JJAEL(JA) .GT. 0)  NAEL = NAEL+1
+         ENDIF
+      ENDDO
+      DO JB=1,IB
+         IF (JJB(JB) .GT. 0)  THEN
+            NB = NB + 1
+         ELSE
+            IF (JJBEL(JB) .GT. 0)  NBEL = NBEL+1
+         ENDIF
+      ENDDO
+      RETURN
+      END
+
+      subroutine invert_array (yy, xmin, dx, n, xnew, ymin, dy)
+C..    This subroutine receives one   array
+C      of n y values in input yy(1:n)
+C      that correspond to  equispaced values of x_j = xmin + dx*(j-1)
+C
+C      and "reverse" the array returning an array of  x values
+C      xnew (1:n) that  corresponds to equispaced values of y
+C      The relation is assumed monotonous but can be
+C      increasing or decreasing
+C..............................................................
+      dimension  yy(n), xnew (n)
+      ymin = yy(1)
+      ymax = yy(n)
+      dy = (ymax - ymin)/float(n-1)
+      xnew (1) = xmin
+      xnew (n) = xmin + dx*float(n-1)
+      k0 = 1
+      do j=2,n-1
+         y = ymin + float(j-1)*dy
+         do k=k0,n
+            if((yy(k) .gt. y) .eqv. (yy(n) .gt. yy(1))) goto 100
+         enddo
+100      y2 = yy(k)
+         y1 = yy(k-1)
+         k0 = k-1
+         x1 = xmin + dx*float(k-2)
+         x2 = x1+dx
+         xnew (j)  = x1 + dx* (y-y1)/(y2-y1)
+      enddo
+      return
+      end
+      SUBROUTINE JET_FRAG (X1J,X2J,PTJET)
+C....Fragmentation of a jet-jet system
+C.   Input : Kinematical variables of a
+C.           jet-jet system
+C............................................
+      REAL*8 DX1J, DX2J, DBETJ
+      COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
+      COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
+      COMMON /S_CHIST/ NW,NJET,NNJET(15),XX1JET(100)
+     +   ,XX2JET(100),PPTJET(100),PHIJET(100),NNPJET(100),NNPSTR(30)
+     +   ,JDIF, EMXB, EMXT
+      DATA PGG /1./
+      E0 = SQRT(S*X1J*X2J)
+      TH = ASIN(MIN(0.999999,2.*PTJET/E0))
+      FI = 6.283185*RNDM(0)
+      NOLD = NP
+      IF ( (E0.LT.8.) .OR. (RNDM(0).GT.PGG)) THEN
+         IS = -1 + 2.*INT(1.9999*RNDM(0))
+         IFL1 = IS*(INT((2.+0.3)*RNDM(0))+1)
+         CALL STRING_FRAG (E0,IFL1,-IFL1,0.,0.,0.,0.,IFBAD)
+      ELSE
+         CALL GG_FRAG(E0)
+      ENDIF
+      DX1J = X1J
+      DX2J = X2J
+      DBETJ = (DX1J-DX2J)/(DX1J+DX2J)
+      CALL SIROBO (NOLD+1,NP,TH,FI,0.D0,0.D0,DBETJ)
+      NNPJET (NJET) = NP-NOLD
+      XX1JET (NJET) = X1J
+      XX2JET (NJET) = X2J
+      PPTJET (NJET) = PTJET
+      PHIJET (NJET) = FI
+      RETURN
+      END
+      SUBROUTINE JET_INI
+C...Compute table of cross sections, and table of probability
+C.  for the production of N (jet pairs)
+C.  The OUTPUT of this routine  is the COMMON block /CCSIG/
+C.  that contains  the cross sections h-p, h-Air, and the
+C.  cumulative probability of n_jets.
+C------------------------------------------------------------
+      COMMON /S_CSIGINP/ QQ2MIN, SSQCD (51,2), SSQCD2 (51,2),SSIG0(2),
+     @                 factork(2),isfchoice
+      COMMON /S_CCSIG2/ SSIG_TOT(51,2),SSIG_B(51,2)
+      COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
+     +    SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
+      COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
+      DIMENSION PJET (0:20)
+
+      DATA CMBARN /0.389385/
+
+      Q2MIN = QQ2MIN
+      CALL FACT_INI            ! Initialise the factorial
+      CALL HAD_CONV            ! Initialise profile convolution
+
+C...spacing in energy  for the table of cross sections.
+      NSQS = 51
+      ASQSMIN = 1.
+      ASQSMAX = 6.
+      DASQS = (ASQSMAX-ASQSMIN)/FLOAT(NSQS-1)
+
+      DO KK=1,2
+         JINT = KK
+         DO J=1, NSQS
+            ASQS = ASQSMIN + DASQS*FLOAT(J-1)
+          if (isfchoice.eq.1) then
+                    SIG_QCD  =factork(1)* SSQCD(J,KK)
+             else  if (isfchoice.eq.2) then
+                    SIG_QCD  =factork(2)* SSQCD2(J,KK)
+          endif
+            SIG_SOFT = SSIG0(KK)
+            CALL SIG_JET (SIG_QCD,SIG_SOFT,JINT,SIG_inel,PJET,
+     +                    SIG_TOT,B_EL)
+            SSIG(J,KK) = SIG_inel*CMBARN
+c            SSIG_TOT(J,KK) = SIG_TOT*CMBARN
+c            SSIG_B(J,KK) = B_EL
+            PJETC (0,J,KK) = PJET(0)
+            DO NJET=1,20
+               PJETC(NJET,J,KK) = PJETC(NJET-1,J,KK) + PJET(NJET)
+            ENDDO
+         ENDDO
+      ENDDO
+      RETURN
+      END
+      SUBROUTINE KCODE (J,CODE,NC)
+C...Produce the code for parton J
+C.  Input K, Output CODE, NC=number of characters
+C..................................................
+      CHARACTER*5 CODE
+      CHARACTER*1 NAMQ(3)
+      DATA NAMQ /'U','D','S'/
+      CODE = '     '
+      IF(J.EQ.0)  THEN
+         CODE(1:3) = 'GLU'
+         NC = 3
+         RETURN
+      ENDIF
+      JA = IABS(J)
+      J1 = MOD(JA,10)
+      J2 = (JA-J1)/10
+      IF(JA .GT. 10) THEN
+         CODE(1:1) = NAMQ(J2)
+         CODE(2:2) = NAMQ(J1)
+         NC = 2
+      ELSE
+         CODE(1:1) = NAMQ(J1)
+         NC = 1
+      ENDIF
+      IF (J .LT. 0)  THEN
+         CODE(NC+1:NC+3) = 'bar'
+         NC = NC+3
+      ENDIF
+      RETURN
+      END
+
+      FUNCTION NJETR (K,SQS)
+C...Generate a number of jet-pairs for a 'projectile'
+C.  (K=1:p),(K=2:pi) interacting with a nucleon at sqrt(s)=SQS(GeV)
+C..................................................................
+      COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
+     +    SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
+      AL = LOG10 (SQS)
+      IF (AL .LT. ASQSMIN)  THEN
+          NJETR = 0
+          RETURN
+      ENDIF
+      IF (AL .GT. ASQSMAX)  THEN
+          WRITE(*,*)  ' NJETR:  sqrt(s) out of bounds ', SQS
+          NJETR = 0
+          RETURN
+      ENDIF
+      J1 = (AL - ASQSMIN)/DASQS + 1
+C D.H.
+      J1 = MIN(J1,50)
+      J1 = MAX(J1,1)
+
+      J2 = J1+1
+      T = (AL-ASQSMIN)/DASQS - FLOAT(J1-1)
+      R = 0.999*RNDM(0)
+      DO J=0,20
+         IF (R .LT. (1.-T)*PJETC(J,J1,K)+T*PJETC(J,J2,K))  GOTO 100
+      ENDDO
+100   NJETR = J
+      RETURN
+      END
+      SUBROUTINE NUC1_PROFIL (AA)
+C...Compute the profile function T(b)
+C.  normalised as INT[d2b T(b) = 1]
+C.  INPUT : AA = mass number of nucleus
+C...............................................
+      PARAMETER (NB=401)
+      EXTERNAL DENSA
+      COMMON /CC01/  B
+      COMMON /CCDA/ JJA
+      COMMON /CPROF/ DB, BMAX, BB(NB), TB(NB), A
+      A = AA
+      IA1 = INT(AA)
+      IA2 = IA1 + 1
+      U = AA - FLOAT(IA1)
+      BMAX = 7.5
+      DB = BMAX/FLOAT(NB-1)
+      DO JB=1,NB
+         B = DB*FLOAT(JB-1)
+         BB(JB) = B
+         IF (A .LE. 18.)  THEN
+             T1 = PROFNUC (B, IA1)
+             T2 = PROFNUC (B, IA2)
+          ELSE
+             JJA = IA1
+             T1 = 2.*GAUSS (DENSA,0.,BMAX)
+             JJA = IA2
+             T2 = 2.*GAUSS (DENSA,0.,BMAX)
+          ENDIF
+          TB(JB) = (1.-U)*T1  + U*T2
+      ENDDO
+      RETURN
+      END
+
+       SUBROUTINE NUC_CONF (IA, XX, YY)
+C...This routine generates the configuration  of a nucleus
+C.  need an initialization call to NUC_GEOM_INI
+C.
+C.  INPUT  : IA = mass number of the nucleus
+C.  OUTPUT : XX(1:IA), YY(1:IA) (fm) = position in impact parameter
+C.                                     space of the IA nucleons
+C...................................................................
+      PARAMETER (IAMAX=56)
+      DIMENSION XX(IAMAX), YY(IAMAX)
+      PARAMETER (NB=401)
+      COMMON /CPROFA/ ZMIN, DZ, BBZ(NB,IAMAX)
+      DATA PI /3.1415926/
+      DO J=1,IA
+         Z = RNDM(0)
+         JZ = INT((Z-ZMIN)/DZ)+1
+C D.H.
+         JZ = MIN(JZ,400)
+         
+         T = (Z-ZMIN)/DZ - FLOAT(JZ-1)
+         B = BBZ(JZ,IA)*(1.-T) + BBZ(JZ+1,IA)*T
+         PHI = 2.*PI*RNDM(0)
+         XX(J) = B*COS(PHI)
+         YY(J) = B*SIN(PHI)
+      ENDDO
+      RETURN
+      END
+
+      SUBROUTINE NUC_GEOM_INI
+C...Initialize all nucleus profiles
+      PARAMETER (NB=401)
+      PARAMETER (IAMAX=56)
+      COMMON /CPROF/ DB, BMAX, BB(NB), TB(NB), A
+      COMMON /CPROFA/ ZMIN, DZ, BBZ(NB,IAMAX)
+      DIMENSION FFB(NB), GGB(NB)
+      DATA PI /3.1415926/
+      CALL SHELL_INI
+      CALL WOOD_SAXON_INI
+      DO IA= 2,IAMAX
+           JA = IA
+         CALL NUC_PROFIL(JA)
+         DO K=1,NB
+           FFB(K) = BB(K)*TB(K) * (2.*PI)
+         ENDDO
+         GGB(1) = 0.
+         GGB(NB) = 1.
+         DO K=2,NB-1
+           GGB(K) = GGB(K-1) + FFB(K-1)*DB
+         ENDDO
+         CALL INVERT_ARRAY(GGB,0.,DB,NB, BBZ(1,IA), ZMIN, DZ)
+      ENDDO
+      RETURN
+      END
+
+       SUBROUTINE NUC_NUC_INI
+C...Initialization for the generation of nucleus-nucleus interactions
+C.  INPUT : E0 (TeV) Energy per nucleon of the beam nucleus
+C........................................................................
+      CALL NUC_GEOM_INI                         ! nucleus profiles
+      CALL SIGMA_INI                          ! initialize pp cross sections
+      RETURN
+      END
+      SUBROUTINE NUC_PROFIL (JA)
+C...Compute the profile function T(b)
+C.  normalised as INT[d2b T(b) = 1]
+C.  INPUT : JA = integer mass number of nucleus
+C...............................................
+      PARAMETER (NB=401)
+      EXTERNAL DENSA
+      COMMON /CC01/  B
+      COMMON /CCDA/ JJA
+      COMMON /CPROF/ DB, BMAX, BB(NB), TB(NB), A
+      BMAX = 7.5
+      DB = BMAX/FLOAT(NB-1)
+      JJA = JA
+      A = JA
+      DO JB=1,NB
+        B = DB*FLOAT(JB-1)
+        BB(JB) = B
+        IF (JA .LE. 18)  THEN
+            TB(JB) = PROFNUC (B, JA)
+         ELSE
+            TB(JB) = 2.*GAUSS (DENSA,0.,BMAX)
+         ENDIF
+      ENDDO
+      RETURN
+      END
+
+      FUNCTION OMEGAP (B, SIG, SLOPE, RHO)
+      COMMON /CA0SH/ A0, A02
+      DATA PI /3.1415926/
+      ETA2 = 0.25*(A02 + SLOPE)
+      F02 = SIG*SIG*(1.+RHO*RHO)/(16.*PI**2)
+      ARG = -B*B/(4.*ETA2)
+      OMEGAP=F02/(4.*ETA2*SLOPE)*(1.-A02/(6.*ETA2)*(1.+ARG))*EXP(ARG)
+      RETURN
+      END
+
+      FUNCTION OMEGAS (B, SIG, SLOPE, RHO)
+      COMMON /CA0SH/ A0, A02
+      DATA PI /3.1415926/
+      ETA2 = 0.25*(A02 + SLOPE)
+      F02 = SIG*SIG*(1.+RHO*RHO)/(16.*PI**2)
+      ARG = -B*B/(4.*ETA2)
+      OMEGAS = F02/(4.*ETA2*SLOPE) *EXP(ARG)
+      RETURN
+      END
+      BLOCK DATA PARAM_INI
+C....This block data contains default values
+C.   of the parameters used in fragmentation
+C................................................
+      COMMON /S_CZDIS/ FA, FB0
+      COMMON /S_CZDISs/ FAs1, fAs2
+      COMMON /S_CZLEAD/ CLEAD, FLEAD
+      COMMON /S_CPSPL/ CCHIK(3,7:14)
+      COMMON /S_CQDIS/ PPT0 (33),ptflag
+      COMMON /S_CDIF0/ FFD, FBD, FDD
+      COMMON /S_CFLAFR/ PAR(8)
+      COMMON/S_cutof/stringmas0
+      data stringmas0/.35/
+C...Diffraction
+c not used in this version.DATA FFD /0.09/, FBD /0.09/, FDD /0.04/
+c      see function fdiffract
+C...Longitudinal Fragmentation function
+      DATA FA /0.5/, FB0 /0.8/
+C...Longitudinal Fragmentation function for leading baryons
+       DATA CLEAD  /0.6/, FLEAD  /0.6/
+c      strange fragmentation
+      data FAs1 /3./, fAs2 /3./
+c      data FAs1 /0./, fAs2 /0./
+C...pT of sea partons
+      DATA PTFLAG /1./
+      DATA PPT0 /0.30,0.30,0.450,30*0.60/
+C...Splitting parameters
+c      DATA CCHIK /18*2.,1.5,2.5,2.5,1.5,2.5,2.5/
+      DATA CCHIK /18*2.,6*3./
+C...Parameters of flavor formation
+      DATA PAR /0.04,0.25,0.25,0.14,0.3,0.3,0.15,0./
+      END
+      SUBROUTINE PARAM_PRINT(LUN)
+      COMMON /S_CZDIS/ FA, FB0
+      COMMON /S_CZLEAD/ CLEAD, FLEAD
+      COMMON /S_CPSPL/ CCHIK(3,7:14)
+      COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
+      COMMON /S_CQDIS/ PPT0 (33),ptflag
+      COMMON /S_CDIF0/ FFD, FBD, FDD
+      COMMON /S_CFLAFR/ PAR(8)
+
+      WRITE (LUN, 25)
+25      FORMAT( //,1x,40('-'), /
+     +   ' SIBYLL MONTECARLO PROGRAM. Version 1.00',/,1x,40('-'),/
+     +   ' List of parameters: ' )
+
+      WRITE (LUN, 27) FFD, FBD, FDD
+27      FORMAT(' Fraction of beam/target/double  diffraction = ',
+     +         3F8.3)
+
+      WRITE (LUN, 28) Q2MIN
+28      FORMAT (' Q2min = ', F10.2, ' GeV**2 ')
+      WRITE (LUN, 31) FA, FB0
+31      FORMAT (' Parameters of longitudinal fragmentation: ', /,
+     +          '  f(z) = (1-z)**a * exp(-b * mt**2/z) ', /,
+     +          '  a = ', f9.3, 3x, ' b = ', f9.3, ' GeV**-2' )
+      WRITE (LUN, 32) CLEAD, 1./FLEAD-1.
+32      FORMAT (' Parameters of leading fragmentation: ', /,
+     +   '  f(z) = c + (1-z)**a ', /,
+     +   '  c = ',f9.3,3x,' a = ',f9.3)
+
+      WRITE (LUN, 35) PPT0(1), PPT0(3), PPT0(11),ppt0(10)
+35      FORMAT (' <pT> of sea partons ', /,
+     +   2x,'<pT>(u/d) ',F8.3,2x,'<pT>(s) ',f8.3,2x,'<pT>(qq) ',f8.3,
+     +     2x,'<pT>(val) ',f8.3)
+
+      WRITE (LUN, 120) PAR
+120      FORMAT (1x, 'Parameters of flavor formation: ',/,
+     +   3x,'PAR(1) = Prob(qq)/Prob(q) =              ',F10.2,/,
+     +   3x,'PAR(2) = Prob(s)/Prob(u)  =              ',F10.2,/,
+     +   3x,'PAR(3) = Prob(us)/Prob(ud) =             ',F10.2,/,
+     +   3x,'PAR(4) = Prob(ud_0)/Prob(ud_1) =         ',F10.2,/,
+     +   3x,'PAR(5) = Prob(Vector)/Prob(Scalar) =     ',F10.2,/,
+     +   3x,'PAR(6) = Prob(K*)/Prob(K) =              ',F10.2,/,
+     +   3x,'PAR(7) = Prob(spin 3/2)/Prob(spin=1/2) = ',F10.2,/,
+     +   3x,'PAR(8) = Prob(B-M-Bbar)/Prob(B-Bbar) =   ',F10.2)
+
+      WRITE (LUN, 40)
+      WRITE (LUN, 41) CCHIK (1,13), CCHIK(2,13)
+40      FORMAT(' Parameters of hadron splitting ' )
+41      FORMAT('   p -> [(ud) u] splitting: alpha = ', F10.3, /,
+     +         '   p -> [(uu) d] splitting: alpha = ', F10.3 )
+
+      RETURN
+      END
+      FUNCTION PARTON(X,L)
+C...This function returns the structure function
+C.   f(x) = x * [ g(x) + 4/9 *(q(x) + qbar(x)) ]
+C.  for a proton. In COMMON /S_CSTR/ JSTR controls
+C.  the choice of structure function
+C................................................
+      COMMON /S_CSTR/ JSTR, JSTRPI
+C O. Palamara 27/8/1993
+c      parameter beta=1.925978
+      parameter (beta=1.925978)
+      IF (L .EQ. 2)  GOTO 1000
+
+C...Eichten et al.  (set 1)
+100      uv = 1.78 * x**0.5 * (1.-x**1.51)**3.5
+      dv = 0.67 * x**0.4 * (1.-x**1.51)**4.5
+      us = 0.182 * (1.-x)**8.54
+      ss = 0.081 * (1.-x)**8.54
+      qq0 = uv + dv + 4.*us + 2.*ss
+      glu0 = (2.62 + 9.17*x)* (1.-x)**5.90
+      parton = glu0 + 4./9.*qq0
+      return
+
+
+1000      continue   ! goto (1100,1200),  jstrpi
+
+C...Owens set 1   from STRF from Wisc. Pheno. group. for q2=q2_min
+      AV=.4
+      BV=.7
+c      BETA=GGAMMA(AV)*GGAMMA(BV+1.)/GGAMMA(AV+BV+1.)  =1.925978
+      uv=X**(AV)*(1.-X)**BV/BETA
+      dv=uv
+c
+      A=.9
+      BET=5.
+      us=(A*(1.-X)**BET)/6.
+c
+      A=.888
+      BET=3.11
+      GA1=6.0
+      glu0=A*(1.-X)**BET*(1.+GA1*X)
+c   Bug Fix thanks to Sue Kashahara- correct factor in front of
+c   sea quarks for Owens S.F.  5-94
+      qq0 = uv + dv + 6.*us
+      parton = (glu0 + 4./9.*qq0)
+      return
+      end
+
+      FUNCTION PART_INT (ZMIN,L)
+C...This function returns as output the integral of
+C.  the parton structure function:
+C.     f(x) = g(x) + 4/9 *(q(x) + qbar(x))
+C.  from xmin = exp(zmin) to 1
+C.  for a proton (L=1) or a pi (L=2)
+C.  needs to be initialised with: CALL ZSAMPLE_INI
+C.....................................................
+      COMMON /S_CZGEN/ XA,XB,XMAX,ZA,ZB,ZMAX,DX,DZ,NX,NZ,APART(2),
+     +   FFA(2),FFB(2),
+     +   DFX(2),DFZ(2),XX(200,2),ZZ(200,2),FFX(200,2),FFZ(200,2)
+
+C D.H.IF (ZMIN .LT. ZA)  THEN
+      IF (ZMIN .LE. ZA)  THEN
+         PART_INT = FFA(L) + APART(L)*(ZA-ZMIN)
+C D.H.ELSE IF (ZMIN .LT. ZB) THEN
+      ELSE IF (ZMIN .LE. ZB) THEN
+         JZ = (ZB-ZMIN)/DZ+1
+         Z0 = ZB-DZ*FLOAT(JZ-1)
+         T = (Z0-ZMIN)/DZ
+         PART_INT = FFZ(JZ,L)*(1.-T) + FFZ(JZ+1,L)*T
+      ELSE
+         X = EXP(ZMIN)
+         JX = (XMAX-X)/DX+1
+         X0 = XMAX-DX*FLOAT(JX-1)
+         T = (X0-X)/DX
+         PART_INT = FFX(JX,L)*(1.-T) + FFX(JX+1,L)*T
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE PJET_PRINT (L,SQS, LUN)
+C...Write the jet probability:
+C.  L = particle code, SQS = sqrt(s), LUN = unit of output
+C..................................................................
+      COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
+     +    SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
+      DIMENSION LL(7:14)
+      DATA LL /6*2,2*1/
+      AL = LOG10 (SQS)
+      IF (AL .LT. ASQSMIN .OR. AL .GT. ASQSMAX)  RETURN
+
+      K = LL(IABS(L))
+      J1 = (AL - ASQSMIN)/DASQS + 1
+      J2 = J1+1
+      T = (AL-ASQSMIN)/DASQS - FLOAT(J1-1)
+      R = 0.999*RNDM(0)
+      J = 0
+      P = (1.-T)*PJETC(0,J1,K)+T*PJETC(0,J2,K)
+      WRITE (LUN, 20)
+      WRITE (LUN, 25) J, P
+      AMED = 0.
+      ASUM = P
+      DO J=0,19
+         PA = (1.-T)*PJETC(J,J1,K)+T*PJETC(J,J2,K)
+         PB = (1.-T)*PJETC(J+1,J1,K)+T*PJETC(J+1,J2,K)
+         P = PB-PA
+         IF (P .GT. 1.E-04)  WRITE (LUN, 25) J+1, P
+         AMED = AMED + FLOAT(J+1)*P
+         ASUM = ASUM + P
+      ENDDO
+      WRITE (LUN, 26) AMED, ASUM
+      RETURN
+20    FORMAT (/,'  Minijet expected frequencies: ')
+25    FORMAT ('    n(jet-pairs)   = ',i3,  F12.4)
+26    FORMAT ('    <n(jet-pairs)> = ',F10.2, '   norm = ', F9.3)
+      END
+      FUNCTION PROFNUC (B, JA)
+C...This function return
+C.  the profile T(b) for a nucleus of mass number A
+C.  INPUT B = impact parameter (GeV**-1)
+C.        JA = integer mass number
+C.  OUTPUT  (fm**-2)
+C.
+C.  The  density of the nucleus is the `shell model density'
+C.  the parameter r0 must beinitialized in the common block
+C.............................................................
+      COMMON /CSHELL/ RR0(18), RR02(18)
+      DATA PI /3.1415926/
+      B2 = B*B
+      ARG = B2/RR02(JA)
+      TS = EXP(-ARG)
+      TP = TS*(2.*B2+RR02(JA))/(3.*RR02(JA))
+      CS = MIN(1.,4./FLOAT(JA))
+      PROFNUC = (CS*TS + (1.-CS)*TP)/(PI*RR02(JA))
+      RETURN
+      END
+
+      SUBROUTINE PTDIS (IFL,PX,PY)
+C...Generate pT
+      COMMON /S_CQDIS/ PPT0(33),ptflag
+      PT = PPT0(IABS(IFL))*SQRT(-ALOG(MAX(1E-10,RNDM(0))))
+      PHI= 6.2831853*RNDM(0)
+      PX=PT*COS(PHI)
+      PY=PT*SIN(PHI)
+      RETURN
+      END
+      FUNCTION QMASS(IFL)
+C...Return quark or diquark constituent masses
+      DIMENSION QMAS(3)
+      DATA QMAS /0.325,0.325,0.5/
+      IFLA = IABS(IFL)
+      IF (IFLA .LE. 3)       THEN
+         QMASS = QMAS(IFLA)
+      ELSE
+         QMA = QMAS(IFLA/10)
+         QMB = QMAS(MOD(IFLA,10))
+         QMASS = QMA+QMB
+      ENDIF
+      RETURN
+      END
+       SUBROUTINE QNUM (JQ,JS,JB,JBA, NC, NF)
+C...Return the quantum numbers of one event
+C.  JQ = charge, JB = baryon number, JS = strangeness
+C.  JBA = (number of baryons+antibaryons)
+C.  NC  = number of charged particles
+C.  NF  = number of final particles
+C..................................................
+      COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
+      COMMON /S_CHP/ ICHP(49), ISTR(49), IBAR(49)
+      JQ = 0
+      JB = 0
+      JS = 0
+      JBA= 0
+      NC = 0
+      NF = 0
+      DO J=1,NP
+          L = LLIST(J)
+          LL = IABS(L)
+          IF (LL .LT. 10000)  THEN
+              IF(ICHP(LL) .NE. 0) NC = NC + 1
+              NF = NF + 1
+              JQ = JQ + ICHP(LL)*ISIGN(1,L)
+              JB = JB + IBAR(LL)*ISIGN(1,L)
+              JBA= JBA+ IBAR(LL)
+              JS = JS + ISTR(LL)*ISIGN(1,L)
+          ENDIF
+      ENDDO
+      RETURN
+      END
+      FUNCTION QUAD_INT (R,X0,X1,X2,V0,V1,V2)
+c  quadratic interpolation?
+      R0=R-X0
+      R1=R-X1
+      R2=R-X2
+      S0=X0-X1
+      S1=X0-X2
+      S2=X1-X2
+      QUAD_INT = V0*R1*R2/(S0*S1)-V1*R0*R2/(S0*S2)+V2*R0*R1/(S1*S2)
+      RETURN
+      END
+
+      function rdis(idummy)
+      dimension probr(20)
+      data probr/
+     *      0.10000, 0.15748, 0.21778, 0.28605, 0.36060,
+     *      0.43815, 0.51892, 0.60631, 0.70002, 0.79325,
+     *      0.88863, 0.98686, 1.10129, 1.21202, 1.32932,
+     *      1.44890, 1.57048, 1.70139, 1.83417, 2.00000/
+      nr = 20.*RNDM(0) + 1
+      if (nr .eq. 1) then
+      f1 = 0.
+      else
+      f1 = probr(nr-1)
+      endif
+      dr = probr(nr) - f1
+      rdis = f1 + dr*RNDM(0)
+      return
+      end
+      SUBROUTINE SAMPLE (L, X1,X2,PT)
+C...Routine for the sampling the kinematical variables
+C.  that determine a  jet-jet  system (x1,x2, pT)
+C.  from the differential cross section:
+C.     d3sigma/(dx1 dx2 dpT)
+C.  This version assumes the `single parton approximation'
+C.  INPUT:  L=1 incident proton, L=2  incident pi
+C.  OUTPUT:  X1, X2, PT (GeV)
+C.................................................................
+      COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
+100   Z1=ZSAMPLE (ZMIN,L)
+      Z2=ZSAMPLE (ZMIN,1)
+      SIG=1.-XMIN*EXP(-Z1-Z2)
+      IF (SIG .LT. RNDM(0))  GOTO 100
+      X1=EXP(Z1)
+      X2=EXP(Z2)
+      Q2=Q2MIN/(1.-RNDM(0)*SIG)
+      PT=SQRT(Q2*(1.-Q2/(S*X1*X2)))
+      RETURN
+      END
+      FUNCTION SHELL (R,JA)
+C...Density in the shell model
+      COMMON /CSHELL/ RR0(18), RR02(18)
+      DATA PI /3.1415926/
+      R0 = RR0(JA)
+      C1 = MIN(1.,4./FLOAT(JA))
+      CS = 1./(R0**3*PI**(1.5))
+      CP = 2.*CS/3.
+      FS = EXP(-(R/R0)**2)
+      FP = (R/R0)**2 * FS
+      SHELL = C1*CS*FS + (1.-C1)*CP*FP
+      RETURN
+      END
+
+      SUBROUTINE SHELL_INI
+C...Initialize the parameter  of the shell model
+C.  for the nuclei with    6 < A < 18
+C..............................................
+      COMMON /CSHELL/ RR0(18), RR02(18)
+      DIMENSION RR(18)
+C...Data on Sqrt[<r**2>]  in fermi
+      DATA RR /0.81,2.095,1.88,1.674, -1.,2.56,2.41,-1.,2.519,2.45
+     +          ,2.37, 2.460, 2.440, 2.54, 2.58, 2.718, 2.662,2.789 /
+      DO JA=1,18
+         A = FLOAT(JA)
+         RMED = RR(JA)
+         IF (RMED .LE. 0.)   RMED = 0.5*(RR(JA-1) + RR(JA+1))
+         C = MAX(1.5,(5./2. - 4./A) )
+         R0 = RMED/SQRT(C)
+         RR0 (JA) = R0
+         RR02(JA) = R0*R0
+      ENDDO
+      RETURN
+      END
+      SUBROUTINE SIBLIST(LUN)
+C...This routine prints the event record for the
+C.  current event on unit LUN
+C.................................................
+      COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
+      COMMON /S_PLIST1/ LLIST1(5000)
+      COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
+      COMMON /S_CHIST/ NW,NJET,NNJET(15),XX1JET(100)
+     +   ,XX2JET(100),PPTJET(100),PHIJET(100),NNPJET(100),NNPSTR(30)
+     +   , JDIF, EMXB, EMXT
+      COMMON /S_CCSTR/ X1(30),X2(30),IFLB(30),IFLT(30),PXB(30),
+     +    PYB(30),PXT(30),PYT(30)
+      COMMON /S_CNAM/ NAMP (0:49)
+      CHARACTER*6 NAMP
+      CHARACTER CODE*18, COD1*5, COD2*5
+      CHARACTER*18 NAMDIF(3)
+      DATA NAMDIF /'Beam diffraction  ','Target diffraction',
+     +               'Double diffraction'/
+*     WRITE (LUN,*)
+      WRITE (LUN,*) ' Event record '
+      WRITE (LUN,100)
+      IF(JDIF .GT. 0)  THEN
+         WRITE (LUN,*) '  ',NAMDIF(JDIF)
+         GOTO 10
+      ENDIF
+      NA = -(NJET+2*NW+1)
+      N  = 0
+      DO J=1,NJET
+         NA = NA+1
+         DO K=1,NNPJET(J)
+            N=N+1
+            LLIST1(N) = NA
+         ENDDO
+      ENDDO
+      DO J=1,2*NW
+         NA = NA+1
+         DO K=1,NNPSTR(J)
+            N=N+1
+            LLIST1(N) = NA
+         ENDDO
+      ENDDO
+C...Jet-Jet strings
+      K = 0
+      JA = -(NJET+2*NW+1)
+      DO J=1,NJET
+         JA = JA+1
+         CODE = 'Jet-Jet           '
+         PX = PPTJET(J)
+         PY = 0.
+         PZ = SQS*(XX1JET(J)-XX2JET(J))
+         EE = SQS*(XX1JET(J)+XX2JET(J))
+         WRITE (LUN,120) JA, CODE, K, PX,PY,PZ,EE
+      ENDDO
+C...Beam strings
+      DO J=1,2*NW
+         JA = JA+1
+         CALL KCODE(IFLT(J),COD1,NC1)
+         CALL KCODE(IFLB(J),COD2,NC2)
+         CODE(1:7)  = 'String '
+         CODE(7+1:18) = '              '
+         CODE(7+1:7+6)=COD1
+         CODE(NC1+1+7:NC1+1+7) = '-'
+         CODE(NC1+2+7:NC1+6+7) = COD2
+         PX = PXB(J)+PXT(J)
+         PY = PYB(J)+PYT(J)
+         PZ = SQS*(X1(J)-X2(J))
+         EE = SQS*(X1(J)+X2(J))
+         WRITE (LUN,120) JA, CODE, K, PX,PY,PZ,EE
+      ENDDO
+C...Print particle list
+10      DO J=1,NP
+          L = MOD(LLIST(J),10000)
+          CODE = '                  '
+          CODE(1:6) = NAMP(IABS(L))
+          IF (L .LT. 0) CODE(7:9) = 'bar'
+          IF(IABS(LLIST(J)) .GT. 10000)   CODE(10:10) = '*'
+          WRITE (LUN,120) J, CODE, LLIST1(J), (P(J,K),K=1,4)
+      ENDDO
+      CALL ESUM(1,NP,EE,PX,PY,PZ,NF)
+      WRITE(LUN,140) PX,PY,PZ,EE
+100      FORMAT(3X,'N  Particle',12X,'Ori',6x,'PX',9x,'PY',9x,'PZ'
+     +         ,9x,'E', /, 3X,70('-'))
+120      FORMAT(1X,I4,1X,A18,1X,I4,2X,2(F9.3,2X),2(E9.3,2X))
+140      FORMAT(1X,'Tot = ',24X,2(F9.3,2X),G9.3,2X,E9.3)
+      RETURN
+      END
+      SUBROUTINE  SIBNUC (IAB, IAT, SQS)
+C...Routine that generates the interaction of a nucleus of
+C.  mass number IAB with a  target nucleus  of mass IAT
+C.  (IAT=0 : air).
+C.  SQS (GeV) is the  center of mass energy of each
+C.  nucleon - nucleon cross section
+C---------------------------------------------------------------
+      COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
+      COMMON /S_PLNUC/ NPA, PA(5000,5), LLA(5000)
+      COMMON /S_MASS1/ AM(49), AM2(49)
+      COMMON /CKFRAG/ KODFRAG
+      PARAMETER (IAMAX=56)
+      COMMON /CNUCMS/ B, BMAX, NTRY, NA, NB, NI, NAEL, NBEL
+     +         ,JJA(IAMAX), JJB(IAMAX), JJINT(IAMAX,IAMAX)
+     +         ,JJAEL(IAMAX), JJBEL(IAMAX)            
+      COMMON /FRAGMENTS/ PPP(3,60)
+      DIMENSION  IAF(60)
+      DATA RPOX /0.3624/
+
+C...Target mass
+      IF (IAT .EQ. 0) THEN
+         IATARGET = 14 + 2*INT((1.+RPOX)*RNDM(0))
+      ELSE
+          IATARGET = IAT
+      ENDIF
+       
+C...Single nucleon (proton) case
+      IF (IAB .EQ. 1)  THEN
+         NPA = 0
+         CALL SIBYLL (13,IATARGET, SQS)
+         CALL DECSIB
+         DO J=1,NP
+            LA = IABS(LLIST(J))
+            IF (LA .LT. 10000)  THEN
+               NPA = NPA + 1
+               LLA(NPA) = LLIST(J)
+               DO K=1,5
+                  PA(NPA,K) = P(J,K)                                                                               (J,K)
+               ENDDO
+            ENDIF
+         ENDDO
+         RETURN
+      ENDIF
+
+
+C...Nuclei
+      E0 = (SQS*SQS-2.*AM2(13))/(2.*AM(13))
+      E0 = E0*1.E-03         ! TeV
+      CALL SIGMA_PP (E0, SIGT, SIGEL, SIG0, SLOPE, RHO)
+      CALL INT_NUC (IATARGET, IAB, SIG0, SIGEL) 
+C...fragment the spectator nucleons
+      NBT = NB + NBEL
+      IF (KODFRAG .EQ. 1)  THEN
+          CALL FRAGM1(IAB,NBT, NF, IAF)
+      ELSE IF(KODFRAG .EQ. 2)  THEN
+          CALL FRAGM2(IAB,NBT, NF, IAF)
+      ELSE 
+          CALL FRAGM (IATARGET, IAB, NBT,B, NF, IAF)
+      ENDIF
+     
+C...Spectator fragments
+      NPA = 0
+      DO J=1,NF
+         NPA = NPA+1
+         LLA(NPA) = 1000+IAF(J)
+         PA(NPA,1) = 0.
+         PA(NPA,2) = 0.
+         PA(NPA,3) = SQS/2.
+         PA(NPA,4) = SQS/2.
+         PA(NPA,5) = FLOAT(IAF(J))*0.5*(AM(13)+AM(14))
+      ENDDO
+C...Elastically scattered   fragments
+      DO J=1,NBEL
+         NPA = NPA+1
+         LLA(NPA) = 1001
+         PA(NPA,1) = 0.
+         PA(NPA,2) = 0.
+         PA(NPA,3) = SQS/2.
+         PA(NPA,4) = SQS/2.
+         PA(NPA,5) = 0.5*(AM(13)+AM(14))
+      ENDDO
+C...Superimpose NB  nucleon interactions
+      DO JJ=1,NB
+          CALL SIBYLL (13,IATARGET, SQS)
+          CALL DECSIB
+          DO J=1,NP
+             LA = IABS(LLIST(J))
+             IF (LA .LT. 10000)   THEN
+                NPA = NPA + 1
+                LLA(NPA) = LLIST(J)
+                DO K=1,5
+                    PA(NPA,K) = P(J,K)
+                ENDDO
+            ENDIF
+         ENDDO
+      ENDDO
+      RETURN
+      END
+      SUBROUTINE SIBYLL (KB, IATARG, SQS)
+C...Main routine for the production of hadronic events,
+C.  Generates an inelastic hadronic interaction of
+C.  a `projectile particle' of code KB with a
+C.  target nucleus of mass number A = IATARG (integer)
+C.  IATARG = 0 is an "air" nucleus  (superposition of oxygen and nitrogen)
+C.  with c.m. energy for the hadron-nucleon system SQS (GeV)
+C.
+C.  Allowed values of KB: 7,8,9,10,11,12,13,14,-13,-14
+C.                        pi+-,K+-,KL,KS,p,n,pbar,nbar
+C.
+C.  The output is contained in COMMON /S_PLIST/ that contains:
+C.
+C.     NP           number of final particles
+C.     P(1:NP, 1:5) 4-momenta + masses of the final particles
+C.     LLIST (1:NP) codes of final particles.
+C.  the reaction is studied in the c.m. of  hadron-nucleon system
+C.
+C.  The COMMON block /S_CHIST/ contains information about the
+C.  the structure of the  generated event:
+C.    NW   = number of wounded nucleons
+C.    NJET = number of jet pairs
+C.    NNJET (1:NW) = number of minijets produced in each interaction
+C.    XX1JET (1:NJET) = x1  for each jet-pair
+C.    XX2JET (1:NJET) = x2   "   "     "
+C.    PPTJET (1:NJET) = pT   "   "     "
+C.    NNPJET (1:NJET) = total number of particles in each jet pair
+C.    NNPSTR (1:2*NW) = number of particles in each `beam string'
+C.    JDIF  = diffraction code
+C----------------------------------------------------------------------
+      COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
+      COMMON /S_RUN/ SQSA, S, Q2MIN, XMIN, ZMIN , kbc ,kt
+      COMMON /S_CHIST/ NW,NJET,NNJET(15),XX1JET(100),XX2JET(100)
+     +   ,PPTJET(100),PHIJET(100),NNPJET(100),NNPSTR(30)
+     +   ,JDIF, EMXB, EMXT
+      COMMON /S_CLDIF/ LDIFF
+      COMMON /S_CCSTR/ X1(30),X2(30),IFLB(30),IFLT(30),PXB(30),
+     +    PYB(30),PXT(30),PYT(30)
+      COMMON /S_CQDIS/ PPT0 (33),ptflag
+      DIMENSION QMAS(33),X2JET(30),LL(7:14),BET(30),GAM(30),EE(30)
+      DATA QMAS
+     .  /2*0.35,0.6,7*0.,2*1.1,1.25,7*0.,1.25,1.1,1.25,7*0,2*1.25,1.5/
+      DATA LL /6*2,2*1/
+      DATA  FOX /0.257/
+      COMMON/S_cutof/stringmas0
+
+      kbc=kb
+      SQSA = SQS
+      S = SQS*SQS
+      XMIN = 2.*Q2MIN/S
+      ZMIN = LOG(XMIN)
+
+C...`soft increase of pT'
+C Setting ptflag = 0 will result in
+C underestimating the P_t at high energies.
+      if (ptflag.gt.0.0) then
+            ptu=.3+.08*log10(sqs/30.)
+            pts=.45+.08*log10(sqs/30.)
+            ptqq=.6+.08*log10(sqs/30.)
+            PPT0 (1) = PTU
+            PPT0 (2) = PTU
+            PPT0 (3) = PTS
+            PPT0 (10) = PTQQ
+            DO J=11,33
+                PPT0(J) = PTQQ
+            ENDDO
+      endif
+
+      NP = 0
+      NJET = 0
+      IATARGET = IATARG
+C
+C      Generate an 'air' interaction by choosing Nitrogen or Oxygen
+C
+      IF (IATARGET .EQ. 0) THEN
+          R = RNDM(0)
+          IATARGET = 14
+          IF (R .LT. FOX)  IATARGET = 16
+      ENDIF
+      IATARG = IATARGET
+      L = LL(IABS(KB))
+C
+C     Generate number ow wounded nucleons, and diffraction code.
+C
+1000  CALL SIB_START_EV (SQS,L,IATARGET, NW,JDIF)
+      IF (LDIFF .NE. 0)  THEN
+         IF((LDIFF.EQ.-1) .AND. (JDIF.NE.0) ) GOTO 1000
+         IF((LDIFF.EQ. 1) .AND. ((JDIF.NE.0).AND.(JDIF.NE.3)))
+     +     GOTO 1000
+         IF((LDIFF.EQ. 5) .AND. (JDIF.EQ.2)) GOTO 1000
+         IF((LDIFF.GE. 2) .AND. (LDIFF.LE.4)) THEN
+             NW = 1
+             JDIF = LDIFF-1
+         ENDIF
+      ENDIF
+C...Diffractive interactions
+      IF (JDIF .NE. 0)  THEN
+        CALL DIFF_GEN (KB, JDIF)
+        RETURN
+      ENDIF
+
+C...Non-diffractive interactions
+2000  L = LL(IABS(KB))
+C...Production of minijets
+3000  NP = 0
+      NJET = 0
+      X1JET = 0.
+      DO JW=1,NW
+         NNJET (JW) = NJETR (L,SQS)
+         X2JET(JW) = 0.
+         DO JJ=1,NNJET(JW)
+           NJET=NJET+1
+           NOLD=NP
+           CALL SAMPLE (L,X1J,X2J,PTJET)
+           CALL JET_FRAG (X1J,X2J,PTJET)
+           X1JET = X1JET + X1J
+           X2JET(JW) = X2JET(JW)+X2J
+         ENDDO
+         IF (X2JET (JW) .GT. 0.7)   GOTO 3000
+      ENDDO
+      IF (X1JET .GT. 0.7)           GOTO 3000
+C
+C ...Prepare 2*NW color strings.
+C
+      CALL BEAM_SPLIT (KB, NW, X1, IFLB, X1JET, LXBAD,stringmas0)
+C     IF (LXBAD .EQ. 1)  GOTO 2000 Bug fix 2-4-94 PL/RSF
+      IF (LXBAD .EQ. 1)  GOTO 1000
+      DO J=1,NW
+         J1=2*(J-1)+1
+         J2=J1+1
+         KT=13
+         IF (IATARGET .GT. 1)  KT = 13+INT(2.*RNDM(0))
+         CALL HSPLI (KT,IFLT(J2),IFLT(J1))
+         XMINA = 2.*stringmas0/(SQS*(1.-X2JET(J)))
+C        XMINA = 2.*0.20/(SQS*(1.-X2JET(J)))  ! change RSF. 5-92
+         CHI=CHIDIS (KT,IFLT(J2),IFLT(J1))
+         XVAL=1.-X2JET(J)
+         IF (XVAL.LT.XMINA) GOTO 3000
+         X2(J2) = MAX(CHI*XVAL,XMINA)
+         X2(J2) = MIN(X2(J2),XVAL-XMINA)
+         X2(J1) = XVAL-X2(J2)
+      ENDDO
+C...Generates primordial pT for the partons
+      DO J=1,NW
+         J1 = 2*(J-1)+1
+         J2 = J1+1
+         CALL PTDIS (10,PXT(J1),PYT(J1))
+         if (j.eq.1) then
+            CALL PTDIS (10,PXB(J2),PYB(J2))
+         else
+            CALL PTDIS (IFLB(J2),PXB(J2),PYB(J2))
+         endif
+         PXB(J1) = -PXB(J2)
+         PYB(J1) = -PYB(J2)
+         PXT(J2) = -PXT(J1)
+         PYT(J2) = -PYT(J1)
+      ENDDO
+C...Check consistency of kinematics
+      DO J=1,2*NW
+         EE(J) = SQS*SQRT(X1(J)*X2(J))
+         XM1 = SQRT(PXB(J)**2+PYB(J)**2+QMAS(IABS(IFLB(J)))**2)
+         XM2 = SQRT(PXT(J)**2+PYT(J)**2+QMAS(IABS(IFLT(J)))**2)
+         IF (EE(J) .LT. XM1+XM2+0.3)  GOTO 2000
+      ENDDO
+C...Fragment the 2*NW color strings
+      DO J=1,2*NW
+         EE (J) = SQS*SQRT(X1(J)*X2(J))
+         BET(J) = (X1(J)-X2(J))/(X1(J)+X2(J))
+         GAM(J) = (X1(J)+X2(J))/(2.*SQRT(X1(J)*X2(J)))
+         NOLD=NP
+         CALL STRING_FRAG
+     +     (EE(J),IFLB(J),IFLT(J),PXB(J),PYB(J),PXT(J),PYT(J),IFBAD)
+         IF (IFBAD .EQ. 1)   GOTO 2000
+         DO K=NOLD+1,NP
+           PZ = P(K,3)
+           P(K,3) = GAM(J)*(PZ+BET(J)*P(K,4))
+           P(K,4) = GAM(J)*(P(K,4)+BET(J)*PZ)
+         ENDDO
+         NNPSTR(J) = NP-NOLD
+      ENDDO
+
+C...Check energy conservation
+      CALL ESUM(1,NP,ETOT,PXT,PYT,PZT,NF)
+      IF (ABS(ETOT/(0.5*SQS*FLOAT(NW+1)) - 1.) .GT. 1.E-03)  THEN
+         WRITE(*,*) ' Energy non conserved. L, SQS : ',L,SQS
+         WRITE(*,*) ' sqs = ', SQS, ' E_f = ', ETOT
+         WRITE(*,*) ' diff/N_w/N_j = ', JDIF, NW, NJET
+      ENDIF
+      RETURN
+      END
+
+      SUBROUTINE SIBYLL_INI
+C   Initialization routine for the   the routine
+C.  SYBILL   for simulation of hadronic interactions
+C.
+C.  the routine fills the COMMON block /CCSIG/ that contains
+C.  important information for the generation of events
+C.
+C*      COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
+C*     +    SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
+C.
+C.  NSQS = number of energy points  (51 is current version)
+C.  ASQSMIN = log_10 [sqrt(s) GeV]   minimum value
+C.  ASQSMIN = log_10 [sqrt(s) GeV]   maximum value
+C.  DASQS   = step  in log_10[sqrt(s)]
+C.            DASQS = (ASQSMAX - ASQSMIN)/(NSQS-1)
+C.
+C.  SSIG(J,1) inelastic cross section for pp interaction
+C.            at energy: sqrt(s)(GeV) = 10**[ASQSMIN+DASQS*(J-1)]
+C.  SSIG(J,2)  inelastic cross section for pi-p interaction
+C.  SSIGN(J,1) inelastic cross section for p-Air interaction
+C.  SSIGN(J,2) inelastic cross section for pi-Air interaction
+C.
+C.  PJETC(n_j,J,1) Cumulative  probability distribution
+C.                 for the production of n_j (n_j=0:20) jet pairs
+C.                 at sqrt(s) labeled by J, for p-p interaction
+C.  PJETC(n_j,J,2) Same as above for pi-p interaction
+C.  ALINT(J,1)   proton-air  interaction length (g cm-2)
+C.  ALINT(J,2)   pi-air  interaction length (g cm-2)
+C------------------------------------------------------------------
+      WRITE(*,*) ' Initialization of the SIBYLL event  generator '
+      WRITE(*,100)
+ 100  FORMAT(' ','====================================================',
+     *     /,' ','|                                                  |',
+     *     /,' ','|                 S I B Y L L  1.6                 |',
+     *     /,' ','|                                                  |',
+     *     /,' ','|         HADRONIC INTERACTION MONTE CARLO         |',
+     *     /,' ','|                        BY                        |',
+     *     /,' ','|           R.S. FLETCHER, T.K. GAISSER            |',
+     *     /,' ','|               P. LIPARI, T. STANEV               |',
+     *     /,' ','|                                                  |',
+     *     /,' ','| LAST MODIFICATIONS: Apr  15, 1997     by D. Heck |',
+     *     /,' ','====================================================',
+     *     /)
+      CALL JET_INI
+      CALL ZSAMPLE_INI
+      CALL BLOCK_INI
+      CALL NUC_GEOM_INI
+      CALL SIG_AIR_INI
+      RETURN
+      END
+      SUBROUTINE sib_SIGMA_HAIR (SQS,L0,SIGINEL)
+C
+C      Sibyll P-air cross section
+C
+C...pi,p air  cross sections
+C. INPUT: SQS = c.m.s. energy (GeV)
+C.
+C. OUTPUT:
+C.         SIGINEL = inelastic cross section
+C---------------------------------------------------------------------------
+      COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
+     +    SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
+      AL = LOG10(SQS)
+      J1 = (AL - 1.)*10. + 1
+C D.H.
+      J1 = MAX(J1,1)
+      J1 = MIN(J1,50)
+
+      T = (AL-1.)*10. - FLOAT(J1-1)
+      SIGINEL = SSIGN(J1,L0)*(1.-T) + SSIGN(J1+1,L0)*T
+      RETURN
+      END
+      SUBROUTINE sib_SIGMA_PIP (SQS, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
+C...pip cross sections
+C. INPUT: SQS = c.m.s. energy (GeV)
+C.
+C. OUTPUT: SIGT = total cross section
+C.         SIGEL = elastic cross section
+C.         SIGINEL = inelastic cross section
+C.         SLOPE = slope of elastic scattering (GeV**-2)
+C.         RHO = Imaginary/Real part of forward elastic scattering amplitude
+C---------------------------------------------------------------------------
+      COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
+     +    SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
+      DATA PI /3.1415926/
+      DATA CMBARN /0.389385/
+      AL = LOG10(SQS)
+      J1 = (AL - 1.)*10. + 1
+C D.H.
+      J1 = MAX(J1,1)
+      J1 = MIN(J1,50)
+
+      T = (AL-1.)*10. - FLOAT(J1-1)
+      SIGINEL = SSIG(J1,2)*(1.-T) + SSIG(J1+1,2)*T
+      CALL BLOCK(SQS,SIGT1,SIGT2,SLOP1,SLOP2,RHO1,RHO2,SIGEL1,SIGEL2)
+      R = SIGEL1/SIGT1
+      RHO = RHO1
+      SIGT  = SIGINEL/(1.-R)
+      SIGEL = SIGINEL*R/(1.-R)
+      SLOPE = SIGT**2/(SIGEL * 16.*PI) * (1.+RHO1**2) /CMBARN
+      RETURN
+      END
+      SUBROUTINE sib_SIGMA_PP (SQS, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
+C...pp cross sections
+C. INPUT: SQS = c.m.s. energy (GeV)
+C.
+C. OUTPUT: SIGT = total cross section
+C.         SIGEL = elastic cross section
+C.         SIGINEL = inelastic cross section
+C.         SLOPE = slope of elastic scattering (GeV**-2)
+C.         RHO = Imaginary/Real part of forward elastic scattering amplitude
+C---------------------------------------------------------------------------
+      COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
+     +    SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
+      COMMON /S_CCSIG2/ SSIG_TOT(51,2),SSIG_B(51,2)
+      DATA PI /3.1415926/
+      DATA CMBARN /0.389385/
+      common/s_icr/icross_fit
+      ICROSS_FIT = 1
+      AL = LOG10(SQS)
+      J1 = (AL - 1.)*10. + 1
+C D.H.
+      J1 = MAX(J1,1)
+      J1 = MIN(J1,50)
+
+      T = (AL-1.)*10. - FLOAT(J1-1)
+      SIGINEL = SSIG(J1,1)*(1.-T) + SSIG(J1+1,1)*T
+      IF (ICROSS_FIT.EQ.1) THEN
+              CALL BLOCK(SQS,SIGT1,SIGT2,SLOP1,SLOP2,RHO1,RHO2,
+     +               SIGEL1,SIGEL2)
+              R = SIGEL1/SIGT1
+              RHO = RHO1
+              SIGT  = SIGINEL/(1.-R)
+              SIGEL = SIGINEL*R/(1.-R)
+              SLOPE = SIGT**2/(SIGEL * 16.*PI) * (1.+RHO1**2) /CMBARN
+      ELSE
+              SIGT = SSIG_TOT(J1,1)*(1.-T) + SSIG_TOT(J1+1,1)*T
+              SLOPE  =  SSIG_B(J1,1) *(1.-T) + SSIG_B(J1+1,1)  *T
+              RHO=0.0
+              SIGEL=SIGT-SIGINEL
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE SIB_START_EV (SQS,L,IA, NW,JDIF)
+C=======================================================================
+C. Code for the wounded nucleon distribution
+C=======================================================================
+C..Beginning of a SIBYLL  interaction
+C. INPUT : SQS = c.m.s. energy (GeV)
+C.         L = 1:proton, 2:charged pion
+C.         IA = mass of target nucleon
+C.
+C. OUTPUT: NW    = number of wounded nucleons
+C.         JDIF  = diffraction code
+C.                 (0 : non diffractive)
+C.                 (1 : forward diffraction)
+C.                 (2 : backward diffraction)
+C.                 (0 : double  diffraction)
+C. Author : P.Lipari  (may 1993)
+C------------------------------------------------
+      COMMON /S_CNCM0/ B, BMAX, NTRY, NA
+      CALL SIGMA_HP (L, SQS, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
+      IF (IA .GT. 1)  THEN
+         CALL INT_H_NUC (IA, SIGT, SLOPE, RHO)
+      ELSE
+         NA = 1
+      ENDIF
+C...diffraction
+      PF = FDIFFRACT(SQS,L)/SIGINEL
+      PB = BDIFFRACT(SQS,L)/SIGINEL
+      PD = DDIFFRACT(SQS,L)/SIGINEL
+      P0 = 1.-PF-PB-PD
+      P1 = P0 + PF
+      P2 = P1 + PB
+      NW = 0
+      JF = 0
+      JB = 0
+      JD = 0
+      DO K=1, NA
+         R = RNDM(0)
+         IF (R .LT. P0)  THEN
+            NW = NW + 1
+         ELSE IF (R .LT. P1)  THEN
+            JF = 1
+         ELSE IF (R .LT. P2)  THEN
+            JB = 1
+         ELSE
+            JD = 1
+         ENDIF
+      ENDDO
+      JDIF = 0
+      IF (NW .EQ. 0)  THEN
+         NW = 1
+         JDIF = 3
+         IF((JF.EQ.1) .AND. (JB.EQ.0) .AND. (JD.EQ.0)) JDIF=1
+         IF((JF.EQ.0) .AND. (JB.EQ.1) .AND. (JD.EQ.0)) JDIF=2
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE SIGMA_AIR (IB,SIG0,SIGEL,NINT,
+     +                            SIGMA,DSIGMA,SIGQE,DSIGQE)
+C==========================================================================
+C. Cross sections
+C==========================================================================
+C...Compute with a montecarlo method the "production"
+C.  and "quasi-elastic" cross section for
+C.  a nucleus-air  interaction
+C.
+C.  INPUT : IB            = mass of projectile nucleus
+C.          SIG0 (mbarn)  = inelastic pp cross section
+C.          NINT            = number  of interactions to generate
+C.  OUTPUT : SIGMA (mbarn) = "production" cross section
+C.           DSIGMA   "    = error
+C.           SIGQE    "    = "quasi-elastic" cross section
+C.           DSIGQE   "    = error
+C.           additional output is in the common block  /CPROBAB/
+C..........................................................................
+      PARAMETER (IAMAX=56)
+      PARAMETER (IAMAX2=3136)          ! IAMAX*IAMAX
+      COMMON  /CPROBAB/ PROBA(IAMAX), DPROBA(IAMAX),
+     +   PROBB(IAMAX), DPROBB(IAMAX), PROBI(IAMAX2), DPROBI(IAMAX2),
+     +   P1AEL(0:IAMAX),DP1AEL(0:IAMAX),P1BEL(0:IAMAX), DP1BEL(0:IAMAX),
+     +   P2AEL(0:IAMAX),DP2AEL(0:IAMAX),P2BEL(0:IAMAX), DP2BEL(0:IAMAX)
+      COMMON /CNUCMS/ B, BMAX, NTRY, NA, NB, NI, NAEL, NBEL
+     +         ,JJA(IAMAX), JJB(IAMAX), JJINT(IAMAX,IAMAX)
+     +         ,JJAEL(IAMAX), JJBEL(IAMAX)
+      DIMENSION  MMA(0:IAMAX), MMB(0:IAMAX), MMI(0:IAMAX2)
+      DIMENSION  M1AEL(0:IAMAX), M1BEL(0:IAMAX)
+      DIMENSION  M2AEL(0:IAMAX), M2BEL(0:IAMAX)
+      DATA WOX /0.346/
+      DATA PI /3.1415926/
+      R2 = 0.1 * SIG0/PI
+      BMAX = 15.                             ! fm
+      SIGMA0 = PI*BMAX*BMAX*10.              ! mbarn
+      IA = 16
+      DO J=1,IA
+         MMA(J) = 0
+         M1AEL(J) = 0
+         M2AEL(J) = 0
+      ENDDO
+      DO J=1,IB
+         MMB(J) = 0
+         M1BEL(J) = 0
+         M2BEL(J) = 0
+      ENDDO
+      DO J=1,IA*IB
+         MMI(J) = 0
+      ENDDO
+      NN = 0
+      M = 0
+      DO KK=1,NINT
+         IA = 14 + 2*INT((1.+WOX)*RNDM(0))
+         CALL INT_NUC (IA, IB, SIG0, SIGEL)
+         NN = NN + NTRY
+         MMI(NI) = MMI(NI) + 1
+         MMA(NA) = MMA(NA)+1
+         MMB(NB) = MMB(NB)+1
+         IF (NI .GT. 0)  THEN
+            M = M+1
+            M1AEL(NAEL) = M1AEL(NAEL)+1
+            M1BEL(NBEL) = M1BEL(NBEL)+1
+         ELSE
+            M2AEL(NAEL) = M2AEL(NAEL)+1
+            M2BEL(NBEL) = M2BEL(NBEL)+1
+         ENDIF
+      ENDDO
+      MQE = NINT - M
+      SIGMA  = SIGMA0 * FLOAT(M)/FLOAT(NN)
+      DSIGMA = SIGMA0 * SQRT(FLOAT(M))/FLOAT(NN)
+      SIGQE  = SIGMA0 * FLOAT(MQE)/FLOAT(NN)
+      DSIGQE = SIGMA0 * SQRT(FLOAT(MQE))/FLOAT(NN)
+      DO J=1,IA
+         PROBA(J) = FLOAT(MMA(J))/FLOAT(M)
+         DPROBA(J) = SQRT(FLOAT(MMA(J)))/FLOAT(M)
+      ENDDO
+      DO J=1,IB
+         PROBB(J) = FLOAT(MMB(J))/FLOAT(M)
+         DPROBB(J) = SQRT(FLOAT(MMB(J)))/FLOAT(M)
+      ENDDO
+      DO J=1,IA*IB
+         PROBI(J) = FLOAT(MMI(J))/FLOAT(M)
+         DPROBI(J) = SQRT(FLOAT(MMI(J)))/FLOAT(M)
+      ENDDO
+      DO J=0,IA
+         P1AEL(J) = FLOAT(M1AEL(J))/FLOAT(M)
+         DP1AEL(J) = SQRT(FLOAT(M1AEL(J)))/FLOAT(M)
+         P2AEL(J) = FLOAT(M2AEL(J))/FLOAT(MQE)
+         DP2AEL(J) = SQRT(FLOAT(M2AEL(J)))/FLOAT(MQE)
+      ENDDO
+      DO J=0,IB
+         P1BEL(J) = FLOAT(M1BEL(J))/FLOAT(M)
+         DP1BEL(J) = SQRT(FLOAT(M1BEL(J)))/FLOAT(M)
+         P2BEL(J) = FLOAT(M2BEL(J))/FLOAT(MQE)
+         DP2BEL(J) = SQRT(FLOAT(M2BEL(J)))/FLOAT(MQE)
+      ENDDO
+      RETURN
+      END
+      SUBROUTINE SIGMA_HP (L, SQS, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
+C--------------------------------------------------------------------------
+C. Hadron-proton cross sections
+C--------------------------------------------------------------------------
+      IF(L .EQ. 2) THEN
+         CALL sib_SIGMA_PIP(SQS,SIGT,SIGEL,SIGINEL,SLOPE,RHO)
+      ELSE
+         CALL sib_SIGMA_PP(SQS,SIGT,SIGEL,SIGINEL,SLOPE,RHO)
+      ENDIF
+      RETURN
+      END
+
+      SUBROUTINE SIGMA_INI
+C...Initialize the cross section and interaction lengths  on air
+        COMMON /CSAIR/ NSQS, ASQSMIN, ASQSMAX, DASQS,
+     +           SSIG0(41,2),SSIGA(41,2),ALINT(41,2)
+      DATA AVOG /6.0221367E-04/
+      CALL BLOCK_INI
+      ATARGET = 14.514
+C...Loop on c.m. energy
+      NSQS = 41
+      SQSMIN = 10.
+      SQSMAX = 1.E+05
+      ASQSMIN = LOG10(SQSMIN)
+      ASQSMAX = LOG10(SQSMAX)
+      DASQS = (ASQSMAX-ASQSMIN)/FLOAT(NSQS-1)
+      DO J=1,NSQS
+         ASQS = ASQSMIN + DASQS*FLOAT(J-1)
+         SQS = 10.**ASQS
+         E0 = SQS*SQS/(2.*0.938) * 1.E-03
+         CALL SIGMA_PP (E0, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
+         CALL SIG_H_AIR (SIGT, SLOPE, RHO, SSIGT, SSIGEL, SSIGQE)
+         SSIGA(J,1) = SSIGT-SSIGQE
+         SSIG0(J,1) = SIGINEL
+         ALINT(J,1) = 1./(AVOG*SSIGA(J,1)/ATARGET)
+         CALL SIGMA_PIP (E0, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
+         CALL  SIG_H_AIR (SIGT, SLOPE, RHO, SSIGT, SSIGEL, SSIGQE)
+         SSIGA(J,2) = SSIGT-SSIGQE
+         SSIG0(J,2) = SIGINEL
+         ALINT(J,2) = 1./(AVOG*SSIGA(J,2)/ATARGET)
+      ENDDO
+      RETURN
+      END
+
+      SUBROUTINE SIGMA_MC (IA,IB,SIG0,SIGEL,NINT,
+     +                            SIGMA,DSIGMA,SIGQE,DSIGQE)
+C...Compute with a montecarlo method the "production"
+C.  and "quasi-elastic" cross section for
+C.  a nucleus-nucleus interaction
+C.
+C.  INPUT : IA            = mass of target nucleus
+C.          IB            = mass of projectile nucleus
+C.          SIG0 (mbarn)  = inelastic pp cross section
+C.          NINT            = number  of interactions to generate
+C.  OUTPUT : SIGMA (mbarn) = "production" cross section
+C.           DSIGMA   "    = error
+C.           SIGQE    "    = "quasi-elastic" cross section
+C.           DSIGQE   "    = error
+C.           additional output is in the common block  /CPROBAB/
+C.           Prob(n_A), Prob(n_B), Prob(n_int)
+C..........................................................................
+      PARAMETER (IAMAX=56)
+      PARAMETER (IAMAX2=3136)          ! IAMAX*IAMAX
+      COMMON  /CPROBAB/ PROBA(IAMAX), DPROBA(IAMAX),
+     +   PROBB(IAMAX), DPROBB(IAMAX), PROBI(IAMAX2), DPROBI(IAMAX2),
+     +   P1AEL(0:IAMAX),DP1AEL(0:IAMAX),P1BEL(0:IAMAX), DP1BEL(0:IAMAX),
+     +   P2AEL(0:IAMAX),DP2AEL(0:IAMAX),P2BEL(0:IAMAX), DP2BEL(0:IAMAX)
+      COMMON /CNUCMS/ B, BMAX, NTRY, NA, NB, NI, NAEL, NBEL
+     +         ,JJA(IAMAX), JJB(IAMAX), JJINT(IAMAX,IAMAX)
+     +         ,JJAEL(IAMAX), JJBEL(IAMAX)
+      DIMENSION  MMA(0:IAMAX), MMB(0:IAMAX), MMI(0:IAMAX2)
+      DIMENSION  M1AEL(0:IAMAX), M1BEL(0:IAMAX)
+      DIMENSION  M2AEL(0:IAMAX), M2BEL(0:IAMAX)
+      DATA PI /3.1415926/
+      R2 = 0.1 * SIG0/PI
+      BMAX = 15.                             ! fm
+      SIGMA0 = PI*BMAX*BMAX*10.              ! mbarn
+      DO J=1,IA
+         MMA(J) = 0
+         M1AEL(J) = 0
+         M2AEL(J) = 0
+      ENDDO
+      DO J=1,IB
+         MMB(J) = 0
+         M1BEL(J) = 0
+         M2BEL(J) = 0
+      ENDDO
+      DO J=1,IA*IB
+         MMI(J) = 0
+      ENDDO
+      NN = 0
+      M = 0
+      DO KK=1,NINT
+         CALL INT_NUC (IA, IB, SIG0, SIGEL)
+         NN = NN + NTRY
+         MMI(NI) = MMI(NI) + 1
+         MMA(NA) = MMA(NA)+1
+         MMB(NB) = MMB(NB)+1
+         IF (NI .GT. 0)  THEN
+            M = M+1
+            M1AEL(NAEL) = M1AEL(NAEL)+1
+            M1BEL(NBEL) = M1BEL(NBEL)+1
+         ELSE
+            M2AEL(NAEL) = M2AEL(NAEL)+1
+            M2BEL(NBEL) = M2BEL(NBEL)+1
+         ENDIF
+      ENDDO
+      MQE = NINT - M
+      SIGMA  = SIGMA0 * FLOAT(M)/FLOAT(NN)
+      DSIGMA = SIGMA0 * SQRT(FLOAT(M))/FLOAT(NN)
+      SIGQE  = SIGMA0 * FLOAT(MQE)/FLOAT(NN)
+      DSIGQE = SIGMA0 * SQRT(FLOAT(MQE))/FLOAT(NN)
+      DO J=1,IA
+         PROBA(J) = FLOAT(MMA(J))/FLOAT(M)
+         DPROBA(J) = SQRT(FLOAT(MMA(J)))/FLOAT(M)
+      ENDDO
+      DO J=1,IB
+         PROBB(J) = FLOAT(MMB(J))/FLOAT(M)
+         DPROBB(J) = SQRT(FLOAT(MMB(J)))/FLOAT(M)
+      ENDDO
+      DO J=1,IA*IB
+         PROBI(J) = FLOAT(MMI(J))/FLOAT(M)
+         DPROBI(J) = SQRT(FLOAT(MMI(J)))/FLOAT(M)
+      ENDDO
+      DO J=0,IA
+         P1AEL(J) = FLOAT(M1AEL(J))/FLOAT(M)
+         DP1AEL(J) = SQRT(FLOAT(M1AEL(J)))/FLOAT(M)
+         P2AEL(J) = FLOAT(M2AEL(J))/FLOAT(MQE)
+         DP2AEL(J) = SQRT(FLOAT(M2AEL(J)))/FLOAT(MQE)
+      ENDDO
+      DO J=0,IB
+         P1BEL(J) = FLOAT(M1BEL(J))/FLOAT(M)
+         DP1BEL(J) = SQRT(FLOAT(M1BEL(J)))/FLOAT(M)
+         P2BEL(J) = FLOAT(M2BEL(J))/FLOAT(MQE)
+         DP2BEL(J) = SQRT(FLOAT(M2BEL(J)))/FLOAT(MQE)
+      ENDDO
+      RETURN
+      END
+
+      SUBROUTINE SIGMA_PIP (E0, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
+C=============================================================
+C.  Cross sections
+C=============================================================
+C...pp cross sections
+C. INPUT: E0 = Laboratory Energy  (TeV)
+C.
+C. OUTPUT: SIGT = total cross section
+C.         SIGEL = elastic cross section
+C.         SIGINEL = inelastic cross section
+C.         SLOPE = slope of elastic scattering (GeV**-2)
+C.         RHO = Imaginary/Real part of forward elastic scattering amplitude
+C...........................................................................
+      DIMENSION SSIG0(41)
+      DATA PI /3.1415926/
+      DATA CMBARN /0.389385/
+C...pi-p inelastic cross sections (mbarn)
+      DATA (SSIG0(J),J=1,41) /
+     +     20.28,    20.36,    20.48,    20.66,    20.91,    21.22,
+     +     21.62,    22.09,    22.64,    23.27,    23.99,    24.79,
+     +     25.66,    26.62,    27.65,    28.76,    29.94,    31.21,
+     +     32.55,    33.97,    35.47,    37.04,    38.70,    40.46,
+     +     42.29,    44.23,    46.26,    48.40,    50.64,    53.01,
+     +     55.48,    58.12,    60.87,    63.75,    66.78,    69.98,
+     +     73.38,    76.91,    80.62,    84.56,    88.68 /
+      SQS = SQRT(2000.*0.938*E0)
+      AL = LOG10(SQS)
+      J1 = (AL - 1.)*10. + 1
+C D.H.
+      J1 = MAX(J1,1)
+      J1 = MIN(J1,40)
+
+      T = (AL-1.)*10. - FLOAT(J1-1)
+      SIGINEL = SSIG0(J1)*(1.-T) + SSIG0(J1+1)*T
+      CALL BLOCK(SQS,SIGT1,SIGT2,SLOP1,SLOP2,RHO1,RHO2,SIGEL1,SIGEL2)
+      R = SIGEL1/SIGT1
+      RHO = RHO1
+      SIGT  = SIGINEL/(1.-R)
+      SIGEL = SIGINEL*R/(1.-R)
+      SLOPE = SIGT**2/(SIGEL * 16.*PI) * (1.+RHO1**2) /CMBARN
+      RETURN
+      END
+
+      SUBROUTINE SIGMA_PP (E0, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
+C...pp cross sections
+C. INPUT: E0 = Laboratory Energy  (TeV)
+C.
+C. OUTPUT: SIGT = total cross section
+C.         SIGEL = elastic cross section
+C.         SIGINEL = inelastic cross section
+C.         SLOPE = slope of elastic scattering (GeV**-2)
+C.         RHO = Imaginary/Real part of forward elastic scattering amplitude
+C...........................................................................
+      DIMENSION SSIG0(41)
+      DATA PI /3.1415926/
+      DATA CMBARN /0.389385/
+C...p-p inelastic cross sections (mbarn)
+      DATA (SSIG0(J),J=1,41) /
+     +     32.08,    32.15,    32.26,    32.45,    32.73,    33.12,
+     +     33.63,    34.28,    35.08,    36.01,    37.09,    38.31,
+     +     39.67,    41.15,    42.75,    44.47,    46.29,    48.22,
+     +     50.24,    52.35,    54.55,    56.81,    59.15,    61.57,
+     +     64.04,    66.57,    69.17,    71.81,    74.51,    77.27,
+     +     80.06,    82.93,    85.82,    88.74,    91.71,    94.76,
+     +     97.86,   100.97,   104.12,   107.31,   110.54 /
+      SQS = SQRT(2000.*0.938*E0)
+      AL = LOG10(SQS)
+      J1 = (AL - 1.)*10. + 1
+C D.H.
+      J1 = MAX(J1,1)
+      J1 = MIN(J1,40)
+
+      T = (AL-1.)*10. - FLOAT(J1-1)
+      SIGINEL = SSIG0(J1)*(1.-T) + SSIG0(J1+1)*T
+      CALL BLOCK(SQS,SIGT1,SIGT2,SLOP1,SLOP2,RHO1,RHO2,SIGEL1,SIGEL2)
+      R = SIGEL1/SIGT1
+      RHO = RHO1
+      SIGT  = SIGINEL/(1.-R)
+      SIGEL = SIGINEL*R/(1.-R)
+      SLOPE = SIGT**2/(SIGEL * 16.*PI) * (1.+RHO1**2) /CMBARN
+      RETURN
+      END
+
+      SUBROUTINE SIGNUC_INI (IA,E0)
+C=============================================================
+C.  Nucleus-nucleus cross sections
+C=============================================================
+C...This subroutine receives in INPUT E0 (TeV)
+C.  energy per nucleon and computes the cross sections
+C.  and interactions lengths for  all nuclei
+C.  with A  between 2 and IA
+C.  The output is contained in common block /CLENNN/
+C........................................................
+      COMMON /CLENNN/ SSIGNUC(60), ALNUC(60)
+      DIMENSION SIGMA(5,56), SIGQE(5,56)
+      DIMENSION AA(5)
+      DATA NE /5/, AMIN /1./, DA /1./
+      DATA AA /1.,2.,3.,4.,5./
+      DATA AVOG /6.0221367E-04/
+      DATA ATARGET /14.514/               ! effective masss of air
+C...Data on `inelastic-production' nucleus-air cross section
+      DATA (SIGMA(J, 2),J=1,5) / 396., 427., 497., 603., 702./
+      DATA (SIGMA(J, 3),J=1,5) / 464., 490., 570., 680., 794./
+      DATA (SIGMA(J, 4),J=1,5) / 497., 524., 600., 711., 813./
+      DATA (SIGMA(J, 5),J=1,5) / 593., 629., 708., 826., 934./
+      DATA (SIGMA(J, 6),J=1,5) / 701., 739., 839., 954.,1066./
+      DATA (SIGMA(J, 7),J=1,5) / 708., 755., 845., 985.,1102./
+      DATA (SIGMA(J, 8),J=1,5) / 777., 790., 909.,1015.,1130./
+      DATA (SIGMA(J, 9),J=1,5) / 808., 845., 952.,1051.,1186./
+      DATA (SIGMA(J,10),J=1,5) / 809., 862., 958.,1077.,1193./
+      DATA (SIGMA(J,11),J=1,5) / 821., 870., 955.,1085.,1191./
+      DATA (SIGMA(J,12),J=1,5) / 861., 897., 985.,1132.,1251./
+      DATA (SIGMA(J,13),J=1,5) / 875., 909., 989.,1129.,1272./
+      DATA (SIGMA(J,14),J=1,5) / 919., 952.,1043.,1202.,1315./
+      DATA (SIGMA(J,15),J=1,5) / 954., 969.,1085.,1217.,1370./
+      DATA (SIGMA(J,16),J=1,5) /1014.,1041.,1148.,1308.,1430./
+      DATA (SIGMA(J,17),J=1,5) /1005.,1028.,1139.,1277.,1434./
+      DATA (SIGMA(J,18),J=1,5) /1065.,1088.,1178.,1324.,1494./
+      DATA (SIGMA(J,19),J=1,5) /1113.,1122.,1238.,1397.,1532./
+      DATA (SIGMA(J,20),J=1,5) /1143.,1169.,1321.,1471.,1615./
+      DATA (SIGMA(J,21),J=1,5) /1167.,1194.,1315.,1488.,1650./
+      DATA (SIGMA(J,22),J=1,5) /1183.,1195.,1318.,1454.,1638./
+      DATA (SIGMA(J,23),J=1,5) /1206.,1264.,1394.,1524.,1653./
+      DATA (SIGMA(J,24),J=1,5) /1244.,1297.,1400.,1557.,1672./
+      DATA (SIGMA(J,25),J=1,5) /1272.,1298.,1449.,1600.,1712./
+      DATA (SIGMA(J,26),J=1,5) /1269.,1332.,1459.,1603.,1743./
+      DATA (SIGMA(J,27),J=1,5) /1262.,1312.,1443.,1598.,1723./
+      DATA (SIGMA(J,28),J=1,5) /1309.,1333.,1469.,1619.,1763./
+      DATA (SIGMA(J,29),J=1,5) /1433.,1505.,1621.,1802.,1935./
+      DATA (SIGMA(J,30),J=1,5) /1346.,1391.,1536.,1678.,1844./
+      DATA (SIGMA(J,31),J=1,5) /1376.,1432.,1556.,1696.,1878./
+      DATA (SIGMA(J,32),J=1,5) /1392.,1418.,1582.,1713.,1857./
+      DATA (SIGMA(J,33),J=1,5) /1412.,1438.,1602.,1742.,1944./
+      DATA (SIGMA(J,34),J=1,5) /1414.,1471.,1633.,1774.,1928./
+      DATA (SIGMA(J,35),J=1,5) /1444.,1498.,1634.,1773.,1944./
+      DATA (SIGMA(J,36),J=1,5) /1455.,1507.,1638.,1815.,1943./
+      DATA (SIGMA(J,37),J=1,5) /1458.,1526.,1660.,1781.,1992./
+      DATA (SIGMA(J,38),J=1,5) /1520.,1515.,1671.,1838.,2052./
+      DATA (SIGMA(J,39),J=1,5) /1492.,1545.,1707.,1863.,2049./
+      DATA (SIGMA(J,40),J=1,5) /1511.,1577.,1719.,1878.,2032./
+      DATA (SIGMA(J,41),J=1,5) /1541.,1581.,1729.,1878.,2072./
+      DATA (SIGMA(J,42),J=1,5) /1540.,1591.,1718.,1919.,2075./
+      DATA (SIGMA(J,43),J=1,5) /1590.,1610.,1783.,1925.,2077./
+      DATA (SIGMA(J,44),J=1,5) /1582.,1614.,1785.,1961.,2106./
+      DATA (SIGMA(J,45),J=1,5) /1580.,1629.,1774.,1939.,2115./
+      DATA (SIGMA(J,46),J=1,5) /1628.,1673.,1812.,1981.,2089./
+      DATA (SIGMA(J,47),J=1,5) /1594.,1672.,1820.,1999.,2163./
+      DATA (SIGMA(J,48),J=1,5) /1639.,1695.,1824.,1986.,2150./
+      DATA (SIGMA(J,49),J=1,5) /1647.,1728.,1856.,2008.,2188./
+      DATA (SIGMA(J,50),J=1,5) /1637.,1714.,1902.,2040.,2210./
+      DATA (SIGMA(J,51),J=1,5) /1682.,1741.,1918.,2042.,2258./
+      DATA (SIGMA(J,52),J=1,5) /1673.,1746.,1933.,2067.,2238./
+      DATA (SIGMA(J,53),J=1,5) /1705.,1763.,1880.,2102.,2249./
+      DATA (SIGMA(J,54),J=1,5) /1699.,1748.,1917.,2142.,2265./
+      DATA (SIGMA(J,55),J=1,5) /1751.,1764.,1934.,2129.,2289./
+      DATA (SIGMA(J,56),J=1,5) /1753.,1828.,1973.,2187.,2335./
+C...Data on `quasi-elastic' nucleus-air cross section
+      DATA (SIGQE(J, 2),J=1,5) /  41.,  42.,  75., 138., 236./
+      DATA (SIGQE(J, 3),J=1,5) /  41.,  41.,  79., 138., 244./
+      DATA (SIGQE(J, 4),J=1,5) /  39.,  41.,  78., 145., 246./
+      DATA (SIGQE(J, 5),J=1,5) /  44.,  47.,  83., 152., 256./
+      DATA (SIGQE(J, 6),J=1,5) /  48.,  53.,  96., 169., 288./
+      DATA (SIGQE(J, 7),J=1,5) /  53.,  52.,  95., 171., 282./
+      DATA (SIGQE(J, 8),J=1,5) /  53.,  52.,  95., 179., 295./
+      DATA (SIGQE(J, 9),J=1,5) /  51.,  49.,  94., 180., 301./
+      DATA (SIGQE(J,10),J=1,5) /  52.,  52.,  93., 183., 308./
+      DATA (SIGQE(J,11),J=1,5) /  52.,  51.,  91., 179., 301./
+      DATA (SIGQE(J,12),J=1,5) /  53.,  53.,  92., 179., 284./
+      DATA (SIGQE(J,13),J=1,5) /  55.,  55.,  97., 184., 308./
+      DATA (SIGQE(J,14),J=1,5) /  54.,  55., 102., 182., 310./
+      DATA (SIGQE(J,15),J=1,5) /  57.,  53., 102., 193., 305./
+      DATA (SIGQE(J,16),J=1,5) /  56.,  53., 105., 195., 331./
+      DATA (SIGQE(J,17),J=1,5) /  57.,  54., 101., 192., 327./
+      DATA (SIGQE(J,18),J=1,5) /  53.,  54., 107., 204., 328./
+      DATA (SIGQE(J,19),J=1,5) /  59.,  63., 105., 209., 345./
+      DATA (SIGQE(J,20),J=1,5) /  59.,  64., 109., 195., 343./
+      DATA (SIGQE(J,21),J=1,5) /  55.,  64., 114., 212., 348./
+      DATA (SIGQE(J,22),J=1,5) /  60.,  63., 117., 206., 340./
+      DATA (SIGQE(J,23),J=1,5) /  63.,  68., 119., 202., 345./
+      DATA (SIGQE(J,24),J=1,5) /  59.,  61., 114., 213., 354./
+      DATA (SIGQE(J,25),J=1,5) /  60.,  65., 121., 216., 357./
+      DATA (SIGQE(J,26),J=1,5) /  61.,  66., 124., 232., 342./
+      DATA (SIGQE(J,27),J=1,5) /  63.,  61., 119., 222., 365./
+      DATA (SIGQE(J,28),J=1,5) /  63.,  68., 121., 218., 354./
+      DATA (SIGQE(J,29),J=1,5) /  67.,  77., 119., 239., 371./
+      DATA (SIGQE(J,30),J=1,5) /  63.,  63., 120., 230., 379./
+      DATA (SIGQE(J,31),J=1,5) /  67.,  66., 124., 223., 371./
+      DATA (SIGQE(J,32),J=1,5) /  62.,  68., 125., 230., 357./
+      DATA (SIGQE(J,33),J=1,5) /  65.,  70., 128., 227., 377./
+      DATA (SIGQE(J,34),J=1,5) /  63.,  70., 120., 222., 359./
+      DATA (SIGQE(J,35),J=1,5) /  66.,  71., 124., 233., 358./
+      DATA (SIGQE(J,36),J=1,5) /  70.,  70., 118., 228., 376./
+      DATA (SIGQE(J,37),J=1,5) /  69.,  73., 131., 209., 381./
+      DATA (SIGQE(J,38),J=1,5) /  68.,  73., 128., 221., 369./
+      DATA (SIGQE(J,39),J=1,5) /  68.,  72., 129., 224., 377./
+      DATA (SIGQE(J,40),J=1,5) /  72.,  73., 123., 232., 384./
+      DATA (SIGQE(J,41),J=1,5) /  67.,  73., 131., 240., 384./
+      DATA (SIGQE(J,42),J=1,5) /  71.,  72., 131., 236., 392./
+      DATA (SIGQE(J,43),J=1,5) /  69.,  76., 137., 249., 395./
+      DATA (SIGQE(J,44),J=1,5) /  71.,  73., 136., 235., 385./
+      DATA (SIGQE(J,45),J=1,5) /  71.,  67., 127., 236., 401./
+      DATA (SIGQE(J,46),J=1,5) /  76.,  68., 133., 241., 399./
+      DATA (SIGQE(J,47),J=1,5) /  73.,  69., 133., 227., 382./
+      DATA (SIGQE(J,48),J=1,5) /  67.,  81., 131., 247., 402./
+      DATA (SIGQE(J,49),J=1,5) /  69.,  78., 133., 247., 400./
+      DATA (SIGQE(J,50),J=1,5) /  73.,  76., 131., 239., 401./
+      DATA (SIGQE(J,51),J=1,5) /  73.,  75., 131., 246., 394./
+      DATA (SIGQE(J,52),J=1,5) /  72.,  77., 135., 242., 408./
+      DATA (SIGQE(J,53),J=1,5) /  75.,  76., 136., 236., 394./
+      DATA (SIGQE(J,54),J=1,5) /  76.,  78., 137., 228., 398./
+      DATA (SIGQE(J,55),J=1,5) /  75.,  82., 133., 238., 390./
+      DATA (SIGQE(J,56),J=1,5) /  76.,  71., 136., 255., 408./
+      ASQS = 0.5*LOG10(1.876E+03*E0)
+      JE = MIN(INT((ASQS-AMIN)/DA)+1,NE-2)
+      DO JA=2,IA
+         ABEAM = FLOAT(JA)
+         S1 = QUAD_INT(ASQS, AA(JE),AA(JE+1),AA(JE+2),
+     +                   SIGMA(JE,JA),SIGMA(JE+1,JA),SIGMA(JE+2,JA))
+         S2 = QUAD_INT(ASQS, AA(JE),AA(JE+1),AA(JE+2),
+     +                   SIGQE(JE,JA),SIGQE(JE+1,JA),SIGQE(JE+2,JA))
+         SSIGNUC(JA) = S1 + S2
+         ALNUC(JA) = ATARGET/(AVOG*SSIGNUC(JA))
+      ENDDO
+      ALNUC(1) = FPNI(E0, 13)
+      SSIGNUC(1) = ATARGET/(AVOG*ALNUC(1))
+      RETURN
+      END
+      SUBROUTINE SIG_AIR_INI
+C==========================================================================
+C. Cross sections
+C==========================================================================
+C...Initialize the cross section and interaction lengths  on air
+      COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
+     +    SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
+      COMMON /S_CCSIG2/ SSIG_TOT(51,2),SSIG_B(51,2)
+      COMMON /S_SIGEL/ielastic,FIN(51,2),FEL(51,2),FQE(0:6,51,2)
+      DATA AVOG /6.0221367E-04/
+      parameter (pi=3.1415927)
+      ATARGET = 14.514
+C...Loop on c.m. energy
+      DO J=1,NSQS
+         ASQS = ASQSMIN + DASQS*FLOAT(J-1)
+         IF (J .EQ. NSQS) ASQS = ASQS-1.E-04
+         SQS = 10.**ASQS
+         CALL sib_SIGMA_PP (SQS, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
+         CALL SIG_H_AIR (SIGT, SLOPE, RHO, SSIGT, SSIGEL, SSIGQE)
+         SSIGN(J,1) = SSIGT-SSIGQE
+       if (ielastic.eq.1)  then
+            ALINT(J,1) = 1./(AVOG*SSIGT/ATARGET)
+        else
+             ALINT(J,1) = 1./(AVOG*SSIGn(j,1)/ATARGET)
+       endif
+       ssig_tot(j,1) = sigt
+       ssig_B(j,1) = slope
+       FIN(J,1) = ssign(j,1)/SSIGT
+       FEL(J,1) = SSIGEL/SSIGT
+       FQE(0,J,1) = (SSIGQE-SSIGEL)/SSIGT
+       eps=ssigt/slope/16./pi*(1+rho**2)
+       FQE(1,J,1) = eps
+       do nqe=2,6
+          FQE(nqe,J,1) = eps**nqe/nqe + fqe(nqe-1,j,1)
+       enddo
+       do nqe=1,6
+          FQE(nqe,J,1) = fqe(nqe,j,1)/fqe(6,j,1)
+       enddo
+
+         CALL sib_SIGMA_PIP (SQS, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
+         CALL  SIG_H_AIR (SIGT, SLOPE, RHO, SSIGT, SSIGEL, SSIGQE)
+         SSIGN(J,2) = SSIGT-SSIGQE
+       if (ielastic.eq.1)  then
+            ALINT(J,2) = 1./(AVOG*SSIGT/ATARGET)
+        else
+             ALINT(J,2) = 1./(AVOG*SSIGn(j,2)/ATARGET)
+       endif
+       ssig_tot(J,2) = sigt
+       ssig_B(J,2) = slope
+
+       FIN(j,2) = ssign(J,2)/SSIGT
+       FEL(j,2) = ssigEL/SSIGT
+       FQE(0,J,2) = SSIGQE/SSIGT
+       eps=ssigt/slope/16./pi*(1+rho**2)
+       FQE(1,J,2) = eps
+       do nqe=2,6
+          FQE(nqe,J,2) = eps**nqe/nqe + fqe(nqe-1,j,2)
+       enddo
+       do nqe=1,6
+          FQE(nqe,J,2) = fqe(nqe,j,2)/fqe(6,j,2)
+       enddo
+
+      ENDDO
+      RETURN
+      END
+      BLOCK DATA  SIG_DAT
+C...Precalculated table of cross sections
+      COMMON /S_CSIGINP/ QQ2MIN, SSQCD (51,2), SSQCD2 (51,2),
+     @                       SSIG0(2), factork(2),isfchoice
+C...Structure functions
+      COMMON /S_CSTR/ JSTR, JSTRPI
+C...EHLQ set 1 for proton Duke-Owens set 1 for pion
+      DATA JSTR /1/, JSTRPI /1/
+C...Q2min (GeV**2) for minijets
+      DATA QQ2MIN /5.0/
+C...Soft cross section in the eikonal factor
+      DATA SSIG0 /123., 73./
+      DATA factork/1.7,2.2/
+      data isfchoice/1/
+C...Sigma_qcd (GeV**-2) for p-p computed with EHLQ set 1 Q2min = 5. GeV**2
+c... with scaling violations. THis is the default choice in SIBYLL.
+c... A K-factor of 1.7 should be used to fit. the Tevatron data.
+      DATA (SSQCD(K,1),K=1,51)  /
+     @  1.1983993E-02, 4.4127252E-02, 0.1238399, 0.2868755, 0.5772045,
+     @   1.045294,    1.744142,    2.731708,    4.065390,    5.807725,
+     @   8.020122,    10.77380,    14.13659,    18.20087,    23.08322,
+     @   28.82062,    35.58009,    43.48313,    52.64074,    63.20496,
+     @   75.42126,    89.40395,    105.5904,    123.8777,    144.6305,
+     @   168.2220,    195.0619,    225.1132,    259.1954,    297.7083,
+     @   340.8559,    389.3647,    443.2799,    503.9778,    571.3537,
+     @   647.0132,    731.9388,    825.9186,    932.3583,    1049.230,
+     @   1178.351,    1320.911,    1479.186,    1656.306,    1851.798,
+     @   2071.153,    2311.224,    2576.411,    2869.631,    3194.693,
+     @   3556.603/
+C...Sigma_qcd (GeV**-2) for pi-p computed with EHLQ set 1  for p
+C                                Owens set 1 for pi Q2min = 5. GeV**2
+c... with scaling violations. THis is the default choice in SIBYLL.
+c... A K-factor of 1.7 should be used to fit. the Tevatron data.
+      DATA (SSQCD(K,2),K=1,51)  /
+     @ 2.6713109E-02, 7.6703623E-02, 0.1787110, 0.3587718, 0.6452169,
+     @ 1.067511,   1.656302,   2.442088,   3.459795,   4.740401,
+     @ 6.328330,   8.265375,   10.59707,   13.38726,   16.70245,
+     @ 20.60534,   25.20829,   30.61100,   36.92186,   44.27321,
+     @ 52.88524,   62.90113,   74.63335,   88.24413,   104.0870,
+     @ 122.5886,   144.2660,   169.4464,   199.1269,   233.9357,
+     @ 274.6917,   322.6675,   378.8712,   445.5984,   524.2751,
+     @ 617.7631,   729.1132,   860.6794,   1019.997,   1208.843,
+     @ 1433.871,   1703.056,   2026.311,   2417.850,   2889.604,
+     @ 3463.152,   4152.619,   4989.879,   6001.615,   7231.195,
+     @ 8747.169/
+C...Sigma_qcd (GeV**-2) for pi-p computed with EHLQ set 1  for p
+C                                Owens set 1 for pi Q2min = 5. GeV**2
+c... WITHOUT scaling violations. THis is an alternate choice in SIBYLL.
+c... A K-factor of 2.2 should be used to fit. the Tevatron data.
+      DATA (SSQCD2(K,1),K=1,51)  /
+     @ 1.4302040E-02, 5.3822853E-02,  0.1535475, 0.3596057, 0.7277440,
+     @ 1.318651,  2.191311,  3.401969,  4.996748,  7.020068,
+     @ 9.494884,  12.44863,  15.89774,  19.85705,  24.34084,
+     @ 29.32943,  34.83667,  40.86320,  47.40503,  54.46183,
+     @ 62.03970,  70.14349,  78.79037,  87.91505,  97.56121,
+     @ 107.7228,  118.4118,  129.5977,  141.3069,  153.5433,
+     @ 166.2887,  179.5711,  193.3551,  207.6443,  222.4576,
+     @ 237.7850,  253.7659,  270.1528,  287.0669,  304.5056,
+     @ 322.4221,  340.8359,  359.7802,  379.2549,  399.2404,
+     @ 419.7521,  440.7868,  462.3503,  484.4333,  507.0548,
+     @ 530.2106/
+      DATA (SSQCD2(K,2),K=1,51)  /
+     @  3.2613490E-02, 9.5264249E-02, 0.2243170, 0.4523652, 0.8127463,
+     @  1.336795,  2.052137,  2.981797,  4.145481,  5.557004,
+     @  7.229480,  9.172240,  11.39208,  13.89822,  16.69263,
+     @  19.78566,  23.18154,  26.88788,  30.90883,  35.25125,
+     @  39.92667,  44.94619,  50.30739,  56.02631,  62.11592,
+     @  68.57966,  75.43336,  82.67727,  90.33365,  98.41272,
+     @  106.9134,  115.8630,  125.2634,  135.1346,  145.4902,
+     @  156.3337,  167.7068,  179.5899,  192.0124,  204.9890,
+     @  218.5388,  232.6741,  247.4235,  262.8056,  278.8209,
+     @  295.4990,  312.8557,  330.9224,  349.6995,  369.2270,
+     @  389.5247/
+      END
+
+      SUBROUTINE SIG_H_AIR (SSIG, SLOPE, ALPHA,  SIGT, SIGEL, SIGQE)
+C...Subroutine to compute hadron-air cross sections
+C.  according to:
+C.  R.J. Glauber and G.Matthiae  Nucl.Phys. B21, 135, (1970)
+C.
+C.  Air is a linear combination of Nitrogen and oxygen
+C.
+C.  INPUT :  SSIG  (mbarn) total pp cross section
+C.           SLOPE (GeV**-2)  elastic scattering slope for pp
+C.           ALPHA    real/imaginary part of the forward pp elastic
+C.                                               scattering amplitude
+C.  OUTPUT : SIGT  = Total cross section
+C.           SIGEL = Elastic cross section
+C.           SIGQEL  = Elastic + Quasi elastic cross section
+C......................................................................
+      DATA  FOX /0.257/
+      CALL GLAUBER(14,SSIG,SLOPE,ALPHA,SIG1,SIGEL1,SIGQE1)
+      CALL GLAUBER(16,SSIG,SLOPE,ALPHA,SIG2,SIGEL2,SIGQE2)
+      SIGT  = (1.-FOX)*SIG1   + FOX*SIG2
+      SIGEL = (1.-FOX)*SIGEL1 + FOX*SIGEL2
+      SIGQE = (1.-FOX)*SIGQE1 + FOX*SIGQE2
+      RETURN
+      END
+
+      SUBROUTINE SIG_JET (SIG_QCD, SIG_SOFT, JINT, SIG_inel, PJET,
+     +                    SIG_TOT,B_EL)
+C...This subroutine  receives in INPUT:
+C.       sig_qcd (GeV-2)
+C.       sig_soft (GeV-2)
+C.       JINT (1 = pp interaction)    (2 pi-p interaction)
+C.
+C.  and returns as output:
+C.       SIG_inel
+C.       and PJET (1:20)   probability of n-jets
+C.
+C.  USES THE OLD GEOMETRY OF:
+C   L.Durand and H.Pi,
+c
+C....................................................................
+      COMMON /S_CFACT/ FACT (0:20), CO_BIN(0:20,0:20)
+      COMMON /S_CHDCNV/NB,DB,ABPP(200),ABPIP(200),ABPPH(200),
+     +        ABPIPH(200)
+c      COMMON /S_CHDCNV/NB,DB,ABPP(200),ABPIP(200)
+      DIMENSION PJET (0:20)
+      DATA PI /3.1415926/
+
+      DO J=1,20
+          PJET(J) = 0.
+      ENDDO
+      SUM = 0.
+      SUM_tot = 0.
+      SUM_B = 0.
+
+      DO JB=1,NB
+         B = DB*FLOAT(JB-1)
+         IF (JINT .EQ. 1)  THEN
+            ABSOFT = ABPP   (JB)
+            ABHARD = ABPPh (JB)
+         ENDIF
+         IF (JINT .EQ. 2)  THEN
+            ABSOFT = ABPIP   (JB)
+            ABHARD = ABPIPh (JB)
+         ENDIF
+         F1 = EXP(-ABHARD*SIG_QCD)
+         F2 = EXP(-ABSOFT*SIG_SOFT)
+         F = B*(1.-F1*F2)
+         SUM = SUM+F
+       f4= sqrt(f1*f2)
+       F_tot=B*(1-f4)
+       sum_tot=sum_tot+f_tot
+       F_B=B**3*(1-f4)
+       sum_B=sum_b+f_b
+         PJET(0) = PJET(0) + (1.-F2)*F1*B
+         G = SIG_QCD*ABHARD
+         F3 = G*F1*B
+         PJET(1) = PJET(1) + F3
+         DO J=2,20
+            F3 = F3*G
+            PJET (J) = PJET(J) + F3
+         ENDDO
+      ENDDO
+      SIG_inel = SUM*2.*PI*DB
+      sig_tot= SUM_TOT*4.*PI*DB
+      B_EL= SUM_B*PI*DB/sig_tot*2.
+      SA = 0.
+      DO J=0,20
+         SA = SA + PJET(J)/FACT(J)
+      ENDDO
+      DO J=0,20
+         PJET(J) = PJET(J)/FACT(J)/SA
+      ENDDO
+
+      RETURN
+      END
+
+      SUBROUTINE SINCO(S,C)
+      DATA PI /3.1415926/
+      F = 2.*PI*RNDM(0)
+      C = COS (F)
+      S = SIN (F)
+      RETURN
+      END
+
+
+       SUBROUTINE SIROBO( NBEG, NEND, THE, PHI, DBEX, DBEY, DBEZ)
+C **********************************************************************
+C   THIS IS A SLIGHTLY ALTERED VERSION OF "LUROBO" [JETSET63.PYTHIA]   *
+C SET TO WORK IN THE SIBYL ENVIROMENT. THE TRANSFORMATION IS PERFORMED *
+C ON PARTICLES NUMBER FROM NBEG TO NEND. COMMON BLOCKS CHANGED.        *
+C                                      TSS,   Oct '87                  *
+C  modification  use directly BETA in double precision in input (PL)   *
+C **********************************************************************
+      COMMON /S_PLIST/ NP, PLIST(5000,5), LLIST(5000)
+      DIMENSION ROT(3,3),PV(3)
+      DOUBLE PRECISION DP(4),DBEX,DBEY,DBEZ,DGA,DBEP,DGABEP
+      IF(THE**2+PHI**2 .LE. 1E-20) GO TO 131
+C...ROTATE (TYPICALLY FROM Z AXIS TO DIRECTION THETA,PHI)
+       ROT(1,1)=COS(THE)*COS(PHI)
+       ROT(1,2)=-SIN(PHI)
+       ROT(1,3)=SIN(THE)*COS(PHI)
+       ROT(2,1)=COS(THE)*SIN(PHI)
+       ROT(2,2)=COS(PHI)
+       ROT(2,3)=SIN(THE)*SIN(PHI)
+       ROT(3,1)=-SIN(THE)
+       ROT(3,2)=0.
+       ROT(3,3)=COS(THE)
+       DO 120 I=NBEG,NEND
+       DO 100 J=1,3
+ 100   PV(J)=PLIST(I,J)
+       DO 110 J=1,3
+ 110   PLIST(I,J)=ROT(J,1)*PV(1)+ROT(J,2)*PV(2)+ROT(J,3)*PV(3)
+ 120   CONTINUE
+ 131    IF(DBEX**2+DBEY**2+DBEZ**2 .LE. 1D-20) GO TO 151
+C...LORENTZ BOOST (TYPICALLY FROM REST TO MOMENTUM/ENERGY=BETA)
+       DGA=1D0/DSQRT(1D0-DBEX**2-DBEY**2-DBEZ**2)
+       DO 140 I=NBEG, NEND
+       DO 130 J=1,4
+ 130   DP(J)=PLIST(I,J)
+       DBEP=DBEX*DP(1)+DBEY*DP(2)+DBEZ*DP(3)
+       DGABEP=DGA*(DGA*DBEP/(1D0+DGA)+DP(4))
+       PLIST(I,1)=DP(1)+DGABEP*DBEX
+       PLIST(I,2)=DP(2)+DGABEP*DBEY
+       PLIST(I,3)=DP(3)+DGABEP*DBEZ
+       PLIST(I,4)=DGA*(DP(4)+DBEP)
+ 140   CONTINUE
+ 151   RETURN
+      END
+      SUBROUTINE SSLOPE (S, BP, BM)
+      COMMON /BLOCKD/ CP, DP, EP, CM, DM
+      AL = LOG(S)
+      BP = CP + DP*AL + EP*AL*AL
+      BM = CM + DM*AL
+      RETURN
+      END
+
+      SUBROUTINE STRING_FRAG(E0,IFL1,IFL2,PX1,PY1,PX2,PY2,IFBAD)
+C...This routine fragments a string of energy E0
+C.  the ends of the strings  have flavors IFL1 and IFL2
+C.  the particles produced are in the  jet-jet frame
+C.  with IFL1 going in the +z direction
+C.     E0 = total energy in jet-jet system
+C.  This version consider also a primordial pT attached
+C.  to the ends of the string PX1,PY1,  PX2,PY2
+C.  OUTPUT:  IFBAD =1  kinematically impossible decay
+c
+c      Modified Nov. 91.  RSF and TSS to fragment symetrically
+c      ie forward and backward are fragmented as leading.
+c      Change- Dec. 92  RSF.  call to ptdis moved- to use flavor
+c      of NEW quark in fragmentation.
+C...........................................................
+      COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
+      COMMON /S_MASS1/ AM(49), AM2(49)
+      COMMON /S_diagnostics/ntry,Iflag(5000),xm(5000),zst(5000)
+      DIMENSION WW(2,2), PTOT(4), PX(3),PY(3),IFL(3)
+      DIMENSION LPOINT(3000), PMQ(3)
+      LOGICAL LRANK
+      DATA LRANK/.true./
+
+C...initialise
+      NTRY = 0
+      IFBAD = 0
+200      NTRY = NTRY + 1
+      IF (NTRY .GT. 50)  THEN
+         IFBAD = 1
+         RETURN
+      ENDIF
+      I = NP
+      DO K=1,2
+         WW(K,1) = 1.
+         WW(K,2) = 0.
+      ENDDO
+      PX(1) = PX1
+      PY(1) = PY1
+      PX(2) = PX2
+      PY(2) = PY2
+      PX(3) = 0.
+      PY(3) = 0.
+      PTOT (1) = PX1+PX2
+      PTOT (2) = PY1+PY2
+      PTOT (3) = 0.
+      PTOT (4) = E0
+      IFL(1) = IFL1
+      IFL(2) = IFL2
+      PMQ(1) = QMASS(IFL(1))
+      PMQ(2) = QMASS(IFL(2))
+
+      IBLEAD = 0
+C
+C      SET FLAG FOR GENERATION OF LEADING PARTICLES.
+C      "AND" IS FOR PPBAR ( DIQUARK AT BOTH ENDS)
+C      "OR" IS FOR PP, PPI, ( DIQUARK AT ONE END.)
+C
+      IF (IABS(IFL1) .GT. 10 .AND. IABS(IFL2) .GT. 10)  THEN
+         IBLEAD = 2
+         I = I+1
+         JT = 1.5+RNDM(0)
+         GOTO 350
+      ENDIF
+      IF (IABS(IFL1) .GT. 10 .OR. IABS(IFL2) .GT. 10)  THEN
+         IBLEAD = 1
+         I = I+1
+         JT = 1
+         IF (IABS(IFL2) .GT. 10) JT = 2
+         GOTO 350
+      ENDIF
+
+C...produce new particle: side, pT
+300      I=I+1
+      IF (IBLEAD .GT. 0)  THEN
+           JT = 3 - JT
+           GO TO 350
+       ENDIF
+c
+ 349     continue
+         JT=1.5+RNDM(0)
+ 350      JR=3-JT
+      LPOINT(I) = JT
+      Iflag(i)=0
+c      old call to Ptdis. pre Dec. 92
+c      CALL PTDIS (IFL(JT), PX(3),PY(3))
+
+C...particle ID and pt.
+ 999        continue
+      CALL IFLAV (IFL(JT), 0, IFL(3), LLIST(I))
+ 991    continue
+      PMQ(3) = QMASS(IFL(3))
+      P(I,5) = AM(IABS(LLIST(I)))
+      CALL PTDIS (IFL(3), PX(3),PY(3))
+C...fill transverse momentum
+      P(I,1) = PX(JT) + PX(3)
+      P(I,2) = PY(JT) + PY(3)
+      XMT2 = P(I,5)**2+P(I,1)**2+P(I,2)**2
+
+
+C...test end of fragmentation
+
+      WREM2 = PTOT(4)**2-PTOT(1)**2-PTOT(2)**2-PTOT(3)**2
+      IF (WREM2 .LT. 0.1)  GOTO 200
+      WMIN = PMQ(1)+PMQ(2)+2.*PMQ(3)+ 1.1 + (2.*RNDM(0)-1.)*0.2
+c      WMIN = PMQ(jr)+sqrt(xmt2)+pmq(3)+ 1.1 +(2.*RNDM(0)-1.)*0.2
+c      IF (WREM2 .LT. WMIN**2) goto 400
+      IF (WREM2 .LT. WMIN**2)    Then!   goto 400
+         if (abs(ifl(3)).ne.3) GOTO 400
+          goto 200
+      endif
+
+c
+C...Choose z
+      xm(i)=xmt2
+      IF (IBLEAD .GT. 0.and.abs(ifl(jt)).gt.10)  THEN
+c        Special frag. for leading Baryon only
+         Z = ZBLEAD (IABS(LLIST(I)))
+         IBLEAD = IBLEAD - 1
+      ELSE
+         Z = ZDIS (IFL(3),ifl(jt),XMT2)
+      ENDIF
+c       store z for spliting
+      if (z.le.0) WRITE (6,*) 'z less than 0 =',z
+      zst(i)=z
+      WW(JT,2) = Z*WW(JT,1)
+      WW(JR,2) = XMT2/(WW(JT,2)*E0**2)
+
+      P(I,3) = WW(1,2)*0.5*E0 - WW(2,2)*0.5*E0
+      P(I,4) = WW(1,2)*0.5*E0 + WW(2,2)*0.5*E0
+
+      DO J=1,4
+         PTOT (J) = PTOT(J) - P(I,J)
+      ENDDO
+      DO K=1,2
+         WW(K,1) = WW(K,1) - WW(K,2)
+      ENDDO
+
+C...Reset pT and flavor at ebds of the string
+      PX(JT) = -PX(3)
+      PY(JT) = -PY(3)
+      IFL(JT) =-IFL(3)
+      PMQ(JT) = PMQ(3)
+      GOTO 300
+
+C...Final two hadrons
+400      IF (IFL(JR)*IFL(3) .GT. 100)  GOTO 200
+c   debug- output ptot
+      iflag(i)=1
+      iflag(i+1)=1
+      do iii=1,4
+        p(4999,iii)=ptot(iii)
+      enddo
+c     p(4999,5)=sqrt(wrem2)
+      CALL IFLAV (IFL(JR), -IFL(3), IFLA, LLIST(I+1))
+      P(I+1,5) = AM(IABS(LLIST(I+1)))
+      P(I,1)   = PX(JT)+PX(3)
+      P(I,2)   = PY(JT)+PY(3)
+      I1 = I+1
+      P(I+1,1) = PX(JR)-PX(3)
+      P(I+1,2) = PY(JR)-PY(3)
+      XM1 = P(I,5)**2+P(I,1)**2+P(I,2)**2
+      XM2 = P(I1,5)**2+P(I1,1)**2+P(I1,2)**2
+      IF (SQRT(XM1)+SQRT(XM2) .GT. SQRT(WREM2)) GOTO 200
+      WREM = SQRT(WREM2)
+      EA1 = (WREM2+XM1-XM2)/(2.*WREM)
+      PA2 = (EA1**2-XM1)
+      if (pa2.gt.0)  then
+            PA = SQRT(PA2)
+      else
+            goto 200
+      endif
+      BA = PTOT(3)/PTOT(4)
+      GA = PTOT(4)/WREM
+      S = FLOAT(3-2*JT)
+      P(I,3) = GA*(BA*EA1+S*PA)
+      P(I,4) = GA*(EA1+BA*S*PA)
+      P(I+1,3) = PTOT(3)-P(I,3)
+      P(I+1,4) = PTOT(4)-P(I,4)
+      NA= NP+1
+      NP=I+1
+
+C...reorder  particles along chain (in rank)
+      IF (LRANK)  THEN
+      N1 = NA-1
+      N2 = 0
+      DO J=NA,NP
+         IF(LPOINT(J) .EQ. 2)  THEN
+            N2=N2+1
+            LLIST (NP+N2) = LLIST(J)
+            DO K=1,5
+               P(NP+N2,K)=P(J,K)
+            ENDDO
+         ELSE
+            N1= N1+1
+            IF (N1.LT.J)   THEN
+               LLIST(N1) = LLIST(J)
+               DO K=1,5
+                  P(N1,K) = P(J,K)
+               ENDDO
+            ENDIF
+         ENDIF
+      ENDDO
+      JJ=N1
+      DO J=NP+N2,NP+1,-1
+         JJ= JJ+1
+         LLIST(JJ) = LLIST(J)
+         DO K=1,5
+             P(JJ,K) = P(J,K)
+         ENDDO
+      ENDDO
+      ENDIF
+
+      RETURN
+      END
+      FUNCTION WOOD_SAXON (R, JA)
+C....Woods Saxon nuclear density (normalised to 1)
+C.   for a nucleus of mass number A.
+C.   INPUT R =  (fm)
+C.         JA = mass number
+C.   OUTPUT (fm**-3)
+C......................................................
+      COMMON /CWOOD/ RR0(19:56), AA0(19:56), CC0(19:56)
+      WOOD_SAXON = CC0(JA)/(1.+EXP((R-RR0(JA))/AA0(JA)))
+      RETURN
+      END
+
+      SUBROUTINE WOOD_SAXON_INI
+      COMMON /CWOOD/ RR0(19:56), AA0(19:56), CC0(19:56)
+      DATA PI /3.1415926/
+C...Wood-Saxon parameters from  table 6.2   of Barrett and Jackson
+      RR0 (19) = 2.59
+      AA0 (19) = 0.564
+      RR0 (20) = 2.74
+      AA0 (20) = 0.569
+      RR0 (22) = 2.782
+      AA0 (22) = 0.549
+      RR0 (24) = 2.99
+      AA0 (24) = 0.548
+      RR0 (27) = 2.84
+      AA0 (27) = 0.569
+      RR0 (28) = 3.14
+      AA0 (28) = 0.537
+      RR0 (29) = 3.77
+      AA0 (29) = 0.52
+      RR0 (48) = 3.912
+      AA0 (48) = 0.5234
+      RR0 (56) = 3.98
+      AA0 (56) = 0.569
+      DO J=19, 56
+         IF (RR0(J) .LE. 0.)  THEN
+            RR0(J) = 1.05*FLOAT(J)**0.333333
+            AA0(J) = 0.545
+         ENDIF
+         CC0(J)=3./(4.*PI*RR0(J)**3)/(1.+((AA0(J)*PI)/RR0(J))**2)
+      ENDDO
+      RETURN
+      END
+
+      FUNCTION ZBLEAD (LB)
+C...fragmentation function for leading baryon
+C.  simple form:  f(z) = a + x**b
+C   INPUT : LB = particle code.
+C..................................................
+      COMMON /S_CZLEAD/ CLEAD, FLEAD
+c      COMMON /S_SZLEAD/ CLEADs, FLEADs
+      COMMON /S_CHP/ ICHP(49), ISTR(49), IBAR(49)
+
+            IC = ICHP(Lb)*ISIGN(1,Lb)
+
+      if (lb.ge.34.and.lb.le.39)  then  ! Lambda's and Sigma's
+  665               ZBLEAD = RNDM(0)
+                if (zblead.le..01) goto 665
+c          zblead=zdisn(1) ! blead**2   ! soft
+      else if (ic.eq.0)     then
+          zblead=zdisn(1)   ! blead**2   !soft
+      else if (ic.eq.1)  then  ! fast protons only
+            if (abs(lb).eq.13) then
+              IF (RNDM(0) .LT. CLEAD)  THEN
+  666               ZBLEAD = RNDM(0)
+                if (zblead.le..01) goto 666
+              ELSE
+                  zblead=1.-zdisn(1)  ! zblead**2   !hard
+              ENDIF
+            continue
+           else
+               zblead=zdisn(1)  ! zblead**2   !hard
+           endif
+      else if (ic.eq.2)  then  ! fast delta++
+          zblead=1.- zdisn(1)  ! (zblead)**.3333
+      else
+               zblead=RNDM(0) ! zdisn(1)     !hard
+      endif
+       RETURN
+      END
+      FUNCTION ZDIS (IFL1,ifl2, XMT2)
+C...z distribution
+      COMMON /S_CZDIS/ FAin, FB0in
+      COMMON /S_CZDISs/ FAs1, fAs2
+      COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
+      fa=fain
+      fb0=fb0in
+C  following statement corrected by D.H. may 10, 1996
+      if (abs(kb).ge.13) then   ! baryons only
+          if (abs(ifl2).eq.3)  fa=fain+fas2
+          if (abs(ifl1).eq.3)  fa=fain+fas1
+      endif
+      FB = FB0*XMT2
+      IF(FA.GT.0.01.AND.ABS(FA-1.)/FB.LE.0.01) ZMAX=FB/(1.+FB)+
+     +  (1.-FA)*FB**2/(1.+FB)**3
+      IF(FA.GT.0.01.AND.ABS(FA-1.)/FB.GT.0.01) ZMAX=0.5*(1.+FB-
+     +  SQRT((1.-FB)**2+4.*FA*FB))/(1.-FA)
+      IF(ZMAX.LT.0.1)  ZDIV=2.75*ZMAX
+      IF(ZMAX.GT.0.85)
+     +     ZDIV=ZMAX-0.6/FB**2+(FA/FB)*ALOG((0.01+FA)/FB)
+C...Choice if z, preweighted for peaks at low or high z
+100      Z=RNDM(0)
+      IDIV=1
+      FPRE=1.
+      IF (ZMAX.LT.0.1)  THEN
+         IF(1..LT.RNDM(0)*(1.-ALOG(ZDIV)))  IDIV=2
+         IF (IDIV.EQ.1)  Z=ZDIV*Z
+         IF (IDIV.EQ.2)  Z=ZDIV**Z
+         IF (IDIV.EQ.2)  FPRE=ZDIV/Z
+      ELSEIF (ZMAX.GT.0.85)  THEN
+         IF(1..LT.RNDM(0)*(FB*(1.-ZDIV)+1.)) IDIV=2
+         IF (IDIV.EQ.1)  Z=ZDIV+ALOG(Z)/FB
+         IF (IDIV.EQ.1)  FPRE=EXP(FB*(Z-ZDIV))
+         IF (IDIV.EQ.2)  Z=ZDIV+Z*(1.-ZDIV)
+      ENDIF
+C...weighting according to the correct formula
+      IF (Z.LE.FB/(50.+FB).OR.Z.GE.1.)  GOTO 100
+      FVAL=(ZMAX/Z)*EXP(FB*(1./ZMAX-1./Z))
+      IF(FA.GT.0.01)  FVAL=((1.-Z)/(1.-ZMAX))**FA*FVAL
+      IF(FVAL.LT.RNDM(0)*FPRE)  GOTO 100
+      ZDIS=Z
+      RETURN
+      END
+      FUNCTION ZDISN (n)
+C...Generate (1-x)**n
+      continue
+666   rmin=1.1
+      do i=1,n+1
+         R1=RNDM(0)
+         IF (R1.LE.RMIN) RMIN=R1
+      ENDDO
+      ZDISn=RMIN
+      if (zdisn.le..01) goto 666
+      if (zdisn.ge..99) goto 666
+      END
+      FUNCTION ZSAMPLE (ZMIN,L)
+C...This function returns as output a value z=log(x)
+C.  distributed as f(x) = g(x) + 4/9 *(q(x) + qbar(x))
+C.  from a minimum value ZMIN to 0,
+C.  for a proton (L=1) or a pi (L=2)
+C.  needs to be initialised with: CALL ZSAMPLE_INI
+C.....................................................
+      COMMON /S_CZGEN/ XA,XB,XMAX,ZA,ZB,ZMAX,DX,DZ,NX,NZ,APART(2),
+     +   FFA(2),FFB(2),
+     +   DFX(2),DFZ(2),XX(200,2),ZZ(200,2),FFX(200,2),FFZ(200,2)
+
+      F = PART_INT(ZMIN,L)*RNDM(0)
+C D.H.
+      IF (F .GE. FFA(L))  THEN
+         ZSAMPLE = ZA - (F-FFA(L))/APART(L)
+C D.H.
+      ELSE IF (F .GE. FFB(L))  THEN
+         JF = (F-FFB(L))/DFZ(L) + 1
+         F0 = FFB(L) + DFZ(L)*FLOAT(JF-1)
+         T = (F-F0)/DFZ(L)
+         ZSAMPLE = ZZ(JF,L)*(1.-T)+ZZ(JF+1,L)*T
+      ELSE
+         JF = F/DFX(L)+1
+         F0 = DFX(L)*FLOAT(JF-1)
+         T = (F-F0)/DFX(L)
+         X = XX(JF,L)*(1.-T)+XX(JF+1,L)*T
+         ZSAMPLE = LOG(X)
+      ENDIF
+      RETURN
+      END
+      SUBROUTINE ZSAMPLE_INI
+C...This subroutine initialise the generation of
+C.  z = log(x)  for the generation  of z according
+C.  to the structure functions
+C..................................................
+      COMMON /S_CZGEN/ XA,XB,XMAX,ZA,ZB,ZMAX,DX,DZ,NX,NZ,APART(2),
+     +   FFA(2),FFB(2),
+     +   DFX(2),DFZ(2),XX(200,2),ZZ(200,2),FFX(200,2),FFZ(200,2)
+
+      XA = 1.E-04
+      XB = 1.E-01
+      XMAX = 0.80
+      ZA = LOG(XA)
+      ZB = LOG(XB)
+      ZMAX = LOG(XMAX)
+      NX = 200
+      NZ = 200
+      DX = (XMAX-XB)/FLOAT(NX-1)
+      DZ = (ZB-ZA)/FLOAT(NZ-1)
+
+      DO L=1,2
+C         very small x:  f(x) = A/x
+         APART(L) = PARTON(0.,L)
+
+C         large x: interpolation in x
+         FFX(1,L) = 0.
+         DO J=2,NX
+            X = XMAX - DX*(FLOAT(J)-0.5)
+             G = PARTON(X,L)/X
+            FFX(J,L) = FFX(J-1,L)+G*DX
+         ENDDO
+         CALL INVERT_ARRAY (FFX(1,L),XMAX,-DX,NX,XX(1,L),FMIN,
+     +                        DFX(L))
+
+C         small x: interpolation in log(x)
+         FFZ(1,L) = FFX(NX,L)
+         DO J=2,NZ
+            Z = ZB - DZ*(FLOAT(J)-0.5)
+            X = EXP(Z)
+            G = PARTON(X,L)
+            FFZ(J,L) = FFZ(J-1,L)+G*DZ
+         ENDDO
+         CALL INVERT_ARRAY (FFZ(1,L),ZB,-DZ,NZ,ZZ(1,L),FMIN,DFZ(L))
+         FFA(L) = FFZ(NZ,L)
+         FFB(L) = FFX(NX,L)
+      ENDDO
+      RETURN
+      END
+      BLOCK DATA DATDEC
+      COMMON /S_CSYDEC/ IDB(49), CBR(102), KDEC(612), LBARP(49)
+      COMMON /S_MASS1/ AM(49), AM2(49)
+      COMMON /S_CHP/ ICHP(49), ISTR(49), IBAR(49)
+      COMMON /S_CNAM/ NAMP (0:49)
+      CHARACTER NAMP*6
+      DATA CBR /3*1.,0.,1.,1.,0.6351,0.8468,0.9027,0.9200,0.9518,1.,
+     +   0.6351,0.8468,0.9027,0.9200,0.9518,1.,0.2160,0.3398,0.4748,
+     +   0.6098,0.8049,1.,0.6861,1.,3*0.,0.5,1.,0.5,1.,
+     +   0.3890,0.7080,0.9440,0.9930,1.,0.,0.4420,0.6470,0.9470,0.9770,
+     +   0.9990,4*1.,0.6670,1.,9*0.,0.6670,1.,0.6670,1.,0.6670,1.,
+     +   0.8880,0.9730,1.,0.4950,0.8390,0.9870,1.,0.5160,5*1.,0.6410,1.,
+     +   1.,0.67,1.,0.33,1.,1.,0.88,0.94,1.,0.88,0.94,1.,0.88,0.94,1.,
+     +   0.33,1.,0.67,1.,0.678,0.914,1./
+      DATA AM / 0.,2*0.511E-3, 2*0.10566, 0.13497, 2*0.13957,
+     +   2*0.49365, 2*0.49767, 0.93827, 0.93957, 4*0.,0.93827,
+     +   0.93957, 2*0.49767, 0.54880,0.95750,2*0.76830,0.76860,
+     +   2*0.89183,2*0.89610,0.78195,1.01941,1.18937,1.19255,
+     +   1.19743,1.31490,1.32132,1.11563,1.23100,1.23500,
+     +   1.23400,1.23300,1.38280,1.38370,1.38720,
+     +   1.53180,1.53500,1.67243 /
+      DATA AM2 /0.,2*2.61121E-07,2*0.011164,0.018217,0.019480,
+     + 0.019480,0.243690,0.243690,0.247675,0.247675,0.880351,0.882792,
+     + 0.000000,0.000000,0.000000,0.000000,0.880351,0.882792,0.247675,
+     + 0.247675,0.301181,0.916806,0.590285,0.590285,0.590746,0.795361,
+     + 0.795361,0.802995,0.802995,0.611446,1.039197,1.414601,1.422176,
+     + 1.433839,1.728962,1.745887,1.244630,1.515361,1.525225,1.522765,
+     + 1.520289,1.912136,1.914626,1.924324,2.346411,2.356225,2.797022/
+      DATA IDB /
+     +    0,0,0,1,2,3,5,6,7,13,19,25,8*0,30,32,34,40,46,47,48,49,60,62,
+     +    64,66,69,73,75,76,77,78,79,81,82,84,86,87,90,93,96,98,100/
+      DATA KDEC /
+     + 3,1,15,2,18,0,3,1,16,3,17,0,2,0,1,1,8*0,2,0,4,17,0,0,2,0,5,18,0,
+     + 0,2,0,4,17,0,0,2,0,7,6,0,0,3,0,7,7,8,0,3,0,7,6,6,0,3,1,17,4,6,0,
+     + 3,1,15,2,6,0,2,0,5,18,0,0,2,0,8,6,0,0,3,0,8,8,7,0,3,0,8,6,6,0,3,
+     + 1,18,5,6,0,3,1,16,3,6,0,3,0,6,6,6,0,3,0,7,8,6,0,3,1,18,5,7,0,3,
+     + 1,17,4,8,0,3,1,16,3,7,0,3,1,15,2,8,0,2,0,7,8,0,0,2,0,6,6,20*0,1,
+     + 0,11,3*0,1,0,12,0,0,0,1,0,11,0,0,0,1,0,12,0,0,0,2,0,1,1,0,0,3,0,
+     + 6,6,6,0,3,0,7,8,6,0,3,0,1,7,8,0,3,0,1,3,2,7*0,3,0,7,8,23,0,3,0,6
+     + ,6,23,0,2,0,1,27,0,0,2,0,1,32,0,0,2,0,1,1,0,0,3,0,6,6,6,0,2,0,7,
+     + 6,0,0,2,0,8,6,0,0,2,0,7,8,0,0,2,0,21,7,0,0,2,0,9,6,0,0,54*0,2,0,
+     + 22,8,0,0,2,0,10,6,0,0,2,0,9,8,0,0,2,0,21,6,0,0,2,0,10,7,0,0,
+     + 2,0,22,6,0,0,3,0,7,8,6,0,2,0,1,6,0,0,2,0,7,8,0,0,2,0,9,10,0,
+     + 0,2,0,11,12,0,0,3,0,7,
+     + 8,6,0,2,0,1,23,0,0,2,0,13,6,0,0,2,0,14,7,0,0,2,0,39,1,0,0,2,
+     + 0,14,8,0,0,2,0,39,6,0,0,2,0,39,8,0,0,2,0,13,8,0,0,2,0,
+     + 14,6,0,0,2,0,13,7,0,0,2,0,13,6,
+     + 0,0,2,0,14,7,0,0,2,0,13,8,0,0,2,0,14,6,0,0,2,0,14,8,0,0,2,0,
+     + 39,7,0,0,2,0,34,6,0,0,2,0,35,7,0,0,2,0,39,6,0,0,2,0,34,8,0,0,
+     + 2,0,36,7,0,0,2,0,39,8,0,0,2,
+     + 0,35,8,0,0,2,0,36,6,0,0,2,0,37,6,0,0,2,0,38,7,0,0,2,0,
+     + 37,8,0,0,2,0,38,6,0,0,2,0,39,10,0,0,2,0,37,8,0,0,2,0,38,6,0,0/
+      DATA LBARP/1,3,2,5,4,6,8,7,10,9,11,12,-13,-14,16,15,18,17,13,14,
+     +  22,21,23,24,26,25,27,29,28,31,30,32,33,-34,-35,-36,-37,-38,-39,
+     +  -40,-41,-42,-43,-44,-45,-46,-47,-48,-49/
+      DATA ICHP /0,1,-1,1,-1,0,1,-1,1,-1,0,0,1,0,4*0,-1,0,4*0,
+     +    1,-1,0,1,-1,4*0,1,0,-1,0,-1,0,2,1,0,-1,1,0,-1,0,-1,-1/
+      DATA ISTR /8*0,-1,+1,10,10,8*0,-1,+1,5*0,-1,+1,-1,+1,2*0,
+     +           3*1,2*2,1,4*0,3*1,2*2,3 /
+      DATA IBAR /12*0,2*1,4*0,2*-1,13*0,16*1/
+      DATA NAMP /
+     +     '     ','gam   ','e+','e-','mu+','mu-','pi0',
+     +     'pi+','pi-','k+', 'k-', 'k0l','k0s',
+     +     'p', 'n', 'nue', 'nueb', 'num', 'numb', 'pbar', 'nbar',
+     +     'k0', 'k0b', 'eta', 'etap', 'rho+', 'rho-','rho0',
+     +     'k*+','k*-','k*0','k*0b','omeg', 'phi', 'SIG+', 'SIG0',
+     +     'SIG-','XI0','XI-','LAM','DELT++','DELT+','DELT0','DELT-',
+     +     'SIG*+ ','SIG*0','SIG*-', 'XI*0', 'XI*-', 'OME*-'/
+      END
+      SUBROUTINE DECPAR (LA,P0,ND,LL,P)
+C...This subroutine generates the decay of a particle
+C.  with ID = LA, and 5-momentum P0(1:5)
+C.  into ND particles of 5-momenta P(j,1:5) (j=1:ND)
+C.
+C.  If the initial particle code is LA=0
+C.  then ND and LL(1:ND) are considered as  input and
+C.  the routine generates a phase space decay into ND
+C.  particles of codes LL(1:nd)
+C.
+C.  june 1992
+C.  This version  contains the decay of polarized muons
+C.  The muon codes are  L =  4 : mu+ R
+C.                          -4 : mu+ L
+C.                           5 : mu- L
+C.                          -5 : mu- R
+C------------------------------------------------------
+      COMMON /S_CSYDEC/ IDB(49), CBR(102), KDEC(612), LBARP(49)
+      COMMON /S_MASS1/ AM(49), AM2(49)
+      DIMENSION P0(5), LL(10), P(10,5)
+      DIMENSION PV(10,5), RORD(10), UE(3),BE(3), FACN(3:10)
+      DATA FACN /2.,5.,15.,60.,250.,1500.,12000.,120000./
+      DATA PI /3.1415926/
+
+C...c.m.s. Momentum in two particle decays
+      PAWT(A,B,C) = SQRT((A**2-(B+C)**2)*(A**2-(B-C)**2))/(2.*A)
+
+C...Phase space decay into the particles in the list
+      IF (LA .EQ. 0)  THEN
+          MAT = 0
+          MBST = 0
+          PS = 0.
+          DO J=1,ND
+             P (J,5) = AM(IABS(LL(J)))
+             PV(J,5) = AM(IABS(LL(J)))
+             PS = PS+P(J,5)
+          ENDDO
+          DO J=1,4
+             PV(1,J) = P0(J)
+          ENDDO
+          PV(1,5) = P0(5)
+          GOTO 140
+      ENDIF
+
+C...Choose decay channel
+      L = IABS(LA)
+      ND=0
+      IDC = IDB(L)-1
+      IF (IDC+1 .LE.0)  RETURN
+      RBR = RNDM(0)
+110   IDC=IDC+1
+      IF(RBR.GT.CBR(IDC))  GOTO 110
+
+      KD =6*(IDC-1)+1
+      ND = KDEC(KD)
+      MAT= KDEC(KD+1)
+      MBST=0
+      IF (MAT .GT.0 .AND. P0(4) .GT. 20*P0(5)) MBST=1
+      IF (MAT .GT.0 .AND. MBST .EQ. 0)
+     +        BETA = SQRT(P0(1)**2+P0(2)**2+P0(3)**2)/P0(4)
+      PS = 0.
+      DO J=1,ND
+         LL(J) = KDEC(KD+1+J)
+         P(J,5)  = AM(LL(J))
+         PV(J,5) = AM(LL(J))
+         PS = PS + P(J,5)
+      ENDDO
+      DO J=1,4
+         PV(1,J) = 0.
+         IF (MBST .EQ. 0)  PV(1,J) = P0(J)
+      ENDDO
+      IF (MBST .EQ. 1)  PV(1,4) = P0(5)
+      PV(1,5) = P0(5)
+
+140   IF (ND .EQ. 2) GOTO 280
+
+      IF (ND .EQ. 1)  THEN
+         DO J=1,4
+            P(1,J) = P0(J)
+         ENDDO
+         RETURN
+      ENDIF
+
+C...Calculate maximum weight for ND-particle decay
+      WWTMAX = 1./FACN(ND)
+      PMAX=PV(1,5)-PS+P(ND,5)
+      PMIN=0.
+      DO IL=ND-1,1,-1
+         PMAX = PMAX+P(IL,5)
+         PMIN = PMIN+P(IL+1,5)
+         WWTMAX = WWTMAX*PAWT(PMAX,PMIN,P(IL,5))
+      ENDDO
+
+C...generation of the masses, compute weight, if rejected try again
+240   RORD(1) = 1.
+      DO 260 IL1=2,ND-1
+        RSAV = RNDM(0)
+        DO 250 IL2=IL1-1,1,-1
+          IF(RSAV.LE.RORD(IL2))   GOTO 260
+250     RORD(IL2+1)=RORD(IL2)
+260     RORD(IL2+1)=RSAV
+      RORD(ND) = 0.
+      WT = 1.
+      DO 270 IL=ND-1,1,-1
+      PV(IL,5)=PV(IL+1,5)+P(IL,5)+(RORD(IL)-RORD(IL+1))*(PV(1,5)-PS)
+270   WT=WT*PAWT(PV(IL,5),PV(IL+1,5),P(IL,5))
+      IF (WT.LT.RNDM(0)*WWTMAX)   GOTO 240
+
+C...Perform two particle decays in respective cm frame
+280   DO 300 IL=1,ND-1
+      PA=PAWT(PV(IL,5),PV(IL+1,5),P(IL,5))
+      UE(3)=2.*RNDM(0)-1.
+      PHI=2.*PI*RNDM(0)
+      UT = SQRT(1.-UE(3)**2)
+      UE(1) = UT*COS(PHI)
+      UE(2) = UT*SIN(PHI)
+      DO 290 J=1,3
+      P(IL,J)=PA*UE(J)
+290   PV(IL+1,J)=-PA*UE(J)
+      P(IL,4)=SQRT(PA**2+P(IL,5)**2)
+300   PV(IL+1,4)=SQRT(PA**2+PV(IL+1,5)**2)
+
+C...Lorentz transform decay products to lab frame
+      DO 310 J=1,4
+310   P(ND,J)=PV(ND,J)
+      DO 340 IL=ND-1,1,-1
+      DO 320 J=1,3
+320   BE(J)=PV(IL,J)/PV(IL,4)
+      GA=PV(IL,4)/PV(IL,5)
+      DO 340 I=IL,ND
+      BEP = BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
+      DO 330 J=1,3
+330   P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J)
+340   P(I,4)=GA*(P(I,4)+BEP)
+
+C...Weak decays
+      IF (MAT .EQ. 1)  THEN
+         F1=P(2,4)*P(3,4)-P(2,1)*P(3,1)-P(2,2)*P(3,2)-P(2,3)*P(3,3)
+         IF (MBST.EQ.1)  THEN
+C          WT = P0(5)*P(1,4)*F1
+           WT = P0(5)*(P(1,4)+FLOAT(LA/L)*P(1,3))*F1
+         ENDIF
+         IF (MBST.EQ.0)  THEN
+           WT=F1*(P(1,4)*P0(4)-P(1,1)*P0(1)-P(1,2)*P0(2)-P(1,3)*P0(3))
+           WT= WT-FLOAT(LA/L)*(P0(4)*BETA*P(1,4)-P0(4)*P(1,3))*F1
+         ENDIF
+         WTMAX = P0(5)**4/8.
+         IF(WT.LT.RNDM(0)*WTMAX)   GOTO 240
+      ENDIF
+
+C...Boost back for rapidly moving particle
+      IF (MBST .EQ. 1)   THEN
+         DO 440 J=1,3
+440      BE(J)=P0(J)/P0(4)
+         GA= P0(4)/P0(5)
+         DO 460 I=1,ND
+         BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
+         DO 450 J=1,3
+450         P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J)
+460         P(I,4)=GA*(P(I,4)+BEP)
+      ENDIF
+
+C...labels for antiparticle decay
+      IF (LA .LT. 0 .AND. L .GT. 18)  THEN
+           DO J=1,ND
+            LL(J) = LBARP(LL(J))
+         ENDDO
+      ENDIF
+
+      RETURN
+      END
+      SUBROUTINE DECPR (LUN)
+C...Print on unit LUN the list of particles and decay channels
+      COMMON /S_CSYDEC/ IDB(49), CBR(102), KDEC(612), LBARP(49)
+      COMMON /S_MASS1/ AM(49), AM2(49)
+      COMMON /S_CNAM/ NAMP (0:49)
+      CHARACTER*6 NAMP
+      DIMENSION LL(3)
+
+      DO L=1,49
+         IDC = IDB(L)-1
+         NC = 0
+         WRITE (LUN,10) L,NAMP(L), AM(L)
+         IF(IDC+1 .GT. 0)  THEN
+            CB = 0.
+110         IDC=IDC+1
+            NC = NC+1
+            CBOLD = CB
+            CB = CBR(IDC)
+            BR = CB-CBOLD
+            KD = 6*(IDC-1)+1
+            ND = KDEC(KD)
+            MAT= KDEC(KD+1)
+            DO J=1,ND
+              LL(J) = KDEC(KD+1+J)
+            ENDDO
+            WRITE (LUN,15) NC,BR,ND,MAT, (NAMP(LL(J)),J=1,ND)
+            IF (CB .LT. 1.)  GOTO 110
+         ENDIF
+      ENDDO
+      RETURN
+10    FORMAT(1X,I3,2X,A6,3X,F10.4)
+15    FORMAT(5X,I2,2X,F9.4,I4,I4,2X,3(A6,2X))
+      END
+      SUBROUTINE DECSIB
+C----------------------------------------------------------------------------
+C  Code for Decay  developed for the SIBYLL montecarlo
+C----------------------------------------------------------------------------
+C...Decay all unstable particle in Sibyll
+C.  decayed particle have the code increased by 10000
+      COMMON /S_CSYDEC/ IDB(49), CBR(102), KDEC(612), LBARP(49)
+      COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
+      COMMON /S_PLIST1/ LLIST1(5000)
+      DIMENSION P0(5), LL(10), PD(10,5)
+      NN = 1
+      DO J=1,NP
+         LLIST1(J) = 0
+      ENDDO
+      DO WHILE (NN .LE. NP)
+         L= LLIST(NN)
+         IF (IDB(IABS(L)) .GT. 0)  THEN
+            DO K=1,5
+              P0(K) = P(NN,K)
+            ENDDO
+            CALL DECPAR (L,P0,ND,LL,PD)
+            LLIST(NN) = LLIST(NN)+ISIGN(10000,LLIST(NN))
+            DO J=1,ND
+               DO K=1,5
+                  P(NP+J,K) = PD(J,K)
+               ENDDO
+               LLIST(NP+J)=LL(J)
+               LLIST1(NP+J)=NN
+            ENDDO
+            NP=NP+ND
+         ENDIF
+         NN = NN+1
+      ENDDO
+      RETURN
+      END
+      SUBROUTINE DEC_DEBUG (L,P0, ND, LL, PD)
+      COMMON /S_CNAM/ NAMP (0:49)
+      CHARACTER*6 NAMP
+      DIMENSION P0(5), LL(10), PD(10,5)
+      ETOT = 0.
+      DO J=1,ND
+         ETOT = ETOT + PD(J,4)
+      ENDDO
+      WRITE(*,*)  NAMP(IABS(L)),' -> ', (NAMP(IABS(LL(J))),J=1,ND)
+      WRITE(*,*)  ' Ei, Ef = ', P0(4), ETOT, ' L = ', L
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/VENUS.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/VENUS.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/VENUS.f	(revision 286)
@@ -0,0 +1,17870 @@
+C=======================================================================
+C
+C                           V E N U S  4.12
+C                 (VERY ENERGETIC NUCLEAR SCATTERING)
+C                      SUBROUTINE-TURBO-VERSION            MAY 04, 1994
+C
+C-----------------------------------------------------------------------
+C
+C   AUTHOR:
+C   -------
+C
+C   KLAUS WERNER
+C
+C   UNIV. HEIDELBERG, INST. F. THEORETISCHE PHYSIK
+C   PHILOSOPHENWEG 19, 6900 HEIDELBERG, GERMANY
+C   WERNER@DHDMPI5.BITNET, WERNER@MINNIE.MPI-HD.MPG.DE, 28877::WERNER
+C
+C   NOW AT: 
+C   UNIVERSITE DE NANTES, SUBATECH - ECOLE DES MINES
+C   4, RUE ALFRED KASTLER, F44070 NANTES CEDEX 03, FRANCE
+C   E-MAIL: WERNER@NANHP2.IN2P3.FR
+C   FAX:    (33)  51 85 84 79
+C   TEL:    (33)  51 85 84 25
+C
+C
+C   SUBROUTINE-TURBO-VERSION 4.12/5:
+C   --------------------------------
+C   DIETER HECK
+C   FORSCHUNGSZENTRUM KARLSRUHE, INST. F. KERNPHYSIK 3
+C   POSTFACH 3640, D-76021 KARLSRUHE, GERMANY
+C   E-MAIL:  HECK@IK3.FZK.DE
+C   FAX:     07247-82-4075
+C   TEL:     07247-82-3777
+C
+C   LAST CHANGES:  OCT  05, 1995
+C-----------------------------------------------------------------------
+C
+C   VENUS:
+C   ------
+C
+C  VENUS IS A MONTE CARLO PROCEDURE TO SIMULATE HADRONIC INTERACTIONS AT
+C  ULTRARELATIVISTIC ENERGIES (HADRON-HADRON, HADRON-NUCLEUS, NUCLEUS-
+C  NUCLEUS SCATTERING), AND ALSO INTERACTIONS INVOLVING LEPTONS (E+E-
+C  ANNIHILATION, LEPTON-NUCLEON, LEPTON-NUCLEUS SCATTERING).
+C  VENUS IS BASED ON GRIBOV-REGGE THEORY (OF MULTIPLE POMERON EXCHANGE)
+C  AND CLASSICAL RELATIVISTIC STRING DYNAMICS. A DETAILED DESCRIPTION CA
+C  BE FOUND IN THE UNIV. HEIDELBERG PREPRINT HD-TVP-93-1 (270 PAGES),
+C  WHICH IS PUBLISHED IN PHYSICS REPORTS 232 (1993) 87-299.
+C
+C   DISTRIBUTION:
+C   -------------
+C
+C  THIS CODE SHOULD NOT BE DISTRIBUTED WITHOUT NOTIFYING THE AUTHOR, IN-
+C  DICATING WHAT THE CODE IS GOING TO BE USED FOR. DEPENDING ON THE TYPE
+C  OF REACTION AND THE KIND OF OBSERVABLES ANALYSED,  THE SYSTEMATIC UN-
+C  CERTAINTIES OF THE VENUS SIMULATIONS VARY STRONGLY,  AND THIS SHOULD
+C  BE CLARIFIED BEFORE USING VENUS.
+C
+C   IMPORTANT FEATURES:
+C   -------------------
+C
+C  COVARIANT TREATMENT OF SECONDARY INTERACTIONS. EACH PRODUCED PARTICLE
+C  IS ALLOWED TO REINTERACT WITH OTHER PRODUCED PARTICLES OR WITH
+C  SPECTATORS. IMPORTANT FOR HADRON-NUCLEUS, NUCLEUS-NUCLEUS AND
+C  LEPTON-NUCLEUS SCATTERING.
+C  NO FINAL STATE INTERACTION, IF 'RADIAC' IS SET ZERO.
+C
+C  PARTICIPATION OF ANTIQUARKS (IN ADDITION TO QUARKS) IN THE
+C  COLOUR EXCHANGE MECHANISM TO FORM STRINGS.
+C
+C  POSSIBILITY OF DIQUARK BREAKUP, LEADING TO MULTI-STRINGS, LIKE
+C  A FORWARD QUARK LINKED VIA TWO (!) STRINGS TO TWO BACKWARD
+C  QUARKS (DOUBLE-STRING). SUCH STRINGS FRAGMENT DIFFERENTLY THAN
+C  QUARK-DIQUARK STRINGS. IN CASE OF THE DOUBLE-STRING, THE FORWARD
+C  QUARK WILL FRAGMENT VIA TWO BREAKS INTO A LEADING BARYON.
+C
+C  SOPHISTICATED FRAGMENTATION PROCEDURE. SINCE SPACE-TIME
+C  EVOLUTION IS AN IMPORTANT ISSUE CONCERNING FINAL STATE INTER-
+C  ACTIONS, IT IS NOT ENOUGH TO HAVE A FRAGMENTATION MODEL WHICH
+C  WORKS, IT SHOULD HAVE THE RIGHT SPACE-TIME DESCRIPTION! THERE-
+C  FOR THE FIELD-FEYNMAN MODEL OF EARLIER VERSIONS (<3.00) HAS BEEN
+C  ABANDONED AND REPLACED BY A VERY POWERFUL AND APPEALING PROCEDURE
+C  SUGGESTED BY ARTRU/MENNESSIER.
+C
+C  VERY LARGE RESONANCE TABLE, INCLUDING FOR EXAMPLE ALL NUCLEON
+C  RESONANCES UP TO 2 GEV. THE DECAY TABLE INCLUDES ALSO KSHORT
+C  AND LAMBDA DECAYS. DECAY SUPPRESSION IS GOVERNED BY THE PARAMETERS
+C  'NDECAY' AND 'NDECAX'. SETTING 'NDECAY' TO 1 SUPPRESSES ALL DECAYS.
+C  FOR FURTHER DETAILS SEARCH FOR 'DECAY SUPPRESSION' IN SUBR. AINITL
+C
+C  FOR VERSION >= 4.01, WE USE GRIBOVS CUT-POMERON PROBABILITIES TO
+C  DETERMINE THE WEIGHTS FOR MULTI-COLOUR-EXCHANGE.
+C
+C-----------------------------------------------------------------------
+C
+C   PARTICLE ID (SAME AS ISAJET - SEE ISAJET.DOC, F.E.PAIGE)
+C   --------------------------------------------------------
+C
+C  QUARKS AND LEPTONS ARE NUMBERED IN ORDER OF MASS:
+C        UP=1 DN=2 ST=3 CH=4 BT=5 TP=6
+C        NUE=11 E-=12 NUM=13 MU-=14 NUT=15 TAU-=16
+C  WITH A NEGATIVE SIGN FOR ANTIPARTICLES.
+C  ARBITRARY CONVENTIONS ARE:
+C        GL=9 GM=10 KS=20 KL=-20 W+=80 Z0=90 .
+C  THE CODE FOR A MESON IS AN INTEGER +-JKL, WHERE J.LE.K ARE THE
+C  QUARKS AND L IS THE SPIN. THE SIGN IS FOR THE J QUARK.
+C  FLAVOR SINGLET MESONS ARE ORDERED BY MASS:
+C        PI0=110 ETA=220 ETAP=330 ETAC=440 .
+C  SIMILARLY, THE CODE FOR A BARYON IS A COMPOUND INTEGER +-IJKL
+C  FORMED FROM THE THREE QUARKS I,J,K AND A SPIN LABEL L=0,1.
+C  THE CODE FOR A DIQUARK IS +-IJ00.
+C
+C   LIST OF IDENT CODES:
+C
+C     IDENT     LABEL           MASS    CHARGE
+C         1     UP        .30000E+00       .67
+C        -1     UB        .30000E+00      -.67
+C         2     DN        .30000E+00      -.33
+C        -2     DB        .30000E+00       .33
+C         3     ST        .50000E+00      -.33
+C        -3     SB        .50000E+00       .33
+C         4     CH        .16000E+01       .67
+C        -4     CB        .16000E+01      -.67
+C         5     BT        .49000E+01      -.33
+C        -5     BB        .49000E+01       .33
+C         6     TP        .30000E+02       .67
+C        -6     TB        .30000E+02      -.67
+C
+C         9     GL       0.               0.00
+C
+C        10     GM       0.               0.00
+C
+C        11     NUE      0.               0.00
+C       -11     ANUE     0.               0.00
+C        12     E-        .51100E-03     -1.00
+C       -12     E+        .51100E-03      1.00
+C        13     NUM      0.               0.00
+C       -13     ANUM     0.               0.00
+C        14     MU-       .10566E+00     -1.00
+C       -14     MU+       .10566E+00      1.00
+C        15     NUT      0.               0.00
+C       -15     ANUT     0.               0.00
+C        16     TAU-      .18070E+01     -1.00
+C       -16     TAU+      .18070E+01      1.00
+C
+C        20     KS        .49767E+00      0.00
+C       -20     KL        .49767E+00      0.00
+C
+C        80     W+        SIN2W=.23       1.00
+C       -80     W-        SIN2W=.23      -1.00
+C        90     Z0        SIN2W=.23       0.00
+C
+C       110     PI0       .13496E+00      0.00
+C       120     PI+       .13957E+00      1.00
+C      -120     PI-       .13957E+00     -1.00
+C       220     ETA       .54880E+00      0.00
+C       130     K+        .49367E+00      1.00
+C      -130     K-        .49367E+00     -1.00
+C       230     K0        .49767E+00      0.00
+C      -230     AK0       .49767E+00      0.00
+C       330     ETAP      .95760E+00      0.00
+C       140     AD0       .18633E+01      0.00
+C      -140     D0        .18633E+01      0.00
+C       240     D-        .18683E+01     -1.00
+C      -240     D+        .18683E+01      1.00
+C       340     F-        .20300E+01     -1.00
+C      -340     F+        .20300E+01      1.00
+C       440     ETAC      .29760E+01      0.00
+C
+C       111     RHO0      .77000E+00      0.00
+C       121     RHO+      .77000E+00      1.00
+C      -121     RHO-      .77000E+00     -1.00
+C       221     OMEG      .78260E+00      0.00
+C       131     K*+       .88810E+00      1.00
+C      -131     K*-       .88810E+00     -1.00
+C       231     K*0       .89220E+00      0.00
+C      -231     AK*0      .89220E+00      0.00
+C       331     PHI       .10196E+01      0.00
+C       141     AD*0      .20060E+01      0.00
+C      -141     D*0       .20060E+01      0.00
+C       241     D*-       .20086E+01     -1.00
+C      -241     D*+       .20086E+01      1.00
+C       341     F*-       .21400E+01     -1.00
+C      -341     F*+       .21400E+01      1.00
+C       441     JPSI      .30970E+01      0.00
+C
+C      1120     P         .93828E+00      1.00
+C     -1120     AP        .93828E+00     -1.00
+C      1220     N         .93957E+00      0.00
+C     -1220     AN        .93957E+00      0.00
+C      1130     S+        .11894E+01      1.00
+C     -1130     AS-       .11894E+01     -1.00
+C      1230     S0        .11925E+01      0.00
+C     -1230     AS0       .11925E+01      0.00
+C      2130     L         .11156E+01      0.00
+C     -2130     AL        .11156E+01      0.00
+C      2230     S-        .11974E+01     -1.00
+C     -2230     AS+       .11974E+01      1.00
+C      1330     XI0       .13149E+01      0.00
+C     -1330     AXI0      .13149E+01      0.00
+C      2330     XI-       .13213E+01     -1.00
+C     -2330     AXI+      .13213E+01      1.00
+C      1140     SC++      .24300E+01      2.00
+C     -1140     ASC--     .24300E+01     -2.00
+C      1240     SC+       .24300E+01      1.00
+C     -1240     ASC-      .24300E+01     -1.00
+C      2140     LC+       .22600E+01      1.00
+C     -2140     ALC-      .22600E+01     -1.00
+C      2240     SC0       .24300E+01      0.00
+C     -2240     ASC0      .24300E+01      0.00
+C      1340     USC.      .25000E+01      1.00
+C     -1340     AUSC.     .25000E+01     -1.00
+C      3140     SUC.      .24000E+01      1.00
+C     -3140     ASUC.     .24000E+01     -1.00
+C      2340     DSC.      .25000E+01      0.00
+C     -2340     ADSC.     .25000E+01      0.00
+C      3240     SDC.      .24000E+01      0.00
+C     -3240     ASDC.     .24000E+01      0.00
+C      3340     SSC.      .26000E+01      0.00
+C     -3340     ASSC.     .26000E+01      0.00
+C      1440     UCC.      .35500E+01      2.00
+C     -1440     AUCC.     .35500E+01     -2.00
+C      2440     DCC.      .35500E+01      1.00
+C     -2440     ADCC.     .35500E+01     -1.00
+C      3440     SCC.      .37000E+01      1.00
+C     -3440     ASCC.     .37000E+01     -1.00
+C
+C      1111     DL++      .12320E+01      2.00
+C     -1111     ADL--     .12320E+01     -2.00
+C      1121     DL+       .12320E+01      1.00
+C     -1121     ADL-      .12320E+01     -1.00
+C      1221     DL0       .12320E+01      0.00
+C     -1221     ADL0      .12320E+01      0.00
+C      2221     DL-       .12320E+01     -1.00
+C     -2221     ADL+      .12320E+01      1.00
+C      1131     S*+       .13823E+01      1.00
+C     -1131     AS*-      .13823E+01     -1.00
+C      1231     S*0       .13820E+01      0.00
+C     -1231     AS*0      .13820E+01      0.00
+C      2231     S*-       .13875E+01     -1.00
+C     -2231     AS*+      .13875E+01      1.00
+C      1331     XI*0      .15318E+01      0.00
+C     -1331     AXI*0     .15318E+01      0.00
+C      2331     XI*-      .15350E+01     -1.00
+C     -2331     AXI*+     .15350E+01      1.00
+C      3331     OM-       .16722E+01     -1.00
+C     -3331     AOM+      .16722E+01      1.00
+C      1141     UUC*      .26300E+01      2.00
+C     -1141     AUUC*     .26300E+01     -2.00
+C      1241     UDC*      .26300E+01      1.00
+C     -1241     AUDC*     .26300E+01     -1.00
+C      2241     DDC*      .26300E+01      0.00
+C     -2241     ADDC*     .26300E+01      0.00
+C      1341     USC*      .27000E+01      1.00
+C     -1341     AUSC*     .27000E+01     -1.00
+C      2341     DSC*      .27000E+01      0.00
+C     -2341     ADSC*     .27000E+01      0.00
+C      3341     SSC*      .28000E+01      0.00
+C     -3341     ASSC*     .28000E+01      0.00
+C      1441     UCC*      .37500E+01      2.00
+C     -1441     AUCC*     .37500E+01     -2.00
+C      2441     DCC*      .37500E+01      1.00
+C     -2441     ADCC*     .37500E+01     -1.00
+C      3441     SCC*      .39000E+01      1.00
+C     -3441     ASCC*     .39000E+01     -1.00
+C      4441     CCC*      .48000E+01      2.00
+C     -4441     ACCC*     .48000E+01     -2.00
+C-----------------------------------------------------------------------
+C
+C   LIST OF SUBROUTINES AND FUNCTIONS OF SUBROUTINE-TURBO-VERSION 4.12
+C   ------------------------------------------------------------------
+C
+C     AVENUS  HAHABS  HAPAPA  HASI    HASTFC  HASTFL  HASTFR  HASTFS
+C     HASTFW  HASTPR  HDECMP  HRESCL  IDCOMJ  IDCOMK  IDCOMP  IDDECO
+C     IDENCO  IDFLAV  IDLABL  IDMASS  IDMIX   IDQUAC  IDRES   IDRESI
+C     IDSPIN  IDTAU   IDTRA   IDTRAI  IDTRB   IDTRBI  IDTR4
+C     JAMBR1  JAMBR2  JAMFRA  JCENTD  JCENTP  JCENTR  JCLUDE  JDECA
+C     JDECAY  JDECIN  JESTPR  JETGEN  JFRADE  JINTA1  JINTA2
+C     JINTCC  JINTCE  JINTCH  JINTCL  JINTEL  JINTFP  JINTFS
+C     JINTFU  JINTPA  JRESCL  JSPLIT  LEPEXP  LEPSTR  LEPTAR
+C     NUCINI  NUCLCO  NUCOGE  NUCOLL  NUCSTR  PVJPSF
+C     RACPRO  RANSTC  RANXQ   SBET    SDENSI  SGAM    SGAU
+C     SHOPAR  SJCENT  SJCEN4  SJCGAM  SMASS   SMASSI  SMASSP  SMASST
+C     SPTF    SPTH    SPTJ    SPTQ    SSE0    SSE1    SSPLIT  SSPLIX
+C     STAA    STXD    STXS    STXU    STXUS   STXZNE  STXZPR  SVA0
+C     SVA1    UINTEG  UTACOS  UTAMNU  UTAMNX  UTAMNY  UTAMNZ  UTAMST
+C     UTAXIS  UTCHM   UTCLEA  UTHIST  UTHSEA  UTINVT  UTKSIX
+C     UTKSTR  UTLOBO  UTLOB2  UTLOC   UTMSG   UTMSGF  UTOVEL  UTPAGE
+C     UTPART  UTPCM   UTQUAF  UTQZ    UTREMB  UTREPL  UTRESM  UTREST
+C     UTROTA  UTROT2  UTSTOP  UTTAIN  UTTAIX  UTTAUS  UTTAUT  UTTUCL
+C
+C-----------------------------------------------------------------------
+C
+C   SUBROUTINE-TURBO-VERSION 4.12:
+C   ------------------------------
+C
+C     IT IS TUNED FOR FASTER CALCULATION, ESPECIALLY IF ENERGY AND
+C   TARGET ARE VARYING FROM COLLISION TO COLLISION, AS IS THE CASE IN
+C   THE DEVELOPMENT OF AN AIR SHOWER CASCADE.
+C     IT NEEDS LINKING ROUTINES FOR INPUT AND OUTPUT AND A RANDOM
+C   GENERATOR. ALL PARAMETERS MUST BE SET IN THE LINKING ROUTINES.
+C   FOR CONNECTION WITH THE AIR SHOWER PROGRAM 'CORSIKA', SUCH ROUTINES
+C   ARE AVAILABLE:
+C        RANGEN:    RANDOM GENERATOR
+C        UTQSEA:    CALC. OF SEA     QUARK STRUCTURE FUNCTION INTEGRAL
+C        UTQVAL:    CALC. OF VALENCE QUARK STRUCTURE FUNCTION INTEGRAL
+C        VENDAT:    INITIALIZATION OF PARTICLE ID TABLE
+C        VENINI:    FOR FIRST INITIALIZATION OF PARAMETERS
+C        VENLNK:    FOR INITIALIZATION OF ENERGY DEPENDENT PARAMETERS
+C        VSTORE:    TO STORE THE GENERATED SECONDARY PARTICLES
+C
+C   NOTE: THE COMMONS ARE IN GENERAL DIFFERENT FROM THE UNTUNED
+C         VENUS VERSION 4.12
+C-----------------------------------------------------------------------
+C  COPYRIGHT AND ANY OTHER APPROPRIATE LEGAL PROTECTION OF THESE
+C  COMPUTER PROGRAMS AND ASSOCIATED DOCUMENTATION RESERVED IN ALL
+C  COUNTRIES OF THE WORLD.
+C
+C  FZK WELCOMES COMMENTS CONCERNING THE VENUS CODE BUT UNDERTAKES NO
+C  OBLIGATION FOR MAINTENANCE OF THE PROGRAMS, NOR RESPONSIBILITY FOR
+C  THEIR CORRECTNESS, AND ACCEPTS NO LIABILITY WHATSOEVER RESULTING
+C  FROM THE USE OF ITS PROGRAMS.
+C=======================================================================
+
+      SUBROUTINE AVENUS
+
+C-----------------------------------------------------------------------
+C  GENERATES ONE VENUS EVENT
+C-----------------------------------------------------------------------
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      DOUBLE PRECISION SEEDC,SEEDI
+      COMMON /CSEED/   SEEDC,SEEDI
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+C-----------------------------------------------------------------------
+      ISH0=ISH
+      ISHS0=ISHSUB
+      IF ( ISHEVT .NE. 0  .AND.  NREVT+1 .NE. ISHEVT ) THEN
+        ISH=0
+        ISHSUB=0
+      ENDIF
+CDH   IF ( NREVT.EQ.0 .AND. (ISH.EQ.13.OR.ISH.EQ.14) ) CALL UTTIMT
+CDH   IF ( ISH .EQ. 14 ) CALL UTTIMA('*** AVENUS *** ')
+      IF ( ISH .EQ. 17  .OR.  ISH .GT. 92 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'AVENUS (ENTRY)'
+      ENDIF
+      IPAGE=0
+      CALL UTPAGE
+      IF ( ISH .GE. 91 )
+     *  WRITE(IFCH,113)('-',L=1,79),IPAGE,NREVT+1,SEEDC,('-',L=1,79)
+113   FORMAT(/1X,79A1/1X,I5,'.PAGE            '
+     *  ,5X,'EVT:',I4,5X,'SEEDC:',D25.15/1X,79A1/)
+      IF ( ICHOIC. EQ. 4  .OR.  ICHOIC .EQ. 5 ) GOTO 1000
+      BIMEVT=-1
+      NTEVT0=NTEVT
+3     NTEVT=NTEVT0
+2     NTEVT=NTEVT+1
+      IF     ( ICHOIC .EQ. 1 ) THEN
+        CALL JETGEN(IER)
+        IF ( IER .EQ. 1 ) GOTO 3
+      ELSEIF ( ICHOIC .EQ. 2  .OR.  ICHOIC .EQ. 3 ) THEN
+        CALL NUCOLL
+      ENDIF
+      IF ( ICHOIC .EQ. 1  .OR.  ICHOIC .EQ. 2 ) THEN
+        CALL JFRADE(IER)
+        IF ( IER. EQ. 1 ) GOTO 3
+      ENDIF
+      IF ( (ICHOIC.EQ.2 .OR. ICHOIC.EQ.3) .AND. NEVT.EQ.0 ) THEN
+        BIMEVT=-1
+        GOTO 2
+      ENDIF
+      IF ( JERR .GT. 0 ) THEN
+        CALL UTSTOP('AVENUS: JERR > 0                        ')
+      ENDIF
+      NREVT=NREVT+1
+
+1000  CONTINUE
+CDH   IF ( ISH .EQ. 14 ) CALL UTTIMA('    AVENUS F   ')
+      IF ( ISH .EQ. 17  .OR.  ISH .GT. 92 ) THEN
+        WRITE(IFCH,*)'AVENUS (EXIT)'
+      ENDIF
+      ISH=ISH0
+      ISHSUB=ISHS0
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE HAHABS(PROJ,TARG,IAP,IAT,ISKIP,IRETHH)
+
+C-----------------------------------------------------------------------
+C  PERFORMS A BASIC (ONE COLOR EXCHANGE) HADRON-HADRON COLLISION
+C-----------------------------------------------------------------------
+      PARAMETER (KOLLMX=2500)
+      PARAMETER (MAMX=56)
+      PARAMETER (MXSTR=3000)
+      PARAMETER (NDEP=129)
+      PARAMETER (NDET=129)
+      PARAMETER (NFLAV=6)
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /CKOL/    KOL
+      COMMON /CLEAD/   COOAV3,COOAV4,LEAD
+      COMMON /CNCE/    NCES,NCOLEX
+      COMMON /CNEW/    KOTRI,NEWCOL,NEWICO
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /COL/     BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
+     *                ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
+     *                ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
+     *                ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
+     *                ,XDET99(NDET)
+     *                ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
+     *                ,NRTARG(KOLLMX),NTARG
+      COMMON /CPROJA/  IPROJ,ITARG,KPROJA(NHA,MAMX),KTARGA(NHA,MAMX)
+      COMMON /CPZSTR/  ESTRL,PZSTRL,ISEA,ISTRL
+      COMMON /CSTR/    PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
+     *                ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
+      COMMON /CSTSH/   NSTSH
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      REAL      PROJ(NSI,NHA),PSUM(5),PSUMX(5)
+     *         ,SIL(NSI),SILP(NSI),SILT(NSI)
+     *         ,SIX(NSI,NSIX),SIXP(NSI,NSIX),SIXT(NSI,NSIX)
+     *         ,STRAP(NSI,NSIX+1),STRAT(NSI,NSIX+1)
+     *         ,STRLP(NSI,NSIX+1),STRLT(NSI,NSIX+1)
+     *         ,STR0(NSI,NSIX+1),TARG(NSI,NHA)
+      INTEGER   ICVP(2),ICVT(2),JCVP(NFLAV,2),JCVT(NFLAV,2)
+      CHARACTER XFLAP*3,XFLAT*3,XFLBP*3,XFLBT*3
+C-----------------------------------------------------------------------
+      R=RANGEN()
+      NTRY=0
+      IRETHH=0
+      CALL UTREMB(PROJ,TARG,2)
+      GOTO 9
+
+9994  IRET=0
+      CALL UTREST(PROJ,TARG,2)
+ 9    CONTINUE
+      DO 8 NX=1,NSIX
+        DO 8 N=1,NSI
+          SIXP(N,NX)=0.
+          SIXT(N,NX)=0.
+ 8    CONTINUE
+      CALL HDECMP(PROJ,SIL,SIX)
+      CALL UTKSIX(SIX,KMAXP)
+      CALL HDECMP(TARG,SIL,SIX)
+      CALL UTKSIX(SIX,KMAXT)
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,100) ( (PROJ(I,J),I=1,NSI), J=2,KMAXP+2 )
+100     FORMAT ( ' PROJ:',4F13.5,2F8.0/,20('      ',4F13.5,2F8.0/) )
+        WRITE(IFCH,102) ( (TARG(I,J),I=1,NSI), J=2,KMAXT+2 )
+102     FORMAT ( ' TARG:',4F13.5,2F8.0/,50('      ',4F13.5,2F8.0/) )
+      ENDIF
+      IF ( ISKIP .EQ. 1 ) GOTO 9999
+
+9997  CALL HDECMP(PROJ,SILP,SIXP)
+      CALL HDECMP(TARG,SILT,SIXT)
+ 1    ICVP(1)=NINT(PROJ(5,1))
+      ICVP(2)=NINT(PROJ(6,1))
+      ICVT(1)=NINT(TARG(5,1))
+      ICVT(2)=NINT(TARG(6,1))
+      CALL HAPAPA(SILP,IFLAP,XFLAP,PTAP,PTAHP,IFLBP,XFLBP,PTBP,PTBHP
+     *            ,NQAQP,ICVP)
+      CALL HAPAPA(SILT,IFLAT,XFLAT,PTAT,PTAHT,IFLBT,XFLBT,PTBT,PTBHT
+     *            ,NQAQT,ICVT)
+      IF ( NQAQP*NQAQT .EQ. -1 ) GOTO 1
+
+9998  NTRY=NTRY+1
+      IF ( NTRY .GT. NTRYMX+1 ) THEN
+        ISKIP=1
+        GOTO 9999
+      ENDIF
+
+      CALL HDECMP(PROJ,SILP,SIXP)
+      CALL HDECMP(TARG,SILT,SIXT)
+      CALL HASTFS(SILP,SIXP,IFLAP,XFLAP,PTAP,PTAHP
+     *            ,SILT,SIXT,IFLBT,XFLBT,PTBT,PTBHT,STRAP,IRET,1)
+      IF ( IRET .EQ. 1 ) THEN
+        ISKIP=1
+        GOTO 9999
+      ENDIF
+      IF ( IRET .EQ. 2 ) GOTO 9997
+      IF ( IRET .EQ. 3 ) THEN
+        IF ( XFLBP(1:2) .EQ. 'VA' ) XFLBP(1:2)='SE'
+        IF ( XFLAT(1:2) .EQ. 'VA' ) XFLAT(1:2)='SE'
+        IFLAT=IFLBT
+        IFLBP=IFLAP
+        GOTO 9998
+      ENDIF
+      IF ( IRET .EQ. 5 ) THEN
+        IF ( XFLAP(1:2) .EQ. 'SE'  .AND.  XFLBP(1:2) .EQ. 'SE' ) THEN
+          IFLBP=-ABS(IFLBP)
+          IFLAP=IFLBP
+        ENDIF
+        IF ( XFLAT(1:2) .EQ. 'SE'  .AND.  XFLBT(1:2) .EQ. 'SE' ) THEN
+          IFLAT=-ABS(IFLAT)
+          IFLBT=IFLAT
+        ENDIF
+        GOTO 9998
+      ENDIF
+      CALL HASTFS(SILT,SIXT,IFLAT,XFLAT,PTAT,PTAHT
+     *,SILP,SIXP,IFLBP,XFLBP,PTBP,PTBHP,STRAT,IRET,2)
+      IF ( IRET .EQ. 1 ) THEN
+        ISKIP=1
+        GOTO 9999
+      ENDIF
+      IF ( IRET .EQ. 2 ) GOTO 9997
+      IF ( IRET .EQ. 3 ) THEN
+        IF ( XFLAP(1:2) .EQ. 'VA' ) XFLAP(1:2)='SE'
+        IF ( XFLBT(1:2) .EQ. 'VA' ) XFLBT(1:2)='SE'
+        IFLBT=IFLAT
+        IFLAP=IFLBP
+        GOTO 9998
+      ENDIF
+      IF ( IRET .EQ. 5 ) THEN
+        IF ( XFLAP(1:2) .EQ. 'SE'  .AND.  XFLBP(1:2) .EQ. 'SE' ) THEN
+          IFLAP=-ABS(IFLAP)
+          IFLBP=IFLAP
+        ENDIF
+        IF ( XFLAT(1:2) .EQ. 'SE'  .AND.  XFLBT(1:2) .EQ. 'SE' ) THEN
+          IFLBT=-ABS(IFLBT)
+          IFLAT=IFLBT
+        ENDIF
+        GOTO 9998
+      ENDIF
+
+      CALL HASTFC(SILP,SIXP,IRET)
+      IF     ( IRET .EQ. 0 ) THEN
+        CALL HASTFC(SILT,SIXT,IRET)
+      ELSEIF ( IRET .EQ. 1 ) THEN
+        IF ( ISH .GE. 91 ) WRITE(IFCH,*)'LIGHT STRING --> REDO HASTFS'
+        GOTO 9998
+      ELSEIF ( IRET .EQ. 2 ) THEN
+        IF ( ISH .GE. 91 ) WRITE(IFCH,*)'JC>9 --> REDO HAPAPA'
+        GOTO 9997
+      ENDIF
+
+9999  CONTINUE
+      IF ( ISKIP .EQ. 1 ) THEN
+        COLEVT=COLEVT-1./NCOLEX
+        CALL HDECMP(PROJ,SILP,SIXP)
+        CALL HDECMP(TARG,SILT,SIXT)
+        IF ( ISH .GE. 91 ) THEN
+          WRITE(IFCH,*)'SKIP'
+          CALL HASTFW(SILP,SIXP)
+          CALL HASTFW(SILT,SIXT)
+        ENDIF
+      ENDIF
+
+      CALL HASTFL(SILP,SIXP,STRLP)
+      CALL HASTFL(SILT,SIXT,STRLT)
+
+      IF ( ISKIP .EQ. 1 ) GOTO 9995
+
+      CALL IDDECO(ICVP,JCVP)
+      CALL IDDECO(ICVT,JCVT)
+      IF ( XFLAP(1:2).EQ.'VA') JCVP(IABS(IFLAP),1)=JCVP(IABS(IFLAP),1)-1
+      IF ( XFLBP(1:2).EQ.'VA') JCVP(IABS(IFLBP),2)=JCVP(IABS(IFLBP),2)-1
+      IF ( XFLAT(1:2).EQ.'VA') JCVT(IABS(IFLAT),1)=JCVT(IABS(IFLAT),1)-1
+      IF ( XFLBT(1:2).EQ.'VA') JCVT(IABS(IFLBT),2)=JCVT(IABS(IFLBT),2)-1
+      CALL IDENCO(JCVP,ICVP,IRETEN)
+      IF ( IRETEN .EQ. 1 ) THEN
+        CALL UTSTOP('HAPAPA: IDENCO RET CODE = 1             ')
+      ENDIF
+      CALL IDENCO(JCVT,ICVT,IRETEN)
+      IF ( IRETEN .EQ. 1 ) THEN
+        CALL UTSTOP('HAPAPA: IDENCO RET CODE = 1             ')
+      ENDIF
+
+      PROJ(5,1)=ICVP(1)
+      PROJ(6,1)=ICVP(2)
+      TARG(5,1)=ICVT(1)
+      TARG(6,1)=ICVT(2)
+      CALL UTKSIX(SIXP,KMAXPN)
+      CALL UTKSIX(SIXT,KMAXTN)
+      IF ( KMAXPN+1 .GT. NSIX ) THEN
+        CALL UTSTOP('HAHABS: DIMENSION NSIX TOO SMALL        ')
+      ENDIF
+      IF ( KMAXTN+1 .GT. NSIX ) THEN
+        CALL UTSTOP('HAHABS: DIMENSION NSIX TOO SMALL        ')
+      ENDIF
+      KMXP=KMAXPN+1
+      KMXT=KMAXTN+1
+      DO 5 N=1,NSI
+        PROJ(N,2)=STRLP(N,1)
+        TARG(N,2)=STRLT(N,1)
+        DO 6 J=1,KMXP
+          PROJ(N,2+J)=SIXP(N,J)
+ 6      CONTINUE
+        DO 7 J=1,KMXT
+          TARG(N,2+J)=SIXT(N,J)
+ 7      CONTINUE
+        KPROJA(2,IPROJ)=KOL
+        IF ( KMAXPN .GT. KMAXP ) THEN
+          DO 2 K=KMAXP+1,KMAXPN
+            KPROJA(2+K,IPROJ)=KOL
+ 2        CONTINUE
+        ENDIF
+        KTARGA(2,ITARG)=KOL
+        IF ( KMAXTN .GT. KMAXT ) THEN
+          DO 3 K=KMAXT+1,KMAXTN
+            KTARGA(2+K,ITARG)=KOL
+ 3        CONTINUE
+        ENDIF
+ 5    CONTINUE
+
+      NSTSH=0
+      LEAD=0
+      ISPLT=0
+11    CALL HASTPR(STRAP,ISPLT)
+      IF ( ISPLT .NE. 0 ) THEN
+        CALL UTSTOP('HAHABS: ISPLT /= 0                      ')
+      ENDIF
+      ISPLT=0
+12    CALL HASTPR(STRAT,ISPLT)
+      IF ( ISPLT .NE. 0 ) THEN
+        CALL UTSTOP('HAHABS: ISPLT /= 0                      ')
+      ENDIF
+
+      IF ( KMAXPN .GT. KMAXP ) THEN
+        PROJ(3,1)=PROJ(3,1)+COORD(3,KOL)
+        PROJ(4,1)=PROJ(4,1)+COORD(4,KOL)
+      ENDIF
+      IF ( KMAXTN .GT. KMAXT ) THEN
+        TARG(3,1)=TARG(3,1)+COORD(3,KOL)
+        TARG(4,1)=TARG(4,1)+COORD(4,KOL)
+      ENDIF
+      KMAXP=KMAXPN
+      KMAXT=KMAXTN
+
+9995  LEAD=1
+
+C  WRITE LEADING STRING (PROJ)
+C  ---------------------------
+
+      IF ( IAP .EQ. 1 ) THEN
+
+        IF ( KMAXP .GT. 0 ) THEN
+          COOAV3=PROJ(3,1)/KMAXP
+          COOAV4=PROJ(4,1)/KMAXP
+        ELSE
+          COOAV3=COORD(3,KOL)
+          COOAV4=COORD(4,KOL)
+        ENDIF
+        CALL UTKSTR(STRLP,KMAXOR)
+        PZSTRL=0.
+        ESTRL=0.
+        ISEA=1
+        PSUM(1)=0.
+        PSUM(2)=0.
+        PSUM(3)=0.
+        PSUM(4)=0.
+        DO 22 K=1,KMAXOR
+          PSUM(1)=PSUM(1)+STRLP(1,K)
+          PSUM(2)=PSUM(2)+STRLP(2,K)
+          PSUM(3)=PSUM(3)+STRLP(3,K)
+          PSUM(4)=PSUM(4)+STRLP(4,K)
+          AMPR=0.
+C-C       IF ( K .EQ. 1 ) AMPR=.94
+          PZSTRL=PZSTRL+STRLP(3,K)
+          ESTRL=ESTRL+SQRT(STRLP(4,K)**2+AMPR**2)
+          IF (K.GE.2.AND.STRLP(5,K).GT.0..AND.STRLP(6,K).GT.0.) ISEA=0
+22      CONTINUE
+        PSUM(5)=PSUM(4)**2-PSUM(3)**2-PSUM(2)**2-PSUM(1)**2
+        IF ( PSUM(5) .GT. 0. ) PSUM(5)=SQRT(PSUM(5))
+        IF ( PZSTRL/PNLLX.GT.1.-0.850/ENGY**2.AND.ISKIP.NE.1 ) GOTO 1002
+        ISTRL=0
+        IF ( NSTSH .EQ. 0 .AND. ISEA .EQ. 1  .AND.
+     *                     PZSTRL/PNLLX .GT. 1.-10.000/ENGY**2 ) ISTRL=1
+        DO 23 K=1,KMAXOR
+          DO 23 I=1,NSI
+            STR0(I,K)=STRLP(I,K)
+23      CONTINUE
+        NSTR0=NSTR
+17      NSTR=NSTR0
+        ISPLT=0
+15      CONTINUE
+        DO 24 K=1,KMAXOR
+          DO 24 I=1,NSI
+            STRLP(I,K)=STR0(I,K)
+24      CONTINUE
+13      CALL HASTPR(STRLP,ISPLT)
+        IF     ( ISPLT .EQ. -1 ) THEN
+          IF ( ISKIP .EQ. 1 ) GOTO 9996
+          GOTO 9994
+        ELSEIF ( ISPLT .EQ. -3 ) THEN
+          GOTO 15
+        ELSEIF ( ISPLT .EQ. -4 ) THEN
+          GOTO 1001
+        ELSEIF ( ISPLT .EQ. -5 ) THEN
+          GOTO 17
+        ELSEIF ( ISPLT .GT. 0 ) THEN
+          GOTO 13
+        ENDIF
+        IF ( NSTR .GT. NSTR0+1 ) THEN
+          PSUMX(1)=0.
+          PSUMX(2)=0.
+          PSUMX(3)=0.
+          PSUMX(4)=0.
+          DO 25 J=NSTR0+1,NSTR
+            PSUMX(1)=PSUMX(1)+PSTR(1,J)
+            PSUMX(2)=PSUMX(2)+PSTR(2,J)
+            PSUMX(3)=PSUMX(3)+PSTR(3,J)
+            PSUMX(4)=PSUMX(4)+PSTR(4,J)
+25        CONTINUE
+          PSUMX(5)=PSUMX(4)**2-PSUMX(3)**2-PSUMX(2)**2-PSUMX(1)**2
+          IF ( PSUMX(5) .GT. 0. ) PSUMX(5)=SQRT(PSUMX(5))
+C-C       WRITE(6,*)' '
+C-C       DO 26 J=NSTR0+1,NSTR
+C-C       WRITE(6,109) J,(ICSTR(K,J)/100,K=1,4)
+C-C  *      ,SQRT(PSTR(1,J)**2+PSTR(2,J)**2),PSTR(3,J)/PNLLX,PSTR(5,J)
+C-C  *      ,IRLSTR(J)
+C-C26     CONTINUE
+C-C       WRITE(6,*)PSUM
+C-C       WRITE(6,*)PSUMX
+          DO 27 J=NSTR0+1,NSTR
+            PSTR(1,J+NSTR-NSTR0)=PSTR(1,J)
+            PSTR(2,J+NSTR-NSTR0)=PSTR(2,J)
+            PSTR(3,J+NSTR-NSTR0)=PSTR(3,J)
+            PSTR(4,J+NSTR-NSTR0)=PSTR(4,J)
+27        CONTINUE
+          CALL HRESCL(NSTR0+1,NSTR,PSUM,IFAIL)
+          IF ( IFAIL .GT. 0 ) THEN
+C-C         WRITE(6,*)'RESCALE FAILED'
+            DO 28 J=NSTR0+1,NSTR
+              PSTR(1,J)=PSTR(1,J+NSTR-NSTR0)
+              PSTR(2,J)=PSTR(2,J+NSTR-NSTR0)
+              PSTR(3,J)=PSTR(3,J+NSTR-NSTR0)
+              PSTR(4,J)=PSTR(4,J+NSTR-NSTR0)
+28          CONTINUE
+          ENDIF
+          PSUMX(1)=0.
+          PSUMX(2)=0.
+          PSUMX(3)=0.
+          PSUMX(4)=0.
+          DO 29 J=NSTR0+1,NSTR
+            PSUMX(1)=PSUMX(1)+PSTR(1,J)
+            PSUMX(2)=PSUMX(2)+PSTR(2,J)
+            PSUMX(3)=PSUMX(3)+PSTR(3,J)
+            PSUMX(4)=PSUMX(4)+PSTR(4,J)
+29        CONTINUE
+          PSUMX(5)=PSUMX(4)**2-PSUMX(3)**2-PSUMX(2)**2-PSUMX(1)**2
+          IF ( PSUMX(5) .GT. 0. ) PSUMX(5)=SQRT(PSUMX(5))
+C-C       DO 30 J=NSTR0+1,NSTR
+C-C       WRITE(6,109) J,(ICSTR(K,J)/100,K=1,4)
+C-C  *      ,SQRT(PSTR(1,J)**2+PSTR(2,J)**2),PSTR(3,J)/PNLLX,PSTR(5,J)
+C-C  *      ,IRLSTR(J)
+C-C30     CONTINUE
+C-C       WRITE(6,*)PSUM
+C-C       WRITE(6,*)PSUMX
+109       FORMAT(' /CSTR/',I4,3X,4I5,2X,3(E10.3),I4)
+        ENDIF
+
+      ENDIF
+
+C  WRITE LEADING STRING (TARG)
+C  ---------------------------
+
+      IF ( IAT .EQ. 1 ) THEN
+
+        IF ( KMAXT .GT. 0 ) THEN
+          COOAV3=TARG(3,1)/KMAXT
+          COOAV4=TARG(4,1)/KMAXT
+        ELSE
+          COOAV3=COORD(3,KOL)
+          COOAV4=COORD(4,KOL)
+        ENDIF
+        CALL UTKSTR(STRLT,KMAXOR)
+        PZSTRL=0.
+        ESTRL=0.
+        ISEA=1
+        PSUM(1)=0.
+        PSUM(2)=0.
+        PSUM(3)=0.
+        PSUM(4)=0.
+        DO 33 K=1,KMAXOR
+          PSUM(1)=PSUM(1)+STRLT(1,K)
+          PSUM(2)=PSUM(2)+STRLT(2,K)
+          PSUM(3)=PSUM(3)+STRLT(3,K)
+          PSUM(4)=PSUM(4)+STRLT(4,K)
+          AMPR=0.
+C-C       IF ( K .EQ. 1 ) AMPR=.94
+          PZSTRL=PZSTRL+STRLT(3,K)
+          ESTRL=ESTRL+SQRT(STRLT(4,K)**2+AMPR**2)
+          IF ( K.GE.2.AND.STRLT(5,K).GT.0..AND.STRLT(6,K).GT.0. ) ISEA=0
+33      CONTINUE
+        PSUM(5)=PSUM(4)**2-PSUM(3)**2-PSUM(2)**2-PSUM(1)**2
+        IF ( PSUM(5) .GT. 0. ) PSUM(5)=SQRT(PSUM(5))
+        IF ( -PZSTRL/PNLLX.GT.1.-0.850/ENGY**2.AND.ISKIP.NE.1 )GOTO 1002
+        ISTRL=0
+        IF ( NSTSH .EQ. 0  .AND.  ISEA .EQ. 1 .AND.
+     *                 -PZSTRL/PNLLX .GT. 1.-10.000/ENGY**2 ) ISTRL=1
+        DO 34 K=1,KMAXOR
+          DO 34 I=1,NSI
+            STR0(I,K)=STRLT(I,K)
+34      CONTINUE
+        NSTR0=NSTR
+18      NSTR=NSTR0
+        ISPLT=0
+16      CONTINUE
+        DO 35 K=1,KMAXOR
+          DO 35 I=1,NSI
+            STRLT(I,K)=STR0(I,K)
+35      CONTINUE
+14      CALL HASTPR(STRLT,ISPLT)
+        IF     ( ISPLT .EQ. -1 ) THEN
+           IF ( ISKIP .EQ. 1 ) GOTO 9996
+           GOTO 9994
+        ELSEIF ( ISPLT .EQ. -3 ) THEN
+          GOTO 16
+        ELSEIF ( ISPLT .EQ. -4 ) THEN
+          GOTO 1001
+        ELSEIF ( ISPLT .EQ. -5 ) THEN
+          GOTO 18
+        ELSEIF ( ISPLT .GT.  0 ) THEN
+          GOTO 14
+        ENDIF
+        IF ( NSTR .GT. NSTR0+1 ) THEN
+          PSUMX(1)=0.
+          PSUMX(2)=0.
+          PSUMX(3)=0.
+          PSUMX(4)=0.
+          DO 36 J=NSTR0+1,NSTR
+            PSUMX(1)=PSUMX(1)+PSTR(1,J)
+            PSUMX(2)=PSUMX(2)+PSTR(2,J)
+            PSUMX(3)=PSUMX(3)+PSTR(3,J)
+            PSUMX(4)=PSUMX(4)+PSTR(4,J)
+36        CONTINUE
+          PSUMX(5)=PSUMX(4)**2-PSUMX(3)**2-PSUMX(2)**2-PSUMX(1)**2
+          IF ( PSUMX(5) .GT. 0. ) PSUMX(5)=SQRT(PSUMX(5))
+C-C       WRITE(6,*)' '
+C-C       DO 37 J=NSTR0+1,NSTR
+C-C       WRITE(6,109) J,(ICSTR(K,J)/100,K=1,4)
+C-C  *      ,SQRT(PSTR(1,J)**2+PSTR(2,J)**2),PSTR(3,J)/PNLLX,PSTR(5,J)
+C-C  *      ,IRLSTR(J)
+C-C37     CONTINUE
+C-C       WRITE(6,*)PSUM
+C-C       WRITE(6,*)PSUMX
+          DO 38 J=NSTR0+1,NSTR
+            PSTR(1,J+NSTR-NSTR0)=PSTR(1,J)
+            PSTR(2,J+NSTR-NSTR0)=PSTR(2,J)
+            PSTR(3,J+NSTR-NSTR0)=PSTR(3,J)
+            PSTR(4,J+NSTR-NSTR0)=PSTR(4,J)
+38        CONTINUE
+          CALL HRESCL(NSTR0+1,NSTR,PSUM,IFAIL)
+          IF ( IFAIL .GT. 0 ) THEN
+C-C         WRITE(6,*)'RESCALE FAILED'
+            DO 39 J=NSTR0+1,NSTR
+              PSTR(1,J)=PSTR(1,J+NSTR-NSTR0)
+              PSTR(2,J)=PSTR(2,J+NSTR-NSTR0)
+              PSTR(3,J)=PSTR(3,J+NSTR-NSTR0)
+              PSTR(4,J)=PSTR(4,J+NSTR-NSTR0)
+39          CONTINUE
+          ENDIF
+          PSUMX(1)=0.
+          PSUMX(2)=0.
+          PSUMX(3)=0.
+          PSUMX(4)=0.
+          DO 40 J=NSTR0+1,NSTR
+            PSUMX(1)=PSUMX(1)+PSTR(1,J)
+            PSUMX(2)=PSUMX(2)+PSTR(2,J)
+            PSUMX(3)=PSUMX(3)+PSTR(3,J)
+            PSUMX(4)=PSUMX(4)+PSTR(4,J)
+40        CONTINUE
+          PSUMX(5)=PSUMX(4)**2-PSUMX(3)**2-PSUMX(2)**2-PSUMX(1)**2
+          IF ( PSUMX(5) .GT. 0. ) PSUMX(5)=SQRT(PSUMX(5))
+C-C       DO 41 J=NSTR0+1,NSTR
+C-C       WRITE(6,109) J,(ICSTR(K,J)/100,K=1,4)
+C-C  *      ,SQRT(PSTR(1,J)**2+PSTR(2,J)**2),PSTR(3,J)/PNLLX,PSTR(5,J)
+C-C  *      ,IRLSTR(J)
+C-C41     CONTINUE
+C-C       WRITE(6,*)PSUM
+C-C       WRITE(6,*)PSUMX
+        ENDIF
+
+      ENDIF
+
+C  EXIT
+C  ----
+
+      IF ( ISH .LT. 91 ) RETURN
+
+      WRITE(IFCH,100) ( (PROJ(I,J),I=1,NSI), J=2,KMAXP+2 )
+      WRITE(IFCH,102) ( (TARG(I,J),I=1,NSI), J=2,KMAXT+2 )
+101   FORMAT ( '  ',I3,'. TRIAL')
+      RETURN
+
+9996  CONTINUE
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'SKIP IMPOSSIBLE, STRL CANT BE STORED'
+      ENDIF
+      ISKIP=2
+      RETURN
+
+1001  CONTINUE
+        IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)
+     *      'SR HAHABS: NOT JUSTIFIED COMPLETE ABSORPTION -> IRETHH=1'
+      ENDIF
+      IRETHH=1
+      IF ( ISKIP .EQ. 1 ) GOTO 9996
+      RETURN
+
+1002  CONTINUE
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'SR HAHABS: TOO FAST MULTI-STRING -> IRETHH=1'
+      ENDIF
+      IRETHH=1
+      IF ( ISKIP .EQ. 1 ) THEN
+        CALL UTSTOP('HAHABS: ISKIP=1 SHOULD NOT HAPPEN       ')
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE HAPAPA(SIL,IFLA,XFLA,PTA,PTAH,IFLB,XFLB,PTB,PTBH,NQAQ
+     *,ICV)
+
+C-----------------------------------------------------------------------
+C  DETERMINES MOMENTA AND FLAVOR OF PARTICIPATING PARTONS IN A HADRON
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      PARAMETER (NPTQ=129)
+      PARAMETER (NSI=6)
+      PARAMETER (NSTRU=2049)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /CNEW/    KOTRI,NEWCOL,NEWICO
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CPTQ/    QPTH(NPTQ),QPTQ(NPTQ),XPTQ(NPTQ),QPTQMX,QPTHMX
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      REAL      PROBAB(NFLAV),PROBSU(NFLAV+1),SIL(NSI)
+      INTEGER   ICV(2),ID(2),JC(NFLAV,2),JCV(NFLAV,2)
+      CHARACTER CHPT*1,XFLA*3,XFLB*3
+C-----------------------------------------------------------------------
+      SGN=SIGN(1.,SIL(3))
+      IF     ( SGN .GT. 0. ) THEN
+        QVALC=QVAPC
+        QSEAC=QSEPC
+        CHPT='P'
+        W=WPROJ
+      ELSE
+        QVALC=QVATC
+        QSEAC=QSETC
+        CHPT='T'
+        W=WTARG
+      ENDIF
+      CALL IDDECO(ICV,JCV)
+      NVQ=0
+      NVA=0
+      DO 12 I=1,NFLAV
+        IF ( ISH.GE.0  .AND.  (JCV(I,1).LT.0.OR.JCV(I,2).LT.0) ) THEN
+          CALL UTMSG('HAHABS')
+          WRITE(IFCH,*)'*****  NEGATIVE JCV'
+          WRITE(IFCH,*)'JCV:'
+          WRITE(IFCH,*)JCV
+          CALL UTMSGF
+        ENDIF
+        NVQ=NVQ+JCV(I,1)
+        NVA=NVA+JCV(I,2)
+12    CONTINUE
+      ID(1)=NINT(SIL(4+1))
+      ID(2)=NINT(SIL(4+2))
+      CALL IDDECO(ID,JC)
+      NQU=0
+      NAQ=0
+      DO 11 I=1,NFLAV
+        NQU=NQU+JC(I,1)
+        NAQ=NAQ+JC(I,2)
+11    CONTINUE
+      NEQ=NQU-NAQ
+
+C  DETERMINE NQAQ,IVAL1,IVAL2
+C  --------------------------
+      NQAQ=0
+      IVAL=0
+      IF ( RANGEN() .GT. W ) THEN
+        IF ( NEQ .GT. NEQMN ) THEN
+          PQ=1.
+        ELSE
+          PQ=0.
+        ENDIF
+        IF ( NEQ .LT. NEQMX ) THEN
+          PA=1.
+        ELSE
+          PA=0.
+        ENDIF
+        SUM=(NVQ*PQ+NVA*PA*IAQU)*QVALC+QSEAC*.5*(PQ+PA*IAQU)
+        IF ( SUM .EQ. 0. ) GOTO 14
+        SUMI = 1./SUM
+        PVQ=NVQ*PQ*QVALC*SUMI
+        PVA=NVA*PA*IAQU*QVALC*SUMI
+        PSQ=.5*PQ*QSEAC*SUMI
+        PSA=.5*PA*IAQU*QSEAC*SUMI
+        R=RANGEN()
+        IF ( R .LT. PVQ+PVA ) IVAL=1
+        NQAQ=-1
+        IF ( IVAL .EQ. 1  .AND.  R .LT. PVQ ) NQAQ=1
+        IF ( IVAL .EQ. 0  .AND.  R .LT. PVQ+PVA+PSQ ) NQAQ=1
+        IF ( NQU-NAQ-NQAQ .LT. NEQMN ) THEN
+          IF ( ISH .GE. 90 ) THEN
+            CALL UTMSG('HAPAPA')
+            WRITE(IFCH,*)'*****  NEQ < NEQMN'
+            WRITE(IFCH,*)'PVQ/A PSQ/A:',PVQ,PVA,PSQ,PSA
+            WRITE(IFCH,*)'NQAQ:',NQAQ
+            CALL UTMSGF
+          ENDIF
+          NQAQ=0
+        ENDIF
+        IF ( NQU-NAQ-NQAQ .GT. NEQMX ) THEN
+          IF ( ISH .GE. 90 ) THEN
+            IF ( ISH .GE. 91 ) WRITE(IFCH,*)' '
+            CALL UTMSG('HAPAPA')
+            WRITE(IFCH,*)'*****  NEQ > NEQMX'
+            WRITE(IFCH,*)'PVQ/A PSQ/A:',PVQ,PVA,PSQ,PSA
+            WRITE(IFCH,*)'NQAQ:',NQAQ
+            IF ( ISH .GE. 91 ) WRITE(IFCH,*)' '
+          ENDIF
+          NQAQ=0
+        ENDIF
+        IF ( NQU-NAQ-NQAQ .LT. NEQMN ) THEN
+          CALL UTSTOP('HAPAPA: NEQ.LT.NEQMN                    ')
+        ENDIF
+        IF ( NQU-NAQ-NQAQ .GT. NEQMX ) THEN
+          CALL UTSTOP('HAPAPA: NEQ.GT.NEQMX                    ')
+        ENDIF
+      ENDIF
+14    CONTINUE
+      IVAL1=IVAL
+      IVAL2=IVAL
+      IF ( NQAQ .EQ. 0 ) THEN
+        IVAL1=0
+        SUM=NVQ*QVALC+QSEAC*.5
+        IF ( SUM .EQ. 0. ) GOTO 15
+        SUMI = 1./SUM
+        PVQ=NVQ*QVALC*SUMI
+        PSQ=.5*QSEAC*SUMI
+        R=RANGEN()
+        IF ( R .LT. PVQ ) IVAL1=1
+15      CONTINUE
+C-C     IF ( NVQ.GT.0  .AND.  RANGEN().LT.PVALEN ) IVAL1=1
+        IVAL2=0
+        SUM=NVA*IAQU*QVALC+QSEAC*.5*IAQU
+        IF ( SUM .EQ. 0. ) GOTO 16
+        SUMI = 1./SUM
+        PVA=NVA*IAQU*QVALC*SUMI
+        PSA=.5*IAQU*QSEAC*SUMI
+        R=RANGEN()
+        IF ( R .LT. PVA ) IVAL2=1
+16      CONTINUE
+C-C     IF ( NVA.GT.0 .AND. RANGEN().LT.PVALEN ) IVAL2=1
+        IF ( IVAL1 .EQ. 1  .AND. IVAL2 .EQ. 1 ) THEN
+          R=RANGEN()
+          IF ( R .LT. 0.5 ) THEN
+            IVAL1=0
+          ELSE
+            IVAL2=0
+          ENDIF
+        ENDIF
+      ENDIF
+
+C  QUARK
+C  -----
+      XFLA='---'
+      IF ( NQAQ .GE. 0 ) THEN
+        IF ( IVAL1 .EQ. 1 ) THEN
+          PROBAB(1)=JCV(1,1)
+          PROBAB(2)=JCV(2,1)
+          PROBAB(3)=JCV(3,1)
+          PROBAB(4)=JCV(4,1)
+          SU=PROBAB(1)+PROBAB(2)+PROBAB(3)+PROBAB(4)
+          XFLA='VA'//CHPT
+        ELSE
+          PROBAB(1)=1.
+          PROBAB(2)=1.
+          PROBAB(3)=RSTRAS
+          PROBAB(4)=0.
+          SU=2.+PROBAB(3)
+          XFLA='SE'//CHPT
+        ENDIF
+        PROBSU(1)=0.
+        PROBSU(2)=1./SU*PROBAB(1)
+        PROBSU(3)=1./SU*PROBAB(2)+PROBSU(2)
+        PROBSU(4)=1./SU*PROBAB(3)+PROBSU(3)
+        PROBSU(5)=1./SU*PROBAB(4)+PROBSU(4)
+        R=RANGEN()
+        IF     ( R .LE. PROBSU(2) ) THEN
+          IFLA=1
+        ELSEIF ( R .LE. PROBSU(3) ) THEN
+          IFLA=2
+        ELSEIF ( R .LE. PROBSU(4) ) THEN
+          IFLA=3
+        ELSE
+          IFLA=4
+        ENDIF
+        R=RANGEN()
+        IF     ( IOPTQ .EQ. 2 ) THEN
+          PTA = SQRT( -4.*PTQ**2/PI * LOG(1.-R*QPTQMX) )
+        ELSEIF ( IOPTQ .EQ. 3 ) THEN
+          PTA = PTQ*SQRT( QPTQMX*R/(1.-QPTQMX*R) )
+        ELSE
+          PTA=UTINVT(NPTQ,XPTQ,QPTQ,R*QPTQ(NPTQ))
+        ENDIF
+        PTAH=PTH*SQRT( 1./SQRT(1.-2.*PTH**2*RANGEN()*QPTHMX) - 1. )
+      ENDIF
+
+C  ANTIQUARK
+C  ---------
+      XFLB='---'
+      IF ( NQAQ .LE. 0 ) THEN
+        IF ( IVAL2 .EQ. 1 ) THEN
+          PROBAB(1)=JCV(1,2)
+          PROBAB(2)=JCV(2,2)
+          PROBAB(3)=JCV(3,2)
+          PROBAB(4)=JCV(4,2)
+          SU=PROBAB(1)+PROBAB(2)+PROBAB(3)+PROBAB(4)
+          XFLB='VA'//CHPT
+        ELSE
+          PROBAB(1)=1.
+          PROBAB(2)=1.
+          PROBAB(3)=RSTRAS
+          SU=2.+RSTRAS
+          PROBAB(4)=0.
+          XFLB='SE'//CHPT
+        ENDIF
+        PROBSU(1)=0.
+        PROBSU(2)=1./SU*PROBAB(1)
+        PROBSU(3)=1./SU*PROBAB(2)+PROBSU(2)
+        PROBSU(4)=1./SU*PROBAB(3)+PROBSU(3)
+        PROBSU(5)=1./SU*PROBAB(4)+PROBSU(4)
+        R=RANGEN()
+        IF     ( R .LE. PROBSU(2) ) THEN
+          IFLB=1
+        ELSEIF ( R .LE. PROBSU(3) ) THEN
+          IFLB=2
+        ELSEIF ( R .LE. PROBSU(4) ) THEN
+          IFLB=3
+        ELSE
+          IFLB=4
+        ENDIF
+        IF ( NQAQ.EQ.0 .AND. IVAL1.EQ.0 .AND. IVAL2.EQ.0 ) IFLB=IFLA
+C-C     IF ( NQAQ.EQ.0 .AND. IVAL2.EQ.0 ) IFLB=IFLA
+C-C     IF ( NQAQ.EQ.0 .AND. IVAL1.EQ.0 ) IFLA=IFLB
+        R=RANGEN()
+        IF     ( IOPTQ .EQ. 2 ) THEN
+          PTB = SQRT( -4.*PTQ**2/PI * LOG(1.-QPTQMX*R) )
+        ELSEIF ( IOPTQ .EQ. 3 ) THEN
+          PTB = PTQ*SQRT( QPTQMX*R/(1.-QPTQMX*R) )
+        ELSE
+          PTB=UTINVT(NPTQ,XPTQ,QPTQ,R*QPTQ(NPTQ))
+        ENDIF
+        PTBH=PTH*SQRT( 1./SQRT(1.-2.*PTH**2*RANGEN()*QPTHMX) - 1. )
+      ENDIF
+
+      IF ( NQAQ.EQ.0 .AND. IVAL1.EQ.0 .AND. IVAL2.EQ.0 ) THEN
+        IFLA=-IFLA
+        IFLB=-IFLB
+      ENDIF
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE HASI(QAQ,SIL,IFL,XFL,PT0,PT0H,SI,IRET,JORD,IXFLAB
+     *               ,PTDIFF)
+
+C-----------------------------------------------------------------------
+C  DETERMINES STRING INGREDIENTS (=JETS)
+C  IRET=0: OK
+C  IRET=1: REMNANT CHANGES DIRECTION
+C  IRET=2: JC(,)=10
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      PARAMETER (NSI=6)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      REAL      PTDIFF(2),SI(NSI),SIL(NSI)
+      INTEGER   IC(2),ID(2),JC(NFLAV,2)
+      CHARACTER QAQ*5,XFL*3
+C-----------------------------------------------------------------------
+      IRET=0
+      IRETX=0
+      NTRY=0
+      PTDIFF(1)=0.
+      PTDIFF(2)=0.
+      IFLA=ABS(IFL)
+      IF ( XFL .EQ. '000' ) THEN
+        DO 11 J=3,NSI
+          SI(J)=0.
+11      CONTINUE
+      ELSE
+        DO 10 J=1,NSI
+          SI(J)=0.
+10      CONTINUE
+      ENDIF
+      IF ( XFL .EQ. '---' ) GOTO 1000
+      IF      ( JORD .EQ. 1 ) THEN
+        IF     ( QAQ .EQ. 'QUARK' ) THEN
+          AMS=AMPROJ
+        ELSEIF ( QAQ .EQ. 'ANTIQ' ) THEN
+          AMS=AMTARG
+        ENDIF
+      ELSEIF ( JORD .EQ. 2 ) THEN
+        IF     ( QAQ .EQ. 'ANTIQ' ) THEN
+          AMS=AMPROJ
+        ELSEIF ( QAQ .EQ. 'QUARK' ) THEN
+          AMS=AMTARG
+        ENDIF
+      ENDIF
+C-C   ENLL=SQRT(AMS**2+PNLLX**2)
+      ENLL=SIL(4)
+      SGN=SIGN(1.,SIL(3))
+      IF ( RANGEN() .LE. PHARD ) THEN
+        IHARD=1
+      ELSE
+        IHARD=0
+      ENDIF
+      ID(1)=NINT(SIL(4+1))
+      ID(2)=NINT(SIL(4+2))
+      CALL IDDECO(ID,JC)
+9999  NTRY=NTRY+1
+      IF ( NTRY .GT. 20 ) THEN
+        IRET=1
+        GOTO 1000
+      ENDIF
+      IF     ( IHARD .EQ. 0 ) THEN
+        PT=PT0
+        IF ( PT .GT. ENLL ) PT=RANGEN()*ENLL
+        ENMIN=0.
+      ELSE
+        PT=PT0H
+        IF ( PT .GT. ENLL ) PT=RANGEN()*ENLL
+        ENMIN=PT
+      ENDIF
+      PTFULL=PT
+      LO=0
+51    LO=LO+1
+      IF ( XFL .EQ. '000' ) THEN
+        EN=0.
+        PT=0.
+      ELSE
+        EN=RANSTC(XFL,ENMIN/ENLL)*ENLL
+      ENDIF
+      IF ( PT .GT. EN ) THEN
+        IF ( RANGEN() .LT. 0.5  .AND.  LO .LE. 10 ) GOTO 51
+        PT=RANGEN()*EN
+      ENDIF
+      PHI=2.*PI*RANGEN()
+      IF ( XFL .NE. '000' ) THEN
+        SI(1)=PT*COS(PHI)
+        SI(2)=PT*SIN(PHI)
+        SI(3)=SGN*SQRT(EN**2-PT**2)
+        IF ( SI(1).EQ.0.  .AND.  SI(2).EQ.0.  .AND.  SI(3).EQ.0. ) THEN
+          IRETX=1
+          IRET=1
+          GOTO 1000
+        ENDIF
+C-C     PTDIFF(1)=(PTFULL-PT)*COS(PHI)
+C-C     PTDIFF(2)=(PTFULL-PT)*SIN(PHI)
+      ENDIF
+      IF ( (SIL(3)-SI(3))*SIL(3) .LT. 0. ) THEN
+        IF ( ISH .GE. 94 ) WRITE(IFCH,*)'SIL,SI,ENLL,EN',SIL,SI,ENLL,EN
+        GOTO 9999
+      ENDIF
+      SI(4)=SQRT(SI(1)**2+SI(2)**2+SI(3)**2)
+      IF     ( QAQ .EQ. 'QUARK' ) THEN
+        SI(5)=10**(NFLAV-IFLA)
+      ELSEIF ( QAQ .EQ. 'ANTIQ' ) THEN
+        SI(6)=10**(NFLAV-IFLA)
+      ENDIF
+
+      IF ( IXFLAB .EQ. 0 ) THEN
+        SIL(1)=SIL(1)-SI(1)
+        SIL(2)=SIL(2)-SI(2)
+        SIL(3)=SIL(3)-SI(3)
+        SIL(4)=SQRT(SIL(1)**2+SIL(2)**2+SIL(3)**2)
+      ENDIF
+
+      IF ( JC(IFLA,1) .GT. 0 ) THEN
+        L1=1
+      ELSE
+        L1=0
+      ENDIF
+      IF ( JC(IFLA,2) .GT. 0 ) THEN
+        L2=1
+      ELSE
+        L2=0
+      ENDIF
+      IF     ( QAQ .EQ. 'QUARK' ) THEN
+        IF     ( L1 .EQ. 0 ) THEN
+          JC(IFLA,2)=JC(IFLA,2)+1
+        ELSE
+          JC(IFLA,1)=JC(IFLA,1)-1
+        ENDIF
+      ELSEIF ( QAQ .EQ. 'ANTIQ' ) THEN
+        IF     ( L2 .EQ. 0 ) THEN
+          JC(IFLA,1)=JC(IFLA,1)+1
+        ELSE
+          JC(IFLA,2)=JC(IFLA,2)-1
+        ENDIF
+      ENDIF
+      IF ( JC(IFLA,1) .EQ. 10  .OR.  JC(IFLA,2) .EQ. 10 ) GOTO 9998
+      CALL IDENCO(JC,IC,IRETEN)
+      IF ( IRETEN .EQ. 1 ) THEN
+        CALL UTSTOP('HASI  : IDENCO RET CODE = 1             ')
+      ENDIF
+      SIL(5)=IC(1)
+      SIL(6)=IC(2)
+      GOTO 1000
+
+9998  IRET=2
+      IF ( ISH .GE. 90 ) THEN
+        CALL UTMSG('HASI  ')
+        WRITE(IFCH,*)'*****  JC(,)=10'
+        WRITE(IFCH,*)JC
+        CALL UTMSGF
+      ENDIF
+
+1000  CONTINUE
+      IF ( ISH .GE. 90  .AND. IRETX .EQ. 1 ) THEN
+        CALL UTMSG('HASI  ')
+        WRITE(IFCH,*)'*****  SI(1/2/3)=0'
+        WRITE(IFCH,*)SI
+        CALL UTMSGF
+      ENDIF
+      IF ( ISH .GE. 93 ) THEN
+        IF ( IRET .NE. 0  .OR.  NTRY .GT. 1 )
+     *           WRITE(IFCH,*)'IRET=',IRET,'  NTRY=',NTRY
+        IF     ( NTRY .GT. 0 ) THEN
+          WRITE(IFCH,100)XFL,PT0,PT,EN,EN/ENLL
+100       FORMAT(' HASI: XFL=',A3
+     *          ,' PT0=',E10.3,' PT=',E10.3,' EN=',E10.3,' X=',E10.3)
+        ELSEIF ( NTRY .EQ. 0 ) THEN
+          WRITE(IFCH,101)XFL
+101       FORMAT(1X,'HASI: XFL=',A3)
+        ENDIF
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE HASTFC(SIL,SIX,IRET)
+
+C-----------------------------------------------------------------------
+C  CHECKS LONG STRINGS
+C  IRET=0: OK
+C  IRET=1: MASS .LT. MINIMAL MASS
+C  IRET=2: JC(,) .GT. 9
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CNCE/    NCES,NCOLEX
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      REAL    SI(NSI),SIL(NSI),SIX(NSI,NSIX)
+      INTEGER IC(2),JC(NFLAV,2),JCP(NFLAV,2)
+C-----------------------------------------------------------------------
+      IRET=0
+
+      CALL UTKSIX(SIX,KMAX)
+      IF ( KMAX .LT. 1 ) GOTO 9000
+
+      SI(1)=SIL(1)
+      SI(2)=SIL(2)
+      SI(3)=SIL(3)
+      SI(4)=SIL(4)
+      DO 110 K=1,KMAX
+        SI(1)=SI(1)+SIX(1,K)
+        SI(2)=SI(2)+SIX(2,K)
+        SI(3)=SI(3)+SIX(3,K)
+        SI(4)=SI(4)+SIX(4,K)
+110   CONTINUE
+      S=SI(4)**2-SI(1)**2-SI(2)**2-SI(3)**2
+
+      IC(1)=NINT(SIL(5))
+      IC(2)=NINT(SIL(6))
+      CALL IDDECO(IC,JC)
+      DO 130 K=1,KMAX
+        IC(1)=NINT(ABS(SIX(5,K)))
+        IC(2)=NINT(ABS(SIX(6,K)))
+        CALL IDDECO(IC,JCP)
+        DO 120 I=1,NFLAV
+          JC(I,1)=JC(I,1)+JCP(I,1)
+          JC(I,2)=JC(I,2)+JCP(I,2)
+120     CONTINUE
+130   CONTINUE
+
+      DO 125 I=1,NFLAV
+        IF ( JC(I,1)-JC(I,2) .GE.  10 ) IRET=2
+        IF ( JC(I,1)-JC(I,2) .LE. -10 ) IRET=2
+125   CONTINUE
+
+      IF ( IRET .EQ. 2 ) GOTO 9000
+
+      KEU=JC(1,1)-JC(1,2)
+      KED=JC(2,1)-JC(2,2)
+      KES=JC(3,1)-JC(3,2)
+      KEC=JC(4,1)-JC(4,2)
+      AMIN=UTAMNU(KEU,KED,KES,KEC,4)*0.5
+
+C-C   IF ( S .LT. AMIN**2 ) IRET=1
+
+9000  CONTINUE
+
+      IF ( ISH .GE. 94 ) THEN
+        WRITE(IFCH,*)' '
+        IF ( IRET .EQ. 0 ) THEN
+          WRITE(IFCH,*)('-',L=1,79)
+        ELSE
+          WRITE(IFCH,*)('#',L=1,79)
+        ENDIF
+        WRITE(IFCH,*)'IRET= ',IRET ,'  KMAX= ',KMAX,'  NREVT= ',NREVT
+     *        ,'  NCES= ',NCES
+        WRITE(IFCH,8004)SIL
+8004    FORMAT(' SIL: ',4F13.5,2F8.0)
+        IF ( KMAX .GT. 0 ) THEN
+          WRITE(IFCH,8007)(SIX(I,1),I=1,NSI)
+8007      FORMAT(' SIX: ',4F13.5,2F8.0)
+          IF ( KMAX .GT. 1 ) THEN
+            DO 1 J=2,KMAX
+              WRITE(IFCH,8008)(SIX(I,J),I=1,NSI)
+ 1          CONTINUE
+8008        FORMAT('      ',4F13.5,2F8.0)
+          ENDIF
+          WRITE(IFCH,8005)(SI(I),I=1,4)
+8005      FORMAT('  SI: ',4F13.5)
+          WRITE(IFCH,8006)(SI(I)**2,I=1,4)
+8006      FORMAT(' SI>2:',4F13.5)
+          WRITE(IFCH,*)'JC:'
+          WRITE(IFCH,*)JC
+          WRITE(IFCH,*)'KEU,KED,KES,KEC: ',KEU,KED,KES,KEC
+          WRITE(IFCH,*)'S= ',S,'    AMIN**2= ',AMIN**2,'   AMIN= ',AMIN
+        ENDIF
+        IF ( IRET .NE. 0 ) THEN
+          WRITE(IFCH,*)('#',L=1,79)
+        ELSE
+          WRITE(IFCH,*)('-',L=1,79)
+        ENDIF
+        WRITE(IFCH,*)' '
+      ENDIF
+
+      IF ( IRET .NE. 0 ) RETURN
+      IF ( ISH .GE. 91 ) CALL HASTFW (SIL,SIX)
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE HASTFL(SIL,SIX,STRL)
+
+C-----------------------------------------------------------------------
+C  FORMS A LEADING STRING
+C-----------------------------------------------------------------------
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+
+      REAL SIL(NSI),SIX(NSI,NSIX),STRL(NSI,NSIX+1)
+C-----------------------------------------------------------------------
+      DO 100 N=1,NSI
+        STRL(N,1)=SIL(N)
+        STRL(N,2)=0.
+100   CONTINUE
+      CALL UTKSIX(SIX,KMAX)
+      IF ( KMAX .EQ. 0 ) RETURN
+      DO 111 K=1,KMAX
+        DO 110 N=1,NSI
+          STRL(N,K+1)=SIX(N,K)
+110     CONTINUE
+111   CONTINUE
+      DO 120 N=1,NSI
+        STRL(N,KMAX+2)=0.
+120   CONTINUE
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE HASTFR(SILA,SILB,SIA,SIB,IRET)
+
+C-----------------------------------------------------------------------
+C  SUBTRACTS SIA-SIB FROM SILA-SILB (ONLY MOMENTUM COMPONENTS)
+C-----------------------------------------------------------------------
+      PARAMETER (NSI=6)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      DOUBLE PRECISION A,B,D,DAUXIL,PAB(4),PAM,PAP,PA3,PA4
+     *                ,PEM,PEP,PIM,PIP,PI3,PI4,PLAB(4)
+     *                ,POT,POX,POY,PUT,PUX,PUY,PYM,PYP,SLA
+     *                ,SSIA(NSI),SSIB(NSI),SSILA(NSI),SSILB(NSI)
+      REAL             SIA(NSI),SIB(NSI),SILA(NSI),SILB(NSI)
+C-----------------------------------------------------------------------
+      IRET=0
+      DO 12 I=1,4
+        SSILB(I)=SILB(I)
+        SSILA(I)=SILA(I)
+        PLAB(I)=SSILA(I)+SSILB(I)
+        SSIB(I)=SIB(I)
+        SSIA(I)=SIA(I)
+        PAB(I)=SSIA(I)+SSIB(I)
+12    CONTINUE
+      SLA=SIGN(1.D0, SSILA(3))
+
+      IF ( ISH.GE.0 .AND. SSIA(3)*SSILA(3) .LT. 0.D0 ) THEN
+        CALL UTMSG('HASTFR')
+        WRITE(IFCH,*)'*****  SSIA(3)*SSILA(3)<0'
+        WRITE(IFCH,*)SSIA(3),SSILA(3)
+        CALL UTMSGF
+      ENDIF
+
+      A=0.D0
+      D=0.D0
+      PYP=0.D0
+      PYM=0.D0
+      PIP=0.D0
+      PAM=0.D0
+
+      POX=SSILA(1)-SSIA(1)
+      POY=SSILA(2)-SSIA(2)
+      POT=SQRT(POX**2+POY**2)
+      PUX=SSILB(1)-SSIB(1)
+      PUY=SSILB(2)-SSIB(2)
+      PUT=SQRT(PUX**2+PUY**2)
+      DAUXIL = SLA*(PLAB(3)-PAB(3))
+      PEP= PLAB(4)-PAB(4) + DAUXIL
+      PEM= PLAB(4)-PAB(4) - DAUXIL
+      IF ( PEP .LT. 0.D0 ) GOTO 9001
+      IF ( PEM .LT. 0.D0 ) GOTO 9001
+      A=(PEM*PEP-PUT**2-POT**2)*0.5D0
+      D=PUT*POT
+      DAUXIL = A**2 - D**2
+      IF ( DAUXIL .LT. 0.D0 ) GOTO 9001
+      B=SQRT(DAUXIL)
+      PYP=(A+PUT**2-B)/PEM
+      PYM=(A+POT**2-B)/PEP
+      IF ( PYP .LT. 0.D0 ) GOTO 9001
+      IF ( PYM .LT. 0.D0 ) GOTO 9001
+      PIP=PEP-PYP
+      IF ( PIP .LT. 0.D0 ) GOTO 9001
+      PIM=PYM
+      PAP=PYP
+      PAM=PEM-PYM
+      IF ( PAM .LT. 0.D0 ) GOTO 9001
+      PI3=(PIP-PIM)*0.5D0*SLA
+      PI4=(PIP+PIM)*0.5D0
+      PA3=(PAP-PAM)*0.5D0*SLA
+      PA4=(PAP+PAM)*0.5D0
+      IF ( PI3*SSILA(3) .LT. 0.D0 ) GOTO 9001
+      IF ( PA3*SSILB(3) .LT. 0.D0 ) GOTO 9001
+      SSILA(1)=POX
+      SSILA(2)=POY
+      SSILA(3)=PI3
+      SSILA(4)=PI4
+      SSILB(1)=PUX
+      SSILB(2)=PUY
+      SSILB(3)=PA3
+      SSILB(4)=PA4
+
+      DO 13 I=1,4
+        SILA(I)=SSILA(I)
+        SILB(I)=SSILB(I)
+        SIA(I)=SSIA(I)
+        SIB(I)=SSIB(I)
+13    CONTINUE
+
+      IF ( ISH .LT. 90 ) GOTO 9000
+
+      IF ( ABS(PIP*PIM-POT**2) .GT. 1.D-4 ) THEN
+        CALL UTMSG('HASTFR')
+        WRITE(IFCH,*)'*****  PIP*PIM /= POT**2'
+        WRITE(IFCH,*)'PIP*PIM=',PIP*PIM
+        WRITE(IFCH,*)'POT**2=',POT**2
+        WRITE(IFCH,*)'PIP=',PIP
+        WRITE(IFCH,*)'PIM=',PIM
+        WRITE(IFCH,*)'POT=',POT
+        CALL UTMSGF
+      ENDIF
+      IF ( ABS(PAP*PAM-PUT**2) .GT. 1.D-4 ) THEN
+        CALL UTMSG('HASTFR')
+        WRITE(IFCH,*)'*****  PAP*PAM /= PUT**2'
+        WRITE(IFCH,*)'PAP*PAM=',PAP*PAM
+        WRITE(IFCH,*)'PUT**2=',PUT**2
+        WRITE(IFCH,*)'PAP=',PAP
+        WRITE(IFCH,*)'PAM=',PAM
+        WRITE(IFCH,*)'PUT=',PUT
+        CALL UTMSGF
+      ENDIF
+      IF ( ABS(SSILA(4)**2
+     *        -SSILA(1)**2-SSILA(2)**2-SSILA(3)**2) .GT. 1.D-4 ) THEN
+        CALL UTMSG('HASTFR')
+        WRITE(IFCH,*)'*****  MASS**2 OF SSILA NONZERO'
+        WRITE(IFCH,*)'MASS**2=',SSILA(4)**2
+     *                         -SSILA(1)**2-SSILA(2)**2-SSILA(3)**2
+        CALL UTMSGF
+      ENDIF
+      IF ( ABS(SSILB(4)**2
+     *         -SSILB(1)**2-SSILB(2)**2-SSILB(3)**2) .GT. 1.D-4 ) THEN
+        CALL UTMSG('HASTFR')
+        WRITE(IFCH,*)'*****  MASS**2 OF SSILB NONZERO'
+        WRITE(IFCH,*)'MASS**2=',SSILB(4)**2
+     *                         -SSILB(1)**2-SSILB(2)**2-SSILB(3)**2
+        CALL UTMSGF
+      ENDIF
+      DO 14 N=1,4
+        IF ( ABS(PLAB(N)
+     *         -SSILA(N)-SSILB(N)-SSIA(N)-SSIB(N)) .GT. 1.D-4 ) GOTO 15
+14    CONTINUE
+      GOTO 16
+15    CONTINUE
+      CALL UTMSG('HASTFR')
+      WRITE(IFCH,*)'***** SSILA+SSILB /= SSILA_NEW+SSILB_NEW+SSIA+SSIB'
+      WRITE(IFCH,*)'SSILA_OLD+SSILB_OLD:'
+      WRITE(IFCH,*)PLAB
+      WRITE(IFCH,*)'SSILA_NEW+SSILB_NEW+SSIA+SSIB:'
+      WRITE(IFCH,*)((SSILA(K)+SSILB(K)+SSIA(K)+SSIB(K)),K=1,4)
+      WRITE(IFCH,*)'SSILA_NEW:'
+      WRITE(IFCH,*)(SSILA(N),N=1,4)
+      WRITE(IFCH,*)'SSILB_NEW:'
+      WRITE(IFCH,*)(SSILB(N),N=1,4)
+      WRITE(IFCH,*)'SSIA:'
+      WRITE(IFCH,*)(SSIA(N),N=1,4)
+      WRITE(IFCH,*)'SSIB:'
+      WRITE(IFCH,*)(SSIB(N),N=1,4)
+      CALL UTMSGF
+16    CONTINUE
+
+9000  RETURN
+
+9001  IRET=1
+      IF ( ISH .LT. 90 ) RETURN
+      CALL UTMSG('HASTFR')
+      WRITE(IFCH,*)'STRING SUBTRACTION NOT POSSIBLE'
+      WRITE(IFCH,*)'SNGL(SSILA):'
+      WRITE(IFCH,*)(SNGL(SSILA(N)),N=1,4)
+      WRITE(IFCH,*)'SNGL(SSILB):'
+      WRITE(IFCH,*)(SNGL(SSILB(N)),N=1,4)
+      WRITE(IFCH,*)'SNGL(SSIA):'
+      WRITE(IFCH,*)(SNGL(SSIA(N)),N=1,4)
+      WRITE(IFCH,*)'SNGL(SSIB):'
+      WRITE(IFCH,*)(SNGL(SSIB(N)),N=1,4)
+      WRITE(IFCH,*)'PEP,PEM:',PEP,PEM
+      WRITE(IFCH,*)'POT,PUT:',POT,PUT
+      WRITE(IFCH,*)'A,D:',A,D
+      WRITE(IFCH,*)'A**2-D**2:',A**2-D**2
+      WRITE(IFCH,*)'PYP,PYM:',PYP,PYM
+      WRITE(IFCH,*)'PIP,PAM:',PIP,PAM
+      WRITE(IFCH,*)'PI3,SILA(3):',PI3,SILA(3)
+      WRITE(IFCH,*)'PA3,SILB(3):',PA3,SILB(3)
+      CALL UTMSGF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE HASTFS(SILA,SIXA,IFLA,XFLA,PTA,PTAH
+     *                 ,SILB,SIXB,IFLB,XFLB,PTB,PTBH  ,STR,IRET  ,JORD)
+
+C-----------------------------------------------------------------------
+C  FORMS A SHORT (=Q-QBAR) STRING
+C  IRET=0: OK
+C  IRET=1: IN SR HASI: REMNANT CHANGES DIRECTION OR ZERO SI().
+C  IRET=2: IN SR HASI: JC(,)=10 .
+C  IRET=3: STRING MASS TOO SMALL. NOT 4 , 5 .
+C  IRET=4: STRING MASS TOO SMALL. EQUAL FLAVOUR,ZERO MOMENTUM,XFL='000'.
+C  IRET=5: STRING MASS TOO SMALL. VALENCE QUARKS INVOLVED.
+C-----------------------------------------------------------------------
+      PARAMETER (NPTQ=129)
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CPTQ/    QPTH(NPTQ),QPTQ(NPTQ),XPTQ(NPTQ),QPTQMX,QPTHMX
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      REAL      PTDIFF(2),SIA(NSI),SIB(NSI),SILA(NSI),SILB(NSI)
+     *         ,SIXA(NSI,NSIX),SIXB(NSI,NSIX),STR(NSI,NSIX+1),STS(NSI,2)
+      CHARACTER XFLA*3,XFLB*3
+C-----------------------------------------------------------------------
+      DO 50 N=1,NSI
+        STR(N,1)=0.
+        STR(N,2)=0.
+        STR(N,3)=0.
+50    CONTINUE
+
+      CALL UTKSIX(SIXA,KMAXA)
+      CALL UTKSIX(SIXB,KMAXB)
+
+      R=RANGEN()
+      IF     ( IOPTQ .EQ. 2 ) THEN
+        PT = SQRT( -4.*PTQ**2/PI * LOG(1.-QPTQMX*R) )
+      ELSEIF ( IOPTQ .EQ. 3 ) THEN
+        PT = PTQ*SQRT( QPTQMX*R/(1.-QPTQMX*R) )
+      ELSE
+        PT=UTINVT(NPTQ,XPTQ,QPTQ,R*QPTQ(NPTQ))
+      ENDIF
+      PHI=2.*PI*RANGEN()
+      SIA(1)=PT*COS(PHI)
+      SIB(1)=-SIA(1)
+      SIA(2)=PT*SIN(PHI)
+      SIB(2)=-SIA(2)
+
+      IXFLAB=0
+      IF (  XFLA.NE.'---' .AND. XFLB.NE.'---' .AND.
+     *       (XFLA .NE. '000'  .OR.  XFLB .NE. '000') ) IXFLAB=1
+      CALL HASI('QUARK',SILA,IFLA,XFLA,PTA,PTAH,SIA,IRET,JORD,IXFLAB
+     *          ,PTDIFF)
+      IF ( IRET .EQ. 1 ) GOTO 9001
+      IF ( IRET .EQ. 2 ) GOTO 9002
+      SILA(1)=SILA(1)-PTDIFF(1)
+      SILA(2)=SILA(2)-PTDIFF(2)
+      SILB(1)=SILB(1)+PTDIFF(1)
+      SILB(2)=SILB(2)+PTDIFF(2)
+      CALL HASI('ANTIQ',SILB,IFLB,XFLB,PTB,PTBH,SIB,IRET,JORD,IXFLAB
+     *          ,PTDIFF)
+      IF ( IRET .EQ. 1 ) GOTO 9001
+      IF ( IRET .EQ. 2 ) GOTO 9002
+      SILB(1)=SILB(1)-PTDIFF(1)
+      SILB(2)=SILB(2)-PTDIFF(2)
+      SILA(1)=SILA(1)+PTDIFF(1)
+      SILA(2)=SILA(2)+PTDIFF(2)
+      IF ( SILA(5) .EQ. 0.  .AND.  SILA(6) .EQ. 0. ) THEN
+        SILA(5)=100000.
+        SILA(6)=100000.
+      ENDIF
+      IF ( SILB(5) .EQ. 0.  .AND.  SILB(6) .EQ. 0. ) THEN
+        SILB(5)=100000.
+        SILB(6)=100000.
+      ENDIF
+      IF     ( XFLA .EQ. '000'  .AND.  XFLB .EQ. '000' ) THEN
+        GOTO 9003
+      ELSEIF ( XFLA .NE. '---'  .AND.  XFLB .NE. '---' ) THEN
+        CALL HASTFR(SILA,SILB,SIA,SIB,IRET)
+        IF ( IRET .EQ. 1 ) GOTO 9003
+        DO 65 N=1,NSI
+          STS(N,1)=SIA(N)
+          STS(N,2)=SIB(N)
+65      CONTINUE
+        CALL UTAMST(STS,AM,AMIN,IRET)
+        IF ( IRET .NE. 0 ) GOTO 9003
+        DO 70 N=1,NSI
+          STR(N,1)=SIA(N)
+          STR(N,2)=SIB(N)
+70      CONTINUE
+      ELSEIF ( XFLA .NE. '---'  .AND.  XFLB .EQ. '---' ) THEN
+        IF ( KMAXB+1 .GT. NSIX ) THEN
+          CALL UTSTOP('HASTFS: NSIX TOO SMALL                  ')
+        ENDIF
+        DO 60 N=1,NSI
+          SIXB(N,KMAXB+1)=SIA(N)
+          IF ( KMAXB+2 .LE. NSIX ) SIXB(N,KMAXB+2)=0.
+60      CONTINUE
+        IF ( IFLA .LT. 0 ) THEN
+          SIXB(5,KMAXB+1)=-SIXB(5,KMAXB+1)
+          SIXB(6,KMAXB+1)=-SIXB(6,KMAXB+1)
+        ENDIF
+        KMAXB=KMAXB+1
+      ELSEIF ( XFLA .EQ. '---'  .AND.  XFLB .NE. '---' ) THEN
+        IF ( KMAXA+1 .GT. NSIX ) THEN
+          CALL UTSTOP('HASTFS: NSIX TOO SMALL                  ')
+        ENDIF
+        DO 80 N=1,NSI
+          SIXA(N,KMAXA+1)=SIB(N)
+          IF ( KMAXA+2 .LE. NSIX ) SIXA(N,KMAXA+2)=0.
+80      CONTINUE
+        IF ( IFLB .LT. 0 ) THEN
+          SIXA(5,KMAXA+1)=-SIXA(5,KMAXA+1)
+          SIXA(6,KMAXA+1)=-SIXA(6,KMAXA+1)
+        ENDIF
+        KMAXA=KMAXA+1
+      ELSEIF ( XFLA .EQ. '---'  .AND.  XFLB .EQ. '---' ) THEN
+C  NO ACTION
+      ELSE
+        CALL UTSTOP('HASTFS: IF/ELSE ERROR                   ')
+      ENDIF
+
+9000  IRET=0
+      IF ( ISH .GE. 91 ) WRITE(IFCH,102)SIA,XFLA,SIB,XFLB
+102   FORMAT(' SIA: ',4F13.5,2F8.0,2X,A3
+     *      /' SIB: ',4F13.5,2F8.0,2X,A3)
+      RETURN
+
+9001  IRET=1
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,102)SIA,XFLA,SIB,XFLB
+        WRITE(IFCH,*)'REMNANT CHANGES DIRECTION'
+        WRITE(IFCH,*)' OR ZERO SI(1/2/3)'
+        WRITE(IFCH,*)' '
+      ENDIF
+      RETURN
+
+9002  IRET=2
+C     JC(,)=10
+      IF ( ISH .GE. 91 ) WRITE(IFCH,102)SIA,XFLA,SIB,XFLB
+      RETURN
+
+9003  IRET=3
+      IF ( XFLA(1:2) .EQ. 'VA'  .OR.  XFLB(1:2) .EQ. 'VA' ) GOTO 9005
+      WT=ABS(SIA(1)+SIB(1))+ABS(SIA(2)+SIB(2))
+     *                              +ABS(SIA(3)+SIB(3))
+      IF ( ABS(IFLA).EQ.ABS(IFLB) .AND. WT.LT.1.E-3
+     *            .AND. XFLA.EQ.'000' .AND. XFLB.EQ.'000' ) GOTO 9004
+      IFLB=SIGN( IABS(IFLA), IFLB)
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,102)SIA,XFLA,SIB,XFLB
+        WRITE(IFCH,*)'STRING MASS TOO SMALL (3)'
+        WRITE(IFCH,*)' '
+      ENDIF
+      XFLA='000'
+      XFLB='000'
+      RETURN
+
+9004  IRET=4
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,102)SIA,XFLA,SIB,XFLB
+        WRITE(IFCH,*)'STRING MASS TOO SMALL (4)'
+        WRITE(IFCH,*)' '
+      ENDIF
+      RETURN
+
+9005  IRET=5
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,102)SIA,XFLA,SIB,XFLB
+        WRITE(IFCH,*)'STRING MASS TOO SMALL (5)'
+        WRITE(IFCH,*)' '
+      ENDIF
+      XFLA(1:2)='SE'
+      XFLB(1:2)='SE'
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE HASTFW(SIL,SIX)
+
+C-----------------------------------------------------------------------
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      REAL SIL(NSI),SIX(NSI,NSIX)
+C-----------------------------------------------------------------------
+      CALL UTKSIX(SIX,KMAX)
+      WRITE(IFCH,103)SIL,((SIX(I,J),I=1,NSI),J=1,KMAX)
+103   FORMAT(/' SIL: ',4F13.5,2F8.0/,' SIX: ',4F13.5,2F8.0/
+     *,50('      ',4F13.5,2F8.0/))
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE HASTPR(STRO,ISPLT)
+
+C-----------------------------------------------------------------------
+C  PROCESSES A STRING
+C  OUT: ISPLT=0 : PROCESSING OF STRO FINISHED
+C            >0 : HASTPR TO BE REDONE TO PROCESS REDUCED STRING
+C            -1 : ERROR
+C            -3 : HASTPR TO BE REDONE WITH NEW EPART,APART
+C            -4 : HAHA COLLISION TO BE REDONE BEC OF TOO FAST LD PTL
+C                             (ONLY FOR ICHOIC=2)
+C            -5 : HASTPR TO BE REDONE BECAUSE OF PRODUCED S=3/2 PARTICLE
+C-----------------------------------------------------------------------
+      PARAMETER (KOLLMX=2500)
+      PARAMETER (MAMX=56)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXSTR=3000)
+      PARAMETER (NDEP=129)
+      PARAMETER (NDET=129)
+      PARAMETER (NFLAV=6)
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /CJSPLI/  ALEAD,APART,ELEAD,EPART,SGNSIL,JPART,NSCC,NSCCX
+      COMMON /CKOL/    KOL
+      COMMON /CLEAD/   COOAV3,COOAV4,LEAD
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CNSUC/   NSUC
+      COMMON /COL/     BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
+     *                ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
+     *                ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
+     *                ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
+     *                ,XDET99(NDET)
+     *                ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
+     *                ,NRTARG(KOLLMX),NTARG
+      COMMON /CPROJA/  IPROJ,ITARG,KPROJA(NHA,MAMX),KTARGA(NHA,MAMX)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CPZSTR/  ESTRL,PZSTRL,ISEA,ISTRL
+      COMMON /CSTR/    PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
+     *                ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
+      COMMON /CSTSH/   NSTSH
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      DOUBLE PRECISION DAUXIL,PPE,PPM,PPP,PPX,PPY,PPZ,PP1(4),PP2(4)
+      REAL             P1(4),P2(4),STR(NSI,2),STRO(NSI,NSIX+1)
+      INTEGER          IC(2),IC1(2),IC1X(2),IC2(2)
+     *                ,JC(NFLAV,2),JC1(NFLAV,2),JC2(NFLAV,2)
+     *                ,JC3(NFLAV,2)
+C-----------------------------------------------------------------------
+      IF     ( ISPLT .EQ. -3 ) THEN
+        JPART=1
+        ISPLT=0
+      ELSEIF ( ISPLT .EQ.  0 ) THEN
+        JPART=0
+      ENDIF
+      ISPLT0=ISPLT
+
+      CALL UTKSTR(STRO,KMAX)
+
+C  ZERO STRING
+C  -----------
+      IF ( KMAX .EQ. 0 ) THEN
+        IF ( ISH .GE. 91 ) THEN
+          WRITE(IFCH,*)'ZERO STRING'
+          WRITE(IFCH,*)' '
+        ENDIF
+        ISPLT=0
+        RETURN
+      ENDIF
+
+C  PRINT
+C  -----
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,105)(STRO(I,1),I=1,4),(NINT(STRO(I,1)),I=5,6)
+105     FORMAT(' STR: ',4F13.5,2I8)
+        IF ( KMAX .GT. 1 ) THEN
+          DO 8 K=2,KMAX
+            WRITE(IFCH,104)(STRO(I,K),I=1,4),(NINT(STRO(I,K)),I=5,6)
+104         FORMAT('      ',4F13.5,2I8)
+ 8        CONTINUE
+        ENDIF
+        WRITE(IFCH,*)' '
+      ENDIF
+
+C  CHECK LEADING OBJECT
+C  --------------------
+      IC1(1)=NINT(STRO(4+1,1))
+      IC1(2)=NINT(STRO(4+2,1))
+      CALL IDCOMP(IC1,IC1X,JC3,1)
+      STRO(4+1,1)=IC1X(1)
+      STRO(4+2,1)=IC1X(2)
+      CALL IDDECO(IC1X,JC1)
+      NPA=0
+      DO 7 N=1,NFLAV
+        NPA=NPA+JC1(N,1)+JC1(N,2)
+ 7    CONTINUE
+
+C  SPLIT STRING
+C  ------------
+      IF ( KMAX .GT. 2  .OR. KMAX.EQ.2 .AND. ISPLT.GT.0
+     *                  .OR. KMAX.EQ.2 .AND. NPA.GT.3
+     *                  .OR. KMAX.EQ.2 .AND. LEAD.EQ.1 ) THEN
+        IF ( ISPLT .EQ. 0 ) THEN
+          NSUC=0
+          KMAXOR=KMAX
+          IF ( STRO(3,1) .LT. 0. ) THEN
+            SGNSIL=-1
+          ELSE
+            SGNSIL=1
+          ENDIF
+          DO 17 N=1,NFLAV
+            JC2(N,1)=0
+            JC2(N,2)=0
+17        CONTINUE
+          DO 15 K=1,KMAX
+            IC1(1)=NINT(ABS(STRO(4+1,K)))
+            IC1(2)=NINT(ABS(STRO(4+2,K)))
+            CALL IDDECO(IC1,JC1)
+            DO 16 N=1,NFLAV
+              JC2(N,1)=JC2(N,1)+JC1(N,1)
+              JC2(N,2)=JC2(N,2)+JC1(N,2)
+              IF ( N .GT. 4  .AND.  (JC2(N,1).NE.0 .OR.
+     *                               JC2(N,2) .NE. 0) ) THEN
+                 CALL UTSTOP('HASTPR: FLAVOUR > 4                     ')
+               ENDIF
+16          CONTINUE
+15        CONTINUE
+          KEU=JC2(1,1)-JC2(1,2)
+          KED=JC2(2,1)-JC2(2,2)
+          KES=JC2(3,1)-JC2(3,2)
+          KEC=JC2(4,1)-JC2(4,2)
+          ALEAD=UTAMNU(KEU,KED,KES,KEC,0)
+C-C       ALEAD=0.
+          ELEAD=STRO(4,1)
+          IF ( JPART .EQ. 0 ) THEN
+            NSCCX=KMAXOR-1
+            NSTR0=NSTR
+          ELSE
+            NSCCX=MAX(1,NSCC)
+            NSTR=NSTR0
+          ENDIF
+          APART=ALEAD/NSCCX
+          EPART=ELEAD/NSCCX
+          IF ( ALEAD .GT. ELEAD ) THEN
+            IF ( ISH .GE. 90 ) THEN
+              CALL UTMSG('HASTPR')
+              WRITE(IFCH,*)'*****  ALEAD > ELEAD  ==> RET CODE = -1'
+              WRITE(IFCH,*)'ALEAD=',ALEAD,'   ELEAD=',ELEAD
+              CALL UTMSGF
+            ENDIF
+            ISPLT=-1
+            RETURN
+          ENDIF
+        ENDIF
+        CALL JSPLIT(STRO,STR,KOLSP,IER,KMAXOR)
+        IF     ( IER .EQ. 1 ) THEN
+          ISPLT=-1
+          RETURN
+        ELSEIF ( IER .EQ. 3 ) THEN
+          ISPLT=-3
+          RETURN
+        ENDIF
+        ISPLT=ISPLT+1
+        IF ( IER .EQ. 2 ) THEN
+          IF ( ISH .GE. 91 ) THEN
+            WRITE(IFCH,*)'MULTISTRING: ABSORPTION OF ONE LEG'
+            WRITE(IFCH,*)' '
+          ENDIF
+          RETURN
+        ENDIF
+        KOLZ=KOLSP
+        IF ( KOLZ .LT. 1  .OR.  KOLZ .GT. KOLLMX ) THEN
+          WRITE(IFCH,*)'KOLZ=',KOLZ
+          CALL UTSTOP('HASTPR: KOLZ OUT OF RANGE (1)           ')
+        ENDIF
+        KIN=1
+      ELSE
+        IF ( ISPLT .GT. 0 ) THEN
+          KIN=1
+        ELSE
+          KIN=0
+        ENDIF
+        DO 5 N=1,NSI
+          IF ( N .LE. 4 ) THEN
+            STR(N,1)=STRO(N,1)
+            STR(N,2)=STRO(N,2)
+          ELSE
+            STR(N,1)=ABS(STRO(N,1))
+            STR(N,2)=ABS(STRO(N,2))
+          ENDIF
+ 5      CONTINUE
+        IF     ( ISPLT .GT. 0 ) THEN
+          IF ( SGNSIL .LT. 0. ) THEN
+            KOLZ=KTARGA(2,ITARG)
+          ELSE
+            KOLZ=KPROJA(2,IPROJ)
+          ENDIF
+        ELSEIF ( LEAD .EQ. 1  .AND.  KMAX .EQ. 2 ) THEN
+          IF ( STR(3,1) .LT. 0. ) THEN
+            KOLZ=KTARGA(2,ITARG)
+          ELSE
+            KOLZ=KPROJA(2,IPROJ)
+          ENDIF
+        ELSE
+          KOLZ=KOL
+        ENDIF
+        IF ( KOLZ .LT. 1  .OR.  KOLZ .GT. KOLLMX ) THEN
+          IF(ISH.GE.90)THEN
+            CALL UTMSG('HASTPR')
+            WRITE(IFCH,*)'*****  KOLZ OUT OF RANGE;   KOLZ:',KOLZ
+     *        ,'   SET TO:',KOL
+            WRITE(IFCH,105)(STR(I,1),I=1,4),(NINT(STR(I,1)),I=5,6)
+            WRITE(IFCH,104)(STR(I,2),I=1,4),(NINT(STR(I,2)),I=5,6)
+            CALL UTMSGF
+          ENDIF
+          KOLZ=KOL
+        ENDIF
+        ISPLT=0
+      ENDIF
+
+C  ADD TWO JETS
+C  ------------
+      IC1(1)=NINT(STR(4+1,1))
+      IC1(2)=NINT(STR(4+2,1))
+      IC2(1)=NINT(STR(4+1,2))
+      IC2(2)=NINT(STR(4+2,2))
+      IA1=IC1(1)+IC1(2)
+      IA2=IC2(1)+IC2(2)
+      IF ( IA1 .EQ. 0  .AND.  IA2 .EQ. 0 ) THEN
+        WRITE(IFCH,*)'STRO:'
+        WRITE(IFCH,105)(STRO(I,1),I=1,4),(NINT(STRO(I,1)),I=5,6)
+        IF ( KMAX .GT. 1 ) THEN
+          DO 18 K=2,KMAX
+            WRITE(IFCH,104)(STRO(I,K),I=1,4),(NINT(STRO(I,K)),I=5,6)
+18        CONTINUE
+        ENDIF
+        WRITE(IFCH,*)'STR:'
+        WRITE(IFCH,105)(STR(I,1),I=1,4),(NINT(STR(I,1)),I=5,6)
+        WRITE(IFCH,104)(STR(I,2),I=1,4),(NINT(STR(I,2)),I=5,6)
+        CALL UTSTOP('HASTPR: STR=0                           ')
+      ENDIF
+      CALL IDDECO(IC1,JC1)
+      CALL IDDECO(IC2,JC2)
+      N1=0
+      N2=0
+      DO 9 N=1,NFLAV
+        N1=N1+JC1(N,1)+JC1(N,2)
+        N2=N2+JC2(N,1)+JC2(N,2)
+        JC(N,1)=JC1(N,1)+JC2(N,1)
+        JC(N,2)=JC1(N,2)+JC2(N,2)
+        IF ( N .GT. 4 .AND. (JC(N,1) .NE. 0 .OR.
+     *                       JC(N,2) .NE. 0) ) THEN
+          CALL UTSTOP ('HASTPR: FLAVOUR > 4                     ')
+        ENDIF
+ 9    CONTINUE
+      KEU=JC(1,1)-JC(1,2)
+      KED=JC(2,1)-JC(2,2)
+      KES=JC(3,1)-JC(3,2)
+      KEC=JC(4,1)-JC(4,2)
+      AMSTR=UTAMNU(KEU,KED,KES,KEC,6)
+      CALL IDENCO(JC,IC,IRETEN)
+      IF ( IRETEN .EQ. 1 ) THEN
+        CALL UTSTOP('HASTPR: IDENCO RET CODE = 1             ')
+      ENDIF
+      IDSTR=IDTRA(IC,0,0,3)
+
+C  DETERMINE ROT
+C  -------------
+      PP1(1)=STR(1,1)
+      PP1(2)=STR(2,1)
+      PP1(3)=STR(3,1)
+      PP1(4)=STR(4,1)
+      PP2(1)=STR(1,2)
+      PP2(2)=STR(2,2)
+      PP2(3)=STR(3,2)
+      PP2(4)=STR(4,2)
+      PPX=PP1(1)+PP2(1)
+      PPY=PP1(2)+PP2(2)
+      PPZ=PP1(3)+PP2(3)
+      PPP=SQRT(PPX**2+PPY**2+PPZ**2)
+      IF ( IA1 .NE. 0  .AND.  IA2 .NE. 0 ) THEN
+        PP1(4)=SQRT(PP1(1)**2+PP1(2)**2+PP1(3)**2)
+        PP2(4)=SQRT(PP2(1)**2+PP2(2)**2+PP2(3)**2)
+        PPE=PP1(4)+PP2(4)
+        PPM=SQRT((PPE-PPP)*(PPE+PPP))
+        CALL UTLOB2(1,PPX,PPY,PPZ,PPE,PPM,PP1(1),PP1(2),PP1(3),PP1(4))
+        CALL UTLOB2(1,PPX,PPY,PPZ,PPE,PPM,PP2(1),PP2(2),PP2(3),PP2(4))
+      ELSE
+        PPE=PP1(4)+PP2(4)
+        DAUXIL=(PPE-PPP)*(PPE+PPP)
+        IF ( DAUXIL .GT. 0.D0 ) THEN
+          PPM=SQRT(DAUXIL)
+        ELSE
+          PPM=0.D0
+          PPE=PPP
+        ENDIF
+        PP1(1)=0.D0
+        PP1(2)=0.D0
+        PP1(3)=0.D0
+        PP1(4)=0.D0
+        PP2(1)=0.D0
+        PP2(2)=0.D0
+        PP2(3)=0.D0
+        PP2(4)=0.D0
+      ENDIF
+      PX=PPX
+      PY=PPY
+      PZ=PPZ
+      E=PPE
+      AM=PPM
+      P=PPP
+      P1(1)=PP1(1)
+      P1(2)=PP1(2)
+      P1(3)=PP1(3)
+      P1(4)=PP1(4)
+      P2(1)=PP2(1)
+      P2(2)=PP2(2)
+      P2(3)=PP2(3)
+      P2(4)=PP2(4)
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,107)(P1(I),I=1,4),IC1
+        WRITE(IFCH,107)(P2(I),I=1,4),IC2
+107     FORMAT(' JET: ',4F13.5,2I8)
+        WRITE(IFCH,*)' '
+      ENDIF
+CDH   IF ( P1(3) .NE. 0. ) THEN
+CDH     DIRCN=SIGN(1.,P1(3))
+CDH   ELSE
+CDH     DIRCN=1.
+CDH   ENDIF
+
+C  MASS ADJUSTMENT
+C  ---------------
+      AM0=AM
+      CALL IDRES(IDSTR,AM,IDSTRR,IADJ)
+
+C  DIFFRACTIVE PARTICLE:
+C-C   IF ( (IA1.EQ.0.OR.IA2.EQ.0) .AND. ISPLT0.EQ.0 ) THEN
+C-C     IF ( MOD(IDSTRR,10).EQ.0 .AND. RANGEN().LT.0.1 ) THEN
+C-C       AM=0.
+C-C       CALL IDRES(IDSTR,AM,IDSTRR,IADJ)
+C-C       AM=AM+.300
+C-C       CALL IDRES(IDSTR,AM,IDSTRR,IADJ)
+C-C     ENDIF
+C-C   ENDIF
+
+C  REMNANT:
+      IF ( (IA1.EQ.0 .OR. IA2.EQ.0) .AND. ISPLT0.GT.0 ) THEN
+        IF     ( NSUC .GT. 0 ) THEN
+          AM=0.
+          CALL IDRES(IDSTR,AM,IDSTRR,IADJ)
+          IF     ( N1+N2 .EQ. 2 ) THEN
+            IF ( RANGEN() .LT. 0.33 ) AM=AM+0.400
+          ELSEIF ( MOD(IDSTRR,10) .EQ. 0 ) THEN
+            IF ( RANGEN() .LT. 0.33 ) AM=AM+0.300
+          ELSE
+            IF ( RANGEN() .GT. 0.33 ) THEN
+              ISPLT=-5
+              RETURN
+            ENDIF
+          ENDIF
+          CALL IDRES(IDSTR,AM,IDSTRR,IADJ)
+
+C  ALL LEGS ABSORBED
+        ELSEIF ( NSUC .EQ. 0 ) THEN
+          IF ( ISEA .EQ. 0 ) THEN
+            ISPLT=-4
+            RETURN
+          ENDIF
+          AM=0.
+          IF ( ISTRL .EQ. 1 ) THEN
+            AM=SQRT(ENGY**2*(1-ABS(PZSTRL)/PNLLX)+.94**2 )
+          ELSE
+            CALL IDRES(IDSTR,AM,IDSTRR,IADJ)
+            IF ( MOD(IDSTRR,10) .EQ. 0 ) THEN
+              AM=AM+RANGEN()
+            ELSE
+              AM=AM+RANGEN()-0.30
+            ENDIF
+C-C         IF ( MOD(IDSTRR,10).EQ.0.AND.RANGEN().LT.0.33 ) AM=AM+0.30
+          ENDIF
+          CALL IDRES(IDSTR,AM,IDSTRR,IADJ)
+        ENDIF
+      ENDIF
+
+C  LEADING STRING = HADRON:
+      IF ( LEAD.EQ.1 .AND. IA1.NE.0 .AND.IA2.NE.0
+     *     .AND. ISPLT0.EQ.0 .AND. ISPLT.EQ.0 .AND. IDSTRR.NE.0 ) THEN
+        AM=0.
+        CALL IDRES(IDSTR,AM,IDSTRR,IADJ)
+        IF ( MOD(IDSTRR,10).EQ.0  .AND.  RANGEN().LT.0.33 ) AM=AM+0.300
+        CALL IDRES(IDSTR,AM,IDSTRR,IADJ)
+      ENDIF
+
+      IDSTR=IDSTRR
+      IF ( IDSTR .EQ. 0  .AND.  AM .LT. AMSTR ) AM=AMSTR
+      PPM=AM
+      E=SQRT(PPP**2+PPM**2)
+
+C  WRITE /CSTR/
+C  ------------
+      NSTR=NSTR+1
+      IF ( NSTR .GT. MXSTR ) THEN
+        CALL UTSTOP('HASTPR: NSTR>MXSTR                      ')
+      ENDIF
+      IF ( LEAD .EQ. 0 ) NSTSH=1
+      NSUC=NSUC+1
+      IRLSTR(NSTR)=NSUC
+      IF ( ISPLT0 .EQ. 0  .AND.  ISPLT .EQ. 0 ) IRLSTR(NSTR)=0
+      ICSTR(1,NSTR)=IC1(1)
+      ICSTR(2,NSTR)=IC1(2)
+      ICSTR(3,NSTR)=IC2(1)
+      ICSTR(4,NSTR)=IC2(2)
+      PSTR(1,NSTR)=PX
+      PSTR(2,NSTR)=PY
+      PSTR(3,NSTR)=PZ
+      PSTR(4,NSTR)=E
+      PSTR(5,NSTR)=AM
+      ROTSTR(1,NSTR)=P1(1)
+      ROTSTR(2,NSTR)=P1(2)
+      ROTSTR(3,NSTR)=P1(3)
+      IF ( P1(1) .EQ. 0.  .AND.  P1(2) .EQ. 0.  .AND.  P1(3) .EQ. 0. )
+     *                                                ROTSTR(3,NSTR)=1.
+      XORSTR(1,NSTR)=COORD(1,KOLZ)
+      XORSTR(2,NSTR)=COORD(2,KOLZ)
+      XORSTR(3,NSTR)=COORD(3,KOLZ)
+      XORSTR(4,NSTR)=COORD(4,KOLZ)
+      IORSTR(NSTR)=-KOLZ
+      AMSAC=AMSAC+AM
+      IF ( ISH .GE. 91 ) THEN
+        IF     ( ISPLT .GT. 0 ) THEN
+          WRITE(IFCH,*)'SPLIT OFF STRING:'
+        ELSEIF ( ISPLT0 .GT. 0 ) THEN
+          WRITE(IFCH,*)'REMAINDER:'
+        ELSEIF ( LEAD .EQ. 1 ) THEN
+          WRITE(IFCH,*)'ORDINARY BARYONIC STRING:'
+        ELSE
+          WRITE(IFCH,*)'ORDINARY MESONIC STRING:'
+        ENDIF
+        WRITE(IFCH,106)NSTR,(ICSTR(K,NSTR)/100,K=1,4)
+     *                      ,(PSTR(I,NSTR),I=3,5)
+106     FORMAT(/' /CSTR/',I4,3X,4I5,2X,3(E10.3)/)
+      ENDIF
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE HDECMP(BAR,SIL,SIX)
+
+C-----------------------------------------------------------------------
+C  DECOMPOSES BAR INTO SIL,SIX
+C-----------------------------------------------------------------------
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      REAL BAR(NSI,NHA),SIL(NSI),SIX(NSI,NSIX)
+C-----------------------------------------------------------------------
+      DO 1 N=1,NSI
+        SIL(N)=BAR(N,2)
+ 1    CONTINUE
+      DO 3 M=1,NSIX
+        SIXSQR=0.
+        DO 2 N=1,NSI
+          SIX(N,M)=BAR(N,2+M)
+          SIXSQR=SIXSQR+SIX(N,M)**2
+ 2      CONTINUE
+        IF ( SIXSQR .LE. 1.E-5 ) RETURN
+ 3    CONTINUE
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE HRESCL(J1,J2,PSUM,IFAIL)
+
+C-----------------------------------------------------------------------
+C  RESCALES STRING MOMENTA OF STRINGS J1-J2 TO HAVE TOTAL MOM PSUM.
+C-----------------------------------------------------------------------
+      PARAMETER (MXSTR=3000)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CSTR/    PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
+     *                ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      DOUBLE PRECISION PADD(5),PP(5),PPSUM(5)
+      REAL             PSUM(5)
+      DATA             ERRLIM /.001/
+C-----------------------------------------------------------------------
+      IFAIL=1
+
+      PPSUM(1)=PSUM(1)
+      PPSUM(2)=PSUM(2)
+      PPSUM(3)=PSUM(3)
+      PPSUM(4)=PSUM(4)
+      PPSUM(5)=PSUM(5)
+
+      IF ( J1 .GE. J2 ) THEN
+        CALL UTSTOP('HRESCL: J1 .GE. J2                      ')
+      ENDIF
+
+      PADD(1)=0.D0
+      PADD(2)=0.D0
+      PADD(3)=0.D0
+      PADD(4)=0.D0
+      PADD(5)=0.D0
+      DO 110 J=J1,J2
+        PADD(1)=PADD(1)+PSTR(1,J)
+        PADD(2)=PADD(2)+PSTR(2,J)
+        PADD(3)=PADD(3)+PSTR(3,J)
+        PADD(4)=PADD(4)+PSTR(4,J)
+        PADD(5)=PADD(5)+PSTR(5,J)
+110   CONTINUE
+      IF ( PADD(5) .GE. PPSUM(5) ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('HRESCL')
+          WRITE(IFCH,*)'*****  SUM OF STR MASSES .GE. PSUM(5)'
+          DO 1 J=J1,J2
+            WRITE(IFCH,109)J,(ICSTR(K,J)/100,K=1,4)
+     *                       ,(PSTR(L,J),L=3,5)
+109         FORMAT(' /CSTR/',I4,3X,4I5,2X,3(E10.3))
+ 1        CONTINUE
+          WRITE(IFCH,*)'PPSUM(345):',(SNGL(PPSUM(K)),K=3,5)
+          CALL UTMSGF
+        ENDIF
+        RETURN
+      ENDIF
+      PADD(5)=PADD(4)**2-PADD(1)**2-PADD(2)**2-PADD(3)**2
+      IF ( PADD(5) .LE. 0.D0 ) THEN
+        DO 2 J=J1,J2
+          WRITE(IFCH,108)J,(PSTR(L,J),L=1,5)
+108       FORMAT(' /CSTR/',I4,2X,5(E10.3))
+ 2      CONTINUE
+        CALL UTSTOP('HRESCL: MASS**2 OF STRING-SUM NEGATIVE  ')
+      ENDIF
+      PADD(5)=SQRT(PADD(5))
+
+C  BOOST STRINGS TO REST
+C  ---------------------
+      DO 115 J=J1,J2
+        PP(1)=PSTR(1,J)
+        PP(2)=PSTR(2,J)
+        PP(3)=PSTR(3,J)
+        PP(4)=PSTR(4,J)
+        CALL UTLOB2(1,PADD(1),PADD(2),PADD(3),PADD(4),PADD(5)
+     *                ,PP(1),PP(2),PP(3),PP(4))
+        PSTR(1,J)=PP(1)
+        PSTR(2,J)=PP(2)
+        PSTR(3,J)=PP(3)
+        PSTR(4,J)=PP(4)
+115   CONTINUE
+
+C  RESCALE MOMENTA IN REST FRAME
+C  -----------------------------
+      SCAL=1.
+      DO 301 IPASS=1,200
+        SUM=0.
+        DO 310 J=J1,J2
+          PSTR(1,J)=SCAL*PSTR(1,J)
+          PSTR(2,J)=SCAL*PSTR(2,J)
+          PSTR(3,J)=SCAL*PSTR(3,J)
+          PSTR(4,J)=SQRT(PSTR(1,J)**2+PSTR(2,J)**2+PSTR(3,J)**2
+     *                  +PSTR(5,J)**2)
+          SUM=SUM+PSTR(4,J)
+310     CONTINUE
+        SCAL=PSUM(5)/SUM
+        IF ( ABS(SCAL-1.) .LE. ERRLIM ) GOTO 300
+301   CONTINUE
+      IF ( ISH .GE. 90 ) THEN
+        CALL UTMSG('HRESCL')
+        WRITE(IFCH,*)'*****  SCAL=',SCAL
+        CALL UTMSGF
+      ENDIF
+300   CONTINUE
+
+C  BOOST BACK WITH PPSUM
+C  ---------------------
+      DO 315 J=J1,J2
+        PP(1)=PSTR(1,J)
+        PP(2)=PSTR(2,J)
+        PP(3)=PSTR(3,J)
+        PP(4)=PSTR(4,J)
+        CALL UTLOB2(-1,PPSUM(1),PPSUM(2),PPSUM(3),PPSUM(4),PPSUM(5)
+     *             ,PP(1),PP(2),PP(3),PP(4))
+        PSTR(1,J)=PP(1)
+        PSTR(2,J)=PP(2)
+        PSTR(3,J)=PP(3)
+        PSTR(4,J)=PP(4)
+315   CONTINUE
+
+      IFAIL=0
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDCOMJ(JC)
+
+C-----------------------------------------------------------------------
+C  COMPACTIFIES JC
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      INTEGER IC(2),ICX(2),JC(NFLAV,2)
+C-----------------------------------------------------------------------
+      CALL IDCOMP(IC,ICX,JC,2)
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDCOMK(IC)
+
+C-----------------------------------------------------------------------
+C  COMPACTIFIES IC
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      INTEGER IC(2),ICX(2),JC(NFLAV,2)
+C-----------------------------------------------------------------------
+      CALL IDCOMP(IC,ICX,JC,1)
+      IC(1)=ICX(1)
+      IC(2)=ICX(2)
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDCOMP(IC,ICX,JC,IM)
+
+C-----------------------------------------------------------------------
+C  COMPACTIFIES IC,JC
+C  INPUT: IM (1 OR 2)
+C         IC (IF IM=1)
+C         JC (IF IM=2)
+C  OUTPUT: ICX (IF IM=1)
+C          JC
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      INTEGER IC(2),ICX(2),JC(NFLAV,2)
+C-----------------------------------------------------------------------
+      IF ( IM .EQ. 1 ) CALL IDDECO(IC,JC)
+      ICX(1)=0
+      ICX(2)=0
+      DO 2 N=1,NFLAV
+        IF ( JC(N,1) .NE. 0  .OR. JC(N,2) .NE. 0 ) GOTO 1
+ 2    CONTINUE
+      RETURN
+ 1    L=0
+      DO 3 N=1,NFLAV
+        K=MIN(JC(N,1),JC(N,2))
+        JC(N,1)=JC(N,1)-K
+        JC(N,2)=JC(N,2)-K
+        IF ( JC(N,1) .LT. 0  .OR.  JC(N,2) .LT. 0 ) THEN
+          CALL UTSTOP('IDCOMP: JC NEGATIVE                     ')
+        ENDIF
+        L=L+JC(N,1)+JC(N,2)
+ 3    CONTINUE
+      IF ( L .EQ. 0 ) THEN
+        JC(1,1)=1
+        JC(1,2)=1
+      ENDIF
+      IF ( IM .EQ. 1 ) THEN
+        CALL IDENCO(JC,ICX,IRETEN)
+        IF ( IRETEN .EQ. 1 ) THEN
+          CALL UTSTOP('IDCOMP: IDENCO RET CODE = 1             ')
+        ENDIF
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDDECO(IC,JC)
+
+C-----------------------------------------------------------------------
+C  DECODE PARTICLE ID
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      INTEGER IC(2),JC(NFLAV,2)
+C-----------------------------------------------------------------------
+      ICI=IC(1)
+      JC(6,1)=MOD(ICI,10)
+      JC(5,1)=MOD(ICI/10,10)
+      JC(4,1)=MOD(ICI/100,10)
+      JC(3,1)=MOD(ICI/1000,10)
+      JC(2,1)=MOD(ICI/10000,10)
+      JC(1,1)=MOD(ICI/100000,10)
+      ICI=IC(2)
+      JC(6,2)=MOD(ICI,10)
+      JC(5,2)=MOD(ICI/10,10)
+      JC(4,2)=MOD(ICI/100,10)
+      JC(3,2)=MOD(ICI/1000,10)
+      JC(2,2)=MOD(ICI/10000,10)
+      JC(1,2)=MOD(ICI/100000,10)
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDENCO(JC,IC,IRETEN)
+
+C-----------------------------------------------------------------------
+C  ENCODE PARTICLE ID
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      INTEGER IC(2),JC(NFLAV,2)
+C-----------------------------------------------------------------------
+      IRETEN=0
+      IC(1)=0
+      DO 20 I=1,NFLAV
+        IF ( JC(I,1) .GE. 10 ) GOTO 22
+        IC(1)=IC(1)+JC(I,1)*10**(NFLAV-I)
+20    CONTINUE
+      IC(2)=0
+      DO 21 I=1,NFLAV
+        IF ( JC(I,2) .GE. 10 ) GOTO 22
+        IC(2)=IC(2)+JC(I,2)*10**(NFLAV-I)
+21    CONTINUE
+      RETURN
+22    IRETEN=1
+      IC(1)=0
+      IC(2)=0
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDFLAV(ID,IFL1,IFL2,IFL3,JSPIN,INDEX)
+
+C-----------------------------------------------------------------------
+C  UNPACKS THE IDENT CODE ID=+/-IJKL
+C
+C          MESONS--
+C          I=0, J<=K, +/- IS SIGN FOR J
+C          ID=110 FOR PI0, ID=220 FOR ETA, ETC.
+C
+C          BARYONS--
+C          I<=J<=K IN GENERAL
+C          J<I<K FOR SECOND STATE ANTISYMMETRIC IN (I,J), EG. L = 2130
+C
+C          OTHER--
+C          ID=1,...,6 FOR QUARKS
+C          ID=9 FOR GLUON
+C          ID=10 FOR PHOTON
+C          ID=11,...,16 FOR LEPTONS
+C          ID=20 FOR KS, ID=-20 FOR KL
+C
+C          I=21...26 FOR SCALAR QUARKS
+C          I=29 FOR GLUINO
+C          I=30 FOR PHOTINO
+C          I=31...36 FOR SCALAR LEPTONS
+C          I=39 FOR WINO
+C          I=40 FOR ZINO
+C
+C          ID=80 FOR W+
+C          ID=81,...,89 FOR HIGGS MESONS
+C          ID=90 FOR Z0
+C
+C          DIQUARKS--
+C          ID=+/-IJ00, I<J FOR DIQUARK COMPOSED OF I,J.
+C
+C          INDEX IS A SEQUENCE NUMBER USED INTERNALLY
+C-----------------------------------------------------------------------
+      PARAMETER (NMES=2)
+      PARAMETER (NQLEP=41)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+C-----------------------------------------------------------------------
+      IDABS=ABS(ID)
+      I=IDABS/1000
+      J1=IDABS-I*1000
+      J = J1/100
+      ISI = SIGN(1,ID)
+      IF ( ID .NE. 0  .AND.  MOD(ID,100) .EQ. 0 ) GOTO 300
+      IF ( J .EQ. 0 ) GOTO 200
+      K1= J1 - J*100
+      K = K1/10
+      JSPIN= K1 - K*10
+      IF ( I .EQ. 0 ) GOTO 100
+C  BARYONS
+C  ONLY X,Y BARYONS ARE QQX, QQY, Q=U,D,S.
+      IFL1=ISI*I
+      IFL2=ISI*J
+      IFL3=ISI*K
+      IF ( K .LE. 6 ) THEN
+        INDEX=MAX(I-1,J-1)**2+I+MAX(I-J,0)+(K-1)*K*(2*K-1)/6
+     *                        +109*JSPIN+36*NMES+NQLEP+11
+      ELSE
+        INDEX=MAX(I-1,J-1)**2+I+MAX(I-J,0)+9*(K-7)+91
+     *                        +109*JSPIN+36*NMES+NQLEP+11
+      ENDIF
+      RETURN
+C  MESONS
+100   CONTINUE
+      IFL1=0
+      IFL2=ISI*J
+      IFL3=ISI*K
+      INDEX=J+K*(K-1)/2+36*JSPIN+NQLEP
+      INDEX=INDEX+11
+      RETURN
+C  QUARKS, LEPTONS, ETC
+200   CONTINUE
+      IFL1=0
+      IFL2=0
+      IFL3=0
+      JSPIN=0
+      INDEX=IDABS
+      IF ( IDABS .LT. 20 ) RETURN
+C  DEFINE INDEX=20 FOR KS, INDEX=21 FOR KL
+      INDEX=IDABS+1
+      IF ( ID .EQ. 20 ) INDEX=20
+C  INDEX=NQLEP+1,...,NQLEP+11 FOR W+, HIGGS, Z0
+      IF ( IDABS .LT. 80 ) RETURN
+      INDEX=NQLEP+IDABS-79
+      RETURN
+300   CONTINUE
+      IFL1=ISI*I
+      IFL2=ISI*J
+      IFL3=0
+      JSPIN=0
+      INDEX=0
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION IDLABL(ID)
+
+C-----------------------------------------------------------------------
+C  RETURNS THE CHARACTER*8 LABEL FOR THE PARTICLE ID
+C-----------------------------------------------------------------------
+      PARAMETER (NMES=2)
+      PARAMETER (NQLEP=41)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+
+      CHARACTER*8 IDLABL,LABAR0(109),LABAR1(109),LAQQ(21),LBAR0(109)
+     *           ,LBAR1(109),LLEP(104),LMES0(64),LMES1(64),LQQ(21)
+
+C          DIQUARK LABELS
+      DATA LQQ/
+     1'UU0. ','UD0. ','DD0. ','US0. ','DS0. ','SS0. ','UC0. ','DC0. ',
+     2'SC0. ','CC0. ','UB0. ','DB0. ','SB0. ','CB0. ','BB0. ','UT0. ',
+     3'DT0. ','ST0. ','CT0. ','BT0. ','TT0. '/
+      DATA LAQQ/
+     1'AUU0.','AUD0.','ADD0.','AUS0.','ADS0.','ASS0.','AUC0.','ADC0.',
+     2'ASC0.','ACC0.','AUB0.','ADB0.','ASB0.','ACB0.','ABB0.','AUT0.',
+     3'ADT0.','AST0.','ACT0.','ABT0.','ATT0.'/
+C          QUARK AND LEPTON LABELS
+      DATA LLEP/
+     *'     ','UP   ','UB   ','DN   ','DB   ','ST   ','SB   ','CH   ',
+     *'CB   ','BT   ','BB   ','TP   ','TB   ','Y    ','YB   ','X    ',
+     *'XB   ','GL   ','ERR  ','GM   ','ERR  ','NUE  ','ANUE ','E-   ',
+     *'E+   ','NUM  ','ANUM ','MU-  ','MU+  ','NUT  ','ANUT ','TAU- ',
+     *'TAU+ ','ERR  ','ERR  ','ERR  ','ERR  ','ERR  ','ERR  ','KS   ',
+     *'ERR  ','ERR  ','KL   ',
+     *'UPSS ','UBSS ','DNSS ','DBSS ','STSS ','SBSS ','CHSS ','CBSS ',
+     *'BTSS ','BBSS ','TPSS ','TBSS ','ERR  ','ERR  ','ERR  ','ERR  ',
+     *'GLSS ','ERR  ','GMSS ','ERR  ','NESS ','ANESS','E-SS ','E+SS ',
+     *'NMSS ','ANMSS','MU-SS','MU+SS','NTSS ','ANTSS','T-SS ','T+SS ',
+     *'ERR  ','ERR  ','ERR  ','ERR  ','W+SS ','W-SS ','Z0SS ','ERR  ',
+     *'W+   ','W-   ','H10  ','AH10 ','H20  ','AH20 ','H30  ','AH30 ',
+     *'H4+  ','H4-  ','H5+  ','H5-  ','H6+  ','H6-  ','H7++ ','H7-- ',
+     *'H8++ ','H8-- ','H9++ ','H9-- ','Z0   '/
+C          0- MESON LABELS
+      DATA LMES0/
+     1'PI0  ','PI+  ','ETA  ','PI-  ','K+   ','K0   ','ETAP ','AK0  ',
+     2'K-   ','AD0  ','D-   ','F-   ','ETAC ','F+   ','D+   ','D0   ',
+     2'UB.  ','DB.  ','SB.  ','CB.  ','BB.  ','BC.  ','BS.  ','BD.  ',
+     3'BU.  ','UT.  ','DT.  ','ST.  ','CT.  ','BT.  ','TT.  ','TB.  ',
+     4'TC.  ','TS.  ','TD.  ','TU.  ','UY.  ','DY.  ','SY.  ','CY.  ',
+     5'BY.  ','TY.  ','YY.  ','YT.  ','YB.  ','YC.  ','YS.  ','YD.  ',
+     6'YU.  ','UX.  ','DX.  ','SX.  ','CX.  ','BX.  ','TX.  ','YX.  ',
+     7'XX.  ','XY.  ','XT.  ','XB.  ','XC.  ','XS.  ','XD.  ','XU.  '/
+C          1- MESON LABELS
+      DATA LMES1/
+     1'RHO0 ','RHO+ ','OMEG ','RHO- ','K*+  ','K*0  ','PHI  ','AK*0 ',
+     2'K*-  ','AD*0 ','D*-  ','F*-  ','JPSI ','F*+  ','D*+  ','D*0  ',
+     3'UB*  ','DB*  ','SB*  ','CB*  ','UPSL ','BC*  ','BS*  ','BD*  ',
+     4'BU*  ','UT*  ','DT*  ','ST*  ','CT*  ','BT*  ','TT*  ','TB*  ',
+     5'TC*  ','TS*  ','TD*  ','TU*  ','UY*  ','DY*  ','SY*  ','CY*  ',
+     6'BY*  ','TY*  ','YY*  ','YT*  ','YB*  ','YC*  ','YS*  ','YD*  ',
+     7'YU*  ','UX*  ','DX*  ','SX*  ','CX*  ','BX*  ','TX*  ','YX*  ',
+     8'XX*  ','XY*  ','XT*  ','XB*  ','XC*  ','XS*  ','XD*  ','XU*  '/
+C          1/2+ BARYON LABELS
+      DATA LBAR0/
+     1'ERR  ','P    ','N    ','ERR  ','ERR  ','S+   ','S0   ','S-   ',
+     2'L    ','XI0  ','XI-  ','ERR  ','ERR  ','ERR  ','SC++ ','SC+  ',
+     3'SC0  ','LC+  ','USC. ','DSC. ','SSC. ','SDC. ','SUC. ','UCC. ',
+     4'DCC. ','SCC. ','ERR  ','ERR  ','ERR  ','ERR  ','UUB. ','UDB. ',
+     5'DDB. ','DUB. ','USB. ','DSB. ','SSB. ','SDB. ','SUB. ','UCB. ',
+     6'DCB. ','SCB. ','CCB. ','CSB. ','CDB. ','CUB. ','UBB. ','DBB. ',
+     7'SBB. ','CBB. ','ERR  ','ERR  ','ERR  ','ERR  ','ERR  ','UTT. ',
+     8'UDT. ','DDT. ','DUT. ','UST. ','DST. ','SST. ','SDT. ','SUT. ',
+     9'UCT. ','DCT. ','SCT. ','CCT. ','CST. ','CDT. ','CUT. ','UBT. ',
+     1'DBT. ','SBT. ','CBT. ','BBT. ','BCT. ','BST. ','BDT. ','BUT. ',
+     2'UTT. ','DTT. ','STT. ','CTT. ','BTT. ','ERR  ','ERR  ','ERR  ',
+     3'ERR  ','ERR  ','ERR  ','UUY. ','UDY. ','DDY. ','DUY. ','USY. ',
+     4'DSY. ','SSY. ','SDY. ','SUY. ','UUX. ','UDX. ','DDX. ','DUX. ',
+     5'USX. ','DSX. ','SSX. ','SDX. ','SUX. '/
+      DATA LABAR0/
+     1'ERR  ','AP   ','AN   ','ERR  ','ERR  ','AS-  ','AS0  ','AS+  ',
+     2'AL   ','AXI0 ','AXI+ ','ERR  ','ERR  ','ERR  ','ASC--','ASC- ',
+     3'ASC0 ','ALC- ','AUSC.','ADSC.','ASSC.','ASDC.','ASUC.','AUCC.',
+     4'ADCC.','ASCC.','ERR  ','ERR  ','ERR  ','ERR  ','AUUB.','AUDB.',
+     5'ADDB.','ADUB.','AUSB.','ADSB.','ASSB.','ASDB.','ASUB.','AUCB.',
+     6'ADCB.','ASCB.','ACCB.','ACSB.','ACDB.','ACUB.','AUBB.','ADBB.',
+     7'ASBB.','ACBB.','ERR  ','ERR  ','ERR  ','ERR  ','ERR  ','AUTT.',
+     8'AUDT.','ADDT.','ADUT.','AUST.','ADST.','ASST.','ASDT.','ASUT.',
+     9'AUCT.','ADCT.','ASCT.','ACCT.','ACST.','ACDT.','ACUT.','AUBT.',
+     1'ADBT.','ASBT.','ACBT.','ABBT.','ABCT.','ABST.','ABDT.','ABUT.',
+     2'AUTT.','ADTT.','ASTT.','ACTT.','ABTT.','ERR  ','ERR  ','ERR  ',
+     3'ERR  ','ERR  ','ERR  ','AUUY.','AUDY.','ADDY.','ADUY.','AUSY.',
+     4'ADSY.','ASSY.','ASDY.','ASUY.','AUUX.','AUDX.','ADDX.','ADUX.',
+     5'AUSX.','ADSX.','ASSX.','ASDX.','ASUX.'/
+C          3/2+ BARYON LABELS
+      DATA LBAR1/
+     1'DL++ ','DL+  ','DL0  ','DL-  ','ERR  ','S*+  ','S*0  ','S*-  ',
+     2'ERR  ','XI*0 ','XI*- ','OM-  ','ERR  ','ERR  ','UUC* ','UDC* ',
+     3'DDC* ','ERR  ','USC* ','DSC* ','SSC* ','ERR  ','ERR  ','UCC* ',
+     4'DCC* ','SCC* ','CCC* ','ERR  ','ERR  ','ERR  ','UUB* ','UDB* ',
+     5'DDB* ','ERR  ','USB* ','DSB* ','SSB* ','ERR  ','ERR  ','UCB* ',
+     6'DCB* ','SCB* ','CCB* ','ERR  ','ERR  ','ERR  ','UBB* ','DBB* ',
+     7'SBB* ','CBB* ','BBB* ','ERR  ','ERR  ','ERR  ','ERR  ','UTT* ',
+     8'UDT* ','DDT* ','ERR  ','UST* ','DST* ','SST* ','ERR  ','ERR  ',
+     9'UCT* ','DCT* ','SCT* ','CCT* ','ERR  ','ERR  ','ERR  ','UBT* ',
+     1'DBT* ','SBT* ','CBT* ','BBT* ','ERR  ','ERR  ','ERR  ','ERR  ',
+     2'UTT* ','DTT* ','STT* ','CTT* ','BTT* ','TTT* ','ERR  ','ERR  ',
+     3'ERR  ','ERR  ','ERR  ','UUY* ','UDY* ','DDY* ','ERR  ','USY* ',
+     4'DSY* ','SSY* ','ERR  ','ERR  ','UUX* ','UDX* ','DDX* ','ERR  ',
+     5'USX* ','DSX* ','SSX* ','ERR  ','ERR  '/
+      DATA LABAR1/
+     1'ADL--','ADL- ','ADL0 ','ADL+ ','ERR  ','AS*- ','AS*0 ','AS*+ ',
+     2'ERR  ','AXI*0','AXI*+','AOM+ ','ERR  ','ERR  ','AUUC*','AUDC*',
+     3'ADDC*','ERR  ','AUSC*','ADSC*','ASSC*','ERR  ','ERR  ','AUCC*',
+     4'ADCC*','ASCC*','ACCC*','ERR  ','ERR  ','ERR  ','AUUB*','AUDB*',
+     5'ADDB*','ERR  ','AUSB*','ADSB*','ASSB*','ERR  ','ERR  ','AUCB*',
+     6'ADCB*','ASCB*','ACCB*','ERR  ','ERR  ','ERR  ','AUBB*','ADBB*',
+     7'ASBB*','ACBB*','ABBB*','ERR  ','ERR  ','ERR  ','ERR  ','AUTT*',
+     8'AUDT*','ADDT*','ERR  ','AUST*','ADST*','ASST*','ERR  ','ERR  ',
+     9'AUCT*','ADCT*','ASCT*','ACCT*','ERR  ','ERR  ','ERR  ','AUBT*',
+     1'ADBT*','ASBT*','ACBT*','ABBT*','ERR  ','ERR  ','ERR  ','ERR  ',
+     2'AUTT*','ADTT*','ASTT*','ACTT*','ABTT*','ATTT*','ERR  ','ERR  ',
+     3'ERR  ','ERR  ','ERR  ','AUUY*','AUDY*','ADDY*','ERR  ','AUSY*',
+     4'ADSY*','ASSY*','ERR  ','ERR  ','AUUX*','AUDX*','ADDX*','ERR  ',
+     5'AUSX*','ADSX*','ASSX*','ERR  ','ERR  '/
+C-----------------------------------------------------------------------
+      CALL IDFLAV(ID,IFL1,IFL2,IFL3,JSPIN,INDEX)
+      IF ( ABS(ID) .LT.   100 ) GOTO 200
+      IF ( ABS(ID) .LT. 1000 ) GOTO 100
+      IF ( ID .NE. 0  .AND.  MOD(ID,100) .EQ. 0 ) GOTO 300
+C  BARYONS
+      INDEX=INDEX-109*JSPIN-36*NMES-NQLEP
+      INDEX=INDEX-11
+      IF     ( JSPIN .EQ. 0 ) THEN
+        IF     ( ID .GT. 0 ) THEN
+          IDLABL=LBAR0(INDEX)
+        ELSEIF ( ID .LT. 0 ) THEN
+          IDLABL=LABAR0(INDEX)
+        ENDIF
+      ELSEIF ( JSPIN .EQ. 1 ) THEN
+        IF     ( ID .GT. 0 ) THEN
+          IDLABL=LBAR1(INDEX)
+        ELSEIF ( ID .LT. 0 ) THEN
+          IDLABL=LABAR1(INDEX)
+        ENDIF
+      ENDIF
+      RETURN
+C  MESONS
+100   CONTINUE
+      I=MAX(IFL2,IFL3)
+      J=-MIN(IFL2,IFL3)
+      INDEX=MAX(I-1,J-1)**2+I+MAX(I-J,0)
+      IF     ( JSPIN .EQ. 0 ) THEN
+        IDLABL=LMES0(INDEX)
+      ELSEIF ( JSPIN .EQ. 1 ) THEN
+        IDLABL=LMES1(INDEX)
+      ENDIF
+      RETURN
+C  QUARKS, LEPTONS, ETC.
+200   CONTINUE
+      INDEX=2*INDEX
+      IF ( ID .LE. 0 ) INDEX=INDEX+1
+      IDLABL=LLEP(INDEX)
+      RETURN
+300   I=ABS(IFL1)
+      J=ABS(IFL2)
+      INDEX=I+J*(J-1)/2
+      IF ( ID .GT. 0 ) THEN
+        IDLABL=LQQ(INDEX)
+      ELSE
+        IDLABL=LAQQ(INDEX)
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDMASS(ID,AMASS)
+
+C-----------------------------------------------------------------------
+C  RETURNS THE MASS OF THE PARTICLE WITH IDENT CODE ID.
+C-----------------------------------------------------------------------
+      PARAMETER (NMES=2)
+      PARAMETER (NQLEP=41)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      REAL    AMBAR0(30),AMBAR1(30),AMLEP(52),AMMES0(10),AMMES1(10)
+
+      DATA AMLEP/.3,.3,.5,1.6,4.9,30.,-1.,-1.,0.,0.,
+     *0.,.511003E-3,0.,.105661,0.,1.807,3*-1.,.49767,.49767,
+     *100.3,100.3,100.5,101.6,104.9,130.,2*-1.,100.,0.,
+     *100.,100.005,100.,100.1,100.,101.8,2*-1.,100.,100.,
+     *11*0./
+C          0- MESON MASS TABLE
+      DATA AMMES0/.13496,.13957,.5488,.49367,.49767,.9576,1.8633
+     1,1.8683,2.030,2.976/
+C          1- MESON MASS TABLE
+      DATA AMMES1/.770,.770,.7826,.8881,.8922,1.0196,2.006,2.0086
+     1,2.140,3.097/
+C          1/2+ BARYON MASS TABLE
+      DATA AMBAR0/-1.,.93828,.93957,2*-1.,1.1894,1.1925,1.1974
+     1,1.1156,1.3149,1.3213,3*-1.,2.43,2.43,2.43,2.26
+     2,2.50,2.50,2.60,2.40,2.40,3.55,3.55,3.70,4*-1./
+C          3/2+ BARYON MASS TABLE
+      DATA AMBAR1/1.232,1.232,1.232,1.232,-1.,1.3823,1.3820
+     1,1.3875,-1.,1.5318,1.5350,1.6722,2*-1.
+     2,2.63,2.63,2.63,-1.,2.70,2.70,2.80,2*-1.,3.75,3.75
+     3,3.90,4.80,3*-1./
+C-----------------------------------------------------------------------
+      IDABS=ABS(ID)
+      I=IDABS/1000
+      J1=IDABS-I*1000
+      J = J1/100
+      IF ( ID .NE. 0  .AND.  MOD(ID,100) .EQ. 0 ) GOTO 400
+      K1= J1 - J*100
+      K = K1/10
+      JSPIN= K1 - K*10
+      IF ( I .GT. 4   .OR.  J .GT. 4   .OR. K .GT .4 ) GOTO 300
+      IF ( J .EQ. 0 ) GOTO 200
+      IF ( I .EQ. 0 ) GOTO 100
+C  BARYONS
+C  ONLY X,Y BARYONS ARE QQX, QQY, Q=U,D,S.
+      IF ( K .LE. 6 ) THEN
+        INDEX=MAX(I-1,J-1)**2+I+MAX(I-J,0)+(K-1)*K*(2*K-1)/6
+      ELSE
+        INDEX=MAX(I-1,J-1)**2+I+MAX(I-J,0)+9*(K-7)+91
+      ENDIF
+      AMASS=(1-JSPIN)*AMBAR0(INDEX)+JSPIN*AMBAR1(INDEX)
+      RETURN
+C  MESONS
+100   CONTINUE
+      INDEX = J + K*(K-1)/2
+      AMASS = (1-JSPIN)*AMMES0(INDEX) + JSPIN*AMMES1(INDEX)
+      RETURN
+C  QUARKS, LEPTONS, ETC
+200   CONTINUE
+      IF     ( IDABS .LT. 20 ) THEN
+        INDEX = IDABS
+C  DEFINE INDEX=20 FOR KS, INDEX=21 FOR KL
+      ELSEIF ( ID .EQ. 20 ) THEN
+        INDEX = 20
+C  INDEX=NQLEP+1,...,NQLEP+11 FOR W+, HIGGS, Z0
+      ELSEIF ( IDABS .LT. 80 ) THEN
+        INDEX = IDABS+1
+      ELSE
+        INDEX = NQLEP+IDABS-79
+      ENDIF
+      AMASS=AMLEP(INDEX)
+      RETURN
+C  B AND T PARTICLES
+300   CONTINUE
+      AMASS=AMLEP(J)+AMLEP(K)-.03+.04*JSPIN
+      IF ( I .NE. 0 ) AMASS=AMASS+AMLEP(I)
+      RETURN
+C  DIQUARKS
+400   CONTINUE
+      AMASS=AMLEP(I)+AMLEP(J)
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDMIX(IC,JSPIN,ICM,IDM)
+
+C-----------------------------------------------------------------------
+C  ACCOUNTS FOR FLAVOUR MIXING
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      REAL    PMIX1(3,2),PMIX2(3,2)
+      INTEGER IC(2),ICM(2)
+      DATA PMIX1 /.25,.25,.5,0.,.5,1./, PMIX2 /.5,.5,1.,0.,0.,1./
+C-----------------------------------------------------------------------
+      ICM(1)=0
+      ICM(2)=0
+      IDM=0
+      I=IC(1)
+      IF ( I .NE. IC(2) ) RETURN
+      ID=0
+      IF ( I .EQ. 100000 ) ID=1
+      IF ( I .EQ.  10000 ) ID=2
+      IF ( I .EQ.   1000 ) ID=3
+      IF ( ID .EQ. 0 ) RETURN
+      RND=RANGEN()
+      IDM=INT(PMIX1(ID,JSPIN+1)+RND)+INT(PMIX2(ID,JSPIN+1)+RND)+1
+      ICM(1)=10**(NFLAV-IDM)
+      ICM(2)=IC(1)
+      IDM=IDM*100+IDM*10+JSPIN
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDQUAC(I,NQ,NS,NA,JC)
+
+C-----------------------------------------------------------------------
+C  RETURNS QUARK CONTENT OF PTL I FROM /CPTL/ .
+C        NQ = # QUARKS - # ANTIQUARKS
+C        NS = # STRANGE QUARKS - # STRANGE ANTIQUARKS
+C        NA = # QUARKS + # ANTIQUARKS
+C        JC(NFLAV,2) = JC-TYPE PARTICLE IDENTIFICATION CODE.
+C-----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      PARAMETER (NFLAV=6)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      INTEGER IC(2),JC(NFLAV,2)
+C-----------------------------------------------------------------------
+      IF ( ABS(IDPTL(I)) .EQ. 20 ) THEN
+        IF ( RANGEN() .LT. .5 ) THEN
+          IDPTL(I)=-230
+        ELSE
+          IDPTL(I)=230
+        ENDIF
+        GOTO 9999
+      ENDIF
+
+      IF ( ABS(IDPTL(I)) .LT. 100 ) THEN
+        NQ=0
+        NS=0
+        DO 1 N=1,NFLAV
+          JC(N,1)=0
+          JC(N,2)=0
+ 1      CONTINUE
+      RETURN
+      ENDIF
+
+9999  IF ( IDPTL(I)/100000000 .NE. 7 ) THEN
+        CALL IDTR4(IDPTL(I),IC)
+        CALL IDDECO(IC,JC)
+      ELSE
+        CALL IDTRB(IBPTL(1,I),IBPTL(2,I),IBPTL(3,I),IBPTL(4,I),JC)
+      ENDIF
+      NA=0
+      NQ=0
+      DO 53 N=1,NFLAV
+        NA=NA+JC(N,1)+JC(N,2)
+        NQ=NQ+JC(N,1)-JC(N,2)
+53    CONTINUE
+      NS=JC(3,1)-JC(3,2)
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDRES(ID,AM,IDR,IADJ)
+
+C-----------------------------------------------------------------------
+C  RETURNS RESONANCE ID IDR CORRESPONDING TO MASS AM.
+C  PERFORMS MASS ADJUSTMENT, IF NECESSARY (IF SO IADJ=1, 0 ELSE)
+C-----------------------------------------------------------------------
+      PARAMETER (MXINDX=1000)
+      PARAMETER (MXMA=11)
+      PARAMETER (MXMX=6)
+      PARAMETER (MXRE=100)
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CREMA/   REMA(MXRE,MXMA),REWI(MXRE,MXMA)
+     *                ,ICRE1(MXRE,MXMA),ICRE2(MXRE,MXMA)
+     *                ,IDMX(MXMA,MXMX),INDX(MXINDX)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+C-----------------------------------------------------------------------
+      IF ( AM .EQ. 0. ) AM=1.E-5
+
+      IDI=ID
+      AMI=AM
+      IDR=0
+      IADJ=0
+
+      IF ( ID .EQ. 0 ) GOTO 9999
+      IDABS = ABS(ID)
+      DO 5 K=1,MXMX
+        DO 3 M=2,MXMA
+          IF ( IDABS .EQ. IDMX(M,K) ) THEN
+            ID=SIGN(IDMX(1,K)*10,ID)
+            GOTO 5
+          ENDIF
+3       CONTINUE
+5     CONTINUE
+
+      IX=IDABS/10
+      IF ( IX .LT. 1  .OR.  IX .GT. MXINDX ) THEN
+        CALL UTSTOP('IDRES: IX OUT OF RANGE.                 ')
+      ENDIF
+      I=INDX(IX)
+      IF ( I .LT. 1  .OR.  I .GT. MXRE ) THEN
+        CALL UTSTOP('IDRES: PARTICLE NOT IN TABLE            ')
+      ENDIF
+      DO 1 J=1,MXMA-1
+        IF ( AM .GE. REMA(I,J)  .AND.  AM .LE. REMA(I,J+1) ) THEN
+          IF ( J .GT. 10 ) THEN
+            CALL UTSTOP('IDRES: SPIN > 9                         ')
+          ENDIF
+          IDR=ID/10*10+SIGN(J-1,ID)
+          GOTO 2
+        ENDIF
+ 1    CONTINUE
+      GOTO 9999
+ 2    CONTINUE
+
+      DO 4 K=1,MXMX
+        IF ( IX .EQ. IDMX(1,K) ) THEN
+          IF ( J .LT. 1  .OR.  J .GT. MXMA-1 ) THEN
+            CALL UTSTOP('IDRES: INDEX J OUT OF RANGE             ')
+          ENDIF
+          IF ( IDMX(J+1,K) .NE. 0 ) IDR = SIGN(IDMX(J+1,K),ID)
+        ENDIF
+ 4    CONTINUE
+
+      IY=MOD(IABS(IDR),10)
+      IF ( IY .GT. MAXRES ) THEN
+        IADJ=0
+        IDR=0
+        GOTO 9999
+      ENDIF
+
+      IF ( IY .NE. 0  .AND.  IY .NE. 1 ) GOTO 9999
+
+      CALL IDMASS(IDR,AM)
+      IF ( AM .LT. 0. ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'*****  ERROR IN IDRES: '
+     *      ,'NEG MASS RETURNED FROM IDMASS'
+        WRITE(IFCH,*)'ID,AM(INPUT):',IDI,AMI
+        WRITE(IFCH,*)'IDR,AM:',IDR,AM
+        CALL UTSTOP('IDRES: NEG MASS RETURNED FROM IDMASS    ')
+      ENDIF
+      IADJ=1
+
+9999  ID=IDI
+      IF ( ISH .LT. 93 ) RETURN
+      WRITE(IFCH,*)' '
+      WRITE(IFCH,*)'RETURN FROM IDRES. ID,AMI,AM,IDR,IADJ:'
+      WRITE(IFCH,*)ID,AMI,AM,IDR,IADJ
+      WRITE(IFCH,*)' '
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDRESI
+
+C-----------------------------------------------------------------------
+C  INITIALIZES /CREMA/
+C-----------------------------------------------------------------------
+      PARAMETER (MXINDX=1000)
+      PARAMETER (MXMA=11)
+      PARAMETER (MXMX=6)
+      PARAMETER (MXRE=100)
+      PARAMETER (N=29)
+      COMMON /CREMA/   REMA(MXRE,MXMA),REWI(MXRE,MXMA)
+     *                ,ICRE1(MXRE,MXMA),ICRE2(MXRE,MXMA)
+     *                ,IDMX(MXMA,MXMX),INDX(MXINDX)
+      REAL    REMAI(N,MXMA),REWII(N,MXMA)
+      INTEGER ICREI(N,2*MXMA),IDMXI(MXMA,MXMX)
+
+      DATA (IDMXI(J,1),J=1,MXMA)/ 11, 110, 111,   0,   0,   0,   0, 4*0/
+      DATA (IDMXI(J,2),J=1,MXMA)/ 22, 220, 330, 331,   0,   0,   0, 4*0/
+      DATA (IDMXI(J,3),J=1,MXMA)/123,2130,1230,1231,   0,   0,   0, 4*0/
+      DATA (IDMXI(J,4),J=1,MXMA)/124,2140,1240,1241,   0,   0,   0, 4*0/
+      DATA (IDMXI(J,5),J=1,MXMA)/134,3140,1340,1341,   0,   0,   0, 4*0/
+      DATA (IDMXI(J,6),J=1,MXMA)/234,3240,2340,2341,   0,   0,   0, 4*0/
+      DATA ((ICREI(K,M),M=1,2*MXMA),K=1,10)/
+     *                 111,000000, 9*300000,    11*0,
+     *                 222,000000, 9*030000,    11*0,
+     *                 112,       10*210000,    11*0,
+     *                 122,       10*120000,    11*0,
+     *                 113,       10*201000,    11*0,
+     *                 223,       10*021000,    11*0,
+     *                 123,       10*111000,    11*0,
+     *                 133,       10*102000,    11*0,
+     *                 233,       10*012000,    11*0,
+     *                 333,000000, 9*003000,    11*0/
+      DATA ((ICREI(K,M),M=1,2*MXMA),K=11,20)/
+     *                 114,       10*200100,    11*0,
+     *                 124,       10*110100,    11*0,
+     *                 224,       10*020100,    11*0,
+     *                 134,       10*101100,    11*0,
+     *                 234,       10*011100,    11*0,
+     *                 334,       10*002100,    11*0,
+     *                 144,       10*100200,    11*0,
+     *                 244,       10*010200,    11*0,
+     *                 344,       10*001200,    11*0,
+     *                 444,000000, 9*000300,    11*0/
+      DATA ((ICREI(K,M),M=1,2*MXMA),K=21,29)/
+     *                  11,  10*100000,    0,   10*100000,
+     *                  22,  10*001000,    0,   10*001000,
+     *                  12,  10*100000,    0,   10*010000,
+     *                  13,  10*100000,    0,   10*001000,
+     *                  23,  10*010000,    0,   10*001000,
+     *                  14,  10*100000,    0,   10*000100,
+     *                  24,  10*010000,    0,   10*000100,
+     *                  34,  10*001000,    0,   10*000100,
+     *                  44,  10*000100,    0,   10*000100/
+
+      DATA ((REMAI(K,M),M=1,MXMA),K=1,10)/
+     *111.,0.000,1.425,1.660,1.825,2.000,0.000,0.000,0.000,0.000,0.000,
+     *222.,0.000,1.425,1.660,1.825,2.000,0.000,0.000,0.000,0.000,0.000,
+     *112.,1.080,1.315,1.485,1.575,1.645,1.685,1.705,1.825,2.000,0.000,
+     *122.,1.080,1.315,1.485,1.575,1.645,1.685,1.705,1.825,2.000,0.000,
+     *113.,1.300,1.500,1.700,1.850,2.000,0.000,0.000,0.000,0.000,0.000,
+     *223.,1.300,1.500,1.700,1.850,2.000,0.000,0.000,0.000,0.000,0.000,
+     *123.,1.117,1.300,1.395,1.465,1.540,1.655,1.710,1.800,1.885,2.000,
+     *133.,1.423,2.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     *233.,1.428,2.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     *333.,0.000,2.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000/
+      DATA ((REMAI(K,M),M=1,MXMA),K=11,20)/
+     *114.,2.530,2.730,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     *124.,2.345,2.530,2.730,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     *224.,2.530,2.730,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     *134.,2.450,2.600,2.800,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     *234.,2.450,2.600,2.800,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     *334.,2.700,2.900,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     *144.,3.650,3.850,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     *244.,3.650,3.850,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     *344.,3.800,4.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     *444.,0.000,5.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000/
+      DATA ((REMAI(K,M),M=1,MXMA),K=21,29)/
+     * 11.,0.450,0.950,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     * 22.,0.750,0.965,1.080,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     * 12.,0.450,0.950,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     * 13.,0.700,1.050,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     * 23.,0.700,1.050,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     * 14.,1.935,2.077,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     * 24.,1.938,2.079,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     * 34.,2.085,2.195,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,
+     * 44.,3.037,3.158,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000/
+
+      DATA ((REWII(K,M),M=1,MXMA),K=1,5)/
+     *111.,0.000E+00,0.115E+00,0.140E+00,0.250E+00,0.250E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     *222.,0.000E+00,0.115E+00,0.140E+00,0.250E+00,0.250E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     *112.,0.000E+00,0.115E+00,0.200E+00,0.140E+00,0.140E+00,
+     *     0.145E+00,0.250E+00,0.140E+00,0.250E+00,0.000E+00,
+     *122.,0.000E+00,0.115E+00,0.200E+00,0.140E+00,0.140E+00,
+     *     0.145E+00,0.250E+00,0.140E+00,0.250E+00,0.000E+00,
+     *113.,0.824E-14,0.036E+00,0.080E+00,0.100E+00,0.170E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00/
+      DATA ((REWII(K,M),M=1,MXMA),K=6,10)/
+     *223.,0.445E-14,0.039E+00,0.080E+00,0.100E+00,0.170E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     *123.,0.250E-14,0.890E-05,0.036E+00,0.040E+00,0.016E+00,
+     *     0.090E+00,0.080E+00,0.100E+00,0.145E+00,0.170E+00,
+     *133.,0.227E-14,0.009E+00,0.000E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     *233.,0.400E-14,0.010E+00,0.000E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     *333.,0.000E+00,0.800E-14,0.000E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00/
+      DATA ((REWII(K,M),M=1,MXMA),K=11,15)/
+     *114.,0.400E-11,0.010E+00,0.000E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     *124.,0.400E-11,0.400E-11,0.010E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     *224.,0.400E-11,0.010E+00,0.010E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     *134.,0.150E-11,0.400E-11,0.010E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     *234.,0.150E-11,0.400E-11,0.010E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00/
+      DATA ((REWII(K,M),M=1,MXMA),K=16,20)/
+     *334.,0.400E-11,0.010E+00,0.010E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     *144.,0.400E-11,0.010E+00,0.010E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     *244.,0.400E-11,0.010E+00,0.010E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     *344.,0.400E-11,0.010E+00,0.010E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     *444.,0.400E-11,0.010E+00,0.010E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00/
+      DATA ((REWII(K,M),M=1,MXMA),K=21,25)/
+     * 11.,0.757E-08,0.153E+00,0.057E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     * 22.,0.105E-05,0.210E-03,0.034E+00,0.004E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     * 12.,0.000E+00,0.153E+00,0.057E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     * 13.,0.000E+00,0.051E+00,0.000E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     * 23.,0.197E-02,0.051E+00,0.000E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00/
+      DATA ((REWII(K,M),M=1,MXMA),K=26,29)/
+     * 14.,0.154E-11,0.002E+00,0.000E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     * 24.,0.615E-12,0.002E+00,0.000E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     * 34.,0.150E-11,0.020E+00,0.000E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00,
+     * 44.,0.010E+00,0.068E-03,0.000E+00,0.000E+00,0.000E+00,
+     *     0.000E+00,0.000E+00,0.000E+00,0.000E+00,0.000E+00/
+C-----------------------------------------------------------------------
+      NN=N
+      DO 3 I=1,MXINDX
+        INDX(I)=0
+ 3    CONTINUE
+      DO 44 M=1,MXMA
+        DO 4 K=1,MXRE
+          REMA(K,M)=0.
+ 4      CONTINUE
+44    CONTINUE
+      DO 22 I=1,MXMX
+        DO 2 J=1,MXMA
+          IDMX(J,I)=IDMXI(J,I)
+ 2      CONTINUE
+22    CONTINUE
+
+      IF ( NN .GT. MXRE ) THEN
+        CALL UTSTOP('IDRESI: DIMENSION MXRE TOO SMALL        ')
+      ENDIF
+      DO 1 K=1,N
+        IX=NINT(REMAI(K,1))
+        IX2=NINT(REWII(K,1))
+        IX3=ICREI(K,1)
+        IF ( IX .NE. IX2 ) THEN
+          CALL UTSTOP('IDRESI: IX /= IX2                       ')
+        ENDIF
+        IF ( IX .NE. IX3 ) THEN
+          CALL UTSTOP('IDRESI: IX /= IX3                       ')
+        ENDIF
+        IF ( IX .LT. 1  .OR.  IX .GT. MXINDX ) THEN
+          CALL UTSTOP('IDRESI: IX OUT OF RANGE.                ')
+        ENDIF
+        INDX(IX)=K
+        REMA(K,1)=0.
+        REWI(K,1)=0.
+        ICRE1(K,1)=0
+        ICRE2(K,1)=0
+        DO 5 M=2,MXMA
+          REMA(K,M)=REMAI(K,M)
+          REWI(K,M)=REWII(K,M)
+          ICRE1(K,M)=ICREI(K,M)
+          ICRE2(K,M)=ICREI(K,MXMA+M)
+ 5      CONTINUE
+ 1    CONTINUE
+
+      INDX(33) =INDX(22)
+      INDX(213)=INDX(123)
+      INDX(214)=INDX(124)
+      INDX(314)=INDX(134)
+      INDX(324)=INDX(234)
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDSPIN(II,IC,ID,JSPIN)
+
+C-----------------------------------------------------------------------
+C  DETERMINES PARTICLE SPIN
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+
+      REAL    PSPIN1(8)
+      INTEGER IC(2),JC(NFLAV,2)
+C-----------------------------------------------------------------------
+      PSPIN1(1)=PSPINL
+      PSPIN1(2)=PSPINL
+      PSPIN1(3)=PSPINL
+      PSPIN1(4)=PSPINH
+      PSPIN1(5)=PSPINH
+      PSPIN1(6)=PSPINH
+      PSPIN1(7)=PSPINH
+      PSPIN1(8)=PSPINH
+      CALL IDDECO(IC,JC)
+      IHIGH=0
+      IF ( II .EQ. 1 ) THEN
+        DO 4 I=1,NFLAV
+          IF ( JC(I,1) .NE. 0 ) IHIGH=I
+          IF ( JC(I,2) .NE. 0 ) IHIGH=I
+ 4      CONTINUE
+      ELSE
+        CALL IDFLAV(ID,I1,I2,I3,IDU1,IDU2)
+        DO 5 I=1,NFLAV
+          IF ( I.EQ.ABS(I1)   .OR.  I .EQ. ABS(I2)
+     *                        .OR.  I .EQ. ABS(I3) ) IHIGH=I
+5       CONTINUE
+      ENDIF
+      JSPIN=INT(RANGEN()+PSPIN1(IHIGH))
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDTAU(ID,P4,P5,TAUGM)
+
+C-----------------------------------------------------------------------
+C  RETURNS LIFETIME*GAMMA FOR ID WITH ENERGY P4, MASS P5
+C-----------------------------------------------------------------------
+      PARAMETER (MXINDX=1000)
+      PARAMETER (MXMA=11)
+      PARAMETER (MXMX=6)
+      PARAMETER (MXRE=100)
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CREMA/   REMA(MXRE,MXMA),REWI(MXRE,MXMA)
+     *                ,ICRE1(MXRE,MXMA),ICRE2(MXRE,MXMA)
+     *                ,IDMX(MXMA,MXMX),INDX(MXINDX)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+C-----------------------------------------------------------------------
+      IDABS = ABS(ID)
+      IF     ( IDABS .LT. 100  .AND.  ID .NE. 20 ) THEN
+        WI=0.
+      ELSEIF ( ID .EQ. 20 ) THEN
+        WI=.197/2.675E13
+      ELSEIF ( IDABS .LT. 100000000 ) THEN
+        IX=IDABS/10
+        IF ( IX .LT. 1  .OR.  IX .GT. MXINDX ) THEN
+          CALL UTSTOP('IDTAU: IX OUT OF RANGE.                 ')
+        ENDIF
+        II=INDX(IX)
+        JJ=MOD(IDABS,10)+2
+        DO 75 IMX=1,MXMX
+          DO 76 IMA=2,MXMA
+            IF ( IDABS .EQ. IDMX(IMA,IMX) ) JJ=IMA
+76        CONTINUE
+75      CONTINUE
+        IF ( II.LT.1 .OR. II.GT.MXRE .OR. JJ.LT.1 .OR. JJ.GT.MXMA ) THEN
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,*)'ID,II,JJ:',ID,'   ',II,JJ
+          CALL UTSTOP('IDTAU: II OR JJ OUT OF RANGE            ')
+        ENDIF
+        WI=REWI(II,JJ)
+      ELSE
+        TAUZ=TAUNLL
+C-C     TAUZ=MIN( 9./P5**2, TAUZ )
+C-C     TAUZ=MAX( .2, TAUZ )
+        WI=.197/TAUZ
+      ENDIF
+      IF ( WI .EQ. 0. ) THEN
+        TAU=AINFIN
+        TAUGM=AINFIN
+        RETURN
+      ELSE
+        TAU=.197/WI
+        IF ( TAU .GE. AINFIN ) THEN
+          TAUGM = AINFIN
+          RETURN
+        ENDIF
+      ENDIF
+      IF ( P5 .EQ. 0. ) THEN
+        GM=AINFIN
+        TAUGM=AINFIN
+      ELSE
+        GM=P4/P5
+        IF ( GM .GE. AINFIN ) THEN
+          TAUGM = AINFIN
+          RETURN
+        ELSE
+          TAUGM=TAU*GM
+        ENDIF
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      INTEGER FUNCTION IDTRA(IC,IER,IRES,IMIX)
+
+C-----------------------------------------------------------------------
+C  TRANFORMS FROM WERNER-ID TO PAIGE-ID
+C-----------------------------------------------------------------------
+      PARAMETER (NIDT=44)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+
+      INTEGER IC(2),ICM(2),IDT(3,NIDT)
+      DATA IDT/
+     * 100000,000000,   1   ,010000,000000,   2   ,001000,000000,   3
+     *,000100,000000,   4
+     *,200000,000000,1100   ,110000,000000,1200   ,020000,000000,2200
+     *,101000,000000,1300   ,011000,000000,2300   ,002000,000000,3300
+     *,100100,000000,1400   ,010100,000000,2400   ,001100,000000,3400
+     *,000200,000000,4400
+     *,100000,100000, 110   ,100000,010000, 120   ,010000,010000, 220
+     *,100000,001000, 130   ,010000,001000, 230   ,001000,001000, 330
+     *,100000,000100, 140   ,010000,000100, 240   ,001000,000100, 340
+     *,000100,000100, 440
+     *,300000,000000,1111   ,210000,000000,1120   ,120000,000000,1220
+     *,030000,000000,2221   ,201000,000000,1130   ,111000,000000,1230
+     *,021000,000000,2230   ,102000,000000,1330   ,012000,000000,2330
+     *,003000,000000,3331   ,200100,000000,1140   ,110100,000000,1240
+     *,020100,000000,2240   ,101100,000000,1340   ,011100,000000,2340
+     *,002100,000000,3340   ,100200,000000,1440   ,010200,000000,2440
+     *,001200,000000,3440   ,000300,000000,4441/
+C-----------------------------------------------------------------------
+      IF ( IC(1) .EQ. 0  .AND.  IC(2) .EQ. 0 ) THEN
+        IDTRA=0
+        RETURN
+      ENDIF
+      DO 1 I=1,NIDT
+        IF ( IC(1).EQ.IDT(1,I) .AND. IC(2).EQ.IDT(2,I) ) THEN
+          IDTRA=IDT(3,I)
+          GOTO 2
+        ENDIF
+        IF ( IC(2).EQ.IDT(1,I) .AND. IC(1).EQ.IDT(2,I) ) THEN
+          IDTRA=-IDT(3,I)
+          GOTO 2
+        ENDIF
+ 1    CONTINUE
+      IDTRA=0
+ 2    CONTINUE
+      IF ( IDTRA .NE. 0 ) THEN
+        ISI=SIGN(1,IDTRA)
+        JSPIN=0
+        IF ( MOD(IDTRA,10).EQ.0 .AND. IRES.EQ.1 )
+     *                                     CALL IDSPIN(1,IC,IDU,JSPIN)
+      ELSE
+        ISI=1
+        JSPIN=0
+      ENDIF
+      IF     ( IMIX .EQ. 3 ) THEN
+        IF     ( IDTRA .EQ. 220 ) THEN
+          IDTRA=110
+        ELSEIF ( IDTRA .EQ. 330 ) THEN
+          IDTRA=220
+        ENDIF
+      ELSEIF ( IMIX .EQ. 2 ) THEN
+        IF     ( IDTRA .EQ. 220 ) THEN
+          IDTRA=110
+        ELSEIF ( IDTRA .EQ. 330 ) THEN
+          IDTRA=110
+        ENDIF
+      ELSEIF ( IMIX .EQ. 1 ) THEN
+        CALL IDMIX(IC,JSPIN,ICM,IDTRAM)
+        IF ( IDTRAM .NE. 0 ) IDTRA=IDTRAM
+        IF ( JSPIN .EQ. 0 ) THEN
+          IF ( RANGEN() .LT. PISPN ) THEN
+            IF     ( ABS(IDTRA). EQ. 1230 ) THEN
+              IDTRA=ISI*2130
+            ELSEIF ( ABS(IDTRA) .EQ. 1240 ) THEN
+              IDTRA=ISI*2140
+            ELSEIF ( ABS(IDTRA) .EQ. 1340 ) THEN
+              IDTRA=ISI*3140
+            ELSEIF ( ABS(IDTRA) .EQ. 2340 ) THEN
+              IDTRA=ISI*3240
+            ENDIF
+          ENDIF
+        ENDIF
+      ENDIF
+
+      IF ( IDTRA .NE. 0 ) IDTRA=IDTRA+JSPIN*ISI
+      IF ( IDTRA .NE. 0 ) RETURN
+      IF ( IER .NE. 1 ) RETURN
+      JERR=JERR+1
+      WRITE(IFCH,*)' '
+      WRITE(IFCH,*)'***** ERROR IN IDTRA: UNKNOWN CODE'
+      WRITE(IFCH,*)'IC = ',IC
+      WRITE(IFCH,*)' '
+      RETURN
+      END
+C=======================================================================
+
+      INTEGER FUNCTION IDTRAI(NUM,ID,IER)
+
+C-----------------------------------------------------------------------
+      PARAMETER (NIDT=44)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      INTEGER IDT(3,NIDT)
+
+      DATA IDT/
+     * 100000,000000,   1   ,010000,000000,   2   ,001000,000000,   3
+     *,000100,000000,   4
+     *,200000,000000,1100   ,110000,000000,1200   ,020000,000000,2200
+     *,101000,000000,1300   ,011000,000000,2300   ,002000,000000,3300
+     *,100100,000000,1400   ,010100,000000,2400   ,001100,000000,3400
+     *,000200,000000,4400
+     *,100000,100000, 110   ,100000,010000, 120   ,010000,010000, 220
+     *,100000,001000, 130   ,010000,001000, 230   ,001000,001000, 330
+     *,100000,000100, 140   ,010000,000100, 240   ,001000,000100, 340
+     *,000100,000100, 440
+     *,300000,000000,1111   ,210000,000000,1120   ,120000,000000,1220
+     *,030000,000000,2221   ,201000,000000,1130   ,111000,000000,1230
+     *,021000,000000,2230   ,102000,000000,1330   ,012000,000000,2330
+     *,003000,000000,3331   ,200100,000000,1140   ,110100,000000,1240
+     *,020100,000000,2240   ,101100,000000,1340   ,011100,000000,2340
+     *,002100,000000,3340   ,100200,000000,1440   ,010200,000000,2440
+     *,001200,000000,3440   ,000300,000000,4441/
+C-----------------------------------------------------------------------
+      IDABS = ABS(ID)
+      DO 1 I=1,NIDT
+        IF ( IDABS .EQ. IDT(3,I) ) THEN
+          IF ( ID .LT. 0 ) THEN
+            IDTRAI=IDT(3-NUM,I)
+          ELSE
+            IDTRAI=IDT(NUM,I)
+          ENDIF
+          RETURN
+        ENDIF
+1     CONTINUE
+      IDTRAI=0
+      IF ( IER .NE. 1 ) RETURN
+      JERR=JERR+1
+      WRITE(IFCH,*)' '
+      WRITE(IFCH,*)'***** ERROR IN IDTRAI: UNKNOWN CODE'
+      WRITE(IFCH,*)'ID = ',ID
+      WRITE(IFCH,*)' '
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDTRB(IB1,IB2,IB3,IB4,JC)
+
+C-----------------------------------------------------------------------
+C  ID TRANSFORMATION IB -> JC
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      INTEGER JC(NFLAV,2)
+C-----------------------------------------------------------------------
+      JC(1,1)=IB1/10000
+      JC(2,1)=IB2/10000
+      JC(3,1)=IB3/10000
+      JC(4,1)=IB4/10000
+      JC(5,1)=0
+      JC(6,1)=0
+      JC(1,2)=MOD(IB1,10000)
+      JC(2,2)=MOD(IB2,10000)
+      JC(3,2)=MOD(IB3,10000)
+      JC(4,2)=MOD(IB4,10000)
+      JC(5,2)=0
+      JC(6,2)=0
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDTRBI(JC,IB1,IB2,IB3,IB4)
+
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      INTEGER JC(NFLAV,2)
+C-----------------------------------------------------------------------
+      IB1=JC(1,1)*10000+JC(1,2)
+      IB2=JC(2,1)*10000+JC(2,2)
+      IB3=JC(3,1)*10000+JC(3,2)
+      IB4=JC(4,1)*10000+JC(4,2)
+      IB5=JC(5,1)*10000+JC(5,2)
+      IB6=JC(6,1)*10000+JC(6,2)
+      IF ( IB5 .NE. 0  .OR.  IB6 .NE. 0 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'***** ERROR IN IDTRBI: BOTTOM OR TOP QUARKS'
+        WRITE(IFCH,*)'JC:'
+        WRITE(IFCH,*)JC
+        CALL UTSTOP('IDTRBI: BOTTOM OR TOP QUARKS            ')
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE IDTR4(ID,IC)
+
+C-----------------------------------------------------------------------
+C  TRANSFORMS GENERALIZED PAIGE_ID -> WERNER_ID  (FOR < 4 FLV)
+C-----------------------------------------------------------------------
+      PARAMETER (MXINDX=1000)
+      PARAMETER (MXMA=11)
+      PARAMETER (MXMX=6)
+      PARAMETER (MXRE=100)
+      COMMON /CREMA/   REMA(MXRE,MXMA),REWI(MXRE,MXMA)
+     *                ,ICRE1(MXRE,MXMA),ICRE2(MXRE,MXMA)
+     *                ,IDMX(MXMA,MXMX),INDX(MXINDX)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      INTEGER IC(2)
+C-----------------------------------------------------------------------
+      IDABS = ABS(ID)
+      IF ( IDABS .LT. 100000000 ) THEN
+        IX=IDABS/10
+        IF ( IX .LT. 1  .OR.  IX .GT. MXINDX ) GOTO 9999
+        II=INDX(IX)
+        IF ( II .EQ. 0 ) GOTO 9998
+        JJ=IDABS-10*IX + 2
+        DO 28 IMX=1,MXMX
+          DO 27 IMA=2,MXMA
+            IF ( IDABS .EQ. IDMX(IMA,IMX) ) THEN
+              JJ=IMA
+              GOTO 29
+            ENDIF
+27        CONTINUE
+28      CONTINUE
+29      IF ( ID .GT. 0 ) THEN
+          IC(1)=ICRE1(II,JJ)
+          IC(2)=ICRE2(II,JJ)
+        ELSE
+          IC(2)=ICRE1(II,JJ)
+          IC(1)=ICRE2(II,JJ)
+        ENDIF
+        IF ( IC(1) .EQ. 100000  .AND.  IC(2) .EQ. 100000
+     *                          .AND.  RANGEN() .LT. 0.5 ) THEN
+          IC(1)=010000
+          IC(2)=010000
+        ENDIF
+      ELSEIF ( MOD(ID/100000000,10) .EQ. 8 ) THEN
+        IC(1)=MOD(ID,100000000)/10000*100
+        IC(2)=MOD(ID,10000)*100
+      ELSE
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'***** ID: ',ID
+        CALL UTSTOP('IDTR4: UNRECOGNIZED ID                  ')
+      ENDIF
+      RETURN
+
+9998  WRITE(IFCH,*)' '
+      WRITE(IFCH,*)'ID: ',ID
+      CALL UTSTOP('IDTR4: INDX=0.                          ')
+      RETURN
+
+9999  WRITE(IFCH,*)' '
+      WRITE(IFCH,*)'ID: ',ID
+      CALL UTSTOP('IDTR4: IX OUT OF RANGE.                 ')
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JAMBR1(NS,NSG,IRET)
+
+C-----------------------------------------------------------------------
+C  "AMOR" (KOCH+WERNER, 89)
+C  BREAKS STRING NS ACCORDING TO A-M MODEL.
+C  NS: POINTS TO THE CURRENT FRAGMENTING STRING.
+C  NSG: POINTS TO THE LAST PRODUCED SUBSTRING (SUCC INCREASED)
+C      INPUT:
+C  PSG(,NS): MOMENTUM OF STRING NS IN PP-CMS
+C  PJT(,2*NS-1),PJT(,2*NS): MOMENTUM OF END OF STRING NS IN PP-CMS
+C      OUTPUT:
+C  XORSG(,NSG): ORIGIN OF SUBSTRING NSG IN PP-CMS
+C  PJT(,2*NSG-1),PJT(,2*NSG): MOMENTUM OF END OF SUBSTRING NSG IN PP-CMS
+C  ICJT(,2*NSG-1),ICJT(,2*NSG): IC-CODE  OF END OF SUBSTRG NSG IN PP-CMS
+C  PSG(,NSG): MOMENTUM OF SUBSTRING NSG IN PP-CMS
+C  XBKPTL(,NPTLC-NPTL2): BREAKPOINT OF NS IN PP-CMS
+C  ISPTL(,NPTLC-NPTL2): 1 IF STRING NS BREAKS
+C-----------------------------------------------------------------------
+      PARAMETER (MXPC=500)
+      PARAMETER (MXSG=500)
+      PARAMETER (MXJT=2*MXSG)
+      PARAMETER (NFLAV=6)
+      PARAMETER (NPTF=129)
+      COMMON /CDELRE/  DELRER
+      COMMON /CJAMBR/  NPTLC,NPTL2
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      DOUBLE PRECISION XBKPTL
+      COMMON /CPC/     XBKPTL(2,MXPC),ISPTL(MXPC)
+      COMMON /CPTF/    FPTFS,FPTFSS,FPTFU,FPTFUS,FPTFUU
+     *                ,QPTFS(NPTF),QPTFSS(NPTF),QPTFU(NPTF),QPTFUS(NPTF)
+     *                ,QPTFUU(NPTF),XPTF(NPTF)
+      DOUBLE PRECISION PJT,PSG,ROTSG,XORSG
+      COMMON /CSG/     PJT(5,MXJT),PSG(5,MXSG),ROTSG(3,MXSG)
+     *                ,XORSG(4,MXSG)
+     *                ,ICJT(2,MXJT),IORSG(MXSG),ISG(MXSG)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /QUARKM/  SMAS,SSMAS,USMAS,UUMAS
+
+      DOUBLE PRECISION DAUXI1,DAUXI2,ETA,EETA,ETAM,ETAP
+     *                ,PM,PP,PT,PX,PY,P0M,P0P,XBK(4),XOR1(4),XOR2(4)
+      INTEGER          IC(2),ICM(2),ICMP(2),ICMS(2)
+     *                ,ICP(2),ICPM(2),ICPS(2),ICX(2),ICY(2)
+     *                ,JC(NFLAV,2)
+     *                ,JCM(NFLAV,2),JCMP(NFLAV,2),JCMS(NFLAV,2)
+     *                ,JCP(NFLAV,2),JCPM(NFLAV,2),JCPS(NFLAV,2)
+     *                ,JCX(NFLAV,2),JCY(NFLAV,2)
+C-----------------------------------------------------------------------
+      NCNT3=0
+      NSG0=NSG
+9993  NSG=NSG0
+
+      IRET=0
+      ICP(1)=ICJT(1,2*NS-1)
+      ICP(2)=ICJT(2,2*NS-1)
+      ICM(1)=ICJT(1,2*NS)
+      ICM(2)=ICJT(2,2*NS)
+      CALL IDDECO(ICP,JCP)
+      CALL IDDECO(ICM,JCM)
+      NP=0
+      DO 7 NF=1,NFLAV
+        JC(NF,1)=JCP(NF,1)+JCM(NF,1)
+        JC(NF,2)=JCP(NF,2)+JCM(NF,2)
+        NP=NP+JCP(NF,1)-JCP(NF,2)
+7     CONTINUE
+      CALL IDENCO(JC,IC,IRETEN)
+      ID=IDTRA(IC,0,0,3)
+      AMMS=UTAMNX(JCP,JCM)
+      AM=PSG(5,NS)
+
+C  SPLIT STRING
+C  ------------
+      J1 = 2*NS
+      J2 = J1-1
+      DAUXI1= PJT(4,J1)+PJT(4,J2)
+      DAUXI2= PJT(3,J1)+PJT(3,J2)
+      P0P = DAUXI1 + DAUXI2
+      P0M = DAUXI1 - DAUXI2
+9994  NCNT3=NCNT3+1
+      IF ( NCNT3 .GT. 100 ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JAMBR1')
+          WRITE(IFCH,*)'*****  SPLIT KINEM NOT POSSIBLE.'
+          WRITE(IFCH,112)
+     *     (ICJT(J,2*NS-1),J=1,2),(ICJT(J,2*NS),J=1,2),PSG(5,NS)
+112       FORMAT(1X,2I8,4X,2I8,4X,F7.2)
+          CALL UTMSGF
+        ENDIF
+        IF ( NS .EQ. 1 ) THEN
+          IRET=9999
+          RETURN
+        ENDIF
+        IRET=9996
+        RETURN
+      ENDIF
+      DO 17 NF=1,NFLAV
+        JCPM(NF,1)=0
+        JCPM(NF,2)=0
+        JCMP(NF,1)=0
+        JCMP(NF,2)=0
+17    CONTINUE
+
+C  DETERMINE FLAVOUR
+C  -----------------
+      NQU=0
+      IF ( ISH .GE. 93 ) THEN
+        WRITE(IFCH,*)'ORDINARY STRING FRAGMENTATION'
+        WRITE(IFCH,*)' '
+      ENDIF
+      IF ( RANGEN() .LE. PDIQUA ) THEN
+        NQU=2
+      ELSE
+        NQU=1
+      ENDIF
+      IF     ( MOD(NP+NQU,3) .EQ. 0 ) THEN
+        II=1
+      ELSEIF ( MOD(NP-NQU,3) .EQ. 0 ) THEN
+        II=2
+      ELSE
+        CALL UTSTOP('JAMBR1: NO SINGLET CONSTRUCTION POSSIBLE')
+      ENDIF
+      IFLTT=0
+      DO 8 N=1,NQU
+        IFL=INT(RANGEN()/PUD)+1
+        IFLTT=IFLTT*10+(IFL+1)/2
+        JCPM(IFL,II)=JCPM(IFL,II)+1
+        JCMP(IFL,3-II)=JCMP(IFL,3-II)+1
+8     CONTINUE
+      CALL IDENCO(JCPM,ICPM,IRETEN)
+      IF ( IRETEN .EQ. 1 ) THEN
+        CALL UTSTOP('JAMBR1: IDENCO(JCPM... RET.CODE=1       ')
+      ENDIF
+      CALL IDENCO(JCMP,ICMP,IRETEN)
+      IF ( IRETEN .EQ. 1 ) THEN
+        CALL UTSTOP('JAMBR1: IDENCO(JCMP... RET.CODE=1       ')
+      ENDIF
+      DO 25 NF=1,NFLAV
+        JCPS(NF,1)=JCP(NF,1)+JCPM(NF,1)
+        JCPS(NF,2)=JCP(NF,2)+JCPM(NF,2)
+        JCMS(NF,1)=JCM(NF,1)+JCMP(NF,1)
+        JCMS(NF,2)=JCM(NF,2)+JCMP(NF,2)
+25    CONTINUE
+      CALL IDENCO(JCPS,ICPS,IRETEN)
+      CALL IDENCO(JCMS,ICMS,IRETEN)
+      CALL IDCOMK(ICPS)
+      CALL IDCOMK(ICMS)
+
+C  CALCULATE P+,P-,PT OF STRING BREAKING
+C  -------------------------------------
+      IF ( ISH .GE. 93 ) THEN
+        WRITE(IFCH,109)ICM(1),ICMP(1),ICPM(1),ICP(1)
+     *     ,ICM(2),ICMP(2),ICPM(2),ICP(2)
+109     FORMAT(1X,'FLAVORS:',2(I11,I7)/9X,2(I11,I7)/)
+        WRITE(IFCH,*)'IFLTT:',IFLTT
+        WRITE(IFCH,*)' '
+      ENDIF
+      IDP=IDTRA(ICPS,0,0,3)
+      IDM=IDTRA(ICMS,0,0,3)
+      AMMP=UTAMNY(JCP,JCPM)
+      AMMM=UTAMNY(JCM,JCMP)
+      R = RANGEN()
+      IF     ( IFLTT .EQ .1 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFU ,R*QPTFU(NPTF))
+C##       WRITE(IFCH,*)'JAMBR1:PT(OLD)=',PT
+        ELSE
+          RPT = R*FPTFU
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(1.+RPT*2./AUXIL))
+        ENDIF
+      ELSEIF ( IFLTT .EQ. 2 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFS ,R*QPTFS(NPTF))
+        ELSE
+          RPT = R*FPTFS
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(EXP(SMAS**2/AUXIL)+RPT*2./AUXIL)-SMAS**2)
+        ENDIF
+      ELSEIF ( IFLTT .EQ. 11 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFUU,R*QPTFUU(NPTF))
+        ELSE
+          RPT = R*FPTFUU
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(EXP(UUMAS**2/AUXIL)+RPT*2./AUXIL)-UUMAS**2)
+        ENDIF
+      ELSEIF ( IFLTT .EQ. 12  .OR.  IFLTT .EQ. 21 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFUS,R*QPTFUS(NPTF))
+        ELSE
+          RPT = R*FPTFUS
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(EXP(USMAS**2/AUXIL)+RPT*2./AUXIL)-USMAS**2)
+        ENDIF
+      ELSEIF ( IFLTT .EQ. 22 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFSS,R*QPTFSS(NPTF))
+        ELSE
+          RPT = R*FPTFSS
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(EXP(SSMAS**2/AUXIL)+RPT*2./AUXIL)-SSMAS**2)
+        ENDIF
+      ENDIF
+      LO=1
+      GOTO 48
+47    LO=LO+1
+      PT=RANGEN()*PT
+48    CONTINUE
+      PHI=2.D0*PI*RANGEN()
+      PX=PT*COS(PHI)
+      PY=PT*SIN(PHI)
+      TMMP=    (PT**2+AMMP**2)
+      TMMM=    (PT**2+AMMM**2)
+      AREA=-LOG(RANGEN())/PAREA
+      AREART = SQRT(AREA)
+      ETAM=LOG((TMMM   +AREA)/(AREART    *P0M))
+      ETAP=LOG((AREART    *P0P)/(TMMP   +AREA))
+      IF ( ETAM .GT. ETAP ) THEN
+        IF ( LO .LT. 5 ) GOTO 47
+        GOTO 9994
+      ENDIF
+      ETA=ETAM+RANGEN()*(ETAP-ETAM)
+      AMP=SQRT(P0P*AREART    *EXP(-ETA)-AREA-PT**2)
+      AMM=SQRT(P0M*AREART    *EXP( ETA)-AREA-PT**2)
+      CALL IDRES(IDP,AMP,IDPR,IADJP)
+      CALL IDRES(IDM,AMM,IDMR,IADJM)
+      R=RANGEN()
+      IF ( IDPR .EQ. 110  .AND. R .LT. 0.5 ) THEN
+        IDP=220
+        AMP=.549
+        IF ( R .LT. 0.6666667 ) AMP=.958
+        CALL IDRES(IDP,AMP,IDPR,IADJP)
+        IADJP=1
+      ENDIF
+      R=RANGEN()
+      IF ( IDMR .EQ. 110 .AND. R .LT. 0.5 ) THEN
+        IDM=220
+        AMM=.549
+        IF ( R .LT. 0.6666667 ) AMM=.958
+        CALL IDRES(IDM,AMM,IDMR,IADJM)
+        IADJM=1
+      ENDIF
+      TMP2=(PT**2+AMP**2)
+      TMM2=(PT**2+AMM**2)
+      IF ( IADJP .EQ. 1  .AND.  IADJM .NE. 1 ) THEN
+        ETA=LOG((AREART  *P0P)/(TMP2+AREA))
+        IF ( ETA .LT. ETAM ) GOTO 9994
+        AMM=SQRT(P0M*AREART  *EXP(ETA)-AREA-PT**2)
+        CALL IDRES(IDM,AMM,IDMR,IADJM)
+        TMM2=(PT**2+AMM**2)
+      ENDIF
+      IF ( IADJP .NE. 1  .AND.  IADJM .EQ. 1 ) THEN
+        ETA=LOG((TMM2+AREA)/(AREART  *P0M))
+        IF ( ETA .GT. ETAP ) GOTO 9994
+        AMP=SQRT(P0P*AREART   *EXP(-ETA)-AREA-PT**2)
+        CALL IDRES(IDP,AMP,IDPR,IADJP)
+        TMP2=(PT**2+AMP**2)
+      ENDIF
+      IF ( IADJP .EQ. 1  .AND.  IADJM .EQ. 1 ) THEN
+        TM=(P0P*P0M-TMM2-TMP2)*0.5
+        IF ( TM .LT. 0. ) GOTO 9994
+        IF ( TM**2-TMP2*TMM2 .LT. 0. ) GOTO 9994
+        AREA=TM-SQRT(TM**2  -TMP2*TMM2)
+        AREART = SQRT(AREA)
+        EETA=P0P*AREART/(TMP2+AREA)
+        IF ( EETA .LE. 0.D0 ) GOTO 9994
+        ETA=LOG(EETA)
+      ENDIF
+
+      PP=AREART*EXP(ETA)
+      PM=AREART*EXP(-ETA)
+      IF ( P0P-PP-PT**2/PM .LT. 0.D0   .OR.
+     *     P0M-PM-PT**2/PP .LT. 0.D0 ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JAMBR1')
+          WRITE(IFCH,*)'*****  NEGATIVE JET ENERGY. SPLIT AGAIN.'
+          IF ( P0P-PP-PT**2/PM .LT. 0.D0 )
+     *      WRITE(IFCH,*)'P0P: ',P0P,'   PP+PT**2/PM: ',PP+PT**2/PM
+          IF ( P0M-PM-PT**2/PP .LT. 0.D0 )
+     *      WRITE(IFCH,*)'P0M: ',P0M,'   PM+PT**2/PP: ',PM+PT**2/PP
+          CALL UTMSGF
+        ENDIF
+        GOTO 9994
+      ENDIF
+
+C  DETERMINE BREAK PNT AND NEW ORIGINS
+C  -----------------------------------
+      XOR1(1)=0.D0
+      XOR1(2)=0.D0
+      XOR1(3)=PP*0.5D0/TENSN
+      XOR1(4)=PP*0.5D0/TENSN
+      IF ( ISH .GE. 93 ) WRITE(IFCH,118)XOR1
+118   FORMAT(' NEW ORIGIN +: ',13X,4F7.2)
+      CALL UTROT2(-1,ROTSG(1,NS),ROTSG(2,NS),ROTSG(3,NS)
+     *             ,XOR1(1),XOR1(2),XOR1(3))
+      CALL UTLOB2(-1,PSG(1,NS),PSG(2,NS),PSG(3,NS),PSG(4,NS),PSG(5,NS)
+     *             ,XOR1(1),XOR1(2),XOR1(3),XOR1(4))
+      XOR1(1)=XOR1(1)+XORSG(1,NS)
+      XOR1(2)=XOR1(2)+XORSG(2,NS)
+      XOR1(3)=XOR1(3)+XORSG(3,NS)
+      XOR1(4)=XOR1(4)+XORSG(4,NS)
+      IF ( ISH .GE. 93 ) WRITE(IFCH,117)XOR1
+      XBK(1)=0.D0
+      XBK(2)=0.D0
+      XBK(3)=0.5D0/TENSN*(PP-PM)
+      XBK(4)=0.5D0/TENSN*(PP+PM)
+      IF ( ISH .GE. 93 ) WRITE(IFCH,116)XBK
+116   FORMAT(' BREAKING PNT: ',13X,4F7.2)
+      CALL UTROT2(-1,ROTSG(1,NS),ROTSG(2,NS),ROTSG(3,NS)
+     *             ,XBK(1),XBK(2),XBK(3))
+      CALL UTLOB2(-1,PSG(1,NS),PSG(2,NS),PSG(3,NS),PSG(4,NS),PSG(5,NS)
+     *             ,XBK(1),XBK(2),XBK(3),XBK(4))
+      XBK(1)=XBK(1)+XORSG(1,NS)
+      XBK(2)=XBK(2)+XORSG(2,NS)
+      XBK(3)=XBK(3)+XORSG(3,NS)
+      XBK(4)=XBK(4)+XORSG(4,NS)
+      IF ( ISH .GE. 93 ) WRITE(IFCH,117)XBK
+117   FORMAT(28X,4F7.2/)
+      XOR2(1)=0.D0
+      XOR2(2)=0.D0
+      XOR2(3)=-PM*0.5D0/TENSN
+      XOR2(4)= PM*0.5D0/TENSN
+      IF ( ISH .GE. 93 ) WRITE(IFCH,119)XOR2
+119   FORMAT(' NEW ORIGIN -: ',13X,4F7.2)
+      CALL UTROT2(-1,ROTSG(1,NS),ROTSG(2,NS),ROTSG(3,NS)
+     *              ,XOR2(1),XOR2(2),XOR2(3))
+      CALL UTLOB2(-1,PSG(1,NS),PSG(2,NS),PSG(3,NS),PSG(4,NS),PSG(5,NS)
+     *              ,XOR2(1),XOR2(2),XOR2(3),XOR2(4))
+      XOR2(1)=XOR2(1)+XORSG(1,NS)
+      XOR2(2)=XOR2(2)+XORSG(2,NS)
+      XOR2(3)=XOR2(3)+XORSG(3,NS)
+      XOR2(4)=XOR2(4)+XORSG(4,NS)
+      IF ( ISH .GE. 93 ) WRITE(IFCH,117)XOR2
+
+C  STORE THE TWO SUBSTRINGS
+C  ------------------------
+      NSGB=NSG
+      DO 9998 M=1,2
+        NSG=NSG+1
+        IF ( NSG .GT. MXSG ) THEN
+          CALL UTSTOP('JAMBR1: NSG>MXSG                        ')
+        ENDIF
+        ISG(NSG)=NPTLC
+        IF ( M .EQ. 1 ) THEN
+          XORSG(1,NSG)=XOR1(1)
+          XORSG(2,NSG)=XOR1(2)
+          XORSG(3,NSG)=XOR1(3)
+          XORSG(4,NSG)=XOR1(4)
+          PJT(1,2*NSG-1)=0.D0
+          PJT(2,2*NSG-1)=0.D0
+          PJT(3,2*NSG-1)=(P0P-PP-PT**2/PM)*0.5D0
+          PJT(4,2*NSG-1)=(P0P-PP-PT**2/PM)*0.5D0
+          PJT(5,2*NSG-1)=0.D0
+          ICJT(1,2*NSG-1)=ICJT(1,2*NS-1)
+          ICJT(2,2*NSG-1)=ICJT(2,2*NS-1)
+          PJT(1,2*NSG)=PX
+          PJT(2,2*NSG)=PY
+          PJT(3,2*NSG)=(PT**2/PM-PM)*0.5D0
+          PJT(4,2*NSG)=(PT**2/PM+PM)*0.5D0
+          PJT(5,2*NSG)=0.D0
+          ICJT(1,2*NSG)=ICPM(1)
+          ICJT(2,2*NSG)=ICPM(2)
+          DO 11 NF=1,NFLAV
+            JC(NF,1)=JCPS(NF,1)
+            JC(NF,2)=JCPS(NF,2)
+11        CONTINUE
+        ELSE
+          XORSG(1,NSG)=XOR2(1)
+          XORSG(2,NSG)=XOR2(2)
+          XORSG(3,NSG)=XOR2(3)
+          XORSG(4,NSG)=XOR2(4)
+          PJT(1,2*NSG-1)=-PX
+          PJT(2,2*NSG-1)=-PY
+          PJT(3,2*NSG-1)=(PP-PT**2/PP)*0.5D0
+          PJT(4,2*NSG-1)=(PP+PT**2/PP)*0.5D0
+          PJT(5,2*NSG-1)=0.D0
+          ICJT(1,2*NSG-1)=ICMP(1)
+          ICJT(2,2*NSG-1)=ICMP(2)
+          DO 12 NF=1,NFLAV
+            JC(NF,1)=JCMS(NF,1)
+            JC(NF,2)=JCMS(NF,2)
+12        CONTINUE
+          PJT(1,2*NSG)=0.D0
+          PJT(2,2*NSG)=0.D0
+          PJT(3,2*NSG)=-(P0M-PM-PT**2/PP)*0.5D0
+          PJT(4,2*NSG)= (P0M-PM-PT**2/PP)*0.5D0
+          PJT(5,2*NSG)=0.D0
+          ICJT(1,2*NSG)=ICJT(1,2*NS)
+          ICJT(2,2*NSG)=ICJT(2,2*NS)
+        ENDIF
+        ICX(1)=ICJT(1,2*NSG-1)
+        ICX(2)=ICJT(2,2*NSG-1)
+        ICY(1)=ICJT(1,2*NSG)
+        ICY(2)=ICJT(2,2*NSG)
+        CALL IDDECO(ICX,JCX)
+        CALL IDDECO(ICY,JCY)
+        DO 28 N=1,NFLAV
+          DO 29 I=1,2
+            K=JCX(N,I)+JCY(N,I)-JC(N,I)
+            IF ( K .LE. 0 ) GOTO 28
+            DO 19 L=1,K
+              JX=JCX(N,I)
+              JY=JCY(N,I)
+              IF     ( JX .EQ. 0  .AND.  JY .GT. 0 ) THEN
+                JCY(N,I)=JCY(N,I)-1
+              ELSEIF ( JX .GT. 0  .AND.  JY .EQ. 0 ) THEN
+                JCX(N,I)=JCX(N,I)-1
+              ELSEIF ( JX .GT. 0  .AND.  JY .GT. 0 ) THEN
+                IF ( RANGEN() .LT. 0.5 ) THEN
+                  JCX(N,I)=JCX(N,I)-1
+                ELSE
+                  JCY(N,I)=JCY(N,I)-1
+                ENDIF
+              ELSE
+                WRITE(IFCH,*)('*',LP=1,71)
+                WRITE(IFCH,*)'*****  IC;  ',IC
+                WRITE(IFCH,*)'*****  ICX: ',ICX
+                WRITE(IFCH,*)'*****  ICY: ',ICY
+                WRITE(IFCH,*)'*****  N,I,K,L: ',N,I,K,L
+                WRITE(IFCH,*)'*****  JX,JY: ',JX,JY
+                WRITE(IFCH,*)('*',LP=1,71)
+                CALL UTSTOP('JAMBR1: ERROR DURING JET COMPACTIFICATN ')
+              ENDIF
+19          CONTINUE
+29        CONTINUE
+28      CONTINUE
+        CALL IDENCO(JCX,ICX,IRETEN)
+        IF ( IRETEN .EQ. 1 ) THEN
+          CALL UTSTOP('JAMBR1: IDENCO(JCX... RET.CODE=1        ')
+        ENDIF
+        CALL IDENCO(JCY,ICY,IRETEN)
+        IF ( IRETEN .EQ. 1 ) THEN
+          CALL UTSTOP('JAMBR1: IDENCO(JCY... RET.CODE=1        ')
+        ENDIF
+        ICJT(1,2*NSG-1)=ICX(1)
+        ICJT(2,2*NSG-1)=ICX(2)
+        ICJT(1,2*NSG)  =ICY(1)
+        ICJT(2,2*NSG)  =ICY(2)
+        IF ( ISH .GE. 93 ) THEN
+          WRITE(IFCH,108)NSG,NS
+     *       ,(ICJT(J,2*NSG-1),J=1,2),(SNGL(PJT(J,2*NSG-1)),J=1,5)
+108       FORMAT(1X,I5,I4,I9,I7,1P,5E10.2)
+          WRITE(IFCH,108)NSG,NS
+     *       ,(ICJT(J,2*NSG  ),J=1,2),(SNGL(PJT(J,2*NSG  )),J=1,5)
+        ENDIF
+        PSG(1,NSG)=PJT(1,2*NSG-1)+PJT(1,2*NSG)
+        PSG(2,NSG)=PJT(2,2*NSG-1)+PJT(2,2*NSG)
+        PSG(3,NSG)=PJT(3,2*NSG-1)+PJT(3,2*NSG)
+        PSG(4,NSG)=PJT(4,2*NSG-1)+PJT(4,2*NSG)
+        PSG(5,NSG)=
+     *     SQRT(PSG(4,NSG)**2-PSG(3,NSG)**2-PSG(2,NSG)**2-PSG(1,NSG)**2)
+        IF ( ISH .GE. 93 ) WRITE(IFCH,110)NSG,NS,(PSG(J,NSG),J=1,5)
+110     FORMAT(1X,I5,I4,16X,1P,5E10.2)
+        CALL UTROT2(-1,ROTSG(1,NS),ROTSG(2,NS),ROTSG(3,NS)
+     *             ,PSG(1,NSG),PSG(2,NSG),PSG(3,NSG))
+        CALL UTLOB2(-1,PSG(1,NS),PSG(2,NS),PSG(3,NS),PSG(4,NS),PSG(5,NS)
+     *          ,PSG(1,NSG),PSG(2,NSG),PSG(3,NSG),PSG(4,NSG))
+        IORSG(NSG)=NS
+        IF ( ISH .GE. 93 ) THEN
+          WRITE(IFCH,102)NSG,IORSG(NSG),(PSG(J,NSG),J=1,5)
+102       FORMAT(1X,I5,I4,16X,1P,5E10.2)
+          WRITE(IFCH,*)' '
+        ENDIF
+
+C-C   DO 56 I=1,2
+C-C     ICPZ(I)=ICJT(I,2*NSG-1)
+C-C56 ICMZ(I)=ICJT(I,2*NSG)
+C-C   CALL IDDECO(ICPZ,JCPZ)
+C-C   CALL IDDECO(ICMZ,JCMZ)
+C-C   DO 57 NF=1,NFLAV
+C-C     JCZ(NF,1)=JCPZ(NF,1)+JCMZ(NF,1)
+C-C57 JCZ(NF,2)=JCPZ(NF,2)+JCMZ(NF,2)
+C-C   CALL IDENCO(JCZ,ICZ,IRETEN)
+C-C   IDZ=IDTRA(ICZ,0,0,3)
+C-C   AMZ=PSG(5,NSG)
+C-C   CALL IDRES(IDZ,AMZ,IDRZ,IADJ)
+C-C   IF ( IDRZ.EQ.110 .AND. RANGEN().LT.0.5 ) GOTO 9993
+
+9998  CONTINUE
+      XBKPTL(1,NPTLC-NPTL2)=XBK(3)
+      XBKPTL(2,NPTLC-NPTL2)=XBK(4)
+      ISPTL(NPTLC-NPTL2)=1
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JAMBR2(NS,NSG,IRET)
+
+C-----------------------------------------------------------------------
+C  "SAMBA" (SCHOLTEN+WERNER, MAR 92)
+C  BREAKS STRING NS ACCORDING TO A-M MODEL.
+C  NS: POINTS TO THE CURRENT FRAGMENTING STRING.
+C  NSG: POINTS TO THE LAST PRODUCED SUBSTRING (SUCC INCREASED)
+C     INPUT:
+C  PSG(,NS): MOMENTUM OF STRING NS IN PP-CMS
+C  PJT(,2*NS-1),PJT(,2*NS): MOMENTUM OF END OF STRING NS IN PP-CMS
+C     OUTPUT:
+C  XORSG(,NSG): ORIGIN OF SUBSTRING NSG IN PP-CMS
+C  PJT(,2*NSG-1),PJT(,2*NSG): MOMENTUM OF END OF SUBSTRING NSG IN PP-CMS
+C  ICJT(,2*NSG-1),ICJT(,2*NSG): IC-CODE  OF END OF SUBSTRG NSG IN PP-CMS
+C  PSG(,NSG): MOMENTUM OF SUBSTRING NSG IN PP-CMS
+C  XBKPTL(,NPTLC-NPTL2): BREAKPOINT OF NS IN PP-CMS
+C  ISPTL(,NPTLC-NPTL2): 1 IF STRING NS BREAKS
+C-----------------------------------------------------------------------
+      PARAMETER (MXPC=500)
+      PARAMETER (MXSG=500)
+      PARAMETER (MXJT=2*MXSG)
+      PARAMETER (NBRM=99)
+      PARAMETER (NFLAV=6)
+      PARAMETER (NPTF=129)
+      DOUBLE PRECISION XBKPTL
+      COMMON /CDELRE/  DELRER
+      COMMON /CJAMBR/  NPTLC,NPTL2
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CPC/     XBKPTL(2,MXPC),ISPTL(MXPC)
+      COMMON /CPTF/    FPTFS,FPTFSS,FPTFU,FPTFUS,FPTFUU
+     *                ,QPTFS(NPTF),QPTFSS(NPTF),QPTFU(NPTF),QPTFUS(NPTF)
+     *                ,QPTFUU(NPTF),XPTF(NPTF)
+      DOUBLE PRECISION PJT,PSG,ROTSG,XORSG
+      COMMON /CSG/     PJT(5,MXJT),PSG(5,MXSG),ROTSG(3,MXSG)
+     *                ,XORSG(4,MXSG)
+     *                ,ICJT(2,MXJT),IORSG(MXSG),ISG(MXSG)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /QUARKM/  SMAS,SSMAS,USMAS,UUMAS
+
+      DOUBLE PRECISION A,AMAM,AMAX,ANEW,DA,DALFA,DATWID
+     *                ,DAUXIL,DR,DY,DYST,DYT,DY1,DY2,PHI,PM,PP,PT
+     *                ,PW(4),PX,PY,P0M,P0P,RA,RMX,RMY,XBK(4)
+     *                ,XBR,XOR2(4),XP,X2,YBR,YP,YTD,YNEW
+      REAL     PXBRAK(100),PYBRAK(100),XBREAK(100),YBREAK(100)
+      INTEGER  ICM(2),ICMP(2),ICMPBR(2,100),ICMZ(2)
+     *        ,ICP(2),ICPM(2),ICPMBR(2,100),ICPZ(2)
+     *        ,ICZ(2),ITRD(100),JC(NFLAV,2)
+     *        ,JCM(NFLAV,2),JCMP(NFLAV,2),JCMS(NFLAV,2),JCMZ(NFLAV,2)
+     *        ,JCP(NFLAV,2),JCPM(NFLAV,2),JCPZ(NFLAV,2),JCZ(NFLAV,2)
+      LOGICAL  LAST
+C-----------------------------------------------------------------------
+      NCNT3=0
+      NSG0=NSG
+9993  NSG=NSG0
+
+C  INITIALIZATION
+C  --------------
+
+      IRET=0
+      ICP(1)=ICJT(1,2*NS-1)
+      ICP(2)=ICJT(2,2*NS-1)
+      ICM(1)=ICJT(1,2*NS)
+      ICM(2)=ICJT(2,2*NS)
+      ICPMBR(1,1)=ICM(1)
+      ICPMBR(2,1)=ICM(2)
+
+      CALL IDDECO(ICP,JCP)
+      CALL IDDECO(ICM,JCM)
+      NP=0
+      DO 7 NF=1,NFLAV
+        NP=NP+JCP(NF,1)-JCP(NF,2)
+ 7    CONTINUE
+      AMMS=UTAMNX(JCP,JCM)
+      AM=PSG(5,NS)
+C
+      J = 2*NS
+      DAUXIL= PJT(3,J-1)+PJT(3,J)
+      P0P=PJT(4,J-1)+PJT(4,J)+DAUXIL
+      P0M=PJT(4,J-1)+PJT(4,J)-DAUXIL
+      XT=P0M
+      YT=P0P
+C
+      DALFA=DBLE(PAREA)
+C  INITIALIZE
+      XBREAK(1)=XT
+      YBREAK(1)=0.
+      PXBRAK(1)=0.
+      PYBRAK(1)=0.
+
+C  REDO
+C  ----
+
+      NCNT3=0
+9994  NCNT3=NCNT3+1
+      IBR=1
+      XP=XT
+      YP=0.D0
+      YTD=YT
+      IF ( NCNT3 .GT. 100 ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JAMBR2')
+          WRITE(IFCH,*)'*****  SPLIT KINEM NOT POSSIBLE.'
+          WRITE(IFCH,112)
+     *     (ICJT(J,2*NS-1),J=1,2),(ICJT(J,2*NS),J=1,2),PSG(5,NS)
+112       FORMAT(1X,2I8,4X,2I8,4X,F7.2)
+          CALL UTMSGF
+        ENDIF
+        IF ( NS .EQ. 1 ) THEN
+          IRET=9999
+          RETURN
+        ENDIF
+        IRET=9996
+        RETURN
+      ENDIF
+
+C  SEARCH FOR BREAKPOINTS
+C  ----------------------
+
+ 9    CONTINUE
+      DO 17 NF=1,NFLAV
+        JCPM(NF,1)=0
+        JCPM(NF,2)=0
+        JCMP(NF,1)=0
+        JCMP(NF,2)=0
+17    CONTINUE
+
+C  ORDINARY STRINGS
+C  ----------------
+C     NQU=0
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)'ORDINARY STRING FRAGMENTATION'
+        WRITE(IFCH,*)' '
+      ENDIF
+      IF ( RANGEN() .LE. PDIQUA ) THEN
+        NQU=2
+      ELSE
+        NQU=1
+      ENDIF
+      IF     ( MOD(NP+NQU,3) .EQ. 0 ) THEN
+        II=1
+      ELSEIF ( MOD(NP-NQU,3) .EQ. 0 ) THEN
+        II=2
+      ELSE
+        CALL UTSTOP('JAMBR2: NO SINGLET CONSTRUCTION POSSIBLE')
+      ENDIF
+      IFLTT=0
+      DO 18 N=1,NQU
+        IFL=INT(RANGEN()/PUD)+1
+        IFLTT=IFLTT*10+(IFL+1)/2
+        JCPM(IFL,II)=JCPM(IFL,II)+1
+        JCMP(IFL,3-II)=JCMP(IFL,3-II)+1
+18    CONTINUE
+      CALL IDENCO(JCPM,ICPM,IRETEN)
+      IF ( IRETEN .EQ. 1 ) THEN
+        CALL UTSTOP('JAMBR2: IDENCO(JCPM... RET.CODE=1       ')
+      ENDIF
+      CALL IDENCO(JCMP,ICMP,IRETEN)
+      IF ( IRETEN .EQ. 1 ) THEN
+        CALL UTSTOP('JAMBR2: IDENCO(JCMP... RET.CODE=1       ')
+      ENDIF
+
+C  CALCULATE PT OF STRING BREAKING
+C  -------------------------------------
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,109)ICM(1),ICMP(1),ICPM(1),ICP(1)
+     *                ,ICM(2),ICMP(2),ICPM(2),ICP(2)
+109     FORMAT(1X,'FLAVORS:',2(I11,I7)/9X,2(I11,I7)/)
+        WRITE(IFCH,*)'IFLTT:',IFLTT
+        WRITE(IFCH,*)' '
+      ENDIF
+      AMMP=UTAMNY(JCP,JCPM)
+      AMMM=UTAMNY(JCMP,JCM)
+      R = RANGEN()
+      IF     ( IFLTT .EQ. 1 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFU ,R*QPTFU(NPTF))
+C##       WRITE(IFCH,*)'JAMBR2:PT(OLD)=',PT
+        ELSE
+          RPT = R*FPTFU
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(1.+RPT*2./AUXIL))
+        ENDIF
+      ELSEIF ( IFLTT .EQ. 2 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFS ,R*QPTFS(NPTF))
+        ELSE
+          RPT = R*FPTFS
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(EXP(SMAS **2/AUXIL)+RPT*2./AUXIL)-SMAS **2)
+        ENDIF
+      ELSEIF ( IFLTT .EQ. 11 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFUU,R*QPTFUU(NPTF))
+        ELSE
+          RPT = R*FPTFUU
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(EXP(UUMAS**2/AUXIL)+RPT*2./AUXIL)-UUMAS**2)
+        ENDIF
+      ELSEIF ( IFLTT .EQ. 12  .OR.  IFLTT .EQ. 21 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFUS,R*QPTFUS(NPTF))
+        ELSE
+          RPT = R*FPTFUS
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(EXP(USMAS**2/AUXIL)+RPT*2./AUXIL)-USMAS**2)
+        ENDIF
+      ELSEIF ( IFLTT .EQ. 22 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFSS,R*QPTFSS(NPTF))
+        ELSE
+          RPT = R*FPTFSS
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(EXP(SSMAS**2/AUXIL)+RPT*2./AUXIL)-SSMAS**2)
+        ENDIF
+      ENDIF
+
+      IF ( IBR .EQ. 1 ) THEN
+        RMX=AMMM**2+PT**2
+      ELSE
+        RMX=0.001D0
+      ENDIF
+      RMY=AMMP**2+PT**2
+      IF ( RMY .GT. XP*(YTD-YP) ) GOTO 8
+
+C  SINGLE ARTRU-MENNESSIER BREAK (SAMB)
+C  ------------------------------------
+C  IN: XP,YP,YTD,RMX,RMY
+C  IN: DALFA
+C  OUT: XBR,YBR
+
+      DYT=YTD-YP
+C  Y-STEPPING RANGE
+      AMAM=1.D0+(RMX-RMY)/(XP*DYT)
+      A=(1.D0-4.D0*RMX/(AMAM*AMAM*XP*DYT))
+      IF ( A .LT. 0.D0 ) GOTO 8
+      A=SQRT(A)
+      DY1=DYT*AMAM*(1.D0-A)*0.5D0
+      DY2=DYT*AMAM*(1.D0+A)*0.5D0
+      DYST=0.0001D0*(DYT-DY2)
+ 3    CONTINUE
+      DR=DBLE(1.-RANGEN())
+      AMAX=XP*DYT*A*AMAM+RMX*LOG(DY1/DY2)+RMY*LOG((DYT-DY2)/(DYT-DY1))
+      RA=-LOG(DR)/DALFA
+      IF ( RA .GT. AMAX  .AND. IBR .GT. 1 ) GOTO 8
+      RA=MOD(RA,AMAX)
+      DY=DYT*SQRT(RMX)/(SQRT(RMX)+SQRT(RMY))
+      DATWID=XP*(DY-DY1)+RMX*LOG(DY1/DY)+RMY*LOG((DYT-DY)/(DYT-DY1))
+      ANEW=RA-DATWID
+      ICOUNT=0
+      IF ( ANEW .GT. 0.D0 ) GOTO 1
+ 2    CONTINUE
+      DA=XP - RMX/DY - RMY/(DYT-DY)
+      YNEW=DY+ANEW/DA
+      DY=INT(YNEW/DYST)*DYST
+      IF ( DY .LT. DY1 ) THEN
+        WRITE(IFCH,*) 'DY,DY1',DY,DY1
+        GOTO 4
+      ENDIF
+      ANEW=RA-XP*(DY-DY1)-RMX*LOG(DY1/DY)-RMY*LOG((DYT-DY)/(DYT-DY1))
+      IF ( ANEW .LT. 0.D0 ) GOTO 2
+      GOTO 4
+ 1    CONTINUE
+      DA=XP - RMX/DY - RMY/(DYT-DY)
+      YNEW=DY+ANEW/DA
+      DY=(INT(YNEW/DYST)+1)*DYST
+      ANEW=RA-XP*(DY-DY1)-RMX*LOG(DY1/DY)-RMY*LOG((DYT-DY)/(DYT-DY1))
+      IF ( ANEW .GT. 0.D0 ) GOTO 1
+      DY=DY-DYST
+      ANEW=RA-XP*(DY-DY1)-RMX*LOG(DY1/DY)-RMY*LOG((DYT-DY)/(DYT-DY1))
+ 4    CONTINUE
+      YBR=MIN( DY+RANGEN()*DYST, DY2 )
+      X2=(XP-RMX/YBR)
+      XBR=MIN( ANEW/DYST+RMY/(DYT-YBR), X2 )
+C  BETTER: SOLVE FOR YBR FROM ANEW=0
+C  FIND XBR FROM HOMOGENEOUS (NOT EXP) DISTR, X1<X<X2
+C        X1=RMY/(DYT-YBR)
+      YBR=YBR+YP
+C
+C  END SAMB
+C
+      IF ( IBR .GE. NBRM ) THEN
+        CALL UTSTOP('JAMBR2: IBR>NBRM                        ')
+      ENDIF
+      IBR=IBR+1
+      XBREAK(IBR)=XBR
+      YBREAK(IBR)=YBR
+      PHI=2.D0*PI*RANGEN()
+      PXBRAK(IBR)=PT*COS(PHI)
+      PYBRAK(IBR)=PT*SIN(PHI)
+      ICPMBR(1,IBR)=ICPM(1)
+      ICPMBR(2,IBR)=ICPM(2)
+      ICMPBR(1,IBR)=ICMP(1)
+      ICMPBR(2,IBR)=ICMP(2)
+      XP=XBR
+      YP=YBR
+      AMLEFT=SQRT(YBR*(XT-XBR))
+      AMRIGT=SQRT(XBR*(YT-YBR))
+      GOTO 9
+ 8    CONTINUE
+
+      IF ( IBR .EQ. 1 ) GOTO 9994
+
+C  INITIALIZE TAIL END
+C  -------------------
+      XBREAK(IBR+1)=0.
+      YBREAK(IBR+1)=YT
+      PXBRAK(IBR+1)=0.
+      PYBRAK(IBR+1)=0.
+      ICMPBR(1,IBR+1)=ICP(1)
+      ICMPBR(2,IBR+1)=ICP(2)
+
+C  PRINT
+C  -----
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'ICMPBR(1/2,)  X/YBREAK  PX/YBREAK:'
+        DO 52 IB=1,IBR+1
+          WRITE(IFCH,100)ICMPBR(1,IB),ICMPBR(2,IB)
+     *            ,XBREAK(IB),YBREAK(IB),PXBRAK(IB),PYBRAK(IB)
+100       FORMAT(1X,I10,I10,2E11.3,7X,2E11.3)
+          WRITE(IFCH,100)ICPMBR(1,IB),ICPMBR(2,IB)
+52      CONTINUE
+        WRITE(IFCH,*)' '
+      ENDIF
+
+C  TIME ORDER BREAKPOINTS
+C  ----------------------
+
+      T1=0.
+      DO 203 J=2,IBR
+        T2=2.
+        DO 20 I=2,IBR
+C         T=XBREAK(I)/XT+YBREAK(I)/YT
+          T=XBREAK(I)*YBREAK(I)/(XT*YT)
+          IF ( T .LE. T1  .OR.  T .GT. T2 ) GOTO 20
+          T2=T
+          NT=I
+20      CONTINUE
+        T1=T2
+        ITRD(J)=NT
+203   CONTINUE
+
+C  PRINT
+C  -----
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'ITRD:'
+        WRITE(IFCH,*)(ITRD(IB),IB=2,IBR)
+        WRITE(IFCH,*)' '
+      ENDIF
+
+C  CHECK ACCEPTANCE CRITERIUM
+C  --------------------------
+
+      NBR=0
+      DO 12 J=2,IBR
+        I=ITRD(J)
+        XBRI=XBREAK(I)
+        YBRI=YBREAK(I)
+C  FIND NEIGHBORING EARLIER BREAK POINTS
+        IR=IBR+1
+        IL=1
+        DO 204 JN=2,J
+          IN=ITRD(JN)
+          IF ( IN .GT. I  .AND.  IN .LT. IR ) IR=IN
+          IF ( IN .LT. I  .AND.  IN .GT. IL ) IL=IN
+204     CONTINUE
+        PML=(XBREAK(IL)-XBRI)
+        PPL=(YBRI-YBREAK(IL))
+        PMR=(XBRI-XBREAK(IR))
+        PPR=(YBREAK(IR)-YBRI)
+        PX=PXBRAK(I)
+        PY=PYBRAK(I)
+        PXL=PX-PXBRAK(IL)
+        PYL=PY-PYBRAK(IL)
+        AMMM=PML*PPL-(PXL*PXL+PYL*PYL)
+        PXR=PXBRAK(IR)-PX
+        PYR=PYBRAK(IR)-PY
+        AMMP=PMR*PPR-(PXR*PXR+PYR*PYR)
+        IF ( AMMP .LE. 0. ) GOTO 13
+        IF ( AMMM .LE. 0. ) GOTO 13
+        AMMP=SQRT(AMMP)
+        AMMM=SQRT(AMMM)
+        AMP=AMMP
+        AMM=AMMM
+        CALL UTRESM(ICMPBR(1,IR),ICMPBR(2,IR)
+     *             ,ICPMBR(1,I),ICPMBR(2,I),AMP,IDPR,IADJP,IRETEN)
+        CALL UTRESM(ICPMBR(1,IL),ICPMBR(2,IL)
+     *             ,ICMPBR(1,I),ICMPBR(2,I),AMM,IDMR,IADJM,IRETEN)
+        IF ( AMP .GT. AMMP ) GOTO 13
+        IF ( AMM .GT. AMMM ) GOTO 13
+        PT2=PX*PX+PY*PY
+        PTL2=PXBRAK(IL)**2+PYBRAK(IL)**2
+        PTR2=PXBRAK(IR)**2+PYBRAK(IR)**2
+        D=(PML*PPL-PTL2-PT2)*0.5
+        D=D*D-PT2*PTL2
+        IF ( D .LE. 0. ) GOTO 13
+        D=(PMR*PPR-PTR2-PT2)*0.5
+        D=D*D-PT2*PTR2
+        IF ( D .LE. 0. ) GOTO 13
+        NBR=NBR+1
+        GOTO 12
+13      CONTINUE
+        ITRD(J)=-1
+        XBREAK(I)=-1.
+        YBREAK(I)=-1.
+12    CONTINUE
+      IF ( NBR .EQ. 0 ) GOTO 9994
+
+C  PRINT
+C  -----
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'ICMPBR(1/2,)  X/YBREAK  PX/YBREAK:'
+        DO 53 IB=1,IBR+1
+          WRITE(IFCH,100)ICMPBR(1,IB),ICMPBR(2,IB)
+     *         ,XBREAK(IB),YBREAK(IB),PXBRAK(IB),PYBRAK(IB)
+          WRITE(IFCH,100)ICPMBR(1,IB),ICPMBR(2,IB)
+53      CONTINUE
+        WRITE(IFCH,*)' '
+      ENDIF
+
+C  BUILD NEW STRINGS
+C  -----------------
+      NBREAK=0
+      TAUAVE=0.
+      IL=1
+      IN=IL
+      IR=1
+      LAST=.FALSE.
+11    CONTINUE
+      IR=IR+1
+      IF ( IR .EQ. IBR+1 ) LAST=.TRUE.
+      IF ( XBREAK(IR) .LT. 0. ) GOTO 11
+      IF ( IN .EQ. 1 ) GOTO 14
+15    CONTINUE
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'IL IN IR:  ',IL,IN,IR
+        WRITE(IFCH,*)' '
+      ENDIF
+      PML=XBREAK(IL)-XBREAK(IN)
+      PPL=YBREAK(IN)-YBREAK(IL)
+      PMR=(XBREAK(IN)-XBREAK(IR))
+      PPR=(YBREAK(IR)-YBREAK(IN))
+      PX=PXBRAK(IN)
+      PY=PYBRAK(IN)
+      PXL=PX-PXBRAK(IL)
+      PYL=PY-PYBRAK(IL)
+      PTL2=(PXL*PXL+PYL*PYL)
+      AMM=SQRT(PML*PPL-PTL2)
+      PXR=PXBRAK(IR)-PX
+      PYR=PYBRAK(IR)-PY
+      PTR2=(PXR*PXR+PYR*PYR)
+      AMP=SQRT(PMR*PPR-PTR2)
+      CALL UTRESM(ICMPBR(1,IR),ICMPBR(2,IR)
+     *           ,ICPMBR(1,IN),ICPMBR(2,IN),AMP,IDPR,IADJP,IRETEN)
+      CALL UTRESM(ICPMBR(1,IL),ICPMBR(2,IL)
+     *           ,ICMPBR(1,IN),ICMPBR(2,IN),AMM,IDMR,IADJM,IRETEN)
+      AREA=PPL*PMR
+      P0P=PPL+PPR
+      P0M=PML+PMR
+      TMM2=(PTL2+AMM**2)
+      TMP2=(PTR2+AMP**2)
+      IF(ISH.GE.90)THEN
+        IF ( TMP2 .GT. PPR*PMR+1.E-4 ) THEN
+          CALL UTMSG('JAMBR2')
+          WRITE(IFCH,*)'*****  TMP*TMP.GT.PPR*PMR'
+          WRITE(IFCH,*)'TMP*TMP PPR*PMR: ',TMP2,PPR*PMR
+          CALL UTMSGF
+        ENDIF
+        IF ( TMM2. GT. PPL*PML+1.E-4 ) THEN
+          CALL UTMSG('JAMBR2')
+          WRITE(IFCH,*)'*****  TMM*TMM.GT.PPL*PML'
+          WRITE(IFCH,*)'TMM*TMM PPL*PML: ',TMM2,PPL*PML
+          CALL UTMSGF
+        ENDIF
+      ENDIF
+      ETA=0.5*LOG(PPL/PMR)
+C ------ ADJUST P NOT M
+      IF     ( IADJP .EQ. 1  .AND.  IADJM .NE. 1 ) THEN
+        IF ( ISH .GE. 92 ) WRITE(IFCH,*)'ADJUST P NOT M'
+        ETANEW=LOG((SQRT(AREA)*P0P)/(TMP2+AREA))
+        IF ( ETANEW .LT. ETA-1.E-4 ) THEN
+          CALL UTMSG('JAMBR2')
+          WRITE(IFCH,*)'*****  ETANEW.LT.ETA'
+          WRITE(IFCH,*)'ETANEW ETA: ',ETANEW,ETA
+          CALL UTMSGF
+          ETANEW=ETA
+        ENDIF
+        XBREAK(IN)=SQRT(AREA)*EXP(-ETANEW)+XBREAK(IR)
+        YBREAK(IN)=SQRT(AREA)*EXP(ETANEW)+YBREAK(IL)
+C ------ ADJUST M NOT P
+      ELSEIF ( IADJM .EQ. 1  .AND.  IADJP .NE. 1 ) THEN
+        IF ( ISH .GE. 92 ) WRITE(IFCH,*)'ADJUST M NOT P'
+        ETANEW=-LOG((SQRT(AREA)*P0M)/(TMM2+AREA))
+        IF ( ETANEW .GT. ETA+1.E-4 ) THEN
+          IF(ISH.GE.90)THEN
+            CALL UTMSG('JAMBR2')
+            WRITE(IFCH,*)'*****  ETANEW.GT.ETA'
+            WRITE(IFCH,*)'ETANEW ETA: ',ETANEW,ETA
+            CALL UTMSGF
+          ENDIF
+          ETANEW=ETA
+        ENDIF
+        XBREAK(IN)=SQRT(AREA)*EXP(-ETANEW)+XBREAK(IR)
+        YBREAK(IN)=SQRT(AREA)*EXP(ETANEW)+YBREAK(IL)
+C ------ ADJUST BOTH
+      ELSEIF ( IADJP .EQ. 1  .AND.  IADJM .EQ. 1 ) THEN
+        IF ( ISH .GE. 92 ) WRITE(IFCH,*)'ADJUST BOTH'
+        D=(P0P*P0M-TMP2-TMM2)**2-4*TMP2*TMM2
+        IF ( D .LT. 0. ) THEN
+          IF(ISH.GE.90)THEN
+            CALL UTMSG('JAMBR2')
+            WRITE(IFCH,*)'***** NEGATIVE D'
+            WRITE(IFCH,*)'D: ',D
+            CALL UTMSGF
+          ENDIF
+          D=0.
+        ENDIF
+        D=SQRT(D)
+        T=P0P*P0M-TMP2+TMM2
+        P1=(T+D)/(2.*P0M)
+        P2=(T-D)/(2.*P0M)
+        IF ( (P1+P2)*0.5 .GT. PPL ) THEN
+          P=P2
+        ELSE
+          P=P1
+        ENDIF
+        XBREAK(IN)=P0M-TMM2/P+XBREAK(IR)
+        YBREAK(IN)=P+YBREAK(IL)
+      ENDIF
+C  ------
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'X/YBREAK:',XBREAK(IN),YBREAK(IN)
+        WRITE(IFCH,*)' '
+      ENDIF
+
+C  WRITE SG
+C  --------
+      NBREAK=NBREAK+1
+      TAUAVE=TAUAVE+XBREAK(IN)*YBREAK(IN)
+      MM=1
+      IF ( LAST ) MM=2
+      DO 9998 M=1,MM
+        NSG=NSG+1
+        IF ( NSG .GT. MXSG ) THEN
+          CALL UTSTOP('JAMBR2: NSG>MXSG                        ')
+        ENDIF
+        IF ( ISH .GE. 92 ) WRITE(IFCH,*)'NSG LAST:  ',NSG,LAST
+        ISG(NSG)=NPTLC
+        IF ( M .EQ. 2 ) THEN
+          IL=IN
+          IN=IR
+        ENDIF
+        XOR2(1)=0.D0
+        XOR2(2)=0.D0
+        XOR2(3)=(YBREAK(IL)-XBREAK(IN))*0.5D0/TENSN
+        XOR2(4)=(YBREAK(IL)+XBREAK(IN))*0.5D0/TENSN
+        IF ( ISH .GE. 92 ) WRITE(IFCH,119)XOR2
+119     FORMAT(/' ORIGIN: ',13X,4F7.2/)
+        CALL UTROT2(-1,ROTSG(1,NS),ROTSG(2,NS),ROTSG(3,NS)
+     *              ,XOR2(1),XOR2(2),XOR2(3))
+        CALL UTLOB2(-1,PSG(1,NS),PSG(2,NS),PSG(3,NS),PSG(4,NS),PSG(5,NS)
+     *              ,XOR2(1),XOR2(2),XOR2(3),XOR2(4))
+        XOR2(1)=XOR2(1)+XORSG(1,NS)
+        XORSG(1,NSG)=XOR2(1)
+        XOR2(2)=XOR2(2)+XORSG(2,NS)
+        XORSG(2,NSG)=XOR2(2)
+        XOR2(3)=XOR2(3)+XORSG(3,NS)
+        XORSG(3,NSG)=XOR2(3)
+        XOR2(4)=XOR2(4)+XORSG(4,NS)
+        XORSG(4,NSG)=XOR2(4)
+C       IF ( ISH .GE. 92 ) WRITE(IFCH,117)XOR2
+        PP=YBREAK(IN)-YBREAK(IL)
+        PM=XBREAK(IL)-XBREAK(IN)
+        PSG(1,NSG)=PXBRAK(IN)-PXBRAK(IL)
+        PSG(2,NSG)=PYBRAK(IN)-PYBRAK(IL)
+        PSG(3,NSG)=(PP-PM)*0.5D0
+        PSG(4,NSG)=(PP+PM)*0.5D0
+        SS=PSG(4,NSG)**2-PSG(3,NSG)**2-PSG(2,NSG)**2-PSG(1,NSG)**2
+        PSG(5,NSG)=SQRT(SS)
+        IF ( ISH .GE. 92 ) WRITE(IFCH,110)NSG,NS,(PSG(J,NSG),J=1,5)
+110     FORMAT(1X,I5,I4,16X,1P,5E10.2)
+        PW(1)=PSG(1,NSG)
+        PW(2)=PSG(2,NSG)
+        PW(3)=PSG(3,NSG)
+        PW(4)=PSG(4,NSG)
+        CALL UTROT2(-1,ROTSG(1,NS),ROTSG(2,NS),ROTSG(3,NS)
+     *              ,PSG(1,NSG),PSG(2,NSG),PSG(3,NSG))
+        CALL UTLOB2(-1,PSG(1,NS),PSG(2,NS),PSG(3,NS),PSG(4,NS),PSG(5,NS)
+     *              ,PSG(1,NSG),PSG(2,NSG),PSG(3,NSG),PSG(4,NSG))
+        IORSG(NSG)=NS
+        IF ( ISH .GE. 92 ) THEN
+          WRITE(IFCH,102)NSG,IORSG(NSG),(PSG(J,NSG),J=1,5)
+102       FORMAT(1X,I5,I4,16X,1P,5E10.2)
+          WRITE(IFCH,*)' '
+        ENDIF
+
+C  WRITE JT
+C  --------
+        ICJT(1,2*NSG-1)=ICMPBR(1,IN)
+        ICJT(2,2*NSG-1)=ICMPBR(2,IN)
+        DO 41 NF=1,NFLAV
+CDH ########  JCMS IST NICHT GESETZT!!!!
+          JC(NF,1)=JCMS(NF,1)
+          JC(NF,2)=JCMS(NF,2)
+41      CONTINUE
+        ICJT(1,2*NSG)=ICPMBR(1,IL)
+        ICJT(2,2*NSG)=ICPMBR(2,IL)
+        IF ( M .EQ. 2 ) THEN
+          IDX=IADJP
+        ELSE
+          IDX=IADJM
+        ENDIF
+        IF ( IDX .EQ. 0 ) THEN
+          PJT(1,2*NSG-1)=PXBRAK(IN)
+          PJT(2,2*NSG-1)=PYBRAK(IN)
+          PTJR2=PXBRAK(IN)**2+PYBRAK(IN)**2
+          PTJL2=PXBRAK(IL)**2+PYBRAK(IL)**2
+          AA=PM*PP-PTJL2-PTJR2
+          AUXIL=SQRT(AA*AA*0.25-PTJL2*PTJR2)
+          PRM=(AA*0.5+PTJR2-AUXIL)/PP
+          PLP=(AA*0.5+PTJL2-AUXIL)/PM
+          PJT(3,2*NSG-1)=(PP-PLP-PRM)*0.5D0
+          PJT(4,2*NSG-1)=(PP-PLP+PRM)*0.5D0
+          PJT(5,2*NSG-1)=0.D0
+          PJT(1,2*NSG)=-PXBRAK(IL)
+          PJT(2,2*NSG)=-PYBRAK(IL)
+          PJT(3,2*NSG)=(PLP-PM+PRM)*0.5D0
+          PJT(4,2*NSG)=(PLP+PM-PRM)*0.5D0
+          PJT(5,2*NSG)=0.D0
+          IF ( ISH .GE. 92 ) THEN
+            WRITE(IFCH,108)NSG,NS
+     *          ,(ICJT(J,2*NSG-1),J=1,2),(SNGL(PJT(J,2*NSG-1)),J=1,5)
+108         FORMAT(2X,I3,I4,2X,2I7,5(E10.2))
+            WRITE(IFCH,108)NSG,NS
+     *          ,(ICJT(J,2*NSG  ),J=1,2),(SNGL(PJT(J,2*NSG  )),J=1,5)
+          ENDIF
+          ERR=    (PW(1)-PJT(1,2*NSG-1)-PJT(1,2*NSG))**2
+          ERR=ERR+(PW(2)-PJT(2,2*NSG-1)-PJT(2,2*NSG))**2
+          ERR=ERR+(PW(3)-PJT(3,2*NSG-1)-PJT(3,2*NSG))**2
+          ERR=ERR+(PW(4)-PJT(4,2*NSG-1)-PJT(4,2*NSG))**2
+        ENDIF
+        ICPZ(1)=ICJT(1,2*NSG-1)
+        ICPZ(2)=ICJT(2,2*NSG-1)
+        ICMZ(1)=ICJT(1,2*NSG)
+        ICMZ(2)=ICJT(2,2*NSG)
+        CALL IDDECO(ICPZ,JCPZ)
+        CALL IDDECO(ICMZ,JCMZ)
+        DO 57 NF=1,NFLAV
+          JCZ(NF,1)=JCPZ(NF,1)+JCMZ(NF,1)
+          JCZ(NF,2)=JCPZ(NF,2)+JCMZ(NF,2)
+57      CONTINUE
+        CALL IDENCO(JCZ,ICZ,IRETEN)
+        IDZ=IDTRA(ICZ,0,0,3)
+        AMZ=PSG(5,NSG)
+        CALL IDRES(IDZ,AMZ,IDRZ,IADJ)
+        IF ( IDRZ .EQ. 110  .AND.  RANGEN() .LT. 0.5 ) GOTO 9993
+9998  CONTINUE
+
+14    CONTINUE
+      IF ( LAST ) GOTO 10
+      IL=IN
+      IN=IR
+      GOTO 11
+10    CONTINUE
+C
+C  DETERMINE BREAK PNT
+C  -----------------------------------
+      TAUAVE=TAUAVE/NBREAK
+      XBK(1)=0.D0
+      XBK(2)=0.D0
+      AUXIL1=SQRT(TAUAVE*YT/XT)
+      AUXIL2=SQRT(TAUAVE*XT/YT)
+      XBK(3)=(AUXIL1-AUXIL2)*0.5D0/TENSN
+      XBK(4)=(AUXIL1+AUXIL2)*0.5D0/TENSN
+      IF ( ISH .GE. 92 ) WRITE(IFCH,116) XBK
+116   FORMAT(' BREAKING PNT: ',13X,4F7.2)
+      CALL UTROT2(-1,ROTSG(1,NS),ROTSG(2,NS),ROTSG(3,NS)
+     *             ,XBK(1),XBK(2),XBK(3))
+      CALL UTLOB2(-1,PSG(1,NS),PSG(2,NS),PSG(3,NS),PSG(4,NS),PSG(5,NS)
+     *             ,XBK(1),XBK(2),XBK(3),XBK(4))
+      XBK(1)=XBK(1)+XORSG(1,NS)
+      XBK(2)=XBK(2)+XORSG(2,NS)
+      XBK(3)=XBK(3)+XORSG(3,NS)
+      XBK(4)=XBK(4)+XORSG(4,NS)
+      IF ( ISH .GE. 92 ) WRITE(IFCH,117)XBK
+117   FORMAT(28X,4F7.2/)
+C
+      XBKPTL(1,NPTLC-NPTL2)=XBK(3)
+      XBKPTL(2,NPTLC-NPTL2)=XBK(4)
+      ISPTL(NPTLC-NPTL2)=1
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JAMFRA(JS,NEWEVT)
+
+C-----------------------------------------------------------------------
+C  FRAGMENTS STRING JS ACCORDING TO A-M MODEL.
+C  VERSION MAR-92 (CALLS JAMBR1 OR JAMBR2)
+C-----------------------------------------------------------------------
+      PARAMETER (MXPC=500)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXSG=500)
+      PARAMETER (MXJT=2*MXSG)
+      PARAMETER (MXSTR=3000)
+      PARAMETER (NFLAV=6)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CDELRE/  DELRER
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /CJAMBR/  NPTLC,NPTL2
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      DOUBLE PRECISION XBKPTL
+      COMMON /CPC/     XBKPTL(2,MXPC),ISPTL(MXPC)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      DOUBLE PRECISION PJT,PSG,ROTSG,XORSG
+      COMMON /CSG/     PJT(5,MXJT),PSG(5,MXSG),ROTSG(3,MXSG)
+     *                ,XORSG(4,MXSG)
+     *                ,ICJT(2,MXJT),IORSG(MXSG),ISG(MXSG)
+      COMMON /CSTR/    PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
+     *                ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      DOUBLE PRECISION ARM(4),ARP(4),TOR,ZOR
+      INTEGER          IC(2),ICJ1(2),ICJ2(2)
+     *                ,ICM(2),ICP(2),ICUM(2),ICUP(2)
+     *                ,JC(NFLAV,2) ,JCJ1(NFLAV,2),JCJ2(NFLAV,2)
+     *                ,JCM(NFLAV,2),JCP(NFLAV,2)
+C-----------------------------------------------------------------------
+      DELREC=0.600
+      DELREX=0.050
+      NEWEVT=0
+
+      PSG(1,1)=PSTR(1,JS)
+      PSG(2,1)=PSTR(2,JS)
+      PSG(3,1)=PSTR(3,JS)
+      PSG(4,1)=PSTR(4,JS)
+      PSG(5,1)=PSTR(5,JS)
+      ROTSG(1,1)=ROTSTR(1,JS)
+      ROTSG(2,1)=ROTSTR(2,JS)
+      ROTSG(3,1)=ROTSTR(3,JS)
+      XORSG(1,1)=XORSTR(1,JS)
+      XORSG(2,1)=XORSTR(2,JS)
+      XORSG(3,1)=XORSTR(3,JS)
+      XORSG(4,1)=XORSTR(4,JS)
+      SQRTS=ABS(PSTR(5,JS))
+      S=PSTR(5,JS)**2
+      ISG(1)=IORSTR(JS)
+      IORSG(1)=0
+      PJT(1,1)=0.D0
+      PJT(1,2)=0.D0
+      PJT(2,1)=0.D0
+      PJT(2,2)=0.D0
+      PJT(3,1)=SQRTS*0.5D0
+      PJT(3,2)=-SQRTS*0.5D0
+      PJT(4,1)=SQRTS*0.5D0
+      PJT(4,2)=SQRTS*0.5D0
+      PJT(5,1)=0.D0
+      PJT(5,2)=0.D0
+      IF ( ROTSTR(3,JS) .LT. 0. ) THEN
+        ICJT(1,1)=ICSTR(3,JS)
+        ICJT(2,1)=ICSTR(4,JS)
+        ICJT(1,2)=ICSTR(1,JS)
+        ICJT(2,2)=ICSTR(2,JS)
+      ELSE
+        ICJT(1,1)=ICSTR(1,JS)
+        ICJT(2,1)=ICSTR(2,JS)
+        ICJT(1,2)=ICSTR(3,JS)
+        ICJT(2,2)=ICSTR(4,JS)
+      ENDIF
+      ICJ1(1)=ICJT(1,1)
+      ICJ1(2)=ICJT(2,1)
+      ICJ2(1)=ICJT(1,2)
+      ICJ2(2)=ICJT(2,2)
+      CALL IDDECO(ICJ1,JCJ1)
+      CALL IDDECO(ICJ2,JCJ2)
+      NQJ1=0
+      NQJ2=0
+      DO 4 NF=1,NFLAV
+        NQJ1=NQJ1+JCJ1(NF,1)-JCJ1(NF,2)
+        NQJ2=NQJ2+JCJ2(NF,1)-JCJ2(NF,2)
+4     CONTINUE
+      IF ( NQJ1 .GE. 0 ) THEN
+        IF ( NQJ2 .GE. 0 ) THEN
+          ISI = 0
+        ELSE
+          ISI = 1
+        ENDIF
+      ELSE
+        IF ( NQJ2 .GE. 0 ) THEN
+          ISI = 2
+        ELSE
+          ISI = 3
+        ENDIF
+      ENDIF
+      NQJSTR=ISI*1000000+ABS(NQJ1)*1000+ABS(NQJ2)
+
+C  ENTRY STRING FRAGMENTATION
+C  --------------------------
+      NPTL2=NPTL
+      NCNT2=0
+9996  NCNT2=NCNT2+1
+      NPTL=NPTL2
+      NSG=1
+      IF ( NCNT2 .GT. 1000 ) GOTO 1001
+
+C  ENTRY SUBSTRING PROCESSING
+C  --------------------------
+      NS=0
+9999  NS=NS+1
+      IF ( NS .GT. NSG ) GOTO 9997
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)'ENTRY SUBSTRING PROCESSING'
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,107)NS
+     *        ,(ICJT(J,2*NS-1 ),J=1,2),(SNGL(PJT(J,2*NS-1 )),J=1,5)
+107     FORMAT(2X,I3,3X,3X,2I7,5(E10.2))
+        WRITE(IFCH,107)NS
+     *        ,(ICJT(J,2*NS   ),J=1,2),(SNGL(PJT(J,2*NS   )),J=1,5)
+        WRITE(IFCH,101)NS,(PSG(J,NS),J=1,5)
+101     FORMAT(2X,I3,23X,5(E10.2)/)
+114     FORMAT(' LEFT BREAKING PNT: ',8X,4F7.2/)
+      ENDIF
+
+C  DETERMINE ID AND MIN.MASS
+C  -------------------------
+      DELRER=DELREX+RANGEN()*(DELREM-DELREX)
+      ICP(1)=ICJT(1,2*NS-1)
+      ICP(2)=ICJT(2,2*NS-1)
+      ICM(1)=ICJT(1,2*NS)
+      ICM(2)=ICJT(2,2*NS)
+      CALL IDCOMK(ICP)
+      CALL IDCOMK(ICM)
+      ICJT(1,2*NS-1)=ICP(1)
+      ICJT(2,2*NS-1)=ICP(2)
+      ICJT(1,2*NS)=ICM(1)
+      ICJT(2,2*NS)=ICM(2)
+      CALL IDDECO(ICP,JCP)
+      CALL IDDECO(ICM,JCM)
+      AMMS=UTAMNX(JCM,JCP)
+      NUBAR=0
+      DO 7 NF=1,NFLAV
+        JC(NF,1)=JCP(NF,1)+JCM(NF,1)
+        JC(NF,2)=JCP(NF,2)+JCM(NF,2)
+        IF ( NF .GT. 4  .AND.  (JC(NF,1).NE.0 .OR. JC(NF,2).NE.0) ) THEN
+          CALL UTSTOP('JAMFRA: FLAVOUR > 4                     ')
+        ENDIF
+        NUBAR=NUBAR+JC(NF,1)-JC(NF,2)
+7     CONTINUE
+      IF ( NS .EQ. 1 ) NUMBAR=NUBAR
+      CALL IDENCO(JC,IC,IRETEN)
+      CALL IDCOMK(IC)
+      ID=IDTRA(IC,0,0,3)
+      IDK=ID
+      AM=PSG(5,NS)
+      IREMN=0
+      IF ( ICP(1)+ICP(2) .EQ. 0  .OR.  ICM(1)+ICM(2) .EQ. 0 ) IREMN=1
+      IF ( AM .GT. AMMS+DELRER  .AND.  IREMN .EQ. 0 ) ID=0
+
+C  MASS ADJUSTMENT => FRAGMENT AGAIN
+C  ---------------------------------
+      AMC=PSG(5,NS)
+      CALL IDRES(ID,AMC,IDR,IADJ)
+      IF ( ABS(AMC-PSG(5,NS)) .GT. 1.E-3 ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JAMFRA')
+          WRITE(IFCH,*)'*****  MASS CHANGED. FRAGMENT AGAIN.'
+          WRITE(IFCH,*)'MASS BEFORE, AFTER: ',PSG(5,NS),AMC
+          WRITE(IFCH,*)'IC,ID,IDR: ',IC,ID,IDR
+          CALL UTMSGF
+        ENDIF
+        GOTO 9996
+      ENDIF
+
+C  IF MASS < MIN.MASS ==> AGAIN
+C  ----------------------------
+C-C   IF ( IDR.EQ.0.AND.AM.LT.AMMS-1.E-3 ) THEN
+C-C     IF ( ISH .GE. 90 ) THEN
+C-C       CALL UTMSG('JAMFRA')
+C-C       WRITE(IFCH,*)'*****  MASS < MIN MASS. ',AM,AMMS
+C-C       WRITE(IFCH,*)'IDK,ID,IDR,PSG(5,NS):'
+C-C       WRITE(IFCH,*)IDK,ID,IDR,PSG(5,NS)
+C-C       WRITE(IFCH,*)'P_JET:'
+C-C       WRITE(IFCH,107)NS
+C-C  *       ,(ICJT(J,2*NS-1 ),J=1,2),(SNGL(PJT(J,2*NS-1 )),J=1,5)
+C-C       WRITE(IFCH,107)NS
+C-C  *       ,(ICJT(J,2*NS   ),J=1,2),(SNGL(PJT(J,2*NS   )),J=1,5)
+C-C       WRITE(IFCH,*)'P_STR:'
+C-C       WRITE(IFCH,101)NS,(PSG(J,NS),J=1,5)
+C-C       CALL UTMSGF
+C-C     ENDIF
+C-C     IF ( NS .EQ. 1 ) GOTO 1001
+C-C     GOTO 9996
+C-C   ENDIF
+
+C  WRITE ON /CPTL/ (1)
+C  -------------------
+      IORI=ISG(NS)
+      NPTLB=NPTL
+9995  NPTL=NPTL+1
+      NPTLC=NPTL
+      IF ( NPTL .GT. MXPTL ) THEN
+        CALL UTSTOP('JAMFRA: NPTL>MXPTL                      ')
+      ENDIF
+      IF ( NPTL-NPTL2 .GT. MXPC ) THEN
+        CALL UTSTOP('JAMFRA: NPTL-NPTL2>MXPC                 ')
+      ENDIF
+
+      PPTL(1,NPTL)=PSG(1,NS)
+      PPTL(2,NPTL)=PSG(2,NS)
+      PPTL(3,NPTL)=PSG(3,NS)
+      PPTL(4,NPTL)=PSG(4,NS)
+      PPTL(5,NPTL)=PSG(5,NS)
+      XORPTL(1,NPTL)=XORSG(1,NS)
+      XORPTL(2,NPTL)=XORSG(2,NS)
+      XORPTL(3,NPTL)=XORSG(3,NS)
+      XORPTL(4,NPTL)=XORSG(4,NS)
+      XBKPTL(1,NPTL-NPTL2)=AINFIN
+      XBKPTL(2,NPTL-NPTL2)=AINFIN
+      TIVPTL(1,NPTL)=-AINFIN
+      TIVPTL(2,NPTL)=AINFIN
+      IFRPTL(1,NPTL)=0
+      IFRPTL(2,NPTL)=0
+      ICLPTL(NPTL)=0
+      ISPTL(NPTL-NPTL2)=0
+      IORPTL(NPTL)=IORI
+      JORPTL(NPTL)=0
+      IF     ( NPTL .GT. NPTL2+1 ) THEN
+        NQJPTL(NPTL)=-NQJSTR
+      ELSEIF ( NPTL .EQ. NPTL2+1 ) THEN
+        NQJPTL(NPTL)= NQJSTR
+      ENDIF
+      IDPTL(NPTL)=IDR
+      IF ( IDR .EQ. 0 ) THEN
+        IF ( IC(1) .EQ. 0  .AND.  IC(2) .EQ. 0 ) THEN
+          IDPTL(NPTL)=700000000
+          CALL IDTRBI(JC,IBPTL(1,NPTL),IBPTL(2,NPTL)
+     *                ,IBPTL(3,NPTL),IBPTL(4,NPTL))
+        ELSE
+          IB5=JC(5,1)*10000+JC(5,2)
+          IB6=JC(6,1)*10000+JC(6,2)
+          IF ( IB5 .NE. 0  .OR.  IB6 .NE. 0 ) THEN
+            WRITE(IFCH,*)' '
+            WRITE(IFCH,*)'***** ERROR IN JAMFRA: BOTTOM OR TOP QUARKS'
+            WRITE(IFCH,*)'JC:'
+            WRITE(IFCH,*)JC
+            CALL UTSTOP('JAMFRA: BOTTOM OR TOP QUARKS            ')
+          ENDIF
+          IDPTL(NPTL)=800000000+IC(1)*100+IC(2)/100
+        ENDIF
+      ENDIF
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,115)NPTL,IORPTL(NPTL),IDPTL(NPTL)
+     *                 ,(PPTL(J,NPTL),J=1,5)
+115     FORMAT(1X,'/CPTL/',I6,I7,I10,5(E10.2))
+        IF ( IDPTL(NPTL) .EQ. 700000000 )
+     *                               WRITE(IFCH,*)(IBPTL(I,NPTL),I=1,4)
+        IF ( ISH .GE. 92 ) WRITE(IFCH,*)' '
+      ENDIF
+      IF ( IDR .NE. 0 ) GOTO 9999
+
+      NQP=0
+      NQM=0
+      NAP=0
+      NAM=0
+      DO 23 NF=1,NFLAV
+        NQP=NQP+JCP(NF,1)
+        NQM=NQM+JCM(NF,1)
+        NAP=NAP+JCP(NF,2)
+        NAM=NAM+JCM(NF,2)
+23    CONTINUE
+      NP=NQP-NAP
+      NM=NQM-NAM
+      JP=NQP+NAP
+      JM=NQM+NAM
+
+C  QUARK-CLUSTER
+C  -------------
+      IF ( ICP(1)+ICP(2) .EQ. 0  .OR.  ICM(1)+ICM(2) .EQ. 0 ) GOTO 78
+      IF ( AM .GT. AMMS+DELRER ) GOTO 77
+      IF ( IDK .EQ. 0  .AND.  AM .GT. AMMS+DELREC ) GOTO 77
+      IF ( IDK .NE. 0  .AND.  AM .GT. AMMS+DELREX ) GOTO 77
+78    CONTINUE
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)'QUARK-CLUSTER'
+        WRITE(IFCH,*)' '
+      ENDIF
+      IF ( ICP(1)+ICP(2) .EQ. 0  .AND. ICM(1)+ICM(2) .EQ. 0 ) THEN
+        CALL UTSTOP('JAMFRA: ZERO STRING.                    ')
+      ENDIF
+      GOTO 9999
+77    CONTINUE
+
+C  JET TRAFOS
+C  ----------
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)'JET TRAFOS'
+        WRITE(IFCH,*)' '
+      ENDIF
+      ARP(1)=PJT(1,2*NS-1)
+      ARP(2)=PJT(2,2*NS-1)
+      ARP(3)=PJT(3,2*NS-1)
+      ARP(4)=PJT(4,2*NS-1)
+      ARM(1)=PJT(1,2*NS)
+      ARM(2)=PJT(2,2*NS)
+      ARM(3)=PJT(3,2*NS)
+      ARM(4)=PJT(4,2*NS)
+      IF ( ISH .GE. 90 ) CALL UTCHM(ARP,ARM,1)
+      NSO=IORSG(NS)
+      IF ( NSO .GT. 0 ) THEN
+        CALL UTROT2(-1,ROTSG(1,NSO),ROTSG(2,NSO),ROTSG(3,NSO)
+     *             ,ARP(1),ARP(2),ARP(3))
+        CALL UTLOB2(-1,PSG(1,NSO),PSG(2,NSO),PSG(3,NSO),PSG(4,NSO)
+     *              ,PSG(5,NSO),ARP(1),ARP(2),ARP(3),ARP(4))
+        CALL UTROT2(-1,ROTSG(1,NSO),ROTSG(2,NSO),ROTSG(3,NSO)
+     *               ,ARM(1),ARM(2),ARM(3))
+        CALL UTLOB2(-1,PSG(1,NSO),PSG(2,NSO),PSG(3,NSO),PSG(4,NSO)
+     *               ,PSG(5,NSO),ARM(1),ARM(2),ARM(3),ARM(4))
+        IF ( ISH .GE. 90 ) CALL UTCHM(ARP,ARM,2)
+        CALL UTLOB2(1,PSG(1,NS),PSG(2,NS),PSG(3,NS),PSG(4,NS),PSG(5,NS)
+     *              ,ARP(1),ARP(2),ARP(3),ARP(4))
+        CALL UTLOB2(1,PSG(1,NS),PSG(2,NS),PSG(3,NS),PSG(4,NS),PSG(5,NS)
+     *               ,ARM(1),ARM(2),ARM(3),ARM(4))
+        IF ( ISH .GE. 90 ) CALL UTCHM(ARP,ARM,3)
+        ROTSG(1,NS)=(ARP(1)-ARM(1))*0.5D0
+        ROTSG(2,NS)=(ARP(2)-ARM(2))*0.5D0
+        ROTSG(3,NS)=(ARP(3)-ARM(3))*0.5D0
+        CALL UTROT2(1,ROTSG(1,NS),ROTSG(2,NS),ROTSG(3,NS)
+     *              ,ARP(1),ARP(2),ARP(3))
+        CALL UTROT2(1,ROTSG(1,NS),ROTSG(2,NS),ROTSG(3,NS)
+     *              ,ARM(1),ARM(2),ARM(3))
+      ENDIF
+      ICUP(1)=ICJT(1,2*NS-1)
+      ICUP(2)=ICJT(2,2*NS-1)
+      ICUM(1)=ICJT(1,2*NS)
+      ICUM(2)=ICJT(2,2*NS)
+      IF ( ARP(3) .LT. 0.D0 ) THEN
+        ICJT(1,2*NS-1)=ICUM(1)
+        ICJT(2,2*NS-1)=ICUM(2)
+        PJT(1,2*NS-1)=ARM(1)
+        PJT(2,2*NS-1)=ARM(2)
+        PJT(3,2*NS-1)=ARM(3)
+        PJT(4,2*NS-1)=ARM(4)
+        ICJT(1,2*NS)=ICUP(1)
+        ICJT(2,2*NS)=ICUP(2)
+        PJT(1,2*NS)=ARP(1)
+        PJT(2,2*NS)=ARP(2)
+        PJT(3,2*NS)=ARP(3)
+        PJT(4,2*NS)=ARP(4)
+      ELSE
+        ICJT(1,2*NS-1)=ICUP(1)
+        ICJT(2,2*NS-1)=ICUP(2)
+        PJT(1,2*NS-1)=ARP(1)
+        PJT(2,2*NS-1)=ARP(2)
+        PJT(3,2*NS-1)=ARP(3)
+        PJT(4,2*NS-1)=ARP(4)
+        ICJT(1,2*NS)=ICUM(1)
+        ICJT(2,2*NS)=ICUM(2)
+        PJT(1,2*NS)=ARM(1)
+        PJT(2,2*NS)=ARM(2)
+        PJT(3,2*NS)=ARM(3)
+        PJT(4,2*NS)=ARM(4)
+      ENDIF
+      S=PSG(5,NS)**2
+      IF ( ISH .GE. 90 ) THEN
+
+        AUXIL=100.*ABS( SNGL(PJT(3,2*NS-1)-PJT(3,2*NS))-ABS(PSG(5,NS)) )
+        IF ( AUXIL .GT. 1.  .AND.  AUXIL .GT. ABS(PSG(5,NS)) ) THEN
+          CALL UTMSG('JAMFRA')
+          WRITE(IFCH,*)'*****  PZ1-PZ2-SQRT(S) NONZERO'
+          WRITE(IFCH,*)'VALUE:   '
+     *                 ,SNGL(PJT(3,2*NS-1)-PJT(3,2*NS))-SQRT(S)
+          WRITE(IFCH,*)'SQRT(S): ',SQRT(S)
+          WRITE(IFCH,*)(SNGL(PJT(I,2*NS-1)),I=1,4)
+          WRITE(IFCH,*)(SNGL(PJT(I,2*NS)),I=1,4)
+          CALL UTMSGF
+        ENDIF
+        IF ( ISH .GE. 92 ) THEN
+          WRITE(IFCH,103)NS,NSO
+     *      ,(ICJT(J,2*NS-1 ),J=1,2),(SNGL(PJT(J,2*NS-1 )),J=1,5)
+103       FORMAT(2X,I3,I3,3X,2I7,5(E10.2))
+          WRITE(IFCH,104)
+     *       (ICJT(J,2*NS   ),J=1,2),(SNGL(PJT(J,2*NS   )),J=1,5)
+104       FORMAT(2X,9X,2I7,5(E10.2)/)
+        ENDIF
+      ENDIF
+
+      IF     ( IOPBRK .EQ. 1 ) THEN
+        CALL JAMBR1(NS,NSG,IRET)
+      ELSEIF ( IOPBRK .EQ. 2 ) THEN
+        CALL JAMBR2(NS,NSG,IRET)
+      ENDIF
+      IF ( IRET .EQ. 9996 ) GOTO 9996
+      GOTO 9999
+
+C  WRITE ON /CPTL/ (2)
+C  -------------------
+9997  CONTINUE
+      IF ( NPTL .LE. NPTL2 ) THEN
+        CALL UTSTOP('JAMFRA: NPTL<=NPTL2                     ')
+      ENDIF
+      IF ( ISH .GE. 91 ) WRITE(IFCH,*)' '
+      DO 67 I=NPTL2+1,NPTL
+        ISTPTL(I)=ISPTL(I-NPTL2)
+        IO=IORPTL(I)
+        IF ( IO .GT. 0 ) THEN
+          IF ( IFRPTL(1,IO) .EQ. 0 ) IFRPTL(1,IO)=I
+          IFRPTL(2,IO)=I
+        ELSE
+          IORPTL(I)=0
+        ENDIF
+        ZOR=XORSG(3,1)
+        TOR=XORSG(4,1)
+        R=RANGEN()
+        TAURAN=-TAUREA*LOG(R)
+        CALL UTTAIX(I,TAURAN,ZOR,TOR,ZIS,TIS)
+        TIVPTL(1,I)=MAX(TIS,XORPTL(4,I))
+        IF     ( ISTPTL(I) .NE. 0 ) THEN
+          TAUBR=SQRT
+     *          ((XBKPTL(2,I-NPTL2)-TOR)**2-(XBKPTL(1,I-NPTL2)-ZOR)**2)
+          CALL UTTAIX(I,TAUBR,ZOR,TOR,ZIS,TIS)
+          TIVPTL(2,I)=TIS
+        ELSEIF ( IO .GT. 0 ) THEN
+          TAUBR=SQRT
+     *         ((XBKPTL(2,IO-NPTL2)-TOR)**2-(XBKPTL(1,IO-NPTL2)-ZOR)**2)
+          CALL UTTAIX(I,TAUBR,XORSG(3,1),XORSG(4,1),ZISBR,TISBR)
+          CALL IDTAU(IDPTL(I),PPTL(4,I),PPTL(5,I),TAUGM)
+          TIVPTL(2,I)=TISBR+TAUGM
+        ELSE
+          CALL IDTAU(IDPTL(I),PPTL(4,I),PPTL(5,I),TAUGM)
+          TIVPTL(2,I)=XORPTL(4,I)+TAUGM
+        ENDIF
+        IF ( ISH .GE. 92 ) WRITE(IFCH,120)I,IORPTL(I),IDPTL(I)
+     *               ,(SNGL(XBKPTL(J,I-NPTL2)),J=1,2)
+     *               ,(XORPTL(J,I),J=3,4),(TIVPTL(J,I),J=1,2)
+120     FORMAT(1X,'/CPTL/',I6,I7,I10
+     *         ,E10.2,E10.2,E10.2,E10.2,E10.2,E10.2)
+67    CONTINUE
+
+1000  RETURN
+
+1001  NEWEVT=1
+      GOTO 1000
+
+      END
+C=======================================================================
+
+      SUBROUTINE JCENTD
+
+C----------------------------------------------------------------------
+      PARAMETER (KPARX=15)
+      PARAMETER (NQUAX=12)
+      COMMON /CENTRO/  ENTRO(1+KPARX,1+NQUAX)
+      REAL ENTROX(1+KPARX,1+NQUAX)
+
+      DATA (ENTROX( 1,1+N),N=0,12)/
+     *.00000E+00,.00000E+00,.00000E+00,.00000E+00,.00000E+00,.00000E+00,
+     *.00000E+00,.00000E+00,.00000E+00,.00000E+00,.00000E+00,.00000E+00,
+     *.00000E+00/
+      DATA (ENTROX( 4,1+N),N=0,12)/
+     *.40254E+01,.59349E+01,.74855E+01,.87464E+01,.98267E+01,.10770E+02,
+     *.11611E+02,.12368E+02,.13058E+02,.13691E+02,.14277E+02,.14822E+02,
+     *.15332E+02/
+      DATA (ENTROX( 7,1+N),N=0,12)/
+     *.61944E+01,.89306E+01,.11114E+02,.12969E+02,.14595E+02,.16054E+02,
+     *.17380E+02,.18599E+02,.19728E+02,.20780E+02,.21767E+02,.22696E+02,
+     *.23574E+02/
+      DATA (ENTROX(10,1+N),N=0,12)/
+     *.68876E+01,.10183E+02,.12855E+02,.15159E+02,.17201E+02,.19046E+02,
+     *.20734E+02,.22296E+02,.23751E+02,.25115E+02,.26400E+02,.27616E+02,
+     *.28771E+02/
+      DATA (ENTROX(13,1+N),N=0,12)/
+     *.61944E+01,.99602E+01,.13068E+02,.15784E+02,.18208E+02,.20406E+02,
+     *.22425E+02,.24295E+02,.26041E+02,.27681E+02,.29228E+02,.30696E+02,
+     *.32092E+02/
+      DATA (ENTROX(16,1+N),N=0,12)/
+     *.40254E+01,.82375E+01,.11781E+02,.14923E+02,.17745E+02,.20311E+02,
+     *.22669E+02,.24853E+02,.26890E+02,.28803E+02,.30609E+02,.32320E+02,
+     *.33948E+02/
+C----------------------------------------------------------------------
+      KPH=KPARX
+      NQH=NQUAX
+      DO 2 N=1,1+NQUAX
+        DO 1 K=1,1+KPARX
+          ENTRO(K,N)=ENTROX(K,N)
+1       CONTINUE
+2     CONTINUE
+
+      IF ( KPH .NE. 15 ) THEN
+        CALL UTSTOP('ICENTD: INSUFFICIENT INITIALIZATION;   K')
+      ENDIF
+      IF ( NQH .NE. 12 ) THEN
+        CALL UTSTOP('ICENTD: INSUFFICIENT INITIALIZATION;   N')
+      ENDIF
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JCENTP
+
+C----------------------------------------------------------------------
+C  PLOTS ENTRO(,) AND FTN SJCENT
+C----------------------------------------------------------------------
+      PARAMETER (KPARX=15)
+      PARAMETER (NQUAX=12)
+      COMMON /CENTRO/  ENTRO(1+KPARX,1+NQUAX)
+      COMMON /CJCENT/  IGX,NSYMX
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      REAL      XPLOT(101),YPLOT(101)
+      INTEGER   IPLOT(5)
+      CHARACTER TEXT*50
+      DATA      IPLOT/0,0,0,1,1/
+C----------------------------------------------------------------------
+      ISH0=ISH
+      IF ( ISHSUB/100 .EQ. 13 ) ISH=MOD(ISHSUB,100)
+      IF ( ISH .LT. 95 ) GOTO 1000
+
+      IF ( IPLOT(1) .EQ. 1 ) THEN
+        TEXT='TITLE IG=     NSYM=     K= 3,6,9,12,15$       '
+        WRITE(TEXT(10:11),122)IGX
+        WRITE(TEXT(20:21),122)NSYMX
+122     FORMAT(I2)
+        DO 54 KX=1,5
+          K=3*KX
+          DO 55 N=1,13
+            XPLOT(N)=N-1
+            YPLOT(N)=ENTRO(1+K,N)
+55        CONTINUE
+          CALL UTHIST(0.,12.,0.,40.,1+12,XPLOT,YPLOT,'LIN','LINLIN'
+     *      ,'XAXIS ENERGY / OMEGA            $                 '
+     *      ,'YAXIS ENTROPY                   $                 ',TEXT)
+54      CONTINUE
+      ENDIF
+
+      IF ( IPLOT(2) .EQ. 1 ) THEN
+        TEXT='TITLE IG=     NSYM=     K= 3,6,9,12,15$       '
+        WRITE(TEXT(10:11),122)IGX
+        WRITE(TEXT(20:21),122)NSYMX
+        DO 64 KX=1,5
+          K=3*KX
+          DO 65 N=1,13
+            XPLOT(N)=(N-1.)/FLOAT(K)
+            YPLOT(N)=ENTRO(1+K,N)/K
+65        CONTINUE
+          CALL UTHIST(0.,5.,0.,6.,1+12,XPLOT,YPLOT,'LIN','LINLIN'
+     *      ,'XAXIS ENERGY / OMEGA / PARTICLE $                 '
+     *      ,'YAXIS ENTROPY / PARTICLE        $                 ',TEXT)
+64      CONTINUE
+      ENDIF
+
+      IF ( IPLOT(3) .EQ. 1 ) THEN
+        DO 62 KX=1,10
+          K=3*KX
+          DO 63 N=0,100
+            X=N*0.05
+            XPLOT(1+N)=X
+            YPLOT(1+N)=SJCENT(K,K,K*X)/K
+63        CONTINUE
+          CALL UTHIST(0.,5.,0.,6.,101,XPLOT,YPLOT,'LIN','LINLIN'
+     *        ,'XAXIS ENERGY / OMEGA / PARTICLE $                 '
+     *        ,'YAXIS ENTROPY / PARTICLE        $                 '
+     *        ,'TITLE INTER(EXTRA)POLATED       $                 ')
+62      CONTINUE
+      ENDIF
+
+      IF ( IPLOT(4) .EQ. 1 ) THEN
+        DO 58 KX=1,10
+          K=3*KX
+          DO 59 N=0,100
+            X=N*0.5
+            XPLOT(1+N)=X
+            YPLOT(1+N)=SJCENT(K,K,X)
+59        CONTINUE
+          CALL UTHIST(0.,50.,0.,80.,101,XPLOT,YPLOT,'LIN','LINLIN'
+     *      ,'XAXIS ENERGY / OMEGA            $                 '
+     *      ,'YAXIS ENTROPY                   $                 '
+     *      ,'TITLE INTER(EXTRA)POLATED  KU=K $                 ')
+58      CONTINUE
+      ENDIF
+
+      IF ( IPLOT(5) .EQ. 1 ) THEN
+        DO 48 KX=1,10
+          K=3*KX
+          DO 49 N=0,100
+            X=N*0.5
+            XPLOT(1+N)=X
+            YPLOT(1+N)=SJCENT(K,0,X)
+49        CONTINUE
+          CALL UTHIST(0.,50.,0.,80.,101,XPLOT,YPLOT,'LIN','LINLIN'
+     *      ,'XAXIS ENERGY / OMEGA            $                 '
+     *      ,'YAXIS ENTROPY                   $                 '
+     *      ,'TITLE INTER(EXTRA)POLATED  KU=0 $                 ')
+48      CONTINUE
+      ENDIF
+
+1000  CONTINUE
+      ISH=ISH0
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JCENTR(NSYM,IG,IDI,INIT)
+
+C----------------------------------------------------------------------
+C  FILLS ARRAY DEGEN(1+K,1+N) CONTAINING
+C    THE NUMBER OF MIXED SYMMETRIC (BOX OF WIDTH NSYM)
+C    K-PARTICLE STATES WITH ENERGY N (UNITS OF OMEGA), BASED ON
+C    OSCILLATOR (DIM: IDI) WAVEFUNCTIONS (ADDIT. DEGENERACY: IG) .
+C  FILLS ARRAY ENTRO(1+K,1+N) = LOG( DEGEN(1+K,1+N) )  .
+C  ENTRO(,) WRITTEN IN FORM OF DATA FOR JCENTD IF ISH=95
+C    (ISHSUB=12.. SELECTS THIS).
+C  INIT MUST BE SET 1 FOR THE FIRST CALL OF JCENTR
+C    (INIT=1 CALLS UTTUCL, UTPART, UTOVEL)
+C----------------------------------------------------------------------
+      PARAMETER (IOVMAX=100)
+      PARAMETER (ITAMAX=1000)
+      PARAMETER (JOVMAX=100)
+      PARAMETER (KPARX=15)
+      PARAMETER (KTUMAX=100)
+      PARAMETER (NQUAX=12)
+      PARAMETER (JPAMAX=NQUAX*NQUAX*NQUAX)
+      PARAMETER (KKPMAX=NQUAX*NQUAX*2)
+      PARAMETER (NSYMAX=20)
+      PARAMETER (NTUMAX=100)
+      PARAMETER (NYMAX=1000)
+      COMMON /CDEGEN/  DEGEN(1+KPARX,1+NQUAX)
+      COMMON /CENTRO/  ENTRO(1+KPARX,1+NQUAX)
+      COMMON /CJCENT/  IGX,NSYMX
+      COMMON /COVEL/   OVEL(1+IOVMAX,1+JOVMAX)
+      COMMON /CPARTA/  PARTA(NQUAX),IPART(NQUAX,JPAMAX)
+      DOUBLE PRECISION TUCL
+      COMMON /CTUCL/   TUCL(1+KTUMAX,1+NTUMAX)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      REAL      YOFA(ITAMAX)
+      INTEGER   IYO(NYMAX,KPARX),IYOL(ITAMAX),IYOM(ITAMAX),IYOO(ITAMAX)
+     *         ,IYOR(NSYMAX),IYOX(KPARX),IYOZ(ITAMAX,NSYMAX,2)
+     *         ,JYO(NYMAX),KKK(KPARX)
+      CHARACTER CIGA*7
+      CHARACTER*1 CYOX(1+NQUAX,KPARX),DELI(1+KPARX,1+NQUAX)
+C----------------------------------------------------------------------
+      IF ( INIT .EQ. 1 ) THEN
+        CALL UTTUCL
+        CALL UTPART
+        CALL UTOVEL
+      ENDIF
+
+      WRITE(IFMT,*)'EXECUTE SR JCENTR ...'
+      IF ( NSYM .GE. NSYMAX ) THEN
+        CALL UTSTOP('JCENTR: DIMENSION NSYMAX TOO SMALL      ')
+      ENDIF
+      IF ( MOD(KPARX,NSYM) .NE. 0 ) THEN
+        CALL UTSTOP('JCENTR: KPARX SHOULD BE MULTIPLE OF NSYM')
+      ENDIF
+      MMAX=1+(KPARX-1)/NSYM
+      IZERO=0
+      NSYMX=NSYM
+      IGX=IG
+
+C  LOOP OVER ENERGY
+C  ----------------
+      DO 6000 N=0,NQUAX
+        WRITE(IFMT,*)'SR JCENTR: N=',N
+        IF ( N .EQ. 0 ) THEN
+          KKP=1
+        ELSE
+          KKP=-IPART(N,1)
+          IF ( KKP .GT. KKPMAX ) THEN
+            CALL UTSTOP('JCENTR: DIMENSION KKPMAX TOO SMALL      ')
+          ENDIF
+          IF ( -IPART(N,1) .NE. NINT(PARTA(N)) ) THEN
+            CALL UTSTOP('JCENTR: # OF PARTITIONS DISAGREE        ')
+          ENDIF
+        ENDIF
+        IF ( ISH .GE. 93 ) THEN
+          WRITE(IFCH,103)('-',IC=1,79),N,KKP,('-',IC=1,79)
+103       FORMAT(/1X,79A1/7X,'N = ',I2,
+     *                       '   --->   ',I4,' PARTITION(S)'/1X,79A1/)
+          JJ=2
+          DO 8 KK=1,KKP
+            IF     ( N .EQ. 0 ) THEN
+              WRITE(IFCH,102)KK,IZERO
+            ELSEIF ( N .GT. 0 ) THEN
+              LL=-IPART(N,JJ)
+              WRITE(IFCH,102)KK,(IPART(N,I),I=JJ+1,JJ+MIN(20,LL))
+102           FORMAT(2X,I2,'. PARTITION:',3X,20I3)
+            ENDIF
+            JJ=JJ+LL+1
+ 8        CONTINUE
+        ENDIF
+
+C  ZERO PARTICLES
+C  --------------
+        DEGEN(1,1+N)=1.
+        ENTRO(1,1+N)=0.
+        IF ( N .EQ. NQUAX ) THEN
+          DELI(1,1+N)='/'
+        ELSE
+          DELI(1,1+N)=','
+        ENDIF
+
+C  LOOP OVER PARTICLE NUMBER
+C  -------------------------
+        DO 6001 KX=1,KPARX/3
+          K=3*KX
+          IF ( K .GT. KPARX ) THEN
+            CALL UTSTOP('JCENTR: DIMENSION KPARX TOO SMALL       ')
+          ENDIF
+          DEGEN(1+K,1+N)=0.
+          IF ( N .EQ. NQUAX ) THEN
+            DELI(1+K,1+N)='/'
+          ELSE
+            DELI(1+K,1+N)=','
+          ENDIF
+          KKK(K)=KKP
+          MMAXK=1+(K-1)/NSYM
+          IF ( K .LT. KPARX ) THEN
+            DO 5 L=K+1,KPARX
+              DO 5 NY=1,NYMAX
+                IYO(NY,L)=-1
+ 5          CONTINUE
+          ENDIF
+          IF ( ISH.GE.93 ) WRITE(IFCH,100)('-',IC=1,11),K,('-',IC=1,11)
+100       FORMAT(/1X,11A1/3X,'K = ',I2/1X,11A1/)
+
+C  LOOP OVER PARTITIONS
+C  --------------------
+          JJ=2
+          DO 6002 KK=1,KKP
+            IF     ( N .GT. 0 ) THEN
+              LL=-IPART(N,JJ)
+            ELSEIF ( N .EQ. 0 ) THEN
+              LL=1
+            ENDIF
+            IF ( LL .GT. K ) THEN
+              KKK(K)=KK-1
+              GOTO 6003
+            ENDIF
+            IF ( ISH .GE. 93 ) THEN
+              IF     ( N .EQ. 0 ) THEN
+                WRITE(IFCH,102)KK,IZERO
+              ELSEIF ( N .GT. 0 ) THEN
+                WRITE(IFCH,102)KK,(IPART(N,I),I=JJ+1,JJ+MIN(20,LL))
+              ENDIF
+              WRITE(IFCH,*)' '
+            ENDIF
+
+C  CONSTRUCT YOUNG TABLEAUS
+C  ------------------------
+            NY1=1
+            NY2=1
+            JYO(NY1)=1
+            DO 46 L=1,K
+              IYO(NY1,L)=0
+46          CONTINUE
+            IF ( N .GT. 0 ) THEN
+              IYO(NY1,K)=IPART(N,JJ+1)
+              NY1=NY1-1
+45            NY1=NY1+1
+              IF ( JYO(NY1) .EQ. LL ) GOTO 51
+              DO 43 LX=1,NSYM
+                L=NSYM+1-LX
+                DO 44 MX=1,MMAXK
+                  M=MMAXK+1-MX
+                  IF ( IYO(NY1,(M-1)*NSYM+L) .EQ. 0 ) THEN
+                    IF ( L.EQ.NSYM .OR. (L.NE.NSYM.AND.
+     *                           IYO(NY1,(M-1)*NSYM+L+1).NE.0) ) THEN
+                      NY2=NY2+1
+                      IF ( NY2 .GT. NYMAX ) THEN
+                        CALL UTSTOP
+     *                    ('JCENTR: DIMENSION NYMAX TOO SMALL       ')
+                      ENDIF
+                      JY=JYO(NY1)+1
+                      JYO(NY2)=JY
+                      DO 50 LP=1,K
+                        IYO(NY2,LP)=IYO(NY1,LP)
+50                    CONTINUE
+                      IYO(NY2,(M-1)*NSYM+L)=IPART(N,JJ+JY)
+                      IF ( NY2 .GT. 1 ) THEN
+                        DO 47 NY3=1,NY2-1
+                          IF ( JYO(NY3) .NE. JYO(NY2) ) GOTO 47
+                          DO 48 LP=1,K
+                            IF ( IYO(NY3,LP) .NE. IYO(NY2,LP) ) GOTO 47
+48                        CONTINUE
+                          NY2=NY2-1
+                          GOTO 49
+47                      CONTINUE
+49                      CONTINUE
+                      ENDIF
+                    ENDIF
+                    GOTO 43
+                  ENDIF
+44              CONTINUE
+43            CONTINUE
+              GOTO 45
+51            CONTINUE
+            ENDIF
+
+C  LOOP OVER YOUNG TABLEAUS
+C  ------------------------
+            DO 6005 NY=NY1,NY2
+
+              IF ( ISH .GE. 93  .AND.  NSYM .EQ. 3 ) THEN
+                WRITE(IFCH,117)NY-NY1+1,((IYO(NY,(M-1)*NSYM+I),
+     *                                               I=1,NSYM),M=1,1)
+117             FORMAT(2X,I2,'. TABLEAU:',5X,3I2)
+                IF ( MMAXK .GT. 1 ) WRITE(IFCH,110)
+     *               ((IYO(NY,(M-1)*NSYM+I),I=1,NSYM),M=2,MMAXK)
+110             FORMAT(19X,3I2)
+                WRITE(IFCH,*)' '
+              ENDIF
+
+C  SELECT NN-SUBTABLEAUS
+C  ---------------------
+              DITAB=1
+              DO 6004 NN=0,N
+                IGA=IG*NINT(EXP(TUCL(1+IDI,1+NN)))
+
+                DO 15 L=1,KPARX
+                  IYOX(L)=-1
+15              CONTINUE
+                DO 11 M=1,MMAXK
+                  MEMP=M-1
+                  MS=(M-1)*NSYM
+                  DO 11 I=1,NSYM
+                    IF ( IYO(NY,MS+I) .EQ. NN ) GOTO 12
+11              CONTINUE
+12              CONTINUE
+                MMAXKS=MMAXK-MEMP
+                DO 13 L=MS+1,K
+                  IF ( IYO(NY,L) .EQ. NN ) IYOX(L-MS)=IYO(NY,L)
+13              CONTINUE
+                IF ( NSYM .GT. 1 ) THEN
+                  DO 17 I=1,NSYM-1
+                    DO 16 M=1,MMAXK
+                      MS=(M-1)*NSYM
+                      IF ( IYOX(MS+1) .NE. -1 ) GOTO 18
+16                  CONTINUE
+                    DO 19 M=1,MMAXK
+                      MS=(M-1)*NSYM
+                      DO 20 L=1,NSYM-1
+                        IYOX(MS+L)=IYOX(MS+L+1)
+20                    CONTINUE
+                      IYOX(MS+NSYM)=-1
+19                  CONTINUE
+17                CONTINUE
+18                CONTINUE
+                ENDIF
+                DO 38 L=1,KPARX
+                  CYOX(1+NN,L)=' '
+                  IF ( IYOX(L) .GE. 0 ) CYOX(1+NN,L)='X'
+38              CONTINUE
+
+C  SKIP FOR EMPTY TABLEAUS
+C  -----------------------
+                DO 21 L=1,K
+                  IF ( IYOX(L) .NE. -1 ) GOTO 22
+21              CONTINUE
+                GOTO 6004
+22              CONTINUE
+
+C  PRINT
+C  -----
+                IF ( ISH .GE. 93  .AND.  NSYM .EQ .3 ) THEN
+                  IF ( IGA.GE.  1.AND.IGA.LT.  10 ) WRITE(CIGA,107)IGA
+107               FORMAT('GL(',I1,')  ')
+                  IF ( IGA.GT. 10.AND.IGA.LT. 100 ) WRITE(CIGA,108)IGA
+108               FORMAT('GL(',I2,') ')
+                  IF ( IGA.GT.100.AND.IGA.LT.1000 ) WRITE(CIGA,109)IGA
+109               FORMAT('GL(',I3,')')
+                  WRITE(IFCH,116)NN,((CYOX(1+NN,(M-1)*NSYM+I)
+     *                                        ,I=1,NSYM),M=1,1),CIGA
+116               FORMAT(2X,I2,'-SUBTABLEAU:',3X,3(1X,A1),3X,A7)
+                  IF ( MMAXKS .GT. 1 ) THEN
+                    DO 39 M=2,MMAXKS
+                      WRITE(IFCH,106)(CYOX(1+NN,(M-1)*NSYM+I),I=1,NSYM)
+106                   FORMAT(19X,3(1X,A1))
+39                  CONTINUE
+                  ENDIF
+                  IF ( ISH .GE. 94 ) WRITE(IFCH,*)' '
+                ENDIF
+
+C  REDUCTIONS OF TABLEAUS 1+IYOX()
+C  -------------------------------
+                DISUTA=0.
+                N1=1
+                N3=1
+                N300=1
+                DO 24 I=1,NSYM
+                  MA=0
+                  ME=0
+                  DO 25 M=1,MMAXK
+                    IF ( 1+IYOX((M-1)*NSYM+I) .LE. 0 ) GOTO 25
+                    IF ( MA .EQ. 0 ) MA=M
+                    ME=M
+25                CONTINUE
+                  IYOZ(N1,I,1)=MA
+                  IYOZ(N1,I,2)=ME
+24              CONTINUE
+                IYOL(N1)=0
+                YOFA(N1)=1.
+                IYOO(N1)=0
+                IYOM(N1)=1
+                N1=N1-1
+5000            N1=N1+1
+                N30=N3
+                IF ( N1.GT.1 .AND. IYOL(N1).GT.IYOL(N1-1) ) N300=N3
+                N2=N1
+                DO 26 I=1,NSYM
+                  IYOR(I)=MAX(0,IYOZ(N1,I,2)-1)
+26              CONTINUE
+                LEV=IYOL(N1)
+                FAC=YOFA(N1)
+                IF ( IGA-1.LE.IOVMAX .AND. LEV.LE.JOVMAX
+     *                                    .AND. LEV.LE.IGA-1 ) THEN
+                  FACX=EXP(OVEL(IGA,1+LEV))
+                  IF ( ABS(FACX-FAC) .GT. 1.E-5*FAC ) THEN
+                    WRITE(IFCH,*)' '
+                    WRITE(IFCH,*)'N=',N,'    K=',K,'    KK=',KK
+     *                                                ,'    NY=',NY
+                    WRITE(IFCH,*)'FACX=',FACX,'     FAC=',FAC
+                    CALL UTSTOP
+     *                     ('JCENTR: BINOMIALS DIFFER                ')
+                  ENDIF
+                ENDIF
+                IF ( LEV .GT. IGA-1 ) GOTO 5003
+                IHEIM=0
+                DO 32 I=1,NSYM
+                  IHEI=IYOZ(N1,I,2)-IYOZ(N1,I,1)
+                  IF ( IHEI .GT. IHEIM ) IHEIM=IHEI
+32              CONTINUE
+                IF ( IHEIM .EQ. 0 ) DISUTA=DISUTA+FAC*IYOM(N1)
+                IF ( ISH.GE.94 .AND. NSYM.EQ.3 ) THEN
+                  WRITE(IFCH,112)N1,(IYOZ(N1,I,1),I=1,NSYM),IYOO(N1)
+     *                ,LEV,FAC,IYOM(N1),IHEIM,DISUTA
+     *                ,(IYOZ(N1,I,2),I=1,NSYM)
+112               FORMAT(3X,I3,2X,3I2,2X,'ORI:',I3,3X
+     *                ,'LEV:',I2,3X,'FAC:',F8.1
+     *                ,3X,'MUL:',I2,3X,'HEI:',I2,3X,'SUM:',F8.1/8X,3I2/)
+                ENDIF
+                N2=N2-1
+5001            N2=N2+1
+                DO 27 I=1,NSYM
+                  IF ( IYOZ(N2,I,2)-1 .LT. IYOR(I) ) GOTO 27
+                  IF ( I.LT.NSYM  .AND.
+     *                         IYOZ(N2,I,2)-1.LT.IYOZ(N2,I+1,2) ) GOTO27
+                  N3=N3+1
+                  IF ( N3 .GT. ITAMAX ) THEN
+                    CALL UTSTOP
+     *                      ('JCENTR: DIMENSION ITAMAX TOO SMALL      ')
+                  ENDIF
+                  IYOL(N3)=IYOL(N1)+1
+                  YOFA(N3)=( YOFA(N1)*(IGA-IYOL(N3)) )/IYOL(N3)
+                  IYOO(N3)=N1
+                  IYOM(N3)=IYOM(N1)
+                  DO 28 J=1,NSYM
+                    IYOZ(N3,J,1)=IYOZ(N2,J,1)
+                    IYOZ(N3,J,2)=IYOZ(N2,J,2)
+28                CONTINUE
+                  IYOZ(N3,I,2)=IYOZ(N3,I,2)-1
+                  IF ( IYOZ(N3,I,2) .LT. IYOZ(N3,I,1) ) THEN
+                    IYOZ(N3,I,1)=0
+                    IYOZ(N3,I,2)=0
+                  ENDIF
+                  IF ( N30+1 .LT. N3 ) THEN
+                    DO 30 NCH=N30+1,N3-1
+                      DO 31 IJ=1,NSYM
+                        IF ( IYOZ(NCH,IJ,1).NE.IYOZ(N3,IJ,1) .OR.
+     *                      IYOZ(NCH,IJ,2).NE.IYOZ(N3,IJ,2) ) GOTO 30
+31                    CONTINUE
+                      N3=N3-1
+                      GOTO 27
+30                  CONTINUE
+                  ENDIF
+                  IF ( ISH .GE. 95  .AND.  NSYM .EQ. 3 ) THEN
+                    WRITE(IFCH,113)N1,(IYOZ(N1,IJ,1),IJ=1,NSYM),N2
+     *           ,(IYOZ(N2,IJ,1),IJ=1,NSYM),N3,(IYOZ(N3,IJ,1),IJ=1,NSYM)
+     *           ,(IYOZ(N1,IJ,2),IJ=1,NSYM)
+     *           ,(IYOZ(N2,IJ,2),IJ=1,NSYM),(IYOZ(N3,IJ,2),IJ=1,NSYM)
+113                 FORMAT(3X,'N1: ',I2,3X,3I2,4X,'N2: ',I2,3X,3I2,4X
+     *                 ,'N3: ',I2,3X,3I2/12X,3I2,13X,3I2,13X,3I2/)
+                  ENDIF
+27              CONTINUE
+                IF ( N2 .EQ. N1 ) N2=N30
+                IF ( N2 .LT. N3 ) GOTO 5001
+                IF ( N30 .LT. N3  .AND.  N300 .LT. N30 ) THEN
+                  N3S=N3
+                  N3M=N3
+                  N3=N30
+                  DO 33 NCH3=N30+1,N3S
+                    N3=N3+1
+                    DO 34 NCH=N300+1,N30
+                      DO 35 IJ=1,NSYM
+                        IF ( IYOZ(NCH,IJ,1).NE.IYOZ(N3,IJ,1) .OR.
+     *                       IYOZ(NCH,IJ,2).NE.IYOZ(N3,IJ,2) ) GOTO 34
+35                    CONTINUE
+                      IYOM(NCH)=IYOM(NCH)+IYOM(N3)
+                      N3=N3-1
+                      N3M=N3M-1
+                      IF ( N3+1 .LE. N3M ) THEN
+                        DO 36 NM=N3+1,N3M
+                          IYOL(NM)=IYOL(NM+1)
+                          YOFA(NM)=YOFA(NM+1)
+                          IYOO(NM)=IYOO(NM+1)
+                          IYOM(NM)=IYOM(NM+1)
+                          DO 37 J=1,NSYM
+                            IYOZ(NM,J,1)=IYOZ(NM+1,J,1)
+                            IYOZ(NM,J,2)=IYOZ(NM+1,J,2)
+37                        CONTINUE
+36                      CONTINUE
+                      ENDIF
+                      GOTO 33
+34                  CONTINUE
+33                CONTINUE
+                ENDIF
+                IF ( N1 .LT. N3 ) GOTO 5000
+5003            CONTINUE
+
+                DIALT=-99999.
+                IF ( IYOZ(1,1,1) .EQ. 1 ) THEN
+                  DIALT=1.
+                  DO 40 I=1,NSYM
+                    IF     ( IYOZ(1,I,1) .GT. 1 ) THEN
+                      CALL UTSTOP
+     *                     ('JCENTR: IYOZ(,,1).GT.1                  ')
+                    ELSEIF ( IYOZ(1,I,1) .EQ. 0 ) THEN
+                      GOTO 40
+                    ENDIF
+                    DO 41 M=1,IYOZ(1,I,2)
+                      HAK=IYOZ(1,I,2)-M+1
+                      IF ( I .LT. NSYM ) THEN
+                        DO 42 J=I+1,NSYM
+                          IF ( IYOZ(1,J,2) .GE. M ) HAK=HAK+1
+42                      CONTINUE
+                      ENDIF
+                      DIALT=DIALT*(IGA+I-M)/HAK
+41                  CONTINUE
+40                CONTINUE
+                ENDIF
+
+                IF ( DIALT.NE.-99999.  .AND.
+     *                   ABS(DIALT-DISUTA).GT.1.E-5*DIALT ) THEN
+                  WRITE(IFCH,*)' '
+                  WRITE(IFCH,*)'N=',N,'    K=',K,'    KK=',KK
+     *                                                   ,'    NY=',NY
+                  WRITE(IFCH,*)'DISUTA=',DISUTA,'     DIALT=',DIALT
+                  CALL UTSTOP
+     *                   ('JCENTR: DIMENSIONS DIFFER               ')
+                ENDIF
+
+                IF ( ISH .GE. 93 ) WRITE(IFCH,118)DISUTA
+118             FORMAT(28X,'SUBTAB.-DIMENSION:',F8.1/)
+
+                DITAB=DITAB*DISUTA
+
+6004          CONTINUE
+
+              IF ( ISH .GE. 93 ) WRITE(IFCH,119)DITAB
+119           FORMAT(35X,'TABLEAU-DIMENSION:',F11.1/)
+
+              DEGEN(1+K,1+N)=DEGEN(1+K,1+N)+DITAB
+
+6005        CONTINUE
+
+            JJ=JJ+LL+1
+6002      CONTINUE
+6003      CONTINUE
+          IF ( KKK(K) .EQ. 0 ) THEN
+            CALL UTSTOP('JCENTR: NO ALLOWED PARTITION            ')
+          ENDIF
+          ENTRO(1+K,1+N)=-9999999.
+          IF ( DEGEN(1+K,1+N) .GT. 0. )
+     *                         ENTRO(1+K,1+N)=LOG(DEGEN(1+K,1+N))
+          IF ( ISH .GE. 93 ) WRITE(IFCH,120)DEGEN(1+K,1+N)
+120       FORMAT(49X,'DEGENERACY:',F11.1/)
+
+6001    CONTINUE
+6000  CONTINUE
+
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,121)('-',IC=1,79)
+121     FORMAT(1X,79A1)
+        WRITE(IFCH,*)'   DEGENERACY(K,N)         IG=',IG,'          '
+     *                ,'NSYM=',NSYM
+        WRITE(IFCH,121)('-',IC=1,79)
+        WRITE(IFCH,*)'   K:','   3','   6','   9','   12'
+        WRITE(IFCH,121)('-',IC=1,79)
+        DO 52 N=0,NQUAX
+          WRITE(IFCH,*)N,(DEGEN(1+3*K,1+N),K=1,4)
+52      CONTINUE
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,121)('-',IC=1,79)
+        WRITE(IFCH,*)'   ENTROPY(K,N)            IG=',IG,'          '
+     *                ,'NSYM=',NSYM
+        WRITE(IFCH,121)('-',IC=1,79)
+        WRITE(IFCH,*)'   K:','   3','   6','   9','   12'
+        WRITE(IFCH,121)('-',IC=1,79)
+        DO 53 N=0,NQUAX
+          WRITE(IFCH,*)N,(ENTRO(1+3*K,1+N),K=1,4)
+53      CONTINUE
+      ENDIF
+
+      ISH0=ISH
+      IF ( ISHSUB/100 .EQ. 12 ) ISH=MOD(ISHSUB,100)
+      IF ( ISH .GE. 95 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,121)('-',IC=1,79)
+        WRITE(IFCH,*)'   ENTROPY(K,N)            IG=',IG
+     *                ,'          NSYM=',NSYM
+        WRITE(IFCH,121)('-',IC=1,79)
+        WRITE(IFCH,125)KPARX
+125     FORMAT(6X,'IF(KPARX.NE.',I2,')'/5X,
+     *      56H*CALL UTSTOP('JCENTD: INSUFFICIENT INITIALIZATION;   K'))
+        WRITE(IFCH,126)NQUAX
+126     FORMAT(6X,'IF(NQUAX.NE.',I2,')'/5X,
+     *      56H*CALL UTSTOP('JCENTD: INSUFFICIENT INITIALIZATION;   N'))
+        DO 58 KX=0,KPARX/3
+          K=3*KX
+          WRITE(IFCH,123)K+1,NQUAX
+123       FORMAT(6X,'DATA (ENTRO(',I2,',1+N),N=0,',I2,')/')
+          WRITE(IFCH,124)(ENTRO(1+K,1+N),DELI(1+K,1+N), N=0,NQUAX)
+124       FORMAT(10(5X,'*',6(E10.5,A1)/))
+58      CONTINUE
+      ENDIF
+      ISH=ISH0
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JCLUDE(IP,IRET)
+
+C-----------------------------------------------------------------------
+C  DECAYS CLUSTER IP FROM /CPTL/ .
+C  REQIRES JCENTR OR JCENTD TO BE CALLED BEFORE.
+C-----------------------------------------------------------------------
+      PARAMETER (IOMAX=54)
+      PARAMETER (IOMAXM=25)
+      PARAMETER (MOXMAX=30)
+      PARAMETER (MOMAX=MOXMAX*IOMAX)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (NFLAV=6)
+      COMMON /CENTEX/  ENTEXP
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CSCAL/   SCAL
+      COMMON /CSJCGA/  AMEGAM,AMNULL,ASUHA(7),ENTRPY,NOPHA,NSUHA(7)
+      COMMON /CTIMEL/  NTC
+      COMMON /CUTINV/  LUTINV
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      DOUBLE PRECISION PA(5),PE(5),PPT(5)
+      REAL             OO(1+MOMAX),PA0(5),POL(IOMAX)
+     *                ,QO(1+MOMAX),U(3),XO(1+MOMAX),YO(1+MOMAX)
+      INTEGER          ICA(2),IDOL(IOMAX),IDOLIS(IOMAX),IFOLIS(IOMAX)
+     *                ,JCA(NFLAV,2),JCA0(NFLAV,2),JCE(NFLAV,2)
+     *                ,JCO(NFLAV,2),KO(1+MOMAX)
+      DATA IDOLIS/
+     *             110,  120,-120,  220, 130, -130, 230, -230, 330
+     *           ,1120,-1120,1220,-1220,1130,-1130,1230,-1230,2130,-2130
+     *           ,2230,-2230,1330,-1330,2330,-2330
+     *           ,1111,-1111,2221,-2221,3331,-3331
+     *            ,111,  121,-121,  221, 131, -131, 231, -231, 331
+     *           ,1121,-1121,1221,-1221,1131,-1131,1231,-1231
+     *           ,2231,-2231,1331,-1331,2331,-2331/
+      DATA IFOLIS/9*1,16*2,6*4,9*3,14*4/
+C-----------------------------------------------------------------------
+      ISH0=ISH
+      IF ( ISHSUB/100 .EQ. 1 ) ISH=MOD(ISHSUB,100)
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)('-',L=1,79)
+        WRITE(IFCH,*)'   CLUSTER DECAY OF',IP,IDPTL(IP),PPTL(5,IP)
+        WRITE(IFCH,*)('-',L=1,79)
+        WRITE(IFCH,*)' '
+      ENDIF
+      DELPOX=.01
+      NPTLB=NPTL
+      LOOP=0
+      IRET=0
+      IPOXRA=0
+      ISTPFL=0
+      EBAMIN=1.5
+      LOOPMX=20
+      NOPHAX=20
+
+C  ORIGINAL CLUSTER --> PA,JCA
+C  ---------------------------
+
+6010  CONTINUE
+      PA(1)=PPTL(1,IP)
+      PA(2)=PPTL(2,IP)
+      PA(3)=PPTL(3,IP)
+      PA(4)=PPTL(4,IP)
+      PA(5)=PPTL(5,IP)
+      CALL IDQUAC(IP,NDU,NDU,NDU,JCA)
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)'INITIAL JCA:'
+        WRITE(IFCH,*)JCA
+      ENDIF
+      CALL IDCOMJ(JCA)
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)'INITIAL JCA AFTER COMPACTIFICATION:'
+        WRITE(IFCH,*)JCA
+      ENDIF
+
+      PA0(1)=PA(1)
+      PA0(2)=PA(2)
+      PA0(3)=PA(3)
+      PA0(4)=PA(4)
+      PA0(5)=PA(5)
+      NQN=0
+      DO 2 NF=1,NFLAV
+        NQN=NQN+JCA(NF,1)-JCA(NF,2)
+        JCA0(NF,1)=JCA(NF,1)
+        JCA0(NF,2)=JCA(NF,2)
+ 2    CONTINUE
+      NBA=ABS(NQN)/3
+      IF ( NBA .GT. 0 ) THEN
+        EBA=PA(5)/NBA
+      ELSE
+        EBA=AINFIN
+      ENDIF
+      ISH00=ISH
+
+C  INITIALIZATION FOR REDO
+C  -----------------------
+
+6001  LOOP=LOOP+1
+      IF ( ISH00 .EQ. 90 ) THEN
+        IF ( LOOP .EQ. LOOPMX ) THEN
+          ISH=92
+          WRITE(IFCH,117)('-',L=1,75),LOOP,ISH
+117       FORMAT(//1X,75A1/1X,I2,'. ATTEMPT TO DECAY THIS CLUSTER!'
+     *          /1X,'ISH SET TO: ',I2)
+        ENDIF
+      ENDIF
+      IF ( LOOP .GT. LOOPMX ) THEN
+        ISH=ISH00
+        GOTO 1001
+      ENDIF
+      NOPHA=0
+      ISMALL=0
+      NPTL=NPTLB
+      PA(1)=PA0(1)
+      PA(2)=PA0(2)
+      PA(3)=PA0(3)
+      PA(4)=PA0(4)
+      PA(5)=PA0(5)
+      DO 3 NF=1,NFLAV
+        JCA(NF,1)=JCA0(NF,1)
+        JCA(NF,2)=JCA0(NF,2)
+ 3    CONTINUE
+
+C  LOOP OVER SEQUENTIAL DECAYS
+C  ---------------------------
+
+6002  NPTL=NPTL+1
+      IF ( NPTL .GT. MXPTL ) THEN
+        CALL UTSTOP('JCLUDE: NPTL>MXPTL                      ')
+      ENDIF
+      ISJCA=0
+      DO 210 NF=1,NFLAV
+        ISJCA=ISJCA+ABS(JCA(NF,1))+ABS(JCA(NF,2))
+210   CONTINUE
+      IF ( ISJCA .EQ. 0 ) THEN
+        JCA(1,1)=1
+        JCA(1,2)=1
+      ENDIF
+      CALL IDCOMJ(JCA)
+      CALL IDENCO(JCA,ICA,IRETEN)
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,100)(PA(K),K=1,5)
+100     FORMAT(1X,'PA:',20X,5(E10.3,1X))
+        WRITE(IFCH,116)JCA
+116     FORMAT(1X,'JCA: ',6I5/6X,6I5)
+      ENDIF
+
+      KAU=JCA(1,1)-JCA(1,2)
+      KAD=JCA(2,1)-JCA(2,2)
+      KAS=JCA(3,1)-JCA(3,2)
+      KAC=JCA(4,1)-JCA(4,2)
+      AMICL=UTAMNU(KAU,KAD,KAS,KAC,5)
+
+      IF ( NOPHA.EQ.NOPHAX .OR. NOPHA.GT.1.AND.PA(5).GT.2.*AMICL ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JCLUDE')
+          IF     ( ISMALL .EQ. 0 ) THEN
+            WRITE(IFCH,*)'*****  NO PHASE SPACE --> REDO DECAY'
+          ELSEIF ( ISMALL .EQ. 1 ) THEN
+            WRITE(IFCH,*)'*****  SMALL PHASE SP --> REDO DECAY'
+          ELSE
+            WRITE(IFCH,*)'***** SMALL/NO PHASE SPACE --> REDO DECAY'
+            WRITE(IFCH,*)'ISMALL=',ISMALL
+          ENDIF
+          WRITE(IFCH,*)'NT=',NTC,'   LOOP=',LOOP,'   NOPHA=',NOPHA
+          IF ( ISMALL .EQ. 1 )
+     *            WRITE(IFCH,*)'YO_HIT=',YOHIT,'   YO_MAX=',YOMAX
+          WRITE(IFCH,*)'M_MIN=',AMICL,'   M=',PA(5)
+          WRITE(IFCH,100)(PA(K),K=1,5)
+          WRITE(IFCH,116)JCA
+          CALL UTMSGF
+        ENDIF
+        GOTO 6001
+      ENDIF
+
+      IF ( NOPHA .GT. 1 ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JCLUDE')
+          IF     ( ISMALL .EQ. 0 ) THEN
+            WRITE(IFCH,*)'*****  NO PHASE SPACE --> INCRS MASS'
+          ELSEIF ( ISMALL .EQ. 1 ) THEN
+            WRITE(IFCH,*)'*****  SMALL PHASE SP --> INCRS MASS'
+          ELSE
+            WRITE(IFCH,*)'***** SMALL/NO PHASE SPACE --> INCRS MASS'
+            WRITE(IFCH,*)'ISMALL=',ISMALL
+          ENDIF
+          WRITE(IFCH,*)'NT=',NTC,'   LOOP=',LOOP,'   NOPHA=',NOPHA
+          IF ( ISMALL .EQ. 1 )
+     *             WRITE(IFCH,*)'YO_HIT=',YOHIT,'   YO_MAX=',YOMAX
+          WRITE(IFCH,*)'M_MIN=',AMICL,'   M=',PA(5)
+          WRITE(IFCH,100)(PA(K),K=1,5)
+          WRITE(IFCH,116)JCA
+        ENDIF
+        PA(5)=PA(5)*1.05
+        PA(4)=SQRT(PA(1)**2+PA(2)**2+PA(3)**2+PA(5)**2)
+        IF ( ISH .GE. 90 ) THEN
+          WRITE(IFCH,100)(PA(K),K=1,5)
+          CALL UTMSGF
+        ENDIF
+      ENDIF
+
+      IDAR=0
+      IF ( NOPHA .EQ. 0 ) THEN
+        ICH=0
+        IF ( IRETEN .EQ. 0 ) THEN
+          IDA=IDTRA(ICA,0,0,3)
+        ELSE
+          IDA=0
+        ENDIF
+        AMA=PA(5)
+        CALL IDRES(IDA,AMA,IDAR,IADJ)
+        IF ( IDAR .NE. 0  .AND.  EBA .LT. EBAMIN ) THEN
+          AMA=0.
+          CALL IDRES(IDA,AMA,IDAR,IADJ)
+          IF ( MOD(IDAR,10) .NE. 0  .AND. LOOP .LT. LOOPMX/2 ) GOTO 6001
+        ENDIF
+        IF ( IDAR .NE. IDPTL(IP) ) ICH=1
+      ENDIF
+
+      IF ( IDAR .NE. 0 ) THEN
+        IF ( NPTL .GT. NPTLB+1  .OR.  ICH .EQ. 1 ) THEN
+          IDPTL(NPTL)=IDAR
+          PA(5)=AMA
+          PA(4)=SQRT(AMA**2+PA(1)**2+PA(2)**2+PA(3)**2)
+          PPTL(1,NPTL)=PA(1)
+          PPTL(2,NPTL)=PA(2)
+          PPTL(3,NPTL)=PA(3)
+          PPTL(4,NPTL)=PA(4)
+          PPTL(5,NPTL)=PA(5)
+          IF ( ISH .GE. 92 )
+     *            WRITE(IFCH,101)NPTL,IDPTL(NPTL),(PPTL(K,NPTL),K=1,5)
+101       FORMAT(1X,'/CPTL/',I6,I11,2X,5(E10.3,1X))
+        ELSE
+          NPTL=NPTL-1
+        ENDIF
+        GOTO 7001
+      ENDIF
+
+      AMA=PA(5)
+
+C  LOOP OVER HADRONS
+C  -----------------
+
+      MO=1
+      PO=0.
+      XO(1)=0.
+      QO(1)=0.
+      YO(1)=0.
+      OO(1)=0.
+      KO(1)=0
+      IOM=0
+      QOL=0.
+      IF ( ISH .GE. 92 ) WRITE(IFCH,106)
+106   FORMAT(' PARTIAL DECAY WIDTHS:')
+
+      DO 6003 IO=1,IOMAX
+        IF ( EBA .LT. EBAMIN  .AND.  IO .GT. IOMAXM ) GOTO 6003
+
+        IDO=IDOLIS(IO)
+        IOM=IOM+1
+        POL(IOM)=PO
+        IDOL(IOM)=IDO
+        CALL IDMASS(IDO,AMO)
+        IDPTL(NPTL)=IDO
+        CALL IDQUAC(NPTL,NDU,NDU,NDU,JCO)
+        DO 22 NF=1,NFLAV
+          JCE(NF,1)=JCA(NF,1)-JCO(NF,1)
+          JCE(NF,2)=JCA(NF,2)-JCO(NF,2)
+          IF ( JCE(NF,1) .LT. 0 ) THEN
+            JCE(NF,2)=JCE(NF,2)-JCE(NF,1)
+            JCE(NF,1)=0
+          ENDIF
+          IF ( JCE(NF,2) .LT. 0 ) THEN
+            JCE(NF,1)=JCE(NF,1)-JCE(NF,2)
+            JCE(NF,2)=0
+          ENDIF
+22      CONTINUE
+        DO 13 I=5,NFLAV
+          IF ( JCE(I,1).NE.0 .OR. JCE(I,2).NE.0 .OR. ISTPFL.GT.0 ) THEN
+            IF ( ISTPFL .EQ. 2 ) THEN
+              CALL UTSTOP('JCLUDE: MORE THAN 4 FLAVOURS            ')
+            ENDIF
+            ISTPFL=ISTPFL+1
+            ISH=93
+            IF ( ISTPFL .EQ. 2 ) GOTO 6010
+            GOTO 6001
+          ENDIF
+13      CONTINUE
+        KEU=JCE(1,1)-JCE(1,2)
+        KED=JCE(2,1)-JCE(2,2)
+        KES=JCE(3,1)-JCE(3,2)
+        KEC=JCE(4,1)-JCE(4,2)
+
+C  LOOP OVER HADRON MOMENTA
+C  ------------------------
+
+        IF ( MO+MOXMAX .GT. 1+MOMAX ) THEN
+          CALL UTSTOP('JCLUDE: DIMENSION MOMAX TOO SMALL       ')
+        ENDIF
+        POX=0.
+        MOM=MO
+        POM=PO
+        QOM=QO(MO)
+        GAMXM=0.
+        POXM=0.
+        GAMY=0.
+        DELPO=DELPOX
+        YOINT=0.
+
+        DO 6004 MOX=1,MOXMAX
+
+          MO=MO+1
+          DELPO=DELPO*1.2
+          POX=POX+DELPO
+          PO=PO+DELPO
+          XO(MO)=PO
+          IF ( MOX .GT. 1 ) THEN
+            KO(MO)=0
+          ELSE
+            KO(MO)=IDO
+          ENDIF
+          GAMX=SJCGAM(KEU,KED,KES,KEC,AMA,AMO,POX,MOX)
+          YO(MO)=IFOLIS(IO)*DELPO*GAMX
+          OO(MO)=ENTEXP
+          YOINT=YOINT+IFOLIS(IO)*DELPO*(GAMX+GAMY)*0.5
+          IF ( GAMX .EQ. 0. ) THEN
+            I6005=1
+          ELSE
+            IF ( GAMX .LT. 1.E-2*GAMXM  .AND.  GAMXM .GT. 0.
+     *        .AND.  MOX .GT. 1 ) THEN
+              I6005=1
+            ELSE
+              I6005=0
+            ENDIF
+          ENDIF
+          IF ( ISH.GE.93 .AND. (I6005.EQ.0 .OR. MOX.GT.1) ) THEN
+            IF ( MOX .EQ. 1 )
+     *         WRITE(IFCH,109)KEU,KED,KES,NSUHA,AMA,ASUHA,AMNULL,IDO,AMO
+109         FORMAT(/' U_D_S:',3I3,'  N:',7I5,11X,'  A:',F10.2
+     *             /18X,'M:',7F5.2,'  M0:',F6.2,'  O:',I5,F5.2
+     *             /'   MO     XO   POX      EO AMA-EO     ENTRPY     '
+     *             ,'  GAMX         YO         OO ')
+            WRITE(IFCH,105)MO,XO(MO),POX,SQRT(POX**2+AMO**2)
+     *                    ,AMA-SQRT(POX**2+AMO**2),ENTRPY,GAMX
+     *                    ,YO(MO),OO(MO)
+105         FORMAT(1X,I5,1X,F6.2,F6.2,2X,F6.2,F6.2
+     *             ,E12.3,E11.3,E11.3,E11.3)
+          ENDIF
+          IF ( I6005 .EQ. 1 ) GOTO 6005
+          IF ( GAMX .GT. GAMXM ) THEN
+            GAMXM=GAMX
+            POXM=POX
+          ENDIF
+          GAMY=GAMX
+
+6004    CONTINUE
+
+        IF ( ISH .GE. 90  .AND.  IPOXRA .EQ. 0 ) THEN
+          IPOXRA=1
+          CALL UTMSG('JCLUDE')
+          WRITE(IFCH,*)'*****  POX-RANGE TOO SMALL'
+          WRITE(IFCH,100)(PA(K),K=1,5)
+          WRITE(IFCH,*)'JCA:'
+          WRITE(IFCH,*)JCA
+          WRITE(IFCH,*)'POX= ',POX, '   GAMX= ',GAMX
+          WRITE(IFCH,*)'POXM=',POXM,'   GAMXM=',GAMXM
+          CALL UTMSGF
+        ENDIF
+
+6005    CONTINUE
+
+        IF ( YOINT .EQ. 0. ) THEN
+          IF ( ISH .GE. 94 ) THEN
+            WRITE(IFCH,*)' '
+            WRITE(IFCH,*)'NO PHASE SPACE FOR',IDO
+          ENDIF
+          MO=MOM
+          PO=POM
+          IOM=IOM-1
+        ELSE
+          IF ( ISH .GE. 92 ) WRITE(IFCH,107)IDO,POXM,YOINT,OO(MO)
+107       FORMAT(' IDO,POXM,YOINT,OO:',I6,3X,F5.2,E12.3,E12.3)
+        ENDIF
+
+6003  CONTINUE
+      IF ( ISH .GE. 92 ) WRITE(IFCH,*)' '
+
+C  NO PHASE SPACE
+C  --------------
+      IF ( IOM .EQ. 0 ) THEN
+        IF ( ISH .GE. 92 ) WRITE(IFCH,*)'NO PHASE SPACE'
+        NPTL=NPTL-1
+        NOPHA=NOPHA+1
+        GOTO 6002
+      ENDIF
+
+C  DETERMINE QO(M)
+C  ---------------
+      OOMAX=0.
+      DO 211 M=1,MO
+        IF ( OO(M) .GT. OOMAX ) OOMAX=OO(M)
+  211 CONTINUE
+      OOX=OOMAX-10.
+      DO 212 M=1,MO
+        IF ( OO(M) .LT. OOX ) THEN
+          YO(M)=0.
+        ELSE
+          YO(M)=YO(M)*EXP(OO(M)-OOX)
+        ENDIF
+  212 CONTINUE
+      QO(1)=0.
+      DO 213 M=2,MO
+        IF ( KO(M) .NE. 0 ) YOM=0.
+        QO(M)=QO(M-1)+(YOM+YO(M))*0.5
+        YOM=YO(M)
+  213 CONTINUE
+      YOMAX=0.
+      DO 214 M=1,MO
+        IF ( YO(M) .GT. YOMAX ) YOMAX=YO(M)
+  214 CONTINUE
+
+      IF ( ISH .GE. 93 ) THEN
+        IDO=0
+        XOX=0.
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'ACCUMULATED DECAY PROBABILITIES:'
+        WRITE(IFCH,*)' '
+        DO 215 M=1,MO
+          IF ( KO(M) .NE. 0 ) THEN
+            WRITE(IFCH,*)' '
+            IDO=KO(M)
+          ENDIF
+          WRITE(IFCH,110)M,IDO,XO(M)-XOX,QO(M)
+110       FORMAT(1X,'M,IDO,XO,QO: ',I6,I6,3X,F6.2,E12.3)
+          IF ( M .LT. MO  .AND.  KO(M+1) .NE. 0 ) XOX=XO(M)
+  215   CONTINUE
+      ENDIF
+
+C  SELECT RANDOMLY HADRON+MOMENTUM
+C  -------------------------------
+
+      LO=0
+24    LO=LO+1
+      IF ( LO .GT. 10 ) THEN
+        IF ( ISH.GE.92 ) WRITE(IFCH,*)'SMALL PHASE SPACE:',YOHIT,YOMAX
+        NPTL=NPTL-1
+        NOPHA=NOPHA+1
+        ISMALL=1
+        GOTO 6002
+      ENDIF
+
+      XOS=UTINVT(MO,XO,QO,RANGEN()*QO(MO))
+      MHIT=LUTINV
+      DO 28 I=2,IOM
+        IX=I-1
+        IF ( XOS .LT. POL(I) ) GOTO 29
+28    CONTINUE
+      IX=IOM
+29    CONTINUE
+      POS=XOS-POL(IX)
+      IDS=IDOL(IX)
+      CALL IDMASS(IDS,AMS)
+      IDPTL(NPTL)=IDS
+
+      CALL IDQUAC(NPTL,NDU,NDU,NDU,JCO)
+      DO 26 NF=1,NFLAV
+        JCE(NF,1)=JCA(NF,1)-JCO(NF,1)
+        JCE(NF,2)=JCA(NF,2)-JCO(NF,2)
+        IF ( JCE(NF,1) .LT. 0 ) THEN
+          JCE(NF,2)=JCE(NF,2)-JCE(NF,1)
+          JCE(NF,1)=0
+        ENDIF
+        IF ( JCE(NF,2) .LT. 0 ) THEN
+          JCE(NF,1)=JCE(NF,1)-JCE(NF,2)
+          JCE(NF,2)=0
+        ENDIF
+26    CONTINUE
+      DO 27 I=5,NFLAV
+        IF ( JCE(I,1) .NE. 0  .OR. JCE(I,2) .NE. 0 ) THEN
+          CALL UTSTOP('JCLUDE: FLAVOUR > 4                     ')
+        ENDIF
+27    CONTINUE
+
+      KEU=JCE(1,1)-JCE(1,2)
+      KED=JCE(2,1)-JCE(2,2)
+      KES=JCE(3,1)-JCE(3,2)
+      KEC=JCE(4,1)-JCE(4,2)
+      GAMXHT=SJCGAM(KEU,KED,KES,KEC,AMA,AMS,POS,1)
+      YOHIT=GAMXHT*(XO(MHIT+1)-XO(MHIT))*4.
+      IF ( YOHIT .LT. 1.E-5  .AND.  YOHIT .LT. 1.E-5*YOMAX ) GOTO 24
+
+      PPTL(5,NPTL)=AMS
+      U(3)=2.*RANGEN()-1.
+      PHI=2.*PI*RANGEN()
+      U(1)=SQRT(1.-U(3)**2)*COS(PHI)
+      U(2)=SQRT(1.-U(3)**2)*SIN(PHI)
+      PPT(1)=POS*U(1)
+      PPTL(1,NPTL)=PPT(1)
+      PPT(2)=POS*U(2)
+      PPTL(2,NPTL)=PPT(2)
+      PPT(3)=POS*U(3)
+      PPTL(3,NPTL)=PPT(3)
+      PPT(4)=SQRT(PPTL(5,NPTL)**2+POS**2)
+      PPTL(4,NPTL)=PPT(4)
+      IF ( ISH .GE. 93 )
+     *    WRITE(IFCH,101)NPTL,IDPTL(NPTL),(PPTL(K,NPTL),K=1,5)
+      CALL UTLOB2(-1,PA(1),PA(2),PA(3),PA(4),PA(5)
+     *        ,PPT(1),PPT(2),PPT(3),PPT(4))
+      PPTL(1,NPTL)=PPT(1)
+      PPTL(2,NPTL)=PPT(2)
+      PPTL(3,NPTL)=PPT(3)
+      PPTL(4,NPTL)=PPT(4)
+      IF ( ISH .GE. 92 )
+     *        WRITE(IFCH,101)NPTL,IDPTL(NPTL),(PPTL(K,NPTL),K=1,5)
+
+      PE(5)=AMEGAM
+      PE(1)=-POS*U(1)
+      PE(2)=-POS*U(2)
+      PE(3)=-POS*U(3)
+      PE(4)=SQRT(PE(5)**2+POS**2)
+      CALL UTLOB2(-1,PA(1),PA(2),PA(3),PA(4),PA(5)
+     *            ,PE(1),PE(2),PE(3),PE(4))
+
+      PA(1)=PE(1)
+      PA(2)=PE(2)
+      PA(3)=PE(3)
+      PA(4)=PE(4)
+      PA(5)=PE(5)
+      DO 23 NF=1,NFLAV
+        JCA(NF,1)=JCE(NF,1)
+        JCA(NF,2)=JCE(NF,2)
+23    CONTINUE
+      NOPHA=0
+
+      GOTO 6002
+
+7001  CONTINUE
+
+C  CHECK ENERGY CONSERVATION
+C  -------------------------
+      IF ( NPTL .LE. NPTLB ) GOTO 1000
+
+      IFAIL=1
+      IF ( NPTL .GT. NPTLB+1 ) THEN
+        ISHRSC=ISH
+        ISH=0
+        CALL JRESCL(NPTLB+1,NPTL,PA0,IFAIL)
+        ISH=ISHRSC
+C-C     IF ( IFAIL.NE.0 .AND. ISH.GE.90 ) THEN
+C-C       CALL UTMSG('JCLUDE')
+C-C       WRITE(IFCH,*)'*****  IFAIL_JRESCL=',IFAIL
+C-C       CALL UTMSGF
+C-C     ENDIF
+      ENDIF
+
+C-C   DO 114 N=NPTLB+1,NPTL
+C-C     P=PPTL(3,N)
+C-C     E=PPTL(4,N)
+C-C     Y=100.
+C-C     DY=3.
+C-C     IF ( E-P.NE.0. .AND. E+P.NE.0. ) Y=.5*LOG((E+P)/(E-P))+DY
+C-C     IDA=ABS(IDPTL(N))
+C-C     IF ( IDA.GT.1000 .AND. MOD(IDA,10).NE.0 .AND. Y.LT.10. ) THEN
+C-C       WRITE(6,*)('-',K=1,69)
+C-C       P=PPTL(3,IP)
+C-C       E=PPTL(4,IP)
+C-C       Y=100.
+C-C       DY=3.
+C-C       IF ( E-P.NE.0. .AND. E+P.NE.0. ) Y=.5*LOG((E+P)/(E-P))+DY
+C-C       WRITE(6,115)IP,IDPTL(IP)
+C-C  *         ,(PPTL(K,IP),K=3,5),Y
+C-C       WRITE(6,*)'-------> '
+C-C       DO 113 M=NPTLB+1,NPTL
+C-C         P=PPTL(3,M)
+C-C         E=PPTL(4,M)
+C-C         Y=100.
+C-C         DY=3.
+C-C         IF ( E-P.NE.0. .AND. E+P.NE.0. ) Y=.5*LOG((E+P)/(E-P))+DY
+C-C         WRITE(6,115)M,IDPTL(M)
+C-C  *            ,(PPTL(K,M),K=3,5),Y
+C113      CONTINUE
+C-C     ENDIF
+C114  CONTINUE
+ 115  FORMAT(1X,'/CPTL/',I6,I10
+     *,3(E10.2),2(E10.2))
+
+      IF ( ISH .GE. 0 ) THEN
+        PX=0.
+        PY=0.
+        PZ=0.
+        E=0.
+        DO 10 N=NPTLB+1,NPTL
+          PX=PX+PPTL(1,N)
+          PY=PY+PPTL(2,N)
+          PZ=PZ+PPTL(3,N)
+          E=E+  PPTL(4,N)
+10      CONTINUE
+      ENDIF
+
+      IF ( ISH .GE. 90 ) THEN
+        IF ( ISH .GE. 92 ) THEN
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,*)'CHECK ENERGY CONSERVATION'
+          DO 11 N=NPTLB+1,NPTL
+            WRITE(IFCH,101)N,IDPTL(N),(PPTL(K,N),K=1,5)
+11        CONTINUE
+          AM=SQRT(E**2-PX**2-PY**2-PZ**2)
+          WRITE(IFCH,103)PX,PY,PZ,E,AM
+103       FORMAT(1X,'P_SUM:  ',15X,5(E10.3,1X))
+          WRITE(IFCH,104)(PA0(K),K=1,5)
+104       FORMAT(1X,'P_CLU:  ',15X,5(E10.3,1X))
+        ENDIF
+
+        IF ( IFAIL.EQ.0 .AND.
+     *   (ABS(PX-PA0(1)).GT.1.E-2*ABS(PX).AND.ABS(PX-PA0(1)).GT.1.E-2
+     *.OR.ABS(PY-PA0(2)).GT.1.E-2*ABS(PY).AND.ABS(PY-PA0(2)).GT.1.E-2
+     *.OR.ABS(PZ-PA0(3)).GT.1.E-2*ABS(PZ).AND.ABS(PZ-PA0(3)).GT.1.E-2
+     *.OR.ABS(E -PA0(4)).GT.1.E-2*ABS(E ).AND.ABS(E -PA0(4)).GT.1.E-2)
+     *.OR.
+     *       IFAIL.NE.0 .AND.
+     *   (ABS(PX-PA0(1)).GT.1.E-2*ABS(PX).AND.ABS(PX-PA0(1)).GT.1.E-2
+     *.OR.ABS(PY-PA0(2)).GT.1.E-2*ABS(PY).AND.ABS(PY-PA0(2)).GT.1.E-2
+     *.OR.ABS(PZ-PA0(3)).GT.1.E-2*ABS(PZ).AND.ABS(PZ-PA0(3)).GT.1.E-2
+     *.OR.ABS(E -PA0(4)).GT.35.E-1*ABS(E ).AND.ABS(E -PA0(4)).GT.35.E-1)
+     *   ) THEN
+          CALL UTMSG('JCLUDE')
+          WRITE(IFCH,*)'*****  P_SUM /= P_CLU'
+          WRITE(IFCH,*)'IFAIL_JRESCL:',IFAIL,'   SCAL:',SCAL
+          DO 30 N=NPTLB+1,NPTL
+            WRITE(IFCH,101)N,IDPTL(N),(PPTL(K,N),K=1,5)
+30        CONTINUE
+          WRITE(IFCH,103)PX,PY,PZ,E
+          WRITE(IFCH,104)(PA0(K),K=1,4)
+          CALL UTMSGF
+        ENDIF
+      ENDIF
+
+1000  CONTINUE
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)('-',L=1,25)
+        WRITE(IFCH,*)'   RETURN FROM JCLUDE   '
+        WRITE(IFCH,*)('-',L=1,25)
+        WRITE(IFCH,*)' '
+      ENDIF
+      ISH=ISH0
+      RETURN
+
+1001  IRET=1
+      IF ( ISH .GE. 90 ) THEN
+        CALL UTMSG('JCLUDE')
+        WRITE(IFCH,*)'*****  CLUSTER DECAY NOT POSSIBLE  --> IRET=1'
+        WRITE(IFCH,100)(PA0(K),K=1,5)
+        WRITE(IFCH,*)'JCA:'
+        WRITE(IFCH,*)JCA0
+        CALL UTMSGF
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JDECA(I,IRET)
+
+C-----------------------------------------------------------------------
+C  DECAYS I (CALLS JDECAY)
+C-----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      PARAMETER (NFLAV=6)
+      COMMON /CCLUDE/  KCLUDE
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      DOUBLE PRECISION DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /CTTAUS/  DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      DOUBLE PRECISION TOR,ZOR
+      INTEGER          JCDU(NFLAV,2)
+C-----------------------------------------------------------------------
+      IRET=0
+      ISH0=ISH
+      IF ( ISHSUB/100 .EQ. 5 ) ISH=MOD(ISHSUB,100)
+      IF ( ISH .GE. 93 ) THEN
+        WRITE(IFCH,*)('-',L=1,79)
+        WRITE(IFCH,*)'ENTRY JDECA. DECAY OF',I,IDPTL(I),PPTL(5,I)
+      ENDIF
+CDH   CALL IDMASS(111,AMRHO0)
+CDH   CALL IDMASS(221,AMOMEG)
+      IOI=IORPTL(I)
+      IF ( .NOT.( IOI.GT.0 .AND. ABS(IDPTL(IOI)).LT.10000
+     *                    .AND. JORPTL(I).EQ.0 ) ) THEN
+        IF ( IDPTL(I) .EQ. 111 ) IDPTL(I)=221
+        IF ( IDPTL(I) .EQ. 221 .AND. RANGEN() .GT. 0.5 ) IDPTL(I)=111
+      ENDIF
+      IF ( MOD(NDECAY        ,10) .EQ.1 ) GOTO 1000
+      IDA=ABS(IDPTL(I))
+      IF ( MOD(NDECAY/10     ,10) .EQ.1 .AND. IDA .EQ.  20 ) GOTO 1000
+      IF ( MOD(NDECAY/100    ,10) .EQ.1 .AND. IDA .EQ.2130 ) GOTO 1000
+      IF ( MOD(NDECAY/1000   ,10) .EQ.1 ) THEN
+        IF ( IDA .EQ.1130 ) GOTO 1000
+        IF ( IDA .EQ.2230 ) GOTO 1000
+      ENDIF
+      IF ( MOD(NDECAY/10000  ,10) .EQ.1 ) THEN
+        IF ( IDA .EQ.2330 ) GOTO 1000
+        IF ( IDA .EQ.1330 ) GOTO 1000
+      ENDIF
+      IF ( MOD(NDECAY/100000 ,10) .EQ.1 .AND. IDA .EQ.3331 ) GOTO 1000
+      IF ( MOD(NDECAY/1000000,10) .EQ.1 .AND. IDA .EQ. 110 ) GOTO 1000
+      IF ( MOD(NDECAX        ,10) .EQ.1 .AND. IDA .EQ. 441 ) GOTO 1000
+      IF ( MOD(NDECAX/10     ,10) .EQ.1 .AND. IDA .EQ. 230 ) GOTO 1000
+      IF ( MOD(NDECAX/100    ,10) .EQ.1 ) THEN
+        IF ( IDA .EQ.1111 ) GOTO 1000
+        IF ( IDA .EQ.1121 ) GOTO 1000
+        IF ( IDA .EQ.1221 ) GOTO 1000
+        IF ( IDA .EQ.2221 ) GOTO 1000
+      ENDIF
+
+      IF ( MOD(NDECAX/1000   ,10) .EQ.1 ) THEN
+        IF ( IDA .EQ. 111 ) GOTO 1000
+        IF ( IDA .EQ. 121 ) GOTO 1000
+        IF ( IDA .EQ. 221 ) GOTO 1000
+        IF ( IDA .EQ. 331 ) GOTO 1000
+      ENDIF
+      IF ( MOD(NDECAX/10000  ,10) .EQ.1 .AND. IDA .EQ. 220 ) GOTO 1000
+      IF ( MOD(NDECAX/100000 ,10) .EQ.1 .AND. IDA .EQ. 330 ) GOTO 1000
+      IF ( MOD(NDECAX/1000000,10) .EQ.1 ) THEN
+        IF ( IDA .EQ. 112 ) GOTO 1000
+        IF ( IDA .EQ. 122 ) GOTO 1000
+      ENDIF
+      IF ( MOD(NDECAW        ,10) .EQ.1 .AND. IDA .EQ. 332 ) GOTO 1000
+      IF ( MOD(NDECAW/10     ,10) .EQ.1 ) THEN
+        IF ( IDA .EQ. 131 ) GOTO 1000
+        IF ( IDA .EQ.-131 ) GOTO 1000
+        IF ( IDA .EQ. 231 ) GOTO 1000
+        IF ( IDA .EQ.-231 ) GOTO 1000
+      ENDIF
+      T=TIVPTL(2,I)
+      NPTLB=NPTL
+      IF ( NPTL .GT. MXPTL-10 ) THEN
+        CALL UTSTOP('JDECA: MXPTL TOO SMALL                  ')
+      ENDIF
+      ISH=ISH0
+      CALL JDECAY(I,IRET)
+      IF ( ISHSUB/100 .EQ. 5 ) ISH=MOD(ISHSUB,100)
+      IF ( IRET .EQ. 1 ) GOTO 1000
+      IF ( NPTL .LE. NPTLB ) GOTO 1000
+      ISH00=ISH
+      IF ( ISHSUB/100.EQ.14 .AND. KCLUDE.EQ.1 ) ISH=MOD(ISHSUB,100)
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,101)SNGL(TTAUS)
+101     FORMAT(1X,'DECAY  AT TAU =',E10.3)
+        WRITE(IFCH,115)I,IDPTL(I)
+     *                 ,(PPTL(K,I),K=3,5),(TIVPTL(K,I),K=1,2)
+115     FORMAT(1X,'/CPTL/',I6,I10
+     *           ,1X,3(E10.2),1X,2(E10.2))
+      ENDIF
+      ISTPTL(I)=1
+      IFRPTL(1,I)=NPTLB+1
+      IFRPTL(2,I)=NPTL
+      X=XORPTL(1,I)+(T-XORPTL(4,I))*PPTL(1,I)/PPTL(4,I)
+      Y=XORPTL(2,I)+(T-XORPTL(4,I))*PPTL(2,I)/PPTL(4,I)
+      Z=XORPTL(3,I)+(T-XORPTL(4,I))*PPTL(3,I)/PPTL(4,I)
+      IF ( ISH .GE. 93 ) WRITE(IFCH,*)
+     *            'LOOP OVER DECAY PRODUCTS ',NPTLB+1,' - ',NPTL,' :'
+      DO 20 N=NPTLB+1,NPTL
+        IF ( ISH .GE. 93 ) WRITE(IFCH,*)'PARTICLE: ',N,IDPTL(N)
+        IORPTL(N)=I
+        JORPTL(N)=0
+        ISTPTL(N)=0
+        IFRPTL(1,N)=0
+        IFRPTL(2,N)=0
+        XORPTL(1,N)=X
+        XORPTL(2,N)=Y
+        XORPTL(3,N)=Z
+        XORPTL(4,N)=T
+        NQJPTL(N)=NQJPTL(I)
+        IO=N
+ 1      IO=IORPTL(IO)
+        IF ( ISH .GE. 93 ) WRITE(IFCH,*)'IO = ',IO
+        IF ( IORPTL(IO) .GT. 0 ) GOTO 1
+        IF ( ISH.GE. 93 ) WRITE(IFCH,*)'ORIGIN: ',IO,IDPTL(IO)
+        ZOR=XORPTL(3,IO)
+        TOR=XORPTL(4,IO)
+        CALL IDQUAC(IO,NQ,NDU,NDU,JCDU)
+        R=RANGEN()
+        TAURAN=-TAUREA*LOG(R)
+        CALL UTTAIX(N,TAURAN,ZOR,TOR,ZIS,TIS)
+        TIVPTL(1,N)=MAX(T,TIS)
+        CALL IDTAU(IDPTL(N),PPTL(4,N),PPTL(5,N),TAUGM)
+        TIVPTL(2,N)=T+TAUGM
+        ICLPTL(N)=1
+        IF ( ISH .GE. 91 ) WRITE(IFCH,115)N,IDPTL(N)
+     *                    ,(PPTL(K,N),K=3,5),(TIVPTL(K,N),K=1,2)
+20    CONTINUE
+      ISH=ISH00
+
+1000  CONTINUE
+      IF ( ISH .GE. 93 ) WRITE(IFCH,*)('-',L=1,79)
+      ISH=ISH0
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JDECAY(IP,IRET)
+
+C-----------------------------------------------------------------------
+C  DECAYS PARTICLE IP FROM /CPTL/
+C-----------------------------------------------------------------------
+      PARAMETER (MXDKY=2000)
+      PARAMETER (MXLOOK=10000)
+      PARAMETER (MXPTL=70000)
+      COMMON /CCLUDE/  KCLUDE
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /DKYTAB/  CBR(MXDKY),LOOK(MXLOOK),MODE(5,MXDKY)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /WCO/     WGAM2,WMASS2
+
+      REAL    BETA(3),PGEN(5,5),PREST(4,5)
+     *       ,REDUCE(5),RND(5),U(3)
+      DATA REDUCE/1.,1.,2.,5.,15./,TWOME/1.022006E-3/
+C-----------------------------------------------------------------------
+C  FCTN DEFINITIONS
+      DOT(I1,I2)=PREST(4,I1)*PREST(4,I2)-PREST(1,I1)*PREST(1,I2)
+     *          -PREST(2,I1)*PREST(2,I2)-PREST(3,I1)*PREST(3,I2)
+C  CHARGED W PROPAGATOR.
+      WPROP(Z)=(Z-WMASS2**2)**2+(WMASS2*WGAM2)**2
+C-----------------------------------------------------------------------
+
+      ISH0=ISH
+      IF ( ISHSUB/100 .EQ. 4 ) ISH=MOD(ISHSUB,100)
+      IF ( ISH .GE. 93 ) THEN
+        WRITE(IFCH,*)('-',L=1,79)
+        WRITE(IFCH,*)'DECAY OF',IP,IDPTL(IP),PPTL(5,IP)
+      ENDIF
+      ISH=ISH0
+
+      IRET=0
+      KCLUDE=0
+
+C  NO K_LONG DECAY
+C  ---------------
+      IF ( IDPTL(IP) .EQ. -20 ) GOTO 1000
+
+C  CLUSTER DECAY
+C  -------------
+      IF ( ABS(IDPTL(IP)) .GT. 100000000 ) THEN
+        KCLUDE=1
+        CALL JCLUDE(IP,IRET)
+        GOTO 1000
+      ENDIF
+
+      IF ( ISHSUB/100 .EQ. 4 ) ISH=MOD(ISHSUB,100)
+      IF ( ISH .GE. 93 ) WRITE(IFCH,*)'ORDINARY DECAY'
+
+C  SELECT DECAY MODE
+C  -----------------
+      NTRY=0
+ 2    NTRY=NTRY+1
+      IF ( NTRY .GT. 100 ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JDECAY')
+          WRITE(IFCH,*)'*****  DECAY NOT POSSIBLE. IRET = 1.'
+          WRITE(IFCH,*)'ID,MASS: ',IDPTL(IP),PPTL(5,IP)
+          CALL UTMSGF
+        ENDIF
+        IRET=1
+        GOTO 1000
+      ENDIF
+      IDLV1=IDPTL(IP)
+      AMSS=PPTL(5,IP)
+ 1    CONTINUE
+      IPOINT=LOOK(IABS(IDLV1))-1
+      IF ( IPOINT .LT. 0 ) GOTO 1000
+      TRY=RANGEN()
+100   IPOINT=IPOINT+1
+      IF ( ISH .GE. 93 ) WRITE(IFCH,*)'IPOINT,CBR,TRY'
+     *                                ,IPOINT,CBR(IPOINT),TRY
+      IF ( TRY .GT. CBR(IPOINT) ) GOTO 100
+      NADD=0
+      SUM=0.
+      NSTART=NPTL+1
+      DO 110 I=1,5
+        IF ( MODE(I,IPOINT) .EQ. 0 ) GOTO 110
+        IF ( NPTL+NADD+1 .GT. MXPTL ) GOTO 9999
+        NADD=NADD+1
+        NEW=NPTL+NADD
+        IDPTL(NEW)=MODE(I,IPOINT)
+        IDLV1=IDPTL(NEW)
+        CALL IDMASS(IDLV1,PPTL(5,NEW))
+        SUM=SUM+PPTL(5,NEW)
+110   CONTINUE
+      IF ( NADD .NE. 1  .AND.  SUM+1.E-2 .GE. AMSS ) GOTO 2
+      NADD1=NADD-1
+      DO 120 J=1,5
+        PGEN(J,1)=PPTL(J,IP)
+120   CONTINUE
+      PGEN(5,NADD)=PPTL(5,NPTL+NADD)
+      IF ( NADD .EQ. 1 ) GOTO 700
+      IF ( NADD .EQ. 2 ) GOTO 400
+
+C  USE KROLL-WADA DISTRIBUTION FOR DALITZ DECAYS.
+C  ----------------------------------------------
+      IF ( ISH .GE. 93 ) WRITE(IFCH,*)'>= 3 BODY DECAY'
+      IF ( .NOT. ( (IDPTL(IP).EQ.110 .OR. IDPTL(IP).EQ.220) .AND.
+     *             ABS(IDPTL(NPTL+2)).EQ.12 ) ) GOTO 130
+      NTRY=0
+125   NTRY=NTRY+1
+      IF ( NTRY .GT. 10 ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JDECAY')
+          WRITE(IFCH,*)'*****  NTRY > 10. IRET = 1.'
+          WRITE(IFCH,*)'AMEE,REE,WTEE',AMEE,REE,WTEE
+          CALL UTMSGF
+        ENDIF
+        IRET=1
+        GOTO 1000
+      ENDIF
+      AMEE=TWOME*(PPTL(5,IP)/TWOME)**RANGEN()
+      REE=(TWOME/AMEE)**2
+      WTEE=(1.-(AMEE/PPTL(5,IP))**2)**3*SQRT(1.-REE)*(1.+.5*REE)
+      IF ( WTEE .LT. RANGEN() ) GOTO 125
+      PGEN(5,2)=AMEE
+      GOTO 400
+130   CONTINUE
+
+C  CALCULATE MAXIMUM PHASE-SPACE WEIGHT
+C  ------------------------------------
+      WTMAX=1./REDUCE(NADD)
+      SUM1=PGEN(5,1)
+      SUM2=SUM-PPTL(5,NPTL+1)
+      DO 200 I=1,NADD1
+        WTMAX=WTMAX*UTPCM(SUM1,SUM2,PPTL(5,NPTL+I))
+        SUM1=SUM1-PPTL(5,NPTL+I)
+        SUM2=SUM2-PPTL(5,NPTL+I+1)
+200   CONTINUE
+
+C  GENERATE UNIFORM NADD-BODY PHASE SPACE
+C  --------------------------------------
+      NTRY=0
+300   NTRY=NTRY+1
+      IF ( NTRY .GT. 10000 ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JDECAY')
+          WRITE(IFCH,*)'*****  INFINITE LOOP (2). IRET = 1.'
+          WRITE(IFCH,*)'IP,IDPTL(IP),PPTL(5,IP):'
+     *                 ,IP,IDPTL(IP),PPTL(5,IP)
+          WRITE(IFCH,*)'WT,WTMAX:',WT,WTMAX
+          WRITE(IFCH,*)'I,PGEN(5,I),PPTL(5,NPTL+I),IDPTL(NPTL+I):'
+          DO 305 I=1,NADD
+            WRITE(IFCH,*)I,PGEN(5,I),PPTL(5,NPTL+I),IDPTL(NPTL+I)
+305       CONTINUE
+          CALL UTMSGF
+        ENDIF
+        IRET=1
+        GOTO 1000
+      ENDIF
+      RND(1)=1.
+      DO 310 I=2,NADD1
+        RNEW=RANGEN()
+        I1=I-1
+        DO 320 JJ1=1,I1
+          J=I-JJ1
+          JSAVE=J+1
+          IF ( RNEW .LE. RND(J) ) GOTO 315
+          RND(JSAVE)=RND(J)
+320     CONTINUE
+315     RND(JSAVE)=RNEW
+310   CONTINUE
+      RND(NADD)=0.
+      WT=1.
+      SUM1=SUM
+      DO 330 I=2,NADD
+        SUM1=SUM1-PPTL(5,NPTL+I-1)
+        PGEN(5,I)=SUM1+RND(I)*(PGEN(5,1)-SUM)
+        A=PGEN(5,I-1)
+        B=PGEN(5,I)
+        C=PPTL(5,NPTL+I-1)
+        WT=WT*UTPCM(A,B,C)
+330   CONTINUE
+      IF ( WT .LT. RANGEN()*WTMAX ) GOTO 300
+
+C  CARRY OUT TWO-BODY DECAYS IN PGEN FRAMES
+C  ----------------------------------------
+400   CONTINUE
+      IF ( ISH .GE. 93 ) WRITE(IFCH,*)'2 BODY DECAY'
+      DO 410 I=1,NADD1
+        QCM=UTPCM(PGEN(5,I),PGEN(5,I+1),PPTL(5,NPTL+I))
+        U(3)=2.*RANGEN()-1.
+        PHI=2.*PI*RANGEN()
+        U(1)=SQRT(1.-U(3)**2)*COS(PHI)
+        U(2)=SQRT(1.-U(3)**2)*SIN(PHI)
+        PPTL(1,NPTL+I)=QCM*U(1)
+        PGEN(1,I+1)=-PPTL(1,NPTL+I)
+        PPTL(2,NPTL+I)=QCM*U(2)
+        PGEN(2,I+1)=-PPTL(2,NPTL+I)
+        PPTL(3,NPTL+I)=QCM*U(3)
+        PGEN(3,I+1)=-PPTL(3,NPTL+I)
+        PPTL(4,NPTL+I)=SQRT(QCM**2+PPTL(5,NPTL+I)**2)
+        PGEN(4,I+1)=SQRT(QCM**2+PGEN(5,I+1)**2)
+410   CONTINUE
+      PPTL(1,NPTL+NADD)=PGEN(1,NADD)
+      PPTL(2,NPTL+NADD)=PGEN(2,NADD)
+      PPTL(3,NPTL+NADD)=PGEN(3,NADD)
+      PPTL(4,NPTL+NADD)=PGEN(4,NADD)
+
+C  BOOST PGEN FRAMES TO LAB FRAME
+C       ALSO SAVE MOMENTA IN REST FRAME (LAST FRAME)
+C  -------------------------------------------------
+      DO 500 II=1,NADD1
+        I=NADD-II
+        BETA(1)=1./PGEN(4,I)*PGEN(1,I)
+        BETA(2)=1./PGEN(4,I)*PGEN(2,I)
+        BETA(3)=1./PGEN(4,I)*PGEN(3,I)
+        GAMMA=PGEN(4,I)/PGEN(5,I)
+        DO 520 K=I,NADD
+          K1=NPTL+K
+          BP=BETA(1)*PPTL(1,K1)+BETA(2)*PPTL(2,K1)+BETA(3)*PPTL(3,K1)
+          AUXIL=GAMMA*(PPTL(4,K1)+BP*GAMMA/(GAMMA+1.))
+          PREST(1,K)=PPTL(1,K1)
+          PPTL(1,K1)=PPTL(1,K1)+BETA(1)*AUXIL
+          PREST(2,K)=PPTL(2,K1)
+          PPTL(2,K1)=PPTL(2,K1)+BETA(2)*AUXIL
+          PREST(3,K)=PPTL(3,K1)
+          PPTL(3,K1)=PPTL(3,K1)+BETA(3)*AUXIL
+          PREST(4,K)=PPTL(4,K1)
+          PPTL(4,K1)=GAMMA*(PPTL(4,K1)+BP)
+520     CONTINUE
+500   CONTINUE
+
+C  MATRIX ELEMENTS
+C  ---------------
+      IF ( NADD .EQ. 3 ) THEN
+        IF ( IDPTL(IP) .EQ. 221  .OR.  IDPTL(IP) .EQ. 331 ) GOTO 610
+        IF ( ABS(IDPTL(NPTL+1)) .LT. 20   .AND.
+     *             IDPTL(NPTL+1) .NE. 10 ) GOTO 620
+      ENDIF
+      GOTO 800
+
+C  OMEG AND PHI DECAY
+C       USE VECTORS IN REST FRAME
+C  ------------------------------
+610   WT=(PPTL(5,NPTL+1)*PPTL(5,NPTL+2)*PPTL(5,NPTL+3))**2
+     *                 -(PPTL(5,NPTL+1)*DOT(2,3))**2
+     *                 -(PPTL(5,NPTL+2)*DOT(1,3))**2
+     *                 -(PPTL(5,NPTL+3)*DOT(1,2))**2
+     *                +2.*DOT(1,2)*DOT(2,3)*DOT(1,3)
+      IF ( WT .LT. RANGEN()*PPTL(5,IP)**6/108. ) GOTO 300
+      GOTO 800
+
+C  SEMILEPTONIC AND QUARK DECAYS
+C       USE VECTORS IN REST FRAME, WHERE IP HAS (M,0,0,0)
+C       INCLUDE W PROPAGATOR
+C  ------------------------------------------------------
+620   WT=(PPTL(5,IP)*PREST(4,2))*DOT(1,3)
+      S12=PPTL(5,NPTL+1)**2+PPTL(5,NPTL+2)**2+2.*DOT(1,2)
+      S12MAX=PPTL(5,IP)**2
+      WT=WT*WPROP(S12MAX)/WPROP(S12)
+      IF ( WT .LT. RANGEN()*PPTL(5,IP)**4/16. ) GOTO 300
+      GOTO 800
+
+C  ONE-PARTICLE DECAYS
+C  -------------------
+700   CONTINUE
+      DO 710 J=1,5
+        PPTL(J,NPTL+1)=PPTL(J,IP)
+710   CONTINUE
+
+C  SWAP PARTICLES AND ANTIPARTICLES IF IDPTL(IP)<0
+C  -----------------------------------------------
+800   CONTINUE
+      IF ( IDPTL(IP).GE.0 .OR. ABS(IDPTL(IP)).EQ.20 ) GOTO 900
+      DO 810 I=1,NADD
+        IDABS=ABS(IDPTL(NPTL+I))
+        IFL1=IDABS/1000
+        IFL2=MOD(IDABS/100,10)
+        IFL3=MOD(IDABS/10,10)
+        IF ( IFL1.EQ.0 .AND. IFL2.NE.0 .AND. IFL2.EQ.IFL3 ) GOTO 810
+        IF ( IDABS.EQ.9  .OR. IDABS.EQ.10 .OR. IDABS.EQ.20 ) GOTO 810
+        IF ( IDABS.EQ.29 .OR. IDABS.EQ.30 .OR. IDABS.EQ.40 ) GOTO 810
+        IDPTL(NPTL+I)=-IDPTL(NPTL+I)
+810   CONTINUE
+
+900   CONTINUE
+      NPTL=NPTL+NADD
+      IF ( NPTL .GT. MXPTL ) THEN
+        CALL UTSTOP('JDECAY: NPTL>MXPTL                      ')
+      ENDIF
+      NQK=0
+      IF ( ABS(IDPTL(NPTL)).LT.10 .OR. MOD(IDPTL(NPTL),100).EQ.0 ) THEN
+        CALL UTSTOP('JDECAY: DECAY PTCL IS PARTON            ')
+      ENDIF
+
+1000  CONTINUE
+      IF ( ISH .GE. 93 ) WRITE(IFCH,*)('-',L=1,79)
+      ISH=ISH0
+      RETURN
+
+9999  CALL UTSTOP('JDECAY: MXPTL TOO SMALL                 ')
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JDECIN(LPRINT)
+
+C-----------------------------------------------------------------------
+C  SETS UP /DKYTAB/
+C-----------------------------------------------------------------------
+      PARAMETER (MXDKY=2000)
+      PARAMETER (MXLOOK=10000)
+      PARAMETER (NDECTB=1171)
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /DKYTAB/  CBR(MXDKY),LOOK(MXLOOK),MODE(5,MXDKY)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      LOGICAL          NODCAY,NOETA,NOEVOL,NOHADR,NONUNU,NOPI0
+      COMMON /NODCAY/  NODCAY,NOETA,NOEVOL,NOHADR,NONUNU,NOPI0
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /WCO/     WGAM2,WMASS2
+
+      REAL        DECTAB(7,NDECTB)
+      INTEGER     IMODE(6)
+      CHARACTER*8 IBLANK,IDLABL,LMODE(6),LRES
+      LOGICAL     LPRINT
+
+      DATA IBLANK/' '/
+      DATA ((DECTAB(I,J),I=1,7),J=  1, 18)/
+     *  110., .98850,  10.,  10.,   0.,   0.,   0.
+     *, 110.,1.00000,  10.,  12., -12.,   0.,   0.
+     *, 220., .38000,  10.,  10.,   0.,   0.,   0.
+     *, 220., .71000, 110., 110., 110.,   0.,   0.
+     *, 220., .94600, 120.,-120., 110.,   0.,   0.
+     *, 220., .99500, 120.,-120.,  10.,   0.,   0.
+     *, 220.,1.00000,  10.,  12., -12.,   0.,   0.
+     *, 330., .44100, 220., 120.,-120.,   0.,   0.
+     *, 330., .66100, 220., 110., 110.,   0.,   0.
+     *, 330., .95900, 111.,  10.,   0.,   0.,   0.
+     *, 330., .98000, 221.,  10.,   0.,   0.,   0.
+     *, 330.,1.00000,  10.,  10.,   0.,   0.,   0.
+     *, 121.,1.00000, 120., 110.,   0.,   0.,   0.
+     *, 111., .99989, 120.,-120.,   0.,   0.,   0.
+     *, 111., .99993,  12., -12.,   0.,   0.,   0.
+     *, 111.,1.00000,  14., -14.,   0.,   0.,   0.
+     *, 221., .89900, 120.,-120., 110.,   0.,   0.
+     *, 221., .91200, 120.,-120.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J= 19, 36)/
+     *  221., .99992, 110.,  10.,   0.,   0.,   0.
+     *, 221.,1.00000,  12., -12.,   0.,   0.,   0.
+     *, 331., .48600, 130.,-130.,   0.,   0.,   0.
+     *, 331., .83700, 230.,-230.,   0.,   0.,   0.
+     *, 331., .98400, 120.,-120., 110.,   0.,   0.
+     *, 331., .99944, 220.,  10.,   0.,   0.,   0.
+     *, 331., .99975,  12., -12.,   0.,   0.,   0.
+     *, 331.,1.00000,  14., -14.,   0.,   0.,   0.
+     *, 230., .50000,  20.,   0.,   0.,   0.,   0.
+     *, 230.,1.00000, -20.,   0.,   0.,   0.,   0.
+     *, 131., .66670, 230., 120.,   0.,   0.,   0.
+     *, 131.,1.00000, 130., 110.,   0.,   0.,   0.
+     *, 231., .66670, 130.,-120.,   0.,   0.,   0.
+     *, 231.,1.00000, 230., 110.,   0.,   0.,   0.
+     *, 240., .11000,  12., -11., 230.,   0.,   0.
+     *, 240., .17000,  12., -11., 231.,   0.,   0.
+     *, 240., .28000,  14., -13., 230.,   0.,   0.
+     *, 240., .34000,  14., -13., 231.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J= 37, 54)/
+     *  240., .37800, 230.,-120.,   0.,   0.,   0.
+     *, 240., .56300, 230.,-121.,   0.,   0.,   0.
+     *, 240., .60800, 231.,-120.,   0.,   0.,   0.
+     *, 240., .62100, 230.,-120., 110.,   0.,   0.
+     *, 240., .71000, 130.,-120.,-120.,   0.,   0.
+     *, 240., .80100, 230.,-120.,-120., 120.,   0.
+     *, 240., .87900, 130.,-120.,-120., 110.,   0.
+     *, 240., .95400, 230.,-120., 110., 110.,   0.
+     *, 240., .96600, 230.,-130.,   0.,   0.,   0.
+     *, 240., .97600, 331.,-120.,   0.,   0.,   0.
+     *, 240., .98800,-130., 231.,   0.,   0.,   0.
+     *, 240.,1.00000,-131., 230.,   0.,   0.,   0.
+     *, 140., .04500,  12., -11., 130.,   0.,   0.
+     *, 140., .07500,  12., -11., 131.,   0.,   0.
+     *, 140., .12000,  14., -13., 130.,   0.,   0.
+     *, 140., .15000,  14., -13., 131.,   0.,   0.
+     *, 140., .20300, 130.,-120.,   0.,   0.,   0.
+     *, 140., .22700, 230., 110.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J= 55, 72)/
+     *  140., .24700, 230., 220.,   0.,   0.,   0.
+     *, 140., .28900, 230., 221.,   0.,   0.,   0.
+     *, 140., .45100, 130.,-121.,   0.,   0.,   0.
+     *, 140., .53600, 131.,-120.,   0.,   0.,   0.
+     *, 140., .56200, 231., 110.,   0.,   0.,   0.
+     *, 140., .57600, 230., 111.,   0.,   0.,   0.
+     *, 140., .58700, 130.,-120., 110.,   0.,   0.
+     *, 140., .60300, 230.,-120., 120.,   0.,   0.
+     *, 140., .72700, 130.,-120.,-120., 120.,   0.
+     *, 140., .87600, 230.,-120., 120., 110.,   0.
+     *, 140., .96900, 130.,-120., 110., 110.,   0.
+     *, 140.,1.00000, 230., 110., 110., 110.,   0.
+     *, 340., .03250,  12., -11., 220.,   0.,   0.
+     *, 340., .06500,  12., -11., 331.,   0.,   0.
+     *, 340., .09750,  14., -13., 220.,   0.,   0.
+     *, 340., .13000,  14., -13., 331.,   0.,   0.
+     *, 340., .17900,-130., 230.,   0.,   0.,   0.
+     *, 340., .22800,-120., 220.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J= 73, 90)/
+     *  340., .33800,-131., 230.,   0.,   0.,   0.
+     *, 340., .44800,-130., 231.,   0.,   0.,   0.
+     *, 340., .55800,-120., 331.,   0.,   0.,   0.
+     *, 340., .57500,-130., 230., 110.,   0.,   0.
+     *, 340., .59200,-230., 230.,-120.,   0.,   0.
+     *, 340., .69400,-130., 230.,-120., 120.,   0.
+     *, 340., .79600,-130., 230., 110., 110.,   0.
+     *, 340., .89800,-130., 130.,-120., 110.,   0.
+     *, 340.,1.00000,-230., 230.,-120., 110.,   0.
+     *, 241., .64000, 140.,-120.,   0.,   0.,   0.
+     *, 241., .92000, 240., 110.,   0.,   0.,   0.
+     *, 241.,1.00000, 240.,  10.,   0.,   0.,   0.
+     *, 141., .55000, 140., 110.,   0.,   0.,   0.
+     *, 141.,1.00000, 140.,  10.,   0.,   0.,   0.
+     *, 341.,1.00000, 340.,  10.,   0.,   0.,   0.
+     *, 441., .07400,  12., -12.,   0.,   0.,   0.
+     *, 441., .14800,  14., -14.,   0.,   0.,   0.
+     *, 441., .15210,-121., 120.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J= 91,108)/
+     *  441., .15620, 111., 110.,   0.,   0.,   0.
+     *, 441., .16020, 121.,-120.,   0.,   0.,   0.
+     *, 441., .16300,-121., 111., 120.,   0.,   0.
+     *, 441., .16580, 121.,-121., 110.,   0.,   0.
+     *, 441., .16860, 121., 111.,-120.,   0.,   0.
+     *, 441., .28740, 120.,-120., 130.,-130.,   0.
+     *, 441., .40620, 110., 110., 130.,-130.,   0.
+     *, 441., .52500, 120.,-120., 120.,-120.,   0.
+     *, 441., .64380, 120.,-120., 110., 110.,   0.
+     *, 441., .76260, 110., 110., 110., 110.,   0.
+     *, 441., .88130, 120.,-120., 230.,-230.,   0.
+     *, 441.,1.00000, 110., 110., 230., 230.,   0.
+     *, 150., .06000, -12.,  11., 140.,   0.,   0.
+     *, 150., .12000, -12.,  11., 141.,   0.,   0.
+     *, 150., .18000, -14.,  13., 140.,   0.,   0.
+     *, 150., .24000, -14.,  13., 141.,   0.,   0.
+     *, 150., .25500, -16.,  15., 140.,   0.,   0.
+     *, 150., .27000, -16.,  15., 141.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=109,126)/
+     *  150., .28050, 140., 120.,   0.,   0.,   0.
+     *, 150., .29100, 140., 121.,   0.,   0.,   0.
+     *, 150., .30150, 141., 120.,   0.,   0.,   0.
+     *, 150., .31200, 141., 121.,   0.,   0.,   0.
+     *, 150., .32650, 140.,-340.,   0.,   0.,   0.
+     *, 150., .34100, 140.,-341.,   0.,   0.,   0.
+     *, 150., .35550, 141.,-340.,   0.,   0.,   0.
+     *, 150., .37000, 141.,-341.,   0.,   0.,   0.
+     *, 150., .39800, 140., 120., 110.,   0.,   0.
+     *, 150., .42600, 140., 120., 220.,   0.,   0.
+     *, 150., .45400, 140., 120., 111.,   0.,   0.
+     *, 150., .48200, 140., 120., 221.,   0.,   0.
+     *, 150., .51000, 140., 121., 110.,   0.,   0.
+     *, 150., .53800, 140., 121., 220.,   0.,   0.
+     *, 150., .56600, 140., 121., 111.,   0.,   0.
+     *, 150., .59400, 140., 121., 221.,   0.,   0.
+     *, 150., .62200, 141., 120., 110.,   0.,   0.
+     *, 150., .65000, 141., 120., 220.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=127,144)/
+     *  150., .67800, 141., 120., 111.,   0.,   0.
+     *, 150., .70600, 141., 120., 221.,   0.,   0.
+     *, 150., .73400, 141., 121., 110.,   0.,   0.
+     *, 150., .76200, 141., 121., 220.,   0.,   0.
+     *, 150., .79000, 141., 121., 111.,   0.,   0.
+     *, 150., .81800, 141., 121., 221.,   0.,   0.
+     *, 150., .83200, 140., 130.,-230.,   0.,   0.
+     *, 150., .84600, 140., 130.,-231.,   0.,   0.
+     *, 150., .86000, 140., 131.,-230.,   0.,   0.
+     *, 150., .87400, 140., 131.,-231.,   0.,   0.
+     *, 150., .88800, 141., 130.,-230.,   0.,   0.
+     *, 150., .90200, 141., 130.,-231.,   0.,   0.
+     *, 150., .91600, 141., 131.,-230.,   0.,   0.
+     *, 150., .93000, 141., 131.,-231.,   0.,   0.
+     *, 150., .93300, 140.,-140., 130.,   0.,   0.
+     *, 150., .93600, 140.,-140., 131.,   0.,   0.
+     *, 150., .93900, 140.,-141., 130.,   0.,   0.
+     *, 150., .94200, 140.,-141., 131.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=145,162)/
+     *  150., .94500, 141.,-140., 130.,   0.,   0.
+     *, 150., .94800, 141.,-140., 131.,   0.,   0.
+     *, 150., .95100, 141.,-141., 130.,   0.,   0.
+     *, 150., .95400, 141.,-141., 131.,   0.,   0.
+     *, 150., .95700, 140.,-240., 230.,   0.,   0.
+     *, 150., .96000, 140.,-240., 231.,   0.,   0.
+     *, 150., .96300, 140.,-241., 230.,   0.,   0.
+     *, 150., .96600, 140.,-241., 231.,   0.,   0.
+     *, 150., .96900, 141.,-240., 230.,   0.,   0.
+     *, 150., .97200, 141.,-240., 231.,   0.,   0.
+     *, 150., .97500, 141.,-241., 230.,   0.,   0.
+     *, 150., .97800, 141.,-241., 231.,   0.,   0.
+     *, 150., .97950, 140.,-340., 330.,   0.,   0.
+     *, 150., .98100, 140.,-340., 331.,   0.,   0.
+     *, 150., .98250, 140.,-341., 331.,   0.,   0.
+     *, 150., .98400, 140.,-341., 331.,   0.,   0.
+     *, 150., .98550, 141.,-340., 330.,   0.,   0.
+     *, 150., .98700, 141.,-340., 331.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=163,180)/
+     *  150., .98850, 141.,-341., 331.,   0.,   0.
+     *, 150., .99000, 141.,-341., 331.,   0.,   0.
+     *, 150., .99200, 441., 130., 110.,   0.,   0.
+     *, 150., .99400, 441., 131., 110.,   0.,   0.
+     *, 150., .99600, 441., 230., 120.,   0.,   0.
+     *, 150., .99800, 441., 231., 120.,   0.,   0.
+     *, 150., .99900, 441., 330., 130.,   0.,   0.
+     *, 150.,1.00000, 441., 331., 130.,   0.,   0.
+     *, 250., .06000, -12.,  11., 240.,   0.,   0.
+     *, 250., .12000, -12.,  11., 241.,   0.,   0.
+     *, 250., .18000, -14.,  13., 240.,   0.,   0.
+     *, 250., .24000, -14.,  13., 241.,   0.,   0.
+     *, 250., .25500, -16.,  15., 240.,   0.,   0.
+     *, 250., .27000, -16.,  15., 241.,   0.,   0.
+     *, 250., .28050, 240., 120.,   0.,   0.,   0.
+     *, 250., .29100, 240., 121.,   0.,   0.,   0.
+     *, 250., .30150, 241., 120.,   0.,   0.,   0.
+     *, 250., .31200, 241., 121.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=181,198)/
+     *  250., .32650, 240.,-340.,   0.,   0.,   0.
+     *, 250., .34100, 240.,-341.,   0.,   0.,   0.
+     *, 250., .35550, 241.,-340.,   0.,   0.,   0.
+     *, 250., .37000, 241.,-341.,   0.,   0.,   0.
+     *, 250., .39800, 240., 120., 110.,   0.,   0.
+     *, 250., .42600, 240., 120., 220.,   0.,   0.
+     *, 250., .45400, 240., 120., 111.,   0.,   0.
+     *, 250., .48200, 240., 120., 221.,   0.,   0.
+     *, 250., .51000, 240., 121., 110.,   0.,   0.
+     *, 250., .53800, 240., 121., 220.,   0.,   0.
+     *, 250., .56600, 240., 121., 111.,   0.,   0.
+     *, 250., .59400, 240., 121., 221.,   0.,   0.
+     *, 250., .62200, 241., 120., 110.,   0.,   0.
+     *, 250., .65000, 241., 120., 220.,   0.,   0.
+     *, 250., .67800, 241., 120., 111.,   0.,   0.
+     *, 250., .70600, 241., 120., 221.,   0.,   0.
+     *, 250., .73400, 241., 121., 110.,   0.,   0.
+     *, 250., .76200, 241., 121., 220.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=199,216)/
+     *  250., .79000, 241., 121., 111.,   0.,   0.
+     *, 250., .81800, 241., 121., 221.,   0.,   0.
+     *, 250., .83200, 240., 130.,-230.,   0.,   0.
+     *, 250., .84600, 240., 130.,-231.,   0.,   0.
+     *, 250., .86000, 240., 131.,-230.,   0.,   0.
+     *, 250., .87400, 240., 131.,-231.,   0.,   0.
+     *, 250., .88800, 241., 130.,-230.,   0.,   0.
+     *, 250., .90200, 241., 130.,-231.,   0.,   0.
+     *, 250., .91600, 241., 131.,-230.,   0.,   0.
+     *, 250., .93000, 241., 131.,-231.,   0.,   0.
+     *, 250., .93300, 240.,-140., 130.,   0.,   0.
+     *, 250., .93600, 240.,-140., 131.,   0.,   0.
+     *, 250., .93900, 240.,-141., 130.,   0.,   0.
+     *, 250., .94200, 240.,-141., 131.,   0.,   0.
+     *, 250., .94500, 241.,-140., 130.,   0.,   0.
+     *, 250., .94800, 241.,-140., 131.,   0.,   0.
+     *, 250., .95100, 241.,-141., 130.,   0.,   0.
+     *, 250., .95400, 241.,-141., 131.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=217,234)/
+     *  250., .95700, 240.,-240., 230.,   0.,   0.
+     *, 250., .96000, 240.,-240., 231.,   0.,   0.
+     *, 250., .96300, 240.,-241., 230.,   0.,   0.
+     *, 250., .96600, 240.,-241., 231.,   0.,   0.
+     *, 250., .96900, 241.,-240., 230.,   0.,   0.
+     *, 250., .97200, 241.,-240., 231.,   0.,   0.
+     *, 250., .97500, 241.,-241., 230.,   0.,   0.
+     *, 250., .97800, 241.,-241., 231.,   0.,   0.
+     *, 250., .97950, 240.,-340., 330.,   0.,   0.
+     *, 250., .98100, 240.,-340., 331.,   0.,   0.
+     *, 250., .98250, 240.,-341., 331.,   0.,   0.
+     *, 250., .98400, 240.,-341., 331.,   0.,   0.
+     *, 250., .98550, 241.,-340., 330.,   0.,   0.
+     *, 250., .98700, 241.,-340., 331.,   0.,   0.
+     *, 250., .98850, 241.,-341., 331.,   0.,   0.
+     *, 250., .99000, 241.,-341., 331.,   0.,   0.
+     *, 250., .99200, 441., 130.,-120.,   0.,   0.
+     *, 250., .99400, 441., 131.,-120.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=235,252)/
+     *  250., .99600, 441., 230., 220.,   0.,   0.
+     *, 250., .99800, 441., 231., 221.,   0.,   0.
+     *, 250., .99900, 441., 330., 230.,   0.,   0.
+     *, 250.,1.00000, 441., 331., 230.,   0.,   0.
+     *, 350., .06000, -12.,  11., 340.,   0.,   0.
+     *, 350., .12000, -12.,  11., 341.,   0.,   0.
+     *, 350., .18000, -14.,  13., 340.,   0.,   0.
+     *, 350., .24000, -14.,  13., 341.,   0.,   0.
+     *, 350., .25500, -16.,  15., 340.,   0.,   0.
+     *, 350., .27000, -16.,  15., 341.,   0.,   0.
+     *, 350., .28050, 340., 120.,   0.,   0.,   0.
+     *, 350., .29100, 340., 121.,   0.,   0.,   0.
+     *, 350., .30150, 341., 120.,   0.,   0.,   0.
+     *, 350., .31200, 341., 121.,   0.,   0.,   0.
+     *, 350., .32650, 340.,-340.,   0.,   0.,   0.
+     *, 350., .34100, 340.,-341.,   0.,   0.,   0.
+     *, 350., .35550, 341.,-340.,   0.,   0.,   0.
+     *, 350., .37000, 341.,-341.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=253,270)/
+     *  350., .39800, 340., 120., 110.,   0.,   0.
+     *, 350., .42600, 340., 120., 220.,   0.,   0.
+     *, 350., .45400, 340., 120., 111.,   0.,   0.
+     *, 350., .48200, 340., 120., 221.,   0.,   0.
+     *, 350., .51000, 340., 121., 110.,   0.,   0.
+     *, 350., .53800, 340., 121., 220.,   0.,   0.
+     *, 350., .56600, 340., 121., 111.,   0.,   0.
+     *, 350., .59400, 340., 121., 221.,   0.,   0.
+     *, 350., .62200, 341., 120., 110.,   0.,   0.
+     *, 350., .65000, 341., 120., 220.,   0.,   0.
+     *, 350., .67800, 341., 120., 111.,   0.,   0.
+     *, 350., .70600, 341., 120., 221.,   0.,   0.
+     *, 350., .73400, 341., 121., 110.,   0.,   0.
+     *, 350., .76200, 341., 121., 220.,   0.,   0.
+     *, 350., .79000, 341., 121., 111.,   0.,   0.
+     *, 350., .81800, 341., 121., 221.,   0.,   0.
+     *, 350., .83200, 340., 130.,-230.,   0.,   0.
+     *, 350., .84600, 340., 130.,-231.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=271,288)/
+     *  350., .86000, 340., 131.,-230.,   0.,   0.
+     *, 350., .87400, 340., 131.,-231.,   0.,   0.
+     *, 350., .88800, 341., 130.,-230.,   0.,   0.
+     *, 350., .90200, 341., 130.,-231.,   0.,   0.
+     *, 350., .91600, 341., 131.,-230.,   0.,   0.
+     *, 350., .93000, 341., 131.,-231.,   0.,   0.
+     *, 350., .93300, 340.,-140., 130.,   0.,   0.
+     *, 350., .93600, 340.,-140., 131.,   0.,   0.
+     *, 350., .93900, 340.,-141., 130.,   0.,   0.
+     *, 350., .94200, 340.,-141., 131.,   0.,   0.
+     *, 350., .94500, 341.,-140., 130.,   0.,   0.
+     *, 350., .94800, 341.,-140., 131.,   0.,   0.
+     *, 350., .95100, 341.,-141., 130.,   0.,   0.
+     *, 350., .95400, 341.,-141., 131.,   0.,   0.
+     *, 350., .95700, 340.,-240., 230.,   0.,   0.
+     *, 350., .96000, 340.,-240., 231.,   0.,   0.
+     *, 350., .96300, 340.,-241., 230.,   0.,   0.
+     *, 350., .96600, 340.,-241., 231.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=289,306)/
+     *  350., .96900, 341.,-240., 230.,   0.,   0.
+     *, 350., .97200, 341.,-240., 231.,   0.,   0.
+     *, 350., .97500, 341.,-241., 230.,   0.,   0.
+     *, 350., .97800, 341.,-241., 231.,   0.,   0.
+     *, 350., .97950, 340.,-340., 330.,   0.,   0.
+     *, 350., .98100, 340.,-340., 331.,   0.,   0.
+     *, 350., .98250, 340.,-341., 331.,   0.,   0.
+     *, 350., .98400, 340.,-341., 331.,   0.,   0.
+     *, 350., .98550, 341.,-340., 330.,   0.,   0.
+     *, 350., .98700, 341.,-340., 331.,   0.,   0.
+     *, 350., .98850, 341.,-341., 331.,   0.,   0.
+     *, 350., .99000, 341.,-341., 331.,   0.,   0.
+     *, 350., .99200, 441., 130.,-130.,   0.,   0.
+     *, 350., .99400, 441., 131.,-130.,   0.,   0.
+     *, 350., .99600, 441., 230.,-230.,   0.,   0.
+     *, 350., .99800, 441., 231.,-230.,   0.,   0.
+     *, 350., .99900, 441., 330., 330.,   0.,   0.
+     *, 350.,1.00000, 441., 331., 331.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=307,324)/
+     *  160., .33330,  -1.,   2.,  -5.,   0.,   0.
+     *, 160., .66660,  -4.,   3.,  -5.,   0.,   0.
+     *, 160., .77770, -11.,  12.,  -5.,   0.,   0.
+     *, 160., .88880, -13.,  14.,  -5.,   0.,   0.
+     *, 160.,1.00000, -15.,  16.,  -5.,   0.,   0.
+     *, 260., .33330,  -1.,   2.,  -5.,   0.,   0.
+     *, 260., .66660,  -4.,   3.,  -5.,   0.,   0.
+     *, 260., .77770, -11.,  12.,  -5.,   0.,   0.
+     *, 260., .88880, -13.,  14.,  -5.,   0.,   0.
+     *, 260.,1.00000, -15.,  16.,  -5.,   0.,   0.
+     *, 360., .33330,  -1.,   2.,  -5.,   0.,   0.
+     *, 360., .66660,  -4.,   3.,  -5.,   0.,   0.
+     *, 360., .77770, -11.,  12.,  -5.,   0.,   0.
+     *, 360., .88880, -13.,  14.,  -5.,   0.,   0.
+     *, 360.,1.00000, -15.,  16.,  -5.,   0.,   0.
+     *, 151.,1.00000, 150.,  10.,   0.,   0.,   0.
+     *, 251.,1.00000, 250.,  10.,   0.,   0.,   0.
+     *, 351.,1.00000, 350.,  10.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=325,342)/
+     *  161.,1.00000, 160.,  10.,   0.,   0.,   0.
+     *, 261.,1.00000, 260.,  10.,   0.,   0.,   0.
+     *, 361.,1.00000, 360.,  10.,   0.,   0.,   0.
+     *,1230.,1.00000,2130.,  10.,   0.,   0.,   0.
+     *,1111.,1.00000,1120., 120.,   0.,   0.,   0.
+     *,1121., .66670,1120., 110.,   0.,   0.,   0.
+     *,1121.,1.00000,1220., 120.,   0.,   0.,   0.
+     *,1221., .66670,1220., 110.,   0.,   0.,   0.
+     *,1221.,1.00000,1120.,-120.,   0.,   0.,   0.
+     *,2221.,1.00000,1220.,-120.,   0.,   0.,   0.
+     *,1131., .88000,2130., 120.,   0.,   0.,   0.
+     *,1131., .94000,1130., 110.,   0.,   0.,   0.
+     *,1131.,1.00000,1230., 120.,   0.,   0.,   0.
+     *,1231., .88000,2130., 110.,   0.,   0.,   0.
+     *,1231., .94000,1130.,-120.,   0.,   0.,   0.
+     *,1231.,1.00000,2230., 120.,   0.,   0.,   0.
+     *,2231., .88000,2130.,-120.,   0.,   0.,   0.
+     *,2231., .94000,1230.,-120.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=343,360)/
+     * 2231.,1.00000,2230., 110.,   0.,   0.,   0.
+     *,1331., .66670,2330., 120.,   0.,   0.,   0.
+     *,1331.,1.00000,1330., 110.,   0.,   0.,   0.
+     *,2331., .66670,1330.,-120.,   0.,   0.,   0.
+     *,2331.,1.00000,2330., 110.,   0.,   0.,   0.
+     *,  16., .18000,  12., -11.,  15.,   0.,   0.
+     *,  16., .36000,  14., -13.,  15.,   0.,   0.
+     *,  16., .45100,-120.,  15.,   0.,   0.,   0.
+     *,  16., .66000,-121.,  15.,   0.,   0.,   0.
+     *,  16., .78000, 110., 110.,-120.,  15.,   0.
+     *,  16., .83600, 120.,-120.,-120.,  15.,   0.
+     *,  16.,1.00000, 120., 110.,-120.,-120.,  15.
+     *,2140., .03750, -12.,  11.,2130.,   0.,   0.
+     *,2140., .07500, -12.,  11.,1231.,   0.,   0.
+     *,2140., .11250, -14.,  13.,2130.,   0.,   0.
+     *,2140., .15000, -14.,  13.,1231.,   0.,   0.
+     *,2140., .18200,2130., 120.,   0.,   0.,   0.
+     *,2140., .21300,1230., 110.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=361,378)/
+     * 2140., .24400,1120.,-230.,   0.,   0.,   0.
+     *,2140., .29500,1131., 110.,   0.,   0.,   0.
+     *,2140., .34600,1231., 120.,   0.,   0.,   0.
+     *,2140., .39700,1121.,-230.,   0.,   0.,   0.
+     *,2140., .44800,1111.,-130.,   0.,   0.,   0.
+     *,2140., .49900,1130., 111.,   0.,   0.,   0.
+     *,2140., .55000,1230., 121.,   0.,   0.,   0.
+     *,2140., .60100,1120.,-231.,   0.,   0.,   0.
+     *,2140., .65800,1120.,-230., 120.,-120.,   0.
+     *,2140., .71500,1120.,-230., 110., 110.,   0.
+     *,2140., .77200,1120.,-130., 120., 110.,   0.
+     *,2140., .82900,1220.,-230., 120., 110.,   0.
+     *,2140., .88600,1220.,-130., 120., 120.,   0.
+     *,2140., .94300,2130., 120., 120.,-120.,   0.
+     *,2140.,1.00000,2130., 120., 110., 110.,   0.
+     *,1140.,1.00000,2140., 120.,   0.,   0.,   0.
+     *,1240.,1.00000,2140., 110.,   0.,   0.,   0.
+     *,2240.,1.00000,2140.,-120.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=379,396)/
+     * 1340., .03750, -12.,  11.,1330.,   0.,   0.
+     *,1340., .07500, -12.,  11.,1331.,   0.,   0.
+     *,1340., .11250, -14.,  13.,1330.,   0.,   0.
+     *,1340., .15000, -14.,  13.,1331.,   0.,   0.
+     *,1340., .19900,1330., 120.,   0.,   0.,   0.
+     *,1340., .24800,1231.,-230.,   0.,   0.,   0.
+     *,1340., .28800,1330., 120.,   0.,   0.,   0.
+     *,1340., .32800,1131.,-230.,   0.,   0.,   0.
+     *,1340., .36800,1330., 121.,   0.,   0.,   0.
+     *,1340., .40800,1130.,-230.,   0.,   0.,   0.
+     *,1340., .44800,1330., 120., 110.,   0.,   0.
+     *,1340., .48800,2330., 120., 120.,   0.,   0.
+     *,1340., .52800,1130.,-130., 120.,   0.,   0.
+     *,1340., .56800,1130.,-230., 110.,   0.,   0.
+     *,1340., .60800,1230.,-230., 120.,   0.,   0.
+     *,1340., .66400,2130.,-230., 120., 110.,   0.
+     *,1340., .72000,2130.,-130., 120., 120.,   0.
+     *,1340., .77600,1130.,-230., 120., 120.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=397,414)/
+     * 1340., .83200,1130.,-230., 110., 110.,   0.
+     *,1340., .88800,1330., 120., 120.,-120.,   0.
+     *,1340., .94400,1330., 120., 110., 110.,   0.
+     *,1340.,1.00000,2330., 120., 120., 110.,   0.
+     *,3140., .03750, -12.,  11.,1330.,   0.,   0.
+     *,3140., .07500, -12.,  11.,1331.,   0.,   0.
+     *,3140., .11250, -14.,  13.,1330.,   0.,   0.
+     *,3140., .15000, -14.,  13.,1331.,   0.,   0.
+     *,3140., .19900,1330., 120.,   0.,   0.,   0.
+     *,3140., .24800,1231.,-230.,   0.,   0.,   0.
+     *,3140., .28800,1330., 120.,   0.,   0.,   0.
+     *,3140., .32800,1131.,-230.,   0.,   0.,   0.
+     *,3140., .36800,1330., 121.,   0.,   0.,   0.
+     *,3140., .40800,1130.,-230.,   0.,   0.,   0.
+     *,3140., .44800,1330., 120., 110.,   0.,   0.
+     *,3140., .48800,2330., 120., 120.,   0.,   0.
+     *,3140., .52800,1130.,-130., 120.,   0.,   0.
+     *,3140., .56800,1130.,-230., 110.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=415,432)/
+     * 3140., .60800,1230.,-230., 120.,   0.,   0.
+     *,3140., .66400,2130.,-230., 120., 110.,   0.
+     *,3140., .72000,2130.,-130., 120., 120.,   0.
+     *,3140., .77600,1130.,-230., 120., 120.,   0.
+     *,3140., .83200,1130.,-230., 110., 110.,   0.
+     *,3140., .88800,1330., 120., 120.,-120.,   0.
+     *,3140., .94400,1330., 120., 110., 110.,   0.
+     *,3140.,1.00000,2330., 120., 120., 110.,   0.
+     *,2340., .03750, -12.,  11.,2330.,   0.,   0.
+     *,2340., .07500, -12.,  11.,2331.,   0.,   0.
+     *,2340., .11250, -14.,  13.,2330.,   0.,   0.
+     *,2340., .15000, -14.,  13.,2331.,   0.,   0.
+     *,2340., .17500,2330., 120.,   0.,   0.,   0.
+     *,2340., .20000,1330., 110.,   0.,   0.,   0.
+     *,2340., .22500,1130.,-130.,   0.,   0.,   0.
+     *,2340., .25000,1230.,-230.,   0.,   0.,   0.
+     *,2340., .29500,2331., 120.,   0.,   0.,   0.
+     *,2340., .34000,1331., 110.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=433,450)/
+     * 2340., .38500,1131.,-130.,   0.,   0.,   0.
+     *,2340., .43000,1231.,-230.,   0.,   0.,   0.
+     *,2340., .47500,2330., 121.,   0.,   0.,   0.
+     *,2340., .52000,1330., 111.,   0.,   0.,   0.
+     *,2340., .56500,1130.,-131.,   0.,   0.,   0.
+     *,2340., .61000,1230.,-231.,   0.,   0.,   0.
+     *,2340., .64900,2130.,-230., 120.,-120.,   0.
+     *,2340., .68800,2130.,-230., 110., 110.,   0.
+     *,2340., .72700,2130.,-130., 120., 110.,   0.
+     *,2340., .76600,1130.,-230.,-120., 110.,   0.
+     *,2340., .80500,1130.,-130., 120.,-120.,   0.
+     *,2340., .84400,1130.,-130., 110., 110.,   0.
+     *,2340., .88300,1330., 120.,-120., 110.,   0.
+     *,2340., .92200,1330., 110., 110., 110.,   0.
+     *,2340., .96100,2330., 120., 120.,-120.,   0.
+     *,2340.,1.00000,2330., 120., 110., 110.,   0.
+     *,3240., .03750, -12.,  11.,2330.,   0.,   0.
+     *,3240., .07500, -12.,  11.,2331.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=451,468)/
+     * 3240., .11250, -14.,  13.,2330.,   0.,   0.
+     *,3240., .15000, -14.,  13.,2331.,   0.,   0.
+     *,3240., .17500,2330., 120.,   0.,   0.,   0.
+     *,3240., .20000,1330., 110.,   0.,   0.,   0.
+     *,3240., .22500,1130.,-130.,   0.,   0.,   0.
+     *,3240., .25000,1230.,-230.,   0.,   0.,   0.
+     *,3240., .29500,2331., 120.,   0.,   0.,   0.
+     *,3240., .34000,1331., 110.,   0.,   0.,   0.
+     *,3240., .38500,1131.,-130.,   0.,   0.,   0.
+     *,3240., .43000,1231.,-230.,   0.,   0.,   0.
+     *,3240., .47500,2330., 121.,   0.,   0.,   0.
+     *,3240., .52000,1330., 111.,   0.,   0.,   0.
+     *,3240., .56500,1130.,-131.,   0.,   0.,   0.
+     *,3240., .61000,1230.,-231.,   0.,   0.,   0.
+     *,3240., .64900,2130.,-230., 120.,-120.,   0.
+     *,3240., .68800,2130.,-230., 110., 110.,   0.
+     *,3240., .72700,2130.,-130., 120., 110.,   0.
+     *,3240., .76600,1130.,-230.,-120., 110.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=469,486)/
+     * 3240., .80500,1130.,-130., 120.,-120.,   0.
+     *,3240., .84400,1130.,-130., 110., 110.,   0.
+     *,3240., .88300,1330., 120.,-120., 110.,   0.
+     *,3240., .92200,1330., 110., 110., 110.,   0.
+     *,3240., .96100,2330., 120., 120.,-120.,   0.
+     *,3240.,1.00000,2330., 120., 110., 110.,   0.
+     *,3340., .07500, -12.,  11.,3331.,   0.,   0.
+     *,3340., .15000, -12.,  11.,3331.,   0.,   0.
+     *,3340., .25000,1330.,-230.,   0.,   0.,   0.
+     *,3340., .31000,3331., 120.,   0.,   0.,   0.
+     *,3340., .37000,1331.,-230.,   0.,   0.,   0.
+     *,3340., .43000,1330.,-231.,   0.,   0.,   0.
+     *,3340., .49000,2330.,-230., 120.,   0.,   0.
+     *,3340., .55000,1330.,-230., 110.,   0.,   0.
+     *,3340., .61000,1330.,-130., 120.,   0.,   0.
+     *,3340., .67500,3331., 120., 120.,-120.,   0.
+     *,3340., .74000,3331., 120., 110., 110.,   0.
+     *,3340., .80500,1330.,-230., 120.,-120.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=487,504)/
+     * 3340., .87000,1330.,-230., 110., 110.,   0.
+     *,3340., .93500,2330.,-230., 120., 110.,   0.
+     *,3340.,1.00000,2330.,-130., 120., 120.,   0.
+     *,1141.,1.00000,2140., 120.,   0.,   0.,   0.
+     *,1241.,1.00000,2140., 110.,   0.,   0.,   0.
+     *,2241.,1.00000,2140.,-120.,   0.,   0.,   0.
+     *,1341., .66670,2340., 120.,   0.,   0.,   0.
+     *,1341.,1.00000,1340., 110.,   0.,   0.,   0.
+     *,2341., .66670,1340.,-120.,   0.,   0.,   0.
+     *,2341.,1.00000,2340., 110.,   0.,   0.,   0.
+     *,3341.,1.00000,3340., 110.,   0.,   0.,   0.
+     *,1150., .06000,  12., -11.,1140.,   0.,   0.
+     *,1150., .12000,  12., -11.,1141.,   0.,   0.
+     *,1150., .18000,  14., -13.,1140.,   0.,   0.
+     *,1150., .24000,  14., -13.,1141.,   0.,   0.
+     *,1150., .25500,  16., -15.,1140.,   0.,   0.
+     *,1150., .27000,  16., -15.,1141.,   0.,   0.
+     *,1150., .28925,1140.,-120.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=505,522)/
+     * 1150., .30850,1140.,-121.,   0.,   0.,   0.
+     *,1150., .32775,1141.,-120.,   0.,   0.,   0.
+     *,1150., .34700,1141.,-121.,   0.,   0.,   0.
+     *,1150., .35775,1140., 340.,   0.,   0.,   0.
+     *,1150., .36850,1140., 341.,   0.,   0.,   0.
+     *,1150., .37925,1141., 340.,   0.,   0.,   0.
+     *,1150., .39000,1141., 341.,   0.,   0.,   0.
+     *,1150., .42050,1140.,-120., 110.,   0.,   0.
+     *,1150., .45100,1140.,-120., 220.,   0.,   0.
+     *,1150., .48150,1140.,-120., 111.,   0.,   0.
+     *,1150., .51200,1140.,-120., 221.,   0.,   0.
+     *,1150., .54250,1140.,-121., 110.,   0.,   0.
+     *,1150., .57300,1140.,-121., 220.,   0.,   0.
+     *,1150., .60350,1140.,-121., 111.,   0.,   0.
+     *,1150., .63400,1140.,-121., 221.,   0.,   0.
+     *,1150., .66450,1141.,-120., 110.,   0.,   0.
+     *,1150., .69500,1141.,-120., 220.,   0.,   0.
+     *,1150., .72550,1141.,-120., 111.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=523,540)/
+     * 1150., .75600,1141.,-120., 221.,   0.,   0.
+     *,1150., .78650,1141.,-121., 110.,   0.,   0.
+     *,1150., .81700,1141.,-121., 220.,   0.,   0.
+     *,1150., .84750,1141.,-121., 111.,   0.,   0.
+     *,1150., .87800,1141.,-121., 221.,   0.,   0.
+     *,1150., .89325,1140.,-130., 230.,   0.,   0.
+     *,1150., .90850,1140.,-130., 231.,   0.,   0.
+     *,1150., .92375,1140.,-131., 230.,   0.,   0.
+     *,1150., .93900,1140.,-131., 231.,   0.,   0.
+     *,1150., .95425,1141.,-130., 230.,   0.,   0.
+     *,1150., .96950,1141.,-130., 231.,   0.,   0.
+     *,1150., .98475,1141.,-131., 230.,   0.,   0.
+     *,1150.,1.00000,1141.,-131., 231.,   0.,   0.
+     *,1250., .06000,  12., -11.,1240.,   0.,   0.
+     *,1250., .12000,  12., -11.,1241.,   0.,   0.
+     *,1250., .18000,  14., -13.,1240.,   0.,   0.
+     *,1250., .24000,  14., -13.,1241.,   0.,   0.
+     *,1250., .25500,  16., -15.,1240.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=541,558)/
+     * 1250., .27000,  16., -15.,1241.,   0.,   0.
+     *,1250., .28925,1240.,-120.,   0.,   0.,   0.
+     *,1250., .30850,1240.,-121.,   0.,   0.,   0.
+     *,1250., .32775,1241.,-120.,   0.,   0.,   0.
+     *,1250., .34700,1241.,-121.,   0.,   0.,   0.
+     *,1250., .35775,1240., 340.,   0.,   0.,   0.
+     *,1250., .36850,1240., 341.,   0.,   0.,   0.
+     *,1250., .37925,1241., 340.,   0.,   0.,   0.
+     *,1250., .39000,1241., 341.,   0.,   0.,   0.
+     *,1250., .42050,1240.,-120., 110.,   0.,   0.
+     *,1250., .45100,1240.,-120., 220.,   0.,   0.
+     *,1250., .48150,1240.,-120., 111.,   0.,   0.
+     *,1250., .51200,1240.,-120., 221.,   0.,   0.
+     *,1250., .54250,1240.,-121., 110.,   0.,   0.
+     *,1250., .57300,1240.,-121., 220.,   0.,   0.
+     *,1250., .60350,1240.,-121., 111.,   0.,   0.
+     *,1250., .63400,1240.,-121., 221.,   0.,   0.
+     *,1250., .66450,1241.,-120., 110.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=559,576)/
+     * 1250., .69500,1241.,-120., 220.,   0.,   0.
+     *,1250., .72550,1241.,-120., 111.,   0.,   0.
+     *,1250., .75600,1241.,-120., 221.,   0.,   0.
+     *,1250., .78650,1241.,-121., 110.,   0.,   0.
+     *,1250., .81700,1241.,-121., 220.,   0.,   0.
+     *,1250., .84750,1241.,-121., 111.,   0.,   0.
+     *,1250., .87800,1241.,-121., 221.,   0.,   0.
+     *,1250., .89325,1240.,-130., 230.,   0.,   0.
+     *,1250., .90850,1240.,-130., 231.,   0.,   0.
+     *,1250., .92375,1240.,-131., 230.,   0.,   0.
+     *,1250., .93900,1240.,-131., 231.,   0.,   0.
+     *,1250., .95425,1241.,-130., 230.,   0.,   0.
+     *,1250., .96950,1241.,-130., 231.,   0.,   0.
+     *,1250., .98475,1241.,-131., 230.,   0.,   0.
+     *,1250.,1.00000,1241.,-131., 231.,   0.,   0.
+     *,1350., .06000,  12., -11.,1340.,   0.,   0.
+     *,1350., .12000,  12., -11.,1341.,   0.,   0.
+     *,1350., .18000,  14., -13.,1340.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=577,594)/
+     * 1350., .24000,  14., -13.,1341.,   0.,   0.
+     *,1350., .25500,  16., -15.,1340.,   0.,   0.
+     *,1350., .27000,  16., -15.,1341.,   0.,   0.
+     *,1350., .28925,1340.,-120.,   0.,   0.,   0.
+     *,1350., .30850,1340.,-121.,   0.,   0.,   0.
+     *,1350., .32775,1341.,-120.,   0.,   0.,   0.
+     *,1350., .34700,1341.,-121.,   0.,   0.,   0.
+     *,1350., .35775,1340., 340.,   0.,   0.,   0.
+     *,1350., .36850,1340., 341.,   0.,   0.,   0.
+     *,1350., .37925,1341., 340.,   0.,   0.,   0.
+     *,1350., .39000,1341., 341.,   0.,   0.,   0.
+     *,1350., .42050,1340.,-120., 110.,   0.,   0.
+     *,1350., .45100,1340.,-120., 220.,   0.,   0.
+     *,1350., .48150,1340.,-120., 111.,   0.,   0.
+     *,1350., .51200,1340.,-120., 221.,   0.,   0.
+     *,1350., .54250,1340.,-121., 110.,   0.,   0.
+     *,1350., .57300,1340.,-121., 220.,   0.,   0.
+     *,1350., .60350,1340.,-121., 111.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=595,612)/
+     * 1350., .63400,1340.,-121., 221.,   0.,   0.
+     *,1350., .66450,1341.,-120., 110.,   0.,   0.
+     *,1350., .69500,1341.,-120., 220.,   0.,   0.
+     *,1350., .72550,1341.,-120., 111.,   0.,   0.
+     *,1350., .75600,1341.,-120., 221.,   0.,   0.
+     *,1350., .78650,1341.,-121., 110.,   0.,   0.
+     *,1350., .81700,1341.,-121., 220.,   0.,   0.
+     *,1350., .84750,1341.,-121., 111.,   0.,   0.
+     *,1350., .87800,1341.,-121., 221.,   0.,   0.
+     *,1350., .89325,1340.,-130., 230.,   0.,   0.
+     *,1350., .90850,1340.,-130., 231.,   0.,   0.
+     *,1350., .92375,1340.,-131., 230.,   0.,   0.
+     *,1350., .93900,1340.,-131., 231.,   0.,   0.
+     *,1350., .95425,1341.,-130., 230.,   0.,   0.
+     *,1350., .96950,1341.,-130., 231.,   0.,   0.
+     *,1350., .98475,1341.,-131., 230.,   0.,   0.
+     *,1350.,1.00000,1341.,-131., 231.,   0.,   0.
+     *,2150., .06000,  12., -11.,2140.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=613,630)/
+     * 2150., .12000,  12., -11.,1241.,   0.,   0.
+     *,2150., .18000,  14., -13.,2140.,   0.,   0.
+     *,2150., .24000,  14., -13.,1241.,   0.,   0.
+     *,2150., .25500,  16., -15.,2140.,   0.,   0.
+     *,2150., .27000,  16., -15.,1241.,   0.,   0.
+     *,2150., .28925,2140.,-120.,   0.,   0.,   0.
+     *,2150., .30850,2140.,-121.,   0.,   0.,   0.
+     *,2150., .32775,1241.,-120.,   0.,   0.,   0.
+     *,2150., .34700,1241.,-121.,   0.,   0.,   0.
+     *,2150., .35775,2140., 340.,   0.,   0.,   0.
+     *,2150., .36850,2140., 341.,   0.,   0.,   0.
+     *,2150., .37925,1241., 340.,   0.,   0.,   0.
+     *,2150., .39000,1241., 341.,   0.,   0.,   0.
+     *,2150., .42050,2140.,-120., 110.,   0.,   0.
+     *,2150., .45100,2140.,-120., 220.,   0.,   0.
+     *,2150., .48150,2140.,-120., 111.,   0.,   0.
+     *,2150., .51200,2140.,-120., 221.,   0.,   0.
+     *,2150., .54250,2140.,-121., 110.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=631,648)/
+     * 2150., .57300,2140.,-121., 220.,   0.,   0.
+     *,2150., .60350,2140.,-121., 111.,   0.,   0.
+     *,2150., .63400,2140.,-121., 221.,   0.,   0.
+     *,2150., .66450,1241.,-120., 110.,   0.,   0.
+     *,2150., .69500,1241.,-120., 220.,   0.,   0.
+     *,2150., .72550,1241.,-120., 111.,   0.,   0.
+     *,2150., .75600,1241.,-120., 221.,   0.,   0.
+     *,2150., .78650,1241.,-121., 110.,   0.,   0.
+     *,2150., .81700,1241.,-121., 220.,   0.,   0.
+     *,2150., .84750,1241.,-121., 111.,   0.,   0.
+     *,2150., .87800,1241.,-121., 221.,   0.,   0.
+     *,2150., .89325,2140.,-130., 230.,   0.,   0.
+     *,2150., .90850,2140.,-130., 231.,   0.,   0.
+     *,2150., .92375,2140.,-131., 230.,   0.,   0.
+     *,2150., .93900,2140.,-131., 231.,   0.,   0.
+     *,2150., .95425,1241.,-130., 230.,   0.,   0.
+     *,2150., .96950,1241.,-130., 231.,   0.,   0.
+     *,2150., .98475,1241.,-131., 230.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=649,666)/
+     * 2150.,1.00000,1241.,-131., 231.,   0.,   0.
+     *,2250., .06000,  12., -11.,2240.,   0.,   0.
+     *,2250., .12000,  12., -11.,2241.,   0.,   0.
+     *,2250., .18000,  14., -13.,2240.,   0.,   0.
+     *,2250., .24000,  14., -13.,2241.,   0.,   0.
+     *,2250., .25500,  16., -15.,2240.,   0.,   0.
+     *,2250., .27000,  16., -15.,2241.,   0.,   0.
+     *,2250., .28925,2240.,-120.,   0.,   0.,   0.
+     *,2250., .30850,2240.,-121.,   0.,   0.,   0.
+     *,2250., .32775,2241.,-120.,   0.,   0.,   0.
+     *,2250., .34700,2241.,-121.,   0.,   0.,   0.
+     *,2250., .35775,2240., 340.,   0.,   0.,   0.
+     *,2250., .36850,2240., 341.,   0.,   0.,   0.
+     *,2250., .37925,2241., 340.,   0.,   0.,   0.
+     *,2250., .39000,2241., 341.,   0.,   0.,   0.
+     *,2250., .42050,2240.,-120., 110.,   0.,   0.
+     *,2250., .45100,2240.,-120., 220.,   0.,   0.
+     *,2250., .48150,2240.,-120., 111.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=667,684)/
+     * 2250., .51200,2240.,-120., 221.,   0.,   0.
+     *,2250., .54250,2240.,-121., 110.,   0.,   0.
+     *,2250., .57300,2240.,-121., 220.,   0.,   0.
+     *,2250., .60350,2240.,-121., 111.,   0.,   0.
+     *,2250., .63400,2240.,-121., 221.,   0.,   0.
+     *,2250., .66450,2241.,-120., 110.,   0.,   0.
+     *,2250., .69500,2241.,-120., 220.,   0.,   0.
+     *,2250., .72550,2241.,-120., 111.,   0.,   0.
+     *,2250., .75600,2241.,-120., 221.,   0.,   0.
+     *,2250., .78650,2241.,-121., 110.,   0.,   0.
+     *,2250., .81700,2241.,-121., 220.,   0.,   0.
+     *,2250., .84750,2241.,-121., 111.,   0.,   0.
+     *,2250., .87800,2241.,-121., 221.,   0.,   0.
+     *,2250., .89325,2240.,-130., 230.,   0.,   0.
+     *,2250., .90850,2240.,-130., 231.,   0.,   0.
+     *,2250., .92375,2240.,-131., 230.,   0.,   0.
+     *,2250., .93900,2240.,-131., 231.,   0.,   0.
+     *,2250., .95425,2241.,-130., 230.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=685,702)/
+     * 2250., .96950,2241.,-130., 231.,   0.,   0.
+     *,2250., .98475,2241.,-131., 230.,   0.,   0.
+     *,2250.,1.00000,2241.,-131., 231.,   0.,   0.
+     *,2350., .06000,  12., -11.,2340.,   0.,   0.
+     *,2350., .12000,  12., -11.,2341.,   0.,   0.
+     *,2350., .18000,  14., -13.,2340.,   0.,   0.
+     *,2350., .24000,  14., -13.,2341.,   0.,   0.
+     *,2350., .25500,  16., -15.,2340.,   0.,   0.
+     *,2350., .27000,  16., -15.,2341.,   0.,   0.
+     *,2350., .28925,2340.,-120.,   0.,   0.,   0.
+     *,2350., .30850,2340.,-121.,   0.,   0.,   0.
+     *,2350., .32775,2341.,-120.,   0.,   0.,   0.
+     *,2350., .34700,2341.,-121.,   0.,   0.,   0.
+     *,2350., .35775,2340., 340.,   0.,   0.,   0.
+     *,2350., .36850,2340., 341.,   0.,   0.,   0.
+     *,2350., .37925,2341., 340.,   0.,   0.,   0.
+     *,2350., .39000,2341., 341.,   0.,   0.,   0.
+     *,2350., .42050,2340.,-120., 110.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=703,720)/
+     * 2350., .45100,2340.,-120., 220.,   0.,   0.
+     *,2350., .48150,2340.,-120., 111.,   0.,   0.
+     *,2350., .51200,2340.,-120., 221.,   0.,   0.
+     *,2350., .54250,2340.,-121., 110.,   0.,   0.
+     *,2350., .57300,2340.,-121., 220.,   0.,   0.
+     *,2350., .60350,2340.,-121., 111.,   0.,   0.
+     *,2350., .63400,2340.,-121., 221.,   0.,   0.
+     *,2350., .66450,2341.,-120., 110.,   0.,   0.
+     *,2350., .69500,2341.,-120., 220.,   0.,   0.
+     *,2350., .72550,2341.,-120., 111.,   0.,   0.
+     *,2350., .75600,2341.,-120., 221.,   0.,   0.
+     *,2350., .78650,2341.,-121., 110.,   0.,   0.
+     *,2350., .81700,2341.,-121., 220.,   0.,   0.
+     *,2350., .84750,2341.,-121., 111.,   0.,   0.
+     *,2350., .87800,2341.,-121., 221.,   0.,   0.
+     *,2350., .89325,2340.,-130., 230.,   0.,   0.
+     *,2350., .90850,2340.,-130., 231.,   0.,   0.
+     *,2350., .92375,2340.,-131., 230.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=721,738)/
+     * 2350., .93900,2340.,-131., 231.,   0.,   0.
+     *,2350., .95425,2341.,-130., 230.,   0.,   0.
+     *,2350., .96950,2341.,-130., 231.,   0.,   0.
+     *,2350., .98475,2341.,-131., 230.,   0.,   0.
+     *,2350.,1.00000,2341.,-131., 231.,   0.,   0.
+     *,3150., .06000,  12., -11.,3140.,   0.,   0.
+     *,3150., .12000,  12., -11.,1341.,   0.,   0.
+     *,3150., .18000,  14., -13.,3140.,   0.,   0.
+     *,3150., .24000,  14., -13.,1341.,   0.,   0.
+     *,3150., .25500,  16., -15.,3140.,   0.,   0.
+     *,3150., .27000,  16., -15.,1341.,   0.,   0.
+     *,3150., .28925,3140.,-120.,   0.,   0.,   0.
+     *,3150., .30850,3140.,-121.,   0.,   0.,   0.
+     *,3150., .32775,1341.,-120.,   0.,   0.,   0.
+     *,3150., .34700,1341.,-121.,   0.,   0.,   0.
+     *,3150., .35775,3140., 340.,   0.,   0.,   0.
+     *,3150., .36850,3140., 341.,   0.,   0.,   0.
+     *,3150., .37925,1341., 340.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=739,756)/
+     * 3150., .39000,1341., 341.,   0.,   0.,   0.
+     *,3150., .42050,3140.,-120., 110.,   0.,   0.
+     *,3150., .45100,3140.,-120., 220.,   0.,   0.
+     *,3150., .48150,3140.,-120., 111.,   0.,   0.
+     *,3150., .51200,3140.,-120., 221.,   0.,   0.
+     *,3150., .54250,3140.,-121., 110.,   0.,   0.
+     *,3150., .57300,3140.,-121., 220.,   0.,   0.
+     *,3150., .60350,3140.,-121., 111.,   0.,   0.
+     *,3150., .63400,3140.,-121., 221.,   0.,   0.
+     *,3150., .66450,1341.,-120., 110.,   0.,   0.
+     *,3150., .69500,1341.,-120., 220.,   0.,   0.
+     *,3150., .72550,1341.,-120., 111.,   0.,   0.
+     *,3150., .75600,1341.,-120., 221.,   0.,   0.
+     *,3150., .78650,1341.,-121., 110.,   0.,   0.
+     *,3150., .81700,1341.,-121., 220.,   0.,   0.
+     *,3150., .84750,1341.,-121., 111.,   0.,   0.
+     *,3150., .87800,1341.,-121., 221.,   0.,   0.
+     *,3150., .89325,3140.,-130., 230.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=757,774)/
+     * 3150., .90850,3140.,-130., 231.,   0.,   0.
+     *,3150., .92375,3140.,-131., 230.,   0.,   0.
+     *,3150., .93900,3140.,-131., 231.,   0.,   0.
+     *,3150., .95425,1341.,-130., 230.,   0.,   0.
+     *,3150., .96950,1341.,-130., 231.,   0.,   0.
+     *,3150., .98475,1341.,-131., 230.,   0.,   0.
+     *,3150.,1.00000,1341.,-131., 231.,   0.,   0.
+     *,3250., .06000,  12., -11.,3240.,   0.,   0.
+     *,3250., .12000,  12., -11.,2341.,   0.,   0.
+     *,3250., .18000,  14., -13.,3240.,   0.,   0.
+     *,3250., .24000,  14., -13.,2341.,   0.,   0.
+     *,3250., .25500,  16., -15.,3240.,   0.,   0.
+     *,3250., .27000,  16., -15.,2341.,   0.,   0.
+     *,3250., .28925,3240.,-120.,   0.,   0.,   0.
+     *,3250., .30850,3240.,-121.,   0.,   0.,   0.
+     *,3250., .32775,2341.,-120.,   0.,   0.,   0.
+     *,3250., .34700,2341.,-121.,   0.,   0.,   0.
+     *,3250., .35775,3240., 340.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=775,792)/
+     * 3250., .36850,3240., 341.,   0.,   0.,   0.
+     *,3250., .37925,2341., 340.,   0.,   0.,   0.
+     *,3250., .39000,2341., 341.,   0.,   0.,   0.
+     *,3250., .42050,3240.,-120., 110.,   0.,   0.
+     *,3250., .45100,3240.,-120., 220.,   0.,   0.
+     *,3250., .48150,3240.,-120., 111.,   0.,   0.
+     *,3250., .51200,3240.,-120., 221.,   0.,   0.
+     *,3250., .54250,3240.,-121., 110.,   0.,   0.
+     *,3250., .57300,3240.,-121., 220.,   0.,   0.
+     *,3250., .60350,3240.,-121., 111.,   0.,   0.
+     *,3250., .63400,3240.,-121., 221.,   0.,   0.
+     *,3250., .66450,2341.,-120., 110.,   0.,   0.
+     *,3250., .69500,2341.,-120., 220.,   0.,   0.
+     *,3250., .72550,2341.,-120., 111.,   0.,   0.
+     *,3250., .75600,2341.,-120., 221.,   0.,   0.
+     *,3250., .78650,2341.,-121., 110.,   0.,   0.
+     *,3250., .81700,2341.,-121., 220.,   0.,   0.
+     *,3250., .84750,2341.,-121., 111.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=793,810)/
+     * 3250., .87800,2341.,-121., 221.,   0.,   0.
+     *,3250., .89325,3240.,-130., 230.,   0.,   0.
+     *,3250., .90850,3240.,-130., 231.,   0.,   0.
+     *,3250., .92375,3240.,-131., 230.,   0.,   0.
+     *,3250., .93900,3240.,-131., 231.,   0.,   0.
+     *,3250., .95425,2341.,-130., 230.,   0.,   0.
+     *,3250., .96950,2341.,-130., 231.,   0.,   0.
+     *,3250., .98475,2341.,-131., 230.,   0.,   0.
+     *,3250.,1.00000,2341.,-131., 231.,   0.,   0.
+     *,3350., .06000,  12., -11.,3340.,   0.,   0.
+     *,3350., .12000,  12., -11.,3341.,   0.,   0.
+     *,3350., .18000,  14., -13.,3340.,   0.,   0.
+     *,3350., .24000,  14., -13.,3341.,   0.,   0.
+     *,3350., .25500,  16., -15.,3340.,   0.,   0.
+     *,3350., .27000,  16., -15.,3341.,   0.,   0.
+     *,3350., .28925,3340.,-120.,   0.,   0.,   0.
+     *,3350., .30850,3340.,-121.,   0.,   0.,   0.
+     *,3350., .32775,3341.,-120.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=811,828)/
+     * 3350., .34700,3341.,-121.,   0.,   0.,   0.
+     *,3350., .35775,3340., 340.,   0.,   0.,   0.
+     *,3350., .36850,3340., 341.,   0.,   0.,   0.
+     *,3350., .37925,3341., 340.,   0.,   0.,   0.
+     *,3350., .39000,3341., 341.,   0.,   0.,   0.
+     *,3350., .42050,3340.,-120., 110.,   0.,   0.
+     *,3350., .45100,3340.,-120., 220.,   0.,   0.
+     *,3350., .48150,3340.,-120., 111.,   0.,   0.
+     *,3350., .51200,3340.,-120., 221.,   0.,   0.
+     *,3350., .54250,3340.,-121., 110.,   0.,   0.
+     *,3350., .57300,3340.,-121., 220.,   0.,   0.
+     *,3350., .60350,3340.,-121., 111.,   0.,   0.
+     *,3350., .63400,3340.,-121., 221.,   0.,   0.
+     *,3350., .66450,3341.,-120., 110.,   0.,   0.
+     *,3350., .69500,3341.,-120., 220.,   0.,   0.
+     *,3350., .72550,3341.,-120., 111.,   0.,   0.
+     *,3350., .75600,3341.,-120., 221.,   0.,   0.
+     *,3350., .78650,3341.,-121., 110.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=829,846)/
+     * 3350., .81700,3341.,-121., 220.,   0.,   0.
+     *,3350., .84750,3341.,-121., 111.,   0.,   0.
+     *,3350., .87800,3341.,-121., 221.,   0.,   0.
+     *,3350., .89325,3340.,-130., 230.,   0.,   0.
+     *,3350., .90850,3340.,-130., 231.,   0.,   0.
+     *,3350., .92375,3340.,-131., 230.,   0.,   0.
+     *,3350., .93900,3340.,-131., 231.,   0.,   0.
+     *,3350., .95425,3341.,-130., 230.,   0.,   0.
+     *,3350., .96950,3341.,-130., 231.,   0.,   0.
+     *,3350., .98475,3341.,-131., 230.,   0.,   0.
+     *,3350.,1.00000,3341.,-131., 231.,   0.,   0.
+     *,1160., .33300,   1.,  -2.,1500.,   0.,   0.
+     *,1160., .66700,   4.,  -3.,1500.,   0.,   0.
+     *,1160., .77800, -12.,  11.,1500.,   0.,   0.
+     *,1160., .88900, -14.,  13.,1500.,   0.,   0.
+     *,1160.,1.00000, -16.,  15.,1500.,   0.,   0.
+     *,1260., .33300,   1.,  -2.,2500.,   0.,   0.
+     *,1260., .66700,   4.,  -3.,2500.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=847,864)/
+     * 1260., .77800, -12.,  11.,2500.,   0.,   0.
+     *,1260., .88900, -14.,  13.,2500.,   0.,   0.
+     *,1260.,1.00000, -16.,  15.,2500.,   0.,   0.
+     *,2260., .33300,   1.,  -2.,2500.,   0.,   0.
+     *,2260., .66700,   4.,  -3.,2500.,   0.,   0.
+     *,2260., .77800, -12.,  11.,2500.,   0.,   0.
+     *,2260., .88900, -14.,  13.,2500.,   0.,   0.
+     *,2260.,1.00000, -16.,  15.,2500.,   0.,   0.
+     *,2160., .33300,   1.,  -2.,1500.,   0.,   0.
+     *,2160., .66700,   4.,  -3.,1500.,   0.,   0.
+     *,2160., .77800, -12.,  11.,1500.,   0.,   0.
+     *,2160., .88900, -14.,  13.,1500.,   0.,   0.
+     *,2160.,1.00000, -16.,  15.,1500.,   0.,   0.
+     *,1360., .33300,   1.,  -2.,3500.,   0.,   0.
+     *,1360., .66700,   4.,  -3.,3500.,   0.,   0.
+     *,1360., .77800, -12.,  11.,3500.,   0.,   0.
+     *,1360., .88900, -14.,  13.,3500.,   0.,   0.
+     *,1360.,1.00000, -16.,  15.,3500.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=865,882)/
+     * 2360., .33300,   1.,  -2.,3500.,   0.,   0.
+     *,2360., .66700,   4.,  -3.,3500.,   0.,   0.
+     *,2360., .77800, -12.,  11.,3500.,   0.,   0.
+     *,2360., .88900, -14.,  13.,3500.,   0.,   0.
+     *,2360.,1.00000, -16.,  15.,3500.,   0.,   0.
+     *,3360., .33300,   1.,  -2.,3500.,   0.,   0.
+     *,3360., .66700,   4.,  -3.,3500.,   0.,   0.
+     *,3360., .77800, -12.,  11.,3500.,   0.,   0.
+     *,3360., .88900, -14.,  13.,3500.,   0.,   0.
+     *,3360.,1.00000, -16.,  15.,3500.,   0.,   0.
+     *,1151.,1.00000,1150.,  10.,   0.,   0.,   0.
+     *,1251.,1.00000,1250.,  10.,   0.,   0.,   0.
+     *,2251.,1.00000,2250.,  10.,   0.,   0.,   0.
+     *,1351.,1.00000,1350.,  10.,   0.,   0.,   0.
+     *,2351.,1.00000,2350.,  10.,   0.,   0.,   0.
+     *,3351.,1.00000,3350.,  10.,   0.,   0.,   0.
+     *,1161.,1.00000,1160.,  10.,   0.,   0.,   0.
+     *,1261.,1.00000,1260.,  10.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=883,886)/
+     * 2261.,1.00000,2260.,  10.,   0.,   0.,   0.
+     *,1361.,1.00000,1360.,  10.,   0.,   0.,   0.
+     *,2361.,1.00000,2360.,  10.,   0.,   0.,   0.
+     *,3361.,1.00000,3360.,  10.,   0.,   0.,   0./
+C    *---------------------------------------------
+C    *    DELTA++ RESONANCES
+C    *---------------------------------------------
+      DATA ((DECTAB(I,J),I=1,7),J=887,900)/
+C    *--DL++(1620)---------------------------------
+     * 1112., .30000,1120., 120.,   0.,   0.,   0.
+     *,1112., .66000,1111., 110.,   0.,   0.,   0.
+     *,1112., .90000,1121., 120.,   0.,   0.,   0.
+     *,1112.,1.00000,1120., 120., 110.,   0.,   0.
+C    *--DL++(1700)---------------------------------
+     *,1113., .15000,1120., 120.,   0.,   0.,   0.
+     *,1113., .51000,1111., 110.,   0.,   0.,   0.
+     *,1113., .75000,1121., 120.,   0.,   0.,   0.
+     *,1113.,1.00000,1120., 120., 110.,   0.,   0.
+C    *--DL++(1925)---------------------------------
+     *,1114., .28000,1120., 120.,   0.,   0.,   0.
+     *,1114., .40600,1111., 110.,   0.,   0.,   0.
+     *,1114., .49000,1121., 120.,   0.,   0.,   0.
+     *,1114., .69000,1120., 121.,   0.,   0.,   0.
+     *,1114., .70000,1130., 130.,   0.,   0.,   0.
+     *,1114.,1.00000,1122., 120.,   0.,   0.,   0./
+C    *---------------------------------------------
+C    *    DELTA- RESONANCES
+C    *---------------------------------------------
+      DATA ((DECTAB(I,J),I=1,7),J=901,914)/
+C    *--DL-(1620)----------------------------------
+     * 2222., .30000,1220.,-120.,   0.,   0.,   0.
+     *,2222., .66000,2221., 110.,   0.,   0.,   0.
+     *,2222., .90000,1221.,-120.,   0.,   0.,   0.
+     *,2222.,1.00000,1220., 110.,-120.,   0.,   0.
+C    *--DL-(1700)----------------------------------
+     *,2223., .15000,1220.,-120.,   0.,   0.,   0.
+     *,2223., .51000,2221., 110.,   0.,   0.,   0.
+     *,2223., .75000,1221.,-120.,   0.,   0.,   0.
+     *,2223.,1.00000,1220., 110.,-120.,   0.,   0.
+C    *--DL-(1925)----------------------------------
+     *,2224., .28000,1220.,-120.,   0.,   0.,   0.
+     *,2224., .40600,2221., 110.,   0.,   0.,   0.
+     *,2224., .49000,1221.,-120.,   0.,   0.,   0.
+     *,2224., .69000,1220.,-121.,   0.,   0.,   0.
+     *,2224., .70000,2230., 230.,   0.,   0.,   0.
+     *,2224.,1.00000,1222.,-120.,   0.,   0.,   0./
+C    *---------------------------------------------
+C    *    N*+ RESONANCES + DELTA+ RESONANCES
+C    *---------------------------------------------
+      DATA ((DECTAB(I,J),I=1,7),J=915,931)/
+C    *--N*+(1440)----------------------------------
+     * 1122., .20000,1120., 110.,   0.,   0.,   0.
+     *,1122., .60000,1220., 120.,   0.,   0.,   0.
+     *,1122., .68000,1111.,-120.,   0.,   0.,   0.
+     *,1122., .73000,1121., 110.,   0.,   0.,   0.
+     *,1122., .76000,1221., 120.,   0.,   0.,   0.
+     *,1122., .84000,1120., 120.,-120.,   0.,   0.
+     *,1122., .87000,1120., 110., 110.,   0.,   0.
+     *,1122.,1.00000,1220., 120., 110.,   0.,   0.
+C    *--N*+(1530)----------------------------------
+     *,1123., .17000,1120., 110.,   0.,   0.,   0.
+     *,1123., .51000,1220., 120.,   0.,   0.,   0.
+     *,1123., .57000,1111.,-120.,   0.,   0.,   0.
+     *,1123., .61000,1121., 110.,   0.,   0.,   0.
+     *,1123., .63000,1221., 120.,   0.,   0.,   0.
+     *,1123., .67000,1120., 120.,-120.,   0.,   0.
+     *,1123., .68000,1120., 110., 110.,   0.,   0.
+     *,1123., .75000,1220., 120., 110.,   0.,   0.
+     *,1123.,1.00000,1120., 220.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=932,948)/
+C    *--DL+(1620)----------------------------------
+     * 1124., .20000,1120., 110.,   0.,   0.,   0.
+     *,1124., .30000,1220., 120.,   0.,   0.,   0.
+     *,1124., .54000,1111.,-120.,   0.,   0.,   0.
+     *,1124., .58000,1121., 110.,   0.,   0.,   0.
+     *,1124., .90000,1221., 120.,   0.,   0.,   0.
+     *,1124., .96000,1120., 120.,-120.,   0.,   0.
+     *,1124.,1.00000,1220., 120., 110.,   0.,   0.
+C    *--N*+(1665)----------------------------------
+     *,1125., .16700,1120., 110.,   0.,   0.,   0.
+     *,1125., .49970,1220., 120.,   0.,   0.,   0.
+     *,1125., .62470,1111.,-120.,   0.,   0.,   0.
+     *,1125., .70800,1121., 110.,   0.,   0.,   0.
+     *,1125., .74970,1221., 120.,   0.,   0.,   0.
+     *,1125., .82080,1120., 120.,-120.,   0.,   0.
+     *,1125., .85190,1120., 110., 110.,   0.,   0.
+     *,1125., .96300,1220., 120., 110.,   0.,   0.
+     *,1125., .97300,1120., 220.,   0.,   0.,   0.
+     *,1125.,1.00000,2130., 130.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=949,955)/
+C    *--DL+(1700)----------------------------------
+     * 1126., .10000,1120., 110.,   0.,   0.,   0.
+     *,1126., .15000,1220., 120.,   0.,   0.,   0.
+     *,1126., .39000,1111.,-120.,   0.,   0.,   0.
+     *,1126., .43000,1121., 110.,   0.,   0.,   0.
+     *,1126., .75000,1221., 120.,   0.,   0.,   0.
+     *,1126., .91500,1120., 120.,-120.,   0.,   0.
+     *,1126.,1.00000,1220., 120., 110.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=956,969)/
+C    *--N*+(1710)----------------------------------
+     * 1127., .04430,1120., 110.,   0.,   0.,   0.
+     *,1127., .13290,1220., 120.,   0.,   0.,   0.
+     *,1127., .23790,1111.,-120.,   0.,   0.,   0.
+     *,1127., .30790,1121., 110.,   0.,   0.,   0.
+     *,1127., .34290,1221., 120.,   0.,   0.,   0.
+     *,1127., .41190,1120., 120.,-120.,   0.,   0.
+     *,1127., .48090,1120., 110., 110.,   0.,   0.
+     *,1127., .54990,1220., 120., 110.,   0.,   0.
+     *,1127., .66070,1120., 220.,   0.,   0.,   0.
+     *,1127., .72800,2130., 130.,   0.,   0.,   0.
+     *,1127., .74930,1230., 130.,   0.,   0.,   0.
+     *,1127., .76000,1130., 230.,   0.,   0.,   0.
+     *,1127., .84000,1120., 111.,   0.,   0.,   0.
+     *,1127.,1.00000,1220., 121.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=970,980)/
+C    *--DL+(1925)----------------------------------
+     * 1128., .18700,1120., 110.,   0.,   0.,   0.
+     *,1128., .28000,1220., 120.,   0.,   0.,   0.
+     *,1128., .36400,1111.,-120.,   0.,   0.,   0.
+     *,1128., .37800,1121., 110.,   0.,   0.,   0.
+     *,1128., .49000,1221., 120.,   0.,   0.,   0.
+     *,1128., .62300,1120., 111.,   0.,   0.,   0.
+     *,1128., .69000,1220., 121.,   0.,   0.,   0.
+     *,1128., .69350,1130., 230.,   0.,   0.,   0.
+     *,1128., .69900,1230., 130.,   0.,   0.,   0.
+     *,1128., .89900,1122., 110.,   0.,   0.,   0.
+     *,1128.,1.00000,1222., 120.,   0.,   0.,   0./
+C    *---------------------------------------------
+C    *    N*0  RESONANCES + DELTA0 RESONANCES
+C    *---------------------------------------------
+      DATA ((DECTAB(I,J),I=1,7),J=981,997)/
+C    *----------N*0(1440)--------------------------
+     * 1222., .20000,1220., 110.,   0.,   0.,   0.
+     *,1222., .60000,1120.,-120.,   0.,   0.,   0.
+     *,1222., .68000,2221., 120.,   0.,   0.,   0.
+     *,1222., .73000,1221., 110.,   0.,   0.,   0.
+     *,1222., .76000,1121.,-120.,   0.,   0.,   0.
+     *,1222., .84000,1220., 120.,-120.,   0.,   0.
+     *,1222., .87000,1220., 110., 110.,   0.,   0.
+     *,1222.,1.00000,1120.,-120., 110.,   0.,   0.
+C    *----------N*0(1530)--------------------------
+     *,1223., .17000,1220., 110.,   0.,   0.,   0.
+     *,1223., .51000,1120.,-120.,   0.,   0.,   0.
+     *,1223., .57000,2221., 120.,   0.,   0.,   0.
+     *,1223., .61000,1221., 110.,   0.,   0.,   0.
+     *,1223., .63000,1121.,-120.,   0.,   0.,   0.
+     *,1223., .67000,1220., 120.,-120.,   0.,   0.
+     *,1223., .68000,1220., 110., 110.,   0.,   0.
+     *,1223., .75000,1120.,-120., 110.,   0.,   0.
+     *,1223.,1.00000,1220., 220.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=998,1014)/
+C    *----------DL0(1620)--------------------------
+     * 1224., .20000,1220., 110.,   0.,   0.,   0.
+     *,1224., .30000,1120.,-120.,   0.,   0.,   0.
+     *,1224., .54000,2221., 120.,   0.,   0.,   0.
+     *,1224., .58000,1221., 110.,   0.,   0.,   0.
+     *,1224., .90000,1121.,-120.,   0.,   0.,   0.
+     *,1224., .96500,1220., 120.,-120.,   0.,   0.
+     *,1224.,1.00000,1120.,-120., 110.,   0.,   0.
+C    *----------N*0(1665)--------------------------
+     *,1225., .16700,1220., 110.,   0.,   0.,   0.
+     *,1225., .49970,1120.,-120.,   0.,   0.,   0.
+     *,1225., .62470,2221., 120.,   0.,   0.,   0.
+     *,1225., .70800,1221., 110.,   0.,   0.,   0.
+     *,1225., .74970,1121.,-120.,   0.,   0.,   0.
+     *,1225., .82080,1220., 120.,-120.,   0.,   0.
+     *,1225., .85190,1220., 110., 110.,   0.,   0.
+     *,1225., .96300,1120.,-120., 110.,   0.,   0.
+     *,1225., .97300,1220., 220.,   0.,   0.,   0.
+     *,1225.,1.00000,2130., 230.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=1015,1021)/
+C    *----------DL0(1700)--------------------------
+     * 1226., .10000,1220., 110.,   0.,   0.,   0.
+     *,1226., .15000,1120.,-120.,   0.,   0.,   0.
+     *,1226., .39000,2221., 120.,   0.,   0.,   0.
+     *,1226., .43000,1221., 110.,   0.,   0.,   0.
+     *,1226., .75000,1121.,-120.,   0.,   0.,   0.
+     *,1226., .91500,1220., 120.,-120.,   0.,   0.
+     *,1226.,1.00000,1120.,-120., 110.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=1022,1035)/
+C    *----------N*0(1710)--------------------------
+     * 1227., .04430,1220., 110.,   0.,   0.,   0.
+     *,1227., .13290,1120.,-120.,   0.,   0.,   0.
+     *,1227., .23790,2221., 120.,   0.,   0.,   0.
+     *,1227., .30790,1221., 110.,   0.,   0.,   0.
+     *,1227., .34290,1121.,-120.,   0.,   0.,   0.
+     *,1227., .41190,1220., 120.,-120.,   0.,   0.
+     *,1227., .48090,1220., 110., 110.,   0.,   0.
+     *,1227., .54990,1120.,-120., 110.,   0.,   0.
+     *,1227., .66070,1220., 220.,   0.,   0.,   0.
+     *,1227., .72800,2130., 230.,   0.,   0.,   0.
+     *,1227., .73870,1230., 230.,   0.,   0.,   0.
+     *,1227., .76000,2230., 130.,   0.,   0.,   0.
+     *,1227., .92000,1120.,-121.,   0.,   0.,   0.
+     *,1227.,1.00000,1220., 111.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=1036,1046)/
+C    *----------DL0(1925)--------------------------
+     * 1228., .18700,1220., 110.,   0.,   0.,   0.
+     *,1228., .28000,1120.,-120.,   0.,   0.,   0.
+     *,1228., .36400,2221., 120.,   0.,   0.,   0.
+     *,1228., .37800,1221., 110.,   0.,   0.,   0.
+     *,1228., .49000,1121.,-120.,   0.,   0.,   0.
+     *,1228., .55700,1220., 111.,   0.,   0.,   0.
+     *,1228., .69000,1120.,-121.,   0.,   0.,   0.
+     *,1228., .69350,2230., 130.,   0.,   0.,   0.
+     *,1228., .70000,1230., 230.,   0.,   0.,   0.
+     *,1228., .80000,1122.,-120.,   0.,   0.,   0.
+     *,1228.,1.00000,1222., 110.,   0.,   0.,   0./
+C    *---------------------------------------------
+C    *   LAMBDA RESONANCES + SIGMA0 RESONANCES
+C    *---------------------------------------------
+      DATA ((DECTAB(I,J),I=1,7),J=1047,1059)/
+C    *----------LAMBDA(1405)-----------------------
+     * 1233., .33000,1230., 110.,   0.,   0.,   0.
+     *,1233., .66000,2230., 120.,   0.,   0.,   0.
+     *,1233.,1.00000,1130.,-120.,   0.,   0.,   0.
+C    *----------LAMBDA(1520)-----------------------
+     *,1234., .22500,1120.,-130.,   0.,   0.,   0.
+     *,1234., .48000,1220.,-230.,   0.,   0.,   0.
+     *,1234., .62000,1230., 110.,   0.,   0.,   0.
+     *,1234., .76000,2230., 120.,   0.,   0.,   0.
+     *,1234., .90000,1130.,-120.,   0.,   0.,   0.
+     *,1234., .96000,2130., 120.,-120.,   0.,   0.
+     *,1234., .99000,2130., 110., 110.,   0.,   0.
+     *,1234., .99330,1130.,-120., 110.,   0.,   0.
+     *,1234., .99660,2230., 120., 110.,   0.,   0.
+     *,1234.,1.00000,1230., 120.,-120.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=1060,1075)/
+C    *----------LAMBDA(1645)-----------------------
+     * 1235., .10000,1120.,-130.,   0.,   0.,   0.
+     *,1235., .20000,1220.,-230.,   0.,   0.,   0.
+     *,1235., .35000,1230., 110.,   0.,   0.,   0.
+     *,1235., .50000,2230., 120.,   0.,   0.,   0.
+     *,1235., .65000,1130.,-120.,   0.,   0.,   0.
+     *,1235., .75000,2130., 120.,-120.,   0.,   0.
+     *,1235., .80000,2130., 110., 110.,   0.,   0.
+     *,1235., .84500,1130.,-120., 110.,   0.,   0.
+     *,1235., .89000,2230., 120., 110.,   0.,   0.
+     *,1235., .93500,1230., 120.,-120.,   0.,   0.
+     *,1235.,1.00000,2130., 220.,   0.,   0.,   0.
+C    *----------SIGMA0(1665)-----------------------
+     *,1236., .10000,1120.,-130.,   0.,   0.,   0.
+     *,1236., .20000,1220.,-230.,   0.,   0.,   0.
+     *,1236., .40000,2230., 120.,   0.,   0.,   0.
+     *,1236., .60000,1130.,-120.,   0.,   0.,   0.
+     *,1236.,1.00000,2130., 110.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=1076,1084)/
+C    *----------SIGMA0(1776)-----------------------
+     * 1237., .17500,1120.,-130.,   0.,   0.,   0.
+     *,1237., .35000,1220.,-230.,   0.,   0.,   0.
+     *,1237., .38750,2230., 120.,   0.,   0.,   0.
+     *,1237., .42500,1130.,-120.,   0.,   0.,   0.
+     *,1237., .57500,2130., 110.,   0.,   0.,   0.
+     *,1237., .60000,2231., 120.,   0.,   0.,   0.
+     *,1237., .62500,1131.,-120.,   0.,   0.,   0.
+     *,1237., .75000,1234., 110.,   0.,   0.,   0.
+     *,1237.,1.00000,1230., 220.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=1085,1094)/
+C    *----------LAMBDA(1845)-----------------------
+     * 1238., .17000,1120.,-130.,   0.,   0.,   0.
+     *,1238., .34000,1220.,-230.,   0.,   0.,   0.
+     *,1238., .44000,1230., 110.,   0.,   0.,   0.
+     *,1238., .54000,2230., 120.,   0.,   0.,   0.
+     *,1238., .64000,1130.,-120.,   0.,   0.,   0.
+     *,1238., .70000,1231., 110.,   0.,   0.,   0.
+     *,1238., .76000,2231., 120.,   0.,   0.,   0.
+     *,1238., .82000,1131.,-120.,   0.,   0.,   0.
+     *,1238., .91000,1120.,-131.,   0.,   0.,   0.
+     *,1238.,1.00000,1220.,-231.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=1095,1106)/
+C    *----------SIGMA0(1930)-----------------------
+     * 1239., .07500,1120.,-130.,   0.,   0.,   0.
+     *,1239., .15000,1220.,-230.,   0.,   0.,   0.
+     *,1239., .20000,1121.,-130.,   0.,   0.,   0.
+     *,1239., .25000,1221.,-230.,   0.,   0.,   0.
+     *,1239., .32500,1120.,-131.,   0.,   0.,   0.
+     *,1239., .40000,1220.,-231.,   0.,   0.,   0.
+     *,1239., .47500,2230., 120.,   0.,   0.,   0.
+     *,1239., .55000,1130.,-120.,   0.,   0.,   0.
+     *,1239., .70000,2130., 110.,   0.,   0.,   0.
+     *,1239., .77500,2231., 120.,   0.,   0.,   0.
+     *,1239., .85000,1131.,-120.,   0.,   0.,   0.
+     *,1239.,1.00000,1234., 110.,   0.,   0.,   0./
+C    *---------------------------------------------
+C    *            SIGMA+ RESONANCES
+C    *---------------------------------------------
+      DATA ((DECTAB(I,J),I=1,7),J=1107,1118)/
+C    *----------SIGMA+(1665)-----------------------
+     * 1132., .20000,1120.,-230.,   0.,   0.,   0.
+     *,1132., .40000,1130., 110.,   0.,   0.,   0.
+     *,1132., .60000,1230., 120.,   0.,   0.,   0.
+     *,1132.,1.00000,2130., 120.,   0.,   0.,   0.
+C    *----------SIGMA+(1776)-----------------------
+     *,1133., .35000,1120.,-230.,   0.,   0.,   0.
+     *,1133., .38750,1130., 110.,   0.,   0.,   0.
+     *,1133., .42500,1230., 120.,   0.,   0.,   0.
+     *,1133., .57500,2130., 120.,   0.,   0.,   0.
+     *,1133., .60000,1131., 110.,   0.,   0.,   0.
+     *,1133., .62500,1231., 120.,   0.,   0.,   0.
+     *,1133., .75000,1234., 120.,   0.,   0.,   0.
+     *,1133.,1.00000,1130., 220.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=1119,1128)/
+C    *----------SIGMA+(1930)-----------------------
+     * 1134., .15000,1120.,-230.,   0.,   0.,   0.
+     *,1134., .22500,1111.,-130.,   0.,   0.,   0.
+     *,1134., .25000,1121.,-230.,   0.,   0.,   0.
+     *,1134., .40000,1120.,-231.,   0.,   0.,   0.
+     *,1134., .47500,1130., 110.,   0.,   0.,   0.
+     *,1134., .55000,1230., 120.,   0.,   0.,   0.
+     *,1134., .70000,2130., 120.,   0.,   0.,   0.
+     *,1134., .77500,1131., 110.,   0.,   0.,   0.
+     *,1134., .85000,1231., 120.,   0.,   0.,   0.
+     *,1134.,1.00000,1234., 120.,   0.,   0.,   0./
+C    *---------------------------------------------
+C    *            SIGMA- RESONANCES
+C    *---------------------------------------------
+      DATA ((DECTAB(I,J),I=1,7),J=1129,1140)/
+C    *----------SIGMA-(1665)-----------------------
+     * 2232., .20000,1220.,-130.,   0.,   0.,   0.
+     *,2232., .40000,2230., 110.,   0.,   0.,   0.
+     *,2232., .60000,1230.,-120.,   0.,   0.,   0.
+     *,2232.,1.00000,2130.,-120.,   0.,   0.,   0.
+C    *----------SIGMA-(1776)-----------------------
+     *,2233., .35000,1220.,-130.,   0.,   0.,   0.
+     *,2233., .38750,2230., 110.,   0.,   0.,   0.
+     *,2233., .42500,1230.,-120.,   0.,   0.,   0.
+     *,2233., .57500,2130.,-120.,   0.,   0.,   0.
+     *,2233., .60000,2231., 110.,   0.,   0.,   0.
+     *,2233., .62500,1231.,-120.,   0.,   0.,   0.
+     *,2233., .75000,1234.,-120.,   0.,   0.,   0.
+     *,2233.,1.00000,2230., 220.,   0.,   0.,   0./
+      DATA ((DECTAB(I,J),I=1,7),J=1141,1150)/
+C    *----------SIGMA-(1930)-----------------------
+     * 2234., .15000,1220.,-130.,   0.,   0.,   0.
+     *,2234., .17500,1221.,-130.,   0.,   0.,   0.
+     *,2234., .25000,2221.,-230.,   0.,   0.,   0.
+     *,2234., .40000,1220.,-131.,   0.,   0.,   0.
+     *,2234., .47500,2230., 110.,   0.,   0.,   0.
+     *,2234., .55000,1230.,-120.,   0.,   0.,   0.
+     *,2234., .70000,2130.,-120.,   0.,   0.,   0.
+     *,2234., .77500,2231., 110.,   0.,   0.,   0.
+     *,2234., .85000,1231.,-120.,   0.,   0.,   0.
+     *,2234.,1.00000,1234.,-120.,   0.,   0.,   0./
+C    *---------------------------------------------
+C    *      ADDITIONAL MESONRESONANCES
+C    *---------------------------------------------
+      DATA ((DECTAB(I,J),I=1,7),J=1151,1159)/
+C    *-----------F0(975)---------------------------
+     *  332., .50000, 120.,-120.,   0.,   0.,   0.
+     *, 332., .75000, 110., 110.,   0.,   0.,   0.
+     *, 332., .87500, 130.,-130.,   0.,   0.,   0.
+     *, 332.,1.00000, 230.,-230.,   0.,   0.,   0.
+C    *-----------A0(980)---------------------------
+     *, 112., .56000, 110., 220.,   0.,   0.,   0.
+     *, 112., .78000, 130.,-130.,   0.,   0.,   0.
+     *, 112.,1.00000, 230.,-230.,   0.,   0.,   0.
+C    *-----------A+(980)---------------------------
+     *, 122., .60000, 120., 220.,   0.,   0.,   0.
+     *, 122.,1.00000, 130.,-230.,   0.,   0.,   0./
+C    *---------------------------------------------
+C    *      WEAK BARYON DECAYS
+C    *---------------------------------------------
+      DATA ((DECTAB(I,J),I=1,7),J=1160,1169)/
+C    *-----------LAMBDA(1116)----------------------
+     * 2130.,0.64200,1120.,-120.,   0.,   0.,   0.
+     *,2130.,1.00000,1220., 110.,   0.,   0.,   0.
+C    *-----------SIGMA+(1180)----------------------
+     *,1130.,0.51580,1120., 110.,   0.,   0.,   0.
+     *,1130.,1.00000,1220., 120.,   0.,   0.,   0.
+C    *-----------SIGMA-(1180)----------------------
+     *,2230.,1.00000,1220.,-120.,   0.,   0.,   0.
+C    *---------KASKADE-(1360)----------------------
+     *,2330.,1.00000,2130.,-120.,   0.,   0.,   0.
+C    *---------KASKADE0(1360)----------------------
+     *,1330.,1.00000,2130., 110.,   0.,   0.,   0.
+C    *---------OMEGA-(1680)------------------------
+     *,3331.,0.68000,2130.,-130.,   0.,   0.,   0.
+     *,3331.,0.82000,1330.,-120.,   0.,   0.,   0.
+     *,3331.,1.00000,2330., 110.,   0.,   0.,   0./
+C    *---------------------------------------------
+C    *      WEAK MESON DECAYS
+C    *---------------------------------------------
+      DATA ((DECTAB(I,J),I=1,7),J=1170,1171)/
+C    *-----------K0S(975)--------------------------
+     *   20., .68610, 120.,-120.,   0.,   0.,   0.
+     *,  20.,1.00000, 110., 110.,   0.,   0.,   0./
+C    *---------------------------------------------
+      DATA ALFA /0.00729735/, GF /1.16570E-5/, SIN2W /.215/
+C  SINW = SQRT(SIN2W), COSW=SQRT(1.-SIN2W)
+      DATA SINW /.463681/,COSW /.886002/
+C-----------------------------------------------------------------------
+      IF     ( IENTRO .EQ. 1 ) THEN
+        CALL JCENTR(3,6,3,1)
+      ELSEIF ( IENTRO .EQ. 2 ) THEN
+        CALL JCENTD
+      ENDIF
+      CALL JCENTP
+
+      CALL IDRESI
+
+C  DETERMINE WMASS2,WGAM2
+C  ----------------------
+      AMW=SQRT(PI*ALFA/(.9304*1.41421356*GF))/SINW
+      WMASS2=AMW
+      CALL IDMASS(5,AMLEP5)
+      CALL IDMASS(6,AMLEP6)
+      IF ( AMLEP5+AMLEP6 .GT. AMW ) THEN
+        NGAM=9
+      ELSE
+        NGAM=12
+      ENDIF
+      WGAM2=GF*AMW**3/(6.*PI*1.41421356)*NGAM
+
+      IRD=0
+      DO 1 I=1,MXLOOK
+        LOOK(I)=0
+ 1    CONTINUE
+      DO 2 I=1,MXDKY
+        MODE(1,I)=0
+        MODE(2,I)=0
+        MODE(3,I)=0
+        MODE(4,I)=0
+        MODE(5,I)=0
+        CBR(I)=0.
+ 2    CONTINUE
+      NODCAY=.FALSE.
+      NOETA=.FALSE.
+      NOPI0=.FALSE.
+      NONUNU=.FALSE.
+      NOEVOL=.FALSE.
+      NOHADR=.FALSE.
+      IF ( LPRINT ) WRITE(IFCH,10)
+10    FORMAT('1',30('*')/' *',28X,'*'/
+     *        ' *',5X,'ISAJET DECAY TABLE',5X,'*'/
+     *        ' *',28X,'*'/' ',30('*')//
+     *        6X,'PART',18X,'DECAY MODE',19X,'CUM BR',15X,'IDENT',17X,
+     *        'DECAY IDENT'/)
+      LOOP=0
+      IOLD=0
+      IF ( NODCAY ) RETURN
+
+200   LOOP=LOOP+1
+      IF ( LOOP .GT. MXDKY ) GOTO 9999
+220   CONTINUE
+      IMODE(1)=0
+      IMODE(2)=0
+      IMODE(3)=0
+      IMODE(4)=0
+      IMODE(5)=0
+      LMODE(1)=IBLANK
+      LMODE(2)=IBLANK
+      LMODE(3)=IBLANK
+      LMODE(4)=IBLANK
+      LMODE(5)=IBLANK
+      IRD=IRD+1
+      IF ( IRD .GT. NDECTB ) RETURN
+      IRES=NINT(DECTAB(1,IRD))
+      BR=DECTAB(2,IRD)
+      IMODE(1)=NINT(DECTAB(2+1,IRD))
+      IMODE(2)=NINT(DECTAB(2+2,IRD))
+      IMODE(3)=NINT(DECTAB(2+3,IRD))
+      IMODE(4)=NINT(DECTAB(2+4,IRD))
+      IMODE(5)=NINT(DECTAB(2+5,IRD))
+      IF ( NOPI0  .AND.  IRES .EQ. 110 ) GOTO 220
+      IF ( NOETA  .AND.  IRES .EQ. 220 ) GOTO 220
+      IF ( IRES .EQ. IOLD ) GOTO 230
+      IF ( IRES .LT. 0  .OR.  IRES .GT. MXLOOK ) THEN
+        CALL UTSTOP('JDECIN: IRES OUT OF RANGE               ')
+      ENDIF
+      LOOK(IRES)=LOOP
+230   IOLD=IRES
+      CBR(LOOP)=BR
+      MODE(1,LOOP)=IMODE(1)
+      MODE(2,LOOP)=IMODE(2)
+      MODE(3,LOOP)=IMODE(3)
+      MODE(4,LOOP)=IMODE(4)
+      MODE(5,LOOP)=IMODE(5)
+      IF ( LPRINT ) THEN
+        IF ( IMODE(1) .NE. 0 ) LMODE(1)=IDLABL(IMODE(1))
+        IF ( IMODE(2) .NE. 0 ) LMODE(2)=IDLABL(IMODE(2))
+        IF ( IMODE(3) .NE. 0 ) LMODE(3)=IDLABL(IMODE(3))
+        IF ( IMODE(4) .NE. 0 ) LMODE(4)=IDLABL(IMODE(4))
+        IF ( IMODE(5) .NE. 0 ) LMODE(5)=IDLABL(IMODE(5))
+        LRES=IDLABL(IRES)
+        WRITE(IFCH,20) LRES,(LMODE(K),K=1,5), BR,IRES,(IMODE(K),K=1,5)
+20      FORMAT(6X,A5,6X,5(A5,2X),3X,F8.5,15X,I5,4X,5(I5,2X))
+      ENDIF
+      GOTO 200
+
+9999  WRITE(IFCH,*)'LOOP=', LOOP
+      CALL UTSTOP('JDECIN: LOOP > MXDKY                    ')
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JESTPR(IC1,IC2,AM,IER)
+
+C-----------------------------------------------------------------------
+C  PROCESSES STRINGS
+C-----------------------------------------------------------------------
+      PARAMETER (KOLLMX=2500)
+      PARAMETER (MAMX=56)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXSTR=3000)
+      PARAMETER (NDEP=129)
+      PARAMETER (NDET=129)
+      PARAMETER (NFLAV=6)
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /CKOL/    KOL
+      COMMON /CLEAD/   COOAV3,COOAV4,LEAD
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /COL/     BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
+     *                ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
+     *                ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
+     *                ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
+     *                ,XDET99(NDET)
+     *                ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
+     *                ,NRTARG(KOLLMX),NTARG
+      COMMON /CPROJA/  IPROJ,ITARG,KPROJA(NHA,MAMX),KTARGA(NHA,MAMX)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CPZSTR/  ESTRL,PZSTRL,ISEA,ISTRL
+      COMMON /CSTR/    PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
+     *                ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      REAL    STRO(NSI,NSIX+1)
+      INTEGER IC1(2),IC2(2),JC(NFLAV,2),JC1(NFLAV,2),JC2(NFLAV,2)
+C-----------------------------------------------------------------------
+      IER=0
+
+C  PMAX
+C  ----
+      CALL IDDECO(IC1,JC)
+      NQ=0
+      DO 7 NF=1,NFLAV
+        NQ=NQ+JC(NF,1)-JC(NF,2)
+ 7    CONTINUE
+      IF ( ABS(NQ) .GE. 2 ) THEN
+        AM1MIN=PROM
+      ELSE
+        AM1MIN=PIOM
+      ENDIF
+      CALL IDDECO(IC2,JC)
+      NQ=0
+      DO 8 NF=1,NFLAV
+        NQ=NQ+JC(NF,1)-JC(NF,2)
+ 8    CONTINUE
+      IF ( ABS(NQ) .GE. 2 ) THEN
+        AM2MIN=PROM
+      ELSE
+        AM2MIN=PIOM
+      ENDIF
+      IF ( AM .LE. AM1MIN+AM2MIN ) THEN
+        PMAX=AM*0.5
+      ELSE
+        PMAX=UTPCM(AM,AM1MIN,AM2MIN)
+      ENDIF
+
+C  HASTPR
+C  ------
+      IPROJ=1
+      ITARG=1
+      KPROJA(2,1)=1
+      KTARGA(2,1)=1
+      KPROJA(3,1)=1
+      KTARGA(3,1)=1
+      KOL=1
+      COORD(1,1)=0.
+      COORD(2,1)=0.
+      COORD(3,1)=0.
+      COORD(4,1)=0.
+      CALL IDDECO(IC1,JC1)
+      NPA1=0
+      DO 2 N=1,NFLAV
+        NPA1=NPA1+JC1(N,1)+JC1(N,2)
+ 2    CONTINUE
+      CALL IDDECO(IC2,JC2)
+      NPA2=0
+      DO 3 N=1,NFLAV
+        NPA2=NPA2+JC2(N,1)+JC2(N,2)
+ 3    CONTINUE
+      IF ( NPA2 .GT. NPA1 ) THEN
+        II=2
+      ELSE
+        II=1
+      ENDIF
+      IF ( NPA1 .GT. 1  .OR.  NPA2 .GT. 1 ) THEN
+        LEAD=1
+      ELSE
+        LEAD=0
+      ENDIF
+
+      NSTR0=NSTR
+17    NSTR=NSTR0
+
+      DO 15 N=1,NSI
+        STRO(N,1)=0.
+        STRO(N,2)=0.
+        STRO(N,3)=0.
+15    CONTINUE
+      STRO(3,II)=AM*0.5
+      STRO(4,II)=AM*0.5
+      STRO(5,II)=IC1(1)
+      STRO(6,II)=IC1(2)
+      STRO(3,3-II)=-AM*0.5
+      STRO(4,3-II)=AM*0.5
+      STRO(5,3-II)=IC2(1)
+      STRO(6,3-II)=IC2(2)
+
+      PZSTRL=STRO(3,1)
+      ESTRL=STRO(4,1)
+      PZSTRL=PZSTRL+STRO(3,2)
+      ESTRL=ESTRL+STRO(4,2)
+      ISTRL=0
+
+      CALL UTPAGE
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,110)('-',L=1,79),IPAGE,('-',L=1,79)
+110     FORMAT(1X,79A1/1X,I5,'.PAGE            '
+     *           ,'STRING GENERATION'/1X,79A1/)
+        WRITE(IFCH,105)(STRO(I,1),I=1,4),(NINT(STRO(I,1)),I=5,6)
+105     FORMAT(' STR: ',4F13.5,2I8)
+        WRITE(IFCH,104)(STRO(I,2),I=1,4),(NINT(STRO(I,2)),I=5,6)
+104     FORMAT('      ',4F13.5,2I8/)
+      ENDIF
+
+      ISEA=1
+      ISPLT=0
+14    CALL HASTPR(STRO,ISPLT)
+      IF ( ISPLT .EQ. -1 ) GOTO 9001
+      IF ( ISPLT .EQ. -3 ) GOTO 9001
+      IF ( ISPLT .EQ. -4 ) THEN
+        CALL UTSTOP('JESTPR: ISPLT=-4                        ')
+      ENDIF
+      IF ( ISPLT .EQ. -5 ) GOTO 17
+      IF ( ISPLT .GT.  0 ) GOTO 14
+
+      PMXEVT=PMAX
+      EGYEVT=AM
+
+      RETURN
+
+9001  IER=1
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JETGEN(IER)
+
+C-----------------------------------------------------------------------
+C  GENERATES STRINGS
+C-----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXSTR=3000)
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      PARAMETER (MAMX=56)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /CLEP/    ICINPU,IDSCAT
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CNTEVM/  NTEVM
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CSTR/    PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
+     *                ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /PARTNR/  PEX,PEY,PEZET,PE0,PX4,PY4,SUMMAS
+     *                ,IC4,IPTNR,JS4,NPS
+
+      REAL    TARGA(NSI,NHA,MAMX)
+      INTEGER ICSTRI(4,18),IC1(2),IC2(2),IC4(2)
+
+      DATA ((ICSTRI(I,J),I=1,4),J=1,8)/
+     *100000,000000,110000,000000,
+     *010000,000000,200000,000000,
+     *100000,000000,210000,100000,
+     *010000,000000,210000,010000,
+     *001000,000000,210000,001000,
+     *000000,100000,310000,000000,
+     *000000,010000,220000,000000,
+     *000000,001000,211000,000000/
+      DATA ((ICSTRI(I,J),I=1,4),J=11,18)/
+     *100000,000000,020000,000000,
+     *010000,000000,110000,000000,
+     *100000,000000,120000,100000,
+     *010000,000000,120000,010000,
+     *001000,000000,120000,001000,
+     *000000,100000,220000,000000,
+     *000000,010000,130000,000000,
+     *000000,001000,121000,000000/
+C-----------------------------------------------------------------------
+      ISH0=ISH
+      IF ( ISHSUB/100 .EQ. 2 ) ISH=MOD(ISHSUB,100)
+      IF ( ISH .GE. 93 ) THEN
+        WRITE(IFCH,*)('-',L=1,79)
+        WRITE(IFCH,*)'STRING GENERATION. SR JETGEN.'
+      ENDIF
+
+      IER=0
+
+      NEVT=1
+      NSTR=0
+      NPTL=0
+
+      IF ( ICINPU .GE. 1 ) THEN
+3       CALL LEPEXP(XBJ,QSQ)
+        RNU=QSQ/(2.* PROM * XBJ)
+        WSQ=PROM**2 + 2.* PROM * RNU - QSQ
+        AMST=SQRT(WSQ)
+        ELEPTO=ELEPTI-RNU
+        COSANG=1.-QSQ/(2.*ELEPTI*ELEPTO)
+        IF ( ISH .GE. 93 ) THEN
+          WRITE(IFCH,*)'ELEPTI,ELEPTO,RNU: ',ELEPTI,ELEPTO,RNU
+          WRITE(IFCH,*)'XBJ,QSQ,COSANG=1-QSQ/2/ELEPTI/ELEPTO: '
+     *                 ,XBJ,QSQ,COSANG
+        ENDIF
+        IF ( RNU .GT. ELEPTI ) THEN
+          IF ( ISH .GE. 93 ) WRITE(IFCH,*)'*****  Q0 TOO LARGE: ',RNU
+          GOTO 3
+        ENDIF
+        IF     ( COSANG.GT.1.  .AND.  COSANG.LT.1.001 ) THEN
+          COSANG=1.
+        ELSEIF ( COSANG.LT.-1.  .OR.  COSANG.GT.1.    ) THEN
+          COSANO=COSANG
+          IF ( COSANG .GE. 0. ) COSANG= 1.
+          IF ( COSANG .LT. 0. ) COSANG=-1.
+          IF(ISH.GE.90)THEN
+            CALL UTMSG('JETGEN')
+            WRITE(IFCH,*)'*****  COSANG OUT OF RANGE'
+            WRITE(IFCH,*)'ELEPTI,ELEPTO,RNU: ',ELEPTI,ELEPTO,RNU
+            WRITE(IFCH,*)'XBJ,QSQ,COSANG=1-QSQ/2/ELEPTI/ELEPTO: '
+     *                   ,XBJ,QSQ,COSANO
+            WRITE(IFCH,*)'COSANG_NEW: ',COSANG
+            CALL UTMSGF
+          ENDIF
+        ENDIF
+        ANGMUE=ACOS(COSANG)
+        CALL LEPTAR(XBJ,QSQ,MATARG,LATARG,IDSCAT)
+      ENDIF
+
+      IF ( MATARG .GT. 0 ) THEN
+        CALL NUCOGE
+        NPTL=0
+        CALL NUCINI('STR',TARGA,LATARG,MATARG,-1)
+        CALL NUCSTR(IER)
+        IF ( IER .EQ. 1 ) GOTO 99999
+      ENDIF
+
+      IF     ( ICINPU .EQ. 0 ) THEN
+        R=RANGEN()
+        PS=0.
+        DO 1 K=1,99
+          PS=PS+PROB(K)
+          IF ( R .LE. PS ) GOTO 2
+ 1      CONTINUE
+        CALL UTSTOP('JETGEN: NO K FOUND                      ')
+ 2      CONTINUE
+        IC1(1)=ICFOR(K,1)
+        IC1(2)=ICFOR(K,2)
+        IC2(1)=ICBAC(K,1)
+        IC2(2)=ICBAC(K,2)
+        AMST=ENGY
+      ELSEIF ( ICINPU .GT. 0 ) THEN
+        CALL LEPSTR(IDSCAT,XBJ,QSQ,IDS)
+        IC1(1)=ICSTRI(1,IDS)
+        IC1(2)=ICSTRI(2,IDS)
+        IC2(1)=ICSTRI(3,IDS)
+        IC2(2)=ICSTRI(4,IDS)
+      ENDIF
+      CALL JESTPR(IC1,IC2,AMST,IER)
+
+99999 ISH=ISH0
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JFRADE(IER)
+
+C-----------------------------------------------------------------------
+C  PERFORMS STRING FRAGMENTATION/DECAY AND FIN. STATE INTERACTIONS
+C-----------------------------------------------------------------------
+      PARAMETER (KOLLMX=2500)
+      PARAMETER (MAMX=56)
+      PARAMETER (MXDKY=2000)
+      PARAMETER (MXINDX=1000)
+      PARAMETER (MXLOOK=10000)
+      PARAMETER (MXMA=11)
+      PARAMETER (MXMX=6)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXRE=100)
+      PARAMETER (MXSTR=3000)
+      PARAMETER (NDEP=129)
+      PARAMETER (NDET=129)
+      PARAMETER (NPRBMS=20)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /CKOL/    KOL
+      COMMON /CNCE/    NCES,NCOLEX
+      COMMON /CNFR/    NRFRA
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /COL/     BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
+     *                ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
+     *                ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
+     *                ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
+     *                ,XDET99(NDET)
+     *                ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
+     *                ,NRTARG(KOLLMX),NTARG
+      COMMON /CPRBMS / PRBMS(NPRBMS)
+      COMMON /CPROJA/  IPROJ,ITARG,KPROJA(NHA,MAMX),KTARGA(NHA,MAMX)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CREMA/   REMA(MXRE,MXMA),REWI(MXRE,MXMA)
+     *                ,ICRE1(MXRE,MXMA),ICRE2(MXRE,MXMA)
+     *                ,IDMX(MXMA,MXMX),INDX(MXINDX)
+      COMMON /CSTR/    PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
+     *                ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
+      COMMON /CTIMEL/  NTC
+      DOUBLE PRECISION DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /CTTAUS/  DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /C2PTL/   AMIPTL(MXPTL),RADPTL(MXPTL),IAAPTL(MXPTL)
+      COMMON /DIDIB/   NDIDIB
+      COMMON /DKYTAB/  CBR(MXDKY),LOOK(MXLOOK),MODE(5,MXDKY)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /PARTNR/  PEX,PEY,PEZET,PE0,PX4,PY4,SUMMAS
+     *                ,IC4,IPTNR,JS4,NPS
+
+      DOUBLE PRECISION DIFF,ZFI
+      REAL             PSUM(5)
+      INTEGER          IC4(2)
+C-----------------------------------------------------------------------
+C  INITIALIZATION
+C  --------------
+CDH   IF ( ISH .EQ. 13 .OR. ISH .EQ. 14 ) CALL UTTIMA('*** JFRADE *** ')
+      IER=0
+      IRET=0
+      ISH0=ISH
+      IF ( ISHSUB/100 .EQ. 16 ) ISH=MOD(ISHSUB,100)
+      IF ( NEVT .NE. 1  .OR.  IFRADE .EQ. 0 ) GOTO 1000
+      NPTLPT=ABS(MAPROJ)+ABS(MATARG)
+      IF ( ICHOIC .EQ. 1  .OR.  ICHOIC .EQ. 4 ) THEN
+        YCMMAX=LOG(EGYEVT*2.5)
+        ETAPRO=YCMMAX*.6667
+        ETATAR=-ETAPRO
+      ELSE
+        ETAPRO=(YPJTL-YHAHA)*.6667
+        ETATAR=-YHAHA*.6667
+      ENDIF
+      DETAP=ETAPRO
+      DETAT=ETATAR
+      TPRO=COSH(DETAP)
+      ZPRO=SINH(DETAP)
+      TTAR=COSH(DETAT)
+      ZTAR=SINH(DETAT)
+
+C  WRITE
+C  -----
+      CALL UTPAGE
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,110)('-',L=1,79),IPAGE,('-',L=1,79)
+110     FORMAT(1X,79A1/1X,I5,'.PAGE            '
+     *           ,'STRINGS BEFORE RESCALING'/1X,79A1/)
+        DO 9 J=1,NSTR
+          WRITE(IFCH,109)J,(ICSTR(K,J)/100,K=1,4)
+     *          ,SQRT(PSTR(1,J)**2+PSTR(2,J)**2),PSTR(3,J),PSTR(5,J)
+     *          ,IRLSTR(J)
+109       FORMAT(' /CSTR/',I4,3X,4I5,3(E11.3),I4)
+ 9      CONTINUE
+      ENDIF
+
+C  STRING RESCALING
+C  ----------------
+      IF ( ICHOIC.LE.2 .AND. NSTR.GT.1 .AND. IRESCL.EQ.1 ) THEN
+        PSUM(1)=0.
+        PSUM(2)=0.
+        IF ( ICHOIC .EQ. 1 ) THEN
+          PSUM(3)=0.
+          PSUM(4)=EGYEVT
+        ELSE
+          PSUM(3)=(NPJEVT-NTGEVT)*PNLLX
+          PSUM(4)=NPJEVT*SQRT(AMPROJ**2+PNLLX**2)
+     *           +NTGEVT*SQRT(AMTARG**2+PNLLX**2)
+        ENDIF
+        PSUM(5)=SQRT(PSUM(4)**2-PSUM(3)**2)
+        CALL HRESCL(1,NSTR,PSUM,IFAIL)
+        IF ( IFAIL .NE. 0 ) GOTO 1001
+      ENDIF
+
+C  WRITE
+C  -----
+      CALL UTPAGE
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,111)('-',L=1,79),IPAGE,('-',L=1,79)
+111     FORMAT(/1X,79A1/1X,I5,'.PAGE            '
+     *                       ,'STRINGS AFTER RESCALING'/1X,79A1/)
+        DO 10 J=1,NSTR
+          WRITE(IFCH,109)J,(ICSTR(K,J)/100,K=1,4)
+     *        ,SQRT(PSTR(1,J)**2+PSTR(2,J)**2),PSTR(3,J),PSTR(5,J)
+     *        ,IRLSTR(J)
+10      CONTINUE
+      ENDIF
+
+C  FRAGMENTATION
+C  -------------
+      IF ( ISHSUB/100 .EQ. 3 ) ISH=MOD(ISHSUB,100)
+CDH   IF ( ISH .EQ. 13 ) CALL UTTIMA('               ')
+      DO 3 J=1,NSTR
+        CALL UTPAGE
+        IF ( ISH .GE. 91 ) WRITE(IFCH,102)('-',L=1,79),IPAGE,J
+     *       ,(ICSTR(K,J),K=1,4),SQRT(PSTR(1,J)**2+PSTR(2,J)**2
+     *            +PSTR(3,J)**2),PSTR(4,J),PSTR(5,J),('-',L=1,79)
+102     FORMAT(/1X,79A1
+     *         /1X,I5,'.PAGE  STR:',I3,4I7,3(E10.2)/1X,79A1/)
+        CALL JAMFRA(J,NEWEVT)
+        IF ( NEWEVT .EQ. 1 ) GOTO 10011
+ 3    CONTINUE
+CDH   IF ( ISH .EQ. 13 ) CALL UTTIMA('FRAGMENTATION  ')
+
+C  PRINT /CPTL/
+C  ------------
+      IF ( ISHSUB/100 .EQ. 9 ) ISH=MOD(ISHSUB,100)
+      CALL UTPAGE
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,104)('-',L=1,79),IPAGE,('-',L=1,79)
+104     FORMAT(/1X,79A1/1X,I5,'.PAGE            '
+     *                       ,'PTLS AFTER FRAGMENTATION'/1X,79A1/)
+        DO 18 N=1,NPTL
+          IF ( N.GT.NPTLPT .OR. ISTPTL(N).NE.0 )
+     *      WRITE(IFCH,116)IORPTL(N),JORPTL(N),N,IFRPTL(1,N),IFRPTL(2,N)
+     *                 ,IDPTL(N),PPTL(3,N),PPTL(4,N),PPTL(5,N),ISTPTL(N)
+18      CONTINUE
+      ENDIF
+
+C  INITIAL DECAY
+C  -------------
+      IF ( ISHSUB/100 .EQ. 10 ) ISH=MOD(ISHSUB,100)
+      CALL UTPAGE
+CDH   IF ( ISH.EQ.13 ) CALL UTTIMA('               ')
+      IF ( RADIAC .GT. 0. ) THEN
+        TTAUS=TAUMIN
+        IACN=1
+      ELSE
+        TTAUS=AINFIN
+        IACN=0
+      ENDIF
+      TTP=TTAUS*TPRO
+      TTT=TTAUS*TTAR
+      ZZP=TTAUS*ZPRO
+      ZZT=TTAUS*ZTAR
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,119)('-',L=1,79),IPAGE,SNGL(TTAUS),('-',L=1,79)
+119     FORMAT(/1X,79A1/1X,I5,'.PAGE            '
+     *                       ,'DECAY BEFORE TAU =',E10.3/1X,79A1/)
+      ENDIF
+      NP1=1
+21    NP2=NPTL
+      DO 5 I=NP1,NP2
+        IF ( TTAUS .LE. 0.D0   ) THEN
+          DIFF = TIVPTL(2,I) - TTAUS
+        ELSE
+          ZFI=XORPTL(3,I)+(TIVPTL(2,I)-XORPTL(4,I))*PPTL(3,I)/PPTL(4,I)
+          CALL UTTAUT(SNGL(ZFI),TZFI)
+          DIFF = TIVPTL(2,I) - TZFI
+        ENDIF
+        IF ( DIFF .LE. 0. .OR. IACN.EQ.0 ) THEN
+          IF ( ISTPTL(I) .EQ. 0 ) THEN
+            CALL JDECA(I,IRET)
+            IF ( IRET .EQ. 1 ) GOTO 1001
+          ENDIF
+        ENDIF
+5     CONTINUE
+      NP1=NP2+1
+      IF ( NP1 .LE. NPTL ) GOTO 21
+CDH   IF ( ISH .EQ. 13 ) CALL UTTIMA('DECAY INI      ')
+
+C  INTERACTION AND DECAY
+C  ---------------------
+      IF ( IACN .EQ. 0 ) GOTO 5000
+      CALL UTPAGE
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,118)('-',L=1,79),IPAGE,('-',L=1,79)
+118     FORMAT(/1X,79A1/1X,I5,'.PAGE            '
+     *                       ,'INTERACTIONS AND DECAY'/1X,79A1/)
+      ENDIF
+      DTAUS=1./(NUMTAU-1.)*(TAUMAX-TAUMIN)
+      DO 23 NT=1,NUMTAU
+        NTC=NT
+        TTAUS=TAUMIN+(NT-1.)*DTAUS
+        TTP=TTAUS*TPRO
+        TTT=TTAUS*TTAR
+        ZZP=TTAUS*ZPRO
+        ZZT=TTAUS*ZTAR
+        IF     ( IOJINT .EQ. 1 ) THEN
+          CALL JINTA1
+        ELSEIF ( IOJINT .EQ. 2 ) THEN
+          CALL JINTA2
+        ENDIF
+        TTAUS=TTAUS+DTAUS
+        TTP=TTAUS*TPRO
+        TTT=TTAUS*TTAR
+        ZZP=TTAUS*ZPRO
+        ZZT=TTAUS*ZTAR
+        NP1=1
+36      NP2=NPTL
+        DO 37 IP=NP1,NP2
+          IF ( TTAUS .LE. 0.D0   ) THEN
+            DIFF = TIVPTL(2,IP) - TTAUS
+          ELSE
+            ZFI=XORPTL(3,IP)+(TIVPTL(2,IP)-XORPTL(4,IP))
+     *                                            *PPTL(3,IP)/PPTL(4,IP)
+            IF     ( ZFI .LE. ZZT ) THEN
+              DIFF = TIVPTL(2,IP) - TTT - (ZFI-ZZT)*ZZT/TTT
+            ELSEIF ( ZFI .GE. ZZP ) THEN
+              DIFF = TIVPTL(2,IP) - TTP - (ZFI-ZZP)*ZZP/TTP
+            ELSE
+              IF ( TTAUS .LT. AINFIN ) THEN
+                IF ( TIVPTL(2,IP) .GE. 0. ) THEN
+                  DIFF = TIVPTL(2,IP)
+                  DIFF = DIFF**2  - (TTAUS**2+ZFI**2)
+                ELSE
+                  DIFF = TIVPTL(2,IP) - SQRT(TTAUS**2+ZFI**2)
+                ENDIF
+              ELSE
+                DIFF = TIVPTL(2,IP) - TTAUS
+                IF ( ISH .GE. 90 ) THEN
+                  CALL UTMSG('JFRADE')
+                  WRITE(IFCH,*)'*****  LARGE TTAUS; SET TZ=TTAUS'
+                  WRITE(IFCH,*)'TTAUS=',TTAUS,'ZFI=',ZFI
+                  CALL UTMSGF
+                ENDIF
+              ENDIF
+            ENDIF
+          ENDIF
+
+          IF ( DIFF .LE. 0. ) THEN
+            IF ( ISTPTL(IP) .EQ. 0 ) THEN
+              CALL JDECA(IP,IRET)
+              IF ( IRET .EQ. 1 ) GOTO 1001
+            ENDIF
+          ENDIF
+37      CONTINUE
+        NP1=NP2+1
+        IF ( NP1 .LE. NPTL ) THEN
+          DO 4 IP=NP1,NPTL
+            IAAPTL(IP)=1
+ 4        CONTINUE
+          GOTO 36
+        ENDIF
+CDH     IF ( ISH .EQ. 13 ) CALL UTTIMA('DECAY          ')
+23    CONTINUE
+
+C  FINAL DECAY
+C  -----------
+      CALL UTPAGE
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,120)('-',L=1,79),IPAGE,('-',L=1,79)
+120     FORMAT(/1X,79A1/1X,I5,'.PAGE            '
+     *                        ,'FINAL DECAY'/1X,79A1/)
+      ENDIF
+      NBEF=NPTL
+CDH   N0BEF=NPTL0
+      NAFT=NPTL
+CDH   N0AFT=NPTL0
+      IF ( NCLEAN .GT. 0 ) THEN
+        CALL UTCLEA(NPTL0)
+        NAFT=NPTL
+CDH     N0AFT=NPTL0
+      ENDIF
+      ISHNPT=ISH
+      IF ( ISHSUB/100 .EQ. 19 ) ISH=MOD(ISHSUB,100)
+      IF ( ISH .EQ. 22 ) THEN
+        WRITE(IFMT,131)NBEF,NAFT
+131     FORMAT(1X,'BEF FIN DE: NBEF=',I8,4X,'NAFT=',I8)
+      ENDIF
+      ISH=ISHNPT
+      NP1=1
+41    NP2=NPTL
+      DO 42 IP=NP1,NP2
+        IF ( ISTPTL(IP) .EQ. 0 ) THEN
+          CALL JDECA(IP,IRET)
+          IF ( IRET .EQ. 1 ) GOTO 1001
+        ENDIF
+42    CONTINUE
+      NP1=NP2+1
+      IF ( NP1 .LE. NPTL ) THEN
+        DO 6 IP=NP1,NPTL
+          IAAPTL(IP)=1
+ 6      CONTINUE
+        GOTO 41
+      ENDIF
+      ISHNPT=ISH
+      IF ( ISHSUB/100 .EQ. 19 ) ISH=MOD(ISHSUB,100)
+      IF ( ISH .EQ. 22 ) THEN
+        WRITE(IFMT,132)NPTL
+132     FORMAT(1X,'AFT FIN DE: NPTL=',I8)
+      ENDIF
+      ISH=ISHNPT
+CDH   IF ( ISH .EQ. 13 ) CALL UTTIMA('DECAY FIN      ')
+
+C  PRINT /CPTL/
+C  ------------
+      CALL UTPAGE
+      IF ( ISHSUB/100 .EQ. 11 ) ISH=MOD(ISHSUB,100)
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,117)('-',L=1,79),IPAGE,('-',L=1,79)
+117     FORMAT(/1X,79A1/1X,I5,'.PAGE            '
+     *         ,'PTLS AFTER PERFORMING INTERACTIONS'/1X,79A1/
+     *         1X,' IOR',' JOR',4X,'   N',4X,'IFR1IFR2',10X,'ID',3X,
+     *         5X,'PTR',7X,'PZ',4X,'MASS ','IST'/)
+        DO 34 N=1,NPTL
+          IF ( N .GT. NPTLPT  .OR.  ISTPTL(N) .NE. 0 )
+     *      WRITE(IFCH,116)IORPTL(N),JORPTL(N),N,IFRPTL(1,N),IFRPTL(2,N)
+     *     ,IDPTL(N),SQRT(PPTL(1,N)**2+PPTL(2,N)**2),PPTL(3,N),PPTL(5,N)
+     *     ,ISTPTL(N),IAAPTL(N)
+116       FORMAT(1X,I7,I7,4X,I7,4X,I4,I4,I12,3(E10.2),1X,I2,I2)
+34      CONTINUE
+      ENDIF
+
+C  TRAFO -> LAB CM
+C  ---------------
+5000  CONTINUE
+      IF ( LABSYS .EQ. 1 ) THEN
+        DO 7 I=1,NPTL
+          AMT=SQRT(PPTL(5,I)**2+PPTL(1,I)**2+PPTL(2,I)**2)
+          PZ=PPTL(3,I)
+          E=PPTL(4,I)
+          YI=SIGN( LOG((E+ABS(PZ))/AMT), PZ )
+          Y=YI+YHAHA
+          PPTL(3,I)=AMT*SINH(Y)
+          PPTL(4,I)=AMT*COSH(Y)
+ 7      CONTINUE
+      ENDIF
+
+C  FINISH
+C  ------
+
+      CALL UTPAGE
+      IF     ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,113)('-',L=1,79),IPAGE,('-',L=1,79)
+113     FORMAT(/1X,79A1/1X,I5,'.PAGE            '
+     *                       ,'PARTICLE PRODUCTION FINISHED'/1X,79A1/)
+CDH   ELSEIF ( ISH .EQ. 13 ) THEN
+CDH     CALL UTTIMA('               ')
+      ENDIF
+      GOTO 1000
+
+10011 CONTINUE
+      IF ( ISH .GE. 90 ) THEN
+        CALL UTMSG('JFRADE')
+        WRITE(IFCH,*)'*****  FRAGMENTATION NOT POSSIBLE'
+        WRITE(IFCH,112)J,(ICSTR(K,J)/100,K=1,4)
+     *                  ,(PSTR(L,J),L=1,5)
+112     FORMAT( ' STR:',3X,I4,3X,3X,4I5,5F7.2,F7.2)
+        CALL UTMSGF
+      ENDIF
+      IER=1
+      GOTO 1000
+
+1001  CONTINUE
+      IER=1
+      GOTO 1000
+
+1000  CONTINUE
+      IF ( IER .EQ. 1 ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JFRADE')
+          WRITE(IFCH,*)'*****  REDO EVENT',NREVT+1
+          CALL UTMSGF
+        ENDIF
+      ENDIF
+CDH   IF ( ISH .EQ. 14 ) CALL UTTIMA('    JFRADE F   ')
+      ISH=ISH0
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JINTA1
+
+C----------------------------------------------------------------------
+C  SECONDARY INTERACTIONS
+C----------------------------------------------------------------------
+      PARAMETER (KOLLMX=2500)
+      PARAMETER (MAMX=56)
+      PARAMETER (MXDKY=2000)
+      PARAMETER (MXINDX=1000)
+      PARAMETER (MXLOOK=10000)
+      PARAMETER (MXMA=11)
+      PARAMETER (MXMX=6)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXIFR=MXPTL)
+      PARAMETER (MXRE=100)
+      PARAMETER (MXSTR=3000)
+      PARAMETER (NDEP=129)
+      PARAMETER (NDET=129)
+      PARAMETER (NFLAV=6)
+      PARAMETER (NPRBMS=20)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /CIFRIJ/  IFRIJ(MXIFR)
+      COMMON /CJINT/   BX,BY,RNUP,RNUT,VELP,VELT,XAVER(4),NPTL0
+      COMMON /CKOL/    KOL
+      COMMON /CNCE/    NCES,NCOLEX
+      COMMON /CNFR/    NRFRA
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /COL/     BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
+     *                ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
+     *                ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
+     *                ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
+     *                ,XDET99(NDET)
+     *                ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
+     *                ,NRTARG(KOLLMX),NTARG
+      COMMON /CPRBMS/  PRBMS(NPRBMS)
+      COMMON /CPROJA/  IPROJ,ITARG,KPROJA(NHA,MAMX),KTARGA(NHA,MAMX)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CREMA/   REMA(MXRE,MXMA),REWI(MXRE,MXMA)
+     *                ,ICRE1(MXRE,MXMA),ICRE2(MXRE,MXMA)
+     *                ,IDMX(MXMA,MXMX),INDX(MXINDX)
+      COMMON /CSTR/    PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
+     *                ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
+      COMMON /CTIMEL/  NTC
+      DOUBLE PRECISION DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /CTTAUS/  DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /C2PTL/   AMIPTL(MXPTL),RADPTL(MXPTL),IAAPTL(MXPTL)
+      COMMON /C4PTL/   OPTL(MXPTL),TPTL(MXPTL),UPTL(MXPTL)
+     *                ,XPTL(MXPTL),YPTL(MXPTL),ZPTL(MXPTL)
+      COMMON /DIDIB/   NDIDIB
+      COMMON /DKYTAB/  CBR(MXDKY),LOOK(MXLOOK),MODE(5,MXDKY)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /PARTNR/  PEX,PEY,PEZET,PE0,PX4,PY4,SUMMAS
+     *                ,IC4,IPTNR,JS4,NPS
+
+      DOUBLE PRECISION DD,DERR,TI1,TI2,TT,VV,VVP,VVT,XO3,XO4,ZZ,ZZA
+      INTEGER          IC4(2),JC(NFLAV,2),JCDU(NFLAV,2),JCI(NFLAV,2)
+      LOGICAL          IACPTL(MXPTL+10)
+      DATA DERR/1.D-2/
+C----------------------------------------------------------------------
+C  INITIALIZATION FOR NTC=1
+C  ------------------------
+      IF ( NTC .EQ. 1 ) THEN
+        IF ( OVERLP.GE.0. .AND. MAPROJ.NE.0 .AND. MATARG.NE.0 ) THEN
+          IF ( MAPROJ .EQ. 1 ) THEN
+            RNUP=0.
+          ELSE
+            RNUP=1.19*MAPROJ**(0.3333333)-1.61*MAPROJ**(-0.3333333)
+          ENDIF
+          IF ( MATARG .EQ. 1 ) THEN
+            RNUT=0.
+          ELSE
+            RNUT=1.19*MATARG**(0.3333333)-1.61*MATARG**(-0.3333333)
+          ENDIF
+          RNUP=RNUP+OVERLP
+          RNUT=RNUT+OVERLP
+          VELP=PPTL(3,1)/PPTL(4,1)
+          VELT=PPTL(3,IABS(MAPROJ)+1)/PPTL(4,IABS(MAPROJ)+1)
+          BX=COS(PHIEVT)*BIMEVT
+          BY=SIN(PHIEVT)*BIMEVT
+        ENDIF
+        NPTL0=NPTL
+        DO 51 I=1,NPTL0
+          IAAPTL(I)=1
+          CALL IDQUAC(I,NQI,NDUMMY,NDUMMY,JCI)
+          IF ( NQI .NE. 0 ) THEN
+            RADPTL(I)=RADIAC
+            AMIPTL(I)=PROM+AMSIAC
+          ELSE
+            RADPTL(I)=RADIAS
+            AMIPTL(I)=PIOM+AMSIAC
+          ENDIF
+51      CONTINUE
+      ENDIF
+
+C  INITIALIZATION FOR EACH NTC
+C  ---------------------------
+      NT=NTC
+      CALL UTPAGE
+CDH   IF ( ISH .EQ. 13 ) CALL UTTIMA('               ')
+      NBEF=NPTL
+CDH   N0BEF=NPTL0
+      NAFT=NPTL
+CDH   N0AFT=NPTL0
+      IF ( NCLEAN .GT. 0 ) THEN
+        IF ( MOD(NT-1,NCLEAN) .EQ. 0 ) THEN
+          CALL UTCLEA(NPTL0)
+          NAFT=NPTL
+CDH       N0AFT=NPTL0
+        ENDIF
+      ENDIF
+      TAUS=TTAUS
+      NPTLPT=ABS(MAPROJ)+ABS(MATARG)
+      IF ( NPTL .GT. NPTL0 ) THEN
+        DO 52 I=NPTL0+1,NPTL
+          CALL IDQUAC(I,NQI,NDUMMY,NDUMMY,JCI)
+          IF ( NQI .NE. 0 ) THEN
+            RADPTL(I)=RADIAC
+            AMIPTL(I)=PROM+AMSIAC
+          ELSE
+            RADPTL(I)=RADIAS
+            AMIPTL(I)=PIOM+AMSIAC
+          ENDIF
+52      CONTINUE
+      ENDIF
+      DO 44 I=1,NPTL
+        IF ( ICLPTL(I).EQ.0 .AND. PPTL(5,I).GT.AMIPTL(I) ) THEN
+          IACPTL(I)=.TRUE.
+        ELSE
+          IACPTL(I)=.FALSE.
+        ENDIF
+        IF ( IORPTL(I).EQ.-1 ) IACPTL(I)=.TRUE.
+C  CALL UTTAIN IS REPLACED HERE TO AVOID OVERHEAD
+C       CALL UTTAIN(I,X,Y,Z,T,N,0)
+        XO4=XORPTL(4,I)
+C*      IF     ( IOPT .EQ. 0 ) THEN
+          TI1=TIVPTL(1,I)
+C*      ELSEIF ( IOPT .EQ. 1 ) THEN
+C*        TI1=XO4
+C*      ENDIF
+        TI2=TIVPTL(2,I)
+        IF ( TI1 .GT. TI2 ) GOTO 1009
+        PPT4I = 1./PPTL(4,I)
+        VV=PPTL(3,I)*PPT4I
+        XO3=XORPTL(3,I)
+        ZZ=XO3+(TI2-XO4)*VV
+        IF ( TTAUS .LE. 0.D0 ) THEN
+          TZ=TTAUS
+        ELSE
+          IF     ( ZZ .LE. ZZT ) THEN
+            TZ=TTT+(ZZ-ZZT)*ZZT/TTT
+          ELSEIF ( ZZ .GE. ZZP ) THEN
+            TZ=TTP+(ZZ-ZZP)*ZZP/TTP
+          ELSE
+            IF ( TTAUS .GE. AINFIN ) THEN
+              TZ=TTAUS
+              IF ( ISH .GE. 90 ) THEN
+                CALL UTMSG('JINTA1')
+                WRITE(IFCH,*)'*****  LARGE TTAUS; SET TZ=TTAUS'
+                WRITE(IFCH,*)'TTAUS=',TTAUS,'ZZ=',ZZ
+                CALL UTMSGF
+              ENDIF
+            ELSE
+C*DH          TZ=SQRT(TTAUS**2+ZZ**2)
+              IF ( TI2 .LT. 0.D0 ) GOTO 1002
+              IF ( TTAUS**2+ZZ**2 .GE. TI2**2 ) GOTO 1002
+              GOTO 1006
+            ENDIF
+          ENDIF
+        ENDIF
+        IF ( TZ .GE. TI2 ) GOTO 1002
+ 1006   ZZ=XO3+(TI1-XO4)*VV
+        IF ( TTAUS .GT. 0.D0 ) THEN
+          IF     ( ZZ .LE. ZZT ) THEN
+            TZ=TTT+(ZZ-ZZT)*ZZT/TTT
+          ELSEIF ( ZZ .GE. ZZP ) THEN
+            TZ=TTP+(ZZ-ZZP)*ZZP/TTP
+          ELSE
+            IF ( TTAUS .GE. AINFIN ) THEN
+              TZ=TTAUS
+              IF ( ISH .GE. 90 ) THEN
+                CALL UTMSG('JINTA1')
+                WRITE(IFCH,*)'*****  LARGE TTAUS; SET TZ=TTAUS'
+                WRITE(IFCH,*)'TTAUS=',TTAUS,'ZZ=',ZZ
+                CALL UTMSGF
+              ENDIF
+            ELSE
+C*DH          TZ=SQRT(TTAUS**2+ZZ**2)
+              IF ( TI1 .LT. 0.D0 ) GOTO 1007
+              IF ( TTAUS**2+ZZ**2 .LE. TI1**2 ) GOTO 1001
+              GOTO 1007
+            ENDIF
+          ENDIF
+        ENDIF
+        IF ( TZ .LE. TI1 ) GOTO 1001
+ 1007   IF ( TTAUS .LE. 0.D0 ) THEN
+          TT=TTAUS
+          ZZ=XO3+(TT-XO4)*VV
+          IF ( TT.LT.TI1 .OR. TT.GE.TI2 ) GOTO 1031
+        ELSE
+          ZZA=XO3-XO4*VV
+          VVT=ZZT/TTT
+          TT=(TTT+(ZZA-ZZT)*VVT)/(1.D0-VV*VVT)
+          ZZ=XO3+(TT-XO4)*VV
+          IF ( ZZ .LE. ZZT ) THEN
+            IF ( TT.LT.TI1 .OR. TT.GE.TI2 ) GOTO 1032
+            GOTO 1000
+          ENDIF
+          VVP=ZZP/TTP
+          TT=(TTP+(ZZA-ZZP)*VVP)/(1.D0-VV*VVP)
+          ZZ=XO3+(TT-XO4)*VV
+          IF ( ZZ .GE. ZZP ) THEN
+            IF ( TT.LT.TI1 .OR. TT.GE.TI2 ) GOTO 1033
+            GOTO 1000
+          ENDIF
+          DD=1.D0-VV**2
+          IF ( DD .EQ. 0.D0 ) THEN
+            TT=-VV*(TTAUS**2+ZZA**2)*0.5D0/ZZA
+          ELSE
+            TT=(ZZA*VV+SQRT(ZZA**2+TTAUS**2*DD))/DD
+          ENDIF
+          ZZ=XO3+(TT-XO4)*VV
+          IF ( TT.LT.TI1 .OR. TT.GE.TI2 ) GOTO 1034
+          IF ( TT .LT. 0.D0 ) GOTO 1035
+          IF ( ZZ.LE.ZZT .OR. ZZ.GE.ZZP ) GOTO 1004
+          IF ( ABS(TTAUS**2-(TT+ZZ)*(TT-ZZ))
+     *                         .GT. DERR*TTAUS**2 ) GOTO 1005
+        ENDIF
+ 1000   N=0
+ 1011   T=TT
+        Z=ZZ
+        X=XORPTL(1,I)+(T-XO4)*PPTL(1,I)*PPT4I
+        Y=XORPTL(2,I)+(T-XO4)*PPTL(2,I)*PPT4I
+        GOTO 53
+ 1001   N=1
+        GOTO 53
+ 1002   N=2
+        GOTO 53
+ 1031   N=31
+        GOTO 1003
+
+ 1032   N=32
+        GOTO 1003
+ 1033   N=33
+        GOTO 1003
+ 1034   N=34
+ 1003   IF ( ABS(TT-TI1) .LE. DERR*ABS(TT) ) GOTO 1000
+        IF ( ABS(TT-TI2) .LE. DERR*ABS(TT) ) GOTO 1000
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JINTA1')
+          WRITE(IFCH,*)'*****  TI1 < TT < TI2   NOT FULFILLED - ',N
+          WRITE(IFCH,*)SNGL(TI1),SNGL(TT),SNGL(TI2)
+          CALL UTMSGF
+        ENDIF
+        GOTO 1011
+ 1035   CONTINUE
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JINTA1')
+          WRITE(IFCH,*)'*****  TT < 0     ( ',TT,' )'
+          WRITE(IFCH,*)'VV,DD:',VV,DD
+          WRITE(IFCH,*)'ZZA,TTAUS:',ZZA,TTAUS
+          CALL UTMSGF
+        ENDIF
+        GOTO 1011
+ 1004   N=4
+        IF ( ABS(ZZ-ZZT) .LE. DERR*ABS(ZZ) ) GOTO 1000
+        IF ( ABS(ZZ-ZZP) .LE. DERR*ABS(ZZ) ) GOTO 1000
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JINTA1')
+          WRITE(IFCH,*)'*****  ZZT < ZZ < ZZP   NOT FULFILLED'
+          WRITE(IFCH,*)SNGL(ZZT),SNGL(ZZ),SNGL(ZZP)
+          CALL UTMSGF
+        ENDIF
+        GOTO 1011
+ 1005   N=5
+        IF ( ABS(TTAUS**2-(TT+ZZ)*(TT-ZZ)) .LE. DERR ) GOTO 1000
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JINTA1')
+          WRITE(IFCH,*)'*****  TTAUS**2 .NE. (TT+ZZ)*(TT-ZZ)'
+          WRITE(IFCH,*)SNGL(TTAUS**2),SNGL((TT+ZZ)*(TT-ZZ))
+          CALL UTMSGF
+        ENDIF
+        GOTO 1011
+ 1009   N=9
+ 53     CONTINUE
+
+        IF ( N.EQ.2 ) THEN
+          IF ( NCLEAN .GT. 0 ) THEN
+            IF ( MOD(NT,NCLEAN).EQ.0 ) THEN
+              ISTPTL(I)=2
+            ENDIF
+          ENDIF
+          IACPTL(I)=.TRUE.
+          GOTO 54
+        ENDIF
+        IF ( N.EQ.9 ) THEN
+          IACPTL(I)=.TRUE.
+          GOTO 54
+        ENDIF
+        IF ( N.EQ.1 ) THEN
+          IACPTL(I)=.TRUE.
+          GOTO 54
+        ENDIF
+        IF ( IAAPTL(I) .EQ. 0 ) THEN
+          IACPTL(I)=.TRUE.
+          GOTO 54
+        ENDIF
+        IF ( ISTPTL(I) .EQ. 2 ) IACPTL(I)=.TRUE.
+        IF ( ABS(IDPTL(I)) .LT. 100
+     *       .AND.  ABS(IDPTL(I)) .NE. 20 ) IACPTL(I)=.TRUE.
+        IF ( IDPTL(I) .EQ. 441  .AND.  JPSIFI .EQ. 0 ) IACPTL(I)=.TRUE.
+ 54     XPTL(I)=X
+        YPTL(I)=Y
+        ZPTL(I)=Z
+        TPTL(I)=T
+        IF ( OVERLP.GE.0. .AND. MAPROJ.NE.0 .AND. MATARG.NE.0 ) THEN
+          IF ( (X-BX*0.5)**2+(Y-BY*0.5)**2+(Z-VELP*TAUS)**2
+     *                                    .LT. RNUP**2  .AND.
+     *         (X+BX*0.5)**2+(Y+BY*0.5)**2+(Z-VELT*TAUS)**2
+     *                                .LT. RNUT**2  )  IACPTL(I)=.TRUE.
+        ENDIF
+44    CONTINUE
+      NPTL0=NPTL
+      I=0
+
+C  I LOOP --> 24
+C  -------------
+9999  I=I+1
+      IF ( IACPTL(I) ) GOTO 24
+      J0=NPTLPT+1
+      IF ( I .GT. NPTLPT ) J0=I+1
+      IF ( I .GT. NPTL0 ) J0=1
+
+C  J LOOP --> 250
+C  -------------
+      J = J0-1
+25    J = J+1
+      IF ( J .GT. NPTL ) GOTO 24
+        IF ( IACPTL(J) ) THEN
+          IF ( IACPTL(J+1) ) THEN
+            IF ( IACPTL(J+2) ) THEN
+              IF ( IACPTL(J+3) ) THEN
+                IF ( IACPTL(J+4) ) THEN
+                  IF ( IACPTL(J+5) ) THEN
+                    IF ( IACPTL(J+6) ) THEN
+                      IF ( IACPTL(J+7) ) THEN
+                        IF ( IACPTL(J+8) ) THEN
+                          IF ( IACPTL(J+9) ) THEN
+                            IF ( IACPTL(J+10) ) THEN
+                              J=J+10
+                              GOTO 25
+                            ELSE
+                              J=J+10
+                              IF ( J .GT. NPTL ) GOTO 24
+                              GOTO 26
+                            ENDIF
+                          ELSE
+                            J=J+9
+                            IF ( J .GT. NPTL ) GOTO 24
+                            GOTO 26
+                          ENDIF
+                        ELSE
+                          J=J+8
+                          IF ( J .GT. NPTL ) GOTO 24
+                          GOTO 26
+                        ENDIF
+                      ELSE
+                        J=J+7
+                        IF ( J .GT. NPTL ) GOTO 24
+                        GOTO 26
+                      ENDIF
+                    ELSE
+                      J=J+6
+                      IF ( J .GT. NPTL ) GOTO 24
+                      GOTO 26
+                    ENDIF
+                  ELSE
+                    J=J+5
+                    IF ( J .GT. NPTL ) GOTO 24
+                    GOTO 26
+                  ENDIF
+                ELSE
+                  J=J+4
+                  IF ( J .GT. NPTL ) GOTO 24
+                  GOTO 26
+                ENDIF
+              ELSE
+                J=J+3
+                IF ( J .GT. NPTL ) GOTO 24
+                GOTO 26
+              ENDIF
+            ELSE
+              J=J+2
+              IF ( J .GT. NPTL ) GOTO 24
+              GOTO 26
+            ENDIF
+          ELSE
+            J=J+1
+            IF ( J .GT. NPTL ) GOTO 24
+            GOTO 26
+          ENDIF
+        ENDIF
+ 26     CONTINUE
+        RADSQR=(RADPTL(I)+RADPTL(J))**2
+        IF ( (ZPTL(I)-ZPTL(J))**2 .GT. RADSQR ) GOTO 25
+        IF ( (YPTL(I)-YPTL(J))**2 .GT. RADSQR ) GOTO 25
+        IF ( (XPTL(I)-XPTL(J))**2 .GT. RADSQR ) GOTO 25
+        IF ( I .EQ. J ) GOTO 25
+        IF ( IORPTL(I).GT.0 .AND. IORPTL(J).EQ.IORPTL(I) ) GOTO 25
+        IF ( IORPTL(I) .EQ. J ) GOTO 25
+        IF ( IORPTL(J) .EQ. I ) GOTO 25
+        PDE=(PPTL(3,I)+PPTL(3,J))/(PPTL(4,I)+PPTL(4,J))
+        GAM2I=1.-PDE**2
+        IF ( GAM2I .EQ. 0. ) GOTO 25
+        IF ( (ZPTL(I)-ZPTL(J)-(TPTL(I)-TPTL(J))*PDE)**2
+     *                                 .GT. RADSQR*GAM2I ) GOTO 25
+        IF ( (XPTL(I)-XPTL(J))**2+(YPTL(I)-YPTL(J))**2+
+     *    1./GAM2I*(ZPTL(I)-ZPTL(J)-(TPTL(I)-TPTL(J))*PDE)**2
+     *                                       .GT. RADSQR ) GOTO 25
+        CALL JINTCC(I,J,IRET)
+        IF ( IRET .EQ. 1 ) GOTO 25
+
+        IACTN=0
+        NPTL00=NPTL
+        NSTR00=NSTR
+        XAVER(1)=(XPTL(I)+XPTL(J))*0.5
+        XAVER(2)=(YPTL(I)+YPTL(J))*0.5
+        XAVER(3)=(ZPTL(I)+ZPTL(J))*0.5
+        XAVER(4)=(TPTL(I)+TPTL(J))*0.5
+
+        CALL JINTFS(I,J,NQIFUS,JC,AMIM,IRET)
+        IF ( IRET .EQ. 1 ) GOTO 25
+
+        CALL JINTCE(I,J,AMIM,IACTN,IRET)
+        IF ( IRET .EQ. 25 ) GOTO25
+
+        TIVPTL(2,I)=TPTL(I)
+        TIVPTL(2,J)=TPTL(J)
+        ISTPTL(I)=1
+        ISTPTL(J)=1
+        IACPTL(I)=.TRUE.
+        IACPTL(J)=.TRUE.
+
+        CALL JINTCH(I,J,KMAX)
+        DO 30 K=1,KMAX
+          N=IFRIJ(K)
+          ISTPTL(N)=2
+          IACPTL(N)=.TRUE.
+30      CONTINUE
+        CALL JINTPA(I,J,KMAX)
+        DO 31 K=1,KMAX
+          N=IFRIJ(K)
+          IACPTL(N)=.TRUE.
+31      CONTINUE
+
+        IF ( IACTN .EQ. 1 ) THEN
+          DO 32 N=NPTL00+1,NPTL
+            IAAPTL(N)=1
+            CALL IDQUAC(N,NQI,NDUMMY,NDUMMY,JCDU)
+            IF ( NQI .EQ. 0 ) THEN
+              RADPTL(N)=RADIAS
+              AMIPTL(N)=PIOM+AMSIAC
+            ELSE
+              RADPTL(N)=RADIAC
+              AMIPTL(N)=PROM+AMSIAC
+            ENDIF
+            IACPTL(N)=.FALSE.
+            IF ( PPTL(5,N) .GT. AMIPTL(N) ) IACPTL(N)=.TRUE.
+            CALL UTTAIN(N,X,Y,Z,T,K,0)
+            IF ( K.EQ.1 .OR. K.EQ.2 .OR. K.EQ.9 ) IACPTL(N)=.TRUE.
+            IF ( ABS(IDPTL(N)) .LT. 100
+     *           .AND. ABS(IDPTL(N)) .NE. 20 ) IACPTL(N)=.TRUE.
+            XPTL(N)=X
+            YPTL(N)=Y
+            ZPTL(N)=Z
+            TPTL(N)=T
+            IF ( OVERLP.GE.0. .AND. MAPROJ.NE.0 .AND. MATARG.NE.0 ) THEN
+              IF ( (X-BX*.5)**2+(Y-BY*.5)**2+(Z-VELP*TAUS)**2
+     *                                 .LT. RNUP**2  .AND.
+     *             (X+BX*.5)**2+(Y+BY*.5)**2+(Z-VELT*TAUS)**2
+     *                                 .LT. RNUT**2 )  IACPTL(N)=.TRUE.
+            ENDIF
+32        CONTINUE
+          GOTO 24
+        ENDIF
+
+        CALL JINTEL(I,J,AMIM,IACTN)
+        IF ( IACTN .EQ. 2 ) THEN
+          DO 33 N=NPTL00+1,NPTL
+            IF     ( N .EQ. NPTL00+1 ) THEN
+              IJ=I
+            ELSEIF ( N .EQ. NPTL00+2 ) THEN
+              IJ=J
+            ENDIF
+            RADPTL(N)=RADPTL(IJ)
+            AMIPTL(N)=AMIPTL(IJ)
+            XPTL(N)=XAVER(1)
+            YPTL(N)=XAVER(2)
+            ZPTL(N)=XAVER(3)
+            TPTL(N)=XAVER(4)
+            IACPTL(N)=.FALSE.
+            IAAPTL(N)=1
+33        CONTINUE
+          GOTO 24
+        ENDIF
+
+        CALL JINTFU(I,J,JC,IACTN)
+        DO 34 N=NPTL00+1,NPTL
+          IF ( NQIFUS .EQ. 0 ) THEN
+            RADPTL(N)=RADIAS
+            AMIPTL(N)=PIOM+AMSIAC
+          ELSE
+            RADPTL(N)=RADIAC
+            AMIPTL(N)=PROM+AMSIAC
+          ENDIF
+          XPTL(N)=XAVER(1)
+          YPTL(N)=XAVER(2)
+          ZPTL(N)=XAVER(3)
+          TPTL(N)=XAVER(4)
+          IACPTL(N)=.FALSE.
+          IAAPTL(N)=1
+34      CONTINUE
+*       GOTO 24
+
+*250   GOTO 25
+
+24    CONTINUE
+      IF ( I .LT. NPTL-1 ) GOTO 9999
+
+      ISHNPT=ISH
+      IF ( ISHSUB/100 .EQ. 19 ) ISH=MOD(ISHSUB,100)
+      IF ( ISH .EQ. 22 ) THEN
+        WRITE(IFMT,131)NT,NBEF,NAFT,NPTL
+131     FORMAT(1X,'NT=',I5,4X,'NBEF=',I8,4X,'NAFT=',I8,4X,'NPTL=',I8)
+      ENDIF
+      ISH=ISHNPT
+CDH   IF ( ISH .EQ. 13 ) CALL UTTIMA('INTERACTIONS   ')
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JINTA2
+
+C----------------------------------------------------------------------
+C  SECONDARY INTERACTIONS: PERCOLATION--CLUSTER MODEL
+C----------------------------------------------------------------------
+      PARAMETER (KOLLMX=2500)
+      PARAMETER (MAMX=56)
+      PARAMETER (MXDKY=2000)
+      PARAMETER (MXINDX=1000)
+      PARAMETER (MXLOOK=10000)
+      PARAMETER (MXMA=11)
+      PARAMETER (MXMX=6)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXIFR=MXPTL)
+      PARAMETER (MXRE=100)
+      PARAMETER (MXSTR=3000)
+      PARAMETER (NDEP=129)
+      PARAMETER (NDET=129)
+      PARAMETER (NFLAV=6)
+      PARAMETER (NPRBMS=20)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /CIFRIJ/  IFRIJ(MXIFR)
+      COMMON /CJINT/   BX,BY,RNUP,RNUT,VELP,VELT,XAVER(4),NPTL0
+      COMMON /CKOL/    KOL
+      COMMON /CNCE/    NCES,NCOLEX
+      COMMON /CNFR/    NRFRA
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /COL/     BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
+     *                ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
+     *                ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
+     *                ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
+     *                ,XDET99(NDET)
+     *                ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
+     *                ,NRTARG(KOLLMX),NTARG
+      COMMON /CPRBMS/  PRBMS(NPRBMS)
+      COMMON /CPROJA/  IPROJ,ITARG,KPROJA(NHA,MAMX),KTARGA(NHA,MAMX)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CREMA/   REMA(MXRE,MXMA),REWI(MXRE,MXMA)
+     *                ,ICRE1(MXRE,MXMA),ICRE2(MXRE,MXMA)
+     *                ,IDMX(MXMA,MXMX),INDX(MXINDX)
+      COMMON /CSTR/    PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
+     *                ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
+      COMMON /CTIMEL/  NTC
+      DOUBLE PRECISION DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /CTTAUS/  DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /C2PTL/   AMIPTL(MXPTL),RADPTL(MXPTL),IAAPTL(MXPTL)
+      COMMON /C3PTL/   DESPTL(MXPTL),DEZPTL(MXPTL)
+      COMMON /C4PTL/   OPTL(MXPTL),TPTL(MXPTL),UPTL(MXPTL)
+     *                ,XPTL(MXPTL),YPTL(MXPTL),ZPTL(MXPTL)
+      COMMON /DIDIB/   NDIDIB
+      COMMON /DKYTAB/  CBR(MXDKY),LOOK(MXLOOK),MODE(5,MXDKY)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /PARTNR/  PEX,PEY,PEZET,PE0,PX4,PY4,SUMMAS
+     *                ,IC4,IPTNR,JS4,NPS
+
+      INTEGER          IC4(2),JC(NFLAV,2),JCDU(NFLAV,2),JCI(NFLAV,2)
+      LOGICAL          IACPTL(MXPTL+10)
+C----------------------------------------------------------------------
+C  INITIALIZATION FOR NTC=1
+C  ------------------------
+      IF ( NTC .EQ. 1 ) THEN
+        IF ( OVERLP.GE.0. .AND. MAPROJ.NE.0 .AND. MATARG.NE.0 ) THEN
+          IF ( MAPROJ .EQ. 1 ) THEN
+            RNUP=0.
+          ELSE
+            RNUP=1.19*MAPROJ**(.3333333)-1.61*MAPROJ**(-.3333333)
+          ENDIF
+          RNUP=RNUP+OVERLP
+          IF ( MATARG .EQ. 1 ) THEN
+            RNUT=0.
+          ELSE
+            RNUT=1.19*MATARG**(.3333333)-1.61*MATARG**(-.3333333)
+          ENDIF
+          RNUT=RNUT+OVERLP
+          VELP=PPTL(3,1)/PPTL(4,1)
+          VELT=PPTL(3,IABS(MAPROJ)+1)/PPTL(4,IABS(MAPROJ)+1)
+          BX=COS(PHIEVT)*BIMEVT
+          BY=SIN(PHIEVT)*BIMEVT
+        ENDIF
+        NPTL0=NPTL
+        DO 51 I=1,NPTL0
+          IAAPTL(I)=1
+          CALL IDQUAC(I,NQI,NDUMMY,NDUMMY,JCI)
+          IF ( NQI .EQ. 0 ) THEN
+            RADPTL(I)=RADIAS
+            DESPTL(I)=RADIAS
+            DEZPTL(I)=0.
+            AMIPTL(I)=PIOM+AMSIAC
+          ELSE
+            RADPTL(I)=RADIAC
+            DESPTL(I)=RADIAC
+            DEZPTL(I)=0.
+            AMIPTL(I)=PROM+AMSIAC
+          ENDIF
+51      CONTINUE
+      ENDIF
+
+C  INITIALIZATION FOR EACH NTC
+C  ---------------------------
+      NT=NTC
+      CALL UTPAGE
+CDH   IF ( ISH .EQ. 13 ) CALL UTTIMA('               ')
+      NBEF=NPTL
+CDH   N0BEF=NPTL0
+      NAFT=NPTL
+CDH   N0AFT=NPTL0
+      IF ( NCLEAN .GT. 0 ) THEN
+        IF ( MOD(NT-1,NCLEAN) .EQ. 0 ) THEN
+          CALL UTCLEA(NPTL0)
+          NAFT=NPTL
+CDH       N0AFT=NPTL0
+        ENDIF
+      ENDIF
+      TAUS=TTAUS
+      NPTLPT=ABS(MAPROJ)+ABS(MATARG)
+      IF ( NPTL .GT. NPTL0 ) THEN
+        DO 52 I=NPTL0+1,NPTL
+          CALL IDQUAC(I,NQI,NDUMMY,NDUMMY,JCI)
+          IF ( NQI .EQ. 0 ) THEN
+            RADPTL(I)=RADIAS
+            DESPTL(I)=RADIAS
+            DEZPTL(I)=0.
+            AMIPTL(I)=PIOM+AMSIAC
+          ELSE
+            RADPTL(I)=RADIAC
+            DESPTL(I)=RADIAC
+            DEZPTL(I)=0.
+            AMIPTL(I)=PROM+AMSIAC
+          ENDIF
+52      CONTINUE
+      ENDIF
+      DO 44 I=1,NPTL
+        IF ( ICLPTL(I).EQ.0 .AND. PPTL(5,I).GT.AMIPTL(I) ) THEN
+          IACPTL(I)=.TRUE.
+        ELSE
+          IACPTL(I)=.FALSE.
+        ENDIF
+        IF ( IORPTL(I).EQ.-1 ) IACPTL(I)=.TRUE.
+        CALL UTTAIN(I,X,Y,Z,T,N,0)
+        IF ( N.EQ.2 ) THEN
+          IF ( NCLEAN .GT. 0 ) THEN
+            IF ( MOD(NT,NCLEAN).EQ.0 ) THEN
+              ISTPTL(I)=2
+            ENDIF
+          ENDIF
+          IACPTL(I)=.TRUE.
+          GOTO 54
+        ENDIF
+        IF ( N.EQ.9 ) THEN
+          IACPTL(I)=.TRUE.
+          GOTO 54
+        ENDIF
+        IF ( N.EQ.1 ) THEN
+          IACPTL(I)=.TRUE.
+          GOTO 54
+        ENDIF
+        IF ( IAAPTL(I) .EQ. 0 ) THEN
+          IACPTL(I)=.TRUE.
+          GOTO 54
+        ENDIF
+        IF ( ISTPTL(I) .EQ. 2 ) IACPTL(I)=.TRUE.
+        IF ( ABS(IDPTL(I)) .LT. 100
+     *       .AND.  ABS(IDPTL(I)) .NE. 20 ) IACPTL(I)=.TRUE.
+        IF ( IDPTL(I) .EQ. 441  .AND.  JPSIFI .EQ. 0 ) IACPTL(I)=.TRUE.
+ 54     XPTL(I)=X
+        YPTL(I)=Y
+        ZPTL(I)=Z
+        TPTL(I)=T
+        CALL UTTAUS(Z,SZ)
+        OPTL(I)=SZ+DESPTL(I)
+        UPTL(I)=SZ-DESPTL(I)
+        IF ( OVERLP.GE.0. .AND. MAPROJ.NE.0 .AND. MATARG.NE.0 ) THEN
+          IF ( (X-BX*.5)**2+(Y-BY*.5)**2+(Z-VELP*TAUS)**2 .LT. RNUP**2
+     *         .AND. (X+BX*.5)**2+(Y+BY*.5)**2+(Z-VELT*TAUS)**2
+     *                                  .LT. RNUT**2 ) IACPTL(I)=.TRUE.
+        ENDIF
+44    CONTINUE
+      NPTL0=NPTL
+      I=0
+
+C  I LOOP --> 24
+C  -------------
+9999  I=I+1
+      IF ( IACPTL(I) ) GOTO 24
+      J0=NPTLPT+1
+      IF ( I .GT. NPTLPT ) J0=I+1
+      IF ( I .GT. NPTL0 ) J0=1
+      UPTLI = UPTL(I)
+      OPTLI = OPTL(I)
+
+C  J LOOP --> 250
+C  -------------
+      J = J0-1
+25    J = J+1
+      IF ( J .GT. NPTL ) GOTO 24
+        IF ( IACPTL(J) ) THEN
+          IF ( IACPTL(J+1) ) THEN
+            IF ( IACPTL(J+2) ) THEN
+              IF ( IACPTL(J+3) ) THEN
+                IF ( IACPTL(J+4) ) THEN
+                  IF ( IACPTL(J+5) ) THEN
+                    IF ( IACPTL(J+6) ) THEN
+                      IF ( IACPTL(J+7) ) THEN
+                        IF ( IACPTL(J+8) ) THEN
+                          IF ( IACPTL(J+9) ) THEN
+                            IF ( IACPTL(J+10) ) THEN
+                              J=J+10
+                              GOTO 25
+                            ELSE
+                              J=J+10
+                              IF ( J .GT. NPTL ) GOTO 24
+                              GOTO 26
+                            ENDIF
+                          ELSE
+                            J=J+9
+                            IF ( J .GT. NPTL ) GOTO 24
+                            GOTO 26
+                          ENDIF
+                        ELSE
+                          J=J+8
+                          IF ( J .GT. NPTL ) GOTO 24
+                          GOTO 26
+                        ENDIF
+                      ELSE
+                        J=J+7
+                        IF ( J .GT. NPTL ) GOTO 24
+                        GOTO 26
+                      ENDIF
+                    ELSE
+                      J=J+6
+                      IF ( J .GT. NPTL ) GOTO 24
+                      GOTO 26
+                    ENDIF
+                  ELSE
+                    J=J+5
+                    IF ( J .GT. NPTL ) GOTO 24
+                    GOTO 26
+                  ENDIF
+                ELSE
+                  J=J+4
+                  IF ( J .GT. NPTL ) GOTO 24
+                  GOTO 26
+                ENDIF
+              ELSE
+                J=J+3
+                IF ( J .GT. NPTL ) GOTO 24
+                GOTO 26
+              ENDIF
+            ELSE
+              J=J+2
+              IF ( J .GT. NPTL ) GOTO 24
+              GOTO 26
+            ENDIF
+          ELSE
+            J=J+1
+            IF ( J .GT. NPTL ) GOTO 24
+            GOTO 26
+          ENDIF
+        ENDIF
+ 26     IF ( OPTLI .LT. UPTL(J) ) GOTO 25
+        IF ( UPTLI .GE. OPTL(J) ) GOTO 25
+        RADSQR=(RADPTL(I)+RADPTL(J))**2
+        IF ( (YPTL(I)-YPTL(J))**2 .GT. RADSQR ) GOTO 25
+        IF ( (XPTL(I)-XPTL(J))**2 .GT. RADSQR ) GOTO 25
+        IF ( I .EQ. J ) GOTO 25
+        IF ( IORPTL(I).GT.0 .AND. IORPTL(J).EQ.IORPTL(I) ) GOTO 25
+        IF ( IORPTL(I) .EQ. J ) GOTO 25
+        IF ( IORPTL(J) .EQ. I ) GOTO 25
+        IF ( (XPTL(I)-XPTL(J))**2+(YPTL(I)-YPTL(J))**2 .GT. RADSQR )
+     *                                                       GOTO 25
+        CALL JINTCC(I,J,IRET)
+        IF ( IRET .EQ. 1 ) GOTO 25
+
+        IACTN=0
+        NPTL00=NPTL
+        NSTR00=NSTR
+        XAVER(1)=(XPTL(I)+XPTL(J))*0.5
+        XAVER(2)=(YPTL(I)+YPTL(J))*0.5
+        XAVER(3)=(ZPTL(I)+ZPTL(J))*0.5
+        XAVER(4)=(TPTL(I)+TPTL(J))*0.5
+
+        CALL JINTFS(I,J,NQIFUS,JC,AMIM,IRET)
+        IF ( IRET .EQ. 1 ) GOTO 25
+
+        CALL JINTCE(I,J,AMIM,IACTN,IRET)
+        IF ( IRET .EQ. 25 ) GOTO 25
+
+        TIVPTL(2,I)=TPTL(I)
+        TIVPTL(2,J)=TPTL(J)
+        ISTPTL(I)=1
+        ISTPTL(J)=1
+        IACPTL(I)=.TRUE.
+        IACPTL(J)=.TRUE.
+
+        CALL JINTCH(I,J,KMAX)
+        DO 30 K=1,KMAX
+          N=IFRIJ(K)
+          ISTPTL(N)=2
+          IACPTL(N)=.TRUE.
+30      CONTINUE
+        CALL JINTPA(I,J,KMAX)
+        DO 31 K=1,KMAX
+          N=IFRIJ(K)
+          IACPTL(N)=.TRUE.
+31      CONTINUE
+
+        IF ( IACTN .EQ. 1 ) THEN
+          DO 32 N=NPTL00+1,NPTL
+            IAAPTL(N)=1
+            CALL IDQUAC(N,NQI,NDUMMY,NDUMMY,JCDU)
+            IF ( NQI .EQ. 0 ) THEN
+              RADPTL(N)=RADIAS
+              DESPTL(N)=RADIAS
+              DEZPTL(N)=0.
+              AMIPTL(N)=PIOM+AMSIAC
+            ELSE
+              RADPTL(N)=RADIAC
+              DESPTL(N)=RADIAC
+              DEZPTL(N)=0.
+              AMIPTL(N)=PROM+AMSIAC
+            ENDIF
+            IACPTL(N)=.FALSE.
+            IF ( PPTL(5,N) .GT. AMIPTL(N) ) IACPTL(N)=.TRUE.
+            CALL UTTAIN(N,X,Y,Z,T,K,0)
+            IF ( K.EQ.1 .OR. K.EQ.2 .OR. K.EQ.9 ) IACPTL(N)=.TRUE.
+            IF ( ABS(IDPTL(N)).LT.100 .AND. ABS(IDPTL(N)).NE.20 )
+     *                                              IACPTL(N)=.TRUE.
+            XPTL(N)=X
+            YPTL(N)=Y
+            ZPTL(N)=Z
+            TPTL(N)=T
+            CALL UTTAUS(Z,SZ)
+            OPTL(N)=SZ+DESPTL(N)
+            UPTL(N)=SZ-DESPTL(N)
+            IF ( OVERLP.GE.0. .AND. MAPROJ.NE.0 .AND. MATARG.NE.0 ) THEN
+              IF ( (X-BX*.5)**2+(Y-BY*.5)**2+(Z-VELP*TAUS)**2.LT.RNUP**2
+     *           .AND. (X+BX*.5)**2+(Y+BY*.5)**2+(Z-VELT*TAUS)**2
+     *                                    .LT.RNUT**2 ) IACPTL(N)=.TRUE.
+            ENDIF
+32        CONTINUE
+          GOTO 24
+        ENDIF
+
+        CALL JINTEL(I,J,AMIM,IACTN)
+        IF ( IACTN .EQ. 2 ) THEN
+          DO 33 N=NPTL00+1,NPTL
+            IF     ( N .EQ. NPTL00+1 ) THEN
+              IJ=I
+            ELSEIF ( N .EQ. NPTL00+2 ) THEN
+              IJ=J
+            ENDIF
+            RADPTL(N)=RADPTL(IJ)
+            DESPTL(N)=DESPTL(IJ)
+            DEZPTL(N)=DEZPTL(IJ)
+            AMIPTL(N)=AMIPTL(IJ)
+            XPTL(N)=XAVER(1)
+            YPTL(N)=XAVER(2)
+            ZPTL(N)=XAVER(3)
+            TPTL(N)=XAVER(4)
+            Z=ZPTL(N)
+            CALL UTTAUS(Z,SZ)
+            OPTL(N)=SZ+DESPTL(N)
+            UPTL(N)=SZ-DESPTL(N)
+            IACPTL(N)=.FALSE.
+            IAAPTL(N)=1
+33        CONTINUE
+          GOTO 24
+        ENDIF
+
+        CALL JINTFU(I,J,JC,IACTN)
+        DO 34 N=NPTL00+1,NPTL
+          IF ( NQIFUS .EQ. 0 ) THEN
+            RADPTL(N)=RADIAS
+            DESPTL(N)=RADIAS
+            DEZPTL(N)=0.
+            AMIPTL(N)=PIOM+AMSIAC
+          ELSE
+            RADPTL(N)=RADIAC
+            DESPTL(N)=RADIAC
+            DEZPTL(N)=0.
+            AMIPTL(N)=PROM+AMSIAC
+          ENDIF
+          XPTL(N)=XAVER(1)
+          YPTL(N)=XAVER(2)
+          ZPTL(N)=XAVER(3)
+          TPTL(N)=XAVER(4)
+          Z=ZPTL(N)
+          CALL UTTAUS(Z,SZ)
+          OPTL(N)=SZ+DESPTL(N)
+          UPTL(N)=SZ-DESPTL(N)
+          IACPTL(N)=.FALSE.
+          IAAPTL(N)=1
+34      CONTINUE
+        IF ( ISH .EQ. 23  .AND.  PPTL(5,NPTL) .GE. AMPRIF ) THEN
+          N=NPTL
+          CALL JINTFP(I,J,N,
+     *           XPTL(I),YPTL(I),RADPTL(I),OPTL(I),UPTL(I),
+     *           XPTL(J),YPTL(J),RADPTL(J),OPTL(J),UPTL(J),
+     *           XPTL(N),YPTL(N),RADPTL(N),OPTL(N),UPTL(N))
+        ENDIF
+*       GOTO 24
+
+*250  GOTO 25
+
+24    CONTINUE
+      IF ( I .LT. NPTL-1 ) GOTO 9999
+
+      IF ( ISH .EQ. 24 ) THEN
+        IF ( TAUS.EQ.1.  .OR.  TAUS.EQ.2.  .OR.
+     *       TAUS.EQ.4.  .OR.  TAUS.EQ.8.      ) THEN
+          DO 45 I=1,NPTL
+            IF ( IACPTL(I)  .AND.  I .NE. NPTL ) GOTO 45
+            CALL JINTCL(I,XPTL(I),YPTL(I),RADPTL(I)
+     *                                       ,OPTL(I),UPTL(I),IACPTL(I))
+45        CONTINUE
+        ENDIF
+      ENDIF
+
+      ISHNPT=ISH
+      IF ( ISHSUB/100 .EQ. 19 ) ISH=MOD(ISHSUB,100)
+      IF ( ISH .EQ. 22 ) THEN
+        WRITE(IFMT,131)NT,NBEF,NAFT,NPTL
+131     FORMAT(1X,'NT=',I5,4X,'NBEF=',I8,4X,'NAFT=',I8,4X,'NPTL=',I8)
+      ENDIF
+      ISH=ISHNPT
+CDH   IF ( ISH .EQ. 13 ) CALL UTTIMA('INTERACTIONS   ')
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JINTCC(I,J,IRET)
+
+C---------------------------------------------------------------------
+C  IRET=1 IF I = CHILD OF J
+C  IRET=1 IF J = CHILD OF I
+C  IRET=0 ELSE
+C---------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXIFR=MXPTL)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /C2PTL/   AMIPTL(MXPTL),RADPTL(MXPTL),IAAPTL(MXPTL)
+
+      INTEGER IFR(MXIFR)
+C---------------------------------------------------------------------
+      IRET=0
+      DO 57 KK=1,2
+        IF ( KK .EQ. 1 ) THEN
+          N=I
+          M=J
+        ELSE
+          N=J
+          M=I
+        ENDIF
+        K1=0
+        K2=0
+        LOOP=0
+55      LOOP=LOOP+1
+        IF ( IFRPTL(1,N) .GT. 0 ) THEN
+          DO 56 K=IFRPTL(1,N),IFRPTL(2,N)
+            IF ( K .EQ. M ) GOTO 1001
+            K2=K2+1
+            IF ( K2 .GT. MXIFR ) THEN
+              CALL UTSTOP('JINTCC: K2 > MXIFR                      ')
+            ENDIF
+            IFR(K2)=K
+56        CONTINUE
+        ENDIF
+        K1=K1+1
+        IF ( K1 .LE. K2 ) THEN
+          N=IFR(K1)
+          GOTO 55
+        ENDIF
+57    CONTINUE
+      GOTO 1000
+
+1001  IRET=1
+
+1000  RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JINTCE(I,J,AMIM,IACTN,IRET)
+
+C----------------------------------------------------------------------
+C  COLOUR EXCHANGE INTERACTION OF PTLS I,J
+C  INPUT:
+C  I,J: PTL NUMBERS; AMF: MASS, AMIM: MIN MASS, OF FUSED OBJ
+C  IACTN=1: CE DONE
+C  IRET=0: CE DONE  OR  CRITERIA FOR CE NOT FULFILLED
+C  IRET=25: SKIP
+C----------------------------------------------------------------------
+      PARAMETER (KOLLMX=2500)
+      PARAMETER (MAMX=56)
+      PARAMETER (MXDKY=2000)
+      PARAMETER (MXINDX=1000)
+      PARAMETER (MXLOOK=10000)
+      PARAMETER (MXMA=11)
+      PARAMETER (MXMX=6)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXRE=100)
+      PARAMETER (MXSTR=3000)
+      PARAMETER (NDEP=129)
+      PARAMETER (NDET=129)
+      PARAMETER (NPRBMS=20)
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /CJINT/   BX,BY,RNUP,RNUT,VELP,VELT,XAVER(4),NPTL0
+      COMMON /CKOL/    KOL
+      COMMON /CNCE/    NCES,NCOLEX
+      COMMON /CNFR/    NRFRA
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /COL/     BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
+     *                ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
+     *                ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
+     *                ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
+     *                ,XDET99(NDET)
+     *                ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
+     *                ,NRTARG(KOLLMX),NTARG
+      COMMON /CPRBMS/  PRBMS(NPRBMS)
+      COMMON /CPROJA/  IPROJ,ITARG,KPROJA(NHA,MAMX),KTARGA(NHA,MAMX)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CREMA/   REMA(MXRE,MXMA),REWI(MXRE,MXMA)
+     *                ,ICRE1(MXRE,MXMA),ICRE2(MXRE,MXMA)
+     *                ,IDMX(MXMA,MXMX),INDX(MXINDX)
+      COMMON /CSTR/    PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
+     *                ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
+      COMMON /CTIMEL/  NTC
+      DOUBLE PRECISION DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /CTTAUS/  DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /C2PTL/   AMIPTL(MXPTL),RADPTL(MXPTL),IAAPTL(MXPTL)
+      COMMON /DIDIB/   NDIDIB
+      COMMON /DKYTAB/  CBR(MXDKY),LOOK(MXLOOK),MODE(5,MXDKY)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /PARTNR/  PEX,PEY,PEZET,PE0,PX4,PY4,SUMMAS
+     *                ,IC4,IPTNR,JS4,NPS
+
+      DOUBLE PRECISION ARM(5),ARP(5),ARQ,BOO(5),ROT(3)
+      REAL             PROJ(NSI,NHA),PSUM(5),TARG(NSI,NHA)
+      INTEGER          IC(2),IC4(2)
+C----------------------------------------------------------------------
+C  INITIALIZATION
+C  --------------
+      IRET=0
+      DELRAP=1.5
+      DELAMF=1.0
+      ISH00=ISH
+      PNLLX0=PNLLX
+      TAUS=TTAUS
+      AMF=PPTL(5,NPTL+1)
+
+C  CHECK WHETHER CE CRITERIA FULFILLED
+C  -----------------------------------
+      VEI=PPTL(3,I)/PPTL(4,I)
+      VEJ=PPTL(3,J)/PPTL(4,J)
+      IF ( ABS(VEI) .LT. 1.  .AND.  ABS(VEJ) .LT. 1. ) THEN
+        RAI=0.5*LOG((1.+VEI)/(1.-VEI))
+        RAJ=0.5*LOG((1.+VEJ)/(1.-VEJ))
+      ELSE
+        RAI=0.
+        RAJ=0.
+      ENDIF
+      IF ( .NOT. (AMF.GT.AMIM+DELAMF .AND. ABS(RAI-RAJ).GT.DELRAP
+     *            .AND. ABS(IDPTL(I)).LT.10000
+     *            .AND. ABS(IDPTL(J)).LT.10000) ) GOTO 1000
+      IACTN=1
+
+C  PRINT
+C  -----
+      IF ( ISH .GE. 91 ) THEN
+        IF ( ISH .GE. 92 ) WRITE(IFCH,*)' '
+        WRITE(IFCH,101)NTC,TAUS
+101     FORMAT(1X,'CO.EX. INTERACTION --- NT=',I3,' --- TAUS=',F6.2)
+        IF ( ISH .GE. 92 ) WRITE(IFCH,*)' '
+        WRITE(IFCH,115)I,IDPTL(I)
+     *                  ,(PPTL(K,I),K=3,5),(XORPTL(K,I),K=3,4)
+115     FORMAT(1X,'/CPTL/',I8,I10
+     *            ,1X,2(E10.2),E10.2,1X,2(E10.2),2X,I4)
+        WRITE(IFCH,115)J,IDPTL(J)
+     *                  ,(PPTL(K,J),K=3,5),(XORPTL(K,J),K=3,4)
+        IF ( ISH .GE. 92 ) THEN
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,*)'AMF,AMIM: ',AMF,AMIM
+          WRITE(IFCH,*)'RAI,RAJ:  ',RAI,RAJ
+          WRITE(IFCH,*)' '
+        ENDIF
+      ENDIF
+
+C  INITIALIZATION
+C  --------------
+      NPTL00=NPTL
+      NSTR00=NSTR
+
+      IPROJ=1
+      ITARG=1
+      DO 11 L=1,NHA
+        KPROJA(L,1)=1
+        KTARGA(L,1)=1
+11    CONTINUE
+      KOL=1
+      COORD(1,1)=XAVER(1)
+      COORD(2,1)=XAVER(2)
+      COORD(3,1)=XAVER(3)
+      COORD(4,1)=XAVER(4)
+
+      IDP=IDPTL(I)
+      IDM=IDPTL(J)
+      DO 12 L=1,5
+        ARP(L)=PPTL(L,I)
+        ARM(L)=PPTL(L,J)
+        BOO(L)=PPTL(L,NPTL+1)
+12    CONTINUE
+      SROOT = ABS(PPTL(5,NPTL+1))
+      S=PPTL(5,NPTL+1)**2
+
+C  BOOSTS INTO I-J CM
+C  ------------------
+      CALL UTLOB2(1,BOO(1),BOO(2),BOO(3),BOO(4),BOO(5)
+     *             ,ARP(1),ARP(2),ARP(3),ARP(4))
+      CALL UTLOB2(1,BOO(1),BOO(2),BOO(3),BOO(4),BOO(5)
+     *             ,ARM(1),ARM(2),ARM(3),ARM(4))
+      IF ( ARP(3) .LT. 0.D0 ) THEN
+        IDQ=IDM
+        IDM=IDP
+        IDP=IDQ
+        DO 14 L=1,5
+          ARQ=ARM(L)
+          ARM(L)=ARP(L)
+          ARP(L)=ARQ
+14      CONTINUE
+      ENDIF
+      PNLLX=ARP(3)
+      ROT(1)=(ARP(1)-ARM(1))*0.5D0
+      ROT(2)=(ARP(2)-ARM(2))*0.5D0
+      ROT(3)=(ARP(3)-ARM(3))*0.5D0
+      CALL UTROT2(1,ROT(1),ROT(2),ROT(3)
+     *             ,ARP(1),ARP(2),ARP(3))
+      CALL UTROT2(1,ROT(1),ROT(2),ROT(3)
+     *             ,ARM(1),ARM(2),ARM(3))
+
+C  CHECKS
+C  ------
+      IF ( ARP(3) .LT. 0.D0 ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JINTCE')
+          WRITE(IFCH,*)'*****  Z-COMP OF +JET < 0.'
+          WRITE(IFCH,*)(SNGL(ARP(L)),L=1,4)
+          WRITE(IFCH,*)(SNGL(ARM(L)),L=1,4)
+          CALL UTMSGF
+        ENDIF
+        GOTO 10025
+      ENDIF
+      IF ( ABS(SNGL(ARP(4)+ARM(4))-SROOT) .GT.
+     *                                 2.E-2*SROOT ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JINTCE')
+          WRITE(IFCH,*)'*****  ARP(4)+ARM(4)-SQRT(S) NONZERO'
+          WRITE(IFCH,*)'VALUE:   ',SNGL(ARP(4)+ARM(4))-SROOT
+          WRITE(IFCH,*)'SQRT(S): ',SROOT
+          WRITE(IFCH,*)(SNGL(ARP(I)),I=1,4)
+          WRITE(IFCH,*)(SNGL(ARM(I)),I=1,4)
+          CALL UTMSGF
+        ENDIF
+      ENDIF
+
+C  FILL PROJ, TARG
+C  ---------------
+      CALL IDTR4(IDP,IC)
+      DO 25 M=1,NHA
+        DO 24 N=1,NSI
+          PROJ(N,M)=0.
+24      CONTINUE
+25    CONTINUE
+      PROJ(5,1)=IC(1)
+      PROJ(6,1)=IC(2)
+      PROJ(5,2)=IC(1)
+      PROJ(6,2)=IC(2)
+      PROJ(1,2)=ARP(1)
+      PROJ(2,2)=ARP(2)
+      PROJ(3,2)=ARP(3)
+      PROJ(4,2)=ARP(4)
+      CALL IDTR4(IDM,IC)
+      DO 28 M=1,NHA
+        DO 27 N=1,NSI
+          TARG(N,M)=0.
+27      CONTINUE
+28    CONTINUE
+      TARG(5,1)=IC(1)
+      TARG(6,1)=IC(2)
+      TARG(5,2)=IC(1)
+      TARG(6,2)=IC(2)
+      TARG(1,2)=ARM(1)
+      TARG(2,2)=ARM(2)
+      TARG(3,2)=ARM(3)
+      TARG(4,2)=ARM(4)
+
+C  REDO
+C  ----
+      CALL UTREMB(PROJ,TARG,1)
+      LOO=1
+      GOTO 58
+57    CONTINUE
+      LOO=LOO+1
+      IF ( LOO .GT. 20 ) GOTO 10025
+      IF ( ISH .GE. 91 ) WRITE(IFCH,*)'REDO HH COLLISION'
+      CALL UTREST(PROJ,TARG,1)
+58    CONTINUE
+
+C  NUMBER OF CE'S
+C  --------------
+      NCOLEX=1
+C-C   LO=0
+C-C16 LO=LO+1
+C-C   IF ( LO .EQ. 3 ) THEN
+C-C     IF ( ISH .GE. 90 ) THEN
+C-C       CALL UTMSG('JINTCE')
+C-C       WRITE(IFCH,*)'*****  LO=3'
+C-C       CALL UTMSGF
+C-C     ENDIF
+C-C   ENDIF
+C-C   R=RANGEN()
+C-C   NCOLEX=0
+C-C15 NCOLEX=NCOLEX+1
+C-C   IF ( NCOLEX .GT. NPRBMS ) GOTO 16
+C-C   IF ( R .GT. PRBMS(NCOLEX) ) GOTO 15
+
+C  DO NCOLEX CE'S
+C  --------------
+      ISKIP=0
+      DO 30 NCE=1,NCOLEX
+        IF ( ISH .GE. 92 .AND. NCE .GT. 1 ) THEN
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,*)NCE,'. COLOUR EXCHANGE'
+          WRITE(IFCH,*)' '
+        ENDIF
+        NCES=NCE
+        ISH=ISH-2
+        CALL HAHABS(PROJ,TARG,NCE/NCOLEX,NCE/NCOLEX,ISKIP,IRETHH)
+        ISH=ISH+2
+        IF ( ISKIP .NE. 0 ) GOTO 10025
+        IF ( IRETHH .EQ. 1 ) GOTO 57
+30    CONTINUE
+
+C  FRAGMENTATION
+C  -------------
+      IF ( NSTR .LE. NSTR00 ) GOTO 10050
+
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,123)
+123     FORMAT(/1X,'STRINGS BEFORE RESCALING'/)
+        DO 31 L=NSTR00+1,NSTR
+          WRITE(IFCH,109)L,(ICSTR(K,L)/100,K=1,4)
+     *          ,SQRT(PSTR(1,L)**2+PSTR(2,L)**2),PSTR(3,L),PSTR(5,L)
+     *          ,IRLSTR(L)
+109       FORMAT(' /CSTR/',I5,3X,4I5,3(E11.3),I5)
+31      CONTINUE
+      ENDIF
+
+      IF ( IRESCL .EQ. 1 ) THEN
+        PSUM(1)=0.
+        PSUM(2)=0.
+        PSUM(3)=0.
+        PSUM(4)=SROOT
+        PSUM(5)=SROOT
+        ISH=ISH-2
+        CALL HRESCL(NSTR00+1,NSTR,PSUM,IFAIL)
+        ISH=ISH+2
+        IF ( IFAIL .NE. 0 ) GOTO 57
+      ENDIF
+
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,124)
+124     FORMAT(/1X,'STRINGS AFTER RESCALING'/)
+        DO 32 L=NSTR00+1,NSTR
+          WRITE(IFCH,109)L,(ICSTR(K,L)/100,K=1,4)
+     *          ,SQRT(PSTR(1,L)**2+PSTR(2,L)**2),PSTR(3,L),PSTR(5,L)
+     *          ,IRLSTR(L)
+32      CONTINUE
+      ENDIF
+
+      DO 33 L=NSTR00+1,NSTR
+        IF ( ISH .GE. 92 ) WRITE(IFCH,122)L
+     *             ,(ICSTR(K,L),K=1,4)
+     *             ,SQRT(PSTR(1,L)**2+PSTR(2,L)**2),PSTR(3,L),PSTR(5,L)
+122     FORMAT(/' STR:',I7,4I7,3(E10.2)/)
+        ISH=ISH-2
+        CALL JAMFRA(L,NEWEVT)
+        ISH=ISH+2
+        IF ( NEWEVT .EQ. 1 ) GOTO 10025
+33    CONTINUE
+
+C  BOOST PARTICLES FROM STRING FRAGMENTATION
+C  -----------------------------------------
+      IF ( NPTL .LE. NPTL00 ) GOTO 10051
+
+      IORPTL(NPTL00+1)=I
+      JORPTL(NPTL00+1)=J
+      DO 34 L=1,5
+        PSUM(L)=0.
+34    CONTINUE
+
+      DO 38 N=NPTL00+1,NPTL
+
+        DO 35 L=1,5
+          ARP(L)=PPTL(L,N)
+35      CONTINUE
+        CALL UTROT2(-1,ROT(1),ROT(2),ROT(3)
+     *                ,ARP(1),ARP(2),ARP(3))
+        CALL UTLOB2(-1,BOO(1),BOO(2),BOO(3),BOO(4),BOO(5)
+     *                ,ARP(1),ARP(2),ARP(3),ARP(4))
+        DO 36 L=1,5
+          PPTL(L,N)=ARP(L)
+36      CONTINUE
+        NQJPTL(N)=0
+
+        IF ( ISTPTL(N) .EQ. 0 ) THEN
+          PSUM(1)=PSUM(1)+PPTL(1,N)
+          PSUM(2)=PSUM(2)+PPTL(2,N)
+          PSUM(3)=PSUM(3)+PPTL(3,N)
+          PSUM(4)=PSUM(4)+PPTL(4,N)
+        ENDIF
+
+        IF ( ISH .GE. 91 ) THEN
+          WRITE(IFCH,115)N,IDPTL(N)
+     *              ,(PPTL(K,N),K=3,5),(XORPTL(K,N),K=3,4),ISTPTL(N)
+        ENDIF
+
+38    CONTINUE
+
+      IF ( ISH .GE. 90 ) THEN
+        IF ( ISH .GE. 92 ) THEN
+          WRITE(IFCH,*)'P_FIN:',(PSUM(K),K=1,4)
+          WRITE(IFCH,*)'P_INI:',(BOO(K),K=1,4)
+        ENDIF
+
+        IF ( (ABS(BOO(1)-PSUM(1)) .GT. 5.E-3*ABS(BOO(1))
+     *         .OR. ABS(BOO(2)-PSUM(2)) .GT. 5.E-3*ABS(BOO(2))
+     *         .OR. ABS(BOO(3)-PSUM(3)) .GT. 5.E-3*ABS(BOO(3))
+     *         .OR. ABS(BOO(4)-PSUM(4)) .GT. 1.E-1*ABS(BOO(4)))
+     *    .AND.
+     *       (ABS(BOO(1)-PSUM(1)) .GT. 5.E-3
+     *         .OR. ABS(BOO(2)-PSUM(2)) .GT. 5.E-3
+     *         .OR. ABS(BOO(3)-PSUM(3)) .GT. 5.E-3
+     *         .OR. ABS(BOO(4)-PSUM(4)) .GT. 1.E-1) ) THEN
+          CALL UTMSG('JINTCE')
+          WRITE(IFCH,*)'*****  P_INI /= P_FIN'
+          WRITE(IFCH,*)'FINAL PARTICLES:'
+          DO 39 N=NPTL00+1,NPTL
+            WRITE(IFCH,125)N,IDPTL(N),(PPTL(K,N),K=1,5),ISTPTL(N)
+125         FORMAT(1X,'/CPTL/',I6,I10,5(E11.3),I2)
+39        CONTINUE
+          WRITE(IFCH,*)'P_FIN:',(PSUM(K),K=1,4)
+          WRITE(IFCH,*)'P_INI:',(SNGL(BOO(K)),K=1,4)
+          CALL UTMSGF
+        ENDIF
+      ENDIF
+      GOTO 1000
+
+C  FINISH
+C  ------
+
+10025 CONTINUE
+      IRET=25
+      IF ( ISH .GE. 91 ) WRITE(IFCH,*)'SKIP'
+      NPTL=NPTL00
+      NSTR=NSTR00
+      GOTO 1000
+
+10050 CONTINUE
+      CALL UTMSG('JINTCE')
+      WRITE(IFCH,*)'INCIDENT PARTICLES:'
+      WRITE(IFCH,115)I,IDPTL(I),(PPTL(K,I),K=3,5)
+      WRITE(IFCH,115)J,IDPTL(J),(PPTL(K,J),K=3,5)
+      WRITE(IFCH,*)'NSTR=',NSTR,'    NSTR00=',NSTR00
+      CALL UTMSGF
+      CALL UTSTOP('JINTCE: NSTR .LE. NSTR00                ')
+
+10051 CONTINUE
+      CALL UTMSG('JINTCE')
+      WRITE(IFCH,*)'INCIDENT PARTICLES:'
+      WRITE(IFCH,115)I,IDPTL(I),(PPTL(K,I),K=3,5)
+      WRITE(IFCH,115)J,IDPTL(J),(PPTL(K,J),K=3,5)
+      WRITE(IFCH,*)'NSTR=',NSTR,'    NSTR00=',NSTR00
+      WRITE(IFCH,*)'NPTL=',NPTL,'    NPTL00=',NPTL00
+      CALL UTMSGF
+      CALL UTSTOP('JINTCE: NPTL .LE. NPTL00                ')
+
+1000  CONTINUE
+      PNLLX=PNLLX0
+      ISH=ISH00
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JINTCH(I,J,KMAX)
+
+C----------------------------------------------------------------------
+C  WRITES CHILDREN OF I,J TO IFRIJ(1-KMAX)
+C----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXIFR=MXPTL)
+      COMMON /CIFRIJ/  IFRIJ(MXIFR)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+C----------------------------------------------------------------------
+      KCUR=0
+      KMAX=0
+      LOOP=0
+31    LOOP=LOOP+1
+      IF     ( LOOP .EQ. 1 ) THEN
+        N=I
+      ELSEIF ( LOOP .EQ. 2 ) THEN
+        N=J
+      ENDIF
+      IF ( IFRPTL(1,N) .GT. 0 ) THEN
+        IF ( ISH.GE.92 ) WRITE(IFCH,*)N,' ---> ',IFRPTL(1,N),IFRPTL(2,N)
+        DO 30 K=IFRPTL(1,N),IFRPTL(2,N)
+          KMAX=KMAX+1
+          IF ( KMAX .GT. MXIFR ) THEN
+            CALL UTSTOP('JINTCH: KMAX > MXIFR                    ')
+          ENDIF
+          IFRIJ(KMAX)=K
+30      CONTINUE
+      ENDIF
+      IF ( LOOP .EQ. 1 ) GOTO 31
+      KCUR=KCUR+1
+      IF ( KCUR .LE. KMAX ) THEN
+        N=IFRIJ(KCUR)
+        GOTO 31
+      ENDIF
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JINTCL(I,X,Y,RAD,O,U,IAC)
+
+C---------------------------------------------------------------------
+C  FILLS HISTOGRAM CONCERNING CLUSTER CHARACTERISTICS
+C---------------------------------------------------------------------
+      PARAMETER (MXEPS=10)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXTAU=4)
+      PARAMETER (MXVOL=10)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CJINTC/  CLUST(MXTAU,MXVOL,MXEPS)
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      DOUBLE PRECISION DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /CTTAUS/  DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /CVSN/    IVERSN
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /NEVNT/   NEVNT
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /PARO5/   DELEPS,DELVOL
+
+      CHARACTER AX*2
+      LOGICAL   IAC
+C---------------------------------------------------------------------
+      TAU=SNGL(TTAUS)
+CDH   ITAU=1+LOG(TAU)/LOG(2.)
+      ITAU=1+LOG(TAU)*1.442695
+
+      IF ( IAC ) GOTO 1
+
+      VOL=(O-U)*RAD**2*PI
+      IVOL=1+VOL/DELVOL
+      EPS=PPTL(5,I)/VOL
+      IEPS=1+EPS/DELEPS
+      IF ( ITAU.GE.1 .AND. ITAU.LE.MXTAU .AND.
+     *     IVOL.GE.1 .AND. IVOL.LE.MXVOL .AND.
+     *     IEPS.GE.1 .AND. IEPS.LE.MXEPS )
+     *                CLUST(ITAU,IVOL,IEPS)=CLUST(ITAU,IVOL,IEPS)+1
+
+ 1    CONTINUE
+      IF ( I .LT. NPTL  .OR.  NREVT+1 .LT. NEVNT ) GOTO 1000
+
+      IF ( ITAU .EQ. 1 ) WRITE(IFCH,105)MAPROJ,MATARG,ENGY,IVERSN/100.
+105   FORMAT(/1X,'PROJ=',I3,3X,'TARG=',I3,3X,'ENGY=',F7.2
+     *          ,3X,'VENUS ',F4.2,' (TURBOVENUS)')
+      WRITE(IFCH,100)TAU,ITAU,NEVNT,DELVOL,DELEPS
+100   FORMAT(/1X,'TAU=',F5.2,3X,'ITAU=',I1
+     *          ,3X,'NEVNT=',I4,3X,'DELVOL=',F5.1,3X,'DELEPS=',F5.1/)
+      WRITE(IFCH,101)
+101   FORMAT(9X,'IVOL=1 IVOL=2 IVOL=3 IVOL=4 IVOL=5 '
+     *         ,'IVOL=6 IVOL=7 IVOL=8 IVOL=9 IVOL=10 ')
+      DO 106 IE=1,MXEPS
+        IF ( IE .LE. 9 ) THEN
+          WRITE(AX,102)IE
+102       FORMAT('0',I1)
+        ELSE
+          WRITE(AX,103)IE
+103       FORMAT(I2)
+        ENDIF
+        WRITE(IFCH,104)AX,(NINT(CLUST(ITAU,IV,IE)),IV=1,MXVOL)
+104     FORMAT(' IEPS=',A2,10I7)
+106   CONTINUE
+
+1000  CONTINUE
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JINTEL(I,J,AMIM,IACTN)
+
+C----------------------------------------------------------------------
+C  ELASTIC SCATTERING OF PTLS I,J
+C  EL SCATT REQUIR NOT FULF: RETURN WITHOUT ACTION, IACTN UNCHANGED
+C    ELSE: ELASTIC SCATTERING DONE, IACTN=2
+C----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      PARAMETER (NPTQ=129)
+      COMMON /CJINT/   BX,BY,RNUP,RNUT,VELP,VELT,XAVER(4),NPTL0
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CPTQ/    QPTH(NPTQ),QPTQ(NPTQ),XPTQ(NPTQ),QPTQMX,QPTHMX
+      COMMON /CTIMEL/  NTC
+      DOUBLE PRECISION DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /CTTAUS/  DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      REAL             P(5),PEI(5),PEJ(5),U(5)
+C----------------------------------------------------------------------
+C  CHECK
+C  -----
+      AMF=PPTL(5,NPTL+1)
+      IF ( AMF .GE. AMIM ) GOTO 1000
+
+C  PRINT
+C  -----
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,101)NTC,SNGL(TTAUS)
+101     FORMAT(1X,'ELASTIC SCATTERING --- NT=',I3,' --- TAUS=',F6.2)
+        WRITE(IFCH,115)I,IDPTL(I)
+     *                  ,(PPTL(K,I),K=3,5),(XORPTL(K,I),K=3,4)
+        WRITE(IFCH,115)J,IDPTL(J)
+     *                  ,(PPTL(K,J),K=3,5),(XORPTL(K,I),K=3,4)
+115     FORMAT(1X,'/CPTL/',I6,I10
+     *           ,1X,2(E10.2),E11.2,1X,2(E10.2),2X,I4)
+      ENDIF
+
+C  INITIALIZATION
+C  --------------
+      IACTN=2
+      DO 125 K=1,5
+        P(K)=PPTL(K,NPTL+1)
+125   CONTINUE
+
+C  DETERMINE MOMENTA OF OUTGOING PARTICLES (PEI,PEJ)
+C  -------------------------------------------------
+      IF     ( P(5) .LE. (PPTL(5,I)+PPTL(5,J))*.99 ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JINTEL')
+          WRITE(IFCH,132)P(5),PPTL(5,I)+PPTL(5,J)
+132       FORMAT(1X,'*****  M_FUS < M_I+M_J ---> QCM SET ZERO    ( '
+     *             ,2F10.3,' )')
+          WRITE(IFCH,133)'P_I:  ',(PPTL(K,I),K=1,5)
+          WRITE(IFCH,133)'P_J:  ',(PPTL(K,J),K=1,5)
+          WRITE(IFCH,133)'P_FUS:',(P(K),K=1,5)
+133       FORMAT(1X,A6,3X,5F10.3)
+          CALL UTMSGF
+        ENDIF
+        QCM=0.
+      ELSEIF ( P(5) .LE. PPTL(5,I)+PPTL(5,J) ) THEN
+        QCM=0.
+      ELSE
+        QCM=UTPCM(P(5),PPTL(5,I),PPTL(5,J))
+      ENDIF
+
+C  ISOTROPIC
+      U(3)=2.*RANGEN()-1.
+      PHI=2.*PI*RANGEN()
+      AUXIL=SQRT(1.-U(3)**2)
+      U(1)=AUXIL*COS(PHI)
+      U(2)=AUXIL*SIN(PHI)
+      PEI(1)= QCM*U(1)
+      PEJ(1)=-QCM*U(1)
+      PEI(2)= QCM*U(2)
+      PEJ(2)=-QCM*U(2)
+      PEI(3)= QCM*U(3)
+      PEJ(3)=-QCM*U(3)
+
+C  NONISOTROPIC
+C-C   R=RANGEN()
+C-C   IF     ( IOPTQ .EQ. 2 ) THEN
+C-C     PT = SQRT( -4.*PTQ**2/PI * LOG(1.-QPTQMX*R) )
+C-C   ELSEIF ( IOPTQ .EQ. 3 ) THEN
+C-C     PT = PTQ*SQRT( QPTQMX*R/(1.-QPTQMX*R) )
+C-C   ELSE
+C-C     PT=UTINVT(NPTQ,XPTQ,QPTQ,R*QPTQ(NPTQ))
+C-C   ENDIF
+C-C   IF ( PT .GE. QCM ) PT=RANGEN()*QCM
+C-C   QPL=SQRT(QCM**2-PT**2)
+C-C   U(3)=QPL
+C-C   PHI=2.*PI*RANGEN()
+C-C   U(1)=PT*COS(PHI)
+C-C   U(2)=PT*SIN(PHI)
+C-C   CALL UTAXIS(I,J,A1,A2,A3)
+C-C   IVT=1
+C-C   IF ( A3 .LT. 0. ) THEN
+C-C     A1=-A1
+C-C     A2=-A2
+C-C     A3=-A3
+C-C     IVT=-1
+C-C   ENDIF
+C-C   CALL UTROTA(-1,A1,A2,A3,U(1),U(2),U(3))
+C-C   DO 47 K=1,3
+C-C     PEI(K)= U(K)*IVT
+C-C     PEJ(K)=-U(K)*IVT
+C-C47 CONTINUE
+      PEI(4)=SQRT(QCM**2+PPTL(5,I)**2)
+      PEJ(4)=SQRT(QCM**2+PPTL(5,J)**2)
+      PEI(5)=PPTL(5,I)
+      PEJ(5)=PPTL(5,J)
+      CALL UTLOBO(-1,P(1),P(2),P(3),P(4),P(5)
+     *            ,PEI(1),PEI(2),PEI(3),PEI(4))
+      CALL UTLOBO(-1,P(1),P(2),P(3),P(4),P(5)
+     *            ,PEJ(1),PEJ(2),PEJ(3),PEJ(4))
+
+C  FILL /CPTL/
+C  -----------
+      DO 49 LO=1,2
+        NPTL=NPTL+1
+        IF ( LO .EQ. 1 ) THEN
+          IJ=I
+          PPTL(1,NPTL)=PEI(1)
+          PPTL(2,NPTL)=PEI(2)
+          PPTL(3,NPTL)=PEI(3)
+          PPTL(4,NPTL)=PEI(4)
+          PPTL(5,NPTL)=PEI(5)
+        ELSE
+          IJ=J
+          PPTL(1,NPTL)=PEJ(1)
+          PPTL(2,NPTL)=PEJ(2)
+          PPTL(3,NPTL)=PEJ(3)
+          PPTL(4,NPTL)=PEJ(4)
+          PPTL(5,NPTL)=PEJ(5)
+        ENDIF
+        ISTPTL(NPTL) =0
+        IDPTL(NPTL)  =IDPTL(IJ)
+        IBPTL(1,NPTL)=IBPTL(1,IJ)
+        IBPTL(2,NPTL)=IBPTL(2,IJ)
+        IBPTL(3,NPTL)=IBPTL(3,IJ)
+        IBPTL(4,NPTL)=IBPTL(4,IJ)
+        XORPTL(1,NPTL)=XAVER(1)
+        XORPTL(2,NPTL)=XAVER(2)
+        XORPTL(3,NPTL)=XAVER(3)
+        XORPTL(4,NPTL)=XAVER(4)
+        IORPTL(NPTL)=I
+        JORPTL(NPTL)=J
+        TIVPTL(1,NPTL)=XAVER(4)
+        CALL IDTAU(IDPTL(NPTL),PPTL(4,NPTL),PPTL(5,NPTL),TAUGM)
+        TIVPTL(2,NPTL)=TIVPTL(1,NPTL)+TAUGM
+        IFRPTL(1,NPTL)=0
+        IFRPTL(2,NPTL)=0
+        ICLPTL(NPTL)=ICLPTL(IJ)
+        NQJPTL(NPTL)=NQJPTL(IJ)
+        IF ( ISH .GE. 91 ) WRITE(IFCH,115)NPTL,IDPTL(NPTL)
+     *                    ,(PPTL(K,NPTL),K=3,5),(XORPTL(K,NPTL),K=3,4)
+49    CONTINUE
+
+1000  RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JINTFP(I,J,N,     XPL1,YPL1,RADPL1,OPL1,UPL1,
+     *  XPL2,YPL2,RADPL2,OPL2,UPL2,XPL3,YPL3,RADPL3,OPL3,UPL3)
+
+C----------------------------------------------------------------------
+C  PRINTOUT
+C----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      DOUBLE PRECISION DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /CTTAUS/  DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+
+      REAL       OPL(3),RADPL(3),UPL(3),XPL(3),YPL(3)
+      CHARACTER  AX*10,LIN*59,MARK*1,TXT*8
+C----------------------------------------------------------------------
+      XPL(1)  =XPL1
+      YPL(1)  =YPL1
+      RADPL(1)=RADPL1
+      OPL(1)  =OPL1
+      UPL(1)  =UPL1
+      XPL(2)  =XPL2
+      YPL(2)  =YPL2
+      RADPL(2)=RADPL2
+      OPL(2)  =OPL2
+      UPL(2)  =UPL2
+      XPL(3)  =XPL3
+      YPL(3)  =YPL3
+      RADPL(3)=RADPL3
+      OPL(3)  =OPL3
+      UPL(3)  =UPL3
+
+      V1=(OPL1-UPL1)*RADPL1**2*PI
+      V2=(OPL2-UPL2)*RADPL2**2*PI
+      V3=(OPL3-UPL3)*RADPL3**2*PI
+
+      WRITE(IFCH,103)SNGL(TTAUS)
+103   FORMAT(' MONITORING FUSION INTERACTION AT TTAUS=',F5.2)
+      TX=TTAUS
+      TX=MAX(TX,1.)
+      WRITE(TXT(3:7),104)TX
+104   FORMAT(F5.2)
+      WRITE(IFCH,105)'INCOMING:',I,IDPTL(I),PPTL(5,I),V1,PPTL(5,I)/V1
+      WRITE(IFCH,105)'INCOMING:',J,IDPTL(J),PPTL(5,J),V2,PPTL(5,J)/V2
+      WRITE(IFCH,105)'FUSED:   ',N,IDPTL(N),PPTL(5,N),V3,PPTL(5,N)/V3
+105   FORMAT(1X,A9,2X,'NR=',I6,2X,'ID=',I9,2X,'MASS=',F5.1,2X
+     *         ,'VOL=',F5.1,2X,'EPS=',F4.1)
+
+      DO 110 MM=1,3
+        IF     ( MM .EQ. 1 ) THEN
+          TXT(1:2)='S/'
+          TXT(8:8)=':'
+        ELSEIF ( MM .EQ. 2 ) THEN
+          TXT='X:      '
+        ELSEIF ( MM .EQ. 3 ) THEN
+          TXT='Y:      '
+        ENDIF
+        AX='---------!'
+        WRITE(IFCH,100)TXT,(AX,L=1,6)
+100     FORMAT(2X,A8,3X,'-3',8X,'-2',8X,'-1',9X,'0',9X,'1',9X,'2',9X,'3'
+     *         /13X,' !',6A10)
+        DO 109 K=1,3
+          DO 108 L=1,59
+            WO=-3.+L*0.1 + 0.05
+            WU=-3.+L*0.1 - 0.05
+            IF     ( MM .EQ. 1 ) THEN
+              O=OPL(K)/TX
+              U=UPL(K)/TX
+            ELSEIF ( MM .EQ. 2 ) THEN
+              O=XPL(K)+RADPL(K)
+              U=XPL(K)-RADPL(K)
+            ELSEIF ( MM .EQ. 3 ) THEN
+              O=YPL(K)+RADPL(K)
+              U=YPL(K)-RADPL(K)
+            ENDIF
+            IF ( K .EQ. 3 ) THEN
+              MARK='X'
+            ELSE
+              MARK='O'
+            ENDIF
+            IF ( WU .LE. O  .AND.  WO .GE. U ) THEN
+              LIN(L:L)=MARK
+            ELSE
+              LIN(L:L)=' '
+            ENDIF
+108       CONTINUE
+          WRITE(IFCH,101)U,O,LIN
+101       FORMAT(1X,2F6.2,' !',A59,'!')
+109     CONTINUE
+        WRITE(IFCH,102)('-',L=1,59)
+102     FORMAT(13X,' !',59A1,'!')
+110   CONTINUE
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JINTFS(I,J,NQI,JC,AMIM,IRET)
+
+C----------------------------------------------------------------------
+C  INPUT: PTL NUMBERS I,J
+C  OUTPUT: PPFUS(5): MOMENTUM , NQI: NET QUARK NUMBER,
+C              JC: JC-CODE, AMIM: MINIMUM MASS,    OF FUSED PTL
+C          IRET=0 IF OK, 1 ELSE
+C          PPFUS() WRITTEN TO PPTL(,NPTL+1)
+C----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      PARAMETER (NFLAV=6)
+      COMMON /CJINT/   BX,BY,RNUP,RNUT,VELP,VELT,XAVER(4),NPTL0
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      DOUBLE PRECISION PPFUS(5),PP52
+      REAL             P(5)
+      INTEGER          JC(NFLAV,2),JCI(NFLAV,2),JCJ(NFLAV,2)
+C----------------------------------------------------------------------
+      IRET=0
+
+      P(1)=PPTL(1,I)+PPTL(1,J)
+      PPFUS(1)=P(1)
+      P(2)=PPTL(2,I)+PPTL(2,J)
+      PPFUS(2)=P(2)
+      P(3)=PPTL(3,I)+PPTL(3,J)
+      PPFUS(3)=P(3)
+      P(4)=PPTL(4,I)+PPTL(4,J)
+      PPFUS(4)=P(4)
+      PP52=PPFUS(4)**2-PPFUS(3)**2-PPFUS(2)**2-PPFUS(1)**2
+      IF ( PP52 .LE. 0.D0 ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JINTFS')
+          WRITE(IFCH,*)'*****  MFUS**2 < 0    (',PP52,' )'
+          WRITE(IFCH,*)(PPFUS(M),M=1,4)
+          CALL UTMSGF
+        ENDIF
+        GOTO 1001
+      ENDIF
+      PPFUS(5)=SQRT(PP52)
+      IF ( NPTL+1 .GT. MXPTL ) THEN
+        CALL UTSTOP('JINTFS: NPTL>MXPTL                      ')
+      ENDIF
+      DO 36 K=1,5
+        PPTL(K,NPTL+1)=PPFUS(K)
+36    CONTINUE
+      AMF=PPFUS(5)
+
+      ISTPTL(NPTL+1)=0
+
+      CALL IDQUAC(I,NDUMMY,NDUMMY,NDUMMY,JCI)
+      CALL IDQUAC(J,NDUMMY,NDUMMY,NDUMMY,JCJ)
+      NQI=0
+      DO 29 N=1,NFLAV
+        JC(N,1)=JCI(N,1)+JCJ(N,1)
+        JC(N,2)=JCI(N,2)+JCJ(N,2)
+        NQI=NQI+JC(N,1)-JC(N,2)
+29    CONTINUE
+
+      CALL IDCOMJ(JC)
+      AMIM=UTAMNZ(JC,5)+.200
+      IF ( AMF.LT.AMIM .AND. I.GT.NPTL0 .AND. J.GT.NPTL0 ) GOTO 1001
+      GOTO 1000
+
+1001  IRET=1
+
+1000  RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JINTFU(I,J,JC,IACTN)
+
+C----------------------------------------------------------------------
+C  FUSION OF PTLS I,J: DETERMINE CLUSTER
+C----------------------------------------------------------------------
+      PARAMETER (MXDKY=2000)
+      PARAMETER (MXLOOK=10000)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (NFLAV=6)
+      COMMON /CJINT/   BX,BY,RNUP,RNUT,VELP,VELT,XAVER(4),NPTL0
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CTIMEL/  NTC
+      DOUBLE PRECISION DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /CTTAUS/  DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /DKYTAB/  CBR(MXDKY),LOOK(MXLOOK),MODE(5,MXDKY)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      INTEGER IB(4),IC(2),JC(NFLAV,2)
+C----------------------------------------------------------------------
+C  PRINT
+C  -----
+      IF ( ISH .GE. 91 ) THEN
+        WRITE(IFCH,101)NTC,SNGL(TTAUS)
+101     FORMAT(1X,'FUSION INTERACTION --- NT=',I3,' --- TAUS=',F6.2)
+        WRITE(IFCH,115)I,IDPTL(I)
+     *                  ,(PPTL(K,I),K=3,5),(XORPTL(K,I),K=3,4)
+        WRITE(IFCH,115)J,IDPTL(J)
+     *                  ,(PPTL(K,J),K=3,5),(XORPTL(K,I),K=3,4)
+115     FORMAT(1X,'/CPTL/',I6,I10
+     *           ,1X,2(E10.2),E11.3,1X,2(E10.2),2X,I4)
+      ENDIF
+
+C  INITIALIZATION
+C  --------------
+      IACTN=3
+      AMF=PPTL(5,NPTL+1)
+      NPTL=NPTL+1
+
+C  DETERMINE IDR, IB(1-4)
+C  ----------------------
+      IDR=0
+      DO 40 NF=1,NFLAV
+        IF ( JC(NF,1) .GE. 10 ) IDR=700000000
+        IF ( JC(NF,2) .GE. 10 ) IDR=700000000
+40    CONTINUE
+      IF ( IDR/100000000 .NE. 7 ) THEN
+        CALL IDENCO(JC,IC,IRETEN)
+        IF ( IRETEN .EQ. 1 ) THEN
+          CALL UTSTOP('JINTFU: IDENCO RET CODE = 1             ')
+        ENDIF
+        ID=IDTRA(IC,0,0,3)
+43      AMC=AMF
+        CALL IDRES(ID,AMC,IDR,IADJ)
+        IF ( IDR .NE. 0 ) THEN
+          LID=LOOK(IABS(IDR))
+          IF ( LID.LE.0  .OR.  LID.GT.0 .AND. MODE(2,LID).EQ.0 ) THEN
+            IF ( PPTL(5,NPTL) .GT. AMC+1.E-3 ) THEN
+              AMF=AMF+0.010
+              GOTO 43
+            ENDIF
+            IF ( ABS(AMC-PPTL(5,NPTL)) .GT. 1.E-3 ) THEN
+              IF ( ISH .GE. 90 ) THEN
+                CALL UTMSG('JINTFU')
+                WRITE(IFCH,*)'*****  NOT ON MASS SHELL AFTER FUSION: '
+     *                       ,PPTL(5,NPTL),AMC
+                CALL UTMSGF
+              ENDIF
+            ENDIF
+          ENDIF
+        ENDIF
+        IF ( IDR .EQ. 0 ) THEN
+          IF ( MOD(IC(1),100).NE.0 .OR. MOD(IC(2),100).NE.0 ) THEN
+            IDR=900000000
+          ELSE
+            IDR=800000000+IC(1)*100+IC(2)/100
+          ENDIF
+        ENDIF
+      ELSE
+        CALL IDTRBI(JC,IB(1),IB(2),IB(3),IB(4))
+        IDR=IDR
+     *      +MOD(JC(1,1)+JC(2,1)+JC(3,1)+JC(4,1),10000)*10000
+     *      +MOD(JC(1,2)+JC(2,2)+JC(3,2)+JC(4,2),10000)
+        IF ( ISH .GE. 93 ) WRITE(IFCH,*) 'IB:',(IB(KK),KK=1,4)
+        IBPTL(1,NPTL)=IB(1)
+        IBPTL(2,NPTL)=IB(2)
+        IBPTL(3,NPTL)=IB(3)
+        IBPTL(4,NPTL)=IB(4)
+      ENDIF
+
+C  FILL /CPTL/
+C  -----------
+      IDPTL(NPTL)=IDR
+      XORPTL(1,NPTL)=XAVER(1)
+      XORPTL(2,NPTL)=XAVER(2)
+      XORPTL(3,NPTL)=XAVER(3)
+      XORPTL(4,NPTL)=XAVER(4)
+      IORPTL(NPTL)=I
+      JORPTL(NPTL)=J
+      TIVPTL(1,NPTL)=XAVER(4)
+      CALL IDTAU(IDPTL(NPTL),PPTL(4,NPTL),PPTL(5,NPTL),TAUGM)
+      TIVPTL(2,NPTL)=TIVPTL(1,NPTL)+TAUGM
+      IFRPTL(1,NPTL)=0
+      IFRPTL(2,NPTL)=0
+      ICLPTL(NPTL)=1
+      NQJPTL(NPTL)=0
+
+C  PRINT + RETURN
+C  --------------
+      IF ( ISH .GE. 91 ) THEN
+        N=NPTL
+        WRITE(IFCH,115)N,IDPTL(N)
+     *                  ,(PPTL(K,N),K=3,5),(XORPTL(K,N),K=3,4)
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JINTPA(I,J,KMAX)
+
+C----------------------------------------------------------------------
+C  WRITES PARENTS OF I,J TO IFRIJ(1-KMAX)
+C  SETS IAAPTL()=0 FOR PARENTS
+C----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXIFR=MXPTL)
+      COMMON /CIFRIJ/  IFRIJ(MXIFR)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /C2PTL/   AMIPTL(MXPTL),RADPTL(MXPTL),IAAPTL(MXPTL)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+C----------------------------------------------------------------------
+      KCUR=0
+      KMAX=0
+      LOOP=0
+12    LOOP=LOOP+1
+      IF     ( LOOP .EQ. 1 ) THEN
+        N=I
+      ELSEIF ( LOOP .EQ. 2 ) THEN
+        N=J
+      ENDIF
+      IF ( IORPTL(N) .GT. 0 ) THEN
+        IF ( ISH .GE. 92 ) WRITE(IFCH,*)N,' <--- ',IORPTL(N),JORPTL(N)
+        IF ( KMAX+2 .GT. MXIFR ) THEN
+          CALL UTSTOP('JINTPA: KMAX+2 > MXIFR                  ')
+        ENDIF
+        IF ( IAAPTL(IORPTL(N)) .NE. 0 ) THEN
+          KMAX=KMAX+1
+          IFRIJ(KMAX)=IORPTL(N)
+          IAAPTL(IORPTL(N))=0
+        ENDIF
+        IF ( JORPTL(N) .GT. 0 ) THEN
+          IF ( IAAPTL(JORPTL(N)) .NE. 0 ) THEN
+            KMAX=KMAX+1
+            IFRIJ(KMAX)=JORPTL(N)
+            IAAPTL(JORPTL(N))=0
+          ENDIF
+        ENDIF
+      ENDIF
+      IF ( LOOP .EQ. 1 ) GOTO 12
+8     KCUR=KCUR+1
+      IF ( KCUR .LE. KMAX ) THEN
+        N=IFRIJ(KCUR)
+        IF ( IAAPTL(N) .NE. 0 ) THEN
+          CALL UTSTOP('JINTPA: SHOULD NOT HAPPEN               ')
+        ENDIF
+        GOTO 12
+      ENDIF
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JRESCL(J1,J2,PSUM,IFAIL)
+
+C-----------------------------------------------------------------------
+C  RESCALES PTL MOMENTA OF PTLS J1-J2 TO HAVE TOTAL MOM PSUM.
+C-----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CSCAL/   SCAL
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      DOUBLE PRECISION ENE,PADD(5),PP(5),PPSUM(5)
+      REAL             PSUM(5)
+      DATA ERRLIM/.001/
+C-----------------------------------------------------------------------
+      IFAIL=1
+
+      IF ( J1 .GE. J2 ) THEN
+        CALL UTSTOP('JRESCL: J1 .GE. J2                      ')
+      ENDIF
+
+      DO 100 K=1,5
+        PPSUM(K)=PSUM(K)
+        PADD(K)=0.D0
+100   CONTINUE
+      DO 110 J=J1,J2
+        DO 110 K=1,5
+          PADD(K)=PADD(K)+PPTL(K,J)
+110   CONTINUE
+      IF ( PADD (5) .GE. PPSUM(5) ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JRESCL')
+          WRITE(IFCH,*)'*****  SUM OF PTL MASSES .GE. PPSUM(5)'
+          DO 1 J=J1,J2
+            WRITE(IFCH,109)J,IDPTL(J),(PPTL(L,J),L=3,5)
+109         FORMAT(' /CPTL/',I6,I10,3(E11.3))
+ 1        CONTINUE
+          WRITE(IFCH,*)'PPSUM(345):',(SNGL(PPSUM(K)),K=3,5)
+          CALL UTMSGF
+        ENDIF
+        RETURN
+      ENDIF
+      PADD(5)=PADD(4)**2-PADD(1)**2-PADD(2)**2-PADD(3)**2
+      IF ( PADD(5) .LE. 0.D0 ) THEN
+        ENE = 0.D0
+        DO 111 J=J1,J2
+          ENE = ENE + DSQRT( PPTL(1,J)**2 + PPTL(2,J)**2
+     *                + DBLE(PPTL(3,J))**2 + PPTL(5,J)**2 )
+111     CONTINUE
+        PADD(5) = ENE**2 - PADD(1)**2 - PADD(2)**2 - PADD(3)**2
+        IF ( PADD(5) .LE. 0.D0 ) THEN
+          DO 2 J=J1,J2
+            WRITE(IFCH,108)J,(PPTL(L,J),L=1,5)
+108         FORMAT(' /CPTL/',I4,5(E11.3))
+ 2        CONTINUE
+          CALL UTSTOP('JRESCL: MASS**2 OF STRING-SUM NEGATIVE  ')
+        ENDIF
+      ENDIF
+      PADD(5)=SQRT(PADD(5))
+
+C  BOOST PTLS TO REST
+C  ------------------
+      DO 200 J=J1,J2
+        PP(1)=PPTL(1,J)
+        PP(2)=PPTL(2,J)
+        PP(3)=PPTL(3,J)
+        PP(4)=PPTL(4,J)
+        CALL UTLOB2(1,PADD(1),PADD(2),PADD(3),PADD(4),PADD(5)
+     *                 ,PP(1),PP(2),PP(3),PP(4))
+        PPTL(1,J)=PP(1)
+        PPTL(2,J)=PP(2)
+        PPTL(3,J)=PP(3)
+        PPTL(4,J)=PP(4)
+200   CONTINUE
+
+C  RESCALE MOMENTA IN REST FRAME
+C  -----------------------------
+      SCAL=1.
+      DO 301 IPASS=1,200
+        SUM=0.
+        DO 310 J=J1,J2
+          PPTL(1,J)=SCAL*PPTL(1,J)
+          PPTL(2,J)=SCAL*PPTL(2,J)
+          PPTL(3,J)=SCAL*PPTL(3,J)
+          PPTL(4,J)=SQRT(PPTL(1,J)**2+PPTL(2,J)**2+PPTL(3,J)**2
+     *                  +PPTL(5,J)**2)
+          SUM=SUM+PPTL(4,J)
+310     CONTINUE
+        SCAL=PSUM(5)/SUM
+        IF ( ABS(SCAL-1.) .LE. ERRLIM ) GOTO 300
+301   CONTINUE
+      IF ( ISH .GE. 90 ) THEN
+        CALL UTMSG('JRESCL')
+        WRITE(IFCH,*)'*****  SCAL=',SCAL
+        CALL UTMSGF
+      ENDIF
+300   CONTINUE
+
+C  BOOST BACK WITH PPSUM
+C  ---------------------
+      DO 330 J=J1,J2
+        PP(1)=PPTL(1,J)
+        PP(2)=PPTL(2,J)
+        PP(3)=PPTL(3,J)
+        PP(4)=PPTL(4,J)
+        CALL UTLOB2(-1,PPSUM(1),PPSUM(2),PPSUM(3),PPSUM(4),PPSUM(5)
+     *                   ,PP(1),PP(2),PP(3),PP(4))
+        PPTL(1,J)=PP(1)
+        PPTL(2,J)=PP(2)
+        PPTL(3,J)=PP(3)
+        PPTL(4,J)=PP(4)
+330   CONTINUE
+
+      IFAIL=0
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE JSPLIT(STRO,STR,KOLSP,IER,KMAXOR)
+
+C-----------------------------------------------------------------------
+C  SPLITS STRING STRO INTO Q-QBAR STRING STR AND REMAINDER (->STRO)
+C  DIMENSIONS: STRO(NSI,NSIX+1),STR(NSI,2)
+C  IER=0: OK ; IER=1: ERROR ; IER=2: ABSORPTION ;
+C  IER=3: AGAIN WITH NEW APART, EPART
+C-----------------------------------------------------------------------
+      PARAMETER (MAMX=56)
+      PARAMETER (NFLAV=6)
+      PARAMETER (NPTF=129)
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      PARAMETER (NSPLIT=129)
+      COMMON /CJSPLI/  ALEAD,APART,ELEAD,EPART,SGNSIL,JPART,NSCC,NSCCX
+      COMMON /CNFUSN/  NFUSN(NSIX+1)
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CPROJA/  IPROJ,ITARG,KPROJA(NHA,MAMX),KTARGA(NHA,MAMX)
+      COMMON /CPTF/    FPTFS,FPTFSS,FPTFU,FPTFUS,FPTFUU
+     *                ,QPTFS(NPTF),QPTFSS(NPTF),QPTFU(NPTF),QPTFUS(NPTF)
+     *                ,QPTFUU(NPTF),XPTF(NPTF)
+      COMMON /CPZSTR/  ESTRL,PZSTRL,ISEA,ISTRL
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /QUARKM/  SMAS,SSMAS,USMAS,UUMAS
+
+      DOUBLE PRECISION A,D,DAUXIL,PAM,PAP,PEM,PEP,PIM,PIP,PNL3,PNL4
+     *                ,PM,PO(5),POM,POP,POT,POX,POY,PO123,PP
+     *                ,PUM,PUP,PUT,PUX,PUY,PYM,PYP,SSTR(NSI,2)
+      REAL             STR(NSI,2),STRO(NSI,NSIX+1),STRO0(NSI,NSIX+1)
+      INTEGER          IC(2),ICX(2),JC(NFLAV,2),JCX(NFLAV,2)
+C-----------------------------------------------------------------------
+      PUDX=PUD*.945
+      ISH0=ISH
+      IF ( ISHSUB/100 .EQ. 15 ) ISH=MOD(ISHSUB,100)
+
+      CALL UTKSTR(STRO,KMAX)
+      IF ( KMAX .EQ. KMAXOR ) THEN
+        NSCC=0
+        IF ( JPART .EQ. 0 ) THEN
+          DO  5 I=1,KMAXOR
+            NFUSN(I)=0
+ 5        CONTINUE
+        ENDIF
+      ENDIF
+      KMAX0=KMAX
+      DO 10 K=1,KMAX
+        DO 10 I=1,NSI
+          STRO0(I,K)=STRO(I,K)
+10    CONTINUE
+C-C   PDIQ=PDIQUA*0.5
+C-C   IF ( KMAXOR .GT. KUTDIQ ) PDIQ=0.
+C-C   PDIQ=PDIQUA*0.5*NSCCX/(KMAXOR-1.)
+      PDIQ=0.
+      LOOP=0
+      NCORN=0
+      XUNTER=0.
+      XOBER=1.
+      MESSCO=0
+      IF ( SGNSIL .LT. 0. ) THEN
+        KOLSP=KTARGA(KMAX+1,ITARG)
+      ELSE
+        KOLSP=KPROJA(KMAX+1,IPROJ)
+      ENDIF
+      PAP=2.D0*EPART
+      PAM=0.D0
+      PUX=STRO(1,KMAX)
+      PUY=STRO(2,KMAX)
+      PUT=SQRT(PUX**2+PUY**2)
+      PUP=STRO(4,KMAX)-ABS(STRO(3,KMAX))
+      PUM=STRO(4,KMAX)+ABS(STRO(3,KMAX))
+
+C  PRINT
+C  -----
+      IF ( ISH .GE. 92 ) THEN
+        IF ( ISH .GE. 93 ) WRITE(IFCH,*)('-',L=1,79)
+        WRITE(IFCH,*)'MULTI-STRING DETECTED. SPLIT OFF Q-QBAR STRING:'
+        IF ( ISH .GE. 93 ) WRITE(IFCH,*)('-',L=1,79)
+        WRITE(IFCH,*)' '
+        IF ( ISH .GE. 93 ) THEN
+          WRITE(IFCH,*)'INPUT STRING STRO:'
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,105)(STRO(I,1),I=1,4),(NINT(STRO(I,1)),I=5,6)
+          DO 8 K=2,KMAX
+            WRITE(IFCH,104)(STRO(I,K),I=1,4),(NINT(STRO(I,K)),I=5,6)
+ 8        CONTINUE
+          WRITE(IFCH,*)' '
+        ENDIF
+      ENDIF
+
+C  ABSORPTION
+C  ----------
+      IF ( ISTRL .EQ. 1 ) GOTO 1002
+
+C  RESET
+C  -----
+5001  LOOP=0
+5000  LOOP=LOOP+1
+      IF ( LOOP .GE. 5 ) GOTO 1002
+      KMAX=KMAX0
+      DO 11 I=1,NSI
+        DO 11 K=1,KMAX
+        STRO(I,K)=STRO0(I,K)
+11    CONTINUE
+
+C  SPLIT OFF HADRON + DETERMINE REMAINDER STRING (MOMENTA)
+C  -------------------------------------------------------
+      IF ( RANGEN() .LT. PDIQ ) THEN
+        NQU=2
+      ELSE
+        NQU=1
+      ENDIF
+      IFLTT=0
+      IFLTO=0
+      DO 24 I=1,NQU
+        IFL=INT(RANGEN()/PUDX)+1
+        IFLTO=IFLTO*10+IFL
+        IFLTT=IFLTT*10+(IFL+1)/2
+24    CONTINUE
+      R=RANGEN()
+      IF     ( IFLTT .EQ. 1 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFU ,R*QPTFU(NPTF))
+C##       WRITE(IFCH,*)'JSPLIT:PT(OLD)=',PT
+        ELSE
+          RPT = R*FPTFU
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(1.+RPT*2./AUXIL))
+        ENDIF
+      ELSEIF ( IFLTT .EQ. 2 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFS ,R*QPTFS(NPTF))
+        ELSE
+          RPT = R*FPTFS
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(EXP( SMAS**2/AUXIL)+RPT*2./AUXIL)- SMAS**2)
+        ENDIF
+      ELSEIF ( IFLTT .EQ. 11 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFUU,R*QPTFUU(NPTF))
+        ELSE
+          RPT = R*FPTFUU
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(EXP(UUMAS**2/AUXIL)+RPT*2./AUXIL)-UUMAS**2)
+        ENDIF
+      ELSEIF ( IFLTT .EQ. 12  .OR.  IFLTT .EQ. 21 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFUS,R*QPTFUS(NPTF))
+        ELSE
+          RPT = R*FPTFUS
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(EXP(USMAS**2/AUXIL)+RPT*2./AUXIL)-USMAS**2)
+        ENDIF
+      ELSEIF ( IFLTT .EQ. 22 ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          PT=UTINVT(NPTF,XPTF,QPTFSS,R*QPTFSS(NPTF))
+        ELSE
+          RPT = R*FPTFSS
+          AUXIL=-4.*PTF**2/PI
+          PT=SQRT(AUXIL*LOG(EXP(SSMAS**2/AUXIL)+RPT*2./AUXIL)-SSMAS**2)
+        ENDIF
+      ENDIF
+      AT=SQRT(APART**2+PT**2)
+      R=RANGEN()
+      AUXIL=2.*R-1.
+      IF ( AUXIL .LT. 0. ) THEN
+        X = SQRT( 0.5-COS( (ACOS(-AUXIL)+PI)*.33333333 ) )
+      ELSE
+        X = SQRT( 0.5+COS( (ACOS(AUXIL)+PI)*.33333333 ) )
+      ENDIF
+      IF ( ESTRL .LE. ABS(PZSTRL) ) THEN
+        XUNTER=1.
+      ELSE
+        YSTRL=.5*LOG((ESTRL+PZSTRL)/(ESTRL-PZSTRL))
+        XUNTER=ABS(0.94*SINH(YSTRL))/EPART
+        IF ( XUNTER .GT. 1. ) XUNTER=1.
+      ENDIF
+      XUNTER=XUNTER-(XOBER-XUNTER)
+      X=XUNTER+X*(XOBER-XUNTER)
+C-C   EN=APART+X*(EPART-APART)
+      PZ=X*EPART
+      IF ( PZ .LT. 0. ) THEN
+        SGNPO=-1.
+      ELSE
+        SGNPO=1.
+      ENDIF
+      EN=SQRT(PZ**2+AT**2)
+C-C   IF ( AT .GT. EN ) AT=APART+RANGEN()*(EN-APART)
+C-C   PT=SQRT((AT-APART)*(AT+APART))
+      PHI=2.*PI*RANGEN()
+      PO(1)=PT*COS(PHI)
+      PO(2)=PT*SIN(PHI)
+C-C   PO(3)=SGNSIL*SQRT(EN**2-AT**2)
+      PO(3)=SGNSIL*PZ
+      PO(4)=EN
+      PO123=SQRT(PO(3)**2+PO(2)**2+PO(1)**2)
+      IF ( PO(4)-PO123 .GT. 0.D0 ) THEN
+        PO(5)=SQRT((PO(4)-PO123)*(PO(4)+PO123))
+      ELSE
+        PO(5)=0.D0
+        IF ( PO(4)-PO123 .LT. -1.D-4*PO(4) ) THEN
+          IF(ISH.GE.90)THEN
+            CALL UTMSG('JSPLIT')
+            WRITE(IFCH,*)'*****  !PO123! > PO4'
+            WRITE(IFCH,*)'PO123,PO4:',PO123,PO(4)
+            WRITE(IFCH,*)'PO1:',PO(1)
+            WRITE(IFCH,*)'PO2:',PO(2)
+            WRITE(IFCH,*)'PO3:',PO(3)
+            WRITE(IFCH,*)'PO5:',PO(5)
+            CALL UTMSGF
+          ENDIF
+        ENDIF
+      ENDIF
+      POX=PO(1)
+      POY=PO(2)
+      POT=SQRT(POX**2+POY**2)
+      POP=PO(4)+ABS(PO(3))*SGNPO
+      POM=PO(4)-ABS(PO(3))*SGNPO
+      STRO(1,1)=STRO(1,1)+PO(1)
+      STRO(2,1)=STRO(2,1)+PO(2)
+      STRO(3,1)=STRO(3,1)-EPART*SGNSIL +PO(3)
+      STRO(4,1)=STRO(4,1)-EPART +PO(4)
+      STRO(1,KMAX)=0.
+      STRO(2,KMAX)=0.
+      STRO(3,KMAX)=0.
+      STRO(4,KMAX)=0.
+      IF ( PO(4)-ABS(PO(3)) .GT. 0.D0 ) THEN
+        YLD=0.5*LOG((PO(4)+ABS(PO(3)))/(PO(4)-ABS(PO(3))))
+      ELSE
+        YLD=100.
+      ENDIF
+
+C  DETERMINE SPLIT STRING (MOMENTA)
+C  --------------------------------
+      PP=PAP+PUP
+      PM=PAM+PUM
+      PEP=PP-POP
+      PEM=PM-POM
+      IF ( PEP .LE. 0.D0 ) GOTO 5000
+      IF ( PEM .LE. 0.D0 ) GOTO 5000
+      A=(PEM*PEP-PUT**2-POT**2)*0.5D0
+      D=PUT*POT
+      DAUXIL = A**2-D**2
+      IF ( DAUXIL .LT. 0.D0 ) GOTO 5000
+      DAUXIL=SQRT(DAUXIL)
+      PYP=A+PUT**2-DAUXIL
+      IF ( PYP .LT. 0.D0  .AND.  PYP .GT. -1.D-6 ) PYP=0.D0
+      PYP=PYP/PEM
+      PYM=A+POT**2-DAUXIL
+      IF ( PYM .LT. 0.D0  .AND.  PYM .GT. -1.D-6 ) PYM=0.D0
+      PYM=PYM/PEP
+      IF ( PYP .LT. 0.D0 ) GOTO 5000
+      IF ( PYM .LT. 0.D0 ) GOTO 5000
+      PIP=PEP-PYP
+      IF ( PIP .LT. 0.D0 ) GOTO 5000
+      PIM=PYM
+      PAP=PYP
+      PAM=PEM-PYM
+      IF ( PAM .LT. 0.D0 ) GOTO 5000
+      SSTR(1,1)=-POX
+      SSTR(2,1)=-POY
+      SSTR(3,1)=SGNSIL*(PIP-PIM)*0.5D0
+      SSTR(4,1)=(PIP+PIM)*0.5D0
+      SSTR(1,2)=PUX
+      SSTR(2,2)=PUY
+      SSTR(3,2)=SGNSIL*(PAP-PAM)*0.5D0
+      SSTR(4,2)=(PAP+PAM)*0.5D0
+      PNL3=SSTR(3,1)+SSTR(3,2)
+      PNL4=SSTR(4,1)+SSTR(4,2)
+      IF ( PNL4-ABS(PNL3) .NE. 0. ) THEN
+        YNL=0.5*LOG((PNL4+ABS(PNL3))/(PNL4-ABS(PNL3)))
+      ELSE
+        YNL=100.
+      ENDIF
+      STR(1,1)=SSTR(1,1)
+      STR(2,1)=SSTR(2,1)
+      STR(3,1)=SSTR(3,1)
+      STR(4,1)=SSTR(4,1)
+      STR(1,2)=SSTR(1,2)
+      STR(2,2)=SSTR(2,2)
+      STR(3,2)=SSTR(3,2)
+      STR(4,2)=SSTR(4,2)
+
+C  CHECKS
+C  ------
+      IF ( ISH .GE. 90 ) THEN
+        IF ( ABS(PIP*PIM-POT**2) .GT. 1.D-4 ) THEN
+          CALL UTMSG('JSPLIT')
+          WRITE(IFCH,*)'*****  PIP*PIM /= POT**2'
+          WRITE(IFCH,*)'PIP*PIM=',PIP*PIM
+          WRITE(IFCH,*)'POT**2=',POT**2
+          WRITE(IFCH,*)'PIP=',PIP
+          WRITE(IFCH,*)'PIM=',PIM
+          WRITE(IFCH,*)'POT=',POT
+          CALL UTMSGF
+        ENDIF
+        IF ( ABS(PAP*PAM-PUT**2) .GT. 1.D-4 ) THEN
+          CALL UTMSG('JSPLIT')
+          WRITE(IFCH,*)'*****  PAP*PAM /= PUT**2'
+          WRITE(IFCH,*)'PAP*PAM=',PAP*PAM
+          WRITE(IFCH,*)'PUT**2=',PUT**2
+          WRITE(IFCH,*)'PAP=',PAP
+          WRITE(IFCH,*)'PAM=',PAM
+          WRITE(IFCH,*)'PUT=',PUT
+          CALL UTMSGF
+        ENDIF
+        IF ( ABS(SSTR(4,1)**2
+     *     -SSTR(1,1)**2-SSTR(2,1)**2-SSTR(3,1)**2) .GT. 1.D-4 ) THEN
+          CALL UTMSG('JSPLIT')
+          WRITE(IFCH,*)'*****  MASS**2 OF STRING END 1 NONZERO'
+          WRITE(IFCH,*)'MASS**2=',SSTR(4,1)**2
+     *                         -SSTR(1,1)**2-SSTR(2,1)**2-SSTR(3,1)**2
+          CALL UTMSGF
+        ENDIF
+        IF ( ABS(SSTR(4,2)**2
+     *     -SSTR(1,2)**2-SSTR(2,2)**2-SSTR(3,2)**2) .GT. 1.D-4 ) THEN
+          CALL UTMSG('JSPLIT')
+          WRITE(IFCH,*)'*****  MASS**2 OF STRING END 2 NONZERO'
+          WRITE(IFCH,*)'MASS**2=',SSTR(4,2)**2
+     *                         -SSTR(1,2)**2-SSTR(2,2)**2-SSTR(3,2)**2
+          CALL UTMSGF
+        ENDIF
+        DO 14 N=1,4
+
+          IF ( ABS(STR(N,1)+STRO(N,1)-STRO0(N,1)
+     *            +STR(N,2)+STRO(N,KMAX)-STRO0(N,KMAX)) .GT. 1.E-4
+     *      .AND.  ABS(STR(N,1)+STRO(N,1)-STRO0(N,1)
+     *                +STR(N,2)+STRO(N,KMAX)-STRO0(N,KMAX))
+     *           .GT. 1.E-4*ABS(STRO0(N,1)+STRO0(N,KMAX)) ) GOTO 15
+14      CONTINUE
+        GOTO 16
+15      CONTINUE
+        CALL UTMSG('JSPLIT')
+        WRITE(IFCH,*)'*****  P_STR + P_STRO /= P_STRO0'
+        WRITE(IFCH,*)'P_STR + P_STRO:'
+        WRITE(IFCH,104)((STR(N,1)+STR(N,2)+STRO(N,1)
+     *                                    +STRO(N,KMAX)),N=1,4)
+        WRITE(IFCH,*)'P_STRO0:'
+        WRITE(IFCH,104)((STRO0(N,1)+STRO0(N,KMAX)),N=1,4)
+        WRITE(IFCH,*)'STR:'
+        WRITE(IFCH,104)(STR(N,1),N=1,4)
+        WRITE(IFCH,104)(STR(N,2),N=1,4)
+        WRITE(IFCH,*)'STRO:'
+        WRITE(IFCH,104)(STRO(N,1),N=1,4)
+        WRITE(IFCH,104)(STRO(N,KMAX),N=1,4)
+        WRITE(IFCH,*)'STRO0:'
+        WRITE(IFCH,104)(STRO0(N,1),N=1,4)
+        WRITE(IFCH,104)(STRO0(N,KMAX),N=1,4)
+        CALL UTMSGF
+16      CONTINUE
+        IF ( ISH .GE. 93 ) THEN
+          WRITE(IFCH,100)APART,EPART,EN,PT
+100       FORMAT(3X,'APART,EPART,EN,PT:',4F13.5)
+          WRITE(IFCH,101)(SNGL(PO(K)),K=1,5)
+101       FORMAT(3X,'PO:',5F11.5/)
+          IF ( NQU .EQ. 2 ) THEN
+            WRITE(IFCH,*)'DIQUARK-ANTIDIQUARK BREAK'
+            WRITE(IFCH,*)' '
+          ENDIF
+        ENDIF
+      ENDIF
+
+C  FLAVOUR
+C  -------
+      IC(1)=NINT(ABS(STRO(4+1,KMAX)))
+      IC(2)=NINT(ABS(STRO(4+2,KMAX)))
+      STR(4+1,2)=IC(1)
+      STR(4+2,2)=IC(2)
+      DO 4 N=1,NFLAV
+        JCX(N,1)=0
+        JCX(N,2)=0
+4     CONTINUE
+      M=0
+      IF     ( NQU .EQ. 1 ) THEN
+        IF ( IC(1) .GT. 0 ) M=2
+        IF ( IC(2) .GT. 0 ) M=1
+        NFL=MOD(IFLTO,10)
+        JCX(NFL,M)=JCX(NFL,M)+1
+      ELSEIF ( NQU .EQ. 2 ) THEN
+        IF ( IC(1) .GT. 0 ) M=1
+        IF ( IC(2) .GT. 0 ) M=2
+        NFL=MOD(IFLTO,10)
+        JCX(NFL,M)=JCX(NFL,M)+1
+        NFL=IFLTO/10
+        JCX(NFL,M)=JCX(NFL,M)+1
+      ENDIF
+      IF ( M .EQ. 0 ) THEN
+        CALL UTSTOP('JSPLIT: M = 0                           ')
+      ENDIF
+      CALL IDENCO(JCX,ICX,IRETEN)
+      IF ( IRETEN .EQ. 1 ) THEN
+        CALL UTSTOP('JSPLIT: IDENCO RET CODE = 1             ')
+      ENDIF
+      STR(4+1,1)=ICX(1)
+      STR(4+2,1)=ICX(2)
+      CALL UTAMST(STR,AM,AMIN,IRET)
+      IF ( IRET .NE. 0 ) GOTO 1002
+      IF ( NFUSN(KMAX) .EQ. 1 ) GOTO 1002
+      IC(1)=NINT(STRO(4+1,1))
+      IC(2)=NINT(STRO(4+2,1))
+      CALL IDDECO(IC,JC)
+      DO 26 N=1,NQU
+        IF ( N .EQ. 1 ) THEN
+          NFL=MOD(IFLTO,10)
+        ELSE
+          NFL=IFLTO/10
+        ENDIF
+        IF ( JC(NFL,M) .GT. 0 ) THEN
+          JC(NFL,M)=JC(NFL,M)-1
+        ELSE
+          JC(NFL,3-M)=JC(NFL,3-M)+1
+        ENDIF
+26    CONTINUE
+      NN=0
+      DO 27 N=1,NFLAV
+        NN=NN+JC(N,1)+JC(N,2)
+27    CONTINUE
+      IF ( NN .EQ. 0 ) THEN
+        NFL=INT(RANGEN()/PUDX)+1
+        JC(NFL,1)=1
+        JC(NFL,2)=1
+      ENDIF
+      CALL IDENCO(JC,IC,IRETEN)
+      IF ( IRETEN .EQ. 1 ) THEN
+        IF ( ISH .GE. 90  .AND.  MESSCO .EQ. 0 ) THEN
+          CALL UTMSG('JSPLIT')
+          WRITE(IFCH,*)'*****  IDENCO RET CODE = 1.   REDO JSPLIT'
+          WRITE(IFCH,*)'JC:'
+          WRITE(IFCH,*)JC
+          CALL UTMSGF
+          MESSCO=1
+        ENDIF
+        GOTO 5000
+      ENDIF
+      STRO(4+1,1)=IC(1)
+      STRO(4+2,1)=IC(2)
+      STRO(4+1,KMAX)=0.
+      STRO(4+2,KMAX)=0.
+
+C  OK
+C  --
+1000  IER=0
+      NSCC=NSCC+1
+      GOTO 10002
+
+C  ERROR
+C  -----
+1001  IER=1
+      IF ( ISH .GE. 90 ) THEN
+        CALL UTMSG('JSPLIT')
+        WRITE(IFCH,*)'*****  SPLIT NOT POSSIBLE'
+        CALL UTMSGF
+      ENDIF
+      GOTO 10001
+
+C  ABSORPTION
+C  ----------
+1002  IER=2
+      NFUSN(KMAX)=1
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)'ABSORPTION OF STRO(,KMAX)'
+        WRITE(IFCH,*)' '
+      ENDIF
+      DO 18 I=1,NSI
+        STR(I,1)=0.
+        STR(I,2)=0.
+18    CONTINUE
+      DO 17 K=1,KMAX
+        DO 17 I=1,NSI
+          STRO(I,K)=STRO0(I,K)
+17    CONTINUE
+      STRO(1,1)=STRO(1,1)+STRO(1,KMAX)
+      STRO(2,1)=STRO(2,1)+STRO(2,KMAX)
+      STRO(3,1)=STRO(3,1)+STRO(3,KMAX)
+      STRO(4,1)=STRO(4,1)+STRO(4,KMAX)
+      STRO(1,KMAX)=0.
+      STRO(2,KMAX)=0.
+      STRO(3,KMAX)=0.
+      STRO(4,KMAX)=0.
+      IC(1)=NINT(STRO(4+1,1))
+      IC(2)=NINT(STRO(4+2,1))
+      CALL IDDECO(IC,JC)
+      ICX(1)=NINT(ABS(STRO(4+1,KMAX)))
+      ICX(2)=NINT(ABS(STRO(4+2,KMAX)))
+      CALL IDDECO(ICX,JCX)
+      DO 22 NF=1,NFLAV
+        JC(NF,1)=JC(NF,1)+JCX(NF,1)
+        JC(NF,2)=JC(NF,2)+JCX(NF,2)
+22    CONTINUE
+      CALL IDENCO(JC,IC,IRETEN)
+      IF ( IRETEN .EQ. 1 ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('JSPLIT')
+          WRITE(IFCH,*)'*****  IDENCO RET CODE = 1'
+     *                ,'   (AFTER ABSORPTION)'
+          WRITE(IFCH,*)'JC:'
+          WRITE(IFCH,*)JC
+          CALL UTMSGF
+        ENDIF
+        GOTO 1001
+      ENDIF
+      STRO(5,1)=IC(1)
+      STRO(6,1)=IC(2)
+      STRO(5,KMAX)=0.
+      STRO(6,KMAX)=0.
+      GOTO 10002
+
+C  CHECK NSCC
+C  ----------
+10002 CONTINUE
+      IF ( KMAXOR.GT.2 .AND. KMAX.EQ.2 .AND. MAX(1,NSCC).NE.NSCCX ) THEN
+        IER=3
+        IF ( ISH .GE. 91 ) THEN
+          WRITE(IFCH,*)'REDO STRING PROCESSING WITH NEW APART, EPART'
+          WRITE(IFCH,*)' '
+        ENDIF
+        GOTO 10001
+      ENDIF
+
+C  PRINT
+C  -----
+      IF ( ISH .GE. 92 ) THEN
+        IF ( ISH .GE. 93 ) THEN
+          WRITE(IFCH,*)'REMAINDER STRING:'
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,105)(STRO(I,1),I=1,4),(NINT(STRO(I,1)),I=5,6)
+          DO 9 K=2,KMAX
+            WRITE(IFCH,104)(STRO(I,K),I=1,4),(NINT(STRO(I,K)),I=5,6)
+ 9        CONTINUE
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,*)'SPLIT STRING:'
+          WRITE(IFCH,*)' '
+        ENDIF
+        WRITE(IFCH,105)(STR(I,1),I=1,4),(NINT(STR(I,1)),I=5,6)
+105     FORMAT(' STR: ',4F13.5,2I8)
+        WRITE(IFCH,104)(STR(I,2),I=1,4),(NINT(STR(I,2)),I=5,6)
+104     FORMAT('      ',4F13.5,2I8)
+        WRITE(IFCH,*)' '
+      ENDIF
+10001 CONTINUE
+      IF ( ISH .GE. 93 ) THEN
+        WRITE(IFCH,*)('-',L=1,25)
+        WRITE(IFCH,*)'   RETURN FROM JSPLIT   '
+        WRITE(IFCH,*)('-',L=1,25)
+        WRITE(IFCH,*)' '
+      ENDIF
+      ISH=ISH0
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE LEPEXP(RXBJ,RQSQ)
+
+C-----------------------------------------------------------------------
+C  GENERATES X_BJORKEN AND Q**2 ACCORDING TO AN EXPERIMENTAL
+C  DISTRIBUTION ( GIVEN IN ARRAY XQ(NXBJ,NQSQ) ).
+C-----------------------------------------------------------------------
+      PARAMETER (NQSQ=10)
+      PARAMETER (NXBJ=10)
+      REAL  XQ(NXBJ,NQSQ),VXQ(NXBJ*NQSQ)
+      EQUIVALENCE (XQ(1,1),VXQ(1))
+
+      DATA VXQ/1304.02,   366.40,    19.84,    10.79,     6.42,
+     *            4.54,     4.15,     3.38,     2.03,     1.56,
+     *          241.63,  1637.26,   427.36,   164.51,    73.72,
+     *           43.07,    20.73,    12.78,     9.34,     5.83,
+     *            0.01,   724.66,   563.79,   275.08,   176.13,
+     *          106.44,    85.82,    54.52,    37.12,    28.65,
+     *            0.01,   202.40,   491.10,   245.13,   157.07,
+     *          104.43,    61.05,    49.42,    37.84,    26.79,
+     *            0.01,     3.77,   316.38,   226.92,   133.45,
+     *           90.30,    63.67,    48.42,    35.73,    28.04,
+     *            0.01,     0.01,   153.74,   213.09,   114.14,
+     *           76.26,    60.02,    43.15,    43.47,    25.60,
+     *            0.01,     0.01,    39.31,   185.74,   108.56,
+     *           88.40,    47.29,    39.35,    31.80,    22.91,
+     *            0.01,     0.01,     0.01,   104.61,   107.01,
+     *           66.24,    45.34,    37.45,    33.44,    23.78,
+     *            0.01,     0.01,     0.01,    56.58,    99.39,
+     *           67.78,    43.28,    35.98,    34.63,    18.31,
+     *            0.01,     0.01,     0.01,    13.56,    76.25,
+     *           64.30,    42.80,    28.56,    21.19,    20.75 /
+      DATA QSQMIN/4./,QSQWID/4./,XBJMIN/0./,XBJWID/.025/,INIT/0/
+C-----------------------------------------------------------------------
+      INIT=INIT+1
+      IF ( INIT .EQ. 1 ) THEN
+        N=NXBJ*NQSQ
+        SUM=VXQ(1)
+        DO 1 I=2,N
+          SUM=SUM+VXQ(I)
+          VXQ(I)=VXQ(I)+VXQ(I-1)
+ 1      CONTINUE
+        DO 3 I=1,N
+          VXQ(I)=VXQ(I)/SUM
+ 3      CONTINUE
+      ENDIF
+
+      N=NXBJ*NQSQ
+      R=RANGEN()
+      CALL UTLOC(VXQ,N,R,ILOC)
+      IF ( ILOC .GE. N ) ILOC=ILOC-1
+      I=MOD(ILOC,NXBJ)+1
+      IF ( I .EQ. 0 ) I=NXBJ
+      J=ILOC/NXBJ + 1
+      IF ( ILOC .GT. 0 ) THEN
+        DXINT=VXQ(ILOC+1)-VXQ(ILOC)
+      ELSE
+        DXINT=VXQ(1)
+      ENDIF
+      DXBJ=XBJWID*ABS(R-VXQ(ILOC+1))/DXINT
+      DY  =QSQWID*RANGEN()
+      RXBJ=XBJMIN+XBJWID*FLOAT(I-1)+DXBJ
+      RQSQ=QSQMIN+QSQWID*FLOAT(J-1)+DY
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE LEPSTR(NUCLON,XBJ,QSQ,NSTRNG)
+
+C-----------------------------------------------------------------------
+C  RETURNS STRING CODE NSTRNG FOR GIVEN NUCLON, XBJ, QSQ.
+C  NUCLON  : THE STRUCK NUCLEON (1120/1220 = PROTON/NEUTRON)
+C  XBJ,QSQ : X-BJORKEN AND Q**2
+C  NSTRNG  : STRING CODE:
+C        PROTON STRINGS:          NEUTRON STRINGS:
+C        1 : U  ---  UD           11 : U  ---  DD
+C        2 : D  ---  UU           12 : D  ---  UD
+C        3 : U  ---  UB(UUD)      13 : U  ---  UB(UDD)
+C        4 : D  ---  DB(UUD)      14 : D  ---  DB(UDD)
+C        5 : S  ---  SB(UUD)      15 : S  ---  SB(UDD)
+C        6 : UB ---  U(UUD)       16 : UB ---  U(UDD)
+C        7 : DB ---  D(UUD)       17 : DB ---  D(UDD)
+C        8 : SB ---  S(UUD)       18 : SB ---  S(UDD)
+C-----------------------------------------------------------------------
+      REAL QUARKS(9)
+C-----------------------------------------------------------------------
+      NSTRNG=0
+
+C  PROTON-STRING (VALENCE PART)
+      IF     ( NUCLON .EQ. 1120 ) THEN
+        QUARKS(1) = 4.* STXU(XBJ,QSQ)
+        QUARKS(2) =     STXD(XBJ,QSQ)
+
+C  NEUTRON-STRING (VALENCE PART)
+      ELSEIF ( NUCLON .EQ. 1220 ) THEN
+        QUARKS(1) = 4.* STXD(XBJ,QSQ)
+        QUARKS(2) =     STXU(XBJ,QSQ)
+
+      ELSE
+        RETURN
+      ENDIF
+
+C  THE SEA CONTRIBUTIONS (PROTON/NEUTRON)
+      UDSEA     =     STXUS(XBJ,QSQ)
+      SSEA      =     STXS(XBJ,QSQ)
+      QUARKS(3) = 4.* UDSEA
+      QUARKS(4) =     UDSEA
+      QUARKS(5) =     SSEA
+      QUARKS(6) = 4.* UDSEA
+      QUARKS(7) =     UDSEA
+      QUARKS(8) =     SSEA
+
+      QUARKS(9) = 0.
+      DO 11 I=1,8
+        QUARKS(9) = QUARKS(9)+QUARKS(I)
+11    CONTINUE
+
+      R = RANGEN() * QUARKS(9)
+      SUMQ = 0.
+      DO 12 I=1,8
+        NSTRNG = I
+        SUMQ = SUMQ + QUARKS(I)
+        IF ( R .LE. SUMQ ) GO TO 13
+12    CONTINUE
+13    CONTINUE
+
+      IF ( NUCLON .EQ. 1220 ) NSTRNG=NSTRNG+10
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE LEPTAR(XBJ,QSQ,MATARG,LATARG,NUCLON)
+
+C-----------------------------------------------------------------------
+C  RETURNS NUCLON = ID OF HIT TARGET NUCLEON.
+C  XBJ   : X BJORKEN
+C  QSQ   : Q SQUARED
+C  MATARG : A  OF TARGET
+C  LATARG : Z  OF TARGET
+C  NUCLON: ID OF TARGET NUCLEON (1120/1220 FOR PROTON/NEUTRON)
+C-----------------------------------------------------------------------
+C  PROTON PART OF THE STRUCTURE FUNCTION:
+      F2P = LATARG * STXZPR(XBJ,QSQ)
+C  NEUTRON PART OF THE STRUCTURE FUNCTION:
+      F2N = (MATARG-LATARG) * STXZNE(XBJ,QSQ)
+C  STRUCTURE FUNCTION OF NUCLEUS:
+      F2A = F2P + F2N
+C  SELECT  THE TARGET-NUCLEON  ( PROTON OR NEUTRON ):
+      RN = RANGEN()
+      F2RNDM = F2A * RN
+      IF ( F2RNDM .LT. F2N ) THEN
+        NUCLON = 1220
+      ELSE
+        NUCLON = 1120
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE NUCINI(OPT,ANUC,LA,MA,ISI)
+
+C-----------------------------------------------------------------------
+C  INITIALIZES NUCLEON-MOMENTA.
+C  WRITES NUCLEONS ON /CPTL/ (P,IFR,ICL).
+C-----------------------------------------------------------------------
+      PARAMETER (MAMX=56)
+      PARAMETER (MAMX2=MAMX*2)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      COMMON /CNNN/    NNNPTL(MAMX2)
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      REAL      ANUC(NSI,NHA,MAMX)
+      CHARACTER OPT*3
+C-----------------------------------------------------------------------
+      NHAX=3
+      IF ( NHA .LT. NHAX ) THEN
+        CALL UTSTOP('NUCINI: NHA TOO SMALL                   ')
+      ENDIF
+      LAS=0
+      MAS=0
+
+      DO 1 L=1,MA
+        DO 2 M=1,NHA
+          DO 3 N=1,NSI
+            ANUC(N,M,L)=0.
+ 3        CONTINUE
+ 2      CONTINUE
+
+        IF     ( OPT .EQ. 'NUC' ) THEN
+          IF     ( ISI .GT. 0  .AND.  LAPROJ .LT. 0 ) THEN
+            ID=IDPROJ
+          ELSEIF ( ISI .LT. 0  .AND.  LATARG .LT. 0 ) THEN
+            ID=IDTARG
+          ELSE
+            IF ( RANGEN() .LE. (LA-LAS)/FLOAT(MA-MAS)) THEN
+              ID=1120
+              LAS=LAS+1
+            ELSE
+              ID=1220
+            ENDIF
+            MAS=MAS+1
+          ENDIF
+          CALL IDMASS(ID,AMS)
+          IC1=IDTRAI(1,ID,1)
+          IC2=IDTRAI(2,ID,1)
+          P1=0.
+          P2=0.
+          P3=ISI*PNLLX
+          P0=SQRT(PNLLX**2+AMS**2)
+          P0X=PNLLX
+          P5=AMS
+
+        ELSEIF ( OPT .EQ. 'STR' ) THEN
+          IF ( RANGEN() .LE. (LA-LAS)/FLOAT(MA-MAS) ) THEN
+            ID=1120
+            LAS=LAS+1
+          ELSE
+            ID=1220
+          ENDIF
+          MAS=MAS+1
+          IC1=IDTRAI(1,ID,1)
+          IC2=IDTRAI(2,ID,1)
+          P1=0.
+          P2=0.
+          P3=0.
+          P0=PROM
+          P5=PROM
+        ENDIF
+
+        ANUC(5,1,L)=IC1
+        ANUC(6,1,L)=IC2
+        ANUC(3,2,L)=P3
+        ANUC(4,2,L)=P0X
+        ANUC(5,2,L)=IC1
+        ANUC(6,2,L)=IC2
+        NPTL=NPTL+1
+        IF ( NPTL .NE. NNNPTL(NPTL) ) THEN
+          CALL UTSTOP('NUCINI: NPTL AND NNNPTL DONT MATCH      ')
+        ENDIF
+        IDPTL(NPTL)=ID
+        PPTL(1,NPTL)=P1
+        PPTL(2,NPTL)=P2
+        PPTL(3,NPTL)=P3
+        PPTL(4,NPTL)=P0
+        PPTL(5,NPTL)=P5
+        IFRPTL(1,NPTL)=0
+        IFRPTL(2,NPTL)=0
+        ICLPTL(NPTL)=1
+        NQJPTL(NPTL)=0
+ 1    CONTINUE
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE NUCLCO(MASSNR,N,X,Y,Z,YNUC)
+
+C-----------------------------------------------------------------------
+C  CALCULATES COORDINATES OF THE NUCLEONS IN A NUCLEUS.
+C-----------------------------------------------------------------------
+      PARAMETER (KOLLMX=2500)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (NDEP=129)
+      PARAMETER (NDET=129)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /COL/     BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
+     *                ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
+     *                ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
+     *                ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
+     *                ,XDET99(NDET)
+     *                ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
+     *                ,NRTARG(KOLLMX),NTARG
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      REAL X(N),Y(N),Z(N)
+C-----------------------------------------------------------------------
+      IF ( MASSNR .EQ. 0 ) RETURN
+      IF ( MASSNR .GT. N ) THEN
+        CALL UTSTOP('NUCLCO: MASSNR.GT.N                     ')
+      ENDIF
+      IF ( MASSNR .EQ. 1 ) THEN
+        X(1)=0.
+        Y(1)=0.
+        Z(1)=0.
+        RETURN
+      ENDIF
+      DO 3 I=1,MASSNR
+10      CONTINUE
+        IF ( MASSNR .EQ. MAPROJ )
+     *                      R=UTINVT(NDEP,XDEP,QDEP,RANGEN()*QDEP(NDEP))
+        IF ( MASSNR .EQ. MATARG ) THEN
+          IF     ( LTARG .EQ. 1 ) THEN
+            R=UTINVT(NDET,XDET14,QDET14,RANGEN()*QDET14(NDET))
+          ELSEIF ( LTARG .EQ. 2 ) THEN
+            R=UTINVT(NDET,XDET16,QDET16,RANGEN()*QDET16(NDET))
+          ELSEIF ( LTARG .EQ. 3 ) THEN
+            R=UTINVT(NDET,XDET40,QDET40,RANGEN()*QDET40(NDET))
+          ELSE
+            R=UTINVT(NDET,XDET99,QDET99,RANGEN()*QDET99(NDET))
+          ENDIF
+        ENDIF
+        IF ( MASSNR.NE.MAPROJ .AND. MASSNR.NE.MATARG ) THEN
+          CALL UTSTOP('NUCLCO: NUCLEUS NEITHER PROJ NOR TARG   ')
+        ENDIF
+        COSTHE=1.-2.*RANGEN()
+        SINTHE= SQRT(1. - COSTHE**2)
+        PHI=2.*PI*RANGEN()
+        X(I)=R*SINTHE*COS(PHI)
+        Y(I)=R*SINTHE*SIN(PHI)
+        Z(I)=R*COSTHE
+        IF ( I .EQ. 1 ) GOTO 3
+        IF ( CORE .EQ. 0. ) GOTO 3
+        DO 2 J=1,I-1
+          IF ( (X(I)-X(J))**2+(Y(I)-Y(J))**2+(Z(I)-Z(J))**2
+     *                               .LT. CORE**2 ) GOTO 10
+2       CONTINUE
+3     CONTINUE
+      IF ( ISH .GE. 93 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'NUCLEON COORDINATES:'
+      ENDIF
+      AUXIL = 1./COSH(YNUC)
+      DO 4 I=1,MASSNR
+        Z(I)=Z(I)*AUXIL
+4     CONTINUE
+      IF ( ISH .GE. 93 ) THEN
+        DO 5 I=1,MASSNR
+          WRITE(IFCH,*)'I X Y Z: ',I,X(I),Y(I),Z(I)
+5       CONTINUE
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE NUCOGE
+
+C-----------------------------------------------------------------------
+C  WRITES NUCLEONS ON /CPTL/ (XOR,TIV,IST,IOR,JOR,NST).
+C  DETERMINES SEQUENCE OF COLLISIONS ACCORDING TO NUCLEAR GEOMETRY
+C    IF MAPROJ>0.
+C-----------------------------------------------------------------------
+      PARAMETER (KOLLMX=2500)
+      PARAMETER (MAMX=56)
+      PARAMETER (MAMX2=MAMX*2)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (NDEP=129)
+      PARAMETER (NDET=129)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /CNCL/    XPROJ(MAMX),XTARG(MAMX),YPROJ(MAMX)
+     *                ,YTARG(MAMX),ZPROJ(MAMX),ZTARG(MAMX)
+      COMMON /CNNN/    NNNPTL(MAMX2)
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /COL/     BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
+     *                ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
+     *                ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
+     *                ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
+     *                ,XDET99(NDET)
+     *                ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
+     *                ,NRTARG(KOLLMX),NTARG
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+C-----------------------------------------------------------------------
+      IF ( ISH .EQ. 17  .OR.  ISH .GT. 92 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'NUCOGE (ENTRY)'
+      ENDIF
+      VELI=1./TANH(YPJTL-YHAHA)+TANH(YHAHA)
+      NPROJ=1
+      NTARG=1
+      DO 15 N=1,KOLLMX
+        NORD(N)=N
+        COORD(1,N)=0.
+        COORD(2,N)=0.
+        COORD(3,N)=0.
+        COORD(4,N)=0.
+15    CONTINUE
+
+      IF     ( MATARG .LT. 0 ) THEN
+        KOLL=-MATARG
+        NTARG=KOLL
+        BIMP=0.
+        NPTL=NPTL+1
+        XORPTL(1,NPTL)=0.
+        XORPTL(2,NPTL)=0.
+        XORPTL(3,NPTL)=0.
+        XORPTL(4,NPTL)=0.
+        TIVPTL(1,NPTL)=-AINFIN
+        TIVPTL(2,NPTL)=0.
+        ISTPTL(NPTL)=1
+        IORPTL(NPTL)=-1
+        JORPTL(NPTL)=0
+        NNNPTL(NPTL)=NPTL
+        DO 1 K=1,KOLL
+          NRPROJ(K)=1
+          NRTARG(K)=K
+          NPTL=NPTL+1
+          XORPTL(1,NPTL)=0.
+          XORPTL(2,NPTL)=0.
+          XORPTL(3,NPTL)=0.
+          XORPTL(4,NPTL)=0.
+          TIVPTL(1,NPTL)=-AINFIN
+          TIVPTL(2,NPTL)=0.
+          ISTPTL(NPTL)=1
+          IORPTL(NPTL)=-1
+          JORPTL(NPTL)=0
+          NNNPTL(NPTL)=NPTL
+1       CONTINUE
+        GOTO 9999
+
+      ELSEIF ( MAPROJ .EQ. 1  .AND.  MATARG .EQ. 1 ) THEN
+        KOLL=1
+        BIMP=0.
+        NRPROJ(1)=1
+        NRTARG(1)=1
+        DO 5 II=1,2
+          NPTL=NPTL+1
+          XORPTL(1,NPTL)=0.
+          XORPTL(2,NPTL)=0.
+          XORPTL(3,NPTL)=0.
+          XORPTL(4,NPTL)=0.
+          TIVPTL(1,NPTL)=-AINFIN
+          TIVPTL(2,NPTL)= 0.
+          ISTPTL(NPTL)  = 1
+          IORPTL(NPTL)  =-1
+          JORPTL(NPTL)  = 0
+          NNNPTL(NPTL)  = NPTL
+ 5      CONTINUE
+        GOTO 9999
+      ENDIF
+
+      CALL NUCLCO(MAPROJ,MAMX,XPROJ,YPROJ,ZPROJ,YPJTL-YHAHA)
+      CALL NUCLCO(MATARG,MAMX,XTARG,YTARG,ZTARG,YHAHA)
+      BX=0.
+      BY=0.
+      IF ( MAPROJ .GT. 0 ) THEN
+        IF ( BIMEVT .LT. 0. ) THEN
+          B1=BMINIM
+          B2=MIN(RMPROJ+RMTARG(LTARG),BMAXIM)
+          IF ( B1 .GT. B2 ) THEN
+            CALL UTSTOP('NUCOGE: BMIN > BMAX                     ')
+          ENDIF
+          BIMP=SQRT(B1**2+(B2**2-B1**2)*RANGEN())
+          PHI=2.*PI*RANGEN()
+        ELSE
+          PHI=PHIEVT
+          BIMP=BIMEVT
+        ENDIF
+        BX=COS(PHI)*BIMP
+        BY=SIN(PHI)*BIMP
+        DO 6 I=1,MAPROJ
+          NPTL=NPTL+1
+          XORPTL(1,NPTL)=XPROJ(I)+BX*0.5
+          XORPTL(2,NPTL)=YPROJ(I)+BY*0.5
+          XORPTL(3,NPTL)=ZPROJ(I)
+          XORPTL(4,NPTL)=0.
+          TIVPTL(1,NPTL)=-AINFIN
+          TIVPTL(2,NPTL)= AINFIN
+          ISTPTL(NPTL)=0
+          IORPTL(NPTL)=0
+          JORPTL(NPTL)=0
+          NNNPTL(NPTL)=NPTL
+ 6      CONTINUE
+      ENDIF
+      DO 7 I=1,MATARG
+        NPTL=NPTL+1
+        XORPTL(1,NPTL)=XTARG(I)-BX*0.5
+        XORPTL(2,NPTL)=YTARG(I)-BY*0.5
+        XORPTL(3,NPTL)=ZTARG(I)
+        XORPTL(4,NPTL)=0.
+        TIVPTL(1,NPTL)=-AINFIN
+        TIVPTL(2,NPTL)= AINFIN
+        ISTPTL(NPTL)=0
+        IORPTL(NPTL)=0
+        JORPTL(NPTL)=0
+        NNNPTL(NPTL)=NPTL
+ 7    CONTINUE
+      IF ( MAPROJ .EQ. 0 ) GOTO 1000
+      KOLL=0
+      DO 12 I=1,MAPROJ
+        DO 12 J=1,MATARG
+          IF ( PI*( (XPROJ(I)+BX-XTARG(J))**2
+     *        +(YPROJ(I)+BY-YTARG(J))**2 ) .GT. SIGPPI ) GOTO 12
+          IF ( KOLL .GT. 0 ) THEN
+            KP=0
+            KT=0
+            DO 30 KL=1,KOLL
+              IF ( NRPROJ(KL) .EQ. I ) KP=1
+              IF ( NRTARG(KL) .EQ. J ) KT=1
+30          CONTINUE
+CDH         FTRSIG=1.0
+            FTR=1.0
+CDH         IF ( KP .EQ. 1 ) FTR=FTR*FTRSIG
+CDH         IF ( KT .EQ. 1 ) FTR=FTR*FTRSIG
+            IF ( KP.EQ.1 .OR. KT.EQ.1 ) THEN
+              IF ( PI*( (XPROJ(I)+BX-XTARG(J))**2
+     *           +(YPROJ(I)+BY-YTARG(J))**2 ) .GT. FTR*SIGPPI ) GOTO 12
+            ENDIF
+          ENDIF
+          KOLL=KOLL+1
+          IF ( KOLL .GT. KOLLMX ) THEN
+            CALL UTSTOP('NUCOGE: KOLLMX TOO SMALL                ')
+          ENDIF
+          NRPROJ(KOLL)=I
+          NRTARG(KOLL)=J
+          DISTCE(KOLL)=ZTARG(J)-ZPROJ(I)
+          COORD(1,KOLL)=(XPROJ(I)+XTARG(J))*0.5
+          COORD(2,KOLL)=(YPROJ(I)+YTARG(J))*0.5
+          COORD(3,KOLL)=(ZPROJ(I)+ZTARG(J))*0.5
+          COORD(4,KOLL)=DISTCE(KOLL)*VELI
+          ISTPTL(I)=1
+          IORPTL(I)=-1
+          TIVPTL(2,I)=COORD(4,KOLL)
+          ISTPTL(MAPROJ+J)=1
+          IORPTL(MAPROJ+J)=-1
+          TIVPTL(2,MAPROJ+J)=COORD(4,KOLL)
+12    CONTINUE
+      IF ( KOLL .LE. 1 ) GOTO 9999
+
+      DO 21 N=2,KOLL
+        DO 22 M=1,N-1
+          IF ( NRPROJ(M) .EQ. NRPROJ(N) ) GOTO 21
+22      CONTINUE
+        NPROJ=NPROJ+1
+21    CONTINUE
+      DO 23 N=2,KOLL
+        DO 24 M=1,N-1
+          IF ( NRTARG(M) .EQ. NRTARG(N) ) GOTO 23
+24      CONTINUE
+        NTARG=NTARG+1
+23    CONTINUE
+
+      DO 20 N=1,KOLL-1
+        DO 20 M=N+1,KOLL
+          IF ( DISTCE(NORD(M)) .LT. DISTCE(NORD(N)) ) THEN
+            NORDM=NORD(M)
+            NORD(M)=NORD(N)
+            NORD(N)=NORDM
+          ENDIF
+20    CONTINUE
+
+9999  CONTINUE
+      IF ( KOLL .LE. 0 ) GOTO 1000
+      IF ( KOLL .LT. KO1KO2/10000  .OR.  KOLL .GT. MOD(KO1KO2,10000) )
+     *                                                     GOTO 1000
+      NEVT=1
+      BIMEVT=BIMP
+      PHIEVT=PHI
+      KOLEVT=KOLL
+      NPJEVT=NPROJ
+      NTGEVT=NTARG
+      PMXEVT=PNLL
+      EGYEVT=ENGY
+
+1000  CONTINUE
+      IF ( ISH .EQ. 17  .OR.  ISH .GT. 92 ) THEN
+        WRITE(IFCH,*)'NUCOGE (EXIT)'
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE NUCOLL
+
+C-----------------------------------------------------------------------
+C  PERFORMS A  NUCLEUS-NUCLEUS COLLISION (INCL. NUCLEON-NUCLEON)
+C-----------------------------------------------------------------------
+      PARAMETER (KOLLMX=2500)
+      PARAMETER (MAMX=56)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXSTR=3000)
+      PARAMETER (NDEP=129)
+      PARAMETER (NDET=129)
+      PARAMETER (NPRBMS=20)
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /CIV/     IVP,IVP0,IVT,IVT0
+      COMMON /CKOL/    KOL
+      COMMON /CNCE/    NCES,NCOLEX
+      COMMON /CNEW/    KOTRI,NEWCOL,NEWICO
+      COMMON /CNFR/    NRFRA
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CNTEVM/  NTEVM
+      COMMON /COL/     BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
+     *                ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
+     *                ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
+     *                ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
+     *                ,XDET99(NDET)
+     *                ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
+     *                ,NRTARG(KOLLMX),NTARG
+      COMMON /CPRBMS/  PRBMS(NPRBMS)
+      COMMON /CPROJA/  IPROJ,ITARG,KPROJA(NHA,MAMX),KTARGA(NHA,MAMX)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CSTR/    PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
+     *                ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /PARTNR/  PEX,PEY,PEZET,PE0,PX4,PY4,SUMMAS
+     *                ,IC4,IPTNR,JS4,NPS
+
+      REAL      PROJ(NSI,NHA),PROJA(NSI,NHA,MAMX)
+     *         ,TARG(NSI,NHA),TARGA(NSI,NHA,MAMX)
+      INTEGER   IC4(2)
+      CHARACTER DASH*1
+      DATA DASH/'-'/
+C-----------------------------------------------------------------------
+      ISH0=ISH
+      IF ( ISHSUB/100 .EQ. 6 ) ISH=MOD(ISHSUB,100)
+      IF     ( ISH .EQ. 17  .OR.  ISH .GT. 92 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'NUCOLL (ENTRY)'
+CDH   ELSEIF ( ISH .EQ. 14 ) THEN
+CDH     CALL UTTIMA('*** NUCOLL *** ')
+      ENDIF
+
+      IF ( ISHSUB/100 .EQ. 7 ) ISH=MOD(ISHSUB,100)
+      NEVT=0
+      NPTL=0
+      CALL NUCOGE
+      IF ( ICHOIC .EQ. 3  .OR.  KOLL .EQ. 0 ) GOTO 1000
+      NAEVT=NAEVT+1
+      IF ( KOLL .LT. KO1KO2/10000  .OR.
+     *     KOLL .GT. MOD(KO1KO2,10000) ) GOTO 1000
+      COLEVT=KOLL
+      AMSEV=SQRT((NPJEVT*SQRT(AMPROJ**2+PNLLX**2)
+     *           +NTGEVT*SQRT(AMTARG**2+PNLLX**2))**2
+     *                -((NPJEVT-NTGEVT)*PNLLX)**2)
+      IF ( ISHSUB/100 .EQ. 7 ) ISH=ISH0
+
+      ITRY=0
+38    CONTINUE
+      ITRY=ITRY+1
+      NSTR=0
+      NPTL=0
+      SUMPT2=0.
+      AMSAC=0.
+      CALL NUCINI('NUC',PROJA,LAPROJ,MAPROJ,1)
+      CALL NUCINI('NUC',TARGA,LATARG,IABS(MATARG),-1)
+
+      KOLRAN=RANGEN()*KOLL+1
+      KOLRAN=MIN(KOLRAN,KOLL)
+      KOLRAN=MAX(KOLRAN,1)
+
+      DO 2 KOLS=1,KOLL
+        KOL=KOLS
+        ISKIP=0
+        I=NRPROJ(NORD(KOL))
+        J=NRTARG(NORD(KOL))
+        IPROJ=I
+        ITARG=J
+        NRECOP=0
+        NRECOT=0
+        IF ( KOL .LT. KOLL ) THEN
+          DO 33 K=KOL+1,KOLL
+            IF ( NRPROJ(NORD(K)) .EQ. I ) NRECOP=NRECOP+1
+            IF ( NRTARG(NORD(K)) .EQ. J ) NRECOT=NRECOT+1
+33        CONTINUE
+        ENDIF
+        NCOP=0
+        NCOT=0
+        IF ( KOL .GT. 1 ) THEN
+          DO 34 K=1,KOL-1
+            IF ( NRPROJ(NORD(K)) .EQ. I ) NCOP=NCOP+1
+            IF ( NRTARG(NORD(K)) .EQ. J ) NCOT=NCOT+1
+34        CONTINUE
+        ENDIF
+        IF ( NCOP.GE.NCOLMX  .OR.  NCOT.GE.NCOLMX ) ISKIP=1
+
+        DO 56 M=1,NHA
+          SM=0.
+          DO 57 N=1,NSI
+            PROJ(N,M)=PROJA(N,M,I)
+            SM=SM+PROJ(N,M)**2
+57        CONTINUE
+          IF ( M .GE. 3  .AND.  SM .LT. 1.E-5 ) GOTO 58
+56      CONTINUE
+58      CONTINUE
+        DO 53 M=1,NHA
+          SM=0.
+          DO 54 N=1,NSI
+            TARG(N,M)=TARGA(N,M,J)
+            SM=SM+TARG(N,M)**2
+54        CONTINUE
+          IF ( M .GE. 3  .AND.  SM .LT. 1.E-5 ) GOTO 55
+53      CONTINUE
+55      CONTINUE
+
+        IF ( KOL .EQ. KOLRAN  .AND.  JPSI .EQ. 1 ) THEN
+          CALL PVJPSF(PROJ,TARG)
+          ISKIP=1
+        ENDIF
+
+C  NR OF COLOUR EXCHANGES
+C  ----------------------
+
+        AMSAC0=AMSAC
+        ISKIP0=ISKIP
+        SMPT2=SUMPT2
+        CALL UTREMB(PROJ,TARG,1)
+        GOTO 4
+ 3      CONTINUE
+        IF ( ISH .GE. 91 ) WRITE(IFCH,*)'REDO HH COLLISION'
+        CALL UTREST(PROJ,TARG,1)
+        SUMPT2=SMPT2
+        ISKIP=ISKIP0
+        AMSAC=AMSAC0
+ 4      CONTINUE
+
+        NCOLEX=1
+        IF ( ISKIP .NE. 1 ) THEN
+          LO=0
+16        LO=LO+1
+          IF ( LO .EQ. 3 ) THEN
+            IF ( ISH .GE. 90 ) THEN
+              CALL UTMSG('NUCOLL')
+              WRITE(IFCH,*)'*****  LO=3'
+              CALL UTMSGF
+            ENDIF
+          ENDIF
+          R=RANGEN()
+          NCOLEX=0
+15        NCOLEX=NCOLEX+1
+          IF ( NCOLEX .GT. NPRBMS ) GOTO 16
+          IF ( R .GT. PRBMS(NCOLEX) ) GOTO 15
+        ENDIF
+
+C  HADRON-HADRON COLLISION
+C  -----------------------
+
+        DO 31 NCE=1,NCOLEX
+          NCES=NCE
+          CALL UTPAGE
+          IF ( ISH .GE. 91 ) THEN
+            WRITE(IFCH,101)(DASH,L=1,79),IPAGE,KOL,NCE
+     *        ,NRPROJ(NORD(KOL)),NRTARG(NORD(KOL)),(DASH,L=1,79)
+101         FORMAT(/1X,79A1/1X,I5,'.PAGE             COL: ',I2
+     *           ,'   CEX: ',I2,'   PRJ: ',I3,'   TRG: ',I3/1X,79A1/)
+          ENDIF
+          IF ( NRECOP .EQ. 0 ) THEN
+            ISTORP=1
+          ELSE
+            ISTORP=0
+          ENDIF
+          IF ( NRECOT .EQ. 0 ) THEN
+            ISTORT=1
+          ELSE
+            ISTORT=0
+          ENDIF
+          CALL HAHABS(PROJ,TARG
+     *           ,ISTORP*(NCE/NCOLEX),ISTORT*(NCE/NCOLEX),ISKIP,IRETHH)
+          IF ( ISKIP .GE. 2 ) GOTO 9997
+          IF ( IRETHH .EQ. 1 ) GOTO 3
+          IF ( IRESCL .EQ. 1  .AND.  AMSAC .GT. AMSEV ) GOTO 9998
+          SUMPT2=SUMPT2+
+     *            PROJ(1,2)**2+PROJ(2,2)**2+TARG(1,2)**2+TARG(2,2)**2
+          IF ( ISH .EQ. 11 ) WRITE(IFCH,*)'SUMPT2:',NREVT,KOL,NCE,SUMPT2
+          ISKIP=0
+31      CONTINUE
+
+        DO 40 M=1,NHA
+          SM=0.
+          DO 41 N=1,NSI
+            PROJA(N,M,I)=PROJ(N,M)
+            SM=SM+PROJ(N,M)**2
+41        CONTINUE
+          IF ( M .GE. 3  .AND.  SM .LT. 1.E-5 ) GOTO 42
+40      CONTINUE
+42      CONTINUE
+        DO 43 M=1,NHA
+          SM=0.
+          DO 44 N=1,NSI
+            TARGA(N,M,J)=TARG(N,M)
+            SM=SM+TARG(N,M)**2
+44        CONTINUE
+          IF ( M .GE. 3  .AND.  SM .LT. 1.E-5 ) GOTO 45
+43      CONTINUE
+45      CONTINUE
+  2   CONTINUE
+
+      IF ( SUMPT2 .LT. 1.E-5 ) GOTO 9999
+
+1000  CONTINUE
+CDH   IF ( ISH .EQ. 14 ) CALL UTTIMA('    NUCOLL F   ')
+      IF ( ISH .EQ. 17  .OR.  ISH .GT. 92 ) THEN
+        WRITE(IFCH,*)'NUCOLL (EXIT)'
+      ENDIF
+      ISH=ISH0
+      RETURN
+
+9999  INOIAC=INOIAC+1
+      IF ( ISH .GE. 91  .OR.  ISH .EQ. 11 ) THEN
+        CALL UTMSG('NUCOLL')
+        WRITE(IFCH,*)'*****  NO INTERACTION. REDO NUCOLL'
+        CALL UTMSGF
+      ENDIF
+      GOTO 38
+
+9998  ILAMAS=ILAMAS+1
+      IF ( ISH .GE. 91  .OR. ISH .EQ. 12 ) THEN
+        CALL UTMSG('NUCOLL')
+        WRITE(IFCH,*)'*****  AMSAC>AMSEV: ',AMSAC,AMSEV
+     *    ,' . REDO NUCOLL'
+        DO 1 NS=1,NSTR
+          WRITE(IFCH,109)NS,(ICSTR(L,NS)/100,L=1,4)
+     *              ,(PSTR(L,NS),L=3,5)
+109       FORMAT(1X,I3,3X,4I5,3(E11.3))
+1       CONTINUE
+        CALL UTMSGF
+      ENDIF
+      GOTO 38
+
+9997  CONTINUE
+      IF ( ISH .GE. 90 ) THEN
+        CALL UTMSG('NUCOLL')
+        WRITE(IFCH,*)'*****  ISKIP>=2. REDO NUCOLL'
+        CALL UTMSGF
+      ENDIF
+      GOTO 38
+
+      END
+C=======================================================================
+
+      SUBROUTINE NUCSTR(IER)
+
+C-----------------------------------------------------------------------
+C  PERFORMES X AND P TRAFOS FOR NUCLEONS FOR STRING DECAY IN NUCLEUS
+C-----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      COMMON /CLEP/    ICINPU,IDSCAT
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+C-----------------------------------------------------------------------
+      IF ( MATARG .NE. NPTL ) THEN
+        CALL UTSTOP('NUCSTR: MATARG /= NPTL                  ')
+      ENDIF
+      NCNT=0
+3     NCNT=NCNT+1
+      IF ( NCNT .GE. 10 ) GOTO 1001
+      N0=MIN(1+INT(RANGEN()*NPTL),NPTL)
+      IF ( ICINPU .GT. 0  .AND.  IDPTL(N0) .NE. IDSCAT ) GOTO 3
+      ISTPTL(N0)=1
+      IORPTL(N0)=-1
+      TIVPTL(2,N0)=0.
+      DO 2 N=1,NPTL
+        XORPTL(1,N)=XORPTL(1,N)-XORPTL(1,N0)
+        XORPTL(2,N)=XORPTL(2,N)-XORPTL(2,N0)
+        XORPTL(3,N)=XORPTL(3,N)-XORPTL(3,N0)
+        PHI=2.*PI*RANGEN()
+        P1=      -ELEPTO*SIN(ANGMUE)*SIN(PHI)
+        P2=      -ELEPTO*SIN(ANGMUE)*COS(PHI)
+        P3=ELEPTI-ELEPTO*COS(ANGMUE)
+        CALL UTROTA(1,P1,P2,P3,XORPTL(1,N),XORPTL(2,N),XORPTL(3,N))
+        P3=SQRT(P1**2+P2**2+P3**2)
+        P1=0.
+        P2=0.
+        P4=PROM+ELEPTI-ELEPTO
+        CALL UTLOBO(1,P1,P2,P3,P4,SQRT(P4**2-P3**2-P2**2-P1**2)
+     *        ,XORPTL(1,N),XORPTL(2,N),XORPTL(3,N),XORPTL(4,N))
+        CALL UTLOBO(1,P1,P2,P3,P4,SQRT(P4**2-P3**2-P2**2-P1**2)
+     *         ,PPTL(1,N),PPTL(2,N),PPTL(3,N),PPTL(4,N))
+2     CONTINUE
+      IER=0
+      RETURN
+
+1001  IER=1
+      IF ( ISH .GE. 90 ) THEN
+        CALL UTMSG('NUCSTR')
+        WRITE(IFCH,*)'*****  IDSCAT NOT POSSIBLE ==> REDO EVENT.'
+        CALL UTMSGF
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE PVJPSF(PROJ,TARG)
+
+C-----------------------------------------------------------------------
+C  FORMS A JPSI
+C-----------------------------------------------------------------------
+      PARAMETER (KOLLMX=2500)
+      PARAMETER (MAMX=56)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXSTR=3000)
+      PARAMETER (NDEP=129)
+      PARAMETER (NDET=129)
+      PARAMETER (NGAU=129)
+      PARAMETER (NPTJ=129)
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CGAU/    QGAU(NGAU),XGAU(NGAU)
+      COMMON /CKOL/    KOL
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /COL/     BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
+     *                ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
+     *                ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
+     *                ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
+     *                ,XDET99(NDET)
+     *                ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
+     *                ,NRTARG(KOLLMX),NTARG
+      COMMON /CPROJA/  IPROJ,ITARG,KPROJA(NHA,MAMX),KTARGA(NHA,MAMX)
+      COMMON /CPTJ/    QPTJ(NPTJ),XPTJ(NPTJ)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CSTR/    PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
+     *                ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      REAL PROJ(NSI,NHA),PR(4),TARG(NSI,NHA),TG(4)
+C-----------------------------------------------------------------------
+      PAX=0.19
+      PROX=PROJ(3,2)
+      TARX=TARG(3,2)
+      LOOP=0
+      PR(1)=PROJ(1,2)
+      PR(2)=PROJ(2,2)
+      PR(3)=PROJ(3,2)
+      PR(4)=PROJ(4,2)
+      TG(1)=TARG(1,2)
+      TG(2)=TARG(2,2)
+      TG(3)=TARG(3,2)
+      TG(4)=TARG(4,2)
+
+      CALL UTPAGE
+      IF ( ISH .GE. 91 ) WRITE(IFCH,110)('-',L=1,79),IPAGE,('-',L=1,79)
+110   FORMAT(1X,79A1/1X,I5,'.PAGE            '
+     *         ,'JPSI FORMATION'/1X,79A1/)
+
+5000  LOOP=LOOP+1
+      IF ( LOOP .GT. 100 ) THEN
+        IF(ISH.GE.90)THEN
+          CALL UTMSG('PVJPSF')
+          WRITE(IFCH,*)'*****  JPSI FORMATION NOT POSSIBLE'
+          CALL UTMSGF
+        ENDIF
+        GOTO 1000
+      ENDIF
+      PROJ(1,2)=PR(1)
+      PROJ(2,2)=PR(2)
+      PROJ(3,2)=PR(3)
+      PROJ(4,2)=PR(4)
+      TARG(1,2)=TG(1)
+      TARG(2,2)=TG(2)
+      TARG(3,2)=TG(3)
+      TARG(4,2)=TG(4)
+
+C  JPSI MOMENTA
+C  ------------
+      ID=441
+      CALL IDMASS(ID,AM)
+      S=AM**2
+      PT=UTINVT(NPTJ,XPTJ,QPTJ,RANGEN()*QPTJ(NPTJ))
+      PHI=2.*PI*RANGEN()
+      PX=PT*COS(PHI)
+      PY=PT*SIN(PHI)
+      LO=0
+ 1    LO=LO+1
+      IF ( LO .GT. 10 ) THEN
+        CALL UTSTOP('PVJPSF: LO > 10                         ')
+      ENDIF
+      Z=PAX*UTINVT(NGAU,XGAU,QGAU,RANGEN()*QGAU(NGAU))
+      IF ( Z .GT. 1. ) GOTO 1
+      IF ( RANGEN() .LE. 0.5 ) THEN
+        PZ=Z*PNLLX
+      ELSE
+        PZ=-Z*PNLLX
+      ENDIF
+      E=SQRT(S+PX**2+PY**2+PZ**2)
+      PP=E+PZ
+      PM=E-PZ
+
+C  PROJ AND TARG MOMENTA
+C  ---------------------
+      R=RANGEN()
+      POX=PROJ(1,2)-R*PX
+      POY=PROJ(2,2)-R*PY
+      POT2=(POX**2+POY**2)
+      R=1.-R
+      PUX=TARG(1,2)-R*PX
+      PUY=TARG(2,2)-R*PY
+      PUT2=(PUX**2+PUY**2)
+      POP=PROJ(4,2)+PROJ(3,2)
+      POM=PROJ(4,2)-PROJ(3,2)
+      PUP=TARG(4,2)+TARG(3,2)
+      PUM=TARG(4,2)-TARG(3,2)
+      PEP=POP+PUP-PP
+      PEM=POM+PUM-PM
+      A=(PEM*PEP-PUT2-POT2)*0.5
+      D2=PUT2*POT2
+      AUXIL = A**2 - D2
+      IF ( AUXIL .LT. 0. ) GOTO 5000
+      AUXIL = SQRT(AUXIL)
+      PYP=(A+PUT2-AUXIL)/PEM
+      PYM=(A+POT2-AUXIL)/PEP
+      IF ( PYP .LT. 0. ) GOTO 5000
+      IF ( PYM. LT. 0. ) GOTO 5000
+      PIP=PEP-PYP
+      IF ( PIP .LT. 0. ) GOTO 5000
+      PIM=PYM
+      PAP=PYP
+      PAM=PEM-PYM
+      IF ( PAM .LT. 0. ) GOTO 5000
+      PROJ(1,2)=POX
+      PROJ(2,2)=POY
+      PROJ(3,2)=(PIP-PIM)*0.5
+      PROJ(4,2)=(PIP+PIM)*0.5
+      TARG(1,2)=PUX
+      TARG(2,2)=PUY
+      TARG(3,2)=(PAP-PAM)*0.5
+      TARG(4,2)=(PAP+PAM)*0.5
+      KPROJA(2,IPROJ)=KOL
+      KTARGA(2,ITARG)=KOL
+      IF ( PROJ(3,2)*PROX .LT. 0. ) GOTO 5000
+      IF ( TARG(3,2)*TARX .LT. 0. ) GOTO 5000
+
+C  JPSI STRING
+C  -----------
+      NSTR=NSTR+1
+      IF ( NSTR .GT. MXSTR ) THEN
+        CALL UTSTOP('PVJPSF: NSTR>MXSTR                      ')
+      ENDIF
+      IORSTR(NSTR)=-KOL
+      ICSTR(1,NSTR)=000100
+      ICSTR(2,NSTR)=0
+      ICSTR(3,NSTR)=0
+      ICSTR(4,NSTR)=000100
+      PSTR(1,NSTR)=PX
+      PSTR(2,NSTR)=PY
+      PSTR(3,NSTR)=PZ
+      PSTR(4,NSTR)=E
+      PSTR(5,NSTR)=AM
+      ROTSTR(1,NSTR)=0.
+      ROTSTR(2,NSTR)=0.
+      ROTSTR(3,NSTR)=1.
+      XORSTR(1,NSTR)=COORD(1,KOL)
+      XORSTR(2,NSTR)=COORD(2,KOL)
+      XORSTR(3,NSTR)=COORD(3,KOL)
+      XORSTR(4,NSTR)=COORD(4,KOL)
+      IF ( ISH .GE. 90 ) THEN
+        IF ( ISH .GE. 91 ) THEN
+          J=NSTR
+          WRITE(IFCH,100)J,(ICSTR(K,J)/100,K=1,4)
+     *           ,PSTR(3,J),PSTR(4,J),PSTR(5,J)
+100       FORMAT(' /CSTR/',I4,3X,4I5,3(E11.3))
+        ENDIF
+
+C  CHECKS
+C  ------
+        IF ( ABS(PIP*PIM-POT2) .GT. 1.E-4 ) THEN
+          CALL UTMSG('PVJPSF')
+          WRITE(IFCH,*)'*****  PIP*PIM /= POT**2'
+          WRITE(IFCH,*)'PIP*PIM=',PIP*PIM,'POT**2=',POT2
+          WRITE(IFCH,*)'PIP=',PIP,'   PIM=',PIM
+          CALL UTMSGF
+        ENDIF
+        IF ( ABS(PAP*PAM-PUT2) .GT. 1.E-4 ) THEN
+          CALL UTMSG('PVJPSF')
+          WRITE(IFCH,*)'*****  PAP*PAM /= PUT**2'
+          WRITE(IFCH,*)'PAP*PAM=',PAP*PAM,'PUT**2=',PUT2
+          WRITE(IFCH,*)'PAP=',PAP,'   PAM=',PAM
+          CALL UTMSGF
+        ENDIF
+        IF ( ABS(PROJ(4,2)**2
+     *      -PROJ(1,2)**2-PROJ(2,2)**2-PROJ(3,2)**2) .GT. 1.E-4 ) THEN
+          CALL UTMSG('PVJPSF')
+          WRITE(IFCH,*)'*****  MASS**2 OF PROJ NONZERO'
+          WRITE(IFCH,*)'MASS**2=',PROJ(4,2)**2
+     *              -PROJ(1,2)**2-PROJ(2,2)**2-PROJ(3,2)**2
+          CALL UTMSGF
+        ENDIF
+        IF ( ABS(TARG(4,2)**2
+     *       -TARG(1,2)**2-TARG(2,2)**2-TARG(3,2)**2) .GT. 1.E-4 ) THEN
+          CALL UTMSG('PVJPSF')
+          WRITE(IFCH,*)'*****  MASS**2 OF TARG NONZERO'
+          WRITE(IFCH,*)'MASS**2=',TARG(4,2)**2
+     *             -TARG(1,2)**2-TARG(2,2)**2-TARG(3,2)**2
+          CALL UTMSGF
+        ENDIF
+        DO 14 N=1,4
+          IF ( ABS(PR(N)+TG(N)
+     *       -PROJ(N,2)-TARG(N,2)-PSTR(N,NSTR)) .GT. 1.E-4 ) GOTO 15
+14      CONTINUE
+        GOTO 16
+15      CONTINUE
+        CALL UTMSG('PVJPSF')
+        WRITE(IFCH,*)'*****  PROJ + TARG /= PROJ_NEW + TARG_NEW +JPSI'
+        WRITE(IFCH,*)'PROJ,TARG:'
+        WRITE(IFCH,*)PR
+        WRITE(IFCH,*)TG
+        WRITE(IFCH,*)'PROJ_NEW,TARG_NEW,JPSI:'
+        WRITE(IFCH,*)(PROJ(N,2),N=1,4)
+        WRITE(IFCH,*)(TARG(N,2),N=1,4)
+        WRITE(IFCH,*)(PSTR(N,NSTR),N=1,4)
+        CALL UTMSGF
+16      CONTINUE
+      ENDIF
+
+      AMSAC=AMSAC+AM
+
+1000  RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE RACPRO(TYP,QMU,N,ACPROB)
+
+C-----------------------------------------------------------------------
+C  RETURNS THE ARRAY ACPROB CONTAINING ACCUMULATED PROB FOR:
+C    EXPONENTIAL OR POISSON DISTRIBUTION (FOR TYP = EXP OR POI)
+C    MULTI POMERON CUTS ACC TO GRIBOV (FOR TYP = GRI).
+C-----------------------------------------------------------------------
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /PARO3/   ASUHAX(7),ASUHAY(7),OMEGA,SIGPPD,SIGPPE,UENTRO
+     *                ,IWZZZZ
+      COMMON /PARO4/   GRICEL,GRIDEL,GRIGAM,GRIRSQ,GRISLO
+
+      DOUBLE PRECISION DENOM,FZ,FZH,Q,QZ,QZH,Z
+      REAL             ACPROB(N)
+      CHARACTER        TYP*3
+C-----------------------------------------------------------------------
+      ISH0=ISH
+      IF ( ISHSUB/100 .EQ. 17 ) ISH=MOD(ISHSUB,100)
+
+C  GRIBOV-REGGE
+C  ------------
+      IF     ( TYP .EQ. 'GRI' ) THEN
+        XI=LOG(ENGY**2)
+        AUXIL = EXP(XI*GRIDEL)*GRIGAM
+        SIG=8.*PI*AUXIL
+        Z=2.D0*GRICEL/(GRIRSQ+GRISLO*XI)*AUXIL
+
+C  0-CUT-POMERON PROBABILITY
+C  -------------------------
+        QZ=-1.D0/Z
+        QZH=-2.D0/Z
+        FZ=0.D0
+        FZH=0.D0
+        DO 10 I=1,20
+          DENOM=1.D0/I
+          QZ=(-Z)*DENOM*QZ
+          QZH=(-Z)*DENOM*0.5*QZH
+          FZ=DENOM*QZ+FZ
+          FZH=DENOM*QZH+FZH
+10      CONTINUE
+        RELER=ABS( QZ/(I*FZ) )
+        RELERH=ABS( QZH/(I*FZH) )
+        SIGPPZ=SIG*(FZH-FZ)
+        SIGPPE=SIGPPZ/GRICEL
+        SIGPPD=SIGPPE*(GRICEL-1)
+
+C  N-CUT-POMERON PROBABILITIES, N>0
+C  --------------------------------
+        AUXIL = EXP(-Z)
+        Q=1.
+        R=1.
+        ACPROB(1)=SIG/Z*(1.-AUXIL)
+        DO 21 I=2,N
+          Q=Q*Z/(I-1)
+          R=R+Q
+          SI=SIG/(I*Z)*(1.-R*AUXIL)
+          ACPROB(I)=ACPROB(I-1)+SI
+21      CONTINUE
+        IF ( SIGPPI .LT. 0. ) SIGPPI=ACPROB(N)
+        AUXIL2 = 1./ACPROB(N)
+        DO 22 I=1,N
+          ACPROB(I)=AUXIL2*ACPROB(I)
+22      CONTINUE
+
+C  WARNINGS
+C  --------
+        IF ( ISH.GE.90 ) THEN
+          IF ( RELER .GT. 1.E-3 ) THEN
+            CALL UTMSG('RACPRO')
+            WRITE(IFCH,*)'*****  RELER TOO LARGE'
+            WRITE(IFCH,*)'RELER,QZ/I,FZ:',RELER,QZ/I,FZ
+            CALL UTMSGF
+          ENDIF
+          IF ( RELERH .GT. 1.E-3 ) THEN
+            CALL UTMSG('RACPRO')
+            WRITE(IFCH,*)'*****  RELERH TOO LARGE'
+            WRITE(IFCH,*)'RELERH,QZH/I,FZH:',RELERH,QZH/I,FZH
+            CALL UTMSGF
+          ENDIF
+          IF ( SIGPPZ .LT. 0. ) THEN
+            CALL UTMSG('RACPRO')
+            WRITE(IFCH,*)'*****  NEGATIVE SIGPPZ'
+            WRITE(IFCH,*)'SIGPPZ,SIG,FZH,FZ:',SIGPPZ,SIG,FZH,FZ
+            CALL UTMSGF
+          ENDIF
+          DO 24 I=1,N
+            IF ( ACPROB(I) .LT. 0. ) THEN
+              CALL UTMSG('RACPRO')
+              WRITE(IFCH,*)'*****  NEGATIVE ACPROB(I)'
+              WRITE(IFCH,*)'I,ACPROB(I):',I,ACPROB(I)
+              CALL UTMSGF
+            ENDIF
+24        CONTINUE
+          RELERN=ACPROB(N)-ACPROB(N-1)
+          IF ( RELERN .GT. 1.E-3 ) THEN
+            CALL UTMSG('RACPRO')
+            WRITE(IFCH,*)'*****  RELERN TOO LARGE'
+            WRITE(IFCH,*)'RELERN:',RELERN
+            CALL UTMSGF
+          ENDIF
+        ENDIF
+
+C  PRINT
+C  -----
+        IF ( ISH .GE. 92 ) THEN
+100       FORMAT(1X,79A1)
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,100)('-',IC=1,79)
+          WRITE(IFCH,*)'   CROSS SECTIONS AND',
+     *      ' CUT-POMERON WEIGHTS ACC TO GRIBOV-REGGE-THEORY'
+          WRITE(IFCH,100)('-',IC=1,79)
+          WRITE(IFCH,*)'   CMS-ENERGY (GEV):',ENGY
+          WRITE(IFCH,100)('-',IC=1,79)
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,*)'   PARAMETERS: '
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,*)'     GAMMA: ',GRIGAM
+          WRITE(IFCH,*)'     R**2:  ',GRIRSQ
+          WRITE(IFCH,*)'     DELTA: ',GRIDEL
+          WRITE(IFCH,*)'     SLOPE: ',GRISLO
+          WRITE(IFCH,*)'     C:     ',GRICEL
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,*)'   CROSS SECTIONS:'
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,*)'     ELASTIC:     ',SIGPPE
+          WRITE(IFCH,*)'     DIFFRACTIVE: ',SIGPPD
+          WRITE(IFCH,*)'     INELASTIC:   ',SIGPPI
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,*)'   WEIGHTS W(N) OF N CUT POMERONS:'
+          WRITE(IFCH,*)'      ( N - W(N) - W(N)_EXP )'
+          WRITE(IFCH,*)' '
+          A=QMU/(QMU+1.)
+          I=1
+          WRITE(IFCH,*)I,ACPROB(I),(1-A)*A**(I-1)
+          DO 25 I=2,N
+            WRITE(IFCH,*)I,ACPROB(I)-ACPROB(I-1),(1-A)*A**(I-1)
+25        CONTINUE
+          WRITE(IFCH,*)' '
+        ENDIF
+
+C  POISSON
+C  -------
+      ELSEIF ( TYP .EQ. 'POI' ) THEN
+        Z=QMU
+        IF ( Z .GE. N-1. ) THEN
+          CALL UTSTOP('RACPRO: Z >= N-1.                       ')
+        ENDIF
+        K=MAX( 0.D0, Z-(N-1-Z) )+1.
+        IF ( K .GE. N ) THEN
+          CALL UTSTOP('RACPRO: K >= N.                         ')
+        ENDIF
+        IF     ( K .EQ. 1 ) THEN
+          PRBAB=EXP(-Z)
+          ACPROB(1)=PRBAB
+          DO 1 I=2,N
+            PRBAB=PRBAB*Z/(I-1)
+            ACPROB(I)=ACPROB(I-1)+PRBAB
+1         CONTINUE
+        ELSEIF ( K .GT. 1 ) THEN
+          X=Z*EXP(-Z/(K-1.))
+          PRBAB=1.
+          DO 3 I=1,K-1
+            PRBAB=PRBAB*X/I
+            ACPROB(I)=0.
+3         CONTINUE
+          ACPROB(K)=PRBAB
+          DO 4 I=K+1,N
+            PRBAB=PRBAB*Z/(I-1)
+            ACPROB(I)=ACPROB(I-1)+PRBAB
+4         CONTINUE
+        ELSE
+          CALL UTSTOP('RACPRO: K <= 0.                         ')
+        ENDIF
+
+C  EXPONENTIAL
+C  -----------
+      ELSEIF ( TYP .EQ. 'EXP' ) THEN
+        A=QMU/(QMU+1.)
+        PRBAB=1.-A
+        ACPROB(1)=PRBAB
+        DO 2 I=2,N
+          PRBAB=PRBAB*A
+          ACPROB(I)=ACPROB(I-1)+PRBAB
+2       CONTINUE
+      ENDIF
+
+      ISH=ISH0
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION RANSTC(XFL,XMIN)
+
+C-----------------------------------------------------------------------
+C  RETURNS RANDOM NUMBER ACCORDING TO A QUARK STRUCTURE FCTN
+C  WITH X>=XMIN
+C
+C  CHANGES  : D. HECK    IK3  KFK KARLSRUHE
+C  DATE     : MAR  22, 1994
+C-----------------------------------------------------------------------
+      PARAMETER (NSTRU=2049)
+      COMMON /CIPIO/   IPIO
+      COMMON /CUTINV/  LUTINV
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /STRU/    QSEP(NSTRU),QSET(NSTRU),QVAP(NSTRU)
+     *                ,QVAT(NSTRU),XCUTAR,XSTRU(NSTRU)
+     *                ,IDTG
+      COMMON /STRU2/   DELTA0,DELTA1,QSEH(NSTRU),QSEPI(NSTRU)
+     *                ,QVAH(NSTRU),QVAPI(NSTRU),XSE(NSTRU),XVA(NSTRU)
+      CHARACTER XFL*3
+C ----------------------------------------------------------------------
+      NSTRUC = NSTRU
+      IF     ( XFL .EQ. 'SEP' ) THEN
+        RANSTC=RANXQ(NSTRUC,XSE  ,QSEP,XMIN)
+      ELSEIF ( XFL .EQ. 'SET' ) THEN
+        RANSTC=RANXQ(NSTRUC,XSE  ,QSET,XMIN)
+      ELSEIF ( XFL .EQ. 'VAP' ) THEN
+        RANSTC=RANXQ(NSTRUC,XVA  ,QVAP,XMIN)
+      ELSEIF ( XFL .EQ. 'VAT' ) THEN
+        RANSTC=RANXQ(NSTRUC,XVA  ,QVAT,XMIN)
+      ENDIF
+1     RETURN
+      END
+C=======================================================================
+
+      FUNCTION RANXQ(N,X,Q,XMIN)
+
+C-----------------------------------------------------------------------
+C  RETURNS RANDOM NUMBER ACCORDING TO X(I) Q(I) WITH X>=XMIN
+C-----------------------------------------------------------------------
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      REAL X(N),Q(N)
+      REAL XMIN,QRAN
+C-----------------------------------------------------------------------
+      IMIN=1
+      IF ( XMIN .EQ. 0. ) GOTO 3
+      I1=1
+      I2=N
+ 1    I=I1+(I2-I1)/2
+      IF     ( X(I) .LT. XMIN ) THEN
+        I1=I
+      ELSEIF ( X(I) .GT. XMIN ) THEN
+        I2=I
+      ELSE
+        IMIN=I
+        GOTO 3
+      ENDIF
+      IF ( I2-I1 .GT. 1 ) GOTO 1
+      IMIN=I2
+ 3    CONTINUE
+      IF ( Q(IMIN) .GT. Q(N)*.9999 ) THEN
+        RANXQ=XMIN
+        GOTO 4
+      ENDIF
+      QRAN=Q(IMIN)+RANGEN()*(Q(N)-Q(IMIN))
+      RANXQ=UTINVT(N,X,Q,QRAN)
+ 4    CONTINUE
+      IF ( RANXQ .LT. XMIN ) THEN
+        IF(ISH.GE.90)THEN
+          CALL UTMSG('RANXQ ')
+          WRITE(IFCH,*)'*****  RANXQ=',RANXQ,' <       XMIN=',XMIN
+          WRITE(IFCH,*)'Q(IMIN) Q Q(N):',Q(IMIN),QRAN,Q(N)
+          WRITE(IFCH,*)'X(IMIN) X X(N):',X(IMIN),RANXQ,X(N)
+          CALL UTMSGF
+        ENDIF
+        RANXQ=XMIN
+      ENDIF
+      IF ( ISH .GT. 91 ) THEN
+        WRITE(IFCH,*)'RANXQ:'
+        WRITE(IFCH,*)'   Q(IMIN) Q Q(N):',Q(IMIN),QRAN,Q(N)
+        WRITE(IFCH,*)'   X(IMIN) X X(N):',X(IMIN),RANXQ,X(N)
+      ENDIF
+
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION SBET(Z,W)
+
+C-----------------------------------------------------------------------
+      SBET=SGAM(Z)*SGAM(W)/SGAM(Z+W)
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION SDENSI(R)
+
+C-----------------------------------------------------------------------
+C  NUCLEAR DENSITY
+C-----------------------------------------------------------------------
+      COMMON /CDEN/   MASSNR,RMX,R0
+C  AI IS INVERSE OF A=0.54
+      REAL AI
+      DATA AI/1.85185185/
+C-----------------------------------------------------------------------
+      SDENSI=R**2 / ( 1. + EXP((R-R0)*AI) )
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION SGAM(X)
+
+C-----------------------------------------------------------------------
+C  GAMMA FUNCTION
+C-----------------------------------------------------------------------
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      DOUBLE PRECISION GC(13),GF,GP,GX,GY,GZ
+      DATA GC/
+     *  0.000539698958808D0, 0.002619307282746D0, 0.020449630823590D0,
+     *  0.073094836414370D0, 0.279643691578538D0, 0.553387692385769D0,
+     *  0.999999999999998D0,-0.000832724708684D0, 0.004698658079622D0,
+     *  0.022523834747260D0,-0.170447932874746D0,-0.056810335086194D0,
+     *  1.130603357286556D0/
+      DATA GP / 3.141592653589793D0 /
+C-----------------------------------------------------------------------
+      GF = 0.D0
+      GX = DBLE(X)
+      GZ = GX
+      IF ( GX .GT. 0.D0 ) GOTO 1
+      IF ( GX .EQ. DINT(GX) ) THEN
+        WRITE(IFCH,'('' ARGUMENT OF GAMMA FUNCTION ='',E20.5)') X
+        CALL UTSTOP('SGAM : NEGATIVE INTEGER ARGUMENT        ')
+         GOTO 5
+      ENDIF
+      GZ = 1.D0 - GZ
+ 1    CONTINUE
+      GY = 1.D0 / GZ
+      IF ( GZ .LE. 1.D0 ) GOTO 4
+      GY = 1.D0
+ 2    CONTINUE
+      IF ( GZ .LT. 2.D0 ) GOTO 3
+      GZ = GZ - 1.D0
+      GY = GY * GZ
+      GOTO 2
+ 3    CONTINUE
+      GZ = GZ - 1.D0
+ 4    CONTINUE
+      GF = GY * ((((((GC(1)*GZ+GC(2))*GZ+GC(3))*GZ+GC(4))*GZ+
+     *       GC(5))*GZ+GC(6))*GZ+GC(7))/((((((GC(8)*GZ+GC(9))*GZ+
+     *       GC(10))*GZ+GC(11))*GZ+GC(12))*GZ+GC(13))*GZ+1.D0)
+      IF ( GX .LE. 0.D0 ) GF = GP / ( SIN(GP*GX) * GF )
+ 5    CONTINUE
+      SGAM = GF
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION SGAU(X)
+
+C-----------------------------------------------------------------------
+C  RETURNS GAUSSIAN DISTRIBUTION (NOT NORMALIZED)
+C-----------------------------------------------------------------------
+      SGAU=EXP(-0.5*X**2)
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE SHOPAR
+
+C-----------------------------------------------------------------------
+      DOUBLE PRECISION SEEDC,SEEDI
+      COMMON /CSEED/   SEEDC,SEEDI
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /PARO3/   ASUHAX(7),ASUHAY(7),OMEGA,SIGPPD,SIGPPE,UENTRO
+     *                ,IWZZZZ
+      COMMON /PARO4/   GRICEL,GRIDEL,GRIGAM,GRIRSQ,GRISLO
+      COMMON /PARO5/   DELEPS,DELVOL
+      COMMON /QUARKM/  SMAS,SSMAS,USMAS,UUMAS
+C-----------------------------------------------------------------------
+      IF ( ISUP .NE. 1  .AND.  ISH .GE. 90 ) THEN
+        WRITE(IFMT,102)('*',I=1,69)
+     *    ,TAUNLL,MAXRES,PTF,PTQ,IOPTQ,PTMX,NEQMN,IAQU,WTARG
+     *    ,WPROJ,QMUST,SIGPPI,CORE,FCTRMX,NCOLMX,LABSYS,IRESCL,OVERLP
+     *    ,NTRYMX,DELMSS,SEEDI,GAUMX,BMAXIM,PUD,PSPINL,PSPINH,PISPN
+     *    ,NCLEAN,JPSI,CUTMSS,RSTRAS,ISTMAX,TENSN,NEQMX,IPAGI,NDECAY
+     *    ,PDIQUA,PAREA,DELREM,TAUMX,NSTTAU,SIGJ,JPSIFI,BMINIM
+     *    ,RADIAC,TAUMIN,TAUMAX,NUMTAU,THEMAS,AMSIAC,ELEPTI
+102     FORMAT(' ',69A1
+     */' *  TAUNLL=',F7.3,'  MAXRES=',I7,'  PTF   =',F7.3
+     *,'  PTQ   =',F7.3,'   *'/' *  IOPTQ =',I7,'  PTMX  =',F7.3
+     *,'  NEQMN =',I7,'  IAQU  =',I7,'   *'/' *  WTARG =',F7.3
+     *,'  WPROJ =',F7.3,'  QMUST =',F7.3,'  SIGPPI=',F7.3,'   *'
+     */' *  CORE  =',F7.3,'  FCTRMX=',F7.3,'  NCOLMX=',I7
+     *,'  LABSYS=',  I7,'   *'/' *  IRESCL=',I7,'  OVERLP=',F7.3
+     *,'  NTRYMX=',I7,'  DELMSS=',F7.3,'   *'/' *  SEEDI=',D24.17
+     *,'  GAUMX =',F7.3,'  BMAXIM=',F7.1,'   *'/' *  PUD   =',F7.3
+     *,'  PSPINL=',F7.3,'  PSPINH=',F7.3,'  PISPN =',F7.3,'   *'
+     */' *  NCLEAN=',I7,'  JPSI  =',I7,'  CUTMSS=',F7.3
+     *,'  RSTRAS=',F7.3,'   *'/' *  ISTMAX=',I7,'  TENSN =',F7.3
+     *,'  NEQMX =',I7,'  IPAGI =',I7,'   *'/' *  NDECAY=',I7
+     *,'  PDIQUA=',F7.3,'  PAREA =',F7.3,'  DELREM=',F7.3,'   *'
+     */' *  TAUMX =',F7.3,'  NSTTAU=',I7,'  SIGJ  =',F7.3
+     *,'  JPSIFI=',I7,'   *'/' *  BMINIM=',F7.1,'  RADIAC=',F7.3
+     *,'  TAUMIN=',F7.3,'  TAUMAX=',F7.3,'   *'/' *  NUMTAU=',I7
+     *,'  THEMAS=',F7.3,'  AMSIAC=',F7.3,'  ELEPTI=',F7.3,'   *')
+        WRITE(IFMT,108)
+     *    ELEPTO,ANGMUE,SMAS,UUMAS,USMAS,SSMAS,IOPBRK,NDECAW
+     *   ,IMIHIS,KENTRO,RADIAS,ISPHIS,RHOPHI,ICLHIS,ISHSUB,IOPENU
+     *   ,IOPENT,CUTMSQ,KUTDIQ,IDPM,TAUREA,ISPALL,YMXIMI,PTH,PHARD
+     *   ,IOPTF,PROSEA,NDECAX,WTMINI,WTSTEP,IWCENT,ISHEVT,PVALEN
+     *   ,IFRADE,IENTRO,GRIGAM,GRIRSQ,GRIDEL,GRISLO,GRICEL,IJPHIS
+     *   ,UENTRO,IWZZZZ,IOJINT,AMPRIF,DELVOL,DELEPS
+     *   ,('*',I=1,69)
+108     FORMAT(
+     * ' *  ELEPTO=',F7.3,'  ANGMUE=',F7.3,'  SMAS  =',F7.3
+     *,'  UUMAS =',F7.3,'   *'/' *  USMAS =',F7.3,'  SSMAS =',F7.3
+     *,'  IOPBRK=',I7,'  NDECAW=',I7  ,'   *'/' *  IMIHIS=',I7
+     *,'  KENTRO=',I7,'  RADIAS=',F7.3,'  ISPHIS=',I7  ,'   *'
+     */' *  RHOPHI=',F7.3,'  ICLHIS=',I7  ,'  ISHSUB=',I7
+     *,'  IOPENU=',I7  ,'   *'/' *  IOPENT=',I7,'  CUTMSQ=',F7.3
+     *,'  KUTDIQ=',I7  ,'  IDPM  =',I7  ,'   *'/' *  TAUREA=',F7.3
+     *,'  ISPALL=',I7  ,'  YMXIMI=',F7.3,'  PTH   =',F7.3,'   *'
+     */' *  PHARD =',F7.3,'  IOPTF =',I7  ,'  PROSEA=',F7.3
+     *,'  NDECAX=',I7  ,'   *'/' *  WTMINI=',F7.3,'  WTSTEP=',F7.3
+     *,'  IWCENT=',I7  ,'  ISHEVT=',I7  ,'   *'/' *  PVALEN=',F7.3
+     *,'  IFRADE=',I7  ,'  IENTRO=',I7  ,'  GRIGAM=',F7.3,'   *'
+     */' *  GRIRSQ=',F7.3,'  GRIDEL=',F7.3,'  GRISLO=',F7.3
+     *,'  GRICEL=',F7.3,'   *'/' *  IJPHIS=',I7  ,'  UENTRO=',F7.3
+     *,'  IWZZZZ=',I7  ,'  IOJINT=',I7  ,'   *'/' *  AMPRIF=',F7.3
+     *,'  DELVOL=',F7.3,'  DELEPS=',F7.3,'         ',7X  ,'   *'
+     */' ',69A1)
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION SJCENT(K,KU,U)
+
+C----------------------------------------------------------------------
+C  RETURNS ENTROPY.
+C  INPUT: QUARK NUMBER K; ENERGY U (GEV).
+C  IOPENT=1: OSCILLATOR MODEL.
+C    INTERPOLATES AND EXTRAPOLATES ENTRO(1+K,1+N)
+C    FROM SR JCENTR (JCENTD).
+C    SR JCENTR (JCENTD) HAS TO BE CALLED BEFORE!!
+C  IOPENT=2,3: FERMI GAS MODEL; JOERG  AICHELIN.
+C    IOPENT=2: CONST VOLUME, IOPENT=3: CONST DENSITY
+C  IOPENT=4: FERMI GAS (NEW)
+C  IOPENT=5: HAGEDORN
+C----------------------------------------------------------------------
+      PARAMETER (KPARX=15)
+      PARAMETER (NQUAX=12)
+      COMMON /CENTRO/  ENTRO(1+KPARX,1+NQUAX)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /PARO3/   ASUHAX(7),ASUHAY(7),OMEGA,SIGPPD,SIGPPE,UENTRO
+     *                ,IWZZZZ
+C----------------------------------------------------------------------
+      SJCENT=0.
+      IF     ( IOPENT .EQ. 0 ) THEN
+        RETURN
+
+      ELSEIF ( IOPENT .EQ. 1 ) THEN
+        IF ( K .LE. KENTRO ) RETURN
+        IF ( MOD(K,3) .NE. 0 ) THEN
+          CALL UTSTOP('SJCENT: K MUST BE MULTIPLE OF 3         ')
+        ENDIF
+        E=U/OMEGA
+        IF ( K .GT. KPARX ) GOTO 5001
+        N=INT(E)
+        IF ( N .LT. 0 ) THEN
+          CALL UTSTOP('SJCENT: NEGATIVE ENERGY                 ')
+        ENDIF
+        IF ( N .GE. NQUAX ) N=NQUAX-1
+        SJCENT=ENTRO(1+K,1+N)+(E-N)*(ENTRO(1+K,1+N+1)-ENTRO(1+K,1+N))
+        IF ( K .LE. 3 ) RETURN
+5002    E3=E*3./K
+        N3=INT(E3)
+        IF ( N3 .GE. NQUAX ) N3=NQUAX-1
+        SENTR3=ENTRO(1+3,1+N3)+(E3-N3)
+     *                              *(ENTRO(1+3,1+N3+1)-ENTRO(1+3,1+N3))
+        SJCENT=MIN(SJCENT,K/3.*SENTR3)
+        RETURN
+5001    CONTINUE
+        L=KPARX
+        EL=(E*L)/K
+        NL=INT(EL)
+        IF ( NL .GE. NQUAX ) NL=NQUAX-1
+        SENTRL=ENTRO(1+L,1+NL)+(EL-NL)
+     *                              *(ENTRO(1+L,1+NL+1)-ENTRO(1+L,1+NL))
+        SJCENT=FLOAT(K)/L*SENTRL
+        GOTO 5002
+
+      ELSEIF ( IOPENT .EQ. 2 ) THEN
+C  CONSTANT VOLUME 5 FM**3
+        IF ( K .LE. KENTRO ) RETURN
+        X1=12.96*K**(-.315)
+        IF ( K .LT. 19 ) THEN
+          X2=.785 + .005*K
+        ELSE
+          X2=.88
+        ENDIF
+        SJCENT=K*X1*(U/K)**X2
+        RETURN
+
+      ELSEIF ( IOPENT .EQ. 3 ) THEN
+C  CONSTANT DENSITY
+        IF ( K .LE. KENTRO ) RETURN
+        X1=9.785
+        X2=.7926
+        SJCENT=K*X1*(U/K)**X2
+        RETURN
+
+      ELSEIF ( IOPENT .EQ. 4 ) THEN
+C  CONSTANT VOLUME 15 FM**3
+        IF ( K .LE. KENTRO ) RETURN
+        SJCENT=SJCEN4(K,KU,U)
+        RETURN
+
+      ELSEIF ( IOPENT .EQ. 5 ) THEN
+C  HAGEDORN
+        IF ( U .LE. UENTRO  .AND.  K .LE. KENTRO ) THEN
+          RETURN
+        ENDIF
+CDH     THAGED=.250
+CDH     SJCENT = U/THAGED
+        SJCENT = U*4.
+
+      ELSE
+        CALL UTSTOP('SJCENT: INVALID OPTION IOPENT           ')
+      ENDIF
+
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION SJCEN4(K,KU,U)
+
+C----------------------------------------------------------------------
+C  RETURNS TOTAL ENTROPY.
+C  CONSTANT VOLUME 15 FM**3.
+C  INPUT: TOTAL QUARK NUMBER K; UP AND DOWN QUARKS KU;
+C  TOTAL EXCITATION ENERGY U(GEV).
+C  INITIAL CALL OF SJCEN0 REQUIRED!!!
+C----------------------------------------------------------------------
+      COMMON /CSJCEN/  ENT(16000)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+C----------------------------------------------------------------------
+      SJCEN4 = 0.
+
+      IF ( K .LT. KU ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('SJCEN4')
+          WRITE(IFCH,*)'*****  K < KU'
+          WRITE(IFCH,*)'*****  K: ',K,'   KU: ',KU
+          CALL UTMSGF
+        ENDIF
+        RETURN
+      ENDIF
+
+      IF ( K .GT. 45 ) THEN
+        KO=K
+        K=45
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('SJCEN4')
+          WRITE(IFCH,*)'*****  K > 45'
+          WRITE(IFCH,*)'*****  K: ',KO,'   K_NEW: ',K
+          CALL UTMSGF
+        ENDIF
+      ENDIF
+
+      IF ( MOD(K,3) .NE. 0 ) THEN
+        CALL UTSTOP('SJCEN4: NONINTEGER BARYON NUMBER        ')
+      ENDIF
+
+      IK=0
+      DO 1 I=3,K-3,3
+        IK=IK+I+1
+ 1    CONTINUE
+      IF ( U .LT. 10. ) THEN
+        DU=MOD(U,.25)
+        IU=INT(U/.25)+1
+        IENTRY=(IK+KU)*41+IU
+        SJCEN4=ENT(IENTRY)+(ENT(IENTRY+1)-ENT(IENTRY))*DU*4.
+      ELSE
+        IU=40
+        IENTRY=(IK+KU)*41+IU
+        SJCEN4=ENT(IENTRY)+(ENT(IENTRY+1)-ENT(IENTRY))*4.*(U-9.75)
+      ENDIF
+
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION SJCGAM(KEUX,KEDX,KESX,KECX,AMA,AMO,PO,MOX)
+
+C----------------------------------------------------------------------
+C  RETURNS PARTIAL DECAY WIDTH DGAMMA = PHASE SPACE * DENSITY
+C    FOR DECAY OF CLUSTER INTO CLUSTER AND HADRON.
+C  KE*X: NET QUARK NUMBER
+C  AMA: CLUSTER MASS;  AMO: HADRON MASS;  PO: HADRON MOMENTUM
+C----------------------------------------------------------------------
+      COMMON /CENTEX/  ENTEXP
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CSJCGA/  AMEGAM,AMNULL,ASUHA(7),ENTRPY,NOPHA,NSUHA(7)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO3/   ASUHAX(7),ASUHAY(7),OMEGA,SIGPPD,SIGPPE,UENTRO
+     *                ,IWZZZZ
+C----------------------------------------------------------------------
+      ENTRPY=-99.9
+      IF ( MOX .EQ. 1 ) THEN
+        ENTEXP=0.
+        AMNULL=UTAMNU(KEUX,KEDX,KESX,KECX,IOPENU)
+      ELSE
+        ENTRPY=ENTRPY-ENTEXP
+      ENDIF
+      EO=SQRT(AMO**2+PO**2)
+      IF ( EO .GT. AMA ) GOTO 999
+      AME2=(AMA-EO)**2-PO**2
+      IF ( AME2 .LT. 0. ) GOTO 999
+      AMEGAM=SQRT(AME2)
+      E=AMEGAM-AMNULL
+      IF ( E .LT. 0. ) GOTO 998
+      KE=ABS(KEUX+KEDX+KESX+KECX)
+
+      IF ( IOPENT .EQ. 5 ) THEN
+        IF ( E .LE. UENTRO  .AND.  KE .LE. KENTRO ) THEN
+          ENTRPY=0.
+        ELSE
+C  ENTROPY AFTER HAGEDORN
+          ENTRPY = E*4.
+        ENDIF
+      ELSE
+        KU=ABS(KEUX+KEDX)
+        ENTRPY=SJCENT(KE,KU,E)
+      ENDIF
+
+      IF ( MOX .EQ. 1 ) THEN
+        ENTEXP=ENTRPY
+        ENTRPY=0.
+        SJCGAM=.125* PO**2/( PI**2*AMA*EO )
+      ELSE
+        ENTRPY=ENTRPY-ENTEXP
+        SJCGAM=.125*EXP(ENTRPY)* PO**2/( PI**2*AMA*EO )
+      ENDIF
+      RETURN
+ 999  AMEGAM = 0.
+ 998  SJCGAM= 0.
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION SMASS(A,Y,Z)
+
+C-----------------------------------------------------------------------
+C  RETURNS CLUSTER MASS (IN GEV) (PER CLUSTER, NOT (!) PER NUCLEON)
+C  ACCORDING TO BERGER/JAFFE MASS FORMULA, PRC35(1987)213 EQ.2.31,
+C  SEE ALSO C. DOVER, BNL-46322, INTERSECTIONS-MEETING, TUCSON, 91.
+C  A: MASSNR, Y: HYPERCHARGE, Z: CHARGE,
+C-----------------------------------------------------------------------
+      COMMON /CMASS/   AC,AS,CZ,DY,DZ,EPSI,RZERO,SIGMA,THET,YM,ZM
+C-----------------------------------------------------------------------
+      YMIN=YM*A
+      ZMIN=CZ/(DZ/A+ZM/A**.3333333)
+      SMASS=EPSI*A +AS*A**.6666667
+     *             +(AC/A**.3333333 +DZ/A*0.5)*(Z-ZMIN)**2
+     *              +DY/A*0.5*(Y-YMIN)**2
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE SMASSI(THETA)
+
+C-----------------------------------------------------------------------
+C  INITIALIZATION FOR SMASS.
+C  CALCULATES PARAMETERS FOR BERGER/JAFFE MASS FORMULA
+C  (PRC35(1987)213 EQ.2.31, SEE ALSO C. DOVER, BNL-46322).
+C  THETA: PARAMETER THAT DETERMINES ALL PARAMETERS IN MASS FORMULA.
+C-----------------------------------------------------------------------
+      COMMON /CMASS/   AC,AS,CZ,DY,DZ,EPSI,RZERO,SIGMA,THET,YM,ZM
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      DATA ALP /0.007297145/
+C-----------------------------------------------------------------------
+      THET=THETA
+
+      ASTR=.150
+
+      CO=COS(THETA)
+      SI=SIN(THETA)
+      BET=(1.+CO**3)*0.5
+      RZERO=SI/ASTR/(0.6666667/PI*(1.+CO**3)  )**0.3333333
+      CS=ASTR/SI
+      CZ=CS*(1.-BET**0.3333333 )
+      SIGMA=0.75/PI*(ASTR/SI)**3*0.3333333*(CO**2*0.5 -SI**2*(1-SI)
+     *    -1./PI*(PI*0.5-THETA-SIN(2*THETA)+SI**3*LOG((1+CO)/SI) ) )
+
+      EPSI=ASTR*(BET**0.3333333+2.)/SI
+      AS=4.*PI*SIGMA*RZERO**2
+      AC=0.6*ALP/RZERO
+      DZ=ASTR/SI*BET**0.3333333 *CO**2 *
+     *  (CO**4*(1.+BET**0.3333333)+(1+BET)**2)/
+     *( (2.*CO**2+BET**.3333333)*(CO**4*(1+BET**.6666667)+(1.+BET)**2)-
+     *        (CO**4+BET**0.3333333*(1+BET))
+     *                     *( (2.*BET**0.6666667-1.)*CO**2+1.+BET) )
+      DY=ASTR/6.*(1.+CO**3)**3/SI*
+     *       (  1.+(1.+CO)/(4.*(1.+CO**3))**0.6666667  )/
+     *       ( CO**6 + CO + CO*(.5*(1+CO**3))**1.333333 )
+      ZM=6.*ALP/(5.*RZERO)
+      YM=(1.-CO**3)/(1.+CO**3)
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE SMASSP
+
+C-----------------------------------------------------------------------
+C  PRINTS SMASS.
+C-----------------------------------------------------------------------
+      COMMON /CMASS/   AC,AS,CZ,DY,DZ,EPSI,RZERO,SIGMA,THET,YM,ZM
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      REAL ENG(14),YMI(14),ZMI(14)
+C-----------------------------------------------------------------------
+      WRITE(IFCH,*)'PARAMETERS OF MASS FORMULA:'
+      WRITE(IFCH,*)'---------------------------'
+      WRITE(IFCH,*)' '
+      WRITE(IFCH,*)'THETA=',THET,'   EPSI=',EPSI
+      WRITE(IFCH,*)'AS=',AS,'   AC=',AC
+      WRITE(IFCH,*)'DY=',DY,'   DZ=',DZ
+      WRITE(IFCH,*)'YM=',YM
+      WRITE(IFCH,*)'CZ DZ ZM=',CZ,DZ,ZM
+      WRITE(IFCH,*)'SIGMA**1/3=',SIGMA**(1./3.),'   RZERO=',RZERO
+      WRITE(IFCH,*)' '
+      WRITE(IFCH,*)'MASS:'
+      WRITE(IFCH,*)'-----'
+      WRITE(IFCH,5000)(J,J=1,14)
+5000  FORMAT(/5X,'A:',14I5/)
+      DO 4 J=1,14
+        A=J
+        YMI(J)=YM*A
+        ZMI(J)=CZ/(DZ/A+ZM/A**0.3333333)
+ 4    CONTINUE
+      WRITE(IFCH,5002)(YMI(J),J=1,14)
+5002  FORMAT(1X,'YMIN: ',14F5.2/)
+      WRITE(IFCH,5003)(ZMI(J),J=1,14)
+5003  FORMAT(1X,'ZMIN: ',14F5.2/)
+      DO 2 I=1,15
+        NS=11-I
+        DO 3 J=1,14
+          A=J
+          Y=A-NS
+          Z=0.
+          ENG(J)=SMASS(A,Y,Z)/A
+ 3      CONTINUE
+        WRITE(IFCH,5001)NS,(ENG(J),J=1,14)
+5001    FORMAT(1X,'S=',I2,2X,14F5.2)
+ 2    CONTINUE
+      WRITE(IFCH,*)' '
+      WRITE(IFCH,*)'MASS-MASS(FREE):'
+      WRITE(IFCH,*)'----------------'
+      WRITE(IFCH,5000)(J,J=1,14)
+      DO 5 I=1,15
+        NS=11-I
+        DO 6 J=1,14
+          A=J
+          Y=A-NS
+          Z=0.
+          SG=SIGN(1.,A)
+          AX=SG*A
+          YX=SG*Y
+          ZX=SG*Z
+          KU=NINT(AX+ZX)
+          KD=NINT(AX-ZX+YX)
+          KS=NINT(AX-YX)
+          KC=0
+          ENG(J)=(SMASS(A,Y,Z)-UTAMNU(KU,KD,KS,KC,3))/A
+ 6      CONTINUE
+        WRITE(IFCH,5001)NS,(ENG(J),J=1,14)
+5     CONTINUE
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE SMASST(KUX,KDX,KSX,KCX,A,Y,Z)
+
+C-----------------------------------------------------------------------
+C  INPUT: KUX,KDX,KSX,KCX = NET QUARK NUMBERS (FOR U,D,S,C QUARKS).
+C  OUTPUT: MASSNR A, HYPERCHARGE Y AND CHARGE Z.
+C-----------------------------------------------------------------------
+      SG=1.
+      IF ( KUX+KDX+KSX+KCX .LT. 0 ) SG=-1.
+      KU=SG*KUX
+      KD=SG*KDX
+      KS=SG*KSX
+      KC=SG*KCX
+      K=KU+KD+KS+KC
+      IF ( MOD(K,3) .NE. 0 ) THEN
+        CALL UTSTOP('SMASST: NONINTEGER BARYON NUMBER        ')
+      ENDIF
+      A=K/3
+      Y=A-KS
+      NZ=2*KU-KD-KS+2*KC
+      IF ( MOD(NZ,3) .NE. 0 ) THEN
+        CALL UTSTOP('SMASST: NONINTEGER CHARGE               ')
+      ENDIF
+      Z=NZ/3
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION SPTF(X)
+
+C-----------------------------------------------------------------------
+C  RETURNS PT-DISTRIBUTION FOR FRAGMENTATION
+C-----------------------------------------------------------------------
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CQUAMA/  QUAMA
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+C-----------------------------------------------------------------------
+      IF     ( IOPTF .EQ. 1 ) THEN
+        SPTF = X * EXP(-2./PTF*SQRT(X**2+QUAMA**2))
+      ELSEIF ( IOPTF .EQ. 2 ) THEN
+        SPTF = X * EXP(-PI*0.25*(X**2+QUAMA**2)/PTF**2)
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION SPTH(X)
+
+C-----------------------------------------------------------------------
+C  RETURNS PT-DISTRIBUTION FOR HARD SCATTERING
+C-----------------------------------------------------------------------
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+C-----------------------------------------------------------------------
+      SPTH=PTH**2*2.*X/(X**2+PTH**2)**3
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION SPTJ(X)
+
+C-----------------------------------------------------------------------
+C  JPSI PT-DISTRIBUTION IN 200 GEV PP
+C-----------------------------------------------------------------------
+      DATA AI/1.052631579/, C/2.75482/, C1/1.75482/, CC/16.30716419/
+C  AI IS THE INVERSE OF A
+C-----------------------------------------------------------------------
+CDH   A=0.95
+CDH   C=1./0.363
+CDH   Z=X/A
+      Z=X*AI
+CDH   SPTJ=1./A*C**C/SGAM(C)*Z**(C-1.)*EXP(-C*Z)
+      SPTJ = AI * CC * 0.619299158 * Z**C1 * EXP(-C*Z)
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION SPTQ(X)
+
+C-----------------------------------------------------------------------
+C  RETURNS PT-DISTRIBUTION OF QUARKS IN NUCLEONS
+C-----------------------------------------------------------------------
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+C-----------------------------------------------------------------------
+      IF     ( IOPTQ .EQ. 2 ) THEN
+        AUXIL2 = PI/PTQ**2
+        SPTQ=(0.5*X)* AUXIL2 * EXP(-(0.5*X)**2*AUXIL2)
+      ELSEIF ( IOPTQ .EQ. 1 ) THEN
+        AUXIL1 = 2./PTQ
+        SPTQ=AUXIL1**2 * X * EXP(-X*AUXIL1)
+      ELSEIF ( IOPTQ .EQ. 3 ) THEN
+        SPTQ=PTQ**2 * 2. * X / (X**2+PTQ**2)**2
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      DOUBLE PRECISION FUNCTION SSE0(Z)
+
+C-----------------------------------------------------------------------
+C  SEA QUARK STRUCTURE FUNCTION FOR HADRONS
+C-----------------------------------------------------------------------
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      DOUBLE PRECISION Z
+C-----------------------------------------------------------------------
+      SSE0 = (1.D0-Z)**8.05D0 * 1.265D0 / SQRT(Z**2+XCUT**2)
+      RETURN
+      END
+C=======================================================================
+
+      DOUBLE PRECISION FUNCTION SSE1(Z)
+
+C-----------------------------------------------------------------------
+C  SEA QUARK STRUCTURE FUNCTION FOR PIONS
+C-----------------------------------------------------------------------
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      DOUBLE PRECISION Z
+C-----------------------------------------------------------------------
+      SSE1 = (1.D0-Z)**5.D0 * 0.9D0 / SQRT(Z**2+XCUT**2)
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION SSPLIT(X)
+
+C-----------------------------------------------------------------------
+C  RETURNS SPLITTING FUNCTION
+C-----------------------------------------------------------------------
+C-C   SSPLIT= ( 0.3 + 10.0*X**7 - 10.3*X**15 ) /SQRT(X**2+.2**2)
+C-C   SSPLIT=   0.2 +  2.4*X**2 -  2.6*X**5
+C-C   SSPLIT=   0.4 +  2.0*X    -  2.4*X**3
+C-C   SSPLIT= ( 0.8 +  2.0*X    -  2.8*X**3  ) /SQRT(X**2+.2**2)
+      SSPLIT= X**3 - X**5
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION SSPLIX(X)
+
+C-----------------------------------------------------------------------
+C  RETURNS SPLITTING FUNCTION
+C-----------------------------------------------------------------------
+C-C   SSPLIX= (1-X) - (1-X)**7
+C-C   SSPLIX= 1
+C-C   Z=2*X-.5
+C-C   SSPLIX= Z**3 - Z**5
+C-C   IF ( Z .LT. 0. ) SSPLIX=0.
+C-C   IF ( Z .GT. 1. ) SSPLIX=0.
+      SSPLIX= X**3 - X**5
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE STAA(X,Q2I,Z,S)
+
+C-----------------------------------------------------------------------
+C  STRUCTURE FUNCTIONS.
+C-----------------------------------------------------------------------
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+C-----------------------------------------------------------------------
+      Z=SQRT(X**2+XCUT**2)
+      Q2=MAX(4.00001,Q2I)
+CDH   S=LOG(LOG(Q2/.2**2)/LOG(4/.2**2))
+      S=LOG(LOG(Q2*25.  )*0.21714724)
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION STXD(X,Q2)
+
+C-----------------------------------------------------------------------
+C  VALENCE D-QUARK DISTRIBUTION.
+C  FROM GLUECK, HOFFMANN, REYA, Z. PHYS. C13 (1982) 119.
+C-----------------------------------------------------------------------
+      CALL STAA(X,Q2,Z,S)
+      A=.364-.0368*S
+      C=2.-.5414*S**.8
+      D=5.09+.3463*S
+      STXD=C*X**A*(1.-X**C)**D/SBET(D+1.,A/C)
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION STXS(X,Q2)
+
+C-----------------------------------------------------------------------
+C  S-SEA DISTRIBUTION.
+C  FROM GLUECK, HOFFMANN, REYA, Z. PHYS. C13 (1982) 119.
+C-----------------------------------------------------------------------
+      CALL STAA(X,Q2,Z,S)
+      A=.0625+.1132*S**1.3
+      B=12.64*S-51.70*S**1.8+38.02*S**2
+      C=4.448*S
+      D=7.+1.562*S
+      E=.3081*S**2.5
+      F=47.24+67.91*S
+      STXS=A*(1.+B*X+C*X**2)*(1.-X)**D + E*EXP(-F*X)
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION STXU(X,Q2)
+
+C-----------------------------------------------------------------------
+C  VALENCE U-QUARK DISTRIBUTION.
+C  FROM GLUECK, HOFFMANN, REYA, Z. PHYS. C13 (1982) 119.
+C-----------------------------------------------------------------------
+      CALL STAA(X,Q2,Z,S)
+      A=.421-.0412*S
+      C=2.-.6223*S**.8
+      D=3.37+.4319*S
+      STXU=2.*C*X**A*(1.-X**C)**D/SBET(D+1.,A/C)
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION STXUS(X,Q2)
+
+C-----------------------------------------------------------------------
+C  U-SEA DISTRIBUTION.
+C  FROM GLUECK, HOFFMANN, REYA, Z. PHYS. C13 (1982) 119.
+C-----------------------------------------------------------------------
+      CALL STAA(X,Q2,Z,S)
+      A=.25+.088*S**1.3
+      B=.8128*S-2.003*S**1.8+.0831*S**2
+      C=3.97*S
+      D=7.+1.666*S
+      E=.2487*S**2.5
+      F=27.8+59.68*S
+      STXUS=A*(1.+B*X+C*X**2)*(1.-X)**D + E*EXP(-F*X)
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION STXZNE(X,Q2)
+
+C-----------------------------------------------------------------------
+C  STRUCTURE FUNCTION OF NEUTRON
+C-----------------------------------------------------------------------
+      STXZNE=(4.*STXD(X,Q2) + STXU(X,Q2) +
+     *        10.*STXUS(X,Q2) + 2.*STXS(X,Q2))/9.
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION STXZPR(X,Q2)
+
+C-----------------------------------------------------------------------
+C  STRUCTURE FUNCTION OF PROTON
+C-----------------------------------------------------------------------
+      STXZPR=(4.*STXU(X,Q2) + STXD(X,Q2) +
+     *        10.*STXUS(X,Q2) + 2.*STXS(X,Q2))/9.
+      RETURN
+      END
+C=======================================================================
+
+      DOUBLE PRECISION FUNCTION SVA0(Z)
+
+C-----------------------------------------------------------------------
+C  VALENCE QUARK STRUCTURE FUNCTION FOR HADRONS
+C-----------------------------------------------------------------------
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      DOUBLE PRECISION Z
+C-----------------------------------------------------------------------
+      IF ( Z .NE. 0.D0 ) THEN
+        SVA0=(1.D0-Z)**3.46 * Z**0.419 * (2.74793064D0*Z + 0.62452969D0)
+     *                   / SQRT(Z**2+XCUT**2)
+      ELSE
+        SVA0=0.D0
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      DOUBLE PRECISION FUNCTION SVA1(Z)
+
+C-----------------------------------------------------------------------
+C  VALENCE QUARK STRUCTURE FUNCTION FOR PIONS
+C-----------------------------------------------------------------------
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      DOUBLE PRECISION Z
+C-----------------------------------------------------------------------
+      IF ( Z .NE. 0.D0 ) THEN
+        SVA1 = (1.D0-Z)**0.7D0 * Z**0.4D0 * 0.1730725D0
+     *                                   / SQRT(Z**2+XCUT**2)
+      ELSE
+        SVA1=0.D0
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UINTEG(VAL,FUNC,A,B,AERR,RERR,LEVEL,ERROR,IFLAG)
+
+C-----------------------------------------------------------------------
+C  CACLULATION OF DEFINITE INTEGRAL OF FUNC(X) FROM A TO B
+C-----------------------------------------------------------------------
+C        RELERR=1.D-12
+C        ABSERR=0.D0
+C        LEVEL=1
+C        CALL UINTEG(VALUE,FUNCTN,A,B,ABSERR,RELERR,LEVEL,ERROR,IFLAG)
+C        IF (IFLAG.GT.3) WRITE(*,'('' IFLAG ='',I7)') IFLAG
+C-----------------------------------------------------------------------
+      IMPLICIT  DOUBLE PRECISION (A-H,O-Z)
+      DIMENSION T(10,10),R(10),AIT(10),DIF(10),RN(4)
+      DIMENSION TS(2049),IBEGS(30),BEGIN(30),FINIS(30),EST(30)
+      LOGICAL   H2CONV,AITKEN,RIGHT,REGLAR,REGLSV(30)
+      DATA      TOLSAV,AITLOW,H2TOL,AITTOL,VJUMP,MAXTS,MAXTBL,MXSTGE
+     *          / 1.D-16, 1.1D0, .15D0, .1D0, .01D0, 2049, 10, 30 /
+      DATA      RN /.71420053D0,.34662815D0,.843751D0,.12633046D0 /
+      DATA      ALG402 /.3010299956639795D0 /
+C-----------------------------------------------------------------------
+      TOLMCH=TOLSAV
+      VAL=0.D0
+      ERROR=0.D0
+      IFLAG=1
+      VLONG=DABS(B-A)
+      IF ( VLONG .EQ. 0.D0 ) RETURN
+      ERRR=DMIN1( .1D0, DMAX1(DABS(RERR),1.D1*TOLMCH) )
+      ERRA=DABS(AERR)
+      STEPMN=DMAX1(VLONG/FLOAT(2**MXSTGE),
+     *   DMAX1(VLONG,DABS(A),DABS(B))*TOLMCH)
+      STAGE=.5D0
+      ISTAGE=1
+      CUREST=0.D0
+      FNSIZE=0.D0
+      PREVER=0.D0
+      REGLAR=.FALSE.
+      BEGI=A
+      FBEG=FUNC(A)/2.D0
+      TS(1)=FBEG
+      IBEG=1
+      ENDE=B
+      FEND=FUNC(B)/2.D0
+      TS(2)=FEND
+      IEND=2
+ 60   CONTINUE
+      RIGHT=.FALSE.
+ 61   CONTINUE
+      STEP=ENDE-BEGI
+      ASTEP=DABS(STEP)
+      IF ( ASTEP .LT. STEPMN ) GOTO 97
+      IF ( LEVEL .GE. 3 ) WRITE(*,101) BEGI,STEP,ISTAGE
+101   FORMAT(' BEGI,STEP',1P,2E16.7,I5)
+      T(1,1)=FBEG+FEND
+      TABS=DABS(FBEG)+DABS(FEND)
+      L=1
+      N=1
+      H2CONV=.FALSE.
+      AITKEN=.FALSE.
+      GOTO 63
+ 62   IF ( LEVEL .GE. 4 ) WRITE(*,102) L,T(1,LM1)
+102   FORMAT(1X,I5,7E16.8/1X,3E16.8)
+ 63   LM1=L
+      L=L+1
+      N2=N*2
+      FN=N2
+      ISTEP=(IEND-IBEG)/N
+      IF ( ISTEP .LE. 1 ) THEN
+        II=IEND
+        IEND=IEND+N
+        IF ( IEND .GT. MAXTS ) GOTO 96
+        HOVN=STEP/FN
+        III=IEND
+        DO  64  I=1,N2,2
+          TS(III)=TS(II)
+          TS(III-1)=FUNC(ENDE-FLOAT(I)*HOVN)
+          III=III-2
+          II=II-1
+ 64     CONTINUE
+        ISTEP=2
+      ENDIF
+      ISTEP2=IBEG+ISTEP/2
+      SUM=0.D0
+      SUMABS=0.D0
+      DO  65  I=ISTEP2,IEND,ISTEP
+        SUM=SUM+TS(I)
+        SUMABS=SUMABS+DABS(TS(I))
+ 65   CONTINUE
+      T(L,1)=T(L-1,1)/2.D0 + SUM/FN
+      TABS=TABS/2.D0+SUMABS/FN
+      ABSI=ASTEP*TABS
+      N=N2
+      IT=1
+      VINT=STEP*T(L,1)
+      TABTLM=TABS*TOLMCH
+      FNSIZE=DMAX1(FNSIZE,DABS(T(L,1)))
+      ERGOAL=DMAX1(ASTEP*TOLMCH*FNSIZE,
+     *       STAGE*DMAX1(ERRA,ERRR*DABS((CUREST)+VINT)))
+      FEXTRP=1.D0
+      DO  66  I=1,LM1
+        FEXTRP=FEXTRP*4.D0
+        T(I,L)=T(L,I)-T(L-1,I)
+        T(L,I+1)=T(L,I)+T(I,L)/(FEXTRP-1.D0)
+ 66   CONTINUE
+      ERRER=ASTEP*DABS(T(1,L))
+      IF ( L .LE. 2 ) THEN
+        IF ( DABS(T(1,2)) .LE. TABTLM)  GOTO 81
+        GOTO 63
+      ENDIF
+      DO  67  I=2,LM1
+        DIFF=0.D0
+        IF ( DABS(T(I-1,L)) .GT. TABTLM ) DIFF=T(I-1,LM1)/T(I-1,L)
+        T(I-1,LM1)=DIFF
+ 67   CONTINUE
+      IF ( DABS(4.D0-T(1,LM1)) .LE. H2TOL ) GOTO 69
+      IF ( T(1,LM1) .EQ. 0.D0 ) GOTO 68
+      IF ( DABS(2.D0-DABS(T(1,LM1))) .LT. VJUMP ) GOTO 80
+      IF ( L .EQ. 3 ) GOTO 62
+      H2CONV=.FALSE.
+      IF ( DABS((T(1,LM1)-T(1,L-2))/T(1,LM1)) .LE. AITTOL ) GOTO 72
+      IF ( REGLAR ) GOTO 68
+      IF ( L .EQ. 4 ) GOTO 62
+ 68   IF ( ERRER .LE. ERGOAL ) GOTO 83
+      IF ( LEVEL .GE. 4 ) WRITE(*,103) L,T(1,LM1)
+103   FORMAT(1X,I5,7E16.8/1X,3E16.8)
+      GOTO 90
+ 69   CONTINUE
+      IF ( LEVEL .GE. 4 ) WRITE(*,104) L,T(1,LM1)
+104   FORMAT(1X,I5,E16.8,5X,'H2CONV')
+      IF ( H2CONV ) GOTO 70
+      AITKEN=.FALSE.
+      H2CONV=.TRUE.
+      IF ( LEVEL .GE. 3 ) WRITE(*,105) L
+105   FORMAT(' H2 CONVERGENCE AT ROW',I4)
+ 70   FEXTRP=4.D0
+ 71   IT=IT+1
+      VINT=STEP*T(L,IT)
+      ERRER=DABS(STEP/(FEXTRP-1.D0)*T(IT-1,L))
+      IF ( ERRER .LE. ERGOAL ) GOTO 86
+      IF ( IT .EQ. LM1 ) GOTO 79
+      IF ( T(IT,LM1) .EQ. 0.D0 ) GOTO 71
+      IF ( T(IT,LM1) .LE. FEXTRP ) GOTO 79
+      IF ( DABS(T(IT,LM1)/4.D0-FEXTRP)/FEXTRP .LT. AITTOL )
+     *                                       FEXTRP=FEXTRP*4.D0
+      GOTO 71
+ 72   IF ( LEVEL .GE. 4 ) WRITE(*,106) L,T(1,LM1)
+106   FORMAT(1X,I5,E16.8,5X,'AITKEN')
+      IF ( T(1,LM1) .LT. AITLOW ) GOTO 90
+      IF ( AITKEN ) GOTO 73
+      H2CONV=.FALSE.
+      AITKEN=.TRUE.
+      IF ( LEVEL .GE. 3 ) WRITE(*,107) L
+107   FORMAT(' AITKEN AT ROW',I4)
+ 73   FEXTRP=T(L-2,LM1)
+      IF ( FEXTRP .GT. 4.5 ) GOTO 70
+      IF ( FEXTRP .LT. AITLOW ) GOTO 90
+      IF ( DABS(FEXTRP-T(L-3,LM1))/T(1,LM1) .GT. H2TOL ) GOTO 90
+      IF ( LEVEL .GE. 3 ) WRITE(*,108) FEXTRP
+108   FORMAT(' RATIO',F13.8)
+      SING=FEXTRP
+      FEXTM1=FEXTRP-1
+      AIT(1)=0.
+      DO  74  I=2,L
+        AIT(I)=T(I,1)+(T(I,1)-T(I-1,1))/FEXTM1
+        R(I)=T(1,I-1)
+        DIF(I)=AIT(I)-AIT(I-1)
+ 74   CONTINUE
+      IT=2
+ 75   VINT=STEP*AIT(L)
+      IF ( LEVEL .GE. 5 ) THEN
+        WRITE(*,109) (R(I+1),I=IT,LM1)
+109     FORMAT(1X,8E15.8)
+        WRITE(*,109) (AIT(I),I=IT,L)
+        WRITE(*,109) (DIF(I+1),I=IT,LM1)
+      ENDIF
+      ERRER=ERRER/FEXTM1
+      IF ( ERRER .GT. ERGOAL ) GOTO 76
+      ALPHA=DLOG10(SING)/ALG402-1.D0
+      IF ( LEVEL .GE. 2 ) WRITE(*,110) ALPHA,BEGI,ENDE
+110   FORMAT(11X,'INTEGRAND SHOWS SINGULAR ',
+     *   'BEHAVIOUR OF TYPE X**(',F5.2,') BETWEEN',1P,E15.7,
+     *   ' AND',1P,E15.7)
+      IFLAG=MAX0(IFLAG,2)
+      GOTO 86
+ 76   IT=IT+1
+      IF ( IT .EQ. LM1 ) GOTO 79
+      IF ( IT .LE. 3 ) THEN
+        H2NEXT=4.D0
+        SINGNX=2.D0*SING
+      ENDIF
+      IF ( H2NEXT .GE. SINGNX)  THEN
+        FEXTRP=SINGNX
+        SINGNX=2.D0*SINGNX
+      ELSE
+        FEXTRP=H2NEXT
+        H2NEXT=4.D0*H2NEXT
+      ENDIF
+      DO 77 I=IT,LM1
+        R(I+1)=0.D0
+        IF ( DABS(DIF(I+1)) .GT. TABTLM ) R(I+1)=DIF(I)/DIF(I+1)
+ 77   CONTINUE
+      IF ( LEVEL .GE. 4 ) WRITE(*,111) FEXTRP,R(L-1),R(L)
+111   FORMAT(' FEXTRP + RATIOS',1P,3E15.7)
+      H2TFEX=-H2TOL*FEXTRP
+      IF ( R(L)-FEXTRP .LT. H2TFEX ) GOTO 79
+      IF ( R(L-1)-FEXTRP .LT. H2TFEX ) GOTO 79
+      ERRER=ASTEP*DABS(DIF(L))
+      FEXTM1=FEXTRP-1.D0
+      DO 78 I=IT,L
+        AIT(I)=AIT(I)+DIF(I)/FEXTM1
+        DIF(I)=AIT(I)-AIT(I-1)
+ 78   CONTINUE
+      GOTO 75
+ 79   FEXTRP=DMAX1(PREVER/ERRER,AITLOW)
+      PREVER=ERRER
+      IF ( L .LT. 5 ) GOTO 63
+      IF ( LEVEL .GE. 3 ) WRITE(*,112)  ERRER,ERGOAL,FEXTRP,IT
+112   FORMAT(' ERRER,ERGOAL,FEXTRP,IT',1P,2E15.7,1P,E14.5,0P,I3)
+      IF ( L-IT .GT. 2  .AND.  ISTAGE .LT. MXSTGE ) GOTO 89
+      IF ( ERRER/FEXTRP**(MAXTBL-L) .LT. ERGOAL ) GOTO 63
+      GOTO 89
+ 80   IF ( LEVEL .GE. 4 ) WRITE(*,113) L,T(1,LM1)
+113   FORMAT(1X,I5,E16.8,5X,'JUMP')
+      IF ( ERRER .GT. ERGOAL ) GOTO 89
+      DIFF=DABS(T(1,L))*2.D0*FN
+      IF ( LEVEL .GE. 2 ) WRITE(*,114) DIFF,BEGI,ENDE
+114   FORMAT(13X,'INTEGRAND SEEMS TO HAVE JUMP OF SIZE',
+     *   1P,E15.7,' BETWEEN',1P,E15.7,' AND',1P,E15.7)
+      GOTO 86
+ 81   IF ( LEVEL .GE. 4 ) WRITE(*,115) L
+115   FORMAT(1X,I5,21X,'STRAIGHT LINE')
+      SLOPE=(FEND-FBEG)*2.D0
+      FBEG2=FBEG*2.D0
+      DO  82  I=1,4
+        DIFF=DABS(FUNC(BEGI+RN(I)*STEP)-FBEG2-RN(I)*SLOPE)
+        IF ( DIFF .GT. TABTLM)  GOTO 85
+ 82   CONTINUE
+      IF ( LEVEL .GE. 3 ) WRITE(*,116) BEGI,ENDE
+116   FORMAT(27X,'INTEGRAND SEEMS TO BE STRAIGHT LINE BETWEEN',
+     *       1P,E15.7,' AND',1P,E15.7)
+      GOTO 86
+ 83   IF ( LEVEL .GE. 4 ) WRITE(*,117) L,T(1,LM1)
+117   FORMAT(1X,I5,1P,E15.7,5X,'NOISE')
+      SLOPE=(FEND-FBEG)*2.D0
+      FBEG2=FBEG*2.D0
+      I=1
+ 84   DIFF=DABS(FUNC(BEGI+RN(I)*STEP)-FBEG2-RN(I)*SLOPE)
+ 85   ERRER=DMAX1(ERRER,ASTEP*DIFF)
+      IF ( ERRER .GT. ERGOAL ) GOTO 90
+      I=I+1
+      IF ( I .LE. 4 ) GOTO 84
+      IF ( LEVEL .GE. 3 ) WRITE(*,118) BEGI,ENDE
+118   FORMAT(' NOISE BETWEEN',1P,E15.7,' AND',1P,E15.7)
+      IFLAG=3
+ 86   VAL=VAL+VINT
+      ERROR=ERROR+ERRER
+      IF ( LEVEL .GE. 3 ) THEN
+        IF ( LEVEL .GE. 5 ) THEN
+          DO 87 I=1,L
+            IF ( LEVEL .GE. 4 ) WRITE(*,119) I,(T(I,J),J=1,L)
+119         FORMAT(1X,I5,7E16.8/1X,3E16.8)
+ 87       CONTINUE
+        ENDIF
+        WRITE(*,120) VINT,ERRER,L,IT
+120     FORMAT(' INTEGRAL IS',1P,E16.8,', ERROR',1P,E16.8,
+     *         '  FROM T(',I1,',',I1,'1H)')
+      ENDIF
+      IF ( RIGHT ) GOTO 88
+      ISTAGE=ISTAGE-1
+      IF ( ISTAGE .EQ. 0 ) RETURN
+      REGLAR=REGLSV(ISTAGE)
+      BEGI=BEGIN(ISTAGE)
+      ENDE=FINIS(ISTAGE)
+      CUREST=CUREST-EST(ISTAGE+1)+VINT
+      IEND=IBEG-1
+      FEND=TS(IEND)
+      IBEG=IBEGS(ISTAGE)
+      GOTO 92
+ 88   CUREST=CUREST+VINT
+      STAGE=STAGE*2.D0
+      IEND=IBEG
+      IBEG=IBEGS(ISTAGE)
+      ENDE=BEGI
+      BEGI=BEGIN(ISTAGE)
+      FEND=FBEG
+      FBEG=TS(IBEG)
+      GOTO 60
+ 89   REGLAR=.TRUE.
+ 90   IF ( ISTAGE .EQ. MXSTGE ) GOTO 97
+      IF ( LEVEL .GE. 5 ) THEN
+        DO 91 I=1,L
+          IF ( LEVEL .GE. 4 ) WRITE(*,121) I,(T(I,J),J=1,L)
+121       FORMAT(1X,I5,7E16.8/1X,3E16.8)
+ 91     CONTINUE
+      ENDIF
+      IF ( RIGHT ) GOTO 93
+      REGLSV(ISTAGE+1)=REGLAR
+      BEGIN(ISTAGE)=BEGI
+      IBEGS(ISTAGE)=IBEG
+      STAGE=STAGE/2.D0
+ 92   RIGHT=.TRUE.
+      BEGI=(BEGI+ENDE)/2.D0
+      IBEG=(IBEG+IEND)/2
+      TS(IBEG)=TS(IBEG)/2.D0
+      FBEG=TS(IBEG)
+      GOTO 61
+ 93   NNLEFT=IBEG-IBEGS(ISTAGE)
+      IF ( IEND+NNLEFT .GE. MAXTS ) GOTO 96
+      III=IBEGS(ISTAGE)
+      II=IEND
+      DO 94 I=III,IBEG
+        II=II+1
+        TS(II)=TS(I)
+ 94   CONTINUE
+      DO 95 I=IBEG,II
+        TS(III)=TS(I)
+        III=III+1
+ 95   CONTINUE
+      IEND=IEND+1
+      IBEG=IEND-NNLEFT
+      FEND=FBEG
+      FBEG=TS(IBEG)
+      FINIS(ISTAGE)=ENDE
+      ENDE=BEGI
+      BEGI=BEGIN(ISTAGE)
+      BEGIN(ISTAGE)=ENDE
+      REGLSV(ISTAGE)=REGLAR
+      ISTAGE=ISTAGE+1
+      REGLAR=REGLSV(ISTAGE)
+      EST(ISTAGE)=VINT
+      CUREST=CUREST+EST(ISTAGE)
+      GOTO 60
+ 96   CONTINUE
+      IF ( LEVEL .GE. 2 ) WRITE(*,122) BEGI,ENDE
+122   FORMAT(' TOO MANY FUNCTION EVALUATIONS AROUND'/
+     *       11X,1P,E15.7,' AND',1P,E15.7)
+      IFLAG=4
+      GOTO 99
+ 97   CONTINUE
+      IFLAG=5
+      IF ( LEVEL .GE. 2 ) THEN
+        IF ( LEVEL .GE. 5 ) THEN
+          DO  98  I =1,L
+            IF ( LEVEL .GE. 4 ) WRITE(*,123) I,(T(I,J),J=1,L)
+123         FORMAT(1X,I5,7E16.8/1X,3E16.8)
+ 98       CONTINUE
+        ENDIF
+        WRITE(*,124) BEGI,ENDE
+124     FORMAT(11X,'INTEGRAND SHOWS SINGULAR BEHAVIOUR OF ',
+     *      'UNKNOWN TYPE BETWEEN',1P,E15.7,' AND',1P,E15.7)
+      ENDIF
+ 99   CONTINUE
+      VAL=CUREST+VINT
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION UTACOS(X)
+
+C-----------------------------------------------------------------------
+C  RETURNS ACOS(X) FOR -1 <= X <= 1 , ACOS(+-1) ELSE
+C-----------------------------------------------------------------------
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+C-----------------------------------------------------------------------
+      ARGUM=X
+      IF     ( X .LT. -1. ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('UTACOS')
+          WRITE(IFCH,*)'*****  ARGUM = ',ARGUM,' SET -1'
+          CALL UTMSGF
+        ENDIF
+        ARGUM=-1.
+      ELSEIF ( X .GT.  1. ) THEN
+        IF ( ISH .GE .90 ) THEN
+          CALL UTMSG('UTACOS')
+          WRITE(IFCH,*)'*****  ARGUM = ',ARGUM,' SET 1'
+          CALL UTMSGF
+        ENDIF
+        ARGUM=1.
+      ENDIF
+      UTACOS=ACOS(ARGUM)
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION UTAMNU(KEUX,KEDX,KESX,KECX,MODUS)
+
+C----------------------------------------------------------------------
+C  RETURNS MIN MASS OF CLUSTER WITH GIVEN U,D,S,C CONTENT
+C  KEUX: NET U QUARK NUMBER
+C  KEDX: NET D QUARK NUMBER
+C  KESX: NET S QUARK NUMBER
+C  KECX: NET C QUARK NUMBER
+C  MODUS:0,1,2,3,4,5,6
+C----------------------------------------------------------------------
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CSJCGA/  AMEGAM,AMNULL,ASUHA(7),ENTRPY,NOPHA,NSUHA(7)
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO3/   ASUHAX(7),ASUHAY(7),OMEGA,SIGPPD,SIGPPE,UENTRO
+     *                ,IWZZZZ
+C----------------------------------------------------------------------
+      AMNULL=0.
+
+      IF     ( MODUS .EQ. 0 ) THEN
+        DO 21 I=1,7
+          ASUHA(I)=ASUHAY(I)
+          NSUHA(I)=0
+21      CONTINUE
+      ELSEIF ( MODUS .EQ. 1 ) THEN
+        IF     ( NOPHA .EQ. 0 ) THEN
+          DO 22 I=1,7
+            ASUHA(I)=ASUHAX(I)
+            NSUHA(I)=0
+22        CONTINUE
+        ELSEIF ( NOPHA .GE. 1 ) THEN
+          DO 23 I=1,7
+            ASUHA(I)=ASUHAY(I)
+            NSUHA(I)=0
+23        CONTINUE
+        ENDIF
+      ELSEIF ( MODUS .EQ. 2 ) THEN
+        DO 24 I=1,7
+          ASUHA(I)=ASUHAY(I)
+          NSUHA(I)=0
+24      CONTINUE
+      ELSEIF ( MODUS .EQ. 3 ) THEN
+        DO 25 I=1,7
+          ASUHA(I)=ASUHAY(I)
+          NSUHA(I)=0
+25      CONTINUE
+      ELSEIF ( MODUS .EQ. 4 ) THEN
+        DO 26 I=1,7
+          ASUHA(I)=ASUHAX(I)
+          NSUHA(I)=0
+26      CONTINUE
+      ELSEIF ( MODUS .EQ. 5 ) THEN
+        DO 27 I=1,7
+          ASUHA(I)=ASUHAY(I)
+          NSUHA(I)=0
+27      CONTINUE
+      ELSEIF ( MODUS .EQ. 6 ) THEN
+        DO 28 I=1,7
+          ASUHA(I)=SQRT(ASUHAY(I)**2+DELMSS**2)
+          NSUHA(I)=0
+28      CONTINUE
+      ENDIF
+      IAUX=KEUX+KEDX+KESX+KECX
+      KE=ABS(IAUX)
+
+      IF ( IAUX .GE. 0 ) THEN
+        KEU=KEUX
+        KED=KEDX
+        KES=KESX
+        KEC=KECX
+      ELSE
+        KEU=-KEUX
+        KED=-KEDX
+        KES=-KESX
+        KEC=-KECX
+      ENDIF
+
+      IF ( KEC .NE. 0 ) THEN
+10      CONTINUE
+        IF   ( KEC .LT. 0 ) THEN
+          KEC=KEC+1
+          IF ( KEU .GT. KED ) THEN
+            KEU=KEU-1
+          ELSE
+            KED=KED-1
+          ENDIF
+          AMNULL=AMNULL+1.87
+          GOTO 10
+        ENDIF
+11      CONTINUE
+        IF ( KEC .GT. 0 ) THEN
+          KEC=KEC-1
+          IF ( KEU .LT. KED ) THEN
+            KEU=KEU+1
+          ELSE
+            KED=KED+1
+          ENDIF
+          AMNULL=AMNULL+1.87
+          GOTO 11
+        ENDIF
+      ENDIF
+
+ 5    CONTINUE
+      IF ( KES .LT. 0 ) THEN
+        AMNULL=AMNULL+ASUHA(6)
+        IF ( KEU .GE. KED ) THEN
+          KEU=KEU-1
+        ELSE
+          KED=KED-1
+        ENDIF
+        KES=KES+1
+        GOTO 5
+      ENDIF
+
+ 6    CONTINUE
+      IF ( KED .LT. 0 ) THEN
+        IF ( KEU .GE. KES ) THEN
+          AMNULL=AMNULL+ASUHA(5)
+          KEU=KEU-1
+        ELSE
+          AMNULL=AMNULL+ASUHA(6)
+          KES=KES-1
+        ENDIF
+        KED=KED+1
+        GOTO 6
+      ENDIF
+
+ 7    CONTINUE
+      IF ( KEU .LT. 0 ) THEN
+        IF ( KED .GE. KES ) THEN
+          AMNULL=AMNULL+ASUHA(5)
+          KED=KED-1
+        ELSE
+          AMNULL=AMNULL+ASUHA(6)
+          KES=KES-1
+        ENDIF
+        KEU=KEU+1
+        GOTO 7
+      ENDIF
+
+      IF ( KEU+KED+KES+KEC .NE. KE ) THEN
+        CALL UTSTOP('UTAMNU: SUM_KEI /= KE                   ')
+      ENDIF
+      KEQ=KEU+KED
+      KEQX=KEQ
+
+      IF ( MODUS .EQ. 2  .AND.  KE .GT. 3 ) THEN
+        CALL SMASST(KEU,KED,KES,KEC,A,Y,Z)
+        AMNUZ=SMASS(A,Y,Z)
+      ENDIF
+
+      AMNUX=0.
+
+      I=4
+ 2    I=I-1
+ 3    CONTINUE
+      IF ( (4-I)*KES .GT. (I-1)*KEQ ) THEN
+        AMNUX=AMNUX+ASUHA(1+I)
+        KEQ=KEQ-3+I
+        KES=KES-I
+        IF ( KES .LT. 0 ) THEN
+          CALL UTSTOP('UTAMNU: NEGATIVE KES                    ')
+        ENDIF
+        IF ( KEQ .LT. 0 ) THEN
+          CALL UTSTOP('UTAMNU: NEGATIVE KEQ                    ')
+        ENDIF
+        GOTO 3
+      ENDIF
+      IF ( I .GT. 1 ) GOTO 2
+
+      IF ( KEQX .GT. KEQ ) THEN
+        DO 8 K=1,KEQX-KEQ
+          IF ( KEU .GE. KED ) THEN
+            KEU=KEU-1
+          ELSE
+            KED=KED-1
+          ENDIF
+ 8      CONTINUE
+      ENDIF
+      IF ( KEU+KED .NE. KEQ ) THEN
+        CALL UTSTOP('UTAMNU: KEU+KED /= KEQ                  ')
+      ENDIF
+
+ 9    CONTINUE
+      IF ( KEU .GT. 2*KED ) THEN
+        AMNUX=AMNUX+ASUHA(7)
+        KEU=KEU-3
+        IF ( KEU .LT. 0 ) THEN
+          CALL UTSTOP('UTAMNU: NEGATIVE KEU                    ')
+        ENDIF
+        GOTO 9
+      ENDIF
+      IF ( KED .GT. 2*KEU ) THEN
+        AMNUX=AMNUX+ASUHA(7)
+        KED=KED-3
+        IF ( KED .LT. 0 ) THEN
+          CALL UTSTOP('UTAMNU: NEGATIVE KED                    ')
+        ENDIF
+        GOTO 9
+      ENDIF
+
+      KEQ=KEU+KED
+      IF ( MOD(KEQ,3) .NE. 0 ) THEN
+        CALL UTSTOP('UTAMNU: MOD(KEQ,3) /= 0                 ')
+      ENDIF
+      AMNUX=AMNUX+ASUHA(1)*KEQ/3
+
+      AMNU=AMNUX
+      IF ( MODUS.EQ.2 .AND. KE.GT.3 ) AMNU=MIN(AMNUX,AMNUZ)
+      AMNULL=AMNULL+AMNU
+
+      IF ( AMNULL.EQ.0. .AND. MODUS.GT.0 ) AMNULL=ASUHA(5)
+
+1000  UTAMNU=AMNULL
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION UTAMNX(JCP,JCM)
+
+C-----------------------------------------------------------------------
+C  RETURNS MINIMUM MASS FOR THE DECAY OF JCP---JCM (BY CALLING UTAMNU).
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      INTEGER JCM(NFLAV,2),JCP(NFLAV,2)
+C-----------------------------------------------------------------------
+      DO 3 I=1,NFLAV
+        IF ( JCP(I,1) .NE. 0 ) GOTO 1
+        IF ( JCP(I,2) .NE. 0 ) GOTO 1
+ 3    CONTINUE
+      KEU=JCM(1,1)-JCM(1,2)
+      KED=JCM(2,1)-JCM(2,2)
+      KES=JCM(3,1)-JCM(3,2)
+      KEC=JCM(4,1)-JCM(4,2)
+      UTAMNX=UTAMNU(KEU,KED,KES,KEC,5)
+      RETURN
+ 1    CONTINUE
+
+      DO  4 I=1,NFLAV
+        IF ( JCM(I,1) .NE. 0 ) GOTO 2
+        IF ( JCM(I,2) .NE. 0 ) GOTO 2
+ 4    CONTINUE
+      KEU=JCP(1,1)-JCP(1,2)
+      KED=JCP(2,1)-JCP(2,2)
+      KES=JCP(3,1)-JCP(3,2)
+      KEC=JCP(4,1)-JCP(4,2)
+      UTAMNX=UTAMNU(KEU,KED,KES,KEC,5)
+      RETURN
+ 2    CONTINUE
+
+      KEU=JCP(1,1)-JCP(1,2)
+      KED=JCP(2,1)-JCP(2,2)
+      KES=JCP(3,1)-JCP(3,2)
+      KEC=JCP(4,1)-JCP(4,2)
+      KE=KEU+KED+KES+KEC
+      IF     ( MOD(KE+1,3) .EQ. 0 ) THEN
+        KEU=KEU+1
+      ELSEIF ( MOD(KE-1,3) .EQ. 0 ) THEN
+        KEU=KEU-1
+      ELSE
+        CALL UTSTOP('UTAMNX: NO SINGLET POSSIBLE (1)         ')
+      ENDIF
+      AMMS=UTAMNU(KEU,KED,KES,KEC,5)
+      KEU=JCM(1,1)-JCM(1,2)
+      KED=JCM(2,1)-JCM(2,2)
+      KES=JCM(3,1)-JCM(3,2)
+      KEC=JCM(4,1)-JCM(4,2)
+      KE=KEU+KED+KES+KEC
+      IF     ( MOD(KE+1,3) .EQ. 0 ) THEN
+        KEU=KEU+1
+      ELSEIF ( MOD(KE-1,3) .EQ. 0 ) THEN
+        KEU=KEU-1
+      ELSE
+        CALL UTSTOP('UTAMNX: NO SINGLET POSSIBLE (2)         ')
+      ENDIF
+      UTAMNX=AMMS+UTAMNU(KEU,KED,KES,KEC,5)
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION UTAMNY(JCP,JCM)
+
+C-----------------------------------------------------------------------
+C  RETURNS MINIMUM MASS OF JCP+JCM (BY CALLING UTAMNU).
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      INTEGER JC(NFLAV,2),JCM(NFLAV,2),JCP(NFLAV,2)
+C-----------------------------------------------------------------------
+      DO 7 NF=1,NFLAV
+        JC(NF,1)=JCP(NF,1)+JCM(NF,1)
+        JC(NF,2)=JCP(NF,2)+JCM(NF,2)
+ 7    CONTINUE
+      KEU=JC(1,1)-JC(1,2)
+      KED=JC(2,1)-JC(2,2)
+      KES=JC(3,1)-JC(3,2)
+      KEC=JC(4,1)-JC(4,2)
+      UTAMNY=UTAMNU(KEU,KED,KES,KEC,5)
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION UTAMNZ(JC,MODUS)
+
+C-----------------------------------------------------------------------
+C  RETURNS MINIMUM MASS OF JC (BY CALLING UTAMNU).
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      INTEGER JC(NFLAV,2)
+C-----------------------------------------------------------------------
+      KEU=JC(1,1)-JC(1,2)
+      KED=JC(2,1)-JC(2,2)
+      KES=JC(3,1)-JC(3,2)
+      KEC=JC(4,1)-JC(4,2)
+      UTAMNZ=UTAMNU(KEU,KED,KES,KEC,MODUS)
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTAMST(STS,AM,AMIN,IRET)
+
+C-----------------------------------------------------------------------
+C  INPUT:  STS   = STRING  (SINGLE)
+C  OUTPUT: AM    = MASS
+C          AMIN  = MINIMUM MASS
+C          IRET  = RETURN CODE (=3 IF AM**2.LT.AMIN**2, 0 ELSE)
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      PARAMETER (NSI=6)
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+
+      REAL    STS(NSI,2)
+      INTEGER IC1(2),IC2(2),JC(NFLAV,2),JC1(NFLAV,2),JC2(NFLAV,2)
+C-----------------------------------------------------------------------
+      IRET=0
+      AM2= (STS(4,1)+STS(4,2))**2 - (STS(3,1)+STS(3,2))**2 -
+     *     (STS(2,1)+STS(2,2))**2 - (STS(1,1)+STS(1,2))**2
+      AM=-AM2
+      IC1(1)=NINT(STS(4+1,1))
+      IC1(2)=NINT(STS(4+2,1))
+      IC2(1)=NINT(STS(4+1,2))
+      IC2(2)=NINT(STS(4+2,2))
+      CALL IDDECO(IC1,JC1)
+      CALL IDDECO(IC2,JC2)
+      DO 2 NF=1,NFLAV
+        JC(NF,1)=JC1(NF,1)+JC2(NF,1)
+        JC(NF,2)=JC1(NF,2)+JC2(NF,2)
+        IF ( NF.GT.4 .AND. (JC(NF,1).NE.0 .OR. JC(NF,2).NE.0) ) THEN
+          CALL UTSTOP('UTAMST: FLAVOUR > 4                     ')
+        ENDIF
+ 2    CONTINUE
+      KEU=JC(1,1)-JC(1,2)
+      KED=JC(2,1)-JC(2,2)
+      KES=JC(3,1)-JC(3,2)
+      KEC=JC(4,1)-JC(4,2)
+      AMIN=UTAMNU(KEU,KED,KES,KEC,4)
+      IF ( AM2. LT. AMIN**2 ) THEN
+        IRET=3
+        RETURN
+      ELSE
+        AM=SQRT(AM2)
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTAXIS(I,J,A1,A2,A3)
+
+C---------------------------------------------------------------------
+C  CALCULATES THE AXIS DEFINED BY THE PTLS I,J IN THE I,J CM SYSTEM
+C---------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+C---------------------------------------------------------------------
+      A1=0.
+      A2=0.
+      A3=1.
+      PI1=PPTL(1,I)
+      PI2=PPTL(2,I)
+      PI3=PPTL(3,I)
+      PI4=PPTL(4,I)
+      PJ1=PPTL(1,J)
+      PJ2=PPTL(2,J)
+      PJ3=PPTL(3,J)
+      PJ4=PPTL(4,J)
+      P1=PI1+PJ1
+      P2=PI2+PJ2
+      P3=PI3+PJ3
+      P4=PI4+PJ4
+      P5=SQRT(P4**2-P3**2-P2**2-P1**2)
+      CALL UTLOBO(1,P1,P2,P3,P4,P5,PI1,PI2,PI3,PI4)
+      CALL UTLOBO(1,P1,P2,P3,P4,P5,PJ1,PJ2,PJ3,PJ4)
+      ERR=(PI1+PJ1)**2+(PI2+PJ2)**2+(PI3+PJ3)**2
+      IF ( ISH.GE.90 .AND. ERR .GT. 1.E-3 ) THEN
+        CALL UTMSG('UTAXIS')
+        WRITE(IFCH,*)'*****  ERR=',ERR
+        WRITE(IFCH,*)'PI:',PI1,PI2,PI3,PI4
+        WRITE(IFCH,*)'PJ:',PJ1,PJ2,PJ3,PJ4
+        CALL UTMSGF
+      ENDIF
+      A=SQRT( (PJ1-PI1)**2 + (PJ2-PI2)**2 + (PJ3-PI3)**2 )
+      IF ( A .EQ. 0. ) RETURN
+      A1=(PI1-PJ1)/A
+      A2=(PI2-PJ2)/A
+      A3=(PI3-PJ3)/A
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTCHM(ARP,ARM,II)
+
+C-----------------------------------------------------------------------
+C  CHECKS WHETHER ARP**2=0. AND ARM**2=0.
+C-----------------------------------------------------------------------
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      DOUBLE PRECISION ARM(4),ARP(4),DIFM,DIFP
+C-----------------------------------------------------------------------
+      IF(ISH.LT.90)RETURN
+      DIFP=ARP(4)**2-ARP(1)**2-ARP(2)**2-ARP(3)**2
+      DIFM=ARM(4)**2-ARM(1)**2-ARM(2)**2-ARM(3)**2
+      IF ( ABS(DIFP) .GT. 1.D-3*ARP(4)**2   .OR.
+     *     ABS(DIFM) .GT. 1.D-3*ARM(4)**2 ) THEN
+        CALL UTMSG('UTCHM ')
+        WRITE(IFCH,*)'*****  MASS NON ZERO  -  ',II
+        WRITE(IFCH,*)'JET-MASS**2`S:    ',DIFP,DIFM
+        WRITE(IFCH,*)'ENERGY**2`S:      ',ARP(4)**2,ARM(4)**2
+        WRITE(IFCH,*)(SNGL(ARP(I)),I=1,4)
+        WRITE(IFCH,*)(SNGL(ARM(I)),I=1,4)
+        CALL UTMSGF
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTCLEA(NPTL0)
+
+C-----------------------------------------------------------------------
+C  OVERWRITES ISTPTL=2 PARTICLES IN /CPTL/, REDUCES SO NPTL.
+C-----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      INTEGER NEWPTL(MXPTL)
+C-----------------------------------------------------------------------
+      ISH0=ISH
+      IF ( ISHSUB/100 .EQ. 18 ) ISH=MOD(ISHSUB,100)
+
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)('-',L=1,68)
+        WRITE(IFCH,*)'SR UTCLEA. INITIAL.'
+        WRITE(IFCH,*)('-',L=1,68)
+        DO 34 N=1,NPTL
+          WRITE(IFCH,116)IORPTL(N),JORPTL(N),N,IFRPTL(1,N),IFRPTL(2,N)
+     *     ,IDPTL(N),SQRT(PPTL(1,N)**2+PPTL(2,N)**2),PPTL(3,N),PPTL(5,N)
+     *     ,ISTPTL(N)
+34      CONTINUE
+116     FORMAT(1X,I6,I6,2X,I6,2X,I4,I4,I12,3(E10.2),I3,I3)
+      ENDIF
+
+      I=0
+ 1    I=I+1
+      IF ( I .GT. NPTL ) GOTO 1000
+      IF ( ISTPTL(I) .EQ. 2 ) GOTO 2
+      NEWPTL(I)=I
+      GOTO 1
+
+ 2    I=I-1
+      J=I
+ 3    I=I+1
+ 4    J=J+1
+      IF ( J .GT. NPTL ) GOTO 5
+      NEWPTL(J)=0
+      IF ( ISTPTL(J) .EQ. 2 ) GOTO 4
+      NEWPTL(J)=I
+      CALL UTREPL(I,J)
+      GOTO 3
+
+ 5    NPTL=I-1
+      IF ( NPTL .EQ. 0 ) THEN
+        NPTL0=0
+        GOTO 1000
+      ENDIF
+
+20    N0=NEWPTL(NPTL0)
+      IF ( N0 .GT. 0 ) THEN
+        NPTL0=N0
+      ELSE
+        NPTL0=NPTL0-1
+        IF ( NPTL0 .GT. 0 ) GOTO 20
+      ENDIF
+
+      DO 11 K=1,NPTL
+        IO=IORPTL(K)
+        IF ( IO .LE. 0 ) THEN
+          IORPTL(K)=IO
+        ELSE
+          IORPTL(K)=NEWPTL(IO)
+        ENDIF
+
+        JO=JORPTL(K)
+        IF ( JO .LE. 0 ) THEN
+          JORPTL(K)=JO
+        ELSE
+          JORPTL(K)=NEWPTL(JO)
+        ENDIF
+
+        IF1=IFRPTL(1,K)
+        IF ( IF1 .LE. 0 ) THEN
+          IFRPTL(1,K)=IF1
+        ELSE
+          IFRPTL(1,K)=NEWPTL(IF1)
+        ENDIF
+
+        IF2=IFRPTL(2,K)
+        IF ( IF2 .LE. 0 ) THEN
+          IFRPTL(2,K)=IF2
+        ELSE
+          IFRPTL(2,K)=NEWPTL(IF2)
+        ENDIF
+11    CONTINUE
+
+      DO 19 K=1,NPTL
+        IF ( IFRPTL(1,K).EQ.0 .AND. IFRPTL(2,K).GT.0 )
+     *                                         IFRPTL(1,K)=IFRPTL(2,K)
+        IF ( IFRPTL(1,K).GT.0 .AND. IFRPTL(2,K).EQ.0 )
+     *                                         IFRPTL(2,K)=IFRPTL(1,K)
+19    CONTINUE
+
+1000  CONTINUE
+
+      IF ( ISH .GE. 92 ) THEN
+        WRITE(IFCH,*)('-',L=1,68)
+        WRITE(IFCH,*)'SR UTCLEA. FINAL.'
+        WRITE(IFCH,*)('-',L=1,68)
+        DO 35 N=1,NPTL
+          WRITE(IFCH,116)IORPTL(N),JORPTL(N),N,IFRPTL(1,N),IFRPTL(2,N)
+     *     ,IDPTL(N),SQRT(PPTL(1,N)**2+PPTL(2,N)**2),PPTL(3,N),PPTL(5,N)
+     *     ,ISTPTL(N)
+35      CONTINUE
+        WRITE(IFCH,*)('-',L=1,79)
+      ENDIF
+
+      ISH=ISH0
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTHIST(X1,X2,Y1,Y2,N,X,Y,LITY,LILO,TEXT1,TEXT2,TEXT3)
+
+C----------------------------------------------------------------------
+C  WRITES ARRAYS X,Y IN HISTO-FORMAT
+C----------------------------------------------------------------------
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      REAL      X(N),Y(N)
+      CHARACTER LILO*6,LITY*3,TEXT1*50,TEXT2*50,TEXT3*50
+C----------------------------------------------------------------------
+      WRITE(IFCH,100)('-',I=1,69)
+      WRITE(IFCH,100)('-',I=1,69)
+100   FORMAT(1X,1H',69A1,1H')
+      WRITE(IFCH,101)X1,X2,0.,Y1,Y2,0.,'_____',0
+     *,'___',LITY,'___','_______',LILO,0.,3,N,0.
+101   FORMAT(1X,6F8.2,2X,1H',A5,1H',I11
+     */4X,1H',A3,1H',3X,1H',A3,A3,1H',3X,1H',A7,A6,1H',F8.2,2I6,F10.4)
+      WRITE(IFCH,100)('-',I=1,69)
+      WRITE(IFCH,102)0.,0.,TEXT1
+      WRITE(IFCH,102)0.,0.,TEXT2
+      WRITE(IFCH,102)0.,0.,TEXT3
+102   FORMAT(4X,F4.2,2X,F4.2,2X,1H',A50,1H')
+      WRITE(IFCH,100)('-',I=1,69)
+      DO 36 K=1,N
+        WRITE(IFCH,103)K,X(K),0.,Y(K),0.,0.
+103     FORMAT(4X,I5,2X,5E12.4)
+36    CONTINUE
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTHSEA
+
+C-----------------------------------------------------------------------
+C  CREATES HISTOGRAM OF SEA STRUCTURE FUNCTION
+C-----------------------------------------------------------------------
+      PARAMETER (NSTRU=2049)
+      COMMON /STRU/    QSEP(NSTRU),QSET(NSTRU),QVAP(NSTRU)
+     *                ,QVAT(NSTRU),XCUTAR,XSTRU(NSTRU)
+     *                ,IDTG
+      REAL XAR(1000),YAR(1000)
+C-----------------------------------------------------------------------
+      DX=1.
+      X1=-1.
+      DO 3 K=1,2
+        DX=DX*0.001
+        X1=X1-3.
+        DO 2 N=1,1000
+          YAR(N)=0.
+          XAR(N)=-DX*0.5+N*DX
+ 2      CONTINUE
+        DO 1 I=1,100000
+          X=UTINVT(NSTRU,XSTRU,QSEP,RANGEN()*QSEP(NSTRU))
+          N=1+X/DX
+          IF ( N .LE. 1000 ) YAR(N)=YAR(N)+1.
+ 1      CONTINUE
+        CALL UTHIST(X1,X1+4,0.,5.,1000,XAR,YAR,'POC','LOGLOG'
+     *        ,'XAXIS X                         $                 '
+     *        ,'YAXIS COUNTS                    $                 '
+     *        ,'TITLE SEA QUARK STRUCTURE FUNCTION                ')
+ 3    CONTINUE
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION UTINVT(N,X,Q,YY)
+
+C-----------------------------------------------------------------------
+C  RETURNS X WITH Y=Q(X)
+C-----------------------------------------------------------------------
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CUTINV/  LUTINV
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      REAL Q(N),X(N)
+C-----------------------------------------------------------------------
+      IF ( Q(N) .EQ. 0. ) THEN
+        CALL UTSTOP('UTINVT: Q(N)=0. DIMENSIONS TOO BIG      ')
+      ENDIF
+      Y = YY
+      IF     ( Y .LT. 0. ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('UTINVT')
+          WRITE(IFCH,*)'*****  Y=',Y,' < 0'
+          CALL UTMSGF
+        ENDIF
+        Y=0.
+      ELSEIF ( Y .GT. Q(N) ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('UTINVT')
+          WRITE(IFCH,*)'*****  Y=',Y,' > ',Q(N)
+          CALL UTMSGF
+        ENDIF
+        Y=Q(N)
+      ENDIF
+      LU=1
+      LO=N
+ 1    LZ=(LO+LU)/2
+      IF     ( Q(LU).LE.Y .AND. Y.LE.Q(LZ) ) THEN
+        LO=LZ
+      ELSEIF ( Q(LZ).LT.Y .AND. Y.LE.Q(LO) ) THEN
+        LU=LZ
+      ELSE
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'Q(1),Y,Q(N):',Q(1),Y,Q(N)
+        WRITE(IFCH,*)'LU,LZ,LO:',LU,LZ,LO
+        WRITE(IFCH,*)'Q(LU),Q(LZ),Q(LO):',Q(LU),Q(LZ),Q(LO)
+        CALL UTSTOP('UTINVT: NO INTERVAL FOUND               ')
+      ENDIF
+      IF ( LO-LU .GE. 2 ) GOTO 1
+      IF ( LO .LE. LU ) THEN
+        CALL UTSTOP('UTINVT: LO.LE.LU                        ')
+      ENDIF
+      UTINVT=X(LU)+(Y-Q(LU))*(X(LO)-X(LU))/(Q(LO)-Q(LU))
+      LUTINV=LU
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTKSIX(SIX,KMAX)
+
+C-----------------------------------------------------------------------
+C  RETURNS KMAX FOR SIX
+C-----------------------------------------------------------------------
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      REAL SIX(NSI,NSIX)
+C-----------------------------------------------------------------------
+      DO 10 K=0,NSIX-1
+        KMAX=K
+        SIXSQR=0.
+        DO 20 I=1,NSI
+          SIXSQR=SIXSQR+SIX(I,K+1)**2
+20      CONTINUE
+        IF ( SIXSQR .LE. 1.E-5 ) RETURN
+10    CONTINUE
+      CALL UTSTOP('UTKSIX: DIMENSION NSIX TOO SMALL        ')
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTKSTR(STR,KMAX)
+
+C-----------------------------------------------------------------------
+C  RETURNS KMAX FOR STR
+C-----------------------------------------------------------------------
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      REAL STR(NSI,NSIX+1)
+C-----------------------------------------------------------------------
+      DO 10 K=0,NSIX
+        KMAX=K
+        STRSQR=0.
+        DO 20 I=1,NSI
+          STRSQR=STRSQR+STR(I,K+1)**2
+20      CONTINUE
+        IF ( STRSQR .LE. 1.E-5 ) RETURN
+10    CONTINUE
+      CALL UTSTOP('UTKSTR: DIMENSION NSIX TOO SMALL        ')
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTLOBO(ISIG,P1,P2,P3,P4,P5,X1,X2,X3,X4)
+
+C-----------------------------------------------------------------------
+C  PERFORMS A LORENTZ BOOST
+C-----------------------------------------------------------------------
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      REAL BETA(4),Z(4)
+C-----------------------------------------------------------------------
+      IF ( P5 .LE. 0. ) THEN
+        CALL UTMSG('UTLOBO')
+        WRITE(IFCH,*)'*****  MASS <= 0.'
+        WRITE(IFCH,*)'P(5): ',P1,P2,P3,P4,P5
+        CALL UTMSGF
+        CALL UTSTOP('UTLOBO: MASS <= 0.                      ')
+      ENDIF
+      Z(1)=X1
+      Z(2)=X2
+      Z(3)=X3
+      Z(4)=X4
+      BETA(1)=-P1/P5
+      BETA(2)=-P2/P5
+      BETA(3)=-P3/P5
+      BETA(4)= P4/P5
+      BP=ISIG*(Z(1)*BETA(1)+Z(2)*BETA(2)+Z(3)*BETA(3))
+      AUXIL= ISIG*Z(4)+ISIG*BP/(BETA(4)+1.)
+      Z(1)=Z(1)+BETA(1)*AUXIL
+      Z(2)=Z(2)+BETA(2)*AUXIL
+      Z(3)=Z(3)+BETA(3)*AUXIL
+      Z(4)=BETA(4)*Z(4)+BP
+      X1=Z(1)
+      X2=Z(2)
+      X3=Z(3)
+      X4=Z(4)
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTLOB2(ISIG,P1,P2,P3,P4,P5,X1,X2,X3,X4)
+
+C-----------------------------------------------------------------------
+C  PERFORMS A LORENTZ BOOST, DOUBLE PREC.
+C-----------------------------------------------------------------------
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      DOUBLE PRECISION BETA(4),BP,DAUXIL,PP,P1,P2,P3,P4,P5,P5I
+     *                ,XX0,X1,X10,X2,X20,X3,X30,X4,X4X,X40,Z(4)
+C-----------------------------------------------------------------------
+      IF ( ISH .GE. 90 ) THEN
+        IF ( ISH .GE. 93 ) THEN
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,101)SNGL(X1),SNGL(X2),SNGL(X3),SNGL(X4)
+     *                  ,SNGL(X4**2-X3**2-X2**2-X1**2)
+101       FORMAT(' UTLOB2:',F9.5,4F13.5)
+        ENDIF
+        PP=P4**2-P3**2-P2**2-P1**2
+        IF ( ABS(PP-P5**2) .GT. 1.D-3*P4**2   .AND.
+     *       ABS(PP-P5**2) .GT. 1.D-3        ) THEN
+          CALL UTMSG('UTLOB2')
+          WRITE(IFCH,*)'*****  P**2 .NE. P5**2'
+          WRITE(IFCH,*)'P**2,P5**2: ',PP,P5**2
+          WRITE(IFCH,*)'P: ',P1,P2,P3,P4,P5
+          CALL UTMSGF
+        ENDIF
+        X10=X1
+        X20=X2
+        X30=X3
+        X40=X4
+      ENDIF
+      XX0=X4**2-X3**2-X2**2-X1**2
+      IF ( P5 .LE. 0.D0 ) THEN
+        CALL UTMSG('UTLOB2')
+        WRITE(IFCH,*)'*****  P5 NEGATIVE.'
+        WRITE(IFCH,*)'P(5): ',P1,P2,P3,P4,P5
+        CALL UTMSGF
+        CALL UTSTOP('UTLOB2: P5 NEGATIVE.                    ')
+      ENDIF
+      Z(1)=X1
+      Z(2)=X2
+      Z(3)=X3
+      Z(4)=X4
+      P5I=1.D0/P5
+      BETA(4)= P5I*P4
+      BETA(1)=-P5I*P1
+      BETA(2)=-P5I*P2
+      BETA(3)=-P5I*P3
+      BP=ISIG*( BETA(1)*Z(1)+BETA(2)*Z(2)+BETA(3)*Z(3) )
+      DAUXIL = ISIG*( Z(4) + BP/(BETA(4)+1.D0) )
+      Z(1)=Z(1)+BETA(1)*DAUXIL
+      Z(2)=Z(2)+BETA(2)*DAUXIL
+      Z(3)=Z(3)+BETA(3)*DAUXIL
+      Z(4)=BETA(4)*Z(4)+BP
+      X1=Z(1)
+      X2=Z(2)
+      X3=Z(3)
+      X4=Z(4)
+      IF ( ISH .GE. 93 )
+     *        WRITE(IFCH,101)SNGL(X1),SNGL(X2),SNGL(X3),SNGL(X4)
+     *                      ,SNGL(X4**2-X3**2-X2**2-X1**2)
+      X4X=X4
+      X4=SQRT(XX0+X1**2+X2**2+X3**2)
+      IF ( ISH .GE. 90 ) THEN
+        IF ( ISH .GE. 93 ) THEN
+          WRITE(IFCH,101)SNGL(X1),SNGL(X2),SNGL(X3),SNGL(X4)
+     *                ,SNGL(X4**2-X3**2-X2**2-X1**2)
+          WRITE(IFCH,*)' '
+        ENDIF
+        IF ( ABS(X4-X4X) .GT. 1.D-2*ABS(X4)    .AND.
+     *       ABS(X4-X4X) .GT. 1.D-2        )   THEN
+          CALL UTMSG('UTLOB2')
+          WRITE(IFCH,*)'*****  X**2_INI .NE. X**2_FIN.'
+          WRITE(IFCH,*)'X1 X2 X3 X4 X**2 (INITIAL/FINAL/CORRECTED):'
+          WRITE(IFCH,101)SNGL(X10),SNGL(X20),SNGL(X30),SNGL(X40)
+     *                  ,SNGL(X40**2-X30**2-X20**2-X10**2)
+          WRITE(IFCH,101)SNGL(X1),SNGL(X2),SNGL(X3),SNGL(X4X)
+     *                  ,SNGL(X4X**2-X3**2-X2**2-X1**2)
+          WRITE(IFCH,101)SNGL(X1),SNGL(X2),SNGL(X3),SNGL(X4)
+     *                  ,SNGL(X4**2-X3**2-X2**2-X1**2)
+          CALL UTMSGF
+        ENDIF
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTLOC(AR,N,A,L)
+
+C-----------------------------------------------------------------------
+      REAL AR(N)
+C-----------------------------------------------------------------------
+      DO 1 I=1,N
+        IF ( A .LT. AR(I) ) THEN
+          L=I-1
+          RETURN
+        ENDIF
+ 1    CONTINUE
+      L=N
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTLOW(CONE)
+
+C-----------------------------------------------------------------------
+C  CONVERTS LOWER CASE CHARACTERS TO UPPER CASE CHARACTERS
+C-----------------------------------------------------------------------
+      CHARACTER*1 CONE
+C-----------------------------------------------------------------------
+      IF     ( CONE .EQ. 'a' ) THEN
+        CONE='A'
+      ELSEIF ( CONE .EQ. 'b' ) THEN
+        CONE='B'
+      ELSEIF ( CONE .EQ. 'c' ) THEN
+        CONE='C'
+      ELSEIF ( CONE .EQ. 'd' ) THEN
+        CONE='D'
+      ELSEIF ( CONE .EQ. 'e' ) THEN
+        CONE='E'
+      ELSEIF ( CONE .EQ. 'f' ) THEN
+        CONE='F'
+      ELSEIF ( CONE .EQ. 'g' ) THEN
+        CONE='G'
+      ELSEIF ( CONE .EQ. 'h' ) THEN
+        CONE='H'
+      ELSEIF ( CONE .EQ. 'i' ) THEN
+        CONE='I'
+      ELSEIF ( CONE .EQ. 'j' ) THEN
+        CONE='J'
+      ELSEIF ( CONE .EQ. 'k' ) THEN
+        CONE='K'
+      ELSEIF ( CONE .EQ. 'l' ) THEN
+        CONE='L'
+      ELSEIF ( CONE .EQ. 'm' ) THEN
+        CONE='M'
+      ELSEIF ( CONE .EQ. 'n' ) THEN
+        CONE='N'
+      ELSEIF ( CONE .EQ. 'o' ) THEN
+        CONE='O'
+      ELSEIF ( CONE .EQ. 'p' ) THEN
+        CONE='P'
+      ELSEIF ( CONE .EQ. 'q' ) THEN
+        CONE='Q'
+      ELSEIF ( CONE .EQ. 'r' ) THEN
+        CONE='R'
+      ELSEIF ( CONE .EQ. 's' ) THEN
+        CONE='S'
+      ELSEIF ( CONE .EQ. 't' ) THEN
+        CONE='T'
+      ELSEIF ( CONE .EQ. 'u' ) THEN
+        CONE='U'
+      ELSEIF ( CONE .EQ. 'v' ) THEN
+        CONE='V'
+      ELSEIF ( CONE .EQ. 'w' ) THEN
+        CONE='W'
+      ELSEIF ( CONE .EQ. 'x' ) THEN
+        CONE='X'
+      ELSEIF ( CONE .EQ. 'y' ) THEN
+        CONE='Y'
+      ELSEIF ( CONE .EQ. 'z' ) THEN
+        CONE='Z'
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTLOW6(CSIX)
+
+C-----------------------------------------------------------------------
+      CHARACTER CSIX*6
+C-----------------------------------------------------------------------
+      DO 1 I=1,6
+        CALL UTLOW(CSIX(I:I))
+ 1    CONTINUE
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTMSG(TXT)
+
+C-----------------------------------------------------------------------
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      DOUBLE PRECISION SEEDC,SEEDI
+      COMMON /CSEED/   SEEDC,SEEDI
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      CHARACTER*6      TXT
+C-----------------------------------------------------------------------
+      IMSG=IMSG+1
+      IF ( ISH.NE.90 .OR. ISHSUB.NE.0 ) WRITE(IFCH,*)' '
+      WRITE(IFCH,*)('-',J=1,77)
+      WRITE(IFCH,100)TXT,NREVT+1,IPAGE,SEEDC
+100   FORMAT(1X,'***** MSG FROM ',A6,'.   EPS:',I7,I5,2X,D23.17)
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTMSGF
+
+C-----------------------------------------------------------------------
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+C-----------------------------------------------------------------------
+      IF ( ISH.EQ.90 .AND. ISHSUB.EQ.0 ) RETURN
+      WRITE(IFCH,*)('-',J=1,77)
+      WRITE(IFCH,*)' '
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTOVEL
+
+C----------------------------------------------------------------------
+C  FILLS ARRAY OVEL(1+I,1+J) CONTAINING THE LOGARITHM (LN) OF
+C    I_OVER_J:
+C  OVEL(1+I,1+J)=LOG(I!/J!/(J-I)!)      I>=0 J>=0
+C----------------------------------------------------------------------
+      PARAMETER (IOVMAX=100)
+      PARAMETER (JOVMAX=100)
+      COMMON /COVEL/   OVEL(1+IOVMAX,1+JOVMAX)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+C----------------------------------------------------------------------
+      DO 1 I=0,IOVMAX
+        OVEL(1+I,1)=0.
+        OVEL(1+I,1+I)=0.
+ 1    CONTINUE
+      DO 2 J=1,JOVMAX-1
+        DO 3 I=J+1,IOVMAX
+          OVEL(1+I,1+J)=OVEL(1+I,J)+LOG((I-J+1.)/J)
+ 3      CONTINUE
+ 2    CONTINUE
+
+      IF ( ISH .GE. 90 ) THEN
+        DO 5 J=1,49
+          DO 5 I=J+1,50
+            RELERR=ABS((EXP(OVEL(1+I,1+J))
+     *           -EXP(OVEL(I,J))-EXP(OVEL(I,1+J)))/EXP(OVEL(1+I,1+J)))
+            IF ( RELERR .GT. 1.E-4 ) THEN
+              CALL UTMSG('UTOVEL')
+              WRITE(IFCH,*)'*****  OVEL(,) VIOLATES RECURRENCE RELATION'
+              WRITE(IFCH,*)EXP(OVEL(1+I,1+J))
+     *                    ,EXP(OVEL(I,J))+EXP(OVEL(I,1+J))
+              CALL UTMSGF
+            ENDIF
+ 5      CONTINUE
+
+        IF ( ISH .GE. 95 ) THEN
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,*)'   EXP( OVEL(1+I,1+J) )'
+          WRITE(IFCH,*)' '
+          DO 6 I=0,15
+            WRITE(IFCH,*)(EXP( OVEL(1+I,1+J) ),J=0,MIN(4,I))
+ 6        CONTINUE
+        ENDIF
+      ENDIF
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTPAGE
+
+C-----------------------------------------------------------------------
+C  INCREASES IPAGE BY 1, CHANGES ISH
+C-----------------------------------------------------------------------
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CISHI/   ISHI
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+C-----------------------------------------------------------------------
+      IPAGE=IPAGE+1
+      IF ( IPAGI .LE. 0 ) RETURN
+      IF ( IPAGE .EQ. 1 ) ISHI=ISH
+      ISH=0
+      IF ( IPAGE.GE.IPAGI/10000.AND.IPAGE.LE.MOD(IPAGI,10000) ) ISH=ISHI
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTPART
+
+C----------------------------------------------------------------------
+C  FILLS ARRAY PARTX(K,N) CONTAINING THE NUMBER
+C    OF PARTITIONS OF N INTO AT MOST K INTEGERS (K>=1 N>=1)  .
+C  FILLS ARRAY PART(K,N) CONTAINING  THE NUMBER
+C    OF PARTITIONS OF N INTO K INTEGERS (K>=1 N>=1)  .
+C  FILLS ARRAY IPART(N,J) CONTAINING THE PARTITIONS OF N.
+C----------------------------------------------------------------------
+      PARAMETER (NQUAX=12)
+      PARAMETER (JPAMAX=NQUAX*NQUAX*NQUAX)
+      PARAMETER (KPAMAX=NQUAX)
+      COMMON /CPART/   PART(KPAMAX,NQUAX)
+      COMMON /CPARTA/  PARTA(NQUAX),IPART(NQUAX,JPAMAX)
+      COMMON /CPARTX/  PARTX(KPAMAX,NQUAX)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      INTEGER ISWAP(JPAMAX)
+C----------------------------------------------------------------------
+      WRITE(IFMT,*)'EXECUTE SR UTPART ...'
+      DO 10 N=1,NQUAX
+        PARTX(1,N)=1.
+        PART(1,N)=1.
+        DO 10 J=1,JPAMAX
+          IPART(N,J)=0
+10    CONTINUE
+
+      DO 1 K=2,KPAMAX
+        DO 2 N=1,NQUAX
+          U=0.
+          DO 3 I=0,N/K
+            IF ( N-I*K .EQ. 0 ) THEN
+              U=U+1.
+            ELSE
+              U=U+PARTX(K-1,N-I*K)
+            ENDIF
+ 3        CONTINUE
+          PARTX(K,N)=U
+ 2      CONTINUE
+ 1    CONTINUE
+      DO 7 N=1,NQUAX
+        PARTA(N)=PART(1,N)
+        DO 7 K=2,KPAMAX
+          PART(K,N)=PARTX(K,N)-PARTX(K-1,N)
+          PARTA(N)=PARTA(N)+PART(K,N)
+ 7    CONTINUE
+
+      IF ( ISH .GE. 93 ) THEN
+121     FORMAT(1X,79A1)
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,121)('-',IC=1,79)
+        WRITE(IFCH,*)'   PARTITIONS OF N INTO AT MOST K INTEGERS'
+        WRITE(IFCH,121)('-',IC=1,79)
+        WRITE(IFCH,101)((K),K=1,10),KPAMAX
+101     FORMAT(9X,'K =',10I5,3X,I5)
+        WRITE(IFCH,121)('-',IC=1,79)
+        DO 8 N=1,NQUAX
+          WRITE(IFCH,100)N,(NINT(PARTX(K,N)),K=1,10),NINT(PARTA(N))
+100       FORMAT(3X,'N = ',I2,3X,10I5,3X,I5)
+ 8      CONTINUE
+      ENDIF
+
+C  N=1
+C  ---
+      IPART(1,1)=-1
+      IPART(1,2)=-1
+      IPART(1,3)=1
+
+C  N>1
+C  ---
+      DO 11 N=2,NQUAX
+        WRITE(IFMT,*)'SR UTPART: N=',N
+        IF ( ISH .GE. 95 ) THEN
+          WRITE(IFCH,*)' '
+          WRITE(IFCH,*)'N=',N
+        ENDIF
+        IPART(N,1)=-1
+        IPART(N,2)=-1
+        IPART(N,3)=N
+        II=3
+
+C  N=N1+N2, MULTIPLY PARTITIONS OF N1 AND N2
+C  -----------------------------------------
+        DO 12 N1=1,N/2
+          N2=N-N1
+          IF ( ISH .GE. 95 ) THEN
+            WRITE(IFCH,*)' '
+            WRITE(IFCH,*)'N1,N2=',N1,N2
+          ENDIF
+          K1MAX=-IPART(N1,1)
+          K2MAX=-IPART(N2,1)
+          IF ( K1MAX .LT. 0  .OR.  K2MAX .LT. 0 ) THEN
+            CALL UTSTOP('UTPART: KIMAX NEGATIVE                  ')
+          ENDIF
+          J1=2
+          DO 13 K1=1,K1MAX
+            L1=-IPART(N1,J1)
+            IF ( L1 .LT. 0 ) THEN
+              CALL UTSTOP('UTPART: L1 NEGATIVE (1)                 ')
+            ENDIF
+            J2=2
+            DO 15 K2=1,K2MAX
+              L2=-IPART(N2,J2)
+              IF ( L2 .LT. 0 ) THEN
+                CALL UTSTOP('UTPART: L2 NEGATIVE (1)                 ')
+              ENDIF
+
+              IPART(N,1)=IPART(N,1)-1
+              II=II+1
+              IF ( II .GT. JPAMAX ) GOTO 1000
+              IPART(N,II)=-L1-L2
+              II0=II+1
+              DO 17 I1=1,L1
+                II=II+1
+                IF ( II .GT. JPAMAX ) GOTO 1000
+                IPART(N,II)=IPART(N1,J1+I1)
+17            CONTINUE
+              DO 18 I2=1,L2
+                II=II+1
+                IF ( II .GT. JPAMAX ) GOTO 1000
+                IPART(N,II)=IPART(N2,J2+I2)
+18            CONTINUE
+
+              IF ( ISH .GE. 95 ) THEN
+                WRITE(IFCH,*)' '
+                WRITE(IFCH,*)'K1,K2=',K1,K2
+                WRITE(IFCH,103)N,-IPART(N,1),NINT(PARTA(N))
+103             FORMAT(/3X,'N = ',I2,'   P(N) = ',I4
+     *                                    ,'   P0(N) = ',I4/)
+                JY=2
+                DO 29 KY=1,-IPART(N,1)
+                  LY=-IPART(N,JY)
+                  WRITE(IFCH,102)KY,LY,(IPART(N,I)
+     *                                        ,I=JY+1,JY+MIN(20,LY))
+102               FORMAT(3X,I2,3X,I2,3X,20I3)
+                  JY=JY+LY+1
+29              CONTINUE
+              ENDIF
+
+              IPRI=0
+              DO 19 I=II0,II-1
+                DO 19 J=I+1,II
+                  IF ( IPART(N,I) .LT. IPART(N,J) ) THEN
+                    IPRI=1
+                    ISTI=IPART(N,I)
+                    IPART(N,I)=IPART(N,J)
+                    IPART(N,J)=ISTI
+                  ENDIF
+19            CONTINUE
+              IF ( IPRI.EQ.1 .AND. ISH.GE.95 ) THEN
+                WRITE(IFCH,*)' '
+                WRITE(IFCH,*)'SEQUENCE CHANGED'
+              ENDIF
+
+              JX=2
+              DO 28 KX=1,-IPART(N,1)-1
+                LX=-IPART(N,JX)
+                IF ( LX .LT. 0 ) THEN
+                 CALL UTSTOP('UTPART: LX NEGATIVE                     ')
+                ENDIF
+                IF ( LX .EQ. L1+L2 ) THEN
+                  DO 22 L=1,LX
+                    IF ( IPART(N,JX+L) .NE. IPART(N,II0-1+L) ) GOTO 23
+22                CONTINUE
+                  IF ( ISH .GE. 95 ) THEN
+                    WRITE(IFCH,*)' '
+                    WRITE(IFCH,*)'EXISTS ALREADY'
+                  ENDIF
+                  IPRI=1
+                  DO 33 I=II0-1,II
+                    IPART(N,I)=0
+33                CONTINUE
+                  II=II0-2
+                  IPART(N,1)=IPART(N,1)+1
+                  GOTO 30
+23                CONTINUE
+                ENDIF
+                JX=JX+LX+1
+28            CONTINUE
+30            CONTINUE
+
+              IF ( IPRI.EQ.1 .AND. ISH.GE.95 ) THEN
+                WRITE(IFCH,103)N,-IPART(N,1),NINT(PARTA(N))
+                JY=2
+                DO 32 KY=1,-IPART(N,1)
+                  LY=-IPART(N,JY)
+                  WRITE(IFCH,102)KY,LY,(IPART(N,I)
+     *                                ,I=JY+1,JY+MIN(20,LY))
+                  JY=JY+LY+1
+32              CONTINUE
+              ENDIF
+
+              J2=J2+L2+1
+15          CONTINUE
+            J1=J1+L1+1
+13        CONTINUE
+12      CONTINUE
+
+C  ORDERING
+C  --------
+        KM=-IPART(N,1)
+        IF ( KM .LT. 0 ) THEN
+          CALL UTSTOP('UTPART: KM NEGATIVE                     ')
+        ENDIF
+        J1=2
+        DO 20 K1=1,KM-1
+          L1=-IPART(N,J1)
+          IF ( L1 .LT. 0 ) THEN
+            CALL UTSTOP('UTPART: L1 NEGATIVE (2)                 ')
+          ENDIF
+          J2=2
+          DO 21 K2=1,KM
+            L2=-IPART(N,J2)
+            IF ( L2 .LT. 0 ) THEN
+              CALL UTSTOP('UTPART: L2 NEGATIVE (2)                 ')
+            ENDIF
+            IF ( K2 .LE. K1 ) GOTO 21
+            IF ( L1 .GT. L2 ) THEN
+              DO 24 L=1,L2+1
+                ISWAP(L)=IPART(N,J2-1+L)
+24            CONTINUE
+              DO 25 L=1,J2-J1
+                I=J2-L
+                IPART(N,I+L2+1)=IPART(N,I)
+25            CONTINUE
+              DO 26 L=1,L2+1
+                IPART(N,J1-1+L)=ISWAP(L)
+26            CONTINUE
+              L1=-IPART(N,J1)
+              IF ( L1 .LT. 0 ) THEN
+                CALL UTSTOP('UTPART: L1 NEGATIVE (2)                 ')
+              ENDIF
+              IF ( ISH .GE. 95 ) THEN
+                WRITE(IFCH,*)' '
+                WRITE(IFCH,*)'ORDER CHANGED.      K1,K2=',K1,K2
+                WRITE(IFCH,103)N,-IPART(N,1),NINT(PARTA(N))
+                JY=2
+                DO 31 KY=1,-IPART(N,1)
+                  LY=-IPART(N,JY)
+                  WRITE(IFCH,102)KY,LY,(IPART(N,I)
+     *                                ,I=JY+1,JY+MIN(20,LY))
+                  JY=JY+LY+1
+31              CONTINUE
+              ENDIF
+            ENDIF
+            J2=J2+L2+1
+21        CONTINUE
+          J1=J1+L1+1
+20      CONTINUE
+
+        IF ( ISH.GE.93 .AND. N.LE.8 ) THEN
+          WRITE(IFCH,113)('-',IC=1,79),N,-IPART(N,1),('-',IC=1,79)
+113       FORMAT(/1X,79A1/7X,'N = ',I2,'   --->   ',I4,
+     *                           ' PARTITIONS'/1X,79A1)
+          JY=2
+          DO 27 KY=1,-IPART(N,1)
+            LY=-IPART(N,JY)
+            WRITE(IFCH,112)KY,(IPART(N,I),I=JY+1,JY+MIN(20,LY))
+112         FORMAT(2X,I2,'. PARTITION:',3X,20I3)
+            JY=JY+LY+1
+27        CONTINUE
+        ENDIF
+        IF ( -IPART(N,1) .NE. NINT(PARTA(N)) ) THEN
+          CALL UTSTOP('UTPART: # OF PARTITIONS WRONG           ')
+        ENDIF
+11    CONTINUE
+
+      RETURN
+
+1000  WRITE(IFCH,*)' '
+      WRITE(IFCH,*)('*',J=1,79)
+      WRITE(IFCH,*)'***** N=',N
+      WRITE(IFCH,*)'***** JPAMAX=',JPAMAX
+      WRITE(IFCH,*)('*',J=1,79)
+      CALL UTSTOP('UTPART: DIMENSION JPAMAX TOO SMALL.     ')
+      RETURN
+      END
+C=======================================================================
+
+      FUNCTION UTPCM(A,B,C)
+
+C-----------------------------------------------------------------------
+C  CALCULATES CM MOMENTUM FOR A-->B+C
+C-----------------------------------------------------------------------
+      VAL=(A**2-B**2-C**2)**2-(2.*B*C)**2
+      IF ( VAL.LT.0. .AND. VAL.GT.-1.E-4 ) THEN
+        UTPCM=0.
+        RETURN
+      ENDIF
+      UTPCM=SQRT(VAL)/(2.*A)
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTQUAF(FU,N,X,Q,X0,X1,X2,X3)
+
+C-----------------------------------------------------------------------
+C  RETURNS Q(I) = INTEGRAL (X(1)->X(I)) FU(X) DX
+C  ACCELERATED VERSION BY      D. HECK, KFK    SEPT 20, 1993
+C-----------------------------------------------------------------------
+      PARAMETER (M=10)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      REAL Q(N),X(N)
+C-----------------------------------------------------------------------
+      QUOT = 1./FLOAT(M-1)
+      IF ( ISH .GE. 90 ) THEN
+        IF ( X1.LT.X0 .OR. X2.LT.X1 .OR. X3.LT.X2 ) THEN
+          CALL UTMSG('UTQUAF')
+          WRITE(IFCH,*)'   XI=',X0,X1,X2,X3
+          CALL UTMSGF
+        ENDIF
+      ENDIF
+      I1 = N/3
+      I2 = 2*N/3
+      FAC1 = (X1-X0)/FLOAT(I1-1)
+      DO 11 I=1,I1-1
+        X(I)=X0+(I-1.)*FAC1
+ 11   CONTINUE
+      FAC2 = (X2-X1)/FLOAT(I2-I1)
+      DO 12 I=I1,I2-1
+        X(I)=X1+FLOAT(I-I1)*FAC2
+ 12   CONTINUE
+      FAC3 = (X3-X2)/FLOAT(N-I2)
+      DO 13 I=I2,N
+        X(I)=X2+FLOAT(I-I2)*FAC3
+ 13   CONTINUE
+      Q(1) = 0.
+      Z = X(1)
+      AUXIL = FU(Z)
+      DO 2 I=2,N
+        FACT = (X(I) - Z) * QUOT
+        UTQUAD = AUXIL*0.5
+        DO 3 K=2,M-1
+          Z=Z+FACT
+          UTQUAD=FU(Z)+UTQUAD
+ 3      CONTINUE
+        Z = X(I)
+        AUXIL = FU(Z)
+        Q(I)=(AUXIL*0.5+UTQUAD)*FACT+Q(I-1)
+ 2    CONTINUE
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTQZ(N,X,Q1,Q2,X0,X1,X2,X3)
+
+C-----------------------------------------------------------------------
+C  RETURNS Q1(I) = INTEGRAL (X(1)->X(I)) FU1(X) DX  (SEA QUARK STRUCT)
+C  RETURNS Q2(I) = INTEGRAL (X(1)->X(I)) FU2(X) DX  (VAL QUARK STRUCT)
+C  ACCELERATED VERSION BY      D. HECK, KFK    OCT  20, 1993
+C-----------------------------------------------------------------------
+      PARAMETER (M=10)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CIPIO/   IPIO
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      REAL Q1(N),Q2(N),X(N)
+C-----------------------------------------------------------------------
+      IF ( ISH .GE. 90 ) THEN
+        IF ( X1.LT.X0 .OR. X2.LT.X1 .OR. X3.LT.X2 ) THEN
+          CALL UTMSG('UTQZ  ')
+          WRITE(IFCH,*)'   XI=',X0,X1,X2,X3
+          CALL UTMSGF
+        ENDIF
+      ENDIF
+      I1 = N/3
+      I2 = 2*N/3
+      FAC1 = (X1-X0)/FLOAT(I1-1)
+      DO 11 I=1,I1-1
+        X(I)=(I-1.)*FAC1+X0
+ 11   CONTINUE
+      FAC2 = (X2-X1)/FLOAT(I2-I1)
+      DO 12 I=I1,I2-1
+        X(I)=FLOAT(I-I1)*FAC2 +X1
+ 12   CONTINUE
+      FAC3 = (X3-X2)/FLOAT(N-I2)
+      DO 13 I=I2,N
+        X(I)=MIN( FLOAT(I-I2)*FAC3 +X2, 0.999999 )
+ 13   CONTINUE
+      XCUT2 = XCUT**2
+      QUOT= 1./FLOAT(M-1)
+      Q1(1)=0.
+      Q2(1)=0.
+      Z = X(1)
+      DENOMI= 1./SQRT(Z**2 + XCUT2)
+      IF ( IPIO .EQ. 0 ) THEN
+        AUXIL1 = (1.-Z)**8.05 *DENOMI
+        IF ( Z .NE. 0. ) THEN
+          AUXIL2 = (1.-Z)**3.46 * Z**.419
+     *                  * (2.74793064*Z+0.62452969)* DENOMI
+        ELSE
+          AUXIL2 = 0.
+        ENDIF
+        DO 3 I=2,N
+          FACT = (X(I) - Z) * QUOT
+          UTQUA1 = 0.5*AUXIL1
+          UTQUA2 = 0.5*AUXIL2
+          DO 2 K=2,M-1
+            Z=Z+FACT
+            DENOMI = 1./SQRT(Z**2 + XCUT2)
+            UTQUA1 = DENOMI * (1.-Z)**8.05 + UTQUA1
+            IF ( Z .NE. 0. ) THEN
+              UTQUA2 = (1.-Z)**3.46 * Z**.419
+     *                  * (2.74793064*Z+0.62452969) * DENOMI + UTQUA2
+            ENDIF
+ 2        CONTINUE
+          Z=X(I)
+          DENOMI = 1./SQRT(Z**2 + XCUT2)
+          AUXIL1 = DENOMI * (1.-Z)**8.05
+          Q1(I) = (AUXIL1*0.5+UTQUA1) * FACT*1.265 + Q1(I-1)
+          IF ( Z .NE. 0. ) THEN
+            AUXIL2=(1.-Z)**3.46 * Z**.419 * (2.74793064*Z+0.62452969)
+     *                  * DENOMI
+            Q2(I) = (AUXIL2*0.5+UTQUA2) * FACT + Q2(I-1)
+          ELSE
+            AUXIL2 = 0.
+            Q2(I) = FACT* UTQUA2 + Q2(I-1)
+          ENDIF
+ 3      CONTINUE
+
+      ELSE
+        CUTLOG= LOG(XCUT)
+        A0 = -5. + 6.6666667*XCUT2 - 0.53333333*XCUT2**2
+        BA0= A0*XCUT
+        A1 = 5. - 1.875*XCUT2
+        QB = 1. - A1*XCUT2
+        A2 = -3.3333333 +0.26666667*XCUT2
+        A3 = 1.25
+        A4 = -0.2
+        AUXIL1 = (1.-Z)**5.0 * DENOMI
+        IF ( Z .NE. 0. ) THEN
+          AUXIL2 = (1.-Z)**0.7 * Z**0.4 * DENOMI
+        ELSE
+          AUXIL2 = 0.
+        ENDIF
+        DO 5 I=2,N
+          FACT = (X(I) - Z) * QUOT
+          UTQUA1 = 0.5*AUXIL1
+          UTQUA2 = 0.5*AUXIL2
+          DO 4 K=2,M-1
+            Z=Z+FACT
+            DENOMI = 1./SQRT(Z**2 + XCUT2)
+            UTQUA1 = DENOMI * (1.-Z)**5.0 + UTQUA1
+            IF ( Z .NE. 0. ) THEN
+              UTQUA2 = DENOMI * (1.-Z)**0.7 * Z**0.4 + UTQUA2
+            ENDIF
+ 4        CONTINUE
+          Z = X(I)
+          ROOT = SQRT(Z**2 + XCUT2)
+          DENOMI= 1./ROOT
+CC        AUXIL1=DENOMI * (1.-Z)**5.0
+CC        Q1(I) = (AUXIL1*0.5+UTQUA1) * FACT*0.9 + Q1(I-1)
+          Q1(I) = ( QB * ( LOG(Z+ROOT) - CUTLOG ) - BA0
+     *           + ROOT * (A0+Z*(A1+Z*(A2+Z*(A3+Z*A4)))) ) *0.9
+          IF ( Z .NE. 0. ) THEN
+            AUXIL2 = DENOMI * (1.-Z)**0.7 * Z**0.4
+            Q2(I) = (AUXIL2*0.5+UTQUA2) * FACT*0.1730725 + Q2(I-1)
+          ELSE
+            AUXIL2 = 0.
+            Q2(I) = FACT*0.1730725 * UTQUA2 + Q2(I-1)
+          ENDIF
+ 5      CONTINUE
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTREMB(PROJ,TARG,II)
+
+C-----------------------------------------------------------------------
+C  REMEMBERS NEVT,NSTR,NPTL,PROJ,TARG
+C-----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXSTR=3000)
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CREMB/   PROJRE(2,NSI,NHA),TARGRE(2,NSI,NHA)
+     *                ,NEVTRE(2),NPTLRE(2),NSTRRE(2)
+      COMMON /CSTR/    PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
+     *                ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
+      REAL PROJ(NSI,NHA),TARG(NSI,NHA)
+C-----------------------------------------------------------------------
+      NEVTRE(II)=NEVT
+      NSTRRE(II)=NSTR
+      NPTLRE(II)=NPTL
+      DO 56 M=1,NHA
+        SM=0.
+        DO 57 N=1,NSI
+          PROJRE(II,N,M)=PROJ(N,M)
+          SM=SM+PROJ(N,M)**2
+57      CONTINUE
+        IF ( M.GE.3 .AND. SM.LT.1.E-5 ) GOTO 58
+56    CONTINUE
+58    CONTINUE
+      DO 53 M=1,NHA
+        SM=0.
+        DO 54 N=1,NSI
+          TARGRE(II,N,M)=TARG(N,M)
+          SM=SM+TARG(N,M)**2
+54      CONTINUE
+        IF ( M.GE.3 .AND. SM.LT.1.E-5 ) GOTO 55
+53    CONTINUE
+55    CONTINUE
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTREPL(I,J)
+
+C-----------------------------------------------------------------------
+C  I IS REPLACED BY J IN /CPTL/
+C-----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /C2PTL/   AMIPTL(MXPTL),RADPTL(MXPTL),IAAPTL(MXPTL)
+C-----------------------------------------------------------------------
+      AMIPTL(I)  =AMIPTL(J)
+      IAAPTL(I)  =IAAPTL(J)
+      IBPTL(1,I) =IBPTL(1,J)
+      IBPTL(2,I) =IBPTL(2,J)
+      IBPTL(3,I) =IBPTL(3,J)
+      IBPTL(4,I) =IBPTL(4,J)
+      ICLPTL(I)  =ICLPTL(J)
+      IDPTL(I)   =IDPTL(J)
+      IFRPTL(1,I)=IFRPTL(1,J)
+      IFRPTL(2,I)=IFRPTL(2,J)
+      IORPTL(I)  =IORPTL(J)
+      ISTPTL(I)  =ISTPTL(J)
+      JORPTL(I)  =JORPTL(J)
+      NQJPTL(I)  =NQJPTL(J)
+      DO 1 K=1,5
+        PPTL(K,I)=PPTL(K,J)
+ 1    CONTINUE
+      RADPTL(I)  =RADPTL(J)
+      TIVPTL(1,I)=TIVPTL(1,J)
+      TIVPTL(2,I)=TIVPTL(2,J)
+      XORPTL(1,I)=XORPTL(1,J)
+      XORPTL(2,I)=XORPTL(2,J)
+      XORPTL(3,I)=XORPTL(3,J)
+      XORPTL(4,I)=XORPTL(4,J)
+
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTRESM(ICP1,ICP2,ICM1,ICM2,AMP,IDPR,IADJ,IRETEN)
+
+C-----------------------------------------------------------------------
+      PARAMETER (NFLAV=6)
+      INTEGER ICM(2),ICP(2),JCM(NFLAV,2),JCP(NFLAV,2)
+C-----------------------------------------------------------------------
+      ICM(1)=ICM1
+      ICM(2)=ICM2
+      ICP(1)=ICP1
+      ICP(2)=ICP2
+      CALL IDDECO(ICM,JCM)
+      CALL IDDECO(ICP,JCP)
+      DO 37 NF=1,NFLAV
+        JCP(NF,1)=JCP(NF,1)+JCM(NF,1)
+        JCP(NF,2)=JCP(NF,2)+JCM(NF,2)
+37    CONTINUE
+      CALL IDENCO(JCP,ICP,IRETEN)
+      IDP=IDTRA(ICP,0,0,3)
+      CALL IDRES(IDP,AMP,IDPR,IADJ)
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTREST(PROJ,TARG,II)
+
+C-----------------------------------------------------------------------
+      PARAMETER (NSI=6)
+      PARAMETER (NSIX=40)
+      PARAMETER (NHA=NSIX+2)
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /CREMB/   PROJRE(2,NSI,NHA),TARGRE(2,NSI,NHA)
+     *                ,NEVTRE(2),NPTLRE(2),NSTRRE(2)
+      REAL PROJ(NSI,NHA),TARG(NSI,NHA)
+C-----------------------------------------------------------------------
+      NEVT=NEVTRE(II)
+      NSTR=NSTRRE(II)
+      NPTL=NPTLRE(II)
+      DO 66 M=1,NHA
+        SM=0.
+        DO 67 N=1,NSI
+          PROJ(N,M)=PROJRE(II,N,M)
+          SM=SM+PROJRE(II,N,M)**2
+67      CONTINUE
+        IF ( M.GE.3 .AND. SM.LT.1.E-5 ) GOTO 68
+66    CONTINUE
+68    CONTINUE
+      DO 63 M=1,NHA
+        SM=0.
+        DO 64 N=1,NSI
+          TARG(N,M)=TARGRE(II,N,M)
+          SM=SM+TARGRE(II,N,M)**2
+64      CONTINUE
+        IF ( M.GE.3 .AND. SM.LT.1.E-5 ) GOTO 65
+63    CONTINUE
+65    CONTINUE
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTROTA(ISIG,AX,AY,AZ,X,Y,Z)
+
+C-----------------------------------------------------------------------
+C  PERFORMS A ROTATION
+C-----------------------------------------------------------------------
+      IF ( AZ .GE. 0. ) THEN
+        RX=AX
+        RY=AY
+        RZ=AZ
+      ELSE
+        RX=-AX
+        RY=-AY
+        RZ=-AZ
+      ENDIF
+      ALP=SIGN( ABS(UTACOS(RZ/SQRT(RZ**2+RY**2))), RY )
+      BET=SIGN( ABS(UTACOS(SQRT(RZ**2+RY**2)/SQRT(RZ**2+RY**2+RX**2)))
+     *                                                        , RX )
+      COSA=COS(ALP)
+      SINA=SIN(ALP)
+      COSB=COS(BET)
+      SINB=SIN(BET)
+      IF     ( ISIG .GT. 0 ) THEN
+        XS=X*COSB-Y*SINA*SINB-Z*COSA*SINB
+        YS=       Y*COSA     -Z*SINA
+        ZS=X*SINB+Y*SINA*COSB+Z*COSA*COSB
+      ELSEIF ( ISIG .LT. 0 ) THEN
+        XS= X*COSB            +Z*SINB
+        YS=-X*SINB*SINA+Y*COSA+Z*COSB*SINA
+        ZS=-X*SINB*COSA-Y*SINA+Z*COSB*COSA
+      ENDIF
+      X=XS
+      Y=YS
+      Z=ZS
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTROT2(ISIG,AX,AY,AZ,X,Y,Z)
+
+C-----------------------------------------------------------------------
+C  PERFORMS A ROTATION, DOUBLE PREC.
+C-----------------------------------------------------------------------
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+
+      DOUBLE PRECISION ALP,AUXIL1,AUXIL2,AX,AY,AZ,BET,COSA,COSB
+     *                ,RX,RY,RZ,SINA,SINB,X,XS,Y,YS,Z,ZS
+C-----------------------------------------------------------------------
+      IF ( AX**2.EQ.0.D0 .AND. AY**2.EQ.0.D0 .AND. AZ**2.EQ.0.D0 ) THEN
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,*)'AX**2,AY**2,AZ**2:',AX**2,AY**2,AZ**2
+        WRITE(IFCH,*)'AX,AY,AZ:',AX,AY,AZ
+        CALL UTSTOP('UTROT2: ZERO VECTOR.                    ')
+      ENDIF
+      IF ( AZ .GE. 0.D0 ) THEN
+        RX=AX
+        RY=AY
+        RZ=AZ
+      ELSE
+        RX=-AX
+        RY=-AY
+        RZ=-AZ
+      ENDIF
+      AUXIL1 = RZ**2+RY**2
+      IF ( AUXIL1 .NE. 0.D0 ) THEN
+        AUXIL2 = SQRT(AUXIL1)
+        ALP=SIGN( ABS(ACOS(RZ/AUXIL2)), RY )
+        BET=SIGN( ABS(ACOS( AUXIL2/SQRT(AUXIL1+RX**2) )), RX )
+        COSA=COS(ALP)
+        SINA=SIN(ALP)
+        COSB=COS(BET)
+        SINB=SIN(BET)
+      ELSE
+        COSA=0.D0
+        COSB=0.D0
+        SINA=1.D0
+        SINB=1.D0
+      ENDIF
+      IF     ( ISIG .GT. 0 ) THEN
+        XS=X*COSB-Y*SINA*SINB-Z*COSA*SINB
+        YS=       Y*COSA     -Z*SINA
+        ZS=X*SINB+Y*SINA*COSB+Z*COSA*COSB
+      ELSEIF ( ISIG .LT. 0 ) THEN
+        XS= X*COSB            +Z*SINB
+        YS=-X*SINB*SINA+Y*COSA+Z*COSB*SINA
+        ZS=-X*SINB*COSA-Y*SINA+Z*COSB*COSA
+      ENDIF
+      X=XS
+      Y=YS
+      Z=ZS
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTSTOP(TEXT)
+
+C-----------------------------------------------------------------------
+C  RETURNS ERROR MESSAGE AND STOPS EXECUTION
+C-----------------------------------------------------------------------
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      DOUBLE PRECISION SEEDC,SEEDI
+      COMMON /CSEED/   SEEDC,SEEDI
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /NEVNT/   NEVNT
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      CHARACTER STAR*1,TEXT*40
+      DATA STAR/'*'/
+C-----------------------------------------------------------------------
+      DO 1 I=1,2
+        IF ( I .EQ. 1 ) THEN
+          IFI=IFCH
+        ELSE
+          IFI=IFMT
+        ENDIF
+        WRITE(IFI,*)' '
+        WRITE(IFI,*)(STAR,J=1,77)
+        WRITE(IFI,*)'***** STOP IN ',TEXT
+CDH     WRITE(IFI,*)'***** CURRENT EVENT NUMBER: ',NREVT+1
+        WRITE(IFI,*)'***** CURRENT EVENT NUMBER: ',NEVNT
+        WRITE(IFI,*)'***** CURRENT PAGE NUMBER: ',IPAGE
+        WRITE(IFI,*)'***** INITIAL SEED FOR CURRENT EVENT:',SEEDI
+        WRITE(IFI,*)'***** RANDOM CALLS FOR CURRENT EVENT:',SEEDC
+        WRITE(IFI,*)(STAR,J=1,77)
+        WRITE(IFI,*)' '
+ 1    CONTINUE
+      STOP
+      END
+C=======================================================================
+
+      SUBROUTINE UTTAIN(I,X,Y,Z,T,N,IOPT)
+
+C-----------------------------------------------------------------------
+C  RETURNS INTERSECTION OF PTL-I-TRAJECTORY WITH TAUS-LINE.
+C  N=0 IF OK, N=1 IF PTL LIVES LATER, N=2 IF EARLIER,
+C    N=9 IF TIV1>TIV2, N=3,4,5 ELSE.
+C  IOPT=0: FORMATION TIME CONSIDERED, IOPT=1 IF NOT
+C-----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      DOUBLE PRECISION DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /CTTAUS/  DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      DOUBLE PRECISION DD,DERR,TI1,TI2,TT,VV,VVP,VVT,XO3,XO4,ZZ,ZZA
+      DATA DERR/1.D-2/
+C-----------------------------------------------------------------------
+      XO4=XORPTL(4,I)
+      IF     ( IOPT .EQ. 0 ) THEN
+        TI1=TIVPTL(1,I)
+      ELSEIF ( IOPT .EQ. 1 ) THEN
+        TI1=XO4
+      ENDIF
+      TI2=TIVPTL(2,I)
+
+      IF ( TI1 .GT. TI2 ) GOTO 1009
+      PPT4I = 1./PPTL(4,I)
+      VV=PPTL(3,I)*PPT4I
+      XO3=XORPTL(3,I)
+
+      ZZ=XO3+(TI2-XO4)*VV
+      IF ( TTAUS .LE. 0.D0 ) THEN
+        TZ=TTAUS
+      ELSE
+        IF     ( ZZ .LE. ZZT ) THEN
+          TZ=TTT+(ZZ-ZZT)*ZZT/TTT
+        ELSEIF ( ZZ .GE. ZZP ) THEN
+          TZ=TTP+(ZZ-ZZP)*ZZP/TTP
+        ELSE
+          IF ( TTAUS .GE. AINFIN ) THEN
+            TZ=TTAUS
+            IF ( ISH .GE. 90 ) THEN
+              CALL UTMSG('UTTAIN')
+              WRITE(IFCH,*)'*****  LARGE TTAUS; SET TZ=TTAUS'
+              WRITE(IFCH,*)'TTAUS=',TTAUS,'ZZ=',ZZ
+              CALL UTMSGF
+            ENDIF
+          ELSE
+C*DH        TZ=SQRT(TTAUS**2+ZZ**2)
+            IF ( TI2 .LT. 0.D0 ) GOTO 1002
+            IF ( TTAUS**2+ZZ**2 .GE. TI2**2 ) GOTO 1002
+            GOTO 1006
+          ENDIF
+        ENDIF
+      ENDIF
+      IF ( TZ .GE. TI2 ) GOTO 1002
+
+ 1006 ZZ=XO3+(TI1-XO4)*VV
+      IF ( TTAUS .GT. 0.D0 ) THEN
+        IF     ( ZZ .LE. ZZT ) THEN
+          TZ=TTT+(ZZ-ZZT)*ZZT/TTT
+        ELSEIF ( ZZ .GE. ZZP ) THEN
+          TZ=TTP+(ZZ-ZZP)*ZZP/TTP
+        ELSE
+          IF ( TTAUS .GE. AINFIN ) THEN
+            TZ=TTAUS
+            IF ( ISH .GE. 90 ) THEN
+              CALL UTMSG('UTTAIN')
+              WRITE(IFCH,*)'*****  LARGE TTAUS; SET TZ=TTAUS'
+              WRITE(IFCH,*)'TTAUS=',TTAUS,'ZZ=',ZZ
+              CALL UTMSGF
+            ENDIF
+          ELSE
+C*DH        TZ=SQRT(TTAUS**2+ZZ**2)
+            IF ( TI1 .LT. 0.D0 ) GOTO 1007
+            IF ( TTAUS**2+ZZ**2 .LE. TI1**2 ) GOTO 1001
+            GOTO 1007
+          ENDIF
+        ENDIF
+      ENDIF
+      IF ( TZ .LE. TI1 ) GOTO 1001
+
+ 1007 IF ( TTAUS .LE. 0.D0 ) THEN
+        TT=TTAUS
+        ZZ=XO3+(TT-XO4)*VV
+        IF ( TT.LT.TI1 .OR. TT.GE.TI2 ) GOTO 1031
+      ELSE
+        ZZA=XO3-XO4*VV
+        VVT=ZZT/TTT
+        TT=(TTT+(ZZA-ZZT)*VVT)/(1.D0-VV*VVT)
+        ZZ=XO3+(TT-XO4)*VV
+        IF ( ZZ .LE. ZZT ) THEN
+          IF ( TT.LT.TI1 .OR. TT.GE.TI2 ) GOTO 1032
+          GOTO 1000
+        ENDIF
+        VVP=ZZP/TTP
+        TT=(TTP+(ZZA-ZZP)*VVP)/(1.D0-VV*VVP)
+        ZZ=XO3+(TT-XO4)*VV
+        IF ( ZZ .GE. ZZP ) THEN
+          IF ( TT.LT.TI1 .OR. TT.GE.TI2 ) GOTO 1033
+          GOTO 1000
+        ENDIF
+        DD=1.D0-VV**2
+        IF ( DD .EQ. 0.D0 ) THEN
+          TT=-VV*(TTAUS**2+ZZA**2)*0.5D0/ZZA
+        ELSE
+          TT=(ZZA*VV+SQRT(ZZA**2+TTAUS**2*DD))/DD
+        ENDIF
+        ZZ=XO3+(TT-XO4)*VV
+        IF ( TT.LT.TI1 .OR. TT.GE.TI2 ) GOTO 1034
+        IF ( TT .LT. 0.D0 ) GOTO 1035
+        IF ( ZZ.LE.ZZT .OR. ZZ.GE.ZZP ) GOTO 1004
+        IF ( ABS(TTAUS**2-(TT+ZZ)*(TT-ZZ))
+     *                         .GT. DERR*TTAUS**2 ) GOTO 1005
+      ENDIF
+
+ 1000 N=0
+ 1011 T=TT
+      Z=ZZ
+      X=XORPTL(1,I)+(T-XO4)*PPTL(1,I)*PPT4I
+      Y=XORPTL(2,I)+(T-XO4)*PPTL(2,I)*PPT4I
+      RETURN
+ 1001 N=1
+      RETURN
+ 1002 N=2
+      RETURN
+ 1031 N=31
+      GOTO 1003
+
+ 1032 N=32
+      GOTO 1003
+ 1033 N=33
+      GOTO 1003
+ 1034 N=34
+ 1003 IF ( ABS(TT-TI1) .LE. DERR*ABS(TT) ) GOTO 1000
+      IF ( ABS(TT-TI2) .LE. DERR*ABS(TT) ) GOTO 1000
+      IF ( ISH .GE. 90 ) THEN
+        CALL UTMSG('UTTAIN')
+        WRITE(IFCH,*)'*****  TI1 < TT < TI2   NOT FULFILLED - ',N
+        WRITE(IFCH,*)SNGL(TI1),SNGL(TT),SNGL(TI2)
+        CALL UTMSGF
+      ENDIF
+      GOTO 1011
+ 1035 CONTINUE
+      IF ( ISH .GE. 90 ) THEN
+        CALL UTMSG('UTTAIN')
+        WRITE(IFCH,*)'*****  TT < 0     ( ',TT,' )'
+        WRITE(IFCH,*)'VV,DD:',VV,DD
+        WRITE(IFCH,*)'ZZA,TTAUS:',ZZA,TTAUS
+        CALL UTMSGF
+      ENDIF
+      GOTO 1011
+ 1004 N=4
+      IF ( ABS(ZZ-ZZT) .LE. DERR*ABS(ZZ) ) GOTO 1000
+      IF ( ABS(ZZ-ZZP) .LE. DERR*ABS(ZZ) ) GOTO 1000
+      IF ( ISH .GE. 90 ) THEN
+        CALL UTMSG('UTTAIN')
+        WRITE(IFCH,*)'*****  ZZT < ZZ < ZZP   NOT FULFILLED'
+        WRITE(IFCH,*)SNGL(ZZT),SNGL(ZZ),SNGL(ZZP)
+        CALL UTMSGF
+      ENDIF
+      GOTO 1011
+ 1005 N=5
+      IF ( ABS(TTAUS**2-(TT+ZZ)*(TT-ZZ)) .LE. DERR ) GOTO 1000
+      IF ( ISH .GE. 90 ) THEN
+        CALL UTMSG('UTTAIN')
+        WRITE(IFCH,*)'*****  TTAUS**2 .NE. (TT+ZZ)*(TT-ZZ)'
+        WRITE(IFCH,*)SNGL(TTAUS**2),SNGL((TT+ZZ)*(TT-ZZ))
+        CALL UTMSGF
+      ENDIF
+      GOTO 1011
+ 1009 N=9
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTTAIX(I,TAU,ZOR,TOR,Z,T)
+
+C-----------------------------------------------------------------------
+C  RETURNS INTERSECTION Z,T OF PTL-I-TRAJECTORY WITH HYPERBOLA H.
+C     H: (T-TOR)**2-(Z-ZOR)**2=TAU**2 .
+C     ZOR, TOR DOUBLE PRECISION.
+C-----------------------------------------------------------------------
+      PARAMETER (MXPTL=70000)
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+
+      DOUBLE PRECISION CC,DD,DERR,TOR,TORS,TT,TTAU,VV,ZOR,ZORS,ZZ
+C-----------------------------------------------------------------------
+      DERR=1.D-3
+      TTAU=TAU
+      ZORS=XORPTL(3,I)-ZOR
+      TORS=XORPTL(4,I)-TOR
+      VV=PPTL(3,I)/PPTL(4,I)
+      IF ( ABS(VV) .GT. 1.D0 ) THEN
+        IF ( ISH.GE.90 .AND. ABS(VV).GT.1.001D0 ) THEN
+          CALL UTMSG('UTTAIX')
+          WRITE(IFCH,*)'*****  !V! > 1'
+          WRITE(IFCH,*)'V: ',VV
+          WRITE(IFCH,*)'P,E: ',PPTL(3,I),PPTL(4,I)
+          CALL UTMSGF
+        ENDIF
+        VV=SIGN(1.D0,VV)
+      ENDIF
+      CC=ZORS-TORS*VV
+      DD=1.D0-VV**2
+      IF     ( DD.EQ.0.D0 .AND. CC.EQ.0.D0 ) THEN
+        IF ( TAU .EQ. 0. ) THEN
+          TT=0.
+        ELSE
+          TT=AINFIN
+        ENDIF
+        ZZ=TT
+        GOTO 1000
+      ELSEIF ( DD .EQ. 0.D0 ) THEN
+        TT=-(TTAU**2+CC**2)*0.5D0/(CC*VV)
+      ELSEIF ( DD .LT. 1.D-8 ) THEN
+        TT=-(TTAU**2+CC**2)*0.5D0/(CC*VV)
+        IF(ISH.GE.90)THEN
+          CALL UTMSG('UTTAIX')
+          WRITE(IFCH,*)'*****  DD = ',DD,'    TREATED AS ZERO'
+          CALL UTMSGF
+        ENDIF
+      ELSE
+        TT=(CC*VV+SQRT(CC**2+TTAU**2*DD))/DD
+      ENDIF
+      ZZ=CC+TT*VV
+      IF ( ABS(TTAU**2-(TT+ZZ)*(TT-ZZ)) .GT. DERR*TTAU**2   .AND.
+     *     ABS(TTAU**2-(TT+ZZ)*(TT-ZZ)) .GT. DERR           .AND.
+     *     TORS**2-ZORS**2 .LT. 1.D6                 ) THEN
+        IF ( ISH .GE. 90 ) THEN
+          CALL UTMSG('UTTAIX')
+          WRITE(IFCH,*)'*****  TTAU**2 .NE. (TT+ZZ)*(TT-ZZ)'
+          WRITE(IFCH,*)SNGL(TTAU**2),SNGL((TT+ZZ)*(TT-ZZ))
+          WRITE(IFCH,*)'TAU,T,Z:'
+          WRITE(IFCH,*)TAU,TT,ZZ
+          WRITE(IFCH,*)'#,ID(PTL):',I,IDPTL(I)
+          WRITE(IFCH,*)'ZOR,TOR(STR):',ZOR,TOR
+          WRITE(IFCH,*)'ZORS,TORS,P,E(PTL):'
+          WRITE(IFCH,*)SNGL(ZORS),SNGL(TORS),PPTL(3,I),PPTL(4,I)
+          CALL UTMSGF
+        ENDIF
+      ENDIF
+1000  Z=ZZ+ZOR
+      T=TT+TOR
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTTAUS(Z,SZ)
+
+C-----------------------------------------------------------------------
+C  RETURNS INV Z-COORD SZ CORRESPONDING TO TTAUS AND Z.
+C-----------------------------------------------------------------------
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      DOUBLE PRECISION DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /CTTAUS/  DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      DOUBLE PRECISION ZZ
+C-----------------------------------------------------------------------
+      IF ( TTAUS .LE. 0.D0 ) THEN
+        SZ=Z
+        RETURN
+      ENDIF
+      ZZ=Z
+      IF     ( ZZ .LE. ZZT ) THEN
+        SZ=TTAUS*DETAT+(ZZ-ZZT)/TTAR
+      ELSEIF ( ZZ .GE. ZZP ) THEN
+        SZ=TTAUS*DETAP+(ZZ-ZZP)/TPRO
+      ELSE
+        IF ( SNGL(TTAUS) .GE. AINFIN ) THEN
+          SZ=0.
+          IF ( ISH .GE. 90 ) THEN
+            CALL UTMSG('UTTAUS')
+            WRITE(IFCH,*)'*****  LARGE TTAUS; SET TZ=TTAUS, SZ=0'
+            WRITE(IFCH,*)'TTAUS=',TTAUS,'ZZ=',ZZ
+            CALL UTMSGF
+          ENDIF
+        ELSE
+          TZ=SQRT(TTAUS**2+ZZ**2)
+          SZ=TTAUS*0.5D0*LOG((TZ+ZZ)/(TZ-ZZ))
+        ENDIF
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+
+      SUBROUTINE UTTAUT(Z,TZ)
+
+C-----------------------------------------------------------------------
+C  RETURNS TZ = TIME    CORRESPONDING TO TTAUS AND Z
+C-----------------------------------------------------------------------
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      DOUBLE PRECISION DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /CTTAUS/  DETAP,DETAT,TPRO,TTAR,TTAUS,TTP,TTT
+     *                ,ZPRO,ZTAR,ZZP,ZZT
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      DOUBLE PRECISION ZZ
+C-----------------------------------------------------------------------
+      ZZ=Z
+      IF     ( ZZ .LE. ZZT ) THEN
+        TZ=TTT+(ZZ-ZZT)*ZZT/TTT
+      ELSEIF ( ZZ .GE. ZZP ) THEN
+        TZ=TTP+(ZZ-ZZP)*ZZP/TTP
+      ELSE
+        IF ( TTAUS .GE. AINFIN ) THEN
+          TZ=TTAUS
+          IF ( ISH .GE. 90 ) THEN
+            CALL UTMSG('UTTAUT')
+            WRITE(IFCH,*)'*****  LARGE TTAUS; SET TZ=TTAUS'
+            WRITE(IFCH,*)'TTAUS=',TTAUS,'ZZ=',ZZ
+            CALL UTMSGF
+          ENDIF
+        ELSE
+          TZ=SQRT(TTAUS**2+ZZ**2)
+        ENDIF
+      ENDIF
+      RETURN
+      END
+C=======================================================================
+C
+C     SUBROUTINE UTTIMA(TEXT)
+C
+C-----------------------------------------------------------------------
+C  RETURNS TIME.
+C-----------------------------------------------------------------------
+C     COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+C     COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+C    *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+C    *                ,YHAHA,YMXIMI,YPJTL
+C    *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+C    *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+C    *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+C    *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+C    *                ,MODSHO,NDECAX,NDECAY,NEVENT
+C     CHARACTER*15 TEXT
+C-----------------------------------------------------------------------
+C     TIMAA=0.
+C     TIMA=0.
+C-C   CALL TIMAX(TIMAA)
+C-C   CALL TIMAD(TIMA)
+C     IF ( TEXT .EQ. '               ' ) RETURN
+C     IF ( ISH .GE. 91 ) WRITE(IFCH,*)' '
+C     WRITE(IFCH,100)TEXT,TIMA/5.,TIMAA/5.
+C     IF ( ISH .GE. 91 ) WRITE(IFCH,*)' '
+C100  FORMAT(1X,A15,5X,F12.5,5X,F12.5)
+C     RETURN
+C     END
+C=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
+C
+C     ENTRY UTTIMT
+C
+C-----------------------------------------------------------------------
+C-C   CALL TIMAST(1E10)
+C     RETURN
+C=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
+C
+C     ENTRY UTTIMX(TIMAAX)
+C
+C-----------------------------------------------------------------------
+C     TIMAAX=0.
+C-C   CALL TIMAX(TIMAAX)
+C     RETURN
+C     END
+C=======================================================================
+
+      SUBROUTINE UTTUCL
+
+C----------------------------------------------------------------------
+C  FILLS ARRAY TUCL(1+K,1+N) CONTAINING THE LOGARITHM (LN) OF
+C  THE NUMBER OF K-TUPELS N_I WITH SUM_I N_I = N:
+C    TUCL(1+K,1+N)=LOG((N+1)*(N+2)...*(N+K-1)/(K-1)!)  K>=0 N>=0 .
+C  DOUBLE PRECISION TUCL.
+C----------------------------------------------------------------------
+      PARAMETER (KTUMAX=100)
+      PARAMETER (NTUMAX=100)
+      DOUBLE PRECISION TUCL
+      COMMON /CTUCL/   TUCL(1+KTUMAX,1+NTUMAX)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+
+      DOUBLE PRECISION DD,RELERR
+C----------------------------------------------------------------------
+      TUCL(1,1)=-100.D0
+      TUCL(2,1)=0.D0
+      DO 7 K=2,KTUMAX
+        TUCL(1+K,1)=0.D0
+ 7    CONTINUE
+      DO 2 N=2,NTUMAX+1
+        TUCL(1,N)=-100.D0
+        TUCL(2,N)=0.D0
+        DO 1 K=2,KTUMAX
+          DD=(N+K-2.D0)/(K-1.D0)
+          TUCL(1+K,N)=TUCL(K,N)+LOG(DD)
+ 1      CONTINUE
+ 2    CONTINUE
+
+      IF ( ISH .GE. 93 ) THEN
+        DO 5 K=2,50
+          DO 4 N=1,50
+            RELERR=ABS((EXP(TUCL(1+K,1+N))-EXP(TUCL(1+K,N))
+     *                  -EXP(TUCL(K,1+N)))/EXP(TUCL(1+K,1+N)))
+            IF ( RELERR .GT. 1.D-4 ) THEN
+              CALL UTMSG('UTTUCL')
+              WRITE(IFCH,*)'*****  TUCL(,) VIOLATES RECURRENCE RELATION'
+              WRITE(IFCH,*)SNGL(EXP(TUCL(1+K,1+N)))
+     *                    ,SNGL(EXP(TUCL(1+K,N))+EXP(TUCL(K,1+N)))
+              CALL UTMSGF
+            ENDIF
+ 4        CONTINUE
+ 5      CONTINUE
+        WRITE(IFCH,*)' '
+        WRITE(IFCH,121)('-',IC=1,79)
+121     FORMAT(1X,79A1)
+        WRITE(IFCH,*)'   DEGENERACY OF ENERGY LEVELS OF K-DIMENSIONAL'
+     *              ,' OSCILLATOR'
+        WRITE(IFCH,121)('-',IC=1,79)
+        WRITE(IFCH,*)'   =='
+     *          ,'     NUMBER OF K-TUPELS OF LENGTH N (SUM_I N_I = N)'
+        WRITE(IFCH,121)('-',IC=1,79)
+        WRITE(IFCH,*)'   K:','   1','   2','   3','   4'
+        WRITE(IFCH,121)('-',IC=1,79)
+        DO 8 N=0,50
+          WRITE(IFCH,*)N,(SNGL(EXP( TUCL(1+K,1+N) )),K=1,4)
+ 8      CONTINUE
+      ENDIF
+
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/VENUSDAT
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/VENUSDAT	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/VENUSDAT	(revision 286)
@@ -0,0 +1,2050 @@
+     1  0.00000000E+00  0.00000000E+00  0.00000000E+00                          
+     2  1.70452541E-12  1.19787010E-06  5.63088827E-07                          
+     3  8.62876437E-12  9.86788291E-06  4.50457754E-06                          
+     4  2.72710743E-11  2.90643952E-05  1.30321933E-05                          
+     5  6.65795197E-11  5.40009882E-05  2.39042380E-05                          
+     6  1.38059120E-10  8.29189049E-05  3.63218455E-05                          
+     7  2.55771071E-10  1.15369075E-04  5.00806092E-05                          
+     8  4.36333747E-10  1.51136130E-04  6.50817721E-05                          
+     9  6.98921032E-10  1.90068467E-04  8.12559650E-05                          
+    10  1.06526388E-09  2.32044109E-04  9.85477334E-05                          
+    11  1.55964974E-09  2.76959607E-04  1.16910397E-04                          
+    12  2.20892160E-09  3.24724910E-04  1.36303618E-04                          
+    13  3.04247949E-09  3.75260503E-04  1.56692017E-04                          
+    14  4.09227907E-09  4.28495256E-04  1.78044143E-04                          
+    15  5.39283218E-09  4.84364989E-04  2.00331790E-04                          
+    16  6.98120650E-09  5.42811348E-04  2.23529444E-04                          
+    17  8.89702545E-09  6.03780923E-04  2.47613877E-04                          
+    18  1.11824684E-08  6.67224566E-04  2.72563812E-04                          
+    19  1.38822700E-08  7.33096812E-04  2.98359659E-04                          
+    20  1.70437208E-08  8.01355431E-04  3.24983296E-04                          
+    21  2.07166658E-08  8.71961028E-04  3.52417886E-04                          
+    22  2.49535060E-08  9.44876745E-04  3.80647736E-04                          
+    23  2.98091972E-08  1.02006797E-03  4.09658165E-04                          
+    24  3.53412498E-08  1.09750212E-03  4.39435396E-04                          
+    25  4.16097289E-08  1.17714842E-03  4.69966467E-04                          
+    26  4.86772543E-08  1.25897777E-03  5.01239150E-04                          
+    27  5.66089999E-08  1.34296254E-03  5.33241881E-04                          
+    28  6.54726940E-08  1.42907649E-03  5.65963707E-04                          
+    29  7.53386185E-08  1.51729464E-03  5.99394222E-04                          
+    30  8.62796091E-08  1.60759314E-03  6.33523531E-04                          
+    31  9.83710551E-08  1.69994922E-03  6.68342203E-04                          
+    32  1.11690899E-07  1.79434110E-03  7.03841238E-04                          
+    33  1.26319636E-07  1.89074787E-03  7.40012032E-04                          
+    34  1.42340316E-07  1.98914951E-03  7.76846349E-04                          
+    35  1.59838537E-07  2.08952677E-03  8.14336294E-04                          
+    36  1.78902455E-07  2.19186111E-03  8.52474291E-04                          
+    37  1.99622774E-07  2.29613472E-03  8.91253059E-04                          
+    38  2.22092752E-07  2.40233039E-03  9.30665594E-04                          
+    39  2.46408196E-07  2.51043154E-03  9.70705153E-04                          
+    40  2.72667467E-07  2.62042215E-03  1.01136524E-03                          
+    41  3.00971476E-07  2.73228672E-03  1.05263957E-03                          
+    42  3.31423683E-07  2.84601027E-03  1.09452210E-03                          
+    43  3.64130101E-07  2.96157827E-03  1.13700697E-03                          
+    44  3.99199292E-07  3.07897668E-03  1.18008852E-03                          
+    45  4.36742366E-07  3.19819184E-03  1.22376126E-03                          
+    46  4.76872985E-07  3.31921052E-03  1.26801988E-03                          
+    47  5.19707358E-07  3.44201986E-03  1.31285924E-03                          
+    48  5.65364245E-07  3.56660737E-03  1.35827434E-03                          
+    49  6.13964951E-07  3.69296090E-03  1.40426033E-03                          
+    50  6.65633332E-07  3.82106862E-03  1.45081250E-03                          
+    51  7.20495791E-07  3.95091904E-03  1.49792626E-03                          
+    52  7.78681277E-07  4.08250093E-03  1.54559718E-03                          
+    53  8.40321287E-07  4.21580339E-03  1.59382090E-03                          
+    54  9.05549863E-07  4.35081576E-03  1.64259323E-03                          
+    55  9.74503596E-07  4.48752765E-03  1.69191004E-03                          
+    56  1.04732162E-06  4.62592892E-03  1.74176732E-03                          
+    57  1.12414562E-06  4.76600966E-03  1.79216119E-03                          
+    58  1.20511981E-06  4.90776022E-03  1.84308782E-03                          
+    59  1.29039096E-06  5.05117114E-03  1.89454350E-03                          
+    60  1.38010840E-06  5.19623317E-03  1.94652461E-03                          
+    61  1.47442397E-06  5.34293729E-03  1.99902759E-03                          
+    62  1.57349208E-06  5.49127465E-03  2.05204898E-03                          
+    63  1.67746967E-06  5.64123659E-03  2.10558539E-03                          
+    64  1.78651622E-06  5.79281466E-03  2.15963353E-03                          
+    65  1.90079377E-06  5.94600054E-03  2.21419014E-03                          
+    66  2.02046687E-06  6.10078611E-03  2.26925205E-03                          
+    67  2.14570264E-06  6.25716340E-03  2.32481618E-03                          
+    68  2.27667072E-06  6.41512461E-03  2.38087947E-03                          
+    69  2.41354331E-06  6.57466206E-03  2.43743895E-03                          
+    70  2.55649513E-06  6.73576825E-03  2.49449171E-03                          
+    71  2.70570345E-06  6.89843581E-03  2.55203489E-03                          
+    72  2.86134807E-06  7.06265749E-03  2.61006569E-03                          
+    73  3.02361134E-06  7.22842620E-03  2.66858135E-03                          
+    74  3.19267814E-06  7.39573495E-03  2.72757919E-03                          
+    75  3.36873588E-06  7.56457689E-03  2.78705657E-03                          
+    76  3.55197451E-06  7.73494530E-03  2.84701087E-03                          
+    77  3.74258652E-06  7.90683354E-03  2.90743956E-03                          
+    78  3.94076694E-06  8.08023512E-03  2.96834014E-03                          
+    79  4.14671332E-06  8.25514364E-03  3.02971014E-03                          
+    80  4.36062575E-06  8.43155281E-03  3.09154715E-03                          
+    81  4.58270685E-06  8.60945644E-03  3.15384880E-03                          
+    82  4.81316179E-06  8.78884845E-03  3.21661275E-03                          
+    83  5.05219824E-06  8.96972284E-03  3.27983672E-03                          
+    84  5.30002643E-06  9.15207373E-03  3.34351844E-03                          
+    85  5.55685911E-06  9.33589530E-03  3.40765571E-03                          
+    86  5.82291156E-06  9.52118185E-03  3.47224633E-03                          
+    87  6.09840159E-06  9.70792773E-03  3.53728817E-03                          
+    88  6.38354953E-06  9.89612742E-03  3.60277910E-03                          
+    89  6.67857825E-06  1.00857754E-02  3.66871706E-03                          
+    90  6.98371315E-06  1.02768664E-02  3.73509999E-03                          
+    91  7.29918215E-06  1.04693950E-02  3.80192587E-03                          
+    92  7.62521569E-06  1.06633561E-02  3.86919273E-03                          
+    93  7.96204674E-06  1.08587444E-02  3.93689861E-03                          
+    94  8.30991080E-06  1.10555549E-02  4.00504158E-03                          
+    95  8.66904590E-06  1.12537826E-02  4.07361974E-03                          
+    96  9.03969257E-06  1.14534225E-02  4.14263122E-03                          
+    97  9.42209388E-06  1.16544698E-02  4.21207418E-03                          
+    98  9.81649542E-06  1.18569196E-02  4.28194679E-03                          
+    99  1.02231453E-05  1.20607671E-02  4.35224728E-03                          
+   100  1.06422942E-05  1.22660078E-02  4.42297387E-03                          
+   101  1.10741951E-05  1.24726370E-02  4.49412481E-03                          
+   102  1.15191039E-05  1.26806501E-02  4.56569839E-03                          
+   103  1.19772786E-05  1.28900426E-02  4.63769291E-03                          
+   104  1.24489800E-05  1.31008101E-02  4.71010670E-03                          
+   105  1.29344713E-05  1.33129482E-02  4.78293810E-03                          
+   106  1.34340183E-05  1.35264524E-02  4.85618549E-03                          
+   107  1.39478891E-05  1.37413186E-02  4.92984726E-03                          
+   108  1.44763545E-05  1.39575425E-02  5.00392181E-03                          
+   109  1.50196879E-05  1.41751198E-02  5.07840758E-03                          
+   110  1.55781650E-05  1.43940466E-02  5.15330302E-03                          
+   111  1.61520642E-05  1.46143186E-02  5.22860659E-03                          
+   112  1.67416661E-05  1.48359319E-02  5.30431680E-03                          
+   113  1.73472542E-05  1.50588825E-02  5.38043214E-03                          
+   114  1.79691143E-05  1.52831663E-02  5.45695115E-03                          
+   115  1.86075348E-05  1.55087795E-02  5.53387236E-03                          
+   116  1.92628064E-05  1.57357183E-02  5.61119433E-03                          
+   117  1.99352225E-05  1.59639787E-02  5.68891565E-03                          
+   118  2.06250791E-05  1.61935571E-02  5.76703491E-03                          
+   119  2.13326744E-05  1.64244497E-02  5.84555070E-03                          
+   120  2.20583093E-05  1.66566528E-02  5.92446167E-03                          
+   121  2.28022872E-05  1.68901628E-02  6.00376646E-03                          
+   122  2.35649140E-05  1.71249760E-02  6.08346371E-03                          
+   123  2.43464981E-05  1.73610889E-02  6.16355210E-03                          
+   124  2.51473502E-05  1.75984978E-02  6.24403033E-03                          
+   125  2.59677839E-05  1.78371994E-02  6.32489707E-03                          
+   126  2.68081150E-05  1.80771901E-02  6.40615106E-03                          
+   127  2.76686618E-05  1.83184666E-02  6.48779102E-03                          
+   128  2.85497452E-05  1.85610253E-02  6.56981569E-03                          
+   129  2.94516885E-05  1.88048630E-02  6.65222382E-03                          
+   130  3.03748178E-05  1.90499762E-02  6.73501419E-03                          
+   131  3.13194611E-05  1.92963618E-02  6.81818558E-03                          
+   132  3.22859496E-05  1.95440165E-02  6.90173677E-03                          
+   133  3.32746163E-05  1.97929369E-02  6.98566658E-03                          
+   134  3.42857973E-05  2.00431199E-02  7.06997382E-03                          
+   135  3.53198307E-05  2.02945624E-02  7.15465732E-03                          
+   136  3.63770575E-05  2.05472611E-02  7.23971592E-03                          
+   137  3.74578208E-05  2.08012130E-02  7.32514847E-03                          
+   138  3.85624665E-05  2.10564150E-02  7.41095385E-03                          
+   139  3.96913429E-05  2.13128640E-02  7.49713091E-03                          
+   140  4.08448006E-05  2.15705570E-02  7.58367856E-03                          
+   141  4.20231929E-05  2.18294909E-02  7.67059568E-03                          
+   142  4.32268756E-05  2.20896629E-02  7.75788118E-03                          
+   143  4.44562067E-05  2.23510700E-02  7.84553398E-03                          
+   144  4.57115470E-05  2.26137091E-02  7.93355302E-03                          
+   145  4.69932597E-05  2.28775775E-02  8.02193720E-03                          
+   146  4.83017103E-05  2.31426723E-02  8.11068550E-03                          
+   147  4.96372670E-05  2.34089906E-02  8.19979686E-03                          
+   148  5.10003004E-05  2.36765296E-02  8.28927026E-03                          
+   149  5.23911834E-05  2.39452865E-02  8.37910466E-03                          
+   150  5.38102917E-05  2.42152585E-02  8.46929905E-03                          
+   151  5.52580032E-05  2.44864429E-02  8.55985242E-03                          
+   152  5.67346984E-05  2.47588369E-02  8.65076379E-03                          
+   153  5.82407603E-05  2.50324379E-02  8.74203214E-03                          
+   154  5.97765742E-05  2.53072430E-02  8.83365652E-03                          
+   155  6.13425281E-05  2.55832498E-02  8.92563593E-03                          
+   156  6.29390122E-05  2.58604556E-02  9.01796943E-03                          
+   157  6.45664195E-05  2.61388576E-02  9.11065604E-03                          
+   158  6.62251451E-05  2.64184534E-02  9.20369484E-03                          
+   159  6.79155868E-05  2.66992403E-02  9.29708487E-03                          
+   160  6.96381448E-05  2.69812158E-02  9.39082519E-03                          
+   161  7.13932217E-05  2.72643774E-02  9.48491490E-03                          
+   162  7.31812227E-05  2.75487225E-02  9.57935307E-03                          
+   163  7.50025554E-05  2.78342486E-02  9.67413879E-03                          
+   164  7.68576297E-05  2.81209533E-02  9.76927116E-03                          
+   165  7.87468582E-05  2.84088341E-02  9.86474928E-03                          
+   166  8.06706558E-05  2.86978885E-02  9.96057227E-03                          
+   167  8.26294398E-05  2.89881142E-02  1.00567392E-02                          
+   168  8.46236302E-05  2.92795087E-02  1.01532493E-02                          
+   169  8.66536492E-05  2.95720696E-02  1.02501016E-02                          
+   170  8.87199216E-05  2.98657946E-02  1.03472954E-02                          
+   171  9.08228746E-05  3.01606814E-02  1.04448296E-02                          
+   172  9.29629377E-05  3.04567274E-02  1.05427035E-02                          
+   173  9.51405431E-05  3.07539306E-02  1.06409162E-02                          
+   174  9.73561253E-05  3.10522885E-02  1.07394670E-02                          
+   175  9.96101213E-05  3.13517989E-02  1.08383549E-02                          
+   176  1.01902970E-04  3.16524595E-02  1.09375792E-02                          
+   177  1.04235115E-04  3.19542680E-02  1.10371390E-02                          
+   178  1.06606998E-04  3.22572222E-02  1.11370336E-02                          
+   179  1.09019068E-04  3.25613200E-02  1.12372620E-02                          
+   180  1.11471772E-04  3.28665590E-02  1.13378236E-02                          
+   181  1.13965564E-04  3.31729371E-02  1.14387175E-02                          
+   182  1.16500896E-04  3.34804521E-02  1.15399429E-02                          
+   183  1.19078225E-04  3.37891018E-02  1.16414991E-02                          
+   184  1.21698011E-04  3.40988842E-02  1.17433853E-02                          
+   185  1.24360714E-04  3.44097970E-02  1.18456007E-02                          
+   186  1.27066798E-04  3.47218382E-02  1.19481445E-02                          
+   187  1.29816730E-04  3.50350057E-02  1.20510160E-02                          
+   188  1.32610977E-04  3.53492973E-02  1.21542145E-02                          
+   189  1.35450012E-04  3.56647110E-02  1.22577391E-02                          
+   190  1.38334306E-04  3.59812447E-02  1.23615891E-02                          
+   191  1.41264337E-04  3.62988963E-02  1.24657638E-02                          
+   192  1.44240583E-04  3.66176639E-02  1.25702625E-02                          
+   193  1.47263524E-04  3.69375454E-02  1.26750844E-02                          
+   194  1.50333643E-04  3.72585388E-02  1.27802288E-02                          
+   195  1.53451425E-04  3.75806421E-02  1.28856950E-02                          
+   196  1.56617360E-04  3.79038533E-02  1.29914822E-02                          
+   197  1.59831936E-04  3.82281705E-02  1.30975898E-02                          
+   198  1.63095648E-04  3.85535916E-02  1.32040170E-02                          
+   199  1.66408989E-04  3.88801148E-02  1.33107632E-02                          
+   200  1.69772458E-04  3.92077380E-02  1.34178276E-02                          
+   201  1.73186554E-04  3.95364594E-02  1.35252095E-02                          
+   202  1.76651780E-04  3.98662771E-02  1.36329083E-02                          
+   203  1.80168641E-04  4.01971891E-02  1.37409233E-02                          
+   204  1.83737643E-04  4.05291936E-02  1.38492537E-02                          
+   205  1.87359297E-04  4.08622886E-02  1.39578990E-02                          
+   206  1.91034114E-04  4.11964724E-02  1.40668584E-02                          
+   207  1.94762608E-04  4.15317430E-02  1.41761313E-02                          
+   208  1.98545298E-04  4.18680987E-02  1.42857169E-02                          
+   209  2.02382700E-04  4.22055375E-02  1.43956147E-02                          
+   210  2.06275338E-04  4.25440577E-02  1.45058240E-02                          
+   211  2.10223734E-04  4.28836574E-02  1.46163441E-02                          
+   212  2.14228416E-04  4.32243348E-02  1.47271744E-02                          
+   213  2.18289912E-04  4.35660882E-02  1.48383143E-02                          
+   214  2.22408753E-04  4.39089158E-02  1.49497630E-02                          
+   215  2.26585473E-04  4.42528157E-02  1.50615200E-02                          
+   216  2.30820606E-04  4.45977862E-02  1.51735846E-02                          
+   217  2.35114693E-04  4.49438257E-02  1.52859562E-02                          
+   218  2.39468272E-04  4.52909322E-02  1.53986341E-02                          
+   219  2.43881887E-04  4.56391042E-02  1.55116178E-02                          
+   220  2.48356084E-04  4.59883398E-02  1.56249066E-02                          
+   221  2.52891410E-04  4.63386374E-02  1.57384999E-02                          
+   222  2.57488415E-04  4.66899952E-02  1.58523971E-02                          
+   223  2.62147652E-04  4.70424116E-02  1.59665976E-02                          
+   224  2.66869676E-04  4.73958848E-02  1.60811007E-02                          
+   225  2.71655043E-04  4.77504133E-02  1.61959059E-02                          
+   226  2.76504313E-04  4.81059953E-02  1.63110126E-02                          
+   227  2.81418048E-04  4.84626291E-02  1.64264201E-02                          
+   228  2.86396812E-04  4.88203132E-02  1.65421279E-02                          
+   229  2.91441172E-04  4.91790458E-02  1.66581354E-02                          
+   230  2.96551698E-04  4.95388254E-02  1.67744419E-02                          
+   231  3.01728959E-04  4.98996503E-02  1.68910470E-02                          
+   232  3.06973530E-04  5.02615188E-02  1.70079500E-02                          
+   233  3.12285988E-04  5.06244295E-02  1.71251503E-02                          
+   234  3.17666909E-04  5.09883807E-02  1.72426474E-02                          
+   235  3.23116875E-04  5.13533708E-02  1.73604407E-02                          
+   236  3.28636470E-04  5.17193981E-02  1.74785297E-02                          
+   237  3.34226278E-04  5.20864613E-02  1.75969136E-02                          
+   238  3.39886887E-04  5.24545586E-02  1.77155921E-02                          
+   239  3.45618887E-04  5.28236885E-02  1.78345645E-02                          
+   240  3.51422871E-04  5.31938495E-02  1.79538303E-02                          
+   241  3.57299434E-04  5.35650400E-02  1.80733889E-02                          
+   242  3.63249172E-04  5.39372585E-02  1.81932397E-02                          
+   243  3.69272685E-04  5.43105035E-02  1.83133823E-02                          
+   244  3.75370574E-04  5.46847734E-02  1.84338160E-02                          
+   245  3.81543444E-04  5.50600667E-02  1.85545404E-02                          
+   246  3.87791902E-04  5.54363819E-02  1.86755548E-02                          
+   247  3.94116555E-04  5.58137176E-02  1.87968587E-02                          
+   248  4.00518015E-04  5.61920722E-02  1.89184516E-02                          
+   249  4.06996896E-04  5.65714442E-02  1.90403330E-02                          
+   250  4.13553812E-04  5.69518322E-02  1.91625024E-02                          
+   251  4.20189382E-04  5.73332347E-02  1.92849591E-02                          
+   252  4.26904227E-04  5.77156502E-02  1.94077026E-02                          
+   253  4.33698968E-04  5.80990773E-02  1.95307325E-02                          
+   254  4.40574231E-04  5.84835146E-02  1.96540483E-02                          
+   255  4.47530643E-04  5.88689605E-02  1.97776493E-02                          
+   256  4.54568833E-04  5.92554137E-02  1.99015351E-02                          
+   257  4.61689434E-04  5.96428727E-02  2.00257051E-02                          
+   258  4.68893079E-04  6.00313361E-02  2.01501589E-02                          
+   259  4.76180405E-04  6.04208025E-02  2.02748959E-02                          
+   260  4.83552051E-04  6.08112704E-02  2.03999157E-02                          
+   261  4.91008658E-04  6.12027386E-02  2.05252176E-02                          
+   262  4.98550868E-04  6.15952055E-02  2.06508013E-02                          
+   263  5.06179328E-04  6.19886698E-02  2.07766662E-02                          
+   264  5.13894686E-04  6.23831301E-02  2.09028117E-02                          
+   265  5.21697591E-04  6.27785850E-02  2.10292375E-02                          
+   266  5.29588697E-04  6.31750332E-02  2.11559430E-02                          
+   267  5.37568657E-04  6.35724732E-02  2.12829277E-02                          
+   268  5.45638129E-04  6.39709038E-02  2.14101911E-02                          
+   269  5.53797773E-04  6.43703236E-02  2.15377327E-02                          
+   270  5.62048249E-04  6.47707312E-02  2.16655521E-02                          
+   271  5.70390222E-04  6.51721253E-02  2.17936487E-02                          
+   272  5.78824357E-04  6.55745045E-02  2.19220221E-02                          
+   273  5.87351324E-04  6.59778676E-02  2.20506717E-02                          
+   274  5.95971793E-04  6.63822131E-02  2.21795972E-02                          
+   275  6.04686436E-04  6.67875399E-02  2.23087980E-02                          
+   276  6.13495930E-04  6.71938465E-02  2.24382736E-02                          
+   277  6.22400951E-04  6.76011317E-02  2.25680236E-02                          
+   278  6.31402178E-04  6.80093941E-02  2.26980475E-02                          
+   279  6.40500295E-04  6.84186325E-02  2.28283448E-02                          
+   280  6.49695985E-04  6.88288456E-02  2.29589151E-02                          
+   281  6.58989935E-04  6.92400321E-02  2.30897578E-02                          
+   282  6.68382834E-04  6.96521906E-02  2.32208726E-02                          
+   283  6.77875371E-04  7.00653201E-02  2.33522589E-02                          
+   284  6.87468242E-04  7.04794190E-02  2.34839163E-02                          
+   285  6.97162140E-04  7.08944863E-02  2.36158443E-02                          
+   286  7.06957764E-04  7.13105207E-02  2.37480425E-02                          
+   287  7.16855813E-04  7.17275208E-02  2.38805104E-02                          
+   288  7.26856990E-04  7.21454855E-02  2.40132476E-02                          
+   289  7.36962000E-04  7.25644135E-02  2.41462535E-02                          
+   290  7.47171548E-04  7.29843036E-02  2.42795278E-02                          
+   291  7.57486344E-04  7.34051545E-02  2.44130700E-02                          
+   292  7.67907098E-04  7.38269650E-02  2.45468797E-02                          
+   293  7.78434524E-04  7.42497339E-02  2.46809563E-02                          
+   294  7.89069338E-04  7.46734599E-02  2.48152995E-02                          
+   295  7.99812257E-04  7.50981419E-02  2.49499087E-02                          
+   296  8.10664001E-04  7.55237787E-02  2.50847837E-02                          
+   297  8.21625292E-04  7.59503690E-02  2.52199238E-02                          
+   298  8.32696855E-04  7.63779116E-02  2.53553288E-02                          
+   299  8.43879416E-04  7.68064054E-02  2.54909981E-02                          
+   300  8.55173704E-04  7.72358492E-02  2.56269312E-02                          
+   301  8.66580449E-04  7.76662418E-02  2.57631279E-02                          
+   302  8.78100386E-04  7.80975819E-02  2.58995875E-02                          
+   303  8.89734250E-04  7.85298685E-02  2.60363098E-02                          
+   304  9.01482777E-04  7.89631003E-02  2.61732942E-02                          
+   305  9.13346708E-04  7.93972762E-02  2.63105403E-02                          
+   306  9.25326785E-04  7.98323951E-02  2.64480478E-02                          
+   307  9.37423752E-04  8.02684557E-02  2.65858161E-02                          
+   308  9.49638355E-04  8.07054569E-02  2.67238449E-02                          
+   309  9.61971343E-04  8.11433976E-02  2.68621337E-02                          
+   310  9.74423466E-04  8.15822767E-02  2.70006821E-02                          
+   311  9.86995478E-04  8.20220929E-02  2.71394897E-02                          
+   312  9.99688133E-04  8.24628451E-02  2.72785560E-02                          
+   313  1.01250219E-03  8.29045323E-02  2.74178807E-02                          
+   314  1.02543840E-03  8.33471533E-02  2.75574633E-02                          
+   315  1.03849754E-03  8.37907070E-02  2.76973034E-02                          
+   316  1.05168036E-03  8.42351922E-02  2.78374006E-02                          
+   317  1.06498764E-03  8.46806079E-02  2.79777544E-02                          
+   318  1.07842013E-03  8.51269529E-02  2.81183645E-02                          
+   319  1.09197861E-03  8.55742261E-02  2.82592305E-02                          
+   320  1.10566385E-03  8.60224264E-02  2.84003519E-02                          
+   321  1.11947663E-03  8.64715528E-02  2.85417283E-02                          
+   322  1.13341772E-03  8.69216041E-02  2.86833593E-02                          
+   323  1.14748791E-03  8.73725792E-02  2.88252445E-02                          
+   324  1.16168796E-03  8.78244771E-02  2.89673836E-02                          
+   325  1.17601868E-03  8.82772967E-02  2.91097760E-02                          
+   326  1.19048083E-03  8.87310369E-02  2.92524214E-02                          
+   327  1.20507521E-03  8.91856966E-02  2.93953194E-02                          
+   328  1.21980261E-03  8.96412748E-02  2.95384696E-02                          
+   329  1.23466382E-03  9.00977703E-02  2.96818716E-02                          
+   330  1.24965963E-03  9.05551822E-02  2.98255250E-02                          
+   331  1.26479084E-03  9.10135093E-02  2.99694293E-02                          
+   332  1.28005824E-03  9.14727507E-02  3.01135843E-02                          
+   333  1.29546265E-03  9.19329052E-02  3.02579894E-02                          
+   334  1.31100485E-03  9.23939719E-02  3.04026443E-02                          
+   335  1.32668566E-03  9.28559496E-02  3.05475487E-02                          
+   336  1.34250587E-03  9.33188373E-02  3.06927020E-02                          
+   337  1.35846631E-03  9.37826340E-02  3.08381040E-02                          
+   338  1.37456777E-03  9.42473387E-02  3.09837542E-02                          
+   339  1.39081108E-03  9.47129503E-02  3.11296523E-02                          
+   340  1.40719704E-03  9.51794679E-02  3.12757978E-02                          
+   341  1.42372648E-03  9.56468903E-02  3.14221903E-02                          
+   342  1.44040021E-03  9.61152166E-02  3.15688296E-02                          
+   343  1.45721905E-03  9.65844457E-02  3.17157151E-02                          
+   344  1.47418383E-03  9.70545767E-02  3.18628465E-02                          
+   345  1.49129537E-03  9.75256084E-02  3.20102234E-02                          
+   346  1.50855451E-03  9.79975401E-02  3.21578455E-02                          
+   347  1.52596206E-03  9.84703705E-02  3.23057123E-02                          
+   348  1.54351886E-03  9.89440988E-02  3.24538235E-02                          
+   349  1.56122575E-03  9.94187239E-02  3.26021787E-02                          
+   350  1.57908356E-03  9.98942448E-02  3.27507775E-02                          
+   351  1.59709312E-03  1.00370661E-01  3.28996195E-02                          
+   352  1.61525529E-03  1.00847970E-01  3.30487044E-02                          
+   353  1.63357089E-03  1.01326173E-01  3.31980318E-02                          
+   354  1.65204077E-03  1.01805267E-01  3.33476012E-02                          
+   355  1.67066579E-03  1.02285253E-01  3.34974124E-02                          
+   356  1.68944678E-03  1.02766128E-01  3.36474649E-02                          
+   357  1.70838460E-03  1.03247892E-01  3.37977584E-02                          
+   358  1.72748010E-03  1.03730545E-01  3.39482925E-02                          
+   359  1.74673414E-03  1.04214084E-01  3.40990669E-02                          
+   360  1.76614756E-03  1.04698510E-01  3.42500811E-02                          
+   361  1.78572124E-03  1.05183820E-01  3.44013348E-02                          
+   362  1.80545602E-03  1.05670015E-01  3.45528276E-02                          
+   363  1.82535277E-03  1.06157093E-01  3.47045592E-02                          
+   364  1.84541236E-03  1.06645054E-01  3.48565291E-02                          
+   365  1.86563565E-03  1.07133895E-01  3.50087371E-02                          
+   366  1.88602351E-03  1.07623618E-01  3.51611827E-02                          
+   367  1.90657681E-03  1.08114219E-01  3.53138656E-02                          
+   368  1.92729643E-03  1.08605699E-01  3.54667854E-02                          
+   369  1.94818323E-03  1.09098057E-01  3.56199418E-02                          
+   370  1.96923809E-03  1.09591292E-01  3.57733344E-02                          
+   371  1.99046190E-03  1.10085402E-01  3.59269628E-02                          
+   372  2.01185553E-03  1.10580387E-01  3.60808266E-02                          
+   373  2.03341986E-03  1.11076246E-01  3.62349256E-02                          
+   374  2.05515579E-03  1.11572978E-01  3.63892593E-02                          
+   375  2.07706419E-03  1.12070582E-01  3.65438274E-02                          
+   376  2.09914595E-03  1.12569057E-01  3.66986295E-02                          
+   377  2.12140197E-03  1.13068403E-01  3.68536653E-02                          
+   378  2.14383314E-03  1.13568617E-01  3.70089344E-02                          
+   379  2.16644035E-03  1.14069701E-01  3.71644365E-02                          
+   380  2.18922449E-03  1.14571651E-01  3.73201711E-02                          
+   381  2.21218648E-03  1.15074469E-01  3.74761380E-02                          
+   382  2.23532720E-03  1.15578152E-01  3.76323368E-02                          
+   383  2.25864755E-03  1.16082700E-01  3.77887671E-02                          
+   384  2.28214846E-03  1.16588112E-01  3.79454286E-02                          
+   385  2.30583081E-03  1.17094387E-01  3.81023209E-02                          
+   386  2.32969551E-03  1.17601525E-01  3.82594437E-02                          
+   387  2.35374349E-03  1.18109523E-01  3.84167966E-02                          
+   388  2.37797564E-03  1.18618382E-01  3.85743793E-02                          
+   389  2.40239289E-03  1.19128101E-01  3.87321914E-02                          
+   390  2.42699615E-03  1.19638678E-01  3.88902325E-02                          
+   391  2.45178633E-03  1.20150113E-01  3.90485024E-02                          
+   392  2.47676436E-03  1.20662405E-01  3.92070006E-02                          
+   393  2.50193116E-03  1.21175554E-01  3.93657269E-02                          
+   394  2.52728766E-03  1.21689557E-01  3.95246808E-02                          
+   395  2.55283477E-03  1.22204415E-01  3.96838621E-02                          
+   396  2.57857342E-03  1.22720126E-01  3.98432703E-02                          
+   397  2.60450455E-03  1.23236690E-01  4.00029052E-02                          
+   398  2.63062909E-03  1.23754106E-01  4.01627663E-02                          
+   399  2.65694797E-03  1.24272372E-01  4.03228534E-02                          
+   400  2.68346212E-03  1.24791489E-01  4.04831661E-02                          
+   401  2.71017248E-03  1.25311455E-01  4.06437041E-02                          
+   402  2.73708000E-03  1.25832269E-01  4.08044669E-02                          
+   403  2.76418560E-03  1.26353931E-01  4.09654543E-02                          
+   404  2.79149024E-03  1.26876440E-01  4.11266660E-02                          
+   405  2.81899486E-03  1.27399794E-01  4.12881015E-02                          
+   406  2.84670040E-03  1.27923994E-01  4.14497606E-02                          
+   407  2.87460782E-03  1.28449037E-01  4.16116428E-02                          
+   408  2.90271806E-03  1.28974925E-01  4.17737480E-02                          
+   409  2.93103208E-03  1.29501654E-01  4.19360756E-02                          
+   410  2.95955083E-03  1.30029226E-01  4.20986254E-02                          
+   411  2.98827527E-03  1.30557638E-01  4.22613971E-02                          
+   412  3.01720635E-03  1.31086891E-01  4.24243903E-02                          
+   413  3.04634503E-03  1.31616982E-01  4.25876046E-02                          
+   414  3.07569228E-03  1.32147912E-01  4.27510398E-02                          
+   415  3.10524906E-03  1.32679680E-01  4.29146954E-02                          
+   416  3.13501633E-03  1.33212285E-01  4.30785712E-02                          
+   417  3.16499506E-03  1.33745726E-01  4.32426668E-02                          
+   418  3.19518623E-03  1.34280001E-01  4.34069819E-02                          
+   419  3.22559079E-03  1.34815112E-01  4.35715161E-02                          
+   420  3.25620972E-03  1.35351056E-01  4.37362692E-02                          
+   421  3.28704401E-03  1.35887832E-01  4.39012407E-02                          
+   422  3.31809462E-03  1.36425441E-01  4.40664304E-02                          
+   423  3.34936253E-03  1.36963881E-01  4.42318379E-02                          
+   424  3.38084872E-03  1.37503151E-01  4.43974628E-02                          
+   425  3.41255417E-03  1.38043251E-01  4.45634364E-02                          
+   426  3.44447987E-03  1.38584180E-01  4.47294989E-02                          
+   427  3.47662681E-03  1.39125937E-01  4.48957779E-02                          
+   428  3.50899596E-03  1.39668812E-01  4.50622731E-02                          
+   429  3.54158832E-03  1.40212230E-01  4.52289840E-02                          
+   430  3.57440488E-03  1.40756474E-01  4.53959105E-02                          
+   431  3.60744664E-03  1.41301544E-01  4.55630522E-02                          
+   432  3.64071457E-03  1.41847437E-01  4.57304087E-02                          
+   433  3.67420970E-03  1.42394154E-01  4.58979797E-02                          
+   434  3.70793300E-03  1.42941693E-01  4.60657649E-02                          
+   435  3.74188548E-03  1.43490055E-01  4.62335957E-02                          
+   436  3.77606814E-03  1.44039237E-01  4.64018045E-02                          
+   437  3.81048198E-03  1.44589240E-01  4.65702264E-02                          
+   438  3.84512802E-03  1.45140062E-01  4.67388613E-02                          
+   439  3.88000725E-03  1.45691322E-01  4.69077086E-02                          
+   440  3.91512069E-03  1.46243772E-01  4.70767681E-02                          
+   441  3.95046934E-03  1.46797040E-01  4.72460395E-02                          
+   442  3.98605422E-03  1.47351124E-01  4.74155225E-02                          
+   443  4.02187633E-03  1.47906024E-01  4.75852166E-02                          
+   444  4.05793671E-03  1.48461739E-01  4.77551217E-02                          
+   445  4.09423636E-03  1.49018268E-01  4.79252373E-02                          
+   446  4.13077630E-03  1.49575611E-01  4.80955631E-02                          
+   447  4.16755755E-03  1.50133766E-01  4.82660988E-02                          
+   448  4.20458114E-03  1.50692733E-01  4.84368442E-02                          
+   449  4.24184809E-03  1.51252512E-01  4.86077988E-02                          
+   450  4.27935942E-03  1.51813100E-01  4.87789623E-02                          
+   451  4.31711617E-03  1.52374499E-01  4.89503344E-02                          
+   452  4.35511936E-03  1.52936706E-01  4.91219148E-02                          
+   453  4.39337002E-03  1.53499722E-01  4.92937032E-02                          
+   454  4.43186919E-03  1.54063545E-01  4.94656993E-02                          
+   455  4.47061790E-03  1.54628175E-01  4.96379026E-02                          
+   456  4.50961719E-03  1.55193611E-01  4.98103130E-02                          
+   457  4.54886809E-03  1.55759853E-01  4.99829300E-02                          
+   458  4.58837165E-03  1.56326898E-01  5.01557534E-02                          
+   459  4.62812890E-03  1.56894748E-01  5.03287827E-02                          
+   460  4.66814089E-03  1.57463401E-01  5.05020178E-02                          
+   461  4.70840866E-03  1.58032856E-01  5.06754583E-02                          
+   462  4.74893326E-03  1.58603113E-01  5.08491039E-02                          
+   463  4.78971574E-03  1.59174171E-01  5.10229542E-02                          
+   464  4.83075714E-03  1.59746029E-01  5.11970089E-02                          
+   465  4.87205853E-03  1.60318686E-01  5.13712679E-02                          
+   466  4.91362094E-03  1.60892142E-01  5.15457306E-02                          
+   467  4.95544544E-03  1.61466397E-01  5.17203967E-02                          
+   468  4.99753308E-03  1.62041448E-01  5.18952659E-02                          
+   469  5.03988491E-03  1.62617297E-01  5.20703380E-02                          
+   470  5.08250201E-03  1.63193941E-01  5.22456126E-02                          
+   471  5.12538542E-03  1.63771380E-01  5.24210893E-02                          
+   472  5.16853622E-03  1.64349614E-01  5.25967680E-02                          
+   473  5.21195547E-03  1.64928642E-01  5.27726481E-02                          
+   474  5.25564422E-03  1.65508463E-01  5.29487295E-02                          
+   475  5.29960356E-03  1.66089076E-01  5.31250118E-02                          
+   476  5.34383454E-03  1.66670481E-01  5.33014948E-02                          
+   477  5.38833825E-03  1.67252677E-01  5.34781774E-02                          
+   478  5.43311574E-03  1.67835663E-01  5.36550605E-02                          
+   479  5.47816811E-03  1.68419438E-01  5.38321433E-02                          
+   480  5.52349641E-03  1.69004003E-01  5.40094253E-02                          
+   481  5.56910174E-03  1.69589354E-01  5.41869064E-02                          
+   482  5.61498516E-03  1.70175495E-01  5.43645861E-02                          
+   483  5.66114776E-03  1.70762422E-01  5.45424643E-02                          
+   484  5.70759061E-03  1.71350135E-01  5.47205404E-02                          
+   485  5.75431482E-03  1.71938633E-01  5.48988143E-02                          
+   486  5.80132145E-03  1.72527916E-01  5.50772857E-02                          
+   487  5.84861159E-03  1.73117983E-01  5.52559541E-02                          
+   488  5.89618634E-03  1.73708834E-01  5.54348193E-02                          
+   489  5.94404678E-03  1.74300467E-01  5.56138810E-02                          
+   490  5.99219401E-03  1.74892882E-01  5.57931388E-02                          
+   491  6.04062911E-03  1.75486079E-01  5.59725925E-02                          
+   492  6.08935318E-03  1.76080056E-01  5.61522417E-02                          
+   493  6.13836732E-03  1.76674813E-01  5.63320860E-02                          
+   494  6.18767262E-03  1.77270349E-01  5.65121253E-02                          
+   495  6.23727019E-03  1.77866664E-01  5.66923592E-02                          
+   496  6.28716112E-03  1.78463757E-01  5.68727873E-02                          
+   497  6.33734652E-03  1.79061626E-01  5.70534094E-02                          
+   498  6.38782748E-03  1.79660273E-01  5.72342251E-02                          
+   499  6.43860512E-03  1.80259695E-01  5.74152341E-02                          
+   500  6.48968055E-03  1.80859893E-01  5.75964361E-02                          
+   501  6.54105485E-03  1.81460865E-01  5.77778308E-02                          
+   502  6.59272916E-03  1.82062611E-01  5.79594179E-02                          
+   503  6.64470458E-03  1.82665130E-01  5.81411970E-02                          
+   504  6.69698222E-03  1.83268421E-01  5.83231679E-02                          
+   505  6.74956319E-03  1.83872485E-01  5.85049171E-02                          
+   506  6.80244862E-03  1.84477319E-01  5.86872781E-02                          
+   507  6.85563961E-03  1.85082924E-01  5.88698300E-02                          
+   508  6.90913729E-03  1.85688277E-01  5.90525726E-02                          
+   509  6.96294277E-03  1.86295437E-01  5.92355055E-02                          
+   510  7.01705719E-03  1.86903367E-01  5.94186284E-02                          
+   511  7.07148165E-03  1.87512064E-01  5.96019411E-02                          
+   512  7.12621729E-03  1.88121529E-01  5.97854432E-02                          
+   513  7.18126522E-03  1.88731761E-01  5.99691343E-02                          
+   514  7.23662659E-03  1.89342760E-01  6.01530142E-02                          
+   515  7.29230251E-03  1.89954524E-01  6.03370826E-02                          
+   516  7.34829411E-03  1.90567053E-01  6.05213392E-02                          
+   517  7.40460253E-03  1.91180346E-01  6.07057836E-02                          
+   518  7.46122890E-03  1.91794402E-01  6.08904155E-02                          
+   519  7.51817436E-03  1.92409222E-01  6.10752346E-02                          
+   520  7.57544003E-03  1.93024804E-01  6.12602406E-02                          
+   521  7.63302706E-03  1.93641148E-01  6.14454332E-02                          
+   522  7.69093659E-03  1.94258253E-01  6.16308120E-02                          
+   523  7.74916974E-03  1.94876118E-01  6.18163769E-02                          
+   524  7.80772768E-03  1.95494743E-01  6.20021273E-02                          
+   525  7.86661153E-03  1.96114127E-01  6.21880631E-02                          
+   526  7.92582244E-03  1.96734270E-01  6.23741839E-02                          
+   527  7.98536157E-03  1.97355170E-01  6.25604894E-02                          
+   528  8.04523004E-03  1.97976827E-01  6.27469794E-02                          
+   529  8.10542902E-03  1.98599241E-01  6.29336534E-02                          
+   530  8.16595965E-03  1.99222411E-01  6.31205111E-02                          
+   531  8.22682308E-03  1.99846336E-01  6.33075523E-02                          
+   532  8.28802047E-03  2.00471015E-01  6.34947767E-02                          
+   533  8.34955296E-03  2.01096448E-01  6.36821838E-02                          
+   534  8.41142172E-03  2.01722635E-01  6.38697735E-02                          
+   535  8.47362789E-03  2.02349574E-01  6.40575454E-02                          
+   536  8.53617264E-03  2.02977265E-01  6.42454992E-02                          
+   537  8.59905713E-03  2.03605708E-01  6.44336346E-02                          
+   538  8.66228251E-03  2.04234901E-01  6.46219512E-02                          
+   539  8.72584995E-03  2.04864844E-01  6.48104487E-02                          
+   540  8.78976061E-03  2.05495537E-01  6.49991269E-02                          
+   541  8.85401565E-03  2.06126979E-01  6.51879855E-02                          
+   542  8.91861624E-03  2.06759168E-01  6.53770240E-02                          
+   543  8.98356354E-03  2.07392105E-01  6.55662422E-02                          
+   544  9.04885873E-03  2.08025789E-01  6.57556398E-02                          
+   545  9.11450297E-03  2.08660219E-01  6.59452165E-02                          
+   546  9.18049743E-03  2.09295395E-01  6.61349720E-02                          
+   547  9.24684329E-03  2.09931316E-01  6.63249058E-02                          
+   548  9.31354172E-03  2.10567981E-01  6.65150178E-02                          
+   549  9.38059389E-03  2.11205390E-01  6.67053077E-02                          
+   550  9.44800097E-03  2.11843541E-01  6.68957750E-02                          
+   551  9.51576415E-03  2.12482436E-01  6.70864195E-02                          
+   552  9.58388460E-03  2.13122072E-01  6.72772409E-02                          
+   553  9.65236351E-03  2.13762449E-01  6.74682389E-02                          
+   554  9.72120204E-03  2.14403566E-01  6.76592572E-02                          
+   555  9.79040139E-03  2.15045424E-01  6.78505916E-02                          
+   556  9.85996274E-03  2.15687837E-01  6.80421014E-02                          
+   557  9.92988727E-03  2.16331138E-01  6.82337863E-02                          
+   558  1.00001762E-02  2.16975177E-01  6.84256461E-02                          
+   559  1.00708306E-02  2.17619953E-01  6.86176805E-02                          
+   560  1.01418518E-02  2.18265465E-01  6.88098890E-02                          
+   561  1.02132409E-02  2.18911712E-01  6.90022714E-02                          
+   562  1.02849992E-02  2.19558695E-01  6.91948274E-02                          
+   563  1.03571277E-02  2.20206412E-01  6.93875567E-02                          
+   564  1.04296278E-02  2.20854864E-01  6.95804589E-02                          
+   565  1.05025005E-02  2.21504048E-01  6.97735338E-02                          
+   566  1.05757472E-02  2.22153965E-01  6.99667810E-02                          
+   567  1.06493689E-02  2.22804613E-01  7.01602002E-02                          
+   568  1.07233669E-02  2.23455993E-01  7.03537911E-02                          
+   569  1.07977424E-02  2.24108104E-01  7.05475529E-02                          
+   570  1.08724966E-02  2.24760945E-01  7.07414862E-02                          
+   571  1.09476307E-02  2.25414515E-01  7.09355903E-02                          
+   572  1.10231459E-02  2.26068814E-01  7.11298649E-02                          
+   573  1.10990433E-02  2.26723840E-01  7.13243095E-02                          
+   574  1.11753243E-02  2.27379594E-01  7.15189240E-02                          
+   575  1.12519899E-02  2.28036076E-01  7.17137080E-02                          
+   576  1.13290415E-02  2.28693283E-01  7.19086612E-02                          
+   577  1.14064802E-02  2.29351216E-01  7.21037832E-02                          
+   578  1.14843072E-02  2.30009875E-01  7.22990738E-02                          
+   579  1.15625237E-02  2.30669257E-01  7.24945327E-02                          
+   580  1.16411310E-02  2.31329364E-01  7.26901595E-02                          
+   581  1.17201302E-02  2.31990193E-01  7.28859539E-02                          
+   582  1.17995226E-02  2.32651745E-01  7.30819156E-02                          
+   583  1.18793094E-02  2.33314019E-01  7.32780442E-02                          
+   584  1.19594917E-02  2.33977014E-01  7.34743396E-02                          
+   585  1.20400709E-02  2.34640729E-01  7.36708013E-02                          
+   586  1.21210481E-02  2.35305165E-01  7.38674290E-02                          
+   587  1.22024246E-02  2.35970320E-01  7.40642225E-02                          
+   588  1.22842015E-02  2.36636193E-01  7.42611813E-02                          
+   589  1.23663802E-02  2.37302785E-01  7.44583053E-02                          
+   590  1.24489617E-02  2.37970093E-01  7.46555940E-02                          
+   591  1.25319474E-02  2.38638119E-01  7.48530472E-02                          
+   592  1.26153384E-02  2.39306861E-01  7.50506645E-02                          
+   593  1.26991360E-02  2.39976318E-01  7.52484457E-02                          
+   594  1.27833414E-02  2.40646491E-01  7.54463903E-02                          
+   595  1.28679558E-02  2.41317377E-01  7.56444982E-02                          
+   596  1.29529805E-02  2.41988977E-01  7.58427689E-02                          
+   597  1.30384167E-02  2.42661290E-01  7.60412022E-02                          
+   598  1.31242657E-02  2.43334316E-01  7.62397978E-02                          
+   599  1.32105285E-02  2.44008053E-01  7.64385553E-02                          
+   600  1.32972066E-02  2.44682501E-01  7.66374744E-02                          
+   601  1.33843010E-02  2.45357660E-01  7.68365547E-02                          
+   602  1.34718131E-02  2.46033528E-01  7.70357961E-02                          
+   603  1.35597441E-02  2.46710106E-01  7.72351981E-02                          
+   604  1.36480952E-02  2.47387392E-01  7.74347604E-02                          
+   605  1.37368677E-02  2.48065386E-01  7.76344828E-02                          
+   606  1.38260628E-02  2.48744087E-01  7.78343649E-02                          
+   607  1.39156817E-02  2.49423495E-01  7.80344064E-02                          
+   608  1.40057256E-02  2.50103609E-01  7.82346069E-02                          
+   609  1.40961959E-02  2.50784428E-01  7.84349662E-02                          
+   610  1.41870937E-02  2.51465952E-01  7.86354839E-02                          
+   611  1.42784203E-02  2.52148180E-01  7.88361598E-02                          
+   612  1.43701769E-02  2.52831111E-01  7.90369934E-02                          
+   613  1.44623649E-02  2.53514745E-01  7.92379845E-02                          
+   614  1.45549853E-02  2.54199081E-01  7.94391327E-02                          
+   615  1.46480395E-02  2.54884118E-01  7.96404378E-02                          
+   616  1.47415288E-02  2.55569856E-01  7.98418995E-02                          
+   617  1.48354543E-02  2.56256295E-01  8.00435173E-02                          
+   618  1.49298173E-02  2.56943433E-01  8.02452910E-02                          
+   619  1.50246190E-02  2.57631269E-01  8.04472202E-02                          
+   620  1.51198608E-02  2.58319804E-01  8.06493047E-02                          
+   621  1.52155439E-02  2.59008576E-01  8.08515441E-02                          
+   622  1.53116694E-02  2.59698501E-01  8.10539381E-02                          
+   623  1.54082387E-02  2.60389123E-01  8.12562623E-02                          
+   624  1.55052531E-02  2.61080439E-01  8.14589625E-02                          
+   625  1.56027137E-02  2.61772451E-01  8.16618163E-02                          
+   626  1.57006219E-02  2.62465157E-01  8.18648235E-02                          
+   627  1.57989788E-02  2.63158557E-01  8.20679836E-02                          
+   628  1.58977858E-02  2.63852649E-01  8.22712963E-02                          
+   629  1.59970440E-02  2.64547434E-01  8.24747614E-02                          
+   630  1.60967549E-02  2.65242911E-01  8.26783785E-02                          
+   631  1.61969195E-02  2.65939078E-01  8.28821473E-02                          
+   632  1.62975393E-02  2.66635936E-01  8.30860675E-02                          
+   633  1.63986153E-02  2.67333483E-01  8.32901387E-02                          
+   634  1.65001490E-02  2.68031719E-01  8.34943606E-02                          
+   635  1.66021415E-02  2.68730644E-01  8.36987330E-02                          
+   636  1.67045942E-02  2.69430256E-01  8.39032554E-02                          
+   637  1.68075082E-02  2.70130555E-01  8.41079276E-02                          
+   638  1.69108849E-02  2.70831541E-01  8.43127493E-02                          
+   639  1.70147255E-02  2.71533212E-01  8.45177200E-02                          
+   640  1.71190313E-02  2.72235568E-01  8.47228395E-02                          
+   641  1.72238036E-02  2.72938608E-01  8.49281075E-02                          
+   642  1.73290436E-02  2.73642332E-01  8.51335236E-02                          
+   643  1.74347525E-02  2.74346739E-01  8.53390876E-02                          
+   644  1.75409317E-02  2.75051828E-01  8.55447990E-02                          
+   645  1.76475825E-02  2.75757599E-01  8.57506576E-02                          
+   646  1.77547060E-02  2.76464050E-01  8.59566631E-02                          
+   647  1.78623036E-02  2.77171182E-01  8.61628150E-02                          
+   648  1.79703766E-02  2.77878993E-01  8.63691132E-02                          
+   649  1.80789261E-02  2.78587483E-01  8.65755572E-02                          
+   650  1.81879536E-02  2.79296651E-01  8.67821468E-02                          
+   651  1.82974602E-02  2.80006497E-01  8.69888816E-02                          
+   652  1.84074472E-02  2.80717020E-01  8.71957612E-02                          
+   653  1.85179160E-02  2.81428218E-01  8.74027854E-02                          
+   654  1.86288677E-02  2.82140092E-01  8.76099539E-02                          
+   655  1.87403037E-02  2.82852640E-01  8.78172663E-02                          
+   656  1.88522252E-02  2.83565863E-01  8.80247222E-02                          
+   657  1.89646336E-02  2.84279759E-01  8.82323214E-02                          
+   658  1.90775300E-02  2.84994327E-01  8.84400636E-02                          
+   659  1.91909159E-02  2.85709568E-01  8.86479483E-02                          
+   660  1.93047923E-02  2.86425479E-01  8.88559753E-02                          
+   661  1.94191607E-02  2.87142061E-01  8.90641442E-02                          
+   662  1.95340224E-02  2.87859313E-01  8.92724548E-02                          
+   663  1.96493785E-02  2.88577234E-01  8.94809067E-02                          
+   664  1.97652304E-02  2.89295823E-01  8.96894995E-02                          
+   665  1.98815793E-02  2.90015079E-01  8.98982329E-02                          
+   666  1.99984266E-02  2.90735003E-01  9.01071066E-02                          
+   667  2.01157736E-02  2.91455593E-01  9.03161203E-02                          
+   668  2.02336214E-02  2.92176848E-01  9.05252737E-02                          
+   669  2.03519715E-02  2.92898768E-01  9.07345663E-02                          
+   670  2.04708250E-02  2.93621353E-01  9.09439980E-02                          
+   671  2.05901833E-02  2.94344600E-01  9.11535683E-02                          
+   672  2.07100476E-02  2.95068510E-01  9.13632769E-02                          
+   673  2.08304193E-02  2.95793082E-01  9.15731235E-02                          
+   674  2.09512996E-02  2.96518315E-01  9.17831077E-02                          
+   675  2.10726899E-02  2.97244208E-01  9.19932293E-02                          
+   676  2.11945913E-02  2.97970761E-01  9.22034879E-02                          
+   677  2.13170052E-02  2.98697973E-01  9.24138831E-02                          
+   678  2.14399330E-02  2.99425844E-01  9.26244147E-02                          
+   679  2.15633758E-02  3.00154371E-01  9.28350823E-02                          
+   680  2.16873349E-02  3.00883555E-01  9.30458855E-02                          
+   681  2.18118117E-02  3.01613396E-01  9.32568240E-02                          
+   682  2.19368075E-02  3.02343891E-01  9.34678976E-02                          
+   683  2.20623235E-02  3.03075041E-01  9.36791058E-02                          
+   684  2.21883611E-02  3.03806844E-01  9.38904484E-02                          
+   685  2.23149215E-02  3.04539301E-01  9.41019250E-02                          
+   686  2.24420059E-02  3.05272409E-01  9.43135352E-02                          
+   687  2.25696159E-02  3.06006169E-01  9.45252788E-02                          
+   688  2.26977525E-02  3.06740580E-01  9.47371553E-02                          
+   689  2.28264171E-02  3.07475640E-01  9.49491645E-02                          
+   690  2.29556110E-02  3.08211350E-01  9.51613061E-02                          
+   691  2.30853355E-02  3.08947708E-01  9.53735796E-02                          
+   692  2.32155919E-02  3.09684713E-01  9.55859848E-02                          
+   693  2.33463815E-02  3.10422365E-01  9.57985213E-02                          
+   694  2.34777055E-02  3.11160663E-01  9.60111888E-02                          
+   695  2.36095654E-02  3.11899607E-01  9.62239869E-02                          
+   696  2.37419623E-02  3.12639195E-01  9.64369154E-02                          
+   697  2.38748976E-02  3.13379426E-01  9.66499738E-02                          
+   698  2.40083726E-02  3.14120300E-01  9.68631619E-02                          
+   699  2.41423885E-02  3.14861817E-01  9.70764792E-02                          
+   700  2.42769467E-02  3.15603974E-01  9.72899255E-02                          
+   701  2.44120485E-02  3.16346772E-01  9.75035005E-02                          
+   702  2.45476951E-02  3.17090210E-01  9.77172037E-02                          
+   703  2.46838879E-02  3.17834287E-01  9.79310349E-02                          
+   704  2.48206282E-02  3.18579001E-01  9.81449936E-02                          
+   705  2.49579173E-02  3.19324353E-01  9.83590797E-02                          
+   706  2.50957564E-02  3.20070341E-01  9.85732927E-02                          
+   707  2.52341469E-02  3.20816965E-01  9.87876322E-02                          
+   708  2.53730900E-02  3.21564223E-01  9.90020980E-02                          
+   709  2.55125872E-02  3.22312116E-01  9.92166898E-02                          
+   710  2.56526396E-02  3.23060641E-01  9.94314070E-02                          
+   711  2.57932486E-02  3.23809799E-01  9.96462496E-02                          
+   712  2.59344155E-02  3.24559588E-01  9.98612170E-02                          
+   713  2.60761415E-02  3.25310008E-01  1.00076309E-01                          
+   714  2.62184281E-02  3.26061058E-01  1.00291525E-01                          
+   715  2.63612764E-02  3.26812736E-01  1.00506865E-01                          
+   716  2.65046879E-02  3.27565043E-01  1.00722329E-01                          
+   717  2.66486637E-02  3.28317977E-01  1.00937915E-01                          
+   718  2.67932052E-02  3.29071537E-01  1.01153625E-01                          
+   719  2.69383138E-02  3.29825723E-01  1.01369457E-01                          
+   720  2.70839906E-02  3.30580533E-01  1.01585411E-01                          
+   721  2.72302371E-02  3.31335968E-01  1.01801487E-01                          
+   722  2.73770545E-02  3.32092025E-01  1.02017684E-01                          
+   723  2.75244441E-02  3.32848704E-01  1.02234003E-01                          
+   724  2.76724073E-02  3.33606004E-01  1.02449621E-01                          
+   725  2.78209452E-02  3.34363925E-01  1.02666174E-01                          
+   726  2.79700594E-02  3.35122465E-01  1.02882848E-01                          
+   727  2.81197509E-02  3.35881624E-01  1.03099641E-01                          
+   728  2.82700213E-02  3.36641400E-01  1.03316554E-01                          
+   729  2.84208716E-02  3.37401793E-01  1.03534439E-01                          
+   730  2.85723034E-02  3.38160944E-01  1.03751595E-01                          
+   731  2.87243178E-02  3.38922554E-01  1.03968870E-01                          
+   732  2.88769162E-02  3.39684777E-01  1.04186263E-01                          
+   733  2.90300999E-02  3.40447614E-01  1.04403774E-01                          
+   734  2.91838702E-02  3.41211063E-01  1.04621402E-01                          
+   735  2.93382283E-02  3.41977052E-01  1.04839147E-01                          
+   736  2.94931757E-02  3.42741737E-01  1.05057009E-01                          
+   737  2.96487136E-02  3.43507031E-01  1.05274987E-01                          
+   738  2.98048433E-02  3.44272934E-01  1.05493080E-01                          
+   739  2.99615661E-02  3.45039445E-01  1.05711290E-01                          
+   740  3.01188834E-02  3.45806562E-01  1.05929614E-01                          
+   741  3.02767964E-02  3.46574285E-01  1.06148054E-01                          
+   742  3.04353064E-02  3.47342612E-01  1.06366608E-01                          
+   743  3.05944148E-02  3.48111544E-01  1.06585276E-01                          
+   744  3.07541229E-02  3.48881078E-01  1.06804058E-01                          
+   745  3.09144319E-02  3.49651215E-01  1.07022953E-01                          
+   746  3.10753432E-02  3.50421952E-01  1.07241962E-01                          
+   747  3.12368581E-02  3.51193289E-01  1.07461083E-01                          
+   748  3.13989779E-02  3.51965225E-01  1.07680317E-01                          
+   749  3.15617039E-02  3.52737760E-01  1.07899663E-01                          
+   750  3.17250374E-02  3.53510891E-01  1.08119120E-01                          
+   751  3.18889797E-02  3.54284619E-01  1.08338689E-01                          
+   752  3.20535321E-02  3.55058941E-01  1.08558369E-01                          
+   753  3.22186960E-02  3.55833858E-01  1.08778160E-01                          
+   754  3.23844726E-02  3.56609368E-01  1.08998060E-01                          
+   755  3.25508632E-02  3.57385470E-01  1.09218071E-01                          
+   756  3.27178692E-02  3.58162163E-01  1.09438192E-01                          
+   757  3.28854918E-02  3.58939446E-01  1.09658421E-01                          
+   758  3.30537324E-02  3.59717318E-01  1.09878760E-01                          
+   759  3.32225923E-02  3.60495778E-01  1.10099207E-01                          
+   760  3.33920727E-02  3.61274826E-01  1.10319762E-01                          
+   761  3.35621750E-02  3.62054459E-01  1.10540425E-01                          
+   762  3.37329006E-02  3.62834677E-01  1.10761195E-01                          
+   763  3.39042506E-02  3.63615480E-01  1.10982073E-01                          
+   764  3.40762264E-02  3.64396865E-01  1.11203057E-01                          
+   765  3.42488293E-02  3.65178832E-01  1.11424148E-01                          
+   766  3.44220607E-02  3.65961380E-01  1.11645344E-01                          
+   767  3.45959217E-02  3.66744507E-01  1.11866647E-01                          
+   768  3.47704138E-02  3.67528213E-01  1.12088054E-01                          
+   769  3.49455383E-02  3.68312497E-01  1.12309567E-01                          
+   770  3.51212964E-02  3.69097357E-01  1.12531184E-01                          
+   771  3.52976894E-02  3.69882793E-01  1.12752906E-01                          
+   772  3.54747187E-02  3.70668803E-01  1.12974731E-01                          
+   773  3.56523855E-02  3.71455387E-01  1.13196660E-01                          
+   774  3.58306912E-02  3.72242542E-01  1.13418692E-01                          
+   775  3.60096370E-02  3.73030269E-01  1.13640827E-01                          
+   776  3.61892244E-02  3.73818565E-01  1.13863064E-01                          
+   777  3.63694545E-02  3.74607431E-01  1.14085403E-01                          
+   778  3.65503286E-02  3.75396864E-01  1.14307844E-01                          
+   779  3.67318482E-02  3.76186864E-01  1.14530387E-01                          
+   780  3.69140144E-02  3.76977429E-01  1.14753030E-01                          
+   781  3.70968287E-02  3.77768559E-01  1.14975774E-01                          
+   782  3.72802922E-02  3.78560252E-01  1.15198619E-01                          
+   783  3.74644063E-02  3.79352507E-01  1.15421563E-01                          
+   784  3.76491724E-02  3.80145323E-01  1.15644606E-01                          
+   785  3.78345916E-02  3.80938699E-01  1.15867749E-01                          
+   786  3.80206653E-02  3.81732634E-01  1.16090991E-01                          
+   787  3.82073949E-02  3.82527126E-01  1.16314331E-01                          
+   788  3.83947815E-02  3.83322174E-01  1.16537770E-01                          
+   789  3.85828266E-02  3.84117777E-01  1.16761306E-01                          
+   790  3.87715313E-02  3.84913935E-01  1.16984939E-01                          
+   791  3.89608971E-02  3.85710645E-01  1.17208669E-01                          
+   792  3.91509252E-02  3.86507907E-01  1.17432496E-01                          
+   793  3.93416168E-02  3.87305719E-01  1.17656419E-01                          
+   794  3.95329734E-02  3.88104080E-01  1.17880439E-01                          
+   795  3.97249962E-02  3.88902989E-01  1.18104553E-01                          
+   796  3.99176865E-02  3.89702445E-01  1.18328763E-01                          
+   797  4.01110457E-02  3.90502447E-01  1.18553067E-01                          
+   798  4.03050749E-02  3.91302992E-01  1.18777466E-01                          
+   799  4.04997755E-02  3.92104081E-01  1.19001959E-01                          
+   800  4.06951488E-02  3.92905712E-01  1.19226546E-01                          
+   801  4.08911961E-02  3.93707883E-01  1.19451226E-01                          
+   802  4.10879187E-02  3.94510593E-01  1.19675999E-01                          
+   803  4.12853179E-02  3.95313842E-01  1.19900865E-01                          
+   804  4.14833950E-02  3.96117627E-01  1.20125823E-01                          
+   805  4.16821513E-02  3.96921948E-01  1.20350872E-01                          
+   806  4.18815880E-02  3.97726803E-01  1.20576013E-01                          
+   807  4.20817065E-02  3.98532191E-01  1.20801245E-01                          
+   808  4.22825081E-02  3.99338111E-01  1.21026568E-01                          
+   809  4.24839940E-02  4.00144561E-01  1.21251981E-01                          
+   810  4.26861656E-02  4.00951540E-01  1.21477485E-01                          
+   811  4.28890241E-02  4.01759047E-01  1.21703077E-01                          
+   812  4.30925708E-02  4.02567081E-01  1.21928759E-01                          
+   813  4.32968071E-02  4.03375639E-01  1.22154530E-01                          
+   814  4.35017342E-02  4.04184721E-01  1.22380390E-01                          
+   815  4.37073534E-02  4.04994326E-01  1.22606337E-01                          
+   816  4.39136660E-02  4.05804452E-01  1.22832372E-01                          
+   817  4.41206733E-02  4.06615098E-01  1.23058495E-01                          
+   818  4.43283765E-02  4.07426262E-01  1.23284705E-01                          
+   819  4.45367771E-02  4.08237943E-01  1.23511001E-01                          
+   820  4.47458761E-02  4.09050140E-01  1.23737383E-01                          
+   821  4.49556750E-02  4.09862851E-01  1.23963852E-01                          
+   822  4.51661751E-02  4.10676075E-01  1.24190405E-01                          
+   823  4.53773775E-02  4.11489810E-01  1.24417044E-01                          
+   824  4.55892837E-02  4.12304056E-01  1.24643768E-01                          
+   825  4.58018948E-02  4.13118810E-01  1.24870576E-01                          
+   826  4.60152122E-02  4.13934072E-01  1.25097468E-01                          
+   827  4.62292372E-02  4.14749840E-01  1.25324443E-01                          
+   828  4.64439710E-02  4.15566112E-01  1.25551502E-01                          
+   829  4.66594149E-02  4.16382887E-01  1.25778644E-01                          
+   830  4.68755702E-02  4.17200164E-01  1.26005868E-01                          
+   831  4.70924382E-02  4.18017941E-01  1.26233174E-01                          
+   832  4.73100201E-02  4.18836216E-01  1.26460562E-01                          
+   833  4.75283173E-02  4.19654989E-01  1.26688031E-01                          
+   834  4.77473311E-02  4.20474258E-01  1.26915582E-01                          
+   835  4.79670626E-02  4.21294021E-01  1.27143212E-01                          
+   836  4.81875132E-02  4.22114277E-01  1.27370923E-01                          
+   837  4.84086841E-02  4.22935024E-01  1.27598714E-01                          
+   838  4.86305767E-02  4.23756261E-01  1.27826584E-01                          
+   839  4.88531922E-02  4.24577986E-01  1.28054533E-01                          
+   840  4.90765319E-02  4.25400199E-01  1.28282561E-01                          
+   841  4.93005970E-02  4.26222896E-01  1.28510667E-01                          
+   842  4.95253889E-02  4.27046078E-01  1.28738851E-01                          
+   843  4.97509088E-02  4.27869741E-01  1.28967113E-01                          
+   844  4.99771579E-02  4.28693885E-01  1.29195451E-01                          
+   845  5.02041376E-02  4.29518509E-01  1.29423867E-01                          
+   846  5.04318491E-02  4.30343610E-01  1.29652358E-01                          
+   847  5.06602938E-02  4.31169187E-01  1.29880926E-01                          
+   848  5.08894727E-02  4.31995239E-01  1.30109569E-01                          
+   849  5.11193873E-02  4.32821763E-01  1.30338288E-01                          
+   850  5.13500388E-02  4.33648759E-01  1.30567081E-01                          
+   851  5.15814285E-02  4.34476225E-01  1.30795949E-01                          
+   852  5.18135576E-02  4.35304158E-01  1.31024891E-01                          
+   853  5.20464274E-02  4.36132559E-01  1.31253906E-01                          
+   854  5.22800391E-02  4.36961424E-01  1.31482995E-01                          
+   855  5.25143941E-02  4.37790752E-01  1.31712156E-01                          
+   856  5.27494936E-02  4.38620542E-01  1.31941390E-01                          
+   857  5.29853388E-02  4.39450792E-01  1.32170697E-01                          
+   858  5.32219310E-02  4.40281500E-01  1.32400074E-01                          
+   859  5.34592715E-02  4.41112665E-01  1.32629524E-01                          
+   860  5.36973615E-02  4.41944285E-01  1.32859044E-01                          
+   861  5.39362023E-02  4.42776358E-01  1.33088635E-01                          
+   862  5.41757952E-02  4.43608883E-01  1.33318295E-01                          
+   863  5.44161413E-02  4.44441858E-01  1.33548026E-01                          
+   864  5.46572420E-02  4.45275281E-01  1.33777826E-01                          
+   865  5.48990985E-02  4.46109150E-01  1.34007695E-01                          
+   866  5.51417121E-02  4.46943465E-01  1.34237633E-01                          
+   867  5.53850840E-02  4.47778223E-01  1.34467638E-01                          
+   868  5.56292155E-02  4.48613422E-01  1.34697712E-01                          
+   869  5.58741078E-02  4.49449060E-01  1.34927853E-01                          
+   870  5.61197622E-02  4.50285137E-01  1.35158061E-01                          
+   871  5.63661799E-02  4.51121649E-01  1.35388335E-01                          
+   872  5.66133622E-02  4.51958596E-01  1.35618676E-01                          
+   873  5.68613103E-02  4.52795976E-01  1.35849083E-01                          
+   874  5.71100255E-02  4.53633786E-01  1.36079555E-01                          
+   875  5.73595090E-02  4.54472026E-01  1.36310092E-01                          
+   876  5.76097620E-02  4.55310692E-01  1.36540694E-01                          
+   877  5.78607858E-02  4.56149784E-01  1.36771361E-01                          
+   878  5.81125817E-02  4.56989300E-01  1.37002091E-01                          
+   879  5.83651508E-02  4.57829237E-01  1.37232884E-01                          
+   880  5.86184945E-02  4.58669595E-01  1.37463741E-01                          
+   881  5.88726139E-02  4.59510370E-01  1.37694660E-01                          
+   882  5.91275104E-02  4.60351562E-01  1.37925641E-01                          
+   883  5.93831851E-02  4.61193168E-01  1.38156685E-01                          
+   884  5.96396392E-02  4.62035186E-01  1.38387790E-01                          
+   885  5.98968741E-02  4.62877615E-01  1.38618956E-01                          
+   886  6.01548909E-02  4.63720453E-01  1.38850182E-01                          
+   887  6.04136908E-02  4.64563698E-01  1.39081469E-01                          
+   888  6.06732752E-02  4.65407348E-01  1.39312816E-01                          
+   889  6.09336453E-02  4.66251400E-01  1.39544222E-01                          
+   890  6.11948021E-02  4.67095854E-01  1.39775688E-01                          
+   891  6.14567471E-02  4.67940707E-01  1.40007212E-01                          
+   892  6.17194814E-02  4.68785957E-01  1.40238794E-01                          
+   893  6.19830063E-02  4.69631602E-01  1.40470435E-01                          
+   894  6.22473229E-02  4.70477641E-01  1.40702133E-01                          
+   895  6.25124325E-02  4.71324071E-01  1.40933888E-01                          
+   896  6.27783364E-02  4.72170890E-01  1.41165699E-01                          
+   897  6.30450357E-02  4.73018097E-01  1.41397567E-01                          
+   898  6.33125316E-02  4.73865689E-01  1.41629491E-01                          
+   899  6.35808254E-02  4.74713665E-01  1.41861470E-01                          
+   900  6.38499183E-02  4.75562022E-01  1.42093504E-01                          
+   901  6.41198116E-02  4.76410758E-01  1.42325593E-01                          
+   902  6.43905064E-02  4.77259871E-01  1.42557736E-01                          
+   903  6.46620039E-02  4.78109360E-01  1.42789934E-01                          
+   904  6.49343053E-02  4.78959222E-01  1.43022184E-01                          
+   905  6.52074120E-02  4.79809455E-01  1.43254488E-01                          
+   906  6.54813250E-02  4.80660057E-01  1.43486844E-01                          
+   907  6.57560456E-02  4.81511026E-01  1.43719253E-01                          
+   908  6.60315750E-02  4.82362360E-01  1.43951713E-01                          
+   909  6.63079144E-02  4.83214056E-01  1.44184225E-01                          
+   910  6.65850650E-02  4.84066114E-01  1.44416788E-01                          
+   911  6.68630280E-02  4.84918530E-01  1.44649401E-01                          
+   912  6.71418047E-02  4.85771302E-01  1.44882065E-01                          
+   913  6.74213961E-02  4.86624429E-01  1.45114778E-01                          
+   914  6.77018036E-02  4.87477907E-01  1.45347541E-01                          
+   915  6.79830283E-02  4.88331736E-01  1.45580353E-01                          
+   916  6.82650714E-02  4.89185913E-01  1.45813213E-01                          
+   917  6.85479341E-02  4.90040435E-01  1.46046122E-01                          
+   918  6.88316176E-02  4.90895300E-01  1.46279078E-01                          
+   919  6.91161231E-02  4.91750507E-01  1.46512082E-01                          
+   920  6.94014518E-02  4.92606053E-01  1.46745132E-01                          
+   921  6.96876048E-02  4.93461936E-01  1.46978229E-01                          
+   922  6.99745835E-02  4.94318153E-01  1.47211373E-01                          
+   923  7.02623889E-02  4.95174703E-01  1.47444561E-01                          
+   924  7.05510222E-02  4.96031582E-01  1.47677796E-01                          
+   925  7.08404847E-02  4.96888790E-01  1.47911075E-01                          
+   926  7.11307774E-02  4.97746323E-01  1.48144398E-01                          
+   927  7.14219017E-02  4.98604180E-01  1.48377766E-01                          
+   928  7.17138586E-02  4.99462357E-01  1.48611177E-01                          
+   929  7.20066494E-02  5.00320853E-01  1.48844632E-01                          
+   930  7.23002752E-02  5.01179666E-01  1.49078129E-01                          
+   931  7.25947372E-02  5.02038793E-01  1.49311669E-01                          
+   932  7.28900366E-02  5.02898231E-01  1.49545251E-01                          
+   933  7.31861746E-02  5.03757979E-01  1.49778874E-01                          
+   934  7.34831523E-02  5.04618034E-01  1.50012538E-01                          
+   935  7.37809708E-02  5.05478394E-01  1.50246244E-01                          
+   936  7.40796315E-02  5.06339056E-01  1.50479989E-01                          
+   937  7.43791354E-02  5.07200018E-01  1.50713775E-01                          
+   938  7.46794836E-02  5.08061277E-01  1.50947600E-01                          
+   939  7.49806775E-02  5.08922832E-01  1.51181464E-01                          
+   940  7.52827180E-02  5.09784680E-01  1.51415366E-01                          
+   941  7.55856065E-02  5.10646817E-01  1.51649307E-01                          
+   942  7.58893439E-02  5.11509243E-01  1.51883286E-01                          
+   943  7.61939316E-02  5.12371955E-01  1.52117302E-01                          
+   944  7.64993707E-02  5.13234949E-01  1.52351355E-01                          
+   945  7.68056622E-02  5.14098224E-01  1.52585445E-01                          
+   946  7.71128075E-02  5.14961777E-01  1.52819571E-01                          
+   947  7.74208075E-02  5.15825605E-01  1.53053733E-01                          
+   948  7.77296635E-02  5.16689707E-01  1.53287930E-01                          
+   949  7.80393767E-02  5.17554080E-01  1.53522161E-01                          
+   950  7.83499481E-02  5.18418720E-01  1.53756428E-01                          
+   951  7.86613789E-02  5.19283626E-01  1.53990728E-01                          
+   952  7.89736703E-02  5.20148795E-01  1.54225062E-01                          
+   953  7.92868233E-02  5.21014225E-01  1.54459429E-01                          
+   954  7.96008392E-02  5.21879912E-01  1.54693829E-01                          
+   955  7.99157191E-02  5.22745855E-01  1.54928262E-01                          
+   956  8.02314640E-02  5.23612051E-01  1.55162726E-01                          
+   957  8.05480753E-02  5.24478497E-01  1.55397222E-01                          
+   958  8.08655539E-02  5.25345191E-01  1.55631749E-01                          
+   959  8.11839010E-02  5.26212129E-01  1.55866307E-01                          
+   960  8.15031177E-02  5.27079310E-01  1.56100894E-01                          
+   961  8.18232052E-02  5.27946731E-01  1.56335512E-01                          
+   962  8.21441646E-02  5.28814389E-01  1.56570159E-01                          
+   963  8.24659971E-02  5.29682281E-01  1.56804835E-01                          
+   964  8.27887036E-02  5.30550405E-01  1.57039540E-01                          
+   965  8.31122855E-02  5.31418758E-01  1.57274273E-01                          
+   966  8.34367437E-02  5.32287338E-01  1.57509033E-01                          
+   967  8.37620794E-02  5.33156141E-01  1.57743821E-01                          
+   968  8.40882937E-02  5.34025166E-01  1.57978636E-01                          
+   969  8.44153878E-02  5.34894409E-01  1.58213477E-01                          
+   970  8.47433627E-02  5.35763867E-01  1.58448344E-01                          
+   971  8.50722196E-02  5.36633538E-01  1.58683237E-01                          
+   972  8.54019595E-02  5.37503420E-01  1.58918154E-01                          
+   973  8.57325836E-02  5.38373509E-01  1.59153097E-01                          
+   974  8.60640929E-02  5.39243802E-01  1.59388064E-01                          
+   975  8.63964887E-02  5.40114297E-01  1.59623054E-01                          
+   976  8.67297719E-02  5.40984991E-01  1.59858068E-01                          
+   977  8.70639437E-02  5.41855882E-01  1.60093106E-01                          
+   978  8.73990052E-02  5.42726965E-01  1.60328165E-01                          
+   979  8.77349574E-02  5.43598240E-01  1.60563247E-01                          
+   980  8.80718016E-02  5.44469702E-01  1.60798351E-01                          
+   981  8.84095386E-02  5.45341349E-01  1.61033475E-01                          
+   982  8.87481697E-02  5.46213178E-01  1.61268621E-01                          
+   983  8.90876960E-02  5.47085186E-01  1.61503787E-01                          
+   984  8.94281185E-02  5.47957370E-01  1.61738973E-01                          
+   985  8.97694383E-02  5.48829728E-01  1.61974179E-01                          
+   986  9.01116564E-02  5.49702257E-01  1.62209404E-01                          
+   987  9.04547741E-02  5.50605717E-01  1.62444647E-01                          
+   988  9.07987923E-02  5.51447813E-01  1.62679909E-01                          
+   989  9.11437121E-02  5.52320835E-01  1.62915189E-01                          
+   990  9.14895346E-02  5.53194016E-01  1.63150486E-01                          
+   991  9.18362609E-02  5.54067353E-01  1.63387416E-01                          
+   992  9.21838920E-02  5.54940843E-01  1.63622754E-01                          
+   993  9.25324290E-02  5.55818048E-01  1.63858109E-01                          
+   994  9.28818730E-02  5.56691852E-01  1.64093479E-01                          
+   995  9.32322251E-02  5.57565800E-01  1.64328864E-01                          
+   996  9.35834862E-02  5.58439889E-01  1.64564264E-01                          
+   997  9.39356575E-02  5.59314116E-01  1.64799679E-01                          
+   998  9.42887401E-02  5.60188477E-01  1.65035108E-01                          
+   999  9.46427349E-02  5.61062971E-01  1.65270550E-01                          
+  1000  9.49976430E-02  5.61937593E-01  1.65506005E-01                          
+  1001  9.53534655E-02  5.62812341E-01  1.65741472E-01                          
+  1002  9.57102035E-02  5.63687211E-01  1.65976952E-01                          
+  1003  9.60678580E-02  5.64562201E-01  1.66212444E-01                          
+  1004  9.64264299E-02  5.65437308E-01  1.66447947E-01                          
+  1005  9.67859205E-02  5.66312527E-01  1.66683461E-01                          
+  1006  9.71463307E-02  5.67187857E-01  1.66918985E-01                          
+  1007  9.75076615E-02  5.68063294E-01  1.67154520E-01                          
+  1008  9.78699140E-02  5.68938835E-01  1.67390064E-01                          
+  1009  9.82330892E-02  5.69814477E-01  1.67625617E-01                          
+  1010  9.85971882E-02  5.70690216E-01  1.67861178E-01                          
+  1011  9.89622120E-02  5.71566050E-01  1.68096748E-01                          
+  1012  9.93281616E-02  5.72441975E-01  1.68332326E-01                          
+  1013  9.96950381E-02  5.73317988E-01  1.68567911E-01                          
+  1014  1.00062842E-01  5.74194085E-01  1.68803504E-01                          
+  1015  1.00431576E-01  5.75070265E-01  1.69039102E-01                          
+  1016  1.00801239E-01  5.75946522E-01  1.69274707E-01                          
+  1017  1.01171833E-01  5.76822855E-01  1.69510317E-01                          
+  1018  1.01543359E-01  5.77699260E-01  1.69745933E-01                          
+  1019  1.01915818E-01  5.78575733E-01  1.69981553E-01                          
+  1020  1.02289211E-01  5.79452272E-01  1.70217177E-01                          
+  1021  1.02663539E-01  5.80328873E-01  1.70452806E-01                          
+  1022  1.03038803E-01  5.81205532E-01  1.70688437E-01                          
+  1023  1.03415004E-01  5.82082247E-01  1.70924072E-01                          
+  1024  1.03792143E-01  5.82959014E-01  1.71159709E-01                          
+  1025  1.04170220E-01  5.83835830E-01  1.71395348E-01                          
+  1026  1.04549238E-01  5.84712691E-01  1.71630989E-01                          
+  1027  1.04929197E-01  5.85589594E-01  1.71866631E-01                          
+  1028  1.05310098E-01  5.86466536E-01  1.72102274E-01                          
+  1029  1.05691942E-01  5.87343514E-01  1.72337917E-01                          
+  1030  1.06074730E-01  5.88220523E-01  1.72573560E-01                          
+  1031  1.06458463E-01  5.89097561E-01  1.72809202E-01                          
+  1032  1.06843141E-01  5.89974624E-01  1.73044844E-01                          
+  1033  1.07228767E-01  5.90851709E-01  1.73280483E-01                          
+  1034  1.07615340E-01  5.91728812E-01  1.73516121E-01                          
+  1035  1.08002863E-01  5.92605930E-01  1.73751757E-01                          
+  1036  1.08391335E-01  5.93483059E-01  1.73987389E-01                          
+  1037  1.08780758E-01  5.94360196E-01  1.74223019E-01                          
+  1038  1.09171133E-01  5.95237338E-01  1.74458644E-01                          
+  1039  1.09562460E-01  5.96114481E-01  1.74694266E-01                          
+  1040  1.09954742E-01  5.96991621E-01  1.74929883E-01                          
+  1041  1.10347978E-01  5.97868755E-01  1.75165495E-01                          
+  1042  1.10742169E-01  5.98745880E-01  1.75401101E-01                          
+  1043  1.11137318E-01  5.99622992E-01  1.75636701E-01                          
+  1044  1.11533423E-01  6.00500087E-01  1.75872295E-01                          
+  1045  1.11930488E-01  6.01377162E-01  1.76107882E-01                          
+  1046  1.12328511E-01  6.02254213E-01  1.76343462E-01                          
+  1047  1.12727495E-01  6.03131238E-01  1.76579034E-01                          
+  1048  1.13127441E-01  6.04008231E-01  1.76814598E-01                          
+  1049  1.13528349E-01  6.04885190E-01  1.77050153E-01                          
+  1050  1.13930220E-01  6.05762110E-01  1.77285699E-01                          
+  1051  1.14333055E-01  6.06638989E-01  1.77521235E-01                          
+  1052  1.14736855E-01  6.07515823E-01  1.77756762E-01                          
+  1053  1.15141622E-01  6.08392608E-01  1.77992278E-01                          
+  1054  1.15547355E-01  6.09269341E-01  1.78227783E-01                          
+  1055  1.15954056E-01  6.10146017E-01  1.78463277E-01                          
+  1056  1.16361726E-01  6.11022633E-01  1.78698759E-01                          
+  1057  1.16770366E-01  6.11899186E-01  1.78934228E-01                          
+  1058  1.17179976E-01  6.12775671E-01  1.79169685E-01                          
+  1059  1.17590559E-01  6.13652086E-01  1.79405129E-01                          
+  1060  1.18002113E-01  6.14528426E-01  1.79640559E-01                          
+  1061  1.18414641E-01  6.15404687E-01  1.79875975E-01                          
+  1062  1.18828143E-01  6.16280867E-01  1.80111377E-01                          
+  1063  1.19242621E-01  6.17156961E-01  1.80346763E-01                          
+  1064  1.19658075E-01  6.18032965E-01  1.80582134E-01                          
+  1065  1.20074505E-01  6.18908875E-01  1.80817490E-01                          
+  1066  1.20491914E-01  6.19784689E-01  1.81052828E-01                          
+  1067  1.20910301E-01  6.20660402E-01  1.81288151E-01                          
+  1068  1.21329669E-01  6.21536010E-01  1.81523455E-01                          
+  1069  1.21750016E-01  6.22411510E-01  1.81758742E-01                          
+  1070  1.22171346E-01  6.23286897E-01  1.81994011E-01                          
+  1071  1.22593657E-01  6.24162168E-01  1.82229262E-01                          
+  1072  1.23016952E-01  6.25037320E-01  1.82464493E-01                          
+  1073  1.23441232E-01  6.25912347E-01  1.82699705E-01                          
+  1074  1.23866496E-01  6.26787247E-01  1.82934896E-01                          
+  1075  1.24292746E-01  6.27662015E-01  1.83170068E-01                          
+  1076  1.24719983E-01  6.28536649E-01  1.83405218E-01                          
+  1077  1.25148208E-01  6.29411142E-01  1.83640347E-01                          
+  1078  1.25577421E-01  6.30285493E-01  1.83875454E-01                          
+  1079  1.26007623E-01  6.31159697E-01  1.84110539E-01                          
+  1080  1.26438816E-01  6.32033749E-01  1.84345602E-01                          
+  1081  1.26871000E-01  6.32907647E-01  1.84580641E-01                          
+  1082  1.27304176E-01  6.33781386E-01  1.84815656E-01                          
+  1083  1.27738344E-01  6.34654963E-01  1.85050647E-01                          
+  1084  1.28173507E-01  6.35528372E-01  1.85285614E-01                          
+  1085  1.28609664E-01  6.36401611E-01  1.85520556E-01                          
+  1086  1.29046816E-01  6.37274676E-01  1.85755472E-01                          
+  1087  1.29484964E-01  6.38147561E-01  1.85990362E-01                          
+  1088  1.29924110E-01  6.39020265E-01  1.86225226E-01                          
+  1089  1.30364253E-01  6.39892781E-01  1.86460063E-01                          
+  1090  1.30805395E-01  6.40765107E-01  1.86694873E-01                          
+  1091  1.31247537E-01  6.41637239E-01  1.86929655E-01                          
+  1092  1.31690679E-01  6.42509171E-01  1.87164408E-01                          
+  1093  1.32134822E-01  6.43380902E-01  1.87399133E-01                          
+  1094  1.32579968E-01  6.44252425E-01  1.87633829E-01                          
+  1095  1.33026116E-01  6.45123738E-01  1.87868495E-01                          
+  1096  1.33473268E-01  6.45994835E-01  1.88103131E-01                          
+  1097  1.33921424E-01  6.46865714E-01  1.88337737E-01                          
+  1098  1.34370586E-01  6.47736370E-01  1.88572311E-01                          
+  1099  1.34820754E-01  6.48606799E-01  1.88806855E-01                          
+  1100  1.35271928E-01  6.49476996E-01  1.89041366E-01                          
+  1101  1.35724111E-01  6.50346959E-01  1.89275845E-01                          
+  1102  1.36177302E-01  6.51216682E-01  1.89510290E-01                          
+  1103  1.36631502E-01  6.52086161E-01  1.89744703E-01                          
+  1104  1.37086712E-01  6.52955393E-01  1.89979082E-01                          
+  1105  1.37542933E-01  6.53824372E-01  1.90213427E-01                          
+  1106  1.38000166E-01  6.54693096E-01  1.90447736E-01                          
+  1107  1.38458412E-01  6.55561560E-01  1.90682011E-01                          
+  1108  1.38917670E-01  6.56429759E-01  1.90916250E-01                          
+  1109  1.39377943E-01  6.57297690E-01  1.91150453E-01                          
+  1110  1.39839230E-01  6.58165348E-01  1.91384620E-01                          
+  1111  1.40301533E-01  6.59032730E-01  1.91618749E-01                          
+  1112  1.40764853E-01  6.59899830E-01  1.91852841E-01                          
+  1113  1.41229189E-01  6.60766645E-01  1.92086895E-01                          
+  1114  1.41694544E-01  6.61633170E-01  1.92320911E-01                          
+  1115  1.42160917E-01  6.62499402E-01  1.92554887E-01                          
+  1116  1.42628309E-01  6.63365335E-01  1.92788825E-01                          
+  1117  1.43096722E-01  6.64230966E-01  1.93022722E-01                          
+  1118  1.43566156E-01  6.65096291E-01  1.93256580E-01                          
+  1119  1.44036611E-01  6.65961305E-01  1.93490396E-01                          
+  1120  1.44508088E-01  6.66826004E-01  1.93724171E-01                          
+  1121  1.44980589E-01  6.67690384E-01  1.93957905E-01                          
+  1122  1.45454114E-01  6.68554440E-01  1.94191597E-01                          
+  1123  1.45928663E-01  6.69418168E-01  1.94425245E-01                          
+  1124  1.46404238E-01  6.70281563E-01  1.94658851E-01                          
+  1125  1.46880839E-01  6.71144623E-01  1.94892414E-01                          
+  1126  1.47358466E-01  6.72007341E-01  1.95125932E-01                          
+  1127  1.47837121E-01  6.72869714E-01  1.95359406E-01                          
+  1128  1.48316805E-01  6.73731738E-01  1.95592835E-01                          
+  1129  1.48797517E-01  6.74593407E-01  1.95826218E-01                          
+  1130  1.49279259E-01  6.75454719E-01  1.96059556E-01                          
+  1131  1.49762032E-01  6.76315668E-01  1.96292847E-01                          
+  1132  1.50245836E-01  6.77176250E-01  1.96526091E-01                          
+  1133  1.50730671E-01  6.78036460E-01  1.96759288E-01                          
+  1134  1.51216539E-01  6.78896295E-01  1.96992438E-01                          
+  1135  1.51703440E-01  6.79755750E-01  1.97225539E-01                          
+  1136  1.52191375E-01  6.80614820E-01  1.97458592E-01                          
+  1137  1.52680345E-01  6.81473501E-01  1.97691595E-01                          
+  1138  1.53170350E-01  6.82331789E-01  1.97924549E-01                          
+  1139  1.53661392E-01  6.83189679E-01  1.98157452E-01                          
+  1140  1.54153469E-01  6.84047167E-01  1.98390305E-01                          
+  1141  1.54646585E-01  6.84904249E-01  1.98623108E-01                          
+  1142  1.55140738E-01  6.85760919E-01  1.98855858E-01                          
+  1143  1.55635930E-01  6.86617174E-01  1.99088557E-01                          
+  1144  1.56132161E-01  6.87473009E-01  1.99321203E-01                          
+  1145  1.56629432E-01  6.88328420E-01  1.99553796E-01                          
+  1146  1.57127745E-01  6.89183401E-01  1.99786336E-01                          
+  1147  1.57627098E-01  6.90037950E-01  2.00018822E-01                          
+  1148  1.58127493E-01  6.90892060E-01  2.00251254E-01                          
+  1149  1.58628932E-01  6.91745729E-01  2.00483631E-01                          
+  1150  1.59131413E-01  6.92598950E-01  2.00715953E-01                          
+  1151  1.59634939E-01  6.93451720E-01  2.00948219E-01                          
+  1152  1.60139509E-01  6.94304035E-01  2.01180428E-01                          
+  1153  1.60645124E-01  6.95155889E-01  2.01412581E-01                          
+  1154  1.61151786E-01  6.96007278E-01  2.01644677E-01                          
+  1155  1.61659494E-01  6.96858198E-01  2.01876716E-01                          
+  1156  1.62168249E-01  6.97708644E-01  2.02108696E-01                          
+  1157  1.62678052E-01  6.98558611E-01  2.02340618E-01                          
+  1158  1.63188903E-01  6.99408096E-01  2.02572480E-01                          
+  1159  1.63700803E-01  7.00257093E-01  2.02804284E-01                          
+  1160  1.64213753E-01  7.01105598E-01  2.03036027E-01                          
+  1161  1.64727754E-01  7.01953607E-01  2.03267710E-01                          
+  1162  1.65242805E-01  7.02801114E-01  2.03499331E-01                          
+  1163  1.65758908E-01  7.03648116E-01  2.03730892E-01                          
+  1164  1.66276063E-01  7.04494607E-01  2.03962391E-01                          
+  1165  1.66794270E-01  7.05340584E-01  2.04193827E-01                          
+  1166  1.67313531E-01  7.06186041E-01  2.04425200E-01                          
+  1167  1.67833846E-01  7.07030974E-01  2.04656511E-01                          
+  1168  1.68355215E-01  7.07875378E-01  2.04887757E-01                          
+  1169  1.68877639E-01  7.08719249E-01  2.05118939E-01                          
+  1170  1.69401119E-01  7.09562582E-01  2.05350057E-01                          
+  1171  1.69925656E-01  7.10405373E-01  2.05581109E-01                          
+  1172  1.70451249E-01  7.11247617E-01  2.05812096E-01                          
+  1173  1.70977899E-01  7.12089309E-01  2.06043017E-01                          
+  1174  1.71505608E-01  7.12930445E-01  2.06273871E-01                          
+  1175  1.72034375E-01  7.13771020E-01  2.06504658E-01                          
+  1176  1.72564201E-01  7.14611029E-01  2.06735377E-01                          
+  1177  1.73095087E-01  7.15450468E-01  2.06966028E-01                          
+  1178  1.73627032E-01  7.16289332E-01  2.07196611E-01                          
+  1179  1.74160039E-01  7.17127617E-01  2.07427125E-01                          
+  1180  1.74694107E-01  7.17965318E-01  2.07657570E-01                          
+  1181  1.75229237E-01  7.18802430E-01  2.07887945E-01                          
+  1182  1.75765429E-01  7.19638948E-01  2.08118249E-01                          
+  1183  1.76302685E-01  7.20474869E-01  2.08348482E-01                          
+  1184  1.76841003E-01  7.21310187E-01  2.08578644E-01                          
+  1185  1.77380386E-01  7.22144897E-01  2.08808735E-01                          
+  1186  1.77920833E-01  7.22978995E-01  2.09038753E-01                          
+  1187  1.78462345E-01  7.23812477E-01  2.09268698E-01                          
+  1188  1.79004923E-01  7.24645337E-01  2.09498570E-01                          
+  1189  1.79548567E-01  7.25477571E-01  2.09728368E-01                          
+  1190  1.80093278E-01  7.26309174E-01  2.09958092E-01                          
+  1191  1.80639056E-01  7.27140142E-01  2.10202250E-01                          
+  1192  1.81185901E-01  7.27970470E-01  2.10417316E-01                          
+  1193  1.81733814E-01  7.28800153E-01  2.10646815E-01                          
+  1194  1.82282796E-01  7.29629186E-01  2.10876238E-01                          
+  1195  1.82832848E-01  7.30457565E-01  2.11105584E-01                          
+  1196  1.83383969E-01  7.31285286E-01  2.11334853E-01                          
+  1197  1.83936159E-01  7.32112342E-01  2.11564044E-01                          
+  1198  1.84489421E-01  7.32938730E-01  2.11793158E-01                          
+  1199  1.85043754E-01  7.33764446E-01  2.12022193E-01                          
+  1200  1.85599158E-01  7.34589483E-01  2.12251149E-01                          
+  1201  1.86155634E-01  7.35413838E-01  2.12480026E-01                          
+  1202  1.86713183E-01  7.36237506E-01  2.12708823E-01                          
+  1203  1.87271804E-01  7.37060482E-01  2.12937540E-01                          
+  1204  1.87831499E-01  7.37882762E-01  2.13166176E-01                          
+  1205  1.88392268E-01  7.38704340E-01  2.13394730E-01                          
+  1206  1.88954112E-01  7.39525213E-01  2.13623203E-01                          
+  1207  1.89517030E-01  7.40345374E-01  2.13851593E-01                          
+  1208  1.90081023E-01  7.41164820E-01  2.14079901E-01                          
+  1209  1.90646092E-01  7.41983546E-01  2.14308125E-01                          
+  1210  1.91212237E-01  7.42801547E-01  2.14536266E-01                          
+  1211  1.91779459E-01  7.43618818E-01  2.14764322E-01                          
+  1212  1.92347757E-01  7.44435355E-01  2.14992294E-01                          
+  1213  1.92917134E-01  7.45251153E-01  2.15220181E-01                          
+  1214  1.93487588E-01  7.46066208E-01  2.15447982E-01                          
+  1215  1.94059120E-01  7.46880513E-01  2.15675698E-01                          
+  1216  1.94631731E-01  7.47694066E-01  2.15903326E-01                          
+  1217  1.95205421E-01  7.48506860E-01  2.16130868E-01                          
+  1218  1.95780190E-01  7.49318892E-01  2.16358322E-01                          
+  1219  1.96356040E-01  7.50130156E-01  2.16585688E-01                          
+  1220  1.96932970E-01  7.50940648E-01  2.16812965E-01                          
+  1221  1.97510980E-01  7.51750364E-01  2.17040154E-01                          
+  1222  1.98090072E-01  7.52559297E-01  2.17267253E-01                          
+  1223  1.98670245E-01  7.53367445E-01  2.17494263E-01                          
+  1224  1.99251500E-01  7.54174801E-01  2.17721182E-01                          
+  1225  1.99833837E-01  7.54981361E-01  2.17948010E-01                          
+  1226  2.00417257E-01  7.55787121E-01  2.18174747E-01                          
+  1227  2.01001761E-01  7.56592076E-01  2.18401392E-01                          
+  1228  2.01587347E-01  7.57396220E-01  2.18627945E-01                          
+  1229  2.02174017E-01  7.58199550E-01  2.18859706E-01                          
+  1230  2.02761772E-01  7.59013452E-01  2.19086101E-01                          
+  1231  2.03350611E-01  7.59815199E-01  2.19312402E-01                          
+  1232  2.03940535E-01  7.60616117E-01  2.19538610E-01                          
+  1233  2.04531544E-01  7.61416202E-01  2.19764722E-01                          
+  1234  2.05123638E-01  7.62215449E-01  2.19990740E-01                          
+  1235  2.05716819E-01  7.63013852E-01  2.20216662E-01                          
+  1236  2.06311086E-01  7.63811408E-01  2.20442488E-01                          
+  1237  2.06906439E-01  7.64608112E-01  2.20668217E-01                          
+  1238  2.07502879E-01  7.65403958E-01  2.20893849E-01                          
+  1239  2.08100407E-01  7.66198943E-01  2.21119384E-01                          
+  1240  2.08699022E-01  7.66993061E-01  2.21344821E-01                          
+  1241  2.09298725E-01  7.67786308E-01  2.21570160E-01                          
+  1242  2.09899517E-01  7.68578679E-01  2.21795400E-01                          
+  1243  2.10501397E-01  7.69370169E-01  2.22020540E-01                          
+  1244  2.11104365E-01  7.70160774E-01  2.22245580E-01                          
+  1245  2.11708423E-01  7.70950489E-01  2.22470521E-01                          
+  1246  2.12313571E-01  7.71739309E-01  2.22695360E-01                          
+  1247  2.12919808E-01  7.72527230E-01  2.22920098E-01                          
+  1248  2.13527135E-01  7.73314247E-01  2.23144734E-01                          
+  1249  2.14135553E-01  7.74100355E-01  2.23369268E-01                          
+  1250  2.14745061E-01  7.74885550E-01  2.23593699E-01                          
+  1251  2.15355660E-01  7.75669826E-01  2.23818028E-01                          
+  1252  2.15967351E-01  7.76453180E-01  2.24042252E-01                          
+  1253  2.16580132E-01  7.77235606E-01  2.24266372E-01                          
+  1254  2.17194006E-01  7.78017099E-01  2.24490388E-01                          
+  1255  2.17808972E-01  7.78797656E-01  2.24714298E-01                          
+  1256  2.18425029E-01  7.79577272E-01  2.24938103E-01                          
+  1257  2.19042180E-01  7.80355941E-01  2.25161802E-01                          
+  1258  2.19660423E-01  7.81133660E-01  2.25385395E-01                          
+  1259  2.20279759E-01  7.81910423E-01  2.25608880E-01                          
+  1260  2.20900189E-01  7.82686226E-01  2.25832258E-01                          
+  1261  2.21521712E-01  7.83461064E-01  2.26055528E-01                          
+  1262  2.22144329E-01  7.84234933E-01  2.26278689E-01                          
+  1263  2.22768040E-01  7.85007827E-01  2.26501742E-01                          
+  1264  2.23392845E-01  7.85779743E-01  2.26724685E-01                          
+  1265  2.24018745E-01  7.86550676E-01  2.26947518E-01                          
+  1266  2.24645739E-01  7.87320621E-01  2.27170241E-01                          
+  1267  2.25273828E-01  7.88089574E-01  2.27392853E-01                          
+  1268  2.25903012E-01  7.88857529E-01  2.27615354E-01                          
+  1269  2.26533292E-01  7.89624482E-01  2.27837743E-01                          
+  1270  2.27164667E-01  7.90390430E-01  2.28060019E-01                          
+  1271  2.27797138E-01  7.91155366E-01  2.28282183E-01                          
+  1272  2.28430705E-01  7.91919287E-01  2.28504234E-01                          
+  1273  2.29065368E-01  7.92682187E-01  2.28726171E-01                          
+  1274  2.29701128E-01  7.93444063E-01  2.28947994E-01                          
+  1275  2.30337984E-01  7.94204910E-01  2.29169702E-01                          
+  1276  2.30975936E-01  7.94964723E-01  2.29391295E-01                          
+  1277  2.31614986E-01  7.95723498E-01  2.29612773E-01                          
+  1278  2.32255132E-01  7.96481230E-01  2.29834134E-01                          
+  1279  2.32896376E-01  7.97237915E-01  2.30055379E-01                          
+  1280  2.33538717E-01  7.97993547E-01  2.30276507E-01                          
+  1281  2.34182156E-01  7.98748123E-01  2.30497518E-01                          
+  1282  2.34826692E-01  7.99501638E-01  2.30718410E-01                          
+  1283  2.35472326E-01  8.00254088E-01  2.30939184E-01                          
+  1284  2.36119058E-01  8.01005467E-01  2.31159839E-01                          
+  1285  2.36766889E-01  8.01755772E-01  2.31380375E-01                          
+  1286  2.37415817E-01  8.02504999E-01  2.31600790E-01                          
+  1287  2.38065844E-01  8.03253141E-01  2.31821086E-01                          
+  1288  2.38716970E-01  8.04000196E-01  2.32041260E-01                          
+  1289  2.39369194E-01  8.04746158E-01  2.32261313E-01                          
+  1290  2.40022518E-01  8.05491023E-01  2.32481245E-01                          
+  1291  2.40676940E-01  8.06234787E-01  2.32701054E-01                          
+  1292  2.41332461E-01  8.06977445E-01  2.32920740E-01                          
+  1293  2.41989081E-01  8.07718993E-01  2.33140304E-01                          
+  1294  2.42646801E-01  8.08459426E-01  2.33359743E-01                          
+  1295  2.43305619E-01  8.09198741E-01  2.33579059E-01                          
+  1296  2.43965538E-01  8.09936931E-01  2.33798249E-01                          
+  1297  2.44626556E-01  8.10673994E-01  2.34017315E-01                          
+  1298  2.45288673E-01  8.11409925E-01  2.34236255E-01                          
+  1299  2.45951891E-01  8.12144719E-01  2.34455069E-01                          
+  1300  2.46616208E-01  8.12878372E-01  2.34673756E-01                          
+  1301  2.47281625E-01  8.13610879E-01  2.34892317E-01                          
+  1302  2.47948142E-01  8.14342237E-01  2.35110750E-01                          
+  1303  2.48615759E-01  8.15072441E-01  2.35329055E-01                          
+  1304  2.49284476E-01  8.15801486E-01  2.35547232E-01                          
+  1305  2.49954293E-01  8.16529369E-01  2.35765279E-01                          
+  1306  2.50625211E-01  8.17256085E-01  2.35983198E-01                          
+  1307  2.51297229E-01  8.17981629E-01  2.36200986E-01                          
+  1308  2.51970347E-01  8.18705997E-01  2.36418644E-01                          
+  1309  2.52644565E-01  8.19429186E-01  2.36636171E-01                          
+  1310  2.53319884E-01  8.20151191E-01  2.36853568E-01                          
+  1311  2.53996304E-01  8.20872007E-01  2.37070832E-01                          
+  1312  2.54673823E-01  8.21591630E-01  2.37287964E-01                          
+  1313  2.55352444E-01  8.22310057E-01  2.37504963E-01                          
+  1314  2.56032164E-01  8.23027282E-01  2.37721830E-01                          
+  1315  2.56712986E-01  8.23743302E-01  2.37938562E-01                          
+  1316  2.57394908E-01  8.24458112E-01  2.38155161E-01                          
+  1317  2.58077930E-01  8.25171708E-01  2.38371625E-01                          
+  1318  2.58762053E-01  8.25884087E-01  2.38587954E-01                          
+  1319  2.59447277E-01  8.26595243E-01  2.38804147E-01                          
+  1320  2.60133601E-01  8.27305173E-01  2.39020204E-01                          
+  1321  2.60821025E-01  8.28013873E-01  2.39236125E-01                          
+  1322  2.61509551E-01  8.28721338E-01  2.39451909E-01                          
+  1323  2.62199176E-01  8.29427564E-01  2.39667556E-01                          
+  1324  2.62889903E-01  8.30132548E-01  2.39883064E-01                          
+  1325  2.63581729E-01  8.30836284E-01  2.40098435E-01                          
+  1326  2.64274657E-01  8.31538770E-01  2.40313666E-01                          
+  1327  2.64968684E-01  8.32240000E-01  2.40528758E-01                          
+  1328  2.65663812E-01  8.32939972E-01  2.40743711E-01                          
+  1329  2.66360040E-01  8.33638680E-01  2.40958523E-01                          
+  1330  2.67057369E-01  8.34336121E-01  2.41173194E-01                          
+  1331  2.67755798E-01  8.35032291E-01  2.41387724E-01                          
+  1332  2.68455326E-01  8.35727185E-01  2.41602113E-01                          
+  1333  2.69155955E-01  8.36420801E-01  2.41816360E-01                          
+  1334  2.69857685E-01  8.37113133E-01  2.42030463E-01                          
+  1335  2.70560514E-01  8.37804178E-01  2.42244424E-01                          
+  1336  2.71264443E-01  8.38493932E-01  2.42458242E-01                          
+  1337  2.71969471E-01  8.39182390E-01  2.42671915E-01                          
+  1338  2.72675600E-01  8.39869550E-01  2.42885444E-01                          
+  1339  2.73382828E-01  8.40555407E-01  2.43098828E-01                          
+  1340  2.74091156E-01  8.41239957E-01  2.43312066E-01                          
+  1341  2.74800583E-01  8.41923197E-01  2.43525159E-01                          
+  1342  2.75511110E-01  8.42605122E-01  2.43738105E-01                          
+  1343  2.76222735E-01  8.43285728E-01  2.43950905E-01                          
+  1344  2.76935460E-01  8.43965013E-01  2.44163557E-01                          
+  1345  2.77649284E-01  8.44642971E-01  2.44376061E-01                          
+  1346  2.78364207E-01  8.45319599E-01  2.44588418E-01                          
+  1347  2.79080229E-01  8.45994894E-01  2.44800625E-01                          
+  1348  2.79797350E-01  8.46668852E-01  2.45012684E-01                          
+  1349  2.80515569E-01  8.47341468E-01  2.45224592E-01                          
+  1350  2.81234886E-01  8.48012739E-01  2.45436351E-01                          
+  1351  2.81955302E-01  8.48682662E-01  2.45647959E-01                          
+  1352  2.82676815E-01  8.49351233E-01  2.45859417E-01                          
+  1353  2.83399427E-01  8.50018447E-01  2.46070722E-01                          
+  1354  2.84123137E-01  8.50684302E-01  2.46281876E-01                          
+  1355  2.84847944E-01  8.51348793E-01  2.46492877E-01                          
+  1356  2.85573848E-01  8.52011917E-01  2.46703726E-01                          
+  1357  2.86300850E-01  8.52673671E-01  2.46914421E-01                          
+  1358  2.87028950E-01  8.53334050E-01  2.47124962E-01                          
+  1359  2.87758146E-01  8.53993052E-01  2.47335349E-01                          
+  1360  2.88488439E-01  8.54650672E-01  2.47545581E-01                          
+  1361  2.89219828E-01  8.55306907E-01  2.47755658E-01                          
+  1362  2.89952314E-01  8.55961754E-01  2.47965580E-01                          
+  1363  2.90685897E-01  8.56615208E-01  2.48175345E-01                          
+  1364  2.91420575E-01  8.57267267E-01  2.48384954E-01                          
+  1365  2.92156349E-01  8.57917927E-01  2.48594405E-01                          
+  1366  2.92893219E-01  8.58567184E-01  2.48803699E-01                          
+  1367  2.93631184E-01  8.59215036E-01  2.49012835E-01                          
+  1368  2.94370244E-01  8.59861478E-01  2.49221813E-01                          
+  1369  2.95110400E-01  8.60506507E-01  2.49430632E-01                          
+  1370  2.95851650E-01  8.61150120E-01  2.49639291E-01                          
+  1371  2.96593994E-01  8.61792313E-01  2.49847790E-01                          
+  1372  2.97337433E-01  8.62433083E-01  2.50056130E-01                          
+  1373  2.98081966E-01  8.63072427E-01  2.50264308E-01                          
+  1374  2.98827593E-01  8.63710341E-01  2.50472325E-01                          
+  1375  2.99574313E-01  8.64346822E-01  2.50680181E-01                          
+  1376  3.00322127E-01  8.64981867E-01  2.50887874E-01                          
+  1377  3.01071033E-01  8.65615472E-01  2.51095405E-01                          
+  1378  3.01821033E-01  8.66247635E-01  2.51302772E-01                          
+  1379  3.02572125E-01  8.66878352E-01  2.51509976E-01                          
+  1380  3.03324309E-01  8.67507619E-01  2.51717017E-01                          
+  1381  3.04077585E-01  8.68135434E-01  2.51923892E-01                          
+  1382  3.04831953E-01  8.68761793E-01  2.52130603E-01                          
+  1383  3.05587412E-01  8.69386694E-01  2.52337148E-01                          
+  1384  3.06343962E-01  8.70010132E-01  2.52543528E-01                          
+  1385  3.07101604E-01  8.70632106E-01  2.52749741E-01                          
+  1386  3.07860335E-01  8.71252611E-01  2.52955788E-01                          
+  1387  3.08620157E-01  8.71871646E-01  2.53161667E-01                          
+  1388  3.09381069E-01  8.72489206E-01  2.53367379E-01                          
+  1389  3.10143070E-01  8.73105289E-01  2.53572922E-01                          
+  1390  3.10906161E-01  8.73719891E-01  2.53778297E-01                          
+  1391  3.11670341E-01  8.74333011E-01  2.53983503E-01                          
+  1392  3.12435609E-01  8.74944644E-01  2.54188540E-01                          
+  1393  3.13201966E-01  8.75554788E-01  2.54393406E-01                          
+  1394  3.13969410E-01  8.76163440E-01  2.54598102E-01                          
+  1395  3.14737943E-01  8.76770597E-01  2.54802627E-01                          
+  1396  3.15507562E-01  8.77376256E-01  2.55006981E-01                          
+  1397  3.16278268E-01  8.77980414E-01  2.55211163E-01                          
+  1398  3.17050062E-01  8.78583068E-01  2.55415173E-01                          
+  1399  3.17822941E-01  8.79184216E-01  2.55619010E-01                          
+  1400  3.18596906E-01  8.79783855E-01  2.55822674E-01                          
+  1401  3.19371957E-01  8.80381982E-01  2.56026165E-01                          
+  1402  3.20148092E-01  8.80978595E-01  2.56229481E-01                          
+  1403  3.20925313E-01  8.81573689E-01  2.56432623E-01                          
+  1404  3.21703618E-01  8.82167264E-01  2.56635590E-01                          
+  1405  3.22483007E-01  8.82759315E-01  2.56838381E-01                          
+  1406  3.23263479E-01  8.83349841E-01  2.57040997E-01                          
+  1407  3.24045035E-01  8.83938839E-01  2.57243436E-01                          
+  1408  3.24827673E-01  8.84526306E-01  2.57445699E-01                          
+  1409  3.25611394E-01  8.85112240E-01  2.57647784E-01                          
+  1410  3.26396197E-01  8.85696637E-01  2.57849692E-01                          
+  1411  3.27182081E-01  8.86279496E-01  2.58051421E-01                          
+  1412  3.27969047E-01  8.86860814E-01  2.58252972E-01                          
+  1413  3.28757093E-01  8.87440588E-01  2.58454344E-01                          
+  1414  3.29546220E-01  8.88018817E-01  2.58655536E-01                          
+  1415  3.30336426E-01  8.88595496E-01  2.58856549E-01                          
+  1416  3.31127712E-01  8.89170625E-01  2.59057381E-01                          
+  1417  3.31920077E-01  8.89744201E-01  2.59258032E-01                          
+  1418  3.32713521E-01  8.90316220E-01  2.59458502E-01                          
+  1419  3.33508042E-01  8.90886682E-01  2.59658790E-01                          
+  1420  3.34303642E-01  8.91455583E-01  2.59858896E-01                          
+  1421  3.35100318E-01  8.92022921E-01  2.60058820E-01                          
+  1422  3.35898071E-01  8.92588694E-01  2.60258560E-01                          
+  1423  3.36696901E-01  8.93152899E-01  2.60458117E-01                          
+  1424  3.37496806E-01  8.93715536E-01  2.60657490E-01                          
+  1425  3.38297786E-01  8.94276600E-01  2.60856678E-01                          
+  1426  3.39099842E-01  8.94836090E-01  2.61055681E-01                          
+  1427  3.39902971E-01  8.95394004E-01  2.61254500E-01                          
+  1428  3.40707175E-01  8.95950340E-01  2.61453132E-01                          
+  1429  3.41512452E-01  8.96505095E-01  2.61651578E-01                          
+  1430  3.42318801E-01  8.97058267E-01  2.61849838E-01                          
+  1431  3.43126223E-01  8.97609855E-01  2.62047911E-01                          
+  1432  3.43934717E-01  8.98159857E-01  2.62245796E-01                          
+  1433  3.44744282E-01  8.98708269E-01  2.62443493E-01                          
+  1434  3.45554918E-01  8.99255091E-01  2.62641001E-01                          
+  1435  3.46366624E-01  8.99800320E-01  2.62838321E-01                          
+  1436  3.47179400E-01  9.00343954E-01  2.63035451E-01                          
+  1437  3.47993245E-01  9.00885992E-01  2.63232392E-01                          
+  1438  3.48808159E-01  9.01426432E-01  2.63429142E-01                          
+  1439  3.49624141E-01  9.01965271E-01  2.63625702E-01                          
+  1440  3.50441190E-01  9.02502508E-01  2.63822070E-01                          
+  1441  3.51259307E-01  9.03038141E-01  2.64018248E-01                          
+  1442  3.52078490E-01  9.03572168E-01  2.64214233E-01                          
+  1443  3.52898739E-01  9.04104587E-01  2.64410025E-01                          
+  1444  3.53720053E-01  9.04635397E-01  2.64605625E-01                          
+  1445  3.54542432E-01  9.05164597E-01  2.64801032E-01                          
+  1446  3.55365875E-01  9.05692183E-01  2.64996245E-01                          
+  1447  3.56190382E-01  9.06218155E-01  2.65191263E-01                          
+  1448  3.57015951E-01  9.06742511E-01  2.65386087E-01                          
+  1449  3.57842583E-01  9.07265250E-01  2.65580716E-01                          
+  1450  3.58670277E-01  9.07786369E-01  2.65775150E-01                          
+  1451  3.59499033E-01  9.08305868E-01  2.65969387E-01                          
+  1452  3.60328848E-01  9.08823744E-01  2.66163428E-01                          
+  1453  3.61159724E-01  9.09339996E-01  2.66362901E-01                          
+  1454  3.61991660E-01  9.09866477E-01  2.66550920E-01                          
+  1455  3.62824654E-01  9.10367624E-01  2.66744369E-01                          
+  1456  3.63658706E-01  9.10878996E-01  2.66937621E-01                          
+  1457  3.64493816E-01  9.11388739E-01  2.67130674E-01                          
+  1458  3.65329982E-01  9.11896850E-01  2.67323527E-01                          
+  1459  3.66167205E-01  9.12403330E-01  2.67516182E-01                          
+  1460  3.67005484E-01  9.12908176E-01  2.67708636E-01                          
+  1461  3.67844817E-01  9.13411387E-01  2.67900890E-01                          
+  1462  3.68685205E-01  9.13912962E-01  2.68092944E-01                          
+  1463  3.69526646E-01  9.14412899E-01  2.68284796E-01                          
+  1464  3.70369141E-01  9.14911198E-01  2.68476447E-01                          
+  1465  3.71212688E-01  9.15407858E-01  2.68667896E-01                          
+  1466  3.72057286E-01  9.15902876E-01  2.68859142E-01                          
+  1467  3.72902936E-01  9.16396252E-01  2.69050185E-01                          
+  1468  3.73749636E-01  9.16887985E-01  2.69241025E-01                          
+  1469  3.74597385E-01  9.17378074E-01  2.69431661E-01                          
+  1470  3.75446184E-01  9.17866518E-01  2.69622094E-01                          
+  1471  3.76296030E-01  9.18353316E-01  2.69812321E-01                          
+  1472  3.77146924E-01  9.18838466E-01  2.70002343E-01                          
+  1473  3.77998866E-01  9.19321968E-01  2.70192160E-01                          
+  1474  3.78851853E-01  9.19803821E-01  2.70381771E-01                          
+  1475  3.79705885E-01  9.20284024E-01  2.70571176E-01                          
+  1476  3.80560963E-01  9.20762577E-01  2.70760374E-01                          
+  1477  3.81417084E-01  9.21239477E-01  2.70949365E-01                          
+  1478  3.82274249E-01  9.21714725E-01  2.71138148E-01                          
+  1479  3.83132456E-01  9.22188320E-01  2.71326723E-01                          
+  1480  3.83991705E-01  9.22660260E-01  2.71515089E-01                          
+  1481  3.84851995E-01  9.23130546E-01  2.71703247E-01                          
+  1482  3.85713325E-01  9.23599176E-01  2.71891195E-01                          
+  1483  3.86575695E-01  9.24066150E-01  2.72078934E-01                          
+  1484  3.87439104E-01  9.24531468E-01  2.72266462E-01                          
+  1485  3.88303551E-01  9.24995128E-01  2.72453780E-01                          
+  1486  3.89169035E-01  9.25457129E-01  2.72640887E-01                          
+  1487  3.90035555E-01  9.25917473E-01  2.72827782E-01                          
+  1488  3.90903112E-01  9.26376157E-01  2.73014466E-01                          
+  1489  3.91771703E-01  9.26833182E-01  2.73200937E-01                          
+  1490  3.92641328E-01  9.27288546E-01  2.73387195E-01                          
+  1491  3.93511987E-01  9.27742250E-01  2.73573241E-01                          
+  1492  3.94383679E-01  9.28194293E-01  2.73759072E-01                          
+  1493  3.95256402E-01  9.28644675E-01  2.73944690E-01                          
+  1494  3.96130156E-01  9.29093395E-01  2.74130093E-01                          
+  1495  3.97004941E-01  9.29540453E-01  2.74315282E-01                          
+  1496  3.97880754E-01  9.29985849E-01  2.74500255E-01                          
+  1497  3.98757597E-01  9.30429582E-01  2.74685013E-01                          
+  1498  3.99635467E-01  9.30871653E-01  2.74869554E-01                          
+  1499  4.00514364E-01  9.31312060E-01  2.75053879E-01                          
+  1500  4.01394287E-01  9.31750805E-01  2.75237987E-01                          
+  1501  4.02275236E-01  9.32187886E-01  2.75421878E-01                          
+  1502  4.03157209E-01  9.32623303E-01  2.75605551E-01                          
+  1503  4.04040205E-01  9.33057057E-01  2.75789006E-01                          
+  1504  4.04924225E-01  9.33489148E-01  2.75972242E-01                          
+  1505  4.05809266E-01  9.33919575E-01  2.76155259E-01                          
+  1506  4.06695328E-01  9.34348338E-01  2.76338057E-01                          
+  1507  4.07582410E-01  9.34775437E-01  2.76524139E-01                          
+  1508  4.08470512E-01  9.35200873E-01  2.76702992E-01                          
+  1509  4.09359632E-01  9.35624646E-01  2.76885129E-01                          
+  1510  4.10249769E-01  9.36046755E-01  2.77067045E-01                          
+  1511  4.11140924E-01  9.36474531E-01  2.77248740E-01                          
+  1512  4.12033094E-01  9.36885984E-01  2.77430212E-01                          
+  1513  4.12926279E-01  9.37303104E-01  2.77611462E-01                          
+  1514  4.13820477E-01  9.37718562E-01  2.77792490E-01                          
+  1515  4.14715689E-01  9.38132357E-01  2.77973294E-01                          
+  1516  4.15611914E-01  9.38544490E-01  2.78153875E-01                          
+  1517  4.16509149E-01  9.38954962E-01  2.78334232E-01                          
+  1518  4.17407395E-01  9.39363772E-01  2.78514364E-01                          
+  1519  4.18306650E-01  9.39770921E-01  2.78694271E-01                          
+  1520  4.19206914E-01  9.40176410E-01  2.78873954E-01                          
+  1521  4.20108185E-01  9.40580238E-01  2.79053411E-01                          
+  1522  4.21010463E-01  9.40982407E-01  2.79232641E-01                          
+  1523  4.21913747E-01  9.41382916E-01  2.79411646E-01                          
+  1524  4.22818036E-01  9.41781767E-01  2.79590423E-01                          
+  1525  4.23723328E-01  9.42178960E-01  2.79768974E-01                          
+  1526  4.24629624E-01  9.42574496E-01  2.79947296E-01                          
+  1527  4.25536921E-01  9.42968374E-01  2.80125391E-01                          
+  1528  4.26445219E-01  9.43360597E-01  2.80303257E-01                          
+  1529  4.27354517E-01  9.43751163E-01  2.80480894E-01                          
+  1530  4.28264814E-01  9.44140075E-01  2.80658302E-01                          
+  1531  4.29176110E-01  9.44527333E-01  2.80835480E-01                          
+  1532  4.30088402E-01  9.44912938E-01  2.81012429E-01                          
+  1533  4.31001691E-01  9.45296890E-01  2.81189147E-01                          
+  1534  4.31915974E-01  9.45679190E-01  2.81365633E-01                          
+  1535  4.32831252E-01  9.46059840E-01  2.81541889E-01                          
+  1536  4.33747523E-01  9.46438839E-01  2.81717913E-01                          
+  1537  4.34664786E-01  9.46816190E-01  2.81893705E-01                          
+  1538  4.35583040E-01  9.47191892E-01  2.82069264E-01                          
+  1539  4.36502284E-01  9.47565948E-01  2.82244591E-01                          
+  1540  4.37422518E-01  9.47938357E-01  2.82419684E-01                          
+  1541  4.38343739E-01  9.48309121E-01  2.82594543E-01                          
+  1542  4.39265947E-01  9.48678241E-01  2.82769169E-01                          
+  1543  4.40189142E-01  9.49045718E-01  2.82943560E-01                          
+  1544  4.41113321E-01  9.49411554E-01  2.83117716E-01                          
+  1545  4.42038484E-01  9.49775749E-01  2.83291637E-01                          
+  1546  4.42964631E-01  9.50138304E-01  2.83465322E-01                          
+  1547  4.43891759E-01  9.50499221E-01  2.83638771E-01                          
+  1548  4.44819867E-01  9.50858501E-01  2.83811983E-01                          
+  1549  4.45748956E-01  9.51216145E-01  2.83984959E-01                          
+  1550  4.46679023E-01  9.51572155E-01  2.84157697E-01                          
+  1551  4.47610068E-01  9.51926532E-01  2.84330198E-01                          
+  1552  4.48542089E-01  9.52279277E-01  2.84502461E-01                          
+  1553  4.49475086E-01  9.52630391E-01  2.84674485E-01                          
+  1554  4.50409058E-01  9.52979877E-01  2.84846271E-01                          
+  1555  4.51344002E-01  9.53327735E-01  2.85017817E-01                          
+  1556  4.52279919E-01  9.53673967E-01  2.85189124E-01                          
+  1557  4.53216807E-01  9.54018575E-01  2.85360190E-01                          
+  1558  4.54154664E-01  9.54361559E-01  2.85531017E-01                          
+  1559  4.55093491E-01  9.54702923E-01  2.85701602E-01                          
+  1560  4.56033286E-01  9.55042666E-01  2.85871947E-01                          
+  1561  4.56974047E-01  9.55380791E-01  2.86042049E-01                          
+  1562  4.57915773E-01  9.55717300E-01  2.86211910E-01                          
+  1563  4.58858465E-01  9.56052193E-01  2.86381528E-01                          
+  1564  4.59802119E-01  9.56385474E-01  2.86550904E-01                          
+  1565  4.60746736E-01  9.56717143E-01  2.86720037E-01                          
+  1566  4.61692314E-01  9.57047202E-01  2.86888926E-01                          
+  1567  4.62638851E-01  9.57375654E-01  2.87057571E-01                          
+  1568  4.63586348E-01  9.57702499E-01  2.87225972E-01                          
+  1569  4.64534802E-01  9.58027741E-01  2.87394128E-01                          
+  1570  4.65484212E-01  9.58351380E-01  2.87562039E-01                          
+  1571  4.66434578E-01  9.58673418E-01  2.87729705E-01                          
+  1572  4.67385898E-01  9.58993858E-01  2.87897125E-01                          
+  1573  4.68338171E-01  9.59312702E-01  2.88064299E-01                          
+  1574  4.69291395E-01  9.59629951E-01  2.88231226E-01                          
+  1575  4.70245571E-01  9.59945608E-01  2.88397906E-01                          
+  1576  4.71200696E-01  9.60259674E-01  2.88564339E-01                          
+  1577  4.72156769E-01  9.60572152E-01  2.88730524E-01                          
+  1578  4.73113789E-01  9.60883043E-01  2.88896461E-01                          
+  1579  4.74071755E-01  9.61192351E-01  2.89062150E-01                          
+  1580  4.75030665E-01  9.61500076E-01  2.89227590E-01                          
+  1581  4.75990519E-01  9.61806222E-01  2.89392780E-01                          
+  1582  4.76951316E-01  9.62110790E-01  2.89557721E-01                          
+  1583  4.77913053E-01  9.62413783E-01  2.89722412E-01                          
+  1584  4.78875730E-01  9.62715203E-01  2.89886852E-01                          
+  1585  4.79839346E-01  9.63015052E-01  2.90051042E-01                          
+  1586  4.80803899E-01  9.63313333E-01  2.90214980E-01                          
+  1587  4.81769388E-01  9.63610047E-01  2.90378667E-01                          
+  1588  4.82735813E-01  9.63905199E-01  2.90542102E-01                          
+  1589  4.83703171E-01  9.64198788E-01  2.90705285E-01                          
+  1590  4.84671461E-01  9.64490820E-01  2.90868216E-01                          
+  1591  4.85640682E-01  9.64781294E-01  2.91030893E-01                          
+  1592  4.86610834E-01  9.65070215E-01  2.91193317E-01                          
+  1593  4.87581914E-01  9.65357585E-01  2.91355487E-01                          
+  1594  4.88553922E-01  9.65643406E-01  2.91517403E-01                          
+  1595  4.89526855E-01  9.65927681E-01  2.91679064E-01                          
+  1596  4.90500714E-01  9.66210412E-01  2.91840471E-01                          
+  1597  4.91475496E-01  9.66491602E-01  2.92001622E-01                          
+  1598  4.92451200E-01  9.66771254E-01  2.92162518E-01                          
+  1599  4.93427826E-01  9.67049371E-01  2.92323158E-01                          
+  1600  4.94405371E-01  9.67325954E-01  2.92483542E-01                          
+  1601  4.95383835E-01  9.67601008E-01  2.92643668E-01                          
+  1602  4.96363215E-01  9.67874534E-01  2.92803538E-01                          
+  1603  4.97343512E-01  9.68146535E-01  2.92963150E-01                          
+  1604  4.98324723E-01  9.68417015E-01  2.93122505E-01                          
+  1605  4.99306847E-01  9.68685976E-01  2.93281601E-01                          
+  1606  5.00289884E-01  9.68953420E-01  2.93440438E-01                          
+  1607  5.01273831E-01  9.69219352E-01  2.93599017E-01                          
+  1608  5.02258687E-01  9.69483773E-01  2.93757337E-01                          
+  1609  5.03244451E-01  9.69746687E-01  2.93915396E-01                          
+  1610  5.04231122E-01  9.70008096E-01  2.94073196E-01                          
+  1611  5.05218697E-01  9.70268005E-01  2.94230736E-01                          
+  1612  5.06207177E-01  9.70526414E-01  2.94388014E-01                          
+  1613  5.07196560E-01  9.70783329E-01  2.94545032E-01                          
+  1614  5.08186843E-01  9.71038752E-01  2.94701788E-01                          
+  1615  5.09178027E-01  9.71292685E-01  2.94858282E-01                          
+  1616  5.10170109E-01  9.71545132E-01  2.95014515E-01                          
+  1617  5.11163088E-01  9.71796097E-01  2.95170484E-01                          
+  1618  5.12156963E-01  9.72045582E-01  2.95326191E-01                          
+  1619  5.13151732E-01  9.72293590E-01  2.95481634E-01                          
+  1620  5.14147395E-01  9.72540125E-01  2.95636814E-01                          
+  1621  5.15143949E-01  9.72785190E-01  2.95791730E-01                          
+  1622  5.16141393E-01  9.73028789E-01  2.95946382E-01                          
+  1623  5.17139726E-01  9.73270924E-01  2.96100768E-01                          
+  1624  5.18138947E-01  9.73511599E-01  2.96254890E-01                          
+  1625  5.19139053E-01  9.73750817E-01  2.96408747E-01                          
+  1626  5.20140045E-01  9.73988582E-01  2.96562337E-01                          
+  1627  5.21141919E-01  9.74224896E-01  2.96715662E-01                          
+  1628  5.22144676E-01  9.74459764E-01  2.96868720E-01                          
+  1629  5.23148313E-01  9.74693189E-01  2.97021511E-01                          
+  1630  5.24152829E-01  9.74925175E-01  2.97174035E-01                          
+  1631  5.25158222E-01  9.75155724E-01  2.97326291E-01                          
+  1632  5.26164492E-01  9.75384840E-01  2.97478280E-01                          
+  1633  5.27171636E-01  9.75612527E-01  2.97630000E-01                          
+  1634  5.28179654E-01  9.75838789E-01  2.97781452E-01                          
+  1635  5.29188543E-01  9.76063628E-01  2.97932635E-01                          
+  1636  5.30198303E-01  9.76287049E-01  2.98083549E-01                          
+  1637  5.31208932E-01  9.76509055E-01  2.98234193E-01                          
+  1638  5.32220428E-01  9.76729650E-01  2.98384567E-01                          
+  1639  5.33232791E-01  9.76948838E-01  2.98534670E-01                          
+  1640  5.34246018E-01  9.77166621E-01  2.98684503E-01                          
+  1641  5.35260108E-01  9.77383005E-01  2.98834065E-01                          
+  1642  5.36275059E-01  9.77597992E-01  2.98983356E-01                          
+  1643  5.37290871E-01  9.77811587E-01  2.99132375E-01                          
+  1644  5.38307542E-01  9.78023792E-01  2.99281122E-01                          
+  1645  5.39325069E-01  9.78234613E-01  2.99429596E-01                          
+  1646  5.40343453E-01  9.78444052E-01  2.99577798E-01                          
+  1647  5.41362690E-01  9.78652114E-01  2.99725726E-01                          
+  1648  5.42382780E-01  9.78858803E-01  2.99873381E-01                          
+  1649  5.43403722E-01  9.79064121E-01  3.00020763E-01                          
+  1650  5.44425513E-01  9.79268074E-01  3.00167870E-01                          
+  1651  5.45448152E-01  9.79470665E-01  3.00314703E-01                          
+  1652  5.46471638E-01  9.79671899E-01  3.00461260E-01                          
+  1653  5.47495970E-01  9.79871778E-01  3.00607543E-01                          
+  1654  5.48521144E-01  9.80070307E-01  3.00753550E-01                          
+  1655  5.49547161E-01  9.80267491E-01  3.00899282E-01                          
+  1656  5.50574019E-01  9.80463332E-01  3.01044737E-01                          
+  1657  5.51601715E-01  9.80657836E-01  3.01189916E-01                          
+  1658  5.52630249E-01  9.80851006E-01  3.01334818E-01                          
+  1659  5.53659619E-01  9.81042846E-01  3.01479442E-01                          
+  1660  5.54689824E-01  9.81233360E-01  3.01623790E-01                          
+  1661  5.55720861E-01  9.81422553E-01  3.01767859E-01                          
+  1662  5.56752729E-01  9.81610428E-01  3.01911650E-01                          
+  1663  5.57785428E-01  9.81796991E-01  3.02055163E-01                          
+  1664  5.58818954E-01  9.81982244E-01  3.02198396E-01                          
+  1665  5.59853307E-01  9.82166192E-01  3.02341351E-01                          
+  1666  5.60888485E-01  9.82348840E-01  3.02484026E-01                          
+  1667  5.61924487E-01  9.82530191E-01  3.02626421E-01                          
+  1668  5.62961310E-01  9.82710251E-01  3.02768536E-01                          
+  1669  5.63998954E-01  9.82889022E-01  3.02910370E-01                          
+  1670  5.65037416E-01  9.83066510E-01  3.03051923E-01                          
+  1671  5.66076696E-01  9.83242718E-01  3.03193196E-01                          
+  1672  5.67116791E-01  9.83417652E-01  3.03334186E-01                          
+  1673  5.68157700E-01  9.83591314E-01  3.03474895E-01                          
+  1674  5.69199421E-01  9.83763711E-01  3.03615322E-01                          
+  1675  5.70241953E-01  9.83934845E-01  3.03755466E-01                          
+  1676  5.71285294E-01  9.84104723E-01  3.03895327E-01                          
+  1677  5.72329442E-01  9.84273346E-01  3.04034905E-01                          
+  1678  5.73374397E-01  9.84440722E-01  3.04174199E-01                          
+  1679  5.74420155E-01  9.84606853E-01  3.04313210E-01                          
+  1680  5.75466716E-01  9.84771744E-01  3.04451936E-01                          
+  1681  5.76514078E-01  9.84935400E-01  3.04590378E-01                          
+  1682  5.77562240E-01  9.85097825E-01  3.04728536E-01                          
+  1683  5.78611199E-01  9.85259023E-01  3.04866408E-01                          
+  1684  5.79660954E-01  9.85419000E-01  3.05003994E-01                          
+  1685  5.80711503E-01  9.85577760E-01  3.05141295E-01                          
+  1686  5.81762846E-01  9.85735306E-01  3.05278309E-01                          
+  1687  5.82814979E-01  9.85891645E-01  3.05415037E-01                          
+  1688  5.83867901E-01  9.86046780E-01  3.05551479E-01                          
+  1689  5.84921612E-01  9.86200715E-01  3.05687633E-01                          
+  1690  5.85976108E-01  9.86353457E-01  3.05823500E-01                          
+  1691  5.87031389E-01  9.86505008E-01  3.05959079E-01                          
+  1692  5.88087453E-01  9.86655375E-01  3.06094370E-01                          
+  1693  5.89144297E-01  9.86804560E-01  3.06229372E-01                          
+  1694  5.90201921E-01  9.86952570E-01  3.06364086E-01                          
+  1695  5.91260323E-01  9.87099409E-01  3.06498511E-01                          
+  1696  5.92319500E-01  9.87245081E-01  3.06632646E-01                          
+  1697  5.93379452E-01  9.87389591E-01  3.06766492E-01                          
+  1698  5.94440177E-01  9.87532944E-01  3.06900048E-01                          
+  1699  5.95501672E-01  9.87675145E-01  3.07033313E-01                          
+  1700  5.96563936E-01  9.87816198E-01  3.07166288E-01                          
+  1701  5.97626968E-01  9.87956108E-01  3.07298972E-01                          
+  1702  5.98690766E-01  9.88094880E-01  3.07431365E-01                          
+  1703  5.99755327E-01  9.88232519E-01  3.07563466E-01                          
+  1704  6.00820651E-01  9.88369029E-01  3.07695275E-01                          
+  1705  6.01886736E-01  9.88504415E-01  3.07826792E-01                          
+  1706  6.02953579E-01  9.88638682E-01  3.07958016E-01                          
+  1707  6.04021179E-01  9.88771835E-01  3.08088948E-01                          
+  1708  6.05089535E-01  9.88903879E-01  3.08219586E-01                          
+  1709  6.06158644E-01  9.89034818E-01  3.08349931E-01                          
+  1710  6.07228506E-01  9.89164658E-01  3.08479982E-01                          
+  1711  6.08299117E-01  9.89293402E-01  3.08609739E-01                          
+  1712  6.09370476E-01  9.89421057E-01  3.08739201E-01                          
+  1713  6.10442583E-01  9.89547627E-01  3.08868369E-01                          
+  1714  6.11515434E-01  9.89673116E-01  3.08997242E-01                          
+  1715  6.12589028E-01  9.89797530E-01  3.09125819E-01                          
+  1716  6.13663363E-01  9.89920874E-01  3.09254101E-01                          
+  1717  6.14738438E-01  9.90043152E-01  3.09382087E-01                          
+  1718  6.15814250E-01  9.90164370E-01  3.09509776E-01                          
+  1719  6.16890799E-01  9.90284533E-01  3.09637169E-01                          
+  1720  6.17968082E-01  9.90403644E-01  3.09764265E-01                          
+  1721  6.19046097E-01  9.90521710E-01  3.09891064E-01                          
+  1722  6.20124843E-01  9.90638735E-01  3.10017565E-01                          
+  1723  6.21204317E-01  9.90754725E-01  3.10143768E-01                          
+  1724  6.22284519E-01  9.90869683E-01  3.10269673E-01                          
+  1725  6.23365445E-01  9.90983616E-01  3.10395280E-01                          
+  1726  6.24447095E-01  9.91096528E-01  3.10520588E-01                          
+  1727  6.25529467E-01  9.91208425E-01  3.10645597E-01                          
+  1728  6.26612558E-01  9.91319310E-01  3.10770307E-01                          
+  1729  6.27696368E-01  9.91429190E-01  3.10894716E-01                          
+  1730  6.28780893E-01  9.91544180E-01  3.11018826E-01                          
+  1731  6.29866133E-01  9.91652048E-01  3.11142636E-01                          
+  1732  6.30952085E-01  9.91758926E-01  3.11266144E-01                          
+  1733  6.32038748E-01  9.91864819E-01  3.11389352E-01                          
+  1734  6.33126120E-01  9.91963677E-01  3.11512259E-01                          
+  1735  6.34214198E-01  9.92067628E-01  3.11634864E-01                          
+  1736  6.35302982E-01  9.92170607E-01  3.11757168E-01                          
+  1737  6.36392469E-01  9.92272622E-01  3.11879169E-01                          
+  1738  6.37482657E-01  9.92373676E-01  3.12000868E-01                          
+  1739  6.38573545E-01  9.92473775E-01  3.12122264E-01                          
+  1740  6.39665131E-01  9.92572923E-01  3.12243357E-01                          
+  1741  6.40757412E-01  9.92671126E-01  3.12364147E-01                          
+  1742  6.41850387E-01  9.92768390E-01  3.12484633E-01                          
+  1743  6.42944055E-01  9.92864718E-01  3.12604815E-01                          
+  1744  6.44038413E-01  9.92960116E-01  3.12724692E-01                          
+  1745  6.45133459E-01  9.93054589E-01  3.12844266E-01                          
+  1746  6.46229191E-01  9.93148143E-01  3.12963534E-01                          
+  1747  6.47325608E-01  9.93240782E-01  3.13082497E-01                          
+  1748  6.48422708E-01  9.93332511E-01  3.13201155E-01                          
+  1749  6.49520489E-01  9.93423336E-01  3.13319507E-01                          
+  1750  6.50618948E-01  9.93513262E-01  3.13437553E-01                          
+  1751  6.51718085E-01  9.93602293E-01  3.13555293E-01                          
+  1752  6.52817896E-01  9.93690436E-01  3.13672725E-01                          
+  1753  6.53918381E-01  9.93777694E-01  3.13789851E-01                          
+  1754  6.55019537E-01  9.93864073E-01  3.13906670E-01                          
+  1755  6.56121363E-01  9.93949579E-01  3.14023181E-01                          
+  1756  6.57223856E-01  9.94034216E-01  3.14139384E-01                          
+  1757  6.58327014E-01  9.94117989E-01  3.14255279E-01                          
+  1758  6.59430837E-01  9.94200904E-01  3.14370866E-01                          
+  1759  6.60535321E-01  9.94282966E-01  3.14486144E-01                          
+  1760  6.61640464E-01  9.94364180E-01  3.14601113E-01                          
+  1761  6.62746266E-01  9.94444550E-01  3.14715772E-01                          
+  1762  6.63852723E-01  9.94524083E-01  3.14830122E-01                          
+  1763  6.64959835E-01  9.94602782E-01  3.14944162E-01                          
+  1764  6.66067598E-01  9.94680654E-01  3.15057891E-01                          
+  1765  6.67176012E-01  9.94757704E-01  3.15171310E-01                          
+  1766  6.68285074E-01  9.94833936E-01  3.15284419E-01                          
+  1767  6.69394782E-01  9.94909356E-01  3.15397216E-01                          
+  1768  6.70505134E-01  9.94983968E-01  3.15509701E-01                          
+  1769  6.71616128E-01  9.95057779E-01  3.15621875E-01                          
+  1770  6.72727763E-01  9.95130792E-01  3.15733737E-01                          
+  1771  6.73840036E-01  9.95203014E-01  3.15845286E-01                          
+  1772  6.74952946E-01  9.95274448E-01  3.15956523E-01                          
+  1773  6.76066490E-01  9.95345101E-01  3.16067447E-01                          
+  1774  6.77180666E-01  9.95414978E-01  3.16178058E-01                          
+  1775  6.78295473E-01  9.95484083E-01  3.16288355E-01                          
+  1776  6.79410908E-01  9.95552422E-01  3.16398338E-01                          
+  1777  6.80526970E-01  9.95619999E-01  3.16508008E-01                          
+  1778  6.81643656E-01  9.95686820E-01  3.16617362E-01                          
+  1779  6.82760965E-01  9.95752890E-01  3.16726403E-01                          
+  1780  6.83878894E-01  9.95818215E-01  3.16835128E-01                          
+  1781  6.84997442E-01  9.95882798E-01  3.16943538E-01                          
+  1782  6.86116606E-01  9.95946645E-01  3.17051632E-01                          
+  1783  6.87236385E-01  9.96009762E-01  3.17159410E-01                          
+  1784  6.88356776E-01  9.96072153E-01  3.17266873E-01                          
+  1785  6.89477778E-01  9.96133823E-01  3.17374018E-01                          
+  1786  6.90599389E-01  9.96194778E-01  3.17480847E-01                          
+  1787  6.91721605E-01  9.96255022E-01  3.17587359E-01                          
+  1788  6.92844427E-01  9.96314561E-01  3.17693554E-01                          
+  1789  6.93967850E-01  9.96373399E-01  3.17799430E-01                          
+  1790  6.95091874E-01  9.96431542E-01  3.17904989E-01                          
+  1791  6.96216497E-01  9.96488994E-01  3.18010230E-01                          
+  1792  6.97341715E-01  9.96545761E-01  3.18115152E-01                          
+  1793  6.98467528E-01  9.96601848E-01  3.18219755E-01                          
+  1794  6.99593934E-01  9.96657259E-01  3.18324039E-01                          
+  1795  7.00720929E-01  9.96712001E-01  3.18428004E-01                          
+  1796  7.01848513E-01  9.96766076E-01  3.18531649E-01                          
+  1797  7.02976683E-01  9.96819492E-01  3.18634974E-01                          
+  1798  7.04105437E-01  9.96872252E-01  3.18737978E-01                          
+  1799  7.05234773E-01  9.96924362E-01  3.18840662E-01                          
+  1800  7.06364688E-01  9.96975826E-01  3.18943025E-01                          
+  1801  7.07495182E-01  9.97026650E-01  3.19045067E-01                          
+  1802  7.08626252E-01  9.97076838E-01  3.19146787E-01                          
+  1803  7.09757895E-01  9.97126396E-01  3.19248186E-01                          
+  1804  7.10890110E-01  9.97175328E-01  3.19349262E-01                          
+  1805  7.12022895E-01  9.97223639E-01  3.19450016E-01                          
+  1806  7.13156247E-01  9.97271335E-01  3.19550447E-01                          
+  1807  7.14290165E-01  9.97318420E-01  3.19650556E-01                          
+  1808  7.15424646E-01  9.97364899E-01  3.19750340E-01                          
+  1809  7.16559688E-01  9.97410776E-01  3.19849802E-01                          
+  1810  7.17695290E-01  9.97456058E-01  3.19948939E-01                          
+  1811  7.18831449E-01  9.97500748E-01  3.20047752E-01                          
+  1812  7.19968163E-01  9.97544851E-01  3.20146241E-01                          
+  1813  7.21105429E-01  9.97588373E-01  3.20244405E-01                          
+  1814  7.22243247E-01  9.97631318E-01  3.20343980E-01                          
+  1815  7.23381613E-01  9.97677362E-01  3.20439757E-01                          
+  1816  7.24520526E-01  9.97719160E-01  3.20536945E-01                          
+  1817  7.25659984E-01  9.97756741E-01  3.20633806E-01                          
+  1818  7.26799984E-01  9.97797427E-01  3.20730342E-01                          
+  1819  7.27940524E-01  9.97837560E-01  3.20826550E-01                          
+  1820  7.29081603E-01  9.97877145E-01  3.20922432E-01                          
+  1821  7.30223217E-01  9.97916187E-01  3.21017987E-01                          
+  1822  7.31365366E-01  9.97954691E-01  3.21113214E-01                          
+  1823  7.32508046E-01  9.97992660E-01  3.21208113E-01                          
+  1824  7.33651256E-01  9.98030100E-01  3.21302684E-01                          
+  1825  7.34794994E-01  9.98067017E-01  3.21396927E-01                          
+  1826  7.35939257E-01  9.98103413E-01  3.21490841E-01                          
+  1827  7.37084043E-01  9.98139294E-01  3.21584425E-01                          
+  1828  7.38229351E-01  9.98174665E-01  3.21677681E-01                          
+  1829  7.39375177E-01  9.98209531E-01  3.21770607E-01                          
+  1830  7.40521521E-01  9.98243895E-01  3.21863203E-01                          
+  1831  7.41668379E-01  9.98277763E-01  3.21955468E-01                          
+  1832  7.42815750E-01  9.98311139E-01  3.22047403E-01                          
+  1833  7.43963631E-01  9.98344028E-01  3.22139007E-01                          
+  1834  7.45112020E-01  9.98376434E-01  3.22230280E-01                          
+  1835  7.46260916E-01  9.98408363E-01  3.22321222E-01                          
+  1836  7.47410315E-01  9.98439817E-01  3.22411831E-01                          
+  1837  7.48560217E-01  9.98470803E-01  3.22502108E-01                          
+  1838  7.49710618E-01  9.98501324E-01  3.22592053E-01                          
+  1839  7.50861516E-01  9.98531386E-01  3.22681666E-01                          
+  1840  7.52012910E-01  9.98560992E-01  3.22770945E-01                          
+  1841  7.53164797E-01  9.98590147E-01  3.22859890E-01                          
+  1842  7.54317175E-01  9.98618856E-01  3.22948502E-01                          
+  1843  7.55470042E-01  9.98647122E-01  3.23036780E-01                          
+  1844  7.56623395E-01  9.98674951E-01  3.23124724E-01                          
+  1845  7.57777233E-01  9.98702347E-01  3.23212333E-01                          
+  1846  7.58931553E-01  9.98729314E-01  3.23299607E-01                          
+  1847  7.60086352E-01  9.98755857E-01  3.23386545E-01                          
+  1848  7.61241630E-01  9.98781980E-01  3.23473148E-01                          
+  1849  7.62397384E-01  9.98807687E-01  3.23559415E-01                          
+  1850  7.63553611E-01  9.98832982E-01  3.23645346E-01                          
+  1851  7.64710309E-01  9.98857871E-01  3.23730940E-01                          
+  1852  7.65867476E-01  9.98882357E-01  3.23816197E-01                          
+  1853  7.67025110E-01  9.98906444E-01  3.23901117E-01                          
+  1854  7.68183209E-01  9.98930137E-01  3.23985699E-01                          
+  1855  7.69341770E-01  9.98953440E-01  3.24069944E-01                          
+  1856  7.70500791E-01  9.98976358E-01  3.24153850E-01                          
+  1857  7.71660271E-01  9.98998894E-01  3.24237417E-01                          
+  1858  7.72820206E-01  9.99021053E-01  3.24320646E-01                          
+  1859  7.73980595E-01  9.99042838E-01  3.24403535E-01                          
+  1860  7.75141435E-01  9.99064255E-01  3.24486085E-01                          
+  1861  7.76302724E-01  9.99085307E-01  3.24568295E-01                          
+  1862  7.77464461E-01  9.99105997E-01  3.24650165E-01                          
+  1863  7.78626641E-01  9.99126332E-01  3.24731694E-01                          
+  1864  7.79789265E-01  9.99146313E-01  3.24812882E-01                          
+  1865  7.80952329E-01  9.99165947E-01  3.24893728E-01                          
+  1866  7.82115830E-01  9.99185235E-01  3.24974234E-01                          
+  1867  7.83279768E-01  9.99204184E-01  3.25054397E-01                          
+  1868  7.84444138E-01  9.99222795E-01  3.25134218E-01                          
+  1869  7.85608941E-01  9.99241075E-01  3.25213696E-01                          
+  1870  7.86774172E-01  9.99259026E-01  3.25292831E-01                          
+  1871  7.87939830E-01  9.99276652E-01  3.25371623E-01                          
+  1872  7.89105912E-01  9.99293957E-01  3.25450071E-01                          
+  1873  7.90272417E-01  9.99310946E-01  3.25528175E-01                          
+  1874  7.91439342E-01  9.99327622E-01  3.25605934E-01                          
+  1875  7.92606685E-01  9.99343989E-01  3.25683349E-01                          
+  1876  7.93774443E-01  9.99360051E-01  3.25760419E-01                          
+  1877  7.94942614E-01  9.99375811E-01  3.25837143E-01                          
+  1878  7.96111197E-01  9.99391274E-01  3.25913521E-01                          
+  1879  7.97280188E-01  9.99406443E-01  3.25989553E-01                          
+  1880  7.98449586E-01  9.99421322E-01  3.26065238E-01                          
+  1881  7.99619388E-01  9.99435914E-01  3.26140576E-01                          
+  1882  8.00789591E-01  9.99450224E-01  3.26215567E-01                          
+  1883  8.01960195E-01  9.99464255E-01  3.26290210E-01                          
+  1884  8.03131196E-01  9.99478011E-01  3.26364505E-01                          
+  1885  8.04302592E-01  9.99491495E-01  3.26438452E-01                          
+  1886  8.05474381E-01  9.99504711E-01  3.26512049E-01                          
+  1887  8.06646560E-01  9.99517663E-01  3.26585298E-01                          
+  1888  8.07819128E-01  9.99530354E-01  3.26658196E-01                          
+  1889  8.08992081E-01  9.99542787E-01  3.26730745E-01                          
+  1890  8.10165419E-01  9.99554967E-01  3.26802943E-01                          
+  1891  8.11339137E-01  9.99566897E-01  3.26874790E-01                          
+  1892  8.12513235E-01  9.99578580E-01  3.26946286E-01                          
+  1893  8.13687710E-01  9.99590019E-01  3.27017431E-01                          
+  1894  8.14862559E-01  9.99601219E-01  3.27088223E-01                          
+  1895  8.16037781E-01  9.99612182E-01  3.27155088E-01                          
+  1896  8.17213372E-01  9.99622913E-01  3.27225179E-01                          
+  1897  8.18389331E-01  9.99633413E-01  3.27294918E-01                          
+  1898  8.19565656E-01  9.99643687E-01  3.27364303E-01                          
+  1899  8.20742343E-01  9.99653739E-01  3.27433334E-01                          
+  1900  8.21919391E-01  9.99663570E-01  3.27502010E-01                          
+  1901  8.23096798E-01  9.99665701E-01  3.27570331E-01                          
+  1902  8.24274561E-01  9.99675113E-01  3.27638297E-01                          
+  1903  8.25452677E-01  9.99684315E-01  3.27705907E-01                          
+  1904  8.26631145E-01  9.99693310E-01  3.27773161E-01                          
+  1905  8.27809962E-01  9.99702102E-01  3.27840058E-01                          
+  1906  8.28989126E-01  9.99710693E-01  3.27906598E-01                          
+  1907  8.30168635E-01  9.99719087E-01  3.27972780E-01                          
+  1908  8.31348485E-01  9.99727287E-01  3.28038605E-01                          
+  1909  8.32528676E-01  9.99735296E-01  3.28104071E-01                          
+  1910  8.33709204E-01  9.99743117E-01  3.28169178E-01                          
+  1911  8.34890067E-01  9.99750752E-01  3.28233925E-01                          
+  1912  8.36071264E-01  9.99758206E-01  3.28298313E-01                          
+  1913  8.37252791E-01  9.99765481E-01  3.28362340E-01                          
+  1914  8.38434646E-01  9.99772580E-01  3.28426007E-01                          
+  1915  8.39616827E-01  9.99779506E-01  3.28489312E-01                          
+  1916  8.40799331E-01  9.99786261E-01  3.28552256E-01                          
+  1917  8.41982157E-01  9.99792850E-01  3.28614837E-01                          
+  1918  8.43165301E-01  9.99799273E-01  3.28677056E-01                          
+  1919  8.44348763E-01  9.99805536E-01  3.28738911E-01                          
+  1920  8.45532538E-01  9.99811639E-01  3.28800402E-01                          
+  1921  8.46716625E-01  9.99817587E-01  3.28861529E-01                          
+  1922  8.47901022E-01  9.99823381E-01  3.28922292E-01                          
+  1923  8.49085726E-01  9.99829025E-01  3.28982689E-01                          
+  1924  8.50270735E-01  9.99834521E-01  3.29042720E-01                          
+  1925  8.51456046E-01  9.99839872E-01  3.29102385E-01                          
+  1926  8.52641657E-01  9.99845080E-01  3.29161684E-01                          
+  1927  8.53827566E-01  9.99850149E-01  3.29220614E-01                          
+  1928  8.55013771E-01  9.99855081E-01  3.29279177E-01                          
+  1929  8.56200268E-01  9.99859877E-01  3.29337371E-01                          
+  1930  8.57387057E-01  9.99864542E-01  3.29395196E-01                          
+  1931  8.58574133E-01  9.99869078E-01  3.29452652E-01                          
+  1932  8.59761496E-01  9.99873486E-01  3.29509737E-01                          
+  1933  8.60949142E-01  9.99877770E-01  3.29566452E-01                          
+  1934  8.62137069E-01  9.99881932E-01  3.29622795E-01                          
+  1935  8.63325275E-01  9.99885974E-01  3.29678766E-01                          
+  1936  8.64513758E-01  9.99889899E-01  3.29734364E-01                          
+  1937  8.65702515E-01  9.99893709E-01  3.29789590E-01                          
+  1938  8.66891544E-01  9.99897406E-01  3.29844441E-01                          
+  1939  8.68080842E-01  9.99900994E-01  3.29898918E-01                          
+  1940  8.69270407E-01  9.99904473E-01  3.29953020E-01                          
+  1941  8.70460236E-01  9.99907847E-01  3.30006747E-01                          
+  1942  8.71650328E-01  9.99911118E-01  3.30060097E-01                          
+  1943  8.72840680E-01  9.99914287E-01  3.30113070E-01                          
+  1944  8.74031289E-01  9.99917358E-01  3.30165665E-01                          
+  1945  8.75222154E-01  9.99920332E-01  3.30217882E-01                          
+  1946  8.76413271E-01  9.99923211E-01  3.30269720E-01                          
+  1947  8.77604638E-01  9.99925997E-01  3.30321178E-01                          
+  1948  8.78796254E-01  9.99928694E-01  3.30372256E-01                          
+  1949  8.79988115E-01  9.99931302E-01  3.30422953E-01                          
+  1950  8.81180219E-01  9.99933823E-01  3.30473267E-01                          
+  1951  8.82372564E-01  9.99936261E-01  3.30523200E-01                          
+  1952  8.83565148E-01  9.99938616E-01  3.30572749E-01                          
+  1953  8.84757967E-01  9.99940891E-01  3.30621914E-01                          
+  1954  8.85951020E-01  9.99943087E-01  3.30670696E-01                          
+  1955  8.87144305E-01  9.99945207E-01  3.30719090E-01                          
+  1956  8.88337818E-01  9.99947252E-01  3.30767098E-01                          
+  1957  8.89531558E-01  9.99949225E-01  3.30814719E-01                          
+  1958  8.90725521E-01  9.99951127E-01  3.30861952E-01                          
+  1959  8.91919707E-01  9.99952959E-01  3.30908796E-01                          
+  1960  8.93114112E-01  9.99954725E-01  3.30955251E-01                          
+  1961  8.94308733E-01  9.99956425E-01  3.31001315E-01                          
+  1962  8.95503569E-01  9.99958061E-01  3.31046987E-01                          
+  1963  8.96698617E-01  9.99959635E-01  3.31092267E-01                          
+  1964  8.97893875E-01  9.99961148E-01  3.31137154E-01                          
+  1965  8.99089339E-01  9.99962603E-01  3.31181646E-01                          
+  1966  9.00285009E-01  9.99964001E-01  3.31225744E-01                          
+  1967  9.01480881E-01  9.99965343E-01  3.31269442E-01                          
+  1968  9.02676953E-01  9.99966631E-01  3.31312746E-01                          
+  1969  9.03873223E-01  9.99967867E-01  3.31355651E-01                          
+  1970  9.05069688E-01  9.99969052E-01  3.31398158E-01                          
+  1971  9.06266346E-01  9.99970188E-01  3.31440265E-01                          
+  1972  9.07463194E-01  9.99971276E-01  3.31481971E-01                          
+  1973  9.08660230E-01  9.99972317E-01  3.31523274E-01                          
+  1974  9.09857451E-01  9.99973313E-01  3.31564174E-01                          
+  1975  9.11054856E-01  9.99974266E-01  3.31604670E-01                          
+  1976  9.12252441E-01  9.99975177E-01  3.31644761E-01                          
+  1977  9.13450205E-01  9.99976046E-01  3.31684445E-01                          
+  1978  9.14648144E-01  9.99976876E-01  3.31723721E-01                          
+  1979  9.15846257E-01  9.99977668E-01  3.31762588E-01                          
+  1980  9.17044541E-01  9.99978423E-01  3.31801045E-01                          
+  1981  9.18242994E-01  9.99979142E-01  3.31839091E-01                          
+  1982  9.19441612E-01  9.99979827E-01  3.31876724E-01                          
+  1983  9.20640395E-01  9.99980479E-01  3.31913943E-01                          
+  1984  9.21839339E-01  9.99981098E-01  3.31950746E-01                          
+  1985  9.23038441E-01  9.99981686E-01  3.31987163E-01                          
+  1986  9.24237701E-01  9.99982245E-01  3.32023134E-01                          
+  1987  9.25437114E-01  9.99982775E-01  3.32058685E-01                          
+  1988  9.26636679E-01  9.99983277E-01  3.32093816E-01                          
+  1989  9.27836393E-01  9.99983753E-01  3.32128524E-01                          
+  1990  9.29036253E-01  9.99984203E-01  3.32162808E-01                          
+  1991  9.30236259E-01  9.99984629E-01  3.32196666E-01                          
+  1992  9.31436406E-01  9.99985031E-01  3.32230098E-01                          
+  1993  9.32636692E-01  9.99985411E-01  3.32263100E-01                          
+  1994  9.33837116E-01  9.99985769E-01  3.32295673E-01                          
+  1995  9.35037674E-01  9.99986107E-01  3.32327813E-01                          
+  1996  9.36238364E-01  9.99986424E-01  3.32359519E-01                          
+  1997  9.37439184E-01  9.99986723E-01  3.32390789E-01                          
+  1998  9.38640131E-01  9.99987003E-01  3.32421621E-01                          
+  1999  9.39841203E-01  9.99987267E-01  3.32452014E-01                          
+  2000  9.41042398E-01  9.99987514E-01  3.32481965E-01                          
+  2001  9.42243712E-01  9.99987745E-01  3.32511473E-01                          
+  2002  9.43445145E-01  9.99987962E-01  3.32540534E-01                          
+  2003  9.44646692E-01  9.99988164E-01  3.32569148E-01                          
+  2004  9.45848352E-01  9.99988353E-01  3.32636974E-01                          
+  2005  9.47050122E-01  9.99988529E-01  3.32664153E-01                          
+  2006  9.48252000E-01  9.99988693E-01  3.32690861E-01                          
+  2007  9.49453983E-01  9.99988846E-01  3.32717092E-01                          
+  2008  9.50656069E-01  9.99988987E-01  3.32742845E-01                          
+  2009  9.51858255E-01  9.99989119E-01  3.32768114E-01                          
+  2010  9.53060540E-01  9.99989241E-01  3.32792897E-01                          
+  2011  9.54262920E-01  9.99989354E-01  3.32817189E-01                          
+  2012  9.55465394E-01  9.99989459E-01  3.32840986E-01                          
+  2013  9.56667957E-01  9.99989556E-01  3.32864284E-01                          
+  2014  9.57870610E-01  9.99989645E-01  3.32887078E-01                          
+  2015  9.59073348E-01  9.99989728E-01  3.32909363E-01                          
+  2016  9.60276169E-01  9.99989804E-01  3.32931134E-01                          
+  2017  9.61479071E-01  9.99989874E-01  3.32952386E-01                          
+  2018  9.62682052E-01  9.99989938E-01  3.32973111E-01                          
+  2019  9.63885109E-01  9.99989998E-01  3.32993306E-01                          
+  2020  9.65088239E-01  9.99990052E-01  3.33012962E-01                          
+  2021  9.66291440E-01  9.99990102E-01  3.33032073E-01                          
+  2022  9.67494710E-01  9.99990148E-01  3.33050631E-01                          
+  2023  9.68698047E-01  9.99990191E-01  3.33068628E-01                          
+  2024  9.69901447E-01  9.99990230E-01  3.33086056E-01                          
+  2025  9.71104908E-01  9.99990266E-01  3.33102905E-01                          
+  2026  9.72308428E-01  9.99990299E-01  3.33119165E-01                          
+  2027  9.73512005E-01  9.99990330E-01  3.33134824E-01                          
+  2028  9.74715635E-01  9.99990358E-01  3.33149871E-01                          
+  2029  9.75919317E-01  9.99990385E-01  3.33164292E-01                          
+  2030  9.77123049E-01  9.99990409E-01  3.33178072E-01                          
+  2031  9.78326826E-01  9.99990432E-01  3.33191196E-01                          
+  2032  9.79530648E-01  9.99990454E-01  3.33203644E-01                          
+  2033  9.80734512E-01  9.99990475E-01  3.33215396E-01                          
+  2034  9.81938415E-01  9.99990494E-01  3.33226429E-01                          
+  2035  9.83142354E-01  9.99990513E-01  3.33236717E-01                          
+  2036  9.84346328E-01  9.99990530E-01  3.33246227E-01                          
+  2037  9.85550334E-01  9.99990548E-01  3.33254924E-01                          
+  2038  9.86754370E-01  9.99990564E-01  3.33262765E-01                          
+  2039  9.87958432E-01  9.99990580E-01  3.33269700E-01                          
+  2040  9.89162519E-01  9.99990596E-01  3.33275664E-01                          
+  2041  9.90366628E-01  9.99990612E-01  3.33280578E-01                          
+  2042  9.91570756E-01  9.99990627E-01  3.33284342E-01                          
+  2043  9.92774902E-01  9.99990642E-01  3.33286820E-01                          
+  2044  9.93979063E-01  9.99990657E-01  3.33287825E-01                          
+  2045  9.95183235E-01  9.99990672E-01  3.33287078E-01                          
+  2046  9.96387418E-01  9.99990687E-01  3.33284136E-01                          
+  2047  9.97591608E-01  9.99990702E-01  3.33278180E-01                          
+  2048  9.98795803E-01  9.99990716E-01  3.33267271E-01                          
+  2049  1.00000000E+00  9.99990731E-01  3.33237496E-01                          
+ENDE                                                                            
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/addang.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/addang.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/addang.f	(revision 286)
@@ -0,0 +1,83 @@
+      SUBROUTINE ADDANG( COST0,PHI0, COST,PHI, COST1,PHI1 )
+ 
+C-----------------------------------------------------------------------
+C  ADD(ITION OF) ANG(LES)
+C
+C  ADDITION OF ANGLES IS DONE BY SEQUENTIAL ROTATIONS :
+C    1. ROTATE VECTOR AROUND Z AXIS BY -PHI0
+C    2. ROTATE VECTOR AROUND Y AXIS BY -THETA0  NOW VECTOR IS (0,0,1)
+C
+C    3. ROTATE VECTOR AROUND Y AXIS BY  THETA ANGLES TO BE ADDED
+C    4. ROTATE VECTOR AROUND Z AXIS BY  PHI
+C
+C    5. ROTATE VECTOR AROUND Y AXIS BY  THETA0
+C    6. ROTATE VECTOR AROUND Z AXIS BY -PHI0
+C              NOW VECTOR IS (X,Y,Z) WITH COST1     = Z
+C                                     AND TAN(PHI1) = Y/X
+C  THIS SUBROUTINE IS CALLED FROM MANY ROUTINES
+C  ARGUMENTS:
+C   COST0  = COSINE THETA OF PARTICLE BEFORE
+C   PHI0   = PHI          OF PARTICLE BEFORE
+C   COST   = COSINE THETA OF ANGLE TO ADD
+C   PHI    = PHI          OF ANGLE TO ADD
+C   COST1  = COSINE THETA OF PARTICLE AFTER ADDITION OF ANGLES
+C   PHI1   = PHI    THETA OF PARTICLE AFTER ADDITION OF ANGLES
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION A,COST,COST0,COST1,CPHI,CPHI0,PHI,PHI0,PHI1,
+     *                 SINT,SINT0,SPHI,SPHI0,XXX,YYY,ZZZ
+C-----------------------------------------------------------------------
+ 
+CC    IF ( DEBUG ) WRITE(MDEBUG,*) 'ADDANG:'
+ 
+      SINT0 = SQRT(1.D0-COST0**2)
+      SINT  = SQRT(1.D0-COST **2)
+      SPHI0 = SIN(PHI0)
+      CPHI0 = COS(PHI0)
+      SPHI  = SIN(PHI)
+      CPHI  = COS(PHI)
+ 
+      A   = COST0 * CPHI * SINT + COST * SINT0
+      XXX = A    * CPHI0 - SPHI0 * SINT * SPHI
+      YYY = A    * SPHI0 + CPHI0 * SINT * SPHI
+      ZZZ = COST * COST0 - SINT0 * SINT * CPHI
+ 
+C  GET NEW COSINE(THETA) AND PHI
+      COST1  = ZZZ
+      IF ( YYY .EQ. 0.D0  .AND.  XXX .EQ. 0.D0 ) THEN
+        PHI1 = 0.D0
+      ELSE
+        PHI1 = ATAN2( YYY, XXX )
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/addani.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/addani.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/addani.f	(revision 286)
@@ -0,0 +1,85 @@
+      SUBROUTINE ADDANI( COST0,PHI0, COST1,PHI1, DCTH,DPHI )
+ 
+C-----------------------------------------------------------------------
+C  ADD(ITION OF) AN(GLES) I(NVERTED)
+C
+C  GIVEN TWO DIRECTIONS (0 AND 1) IN A COMMON SYSTEM OF REFERENCE.
+C  FIND DCTH AND DPHI SUCH, THAT THE ROUTINE ADDANG TRANSFORMS
+C  (COST0,PHI0) BY ADDING (DCTH,DPHI) INTO (COST1,PHI1).
+C  CALCULATION IS DONE BY SEQUENTIAL ROTATIONS :
+C    1. ROTATE VECTOR AROUND Z AXIS BY -PHI1
+C    2. ROTATE VECTOR AROUND Y AXIS BY -THETA1
+C  NOW VECTOR IS (X,Y,Z) WITH DCTH      = Z
+C                         AND TAN(DPHI) = Y/X
+C  THIS SUBROUTINE IS CALLED FROM MUDECY
+C  ARGUMENTS:
+C   COST0  = COSINE THETA OF PARTICLE BEFORE
+C   PHI0   = PHI          OF PARTICLE BEFORE
+C   COST1  = COSINE THETA OF PARTICLE
+C   PHI1   = PHI          OF PARTICLE
+C   DCTH   = COSINE THETA OF ANGLE
+C   DPHI   = PHI          OF ANGLE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION COST0,COST1,CP,CP1,CT,CT1,DCTH,DPHI,PHI0,PHI1,
+     *                 SP,SP1,ST,ST1,X,XX,Y,YY,Z,ZZ
+C-----------------------------------------------------------------------
+ 
+CC    IF ( DEBUG ) WRITE(MDEBUG,*) 'ADDANI:'
+ 
+      CT  = COST0
+      ST  = SQRT(1.D0-CT**2)
+      CP  = COS(PHI0)
+      SP  = SIN(PHI0)
+      CT1 = COST1
+      ST1 = SQRT(1.D0-CT1**2)
+      CP1 = COS(PHI1)
+      SP1 = SIN(PHI1)
+ 
+      X = ST1 * CP1
+      Y = ST1 * SP1
+      Z = CT1
+ 
+      XX =  CT*CP*X + CT*SP*Y - ST*Z
+      YY = -SP   *X + CP   *Y
+      ZZ =  ST*CP*X + ST*SP*Y + CT*Z
+ 
+C  GET NEW COSINE(THETA) AND PHI
+      DCTH   = ZZ
+      IF ( YY .NE. 0.D0  .OR.  XX .NE. 0.D0 ) THEN
+        DPHI = ATAN2( YY, XX )
+      ELSE
+        DPHI = 0.D0
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/age.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/age.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/age.f	(revision 286)
@@ -0,0 +1,73 @@
+      SUBROUTINE AGE( R,S )
+ 
+C-----------------------------------------------------------------------
+C  AGE
+C
+C  CALCULATES LONGITUDINAL AGE PARAMETER
+C  ORIGINALLY DEVELOPED BY: J. KEMPA, UNIVERSITY OF LODZ, POLAND
+C  THIS SUBROUTINE IS CALLED FROM AVAGE
+C  ARGUMENTS:
+C   R      = AVERAGED AGE PARAMETER
+C   S      = LONGITUDINAL AGE PARAMETER OF TOTAL SHOWER
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION A,B,C,R,R1,R2,R3,R4,R5,S
+      DATA R1 / 1.9096D-02 /, R2 / 1.7964D-01 /, R3 / 5.3644D-01 /,
+     *     R4 / 1.0332D0   /, R5 / 1.4856D0   /
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'AGE   : R=',SNGL(R)
+ 
+      R = MAX( R, R1 )
+      R = MIN( R, R5 )
+ 
+      IF     ( R .LT. R2 ) THEN
+        A =  3.109121D-1
+        B =  2.146465D-1
+        C = -5.451040D-3
+      ELSEIF ( R .LT. R3 ) THEN
+        A =  3.666449D-1
+        B =  1.639189D-1
+        C =  5.970362D-3
+      ELSEIF ( R .LT. R4 ) THEN
+        A =  1.459842D-1
+        B =  6.317027D-1
+        C = -2.420241D-1
+      ELSEIF ( R .LE. R5 ) THEN
+        A = -3.375703D-1
+        B =  2.090333D0
+        C = -1.343802D0
+      ENDIF
+ 
+      S = ( SQRT(B**2 - 4.D0 * A * (C-R)) - B ) / ( 2.D0 * A )
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'AGE   : S=',SNGL(S)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/amoeba.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/amoeba.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/amoeba.f	(revision 286)
@@ -0,0 +1,121 @@
+      SUBROUTINE AMOEBA(P,Y,MP,NP,NDIM,FTOL,FUNK,ITER,IFLAG)
+ 
+C-----------------------------------------------------------------------
+C
+C  FITTING ROUTINE
+C  REFERENCE : NUMERICAL RECIPES, W.H. PRESS ET AL.,
+C              CAMBRIDGE UNIVERSITY PRESS, 1992  ISBN 0 521 43064 X
+C  ADAPTED FOR DOUBLE PRECISION
+C  THIS SUBROUTINE IS CALLED FROM LONGFT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      INTEGER          ITMAX,MP,NMAX,NP
+C  MAXIMUM NUMBER OF TRIAL PER CALL
+      PARAMETER        (ITMAX=5000)
+      PARAMETER        (NMAX=20)
+      DOUBLE PRECISION AMOTRY,FTOL,FUNK,P(MP,NP),PSUM(NMAX),
+     *                 RTOL,SUM,SWAP,Y(MP),YSAVE,YTRY
+      INTEGER          I,IFLAG,IHI,ILO,INHI,ITER,J,M,N,NDIM
+      EXTERNAL         FUNK
+ 
+CU  USES AMOTRY,FUNK
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'AMOEBA:'
+ 
+      IFLAG = 0
+      ITER  = 0
+ 1    DO 12 N=1,NDIM
+        SUM = 0.D0
+        DO 11 M=1,NDIM+1
+          SUM = SUM + P(M,N)
+ 11     CONTINUE
+        PSUM(N) = SUM
+ 12   CONTINUE
+ 2    ILO=1
+      IF ( Y(1) .GT. Y(2) ) THEN
+        IHI  = 1
+        INHI = 2
+      ELSE
+        IHI  = 2
+        INHI = 1
+      ENDIF
+      DO 13 I=1,NDIM+1
+        IF ( Y(I) .LE. Y(ILO) ) ILO = I
+        IF     ( Y(I) .GT. Y(IHI)  ) THEN
+          INHI = IHI
+          IHI  = I
+        ELSEIF ( Y(I) .GT. Y(INHI) ) THEN
+          IF ( I .NE. IHI ) INHI = I
+        ENDIF
+ 13   CONTINUE
+      RTOL = 2.D0*ABS(Y(IHI)-Y(ILO))/(ABS(Y(IHI))+ABS(Y(ILO)))
+      IF ( RTOL .LT. FTOL ) THEN
+        SWAP   = Y(1)
+        Y(1)   = Y(ILO)
+        Y(ILO) = SWAP
+        DO 14 N=1,NDIM
+          SWAP     = P(1,N)
+          P(1,N)   = P(ILO,N)
+          P(ILO,N) = SWAP
+ 14     CONTINUE
+        RETURN
+      ENDIF
+      IF ( ITER .GE.ITMAX ) THEN
+        IF(DEBUG) WRITE(MDEBUG,*) 'AMOEBA: ITMAX EXCEEDED IN AMOEBA'
+        IFLAG = 1
+        RETURN
+      ENDIF
+      ITER = ITER + 2
+      YTRY = AMOTRY(P,Y,PSUM,MP,NP,NDIM,FUNK,IHI,-1.0D0)
+      IF     ( YTRY .LE. Y(ILO)  ) THEN
+        YTRY = AMOTRY(P,Y,PSUM,MP,NP,NDIM,FUNK,IHI,2.0D0)
+      ELSEIF ( YTRY .GE. Y(INHI) ) THEN
+        YSAVE = Y(IHI)
+        YTRY = AMOTRY(P,Y,PSUM,MP,NP,NDIM,FUNK,IHI,0.5D0)
+        IF ( YTRY .GE. YSAVE ) THEN
+          DO 16 I=1,NDIM+1
+            IF ( I .NE. ILO ) THEN
+              DO 15 J=1,NDIM
+                PSUM(J) = 0.5D0 * (P(I,J) + P(ILO,J))
+                P(I,J)  = PSUM(J)
+ 15           CONTINUE
+              Y(I) = FUNK(PSUM)
+            ENDIF
+ 16       CONTINUE
+          ITER = ITER + NDIM
+          GOTO 1
+        ENDIF
+      ELSE
+        ITER = ITER - 1
+      ENDIF
+      GOTO 2
+      END
+C=======================================================================
+ 
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/amotry.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/amotry.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/amotry.f	(revision 286)
@@ -0,0 +1,63 @@
+      DOUBLE PRECISION FUNCTION AMOTRY(P,Y,PSUM,MP,NP,NDIM,FUNK,IHI,FAC)
+ 
+C-----------------------------------------------------------------------
+C
+C  REFERENCE : NUMERICAL RECIPES, W.H. PRESS ET AL.,
+C              CAMBRIDGE UNIVERSITY PRESS, 1992  ISBN 0 521 43064 X
+C  ADAPTED FOR DOUBLE PRECISION
+C  THIS SUBROUTINE IS CALLED FROM AMOEBA
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      INTEGER          MP,NP,NMAX
+      PARAMETER        (NMAX=20)
+      DOUBLE PRECISION FAC,P(MP,NP),PSUM(NP),Y(MP),FUNK
+      DOUBLE PRECISION FAC1,FAC2,YTRY,PTRY(NMAX)
+      INTEGER          IHI,NDIM,J
+      EXTERNAL         FUNK
+CU  USES FUNK
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'AMOTRY:'
+ 
+      FAC1 = (1.D0-FAC)/NDIM
+      FAC2 = FAC1-FAC
+      DO 11 J=1,NDIM
+        PTRY(J) = PSUM(J) * FAC1 - P(IHI,J) * FAC2
+ 11   CONTINUE
+      YTRY = FUNK(PTRY)
+      IF ( YTRY .LT. Y(IHI) ) THEN
+        Y(IHI) = YTRY
+        DO 12 J=1,NDIM
+          PSUM(J)  = PSUM(J) - P(IHI,J) + PTRY(J)
+          P(IHI,J) = PTRY(J)
+ 12     CONTINUE
+      ENDIF
+      AMOTRY = YTRY
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/annih.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/annih.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/annih.f	(revision 286)
@@ -0,0 +1,87 @@
+      SUBROUTINE ANNIH
+C                                VERSION 4.00  --  26 JAN 1986/1900
+C******************************************************************
+C   GAMMA SPECTRUM FOR TWO GAMMA IN-FLIGHT POSITRON ANNIHILATION.
+C   USING SCHEME BASED ON HEITLER'S P269-270 FORMULAE
+C   THIS ROUTINE SHOULD GIVE THE CORRECT DISTRIBUTION, BUT MORE
+C   THOUGHT COULD BE PUT INTO DEVISING A FASTER SCHEME.  HOWEVER,
+C   SINCE POSITRON ANNIHILATION IN FLIGHT IS RELATIVELY INFREQUENT
+C   THIS MAY NOT BE WORTHWHILE.
+C******************************************************************
+      DOUBLE PRECISION PAVIP
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' ANNIH: NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      PAVIP=E(NP)+PRM
+      AVIP=PAVIP
+      A=AVIP*RMI
+      AI=1.0/A
+      G=A-1.0
+      T=G-1.0
+      P=SQRT(A*T)
+      POT=P/T
+      EP0I=(A+P)
+331   CONTINUE
+       CALL RMMAR(RD,2,2)
+       RNNO01=RD(1)
+       RNNO02=RD(2)
+       EP=EXP(RNNO01*LOG(EP0I-1.0))/EP0I
+       REJF=1.0-EP+AI*AI*(2.0*G-1.0/EP)
+       IF((RNNO02.LE.REJF))GO TO332
+      GO TO 331
+332   CONTINUE
+      ESG1=AVIP*MAX(EP,1.-EP)
+      E(NP)=ESG1
+      E(NP+1)=PAVIP-E(NP)
+      ESG2=E(NP+1)
+      IQ(NP)=1
+      COSTHE=(ESG1-RM)*POT/ESG1
+      SINTHE=SQRT(MAX(1.0-COSTHE*COSTHE,0.))
+      CALL UPHI(2,1)
+      NP=NP+1
+      IQ(NP)=1
+      COSTHE=(ESG2-RM)*POT/ESG2
+      SINTHE=SQRT(MAX(1.0-COSTHE*COSTHE,0.))
+      CALL UPHI(3,2)
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ausgab.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ausgab.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ausgab.f	(revision 286)
@@ -0,0 +1,87 @@
+      SUBROUTINE AUSGAB
+C
+C*********************************************************************
+C  DESIGN  : D. HECK   IK3  FZK KARLSRUHE
+C*********************************************************************
+C  WE USE AUSGAB TO FILL OUTPAR WITH PARTICLE COORDINATES.
+C*********************************************************************
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEND.
+      COMMON/MISC/KMPI,KMPO,DUNIT,NOSCAT,MED(6),RHOR(6),IRAYLR(6)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+      NOBS=IOBS(NP)
+C*** ANGLE WITH RESPECT TO X AXIS
+      IF (U(NP)**2+V(NP)**2.GT.3.E-38) THEN
+       ANGLEX = -ATAN2(V(NP),U(NP))
+      ELSE
+       ANGLEX = 0.
+      END IF
+C***  PARTICLE IS WRITTEN IN OUTPUT BUFFER ARRAY
+      OUTPAR(1)=IQ(NP)
+      OUTPAR(2)=E(NP)*0.001D0
+      OUTPAR(3)=W(NP)
+      OUTPAR(4)=ANGLEX
+      OUTPAR(5)=-Z(NP)
+      OUTPAR(6)=TIME(NP)
+      OUTPAR(7)=X(NP)
+      OUTPAR(8)=-Y(NP)
+      OUTPAR(9)=IGEN(NP)
+      OUTPAR(10)=ALEVEL
+      LEVL=NOBS
+      CALL OUTPUT
+      IF (DEBUG.OR.(JCLOCK.GT.1 .AND. NCLOCK.GT.JCLOCK)) THEN
+       WRITE(MDEBUG,* )'AUSGAB: NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+       XX=X(NP)
+       YY=-Y(NP)
+       ZZ=-Z(NP)
+       ANGLEZ=W(NP)
+       ANGLX=ANGLEX
+       ETOT=E(NP)*.001
+       WRITE(KMPO,170) IQ(NP),ETOT,ANGLEZ,ANGLX,ZZ,TIME(NP)*1.0D3,XX,YY,
+     *  IGEN(NP)
+170    FORMAT(' AUSGAB:',10X,I4,1X,F10.4,1X,F7.4,1X,F7.4,1X,F9.0, F9.6,
+     *   1X,F10.1,1X,F10.1,1X,I3
+     * )
+      END IF
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ausgb2.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ausgb2.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ausgb2.f	(revision 286)
@@ -0,0 +1,66 @@
+      SUBROUTINE AUSGB2
+C
+C*********************************************************************
+C  DESIGN  : D. HECK   IK3  FZK KARLSRUHE
+C*********************************************************************
+C  IN CASE OF DEBUGGING WE PRINT THE PARTICLE COORDINATES.
+C*********************************************************************
+      COMMON/MISC/KMPI,KMPO,DUNIT,NOSCAT,MED(6),RHOR(6),IRAYLR(6)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+C*** ANGLE WITH RESPECT TO X AXIS
+      IF (U(NP)**2+V(NP)**2.GT.3.E-38) THEN
+       ANGLEX = -ATAN2(V(NP),U(NP))
+      ELSE
+       ANGLEX = 0.
+      END IF
+      XX=X(NP)
+      YY=-Y(NP)
+      ZZ=-Z(NP)
+      ANGLEZ=W(NP)
+      ANGLX=ANGLEX
+      ETOT=E(NP)*.001
+      WRITE(KMPO,170) IQ(NP),ETOT,ANGLEZ,ANGLX,ZZ,TIME(NP)*1.0D3,XX,YY,
+     *IGEN(NP)
+170   FORMAT(' AUSGB2:',10X,I4,1X,F10.3,1X,F7.4,1X,F7.4,1X,F9.0, F9.6,
+     *  1X,F10.1,1X,F10.1,1X,I3
+     * )
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/avage.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/avage.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/avage.f	(revision 286)
@@ -0,0 +1,191 @@
+      SUBROUTINE AVAGE
+ 
+C-----------------------------------------------------------------------
+C  AVE(ERAGE) AGE
+C
+C  CALCULATES AVERAGE AGE AS A FUNCTION OF RADIUS
+C  THIS SUBROUTINE IS CALLED FROM MAIN
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEEP,NKGI.
+      COMMON /NKGI/    SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
+     *                 DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
+     *                 OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
+      DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
+     *                 ZSL(10),DIST(10),
+     *                 DISX(-10:10),DISY(-10:10),
+     *                 DISXY(-10:10,2),DISYX(-10:10,2),
+     *                 DLAX (-10:10,2),DLAY (-10:10,2),
+     *                 DLAXY(-10:10,2),DLAYX(-10:10,2),
+     *                 OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
+      INTEGER          IALT(2)
+*KEEP,NKGS.
+      COMMON /NKGS/    CZX,CZY,CZXY,CZYX,SAH,SL,ZNE
+      DOUBLE PRECISION CZX(-10:10,2),CZY(-10:10,2),CZXY(-10:10,2),
+     *                 CZYX(-10:10,2),SAH(10),SL(10),ZNE(10)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION AJ,BJ,CJ,DF(10),SJ(10),SLLG,TH,ZF
+      INTEGER          I,ID,IL,IOL,J,K,L
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'AVAGE :'
+ 
+      IF ( FPRINT ) WRITE(MONIOU,1110) SHOWNO,ELCUT(3),ELCUT(4)
+ 1110 FORMAT (/' ---------- NKG - OUTPUT OF SHOWER NO ',I10,
+     *         ' --------------------------------'/
+     *       ' ELECTRON/PHOTON THRESHOLD AT ',F10.5,' /',F10.5,' GEV')
+ 
+C  LOOP OVER ALL DISTANCES WHERE ELECTRON NUMBER IS CALCULATED
+      DO 302  K = 1,2
+        IF ( OBSATI(K) .GE. 0.D0 ) THEN
+          DO 301  ID = -10,10
+            DLAX (ID,K) = DLAX (ID,K) + CZX (ID,K)
+            DLAY (ID,K) = DLAY (ID,K) + CZY (ID,K)
+            DLAXY(ID,K) = DLAXY(ID,K) + CZXY(ID,K)
+            DLAYX(ID,K) = DLAYX(ID,K) + CZYX(ID,K)
+ 301      CONTINUE
+        ENDIF
+ 302  CONTINUE
+ 
+C  CALCULATE LONGITUDINAL SHOWER DEVELOPMENT
+      DO 311  IL = 1,IALT(1)
+        IF ( SL(IL) .GT. 0.D0 ) THEN
+          SEL(IL)   = SEL(IL) + SL(IL)
+          SLLG      = LOG10(SL(IL))
+          SELLG(IL) = SELLG(IL) + SLLG
+          ZEL(IL)   = ZEL(IL) + SL(IL)**2
+          ZELLG(IL) = ZELLG(IL) + SLLG**2
+          ZF        = ZNE(IL) / SL(IL)
+          CALL AGE( ZF,TH )
+C  AGE PARAMETERS AVERAGED ON ALL SUBCASCADES AT THIS LEVEL
+          SAH(IL) = TH
+          STH(IL) = STH(IL) + TH
+          ZSL(IL) = ZSL(IL) + TH**2
+        ELSE
+          SAH(IL) = 0.D0
+        ENDIF
+        EVTE(175+IL) = SL (IL)
+        EVTE(185+IL) = SAH(IL)
+        EVTE(215+IL) = TLEV(IL)
+        EVTE(225+IL) = TLEVCM(IL)
+ 311  CONTINUE
+ 
+C  PRINT LONGITUDINAL SHOWER DEVELOPMENT
+      IF ( FPRINT ) WRITE(MONIOU,229)
+     *  (I,TLEV(I),TLEVCM(I),SL(I),SAH(I),I=1,IALT(1))
+  229 FORMAT(
+     *  /' LEVEL',2X,'THICKNESS',8X,'HEIGHT',5X,'ELECT. NUMBER',7X,'AGE'
+     *  /'  NO. ',2X,'  G/CM**2',8X,'    CM'/
+     *        (' ',I4,F12.0,2X,F12.0,1X,F17.3,F10.3) )
+ 
+      DO 312  IOL = 1,2
+        IF ( OBSATI(IOL) .LT. 0.D0 ) GOTO 312
+C  DETERMINE LOCAL AGE PARAMETER
+        DO 50  J = 1,9
+          IF ( CZX(J+1,IOL).GT.0.D0  .AND.  CZX(-J-1,IOL).GT.0.D0  .AND.
+     *         CZXY(J+1,IOL).GT.0.D0 .AND.  CZXY(-J-1,IOL).GT.0.D0 .AND.
+     *         CZYX(J+1,IOL).GT.0.D0 .AND.  CZYX(-J-1,IOL).GT.0.D0 .AND.
+     *         CZY(J+1,IOL).GT.0.D0  .AND.  CZY(-J-1,IOL).GT.0.D0 ) THEN
+            AJ = 0.125D0 * (
+     *           CZX(J,IOL) /CZX(J+1,IOL) + CZX(-J,IOL) /CZX(-J-1,IOL)
+     *         + CZXY(J,IOL)/CZXY(J+1,IOL)+ CZXY(-J,IOL)/CZXY(-J-1,IOL)
+     *         + CZYX(J,IOL)/CZYX(J+1,IOL)+ CZYX(-J,IOL)/CZYX(-J-1,IOL)
+     *         + CZY(J,IOL) /CZY(J+1,IOL) + CZY(-J,IOL) /CZY(-J-1,IOL) )
+          ELSE
+            AJ = 0.D0
+          ENDIF
+          IF ( AJ .GT. 0.D0 ) THEN
+            BJ    = DIST(J) / DIST(J+1)
+            CJ    = (DIST(J)+RMOL(IOL)) / (DIST(J+1)+RMOL(IOL))
+            SJ(J) = LOG(AJ * BJ**2 * CJ**4.5D0) / LOG(BJ * CJ)
+            DF(J) = 0.5D0 * (DIST(J) + DIST(J+1))
+          ELSE
+            SJ(J) = 0.D0
+            DF(J) = 0.D0
+          ENDIF
+  50    CONTINUE
+ 
+        DO L = 1,10
+          EVTE(165+IOL*40+L) = SJ(L)
+        ENDDO
+ 
+        IF ( FPRINT ) THEN
+C  WRITE LOCAL AGE PARAMETER
+          WRITE(MONIOU,60) IOL,OBSATI(IOL), (I,DF(I),SJ(I),I=1,9)
+  60      FORMAT(/' RADIAL BIN  DISTANCE(CM)  LOCAL AGE  AT LEVEL NO.',
+     *          I4,' AT HEIGHT:',F10.0,' CM'/
+     *         (' ',I10,'   ',F10.0,'  ',F10.3 ) )
+ 
+C  PRINT LATERAL ELECTRON DISTRIBUTION
+          WRITE(MONIOU,507) IOL,OBSATI(IOL)
+ 507      FORMAT(/' LATERAL ELECTRON DENSITY (/CM**2)    AT LEVEL NO.',
+     *           I4,' AT HEIGHT:',F10.0,' CM'/
+     *           ' --------------------------------------------------',
+     *           '---------------------------'/
+     *           '  DIST (CM)        CZX            CZY      ',
+     *           '      CZXY           CZYX     ')
+          WRITE(MONIOU,508) (DISX(I),CZX(I,IOL),CZY(I,IOL),
+     *                      CZXY(I,IOL),CZYX(I,IOL),I=-10,10)
+ 508      FORMAT(' ',0P,F10.0,1P,4E15.5)
+        ENDIF
+ 
+ 312  CONTINUE
+ 
+      DO  L = 1,10
+        EVTE(195+L) = DIST(L)
+        EVTE(235+L) = DF(L)
+      ENDDO
+ 
+C  WRITE NKG - SHOWER INFORMATION TO EVENT END BLOCK
+      DO 353  L = 1,21
+        EVTE(  7+L) = CZX (-11+L,1)
+        EVTE( 28+L) = CZY (-11+L,1)
+        EVTE( 49+L) = CZXY(-11+L,1)
+        EVTE( 70+L) = CZYX(-11+L,1)
+        EVTE( 91+L) = CZX (-11+L,2)
+        EVTE(112+L) = CZY (-11+L,2)
+        EVTE(133+L) = CZXY(-11+L,2)
+        EVTE(154+L) = CZYX(-11+L,2)
+ 353  CONTINUE
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/avept.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/avept.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/avept.f	(revision 286)
@@ -0,0 +1,85 @@
+      SUBROUTINE AVEPT( ECM,SLOG )
+ 
+C-----------------------------------------------------------------------
+C  AVE(RAGE) PT (TRANSVERSE MOMENTUM)
+C
+C  CALCULATES AVERAGE RATIO PT(PARTICLE)/PT(PION) DEPENDING ON ENERGY
+C  THE DEPENDENCE OF PT ON ENERGY IS DONE IN ROUTINE PTRAM/PTRAN
+C  THIS SUBROUTINE IS CALLED FROM HDPM
+C  ARGUMENTS:
+C   ECM    = ENERGY IN THE CM SYSTEM
+C   SLOG   = LOG(S) ( = LOG(ECM**2) )
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,AVPT.
+      COMMON /AVPT/    AVPT,AVPK,AVPN,AVPH,AVPE
+      DOUBLE PRECISION AVPT,AVPK,AVPN,AVPH,AVPE
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION ECM,SLOG
+C-----------------------------------------------------------------------
+ 
+CC    IF ( DEBUG ) WRITE(MDEBUG,*) 'AVEPT : ECM =',SNGL(ECM)
+ 
+C  AVERAGE TRANSVERSE MOMENTUM
+ 
+C  ... FOR PIONS (=AVPT)
+      IF ( ECM .LT. 132.D0 ) THEN
+        AVPT = 0.3D0 + 6.272D-3 * SLOG
+      ELSE
+        AVPT = ( 0.442105D0 + 0.016276D0 * SLOG )**2
+      ENDIF
+ 
+C  ... FOR KAONS (=AVPK)
+      IF ( ECM .LT. 131.D0 ) THEN
+        AVPK = 1.27D0 * AVPT
+      ELSE
+        AVPK = (0.403146D0 + 0.0281D0 * SLOG)**2
+      ENDIF
+ 
+C  ... FOR NUCLEONS (=AVPN)
+      IF ( ECM .LT. 102.D0 ) THEN
+        AVPN = 1.39D0 * AVPT
+      ELSE
+        AVPN = (0.389873D0 + 0.034127D0 * SLOG)**2
+      ENDIF
+ 
+C  SET AVERAGE PT RELATED TO AVERAGE PT FOR PIONS
+C  ... FOR STRANGE BARYONS (=AVPH)
+      AVPH = 1.3D0 * (1.45D0 * AVPN - 0.45D0 * AVPK) / AVPT
+C  ... FOR ETA MESONS (=AVPE)
+      AVPE = 1.3D0 * (0.88D0 * AVPK + 0.12D0 * AVPN) / AVPT
+      AVPK = 1.3D0 * AVPK / AVPT
+      AVPN = 1.3D0 * AVPN / AVPT
+      AVPT = 1.3D0
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,100)
+     *       SNGL(AVPT),SNGL(AVPK),SNGL(AVPN),SNGL(AVPH),SNGL(AVPE)
+ 100  FORMAT(' AVEPT : AVPT,AVPK,AVPN,AVPH,AVPE=',5F12.5)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/bhabha.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/bhabha.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/bhabha.f	(revision 286)
@@ -0,0 +1,110 @@
+      SUBROUTINE BHABHA
+C                                VERSION 4.00  --  26 JAN 1986/1900
+C******************************************************************
+C   DISCRETE BHABHA SCATTERING (A CALL TO THIS ROUTINE) HAS BEEN
+C   ARBITRARILY DEFINED AND CALCULATED TO MEAN BHABHA SCATTERINGS
+C   WHICH IMPART TO THE SECONDARY ELECTRON SUFFICIENT ENERGY THAT
+C   IT BE TRANSPORTED DISCRETELY, I.E. E=AE OR T=TE.  IT IS NOT
+C   GUARANTEED THAT THE FINAL POSITRON WILL HAVE THIS MUCH ENERGY
+C   HOWEVER.  THE EXACT BHABHA DIFFERENTIAL CROSS SECTION IS USED.
+C******************************************************************
+      DOUBLE PRECISION PEIP,PEKSE2,PESE1,PESE2
+      DOUBLE PRECISION PEKIN,PEKINI,H1,DCOSTH
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' BHABHA:NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      PEIP=E(NP)
+      EIP=PEIP
+      PEKIN=PEIP-PRM
+      EKIN=PEKIN
+      PEKINI=1./PEKIN
+      EKINI=PEKINI
+      T0=EKIN*RMI
+      E0=T0+1.
+      YY=1./(T0+2.)
+      E02=E0*E0
+      BETAI2=E02/(E02-1.)
+      EP0=TE*EKINI
+      EP0C=1.-EP0
+      Y2=YY*YY
+      YP=1.-2.*YY
+      YP2=YP*YP
+      B4=YP2*YP
+      B3=B4+YP2
+      B2=YP*(3.+Y2)
+      B1=2.-Y2
+341   CONTINUE
+       CALL RMMAR(RD,2,2)
+       RNNO03=RD(1)
+       RNNO04=RD(2)
+       BR=EP0/(1.-EP0C*RNNO03)
+       REJF2=EP0C*(BETAI2-BR*(B1-BR*(B2-BR*(B3-BR*B4))))
+       IF((RNNO04.LE.REJF2))GO TO342
+      GO TO 341
+342   CONTINUE
+      IF (BR.LT.0.5) THEN
+       IQ(NP+1)=3
+      ELSE
+       IQ(NP)=3
+       IQ(NP+1)=2
+       BR=1.-BR
+      END IF
+      BR=MAX(BR,0.0)
+      PEKSE2=BR*EKIN
+      PESE1=PEIP-PEKSE2
+      PESE2=PEKSE2+PRM
+      E(NP)=PESE1
+      E(NP+1)=PESE2
+      H1=(PEIP+PRM)*PEKINI
+      DCOSTH=MIN(H1*(PESE1-PRM)/(PESE1+PRM),1.D0)
+      SINTHE=SQRT(1.D0-DCOSTH)
+      COSTHE=SQRT(DCOSTH)
+      CALL UPHI(2,1)
+      NP=NP+1
+      DCOSTH=MIN(H1*(PESE2-PRM)/(PESE2+PRM),1.D0)
+      SINTHE=-SQRT(1.D0-DCOSTH)
+      COSTHE=SQRT(DCOSTH)
+      CALL UPHI(3,2)
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/block1.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/block1.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/block1.f	(revision 286)
@@ -0,0 +1,280 @@
+      BLOCK DATA BLOCK1
+ 
+C-----------------------------------------------------------------------
+C
+C  INITIALIZES DATA
+C-----------------------------------------------------------------------
+ 
+*KEEP,AIR.
+      COMMON /AIR/     COMPOS,PROBTA,AVERAW,AVOGAD
+      DOUBLE PRECISION COMPOS(3),PROBTA(3),AVERAW,AVOGAD
+*KEEP,ANNI.
+      COMMON /ANNI/    CAN,CANN
+      DOUBLE PRECISION CAN(50),CANN(50)
+*KEEP,ATMOS.
+      COMMON /ATMOS/   AATM,BATM,CATM,DATM
+      DOUBLE PRECISION AATM(5),BATM(5),CATM(5),DATM(5)
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,EDECAY.
+      COMMON /EDECAY/  CETA
+      DOUBLE PRECISION CETA(5)
+*KEEP,GNUPR.
+      COMMON /GNUPR/   SE14,SE16,SE40
+      DOUBLE PRECISION SE14(3,14),SE16(3,16),SE40(3,40)
+*KEEP,KAONS.
+      COMMON /KAONS/   CKA
+      DOUBLE PRECISION CKA(80)
+*KEEP,MUPART.
+      COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
+      DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
+      LOGICAL          FMUBRM,FMUORG
+*KEEP,NKGI.
+      COMMON /NKGI/    SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
+     *                 DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
+     *                 OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
+      DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
+     *                 ZSL(10),DIST(10),
+     *                 DISX(-10:10),DISY(-10:10),
+     *                 DISXY(-10:10,2),DISYX(-10:10,2),
+     *                 DLAX (-10:10,2),DLAY (-10:10,2),
+     *                 DLAXY(-10:10,2),DLAYX(-10:10,2),
+     *                 OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
+      INTEGER          IALT(2)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANGE.
+      COMMON /RANGE/   CC
+      DOUBLE PRECISION CC(20)
+*KEEP,REST.
+      COMMON /REST/    CONTNE,TAR,LT
+      DOUBLE PRECISION CONTNE(3),TAR
+      INTEGER          LT
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKF.
+      COMMON /STACKF/  STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+      INTEGER          MAXSTK
+      PARAMETER        (MAXSTK = 12*340*2)
+      DOUBLE PRECISION STACK(MAXSTK)
+      INTEGER          STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+*KEEP,STRBAR.
+      COMMON /STRBAR/  CSTRBA
+      DOUBLE PRECISION CSTRBA(11)
+*KEEP,VERS.
+      COMMON /VERS/    VERNUM,MVDATE,VERDAT
+      DOUBLE PRECISION VERNUM
+      INTEGER          MVDATE
+      CHARACTER*18     VERDAT
+*KEEP,CEREN3.
+      COMMON /CEREN3/  CERCNT,DATAB2,LHCER
+      INTEGER          MAXBF2
+      PARAMETER        (MAXBF2 = 39 * 7)
+      DOUBLE PRECISION CERCNT
+      REAL             DATAB2(MAXBF2)
+      INTEGER          LHCER
+*KEND.
+ 
+C-----------------------------------------------------------------------
+C  AIR
+      DATA COMPOS / 0.78479D0, 0.21052D0, 0.00469D0 /
+      DATA PROBTA / 0.78479D0, 0.99531D0, 1.00000D0 /
+      DATA AVERAW / 14.543D0 /
+      DATA AVOGAD / 6.0225D-4 /
+C  ANNI
+      DATA CAN / 0.0042D0, 0.0728D0, 0.0981D0, 0.2458D0, 0.0295D0,
+     *           0.0654D0, 0.1888D0, 0.1751D0, 0.0443D0, 0.0211D0,
+     *           0.0179D0, 0.0032D0, 0.0020D0, 0.0000D0, 0.0800D0,
+     *           0.0900D0, 0.0070D0, 0.0230D0, 0.1700D0, 0.1000D0,
+     *           0.2600D0, 0.0400D0, 0.0420D0, 0.1200D0, 0.0660D0,
+     *           0.0000D0,   24* 0.0D0 /
+C  ATMOS
+      DATA AATM / -186.5562D0,  -94.919D0,  0.61289D0,0.D0,.01128292D0 /
+      DATA BATM / 1222.6562D0,1144.9069D0,1305.5948D0,540.1778D0,0.D0  /
+      DATA CATM / 994186.38D0,878153.55D0,636143.04D0,772170.16D0,1.D-9/
+C  CEREN3
+      DATA CERCNT / 0.D0 /
+C  CONST
+      DATA PI  / 3.141592653589793D0 /
+      DATA PI2 / 6.283185307179586D0 /
+      DATA OB3 / 0.333333333333333D0 /
+      DATA TB3 / 0.666666666666666D0 /
+C  ENEPER IS CALCULATED IN START: ENEPER = EXP(1.D0)
+C  DATA FOR MUPART: CUTOFF FOR BREMSSTRAHLUNG AT 3 MEV
+      DATA BCUT /0.003D0/
+C  DATA FOR REST: AVERAGE ATOMIC WEIGHT, NEUTRON CONTENTS OF N,O,AR
+      DATA TAR / 14.6D0 /, CONTNE / 0.5D0, 0.5D0, 0.55D0 /, LT / 1 /
+C  KAON CONSTANTS
+      DATA CKA /     0.0D0,  0.1D0, 1.2371D-8, 1.2371D-8, 0.8922D-10,
+     *             5.16D-8, 0.25D0,     0.5D0,    0.75D0,      1.0D0,
+     *               0.5D0,  0.2D0,     0.0D0,     0.0D0,    149.6D0,
+     *             149.6D0,0.236D0,   0.206D0,   0.135D0,    0.222D0,
+     *               0.5D0,  0.0D0,   0.635D0,   0.686D0,    0.876D0,
+     *             0.658D0,0.387D0,     0.0D0,     0.0D0,      0.0D0,
+     *               0.0D0,  0.0D0,     0.0D0,     0.0D0,      1.0D0,
+     *               1.0D5,  0.0D0,     0.0D0,     0.0D0,      0.0D0,
+     *               0.0D0,  0.0D0,     0.0D0,     0.0D0,      0.0D0,
+     *               0.0D0,0.8468D0, 0.9027D0,  0.9509D0,   0.9827D0,
+     *           -0.2154D0, 0.012D0,-0.0101D0,    1.27D0,    0.594D0,
+     *             0.035D0,   0.0D0,   1.84D0,     0.0D0,      1.0D0,
+     *              0.67D0, 0.079D0, 0.0098D0,    2.22D0,    0.028D0,
+     *               0.0D0,1.288D-2,  0.033D0,   0.004D0,   1.194D-2,
+     *              0.03D0,   0.0D0, 1.310D-2,   0.034D0,    0.025D0,
+     *            1.241D-2,   0.0D0,    0.0D0,     0.0D0,      0.0D0  /
+C  DATA FOR ETA DECAY
+      DATA CETA /  0.3913D0,  0.7122D0,  0.9506D0,  -1.07D0,  2.07D0 /
+C  DATA FOR STRANGE BARYON DECAY
+      DATA CSTRBA / 2.632D-10, 0.799D-10, 7.4D-20, 1.479D-10, 0.642D0,
+     *              0.5164D0, 2.90D-10, 1.639D-10, 0.822D-10, 0.678D0,
+     *              0.914D0 /
+C  PARPAR
+      DATA C /   0.0D0,    0.0D0,      1.4D0,      2.5D0,       1.35D0,
+     *           0.0D0,    0.0D0,      0.0D0,      0.0D0,       2.07D0,
+     *           8.2D0,    0.1D0,      0.0D0,      0.0D0,        0.0D0,
+     *          88.0D0,   110.D0,      2.603D-8,   2.19703D-6,   0.0D0,
+     *          37.7D0, 1.532873D-4, 9.386417D0,   2.D-3, 29.9792458D9,
+     *           1.0D0,    0.0D0,     1.57D0,      0.0D0,      0.021D0,
+     *          88.0D0,  110.0D0,      0.0D0,      2.0D1,        0.1D0,
+     *          0.12D0,    0.0D0,      0.0D0,      0.0D0,       0.09D0,
+     *           0.0D0,    0.1D0,      0.0D0,      0.0D0,        0.0D0,
+     *           0.0D0,    0.0D0,      0.0D0,      0.0D0,137.0359895D0 /
+C  DATA FOR RANGE: ENERGY REGIONS FOR SELECTION OF BOXES IN ISOBAR MODEL
+      DATA CC / 2.5D0,  3.5D0, 5.5D0, 10.1D0,
+     *          1.6D0,  2.7D0, 3.9D0, 10.1D0,
+     *          1.6D0, 3.05D0, 3.9D0, 10.1D0, 8*0.D0 /
+C  RUNPAR,STACKF
+      DATA MONIIN /  5 /, MONIOU /  6 /, PATAPE / 90 /, EXST / 96 /,
+     *     MDEBUG /  6 /, NUCNUC / 11 /, MDBASE / 45 /
+     *    ,CETAPE / 91 /
+C  GNUPR   (NEW VERSION OCT 1991)
+C  NITROGEN TARGET  14
+      DATA ((SE14(I,J),I=1,3),J=1,14)
+     *                       / 0.472000D+00,-0.426710D-02, 0.726439D-04,
+     *                         0.230324D+00,-0.989733D-03,-0.807077D-05,
+     *                         0.138623D+00, 0.609624D-03,-0.401675D-04,
+     *                         0.827139D-01, 0.135103D-02,-0.360236D-04,
+     *                         0.445693D-01, 0.137582D-02,-0.137674D-04,
+     *                         0.206106D-01, 0.998620D-03, 0.422867D-05,
+     *                         0.792756D-02, 0.559858D-03, 0.957875D-05,
+     *                         0.247793D-02, 0.247480D-03, 0.701650D-05,
+     *                         0.615535D-03, 0.860096D-04, 0.324410D-05,
+     *                         0.118279D-03, 0.230732D-04, 0.104282D-05,
+     *                         0.169210D-04, 0.461424D-05, 0.235175D-06,
+     *                         0.169481D-05, 0.647634D-06, 0.358189D-07,
+     *                         0.105988D-06, 0.568994D-07, 0.332920D-08,
+     *                         0.311374D-08, 0.235385D-08, 0.143213D-09/
+C  OXYGEN TARGET  16
+      DATA ((SE16(I,J), I=1,3),J=1,16)
+     *                        /0.475002D+00,-0.434401D-02, 0.734217D-04,
+     *                         0.230261D+00,-0.966152D-03,-0.982228D-05,
+     *                         0.137372D+00, 0.642454D-03,-0.408490D-04,
+     *                         0.813380D-01, 0.135241D-02,-0.354835D-04,
+     *                         0.437870D-01, 0.135776D-02,-0.134429D-04,
+     *                         0.204919D-01, 0.988538D-03, 0.398723D-05,
+     *                         0.812995D-02, 0.567070D-03, 0.942943D-05,
+     *                         0.269031D-02, 0.263160D-03, 0.728079D-05,
+     *                         0.732711D-03, 0.993722D-04, 0.366933D-05,
+     *                         0.161940D-03, 0.303662D-04, 0.134776D-05,
+     *                         0.285325D-04, 0.740356D-05, 0.371648D-06,
+     *                         0.390910D-05, 0.140655D-05, 0.768260D-07,
+     *                         0.401145D-06, 0.200620D-06, 0.116200D-07,
+     *                         0.290010D-07, 0.202033D-07, 0.121929D-08,
+     *                         0.131709D-08, 0.128046D-08, 0.795482D-10,
+     *                         0.282645D-10, 0.384068D-10, 0.243535D-11/
+C  ARGON TARGET  40
+      DATA ((SE40(I,J),I=1,3),J=1,18)
+     *                       / 0.318084D+00,-0.352566D-02, 0.829469D-04,
+     *                         0.193581D+00,-0.238538D-02, 0.404919D-04,
+     *                         0.148699D+00,-0.118791D-02,-0.130378D-04,
+     *                         0.117201D+00, 0.966097D-04,-0.536044D-04,
+     *                         0.876737D-01, 0.106482D-02,-0.612882D-04,
+     *                         0.600279D-01, 0.150343D-02,-0.412273D-04,
+     *                         0.370180D-01, 0.147347D-02,-0.130096D-04,
+     *                         0.204422D-01, 0.117625D-02, 0.743960D-05,
+     *                         0.101003D-01, 0.807913D-03, 0.155153D-04,
+     *                         0.447163D-02, 0.489622D-03, 0.146804D-04,
+     *                         0.177806D-02, 0.265260D-03, 0.102802D-04,
+     *                         0.636671D-03, 0.129412D-03, 0.591434D-05,
+     *                         0.205809D-03, 0.571042D-04, 0.291674D-05,
+     *                         0.601981D-04, 0.228546D-04, 0.126074D-05,
+     *                         0.159631D-04, 0.831226D-05, 0.484001D-06,
+     *                         0.384379D-05, 0.275100D-05, 0.166440D-06,
+     *                         0.841490D-06, 0.829259D-06, 0.515615D-07,
+     *                         0.167633D-06, 0.227810D-06, 0.144446D-07/
+      DATA((SE40(I,J),I=1,3),J=19,36)
+     *                        /0.304029D-07, 0.570494D-07, 0.366843D-08,
+     *                         0.502077D-08, 0.130224D-07, 0.845876D-09,
+     *                         0.754786D-09, 0.270844D-08, 0.177211D-09,
+     *                         0.103229D-09, 0.512862D-09, 0.337323D-10,
+     *                         0.128308D-10, 0.883149D-10, 0.583066D-11,
+     *                         0.144721D-11, 0.138082D-10, 0.914113D-12,
+     *                         0.147837D-12, 0.195621D-11, 0.129757D-12,
+     *                         0.136429D-13, 0.250465D-12, 0.166371D-13,
+     *                         0.113379D-14, 0.288894D-13, 0.192092D-14,
+     *                         0.845213D-16, 0.299003D-14, 0.198959D-15,
+     *                         0.562496D-17, 0.276346D-15, 0.183981D-16,
+     *                         0.332222D-18, 0.226723D-16, 0.151001D-17,
+     *                         0.172872D-19, 0.163915D-17, 0.109200D-18,
+     *                         0.785321D-21, 0.103480D-18, 0.689517D-20,
+     *                         0.307886D-22, 0.563885D-20, 0.375787D-21,
+     *                         0.102630D-23, 0.261299D-21, 0.174154D-22,
+     *                         0.285163D-25, 0.100944D-22, 0.672832D-24,
+     *                         0.642589D-27, 0.316302D-24, 0.210839D-25/
+      DATA((SE40(I,J),I=1,3),J=37,40)
+     *                        /0.112817D-28, 0.772286D-26, 0.514807D-27,
+     *                         0.144773D-30, 0.137838D-27, 0.918858D-29,
+     *                         0.120779D-32, 0.159956D-29, 0.106632D-30,
+     *                         0.491605D-35, 0.905709D-32, 0.603784D-33/
+ 
+C  VERSION NUMBER AND DATE OF RELEASE
+      DATA VERNUM / 5.201 /
+      DATA MVDATE / 19970416 /
+C                  -YYYYMMDD-
+      DATA VERDAT / 'APRIL     16, 1997' /
+C                    ----+----+----+---
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box2.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box2.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box2.f	(revision 286)
@@ -0,0 +1,598 @@
+      SUBROUTINE BOX2
+ 
+C-----------------------------------------------------------------------
+C
+C  DETERMINES POINT OF INTERACTION OR DECAY FOR ANY PARTICLE
+C  HEAVY PRIMARIES AND STRANGE BARYONS INCLUDED
+C  ANNIHILATION CROSS SECTION INCLUDED
+C  PRECISE MEAN FREE PATH FOR DECAYING PARTICLES
+C  HAS INTERACTION LENGTH STATISTICS INCLUDED
+C  THIS SUBROUTINE IS CALLED FROM MAIN
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,AIR.
+      COMMON /AIR/     COMPOS,PROBTA,AVERAW,AVOGAD
+      DOUBLE PRECISION COMPOS(3),PROBTA(3),AVERAW,AVOGAD
+*KEEP,CHISTA.
+      COMMON /CHISTA/  IHYCHI,IKACHI,IMUCHI,INNCHI,INUCHI,IPICHI
+      INTEGER          IHYCHI(124),IKACHI(124),IMUCHI(124),
+     *                 INNCHI(124),INUCHI(124),IPICHI(124)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,KAONS.
+      COMMON /KAONS/   CKA
+      DOUBLE PRECISION CKA(80)
+*KEEP,MUPART.
+      COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
+      DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
+      LOGICAL          FMUBRM,FMUORG
+*KEEP,NCSNCS.
+      COMMON /NCSNCS/  SIGN30,SIGN45,SIGN60,SIGO30,SIGO45,SIGO60,
+     *                 SIGA30,SIGA45,SIGA60,PNOA30,PNOA45,PNOA60,
+     *                 SIG30A,SIG45A,SIG60A
+      DOUBLE PRECISION SIGN30(56),SIGN45(56),SIGN60(56),
+     *                 SIGO30(56),SIGO45(56),SIGO60(56),
+     *                 SIGA30(56),SIGA45(56),SIGA60(56),
+     *                 PNOA30(1540,3),PNOA45(1540,3),PNOA60(1540,3),
+     *                 SIG30A(56),SIG45A(56),SIG60A(56)
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,REST.
+      COMMON /REST/    CONTNE,TAR,LT
+      DOUBLE PRECISION CONTNE(3),TAR
+      INTEGER          LT
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,SIGM.
+      COMMON /SIGM/    SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+      DOUBLE PRECISION SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+*KEEP,STRBAR.
+      COMMON /STRBAR/  CSTRBA
+      DOUBLE PRECISION CSTRBA(11)
+*KEEP,VENUS.
+      COMMON /VENUS/   ISH0,IVERVN,MTAR99,FVENUS,FVENSG
+      INTEGER          ISH0,IVERVN,MTAR99
+      LOGICAL          FVENUS,FVENSG
+*KEND.
+ 
+      DOUBLE PRECISION CHIBRM,CHIPRM,CHIINT,CHI1,CHI2,CKA2,COR1,DH,
+     *                 ELAB,ELABLG,ELABT,FRAPTN,FRPTNO,
+     *                 HDEC,HEIGH,PLAB,PLABLG,SIGBRM,SIGPRM,
+     *                 SIG45,S45SQ,S4530,THICK
+      REAL             EKIN,GBRSGM,GPRSGM
+      INTEGER          I,IA,IHY,IP,KA,MU,NI,NU
+      EXTERNAL         HEIGH,THICK,GBRSGM,GPRSGM
+      DOUBLE PRECISION SIGGHE,CGHSIG
+      EXTERNAL         CGHSIG
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,8)
+  444 FORMAT(' BOX2  : CURPAR=',1P,8E10.3)
+ 
+      ITYPE = CURPAR(1)
+ 
+      BETA = SQRT( GAMMA**2 - 1.D0 ) / GAMMA
+ 
+C-----------------------------------------------------------------------
+C  PHOTONS, ELECTRONS,PI(0), AND ETA ARE TREATED SEPARATELY (SEE BOX3)
+      IF ( ITYPE .LE.  3  .OR.   ITYPE .EQ.  7  .OR.  ITYPE .EQ. 17 .OR.
+     *    (ITYPE .GE. 71  .AND.  ITYPE .LE. 74)     ) THEN
+        CHI = 0.D0
+        RETURN
+      ENDIF
+ 
+C-----------------------------------------------------------------------
+C  RESONANCES ARE TREATED SEPARATELY (SEE BOX3)
+      IF ( ITYPE .GT. 50  .AND.  ITYPE .LE. 65 ) THEN
+        CHI = 0.D0
+        RETURN
+      ENDIF
+ 
+      THICKH = THICK(H)
+      ELAB = PAMA(ITYPE) * GAMMA
+ 
+C-----------------------------------------------------------------------
+C  MU + , MU - DECAYS AFTER ITS LIFE TIME
+C  MUON INTERACTS BY BREMSSTRAHLUNG OR PAIR PRODUCTION
+      IF     ( ITYPE .EQ. 5  .OR.  ITYPE .EQ. 6 ) THEN
+        CALL RMMAR( RD,3,1 )
+        COR1 = -LOG(RD(1)) * C(25) * C(19)
+        CALL PRANGE(COR1)
+        DH   = H - HEIGH( THICKH + CHI*COSTHE )
+        IF(DEBUG)WRITE(MDEBUG,*)'BOX2  : ITYPE,RD(1),CHIDEC=',
+     *                                 ITYPE,RD(1),SNGL(CHI)
+        IF ( GAMMA .LE. 200.D0 ) THEN
+          FDECAY = .TRUE.
+ 
+        ELSE
+C  AT HIGHER ENERGIES CHECK FOR MUON BREMSSTRAHLUNG AND PAIR PRODUCTION
+          ELABLG = LOG(ELAB)
+C  CALCULATE MUON BREMSSTRAHLUNG CROSS SECTION FOR AIR
+          IF ( ELAB .LE. 1.D5 ) THEN
+            FRACTN =          COMPOS(1)*GBRSGM( 7.,SNGL(ELAB))
+            FRCTNO = FRACTN + COMPOS(2)*GBRSGM( 8.,SNGL(ELAB))
+            SIGBRM = FRCTNO + COMPOS(3)*GBRSGM(18.,SNGL(ELAB))
+          ELSE
+C  PRELIMINARY PARAMETRIZED FOR ULTRAHIGH ENERGIES
+            SIGBRM = EXP( ELABLG * 0.04437D0 - 1.4805D0 )
+            FRACTN = SIGBRM * 0.78D0
+            FRCTNO = SIGBRM * 0.99D0
+          ENDIF
+          IF(DEBUG)WRITE(MDEBUG,*)'BOX2  : SIGBRM=',SNGL(SIGBRM)
+C  CALCULATE MEAN FREE PATH FOR BREMSSTRAHLUNG
+          CHIBRM = -LOG(RD(2)) * AVERAW / (AVOGAD * SIGBRM)
+          IF(DEBUG)WRITE(MDEBUG,*)'BOX2  : ITYPE,RD(2),CHIBRM=',
+     *                                 ITYPE,RD(2),SNGL(CHIBRM)
+          CHI1   = MIN( CHIBRM, CHI )
+ 
+          IF ( ELAB .LE. 1.D6 ) THEN
+C  CALCULATE  MUON PAIR PRODUCTION CROSS SECTION FOR AIR
+            FRAPTN =          COMPOS(1)*GPRSGM( 7.,SNGL(ELAB))
+            FRPTNO = FRAPTN + COMPOS(2)*GPRSGM( 8.,SNGL(ELAB))
+            SIGPRM = FRPTNO + COMPOS(3)*GPRSGM(18.,SNGL(ELAB))
+          ELSE
+C  PRELIMINARY PARAMETRIZED FOR ULTRAHIGH ENERGIES
+            SIGPRM = EXP( ELABLG * 0.2067D0 + 0.9169D0 )
+            FRACTN = SIGPRM * 0.78D0
+            FRCTNO = SIGPRM * 0.99D0
+          ENDIF
+          IF(DEBUG)WRITE(MDEBUG,*)'BOX2  : SIGPRM=',SNGL(SIGPRM)
+C  CALCULATE MEAN FREE PATH FOR PAIR PRODUCTION
+          CHIPRM = -LOG(RD(3)) * AVERAW / (AVOGAD * SIGPRM)
+          IF(DEBUG)WRITE(MDEBUG,*)'BOX2  : ITYPE,RD(3),CHIPRM=',
+     *                                 ITYPE,RD(3),SNGL(CHIPRM)
+          CHI2   = MIN( CHIPRM, CHI1 )
+          IF     ( CHI2 .EQ. CHI    ) THEN
+            FDECAY = .TRUE.
+          ELSEIF ( CHI2 .EQ. CHIBRM ) THEN
+            FDECAY = .FALSE.
+            FMUBRM = .TRUE.
+C  TARGET IS CHOSEN AT RANDOM FOR MUON BREMSSTRAHLUNG
+            CALL RMMAR( RD,1,1 )
+            IF     ( RD(1)*SIGBRM .LE. FRACTN ) THEN
+C  BREMSSTRAHLUNG WITH NITROGEN
+              LT  = 1
+              TAR = 14.D0
+            ELSEIF ( RD(1)*SIGBRM .LE. FRCTNO ) THEN
+C  BREMSSTRAHLUNG WITH OXYGEN
+              LT  = 2
+              TAR = 16.D0
+            ELSE
+C  BREMSSTRAHLUNG WITH ARGON
+              LT  = 3
+              TAR = 40.D0
+            ENDIF
+          ELSEIF ( CHI2 .EQ. CHIPRM ) THEN
+            FDECAY = .FALSE.
+            FMUBRM = .FALSE.
+C  TARGET IS CHOSEN AT RANDOM FOR MUON PAIR PRODUCTION
+            CALL RMMAR( RD,1,1 )
+            IF     ( RD(1)*SIGPRM .LE. FRAPTN ) THEN
+C  PAIR PRODUCTION WITH NITROGEN
+              LT  = 1
+              TAR = 14.D0
+            ELSEIF ( RD(1)*SIGPRM .LE. FRPTNO ) THEN
+C  PAIR PRODUCTION WITH OXYGEN
+              LT  = 2
+              TAR = 16.D0
+            ELSE
+C  PAIR PRODUCTION WITH ARGON
+              LT  = 3
+              TAR = 40.D0
+            ENDIF
+          ENDIF
+          CHI = CHI2
+        ENDIF
+ 
+C  DECAY LENGTH STATISTICS
+        MU = 1.D0 + DH * 1.D-5 / COSTHE
+        MU = MIN( MU, 123 )
+        IMUCHI( MU) = IMUCHI( MU) + 1
+        IMUCHI(124) = IMUCHI(124) + 1
+ 
+C-----------------------------------------------------------------------
+C  CHARGED PIONS
+      ELSEIF ( ITYPE .EQ. 8  .OR.  ITYPE .EQ. 9 ) THEN
+        PLAB = ELAB * BETA
+C  CALCULATION OF CROSS SECTION IN THE GHEISHA ROUTINES
+        IF ( GHEISH  .AND.  (ELAB .LE. HILOELB) ) THEN
+          EKIN   = ELAB - PAMA(ITYPE)
+          SIGAIR = CGHSIG(SNGL(PLAB),EKIN,ITYPE)
+          GHESIG = .TRUE.
+        ELSE
+          GHESIG = .FALSE.
+C  SIGMA IS ENERGY DEPENDENT INELASTIC PION-NUCLEON CROSS SECTION
+            IF     ( PLAB .LE. 5.D0 ) THEN
+              SIGMA  = 20.64D0
+            ELSEIF ( PLAB .LT. 1.D3 ) THEN
+              PLABLG = LOG(PLAB)
+C  INELASTIC CROSS SECTIONS FROM PARTICLE DATA GROUP
+C  (A.BALDINI ET AL., LANDOLT-BOERNSTEIN NEW SERIES I/12A (1987) 193)
+              SIGMA  = 24.3D0 - 12.3D0 * PLAB**(-1.91D0)
+     *                + 0.324D0 * PLABLG**2 - 2.44D0 * PLABLG
+            ELSE
+C  FACTOR 0.6667 GIVES RATIO BETWEEN PION AND NUCLEON CROSS SECTION
+              SIGMA  = 22.01D0 * ELAB**.0642D0 * 0.6667D0
+            ENDIF
+C  AUXIL. QUANTITIES FOR INTERPOLATION
+            SIG45  = SIGMA - 45.D0
+            S45SQ  = SIG45**2 / 450.D0
+            S4530  = SIG45 / 30.D0
+C  INELASTIC CROSS SECTIONS OF AIR FOR PROJECTILE WITH MASS NUMBER 1
+            SIGAIR = (1.D0 - 2.D0 * S45SQ) * SIG45A(1)
+     *                    +(S45SQ - S4530) * SIG30A(1)
+     *                    +(S45SQ + S4530) * SIG60A(1)
+        ENDIF
+        IF ( DEBUG ) WRITE(MDEBUG,*)'BOX2  : SIGMA,SIGAIR,GHESIG=',
+     *                           SNGL(SIGMA),SNGL(SIGAIR),GHESIG
+ 
+        CALL RMMAR( RD,2,1 )
+C  MEAN FREE PATH FOR INTERACTION (CHIINT)  OR DECAY (CHI)
+        CHIINT = -LOG(RD(1)) * AVERAW / (AVOGAD * SIGAIR)
+        IF(DEBUG)WRITE(MDEBUG,*)'BOX2  : ITYPE,RD(1),CHIINT=',
+     *                                 ITYPE,RD(1),SNGL(CHIINT)
+        COR1   = -LOG(RD(2)) * C(25) * C(18)
+        CALL PRANGE(COR1)
+        IF(DEBUG)WRITE(MDEBUG,*)'BOX2  : ITYPE,RD(2),CHIDEC=',
+     *                                 ITYPE,RD(2),SNGL(CHI)
+        CHI    = MIN( CHIINT, CHI )
+        IF ( CHI .LT. CHIINT ) THEN
+          FDECAY = .TRUE.
+        ELSE
+          FDECAY = .FALSE.
+        ENDIF
+ 
+C  INTERACTION LENGTH STATISTICS
+        IP = 1.D0 + CHI * 0.1D0
+        IP = MIN( IP, 123 )
+        IPICHI( IP) = IPICHI( IP) + 1
+        IPICHI(124) = IPICHI(124) + 1
+ 
+C-----------------------------------------------------------------------
+C  NUCLEONS AND ANTINUCLEONS
+      ELSEIF ( ITYPE .EQ. 13  .OR.  ITYPE .EQ. 14  .OR.
+     *         ITYPE .EQ. 15  .OR.  ITYPE .EQ. 25 ) THEN
+        PLAB = ELAB * BETA
+C  CALCULATION OF CROSS SECTION IN THE GHEISHA ROUTINES
+        IF ( GHEISH  .AND.  (ELAB .LE. HILOELB) ) THEN
+          EKIN   = ELAB - PAMA(ITYPE)
+          SIGAIR = CGHSIG(SNGL(PLAB),EKIN,ITYPE)
+          GHESIG = .TRUE.
+        ELSE
+          GHESIG = .FALSE.
+C  SIGMA IS ENERGY DEPENDENT INELASTIC NUCLEON-NUCLEON CROSS SECTION
+            IF     ( PLAB .LT. 1.D1 ) THEN
+              SIGMA  = 29.9D0
+            ELSEIF ( PLAB .LT. 1.D3 ) THEN
+              PLABLG = LOG(PLAB)
+C  INELASTIC CROSS SECTIONS FROM PARTICLE DATA GROUP
+C  (A.BALDINI ET AL., LANDOLT-BOERNSTEIN NEW SERIES I/12B (1987) 150)
+              SIGMA  = 30.9D0 - 28.9D0 * PLAB**(-2.46D0)
+     *                + 0.192D0 * PLABLG**2 - 0.835D0 * PLABLG
+            ELSE
+              SIGMA  = 22.01D0 * ELAB**.0642D0
+            ENDIF
+ 
+C  ADD ANNIHILATION CROSS SECTION FOR ANTI-NUCLEONS
+            IF ( ITYPE .EQ. 15  .OR.  ITYPE .EQ. 25 ) THEN
+C  ANNIHILATION CROSS SECTIONS FROM PARTICLE DATA GROUP
+C  (A.BALDINI ET AL., LANDOLT-BOERNSTEIN NEW SERIES I/12B (1987) 286)
+              SIGANN = 0.532D0 + 0.634D2 * PLAB**(-0.71D0)
+              SIGMA  = MIN( 120.D0, SIGMA + SIGANN )
+            ENDIF
+C  AUXIL. QUANTITIES FOR INTERPOLATION
+            SIG45  = SIGMA - 45.D0
+            S45SQ  = SIG45**2 / 450.D0
+            S4530  = SIG45 / 30.D0
+C  INELASTIC CROSS SECTIONS OF AIR FOR PROJECTILE WITH MASS NUMBER 1
+            SIGAIR = (1.D0 - 2.D0 * S45SQ) * SIG45A(1)
+     *                    +(S45SQ - S4530) * SIG30A(1)
+     *                    +(S45SQ + S4530) * SIG60A(1)
+        ENDIF
+        IF ( DEBUG ) WRITE(MDEBUG,*)'BOX2  : SIGMA,SIGAIR,GHESIG=',
+     *                           SNGL(SIGMA),SNGL(SIGAIR),GHESIG
+ 
+C  MEAN FREE PATH FROM MOLECULAR WEIGHT, AVOGADRO'S CONSTANT AND SIGMA
+        CALL RMMAR( RD,1,1 )
+        CHI = -LOG(RD(1)) * AVERAW / (AVOGAD * SIGAIR)
+        IF(DEBUG)WRITE(MDEBUG,*)'BOX2  : ITYPE,RD(1),CHI=',
+     *                                 ITYPE,RD(1),SNGL(CHI)
+ 
+C  INTERACTION LENGTH STATISTICS
+        NU = 1.D0 + CHI * 0.1D0
+        NU = MIN( NU, 123 )
+        INUCHI( NU) = INUCHI( NU) + 1
+        INUCHI(124) = INUCHI(124) + 1
+ 
+C-----------------------------------------------------------------------
+C  KAONS (PARTICLE TYPES 10,11,12,16)
+      ELSEIF ( ITYPE .EQ. 10  .OR.  ITYPE .EQ. 11  .OR.
+     *         ITYPE .EQ. 12  .OR.  ITYPE .EQ. 16      ) THEN
+        PLAB = ELAB * BETA
+C  CALCULATION OF CROSS SECTION IN THE GHEISHA ROUTINES
+        IF ( GHEISH  .AND.  (ELAB .LE. HILOELB) ) THEN
+          EKIN   = ELAB - PAMA(ITYPE)
+          SIGAIR = CGHSIG(SNGL(PLAB),EKIN,ITYPE)
+          GHESIG = .TRUE.
+        ELSE
+          GHESIG = .FALSE.
+C  SIGMA IS ENERGY DEPENDENT INELASTIC KAON-NUCLEON CROSS SECTION
+            IF     ( PLAB .LE. 1.D1 ) THEN
+              SIGMA  = 14.11D0
+            ELSEIF ( PLAB .LT. 1.D3 ) THEN
+              PLABLG = LOG(PLAB)
+C  INELASTIC CROSS SECTIONS FROM PARTICLE DATA GROUP
+C  (A.BALDINI ET AL., LANDOLT-BOERNSTEIN NEW SERIES I/12B (1987) 56)
+              SIGMA  = 12.3D0 - 7.77D0 * PLAB**(-2.12D0)
+     *              + 0.0326D0 * PLABLG**2 + 0.738D0 * PLABLG
+            ELSE
+C  FACTOR 0.5541 GIVES RATIO BETWEEN KAON AND NUCLEON CROSS SECTION
+              SIGMA  = 22.01D0 * ELAB**.0642D0 * 0.5541D0
+            ENDIF
+C  AUXIL. QUANTITIES FOR INTERPOLATION
+            SIG45  = SIGMA - 45.D0
+            S45SQ  = SIG45**2 / 450.D0
+            S4530  = SIG45 / 30.D0
+C  INELASTIC CROSS SECTIONS OF AIR FOR PROJECTILE WITH MASS NUMBER 1
+            SIGAIR = (1.D0 - 2.D0 * S45SQ) * SIG45A(1)
+     *                    +(S45SQ - S4530) * SIG30A(1)
+     *                    +(S45SQ + S4530) * SIG60A(1)
+        ENDIF
+        IF ( DEBUG ) WRITE(MDEBUG,*)'BOX2  : SIGMA,SIGAIR,GHESIG=',
+     *                           SNGL(SIGMA),SNGL(SIGAIR),GHESIG
+ 
+        CALL RMMAR( RD,2,1 )
+C  MEAN FREE PATH FOR INTERACTION (CHIINT)  OR DECAY (CHI)
+        CHIINT = -LOG(RD(1)) * AVERAW / (AVOGAD * SIGAIR)
+        IF(DEBUG)WRITE(MDEBUG,*)'BOX2  : ITYPE,RD(1),CHIINT=',
+     *                                 ITYPE,RD(1),SNGL(CHIINT)
+ 
+        IF     ( ITYPE .EQ. 16 ) THEN
+          CKA2 = CKA(5)
+        ELSEIF ( ITYPE .EQ. 10 ) THEN
+          CKA2 = CKA(6)
+        ELSE
+          CKA2 = CKA(3)
+        ENDIF
+        COR1   = -LOG(RD(2)) * C(25) * CKA2
+        IF ( SIGNUM(ITYPE) .EQ. 0.D0 ) THEN
+C  NEUTRAL KAONS
+          DH   = BETA * GAMMA * COSTHE * COR1
+          HDEC = MAX( H - DH, -1.D5 )
+          CHI  = ( THICK(HDEC) - THICKH ) / COSTHE
+        ELSE
+C  CHARGED KAONS
+          CALL PRANGE(COR1)
+        ENDIF
+ 
+        IF(DEBUG)WRITE(MDEBUG,*)'BOX2  : ITYPE,RD(2),CHIDEC=',
+     *                                 ITYPE,RD(2),SNGL(CHI)
+        CHI    = MIN( CHIINT, CHI )
+        IF ( CHI .LT. CHIINT ) THEN
+          FDECAY = .TRUE.
+        ELSE
+          FDECAY = .FALSE.
+        ENDIF
+ 
+C  INTERACTION LENGTH STATISTICS
+        KA = 1.D0 + CHI * 0.1D0
+        KA = MIN( KA, 123 )
+        IKACHI( KA) = IKACHI( KA) + 1
+        IKACHI(124) = IKACHI(124) + 1
+ 
+C-----------------------------------------------------------------------
+C  STRANGE BARYONS ( LAMBDA, SIGMA(+,0,-),XI(0,-), OMEGA- )
+      ELSEIF ( (ITYPE .GE. 18  .AND.  ITYPE .LE. 24)  .OR.
+     *         (ITYPE .GE. 26  .AND.  ITYPE .LE. 32)      ) THEN
+        PLAB = ELAB * BETA
+C  CALCULATION OF CROSS SECTION IN THE GHEISHA ROUTINES
+        IF ( GHEISH  .AND.  (ELAB .LE. HILOELB) ) THEN
+          EKIN   = ELAB - PAMA(ITYPE)
+          SIGAIR = CGHSIG(SNGL(PLAB),EKIN,ITYPE)
+C  SET CROSS SECTION VALUE TO A SMALL NUMBER FOR SIGMA0 AND ANTI SIGMA0
+          IF ( ITYPE .EQ. 20 .OR. ITYPE .EQ. 28 ) THEN
+            SIGAIR = 1.D-3
+          ENDIF
+          GHESIG = .TRUE.
+        ELSE
+          GHESIG = .FALSE.
+C  CROSS SECTION FOR BARYONS IS ASSUMED TO BE THE SAME AS FOR NUCLEONS
+C  SIGMA IS ENERGY DEPENDENT INELASTIC NUCLEON-NUCLEON CROSS SECTION
+            IF     ( PLAB .LT. 1.D1 ) THEN
+              SIGMA  = 29.9D0
+            ELSEIF ( PLAB .LT. 1.D3 ) THEN
+              PLABLG = LOG(PLAB)
+C  INELASTIC CROSS SECTIONS FROM PARTICLE DATA GROUP
+C  (A.BALDINI ET AL., LANDOLT-BOERNSTEIN NEW SERIES I/12B (1987) 150)
+              SIGMA  = 30.9D0 - 28.9D0 * PLAB**(-2.46D0)
+     *                + 0.192D0 * PLABLG**2 - 0.835D0 * PLABLG
+            ELSE
+              SIGMA  = 22.01D0 * ELAB**.0642D0
+            ENDIF
+C  AUXIL. QUANTITIES FOR INTERPOLATION
+            SIG45  = SIGMA - 45.D0
+            S45SQ  = SIG45**2 / 450.D0
+            S4530  = SIG45 / 30.D0
+C  INELASTIC CROSS SECTIONS OF AIR FOR PROJECTILE WITH MASS NUMBER 1
+            SIGAIR = (1.D0 - 2.D0 * S45SQ) * SIG45A(1)
+     *                  +(S45SQ - S4530) * SIG30A(1)
+     *                  +(S45SQ + S4530) * SIG60A(1)
+        ENDIF
+        IF ( DEBUG ) WRITE(MDEBUG,*)'BOX2  : SIGMA,SIGAIR,GHESIG=',
+     *                           SNGL(SIGMA),SNGL(SIGAIR),GHESIG
+ 
+        CALL RMMAR( RD,2,1 )
+C  MEAN FREE PATH FOR INTERACTION (CHIINT)  OR DECAY (CHI)
+        IF     ( ITYPE .GE. 18  .AND.  ITYPE .LE. 21 ) THEN
+          COR1 = -LOG(RD(2)) * C(25) * CSTRBA(ITYPE-17)
+        ELSEIF ( ITYPE .GE. 22  .AND.  ITYPE .LE. 24 ) THEN
+          COR1 = -LOG(RD(2)) * C(25) * CSTRBA(ITYPE-15)
+        ELSEIF ( ITYPE .GE. 26  .AND.  ITYPE .LE. 29 ) THEN
+          COR1 = -LOG(RD(2)) * C(25) * CSTRBA(ITYPE-25)
+        ELSEIF ( ITYPE .GE. 30  .AND.  ITYPE .LE. 32 ) THEN
+          COR1 = -LOG(RD(2)) * C(25) * CSTRBA(ITYPE-23)
+        ENDIF
+        IF ( SIGNUM(ITYPE) .EQ. 0.D0 ) THEN
+C  NEUTRAL STRANGE BARYONS
+          DH   = BETA * GAMMA * COSTHE * COR1
+          HDEC = MAX( H - DH, -1.D5 )
+          CHI  = ( THICK(HDEC) - THICKH ) / COSTHE
+        ELSE
+C  CHARGED STRANGE BARYONS
+          CALL PRANGE(COR1)
+        ENDIF
+        IF(DEBUG)WRITE(MDEBUG,*)'BOX2  : ITYPE,RD(2),CHIDEC=',
+     *                                 ITYPE,RD(2),SNGL(CHI)
+        CHIINT = -LOG(RD(1)) * AVERAW / (AVOGAD * SIGAIR)
+        IF(DEBUG)WRITE(MDEBUG,*)'BOX2  : ITYPE,RD(1),CHIINT=',
+     *                                 ITYPE,RD(1),SNGL(CHIINT)
+        CHI    = MIN( CHIINT, CHI )
+          IF ( CHI .LT. CHIINT ) THEN
+            FDECAY = .TRUE.
+          ELSE
+            FDECAY = .FALSE.
+          ENDIF
+C  GHEISHA CANNOT TREAT SIGMA0 AND ANTI-SIGMA0, LET THEM DECAY
+        IF (GHESIG .AND. (ITYPE.EQ.20 .OR. ITYPE.EQ.28))FDECAY = .TRUE.
+ 
+C  INTERACTION LENGTH STATISTICS
+        IHY = 1.D0 + CHI * 0.1D0
+        IHY = MIN( IHY, 123 )
+        IHYCHI(IHY) = IHYCHI(IHY) + 1
+        IHYCHI(124) = IHYCHI(124) + 1
+ 
+C-----------------------------------------------------------------------
+C  HEAVY PRIMARIES ( ITYPE = 100 * A + Z ,  FE -> ITYPE = 5626 )
+C  ( APPEARING AT FIRST INTERACTION AND AS REMANENTS OF THE PRIMARY )
+      ELSEIF ( ITYPE .GT. 100 ) THEN
+        IA = ITYPE / 100
+        IF ( IA .GT. 56 ) THEN
+          WRITE(MONIOU,*) 'BOX2  : UNEXPECTED PARTICLE TYPE=',ITYPE
+          STOP
+        ENDIF
+C  MEAN FREE PATH OF THE HEAVY PRIMARY IS DEDUCED FROM THAT OF A NUCLEON
+C  ONLY INELASTIC SCATTERING AT INTERACTIONS WITH HEAVY PRIMARY/FRAGMENT
+        ELAB = (PAMA(13) + PAMA(14)) * 0.5D0 * GAMMA
+        PLAB = ELAB * BETA
+C  CALCULATION OF CROSS SECTION IN THE GHEISHA ROUTINES
+        ELABT = ELAB * IA
+        
+c> *** modified by fs (22/09/98) *******************************
+
+c        IF ( GHEISH  .AND.  (ELAB .LE. HILOELB)  .AND.
+c     *     (ITYPE.EQ.402 .OR. ITYPE.EQ.201 .OR. ITYPE.EQ.301) ) THEN
+	IF ( GHEISH  .AND.  (ELAB .LE. HILOELB)  .AND.
+     *     (ITYPE.LE.101) ) THEN
+
+c> *** end of modification *************************************
+
+          EKIN   = ELABT - PAMA(ITYPE)
+          SIGGHE = CGHSIG(SNGL(PLAB),EKIN,ITYPE)
+          IF ( SIGGHE .LE. 0. ) THEN
+            GHESIG = .FALSE.
+          ELSE
+            GHESIG = .TRUE.
+            SIGAIR = SIGGHE
+          ENDIF
+        ELSE
+          GHESIG = .FALSE.
+        ENDIF
+        IF ( .NOT. GHESIG ) THEN
+C  SIGMA IS ENERGY DEPENDENT INELASTIC NUCLEON-NUCLEON CROSS SECTION
+            IF     ( PLAB .LT. 1.D1 ) THEN
+              SIGMA  = 29.9D0
+            ELSEIF ( PLAB .LT. 1.D3 ) THEN
+              PLABLG = LOG(PLAB)
+C  INELASTIC CROSS SECTIONS FROM PARTICLE DATA GROUP
+C  (A.BALDINI ET AL., LANDOLT-BOERNSTEIN NEW SERIES I/12B (1987) 150)
+              SIGMA  = 30.9D0 - 28.9D0 * PLAB**(-2.46D0)
+     *              + 0.192D0 * PLABLG**2 - 0.835D0 * PLABLG
+            ELSE
+              SIGMA  = 22.01D0 * ELAB**.0642D0
+            ENDIF
+C  AUXIL. QUANTITIES FOR INTERPOLATION
+          SIG45  = SIGMA - 45.D0
+          S45SQ  = SIG45**2 / 450.D0
+          S4530  = SIG45 / 30.D0
+C  INELASTIC CROSS SECTIONS OF AIR FOR PROJECTILE WITH MASS NUMBER IA
+          SIGAIR = (1.D0 - 2.D0 * S45SQ) * SIG45A(IA)
+     *                  +(S45SQ - S4530) * SIG30A(IA)
+     *                  +(S45SQ + S4530) * SIG60A(IA)
+        ENDIF
+        IF ( DEBUG ) WRITE(MDEBUG,*)'BOX2  : SIGMA,SIGAIR,GHESIG=',
+     *                           SNGL(SIGMA),SNGL(SIGAIR),GHESIG
+ 
+C  MEAN FREE PATH FROM MOLECULAR WEIGHT, AVOGADRO'S CONSTANT AND SIGMA
+        IF ( SIGAIR .EQ. 0.D0 ) WRITE(MONIOU,*)
+     *    'BOX2: SIGAIR=0.D0, PROGRAM STOPPED',
+     *    'CHECK SELECTED CROSS SECTIONS AND PRIMARIES'
+        CALL RMMAR( RD,1,1 )
+        CHI = -LOG(RD(1)) * AVERAW / (AVOGAD * SIGAIR)
+        IF(DEBUG)WRITE(MDEBUG,*)'BOX2  : ITYPE,RD(1),CHI=',
+     *                                 ITYPE,RD(1),SNGL(CHI)
+ 
+C  INTERACTION LENGTH STATISTICS
+        NI = 1.D0 + CHI * 0.1D0
+        NI = MIN( NI, 123 )
+        INNCHI( NI) = INNCHI( NI) + 1
+        INNCHI(124) = INNCHI(124) + 1
+ 
+C-----------------------------------------------------------------------
+C  ERROR IN PARTICLE CODE
+      ELSE
+        WRITE(MONIOU,*) 'BOX2  : UNEXPECTED PARTICLE TYPE=',ITYPE
+        STOP
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box3.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box3.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box3.f	(revision 286)
@@ -0,0 +1,281 @@
+      SUBROUTINE BOX3
+ 
+C-----------------------------------------------------------------------
+C
+C  CHECKS PASSAGE THROUGH OBSERVATION LEVEL(S)
+C  IRET1=1 KILLS PARTICLE
+C  IRET2=1 PARTICLE HAS BEEN CUTTED IN UPDATE
+C  THIS SUBROUTINE IS CALLED FROM MAIN
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,IRET.
+      COMMON /IRET/    IRET1,IRET2
+      INTEGER          IRET1,IRET2
+*KEEP,LONGI.
+      COMMON /LONGI/   APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
+     *                 NSTEP,LLONGI,FLGFIT
+      DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
+     *                 SPLONG(0:1040,9),THSTEP,THSTPI
+      INTEGER          NSTEP
+      LOGICAL          LLONGI,FLGFIT
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c   Simulate more precisely muons Cherenkov light
+c------------------------------------------------------------
+      integer          k
+      double precision chloop,savpar(8),oldchi,oldthk,oldh
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+      DOUBLE PRECISION HEIGH,HNEW,PROPAR(8),THCKHN
+      INTEGER          I,IRET3,J,L,LPCT1,LPCT2
+      EXTERNAL         HEIGH
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX3  : CURPAR=',1P,9E10.3)
+ 
+      IF     ( ITYPE .EQ. 7 ) THEN
+C  PI 0 DECAYS INTO 2 PHOTONS IN SUBROUTINE PI0DEC
+        CALL TSTINI
+        CALL PI0DEC
+        CALL TSTEND
+        IRET1 = 1
+        RETURN
+ 
+      ELSEIF ( ITYPE .EQ. 5  .OR.  ITYPE .EQ. 6 ) THEN
+C  MUONS ARE TRACKED WITHIN ROUTINE MUTRAC
+        CALL TSTINI
+        CALL MUTRAC
+        CALL TSTEND
+        IRET1 = 1
+        RETURN
+ 
+      ELSEIF ( ITYPE .LE. 3 ) THEN
+C  ELECTRONS OR PHOTONS ARE TREATED IN SUBROUTINE EM
+        CALL EM
+        IRET1 = 1
+        RETURN
+ 
+      ELSEIF (     ITYPE .EQ. 17  .OR.
+     *        (ITYPE .GE. 71  .AND.  ITYPE .LE. 74)) THEN
+C  ETA DECAYS WITHIN ROUTINE ETADEC
+        CALL TSTINI
+        CALL ETADEC
+        CALL TSTEND
+        IRET1 = 1
+        RETURN
+ 
+      ELSEIF ( ITYPE .GE. 51  .AND.  ITYPE .LE. 65 ) THEN
+C  RESONANCES DECAY WITHIN ROUTINE RESDEC
+        CALL TSTINI
+        CALL RESDEC
+        CALL TSTEND
+        IRET1 = 1
+        RETURN
+ 
+      ENDIF
+ 
+C  FOR ALL THE OTHER PARTICLES THE PLACE OF NEXT INTERACTION WAS
+C  DETERMINED IN BOX2
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c   This is just a first approach to the problem
+c------------------------------------------------------------
+
+c      goto 5991
+      if ( itype .eq. 5 .or. itype .eq. 6 ) then
+        oldthk = thickh     
+        do 5101  i = 1,9
+          savpar(i) = curpar(i)
+ 5101   continue
+        chi = 0.2d0 * chi
+        do 5100  k = 1,5
+c  calculate hight difference in cm from given chi in g/cm**2
+          thckhn = thickh + costhe * chi
+          hnew   = heigh(thckhn)
+c  update particle to interaction point (if it reaches so far)
+c  and store coordinates in propar
+          call update( hnew, thckhn, 0 )
+          if ( iret2 .ne. 0 ) goto 5104
+          do 5103  i = 1,8
+            curpar(i) = outpar(i)
+ 5103     continue
+          thickh = thckhn 
+ 5100   continue
+ 5104   continue
+        thickh = oldthk
+        do 5102  i = 1,9
+          curpar(i) = savpar(i)
+ 5102   continue
+        
+      else
+c  calculate hight difference in cm from given chi in g/cm**2
+        thckhn = thickh + costhe * chi
+        hnew   = heigh(thckhn)
+c  update particle to interaction point (if it reaches so far)
+c  and store coordinates in propar
+        call update( hnew, thckhn, 0 )
+          
+      endif
+        
+      goto 5992
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c 5991 continue
+c
+cC     CALCULATE HIGHT DIFFERENCE IN CM FROM GIVEN CHI IN G/CM**2
+c      THCKHN = THICKH + COSTHE * CHI
+c      HNEW   = HEIGH(THCKHN)
+cC     UPDATE PARTICLE TO INTERACTION POINT (IF IT REACHES SO FAR)
+cC     AND STORE COORDINATES IN PROPAR
+c      CALL UPDATE( HNEW, THCKHN, 0 )
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+ 5992 continue
+c>>> it was : >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+cC  CALCULATE HIGHT DIFFERENCE IN CM FROM GIVEN CHI IN G/CM**2
+c      THCKHN = THICKH + COSTHE * CHI
+c      HNEW   = HEIGH(THCKHN)
+c      IF (DEBUG) WRITE(MDEBUG,*)'BOX3  : THICKH,THCKHN,HNEW=',
+c     *                    SNGL(THICKH),SNGL(THCKHN),SNGL(HNEW)
+cC  UPDATE PARTICLE TO INTERACTION POINT (IF IT REACHES SO FAR)
+cC  AND STORE COORDINATES IN PROPAR
+c      CALL UPDATE( HNEW, THCKHN, 0 )
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
+
+      IF ( DEBUG ) THEN
+        WRITE(MDEBUG,455) IRET1,IRET2
+  455   FORMAT(' BOX3  : IRET1..2=',2I5)
+        IF ( IRET2 .EQ. 0 ) WRITE(MDEBUG,454) (OUTPAR(I),I=1,8)
+  454   FORMAT(' BOX3  : OUTPAR=',1P,8E10.3)
+      ENDIF
+C  STORE PARTICLE FOR FURTHER TREATMENT
+      IF ( IRET2 .EQ. 0 ) THEN
+        DO  3  I = 1,8
+          PROPAR(I) = OUTPAR(I)
+   3    CONTINUE
+        IRET3 = 0
+      ELSE
+C  PARTICLE CUTTED AT INTERACTION POINT; IT MAY HOWEVER PASS SOME OF THE
+C  OBSERVATION LEVELS
+        IRET3 = 1
+      ENDIF
+ 
+C  HERE THE ENDPOINT OF THE CURRENT TRACKING STEP IS WELL DEFINED.
+C  THE PARTICLE IS TRACKED FROM THICKH DOWN TO THCKHN
+C  COUNT THE PARTICLES FOR THE LONGITUDINAL DEVELOPMENT
+      IF ( LLONGI ) THEN
+        LPCT1 = INT(THICKH*THSTPI + 1.D0)
+        LPCT2 = INT(THCKHN*THSTPI)
+        LPCT2 = MIN(NSTEP,LPCT2)
+C  ALL HADRONS
+        IF     ( ITYPE .GE. 7 .AND. ITYPE .LE. 41 ) THEN
+          DO 5004 L = LPCT1,LPCT2
+            PLONG(L,6) = PLONG(L,6) + 1.D0
+ 5004     CONTINUE
+C  CHARGED HADRONS
+          IF ( SIGNUM(ITYPE) .NE. 0.D0 ) THEN
+            DO 5005 L = LPCT1,LPCT2
+              PLONG(L,7) = PLONG(L,7) + 1.D0
+ 5005       CONTINUE
+          ENDIF
+C  NUCLEI
+        ELSEIF ( ITYPE .GT. 100 ) THEN
+          DO 5006 L = LPCT1,LPCT2
+            PLONG(L,8) = PLONG(L,8) + 1.D0
+ 5006     CONTINUE
+        ENDIF
+      ENDIF
+ 
+C  CHECK OBSERVATION LEVEL PASSAGE AND UPDATE PARTICLE COORDINATES
+      DO  1  J = 1,NOBSLV
+        IF ( HNEW .GT. OBSLEV(J) ) GOTO 2
+        IF ( H    .LT. OBSLEV(J) ) GOTO 1
+C  REMEMBER NUMBER OF LEVEL FOR OUTPUT
+        LEVL  = J
+        CALL UPDATE( OBSLEV(J), THCKOB(J), J )
+        IF (DEBUG) WRITE(MDEBUG,456) J,IRET1,IRET2
+  456   FORMAT(' BOX3  : LEVEL ',I5,' IRET1,2=',2I5)
+ 
+C  IF PARTICLE IS NOT CUTTED, BRING IT TO OUTPUT
+        IF ( IRET2 .EQ. 0 ) THEN
+          CALL OUTPUT
+        ENDIF
+   1  CONTINUE
+ 
+C  KILL PARTICLE AS IT DECAYS OR INTERACTS BELOW LOWEST OBSLEVEL
+      IRET1 = 1
+      RETURN
+ 
+C  PARTICLE INTERACTS OR DECAYS BEFORE PASSING OBSLEVEL
+   2  CONTINUE
+ 
+C  PARTICLE IS NOW UPDATED TO POINT OF INTERACTION
+      IF ( IRET3 .EQ. 0 ) THEN
+        DO  5  J = 1,8
+          CURPAR(J) = PROPAR(J)
+   5    CONTINUE
+        ALEVEL = H
+        BETA   = SQRT( GAMMA**2 - 1.D0 ) / GAMMA
+      ELSE
+C  ELIMINATE PARTICLE IF BELOW CUTS
+        IRET1 = 1
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box60.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box60.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box60.f	(revision 286)
@@ -0,0 +1,103 @@
+      SUBROUTINE BOX60
+ 
+C-----------------------------------------------------------------------
+C
+C  NUCLEON OR ANTINUCLEON INTERACTIONS
+C  ELASTIC SCATTERING, NO ENERGY LOSS CONSIDERED
+C  INCLUDES ANNIHILATION
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,NCOUNT.
+      COMMON /NCOUNT/  NCOUN
+      INTEGER          NCOUN(8)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,SIGM.
+      COMMON /SIGM/    SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+      DOUBLE PRECISION SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX60 : CURPAR=',1P,9E10.3)
+ 
+C  ANNIHILATION
+      IF ( ITYPE .EQ. 15  .OR.  ITYPE .EQ. 25 ) THEN
+        NCOUN(1) = NCOUN(1) + 1
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1)*SIGMA .LE. SIGANN ) THEN
+          NCOUN(2) = NCOUN(2) + 1
+          CALL NIHILA
+          RETURN
+        ENDIF
+      ENDIF
+ 
+C  ELASTIC SCATTERING
+      DO  1  I = 1,8
+        SECPAR(I) = CURPAR(I)
+    1 CONTINUE
+ 
+      PT     = PTRANS(DUMMY)
+      PLLAB2 = PAMA(ITYPE)**2 * (GAMMA**2 - 1.D0)
+      CTHETA = SQRT( PLLAB2 / (PT**2+PLLAB2))
+ 
+C  KILL UPWARD GOING PARTICLES
+      IF ( CTHETA .LT. C(27) ) RETURN
+      CALL RMMAR( RD,1,1 )
+      CALL ADDANG( COSTHE,PHI, CTHETA,RD(1)*PI2, SECPAR(3),SECPAR(4) )
+      IF ( SECPAR(3) .LT. C(29) ) RETURN
+ 
+      CALL TSTACK
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box61.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box61.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box61.f	(revision 286)
@@ -0,0 +1,103 @@
+      SUBROUTINE BOX61
+ 
+C-----------------------------------------------------------------------
+C
+C  NUCLEON OR ANTINUCLEON INTERACTIONS
+C  LIGHT ISOBAR (FORWARD OR BACKWARD), NUCLEON
+C  INCLUDES ANNIHILATION
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,NCOUNT.
+      COMMON /NCOUNT/  NCOUN
+      INTEGER          NCOUN(8)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,SIGM.
+      COMMON /SIGM/    SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+      DOUBLE PRECISION SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX61 : CURPAR=',1P,9E10.3)
+ 
+C  ANNIHILATION
+      IF ( ITYPE .EQ. 15  .OR.  ITYPE .EQ. 25 ) THEN
+        NCOUN(3) = NCOUN(3) + 1
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1)*SIGMA .LE. SIGANN ) THEN
+          NCOUN(4) = NCOUN(4) + 1
+          CALL NIHILA
+          RETURN
+        ENDIF
+      ENDIF
+ 
+C  INTERACTION (ISOBAR EXCITATION)
+C  SELECT LIGHT ISOBAR AND NUCLEON MASSES
+      CA = C(3)
+      CB = PAMA(14)
+ 
+C  DECIDE WHETHER ISOBAR GOES FORWARD OR BACKWARD
+C  FORWARD IF KIND = 0, BACKWORD IF KIND = 1
+      CALL RMMAR( RD,1,1 )
+      IF ( RD(1) .LE. 0.5 ) THEN
+        KIND = 0
+      ELSE
+        KIND = 1
+      ENDIF
+ 
+C  LIGHT ISOBAR
+      CALL ISOBAR( ECM,KIND,CA,CB,1 )
+ 
+C  NUCLEON
+      CALL SINGLE( ECM,1-KIND,CB,CA )
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box62.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box62.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box62.f	(revision 286)
@@ -0,0 +1,103 @@
+      SUBROUTINE BOX62
+ 
+C-----------------------------------------------------------------------
+C
+C  NUCLEON OR ANTINUCLEON INTERACTIONS
+C  HEAVY ISOBAR (FORWARD OR BACKWARD), NUCLEON
+C  INCLUDES ANNIHILATION
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,NCOUNT.
+      COMMON /NCOUNT/  NCOUN
+      INTEGER          NCOUN(8)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,SIGM.
+      COMMON /SIGM/    SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+      DOUBLE PRECISION SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX62 : CURPAR=',1P,9E10.3)
+ 
+C  ANNIHILATION
+      IF ( ITYPE .EQ. 15  .OR.  ITYPE .EQ. 25 ) THEN
+        NCOUN(5) = NCOUN(5) + 1
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1)*SIGMA .LE. SIGANN ) THEN
+          NCOUN(6) = NCOUN(6) + 1
+          CALL NIHILA
+          RETURN
+        ENDIF
+      ENDIF
+ 
+C  INTERACTION (ISOBAR EXCITATION)
+C  SELECT HEAVY ISOBAR AND NUCLEON MASSES
+      CA = C(4)
+      CB = PAMA(14)
+ 
+C  DECIDE WHETHER ISOBAR GOES FORWARD OR BACKWARD
+C  FORWARD IF KIND = 0, BACKWARD IF KIND = 1
+      CALL RMMAR( RD,1,1 )
+      IF ( RD(1) .LE. 0.5 ) THEN
+        KIND = 0
+      ELSE
+        KIND = 1
+      ENDIF
+ 
+C  HEAVY ISOBAR
+      CALL ISOBAR( ECM,KIND,CA,CB,3 )
+ 
+C  NUCLEON
+      CALL SINGLE( ECM,1-KIND,CB,CA )
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box63.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box63.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box63.f	(revision 286)
@@ -0,0 +1,91 @@
+      SUBROUTINE BOX63
+ 
+C-----------------------------------------------------------------------
+C
+C  NUCLEON OR ANTINUCLEON INTERACTIONS
+C  TWO HEAVY ISOBARS
+C  INCLUDES ANNIHILATION
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,NCOUNT.
+      COMMON /NCOUNT/  NCOUN
+      INTEGER          NCOUN(8)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,SIGM.
+      COMMON /SIGM/    SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+      DOUBLE PRECISION SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX63 : CURPAR=',1P,9E10.3)
+ 
+C  ANNIHILATION
+      IF ( ITYPE .EQ. 15  .OR.  ITYPE .EQ. 25 ) THEN
+        NCOUN(7) = NCOUN(7) + 1
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1)*SIGMA .LE. SIGANN ) THEN
+          NCOUN(8) = NCOUN(8) + 1
+          CALL NIHILA
+          RETURN
+        ENDIF
+      ENDIF
+ 
+C  INTERACTION (ISOBAR EXCITATION)
+C  SELECT HEAVY ISOBAR MASSES
+      CA = C(4)
+      CB = C(4)
+ 
+C  HEAVY ISOBAR BACKWARD
+      CALL ISOBAR( ECM,1,CA,CB,3 )
+ 
+C  HEAVY ISOBAR FORWARD
+      CALL ISOBAR( ECM,0,CB,CA,3 )
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box65.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box65.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box65.f	(revision 286)
@@ -0,0 +1,83 @@
+      SUBROUTINE BOX65
+ 
+C-----------------------------------------------------------------------
+C
+C  PION INTERACTIONS
+C  ELASTIC SCATTERING, NO ENERGY LOSS
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX65 : CURPAR=',1P,9E10.3)
+ 
+C  SCATTERING OF SINGLE PARTICLE
+      DO  1  I = 1,8
+        SECPAR(I) = CURPAR(I)
+    1 CONTINUE
+      PT     = PTRANS(DUMMY)
+      PLLAB2 = PAMA(8)**2 * (GAMMA**2 - 1.D0)
+      CTHETA = SQRT( PLLAB2 / (PT**2+PLLAB2) )
+      IF ( CTHETA .LT. C(27) ) RETURN
+      CALL RMMAR( RD,1,1 )
+      CALL ADDANG( COSTHE,PHI, CTHETA,RD(1)*PI2, SECPAR(3),SECPAR(4) )
+C  KILL BACKWARD GOING PARTICLES
+      IF ( SECPAR(3) .LT. C(29) ) RETURN
+ 
+      CALL TSTACK
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box66.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box66.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box66.f	(revision 286)
@@ -0,0 +1,69 @@
+      SUBROUTINE BOX66
+ 
+C-----------------------------------------------------------------------
+C
+C  PION INTERACTIONS
+C  LIGHT ISOBAR BACKWARD, PION FORWARD
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX66 : CURPAR=',1P,9E10.3)
+ 
+C  SELECT LIGHT ISOBAR AND PION MASSES
+      CA = PAMA(8)
+      CB = C(3)
+ 
+C  LIGHT ISOBAR BACKWARD
+      CALL ISOBAR( ECM,1,CB,CA,1 )
+ 
+C  PION FORWARD
+      CALL SINGLE( ECM,0,CA,CB )
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box67.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box67.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box67.f	(revision 286)
@@ -0,0 +1,69 @@
+      SUBROUTINE BOX67
+ 
+C-----------------------------------------------------------------------
+C
+C  PION INTERACTIONS
+C  HEAVY MESON FORWARD, NUCLEON BACKWARD
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX67 : CURPAR=',1P,9E10.3)
+ 
+C  SELECT HEAVY MESON AND NUCLEON MASSES
+      CA = C(5)
+      CB = PAMA(14)
+ 
+C  HEAVY MESON FORWARD
+      CALL HMESON( ECM,CA,CB )
+ 
+C  NUCLEON BACKWARD
+      CALL SINGLE( ECM,1,CB,CA )
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box68.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box68.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box68.f	(revision 286)
@@ -0,0 +1,69 @@
+      SUBROUTINE BOX68
+ 
+C-----------------------------------------------------------------------
+C
+C  PION INTERACTIONS
+C  HEAVY ISOBAR BACKWARD, PION FORWARD
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX68 : CURPAR=',1P,9E10.3)
+ 
+C  SELECT PION AND HEAVY ISOBAR MASSES
+      CA = PAMA(8)
+      CB = C(4)
+ 
+C  HEAVY ISOBAR BACKWARD
+      CALL ISOBAR( ECM,1,CB,CA,3 )
+ 
+C  PION FORWARD
+      CALL SINGLE( ECM,0,CA,CB )
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box69.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box69.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box69.f	(revision 286)
@@ -0,0 +1,66 @@
+      SUBROUTINE BOX69
+ 
+C-----------------------------------------------------------------------
+C
+C  PION INTERACTIONS
+C  HEAVY ISOBAR BACKWARD, HEAVY MESON FORWARD
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX69 : CURPAR=',1P,9E10.3)
+ 
+C  SELECT HEAVY MESON AND HEAVY ISOBAR MASSES
+      CA = C(5)
+      CB = C(4)
+ 
+C  HEAVY ISOBAR BACKWARD
+      CALL ISOBAR( ECM,1,CB,CA,3 )
+ 
+C  HEAVY MESON FORWARD
+      CALL HMESON( ECM,CA,CB )
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box70.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box70.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box70.f	(revision 286)
@@ -0,0 +1,82 @@
+      SUBROUTINE BOX70
+ 
+C-----------------------------------------------------------------------
+C
+C  KAON INTERACTIONS
+C  ELASTIC SCATTERING, NO ENERGY LOSS
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX70 : CURPAR=',1P,9E10.3)
+ 
+C  ELASTIC SCATTERING
+      DO  1  I = 1,8
+        SECPAR(I) = CURPAR(I)
+    1 CONTINUE
+      PT     = PTRANS(DUMMY)
+      PLLAB2 = PAMA(ITYPE)**2 *(GAMMA**2 - 1.D0)
+      CTHETA = SQRT( PLLAB2 / (PT**2+PLLAB2) )
+      IF ( CTHETA .LT. C(27) ) RETURN
+      CALL RMMAR( RD,1,1 )
+      CALL ADDANG( COSTHE,PHI, CTHETA,RD(1)*PI2,SECPAR(3),SECPAR(4) )
+      IF ( SECPAR(3) .LT. C(29) ) RETURN
+ 
+      CALL TSTACK
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box71.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box71.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box71.f	(revision 286)
@@ -0,0 +1,69 @@
+      SUBROUTINE BOX71
+ 
+C-----------------------------------------------------------------------
+C
+C  KAON INTERACTIONS
+C  LIGHT ISOBAR BACKWARD, KAON FORWARD
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX71 : CURPAR=',1P,9E10.3)
+ 
+C  SELECT LIGHT ISOBAR AND KAON MASSES
+      CA = PAMA(ITYPE)
+      CB = C(3)
+ 
+C  LIGHT ISOBAR BACKWARD
+      CALL ISOBAR( ECM,1,CB,CA,1 )
+ 
+C  KAON FORWARD
+      CALL SINGLE( ECM,0,CA,CB )
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box72.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box72.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box72.f	(revision 286)
@@ -0,0 +1,69 @@
+      SUBROUTINE BOX72
+ 
+C-----------------------------------------------------------------------
+C
+C  KAON INTERACTION
+C  STRANGE MESON, NUCLEON BACKWARD
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX72 : CURPAR=',1P,9E10.3)
+ 
+C  SELECT HEAVY MESON AND NUCLEON MASSES
+      CA = C(5)
+      CB = PAMA(14)
+ 
+C  STRANGE MESON FORWARD
+      CALL VHMESO( ECM,CA,CB )
+ 
+C  NUCLEON BACKWARD
+      CALL SINGLE( ECM,1,CB,CA )
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box73.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box73.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box73.f	(revision 286)
@@ -0,0 +1,70 @@
+      SUBROUTINE BOX73
+ 
+C-----------------------------------------------------------------------
+C
+C  KAON INTERACTIONS
+C  HEAVY ISOBAR BACKWARD, KAON FORWARD
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX73 : CURPAR=',1P,9E10.3)
+ 
+C  SELECT HEAVY ISOBAR AND KAON MASSES
+      CA = PAMA(ITYPE)
+      CB = C(4)
+ 
+C  HEAVY ISOBAR BACKWARD
+      CALL ISOBAR( ECM,1,CA,CB,3 )
+ 
+C  KAON FORWARD
+      CA = PAMA(ITYPE)
+      CALL SINGLE( ECM,0,CA,CB )
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/box74.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/box74.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/box74.f	(revision 286)
@@ -0,0 +1,66 @@
+      SUBROUTINE BOX74
+ 
+C-----------------------------------------------------------------------
+C
+C  KAON INTERACTIONS
+C  HEAVY ISOBAR BACKWARD, STRANGE MESON FORWARD
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' BOX74 : CURPAR=',1P,9E10.3)
+ 
+C  SELECT STRANGE MESON AND HEAVY ISOBAR MASSES
+      CA = C(5)
+      CB = C(4)
+ 
+C  HEAVY ISOBAR BACKWARD
+      CALL ISOBAR( ECM,1,CA,CB,3 )
+ 
+C  STRANGE MESON FORWARD
+      CALL VHMESO( ECM,CA,CB )
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/brems.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/brems.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/brems.f	(revision 286)
@@ -0,0 +1,138 @@
+      SUBROUTINE BREMS
+C                                VERSION 4.00  --  26 JAN 1986/1900
+C******************************************************************
+C   FOR ELECTRON ENERGY GREATER THAN 5.0 MEV, THE BETHE-HEITLER
+C   CROSS SECTION IS EMPLOYED.
+C******************************************************************
+      DOUBLE PRECISION PEIE,PESG,PESE
+      COMMON/BREMPR/DL1(6),DL2(6),DL3(6),DL4(6),DL5(6),DL6(6),DELCM, ALP
+     *HI(2),BPAR(2),DELPOS(2),PWR2I(50)
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+      DATA AI2LN2/0.7213475/
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' BREMS: NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      PEIE=E(NP)
+      EIE=PEIE
+      NP=NP+1
+      IF (EIE.LT.50.0) THEN
+       LVX=1
+       LVL0=0
+      ELSE
+       LVX=2
+       LVL0=3
+      END IF
+      ABREMS=REAL(IFIX(1.44269*ALOG(EIE*API)))
+351   CONTINUE
+       CALL RMMAR(RNNO06,1,2)
+       IF (0.5.LT.((ABREMS*ALPHI(LVX)+0.5)*RNNO06)) THEN
+        CALL RMMAR(RD,2,2)
+        RNNO07=RD(1)
+        RNNO08=RD(2)
+        IDISTR=ABREMS*RNNO07
+        P=PWR2I(IDISTR+1)
+        LVL=LVL0+1
+        IF (RNNO08.GE.AI2LN2) THEN
+361      CONTINUE
+          CALL RMMAR(RD,3,2)
+          RNNO09=RD(1)
+          RNNO10=RD(2)
+          RNNO11=RD(3)
+          H=MAX(RNNO10,RNNO11)
+          BR=1.0-0.5*H
+          IF((BR*RNNO09.LE.0.5))GO TO362
+         GO TO 361
+362      CONTINUE
+        ELSE
+         CALL RMMAR(RNNO12,1,2)
+         BR=RNNO12*0.5
+        END IF
+        BR=BR*P
+       ELSE
+        CALL RMMAR(RD,2,2)
+        RNNO13=RD(1)
+        RNNO14=RD(2)
+        BR=MAX(RNNO13,RNNO14)
+        LVL=LVL0+2
+       END IF
+       ESG=EIE*BR
+       IF((ESG.LT.AP))GO TO351
+       PESG=ESG
+       PESE=PEIE-PESG
+       ESE=PESE
+       IF((ESE.LT.RM))GO TO351
+       DEL = BR/ESE
+       IF((DEL.GE.DELPOS(LVX)))GO TO351
+       DELTA = DELCM*DEL
+       IF (DELTA.LT.1.0) THEN
+        REJF=DL1(LVL)+DELTA*(DL2(LVL)+DELTA*DL3(LVL))
+       ELSE
+        REJF=DL4(LVL)+DL5(LVL)*LOG(DELTA+DL6(LVL))
+       END IF
+       CALL RMMAR(RNSCRN,1,2)
+       IF((RNSCRN.LE.REJF))GO TO352
+      GO TO 351
+352   CONTINUE
+      THETA=RM/EIE
+      CALL UPHI(1,3)
+      IF (ESG.LE.ESE) THEN
+       IQ(NP)=1
+       E(NP)=PESG
+       E(NP-1)=PESE
+      ELSE
+       IQ(NP)=IQ(NP-1)
+       IQ(NP-1)=1
+       E(NP)=PESE
+       E(NP-1)=PESG
+       T=U(NP)
+       U(NP)=U(NP-1)
+       U(NP-1)=T
+       T=V(NP)
+       V(NP)=V(NP-1)
+       V(NP-1)=T
+       T=W(NP)
+       W(NP)=W(NP-1)
+       W(NP-1)=T
+      END IF
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/c-script.sh
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/c-script.sh	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/c-script.sh	(revision 286)
@@ -0,0 +1,190 @@
+#! /bin/sh
+
+readvalue () {
+    dfl="$1"
+    msg="$2"
+    desc="$3"
+
+    echo ''
+    echo $msg
+    echo -n "[ $dfl ] ? "
+    read value
+    value=${value:="$dfl"}
+    echo "$desc <- $value"
+}
+
+cat <<EOF    
+
+MAGIC.MC.DAEMON Configuration Script
+========================================
+
+NOTE:: This script WILL NOT create any directory in
+       the case that it does not exist. 
+       You MUST have created all the directories for yourself.
+       You will need :
+
+        - an [executables directory]: where I will look for 
+                    the CORSIKA executables and data files, and
+                    for the MMD program.
+
+        - a [data directory]: where I will save the data.
+
+        - an [administration directory]: where some log-files
+                    will be created.
+
+       If you DO NOT have yet these directories created, press
+       now Ctrl-C, create them, and write afterwards again
+
+       $ make script
+
+Press Return to continue, or Ctrl-C to stop this script.
+EOF
+read ans
+
+cat <<EOF
++---------------------------------------------------+
+| This procedure will ask you about some parameters | 
+| of your system. Please, answer all the questions. | 
+| If you have any doubt, press Ctrl-C.              | 
++---------------------------------------------------+
+EOF
+
+readvalue `pwd` \
+    "Directory where the CORSIKA and daemon executables should be located:" path-exe 
+pathexe="$value"
+
+readvalue "c520-osf" \
+    "Enter the executable name:" name-exe 
+nameexe="$value"
+
+readvalue "/data" \
+    "Disk/path where the bulk of data will be stored:" data-disk
+datadisk="$value"
+
+readvalue "/data" \
+    "Disk/path where the administration files will be stored:" adm-disk
+admdisk="$value"
+
+echo ''
+
+readvalue "0" \
+    "Final NICE value to use when running CORSIKA" niceval
+niceval="$value"
+
+readvalue "0" \
+    "What is your site seed generator?" siteval
+siteval="$value"
+
+readvalue "no" \
+    "Do you want to check the system load before running CORSIKA (yes/no)" MACH
+MACH="$value"
+
+echo ''
+
+readvalue "$USER@$HOST" \
+    "Enter the e-mail address to sent the log-mailing to" email-add
+useradd="$value"
+
+echo ''
+
+echo 'Preparing daemon . . .'
+
+cat <<EOF >dmy.sed
+s=#USERADD#=$useradd=g
+s=#DATADISK#=$datadisk=g
+s=#ADMDISK#=$admdisk=g
+s=#PATHEXE#=$pathexe=g
+s=#NAMEEXE#=$nameexe=g
+s=#NICE#=$niceval=g
+s=#SITE#=$siteval=g
+EOF
+
+sed -f dmy.sed magic-mc.daemon.tpl > mmd
+
+
+if [ $MACH = "yes" ]; then
+
+    cat <<EOF >> mmd
+# get information about system load
+if ( check_cpu_load() < 3 ) {
+    send_mail( "\n## Top output:\n\n" . \`\$TOP -b\`, 1 );
+    exit;
+}
+
+# make job
+make_job;
+
+# say bye, execute job and leave this program
+exec "\$SYSDIR/job.cmds" 
+    or croak "Cannot execute job file";
+EOF
+
+else
+
+    cat <<EOF >> mmd
+# get information about system load
+check_cpu_load();
+
+# make job
+make_job;
+
+# say bye, execute job and leave this program
+exec "\$SYSDIR/job.cmds" 
+    or croak "Cannot execute job file";
+EOF
+
+fi
+
+chmod 744 ${pathexe}/mmd
+
+echo 'MMD (MAGIC-MC.DAEMON) was generated.'
+
+echo ''
+
+echo 'The MAGIC-MC.DAEMON is designed to run from the crontab.'
+
+readvalue "yes" \
+    "Do you want me to change your crontab (yes/no)?" crntb
+crntb="$value"
+
+echo ''
+
+echo 'OK, I will change your crontab. I will asume you are using C-shell'
+
+if [ $crntb = "yes" ]; then
+    crontab -l > dmy
+    echo '0,15,30,45 * * * * '${pathexe}'/mmd -n'${niceval}' -q >& '${admdisk}'/last-crontab-out' >> dmy
+    crontab dmy
+    rm -f dmy
+fi
+
+echo ''
+echo 'Preparing your administration directory (do not worry about'
+echo 'some messages like "[file]: No such file or directory"'
+echo ''
+
+${pathexe}/mmd -c
+
+echo 'Done.'
+
+cat <<EOF
+
+MAGIC-MC.DAEMON is ready to run.
+
+If you did not ask me to modify your crontab,
+you must run yourself the program, with the following 
+command line:
+
+$ mmd -n$niceval -q >& ${admdisk}/last-crontab-out
+
+However, it's much better if let my do the dirty work
+for you.
+
+Good luck.
+
+In case of problems, please contact to <gonzales@hegra1.mppmu.mpg.de>
+
+EOF
+
+
+
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/cerenkov.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/cerenkov.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/cerenkov.f	(revision 286)
@@ -0,0 +1,1196 @@
+C=======================================================================
+
+      SUBROUTINE CERENE( STEPCR )
+
+C-----------------------------------------------------------------------
+C  CEREN(KOV RADIATION FROM) E(LECTRONS)
+C
+C  CREATION OF CERENKOV PHOTONS ALONG A TRACK OF ELECTRONS
+C  CERENKOV RADIATION IS ONLY CALCULATED FOR LOWEST OBSERVATION LEVEL
+C  THE COORDINATES ON EGS-STACK ARE AT THE END OF STEP EXCEPT E(NP),
+C  WHICH IS AT THE BEGINNING OF STEP
+C  THIS SUBROUTINE IS CALLED FROM ELECTR
+C  ARGUMENT:
+C   STEPCR = STEP LENGTH FOR ELECTRON OR POSITRON (REAL*4)
+C
+C  AUTHOR  : M. ROZANSKA  UNIVERSITY OF KRAKOW
+C            S. MARTINEZ  UNIVERSITY OF MADRID
+C            F. ARQUEROS  UNIVERSITY OF MADRID
+C  CHANGES : D. HECK    IK3  FZK KARLSRUHE
+C            R. ATTALLAH  UNIVERSITY OF PERPIGNAN
+C-----------------------------------------------------------------------
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      parameter (xct=1)
+      parameter (yct=2)
+      parameter (zct=3)
+      parameter (ctthet=4)
+      parameter (ctphi=5)
+      parameter (ctdiam=6)
+      parameter (ctfoc=7)
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+c      IMPLICIT NONE
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,EPCONT.
+      COMMON/EPCONT/   EDEP,RATIO,TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,IDISC,
+     *                 IROLD,IRNEW,RHOFAC, EOLD,ENEW,EKE,ELKE,BETA2,GLE,
+     *                 TSCAT,IAUSFL
+      DOUBLE PRECISION EDEP,RATIO
+      REAL             TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,RHOFAC,EOLD,ENEW,
+     *                 EKE,ELKE,BETA2,GLE,TSCAT
+      INTEGER          IDISC,IROLD,IRNEW,IAUSFL(29)
+*KEEP,LONGI.
+      COMMON /LONGI/   APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
+     *                 NSTEP,LLONGI,FLGFIT
+      DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
+     *                 SPLONG(0:1040,9),THSTEP,THSTPI
+      INTEGER          NSTEP
+      LOGICAL          LLONGI,FLGFIT
+*KEEP,MAGANG.
+      COMMON /MAGANG/  ARRANG,ARRANR,COSANG,SINANG
+      DOUBLE PRECISION ARRANG,ARRANR,COSANG,SINANG
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEEP,CEREN1.
+      COMMON /CEREN1/  CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD,
+     *                 CERSIZ,LCERFI
+      DOUBLE PRECISION CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD
+      REAL             CERSIZ
+      LOGICAL          LCERFI
+*KEEP,CEREN2.
+      COMMON /CEREN2/  PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS,CERYOS,
+     *                 NCERX,NCERY,ICERML
+      REAL             PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS(20),CERYOS(20)
+      INTEGER          NCERX,NCERY,ICERML
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+*keep,certel.
+      common /certel/  cormxd,cord,coralp,ctpars,omega,
+     +                 photn,photnp,phpt,pht,vphot,
+     +                 vchi,veta,vzeta,vchim,vetam,vzetam,
+     +                 lambda,mu,nu,nctels,ncph
+      double precision cormxd,cord,coralp,ctpars(20,7),omega(20,3,3),
+     +                 photn(3),photnp(3),phpt(3),pht,vphot(3),
+     +                 vchi(3),veta(3),vzeta(3),vchim,vetam,vzetam,
+     +                 lambda,mu,nu
+      integer          nctels,ncph(5)
+      double precision xg,yg,zg,xgp,ygp,zgp,up,vp,wp,xpcut,ypcut,zpcut
+      equivalence (photn(1) ,xg)   ,(photn(2) ,yg)   ,(photn(3) ,zg)  ,
+     +            (photnp(1),xgp)  ,(photnp(2),ygp)  ,(photnp(3),zgp),
+     +            (phpt(1)  ,xpcut),(phpt(2)  ,ypcut),(phpt(3)  ,zpcut),
+     +            (vphot(1) ,up)   ,(vphot(2) ,vp)   ,(vphot(3) ,wp)    
+      character *72 ctfile
+*keep,graal1.
+      common /graal1/ wavelength ! (nm)
+      real wavelength
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+*KEND.
+
+      COMMON /ACLOCK/  NCLOCK,JCLOCK
+      DOUBLE PRECISION BETAE,BETAF,BETAI,CTHETA,DBETA,ECR,
+     *                 ETA1,E1,STHETA,STHETF,STHETI
+      DOUBLE PRECISION RHOF,THICK
+      REAL             A,B,CC,COSCR,COSDEL,DVCOR,DXXX,DYYY,FSTEPI,
+     *                 HTOP,H2,PATHCR,PHICER,PHOTCT,RADINV,
+     *                 SINCR,SINDEL,SINPSI,SINPS2,STEPCR,UEMIS2,US,VCOR,
+     *                 VEMIS2,VS,WEMIS,XCER1,XCER2,XEMIS,XXX,
+     *                 YCER1,YCER2,YEMIS,YYY
+      INTEGER          I,ISTC,I1,JCLOCK,LPCT1,NCLOCK,NSTEPC
+      EXTERNAL         RHOF,THICK
+C-----------------------------------------------------------------------
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,*)'CERENE: NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____ENDIF
+
+C-----------------------------------------------------------------------
+
+C  SKIP PARTICLES OUT OF ZENITH ANGULAR CUT
+      IF ( W(NP) .LT. C(29) ) RETURN
+C  E(NP) IS ENERGY AT BEGIN OF STEP
+      E1 = E(NP)
+
+C  LOOK WETHER CERENKOV CONDITION IS FULFILLED AT BEGIN OF STEP
+      BETAI  = SQRT( 1.D0 - (PAMA(2)*1.D3/E1)**2 )
+C  REFRACTIVE INDEX PARAMETRISATION: N=1+ETA = ETA1
+      H2     = -Z(NP)
+      HTOP   = H2 + VSTEP * W(NP)
+      ETA1   = 1.D0 + ETADSN * RHOF(DBLE(HTOP))
+      CTHETA = 1.D0 /( ETA1 * BETAI)
+      STHETI = 1.D0 - CTHETA**2
+      IF ( STHETI .GT. 0.D0 ) THEN
+C  PARTICLE IS ABOVE ENERGY THRESHOLD IF EMISSION ANGLE IS >0
+        PHOTCT = CYIELD * STEPCR * STHETI
+        NSTEPC = PHOTCT / CERSIZ + 1
+        IF ( NSTEPC .LT. 1 ) RETURN
+        FSTEPI = 1. / REAL(NSTEPC)
+C  CALCULATE INCREMENTS AND START VALUES FOR POSITION AND VELOCITY
+        DVCOR  = -VSTEP * FSTEPI
+        VCOR   = VSTEP - 0.5 * DVCOR
+        DBETA  = -2.D0*FSTEPI*EDEP*(PAMA(2)*1.D3)**2 / (E1**3*BETAI)
+        BETAE  = BETAI - 0.5D0 * DBETA
+      ELSE
+        
+C  LOOK WETHER CERENKOV CONDITION IS FULFILLED AT END OF STEP, BUT NOT
+C  AT THE BEGINNING. THIS MAY HAPPEN ONLY ABOVE ABOUT 22 KM
+        IF ( HTOP .LT. 22.E5 ) RETURN
+C  ENERGY AT END OF STEP IS ENEW (FROM COMMON EPCONT)
+        BETAF  = SQRT( 1.D0 - (PAMA(2)*1.D3/ENEW)**2 )
+C  REFRACTIVE INDEX PARAMETRISATION: N=1+ETA = ETA1
+        ETA1   = 1.D0 + ETADSN * RHOF( DBLE(H2) )
+        CTHETA = 1.D0 /( ETA1 * BETAF)
+        STHETF = 1.D0 - CTHETA**2
+C  PARTICLE IS BELOW ENERGY THRESHOLD IF EMISSION ANGLE IS 0
+        IF ( STHETF .LE. 0.D0 ) RETURN
+        PHOTCT = CYIELD * STEPCR * STHETF
+        NSTEPC = PHOTCT / CERSIZ + 1
+        IF ( NSTEPC .LT. 1 ) RETURN
+        FSTEPI = 1. / REAL(NSTEPC)
+C  CALCULATE INCREMENTS AND START VALUES FOR POSITION AND VELOCITY
+C  LOOP 1000 RUNS FROM BOTTOM TO TOP OF STEP
+        DVCOR  = VSTEP * FSTEPI
+        VCOR   = -0.5 * DVCOR
+        DBETA  = 2.D0*FSTEPI*EDEP*(PAMA(2)*1.D3)**2 / (ENEW**3*BETAF)
+        BETAE  = BETAF - 0.5D0 * DBETA
+      ENDIF
+
+C  LOOP OVER SUBSTEPS
+      DO 1000  ISTC = 1,NSTEPC
+        VCOR   = VCOR + DVCOR
+        ZEMIS  = H2 + VCOR * W(NP)
+        ETA1   = 1.D0 + ETADSN * RHOF(DBLE(ZEMIS))
+C  VELOCITY IN THE MIDDLE OF SUBSTEP
+        BETAE  =  BETAE + DBETA
+        CTHETA = 1.D0 / (ETA1*BETAE)
+        STHETA = 1.D0 - CTHETA**2
+C  PARTICLE IS AT ENERGY THRESHOLD IF EMISSION ANGLE BECOMES 0
+        IF ( STHETA .LE. 0.D0 ) RETURN
+C  NUMBER OF EMITTED PHOTONS ON DISTANCE DVCOR
+        PHOTCM = CYIELD * STHETA * STEPCR * FSTEPI
+        STHETA = SQRT(STHETA)
+C  ASSUME EMISSION POINT OF ALL PHOTONS IN THE MIDDLE OF THE STEP
+        XEMIS  =  X(NP) - VCOR * U(NP)
+        YEMIS  = -Y(NP) + VCOR * V(NP)
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C GENERATE RANDOM WAVELENGTH FOR SINGLE C-PHOTON.
+        CALL RMMAR( RD,1,3 )
+        WAVELENGTH = 1. / (1/WAVLGL - 
+     +       RD(1)/(WAVLGL*WAVLGU/(WAVLGU-WAVLGL)))
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C  CALCULATE PHOTON DIRECTION IN THE CORSIKA COORDINATE FRAME
+        CALL RMMAR( RD,1,3 )
+        PHICER = RD(1) * PI2
+        SINCR  = SIN(PHICER)
+        COSCR  = COS(PHICER)
+        A =  U(NP)
+        B = -V(NP)
+        CC = W(NP)
+        SINPS2 = A**2 + B**2
+        IF ( SINPS2 .LT. 1.E-10 ) THEN
+          UEMIS  = STHETA * COSCR
+          VEMIS  = STHETA * SINCR
+          WEMIS  = CTHETA * CC
+        ELSE
+          SINPSI = SQRT(SINPS2)
+          US     = STHETA * COSCR
+          VS     = STHETA * SINCR
+          SINDEL = B * (1./SINPSI)
+          COSDEL = A * (1./SINPSI)
+          UEMIS  = CC * COSDEL * US - SINDEL * VS + A * CTHETA
+          VEMIS  = CC * SINDEL * US + COSDEL * VS + B * CTHETA
+          WEMIS  =     -SINPSI * US              + CC * CTHETA
+        ENDIF
+C  EMISSION ANGLE WITHIN ZENITH ANGULAR CUT?
+        IF ( WEMIS .LT. C(29) ) GOTO 1000
+        RADINV = 1.5 - 0.5 * ( UEMIS**2 + VEMIS**2 + WEMIS**2 )
+        UEMIS2 = UEMIS * RADINV
+        VEMIS2 = VEMIS * RADINV
+        WEMIS  = WEMIS * RADINV
+
+C  CALCULATE DISTANCE FROM SHOWER AXIS AT THE DETECTOR LEVEL
+        PATHCR = ( ZEMIS - OBSLEV(NOBSLV) ) / WEMIS
+        XCER2  = XEMIS + PATHCR * UEMIS2 - XOFF(NOBSLV)
+        YCER2  = YEMIS + PATHCR * VEMIS2 - YOFF(NOBSLV)
+
+C  ADD THE CERENKOV PHOTONS TO THE LONGITUDINAL DEVELOPMENT
+        IF ( LLONGI ) THEN
+C  IF STARTING POINT BELOW LOWEST LEVEL THEN DON'T CHECK
+          IF ( HLONG(NSTEP) .LE. ZEMIS ) THEN
+C  FIND FIRST THE EQUIVALENT LEVELS
+            LPCT1 = LPCTE(NP)
+C  ZEMIS IS ONLY LITTLE BELOW Z OLD, THEREFORE INCREMENTAL SEARCH
+C  (REMEBER: LPCTE IS AT START OF ELECTRON STEP)
+            DO 6002 I1 = LPCT1,NSTEP
+              IF ( HLONG(I1) .LT. ZEMIS ) GOTO 6003
+ 6002       CONTINUE
+            I1 = NSTEP + 1
+ 6003       CONTINUE
+            DO 4862 I=I1,NSTEP
+                PLONG(I,9) = PLONG(I,9) + PHOTCM
+ 4862       CONTINUE
+          ENDIF
+        ENDIF
+
+C  TAKE INTO ACCOUNT A ROTATION OF ARRAY RELATIVE TO MAGNETIC NORD
+        XCER  = XCER2  * COSANG + YCER2  * SINANG
+        YCER  = YCER2  * COSANG - XCER2  * SINANG
+        UEMIS = UEMIS2 * COSANG + VEMIS2 * SINANG
+        VEMIS = VEMIS2 * COSANG - UEMIS2 * SINANG
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+        CERELE = CERELE + PHOTCM
+        DO 7001 I=1,ICERML
+          DO 101 NCT=1,NCTELS
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>> Modification to implement sphere algorithm >>>>>>>>>>>>>>>>>>>>>>>>
+c>> JCG Wed Sep 21 10:49:14 MET DST 1998 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>>>>> this is the last (simple) check <<<<<
+C  changes to ct frame
+c            XG = XCER - CERXOS(I) - CTPARS(NCT,XCT) 
+c            YG = YCER - CERYOS(I) - CTPARS(NCT,YCT) 
+c            ZG =  0.0 - CTPARS(NCT,ZCT)
+c            DIST2 = SQRT( XG**2 + YG**2 )
+c            IF ( DIST2 .LT. (CTPARS(NCT,CTDIAM)/2.) ) GOTO 102
+c>> New check >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+            XG = XCER - CERXOS(I) 
+            YG = YCER - CERYOS(I)
+            ZG = 0.0
+            DIST2 = 
+     >          SQRT((VEMIS*(-CTPARS(NCT,XCT) + XG) - 
+     >          UEMIS*(-CTPARS(NCT,YCT) + YG))**2 + 
+     >          (-(SQRT(1 - UEMIS**2 - VEMIS**2)*
+     >          (-CTPARS(NCT,XCT) + XG)) + 
+     >          UEMIS*(-CTPARS(NCT,ZCT) + ZG))**2 + 
+     >          (SQRT(1 - UEMIS**2 - VEMIS**2)*
+     >          (-CTPARS(NCT,YCT) + YG) - 
+     >          VEMIS*(-CTPARS(NCT,ZCT) + ZG))**2)
+            IF ( DIST2 .LT. (CTPARS(NCT,CTDIAM)/2.) ) GOTO 102
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+            
+ 101      CONTINUE
+          
+          GOTO 7001
+          
+C   BUNCH FALLS ON A DETECTOR, CALCULATE ARRIVAL TIME (NSEC)
+          
+ 102      CARTIM = ((ETADSN*(THCKOB(NOBSLV)-THICK(DBLE(ZEMIS)))
+     *         /WEMIS+PATHCR-VCOR/BETAE)/C(25)+TIME(NP))* 1.E9
+          
+c          CALL OUTPT2(IQ(NP),I)
+          CALL OUTPT2(NCT,I)
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+          call jctime(cartim)
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+          GOTO 1000
+          
+ 7001   CONTINUE
+ 1000 CONTINUE
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      RETURN
+      END
+
+C=======================================================================
+
+      SUBROUTINE CERENH( STEPCR,BETACR )
+
+C-----------------------------------------------------------------------
+C  CEREN(KOV RADIATION FROM) H(ADRONS)
+C
+C  CERENKOV RADIATION FROM HADRONS
+C  CERENKOV RADIATION IS ONLY CALCULATED FOR LOWEST OBSERVATION LEVEL
+C  THIS SUBROUTINE IS CALLED FROM UPDATE
+C  ARGUMENTS:
+C   STEPCR = STEP LENGTH FOR ELECTRON OR POSITRON
+C   BETACR = VELOCITY OF PARTICLE IN UNITS OF SPEED OF LIGHT
+C
+C  AUTHOR  : M. ROZANSKA  UNIVERSITY OF KRAKOW
+C            S. MARTINEZ  UNIVERSITY OF MADRID
+C            F. ARQUEROS  UNIVERSITY OF MADRID
+C  CHANGES : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      parameter (xct=1)
+      parameter (yct=2)
+      parameter (zct=3)
+      parameter (ctthet=4)
+      parameter (ctphi=5)
+      parameter (ctdiam=6)
+      parameter (ctfoc=7)
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+c      IMPLICIT NONE
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,EPCONT.
+      COMMON/EPCONT/   EDEP,RATIO,TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,IDISC,
+     *                 IROLD,IRNEW,RHOFAC, EOLD,ENEW,EKE,ELKE,BETA2,GLE,
+     *                 TSCAT,IAUSFL
+      DOUBLE PRECISION EDEP,RATIO
+      REAL             TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,RHOFAC,EOLD,ENEW,
+     *                 EKE,ELKE,BETA2,GLE,TSCAT
+      INTEGER          IDISC,IROLD,IRNEW,IAUSFL(29)
+*KEEP,LONGI.
+      COMMON /LONGI/   APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
+     *                 NSTEP,LLONGI,FLGFIT
+      DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
+     *                 SPLONG(0:1040,9),THSTEP,THSTPI
+      INTEGER          NSTEP
+      LOGICAL          LLONGI,FLGFIT
+*KEEP,MAGANG.
+      COMMON /MAGANG/  ARRANG,ARRANR,COSANG,SINANG
+      DOUBLE PRECISION ARRANG,ARRANR,COSANG,SINANG
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,CEREN1.
+      COMMON /CEREN1/  CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD,
+     *                 CERSIZ,LCERFI
+      DOUBLE PRECISION CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD
+      REAL             CERSIZ
+      LOGICAL          LCERFI
+*KEEP,CEREN2.
+      COMMON /CEREN2/  PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS,CERYOS,
+     *                 NCERX,NCERY,ICERML
+      REAL             PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS(20),CERYOS(20)
+      INTEGER          NCERX,NCERY,ICERML
+*KEEP,CERHDR.
+      COMMON/CERHDR/   TPART,UPART,VPART,WPART,XPART,YPART,ZPART
+      DOUBLE PRECISION TPART,UPART,VPART,WPART,XPART,YPART,ZPART
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+*keep,certel.
+      common /certel/  cormxd,cord,coralp,ctpars,omega,
+     +                 photn,photnp,phpt,pht,vphot,
+     +                 vchi,veta,vzeta,vchim,vetam,vzetam,
+     +                 lambda,mu,nu,nctels,ncph
+      double precision cormxd,cord,coralp,ctpars(20,7),omega(20,3,3),
+     +                 photn(3),photnp(3),phpt(3),pht,vphot(3),
+     +                 vchi(3),veta(3),vzeta(3),vchim,vetam,vzetam,
+     +                 lambda,mu,nu
+      integer          nctels,ncph(5)
+      double precision xg,yg,zg,xgp,ygp,zgp,up,vp,wp,xpcut,ypcut,zpcut
+      equivalence (photn(1) ,xg)   ,(photn(2) ,yg)   ,(photn(3) ,zg)  ,
+     +            (photnp(1),xgp)  ,(photnp(2),ygp)  ,(photnp(3),zgp),
+     +            (phpt(1)  ,xpcut),(phpt(2)  ,ypcut),(phpt(3)  ,zpcut),
+     +            (vphot(1) ,up)   ,(vphot(2) ,vp)   ,(vphot(3) ,wp)    
+      character *72 ctfile
+*keep,graal1.
+      common /graal1/ wavelength ! (nm)
+      real wavelength
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+*KEND.
+
+      DOUBLE PRECISION BETACR,CINTEN,CTHETA,ETA,ETA1,HMID,PHOTCT,
+     *                 RHOF,STEPCR,STHETA,THICK
+      REAL             A,B,CC,COSCR,COSDEL,DVCOR,DXXX,DYYY,FSTEPI,
+     *                 PATHCR,PHICER,RADINV,SINCR,SINDEL,SINPSI,SINPS2,
+     *                 UEMIS2,US,VEMIS2,VCOR,VS,WEMIS,XCER1,XCER2,XEMIS,
+     *                 XXX,YCER1,YCER2,YEMIS,YYY
+      INTEGER          I,II,ISTC,I1,I2,NSTEPC
+      EXTERNAL         RHOF,THICK
+C-----------------------------------------------------------------------
+
+c      IF ( DEBUG ) WRITE(MDEBUG,*) 'CERENH: ZPART=',SNGL(ZPART),
+c     *    ' STEPCR=',SNGL(STEPCR),' BETACR=',SNGL(BETACR)
+
+C  SKIP PARTICLE OUT OF ANGULAR ACCEPTANCE RANGE
+      IF ( WPART .LT. C(29) ) RETURN
+C  CERENKOV INTENSITY FACTOR DEPENDS ON CHARGE STATE OF HEAVY IONS
+      CINTEN = CYIELD * ABS(SIGNUM(INT(CURPAR(1))))
+
+C  REFRACTIVE INDEX PARAMETRISATION: N=1+ETA
+      HMID   = ZPART + 0.5D0 * STEPCR * WPART
+      ETA1   = 1.D0 + ETADSN * RHOF(DBLE(HMID))
+      CTHETA = 1.D0 / ( ETA1 * BETACR )
+      STHETA = 1.D0 - CTHETA**2
+      IF ( STHETA .LE. 0.D0 ) RETURN
+
+      PHOTCT = CINTEN * STHETA * STEPCR
+      NSTEPC = PHOTCT / CERSIZ + 1
+      IF ( NSTEPC .LT. 1 ) RETURN
+      FSTEPI = 1. / REAL(NSTEPC)
+      VCOR   = -0.5 * STEPCR * FSTEPI
+      DVCOR  = -2. * VCOR
+C  CERENKOV RADIATION IS ONLY CALCULATED FOR LOWEST OBSERVATION LEVEL
+      DO  1000  ISTC = 1,NSTEPC
+        VCOR   = VCOR + DVCOR
+        ZEMIS  = ZPART + VCOR * WPART
+        ETA    = ETADSN * RHOF(DBLE(ZEMIS))
+        ETA1   = 1.D0 + ETA
+        CTHETA = 1.D0 / ( ETA1 * BETACR )
+        STHETA = 1.D0 - CTHETA**2
+        IF ( STHETA .LE. 0.D0 ) RETURN
+
+C  NUMBER OF EMITTED PHOTONS ON DISTANCE STEPCR
+        PHOTCM = CINTEN * STHETA * STEPCR * FSTEPI
+        STHETA = SQRT(STHETA)
+
+C  ASSUME EMISSION POINT OF ALL PHOTONS IN THE MIDDLE OF THE STEP
+C  HAS TO BE CHECKED IF STEPS ARE NOT TOO LONG
+        XEMIS = XPART - VCOR * UPART
+        YEMIS = YPART - VCOR * VPART
+
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C GENERATE RANDOM WAVELENGTH FOR SINGLE C-PHOTON.
+        CALL RMMAR( RD,1,3 )
+        WAVELENGTH = 1. / (1/WAVLGL - 
+     +       RD(1)/(WAVLGL*WAVLGU/(WAVLGU-WAVLGL)))
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+C  CALCULATE PHOTON DIRECTION IN THE OVERALL COORDINATE FRAME
+        CALL RMMAR( RD,1,3 )
+        PHICER = RD(1) * PI2
+        SINCR  = SIN(PHICER)
+        COSCR  = COS(PHICER)
+        A  = UPART
+        B  = VPART
+        CC = WPART
+        SINPS2 = A**2 + B**2
+        IF ( SINPS2 .LT. 1.E-10 ) THEN
+          UEMIS  = STHETA * COSCR
+          VEMIS  = STHETA * SINCR
+          WEMIS  = CTHETA * CC
+        ELSE
+          SINPSI = SQRT(SINPS2)
+          US = STHETA * COSCR
+          VS = STHETA * SINCR
+          SINDEL = B * (1./SINPSI)
+          COSDEL = A * (1./SINPSI)
+          UEMIS  = CC * COSDEL * US - SINDEL * VS + A * CTHETA
+          VEMIS  = CC * SINDEL * US + COSDEL * VS + B * CTHETA
+          WEMIS  =     -SINPSI * US              + CC * CTHETA
+        ENDIF
+C  EMISSION ANGLE WITHIN ZENITH ANGULAR CUT?
+        IF ( WEMIS .LT. C(29) ) GOTO 1000
+        RADINV = 1.5 - 0.5 * ( UEMIS**2 + VEMIS**2 + WEMIS**2 )
+        UEMIS2 = UEMIS * RADINV
+        VEMIS2 = VEMIS * RADINV
+        WEMIS  = WEMIS * RADINV
+
+C  CALCULATE DISTANCE FROM SHOWER AXIS AT THE DETECTOR LEVEL
+        PATHCR = ( ZEMIS - OBSLEV(NOBSLV) ) / WEMIS
+        XCER2  = XEMIS + PATHCR * UEMIS2 - XOFF(NOBSLV)
+        YCER2  = YEMIS + PATHCR * VEMIS2 - YOFF(NOBSLV)
+
+C  ADD THE CERENKOV PHOTONS TO THE LONGITUDINAL DEVELOPMENT
+        IF ( LLONGI ) THEN
+C  IF STARTING POINT BELOW LOWEST LEVEL THEN DON'T CHECK
+          IF ( HLONG(NSTEP) .LE. ZEMIS ) THEN
+C  FIND FIRST THE EQUIVALENT LEVELS
+            I1 = 0
+            I2 = NSTEP
+ 6001       CONTINUE
+            II = (I1+I2)/2
+            IF ( HLONG(II) .LT. ZEMIS ) THEN
+              I2 = II
+            ELSE
+              I1 = II
+            ENDIF
+            IF ( I2-I1 .GT. 1 ) GOTO 6001
+            DO 4862 I=I2,NSTEP
+                PLONG(I,9) = PLONG(I,9) + PHOTCM
+ 4862       CONTINUE
+          ENDIF
+        ENDIF
+
+C  TAKE INTO ACCOUNT A ROTATION OF ARRAY RELATIVE TO MAGNETIC NORD
+        XCER  = XCER2  * COSANG + YCER2  * SINANG
+        YCER  = YCER2  * COSANG - XCER2  * SINANG
+        UEMIS = UEMIS2 * COSANG + VEMIS2 * SINANG
+        VEMIS = VEMIS2 * COSANG - UEMIS2 * SINANG
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+        CERHAD = CERHAD + PHOTCM
+        DO 7001 I=1,ICERML
+          DO 101 NCT=1,NCTELS
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>> Modification to implement sphere algorithm >>>>>>>>>>>>>>>>>>>>>>>>
+c>> JCG Wed Sep 21 10:49:14 MET DST 1998 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>>>>> this is the last (simple) check <<<<<
+C  changes to ct frame
+c            XG = XCER - CERXOS(I) - CTPARS(NCT,XCT) 
+c            YG = YCER - CERYOS(I) - CTPARS(NCT,YCT) 
+c            ZG =  0.0 - CTPARS(NCT,ZCT)
+c            DIST2 = SQRT( XG**2 + YG**2 )
+c            IF ( DIST2 .LT. (CTPARS(NCT,CTDIAM)/2.) ) GOTO 102
+c>> New check >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+            XG = XCER - CERXOS(I) 
+            YG = YCER - CERYOS(I)
+            ZG = 0.0
+            DIST2 = 
+     >          SQRT((VEMIS*(-CTPARS(NCT,XCT) + XG) - 
+     >          UEMIS*(-CTPARS(NCT,YCT) + YG))**2 + 
+     >          (-(SQRT(1 - UEMIS**2 - VEMIS**2)*
+     >          (-CTPARS(NCT,XCT) + XG)) + 
+     >          UEMIS*(-CTPARS(NCT,ZCT) + ZG))**2 + 
+     >          (SQRT(1 - UEMIS**2 - VEMIS**2)*
+     >          (-CTPARS(NCT,YCT) + YG) - 
+     >          VEMIS*(-CTPARS(NCT,ZCT) + ZG))**2)
+            IF ( DIST2 .LT. (CTPARS(NCT,CTDIAM)/2.) ) GOTO 102
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ 101      CONTINUE
+          
+          GOTO 7001
+          
+C   BUNCH FALLS ON A DETECTOR, CALCULATE ARRIVAL TIME (NSEC)
+          
+ 102      CARTIM = ((ETADSN*(THCKOB(NOBSLV)-THICK(DBLE(ZEMIS)))
+     *         /WEMIS+PATHCR-VCOR/BETACR)/C(25)+TPART)*1.E9
+
+c          CALL OUTPT2(INT(CURPAR(1)),I)
+          CALL OUTPT2(NCT,I)
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+          call jctime(cartim)
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+          GOTO 1000
+          
+ 7001   CONTINUE
+ 1000 CONTINUE
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      RETURN
+      END
+
+C=======================================================================
+
+      SUBROUTINE GETBUS( IPARTI,ENERGY,THETA,CERSZE )
+
+C-----------------------------------------------------------------------
+C  GET BU(NCH) S(IZE)
+C
+C  CALCULATES OPTIMAL BUNCH SIZE FOR CERENKOV PHOTONS. CERENKOV PHOTONS
+C  ARE GROUPED IN BUNCHES IN ORDER TO ACCELERATE COMPUTING TIME.
+C  HOWEVER, WE SET A MAXIMAL VALUE FOR THE GROUPING OF CERENKOV PHOTONS
+C  SO THAT WE GET AT LEAST 100 BUNCHES/M**2 AT A CERENKOV FLUX OF 3000
+C  PHOTONS/M**2. THIS IS THE MINIMUM CERENKOV FLUX WHICH CAN BE
+C  DISTINGUISHED FROM THE NIGHT SKY LIGHT BACKGROUND IN THE HEGRA
+C  EXPERIMENT AT THE ISLAND LA PALMA. SO THE PARAMETRIZATION OF THE
+C  CERENKOV BUNCH AS CALCULATED IN THIS SUBROUTINE IS VALID FOR
+C  OBSERVATION LEVELS SIMILAR TO THAT OF THE HEGRA EXPERIMENT.
+C     FOR A GIVEN PRIMARY PARTICLE, INCIDENT ENERGY AND ANGLE, AN
+C  OPTIMAL BUNCH SIZE IS CALCULATED BY INTERPOLATION IN A TABLE,
+C  WHERE WE HAVE CHOSEN AN ENERGY RANGE UP TO 1000 TEV, INCIDENT
+C  ANGLES 0 AND 40 DEGREES, AND 4 TYPES OF PRIMARIS: GAMMAS,
+C  PROTONS, NITROGEN, AND IRON.
+C  THIS SUBROUTINE IS CALLED FROM MAIN
+C  ARGUMENTS:
+C   IPARTI      = TYPE OF PRIMARY PARTICLE
+C   ENERGY (R4) = PARTICLES ENERGY IN GEV
+C   THETA  (R4) = ANGLE IN RAD
+C   CERSZE (R4) = SIZE OF CERENKOV BUNCH
+C
+C  AUTHORS : S. MARTINEZ  UNIVERSITY OF MADRID
+C            F. ARQUEROS  UNIVERSITY OF MADRID
+C-----------------------------------------------------------------------
+
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+
+      REAL    ANGLE(2),ENGAM(3),ENHAD(3),ENNIT(2),
+     *        SIFE(3,2),SIGAM(3,2),SINIT(2),SIPRO(3,2)
+      REAL    CERS1F,CERS1P,ENERGY,CERSZE,S1,S2,THETA
+      INTEGER I,IANFE,IANP,IATNUM,IPARTI,I1,I2
+
+      DATA ANGLE /  0., 40. /
+      DATA ENGAM /  100.,  200.,  500. /
+      DATA ENHAD /  100.,  200.,  1000. /
+      DATA ENNIT /  200.,  1000. /
+      DATA ( SIFE (I,1),I=1,3 ) /  30.,  30.,  140. /
+      DATA ( SIFE (I,2),I=1,3 ) /  30.,  30.,  110. /
+      DATA ( SIGAM(I,1),I=1,3 ) /  30.,  45.,  100. /
+      DATA ( SIGAM(I,2),I=1,3 ) /  30.,  40.,  100. /
+      DATA SINIT /  30.,  150. /
+      DATA ( SIPRO(I,1),I=1,3 ) /  30.,  30.,  120. /
+      DATA ( SIPRO(I,2),I=1,3 ) /  30.,  30.,  160. /
+      DATA IANP   / 1 /, IANFE / 26 /
+C-----------------------------------------------------------------------
+
+c      IF ( DEBUG ) WRITE(MDEBUG,100) IPARTI,SNGL(ENERGY),SNGL(THETA)
+c 100  FORMAT(' GETBUS: INPUT PARTICLE = ',I5,1P,2E10.3)
+
+C  DEFAULT VALUE
+      CERSZE = 100.
+
+      ENERGY = ENERGY / 1000.
+      IF ( ENERGY .LE. 100. ) THEN
+        CERSZE = 30.
+        IF ( DEBUG ) WRITE(MDEBUG,101) CERSZE
+        RETURN
+      ENDIF
+
+      THETA  = THETA / PI * 180.
+
+C-----------------------------------------------------------------------
+C  PHOTON, ELECTRON OR POSITRON AS PRIMARY PARTICLE
+      IF ( IPARTI .LE. 3 ) THEN
+C  FIND ENERGY BIN FOR INTERPOLATION
+        IF ( ENERGY .LE. ENGAM(2) ) THEN
+          I1 = 1
+          I2 = 2
+        ELSE
+          I1 = 2
+          I2 = 3
+        ENDIF
+        S1 = SIGAM(I1,1) + (ENERGY - ENGAM(I1))
+     *       / (ENGAM(I2) - ENGAM(I1))
+     *       * (SIGAM(I2,1) - SIGAM(I1,1))
+        S2 = SIGAM(I1,2) + (ENERGY - ENGAM(I1))
+     *       / (ENGAM(I2) - ENGAM(I1))
+     *       * (SIGAM(I2,2) - SIGAM(I1,2))
+        CERSZE = S1 + (THETA-ANGLE(1))/(ANGLE(2)-ANGLE(1)) * (S2-S1)
+        IF ( DEBUG ) WRITE(MDEBUG,101) CERSZE
+        RETURN
+      ENDIF
+
+C-----------------------------------------------------------------------
+C  NITROGEN AS PRIMARY PARTICLE AND VERTICAL INCIDENCE
+CJOK WHY SPECIAL TREATMENT FOR NITROGEN ????
+CJOK WHY ONLY VERTICAL INCIDENCE ????
+      IF ( IPARTI .EQ. 1407  .AND.  ABS(THETA) .LT. 1.E-1 ) THEN
+        IF ( ENERGY .LT. 200. ) THEN
+          CERSZE = 30.
+        ELSE
+          CERSZE = SINIT(1) + (ENERGY-ENNIT(1))
+     *             / (ENNIT(2)-ENNIT(1)) * (SINIT(2)-SINIT(1))
+        ENDIF
+        IF ( DEBUG ) WRITE(MDEBUG,101) CERSZE
+        RETURN
+      ENDIF
+
+C-----------------------------------------------------------------------
+C  GET THE ATOMIC NUMBER OF THE NUCLEUS
+C  Z IS 1,  IF PROTON
+      IF     ( IPARTI .EQ. 14  ) THEN
+        IATNUM = 1
+C  REST OF POSSIBLE NUCLEI
+      ELSEIF ( IPARTI .GT. 100 ) THEN
+        IATNUM = MOD(IPARTI,100)
+        IF ( IATNUM .GT. 26 ) THEN
+          WRITE(MONIOU,*) 'GETBUS: UNEXPECTED PARTICLE CODE'
+          RETURN
+        ENDIF
+      ELSE
+        WRITE(MONIOU,*) 'GETBUS: UNEXPECTED PARTICLE CODE'
+        RETURN
+      ENDIF
+
+C  FIND ENERGY BIN FOR INTERPOLATION IN CASE OF HADRONIC PRIMARY
+      IF ( ENERGY .LE. ENHAD(2) ) THEN
+        I1 = 1
+        I2 = 2
+      ELSE
+        I1 = 2
+        I2 = 3
+      ENDIF
+
+C  INTERPOLATION FOR HADRONS
+      S1 = SIPRO(I1,1) + (ENERGY-ENHAD(I1))
+     *       / (ENHAD(I2)-ENHAD(I1)) * (SIPRO(I2,1)-SIPRO(I1,1))
+      S2 = SIPRO(I1,2) + (ENERGY-ENHAD(I1))
+     *       / (ENHAD(I2)-ENHAD(I1)) * (SIPRO(I2,2)-SIPRO(I1,2))
+      CERS1P = S1 + (THETA-ANGLE(1)) / (ANGLE(2)-ANGLE(1)) * (S2-S1)
+
+      S1 = SIFE(I1,1) + (ENERGY-ENHAD(I1)) / (ENHAD(I2)-ENHAD(I1))
+     *                * (SIFE(I2,1)-SIFE(I1,1))
+      S2 = SIFE(I1,2) + (ENERGY-ENHAD(I1)) / (ENHAD(I2)-ENHAD(I1))
+     *                * (SIFE(I2,2)-SIFE(I1,2))
+      CERS1F = S1 + (THETA-ANGLE(1)) / (ANGLE(2)-ANGLE(1)) * (S2-S1)
+
+      CERSZE = CERS1P + (IATNUM-IANP) * (CERS1F-CERS1P) / (IANFE-IANP)
+
+      IF ( DEBUG ) WRITE(MDEBUG,101) CERSZE
+ 101  FORMAT(' GETBUS: BUNCH SIZE = ',1P,1E10.3)
+
+      RETURN
+      END
+
+C=======================================================================
+
+      SUBROUTINE OUTND2
+
+C-----------------------------------------------------------------------
+C  OUT(PUT AT E)ND (OF SHOWER)
+C
+C  WRITE REST OF PARTICLES TO OUTPUT BUFFER
+C  OUTND2 IS CALLED FROM MAIN
+C
+C  AUTHORS : S. MARTINEZ, UNIVERSITY OF MADRID
+C            F. ARQUEROS, UNIVERSITY OF MADRID
+C-----------------------------------------------------------------------
+
+      IMPLICIT NONE
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,CEREN2.
+      COMMON /CEREN2/  PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS,CERYOS,
+     *                 NCERX,NCERY,ICERML
+      REAL             PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS(20),CERYOS(20)
+      INTEGER          NCERX,NCERY,ICERML
+*KEEP,CEREN3.
+      COMMON /CEREN3/  CERCNT,DATAB2,LHCER
+      INTEGER          MAXBF2
+      PARAMETER        (MAXBF2 = 39 * 7)
+      DOUBLE PRECISION CERCNT
+      REAL             DATAB2(MAXBF2)
+      INTEGER          LHCER
+*KEND.
+
+      INTEGER I
+C-----------------------------------------------------------------------
+
+      IF ( LHCER .GT. 0 ) THEN
+        CALL TOBUFC( DATAB2,1 )
+        DO  2  I = 1,MAXBF2
+          DATAB2(I) = 0.
+    2   CONTINUE
+      ELSE
+        CALL TOBUFC( DATAB2,2 )
+      ENDIF
+
+      WRITE(MONIOU,*) 'CERCNT = ',SNGL( CERCNT )
+      CERCNT = 0.D0
+      LHCER  = 0
+
+      RETURN
+      END
+
+C=======================================================================
+
+      SUBROUTINE OUTPT2(J,IMOV)
+
+C-----------------------------------------------------------------------
+C  (WRITE CERENKOV RADIATION) OUTP(U)T
+C
+C  OUTPUT ROUTINE FOR CERENKOV PHOTONS
+C  THIS SUBROUTINE IS CALLED FROM CERENE AND CERENH
+C
+C  AUTHORS : S. MARTINEZ, UNIVERSITY OF MADRID
+C            F. ARQUEROS, UNIVERSITY OF MADRID
+C-----------------------------------------------------------------------
+
+      IMPLICIT NONE
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,CEREN1.
+      COMMON /CEREN1/  CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD,
+     *                 CERSIZ,LCERFI
+      DOUBLE PRECISION CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD
+      REAL             CERSIZ
+      LOGICAL          LCERFI
+*KEEP,CEREN2.
+      COMMON /CEREN2/  PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS,CERYOS,
+     *                 NCERX,NCERY,ICERML
+      REAL             PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS(20),CERYOS(20)
+      INTEGER          NCERX,NCERY,ICERML
+*KEEP,CEREN3.
+      COMMON /CEREN3/  CERCNT,DATAB2,LHCER
+      INTEGER          MAXBF2
+      PARAMETER        (MAXBF2 = 39 * 7)
+      DOUBLE PRECISION CERCNT
+      REAL             DATAB2(MAXBF2)
+      INTEGER          LHCER
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      COMMON /GRAAL1/  WAVELENGTH ! (NM)
+      REAL WAVELENGTH
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+*KEND.
+
+      INTEGER I,J,IMOV
+C-----------------------------------------------------------------------
+
+      IF(DEBUG)WRITE(MDEBUG,3)PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS
+  3   FORMAT(' OUTPT2: ',1P,8E10.3)
+C  WRITE A BLOCK OF 39 PARTICLES TO THE CERENKOV OUTPUT BUFFER AND
+C  CLEAR FIELD
+      IF ( LCERFI ) THEN
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c        DATAB2(LHCER+1) = PHOTCM
+cc        DATAB2(LHCER+1) = WAVELENGTH + J*1000.
+        DATAB2(LHCER+1) = J*100000. + IMOV*1000. + WAVELENGTH
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+        DATAB2(LHCER+2) = XCER
+        DATAB2(LHCER+3) = YCER
+        DATAB2(LHCER+4) = UEMIS
+        DATAB2(LHCER+5) = VEMIS
+        DATAB2(LHCER+6) = CARTIM
+        DATAB2(LHCER+7) = ZEMIS
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c        CERCNT = CERCNT + DBLE( PHOTCM )
+        CERCNT = CERCNT + 1
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+        LHCER  = LHCER + 7
+        IF ( LHCER .GE. MAXBF2 ) THEN
+          CALL TOBUFC( DATAB2,0 )
+          DO  1  I = 1,MAXBF2
+            DATAB2(I) = 0.
+    1     CONTINUE
+          LHCER = 0
+        ENDIF
+      ELSE
+C  WRITE A BLOCK OF 39 PARTICLES TO THE PARTICLE OUTPUT BUFFER AND
+C  CLEAR FIELD
+        DATAB(LH+1) = 99.E5 + NINT(PHOTCM)*10. + 1.
+        DATAB(LH+2) = XCER
+        DATAB(LH+3) = YCER
+        DATAB(LH+4) = UEMIS
+        DATAB(LH+5) = VEMIS
+        DATAB(LH+6) = CARTIM
+        DATAB(LH+7) = ZEMIS
+        LH     = LH + 7
+        NOPART = NOPART + 1
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c        CERCNT = CERCNT + DBLE( PHOTCM )
+        CERCNT = CERCNT + 1
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+        IF ( LH .GE. MAXBUF ) THEN
+          CALL TOBUF( DATAB,0 )
+          DO  2  I = 1,MAXBUF
+            DATAB(I) = 0.
+    2     CONTINUE
+          LH = 0
+        ENDIF
+      ENDIF
+
+      RETURN
+      END
+
+C=======================================================================
+
+      SUBROUTINE TOBUFC( A,IFL )
+
+C-----------------------------------------------------------------------
+C  (WRITE) TO BUF(FER) C(ERENKOV DATA)
+C
+C  COPY TO BUFFER CERENKOV DATA
+C  THIS SUBROUTINE IS CALLED FROM MAIN, INPRM, ELECTR, PHOTON, OUTND2,
+C  AND OUTPT2
+C  ARGUMENTS:
+C   A      = ARRAY TO BE WRITTEN TO TAPE
+C   IFL    = STARTING OF FINAL OUTPUT
+C          = 0  NORMAL BLOCK
+C          = 1  NORMAL BLOCK WITH END OF OUTPUT
+C          = 2  ONLY END OF OUTPUT
+C-----------------------------------------------------------------------
+
+      IMPLICIT NONE
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,RECORD.
+      COMMON /RECORD/  IRECOR
+      INTEGER          IRECOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,CEREN3.
+      COMMON /CEREN3/  CERCNT,DATAB2,LHCER
+      INTEGER          MAXBF2
+      PARAMETER        (MAXBF2 = 39 * 7)
+      DOUBLE PRECISION CERCNT
+      REAL             DATAB2(MAXBF2)
+      INTEGER          LHCER
+*KEEP,CEREN4.
+      COMMON /CEREN4/  NRECER
+      INTEGER          NRECER
+*KEND.
+
+      INTEGER   NSUBBL
+      PARAMETER (NSUBBL=21)
+      REAL      A(*)
+C  NSUBBL IS NUMBER OF SUBBLOCKS IN ONE OUTPUT RECORD
+C  (OUTPUT RECORD LENGTH = NSUBBL * 39 * 7 * 4 BYTES  <= 22932 )
+C  IBLK2 IS COUNTER FOR SUBBLOCKS OF CERENKOV OUTPUT
+C  OUTPUT BUFFER FOR CERENKOV OUTPUT
+      REAL      OUTBF2(MAXBF2,NSUBBL)
+      SAVE      OUTBF2
+      INTEGER   I,IBLK2,IFL,K
+      DATA      IBLK2 / 0 /
+C-----------------------------------------------------------------------
+
+      IF ( IFL .LE. 1 ) THEN
+        IBLK2 = IBLK2 + 1
+        DO  3  I = 1,MAXBF2
+          OUTBF2(I,IBLK2) = A(I)
+    3   CONTINUE
+      ENDIF
+
+C  WRITE TO TAPE IF BLOCK IS FULL OR IF IFL IS 1
+      IF ( IFL .GE. 1  .OR.  IBLK2 .EQ. NSUBBL ) THEN
+        NRECER = NRECER + 1
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c        WRITE(CETAPE)            ((OUTBF2(I,K),I=1,MAXBF2),K=1,NSUBBL)
+        call jccersave(outbf2)
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+        IBLK2 = 0
+        DO  4  K = 1,NSUBBL
+        DO  4  I = 1,MAXBF2
+          OUTBF2(I,K) = 0.0
+   4    CONTINUE
+      ENDIF
+
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/cghei.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/cghei.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/cghei.f	(revision 286)
@@ -0,0 +1,853 @@
+      SUBROUTINE CGHEI
+ 
+C-----------------------------------------------------------------------
+C  C(ORSIKA) GHE(ISHA) I(NTERFACE)
+C
+C  MAIN STEERING ROUTINE FOR HADRON PACKAGE GHEISHA ***
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C
+C  ORIGIN  : F.CARMINATI, H.FESEFELDT (ROUTINE GHESIG)
+C  REDESIGN: P. GABRIEL IK1  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+*KEEP,CGCOMP.
+      PARAMETER (KK=3)
+      COMMON/CGCOMP/ ACOMP,ZCOMP,WCOMP
+      REAL           ACOMP(KK),ZCOMP(KK),WCOMP(KK)
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEEP,ELADPM.
+      COMMON /ELADPM/  ELMEAN,ELMEAA,IELDPM,IELDPA
+      DOUBLE PRECISION ELMEAN(37),ELMEAA(37)
+      INTEGER          IELDPM(37,13),IELDPA(37,13)
+*KEEP,ELASTY.
+      COMMON /ELASTY/  ELAST,IELIS,IELHM,IELNU,IELPI
+      DOUBLE PRECISION ELAST
+      INTEGER          IELIS(20),IELHM(20),IELNU(20),IELPI(20)
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,MULT.
+      COMMON /MULT/    EKINL,MSMM,MULTMA,MULTOT
+      DOUBLE PRECISION EKINL
+      INTEGER          MSMM,MULTMA(37,13),MULTOT(37,13)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION ELASTI,ELABOR,PLX,PLY,PLZ,PLSQ,PLTOT,RMASSK
+ 
+      COMMON/GSECTI/ AIEL(20),AIIN(20),AIFI(20),AICA(20),ALAM,K0FLAG
+      INTEGER K0FLAG
+      REAL AIEL,AIIN,AIFI,AICA,ALAM
+ 
+C --- GHEISHA COMMONS ---
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+ 
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+ 
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+ 
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+ 
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+ 
+ 
+C --- "NEVENT" CHANGED TO "KEVENT" IN COMMON /CURPAR/ DUE TO CLASH ---
+C --- WITH VARIABLE "NEVENT" IN GEANT COMMON ---
+ 
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON /CURPAR/ WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,KEVENT,SHFLAG,
+     $                ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     $                RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     $                ATNO2,ZNO2
+ 
+C --- "IPART" CHANGED TO "KPART" IN COMMON /RESULT/ DUE TO CLASH ---
+C --- WITH VARIABLE "IPART" IN GEANT COMMON ---
+ 
+      COMMON /RESULT/ XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     $                USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,KPART,IND,
+     $                LCALO,ICEL,SINL,COSL,SINP,COSP,
+     $                XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     $                XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                      REAL NCH,INTCT
+ 
+C --- "ABSL(21)" CHANGED TO "ABSLTH(21)" IN COMMON /MAT/ DUE TO CLASH ---
+C --- WITH VARIABLE "ABSL" IN GEANT COMMON ---
+ 
+      COMMON /MAT/ LMAT,
+     $             DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSLTH(21),
+     $             CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21),
+     $             MATID(21),MATID1(21,24),PARMAT(21,10),
+     $             IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10),
+     $             ATNO1(21,10),ZNO1(21,10)
+ 
+      DIMENSION IPELOS(35)
+      REAL EMAX,EEESQ
+      SAVE IDEOL
+ 
+      DIMENSION RNDM(1)
+ 
+C --- DIMENSION STMTS. FOR GEANT/GHEISHA PARTICLE CODE CONVERSIONS ---
+C --- KIPART(I)=GHEISHA CODE CORRESPONDING TO GEANT   CODE I ---
+C --- IKPART(I)=GEANT   CODE CORRESPONDING TO GHEISHA CODE I ---
+ 
+      DIMENSION KIPART(48),IKPART(35)
+ 
+C --- DATA STMTS. FOR GEANT/GHEISHA PARTICLE CODE CONVERSIONS ---
+C --- KIPART(I)=GHEISHA CODE CORRESPONDING TO GEANT   CODE I ---
+C --- IKPART(I)=GEANT   CODE CORRESPONDING TO GHEISHA CODE I ---
+ 
+      DATA KIPART/
+     $               1,   3,   4,   2,   5,   6,   8,   7,
+     $               9,  12,  10,  13,  16,  14,  15,  11,
+     $              35,  18,  20,  21,  22,  26,  27,  33,
+     $              17,  19,  23,  24,  25,  28,  29,  34,
+     $              35,  35,  35,  35,  35,  35,  35,  35,
+     $              35,  35,  35,  35,  30,  31,  32,  35/
+ 
+      DATA IKPART/
+     $               1,   4,   2,   3,   5,   6,   8,   7,
+     $               9,  11,  16,  10,  12,  14,  15,  13,
+     $              25,  18,  26,  19,  20,  21,  27,  28,
+     $              29,  22,  23,  30,  31,  45,  46,  47,
+     $              24,  32,  48/
+ 
+ 
+C --- DENOTE STABLE PARTICLES ACCORDING TO GHEISHA CODE ---
+C --- STABLE : GAMMA, NEUTRINO, ELECTRON, PROTON AND HEAVY FRAGMENTS ---
+C --- WHEN STOPPING THESE PARTICLES ONLY LOOSE THEIR KINETIC ENERGY ---
+      DATA IPELOS/
+     $             1,   1,   0,   1,   0,   0,   0,   0,
+     $             0,   0,   0,   0,   0,   1,   0,   0,
+     $             0,   0,   0,   0,   0,   0,   0,   0,
+     $             0,   0,   0,   0,   0,   1,   1,   1,
+     $             0,   0,   1/
+ 
+C --- LOWERBOUND OF KINETIC ENERGY BIN IN N CROSS-SECTION TABLES ---
+      DATA TEKLOW /0.0001/
+ 
+C --- KINETIC ENERGY TO SWITCH FROM "CASN" TO "GNSLWD" FOR N CASCADE ---
+      DATA SWTEKN /0.05/
+ 
+      DATA IDEOL/0/
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'CGHEI :'
+ 
+C --- DEFINE PARTICLE TYPE
+      IF     ( ITYPE .LE.  48 ) THEN
+         IPART = ITYPE
+      ELSEIF ( ITYPE .EQ. 201 ) THEN
+         IPART = 45
+      ELSEIF ( ITYPE .EQ. 301 ) THEN
+         IPART = 46
+      ELSEIF ( ITYPE .EQ. 402 ) THEN
+         IPART = 47
+      ELSE
+         WRITE (MONIOU,7795) ITYPE
+ 7795    FORMAT (//,' *CGHEI*  ILLEGAL PARTICLE TYPE OCCURS =',I5)
+         IPART = 48
+      ENDIF
+ 
+      NETEST=IKPART(KPART)
+      IF ( NETEST .EQ. IPART ) GO TO 9004
+ 
+      WRITE(MONIOU,8881) IPART,KPART
+ 8881 FORMAT(' *CGHEI* IPART,KPART = ',2(I3,1X)/
+     $ ' *CGHEI* ======> PARTICLE TYPES DO NOT MATCH <=======')
+      STOP
+ 
+ 9004 CONTINUE
+      KPART=KIPART(IPART)
+      KKPART=KPART
+ 
+C --- TRANSPORT THE TRACK NUMBER TO GHEISHA AND INITIALISE SOME NUMBERS
+C --- NTK=ITRA   ITRA = CURRENT TRACK NUMBER IN GEANT (GCKINE)
+      NTK=0
+      INTCT=0.0
+      NEXT=1
+      NTOT=0
+      INT=0
+      TOF=0.0
+ 
+C --- STORE COORDINATES FOR SECONDARIES AND RESET ITYPE
+      SECPAR(1) = 0.
+      DO 7001 LK = 5, 8
+         SECPAR(LK) = CURPAR(LK)
+ 7001 CONTINUE
+ 
+ 
+C --- FILL RESULT COMMON FOR THIS TRACK WITH CORSIKA VALUES ---
+ 
+      AMAS=RMASS(KPART)
+      NCH=RCHARG(KPART)
+  107 XEND = CURPAR(7)
+      YEND = CURPAR(8)
+      ZEND = CURPAR(5)
+      SINL = -CURPAR(3)
+      PHI  = CURPAR(4)
+      USERW=0.0
+ 
+      AMASQ=AMAS*AMAS
+      EN = CURPAR(2) * ABS(AMAS)
+      EK = ABS ( EN - ABS(AMAS) )
+      ENOLD=EN
+      EMAX = 0.
+      P  = SQRT ( EN*EN - AMASQ )
+      ELABOR = EN
+ 
+      SINP = SIN(PHI)
+      COSP = COS(PHI)
+      COSL = SQRT ( ABS(1.-SINL**2) )
+ 
+      PX = COSL * COSP
+      PY = COSL * SINP
+      PZ = SINL
+ 
+C --- SET GHEISHA INDEX FOR THE CURRENT MEDIUM ALWAYS TO 1 ---
+      IND=1
+ 
+C --- TRANSFER GLOBAL MATERIAL CONSTANTS FOR CURRENT MEDIUM ---
+C --- DETAILED DATA FOR COMPOUNDS IS OBTAINED VIA ROUTINE COMPO ---
+      ATNO(IND+1) = 14.56
+      ZNO(IND+1)  =  7.265
+      DEN(IND+1)  =  0.0
+      RADLTH(IND+1)= 0.0
+      ABSLTH(IND+1)= 0.0
+ 
+C --- SETUP PARMAT FOR PHYSICS STEERING ---
+      PARMAT(IND+1,10)=0.0
+ 
+  5   CONTINUE
+ 
+C --- INDICATE LIGHT (<= PI) AND HEAVY PARTICLES (HISTORICALLY) ---
+C --- CALIM CODE ---
+      J=2
+      TEST=RMASS(7)-0.001
+      IF (ABS(AMAS) .LT. TEST) J=1
+ 
+C *** DIVISION INTO VARIOUS INTERACTION CHANNELS DENOTED BY "INT" ***
+C THE CONVENTION FOR "INT" IS THE FOLLOWING
+ 
+C INT  = -1 REACTION CROSS SECTIONS NOT YET TABULATED/PROGRAMMED
+C      =  0 NO INTERACTION
+C      =  1 ELEASTIC SCATTERING
+C      =  2 INELASTIC SCATTERING
+C      =  3 NUCLEAR FISSION WITH INELEASTIC SCATTERING
+C      =  4 NEUTRON CAPTURE
+C INT  =  3, 4  SHOULD BE DELETED FOR AIR TARGET
+ 
+C --- INTACT CODE ---
+      ALAM1=0.0
+      CALL GRNDM(RNDM,1)
+      RAT=RNDM(1)*ALAM
+      ATNO2 = 14.56
+      ZNO2  = 7.265
+ 
+      DO 6 K=1,KK
+      ATNO2 = ACOMP(K)
+      ZNO2 =  ZCOMP(K)
+ 
+C --- TRY FOR ELASTIC SCATTERING ---
+      INT=1
+      ALAM1=ALAM1+AIEL(K)
+      IF (RAT .LT. ALAM1) GO TO 8
+ 
+C --- TRY FOR INELASTIC SCATTERING ---
+      INT=2
+      ALAM1=ALAM1+AIIN(K)
+      IF (RAT .LT. ALAM1) GO TO 8
+ 
+C --- TRY FOR NEUTRON CAPTURE ---
+      INT=4
+      ALAM1=ALAM1+AICA(K)
+      IF (RAT .LT. ALAM1) GO TO 8
+ 
+ 6    CONTINUE
+ 
+C --- NO REACTION SELECTED ==> ELASTIC SCATTERING ---
+      INT=1
+ 
+C *** TAKE ACTION ACCORDING TO SELECTED REACTION CHANNEL ***
+C --- FOLLOWING CODE IS A TRANSLATION OF "CALIM" INTO GEANT JARGON ---
+ 
+ 8    CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,1001) INT
+ 1001 FORMAT(' *CGHEI* INTERACTION TYPE CHOSEN INT = ',I3)
+ 
+      IF (INT .NE. 4) GO TO 10
+ 
+C --- NEUTRON CAPTURE ---
+      IF (NPRT(9)) WRITE(MDEBUG,2000)
+ 2000 FORMAT(' *CGHEI* ROUTINE CAPTUR WILL BE CALLED')
+      CALL CAPTUR(NOPT)
+      GO TO 40
+ 
+ 10   CONTINUE
+ 
+C --- ELASTIC AND INELASTIC SCATTERING ---
+      PV(1,MXGKPV)=P*PX
+      PV(2,MXGKPV)=P*PY
+      PV(3,MXGKPV)=P*PZ
+      PV(4,MXGKPV)=EN
+      PV(5,MXGKPV)=AMAS
+      PV(6,MXGKPV)=NCH
+      PV(7,MXGKPV)=TOF
+      PV(8,MXGKPV)=KPART
+      PV(9,MXGKPV)=0.
+      PV(10,MXGKPV)=USERW
+ 
+C --- ADDITIONAL PARAMETERS TO SIMULATE FERMI MOTION AND EVAPORATION ---
+      DO 111 JENP=1,10
+         ENP(JENP)=0.
+ 111  CONTINUE
+      ENP(5)=EK
+      ENP(6)=EN
+      ENP(7)=P
+ 
+      IF (INT .NE. 1) GO TO 12
+ 
+C *** ELASTIC SCATTERING PROCESSES ***
+ 
+C --- ONLY NUCLEAR INTERACTIONS FOR HEAVY FRAGMENTS ---
+      IF ((KPART .GE. 30) .AND. (KPART .LE. 32)) GO TO 35
+ 
+C --- NORMAL ELASTIC SCATTERING FOR LIGHT MEDIA ---
+      IF (ATNO2 .LT. 1.5) GO TO 35
+ 
+C --- COHERENT ELASTIC SCATTERING FOR HEAVY MEDIA ---
+      IF (NPRT(9)) WRITE(MDEBUG,2002)
+ 2002 FORMAT(' *CGHEI* ROUTINE COSCAT WILL BE CALLED')
+      CALL COSCAT
+      GO TO 40
+ 
+C *** NON-ELASTIC SCATTERING PROCESSES ***
+ 12   CONTINUE
+ 
+C --- ONLY NUCLEAR INTERACTIONS FOR HEAVY FRAGMENTS ---
+      IF ((KPART .GE. 30) .AND. (KPART .LE. 32)) GO TO 35
+ 
+C *** USE SOMETIMES NUCLEAR REACTION ROUTINE "NUCREC" FOR LOW ENERGY ***
+C *** PROTON AND NEUTRON SCATTERING ***
+      CALL GRNDM(RNDM,1)
+      TEST1=RNDM(1)
+      TEST2=4.5*(EK-0.01)
+      IF ((KPART .EQ. 14) .AND. (TEST1 .GT. TEST2)) GO TO 85
+      IF ((KPART .EQ. 16) .AND. (TEST1 .GT. TEST2)) GO TO 86
+ 
+C *** FERMI MOTION AND EVAPORATION ***
+      TKIN=CINEMA(EK)
+      PV(9,MXGKPV) = TKIN
+      ENP(5)=EK+TKIN
+C --- CHECK FOR LOWERBOUND OF EKIN IN CROSS-SECTION TABLES ---
+      IF (ENP(5) .LE. TEKLOW) ENP(5)=TEKLOW
+      ENP(6)=ENP(5)+ABS(AMAS)
+      ENP(7)=(ENP(6)-AMAS)*(ENP(6)+AMAS)
+      ENP(7)=SQRT(ABS(ENP(7)))
+      TKIN=FERMI(ENP(5))
+      ENP(5)=ENP(5)+TKIN
+C --- CHECK FOR LOWERBOUND OF EKIN IN CROSS-SECTION TABLES ---
+      IF (ENP(5) .LE. TEKLOW) ENP(5)=TEKLOW
+      ENP(6)=ENP(5)+ABS(AMAS)
+      ENP(7)=(ENP(6)-AMAS)*(ENP(6)+AMAS)
+      ENP(7)=SQRT(ABS(ENP(7)))
+      TKIN=EXNU(ENP(5))
+      ENP(5)=ENP(5)-TKIN
+C --- CHECK FOR LOWERBOUND OF EKIN IN CROSS-SECTION TABLES ---
+      IF (ENP(5) .LE. TEKLOW) ENP(5)=TEKLOW
+      ENP(6)=ENP(5)+ABS(AMAS)
+      ENP(7)=(ENP(6)-AMAS)*(ENP(6)+AMAS)
+      ENP(7)=SQRT(ABS(ENP(7)))
+ 
+C *** IN CASE OF ENERGY ABOVE CUT-OFF LET THE PARTICLE CASCADE ***
+      IF ( ENP(5) .GT. ELCUT(1)) GO TO 35
+ 
+C --- SECOND CHANCE FOR ANTI-BARYONS DUE TO POSSIBLE ANNIHILATION ---
+      IF ((AMAS .GE. 0.0) .OR. (KPART .LE. 14)) GO TO 13
+      ANNI=1.3*P
+      IF (ANNI .GT. 0.4) ANNI=0.4
+      CALL GRNDM(RNDM,1)
+      TEST=RNDM(1)
+      IF (TEST .GT. ANNI) GO TO 35
+ 
+C *** PARTICLE WITH ENERGY BELOW CUT-OFF ***
+C --- ==> ONLY NUCLEAR EVAPORATION AND QUASI-ELASTIC SCATTERING ---
+ 13   CONTINUE
+ 
+      IF (NPRT(9)) WRITE(MDEBUG,1002) KPART,EK,EN,P,ENP(5),ENP(6),ENP(7)
+ 1002 FORMAT(' *CGHEI* ENERGY BELOW CUT-OFF FOR GHEISHA PARTICLE ',I3/
+     $ ' EK,EN,P,ENP(5),ENP(6),ENP(7) = ',6(G12.5,1X))
+ 
+      IF ((KPART .NE. 14) .AND. (KPART .NE. 16)) GO TO 14
+      IF (KPART .EQ. 16) GO TO 86
+ 
+C --- SLOW PROTON ---
+ 85   CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2003) EK,KPART
+ 2003 FORMAT(' *CGHEI* ROUTINE NUCREC WILL BE CALLED',
+     $ ' EK = ',G12.5,' GEV  KPART = ',I3)
+      CALL NUCREC(NOPT,2)
+ 
+      IF (NOPT .NE. 0) GO TO 50
+ 
+      IF (NPRT(9)) WRITE(MDEBUG,2004)EK,KPART
+ 2004 FORMAT(' *CGHEI* ROUTINE COSCAT WILL BE CALLED',
+     $ ' EK = ',G12.5,' GEV  KPART = ',I3)
+      CALL COSCAT
+      GO TO 40
+ 
+C --- SLOW NEUTRON ---
+ 86   CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2015)
+      NUCFLG=0
+      CALL GNSLWD(NUCFLG,INT,NFL,TEKLOW)
+      IF (NUCFLG .NE. 0) GO TO 50
+      GO TO 40
+ 
+C --- OTHER SLOW PARTICLES ---
+ 14   CONTINUE
+      IPA(1)=KPART
+C --- DECIDE FOR PROTON OR NEUTRON TARGET ---
+      IPA(2)=16
+      CALL GRNDM(RNDM,1)
+      TEST1=RNDM(1)
+      TEST2=ZNO2/ATNO2
+      IF (TEST1 .LT. TEST2) IPA(2)=14
+      AVERN=0.0
+      NFL=1
+      IF (IPA(2) .EQ. 16) NFL=2
+      IPPP=KPART
+      IF (NPRT(9)) WRITE(MDEBUG,2005)
+ 2005 FORMAT(' *CGHEI* ROUTINE TWOB WILL BE CALLED')
+      CALL TWOB(IPPP,NFL,AVERN)
+      GOTO 40
+ 
+C --- INITIALISATION OF CASCADE QUANTITIES ---
+ 35   CONTINUE
+ 
+C *** CASCADE GENERATION ***
+C --- CALCULATE FINAL STATE MULTIPLICITY AND LONGITUDINAL AND ---
+C --- TRANSVERSE MOMENTUM DISTRIBUTIONS ---
+ 
+C --- FIXED PARTICLE TYPE TO STEER THE CASCADE ---
+      KKPART=KPART
+ 
+C --- NO CASCADE FOR LEPTONS ---
+      IF (KKPART .LE. 6) GO TO 9999
+ 
+C *** WHAT TO DO WITH "NEW PARTICLES" FOR GHEISHA ?????? ***
+C --- RETURN FOR THE TIME BEING ---
+      IF (KKPART .GE. 35) GO TO 9999
+ 
+C --- CASCADE OF HEAVY FRAGMENTS
+      IF ((KKPART .GE. 30) .AND. (KKPART .LE. 32)) GO TO 390
+ 
+C --- INITIALIZE THE IPA ARRAY ---
+      CALL VZERO(IPA(1),MXGKCU)
+ 
+C --- CASCADE OF OMEGA - AND OMEGA - BAR ---
+      IF (KKPART .EQ. 33) GO TO 330
+      IF (KKPART .EQ. 34) GO TO 331
+ 
+      NVEPAR=KKPART-17
+      IF (NVEPAR .LE. 0) GO TO 15
+      GO TO (318,319,320,321,322,323,324,325,326,327,328,329),NVEPAR
+ 
+ 15   CONTINUE
+      NVEPAR=KKPART-6
+      GO TO (307,308,309,310,311,312,313,314,315,316,317,318),NVEPAR
+ 
+C --- PI+ CASCADE ---
+ 307  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2006)
+ 2006 FORMAT(' *CGHEI* ROUTINE CASPIP WILL BE CALLED')
+      CALL CASPIP(J,INT,NFL)
+      GO TO 40
+ 
+C --- PI0 ==> NO CASCADE ---
+ 308  CONTINUE
+      GO TO 40
+ 
+C --- PI- CASCADE ---
+ 309  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2007)
+ 2007 FORMAT(' *CGHEI* ROUTINE CASPIM WILL BE CALLED')
+      CALL CASPIM(J,INT,NFL)
+      GO TO 40
+ 
+C --- K+ CASCADE ---
+ 310  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2008)
+ 2008 FORMAT(' *CGHEI* ROUTINE CASKP WILL BE CALLED')
+      CALL CASKP(J,INT,NFL)
+      GO TO 40
+ 
+C --- K0 CASCADE ---
+ 311  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2009)
+ 2009 FORMAT(' *CGHEI* ROUTINE CASK0 WILL BE CALLED')
+      CALL CASK0(J,INT,NFL)
+      GO TO 40
+ 
+C --- K0 BAR CASCADE ---
+ 312  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2010)
+ 2010 FORMAT(' *CGHEI* ROUTINE CASK0B WILL BE CALLED')
+      CALL CASK0B(J,INT,NFL)
+      GO TO 40
+ 
+C --- K- CASCADE ---
+ 313  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2011)
+ 2011 FORMAT(' *CGHEI* ROUTINE CASKM WILL BE CALLED')
+      CALL CASKM(J,INT,NFL)
+      GO TO 40
+ 
+C --- PROTON CASCADE ---
+ 314  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2012)
+ 2012 FORMAT(' *CGHEI* ROUTINE CASP WILL BE CALLED')
+      CALL CASP(J,INT,NFL)
+      GO TO 40
+ 
+C --- PROTON BAR CASCADE ---
+ 315  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2013)
+ 2013 FORMAT(' *CGHEI* ROUTINE CASPB WILL BE CALLED')
+      CALL CASPB(J,INT,NFL)
+      GO TO 40
+ 
+C --- NEUTRON CASCADE ---
+ 316  CONTINUE
+      NUCFLG=0
+      IF (EK .GT. SWTEKN) THEN
+         CALL CASN(J,INT,NFL)
+         IF (NPRT(9)) WRITE(MDEBUG,2014)
+ 2014 FORMAT(' *CGHEI* ROUTINE CASN WILL BE CALLED')
+      ELSE
+         CALL GNSLWD(NUCFLG,INT,NFL,TEKLOW)
+         IF (NPRT(9)) WRITE(MDEBUG,2015)
+ 2015 FORMAT(' *CGHEI* ROUTINE GNSLWD WILL BE CALLED')
+      ENDIF
+      IF (NUCFLG .NE. 0) GO TO 50
+      GO TO 40
+ 
+C --- NEUTRON BAR CASCADE ---
+ 317  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2016)
+ 2016 FORMAT(' *CGHEI* ROUTINE CASNB WILL BE CALLED')
+      CALL CASNB(J,INT,NFL)
+      GO TO 40
+ 
+C --- LAMBDA CASCADE ---
+ 318  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2017)
+ 2017 FORMAT(' *CGHEI* ROUTINE CASL0 WILL BE CALLED')
+      CALL CASL0(J,INT,NFL)
+      GO TO 40
+ 
+C --- LAMBDA BAR CASCADE ---
+ 319  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2018)
+ 2018 FORMAT(' *CGHEI* ROUTINE CASAL0 WILL BE CALLED')
+      CALL CASAL0(J,INT,NFL)
+      GO TO 40
+ 
+C --- SIGMA + CASCADE ---
+ 320  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2019)
+ 2019 FORMAT(' *CGHEI* ROUTINE CASSP WILL BE CALLED')
+      CALL CASSP(J,INT,NFL)
+      GO TO 40
+ 
+C --- SIGMA 0 ==> NO CASCADE ---
+ 321  CONTINUE
+      GO TO 40
+ 
+C --- SIGMA - CASCADE ---
+ 322  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2020)
+ 2020 FORMAT(' *CGHEI* ROUTINE CASSM WILL BE CALLED')
+      CALL CASSM(J,INT,NFL)
+      GO TO 40
+ 
+C --- SIGMA + BAR CASCADE ---
+ 323  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2021)
+ 2021 FORMAT(' *CGHEI* ROUTINE CASASP WILL BE CALLED')
+      CALL CASASP(J,INT,NFL)
+      GO TO 40
+ 
+C --- SIGMA 0 BAR ==> NO CASCADE ---
+ 324  CONTINUE
+      GO TO 40
+ 
+C --- SIGMA - BAR CASCADE ---
+ 325  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2022)
+ 2022 FORMAT(' *CGHEI* ROUTINE CASASM WILL BE CALLED')
+      CALL CASASM(J,INT,NFL)
+      GO TO 40
+ 
+C --- XI 0 CASCADE ---
+ 326  CONTINUE
+      IF (NPRT(9)) PRINT 2023
+ 2023 FORMAT(' *CGHEI* ROUTINE CASX0 WILL BE CALLED')
+      CALL CASX0(J,INT,NFL)
+      GO TO 40
+ 
+C --- XI - CASCADE ---
+ 327  CONTINUE
+      IF (NPRT(9)) PRINT 2024
+ 2024 FORMAT(' *CGHEI* ROUTINE CASXM WILL BE CALLED')
+      CALL CASXM(J,INT,NFL)
+      GO TO 40
+ 
+C --- XI 0 BAR CASCADE ---
+ 328  CONTINUE
+      IF (NPRT(9)) PRINT 2025
+ 2025 FORMAT(' *CGHEI* ROUTINE CASAX0 WILL BE CALLED')
+      CALL CASAX0(J,INT,NFL)
+      GO TO 40
+ 
+C --- XI - BAR CASCADE ---
+ 329  CONTINUE
+      IF (NPRT(9)) PRINT 2026
+ 2026 FORMAT(' *CGHEI* ROUTINE CASAXM WILL BE CALLED')
+      CALL CASAXM(J,INT,NFL)
+      GO TO 40
+ 
+C --- OMEGA - CASCADE ---
+ 330  CONTINUE
+      IF (NPRT(9)) PRINT 2027
+ 2027 FORMAT(' *CGHEI* ROUTINE CASOM WILL BE CALLED')
+      CALL CASOM(J,INT,NFL)
+      GO TO 40
+ 
+C --- OMEGA - BAR CASCADE ---
+ 331  CONTINUE
+      IF (NPRT(9)) PRINT 2028
+ 2028 FORMAT(' *CGHEI* ROUTINE CASAOM WILL BE CALLED')
+      CALL CASAOM(J,INT,NFL)
+      GO TO 40
+ 
+C --- HEAVY FRAGMENT CASCADE ---
+ 390  CONTINUE
+      IF (NPRT(9)) WRITE(MDEBUG,2090)
+ 2090 FORMAT(' *CGHEI* ROUTINE CASFRG WILL BE CALLED')
+      NUCFLG=0
+      CALL CASFRG(NUCFLG,INT,NFL)
+      IF (NUCFLG .NE. 0) GO TO 50
+ 
+C *** CHECK WHETHER THERE ARE NEW PARTICLES GENERATED ***
+ 40   CONTINUE
+      IF ((NTOT .NE. 0) .OR. (KKPART .NE. KPART)) GO TO 50
+ 
+ 50   CONTINUE
+ 
+      NVEDUM=KIPART(IPART)
+      IF (NPRT(9)) WRITE(MDEBUG,1004)NTOT,IPART,KPART,KKPART,NVEDUM
+ 1004 FORMAT(' *CGHEI* SEC. GEN. NTOT,IPART,KPART,KKPART,KIPART = ',
+     $ 5(I3,1X))
+ 
+C --- INITIAL PARTICLE TYPE HAS BEEN CHANGED ==> PUT NEW TYPE ON ---
+C --- THE TEMPORARY STACK ---
+ 
+C --- MAKE CHOICE BETWEEN K0 LONG / K0 SHORT ---
+      IF ((KPART .NE. 11) .AND. (KPART .NE. 12)) GO TO 52
+      CALL GRNDM(RNDM,1)
+      KPART=11.5+RNDM(1)
+ 
+ 52   CONTINUE
+ 
+C --- IN CASE THE NEW PARTICLE IS A NEUTRINO ==> FORGET IT ---
+      IF (KPART .EQ. 2) GO TO 60
+ 
+C --- PUT CURRENT GHEISHA PARTICLE ON THE CORSIKA STACK
+C --- ( IF SURVIVING ANGLE CUT ! )
+      NGKINE = 1
+      SECPAR(3) = -PZ
+ 
+C --- CALCULATE ELASTICITY
+      IF ( EN .GT. EMAX ) THEN
+        EMAX = EN
+      ENDIF
+ 
+      IF ( SECPAR(3) .GT. C(29) ) THEN
+ 
+         ITY=IKPART(KPART)
+         IF     ( ITY .LT. 45 ) THEN
+            SECPAR(1) = DBLE(ITY)
+         ELSEIF ( ITY .EQ. 45 ) THEN
+            SECPAR(1) = 201.D0
+         ELSEIF ( ITY .EQ. 46 ) THEN
+            SECPAR(1) = 301.D0
+         ELSEIF ( ITY .EQ. 47 ) THEN
+            SECPAR(1) = 402.D0
+         ENDIF
+         IF ( ABS(AMAS) .LT. 1.E-9 ) THEN
+            SECPAR(2) = EN
+         ELSE
+            SECPAR(2) = DBLE(EN) / DBLE(ABS(AMAS))
+         ENDIF
+         IF ( PX .NE. 0. .OR. PY .NE. 0. )  THEN
+            SECPAR(4) = ATAN2 ( DBLE(PY) , DBLE(PX) )
+         ELSE
+            SECPAR(4) = 0.D0
+         ENDIF
+ 
+        CALL TSTACK
+ 
+      ENDIF
+ 
+C *** CHECK WHETHER SECONDARIES HAVE BEEN GENERATED AND COPY THEM ***
+C *** ALSO ON THE GEANT STACK ***
+ 60   CONTINUE
+ 
+C --- ALL QUANTITIES ARE TAKEN FROM THE GHEISHA STACK WHERE THE ---
+C --- CONVENTION IS THE FOLLOWING ---
+C
+C EVE(INDEX+ 1)= X
+C EVE(INDEX+ 2)= Y
+C EVE(INDEX+ 3)= Z
+C EVE(INDEX+ 4)= NCAL
+C EVE(INDEX+ 5)= NCELL
+C EVE(INDEX+ 6)= MASS
+C EVE(INDEX+ 7)= CHARGE
+C EVE(INDEX+ 8)= TOF
+C EVE(INDEX+ 9)= PX
+C EVE(INDEX+10)= PY
+C EVE(INDEX+11)= PZ
+C EVE(INDEX+12)= TYPE
+ 
+      IF (NTOT .LE. 0) GO TO 9999
+ 
+C --- ONE OR MORE SECONDARIES HAVE BEEN GENERATED ---
+      DO 61 L=1,NTOT
+      INDEX=(L-1)*12
+      JND=EVE(INDEX+12)
+ 
+C --- MAKE CHOICE BETWEEN K0 LONG / K0 SHORT ---
+      IF ((JND .NE. 11) .AND. (JND .NE. 12)) GO TO 63
+      CALL GRNDM(RNDM,1)
+      JND=11.5+RNDM(1)
+ 
+C --- FORGET ABOUT NEUTRINOS ---
+ 63   CONTINUE
+      IF (JND .EQ. 2) GO TO 61
+ 
+C --- SWITCH TO CORSIKA QUANTITIES ---
+      ITY=IKPART(JND)
+      IF (NPRT(9)) WRITE(MDEBUG,1006) ITY,NGKINE,L,(EVE(INDEX+J),J=1,12)
+ 1006 FORMAT(' *CGHEI* GEANT PART. ',I3,' ALSO PUT ONTO STACK AT',
+     $ ' POS. ',I3/
+     $ ' EVE(',I2,') = ',(' ',10G12.5))
+ 
+      PLX = EVE(INDEX+9)
+      PLY = EVE(INDEX+10)
+      PLZ = EVE(INDEX+11)
+      PLSQ = PLX**2 + PLY**2 + PLZ**2
+      PLTOT = SQRT (PLSQ)
+      RMASSK = ABS(RMASS(JND))
+ 
+C  FIND HIGHEST ENERGY PARTICLE FOR ELASTICITY
+      EEESQ = PLSQ + RMASSK**2
+      IF ( EEESQ .GT. EMAX**2 ) THEN
+        EMAX = SQRT(EEESQ)
+      ENDIF
+ 
+C --- APPLY ANGLE CUT AND
+C --- ADD PARTICLE TO THE CORSIKA STACK (RESTRICTED TO 100) ---
+      IF ( PLTOT .LE. 1.D-10 ) GOTO 61
+      SECPAR(3) = -PLZ / PLTOT
+      IF ( SECPAR(3) .LE. C(29) )  GOTO 61
+ 
+      IF (NGKINE .GE. MXGKGH) GO TO 9999
+      NGKINE=NGKINE+1
+      IF     ( ITY .LT. 45 ) THEN
+         SECPAR(1) = DBLE(ITY)
+      ELSEIF ( ITY .EQ. 45 ) THEN
+         SECPAR(1) = 201.D0
+      ELSEIF ( ITY .EQ. 46 ) THEN
+         SECPAR(1) = 301.D0
+      ELSEIF ( ITY .EQ. 47 ) THEN
+         SECPAR(1) = 402.D0
+      ELSE
+         SECPAR(1) = 0.D0
+         WRITE(MONIOU,*) '*CGHEI*  ILLEGAL PARTICLE TYPE'
+      ENDIF
+      IF ( RMASSK .LT. 1.D-9 ) THEN
+         SECPAR(2) = PLTOT
+      ELSE
+         SECPAR(2) = SQRT (PLSQ+RMASSK**2) / RMASSK
+      ENDIF
+      IF ( PLX .NE. 0.D0 .OR. PLY .NE. 0.D0 )  THEN
+         SECPAR(4) = ATAN2 ( PLY,PLX )
+      ELSE
+         SECPAR(4) = 0.D0
+      ENDIF
+ 
+      CALL TSTACK
+ 
+ 61   CONTINUE
+ 
+C --- COUNTER FOR ENERGY-MULTIPLICITY MATRIX
+      MSMM = MSMM + NTOT
+ 
+C --- FILL ELASTICITY IN MATRICES
+      ELASTI = EMAX/ENOLD
+      MELL = MIN ( 1.D0+10.D0*      MAX( 0.D0, ELASTI ) , 11.D0 )
+      MEN  = MIN ( 4.D0+ 3.D0*LOG10(MAX( .1D0, EKINL )), 37.D0 )
+      IELDPM(MEN,MELL) = IELDPM(MEN,MELL) + 1
+      IELDPA(MEN,MELL) = IELDPA(MEN,MELL) + 1
+      IF ( ELASTI .LT. 1. ) THEN
+        ELMEAN(MEN) = ELMEAN(MEN) + ELASTI
+        ELMEAA(MEN) = ELMEAA(MEN) + ELASTI
+      ENDIF
+ 
+ 9999 CONTINUE
+C --- LIMIT THE VALUE OF NGKINE IN CASE OF OVERFLOW ---
+      NGKINE=MIN(NGKINE,MXGKGH)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/cghini.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/cghini.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/cghini.f	(revision 286)
@@ -0,0 +1,290 @@
+      SUBROUTINE CGHINI
+ 
+C-----------------------------------------------------------------------
+C  C(ORSIKA) GH(EISHA) INI(TIALISATION)
+C  INITIALIZATION OF RELEVANT GHEISHA VARIABLES
+C  THIS SUBROUTINE IS CALLED FROM START
+C
+C  ORIGIN  : GHEISHA ROUTINE "GHEINI", F.CARMINATI
+C  REDESIGN: P. GABRIEL IK1  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+*KEEP,AIR.
+      COMMON /AIR/     COMPOS,PROBTA,AVERAW,AVOGAD
+      DOUBLE PRECISION COMPOS(3),PROBTA(3),AVERAW,AVOGAD
+*KEEP,CGCOMP.
+      PARAMETER (KK=3)
+      COMMON/CGCOMP/ ACOMP,ZCOMP,WCOMP
+      REAL           ACOMP(KK),ZCOMP(KK),WCOMP(KK)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      COMMON/GSECTI/ AIEL(20),AIIN(20),AIFI(20),AICA(20),ALAM,K0FLAG
+      INTEGER K0FLAG
+      REAL AIEL,AIIN,AIFI,AICA,ALAM
+ 
+C --- GHEISHA COMMONS ---
+C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
+      COMMON /KGINIT/ KGINIT(50)
+ 
+      COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
+     $               SMU,CT,CTKCH,CTK0,
+     $               ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
+     $               RMASS(35),RCHARG(35)
+ 
+                     REAL MP,MPI,MMU,MEL,MKCH,MK0,
+     *                    ML0,MSP,MS0,MSM,MX0,MXM
+ 
+      PARAMETER (MXGKGH=100)
+      PARAMETER (MXEVEN=12*MXGKGH)
+      COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
+ 
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+ 
+      PARAMETER (MXGKPV=MXGKGH)
+      COMMON /VECUTY/ PV(10,MXGKPV)
+ 
+C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
+C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
+      COMMON /LIMITS/ EXPXL,EXPXU
+ 
+ 
+C --- "NEVENT" CHANGED TO "KEVENT" IN COMMON /CURPAR/ DUE TO CLASH ---
+C --- WITH VARIABLE "NEVENT" IN GEANT COMMON ---
+ 
+      PARAMETER (MXGKCU=MXGKGH)
+      COMMON /CURPAR/ WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,KEVENT,SHFLAG,
+     $                ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
+     $                RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
+     $                ATNO2,ZNO2
+ 
+      DATA CLIGHT /2.99792458E10/
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'CGHINI:'
+ 
+C --- INITIALZE COMPOSITION OF AIR
+      WCOMP(1) = COMPOS(1)
+      WCOMP(2) = COMPOS(2)
+      WCOMP(3) = COMPOS(3)
+      ACOMP(1) = 14.
+      ACOMP(2) = 16.
+      ACOMP(3) = 40.
+      ZCOMP(1) =  7.
+      ZCOMP(2) =  8.
+      ZCOMP(3) = 18.
+ 
+C --- SET GHEISHA I/O UNITS TO THE SAME AS FOR CORSIKA --
+      INBCD=MONIIN
+      NEWBCD=MONIOU
+      IF ( DEBUG ) NEWBCD=MDEBUG
+ 
+C --- INITIALISE ALL GHEISHA PRINT FLAGS AS FALSE ---
+C --- ACTIVATION IS DONE BY "DEBUG" STEERING CARD ---
+      DO 11 J=1,10
+         NPRT(J)=.FALSE.
+ 11   CONTINUE
+      IF ( DEBUG ) THEN
+         NPRT(4)=.TRUE.
+         NPRT(9)=.TRUE.
+      ENDIF
+      LPRT=.FALSE.
+      DO 12 I=1,MXGKPV
+         DO 12 J=1,10
+            PV(J,I)=0.
+ 12   CONTINUE
+ 
+C --- INITIALISE KGINIT ARRAY ---
+      DO 20 J=1,50
+         KGINIT(J)=0
+ 20   CONTINUE
+ 
+C --- INITIALIZE SOME CUT-OFF PARAMETERS WITH GEANT VALUES ---
+      TOFCUT=1.0E+20
+      NSIZE=MXEVEN
+      K0FLAG=0
+      CENG(3)=0.
+      CENG(4)=0.
+ 
+C --- INITIALIZE PI, 2*PI, PI/2 AND PARTICLE PARAMETERS ---
+      PI=ACOS(-1.0)
+      TWPI=2.0*PI
+      PIBTW=PI/2.0
+C *** GAMMA ***
+      RMASS(1)=PAMA(1)
+      RCHARG(1)=0.0
+C *** NEUTRINO ***
+      RMASS(2)=PAMA(4)
+      RCHARG(2)=0.0
+C *** E+ ***
+      RMASS(3)=PAMA(2)
+      RCHARG(3)=1.0
+C *** E- ***
+      RMASS(4)=PAMA(3)
+      RCHARG(4)=-1.0
+C *** MU+ ***
+      RMASS(5)=PAMA(5)
+      RCHARG(5)=1.0
+C *** MU- ***
+      RMASS(6)=PAMA(6)
+      RCHARG(6)=-1.0
+C *** PI+ ***
+      RMASS(7)=PAMA(8)
+      RCHARG(7)=1.0
+      CT=780.4
+C *** PI0 ***
+      RMASS(8)=PAMA(7)
+      RCHARG(8)=0.0
+C *** PI- ***
+      RMASS(9)=PAMA(9)
+      RCHARG(9)=-1.0
+C *** K+ ***
+      RMASS(10)=PAMA(11)
+      RCHARG(10)=1.0
+      CTKCH=370.9
+C *** K0 SHORT (==> K0) ***
+      RMASS(11)=PAMA(16)
+      RCHARG(11)=0.0
+      CTK0=2.675
+C *** K0 LONG (==> K0 BAR) ***
+      RMASS(12)=-PAMA(10)
+      RCHARG(12)=0.0
+C *** K- ***
+      RMASS(13)=PAMA(12)
+      RCHARG(13)=-1.0
+C *** P ***
+      RMASS(14)=PAMA(14)
+      RCHARG(14)=1.0
+C *** P BAR ***
+      RMASS(15)=-PAMA(15)
+      RCHARG(15)=-1.0
+C *** N ***
+      RMASS(16)=PAMA(13)
+      RCHARG(16)=0.0
+C *** N BAR ***
+      RMASS(17)=-PAMA(25)
+      RCHARG(17)=0.0
+C *** L0 ***
+      RMASS(18)=PAMA(18)
+      RCHARG(18)=0.0
+      CTL0=7.89
+C *** L0 BAR ***
+      RMASS(19)=-PAMA(26)
+      RCHARG(19)=0.0
+C *** S+ ***
+      RMASS(20)=PAMA(19)
+      RCHARG(20)=1.0
+      CTSP=2.40
+C *** S0 ***
+      RMASS(21)=PAMA(20)
+      RCHARG(21)=0.0
+C *** S- ***
+      RMASS(22)=PAMA(21)
+      RCHARG(22)=-1.0
+      CTSM=4.44
+C *** S+ BAR ***
+      RMASS(23)=-PAMA(27)
+      RCHARG(23)=-1.0
+C *** S0 BAR ***
+      RMASS(24)=-PAMA(28)
+      RCHARG(24)=0.0
+C *** S- BAR ***
+      RMASS(25)=-PAMA(29)
+      RCHARG(25)=1.0
+C *** XI0 ***
+      RMASS(26)=PAMA(22)
+      RCHARG(26)=0.0
+      CTX0=8.69
+C *** XI- ***
+      RMASS(27)=PAMA(23)
+      RCHARG(27)=-1.0
+      CTXM=4.92
+C *** XI0 BAR ***
+      RMASS(28)=-PAMA(30)
+      RCHARG(28)=0.0
+      CTX0=8.69
+C *** XI- BAR ***
+      RMASS(29)=-PAMA(31)
+      RCHARG(29)=1.0
+C *** DEUTERON ***
+      RMASS(30)=PAMA(45)
+      RCHARG(30)=1.0
+C *** TRITON ***
+      RMASS(31)=PAMA(46)
+      RCHARG(31)=1.0
+C *** ALPHA ***
+      RMASS(32)=PAMA(47)
+      RCHARG(32)=2.0
+C *** OMEGA- ***
+      RMASS(33)=PAMA(24)
+      RCHARG(33)=-1.0
+C *** OMEGA- BAR ***
+      RMASS(34)=-PAMA(32)
+      RCHARG(34)=1.0
+C *** NEW PARTICLE (GEANTINO) ***
+      RMASS(35)=0.0
+      RCHARG(35)=0.0
+ 
+      IF (NPRT(9))
+     $ WRITE(MDEBUG,1000) (I,RMASS(I),RCHARG(I),I=1,33),
+     $            CT,CTKCH,CTK0,CTL0,CTSP,CTSM,CTX0,CTXM
+ 1000 FORMAT(' *CGHINI* === GHEISHA PARTICLE PROPERTIES ==='/
+     $ '0INDEX',5X,'MASS (GEV)',5X,'CHARGE'/1H /
+     $ 33(1H ,1X,I3,5X,F11.6,6X,F5.2/),
+     $ '0PI +-  CT = ',G12.5,' K  +-  CT = ',G12.5/
+     $ ' K0     CT = ',G12.5,' L0     CT = ',G12.5/
+     $ ' S+     CT = ',G12.5,' S-     CT = ',G12.5/
+     $ ' X0     CT = ',G12.5,' X-     CT = ',G12.5)
+ 
+      MP=RMASS(14)
+      MPI=RMASS(7)
+      MMU=RMASS(5)
+      MEL=RMASS(3)
+      MKCH=RMASS(10)
+      MK0=RMASS(11)
+      SMP=MP**2
+      SMPI=MPI**2
+      SMU=MMU**2
+      ML0=RMASS(18)
+      MSP=RMASS(20)
+      MS0=RMASS(21)
+      MSM=RMASS(22)
+      MX0=RMASS(26)
+      MXM=RMASS(27)
+ 
+C --- LOAD LIMITS FOR INTRINSIC FUNCTION ARGUMENTS ---
+      EXPXL = - 82.0
+      EXPXU =   82.0
+ 
+      IF (NPRT(9)) WRITE(MDEBUG,1001) EXPXL,EXPXU
+ 1001 FORMAT(' *GHEINI* === INTRINSIC FUNCTION BOUNDARIES ==='/
+     $ ' EXPXL,EXPXU = ',2(G12.5,1X))
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/cghsig.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/cghsig.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/cghsig.f	(revision 286)
@@ -0,0 +1,1191 @@
+      DOUBLE PRECISION FUNCTION CGHSIG( PPART,EKIN,LPART )
+ 
+C-----------------------------------------------------------------------
+C  C(ORSIKA) GH(EISHA) SIG(MA)
+C
+C  CALCULATION OF THE PROBABILITIES FOR (IN)ELASTIC INTERACTIONS ***
+C  THIS FUNCTION IS CALLED FROM BOX2
+C
+C  ORIGIN  : F.CARMINATI, H.FESEFELDT (ROUTINE GHESIG)
+C  REDESIGN: P. GABRIEL IK1  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+C  *** IPART DENOTES THE GHEISHA PARTICLE INDEX ***
+C
+C  CONVENTION :
+C
+C   PARTICLE                 IPART
+C   ------------------------------
+C   GAMMA                    1
+C   NEUTRINO                 2
+C   POSITRON                 3
+C   ELECTRON                 4
+C   MUON +                   5
+C   MUON -                   6
+C   PION +                   7
+C   PION 0                   8
+C   PION -                   9
+C   KAON +                  10
+C   KAON 0 S                11
+C   KAON 0 L                12
+C   KAON -                  13
+C   PROTON                  14
+C   PROTON BAR              15
+C   NEUTRON                 16
+C   NEUTRON BAR             17
+C   LAMBDA                  18
+C   LAMBDA BAR              19
+C   SIGMA +                 20
+C   SIGMA 0                 21
+C   SIGMA -                 22
+C   SIGMA + BAR             23
+C   SIGMA 0 BAR             24
+C   SIGMA - BAR             25
+C   XSI 0                   26
+C   XSI -                   27
+C   XSI 0 BAR               28
+C   XSI - BAR               29
+C   DEUTERON                30
+C   TRITON                  31
+C   ALPHA                   32
+C   OMEGA -                 33
+C   OMEGA - BAR             34
+C   NEW PARTICLES           35
+C
+C-----------------------------------------------------------------------
+ 
+*KEEP,CGCOMP.
+      PARAMETER (KK=3)
+      COMMON/CGCOMP/ ACOMP,ZCOMP,WCOMP
+      REAL           ACOMP(KK),ZCOMP(KK),WCOMP(KK)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      COMMON/GSECTI/ AIEL(20),AIIN(20),AIFI(20),AICA(20),ALAM,K0FLAG
+      INTEGER K0FLAG
+      REAL AIEL,AIIN,AIFI,AICA,ALAM
+ 
+C --- GHEISHA COMMONS ---
+      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
+     *              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,
+     *              LCALO,ICEL,SINL,COSL,SINP,COSP,
+     *              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
+     *              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
+                    REAL NCH,INTCT
+ 
+      COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
+                    LOGICAL LPRT,NPRT
+ 
+ 
+      DIMENSION ALPHA(35),ALPHAC(41),IPART2(7),CSA(4)
+      DIMENSION PARTEL(35),PARTIN(35),ICORR(35),INTRC(35)
+ 
+C --- DIMENSION STATEMENTS FOR CROSS SECTION DATA ---
+      DIMENSION PLAB(41),CSEL(35,41),CSIN(35,41),CSPIEL(3,41),
+     $          CSPIIN(3,41),CSPNEL(3,41),CSPNIN(3,41),
+     $          ELAB(17),CNLWAT(15),CNLWEL(15,17),CNLWIN(15,17),
+     $          CSCAP(100)
+ 
+C --- DIMENSION STMTS. FOR GEANT/GHEISHA PARTICLE CODE CONVERSIONS ---
+C --- KIPART(I)=GHEISHA CODE CORRESPONDING TO GEANT   CODE I ---
+C --- IKPART(I)=GEANT   CODE CORRESPONDING TO GHEISHA CODE I ---
+ 
+      DIMENSION KIPART(48),IKPART(35)
+ 
+C --- CROSS-SECTION DATA BY "PCSDAT" 01-FEB-1989 ---
+      DATA PLAB /
+     $  0.00000E+00, 0.10000    , 0.15000    , 0.20000    , 0.25000    ,
+     $  0.30000    , 0.35000    , 0.40000    , 0.45000    , 0.50000    ,
+     $  0.55000    , 0.60000    , 0.65000    , 0.70000    , 0.75000    ,
+     $  0.80000    , 0.85000    , 0.90000    , 0.95000    ,  1.0000    ,
+     $   1.1000    ,  1.2000    ,  1.3000    ,  1.4000    ,  1.5000    ,
+     $   1.6000    ,  1.8000    ,  2.0000    ,  2.2000    ,  2.4000    ,
+     $   2.6000    ,  2.8000    ,  3.0000    ,  4.0000    ,  5.0000    ,
+     $   6.0000    ,  8.0000    ,  10.000    ,  20.000    ,  100.00    ,
+     $   1000.0    /
+ 
+      DATA ((CSEL(I,J),I=1,6),J=1,41) / 246 * 0. /
+      DATA (CSEL( 8,J),J=1,41) / 41 * 0. /
+      DATA (CSEL(21,J),J=1,41) / 41 * 0. /
+      DATA (CSEL(24,J),J=1,41) / 41 * 0. /
+      DATA ((CSEL(I,J),I=30,32),J=1,41) / 123 * 0. /
+      DATA (CSEL(35,J),J=1,41) / 41 * 0. /
+ 
+      DATA (CSEL( 7,J),J=1,41) /
+     $  0.00000E+00,  6.0000    ,  20.000    ,  71.000    ,  155.00    ,
+     $   195.00    ,  130.00    ,  78.000    ,  60.000    ,  32.000    ,
+     $   23.500    ,  18.500    ,  15.000    ,  12.500    ,  10.000    ,
+     $   9.1000    ,  8.6000    ,  8.8000    ,  9.5000    ,  10.600    ,
+     $   13.000    ,  15.500    ,  17.100    ,  17.200    ,  16.200    ,
+     $   15.000    ,  12.300    ,  10.200    ,  9.0000    ,  8.0000    ,
+     $   7.3000    ,  6.8000    ,  6.5000    ,  5.8000    ,  5.4000    ,
+     $   5.2000    ,  5.0000    ,  4.9000    ,  3.8000    ,  3.2000    ,
+     $   3.5000    /
+      DATA (CSEL( 9,J),J=1,41) /
+     $  0.00000E+00,  1.0000    ,  3.0000    ,  8.0000    ,  18.000    ,
+     $   25.000    ,  27.500    ,  12.300    ,  10.600    ,  11.000    ,
+     $   12.500    ,  14.500    ,  17.000    ,  19.400    ,  19.800    ,
+     $   16.800    ,  14.000    ,  14.800    ,  20.000    ,  26.100    ,
+     $   19.500    ,  15.000    ,  12.800    ,  11.500    ,  10.500    ,
+     $   9.8000    ,  8.8000    ,  8.2000    ,  7.8000    ,  7.5000    ,
+     $   7.2000    ,  7.0000    ,  6.8000    ,  6.1000    ,  5.7000    ,
+     $   5.4000    ,  4.9000    ,  4.6000    ,  4.0000    ,  3.3000    ,
+     $   3.5000    /
+      DATA (CSEL(10,J),J=1,41) /
+     $   10.000    ,  11.200    ,  11.300    ,  11.400    ,  11.500    ,
+     $   11.600    ,  11.800    ,  12.000    ,  12.100    ,  12.200    ,
+     $   12.300    ,  12.400    ,  12.500    ,  12.500    ,  12.500    ,
+     $   12.400    ,  12.300    ,  12.200    ,  12.000    ,  11.800    ,
+     $   11.200    ,  11.500    ,  9.9000    ,  9.4000    ,  8.8000    ,
+     $   8.4000    ,  7.5000    ,  6.9000    ,  6.3000    ,  5.9000    ,
+     $   5.5000    ,  5.2000    ,  5.0000    ,  4.0000    ,  3.5000    ,
+     $   3.3000    ,  3.1000    ,  3.1000    ,  3.0000    ,  2.5000    ,
+     $   3.0000    /
+      DATA (CSEL(11,J),J=1,41) /
+     $   10.000    ,  11.200    ,  11.300    ,  11.400    ,  11.500    ,
+     $   11.600    ,  11.800    ,  12.000    ,  12.100    ,  12.200    ,
+     $   12.300    ,  12.400    ,  12.500    ,  12.500    ,  12.500    ,
+     $   12.400    ,  12.300    ,  12.200    ,  12.000    ,  11.800    ,
+     $   11.200    ,  11.500    ,  9.9000    ,  9.4000    ,  8.8000    ,
+     $   8.4000    ,  7.5000    ,  6.9000    ,  6.3000    ,  5.9000    ,
+     $   5.5000    ,  5.2000    ,  5.0000    ,  4.0000    ,  3.5000    ,
+     $   3.3000    ,  3.1000    ,  3.1000    ,  3.0000    ,  2.5000    ,
+     $   3.0000    /
+      DATA (CSEL(12,J),J=1,41) /
+     $   160.83    ,  82.800    ,  58.575    ,  43.683    ,  34.792    ,
+     $   28.650    ,  24.367    ,  20.917    ,  18.192    ,  16.300    ,
+     $   14.608    ,  13.017    ,  12.250    ,  11.700    ,  12.017    ,
+     $   14.075    ,  15.842    ,  16.433    ,  16.042    ,  15.008    ,
+     $   12.575    ,  10.708    ,  9.2000    ,  8.0167    ,  7.2833    ,
+     $   7.0750    ,  6.6333    ,  6.1250    ,  5.6583    ,  5.2750    ,
+     $   4.9333    ,  4.6250    ,  4.4583    ,  3.7333    ,  3.3833    ,
+     $   3.1833    ,  2.9833    ,  2.7500    ,  2.3667    ,  2.2000    ,
+     $   2.6000    /
+      DATA (CSEL(13,J),J=1,41) /
+     $   300.00    ,  140.00    ,  97.000    ,  70.000    ,  55.000    ,
+     $   45.000    ,  37.000    ,  31.000    ,  26.000    ,  23.000    ,
+     $   20.000    ,  17.000    ,  15.500    ,  14.500    ,  14.700    ,
+     $   18.500    ,  22.000    ,  23.000    ,  22.500    ,  20.700    ,
+     $   16.500    ,  14.000    ,  11.500    ,  9.6000    ,  8.6000    ,
+     $   8.5000    ,  8.3000    ,  7.6000    ,  7.0000    ,  6.4000    ,
+     $   5.9000    ,  5.5000    ,  5.3000    ,  4.4000    ,  4.1000    ,
+     $   3.9000    ,  3.7000    ,  3.3000    ,  2.6000    ,  2.5000    ,
+     $   3.0000    /
+      DATA (CSEL(14,J),J=1,41) /
+     $   1100.0    ,  115.00    ,  105.00    ,  100.00    ,  56.000    ,
+     $   40.000    ,  27.000    ,  22.000    ,  21.000    ,  20.000    ,
+     $   20.000    ,  20.000    ,  20.500    ,  21.000    ,  22.000    ,
+     $   23.000    ,  24.000    ,  24.000    ,  24.400    ,  24.500    ,
+     $   25.000    ,  25.500    ,  26.000    ,  26.500    ,  27.000    ,
+     $   27.000    ,  26.000    ,  23.000    ,  21.500    ,  20.000    ,
+     $   19.000    ,  18.000    ,  17.000    ,  13.000    ,  11.500    ,
+     $   10.300    ,  9.4000    ,  9.0000    ,  8.8000    ,  7.0000    ,
+     $   7.5000    /
+      DATA (CSEL(15,J),J=1,41) /
+     $   200.00    ,  163.00    ,  141.00    ,  120.00    ,  111.00    ,
+     $   99.500    ,  92.500    ,  86.500    ,  82.000    ,  78.000    ,
+     $   74.000    ,  71.000    ,  67.500    ,  65.000    ,  62.500    ,
+     $   59.700    ,  58.100    ,  56.300    ,  54.700    ,  52.700    ,
+     $   50.000    ,  48.400    ,  47.000    ,  46.000    ,  45.200    ,
+     $   42.800    ,  39.200    ,  36.300    ,  32.800    ,  30.400    ,
+     $   28.100    ,  26.300    ,  24.500    ,  19.250    ,  16.840    ,
+     $   14.600    ,  12.340    ,  11.210    ,  8.8500    ,  7.5000    ,
+     $   7.5000    /
+      DATA (CSEL(16,J),J=1,41) /
+     $   4200.0    ,  440.00    ,  420.00    ,  400.00    ,  230.00    ,
+     $   160.00    ,  105.00    ,  80.000    ,  62.000    ,  50.000    ,
+     $   45.000    ,  41.000    ,  38.000    ,  36.000    ,  35.000    ,
+     $   34.000    ,  33.000    ,  32.000    ,  31.500    ,  31.000    ,
+     $   30.500    ,  30.000    ,  29.500    ,  29.000    ,  28.500    ,
+     $   28.000    ,  26.000    ,  23.000    ,  21.500    ,  20.000    ,
+     $   19.000    ,  18.000    ,  17.000    ,  13.000    ,  11.500    ,
+     $   10.300    ,  9.4000    ,  9.0000    ,  8.8000    ,  7.0000    ,
+     $   7.5000    /
+      DATA (CSEL(17,J),J=1,41) /
+     $   185.88    ,  133.23    ,  119.37    ,  102.86    ,  93.102    ,
+     $   82.752    ,  76.205    ,  71.008    ,  67.366    ,  64.096    ,
+     $   60.891    ,  58.501    ,  55.735    ,  53.773    ,  51.839    ,
+     $   49.671    ,  48.485    ,  47.045    ,  45.803    ,  44.306    ,
+     $   42.623    ,  41.786    ,  41.115    ,  40.630    ,  40.129    ,
+     $   38.242    ,  35.233    ,  32.662    ,  29.639    ,  27.573    ,
+     $   25.536    ,  23.948    ,  22.356    ,  17.723    ,  15.614    ,
+     $   13.653    ,  11.675    ,  10.653    ,  8.6198    ,  7.4464    ,
+     $   7.4821    /
+      DATA (CSEL(18,J),J=1,41) /
+     $   1100.0    ,  115.00    ,  105.00    ,  100.00    ,  56.000    ,
+     $   40.000    ,  27.000    ,  22.000    ,  21.000    ,  20.000    ,
+     $   20.000    ,  19.067    ,  19.333    ,  19.500    ,  19.833    ,
+     $   20.567    ,  21.800    ,  22.900    ,  23.869    ,  23.809    ,
+     $   22.161    ,  21.488    ,  19.732    ,  19.433    ,  19.345    ,
+     $   19.029    ,  18.121    ,  16.280    ,  15.258    ,  14.280    ,
+     $   13.644    ,  12.963    ,  12.316    ,  9.5333    ,  8.4333    ,
+     $   7.5728    ,  6.9696    ,  6.7518    ,  6.6175    ,  5.6000    ,
+     $   6.1145    /
+      DATA (CSEL(19,J),J=1,41) /
+     $   157.65    ,  73.701    ,  76.096    ,  68.571    ,  57.305    ,
+     $   49.257    ,  43.616    ,  40.024    ,  38.098    ,  36.287    ,
+     $   34.674    ,  33.105    ,  31.712    ,  30.685    ,  29.613    ,
+     $   28.602    ,  28.336    ,  28.075    ,  27.786    ,  27.215    ,
+     $   26.380    ,  26.146    ,  25.108    ,  24.783    ,  24.360    ,
+     $   23.219    ,  21.431    ,  20.095    ,  18.382    ,  17.267    ,
+     $   16.100    ,  15.175    ,  14.271    ,  11.573    ,  10.305    ,
+     $   9.1471    ,  8.0149    ,  7.4349    ,  6.2499    ,  5.8928    ,
+     $   6.0774    /
+      DATA (CSEL(20,J),J=1,41) /
+     $   1100.0    ,  115.00    ,  105.00    ,  100.00    ,  56.000    ,
+     $   40.000    ,  27.000    ,  22.000    ,  21.000    ,  20.000    ,
+     $   20.000    ,  19.067    ,  19.333    ,  19.500    ,  19.833    ,
+     $   20.567    ,  21.800    ,  22.900    ,  23.869    ,  23.809    ,
+     $   22.161    ,  21.488    ,  19.732    ,  19.433    ,  19.345    ,
+     $   19.029    ,  18.121    ,  16.280    ,  15.258    ,  14.280    ,
+     $   13.644    ,  12.963    ,  12.316    ,  9.5333    ,  8.4333    ,
+     $   7.5728    ,  6.9696    ,  6.7518    ,  6.6175    ,  5.6000    ,
+     $   6.1145    /
+      DATA (CSEL(22,J),J=1,41) /
+     $   1100.0    ,  115.00    ,  105.00    ,  100.00    ,  56.000    ,
+     $   40.000    ,  27.000    ,  22.000    ,  21.000    ,  20.000    ,
+     $   20.000    ,  19.067    ,  19.333    ,  19.500    ,  19.833    ,
+     $   20.567    ,  21.800    ,  22.900    ,  23.869    ,  23.809    ,
+     $   22.161    ,  21.488    ,  19.732    ,  19.433    ,  19.345    ,
+     $   19.029    ,  18.121    ,  16.280    ,  15.258    ,  14.280    ,
+     $   13.644    ,  12.963    ,  12.316    ,  9.5333    ,  8.4333    ,
+     $   7.5728    ,  6.9696    ,  6.7518    ,  6.6175    ,  5.6000    ,
+     $   6.1145    /
+      DATA (CSEL(23,J),J=1,41) /
+     $   185.88    ,  133.23    ,  119.37    ,  102.86    ,  93.102    ,
+     $   82.752    ,  76.205    ,  71.008    ,  67.366    ,  64.096    ,
+     $   60.891    ,  58.104    ,  55.241    ,  53.140    ,  50.934    ,
+     $   48.660    ,  47.566    ,  46.585    ,  45.581    ,  44.003    ,
+     $   41.134    ,  39.374    ,  36.878    ,  35.523    ,  34.503    ,
+     $   32.334    ,  29.365    ,  27.370    ,  24.705    ,  22.921    ,
+     $   21.229    ,  19.879    ,  18.559    ,  14.625    ,  12.758    ,
+     $   11.041    ,  9.3440    ,  8.5484    ,  6.7104    ,  6.0000    ,
+     $   6.1131    /
+      DATA (CSEL(25,J),J=1,41) /
+     $   157.65    ,  73.701    ,  76.096    ,  68.571    ,  57.305    ,
+     $   49.257    ,  43.616    ,  40.024    ,  38.098    ,  36.287    ,
+     $   34.674    ,  33.105    ,  31.712    ,  30.685    ,  29.613    ,
+     $   28.602    ,  28.336    ,  28.075    ,  27.786    ,  27.215    ,
+     $   26.380    ,  26.146    ,  25.108    ,  24.783    ,  24.360    ,
+     $   23.219    ,  21.431    ,  20.095    ,  18.382    ,  17.267    ,
+     $   16.100    ,  15.175    ,  14.271    ,  11.573    ,  10.305    ,
+     $   9.1471    ,  8.0149    ,  7.4349    ,  6.2499    ,  5.8928    ,
+     $   6.0774    /
+      DATA (CSEL(26,J),J=1,41) /
+     $   1100.0    ,  115.00    ,  105.00    ,  100.00    ,  56.000    ,
+     $   40.000    ,  27.000    ,  22.000    ,  21.000    ,  20.000    ,
+     $   20.000    ,  18.133    ,  18.167    ,  18.000    ,  17.667    ,
+     $   18.133    ,  19.600    ,  21.800    ,  23.338    ,  23.118    ,
+     $   19.323    ,  17.476    ,  13.464    ,  12.367    ,  11.691    ,
+     $   11.057    ,  10.242    ,  9.5593    ,  9.0151    ,  8.5591    ,
+     $   8.2884    ,  7.9253    ,  7.6311    ,  6.0667    ,  5.3667    ,
+     $   4.8456    ,  4.5392    ,  4.5036    ,  4.4351    ,  4.2000    ,
+     $   4.7289    /
+      DATA (CSEL(27,J),J=1,41) /
+     $   1100.0    ,  115.00    ,  105.00    ,  100.00    ,  56.000    ,
+     $   40.000    ,  27.000    ,  22.000    ,  21.000    ,  20.000    ,
+     $   20.000    ,  18.133    ,  18.167    ,  18.000    ,  17.667    ,
+     $   18.133    ,  19.600    ,  21.800    ,  23.338    ,  23.118    ,
+     $   19.323    ,  17.476    ,  13.464    ,  12.367    ,  11.691    ,
+     $   11.057    ,  10.242    ,  9.5593    ,  9.0151    ,  8.5591    ,
+     $   8.2884    ,  7.9253    ,  7.6311    ,  6.0667    ,  5.3667    ,
+     $   4.8456    ,  4.5392    ,  4.5036    ,  4.4351    ,  4.2000    ,
+     $   4.7289    /
+      DATA (CSEL(28,J),J=1,41) /
+     $   157.65    ,  73.701    ,  76.096    ,  68.571    ,  57.305    ,
+     $   49.257    ,  43.616    ,  40.024    ,  38.098    ,  36.287    ,
+     $   34.674    ,  32.708    ,  31.218    ,  30.052    ,  28.707    ,
+     $   27.591    ,  27.417    ,  27.615    ,  27.564    ,  26.913    ,
+     $   24.891    ,  23.734    ,  20.871    ,  19.677    ,  18.734    ,
+     $   17.311    ,  15.563    ,  14.803    ,  13.448    ,  12.615    ,
+     $   11.794    ,  11.106    ,  10.474    ,  8.4745    ,  7.4498    ,
+     $   6.5350    ,  5.6835    ,  5.3300    ,  4.3406    ,  4.4464    ,
+     $   4.7083    /
+      DATA (CSEL(29,J),J=1,41) /
+     $   143.53    ,  43.935    ,  54.462    ,  51.429    ,  39.407    ,
+     $   32.510    ,  27.321    ,  24.532    ,  23.465    ,  22.383    ,
+     $   21.566    ,  20.209    ,  19.453    ,  18.825    ,  18.046    ,
+     $   17.562    ,  17.802    ,  18.360    ,  18.667    ,  18.519    ,
+     $   17.514    ,  17.120    ,  14.985    ,  14.306    ,  13.663    ,
+     $   12.753    ,  11.596    ,  11.165    ,  10.287    ,  9.7882    ,
+     $   9.2294    ,  8.7539    ,  8.3300    ,  6.9480    ,  6.2234    ,
+     $   5.5881    ,  5.0189    ,  4.7733    ,  4.1104    ,  4.3929    ,
+     $   4.6905    /
+      DATA (CSEL(33,J),J=1,41) /
+     $   1100.0    ,  115.00    ,  105.00    ,  100.00    ,  56.000    ,
+     $   40.000    ,  27.000    ,  22.000    ,  21.000    ,  20.000    ,
+     $   20.000    ,  18.133    ,  18.167    ,  18.000    ,  17.667    ,
+     $   18.133    ,  19.600    ,  21.800    ,  23.338    ,  23.118    ,
+     $   19.323    ,  17.476    ,  13.464    ,  12.367    ,  11.691    ,
+     $   11.057    ,  10.242    ,  9.5593    ,  9.0151    ,  8.5591    ,
+     $   8.2884    ,  7.9253    ,  7.6311    ,  6.0667    ,  5.3667    ,
+     $   4.8456    ,  4.5392    ,  4.5036    ,  4.4351    ,  4.2000    ,
+     $   4.7289    /
+      DATA (CSEL(34,J),J=1,41) /
+     $   143.53    ,  43.935    ,  54.462    ,  51.429    ,  39.407    ,
+     $   32.510    ,  27.321    ,  24.532    ,  23.465    ,  22.383    ,
+     $   21.566    ,  20.209    ,  19.453    ,  18.825    ,  18.046    ,
+     $   17.562    ,  17.802    ,  18.360    ,  18.667    ,  18.519    ,
+     $   17.514    ,  17.120    ,  14.985    ,  14.306    ,  13.663    ,
+     $   12.753    ,  11.596    ,  11.165    ,  10.287    ,  9.7882    ,
+     $   9.2294    ,  8.7539    ,  8.3300    ,  6.9480    ,  6.2234    ,
+     $   5.5881    ,  5.0189    ,  4.7733    ,  4.1104    ,  4.3929    ,
+     $   4.6905    /
+ 
+      DATA ((CSIN(I,J),I=1,6),J=1,41) / 246 * 0. /
+      DATA (CSIN( 8,J),J=1,41) / 41 * 0. /
+      DATA (CSIN(21,J),J=1,41) / 41 * 0. /
+      DATA (CSIN(24,J),J=1,41) / 41 * 0. /
+      DATA ((CSIN(I,J),I=30,32),J=1,41) / 123 * 0. /
+      DATA (CSIN(35,J),J=1,41) / 41 * 0. /
+ 
+      DATA (CSIN( 7,J),J=1,41) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.50000    ,  1.2000    ,  1.7000    ,
+     $   2.2500    ,  3.0000    ,  3.6000    ,  4.5000    ,  5.4000    ,
+     $   6.3000    ,  8.6000    ,  9.0000    ,  10.000    ,  11.500    ,
+     $   14.000    ,  17.000    ,  19.500    ,  22.000    ,  24.000    ,
+     $   21.500    ,  18.500    ,  19.000    ,  20.500    ,  22.200    ,
+     $   23.000    ,  23.300    ,  23.000    ,  21.000    ,  20.500    ,
+     $   20.200    ,  20.100    ,  20.000    ,  20.000    ,  20.000    ,
+     $   21.000    /
+      DATA (CSIN( 9,J),J=1,41) /
+     $  0.00000E+00,  3.0000    ,  9.2000    ,  20.500    ,  36.500    ,
+     $   45.000    ,  28.000    ,  19.500    ,  15.500    ,  14.200    ,
+     $   15.500    ,  17.500    ,  20.000    ,  23.000    ,  26.000    ,
+     $   20.000    ,  23.000    ,  26.500    ,  32.000    ,  35.000    ,
+     $   28.500    ,  22.000    ,  22.500    ,  23.500    ,  24.000    ,
+     $   24.500    ,  26.000    ,  27.500    ,  27.500    ,  27.000    ,
+     $   26.500    ,  25.500    ,  25.000    ,  23.000    ,  22.500    ,
+     $   22.200    ,  22.000    ,  22.000    ,  21.200    ,  20.700    ,
+     $   21.000    /
+      DATA (CSIN(10,J),J=1,41) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.50000    ,  1.5000    ,  2.7000    ,  3.8000    ,  4.8000    ,
+     $   6.5000    ,  7.6000    ,  8.4000    ,  9.0000    ,  9.4000    ,
+     $   9.8000    ,  10.500    ,  11.000    ,  11.500    ,  11.800    ,
+     $   12.200    ,  12.400    ,  12.600    ,  13.200    ,  13.500    ,
+     $   13.700    ,  14.000    ,  14.200    ,  14.500    ,  16.400    ,
+     $   17.000    /
+      DATA (CSIN(11,J),J=1,41) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.50000    ,  1.5000    ,  2.7000    ,  3.8000    ,  4.8000    ,
+     $   6.5000    ,  7.6000    ,  8.4000    ,  9.0000    ,  9.4000    ,
+     $   9.8000    ,  10.500    ,  11.000    ,  11.500    ,  11.800    ,
+     $   12.200    ,  12.400    ,  12.600    ,  13.200    ,  13.500    ,
+     $   13.700    ,  14.000    ,  14.200    ,  14.500    ,  16.400    ,
+     $   17.000    /
+      DATA (CSIN(12,J),J=1,41) /
+     $   266.67    ,  133.33    ,  83.333    ,  57.083    ,  44.500    ,
+     $   33.250    ,  24.583    ,  20.833    ,  18.333    ,  16.083    ,
+     $   15.625    ,  15.083    ,  14.833    ,  15.083    ,  15.833    ,
+     $   17.042    ,  18.958    ,  20.758    ,  22.533    ,  22.825    ,
+     $   21.250    ,  18.567    ,  17.767    ,  18.100    ,  19.933    ,
+     $   20.783    ,  21.225    ,  21.000    ,  20.558    ,  20.258    ,
+     $   20.017    ,  19.767    ,  19.600    ,  19.183    ,  18.850    ,
+     $   18.575    ,  18.350    ,  18.175    ,  17.808    ,  17.558    ,
+     $   19.250    /
+      DATA (CSIN(13,J),J=1,41) /
+     $   400.00    ,  200.00    ,  120.00    ,  81.000    ,  62.000    ,
+     $   47.000    ,  35.000    ,  28.000    ,  24.000    ,  21.000    ,
+     $   19.500    ,  19.000    ,  18.800    ,  19.000    ,  20.000    ,
+     $   21.000    ,  23.000    ,  25.000    ,  27.000    ,  27.500    ,
+     $   25.500    ,  22.000    ,  20.800    ,  21.000    ,  23.000    ,
+     $   24.000    ,  24.000    ,  23.800    ,  23.000    ,  22.500    ,
+     $   22.000    ,  21.600    ,  21.400    ,  21.000    ,  20.500    ,
+     $   20.200    ,  19.800    ,  19.500    ,  18.600    ,  17.500    ,
+     $   20.000    /
+      DATA (CSIN(14,J),J=1,41) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.10000    ,  1.5000    ,
+     $   7.0000    ,  12.000    ,  17.000    ,  19.500    ,  20.500    ,
+     $   22.000    ,  23.500    ,  24.800    ,  25.800    ,  26.500    ,
+     $   27.000    ,  27.500    ,  28.000    ,  30.000    ,  31.000    ,
+     $   32.000    ,  32.500    ,  32.500    ,  33.000    ,  33.500    ,
+     $   34.000    /
+      DATA (CSIN(15,J),J=1,41) /
+     $   1500.0    ,  1160.0    ,  310.00    ,  230.00    ,  178.00    ,
+     $   153.00    ,  134.00    ,  124.00    ,  113.00    ,  106.00    ,
+     $   101.00    ,  96.000    ,  92.000    ,  89.000    ,  87.000    ,
+     $   84.000    ,  81.000    ,  78.500    ,  76.500    ,  75.000    ,
+     $   72.000    ,  70.000    ,  68.000    ,  64.500    ,  63.000    ,
+     $   62.000    ,  61.000    ,  59.500    ,  58.500    ,  56.500    ,
+     $   56.500    ,  56.000    ,  55.500    ,  52.000    ,  50.000    ,
+     $   48.000    ,  45.000    ,  44.000    ,  39.200    ,  34.500    ,
+     $   34.500    /
+      DATA (CSIN(16,J),J=1,41) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.10000    ,  1.5000    ,
+     $   7.0000    ,  12.000    ,  17.000    ,  19.500    ,  20.500    ,
+     $   22.000    ,  23.500    ,  24.800    ,  25.800    ,  26.500    ,
+     $   27.000    ,  27.500    ,  28.000    ,  30.000    ,  31.000    ,
+     $   32.000    ,  32.500    ,  32.500    ,  33.000    ,  33.500    ,
+     $   34.000    /
+      DATA (CSIN(17,J),J=1,41) /
+     $   1394.1    ,  948.17    ,  262.43    ,  197.14    ,  149.30    ,
+     $   127.25    ,  110.39    ,  101.79    ,  92.834    ,  87.104    ,
+     $   83.109    ,  79.099    ,  75.965    ,  73.627    ,  72.161    ,
+     $   69.889    ,  67.595    ,  65.595    ,  64.057    ,  63.054    ,
+     $   61.377    ,  60.434    ,  59.485    ,  56.970    ,  55.931    ,
+     $   55.398    ,  54.827    ,  53.538    ,  52.861    ,  51.247    ,
+     $   51.344    ,  50.992    ,  50.644    ,  47.876    ,  46.358    ,
+     $   44.887    ,  42.577    ,  41.815    ,  38.180    ,  34.254    ,
+     $   34.418    /
+      DATA (CSIN(18,J),J=1,41) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.97815E-01,  1.4577    ,
+     $   6.2052    ,  10.112    ,  12.902    ,  14.300    ,  14.688    ,
+     $   15.505    ,  16.379    ,  17.554    ,  18.309    ,  18.920    ,
+     $   19.389    ,  19.804    ,  20.284    ,  22.000    ,  22.733    ,
+     $   23.527    ,  24.097    ,  24.382    ,  24.816    ,  26.800    ,
+     $   27.719    /
+      DATA (CSIN(19,J),J=1,41) /
+     $   1182.4    ,  524.50    ,  167.30    ,  131.43    ,  91.895    ,
+     $   75.743    ,  63.184    ,  57.376    ,  52.502    ,  49.313    ,
+     $   47.326    ,  44.762    ,  43.222    ,  42.015    ,  41.221    ,
+     $   40.244    ,  39.504    ,  39.145    ,  38.860    ,  38.731    ,
+     $   37.987    ,  37.814    ,  36.326    ,  34.750    ,  33.953    ,
+     $   33.635    ,  33.349    ,  32.938    ,  32.785    ,  32.092    ,
+     $   32.373    ,  32.312    ,  32.329    ,  31.261    ,  30.597    ,
+     $   30.073    ,  29.228    ,  29.182    ,  27.683    ,  27.107    ,
+     $   27.956    /
+      DATA (CSIN(20,J),J=1,41) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.97815E-01,  1.4577    ,
+     $   6.2052    ,  10.112    ,  12.902    ,  14.300    ,  14.688    ,
+     $   15.505    ,  16.379    ,  17.554    ,  18.309    ,  18.920    ,
+     $   19.389    ,  19.804    ,  20.284    ,  22.000    ,  22.733    ,
+     $   23.527    ,  24.097    ,  24.382    ,  24.816    ,  26.800    ,
+     $   27.719    /
+      DATA (CSIN(22,J),J=1,41) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.97815E-01,  1.4577    ,
+     $   6.2052    ,  10.112    ,  12.902    ,  14.300    ,  14.688    ,
+     $   15.505    ,  16.379    ,  17.554    ,  18.309    ,  18.920    ,
+     $   19.389    ,  19.804    ,  20.284    ,  22.000    ,  22.733    ,
+     $   23.527    ,  24.097    ,  24.382    ,  24.816    ,  26.800    ,
+     $   27.719    /
+      DATA (CSIN(23,J),J=1,41) /
+     $   1394.1    ,  948.17    ,  262.43    ,  197.14    ,  149.30    ,
+     $   127.25    ,  110.39    ,  101.79    ,  92.834    ,  87.104    ,
+     $   83.109    ,  78.563    ,  75.292    ,  72.760    ,  70.900    ,
+     $   68.467    ,  66.314    ,  64.955    ,  63.746    ,  62.623    ,
+     $   59.233    ,  56.946    ,  53.355    ,  49.810    ,  48.090    ,
+     $   46.839    ,  45.695    ,  44.863    ,  44.062    ,  42.599    ,
+     $   42.684    ,  42.328    ,  42.041    ,  39.508    ,  37.880    ,
+     $   36.299    ,  34.075    ,  33.553    ,  29.723    ,  27.600    ,
+     $   28.120    /
+      DATA (CSIN(25,J),J=1,41) /
+     $   1182.4    ,  524.50    ,  167.30    ,  131.43    ,  91.895    ,
+     $   75.743    ,  63.184    ,  57.376    ,  52.502    ,  49.313    ,
+     $   47.326    ,  44.762    ,  43.222    ,  42.015    ,  41.221    ,
+     $   40.244    ,  39.504    ,  39.145    ,  38.860    ,  38.731    ,
+     $   37.987    ,  37.814    ,  36.326    ,  34.750    ,  33.953    ,
+     $   33.635    ,  33.349    ,  32.938    ,  32.785    ,  32.092    ,
+     $   32.373    ,  32.312    ,  32.329    ,  31.261    ,  30.597    ,
+     $   30.073    ,  29.228    ,  29.182    ,  27.683    ,  27.107    ,
+     $   27.956    /
+      DATA (CSIN(26,J),J=1,41) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.95639E-01,  1.4154    ,
+     $   5.4104    ,  8.2240    ,  8.8031    ,  9.1000    ,  8.8761    ,
+     $   9.0095    ,  9.2576    ,  10.307    ,  10.818    ,  11.341    ,
+     $   11.778    ,  12.108    ,  12.569    ,  14.000    ,  14.467    ,
+     $   15.054    ,  15.694    ,  16.263    ,  16.632    ,  20.100    ,
+     $   21.438    /
+      DATA (CSIN(27,J),J=1,41) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.95639E-01,  1.4154    ,
+     $   5.4104    ,  8.2240    ,  8.8031    ,  9.1000    ,  8.8761    ,
+     $   9.0095    ,  9.2576    ,  10.307    ,  10.818    ,  11.341    ,
+     $   11.778    ,  12.108    ,  12.569    ,  14.000    ,  14.467    ,
+     $   15.054    ,  15.694    ,  16.263    ,  16.632    ,  20.100    ,
+     $   21.438    /
+      DATA (CSIN(28,J),J=1,41) /
+     $   1182.4    ,  524.50    ,  167.30    ,  131.43    ,  91.895    ,
+     $   75.743    ,  63.184    ,  57.376    ,  52.502    ,  49.313    ,
+     $   47.326    ,  44.225    ,  42.549    ,  41.148    ,  39.960    ,
+     $   38.822    ,  38.223    ,  38.505    ,  38.549    ,  38.301    ,
+     $   35.843    ,  34.326    ,  30.196    ,  27.590    ,  26.112    ,
+     $   25.076    ,  24.217    ,  24.264    ,  23.985    ,  23.445    ,
+     $   23.713    ,  23.647    ,  23.726    ,  22.892    ,  22.119    ,
+     $   21.485    ,  20.726    ,  20.921    ,  19.226    ,  20.454    ,
+     $   21.658    /
+      DATA (CSIN(29,J),J=1,41) /
+     $   1076.5    ,  312.66    ,  119.74    ,  98.571    ,  63.193    ,
+     $   49.990    ,  39.579    ,  35.168    ,  32.335    ,  30.417    ,
+     $   29.434    ,  27.325    ,  26.514    ,  25.775    ,  25.120    ,
+     $   24.711    ,  24.818    ,  25.600    ,  26.106    ,  26.355    ,
+     $   25.220    ,  24.760    ,  21.681    ,  20.060    ,  19.044    ,
+     $   18.474    ,  18.044    ,  18.301    ,  18.347    ,  18.192    ,
+     $   18.557    ,  18.639    ,  18.870    ,  18.769    ,  18.478    ,
+     $   18.372    ,  18.302    ,  18.735    ,  18.206    ,  20.207    ,
+     $   21.576    /
+      DATA (CSIN(33,J),J=1,41) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.95639E-01,  1.4154    ,
+     $   5.4104    ,  8.2240    ,  8.8031    ,  9.1000    ,  8.8761    ,
+     $   9.0095    ,  9.2576    ,  10.307    ,  10.818    ,  11.341    ,
+     $   11.778    ,  12.108    ,  12.569    ,  14.000    ,  14.467    ,
+     $   15.054    ,  15.694    ,  16.263    ,  16.632    ,  20.100    ,
+     $   21.438    /
+      DATA (CSIN(34,J),J=1,41) /
+     $   1076.5    ,  312.66    ,  119.74    ,  98.571    ,  63.193    ,
+     $   49.990    ,  39.579    ,  35.168    ,  32.335    ,  30.417    ,
+     $   29.434    ,  27.325    ,  26.514    ,  25.775    ,  25.120    ,
+     $   24.711    ,  24.818    ,  25.600    ,  26.106    ,  26.355    ,
+     $   25.220    ,  24.760    ,  21.681    ,  20.060    ,  19.044    ,
+     $   18.474    ,  18.044    ,  18.301    ,  18.347    ,  18.192    ,
+     $   18.557    ,  18.639    ,  18.870    ,  18.769    ,  18.478    ,
+     $   18.372    ,  18.302    ,  18.735    ,  18.206    ,  20.207    ,
+     $   21.576    /
+ 
+      DATA (CSPIEL( 1,J),J=1,41) /
+     $  0.00000E+00,  350.00    ,  580.00    ,  600.00    ,  550.00    ,
+     $   450.00    ,  410.00    ,  370.00    ,  340.00    ,  230.00    ,
+     $   220.00    ,  205.00    ,  180.00    ,  155.00    ,  145.00    ,
+     $   140.00    ,  160.00    ,  195.00    ,  235.00    ,  250.00    ,
+     $   270.00    ,  280.00    ,  300.00    ,  300.00    ,  290.00    ,
+     $   285.00    ,  265.00    ,  240.00    ,  230.00    ,  222.00    ,
+     $   204.00    ,  196.00    ,  190.00    ,  170.00    ,  170.00    ,
+     $   160.00    ,  150.00    ,  140.00    ,  120.00    ,  80.000    ,
+     $   80.000    /
+      DATA (CSPIEL( 2,J),J=1,41) /
+     $  0.00000E+00,  700.00    ,  1000.0    ,  1200.0    ,  1300.0    ,
+     $   1300.0    ,  1250.0    ,  1250.0    ,  1100.0    ,  1000.0    ,
+     $   940.00    ,  740.00    ,  700.00    ,  670.00    ,  660.00    ,
+     $   670.00    ,  680.00    ,  700.00    ,  735.00    ,  800.00    ,
+     $   810.00    ,  820.00    ,  820.00    ,  810.00    ,  800.00    ,
+     $   800.00    ,  700.00    ,  600.00    ,  500.00    ,  470.00    ,
+     $   440.00    ,  410.00    ,  380.00    ,  330.00    ,  330.00    ,
+     $   330.00    ,  330.00    ,  330.00    ,  285.00    ,  240.00    ,
+     $   240.00    /
+      DATA (CSPIEL( 3,J),J=1,41) /
+     $  0.00000E+00,  1700.0    ,  2200.0    ,  2200.0    ,  1800.0    ,
+     $   1300.0    ,  1200.0    ,  900.00    ,  900.00    ,  1000.0    ,
+     $   1100.0    ,  1300.0    ,  1400.0    ,  1420.0    ,  1490.0    ,
+     $   1560.0    ,  1580.0    ,  1690.0    ,  1795.0    ,  2000.0    ,
+     $   2070.0    ,  2140.0    ,  2050.0    ,  2010.0    ,  1970.0    ,
+     $   1880.0    ,  1690.0    ,  1500.0    ,  1420.0    ,  1390.0    ,
+     $   1350.0    ,  1360.0    ,  1370.0    ,  1280.0    ,  1290.0    ,
+     $   1295.0    ,  1250.0    ,  1200.0    ,  1050.0    ,  900.00    ,
+     $   900.00    /
+      DATA (CSPIIN( 1,J),J=1,41) /
+     $  0.00000E+00,  200.00    ,  320.00    ,  500.00    ,  600.00    ,
+     $   600.00    ,  590.00    ,  530.00    ,  510.00    ,  470.00    ,
+     $   430.00    ,  425.00    ,  420.00    ,  425.00    ,  425.00    ,
+     $   430.00    ,  430.00    ,  435.00    ,  435.00    ,  440.00    ,
+     $   430.00    ,  430.00    ,  420.00    ,  420.00    ,  420.00    ,
+     $   415.00    ,  415.00    ,  410.00    ,  410.00    ,  408.00    ,
+     $   406.00    ,  404.00    ,  400.00    ,  380.00    ,  340.00    ,
+     $   340.00    ,  340.00    ,  340.00    ,  340.00    ,  340.00    ,
+     $   340.00    /
+      DATA (CSPIIN( 2,J),J=1,41) /
+     $  0.00000E+00,  400.00    ,  800.00    ,  1000.0    ,  1100.0    ,
+     $   1200.0    ,  1150.0    ,  1050.0    ,  1000.0    ,  900.00    ,
+     $   860.00    ,  860.00    ,  850.00    ,  850.00    ,  840.00    ,
+     $   830.00    ,  820.00    ,  810.00    ,  805.00    ,  800.00    ,
+     $   800.00    ,  800.00    ,  800.00    ,  800.00    ,  800.00    ,
+     $   800.00    ,  800.00    ,  800.00    ,  800.00    ,  780.00    ,
+     $   760.00    ,  740.00    ,  720.00    ,  720.00    ,  700.00    ,
+     $   690.00    ,  680.00    ,  670.00    ,  665.00    ,  660.00    ,
+     $   660.00    /
+      DATA (CSPIIN( 3,J),J=1,41) /
+     $  0.00000E+00,  1000.0    ,  1900.0    ,  2600.0    ,  2900.0    ,
+     $   3000.0    ,  2800.0    ,  2600.0    ,  2500.0    ,  2300.0    ,
+     $   2200.0    ,  2000.0    ,  1900.0    ,  1880.0    ,  1860.0    ,
+     $   1840.0    ,  1820.0    ,  1810.0    ,  1805.0    ,  1800.0    ,
+     $   1780.0    ,  1760.0    ,  1750.0    ,  1740.0    ,  1730.0    ,
+     $   1720.0    ,  1710.0    ,  1700.0    ,  1680.0    ,  1660.0    ,
+     $   1650.0    ,  1640.0    ,  1630.0    ,  1620.0    ,  1610.0    ,
+     $   1605.0    ,  1600.0    ,  1600.0    ,  1550.0    ,  1500.0    ,
+     $   1500.0    /
+      DATA (CSPNEL( 1,J),J=1,41) /
+     $   2100.0    ,  1800.0    ,  1500.0    ,  1050.0    ,  900.00    ,
+     $   950.00    ,  800.00    ,  650.00    ,  570.00    ,  390.00    ,
+     $   300.00    ,  240.00    ,  230.00    ,  230.00    ,  220.00    ,
+     $   220.00    ,  225.00    ,  225.00    ,  240.00    ,  240.00    ,
+     $   290.00    ,  330.00    ,  335.00    ,  350.00    ,  355.00    ,
+     $   370.00    ,  350.00    ,  330.00    ,  310.00    ,  290.00    ,
+     $   270.00    ,  265.00    ,  260.00    ,  230.00    ,  210.00    ,
+     $   210.00    ,  200.00    ,  200.00    ,  190.00    ,  180.00    ,
+     $   180.00    /
+      DATA (CSPNEL( 2,J),J=1,41) /
+     $   3800.0    ,  2900.0    ,  1850.0    ,  1550.0    ,  1450.0    ,
+     $   1520.0    ,  1460.0    ,  1300.0    ,  1140.0    ,  880.00    ,
+     $   700.00    ,  620.00    ,  540.00    ,  560.00    ,  460.00    ,
+     $   460.00    ,  470.00    ,  470.00    ,  480.00    ,  480.00    ,
+     $   580.00    ,  600.00    ,  610.00    ,  620.00    ,  620.00    ,
+     $   620.00    ,  590.00    ,  580.00    ,  460.00    ,  440.00    ,
+     $   420.00    ,  400.00    ,  480.00    ,  430.00    ,  380.00    ,
+     $   380.00    ,  380.00    ,  380.00    ,  380.00    ,  380.00    ,
+     $   380.00    /
+      DATA (CSPNEL( 3,J),J=1,41) /
+     $   7000.0    ,  6000.0    ,  4500.0    ,  3350.0    ,  2700.0    ,
+     $   3000.0    ,  3550.0    ,  3970.0    ,  3280.0    ,  2490.0    ,
+     $   2100.0    ,  1510.0    ,  1440.0    ,  1370.0    ,  1370.0    ,
+     $   1370.0    ,  1400.0    ,  1400.0    ,  1420.0    ,  1420.0    ,
+     $   1440.0    ,  1460.0    ,  1460.0    ,  1450.0    ,  1450.0    ,
+     $   1470.0    ,  1400.0    ,  1400.0    ,  1380.0    ,  1370.0    ,
+     $   1360.0    ,  1350.0    ,  1340.0    ,  1330.0    ,  1320.0    ,
+     $   1310.0    ,  1305.0    ,  1300.0    ,  1300.0    ,  1300.0    ,
+     $   1300.0    /
+      DATA (CSPNIN( 1,J),J=1,41) /
+     $  0.00000E+00,  200.00    ,  400.00    ,  800.00    ,  800.00    ,
+     $   550.00    ,  500.00    ,  450.00    ,  430.00    ,  410.00    ,
+     $   400.00    ,  390.00    ,  380.00    ,  370.00    ,  370.00    ,
+     $   370.00    ,  365.00    ,  365.00    ,  360.00    ,  360.00    ,
+     $   360.00    ,  360.00    ,  365.00    ,  370.00    ,  375.00    ,
+     $   380.00    ,  400.00    ,  410.00    ,  420.00    ,  430.00    ,
+     $   440.00    ,  440.00    ,  440.00    ,  440.00    ,  440.00    ,
+     $   440.00    ,  440.00    ,  440.00    ,  440.00    ,  440.00    ,
+     $   440.00    /
+      DATA (CSPNIN( 2,J),J=1,41) /
+     $  0.00000E+00,  400.00    ,  950.00    ,  1050.0    ,  1050.0    ,
+     $   980.00    ,  940.00    ,  900.00    ,  860.00    ,  820.00    ,
+     $   800.00    ,  780.00    ,  760.00    ,  740.00    ,  740.00    ,
+     $   740.00    ,  730.00    ,  730.00    ,  720.00    ,  720.00    ,
+     $   720.00    ,  720.00    ,  730.00    ,  740.00    ,  750.00    ,
+     $   760.00    ,  800.00    ,  820.00    ,  820.00    ,  820.00    ,
+     $   820.00    ,  820.00    ,  820.00    ,  820.00    ,  820.00    ,
+     $   820.00    ,  820.00    ,  820.00    ,  820.00    ,  820.00    ,
+     $   820.00    /
+      DATA (CSPNIN( 3,J),J=1,41) /
+     $  0.00000E+00, 0.00000E+00,  500.00    ,  1450.0    ,  1700.0    ,
+     $   1800.0    ,  1750.0    ,  1730.0    ,  1720.0    ,  1710.0    ,
+     $   1700.0    ,  1690.0    ,  1660.0    ,  1630.0    ,  1630.0    ,
+     $   1630.0    ,  1600.0    ,  1600.0    ,  1580.0    ,  1580.0    ,
+     $   1580.0    ,  1580.0    ,  1600.0    ,  1630.0    ,  1650.0    ,
+     $   1670.0    ,  1760.0    ,  1800.0    ,  1800.0    ,  1800.0    ,
+     $   1800.0    ,  1800.0    ,  1800.0    ,  1800.0    ,  1800.0    ,
+     $   1800.0    ,  1800.0    ,  1800.0    ,  1800.0    ,  1800.0    ,
+     $   1800.0    /
+      DATA ELAB /
+     $  0.10000E-03, 0.20000E-03, 0.30000E-03, 0.40000E-03, 0.50000E-03,
+     $  0.70000E-03, 0.10000E-02, 0.20000E-02, 0.30000E-02, 0.40000E-02,
+     $  0.50000E-02, 0.70000E-02, 0.10000E-01, 0.15000E-01, 0.20000E-01,
+     $  0.25000E-01, 0.32700E-01/
+      DATA CNLWAT /
+     $   1.0000    ,  16.000    ,  27.000    ,  56.000    ,  59.000    ,
+     $   64.000    ,  91.000    ,  112.00    ,  119.00    ,  127.00    ,
+     $   137.00    ,  181.00    ,  207.00    ,  209.00    ,  238.00    /
+      DATA (CNLWEL( 1,J),J=1,17) /
+     $   6000.0    ,  5500.0    ,  5200.0    ,  4900.0    ,  4800.0    ,
+     $   4400.0    ,  4000.0    ,  2900.0    ,  2200.0    ,  1800.0    ,
+     $   1400.0    ,  1100.0    ,  900.00    ,  700.00    ,  600.00    ,
+     $   560.00    ,  520.00    /
+      DATA (CNLWEL( 2,J),J=1,17) /
+     $   5400.0    ,  5050.0    ,  4800.0    ,  4600.0    ,  4399.0    ,
+     $   4090.0    ,  3700.0    ,  2600.0    ,  1950.0    ,  1600.0    ,
+     $   1300.0    ,  900.00    ,  700.00    ,  800.00    ,  1050.0    ,
+     $   1250.0    ,  1320.0    /
+      DATA (CNLWEL( 3,J),J=1,17) /
+     $   5500.0    ,  5150.0    ,  4900.0    ,  4699.0    ,  4490.0    ,
+     $   4150.0    ,  3750.0    ,  2790.0    ,  2100.0    ,  1650.0    ,
+     $   1300.0    ,  950.00    ,  800.00    ,  860.00    ,  1000.0    ,
+     $   1090.0    ,  1080.0    /
+      DATA (CNLWEL( 4,J),J=1,17) /
+     $   5499.0    ,  4970.0    ,  4450.0    ,  4080.0    ,  3750.0    ,
+     $   3380.0    ,  2900.0    ,  2400.0    ,  2380.0    ,  2350.0    ,
+     $   2300.0    ,  2100.0    ,  1720.0    ,  1370.0    ,  1200.0    ,
+     $   1060.0    ,  870.00    /
+      DATA (CNLWEL( 5,J),J=1,17) /
+     $   5399.0    ,  4710.0    ,  4180.0    ,  3760.0    ,  3460.0    ,
+     $   3150.0    ,  2730.0    ,  2270.0    ,  1850.0    ,  1850.0    ,
+     $   2130.0    ,  2330.0    ,  2120.0    ,  1640.0    ,  1310.0    ,
+     $   1100.0    ,  1050.0    /
+      DATA (CNLWEL( 6,J),J=1,17) /
+     $   5099.0    ,  4405.0    ,  3825.0    ,  3455.0    ,  3125.0    ,
+     $   2695.0    ,  2350.0    ,  1850.0    ,  1580.0    ,  1820.0    ,
+     $   2050.0    ,  2210.0    ,  2000.0    ,  1590.0    ,  1310.0    ,
+     $   1120.0    ,  1040.0    /
+      DATA (CNLWEL( 7,J),J=1,17) /
+     $   6290.0    ,  5960.0    ,  5640.0    ,  5370.0    ,  5150.0    ,
+     $   4800.0    ,  4250.0    ,  3150.0    ,  2470.0    ,  2100.0    ,
+     $   2230.0    ,  2420.0    ,  2450.0    ,  2050.0    ,  1760.0    ,
+     $   1550.0    ,  1330.0    /
+      DATA (CNLWEL( 8,J),J=1,17) /
+     $   6885.0    ,  6650.0    ,  6350.0    ,  6150.0    ,  6000.0    ,
+     $   5700.0    ,  5360.0    ,  4250.0    ,  2800.0    ,  1870.0    ,
+     $   1810.0    ,  1820.0    ,  2170.0    ,  2450.0    ,  2150.0    ,
+     $   1700.0    ,  1390.0    /
+      DATA (CNLWEL( 9,J),J=1,17) /
+     $   6600.0    ,  6500.0    ,  6400.0    ,  6249.0    ,  6190.0    ,
+     $   5950.0    ,  5520.0    ,  4250.0    ,  2750.0    ,  1900.0    ,
+     $   1850.0    ,  1950.0    ,  2340.0    ,  2800.0    ,  2540.0    ,
+     $   2100.0    ,  1760.0    /
+      DATA (CNLWEL(10,J),J=1,17) /
+     $   7400.0    ,  7200.0    ,  6999.0    ,  6840.0    ,  6655.0    ,
+     $   6320.0    ,  5820.0    ,  4400.0    ,  2850.0    ,  2000.0    ,
+     $   1800.0    ,  1800.0    ,  2150.0    ,  2600.0    ,  2350.0    ,
+     $   1950.0    ,  2100.0    /
+      DATA (CNLWEL(11,J),J=1,17) /
+     $   7900.0    ,  7700.0    ,  7499.0    ,  7390.0    ,  7202.0    ,
+     $   6810.0    ,  6360.0    ,  4920.0    ,  3450.0    ,  2600.0    ,
+     $   2200.0    ,  1950.0    ,  2300.0    ,  2800.0    ,  2650.0    ,
+     $   2250.0    ,  2050.0    /
+      DATA (CNLWEL(12,J),J=1,17) /
+     $   7900.0    ,  7750.0    ,  7699.0    ,  7590.0    ,  7450.0    ,
+     $   7200.0    ,  6850.0    ,  5650.0    ,  4400.0    ,  3700.0    ,
+     $   3400.0    ,  2800.0    ,  2700.0    ,  3100.0    ,  3250.0    ,
+     $   3100.0    ,  2750.0    /
+      DATA (CNLWEL(13,J),J=1,17) /
+     $   6100.0    ,  5950.0    ,  5750.0    ,  5599.0    ,  5440.0    ,
+     $   5200.0    ,  4800.0    ,  4300.0    ,  5800.0    ,  5750.0    ,
+     $   4800.0    ,  3420.0    ,  2650.0    ,  3200.0    ,  3650.0    ,
+     $   3500.0    ,  2980.0    /
+      DATA (CNLWEL(14,J),J=1,17) /
+     $   6100.0    ,  5950.0    ,  5750.0    ,  5599.0    ,  5440.0    ,
+     $   5200.0    ,  4800.0    ,  4300.0    ,  5800.0    ,  5750.0    ,
+     $   4800.0    ,  3420.0    ,  2650.0    ,  3200.0    ,  3650.0    ,
+     $   3500.0    ,  2980.0    /
+      DATA (CNLWEL(15,J),J=1,17) /
+     $   6600.0    ,  6350.0    ,  6100.0    ,  5899.0    ,  5690.0    ,
+     $   5300.0    ,  4850.0    ,  4450.0    ,  5650.0    ,  5700.0    ,
+     $   4950.0    ,  3850.0    ,  3050.0    ,  3050.0    ,  3460.0    ,
+     $   3650.0    ,  3340.0    /
+      DATA (CNLWIN( 1,J),J=1,17) / 17*0.0E+00 /
+      DATA (CNLWIN( 2,J),J=1,17) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00,  1.0000    ,
+     $   10.000    ,  50.000    ,  100.00    ,  200.00    ,  300.00    ,
+     $   400.00    ,  600.00    ,  700.00    ,  750.00    ,  700.00    ,
+     $   700.00    ,  680.00    /
+      DATA (CNLWIN( 3,J),J=1,17) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00,  1.0000    ,  10.000    ,
+     $   50.000    ,  100.00    ,  260.00    ,  450.00    ,  600.00    ,
+     $   700.00    ,  800.00    ,  900.00    ,  940.00    ,  900.00    ,
+     $   860.00    ,  820.00    /
+      DATA (CNLWIN( 4,J),J=1,17) /
+     $   1.0000    ,  80.000    ,  200.00    ,  320.00    ,  400.00    ,
+     $   520.00    ,  700.00    ,  1000.0    ,  1120.0    ,  1200.0    ,
+     $   1200.0    ,  1200.0    ,  1180.0    ,  1130.0    ,  1100.0    ,
+     $   1090.0    ,  1080.0    /
+      DATA (CNLWIN( 5,J),J=1,17) /
+     $   1.0000    ,  90.000    ,  220.00    ,  340.00    ,  420.00    ,
+     $   550.00    ,  720.00    ,  1080.0    ,  1300.0    ,  1400.0    ,
+     $   1420.0    ,  1420.0    ,  1380.0    ,  1260.0    ,  1190.0    ,
+     $   1150.0    ,  1100.0    /
+      DATA (CNLWIN( 6,J),J=1,17) /
+     $   1.0000    ,  95.000    ,  225.00    ,  345.00    ,  425.00    ,
+     $   555.00    ,  750.00    ,  1150.0    ,  1500.0    ,  1680.0    ,
+     $   1700.0    ,  1690.0    ,  1550.0    ,  1360.0    ,  1240.0    ,
+     $   1180.0    ,  1120.0    /
+      DATA (CNLWIN( 7,J),J=1,17) /
+     $   10.000    ,  140.00    ,  260.00    ,  380.00    ,  450.00    ,
+     $   600.00    ,  750.00    ,  1200.0    ,  1580.0    ,  1800.0    ,
+     $   1820.0    ,  1830.0    ,  1800.0    ,  1750.0    ,  1690.0    ,
+     $   1650.0    ,  1620.0    /
+      DATA (CNLWIN( 8,J),J=1,17) /
+     $   15.000    ,  150.00    ,  300.00    ,  400.00    ,  500.00    ,
+     $   650.00    ,  840.00    ,  1500.0    ,  2100.0    ,  2130.0    ,
+     $   2140.0    ,  2130.0    ,  2080.0    ,  2000.0    ,  1950.0    ,
+     $   1900.0    ,  1860.0    /
+      DATA (CNLWIN( 9,J),J=1,17) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00,  1.0000    ,  10.000    ,
+     $   150.00    ,  380.00    ,  1000.0    ,  1650.0    ,  2100.0    ,
+     $   2100.0    ,  2100.0    ,  2060.0    ,  1950.0    ,  1860.0    ,
+     $   1800.0    ,  1740.0    /
+      DATA (CNLWIN(10,J),J=1,17) /
+     $  0.00000E+00, 0.00000E+00,  1.0000    ,  10.000    ,  45.000    ,
+     $   180.00    ,  380.00    ,  1050.0    ,  1900.0    ,  2300.0    ,
+     $   2300.0    ,  2200.0    ,  2150.0    ,  2000.0    ,  1900.0    ,
+     $   1800.0    ,  1750.0    /
+      DATA (CNLWIN(11,J),J=1,17) /
+     $  0.00000E+00, 0.00000E+00,  1.0000    ,  10.000    ,  48.000    ,
+     $   190.00    ,  390.00    ,  1080.0    ,  2000.0    ,  2400.0    ,
+     $   2400.0    ,  2300.0    ,  2200.0    ,  2100.0    ,  1950.0    ,
+     $   1850.0    ,  1800.0    /
+      DATA (CNLWIN(12,J),J=1,17) /
+     $  0.00000E+00, 0.00000E+00,  1.0000    ,  10.000    ,  50.000    ,
+     $   200.00    ,  400.00    ,  1100.0    ,  2100.0    ,  2500.0    ,
+     $   2500.0    ,  2450.0    ,  2300.0    ,  2100.0    ,  2000.0    ,
+     $   1900.0    ,  1850.0    /
+      DATA (CNLWIN(13,J),J=1,17) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00,  1.0000    ,  10.000    ,
+     $   100.00    ,  350.00    ,  900.00    ,  1400.0    ,  2000.0    ,
+     $   2300.0    ,  2380.0    ,  2400.0    ,  2300.0    ,  2250.0    ,
+     $   2200.0    ,  2120.0    /
+      DATA (CNLWIN(14,J),J=1,17) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00,  1.0000    ,  10.000    ,
+     $   100.00    ,  350.00    ,  900.00    ,  1400.0    ,  2000.0    ,
+     $   2300.0    ,  2380.0    ,  2400.0    ,  2300.0    ,  2250.0    ,
+     $   2200.0    ,  2120.0    /
+      DATA (CNLWIN(15,J),J=1,17) /
+     $  0.00000E+00, 0.00000E+00, 0.00000E+00,  1.0000    ,  10.000    ,
+     $   100.00    ,  400.00    ,  950.00    ,  1600.0    ,  2200.0    ,
+     $   2550.0    ,  2750.0    ,  2700.0    ,  2600.0    ,  2540.0    ,
+     $   2450.0    ,  2360.0    /
+      DATA (CSCAP(J),J=1,50) /
+     $   6.0000    ,  5.7000    ,  5.5000    ,  5.3000    ,  5.2000    ,
+     $   5.1000    ,  5.0000    ,  4.9000    ,  4.8000    ,  4.8000    ,
+     $   4.8000    ,  4.8000    ,  4.8000    ,  4.8000    ,  4.8000    ,
+     $   4.8000    ,  4.9000    ,  5.0000    ,  5.2000    ,  5.5000    ,
+     $   6.0000    ,  6.7000    ,  7.5000    ,  8.5000    ,  10.000    ,
+     $   12.000    ,  14.500    ,  19.000    ,  26.500    ,  40.000    ,
+     $   75.000    ,  120.00    ,  180.00    ,  260.00    ,  360.00    ,
+     $   330.00    ,  60.000    ,  7.0000    ,  9.5000    ,  20.000    ,
+     $   75.000    ,  140.00    ,  250.00    ,  360.00    ,  480.00    ,
+     $   580.00    ,  590.00    ,  500.00    ,  300.00    ,  100.00    /
+      DATA (CSCAP(J),J=51,100) /
+     $   200.00    ,  300.00    ,  400.00    ,  470.00    ,  500.00    ,
+     $   430.00    ,  100.00    ,  20.000    ,  22.000    ,  40.000    ,
+     $   560.00    ,  950.00    ,  1000.0    ,  1000.0    ,  1000.0    ,
+     $   990.00    ,  920.00    ,  860.00    ,  790.00    ,  740.00    ,
+     $   650.00    ,  600.00    ,  540.00    ,  470.00    ,  440.00    ,
+     $   390.00    ,  360.00    ,  340.00    ,  320.00    ,  310.00    ,
+     $   280.00    ,  2.0000    ,  2.5000    ,  6.0000    ,  13.000    ,
+     $   38.000    ,  65.000    ,  140.00    ,  280.00    ,  300.00    ,
+     $   430.00    ,  580.00    ,  650.00    ,  800.00    ,  920.00    ,
+     $   1100.0    ,  1250.0    ,  1400.0    ,  1550.0    ,  1700.0    /
+C --- END OF CROSS SECTION DATA STATEMENTS ---
+ 
+C --- DATA STMTS. FOR GEANT/GHEISHA PARTICLE CODE CONVERSIONS ---
+C --- KIPART(I)=GHEISHA CODE CORRESPONDING TO GEANT   CODE I ---
+C --- IKPART(I)=GEANT   CODE CORRESPONDING TO GHEISHA CODE I ---
+ 
+      DATA KIPART/
+     $               1,   3,   4,   2,   5,   6,   8,   7,
+     $               9,  12,  10,  13,  16,  14,  15,  11,
+     $              35,  18,  20,  21,  22,  26,  27,  33,
+     $              17,  19,  23,  24,  25,  28,  29,  34,
+     $              35,  35,  35,  35,  35,  35,  35,  35,
+     $              35,  35,  35,  35,  30,  31,  32,  35/
+ 
+      DATA IKPART/
+     $               1,   4,   2,   3,   5,   6,   8,   7,
+     $               9,  11,  16,  10,  12,  14,  15,  13,
+     $              25,  18,  26,  19,  20,  21,  27,  28,
+     $              29,  22,  23,  30,  31,  45,  46,  47,
+     $              24,  32,  48/
+ 
+ 
+C     PARAMETER (ONETHR=1./3.)
+      DATA ONETHR   / .33333333/
+      DATA ALPHA    / 6*0.7,
+     +                0.75 ,0.75 ,0.75 ,
+     +                0.76,0.76 ,0.76 ,0.76 ,
+     +                0.685,0.63 ,0.685,0.63,0.685,0.63,
+     +                3*0.685,3*0.63,2*0.685,2*0.63,
+     +                3*0.7,0.685,0.63,0.7/
+      DATA ALPHAC    /1.2,1.2,1.2,1.15,0.90,0.91,0.98,1.06,1.10,1.11,
+     +                1.10,1.08,1.05,1.01,0.985,0.962,0.945,0.932,
+     +                0.925,0.920,0.920,0.921,0.922,0.923,0.928,0.931,
+     +                0.940,0.945,0.950,0.955,0.958,0.962,0.965,0.976,
+     +                0.982,0.988,0.992,1.010,1.020,1.030,1.040/
+      DATA PARTEL/6*0.,29*1./
+      DATA PARTIN/6*0.,1.00,0.00,1.05,1.20,1.35,1.30,1.20,1.00,1.30,
+     +            1.00,1.30,1.00,1.30,1.00,1.00,1.00,1.30,1.30,1.30,
+     +            1.00,1.00,1.30,1.30,1.00,1.,1.,1.,1.3,1./
+      DATA ICORR /14*1, 0, 1, 0, 1, 0, 3*1, 3*0, 2*1, 2*0, 4*1, 2*0/
+C--  SET INTRC TO 0 FOR IPART = 26-29, 33, 34  ( XI'S AND OMEGA'S )
+C-DH- DATA INTRC /6*0, 1, 0, 12*1, 0, 2*2, 0, 1, 4*0, 3*1, 3*0 /
+C--  RESET INTRC FOR IPART = 26-29, 33, 34  ( XI'S AND OMEGA'S )
+      DATA INTRC /6*0, 1, 0, 12*1, 0, 2*2, 0, 10*1, 0/
+ 
+C CROSS SECTIONS ON NUCLEUS ARE KNOWN ONLY FOR PIONS AND PROTONS.
+C THE GENERAL LAW SIGMA(A)=1.25*SIGMA(TOT,PROTON)*A**ALPHA IS VALID
+C ONLY FOR MOMENTA > 2 GEV.THE PARAMETRIZATION DONE HERE GIVES ONLY
+C A BEHAVIOUR AVERAGED OVER MOMENTA AND PARTICLE TYPES.
+C FOR A DETECTOR WITH ONLY A FEW MATERIALS IT'S OF COURSE MUCHBETTER
+C TO USE TABLES OF THE MEASURED CROSS SECTIONS .
+C FOR ELEMENTS WITH THE FOLLOWING ATOMIC NUMBERS MEASURED CROSS
+C SECTIONS ARE AVAILABLE (SEE "PCSDATA").
+ 
+C                 H   AL     CU     PB
+      DATA  CSA  /1. ,27.00 ,63.54 ,207.19 /
+      DATA IPART2/9,8,7,11,10,13,12/
+      SAVE ALPHA,ALPHAC,PARTEL,PARTIN,CSA,IPART2,ICORR,INTRC
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) THEN
+         WRITE(MDEBUG,*) 'CGHSIG:'
+         NPRT(4)=.TRUE.
+         NPRT(9)=.TRUE.
+      ENDIF
+ 
+C --- INITIALISE CGHSIG AND SWITCH TO GHEISHA PARTICLE CODE ---
+      CGHSIG=0.0
+      IF     ( LPART .LE.  48 ) THEN
+         IPART = KIPART(LPART)
+      ELSEIF ( LPART .EQ. 201 ) THEN
+         IPART = 30
+      ELSEIF ( LPART .EQ. 301 ) THEN
+         IPART = 31
+      ELSEIF ( LPART .EQ. 402 ) THEN
+         IPART = 32
+      ELSE
+         GOTO 160
+      ENDIF
+ 
+C --- NO INTERACTION FOR GAMMAS, NEUTRINOS, ELECTRONS, POSITRONS, MUONS,
+C --- NEUTRAL PIONS, NEUTRAL SIGMAS AND ANTISIGMAS AND NEW PARTICLES.
+      IF(INTRC(IPART).EQ. 0) GO TO 160
+      P=PPART
+      EK=EKIN
+ 
+C --- INITIALISE THE CROSS-SECTIONS WITH 0.0 ---
+      DO 10  K=1,KK
+         AIEL(K)=0.0
+         AIIN(K)=0.0
+         AICA(K)=0.0
+   10 CONTINUE
+C
+      IF     ((IPART .GE. 30) .AND. (IPART .LE. 32)) THEN
+ 
+C --- TAKE GEOMETRICAL CROSS SECTIONS FOR INELASTIC SCATTERING ---
+C --- OF DEUTERONS, TRITONS AND ALPHAS ---
+         IF     ( IPART .EQ. 30 ) THEN
+            APART=2.0**ONETHR
+         ELSEIF ( IPART .EQ. 31 ) THEN
+            APART=3.0**ONETHR
+         ELSEIF ( IPART .EQ. 32 ) THEN
+            APART=4.0**ONETHR
+         ENDIF
+         DO 20 K=1,KK
+            AIIN(K)=49.0*(APART+ACOMP(K)**ONETHR)**2
+   20    CONTINUE
+         IF (NPRT(9)) WRITE(MDEBUG,10000)
+ 
+      ELSEIF ((IPART .EQ. 16) .AND. (EK .LE. 0.0327)) THEN
+ 
+C --- USE TABLES FOR LOW ENERGY NEUTRONS ---
+C --- GET ENERGY BIN ---
+         JE2=17
+         DO 30 J=2,17
+            IF (EK .LT. ELAB(J)) THEN
+               JE2=J
+               GO TO 40
+            ENDIF
+   30    CONTINUE
+ 
+   40    JE1=JE2-1
+         EKX=MAX(EK,1.0E-9)
+         DELAB=ELAB(JE2)-ELAB(JE1)
+         DO 70 K=1,KK
+ 
+C --- GET A BIN ---
+            JA2=15
+            DO 50 J=2,15
+               IF (ACOMP(K) .LT. CNLWAT(J)) THEN
+                  JA2=J
+                  GO TO 60
+               ENDIF
+   50       CONTINUE
+ 
+   60       JA1=JA2-1
+            DNLWAT=CNLWAT(JA2)-CNLWAT(JA1)
+ 
+C --- USE LINEAR INTERPOLATION OR EXTRAPOLATION BY Y=RCE*X+RCA*X+B ---
+ 
+C --- ELASTIC CROSS SECTION ---
+C --- E INTERPOLATION OR EXTRAPOLATION AT JA1 ---
+            DY=CNLWEL(JA1,JE2)-CNLWEL(JA1,JE1)
+            RCE=DY/DELAB
+C --- A INTERPOLATION OR EXTRAPOLATION AT JE1 ---
+            DY=CNLWEL(JA2,JE1)-CNLWEL(JA1,JE1)
+            RCA=DY/DNLWAT
+            B=CNLWEL(JA1,JE1)-RCE*ELAB(JE1)-RCA*CNLWAT(JA1)
+            AIEL(K)=RCE*EK+RCA*ACOMP(K)+B
+ 
+C --- INELASTIC CROSS SECTION ---
+C --- E INTERPOLATION OR EXTRAPOLATION AT JA1 ---
+            DY=CNLWIN(JA1,JE2)-CNLWIN(JA1,JE1)
+            RCE=DY/DELAB
+C --- A INTERPOLATION OR EXTRAPOLATION AT JE1 ---
+            DY=CNLWIN(JA2,JE1)-CNLWIN(JA1,JE1)
+            RCA=DY/DNLWAT
+            B=CNLWIN(JA1,JE1)-RCE*ELAB(JE1)-RCA*CNLWAT(JA1)
+            AIIN(K)=RCE*EK+RCA*ACOMP(K)+B
+ 
+            IZNO=ZCOMP(K)+0.01
+            AICA(K)=11.12*CSCAP(IZNO)/(EKX*1.0E6)**0.577
+   70    CONTINUE
+         IF (NPRT(9)) WRITE(MDEBUG,10100)
+      ELSE
+ 
+C --- USE PARAMETRIZATION OF CROSS SECTION DATA FOR ALL OTHER CASES ---
+ 
+         IF (NPRT(9)) WRITE(MDEBUG,10200)
+ 
+C --- GET MOMENTUM BIN ---
+         J=40
+         DO 80 I=2,41
+            IF (P .LT. PLAB(I)) THEN
+               J=I-1
+               GO TO 90
+            ENDIF
+   80    CONTINUE
+ 
+C --- START WITH  CROSS SECTIONS FOR SCATTERING ON FREE PROTONS ---
+C --- USE LINEAR INTERPOLATION OR EXTRAPOLATION BY Y=RC*X+B     ---
+   90    DX=PLAB(J+1)-PLAB(J)
+C --- ELASTIC CROSS SECTION ---
+         DY=CSEL(IPART,J+1)-CSEL(IPART,J)
+         RC=DY/DX
+         B=CSEL(IPART,J)-RC*PLAB(J)
+         AIELIN=RC*P+B
+C --- INELASTIC CROSS SECTION ---
+         DY=CSIN(IPART,J+1)-CSIN(IPART,J)
+         RC=DY/DX
+         B=CSIN(IPART,J)-RC*PLAB(J)
+         AIININ=RC*P+B
+         ALPH=ALPHA(IPART)
+         IF(IPART.LT.14) THEN
+            DY=ALPHAC(J+1)-ALPHAC(J)
+            RC=DY/DX
+            B=ALPHAC(J)-RC*PLAB(J)
+            CORFAC=RC*P+B
+            ALPH=ALPH*CORFAC
+ 
+            IPART3=IPART2(IPART-6)
+ 
+C --- ELASTIC CROSS SECTION ---
+            DY=CSEL(IPART3,J+1)-CSEL(IPART3,J)
+            RC=DY/DX
+            B=CSEL(IPART3,J)-RC*PLAB(J)
+            XSECEL=RC*P+B
+C --- INELASTIC CROSS SECTION ---
+            DY=CSIN(IPART3,J+1)-CSIN(IPART3,J)
+            RC=DY/DX
+            B=CSIN(IPART3,J)-RC*PLAB(J)
+            XSECIN=RC*P+B
+ 
+         ENDIF
+ 
+         DO 100 K=1,KK
+            AIEL(K)=AIELIN
+            AIIN(K)=AIININ
+ 
+            IF (ACOMP(K) .GE. 1.5) THEN
+ 
+C --- A-DEPENDENCE FROM PARAMETRIZATION ---
+               CREL=1.0
+               CRIN=1.0
+C --- GET MEDIUM BIN  1=HYDR.  2=AL  3=CU  4=PB ---
+               I=3
+               IF (ACOMP(K) .LT. 50.0) I=2
+               IF (ACOMP(K) .GT. 100.0) I=4
+               IF     ((IPART .EQ. 14) .OR. (IPART .EQ. 16)) THEN
+ 
+C --- PROTONS AND NEUTRONS ---
+ 
+C --- ELASTIC CROSS SECTION ---
+                  DY=CSPNEL(I-1,J+1)-CSPNEL(I-1,J)
+                  RC=DY/DX
+                  B=CSPNEL(I-1,J)-RC*PLAB(J)
+                  XSECEL=RC*P+B
+C --- INELASTIC CROSS SECTION ---
+                  DY=CSPNIN(I-1,J+1)-CSPNIN(I-1,J)
+                  RC=DY/DX
+                  B=CSPNIN(I-1,J)-RC*PLAB(J)
+                  XSECIN=RC*P+B
+                  IF (AIEL(K) .GE. 0.001) CREL=XSECEL/(0.36*AIEL(K)*
+     +            CSA(I)**1.17)
+                  AITOT=AIEL(K)+AIIN(K)
+                  IF (AITOT .GE. 0.001) CRIN=XSECIN/(AITOT*CSA(I)**
+     +            ALPH)
+ 
+               ELSEIF (IPART .LT. 15) THEN
+ 
+C --- CALCULATE CORRECTION FACTORS FROM VALUES ON AL,CU,PB FOR ALL ---
+C --- MESONS USE LINEAR INTERPOLATION OR EXTRAPOLATION BY Y=RC*X+B ---
+C --- NOTE THAT DATA IS ONLY AVAILABLE FOR PIONS AND PROTONS
+                  WGCH=0.5
+               IF (ACOMP(K) .LT. 20.0) WGCH=0.5+0.5*EXP(-(ACOMP(K)-1.0))
+                  AIEL(K)=WGCH*AIEL(K)+(1.0-WGCH)*XSECEL
+                  AIIN(K)=WGCH*AIIN(K)+(1.0-WGCH)*XSECIN
+ 
+C --- THIS SECTION NOT FOR KAONS ---
+                  IF (IPART .LT. 10) THEN
+ 
+C --- ELASTIC CROSS SECTION ---
+                     DY=CSPIEL(I-1,J+1)-CSPIEL(I-1,J)
+                     RC=DY/DX
+                     B=CSPIEL(I-1,J)-RC*PLAB(J)
+                     XSPIEL=RC*P+B
+C --- INELASTIC CROSS SECTION ---
+                     DY=CSPIIN(I-1,J+1)-CSPIIN(I-1,J)
+                     RC=DY/DX
+                     B=CSPIIN(I-1,J)-RC*PLAB(J)
+                     XSPIIN=RC*P+B
+ 
+                     IF (AIEL(K) .GE. 0.001) CREL=XSPIEL/(0.36* AIEL(K)
+     +               *CSA(I)**1.17)
+                     AITOT=AIEL(K)+AIIN(K)
+                     IF (AITOT .GE. 0.001) CRIN=XSPIIN/(AITOT*CSA(I)
+     +               **ALPH)
+                  ENDIF
+               ENDIF
+               AIIN(K)=CRIN*(AIIN(K)+AIEL(K))*ACOMP(K)**ALPH
+               AIEL(K)=CREL*0.36*AIEL(K)*ACOMP(K)**1.17
+               AIEL(K)=AIEL(K)*PARTEL(IPART)
+               AIIN(K)=AIIN(K)*PARTIN(IPART)
+            ENDIF
+  100    CONTINUE
+ 
+      ENDIF
+ 
+C --- CALCULATE INTERACTION PROBABILITY ---
+ 
+      ALAM=0.0
+      DO 150 K=1,KK
+         AIEL(K) = AIEL(K)*WCOMP(K)
+         AIIN(K) = AIIN(K)*WCOMP(K)
+         AICA(K) = AICA(K)*WCOMP(K)
+         ALAM = ALAM + AIEL(K) + AIIN(K) + AICA(K)
+  150 CONTINUE
+ 
+C --- PASS THE CROSS SECTION (MBARN) TO CORSIKA ---
+      CGHSIG=ALAM
+ 
+      GO TO 999
+ 
+C --- PRINTOUT OF SKIPPED PARTICLES IN CASE OF INTERFACE DEBUG ---
+  160 IF (NPRT(9)) WRITE(MDEBUG,10300) IPART
+10000 FORMAT(' *CGHSIG* GEOM X-SECT. FOR INEL. SCAT. OF D,T AND ALPHA')
+10100 FORMAT(' *CGHSIG* X-SECT. FROM LOW ENERGY NEUTRON TABLES')
+10200 FORMAT(' *CGHSIG* X-SECT. FROM PARAMETRIZATION OF DATA')
+10300 FORMAT(' *CGHSIG* GHEISHA PARTICLE ',I3,' SKIPPED')
+  999 RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/chisq.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/chisq.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/chisq.f	(revision 286)
@@ -0,0 +1,85 @@
+      DOUBLE PRECISION FUNCTION CHISQ(F)
+ 
+C-----------------------------------------------------------------------
+C  CHI SQ(UARE)
+C
+C  THIS FUNCTION CALCULATES THE CHI**2 OBTAINED WITH THE FITFUNCTION
+C  AMOEBA USING THE PARAMETER SET F
+C    F(1) = HEIGHT AT MAXIMUM
+C    F(2) = SHOWER STARTING POINT
+C    F(3) = T AT MAXIMUM
+C    F(4) = WIDTH PARAMETER 1
+C    F(5) = WIDTH PARAMETER 2 T
+C    F(6) = WIDTH PARAMETER 3 T**2
+C  THIS FUNCTION IS CALLED FROM LONGFT AND FROM AMOEBA
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CURVE.
+      COMMON /CURVE/   CHAPAR,DEP,ERR,NSTP
+      DOUBLE PRECISION CHAPAR(1100),DEP(1100),ERR(1100)
+      INTEGER          NSTP
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION AUXIL,BALL,BASE,EXPO,F(6),T
+      INTEGER          I
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'CHISQ : PARAMETERS =',F
+ 
+C  EXCLUDE PATHOLOGICAL PARAMETER SETTINGS
+      IF ( F(1) .LE. 0.D0  .OR.  F(2) .GE. F(3)  .OR.
+     *    (F(4).EQ.0.D0 .AND. F(5).EQ.0.D0 .AND. F(6).EQ.0.D0) ) THEN
+        CHISQ = 1.D16
+        RETURN
+      ENDIF
+ 
+      CHISQ = 0.D0
+C  LOOP OVER THE LONGITUDINAL DISTRIBUTION
+      DO 1 I=1,NSTP
+        T = DEP(I)
+        IF ( T .GT. F(2) ) THEN
+          BASE  = (T-F(2)) / (F(3)-F(2))
+          AUXIL = F(4) + T*F(5) + T**2*F(6)
+          IF ( AUXIL .LT. 1.D-20 ) THEN
+            CHISQ = CHISQ + 1.D16
+            GOTO 1
+          ENDIF
+          EXPO  = (F(3)-T) / AUXIL
+CC        IF(DEBUG)WRITE(MDEBUG,*)'CHISQ : I,BASE,EXPO=',I,
+CC   *                            SNGL(BASE),SNGL(EXPO)
+          BALL = F(1) * BASE ** EXPO
+        ELSE
+          BALL = 0.D0
+        ENDIF
+        CHISQ = CHISQ + ((BALL-CHAPAR(I))/ERR(I))**2
+ 1    CONTINUE
+      CHISQ = CHISQ / (NSTP-6)
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'CHISQ : CHI**2 =',SNGL(CHISQ)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/compt.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/compt.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/compt.f	(revision 286)
@@ -0,0 +1,129 @@
+      SUBROUTINE COMPT
+C                                VERSION 4.00  --  26 JAN 1986/1900
+C******************************************************************
+C   BUTCHER AND MESSEL'S CROSS SECTION EXPRESSION IS USED
+C   (BUTCHER AND MESSEL, OP.CIT., P. 17-19,25), BUT THE
+C   1/EPSILON PART IS NOT SAMPLED IN THE WAY THAT THEY DO.
+C   THIS ROUTINE CALLS THEIR 'EPSILON' VARIABLE BY THE NAME 'BR'.
+C   BR=FINAL PHOTON ENERGY /INITIAL PHOTON ENERGY.
+C   BR0 = MINIMUM BR = 1./(1.+2.*(E(NP)/RM))
+C   MAXIMUM BR IS 1.
+C   BUTCHER AND MESSEL'S EXPRESSION FOR THE DIFFERENTIAL CROSS
+C   SECTION IS PROPORTIONAL TO
+C        (1./BR+BR)*(1.-BR*SINTHE**2/(1.+BR*BR))
+C   WE SHALL SAMPLE FROM THE FIRST FACTOR FROM THE INTERVAL (BR0,1)
+C   AND USE THE SECOND FACTOR AS A REJECTION FUNCTION.
+C******************************************************************
+      DOUBLE PRECISION PEIG,PESG,PESE
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' COMPT: NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      PEIG=E(NP)
+      EIG=PEIG
+      EGP=EIG*RMI
+      BR0I=1.+2.*EGP
+      BR0=1./BR0I
+      ALPH1=LOG(BR0I)
+      ALPH2=EGP*(BR0I+1.)*BR0*BR0
+      SUMALP = ALPH1+ALPH2
+371   CONTINUE
+       CALL RMMAR(RNNO15,1,2)
+       IF (ALPH1.GE.SUMALP*RNNO15) THEN
+        CALL RMMAR(RNNO16,1,2)
+        BR=EXP(ALPH1*RNNO16)*BR0
+       ELSE
+        CALL RMMAR(RD,2,2)
+        BRP=RD(1)
+        RNNO18=RD(2)
+        IF (EGP.GE.(EGP+1.)*RNNO18) THEN
+         CALL RMMAR(RNNO19,1,2)
+         BRP=MAX(BRP,RNNO19)
+        END IF
+        BR=((BR0I-1.)*BRP+1.)*BR0
+       END IF
+       ESG=BR*EIG
+       A1MIBR = 1.-BR
+       TEMP=RM*A1MIBR/ESG
+       SINTHE=MAX(0.0,TEMP*(2.0-TEMP))
+       CALL RMMAR(RNNO20,1,2)
+       IF(((1.0-RNNO20)*(1.0+BR*BR).GE.BR*SINTHE))GO TO372
+      GO TO 371
+372   CONTINUE
+      SINTHE=SQRT(SINTHE)
+      COSTHE=1.0-TEMP
+      PESG=ESG
+      PESE=PEIG-PESG+PRM
+      ESE=PESE
+      CALL UPHI(2,1)
+      NP=NP+1
+      PSQ=ESE*ESE-RMSQ
+      IF (PSQ.LE.0.0) THEN
+       COSTHE=0.
+       SINTHE=-1.
+      ELSE
+       COSTHE=(ESE+ESG)*A1MIBR/SQRT(PSQ)
+       SINTHE=-SQRT(MAX(0.0,1.0-COSTHE*COSTHE))
+      END IF
+      CALL UPHI(3,2)
+      IF (ESE.LE.ESG) THEN
+       IQ(NP)=3
+       E(NP)=PESE
+       E(NP-1)=PESG
+      ELSE
+       IQ(NP)=1
+       IQ(NP-1)=3
+       E(NP)=PESG
+       E(NP-1)=PESE
+       T=U(NP)
+       U(NP)=U(NP-1)
+       U(NP-1)=T
+       T=V(NP)
+       V(NP)=V(NP-1)
+       V(NP-1)=T
+       T=W(NP)
+       W(NP)=W(NP-1)
+       W(NP-1)=T
+      END IF
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/coorin.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/coorin.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/coorin.f	(revision 286)
@@ -0,0 +1,67 @@
+      SUBROUTINE COORIN( HEIGHT )
+ 
+C-----------------------------------------------------------------------
+C  COOR(DINATE) IN(ITIALIZATION)
+C
+C  INITIALIZES COORDINATE CORRECTION FOR EACH OBSERVATION LEVEL
+C  ROUTINE SHOULD BE CALLED AFTER HEIGHT OF FIRST INTERACTION IS
+C  DETERMINED. X,Y COORDINATES OF 1. INERACTION ARE ASSUMED TO BE 0,0.
+C  THIS SUBROUTINE IS CALLED FROM MAIN, ELECTR, AND PHOTON
+C  ARGUMENT:
+C   HEIGHT = HEIGHT OF 1. INTERACTION
+C
+C  AUTHOR  : J. KNAPP   IK1  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION DXY,HEIGHT,TANTE
+      INTEGER          I
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'COORIN: HEIGHT,THETA,PHI =',
+     *                     SNGL(HEIGHT),SNGL(THETAP),SNGL(PHIP)
+ 
+      TANTE = TAN( THETAP )
+      DO  1  I = 1,NOBSLV
+        DXY     = TANTE * ( HEIGHT - OBSLEV(I) )
+        XOFF(I) = COS( PHIP ) * DXY
+        YOFF(I) = SIN( PHIP ) * DXY
+    1 CONTINUE
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,100)
+     *                    (OBSLEV(I),XOFF(I),YOFF(I),I=1,NOBSLV)
+  100 FORMAT(' COORIN: OBSLVL,XOFF,YOFF= ',1P,3E12.4)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/datac.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/datac.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/datac.f	(revision 286)
@@ -0,0 +1,1073 @@
+      SUBROUTINE DATAC
+ 
+C-----------------------------------------------------------------------
+C  DATA C(ARDS)
+C
+C  READS DATA CARDS FROM UNIT 5 TO STEER RUN.
+C  READING IS FREE FORMAT WITH BLANK AS SEPARATOR.
+C  EACH KEYWORD STARTS ON A NEW LINE LEFTSHIFTED.
+C  THIS SUBROUTINE IS CALLED FROM START
+C
+C  AUTHOR  : J. KNAPP   IK1  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+c      IMPLICIT NONE
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c All this lines are under test
+c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+      parameter (xct=1)
+      parameter (yct=2)
+      parameter (zct=3)
+      parameter (ctthet=4)
+      parameter (ctphi=5)
+      parameter (ctdiam=6)
+      parameter (ctfoc=7)
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+*KEEP,DPMFLG.
+      COMMON /DPMFLG/  NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+      INTEGER          NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEEP,ETHMAP.
+      COMMON /ETHMAP/  ECTMAP,ELEFT
+      DOUBLE PRECISION ECTMAP,ELEFT
+*KEEP,LONGI.
+      COMMON /LONGI/   APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
+     *                 NSTEP,LLONGI,FLGFIT
+      DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
+     *                 SPLONG(0:1040,9),THSTEP,THSTPI
+      INTEGER          NSTEP
+      LOGICAL          LLONGI,FLGFIT
+*KEEP,MAGANG.
+      COMMON /MAGANG/  ARRANG,ARRANR,COSANG,SINANG
+      DOUBLE PRECISION ARRANG,ARRANR,COSANG,SINANG
+*KEEP,MAGNET.
+      COMMON /MAGNET/  BX,BZ,BVAL,BNORMC,BNORM,COSB,SINB,BLIMIT
+      DOUBLE PRECISION BX,BZ,BVAL,BNORMC
+      REAL             BNORM,COSB,SINB,BLIMIT
+*KEEP,MUMULT.
+      COMMON /MUMULT/  CHC,OMC,FMOLI
+      DOUBLE PRECISION CHC,OMC
+      LOGICAL          FMOLI
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,NKGI.
+      COMMON /NKGI/    SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
+     *                 DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
+     *                 OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
+      DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
+     *                 ZSL(10),DIST(10),
+     *                 DISX(-10:10),DISY(-10:10),
+     *                 DISXY(-10:10,2),DISYX(-10:10,2),
+     *                 DLAX (-10:10,2),DLAY (-10:10,2),
+     *                 DLAXY(-10:10,2),DLAYX(-10:10,2),
+     *                 OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
+      INTEGER          IALT(2)
+*KEEP,PRIMSP.
+      COMMON /PRIMSP/  PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX,ISPEC
+      DOUBLE PRECISION PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX
+      INTEGER          ISPEC
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,REJECT.
+      COMMON /REJECT/  AVNREJ,
+     *                 ALTMIN,ANEXP,THICKA,THICKD,CUTLN,EONCUT,
+     *                 FNPRIM
+      DOUBLE PRECISION AVNREJ(10)
+      REAL             ALTMIN(10),ANEXP(10),THICKA(10),THICKD(10),
+     *                 CUTLN,EONCUT
+      LOGICAL          FNPRIM
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,VENPAR.
+      COMMON /VENPAR/  PARVAL,NPARAM,PARCHA
+      REAL             PARVAL(100)
+      INTEGER          NPARAM
+      CHARACTER*6      PARCHA(100)
+*KEEP,VENUS.
+      COMMON /VENUS/   ISH0,IVERVN,MTAR99,FVENUS,FVENSG
+      INTEGER          ISH0,IVERVN,MTAR99
+      LOGICAL          FVENUS,FVENSG
+*KEEP,CEREN1.
+      COMMON /CEREN1/  CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD,
+     *                 CERSIZ,LCERFI
+      DOUBLE PRECISION CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD
+      REAL             CERSIZ
+      LOGICAL          LCERFI
+*KEEP,CEREN2.
+      COMMON /CEREN2/  PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS,CERYOS,
+     *                 NCERX,NCERY,ICERML
+      REAL             PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS(20),CERYOS(20)
+      INTEGER          NCERX,NCERY,ICERML
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c All this lines are under test
+c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+*keep,certel.
+      common /certel/  cormxd,cord,coralp,ctpars,omega,
+     +                 photn,photnp,phpt,pht,vphot,
+     +                 vchi,veta,vzeta,vchim,vetam,vzetam,
+     +                 lambda,mu,nu,nctels,ncph
+      double precision cormxd,cord,coralp,ctpars(20,7),omega(20,3,3),
+     +                 photn(3),photnp(3),phpt(3),pht,vphot(3),
+     +                 vchi(3),veta(3),vzeta(3),vchim,vetam,vzetam,
+     +                 lambda,mu,nu
+      integer          nctels,ncph(5)
+      double precision xg,yg,zg,xgp,ygp,zgp,up,vp,wp,xpcut,ypcut,zpcut
+      equivalence (photn(1) ,xg)   ,(photn(2) ,yg)   ,(photn(3) ,zg)  ,
+     +            (photnp(1),xgp)  ,(photnp(2),ygp)  ,(photnp(3),zgp),
+     +            (phpt(1)  ,xpcut),(phpt(2)  ,ypcut),(phpt(3)  ,zpcut),
+     +            (vphot(1) ,up)   ,(vphot(2) ,vp)   ,(vphot(3) ,wp)    
+      character *72 ctfile
+
+      character *6  keyw
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c     Angles for the "spinning" of a particle around the 
+c     main axis of the CT
+      common /spinang/ spinxi
+      double precision spinxi
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+*KEND.
+ 
+      DOUBLE PRECISION R1,R2
+      INTEGER          I,IE,IOBSLV,IS,ISEQ,MMM,MONNEW,NNTYP
+      INTEGER          IPARAM
+      CHARACTER        LINE*80, CFMTF*7, CFMTI*5, CFMTL*4
+      DATA             CFMTF/'(F10.0)'/, CFMTI/'(I11)'/, CFMTL/'(L1)'/
+C-----------------------------------------------------------------------
+ 
+C  WRITE TITEL
+      WRITE(MONIOU,999)
+ 999  FORMAT(' ',10('='),' USERS RUN DIRECTIVES FOR THIS SIMULATION ',
+     *    27('=')/)
+ 
+C  DEFAULT VALUES FOR ALL RUN PARAMETERS
+      ISEQ = 0
+      NSEQ = 2
+      ISEED(1,1) = 1
+      ISEED(2,1) = 0
+      ISEED(3,1) = 0
+      ISEED(1,2) = 2
+      ISEED(2,2) = 0
+      ISEED(3,2) = 0
+      ISEED(1,3) = 3
+      ISEED(2,3) = 0
+      ISEED(3,3) = 0
+      NRRUN     = 1
+      SHOWNO    = 0
+      LLIMIT    = 1.D4
+      ULIMIT    = 1.D4
+      PSLOPE    = 0.D0
+      PRMPAR(1) = 14.D0
+      THETPR(1) = 0.D0
+      THETPR(2) = 0.D0
+      PHIPR(1)  = 0.D0
+      PHIPR(2)  = 0.D0
+      NSHOW     = 10
+      IOBSLV    = 0
+      NOBSLV    = 1
+      OBSLEV(1) = 110.D2
+      ELCUT(1)  = 0.3D0
+      ELCUT(2)  = 0.3D0
+      ELCUT(3)  = 0.003D0
+      ELCUT(4)  = 0.003D0
+      ECTMAP  = 1.D4
+      NFLAIN  = 0
+      NFLDIF  = 0
+      NFLPI0  = 0
+      NFLPIF  = 0
+      NFLCHE  = 0
+      NFRAGM  = 0
+      FNKG    = .TRUE.
+      FMOLI   = .TRUE.
+      FMUADD  = .FALSE.
+      FEGS    = .FALSE.
+      STEPFC  = 10.
+      MAXPRT  = 10
+      BX      = 20.D0
+      BZ      = 42.8D0
+      ARRANG  =  0.D0
+      LLONGI  = .FALSE.
+      FLGFIT  = .FALSE.
+      THSTEP  = 20.D0
+      RADNKG  = 200.D2
+C  BORDER BETWEEN LOW AND HIGH ENERGY INTERACTION MODELS
+C  SET BY DEFAULT TO ELAB = 80 GEV
+      HILOELB = 80.D0
+      GHEISH  = .TRUE.
+      FDBASE  = .TRUE.
+      DEBUG   = .FALSE.
+      DEBDEL  = .FALSE.
+      NDEBDL  = 100000000
+      THICK0  = 0.D0
+      FIX1I   = .FALSE.
+      FIXHEI  = 0.D0
+      DSN     =
+     *'ANYNAMEUPTO64CHARACTERS                                         '
+      HOST    = '                    '
+      USER    = '                    '
+      WAVLGL  = 300.D0
+      WAVLGU  = 450.D0
+      CERSIZ  = 0.
+      NCERX   = 27
+      NCERY   = 27
+      DCERX   = 1500.
+      DCERY   = 1500.
+      ACERX   = 100.
+      ACERY   = 100.
+      LCERFI  = .TRUE.
+      ICERML  = 1
+      XSCATT  = 0.
+      YSCATT  = 0.
+      DO  554  I = 1,20
+        CERXOS(I) = 0.
+        CERYOS(I) = 0.
+ 554  CONTINUE
+      FVENUS  =.TRUE.
+      ISH0    = 91
+      IPARAM  = 0
+      NPARAM  = 0
+      DO  555  I = 1,100
+        PARVAL(I) = 0.
+ 555  CONTINUE
+      FVENSG  =.FALSE.
+ 
+C-----------------------------------------------------------------------
+C  OPEN DATASET FOR COMMANDS
+      IF ( MONIIN .NE. 5 ) THEN
+        OPEN(UNIT=MONIIN,FILE='INPUTS',STATUS='OLD',FORM='FORMATTED')
+        WRITE(MONIOU,*) 'DATA CARDS FOR RUN STEERING ARE ',
+     *                  'EXPECTED FROM UNIT',MONIIN
+      ELSE
+        WRITE(MONIOU,*) 'DATA CARDS FOR RUN STEERING ARE ',
+     *                  'EXPECTED FROM STANDARD INPUT'
+      ENDIF
+ 
+C-----------------------------------------------------------------------
+ 1    CONTINUE
+ 
+C  ERASE 'LINE' BY FILLING WITH BLANKS
+      DO 2 I=1,80
+        LINE(I:I) = ' '
+ 2    CONTINUE
+ 
+C  GET A NEW INPUT LINE AND PRINT IT
+      READ(MONIIN,500,END=1000) LINE
+ 500  FORMAT(A80)
+      IF (DEBUG) THEN
+        WRITE(MDEBUG,501) LINE
+ 501    FORMAT(' DATAC : ',A80)
+      ELSE
+        WRITE(MONIOU,502) LINE
+ 502    FORMAT(' ',A80)
+      ENDIF
+ 
+C  CONVERT LOWER CASE CHARACTERS TO UPPER CASE
+      DO 3 I=1,5
+        CALL LOWUP(LINE(I:I))
+ 3    CONTINUE
+      IF ( LINE(1:4).NE.'HOST' .AND. LINE(1:4).NE.'USER' ) THEN
+        CALL LOWUP(LINE(6:6))
+        IF ( LINE(1:6).NE.'DIRECT' .AND. LINE(1:6).NE.'HISTDS' ) THEN
+          DO 4 I=7,80
+            CALL LOWUP(LINE(I:I))
+ 4        CONTINUE
+        ENDIF
+      ENDIF
+ 
+C-----------------------------------------------------------------------
+C  INTERPRET KEYWORD AND READ PARAMETERS
+ 
+C  DUMMY LINE (MAY BE USED FOR COMMENTS) NO ACTION
+      IF     ( LINE(1:6) .EQ. '      ' ) THEN
+      ELSEIF ( LINE(1:1) .EQ. '*'      ) THEN
+      ELSEIF ( LINE(1:2) .EQ. 'C '     ) THEN
+ 
+C  GET ANGLE (DEGREES) BETWEEN ARRAY X-DIRCTION AND MAGNETIC NORD
+      ELSEIF ( LINE(1:6) .EQ. 'ARRANG' ) THEN
+        IS = 6
+ 11     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 11
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) ARRANG
+ 
+C  GET CERENKOV ARRAY SPECIFICATIONS
+      ELSEIF ( LINE(1:6) .EQ. 'CERARY' ) THEN
+        IS = 6
+ 21     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 21
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) NCERX
+        IS = IE
+ 22     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 22
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) NCERY
+        IS = IE
+ 23     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 23
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) DCERX
+        IS = IE
+ 24     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 24
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) DCERY
+        IS = IE
+ 25     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 25
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) ACERX
+        IS = IE
+ 26     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 26
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) ACERY
+ 
+C  GET CERENKOV OUTPUT FLAG
+      ELSEIF ( LINE(1:6) .EQ. 'CERFIL' ) THEN
+        IS = 6
+ 31     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 31
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTL) LCERFI
+ 
+C  GET MAXIMUM BUNCH SIZE FOR CERENKOV PHOTONS
+      ELSEIF ( LINE(1:6) .EQ. 'CERSIZ' ) THEN
+        IS = 6
+ 36     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 36
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) CERSIZ
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C  get maximum "xi" angle, respecto to the CT direction
+      ELSEIF ( LINE(1:3) .EQ. 'XIP' ) THEN
+        IS = 3
+ 41     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 41
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) spinxi
+ 
+C  GET CERENKOV EVENT SCATTERING INFORMATION
+      ELSEIF ( LINE(1:5) .EQ. 'CSCAT' ) THEN
+        IS = 5
+ 43     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 43
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) ICERML
+        IS = IE
+ 44     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 44
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) XSCATT
+        IS = IE
+ 45     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 45
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) YSCATT
+ 
+C  GET CERENKOV WAVELENGTH BAND
+      ELSEIF ( LINE(1:6) .EQ. 'CWAVLG' ) THEN
+        IS = 6
+ 46     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 46
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) R1
+        IS = IE
+ 47     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 47
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) R2
+        WAVLGL = MIN( R1, R2 )
+        WAVLGU = MAX( R1, R2 )
+ 
+C  GET DATABASE FLAG
+      ELSEIF ( LINE(1:6) .EQ. 'DATBAS' ) THEN
+        IS = 6
+ 50     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 50
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTL(3:3),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTL) FDBASE
+ 
+C  GET DEBUG FLAG AND DELAYED DEBUG PARAMETERS
+      ELSEIF ( LINE(1:5) .EQ. 'DEBUG' ) THEN
+        IS = 5
+ 51     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 51
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTL) DEBUG
+        IS = IE
+ 52     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 52
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) MMM
+        IS = IE
+ 53     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 53
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTL) DEBDEL
+        IS = IE
+ 54     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 54
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) NDEBDL
+        IF ( MMM .LE. 0  .OR.  MMM .GT. 99 ) THEN
+          MDEBUG = 6
+        ELSE
+          MDEBUG = MMM
+        ENDIF
+ 
+C  GET OUTPUT DIRECTORY FOR CALCULATIONS ON DEC-STATION OR TRANSPUTER
+      ELSEIF ( LINE(1:6) .EQ. 'DIRECT' ) THEN
+        DO 70 I=1,79
+          DSN(I:I) = ' '
+ 70     CONTINUE
+        IS = 6
+        IF ( LINE(IS+1:80) .NE. ' ' ) THEN
+ 71       CONTINUE
+          IS = IS + 1
+          IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 71
+          IE = INDEX(LINE(IS:),' ') + IS - 2
+          IF ( IE-IS .GT. 63 ) THEN
+            IE = IS + 63
+            DSN(1:IE-IS+1) = LINE(IS:IE)
+            WRITE(MONIOU,*)
+     *        'DATAC: DATASETNAME TOO LONG AND TRUNCATED TO:',DSN(1:64)
+          ELSE
+            DSN(1:IE-IS+1) = LINE(IS:IE)
+          ENDIF
+        ENDIF
+ 
+C  GET ENERGY CUTS FOR PARTICLE PRINTOUT
+      ELSEIF ( LINE(1:6) .EQ. 'ECTMAP' ) THEN
+        IS = 6
+ 81     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 81
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) ECTMAP
+ 
+C  GET ENERGY CUTS FOR HADRONS, MUONS, ELECTRONS, AND PHOTONS
+      ELSEIF ( LINE(1:5) .EQ. 'ECUTS' ) THEN
+        IS = 5
+ 91     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 91
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) ELCUT(1)
+        IS = IE
+ 92     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 92
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) ELCUT(2)
+        IS = IE
+ 93     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 93
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) ELCUT(3)
+        IS = IE
+ 94     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 94
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) ELCUT(4)
+ 
+C  GET FLAGS FOR ELECTROMAGNETIC OPTIONS (NKG, EGS)
+      ELSEIF ( LINE(1:6) .EQ. 'ELMFLG' ) THEN
+        IS = 6
+201     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 201
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTL) FNKG
+        IS = IE
+202     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 202
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTL) FEGS
+ 
+C  GET ENERGY RANGE OF PRIMARY PARTICLE
+      ELSEIF ( LINE(1:6) .EQ. 'ERANGE' ) THEN
+        IS = 6
+211     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 211
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) R1
+        IS = IE
+212     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 212
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) R2
+        LLIMIT = MIN( R1, R2 )
+        ULIMIT = MAX( R1, R2 )
+ 
+C  GET SLOPE OF ENERGY SPECTRUM OF PRIMARY PARTICLE
+      ELSEIF ( LINE(1:6) .EQ. 'ESLOPE' ) THEN
+        IS = 6
+221     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 221
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) PSLOPE
+ 
+C  GET EVENT NUMBER
+      ELSEIF ( LINE(1:5) .EQ. 'EVTNR' ) THEN
+        IS = 5
+231     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 231
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) SHOWNO
+        SHOWNO = MAX( SHOWNO-1, 0 )
+ 
+C  END OF DATA CARD INPUT
+      ELSEIF ( LINE(1:4) .EQ. 'EXIT' ) THEN
+        IF ( DEBUG ) THEN
+          WRITE(MONIOU,*) 'DATAC : END OF DATACARD INPUT'
+        ELSE
+          WRITE(MONIOU,*)
+          WRITE(MONIOU,*) 'END OF DATACARD INPUT'
+        ENDIF
+        RETURN
+ 
+C  GET FIXED HEIGHT (G/CM**2) OF PARTICLE START
+      ELSEIF ( LINE(1:6) .EQ. 'FIXCHI' ) THEN
+        IS = 6
+241     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 241
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) THICK0
+ 
+C  GET FIXED HEIGHT OF FIRST INTERACTION AND FIRST TARGET
+      ELSEIF ( LINE(1:6) .EQ. 'FIXHEI' ) THEN
+        IS = 6
+251     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 251
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) FIXHEI
+        IS = IE
+252     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 252
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) N1STTR
+        IF ( FIXHEI .GT. 0. ) FIX1I = .TRUE.
+ 
+C  GET FLAG FOR GHEISHA LOW ENERGY HADRONIC INTERACTION MODEL
+      ELSEIF ( LINE(1:6) .EQ. 'GHEISH' ) THEN
+        IS = 6
+261     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 261
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTL) GHEISH
+ 
+C  GET FLAGS FOR HADRON INTERACTION OPTIONS
+      ELSEIF ( LINE(1:6) .EQ. 'HADFLG' ) THEN
+        IS = 6
+271     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 271
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) NFLAIN
+        IS = IE
+272     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 272
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) NFLDIF
+        IS = IE
+273     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 273
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) NFLPI0
+        IS = IE
+274     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 274
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) NFLPIF
+        IS = IE
+275     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 275
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) NFLCHE
+        IS = IE
+276     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 276
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) NFRAGM
+ 
+C  GET NAME OF HOST COMPUTER
+      ELSEIF ( LINE(1:4) .EQ. 'HOST' ) THEN
+        DO 286 I=1,20
+          HOST(I:I) = ' '
+ 286    CONTINUE
+        IS = 4
+ 287    CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 287
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        IF ( IE-IS .GT. 19 ) THEN
+          IE = IS + 19
+          HOST(1:IE-IS+1) = LINE(IS:IE)
+          WRITE(MONIOU,*)
+     *        'DATAC: HOSTNAME TOO LONG AND TRUNCATED TO:',HOST(1:20)
+        ELSE
+          HOST(1:IE-IS+1) = LINE(IS:IE)
+        ENDIF
+ 
+C  GET PARAMETER FOR LONGITUDINAL DEVELOPMENT
+      ELSEIF ( LINE(1:5) .EQ. 'LONGI' ) THEN
+        IS = 5
+301     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 301
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTL) LLONGI
+        IS = IE
+302     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 302
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) THSTEP
+        IS = IE
+303     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 303
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTL) FLGFIT
+ 
+C  GET PARAMETERS OF MAGNETIC FIELD
+      ELSEIF ( LINE(1:6) .EQ. 'MAGNET' ) THEN
+        IS = 6
+311     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 311
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) BX
+        IS = IE
+312     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 312
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) BZ
+ 
+C  GET NUMBER OF EVENTS TO BE PRINTED
+      ELSEIF ( LINE(1:6) .EQ. 'MAXPRT' ) THEN
+        IS = 6
+321     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 321
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) MAXPRT
+        IF ( MAXPRT .LT. 0 ) MAXPRT = 10
+ 
+C  GET FLAG FOR ADDITIONAL MUON INFORMATION ON PATAPE
+      ELSEIF ( LINE(1:6) .EQ. 'MUADDI' ) THEN
+        IS = 6
+331     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 331
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTL) FMUADD
+ 
+C  GET FLAG FOR MUON MULTIPLE SCATTERING (T=MOLIERE, F=GAUSS)
+      ELSEIF ( LINE(1:6) .EQ. 'MUMULT' ) THEN
+        IS = 6
+336     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 336
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTL) FMOLI
+ 
+C  GET NUMBER OF SHOWERS TO BE PRODUCED
+      ELSEIF ( LINE(1:5) .EQ. 'NSHOW' ) THEN
+        IS = 5
+341     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 341
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) NSHOW
+        IF ( NSHOW .LE. 0 ) NSHOW = 1
+ 
+C  GET HEIGHT OF OBSERVATION LEVELS
+      ELSEIF ( LINE(1:6) .EQ. 'OBSLEV' ) THEN
+        IOBSLV = IOBSLV + 1
+        IF ( IOBSLV .LE. 10 )  THEN
+          IS = 6
+351       CONTINUE
+          IS = IS + 1
+          IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 351
+          IE = INDEX(LINE(IS:),' ') + IS - 2
+          WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+          READ(LINE(IS:IE),CFMTF) OBSLEV(IOBSLV)
+          NOBSLV = IOBSLV
+        ELSE
+          WRITE(MONIOU,*) 'DATAC : TOO MUCH OBSERVATION LEVELS,',
+     *                    ' IGNORE IT'
+        ENDIF
+ 
+C  GET NEW MONITOR OUTPUT UNIT
+      ELSEIF ( LINE(1:6) .EQ. 'OUTPUT' ) THEN
+        IS = 6
+361     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 361
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) MONNEW
+        WRITE(MONIOU,593) MONIOU,MONNEW
+ 593    FORMAT(' ATTENTION'/' ========='/
+     *         ' PRINTER OUTPUT REDIRECTED FROM UNIT ',I3,
+     *         ' TO UNIT ',I3)
+        MONIOU = MONNEW
+ 
+C  GET PHI OF PRIMARY PARTICLE
+      ELSEIF ( LINE(1:4) .EQ. 'PHIP' ) THEN
+        IS = 4
+371     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 371
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) R1
+        IS = IE
+372     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 372
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) R2
+        PHIPR(1) = MIN( R1, R2 )
+        PHIPR(2) = MAX( R1, R2 )
+ 
+C  GET TYPE OF PRIMARY PARTICLE
+      ELSEIF ( LINE(1:6) .EQ. 'PRMPAR' ) THEN
+        IS = 6
+381     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 381
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) NNTYP
+        PRMPAR(1) = NNTYP
+ 
+C  GET WIDTH OF NKG LATERAL DISTRIBUTION
+      ELSEIF ( LINE(1:6) .EQ. 'RADNKG' ) THEN
+        IS = 6
+389     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 389
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) RADNKG
+ 
+C  GET RUN NUMBER
+      ELSEIF ( LINE(1:5) .EQ. 'RUNNR' ) THEN
+        IS = 5
+391     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 391
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) NRRUN
+        NRRUN = ABS(NRRUN)
+ 
+C  GET SEEDS OF RANDOM NUMBER SEQUENCES
+      ELSEIF ( LINE(1:4) .EQ. 'SEED' ) THEN
+        ISEQ = ISEQ + 1
+        IF ( ISEQ .LE. 10 )  THEN
+          IS = 4
+401       CONTINUE
+          IS = IS + 1
+          IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 401
+          IE = INDEX(LINE(IS:),' ') + IS - 2
+          WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+          READ(LINE(IS:IE),CFMTI) ISEED(1,ISEQ)
+          IS = IE
+402       CONTINUE
+          IS = IS + 1
+          IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 402
+          IE = INDEX(LINE(IS:),' ') + IS - 2
+          WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+          READ(LINE(IS:IE),CFMTI) ISEED(2,ISEQ)
+          IS = IE
+403       CONTINUE
+          IS = IS + 1
+          IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 403
+          IE = INDEX(LINE(IS:),' ') + IS - 2
+          WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+          READ(LINE(IS:IE),CFMTI) ISEED(3,ISEQ)
+          NSEQ = ISEQ
+        ELSE
+          WRITE(MONIOU,*) 'DATAC : TOO MUCH RANDOM GENERATOR SEEDS,',
+     *                    ' IGNORE IT'
+        ENDIF
+ 
+C  GET FACTOR FOR ELECTRON'S MULTIPLE SCATTERING LENGTH
+      ELSEIF ( LINE(1:6) .EQ. 'STEPFC' ) THEN
+        IS = 6
+406     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 406
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) STEPFC
+ 
+C  GET THETA OF PRIMARY PARTICLE
+      ELSEIF ( LINE(1:6) .EQ. 'THETAP' ) THEN
+        IS = 6
+411     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 411
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) R1
+        IS = IE
+412     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 412
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTF) R2
+        THETPR(1) = MIN( R1, R2 ) 
+        THETPR(2) = MAX( R1, R2 )
+ 
+C  GET NAME OF USER
+      ELSEIF ( LINE(1:4) .EQ. 'USER' ) THEN
+        DO 416 I=1,20
+          USER(I:I) = ' '
+416     CONTINUE
+        IS = 4
+417     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 417
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        IF ( IE-IS .GT. 19 ) THEN
+          IE = IS + 19
+          USER(1:IE-IS+1) = LINE(IS:IE)
+          WRITE(MONIOU,*)
+     *        'DATAC: USERNAME TOO LONG AND TRUNCATED TO:',USER(1:20)
+        ELSE
+          USER(1:IE-IS+1) = LINE(IS:IE)
+        ENDIF
+ 
+C  GET PARAMETER ISH0 FOR AMOUNT OF VENUS DEBUG
+      ELSEIF ( LINE(1:6) .EQ. 'VENDBG' ) THEN
+        IS = 6
+421     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 421
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTI(3:4),'(I2)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTI) ISH0
+ 
+C  GET VENUS PARAMETER WITH CODE WORD AND VALUE
+      ELSEIF ( LINE(1:6) .EQ. 'VENPAR' ) THEN
+        IPARAM = IPARAM + 1
+        IF ( IPARAM .LE. 100 ) THEN
+          PARCHA(IPARAM) = '      '
+          IS = 6
+431       CONTINUE
+          IS = IS + 1
+          IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 431
+          IE = INDEX(LINE(IS:),' ') + IS - 2
+          IF ( IE-IS .GT. 5 ) THEN
+            WRITE(MONIOU,*)
+     *        'DATAC: VENUS PARAMETER NAME TOO LONG AND IGNORED'
+            GOTO 1
+          ELSE
+            PARCHA(IPARAM) = LINE(IS:IE)
+          ENDIF
+          IS = IE
+432       CONTINUE
+          IS = IS + 1
+          IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 432
+          IE = INDEX(LINE(IS:),' ') + IS - 2
+          WRITE(CFMTF(3:4),'(I2)') IE - IS + 1
+          READ(LINE(IS:IE),CFMTF) PARVAL(IPARAM)
+          NPARAM = IPARAM
+        ELSE
+          WRITE(MONIOU,*) 'DATAC : TOO MUCH VENUS PARAMETERS,',
+     *                    ' IGNORE IT'
+        ENDIF
+ 
+C  GET FLAG FOR VENUS HIGH ENERGY HADRONIC INTERACTION MODEL
+      ELSEIF ( LINE(1:5) .EQ. 'VENUS' ) THEN
+        IS = 5
+441     CONTINUE
+        IS = IS + 1
+        IF ( LINE(IS:IS) .EQ. ' ' ) GOTO 441
+        IE = INDEX(LINE(IS:),' ') + IS - 2
+        WRITE(CFMTL(3:3),'(I1)') IE - IS + 1
+        READ(LINE(IS:IE),CFMTL) FVENUS
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  
+c  get cerenkov file name with cts array specifications
+      elseif ( LINE(1:6) .eq. 'CERTEL' ) then
+        read(line(7:),'(I10)') nctels
+        d2r = 3.1415926535897932385/180.0
+        do 10 nct=1,nctels
+          read(moniin,*) (ctpars(nct,m),m=1,7)
+          ct = cos(ctpars(nct,ctthet)*d2r)
+          st = sin(ctpars(nct,ctthet)*d2r)
+          cp = cos(ctpars(nct,ctphi)*d2r)
+          sp = sin(ctpars(nct,ctphi)*d2r)
+          omega(nct,1,1) = cp
+          omega(nct,1,2) = sp 
+          omega(nct,1,3) = 0.0
+          omega(nct,2,1) = -ct*sp 
+          omega(nct,2,2) = ct*cp 
+          omega(nct,2,3) = st 
+          omega(nct,3,1) = st*sp 
+          omega(nct,3,2) = -st*cp 
+          omega(nct,3,3) = ct 
+c          write(moniou,*) nct,(ctpars(nct,m),m=1,7)
+ 10     continue
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  
+
+C  ILLEGAL KEYWORD
+      ELSE
+        WRITE(MONIOU,*) 'DATAC : UNKNOWN KEYWORD :',(LINE(I:I),I=1,6)
+      ENDIF
+ 
+      GOTO 1
+ 
+C-----------------------------------------------------------------------
+ 1000 CONTINUE
+      IF ( DEBUG ) THEN
+        WRITE(MDEBUG,*) 'DATAC : NO MORE DIRECTIVES FOUND'
+      ELSE
+        WRITE(MONIOU,*) '*** NO MORE DIRECTIVES FOUND ***'
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/decay1.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/decay1.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/decay1.f	(revision 286)
@@ -0,0 +1,124 @@
+      SUBROUTINE DECAY1( M0,M3,M4 )
+ 
+C-----------------------------------------------------------------------
+C  DECAY (INTO TWO PARTICLES)
+C
+C  TWO PARTICLE DECAY WITH FULL KINEMATIC; ENERGY AND MOMENTA CONSERVED
+C  THIS SUBROUTINE IS CALLED FROM KDECAY, RESDEC, AND STRDEC
+C  ARGUMENTS:
+C   M0     = TYPE OF DECAYING PARTICLE
+C   M3     = TYPE OF FIRST PRODUCT PARTICLE
+C   M4     = TYPE OF SECOND PRODUCT PARTICLE
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION AUX1,AUX2,AUX2A,AUX3,AUX4,COSTCM,COSTH3,COSTH4,
+     *                 GAMMA3,GAMMA4,PHI4,WORK1,WORK2
+      INTEGER          I,M0,M3,M4
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) BETA,M0,M3,M4
+  444 FORMAT(' DECAY1: BETA,M0,M3,M4=',1P,E10.3,3I5)
+ 
+C  PARTICLE COORDINATES 5..10 ARE COPIED INTO SECPAR IN CALLING PROGRAM
+C  CALCULATE AUXILIARY QUANTITIES
+      AUX1   = ( ( PAMA(M0)**2 + PAMA(M3)**2 - PAMA(M4)**2 )
+     *            / (2.D0*PAMA(M0)) )**2  - PAMA(M3)**2
+      AUX2   = 1.D0 + AUX1 / PAMA(M3)**2
+      AUX2A  = SQRT(AUX2)
+      AUX3   = SQRT( 1.D0 - 1.D0 / AUX2 )
+ 
+      WORK1  = GAMMA * AUX2A
+      WORK2  = AUX3 * BETA * WORK1
+ 
+C  DETERMINE POLAR ANGLE IN CM SYSTEM
+      CALL RMMAR( RD,2,1 )
+      COSTCM = 2.D0 * RD(1) - 1.D0
+      GAMMA3 = WORK1 + WORK2 * COSTCM
+C  SECOND PRODUCT PARTICLE WITH NONVANISHING REST MASS
+      IF ( PAMA(M4) .NE. 0.D0 ) THEN
+        GAMMA4 = (PAMA(M0)*GAMMA - PAMA(M3)*GAMMA3) / PAMA(M4)
+        AUX4   = (PAMA(M0)**2 + PAMA(M4)**2 - PAMA(M3)**2 )
+     *            / (2.D0*PAMA(M0)*PAMA(M4))
+        COSTH4 = MIN( 1.D0, (GAMMA*GAMMA4 - AUX4)
+     *                     / (BETA * GAMMA * SQRT(GAMMA4**2 - 1.D0)) )
+      ELSE
+C  SECOND PRODUCT PARTICLE IS GAMMA; THEN GAMMA4 IS THE ENERGY
+        GAMMA4 = PAMA(M0)*GAMMA - PAMA(M3)*GAMMA3
+        COSTH4 = MIN( 1.D0, (BETA - COSTCM)/(1.D0 - BETA*COSTCM) )
+      ENDIF
+      PHI4 = RD(2)*PI2
+      CALL ADDANG( COSTHE,PHI, COSTH4,PHI4, SECPAR(3),SECPAR(4) )
+      IF ( SECPAR(3) .GT. C(29) ) THEN
+        SECPAR(1) = M4
+        SECPAR(2) = GAMMA4
+        IF ( DEBUG ) WRITE(MDEBUG,445) (SECPAR(I),I=1,9)
+  445   FORMAT(' DECAY1: SECPAR=',1P,9E10.3)
+        CALL TSTACK
+      ENDIF
+C  FIRST PRODUCT PARTICLE
+      COSTH3 = MIN( 1.D0, (GAMMA * GAMMA3 - AUX2A)
+     *                   / (BETA * GAMMA * SQRT(GAMMA3**2 - 1.D0)) )
+      CALL ADDANG( COSTHE,PHI, COSTH3,PHI4+PI, SECPAR(3),SECPAR(4) )
+      IF ( SECPAR(3) .GT. C(29) ) THEN
+        SECPAR(1) = M3
+        SECPAR(2) = GAMMA3
+        IF ( DEBUG ) WRITE(MDEBUG,445) (SECPAR(I),I=1,9)
+        CALL TSTACK
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/decay6.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/decay6.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/decay6.f	(revision 286)
@@ -0,0 +1,306 @@
+      SUBROUTINE DECAY6(AM0,AM3,AM4,AM5,PARAMA,PARAMB,PARAMC,AMPMX,MODE)
+ 
+C-----------------------------------------------------------------------
+C  DECAY (INTO 3 PARTICLES)
+C
+C  TREATES DECAY INTO 3 PARTICLES; FULLY CONSERVING ENERGY AND MOMENTA
+C  KINEMATIC RANGE PARAMETRISATION SEE PHYS. LETT. 204B (1988) 90-91
+C  FOR LEPTONIC KAON DACAY: THE POLARIZATION OF THE MUON AND
+C  THE NEUTRINO PRODUCTION IS INCLUDED.
+C  THIS SUBROUTINE IS CALLED FROM ETADEC, KDECAY, AND PI0DEC
+C  ARGUMENTS:
+C   AM0    = MASS OF DECAYING PARTICLE
+C   AM3, AM4, AM5 = MASSES OF RESULTING PARTICLES
+C   PARAMA = DALITZ AMPLITUDE PARAMETER (SEE BELOW)
+C   PARAMB = DALITZ AMPLITUDE PARAMETER (SEE BELOW)
+C   PARAMC = DALITZ AMPLITUDE PARAMETER (SEE BELOW)
+C   AMPMX  = MAXIMUM AMPLITUDE OF DALITZ PLOT
+C   MODE   = 1  FOR DECAY KAON  ----> 3 PIONS
+C          = 2  FOR DECAY ETA   ----> 3 PIONS OR 2 PIONS + GAMMA
+C               FOR DECAY PI(0) ----> ELECTRON + POSITRON + GAMMA
+C          = 3  FOR DECAY KAON  ----> PION + MUON + NEUTRINO
+C          = 4  FOR DECAY KAON  ----> PION + ELECTRON + NEUTRINO
+C
+C  AMPLITUDE PARAMETERS PARAMA, PARAMB, PARAMC ARE DEPENDENT ON MODE:
+C  FOR MODE=1: PARAMA = G      DALITZ AMPLITUDE PARAMETRISATION SEE
+C              PARAMB = H      PHYS. LETT. 204B (1988) 181 - 193
+C              PARAMC = K
+C
+C  FOR MODE=2: PARAMA = A      DALITZ AMPLITUDE PARAMETRISATION SEE
+C              PARAMB = DUMMY  PHYS. LETT. 204B (1988) 173 - 175;
+C              PARAMC = DUMMY  J.G. LAYTER ET.AL. PHYS.REV.D7(1973)2565
+C
+C  FOR MODE>2: PARAMA = LAMBDA-PLUS    DALITZ AMPLITUDE PARAMETRISATION
+C              PARAMB = LAMBDA-ZERO    SEE PHYS. LETT. 204B (1988)
+C              PARAMC = DUMMY          182 - 194
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,DECAY.
+      COMMON /DECAY/   GAM345,COS345,PHI345
+      DOUBLE PRECISION GAM345(3),COS345(3),PHI345(3)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,POLAR.
+      COMMON /POLAR/   POLART,POLARF
+      DOUBLE PRECISION POLART,POLARF
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION ABYM,AMPLI,AMPMX,AM0,AM3,AM34I,AM34SQ,AM35SQ,
+     *                 AM4,AM5,APARAL,APERPN,AUXA,AUXB,AUX1,AUX2,AUX2A,
+     *                 AUX3,AUX4,AUX4A,AUX5,AUX6,
+     *                 AUX7,AUX8,AUX10,AUX12,AUX14,BBYM,BOFQ,
+     *                 CM0SQ,CM3SQ,CM3SQI,CM4SQ,CM5SQ,COSALF,COSBET,
+     *                 COSFI4,COSOME,COSPHI,COSPSI,COS3CM,COS4CM,COS5CM,
+     *                 DISCR,EPIPRM,E3CM,E3STAR,E4CM,E5CM,E5STAR,FACT,
+     *                 GRLAMD,OMEGA,PA,PARAMA,PARAMB,PARAMC,PB,PC,PSI,
+     *                 P3CM,P3SQ,P4CM,P4SQ,P5CM,P5SQ,ROOT1,ROOT2,
+     *                 SINALF,SINBET,SINFI4,SINFI5,SINOMG,SINPHI,SINPSI,
+     *                 SINT4,SINT4I,SINT5I,SIN3CM,S0,TBYMSS,XIT,XI0
+      INTEGER          MODE
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) AM0,AM3,AM4,AM5
+  444 FORMAT(' DECAY6: AM0',1P,E10.3,' AM3',E10.3,' AM4',E10.3,
+     *       ' AM5',E10.3)
+ 
+C  CALCULATE AUXILIARY QUANTITIES
+      CM0SQ = AM0**2
+      CM3SQ = AM3**2
+      CM4SQ = AM4**2
+      CM5SQ = AM5**2
+      AUX1  = (AM3 + AM4)**2
+      AUX2A = (AM0 - AM5)**2
+      AUX2  = AUX2A - AUX1
+      AUX3  = (AM3 + AM5)**2
+      AUX4A = (AM0 - AM4)**2
+      AUX4  = AUX4A - AUX3
+      AUX5  = CM3SQ - CM4SQ
+      AUX6  = CM0SQ - CM5SQ
+      AUX7  = 0.5D0 / AM0
+      IF     ( MODE .EQ. 1 ) THEN
+        AUX8   = (AM0 - AM3)**2
+        S0     = OB3 * ( CM0SQ + CM3SQ + CM4SQ + CM5SQ )
+        AUX10  = 1.D0 / PAMA(8)**2
+      ELSEIF ( MODE .EQ. 2 ) THEN
+        AUX14  = 1.D0 / (AM0 - AM3 - AM4 - AM5)
+      ELSEIF ( MODE .EQ. 3  .OR.  MODE .EQ. 4 ) THEN
+        CM3SQI = 1.D0 / CM3SQ
+        AUX12  = (CM0SQ + CM3SQ - CM4SQ) * AUX7
+C  XI0 IS XI(0); GRLAMD IS GREAT LAMBDA
+        XI0    = ( CM0SQ - CM3SQ) * CM3SQI * (PARAMB - PARAMA)
+        GRLAMD = -XI0 * PARAMA
+      ELSE
+        WRITE(MONIOU,*) 'DECAY6: UNEXPECTED MODE =',MODE
+        RETURN
+      ENDIF
+ 
+ 100  CALL RMMAR( RD,3,1 )
+C  ARE INVARIANT MASS SQUARES INSIDE BOUNDARY OF DALITZ PLOT?
+      AM34SQ = AUX2 * RD(1) + AUX1
+      AM35SQ = AUX4 * RD(2) + AUX3
+      AM34I  = 0.5D0 / SQRT(AM34SQ)
+      E3STAR = (AUX5 + AM34SQ) * AM34I
+      E5STAR = (AUX6 - AM34SQ) * AM34I
+      ROOT1  = SQRT(E3STAR**2 - CM3SQ )
+      ROOT2  = SQRT(E5STAR**2 - CM5SQ )
+      DISCR  = AM35SQ - (E3STAR + E5STAR)**2
+C  REJECT RANDOM NUMBERS, IF OUTSIDE KINEMATIC BOUNDARY OF DALITZ PLOT
+      IF ( DISCR .GT. -(ROOT1 - ROOT2)**2 ) GOTO 100
+      IF ( DISCR .LT. -(ROOT1 + ROOT2)**2 ) GOTO 100
+C  E3CM, E4CM, E5CM ARE ENERGIES IN THE C. M. SYSTEM
+      E4CM   = (CM0SQ + CM4SQ - AM35SQ) * AUX7
+      E5CM   = (CM0SQ + CM5SQ - AM34SQ) * AUX7
+      E3CM   = AM0 - E4CM - E5CM
+ 
+      IF     ( MODE .EQ. 1 ) THEN
+        FACT  = AUX10 * (AUX2A - 2.D0*AM0*(E5CM-AM5) - S0)
+C  AMPLITUDE OF SQUARED MATRIX ELEMENT (SEE PHYS. LETT. B204 (1988) 181)
+        AMPLI = 1.D0 + PARAMA*FACT + PARAMB*FACT**2 + PARAMC*( AUX10
+     *           * ( AUX4A -AUX8 -2.D0*(E4CM-AM4-E3CM+AM3)*AM0 ) )**2
+ 
+      ELSEIF ( MODE .EQ. 2 ) THEN
+C  AMPLITUDE OF SQUARED MATRIX ELEMENT (SEE PHYS. LETT. B204 (1988) 173)
+C  REF: J. G. LAYTER ET AL., PHYS. REV. D7 (1973) 2565
+        AMPLI = 1.D0 + PARAMA * ( 3.D0 * (E5CM - AM5) * AUX14 - 1.D0 )
+ 
+      ELSE
+C  EPIPRM IS (ENERGY OF PION)PRIMED
+        EPIPRM = AUX12 - E3CM
+C  PA, PB, AND PC ARE THE A, B, AND C PARAMETERS
+        PA     = AM0 * ( 2.D0 * E4CM * E5CM - AM0 * EPIPRM )
+     *            + CM4SQ * ( 0.25D0 * EPIPRM - E5CM )
+        PB     = CM4SQ * ( E5CM - 0.5D0 * EPIPRM )
+        PC     = CM4SQ * EPIPRM * 0.25D0
+C  TBYMSS IS T DIVIDED BY MASS SQUARE OF PION
+        TBYMSS = (CM0SQ + CM3SQ - 2.D0 * AM0 * E3CM) * CM3SQI
+C  XIT IS XI(T)
+        XIT   = XI0 + GRLAMD*TBYMSS
+C  AMPLITUDE OF SQUARED MATRIX ELEMENT (PHYS. LETT. B204 (1988) 183)
+        AMPLI = (1.D0 + PARAMA*TBYMSS)**2 * ( PA + XIT*PB + XIT**2 *PC )
+      ENDIF
+ 
+C  REJECT RANDOM NUMBERS, IF RD(3) IS LARGER THAN DALITZ PLOT AMPLITUDE
+      IF ( RD(3)*AMPMX .GT. AMPLI ) GOTO 100
+ 
+      IF (DEBUG) WRITE(MDEBUG,*)'DECAY6: E3CM,E4CM,E5CM=',
+     *   SNGL(E3CM),SNGL(E4CM),SNGL(E5CM)
+C  P3CM, P4CM, P5CM ARE MOMENTA IN THE C.M. SYSTEM
+C  P3SQ, P4SQ, P5SQ ARE SQUARED MOMENTA IN C.M. SYSTEM
+      P5SQ   = E5CM**2 - CM5SQ
+      P5CM   = SQRT(P5SQ)
+      P4SQ   = E4CM**2 - CM4SQ
+      P4CM   = SQRT(P4SQ)
+      P3SQ   = E3CM**2 - CM3SQ
+      P3CM   = SQRT(P3SQ)
+C  ANGLE ALFA AND BETA ARE BETWEEN PARTICLE 3 AND 4 RSP. 3 AND 5
+      COSALF = (P5SQ - P3SQ - P4SQ) / (2.D0 * P3CM * P4CM)
+      SINALF = -SQRT(1.D0 - COSALF**2)
+      COSBET = (P4SQ - P3SQ - P5SQ) / (2.D0 * P3CM * P5CM)
+      SINBET = SQRT(1.D0 - COSBET**2)
+C  NOW SELECT RANDOM NUMBERS FOR THREE INDEPENDENT ANGLES IN CM-SYSTEM
+C  COS3CM AND PHI ARE ANGLES OF PARTICLE 3 RELATIVE TO DECAYING PARTICLE
+      CALL RMMAR( RD,3,1 )
+      COS3CM = 2.D0*RD(1) - 1.D0
+      SIN3CM = SQRT(1.D0 - COS3CM**2)
+      PHI345(1) = PI2 * RD(2)
+      COSPHI = COS( PHI345(1) )
+      SINPHI = SIN( PHI345(1) )
+C  ANGLE PSI GIVES ROTATION OF PLANE (3,4,5) RELATIVE TO PLANE (1,3)
+      PSI    = PI2 * RD(3)
+      COSPSI = COS(PSI)
+      SINPSI = SIN(PSI)
+C  CALCULATE ALL NEEDED POLAR AND AZIMUTHAL ANGLES IN THE CM-SYSTEM
+      COS4CM = COS3CM * COSALF - SIN3CM * COSPSI * SINALF
+      IF ( ABS(COS4CM) .LT. 1.D0 ) THEN
+         SINT4     = SQRT(1.D0 - COS4CM**2)
+         SINT4I    = 1.D0 / SINT4
+         AUXA      = COS3CM * COSPSI * SINALF + SIN3CM * COSALF
+         COSFI4    = (COSPHI*AUXA-SINPHI*SINPSI*SINALF) * SINT4I
+         PHI345(2) = ACOS( MAX( -1.D0, MIN( 1.D0, COSFI4 ) ) )
+         SINFI4    = (SINPHI*AUXA+COSPHI*SINPSI*SINALF) * SINT4I
+         IF ( SINFI4 .LE. 0.D0 ) PHI345(2) = PI2 - PHI345(2)
+      ELSE
+         PHI345(2) = 0.D0
+      ENDIF
+C  CALCULATE GAMMA FACTORS AND POLAR ANGLES IN LABORATORY SYSTEM
+      GAM345(1) = GAMMA * (E3CM + BETA * P3CM * COS3CM) / AM3
+      COS345(1) = MIN( 1.D0, (BETA * E3CM + P3CM * COS3CM) * GAMMA
+     *                      / ( AM3 * SQRT(GAM345(1)**2 - 1.D0) ) )
+      GAM345(2) = GAMMA * (E4CM + BETA * P4CM * COS4CM) / AM4
+      COS345(2) = MIN( 1.D0, (BETA * E4CM + P4CM * COS4CM) * GAMMA
+     *                       / ( AM4 * SQRT(GAM345(2)**2 - 1.D0) ) )
+C  CALCULATE PARAMETERS OF PARTICLE 5, IF NEEDED
+      IF ( MODE .LE. 2 ) THEN
+        COS5CM      = COS3CM * COSBET - SIN3CM * COSPSI * SINBET
+        IF ( ABS(COS5CM) .LT. 1.D0 ) THEN
+          SINT5I    = 1.D0 / SQRT(1.D0 - COS5CM**2)
+          AUXB      = COS3CM * COSPSI * SINBET + SIN3CM * COSBET
+          PHI345(3) = ACOS((COSPHI*AUXB-SINPHI*SINPSI*SINBET) * SINT5I)
+          SINFI5    =      (SINPHI*AUXB+COSPHI*SINPSI*SINBET) * SINT5I
+          IF ( SINFI5 .LE. 0.D0 ) PHI345(3) = PI2 - PHI345(3)
+        ELSE
+          PHI345(3) = 0.D0
+        ENDIF
+        IF ( AM5 .NE. 0.D0 ) THEN
+          GAM345(3) = GAMMA * (E5CM + BETA * P5CM * COS5CM) / AM5
+          COS345(3) = MIN( 1.D0, (BETA * E5CM + P5CM * COS5CM) * GAMMA
+     *                           / ( AM5 * SQRT(GAM345(3)**2 - 1.D0) ) )
+        ELSE
+C  IF PARTICLE 5 IS GAMMA RAY OR NEUTRINO, THEN GAM345(3) IS THE ENERGY
+          GAM345(3) = GAMMA * (E5CM + BETA * P5CM * COS5CM)
+          COS345(3) = MIN( 1.D0, (BETA * E5CM + P5CM * COS5CM) * GAMMA
+     *                           / GAM345(3) )
+        ENDIF
+      ENDIF
+ 
+      IF ( MODE .EQ. 3 ) THEN
+C  CALCULATION OF MUON POLARIZATION. WE FOLLOW THE DESCRIPTION OF
+C  L. JAUNEAU, IN: METHODS IN SUBNUCLEAR PHYSICS, VOL. 3, M. NIKOLIC ED.
+C  (GORDON + BREACH, NEW YORK, 1969), P. 123
+C  SEE ALSO: L.M. CHOUNET ET AL., PHYS. REP. 4 (1972) 199, APPENDIX 1.
+C  SEE ALSO: N. CABBIBO, A. MAKSYMOWICZ, PHYS. LETT. 9 (1964) 352
+C  (CORRECTIONS IN: PHYS. LETT. 11 (1964) 360; 14 (1965) 72)
+C  WE DEFINE  BOFQ (READ: B OF Q), WHICH IS -B(Q**2)*4
+        BOFQ = 1.D0 - XIT
+C  ABYM AND BBYM (READ A BY M; B BY M) ARE THE QUANTITIES A/M AND B/M
+        ABYM = AM0 * ( BOFQ * EPIPRM - 2.D0 * E5CM )
+        BBYM = CM0SQ + 0.25D0 * CM4SQ * BOFQ**2 - BOFQ * AM0 * E4CM
+C  NOW CALCULATE THE COMPONENTS APARAL (PARALLEL TO MU DIRECTION) AND
+C  APERPN (PERPENDICULAR TO MU DIRECTION) USING QUANTITIES DEFINED IN
+C  KAON REST SYSTEM. NOTE OUR DEFINITION OF SINALF (ALWAYS WITH NEGATIVE
+C  SIGN) OPPOSITE TO CABBIBO'S SIN(PSI) AND JAUNEAU'S SIN(THETA)
+        APARAL = -P3CM*AM4*BBYM*COSALF - P4CM * ( AM0*ABYM - BBYM *
+     *           ( P3CM*SINALF*(E4CM-AM4)/P4CM + AM0 - E3CM ) )
+        APERPN =  P3CM*AM4*BBYM*SINALF
+C  NOW NORMALIZE THE PARALLEL COMPONENT OF POLARIZATION; POLART IS
+C  COSINE OF THE ANGLE BETWEEN MUON MOMENTUM AND POLARISATION
+        POLART = APARAL / SQRT(APARAL**2 + APERPN**2)
+C  THE POLARIZATION VECTOR LIES IN THE PLANE OF MOMENTA (PION,MUON).
+C  OMEGA IS THE ANGLE BY WHICH THE DECAY PLANE (PION,MUON) IS ROTATET
+C  AROUND THE DIRECTION OF MUON RELATIVE TO THE PLANE (KAON,MUON)
+        IF ( ABS(COS4CM) .LT. 1.D0  .AND.  SINALF .NE. 0.D0 ) THEN
+          COSOME = (COS4CM*COSALF - COS3CM)*SINT4I/SINALF
+          OMEGA  = ACOS( MAX( -1.D0, MIN( 1.D0, COSOME ) ) )
+          IF ( SINFI4 .NE. 0.D0 ) THEN
+            SINOMG = ( COSFI4 * ( COSALF - COS3CM*COS4CM ) * SINT4I
+     *                 - SIN3CM * COSPHI ) / (SINALF*SINFI4)
+            IF ( SINOMG .LT. 0.D0 ) OMEGA = PI2 - OMEGA
+          ENDIF
+        ELSE
+          OMEGA = 0.D0
+        ENDIF
+        POLARF  = OMEGA
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/difrac.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/difrac.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/difrac.f	(revision 286)
@@ -0,0 +1,218 @@
+      SUBROUTINE DIFRAC( NRETFL )
+ 
+C-----------------------------------------------------------------------
+C  (SINGLE) DIF(F)RAC(TION)
+C
+C  SETS PARAMETERS FOR HDPM IN CASE OF SINGLE DIFFRACTION
+C  THIS SUBROUTINE IS CALLED FROM HDPM
+C  ARGUMENT:
+C   NRETFL = 0  CORRECT ENDING OF SUBROUTINE
+C          = 1  INCORRECT ENDING OF SUBROUTINE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,DPMFLG.
+      COMMON /DPMFLG/  NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+      INTEGER          NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+*KEEP,INTER.
+      COMMON /INTER/   AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
+     *                 IDIF,ITAR
+      DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
+      INTEGER          IDIF,ITAR
+*KEEP,LEPAR.
+      COMMON /LEPAR/   LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
+      INTEGER          LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,REST.
+      COMMON /REST/    CONTNE,TAR,LT
+      DOUBLE PRECISION CONTNE(3),TAR
+      INTEGER          LT
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'DIFRAC:'
+ 
+C  DECIDE FIRST, WHETHER PROJECTILE OR TARGET DIFFRACTION
+      CALL RMMAR( RD,1,1 )
+      IF ( RD(1) .LE. 0.5 ) THEN
+C  PROJECTILE DIFFRACTON, TARGET DIFFRACTION FLAG IS NOT SET
+        NFTARD = 0
+C  MASS OF INCOMING PARTICLE AND PI(0) MASS
+C  PI(0) IS MINIMAL OUTCOME OF SECONDARIES IN DIFRAC
+        XM0    = ( PAMA(LEPAR1) + PAMA(7) )**2
+      ELSE
+C  TARGET DIFFRACTON, SET TARGET DIFFRACTION FLAG
+        NFTARD = 1
+C  MASS OF NUCLEON AND PI(0) MASS
+C  PI(0) IS MINIMAL OUTCOME OF SECONDARIES IN DIFRAC
+        XM0    = ( PAMA(LEPAR2) + PAMA(7) )**2
+      ENDIF
+C  MAXIMAL DIFFRACTIVE MASS, FACTOR 0.15 GIVEN BY COHERENCE CONDITION
+      XMX    = 0.15D0 * S
+ 
+C  THROW MAXIMAL 200 TIMES TO GET A GOOD DIFFRACTIVE MASS
+      NCDIFL = 0
+  7   CONTINUE
+C  GET DIFFRACTIVE MASS
+      CALL RMMAR( RD,2,1 )
+C  GET S (=ECM**2) (WHY THIS WAY OF THROWING ???)
+      SDIF = (XMX/XM0)**RD(1) * XM0
+ 
+      IF ( SDIF .LE. XM0 ) THEN
+        IF ( NCDIFL .LE. 200 ) THEN
+          NCDIFL = NCDIFL + 1
+          GOTO 7
+        ELSE
+C  SET RETURN FLAG TO ERROR
+          NRETFL = 1
+          RETURN
+        ENDIF
+      ENDIF
+ 
+C  DISTRIBUTION OF DIFFRACTIVE MASS FLATTENS OFF FOR DIFFRACTIVE
+C  MASS SQUARED .LE. 2 GEV
+      IF ( SDIF .LE. 2.D0 ) THEN
+C----- SO GEHT DAS NICHT!!   16.12.91 D.H.
+        SDIF = RD(2) * (2.D0 - XM0) + XM0
+      ENDIF
+C  SQRT(S) IS ECM
+      ECMDIF = SQRT(SDIF)
+C  LOG(S), LOG(S)**2
+      DLOG   = LOG(SDIF)
+      DLOGSQ = DLOG**2
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'DIFRAC: SDIF,ECMDIF,NFTARD=',
+     *               SNGL(SDIF),SNGL(ECMDIF),NFTARD
+ 
+C  RAPIDITY IN CMS OF DIFFRACTIVE SYSTEM
+C  TO CALCULATE DMLOG, SUBTRACT SUM OF MASS SQUARES FROM SDIF
+C  PI(0) MASS SQUARED IS 0.0182.
+      IF ( NFTARD .EQ. 0 ) THEN
+        YY0   =  LOG(ECMDPM/ECMDIF)
+        DMLOG =  LOG(SDIF - 0.0182D0 - PAMA(LEPAR1)**2)
+      ELSE
+        YY0   = -LOG(ECMDPM/ECMDIF)
+        DMLOG =  LOG(SDIF - 0.0182D0 - PAMA(LEPAR2)**2)
+      ENDIF
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'DIFRAC: YY0,DMLOG=',
+     *                           SNGL(YY0),SNGL(DMLOG)
+C  CENTRAL RAPIDITY DENSITY IN CMS OF DIFFRACTIVE SYSTEM
+C  PARAMETRISATION SEE CAPDEVIELLE,J.PHYS.G:NUCL.PHYS.16(1990)1539 EQ.7
+C  WE USE ONLY THE LOW-ENERGY PART OF THE PARAMETRISATION, AS SDIF DOES
+C  NOT REACH THE HIGHER VALUES
+      DC0 = 0.82D0 * (SDIF**0.107D0)
+ 
+C  THERE ARE 3 ENERGY DEPENDENT FORMULAS FOR AVERAGE CHARGED
+C  MULTIPLICITY ( AVCH1 );
+C  PARAMETRISATIONS SEE CAPDEVIELLE,J.PHYS.G:NUCL.PHYS.16(1990)1539 EQ.8
+      IF     ( ECMDIF .LE. 187.5D0 ) THEN
+C  CHARGED MULTIPLICITY (M**2 IN PLACE OF S)
+        AVCH1 = 0.57D0 + 0.584D0*DLOG + 0.127D0*DLOGSQ
+      ELSEIF ( ECMDIF .LE. 945.5D0 ) THEN
+        AVCH1 = -6.55D0 + 6.89D0 * SDIF**0.131D0
+      ELSE
+        AVCH1 = 3.4D0 * SDIF**0.17D0
+      ENDIF
+C  PARAMETRISATION IS BASED ON COLLIDER DATA WHERE PROTON AND ANTIPROTON
+C  ARE INCLUDED. LOWER LIMIT FOR AVERAGE CHARGED MULTIPLICITY IS 1.
+      AVCH1 = MAX( 1.D0, AVCH1 )
+ 
+C  CENTER OF GAUSSIAN 1ST+2ND STRING OF FRAGMENTATION SYSTEM
+      POSC2 = 0.146D0 * DMLOG + 0.072D0
+C  WIDTH  OF GAUSSIAN 1ST+2ND STRING OF FRAGMENTATION SYSTEM
+      WIDC2 = 0.120D0 * DMLOG + 0.180D0
+C  INTERACTION FACTOR GNU FOR INTERACTION WITH NUCLEUS;
+      IF ( NFLAIN .EQ. 0 ) THEN
+        GNU   = 1.D0
+        AVCH3 = 0.D0
+        POSC3 = 0.D0
+        WIDC3 = 1.D0
+      ELSE
+C  NEW PARAMETRIZATION OF J.N.CAPDEVIELLE (MARCH 93)
+        GNU   = (0.4826D0 + 3.522D-2 * DLOG) * TAR**0.31D0
+C  CENTER OF GAUSSIAN FOR 3RD STRING (FROM TARGET)
+        POSC3 = +3.D0 - 2.575D0 * EXP( -0.081756452D0 * GNU )
+C  WIDTH  OF GAUSSIAN FOR 3RD STRING (FROM TARGET)
+        WIDC3 = 1.2338466D0 + 0.078969916D0 * LOG(GNU)
+        IF ( ECMDIF .LE. 137.D0 ) THEN
+          AVCH3 = 0.57D0 * AVCH1 * (GNU-1.D0)
+        ELSE
+          AVCH3 = 0.5D0  * AVCH1 * (GNU-1.D0)
+        ENDIF
+      ENDIF
+      IF ( DEBUG ) WRITE(MDEBUG,100)
+     *          SNGL(POSC2),SNGL(WIDC2),SNGL(POSC3),SNGL(WIDC3)
+ 100  FORMAT(' DIFRAC: POSC2,WIDC2,POSC3,WIDC3=',4F12.7)
+C  AVERAGE CHARGED, INCLUDING THOSE FROM TARGET
+      AVCH = AVCH1 + AVCH3
+C  THE FOLOWING PROCEDURE IS TO PRODUCE PHOTONS FROM UNKNOWN NEUTRAL
+C  DECAYS FOLLOWING CORRELATION WITH CHARGED PARTICLES BASED ON
+C  PHOTON EXCESS AT COLLIDER EXPERIMENTS. SEUGP IS <N_PHOTON>
+C  PROBLEM OF THE RISE OF THE UNKNOWN ETA PRODUCTION CROSS SECTION
+C  IS SOLVED WITH PARAMETRISATION OF UA5 (Z. PHYS. C43 (1989) 75)
+      IF ( ECMDIF .LE. 103.D0 ) THEN
+        SEUGP = -1.27D0 + 0.52D0 * DLOG + 0.148D0 * DLOGSQ
+      ELSE
+C  AT HIGH DIFFRACTIVE MASS USE PARAMETRISATION OF THOUW ????
+        SEUGP = -18.7D0 + 11.55D0 * SDIF**0.1195D0
+      ENDIF
+      SEUGP = MAX( 0.5D0, SEUGP )
+      IF ( DEBUG ) WRITE(MDEBUG,110)
+     *   SNGL(DC0),SNGL(AVCH1),SNGL(AVCH3),SNGL(AVCH),SNGL(SEUGP)
+ 110  FORMAT(' DIFRAC: DC0,AVCH1,AVCH3,AVCH,SEUGP=',5F12.6)
+ 
+C  SET RETURN FLAG TO OK
+      NRETFL = 0
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/dmy.sed
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/dmy.sed	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/dmy.sed	(revision 286)
@@ -0,0 +1,7 @@
+s=#USERADD#=harald@hegra6.mppmu.mpg.de=g
+s=#DATADISK#=/hd61/MagicMc/Data=g
+s=#ADMDISK#=/hd61/MagicMc/Log=g
+s=#PATHEXE#=/usr/users/harald/MagicSoft/Simulation/Corsika/mmcs-0.3.1=g
+s=#NAMEEXE#=c520-generic=g
+s=#NICE#=2=g
+s=#SITE#=4=g
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/dpfunc.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/dpfunc.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/dpfunc.f	(revision 286)
@@ -0,0 +1,20 @@
+      DOUBLE PRECISION FUNCTION DPFUNC( ENER )
+ 
+C-----------------------------------------------------------------------
+C  D(IFFRACTION) P(ORTION) FUNC(TION)
+C
+C  CALCULATES THE FRACTION OF DIFFRACTION
+C  THIS FUNCTION IS CALLED FROM HDPM
+C  ARGUMNENT:
+C   ENER   = C.M. ENERGY
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+      DOUBLE PRECISION ENER
+C-----------------------------------------------------------------------
+ 
+C  FUNCTION DPFUNC IS DUMMY
+      DPFUNC = 0.15D0
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/egs4.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/egs4.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/egs4.f	(revision 286)
@@ -0,0 +1,163 @@
+      SUBROUTINE EGS4( EEIN )
+ 
+C---------------------------------------------------------------------
+C  E(LECTRON) G(AMMA) S(HOWER)
+C
+C  TREATES ELECTROMAGNETIC SUBSHOWER
+C  THIS SUBROUTINE PACKAGE IS CALLED FROM EM
+C  ARGUMENT:
+C   EEIN   = (R8) INCOMING PARTICLE ENERGY (GEV)
+C
+C  DESIGN  : D. HECK   IK3  FZK KARLSRUHE
+C---------------------------------------------------------------------
+ 
+      DOUBLE PRECISION EEIN
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEND.
+      COMMON/GEOM/ZALTIT,BOUND(6),NEWOBS,OBSLVL(10)
+*KEEP,LONGI.
+      COMMON /LONGI/   APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
+     *                 NSTEP,LLONGI,FLGFIT
+      DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
+     *                 SPLONG(0:1040,9),THSTEP,THSTPI
+      INTEGER          NSTEP
+      LOGICAL          LLONGI,FLGFIT
+*KEND.
+      COMMON/MISC/KMPI,KMPO,DUNIT,NOSCAT,MED(6),RHOR(6),IRAYLR(6)
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEND.
+      DOUBLE PRECISION PI0MSQ
+      COMMON/PION/PI0MSQ,PITHR,PICMAS,PI0MAS,AMASK0,AMASKC,AMASPR,AMASNT
+*KEEP,REJECT.
+      COMMON /REJECT/  AVNREJ,
+     *                 ALTMIN,ANEXP,THICKA,THICKD,CUTLN,EONCUT,
+     *                 FNPRIM
+      DOUBLE PRECISION AVNREJ(10)
+      REAL             ALTMIN(10),ANEXP(10),THICKA(10),THICKD(10),
+     *                 CUTLN,EONCUT
+      LOGICAL          FNPRIM
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+      DOUBLE PRECISION THICK
+      CHARACTER MEDARR*24
+      DATA MEDARR/'AIR-NTP                 '/
+C---------------------------------------------------------------------
+ 
+      IF((DEBUG))WRITE(MDEBUG,* )'EGS4  :'
+C***  CONVERSION GEV --> MEV
+      E(1)= EEIN*1000.D0
+C***  CHECK ENERGY RANGE
+      IQ(1)=NINT(SECPAR(1))
+      IF ( IQ(1) .EQ. 1 ) THEN
+       IF ( E(1) .GT. UP ) THEN
+        CALL AUSGB2
+        WRITE(KMPO,91) EEIN
+91      FORMAT(' EGS4  : ENERGY OF GAMMA =',1P,E10.3,' GEV TOO HIGH')
+        STOP
+       ENDIF
+      ELSE
+       IF ( E(1) .GT. UE ) THEN
+        CALL AUSGB2
+        WRITE(KMPO,92) EEIN
+92      FORMAT(' EGS4  :ENERGY OF ELECTRON/POSITRON =',1P,E10.3,
+     *         ' GEV TOO HIGH')
+        STOP
+       ENDIF
+      ENDIF
+C***  FILL IN STARTING COORDINATES
+      NP=1
+      TIME(1)=SECPAR(6)
+      X(1)=SECPAR(7)
+      Y(1)=-SECPAR(8)
+C***  STARTS IN HEIGHT 'Z' DOWNWARDS
+      Z(1)=-SECPAR(5)
+      IF (LLONGI) LPCTE(1)=MIN(NSTEP,INT(THICK(SECPAR(5))*THSTPI)+1)
+      SITHET=SQRT(1.D0-SECPAR(3)**2)
+C***  START DIRECTION COSINES
+      U(NP)=SITHET*COS(-SECPAR(4))
+      V(NP)=SITHET*SIN(-SECPAR(4))
+      W(NP)=SECPAR(3)
+C*** RENORMALIZATION OF DIRECTION COSINES
+      RADINV=1.5-0.5*(U(NP)**2+V(NP)**2+W(NP)**2)
+      U(NP)=U(NP)*RADINV
+      V(NP)=V(NP)*RADINV
+      W(NP)=W(NP)*RADINV
+      DNEAR(1)=0.
+      IGEN(1)=GEN
+       DO 101 K=1,5
+C ***  DETERMINE START REGION
+       IF (-BOUND(K).LE.Z(1) .AND. -BOUND(K+1).GT.Z(1)) THEN
+        IR(1)=K+1
+        GO TO 110
+       END IF
+101   CONTINUE
+102   CONTINUE
+      CALL AUSGB2
+      WRITE(KMPO,120) -Z(1)*0.00001
+120   FORMAT (' EGS4  : START VALUE OF Z=',1P,E10.3,' KM  NOT IN ATMOSPH
+     *ERE')
+      STOP
+110   CONTINUE
+       DO 111 IDET=1,NOBSLV
+C ***  DETERMINE NEXT OBSERVATION LEVEL
+       IF (-Z(1).GE.OBSLVL(IDET)) THEN
+        IOBS(1)=IDET
+        GO TO 130
+       END IF
+111   CONTINUE
+112   CONTINUE
+      CALL AUSGB2
+      WRITE(KMPO,140) -Z(1)*0.01,OBSLVL(NOBSLV)*0.01
+140   FORMAT(' EGS4  : START VALUE OF Z= ',E10.3, ' M  BELOW LOWEST DET'
+     *, 'ECTOR AT',E10.3,' M')
+      STOP
+C***  NEWOBS IS THE NEXT OBSERVATION LEVEL
+130   NEWOBS=IOBS(NP)
+      CALL SHOWER
+      IF(DEBUG) WRITE(MDEBUG,*) 'EGS4  : EGS-STACK EMPTY, EXIT'
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/egs4bd.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/egs4bd.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/egs4bd.f	(revision 286)
@@ -0,0 +1,124 @@
+      BLOCK DATA EGS4BD
+C                                VERSION 4.00  --  26 JAN 1986/1900
+C******************************************************************
+      COMMON/BOUNDS/ECUT(6),PCUT(6),VACDST
+      COMMON/ELECIN/EKELIM,ICOMP,EKE0,EKE1,CMFP0,CMFP1,RANGE0,RANGE1, XR
+     *0,TEFF0,BLCC,XCC,PICMP0(1),PICMP1(1),EICMP0(1),EICMP1(1),MPEEM(1),
+     * ESIG0(500),ESIG1(500),PSIG0(500),PSIG1(500),EDEDX0(500),EDEDX1(50
+     *0),PDEDX0(500),PDEDX1(500),EBR10(500),EBR11(500),PBR10(500),PBR11(
+     *500),PBR20(500),PBR21(500),TMXS0(500),TMXS1(500),CMFPE0(1),CMFPE1(
+     *1),CMFPP0(1),CMFPP1(1),ERANG0(1),ERANG1(1),PRANG0(1),PRANG1(1),CXC
+     *2E0(1),CXC2E1(1),CXC2P0(1),CXC2P1(1),CLXAE0(1),CLXAE1(1),CLXAP0(1)
+     *,CLXAP1(1), THR0(1,1),THR1(1,1),THR2(1,1),THRI0(1,1),THRI1(1,1),TH
+     *RI2(1,1),FSTEP(16),FSQR(16),MSMAP(200), VERT1(1000),VERT2(100,16),
+     *MSTEPS,JRMAX,MXV1, MXV2,NBLC,NRNTH,NRNTHI,BLC0,BLC1,RTHR0,RTHR1,RT
+     *HRI0,RTHRI1
+*KEEP,EPCONT.
+      COMMON/EPCONT/   EDEP,RATIO,TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,IDISC,
+     *                 IROLD,IRNEW,RHOFAC, EOLD,ENEW,EKE,ELKE,BETA2,GLE,
+     *                 TSCAT,IAUSFL
+      DOUBLE PRECISION EDEP,RATIO
+      REAL             TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,RHOFAC,EOLD,ENEW,
+     *                 EKE,ELKE,BETA2,GLE,TSCAT
+      INTEGER          IDISC,IROLD,IRNEW,IAUSFL(29)
+*KEND.
+      COMMON /MEDIA/ NMED, RLC,RLDU,RLDUI,RHO,MSGE,MGE,MSEKE,MEKE,MLEKE,
+     *MCMFP,MRANGE,IRAYLM,HBARO(6),HBAROI(6)
+      CHARACTER MEDIA*24
+      COMMON/MEDIAC/MEDIA
+      COMMON/MISC/KMPI,KMPO,DUNIT,NOSCAT,MED(6),RHOR(6),IRAYLR(6)
+      COMMON/MULTS/NG21,B0G21,B1G21,G210(7),G211(7),G212(7), NG22,B0G22,
+     *B1G22,G220(8),G221(8),G222(8), NG31,B0G31,B1G31,G310(11),G311(11),
+     *G312(11), NG32,B0G32,B1G32,G320(25),G321(25),G322(25), NBGB,B0BGB,
+     *B1BGB,BGB0(8),BGB1(8),BGB2(8)
+      COMMON/PATHCM/NPTH,B0PTH,B1PTH,PTH0(6),PTH1(6),PTH2(6)
+      COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+      CHARACTER MEDIA1*24
+      EQUIVALENCE (MEDIA1,MEDIA)
+      DATA NCLOCK/0/,JCLOCK/ 1/
+      DATA ECUT/6*0./,PCUT/6*0./,VACDST/1.E8/
+      DATA EKELIM/0./,ICOMP/1/
+      DATA IAUSFL/5*1,24*0/,RHOFAC/1.0/
+      DATA NMED/1/,MEDIA1/'NAI                     '/
+      DATA IRAYLM/1*0/
+      DATA KMPI/12/,KMPO/8/,DUNIT/1./,NOSCAT/0/
+      DATA MED/6*1/,RHOR/6*0./,IRAYLR/6*0/
+      DATA NG21/ 7/,B0G21/ 2.0000E+00/,B1G21/ 5.0000E+00/
+      DATA G210(1),G211(1),G212(1)/-9.9140E-04, 2.7672E+00,-1.1544E+00/
+      DATA G210(2),G211(2),G212(2)/-9.9140E-04, 2.7672E+00,-1.1544E+00/
+      DATA G210(3),G211(3),G212(3)/-7.1017E-02, 3.4941E+00,-3.0773E+00/
+      DATA G210(4),G211(4),G212(4)/-7.3556E-02, 3.5487E+00,-3.1989E+00/
+      DATA G210(5),G211(5),G212(5)/ 3.6658E-01, 2.1162E+00,-2.0311E+00/
+      DATA G210(6),G211(6),G212(6)/ 1.4498E+00,-5.9717E-01,-3.2951E-01/
+      DATA G210(7),G211(7),G212(7)/ 1.4498E+00,-5.9717E-01,-3.2951E-01/
+      DATA NG22/ 8/,B0G22/ 2.0000E+00/,B1G22/ 6.0000E+00/
+      DATA G220(1),G221(1),G222(1)/-5.2593E-04, 1.4285E+00,-1.2670E+00/
+      DATA G220(2),G221(2),G222(2)/-5.2593E-04, 1.4285E+00,-1.2670E+00/
+      DATA G220(3),G221(3),G222(3)/-6.4819E-02, 2.2033E+00,-3.6399E+00/
+      DATA G220(4),G221(4),G222(4)/ 3.7427E-02, 1.6630E+00,-2.9362E+00/
+      DATA G220(5),G221(5),G222(5)/ 6.1955E-01,-6.2713E-01,-6.7859E-01/
+      DATA G220(6),G221(6),G222(6)/ 1.7584E+00,-4.0390E+00, 1.8810E+00/
+      DATA G220(7),G221(7),G222(7)/ 2.5694E+00,-6.0484E+00, 3.1256E+00/
+      DATA G220(8),G221(8),G222(8)/ 2.5694E+00,-6.0484E+00, 3.1256E+00/
+      DATA NG31/ 11/,B0G31/ 2.0000E+00/,B1G31/ 9.0000E+00/
+      DATA G310(1),G311(1),G312(1)/ 4.9437E-01, 1.9124E-02, 1.8375E+00/
+      DATA G310(2),G311(2),G312(2)/ 4.9437E-01, 1.9124E-02, 1.8375E+00/
+      DATA G310(3),G311(3),G312(3)/ 5.3251E-01,-6.1555E-01, 4.5595E+00/
+      DATA G310(4),G311(4),G312(4)/ 6.6810E-01,-2.2056E+00, 8.9293E+00/
+      DATA G310(5),G311(5),G312(5)/-3.8262E+00, 2.5528E+01,-3.3862E+01/
+      DATA G310(6),G311(6),G312(6)/ 4.2335E+00,-1.0604E+01, 6.6702E+00/
+      DATA G310(7),G311(7),G312(7)/ 5.0694E+00,-1.4208E+01, 1.0456E+01/
+      DATA G310(8),G311(8),G312(8)/ 1.4563E+00,-3.3275E+00, 2.2601E+00/
+      DATA G310(9),G311(9),G312(9)/-3.2852E-01, 1.2938E+00,-7.3254E-01/
+      DATA G310(10),G311(10),G312(10)/-2.2489E-1, 1.0713E+0,-6.1358E-1/
+      DATA G310(11),G311(11),G312(11)/-2.2489E-1, 1.0713E+0,-6.1358E-1/
+      DATA NG32/ 25/,B0G32/ 2.0000E+00/,B1G32/ 2.3000E+01/
+      DATA G320(1),G321(1),G322(1)/ 2.9907E-05, 4.7318E-01, 6.5921E-01/
+      DATA G320(2),G321(2),G322(2)/ 2.9907E-05, 4.7318E-01, 6.5921E-01/
+      DATA G320(3),G321(3),G322(3)/ 2.5820E-03, 3.5853E-01, 1.9776E+00/
+      DATA G320(4),G321(4),G322(4)/-5.3270E-03, 4.9418E-01, 1.4528E+00/
+      DATA G320(5),G321(5),G322(5)/-6.6341E-02, 1.4422E+00,-2.2407E+00/
+      DATA G320(6),G321(6),G322(6)/-3.6027E-01, 4.7190E+00,-1.1380E+01/
+      DATA G320(7),G321(7),G322(7)/-2.7953E+00, 2.6694E+01,-6.0986E+01/
+      DATA G320(8),G321(8),G322(8)/-3.6091E+00, 3.4125E+01,-7.7512E+01/
+      DATA G320(9),G321(9),G322(9)/ 1.2491E+01,-7.1103E+01, 9.4496E+01/
+      DATA G320(10),G321(10),G322(10)/ 1.9637E+1,-1.1371E+2, 1.5794E+2/
+      DATA G320(11),G321(11),G322(11)/ 2.1692E+0,-2.5019E+1, 4.5340E+1/
+      DATA G320(12),G321(12),G322(12)/-1.6682E+1, 6.2067E+1,-5.5257E+1/
+      DATA G320(13),G321(13),G322(13)/-2.1539E+1, 8.2651E+1,-7.7065E+1/
+      DATA G320(14),G321(14),G322(14)/-1.4344E+1, 5.5193E+1,-5.0867E+1/
+      DATA G320(15),G321(15),G322(15)/-5.4990E+0, 2.3874E+1,-2.3140E+1/
+      DATA G320(16),G321(16),G322(16)/ 3.1029E+0,-4.4708E+0, 2.1318E-1/
+      DATA G320(17),G321(17),G322(17)/ 6.0961E+0,-1.3670E+1, 7.2823E+0/
+      DATA G320(18),G321(18),G322(18)/ 8.6179E+0,-2.0950E+1, 1.2536E+1/
+      DATA G320(19),G321(19),G322(19)/ 7.5064E+0,-1.7956E+1, 1.0520E+1/
+      DATA G320(20),G321(20),G322(20)/ 5.9838E+0,-1.4065E+1, 8.0342E+0/
+      DATA G320(21),G321(21),G322(21)/ 4.4959E+0,-1.0456E+1, 5.8462E+0/
+      DATA G320(22),G321(22),G322(22)/ 3.2847E+0,-7.6709E+0, 4.2445E+0/
+      DATA G320(23),G321(23),G322(23)/ 1.9514E+0,-4.7505E+0, 2.6452E+0/
+      DATA G320(24),G321(24),G322(24)/ 4.8808E-1,-1.6910E+0, 1.0459E+0/
+      DATA G320(25),G321(25),G322(25)/ 4.8808E-1,-1.6910E+0, 1.0459E+0/
+      DATA NBGB/ 8/,B0BGB/ 1.5714E+00/,B1BGB/ 2.1429E-01/
+      DATA BGB0(1),BGB1(1),BGB2(1)/-1.0724E+00, 2.8203E+00,-3.5669E-01/
+      DATA BGB0(2),BGB1(2),BGB2(2)/ 3.7136E-01, 1.4560E+00,-2.8072E-02/
+      DATA BGB0(3),BGB1(3),BGB2(3)/ 1.1396E+00, 1.1910E+00,-5.2070E-03/
+      DATA BGB0(4),BGB1(4),BGB2(4)/ 1.4908E+00, 1.1267E+00,-2.2565E-03/
+      DATA BGB0(5),BGB1(5),BGB2(5)/ 1.7342E+00, 1.0958E+00,-1.2705E-03/
+      DATA BGB0(6),BGB1(6),BGB2(6)/ 1.9233E+00, 1.0773E+00,-8.1806E-04/
+      DATA BGB0(7),BGB1(7),BGB2(7)/ 2.0791E+00, 1.0649E+00,-5.7197E-04/
+      DATA BGB0(8),BGB1(8),BGB2(8)/ 2.0791E+00, 1.0649E+00,-5.7197E-04/
+      DATA NPTH/ 6/,B0PTH/ 2.0000E+00/,B1PTH/ 1.8182E+01/
+      DATA PTH0(1),PTH1(1),PTH2(1)/ 1.0000E+00, 9.8875E-01, 2.5026E+00/
+      DATA PTH0(2),PTH1(2),PTH2(2)/ 1.0000E+00, 9.8875E-01, 2.5026E+00/
+      DATA PTH0(3),PTH1(3),PTH2(3)/ 1.0060E+00, 7.8657E-01, 4.2387E+00/
+      DATA PTH0(4),PTH1(4),PTH2(4)/ 1.0657E+00,-2.5051E-01, 8.7681E+00/
+      DATA PTH0(5),PTH1(5),PTH2(5)/ 1.6971E+00,-7.5600E+00, 2.9946E+01/
+      DATA PTH0(6),PTH1(6),PTH2(6)/ 1.6971E+00,-7.5600E+00, 2.9946E+01/
+      DATA RMT2/1.022007/,RMSQ/.2611245/
+      DATA PI/3.141593/,TWOPI/6.283185/,PI5D2/7.853982/
+      DATA ICALL/0/,RM/.5110034/
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/egsini.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/egsini.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/egsini.f	(revision 286)
@@ -0,0 +1,189 @@
+      SUBROUTINE EGSINI
+ 
+C---------------------------------------------------------------------
+C  E(LECTRON) G(AMMA) S(HOWER) INI(TIALIZATION)
+C
+C  INITIALIZES EGS4 PACKAGE
+C  THIS SUBROUTINE IS CALLED FROM START
+C
+C  DESIGN  : D. HECK   IK3  FZK KARLSRUHE
+C---------------------------------------------------------------------
+ 
+*KEEP,ATMOS.
+      COMMON /ATMOS/   AATM,BATM,CATM,DATM
+      DOUBLE PRECISION AATM(5),BATM(5),CATM(5),DATM(5)
+*KEND.
+      COMMON/BOUNDS/ECUT(6),PCUT(6),VACDST
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEND.
+      COMMON/GEOM/ZALTIT,BOUND(6),NEWOBS,OBSLVL(10)
+      COMMON /MEDIA/ NMED, RLC,RLDU,RLDUI,RHO,MSGE,MGE,MSEKE,MEKE,MLEKE,
+     *MCMFP,MRANGE,IRAYLM,HBARO(6),HBAROI(6)
+      CHARACTER MEDIA*24
+      COMMON/MEDIAC/MEDIA
+      DOUBLE PRECISION PRRMMU
+      COMMON/MUON/PRRMMU,RMMU,RMMUT2
+      COMMON/MISC/KMPI,KMPO,DUNIT,NOSCAT,MED(6),RHOR(6),IRAYLR(6)
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEND.
+      DOUBLE PRECISION PI0MSQ
+      COMMON/PION/PI0MSQ,PITHR,PICMAS,PI0MAS,AMASK0,AMASKC,AMASPR,AMASNT
+*KEEP,REJECT.
+      COMMON /REJECT/  AVNREJ,
+     *                 ALTMIN,ANEXP,THICKA,THICKD,CUTLN,EONCUT,
+     *                 FNPRIM
+      DOUBLE PRECISION AVNREJ(10)
+      REAL             ALTMIN(10),ANEXP(10),THICKA(10),THICKD(10),
+     *                 CUTLN,EONCUT
+      LOGICAL          FNPRIM
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+      COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+      CHARACTER MEDARR*24
+      DATA MEDARR/'AIR-NTP                 '/
+C---------------------------------------------------------------------
+ 
+      IF((DEBUG))WRITE(MDEBUG,* )'EGSINI:'
+C***  INITIALISATION BEFORE THE FIRST CALL OF EGS4
+      ICALL = 1
+      IF (( DEBUG )) THEN
+       KMPO = MDEBUG
+      ELSE
+       KMPO = MONIOU
+      END IF
+      WRITE(KMPO,10)
+10     FORMAT (' START AIR SHOWER SUBROUTINE EGS4 VERSION 64S (OCT 94)'/
+     *  ' MU+MU- PAIRS ARE FORMED IN ANALOGY WITH E+E- PAIRS. THIS IS ',
+     *  'CERTAINLY NOT'/' CORRECT BECAUSE OF DIFFERENT FORM FACTORS. T',
+     *  'HEREFORE TREAT MUON PAIRS WITH CAUTION.')
+C***  SET PARTICLE MASSES AND PHYSICAL CONSTANTS
+      RM = PAMA(2)*1.D3
+      RMT2 = 2.*RM
+      RMSQ = RM**2
+      PRRMMU = PAMA(5)*1.D3
+      RMMU = PRRMMU
+      RMMUT2 = 2.*RMMU
+      PICMAS = PAMA(8)*1.D3
+      PI0MAS = PAMA(7)*1.D3
+      PI0MSQ = PI0MAS**2
+      AMASKC = PAMA(11)*1.D3
+      AMASK0 = PAMA(10)*1.D3
+      AMASPR = PAMA(14)*1.D3
+      AMASNT = PAMA(13)*1.D3
+C***  INVERSE OF VELOCITY OF LIGHT
+      VC = 1.D0/C(25)
+C***  PION-PRODUCTION THRESHOLD
+      PITHR = 152.0
+C***  NMED AND DUNIT DEFAULT TO 1,I.E. ONE MEDIUM AND WE WORK IN CM
+      MEDIUM=1
+      DO 21 I=1,24
+       MEDIA(I:I)=MEDARR(I:I)
+21    CONTINUE
+22    CONTINUE
+C***  BOUNDARY 1= TOP OF ATMOSPHERE (SEE SUBROUTINE HOWFAR)
+      BOUND(1)=11300000.
+      BOUND(2)= 4000000.
+      BOUND(3)= 1000000.
+      BOUND(4)= 400000.
+      BOUND(5)= 0.
+      BOUND(6)= -0.
+      MED(1)=0
+      MED(6)=0
+C***  VACUUM IN REGIONS 1 AND 6, AIR IN REGION 2 TO 5
+      DO 31 IRL=2,5
+       MED(IRL)= 1
+C ***  VALUE OF BARO-HEIGHT FROM HILLAS, PRIV. COMMUN. (AUG 1988)
+       HBARO(IRL)=CATM(6-IRL)
+       HBAROI(IRL)=1./HBARO(IRL)
+       RHOR(IRL) =BATM(6-IRL)*HBAROI(IRL)
+C ***  NEEDED FOR REGION 2 TO 5 SINCE NO TRANSPORT ELSEWHERE
+C ***  ECUT IS TOTAL ENERGY
+C ***  TERMINATE ELECTRON HISTORIES AT ECUT (GEV TO MEV CONVERTED)
+       ECUT(IRL)=1000.D0*ELCUT(3)+RM
+C ***  TERMINATE PHOTON HISTORIES AT PCUT (GEV TO MEV CONVERTED)
+       PCUT(IRL)=1000.D0*ELCUT(4)
+31    CONTINUE
+32    CONTINUE
+      OPEN(UNIT=KMPI,FILE='EGSDAT2',STATUS='OLD')
+C***  PICK UP CROSS SECTION DATA FOR AIR-NTP FROM UNIT KMPI=12
+      CALL HATCH
+      CLOSE(UNIT=KMPI)
+C***  INVERTED PHOTON THRESHOLD
+      API=1./AP
+      WRITE(KMPO,40) (AE-RM)*.001,AP*.001,ECUT(2)*.001,PCUT(2)*.001
+40    FORMAT (' ELECTRONS CAN BE CREATED AND ANY ELECTRON FOLLOWED DO',
+     *  'WN TO'/T40,F8.4,' GEV KINETIC ENERGY'/' GAMMAS CAN BE CREATED',
+     *  ' AND ANY GAMMA FOLLOWED DOWN TO'/T40,F8.4,' GEV ENERGY'/' ELE',
+     *  'CTRON HISTORIES ARE TERMINATED AT',F10.4,' GEV'/' GAMMA HISTO',
+     *  'RIES ARE TERMINATED AT   ',F10.4,' GEV'/)
+cc    IF((DEBUG.OR.(JCLOCK.GT.1)))WRITE(KMPO,50)
+cc50  FORMAT (7X,' PART|TOT.ENERGY|ANGLE Z|ANGLE X|ALTITUDE|',
+cc   * '  TIME  |  POS. X  |  POS. Y  |GENER|',/,8X,'ICLE|',
+cc   * '  (GEV)   |COSTHET| (RAD) |  (CM)  | (MSEC) |   (CM)   |',
+cc   * '   (CM)   |ATION|')
+C***  CALCULATE THE LAYER THICKNESS BELOW EACH DETECTOR
+      DO 61 IDET=1,NOBSLV
+C ***  NECESSARY BECAUSE OF DOUBLE PRECIS.
+       OBSLVL(IDET)=OBSLEV(IDET)
+       DO 71 JREG=2,5
+         IF (OBSLVL(IDET).GE.BOUND(JREG)) THEN
+          KREG=JREG
+          GO TO 80
+         END IF
+71     CONTINUE
+72     CONTINUE
+       WRITE(KMPO,90) IDET,OBSLVL(IDET)*0.01
+90     FORMAT (' EGS4  :', ' DETECTOR ',I2,' AT ',E10.3,' M IS OUT OF A
+     *TMOSPHERE')
+       STOP
+80     THICKD(IDET)=EXP(-OBSLVL(IDET)*HBAROI(KREG))
+       THICKA(IDET)=RHOR(KREG)*HBARO(KREG)*(1.-THICKD(IDET))
+C ***  MIN ALTITUDE FOR REJECT IS OBSERVATION LEVEL+3*36.6 G/CM**2
+       ALTMIN(IDET)=-HBARO(KREG)*LOG(MAX(1.E-37,(1.-(THICKA(IDET)+109.8
+     *  )* HBAROI(KREG)/RHOR(KREG))))
+       ALTMIN(IDET)=MIN(ALTMIN(IDET),BOUND(1))
+61    CONTINUE
+62    CONTINUE
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/electr.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/electr.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/electr.f	(revision 286)
@@ -0,0 +1,564 @@
+      SUBROUTINE ELECTR(IRCODE)
+C                                VERSION 4.00  --  26 JAN 1986/1900
+C******************************************************************
+      DOUBLE PRECISION PEIE
+      COMMON/BOUNDS/ECUT(6),PCUT(6),VACDST
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,CEREN1.
+      COMMON /CEREN1/  CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD,
+     *                 CERSIZ,LCERFI
+      DOUBLE PRECISION CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD
+      REAL             CERSIZ
+      LOGICAL          LCERFI
+*KEND.
+      COMMON/ELECIN/EKELIM,ICOMP,EKE0,EKE1,CMFP0,CMFP1,RANGE0,RANGE1, XR
+     *0,TEFF0,BLCC,XCC,PICMP0(1),PICMP1(1),EICMP0(1),EICMP1(1),MPEEM(1),
+     * ESIG0(500),ESIG1(500),PSIG0(500),PSIG1(500),EDEDX0(500),EDEDX1(50
+     *0),PDEDX0(500),PDEDX1(500),EBR10(500),EBR11(500),PBR10(500),PBR11(
+     *500),PBR20(500),PBR21(500),TMXS0(500),TMXS1(500),CMFPE0(1),CMFPE1(
+     *1),CMFPP0(1),CMFPP1(1),ERANG0(1),ERANG1(1),PRANG0(1),PRANG1(1),CXC
+     *2E0(1),CXC2E1(1),CXC2P0(1),CXC2P1(1),CLXAE0(1),CLXAE1(1),CLXAP0(1)
+     *,CLXAP1(1), THR0(1,1),THR1(1,1),THR2(1,1),THRI0(1,1),THRI1(1,1),TH
+     *RI2(1,1),FSTEP(16),FSQR(16),MSMAP(200), VERT1(1000),VERT2(100,16),
+     *MSTEPS,JRMAX,MXV1, MXV2,NBLC,NRNTH,NRNTHI,BLC0,BLC1,RTHR0,RTHR1,RT
+     *HRI0,RTHRI1
+*KEEP,EPCONT.
+      COMMON/EPCONT/   EDEP,RATIO,TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,IDISC,
+     *                 IROLD,IRNEW,RHOFAC, EOLD,ENEW,EKE,ELKE,BETA2,GLE,
+     *                 TSCAT,IAUSFL
+      DOUBLE PRECISION EDEP,RATIO
+      REAL             TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,RHOFAC,EOLD,ENEW,
+     *                 EKE,ELKE,BETA2,GLE,TSCAT
+      INTEGER          IDISC,IROLD,IRNEW,IAUSFL(29)
+*KEND.
+      COMMON/GEOM/ZALTIT,BOUND(6),NEWOBS,OBSLVL(10)
+*KEEP,LONGI.
+      COMMON /LONGI/   APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
+     *                 NSTEP,LLONGI,FLGFIT
+      DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
+     *                 SPLONG(0:1040,9),THSTEP,THSTPI
+      INTEGER          NSTEP
+      LOGICAL          LLONGI,FLGFIT
+*KEEP,MAGNET.
+      COMMON /MAGNET/  BX,BZ,BVAL,BNORMC,BNORM,COSB,SINB,BLIMIT
+      DOUBLE PRECISION BX,BZ,BVAL,BNORMC
+      REAL             BNORM,COSB,SINB,BLIMIT
+*KEND.
+      COMMON /MEDIA/ NMED, RLC,RLDU,RLDUI,RHO,MSGE,MGE,MSEKE,MEKE,MLEKE,
+     *MCMFP,MRANGE,IRAYLM,HBARO(6),HBAROI(6)
+      CHARACTER MEDIA*24
+      COMMON/MEDIAC/MEDIA
+      COMMON/MISC/KMPI,KMPO,DUNIT,NOSCAT,MED(6),RHOR(6),IRAYLR(6)
+      DOUBLE PRECISION PRRMMU
+      COMMON/MUON/PRRMMU,RMMU,RMMUT2
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEND.
+      COMMON/PATHCM/NPTH,B0PTH,B1PTH,PTH0(6),PTH1(6),PTH2(6)
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,REJECT.
+      COMMON /REJECT/  AVNREJ,
+     *                 ALTMIN,ANEXP,THICKA,THICKD,CUTLN,EONCUT,
+     *                 FNPRIM
+      DOUBLE PRECISION AVNREJ(10)
+      REAL             ALTMIN(10),ANEXP(10),THICKA(10),THICKD(10),
+     *                 CUTLN,EONCUT
+      LOGICAL          FNPRIM
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
+      COMMON/UPHIIN/SINC0,SINC1,SIN0(20002),SIN1(20002)
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+      DOUBLE PRECISION THICK
+      DATA NSTPCN/0/
+ 
+ 
+ 
+C_____NCLOCK = NCLOCK+1
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' ELECTR:NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      NEWOBS=IOBS(NP)
+      IRCODE=1
+      IROLD=IR(NP)
+      IRL=IR(NP)
+      MEDIUM=MED(IRL)
+380   CONTINUE
+381    CONTINUE
+       LELEC=5-2*IQ(NP)
+       PEIE=E(NP)
+       EIE=PEIE
+       IF((EIE.LE.ECUT(IRL)))GO TO 390
+       MEDIUM=MED(IRL)
+400    CONTINUE
+401     CONTINUE
+        IF (MEDIUM.NE.0) THEN
+         EKE=EIE-RM
+         ELKE=LOG(EKE)
+         CALL RMMAR(RNNE1,1,2)
+         IF ((RNNE1.EQ.0.0)) THEN
+          RNNE1=1.E-30
+         END IF
+         DEMFP=AMAX1(-ALOG(RNNE1),1.E-6)
+         LELKE=EKE1*ELKE+EKE0
+         IF (LELEC.LT.0) THEN
+          SIG0=ESIG1(LELKE)*ELKE+ESIG0(LELKE)
+         ELSE
+          SIG0=PSIG1(LELKE)*ELKE+PSIG0(LELKE)
+         END IF
+        END IF
+450     CONTINUE
+451      CONTINUE
+         IF (MEDIUM.EQ.0) THEN
+          TSTEP=VACDST
+          USTEP=TSTEP
+          TUSTEP=USTEP
+         ELSE
+          RHOFAC=RHOR(IRL)/RHO
+          RHOFI=1./RHOFAC
+          SIG=SIG0*RHOFAC
+          IF (SIG.LE.0.0) THEN
+           TSTEP=VACDST
+          ELSE
+           TSTEP=DEMFP/SIG
+          END IF
+          TMXS=TMXS1(LELKE)*ELKE+TMXS0(LELKE)
+          TMXS=MIN(TMXS,STEPFC*200.*TEFF0)
+          TMXS=TMXS*RHOFI
+          TUSTEP=MIN(TSTEP,TMXS)
+          IF (LELEC.LT.0) THEN
+           DEDX0=EDEDX1(LELKE)*ELKE+EDEDX0(LELKE)
+          ELSE
+           DEDX0=PDEDX1(LELKE)*ELKE+PDEDX0(LELKE)
+          END IF
+          DEDX=RHOFAC*MIN(DEDX0,(86.65-Z(NP)*8.E-6)*RLDUI)
+          RANGE=(EIE-ECUT(IRL)+0.001)/DEDX
+          BETA2=MAX(1.E-8,1.-RMSQ/(EIE*EIE))
+          BETA3=EIE*BETA2*0.094315
+          TSCAT=RLDU*BETA3*BETA3
+          TSCAT=TSCAT*RHOFI
+          TUSTEP=MIN(TUSTEP,0.3*TSCAT,RANGE)
+          RATIO=TUSTEP/TSCAT
+          USTEP=TUSTEP*(1.D0-RATIO)
+          USTEPU=USTEP
+          ALTEXP=EXP(-Z(NP)*HBAROI(IRL))
+          USTEP=USTEP*ALTEXP
+          DISC=W(NP)*USTEP*HBAROI(IRL)
+          IF (ABS(DISC).LT.0.065) THEN
+           USTEP=USTEP*(1.-0.5*DISC*(1.-0.6666667*DISC* (1.-0.75*DISC *
+     *     (1.-0.8*DISC))))
+          ELSE IF(DISC.LE.-1.) THEN
+           USTEP=VACDST
+          ELSE
+           USTEP=USTEP/DISC*LOG(DISC+1.)
+          END IF
+          TUSTPC=USTEP/(1.D0-RATIO)
+         END IF
+         IRNEW=IR(NP)
+         IDISC=0
+         USTEP0=USTEP
+         USTEP=MIN(USTEP,BLIMIT*EIE)
+         IF((USTEP.GT.DNEAR(NP) ))CALL HOWFAR
+         IF((IDISC.GT.0))GO TO 420
+         IF (USTEP.LE.0.0) THEN
+          IF (USTEP.LT.-1.E-4) THEN
+           WRITE(KMPO,460)USTEP
+460        FORMAT(' ELECTR: NEGATIVE USTEP=',G20.10,' CM')
+           WRITE(KMPO,470)Z(NP),DNEAR(NP),IR(NP),IRNEW,W(NP)
+470        FORMAT (' Z=',G15.7, ' DNEAR=',G15.7,' IR=',I5, ' IRNEW=',I5,
+     *      ' W=',G15.7)
+           NSTPCN=NSTPCN+1
+           IF (NSTPCN.GE.20) THEN
+            CALL AUSGB2
+            WRITE(KMPO,480) NSTPCN
+480         FORMAT (' ELECTR: PROGRAM STOPPED BECAUSE OF FREQUENT NEGA',
+     *       'TIVE USTEP, COUNTER = ',I5)
+            STOP
+           END IF
+          END IF
+          USTEP=0.
+         END IF
+         IF (USTEP.EQ.0.0.OR.MEDIUM.EQ.0) THEN
+          IF (USTEP.NE.0.0) THEN
+           VSTEP=USTEP
+           TVSTEP=VSTEP
+           EDEP=PZERO
+           TVSTPC=TVSTEP
+           ALPHA=VSTEP*LELEC*BNORM/EIE
+           TVSTPC=TVSTPC*(1.+0.04166667*ALPHA*ALPHA)
+           U0=U(NP)
+           V0=V(NP)
+           W0=W(NP)
+           FNORM=1.-0.5*(ALPHA*ALPHA)*(1.-0.75*(ALPHA*ALPHA))
+           F1SIN=(1.-FNORM)*SINB
+           F1COS=(1.-FNORM)*COSB
+           V1=V0*ALPHA*FNORM
+           U(NP)=U0*(1.-F1SIN*SINB)+W0*F1SIN*COSB+V1*SINB
+           V(NP)=FNORM*(V0-ALPHA*(U0*SINB-W0*COSB))
+           W(NP)=W0*(1.-F1COS*COSB)+U0*F1COS*SINB-V1*COSB
+           RADINV=1.5-0.5*(U(NP)**2+V(NP)**2+W(NP)**2)
+           U(NP)=U(NP)*RADINV
+           V(NP)=V(NP)*RADINV
+           W(NP)=W(NP)*RADINV
+           X(NP)=X(NP)+(VSTEP*0.5)*(U0+U(NP))
+           Y(NP)=Y(NP)+(VSTEP*0.5)*(V0+V(NP))
+           ZOLD =Z(NP)
+           Z(NP)=Z(NP)+(VSTEP*0.5)*(W0+W(NP))
+           TIME(NP)=TIME(NP)+TVSTPC*VC*E(NP)/SQRT((E(NP)-PRM)*(E(NP)+PRM
+     *     ))
+ 
+ 
+C     GENERATE CERENKOV PHOTONS
+           IF ( FNPRIM ) CALL CERENE(TVSTPC)
+C  ADD ELECTRONS TO THE LONGITUDINAL DEVELOPMENT
+C  FIND FIRST THE EQUIVALENT LEVELS
+           IF ( LLONGI ) THEN
+C  IF STARTING POINT BELOW LOWEST LEVEL THEN DON'T CHECK
+            IF ( HLONG(NSTEP) .LE. -ZOLD ) THEN
+              LPCT1 = LPCTE(NP)
+C  Z NEW IS PROBABLY ONLY LITTLE BELOW Z OLD, THEREFORE INCREMENTAL SEARCH
+              DO 6002 I1 = LPCT1,NSTEP
+                IF ( HLONG(I1) .LT. -Z(NP) ) GOTO 6003
+ 6002         CONTINUE
+              I1 = NSTEP + 1
+ 6003         CONTINUE
+              LPCT2 = I1 - 1
+              DO 485 I=LPCT1,LPCT2
+                PLONG(I,IQ(NP)) = PLONG(I,IQ(NP)) + 1.D0
+ 485          CONTINUE
+C  STORE END POINT AS POSSIBLE STARTPOINT OF NEXT TRACK
+              LPCTE(NP) = LPCT2 + 1
+            ENDIF
+           ENDIF
+           DNEAR(NP)=DNEAR(NP)-VSTEP
+           IROLD=IR(NP)
+          END IF
+          IR(NP)=IRNEW
+          IRL=IRNEW
+          MEDIUM=MED(IRL)
+          IF((EIE.LE.ECUT(IRL)))GO TO 390
+          IF (USTEP.NE.0.0) THEN
+           IF (NEWOBS.GT.IOBS(NP)) THEN
+            CALL AUSGAB
+            IOBS(NP)=NEWOBS
+           END IF
+          END IF
+          GO TO 401
+         END IF
+         VSTEP=USTEP
+         IF (USTEP.EQ.USTEP0) THEN
+          TVSTEP=TUSTEP
+          TVSTPC=TUSTPC
+         ELSE
+          VSTEPU=VSTEP
+          DISC=W(NP)*VSTEPU*HBAROI(IRL)
+          VSTEPU=VSTEPU/ALTEXP
+          IF (ABS(DISC).LT.0.16) THEN
+           VSTEPU=VSTEPU*(1.+.5*DISC*(1.+.33333333*DISC* (1.+0.25*DISC*
+     *     (1.+0.2*DISC))))
+          ELSE
+           VSTEPU=VSTEPU/DISC*(EXP(DISC)-1.)
+          END IF
+          VSTP=VSTEPU/TSCAT
+          IPTH=B0PTH+B1PTH*VSTP
+          IF (IPTH.GT.NPTH) THEN
+           CALL AUSGB2
+           WRITE(KMPO,490) VSTP,IPTH,NPTH
+490        FORMAT (' ELECTR: OUT OF BOUNDS IPTH: VSTP,IPTH,NPTH=' , 1P ,
+     *      G15.6,2I10)
+           STOP
+          END IF
+          PTH=PTH0(IPTH)+VSTP*(PTH1(IPTH)+VSTP*PTH2(IPTH))
+          TVSTEP=PTH*VSTEPU
+          TVSTPC=PTH*VSTEP
+         END IF
+         ALPHA=VSTEP*LELEC*BNORM/EIE
+         TVSTPC=TVSTPC*(1.+0.04166667*ALPHA*ALPHA)
+         DE=DEDX*TVSTEP
+         EDEP=DE
+         EKEF=EKE-DE
+         EOLD=EIE
+         ENEW=EOLD-DE
+         CALL MSCAT
+         U0=U(NP)
+         V0=V(NP)
+         W0=W(NP)
+         FNORM=1.-0.5*(ALPHA*ALPHA)*(1.-0.75*(ALPHA*ALPHA))
+         F1SIN=(1.-FNORM)*SINB
+         F1COS=(1.-FNORM)*COSB
+         V1=V0*ALPHA*FNORM
+         U(NP)=U0*(1.-F1SIN*SINB)+W0*F1SIN*COSB+V1*SINB
+         V(NP)=FNORM*(V0-ALPHA*(U0*SINB-W0*COSB))
+         W(NP)=W0*(1.-F1COS*COSB)+U0*F1COS*SINB-V1*COSB
+         RADINV=1.5-0.5*(U(NP)**2+V(NP)**2+W(NP)**2)
+         U(NP)=U(NP)*RADINV
+         V(NP)=V(NP)*RADINV
+         W(NP)=W(NP)*RADINV
+         X(NP)=X(NP)+(VSTEP*0.5)*(U0+U(NP))
+         Y(NP)=Y(NP)+(VSTEP*0.5)*(V0+V(NP))
+         ZOLD = Z(NP)
+         Z(NP)=Z(NP)+(VSTEP*0.5)*(W0+W(NP))
+         TIME(NP)=TIME(NP)+TVSTPC*VC*E(NP)/SQRT((E(NP)-PRM)*(E(NP)+PRM))
+ 
+ 
+C   GENERATE CERENKOV PHOTONS
+         IF ( FNPRIM ) CALL CERENE(TVSTPC)
+C  ADD ELECTRONS TO THE LONGITUDINAL DEVELOPMENT
+C  FIND FIRST THE EQUIVALENT LEVELS
+         IF ( LLONGI ) THEN
+C  IF STARTING POINT BELOW LOWEST LEVEL THEN DON'T CHECK
+           IF ( HLONG(NSTEP) .LE. -ZOLD ) THEN
+             LPCT1 = LPCTE(NP)
+C  Z NEW IS PROBABLY ONLY LITTLE BELOW Z OLD, THEREFORE INCREMENTAL SEARCH
+             DO 6102 I1 = LPCT1,NSTEP
+               IF ( HLONG(I1) .LT. -Z(NP) ) GOTO 6103
+ 6102        CONTINUE
+             I1 = NSTEP + 1
+ 6103        CONTINUE
+             LPCT2 = I1 - 1
+             DO 495 I=LPCT1,LPCT2
+                PLONG(I,IQ(NP)) = PLONG(I,IQ(NP)) + 1.D0
+ 495         CONTINUE
+             LPCTE(NP) = LPCT2 + 1
+           ENDIF
+         ENDIF
+         DNEAR(NP)=DNEAR(NP)-VSTEP
+         IROLD=IR(NP)
+         CALL RMMAR(RNNO38,1,2)
+         PHI=RNNO38*TWOPI
+         LPHI=SINC1*PHI+SINC0
+         SINPHI=SIN1(LPHI)*PHI+SIN0(LPHI)
+         CPHI=PI5D2-PHI
+         LCPHI=SINC1*CPHI+SINC0
+         COSPHI=SIN1(LCPHI)*CPHI+SIN0(LCPHI)
+         A=U(NP)
+         B=V(NP)
+         CC=W(NP)
+         SINPS2=A*A+B*B
+         IF (SINPS2.LT.1.0E-10) THEN
+          U(NP)=SINTHE*COSPHI
+          V(NP)=SINTHE*SINPHI
+          W(NP)=CC*COSTHE
+         ELSE
+          SINPSI=SQRT(SINPS2)
+          US=SINTHE*COSPHI
+          VS=SINTHE*SINPHI
+          SINDEL=B*(1./SINPSI)
+          COSDEL=A*(1./SINPSI)
+          U(NP)=CC*COSDEL*US-SINDEL*VS+A*COSTHE
+          V(NP)=CC*SINDEL*US+COSDEL*VS+B*COSTHE
+          W(NP)=-SINPSI*US+CC*COSTHE
+         END IF
+         RADINV=1.5-0.5*(U(NP)**2+V(NP)**2+W(NP)**2)
+         U(NP)=U(NP)*RADINV
+         V(NP)=V(NP)*RADINV
+         W(NP)=W(NP)*RADINV
+         PEIE=PEIE-EDEP
+         EIE=PEIE
+         E(NP)=PEIE
+         IF((EIE.LE.ECUT(IRL)))GO TO 390
+         MEDOLD=MEDIUM
+         IF (MEDIUM.NE.0) THEN
+          EKEOLD=EKE
+          EKE=EIE-RM
+          ELKE=LOG(EKE)
+          LELKE=EKE1*ELKE+EKE0
+         END IF
+         IF (IRNEW.NE.IROLD) THEN
+          IR(NP)=IRNEW
+          IRL=IRNEW
+          MEDIUM=MED(IRL)
+         END IF
+         IF((EIE.LE.ECUT(IRL)))GO TO 390
+         IF (NEWOBS.GT.IOBS(NP)) THEN
+          CALL AUSGAB
+          IOBS(NP)=NEWOBS
+         END IF
+         IF((IDISC.LT.0))GO TO 420
+         IF((MEDIUM.NE.MEDOLD))GO TO 401
+         DEMFP=MAX(0.,DEMFP-TVSTEP*SIG)
+         IF(((DEMFP.LT.1.E-6)))GO TO452
+        GO TO 451
+452     CONTINUE
+        IF (LELEC.LT.0) THEN
+         SIGF=ESIG1(LELKE)*ELKE+ESIG0(LELKE)
+        ELSE
+         SIGF=PSIG1(LELKE)*ELKE+PSIG0(LELKE)
+        END IF
+        CALL RMMAR(RFICT,1,2)
+        IF(((RFICT.LE.SIGF/SIG0)))GO TO402
+       GO TO 401
+402    CONTINUE
+       IF ( .NOT. FNPRIM ) THEN
+        X(1)=0.
+        Y(1)=0.
+        EVTH(5)=X(1)
+        EVTH(6)=-Y(1)
+        IF (FIX1I) THEN
+         Z(1)=-FIXHEI
+         NP=1
+         LPCTE(1)=MIN(NSTEP,INT(THICK(FIXHEI)*THSTPI)+1)
+         SITHET=SQRT(1.D0-SECPAR(3)**2)
+         U(1)=SITHET*COS(-SECPAR(4))
+         V(1)=SITHET*SIN(-SECPAR(4))
+         W(1)=SECPAR(3)
+         RADINV=1.5-0.5*(U(1)**2+V(1)**2+W(1)**2)
+         U(1)=U(1)*RADINV
+         V(1)=V(1)*RADINV
+         W(1)=W(1)*RADINV
+        END IF
+        EVTH(7)=-Z(1)
+        CALL TOBUF(EVTH,0)
+C   OUTPUT OF EVENTHEADER TO THE CERENKOV FILE
+        IF (LCERFI) CALL TOBUFC(EVTH,0)
+        CALL COORIN(DBLE(-Z(1)))
+        TIME(1)=0.D0
+        FNPRIM =.TRUE.
+        IF (FPRINT) THEN
+         WRITE(KMPO,* )' FIRST INTERACTION AT ',EVTH(7)*0.01,' M'
+        END IF
+       END IF
+       IF (LELEC.LT.0) THEN
+        EBR1=EBR11(LELKE)*ELKE+EBR10(LELKE)
+        CALL RMMAR(RNNO24,1,2)
+        IF (RNNO24.LE.EBR1) THEN
+         GO TO 500
+        ELSE
+         IF (E(NP).LE.THMOLL) THEN
+          IF((EBR1.LE.0.0))GO TO 380
+          GO TO 500
+         END IF
+         CALL MOLLER
+        END IF
+        GO TO 380
+       END IF
+       PBR1=PBR11(LELKE)*ELKE+PBR10(LELKE)
+       CALL RMMAR(RNNO25,1,2)
+       IF((RNNO25.LT.PBR1))GO TO 500
+       PBR2=PBR21(LELKE)*ELKE+PBR20(LELKE)
+       IF (RNNO25.LT.PBR2) THEN
+        CALL BHABHA
+       ELSE
+        CALL ANNIH
+        GO TO 382
+       END IF
+      GO TO 381
+382   CONTINUE
+      RETURN
+500   CONTINUE
+      CALL BREMS
+      IF (IQ(NP).EQ.1) THEN
+       RETURN
+      ELSE
+       GO TO 380
+      END IF
+390   IF (EIE.GT.AE) THEN
+       IDR=1
+       IF (LELEC.LT.0) THEN
+        EDEP=PEIE-PRM
+       ELSE
+        EDEP=PEIE-PRM
+       END IF
+      ELSE
+       IDR=2
+       EDEP=PEIE-PRM
+      END IF
+      IF (LELEC.GT.0) THEN
+       IF (EDEP.LT.PEIE) THEN
+        CALL RMMAR(RD,2,2)
+        COSTHE=RD(1)
+        FLIP=RD(2)
+        IF((FLIP.LE.0.5))COSTHE=-COSTHE
+        SINTHE=SQRT(MAX(0.,1.0-COSTHE*COSTHE))
+        E(NP)=PRM
+        IQ(NP)=1
+        U(NP)=0.
+        V(NP)=0.
+        W(NP)=1.
+        CALL UPHI(2,1)
+        NP=NP+1
+        E(NP)=PRM
+        IQ(NP)=1
+        X(NP)=X(NP-1)
+        Y(NP)=Y(NP-1)
+        Z(NP)=Z(NP-1)
+        LPCTE(NP)=LPCTE(NP-1)
+        IR(NP)=IR(NP-1)
+        DNEAR(NP)=DNEAR(NP-1)
+        TIME(NP)=TIME(NP-1)
+        IGEN(NP)=IGEN(NP-1)
+        IOBS(NP)=IOBS(NP-1)
+        U(NP)=-U(NP-1)
+        V(NP)=-V(NP-1)
+        W(NP)=-W(NP-1)
+        RETURN
+       END IF
+      END IF
+      NP=NP-1
+      IRCODE=2
+      RETURN
+420   IF (LELEC.LT.0) THEN
+       EDEP=PEIE-PRM
+      ELSE
+       EDEP=PEIE+PRM
+      END IF
+      IRCODE=2
+      NP=NP-1
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/em.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/em.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/em.f	(revision 286)
@@ -0,0 +1,100 @@
+      SUBROUTINE EM
+ 
+C-----------------------------------------------------------------------
+C  E(LECTRO) M(AGNETIC PARTICLES)
+C
+C  ROUTINE FOR TREATING EM PARTICLES
+C  THIS SUBROUTINE IS CALLED FROM BOX3
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION ENER
+      INTEGER          I
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' EM    : CURPAR=',1P,9E10.3)
+ 
+C  GET CORRECT PARTICLE ENERGY
+      IF     ( ITYPE  .EQ. 1 ) THEN
+        ENER = CURPAR(2)
+      ELSEIF ( ITYPE .EQ. 2  .OR.  ITYPE .EQ. 3 ) THEN
+        ENER  = SECPAR(2) * PAMA(2)
+      ELSE
+        WRITE(MONIOU,*) 'EM    : WRONG PARTICLE CODE =',ITYPE
+        RETURN
+      ENDIF
+ 
+C  LOOK FOR ENERGY OF EM PARTICLE
+*     IF ( ENER .LE. 1.D7 ) THEN
+C  EM-PARTICLE ENERGY IS BELOW LPM EFFECT, STORE IT TO SECPAR
+C  LPM LIMIT IS SET AT 1.*10**16 EV = 1.*10**7 GEV
+        DO 101  I = 1,8
+          SECPAR(I) = CURPAR(I)
+  101   CONTINUE
+        SECPAR( 9)  = GEN
+        SECPAR(10)  = ALEVEL
+ 
+C  CALL NKG IF SELECTED
+        IF ( FNKG ) THEN
+          CALL NKG( ENER )
+        ENDIF
+ 
+C  CALL EGS4 IF SELECTED ( PARTICLE IS TAKEN IN EGS FROM COMMON )
+        IF ( FEGS ) THEN
+          CALL EGS4( ENER )
+        ENDIF
+ 
+*     ELSE
+C  EM-PARTICLE ENERGY IS ABOVE LPM EFFECT AND MUST BE TREATED BY LPM,
+C  IF EM_PARTICLES ARE REQUESTED BY EGS OR NKG
+*       IF ( FNKG .OR. FEGS ) CALL LPM(ENER)
+*     ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/etadec.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/etadec.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/etadec.f	(revision 286)
@@ -0,0 +1,182 @@
+      SUBROUTINE ETADEC
+ 
+C-----------------------------------------------------------------------
+C  ETA DEC(AY)
+C
+C  ROUTINE TREATES DECAY OF ETA
+C  DECAY WITH FULL KINEMATIC, ENERGY AND MOMENTA CONSERVED
+C  THIS SUBROUTINE IS CALLED FROM BOX3
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,DECAY.
+      COMMON /DECAY/   GAM345,COS345,PHI345
+      DOUBLE PRECISION GAM345(3),COS345(3),PHI345(3)
+*KEEP,EDECAY.
+      COMMON /EDECAY/  CETA
+      DOUBLE PRECISION CETA(5)
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION AUX1,AUX2,COSTH1,COSTH2,EETA2,FI1
+      INTEGER          I
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' ETADEC: CURPAR=',1P,9E10.3)
+ 
+C  SELECT MODE OF DECAY, IF NOT ALREADY SELECTED BY THE PARTICLE TYPE
+      IF ( ITYPE .EQ. 17 ) THEN
+        CALL RMMAR( RD,1,1 )
+        IF     ( RD(1) .LE. CETA(1) ) THEN
+          ITYPE = 71
+        ELSEIF ( RD(1) .LE. CETA(2) ) THEN
+          ITYPE = 72
+        ELSEIF ( RD(1) .LE. CETA(3) ) THEN
+          ITYPE = 73
+        ELSE
+          ITYPE = 74
+        ENDIF
+      ENDIF
+ 
+C  COPY COORDINATES INTO SECPAR
+      DO  1  I = 5,8
+        SECPAR(I) = CURPAR(I)
+  1   CONTINUE
+      SECPAR( 9)  = GEN
+      SECPAR(10)  = ALEVEL
+ 
+C  DECAY OF ETA  WITH 4 MODES
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  DECAY    ETA  ---->  GAMMA + GAMMA
+      IF     ( ITYPE .EQ. 71 ) THEN
+        EETA2  = 0.5D0 * GAMMA * PAMA(17)
+        CALL RMMAR( RD,2,1 )
+        AUX1   = 1.D0 + BETA * RD(1)
+        AUX2   = 1.D0 - BETA * RD(1)
+        COSTH1 = (BETA + RD(1)) / AUX1
+        COSTH2 = (BETA - RD(1)) / AUX2
+ 
+        SECPAR(1) = 1.D0
+C  FIRST GAMMA (WITH HIGHER ENERGY)
+        FI1       = PI2 * RD(2)
+        CALL ADDANG( COSTHE,PHI, COSTH1,FI1, SECPAR(3),SECPAR(4) )
+        IF ( SECPAR(3) .GT. C(29) ) THEN
+          SECPAR(2) = AUX1 * EETA2
+          CALL TSTACK
+        ENDIF
+C  SECOND GAMMA (WITH LOWER ENERGY)
+        CALL ADDANG( COSTHE,PHI, COSTH2,FI1+PI, SECPAR(3),SECPAR(4) )
+        IF ( SECPAR(3) .GT. C(29) ) THEN
+          SECPAR(2) = AUX2 * EETA2
+          CALL TSTACK
+        ENDIF
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  DECAY    ETA  ---->  PI(0) + PI(0) + PI(0)
+      ELSEIF ( ITYPE .EQ. 72 ) THEN
+        CALL DECAY6( PAMA(17), PAMA(7),PAMA(7),PAMA(7),
+     *               0.D0,0.D0,0.D0, 1.D0, 2 )
+        SECPAR(1) = 7.D0
+        DO 340  I = 1,3
+          CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
+     *                                SECPAR(3),SECPAR(4) )
+          IF ( SECPAR(3) .GT. C(29) ) THEN
+            SECPAR(2) = GAM345(I)
+            CALL TSTACK
+          ENDIF
+  340   CONTINUE
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  DECAY    ETA  ---->   PI(-) + PI(+) + PI(0)
+      ELSEIF ( ITYPE .EQ. 73 ) THEN
+        CALL DECAY6( PAMA(17), PAMA(9),PAMA(8),PAMA(7),
+     *               CETA(4),0.D0,0.D0, CETA(5), 2 )
+        DO 360  I = 1,3
+          CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
+     *                                  SECPAR(3),SECPAR(4) )
+          IF ( SECPAR(3) .GT. C(29) ) THEN
+            SECPAR(1) = 10 - I
+            SECPAR(2) = GAM345(I)
+            CALL TSTACK
+          ENDIF
+  360   CONTINUE
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  DECAY    ETA  ---->  PI(+) + PI(-) + GAMMA
+      ELSEIF ( ITYPE .EQ. 74 ) THEN
+        CALL DECAY6( PAMA(17), PAMA(8),PAMA(9),0.D0,
+     *               0.D0,0.D0,0.D0, 1.D0, 2 )
+        DO 380  I = 1,3
+          CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
+     *                                SECPAR(3),SECPAR(4) )
+          IF ( SECPAR(3) .GT. C(29) ) THEN
+            IF ( I .LE. 2 ) THEN
+              SECPAR(1) = 7 + I
+            ELSE
+              SECPAR(1) = 1.D0
+            ENDIF
+            SECPAR(2)   = GAM345(I)
+            CALL TSTACK
+          ENDIF
+  380   CONTINUE
+ 
+      ELSE
+        WRITE(MONIOU,*) 'ETADEC: UNEXPECTED PARTICLE CODE ITYPE=',ITYPE
+      ENDIF
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/flpsor.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/flpsor.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/flpsor.f	(revision 286)
@@ -0,0 +1,63 @@
+      SUBROUTINE FLPSOR(A,N)
+ 
+C-----------------------------------------------------------------------
+C CERN PROGLIB# M103    FLPSOR          .VERSION KERNFOR  3.15  820113
+C ORIG. 29/04/78
+C-----------------------------------------------------------------------
+C   SORT THE ONE-DIMENSIONAL FLOATING POINT ARRAY A(1),...,A(N) BY
+C   INCREASING VALUES
+C
+C     PROGRAM  M103  TAKEN FROM CERN PROGRAM LIBRARY,  29-APR-78
+C-----------------------------------------------------------------------
+ 
+      DIMENSION A(*)
+      COMMON /SLATE/ LT(20),RT(20)
+      INTEGER R,RT
+C-----------------------------------------------------------------------
+ 
+      LEVEL=1
+      LT(1)=1
+      RT(1)=N
+   10 L=LT(LEVEL)
+      R=RT(LEVEL)
+      LEVEL=LEVEL-1
+   20 IF(R.GT.L) GO TO 200
+      IF(LEVEL) 50,50,10
+C
+C   SUBDIVIDE THE INTERVAL L,R
+C     L : LOWER LIMIT OF THE INTERVAL (INPUT)
+C     R : UPPER LIMIT OF THE INTERVAL (INPUT)
+C     J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT)
+C     I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT)
+C
+  200 I=L
+      J=R
+      M=(L+R)/2
+      X=A(M)
+  220 IF(A(I).GE.X) GO TO 230
+      I=I+1
+      GO TO 220
+  230 IF(A(J).LE.X) GO TO 231
+      J=J-1
+      GO TO 230
+C
+  231 IF(I.GT.J) GO TO 232
+      W=A(I)
+      A(I)=A(J)
+      A(J)=W
+      I=I+1
+      J=J-1
+      IF(I.LE.J) GO TO 220
+C
+  232 LEVEL=LEVEL+1
+      IF((R-I).GE.(J-L)) GO TO 30
+      LT(LEVEL)=L
+      RT(LEVEL)=J
+      L=I
+      GO TO 20
+   30 LT(LEVEL)=I
+      RT(LEVEL)=R
+      R=J
+      GO TO 20
+   50 RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/fstack.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/fstack.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/fstack.f	(revision 286)
@@ -0,0 +1,127 @@
+      SUBROUTINE FSTACK
+ 
+C-----------------------------------------------------------------------
+C  F(ROM) STACK
+C
+C  GETS PARTICLE FROM STACK AND READS FROM DISK IF NECESSARY
+C  THIS SUBROUTINE IS CALLED FORM MAIN
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,ETHMAP.
+      COMMON /ETHMAP/  ECTMAP,ELEFT
+      DOUBLE PRECISION ECTMAP,ELEFT
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,IRET.
+      COMMON /IRET/    IRET1,IRET2
+      INTEGER          IRET1,IRET2
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,POLAR.
+      COMMON /POLAR/   POLART,POLARF
+      DOUBLE PRECISION POLART,POLARF
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKF.
+      COMMON /STACKF/  STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+      INTEGER          MAXSTK
+      PARAMETER        (MAXSTK = 12*340*2)
+      DOUBLE PRECISION STACK(MAXSTK)
+      INTEGER          STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+*KEND.
+ 
+      INTEGER I,ISTK,J
+      DATA ISTK / MAXSTK /
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'FSTACK:'
+ 
+C  STACK EMPTY, SOMETHING TO BE READ FROM DISK ?
+      IF ( STACKP .EQ. 0 ) THEN
+        IF ( NOUREC .EQ. 0 ) THEN
+          IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,224) NTO,NFROM
+ 224      FORMAT(/' NO MORE SECONDARIES FOUND ON STACK'/
+     *            ' ',I10,' PARTICLES WRITTEN TO STACK'/
+     *            ' ',I10,' PARTICLES READ FROM STACK' )
+          CURPAR(1) = 0.D0
+          IRET1 = 1
+          RETURN
+        ENDIF
+C  READ LAST BLOCK OF 340 PARTICLES FROM DISK
+        READ(EXST,REC=NOUREC) (STACK(I),I=1,ISTK/2)
+        NOUREC = NOUREC - 1
+        STACKP = ISTK/2
+      ENDIF
+ 
+      NFROM  = NFROM + 1
+      ICOUNT = ICOUNT - 1
+ 
+C  PUT PARTICLE FROM STACK INTO CURPAR
+      STACKP = STACKP - MAXLEN
+      DO  5  J = 1,8
+        CURPAR(J) = STACK(STACKP+J)
+    5 CONTINUE
+      GEN    = STACK(STACKP+ 9)
+      ALEVEL = STACK(STACKP+10)
+      POLART = STACK(STACKP+11)
+      POLARF = STACK(STACKP+12)
+      IF ( PAMA(NINT(CURPAR(1))) .NE. 0.D0 ) THEN
+        ELEFT  = ELEFT - CURPAR(2)*PAMA(NINT(CURPAR(1)))
+      ELSE
+        ELEFT  = ELEFT - CURPAR(2)
+      ENDIF
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,667) ICOUNT,(CURPAR(J),J=1,8)
+  667 FORMAT('+       ',I7,1X,1P,9E10.3)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/gam.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/gam.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/gam.f	(revision 286)
@@ -0,0 +1,40 @@
+      DOUBLE PRECISION FUNCTION GAM( Z )
+ 
+C-----------------------------------------------------------------------
+C  GAM(MA FUNCTION)
+C
+C  EULER'S GAMMA FUNCTION
+C  THE INTERNAL PRECISION OF THIS FUNCTION IS ONLY SINGLE PRECISION.
+C  THIS FUNCION IS CALLED FROM NKG
+C  ARGUMENT:
+C   Z      = ARGUMENT OF GAMMA FUNCTION (0 < Z < 57)
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+ 
+      DOUBLE PRECISION U,Y,YY,Z
+C-----------------------------------------------------------------------
+ 
+C  CALCULATE CORRESPONDING FUNCTION VALUE IN INTERVAL 1 ... 2
+      Y   = MOD(Z,1.D0)
+      YY  = Y + 1.D0
+ 
+C  PARAMETRIZATION FOR VALUES IN INTERVAL 1 ... 2
+      GAM = 1.D0 + Y*(-0.5771017D0 + Y*(0.9858540D0+
+     *             Y*(-0.8764218D0 + Y*(0.8328212D0+
+     *             Y*(-0.5684729D0 + Y*(0.2548205D0+
+     *             Y*(-0.0514993D0  )))))))
+ 
+C  GET FUNCTION VALUE IN DESIRED INTERVAL BY ITERATION
+      IF ( Z .LT. 1.D0 ) THEN
+C  GAMMA(Z-1) IS  GAMMA(Z) / (Z-1)
+        GAM = GAM / Z
+      ELSE
+C  GAMMA(Z+1) IS  GAMMA(Z) * Z
+        DO  1  U = YY, Z-1.D0, 1.D0
+          GAM = GAM * U
+ 1      CONTINUE
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/garndm.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/garndm.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/garndm.f	(revision 286)
@@ -0,0 +1,13 @@
+      REAL FUNCTION GARNDM(DUMMY)
+ 
+C-----------------------------------------------------------------------
+C  1 EXPONENTIALLY DISTRIBUTED RANDOM NUMBER
+C-----------------------------------------------------------------------
+ 
+      REAL RD(1)
+C-----------------------------------------------------------------------
+ 
+      CALL RMMAR(RD,1,1)
+      GARNDM = -LOG(RD(1))
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/gbrsgm.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/gbrsgm.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/gbrsgm.f	(revision 286)
@@ -0,0 +1,112 @@
+      REAL FUNCTION GBRSGM(Z,E)
+ 
+C-----------------------------------------------------------------------
+C  CALCULATES MUON BREMSSTRAHLUNG CROSS SECTIONS
+C
+C  THIS SUBROUTINE IS TAKEN FROM GEANT321 PACKAGE (WITH MODIFICATIONS)
+C  CALCULATES CROSS-SECTION IN CURRENT MATERIAL FOR DISCRETE(HARD) MUON
+C  BREMSSTRAHLUNG.   (SIG IN BARN/ATOM)
+C  FOR A DESCRIPTION SEE: CERN PROGRAM LIBRARY LONG WRITEUP W5013 (1993)
+C  THIS FUNCTION IS CALLED FROM BOX2
+C  ARGUMENTS:
+C   Z (R4) = ATOMIC NUMBER OF PENETRATET MATERIAL
+C   E (R4) = TOTAL ENERGY OF MUON
+C
+C  AUTHOR  : L.URBAN
+C  MODIFIED: D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,MUPART.
+      COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
+      DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
+      LOGICAL          FMUBRM,FMUORG
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      REAL    C(52),AKSI,ALFA,E,ECMAX,FAC,GAM,
+     *        S,SS,X,XX,Y,YY,Z
+      INTEGER I,J,K
+      SAVE    C
+      DATA    AKSI/2.30/, ALFA/1.06/, GAM/0.63/
+      DATA    C/ 0.949313E-07,-0.819600E-07, 0.529075E-07,-0.832023E-08
+     +         , 0.539299E-09,-0.127042E-10,-0.165784E-08,-0.307788E-07
+     +         , 0.977905E-08,-0.113658E-08, 0.574481E-10,-0.106221E-11
+     +         , 0.968339E-09,-0.108640E-08,-0.177634E-09, 0.889497E-10
+     +         ,-0.876878E-11, 0.264303E-12, 0.216263E-08,-0.152680E-08
+     +         , 0.380989E-09,-0.455274E-10, 0.264172E-11,-0.596016E-13
+     +         , 0.444927E-09,-0.272978E-09, 0.645634E-10,-0.748783E-11
+     +         , 0.424890E-12,-0.940837E-14, 0.162289E-10,-0.362486E-11
+     +         ,-0.576652E-12, 0.211269E-12,-0.185482E-13, 0.522065E-15
+     +         ,-0.215590E-09, 0.112204E-09,-0.819133E-11, 0.145128E-12
+     +         ,-0.206029E-09, 0.559940E-10,-0.483350E-11, 0.134252E-12
+     +         ,-0.368469E-10, 0.999457E-11,-0.904967E-12, 0.272717E-13
+     +         ,-0.303446E-11, 0.853429E-12,-0.785466E-13, 0.236435E-14/
+C-----------------------------------------------------------------------
+ 
+      GBRSGM = 0.
+      IF ( E-PAMA(5) .LE. BCUT ) RETURN
+      ECMAX = E - CMUON(10) * Z**0.333333
+      IF ( ECMAX .LE. BCUT ) RETURN
+      X = LOG(E/PAMA(5))
+ 
+      S = 0.
+      YY = 1.
+      DO 30 I = 1,6
+        XX = 1.
+        DO 20 J = 1,6
+          K  = 6*I + J - 6
+          S  = S + C(K) * XX * YY
+          XX = XX * X
+  20    CONTINUE
+        YY = YY * CMUON(11)
+  30  CONTINUE
+      SS = 0.
+      YY = 1.
+      DO 50 I = 1,4
+        XX = 1.
+        DO 40 J = 1,4
+          K  = 4*I + J + 32
+          SS = SS + C(K) * XX * YY
+          XX = XX * X
+  40    CONTINUE
+        YY = YY * CMUON(11)
+  50  CONTINUE
+      S = S + Z * SS
+      IF ( S .LE. 0. ) RETURN
+ 
+      FAC = LOG(ECMAX/BCUT)
+      IF ( FAC .LE. 0. ) RETURN
+      FAC = Z * ( Z + AKSI * (1.+GAM*LOG(Z)) ) * FAC**ALFA
+      GBRSGM = FAC * S
+ 
+*     IF ( DEBUG ) WRITE(MDEBUG,444) Z,E,GBRSGM
+* 444 FORMAT(' GBRSGM: Z=',F3.0,' E=',1P,E10.4,' GBRSGM=',E10.4)
+ 
+  99  RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/gprsgm.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/gprsgm.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/gprsgm.f	(revision 286)
@@ -0,0 +1,158 @@
+      REAL FUNCTION GPRSGM(Z,E)
+ 
+C-----------------------------------------------------------------------
+C  G(EANT) P(AI)R S(I)GM(A)
+C  CALCULATES MUON PAIR PRODUCTION CROSS SECTIONS
+C
+C  THIS SUBROUTINE IS TAKEN FROM GEANT321 PACKAGE (WITH MODIFICATIONS)
+C  CALCULATES CROSS-SECTION IN CURRENT MATERIAL FOR DISCRETE(HARD) MUON
+C  PAIR PRODUCTION.  (SIG IN BARN/ATOM)
+C  FOR A DESCRIPTION SEE: CERN PROGRAM LIBRARY LONG WRITEUP W5013 (1993)
+C  THIS SUBROUTINE IS CALLED FROM BOX2
+C  ARGUMENTS:
+C   Z (R4) = ATOMIC NUMBER OF PENETRATET MATERIAL
+C   E (R4) = TOTAL ENERGY OF MUON
+C
+C  AUTHOR  : L.URBAN
+C  MODIFIED: D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,MUPART.
+      COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
+      DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
+      LOGICAL          FMUBRM,FMUORG
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      REAL        C(100),C1(60),C2(40),AKSI,ALFA,E,ECMAX,ECMIN,FAC,GAM,
+     *            S,SS,VS,X,XX,Y,YY,Z
+      INTEGER     I,J,K
+      EQUIVALENCE (C(1),C1(1)),(C(61),C2(1))
+      SAVE        C
+      DATA        AKSI/1.16/,ALFA/3.46/,GAM/0.06/,VS/0.019/
+      DATA        ECMIN/2.044E-3/
+      DATA C1/0.230181E-08,-0.280842E-08, 0.137525E-08,-0.156503E-09
+     +      , 0.728088E-11,-0.122631E-12, 0.133014E-08,-0.160591E-09
+     +      ,-0.390814E-09, 0.314492E-10, 0.251296E-12,-0.574223E-13
+     +      , 0.604923E-09,-0.560766E-09, 0.660253E-09,-0.103474E-09
+     +      , 0.621338E-11,-0.135273E-12, 0.103739E-09, 0.710290E-09
+     +      ,-0.544755E-10,-0.211241E-11, 0.286443E-12,-0.644602E-14
+     +      , 0.332492E-09,-0.484785E-10, 0.126921E-10,-0.165217E-11
+     +      , 0.845273E-13,-0.143180E-14,-0.112267E-13, 0.113308E-11
+     +      , 0.292577E-12,-0.733441E-13, 0.475747E-14,-0.976279E-16
+     +      ,-0.112856E-07, 0.936398E-08,-0.291882E-08, 0.422266E-09
+     +      ,-0.279042E-10, 0.678485E-12, 0.112383E-07,-0.964400E-08
+     +      , 0.313121E-08,-0.440224E-09, 0.278668E-10,-0.643012E-12
+     +      ,-0.414131E-08, 0.355112E-08,-0.115035E-08, 0.158539E-09
+     +      ,-0.976788E-11, 0.216911E-12, 0.521380E-09,-0.442265E-09
+     +      , 0.141753E-09,-0.190826E-10, 0.114038E-11,-0.242085E-13/
+      DATA C2/0.572943E-10,-0.296824E-10, 0.630217E-11,-0.623179E-12
+     +      , 0.211467E-13,-0.143579E-10,-0.137247E-11, 0.118670E-11
+     +      ,-0.793091E-13, 0.124745E-14,-0.269884E-10, 0.125314E-10
+     +      ,-0.239259E-11, 0.181151E-12,-0.470277E-14,-0.342454E-11
+     +      , 0.976666E-12,-0.236792E-12, 0.213290E-13,-0.607799E-15
+     +      ,-0.748844E-12, 0.178214E-12,-0.226827E-13, 0.148441E-14
+     +      ,-0.367972E-16, 0.840330E-12, 0.820025E-11,-0.294797E-11
+     +      , 0.294669E-12,-0.970294E-14,-0.830636E-12,-0.309273E-11
+     +      , 0.124169E-11,-0.135879E-12, 0.481683E-14, 0.438223E-12
+     +      , 0.259162E-12,-0.149284E-12, 0.180170E-13,-0.677948E-15/
+C-----------------------------------------------------------------------
+      GPRSGM=0.
+C     IF ( ECMIN .GT. BCUT ) CUT=ECMIN
+ 
+      ECMAX  = E - CMUON(10) * Z**OB3
+      IF ( ECMAX .LE. BCUT ) RETURN
+      X = LOG(E/PAMA(5))
+      Y = LOG( BCUT/(VS*E) )
+ 
+      S = 0.
+      YY = 1.
+      DO 30 I = 1,2
+        XX = 1.
+        DO 20 J = 1,6
+          K  = 6*I + J - 6
+          S  = S + C(K) * XX * YY
+          XX = XX * X
+ 20     CONTINUE
+        YY = YY * Y
+ 30   CONTINUE
+      DO 50 I = 3,6
+        XX = 1.
+        DO 40 J = 1,6
+          K = 6*I + J - 6
+          IF ( Y .LE. 0. ) THEN
+            S = S + C(K) * XX * YY
+          ELSE
+            S = S + C(K+24) * XX * YY
+          ENDIF
+          XX = XX * X
+ 40     CONTINUE
+        YY = YY * Y
+ 50   CONTINUE
+      SS = 0.
+      YY = 1.
+      DO 70 I = 1,2
+        XX = 1.
+        DO 60 J = 1,5
+          K = 5*I + J + 55
+          SS = SS + C(K) * XX * YY
+          XX = XX * X
+ 60     CONTINUE
+        YY = YY * Y
+ 70   CONTINUE
+      DO 90 I = 3,5
+        XX = 1.
+        DO 80 J = 1,5
+          K = 5*I + J + 55
+          IF ( Y .LE. 0. ) THEN
+            SS = SS + C(K) * XX * YY
+          ELSE
+            SS = SS + C(K+15) * XX * YY
+          ENDIF
+          XX = XX * X
+ 80     CONTINUE
+        YY = YY * Y
+ 90   CONTINUE
+ 
+      S = S + Z * SS
+      IF ( S .LE. 0. ) RETURN
+C  DE/DX SHOULD BE MONOTON INCREASING AS A
+C  FUNCTION OF THE CUT
+C  SOLUTION: LIN. INTERPOLATION FOR 0.2*ECMAX<CUT<ECMAX
+      FAC = 2. * ( LOG(ECMAX/BCUT) )**ALFA
+      FAC = Z * ( Z + AKSI*( 1.+GAM*LOG(Z) ) ) * FAC
+      GPRSGM = FAC * S
+*     IF ( DEBUG ) WRITE(MDEBUG,444) Z,E,GPRSGM
+* 444 FORMAT(' GPRSGM: Z=',F3.0,' E=',1P,E10.4,' GPRSGM=',E10.4)
+ 
+ 99   RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/granor.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/granor.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/granor.f	(revision 286)
@@ -0,0 +1,21 @@
+      SUBROUTINE GRANOR(A,B)
+ 
+C-----------------------------------------------------------------------
+C  TWO GAUSSIAN DISTRIBUTED RANDOM NUMBERS (MEAN=0, SIGMA=1)
+C
+C  RANDOM NUMBER GENERATORS USED BY THE GHEISHA ROUTINES
+C  ADAPTED FOR USE WITH THE CORSIKA RANDOM NUMBER GENERATORS
+C
+C  DESIGN  : J. KNAPP   IK1  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      REAL RD(2)
+C-----------------------------------------------------------------------
+ 
+      CALL RMMAR(RD,2,1)
+      U1 = SQRT(-2.*LOG(RD(1)))
+      U2 = RD(2) * 6.28318530718
+      A = COS(U2) * U1
+      B = SIN(U2) * U1
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/grndm.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/grndm.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/grndm.f	(revision 286)
@@ -0,0 +1,60 @@
+      SUBROUTINE GRNDM(RVEC,LENV)
+ 
+C-----------------------------------------------------------------------
+C  G(ENERATOR OF) R(A)ND(O)M (NUMBERS)
+C
+C  THIS ROUTINE IS IDENTICAL TO RMMAR
+C  DESCRIPTION OF ALGORITHM SEE SUBROUTINE RMMAR
+C  THIS SUBROUTINE IS CALLED FROM GHEISHA ROUTINES
+C  ARGUMENTS:
+C   RVEC   = VECTOR FIELD TO BE FILLED WITH RANDOM NUMBERS
+C   LENV   = LENGTH OF VECTOR (# OF RANDNUMBERS TO BE GENERATED)
+C
+C  CERN PROGLIB# V113    RMMAR           .VERSION KERNFOR  1.0
+C  ORIG. 01/03/89 FCA + FJ
+C-----------------------------------------------------------------------
+ 
+      REAL RVEC(*)
+      COMMON /RANMA2/ IU(1030),JSEQ
+      COMMON /RANMA3/ TWOM24,TWOM48,CD,CM,CINT,MODCNS
+      INTEGER I97(0:1030),J97(0:1030),NTOT(0:1030),NTOT2(0:1030),
+     *        IJKL(0:1030)
+      REAL    U(1030),C(0:1030)
+      EQUIVALENCE (IJKL(0),IU(1)),(NTOT(0),IU(2)),(NTOT2(0),IU(3))
+      EQUIVALENCE (U(1),IU(4)),(C(0),IU(101)),(I97(0),IU(102))
+      EQUIVALENCE (J97(0),IU(103))
+C-----------------------------------------------------------------------
+ 
+      ISEQ = 1
+      IF ( ISEQ .GT. 0 ) JSEQ = ISEQ
+      IBASE = (JSEQ-1)*103
+ 
+      DO 100  IVEC = 1,LENV
+        UNI = U(IBASE+I97(IBASE))-U(IBASE+J97(IBASE))
+        IF ( UNI .LT. 0. ) UNI = UNI+1.
+        U(IBASE+I97(IBASE)) = UNI
+        I97(IBASE) = I97(IBASE)-1
+        IF ( I97(IBASE) .EQ. 0 ) I97(IBASE) = 97
+        J97(IBASE) = J97(IBASE)-1
+        IF ( J97(IBASE) .EQ. 0 ) J97(IBASE) = 97
+        C(IBASE)   = C(IBASE) - CD
+        IF ( C(IBASE) .LT. 0. ) C(IBASE) = C(IBASE)+CM
+        UNI = UNI-C(IBASE)
+        IF ( UNI .LT. 0. ) UNI = UNI+1.
+C  REPLACE EXACT ZEROES BY UNIFORM DISTR. *2**-24
+        IF ( UNI .EQ. 0. ) THEN
+          UNI = TWOM24*U(2)
+C  AN EXACT ZERO HERE IS VERY UNLIKELY, BUT LET'S BE SAFE.
+          IF ( UNI .EQ. 0. ) UNI = TWOM48
+        ENDIF
+        RVEC(IVEC) = UNI
+  100 CONTINUE
+ 
+      NTOT(IBASE) = NTOT(IBASE) + LENV
+      IF ( NTOT(IBASE) .GE. MODCNS )  THEN
+        NTOT2(IBASE) = NTOT2(IBASE) + 1
+        NTOT(IBASE)  = NTOT(IBASE) - MODCNS
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/hatch.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/hatch.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/hatch.f	(revision 286)
@@ -0,0 +1,402 @@
+      SUBROUTINE HATCH
+C                                VERSION 4.00  --  26 JAN 1986/1900
+C******************************************************************
+C   SETUP WHICH THE USER IS EXPECTED TO DO BEFORE CALLING HATCH IS:
+C     1. SET 'NMED' TO THE NUMBER OF MEDIA TO BE USED.
+C     2. SET THE ARRAY 'MEDIA', WHICH CONTAINS THE NAMES OF THE
+C        MEDIA THAT ARE DESIRED.  THE CHARACTER FORMAT IS A1, SO
+C        THAT MEDIA(IB,IM) CONTAINS THE IB'TH BYTE OF THE NAME OF
+C        THE IM'TH MEDIUM IN A1 FORMAT.
+C     3. SET 'DUNIT', THE DISTANCE UNIT TO BE USED.
+C        DUNIT.GT.0 MEANS VALUE OF DUNIT IS LENGTH OF DISTANCE UNIT
+C        CENTIMETERS.  DUNIT.LT.0 MEANS USE THE RADIATION LENGTH OF
+C        THE ABS(DUNIT)'TH MEDIUM FOR THE DISTANCE UNIT.
+C     4. FILL THE ARRAY 'MED' WITH THE MEDIUM INDICES FOR THE
+C        REGIONS.
+C     5. FILL ARRAYS 'ECUT' AND 'PCUT' WITH THE ELECTRON AND PHOTON
+C        CUT-OFF ENERGIES FOR EACH REGION RESPECTIVELY.  SETUP WILL
+C        RAISE THESE IF NECESSARY TO MAKE THEM AT LEAST AS LARGE AS
+C        THE REGION'S MEDIUM'S AE AND AP RESPECTIVELY.
+C     6. FILL 'MED' ARRAY.  MED(IR) IS THE MEDIUM INDEX FOR REGION
+C        IR.  A ZERO MEDIUM INDEX MEANS THE REGION IS IN A VACUUM.
+C     7. FILL THE ARRAY 'IRAYLR' WITH 1 FOR EACH REGION IN WHICH
+C        RAYLEIGH (COHERENT) SCATTERING IS TO BE INCLUDED.
+C******************************************************************
+      CHARACTER MBUF*72,MDLABL*8
+      DIMENSION ZEROS(3)
+CNOTE: ABOVE IS ZEROS OF SINE, 0,PI,TWOPI
+      COMMON/BOUNDS/ECUT(6),PCUT(6),VACDST
+      COMMON/BREMPR/DL1(6),DL2(6),DL3(6),DL4(6),DL5(6),DL6(6),DELCM, ALP
+     *HI(2),BPAR(2),DELPOS(2),PWR2I(50)
+      COMMON/ELECIN/EKELIM,ICOMP,EKE0,EKE1,CMFP0,CMFP1,RANGE0,RANGE1, XR
+     *0,TEFF0,BLCC,XCC,PICMP0(1),PICMP1(1),EICMP0(1),EICMP1(1),MPEEM(1),
+     * ESIG0(500),ESIG1(500),PSIG0(500),PSIG1(500),EDEDX0(500),EDEDX1(50
+     *0),PDEDX0(500),PDEDX1(500),EBR10(500),EBR11(500),PBR10(500),PBR11(
+     *500),PBR20(500),PBR21(500),TMXS0(500),TMXS1(500),CMFPE0(1),CMFPE1(
+     *1),CMFPP0(1),CMFPP1(1),ERANG0(1),ERANG1(1),PRANG0(1),PRANG1(1),CXC
+     *2E0(1),CXC2E1(1),CXC2P0(1),CXC2P1(1),CLXAE0(1),CLXAE1(1),CLXAP0(1)
+     *,CLXAP1(1), THR0(1,1),THR1(1,1),THR2(1,1),THRI0(1,1),THRI1(1,1),TH
+     *RI2(1,1),FSTEP(16),FSQR(16),MSMAP(200), VERT1(1000),VERT2(100,16),
+     *MSTEPS,JRMAX,MXV1, MXV2,NBLC,NRNTH,NRNTHI,BLC0,BLC1,RTHR0,RTHR1,RT
+     *HRI0,RTHRI1
+      COMMON /MEDIA/ NMED, RLC,RLDU,RLDUI,RHO,MSGE,MGE,MSEKE,MEKE,MLEKE,
+     *MCMFP,MRANGE,IRAYLM,HBARO(6),HBAROI(6)
+      CHARACTER MEDIA*24
+      COMMON/MEDIAC/MEDIA
+      COMMON/MISC/KMPI,KMPO,DUNIT,NOSCAT,MED(6),RHOR(6),IRAYLR(6)
+      COMMON/PHOTIN/EBINDA,GE0,GE1, MPGEM(1),GMFP0(500),GMFP1(500),GBR10
+     *(500),GBR11(500),GBR20(500),GBR21(500),GBR30(500),GBR31(500),GBR40
+     *(500),GBR41(500),NGR,RCO0,RCO1, RSCT0(100),RSCT1(100), COHE0(500),
+     *COHE1(500)
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
+      COMMON/UPHIIN/SINC0,SINC1,SIN0(20002),SIN1(20002)
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      DATA MDLABL/' MEDIUM='/,LMDL/8/,LMDN/24/,DUNITO/1./
+      DATA I1ST/1/,NSINSS/37/,MXSINC/20002/,ISTEST/0/,NRNA/1000/
+510   FORMAT(1X,14I5)
+520   FORMAT(1X,1P,5E14.5)
+530   FORMAT(A72)
+      IF (I1ST.NE.0) THEN
+       I1ST=0
+       PRM=RM
+       RMI=1./PRM
+       PRMT2=2.D0*PRM
+       PZERO=0.0D0
+       NISUB=MXSINC-2
+       FNSSS=NSINSS
+       WID=PI5D2/REAL(NISUB)
+       WSS=WID/(FNSSS-1.0)
+       ZEROS(1)=0.
+       ZEROS(2)=PI
+       ZEROS(3)=TWOPI
+        DO 541 ISUB=1,MXSINC
+        SX=0.
+        SY=0.
+        SXX=0.
+        SXY=0.
+        XS0=WID*REAL(ISUB-2)
+        XS1=XS0+WID
+        IZ=0
+         DO 551 IZZ=1,3
+         IF ((XS0.LE.ZEROS(IZZ)).AND.(ZEROS(IZZ).LE.XS1)) THEN
+          IZ=IZZ
+          GO TO552
+         END IF
+551     CONTINUE
+552     CONTINUE
+        IF (IZ.EQ.0) THEN
+         XSI=XS0
+        ELSE
+         XSI=ZEROS(IZ)
+        END IF
+         DO 561 ISS=1,NSINSS
+         XS=WID*REAL(ISUB-2)+WSS*REAL(ISS-1)-XSI
+         YS=SIN(XS+XSI)
+         SX=SX+XS
+         SY=SY+YS
+         SXX=SXX+XS*XS
+         SXY=SXY+XS*YS
+561     CONTINUE
+562     CONTINUE
+        IF (IZ.NE.0) THEN
+         SIN1(ISUB)=SXY/SXX
+         SIN0(ISUB)=-SIN1(ISUB)*XSI
+        ELSE
+         DEL=FNSSS*SXX-SX*SX
+         SIN1(ISUB)=(FNSSS*SXY-SY*SX)/DEL
+         SIN0(ISUB)=(SY*SXX-SX*SXY)/DEL - SIN1(ISUB)*XSI
+        END IF
+541    CONTINUE
+542    CONTINUE
+       SINC0=2.0
+       SINC1=1.0/WID
+       IF (ISTEST.NE.0) THEN
+        ADEV=0.
+        RDEV=0.
+        S2C2MN=10.
+        S2C2MX=0.
+         DO 571 ISUB=1,NISUB
+          DO 581 ISS=1,NSINSS
+          THETA=WID*REAL(ISUB-1)+WSS*REAL(ISS-1)
+          CTHET=PI5D2-THETA
+          LTHETA=SINC1*THETA+SINC0
+          LCTHET=SINC1*CTHET+SINC0
+          SINTHE=SIN1(LTHETA)*THETA+SIN0(LTHETA)
+          COSTHE=SIN1(LCTHET)*CTHET+SIN0(LCTHET)
+          SINT=SIN(THETA)
+          COST=COS(THETA)
+          ASD=ABS(SINTHE-SINT)
+          ACD=ABS(COSTHE-COST)
+          ADEV=MAX(ADEV,ASD,ACD)
+          IF((SINT.NE.0.0))RDEV=MAX(RDEV,ASD/ABS(SINT))
+          IF((COST.NE.0.0))RDEV=MAX(RDEV,ACD/ABS(COST))
+          S2C2=SINTHE**2+COSTHE**2
+          S2C2MN=MIN(S2C2MN,S2C2)
+          S2C2MX=MAX(S2C2MX,S2C2)
+          IF (ISUB.LT.11) THEN
+           WRITE(KMPO,590)THETA,SINTHE,SINT,COSTHE,COST
+590        FORMAT(1P,5E20.7)
+          END IF
+581      CONTINUE
+582      CONTINUE
+571     CONTINUE
+572     CONTINUE
+        WRITE(KMPO,600)MXSINC,NSINSS
+600     FORMAT(' SINE TESTS,MXSINC,NSINSS=',2I5)
+        WRITE(KMPO,610)ADEV,RDEV,S2C2MN,S2C2MX
+610     FORMAT(' ADEV,RDEV,S2C2(MN,MX) =',1P,4E16.8)
+        ADEV=0.
+        RDEV=0.
+        S2C2MN=10.
+        S2C2MX=0.
+         DO 621 IRN=1,NRNA
+         CALL RMMAR(THETA,1,2)
+         THETA=THETA*PI5D2
+         CTHET=PI5D2-THETA
+         LTHETA=SINC1*THETA+SINC0
+         LCTHET=SINC1*CTHET+SINC0
+         SINTHE=SIN1(LTHETA)*THETA+SIN0(LTHETA)
+         COSTHE=SIN1(LCTHET)*CTHET+SIN0(LCTHET)
+         SINT=SIN(THETA)
+         COST=COS(THETA)
+         ASD=ABS(SINTHE-SINT)
+         ACD=ABS(COSTHE-COST)
+         ADEV=MAX(ADEV,ASD,ACD)
+         IF((SINT.NE.0.0))RDEV=MAX(RDEV,ASD/ABS(SINT))
+         IF((COST.NE.0.0))RDEV=MAX(RDEV,ACD/ABS(COST))
+         S2C2=SINTHE**2+COSTHE**2
+         S2C2MN=MIN(S2C2MN,S2C2)
+         S2C2MX=MAX(S2C2MX,S2C2)
+621     CONTINUE
+622     CONTINUE
+        WRITE(KMPO,630)NRNA
+630     FORMAT(' TEST AT ',I7,' RANDOM ANGLES IN (0,5*PI/2)')
+        WRITE(KMPO,640)ADEV,RDEV,S2C2MN,S2C2MX
+640     FORMAT(' ADEV,RDEV,S2C2(MN,MX) =',1P,4E16.8)
+       END IF
+       P=1.
+        DO 651 I=1,50
+        PWR2I(I)=P
+        P=P*.5
+651    CONTINUE
+652    CONTINUE
+      END IF
+       DO 661 IM=1,NMED
+670    CONTINUE
+        DO 671 I=1,6
+        IF (IRAYLR(I).EQ.1.AND.MED(I).EQ.IM) THEN
+         IRAYLM=1
+         GO TO 672
+        END IF
+671    CONTINUE
+672    CONTINUE
+661   CONTINUE
+662   CONTINUE
+      REWIND KMPI
+      NM=0
+       DO 681 IM=1,NMED
+       LOK=0
+       IF (IRAYLM.EQ.1) THEN
+        WRITE(KMPO,690)IM
+690     FORMAT(' RAYLEIGH OPTION REQUESTED FOR MEDIUM NUMBER',I3,/)
+       END IF
+681   CONTINUE
+682   CONTINUE
+700   CONTINUE
+701    CONTINUE
+710    CONTINUE
+711     CONTINUE
+        READ(KMPI,530,END=720)MBUF
+         DO 731 IB=1,LMDL
+         IF((MBUF(IB:IB).NE.MDLABL(IB:IB)))GO TO 711
+731     CONTINUE
+732     CONTINUE
+740     CONTINUE
+         DO 741 IM=1,NMED
+          DO 751 IB=1,LMDN
+          IL=LMDL+IB
+          IF((MBUF(IL:IL).NE.MEDIA(IB:IB)))GO TO 741
+          IF((IB.EQ.LMDN))GO TO 712
+751      CONTINUE
+752      CONTINUE
+741     CONTINUE
+742     CONTINUE
+       GO TO 711
+712    CONTINUE
+       IF((LOK.NE.0))GO TO 710
+       LOK=1
+       NM=NM+1
+       WRITE(KMPO,760)IM,MBUF
+760    FORMAT(' DATA FOR MEDIUM #',I3,', WHICH IS:',A72)
+       READ(KMPI,770)(MBUF(I:I),I=1,5),RHO,NE
+770    FORMAT(5A1,5X,F11.0,4X,I2)
+       WRITE(KMPO,780)(MBUF(I:I),I=1,5),RHO,NE
+780    FORMAT(5A1,',RHO=',1P,G11.4, ',NE=',I2,',COMPOSITION IS :')
+        DO 791 IE=1,NE
+        READ(KMPI,530)MBUF
+        WRITE(KMPO,530)MBUF
+791    CONTINUE
+792    CONTINUE
+       READ(KMPI,520)RLC,AE,AP,UE,UP
+       TE=AE-RM
+       THMOLL=TE*2. + RM
+       READ(KMPI,510)MSGE,MGE,MSEKE,MEKE,MLEKE,MCMFP,MRANGE,IRAYL
+       NSGE=MSGE
+       NGE=MGE
+       NSEKE=MSEKE
+       NEKE=MEKE
+       NLEKE=MLEKE
+       NCMFP=MCMFP
+       NRANGE=MRANGE
+       READ(KMPI,520)(DL1(I),DL2(I),DL3(I),DL4(I),DL5(I),DL6(I),I=1,6)
+       READ(KMPI,520)DELCM,(ALPHI(I),BPAR(I),DELPOS(I),I=1,2)
+       READ(KMPI,520)XR0,TEFF0,BLCC,XCC
+       READ(KMPI,520)EKE0,EKE1
+       READ(KMPI,520)(ESIG0(I),ESIG1(I),PSIG0(I),PSIG1(I),EDEDX0(I),EDED
+     * X1(I),PDEDX0(I),PDEDX1(I),EBR10(I),EBR11(I),PBR10(I),PBR11(I),PBR
+     * 20(I),PBR21(I),TMXS0(I),TMXS1(I),I=1,NEKE)
+       READ(KMPI,520)EBINDA,GE0,GE1
+       READ(KMPI,520)(GMFP0(I),GMFP1(I),GBR10(I),GBR11(I),GBR20(I),GBR21
+     * (I),GBR30(I),GBR31(I),GBR40(I),GBR41(I),I=1,NGE)
+       IF (IRAYLM.EQ.1.AND.IRAYL.NE.1) THEN
+        WRITE(KMPO,800)IM
+800     FORMAT(' STOPPED IN HATCH: REQUESTED RAYLEIGH OPTION FOR MEDIUM'
+     *  ,I3/ ' BUT RAYLEIGH DATA NOT INCLUDED IN DATA CREATED BY PEGS.')
+        STOP
+       END IF
+       IF (IRAYL.EQ.1) THEN
+        READ(KMPI,510)NGR
+        NGRIM=NGR
+        READ(KMPI,520)RCO0,RCO1
+        READ(KMPI,520)(RSCT0(I),RSCT1(I),I=1,NGRIM)
+        READ(KMPI,520)(COHE0(I),COHE1(I),I=1,NGE)
+        IF (IRAYLM.NE.1) THEN
+         WRITE(KMPO,810)IM
+810      FORMAT(' RAYLEIGH DATA AVAILABLE FOR MEDIUM',I3,' BUT OPTION ',
+     *    'NOT REQUESTED.',/)
+        END IF
+       END IF
+       IF((NM.GE.NMED))GO TO702
+      GO TO 701
+702   CONTINUE
+      DUNITR=DUNIT
+      IF (DUNIT.LT.0.0) THEN
+       MD=MAX(1,MIN(1,IFIX(-DUNIT)))
+       DUNIT=RLC
+      END IF
+      IF (DUNIT.NE.1.0) THEN
+       WRITE(KMPO,820)DUNITR,DUNIT
+820    FORMAT(' DUNIT REQUESTED&USED ARE:',1P,2E14.5,'(CM.)')
+      END IF
+       DO 831 IM=1,NMED
+       DFACT=RLC/DUNIT
+       DFACTI=1.0/DFACT
+       I=1
+        GO TO 843
+841     I=I+1
+843     IF(I-(MEKE).GT.0)GO TO 842
+        ESIG0(I)=ESIG0(I)*DFACTI
+        ESIG1(I)=ESIG1(I)*DFACTI
+        PSIG0(I)=PSIG0(I)*DFACTI
+        PSIG1(I)=PSIG1(I)*DFACTI
+        EDEDX0(I)=EDEDX0(I)*DFACTI
+        EDEDX1(I)=EDEDX1(I)*DFACTI
+        PDEDX0(I)=PDEDX0(I)*DFACTI
+        PDEDX1(I)=PDEDX1(I)*DFACTI
+        TMXS0(I)=TMXS0(I)*DFACT
+        TMXS1(I)=TMXS1(I)*DFACT
+       GO TO 841
+842    CONTINUE
+       I=1
+        GO TO 853
+851     I=I+1
+853     IF(I-(MLEKE).GT.0)GO TO 852
+        ERANG0(I)=ERANG0(I)*DFACT
+        ERANG1(I)=ERANG1(I)*DFACT
+        PRANG0(I)=PRANG0(I)*DFACT
+        PRANG1(I)=PRANG1(I)*DFACT
+       GO TO 851
+852    CONTINUE
+       TEFF0=TEFF0*DFACT
+       BLCC=BLCC*DFACTI
+       XCC=XCC*SQRT(DFACTI)
+       RLDU=RLC/DUNIT
+       RLDUI=1./RLDU
+       I=1
+        GO TO 863
+861     I=I+1
+863     IF(I-(MGE).GT.0)GO TO 862
+        GMFP0(I)=GMFP0(I)*DFACT
+        GMFP1(I)=GMFP1(I)*DFACT
+       GO TO 861
+862    CONTINUE
+831   CONTINUE
+832   CONTINUE
+      VACDST=VACDST*DUNITO/DUNIT
+      DUNITO=DUNIT
+       DO 871 JR=1,6
+       MD=MED(JR)
+       IF ((MD.GE.1).AND.(MD.LE.NMED)) THEN
+        ECUT(JR)=MAX(ECUT(JR),AE,AP+1.1*RM)
+        PCUT(JR)=MAX(PCUT(JR),AP)
+        IF((RHOR(JR).EQ.0.0))RHOR(JR)=RHO
+       END IF
+871   CONTINUE
+872   CONTINUE
+      IF (NMED.EQ.1) THEN
+       WRITE(KMPO,880)
+880    FORMAT(' EGS SUCCESSFULLY ''HATCHED'' FOR ONE MEDIUM.')
+      ELSE
+       WRITE(KMPO,890)NMED
+890    FORMAT(' EGS SUCCESSFULLY ''HATCHED'' FOR ',I5,' MEDIA.')
+      END IF
+      RETURN
+720   WRITE(KMPO,900)KMPI
+900   FORMAT(' END OF FILE ON UNIT ',I2,//, ' PROGRAM STOPPED IN HATCH '
+     *, 'BECAUSE THE'/ ' FOLLOWING NAMES WERE NOT RECOGNIZED:',/)
+       DO 911 IM=1,NMED
+       IF (LOK.NE.1) THEN
+        WRITE(KMPO,920)(MEDIA(I:I),I=1,LMDN)
+920     FORMAT(40X,'''',24A1,'''')
+       END IF
+911   CONTINUE
+912   CONTINUE
+      STOP
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/hdpm.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/hdpm.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/hdpm.f	(revision 286)
@@ -0,0 +1,875 @@
+      SUBROUTINE HDPM
+ 
+C-----------------------------------------------------------------------
+C  H(ADRONIC) D(UAL) P(ARTON) M(ODEL)
+C
+C  GENERATOR OF HADRONIC COLLISION INSPIRED BY DUAL PARTON MODEL
+C  THIS SUBROUTINE IS CALLED FROM SDPM
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,DPMFLG.
+      COMMON /DPMFLG/  NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+      INTEGER          NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+*KEEP,ELADPM.
+      COMMON /ELADPM/  ELMEAN,ELMEAA,IELDPM,IELDPA
+      DOUBLE PRECISION ELMEAN(37),ELMEAA(37)
+      INTEGER          IELDPM(37,13),IELDPA(37,13)
+*KEEP,ELASTY.
+      COMMON /ELASTY/  ELAST,IELIS,IELHM,IELNU,IELPI
+      DOUBLE PRECISION ELAST
+      INTEGER          IELIS(20),IELHM(20),IELNU(20),IELPI(20)
+*KEEP,INDICE.
+      COMMON /INDICE/  NNUCN,NKA0,NHYPN,NETA,NETAS,NPIZER,
+     *                 NNC,NKC,NHC,NPC,NCH,NNN,NKN,NHN,NET,NPN
+      INTEGER          NNUCN(2:3),NKA0(2:3),NHYPN(2:3),NETA(2:3,1:4),
+     *                 NETAS(2:3),NPIZER(2:3),
+     *                 NNC,NKC,NHC,NPC,NCH,NNN,NKN,NHN,NET,NPN
+*KEEP,INTER.
+      COMMON /INTER/   AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
+     *                 IDIF,ITAR
+      DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
+      INTEGER          IDIF,ITAR
+*KEEP,ISTA.
+      COMMON /ISTA/    IFINET,IFINNU,IFINKA,IFINPI,IFINHY
+      INTEGER          IFINET,IFINNU,IFINKA,IFINPI,IFINHY
+*KEEP,LEPAR.
+      COMMON /LEPAR/   LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
+      INTEGER          LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
+*KEEP,MULT.
+      COMMON /MULT/    EKINL,MSMM,MULTMA,MULTOT
+      DOUBLE PRECISION EKINL
+      INTEGER          MSMM,MULTMA(37,13),MULTOT(37,13)
+*KEEP,NEWPAR.
+      COMMON /NEWPAR/  EA,PT2,PX,PY,TMAS,YR,ITYP,
+     *                 IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
+     *                 IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
+      DOUBLE PRECISION EA(3000),PT2(3000),PX(3000),PY(3000),TMAS(3000),
+     *                 YR(3000)
+      INTEGER          ITYP(3000),
+     *                 IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
+     *                 IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RATIOS.
+      COMMON /RATIOS/  RPI0R,RPIER,RPEKR,RPEKNR,PPICH,PPINCH,PPNKCH,
+     *                 ISEL,NEUTOT,NTOTEM
+      DOUBLE PRECISION RPI0R,RPIER,RPEKR,RPEKNR,PPICH,PPINCH,PPNKCH
+      INTEGER          ISEL,NEUTOT,NTOTEM
+*KEEP,RESON.
+      COMMON /RESON/   RDRES,RESRAN,IRESPAR
+      REAL             RDRES(2),RESRAN(1000)
+      INTEGER          IRESPAR
+ 
+*KEEP,REST.
+      COMMON /REST/    CONTNE,TAR,LT
+      DOUBLE PRECISION CONTNE(3),TAR
+      INTEGER          LT
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444   FORMAT(' HDPM  : CURPAR=',1P,9E10.3)
+ 
+C  SET ANTI-LEADER TO PROTON OR NEUTRON; TARGET IS ALWAYS NUCLEON
+      CALL RMMAR( RD,1,1 )
+      IF ( RD(1) .LE. CONTNE(LT) ) THEN
+        ITAR = 13
+      ELSE
+        ITAR = 14
+      ENDIF
+ 
+ 
+C  CALCULATE LAB AND CM ENERGY
+      IF ( ITYPE .NE. 1 ) THEN
+        ELAB  = PAMA(ITYPE) * GAMMA
+        PLAB  = ELAB * BETA
+        S     = PAMA(ITYPE)**2 + PAMA(ITAR)**2 + 2.D0*PAMA(ITAR)*ELAB
+      ELSE
+C  FOR GAMMA-INDUCED REACTION TAKE PI(0) AS LEADING PARTICLE
+        ITYPE = 7
+        ELAB  = GAMMA
+        PLAB  = ELAB
+        S     = PAMA(ITAR)**2 + 2.D0*PAMA(ITAR)*ELAB
+      ENDIF
+ 
+      ECMDPM  = SQRT(S)
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'HDPM  : ITYPE,ELAB,PLAB,S,ECMDPM=',
+     *             ITYPE,SNGL(ELAB),SNGL(PLAB),SNGL(S),SNGL(ECMDPM)
+ 
+C  LN(S), LN(S)**2 AND RAPIDITY OF C. M. SYSTEM IN LAB
+      SLOG    = LOG(S)
+      SLOGSQ  = SLOG**2
+      SMLOG   = LOG( 2.D0 * PAMA(ITAR) * ELAB )
+      ELABLG  = LOG(ELAB)
+      EPLUSP  = ELAB + PLAB
+*     YCM = 0.5D0 * LOG( (ELAB+PAMA(ITAR)+PLAB)/(ELAB+PAMA(ITAR)-PLAB) )
+      YCM = 0.5D0 * LOG( (EPLUSP**2     +PAMA(ITAR)*EPLUSP)/
+     *                   (PAMA(ITYPE)**2+PAMA(ITAR)*EPLUSP) )
+      IF ( DEBUG ) WRITE(MDEBUG,*)'HDPM  : SLOG,SLOGSQ,YCM=',
+     *                    SNGL(SLOG),SNGL(SLOGSQ),SNGL(YCM)
+ 
+C-----------------------------------------------------------------------
+C  RETURN POINT IF CALCULATION OF PARTICLES GOES WRONG
+   1  CONTINUE
+ 
+      IF ( ITYPE .NE. 7 ) THEN
+C  CHOOSE NUMBER OF INTERACTIONS IN TARGET
+        CALL TARINT
+      ELSE
+C  FOR GAMMA-INDUCED REACTIONS TAKE ALWAYS ONE COLLISION
+        GNU = 1.D0
+      ENDIF
+ 
+C-----------------------------------------------------------------------
+C  NO DIFFRACTION IF
+C  OR       THE NUMBER OF INTERACTIONS IN TARGET IS CHOSEN RANDOMLY
+C     AND   MORE THAN ONE INTERACTION TAKES PLACE
+C  OR       PRIMARY PARTICLE IS GAMMA (PI0)
+C  NOW NFLDIF DECIDES WHETHER DIFFRACTIVE PROCESS POSSIBLE OR NOT
+      IF ( ( NFLAIN.EQ.0 .AND. GNU.GT.1.D0 .AND. NFLDIF.EQ.0 )
+     *      .OR. ( ITYPE .EQ. 7 ) ) THEN
+        IDIF = 0
+      ELSE
+C  SET DIFFRACTION FLAG IF RANDOM NUMBER < PROBABILITY
+        CALL RMMAR( RD,1,1 )
+C  IDIF IS 0 : NO DIFFRACTION ; IDIF IS 1 : DIFFRACTION
+C  DIFFRACTION RISES WITH ENERGY AND SATURATES AT 10000 GEV
+C  ### DAS TUT ES ABER NICHT: ES IST KONSTANT 0.15 (SIEHE DPFUNC) !!!!
+        IF ( RD(1) .GT. DPFUNC(ECMDPM) ) THEN
+          IDIF = 0
+        ELSE
+          IDIF = 1
+        ENDIF
+      ENDIF
+ 
+ 
+C  PRINTOUT FOR DEBUG
+      IF ( DEBUG ) THEN
+        WRITE(MDEBUG,*) '    DIFFRACTIVE INTERACTION (0/1) = ',IDIF
+      ENDIF
+ 
+C  SET COUNTER FOR REPEAT TO 0
+      NREPRD = 0
+ 
+C  GENERATION OF INTERACTION
+ 1919 CONTINUE
+ 
+C  FLAG TO CHECK NUMBER OF SECONDARIES;
+C  IS CHANGED TO 1 IF SECONDARY MULTIPLICITY IS LOW
+      ISEL   = 0
+C  SET LEADING PARTICLE TO INCOMING PARTICLE AND ANTI-LEADER TO NUCLEON
+C  (AS IT COMES FROM TARGET NUCLEUS) BOTH MAY BE CHANGED BY LEPACX
+      LEPAR1 = ITYPE
+      LEPAR2 = ITAR
+ 
+      IF ( IDIF .EQ. 0 ) THEN
+C-----------------------------------------------------------------------
+C  NON SINGLE DIFFRACTIVE PROCESS STARTS HERE
+ 
+        CALL NSD
+C  CHARGE EXCHANGE ENABLED? EXCHANGE LEADER AND ANTI-LEADER
+        LASTPI = 0
+        NRESPC = 0
+        NRESPN = 0
+        NCPLUS = 0
+        IF ( NFLCHE .EQ. 0 ) THEN
+          CALL LEPACX( ECMDPM,ELABLG,LEPAR1,1 )
+          CALL LEPACX( ECMDPM,ELABLG,LEPAR2,2 )
+        ENDIF
+ 1921   CONTINUE
+        CALL RNEGBI( NCH,AVCH,ECMDPM )
+C  NCH IS # OF ALL CHARGED PARTICLES INCLUDING EXCESS FROM TARGET
+        IF ( NCH .LT. 1 ) THEN
+          IF ( LEPAR1 .LT. 50  .OR.  LEPAR2 .LT. 50 ) THEN
+            NREPRD = NREPRD + 1
+            IF ( NREPRD .GT. 10 ) GOTO 1
+            GOTO 1921
+          ELSE
+C  INTERACTION IS ONLY RESONANCE PRODUCTION
+            ISEL = 1
+          ENDIF
+        ENDIF
+C  WIDTH PLATEAU FOR CLUSTERS AND FOR CALCULATION OF CENTR.RAP.DENSITY
+        DELRAP = 0.6722D0 * (2.95D0 + 0.0302D0 * SLOG)
+C  SET RSLOG FOR CALCULATION OF PARTICLE RATIOS
+        RSLOG  = SLOG
+C  AVERAGE TRANSVERSE MOMENTUM
+        CALL AVEPT( ECMDPM,SLOG )
+ 
+      ELSE
+C-----------------------------------------------------------------------
+C  SINGLE DIFFRACTIVE PROCESS STARTS HERE
+ 
+ 1920   CONTINUE
+        CALL DIFRAC( NRETDF )
+        IF ( NRETDF .EQ. 1 ) GOTO 1
+C  CHARGE EXCHANGE ENABLED?  EXCHANGE CHARGE OF DIFFRACTING PARTICLE
+        LASTPI = 0
+        NRESPC = 0
+        NRESPN = 0
+        NCPLUS = 0
+        IF ( NFLCHE .EQ. 0 ) THEN
+          IF ( YY0 .GT. 0.D0 ) THEN
+C  PROJECTILE DIFFRACTION
+            CALL LEPACX( ECMDIF,DMLOG,LEPAR1,1 )
+          ELSE
+C  TARGET DIFFRACTION
+            CALL LEPACX( ECMDIF,DMLOG,LEPAR2,2 )
+          ENDIF
+        ENDIF
+C  FLUCTUATION OF MULTIPLICITY ACCORDING TO NEG.BIN. DISTRIBUTION
+        CALL RNEGBI( NCH,AVCH,ECMDIF )
+C  REPEAT CALCULATION AS SOMETHING WENT WRONG
+        IF ( NCH .LT. 1 ) THEN
+          IF ( (YY0 .GT. 0.D0  .AND.  LEPAR1 .LT. 50)  .OR.
+     *         (YY0 .LT. 0.D0  .AND.  LEPAR2 .LT. 50)        ) THEN
+            NREPRD = NREPRD + 1
+            IF ( NREPRD .GT. 10 ) GOTO 1
+            GOTO 1920
+          ELSE
+C  DIFFRACTIVE INTERACTION IS ONLY RESONANCE PRODUCTION
+            ISEL = 1
+          ENDIF
+        ENDIF
+C  SET RSLOG FOR CALCULATION OF PARTICLE RATIOS
+        RSLOG = DLOG
+C  HERE WE USE ECMDPM, BECAUSE THE MOMENTUM TRANSFER IS DEPENDENT
+C  ON THE ENERGY OF THE TOTAL SYSTEM AND NOT ON THE DIFFRACTING MASS
+        CALL AVEPT( ECMDPM,SLOG )
+ 
+      ENDIF
+ 
+C-----------------------------------------------------------------------
+C  NOW FOR NSD AND DIFFRACTIVE PROCESSES
+ 
+C  IN CASE OF LOW MULTIPLICITY SET FLAG ISEL
+      IF ( NCH .LE. 2 ) ISEL=1
+C  FNCH IS FLUCTUATING TOT.NUMBER OF CHARGED PARTICLES FOR ALL 3 STRINGS
+      FNCH  = DBLE(NCH)
+C  RATIO  ALL CHARGED PARTICLES  WITH FLUCTUATION/WITHOUT FLUCTUATION
+      XZ    = FNCH / AVCH
+C  FNCH3 IS FLUCTUATING NUMBER OF CHARGED PARTICLES FOR 3RD STRING
+      FNCH3 = XZ * AVCH3
+C  FNCH2 IS FLUCTUATING NUMBER OF CHARGED PARTICLES 1ST AND 2ND STRING
+      FNCH2 = FNCH - FNCH3
+C  RC3TO2 IS RATIO (CHARGED 3RD STRING)/(CHARGED 1ST AND 2ND STRING)
+      IF ( FNCH2 .NE. 0.D0 ) THEN
+        RC3TO2 = FNCH3 / FNCH2
+      ELSE
+        RC3TO2 = 0.D0
+      ENDIF
+      IF ( DEBUG ) WRITE(MDEBUG,*) '   FNCH,FNCH2,FNCH3,RC3TO2=',
+     *          SNGL(FNCH),SNGL(FNCH2),SNGL(FNCH3),SNGL(RC3TO2)
+ 
+C  IS NUMBER OF NEUTRALS FLUCTUATING AS NUMBER OF CHARGED ?
+      IF ( NFLPIF .EQ. 0 .OR. IDIF .EQ. 1 .OR. ECMDPM .LT. 60.D0 ) THEN
+C  SET NUMBER OF GAMMAS ACCORDING TO NEG. BIN. VARIABLE XZ
+C  AS NUMBER OF NEUTRALS FLUCTUATES AS CHARGED.
+        SEUGF = SEUGP * XZ
+        ZG    = XZ
+      ELSE
+C  NFLPIF IS 1 MEANS: # OF PI(0) FLUCTUATES AS MEASURED AT COLLIDER
+        IF ( ECMDPM .LT. 200.D0 ) THEN
+          SEUGF = SEUGP * XZ
+*         SEUGF = (0.0786D0*SLOG-0.010D0)*FNCH2 + (0.391D0*SLOG+0.305D0)
+        ELSE
+C  DETERMINE NEW NUMBER OF GAMMAS WITH FLUCTUATION AROUND SEUGP*XZ
+          AGR   = EXP(-XZ)
+          DGR   = SEUGP * XZ * (0.9823D0 - 0.3756D0 * AGR)
+          SGS   = DGR * (0.14718D0 + 2.53213D0 * AGR)
+ 723      CONTINUE
+          SEUGF = 0.88D0 * RANNOR(DGR,SGS)
+          IF ( SEUGF .LT. 1.D0 ) GOTO 723
+        ENDIF
+C  SET NEGATIVE BINOMIAL VARIABLE ZG FOR GAMMAS
+        ZG  = SEUGF / SEUGP
+      ENDIF
+      SEUGF = MAX( 1.D0, SEUGF )
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'HDPM  :XZ,ZG,SEUGF=',
+     *      SNGL(XZ),SNGL(ZG),SNGL(SEUGF)
+ 
+C-----------------------------------------------------------------------
+C  RATIO ALL-NUCLEON/ALL-CHARGED
+C  PARAMETRISATION FROM UA5, NUCL. PHYS. B291 (1987) 445 EQ.(2.4)
+      RNUCCH = MAX( 0.D0, -0.008D0 + 0.00865D0 * RSLOG )
+C  NUMBER FOR DIRECT NEUTRON/ANTINEUTRON PRODUCTION 1ST AND 2ND STRING
+C  MULTIPLY BY 0.5 BECAUSE RATIO RNUCCH GIVES (ALL-NUCL)/(ALL-CHARGED)
+C  AND HERE ONLY THE NEUTRON-ANTINEUTRONS ARE COUNTED
+      FNUCN  = 0.5D0 * RNUCCH * FNCH2
+C  RATIO (ALL CHARGED SIGMAS)/(ALL CHARGED) IS 1/3 OF ALL STRANGE BARYON
+C  PARAMETRISATION FORM UA5, NUCL. PHYS. B291 (1987) 445 EQ.(2.5)
+      RHYPCH = MAX( 0.D0, (-0.007D0 + 0.0028D0 * RSLOG) * OB3 )
+C  NEUTRAL STRANGE BARYONS ARE DOUBLE OF CHARGED STRANGE BARYONS
+      FHYPN  = 2.D0 * RHYPCH * FNCH2
+C  CORRECT NUMBER OF GAMMAS FROM NEUTRAL HYPERON DECAY S0-->L+GAMMA
+      SEUGFC = MAX( 0.D0, SEUGF - 0.5D0 * FHYPN )
+C  RATIO CHARGED-KAON/CHARGED PIONS
+C  PARAMETRISATION FROM UA5, NUCL. PHYS. B291 (1987) 445 EQ.(2.7)
+      RKPI   = MAX (0.D0, 0.024D0 + 0.0062D0 * RSLOG )
+C  RKCH IS RATIO (CHARGED-KAON)/(ALL-CHARGED) DERIVED FROM RKPI;
+C  THE FACTOR 0.5 IN FRONT OF RNUCCH IS BECAUSE ONLY HALF OF NUCLEONS
+C  ARE P/PBAR. THE 1.17 IS AN APROXIMATE CONVERSION FACTOR FROM
+C  (ALL-NUCL)/(ALL-CHARGED) TO (ALL-NUCL)/(CHARGED-PI), WHICH IS A BIT
+C  ENERGY DEPENDENT (1.14 ...1.21) SEE GEICH-GIMBEL TABLE 7.1
+      RKCH   = RKPI / (1.D0 + RKPI + (0.5D0*RNUCCH+RHYPCH) * 1.17D0)
+C  K0/K0-BAR  FOR 1ST AND 2ND STRING
+C  NEUTRAL KAONS ARE PRODUCED WITH THE SAME RATE AS CHARGED KAONS
+      FKA0   = RKCH * FNCH2
+C  RATIO ETA/PI(0) IS ASSUMED TO BE INDEPENDENT OF ENERGY = 0.19
+C  SEE: ANSORGE ET AL. (UA5-COLLABORATION) Z.PHYS.C43(1989)75
+*     RETPI0 = 0.19D0
+C  RATIO ETA/PI(0) IS ASSUMED TO BE DEPENDENT ON ENERGY
+C  SEE: GEICH-GIMBEL,INT.J.MOD.PHYS.A4(1989)1527 TAB.7.1
+C  HECK'S FIT:   RETPI0 IS 0.06 + 0.006*RSLOG + 0.0011*RSLOG**2
+      RETPI0 = 0.06D0 + 0.006D0 * RSLOG + 0.0011D0 * RSLOG**2
+C  AUXIL1 IS FRACTION OF PI(0)/(PI(0)+ETA)
+      AUXIL1 = 1.D0 / (1.D0 + RETPI0)
+C  NUMBER OF GAMMAS FROM PI(0) IS 2, FROM ETA IS 3.216 IN AVERAGE;
+C  AUXIL2 IS NUMBER OF GAMMA-PRODUCING-PARTICLES: PI(0) AND ETA
+      AUXIL2 = SEUGFC / ( AUXIL1 * 2.D0 + (1.D0 - AUXIL1) * 3.216D0 )
+      FETA   = (1.D0 - AUXIL1) * AUXIL2
+      FPI0   =         AUXIL1  * AUXIL2
+C  CORRECT FPI0 BY DECAYS OF STRANGE BARYONS; NEUTRAL: FHYPN*0.357
+C  CHARGED: 0.5*FNCH2*RHYPCH*0.5157; IT YIELDS FHYPN*(0.357+0.12893)
+      FPI0   = MAX( 0.D0, FPI0 - FHYPN * 0.486D0 )
+C  SUMMED NEUTRAL PARTICLES FOR 1ST AND 2ND STRING
+      FNEUT2 = FNUCN + FKA0 + FHYPN + FETA + FPI0
+C  NEUTRAL PARTICLES FROM 3RD STRING
+      FNEUT3 = RC3TO2 * FNEUT2
+C  TOTAL NUMBER OF NEUTRALS
+      FNEUT  = FNEUT2 + FNEUT3
+      NEUTOT = NINT( FNEUT )
+C  CALCULATE TOTAL NUMBER OF PARTICLES TO BE CREATED
+      NTOTEM = NCH + NEUTOT
+      IF ( DEBUG ) WRITE(MDEBUG,*)
+     *     '    FNUCN,FKA0,FHYPN,FETA,FPI0,FNEUT2,FNEUT3,NTOTEM=',
+     * SNGL(FNUCN),SNGL(FKA0),SNGL(FHYPN),SNGL(FETA),SNGL(FPI0),
+     * SNGL(FNEUT2),SNGL(FNEUT3),NTOTEM
+C  LIMIT OF SECONDARIES PRODUCED (GIVEN BY SIZE OF ARRAY : 3000)
+C  LIMIT IS ARRAY SIZE - SIZE OF LARGEST TARGET NUCLEUS(40)
+      IF ( NTOTEM .GE. 2956 ) THEN
+        WRITE(MONIOU,*) 'HDPM  : REJECT EVENT WITH ',NTOTEM,
+     *                  ' SECONDARIES'
+        GOTO 1
+      ENDIF
+C  SPECIAL TREATMENT IF MULTIPLICITY IS TOO LOW
+      IF ( NTOTEM .LE. 3 ) ISEL = 1
+ 
+C  FRACTION OF THE VARIOUS NEUTRAL PARTICLES (NN, K(0), L+S0 AS PAIRS)
+C  NORMALIZE WITH THE SUM OF ALL NEUTRAL PARTICLES
+      FNORML = 1.D0 / ( 0.5D0 * (FNUCN+FKA0+FHYPN) + FETA + FPI0 )
+      RNUCNR = FNUCN * FNORML * 0.5D0
+      RKA0R  = FKA0  * FNORML * 0.5D0
+      RHYPNR = FHYPN * FNORML * 0.5D0
+      RETAR  = FETA  * FNORML
+      RPI0R  = FPI0  * FNORML
+C  CUMULATED RATIOS (NN, K(0), LAMBDA+SIGMA0 AS PAIRS)
+      RPIER  = RPI0R + RETAR
+      RPEKR  = RPIER + RKA0R
+      RPEKNR = RPEKR + RNUCNR
+C THEN THE REMAINDER (1-RPEKNR) MUST BE NEUTRAL HYPERON PAIRS
+      IF ( DEBUG ) WRITE(MDEBUG,*)
+     *         '    RPI0R,RETAR,RKA0R,RNUCNR,RHYPNR,FNORML=',
+     *  SNGL(RPI0R),SNGL(RETAR),SNGL(RKA0R),SNGL(RNUCNR),SNGL(RHYPNR),
+     *  SNGL(FNORML)
+ 
+C  PROBABILITY TO PRODUCE CHARGED PIONS IS PROBABILITY NOT TO PRODUCE
+C  CHARGED KAONS OR PROTONS OR CHARGED HYPERONS, WHERE PROTON/ANTIPROTON
+C  IS HALF OF (ALL-NUCL)/(ALL-CHARGED)
+      AUXIL  = RKCH + 0.5D0 * RNUCCH + RHYPCH
+      AUXIL3 = 1.D0 - AUXIL
+C  RENORMALIZATION AS P/P_BAR, K+-, AND HYPERONS ARE PRODUCED IN PAIRS
+C  AUXIL2 IS INVERSE OF NORMALISATION
+      AUXIL2 = 1.D0 / (1.D0 - 0.5D0 * AUXIL)
+C  CUMULATED PROBABILITIES (PP, K+-, SIGMA+- AS PAIRS)
+      PPICH  = AUXIL3 * AUXIL2
+      PPINCH =  PPICH + 0.25D0 * RNUCCH * AUXIL2
+      PPNKCH =  PPINCH + 0.5D0 * RKCH * AUXIL2
+C THEN THE REMAINDER (1-PPNKCH) MUST BE CHARGED HYPERON PAIRS
+      IF ( DEBUG ) WRITE(MDEBUG,*) '   PPICH,PPINCH,PPNKCH=',
+     *         SNGL(PPICH),SNGL(PPINCH),SNGL(PPNKCH)
+ 
+C  NOW SELECT HOW MANY PARTICLES OF EACH TYPE ARE PRODUCED
+      CALL PARNUM( INUMFL )
+      IF ( INUMFL .NE. 0 ) GOTO 1919
+ 
+C  DEFINE PARTICLE NUMBERS WHERE SPECIAL RAPIDITY IS CALCULATED
+C  FOR PARTICLES FROM TARGET (THIRD STRING)
+      PPP = RC3TO2 / (1.D0+RC3TO2)
+C  NUMBER OF PARTICLES IN PROTON ANTIPROTON PAIRS FROM TARGET
+      ITA = NINT(PPP * 2.D0 * NNC)
+C  NUMBER OF PARTICLES IN K+ K- PAIRS FROM TARGET
+      ITB = NINT(PPP * 2.D0 * NKC)
+C  NUMBER OF PARTICLES IN SIGMA+ SIGMA- PAIRS FROM TARGET
+      ITC = NINT(PPP * 2.D0 * NHC)
+C  NUMBER OF PI+ PI- FROM TARGET
+      ITD = NINT(PPP * NPC )
+C  CALCULATE BOUNDARIES
+      IA1 = 2
+      IA2 = IA1 + ITA
+      IB1 = IA1 + 2 * NNC
+      IB2 = IB1 + ITB
+      IC1 = IB1 + 2 * NKC
+      IC2 = IC1 + ITC
+      ID1 = IC1 + 2 * NHC
+      ID2 = ID1 + ITD
+      IE1 = ID1 +     NPC
+C  NUMBER OF PARTICLES IN NEUTRON ANTINEUTRON PAIRS FROM TARGET
+      IE2 = IE1 + 2 * NNUCN(3)
+      IF1 = IE1 + 2 * NNN
+C  NUMBER OF PARTICLES IN K0S K0L PAIRS FROM TARGET
+      IF2 = IF1 + 2 * NKA0(3)
+      IG1 = IF1 + 2 * NKN
+C  NUMBER OF PARTICLES IN NEUTRAL HYPERON PAIRS FROM TARGET
+      IG2 = IG1 + 2 * NHYPN(3)
+      IH1 = IG1 + 2 * NHN
+C  NUMBER OF ETA FROM TARGET
+      IH2 = IH1 + NETAS(3)
+      II1 = IH1 +     NET
+C  NUMBER OF PI(0) FROM TARGET
+      II2 = II1 + NPIZER(3)
+      IJ1 = II1 +     NPN
+      IF ( DEBUG ) THEN
+        WRITE(MDEBUG,*) '   CHARGED FROM TARGET:',ITA,ITB,ITC,ITD
+        WRITE(MDEBUG,*) '   NEUTRAL FROM TARGET:',
+     *     2*NNUCN(3),2*NKA0(3),2*NHYPN(3),NETAS(3),NPIZER(3)
+        WRITE(MDEBUG,*) '   NTOTEM,IJ1=',NTOTEM,IJ1
+      ENDIF
+C  REDEFINE TOTAL NUMBER OF SECONDARY PARTICLES : NTOTEM
+C  BY CHARGE EXCHANGE AND RESONANCE FORMATION THIS NUMBER MAY BE ALTERED
+      NTOTEM = IJ1 - 2
+ 
+C-----------------------------------------------------------------------
+C  RATIO OF RAPIDITY DENSITY TO MEAN PSEUDORAPIDITY IN CENTER
+C  PARAMETRISATION SEE CAPDEVIELLE, J.PHYS.G:NUCL.PHYS.15(1989)909,EQ.6
+      IF ( XZ .LT. 1.5D0 ) THEN
+        RDS = (0.24396D0 + 0.70150424D0 * XZ)**2
+      ELSE
+        RDS = (0.55685D0 + 0.48664753D0 * XZ)**2
+      ENDIF
+C  CALCULATE NOW: DN/DY AT Y = 0; DC0 IS AVERAGE PSEUDORAPIDITY DENSITY
+C  TRAP IS RATIO (RAPID.DENS.)/(PSEUDORAP.DENS.) IN CENTER OF RAPIDITY
+      TRAP = 1.25D0
+      IF ( IDIF .EQ. 0  .AND.  ECMDPM .GT. 19.4D0 )
+     *                 TRAP = MAX( 1.D0, 1.28852D0 - 0.0065D0 * SMLOG )
+      DCN2 = DC0 * RDS * TRAP
+      IF ( DEBUG ) WRITE(MDEBUG,*) '   RDS,TRAP,DCN2=',
+     *                SNGL(RDS),SNGL(TRAP),SNGL(DCN2)
+C  AMPLITUDE OF GAUSSIAN 1ST AND 2ND STRING
+      ATG2 = FNCH2 / (5.0132566D0 * WIDC2)
+C  NEW DEFINITION OF POSITION BASED ON SEMI INCLUSIVE DATA
+      SQ2  = 2.D0 * ATG2 / DCN2
+C  FINAL POSITION OF GAUSSIAN;  WIDTH WIDC2 IS UNCHANGED
+      IF ( SQ2 .GT. 1.D0 )  POSC2 = WIDC2 * SQRT( 2.D0*LOG(SQ2) )
+C  DENSITY OF CHARGED IN EXCESS FROM TARGET IN CENTER OF RAPIDITY
+      DCN3 = 0.5D0 * (GNU - 1.D0) * DCN2
+      IF (DEBUG) WRITE(MDEBUG,*) '   SQ2,POSC2,DCN3=',
+     *          SNGL(SQ2),SNGL(POSC2),SNGL(DCN3)
+      IF ( DCN3 .GT. 0.D0 ) THEN
+C  AMPLITUDE 3RD GAUSSIAN
+        ATG3 = FNCH3 / (5.0132566D0 * WIDC3)
+C  AMPLITUDE IS DIVIDED BY DENSITY FOR GETTING CENTER OF 3RD GAUSSIAN
+        SQ3  = 2.D0 * ATG3 / DCN3
+C  CHECK IF ADDITIVE MULTIPLICITY IS TOO LOW
+        IF ( SQ3 .GT. 1.D0 )  POSC3 = WIDC3 * SQRT( 2.D0*LOG(SQ3) )
+        IF (DEBUG) WRITE(MDEBUG,*)'   SQ3,POSC3=',SNGL(SQ3),SNGL(POSC3)
+      ENDIF
+ 
+C  NFLPI0 .EQ. 0 MEANS TREAT PI(0) RAPIDITY ACCORDING TO COLLIDER DATA
+      IF ( NFLPI0 .EQ. 0 ) THEN
+C  RATIO OF RAPIDITY DENSITY TO MEAN PSEUDORAPIDITY AT CENTER WITH Z<1.5
+        IF ( ZG .LT. 1.5D0 ) THEN
+          RDG = (0.24396D0 + 0.70150424D0 * ZG)**2
+        ELSE
+          RDG = (0.55685D0 + 0.48664753D0 * ZG)**2
+        ENDIF
+C  GAMMAS USE RATIO TRAG TO CALCULATE RATIO OF RAPIDITY TO
+C  PSEUDO RAPIDITY DENSITY IN CENTER (TRAG = 1.1 * 0.5 ).
+C  FACTOR 0.5 COMES FROM RATIO NEUTRAL/CHARGED, AS WE USE DC0, WHICH
+C  IS AVERAGE PSEUDORAPIDITY DENSITY FOR CHARGED PIONS
+        TRAG = 0.55D0
+        IF ( IDIF .EQ. 0 ) THEN
+          IF ( ECMDPM .GT. 19.4D0 )
+     *               TRAG = MAX( 0.4D0, 0.6658D0 - 0.01954D0 * SMLOG )
+          IF     ( ECMDPM .LE.  50.D0 ) THEN
+            DCG = DC0 * RDG * TRAG
+          ELSEIF ( ECMDPM .LE. 200.D0 ) THEN
+            DCG = DC0 * RDG * TRAG * (1.D0 + 0.18D0 * LOG(ECMDPM/50.D0))
+          ELSE
+            DCG = DC0 * RDG * TRAG * 1.25D0
+          ENDIF
+        ELSE
+          DCG = DC0 * RDG * TRAG
+        ENDIF
+C  DEFINE WIDTH OF STRINGS FOR NEUTRAL PIONS AND ETAS
+        WIDN2 = WIDC2 * MIN( 1.D0, 1.12275D0 - 0.0208D0 * RSLOG )
+C  NEW DEFINITION OF CENTER OF GAUSSIAN BASED ON SEMI INCLUSIVE DATA
+C  USING AMPLITUDE OF THE GAUSSIAN FOR NEUTRALS
+        AUXIL = 2.D0 / (5.0132566D0 * WIDN2 * DCG)
+C  TOTAL MULTIPLICITY USED FOR 1ST AND 2ND STRING OF PI(0) AND ETA
+C  IS GIVEN BY THEIR NUMBERS. ANALOGOUS FOR 3RD STRING
+        SP2   = DBLE ( NPIZER(2)+NETAS(2)) * AUXIL
+C  FINAL CENTER OF GAUSSIANS FOR PI(0) AND ETA (WIDC2 IS UNCHANGED)
+        IF ( SP2 .GT. 1.D0 ) THEN
+          POSN2 = WIDN2 * SQRT( 2.D0 * LOG(SP2) )
+        ELSE
+          POSN2 = POSC2
+        ENDIF
+        WIDN3 = WIDN2
+        SP3   = DBLE(NPIZER(3)+NETAS(3)) * AUXIL
+        IF ( SP3 .GT. 1.D0 ) THEN
+          POSN3 = WIDN3 * SQRT( 2.D0 * LOG(SP3) )
+        ELSE
+          POSN3 = POSC3
+        ENDIF
+      ELSE
+C  NFLPI0 .EQ. 1 MEANS RAPIDITY OF PI(0) AND ETA SAME AS THAT OF CHARGED
+        POSN2 = POSC2
+        WIDN2 = WIDC2
+        POSN3 = POSC3
+        WIDN3 = WIDC3
+      ENDIF
+      IF ( DEBUG ) WRITE(MDEBUG,*)
+     *           '   ZG,RDG,DCG,SP2,SP3,POSN2,POSN3,WIDN2 =',
+     *   SNGL(ZG),SNGL(RDG),SNGL(DCG),SNGL(SP2),SNGL(SP3),SNGL(POSN2),
+     *   SNGL(POSN3),SNGL(WIDN2)
+ 
+C-----------------------------------------------------------------------
+      NREPR1 = 0
+C  RETURN POINT. NUMBERS OF PARTICLES REMAIN UNCHANGED FOR NEXT TRY,
+C  BUT INDIVIDUAL RAPIDITIES GET NEW VALUES.
+C  START FROM BEGINNING IF NO MATCH AFTER 20 TRIES
+  30  CONTINUE
+      NREPR1 = NREPR1 + 1
+      IF ( NREPR1 .GT. 20 ) THEN
+        IF ( IDIF .EQ. 1  .AND.  NREPRD .LE. 10 ) GOTO 1919
+        GOTO 1
+      ENDIF
+ 
+C  FOR TOTAL NUMBER OF PARTICLES ADD 2 FOR LEADER AND ANTILEADER
+      NTOT = NTOTEM + 2
+ 
+C  PRODUCTION OF INDIVIDUAL RAPIDITIES FOR ALL SECONDARY PARTICLES
+      CALL PARRAP
+CC    IF ( DEBUG ) THEN
+CC      WRITE (MDEBUG,*) '   RAPIDITIES:'
+CC      WRITE (MDEBUG,134) (I,YR(I), I=3,NTOT)
+C134    FORMAT('   ',1P, (1X, I4, 5X, G13.6 ))
+CC    ENDIF
+ 
+ 
+C  CALCULATION OF CENTRAL RAPIDITY WITHOUT (ANTI)LEADER
+C  MULTIPLICITY IN CENTER OF RAPIDITY DISTRIBUTION
+      IZN = 0.D0
+      IF ( IDIF .EQ. 0 ) THEN
+        DO 111  I = 3,NTOT
+          IF ( ABS(YR(I)) .LT. DELRAP ) IZN = IZN + 1
+ 111    CONTINUE
+        IF ( IZN .LT. 1 ) THEN
+          IF ( ISEL .EQ. 0 ) GOTO 30
+C  IN CASE OF FEW PARTICLES, SET PARTICLE NUMBER IN PLATEAU TO 1
+          IZN = 1
+        ENDIF
+C  CENTRAL RAPIDITY DENSITY FOR CHARGED PARTICLES
+        IF ( NTOTEM .GE. 1 ) THEN
+          ZNC = MAX( 1.1D0, DBLE(NCH)*IZN/(DBLE(NTOTEM)*2.D0*DELRAP) )
+        ELSE
+          ZNC = 1.1D0
+        ENDIF
+      ELSE
+C  DIFFRACTION: SHIFT RAPIDITIES + TAKE CENT.RAP.DENS. FROM PARAMETRISAT
+        DO 112  I = 3,NTOT
+          YR(I) = YR(I) + YY0
+ 112    CONTINUE
+        ZNC = MAX( 1.1D0, DCN2 )
+      ENDIF
+ 
+C  ZN ACCOUNTS FOR THE RISE OF PT WITH CENTRAL RAP.DENSITY. THE FORMULA
+C  IS A FIT TO UA1 VALUES OF ARNISON ET AL, PHYS.LETT.B118(1982)167
+C  REGARD, THAT OUR ZN IS DEFINED DIFFERENT FROM LITERATURE N BY 1
+C - - - - - -
+C  MODIFICATION AFTER J.N. CAPDEVIELLE, (DEC.96)
+      IF ( ECMDPM .LE. 500.D0 ) THEN
+        ZN = MAX( 1.00001D0, 3.669D0 / ZNC**0.435D0 + 6.4D0 )
+      ELSE
+C  TAKE INTO ACCOUNT THE RESULTS OF UA1/MIMI EXPERIMENT
+        IF ( ZNC .GE. 3.D0 ) THEN
+          ZN = 1.D0 /(ZNC*0.004111D0 + 0.145D0)+3.D0
+        ELSE
+C  FOR ROCH < 3.00 (MIMI)   (TO BE USED IN  PTRAM)
+          ZM = 0.0033D0 * (ZNC-1.56D0)**2 + 0.406D0
+          ZN = 2.64D0/ZM + 3.D0
+        ENDIF
+      ENDIF
+C - - - - - -
+C  NOW SET PARTICLE TYPE AND TRANSV. MOMENTA FOR NEW PARTICLES IN PPARAM
+C  SET ALSO TRANSVERSE MASS FOR ALL PARTICLES (INCL. LEADER+ANTILEADER)
+      CALL PPARAM
+ 
+      IF ( IDIF .EQ. 0 ) THEN
+C  NOW SET THE RAPIDITY OF THE ANTILEADER ACCORDING TO THE DISTRIBUTION
+C  IN THE FEYNMAN X VARIABLE; SET THE RAPIDITY OF LEADER TO CONSUME
+C  THE REMAINDER OF ENERGY
+        CALL LEDENY( LEDEFL )
+        IF ( LEDEFL .NE. 0 ) THEN
+          IF ( DEBUG ) WRITE(MDEBUG,*) '   LEDEFL=',LEDEFL
+          GOTO 30
+        ENDIF
+ 
+C  CALCULATE FOR SINGLE COLLISION SYSTEM C.M. ENERGY + RAPIDITY SHIFT
+        IF ( GNU .LE. 1.D0 ) THEN
+          JGNU   = 0.D0
+          DYGNU  = 0.D0
+          ECMJAD = ECMDPM
+        ELSE
+C  MULTIPLE COLLISION IN TARGET
+          JGNU   = NINT(GNU-1.D0)
+C  ADD ADDITIONALLY INTERACTING
+C  TARGET NUCLEONS TO GET CORRECT JADACH FILTERING
+C  CHOSE RANDOMLY WHETHER PROTON OR NEUTRON
+          CALL RMMAR( RD,JGNU,1 )
+          IPR = 0
+          INE = 0
+          TARMAS = PAMA(ITYP(2))
+          DO 114  I = 1,JGNU
+            NTOT       = NTOT + 1
+            IF ( RD(I) .LE. .5D0 ) THEN
+              ITYP(NTOT) = 13
+              INE = INE + 1
+            ELSE
+              ITYP(NTOT) = 14
+              IPR = IPR + 1
+            ENDIF
+            TMAS(NTOT) = PAMA(ITYP(NTOT))
+            TARMAS     = TARMAS + TMAS(NTOT)
+            EA(NTOT)   = TMAS(NTOT)
+            PX(NTOT)   = 0.D0
+            PY(NTOT)   = 0.D0
+            PT2(NTOT)  = 0.D0
+ 114      CONTINUE
+ 
+C  CALCULATE C.M. ENERGY + RAPIDITY SHIFT
+*         YCMGNU = 0.5D0 * LOG( (ELAB+TARMAS+PLAB)/(ELAB+TARMAS-PLAB) )
+          YCMGNU = 0.5D0 * LOG( (EPLUSP**2     +TARMAS*EPLUSP)/
+     *                          (PAMA(ITYPE)**2+TARMAS*EPLUSP) )
+          DYGNU  = YCM - YCMGNU
+ 
+C  CALCULATE RAPIDITIES OF ADDITIONALLY INTERACTING TARGET NUCLEONS
+C  IN THE CM SYSTEM OF NUCLEON-NUCLEON SYSTEM
+          DO 115  I = NTOT-JGNU+1,NTOT
+            YR(I) = - YCM
+ 115      CONTINUE
+C  SHIFT RAPIDITIES INTO CM SYSTEM OF GNU+1 MASSES
+          DO 113  I = 1,NTOT
+            YR(I) = YR(I) + DYGNU
+ 113      CONTINUE
+ 
+C  CENTER OF MASS ENERGY OF 1 PROJECTILE AND GNU TARGET NUCLEONS TO
+C  BE USED IN THE JADACH FILTER.
+          ECMJAD = SQRT( PAMA(ITYPE)**2 + TARMAS**2 + 2.D0*TARMAS*ELAB )
+ 
+        ENDIF
+ 
+      ELSE
+C  IN CASE OF DIFFRACTION SET THE RAPIDITY OF LEADER AND ANTILEADER
+C  IN SUBROUTINE LEADDF
+        DYGNU  = 0.D0
+        ECMJAD = ECMDPM
+        CALL LEADDF( IFLGLD )
+        IF ( IFLGLD .NE. 0 ) THEN
+          IF ( DEBUG ) WRITE(MDEBUG,*) '   IFLGLD=',IFLGLD
+          GOTO 30
+        ENDIF
+      ENDIF
+ 
+C  CORRECT THE RAPIDITIES TO CONSERVE LONGITUDINAL MOMENTA AND ENERGY
+C  USING THE ALGORITHM OF JADACH (SIMPLIFIED VERSION BY R. ATTALLAH)
+      CALL JADACH( ECMJAD,JADFLG )
+      IF ( JADFLG .NE. 0 ) THEN
+        IF ( DEBUG ) WRITE(MDEBUG,*) '   JADFLG=', JADFLG
+        IF ( JADFLG .GT. 0 ) GOTO 30
+        IF ( JADFLG .LT. 0 ) THEN
+          NREPRD = NREPRD + 1
+          IF ( NREPRD .GT. 10 ) GOTO 1
+          GOTO 1919
+        ENDIF
+      ENDIF
+ 
+ 
+C  CALCULATE LAB ENERGIES OF SECONDARY PARTICLES FROM THE RAPIDITIES
+C  INCLUDING THE ADDITIONAL TARGET NUCLEONS
+      ETOT = 0.D0
+      DO 135  I = 1,NTOT
+        YR(I) = YR(I) + YCM - DYGNU
+        EA(I) = TMAS(I) * COSH( YR(I) )
+        ETOT  = ETOT + EA(I)
+ 135  CONTINUE
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,136)
+     *             (I,ITYP(I),PX(I),PY(I),YR(I),EA(I),I=1,NTOT)
+ 136  FORMAT('  NO ITYP     PX          PY            YR          EA'/
+     *      (' ',I4,I3,1X,1P,4G13.6) )
+ 
+C-----------------------------------------------------------------------
+C  LOOP OVER ALL SECONDARY PARTICLES AND THE LEADING PARTICLE
+C  PUT THEM ON THE STACK
+      DO 139  LK = 5,8
+        SECPAR(LK) = CURPAR(LK)
+ 139  CONTINUE
+ 
+C  PROCESS LOOP
+      DO 140  J = 1,NTOT
+C  REJECTION OF BACKWARD GOING PARTICLES
+        IF ( YR(J) .LE. 0.D0 ) THEN
+          IF ( DEBUG ) WRITE(MDEBUG,*)'HDPM  : YR REJECT PARTICLE ',J
+          GOTO 140
+        ENDIF
+C  CALCULATE THE PROPERTIES OF ALL SECONDARIES
+C  PARTICLE TYPE
+        SECPAR(1) = ITYP(J)
+C  CALCULATE GAMMA FACTOR
+        SECPAR(2) = EA(J) / PAMA(ITYP(J))
+C  TOTAL MOMENTUM SQUARED
+        PTM = EA(J)**2 - PAMA(ITYP(J))**2
+        IF ( PT2(J) .GT. PTM ) THEN
+          IF ( DEBUG ) WRITE(MDEBUG,*)'HDPM  : PT REJECT PARTICLE ',J
+          GOTO 140
+        ENDIF
+C  EMISSION ZENITH ANGLE AGAINST TRAJECTORY OF PROJECTILE
+        IF ( PTM .EQ. 0.D0 ) THEN
+          COSTET = 1.D0
+        ELSE
+          COSTET = SQRT( 1.D0 - PT2(J) / PTM )
+        ENDIF
+C  EMISSION AZIMUTH ANGLE
+        IF ( PX(J) .NE. 0.D0  .OR.  PY(J) .NE. 0.D0 ) THEN
+          PHIJ = ATAN2( PY(J), PX(J) )
+        ELSE
+          PHIJ = 0.D0
+        ENDIF
+        CALL ADDANG( COSTHE,PHI, COSTET,PHIJ, SECPAR(3),SECPAR(4) )
+        IF ( SECPAR(3) .LT. C(29) ) THEN
+C  OMIT UPWARD GOING PARTICLES
+          IF (DEBUG) WRITE(MDEBUG,*)'HDPM  : ANGLE REJECT PARTICLE ',J
+          GOTO 140
+        ENDIF
+C  PUT SECONDARY PARTICLES ON STACK, IF NOT GOING UPWARDS
+        IF ( J .GT. 2 ) THEN
+          CALL TSTACK
+        ELSE
+C  PUT LEADER OR ANTI-LEADER ON STACK, IF NOT GOING UPWARDS
+          IF ( ITYP(J) .GT. 50 ) THEN
+C  LEADER OR ANTI LEADER ARE RESONANCES AND DECAY
+            IRESPAR = IRESPAR + 1
+            IF ( IRESPAR .GE. 1000 ) THEN
+              WRITE(MONIOU,*) 'STACK OF RESDEC RANDOM NUMBERS FULL'
+              IRESPAR = 999
+            ENDIF
+            RESRAN(IRESPAR) = RDRES(J)
+C  COUNTER FOR ENERGY-MULTIPLICITY MATRIX
+            MSMM = MSMM + 1
+          ENDIF
+          CALL TSTACK
+ 
+C  CALCULATE ELASTICITY FROM ENERGY OF LEADER (REST OF RESONANCE DECAY)
+          IF ( J. EQ. 1 ) ELASTI = SECPAR(2)*PAMA(NINT(SECPAR(1)))/ELAB
+        ENDIF
+C  COUNTERS FOR FIRST INTERACTION
+        IF ( FIRSTI ) THEN
+          IF     ( SECPAR(1) .EQ.  7.D0  .OR.  SECPAR(1) .EQ.  8.D0
+     *       .OR.  SECPAR(1) .EQ.  9.D0                           ) THEN
+            IFINPI = IFINPI + 1
+          ELSEIF ( SECPAR(1) .EQ. 13.D0  .OR.  SECPAR(1) .EQ. 14.D0
+     *       .OR.  SECPAR(1) .EQ. 15.D0 .OR. SECPAR(1) .EQ. 25.D0 ) THEN
+            IFINNU = IFINNU + 1
+          ELSEIF ( SECPAR(1) .EQ. 10.D0  .OR.  SECPAR(1) .EQ. 11.D0
+     *       .OR.  SECPAR(1) .EQ. 12.D0 .OR. SECPAR(1) .EQ. 16.D0 ) THEN
+            IFINKA = IFINKA + 1
+          ELSEIF ( SECPAR(1) .GE. 71.D0 .AND. SECPAR(1) .LE. 74.D0) THEN
+            IFINET = IFINET + 1
+          ELSEIF ((SECPAR(1) .GE. 18.D0 .AND. SECPAR(1) .LE. 24.D0)
+     *       .OR. (SECPAR(1) .GE. 26.D0 .AND. SECPAR(1) .LE. 32.D0))THEN
+            IFINHY = IFINHY + 1
+          ENDIF
+        ENDIF
+ 
+ 140  CONTINUE
+ 
+C  COUNTER FOR ENERGY-MULTIPLICITY MATRIX
+      MSMM = MSMM + NTOT - 2
+ 
+C  FILL ELASTICITY IN MATRICES
+      MEL = MIN ( 1.D0+10.D0*      MAX( 0.D0, ELASTI ) , 11.D0 )
+      MEN = MIN ( 4.D0+ 3.D0*LOG10(MAX( .1D0, EKINL  )), 37.D0 )
+      IELDPM(MEN,MEL) = IELDPM(MEN,MEL) + 1
+      IELDPA(MEN,MEL) = IELDPA(MEN,MEL) + 1
+      IF ( ELASTI .LT. 1.D0 ) THEN
+        ELMEAN(MEN) = ELMEAN(MEN) + ELASTI
+        ELMEAA(MEN) = ELMEAA(MEN) + ELASTI
+      ENDIF
+ 
+      IF ( FIRSTI ) THEN
+        ELAST  = ELASTI
+        FIRSTI = .FALSE.
+      ENDIF
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'HDPM  : ELAST=',SNGL(ELASTI),
+     *                            SNGL(ETOT),SNGL(ELAB)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/heigh.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/heigh.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/heigh.f	(revision 286)
@@ -0,0 +1,113 @@
+C=======================================================================
+
+      DOUBLE PRECISION FUNCTION HEIGH( ARG )
+
+C-----------------------------------------------------------------------
+C  HEIGH(T AS FUNCTION OF THICKNESS)
+C
+C  CALCULATES HEIGHT DEPENDING ON THICKNESS OF ATMOSPHERE
+C  (US STANDARD ATMOSPHERE)
+C  THIS FUNCTION IS CALLED FROM MAIN, BOX2, BOX3, ININKG, INPRM,
+C  MUTRAC, AND UPDATE
+C  ARGUMENT:
+C   ARG    = MASS OVERLAY IN G/CM**2
+C-----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+*KEEP,ATMOS.
+      COMMON /ATMOS/   AATM,BATM,CATM,DATM
+      DOUBLE PRECISION AATM(5),BATM(5),CATM(5),DATM(5)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c Try
+c------------------------------------------------------------
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+*KEND.
+C*******************************************************************
+C     Modificado por Aitor (5-febrero-98)
+      
+      common /aitor/   aitoth
+      double precision aitoth
+C*******************************************************************
+
+
+      DOUBLE PRECISION ARG,H,R,RT
+      PARAMETER (RT=6348.0D5)
+
+C-----------------------------------------------------------------------
+
+CC    IF ( DEBUG ) WRITE(MDEBUG,*) 'HEIGH : ARG=',SNGL(ARG)
+
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>> Modification (HZA trick) cancelled >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>> JCG Wed Sep 21 10:49:14 MET DST 1998 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      IF     ( ARG .GT. 631.1D0 ) THEN
+        HEIGH = CATM(1) * LOG ( BATM(1) / (ARG - AATM(1)) )
+      ELSEIF ( ARG .GT. 271.7D0 ) THEN
+        HEIGH = CATM(2) * LOG ( BATM(2) / (ARG - AATM(2)) )
+      ELSEIF ( ARG .GT. 3.0395D0 ) THEN
+        HEIGH = CATM(3) * LOG ( BATM(3) / (ARG - AATM(3)) )
+      ELSEIF ( ARG .GT. 0.00128292D0 ) THEN
+        HEIGH = CATM(4) * LOG ( BATM(4) / (ARG - AATM(4)) )
+      ELSE
+        HEIGH = (AATM(5) - ARG) * DATM(5)
+      ENDIF
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c      IF     ( ARG .GT. 631.1D0 ) THEN
+c        H = CATM(1) * LOG ( BATM(1) / (ARG - AATM(1)) )
+c      ELSEIF ( ARG .GT. 271.7D0 ) THEN
+c        H = CATM(2) * LOG ( BATM(2) / (ARG - AATM(2)) )
+c      ELSEIF ( ARG .GT. 3.0395D0 ) THEN
+c        H = CATM(3) * LOG ( BATM(3) / (ARG - AATM(3)) )
+c      ELSEIF ( ARG .GT. 0.00128292D0 ) THEN
+c        H = CATM(4) * LOG ( BATM(4) / (ARG - AATM(4)) )
+c      ELSE
+c        H = (AATM(5) - ARG) * DATM(5)
+c      ENDIF
+c
+cC************************************************************************
+cC     Modificacion hecha por Aitor (5-febrero-98)
+c
+c      HEIGH = (COS(aitoth))**2 * (-RT + SQRT(RT**2 + 
+c     * ((H**2 + (2.0D0*RT*H))/(COS(aitoth))**2)))
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+C************************************************************************
+
+C      R = SQRT(CURPAR(7)**2+CURPAR(8)**2)
+C      HEIGH = SQRT((RT+H)**2-R**2)-RT
+c      print *,'HEIGH>>',ARG,r,heigh,curpar(7),curpar(8)
+
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/hmeson.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/hmeson.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/hmeson.f	(revision 286)
@@ -0,0 +1,176 @@
+      SUBROUTINE HMESON( E,AMASS,ASMASS )
+ 
+C-----------------------------------------------------------------------
+C  H(EAVY) MESON
+C
+C  HANDLES PION INITIATED HEAVY MESON AND ITS DECAY IN UP TO 3 PIONS
+C  HEAVY MESON EMITTED FORWARD
+C  THIS SUBROUTINE IS CALLED FROM BOX67 AND BOX69
+C  ARGUMENTS:
+C   E      = AVAILABLE ENERGY IN CM
+C   AMASS  = MASS OF HEAVY MESON
+C   ASMASS = MASS TO BE LEFT OVER FOR OTHER PARTICLES
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,BAL.
+      COMMON /BAL/     EBAL
+      DOUBLE PRECISION EBAL(10)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,ELASTY.
+      COMMON /ELASTY/  ELAST,IELIS,IELHM,IELNU,IELPI
+      DOUBLE PRECISION ELAST
+      INTEGER          IELIS(20),IELHM(20),IELNU(20),IELPI(20)
+*KEEP,MULT.
+      COMMON /MULT/    EKINL,MSMM,MULTMA,MULTOT
+      DOUBLE PRECISION EKINL
+      INTEGER          MSMM,MULTMA(37,13),MULTOT(37,13)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,VKIN.
+      COMMON /VKIN/    BETACM
+      DOUBLE PRECISION BETACM
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'HMESON: E,AMASS,ASMASS=',
+     *         SNGL(E),SNGL(AMASS),SNGL(ASMASS)
+ 
+      IPI   = 0
+      EDHM  = 0.D0
+      PACC  = 0.D0
+      W     = 0.6D0
+ 
+C  GAMMA AND BETA OF HEAVY MESON IN CM AND LAB
+C  E > AMASS + ASMASS  TO KEEP GHMCM > 1.
+      GHMCM  = ( E**2+AMASS**2-ASMASS**2 ) / ( 2.D0*E*AMASS )
+      BHMCM  = SQRT(GHMCM**2 - 1.D0) / GHMCM
+      GHMLAB = GCM * GHMCM * (1.D0 + BETACM * BHMCM)
+      BHMLAB = SQRT(GHMLAB**2 - 1.D0) / GHMLAB
+ 
+C  DECAY OF HEAVY MESON
+    7 CONTINUE
+      IPI  = IPI + 1
+C  CHOSE TRANSVERSE MOMENTUM RANDOMLY
+      PTPI = PTRANS(DUMMY)
+C  CHOSE LONGITUDINAL MOMENTUM RANDOMLY
+      IF ( IPI .LT. 3 ) THEN
+        P  = PCL(C(40),W)
+      ELSE
+        P2 = RESTE**2 - PAMA(8)**2 - PTPI**2
+        P  = SQRT(MAX( P2, 0.D0 ))
+      ENDIF
+ 
+      PTPI  = PTRANS(DUMMY)
+      GPIHM = SQRT( P**2 / PAMA(8)**2 + 1.D0 )
+      BPIHM = SQRT( GPIHM**2-1.D0 ) / GPIHM
+      EDHM  = EDHM + SQRT( PAMA(8)**2 + P**2 + PTPI**2 )
+      RESTE = AMASS - EDHM
+ 
+C  FOR FIRST 2 PARTICLES CHOSE RANDOMLY WHETHER FORWARD OR BACKWARD
+C  FOR 3. PARTICLE DECIDE ACCORDING TO ACCULMULATED P
+      CALL RMMAR( RD,3,1 )
+      IF ( IPI .EQ. 3 ) THEN
+        IF ( PACC .LE. 0.D0 ) THEN
+          RD(1) = 0.
+        ELSE
+          RD(1) = 1.
+        ENDIF
+      ENDIF
+ 
+      IF ( RD(1) .GT. 0.5 ) THEN
+C  BACKWARD PION
+        GPILAB = GHMLAB*GPIHM*(1.D0-BHMLAB*BPIHM)
+        PACC   = PACC - P
+      ELSE
+C  FORWARD PION
+        GPILAB = GHMLAB*GPIHM*(1.D0+BHMLAB*BPIHM)
+        PACC   = PACC + P
+      ENDIF
+C  CORRECTIVE ACTION IF GPILAB LESS OR EQUAL TO 1.0
+      GPILAB   = MAX( GPILAB, 1.D0 )
+ 
+C  GET NEW DIRECTION
+      PLLAB2 = PAMA(8)**2 *(GPILAB**2 - 1.D0)
+      CTHETA = SQRT( PLLAB2 / (PTPI**2+PLLAB2) )
+      IF ( CTHETA .GE. C(27) ) THEN
+        CALL ADDANG( COSTHE,PHI, CTHETA,RD(2)*PI2, SECPAR(3),SECPAR(4) )
+        IF ( SECPAR(3) .GE. C(29) ) THEN
+          SECPAR(2) = GPILAB
+ 
+C  RANDOM CHARGE ASSIGNMENT FOR PIONS
+          IF     ( RD(3) .LE. OB3 ) THEN
+            SECPAR(1) = 7.D0
+          ELSEIF ( RD(3) .LE. TB3 ) THEN
+            SECPAR(1) = 8.D0
+          ELSE
+            SECPAR(1) = 9.D0
+          ENDIF
+ 
+          DO  4  J = 5,8
+            SECPAR(J) = CURPAR(J)
+    4     CONTINUE
+ 
+          CALL TSTACK
+        ENDIF
+      ENDIF
+      IF ( IPI .LT. 3  .AND.  RESTE .GT. PAMA(8) ) GOTO 7
+ 
+C  STATISTICS ON ENERGY BALANCE, MULTIPLICITY AND ELASTICITY
+      EBAL(4) = EBAL(4) + RESTE
+      MSMM    = MSMM + IPI
+ 
+C  INELASTICITY STATISTICS
+      IN = 1.D0 + SECPAR(2) / GAMMA * 20.D0
+      IN = MIN( IN, 20 )
+      IELHM(IN) = IELHM(IN) + 1
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/howfar.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/howfar.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/howfar.f	(revision 286)
@@ -0,0 +1,198 @@
+      SUBROUTINE HOWFAR
+C
+C*********************************************************************
+C  DESIGN  : D. HECK   IK3  FZK KARLSRUHE
+C  DATE    : SEP  05, 1988
+C*********************************************************************
+C  THE FOLLOWING IS A GENERAL SPECIFICATION OF HOWFAR:
+C  GIVEN A PARTICLE AT (X,Y,Z) IN REGION IR AND GOING IN DIRECTION
+C  (U,V,W), THIS ROUTINE ANSWERS THE QUESTION, CAN THE PARTICLE GO
+C  A DISTANCE USTEP WITHOUT CROSSING A BOUNDARY OR OBSERVATION LEVEL?
+C          IF YES, IT CALCULATES DNEAR AND RETURNS.
+C          IF NO, IT SETS USTEP=DISTANCE TO BOUNDARY OR DETECTOR IN
+C             IN THE CURRENT DIRECTION.
+C             IT SETS IRNEW TO THE REGION NUMBER ON THE FAR SIDE
+C             OF THE BOUNDARY (THIS CAN BE MESSY IN GENERAL!);
+C             IT SETS NEWOBS TO THE DETECTOR NUMBER NEXT AFTER THE
+C             DETECTOR JUST PASSING.
+C  THE USER CAN TERMINATE A HISTORY BY SETTING IDISC>0. THE USER
+C  CAN TRANSPORT THE LAST PARTICLE  BY SETTING IDISC<0. HERE WE
+C  TERMINATE ALL HISTORIES WHICH ENTER REGION 6 OR ARE GOING
+C  BACKWARDS IN REGION 1 OR HAVE PASSED THE LAST OBSERVATION LEVEL.
+C*********************************************************************
+C   ELECTRON OR PHOTON        POSITIVE Z-DIRECTION (W>0) IS DOWNWARDS
+C            |
+C            |                  REGION 1   (VACUUM)
+C            V
+C---------------------------    STARTING PLANE AT -BOUND(1) = -ZALTIT
+C
+C                               REGION 2   (AIR WITH EXPONENTIALLY
+C                                           INCREASING DENSITY)
+C
+C---------------------------    BOUNDARY AT -BOUND(2)
+C
+C                               REGION 3   (AIR WITH EXPONENTIALLY
+C                                           INCREASING DENSITY)
+C
+C---------------------------    BOUNDARY AT  -BOUND(3)
+C
+C                               REGION 4   (AIR WITH EXPONENTIALLY
+C                                           INCREASING DENSITY)
+C
+C---------------------------    BOUNDARY AT  -BOUND(4)
+C
+C                               REGION 5   (AIR WITH EXPONENTIALLY
+C                                           INCREASING DENSITY)
+C
+C-------------------------Z=0   BOUNDARY AT -BOUND(5)   (SEA LEVEL)
+C////////////|/////////
+C////////////|/////////         REGION 6   (VACUUM)
+C////////////V/////////                    (MAY CONTAIN DETECTOR)
+C   ELECTRON OR PHOTON
+C------------------------       BOUNDARY AT -BOUND(6)
+C
+C*********************************************************************
+*KEEP,EPCONT.
+      COMMON/EPCONT/   EDEP,RATIO,TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,IDISC,
+     *                 IROLD,IRNEW,RHOFAC, EOLD,ENEW,EKE,ELKE,BETA2,GLE,
+     *                 TSCAT,IAUSFL
+      DOUBLE PRECISION EDEP,RATIO
+      REAL             TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,RHOFAC,EOLD,ENEW,
+     *                 EKE,ELKE,BETA2,GLE,TSCAT
+      INTEGER          IDISC,IROLD,IRNEW,IAUSFL(29)
+*KEND.
+      COMMON/GEOM/ZALTIT,BOUND(6),NEWOBS,OBSLVL(10)
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' HOWFAR:NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      IF (IR(NP).GT.1 .AND. IR(NP).LT.6) THEN
+C ***  WE ARE IN THE ATMOSPHERE - CHECK THE GEOMETRY
+       IRL=IR(NP)
+C ***  GOING FORWARD - CONSIDER FIRST SINCE MOST FREQUENT
+       NOBS=IOBS(NP)
+       IF (W(NP).GT.0.0) THEN
+C  ***  TVAL IS DISTANCE TO NEXT BOUNDARY OR
+C  ***  OBSERVATION LEVEL IN THIS DIRECTION
+        TVAL=(-Z(NP)-MAX(BOUND(IRL),OBSLVL(NOBS)))/W(NP)
+        IF (TVAL.GT.USTEP) THEN
+C   ***  CAN TAKE CURRENTLY REQUESTED STEP
+         DNEAR(NP)=TVAL*W(NP)
+        ELSE
+C   ***  GO TO DETECTOR OR BOUNDARY, WHICH IS CLOSER
+         USTEP=MAX(TVAL,0.0001)
+         IF (BOUND(IRL).GE.OBSLVL(NOBS)) THEN
+C    ***  PARTICLE CROSSES BOUNDARY
+          IRNEW=IRL+1
+C    ***  PARTICLE LEAVES AIR
+          IF((IRNEW.GE.6))IDISC=-1
+         END IF
+         IF (BOUND(IRL).LE.OBSLVL(NOBS)) THEN
+C    ***  PARTICLE CROSSES DETECTOR
+          NEWOBS=NOBS+1
+C    ***  MAKE A VERY SMALL STEP TO AVOID HANGUP OF PROGRAM
+          IF((USTEP.LE.0.0))USTEP = 0.0001
+C    ***  TRANSPORT PARTICLE  TO FINAL DETECTOR LEVEL AND DISCARD IT
+          IF((NEWOBS.GT.NOBSLV))IDISC=-1
+         END IF
+        END IF
+C  ***  END OF W(NP)>0 CASE
+C  ***  GOING UPWARD IN ATMOSPHERE
+       ELSE IF(W(NP).LT.0.0) THEN
+C  ***  NO DETECTOR ABOVE PARTICLE
+        IF (NOBS.LE.1) THEN
+C   ***  DISTANCE TO BOUNDARY ABOVE
+         TVAL=(-Z(NP)-BOUND(IRL-1))/W(NP)
+         IF (TVAL.GT.USTEP) THEN
+C    ***  CAN TAKE CURRENTLY REQUESTED STEP
+          DNEAR(NP)=MIN(Z(NP)+BOUND(IRL-1),-(Z(NP)+BOUND(IRL)))
+         ELSE
+C    ***  CROSS BOUNDARY ABOVE
+          USTEP=MAX(TVAL,0.0001)
+          IRNEW=IRL-1
+         END IF
+        ELSE
+C   ***  BOUNDARY AND DETECTOR ABOVE PARTICLE
+         TVAL=(-Z(NP)-MIN(BOUND(IRL-1),OBSLVL(NOBS-1)))/W(NP)
+         IF (TVAL.GT.USTEP) THEN
+C    ***  CAN TAKE CURRENTLY REQUESTED STEP
+C    ***  DNEAR IS CLOSEST DISTANCE TO DETECTOR OR
+C    ***  BOUNDARY ABOVE OR BELOW PARTICLE
+          DNEAR(NP)=MIN(Z(NP)+MIN(BOUND(IRL-1),OBSLVL(NOBS-1)), -Z(NP) +
+     *     MAX(BOUND(IRL),OBSLVL(NOBS)))
+         ELSE
+C    ***  TAKE ONLY STEP UP TO BOUNDARY OR DETECTOR
+          USTEP=MAX(TVAL,0.0001)
+          IF (BOUND(IRL-1).LE.OBSLVL(NOBS-1)) THEN
+C     ***  PARTICLE CROSSES  BOUNDARY ABOVE
+           IRNEW=IRL-1
+C     ***  PARTICLE LEAVES ATMOSPHERE
+           IF((IRNEW.LE.1))IDISC=1
+          END IF
+          IF ((BOUND(IRL-1).GE.OBSLVL(NOBS-1))) THEN
+C     ***  PARTICLE CROSSES DETECTOR ABOVE; IT IS NOT
+C     ***  PRINTED, BECAUSE IT MUST HIT DETECTOR DOWNWARDS
+           NEWOBS=NOBS-1
+           IOBS(NP)=NEWOBS
+          END IF
+         END IF
+        END IF
+C  ***  END W(NP)<0 CASE
+C  ***  PARTICLE IS MOVING HORIZONTALLY, CANNOT HIT BOUNDARY
+       ELSE IF(W(NP).EQ.0.0) THEN
+        RETURN
+       END IF
+C ***  END OF ATMOSPHERE REGION CASE
+      ELSE IF(IR(NP).EQ.6) THEN
+C ***  TERMINATE THIS HISTORY, IT IS PAST THE ATMOSPHERE
+       IDISC=1
+C ***  WE ARE IN THE REGION WITH SOURCE ABOVE AIR
+      ELSE IF(IR(NP).EQ.1) THEN
+       IF (W(NP).GT.0.0) THEN
+C  ***  IT MUST BE A SOURCE PARTICLE ON BOUNDARY 1
+        USTEP=0.0001
+        IRNEW=2
+       ELSE
+C  ***  IT IS A REFLECTED PARTICLE, DISCARD IT
+        IDISC=1
+       END IF
+C ***  END REGION 1 CASE
+      END IF
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ininkg.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ininkg.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ininkg.f	(revision 286)
@@ -0,0 +1,148 @@
+      SUBROUTINE ININKG
+ 
+C-----------------------------------------------------------------------
+C  INI(TIALIZE) NKG
+C
+C  INITIALIZES ARRAYS FOR NKG CALCULATING VARIABLES
+C  THIS SUBROUTINE IS CALLED FROM MAIN
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,NKGI.
+      COMMON /NKGI/    SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
+     *                 DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
+     *                 OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
+      DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
+     *                 ZSL(10),DIST(10),
+     *                 DISX(-10:10),DISY(-10:10),
+     *                 DISXY(-10:10,2),DISYX(-10:10,2),
+     *                 DLAX (-10:10,2),DLAY (-10:10,2),
+     *                 DLAXY(-10:10,2),DLAYX(-10:10,2),
+     *                 OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
+      INTEGER          IALT(2)
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION DEPTH,HEIGH,RHOF,RMGCM,THICK
+      INTEGER          I,IL,K,KL
+      EXTERNAL         HEIGH,RHOF,THICK
+      DATA             RMGCM / 9.6D0 /
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'ININKG:'
+ 
+C  SET LATERAL DISTRIBUTION DISTANCES
+      IF ( RADNKG .LE. 100.D0 ) THEN
+        WRITE(MONIOU,*) 'ININKG: RADNKG=',RADNKG,' CM  TOO SMALL '
+        RADNKG = 200.D2
+        WRITE(MONIOU,*) '        RADNKG CORRECTED TO  ',RADNKG,' CM'
+      ENDIF
+      EVTH(148) = RADNKG
+      DO I=1,10
+        DIST(I)  = 100.D0 * 10.D0**(LOG10(RADNKG/100.D0)*0.1D0*I)
+        DISX(I)  =  DIST(I)
+        DISX(-I) = -DIST(I)
+      ENDDO
+      DISX(0) = 0.D0
+ 
+C  MOLIERE RADIUS FOR COULOMB SCATTERING ; EQUIVALENT TO 9.6 G/CM**2
+C  OBSERVATION LEVELS AND CORRESPONDING MOLIERE RADII (IN CM) FOR NKG
+      OBSATI(1) = OBSLEV(NOBSLV)
+      RMOL  (1) = RMGCM / RHOF(OBSATI(1))
+      IF ( NOBSLV .GT. 1 ) THEN
+        OBSATI(2) = OBSLEV(NOBSLV-1)
+        RMOL  (2) = RMGCM / RHOF(OBSATI(2))
+      ELSE
+        OBSATI(2) = -1.D0
+        RMOL  (2) =  0.D0
+        IALT  (2) =  0
+      ENDIF
+ 
+C  CALCULATE COORDINATES OF POINTS ON THE X AND Y AXIS AND THE TWO
+C  DIAGONAL LINES  Y IS X AND Y IS -X
+      DO 3333  KL = -10,10
+        DISY (KL)   =  DISX (KL)
+        DISXY(KL,1) =  DISX (KL) / SQRT(2.D0)
+        DISXY(KL,2) =  DISXY(KL,1)
+        DISYX(KL,1) =  DISXY(KL,1)
+        DISYX(KL,2) = -DISXY(KL,2)
+ 3333 CONTINUE
+C  CLEAR ARRAY FOR LATERAL ELECTRON DISTR. (AVERAGE OVER ALL SHOWERS)
+      DO 45  K = 1,2
+      DO 45  I = -10,10
+        DLAX (I,K) = 0.D0
+        DLAY (I,K) = 0.D0
+        DLAXY(I,K) = 0.D0
+        DLAYX(I,K) = 0.D0
+  45  CONTINUE
+C  CLEAR ARRAY FOR AGE PARAMETER CALCULATION (AVERAGE OVER ALL SHOWERS)
+      DO 17  I = 1,10
+        SEL(I)   = 0.D0
+        SELLG(I) = 0.D0
+        STH(I)   = 0.D0
+        ZELLG(I) = 0.D0
+        ZEL(I)   = 0.D0
+        ZSL(I)   = 0.D0
+  17  CONTINUE
+ 
+C  LAST OBSERVATION LEVEL DEPTH IS GIVEN IN G/CM**2
+      DEPTH   = THICK(OBSATI(1))
+      IALT(1) = MIN( 10, INT(DEPTH/102.D0)+1 )
+C  CALCULATE 10 LEVELS AT EACH 100 G/CM**2
+      DO 111  IL = 1,IALT(1)-1
+        TLEV  (IL) = 100.D0 * IL
+        TLEVCM(IL) = HEIGH(TLEV(IL))
+ 111  CONTINUE
+C  FOR LAST LEVEL NOT IL*100 BUT OBSERVATION LEVEL
+      TLEV  (IALT(1)) = DEPTH
+      TLEVCM(IALT(1)) = OBSATI(1)
+C  SECOND OBSERVATION LEVEL ?
+      IF ( OBSATI(2) .GE. 0.D0 ) THEN
+        DEPTH           = THICK(OBSATI(2))
+        IALT(2)         = INT(DEPTH/102.D0) + 1
+        IF ( IALT(2) .GE. IALT(1) ) IALT(2) = IALT(1) - 1
+        TLEV  (IALT(2)) = DEPTH
+        TLEVCM(IALT(2)) = OBSATI(2)
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/inprm.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/inprm.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/inprm.f	(revision 286)
@@ -0,0 +1,812 @@
+C=======================================================================
+
+      SUBROUTINE INPRM
+ 
+C-----------------------------------------------------------------------
+C  IN(PUT) PR(I)M(ARY)
+C
+C  TAKES INPUT PRIMARY ENERGY FROM SPECIFIED SPECTRUM
+C  CHECKS INPUT VARIABLES FOR CONSISTENCY AND LIMITATIONS
+C  WRITES DATA BASE FILE
+C  THIS SUBROUTINE IS CALLED FROM MAIN
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,ATMOS.
+      COMMON /ATMOS/   AATM,BATM,CATM,DATM
+      DOUBLE PRECISION AATM(5),BATM(5),CATM(5),DATM(5)
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,DPMFLG.
+      COMMON /DPMFLG/  NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+      INTEGER          NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEEP,ETHMAP.
+      COMMON /ETHMAP/  ECTMAP,ELEFT
+      DOUBLE PRECISION ECTMAP,ELEFT
+*KEEP,LONGI.
+      COMMON /LONGI/   APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
+     *                 NSTEP,LLONGI,FLGFIT
+      DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
+     *                 SPLONG(0:1040,9),THSTEP,THSTPI
+      INTEGER          NSTEP
+      LOGICAL          LLONGI,FLGFIT
+*KEEP,MAGANG.
+      COMMON /MAGANG/  ARRANG,ARRANR,COSANG,SINANG
+      DOUBLE PRECISION ARRANG,ARRANR,COSANG,SINANG
+*KEEP,MAGNET.
+      COMMON /MAGNET/  BX,BZ,BVAL,BNORMC,BNORM,COSB,SINB,BLIMIT
+      DOUBLE PRECISION BX,BZ,BVAL,BNORMC
+      REAL             BNORM,COSB,SINB,BLIMIT
+*KEEP,NKGI.
+      COMMON /NKGI/    SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
+     *                 DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
+     *                 OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
+      DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
+     *                 ZSL(10),DIST(10),
+     *                 DISX(-10:10),DISY(-10:10),
+     *                 DISXY(-10:10,2),DISYX(-10:10,2),
+     *                 DLAX (-10:10,2),DLAY (-10:10,2),
+     *                 DLAXY(-10:10,2),DLAYX(-10:10,2),
+     *                 OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
+      INTEGER          IALT(2)
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,PRIMSP.
+      COMMON /PRIMSP/  PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX,ISPEC
+      DOUBLE PRECISION PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX
+      INTEGER          ISPEC
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,REJECT.
+      COMMON /REJECT/  AVNREJ,
+     *                 ALTMIN,ANEXP,THICKA,THICKD,CUTLN,EONCUT,
+     *                 FNPRIM
+      DOUBLE PRECISION AVNREJ(10)
+      REAL             ALTMIN(10),ANEXP(10),THICKA(10),THICKD(10),
+     *                 CUTLN,EONCUT
+      LOGICAL          FNPRIM
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKF.
+      COMMON /STACKF/  STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+      INTEGER          MAXSTK
+      PARAMETER        (MAXSTK = 12*340*2)
+      DOUBLE PRECISION STACK(MAXSTK)
+      INTEGER          STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+*KEEP,VERS.
+      COMMON /VERS/    VERNUM,MVDATE,VERDAT
+      DOUBLE PRECISION VERNUM
+      INTEGER          MVDATE
+      CHARACTER*18     VERDAT
+*KEEP,VENUS.
+      COMMON /VENUS/   ISH0,IVERVN,MTAR99,FVENUS,FVENSG
+      INTEGER          ISH0,IVERVN,MTAR99
+      LOGICAL          FVENUS,FVENSG
+*KEEP,CEREN1.
+      COMMON /CEREN1/  CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD,
+     *                 CERSIZ,LCERFI
+      DOUBLE PRECISION CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD
+      REAL             CERSIZ
+      LOGICAL          LCERFI
+*KEEP,CEREN2.
+      COMMON /CEREN2/  PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS,CERYOS,
+     *                 NCERX,NCERY,ICERML
+      REAL             PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS(20),CERYOS(20)
+      INTEGER          NCERX,NCERY,ICERML
+*KEND.
+ 
+      DOUBLE PRECISION EFRAC,HEIGH,H0,OOO,THICK
+      REAL             VERVEN
+      INTEGER          I,IBL,IDPM,ILONG,ISO,J,L
+      LOGICAL          LTHIN
+      EXTERNAL         HEIGH,THICK
+      CHARACTER*1      MARK
+      CHARACTER*9      LSTDSN
+C-----------------------------------------------------------------------
+ 
+      WRITE(MONIOU,504)
+  504 FORMAT(//' ',10('='),' SHOWER PARAMETERS ', 50('=') )
+ 
+C  WRITE ENERGY SPECTRUM TO HEADER
+      RUNH(16) = PSLOPE
+      RUNH(17) = LLIMIT
+      RUNH(18) = ULIMIT
+ 
+      EVTH(58) = PSLOPE
+      EVTH(59) = LLIMIT
+      EVTH(60) = ULIMIT
+ 
+      IF ( PRMPAR(1) .GE. 6000.D0  .OR.  PRMPAR(1) .LE. 0.D0 ) THEN
+        WRITE(MONIOU,*)'INCORRECT SELECTION OF PRIMARY PARTICLE TYPE = '
+     *                  ,INT(PRMPAR(1))
+        WRITE(MONIOU,*)'PLEASE READ THE MANUALS'
+        STOP
+      ENDIF
+C  CHECK WETHER NUCLEUS IS A SINGLE NUCLEON
+      IF (PRMPAR(1) .EQ. 100.D0 ) PRMPAR(1) = 13.D0
+      IF (PRMPAR(1) .EQ. 101.D0 ) PRMPAR(1) = 14.D0
+      WRITE(MONIOU,*)'PRIMARY PARTICLE IDENTIFICATION IS ',
+     *                NINT(PRMPAR(1))
+C  CHECK RECOMMENDED ENERGY RANGE
+      IF ( FVENUS  .AND.
+     *     ULIMIT.GT.2.D7  .AND.  PRMPAR(1).GE.8.D0 ) THEN
+        WRITE(MONIOU,502) ULIMIT
+  502   FORMAT(' INTERACTION MODEL DOUBTFUL FOR THE SELECTED PRIMARY ',
+     *         'ENERGY OF ',E10.3,' GEV'/' PLEASE READ THE MANUALS')
+        STOP
+      ENDIF
+ 
+
+
+
+c> *** modified by fs (22/09/98) *******************************
+
+
+c      IF ( PRMPAR(1) .GT. 101.D0 ) THEN
+c        IF ( GHEISH ) THEN
+cC  GHEISHA CAN TREAT ONLY DEUTERONS, TRITONS, AND ALPHA PARTICLES
+c          IF ( PRMPAR(1) .NE. 201.D0  .AND.  PRMPAR(1) .NE. 301.D0
+c     *         .AND.  PRMPAR(1) .NE. 402.D0 ) THEN
+c            IF ( LLIMIT .LT. HILOELB * INT(PRMPAR(1)/100.D0) ) THEN
+c              WRITE(MONIOU,503) INT(PRMPAR(1)/100.D0),LLIMIT
+c              STOP
+c            ENDIF
+c          ENDIF
+c        ELSE
+c          IF ( LLIMIT .LT. HILOELB * INT(PRMPAR(1)/100.D0) ) THEN
+c            WRITE(MONIOU,503) INT(PRMPAR(1)/100.D0),LLIMIT
+c  503       FORMAT(' NUCLEUS WITH A =',I2,' AND PRIMARY ENERGY =',
+c     *        1PE10.3,' GEV TOO LOW FOR HIGH ENERGY INTERACTION MODEL'/
+c     *        ' AND CANNOT BE TREATED BY LOW ENERGY INTERACTION MODEL'/
+c     *        ' PLEASE READ THE MANUALS')
+c            STOP
+c          ENDIF
+c        ENDIF
+c      ENDIF
+
+
+c> *** end of modification ****************************************
+
+C  DEFINE ENERGY RANGE AND ENERGY SPECTRUM OF PRIMARY
+      IF ( LLIMIT .EQ. ULIMIT ) THEN
+        ISPEC = 0
+        WRITE(MONIOU,506) LLIMIT
+  506   FORMAT(' PRIMARY ENERGY IS FIXED AT           ',1PE10.3,
+     *         ' GEV' )
+      ELSE
+        ISPEC = 1
+        WRITE(MONIOU,505) PSLOPE,LLIMIT,ULIMIT
+  505   FORMAT(' PRIMARY ENERGY IS TAKEN FROM SPECTRUM VIA MONTE CARLO'/
+     *  5X,' SLOPE OF PRIMARY SPECTRUM                = ',1P,E10.3/
+     *  5X,' LOWER LIMIT CUT-OFF FOR PRIMARY SPECTRUM = ',E10.3,' GEV'/
+     *  5X,' UPPER LIMIT CUT-OFF FOR PRIMARY SPECTRUM = ',E10.3,' GEV'/)
+        IF ( PSLOPE .NE. -1.D0 ) THEN
+          LL   = LLIMIT ** (PSLOPE + 1.D0)
+          UL   = ULIMIT ** (PSLOPE + 1.D0)
+          SLEX = 1.D0 / (PSLOPE + 1.D0)
+        ELSE
+          LL   = ULIMIT / LLIMIT
+        ENDIF
+      ENDIF
+ 
+C  FIRST INTERACTION TARGET FIXED ?
+      IF     ( N1STTR .EQ. 1 ) THEN
+        WRITE(MONIOU,508) 'NITROGEN'
+ 508    FORMAT(' TARGET OF FIRST INTERACTION IS FIXED TO   ',A8)
+      ELSEIF ( N1STTR .EQ. 2 ) THEN
+        WRITE(MONIOU,508) 'OXYGEN  '
+      ELSEIF ( N1STTR .EQ. 3 ) THEN
+        WRITE(MONIOU,508) 'ARGON   '
+      ELSE
+        N1STTR = 0
+        WRITE(MONIOU,*)'TARGET OF FIRST INTERACTION IS CHOSEN RANDOMLY'
+      ENDIF
+ 
+C  CHECK ANGULAR SETTINGS
+      IF ( THETPR(1) .LT. 0.D0 ) THEN
+        WRITE(MONIOU,*)'UNALLOWED CHOICE OF THETPR = ',SNGL(THETPR(1)),
+     *                  ' DEGREES'
+        WRITE(MONIOU,*)'PLEASE READ THE MANUALS'
+        STOP
+      ENDIF
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>      IF     ( THETPR(2) .GT. 70.D0 ) THEN
+c>        WRITE(MONIOU,*)'UNALLOWED CHOICE OF THETPR = ',SNGL(THETPR(2)),
+c>     *                  ' DEGREES'
+c>        WRITE(MONIOU,*)'PLEASE READ THE MANUALS'
+c>        STOP
+c>      ELSEIF ( THETPR(2) .GT. 45.D0 ) THEN
+c>        WRITE(MONIOU,*)'UNALLOWED CHOICE OF THETPR = ',SNGL(THETPR(2)),
+c>     *                  ' DEGREES'
+c>        WRITE(MONIOU,*)'#########################################'
+c>        WRITE(MONIOU,*)'# IN DOUBTFUL CASES CONTACT THE AUTHORS #'
+c>        WRITE(MONIOU,*)'#########################################'
+c>        STOP
+c>      ENDIF
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C  INCIDENCE ANGLE FIXED ?
+      IF ( THETPR(1) .EQ. THETPR(2) .AND. PHIPR(1) .EQ. PHIPR(2) ) THEN
+        FIXINC = .TRUE.
+        WRITE(MONIOU,517) THETPR(1),PHIPR(1)
+  517   FORMAT(' THETA OF INCIDENCE IS FIXED TO ',F10.2,' DEGREES'/
+     *         ' PHI   OF INCIDENCE IS FIXED TO ',F10.2,' DEGREES')
+      ELSE
+        FIXINC = .FALSE.
+        WRITE(MONIOU,527) THETPR,PHIPR
+  527   FORMAT(' THETA OF INCIDENCE CHOSEN FROM ',F10.2,'...',F10.2,
+     *         ' DEGREES'/
+     *         ' PHI   OF INCIDENCE CHOSEN FROM ',F10.2,'...',F10.2,
+     *         ' DEGREES')
+      ENDIF
+      EVTH(81) = THETPR(1)
+      EVTH(82) = THETPR(2)
+      EVTH(83) = PHIPR(1)
+      EVTH(84) = PHIPR(2) 
+      THETPR(1) = THETPR(1)*PI/180.D0
+      THETPR(2) = THETPR(2)*PI/180.D0
+      PHIPR(1)  = PHIPR(1) *PI/180.D0
+      PHIPR(2)  = PHIPR(2) *PI/180.D0
+ 
+C-----------------------------------------------------------------------
+C  PRMPAR, OBSLEV, NOBSLV
+      PRMPAR(2) = 0.D0
+      PRMPAR(6) = 0.D0
+      PRMPAR(7) = 0.D0
+      PRMPAR(8) = 0.D0
+ 
+C  ORDERING OF OBSERVATION LEVELS FROM TOP TO BOTTOM
+      IF ( NOBSLV .GT. 1 ) THEN
+  215 CONTINUE
+        DO 11  I = 2,NOBSLV
+          IF ( OBSLEV(I) .GT. OBSLEV(I-1) ) THEN
+            OOO         = OBSLEV(I)
+            OBSLEV(I)   = OBSLEV(I-1)
+            OBSLEV(I-1) = OOO
+            GOTO 215
+          ENDIF
+   11   CONTINUE
+      ENDIF
+C  CHECK WETHER OBSERVATION LEVELS ARE IN ALLOWED RANGE
+      DO 12  I = 1,NOBSLV
+        IF ( OBSLEV(I) .GE. HEIGH(0.D0) ) THEN
+          WRITE(MONIOU,120)I,OBSLEV(I),HEIGH(0.D0)
+ 120      FORMAT(' UNALLOWED CHOICE OF OBSLEV '/' OBSERVATION LEVEL ',
+     *           I2,' IS AT ',F12.3,' CM, WHICH IS ABOVE ',
+     *           F12.3,' CM'/' PLEASE READ THE MANUALS')
+          STOP
+        ENDIF
+        IF ( OBSLEV(I) .LE. -1.D5 ) THEN
+          WRITE(MONIOU,121)I,OBSLEV(I)
+ 121      FORMAT(' UNALLOWED CHOICE OF OBSLEV '/' OBSERVATION LEVEL ',
+     *          I2,' IS AT ',F12.3,' CM, WHICH IS BELOW ',
+     *          '-1.D5 CM'/' PLEASE READ THE MANUALS')
+          STOP
+        ENDIF
+        THCKOB(I) = THICK(OBSLEV(I))
+   12 CONTINUE
+ 
+C  WRITE OBSERVATION LEVELS TO HEADER (IN CM)
+      RUNH(5) = REAL(NOBSLV)
+      EVTH(47) = REAL(NOBSLV)
+      DO 114  I = 1,NOBSLV
+        RUNH(5+I)  = OBSLEV(I)
+        EVTH(47+I) = OBSLEV(I)
+  114 CONTINUE
+ 
+C  FIRST INTERACTION HEIGHT FIXED ?
+      IF ( FIX1I ) THEN
+        IF ( FIXHEI .GE. HEIGH(0.D0) ) THEN
+          WRITE(MONIOU,122)FIXHEI,HEIGH(0.D0)
+ 122      FORMAT(' UNALLOWED CHOICE OF FIXHEI '/' FIRST INTERACTION ',
+     *           'IS FIXED AT ',F12.3,' CM, WHICH IS ABOVE ',
+     *           F12.3,' CM'/' PLEASE READ THE MANUALS')
+          STOP
+        ENDIF
+        IF ( FIXHEI .LE. OBSLEV(NOBSLV) ) THEN
+          WRITE(MONIOU,123)FIXHEI,OBSLEV(NOBSLV)
+ 123      FORMAT(' UNALLOWED CHOICE OF FIXHEI '/' FIRST INTERACTION ',
+     *           'IS FIXED AT ',F12.3,' CM, '/' WHICH IS BELOW ',
+     *           'LOWEST OBSERVATION LEVEL AT ',F12.3,' CM'
+     *           /' PLEASE READ THE MANUALS')
+          STOP
+        ENDIF
+          WRITE(MONIOU,507) FIXHEI
+ 507      FORMAT(' HEIGHT OF FIRST INTERACTION IS FIXED TO ',1P,E10.2,
+     *         ' CM')
+        IF ( N1STTR .GE. 1  .AND.  N1STTR .LE. 3 ) THEN
+          IF ( PRMPAR(1) .LE. 3.D0 ) THEN
+            WRITE(MONIOU,516) INT(PRMPAR(1))
+ 516        FORMAT(' TARGET OF FIRST INTERACTION CANNOT BE FIXED FOR ',
+     *           'PRIMARY TYPE ',I5/' PLEASE READ THE MANUALS')
+            STOP
+          ELSEIF ( N1STTR .EQ. 1 ) THEN
+            WRITE(MONIOU,*)'TARGET OF FIRST INTERACTION IS NITROGEN'
+          ELSEIF ( N1STTR .EQ. 2 ) THEN
+            WRITE(MONIOU,*)'TARGET OF FIRST INTERACTION IS OXYGEN'
+          ELSEIF ( N1STTR .EQ. 3 ) THEN
+            WRITE(MONIOU,*)'TARGET OF FIRST INTERACTION IS ARGON'
+          ENDIF
+        ELSE
+          WRITE(MONIOU,*)
+     *       'TARGET OF FIRST INTERACTION IS CHOSEN AT RANDOM'
+        ENDIF
+      ELSE
+        FIXHEI = 0.D0
+        WRITE(MONIOU,*) 'HEIGHT OF FIRST INTERACTION IS CHOSEN RANDOMLY'
+      ENDIF
+ 
+C  STARTING ALTITUDE WITHIN ATMOSPHERE?
+      IF ( THICK0 .LT. 0.D0 ) THEN
+        WRITE(MONIOU,130)THICK0
+ 130    FORMAT(' UNALLOWED STARTING ALTITUDE WITH NEGATIVE MASS OVERLAY'
+     *          ,E12.3/' PLEASE READ THE MANUALS')
+        STOP
+      ENDIF
+      IF ( THICK0 .GE. THCKOB(NOBSLV) ) THEN
+        WRITE(MONIOU,131) THICK0
+ 131    FORMAT(' UNALLOWED STARTING ALTITUDE AT ',F12.3,' G/CM**2',
+     *         '  WHICH IS BELOW LOWEST OBSERVATION LEVEL'/
+     *        ' PLEASE READ THE MANUALS')
+        STOP
+      ENDIF
+      H0 = HEIGH(THICK0)
+      IF ( THICK0 .EQ. 0.D0 ) THEN
+        WRITE(MONIOU,518) H0, THICK0
+        WRITE(MONIOU,*)'                 WHICH IS AT TOP OF ATMOSPHERE'
+      ELSE
+        WRITE(MONIOU,518) H0, THICK0
+      ENDIF
+ 518  FORMAT(' STARTING ALTITUDE AT ',1P,F13.2,' CM (=',
+     *                                             E7.1,' G/CM**2)')
+      WRITE(MONIOU,203) (OBSLEV(I),THCKOB(I),I=1,NOBSLV)
+  203 FORMAT(/' OBSERVATION LEVELS IN  CM    AND IN    G/CM**2 ',
+     *  1P /(5X, 2E20.8 /))
+ 
+C  LONGITUDINAL SHOWER DEVELOPMENT
+      IF ( LLONGI ) THEN
+        THSTEP = NINT(THSTEP)
+        THSTEP = MAX(THSTEP,1.D0)
+        THSTEP = MIN(THSTEP,1040.D0)
+        THSTPI = 1.D0/THSTEP
+        NSTEP  = INT(THCKOB(NOBSLV)*THSTPI)
+        IF ( NSTEP .GE. 1040 ) THEN
+          NSTEP  = 1040
+          THSTEP = THCKOB(NOBSLV)/NSTEP
+          WRITE(MONIOU,*)'LONGITUDINAL SHOWER SAMPLING MODIFIED'
+        ENDIF
+        WRITE(MONIOU,925) NSTEP+1,THSTEP
+ 925    FORMAT(/' LONGITUDINAL SHOWER DEVELOPMENT:'/
+     *          '      SHOWER IS SAMPLED IN ',I4,
+     *          ' STEPS OF ',F6.1,' G/CM**2')
+C  GET HEIGHT VALUES IN CM FOR USE IN EGS
+        DO 478  J = 0,NSTEP
+          HLONG(J) = HEIGH(J*THSTEP)
+ 478    CONTINUE
+        IF ( FLGFIT ) THEN
+          WRITE(MONIOU,*)
+     *      '     FIT TO CHARGED PARTICLE LONG. DISTRIBUTION   ENABLED'
+        ELSE
+          WRITE(MONIOU,*)
+     *      '     FIT TO CHARGED PARTICLE LONG. DISTRIBUTION   DISABLED'
+        ENDIF
+        WRITE(MONIOU,*)
+      ENDIF
+ 
+C-----------------------------------------------------------------------
+C  CHECK INPUT OF ENERGY CUTS
+      IF     ( GHEISH  .AND.  ELCUT(1) .LT. 0.05D0 ) THEN
+        WRITE(MONIOU,*)'ELCUT(1) SELECTED INCORRECT TO ',ELCUT(1),' GEV'
+        WRITE(MONIOU,*)'PLEASE READ THE MANUALS '
+        STOP
+      ELSEIF ( .NOT.GHEISH  .AND.  ELCUT(1) .LT. 0.3D0 ) THEN
+        WRITE(MONIOU,*)'ELCUT(1) SELECTED INCORRECT TO ',ELCUT(1),' GEV'
+        WRITE(MONIOU,*)'PLEASE READ THE MANUALS '
+        STOP
+      ENDIF
+      IF ( ELCUT(2) .LT. 0.05D0 ) THEN
+        WRITE(MONIOU,*)'ELCUT(2) SELECTED INCORRECT TO ',ELCUT(2),' GEV'
+        WRITE(MONIOU,*)'PLEASE READ THE MANUALS '
+        STOP
+      ENDIF
+      IF ( ELCUT(3) .LT. 0.003D0 ) THEN
+        WRITE(MONIOU,*)'ELCUT(3) SELECTED INCORRECT TO ',ELCUT(3),' GEV'
+        WRITE(MONIOU,*)'PLEASE READ THE MANUALS '
+        STOP
+      ENDIF
+      IF ( ELCUT(4) .LT. 0.003D0 ) THEN
+        WRITE(MONIOU,*)'ELCUT(4) SELECTED INCORRECT TO ',ELCUT(4),' GEV'
+        WRITE(MONIOU,*)'PLEASE READ THE MANUALS '
+        STOP
+      ENDIF
+      WRITE(MONIOU,703) ECTMAP,ELCUT
+  703 FORMAT (' PARTICLES WITH LORENTZ FACTOR LARGER THAN',1P,E15.4,
+     *        ' ARE PRINTED OUT'/' SHOWER PARTICLES ENERGY CUT :'/
+     *        '      FOR HADRONS   : ',E15.4,' GEV'/
+     *        '      FOR MUONS     : ',E15.4,' GEV'/
+     *        '      FOR ELECTRONS : ',E15.4,' GEV'/
+     *        '      FOR PHOTONS   : ',E15.4,' GEV'//)
+ 
+      DO 774  I = 1,4
+        RUNH(20+I) = ELCUT(I)
+        EVTH(60+I) = ELCUT(I)
+  774 CONTINUE
+ 
+C-----------------------------------------------------------------------
+C  PARAMETERS OF EARTH MAGNETIC FIELD OF MIDDLE EUROPE
+C  +X DIRECTION IS NORTH, +Y DIRECTION IS EAST, +Z DIRECTION IS DOWN
+      BVAL   = SQRT( BX**2 + BZ**2 )
+C  BNORM HAS DIMENSIONS OF MEV/CM
+      BNORM  = BVAL * C(25) * 1.D-16
+C  BNORMC HAS DIMENSIONS OF GEV/CM
+      BNORMC = BNORM * 1.D-3
+      SINB   = BZ / BVAL
+      COSB   = BX / BVAL
+      WRITE(MONIOU,*)'EARTH MAGNETIC FIELD STRENGTH IS ',SNGL(BVAL),
+     *                ' MICROTESLA'
+      WRITE(MONIOU,*)'     WITH INCLINATION ANGLE      ',
+     *               SNGL(ASIN(SINB)*180./PI),' DEGREES'
+      IF ( BVAL .GE. 10000.D0 ) THEN
+        WRITE(MONIOU,*)'YOU WANT TO MAGNETIZE THE GALAXY ?'
+        WRITE(MONIOU,*)'PLEASE READ THE MANUALS !'
+        STOP
+      ENDIF
+C  LIMITING FACTOR FOR STEP SIZE OF ELECTRON IN MAGNETIC FIELD
+      BLIMIT = 0.2 / BNORM
+      EVTH(71) = BX
+      EVTH(72) = BZ
+C  ANGLE BETWEEN ARRAY X-DIRECTION AND MAGNETIC NORD
+C  POSITIV, IF X-DIRECTION OF ARRAY POINTS TO EASTERN DIRECTION
+      ARRANR = ARRANG * PI / 180.D0
+      COSANG = COS(ARRANR)
+      SINANG = SIN(ARRANR)
+      EVTH(93) = ARRANR
+      IF ( ARRANG .NE. 0.D0 ) THEN
+        WRITE(MONIOU,*)
+        WRITE(MONIOU,*)'DETECTOR COORDINATE SYSTEM IS ROTATED AWAY ',
+     *                 'FROM NORTH BY ',SNGL(ARRANG),' DEGREES'
+      ENDIF
+ 
+C-----------------------------------------------------------------------
+C  DEFINE CERENKOV ARRAY
+      NCERX = MAX( NCERX, 1 )
+      NCERY = MAX( NCERY, 1 )
+      ACERX = ABS(ACERX)
+      ACERY = ABS(ACERY)
+      DCERX = MAX( ABS(DCERX), 0.001 )
+      DCERY = MAX( ABS(DCERY), 0.001 )
+      XCMAX = (ACERX + (NCERX-1) * DCERX) * 0.5
+      YCMAX = (ACERY + (NCERY-1) * DCERY) * 0.5
+      DCERXI = 1./DCERX
+      EPSX = ACERX * 0.5 * DCERXI
+      DCERYI = 1./DCERY
+      EPSY = ACERY * 0.5 * DCERYI
+      IF ( MOD(NCERX,2) .EQ. 0 ) THEN
+        FCERX = -0.5
+      ELSE
+        FCERX = 0.0
+      ENDIF
+      IF ( MOD(NCERY,2) .EQ. 0 ) THEN
+        FCERY = -0.5
+      ELSE
+        FCERY = 0.0
+      ENDIF
+ 
+      WRITE(MONIOU,472)
+     *          ACERX*.01,ACERY*.01, DCERX*.01,DCERY*.01, NCERX,NCERY
+ 472  FORMAT(/' CERENKOV ARRAY:'/
+     *  5X,' CERENKOV STATIONS ARE ',F6.2,'  X  ',F6.2,' M**2 LARGE'/
+     *  5X,' THE GRID SPACING IS   ',F6.2,' AND ',F6.2,' M',/
+     *  5X,' THERE ARE ',I3,' X ',I3,' STATIONS IN X/Y DIRECTIONS'/
+     *  5X,' THE CERENKOV ARRAY IS CENTERED AROUND (0., 0.)'/)
+C  CALCULATE CERENKOV YIELD FACTOR FROM WAVELENGTH BAND
+      IF ( WAVLGL .LT. 100.D0  .OR.  WAVLGU .GT. 700.D0
+     *                         .OR.  WAVLGL .GE. WAVLGU ) THEN
+        WRITE(MONIOU,*)'CERENKOV WAVELENGTH BAND FROM ',SNGL(WAVLGL),
+     *              ' TO ',SNGL(WAVLGU),' NANOMETER'
+        WRITE(MONIOU,*)' IS OUT OF VALIDITY RANGE'
+        WRITE(MONIOU,*)'PLEASE READ THE MANUALS'
+        STOP
+      ENDIF
+      WRITE(MONIOU,*)'CERENKOV WAVELENGTH BAND FROM ',SNGL(WAVLGL),
+     *              ' TO ',SNGL(WAVLGU),' NANOMETER'
+C  WAVELENGTH IS CONVERTED FROM NM TO CM
+      CYIELD = (1.D0/WAVLGL - 1.D0/WAVLGU) * 2.D7 * PI / C(50)
+C  CALCULATE FACTOR FOR ETA DENSITY NORML.(ETA AT SEA LEVEL = 0.283D-3)
+      ETADSN = 0.283D-3 * CATM(1) / BATM(1)
+ 
+      IF ( CERSIZ .GT. 0. ) THEN
+        WRITE(MONIOU,*)'CERENKOV BUNCH SIZE IS SET TO=',CERSIZ
+      ELSE
+        WRITE(MONIOU,*)'CERENKOV BUNCH SIZE IS CALCULATED FOR EACH ',
+     *                 'SHOWER'
+      ENDIF
+ 
+      IF ( LCERFI ) THEN
+        WRITE(MONIOU,*)'CERENKOV PHOTONS ARE WRITTEN TO SEPARATE FILE'
+      ELSE
+        WRITE(MONIOU,*)'CERENKOV PHOTONS ARE WRITTEN TO PARTICLE ',
+     *                 'OUTPUT FILE'
+      ENDIF
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c   Next block of code has been modified, and is passed to MAIN
+c----------------------------------------------------------------------
+cC  SCATTERING OF CENTER OF CHERENKOV ARRAY RELATIVE TO SHOWER AXIS
+c      ICERML = MIN(MAX(ICERML,1),20)
+c      XSCATT = ABS(XSCATT)
+c      YSCATT = ABS(YSCATT)
+c      IF ( ICERML .GE. 1 ) THEN
+c        WRITE(MONIOU,5225)ICERML,XSCATT,YSCATT
+c 5225   FORMAT(' DEFINE MULTIPLE CERENKOV ARRAYS TO USE EACH',
+c     *   ' SHOWER SEVERAL TIMES'/ ' USE EACH EVENT ',I2,' TIMES'/
+c     *   ' THE EVENTS ARE SCATTERED QUASI RANDOMLY IN THE RANGE '/
+c     *   '   X =  +- ',F10.0,'    Y = +- ',F10.0)
+c        DO 4438 I=1,ICERML
+c          CALL SELCOR(CERXOS(I),CERYOS(I))
+c          WRITE(MONIOU,4437) I,CERXOS(I),CERYOS(I)
+c 4437     FORMAT('    CORE OF EVENT ',I2,'  AT  ',2F12.2)
+c 4438   CONTINUE
+c        XCMAX = XCMAX + XSCATT
+c        YCMAX = YCMAX + YSCATT
+c      ENDIF
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+C  STORE CERENKOV PARAMETERS IN EVENTHEADER
+      EVTH(86) = NCERX
+      EVTH(87) = NCERY
+      EVTH(88) = DCERX
+      EVTH(89) = DCERY
+      EVTH(90) = ACERX
+      EVTH(91) = ACERY
+      IF ( LCERFI ) THEN
+        EVTH(92) = 1.
+      ELSE
+        EVTH(92) = 0.
+      ENDIF
+      EVTH(96) = WAVLGL
+      EVTH(97) = WAVLGU
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c   Next block of code has been passed to MAIN
+c----------------------------------------------------------------------
+c      EVTH(98) = FLOAT(ICERML)
+c      DO  480 I=1,20
+c        EVTH( 98+I) = CERXOS(I)
+c        EVTH(118+I) = CERYOS(I)
+c 480  CONTINUE
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+C-----------------------------------------------------------------------
+C  FLAG FOR ADDITIONAL MUON INFORMATION
+      IF ( FMUADD ) THEN
+        WRITE(MONIOU,*)
+        WRITE(MONIOU,*)'ADDITIONAL INFORMATION ON MUON ORIGIN IS',
+     *                 ' WRITTEN TO PARTICLE TAPE'
+        EVTH(94) = 1.
+      ELSE
+        EVTH(94) = 0.
+      ENDIF
+ 
+C  PRINTOUT OF INFORMATIONS FOR DEBUGGING
+      IF ( DEBUG ) WRITE(MONIOU,484) MDEBUG
+  484 FORMAT(/' ATTENTION ! DEBUGGING IS ACTIVE'/
+     *          ' ====> DEBUG INFORMATION WRITTEN TO UNIT ',I3//)
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c   Next block of code is obsolete.
+c   Now it's used "jcio" routines (C)
+cC-----------------------------------------------------------------------
+cC  OPEN OUTPUT DATA SET FOR RUN
+c      IBL = INDEX(DSN,' ')
+c      DSN(IBL:73) = 'DAT000000'
+c      WRITE(DSN(IBL+3:IBL+8),'(I6)') NRRUN
+c      DO 274  L = IBL+3,IBL+8
+c        IF ( DSN(L:L) .EQ. ' ' ) DSN(L:L) = '0'
+c 274  CONTINUE
+cC  OPEN DATASET FOR PARTICLE OUTPUT
+c      OPEN(UNIT=PATAPE,FILE=DSN,STATUS='NEW',
+c     *       FORM='UNFORMATTED',ACCESS='SEQUENTIAL')
+c      WRITE(MONIOU,579) DSN
+c 579  FORMAT(/' PARTICLE OUTPUT TO DIRECTORY : ',A79)
+cC  WRITE RUNHEADER TO OUTPUT BUFFER
+c      CALL TOBUF( RUNH,0 )
+c
+cC  OPEN OUTPUT DATA SET FOR CERENKOV PHOTONS
+c      IF ( LCERFI ) THEN
+c        DSN(IBL:73) = 'CER000000'
+c        WRITE(DSN(IBL+3:IBL+8),'(I6)') NRRUN
+c        DO 249  L = IBL+3,IBL+8
+c          IF (DSN(L:L) .EQ. ' ' ) DSN(L:L) = '0'
+c 249    CONTINUE
+c        OPEN(UNIT=CETAPE,FILE=DSN,STATUS='NEW',
+c     *       FORM='UNFORMATTED',ACCESS='SEQUENTIAL')
+c        WRITE(MONIOU,580) DSN
+c 580    FORMAT(' CERENKOV OUTPUT TO DIRECTORY : ',A79)
+c        CALL TOBUFC( RUNH,0 )
+c      ELSE
+c        WRITE(MONIOU,580) DSN
+c      ENDIF
+cC  RESET DSN
+c      DSN(IBL:73) = '         '
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ 
+C  OPEN ON EXTERNAL STACK
+C  BLOCKS OF 32640 BYTES = 4080 REAL*8 = 340 PARTICLES
+      OPEN(UNIT=EXST,STATUS='SCRATCH',
+     *     FORM='UNFORMATTED',ACCESS='DIRECT',RECL=MAXSTK)
+ 
+ 
+C-----------------------------------------------------------------------
+C  WRITE DATA SET FOR INFORMATION BANK
+      IF (FDBASE ) THEN
+C  OPEN OUTPUT DATA SET FOR RUN
+        IBL = INDEX(DSN,' ')
+        DSN(IBL:79) = 'DAT000000.dbase'
+        WRITE(DSN(IBL+3:IBL+8),'(I6)') NRRUN
+        DO 275  L = IBL+3,IBL+8
+          IF ( DSN(L:L) .EQ. ' ' ) DSN(L:L) = '0'
+ 275    CONTINUE
+        OPEN(UNIT=MDBASE,FILE=DSN,STATUS='NEW')
+        WRITE(MONIOU,581) DSN
+ 581    FORMAT(/' DBASE OUTPUT TO DIRECTORY : ',A79)
+C  RESET DSN
+        DSN(IBL+9:IBL+14) = '      '
+ 
+        LSTDSN(1:3) = 'LST'
+        LSTDSN(4:9) = DSN(IBL+3:IBL+8)
+        VERVEN=FLOAT(IVERVN)/1000.
+        IF ( LLONGI ) THEN
+          ILONG = 1
+        ELSE
+          ILONG = 0
+        ENDIF
+        IF ( EVTH(75) .NE. 0. ) THEN
+          ISO = 0
+        ELSE
+          ISO = 1
+        ENDIF
+C  SET DPMFLAG (0=VENUS, 1=HDPM, 2=SIBYLL, 3=QGSJET, 4=DPMJET)
+        IF     ( EVTH( 76) .NE. 0. ) THEN
+          IDPM = 0
+        ELSEIF ( EVTH(139) .NE. 0. ) THEN
+          IDPM = 2
+        ELSEIF ( EVTH(141) .NE. 0. ) THEN
+          IDPM = 3
+        ELSEIF ( EVTH(143) .NE. 0. ) THEN
+          IDPM = 4
+        ELSE
+          IDPM = 1
+        ENDIF
+C  INCREMENT DPMFLAG FOR VARIOUS CROSS SECTIONS
+C  BY (0=HDPM-SIG, 10=VENUSSIG, 20=SIBYLLSIG, 30=QGSSIG, 4=DPMJETSIG)
+        IF     ( EVTH(145) .NE. 0 ) THEN
+          IDPM = IDPM + 10
+        ELSEIF ( EVTH(140) .NE. 0 ) THEN
+          IDPM = IDPM + 20
+        ELSEIF ( EVTH(142) .NE. 0 ) THEN
+          IDPM = IDPM + 30
+        ELSEIF ( EVTH(144) .NE. 0 ) THEN
+          IDPM = IDPM + 40
+        ENDIF
+        MARK = '1'
+        LTHIN = .FALSE.
+        EFRAC = 0.D0
+ 
+        WRITE(MDBASE,666)VERNUM,MARK,MVDATE,VERVEN,
+     $INT(RUNH(3))+19000000,INT(EVTH(80)),INT(EVTH(79)),INT(EVTH(78)),
+     $INT(EVTH(77)),INT(RUNH(2)),INT(PRMPAR(1)),
+     $LLIMIT,ULIMIT,PSLOPE,INT(RUNH(20)),
+     $INT(RUNH(19)),INT(EVTH(76)),INT(EVTH(75)),ISO,IDPM,
+     $NFLAIN,NFLDIF,NFLPI0,NFLPIF,
+     $NFLCHE,NFRAGM,ILONG,THSTEP,
+     $BX,BZ,NOBSLV,
+     $OBSLEV(1),OBSLEV(2),OBSLEV(3),
+     $OBSLEV(4),OBSLEV(5),OBSLEV(6),
+     $OBSLEV(7),OBSLEV(8),OBSLEV(9),
+     $OBSLEV(10),ELCUT(1),ELCUT(2),ELCUT(3),
+     $ELCUT(4),EVTH(81),EVTH(82),EVTH(83),
+     $EVTH(84),FIXHEI,N1STTR,THICK0,
+     $STEPFC,ARRANG,INT(EVTH(94)),NSEQ,
+     $ISEED(1,1),ISEED(2,1),ISEED(3,1),ISEED(1,2),
+     $ISEED(2,2),ISEED(3,2),ISEED(1,3),
+     $ISEED(2,3),ISEED(3,3),0,DSN,
+     $LSTDSN,' JDD300.01',' JDD300.01',
+     $NSHOW,HOST,USER,LTHIN,EFRAC
+ 
+ 666    FORMAT('#version#',F6.3,A1,'#versiondate#',I9,'#venusversion#',
+     $F6.3,'#rundate#',I9,/,'#computer#',I2,'#horizont#',I2,'#neutrino#'
+     $,I2,'#cerenkov#',I2,'#runnumber#',I7,/,'#primary#',I5,
+     $'#e_range_l#',E15.7,'#e_range_u#',E15.7,/,'#slope#',E15.7,'#nkg#',
+     $I2,'#egs#',I2,'#venus#',I2,'#gheisha#',I2,'#isobar#',I2,'#hdpm#',
+     $I2,/,'#hadflag1#',I2,'#hadflag2#',I2,'#hadflag3#',I2,'#hadflag4#',
+     $I2,'#hadflag5#',I2,'#hadflag6#',I2,/,'#longi#',I2,'#longistep#',
+     $E15.7,'#magnetx#',E15.7,/,'#magnetz#',E15.7,'#nobslev#',I3,/,
+     $'#obslev1#',E15.7,'#obslev2#',E15.7,'#obslev3#',E15.7,/,
+     $'#obslev4#',E15.7,'#obslev5#',E15.7,'#obslev6#',E15.7,/,
+     $'#obslev7#',E15.7,'#obslev8#',E15.7,'#obslev9#',E15.7,/,
+     $'#obslev10#',E15.7,'#hcut#',E15.7,'#mcut#',E15.7,/,'#ecut#',E15.7,
+     $'#gcut#',E15.7,'#thetal#',E15.7,/,'#thetau#',E15.7,'#phil#',E15.7,
+     $'#phiu#',E15.7,/,'#fixhei#',E15.7,'#n1sttr#',I3,'#fixchi#',E15.7,
+     $/,'#stepfc#',E15.7,'#arrang#',E15.7,'#muaddi#',I2,'#nseq#',I2,/,
+     $'#seq1seed1#',I9,'#seq1seed2#',I9,'#seq1seed3#',I9,/,'#seq2seed1#'
+     $,I9,'#seq2seed2#',I9,'#seq2seed3#',I9,/,'#seq3seed1#',I9,
+     $'#seq3seed2#',I9,'#seq3seed3#',I9,/,'#size#',I10,'#dsn_events#',
+     $A59,/,'#dsn_prtout# ',A9,'#tape_name#',A10,'#backup#',A10,/,
+     $'#howmanyshowers#',I10,'#host#',A20,'#user#',A20,/
+     $'#thinning#',L4,'#thinninglevel#',E15.7)
+ 
+C  RESET DSN
+        DSN(IBL:IBL+14) = '               '
+        CLOSE(UNIT=MDBASE)
+      ENDIF
+ 
+      WRITE(MONIOU,*)'NUMBER OF SHOWERS TO GENERATE =',NSHOW
+      WRITE(MONIOU,*)
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/isobar.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/isobar.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/isobar.f	(revision 286)
@@ -0,0 +1,304 @@
+      SUBROUTINE ISOBAR( E,KIND,AMASS,ASMASS,NOPI )
+ 
+C-----------------------------------------------------------------------
+C  ISOBAR
+C
+C  THREE AND FOUR PION DECAY OF HEAVY ISOBAR, DECAY IS PICKED AT
+C  RANDOM FROM A UNIFORM DISTRIBUTION WITH EQUAL PROBABILITY
+C  CHARGE IS DISTRIBUTED AT RANDOM WITH EQUAL PROBABILITY
+C  DECAYS ARE COMPUTED VIA MOMENTA, HAVING UNIFORM DISTRIBUTION
+C  UPPER LIMIT OF MOMENTUM DISTRIBUTIONS ARE SPECIFIED BY INPUT DATA
+C  ENERGY IS STRICTLY CONSERVED, MOMENTA ONLY ON AVERAGE
+C  THIS SUBROUTINE IS CALLED FROM MANY BOX ROUTINES
+C  ARGUMENTS:
+C   E      = AVAILABLE ENERGY IN CM
+C   KIND   = 1  BACKWARD ISOBAR
+C          = 0  FORWARD  ISOBAR
+C   AMASS  = MASS OF HEAVY MESON
+C   ASMASS = MASS TO BE LEFT OVER FOR OTHER PARTICLES
+C   NOPI   = NUMBER OF PIONS TO BE GENERATED
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,BAL.
+      COMMON /BAL/     EBAL
+      DOUBLE PRECISION EBAL(10)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,ELASTY.
+      COMMON /ELASTY/  ELAST,IELIS,IELHM,IELNU,IELPI
+      DOUBLE PRECISION ELAST
+      INTEGER          IELIS(20),IELHM(20),IELNU(20),IELPI(20)
+*KEEP,MULT.
+      COMMON /MULT/    EKINL,MSMM,MULTMA,MULTOT
+      DOUBLE PRECISION EKINL
+      INTEGER          MSMM,MULTMA(37,13),MULTOT(37,13)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,VKIN.
+      COMMON /VKIN/    BETACM
+      DOUBLE PRECISION BETACM
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,201)E,KIND,AMASS,ASMASS,NOPI
+ 201  FORMAT(' ISOBAR: E,KIND,AMASS,ASMASS,NOPI=',1P,E10.4,I3,2E10.4,I3)
+ 
+C  RETURN 1 KILLS PARTICLE
+ 
+      ISET  = 1
+      EDI   = 0.D0
+      PACC  = 0.D0
+      RESTE = AMASS
+ 
+      IF ( KIND .NE. 0 ) GOTO 100
+ 
+C-----------------------------------------------------------------------
+C  FORWARD ISOBAR
+C  PIONS FROM FORWARD ISOBAR
+      IF ( NOPI .EQ. 1 ) THEN
+        INOPI = NOPI
+        A     = C(36)
+        W     = 0.38D0
+      ELSE
+        W     = 1.5D0
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1) .LE. 0.5 ) THEN
+          INOPI = 3
+          A     = C(36)
+        ELSE
+          INOPI = 4
+          A     = C(35)
+        ENDIF
+      ENDIF
+ 
+      GIFCM  = (E**2+AMASS**2-ASMASS**2) * 0.5D0 /(E*AMASS)
+      BEIFCM = SQRT(GIFCM**2 - 1.D0) / GIFCM
+      GIFLAB = GCM * GIFCM * (1.D0+BETACM*BEIFCM)
+      BEIFL  = SQRT(GIFLAB**2 - 1.D0) / GIFLAB
+ 
+C  PION LOOP FOR FORWARD ISOBAR DECAY
+ 13   CONTINUE
+      P      = PCL(A,W)
+      PT     = PTRANS(DUMMY)
+      GPIIF  = SQRT( P**2 / PAMA(8)**2 + 1.D0 )
+      BEPIIF = SQRT(GPIIF**2 - 1.D0) / GPIIF
+      EDI    = EDI + SQRT( PAMA(8)**2 + P**2 + PT**2 )
+      RESTE  = RESTE - EDI
+ 
+      CALL RMMAR( RD,3,1 )
+      IF ( RD(1) .GT. 0.5 ) THEN
+        GPILAB = GPIIF*GIFLAB*(1.D0-BEIFL*BEPIIF)
+        PACC   = PACC - P
+      ELSE
+        GPILAB = GPIIF*GIFLAB*(1.D0+BEIFL*BEPIIF)
+        PACC   = PACC + P
+      ENDIF
+ 
+C  CORRECTIVE ACTION IF PLLAB2 LE 1.E-6
+      PLLAB2 = PAMA(8)**2 *(GPILAB**2 - 1.D0)
+      PLLAB2 = MAX( 1.D-6, PLLAB2 )
+      CTHETA = SQRT( PLLAB2 / (PT**2+PLLAB2) )
+      IF ( CTHETA .GE. C(27) ) THEN
+        CALL ADDANG( COSTHE,PHI, CTHETA,RD(2)*PI2, SECPAR(3),SECPAR(4) )
+        IF ( SECPAR(3) .GE. C(29) ) THEN
+          SECPAR(2) = GPILAB
+C  CHARGE ASSIGNMENT
+          IF     ( RD(3) .LE. OB3 ) THEN
+            SECPAR(1) = 7.D0
+          ELSEIF ( RD(3) .LE. TB3 ) THEN
+            SECPAR(1) = 8.D0
+          ELSE
+            SECPAR(1) = 9.D0
+          ENDIF
+          DO  5  J = 5,8
+            SECPAR(J) = CURPAR(J)
+ 5        CONTINUE
+ 
+          CALL TSTACK
+        ENDIF
+      ENDIF
+      IF ( RESTE .LE. PAMA(14)  .OR.  ISET .EQ. INOPI ) GOTO 14
+      ISET = ISET + 1
+      GOTO 13
+ 
+C  NUCLEON FROM FORWARD ISOBAR
+ 14   CONTINUE
+      PT    = PTRANS(DUMMY)
+      MSMM  = MSMM + ISET
+      EPT   = SQRT( PAMA(14)**2 + PT**2 )
+      RESTE = RESTE - EPT
+ 
+      IF ( RESTE .LE. 0.D0 ) THEN
+        GNFLAB  = GIFLAB
+        EBAL(1) = EBAL(1) + RESTE
+      ELSE
+        GNIF    = (RESTE+PAMA(14)) / PAMA(14)
+        BENIF   = SQRT(GNIF**2 - 1.D0) / GNIF
+        IF ( PACC .LE. 0.D0 ) THEN
+          GNFLAB = GIFLAB * GNIF * (1.D0 + BENIF*BEIFL)
+        ELSE
+          GNFLAB = GIFLAB * GNIF * (1.D0 - BENIF*BEIFL)
+        ENDIF
+      ENDIF
+ 
+      PLLAB2 = PAMA(14)**2 * (GNFLAB**2 - 1.D0)
+      PLLAB2 = MAX( 1.D-6, PLLAB2 )
+      CTHETA = SQRT( PLLAB2 / (PT**2+PLLAB2) )
+      IF ( CTHETA .LT. C(27) ) RETURN
+      CALL RMMAR( RD,2,1 )
+      CALL ADDANG( COSTHE,PHI, CTHETA,RD(1)*PI2, SECPAR(3),SECPAR(4) )
+      IF ( SECPAR(3) .LT. C(29) ) RETURN
+      SECPAR(2) = GNFLAB
+ 
+      IF ( RD(2) .LT. 0.5 ) THEN
+        IADD = 1
+      ELSE
+        IADD = 0
+      ENDIF
+ 
+      IF ( ITYPE .EQ. 13  .OR.  ITYPE .EQ. 14 ) THEN
+        SECPAR(1) = 14 - IADD
+      ELSE
+        SECPAR(1) = 15 + 10*IADD
+      ENDIF
+ 
+C  CHARGE ASSIGNMENT
+      DO  9  J = 5,8
+        SECPAR(J) = CURPAR(J)
+    9 CONTINUE
+      CALL TSTACK
+ 
+C  FILL HISTOGRAM
+      IN = 1.D0 + SECPAR(2) / GAMMA * 20.D0
+      IN = MIN( IN, 20 )
+      IELIS(IN) = IELIS(IN) + 1
+ 
+      RETURN
+ 
+C-----------------------------------------------------------------------
+C  BACKWARD ISOBAR
+C  PIONS FROM BACKWARD ISOBAR
+  100 CONTINUE
+ 
+      IF ( NOPI .EQ. 1 ) THEN
+        INOPI = NOPI
+      ELSE
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1) .LE. 0.5 ) THEN
+          INOPI = 3
+        ELSE
+          INOPI = 4
+        ENDIF
+      ENDIF
+      WORK = MIN( C(11), GAMMA*0.5D0 )
+      MSMM = MSMM + INOPI
+      DO 101  J = 1,INOPI
+        CALL RMMAR( RD,3,1 )
+        GPI    = RD(1)*(WORK-1.D0) + 1.D0
+        PT     = PTRANS(DUMMY)
+        EDI    = EDI+SQRT( PAMA(8)**2+PAMA(8)**2*(GPI**2-1.D0)+PT**2 )
+        RESTE  = ASMASS - EDI
+        PLLAB2 = PAMA(8)**2 * (GPI**2 - 1.D0)
+        PLLAB2 = MAX( 1.D-6, PLLAB2 )
+        CTHETA = SQRT( PLLAB2 / (PT**2+PLLAB2) )
+        IF ( CTHETA .GE. C(27) ) THEN
+          CALL ADDANG( COSTHE,PHI, CTHETA,RD(2)*PI2,
+     *                                    SECPAR(3),SECPAR(4) )
+          IF ( SECPAR(3) .GE. C(29) ) THEN
+            SECPAR(2) = GPI
+C  CHARGE ASSIGNMENT
+            RR = RD(3)
+            IF     ( RR .LE. OB3 ) THEN
+              SECPAR(1) = 7.D0
+            ELSEIF ( RR .LE. TB3 ) THEN
+              SECPAR(1) = 8.D0
+            ELSE
+              SECPAR(1) = 9.D0
+            ENDIF
+            DO 104  I = 5,8
+              SECPAR(I) = CURPAR(I)
+  104       CONTINUE
+ 
+            CALL TSTACK
+          ENDIF
+        ENDIF
+        IF ( RESTE .LE. PAMA(14) ) GOTO 110
+  101 CONTINUE
+ 
+C  NUCLEON FROM BACKWARD ISOBAR
+ 
+  110 CONTINUE
+      WORK    = MIN( C(10), GAMMA*0.5D0 )
+      CALL RMMAR( RD,3,1 )
+      GNRLAB  = RD(1) * (WORK-1.D0) + 1.D0
+      PT      = PTRANS(DUMMY)
+      EDI = EDI+SQRT( PAMA(14)**2 + PAMA(14)**2*(GNRLAB**2-1.D0)+PT**2)
+      RESTE   = ASMASS - EDI
+      EBAL(2) = EBAL(2) + RESTE
+      PLLAB2  = PAMA(14)**2 * (GNRLAB**2 - 1.D0)
+      PLLAB2  = MAX( 1.D-6, PLLAB2 )
+      CTHETA  = SQRT( PLLAB2 / (PT**2+PLLAB2) )
+      IF ( CTHETA .LT. C(27) ) RETURN
+      CALL ADDANG( COSTHE,PHI, CTHETA,RD(2)*PI2, SECPAR(3),SECPAR(4) )
+      IF ( SECPAR(3) .LT. C(29) ) RETURN
+      SECPAR(2) = GNRLAB
+C  CHARGE ASSIGNMENT
+      IF ( RD(3) .LT. 0.5 ) THEN
+        SECPAR(1) = 13.D0
+      ELSE
+        SECPAR(1) = 14.D0
+      ENDIF
+      DO 113  J = 5,8
+        SECPAR(J) = CURPAR(J)
+  113 CONTINUE
+      CALL TSTACK
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/istack.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/istack.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/istack.f	(revision 286)
@@ -0,0 +1,57 @@
+      SUBROUTINE ISTACK
+ 
+C-----------------------------------------------------------------------
+C  I(NITIALIZE) STACK
+C
+C  PREPARES STACK AND EXTERNAL DISK FILE
+C  THIS SUBROUTINE IS CALLED FROM MAIN
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,ETHMAP.
+      COMMON /ETHMAP/  ECTMAP,ELEFT
+      DOUBLE PRECISION ECTMAP,ELEFT
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKF.
+      COMMON /STACKF/  STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+      INTEGER          MAXSTK
+      PARAMETER        (MAXSTK = 12*340*2)
+      DOUBLE PRECISION STACK(MAXSTK)
+      INTEGER          STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'ISTACK:'
+ 
+      NTO    = 0
+      NFROM  = 0
+      NOUREC = 0
+      NSHIFT = 0
+      STACKP = 0
+      ELEFT  = 0.D0
+      ICOUNT = 1
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/jadach.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/jadach.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/jadach.f	(revision 286)
@@ -0,0 +1,135 @@
+      SUBROUTINE JADACH( ECMJAD,JADFLG )
+ 
+C-----------------------------------------------------------------------
+C  JADACH (FILTER)
+C
+C  ADJUSTS THE RAPIDITIES OF ALL SECONDARIES SUCH THAT
+C  ENERGY AND LONGITUDINAL MOMENTUM ARE CONSERVED AT THE SAME TIME
+C  THE ALGORITHM IS TAKEN FROM S.JADACH, COM.PHYS.COMM. 9 (1975) 297
+C  THE ROUTINE MUST BE CALLED AFTER THE PT IS CONSERVED AND BEFORE
+C  THE TRANSFORMATION TO THE LAB SYSTEM IS DONE
+C  THIS SUBROUTINE IS CALLED FROM HDPM
+C  ARGUMENTS:
+C   ECMJAD = CM ENERGY IN THE PROJECTILE -- GNU*NUCLEONS SYSTEM
+C   JADFLG = 0  JADACH FILTER CORRECTLY ENDED
+C          = 1  BAD RAPIDITIES, SELECT RAPIDITIES AGAIN
+C          =-1  SUM OF TRANSVERSE MASSES EXCEEDS AVAILABLE CM ENERGY
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,INTER.
+      COMMON /INTER/   AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
+     *                 IDIF,ITAR
+      DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
+      INTEGER          IDIF,ITAR
+*KEEP,NEWPAR.
+      COMMON /NEWPAR/  EA,PT2,PX,PY,TMAS,YR,ITYP,
+     *                 IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
+     *                 IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
+      DOUBLE PRECISION EA(3000),PT2(3000),PX(3000),PY(3000),TMAS(3000),
+     *                 YR(3000)
+      INTEGER          ITYP(3000),
+     *                 IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
+     *                 IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DIMENSION YRJAD(3000)
+      DATA EPS / 1.D-7 /
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'JADACH: NTOT=',NTOT
+ 
+      JADFLG = 0
+ 
+C  SUM UP TRANSVERSE MOMENTA AND COMPARE WITH AVAILABLE C.M.ENERGY
+      STMAS = 0.D0
+      ECMI  = 1.D0 / ECMJAD
+      DO  4  I = 1,NTOT
+        STMAS    = STMAS + TMAS(I)
+        YRJAD(I) = YR(I)
+  4   CONTINUE
+      REST  = ( ECMJAD - STMAS ) * ECMI
+      IF ( REST .LE. 0.D0 ) THEN
+C  SUMMED TRANSVERSE MASS > AVAILABLE C.M. ENERGY
+        JADFLG = -1
+        RETURN
+      ENDIF
+      FACT   = 1.5D0 / REST
+      AA     = 1.D0
+      DIFOLD = 0.D0
+      ICOUNT = 0
+C  OPTIMIZATION LOOP TO DEFINE PARAMETER AA
+  1   CONTINUE
+      ICOUNT = ICOUNT + 1
+      IF ( ICOUNT .GE. 50 ) GOTO 999
+C  FORM SUMS S1 AND S2
+      S1     = 0.D0
+      S2     = 0.D0
+      DO  5  I = 1,NTOT
+        EXPO = EXP( AA * YR(I) )
+        S1   = S1 + TMAS(I) * ECMI * EXPO
+        S2   = S2 + TMAS(I) * ECMI / EXPO
+  5   CONTINUE
+      DIFF   = 0.1D0 * LOG(S1*S2)
+C  ACCELERATING OF CONVERGENCE IF NO CHANGE OF SIGN IN DIFF
+      IF ( DIFOLD*DIFF .GE. 0.D0 ) DIFF =  DIFF * FACT
+      DIFOLD = DIFF
+      IF ( DEBUG ) WRITE(MDEBUG,*) '   DIFF=',SNGL(DIFF)
+      AA     = AA * MAX( 0.1D0, (1.D0 - DIFF) )
+      IF ( ABS(DIFF) .GT. EPS ) GOTO 1
+ 
+C  ITERATION HAS CONVERGED, CALCULATE PARAMETER BB
+      BB     = 0.5D0 * LOG(S2/S1)
+ 
+      IF ( DEBUG ) WRITE (MDEBUG,110) ICOUNT,STMAS,REST
+  110 FORMAT('   ICOUNT, STMAS, REST = ',I5,2E13.5,/
+     *       '   NUM   ITYP    TMAS          YR(OLD)         YR(NEW)')
+C  CORRECT RAPIDITIES
+      DO 10  I = 1,NTOT
+        YR(I) = AA * YR(I) + BB
+        IF ( DEBUG ) WRITE(MDEBUG,111) I,ITYP(I),TMAS(I),YRJAD(I),YR(I)
+ 111    FORMAT('  ',I4,I6,F12.5,2F16.8)
+C  IMPOSSIBLE RAPIDITY, DETERMINE AGAIN THE RAPIDITIES
+        IF ( ABS(YR(I)) .GT. LOG(ECMJAD/PAMA(ITYP(I))) ) GOTO 999
+ 10   CONTINUE
+      RETURN
+ 
+ 
+C  ERROR EXIT
+ 999  JADFLG = 1
+C  NO CONVERGENCE AFTER 50 ITERATIONS OR IMPOSSIBLE RAPIDITY
+      RETURN
+ 
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/jcdate.c
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/jcdate.c	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/jcdate.c	(revision 286)
@@ -0,0 +1,45 @@
+/*----------------------------------------------------------------------
+  jcdate.c : 
+
+  Function to get the hour/date of the system
+  modified 13-10-98, D. Petry
+
+----------------------------------------------------------------------*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+
+static int s0=0;
+
+/*--------------------------------------------------
+  jcdate: 
+--------------------------------------------------*/
+#ifdef JC_UNDERSCORES
+void
+jcdate_ (int *id, int *it, int *isl1, int *isl2, int *isl3, 
+                           int *isl4, int *isl5, int *isl6 )
+#else /* JC_NO_UNDERSCORES */
+void
+jcdate (int *id, int *it, int *isl1, int *isl2, int *isl3, 
+                          int *isl4, int *isl5, int *isl6 )
+#endif /* JC_UNDERSCORES */
+{
+  time_t timesecs;
+  struct tm *t;
+
+  s0 = (int) time( &timesecs );
+  t = gmtime( &timesecs );
+  *isl1 = (int) t->tm_year;
+  *isl2 = (int) t->tm_mon+1;
+  *isl3 = (int) t->tm_mday;
+  *isl4 = (int) t->tm_hour;
+  *isl5 = (int) t->tm_min;
+  *isl6 = (int) t->tm_sec;
+
+  *id = *isl1 * 10000 + *isl2 * 100 + *isl3;
+  *it = *isl4 * 10000 + *isl5 * 100 + *isl6;
+
+  return;
+}
+
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/jcio.c
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/jcio.c	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/jcio.c	(revision 286)
@@ -0,0 +1,358 @@
+/*----------------------------------------------------------------------
+  jcio.c : 
+
+Rutinas para la gestion de ficheros en CORSIKA 5.20 Las posibilidades
+que contempla son: 
+
+- Creacion de un fichero de inicio de run: run###### 
+- Creacion de un fichero de fin de run: end###### 
+- Creacion de fichero separados para cada cascada, tanto para
+  particulas como para Cherenkov. Ademas, para la salida Cherenkov se
+  genera en ficheros separados en caso de que se reutilice la cascada.
+  Los fichero son por tanto: cer######.# y dat######, donde el indice
+  del fichero cer va de 0 a 9.
+- La grabacion se realiza en C, por lo que no existen marcas de inicio
+  ni final de bloque en los ficheros.
+----------------------------------------------------------------------*/
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#define MAXBUF 273  /*- 39*7 -*/
+#define NSUBBL 21
+#define NPLONG 1041
+
+static int nshow = 0;
+static float timefirst = 0.;
+static float timelast = 0.;
+
+FILE *cetape;
+FILE *patape;
+FILE *sttape;
+FILE *runtape;
+FILE *endtape;
+char tpl[100];
+char certpl[100];
+char dattpl[100];
+char statpl[100];
+char cerfile[100];
+char datfile[100];
+char stafile[100];
+char runfile[100];
+char endfile[100];
+
+/*--------------------------------------------------
+  jcinitio: 
+  graba un bloque al fichero de particulas 
+--------------------------------------------------*/
+#ifdef JC_UNDERSCORES
+void
+jcinitio_ (char *path, int *runnum)
+#else /* JC_NO_UNDERSCORES */
+void
+jcinitio (char *path, int *runnum)
+#endif /* JC_UNDERSCORES */
+{
+  register int i = 0;
+
+  while (*(path + (++i)) != ' ');
+  strncpy (tpl, path, i);
+  if (*(path + i - 1) != '/')
+    strcat (tpl, "/");
+
+  strcpy (certpl, tpl);
+  strcat (certpl, "cer%06d");
+  strcpy (dattpl, tpl);
+  strcat (dattpl, "dat%06d");
+  strcpy (statpl, tpl);
+  strcat (statpl, "sta%06d");
+
+  sprintf (runfile, "%srun%06d", tpl, *runnum);
+  sprintf (endfile, "%send%06d", tpl, *runnum);
+}
+
+/*--------------------------------------------------
+  jcdatsave: 
+  graba un bloque al fichero de particulas 
+--------------------------------------------------*/
+#ifdef JC_UNDERSCORES
+void
+jcdatsave_ (float *outbuf)
+#else /* JC_NO_UNDERSCORES */
+void
+jcdatsave (float *outbuf)
+#endif /* JC_UNDERSCORES */
+{
+  /* puts("JCIO:: saving particle buffer..."); */
+  fwrite (outbuf, sizeof (float) * MAXBUF * NSUBBL, 1, patape);
+}
+
+/*--------------------------------------------------
+  jccersave: 
+  graba un bloque al fichero de particulas 
+--------------------------------------------------*/
+#ifdef JC_UNDERSCORES
+void
+jccersave_ (float *outbuf)
+#else /* JC_NO_UNDERSCORES */
+void
+jccersave (float *outbuf)
+#endif /* JC_UNDERSCORES */
+{
+  /* puts("JCIO:: saving cerenkov buffer..."); */
+  fwrite (outbuf, sizeof (float) * MAXBUF * NSUBBL, 1, cetape);
+}
+
+/*--------------------------------------------------
+  jcstartrun:
+  abre el fichero run###### y graba el contenido
+--------------------------------------------------*/
+#ifdef JC_UNDERSCORES
+void
+jcstartrun_ (float *runh)
+#else /* JC_NO_UNDERSCORES */
+void
+jcstartrun (float *runh)
+#endif /* JC_UNDERSCORES */
+{
+  if ((runtape = fopen (runfile, "wb")) == NULL) {
+    printf ("JCIO:: Cannot open RUN file %s. Exiting.\n", runfile);
+    exit (1);
+  }
+  /* puts("JCIO:: saving runheader buffer..."); */
+  fwrite (runh, sizeof (float) * MAXBUF, 1, runtape);
+}
+
+/*--------------------------------------------------
+  jcendrun:
+  abre el fichero run###### y graba el contenido
+--------------------------------------------------*/
+#ifdef JC_UNDERSCORES
+void
+jcendrun_ (float *rune)
+#else /* JC_NO_UNDERSCORES */
+void
+jcendrun (float *rune)
+#endif /* JC_UNDERSCORES */
+{
+  fwrite (rune, sizeof (float) * MAXBUF, 1, runtape);
+  fclose (runtape);
+}
+
+/*--------------------------------------------------
+  jcnewcerfile:
+  abre un nuevo fichero Cherenkov
+--------------------------------------------------*/
+#ifdef JC_UNDERSCORES
+void
+jcnewcerfile_ ()
+#else /* JC_NO_UNDERSCORES */
+void
+jcnewcerfile ()
+#endif /* JC_UNDERSCORES */
+{
+  sprintf (cerfile, certpl, nshow);
+  if ((cetape = fopen (cerfile, "wb")) == NULL) {
+    printf ("JCIO:: Cannot open CER file %s. Exiting.\n", cerfile);
+    exit (1);
+  }
+  timefirst = 9.0e10;
+  timelast = -9.0e10;
+}
+
+/*--------------------------------------------------
+  jcnewdatfile:
+  abre un nuevo fichero de particulas
+--------------------------------------------------*/
+#ifdef JC_UNDERSCORES
+void
+jcnewdatfile_ (void)
+#else /* JC_NO_UNDERSCORES */
+void
+jcnewdatfile (void)
+#endif /* JC_UNDERSCORES */
+{
+  sprintf (datfile, dattpl, nshow);
+  if ((patape = fopen (datfile, "wb")) == NULL) {
+    printf ("JCIO:: Cannot open DAT file %s. Exiting.\n", datfile);
+    exit (1);
+  }
+}
+
+/*--------------------------------------------------
+  jcnewstafile:
+  abre un nuevo fichero de estadisticas
+--------------------------------------------------*/
+#ifdef JC_UNDERSCORES
+void
+jcnewstafile_ (void)
+#else /* JC_NO_UNDERSCORES */
+void
+jcnewstafile (void)
+#endif /* JC_UNDERSCORES */
+{
+  sprintf (stafile, statpl, nshow);
+  if ((sttape = fopen (stafile, "wb")) == NULL) {
+    printf ("JCIO:: Cannot open STA file %s. Exiting.\n", stafile);
+    exit (1);
+  }
+}
+
+/*--------------------------------------------------
+  jcnewshower:
+  abre nuevos ficheros para la nueva cascada
+--------------------------------------------------*/
+#ifdef JC_UNDERSCORES
+void
+jcnewshower_ (void)
+#else /* JC_NO_UNDERSCORES */
+void
+jcnewshower (void)
+#endif /* JC_UNDERSCORES */
+{
+  if (nshow > 0) {
+    fclose (patape);
+    fclose (cetape);
+    fclose (sttape);
+  }
+
+  nshow++;
+#ifdef JC_UNDERSCORES
+  jcnewdatfile_ ();
+  jcnewcerfile_ ();
+  jcnewstafile_ ();
+#else /* JC_NO_UNDERSCORES */
+  jcnewdatfile ();
+  jcnewcerfile ();
+  jcnewstafile ();
+#endif /* JC_UNDERSCORES */
+}
+
+/*--------------------------------------------------
+  jcenddata:
+  abre el fichero run###### y graba el contenido
+--------------------------------------------------*/
+#ifdef JC_UNDERSCORES
+void
+jcenddata_ (float *runh, float *rune)
+#else /* JC_NO_UNDERSCORES */
+void
+jcenddata (float *runh, float *rune)
+#endif /* JC_UNDERSCORES */
+{
+  if ((endtape = fopen (endfile, "wb")) == NULL) {
+    printf ("JCIO:: Cannot open END file %s. Exiting.\n", endfile);
+    exit (1);
+  }
+  fwrite (runh, sizeof (float) * MAXBUF, 1, endtape);
+  fwrite (rune, sizeof (float) * MAXBUF, 1, endtape);
+  fclose (endtape);
+}
+
+/*--------------------------------------------------
+  jctime:
+  va echando cuentas del tiempo de los fotones
+--------------------------------------------------*/
+#ifdef JC_UNDERSCORES
+void
+jctime_ (float *cartim)
+#else /* JC_NO_UNDERSCORES */
+void
+jctime (float *cartim)
+#endif /* JC_UNDERSCORES */
+{
+  if (*cartim>timelast) timelast = *cartim;
+  if (*cartim<timefirst) timefirst = *cartim;
+}
+
+/*--------------------------------------------------
+  jcstadata:
+  graba las estadisticas de la cascada
+--------------------------------------------------*/
+#ifdef JC_UNDERSCORES
+void
+jcstadata_ (float *evth, float *evte,
+	    double *nproto, double *nprotb, double *nneutr,
+	    double *nneutb, double *nphoto, double *nelect,
+	    double *nposit, double *nnu, double *nmum,
+	    double *nmup, double *npi0, double *npim, double *npip,
+	    double *nk0l, double *nk0s, double *nkmi, double *nkpl,
+	    double *nhyp, double *ndeut, double *ntrit, double *nalpha,
+	    double *nother, int *ifinnu, int *ifinpi,
+	    int *ifinet, int *ifinka, int *ifinhy,
+	    double *cerele, double *cerhad,
+	    double *plong, int *lpct1, int *nstep, double *thstep)
+#else /* JC_NO_UNDERSCORES */
+void
+jcstadata (float *evth, float *evte,
+	    double *nproto, double *nprotb, double *nneutr,
+	    double *nneutb, double *nphoto, double *nelect,
+	    double *nposit, double *nnu, double *nmum,
+	    double *nmup, double *npi0, double *npim, double *npip,
+	    double *nk0l, double *nk0s, double *nkmi, double *nkpl,
+	    double *nhyp, double *ndeut, double *ntrit, double *nalpha,
+	    double *nother, int *ifinnu, int *ifinpi,
+	    int *ifinet, int *ifinka, int *ifinhy,
+	    double *cerele, double *cerhad,
+	    double *plong, int *lpct1, int *nstep, double *thstep)
+#endif /* JC_UNDERSCORES */ 
+{
+  register int i, ii, k;
+  int np[22];
+  float f;
+
+  fwrite (evth, sizeof (float) * MAXBUF, 1, sttape);
+  fwrite (evte, sizeof (float) * MAXBUF, 1, sttape);
+
+  fwrite (&timefirst, sizeof (float), 1, sttape);
+  fwrite (&timelast, sizeof (float), 1, sttape);
+
+  for (i = 0; i < 10; i++) {
+    np[0] = (int) (*(nproto + i));
+    np[1] = (int) (*(nprotb + i));
+    np[2] = (int) (*(nneutr + i));
+    np[3] = (int) (*(nneutb + i));
+    np[4] = (int) (*(nphoto + i));
+    np[5] = (int) (*(nelect + i));
+    np[6] = (int) (*(nposit + i));
+    np[7] = (int) (*(nnu + i));
+    np[8] = (int) (*(nmum + i));
+    np[9] = (int) (*(nmup + i));
+    np[10] = (int) (*(npi0 + i));
+    np[11] = (int) (*(npim + i));
+    np[12] = (int) (*(npip + i));
+    np[13] = (int) (*(nk0l + i));
+    np[14] = (int) (*(nk0s + i));
+    np[15] = (int) (*(nkmi + i));
+    np[16] = (int) (*(nkpl + i));
+    np[17] = (int) (*(nhyp + i));
+    np[18] = (int) (*(ndeut + i));
+    np[19] = (int) (*(ntrit + i));
+    np[20] = (int) (*(nalpha + i));
+    np[21] = (int) (*(nother + i));
+    fwrite (np, sizeof (int) * 22, 1, sttape);
+  }
+
+  np[0] = (int) (*ifinnu);
+  np[1] = (int) (*ifinpi);
+  np[2] = (int) (*ifinet);
+  np[3] = (int) (*ifinka);
+  np[4] = (int) (*ifinhy);
+  np[5] = (int) (*cerele);
+  np[6] = (int) (*cerhad);
+  fwrite (np, sizeof (int) * 7, 1, sttape);
+
+  fwrite (lpct1, sizeof (int), 1, sttape);
+  fwrite (nstep, sizeof (int), 1, sttape);
+
+  f = (float) (*thstep);
+  fwrite (&f, sizeof (float), 1, sttape);
+
+  for (k=0;k<9;k++) 
+    for (i = 0; i < *nstep; i++) {
+      f = (float)(*(plong + i + k*NPLONG));
+      fwrite (&f, sizeof (float), 1, sttape);
+    }
+
+
+}
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/kdecay.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/kdecay.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/kdecay.f	(revision 286)
@@ -0,0 +1,356 @@
+      SUBROUTINE KDECAY( IGO )
+ 
+C-----------------------------------------------------------------------
+C  K(AON) DECAY
+C
+C  KAON DECAYS WITH FULL KINEMATIC, ENERGY AND MOMENTA CONSERVED
+C  ALL SECONDARY PARTICLES ARE WRITTEN TO STACK
+C  THIS SUBROUTINE IS CALLED FROM NUCINT
+C  ARGUMENT:         (TO CHARACTERIZE THE DECAYING KAON)
+C   IGO    = 1  K+
+C          = 2  K-
+C          = 3  K0S
+C          = 4  K0L
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,DECAY.
+      COMMON /DECAY/   GAM345,COS345,PHI345
+      DOUBLE PRECISION GAM345(3),COS345(3),PHI345(3)
+*KEEP,IRET.
+      COMMON /IRET/    IRET1,IRET2
+      INTEGER          IRET1,IRET2
+*KEEP,KAONS.
+      COMMON /KAONS/   CKA
+      DOUBLE PRECISION CKA(80)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,POLAR.
+      COMMON /POLAR/   POLART,POLARF
+      DOUBLE PRECISION POLART,POLARF
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION BETA3,COSTCM,COSTH3,GAMMA3,PHI3,RA,WORK1,WORK2
+      INTEGER          I,ICHARG,IGO,IPI,J,M3
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' KDECAY: CURPAR=',1P,9E10.3)
+ 
+C  COPY COORDINATES INTO SECPAR
+      DO 20  J = 5,8
+        SECPAR(J) = CURPAR(J)
+   20 CONTINUE
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  DECAY OF K(+,-) (6 MODES)
+ 
+      IF     ( IGO .LE. 2 ) THEN
+   21   CALL RMMAR( RD,1,1 )
+        RA = RD(1)
+ 
+C  DECAY  K(+,-)  ---->  MU(+,-) + NEUTRINO
+        IF     ( RA .LE. CKA(23) ) THEN
+C  NEUTRINO IS DROPPED
+          WORK1  = CKA(28) * GAMMA
+          WORK2  = CKA(29) * BETA * WORK1
+          CALL RMMAR( RD,2,1 )
+          COSTCM = RD(1) * 2.D0 - 1.D0
+C  MU(+,-)
+          GAMMA3 = WORK1 + COSTCM * WORK2
+          BETA3  = SQRT( 1.D0 - 1.D0 / GAMMA3**2 )
+          COSTH3 = MIN( 1.D0, (GAMMA * GAMMA3 - CKA(28))
+     *                   / (BETA * GAMMA * BETA3 * GAMMA3) )
+          PHI3   = RD(2) * PI2
+          CALL ADDANG( COSTHE,PHI, COSTH3,PHI3, SECPAR(3),SECPAR(4) )
+          IF ( SECPAR(3) .GT. C(29) ) THEN
+            SECPAR(1) = 4 + IGO
+            SECPAR(2) = GAMMA3
+C  DIRECTION OF PION IN THE MUON CM SYSTEM (= DIRECTION OF POLARIZATION)
+C  SEE: G. BARR ET AL., PHYS. REV. D39 (1989) 3532, EQ. 5
+C  POLART IS COS OF ANGLE BETWEEN KAON AND LABORATORY IN THE MU CM
+C  POLARF IS ANGLE PHI AROUND THE LAB DIRECTION IN THE MU CM
+C  POLART, POLARF WITH RESPECT TO THE MU DIRECTION IN THE LAB SYSTEM
+            POLART = ( 2.D0*PAMA(11)*GAMMA*C(6) / (PAMA(5)*GAMMA3)
+     *                 - C(6) - 1.D0 ) / ( BETA3 * (1.D0-C(6)) )
+            POLARF = PHI3 - PI
+C  PION DIRECTION IS DIRECTION OF POLARIZATION FOR K+, OPPOSITE FOR K-
+            IF ( ITYPE .EQ. 12 ) THEN
+              POLART = -POLART
+              POLARF = POLARF + PI
+            ENDIF
+C  GET THE POLARIZATION DIRECTION IN THE MU CM RELATIVE TO THE CORSIKA
+C  COORDINATE SYSTEM
+            CALL ADDANG( SECPAR(3),SECPAR(4), POLART,POLARF,
+     *                                             POLART,POLARF )
+            SECPAR(11) = POLART
+            SECPAR(12) = POLARF
+            CALL TSTACK
+            SECPAR(11) = 0.D0
+            SECPAR(12) = 0.D0
+          ENDIF
+ 
+C  DECAY  K(+,-)  ---->  PI(+,-) + PI(0)
+        ELSEIF ( RA .LE. CKA(47) ) THEN
+          M3 = ITYPE - 3
+          CALL DECAY1( ITYPE, M3, 7 )
+ 
+C  DECAY   K(+,-)  ---->   PI(+,-) + PI(+,-) + PI(-,+)
+        ELSEIF ( RA. LE. CKA(48) ) THEN
+          CALL DECAY6( PAMA(11), PAMA(8),PAMA(8),PAMA(8),
+     *                 CKA(51),CKA(52),CKA(53), CKA(54), 1 )
+C  PI(+,-)  AND  PI(+,-) AND  THIRD (ODD) PI(-,+)
+          DO 230  I = 1,3
+            CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
+     *                                 SECPAR(3),SECPAR(4) )
+            IF ( SECPAR(3) .GT. C(29) ) THEN
+              IF ( I .LE. 2 ) THEN
+                SECPAR(1) =  7 + IGO
+              ELSE
+                SECPAR(1) = 10 - IGO
+              ENDIF
+              SECPAR(2) = GAM345(I)
+              CALL TSTACK
+            ENDIF
+  230     CONTINUE
+ 
+C  DECAY  K(+,-)  ---->  PI(0)  + E(+,-) + NEUTRINO
+        ELSEIF ( RA. LE. CKA(49) ) THEN
+          CALL DECAY6( PAMA(11), PAMA(7),PAMA(2),0.D0,
+     *                 CKA(65),CKA(66),0.D0, CKA(67), 4 )
+C  PI(0)  AND  E(+,-) / NEUTRINO IS DROPPED
+          DO 250  I = 1,2
+            CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
+     *                                  SECPAR(3),SECPAR(4) )
+            IF ( SECPAR(3) .GT. C(29) ) THEN
+              IF ( I .EQ. 1 ) THEN
+                SECPAR(1) = 7.D0
+              ELSE
+                SECPAR(1) = 1 + IGO
+              ENDIF
+              SECPAR(2) = GAM345(I)
+              CALL TSTACK
+            ENDIF
+  250     CONTINUE
+ 
+C  DECAY  K(+,-)  ---->  PI(0)  + MU(+,-) + NEUTRINO
+        ELSEIF ( RA. LE. CKA(50) ) THEN
+          CALL DECAY6( PAMA(11), PAMA(7),PAMA(5),0.D0,
+     *                 CKA(68),CKA(69),0.D0, CKA(70), 3 )
+C  PI(0)  AND  MU(+,-) / NEUTRINO IS DROPPED
+          DO 260  I = 1,2
+            CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
+     *                                  SECPAR(3),SECPAR(4) )
+            IF ( SECPAR(3) .GT. C(29) ) THEN
+              SECPAR(2) = GAM345(I)
+              IF ( I .EQ. 1 ) THEN
+                SECPAR(1) = 7.D0
+              ELSE
+                SECPAR(1) = 4 + IGO
+                IF ( SECPAR(1) .EQ. 6.D0 ) THEN
+C  INVERT POLARIZATION DIRECTION FOR MU(-)
+                  POLART  = -POLART
+                  POLARF  =  POLARF + PI
+                ENDIF
+C  GET THE POLARIZATION DIRECTION IN THE MU CM RELATIVE TO THE CORSIKA
+C  COORDINATE SYSTEM
+                CALL ADDANG( SECPAR(3),SECPAR(4), POLART, POLARF,
+     *                                             POLART,POLARF )
+                SECPAR(11) = POLART
+                SECPAR(12) = POLARF
+              ENDIF
+              CALL TSTACK
+            ENDIF
+            SECPAR(11) = 0.D0
+            SECPAR(12) = 0.D0
+  260     CONTINUE
+ 
+C  DECAY  K(+,-)  ---->  PI(0) + PI(0) + PI(+,-)
+        ELSE
+          CALL DECAY6( PAMA(11), PAMA(7),PAMA(7),PAMA(8),
+     *                 CKA(55),CKA(56),CKA(57), CKA(58), 1 )
+C  PI(0)'S  AND  PI(+,-)
+          DO 270  I = 1,3
+            CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
+     *                                  SECPAR(3),SECPAR(4) )
+            IF ( SECPAR(3) .GT. C(29) ) THEN
+              IF ( I .LE. 2 ) THEN
+                SECPAR(1) = 7.D0
+              ELSE
+                SECPAR(1) = 7 + IGO
+              ENDIF
+              SECPAR(2) = GAM345(I)
+              CALL TSTACK
+            ENDIF
+  270     CONTINUE
+ 
+        ENDIF
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  DECAY OF K0S  (2 MODES)
+      ELSEIF ( IGO .EQ. 3 ) THEN
+ 
+        CALL RMMAR( RD,1,1 )
+C  DECAY  K0S  ---->  PI(+) + PI(-)
+        IF ( RD(1) .LE. CKA(24) ) THEN
+          CALL DECAY1( ITYPE, 8, 9 )
+ 
+C  DECAY  K0S  ---->  PI(0) + PI(0)
+        ELSE
+          CALL DECAY1( ITYPE, 7, 7 )
+ 
+        ENDIF
+ 
+C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  DECAY OF K0L   (4 MODES)
+      ELSEIF ( IGO .EQ. 4 ) THEN
+        CALL RMMAR( RD,1,1 )
+        RA = RD(1)
+ 
+C  DECAY   K0L  ---->   PI(+,-)  + E(-,+) + NEUTRINO
+        IF     ( RA .LE. CKA(27) ) THEN
+          CALL DECAY6( PAMA(10), PAMA(8),PAMA(2),0.D0,
+     *                 CKA(71),CKA(72),0.D0, CKA(73), 4 )
+          CALL RMMAR( RD,1,1 )
+C  CHARGE ASYMMETRY PREFERS FORMATION OF PI(-)
+          ICHARG = INT(1.5016 + RD(1))
+C  PI(+,-)  AND  E(-,+) / NEUTRINO IS DROPPED
+          DO 420  I = 1,2
+            CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
+     *                                  SECPAR(3),SECPAR(4) )
+            IF ( SECPAR(3) .GT. C(29) ) THEN
+              SECPAR(1) = 10 - 3*I - (2*I-3)*ICHARG
+              SECPAR(2) = GAM345(I)
+              CALL TSTACK
+            ENDIF
+  420     CONTINUE
+ 
+C  DECAY   K0L  ---->  PI(+,-)  + MU(-,+) + NEUTRINO
+        ELSEIF ( RA .LE. CKA(26) ) THEN
+          CALL DECAY6( PAMA(10), PAMA(8),PAMA(5),0.D0,
+     *                 CKA(74),CKA(75),0.D0, CKA(76), 3 )
+          CALL RMMAR( RD,1,1 )
+C  CHARGE ASYMMETRY PREFERS FORMATION OF PI(-)
+          ICHARG = INT(1.5016 + RD(1))
+C  PI(+,-)  AND  MU(-,+) / NEUTRINO IS DROPPED
+          DO 430  I = 1,2
+            CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
+     *                                  SECPAR(3),SECPAR(4) )
+            IF ( I .EQ. 1 ) THEN
+              SECPAR(1) = 7 + ICHARG
+              IPI = SECPAR(1)
+            ENDIF
+            IF ( SECPAR(3) .GT. C(29) ) THEN
+              SECPAR(2) = GAM345(I)
+              IF     ( I .EQ. 2 ) THEN
+                SECPAR(1) = 7 - ICHARG
+                IF ( SECPAR(1) .EQ. 6.D0 ) THEN
+C  INVERT POLARIZATION DIRECTION FOR MU(-)
+                  POLART = -POLART
+                  POLARF =  POLARF + PI
+                ENDIF
+C  GET THE POLARIZATION DIRECTION IN THE MU CM RELATIVE TO THE CORSIKA
+C  COORDINATE SYSTEM
+                CALL ADDANG( SECPAR(3),SECPAR(4), POLART,POLARF,
+     *                                               POLART,POLARF )
+                SECPAR(11) = POLART
+                SECPAR(12) = POLARF
+              ENDIF
+              CALL TSTACK
+            ENDIF
+            SECPAR(11) = 0.D0
+            SECPAR(12) = 0.D0
+  430     CONTINUE
+ 
+C  DECAY   K0L  ---->  PI(0) + PI(0) + PI(0)
+        ELSEIF ( RA .LE. CKA(25) ) THEN
+C  SEE: S.V. SOMALWAR ET AL., PHYS.REV.LET. 68(1992)2580
+          CALL DECAY6( PAMA(10), PAMA(7),PAMA(7),PAMA(7),
+     *                 CKA(59),-.00033D0,CKA(59), CKA(60), 1 )
+C  PI(0)'S
+          SECPAR(1) = 7.D0
+          DO 440  I = 1,3
+            CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
+     *                                  SECPAR(3),SECPAR(4) )
+            IF ( SECPAR(3) .GT. C(29) ) THEN
+              SECPAR(2) = GAM345(I)
+              CALL TSTACK
+            ENDIF
+  440     CONTINUE
+ 
+C  DECAY   K0L  ---->   PI(+) + PI(-) + PI(0)
+        ELSE
+          CALL DECAY6( PAMA(10), PAMA(8),PAMA(8),PAMA(7),
+     *                 CKA(61),CKA(62),CKA(63), CKA(64), 1 )
+C  PI(+)  AND  PI(-)  AND  PI(0)
+          DO 450  I = 1,3
+            CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
+     *                                  SECPAR(3),SECPAR(4) )
+            IF ( SECPAR(3) .GT. C(29) ) THEN
+              IF ( I .LE. 2 ) THEN
+                SECPAR(1) = 7 + I
+              ELSE
+                SECPAR(1) = 7.D0
+              ENDIF
+              SECPAR(2) = GAM345(I)
+              CALL TSTACK
+            ENDIF
+  450     CONTINUE
+ 
+        ENDIF
+      ENDIF
+ 
+C  KILL CURRENT PARTICLE
+      IRET1 = 1
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/leaddf.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/leaddf.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/leaddf.f	(revision 286)
@@ -0,0 +1,121 @@
+      SUBROUTINE LEADDF( IFLGLD )
+ 
+C-----------------------------------------------------------------------
+C  LEAD(ING PARTICLE RAPIDITY FOR) D(I)F(FFRACTING SYSTEM)
+C
+C  SELECTS THE RAPIDITY OF THE (ANTI)LEADING PARTICLES IN CASE OF
+C  DIFFRACTION. THE NON-DIFFRACTING (ANTI)LEADER GETS ITS RAPIDITY
+C  FROM THE REMAINDER ENERGY, THE DIFFRACTING (ANTI)LEADER GETS ITS
+C  RAPIDITY FROM THE GAUSSIAN (STRING) OF THE DECAYING DIFFRACTIVE MASS.
+C  THIS SUBROUTINE IS CALLED FROM HDPM
+C  ARGUMENT:
+C   IFLGLD = 0  RAPIDITY SELECTION SUCCESSFUL
+C          = 1  RAPIDITY SELECTION NOT SUCCESSFULL
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,INTER.
+      COMMON /INTER/   AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
+     *                 IDIF,ITAR
+      DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
+      INTEGER          IDIF,ITAR
+*KEEP,LEPAR.
+      COMMON /LEPAR/   LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
+      INTEGER          LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
+*KEEP,NEWPAR.
+      COMMON /NEWPAR/  EA,PT2,PX,PY,TMAS,YR,ITYP,
+     *                 IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
+     *                 IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
+      DOUBLE PRECISION EA(3000),PT2(3000),PX(3000),PY(3000),TMAS(3000),
+     *                 YR(3000)
+      INTEGER          ITYP(3000),
+     *                 IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
+     *                 IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'LEADDF: LEPAR1,LEPAR2=',
+     *                                      LEPAR1,LEPAR2
+ 
+      IF ( YY0 .GT. 0.D0 ) THEN
+C  PROJECTILE DIFFRACTION; CALCULATE TARGET RAPIDITY USING TARGET
+C  ENERGY ECMTAR AND LONGITUDINAL MOMENTUM PCMTAR THE IN C.M. SYSTEM
+        ECMTAR = (ECMDPM**2 - ECMDIF**2 + TMAS(2)**2) / (2.D0 * ECMDPM)
+        PTLSQ  = ECMTAR**2 - TMAS(2)**2
+        IF ( PTLSQ .LE. 0.D0 ) THEN
+          IFLGLD = 1
+          RETURN
+        ENDIF
+        PCMTAR = SQRT(PTLSQ)
+*       YR(2)  = -0.5D0 * LOG( (ECMTAR+PCMTAR) / (ECMTAR-PCMTAR) )
+        YR(2)  = - LOG( (ECMTAR+PCMTAR) / TMAS(2) )
+C  RAPIDITY OF DIFFRACTING PROJECTILE
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1) .GE. 0.5 ) THEN
+          YR(1) = RANNOR( POSC2, WIDC2 ) + YY0
+        ELSE
+          YR(1) = RANNOR(-POSC2, WIDC2 ) + YY0
+        ENDIF
+ 
+      ELSE
+C  TARGET DIFFRACTION; CALCULATE PROJECTILE RAPIDITY USING PROJECTILE
+C  ENERGY ECMPRO AND LONGITUDINAL MOMENTUM PLPRO IN THE C.M. SYSTEM
+        ECMPRO = (ECMDPM**2 -ECMDIF**2 +TMAS(1)**2) / (2.D0*ECMDPM)
+        PPLSQ  = ECMPRO**2 - TMAS(1)**2
+        IF ( PPLSQ .LE. 0.D0 ) THEN
+          IFLGLD = 1
+          RETURN
+        ENDIF
+        PCMPRO = SQRT(PPLSQ)
+*       YR(1)  = 0.5D0 * LOG( (ECMPRO+PCMPRO) / (ECMPRO-PCMPRO) )
+        YR(1)  = LOG( (ECMPRO+PCMPRO) / TMAS(1) )
+C  RAPIDITY OF DIFFRACTING TARGET NUCLEON
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1) .GE. 0.5 ) THEN
+          YR(2) = RANNOR( POSC2, WIDC2 ) + YY0
+        ELSE
+          YR(2) = RANNOR(-POSC2, WIDC2 ) + YY0
+        ENDIF
+      ENDIF
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'LEADDF: YR(2),YR(1)=',
+     *                           SNGL(YR(2)),SNGL(YR(1))
+      IFLGLD = 0
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ledeny.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ledeny.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ledeny.f	(revision 286)
@@ -0,0 +1,170 @@
+      SUBROUTINE LEDENY( LEDEFL )
+ 
+C-----------------------------------------------------------------------
+C  LE(A)D(ER'S) EN(ERG)Y
+C
+C  SELECTS THE FEYNMAN X OF THE ANTILEADING PARTICLES FROM A THEORETICAL
+C  DISTRIBUTION AND CALCULATES THE RAPIDITY FROM IT
+C  CALCULATE THE RAPIDITY OF THE LEADER FROM THE REMAINDER OF ENERGY
+C  THIS SUBROUTINE IS CALLED FROM HDPM
+C  ARGUMENT:
+C   LEDEFL = 0  CORRECT ENDING OF LEDENY
+C          = 1  NOT CORRECT ENDING OF LEDENY
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,INTER.
+      COMMON /INTER/   AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
+     *                 IDIF,ITAR
+      DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
+      INTEGER          IDIF,ITAR
+*KEEP,LEPAR.
+      COMMON /LEPAR/   LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
+      INTEGER          LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
+*KEEP,NEWPAR.
+      COMMON /NEWPAR/  EA,PT2,PX,PY,TMAS,YR,ITYP,
+     *                 IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
+     *                 IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
+      DOUBLE PRECISION EA(3000),PT2(3000),PX(3000),PY(3000),TMAS(3000),
+     *                 YR(3000)
+      INTEGER          ITYP(3000),
+     *                 IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
+     *                 IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,VKIN.
+      COMMON /VKIN/    BETACM
+      DOUBLE PRECISION BETACM
+*KEND.
+ 
+      DATA SL / 3.D0 /
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'LEDENY: ITYPE,ITAR=',ITYPE,ITAR
+ 
+C  BETACM IS AVAILABLE IN COMMON /VKIN/ BUT NOT FOR PHOTOPRODUCTION
+      IF ( ITYPE .EQ. 7 ) BETACM = SQRT( 1.D0 - 1.D0 / GCM**2 )
+ 
+C  MOMENTUM OF INCOMING TARGET IN CM SYSTEM
+      PNT = PAMA(ITAR) * GCM * BETACM
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'LEDENY: PNT=',SNGL(PNT)
+ 
+C  GET FEYNMAN X FOR ANTILEADER DEPENDING ON ENERGY
+C  DISCRIPTION OF THE FEYNMAN X DISTRIBUTION DEPENDING ON ENERGY
+C    DN/DXF = SL*XF                               0 < XF < X1
+C    DN/DXF = SL*X1                              X1 < XF < X2
+C    DN/DXF = SL*X1 * EXP(-AL*(XF-X2))           X2 < XF <  1
+ 
+      IF     ( ECMDPM .LT. 13.76D0 ) THEN
+        X1 = 0.20D0
+        X2 = 0.65D0
+        AL = 1.265D0
+      ELSEIF ( ECMDPM .LT. 5580.D0 ) THEN
+        X1 = 0.716D0   + 0.00543D0 * SMLOG
+        X2 = 0.8175D0  - 0.032D0   * SMLOG
+        AL = 1.14D0    + 0.022D0   * SMLOG
+      ELSE
+        X1 = 0.265D0
+        X2 = 0.265D0
+        AL = 1.14D0 + 0.022D0*SMLOG
+      ENDIF
+ 
+C  CALCULATE THE INTEGRALS OVER THE THREE PARTS OF THE FUNCTION
+      AA = 0.5D0 * SL * X1**2
+      BB = SL * X1 * (X2 - X1)
+      CC = SL * X1 / AL * ( 1.D0 - EXP( AL*(X2-1.D0) ) )
+C  NORMALIZE TO 1
+      TT = 1.D0 / (AA + BB + CC)
+      CC = CC * TT
+      AA = AA * TT
+      BB = BB * TT
+      AB = AA + BB
+ 
+      CALL RMMAR( RD,1,1 )
+C  GET XF FOR ANTILEADER
+        IF     ( RD(1) .LE. AA ) THEN
+          XF = SQRT( RD(1)*2.D0 / (SL*TT) )
+        ELSEIF ( RD(1) .LE. AB ) THEN
+          XF = (RD(1)-AA) / (SL*X1*TT) + X1
+        ELSE
+          XF = X2 - LOG( 1.D0 - (RD(1)-AB)*AL/(SL*X1*TT) ) / AL
+        ENDIF
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'LEDENY: XF(TARGET)=',SNGL(XF)
+ 
+C  CONVERT FEYNMAN X INTO RAPIDITY FOR ANTILEADER
+      PLAL  = PNT * XF * PAMA(LEPAR2) / PAMA(ITAR)
+      EA(2) = SQRT(PLAL**2 + TMAS(2)**2)
+*     YR(2) = -0.5D0 * LOG( (EA(2)+PLAL)/(EA(2)-PLAL) )
+      YR(2) = - LOG( (EA(2)+PLAL)/TMAS(2) )
+ 
+C  CALCULATE THE REMAINDER OF ENERGY AND LONG. MOMENTUM OF LEADER
+C  THIS HOLDS ALSO FOR MULTIPLE COLLISIONS (GNU > 1)
+      ESUM  = 0.D0
+      DO 10  I = 2,NTOT
+        EA(I) = TMAS(I) * COSH( YR(I) + YCM )
+        ESUM  = ESUM + EA(I)
+  10  CONTINUE
+      EA(1) = ELAB + PAMA(ITAR) - ESUM
+      IF ( EA(1) .LE. TMAS(1) ) THEN
+        LEDEFL = 1
+        RETURN
+      ENDIF
+      PLLBSQ = EA(1)**2 - TMAS(1)**2
+      PLLB   = SQRT( PLLBSQ )
+*     YR(1)  = 0.5D0 * LOG( (EA(1) + PLLB) / (EA(1) - PLLB) ) - YCM
+      YR(1)  = LOG( (EA(1) + PLLB) / TMAS(1) ) - YCM
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'LEDENY: EA(1),YR(2),YR(1)=',
+     *                     SNGL(EA(1)),SNGL(YR(2)),SNGL(YR(1))
+      LEDEFL = 0
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/lepacx.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/lepacx.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/lepacx.f	(revision 286)
@@ -0,0 +1,390 @@
+      SUBROUTINE LEPACX( ECMCE,SDMLOG,LEPART,IPART )
+ 
+C-----------------------------------------------------------------------
+C  LE(ADING) PA(RTICLE) C(HARGE) (E)X(CHANGE)
+C
+C  CONSIDERS CHARGE EXCHANGE POSSIBILITY OF (ANTI)LEADING PARTICLE
+C  CONSIDERS RESONANCE EXCITATION WITHOUT/WITH CHARGE EXCHANGE
+C  LASTPI INCREASED: CREATE ONE CHARGED PION FOR CHARGE CONSERVATION
+C  LASTPI UNCHANGED: NO CHARGE EXCHANGE
+C  LASTPI DECREASED: CANCEL ONE CHARGED PION FOR CHARGE CONSERVATION
+C  NRESPC INCRESAED BY 1, IF PI(+-) WILL BE GENERATED BY RESON. DECAY
+C  NRESPN INCRESAED BY 1, IF PI(0)  WILL BE GENERATED BY RESON. DECAY
+C  NCPLUS INCREASED BY 1, IF POSITIVE CHARGE IS CREATED
+C  NCPLUS DECREASED BY 1, IF NEGATIVE CHARGE IS CREATED
+C  THIS SUBROUTINE IS CALLED FROM HDPM
+C  ARGUMENTS:
+C   ECMCE  = ENERGY FOR CHARGE EXCHANGE (ECMDPM OR ECMDIF)
+C   SDMLOG = ELABLG FOR NSD, DMLOG FOR DIFFRACTION
+C   LEPART = PARTICLE CODE OF (ANTI)LEADER EXCHANGING CHARGE
+C   IPART  = PARTICLE NUMBER IN ARRAY OF SECONDARY PARTICLES
+C          = 1  FOR LEADER, = 2  FOR ANTI-LEADER
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,LEPAR.
+      COMMON /LEPAR/   LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
+      INTEGER          LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RESON.
+      COMMON /RESON/   RDRES,RESRAN,IRESPAR
+      REAL             RDRES(2),RESRAN(1000)
+      INTEGER          IRESPAR
+ 
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'LEPACX: LEPART=',LEPART
+ 
+C  SET PROBABILITIES FOR RESONANCE PRODUCTION (PRESPR) AND FOR
+C     CHARGE EXCHANGE OR RESONANCE PRODUCTION (PCEXRS)
+      IF     ( ECMCE .LE.  19.4D0 ) THEN
+        PCEXRS = 0.45D0
+        PRESPR = 0.35D0
+      ELSEIF ( ECMCE .LT. 968.5D0 ) THEN
+        PCEXRS = 0.45D0 + 0.034509D0 * (SDMLOG - 5.29832D0)
+        PRESPR = 0.0881897D0 * (SDMLOG - 5.29832D0)
+      ELSE
+        PCEXRS = 0.72D0
+        PRESPR = 0.69D0
+      ENDIF
+      PRESPR   = MAX( 0.35D0, PRESPR )
+      IF ( LEPART .EQ. 7 ) THEN
+C  ASSUME 50% CHARGE EXCHANGE FOR GAMMA INITIATED INTERACTION
+        PCEXRS = 0.5D0
+        PRESPR = 0.D0
+      ENDIF
+ 
+C  THROW RANDOM NUMBER TO LOOK FOR RES. PRODUCTION OR CHARGE EXCHANGE
+      CALL RMMAR( RD,2,1 )
+ 
+C  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  RESONANCE IS FORMED. IF ADDITIONAL CHARGE EXCHANGE, THEN SET LASTPI
+      IF     ( RD(1) .LE. PRESPR ) THEN
+ 
+C  FIRST FOR NUCLEONS (AS MOST FREQUENT)
+        IF     ( LEPART .EQ. 13 ) THEN
+          IF     ( RD(2) .LE. 0.5 ) THEN
+C  NEUTRON ---->  DELTA(-)
+            LEPART = 57
+            NRESPC = NRESPC + 1
+            NCPLUS = NCPLUS - 1
+          ELSEIF ( RD(2) .GT. TB3 ) THEN
+C  NEUTRON ---->  DELTA(0)
+            LEPART = 56
+            CALL RMMAR( RDRES(IPART),1,1 )
+            IF ( RDRES(IPART) .LE. TB3 ) THEN
+              NRESPN = NRESPN + 1
+            ELSE
+              NRESPC = NRESPC + 1
+              LASTPI = LASTPI - 1
+            ENDIF
+          ELSE
+C  NEUTRON ---->  DELTA(+)
+            LEPART = 55
+            CALL RMMAR( RDRES(IPART),1,1 )
+            IF ( RDRES(IPART) .LE. TB3 ) THEN
+              NRESPN = NRESPN + 1
+              LASTPI = LASTPI - 1
+            ELSE
+              NRESPC = NRESPC + 1
+            ENDIF
+            NCPLUS = NCPLUS + 1
+          ENDIF
+        ELSEIF ( LEPART .EQ. 14 ) THEN
+          IF     ( RD(2) .LE. 0.5 ) THEN
+C  PROTON ---->  DELTA(++)
+            LEPART = 54
+            NRESPC = NRESPC + 1
+            NCPLUS = NCPLUS + 1
+          ELSEIF ( RD(2) .GT. TB3 ) THEN
+C  PROTON  ---->  DELTA(+)
+            LEPART = 55
+            CALL RMMAR( RDRES(IPART),1,1 )
+            IF ( RDRES(IPART) .LE. TB3 ) THEN
+              NRESPN = NRESPN + 1
+            ELSE
+              NRESPC = NRESPC + 1
+              LASTPI = LASTPI + 1
+            ENDIF
+          ELSE
+C  PROTON ---->  DELTA(0)
+            LEPART = 56
+            CALL RMMAR( RDRES(IPART),1,1 )
+            IF ( RDRES(IPART) .LE. TB3 ) THEN
+              NRESPN = NRESPN + 1
+              LASTPI = LASTPI + 1
+            ELSE
+              NRESPC = NRESPC + 1
+            ENDIF
+            NCPLUS = NCPLUS - 1
+          ENDIF
+ 
+C  NOW FOR PIONS
+        ELSEIF ( LEPART .EQ. 8  .OR.  LEPART .EQ. 9 ) THEN
+          IF ( RD(2) .LE. 0.5 ) THEN
+C  PI(+-)   ----> RHO(+-)
+            LEPART = LEPART + 44
+            NRESPN = NRESPN + 1
+          ELSE
+C  PI(+-)   ----> RHO(0)  ( ----> PI(+) + PI(-) )
+            NCPLUS = NCPLUS + 2 * LEPART - 17
+            LEPART = 51
+            NRESPC = NRESPC + 1
+          ENDIF
+ 
+C  NOW FOR KAONS
+        ELSEIF ( LEPART .EQ. 11  .OR.  LEPART .EQ. 12 ) THEN
+          IF ( RD(2) .LE. 0.5 ) THEN
+C  K(+-)   ----> K*(+-)
+            LEPART = LEPART + 52
+            CALL RMMAR( RDRES(IPART),1,1 )
+            IF ( RDRES(IPART) .LE. TB3 ) THEN
+              NRESPN = NRESPN + 1
+            ELSE
+              NRESPC = NRESPC + 1
+              LASTPI = LASTPI + 1
+            ENDIF
+          ELSE
+C  K(+)   ---->      K*(0)
+C  K(-)   ----> ANTI-K*(0)
+            CALL RMMAR( RDRES(IPART),1,1 )
+            NCPLUS = NCPLUS + 2 * LEPART - 23
+            IF ( RDRES(IPART) .LE. TB3 ) THEN
+              NRESPC = NRESPC + 1
+            ELSE
+              NRESPN = NRESPN + 1
+              LASTPI = LASTPI + 1
+            ENDIF
+            LEPART = 3*LEPART + 29
+          ENDIF
+        ELSEIF ( LEPART .EQ. 10  .OR.  LEPART .EQ. 16 ) THEN
+          IF ( RD(2) .LE. 0.5 ) THEN
+C  K(0)   ----> (ANTI) K*(0)
+            CALL RMMAR( RD,1,1 )
+            IF ( RD(1) .LE. 0.5 ) THEN
+              LEPART = 62
+            ELSE
+              LEPART = 65
+            ENDIF
+            CALL RMMAR( RDRES(IPART),1,1 )
+            IF ( RDRES(IPART) .LE. TB3 ) THEN
+              NRESPC = NRESPC + 1
+              LASTPI = LASTPI - 1
+            ELSE
+              NRESPN = NRESPN + 1
+            ENDIF
+          ELSE
+C  K(0)   ----> K*(+-)
+            CALL RMMAR( RD,1,1 )
+            IF ( RD(1) .LE. 0.5 ) THEN
+              LEPART = 63
+              NCPLUS = NCPLUS + 1
+            ELSE
+              LEPART = 64
+              NCPLUS = NCPLUS - 1
+            ENDIF
+            CALL RMMAR( RDRES(IPART),1,1 )
+            IF ( RDRES(IPART) .LE. TB3 ) THEN
+              NRESPN = NRESPN + 1
+              LASTPI = LASTPI - 1
+            ELSE
+              NRESPC = NRESPC + 1
+            ENDIF
+          ENDIF
+ 
+C  NOW FOR ANTINUCLEONS
+        ELSEIF ( LEPART .EQ. 25 ) THEN
+          IF     ( RD(2) .LE. 0.5 ) THEN
+C  ANTINEUTRON ---->  ANTI-DELTA(0)
+            LEPART = 60
+            CALL RMMAR( RDRES(IPART),1,1 )
+            IF ( RDRES(IPART) .LE. TB3 ) THEN
+              NRESPN = NRESPN + 1
+            ELSE
+              NRESPC = NRESPC + 1
+              LASTPI = LASTPI - 1
+            ENDIF
+          ELSEIF ( RD(2) .GT. TB3 ) THEN
+C  ANTINEUTRON ---->  ANTI-DELTA(+)
+            LEPART = 61
+            NRESPC = NRESPC + 1
+            NCPLUS = NCPLUS + 1
+          ELSE
+C  ANTINEUTRON ---->  ANTI-DELTA(-)
+            LEPART = 59
+            CALL RMMAR( RDRES(IPART),1,1 )
+            IF ( RDRES(IPART) .LE. TB3 ) THEN
+              NRESPN = NRESPN + 1
+              LASTPI = LASTPI - 1
+            ELSE
+              NRESPC = NRESPC + 1
+            ENDIF
+            NCPLUS = NCPLUS - 1
+          ENDIF
+        ELSEIF ( LEPART .EQ. 15 ) THEN
+          IF     ( RD(2) .LE. 0.5 ) THEN
+C  ANTIPROTON  ---->  ANTI-DELTA(--)
+            LEPART = 58
+            NRESPC = NRESPC + 1
+            NCPLUS = NCPLUS - 1
+          ELSEIF ( RD(2) .GT. TB3 ) THEN
+C  ANTIPROTON  ---->  ANTI-DELTA(-)
+            LEPART = 59
+            CALL RMMAR( RDRES(IPART),1,1 )
+            IF ( RDRES(IPART) .LE. TB3 ) THEN
+              NRESPN = NRESPN + 1
+            ELSE
+              NRESPC = NRESPC + 1
+              LASTPI = LASTPI + 1
+            ENDIF
+          ELSE
+C  ANTIPROTON  ---->  ANTI-DELTA(0)
+            LEPART = 60
+            CALL RMMAR( RDRES(IPART),1,1 )
+            IF ( RDRES(IPART) .LE. TB3 ) THEN
+              NRESPN = NRESPN + 1
+              LASTPI = LASTPI + 1
+            ELSE
+              NRESPC = NRESPC + 1
+            ENDIF
+            NCPLUS = NCPLUS + 1
+          ENDIF
+ 
+        ELSEIF ( LEPART .EQ. 7 ) THEN
+C  NO RESONANCE FORMATION FOR INDUCING GAMMA RADIATION
+          IF ( DEBUG ) WRITE(MDEBUG,*) 'LEPACX: NO EXCHANGE'
+ 
+        ELSEIF ( (LEPART .GE. 18  .AND.  LEPART .LE. 24)  .OR.
+     *           (LEPART .GE. 26  .AND.  LEPART .LE. 32) ) THEN
+C  NO RESONANCE FORMATION FOR STRANGE BARYONS
+          IF ( DEBUG ) WRITE(MDEBUG,*) 'LEPACX: NO EXCHANGE'
+ 
+        ELSE
+          WRITE(MONIOU,100) LEPART
+ 100      FORMAT(1H ,'LEPACX: UNIDENTIFIED PARTICLE CODE= ',I4,
+     *           ' FOR RESONANCE FORMATION')
+        ENDIF
+        IF ( DEBUG ) WRITE(MDEBUG,102)
+     *                        LEPART,LASTPI,NRESPC,NRESPN,NCPLUS
+ 102    FORMAT(' LEPACX: LEPART,LASTPI,NRESPC,NRESPN,NCPLUS=',5I5)
+ 
+C  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  CHARGE EXCHANGE WITHOUT RESONANCE FORMATION
+      ELSEIF ( RD(1) .LE. PCEXRS ) THEN
+ 
+C  FIRST FOR NUCLEONS (AS MOST FREQUENT)
+        IF     ( LEPART .EQ. 13 ) THEN
+C  NEUTRON ( + PI(+) ) ---->  PROTON  ( + PI(0) )
+          LEPART = 14
+          LASTPI = LASTPI - 1
+          NCPLUS = NCPLUS + 1
+        ELSEIF ( LEPART .EQ. 14 ) THEN
+C  PROTON  ( + PI(0) ) ---->  NEUTRON ( + PI(+) )
+          LEPART = 13
+          LASTPI = LASTPI + 1
+          NCPLUS = NCPLUS - 1
+ 
+C  NOW FOR PIONS
+        ELSEIF ( LEPART .EQ. 8  .OR.  LEPART .EQ. 9 ) THEN
+C  PI(+-)  ----> PI(0)
+          NCPLUS = NCPLUS + 2 * LEPART - 17
+          LEPART = 7
+          LASTPI = LASTPI + 1
+ 
+C  NOW FOR KAONS
+        ELSEIF ( LEPART .EQ. 11  .OR.  LEPART .EQ. 12 ) THEN
+C  K(+-)  ----> K(0)  (S OR L)
+          NCPLUS = NCPLUS + 2 * LEPART - 23
+          IF ( RD(2) .LE. 0.5 ) THEN
+            LEPART = 10
+          ELSE
+            LEPART = 16
+          ENDIF
+          LASTPI = LASTPI + 1
+        ELSEIF ( LEPART .EQ. 10  .OR.  LEPART .EQ. 16 ) THEN
+C  K(0)  ----> K(+-)
+          IF ( RD(2) .LE. 0.5 ) THEN
+            LEPART = 11
+            NCPLUS = NCPLUS + 1
+          ELSE
+            LEPART = 12
+            NCPLUS = NCPLUS - 1
+          ENDIF
+          LASTPI = LASTPI - 1
+ 
+C  NOW FOR ANTINUCLEONS
+        ELSEIF ( LEPART .EQ. 25 ) THEN
+C  ANTINEUTRON ( + PI(-) ) ---->  ANTIPROTON  ( + PI(0) )
+          LEPART = 15
+          LASTPI = LASTPI - 1
+          NCPLUS = NCPLUS - 1
+        ELSEIF ( LEPART .EQ. 15 ) THEN
+C  ANTIPROTON  ( + PI(0) ) ---->  ANTINEUTRON ( + PI(-) )
+          LEPART = 25
+          LASTPI = LASTPI + 1
+          NCPLUS = NCPLUS + 1
+ 
+C  NOW FOR GAMMA INDUCED REACTIONS (ITYPE=7)
+        ELSEIF ( LEPART .EQ. 7 ) THEN
+C  TEST IF CHARGE EXCHANGE REACTION FOR PI(0)
+C  PI(0)  ---->  PI(+-)
+          IF ( RD(2) .LE. 0.5 ) THEN
+            LEPART = 8
+            NCPLUS = NCPLUS + 1
+          ELSE
+            LEPART = 9
+            NCPLUS = NCPLUS - 1
+          ENDIF
+          LASTPI = LASTPI - 1
+ 
+        ELSEIF ( (LEPART .GE. 18  .AND.  LEPART .LE. 24)  .OR.
+     *           (LEPART .GE. 26  .AND.  LEPART .LE. 32) ) THEN
+C  NO CHARGE EXCHANGE FOR STRANGE BARYONS
+          IF ( DEBUG ) WRITE(MDEBUG,*) 'LEPACX: NO EXCHANGE'
+ 
+        ELSE
+          WRITE(MONIOU,101) LEPART
+ 101      FORMAT(1H ,'LEPACX: UNIDENTIFIED PARTICLE CODE= ',I4,
+     *           ' FOR CHARGE EXCHANGE')
+        ENDIF
+        IF ( DEBUG ) WRITE(MDEBUG,*) 'LEPACX: LEPART,LASTPI,NCPLUS=',
+     *                                        LEPART,LASTPI,NCPLUS
+      ELSE
+        IF ( DEBUG ) WRITE(MDEBUG,*) 'LEPACX: NO EXCHANGE'
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/longft.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/longft.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/longft.f	(revision 286)
@@ -0,0 +1,152 @@
+      SUBROUTINE LONGFT(FPARAM,CHI2)
+ 
+C-----------------------------------------------------------------------
+C  LONG(ITUDINAL) F(I)T
+C
+C  THIS ROUTINE PERFORMS A FIT TO THE LONGITUDINAL DISTRIBUTION OF AN
+C  AIR SHOWER. DUE TO THE LARGE PARTICLE NUMBERS IN AN AIR SHOWER THE
+C  STATISTICAL ERRORS ON THE PARTICLE NUMBER AT A GIVEN LEVEL ARE
+C  MINUTE. THIS LEADS TO RATHER LARGE CHI**2/DOF FOR THE FITS EVEN IF
+C  THE FITTED FUNCTION MATCHES THE POINTS BETTER THAN SAY 1%.
+C  KEEP IN MIND THAT FITTING IS A DIFFICULT TASK AND THE RESULTS DO NOT
+C  NECESSARILY REPRESENT THE ABOLUTE MINIMUM OR EVEN A GOOD
+C  APPROXIMATION.
+C
+C  TRY A 6 PARAMETER FIT BASED ON J. BALL'S PROPOSED CURVE REPLACING HIS
+C  CONSTANT WIDTH PARAMETER LAMBDA BY A POLYNOMIAL OF 3. DEGREE.
+C   N(T) = NMAX * ((T-T0)/(TMAX-T0))**((TMAX-T)/(P1+P2*T+P3*T**2))
+C   T    = DEPTH IN G/CM**2
+C   T0   = STARTING DEPTH OF SHOWER
+C   TMAX = DEPTH OF SHOWER MAXIMUM
+C   NMAX = PARTICLE NUMBER AT TMAX
+C   P1 .. P3 = PARAMETERS OF A POLYNOMIAL DESCRIBING THE WIDTH
+C
+C  THIS SUBROUTINE IS CALLED FROM MAIN
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CURVE.
+      COMMON /CURVE/   CHAPAR,DEP,ERR,NSTP
+      DOUBLE PRECISION CHAPAR(1100),DEP(1100),ERR(1100)
+      INTEGER          NSTP
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      INTEGER NPAR
+      PARAMETER (NPAR=6)
+      DOUBLE PRECISION F(NPAR),FPARAM(NPAR),CHI2,CHISQ
+      DOUBLE PRECISION P(NPAR+1,NPAR),Y(NPAR+1),EPS
+      DOUBLE PRECISION T0,TMAX,NMAX,FAC
+      INTEGER          I,J,JJ,K,ITER,IFLAG
+      EXTERNAL         CHISQ
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'LONGFT:'
+ 
+C  FIND GOOD START VALUES FOR XMAX AND FMAX
+      NMAX = 0.D0
+      DO 2 I = 1,NSTP
+        ERR(I) = MAX( 1.D0, SQRT(CHAPAR(I)) )
+        IF ( CHAPAR(I) .GT. NMAX ) THEN
+          NMAX = CHAPAR(I)
+          TMAX = DEP(I)
+        ENDIF
+ 2    CONTINUE
+C  STARTVALUE FOR X0 IS ABOUT WHERE MORE THAN 1 PARTICLE SHOWS UP
+      DO 3 I = 1,NSTP
+        IF ( CHAPAR(I) .GT. 1.D0 ) GOTO 1
+ 3    CONTINUE
+      I = NSTP
+ 1    CONTINUE
+      T0 = DEP(I)
+ 
+C-----------------------------------------------------------------------
+C  FIT IS PERFORMED WITH THE ROUTINE AMOEBA FROM:
+C      NUMERICAL RECIPES, W.H. PRESS ET AL.,
+C      CAMBRIDGE UNIVERSITY PRESS, 1992  ISBN 0 521 43064 X
+C  SEE THERE HOW IT HAS TO BE USED.
+ 
+C  CREATE A SET OF NPAR+1 STARTING VERTICES
+C  HERE IS THE FIRST ONE
+      P(1,1) = NMAX
+      P(1,2) = T0
+      P(1,3) = TMAX
+      P(1,4) = 200.D0
+      P(1,5) = 1.D-1
+      P(1,6) = 1.D-1
+ 
+C  LOOP OVER THE FITTING ROUTINE (2 TIMES 5 FITS WITH VARYING PRECISION)
+      DO 10 J = 1,2
+        DO 9 JJ = 1,5
+C  START WITH CRUDE PRECISION AND IMPROVE STEP BY STEP
+C  AFTER FIVE STEPS ENLARGE AGAIN
+          EPS = 10.D0**(-3.D0-JJ*0.5D0)
+          FAC = 1.D0 + 2.D0**(2.1D0*(1.D0-JJ))
+C  GO AS WELL IN DIFFERENT DIRECTIONS
+          IF ( J .EQ. 2 ) FAC = 1.D0/FAC
+ 
+C  GET OTHER NPAR STARTING VERTICES FROM THE STARTING POINT BY VARIATION
+C  OF ONLY ONE OF THE COORDINATE VALUES
+          DO 5 I = 2,NPAR+1
+            DO 4 K = 1,NPAR
+              P(I,K) = P(1,K)
+ 4          CONTINUE
+            IF ( P(I,I-1) .EQ. 0.D0 ) THEN
+              P(I,I-1) = 1.D0
+            ELSE
+              P(I,I-1) = P(I,I-1) * FAC
+            ENDIF
+ 5        CONTINUE
+          IF (DEBUG) WRITE(MDEBUG,*) 'LONGFT: TRIAL,FAC,EPS ',J,
+     *                                   SNGL(FAC),SNGL(EPS)
+ 
+C  CALCULATE FUNCTION VALUES AT THE START VERTICES
+          DO 7 I = 1,NPAR+1
+            DO 6 K = 1,NPAR
+              F(K) = P(I,K)
+ 6          CONTINUE
+            Y(I) = CHISQ(F)
+ 7        CONTINUE
+C  PERFORM A FIT
+          CALL AMOEBA(P,Y,NPAR+1,NPAR,NPAR,EPS,CHISQ,ITER,IFLAG)
+          IF ( DEBUG ) THEN
+            WRITE(MDEBUG,*) 'LONGFT: ITER/IFLAG=',ITER,IFLAG
+            WRITE(MDEBUG,*) 'LONGFT: PARAMETERS=',1,(P(1,K),K=1,6)
+            WRITE(MDEBUG,*) 'LONGFT: CHISQ     =',SNGL(Y(1))
+          ENDIF
+ 
+C  STORE VALUES AT FIRST TRIAL OR AT IMPROVED RESULT
+          IF ( J .EQ. 1 .OR. Y(1) .LT. CHI2 ) THEN
+            DO 8 I = 1,NPAR
+              FPARAM(I) = P(1,I)
+ 8          CONTINUE
+            CHI2 = Y(1)
+          ENDIF
+C  END OF LOOPS OVER THE FITTING ROUTINE
+ 9      CONTINUE
+ 10   CONTINUE
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/lowup.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/lowup.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/lowup.f	(revision 286)
@@ -0,0 +1,70 @@
+      SUBROUTINE LOWUP(CHAR)
+ 
+C-----------------------------------------------------------------------
+C  (CONVERTS) LOW(ER CASE CHARACTER TO) UP(PPER CASE CHARACTER)
+C
+C  THIS SUBROUTINE IS CALLED FROM DATAC
+C  ARGUMENT :
+C   CHAR    =  CHARACTER TO BE CONVERTED
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+      CHARACTER*1 CHAR
+C-----------------------------------------------------------------------
+ 
+      IF     ( CHAR .EQ. 'a' ) THEN
+        CHAR='A'
+      ELSEIF ( CHAR .EQ. 'b' ) THEN
+        CHAR='B'
+      ELSEIF ( CHAR .EQ. 'c' ) THEN
+        CHAR='C'
+      ELSEIF ( CHAR .EQ. 'd' ) THEN
+        CHAR='D'
+      ELSEIF ( CHAR .EQ. 'e' ) THEN
+        CHAR='E'
+      ELSEIF ( CHAR .EQ. 'f' ) THEN
+        CHAR='F'
+      ELSEIF ( CHAR .EQ. 'g' ) THEN
+        CHAR='G'
+      ELSEIF ( CHAR .EQ. 'h' ) THEN
+        CHAR='H'
+      ELSEIF ( CHAR .EQ. 'i' ) THEN
+        CHAR='I'
+      ELSEIF ( CHAR .EQ. 'j' ) THEN
+        CHAR='J'
+      ELSEIF ( CHAR .EQ. 'k' ) THEN
+        CHAR='K'
+      ELSEIF ( CHAR .EQ. 'l' ) THEN
+        CHAR='L'
+      ELSEIF ( CHAR .EQ. 'm' ) THEN
+        CHAR='M'
+      ELSEIF ( CHAR .EQ. 'n' ) THEN
+        CHAR='N'
+      ELSEIF ( CHAR .EQ. 'o' ) THEN
+        CHAR='O'
+      ELSEIF ( CHAR .EQ. 'p' ) THEN
+        CHAR='P'
+      ELSEIF ( CHAR .EQ. 'q' ) THEN
+        CHAR='Q'
+      ELSEIF ( CHAR .EQ. 'r' ) THEN
+        CHAR='R'
+      ELSEIF ( CHAR .EQ. 's' ) THEN
+        CHAR='S'
+      ELSEIF ( CHAR .EQ. 't' ) THEN
+        CHAR='T'
+      ELSEIF ( CHAR .EQ. 'u' ) THEN
+        CHAR='U'
+      ELSEIF ( CHAR .EQ. 'v' ) THEN
+        CHAR='V'
+      ELSEIF ( CHAR .EQ. 'w' ) THEN
+        CHAR='W'
+      ELSEIF ( CHAR .EQ. 'x' ) THEN
+        CHAR='X'
+      ELSEIF ( CHAR .EQ. 'y' ) THEN
+        CHAR='Y'
+      ELSEIF ( CHAR .EQ. 'z' ) THEN
+        CHAR='Z'
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/lpm.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/lpm.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/lpm.f	(revision 286)
@@ -0,0 +1,71 @@
+      SUBROUTINE LPM(ENER)
+ 
+C------------------------------------------------------------------------
+C  L(ANDAU) P(OMAEANCHUK) M(IGDAL)
+C  TREATS ELECTROMAGNETIC PARTICLES WITH ENERGIES ABOVE 1.*10**16 EV
+C  THIS SUBROUTINE IS CALLED FROM EM
+C  ARGUMENT:
+C   ENER      = ENERGY OF EM PARTICLE
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION ENER
+      INTEGER          I
+C-----------------------------------------------------------------------
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' LPM   : CURPAR=',1P,9E10.3)
+ 
+      IF ( ENER .GT. 1.D7 ) THEN
+        WRITE(MONIOU,*)
+     *    'LPM   : ENERGY OF EM-PARTICLE = ',SNGL(ENER),' TOO HIGH'
+        WRITE(MONIOU,*)'LPM   : LANDAU-POMERANCHUK-MIGDAL ROUTINES ',
+     *               'NOT YET AVAILABLE, PROGRAM STOPPED'
+        STOP
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/magic-mc.daemon.tpl
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/magic-mc.daemon.tpl	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/magic-mc.daemon.tpl	(revision 286)
@@ -0,0 +1,533 @@
+#!/usr/local/bin/perl -w
+#############################################################
+# JOBS-MC.daemon v. 0.01
+# Copyright (c) J C Gonzalez, 1998 - All rights reserved
+#------------------------------------------------------------
+# Perl script for running automatically the MC generation
+# program.
+#############################################################
+#
+
+use strict;
+use vars qw(
+            $VERSION $PROGRAM $SYSDIR $COPYRIGHT $USER $EXECCOR
+            $uptime $DISK $MOTHERDIR $NICE $TOP $TEL
+            $MINN $SITE
+            $Spectral_Index
+            @energies @energies2
+            @nshowers
+            @primaries
+            @Theta
+            @Phi
+            $Energy1 $Energy2
+            $Primary
+            $Set
+            $MACH_CRITICAL
+            $MACH_BAD     
+            $MACH_GOOD    
+            $MACH_VERYGOOD
+            $MAXDISK $MAXTAPE
+            $verbose      
+            $debug        
+            $minfree      
+            $cpu
+            $cpumsg
+            $icpu
+            );
+use Carp;
+
+require 5.001;
+
+$TEL = 'MAGIC';
+
+$PROGRAM = "$TEL-MC.DAEMON";
+$COPYRIGHT = 'Copyright (c) J C Gonzalez, 1998 - All rights reserved';
+$VERSION = '0.01';
+$USER = '#USERADD#';
+$DISK = '#DATADISK#';
+$SYSDIR = '#ADMDISK#';
+$MOTHERDIR = '#PATHEXE#';
+$EXECCOR = '#NAMEEXE#';
+$NICE = '#NICE#';
+$SITE = '#SITE#';
+$TOP = '/usr/local/bin/top';
+
+# parameters 
+
+# Note: each CORSIKA run launched from this script will generate
+#       [nshowers] showers in the energy bin [energies:energies2], 
+#       with a **differential** spectral index [Spectral_Index].
+#       The range in angles are given in @Theta and @Phi
+
+$Spectral_Index = -1.5;         # spectral index ( **differential** )
+@energies = qw ( 30 );           # lower limits in energy bins
+@energies2 = qw ( 30000 );      # corresponding upper limits
+@nshowers = qw ( 1000 );           # number of showers to generate
+@primaries = ( 1 );             # primaries (GEANT codes)
+@Theta = qw ( 5. 25. );         # Theta range
+@Phi = qw ( 0. 360. );          # Phi range
+
+$MINN = {};                     # minimum number of showers for energy
+
+# currently we use the MACH factor to see how loaded is
+# the machine. It goes from 0 to 1, 0 is dead, 1 is free
+
+$MACH_CRITICAL = 0.0;       # critical 
+$MACH_BAD      = 0.2;       # bad
+$MACH_GOOD     = 0.4;       # good
+$MACH_VERYGOOD = 0.9;       # verygood
+
+# maximum disk and tape space allowed
+$MAXDISK = (10 * 1024 * 1024);  # max. disk
+$MAXTAPE = (6 * 1024 * 1024);   # max. space
+    
+# some flags (some of them not yet used)
+$verbose = 1;           # verbose output flag
+$debug = 0;         # debugging flag
+$minfree = 1;           # minimum number of free jobs
+$uptime = 0;
+$cpumsg = '';
+
+###
+# subroutines
+###
+
+# presentation
+sub hello {
+    print <<"_eom_" if ( $verbose );
+============================================================
+$PROGRAM version $VERSION
+$COPYRIGHT
+============================================================
+
+_eom_
+}
+
+# initialize
+sub init {
+    my (@line,$df,$e,$p,$msg,$l);
+
+    for ($l=0; $l<=$#energies; $l++) {
+        $$MINN{$energies[$l]} = $nshowers[$l];
+    }
+    
+    $msg = "";
+    if (! -f "$SYSDIR/last-primary") {
+        system("echo $#primaries > $SYSDIR/last-primary");
+        $msg .= "\n\t\tlast-primary file initialized.";
+    }
+    if (! -f "$SYSDIR/last-energy") {
+        system("echo $#energies > $SYSDIR/last-energy");
+        $msg .= "\n\t\tlast-energy file initialized.";
+    }                           
+    if (! -f "$SYSDIR/disk-space") {
+        system("echo $MAXDISK > $SYSDIR/disk-space") == 0
+            or croak "Cannot write $SYSDIR/disk-space";
+        $msg .= "\n\t\tdisk-space file initialized.";
+    }
+    if (! -f "$SYSDIR/tape-space") {
+        system("echo $MAXTAPE > $SYSDIR/tape-space") == 0
+            or croak "Cannot write $SYSDIR/tape-space";
+        $msg .= "\n\t\ttape-space file initialized.";
+        $msg .= "\n\t\tA new tape for disk $DISK is required.";
+    }
+    if (! -f "$SYSDIR/last-sets") {
+        open(FILESETS,"> $SYSDIR/last-sets") 
+            or croak "Cannot open file $SYSDIR/last-sets";
+        foreach $p (@primaries) {
+            foreach $e (@energies) {
+                $l = $p . "-" . $e . "  0\n";
+                print FILESETS $l;
+            }
+        } 
+        close(FILESETS);
+        $msg .= "\n\t\tlast-sets file initialized.";
+    }       
+    send_mail("System Initialization Procedure:" . $msg, 0) 
+        if ($msg ne "");
+}
+
+# clear the system
+sub sys_clear {
+    exit system('yes | rm -r ' . 
+                $SYSDIR . '/last-* ' . 
+                $SYSDIR . '/*space ' . 
+                $SYSDIR . '/to-save ');
+}
+
+# get options for the program
+sub get_options {
+    my ($op);
+    foreach $op ( @ARGV ) { 
+        shift;
+        last if ($op =~ /^--$/);
+        if ($op =~ /^-q/) { $verbose = 0 }
+        if ($op =~ /^-D/) { $debug = 1 }
+        if ($op =~ /^-u/) { $uptime = 1 }
+        if ($op =~ /^-n(.*)/) { $NICE = $1 }
+        if ($op =~ /^-t(.*):(.*)/) { @Theta = ( $1, $2, );}
+        if ($op =~ /^-p(.*):(.*)/) { @Phi = ( $1, $2, );}
+        if ($op =~ /^-c/) { &sys_clear }
+    }
+    1;
+}
+
+# get machine load
+sub read_cpu_load {
+    my ($line, @upline, $users, @mach);
+
+    $line = `uptime -m`;
+    @mach  = split (
+                    /^.* factor: ([0-9\.]*), ([0-9\.]*), ([0-9\.]*)$/,
+                    $line);
+    return $mach[1];
+}
+
+# check the cpu load
+sub check_cpu_load {
+    my ($cpu, $msg, $running, $l);
+
+    $cpu = read_cpu_load;
+
+    if ( $cpu < $MACH_CRITICAL ) {
+        $cpumsg = "CPU is critically overloaded:  MACH = $cpu";
+        $icpu = 0;
+    } elsif ( $cpu < $MACH_BAD ) {
+        $cpumsg = "CPU load is too high:  MACH = $cpu";
+        $icpu = 1;
+    } elsif ( $cpu < $MACH_GOOD ) {
+        $cpumsg = "CPU load is not good enough:  MACH = $cpu";
+        $icpu = 2;
+    } elsif ( $cpu < $MACH_VERYGOOD ) {
+        $cpumsg = "CPU load is very good:  MACH = $cpu";
+        $icpu = 3;
+    } else {
+        $cpumsg = "CPU load is excellent!:  MACH = $cpu";
+        $icpu = 4;
+    }
+	
+	open(C520RUNNING, "ps x|") 
+		or die "Cannot execute ps x: $!"; 	
+	$running = 0;
+	while ( $l = <C520RUNNING> ) {
+		if ( $l =~ /c520/ ) {
+			$running++;
+		}
+	}	
+	close(C520RUNNING);
+	
+	if ( $running > 0 ) {
+		$cpumsg .= "\nCORSIKA still running $running time(s):\n$l";
+        $icpu = 0;
+	}		
+	
+	$icpu;
+}
+
+# get primary to be used
+sub get_primary {
+    my ($prim);
+
+    $prim = `cat $SYSDIR/last-primary`
+        or croak "Cannot read data file $SYSDIR/last-primary"; 
+
+    $prim = ($prim == $#primaries ) ? 0 : $prim+1;
+    
+    system("echo $prim > $SYSDIR/last-primary") == 0
+        or croak "Cannot write data file $SYSDIR/last-primary";
+
+    $primaries[$prim];
+}
+
+# get primary to be used
+sub get_energy {
+    my ($prim) = @_;
+    my ($ener);
+
+    $ener = `cat $SYSDIR/last-energy`
+        or croak "Cannot read data file $SYSDIR/last-energy"; 
+    
+    if ($prim == $primaries[0]) {
+        $ener = ($ener == $#energies ) ? 0 : $ener+1;
+        system("echo $ener > $SYSDIR/last-energy") == 0
+            or croak "Cannot write data file $SYSDIR/last-energy";
+    }
+
+    return ( $energies[$ener], $energies2[$ener],);
+}
+
+# get set (run) number for this run
+sub get_set {
+    my ($energy, $primary) = @_;
+    my (@line, $lastset, $l);
+
+    open(FILESETS,"< $SYSDIR/last-sets") 
+        or croak "Cannot open file $SYSDIR/last-sets";
+    open(FILESETS2,"> $SYSDIR/last-sets.bak") 
+        or croak "Cannot open file $SYSDIR/last-sets.bak";
+    while ($l = <FILESETS>) {
+        if ($l =~ /^($primary-$energy) /) {
+            chomp $l;
+            @line = split ' ', $l;
+            $lastset = $line[1];
+            $lastset++;
+            $l = "$primary-$energy     $lastset\n";
+        }
+        print FILESETS2 $l;
+    }
+    close(FILESETS2);
+    close(FILESETS);
+    system("mv $SYSDIR/last-sets.bak $SYSDIR/last-sets") == 0
+        or croak "Cannot modify file $SYSDIR/last-sets";
+    
+    $lastset;
+}
+
+# send an e-mail
+sub send_mail {
+    my ($msg,$err)=@_;
+    my ($date,$fullmsg,$time);
+
+    $date = scalar localtime;
+    $time = time;
+
+    $fullmsg = "Subject: $PROGRAM $VERSION - log\n";
+    $fullmsg .= "=" x 60 . "\n";
+    $fullmsg .= "$PROGRAM version $VERSION\n";
+    $fullmsg .= "$COPYRIGHT\n";
+    $fullmsg .= "=" x 60 . "\n\n";
+    $fullmsg .= "  User:   $USER\n";
+    $fullmsg .= "  Date:   $date ($time)\n\n";
+    $fullmsg .= "  Msg:    $msg\n\n";
+    open(MSGFILE, "> $SYSDIR/last-msg") 
+        or croak "Cannot write data file $SYSDIR/last-msg";
+    print MSGFILE $fullmsg;
+    close(MSGFILE);
+    open(OVERLOAD, ">> $SYSDIR/last-logs")
+        or croak "Cannot write data file $SYSDIR/last-logs";
+    if ($err < 1) {
+        system("mail $USER < $SYSDIR/last-msg") == 0
+            or croak "Cannot send e-mail file $SYSDIR/last-msg";
+        print OVERLOAD "+$date : $cpumsg\n";
+    } else {
+        print OVERLOAD " $date : $cpumsg\n";
+    }
+    close(OVERLOAD);
+}
+
+# construct the job file
+sub make_job {
+    my ($job,$nrun,$date,$dir,$fulldir,$nshow);
+    my ($seed1,$seed2,$seed3);
+    
+    $Primary = get_primary();
+    ($Energy1,$Energy2) = get_energy($Primary);
+    $Set = get_set($Energy1, $Primary);
+    $nshow = $$MINN{$Energy1};
+    $dir = "mc$TEL-$Primary-$Energy1:$Energy2-$Set";
+    $fulldir = "$DISK/$dir";
+    $job = "job.cmds";
+
+    # change seed for random numbers
+    srand ( time() ^ ($$ + ($$ << 15)) );
+    $seed1 = int(rand 100000) + 1;
+    $seed2 = int(rand 100000) + 1;
+    $seed3 = int(rand 100000) + 1;
+
+### make job commands file
+
+    open(JOBFILE,"> $SYSDIR/$job") 
+        or croak "Cannot write job file $SYSDIR/job";
+    $date = scalar localtime;
+
+    print JOBFILE <<"_eoj_";
+#!/bin/sh
+#############################################################
+# JOBS script
+# Automaticaly generated by $PROGRAM v. $VERSION 
+#
+# $COPYRIGHT
+# $date
+#############################################################
+#
+
+# begin
+
+# initialize variables 
+
+MAIN_DIR="$MOTHERDIR"
+TARGET_DIR="$fulldir"
+DATA_FILES="ATM75 ATM80 ATM84 ATM85 ATM86 ATM87 ATM88 ATM89 ATM90"
+DATA_FILES="\$DATA_FILES EGSDAT2 NUCNUCCS VENUSDAT"
+PROG="$EXECCOR"
+INPUT="input"
+OUTPUT="output"
+ERROR="error"
+
+# create target directory
+mkdir \$TARGET_DIR || \
+{ echo "Cannot create directory \$TARGET_DIR"; exit 1; }
+cd \$TARGET_DIR || \
+{ echo "Cannot move to directory \$TARGET_DIR"; exit 1; }
+
+# make symbolic links
+for i in \$DATA_FILES; do
+  ln -s \$MAIN_DIR/\$i \$TARGET_DIR/. || \
+    { echo "Cannot create symbolic link"; exit 1; }
+done
+
+# copy this file to the target directory
+cp $SYSDIR/$job $SYSDIR/\$INPUT \$TARGET_DIR/.
+
+# before it starts
+datebef=`date`
+timebef=`times`
+
+#------------------------------------------------------------
+# execute CORSIKA
+nice -n $NICE \$MAIN_DIR/\$PROG < \$INPUT 1> \$OUTPUT 2> \$ERROR
+# \$MAIN_DIR/\$PROG < \$INPUT 1> \$OUTPUT 2> \$ERROR 
+#------------------------------------------------------------
+
+# after it finishes
+dateaft=`date`
+timeaft=`times`
+dspace=`du -sk \$TARGET_DIR | cut -f 1`
+
+# now update information in the system
+odspace=`cat "$SYSDIR/disk-space"`
+otspace=`cat "$SYSDIR/tape-space"`
+ndspace=`expr "\$odspace" - "\$dspace"`
+ntspace=`expr "\$otspace" - "\$dspace"`
+echo \$ndspace > $SYSDIR/disk-space
+echo \$ntspace > $SYSDIR/tape-space
+
+# save the directory name in the table to be saved to tape
+echo \$TARGET_DIR \$dspace >> $SYSDIR/to-save
+
+# build report
+
+cat << EOM > $SYSDIR/last-mail
+Subject: $PROGRAM v $VERSION - END OF JOB
+============================================================
+$PROGRAM version $VERSION
+$COPYRIGHT
+============================================================
+
+  User:   $USER
+  Date:   \$dateaft
+
+  Msg:    The job has finished
+          Follows statistics of the job:
+
+  Running with nice: $NICE
+           CPU load: $cpumsg
+   Command line was: "\$MAIN_DIR/\$PROG < \$INPUT"
+   Target directory: \$TARGET_DIR
+    Used disk space: \$dspace
+   Start date(time): \$datebef ( \$timebef )
+     End date(time): \$dateaft ( \$timeaft )
+  Disk space avail.: \$ndspace
+  Tape space avail.: \$ntspace
+
+EOM
+
+echo '-- List of directories to save --------' >> $SYSDIR/last-mail 
+cat $SYSDIR/to-save >> $SYSDIR/last-mail 
+echo '-- EOF --------------------------------' >> $SYSDIR/last-mail 
+
+echo '' >> $SYSDIR/last-mail 
+
+echo '-- Input file used --------------------' >> $SYSDIR/last-mail 
+cat \$INPUT >> $SYSDIR/last-mail 
+echo '-- EOF --------------------------------' >> $SYSDIR/last-mail 
+
+echo '' >> $SYSDIR/last-mail 
+
+echo '-- Job file used ----------------------' >> $SYSDIR/last-mail 
+cat job.cmds >> $SYSDIR/last-mail
+echo '-- EOF --------------------------------' >> $SYSDIR/last-mail 
+
+# send the report 
+
+mail $USER < $SYSDIR/last-mail
+
+# bye
+
+exit 0
+ 
+_eoj_
+
+    close(JOBFILE);
+    chmod(0755, "$SYSDIR/job.cmds"); # make it executable
+
+###  make input file
+
+    open(INFILE, "> $SYSDIR/input") 
+    or croak "Cannot write input file $SYSDIR/input";
+    print INFILE <<"_eoj_";
+RUNNR   $Set                           number of run
+EVTNR   1                              number of first shower event
+NSHOW   $nshow                         number of showers to generate
+PRMPAR  $Primary                       particle type of prim. particle
+ESLOPE  $Spectral_Index                   slope of primary energy spectrum
+ERANGE  $Energy1    $Energy2             energy range of primary particle
+THETAP  $Theta[0]  $Theta[1]               range of zenith angle (degree)
+PHIP    $Phi[0]  $Phi[1]                   range of azimuth angle (degree)
+SEED    $seed1   $SITE   0                seed for 1. random number sequence
+SEED    $seed2   $SITE   0                seed for 2. random number sequence
+SEED    $seed3   $SITE   0                seed for 3. random number sequence
+OBSLEV  2200.E2                        observation level (in cm)
+ELMFLG  F   F                          em. interaction flags (NKG,EGS)
+RADNKG  200.E2                         outer radius for NKG lat.dens.determ.
+ARRANG  0.                             rotation of array to north
+FIXHEI  0.  0                          first interaction height & target
+FIXCHI  0.                             starting altitude (g/cm**2)
+MAGNET  20.0  42.8                     magnetic field centr. europe
+HADFLG  0  0  0  0  0  0               flags for hadr. interaction
+GHEISH  T                              use gheisha for low energy hadrons
+VENUS   T                              use venus for high energy hadrons
+VENSIG  T                              use VENUS hadronic cross sections
+ECUTS   0.3  0.3  0.02  0.02         e.cuts: had, mu, elec y fot
+MUADDI  F                              additional info for muons
+MUMULT  T                              muon multiple scattering angle
+LONGI   T  10.  T                      longit.distr. & step size & fit
+MAXPRT  0                              max. number of printed events
+ECTMAP  1.E4                           cut on gamma factor for printout
+STEPFC  10.0                           mult. scattering step length fact.
+DEBUG   F  6  F  1000000               debug flag and log.unit for out
+VENDBG  0                              venus debug option
+DIRECT  ./                   
+CWAVLG  290.  600.                     Cherenkov wavelength band
+CSCAT   1  0.  35000.                  scatter Cherenkov events
+CERSIZ  1.                             bunch size Cherenkov photons
+CERFIL  T                              Cherenkov output to extra file
+CERTEL  1
+        0. 0. 0. 0. 0. 1800. 1700.     Location and size of each CT
+EXIT                                   terminates input
+_eoj_
+    close(INFILE);
+}
+
+sub bye {
+    print "\nbye.\n\n";
+}
+
+
+
+###
+#  main procedure
+###
+
+# get command line options
+init;
+
+# get command line options
+get_options;
+
+# say hello
+hello;
+
+
+
+
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/main.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/main.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/main.f	(revision 286)
@@ -0,0 +1,1600 @@
+
+      PROGRAM MAIN
+ 
+C-----------------------------------------------------------------------
+C  MAIN PROGRAM
+C
+C  SIMULATION OF EXTENSIVE AIR SHOWERS
+C  PREPARES INITIALIZATIONS
+C  GENERATES SHOWERS IN THE SHOWER LOOP
+C  TREATES PARTICLES IN THE PARTICLE LOOP
+C  PERFORMS PRINTING OF TABLES AT END OF SHOWER AND AT END OF RUN
+C-----------------------------------------------------------------------
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      parameter (xct=1)
+      parameter (yct=2)
+      parameter (zct=3)
+      parameter (ctthet=4)
+      parameter (ctphi=5)
+      parameter (ctdiam=6)
+      parameter (ctfoc=7)
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,BAL.
+      COMMON /BAL/     EBAL
+      DOUBLE PRECISION EBAL(10)
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,CHISTA.
+      COMMON /CHISTA/  IHYCHI,IKACHI,IMUCHI,INNCHI,INUCHI,IPICHI
+      INTEGER          IHYCHI(124),IKACHI(124),IMUCHI(124),
+     *                 INNCHI(124),INUCHI(124),IPICHI(124)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,CURVE.
+      COMMON /CURVE/   CHAPAR,DEP,ERR,NSTP
+      DOUBLE PRECISION CHAPAR(1100),DEP(1100),ERR(1100)
+      INTEGER          NSTP
+*KEEP,ELADPM.
+      COMMON /ELADPM/  ELMEAN,ELMEAA,IELDPM,IELDPA
+      DOUBLE PRECISION ELMEAN(37),ELMEAA(37)
+      INTEGER          IELDPM(37,13),IELDPA(37,13)
+*KEEP,ELASTY.
+      COMMON /ELASTY/  ELAST,IELIS,IELHM,IELNU,IELPI
+      DOUBLE PRECISION ELAST
+      INTEGER          IELIS(20),IELHM(20),IELNU(20),IELPI(20)
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,IRET.
+      COMMON /IRET/    IRET1,IRET2
+      INTEGER          IRET1,IRET2
+*KEEP,ISTA.
+      COMMON /ISTA/    IFINET,IFINNU,IFINKA,IFINPI,IFINHY
+      INTEGER          IFINET,IFINNU,IFINKA,IFINPI,IFINHY
+*KEEP,LONGI.
+      COMMON /LONGI/   APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
+     *                 NSTEP,LLONGI,FLGFIT
+      DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
+     *                 SPLONG(0:1040,9),THSTEP,THSTPI
+      INTEGER          NSTEP
+      LOGICAL          LLONGI,FLGFIT
+*KEEP,MPARTI.
+      COMMON /MPARTI/  MPARTO
+      DOUBLE PRECISION MPARTO(10,25),MPHOTO(10),MPOSIT(10),MELECT(10),
+     *                 MNU(10),MMUP(10),MMUM(10),MPI0(10),MPIP(10),
+     *                 MPIM(10),MK0L(10),MKPL(10),MKMI(10),MNEUTR(10),
+     *                 MPROTO(10),MPROTB(10),MK0S(10),MHYP(10),
+     *                 MNEUTB(10),MDEUT(10),MTRIT(10),MALPHA(10),
+     *                 MOTHER(10)
+      EQUIVALENCE (MPARTO(1, 1),MPHOTO(1)), (MPARTO(1, 2),MPOSIT(1)),
+     *            (MPARTO(1, 3),MELECT(1)), (MPARTO(1, 4),MNU(1))   ,
+     *            (MPARTO(1, 5),MMUP(1))  , (MPARTO(1, 6),MMUM(1))  ,
+     *            (MPARTO(1, 7),MPI0(1))  , (MPARTO(1, 8),MPIP(1))  ,
+     *            (MPARTO(1, 9),MPIM(1))  , (MPARTO(1,10),MK0L(1))  ,
+     *            (MPARTO(1,11),MKPL(1))  , (MPARTO(1,12),MKMI(1))  ,
+     *            (MPARTO(1,13),MNEUTR(1)), (MPARTO(1,14),MPROTO(1)),
+     *            (MPARTO(1,15),MPROTB(1)), (MPARTO(1,16),MK0S(1))  ,
+     *            (MPARTO(1,18),MHYP(1))  , (MPARTO(1,19),MDEUT(1)) ,
+     *            (MPARTO(1,20),MTRIT(1)) , (MPARTO(1,21),MALPHA(1)),
+     *            (MPARTO(1,22),MOTHER(1)), (MPARTO(1,25),MNEUTB(1))
+*KEEP,MULT.
+      COMMON /MULT/    EKINL,MSMM,MULTMA,MULTOT
+      DOUBLE PRECISION EKINL
+      INTEGER          MSMM,MULTMA(37,13),MULTOT(37,13)
+*KEEP,MUPART.
+      COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
+      DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
+      LOGICAL          FMUBRM,FMUORG
+*KEEP,NCOUNT.
+      COMMON /NCOUNT/  NCOUN
+      INTEGER          NCOUN(8)
+*KEEP,NKGI.
+      COMMON /NKGI/    SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
+     *                 DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
+     *                 OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
+      DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
+     *                 ZSL(10),DIST(10),
+     *                 DISX(-10:10),DISY(-10:10),
+     *                 DISXY(-10:10,2),DISYX(-10:10,2),
+     *                 DLAX (-10:10,2),DLAY (-10:10,2),
+     *                 DLAXY(-10:10,2),DLAYX(-10:10,2),
+     *                 OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
+      INTEGER          IALT(2)
+*KEEP,NKGS.
+      COMMON /NKGS/    CZX,CZY,CZXY,CZYX,SAH,SL,ZNE
+      DOUBLE PRECISION CZX(-10:10,2),CZY(-10:10,2),CZXY(-10:10,2),
+     *                 CZYX(-10:10,2),SAH(10),SL(10),ZNE(10)
+*KEEP,NPARTI.
+      COMMON /NPARTI/  NPARTO,MUOND
+      DOUBLE PRECISION NPARTO(10,25),NPHOTO(10),NPOSIT(10),NELECT(10),
+     *                 NNU(10),NMUP(10),NMUM(10),NPI0(10),NPIP(10),
+     *                 NPIM(10),NK0L(10),NKPL(10),NKMI(10),NNEUTR(10),
+     *                 NPROTO(10),NPROTB(10),NK0S(10),NHYP(10),
+     *                 NNEUTB(10),NDEUT(10),NTRIT(10),NALPHA(10),
+     *                 NOTHER(10),MUOND
+      EQUIVALENCE (NPARTO(1, 1),NPHOTO(1)), (NPARTO(1, 2),NPOSIT(1)),
+     *            (NPARTO(1, 3),NELECT(1)), (NPARTO(1, 4),NNU(1))   ,
+     *            (NPARTO(1, 5),NMUP(1))  , (NPARTO(1, 6),NMUM(1))  ,
+     *            (NPARTO(1, 7),NPI0(1))  , (NPARTO(1, 8),NPIP(1))  ,
+     *            (NPARTO(1, 9),NPIM(1))  , (NPARTO(1,10),NK0L(1))  ,
+     *            (NPARTO(1,11),NKPL(1))  , (NPARTO(1,12),NKMI(1))  ,
+     *            (NPARTO(1,13),NNEUTR(1)), (NPARTO(1,14),NPROTO(1)),
+     *            (NPARTO(1,15),NPROTB(1)), (NPARTO(1,16),NK0S(1))  ,
+     *            (NPARTO(1,18),NHYP(1))  , (NPARTO(1,19),NDEUT(1)) ,
+     *            (NPARTO(1,20),NTRIT(1)) , (NPARTO(1,21),NALPHA(1)),
+     *            (NPARTO(1,22),NOTHER(1)), (NPARTO(1,25),NNEUTB(1))
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,PBALA.
+      COMMON /PBALA/   PBAL
+      DOUBLE PRECISION PBAL(10)
+*KEEP,PRIMSP.
+      COMMON /PRIMSP/  PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX,ISPEC
+      DOUBLE PRECISION PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX
+      INTEGER          ISPEC
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RECORD.
+      COMMON /RECORD/  IRECOR
+      INTEGER          IRECOR
+*KEEP,REJECT.
+      COMMON /REJECT/  AVNREJ,
+     *                 ALTMIN,ANEXP,THICKA,THICKD,CUTLN,EONCUT,
+     *                 FNPRIM
+      DOUBLE PRECISION AVNREJ(10)
+      REAL             ALTMIN(10),ANEXP(10),THICKA(10),THICKD(10),
+     *                 CUTLN,EONCUT
+      LOGICAL          FNPRIM
+*KEEP,RESON.
+      COMMON /RESON/   RDRES,RESRAN,IRESPAR
+      REAL             RDRES(2),RESRAN(1000)
+      INTEGER          IRESPAR
+ 
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKF.
+      COMMON /STACKF/  STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+      INTEGER          MAXSTK
+      PARAMETER        (MAXSTK = 12*340*2)
+      DOUBLE PRECISION STACK(MAXSTK)
+      INTEGER          STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+*KEEP,STATI.
+      COMMON /STATI/   SABIN,SBBIN,INBIN,IPBIN,IKBIN,IHBIN
+      DOUBLE PRECISION SABIN(37),SBBIN(37)
+      INTEGER          INBIN(37),IPBIN(37),IKBIN(37),IHBIN(37)
+*KEEP,THNVAR.
+      COMMON /THNVAR/  STACKINT,INT_ICOUNT,THINNING
+      INTEGER          MAXICOUNT
+      PARAMETER        (MAXICOUNT=20000)
+      DOUBLE PRECISION STACKINT(MAXICOUNT,13)
+      INTEGER          INT_ICOUNT
+      LOGICAL          THINNING
+*KEEP,VERS.
+      COMMON /VERS/    VERNUM,MVDATE,VERDAT
+      DOUBLE PRECISION VERNUM
+      INTEGER          MVDATE
+      CHARACTER*18     VERDAT
+*KEEP,CEREN1.
+      COMMON /CEREN1/  CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD,
+     *                 CERSIZ,LCERFI
+      DOUBLE PRECISION CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD
+      REAL             CERSIZ
+      LOGICAL          LCERFI
+*KEEP,CEREN2.
+      COMMON /CEREN2/  PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS,CERYOS,
+     *                 NCERX,NCERY,ICERML
+      REAL             PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS(20),CERYOS(20)
+      INTEGER          NCERX,NCERY,ICERML
+*KEEP,CEREN3.
+      COMMON /CEREN3/  CERCNT,DATAB2,LHCER
+      INTEGER          MAXBF2
+      PARAMETER        (MAXBF2 = 39 * 7)
+      DOUBLE PRECISION CERCNT
+      REAL             DATAB2(MAXBF2)
+      INTEGER          LHCER
+*KEEP,CEREN4.
+      COMMON /CEREN4/  NRECER
+      INTEGER          NRECER
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+*keep,certel.
+      common /certel/  cormxd,cord,coralp,ctpars,omega,
+     +                 photn,photnp,phpt,pht,vphot,
+     +                 vchi,veta,vzeta,vchim,vetam,vzetam,
+     +                 lambda,mu,nu,nctels,ncph
+      double precision cormxd,cord,coralp,ctpars(20,7),omega(20,3,3),
+     +                 photn(3),photnp(3),phpt(3),pht,vphot(3),
+     +                 vchi(3),veta(3),vzeta(3),vchim,vetam,vzetam,
+     +                 lambda,mu,nu
+      integer          nctels,ncph(5)
+      double precision xg,yg,zg,xgp,ygp,zgp,up,vp,wp,xpcut,ypcut,zpcut
+      equivalence (photn(1) ,xg)   ,(photn(2) ,yg)   ,(photn(3) ,zg)  ,
+     +            (photnp(1),xgp)  ,(photnp(2),ygp)  ,(photnp(3),zgp),
+     +            (phpt(1)  ,xpcut),(phpt(2)  ,ypcut),(phpt(3)  ,zpcut),
+     +            (vphot(1) ,up)   ,(vphot(2) ,vp)   ,(vphot(3) ,wp)    
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C     Modificacion hecha por Aitor (5-feb-98)
+      common /aitor/   aitoth
+      double precision aitoth
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c     Angles for the "spinning" of a particle around the 
+c     main axis of the CT
+      common /spinang/ spinxi
+      double precision spinxi
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+*KEND.
+ 
+      INTEGER JNBIN(37),JPBIN(37),JKBIN(37),JHBIN(37)
+      DOUBLE PRECISION CHI2,FPARAM(6)
+      DOUBLE PRECISION MPART2(10,25),MPHOT2(10),MPOSI2(10),MELEC2(10),
+     *                 MNU2(10),MMUP2(10),MMUM2(10),MPI02(10),MPIP2(10),
+     *                 MPIM2(10),MK0L2(10),MKPL2(10),MKMI2(10),
+     *                 MNETR2(10),MPROT2(10),MPRTB2(10),MK0S2(10),
+     *                 MHYP2(10),MNETB2(10),MDEUT2(10),MTRIT2(10),
+     *                 MALPH2(10),MOTH2(10)
+      EQUIVALENCE (MPART2(1, 1),MPHOT2(1)), (MPART2(1, 2),MPOSI2(1)),
+     *            (MPART2(1, 3),MELEC2(1)), (MPART2(1, 4),MNU2(1))  ,
+     *            (MPART2(1, 5),MMUP2(1)) , (MPART2(1, 6),MMUM2(1)) ,
+     *            (MPART2(1, 7),MPI02(1)) , (MPART2(1, 8),MPIP2(1)) ,
+     *            (MPART2(1, 9),MPIM2(1)) , (MPART2(1,10),MK0L2(1)) ,
+     *            (MPART2(1,11),MKPL2(1)) , (MPART2(1,12),MKMI2(1)) ,
+     *            (MPART2(1,13),MNETR2(1)), (MPART2(1,14),MPROT2(1)),
+     *            (MPART2(1,15),MPRTB2(1)), (MPART2(1,16),MK0S2(1)) ,
+     *            (MPART2(1,18),MHYP2(1)) , (MPART2(1,19),MDEUT2(1)),
+     *            (MPART2(1,20),MTRIT2(1)), (MPART2(1,21),MALPH2(1)),
+     *            (MPART2(1,22),MOTH2 (1)), (MPART2(1,25),MNETB2(1))
+C  VARIABLES BEING USED FOR RUNTIME
+      REAL     TDIFF
+      INTEGER  ILEFTA,ILEFTB,TIME
+      EXTERNAL TIME
+
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      double precision ctdiams(20)
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      double precision theprim, phiprim
+      double precision spinthe, spinphi
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+C-----------------------------------------------------------------------
+ 
+ 
+      CERELE = 0.D0
+      CERHAD = 0.D0
+      NRECER = 0
+C  INITIALIZE AND READ RUN STEERING CARDS
+      CALL START
+ 
+      IF ( CERSIZ .LE. 0. ) THEN
+        ICRSIZ = 0
+      ELSE
+        ICRSIZ = 1
+      ENDIF
+ 
+C  RESET COUNTER FOR WORDS WRITTEN TO TAPE
+      IRECOR = 0
+ 
+C  RESET COUNTER FOR AVERAGE HIGHT OF 1ST INTERACTION
+      CHISUM = 0.D0
+      CHISM2 = 0.D0
+ 
+C  SET ARRAYS FOR SCALES OF KINETIC ENERGY-INTERACTION TABLE
+      SABIN(1) = 0.D0
+      SBBIN(1) = 0.1D0
+      DO 13  J = 2,37
+        SABIN(J) = 10.D0**((J-4.D0)/3.D0)
+        SBBIN(J) = 10.D0**((J-3.D0)/3.D0)
+  13  CONTINUE
+ 
+C  CHECK AND SET PRIMARY PARAMETERS
+      CALL INPRM
+
+      do 161 i=1,nctels
+        ctdiams(i) = ctpars(i,ctdiam)
+ 161  continue
+
+C  INITIALIZE NKG ROUTINES
+      CALL ININKG
+ 
+C  RESET COUNTERS FOR NUCLEON, PION AND KAON TABLE FOR ALL SHOWERS
+C  RESET ENERGY-MULTIPLICITY & ENERGY-ELASTICITY MATRIX FOR ALL SHOWERS
+      DO 17  J = 1,37
+        JNBIN(J)  = 0
+        JPBIN(J)  = 0
+        JKBIN(J)  = 0
+        JHBIN(J)  = 0
+        ELMEAA(J) = 0.D0
+        DO 17  L = 1,13
+          MULTOT(J,L) = 0
+          IELDPA(J,L) = 0
+  17  CONTINUE
+ 
+C  RESET OTHER ARRAYS FOR ALL SHOWERS
+      DO 99  J = 1,20
+        IELNU(J) = 0
+        IELPI(J) = 0
+        IELIS(J) = 0
+        IELHM(J) = 0
+  99  CONTINUE
+ 
+C  RESET ARRAYS FOR INTERACTION LENGTH STATISTICS
+      DO 90  J = 1,124
+        IHYCHI(J) = 0
+        IKACHI(J) = 0
+        IMUCHI(J) = 0
+        INUCHI(J) = 0
+        IPICHI(J) = 0
+        INNCHI(J) = 0
+  90  CONTINUE
+ 
+C  RESET ARRAY FOR MEAN VALUES AND STANDARD DEVIATION
+      DO 477  K = 1,25
+      DO 477  J = 1,10
+        MPARTO(J,K) = 0.D0
+        MPART2(J,K) = 0.D0
+ 477  CONTINUE
+ 
+C  RESET ARRAYS FOR LONGITUDINAL DISTRIBUTION
+      IF ( LLONGI ) THEN
+        DO 478  K = 1,9
+          DO 4781  J = 0,NSTEP
+            APLONG(J,K) = 0.D0
+            SPLONG(J,K) = 0.D0
+ 4781     CONTINUE
+ 478    CONTINUE
+      ENDIF
+ 
+C  STEERING OF PRINTOUT OF RANDOM GENERATOR SEEDS
+      IPROUT = MIN(100,NSHOW/20)
+      IPROUT = MAX(1,IPROUT)
+ 
+C  TIME AT BEGINNING
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c      ILEFTA = TIME()
+      ILEFTA = 0
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      print *,'JCIO::========================================'
+      print *,'JCIO:: Initializing JCIO system for advanced'
+      print *,'JCIO:: saving of data.'
+      print *,'JCIO::========================================'
+c- initialize jcio system
+      call jcinitio(dsn,nrrun)
+c- create file run######
+      call jcstartrun(runh)
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+C-----------------------------------------------------------------------
+C  LOOP OVER SHOWERS
+      DO 2  ISHW = 1,NSHOW
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c   Next block of code has been modified, and comes from INPRM 
+c----------------------------------------------------------------------
+C  SCATTERING OF CENTER OF CHERENKOV ARRAY RELATIVE TO SHOWER AXIS
+c>> Actually, XSCATT and YSCATT should be RminSCATT and RmaxSCATT
+        ICERML = MIN(MAX(ICERML,1),20)
+        XSCATT = ABS(XSCATT)
+        YSCATT = ABS(YSCATT)
+        WRITE(MONIOU,5225)ICERML,XSCATT,YSCATT
+ 5225   FORMAT(' ** USING EACH SHOWER SEVERAL TIMES:'/ 
+     +     ' USE EACH EVENT ',I2,' TIMES'/
+     +     ' THE EVENTS ARE SCATTERED RANDOMLY IN A SECTOR OF RADII:'/
+     +     '   Rmin = ',F10.0,'   Rmax = ',F10.0)
+        DO 4438 I=1,ICERML
+ 5226     CALL RMMAR( RD,2,3 )
+          CERXOS(I) = 2.0*YSCATT*(RD(1)-0.5)
+          CERYOS(I) = 2.0*YSCATT*(RD(2)-0.5)
+          R=SQRT(CERXOS(I)**2+CERYOS(I)**2)
+          IF ((R.LT.XSCATT).OR.(R.GT.YSCATT)) GOTO 5226
+          WRITE(MONIOU,4437) I,CERXOS(I),CERYOS(I)
+ 4437     FORMAT('    CORE OF EVENT ',I2,'  AT  ',2F12.2)
+ 4438   CONTINUE
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c   Next block of code comes from INPRM 
+c----------------------------------------------------------------------
+        EVTH(98) = FLOAT(ICERML)
+        DO  480 I=1,20
+          EVTH( 98+I) = CERXOS(I)
+          EVTH(118+I) = CERYOS(I)
+ 480    CONTINUE
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+        SHOWNO = SHOWNO + 1
+        I      = ISHW
+        IF ( ISHW .LE. MAXPRT ) THEN
+          FPRINT = .TRUE.
+        ELSE
+          FPRINT = .FALSE.
+        ENDIF
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c   Create cer######,dat######,sta###### files
+c------------------------------------------------------------
+        call jcnewshower
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+C  RESET COUNTERS
+        DO 447  K = 1,25
+        DO 447  J = 1,10
+          NPARTO(J,K) = 0.D0
+ 447    CONTINUE
+        MUOND = 0.D0
+ 
+C  RESET ARRAY FOR LONGITUDINAL DISTRIBUTION PER SHOWER
+        IF ( LLONGI ) THEN
+          DO 479  K = 1,9
+            DO 4791  J = 0,NSTEP
+              PLONG(J,K) = 0.D0
+ 4791       CONTINUE
+ 479      CONTINUE
+        ENDIF
+ 
+        NRECS = 0
+        NBLKS = 0
+        DO 922  KKK = 1,10
+          AVNREJ(KKK) = 0.D0
+ 922    CONTINUE
+        IRESPAR = 0
+ 
+ 
+C  FIRST INTERACTION DATA
+        FIRSTI = .TRUE.
+        IFINET = 0
+        IFINNU = 0
+        IFINKA = 0
+        IFINPI = 0
+        IFINHY = 0
+        ELAST  = 0.D0
+ 
+C  RESET COUNTERS FOR NUCLEON, PION AND KAON TABLE FOR SHOWER
+C  RESET ENERGY-MULTIPLICITY & ENERGY-ELASTICITY MATRIX FOR SHOWER
+        DO 11  J = 1,37
+          INBIN(J) = 0
+          IPBIN(J) = 0
+          IKBIN(J) = 0
+          IHBIN(J) = 0
+          ELMEAN(J) = 0.D0
+          DO 11  L = 1,13
+            MULTMA(J,L) = 0
+            IELDPM(J,L) = 0
+  11    CONTINUE
+ 
+        DO 12  J = 1,10
+          PBAL(J) = 0.D0
+          EBAL(J) = 0.D0
+  12    CONTINUE
+ 
+C  INITIALIZE PARTICLE STACK
+        CALL ISTACK
+C  RESET STACKINT
+        DO J=1,MAXICOUNT
+          DO K=1,MAXLEN
+            STACKINT(J,K) = 0.D0
+          ENDDO
+        ENDDO
+ 
+C  INITIALIZE EVENT HEADER AND END FOR EACH EVENT
+        DO 2123  L = 2,43
+          EVTH(L) = 0.
+ 2123   CONTINUE
+        DO 123  L = 2,MAXBUF
+          EVTE(L) = 0.
+ 123    CONTINUE
+ 
+C  SHOWER BEGIN PRINTOUT
+        IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,105) SHOWNO
+ 105    FORMAT ('1',10('='),' SHOWER NO ',I10,' ',47('=')/)
+ 
+C  RANDOM GENERATOR STATUS AT BEGINNING OF SHOWER CALCULATION
+        EVTH(13) = NSEQ
+        DO 45  L = 1,NSEQ
+          CALL RMMAQ( ISEED(1,L), L, 'R' )
+C  SEED
+          EVTH(11+L*3) = ISEED(1,L)
+C  NUMBER OF CALLS
+          EVTH(12+L*3) = MOD ( ISEED(2,L), 1000000 )
+C  NUMBER OF MILLIONS
+          EVTH(13+L*3) = ISEED(3,L)*1000 + INT( ISEED(2,L)/1000000 )
+  45    CONTINUE
+        IF ( FPRINT  .OR.  DEBUG  .OR.  MOD(ISHW-1,IPROUT).EQ.0 ) THEN
+          CALL PRTIME(TTIME)
+          WRITE(MONIOU,158) SHOWNO,(L,(ISEED(J,L),J=1,3),L=1,NSEQ)
+ 158      FORMAT(' AND RANDOM NUMBER GENERATOR AT BEGIN OF EVENT :',I8,
+     *            /,(' SEQUENCE = ',I2,'  SEED = ',I9 ,'  CALLS = ',I9,
+     *               '  BILLIONS = ',I9))
+        ENDIF
+C  RESET KNOR
+        KNOR = .TRUE.
+ 
+C  GET FULL RANDOM GENERATOR STATUS (103 WORDS PER SEQUENCE)
+CC      DO 495  L = 1,NSEQ
+CC        CALL RMMAQ( ISEED(1,L), L, 'RV' )
+CC        WRITE(MONIOU,658) L,(ISEED(J,L),J=1,103)
+CC658     FORMAT ( ' FULL RANDOM NUMBER GENERATOR STATUS ',
+CC   *             'FOR SEQUENCE ',I2,/(' ',10I11))
+CC495   CONTINUE
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>> *** ATENTION *** ATENTION *** ATENTION *** ATENTION *** ATENTION >>
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>>                                                                  >>
+c>> In the next block (between this ATENTION comments) CORSIKA makes >>
+c>> three things, in this order:                                     >>
+c>>                                                                  >>
+c>>   i. Set ANGLES OF INCIDENCE (different distributions of theta   >>
+c>>      for gammas -flat- and hadrons -standard.                    >>
+c>>  ii. Set HEIGHT for start at THICK0 (normally = 0 => 112.8 Km)   >>
+c>> iii. Set ENERGY of the primary.                                  >>
+c>>                                                                  >>
+c>> (The original order was ii., iii. and i.)                        >>
+c>>                                                                  >>
+c>> JCG Wed Sep 21 10:49:14 MET DST 1998 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C  GET PRIMARY ANGLES OF INCIDENCE
+        IF ( FIXINC ) THEN
+
+          THETAP = THETPR(1)
+          PHIP   = PHIPR(1)
+          PRMPAR(3) = COS(THETAP)
+
+        ELSE
+
+          if ( prmpar(1).eq.1 ) then
+
+C>> GAMMAS >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C NOTE!! We will use a FLAT distribution for THETA: 
+C Then, next block (original block) must be commented.
+c The modificated code follows this block
+c
+            CALL RMMAR( RD,3,1 )
+            CT1 = THETPR(1)
+            CT2 = THETPR(2)
+            THETAP = RD(2)*(CT2 - CT1) + CT1
+            CTT  = COS(THETAP)
+            PRMPAR(3) = CTT
+
+          else
+
+C>> HADRONS AND ELECTRONS (AND ANY OTHER BUT GAMMAS) >>>>>>>>>>>>>>>>
+c  Choose angles at random with equal flux for all directions
+c  with horizontal detector array (see: O.C. Allkofer & P.K.F. Grieder,
+c  Cosmic Rays on Earth, in: Physics Data 25/1, H.Behrens & G.Ebel Ed.,
+c  (Fachinformationszentrum Karlsruhe, Germany, 1983) chpt. 1.1.2)
+c
+            CALL RMMAR( RD,3,1 )
+            CT1 = SIN(THETPR(1))**2
+            CT2 = SIN(THETPR(2))**2
+            CTT  = SQRT( 1.D0 - RD(2)*(CT2 - CT1) - CT1 )
+            PRMPAR(3) = CTT
+            THETAP = ACOS(CTT)
+
+          endif
+
+          PHIP = RD(1) * ( PHIPR(2) - PHIPR(1) ) + PHIPR(1)
+
+        ENDIF
+        PRMPAR(4) = PHIP
+
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C  DEFINE HEIGHT FOR START AT THICK0 (IN G/CM**2) (112.8 KM FOR THICK0=0)
+        PRMPAR(5) = HEIGH(THICK0)
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C  GET PRIMARY ENERGY INTO PRMPAR(2)
+        IF ( ISPEC .EQ. 0 ) THEN
+          PRMPAR(2) = LLIMIT
+        ELSE
+          CALL RMMAR( RD,1,1 )
+          IF ( PSLOPE .NE. -1.D0 ) THEN
+            PRMPAR(2) = ( RD(1)*UL + ( 1.D0-RD(1) )*LL )**SLEX
+          ELSE
+            PRMPAR(2) = LLIMIT * LL**RD(1)
+          ENDIF
+        ENDIF
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>> *** ATENTION *** ATENTION *** ATENTION *** ATENTION *** ATENTION >>
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>> Modification: this is no longer needed >>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>> (Superseeded by Sphere algorithm, see cerenkov.f) >>>>>>>>>>>>>>>>>
+c>> JCG Wed Sep 21 10:49:14 MET DST 1998 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+cc Btw, we now modify the "shadow area" of the telescopes,
+cc to cover the angle theta. 
+c        do 160 i=1,nctels
+c          ctpars(i,ctdiam) = ctdiams(i)/cos(thetap)
+c          write (MONIOU,*) 
+c     *        'New region for CT',i,' = ',ctpars(i,ctdiam)
+c 160    continue
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+          
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c Here we calculate the angles spinphi and spinthe, which are the 
+c phi and theta angles of the particle, with respect to the direction
+c where the CT is pointing to. spinthe is the angular displacement
+c of the new direction respect to the original (CT); spinphi=0 means
+c that the new direction is towards the zenith, spinphi=+-180 means 
+c towards the horizont.
+c See the document "simulation.tex" 
+
+c First, save the "CT" orientation 
+c (moved from a couple of lines below, marked with [*])
+        EVTH(11) = THETAP
+        EVTH(12) = PHIP
+        
+        CALL RMMAR( RD,3,1 )
+
+c Then, calculate the new direction relative to the CT direction
+        spinphi = RD(1)*PI
+        spinthe = RD(2)*spinxi*pi/180
+
+c And then, RE-calculate the GLOBAL direction in CORSIKA
+c We use formulae for spherical triangles
+        theprim = acos( cos(THETAP)*cos(spinthe)+
+     $                  sin(THETAP)*sin(spinthe)*cos(spinphi) )
+        phiprim = asin( sin(spinthe)*sin(spinphi)/sin(theprim) )
+        THETAP = theprim
+        EVTH(140) = spinthe
+        if (RD(3).gt.0.5) then
+          PHIP = PHIP - phiprim 
+          EVTH(141) = -spinphi
+        else
+          PHIP = PHIP + phiprim 
+          EVTH(141) = spinphi
+        endif
+        PRMPAR(3) = COS(THETAP)
+        PRMPAR(4) = PHIP
+
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>> Modification (HZA trick) cancelled >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>> JCG Wed Sep 21 10:49:14 MET DST 1998 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C     Modificacion hecha por Aitor
+c         aitoth = THETAP
+C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+C  CALCULATE COORDINATE CORRECTION FOR TOP OF ATMOSPHERE
+        CALL COORIN( PRMPAR(5) )
+ 
+C  COUNTER FOR PARTICLE OUTPUT
+        LH = 0
+C  COUNTER FOR CERENKOV OUTPUT
+        IF ( LCERFI ) LHCER = 0
+C  CALCULATE BUNCH SIZE FOR CERENKOV PHOTONS IF NOT SET IN DATAC
+        IF ( ICRSIZ .EQ. 0 ) THEN
+          CALL GETBUS( NINT(PRMPAR(1)),SNGL(PRMPAR(2)),SNGL(PRMPAR(3)),
+     *                  CERSIZ )
+          WRITE(MONIOU,*)'CERENKOV BUNCH SIZE IS CALCULATED TO=',CERSIZ
+        ENDIF
+C  GET GAMMA FACTOR FROM ENERGY
+C  FOR GAMMAS PRMPAR(2) STAYS = ENERGY
+        IF ( PRMPAR(1) .NE. 1.D0 )
+     *              PRMPAR(2) = PRMPAR(2) / PAMA(NINT(PRMPAR(1)))
+ 
+C  SET PRIMARY TO CURRENT PARTICLE
+        DO 3  J = 1,8
+          CURPAR(J) = PRMPAR(J)
+          NCOUN(J)  = 0
+  3     CONTINUE
+C  SET WEIGHT
+ 
+C  CALCULATE FIRST INTERACTION POINT IF HADRONIC
+        GEN = 0.D0
+ 
+        H = HEIGH(THICK0)
+        CALL BOX2
+        IF ( FIX1I ) THEN
+          CHI = THICK(FIXHEI) / PRMPAR(3)
+          H = FIXHEI
+          FDECAY = .FALSE.
+        ELSE
+          H = HEIGH ( CHI*PRMPAR(3) + THICK0 )
+        ENDIF
+        CHISUM = CHISUM + CHI
+        CHISM2 = CHISM2 + CHI**2
+        ALEVEL = H
+C  INITIALIZE COORDINATE CORRECTIONS FOR HADRONIC PRIMARIES
+C  FOR EM PRIMARIES IT IS DONE IN EGS
+        HH = MAX( H, 0.D0 )
+        IF ( CURPAR(1) .GT. 3.D0 ) CALL COORIN( HH )
+ 
+        IF ( FMUADD ) THEN
+          IF ( CURPAR(1) .EQ. 5  .OR.  CURPAR(1) .EQ. 6) THEN
+            DO J = 1,MAXLEN
+              AMUPAR(J) = CURPAR(J)
+            ENDDO
+            AMUPAR(5) = PRMPAR(5)
+            IF(DEBUG)WRITE(MDEBUG,*)'MAIN  : MUON STORED IN AMUPAR'
+            FMUORG = .TRUE.
+          ENDIF
+        ENDIF
+ 
+C  SET TARGET FLAG IF SELECTED FOR FIRST INTERACTION
+        IF ( N1STTR .GT. 0 ) THEN
+          FIXTAR  = .TRUE.
+          FDECAY  = .FALSE.
+          EVTH(6) = REAL(N1STTR)
+        ELSE
+          FIXTAR  = .FALSE.
+          EVTH(6) = 0.0
+        ENDIF
+ 
+C  INITIALIZE ARRAYS FOR NKG FOR EACH SHOWER
+        IF ( FNKG ) CALL STANKG
+ 
+C  STORE FIRST PARTICLE IN HEADER AND PRINT IT OUT
+        EVTH( 2) = REAL(SHOWNO)
+        EVTH( 3) = CURPAR(1)
+        IF ( CURPAR(1) .EQ. 1.D0 ) THEN
+C  PRIMARY ENERGY FOR PHOTONS
+          E00    = GAMMA
+          E00PN  = GAMMA
+          INUCL  = 1
+        ELSE
+          E00    = GAMMA * PAMA(NINT(CURPAR(1)))
+          INUCL  = INT(MAX(1.D0,CURPAR(1)/100.D0))
+          E00PN  = E00 / INUCL
+        ENDIF
+        EVTH(147) = 0.
+ 
+        IF ( FEGS ) THEN
+C  PARAMETER FOR ELECTRON AND PHOTON REJECT (CONVERT ENERGY TO MEV)
+          EONCUT = .5E-9*SQRT(E00*1000.D0)
+          CUTLN  = LOG(EONCUT)
+        ENDIF
+        EVTH( 4) = E00
+        EVTH( 5) = THICK0
+        EVTH( 7) = H
+        PTOT0    = SQRT( E00**2 - PAMA(NINT(CURPAR(1)))**2 )
+        PTOT0N   = PTOT0 / INUCL
+        ST       = SQRT(1.D0-COSTHE**2)
+        EVTH( 8) = PTOT0 * ST * COS(PHI)
+        EVTH( 9) = PTOT0 * ST * SIN(PHI)
+        EVTH(10) = PTOT0 * COSTHE
+c
+c [*] one block from here sent above
+c
+        EVTH(85) = CERSIZ
+ 
+        IF ( CURPAR(1) .GT. 3.D0 ) THEN
+          IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,102) (CURPAR(J),J = 1,8)
+ 102      FORMAT (/' PRIMARY PARAMETERS AT FIRST INTERACTION POINT'/
+     *               16X,1P,8E10.3)
+        ELSE
+          IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,132)
+ 132      FORMAT (/' PRIMARY PARTICLE IS ELECTROMAGNETIC')
+        ENDIF
+ 
+C  WRITE EVENT HEADER INTO BUFFER
+C  FOR EM PARTICLES EVTH IS WRITTEN TO BUFFER IN EGS (IF ACTIVE)
+        IF ( EVTH(3) .GT. 3.0  .OR.  .NOT. FEGS ) THEN
+          CALL TOBUF ( EVTH,0 )
+          IF ( LCERFI ) CALL TOBUFC( EVTH,0 )
+        ENDIF
+ 
+C  PRINT HEADER FOR HIGH ENERGY PARTICLES
+        IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,103)
+ 103    FORMAT(/'                   TYPE      GAMMA   COSTHETA ',
+     *          '    PHI     HEIGHT     TIME      X-CM      Y-CM   ',
+     *          '    GEN      LEVEL  E ON STACK'/)
+        NOPART = 0
+ 
+ 
+        IF ( CURPAR(1) .LE. 3.D0  .OR.
+     *      (CURPAR(1) .GE. 5.D0  .AND.  CURPAR(1) .LE. 7.D0) ) THEN
+C  GIVE PARTICLE TO EGS OR NKG IF ELECTROMAGNETIC
+C  AND TAKE THEN NEXT PARTICLE FROM STACK
+C  FLAG FOR NO PRIMARY INTERACTION IS SET FOR ALL BUT ELM. PRIMARIES
+          IF ( CURPAR(1) .LE. 3.D0 ) THEN
+            FNPRIM = .FALSE.
+          ELSE
+            FNPRIM = .TRUE.
+            H = PRMPAR(5)
+          ENDIF
+          CALL BOX3
+          IF ( FEGS ) THEN
+            CHISUM = CHISUM + THICK(DBLE(EVTH(7)))
+            CHISM2 = CHISM2 + THICK(DBLE(EVTH(7)))**2
+          ENDIF
+          FIRSTI = .FALSE.
+          GOTO 4
+ 
+        ELSE
+C  HADRONIC PARTICLES
+          FNPRIM = .TRUE.
+ 
+C  FILL LONGITUDINAL DISTRIBUTION FOR THE PRIMARY PARTICLE
+C  THE PARTICLE IS TRACKED FROM THICK0 DOWN TO THICK0+CHI*PRMPAR(3)
+C  COUNT THE PARTICLES FOR THE LONGITUDINAL DEVELOPMENT
+          IF ( LLONGI ) THEN
+            LPCT1 = INT( THICK0 * THSTPI )
+            LPCT2 = INT( (THICK0 + PRMPAR(3)*CHI) * THSTPI )
+            LPCT2 = MIN(NSTEP,LPCT2)
+C  GAMMAS, ELECTRONS AND POSITRONS ARE NOT TRANSPORTED HERE, SEE EGS
+C  MUONS ARE TRANSPORTED IN MUTRAC
+C  HADRONS
+            IF     ( ITYPE .GE. 7 .AND. ITYPE .LE. 41 ) THEN
+              DO 5004 L = LPCT1,LPCT2
+                PLONG(L,6) = PLONG(L,6) + 1.
+ 5004         CONTINUE
+C  CHARGED HADRONS
+              IF ( SIGNUM(ITYPE) .NE. 0.D0 ) THEN
+                DO 5005 L = LPCT1,LPCT2
+                  PLONG(L,7) = PLONG(L,7) + 1.
+ 5005           CONTINUE
+              ENDIF
+C  NUCLEI
+            ELSEIF ( ITYPE .GT. 100 ) THEN
+              DO 5006 L = LPCT1,LPCT2
+                PLONG(L,8) = PLONG(L,8) + 1.
+ 5006         CONTINUE
+            ENDIF
+          ENDIF
+ 
+C  CHECK OBSERVATION LEVEL PASSAGE AND UPDATE PARTICLE COORDINATES
+          HNEW = H
+C  FOR UPDATE WE NEED THE START ALTITUDE H
+          H = HEIGH(THICK0)
+          DO  251  J = 1,NOBSLV
+C  JUMP INTO NORMAL PARTICLE TREATMENT FOR HADRONS
+            IF ( HNEW .GT. OBSLEV(J) ) THEN
+              H = HNEW
+              GOTO 6
+            ENDIF
+            IF ( H .LT. OBSLEV(J) ) GOTO 251
+C  REMEMBER NUMBER OF LEVEL FOR OUTPUT
+            LEVL   = J
+            CALL UPDATE( OBSLEV(J),THCKOB(J),J )
+            IF (DEBUG) WRITE(MDEBUG,256) J,IRET1,IRET2
+ 256        FORMAT(' MAIN  : LEVEL ',I5,' IRET1,2=',2I5)
+C  IF PARTICLE IS NOT CUTTED, BRING IT TO OUTPUT
+            IF ( IRET2 .EQ. 0 ) THEN
+              CALL OUTPUT
+            ENDIF
+ 251      CONTINUE
+          IF (DEBUG) WRITE(MDEBUG,*)
+     *       'MAIN  : PRIMARY REACHED LOWEST OBSERVATION LEVEL'
+          GOTO 4
+        ENDIF
+ 
+C-----------------------------------------------------------------------
+C  NORMAL CYCLE
+  7     CONTINUE
+ 
+C  IF ENERGY TOO SMALL TAKE NEXT PARTICLE
+        IF ( GAMMA .LE. 1.D0 ) THEN
+          IF ( CURPAR(1) .NE. 1.D0 ) THEN
+            IF ( CURPAR(1).EQ.5.D0 .OR. CURPAR(1).EQ.6.D0 )
+     *                                        FMUORG = .FALSE.
+            GOTO 4
+          ENDIF
+C  SPECIAL TREATMENT FOR PHOTONS
+          ITYPE = 1
+          CHI   = 0.D0
+          GOTO 5
+        ENDIF
+ 
+C  DETERMINE PLACE OF NEXT INTERACTION
+        CALL BOX2
+ 
+C  CHECK PASSAGE THROUGH OBSERVATION LEVELS AND TRACK PARTICLES TO THE
+C  PLACE OF INTERACTION
+  5     CONTINUE
+        IRET1 = 0
+        CALL BOX3
+        IF ( IRET1 .NE. 0 ) GOTO 4
+ 
+  6     CONTINUE
+        IRET1 = 0
+        MSMM  = 0
+ 
+C  INCREMENT PARTICLE GENERATION AND PROCESS NUCLEAR INTERACTION
+        GEN   = GEN + 1.D0
+C  INITIALIZE INTERMEDIATE STACK FOR ONE REACTION
+        CALL TSTINI
+        CALL NUCINT
+C  TRANSFER INTERMEDIATE STACK FOR ONE REACTION
+        CALL TSTEND
+ 
+C  ENERGY - MULTIPLICITY STATISTICS
+        IF ( EKINL .LE. 0.1D0 ) THEN
+          MEN = 1
+        ELSE
+          MEN = 4.D0 + 3.D0 * LOG10(EKINL)
+          MEN = MIN( MEN, 37 )
+        ENDIF
+        IF ( MSMM .LE. 1 ) THEN
+          MMU = 1
+        ELSE
+          MMU = 1.D0 + 3.D0 * LOG10(DBLE(MSMM))
+          MMU = MIN( MMU, 13 )
+        ENDIF
+        MULTMA(MEN,MMU) = MULTMA(MEN,MMU) + 1
+        MULTOT(MEN,MMU) = MULTOT(MEN,MMU) + 1
+        IF ( DEBUG ) WRITE(MDEBUG,*) 'MAIN  : EKINL,MSMM=',
+     *                                  SNGL(EKINL),MSMM
+ 
+        IF ( IRET1 .EQ. 0 ) THEN
+          IF ( DEBUG ) WRITE(MDEBUG,666) (CURPAR(II),II=1,11)
+ 666      FORMAT(' MAIN  : CURPAR=',1P,11E10.3)
+          GOTO 7
+        ENDIF
+ 
+C  GET NEXT PARTICLE FROM STACK, IF IRET=1 ALL PARTICLES ARE DONE
+  4     CONTINUE
+        IRET1 = 0
+        CALL FSTACK
+        IF ( FMUADD ) THEN
+          IF ( (CURPAR(1) .EQ. 5  .OR.  CURPAR(1) .EQ. 6)
+     *         .AND.  IRET1 .EQ. 0  .AND.  .NOT. FMUORG ) THEN
+            DO J = 1,MAXLEN
+              AMUPAR(J) = CURPAR(J)
+            ENDDO
+            IF(DEBUG)WRITE(MDEBUG,*)'MAIN  : MUON STORED IN AMUPAR'
+            FMUORG = .TRUE.
+          ENDIF
+        ENDIF
+ 
+        IF ( IRET1 .EQ. 0 ) GOTO 7
+ 
+C-----------------------------------------------------------------------
+C  FINISH SHOWER AND PRINT INFORMATION
+        CALL OUTEND
+ 
+ 
+*       IF ( DEBUG ) WRITE(MDEBUG,442) NPARTO
+*442    FORMAT(' MAIN  : NPARTO='/(' ',10F10.0))
+ 
+        IF ( FPRINT .OR. DEBUG ) THEN
+          IOBSLV = MIN( 5, NOBSLV )
+          WRITE(MONIOU,54) (K,K=1,IOBSLV)
+  54      FORMAT (/' PARTICLES AT DETECTOR LEVEL :'/
+     *             ' FOR LEVEL         ', 5I13)
+          WRITE(MONIOU,55) (OBSLEV(K),K=1,IOBSLV)
+  55      FORMAT ( ' HEIGHT IN CM        ',1P, 5E13.3/)
+          WRITE(MONIOU,776) 'PROTONS      ',(NPROTO(K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'ANTIPROTONS  ',(NPROTB(K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'NEUTRONS     ',(NNEUTR(K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'ANTINEUTRONS ',(NNEUTB(K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'PHOTONS      ',(NPHOTO(K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'ELECTRONS    ',(NELECT(K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'POSITRONS    ',(NPOSIT(K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'NEUTRINOS    ',(NNU   (K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'MU -         ',(NMUM  (K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'MU +         ',(NMUP  (K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'PI 0         ',(NPI0  (K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'PI -         ',(NPIM  (K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'PI +         ',(NPIP  (K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'K0L          ',(NK0L  (K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'K0S          ',(NK0S  (K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'K -          ',(NKMI  (K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'K +          ',(NKPL  (K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'STR. BARYONS ',(NHYP  (K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'DEUTERONS    ',(NDEUT (K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'TRITONS      ',(NTRIT (K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'ALPHAS       ',(NALPHA(K),K=1,IOBSLV)
+          WRITE(MONIOU,776) 'OTHER PARTIC.',(NOTHER(K),K=1,IOBSLV)
+          WRITE(MONIOU,*)
+          WRITE(MONIOU,776) 'DECAYED MUONS',MUOND
+ 776      FORMAT(' NO OF ',A13, '= ',5F13.0)
+ 
+          IF ( NOBSLV .GT. 5 ) THEN
+            IOBSLV =  NOBSLV
+            WRITE(MONIOU,54) (K,K=6,IOBSLV)
+            WRITE(MONIOU,55) (OBSLEV(K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'PROTONS      ',(NPROTO(K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'ANTIPROTONS  ',(NPROTB(K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'NEUTRONS     ',(NNEUTR(K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'ANTINEUTRONS ',(NNEUTB(K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'PHOTONS      ',(NPHOTO(K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'ELECTRONS    ',(NELECT(K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'POSITRONS    ',(NPOSIT(K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'NEUTRINOS    ',(NNU   (K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'MU -         ',(NMUM  (K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'MU +         ',(NMUP  (K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'PI 0         ',(NPI0  (K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'PI -         ',(NPIM  (K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'PI +         ',(NPIP  (K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'K0L          ',(NK0L  (K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'K0S          ',(NK0S  (K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'K -          ',(NKMI  (K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'K +          ',(NKPL  (K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'STR. BARYONS ',(NHYP  (K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'DEUTERONS    ',(NDEUT (K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'TRITONS      ',(NTRIT (K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'ALPHAS       ',(NALPHA(K),K=6,IOBSLV)
+            WRITE(MONIOU,776) 'OTHER PARTIC.',(NOTHER(K),K=6,IOBSLV)
+            WRITE(MONIOU,*)
+          ENDIF
+        ENDIF
+ 
+C  ADD UP FOR MEAN VALUES
+        DO 779  K = 1,25
+        DO 779  J = 1,10
+          MPARTO(J,K) = MPARTO(J,K) + NPARTO(J,K)
+          MPART2(J,K) = MPART2(J,K) + NPARTO(J,K)**2
+ 779    CONTINUE
+        EVTE(2) = SHOWNO
+        DO 335  K = 1,NOBSLV
+          EVTE(3) = EVTE(3) + NPHOTO(K)
+          EVTE(4) = EVTE(4) + NELECT(K) + NPOSIT(K)
+          EVTE(5) = EVTE(5) + NPROTO(K) + NPROTB(K) + NNEUTR(K) +
+     *              NNEUTB(K) + NPI0(K) + NPIM(K) + NPIP(K) + NK0L(K) +
+     *              NK0S(K) + NKMI(K) + NKPL(K) + NHYP(K) +
+     *              NDEUT(K) + NTRIT(K) + NALPHA(K) + NOTHER(K)
+          EVTE(6) = EVTE(6) + NMUP(K) + NMUM(K)
+ 335    CONTINUE
+        EVTE(7)   = NOPART
+ 
+        IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,110)
+     *                  IFINNU,IFINPI,IFINET,IFINKA,IFINHY,
+     *                  IFINNU+IFINPI+IFINET+IFINKA+IFINHY,ELAST
+ 110    FORMAT(/' NO OF NUCLEONS  PRODUCED IN FIRST INTERACTION =',I10/
+     *          ' NO OF PIONS     PRODUCED IN FIRST INTERACTION =',I10/
+     *          ' NO OF ETAS      PRODUCED IN FIRST INTERACTION =',I10/
+     *          ' NO OF KAONS     PRODUCED IN FIRST INTERACTION =',I10/
+     *          ' NO OF S.BARYONS PRODUCED IN FIRST INTERACTION =',I10/
+     *          ' TOTAL MULTIPLICITY       OF FIRST INTERACTION =',I10/
+     *        ' ELASTICITY               OF FIRST INTERACTION =',F10.4)
+ 
+C  PRINT OUT NKG RESULT FOR ONE SHOWER IF SELECTED
+        IF ( FNKG ) CALL AVAGE
+ 
+        IF ( LLONGI ) THEN
+C  TREAT LONGITUDINAL DISTRIBUTIONS
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c   calculated here again, 'cos it's rewrite I dont know where
+          LPCT1 = INT( THICK0 * THSTPI )
+          LPCT2 = INT( (THICK0 + PRMPAR(3)*CHI) * THSTPI )
+          LPCT2 = MIN(NSTEP,LPCT2)
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+          DO 980  J = LPCT1,NSTEP
+C  ADD ELECTRONS, POSITRONS, MUONS AND NUCLEI TO THE CHARGED PARTICLES
+            PLONG(J,7) = PLONG(J,7) + PLONG(J,2) + PLONG(J,3)
+     *                 + PLONG(J,4) + PLONG(J,5) + PLONG(J,8)
+C  ADD UP FOR MEAN VALUES OF LONGITUDINAL DISTRIBUTION
+            DO 979  K = 1,9
+              APLONG(J,K) = APLONG(J,K) + PLONG(J,K)
+              SPLONG(J,K) = SPLONG(J,K) + PLONG(J,K)**2
+ 979        CONTINUE
+ 980      CONTINUE
+ 
+C  PRINT LONGITUDINAL DISTRIBUTIONS PER SHOWER
+          IF ( FPRINT .OR. DEBUG )  WRITE(MONIOU,910) THSTEP,
+     *      'GAMMAS','POSITRONS','ELECTRONS','MU-','MU+','HADRONS',
+     *      'CHARGED','NUCLEI','CERENKOV',
+     *      (J*THSTEP,(PLONG(J,K),K=1,9),J=LPCT1,NSTEP)
+ 910      FORMAT(/' ---------- LONGITUDINAL DISTRIBUTION IN STEPS OF ',
+     *        F5.0,' G/CM**2 ----------------'/
+     *        '  DEPTH ',3A12,3A11,A12,A11,A12/
+     *        (' ',F6.0,F13.0,2F12.0,3F11.0,F12.0,F11.0,1P,E12.5,0P) )
+CJOK  ADAPTED FOR HEAT CALCULATION
+C910      FORMAT(/
+C    *    ' LONGITUDINAL DISTRIBUTION IN STEPS OF ',F5.0,' G/CM**2'
+C    *      /' ',92('=')/'  DEPTH',8A10,A12/1P
+C    *      (' ',0P,F6.0,1P,9E11.4))
+CJOK
+ 
+          IF ( FLGFIT ) THEN
+C  PERFORM FIT TO THE LONGITUDINAL DISTRIBUTION OF ALL CHARGED PARTICLES
+C  IF EGS IS SELECTED THIS IS THE DISTRIBUTION WHICH IS TO BE TAKEN
+            IF ( FEGS ) THEN
+              DO 930 J=0,NSTEP-LPCT1
+                DEP(J+1)    = (J+LPCT1)*THSTEP
+                CHAPAR(J+1) = PLONG(J+LPCT1,7)
+ 930          CONTINUE
+              NSTP = NSTEP + 1 - LPCT1
+              WRITE(MONIOU,8229) 'ALL CHARGED PARTICLES'
+ 8229         FORMAT(/' FIT OF THE CURVE   ',
+     *      ' N(T) = P1*((T-P2)/(P3-P2))**((P3-T)/(P4+P5*T+P6*T**2))'/
+     *      ' TO LONGITUDINAL DISTRIBUTION OF ',A35)
+C  IF NKG IS SELECTED ONLY THE ELECTRON DISTRIBUTION IS AVAILABLE
+            ELSEIF ( FNKG ) THEN
+              DEP(1)    = 0.D0
+              CHAPAR(1) = 0.D0
+              DO 931 J = 1,IALT(1)
+                DEP(J+1)    = TLEV(J)
+                CHAPAR(J+1) = SL(J)
+ 931          CONTINUE
+              NSTP = IALT(1) + 1
+              WRITE(MONIOU,8229) 'NKG ELECTRONS'
+C  IF NONE IS SELECTED IT DOES NOT REALLY MAKE SENSE TO FIT
+C  BUT LET'S TAKE THEN ALL CHARGED WHICH ARE MUONS AND HADRONS
+            ELSE
+              DO 932 J=0,NSTEP-LPCT1
+                DEP(J+1)    = (J+LPCT1)*THSTEP
+                CHAPAR(J+1) = PLONG(J+LPCT1,7)
+ 932          CONTINUE
+              NSTP = NSTEP + 1 - LPCT1
+              WRITE(MONIOU,8229) 'MUONS AND CHARGED HADRONS'
+            ENDIF
+            IF ( NSTP .GT. 6 ) THEN
+C  THERE ARE MORE THAN 6 STEP VALUES, A FIT SHOULD BE POSSIBLE.
+C  DO THE FIT: NPAR AND FPARAM GIVE THE NUMBER OF PARAMETERS USED
+C  AND THE FINAL VALUES FOR THE PARAMETERS. CHISQ GIVES THE CHI**2/DOF
+C  FOR THE FIT.
+              CALL LONGFT(FPARAM,CHI2)
+              WRITE(MONIOU,8230) FPARAM,CHI2,CHI2/SQRT(FPARAM(1))*100.D0
+ 8230         FORMAT(' PARAMETERS         = ',1P,6E12.4,0P/
+     *               ' CHI**2/DOF         = ',F10.1/
+     *               ' AV. DEVIATION IN % = ',F10.4)
+C  STORE RESULT IN END EVENT BLOCK
+              DO 933 K = 1,6
+                EVTE(255+K) = FPARAM(K)
+ 933          CONTINUE
+              EVTE(262) = CHI2
+            ELSE
+              WRITE(MONIOU,*) 'NO LONGI. FIT POSSIBLE, ',
+     *          ' NSTP = ',NSTP,'  TOO SMALL.'
+              DO 934 K = 1,6
+                EVTE(255+K) = 0.
+ 934          CONTINUE
+              EVTE(262) = 0.
+            ENDIF
+          ENDIF
+        ENDIF
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c   Saves statistics to sta###### file
+        call jcstadata(EVTH,EVTE,
+     +      NPROTO,NPROTB,NNEUTR,NNEUTB,NPHOTO,NELECT,NPOSIT,
+     +      NNU   ,NMUM  ,NMUP  ,NPI0  ,NPIM  ,NPIP  ,NK0L  ,
+     +      NK0S  ,NKMI  ,NKPL  ,NHYP  ,NDEUT ,NTRIT ,NALPHA,
+     +      NOTHER,IFINNU,IFINPI,IFINET,IFINKA,IFINHY,
+     +      CERELE,CERHAD,PLONG,LPCT1,NSTEP,THSTEP)
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C  WRITE SHOWER END TO OUTPUT BUFFER
+c        CALL TOBUF( EVTE,0 )
+        CALL TOBUF( EVTE,1 )
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+        IF ( LCERFI ) THEN
+          CALL OUTND2
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c          CALL TOBUFC( EVTE,0 )
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+        ENDIF
+ 
+        IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,*)
+     *                 'CERENKOV PH. FROM ELECTRONS = ',SNGL(CERELE),
+     *                 '  CERENKOV PH. FROM HADRONS = ',SNGL(CERHAD)
+        CERELE = 0.D0
+        CERHAD = 0.D0
+        NRECER = 0
+ 
+        IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,210) SHOWNO
+ 210    FORMAT(/'   END OF SHOWER NO ',I10)
+ 
+        DO 19  J = 1,37
+          JNBIN(J) = JNBIN(J) + INBIN(J)
+          JPBIN(J) = JPBIN(J) + IPBIN(J)
+          JKBIN(J) = JKBIN(J) + IKBIN(J)
+          JHBIN(J) = JHBIN(J) + IHBIN(J)
+  19    CONTINUE
+ 
+  2   CONTINUE
+C  END OF SHOWER LOOP
+ 
+C-----------------------------------------------------------------------
+ 992  CONTINUE
+ 
+C  RESET NUMBER OF SHOWERS TO CORRECT VALUE
+      ISHW = I
+ 
+      RUNE(3) = REAL(ISHW)
+C  WRITE RUN END TO OUTPUT BUFFER AND FINISH OUTPUT
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c      CALL TOBUF ( RUNE,1 )
+      call jcendrun(rune)
+c      IF ( LCERFI ) CALL TOBUFC( RUNE,1 )
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+C  TIME SINCE BEGINNING
+c      ILEFTB = TIME()
+      ILEFTB = 1
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      TDIFF  = ILEFTB - ILEFTA
+ 
+C  MEAN VALUE FOR FIRST INTERACTION ALTITUDE (G/CM**2)
+      IF ( ISHW .GT. 1 ) THEN
+        CHISM2 = SQRT( ABS(CHISM2-CHISUM**2/ISHW) / (ISHW-1) )
+        CHISUM = CHISUM / ISHW
+      ELSE
+        CHISM2 = 0.D0
+      ENDIF
+ 
+C  OUTPUTS FOR ALL SHOWERS
+      WRITE(MONIOU,201) ISHW,TDIFF,TDIFF/ISHW,IRECOR,IRECOR/ISHW,
+     *                   CHISUM,CHISM2
+ 201  FORMAT('1',10('='),' RUN SUMMARY ',56('=')//
+     *  ' NUMBER OF GENERATED EVENTS = ',I10,/
+     *  ' TOTAL TIME USED            = ',E10.3,' SEC'/
+     *  ' TIME PER EVENT             = ',E10.3,' SEC'/
+     *  ' TOTAL SPACE ON PATAPE USED = ',I10,' WORDS'/
+     *  ' SPACE PER EVENT ON PATAPE  = ',I10,' WORDS'/
+     *  ' AVERAGE HEIGHT OF 1ST INT. = ',F10.3,' +-',F10.3,' G/CM**2'/)
+ 
+C  ENERGY - MULTIPLICITY MATRIX FOR ALL SHOWERS
+      WRITE(MONIOU,209) (K,K=1,13),
+     *  (J,(MULTOT(J,K),K=1,13),10**((J-4.)/3.),10**((J-3.)/3.),J=1,37),
+     *   1,(INT(10**((K-1.)/3.)+1),K = 2,13),
+     *   2,(INT(10**((K   )/3.)  ),K = 2,13)
+ 209  FORMAT(//' ENERGY - MULTIPLICITY MATRIX FOR ALL SHOWERS'/
+     *       ' ENERGY RUNS VERTICALLY, MULTIPLICITY HORIZONTALLY'//,
+     *       ' ',6X,5I9,3I8,5I7'   ENERGY RANGE (GEV)'/
+     *       37(/' ',I4,1X,I10,4I9,3I8,5I7,1X,1P,2E10.1,0P)//
+     *       ' MULT. ',5I9,3I8,5I7,4X,'LOWER BIN LIMIT'/
+     *       ' RANGE ',5I9,3I8,5I7,4X,'UPPER BIN LIMIT')
+ 
+C  GET MEAN OF ELASTICITY FOR ENERGY BINS
+      DO 3377  J = 1,37
+        NELMEA = 0
+        DO 3378  K = 1,10
+          NELMEA = NELMEA + IELDPA(J,K)
+ 3378   CONTINUE
+        IF ( NELMEA .NE. 0 ) ELMEAA(J) = ELMEAA(J) / NELMEA
+ 3377 CONTINUE
+ 
+C  PRINT ENERGY - ELASTICITY MATRIX FOR ALL SHOWERS
+      WRITE(MONIOU,408) (K,K=1,10),  (J,(IELDPA(J,K),K=1,10),
+     *  ELMEAA(J),10**((J-4.D0)/3.D0),10**((J-3.)/3.D0),J=1,37),
+     *      ((K-1)*0.1D0,K=1,10),(K*0.1D0,K=1,10)
+ 408  FORMAT (//' ENERGY - ELASTICITY MATRIX FOR ALL SHOWERS'/
+     *          ' ENERGY RUNS VERTICALLY, ELASTICITY HORIZONTALLY'//
+     *          ' ',5X,10I9,'   MEAN EL.   ENERGY RANGE (GEV)'/
+     *          37(/' ',I4,1X,10I9,2X,1P,E10.3,2E10.1,0P)//
+     *          ' ELA. ',10F9.2,5X,'LOWER BIN LIMIT'/
+     *          ' RANGE',10F9.2,5X,'UPPER BIN LIMIT')
+ 
+      WRITE(MONIOU,204)
+ 204  FORMAT (//' INTERACTIONS PER KINETIC ENERGY INTERVAL FOR ALL ',
+     *    'SHOWERS'//'   BIN    LOWER LIMIT    UPPER LIMIT     ',
+     *    'NUCLEON     PIONS     KAONS S.BARYONS      TOTAL'/
+     *    12X,'IN GEV',9X,'IN GEV',7X,
+     *     '  EVENTS    EVENTS    EVENTS    EVENTS    '//)
+      WRITE(MONIOU,207) (I,SABIN(I),SBBIN(I),JNBIN(I),JPBIN(I),JKBIN(I)
+     *            ,JHBIN(I),JNBIN(I)+JPBIN(I)+JKBIN(I)+JHBIN(I),I=1,37)
+ 207  FORMAT(' ',I5,1P,2E15.4,0P,I12,3I10,I11)
+ 
+      IF ( .NOT.GHEISH ) THEN
+C  PRINT ELASTICITY STATISTICS
+        WRITE(MONIOU,89) (I,(I-1)*.05,I*.05,
+     *                   IELIS(I),IELHM(I),IELNU(I),IELPI(I),I = 1,20)
+  89    FORMAT (//' ELASTICITY STATISTICS '//
+     *          ' BIN   LOW  HIGH EDGE   FOR ISOBARS     HEAVY MESONS',
+     *          '  SINGLE NUCLEONS        AND PIONS'/
+     *         (' ',I3,'  ',F4.2,'  ',F4.2,'  ',4I17))
+      ENDIF
+ 
+C  CALCULATE MEAN VALUES AND STANDARD DEVIATIONS OF PARTICLE NUMBERS
+      IF ( ISHW .GT. 1 ) THEN
+        DO 879  K = 1,25
+        DO 879  J = 1,NOBSLV
+          MPART2(J,K) = SQRT( abs(MPART2(J,K)-MPARTO(J,K)**2/ISHW)
+     *                                                  /(ISHW-1) )
+          MPARTO(J,K) = MPARTO(J,K)/ISHW
+ 879    CONTINUE
+      ELSE
+        DO 880  K = 1,25
+        DO 880  J = 1,NOBSLV
+          MPART2(J,K) = 0.D0
+ 880    CONTINUE
+      ENDIF
+ 
+C  PRINT MEAN VALUES AND STANDARD DEVIATIONS OF PARTICLE NUMBERS
+      IOBSLV = MIN( 3, NOBSLV )
+      WRITE(MONIOU,854) (K,K=1,IOBSLV)
+ 854  FORMAT (/ ' AVERAGE NUMBER OF PARTICLES PER EVENT :'/
+     *          ' FROM LEVEL NUMBER ', 3(10X,I10,10X) )
+      WRITE(MONIOU,855) (OBSLEV(K),K=1,IOBSLV)
+ 855  FORMAT (  ' HEIGHT IN CM',1P,3(20X,E10.3)/)
+ 
+      WRITE(MONIOU,778)'PROTONS     ',(MPROTO(K),MPROT2(K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'ANTIPROTONS ',(MPROTB(K),MPRTB2(K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'NEUTRONS    ',(MNEUTR(K),MNETR2(K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'ANTINEUTRONS',(MNEUTB(K),MNETB2(K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'PHOTONS     ',(MPHOTO(K),MPHOT2(K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'ELECTRONS   ',(MELECT(K),MELEC2(K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'POSITRONS   ',(MPOSIT(K),MPOSI2(K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'NEUTRINOS   ',(MNU   (K),MNU2  (K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'MU -        ',(MMUM  (K),MMUM2 (K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'MU +        ',(MMUP  (K),MMUP2 (K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'PI 0        ',(MPI0  (K),MPI02 (K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'PI -        ',(MPIM  (K),MPIM2 (K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'PI +        ',(MPIP  (K),MPIP2 (K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'K0L         ',(MK0L  (K),MK0L2 (K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'K0S         ',(MK0S  (K),MK0S2 (K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'K -         ',(MKMI  (K),MKMI2 (K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'K +         ',(MKPL  (K),MKPL2 (K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'STR. BARYONS',(MHYP  (K),MHYP2 (K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'DEUTERONS   ',(MDEUT (K),MDEUT2(K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'TRITONS     ',(MTRIT (K),MTRIT2(K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'ALPHAS      ',(MALPHA(K),MALPH2(K),K=1,IOBSLV)
+      WRITE(MONIOU,778)'OTHER PART. ',(MOTHER(K),MOTH2 (K),K=1,IOBSLV)
+      WRITE(MONIOU,*)
+ 778  FORMAT(' NO OF ',A12,' = ',3(F13.1,' +-',F13.1,' '))
+ 
+      IF ( NOBSLV .GT. 3 ) THEN
+        IOBSLV = MIN( 6, NOBSLV )
+        WRITE(MONIOU,854) (K,K=4,IOBSLV)
+        WRITE(MONIOU,855) (OBSLEV(K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'PROTONS     ',(MPROTO(K),MPROT2(K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'ANTIPROTONS ',(MPROTB(K),MPRTB2(K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'NEUTRONS    ',(MNEUTR(K),MNETR2(K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'ANTINEUTRONS',(MNEUTB(K),MNETB2(K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'PHOTONS     ',(MPHOTO(K),MPHOT2(K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'ELECTRONS   ',(MELECT(K),MELEC2(K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'POSITRONS   ',(MPOSIT(K),MPOSI2(K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'NEUTRINOS   ',(MNU   (K),MNU2  (K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'MU -        ',(MMUM  (K),MMUM2 (K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'MU +        ',(MMUP  (K),MMUP2 (K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'PI 0        ',(MPI0  (K),MPI02 (K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'PI -        ',(MPIM  (K),MPIM2 (K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'PI +        ',(MPIP  (K),MPIP2 (K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'K0L         ',(MK0L  (K),MK0L2 (K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'K0S         ',(MK0S  (K),MK0S2 (K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'K -         ',(MKMI  (K),MKMI2 (K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'K +         ',(MKPL  (K),MKPL2 (K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'STR. BARYONS',(MHYP  (K),MHYP2 (K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'DEUTERONS   ',(MDEUT (K),MDEUT2(K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'TRITONS     ',(MTRIT (K),MTRIT2(K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'ALPHAS      ',(MALPHA(K),MALPH2(K),K=4,IOBSLV)
+        WRITE(MONIOU,778)'OTHER PART. ',(MOTHER(K),MOTH2 (K),K=4,IOBSLV)
+        WRITE(MONIOU,*)
+ 
+        IF ( NOBSLV .GT. 6 ) THEN
+          IOBSLV = MIN( 9, NOBSLV )
+          WRITE(MONIOU,854) (K,K=7,IOBSLV)
+          WRITE(MONIOU,855) (OBSLEV(K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'PROTONS     ',(MPROTO(K),MPROT2(K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'ANTIPROTONS ',(MPROTB(K),MPRTB2(K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'NEUTRONS    ',(MNEUTR(K),MNETR2(K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'ANTINEUTRONS',(MNEUTB(K),MNETB2(K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'PHOTONS     ',(MPHOTO(K),MPHOT2(K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'ELECTRONS   ',(MELECT(K),MELEC2(K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'POSITRONS   ',(MPOSIT(K),MPOSI2(K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'NEUTRINOS   ',(MNU   (K),MNU2  (K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'MU -        ',(MMUM  (K),MMUM2 (K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'MU +        ',(MMUP  (K),MMUP2 (K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'PI 0        ',(MPI0  (K),MPI02 (K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'PI -        ',(MPIM  (K),MPIM2 (K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'PI +        ',(MPIP  (K),MPIP2 (K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'K0L         ',(MK0L  (K),MK0L2 (K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'K0S         ',(MK0S  (K),MK0S2 (K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'K -         ',(MKMI  (K),MKMI2 (K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'K +         ',(MKPL  (K),MKPL2 (K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'STR. BARYONS',(MHYP  (K),MHYP2 (K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'DEUTERONS   ',(MDEUT (K),MDEUT2(K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'TRITONS     ',(MTRIT (K),MTRIT2(K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'ALPHAS      ',(MALPHA(K),MALPH2(K),K=7,IOBSLV)
+        WRITE(MONIOU,778)'OTHER PART. ',(MOTHER(K),MOTH2 (K),K=7,IOBSLV)
+          WRITE(MONIOU,*)
+ 
+          IF ( NOBSLV .GT. 9 ) THEN
+            IOBSLV = MIN( 10, NOBSLV )
+            WRITE(MONIOU,854) (K,K=9,IOBSLV)
+            WRITE(MONIOU,855) (OBSLEV(K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'PROTONS     ',(MPROTO(K),MPROT2(K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'ANTIPROTONS ',(MPROTB(K),MPRTB2(K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'NEUTRONS    ',(MNEUTR(K),MNETR2(K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'ANTINEUTRONS',(MNEUTB(K),MNETB2(K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'PHOTONS     ',(MPHOTO(K),MPHOT2(K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'ELECTRONS   ',(MELECT(K),MELEC2(K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'POSITRONS   ',(MPOSIT(K),MPOSI2(K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'NEUTRINOS   ',(MNU   (K),MNU2  (K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'MU -        ',(MMUM  (K),MMUM2 (K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'MU +        ',(MMUP  (K),MMUP2 (K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'PI 0        ',(MPI0  (K),MPI02 (K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'PI -        ',(MPIM  (K),MPIM2 (K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'PI +        ',(MPIP  (K),MPIP2 (K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'K0L         ',(MK0L  (K),MK0L2 (K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'K0S         ',(MK0S  (K),MK0S2 (K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'K -         ',(MKMI  (K),MKMI2 (K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'K +         ',(MKPL  (K),MKPL2 (K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'STR. BARYONS',(MHYP  (K),MHYP2 (K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'DEUTERONS   ',(MDEUT (K),MDEUT2(K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'TRITONS     ',(MTRIT (K),MTRIT2(K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'ALPHAS      ',(MALPHA(K),MALPH2(K),K=9,IOBSLV)
+        WRITE(MONIOU,778)'OTHER PART. ',(MOTHER(K),MOTH2 (K),K=9,IOBSLV)
+            WRITE(MONIOU,*)
+          ENDIF
+ 
+        ENDIF
+      ENDIF
+ 
+C  PRINT OUT NKG RESULT FOR ALL SHOWERS IF SELECTED
+      IF ( FNKG ) CALL MITAGE
+ 
+C  CALCULATE MEAN VALUES AND SIGMAS OF LONGITUDINAL DISTRIBUTION
+      IF ( LLONGI ) THEN
+        IF ( ISHW .GT. 1 ) THEN
+          DO 790  K = 1,9
+            DO 789  J = LPCT1,NSTEP
+              SPLONG(J,K) = SQRT( abs(SPLONG(J,K)-APLONG(J,K)**2/ISHW)
+     *                                                   /(ISHW-1) )
+              APLONG(J,K) = APLONG(J,K)/ISHW
+ 789        CONTINUE
+ 790      CONTINUE
+        ELSE
+          DO 990  K = 1,9
+            DO 989  J = LPCT1,NSTEP
+              SPLONG(J,K) = 0.D0
+ 989        CONTINUE
+ 990      CONTINUE
+        ENDIF
+ 
+C  PRINT AVERAGE LONGITUDINAL DISTRIBUTIONS
+        WRITE(MONIOU,911) THSTEP,
+     *     'GAMMAS ','POSITRONS','ELECTRONS','MU-  ','MU+  ',
+     *     (J*THSTEP,(APLONG(J,K),SPLONG(J,K),K=1,5),J=LPCT1,NSTEP)
+ 911    FORMAT(/' AVERAGE LONGITUDINAL DISTRIBUTION IN STEPS OF ',
+     *      F5.0,' G/CM**2 '/' ',131('=')/
+     *      ' DEPTH',8X,3(A10,16X),A9,15X,A9 //
+     *     (' ',F5.0,2X,1P,E11.4,'+-',E11.4,0P,1X,F12.0,'+-',F11.0,
+     *                1X,F12.0,'+-',E11.4,1X,F11.1,'+-',F10.1,
+     *                1X,F11.1,'+-',F10.1 ))
+        WRITE(MONIOU,912) THSTEP,
+     *     'HADRONS','CHARGED','NUCLEI','CERENKOV',
+     *     (J*THSTEP,(APLONG(J,K),SPLONG(J,K),K=6,9),J=LPCT1,NSTEP)
+ 912    FORMAT(/' AVERAGE LONGITUDINAL DISTRIBUTION IN STEPS OF ',
+     *      F5.0,' G/CM**2 '/' ',115('=')/
+     *      ' DEPTH',8X,A9,16X,A10,16X,A9,21X,A9 //
+     *     (' ',F5.0,1X,F11.1,'+-',F11.1,1X,F12.0,'+-',F12.0,
+     *                2X,F10.1,'+-',F10.1,1X,1P,E16.6,'+-',E16.6,0P))
+      ENDIF
+ 
+      IF ( FLGFIT ) THEN
+C  PERFORM FIT TO THE LONGITUDINAL DISTRIBUTION OF ALL CHARGED PARTICLES
+C  IF EGS IS SELECTED THIS IS THE DISTRIBUTION WHICH IS TO BE TAKEN
+        IF ( FEGS ) THEN
+          DO 730 J=0,NSTEP-LPCT1
+            DEP(J+1)    = (J+LPCT1)*THSTEP
+            CHAPAR(J+1) = APLONG(J+LPCT1,7)
+ 730      CONTINUE
+          NSTP = NSTEP + 1 - LPCT1
+          WRITE(MONIOU,8229) 'AVERAGE ALL CHARGED PARTICLES'
+C  IF NKG IS SELECTED ONLY THE ELECTRON DISTRIBUTION IS AVAILABLE
+        ELSEIF ( FNKG ) THEN
+          DEP(1)    = 0.D0
+          CHAPAR(1) = 0.D0
+          DO 731 J = 1,IALT(1)
+            DEP(J+1)    = TLEV(J)
+            CHAPAR(J+1) = SEL(J)/ISHW
+ 731      CONTINUE
+          NSTP = IALT(1) + 1
+          WRITE(MONIOU,8229) 'AVERAGE NKG ELECTRONS'
+C  IF NONE IS SELECTED IT DOES NOT REALLY MAKE SENSE TO FIT
+C  BUT LET'S TAKE THEN ALL CHARGED WHICH ARE MUONS AND HADRONS
+        ELSE
+          DO 732 J=0,NSTEP-LPCT1
+            DEP(J+1)    = (J+LPCT1)*THSTEP
+            CHAPAR(J+1) = APLONG(J+LPCT1,7)
+ 732      CONTINUE
+          NSTP = NSTEP + 1 - LPCT1
+          WRITE(MONIOU,8229) 'AVERAGE MUONS AND CHARGED HADRONS'
+        ENDIF
+        IF ( NSTP .GT. 6 ) THEN
+C  THERE ARE MORE THAN 6 STEP VALUES, A FIT SHOULD BE POSSIBLE.
+C  DO THE FIT: NPAR AND FPARAM GIVE THE NUMBER OF PARAMETERS USED
+C  AND THE FINAL VALUES FOR THE PARAMETERS. CHISQ GIVES THE CHI**2/DOF
+C  FOR THE FIT.
+          CALL LONGFT(FPARAM,CHI2)
+          WRITE(MONIOU,8230) FPARAM,CHI2,CHI2/SQRT(FPARAM(1))*100.D0
+        ELSE
+          WRITE(MONIOU,*) 'NO LONGI. FIT POSSIBLE, ',
+     *                      ' NSTP = ',NSTP,'  TOO SMALL.'
+        ENDIF
+      ENDIF
+ 
+ 
+C  CONTROL PRINT OUTPUT OF CONSTANTS
+      IF ( DEBUG ) THEN
+        CALL STAEND
+        WRITE(MDEBUG,*) 'MAIN  : STAEND CALLED'
+      ENDIF
+ 
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      call jcenddata(runh,rune)
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+      WRITE(MONIOU,*)' '
+      CALL PRTIME(TTIME)
+      WRITE(MONIOU,101)
+ 101  FORMAT (/' ',10('='),' END OF RUN ',67('='))
+ 
+C  CLOSE ALL OPEN UNITS
+      IF ( MONIOU .NE. 6 ) CLOSE( MONIOU )
+      IF ( MDEBUG .NE. 6 ) CLOSE( MDEBUG )
+      CLOSE( EXST )
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c      CLOSE( PATAPE )
+c      IF ( LCERFI ) CLOSE( CETAPE )
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ 
+      STOP
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/mitage.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/mitage.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/mitage.f	(revision 286)
@@ -0,0 +1,154 @@
+      SUBROUTINE MITAGE
+ 
+C-----------------------------------------------------------------------
+C  MIT(TELWERT) AGE   (AVERAGE AGE)
+C
+C  CALCULATES AVERAGE DISTRIBUTION FOR NKG FUNCTION OVER ALL SHOWERS
+C  THIS SUBROUTINE IS CALLED FROM MAIN
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEEP,NKGI.
+      COMMON /NKGI/    SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
+     *                 DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
+     *                 OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
+      DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
+     *                 ZSL(10),DIST(10),
+     *                 DISX(-10:10),DISY(-10:10),
+     *                 DISXY(-10:10,2),DISYX(-10:10,2),
+     *                 DLAX (-10:10,2),DLAY (-10:10,2),
+     *                 DLAXY(-10:10,2),DLAYX(-10:10,2),
+     *                 OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
+      INTEGER          IALT(2)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION AJ,ATH,BJ,CJ,DF(10),RISH,SELEC,SELCLG,SJ(10),
+     *                 ZEC,ZECLG,ZSE
+      INTEGER          I,ID,J,K,LI
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'MITAGE:'
+ 
+      WRITE(MONIOU,349) ELCUT(3),ELCUT(4)
+  349 FORMAT(/' ========== NKG - AVERAGE VALUES OF ALL SHOWERS ',
+     *        '==============================='/
+     *   ' ELECTRON/PHOTON THRESHOLDS AT ',F9.4,' /',F9.4,' GEV'//
+     *   ' LEVEL  THICKNESS   HEIGHT      <EL NR>      DEV<EL>',
+     *   '   <LOG(EL NR)>  DEV<LOG(E)>      <AGE>  DEV<AGE>'/
+     *   '  NO.   (G/CM**2)     (M) ' )
+ 
+C  NORMALIZE AVERAGE ELECTRON DENSITIES
+      RISH = 1.D0 / ISHW
+      DO 161  K = 1,2
+        IF ( OBSATI(K) .GE. 0.D0 ) THEN
+          DO 162  ID = -10,10
+            DLAX (ID,K) = DLAX (ID,K) * RISH
+            DLAY (ID,K) = DLAY (ID,K) * RISH
+            DLAXY(ID,K) = DLAXY(ID,K) * RISH
+            DLAYX(ID,K) = DLAYX(ID,K) * RISH
+  162     CONTINUE
+        ENDIF
+  161 CONTINUE
+ 
+      DO 16  LI = 1,IALT(1)
+C  ELECTRON NUMBER <N_E>
+        SELEC   = SEL(LI) * RISH
+C  LOG10 ELECTRON NUMBER <N_E>
+        SELCLG  = SELLG(LI) * RISH
+C  <S_....> AVERAGE LONGITUDINAL AGE
+        ATH     = STH(LI) * RISH
+        IF ( ISHW .GT. 1 ) THEN
+C  ELECTRON NUMBER <N_E>
+          ZEC   = SQRT( abs(ZEL(LI) - SEL(LI)**2*RISH)/(ISHW-1.D0) )
+C  LOG10 ELECTRON NUMBER <N_E>
+          ZECLG = SQRT( abs(ZELLG(LI) - SELLG(LI)**2*RISH)/(ISHW-1.D0) )
+C  <S_....> AVERAGE LONGITUDINAL AGE
+          ZSE   = SQRT( abs(ZSL(LI)-STH(LI)**2*RISH)/(ISHW-1.D0) )
+        ELSE
+          ZEC   = 0.D0
+          ZECLG = 0.D0
+          ZSE   = 0.D0
+        ENDIF
+C  WRITE ELECTRON INFORMATION FOR ALL NKG LEVELS (LONG. DEVELOPMENT)
+        WRITE(MONIOU,219) LI,TLEV(LI),TLEVCM(LI)*0.01,
+     *                       SELEC,ZEC,SELCLG,ZECLG,ATH,ZSE
+  219   FORMAT (' ',I4,F10.0,F11.2,1X,2F12.0,3X,2F12.5,F13.3,F9.3)
+  16  CONTINUE
+ 
+      DO 520  K = 1,2
+        IF ( OBSATI(K) .LT. 0.D0 ) GOTO 520
+C  DETERMINE LOCAL AGE PARAMETER
+        DO 50  J = 1,9
+          IF ( DLAX(J+1,K).GT.0.D0  .AND.  DLAX(-J-1,K).GT.0.D0  .AND.
+     *         DLAXY(J+1,K).GT.0.D0  .AND.  DLAXY(-J-1,K).GT.0.D0  .AND.
+     *         DLAYX(J+1,K).GT.0.D0  .AND.  DLAYX(-J-1,K).GT.0.D0  .AND.
+     *         DLAY(J+1,K).GT.0.D0  .AND.  DLAY(-J-1,K).GT.0.D0 ) THEN
+            AJ = 0.125D0 * (
+     *           DLAX(J,K) /DLAX(J+1,K)  + DLAX(-J,K) /DLAX(-J-1,K)
+     *         + DLAXY(J,K)/DLAXY(J+1,K) + DLAXY(-J,K)/DLAXY(-J-1,K)
+     *         + DLAYX(J,K)/DLAYX(J+1,K) + DLAYX(-J,K)/DLAYX(-J-1,K)
+     *         + DLAY(J,K) /DLAY(J+1,K)  + DLAY(-J,K) /DLAY(-J-1,K))
+          ELSE
+            AJ = 0.D0
+          ENDIF
+          IF ( AJ .GT. 0.D0 ) THEN
+            BJ    = DIST(J) / DIST(J+1)
+            CJ    = (DIST(J)+RMOL(K)) / (DIST(J+1)+RMOL(K))
+            SJ(J) = LOG(AJ * BJ**2 * CJ**4.5D0) / LOG(BJ * CJ)
+            DF(J) = 0.5D0* (DIST(J) + DIST(J+1))
+          ELSE
+            SJ(J) = 0.D0
+            DF(J) = 0.D0
+          ENDIF
+  50    CONTINUE
+ 
+C  WRITE LOCAL AGE PARAMETER
+        WRITE(MONIOU,60) K,OBSATI(K), (I,DF(I),SJ(I),I=1,9)
+  60    FORMAT(/' RADIAL BIN  DISTANCE(CM)  LOCAL AGE AT LEVEL NO.',
+     *          I4,' AT HEIGHT:',F10.0,' CM'/
+     *         (' ',I9,'   ',F10.0,'  ',F10.3 ) )
+ 
+C  WRITE LATERAL ELECTRON DISTRIBUTION
+        WRITE(MONIOU,507) K,OBSATI(K)
+ 507    FORMAT(/' AVERAGE ELECTRON DENSITY (/CM**2)  FOR LEVEL NO.',
+     *         I4,' AT HEIGHT:',F10.0,' CM'/
+     *         ' ==================================================',
+     *         '=========================='/
+     *         '  DIST (CM)       DLAX           DLAY    ',
+     *         '       DLAXY          DLAYX')
+        WRITE(MONIOU,508) (DISX(I),DLAX(I,K),DLAY(I,K),
+     *                     DLAXY(I,K),DLAYX(I,K),I=-10,10)
+  508   FORMAT(' ',0P,F10.0,1P,4E15.5)
+ 
+ 
+  520 CONTINUE
+ 
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/mmol4.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/mmol4.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/mmol4.f	(revision 286)
@@ -0,0 +1,75 @@
+      SUBROUTINE MMOL4(Y,X,VAL,ARG,EPS,IER)
+ 
+C-----------------------------------------------------------------------
+C  M(UON) MOL(IERE SCATTERING) 4 (POINT CONTINUED FRACT. INTERPOLATION)
+C
+C  ROUTINE TAKEN FROM IBM SCIENTIFIC SUBROUTINE PACKAGE
+C  ROUTINE TAKEN FROM GEANT321 (CERN)
+C  4 POINT CONTINUED FRACTION INTERPOLATION
+C  THIS SUBROUTINE IS CALLED FROM MMOLIE
+C  ARGUMENTS:
+C   Y     = INTERPOLATED VALUE FOR THE ARGUMENT X
+C   X     = ARGUMENT FOR Y
+C   VAL   = VALUE ARRAY
+C   ARG   = ARGUMENT ARRAY
+C   EPS   = DESIRED ACCURACY
+C   IER   = OUTPUT ERROR PARAMETER
+C            0 ACCURACY O.K.
+C            1 ACCURACY CAN NOT BE TESTED IN 4TH ORDER INTERPOLATION
+C            2 TWO IDENTICAL ELEMENTS IN THE ARGUMENT ARRAY
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT  NONE
+      REAL      ARG(4),AUX,DELT,EPS,H,P1,P2,P3,Q1,Q2,Q3,VAL(4),X,Y,Z
+      INTEGER   I,II,III,IER,J,JEND
+C-----------------------------------------------------------------------
+ 
+      IER = 1
+      Y   = VAL(1)
+      P2  = 1.
+      P3  = Y
+      Q2  = 0.
+      Q3  = 1.
+      DO 16 I = 2,4
+        II = 0
+        P1 = P2
+        P2 = P3
+        Q1 = Q2
+        Q2 = Q3
+        Z  = Y
+        JEND = I - 1
+   3    AUX  = VAL(I)
+        DO 10 J = 1,JEND
+          H = VAL(I) - VAL(J)
+          IF ( ABS(H) .GT. 1.E-6*ABS(VAL(I)) ) GOTO 9
+          IF ( ARG(I) .EQ. ARG(J) ) GOTO 17
+          IF ( J .LT. JEND ) GOTO 8
+          II  = II + 1
+          III = I + II
+          IF ( III .GT. 4 ) GOTO 19
+          VAL(I)   = VAL(III)
+          VAL(III) = AUX
+          AUX      = ARG(I)
+          ARG(I)   = ARG(III)
+          ARG(III) = AUX
+          GO TO 3
+   8      VAL(I) = 1.E36
+          GO TO 10
+   9      VAL(I) = ( ARG(I)-ARG(J) ) / H
+  10    CONTINUE
+        P3 = VAL(I) * P2 + ( X - ARG(I-1) ) * P1
+        Q3 = VAL(I) * Q2 + ( X - ARG(I-1) ) * Q1
+        IF ( Q3. NE. 0. ) THEN
+          Y = P3 / Q3
+        ELSE
+          Y = 1.E36
+        ENDIF
+        DELT = ABS(Z-Y)
+        IF ( DELT .LE. EPS ) GOTO 19
+  16  CONTINUE
+      RETURN
+  17  IER = 2
+      RETURN
+  19  IER = 0
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/mmolie.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/mmolie.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/mmolie.f	(revision 286)
@@ -0,0 +1,190 @@
+      SUBROUTINE MMOLIE(OMEGA,DENS,VSCAT)
+ 
+C-----------------------------------------------------------------------
+C   M(UON) MOLIE(RE MULTIPLE SCATTERING)
+C
+C  TREATES MOLIERE MULTIPLE SCATTERING FOR MUONS
+C  CORRECTED FOR FINITE ANGLE SCATTERING
+C  THIS SUBROUTINE IS IN ANALOGY WITH SUBROUTINE GMOLIE
+C  (AUTHOR: M.S.DIXIT, NRCC, OTTAWA) OF GEANT321
+C  SEE CERN PROGRAM LIBRARY LONG WRITEUP W5013
+C  THIS SUBROUTINE IS CALLED FROM UPDATE
+C  ARGUMENTS:
+C   OMEGA = NUMBER OF SCATTERINGS FOR THE STEP
+C   DENS  = LOCAL DENSITY
+C   VSCAT = SCATTERING ANGLE
+C
+C  REDESIGN: D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,MUMULT.
+      COMMON /MUMULT/  CHC,OMC,FMOLI
+      DOUBLE PRECISION CHC,OMC
+      LOGICAL          FMOLI
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION TINT(40),B,BINV,CHIC,CNST,DB,DENS,OMEGA,SINTH,
+     *                 TEST,TMP,VSCAT
+      REAL             ARG(4),F0I(40),F1I(40),F2I(40),
+     *                 THRED(40),VAL(4),DIN(3),F,THRI,XINT
+      INTEGER          IER,JA,L,M,NA,NA3,NA3M,NMAX
+      DATA THRED/  0.00, 0.10, 0.20, 0.30
+     +          ,  0.40, 0.50, 0.60, 0.70
+     +          ,  0.80, 0.90, 1.00, 1.10
+     +          ,  1.20, 1.30, 1.40, 1.50
+     +          ,  1.60, 1.70, 1.80, 1.90
+     +          ,  2.00, 2.20, 2.40, 2.60
+     +          ,  2.80, 3.00, 3.20, 3.40
+     +          ,  3.60, 3.80, 4.00, 5.00
+     +          ,  6.00, 7.00, 8.00, 9.00
+     +          , 10.00,11.00,12.00,13.00 /
+      DATA F0I/
+     +  0.000000E+00 ,0.995016E-02 ,0.392106E-01 ,0.860688E-01
+     + ,0.147856E+00 ,0.221199E+00 ,0.302324E+00 ,0.387374E+00
+     + ,0.472708E+00 ,0.555142E+00 ,0.632121E+00 ,0.701803E+00
+     + ,0.763072E+00 ,0.815480E+00 ,0.859142E+00 ,0.894601E+00
+     + ,0.922695E+00 ,0.944424E+00 ,0.960836E+00 ,0.972948E+00
+     + ,0.981684E+00 ,0.992093E+00 ,0.996849E+00 ,0.998841E+00
+     + ,0.999606E+00 ,0.999877E+00 ,0.999964E+00 ,0.999990E+00
+     + ,0.999998E+00 ,0.999999E+00 ,0.100000E+01 ,0.100000E+01
+     + ,0.100000E+01 ,0.100000E+01 ,0.100000E+01 ,0.100000E+01
+     + ,1.000000E+00 ,1.000000E+00 ,1.000000E+00 ,1.000000E+00 /
+      DATA F1I/
+     +   0.000000E+00, 0.414985E-02, 0.154894E-01, 0.310312E-01
+     + , 0.464438E-01, 0.569008E-01, 0.580763E-01, 0.468264E-01
+     + , 0.217924E-01,-0.163419E-01,-0.651205E-01,-0.120503E+00
+     + ,-0.178272E+00,-0.233580E+00,-0.282442E+00,-0.321901E+00
+     + ,-0.350115E+00,-0.366534E+00,-0.371831E+00,-0.367378E+00
+     + ,-0.354994E+00,-0.314803E+00,-0.266539E+00,-0.220551E+00
+     + ,-0.181546E+00,-0.150427E+00,-0.126404E+00,-0.107830E+00
+     + ,-0.933106E-01,-0.817375E-01,-0.723389E-01,-0.436650E-01
+     + ,-0.294700E-01,-0.212940E-01,-0.161406E-01,-0.126604E-01
+     + ,-0.102042E-01,-0.840465E-02,-0.704261E-02,-0.598886E-02/
+      DATA F2I/
+     +   0.000000    , 0.121500E-01, 0.454999E-01, 0.913000E-01
+     + , 0.137300E+00, 0.171400E+00, 0.183900E+00, 0.170300E+00
+     + , 0.132200E+00, 0.763000E-01, 0.126500E-01,-0.473500E-01
+     + ,-0.936000E-01,-0.119750E+00,-0.123450E+00,-0.106300E+00
+     + ,-0.732800E-01,-0.312400E-01, 0.128450E-01, 0.528800E-01
+     + , 0.844100E-01, 0.114710E+00, 0.106200E+00, 0.765830E-01
+     + , 0.435800E-01, 0.173950E-01, 0.695001E-03,-0.809500E-02
+     + ,-0.117355E-01,-0.125449E-01,-0.120280E-01,-0.686530E-02
+     + ,-0.385275E-02,-0.231115E-02,-0.147056E-02,-0.982480E-03
+     + ,-0.682440E-03,-0.489715E-03,-0.361190E-03,-0.272582E-03/
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*)'MMOLIE: OMEGA=',SNGL(OMEGA),
+     *                                    ' DENS=',SNGL(DENS)
+ 
+C  COMPUTE VSCAT ANGLE FROM MOLIERE DISTRIBUTION
+      VSCAT = 0.D0
+      IF ( OMEGA .LE. ENEPER ) RETURN
+      CNST  = LOG(OMEGA)
+      B     = 5.D0
+      DO 10 L = 1,10
+        IF ( ABS(B) .LT. 1.D-10 ) THEN
+          B = 1.D-10
+        ENDIF
+        DB = - (B - LOG(ABS(B)) - CNST)/(1.D0 - 1.D0/B)
+        B  = B + DB
+        IF ( ABS(DB) .LE. 0.0001D0 ) GOTO 20
+ 10   CONTINUE
+      RETURN
+ 20   CONTINUE
+      IF ( B .LE. 0.D0 ) RETURN
+C  CHC IS DEFINED DIFFERENTLY FROM GEANT
+      CHIC = CHC*SQRT(CHI)/(PAMA(5)*GAMMA*BETA**2)
+      BINV = 1.D0/B
+      TINT(1) = 0.D0
+      DO 30   JA = 2,4
+        TINT(JA) = F0I(JA) + ( F1I(JA) + F2I(JA)*BINV ) * BINV
+ 30   CONTINUE
+      NMAX = 4
+ 40   CONTINUE
+      CALL RMMAR(RD,2,1)
+      XINT = RD(2)
+      DO 50 NA = 3,40
+        IF ( NA .GT. NMAX ) THEN
+          TINT(NA) = F0I(NA) + ( F1I(NA) + F2I(NA)*BINV ) * BINV
+          NMAX = NA
+        ENDIF
+        IF ( XINT .LE. TINT(NA-1) ) GOTO 60
+ 50   CONTINUE
+      IF ( XINT .LE. TINT(40) ) THEN
+        NA = 40
+        GOTO 60
+      ELSE
+        TMP  = 1.D0 - ( 1.D0 - B*(1.D0-XINT) )**5
+        IF ( TMP .LE. 0.D0 ) GOTO 40
+        THRI = 5.D0 / TMP
+        GOTO 80
+      ENDIF
+ 60   CONTINUE
+      NA  = MAX(NA-1,3)
+      NA3 = NA-3
+      DO 70 M = 1,4
+        NA3M   = NA3 + M
+        ARG(M) = TINT(NA3M)
+        VAL(M) = THRED(NA3M)**2
+ 70   CONTINUE
+      F = THRED(NA) * .02D0
+      CALL MMOL4(THRI,XINT,VAL,ARG,F,IER)
+ 80   CONTINUE
+      VSCAT = CHIC * SQRT( ABS(B*THRI) )
+      IF ( VSCAT .GT. PI ) GOTO 40
+      SINTH = SIN(VSCAT)
+      TEST  = VSCAT * (RD(1))**2
+      IF ( TEST .GT. SINTH ) GOTO 40
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/moller.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/moller.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/moller.f	(revision 286)
@@ -0,0 +1,104 @@
+      SUBROUTINE MOLLER
+C                                VERSION 4.00  --  26 JAN 1986/1900
+C******************************************************************
+C   DISCRETE MOLLER SCATTERING (A CALL TO THIS ROUTINE) HAS BEEN
+C   ARBITRARILY DEFINED AND CALCULATED TO MEAN MOLLER SCATTERINGS
+C   WHICH IMPART TO THE SECONDARY ELECTRON SUFFICIENT ENERGY THAT
+C   IT BE TRANSPORTED DISCRETELY.  THE THRESHOLD TO TRANSPORT AN
+C   ELECTRON DISCRETELY IS A TOTAL ENERGY OF AE OR A KINETIC ENERGY
+C   OF TE=AE-RM.  SINCE THE KINETIC ENERGY TRANSFER IS ALWAYS, BY
+C   DEFINITION, LESS THAN HALF OF THE INCIDENT KINETIC ENERGY, THIS
+C   IMPLIES THAT THE INCIDENT ENERGY, EIE, MUST BE LARGER THAN
+C   THMOLL=TE*2+RM.  THE REST OF THE COLLISION CONTRIBUTION IS
+C   SUBTRACTED CONTINUOUSLY FROM THE ELECTRON AS IONIZATION
+C   LOSS DURING TRANSPORT.
+C******************************************************************
+      DOUBLE PRECISION PEIE,PEKSE2,PESE1,PESE2
+      DOUBLE PRECISION PEKIN,H1,DCOSTH,PEKINI
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' MOLLER:NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      PEIE=E(NP)
+      EIE=PEIE
+      PEKIN=PEIE-PRM
+      EKIN=PEKIN
+      PEKINI=1./PEKIN
+      EKINI=PEKINI
+      T0=EKIN*RMI
+      E0=T0+1.0
+      EXTRAE = EIE - THMOLL
+      E02=E0*E0
+      BETAI2=E02/(E02-1.0)
+      EP0=TE*EKINI
+      G1=(1.-2.*EP0)*BETAI2
+      G2=T0*T0*(1./E02)
+      G3=(2.*T0+1.)*(1./E02)
+931   CONTINUE
+       CALL RMMAR(RD,2,2)
+       RNNO27=RD(1)
+       RNNO28=RD(2)
+       BR = TE/(EKIN-EXTRAE*RNNO27)
+       R=BR/(1.-BR)
+       REJF4=G1*(1.+G2*BR*BR+R*(R-G3))
+       IF((RNNO28.LE.REJF4))GO TO932
+      GO TO 931
+932   CONTINUE
+      PEKSE2=BR*EKIN
+      PESE1=PEIE-PEKSE2
+      PESE2=PEKSE2+PRM
+      E(NP)=PESE1
+      E(NP+1)=PESE2
+      H1=(PEIE+PRM)*PEKINI
+      DCOSTH=MIN(H1*(PESE1-PRM)/(PESE1+PRM),1.D0)
+      SINTHE=SQRT(1.D0-DCOSTH)
+      COSTHE=SQRT(DCOSTH)
+      CALL UPHI(2,1)
+      NP=NP+1
+      IQ(NP)=3
+      DCOSTH=MIN(H1*(PESE2-PRM)/(PESE2+PRM),1.D0)
+      SINTHE=-SQRT(1.D0-DCOSTH)
+      COSTHE=SQRT(DCOSTH)
+      CALL UPHI(3,2)
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/mpoiss.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/mpoiss.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/mpoiss.f	(revision 286)
@@ -0,0 +1,80 @@
+      SUBROUTINE MPOISS(AMEAN,NPRAN)
+ 
+C-----------------------------------------------------------------------
+C   M(UON COULOMB SCATTERING) POISS(ON DISTRIBUTION)
+C
+C  GENERATES A RANDOM NUMBER POISSON DISTRIBUTED WITH MEAN VALUE AMEAN.
+C  THIS SUBROUTINE IS IN ANALOGY WITH SUBROUTINE GPOISS.
+C  (AUTHOR: L. URBAN) OF GEANT321
+C  SEE CERN PROGRAM LIBRARY LONG WRITEUP W5013.
+C  THIS SUBROUTINE IS CALLED FROM MUCOUL
+C  ARGUMENTS:
+C   AMEAN =  MEAN VALUE OF RANDOM NUMBER
+C   NPRAN =  RANDOM NUMBER POISSON DISTRIBUTED
+C
+C  REDESIGN: D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION AMEAN,AN,HMXINT,P,PLIM,RR,S,X
+      INTEGER          NPRAN
+      DATA             PLIM/16.D0/,HMXINT/2.D9/
+C-----------------------------------------------------------------------
+ 
+C  PROTECTION AGAINST NEGATIVE MEAN VALUES
+      AN = 0.D0
+      IF ( AMEAN .GT. 0.D0 ) THEN
+        IF ( AMEAN .LE. PLIM ) THEN
+          CALL RMMAR(RD,1,1)
+          P = EXP(-AMEAN)
+          S = P
+          IF ( RD(1) .LE. S ) GOTO 20
+ 10       AN = AN + 1.D0
+          P = P * AMEAN / AN
+          S = S + P
+          IF ( S .LT. RD(1)  .AND.  P .GT. 1.D-30 ) GOTO 10
+        ELSE
+          CALL RMMAR(RD,2,1)
+          RR  = SQRT( -2.D0*LOG(RD(1)) )
+          X = RR * COS( PI2 * RD(2) )
+          AN = MIN( MAX( AMEAN+X*SQRT(AMEAN), 0.D0 ), HMXINT )
+        ENDIF
+      ENDIF
+ 20   NPRAN = AN
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/mpprop.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/mpprop.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/mpprop.f	(revision 286)
@@ -0,0 +1,110 @@
+      SUBROUTINE MPPROP
+C
+C*********************************************************************
+C  DESIGN  : D. HECK   IK3  FZK KARLSRUHE
+C  DATE    : JUL  14, 1989
+C*********************************************************************
+C  SUBROUTINE MOVES MUONS AND PIONS FROM EGS-STACK TO CORSIKA-STACK.
+C*********************************************************************
+      DOUBLE PRECISION AMASS
+C     DOUBLE PRECISION CUT
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEND.
+      DOUBLE PRECISION PRRMMU
+      COMMON/MUON/PRRMMU,RMMU,RMMUT2
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEND.
+      DOUBLE PRECISION PI0MSQ
+      COMMON/PION/PI0MSQ,PITHR,PICMAS,PI0MAS,AMASK0,AMASKC,AMASPR,AMASNT
+     *
+*KEEP,POLAR.
+      COMMON /POLAR/   POLART,POLARF
+      DOUBLE PRECISION POLART,POLARF
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' MPPROP:NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+C***  SET MASS AND CUT PARAMETER OF PARTICLE UNDER CONSIDERATION
+      IF (IQ(NP).LT.7) THEN
+       AMASS=PRRMMU
+C      CUT=ELCUT(2)*1000.D0
+      ELSEIF(IQ(NP).EQ.7) THEN
+       AMASS=PI0MAS
+C      CUT=ELCUT(1)*1000.D0
+       POLART=1.D0
+       POLARF=0.D0
+      ELSE
+       AMASS=PICMAS
+C      CUT=ELCUT(1)*1000.D0
+       POLART=1.D0
+       POLARF=0.D0
+      END IF
+C***  USE PARTICLE ONLY IF ABOVE CUT AND INSIDE ACCEPTANCE CONE
+C     IF (E(NP)-AMASS.GT.CUT .AND. W(NP).GT.C(29)) THEN
+      IF (W(NP).GT.C(29)) THEN
+C *** ANGLE WITH RESPECT TO X AXIS
+       IF (U(NP)**2+V(NP)**2.GT.3.E-38) THEN
+        ANGLEX = -ATAN2(V(NP),U(NP))
+       ELSE
+        ANGLEX = 0.
+       END IF
+C ***  FILL MUON/PION COORDINATES INTO CORSIKA-STACK
+       SECPAR(1)=IQ(NP)
+       SECPAR(2)=E(NP)/AMASS
+       SECPAR(3)=W(NP)
+       SECPAR(4)=ANGLEX
+       SECPAR(5)=-Z(NP)
+       SECPAR(6)=TIME(NP)
+       SECPAR(7)=X(NP)
+       SECPAR(8)=-Y(NP)
+       SECPAR(9)=IGEN(NP)
+       SECPAR(10)=-Z(NP)
+       SECPAR(11)=POLART
+       SECPAR(12)=POLARF
+C ***  ADD MUON/PION TO CORSIKA-STACK
+       CALL TSTOUT
+      END IF
+C***  ELIMINATE MUON/PION FROM EGS-STACK
+      POLART=-POLART
+      POLARF=POLARF+PI
+      NP=NP-1
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/mscat.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/mscat.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/mscat.f	(revision 286)
@@ -0,0 +1,148 @@
+      SUBROUTINE MSCAT
+C                                VERSION 4.00  --  26 JAN 1986/1900
+C******************************************************************
+      COMMON/ELECIN/EKELIM,ICOMP,EKE0,EKE1,CMFP0,CMFP1,RANGE0,RANGE1, XR
+     *0,TEFF0,BLCC,XCC,PICMP0(1),PICMP1(1),EICMP0(1),EICMP1(1),MPEEM(1),
+     * ESIG0(500),ESIG1(500),PSIG0(500),PSIG1(500),EDEDX0(500),EDEDX1(50
+     *0),PDEDX0(500),PDEDX1(500),EBR10(500),EBR11(500),PBR10(500),PBR11(
+     *500),PBR20(500),PBR21(500),TMXS0(500),TMXS1(500),CMFPE0(1),CMFPE1(
+     *1),CMFPP0(1),CMFPP1(1),ERANG0(1),ERANG1(1),PRANG0(1),PRANG1(1),CXC
+     *2E0(1),CXC2E1(1),CXC2P0(1),CXC2P1(1),CLXAE0(1),CLXAE1(1),CLXAP0(1)
+     *,CLXAP1(1), THR0(1,1),THR1(1,1),THR2(1,1),THRI0(1,1),THRI1(1,1),TH
+     *RI2(1,1),FSTEP(16),FSQR(16),MSMAP(200), VERT1(1000),VERT2(100,16),
+     *MSTEPS,JRMAX,MXV1, MXV2,NBLC,NRNTH,NRNTHI,BLC0,BLC1,RTHR0,RTHR1,RT
+     *HRI0,RTHRI1
+*KEEP,EPCONT.
+      COMMON/EPCONT/   EDEP,RATIO,TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,IDISC,
+     *                 IROLD,IRNEW,RHOFAC, EOLD,ENEW,EKE,ELKE,BETA2,GLE,
+     *                 TSCAT,IAUSFL
+      DOUBLE PRECISION EDEP,RATIO
+      REAL             TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,RHOFAC,EOLD,ENEW,
+     *                 EKE,ELKE,BETA2,GLE,TSCAT
+      INTEGER          IDISC,IROLD,IRNEW,IAUSFL(29)
+*KEND.
+      COMMON/MISC/KMPI,KMPO,DUNIT,NOSCAT,MED(6),RHOR(6),IRAYLR(6)
+      COMMON/MULTS/NG21,B0G21,B1G21,G210(7),G211(7),G212(7), NG22,B0G22,
+     *B1G22,G220(8),G221(8),G222(8), NG31,B0G31,B1G31,G310(11),G311(11),
+     *G312(11), NG32,B0G32,B1G32,G320(25),G321(25),G322(25), NBGB,B0BGB,
+     *B1BGB,BGB0(8),BGB1(8),BGB2(8)
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
+      COMMON/UPHIIN/SINC0,SINC1,SIN0(20002),SIN1(20002)
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' MSCAT: NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      VSTEFF=TVSTEP*RHOFAC
+      OMEGA0=BLCC*VSTEFF/BETA2
+      IF ((OMEGA0.LE.1.0)) THEN
+       SINTHE=0.0
+       COSTHE=1.0
+       THETA=0.0
+       NOSCAT=NOSCAT+1
+       RETURN
+      END IF
+      BLC=LOG(OMEGA0)
+      IF (BLC.LE.1.30685) THEN
+       B=1.530394*BLC
+      ELSE
+       IB=B0BGB+BLC*B1BGB
+       IF (IB.GT.NBGB) THEN
+        WRITE(KMPO,940)IB
+940     FORMAT('MSCAT: NBGB<IB=',I5)
+       END IF
+       B=BGB0(IB)+BLC*(BGB1(IB)+BLC*BGB2(IB))
+      END IF
+      XR=XCC*SQRT(MAX(0.,VSTEFF*B))/(EOLD*BETA2)
+      IF (B.GT.2.0) THEN
+       BI=1./B
+       BMD=1./(1.0+1.75*BI)
+       BM1=(1.0-2.0*BI)*BMD
+       BM2=(1.0+0.025*BI)*BMD
+      ELSE
+       BI=0.5
+       BM1=(1.-2./B)*0.53333333
+       BM2=0.54
+      END IF
+951   CONTINUE
+       CALL RMMAR(RMS1,1,2)
+       IF (RMS1.LE.BM1) THEN
+        CALL RMMAR(RMS2,1,2)
+        IF((RMS2.EQ.0.0))RMS2=1.E-30
+        THR=SQRT(MAX(0.,-LOG(RMS2)))
+       ELSE IF((RMS1.LE.BM2)) THEN
+        CALL RMMAR(RD,3,2)
+        RMS3=RD(1)
+        RMS4=RD(2)
+        RMS5=RD(3)
+        ETA=MAX(RMS3,RMS4)
+        I31=B0G31+ETA*B1G31
+        G31=G310(I31)+ETA*(G311(I31)+ETA*G312(I31))
+        I32=B0G32+ETA*B1G32
+        G32=G320(I32)+ETA*(G321(I32)+ETA*G322(I32))
+        G3=G31+G32*BI
+        IF((RMS5.GT.G3))GO TO951
+        THR=1.0/ETA
+       ELSE
+        CALL RMMAR(RD,2,2)
+        RMS6=RD(1)
+        RMS7=RD(2)
+        THR=RMS6
+        I21=B0G21+THR*B1G21
+        G21=G210(I21)+THR*(G211(I21)+THR*G212(I21))
+        I22=B0G22+THR*B1G22
+        G22=G220(I22)+THR*(G221(I22)+THR*G222(I22))
+        G2=G21+G22*BI
+        IF((RMS7.GT.G2))GO TO951
+       END IF
+       THETA=THR*XR
+       IF((THETA.GE.PI))GO TO951
+       LTHETA=SINC1*THETA+SINC0
+       SINTHE=SIN1(LTHETA)*THETA+SIN0(LTHETA)
+       CALL RMMAR(RMS8,1,2)
+       IF(((RMS8*RMS8*THETA.LE.SINTHE)))GO TO952
+      GO TO 951
+952   CONTINUE
+      CTHET=PI5D2-THETA
+      LCTHET=SINC1*CTHET+SINC0
+      COSTHE=SIN1(LCTHET)*CTHET+SIN0(LCTHET)
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/mubrem.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/mubrem.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/mubrem.f	(revision 286)
@@ -0,0 +1,189 @@
+      SUBROUTINE MUBREM
+ 
+C-----------------------------------------------------------------------
+C  MU(ON) BREM(SSTRAHLUNG)
+C
+C  TREATES MUON BREMSSTRAHLUNG (WITHOUT POLARISATION EFFECTS)
+C  IN ANALOGY WITH SUBROUTINE GBREMM FROM GEANT WRITTEN BY L. URBAN
+C  EXPLANATIONS SEE CERN PROGRM LIBRARY LONG WRITEUP W5013
+C  THIS SUBROUTINE IS CALLED FROM MUTRAC
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,MUPART.
+      COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
+      DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
+      LOGICAL          FMUBRM,FMUORG
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,POLAR.
+      COMMON /POLAR/   POLART,POLARF
+      DOUBLE PRECISION POLART,POLARF
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,REST.
+      COMMON /REST/    CONTNE,TAR,LT
+      DOUBLE PRECISION CONTNE(3),TAR
+      INTEGER          LT
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION ALFA1,AUXIL,BETA1,COSTH3,COSTH4,CREJ,D,F1,
+     *                 EKIN,EMUON,PHI3,SCREJ,SINTH3,THETA3,U,UMAX,
+     *                 V,VC,VM,V1,W1,Z
+      INTEGER          I
+      DATA             ALFA1/0.625D0/
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' MUBREM: CURPAR=',1P,9E10.3)
+ 
+C  COPY COORDINATES TO SECPAR
+      DO 11 I = 5,8
+        SECPAR(I) = CURPAR(I)
+ 11   CONTINUE
+      SECPAR( 9)  = GEN
+C  TOTAL AND KINETIC ENERGY OF MUON
+      EMUON = PAMA(5) * GAMMA
+      EKIN  = EMUON - PAMA(5)
+      IF ( EKIN .LE. BCUT ) THEN
+C   MUON ENERGY IS TOO LOW TO PRODUCE BREMSSTRAHLUNG
+        SECPAR(2) = CURPAR(2)
+        GOTO 900
+      ENDIF
+      VC = BCUT/EMUON
+      VM = 1.D0 - CMUON(6+LT)/EMUON
+      IF ( VM .LE. 0.D0 ) THEN
+C  MAXIMUM OF BREMSSTRAHLUNG SPECTRUM IS NEGATIVE, NO BREMSSTRAHLUNG
+        SECPAR(2) = CURPAR(2)
+        GOTO 900
+      ENDIF
+      CREJ  = CMUON(3+LT)/EMUON
+ 
+  50  CALL RMMAR(RD,2,1)
+      V     = VC*(VM/VC)**RD(1)
+      V1    = 1.D0 - V
+C  COMPUTE REJECTION FUNCTION
+      F1    = CMUON(LT) - LOG(1.D0 + CREJ*V/V1)
+      SCREJ = (V1 + 0.75D0*V*V)*F1/CMUON(LT)
+      IF ( RD(2) .GT. SCREJ ) GOTO 50
+ 
+C  PHOTON ENERGY
+      SECPAR(2) = EMUON * V
+ 
+C  RADIATED GAMMA BELOW CUT? THEN REDUCE ENERGY OF MUON
+      IF ( SECPAR(2) .LE. ELCUT(4) ) THEN
+        GO TO 800
+      ENDIF
+ 
+C  SET MATERIAL CONSTANTS CMUON(.) ACCORDING TO
+C  TARGET INDEX LT (1=N, 2=O, 3=AR)  WHICH HAS BEEN SET IN BOX2
+      IF     ( LT .EQ. 1 ) THEN
+        Z = 7.D0
+      ELSEIF ( LT .EQ. 2 ) THEN
+        Z = 8.D0
+      ELSE
+        Z = 18.D0
+      ENDIF
+ 
+C  GENERATE EMITTED PHOTON ANGLES WITH RESPECT TO MUON DIRECTION
+C  PHI IS GENERATED ISOTROPICALLY AND THETA IS ASSIGNED A UNIVERSAL
+C  ANGULAR DISTRIBUTION WITH D=D(Z,E,V)
+C  THIS FUNCTION APPROXIMATES THE REAL DISTRIBUTION FUNCTION WHICH CAN
+C  BE FOUND IN: YUNG-SU TSAI, REV. MOD. PHYS. 46(1974)815
+C                   +ERRATUM: REV. MOD. PHYS. 49(1977)421
+      D = 0.13D0 *(0.8D0 + 1.3D0/Z) * (100.D0 + 1.D0/EMUON) * (1.D0 + V)
+      W1   = 9.D0 / (9.D0 + D)
+      UMAX = EMUON * PI / PAMA(5)
+10    CALL RMMAR(RD,3,1)
+      IF ( RD(1) .LE. W1 ) THEN
+        BETA1 = ALFA1
+      ELSE
+        BETA1 = 3.D0 * ALFA1
+      ENDIF
+      U = -( LOG(RD(2) * RD(3)) ) / BETA1
+C  CUT: THETA SHOULD BE .LE. PI  !
+C  THIS CONDITION DEPENDS ON E IN THE CASE OF D=CONST TOO!
+      IF ( U .GE. UMAX ) GOTO 10
+ 
+      THETA3 = U * PAMA(ITYPE) / EMUON
+      COSTH3 = COS( THETA3 )
+      SINTH3 = SIN( THETA3 )
+      CALL RMMAR(RD,1,1)
+ 
+      PHI3   = PI2 * RD(1)
+      CALL ADDANG( COSTHE,PHI, COSTH3,PHI3, SECPAR(3),SECPAR(4))
+      IF ( SECPAR(3) .GT. C(29) ) THEN
+C  WRITE BREMSSTRAHLUNG PHOTON TO STACK
+        SECPAR( 1) = 1.D0
+        SECPAR(10) = H
+        CALL TSTACK
+      ENDIF
+ 
+C  REDUCE ENERGY OF MUON
+ 800  CONTINUE
+      EMUON = EMUON * V1
+      SECPAR(2) = EMUON/PAMA(5)
+ 
+ 900  CONTINUE
+C  WRITE MUON TO STACK
+      SECPAR( 1) = CURPAR(1)
+      SECPAR( 3) = CURPAR(3)
+      SECPAR( 4) = CURPAR(4)
+      SECPAR(10) = ALEVEL
+      CALL TSTACK
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/mucoul.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/mucoul.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/mucoul.f	(revision 286)
@@ -0,0 +1,109 @@
+      SUBROUTINE MUCOUL(OMEGA,DENS,VSCAT)
+ 
+C-----------------------------------------------------------------------
+C   MU(ON) COUL(OMB SCATTERING OF SINGLE SCATTERING EVENTS)
+C
+C  TREATES SINGLE COULOMB SCATTERING FOR MUONS IN SMALL ANGLE
+C  APPROXIMATION.
+C  THIS SUBROUTINE IS IN ANALOGY WITH SUBROUTINE GMCOUL
+C  (AUTHOR: G. LYNCH, LBL) OF GEANT321
+C  SEE CERN PROGRAM LIBRARY LONG WRITEUP W5013
+C  THIS SUBROUTINE IS CALLED FROM UPDATE
+C  ARGUMENTS:
+C   OMEGA = NUMBER OF SCATTERINGS FOR THE STEP
+C   DENS  = LOCAL DENSITY
+C   VSCAT = SCATTERING ANGLE
+C
+C  REDESIGN: D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,MUMULT.
+      COMMON /MUMULT/  CHC,OMC,FMOLI
+      DOUBLE PRECISION CHC,OMC
+      LOGICAL          FMOLI
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION DENS,OMCF,OMEGA,OMEGA0,PHIS,SUMX,SUMY,
+     *                 THET,THMIN2,VSCAT
+      INTEGER          I,NSCMX,NSCA
+      DATA             OMCF/1.167D0/,NSCMX/50/
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*)'MUCOUL: OMEGA=',SNGL(OMEGA),
+     *                                    ' DENS=',SNGL(DENS)
+ 
+C  COMPUTE NUMBER OF SCATTERS (POISSON DISTR. WITH MEAN OMEGA0)
+      OMEGA0 = OMCF*OMEGA
+      CALL MPOISS (OMEGA0,NSCA)
+      IF ( NSCA .LE. 0 ) THEN
+        VSCAT = 0.D0
+        RETURN
+      ENDIF
+      NSCA = MIN(NSCA,NSCMX)
+      CALL RMMAR(RD,2*NSCA,1)
+ 
+C  THMIN2 IS THE SCREENING ANGLE
+      THMIN2 = CHC**2/( OMCF*OMC * (PAMA(5)*BETA*GAMMA)**2 )
+ 
+      SUMX = 0.D0
+      SUMY = 0.D0
+      DO 12 I = 1,NSCA
+        THET  = SQRT( THMIN2*((1./RD(I)) - 1.) )
+        PHIS  = PI2 * RD(NSCA+I)
+        SUMX  = SUMX + THET*COS(PHIS)
+        SUMY  = SUMY + THET*SIN(PHIS)
+ 12   CONTINUE
+      VSCAT  = SQRT(SUMX**2 + SUMY**2)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/mudecy.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/mudecy.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/mudecy.f	(revision 286)
@@ -0,0 +1,126 @@
+      SUBROUTINE MUDECY
+ 
+C-----------------------------------------------------------------------
+C  MU(ON) DEC(A)Y
+C
+C  TREATES DECAY OF MUON INTO ELECTRON (INCLUDING POLARISATION EFFECTS)
+C  INCLUDING NEUTRINOS, IF SELECTED
+C  THIS SUBROUTINE IS CALLED FROM MUTRAC
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,POLAR.
+      COMMON /POLAR/   POLART,POLARF
+      DOUBLE PRECISION POLART,POLARF
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION AUX2,COSDE,COSTH3,COS3CM,COS3C1,COS3C2,
+     *                 E3CM,GAMMA3,PHI3CM,PHI3C2,PHI31,
+     *                 P3CM,XI
+      INTEGER          I
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' MUDECY: CURPAR=',1P,9E10.3)
+ 
+C  MUON DECAYS INTO ELECTRON AND NEUTRINOS
+      XI     = 2*ITYPE - 11
+C  ELECTRON ENERGY SPECTRUM  N(E) * DE = CONST * E**2 * (3/2*E0-E) * DE
+C  IS GAINED BY THE REJECTION/REFLECTION METHOD
+   6  CALL RMMAR( RD,4,1 )
+      IF ( RD(1)**2*(3.-RD(1)*2.)  .LT.  RD(2) )  RD(1) = 1.-RD(1)
+      E3CM   = PAMA(2) + RD(1) * ( C(8) - PAMA(2) )
+      IF ( E3CM .GT. 0.5D0*PAMA(5) )  GOTO 6
+      P3CM   = SQRT( E3CM**2 - PAMA(2)**2 )
+C  NOW DETERMINE COS3C1 AND PHI31 BY RANDOM SELECTION
+C  WITH RESPECT TO THE POLARIZATION DIRECTION OF THE MUON IN THE MU CM
+C  GIVEN BY POLART, POLARF
+      COSDE  = 2.D0 * RD(4) - 1.D0
+      AUX2   = ( 1. - 2.*RD(1) ) / ( 3. - 2.*RD(1) )
+      IF ( ABS(AUX2) .GT. 1.D-2 ) THEN
+        COS3C1 = XI*(SQRT(1.D0-(2.D0*COSDE-AUX2)*AUX2) - 1.D0) / AUX2
+      ELSE
+        COS3C1 = -XI * COSDE
+      ENDIF
+      PHI31  = RD(3)*PI2
+ 
+C  NOW ADD ELECTRON EMISSION ANGLE COS3C1 TO THE POLARISATION DIRECTION
+C  TO GET THE DIRECTION (RELATIVE TO THE CORSIKA COORDINATE SYSTEM)
+      CALL ADDANG( POLART,POLARF, COS3C1,PHI31, COS3C2,PHI3C2 )
+C  GET THE ELECTRON DIRECTION RELATIVE TO THE MUON LAB DIRECTION
+      CALL ADDANI( CURPAR(3),CURPAR(4), COS3C2,PHI3C2, COS3CM,PHI3CM )
+C  LORENTZ TRANSFORMATION TO THE LAB SYSTEM
+      GAMMA3 = GAMMA * ( E3CM + BETA * P3CM * COS3CM ) / PAMA(2)
+      COSTH3 = MIN( 1.D0, GAMMA * (P3CM * COS3CM + BETA * E3CM) /
+     *                             (PAMA(2) * SQRT(GAMMA3**2 - 1.D0)) )
+      CALL ADDANG( CURPAR(3),CURPAR(4), COSTH3,PHI3CM,
+     *                                    SECPAR(3),SECPAR(4) )
+      IF ( SECPAR(3) .GE. C(29) ) THEN
+        SECPAR(1) = ITYPE - 3
+        SECPAR(2) = GAMMA3
+        DO 10  I = 5,8
+          SECPAR(I) = CURPAR(I)
+  10    CONTINUE
+        SECPAR( 9)  = GEN
+        SECPAR(10)  = ALEVEL
+        CALL TSTACK
+      ENDIF
+      POLART = 0.D0
+      POLARF = 0.D0
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/mupair.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/mupair.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/mupair.f	(revision 286)
@@ -0,0 +1,194 @@
+      SUBROUTINE MUPAIR
+C
+C*********************************************************************
+C  DESIGN  : D. HECK   IK3  FZK KARLSRUHE
+C  DATE    : JUL  15, 1988
+C*********************************************************************
+C  IN ANALOGY WITH THE SUBROUTINE PAIR.
+C  FOR A PHOTON ENERGY LESS THAN 434 MEV, THE APPROXIMATION IS
+C  MADE THAT THE ENERGY OF ONE POSITIVE OR NEGATIVE MUON IS
+C  UNIFORMLY DISTRIBUTED IN THE INTERVAL (RMMU, EIG/2)  =
+C  (MUON REST MASS, PHOTON ENERGY/2).
+C  FOR PHOTON ENERGY ABOVE 434 MEV THE
+C  COULOMB CORRECTED BETHE-HEITLER CROSS SECTION IS USED.
+C  (BUTCHER AND MESSEL, OP. CIT., P. 17-19, 22).
+C  ========== THIS MAY BE INCORRECT ==========
+C*********************************************************************
+      DOUBLE PRECISION PEIG,PESE1,PESE2
+      DOUBLE PRECISION ENERN
+      COMMON/BREMPR/DL1(6),DL2(6),DL3(6),DL4(6),DL5(6),DL6(6),DELCM, ALP
+     *HI(2),BPAR(2),DELPOS(2),PWR2I(50)
+      DOUBLE PRECISION PRRMMU
+      COMMON/MUON/PRRMMU,RMMU,RMMUT2
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,POLAR.
+      COMMON /POLAR/   POLART,POLARF
+      DOUBLE PRECISION POLART,POLARF
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' MUPAIR:NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      IF(DEBUG)WRITE(MDEBUG,*)'MUPAIR: E=',E(NP)
+      IGEN(NP) = IGEN(NP) + 1
+C***  PRECISE ENERGY OF INCIDENT GAMMA
+      PEIG=E(NP)
+C ***  SUBTRACT EM SUBSHOWER FROM NKG CALCULATION
+      IF ( FNKG ) THEN
+        SECPAR(3) = W(NP)
+        IF (U(NP)**2+V(NP)**2.GT.3.E-38) THEN
+          ANGLEX = -ATAN2(V(NP),U(NP))
+        ELSE
+          ANGLEX = 0.
+        END IF
+        SECPAR(4) = ANGLEX
+        SECPAR(5) = -Z(NP)
+        ENERN = -PEIG*1.D-3
+        CALL NKG(ENERN)
+      ENDIF
+C***  ENERGY OF INCIDENT GAMMA
+      EIG=PEIG
+      IF (EIG.LE.434.) THEN
+C ***  BELOW 434.MEV, WE ASSUME UNIFORM ENERGY
+C ***  DISTRIBUTION OF THE MUON #2 IN THE INTERVAL (RMMU, EIG/2).
+C ***  SEE ALSO SLAC-265, P.49  FOR FURTHER DISCUSSION.
+       CALL RMMAR(RNNO29,1,2)
+       ESE2=(EIG*0.5-RMMU)*RNNO29+RMMU
+      ELSE
+C ***  ABOVE 434.MEV, MUST SAMPLE
+C ***  COULOMB CORRECTED(LVX=2,LVL=4,6) CROSS SECTIONS.
+C ***  SEE RELATED COMMENTS IN BREMS.
+       LVX=2
+       LVL0=3
+181    CONTINUE
+C  ***  RETRY IF REJECTED BECAUSE DEL OUT OF RANGE, OR BY SCREENING
+C  ***  WE'LL NEED AT LEAST ONE RANDOM NUMBER
+        CALL RMMAR(RD,2,2)
+        RNNO30=RD(1)
+C  ***  NOW DECIDE WHICH OF THE TWO SUBDISTRIBUTIONS TO USE.
+        RNNO31=RD(2)
+        IF (RNNO31.GE.BPAR(LVX)) THEN
+C   ***  USE THE SUBDISTRIBUTION THAT IS PROPORTIONAL TO
+C   ***  12*(BR-0.5)**2. IT USES A(DELTA) FOR SCREENING FUNCTION
+         LVL=LVL0+1
+         CALL RMMAR(RD,2,2)
+         RNNO32=RD(1)
+         RNNO33=RD(2)
+C   ***  FROM SYMMETRY, ONLY NEED TO SAMPLE BR IN INTERVAL (0,.5)
+         BR=0.5*(1.0-MAX(RNNO32,RNNO33,RNNO30))
+        ELSE
+C   ***  USE THE SUBDISTRIBUTION THAT IS PROPORTIONAL TO 1,I.E.
+C   ***  UNIFORM.IT USES C(DELTA) FOR A SCREENING REJECT FUNCTION
+         LVL=LVL0+3
+         BR=RNNO30*0.5
+        END IF
+C  ***  THE SCREENING FUNCTIONS ARE FUNCTIONS OF DELTA=DELCM*DEL,
+C  ***  WHERE DELCM= 136.0*EXP(ZG)*RM (SAME AS FOR BREMS)
+C  ***  AND WHERE DEL=1./(EG0*BR*(1.0-BR))
+C  ***  WITH EG0 = INCIDENT PHOTON ENERGY AND BR=ENERGY FRACTION.
+        IF((BR.EQ.0.0))GO TO181
+C  ***  TO AVOID DIVISION BY ZERO
+        DEL=1.0/(EIG*BR*(1.0-BR))
+        IF((DEL.GE.(RM/RMMU)*DELPOS(LVX)))GO TO181
+C  ***  NEXT TRY
+C  ***  THE PRECEDING CONDITION ENSURES THAT A(DELTA) AND C(DELTA)
+C  ***  WILL BE POSITIVE. IF IT IS NOT SATISFIED,LOOP BACK AND TRY
+C  ***  ANOTHER SAMPLE.
+        DELTA=(RMMU*RMI)*DELCM*DEL
+        IF (DELTA.LT.1.0) THEN
+         REJF=DL1(LVL)+DELTA*(DL2(LVL) +DELTA*DL3(LVL))
+        ELSE
+         REJF=DL4(LVL)+DL5(LVL) *LOG(DELTA+DL6(LVL))
+        END IF
+C  ***  RANDOM NUMBER FOR SCREENING REJECTION
+        CALL RMMAR(RNSCRN,1,2)
+C  ***  RETRY UNTIL ACCEPTED
+        IF((RNSCRN.LE.REJF))GO TO182
+       GO TO 181
+182    CONTINUE
+C ***  BR=PRODUCT ENERGY FRACTION
+C ***  ENERGY OF SECONDARY 'MUON' #2
+       ESE2=BR*EIG
+C ***  END OF EIG.GT.434 ELSE
+      END IF
+C***  ENERGY GOING TO LOWER SECONDARY HAS NOW BEEN DETERMINED
+C***  PRECISE ENERGY OF SECONDARY 'MUON' 2
+      PESE2=ESE2
+C***  PRECISE ENERGY OF SECONDARY 'MUON' 1
+      PESE1=PEIG-PESE2
+      E(NP)=PESE1
+      E(NP+1)=PESE2
+C***  THIS AVERAGE ANGLE OF EMISSION FOR BOTH PAIR PRODUCTION AND
+C***  BREMSSTRAHLUNG IS MUCH SMALLER THAN THE AVERAGE ANGLE OF
+C***  MULTIPLE SCATTERING FOR DELTA T TRANSPORT=0.01 R.L.
+C***  THE INITIAL AND FINAL MOMENTA ARE COPLANAR
+C***  SET UP A NEW 'MUON'
+      THETA=RMMU/EIG
+      CALL UPHI(1,1)
+C***  SET UP A NEW 'MUON'
+      NP=NP+1
+      SINTHE=-SINTHE
+      CALL UPHI(3,2)
+C***  NOW RANDOMLY DECIDED WHICH IS POSITIVE MUON, AND SET
+C***  CHARGES ACCORDINGLY
+      CALL RMMAR(RNNO34,1,2)
+      IF (RNNO34.LE.0.5) THEN
+C ***  POSITIVE MUON ON TOP
+       IQ(NP)=5
+       IQ(NP-1)=6
+      ELSE
+C ***  NEGATIVE MUON ON TOP
+       IQ(NP)=6
+       IQ(NP-1)=5
+      END IF
+      CALL RMMAR(RD,2,2)
+      RNPOLT=RD(1)
+      RNPOLF=RD(2)
+      POLART=2.*RNPOLT-1.
+      POLARF=TWOPI*RNPOLF
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/muprpr.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/muprpr.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/muprpr.f	(revision 286)
@@ -0,0 +1,183 @@
+      SUBROUTINE MUPRPR
+ 
+C-----------------------------------------------------------------------
+C  MU(ON) P(AI)R PR(ODUCTION)
+C
+C  TREATES MUON PAIR PRODUCTION (WITHOUT POLARISATION EFFECTS)
+C  IN ANALOGY WITH SUBROUTINE GPAIRM FROM GEANT WRITTEN BY L. URBAN
+C  EXPLANATIONS SEE CERN PROGRM LIBRARY LONG WRITEUP W5013
+C  THIS SUBROUTINE IS CALLED FROM MUTRAC
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,MUPART.
+      COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
+      DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
+      LOGICAL          FMUBRM,FMUORG
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,POLAR.
+      COMMON /POLAR/   POLART,POLARF
+      DOUBLE PRECISION POLART,POLARF
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,REST.
+      COMMON /REST/    CONTNE,TAR,LT
+      DOUBLE PRECISION CONTNE(3),TAR
+      INTEGER          LT
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION AA,ALE,ALFA,AL10T,A1,A1R,B,BETA1,CC,C1,C2,
+     *                 COSTH3,COSTH4,EKIN,EMUON,ENEG,EPOS,EPP,
+     *                 PHI3,PPOS,R0,R0MAX,SCREJ,SINTH3,
+     *                 TPOS,V,VC,VMAX,VMIN,V0,Z
+      INTEGER          I
+      DATA             AL10T/9.212D0/
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' MUPRPR: CURPAR=',1P,9E10.3)
+ 
+C  COPY COORDINATES TO SECPAR
+      DO 11 I = 5,8
+        SECPAR(I) = CURPAR(I)
+ 11   CONTINUE
+      SECPAR( 9) = GEN
+C  SET MATERIAL CONSTANTS CMUON(.) ACCORDING TO
+C  TARGET INDEX LT (1=N, 2=O, 3=AR)  WHICH HAS BEEN SET IN BOX2
+      IF     ( LT .EQ. 1 ) THEN
+        Z = 7.D0
+      ELSEIF ( LT .EQ. 2 ) THEN
+        Z = 8.D0
+      ELSE
+        Z = 18.D0
+      ENDIF
+C  TOTAL AND KINETIC ENERGY OF MUON
+      EMUON = PAMA(5) * GAMMA
+      EKIN  = EMUON - PAMA(5)
+      IF ( EKIN .LE. BCUT ) GOTO 900
+C
+      VMIN  = 4.D0 * PAMA(2) / EMUON
+      VMAX  = 1.D0 - CMUON(10) * Z**OB3 / EMUON
+      IF ( VMAX .LE. VMIN ) GOTO 900
+      VC    = BCUT / EMUON
+      ALE   = LOG(EMUON)
+      ALFA  = 1.D0 + ALE/AL10T
+      V0    = 0.18D0 * (4.D0 + ALE/AL10T) * ALFA * (ALFA*VMIN)**TB3
+      BETA1 = 0.1D0 * (1.D0 + 3.D0 * ALE/AL10T)
+      B     = 0.9D0 / (1.D0 + 0.4D0*ALE + 0.022D0*ALE**2)
+      AA    = 1.D0 + 2.D0 * B * LOG(VC/V0)
+      IF ( AA .LE. 1.D0 ) AA = 1.05D0
+      A1    = 1.D0 - AA
+      CC    = EXP(-0.25D0*A1*A1/B)
+      A1R   = 1.D0 / A1
+      C1    = VMAX**A1
+      C2    = VC**A1
+C  SAMPLE ENERGY FRACTION V AND RO
+ 50   CALL RMMAR(RD,2,1)
+      V     = ( RD(1)*C1 + (1.-RD(1))*C2 )**A1R
+      IF ( V .LE. VMIN ) GOTO 50
+      IF ( V .LT. V0 ) THEN
+        SCREJ = CC * ( (V-VMIN)/(V0-VMIN) )**BETA * (V0/V)**A1
+      ELSE
+        SCREJ = CC * (V0/V)**( A1 + B*LOG(V/V0) )
+      ENDIF
+      IF ( RD(2) .GT. SCREJ ) GOTO 50
+      R0MAX = SCREJ * ( 1.D0 - 6.D0 *PAMA(5)/( EMUON**2 * (1.D0-V) ) )
+      CALL RMMAR(RD,2,1)
+      R0    = R0MAX * (2.*RD(1)-1.)
+C  ENERGIES
+      EPP  = V * EMUON
+      EPOS = 0.5D0 * EPP * (1.D0 + R0)
+      ENEG = EPP - EPOS
+C  ANGLES
+      COSTH3 = COS( PAMA(5)/EMUON )
+      PHI3   = PI2 * RD(2)
+C  POSITRON
+      IF ( EPOS .GT. BCUT+PAMA(3) ) THEN
+        CALL ADDANG( COSTHE,PHI, COSTH3,PHI3, SECPAR(3),SECPAR(4) )
+        IF ( SECPAR(3) .GT. C(29) ) THEN
+          SECPAR( 1) = 2.D0
+          SECPAR( 2) = EPOS/PAMA(2)
+          SECPAR(10) = H
+          CALL TSTACK
+        ENDIF
+      ENDIF
+C  ELECTRON
+      IF ( ENEG .GT. BCUT+PAMA(3) ) THEN
+        CALL ADDANG( COSTHE,PHI, COSTH3,-PHI3, SECPAR(3),SECPAR(4) )
+        IF ( SECPAR(3) .GT. C(29) ) THEN
+          SECPAR( 1) = 3.D0
+          SECPAR( 2) = ENEG/PAMA(2)
+          SECPAR(10) = H
+          CALL TSTACK
+        ENDIF
+      ENDIF
+C  REDUCE ENERGY OF MUON
+ 60   CONTINUE
+      GAMMA = (EMUON - EPP)/ PAMA(5)
+ 
+ 900  CONTINUE
+C  WRITE MUON TO STACK
+      SECPAR( 1) = CURPAR(1)
+      SECPAR( 2) = GAMMA
+      SECPAR( 3) = CURPAR(3)
+      SECPAR( 4) = CURPAR(4)
+      SECPAR(10) = ALEVEL
+      CALL TSTACK
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/mutrac.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/mutrac.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/mutrac.f	(revision 286)
@@ -0,0 +1,233 @@
+      SUBROUTINE MUTRAC
+ 
+C-----------------------------------------------------------------------
+C  MU(ON) TRAC(KING)
+C
+C  TRACKS THE MUON REGARDING MAX. STEP LENGTH FOR MULTIPLE SCATTERING
+C  CHECKS PASSAGE THROUGH OBSERVATION LEVELS
+C  IRET1=1 KILLS PARTICLE
+C  IRET2=1 PARTICLE HAS BEEN CUTTED IN UPDATE
+C  THIS SUBROUTINE IS CALLED FROM BOX3
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,IRET.
+      COMMON /IRET/    IRET1,IRET2
+      INTEGER          IRET1,IRET2
+*KEEP,LONGI.
+      COMMON /LONGI/   APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
+     *                 NSTEP,LLONGI,FLGFIT
+      DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
+     *                 SPLONG(0:1040,9),THSTEP,THSTPI
+      INTEGER          NSTEP
+      LOGICAL          LLONGI,FLGFIT
+*KEEP,MUPART.
+      COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
+      DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
+      LOGICAL          FMUBRM,FMUORG
+*KEEP,NPARTI.
+      COMMON /NPARTI/  NPARTO,MUOND
+      DOUBLE PRECISION NPARTO(10,25),NPHOTO(10),NPOSIT(10),NELECT(10),
+     *                 NNU(10),NMUP(10),NMUM(10),NPI0(10),NPIP(10),
+     *                 NPIM(10),NK0L(10),NKPL(10),NKMI(10),NNEUTR(10),
+     *                 NPROTO(10),NPROTB(10),NK0S(10),NHYP(10),
+     *                 NNEUTB(10),NDEUT(10),NTRIT(10),NALPHA(10),
+     *                 NOTHER(10),MUOND
+      EQUIVALENCE (NPARTO(1, 1),NPHOTO(1)), (NPARTO(1, 2),NPOSIT(1)),
+     *            (NPARTO(1, 3),NELECT(1)), (NPARTO(1, 4),NNU(1))   ,
+     *            (NPARTO(1, 5),NMUP(1))  , (NPARTO(1, 6),NMUM(1))  ,
+     *            (NPARTO(1, 7),NPI0(1))  , (NPARTO(1, 8),NPIP(1))  ,
+     *            (NPARTO(1, 9),NPIM(1))  , (NPARTO(1,10),NK0L(1))  ,
+     *            (NPARTO(1,11),NKPL(1))  , (NPARTO(1,12),NKMI(1))  ,
+     *            (NPARTO(1,13),NNEUTR(1)), (NPARTO(1,14),NPROTO(1)),
+     *            (NPARTO(1,15),NPROTB(1)), (NPARTO(1,16),NK0S(1))  ,
+     *            (NPARTO(1,18),NHYP(1))  , (NPARTO(1,19),NDEUT(1)) ,
+     *            (NPARTO(1,20),NTRIT(1)) , (NPARTO(1,21),NALPHA(1)),
+     *            (NPARTO(1,22),NOTHER(1)), (NPARTO(1,25),NNEUTB(1))
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION CHITOT,HEIGH,HNEW,PROPAR(8),THCKHN
+      INTEGER          I,IRET3,J,L,LPCT1,LPCT2
+      LOGICAL          FSCAT
+      EXTERNAL         HEIGH
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' MUTRAC: CURPAR=',1P,9E10.3)
+ 
+C  THE PLACE OF NEXT INTERACTION WAS DETERMINED IN BOX2
+C  KEEP TOTAL STEP LENGTH UNTIL DECAY OR INTERACTION OCCURS
+      CHITOT = CHI
+ 
+ 10   CONTINUE
+ 
+C  CALCULATE MAX STEP SIZE (10 RAD. LENGTH) FOR MULTIPLE SCATTERING
+      CHI = MIN( C(20), CHITOT )
+      IF ( CHI .EQ. CHITOT ) THEN
+        FSCAT  = .FALSE.
+        IF (DEBUG) WRITE(MDEBUG,*)'MUTRAC: CHI=',SNGL(CHI)
+      ELSE
+        FSCAT  = .TRUE.
+        IF (DEBUG) WRITE(MDEBUG,*)'MUTRAC: C(20)=',SNGL(C(20))
+      ENDIF
+ 
+ 
+C  CALCULATE HIGHT DIFFERENCE IN CM FROM GIVEN CHI IN G/CM**2
+      THCKHN = THICKH + COSTHE * CHI
+      HNEW   = HEIGH(THCKHN)
+      IF (DEBUG) WRITE(MDEBUG,*)'MUTRAC: THICKH,THCKHN,HNEW=',
+     *                    SNGL(THICKH),SNGL(THCKHN),SNGL(HNEW)
+C  UPDATE MUON TO INTERACTION POINT (IF IT REACHES SO FAR)
+C  AND STORE COORDINATES IN PROPAR
+      CALL UPDATE( HNEW, THCKHN, 0 )
+      IF ( DEBUG ) THEN
+        WRITE(MDEBUG,455) IRET1,IRET2
+  455   FORMAT(' MUTRAC: IRET1..2=',2I5)
+        IF ( IRET2 .EQ. 0 ) WRITE(MDEBUG,454) (OUTPAR(I),I=1,8)
+  454   FORMAT(' MUTRAC: OUTPAR=',1P,8E10.3)
+      ENDIF
+C  STORE MUON FOR FURTHER TREATMENT
+      IF ( IRET2 .EQ. 0 ) THEN
+        DO  3  I = 1,8
+          PROPAR(I) = OUTPAR(I)
+  3     CONTINUE
+        IRET3 = 0
+      ELSE
+C  MUON CUTTED AT INTERACTION POINT; IT MAY HOWEVER PASS SOME OF THE
+C  OBSERVATION LEVELS
+        IRET3 = 1
+      ENDIF
+ 
+C  HERE THE ENDPOINT OF THE CURRENT TRACKING STEP IS WELL DEFINED.
+C  THE MUON IS TRACKED FROM THICKH DOWN TO THICKHN
+C  COUNT THE MUONS FOR THE LONGITUDINAL DEVELOPMENT
+      IF ( LLONGI ) THEN
+        LPCT1 = INT(THICKH*THSTPI + 1.D0)
+        LPCT2 = INT(THCKHN*THSTPI)
+        LPCT2 = MIN(NSTEP,LPCT2)
+        IF     ( ITYPE .EQ. 6 ) THEN
+          DO 5003 L = LPCT1,LPCT2
+            PLONG(L,4) = PLONG(L,4) + 1.D0
+ 5003     CONTINUE
+        ELSEIF ( ITYPE .EQ. 5 ) THEN
+          DO 5013 L = LPCT1,LPCT2
+            PLONG(L,5) = PLONG(L,5) + 1.D0
+ 5013     CONTINUE
+        ENDIF
+      ENDIF
+ 
+C  CHECK OBSERVATION LEVEL PASSAGE AND UPDATE MUON COORDINATES
+      DO  1  J = 1,NOBSLV
+        IF ( HNEW .GT. OBSLEV(J) ) GOTO 2
+        IF ( H    .LT. OBSLEV(J) ) GOTO 1
+C  REMEMBER NUMBER OF LEVEL FOR OUTPUT
+        LEVL  = J
+        CALL UPDATE( OBSLEV(J), THCKOB(J), J )
+        IF (DEBUG) WRITE(MDEBUG,456) J,IRET1,IRET2
+  456   FORMAT(' MUTRAC: OBSLEV=',I5,' IRET1,2=',2I5)
+ 
+C  IF MUON IS NOT CUTTED, BRING IT TO OUTPUT
+        IF ( IRET2 .EQ. 0 ) THEN
+          CALL OUTPUT
+        ENDIF
+  1   CONTINUE
+ 
+C  KILL MUON AS IT DECAYS OR INTERACTS BELOW LOWEST OBSLEVEL
+      IRET1  = 1
+      FMUORG = .FALSE.
+      RETURN
+ 
+C  MUON SCATTERS, DECAYS OR INTERACTS BEFORE PASSING OBSLEVEL
+  2   CONTINUE
+ 
+      IF ( IRET3 .NE. 0 ) THEN
+C  ELIMINATE MUON IF BELOW CUTS
+        IRET1  = 1
+        FMUORG = .FALSE.
+        RETURN
+      ENDIF
+C  MUON IS NOW UPDATED TO POINT OF INTERACTION
+      DO  5  J = 1,8
+        CURPAR(J) = PROPAR(J)
+  5   CONTINUE
+      BETA = SQRT( GAMMA**2 - 1.D0 ) / GAMMA
+      IF ( FSCAT ) THEN
+C  MUON HAS MADE MULTIPLE SCATTERING AND MUST NOW BE TRACKED FURTHER ON
+        CHITOT = CHITOT - C(20)
+        IF ( CHITOT .GT. 0.D0 ) THEN
+          THICKH = THCKHN
+          IF ( DEBUG ) WRITE(MDEBUG,457) (CURPAR(I),I=1,9)
+ 457      FORMAT(' MUTRAC: SCATTER',1P,9E10.3)
+          GOTO 10
+        ENDIF
+      ENDIF
+C  MUONS HAVE TO DECAY IMMEDIATELY OR TO UNDERGO BREMSSTR./PAIRPR.
+      IF ( FDECAY ) THEN
+        ALEVEL = H
+        CALL MUDECY
+        MUOND  = MUOND + 1.D0
+        FMUORG = .FALSE.
+C  MUDECY WRITES EM-PARTICLE TO STACK
+      ELSE
+        IF ( FMUBRM ) THEN
+          CALL MUBREM
+        ELSE
+          CALL MUPRPR
+        ENDIF
+C  MUBREM AND MUPRPR WRITE EM-PARTICLES AND MUON TO STACK
+      ENDIF
+      IRET1 = 1
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/nihila.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/nihila.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/nihila.f	(revision 286)
@@ -0,0 +1,423 @@
+      SUBROUTINE NIHILA
+ 
+C-----------------------------------------------------------------------
+C  (AN)NIHILA(TION)
+C
+C  TREATES ANNIHILATION OF ANTINUCLEONS WITH FREE NUCLEONS
+C  MOMENTA CONSERVED IN ALL DIRECTIONS
+C  ENERGY CONSERVED BY MULTPLICATION OF ALL MOMENTA WITH A CORRECTION
+C  FACTOR, CONSERVING MOMENTUM BALANCE
+C  THIS SUBROUTINE IS CALLED FROM BOX60, BOX61, BOX62, AND BOX63
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,ANNI.
+      COMMON /ANNI/    CAN,CANN
+      DOUBLE PRECISION CAN(50),CANN(50)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,MULT.
+      COMMON /MULT/    EKINL,MSMM,MULTMA,MULTOT
+      DOUBLE PRECISION EKINL
+      INTEGER          MSMM,MULTMA(37,13),MULTOT(37,13)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,VKIN.
+      COMMON /VKIN/    BETACM
+      DOUBLE PRECISION BETACM
+*KEND.
+ 
+      DOUBLE PRECISION E(10),PHIPAR(10),PL(10),PTR(10),PTSQ(10)
+      DOUBLE PRECISION PX(10),PY(10)
+      DIMENSION ISEQ(10),NTYP(10)
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' NIHILA: CURPAR=',1P,9E10.3)
+ 
+      IREP = 0
+ 
+C  RANDOM DECISION FOR ANNIHILATION WITH PROTON OR NEUTRON
+ 
+  20  CONTINUE
+      CALL RMMAR( RD,2,1 )
+      IREP = IREP + 1
+C  AFTER THE 5TH TRY, QUIT THE ANNIHILATION WITHOUT ANY PION GENERATED
+      IF ( IREP .GT. 5 ) GOTO 999
+      IF ( RD(1) .LE. 0.5 ) THEN
+ 
+C-----------------------------------------------------------------------
+C  ANTIPROTON - PROTON AND ANTINEUTRON - NEUTRON ANNIHILATION
+        IF     ( RD(2) .LE. CANN(1)  ) THEN
+C  ANNIHILATION INTO PI+, PI-
+          NPIPOS = 1
+          NPINEG = 1
+          NPIZ   = 0
+        ELSEIF ( RD(2) .LE. CANN(2)  ) THEN
+C  ANNIHILATION INTO PI+, PI-, PI0
+          NPIPOS = 1
+          NPINEG = 1
+          NPIZ   = 1
+        ELSEIF ( RD(2) .LE. CANN(3)  ) THEN
+C  ANNIHILATION INTO PI+, PI-, 2PI0
+          NPIPOS = 1
+          NPINEG = 1
+          NPIZ   = 2
+        ELSEIF ( RD(2) .LE. CANN(4)  ) THEN
+C  ANNIHILATION INTO PI+, PI-, 3PI0
+          NPIPOS = 1
+          NPINEG = 1
+          NPIZ   = 3
+        ELSEIF ( RD(2) .LE. CANN(5)  ) THEN
+C  ANNIHILATION INTO PI+, PI-, 4PI0
+          NPIPOS = 1
+          NPINEG = 1
+          NPIZ   = 4
+        ELSEIF ( RD(2) .LE. CANN(6)  ) THEN
+C  ANNIHILATION INTO 2PI+, 2PI-
+          NPIPOS = 2
+          NPINEG = 2
+          NPIZ   = 0
+        ELSEIF ( RD(2) .LE. CANN(7)  ) THEN
+C  ANNIHILATION INTO 2PI+, 2PI-, PI0
+          NPIPOS = 2
+          NPINEG = 2
+          NPIZ   = 1
+        ELSEIF ( RD(2) .LE. CANN(8)  ) THEN
+C  ANNIHILATION INTO 2PI+, 2PI-, 2PI0
+          NPIPOS = 2
+          NPINEG = 2
+          NPIZ   = 2
+        ELSEIF ( RD(2) .LE. CANN(9)  ) THEN
+C  ANNIHILATION INTO 2PI+, 2PI-, 3PI0
+          NPIPOS = 2
+          NPINEG = 2
+          NPIZ   = 3
+        ELSEIF ( RD(2) .LE. CANN(10) ) THEN
+C  ANNIHILATION INTO 3PI+, 3PI-
+          NPIPOS = 3
+          NPINEG = 3
+          NPIZ   = 0
+        ELSEIF ( RD(2) .LE. CANN(11) ) THEN
+C  ANNIHILATION INTO 3PI+, 3PI-, PI0
+          NPIPOS = 3
+          NPINEG = 3
+          NPIZ   = 1
+        ELSEIF ( RD(2) .LE. CANN(12) ) THEN
+C  ANNIHILATION INTO 3PI+, 3PI-, 2PI0
+          NPIPOS = 3
+          NPINEG = 3
+          NPIZ   = 2
+        ELSE
+C  ANNIHILATION INTO 4PI0
+          NPIPOS = 0
+          NPINEG = 0
+          NPIZ   = 4
+        ENDIF
+ 
+      ELSE
+C-----------------------------------------------------------------------
+C  ANTIPROTON - NEUTRON (OR ANTINEUTRON - PROTON) ANNIHILATION
+        IF     ( RD(2) .LE. CANN(13) ) THEN
+C  ANNIHILATION INTO PI-, PI0
+          NPIPOS = 0
+          NPINEG = 1
+          NPIZ   = 1
+        ELSEIF ( RD(2) .LE. CANN(14) ) THEN
+C  ANNIHILATION INTO PI-, 2PI0
+          NPIPOS = 0
+          NPINEG = 1
+          NPIZ   = 2
+        ELSEIF ( RD(2) .LE. CANN(15) ) THEN
+C  ANNIHILATION INTO PI-, 3PI0
+          NPIPOS = 0
+          NPINEG = 1
+          NPIZ   = 3
+        ELSEIF ( RD(2) .LE. CANN(16) ) THEN
+C  ANNIHILATION INTO PI-, 4PI0
+          NPIPOS = 0
+          NPINEG = 1
+          NPIZ   = 4
+        ELSEIF ( RD(2) .LE. CANN(17) ) THEN
+C  ANNIHILATION INTO PI-, 5PI0
+          NPIPOS = 0
+          NPINEG = 1
+          NPIZ   = 5
+        ELSEIF ( RD(2) .LE. CANN(18) ) THEN
+C  ANNIHILATION INTO PI+, 2PI-
+          NPIPOS = 1
+          NPINEG = 2
+          NPIZ   = 0
+        ELSEIF ( RD(2) .LE. CANN(19) ) THEN
+C  ANNIHILATION INTO PI+, 2PI-, PI0
+          NPIPOS = 1
+          NPINEG = 2
+          NPIZ   = 1
+        ELSEIF ( RD(2) .LE. CANN(20) ) THEN
+C  ANNIHILATION INTO PI+, 2PI-, 2PI0
+          NPIPOS = 1
+          NPINEG = 2
+          NPIZ   = 2
+        ELSEIF ( RD(2) .LE. CANN(21) ) THEN
+C  ANNIHILATION INTO PI+, 2PI-, 3PI0
+          NPIPOS = 1
+          NPINEG = 2
+          NPIZ   = 3
+        ELSEIF ( RD(2) .LE. CANN(22) ) THEN
+C  ANNIHILATION INTO PI+, 2PI-, 4PI0
+          NPIPOS = 1
+          NPINEG = 2
+          NPIZ   = 4
+        ELSEIF ( RD(2) .LE. CANN(23) ) THEN
+C  ANNIHILATION INTO 2PI+, 3PI-
+          NPIPOS = 2
+          NPINEG = 3
+          NPIZ   = 0
+        ELSEIF ( RD(2) .LE. CANN(24) ) THEN
+C  ANNIHILATION INTO 2PI+, 3PI-, PI0
+          NPIPOS = 2
+          NPINEG = 3
+          NPIZ   = 1
+        ELSEIF ( RD(2) .LE. CANN(25) ) THEN
+C  ANNIHILATION INTO 2PI+, 3PI-, 2PI0
+          NPIPOS = 2
+          NPINEG = 3
+          NPIZ   = 2
+        ELSEIF ( RD(2) .LE. CANN(26) ) THEN
+C  ANNIHILATION INTO 2PI+, 3PI-, 3PI0
+          NPIPOS = 2
+          NPINEG = 3
+          NPIZ   = 3
+        ELSE
+C  ANNIHILATION INTO 3PI+, 4PI-
+          NPIPOS = 3
+          NPINEG = 4
+          NPIZ   = 0
+        ENDIF
+ 
+C  CHARGE INVERSION IF ANTINEUTRON ANNIHILATES WITH PROTON
+        IF ( ITYPE .EQ. 25 ) THEN
+          NPINEG = NPINEG - 1
+          NPIPOS = NPIPOS + 1
+        ENDIF
+ 
+      ENDIF
+ 
+      NPI  = NPIPOS + NPINEG + NPIZ
+      FNPI = 1.D0 / NPI
+      GCMI = 1.D0 / GCM
+ 
+C-----------------------------------------------------------------------
+C  CHARGE ASSIGNMENT
+ 
+      DO 26  I = 1,NPI
+        IF     ( I .LE. NPIZ          ) THEN
+C  NEUTRAL PIONS
+          NTYP(I) = 7
+        ELSEIF ( I .LE. NPIZ+NPIPOS ) THEN
+C  POSITIVE PIONS
+          NTYP(I) = 8
+        ELSE
+C  NEGATIVE PIONS
+          NTYP(I) = 9
+        ENDIF
+  26  CONTINUE
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  KINEMATIC CALCULATIONS
+ 
+      ISCALE = 0
+  27  CONTINUE
+      ISCALE = ISCALE + 1
+C  AFTER THE 5TH TRY, TAKE A NEW SET OF PIONS
+      IF ( ISCALE .GT. 5 ) GOTO 20
+ 
+C  DISTRIBUTUION OF TRANSVERSE MOMENTA PTR
+ 
+      CORECT = 5.3333333333D0 * FNPI**1.5D0 * ECM
+      DO 28  I = 1,NPI
+        PTR(I) = PTRANS(DUMMY) * (1.33333333D0 + CORECT)
+  28  CONTINUE
+ 
+      SUMPX = 0.D0
+      SUMPY = 0.D0
+      CALL RMMAR( RD,NPI,1 )
+      DO 29  I = 1,NPI
+C  SELECT EMISSION ANGLE BY REDUCED RESIDUAL DIRECTION
+        IF ( SUMPX .NE. 0.D0  .OR.  SUMPY .NE. 0.D0 ) THEN
+          PHISUM  = ATAN2( SUMPY, SUMPX )
+        ELSE
+          PHISUM  = 0.D0
+        ENDIF
+        PHIPAR(I) = PHISUM + PI + PI * (NPI+1-I) * (2.*RD(I)-1.) * FNPI
+        PX(I)     = COS( PHIPAR(I) ) * PTR(I)
+        PY(I)     = SIN( PHIPAR(I) ) * PTR(I)
+        SUMPX     = SUMPX + PX(I)
+        SUMPY     = SUMPY + PY(I)
+  29  CONTINUE
+ 
+C  CORRECTION OF TRANSVERSE MOMENTA TO KEEP TRANSVERSE MOMENTUM BALANCE
+      SUMPT2 = ECM
+      DPX    = SUMPX * FNPI
+      DPY    = SUMPY * FNPI
+      DO 30  I = 1,NPI
+        PX(I)   = PX(I) - DPX
+        PY(I)   = PY(I) - DPY
+        IF ( PX(I) .NE. 0.D0  .OR.  PY(I) .NE. 0.D0 ) THEN
+          PHIPAR(I) = ATAN2( PY(I), PX(I) )
+        ELSE
+          PHIPAR(I) = 0.D0
+        ENDIF
+        PTSQ(I) = PX(I)**2 + PY(I)**2
+        SUMPT2  = SUMPT2 - SQRT( PAMA(NTYP(I))**2 + PTSQ(I) )
+  30  CONTINUE
+ 
+C  CHECK, IF C.M. ENERGY IS EXHAUSTED BY TRANSVERSE MOMENTA
+C  IF SO, TRY ANOTHER SET OF TRANSVERSE MOMENTA
+      IF ( SUMPT2 .LE. 0.D0 ) GOTO 27
+ 
+C  DISTRIBUTION OF LONGITUDINAL MOMENTA PL
+ 
+C  SUM1PL IS SUM OF ABS. VALUES OF LONGITUDINAL MOMENTA
+      F = SUMPT2 * FNPI
+      SUM1PL = 0.D0
+      DO 31  I = 1,NPI
+        FWHM    = F + 0.5D0 * SQRT( PTSQ(I) )
+        PL(I)   = ABS( RANNOR(0.D0,FWHM) )
+        SUM1PL  = SUM1PL + PL(I)
+C  SET SEQUENCE COUNTER
+        ISEQ(I) = I
+  31  CONTINUE
+ 
+C  SORT ISEQ IN DECREASING SIZE OF THE LONGITUDINAL MOMENTUM
+      DO 33  I = 1,NPI
+        DO 32  K = I+1,NPI
+          IF ( PL(ISEQ(I)) .LT. PL(ISEQ(K)) ) THEN
+            IHELP   = ISEQ(I)
+            ISEQ(I) = ISEQ(K)
+            ISEQ(K) = IHELP
+          ENDIF
+  32    CONTINUE
+  33  CONTINUE
+ 
+C  TRY TO BALANCE LONGITUDINAL MOMENTA (TO MINIMIZE CORRECTIONS)
+C  START WITH LONG. MOMENTA IN FORWARD/BACKWARD DIRECTION BY RANDOM
+      CALL RMMAR( RD,1,1 )
+      IF ( RD(1) .LE. 0.5 )  PL(ISEQ(1)) = - PL(ISEQ(1))
+      SUMPL = PL(ISEQ(1))
+      DO 34  I = 2,NPI
+        SUM1PL = SUM1PL - PL(ISEQ(I))
+C  IF THERE IS NOT ENOUGH MOMENTUM LEFT, SELECT FORWARD/BACKWARD TO
+C  BALANCE MOMENTUM, ELSE CHOOSE DIRECTION BY RANDOM
+        IF ( PL(ISEQ(I))+ABS(SUMPL) .GT. SUM1PL ) THEN
+          IF ( PL(ISEQ(I))*SUMPL .GT. 0.D0 )  PL(ISEQ(I)) = -PL(ISEQ(I))
+        ELSE
+          CALL RMMAR( RD,1,1 )
+          IF ( RD(1) .LE. 0.5 )  PL(ISEQ(I)) = - PL(ISEQ(I))
+        ENDIF
+        SUMPL = SUMPL + PL(ISEQ(I))
+  34  CONTINUE
+ 
+C  CORRECTION OF LONGITUDINAL MOMENTA TO KEEP MOMENTUM BALANCE
+      DPL = SUMPL * FNPI
+      DO 35  I = 1,NPI
+        PL(I) = PL(I) - DPL
+  35  CONTINUE
+ 
+C  ITERATIVE CORRECTION OF ALL MOMENTA TO KEEP ENERGY BALANCE
+ 
+      IREPET = 0
+  36  CONTINUE
+      IREPET = IREPET + 1
+      IF ( IREPET .GT. 10 ) GOTO 27
+      ETOT   = 0.D0
+C  CHECK ENERGY CONSERVATION
+      DO 37  I = 1,NPI
+        PTSQ(I) = PX(I)**2 + PY(I)**2
+        E(I)    = SQRT( PAMA(NTYP(I))**2 + PTSQ(I) + PL(I)**2 )
+        ETOT    = ETOT + E(I)
+  37  CONTINUE
+ 
+      ECORR =  ECM / ETOT - 1.D0
+ 
+C  LOOK WHETHER ENERGY IS CONSERVED WITHIN 1 %
+      IF ( ABS(ECORR) .GT. .01D0 ) THEN
+C  FACTOR IS MODIFIED WITH EMPIRICAL TERM 1/GCM FOR FASTER CONVERGENCE
+        FACT = (0.5D0+GCMI) * ECORR * 0.02D0 * NPI
+        DO 38  I = 1,NPI
+          PX(I) = PX(I) * ( FACT         + 1.D0 )
+          PY(I) = PY(I) * ( FACT         + 1.D0 )
+          PL(I) = PL(I) * ( FACT * 20.D0 + 1.D0 )
+  38    CONTINUE
+        GOTO 36
+      ENDIF
+ 
+C  LORENTZ TRANSFORMATION FROM C.M. TO LAB. FRAME
+ 
+      DO 40  K = 5,8
+        SECPAR(K) = CURPAR(K)
+  40  CONTINUE
+      DO 41  I = 1,NPI
+        PLLAB  = GCM * ( PL(I) + BETACM * E(I) )
+        IF ( PLLAB .LE. 0.D0 ) GOTO 41
+        CTHETA = PLLAB / SQRT( PTSQ(I) + PLLAB**2 )
+        IF ( CTHETA .LT. C(27) ) GOTO 41
+        CALL ADDANG( COSTHE,PHI, CTHETA,PHIPAR(I), SECPAR(3),SECPAR(4) )
+        IF ( SECPAR(3) .LT. C(29) ) GOTO 41
+        SECPAR(1) = NTYP(I)
+        SECPAR(2) = GCM / PAMA(NTYP(I)) * ( PL(I) * BETACM + E(I) )
+        CALL TSTACK
+  41  CONTINUE
+ 
+      MSMM  = MSMM + NPI
+ 999  CONTINUE
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/nkg.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/nkg.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/nkg.f	(revision 286)
@@ -0,0 +1,219 @@
+      SUBROUTINE NKG( ENERN )
+ 
+C-----------------------------------------------------------------------
+C  N(ISHIMURA) K(AMATA) G(REISEN)
+C
+C  CALCULATES ELECTROMAGNETIC COMPONENT OF SHOWERS USING THE ANALYTIC
+C  NKG FORMULAS, INCLUDING ELECTRON ENERGY THRESHOLD ELCUT(3)
+C  SEE J.N. CAPDEVIELLE, 22ND ICRC, DUBLIN 1991, CONTRIB. HE 3.5.10
+C  THIS SUBROUTINE IS CALLED FROM EM
+C  ARGUMENTS:
+C   ENERN  = ENERGY OF ELECTRON/PHOTON GENERATING A SUBSHOWER
+C            NEGATIVE FOR SUBSHOWERS TO BE SUBTRACTED AFTER
+C            PHOTONUCLEAR REACTION
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEEP,NKGI.
+      COMMON /NKGI/    SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
+     *                 DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
+     *                 OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
+      DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
+     *                 ZSL(10),DIST(10),
+     *                 DISX(-10:10),DISY(-10:10),
+     *                 DISXY(-10:10,2),DISYX(-10:10,2),
+     *                 DLAX (-10:10,2),DLAY (-10:10,2),
+     *                 DLAXY(-10:10,2),DLAYX(-10:10,2),
+     *                 OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
+      INTEGER          IALT(2)
+*KEEP,NKGS.
+      COMMON /NKGS/    CZX,CZY,CZXY,CZYX,SAH,SL,ZNE
+      DOUBLE PRECISION CZX(-10:10,2),CZY(-10:10,2),CZXY(-10:10,2),
+     *                 CZYX(-10:10,2),SAH(10),SL(10),ZNE(10)
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION AE,AS,ASE,AUXIL,BS,CCP,CPC,CPCP,CPH,CSGA,
+     *                 DE,DISTL,ECRI,ECR1,ECR2,ENERN,GAM,GRCUT,
+     *                 G1,G2,G3,S,SC1,SC2,SIGNE,SM,SMRM,
+     *                 SQRZ1I,SQZC1I,SQZC2I,SS2,SS45,TEX,THICK,THICKP,
+     *                 XMOL,XNE,XS,X0,YM,YS,ZC1,ZC2,ZG1,ZG2,ZG3,Z1
+      INTEGER          IL,IOL,M
+      EXTERNAL         GAM,THICK
+C  X0 IS RADIATON LENGTH IN AIR (G/CM**2)
+C  (SEE ALSO MIKOCKI ET AL. J.PHYS.G.:NUCL.PART.PHYS. 17 (1991) 1303 )
+C  GRCUT IS GREISEN CUT OFF,  ECRI IS CRITICAL ENERGY IN AIR
+C  ECR2 IS 0.4 * ECRI
+      DATA X0 / 37.1D0 /, GRCUT / 0.1D0 /, ECRI / 0.082D0 /
+      DATA ECR2 / 0.0328D0 /
+C-----------------------------------------------------------------------
+ 
+      IF (DEBUG) WRITE(MDEBUG,*)'NKG   : ',SNGL(SECPAR(1)),SNGL(ENERN)
+ 
+C  CHECK WETHER SUBSHOWER IS SUBTRACTED
+      IF ( ENERN .GE. 0.D0 ) THEN
+        SIGNE = +1.D0
+      ELSE
+        ENERN = -ENERN
+        SIGNE = -1.D0
+      ENDIF
+ 
+C  ENERGY CUT OFF IN GREISEN FORMULA
+C  (EM PARTICLE BELOW THIS CUT CAN NOT PRODUCE A SHOWER)
+      IF ( ENERN .LT. GRCUT ) RETURN
+C  DON'T CALCULATE NKG FOR BACKWARD GOING PARTICLES
+      IF ( SECPAR(3) .LE. 0.D0 ) RETURN
+C  DON'T CALCULATE NKG IF PARTICLE BELOW THE LOWEST OBSERVATION LEVEL
+      IF ( SECPAR(5) .LT. OBSATI(1) ) RETURN
+ 
+      Z1     = LOG(ENERN / ECRI)
+      SQRZ1I = 1.D0 / SQRT(Z1)
+ 
+C  THIS CUT IS ONLY IMPORTANT FOR ELCUT > .0672
+      ECR1 = ECR2 + ELCUT(3)
+      IF ( ENERN .LT. ECR1 ) RETURN
+      ZC1    = LOG(ENERN / ECR1)
+      SQZC1I = 1.D0 / SQRT(ZC1)
+C  LOG(ENERN/ECR2) IS LOG(ENERN / ECRI) - LOG(0.4)
+      ZC2    = Z1 + 0.916290732D0
+      SQZC2I = 1.D0 / SQRT(ZC2)
+      THICKP = THICK(SECPAR(5))
+ 
+C  LOOP OVER LEVELS
+      DO 14  IL = 1,IALT(1)
+C  DISREGARD LEVELS ABOVE THE PARTICLE
+        IF ( TLEVCM(IL) .GT. SECPAR(5) ) GOTO 14
+C  DISTANCE IN G/CM**2 .... (ALONG PHOTON-AXIS) IN RADIATION LENGTHS
+        XMOL  = (TLEV(IL) - THICKP) / ( X0 * SECPAR(3) )
+C  CORRECT DEPTH FOR SUBSHOWERS TO BE SUBTRACTED BY 9/7
+        IF ( SIGNE .LT. 0.D0 ) XMOL = XMOL + 1.285714286D0
+C  XMOL IS DEPTH IN RADIATION LENGTHS
+        IF ( XMOL .GT. 60.D0  .OR.  XMOL .LT. 1.D0 ) GOTO 14
+C  S IS AGE PARAMETER
+        S     = 3.D0 * XMOL / (XMOL + 2.D0 * Z1)
+        IF ( S .LE. 0.2D0 ) GOTO 14
+        SC1   = 3.D0 * XMOL / (XMOL + 2.D0 * ZC1)
+        SC2   = 3.D0 * XMOL / (XMOL + 2.D0 * ZC2)
+C  ELECTRON NUMBER AT OBSERVATION LEVEL
+        CPH   = .31D0 * EXP( XMOL * (1.D0 - 1.5D0 * LOG(S) ) ) * SQRZ1I
+        CPC   = EXP( XMOL * ( 1.D0 - 1.5D0 * LOG(SC1) ) ) * SQZC1I
+        CCP   = EXP( XMOL * ( 1.D0 - 1.5D0 * LOG(SC2) ) ) * SQZC2I
+        CPCP  = SIGNE * CPH * CPC / CCP
+C  INTERMEDIATE FACTORS FOR LATERAL DISTRIBUTION AND AGE PARAMETER
+        AE    = 4.D0 * EXP( 0.915D0 * (S - 1.D0) ) / S
+        DE    = ( 1.D0 + S ) / ( 1.15D0 + 0.15D0 * S )
+        ASE   = AE**DE
+        ZG3   = GAM( (S + 2.D0) * DE )
+        IF ( ZG3 .LE. 0.D0 ) GOTO 14
+        ZG1   = GAM(S * DE)
+        ZG2   = GAM( (S + 1.D0) * DE )
+        AUXIL = 4.D0 / (S * ASE)
+        XNE = CPCP * ( ZG2 + AUXIL * ZG3 ) / ( ASE * (ZG1 + AUXIL*ZG2) )
+C  SUM OF N_E AT FIXED LEVEL
+        ZNE(IL) = ZNE(IL) + XNE
+        SL(IL)  = SL(IL) + CPCP
+ 
+C  CALCULATE THE ELECTRON LATERAL DISTRIBUTION FOR THE 2 SELECTED
+C  OBSERVATION LEVELS
+        IF     ( IL .EQ. IALT(1) ) THEN
+          IOL = 1
+        ELSEIF ( IL .EQ. IALT(2) ) THEN
+          IOL = 2
+        ELSE
+          GOTO 14
+        ENDIF
+ 
+C  CALCULATION OF LATERAL ELECTRON DISTRIBUTION
+        IF ( SC1 .GE. 2.25D0 ) GOTO 14
+        G1    = GAM(4.5D0 - SC1)
+        G2    = GAM(SC1)
+        G3    = GAM(4.5D0 - 2.D0 * SC1)
+C  DISTANCE IN CM BETWEEN PHOTON INITIATION AND OBSERVATION (VERTICAL)
+        DISTL = SECPAR(5) - TLEVCM(IL)
+C  MODULATION BY AGE PARAMETER FOLLOWING LAGUTIN & UCHAIKIN
+C  (AGE PARAMETER LIES BETWEEN 0.2 AND 2.25)
+        SM    = 0.78D0 - 0.21D0 * SC1
+        SMRM  = 1.D0 / ( SM * RMOL(IOL) )
+ 
+        CSGA  = CPCP * SMRM**2 * G1 / ( PI2 * G2 * G3 )
+        SS2   = SC1 - 2.D0
+        SS45  = SC1 - 4.5D0
+        AS    = SIN( SECPAR(4) )
+        BS    = COS( SECPAR(4) )
+        TEX   = DISTL * SQRT( 1.D0 - SECPAR(3)**2 ) / SECPAR(3)
+C  DISTANCE TO THE CENTER OF THE CASCADE (IN CM)
+        XS    = SECPAR(7) + TEX * BS - XOFF(NOBSLV+1-IOL)
+        YS    = SECPAR(8) + TEX * AS - YOFF(NOBSLV+1-IOL)
+ 
+C  NKG-FORMULA
+C  LOOP OVER ALL LATERAL DISTANCES GETTING THE DENSITY IN MOLIERE UNITS
+        DO 171  M = -10,10
+          IF ( M .EQ. 0 ) GOTO 171
+C  X DIRECTION
+          YM  = SMRM * MAX( SQRT((DISX(M)-XS)**2 + YS**2), 1.D0 )
+          CZX (M,IOL) = CZX (M,IOL) + CSGA * YM**SS2 * (YM+1.D0)**SS45
+C  Y DIRECTION
+          YM  = SMRM * MAX( SQRT(XS**2 + (DISY(M)-YS)**2), 1.D0 )
+          CZY (M,IOL) = CZY (M,IOL) + CSGA * YM**SS2 * (YM+1.D0)**SS45
+C  XY DIRECTION
+          YM  = SMRM *
+     *       MAX( SQRT((DISXY(M,1)-XS)**2 + (DISXY(M,2)-YS)**2), 1.D0 )
+          CZXY(M,IOL) = CZXY(M,IOL) + CSGA * YM**SS2 * (YM+1.D0)**SS45
+C  YX DIRECTION
+          YM  = SMRM *
+     *       MAX( SQRT((DISYX(M,1)-XS)**2 + (DISYX(M,2)-YS)**2), 1.D0 )
+          CZYX(M,IOL) = CZYX(M,IOL) + CSGA * YM**SS2 * (YM+1.D0)**SS45
+  171   CONTINUE
+ 
+   14 CONTINUE
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/nsd.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/nsd.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/nsd.f	(revision 286)
@@ -0,0 +1,113 @@
+      SUBROUTINE NSD
+ 
+C-----------------------------------------------------------------------
+C  N(ON) S(INGLE) D(IFFRACTION CASE)
+C
+C  SETS PARAMETERS FOR HDPM IN CASE OF NON-SINGLE-DIFFRACTION EVENT
+C  THIS SUBROUTINE IS CALLED FROM HDPM
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,INTER.
+      COMMON /INTER/   AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
+     *                 IDIF,ITAR
+      DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
+      INTEGER          IDIF,ITAR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'NSD   :'
+ 
+C  CENTRAL RAPIDITY DENSITY ( RHO ) FOR NSD REACTION
+C  PARAMETRISATION SEE CAPDEVIELLE,J.PHYS.G:NUCL.PHYS.16(1990)1539 EQ.7
+      IF ( ECMDPM .LE. 680.D0 ) THEN
+        DC0   = 0.82D0 * (S**0.107D0)
+      ELSE
+        DC0   = 0.64D0 * (S**0.126D0)
+      ENDIF
+C  THERE ARE 3 ENERGY DEPENDENT FORMULAS FOR AVERAGE CHARGED
+C  MULTIPLICITY ( AVCH0 );
+C  PARAMETRISATIONS SEE CAPDEVIELLE,J.PHYS.G:NUCL.PHYS.16(1990)1539 EQ.8
+      IF     ( ECMDPM .LE. 187.5D0 ) THEN
+        AVCH0 = 0.57D0 + 0.584D0 * SLOG + 0.127D0 * SLOGSQ
+      ELSEIF ( ECMDPM .LT. 945.5D0 ) THEN
+        AVCH0 = -6.55D0 + 6.89D0 * S**0.131D0
+      ELSE
+        AVCH0 = 3.4D0 * S**0.17D0
+      ENDIF
+C  MINIMUM AVERAGE CHARGED MULTIPLICITY IS 1
+      AVCH0   = MAX( 1.D0, AVCH0 )
+C  EXCESS OF CHARGED PARTICLES WHICH COME FROM AIR TARGET
+      IF ( ECMDPM .LE. 137.D0 ) THEN
+        AVCH3 = 0.57D0 * AVCH0 * (GNU - 1.D0)
+      ELSE
+        AVCH3 = 0.5D0  * AVCH0 * (GNU - 1.D0)
+      ENDIF
+C  AVERAGE NUMBER OF ALL CHARGED
+      AVCH    = AVCH0 + AVCH3
+C  THE FOLOWING PROCEDURE IS TO PRODUCE PHOTONS FROM UNKNOWN NEUTRAL
+C  DECAYS FOLLOWING CORRELATION WITH CHARGED PARTICLES BASED ON PHOTON
+C  EXCESS AT COLLIDER EXPERIMENTS. SEUGP IS <N_PHOTON>
+C  PARAMETRISATION OF UA5: ANSORGE ET AL., Z.PHYS.C43 (1989) 75
+      IF ( ECMDPM .LE. 103.D0 ) THEN
+        SEUGP = -1.27D0 + 0.52D0 * SLOG + 0.148D0 * SLOGSQ
+      ELSE
+C  PROBLEM OF THE RISE OF THE UNKNOWN ETA PRODUCTION CROSS SECTION
+C  IS SOLVED WITH THOUW'S PARAMETRISATION OF UA5 DATA:
+        SEUGP = -18.7D0 + 11.55D0 * S**0.1195D0
+      ENDIF
+      SEUGP   = MAX( 0.5D0, SEUGP )
+      IF ( DEBUG ) WRITE(MDEBUG,100)
+     *    SNGL(DC0),SNGL(AVCH0),SNGL(AVCH3),SNGL(AVCH),SNGL(SEUGP)
+ 100  FORMAT(' NSD   : DC0,AVCH0,AVCH3,AVCH,SEUGP=',5F12.7)
+ 
+C  CENTER OF GAUSSIAN FOR CHARGED SECONDARIES 1ST AND 2ND STRING
+C  NEEDED FOR SOME CALCULATION ; FINAL POSITION CALCULATED LATER
+      POSC2   = 0.146D0 * SMLOG + 0.072D0
+C  WIDTH  OF GAUSSIAN FOR CHARGED SECONDARIES 1ST AND 2ND STRING
+      WIDC2   = 0.12D0 * SMLOG + 0.18D0
+      IF ( GNU .LE. 1.D0 ) THEN
+        POSC3 = 0.D0
+        WIDC3 = 1.D0
+      ELSE
+C  CENTER OF GAUSSIAN 3RD STRING (TARGET CONTRIB. FOR PROJECTILE-AIR)
+        POSC3 = 3.D0 - 2.575D0 * EXP( -0.081756452D0 * GNU )
+C  WIDTH  OF GAUSSIAN FOR 3RD STRING
+        WIDC3 = 1.2338466D0 + 0.078969916D0 * LOG(GNU)
+      ENDIF
+      IF ( DEBUG ) WRITE(MDEBUG,110)
+     *            SNGL(POSC2),SNGL(WIDC2),SNGL(POSC3),SNGL(WIDC3)
+ 110  FORMAT(' NSD   : POSC2,WIDC2,POSC3,WIDC3=',4F12.7)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/nucint.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/nucint.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/nucint.f	(revision 286)
@@ -0,0 +1,390 @@
+      SUBROUTINE NUCINT
+ 
+C-----------------------------------------------------------------------
+C  NUC(LEAR) INT(ERACTION)
+C
+C  SELECTS TYPE OF INTERACTION PROCESS FOR ISOBAR MODEL, ACCORDING TO ECM
+C  ISOBAR MASSES INDEPENDENT OF RESPECTIVE ENERGY RANGES
+C  HEAVY PRIMARIES AND STRANGE BARYONS INCLUDED
+C  THIS SUBROUTINE IS CALLED FROM MAIN
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,AIR.
+      COMMON /AIR/     COMPOS,PROBTA,AVERAW,AVOGAD
+      DOUBLE PRECISION COMPOS(3),PROBTA(3),AVERAW,AVOGAD
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,IRET.
+      COMMON /IRET/    IRET1,IRET2
+      INTEGER          IRET1,IRET2
+*KEEP,KAONS.
+      COMMON /KAONS/   CKA
+      DOUBLE PRECISION CKA(80)
+*KEEP,MULT.
+      COMMON /MULT/    EKINL,MSMM,MULTMA,MULTOT
+      DOUBLE PRECISION EKINL
+      INTEGER          MSMM,MULTMA(37,13),MULTOT(37,13)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,POLAR.
+      COMMON /POLAR/   POLART,POLARF
+      DOUBLE PRECISION POLART,POLARF
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RANGE.
+      COMMON /RANGE/   CC
+      DOUBLE PRECISION CC(20)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,SIGM.
+      COMMON /SIGM/    SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+      DOUBLE PRECISION SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+*KEEP,STATI.
+      COMMON /STATI/   SABIN,SBBIN,INBIN,IPBIN,IKBIN,IHBIN
+      DOUBLE PRECISION SABIN(37),SBBIN(37)
+      INTEGER          INBIN(37),IPBIN(37),IKBIN(37),IHBIN(37)
+*KEEP,VKIN.
+      COMMON /VKIN/    BETACM
+      DOUBLE PRECISION BETACM
+*KEND.
+ 
+      DOUBLE PRECISION BETA3,COSMU,COSTCM,COSTH3,GAMMA3,
+     *                 PHIMU,PHI3,WORK1,WORK2
+      INTEGER          I,IGO,KJ
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' NUCINT: CURPAR=',1P,9E10.3)
+ 
+C  SET GENERATION AND LEVEL OF LAST INTERACTION
+      SECPAR( 9) = GEN
+      SECPAR(10) = ALEVEL
+C  RESET POLARIZATION, NOT USED FOR PARTICLES OTHER THAN MUONS YET
+      SECPAR(11) = 0.D0
+      SECPAR(12) = 0.D0
+ 
+C  CALCULATE KIN. ENERGY BIN
+      EKINL = PAMA(ITYPE) * ( GAMMA - 1.D0 )
+      IF ( EKINL .GE. .1D0 ) THEN
+        KJ = INT( MIN( 37.D0, 4.D0 + 3.D0*LOG10(EKINL) ) )
+      ELSE
+        KJ = 1
+      ENDIF
+ 
+C-----------------------------------------------------------------------
+C  PION INCIDENT
+      IF     ( ITYPE .EQ.  8  .OR.  ITYPE .EQ.  9 ) THEN
+        IF ( DEBUG ) WRITE(MDEBUG,*) 'NUCINT: PION EKINL=',SNGL(EKINL)
+        IPBIN(KJ) = IPBIN(KJ) + 1
+ 
+C  DECAY OR INTERACTION FOR PIONS ?
+        IF ( FDECAY ) THEN
+          DO 10  I = 5,8
+            SECPAR(I) =  CURPAR(I)
+ 10       CONTINUE
+C  DECAY  PI(+,-)  ---->  MU(+,-) + (ANTI)-NEUTRINO(MU)
+          WORK1  = C(48) * GAMMA
+          WORK2  = C(49) * BETA * WORK1
+          CALL RMMAR( RD,2,1 )
+          COSTCM = 2.D0 * RD(1) - 1.D0
+          GAMMA3 = WORK1 + COSTCM * WORK2
+          BETA3  = SQRT( 1.D0 - 1.D0 / GAMMA3**2 )
+          COSTH3 = MIN( 1.D0, ( GAMMA * GAMMA3 - C(48) )
+     *                      /( BETA * GAMMA * BETA3 * GAMMA3 ) )
+          PHI3   = PI2 * RD(2)
+C  MUON / NEUTRINO IS DROPPED
+          CALL ADDANG( COSTHE,PHI, COSTH3,PHI3, COSMU,PHIMU )
+          IF ( COSMU .GT. C(29) ) THEN
+C  DIRECTION OF PION IN THE MUON CM SYSTEM (= DIRECTION OF POLARIZATION)
+C  SEE: G. BARR ET AL., PHYS. REV. D39 (1989) 3532, EQ. 5
+C  POLART IS COS OF ANGLE BETWEEN PION AND LABORATORY IN THE MU CM
+C  POLARF IS ANGLE PHI AROUND THE LAB DIRECTION IN THE MU CM
+C  POLART, POLARF ARE WITH RESPECT TO THE MU DIRECTION IN THE LAB SYSTEM
+            POLART = ( 2.D0*PAMA(8)*GAMMA*C(7)/(PAMA(5)*GAMMA3)
+     *                 - C(7) - 1.D0 ) / ( BETA3 * (1.D0 - C(7)) )
+            POLARF = PHI3 - PI
+C  PION DIRECTION IS DIRECTION OF POLARIZATION FOR PI+, OPPOSITE FOR PI-
+            IF ( ITYPE .EQ. 9 ) THEN
+              POLART = -POLART
+              POLARF = POLARF + PI
+            ENDIF
+C  GET THE POLARIZATION DIRECTION IN THE MU CM RELATIVE TO THE CORSIKA
+C  COORDINATE SYSTEM
+            CALL ADDANG( COSMU,PHIMU, POLART,POLARF, POLART,POLARF )
+C  MUON IS WRITTEN TO STACK
+            SECPAR( 1) = CURPAR(1) - 3.D0
+            SECPAR( 2) = GAMMA3
+            SECPAR( 3) = COSMU
+            SECPAR( 4) = PHIMU
+            SECPAR(11) = POLART
+            SECPAR(12) = POLARF
+            CALL TSTACK
+            SECPAR(11) = 0.D0
+            SECPAR(12) = 0.D0
+          ENDIF
+          IRET1 = 1
+          RETURN
+        ENDIF
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  PION INTERACTS
+ 
+C  CALCULATE GAMMA, BETA AND ENERGY IN CENTER OF MASS
+        ECM    = SQRT( C(45) * GAMMA + C(46) )
+        GCM    = (PAMA(ITYPE) * GAMMA + PAMA(14)) / ECM
+        BETACM = SQRT( 1.D0 - 1.D0 / GCM**2 )
+ 
+C  LOW ENERGY HADRONIC INTERACTIONS
+C  USE GHEISHA IF THE CROSS SECTION HAS BEEN CALCULATED FOR GHEISHA
+        IF ( GHEISH ) THEN
+          IF ( GHESIG ) THEN
+            CALL CGHEI
+          ELSE
+            CALL SDPM
+          ENDIF
+        ELSE
+C  DETERMINE TYPE OF INTERACTION FOR PIONS
+          IF     ( ECM .GT. CC(8) ) THEN
+C  DUAL PARTON MODEL
+            CALL SDPM
+          ELSEIF ( ECM .GT. CC(7) ) THEN
+C  HEAVY ISOBAR + HEAVY MESON
+            CALL BOX69
+          ELSEIF ( ECM .GT. CC(6) ) THEN
+            CALL RMMAR( RD,1,1 )
+            IF ( RD(1) .LE. 0.5 ) THEN
+C  HEAVY ISOBAR + PION
+              CALL BOX68
+            ELSE
+C  HEAVY MESON + NUCLEON
+              CALL BOX67
+            ENDIF
+          ELSEIF ( ECM .GT. CC(5) ) THEN
+C  LIGHT ISOBAR + PION
+            CALL BOX66
+          ELSE
+C  ELASTIC SCATTERING
+            CALL BOX65
+          ENDIF
+        ENDIF
+ 
+C-----------------------------------------------------------------------
+C  NUCLEON OR ANTINUCLEON INCIDENT
+      ELSEIF ( ITYPE .EQ. 13  .OR.  ITYPE .EQ. 14  .OR.
+     *         ITYPE .EQ. 15  .OR.  ITYPE .EQ. 25 ) THEN
+C  CALCULATE GAMMA, BETA AND ENERGY IN CENTER OF MASS
+        GCM       = SQRT( GAMMA * 0.5D0 + 0.5D0 )
+        ECM       = PAMA(ITYPE) * GCM * 2.D0
+        BETACM    = SQRT( 1.D0 - 1.D0 / GCM**2 )
+        IF ( DEBUG ) WRITE(MDEBUG,*) 'NUCINT: NUCL EKINL=',SNGL(EKINL)
+        INBIN(KJ) = INBIN(KJ) + 1
+ 
+C  LOW ENERGY HADRONIC INTERACTIONS
+C  USE GHEISHA IF THE CROSS SECTION HAS BEEN CALCULATED FOR GHEISHA
+        IF ( GHEISH ) THEN
+          IF ( GHESIG ) THEN
+            CALL CGHEI
+          ELSE
+            CALL SDPM
+          ENDIF
+        ELSE
+C  DETERMINE TYPE OF INTERACTION FOR NUCLEONS AND ANTINUCLEONS
+          IF     ( ECM .GT. CC(4) ) THEN
+C  DUAL PARTON MODEL
+            CALL SDPM
+          ELSEIF ( ECM .GT. CC(3) ) THEN
+C  USE THE INTERACTION ROUTINES OF PKF GRIEDER
+C  2 HEAVY ISOBARS AND ANNIHILATION
+            CALL BOX63
+          ELSEIF ( ECM .GT. CC(2) ) THEN
+C  1 HEAVY ISOBAR + NUCLEON AND ANNIHILATION
+            CALL BOX62
+          ELSEIF ( ECM .GT. CC(1) ) THEN
+C  1 LIGHT ISOBAR + NUCLEON AND ANNIHILATION
+            CALL BOX61
+          ELSE
+C  ELASTIC SCATTERING AND ANNIHILATION
+            CALL BOX60
+          ENDIF
+        ENDIF
+ 
+C-----------------------------------------------------------------------
+C  KAON INCIDENT
+      ELSEIF ( ITYPE .EQ. 11  .OR.  ITYPE .EQ. 12  .OR.
+     *         ITYPE .EQ. 10  .OR.  ITYPE .EQ. 16 ) THEN
+        IF ( DEBUG ) WRITE(MDEBUG,*) 'NUCINT: KAON EKINL=',SNGL(EKINL)
+        IKBIN(KJ) = IKBIN(KJ) + 1
+ 
+C  DECAY OR INTERACTION FOR KAONS ?
+        IF ( FDECAY ) THEN
+C  KAON DECAYS. DETERMINE DECAY MODE FOR KAONS AND SET LIFE TIME
+          IF     ( ITYPE .EQ. 10 ) THEN
+C  K(0,L)-MESON
+            IGO = 4
+          ELSEIF ( ITYPE .EQ. 11 ) THEN
+C  K(+)-MESON
+            IGO = 1
+          ELSEIF ( ITYPE .EQ. 12 ) THEN
+C  K(-)-MESON
+            IGO = 2
+          ELSE
+C  K(0,S)-MESON
+            IGO = 3
+          ENDIF
+          CALL KDECAY( IGO )
+          RETURN
+ 
+        ELSE
+C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  KAON INTERACTS
+C  CALCULATE GAMMA, BETA AND ENERGY IN CENTER OF MASS
+          ECM    = SQRT( CKA(13) * GAMMA + CKA(14) )
+          GCM    = ( PAMA(ITYPE) * GAMMA + PAMA(14) ) / ECM
+          BETACM = SQRT( 1.D0 - 1.D0 / GCM**2 )
+C  LOW ENERGY HADRONIC INTERACTIONS
+C  USE GHEISHA IF THE CROSS SECTION HAS BEEN CALCULATED FOR GHEISHA
+          IF ( GHEISH ) THEN
+            IF ( GHESIG ) THEN
+              CALL CGHEI
+            ELSE
+              CALL SDPM
+            ENDIF
+          ELSE
+C  KAON INTERACTS. DETERMINE TYPE OF INTERACTION FOR KAONS
+            IF     ( ECM .GT. CC(12) ) THEN
+C  DUAL PARTON MODEL
+              CALL SDPM
+C  USE THE INTERACTION ROUTINES OF PKF GRIEDER
+            ELSEIF ( ECM .GT. CC(11) ) THEN
+C  HEAVY ISOBAR + STRANGE MESON
+              CALL BOX74
+            ELSEIF ( ECM .GT. CC(10) ) THEN
+              CALL RMMAR( RD,1,1 )
+              IF ( RD(1) .GT. CKA(21) ) THEN
+C  HEAVY ISOBAR + KAON
+                CALL BOX73
+              ELSE
+C  STRANGE MESON + NUCLEON
+                CALL BOX72
+              ENDIF
+            ELSEIF ( ECM .GT. CC(9) ) THEN
+C  LIGHT ISOBAR + KAON
+              CALL BOX71
+            ELSE
+C  ELASTIC SCATTERING
+              CALL BOX70
+            ENDIF
+          ENDIF
+        ENDIF
+ 
+C-----------------------------------------------------------------------
+C  STRANGE BARYON (LAMDA, SIGMA) INCIDENT
+      ELSEIF ( (ITYPE .GE. 18  .AND.  ITYPE .LE. 24)  .OR.
+     *         (ITYPE .GE. 26  .AND.  ITYPE .LE. 32) ) THEN
+        IF ( DEBUG ) WRITE(MDEBUG,*) 'NUCINT: SBAR EKINL=',SNGL(EKINL)
+        IHBIN(KJ) = IHBIN(KJ) + 1
+C  DECAY OR INTERACTION FOR STRANGE BARYONS?
+        IF ( FDECAY ) THEN
+          CALL STRDEC
+          RETURN
+        ENDIF
+C  CALCULATE GAMMA, BETA AND ENERGY IN CENTER OF MASS
+        ECM    = SQRT( 2.D0 * PAMA(ITYPE) * PAMA(14) * GAMMA
+     *              + PAMA(ITYPE)**2 + PAMA(14)**2 )
+        GCM    = ( PAMA(ITYPE) * GAMMA + PAMA(14)) / ECM
+        BETACM = SQRT( 1.D0 - 1.D0 / GCM**2 )
+C  LOW ENERGY HADRONIC INTERACTIONS
+C  USE GHEISHA IF THE CROSS SECTION HAS BEEN CALCULATED FOR GHEISHA
+        IF ( GHEISH ) THEN
+          IF ( GHESIG ) THEN
+            CALL CGHEI
+          ELSE
+C  VENUS TREATS STRANGE BARYONS
+            CALL SDPM
+          ENDIF
+        ELSE
+          IF ( ECM .GT. CC(4) ) THEN
+            CALL SDPM
+          ELSE
+C  USE THE INTERACTION ROUTINES OF PKF GRIEDER
+C  ELASTIC SCATTERING
+            CALL BOX60
+          ENDIF
+        ENDIF
+ 
+C-----------------------------------------------------------------------
+C  HEAVY PRIMARY INCIDENT
+      ELSEIF ( ITYPE .GT. 100 ) THEN
+        IF (DEBUG) WRITE(MDEBUG,*) 'NUCINT: HEAVY PRIMARY EKINL=',
+     *                                               SNGL(EKINL)
+C  USE GHEISHA IF THE CROSS SECTION HAS BEEN CALCULATED FOR GHEISHA
+C   (THIS MIGHT BE THE CASE FOR DEUTERONS, TRITONS AND ALPHAS)
+        IF ( GHEISH ) THEN
+          IF ( GHESIG ) THEN
+            CALL CGHEI
+          ELSE
+            CALL SDPM
+          ENDIF
+        ELSE
+C  TREAT HEAVY PRIMARY IN SDPM
+          CALL SDPM
+        ENDIF
+ 
+C-----------------------------------------------------------------------
+C  ILLEGAL PARTICLE
+      ELSE
+        WRITE(MONIOU,*) 'NUCINT: ILLEGAL PARTICLE = ',ITYPE
+        STOP
+      ENDIF
+ 
+C-----------------------------------------------------------------------
+C  KILL PARTICLE
+      IRET1 = 1
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/outend.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/outend.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/outend.f	(revision 286)
@@ -0,0 +1,213 @@
+      SUBROUTINE OUTEND
+ 
+C-----------------------------------------------------------------------
+C  OUT(PUT AT) END (OF SHOWER)
+C
+C  WRITE REST OF PARTICLES TO OUTPUT BUFFER
+C  PRINTS INTERACTION LENGTHS STATISTICS
+C  THIS SUBROUTINE IS CALLED FROM MAIN
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,BAL.
+      COMMON /BAL/     EBAL
+      DOUBLE PRECISION EBAL(10)
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,CHISTA.
+      COMMON /CHISTA/  IHYCHI,IKACHI,IMUCHI,INNCHI,INUCHI,IPICHI
+      INTEGER          IHYCHI(124),IKACHI(124),IMUCHI(124),
+     *                 INNCHI(124),INUCHI(124),IPICHI(124)
+*KEEP,ELADPM.
+      COMMON /ELADPM/  ELMEAN,ELMEAA,IELDPM,IELDPA
+      DOUBLE PRECISION ELMEAN(37),ELMEAA(37)
+      INTEGER          IELDPM(37,13),IELDPA(37,13)
+*KEEP,MULT.
+      COMMON /MULT/    EKINL,MSMM,MULTMA,MULTOT
+      DOUBLE PRECISION EKINL
+      INTEGER          MSMM,MULTMA(37,13),MULTOT(37,13)
+*KEEP,NCOUNT.
+      COMMON /NCOUNT/  NCOUN
+      INTEGER          NCOUN(8)
+*KEEP,NPARTI.
+      COMMON /NPARTI/  NPARTO,MUOND
+      DOUBLE PRECISION NPARTO(10,25),NPHOTO(10),NPOSIT(10),NELECT(10),
+     *                 NNU(10),NMUP(10),NMUM(10),NPI0(10),NPIP(10),
+     *                 NPIM(10),NK0L(10),NKPL(10),NKMI(10),NNEUTR(10),
+     *                 NPROTO(10),NPROTB(10),NK0S(10),NHYP(10),
+     *                 NNEUTB(10),NDEUT(10),NTRIT(10),NALPHA(10),
+     *                 NOTHER(10),MUOND
+      EQUIVALENCE (NPARTO(1, 1),NPHOTO(1)), (NPARTO(1, 2),NPOSIT(1)),
+     *            (NPARTO(1, 3),NELECT(1)), (NPARTO(1, 4),NNU(1))   ,
+     *            (NPARTO(1, 5),NMUP(1))  , (NPARTO(1, 6),NMUM(1))  ,
+     *            (NPARTO(1, 7),NPI0(1))  , (NPARTO(1, 8),NPIP(1))  ,
+     *            (NPARTO(1, 9),NPIM(1))  , (NPARTO(1,10),NK0L(1))  ,
+     *            (NPARTO(1,11),NKPL(1))  , (NPARTO(1,12),NKMI(1))  ,
+     *            (NPARTO(1,13),NNEUTR(1)), (NPARTO(1,14),NPROTO(1)),
+     *            (NPARTO(1,15),NPROTB(1)), (NPARTO(1,16),NK0S(1))  ,
+     *            (NPARTO(1,18),NHYP(1))  , (NPARTO(1,19),NDEUT(1)) ,
+     *            (NPARTO(1,20),NTRIT(1)) , (NPARTO(1,21),NALPHA(1)),
+     *            (NPARTO(1,22),NOTHER(1)), (NPARTO(1,25),NNEUTB(1))
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,PBALA.
+      COMMON /PBALA/   PBAL
+      DOUBLE PRECISION PBAL(10)
+*KEEP,RECORD.
+      COMMON /RECORD/  IRECOR
+      INTEGER          IRECOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKF.
+      COMMON /STACKF/  STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+      INTEGER          MAXSTK
+      PARAMETER        (MAXSTK = 12*340*2)
+      DOUBLE PRECISION STACK(MAXSTK)
+      INTEGER          STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+*KEEP,STATI.
+      COMMON /STATI/   SABIN,SBBIN,INBIN,IPBIN,IKBIN,IHBIN
+      DOUBLE PRECISION SABIN(37),SBBIN(37)
+      INTEGER          INBIN(37),IPBIN(37),IKBIN(37),IHBIN(37)
+*KEND.
+ 
+      INTEGER I,J,K,NELMEA
+C-----------------------------------------------------------------------
+ 
+      IF ( LH .GT. 0 ) THEN
+        CALL TOBUF( DATAB,0 )
+        DO  2  I = 1,MAXBUF
+          DATAB(I) = 0.
+    2   CONTINUE
+      ENDIF
+      LH = 0
+ 
+      IF ( FPRINT .OR. DEBUG ) THEN
+        WRITE(MONIOU,101) NSHIFT,NOPART
+  101   FORMAT(' ',I10,' SHIFTS TO EXTERNAL STACK'/
+     *         ' ',I10,' PARTICLES WRITTEN TO PATAPE')
+ 
+        IF ( .NOT. GHEISH ) THEN
+          WRITE(MONIOU,103) (EBAL(I),I=1,10)
+  103     FORMAT (/' ENERGY BALANCE OF PARTICLE PRODUCTION PROCESSES'//
+     *             1P,5E20.8/5E20.8/)
+ 
+          WRITE(MONIOU,203) (PBAL(I),I=1,10)
+  203     FORMAT (' MOMENTUM BALANCE OF PARTICLE PRODUCTION PROCESSES'//
+     *          1P,5E20.8/5E20.8/)
+ 
+          WRITE(MONIOU,104) (NCOUN(K),K=1,8)
+  104     FORMAT(//
+     *      I10,' / ',I6,'  ANTINUCLEONS ENTER / ANNIHILATE IN BOX 60'/
+     *      I10,' / ',I6,'  ANTINUCLEONS ENTER / ANNIHILATE IN BOX 61'/
+     *      I10,' / ',I6,'  ANTINUCLEONS ENTER / ANNIHILATE IN BOX 62'/
+     *      I10,' / ',I6,'  ANTINUCLEONS ENTER / ANNIHILATE IN BOX 63'/)
+        ENDIF
+      ENDIF
+ 
+      IF ( FPRINT ) THEN
+C  PRINT ENERGY - MULTIPLICITY MATRIX
+        WRITE(MONIOU,209) SHOWNO,(K,K=1,13),
+     *  (J,(MULTMA(J,K),K=1,13),10**((J-4.)/3.),10**((J-3.)/3.),J=1,37),
+     *     1,(INT(10**((K-1.)/3.)+1 ),K = 2,13),
+     *     2,(INT(10**((K   )/3.)   ),K = 2,13)
+  209   FORMAT(//' ENERGY - MULTIPLICITY MATRIX OF SHOWER NO ',I10/
+     *           ' ENERGY RUNS VERTICALLY, MULTIPLICITY HORIZONTALLY'//
+     *           ' ',5X,5I9,3I8,5I7,'    ENERGY RANGE (GEV)'/
+     *           37(/' ',I4,1X,5I9,3I8,5I7,2X,1P,2E10.1,0P)//
+     *           ' MULT.',5I9,3I8,5I7,5X,'LOWER BIN LIMIT'/
+     *           ' RANGE',5I9,3I8,5I7,5X,'UPPER BIN LIMIT')
+      ENDIF
+ 
+C  GET MEAN OF ELASTICITY FOR ENERGY BINS
+      DO 3377  J = 1,37
+        NELMEA = 0
+        DO 3378  K = 1,10
+          NELMEA = NELMEA + IELDPM(J,K)
+ 3378   CONTINUE
+        IF ( NELMEA .NE. 0 ) ELMEAN(J) = ELMEAN(J) / NELMEA
+ 3377 CONTINUE
+ 
+      IF ( FPRINT ) THEN
+C  PRINT ENERGY - ELASTICITY MATRIX
+        WRITE(MONIOU,408) SHOWNO,(K,K=1,10),
+     *        (J,(IELDPM(J,K),K=1,10),
+     *        ELMEAN(J),10**((J-4.)/3.),10**((J-3.)/3.),J=1,37),
+     *        ((K-1)*0.1,K=1,10),(K*0.1,K=1,10)
+  408   FORMAT (//' ENERGY - ELASTICITY MATRIX OF SHOWER NO ',I10/
+     *            ' ENERGY RUNS VERTICALLY, ELASTICITY HORIZONTALLY'//
+     *            ' ',5X,10I9,'   MEAN EL.   ENERGY RANGE (GEV)'/
+     *            37(/' ',I4,1X,10I9,2X,1P,E10.3,2E10.1,0P)//
+     *            ' ELA. ',10F9.2,5X,'LOWER BIN LIMIT'/
+     *            ' RANGE',10F9.2,5X,'UPPER BIN LIMIT')
+ 
+        WRITE(MONIOU,204) SHOWNO
+  204   FORMAT(//' INTERACTIONS PER KINETIC ENERGY INTERVAL OF SHOWER',
+     *         ' NO ',I10//)
+ 
+        WRITE(MONIOU,205)
+  205   FORMAT('   BIN    LOWER LIMIT    UPPER LIMIT    ',
+     *         ' NUCLEON      PIONS      KAONS  S.BARYONS      TOTAL'/
+     *         '             IN GEV         IN GEV      ',
+     *         '  EVENTS     EVENTS     EVENTS     EVENTS  '/)
+        WRITE(MONIOU,207) (I,SABIN(I),SBBIN(I),INBIN(I),IPBIN(I),
+     *    IKBIN(I),IHBIN(I),INBIN(I)+IPBIN(I)+IKBIN(I)+IHBIN(I),I=1,37)
+  207   FORMAT(' ',I5,1P,2E15.4,0P,1X,5I11)
+ 
+        WRITE(MONIOU,301)
+  301   FORMAT (//' INTERACTION LENGTH STATISTICS: ',
+     *        '    1 BIN CORRESPONDS TO 10 G/CM**2 OR 1KM FOR MUONS'//
+     *        '  BIN      LAMBDA NU   LAMBDA PI   LAMBDA KA   ',
+     *                   'LAMBDA HY   LAMBDA MU   LAMBDA NUCLEUS'/)
+        WRITE(MONIOU,303) (I,INUCHI(I),IPICHI(I),IKACHI(I),IHYCHI(I),
+     *                      IMUCHI(I),INNCHI(I),I=1,124)
+  303   FORMAT (' ',I4,6I12)
+ 
+        WRITE(MONIOU,105) IRECOR
+  105   FORMAT (/' NO OF WORDS WRITTEN TO PARTICLE TAPE UP TO NOW =',
+     *           I10)
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/output.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/output.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/output.f	(revision 286)
@@ -0,0 +1,208 @@
+      SUBROUTINE OUTPUT
+ 
+C-----------------------------------------------------------------------
+C  (WRITE PARTICLE) OUTPUT
+C
+C  WRITES 39 PARTICLE RECORDS PER PHYSICAL RECORD
+C  TABULATES PARAMETERS OF ALL HIGH ENERGY PARTICLES WITH
+C  LORENTZ FACTOR LARGER THAN ECTMAP
+C  THIS SUBROUTINE IS CALLED FROM MAIN, BOX3, MUTRAC, AND AUSGAB
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,ETHMAP.
+      COMMON /ETHMAP/  ECTMAP,ELEFT
+      DOUBLE PRECISION ECTMAP,ELEFT
+*KEEP,MAGANG.
+      COMMON /MAGANG/  ARRANG,ARRANR,COSANG,SINANG
+      DOUBLE PRECISION ARRANG,ARRANR,COSANG,SINANG
+*KEEP,MULT.
+      COMMON /MULT/    EKINL,MSMM,MULTMA,MULTOT
+      DOUBLE PRECISION EKINL
+      INTEGER          MSMM,MULTMA(37,13),MULTOT(37,13)
+*KEEP,MUPART.
+      COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
+      DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
+      LOGICAL          FMUBRM,FMUORG
+*KEEP,NPARTI.
+      COMMON /NPARTI/  NPARTO,MUOND
+      DOUBLE PRECISION NPARTO(10,25),NPHOTO(10),NPOSIT(10),NELECT(10),
+     *                 NNU(10),NMUP(10),NMUM(10),NPI0(10),NPIP(10),
+     *                 NPIM(10),NK0L(10),NKPL(10),NKMI(10),NNEUTR(10),
+     *                 NPROTO(10),NPROTB(10),NK0S(10),NHYP(10),
+     *                 NNEUTB(10),NDEUT(10),NTRIT(10),NALPHA(10),
+     *                 NOTHER(10),MUOND
+      EQUIVALENCE (NPARTO(1, 1),NPHOTO(1)), (NPARTO(1, 2),NPOSIT(1)),
+     *            (NPARTO(1, 3),NELECT(1)), (NPARTO(1, 4),NNU(1))   ,
+     *            (NPARTO(1, 5),NMUP(1))  , (NPARTO(1, 6),NMUM(1))  ,
+     *            (NPARTO(1, 7),NPI0(1))  , (NPARTO(1, 8),NPIP(1))  ,
+     *            (NPARTO(1, 9),NPIM(1))  , (NPARTO(1,10),NK0L(1))  ,
+     *            (NPARTO(1,11),NKPL(1))  , (NPARTO(1,12),NKMI(1))  ,
+     *            (NPARTO(1,13),NNEUTR(1)), (NPARTO(1,14),NPROTO(1)),
+     *            (NPARTO(1,15),NPROTB(1)), (NPARTO(1,16),NK0S(1))  ,
+     *            (NPARTO(1,18),NHYP(1))  , (NPARTO(1,19),NDEUT(1)) ,
+     *            (NPARTO(1,20),NTRIT(1)) , (NPARTO(1,21),NALPHA(1)),
+     *            (NPARTO(1,22),NOTHER(1)), (NPARTO(1,25),NNEUTB(1))
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION AUGM,ETOT,PTOT,STT,XADDMU,YADDMU
+      INTEGER          I,IGG,III,NCOUNT
+      DATA             NCOUNT /0/,AUGM/1.D0/
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (OUTPAR(I),I=1,9)
+  444 FORMAT(' OUTPUT: OUTPAR=',1P,9E10.3)
+ 
+C  CORRECT X,Y COORDINATES FOR EACH LEVEL
+      OUTPAR(7) = OUTPAR(7) - XOFF(LEVL)
+      OUTPAR(8) = OUTPAR(8) - YOFF(LEVL)
+ 
+C  PRINT OUT PARTICLE IF IT IS ABOVE THE CUT
+      IF ( FPRINT .OR. DEBUG ) THEN
+        IF ( OUTPAR(2) .GE. ECTMAP ) THEN
+          WRITE(MONIOU,3) (OUTPAR(I),I=1,10), ELEFT
+    3     FORMAT(' OUTPUT:        ',1P,11E10.3)
+          IF (DEBDEL) THEN
+            NCOUNT = NCOUNT + 1
+            WRITE(MDEBUG,*)'OUTPUT: NCOUNT = ',NCOUNT
+            IF ( NCOUNT .GE. NDEBDL ) DEBUG = .TRUE.
+          ENDIF
+        ENDIF
+      ENDIF
+ 
+C  COUNT PARTICLES, THAT ARE WRITTEN TO TAPE
+      NOPART = NOPART + 1
+C  COUNT PARTICLES SPECIFIED BY THEIR PARTICLE CODE < 25
+      III    = NINT(OUTPAR(1))
+      IF     ( III .LT. 18 ) THEN
+        NPARTO(LEVL,III) = NPARTO(LEVL,III) + AUGM
+      ELSEIF ( (III .GE. 18  .AND.  III .LE. 24)  .OR.
+     *         (III .GE. 26  .AND.  III .LE. 32)      ) THEN
+        NHYP(LEVL) = NHYP(LEVL) + AUGM
+      ELSEIF ( III .EQ. 201 ) THEN
+        NDEUT(LEVL) = NDEUT(LEVL) + AUGM
+      ELSEIF ( III .EQ. 301 ) THEN
+        NTRIT(LEVL) = NTRIT(LEVL) + AUGM
+      ELSEIF ( III .EQ. 402 ) THEN
+        NALPHA(LEVL) = NALPHA(LEVL) + AUGM
+      ELSEIF ( III .GT. 33 ) THEN
+        WRITE(MONIOU,*) 'OUTPUT: PARTICLE ON OBSLEV ',LEVL,'  ID= ',III
+        NOTHER(LEVL) = NOTHER(LEVL) + AUGM
+      ELSE
+        NPARTO(LEVL,III) = NPARTO(LEVL,III) + AUGM
+      ENDIF
+ 
+C   TREATE ADDITIONAL INFORMATION OF MUONS
+C   THE COORDINATES OF MUON ORIGIN ARE STORED IN AMUPAR(.)
+      IF ( FMUADD  .AND. (III .EQ. 5  .OR. III .EQ. 6) ) THEN
+        DATAB(LH+1) = (III + 70.) * 1000.
+        PTOT = PAMA(III) * SQRT( AMUPAR(2)**2 - 1.D0 )
+        STT  = SQRT( 1.D0 - AMUPAR(3)**2 )
+        DATAB(LH+2) = PTOT * STT * COS( AMUPAR(4) + ARRANR )
+        DATAB(LH+3) = PTOT * STT * SIN( AMUPAR(4) + ARRANR )
+        DATAB(LH+4) = PTOT * AMUPAR(3)
+        XADDMU = AMUPAR(7) - XOFF(LEVL)
+        YADDMU = AMUPAR(8) - YOFF(LEVL)
+        DATAB(LH+5) = XADDMU * COSANG + YADDMU * SINANG
+        DATAB(LH+6) = YADDMU * COSANG - XADDMU * SINANG
+        DATAB(LH+7) = AMUPAR(5)
+        IF ( DEBUG ) WRITE(MDEBUG,445) (DATAB(LH+I),I=1,7)
+  445   FORMAT(' OUTPUT: MUADDI=',1P,8E10.3)
+        LH = LH + 7
+ 
+C  WRITE A BLOCK OF 39 PARTICLES TO OUTPUT BUFFER AND CLEAR FIELD
+        IF ( LH .GE. MAXBUF ) THEN
+          CALL TOBUF( DATAB,0 )
+          DO  1  I = 1,MAXBUF
+            DATAB(I) = 0.
+  1       CONTINUE
+          LH = 0
+        ENDIF
+      ENDIF
+ 
+C   COPY PARTICLE TO DATAB FIELD
+      IGG = MIN( OUTPAR(9), 99.D0 )
+      DATAB(LH+1) = III*1000 + IGG*10 + MOD(LEVL,10)
+      IF ( OUTPAR(1) .LE. 3.D0 ) THEN
+        ETOT = OUTPAR(2)
+      ELSE
+        ETOT = PAMA(III) * OUTPAR(2)
+      ENDIF
+      PTOT = SQRT( ETOT**2 - PAMA(III)**2 )
+      STT  = SQRT( 1.D0 - OUTPAR(3)**2 )
+      DATAB(LH+2) = PTOT * STT * COS( OUTPAR(4) + ARRANR )
+      DATAB(LH+3) = PTOT * STT * SIN( OUTPAR(4) + ARRANR )
+      DATAB(LH+4) = PTOT * OUTPAR(3)
+      DATAB(LH+5) = OUTPAR(7) * COSANG + OUTPAR(8) * SINANG
+      DATAB(LH+6) = OUTPAR(8) * COSANG - OUTPAR(7) * SINANG
+      DATAB(LH+7) = OUTPAR(6) * 1.E9
+      LH = LH + 7
+ 
+C  WRITE A BLOCK OF 39 PARTICLES TO OUTPUT BUFFER AND CLEAR FIELD
+      IF ( LH .GE. MAXBUF ) THEN
+        CALL TOBUF( DATAB,0 )
+        DO  2  I = 1,MAXBUF
+          DATAB(I) = 0.
+  2     CONTINUE
+        LH = 0
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/pair.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/pair.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/pair.f	(revision 286)
@@ -0,0 +1,117 @@
+      SUBROUTINE PAIR
+C                                VERSION 4.00  --  26 JAN 1986/1900
+C******************************************************************
+C   FOR A PHOTON ENERGY LESS THAN 2.1 MEV, THE APPROXIMATION IS
+C   MADE THAT ONE PAIR ELECTRON (OR POSITRON) HAS ONLY ITS REST
+C   MASS ENERGY.   FOR PHOTON ENERGY BETWEEN 2.1 MEV AND 50 MEV THE
+C   BETHE-HEITLER CROSS SECTION IS EMPLOYED.  ABOVE 50 MEV THE
+C   COULOMB CORRECTED BETHE-HEITLER CROSS SECTION IS USED.
+C   (BUTCHER AND MESSEL, OP. CIT., P. 17-19, 22).
+C******************************************************************
+      DOUBLE PRECISION PEIG,PESE1,PESE2
+      COMMON/BREMPR/DL1(6),DL2(6),DL3(6),DL4(6),DL5(6),DL6(6),DELCM, ALP
+     *HI(2),BPAR(2),DELPOS(2),PWR2I(50)
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' PAIR:  NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      PEIG=E(NP)
+      EIG=PEIG
+      IF (EIG.LE.2.1) THEN
+       ESE2=PRM
+      ELSE
+       IF (EIG.LT.50.) THEN
+        LVX=1
+        LVL0=0
+       ELSE
+        LVX=2
+        LVL0=3
+       END IF
+961    CONTINUE
+        CALL RMMAR(RD,2,2)
+        RNNO30=RD(1)
+        RNNO31=RD(2)
+        IF (RNNO31.GE.BPAR(LVX)) THEN
+         LVL=LVL0+1
+         CALL RMMAR(RD,2,2)
+         RNNO32=RD(1)
+         RNNO33=RD(2)
+         BR=0.5*(1.0-MAX(RNNO32,RNNO33,RNNO30))
+        ELSE
+         LVL=LVL0+3
+         BR=RNNO30*0.5
+        END IF
+        IF((BR.EQ.0.0))GO TO961
+        DEL=1.0/(EIG*BR*(1.0-BR))
+        IF((DEL.GE.DELPOS(LVX)))GO TO961
+        DELTA=DELCM*DEL
+        IF (DELTA.LT.1.0) THEN
+         REJF=DL1(LVL)+DELTA*(DL2(LVL)+DELTA*DL3(LVL))
+        ELSE
+         REJF=DL4(LVL)+DL5(LVL)*LOG(DELTA+DL6(LVL))
+        END IF
+        CALL RMMAR(RNSCRN,1,2)
+        IF((RNSCRN.LE.REJF))GO TO962
+       GO TO 961
+962    CONTINUE
+       ESE2=BR*EIG
+      END IF
+      PESE2=ESE2
+      PESE1=PEIG-PESE2
+      E(NP)=PESE1
+      E(NP+1)=PESE2
+      THETA=RM/EIG
+      CALL UPHI(1,1)
+      NP=NP+1
+      SINTHE=-SINTHE
+      CALL UPHI(3,2)
+      CALL RMMAR(RNNO34,1,2)
+      IF (RNNO34.LE.0.5) THEN
+       IQ(NP)=2
+       IQ(NP-1)=3
+      ELSE
+       IQ(NP)=3
+       IQ(NP-1)=2
+      END IF
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/pamaf.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/pamaf.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/pamaf.f	(revision 286)
@@ -0,0 +1,150 @@
+      SUBROUTINE PAMAF
+ 
+C-----------------------------------------------------------------------
+C  PA(RTICLE) MA(SS) F(ILLING)
+C
+C  FILLS PARTICLE MASS FOR PARTICLE IP IN ARRAY PAMA
+C  RESONANCES AND STRANGE BARYONS INCLUDED
+C  PARTICLE MASSES ACCORDING TO GEANT TABLE,
+C  TAKEN FROM THE PERIODIC TABLE
+C  OR CALCULATED WITH THE MASS FORMULA OF WEIZSAECKER
+C  THIS SUBROUTINE IS CALLED FROM START
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEND.
+ 
+      DOUBLE PRECISION AMUS(59,14),BIND,B1,B2,B3,B4,B5,CHARGE(75),
+     *                 MASSES(75),SS
+      INTEGER          I,IA,IC,IN,IP,L
+C-----------------------------------------------------------------------
+      DATA MASSES /
+     * 0.0D0      ,.51099906D-3,.51099906D-3, 0.0D0      ,.105658389D0,
+     *.105658389D0, .1349743D0 , .1395679D0 , .1395679D0 , 0.497671D0 ,
+     * 0.493646D0 , 0.493646D0 ,.93956563D0 ,.93827231D0 ,.93827231D0 ,
+     * 0.497671D0 , 0.54745D0  , 1.11563D0  , 1.18937D0  , 1.19255D0  ,
+     * 1.197465D0 , 1.31485D0  , 1.32133D0  , 1.67243D0  ,.93956563D0 ,
+     * 1.11563D0  , 1.18937D0  , 1.19255D0  , 1.19743D0  , 1.31485D0  ,
+     * 1.32133D0  , 1.67243D0  , 1.7841D0   , 1.7841D0   , 1.8693D0   ,
+     * 1.8693D0   , 1.8645D0   , 1.8645D0   , 1.9693D0   , 1.9693D0   ,
+     * 2.2852D0   , 80.6D0     , 80.6D0     , 91.161D0   , 1.877D0    ,
+     * 2.817D0    , 3.755D0    , 0.0D0      , 0.0D0      , 0.0D0      ,
+     * 0.7669D0   , 0.7681D0   , 0.7681D0   , 1.2309D0   , 1.2323D0   ,
+     * 1.2336D0   , 1.2349D0   , 1.2309D0   , 1.2323D0   , 1.2336D0   ,
+     * 1.2349D0   , 0.89624D0  , 0.89209D0  , 0.89209D0  , 0.89624D0  ,
+     * 0.0D0      , 0.0D0      , 0.0D0      , 0.0D0      , 0.0D0      ,
+     * 0.54745D0  , 0.54745D0  , 0.54745D0  , 0.54745D0  , 0.0D0      /
+ 
+      DATA CHARGE /
+     *  0.D0,+1.D0,-1.D0, 0.D0,+1.D0,-1.D0, 0.D0,+1.D0,-1.D0, 0.D0,
+     * +1.D0,-1.D0, 0.D0,+1.D0,-1.D0, 0.D0, 0.D0, 0.D0,+1.D0, 0.D0,
+     * -1.D0, 0.D0,-1.D0,-1.D0, 0.D0, 0.D0,-1.D0, 0.D0,+1.D0, 0.D0,
+     * +1.D0,+1.D0,+1.D0,-1.D0,+1.D0,-1.D0, 0.D0, 0.D0,+1.D0,-1.D0,
+     * +1.D0,+1.D0,-1.D0, 0.D0,+1.D0,+1.D0,+2.D0, 0.D0, 0.D0, 0.D0,
+     *  0.D0,+1.D0,-1.D0,+2.D0,+1.D0, 0.D0,-1.D0,-2.D0,-1.D0, 0.D0,
+     * +1.D0, 0.D0,+1.D0,-1.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
+     *  0.D0, 0.D0, 0.D0, 0.D0, 0.D0 /
+ 
+C  ISOTOPE MASSES CALCULATED FROM: ATOMIC DATA AND NUCL.DATA TABLES 39
+C  (1988) 289, (WAPSTRA'S VALUES, CORRECTED FOR ELECTRON MASSES)
+      DATA ((AMUS(I,L),I=1,59),L=1,7) /
+     * 1.8756D0,  2.8089D0,                                    57*0.D0,
+     * 2.8083D0,  3.7273D0,  4.6678D0,  5.6054D0,  6.5454D0,   54*0.D0,
+     * 2*0.D0  ,  5.6014D0,  6.5337D0,  7.4712D0,  8.4067D0,
+     *                       9.3471D0, 10.2856D0,              51*0.D0,
+     * 2*0.D0  ,  6.5341D0,  7.4547D0,  8.3926D0,  9.3253D0,
+     *                      10.2644D0, 11.2008D0,              51*0.D0,
+     * 2*0.D0  ,  7.4722D0,  8.3932D0,  9.3243D0, 10.2524D0,
+     *           11.1886D0, 12.1232D0, 13.0618D0, 13.9986D0,   49*0.D0,
+     * 2*0.D0  ,  8.4091D0,  9.3274D0, 10.2538D0, 11.1747D0, 12.1093D0,
+     *           13.0406D0, 13.9790D0, 14.9143D0, 15.8531D0,   48*0.D0,
+     * 4*0.D0  , 11.1915D0, 12.1110D0, 13.0400D0, 13.9687D0, 14.9057D0,
+     *           15.8394D0, 16.7761D0, 17.7104D0,              47*0.D0/
+      DATA ((AMUS(I,L),I=1,59),L=8,14) /
+     * 4*0.D0, 12.1282D0, 13.0446D0, 13.9709D0, 14.8948D0, 15.8302D0,
+     *             16.7617D0, 17.6973D0, 18.6293D0, 19.5650D0, 46*0.D0,
+     * 7*0.D0, 15.8325D0, 16.7629D0, 17.6920D0, 18.6429D0, 19.5564D0,
+     *             20.4907D0, 21.4227D0, 22.3587D0,            44*0.D0,
+     * 6*0.D0, 15.8464D0, 16.7668D0, 17.6947D0, 18.6174D0, 19.5502D0,
+     *  20.4794D0, 21.4137D0, 22.3444D0, 23.2839D0, 24.2138D0, 43*0.D0,
+     * 8*0.D0, 18.6308D0, 19.5532D0, 20.4817D0, 21.4088D0, 22.3414D0,
+     *  23.2720D0, 24.2059D0, 25.1387D0, 26.0746D0, 27.0099D0,
+     *  27.9469D0, 28.8820D0, 29.8173D0, 30.7546D0, 31.6913D0, 36*0.D0,
+     * 7*0.D0, 18.6410D0, 19.5658D0, 20.4860D0, 21.4124D0, 22.3354D0,
+     *  23.2676D0, 24.1961D0, 25.1292D0, 26.0602D0, 26.9961D0,
+     *  27.9291D0, 28.8660D0, 29.7994D0, 30.7376D0,            38*0.D0,
+     * 9*0.D0, 21.4241D0, 22.3488D0, 23.2714D0, 24.1996D0, 25.1261D0,
+     *  26.0579D0, 26.9880D0, 27.9218D0, 28.8541D0, 29.7894D0,
+     *  30.7233D0, 31.6599D0, 32.5944D0, 33.5316D0,            36*0.D0,
+     * 9*0.D0, 22.3591D0, 23.2836D0, 24.2041D0, 25.1304D0, 26.0527D0,
+     *  26.9838D0, 27.9128D0, 28.8457D0, 29.7761D0, 30.7111D0,
+     *  31.6431D0, 32.5803D0, 33.5128D0, 34.4505D0, 35.3837D0, 35*0.D0/
+C-----------------------------------------------------------------------
+ 
+C  GEANT PARTICLES  INCLUDING RHO, K*, AND DELTA
+      DO  1  IP = 1,75
+        PAMA  (IP) = MASSES(IP)
+        SIGNUM(IP) = CHARGE(IP)
+  1   CONTINUE
+ 
+C  RESET REST OF THE ARRAY
+      DO  2  IP = 76,6000
+        PAMA  (IP) = 0.D0
+        SIGNUM(IP) = 0.D0
+  2   CONTINUE
+ 
+      DO  3  IA = 1,59
+      DO  3  IC = 1,IA
+        IN = IA - IC
+        IP = IA * 100 + IC
+cc      IF ( IC .LE. 14 ) THEN
+C  MASSES FROM MASS TABLE FOR ISOTOPES
+cc        IF ( IN .EQ. 0 ) THEN
+cc          PAMA(IP) = IC * PAMA(14)
+cc        ELSE
+cc          PAMA(IP) = AMUS(IN,IC)
+cc        ENDIF
+C  SIMPLE SUM OF PROTON AND NEUTRON MASSES
+cc        IF ( PAMA(IP) .EQ. 0.D0 )
+cc   *               PAMA(IP) = IC * PAMA(14) + IN * PAMA(13)
+cc      ELSE
+C  WEIZSAECKERS MASS FORMULA GIVES BINDING ENERGY IN MEV
+cc        B1 =  14.1D0 * IA
+cc        B2 = -13.D0 * IA**TB3
+cc        B3 = -0.595D0 * IC**2 / IA**OB3
+cc        B4 = -19.D0 * (IC-IN)**2 / IA
+cc        B5 =  33.5D0 / IA**0.75D0
+cc        IF     ( MOD(IC,2) .EQ. 0  .AND.  MOD(IN,2) .EQ. 0 ) THEN
+cc          SS =  1.D0
+cc        ELSEIF ( MOD(IC,2) .EQ. 1  .AND.  MOD(IN,2) .EQ. 1 ) THEN
+cc          SS = -1.D0
+cc        ELSE
+cc          SS =  0.D0
+cc        ENDIF
+cc        BIND = (B1 + B2 + B3 + B4 + SS*B5)* 1.D-3
+cc        BIND = MAX( 0.D0, BIND )
+cc        PAMA(IP) = IN * MASSES(13) + IC * MASSES(14) - BIND
+cc      ENDIF
+ 
+C  DO NOT USE BINDING ENERGY EFFECTS
+        PAMA(IP) = IN * MASSES(13) + IC * MASSES(14)
+ 
+C  NUCLEI ARE ASSUMED TO BE FULLY IONIZED
+        SIGNUM(IP) = +IC
+  3   CONTINUE
+ 
+C  MASSES OF MULTINEUTRON CLUSTERS
+      DO  4  IN = 1,59
+        IP = 100 * IN
+        PAMA  (IP) = IN * PAMA(13)
+        SIGNUM(IP) = 0.D0
+  4   CONTINUE
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/parnum.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/parnum.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/parnum.f	(revision 286)
@@ -0,0 +1,282 @@
+      SUBROUTINE PARNUM( INUMFL )
+ 
+C-----------------------------------------------------------------------
+C  PART(ICLE TYPE) NUM(BERS)
+C
+C  DETERMINES THE NUMBERS OF SECONDARY PARTICLES FOR EACH TYPE
+C  THIS SUBROUTINE IS CALLED FROM HDPM
+C  ARGUMENT
+C   INUMFL = 0  CORRECT DETERMINATION OF PARTICLE NUMBERS
+C          = 1  SOMETHING WENT WRONG WITH NEUTRAL PARTICLE NUMBERS
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,EDECAY.
+      COMMON /EDECAY/  CETA
+      DOUBLE PRECISION CETA(5)
+*KEEP,INDICE.
+      COMMON /INDICE/  NNUCN,NKA0,NHYPN,NETA,NETAS,NPIZER,
+     *                 NNC,NKC,NHC,NPC,NCH,NNN,NKN,NHN,NET,NPN
+      INTEGER          NNUCN(2:3),NKA0(2:3),NHYPN(2:3),NETA(2:3,1:4),
+     *                 NETAS(2:3),NPIZER(2:3),
+     *                 NNC,NKC,NHC,NPC,NCH,NNN,NKN,NHN,NET,NPN
+*KEEP,INTER.
+      COMMON /INTER/   AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
+     *                 IDIF,ITAR
+      DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
+      INTEGER          IDIF,ITAR
+*KEEP,LEPAR.
+      COMMON /LEPAR/   LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
+      INTEGER          LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RATIOS.
+      COMMON /RATIOS/  RPI0R,RPIER,RPEKR,RPEKNR,PPICH,PPINCH,PPNKCH,
+     *                 ISEL,NEUTOT,NTOTEM
+      DOUBLE PRECISION RPI0R,RPIER,RPEKR,RPEKNR,PPICH,PPINCH,PPNKCH
+      INTEGER          ISEL,NEUTOT,NTOTEM
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      REAL RDETA
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'PARNUM: NCH,NEUTOT,NTOTEM=',
+     *                                      NCH,NEUTOT,NTOTEM
+ 
+      INUMFL = 0
+C  RESET PARTICLE NUMBERS
+      NNC = 0
+      NKC = 0
+      NHC = 0
+      NPC = 0
+C  ISEL IS 1 MEANS VERY LOW MULTIPLICITY
+C  CREATE ONLY PIONS (TO RISKY TO CREATE OTHER PARTICLES)
+      IF ( ISEL .EQ. 1 ) THEN
+        NNN = 0
+        NKN = 0
+        NET = 0
+        NHN = 0
+        NPN = 0
+        NETAS(2) = 0
+        NETAS(3) = 0
+C  CREATE RANDOM NUMBERS
+        CALL RMMAR( RD,NTOTEM,1 )
+        DO 1000  I = 1,NTOTEM
+          IF ( RD(I) .LE. TB3 ) THEN
+            NPC = NPC + 1
+          ELSE
+            NPN = NPN + 1
+          ENDIF
+ 1000   CONTINUE
+C  NO NEUTRAL PARTICLES FOR THE 3RD STRING EXCEPT EVENTUALLY PI(0)
+        NNUCN(3)  = 0
+        NKA0(3)   = 0
+        NHYPN(3)  = 0
+        NETAS(3)  = 0
+        NPIZER(3) = MAX( 0, NINT(RC3TO2/(1.D0+RC3TO2)*DBLE(NPN)) )
+        IF ( DEBUG ) WRITE(MDEBUG,*) '   ISEL=1, NTOTEM=',NTOTEM
+ 
+      ELSE
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  NOW THE CASE OF HAVING ENOUGH PARTICLES TO BE ABLE TO CREATE
+C  KAONS, NUCLEONS, AND HYPERONS TOO.
+ 
+C  ...FOR NEUTRALS
+        NCOUNT = 0
+C  BEGIN OF REJECT LOOP
+ 1002   K = 1
+        CALL RMMAR( RD,NEUTOT+3,1 )
+C  DETERMINE NUMBER OF PI(0), ETA, K0S/K0 PAIRS, NEUTRON/ANTINEUTRON
+C  PAIRS, AND NEUTRAL HYPERON PAIRS  AND SUM UP THE GAMMAS
+C  FOR 1ST + 2ND STRING: J IS 2;  FOR 3RD STRING: J IS 3
+        SGAMMA = 0.D0
+        DO 1010  J = 2,3
+          NNUCN(J)  = 0
+          NKA0(J)   = 0
+          NHYPN(J)  = 0
+          NETA(J,1) = 0
+          NETA(J,2) = 0
+          NETA(J,3) = 0
+          NETA(J,4) = 0
+          NPIZER(J) = 0
+          IF ( J .EQ. 2 ) THEN
+C  SET BOUNDARY FOR GAMMA SUM
+            GABOU = SEUGF
+            NNTOT = INT(FNEUT2)
+C  CALCULATE BOUNDARY NNTOT OF PARTICLE LOOP RATHER AT RANDOM THAN BY
+C  ROUNDING OF FNEUT2 TO AVOID DIGITIZING EFFECTS ON THE NEUTRAL
+C  PARTICLE COMPOSITION AT COLLISIONS WITH LOW MULTIPLICITY
+            IF ( NNTOT+RD(NEUTOT+2) .GE. FNEUT2 ) NNTOT = NNTOT+1
+          ELSE
+            IF ( RC3TO2 .LE. 0.D0 ) GOTO 1010
+            GABOU = GABOU + SEUGF* RC3TO2
+            NNTOT = INT(FNEUT)
+            IF ( NNTOT+RD(NEUTOT+3) .GE. FNEUT ) NNTOT = NNTOT+1
+          ENDIF
+          IF ( DEBUG ) WRITE(MDEBUG,*) '   J,NNTOT=',J,NNTOT
+C  START NEUTRAL PARTICLE PRODUCTION LOOP
+ 1003     CONTINUE
+          IF     ( K .LT. NNTOT ) THEN
+            RNDM = RD(K)
+          ELSEIF ( K .EQ. NNTOT ) THEN
+C  RENORMALIZE THE RANDOM NUMBER, THAT ONLY PI(0) OR ETA IS PRODUCED
+C  BUT PAIR PRODUCTION BECOMES IMPOSSIBLE
+            RNDM = RD(K) * RPIER
+          ELSEIF ( K .GT. NNTOT ) THEN
+            GOTO 1010
+          ENDIF
+          IF     ( RNDM .LE. RPI0R ) THEN
+C  PI(0)
+            SGAMMA    = SGAMMA + 2.D0
+            NPIZER(J) = NPIZER(J) + 1
+            K = K + 1
+ 
+          ELSEIF ( RNDM .LE. RPIER ) THEN
+C  ETA
+            CALL RMMAR( RDETA,1,1 )
+            IF     ( RDETA .LE. CETA(1) ) THEN
+              SGAMMA    = SGAMMA + 2.D0
+              NETA(J,1) = NETA(J,1) + 1
+            ELSEIF ( RDETA .LE. CETA(2) ) THEN
+              SGAMMA    = SGAMMA + 6.D0
+              NETA(J,2) = NETA(J,2) + 1
+            ELSEIF ( RDETA .LE. CETA(3) ) THEN
+              SGAMMA    = SGAMMA + 2.D0
+              NETA(J,3) = NETA(J,3) + 1
+            ELSE
+              SGAMMA    = SGAMMA + 1.D0
+              NETA(J,4) = NETA(J,4) + 1
+            ENDIF
+            K = K + 1
+ 
+          ELSEIF ( RNDM .LE. RPEKR ) THEN
+C  K0S/K0L PAIR; RPEKR IS NORMALIZED FOR K0 PAIR FORMATION
+C  THE UA5 GAMMA YIELD DOES NOT INCLUDE GAMMAS FROM K DECAY !!!
+C  SEE: ANSORGE ET AL., Z. PHYS. C43 (1989) 75
+            NKA0(J) = NKA0(J) + 1
+            K = K + 2
+          ELSEIF ( RNDM .LE. RPEKNR ) THEN
+C  NEUTRON-ANTINEUTRON PAIR
+            NNUCN(J) = NNUCN(J) + 1
+            K = K + 2
+          ELSE
+C  HYPERON-ANTIHYPERON PAIR
+C  AVERAGE NEUTRAL HYPERON PAIR L0 --> .357*2 GAMMAS = 0.714 GAMMAS
+C                               S0 --> L0 + 1 GAMMA  = 1.714 GAMMAS
+C  THEY ARE INCLUDED IN UA5 GAMMA MULTIPLICITIES, THEREFORE COUNT
+            SGAMMA   = SGAMMA + 2.428D0
+            NHYPN(J) = NHYPN(J) + 1
+            K = K + 2
+          ENDIF
+          GOTO 1003
+ 1010   CONTINUE
+        IF ( DEBUG ) WRITE(MDEBUG,1020) ( 2*NNUCN(J),2*NKA0(J),
+     *            2*NHYPN(J),NETA(J,1),NETA(J,2),NETA(J,3),NETA(J,4),
+     *            NPIZER(J),J=2,3 ), NNTOT,GABOU,SGAMMA,SGAMMA/GABOU
+ 1020   FORMAT(' PARNUM: NEUTRALS (1.,2.STRING)=',8I5,/
+     *         '         NEUTRALS (3. STRING)  =',8I5,/
+     *         '  NNTOT,SEUGF2+3,SGAMMA,RATIO=',I6,3(2X,F10.5))
+C  REJECT ALL NEUTRALS, IF SUM OF GAMMAS DEVIATES BY MORE THAN SIGMA
+        IF ( (SGAMMA - GABOU)**2 .GT. GABOU ) THEN
+          NCOUNT = NCOUNT + 1
+C  AFTER 20 TRIES SET FLAG INUMFL TO 1 AND RETURN
+          IF ( NCOUNT .LE. 20 ) GOTO 1002
+          INUMFL = 1
+          RETURN
+        ENDIF
+C  ALL NEUTRALS
+        NNN = NNUCN(2)  + NNUCN(3)
+        NKN = NKA0(2)   + NKA0(3)
+        NHN = NHYPN(2)  + NHYPN(3)
+        NETAS(2) = NETA(2,1) + NETA(2,2) + NETA(2,3) + NETA(2,4)
+        NETAS(3) = NETA(3,1) + NETA(3,2) + NETA(3,3) + NETA(3,4)
+        NET = NETAS(2)  + NETAS(3)
+        NPN = NPIZER(2) + NPIZER(3)
+ 
+C  ...FOR CHARGED
+        I = 1
+        CALL RMMAR( RD,NCH-1,1 )
+C  START CHARGED PARTICLE PRODUCTION LOOP
+ 1101   CONTINUE
+        RNDM = RD(I)
+        IF     ( RNDM .LT. PPICH  ) THEN
+C  PI(+-)
+          NPC = NPC + 1
+          I   = I + 1
+        ELSEIF ( RNDM .LT. PPINCH ) THEN
+C  PROTON/ANTIPROTON PAIR
+          NNC = NNC + 1
+          I   = I + 2
+        ELSEIF ( RNDM .LT. PPNKCH ) THEN
+C  KAON(+,-) PAIR
+          NKC = NKC + 1
+          I   = I + 2
+        ELSE
+C  CHARGED HYPERON/ANTIHYPERON PAIR
+          NHC = NHC + 1
+          I   = I + 2
+        ENDIF
+        IF     ( I .LT. NCH ) THEN
+          GOTO 1101
+        ELSEIF ( I .EQ. NCH ) THEN
+C  ONLY 1 CHARGED PARTICLE TO BE PRODUCED WHICH IS PI(+-)
+          NPC = NPC + 1
+        ENDIF
+C  CORRECT CHARGED PION NUMBER FOR DECAY OF ETA'S
+        NCORR = 2 * ( NETA(2,3) + NETA(2,4) + NETA(3,3) + NETA(3,4) )
+        NPC   = MAX( 0, NPC - NCORR )
+        IF ( DEBUG ) WRITE(MDEBUG,*) '   NPC,NPN,NCORR,LASTPI=',
+     *                                   NPC,NPN,NCORR,LASTPI
+      ENDIF
+C  CORRECT NUMBER OF CHARGED AND NEUTRAL PIONS FOR RESONANCE DECAY
+C  (NRESPC, NRESPN)
+      NPC = MAX( 0, NPC - NRESPC + LASTPI )
+C  INCREASE NPN ADDITIONALLY BY 1 TO MEET UA5 DATA, WHICH REPRODUCE ON
+C  AVERAGE ONE EXCHANGED CHARGE (LASTPI = +1).
+      NPN = MAX( 0, NPN - NRESPN - LASTPI + 1 )
+C  TOTAL NUMBER OF CHARGED PARTICLES
+      NCH = (NNC + NKC + NHC) * 2 + NPC
+C  NOW ALL PARTICLES ARE DETERMINED
+      IF ( DEBUG ) WRITE(MDEBUG,*)
+     *             'PARNUM: TOT.CHARGED=',2*NNC,2*NKC,2*NHC,NPC,
+     *             'PARNUM: TOT.NEUTRAL=',2*NNN,2*NKN,2*NHN,NET,NPN
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/parrap.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/parrap.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/parrap.f	(revision 286)
@@ -0,0 +1,204 @@
+      SUBROUTINE PARRAP
+ 
+C-----------------------------------------------------------------------
+C  PAR(TICLE) RAP(IDITY)
+C
+C  ROUTINE GIVES THE NEW PARTICLES OF HDPM THEIR RAPIDITIES
+C  THIS SUBROUTINE IS CALLED FROM HDPM
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,INTER.
+      COMMON /INTER/   AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
+     *                 IDIF,ITAR
+      DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
+      INTEGER          IDIF,ITAR
+*KEEP,NEWPAR.
+      COMMON /NEWPAR/  EA,PT2,PX,PY,TMAS,YR,ITYP,
+     *                 IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
+     *                 IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
+      DOUBLE PRECISION EA(3000),PT2(3000),PX(3000),PY(3000),TMAS(3000),
+     *                 YR(3000)
+      INTEGER          ITYP(3000),
+     *                 IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
+     *                 IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      REAL RAND(3000)
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'PARRAP: NTOT=',NTOT
+ 
+C  PROTON ANTIPROTON PAIRS
+      CALL RMMAR( RAND(3),IJ1-2,1 )
+      DO 1013  K = 3,IB1
+C  GENERATION OF RAPIDITY FOR EXTRA PARTICLES FROM TARGET.
+        IF ( K .LE. IA2 ) THEN
+          YR(K) = RANNOR(-POSC3,WIDC3)
+        ELSE
+C  GENERATION OF RAPIDITY FOR PARTICLES FROM PP-COLLISION AND PROJECTILE
+          IF ( RAND(K) .LE. 0.5 ) THEN
+            YR(K) = RANNOR(POSC2,WIDC2)
+          ELSE
+            YR(K) = RANNOR(-POSC2,WIDC2)
+          ENDIF
+        ENDIF
+ 1013 CONTINUE
+ 
+C  K+ K- PAIRS
+      DO 1014  K = IB1+1,IC1
+        IF ( K .LE. IB2 ) THEN
+C  GENERATION OF RAPIDITY FOR EXTRA PARTICLES FROM TARGET.
+          YR(K) = RANNOR(-POSC3,WIDC3)
+        ELSE
+C  GENERATION OF RAPIDITY FOR PARTICLES FROM PP-COLLISION AND PROJECTILE
+          IF ( RAND(K) .LE. 0.5 ) THEN
+            YR(K) = RANNOR(POSC2,WIDC2)
+          ELSE
+            YR(K) = RANNOR(-POSC2,WIDC2)
+          ENDIF
+        ENDIF
+ 1014 CONTINUE
+ 
+C  CHARGED HYPERON PAIRS
+      DO 1015  K = IC1+1,ID1
+        IF ( K .LE. IC2 ) THEN
+C  GENERATION OF RAPIDITY FOR EXTRA PARTICLES FROM TARGET.
+          YR(K) = RANNOR(-POSC3,WIDC3)
+        ELSE
+C  GENERATION OF RAPIDITY FOR PARTICLES FROM PP-COLLISION AND PROJECTILE
+          IF ( RAND(K) .LE. 0.5 ) THEN
+            YR(K) = RANNOR(POSC2,WIDC2)
+          ELSE
+            YR(K) = RANNOR(-POSC2,WIDC2)
+          ENDIF
+        ENDIF
+ 1015 CONTINUE
+ 
+C  PI +-
+      DO 1017  K = ID1+1,IE1
+        IF ( K .LE. ID2 ) THEN
+C  GENERATION OF RAPIDITY FOR EXTRA PARTICLES FROM TARGET.
+          YR(K) = RANNOR(-POSC3,WIDC3)
+        ELSE
+C  GENERATION OF RAPIDITY FOR PARTICLES FROM PP-COLLISION AND PROJECTILE
+          IF ( RAND(K) .LE. 0.5 ) THEN
+            YR(K) = RANNOR(POSC2,WIDC2)
+          ELSE
+            YR(K) = RANNOR(-POSC2,WIDC2)
+          ENDIF
+        ENDIF
+ 1017 CONTINUE
+ 
+C  NEUTRON ANTINEUTRON PAIRS
+      DO 1021  K = IE1+1,IF1
+        IF ( K .LE. IE2 ) THEN
+C  GENERATION OF RAPIDITY FOR EXTRA PARTICLES FROM TARGET.
+          YR(K) = RANNOR(-POSC3,WIDC3)
+        ELSE
+C  GENERATION OF RAPIDITY FOR PARTICLES FROM PP-COLLISION AND PROJECTILE
+          IF ( RAND(K) .LE. 0.5 ) THEN
+            YR(K) = RANNOR(POSC2,WIDC2)
+          ELSE
+            YR(K) = RANNOR(-POSC2,WIDC2)
+          ENDIF
+        ENDIF
+ 1021 CONTINUE
+ 
+C  K0L K0S PAIRS
+      DO 1022  K = IF1+1,IG1
+        IF ( K .LE. IF2 ) THEN
+C  GENERATION OF RAPIDITY FOR EXTRA PARTICLES FROM TARGET.
+          YR(K) = RANNOR(-POSC3,WIDC3)
+        ELSE
+C  GENERATION OF RAPIDITY FOR PARTICLES FROM PP-COLLISION AND PROJECTILE
+          IF ( RAND(K) .LE. 0.5 ) THEN
+            YR(K) = RANNOR(POSC2,WIDC2)
+          ELSE
+            YR(K) = RANNOR(-POSC2,WIDC2)
+          ENDIF
+        ENDIF
+ 1022 CONTINUE
+ 
+C  NEUTRAL HYPERON PAIRS
+      DO 1023  K = IG1+1,IH1
+        IF ( K .LE. IG2 ) THEN
+C  GENERATION OF RAPIDITY FOR EXTRA PARTICLES FROM TARGET.
+          YR(K) = RANNOR(-POSC3,WIDC3)
+        ELSE
+C  GENERATION OF RAPIDITY FOR PARTICLES FROM PP-COLLISION AND PROJECTILE
+          IF ( RAND(K) .LE. 0.5 ) THEN
+            YR(K) = RANNOR(POSC2,WIDC2)
+          ELSE
+            YR(K) = RANNOR(-POSC2,WIDC2)
+          ENDIF
+        ENDIF
+ 1023 CONTINUE
+ 
+C  ETA
+      DO 1025  K = IH1+1,II1
+        IF ( K .LE. IH2 ) THEN
+C  GENERATION OF RAPIDITY FOR EXTRA PARTICLES FROM TARGET.
+          YR(K) = RANNOR(-POSN3,WIDN3)
+        ELSE
+C  GENERATION OF RAPIDITY FOR PARTICLES FROM PP-COLLISION AND PROJECTILE
+          IF ( RAND(K) .LE. 0.5 ) THEN
+            YR(K) = RANNOR(POSN2,WIDN2)
+          ELSE
+            YR(K) = RANNOR(-POSN2,WIDN2)
+          ENDIF
+        ENDIF
+ 1025 CONTINUE
+ 
+C PI(0)
+      DO 1026  K = II1+1,IJ1
+        IF ( K .LE. II2 ) THEN
+C  GENERATION OF RAPIDITY FOR EXTRA PARTICLES FROM TARGET.
+          YR(K) = RANNOR(-POSN3,WIDN3)
+        ELSE
+C  GENERATION OF RAPIDITY FOR PARTICLES FROM PP-COLLISION AND PROJECTILE
+          IF ( RAND(K) .LE. 0.5 ) THEN
+            YR(K) = RANNOR(POSN2,WIDN2)
+          ELSE
+            YR(K) = RANNOR(-POSN2,WIDN2)
+          ENDIF
+        ENDIF
+ 1026 CONTINUE
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/pcl.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/pcl.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/pcl.f	(revision 286)
@@ -0,0 +1,59 @@
+      DOUBLE PRECISION FUNCTION PCL( A,B )
+ 
+C-----------------------------------------------------------------------
+C  P (MOMENTUM) C(ENTER OF MASS) L(ONGITUDINAL)
+C
+C  RANDOM SELECTION OF LONGITUDINAL MOMENTUM IN CENTER OF MASS
+C  EXPONENTIAL DISTRIBUTION   PCL(X) = EXP(-X/A)
+C  THIS FUNCTION IS CALLED FORM HMESON, ISOBAR, AND VHMESO
+C  ARGUMENTS:
+C   A      = MEAN VALUE OF DISTRIBUTION
+C   B      = CUT FOR LIMITING MOMENTUM
+C
+C  CHANGES : J. KNAPP   IK1  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+C     IF ( DEBUG ) WRITE(MDEBUG,*) 'PCL   : A,B=',SNGL(A),SNGL(B)
+ 
+    1 CONTINUE
+      CALL RMMAR( RD,1,1 )
+      PCL = -A * LOG ( RD(1) )
+      IF ( PCL .GT. B ) GOTO 1
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'PCL   : PCL =',SNGL(PCL)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/photo.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/photo.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/photo.f	(revision 286)
@@ -0,0 +1,71 @@
+      SUBROUTINE PHOTO
+C                                VERSION 4.00  --  26 JAN 1986/1900
+C******************************************************************
+      DOUBLE PRECISION PEIG
+*KEEP,EPCONT.
+      COMMON/EPCONT/   EDEP,RATIO,TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,IDISC,
+     *                 IROLD,IRNEW,RHOFAC, EOLD,ENEW,EKE,ELKE,BETA2,GLE,
+     *                 TSCAT,IAUSFL
+      DOUBLE PRECISION EDEP,RATIO
+      REAL             TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,RHOFAC,EOLD,ENEW,
+     *                 EKE,ELKE,BETA2,GLE,TSCAT
+      INTEGER          IDISC,IROLD,IRNEW,IAUSFL(29)
+*KEND.
+      COMMON/PHOTIN/EBINDA,GE0,GE1, MPGEM(1),GMFP0(500),GMFP1(500),GBR10
+     *(500),GBR11(500),GBR20(500),GBR21(500),GBR30(500),GBR31(500),GBR40
+     *(500),GBR41(500),NGR,RCO0,RCO1, RSCT0(100),RSCT1(100), COHE0(500),
+     *COHE1(500)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' PHOTO: NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      PEIG=E(NP)
+      IF (E(NP).LE.EBINDA) THEN
+       EDEP=PEIG
+       IBLOBE=1
+      ELSE
+       EDEP=EBINDA
+       E(NP)=EDEP
+       IBLOBE=0
+      END IF
+      IRL=IR(NP)
+      IF (IBLOBE.EQ.1) THEN
+       E(NP)=PZERO
+       RETURN
+      END IF
+      IQ(NP)=3
+      E(NP)=PEIG-EDEP+PRM
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/photon.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/photon.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/photon.f	(revision 286)
@@ -0,0 +1,340 @@
+      SUBROUTINE PHOTON(IRCODE)
+C                                VERSION 4.00  --  26 JAN 1986/1900
+C******************************************************************
+      DOUBLE PRECISION PEIG
+      COMMON/BOUNDS/ECUT(6),PCUT(6),VACDST
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,CEREN1.
+      COMMON /CEREN1/  CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD,
+     *                 CERSIZ,LCERFI
+      DOUBLE PRECISION CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD
+      REAL             CERSIZ
+      LOGICAL          LCERFI
+*KEEP,EPCONT.
+      COMMON/EPCONT/   EDEP,RATIO,TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,IDISC,
+     *                 IROLD,IRNEW,RHOFAC, EOLD,ENEW,EKE,ELKE,BETA2,GLE,
+     *                 TSCAT,IAUSFL
+      DOUBLE PRECISION EDEP,RATIO
+      REAL             TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,RHOFAC,EOLD,ENEW,
+     *                 EKE,ELKE,BETA2,GLE,TSCAT
+      INTEGER          IDISC,IROLD,IRNEW,IAUSFL(29)
+*KEND.
+      COMMON/GEOM/ZALTIT,BOUND(6),NEWOBS,OBSLVL(10)
+*KEEP,LONGI.
+      COMMON /LONGI/   APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
+     *                 NSTEP,LLONGI,FLGFIT
+      DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
+     *                 SPLONG(0:1040,9),THSTEP,THSTPI
+      INTEGER          NSTEP
+      LOGICAL          LLONGI,FLGFIT
+*KEND.
+      COMMON /MEDIA/ NMED, RLC,RLDU,RLDUI,RHO,MSGE,MGE,MSEKE,MEKE,MLEKE,
+     *MCMFP,MRANGE,IRAYLM,HBARO(6),HBAROI(6)
+      CHARACTER MEDIA*24
+      COMMON/MEDIAC/MEDIA
+      COMMON/MISC/KMPI,KMPO,DUNIT,NOSCAT,MED(6),RHOR(6),IRAYLR(6)
+      DOUBLE PRECISION PRRMMU
+      COMMON/MUON/PRRMMU,RMMU,RMMUT2
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEND.
+      COMMON/PHOTIN/EBINDA,GE0,GE1, MPGEM(1),GMFP0(500),GMFP1(500),GBR10
+     *(500),GBR11(500),GBR20(500),GBR21(500),GBR30(500),GBR31(500),GBR40
+     *(500),GBR41(500),NGR,RCO0,RCO1, RSCT0(100),RSCT1(100), COHE0(500),
+     *COHE1(500)
+      DOUBLE PRECISION PI0MSQ
+      COMMON/PION/PI0MSQ,PITHR,PICMAS,PI0MAS,AMASK0,AMASKC,AMASPR,AMASNT
+     *
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,REJECT.
+      COMMON /REJECT/  AVNREJ,
+     *                 ALTMIN,ANEXP,THICKA,THICKD,CUTLN,EONCUT,
+     *                 FNPRIM
+      DOUBLE PRECISION AVNREJ(10)
+      REAL             ALTMIN(10),ANEXP(10),THICKA(10),THICKD(10),
+     *                 CUTLN,EONCUT
+      LOGICAL          FNPRIM
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/THRESH/RMT2,RMSQ,ESCD2,AP,API,AE,UP,UE,TE,THMOLL
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      DOUBLE PRECISION PZERO,PRM,PRMT2,RMI,VC
+      COMMON/USEFUL/PZERO,PRM,PRMT2,RMI,VC,RM,MEDIUM,MEDOLD,IBLOBE,ICALL
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+      DOUBLE PRECISION THICK
+ 
+ 
+ 
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' PHOTON:NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      NEWOBS=IOBS(NP)
+      IRCODE=1
+      PEIG=E(NP)
+      EIG=PEIG
+      IRL=IR(NP)
+      MEDIUM=MED(IRL)
+      IF((EIG.LE.PCUT(IRL)))GO TO 970
+980   CONTINUE
+981    CONTINUE
+       GLE=LOG(EIG)
+       CALL RMMAR(RNNO35,1,2)
+       IF ((RNNO35.EQ.0.0)) THEN
+        RNNO35=1.E-30
+       END IF
+       DPMFP=-ALOG(RNNO35)
+       IROLD=IR(NP)
+1030   CONTINUE
+1031    CONTINUE
+        IF (MEDIUM.NE.0) THEN
+         LGLE=GE1*GLE+GE0
+         GMFPR0=GMFP1(LGLE)*GLE+GMFP0(LGLE)
+        END IF
+1040    CONTINUE
+1041     CONTINUE
+         IF (MEDIUM.EQ.0) THEN
+          TSTEP=VACDST
+         ELSE
+          RHOFAC=RHOR(IRL)/RHO
+          RHOFI=1./RHOFAC
+          GMFP=GMFPR0*RHOFI
+          IF ((IRAYLR(IRL).EQ.1)) THEN
+           COHFAC=COHE1(LGLE)*GLE+COHE0(LGLE)
+           GMFP=GMFP*COHFAC
+          END IF
+          TSTEP=GMFP*DPMFP
+          ALTEXP=EXP(-Z(NP)*HBAROI(IRL))
+          TSTEP=TSTEP*ALTEXP
+          DISC=W(NP)*TSTEP*HBAROI(IRL)
+          IF (ABS(DISC).LT.0.065) THEN
+           TSTEP=TSTEP*(1.-0.5*DISC*(1.-0.6666667*DISC* (1.-0.75*DISC *
+     *     (1.-0.8*DISC))))
+          ELSE IF(DISC.LE.-1.) THEN
+           TSTEP=VACDST
+          ELSE
+           TSTEP=TSTEP/DISC*LOG(DISC+1.)
+          END IF
+         END IF
+         IRNEW=IR(NP)
+         IDISC=0
+         USTEP=TSTEP
+         TUSTEP=USTEP
+         IF((USTEP.GT.DNEAR(NP)))CALL HOWFAR
+         IF((IDISC.GT.0))GO TO 1000
+         VSTEP=USTEP
+         TVSTEP=VSTEP
+         EDEP=PZERO
+         USTEPU=USTEP
+         DISC=W(NP)*USTEPU*HBAROI(IRL)
+         USTEPU=USTEPU/ALTEXP
+         IF (ABS(DISC).LT.0.16) THEN
+          USTEPU=USTEPU*(1.+.5*DISC*(1.+.33333333*DISC* (1.+0.25*DISC* (
+     *    1.+0.2*DISC))))
+         ELSE
+          USTEPU=USTEPU/DISC*(EXP(DISC)-1.)
+         END IF
+         X(NP)=X(NP)+U(NP)*USTEP
+         Y(NP)=Y(NP)+V(NP)*USTEP
+         ZOLD =Z(NP)
+         Z(NP)=Z(NP)+W(NP)*USTEP
+         TIME(NP)=TIME(NP)+TVSTEP*VC
+ 
+ 
+C  ADD PHOTONS TO THE LONGITUDINAL DEVELOPMENT
+         IF ( LLONGI ) THEN
+C  FIND FIRST THE EQUIVALENT LEVELS
+C  IF STARTING POINT BELOW LOWEST LEVEL THEN DON'T CHECK
+           IF ( HLONG(NSTEP) .LE. -ZOLD ) THEN
+             LPCT1 = LPCTE(NP)
+C  Z NEW IS PROBABLY ONLY LITTLE BELOW Z OLD, THEREFORE INCREMENTAL SEARCH
+             DO 6002 I1 = LPCT1,NSTEP
+               IF ( HLONG(I1) .LT. -Z(NP) ) GOTO 6003
+ 6002        CONTINUE
+             I1 = NSTEP + 1
+ 6003        CONTINUE
+             LPCT2 = I1 - 1
+             DO 485 I=LPCT1,LPCT2
+                PLONG(I,1) = PLONG(I,1) + 1.D0
+ 485         CONTINUE
+             LPCTE(NP) = LPCT2 + 1
+           ENDIF
+         ENDIF
+         DNEAR(NP)=DNEAR(NP)-USTEP
+         IF (MEDIUM.NE.0) THEN
+          DPMFP=MAX(0.,DPMFP-USTEPU/GMFP)
+         END IF
+         IROLD=IR(NP)
+         MEDOLD=MEDIUM
+         IF (IRNEW.NE.IROLD) THEN
+          IR(NP)=IRNEW
+          IRL=IRNEW
+          MEDIUM=MED(IRL)
+          IF((EIG.LE.PCUT(IRL)))GO TO 970
+         END IF
+         IF (NEWOBS.GT.IOBS(NP)) THEN
+          CALL AUSGAB
+          IOBS(NP)=NEWOBS
+         END IF
+         IF((IDISC.LT.0))GO TO 1000
+         IF((MEDIUM.NE.MEDOLD))GO TO 1042
+         IF((MEDIUM.NE.0.AND.DPMFP.LE.1.E-6))GO TO 1032
+        GO TO 1041
+1042    CONTINUE
+       GO TO 1031
+1032   CONTINUE
+       IF ((IRAYLR(IRL).EQ.1)) THEN
+        CALL RMMAR(RNNO37,1,2)
+        IF ((RNNO37.LE.(1.0-COHFAC))) THEN
+1050     CONTINUE
+1051      CONTINUE
+          CALL RMMAR(XXX,1,2)
+          LXXX=RCO1*XXX+RCO0
+          X2=RSCT1(LXXX)*XXX+RSCT0(LXXX)
+          Q2=X2*RMSQ*.23547885E-02
+          COSTHE=1.-Q2/(2.*E(NP)*E(NP))
+          IF((ABS(COSTHE).GT.1.0))GO TO 1050
+          CSQTHE=COSTHE*COSTHE
+          REJF=(1.0+CSQTHE)*.5
+          CALL RMMAR(RNNORJ,1,2)
+          IF((RNNORJ.LE.REJF))GO TO1052
+         GO TO 1051
+1052     CONTINUE
+         SINTHE=SQRT(AMAX1(0.,1.0-CSQTHE))
+         CALL UPHI(2,1)
+         GOTO 980
+        END IF
+       END IF
+       IF ( .NOT. FNPRIM ) THEN
+        X(1)=0.
+        Y(1)=0.
+        EVTH(5)=X(1)
+        EVTH(6)=-Y(1)
+        IF (FIX1I) THEN
+         Z(1)=-FIXHEI
+         NP=1
+         LPCTE(1)=MIN(NSTEP,INT(THICK(FIXHEI)*THSTPI)+1)
+         SITHET=SQRT(1.D0-SECPAR(3)**2)
+         U(1)=SITHET*COS(-SECPAR(4))
+         V(1)=SITHET*SIN(-SECPAR(4))
+         W(1)=SECPAR(3)
+         RADINV=1.5-0.5*(U(1)**2+V(1)**2+W(1)**2)
+         U(1)=U(1)*RADINV
+         V(1)=V(1)*RADINV
+         W(1)=W(1)*RADINV
+        END IF
+        EVTH(7)=-Z(1)
+        CALL TOBUF(EVTH,0)
+        IF (LCERFI) CALL TOBUFC(EVTH,0)
+        CALL COORIN(DBLE(-Z(1)))
+        TIME(1)=0.D0
+        FNPRIM =.TRUE.
+        IF (FPRINT) THEN
+         WRITE(KMPO,* )' FIRST INTERACTION AT ',EVTH(7)*0.01,' M'
+        END IF
+       END IF
+       CALL RMMAR(RNNO36,1,2)
+       GBR1=GBR11(LGLE)*GLE+GBR10(LGLE)
+       IF ((RNNO36.LE.GBR1).AND.(E(NP).GT.RMT2)) THEN
+        CALL PAIR
+        GO TO 982
+       END IF
+       GBR2=GBR21(LGLE)*GLE+GBR20(LGLE)
+       IF (RNNO36.LT.GBR2) THEN
+        CALL COMPT
+        IF((IQ(NP).NE.1))GO TO 982
+        GO TO1060
+       END IF
+       GBR4=GBR41(LGLE)*GLE+GBR40(LGLE)
+       IF (RNNO36.GE.GBR4 .AND. E(NP).GT.RMMUT2) THEN
+        CALL MUPAIR
+        GO TO 982
+       END IF
+       GBR3=GBR31(LGLE)*GLE+GBR30(LGLE)
+       IF (RNNO36.GE.GBR3 .AND. E(NP).GT.PITHR) THEN
+        CALL PIGEN
+        IF (NP.EQ.0) THEN
+         IRCODE=2
+         RETURN
+        END IF
+        GO TO 982
+       ELSE
+        CALL PHOTO
+        IF (NP.EQ.0) THEN
+         IRCODE=2
+         RETURN
+        END IF
+        IF((IQ(NP).EQ.3))GO TO 982
+       END IF
+1060   PEIG=E(NP)
+       EIG=PEIG
+       IF((EIG.LT.PCUT(IRL)))GO TO 970
+      GO TO 981
+982   CONTINUE
+      RETURN
+970   IF (EIG.GT.AP) THEN
+       IDR=1
+      ELSE
+       IDR=2
+      END IF
+      EDEP=PEIG
+      IRCODE=2
+      NP=NP-1
+      RETURN
+1000  EDEP=PEIG
+      IRCODE=2
+      NP=NP-1
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/pi0dec.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/pi0dec.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/pi0dec.f	(revision 286)
@@ -0,0 +1,133 @@
+      SUBROUTINE PI0DEC
+ 
+C-----------------------------------------------------------------------
+C  PI 0 DEC(AY)
+C
+C  DECAY OF PI0 INTO 2 GAMMAS OR INTO E(+) + E(-) + GAMMA
+C  THIS SUBROUTINE IS CALLED FROM BOX3
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,DECAY.
+      COMMON /DECAY/   GAM345,COS345,PHI345
+      DOUBLE PRECISION GAM345(3),COS345(3),PHI345(3)
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION AUX1,AUX2,COSTH1,COSTH2,EPITO2,FI1
+      INTEGER          I
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT (' PI0DEC: CURPAR=',1P,9E10.3)
+ 
+C  COPY VERTEX COORDINATES INTO SECPAR
+      DO  1  I = 5,8
+        SECPAR(I) = CURPAR(I)
+  1   CONTINUE
+      SECPAR( 9)  = GEN
+      SECPAR(10)  = ALEVEL
+ 
+C  LOOK FOR DECAY MODE
+      CALL RMMAR (RD,3,1)
+ 
+C  DECAY    PI(0)  ---->  GAMMA + GAMMA
+      IF ( RD(3) .LT. 0.98802 ) THEN
+C  HALF OF TOTAL ENERGY OF THE PION = EPITO2
+        EPITO2 = 0.5D0 * GAMMA * PAMA(7)
+        AUX1   = 1.D0 + BETA * RD(1)
+        AUX2   = 1.D0 - BETA * RD(1)
+        COSTH1 = (BETA + RD(1)) / AUX1
+        COSTH2 = (BETA - RD(1)) / AUX2
+ 
+C  FIRST GAMMA  (WITH HIGHER ENERGY)
+        FI1 = PI2 * RD(2)
+        CALL ADDANG( COSTHE,PHI, COSTH1,FI1, SECPAR(3),SECPAR(4) )
+        IF ( SECPAR(3) .GT. C(29) ) THEN
+          SECPAR(1) = 1.D0
+C  ENERGY OF GAMMA
+          SECPAR(2) = AUX1 * EPITO2
+          CALL TSTACK
+        ENDIF
+ 
+C  SECOND GAMMA   (WITH LOWER ENERGY)
+        CALL ADDANG( COSTHE,PHI, COSTH2,FI1+PI, SECPAR(3),SECPAR(4) )
+        IF ( SECPAR(3) .GT. C(29) ) THEN
+          SECPAR(1) = 1.D0
+C  ENERGY OF GAMMA
+          SECPAR(2) = AUX2 * EPITO2
+          CALL TSTACK
+        ENDIF
+ 
+C  DECAY    PI(0)  ---->  E(+) + E(-) + GAMMA      (DALITZ DECAY)
+C  (UNIFORM PHASE SPACE DISTRIBUTION IS ASSUMED FOR THIS DECAY)
+      ELSE
+        CALL DECAY6( PAMA(7), PAMA(3), PAMA(2), 0.D0,
+     *                0.D0,0.D0,0.D0, 1.D0, 2)
+        DO 11 I = 1,3
+          CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
+     *                                SECPAR(3),SECPAR(4) )
+          IF ( SECPAR(3) .GT. C(29) ) THEN
+            SECPAR(1) = FLOAT(4 - I)
+            SECPAR(2) = GAM345(I)
+            CALL TSTACK
+          ENDIF
+ 11    CONTINUE
+ 
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/pigen.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/pigen.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/pigen.f	(revision 286)
@@ -0,0 +1,150 @@
+      SUBROUTINE PIGEN
+C
+C*********************************************************************
+C  DESIGN  : D. HECK   IK3  FZK KARLSRUHE
+C  DATE    : JUL  31, 1989
+C*********************************************************************
+C  THIS SUBROUTINE STEERS THE PHOTONUCLEAR REACTION:
+C    FOR PRODUCTION OF 1 PION, PIGEN1 IS CALLED.
+C    FOR PRODUCTION OF 2 PIONS, PIGEN2 IS CALLED.
+C    FOR PRODUCTION OF MORE PARTICLES, SDPM IS CALLED.
+C*********************************************************************
+      DOUBLE PRECISION PEIG,REGPAR,REGGEN,REGLVL
+      DOUBLE PRECISION ENERN
+      DIMENSION REGPAR(12)
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' PIGEN: NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      IF(DEBUG)WRITE(MDEBUG,*)'PIGEN : E=',E(NP)
+C***  INCREASE AGE, WE HAVE HADRONIC INTERACTION
+      IGEN(NP)=IGEN(NP)+1
+      SECPAR(9)=IGEN(NP)
+      SECPAR(10)=-Z(NP)
+      PEIG=E(NP)
+      IF (U(NP)**2+V(NP)**2.GT.3.E-38) THEN
+       ANGLEX = -ATAN2(V(NP),U(NP))
+      ELSE
+       ANGLEX = 0.
+      END IF
+C ***  SUBTRACT EM SUBSHOWER FROM NKG CALCULATION
+      IF ( FNKG ) THEN
+       SECPAR(3) = W(NP)
+       SECPAR(4) = ANGLEX
+       SECPAR(5) = -Z(NP)
+       ENERN = -PEIG*1.D-3
+       CALL NKG(ENERN)
+      ENDIF
+      CALL RMMAR(RNNO90,1,2)
+      IF (RNNO90.GT.(PEIG-400.D0)/1000.D0) THEN
+C ***  FOR ENERGIES BETWEEN 400 MEV AND 1400 MEV (=1000+400) DECIDE
+C ***  BY CHANCE WHETHER ONE OR TWO PIONS ARE GENERATED
+C ***  PIGEN1 TREATES THE PRODUCTION OF 1 PION
+       CALL PIGEN1
+      ELSE IF(RNNO90.GT.(PEIG-2000.D0)/1000.D0) THEN
+C ***  FOR ENERGIES BETWEEN 2000MEV AND 3000MEV (=1000+2000) DECIDE
+C ***  BY CHANCE WHETHER 2 (PIGEN2) OR MORE PIONS (DPM) ARE GENERATED
+C ***  PIGEN2 TREATES THE PRODUCTION OF 2 PIONS
+       CALL PIGEN2
+      ELSE
+C ***  AT HIGHER ENERGIES MORE THAN 2 PIONS ARE GENERATED BY
+C ***  THE DUAL PARTON MODEL, BY VENUS, BY SIBYLL, BY QGS, OR BY DPMJET
+        DO 191 K=1,MAXLEN
+C  ***  SAVE CURPAR PARTICLE INTO REGISTER REGPAR
+        REGPAR(K)=CURPAR(K)
+191    CONTINUE
+192    CONTINUE
+       REGGEN = GEN
+       REGLVL = ALEVEL
+C ***  FILL CURRENT EGS4-PARTICLE INTO CURPAR
+       ITYPE=1
+       CURPAR(1)=1.D0
+       CURPAR(2)=PEIG*1.D-3
+       CURPAR(3)=W(NP)
+       CURPAR(4)=ANGLEX
+       CURPAR(5)=-Z(NP)
+       CURPAR(6)=TIME(NP)
+       CURPAR(7)=X(NP)
+       CURPAR(8)=-Y(NP)
+       CURPAR(9)=0.D0
+       CURPAR(10)=1.D0
+       CURPAR(12)=SQRT(PAMA(14)*(PAMA(14)+PEIG*2.D-3))
+       CURPAR(11)=(PEIG*1.D-3+PAMA(14))/CURPAR(12)
+       GEN = IGEN(NP)
+       ALEVEL = -Z(NP)
+C ***  ELIMINATE GAMMA FROM EGS-STACK
+       NP=NP-1
+C ***  HDPM, VENUS, SIBYLL, QGS, DPMJET GIVE ALL PARTICLES TO SECPAR
+       CALL TSTINI
+       CALL SDPM
+       CALL TSTEND
+        DO 201 K=1,MAXLEN
+C  ***  RESTORE CURPAR PARTICLE FROM REGPAR
+        CURPAR(K)=REGPAR(K)
+201    CONTINUE
+202    CONTINUE
+       GEN = REGGEN
+       ALEVEL = REGLVL
+C ***  END OF MANY PION GENERATION
+      END IF
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/pigen1.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/pigen1.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/pigen1.f	(revision 286)
@@ -0,0 +1,232 @@
+      SUBROUTINE PIGEN1
+C
+C*********************************************************************
+C  DESIGN  : D. HECK   IK3  FZK KARLSRUHE
+C  DATE    : JUL  31, 1989
+C*********************************************************************
+C  THIS SUBROUTINE DESCRIBES THE PHOTONUCLEAR REACTION
+C    GAMMA + NUCLEON  -----> PION + NUCLEON
+C*********************************************************************
+      DOUBLE PRECISION BETA,DUMMY,ENUCL,ESQ,E3CM,GAMMA
+      DOUBLE PRECISION PEIG,PEOP,PT,PTRANS,P3CM,W0,W0I,W0S,W0SI
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEND.
+      DOUBLE PRECISION PI0MSQ
+      COMMON/PION/PI0MSQ,PITHR,PICMAS,PI0MAS,AMASK0,AMASKC,AMASPR,AMASNT
+     *
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' PIGEN1:NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      IF(DEBUG)WRITE(MDEBUG,*)'PIGEN1: E=',E(NP)
+      PEIG=E(NP)
+C***  NUMBERS AT THE VARIABLES MEAN :
+C***    1  INCOMING GAMMA RAY
+C***    2  HIT NUCLEON
+C***    3  PRODUCED PION
+C***    4  RECOILING NUCLEON
+C***  LOOK WHICH TYPE OF REACTION
+      CALL RMMAR(RD,2,2)
+      RNNO91=RD(1)
+      RNNO92=RD(2)
+C***  0.49923 IS THE FRACTION OF PROTONS IN AIR
+      IF (RNNO91.LE.0.49923) THEN
+C ***  HIT NUCLEON IS PROTON
+       AMASS2=AMASPR
+C ***  33% CHANCE FOR CHARGE EXCHANGE
+       IF (RNNO92.LE.0.333333) THEN
+C  ***  PI(+) + NEUTRON PRODUCED
+        IQ(NP)=8
+        IQ(NP+1)=13
+       ELSE
+C  ***  PI(0) + PROTON PRODUCED
+        IQ(NP)=7
+        IQ(NP+1)=14
+       END IF
+      ELSE
+C ***  HIT NUCLEON IS NEUTRON
+       AMASS2=AMASNT
+C ***  33% CHANCE FOR CHARGE EXCHANGE
+       IF (RNNO92.LE.0.333333) THEN
+C  ***  PI(-) + PROTON PRODUCED
+        IQ(NP)=9
+        IQ(NP+1)=14
+       ELSE
+C  ***  PI(0) + NEUTRON PRODUCED
+        IQ(NP)=7
+        IQ(NP+1)=13
+       END IF
+      END IF
+      AMAS2I=1./AMASS2
+C***  NOTE: THE ENERGIES IN EGS ARE IN MEV, IN CORSIKA IN GEV
+      AMASS3=PAMA(IQ(NP))*1.D3
+      AMASS4=PAMA(IQ(NP+1))*1.D3
+C***  TOTAL LABORATORY ENERGY AND ITS INVERSE
+      W0 =PEIG+AMASS2
+      W0I=1.D0/W0
+C***  TOTAL.C.M. ENERGY AND INVERSE OF TOTAL C.M.ENERGY
+      W0S = SQRT(AMASS2*(AMASS2+2.D0*PEIG))
+      W0SI=1.D0/W0S
+C***  THRESHOLD ENERGY
+      ETH=0.5*((AMASS3+AMASS4)**2-AMASS2**2)*AMAS2I
+C***  BETA,GAMMA, ESQ, BRATIO, G3 ARE AUXILIARY QUANTITIES
+      BETA=PEIG*W0I
+      GAMMA=W0*W0SI
+      ED =0.5*((AMASS3-AMASS4)**2-AMASS2**2)*AMAS2I
+      ESQ = SQRT((PEIG-ETH)*(PEIG-ED))
+      BRATIO = PEIG/ESQ
+      G3 = W0I*BRATIO*(PEIG-ETH+AMASS3*AMAS2I*(AMASS3+AMASS4))
+C***  C.M. ENERGY OF PION
+      E3CM=G3*AMASS2*GAMMA/BRATIO
+C***  C.M. PION MOMENTUM
+      P3CM=AMASS2*W0SI*ESQ
+      B3CM2=P3CM**2/(P3CM**2+AMASS3**2)
+      B3CM=SQRT(B3CM2)
+C***  DETERMINE THETA IN C.M. SYSTEM BY CHANCE.
+      IF (PEIG.LE.900.D0) THEN
+C ***  PHOTON ENERGY IS BELOW 900 MEV
+210    CONTINUE
+       CALL RMMAR(RD,2,2)
+       RNNO93=RD(1)
+       RNNO94=RD(2)
+       IF (IQ(NP).EQ.7) THEN
+C  ***  NEUTRAL PION EMITTED, TAKE PURE
+C  ***  DIPOLE RADIATION: W(COSTH) = 1-3/5*COSTH**2
+        COSTE3 = 2.*RNNO93-1.
+        IF((RNNO94 .GT. 1.-0.6*COSTE3**2))GOTO 210
+       ELSE
+C  ***  CHARGED PION EMITTED, TAKE MODIFIED DIPOLE RADIATION
+C  ***  WITH ASYMMETRY TERM 1/(1-BETACM*COSTE3)**2
+        COSTE3 = 1./B3CM-1./(RNNO93*2.*B3CM2/(1.-B3CM2)+B3CM/(1.+B3CM))
+        IF((RNNO94*2.5 .GT. 1.+COSTE3*(-1.8+COSTE3*(.65+COSTE3*(.34 -.18
+     *  *COSTE3 )))))GOTO 210
+       END IF
+      ELSE IF(PEIG.LE.1300.D0) THEN
+C ***  PHOTON ENERGY BETWEEN 900 AND 1300 MEV
+220    CONTINUE
+       CALL RMMAR(RD,2,2)
+       RNNO93=RD(1)
+       RNNO94=RD(2)
+       IF (IQ(NP).EQ.7) THEN
+C  ***  NEUTRAL PION EMITTED, TAKE PURE QUADRUPOLE
+C  ***  RADIATION: W(COSTH) = 1+6*COSTH**2-5*COSTH**4
+        COSTE3 = 2.*RNNO93-1.
+        IF((2.8*RNNO94 .GT. 1.+6.*COSTE3**2-5.*COSTE3**4))GOTO 220
+       ELSE
+C  ***  CHARGED PION EMITTED, TAKE MODIFIED QUADRUPOLE
+C  ***  RADIATION WITH ASYMMETRY TERM:  1/(1-BETACM*COSTE3)**2
+        COSTE3 = 1./B3CM-1./(RNNO93*2.*B3CM2/(1.-B3CM2)+B3CM/(1.+B3CM))
+        IF((13.2*RNNO94 .GT. 1.+COSTE3*(-2.18+COSTE3*(7.20+COSTE3*(-2.55
+     *   +COSTE3*(-15.39+COSTE3*(6.36+COSTE3*(13.80-COSTE3*8.235))))))))
+     *  GOTO 220
+       END IF
+      ELSE
+C ***  ABOVE 1300 MEV THE ANGULAR DISTRIBUTION IS DETERMINED
+C ***  BY THE TRANSVERSE MOMENTUM OF THE PION
+       PT=1.D3*PTRANS(DUMMY)
+       COSTE3=SQRT(MAX(0.D0,P3CM**2-PT**2))/P3CM
+      END IF
+C***  PRECISE ENERGY OUTGOING PION = PEOP
+      PEOP =GAMMA*(E3CM+BETA*P3CM*COSTE3)
+C***  ENERGY OF OUTGOING PION IN STACK POSITION NP
+      E(NP)=PEOP
+C***  MOMENTUM OF OUTGOING PION = AMOM3
+C***  COSTHE AND SINTHE ARE ANGLES IN LAB SYSTEM FOR PARTICLE 3 (PION)
+C***          SEE SLAC-265, P. 52
+      AMOM3=SQRT(MAX(0.D0,PEOP**2-AMASS3**2))
+      IF (AMOM3.GT.0.) THEN
+       COSTHE=(AMASS4**2-AMASS2**2-AMASS3**2+2.*PEOP*W0-2.*PEIG*AMASS2)
+     * /(2.*PEIG* AMOM3)
+      ELSE
+       COSTHE=1.
+      END IF
+      SINTHE= SQRT(MAX(0.0,1.-COSTHE**2))
+      CALL UPHI(2,1)
+C***  TOTAL ENERGY OF RECOILING NUCLEON  = ENUCL
+      ENUCL=W0-PEOP
+      IF ((ENUCL-AMASS4).GT.ELCUT(1)*1000.D0) THEN
+C ***  RECOIL ENERGY IS TOO LARGE, MUST TREAT THE NUCLEON
+       NP=NP+1
+       E(NP)=ENUCL
+C ***  MOMENTUM OF RECOIL NUCLEON
+       AMOM4=SQRT(ENUCL**2-AMASS4**2)
+C ***  COSTHE AND SINTHE ARE ANGLES IN LAB SYSTEM FOR RECOIL NUCLEON
+C ***       SEE SLAC-265, P. 52
+       COSTHE=(AMASS3**2-AMASS2**2-AMASS4**2+2.*ENUCL*W0-2.*PEIG*AMASS2)
+     *  / (2. * PEIG*AMOM4)
+       SINTHE=-SQRT(MAX(0.0,1.-COSTHE**2))
+       CALL UPHI(3,2)
+       IF (W(NP).GT.C(29)) THEN
+C  *** ANGLE WITH RESPECT TO X AXIS
+        IF (U(NP)**2+V(NP)**2.GT.3.E-38) THEN
+         ANGLEX = -ATAN2(V(NP),U(NP))
+        ELSE
+         ANGLEX = 0.
+        END IF
+C  ***  ADD NUCLEON TO CORSIKA STACK
+        SECPAR(1)=IQ(NP)
+        SECPAR(2)=E(NP)/AMASS4
+        SECPAR(3)=W(NP)
+        SECPAR(4)=ANGLEX
+        SECPAR(5)=-Z(NP)
+        SECPAR(6)=TIME(NP)
+        SECPAR(7)=X(NP)
+        SECPAR(8)=-Y(NP)
+        SECPAR(11)=1.D0
+        SECPAR(12)=0.D0
+        CALL TSTOUT
+       END IF
+C ***  ELIMINATE NUCLEON FROM EGS-STACK
+       NP=NP-1
+      END IF
+C***  END OF RECOIL NUCLEON TREATEMENT CASE
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/pigen2.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/pigen2.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/pigen2.f	(revision 286)
@@ -0,0 +1,276 @@
+      SUBROUTINE PIGEN2
+C
+C*********************************************************************
+C  DESIGN  : D. HECK   IK3  FZK KARLSRUHE
+C  DATE    : JUL  31, 1989
+C*********************************************************************
+C  THIS SUBROUTINE DESCRIBES THE PHOTONUCLEAR REACTION
+C    GAMMA + NUCLEON  -----> PION + PION + NUCLEON
+C*********************************************************************
+      DOUBLE PRECISION BETA,DUMMY,ECM,ENUCL,GAMMA,PEIG,PTRANS
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEND.
+      DOUBLE PRECISION PI0MSQ
+      COMMON/PION/PI0MSQ,PITHR,PICMAS,PI0MAS,AMASK0,AMASKC,AMASPR,AMASNT
+     *
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/UPHIIN/SINC0,SINC1,SIN0(20002),SIN1(20002)
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      COMMON/ACLOCK/NCLOCK,JCLOCK
+C_____IF (NCLOCK.GT.JCLOCK) THEN
+C______WRITE(MDEBUG,* )' PIGEN2:NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
+C______CALL AUSGB2
+C_____END IF
+      IF(DEBUG)WRITE(MDEBUG,*)'PIGEN2: E=',E(NP)
+      PEIG=E(NP)
+C***  NUMBERS AT THE VARIABLES MEAN :
+C***  1  INCOMING GAMMA RAY
+C***  2  HIT NUCLEON
+C***  3  FIRST  PRODUCED PION
+C***  4  SECOND PRODUCED PION
+C***  5  RECOILING NUCLEON
+      CALL RMMAR(RD,2,2)
+      RNNO81=RD(1)
+      RNNO82=RD(2)
+C***  LOOK WHICH TYPE OF REACTION
+C***  0.49923 IS THE FRACTION OF PROTONS IN AIR
+      IF (RNNO81.LE.0.49923) THEN
+C ***  HIT NUCLEON IS PROTON
+       AMASS2=AMASPR
+C ***  BRANCHING FOR COLLISION WITH PROTON
+       IF (RNNO82.LE.0.3) THEN
+C  ***  PI(0) + PI(0) + PROTON
+        IQ(NP)= 7
+        IQ(NP+1)= 7
+        IQ(NP+2)= 14
+       ELSE IF(RNNO82.LE.0.6) THEN
+C  ***  PI(+) + PI(-) + PROTON
+        IQ(NP)= 8
+        IQ(NP+1)= 9
+        IQ(NP+2)= 14
+       ELSE
+C  ***   PI(+) + PI(0) + NEUTRON
+        IQ(NP)= 8
+        IQ(NP+1)= 7
+        IQ(NP+2)= 13
+       END IF
+      ELSE
+C ***  HIT NUCLEON IS NEUTRON
+C ***  BRANCHING FOR COLLISION WITH NEUTRON
+       AMASS2=AMASNT
+       IF (RNNO82.LE.0.3) THEN
+C  ***  PI(0) + PI(0) + NEUTRON
+        IQ(NP)= 7
+        IQ(NP+1)= 7
+        IQ(NP+2)= 13
+       ELSE IF(RNNO82.LE.0.6) THEN
+C  ***  PI(+) + PI(-) + NEUTRON
+        IQ(NP)= 8
+        IQ(NP+1)= 9
+        IQ(NP+2)= 13
+       ELSE
+C  ***  PI(-) + PI(0) + PROTON
+        IQ(NP)= 9
+        IQ(NP+1)= 7
+        IQ(NP+2)= 14
+       END IF
+      END IF
+C***  CALCULATE AUXILIARY PARAMETERS
+      ECM=SQRT(AMASS2*(AMASS2+2.D0*PEIG))
+C***  NOTE: THE ENERGIES IN EGS ARE IN MEV, IN CORSIKA IN GEV
+      AMASS3=PAMA(IQ(NP))*1.D3
+      AMASS4=PAMA(IQ(NP+1))*1.D3
+      AMASS5=PAMA(IQ(NP+2))*1.D3
+      AUX1=(AMASS3+AMASS4)**2
+      AUX2A=(ECM - AMASS5)**2
+      AUX2=AUX2A-AUX1
+      AUX3=(AMASS3+AMASS5)**2
+      AUX4A=(ECM - AMASS4)**2
+      AUX4=AUX4A-AUX3
+      AUX5=AMASS3**2-AMASS4**2
+      AUX6=ECM**2-AMASS5**2
+      AUX7=0.5/ECM
+      AUX8=(ECM - AMASS3)**2
+      BETA=PEIG/(AMASS2+PEIG)
+      GAMMA=2.*(PEIG+AMASS2)*AUX7
+230   CONTINUE
+      CALL RMMAR(RD,2,2)
+      RNNO84=RD(1)
+      RNNO85=RD(2)
+C***  ARE INVARIANT MASS SQUARES INSIDE BOUNDARY OF DALITZ PLOT?
+      AM34SQ=AUX2*RNNO84+AUX1
+      AM35SQ=AUX4*RNNO85+AUX3
+      AM34I=0.5/SQRT(AM34SQ)
+      E3STAR=(AUX5+AM34SQ)*AM34I
+      E5STAR=(AUX6-AM34SQ)*AM34I
+      ROOT1=SQRT(E3STAR**2-AMASS3**2)
+      ROOT2=SQRT(E5STAR**2-AMASS5**2)
+C***  REJECT RANDOM NUMBERS, IF NOT INSIDE KINEMATIC BOUNDARY
+      DISCR=AM35SQ-(E3STAR+E5STAR)**2
+      IF((DISCR.GT.-(ROOT1-ROOT2)**2))GOTO 230
+      IF((DISCR.LT.-(ROOT1+ROOT2)**2))GOTO 230
+C***  E3CM,E4CM,E5CM ARE ENERGIES IN C.M. SYSTEM
+      E4CM=(ECM**2+AMASS4**2-AM35SQ)*AUX7
+      E5CM=(ECM**2+AMASS5**2-AM34SQ)*AUX7
+C***  NOW TAKE PION WITH HIGHEST ENERGY AS PARTICLE 3
+      E3CM=ECM-E4CM-E5CM
+      IF (E4CM.GT.E3CM) THEN
+C ***  INTERCHANGE PARTICLE 3 AND 4
+       HELP=E3CM
+       E3CM=E4CM
+       E4CM=HELP
+       HELP=AMASS3
+       AMASS3=AMASS4
+       AMASS4=HELP
+       IHELP=IQ(NP)
+       IQ(NP)=IQ(NP+1)
+       IQ(NP+1)=IHELP
+      END IF
+C***  P3CM,P4CM,P5CM ARE MOMENTA IN C.M. SYSTEM
+C***  P3SQ,P4SQ,P5SQ ARE SQUARED MOMENTA IN C.M. SYSTEM
+      P3SQ=E3CM**2-AMASS3**2
+      P3CM=SQRT(MAX(0.,P3SQ))
+      P4SQ=E4CM**2-AMASS4**2
+      P4CM=SQRT(MAX(0.,P4SQ))
+      P5SQ=E5CM**2-AMASS5**2
+      P5CM=SQRT(MAX(0.,P5SQ))
+      COSA=(P5SQ-P3SQ-P4SQ)/(2.*P3CM*P4CM)
+      SINA=-SQRT(MAX(0.,1.-COSA**2))
+      COSB=(P4SQ-P3SQ-P5SQ)/(2.*P3CM*P5CM)
+      SINB= SQRT(MAX(0.,1.-COSB**2))
+C***  NOW SELECT THE THREE INDEPENDENT ANGLES IN C.M. SYSTEM
+      PT3=1.D3*PTRANS(DUMMY)
+      SIN3CM=MIN(1.,PT3/P3CM)
+      COS3CM=SQRT(1.-SIN3CM**2)
+      CALL RMMAR(RNNO86,1,2)
+      PSI=TWOPI*RNNO86
+      LPSI=SINC1*PSI+SINC0
+      SINPSI=SIN1(LPSI)*PSI+SIN0(LPSI)
+      CPSI=PI5D2-PSI
+      LCPSI=SINC1*CPSI+SINC0
+      COSPSI=SIN1(LCPSI)*CPSI+SIN0(LCPSI)
+C***  THIRD INDEPENDENT ANGLE PHI IS CHOOSEN LATER IN SUBROUTINE UPHI
+C***  NOW MAKE LORENTZ-TRANSFORMATION FOR PARTICLE 3 (PION)
+      E(NP)=GAMMA*(E3CM+BETA*P3CM*COS3CM)
+C***  COSTHE AND SINTHE ARE ANGLES IN LAB SYSTEM FOR PARTICLE 3 (PION)
+      COSTHE= MIN((BETA*E3CM+P3CM*COS3CM)*GAMMA/ SQRT(MAX(0.D0,E(NP)**2
+     *-AMASS3**2)),1.D0)
+      SINTHE=SQRT(MAX(0.0,1.-COSTHE**2))
+C***  SINPHI AND COSPHI ARE NOW SET IN SUBROUTINE UPHI
+      CALL UPHI(2,1)
+      SINFI3=SINPHI
+      COSFI3=COSPHI
+C***  NOW MAKE LORENTZ-TRANSFORMATION FOR PARTICLE 4 = PION
+      COS4CM=COS3CM*COSA-SIN3CM*COSPSI*SINA
+      NP=NP+1
+      E(NP)=GAMMA*(E4CM+BETA*P4CM*COS4CM)
+      SINT4=SQRT(MAX(0.,1.-COS4CM**2))
+      IF (SINT4.NE.0.) THEN
+       SINT4I =1./SINT4
+       AUXA=COS3CM*COSPSI*SINA+SIN3CM*COSA
+C ***  COSPHI AND SINPHI ARE IN LAB SYSTEM FOR PARTICLE 4 (PION)
+       COSPHI=(COSFI3*AUXA-SINFI3*SINPSI*SINA)*SINT4I
+       SINPHI=(SINFI3*AUXA+COSFI3*SINPSI*SINA)*SINT4I
+      ELSE
+       COSPHI=0.
+       SINPHI=1.
+      END IF
+C***  COSTHE AND SINTHE ARE IN LAB SYSTEM FOR PARTICLE 4 (PION)
+      COSTHE= MIN((BETA*E4CM+P4CM*COS4CM)*GAMMA/ SQRT(MAX(0.D0,E(NP)**2
+     *-AMASS4**2)),1.D0)
+      SINTHE=SQRT(MAX(0.0,1.-COSTHE**2))
+      CALL UPHI(3,2)
+C***  NOW MAKE LORENTZ-TRANSFORMATION FOR PARTICLE 5 = RECOIL NUCLEON
+      COS5CM=COS3CM*COSB-SIN3CM*COSPSI*SINB
+      ENUCL=GAMMA*(E5CM+BETA*P5CM*COS5CM)
+      IF ((ENUCL-AMASS5).GT.ELCUT(1)*1000.D0) THEN
+C ***  RECOIL NUCLEON IS ABOVE THRESHOLD AND MUST BE TREATED
+       NP=NP+1
+       E(NP)=ENUCL
+       SINT5=SQRT(MAX(0.,1.-COS5CM**2))
+       IF (SINT5.NE.0.) THEN
+        SINT5I =1./SINT5
+        AUXB=COS3CM*COSPSI*SINB+SIN3CM*COSB
+C  ***  COSPHI AND SINPHI ARE IN LAB SYSTEM FOR PART. 5 (NUCLEON)
+        COSPHI=(COSFI3*AUXB-SINFI3*SINPSI*SINB)*SINT5I
+        SINPHI=(SINFI3*AUXB+COSFI3*SINPSI*SINB)*SINT5I
+       ELSE
+        COSPHI=0.
+        SINPHI=1.
+       END IF
+C ***  COSTHE AND SINTHE ARE IN LAB SYSTEM FOR PARTICLE 5 (NUCLEON)
+       COSTHE=MIN((BETA*E5CM+P5CM*COS5CM)*GAMMA/SQRT(ENUCL**2-AMASS5**2)
+     * , 1.D0)
+       SINTHE=SQRT(MAX(0.0,1.-COSTHE**2))
+       CALL UPHI(3,2)
+       IF (W(NP).GT.C(29)) THEN
+C  *** ANGLE WITH RESPECT TO X AXIS
+        IF (U(NP)**2+V(NP)**2.GT.3.E-38) THEN
+         ANGLEX = -ATAN2(V(NP),U(NP))
+        ELSE
+         ANGLEX = 0.
+        END IF
+C  ***  ADD NUCLEON TO CORSIKA STACK
+        SECPAR(1)=IQ(NP)
+        SECPAR(2)=E(NP)/AMASS5
+        SECPAR(3)=W(NP)
+        SECPAR(4)=ANGLEX
+        SECPAR(5)=-Z(NP)
+        SECPAR(6)=TIME(NP)
+        SECPAR(7)=X(NP)
+        SECPAR(8)=-Y(NP)
+        SECPAR(11)=1.D0
+        SECPAR(12)=0.D0
+        CALL TSTOUT
+       END IF
+C ***  ELIMINATE NUCLEON FROM EGS-STACK
+       NP=NP-1
+      END IF
+C***  END OF RECOIL NUCLEON TREATEMENT CASE
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/pparam.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/pparam.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/pparam.f	(revision 286)
@@ -0,0 +1,342 @@
+      SUBROUTINE PPARAM
+ 
+C-----------------------------------------------------------------------
+C  P(ARTICLE) PARAM(ETERS)
+C
+C  SETS PARAMETERS (PARTICLE TYP, TRANSVERSE MOMENTUM)
+C  OF SECONDARY PARTICLES IN HDPM
+C  THIS SUBROUTINE IS CALLED FROM HDPM
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C  CHANGES : J.N. CAPDEVIELLE CDF PARIS
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,AVPT.
+      COMMON /AVPT/    AVPT,AVPK,AVPN,AVPH,AVPE
+      DOUBLE PRECISION AVPT,AVPK,AVPN,AVPH,AVPE
+*KEEP,DPMFLG.
+      COMMON /DPMFLG/  NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+      INTEGER          NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+*KEEP,INDICE.
+      COMMON /INDICE/  NNUCN,NKA0,NHYPN,NETA,NETAS,NPIZER,
+     *                 NNC,NKC,NHC,NPC,NCH,NNN,NKN,NHN,NET,NPN
+      INTEGER          NNUCN(2:3),NKA0(2:3),NHYPN(2:3),NETA(2:3,1:4),
+     *                 NETAS(2:3),NPIZER(2:3),
+     *                 NNC,NKC,NHC,NPC,NCH,NNN,NKN,NHN,NET,NPN
+*KEEP,INTER.
+      COMMON /INTER/   AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
+     *                 IDIF,ITAR
+      DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
+      INTEGER          IDIF,ITAR
+*KEEP,LEPAR.
+      COMMON /LEPAR/   LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
+      INTEGER          LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
+*KEEP,NEWPAR.
+      COMMON /NEWPAR/  EA,PT2,PX,PY,TMAS,YR,ITYP,
+     *                 IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
+     *                 IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
+      DOUBLE PRECISION EA(3000),PT2(3000),PX(3000),PY(3000),TMAS(3000),
+     *                 YR(3000)
+      INTEGER          ITYP(3000),
+     *                 IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
+     *                 IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'PPARAM: NTOT,NPC,NCPLUS=',
+     *                                      NTOT,NPC,NCPLUS
+ 
+C  FILL PARTICLES INTO ARRAYS, CALCULATE PT AND SUM UP
+      SPX   = 0.D0
+      SPY   = 0.D0
+      NPART = 3
+C  PROTON ANTIPROTON PAIRS
+      DO 1003  K = 1,NNC
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1) .LT. 0.5 ) THEN
+          ITYP(NPART)   = 14
+          ITYP(NPART+1) = 15
+        ELSE
+          ITYP(NPART)   = 15
+          ITYP(NPART+1) = 14
+        ENDIF
+        CALL PTRAM( ZN,AVPN,PX(NPART),PY(NPART) )
+        CALL PTRAM( ZN,AVPN,PX(NPART+1),PY(NPART+1) )
+        SPX   = SPX + PX(NPART) + PX(NPART+1)
+        SPY   = SPY + PY(NPART) + PY(NPART+1)
+        NPART = NPART + 2
+ 1003 CONTINUE
+C  K+ K- PAIRS
+      DO 1004  K = 1,NKC
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1) .LT. 0.5 ) THEN
+          ITYP(NPART)   = 11
+          ITYP(NPART+1) = 12
+        ELSE
+          ITYP(NPART)   = 12
+          ITYP(NPART+1) = 11
+        ENDIF
+        CALL PTRAM( ZN,AVPK,PX(NPART),PY(NPART) )
+        CALL PTRAM( ZN,AVPK,PX(NPART+1),PY(NPART+1) )
+        SPX   = SPX + PX(NPART) + PX(NPART+1)
+        SPY   = SPY + PY(NPART) + PY(NPART+1)
+        NPART = NPART + 2
+ 1004 CONTINUE
+C  SIGMA PAIRS
+      DO 1005  K = 1,NHC
+        CALL RMMAR( RD,2,1 )
+        IF ( RD(1) .LT. 0.5 ) THEN
+          IF ( RD(2) .LT. 0.5 ) THEN
+            ITYP(NPART)   = 19
+            ITYP(NPART+1) = 27
+          ELSE
+            ITYP(NPART)   = 27
+            ITYP(NPART+1) = 19
+          ENDIF
+        ELSE
+          IF ( RD(2) .LT. 0.5 ) THEN
+            ITYP(NPART)   = 21
+            ITYP(NPART+1) = 29
+          ELSE
+            ITYP(NPART)   = 29
+            ITYP(NPART+1) = 21
+          ENDIF
+        ENDIF
+        CALL PTRAM( ZN,AVPH,PX(NPART),PY(NPART) )
+        CALL PTRAM( ZN,AVPH,PX(NPART+1),PY(NPART+1) )
+        SPX   = SPX + PX(NPART) + PX(NPART+1)
+        SPY   = SPY + PY(NPART) + PY(NPART+1)
+        NPART = NPART + 2
+ 1005 CONTINUE
+ 
+C  DECIDE WITH WHICH CHARGED PION TO START WITH
+C  NUMBER OF PIONS MAY BE ODD IN THE CASE IF ISEL IS 1
+      CALL RMMAR( RD,1,1 )
+      IF ( RD(1) .GT. 0.5 ) THEN
+        NPIOCH = 0
+      ELSE
+        NPIOCH = 1
+      ENDIF
+      NPOS = NCPLUS
+C  PI +-
+      DO 1007  K = 1,NPC
+        IF     ( NPC-K+1 .LE.  NPOS ) THEN
+          NPIOCH = 1
+          IF ( DEBUG ) WRITE(MDEBUG,*) '   NPC,K,NPOS,NPIOCH=',
+     *                                     NPC,K,NPOS,NPIOCH
+        ELSEIF ( NPC-K+1 .LE. -NPOS ) THEN
+          NPIOCH = 0
+          IF ( DEBUG ) WRITE(MDEBUG,*) '   NPC,K,-NPOS,NPIOCH=',
+     *                                     NPC,K,-NPOS,NPIOCH
+        ENDIF
+        IF ( NPIOCH .EQ. 0 ) THEN
+          ITYP(NPART) = 8
+          NPIOCH = 1
+          NPOS   = NPOS + 1
+        ELSE
+          ITYP(NPART) = 9
+          NPIOCH = 0
+          NPOS   = NPOS - 1
+        ENDIF
+        CALL PTRAM( ZN,AVPT,PX(NPART),PY(NPART) )
+        SPX   = SPX + PX(NPART)
+        SPY   = SPY + PY(NPART)
+        NPART = NPART + 1
+ 1007 CONTINUE
+C  NEUTRON ANTINEUTRON PAIRS
+      DO 1008  K = 1,NNN
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1) .LT. 0.5 ) THEN
+          ITYP(NPART)   = 13
+          ITYP(NPART+1) = 25
+        ELSE
+          ITYP(NPART)   = 25
+          ITYP(NPART+1) = 13
+        ENDIF
+        CALL PTRAM( ZN,AVPN,PX(NPART),PY(NPART) )
+        CALL PTRAM( ZN,AVPN,PX(NPART+1),PY(NPART+1) )
+        SPX   = SPX + PX(NPART) + PX(NPART+1)
+        SPY   = SPY + PY(NPART) + PY(NPART+1)
+        NPART = NPART + 2
+ 1008 CONTINUE
+C  K0L K0S PAIRS
+      DO 1009  K = 1,NKN
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1) .LT. 0.5 ) THEN
+          ITYP(NPART)   = 10
+          ITYP(NPART+1) = 16
+        ELSE
+          ITYP(NPART)   = 16
+          ITYP(NPART+1) = 10
+        ENDIF
+        CALL PTRAM( ZN,AVPK,PX(NPART),PY(NPART) )
+        CALL PTRAM( ZN,AVPK,PX(NPART+1),PY(NPART+1) )
+        SPX   = SPX + PX(NPART) + PX(NPART+1)
+        SPY   = SPY + PY(NPART) + PY(NPART+1)
+        NPART = NPART + 2
+ 1009 CONTINUE
+C  LAMDA/SIGMA0 PAIRS
+      DO 1010  K = 1,NHN
+        CALL RMMAR( RD,2,1 )
+        IF ( RD(1) .LT. 0.5 ) THEN
+          IF ( RD(2) .LT. 0.5 ) THEN
+            ITYP(NPART)   = 18
+            ITYP(NPART+1) = 28
+          ELSE
+            ITYP(NPART)   = 28
+            ITYP(NPART+1) = 18
+          ENDIF
+        ELSE
+          IF ( RD(2) .LT. 0.5 ) THEN
+            ITYP(NPART)   = 26
+            ITYP(NPART+1) = 20
+          ELSE
+            ITYP(NPART)   = 20
+            ITYP(NPART+1) = 26
+          ENDIF
+        ENDIF
+C      -----  CHANGE BY JNC DEC.96)
+        IF ( ECMDPM .LE. 500.D0 ) THEN
+          CALL PTRAN( ZN,AVPH,PX(NPART),PY(NPART) )
+          CALL PTRAN( ZN,AVPH,PX(NPART+1),PY(NPART+1) )
+        ELSE
+          CALL PTRAM( ZN,AVPH,PX(NPART),PY(NPART) )
+          CALL PTRAM( ZN,AVPH,PX(NPART+1),PY(NPART+1) )
+        ENDIF
+        SPX   = SPX + PX(NPART) + PX(NPART+1)
+        SPY   = SPY + PY(NPART) + PY(NPART+1)
+        NPART = NPART + 2
+ 1010 CONTINUE
+C  ETA
+      DO 1013  K = 1,NET
+C  FIRST FOR ETAS FROM THIRD STRING
+        IF     ( K .LE. NETA(3,1)                              ) THEN
+          ITYP(NPART) = 71
+        ELSEIF ( K .LE. NETA(3,1)+NETA(3,2)                    ) THEN
+          ITYP(NPART) = 72
+        ELSEIF ( K .LE. NETA(3,1)+NETA(3,2)+NETA(3,3)          ) THEN
+          ITYP(NPART) = 73
+        ELSEIF ( K .LE. NETA(3,1)+NETA(3,2)+NETA(3,3)+NETA(3,4)) THEN
+          ITYP(NPART) = 74
+C  NOW FOR ETAS FROM FIRST AND SECOND STRING
+        ELSEIF ( K .LE. NETAS(3)+NETA(2,1)                     ) THEN
+          ITYP(NPART) = 71
+        ELSEIF ( K .LE. NETAS(3)+NETA(2,1)+NETA(2,2)           ) THEN
+          ITYP(NPART) = 72
+        ELSEIF ( K .LE. NETAS(3)+NETA(2,1)+NETA(2,2)+NETA(2,3) ) THEN
+          ITYP(NPART) = 73
+        ELSE
+          ITYP(NPART) = 74
+        ENDIF
+C      -----  CHANGE BY JNC DEC.96)
+        IF ( ECMDPM .LE. 500.D0 ) THEN
+          CALL PTRAN( ZN,AVPE,PX(NPART),PY(NPART) )
+        ELSE
+          CALL PTRAM( ZN,AVPE,PX(NPART),PY(NPART) )
+        ENDIF
+        SPX   = SPX + PX(NPART)
+        SPY   = SPY + PY(NPART)
+        NPART = NPART + 1
+ 1013 CONTINUE
+C  PI(0)
+      DO 1014  K = 1,NPN
+        ITYP(NPART) = 7
+C      -----  CHANGE BY JNC DEC.96)
+        IF ( ECMDPM .LE. 500.D0 ) THEN
+          CALL PTRAN( ZN,AVPT,PX(NPART),PY(NPART) )
+        ELSE
+          CALL PTRAM( ZN,AVPT,PX(NPART),PY(NPART) )
+        ENDIF
+        SPX   = SPX + PX(NPART)
+        SPY   = SPY + PY(NPART)
+        NPART = NPART + 1
+ 1014 CONTINUE
+ 
+C  ANTILEADER (FROM TARGET, THEREFORE ALWAYS NUCLEON OR DELTA RESONANCE)
+      ITYP(2) = LEPAR2
+C      -----  CHANGE BY JNC DEC.96)
+      IF ( ECMDPM .LE. 500.D0 ) THEN
+        CALL PTRAN( ZN,AVPN,PX(2),PY(2) )
+      ELSE
+        CALL PTRAM( ZN,AVPN,PX(2),PY(2) )
+      ENDIF
+ 
+C  FIRST PARTICLE IS LEADING PARTICLE
+      ITYP(1) = LEPAR1
+      IF     (  (LEPAR1 .GE.  7  .AND.  LEPAR1 .LE.  9)  .OR.
+     *          (LEPAR1 .GE. 51  .AND.  LEPAR1 .LE. 53) ) THEN
+C  LEADING PARTICLE IS PION OR RHO RESONANCE
+        AVERPT = AVPT
+C  LEADING PARTICLE IS KAON OR KAON RESONANCE
+      ELSEIF ( LEPAR1 .EQ. 10  .OR.  LEPAR1 .EQ. 11  .OR.
+     *         LEPAR1 .EQ. 12  .OR.  LEPAR1 .EQ. 16  .OR.
+     *        (LEPAR1 .GE. 62  .AND. LEPAR1 .LE. 68) ) THEN
+        AVERPT = AVPK
+      ELSE
+C  LEADING PARTICLE IS NUCLEON OR ANTINUCLEON OR DELTA RESONANCE
+C  OR STRANGE BARYON
+        AVERPT = AVPN
+      ENDIF
+C      -----  CHANGE BY JNC DEC.96)
+      IF ( ECMDPM .LE. 500.D0 ) THEN
+        CALL PTRAN( ZN,AVERPT,PX(1),PY(1) )
+      ELSE
+        CALL PTRAM( ZN,AVERPT,PX(1),PY(1) )
+      ENDIF
+      SPX = SPX + PX(1) + PX(2)
+      SPY = SPY + PY(1) + PY(2)
+ 
+C  AVERAGE EXCESS PT PER PARTICLE
+      SPX = SPX / NTOT
+      SPY = SPY / NTOT
+ 
+C  RENORMALIZATION OF PT AND CALCULATION OF TRANSVERSE MASSES
+      DO 130  I = 1,NTOT
+        PX(I)   = PX(I) - SPX
+        PY(I)   = PY(I) - SPY
+        PT2(I)  = PX(I)**2 + PY(I)**2
+        TMAS(I) = SQRT( PAMA(ITYP(I))**2 + PT2(I) )
+ 130  CONTINUE
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/prange.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/prange.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/prange.f	(revision 286)
@@ -0,0 +1,144 @@
+      SUBROUTINE PRANGE(ARG)
+ 
+C-----------------------------------------------------------------------
+C  (DECAYING) P(ARTICLE'S) RANGE
+C
+C  DETERMINES MEAN FREE PATH FOR DECAYING PARTICLES
+C  INCLUDING IONIZATION ENERGY LOSS,
+C  FOR EACH LAYER OF THE ATMOSOHERE SEPARATELY
+C  PRECISELY
+C  THIS SUBROUTINE IS CALLED FROM BOX2
+C  ARGUMENT:
+C   ARG    = -LOG(RANDOM NUMBER) * SPEED OF LIGHT * LIFETIME
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,AIR.
+      COMMON /AIR/     COMPOS,PROBTA,AVERAW,AVOGAD
+      DOUBLE PRECISION COMPOS(3),PROBTA(3),AVERAW,AVOGAD
+*KEEP,ATMOS.
+      COMMON /ATMOS/   AATM,BATM,CATM,DATM
+      DOUBLE PRECISION AATM(5),BATM(5),CATM(5),DATM(5)
+*KEEP,ATMOS2.
+      COMMON /ATMOS2/  HLAY,THICKL
+      DOUBLE PRECISION HLAY(5),THICKL(5)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION AK,ARG,ARG0,BK,CHIT,DK,ELOSS
+      DOUBLE PRECISION GAMK,GAMNEW,GAMSQ,GAM0,GMSQM1,H0,TH0
+      INTEGER          ILAY
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) ARG,THICKH
+  444 FORMAT(' PRANGE: -LOG(RD)*C*TAU = ',1P,E10.3,' THICKH=',E10.3)
+ 
+C  LOOK WITHIN WHICH LAYER THE PARTICLE STARTS
+      IF     ( H .LE. HLAY(2) ) THEN
+        ILAY = 1
+        TH0  = THICKH
+      ELSEIF ( H .LE. HLAY(3) ) THEN
+        ILAY = 2
+        TH0  = THICKH
+      ELSEIF ( H .LE. HLAY(4) ) THEN
+        ILAY = 3
+        TH0  = THICKH
+      ELSE
+        ILAY = 4
+        TH0  = MAX( THICKH, 2.D-4 )
+      ENDIF
+C  SET START VALUES FOR ITERATION
+      ARG0 = ARG
+      CHIT = 0.D0
+      GAM0 = GAMMA
+      H0   = H
+ 
+  2   CONTINUE
+      GAM0   = MAX( GAM0, 1.0001D0 )
+      GAMSQ  = GAM0**2
+      GMSQM1 = GAMSQ - 1.D0
+C  ENERGY LOSS BY IONIZATION
+      ELOSS  = SIGNUM(ITYPE)**2 * C(22) *
+     *           ( GAMSQ * (LOG(GMSQM1) + C(23)) / GMSQM1 - 1.D0 )
+      ELOSS  = ELOSS / (PAMA(ITYPE) * COSTHE )
+      BK     = ELOSS * (TH0 - AATM(ILAY))
+      DK     = GAM0 + BK
+      AK     = ARG0 * DK * COSTHE * DATM(ILAY)
+      IF ( AK .LT. 174.D0 ) THEN
+C  LIMIT FOR EXPONENT (ON IBM COMPUTER)
+        GAMNEW = MAX( GAM0 * DK / ( GAM0 + BK * EXP(AK) ), 1.D0 )
+      ELSE
+        GAMNEW = 1.D0
+      ENDIF
+      GAMK   = GAM0 - ELOSS * ( THICKL(ILAY) - TH0)
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'PRANGE: GAMNEW,GAMK=',
+     *                           SNGL(GAMNEW),SNGL(GAMK)
+C  LOOK WETHER PARTICLE PENETRATES LAYER BOUNDARY OR DECAYS BEFORE
+      IF ( GAMNEW .LT. GAMK  .AND.  ILAY. GT. 1 ) THEN
+C  CALCULATE PORTION OF RANGE AND NEW START VALUES AT LAYER BOUNDARY
+        ARG0 = ARG0 - ( H0 - HLAY(ILAY) + CATM(ILAY) * LOG(GAM0/GAMK) )
+     *                       / (DK * COSTHE)
+        CHIT = CHIT + (THICKL(ILAY) - TH0) / COSTHE
+        GAM0 = GAMK
+        H0   = HLAY(ILAY)
+        TH0  = THICKL(ILAY)
+        ILAY = ILAY - 1
+        GOTO 2
+      ENDIF
+C  PENETRATED MATTER THICKNESS
+      CHI = CHIT + (GAM0 - GAMNEW) / (ELOSS*COSTHE)
+      IF ( DEBUG ) WRITE(MDEBUG,445) CHI
+  445 FORMAT(' PRANGE: CHI = ',1P,E10.3)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/prtime.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/prtime.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/prtime.f	(revision 286)
@@ -0,0 +1,67 @@
+      SUBROUTINE PRTIME(TTIME)
+ 
+C-----------------------------------------------------------------------
+C  PR(INT) TIME
+C
+C  PRINTS PRESENT DATE AND TIME AND GIVES IT IN A FORMAT SUITED FOR THE
+C  RUNHEADER AND EVENTHEADER
+C  THIS SUBROUTINE IS CALLED FROM MAIN AND START
+C  ARGUMENT:
+C   TTIME  = TIME (YYMMDD)
+C
+C  IF OUR DATE ROUTINE DOES NOT FIT TO YOUR COMPUTER, PLEASE REPLACE
+C  IT BY A SUITABLE ROUTINE OF YOUR SYSTEM
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+
+      DOUBLE PRECISION TTIME
+      INTEGER ID, IT, ISL1, ISL2, ISL3, ISL4, ISL5, ISL6
+
+C-----------------------------------------------------------------------
+ 
+C call jcdate (modified version 13-10-98)
+      CALL jcdate(ID, IT, ISL1, ISL2, ISL3, ISL4, ISL5, ISL6)
+      ttime = DBLE(ID)
+      
+C format dd, mm, yy, hh, mm, ss
+      WRITE(MONIOU,100) ISL3,ISL2,ISL1,ISL4,ISL5,ISL6
+ 100  FORMAT(' PRESENT TIME : ',
+     *     I2,'.',I2.2,'.',I2.2,I4,':',I2.2,':',I2.2)
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ 
+      RETURN
+      END
+
+
+
+
+
+
+
+
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ptram.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ptram.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ptram.f	(revision 286)
@@ -0,0 +1,102 @@
+      SUBROUTINE PTRAM( ZN,FACT,PTX,PTY )
+ 
+C-----------------------------------------------------------------------
+C  TRA(NSVERSE MOMENTUM FROM) M(IMI EXPERIMENT)
+C
+C  GENERATION OF TRANSVERSE MOMENTUM FOR PARTICLES IN HDPM  GENERATOR
+C  SEE RESULTS FROM UA1/MIMI/96
+C  SOME CONSTANTS CHANGED FROM MATHEMATICAL SOLUTION BY DICHOTOMY TO
+C  TO TAKE INTO ACCOUNT EFFECT OF REJECTIONS. (TESTIFIED AT VS=630 GEV
+C  ONLY)  SEE J.N. CAPDEVIELLE, 24TH ICRC, ROMA 1995
+C         AND J.N. CAPDEVIELLE, 9TH ISVHECRI, KARLSRUHE 1996
+C  THIS SUBROUTINE IS CALLED FROM PPARAM
+C  ARGUMENTS:
+C   ZN    = POWER OF TRANSV. MOMENTUM FUNCTION, DEP. ON CENT.RAP.DENSITY
+C   FACT  = FACTOR TAKING INTO ACCOUNT PARTICLE SPECIFIC TRANSV.MOMENTUM
+C   PTX   = TRANSVERSE MOMENTUM IN X DIRECTION
+C   PTY   = TRANSVERSE MOMENTUM IN Y DIRECTION
+C
+C  DESIGN  : J.N. CAPDEVIELLE CDF PARIS
+C  CHANGES : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+CC    IF ( DEBUG ) WRITE(MDEBUG,*) 'PTRAM : ZN=',SNGL(ZN)
+ 
+C  TWO RANDOM NUMBERS
+      CALL RMMAR( RD,2,1 )
+C  GENERATE <P_T>
+      ALFA = -0.05D0
+      B = ZN-1.D0
+      A = RD(1)/B
+      U = 0.D0
+      DO 5 J = 1,1000
+        F1 =  A * (U+1.D0)**B - 1.D0/B
+        IF ( F1 .GE. U ) GOTO 15
+        U  = U + 0.05D0
+ 5    CONTINUE
+ 15   BETA = U
+      ALFA = U - 0.05D0
+      IF ( F1-U .EQ. 0.D0 ) GOTO 30
+      I = 0
+ 14   U = 0.5D0 * (ALFA+BETA)
+      I = I + 1
+      F = A * (U+1.D0)**B - 1.D0/B - U
+      IF ( F .EQ. 0.D0 ) GO TO 30
+      IF ( ABS(U-BETA) .LE. 1.D-4 ) GOTO 30
+      FA = A * (ALFA+1.D0)**B - ALFA - 1.D0/B
+      FB = B * (BETA+1.D0)**B - BETA - 1.D0/B
+      IF ( F*FA .GE. 0.D0 ) THEN
+        ALFA = U
+      ELSE
+        BETA = U
+      ENDIF
+      GO TO 14
+ 
+ 30   XPT = 0.9154D0 * U
+C  2*PI*RANDOM NUMBER FOR ANGLE PHI
+      Z   = PI2 * RD(2)
+      PTX = XPT * FACT * COS(Z)
+      PTY = XPT * FACT * SIN(Z)
+ 
+CC    IF ( DEBUG ) WRITE(MDEBUG,*) 'PTRAM : RD(1,2),XPT=',
+CC   *                                      RD(1),RD(2),SNGL(XPT)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ptran.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ptran.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ptran.f	(revision 286)
@@ -0,0 +1,83 @@
+      SUBROUTINE PTRAN( ZN,FACT,PTX,PTY )
+ 
+C-----------------------------------------------------------------------
+C  TRAN(SVERSE MOMENTUM)
+C
+C  GENERATION OF TRANSVERSE MOMENTUM FOR PARTICLES IN HDPM
+C  THIS SUBROUTINE IS CALLED FROM PPARAM
+C  ARGUMENTS:
+C   ZN    = POWER OF TRANSV. MOMENTUM FUNCTION, DEP. ON CENT.RAP.DENSITY
+C   FACT  = FACTOR TAKING INTO ACCOUNT PARTICLE SPECIFIC TRANSV.MOMENTUM
+C   PTX   = TRANSVERSE MOMENTUM IN X DIRECTION
+C   PTY   = TRANSVERSE MOMENTUM IN Y DIRECTION
+C
+C  DESIGN  : T. THOUW   IK3  FZK KARLSRUHE
+C  CHANGES : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+CC    IF ( DEBUG ) WRITE(MDEBUG,*) 'PTRAN : ZN=',SNGL(ZN)
+ 
+C  TWO RANDOM NUMBERS
+      CALL RMMAR( RD,2,1 )
+C  GENERATE <P_T>   (REFERENCE??)
+      B   = ZN * (ZN - 1.D0)
+      ZZ  = SQRT(1.D0/RD(1) - 1.D0)
+      XPT = ZZ * SQRT(2.D0/B)
+   11 CONTINUE
+      IF ( XPT .LT. 0.5D-3 ) GOTO 22
+      X1  = 1.D0 + XPT
+      XB  = X1**ZN
+      XC  = 1.D0 + ZN * XPT
+      ZA  = SQRT(XB/XC - 1.D0)
+      XD  = (ZZ - ZA) * (X1 * 2.D0 * ZA * XC**2 ) / ( B * XPT * XB )
+      XPT = XPT + XD
+      IF ( ABS(XD) .GT. 1.D-3 ) GOTO 11
+   22 CONTINUE
+ 
+C  2*PI*RANDOM NUMBER FOR ANGLE PHI
+      Z   = PI2 * RD(2)
+      PTX = XPT * FACT * COS(Z)
+      PTY = XPT * FACT * SIN(Z)
+ 
+CC    IF ( DEBUG ) WRITE(MDEBUG,*) 'PTRAN : RD(1,2),XPT=',
+CC   *                                      RD(1),RD(2),SNGL(XPT)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ptrans.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ptrans.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ptrans.f	(revision 286)
@@ -0,0 +1,109 @@
+      DOUBLE PRECISION FUNCTION PTRANS( DUMMY )
+ 
+C-----------------------------------------------------------------------
+C  TRANS(VERSE MOMENTUM)
+C
+C  RANDOM SELECTION OF TRANSVERSE MOMENTUM
+C  DISTRIBUTION IS OF FORM X*EXP(-X)
+C  THIS FUNCTION IS CALLED FROM BOX60, BOX65, BOX70, HMESON, ISOBAR,
+C  NIHILA, PIGEN1, PIGEN2, SINGLE, AND VHMESO
+C  ARGUMENT:
+C   DUMMY  = DUMMY (FOR HISTORICAL REASONS)
+C
+C  CHANGES : J. KNAPP   IK1  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      REAL GX(0:50),HX(0:50)
+      SAVE GX,HX,DX,FIRST
+      LOGICAL FIRST
+C  DX IS STEPSIZE FOR APPROXIMATING CURVE
+      DATA FIRST / .TRUE. /, DX / 0.5D0 /
+C-----------------------------------------------------------------------
+ 
+C     IF ( DEBUG ) WRITE(MDEBUG,*) 'PTRANS:'
+ 
+C  COMPUTE FUNCTION VALUES AND INTEGRAL OF STEP FUNCTION H(X)
+C  APPROXIMATING Y(X) = X * EXP(1-X) WITH H(X) > Y(X)
+      IF ( FIRST ) THEN
+        FIRST = .FALSE.
+        IMAX  = C(34) / DX
+        GX(0) = 0.D0
+        HX(0) = DX*EXP(1.D0-DX)
+        DO  2  I = 1,IMAX
+          X     = I*DX
+          IF ( X .LT. 1.D0 ) X = X + DX
+          HX(I) = X*EXP(1.D0-X)
+          GX(I) = GX(I-1) + HX(I-1)
+    2   CONTINUE
+        SUMI = 1.D0 / GX(IMAX)
+        DO  3  I = 1,IMAX
+          GX(I) = GX(I) * SUMI
+    3   CONTINUE
+      ENDIF
+ 
+C-----------------------------------------------------------------------
+C  GET RANDOM VARIABLE DISTRIBUTED AS HX(X)
+   11 CONTINUE
+      CALL RMMAR( RD,2,1 )
+      I  = 0
+    1 CONTINUE
+      I  = I+1
+      IF ( GX(I) .LT. RD(1) ) GOTO 1
+      XX = ( (RD(1)-GX(I-1))/(GX(I)-GX(I-1)) + I-1 ) * DX
+      ZZ = HX(I-1)
+C  GET RANDOM VARIABLE DISTRIBUTED AS Y(X) BY REJECTION METHOD
+      TT = XX * EXP(1.-XX)
+      IF ( RD(2)*ZZ .GT. TT ) GOTO 11
+ 
+C  GET REQUIRED PEAK VALUE
+      PTRANS = XX * C(12)
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'PTRANS: PT = ',SNGL(PTRANS)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/rangen.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/rangen.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/rangen.f	(revision 286)
@@ -0,0 +1,62 @@
+      FUNCTION RANGEN()
+ 
+C-----------------------------------------------------------------------
+C  RAN(DOM  NUMBER) GEN(ERATOR)
+C
+C  SEE SUBROUTINE RMMAR
+C  THIS FUNCTION IS CALLED FROM MANY VENUS ROUTINES
+C
+C  CERN PROGLIB# V113    RMMAR           .VERSION KERNFOR  1.0
+C  ORIG. 01/03/89 FCA + FJ
+C
+C  CHANGES  : D. HECK    IK3  FZK KARLSRUHE
+C  DATE     : FEB  02, 1994
+C-----------------------------------------------------------------------
+ 
+C     REAL RVEC(1)
+      COMMON /RANMA2/ IU(1030),JSEQ
+      COMMON /RANMA3/ TWOM24,TWOM48,CD,CM,CINT,MODCNS
+      INTEGER I97(0:1030),J97(0:1030),NTOT(0:1030)
+      INTEGER NTOT2(0:1030),IJKL(0:1030)
+      REAL    U(97),C(0:1030)
+      EQUIVALENCE (IJKL(0),IU(1)),(NTOT(0),IU(2)),(NTOT2(0),IU(3))
+      EQUIVALENCE (U(1),IU(4)),(C(0),IU(101)),(I97(0),IU(102))
+      EQUIVALENCE (J97(0),IU(103))
+C-----------------------------------------------------------------------
+ 
+C     ISEQ = 1
+      LENV = 1
+C     IF ( ISEQ .GT. 0 ) JSEQ = ISEQ
+C     IBASE = (JSEQ-1)*103
+      IBASE = 0
+ 
+      IVEC = 1
+C     DO 100  IVEC = 1,LENV
+        UNI = U(     +I97(IBASE))-U(     +J97(IBASE))
+        IF ( UNI .LT. 0. ) UNI = UNI+1.
+        U(     +I97(IBASE)) = UNI
+        I97(IBASE) = I97(IBASE)-1
+        IF ( I97(IBASE) .EQ. 0 ) I97(IBASE) = 97
+        J97(IBASE) = J97(IBASE)-1
+        IF ( J97(IBASE) .EQ. 0 ) J97(IBASE) = 97
+        C(IBASE)   = C(IBASE) - CD
+        IF ( C(IBASE) .LT. 0. ) C(IBASE) = C(IBASE)+CM
+        UNI = UNI-C(IBASE)
+        IF ( UNI .LT. 0. ) UNI = UNI+1.
+C  REPLACE EXACT ZEROES BY UNIFORM DISTR. *2**-24
+        IF ( UNI .EQ. 0. ) THEN
+          UNI = TWOM24*U(2)
+C  AN EXACT ZERO HERE IS VERY UNLIKELY, BUT LET'S BE SAFE.
+          IF ( UNI .EQ. 0. ) UNI = TWOM48
+        ENDIF
+        RANGEN = UNI
+  100 CONTINUE
+ 
+      NTOT(IBASE) = NTOT(IBASE) + LENV
+      IF ( NTOT(IBASE) .GE. MODCNS )  THEN
+        NTOT2(IBASE) = NTOT2(IBASE) + 1
+        NTOT(IBASE)  = NTOT(IBASE) - MODCNS
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/rannor.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/rannor.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/rannor.f	(revision 286)
@@ -0,0 +1,77 @@
+      DOUBLE PRECISION FUNCTION RANNOR( A,B )
+ 
+C-----------------------------------------------------------------------
+C  RAN(DOM NUMBER) NOR(MALLY DISTRIBUTED)
+C
+C  GENERATES NORMAL DISTRIBUTED RANDOM NUMBER
+C  DELIVERS 2 UNCORRELATED RANDOM NUMBERS,
+C  THEREFORE RANDOM CALLS ARE ONLY NECESSARY EVERY SECOND TIME.
+C  REFERENCE : NUMERICAL RECIPES, W.H. PRESS ET AL.,
+C              CAMBRIDGE UNIVERSITY PRESS, 1992  ISBN 0 521 43064 X
+C  THIS FUNCTION IS CALLED FROM HDPM, LEADDF, NIHILA, PARRAP, QGSTOR,
+C  UPDATE, AND VAPOR
+C  ARGUMENTS:
+C   A      = MEAN VALUE
+C   B      = STANDARD DEVIATION
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION A,B,RR
+C-----------------------------------------------------------------------
+ 
+CC    IF ( DEBUG ) WRITE(MDEBUG,100) SNGL(A),SNGL(B)
+CC100 FORMAT(' RANNOR: A,B=',1P,2E10.3)
+      IF ( KNOR ) THEN
+  1     CONTINUE
+        CALL RMMAR( RD,2,1 )
+        U1 = 2.D0*RD(1) - 1.D0
+        U2 = 2.D0*RD(2) - 1.D0
+        RR = U1**2 + U2**2
+        IF ( RR .GE. 1.D0 .OR. RR .EQ. 0.D0 ) GOTO 1
+        FAC = SQRT( -2.D0 * LOG(RR) / RR )
+ 
+        RANNOR = FAC * U1 * B + A
+        KNOR   = .FALSE.
+      ELSE
+        RANNOR = FAC * U2 * B + A
+        KNOR   = .TRUE.
+      ENDIF
+CC    IF ( DEBUG ) WRITE(MDEBUG,101) RANNOR
+CC101 FORMAT('+',34X,' RANNOR =',1P,E12.5)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/resdec.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/resdec.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/resdec.f	(revision 286)
@@ -0,0 +1,200 @@
+      SUBROUTINE RESDEC
+ 
+C-----------------------------------------------------------------------
+C  RES(ONANCE) DEC(AY)
+C
+C  ROUTINE TREATES DECAY OF THE RESONANCES RHO, K*, AND DELTA
+C  THE DECAY MODE IS SELECTED BY THE RANDOM NUMBER RESRAN, WHICH IS
+C  SET IN THE ROUTINE HDPM/LEPACX, WHERE THE RESONANCE IS FORMED
+C  DECAY WITH FULL KINEMATIC, ENERGY AND MOMENTA CONSERVED
+C  THIS SUBROUTINE IS CALLED FROM BOX3
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RESON.
+      COMMON /RESON/   RDRES,RESRAN,IRESPAR
+      REAL             RDRES(2),RESRAN(1000)
+      INTEGER          IRESPAR
+ 
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      INTEGER          I,KK,M3,M4
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,8)
+  444 FORMAT(' RESDEC: CURPAR=',1P,8E10.3)
+ 
+C  CURRENT PARTICLE MUST BE SAVED IN STORE
+      DO 141  KK = 5,8
+        SECPAR(KK) = CURPAR(KK)
+ 141  CONTINUE
+      SECPAR( 9)  = GEN
+      SECPAR(10)  = ALEVEL
+ 
+      BETA   = SQRT( GAMMA**2 - 1.D0 ) / GAMMA
+ 
+      IF ( IRESPAR .LE. 0 ) THEN
+        WRITE(MONIOU,*)'RESDEC: IRESPAR .LE. 0, CORRECTED'
+        IRESPAR = 1
+      ENDIF
+C-----------------------------------------------------------------------
+C  TREAT FIRST NUCLEON RESONANCES, AS MOST FREQUENT
+ 
+      IF     ( ITYPE .EQ. 54 ) THEN
+C  DECAY    DELTA(++)  ---->  P + PI(+)
+        CALL DECAY1( ITYPE, 14, 8 )
+ 
+      ELSEIF ( ITYPE .EQ. 55  .OR.  ITYPE .EQ. 56 ) THEN
+C  DECAY    DELTA(+)   OR       DECAY    DELTA(0)
+ 
+        IF ( RESRAN(IRESPAR) .LE. TB3 ) THEN
+C  DECAY    DELTA(+)  ---->  P + PI(0)
+C  DECAY    DELTA(0)  ---->  N + PI(0)
+          M3 = 69 - ITYPE
+          CALL DECAY1( ITYPE, M3, 7 )
+ 
+        ELSE
+C  DECAY    DELTA(+)  ---->  N + PI(+)
+C  DECAY    DELTA(0)  ---->  P + PI(-)
+          M3 = ITYPE - 42
+          M4 = M3 - 5
+          CALL DECAY1( ITYPE, M3, M4 )
+        ENDIF
+ 
+      ELSEIF ( ITYPE .EQ. 57 ) THEN
+C  DECAY    DELTA(-)  ---->  N + PI(-)
+        CALL DECAY1( ITYPE, 13, 9 )
+ 
+C-----------------------------------------------------------------------
+C  RHO RESONANCES
+ 
+      ELSEIF ( ITYPE .EQ. 51 ) THEN
+C  DECAY    RHO(0)  ---->  PI(+) + PI(-)
+        CALL DECAY1( ITYPE, 8, 9 )
+ 
+      ELSEIF ( ITYPE .EQ. 52  .OR.  ITYPE .EQ. 53 ) THEN
+C  DECAY    RHO(+,-)  ---->  PI(+,-) + PI(0)
+        M3 = ITYPE - 44
+        CALL DECAY1( ITYPE, M3, 7 )
+ 
+C-----------------------------------------------------------------------
+C  EXCITED KAON RESONANCES
+ 
+      ELSEIF ( ITYPE .EQ. 62 ) THEN
+C  DECAY    K*(0)          ---->  2/3: K(+)    + PI(-)
+C                          ---->  1/3: K0(L,S) + PI(0)
+        IF     ( RESRAN(IRESPAR) .LE.      TB3 ) THEN
+          CALL DECAY1( ITYPE, 11, 9 )
+        ELSEIF ( RESRAN(IRESPAR) .LE. .8333333 ) THEN
+          CALL DECAY1( ITYPE, 10, 7 )
+        ELSE
+          CALL DECAY1( ITYPE, 16, 7 )
+        ENDIF
+ 
+      ELSEIF ( ITYPE .EQ. 65 ) THEN
+C  DECAY    ANTI-K*(0)     ---->  2/3: K(-)    + PI(+)
+C                          ---->  1/3: K0(L,S) + PI(0)
+        IF     ( RESRAN(IRESPAR) .LE.      TB3 ) THEN
+          CALL DECAY1( ITYPE, 12, 8 )
+        ELSEIF ( RESRAN(IRESPAR) .LE. .8333333 ) THEN
+          CALL DECAY1( ITYPE, 10, 7 )
+        ELSE
+          CALL DECAY1( ITYPE, 16, 7 )
+        ENDIF
+ 
+      ELSEIF ( ITYPE .EQ. 63  .OR.  ITYPE .EQ. 64 ) THEN
+C  DECAY    K*(+-)          ---->  2/3: K(+-) + PI(0)
+C                           ---->  1/3: K0(L,S) + PI(+-)
+        IF     ( RESRAN(IRESPAR) .LE.      TB3 ) THEN
+          CALL DECAY1( ITYPE, ITYPE-52, 7 )
+        ELSEIF ( RESRAN(IRESPAR) .LE. .8333333 ) THEN
+          CALL DECAY1( ITYPE, 10, ITYPE-55 )
+        ELSE
+          CALL DECAY1( ITYPE, 16, ITYPE-55 )
+        ENDIF
+ 
+C-----------------------------------------------------------------------
+C  ANTI-NUCLEON RESONANCES
+ 
+      ELSEIF ( ITYPE .EQ. 58 ) THEN
+C  DECAY    ANTI-DELTA(--)  ---->  ANTI-P + PI(-)
+        CALL DECAY1( ITYPE, 15, 9 )
+ 
+      ELSEIF ( ITYPE .EQ. 59  .OR.  ITYPE .EQ. 60 ) THEN
+C  DECAY    ANTI-DELTA(-)   OR       DECAY    ANTI-DELTA(0)
+ 
+        IF ( RESRAN(IRESPAR) .LE. TB3 ) THEN
+C  DECAY    ANTI-DELTA(-)  ---->  ANTI-P + PI(0)
+C  DECAY    ANTI-DELTA(0)  ---->  ANTI-N + PI(0)
+          M3 = 15 + (ITYPE - 59) * 10
+          CALL DECAY1( ITYPE, M3, 7 )
+ 
+        ELSE
+C  DECAY    ANTI-DELTA(-)  ---->  ANTI-N + PI(-)
+C  DECAY    ANTI-DELTA(0)  ---->  ANTI-P + PI(+)
+          M3 = 15 + (60 - ITYPE) * 10
+          M4 = 68 - ITYPE
+          CALL DECAY1( ITYPE, M3, M4 )
+        ENDIF
+ 
+      ELSEIF ( ITYPE .EQ. 61 ) THEN
+C  DECAY    ANTI-DELTA(+)  ---->  ANTI-N + PI(+)
+        CALL DECAY1( ITYPE, 25, 8 )
+ 
+C-----------------------------------------------------------------------
+      ELSE
+        WRITE(MONIOU,*) 'RESDEC: UNFORESEEN PARTICLE CODE =',ITYPE
+      ENDIF
+      IRESPAR = IRESPAR -1
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/rhof.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/rhof.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/rhof.f	(revision 286)
@@ -0,0 +1,110 @@
+C=======================================================================
+
+      DOUBLE PRECISION FUNCTION RHOF( ARG )
+
+C-----------------------------------------------------------------------
+C  RHO (DENSITY) F(UNCTION)
+C
+C  CALCULATES DENSITY (G/CM**3) OF ATMOSPHERE DEPENDING ON HEIGHT (CM)
+C  (US STANDARD ATMOSPHERE)
+C  THIS FUNCTION IS CALLED FROM ININKG, UPDATE, CERENE, CERENH
+C  ARGUMENT:
+C   ARG    = HEIGHT IN CM
+C-----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+*KEEP,ATMOS.
+      COMMON /ATMOS/   AATM,BATM,CATM,DATM
+      DOUBLE PRECISION AATM(5),BATM(5),CATM(5),DATM(5)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c Try
+c------------------------------------------------------------
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+*KEND.
+
+C*******************************************************************
+C     Modificado por Aitor (5-febrero-98)
+      
+      common /aitor/   aitoth
+      double precision aitoth
+C*******************************************************************
+
+
+      DOUBLE PRECISION ARG,H,RT
+      PARAMETER (RT=6348.0D5)
+
+C-----------------------------------------------------------------------
+
+CC    IF ( DEBUG ) WRITE(MDEBUG,*) 'RHOF  : ARG=',SNGL(ARG)
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>> Modification (HZA trick) cancelled >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>> JCG Wed Sep 21 10:49:14 MET DST 1998 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      IF     ( ARG .LT. 4.D5 ) THEN
+        RHOF =  BATM(1) * DATM(1) * EXP ( -ARG * DATM(1) )
+      ELSEIF ( ARG .LT. 1.D6 ) THEN
+        RHOF =  BATM(2) * DATM(2) * EXP ( -ARG * DATM(2) )
+      ELSEIF ( ARG .LT. 4.D6 ) THEN
+        RHOF =  BATM(3) * DATM(3) * EXP ( -ARG * DATM(3) )
+      ELSEIF ( ARG .LT. 1.D7 ) THEN
+        RHOF =  BATM(4) * DATM(4) * EXP ( -ARG * DATM(4) )
+      ELSE
+        RHOF =  CATM(5)
+      ENDIF
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+cC*******************************************************************
+cC     Modificado por Aitor (5-febrero-98)
+c
+c      H = -RT + SQRT(RT**2 + (ARG/COS(aitoth))**2 +(2.0D0*RT*ARG))
+cC*******************************************************************
+c
+cC      R = SQRT(CURPAR(7)**2+CURPAR(8)**2)
+cC      H = SQRT((RT+ARG)**2+R**2)-RT
+cc      print *,'RHOF>>',arg,r,h,curpar(7),curpar(8)
+c
+c      IF     ( H .LT. 4.D5 ) THEN
+c        RHOF =  BATM(1) * DATM(1) * EXP ( -H * DATM(1) )
+c      ELSEIF ( H .LT. 1.D6 ) THEN
+c        RHOF =  BATM(2) * DATM(2) * EXP ( -H * DATM(2) )
+c      ELSEIF ( H .LT. 4.D6 ) THEN
+c        RHOF =  BATM(3) * DATM(3) * EXP ( -H * DATM(3) )
+c      ELSEIF ( H .LT. 1.D7 ) THEN
+c        RHOF =  BATM(4) * DATM(4) * EXP ( -H * DATM(4) )
+c      ELSE
+c        RHOF =  CATM(5)
+c      ENDIF
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/rmmaq.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/rmmaq.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/rmmaq.f	(revision 286)
@@ -0,0 +1,124 @@
+      SUBROUTINE RMMAQ( ISEED,ISEQ,CHOPT )
+ 
+C-----------------------------------------------------------------------
+C  R(ANDO)M (NUMBER GENERATOR OF) MA(RSAGLIA TYPE INITIALISATION)
+C
+C  ROUTINE FOR INITIALIZATION OF RMMAR
+C  THIS SUBROUTINE IS CALLED FROM MAIN AND START
+C  ARGUMENTS:
+C   ISEED  = SEED TO INITIALIZE A SEQUENCE
+C   ISEQ   = # OF RANDOM SEQUENCE
+C   CHOPT  = CHARACTER TO STEER INITIALIZATION OPTIONS
+C
+C  CERN PROGLIB# V113    RMMAQ           .VERSION KERNFOR  1.0
+C  ORIG. 01/03/89 FCA + FJ
+C-----------------------------------------------------------------------
+ 
+      COMMON /RANMA2/ IU(1030),JSEQ
+      COMMON /RANMA3/ TWOM24,TWOM48,CD,CM,CINT,MODCNS
+      INTEGER I97(0:1030),J97(0:1030),NTOT(0:1030),NTOT2(0:1030),
+     *        IJKL(0:1030)
+      REAL    U(1030),C(0:1030),UU(1030)
+      EQUIVALENCE (IJKL(0),IU(1)),(NTOT(0),IU(2)),(NTOT2(0),IU(3))
+      EQUIVALENCE (U(1),IU(4)),(C(0),IU(101)),(I97(0),IU(102))
+      EQUIVALENCE (J97(0),IU(103))
+      INTEGER     ISEED(*)
+      CHARACTER   CHOPT*(*), CCHOPT*12
+      LOGICAL FIRST
+      DATA    FIRST / .TRUE. /
+C-----------------------------------------------------------------------
+ 
+      IF ( FIRST ) THEN
+        TWOM24 = 2.**(-24)
+        TWOM48 = 2.**(-48)
+        CD     = 7654321.*TWOM24
+        CM     = 16777213.*TWOM24
+        CINT   = 362436.*TWOM24
+        MODCNS = 1000000000
+        FIRST  = .FALSE.
+      ENDIF
+ 
+      CCHOPT = CHOPT
+      IF ( CCHOPT .EQ. ' ' ) THEN
+        ISEED(1) = 54217137
+        ISEED(2) = 0
+        ISEED(3) = 0
+        CCHOPT   = 'S'
+        JSEQ     = 1
+      ENDIF
+ 
+      IF     ( INDEX(CCHOPT,'S') .NE. 0 ) THEN
+        IF ( ISEQ .GT. 0 ) JSEQ = ISEQ
+        IBASE = (JSEQ-1)*103
+        IF ( INDEX(CCHOPT,'V') .NE. 0 ) THEN
+          DO 10  JJ = 1,103
+            IU(IBASE+JJ) = ISEED(JJ)
+  10      CONTINUE
+        ELSE
+          IJKL(IBASE)  = ISEED(1)
+          NTOT(IBASE)  = ISEED(2)
+          NTOT2(IBASE) = ISEED(3)
+          IJ = IJKL(IBASE) / 30082
+          KL = IJKL(IBASE) - 30082*IJ
+          I  = MOD(IJ/177, 177) + 2
+          J  = MOD(IJ, 177)     + 2
+          K  = MOD(KL/169, 178) + 1
+          L  = MOD(KL, 169)
+          DO 30  II = 1,97
+            S = 0.
+            T = .5
+            DO 20  JJ = 1,24
+              M = MOD(MOD(I*J,179)*K, 179)
+              I = J
+              J = K
+              K = M
+              L = MOD(53*L+1, 169)
+              IF ( MOD(L*M,64) .GE. 32 ) S = S+T
+              T = 0.5*T
+  20        CONTINUE
+            UU(II) = S
+  30      CONTINUE
+          CC   = CINT
+          II97 = 97
+          IJ97 = 33
+C  COMPLETE INITIALIZATION BY SKIPPING (NTOT2*MODCNS+NTOT) RANDOMNUMBERS
+          NITER = MODCNS
+          DO 50  LOOP2 = 1,NTOT2(IBASE)+1
+            IF ( LOOP2 .GT.N TOT2(IBASE) ) NITER = NTOT(IBASE)
+            DO 40  IDUM = 1,NITER
+              UNI = UU(II97)-UU(IJ97)
+              IF ( UNI .LT. 0. ) UNI = UNI+1.
+              UU(II97) = UNI
+              II97 = II97-1
+              IF ( II97 .EQ. 0 ) II97 = 97
+              IJ97 = IJ97-1
+              IF ( IJ97 .EQ. 0 ) IJ97 = 97
+              CC = CC - CD
+              IF ( CC .LT. 0. ) CC = CC+CM
+   40       CONTINUE
+   50     CONTINUE
+          I97(IBASE) = II97
+          J97(IBASE) = IJ97
+          C(IBASE)   = CC
+          DO 60  JJ = 1,97
+            U(IBASE+JJ) = UU(JJ)
+  60      CONTINUE
+        ENDIF
+      ELSEIF ( INDEX(CCHOPT,'R') .NE. 0 ) THEN
+        IF ( ISEQ .GT. 0 ) THEN
+          JSEQ = ISEQ
+        ELSE
+          ISEQ = JSEQ
+        ENDIF
+        IBASE = (JSEQ-1)*103
+        IF ( INDEX(CCHOPT,'V') .NE. 0 ) THEN
+          NCOPY = 103
+        ELSE
+          NCOPY = 3
+        ENDIF
+        DO 70  JJ = 1,NCOPY
+          ISEED(JJ) = IU(IBASE+JJ)
+  70    CONTINUE
+      ENDIF
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/rmmar.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/rmmar.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/rmmar.f	(revision 286)
@@ -0,0 +1,60 @@
+      SUBROUTINE RMMAR( RVEC,LENV,ISEQ )
+ 
+C-----------------------------------------------------------------------
+C  R(ANDO)M (NUMBER GENERATOR OF) MAR(SAGLIA TYPE)
+C
+C  THESE ROUTINES (RMMAR,RMMAQ) ARE TAKEN FROM THE CERN LIBRARIES
+C  DESCRIPTION OF ALGORITHM SEE THERE
+C  THIS SUBROUTINE IS CALLED FROM MANY ROUTINES
+C  ARGUMENTS:
+C   RVEC   = VECTOR FIELD TO BE FILLED WITH RANDOM NUMBERS
+C   LENV   = LENGTH OF VECTOR (# OF RANDNUMBERS TO BE GENERATED)
+C   ISEQ   = # OF RANDOM SEQUENCE
+C
+C  CERN PROGLIB# V113    RMMAR           .VERSION KERNFOR  1.0
+C  ORIG. 01/03/89 FCA + FJ
+C-----------------------------------------------------------------------
+ 
+      REAL RVEC(*)
+      COMMON /RANMA2/ IU(1030),JSEQ
+      COMMON /RANMA3/ TWOM24,TWOM48,CD,CM,CINT,MODCNS
+      INTEGER I97(0:1030),J97(0:1030),NTOT(0:1030),NTOT2(0:1030),
+     *        IJKL(0:1030)
+      REAL    U(1030),C(0:1030)
+      EQUIVALENCE (IJKL(0),IU(1)),(NTOT(0),IU(2)),(NTOT2(0),IU(3))
+      EQUIVALENCE (U(1),IU(4)),(C(0),IU(101)),(I97(0),IU(102))
+      EQUIVALENCE (J97(0),IU(103))
+C-----------------------------------------------------------------------
+ 
+      IF ( ISEQ .GT. 0 ) JSEQ = ISEQ
+      IBASE = (JSEQ-1)*103
+ 
+      DO 100  IVEC = 1,LENV
+        UNI = U(IBASE+I97(IBASE))-U(IBASE+J97(IBASE))
+        IF ( UNI .LT. 0. ) UNI = UNI+1.
+        U(IBASE+I97(IBASE)) = UNI
+        I97(IBASE) = I97(IBASE)-1
+        IF ( I97(IBASE) .EQ. 0 ) I97(IBASE) = 97
+        J97(IBASE) = J97(IBASE)-1
+        IF ( J97(IBASE) .EQ. 0 ) J97(IBASE) = 97
+        C(IBASE)   = C(IBASE) - CD
+        IF ( C(IBASE) .LT. 0. ) C(IBASE) = C(IBASE)+CM
+        UNI = UNI-C(IBASE)
+        IF ( UNI .LT. 0. ) UNI = UNI+1.
+C  REPLACE EXACT ZEROES BY UNIFORM DISTR. *2**-24
+        IF ( UNI .EQ. 0. ) THEN
+          UNI = TWOM24*U(2)
+C  AN EXACT ZERO HERE IS VERY UNLIKELY, BUT LET'S BE SAFE.
+          IF ( UNI .EQ. 0. ) UNI = TWOM48
+        ENDIF
+        RVEC(IVEC) = UNI
+  100 CONTINUE
+ 
+      NTOT(IBASE) = NTOT(IBASE) + LENV
+      IF ( NTOT(IBASE) .GE. MODCNS )  THEN
+        NTOT2(IBASE) = NTOT2(IBASE) + 1
+        NTOT(IBASE)  = NTOT(IBASE) - MODCNS
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/rnegbi.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/rnegbi.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/rnegbi.f	(revision 286)
@@ -0,0 +1,86 @@
+      SUBROUTINE RNEGBI( N,XN,ECM )
+ 
+C-----------------------------------------------------------------------
+C  R(ANDOM NUMBER WITH) NEG(ATIVE) BI(NOMIAL DISTRIBUTION)
+C
+C  RANDOM NUMBER GENERATOR FOR INTEGER NUMBERS DISTRIBUTED ACCORDING TO
+C  A NEGATIVE BINOMIAL DISTRIBUTION WITH PARAMETERS <N> AND K
+C  DELIVERS ONLY EVEN NUMBERS AS CHARGE MUST BE CONSERVED
+C  THIS SUBROUTINE IS CALLED FROM HDPM
+C  ARGUMENTS:
+C   XN     = <N>  AVERAGE VALUE OF N
+C   ECM    = CENTER OF MASS ENERGY
+C   N      = RANDOM NUMBER DISTRIBUTED WITH NEG. BIN. DISTR.
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION ECM,P,PN,Q,R,SUM,XI,XK,XN
+      INTEGER          N
+C-----------------------------------------------------------------------
+ 
+CC    IF ( DEBUG ) WRITE(MDEBUG,*) 'RNEGBI: XN,ECM=',SNGL(XN),SNGL(ECM)
+ 
+C  PARAMETRIZATION OF PARAMETER K OF NEG.BIN. DISTRIBUTION ACCORDING
+C  TO  UA5 COLLABORATION, PHYS. LETT. 167B (1986) 476
+      XK  = 1.D0 / ( -0.104D0 + 0.058D0 * LOG(ECM) )
+C  OTHER PARAMETERS
+      R   = XN / XK
+      Q   = 1.D0 / (1.D0 + R)
+      P   = R * Q
+ 
+C  VALUES FOR N EQUAL 0
+  1   CONTINUE
+      N   = 0
+      PN  = Q**XK
+      SUM = PN
+C  GET UNIFORM RANDOM NUMBER
+      CALL RMMAR( RD,1,1 )
+      IF ( RD(1) .LE. SUM ) GOTO 100
+C  COMPARE WITH SUM OVER P(N)
+      DO  2  XI = 1.D0, 1350.D0
+        PN  = PN * P * (XK - 1.D0 + XI) / XI
+        SUM = SUM + PN
+        IF ( RD(1) .LE. SUM ) THEN
+          N = XI
+          GOTO 100
+        ENDIF
+  2   CONTINUE
+      N = 1350
+ 
+ 100  CONTINUE
+      IF ( MOD(N,2) .NE. 0  .AND.  N .NE. 1 ) GOTO 1
+CC    IF (DEBUG) WRITE(MDEBUG,*)'RNEGBI: RD(1),N,<N>=',RD(1),N,SNGL(XN)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/sdpm.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/sdpm.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/sdpm.f	(revision 286)
@@ -0,0 +1,560 @@
+      SUBROUTINE SDPM
+ 
+C-----------------------------------------------------------------------
+C  S(TARTING) D(UAL) P(ARTON) M(ODEL)
+C
+C  THIS ROUTINE DETERMINES THE TARGET NUCLEUS.
+C  IT CALLS ALSO THE VARIOUS INTERACTION MODELS.
+C  FOR HDPM, THIS ROUTINE LOOKS, HOW MANY NUCLEONS INTERACT AND WHICH
+C  RESIDUAL FRAGMENT OF THE PROJECTILE NUCLEUS REMAINS.
+C  THIS SUBROUTINE IS CALLED FROM NUCINT AND PIGEN
+C
+C  REDESIGN: D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,AIR.
+      COMMON /AIR/     COMPOS,PROBTA,AVERAW,AVOGAD
+      DOUBLE PRECISION COMPOS(3),PROBTA(3),AVERAW,AVOGAD
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,DPMFLG.
+      COMMON /DPMFLG/  NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+      INTEGER          NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,INTER.
+      COMMON /INTER/   AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
+     *                 IDIF,ITAR
+      DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
+      INTEGER          IDIF,ITAR
+*KEEP,ISTA.
+      COMMON /ISTA/    IFINET,IFINNU,IFINKA,IFINPI,IFINHY
+      INTEGER          IFINET,IFINNU,IFINKA,IFINPI,IFINHY
+*KEEP,MULT.
+      COMMON /MULT/    EKINL,MSMM,MULTMA,MULTOT
+      DOUBLE PRECISION EKINL
+      INTEGER          MSMM,MULTMA(37,13),MULTOT(37,13)
+*KEEP,NCSNCS.
+      COMMON /NCSNCS/  SIGN30,SIGN45,SIGN60,SIGO30,SIGO45,SIGO60,
+     *                 SIGA30,SIGA45,SIGA60,PNOA30,PNOA45,PNOA60,
+     *                 SIG30A,SIG45A,SIG60A
+      DOUBLE PRECISION SIGN30(56),SIGN45(56),SIGN60(56),
+     *                 SIGO30(56),SIGO45(56),SIGO60(56),
+     *                 SIGA30(56),SIGA45(56),SIGA60(56),
+     *                 PNOA30(1540,3),PNOA45(1540,3),PNOA60(1540,3),
+     *                 SIG30A(56),SIG45A(56),SIG60A(56)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RANGE.
+      COMMON /RANGE/   CC
+      DOUBLE PRECISION CC(20)
+*KEEP,REST.
+      COMMON /REST/    CONTNE,TAR,LT
+      DOUBLE PRECISION CONTNE(3),TAR
+      INTEGER          LT
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,SIGM.
+      COMMON /SIGM/    SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+      DOUBLE PRECISION SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+*KEEP,VKIN.
+      COMMON /VKIN/    BETACM
+      DOUBLE PRECISION BETACM
+*KEEP,VENUS.
+      COMMON /VENUS/   ISH0,IVERVN,MTAR99,FVENUS,FVENSG
+      INTEGER          ISH0,IVERVN,MTAR99
+      LOGICAL          FVENUS,FVENSG
+*KEND.
+ 
+      DOUBLE PRECISION PFRX(60),PFRY(60)
+      DOUBLE PRECISION COSTET,EA,P,PHIV,PTM,PT2,
+     *                 SIGMAA,SIGMAN,SIGMAO,SIG45,S45SQ,S4530
+      DOUBLE PRECISION CGHSIG,EKIN
+      EXTERNAL         CGHSIG
+      INTEGER          ITYP(60),I,IA,IANEW,INACTA,INACTZ,INDEX,INEUTR,
+     *                 IZ,IZNEW,J,JFIN,KNEW,L,LL,NPRPRO,NNEPRO
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+  444 FORMAT(' SDPM  : CURPAR=',1P,9E10.3)
+ 
+C  IA IS MASS NUMBER OF PROJECTILE
+      IA = ITYPE / 100
+      IF ( IA .GT. 56 ) THEN
+        WRITE(MONIOU,*) 'SDPM  : NOT FORESEEN PARTICLE TYPE=',ITYPE
+        STOP
+      ENDIF
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  TREATMENT OF GAMMAS COMING FROM EGS4 (PIGEN)
+      IF     ( ITYPE .EQ. 1 ) THEN
+C  RATIOS OF CROSS SECTIONS GO LIKE A**0.91
+        FRACTN = COMPOS(1) * 11.04019D0
+        FRCTNO = FRACTN + COMPOS(2) * 12.46663D0
+        SIGAIR = FRCTNO + COMPOS(3) * 28.69952D0
+C  TARGET IS CHOSEN AT RANDOM
+        CALL RMMAR( RD,1,1 )
+        IF     ( RD(1)*SIGAIR .LE. FRACTN ) THEN
+C  INTERACTION WITH NITROGEN
+          LT  = 1
+          TAR = 14.D0
+        ELSEIF ( RD(1)*SIGAIR .LE. FRCTNO ) THEN
+C  INTERACTION WITH OXYGEN
+          LT  = 2
+          TAR = 16.D0
+        ELSE
+C  INTERACTION WITH ARGON
+          LT  = 3
+          TAR = 40.D0
+        ENDIF
+ 
+C  GAMMAS ARE TREATED BY VENUS, IF SUFFICIENT ENERGY
+        IF ( FVENUS  .AND.  CURPAR(2) .GT. HILOELB ) THEN
+          CALL VENLNK
+        ELSE
+          CALL HDPM
+        ENDIF
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  NORMAL HADRON PROJECTILE
+      ELSEIF ( ITYPE .LT. 100 ) THEN
+ 
+C  WITH WHAT KIND OF TARGET DOES PROJECTILE INTERACT?
+        IF ( FIXTAR ) THEN
+C  TARGET OF FIRST INTERACTION IS FIXED
+          LT = N1STTR
+          IF     ( N1STTR .EQ. 1 ) THEN
+            TAR = 14.D0
+          ELSEIF ( N1STTR .EQ. 2 ) THEN
+            TAR = 16.D0
+          ELSE
+            TAR = 40.D0
+          ENDIF
+          FIXTAR = .FALSE.
+        ELSE
+C  TARGET IS CHOSEN AT RANDOM ACCORDING TO CROSS SECTION
+C  SIGMA IS ENERGY DEPENDENT INELASTIC NUCLEON-NUCLEON CROSS SECTION
+C  AND IS SET IN BOX2
+C  AUXIL. QUANTITIES FOR INTERPOLATION
+          SIG45  = SIGMA - 45.D0
+          S45SQ  = SIG45**2 / 450.D0
+          S4530  = SIG45 / 30.D0
+C  INELASTIC CROSS SECTIONS FOR PROJECTICLE WITH MASS NUMBER 1
+          SIGMAN = (1.D0 - 2.D0 * S45SQ) * SIGN45(1)
+     *                  +(S45SQ - S4530) * SIGN30(1)
+     *                  +(S45SQ + S4530) * SIGN60(1)
+          FRACTN = COMPOS(1) * SIGMAN
+          SIGMAO = (1.D0 - 2.D0 * S45SQ) * SIGO45(1)
+     *                  +(S45SQ - S4530) * SIGO30(1)
+     *                  +(S45SQ + S4530) * SIGO60(1)
+          FRCTNO = FRACTN + COMPOS(2) * SIGMAO
+          SIGMAA = (1.D0 - 2.D0 * S45SQ) * SIGA45(1)
+     *                  +(S45SQ - S4530) * SIGA30(1)
+     *                  +(S45SQ + S4530) * SIGA60(1)
+C  INELASTIC CROSS SECTIONS OF AIR FOR PROJECTILE WITH MASS NUMBER 1
+          SIGAIR = FRCTNO + COMPOS(3)*SIGMAA
+ 333      CONTINUE
+          CALL RMMAR( RD,1,1 )
+          IF(DEBUG)WRITE(MDEBUG,*)'SDPM  : FRACTN=',SNGL(FRACTN),
+     *      'FRCTNO=',SNGL(FRCTNO),'RD=',RD(1)
+          IF     ( RD(1)*SIGAIR .LE. FRACTN ) THEN
+C  INTERACTION WITH NITROGEN
+            LT  = 1
+            TAR = 14.D0
+          ELSEIF ( RD(1)*SIGAIR .LE. FRCTNO ) THEN
+C  INTERACTION WITH OXYGEN
+            LT  = 2
+            TAR = 16.D0
+          ELSE
+C  INTERACTION WITH ARGON
+            LT  = 3
+            TAR = 40.D0
+          ENDIF
+        ENDIF
+ 
+        IF ( FVENUS ) THEN
+C  MESONS, NUCLEONS AND STRANGE BARYONS ARE TREATED BY VENUS (JAN 95)
+          IF ( (ITYPE .GE.  7  .AND.  ITYPE .LE. 16)  .OR.
+     *         (ITYPE .GE. 18  .AND.  ITYPE .LE. 32)  )THEN
+            CALL VENLNK
+          ELSE
+            CALL HDPM
+          ENDIF
+        ELSE
+          CALL HDPM
+        ENDIF
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  HEAVY PRIMARY INCIDENT WITH IA NUCLEONS
+      ELSEIF ( IA .LE. 56 ) THEN
+ 
+        IZ = MOD(ITYPE,100)
+C  WITH WHAT KIND OF TARGET DOES PROJECTILE INTERACT?
+        IF ( FIXTAR ) THEN
+C  TARGET OF FIRST INTERACTION IS FIXED
+          LT = N1STTR
+          IF     ( N1STTR .EQ. 1 ) THEN
+            TAR = 14.D0
+          ELSEIF ( N1STTR .EQ. 2 ) THEN
+            TAR = 16.D0
+          ELSE
+            TAR = 40.D0
+          ENDIF
+          FIXTAR = .FALSE.
+          CALL RMMAR( RD,2,1 )
+        ELSE
+C  ONLY INELASTIC INTERACTIONS WITH HEAVY PRIMARY/FRAGMENT
+C  SIGMA IS ENERGY DEPENDENT INELASTIC NUCLEON-NUCLEON CROSS SECTION
+C  AND IS SET IN BOX2
+C  AUXIL. QUANTITIES FOR INTERPOLATION
+          SIG45  = SIGMA - 45.D0
+          S45SQ  = SIG45**2 / 450.D0
+          S4530  = SIG45 / 30.D0
+C  INELASTIC CROSS SECTIONS FOR PROJECTICLE WITH MASS NUMBER IA
+          SIGMAN = (1.D0 - 2.D0 * S45SQ) * SIGN45(IA)
+     *                  +(S45SQ - S4530) * SIGN30(IA)
+     *                  +(S45SQ + S4530) * SIGN60(IA)
+          FRACTN = COMPOS(1) * SIGMAN
+          SIGMAO = (1.D0 - 2.D0 * S45SQ) * SIGO45(IA)
+     *                  +(S45SQ - S4530) * SIGO30(IA)
+     *                  +(S45SQ + S4530) * SIGO60(IA)
+          FRCTNO = FRACTN + COMPOS(2) * SIGMAO
+          SIGMAA = (1.D0 - 2.D0 * S45SQ) * SIGA45(IA)
+     *                  +(S45SQ - S4530) * SIGA30(IA)
+     *                  +(S45SQ + S4530) * SIGA60(IA)
+C  INELASTIC CROSS SECTIONS OF AIR FOR PROJECTILE WITH MASS NUMBER IA
+          SIGAIR = FRCTNO +COMPOS(3)*SIGMAA
+C  TARGET IS CHOSEN AT RANDOM
+          CALL RMMAR( RD,2,1 )
+          IF(DEBUG)WRITE(MDEBUG,*)'SDPM  : FRACTN=',SNGL(FRACTN),
+     *      'FRCTNO=',SNGL(FRCTNO),'RD=',RD(1)
+          IF     ( RD(1)*SIGAIR .LE. FRACTN ) THEN
+C  INTERACTION WITH NITROGEN
+            LT  = 1
+            TAR = 14.D0
+          ELSEIF ( RD(1)*SIGAIR .LE. FRCTNO ) THEN
+C  INTERACTION WITH OXYGEN
+            LT  = 2
+            TAR = 16.D0
+          ELSE
+C  INTERACTION WITH ARGON
+            LT  = 3
+            TAR = 40.D0
+          ENDIF
+        ENDIF
+C  TREAT NUCLEUS BY VENUS, IF SELECTED AND ENERGY/NUCLEON HIGH ENOUGH
+        IF ( FVENUS .AND. PAMA(ITYPE)*GAMMA .GT. HILOELB*IA ) THEN
+          CALL VENLNK
+          RETURN
+        ENDIF
+ 
+C  TREATMENT OF NUCLEUS-NUCLEUS INTERACTION IN HDPM BY SUPERPOSITION
+C
+C  INDEX CALCULATION 1<I=<56     NUCLEONS IN PROJECTILE
+C                    1<J<I       INTERACTING NUCLEONS
+C                    P(I,I)=1    CUMULATIVE PROBABILITIES
+C                    P(I,J)  ---> P( I*(I-3)*0.5+J+1 )
+C  IZ     IS NUMBER OF PROTONS IN PROJECTILE
+C  LT     IS INDEX FOR TARGET 1 = N, 2 = O, 3 = AR
+C  INACTA IS NUMBER OF INTERACTING NUCLEONS
+C  INACTZ IS NUMBER OF INTERACTING PROTONS
+ 
+C  LOOK, HOW MANY NUCLEONS INTERACT
+        DO 100  J = 1,IA-1
+          INACTA = J
+          INDEX  = IA * (IA-3) * 0.5 + 1 + J
+          P = ( 1.D0 - S45SQ *2.D0 ) * PNOA45(INDEX,LT)
+     *            +( S45SQ - S4530 ) * PNOA30(INDEX,LT)
+     *            +( S45SQ + S4530 ) * PNOA60(INDEX,LT)
+          IF ( RD(2) .LT. P ) GO TO 110
+  100   CONTINUE
+C  ALL NUCLEONS INTERACT  (INACTA EQUAL IA)
+        INACTA = INACTA + 1
+ 
+  110   CONTINUE
+        IANEW  = IA - INACTA
+ 
+C  REMAINING PROJECTILE WITH IANEW NUCLEONS
+        DO 120  L = 2,8
+          SECPAR(L) = CURPAR(L)
+  120   CONTINUE
+ 
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  PROJECTILE NUCLEUS FRAGMENTS COMPLETELY, WRITE SPECTATOR NUCLEONS
+C  ONTO STACK
+        IF ( NFRAGM .EQ. 0 ) THEN
+C  LOOK, HOW MANY PROTONS AND NEUTRONS ARE FORMED
+          IZNEW  = IANEW / 2.15D0 + 0.7D0
+          INEUTR = IANEW - IZNEW
+          INACTZ = MAX( IZ-IZNEW, 0 )
+ 
+          IF ( IZNEW .GT. 0 ) THEN
+C  PROTONS
+            SECPAR(1) = 14.D0
+            DO 300  L = 1,IZNEW
+              CALL TSTACK
+  300       CONTINUE
+          ENDIF
+          IF ( INEUTR .GT. 0 ) THEN
+C  NEUTRONS
+            SECPAR(1) = 13.D0
+            DO 310  L = 1,INEUTR
+              CALL TSTACK
+  310       CONTINUE
+          ENDIF
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  NO FRAGMENTATION, BUT SUCCESSIVE ABRASION OF PROJECTILE NUCLEUS
+        ELSE
+          IF ( DEBUG ) WRITE( MDEBUG,111 ) TAR,INACTA,IANEW
+  111     FORMAT(' SDPM  : TARGET=',F4.0,' INACTA=',I4,' IANEW=',I4)
+ 
+C  ALL NUCLEONS INTERACT, NO RESIDUAL NUCLEUS
+          IF     ( IANEW .EQ. 0 ) THEN
+            INACTZ    = IZ
+            IF ( DEBUG ) WRITE(MDEBUG,554) (CURPAR(I),I=1,9)
+  554       FORMAT (' SDPM  : CURPAR=',1P,9E10.3)
+            KNEW = 0
+ 
+C  REMAINING NUCLEUS IS A NUCLEON
+          ELSEIF ( IANEW .EQ. 1 ) THEN
+            CALL RMMAR( RD,1,1 )
+            IZNEW     = NINT(RD(1))
+            INACTZ    = IZ - IZNEW
+            KNEW      = 13 + IZNEW
+ 
+C  REMAINING NUCLEUS GETS A CHARGE WHICH IS ABOUT HALF THE MASS NUMBER
+          ELSEIF ( IANEW .GT. 1 ) THEN
+            IZNEW = FLOAT(IANEW) / 2.15D0 + 0.7D0
+            INACTZ = MAX( IZ - IZNEW, 0 )
+            KNEW  = IANEW*100 + IZNEW
+ 
+C  REMAINING NUCLEUS DEEXCITES BY EVAPORATION OF NUCLEONS/ALPHA PARTCLS.
+            IF ( NFRAGM .GE. 2 ) THEN
+              JFIN=0
+              CALL VAPOR(IA,KNEW,JFIN,ITYP,PFRX,PFRY)
+              IF ( JFIN .LE. 0 ) GOTO 190
+              KNEW = 0
+              DO  135 J=1,JFIN
+                EA = GAMMA * PAMA(ITYP(J))
+                IF (DEBUG) WRITE (MDEBUG,*)'SDPM  : J,ITYP,EA=',
+     *                                              J,ITYP,SNGL(EA)
+                PTM = EA**2 - PAMA(ITYP(J))**2
+                PT2 = PFRX(J)**2 + PFRY(J)**2
+                IF ( PT2 .GE. PTM ) THEN
+                  IF (DEBUG) WRITE(MDEBUG,*)'SDPM  : PT REJECT ',J
+                  GOTO 135
+                ENDIF
+                IF ( PTM .GT. 0.D0 ) THEN
+                  COSTET = SQRT( 1.D0 - PT2/PTM )
+                ELSE
+                  COSTET = 1.D0
+                ENDIF
+                IF ( PFRX(J) .NE. 0.D0  .OR.  PFRY(J) .NE. 0.D0 ) THEN
+                  PHIV = ATAN2( PFRY(J), PFRX(J) )
+                ELSE
+                  PHIV = 0.D0
+                ENDIF
+                CALL ADDANG( COSTHE,PHI, COSTET,PHIV,
+     *                                           SECPAR(3),SECPAR(4) )
+                IF ( SECPAR(3) .GE. C(29) ) THEN
+                  IF ( J .LT. JFIN ) THEN
+                    SECPAR(1) = ITYP(J)
+                    CALL TSTACK
+                  ELSE
+                    KNEW  = ITYP(JFIN)
+                    IANEW = KNEW/100
+                  ENDIF
+                ELSE
+                  IF (DEBUG) WRITE(MDEBUG,*)'SDPM  : ANGLE REJECT ',J
+                ENDIF
+ 135          CONTINUE
+            ENDIF
+          ENDIF
+ 
+C  REMAINING NUCLEUS: MASS 5 CANNOT BE TREATED IN BOX2
+          IF     ( KNEW/100 .EQ. 5 ) THEN
+            IF ( MOD(KNEW,100) .GE. 3 ) THEN
+C  MASS 5: SPLIT OFF ONE PROTON
+              SECPAR(1) = 14.D0
+              CALL TSTACK
+              KNEW = KNEW - 101
+            ELSE
+C  MASS 5: SPLIT OFF ONE NEUTRON
+              SECPAR(1) = 13.D0
+              CALL TSTACK
+              KNEW = KNEW - 100
+            ENDIF
+ 
+C  REMAINING NUCLEUS: MASS 8 CANNOT BE TREATED IN BOX2
+          ELSEIF ( KNEW/100 .EQ. 8 ) THEN
+            IF     ( MOD(KNEW,100) .GE. 5 ) THEN
+C  MASS 8: SPLIT OFF ONE PROTON
+              SECPAR(1) = 14.D0
+              CALL TSTACK
+              KNEW = KNEW - 101
+            ELSEIF ( MOD(KNEW,100) .LE. 3 ) THEN
+C  MASS 8: SPLIT OFF ONE NEUTRON
+              SECPAR(1) = 13.D0
+              CALL TSTACK
+              KNEW = KNEW - 100
+            ELSE
+C  MASS 8: SPLIT OFF ONE ALPHA PARTICLE
+              SECPAR(1) = 402.D0
+              CALL TSTACK
+              KNEW = KNEW - 402
+            ENDIF
+          ENDIF
+ 
+          IF ( KNEW .GT. 0 ) THEN
+            SECPAR(1) = KNEW
+              CALL TSTACK
+            IF ( DEBUG ) WRITE(MDEBUG,555) (SECPAR(I),I=1,9)
+ 555        FORMAT (' SDPM  : SECPAR=',1P,9E10.3)
+          ENDIF
+        ENDIF
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  HERE THE REACTING NUCLEONS ARE TREATED
+ 190    NPRPRO = INACTZ
+        NNEPRO = INACTA - INACTZ
+ 
+C  TREAT INTERACTING NEUTRONS FROM PROJECTILE
+        IF ( NNEPRO .GE. 1 ) THEN
+          CURPAR(1) = 13.D0
+          ITYPE     = 13
+C  CALCULATE GAMMA, BETA AND ENERGY IN CENTER OF MASS
+          GCM       = SQRT( GAMMA * 0.5D0 + 0.5D0 )
+          ECM       = PAMA(ITYPE) * GCM * 2.D0
+          BETACM    = SQRT( 1.D0 - 1.D0 / GCM**2 )
+          DO 200  LL = 1,NNEPRO
+C  USE GHEISHA IF THE CROSS SECTION HAS BEEN CALCULATED FOR GHEISHA
+            IF (  GHEISH  .AND.  ECM .LE. HILOECM ) THEN
+              ELAB = PAMA(ITYPE) *  GAMMA
+              PLAB = ELAB * BETA
+              EKIN = ELAB - PAMA(ITYPE)
+              SIGAIR = CGHSIG(SNGL(PLAB),SNGL(EKIN),ITYPE)
+              CALL CGHEI
+            ELSE
+C  DETERMINE TYPE OF INTERACTION FOR NUCLEONS AND ANTINUCLEONS
+              IF     ( ECM .GT. CC(4) ) THEN
+C  DUAL PARTON MODEL
+                CALL HDPM
+              ELSEIF ( ECM .GT. CC(3) ) THEN
+C  USE THE INTERACTION ROUTINES OF PKF GRIEDER
+C  2 HEAVY ISOBARS AND ANNIHILATION
+                CALL BOX63
+              ELSEIF ( ECM .GT. CC(2) ) THEN
+C  1 HEAVY ISOBAR + NUCLEON AND ANNIHILATION
+                CALL BOX62
+              ELSEIF ( ECM .GT. CC(1) ) THEN
+C  1 LIGHT ISOBAR + NUCLEON AND ANNIHILATION
+                CALL BOX61
+              ELSE
+C  ELASTIC SCATTERING AND ANNIHILATION
+                CALL BOX60
+              ENDIF
+            ENDIF
+ 200      CONTINUE
+        ENDIF
+ 
+C  TREAT INTERACTING PROTONS FROM PROJECTILE IN ROUTINE HDPM
+        IF ( NPRPRO .GE. 1 ) THEN
+          CURPAR(1) = 14.D0
+          ITYPE     = 14
+C  CALCULATE GAMMA, BETA AND ENERGY IN CENTER OF MASS
+          GCM       = SQRT( GAMMA * 0.5D0 + 0.5D0 )
+          ECM       = PAMA(ITYPE) * GCM * 2.D0
+          BETACM    = SQRT( 1.D0 - 1.D0 / GCM**2 )
+          DO 210  LL = 1,NPRPRO
+C  USE GHEISHA IF THE CROSS SECTION HAS BEEN CALCULATED FOR GHEISHA
+            IF (  GHEISH  .AND.  ECM .LE. HILOECM ) THEN
+              ELAB = PAMA(ITYPE) *  GAMMA
+              PLAB = ELAB * BETA
+              EKIN = ELAB - PAMA(ITYPE)
+              SIGAIR = CGHSIG(SNGL(PLAB),SNGL(EKIN),ITYPE)
+              CALL CGHEI
+            ELSE
+C  DETERMINE TYPE OF INTERACTION FOR NUCLEONS AND ANTINUCLEONS
+              IF     ( ECM .GT. CC(4) ) THEN
+C  DUAL PARTON MODEL
+                CALL HDPM
+              ELSEIF ( ECM .GT. CC(3) ) THEN
+C  USE THE INTERACTION ROUTINES OF PKF GRIEDER
+C  2 HEAVY ISOBARS AND ANNIHILATION
+                CALL BOX63
+              ELSEIF ( ECM .GT. CC(2) ) THEN
+C  1 HEAVY ISOBAR + NUCLEON AND ANNIHILATION
+                CALL BOX62
+              ELSEIF ( ECM .GT. CC(1) ) THEN
+C  1 LIGHT ISOBAR + NUCLEON AND ANNIHILATION
+                CALL BOX61
+              ELSE
+C  ELASTIC SCATTERING AND ANNIHILATION
+                CALL BOX60
+              ENDIF
+            ENDIF
+ 210      CONTINUE
+        ENDIF
+ 
+C  ALL PARTICLES, INCLUDING THE LEADING ONE, ARE NOW WRITTEN TO STACK
+ 
+      ELSE
+        WRITE(MONIOU,*) 'SDPM  : NOT FORESEEN PARTICLE TYPE=',ITYPE
+        STOP
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/selcor.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/selcor.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/selcor.f	(revision 286)
@@ -0,0 +1,71 @@
+      SUBROUTINE SELCOR(X,Y)
+ 
+C-----------------------------------------------------------------------
+C  SEL(ECT) COR(E LOCATION)
+C
+C  SELECT A QUASI RANDOM CORE LOCATION
+C  THIS SUBROUTINE IS CALLED FROM INPRM
+C
+C  DESIGN  : J. KNAPP   IK1  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,CEREN2.
+      COMMON /CEREN2/  PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS,CERYOS,
+     *                 NCERX,NCERY,ICERML
+      REAL             PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
+     *                 DCERX,DCERY,ACERX,ACERY,
+     *                 XCMAX,YCMAX,EPSX,EPSY,
+     *                 DCERXI,DCERYI,FCERX,FCERY,
+     *                 XSCATT,YSCATT,CERXOS(20),CERYOS(20)
+      INTEGER          NCERX,NCERY,ICERML
+*KEND.
+ 
+      REAL    RD(2),X,Y
+      LOGICAL FIRST
+      SAVE    FIRST
+      DATA    FIRST /.TRUE./
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'SELCOR:'
+ 
+C  INITIALIZE SOBOL NUMBER GENERATOR
+      IF ( FIRST ) THEN
+        FIRST = .FALSE.
+        CALL SOBSEQ(-2,RD)
+      ENDIF
+C  TAKE A PAIR OF QUASI RANDOM NUMBERS
+      CALL SOBSEQ(2,RD)
+      X = XSCATT * (2.*RD(1)-1.)
+      Y = YSCATT * (2.*RD(2)-1.)
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*)'SELCOR: CORE LOCATION X=',X,' Y=',Y
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/shower.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/shower.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/shower.f	(revision 286)
@@ -0,0 +1,85 @@
+      SUBROUTINE SHOWER
+C
+C*********************************************************************
+C  DESIGN  : D. HECK   IK3  FZK KARLSRUHE
+C  DATE    : AUG  11, 1988
+C*********************************************************************
+C  THIS ROUTINE LOOKS, WHAT IS ON TOP OF STACK, AND CALLS THE
+C  APPROPRIATE ROUTINE TO TREAT THIS PARTICLE.
+C*********************************************************************
+      COMMON/MISC/KMPI,KMPO,DUNIT,NOSCAT,MED(6),RHOR(6),IRAYLR(6)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+C***  TAKE FIRST PARTICLE IN STACK
+      NP=1
+      IF((DEBUG))CALL AUSGB2
+251   CONTINUE
+C ***  DECIDE WHAT IS ON TOP OF STACK
+261    CONTINUE
+C  ***  JUMP TO PARTICLE IN QUESTION
+C  ***    THE FOLLOWING PARTICLE IDENTIFICATION IS MADE BY THE
+C  ***    VALUE OF IQ(NP) (ACCORDING TO PROGRAM 'GEANT')
+C  ***    IQ    =  1         PHOTON
+C  ***          =  2         POSITRON E (+)
+C  ***          =  3         ELECTRON E (-)
+C  ***          =  5         POSITIVE MUON (+)
+C  ***          =  6         NEGATIVE MUON (-)
+C  ***          =  7         NEUTRAL  PION (0)
+C  ***          =  8         POSITIVE PION (+)
+C  ***          =  9         NEGATIVE PION (-)
+C  ***    IF IQ =  OTHER VALUE, JUMP TO ERROR MESSAGE
+        GO TO(270,280,280,290, 300,300,300,300,300) (IQ(NP))
+C  ***  IQ OUT OF RANGE?
+290     WRITE(KMPO,320) IQ(NP)
+320     FORMAT(' SHOWER: PARTICLE TYPE ',I5,' NOT IDENTIFIED')
+        CALL AUSGB2
+        NP=NP-1
+        GO TO262
+300     CALL MPPROP
+        GO TO262
+270     CALL PHOTON(IRCODE)
+C  ***  PHOTON DISCARDED ?
+        IF((IRCODE.EQ.2))GO TO262
+        IF((IQ(NP).LT.2 .OR. IQ(NP).GT.3))GO TO261
+280     CALL ELECTR(IRCODE)
+C  ***  ELECTRON DISCARDED ?
+        IF((IRCODE.EQ.2))GO TO262
+        IF((IQ(NP).EQ.1))GO TO 270
+C  ***  LOOP BACK UP TO PARTICLE SELECTION
+       GO TO 261
+262    CONTINUE
+C ***  CHECK TO SEE IF ANYTHING LEFT ON STACK
+C ***  NOTHING ON STACK, SO JUMP OUT OF LOOP
+       IF((NP.LE.0))GO TO252
+      GO TO 251
+252   CONTINUE
+C***  TOP STACK LOOP END
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/single.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/single.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/single.f	(revision 286)
@@ -0,0 +1,165 @@
+      SUBROUTINE SINGLE( E,KIND,AMASS,ASMASS )
+ 
+C-----------------------------------------------------------------------
+C  SINGLE (PARTICLE)
+C
+C  NUCLEON, ANTINUCLEON, PION OR KAON INITIATED
+C  HANDLES SINGLE PARTICLE CASE
+C  THIS SUBROUTINE IS CALLED FROM MANY BOX ROUTINES
+C  ARGUMENTS:
+C   E      = AVAILABLE ENERGY IN CM
+C   KIND   = 1  BACKWARD PARTICLE
+C          = 0  FORWARD  PARTICLE
+C   AMASS  = MASS OF SINGLE PARTICLE
+C   ASMASS = MASS TO BE LEFT OVER FOR OTHER PARTICLES
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,ELASTY.
+      COMMON /ELASTY/  ELAST,IELIS,IELHM,IELNU,IELPI
+      DOUBLE PRECISION ELAST
+      INTEGER          IELIS(20),IELHM(20),IELNU(20),IELPI(20)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,VKIN.
+      COMMON /VKIN/    BETACM
+      DOUBLE PRECISION BETACM
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,201)E,KIND,AMASS,ASMASS
+ 201  FORMAT(' SINGLE: E,KIND,AMASS,ASMASS=',1P,E10.4,I3,2E10.4)
+ 
+      IF ( KIND .NE. 0 ) GOTO 100
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  FORWARD PARTICLE
+C  NUCLEON, ANTINUCLEON, PION, OR KAON
+C  PIONS AND / OR KAONS ARE ALWAYS FORWARD
+ 
+      GFCM   = ( E**2 + AMASS**2 - ASMASS**2 ) * 0.5D0 / (E*AMASS)
+      GFCM   = MAX( 1.D0, GFCM )
+      BEFCM  = SQRT( GFCM**2 - 1.D0 ) / GFCM
+      GFLAB  = GCM * GFCM * ( 1.D0 + BETACM * BEFCM )
+      PT     = PTRANS(DUMMY)
+      PLLAB2 = MAX( 1.D-6, AMASS**2*(GFLAB**2-1.D0) )
+      CTHETA = SQRT( PLLAB2 / (PT**2+PLLAB2) )
+      IF ( CTHETA .LT. C(27) ) GOTO 3
+      CALL RMMAR( RD,2,1 )
+      CALL ADDANG( COSTHE,PHI, CTHETA,RD(1)*PI2, SECPAR(3),SECPAR(4) )
+      IF ( SECPAR(3) .LT. C(29) ) GOTO 3
+ 
+C  CHARGE ASSIGNMENT
+      IF ( ITYPE .EQ. 10  .OR.  ITYPE .EQ. 11  .OR.
+     *     ITYPE .EQ. 12  .OR.  ITYPE .EQ. 16      ) THEN
+        SECPAR(1) = CURPAR(1)
+      ELSE
+        IF ( RD(2) .LT. 0.5 ) THEN
+          IADD = 1
+        ELSE
+          IADD = 0
+        ENDIF
+        IF     ( ITYPE .EQ. 13  .OR.  ITYPE .EQ. 14 ) THEN
+          SECPAR(1) = 13 + IADD
+        ELSEIF ( ITYPE .EQ.  8  .OR.  ITYPE .EQ.  9 ) THEN
+          SECPAR(1) =  8 + IADD
+        ELSEIF ( ITYPE .EQ. 15  .OR.  ITYPE .EQ. 25 ) THEN
+          SECPAR(1) = 15 + IADD * 10
+        ENDIF
+      ENDIF
+      SECPAR(2) = GFLAB
+      DO  1  J = 5,8
+        SECPAR(J) = CURPAR(J)
+    1 CONTINUE
+      CALL TSTACK
+ 
+    3 CONTINUE
+ 
+C  STATISTICS ON ELASTICITY
+      IN = 1.D0 + SECPAR(2) / GAMMA * 20.D0
+      IN = MIN( IN, 20 )
+      IF ( ITYPE .EQ. 13  .OR.  ITYPE .EQ. 14  .OR.
+     *     ITYPE .EQ. 15  .OR.  ITYPE .EQ. 25      ) THEN
+        IELNU(IN) = IELNU(IN) + 1
+      ELSE
+        IELPI(IN) = IELPI(IN)  + 1
+      ENDIF
+      RETURN
+ 
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C  RECOIL PARTICLE, NUCLEON ONLY
+C  FROM SIMPLE RECOIL SPECTRUM COMPUTED
+  100 CONTINUE
+      HELP   = MIN( C(10), GAMMA*0.5D0 )
+      CALL RMMAR( RD,3,1 )
+      GRLAB  = RD(1)*(HELP-1.D0)+ 1.D0
+      PT     = PTRANS(DUMMY)
+      PLLAB2 = MAX( 1.D-6, PAMA(14)**2*(GRLAB**2-1.D0) )
+      CTHETA = SQRT( PLLAB2 / (PT**2+PLLAB2) )
+      IF ( CTHETA .LT. C(27) ) RETURN
+      CALL ADDANG( COSTHE,PHI, CTHETA,RD(2)*PI2, SECPAR(3),SECPAR(4) )
+      IF ( SECPAR(3) .LT. C(29) ) RETURN
+      SECPAR(2)=GRLAB
+ 
+C  CHARGE ASSIGNEMENT
+      IF ( RD(3) .GE. 0.5 ) THEN
+        SECPAR(1) = 14.D0
+      ELSE
+        SECPAR(1) = 13.D0
+      ENDIF
+ 
+      DO 103  J = 5,8
+        SECPAR(J) = CURPAR(J)
+  103 CONTINUE
+      CALL TSTACK
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/sobseq.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/sobseq.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/sobseq.f	(revision 286)
@@ -0,0 +1,56 @@
+      SUBROUTINE SOBSEQ(N,X)
+ 
+C-----------------------------------------------------------------------
+C  SOB(OL) SEQ(UENCE)
+C
+C  SOBOL QUASI RANDOM NUMBER GENERATOR
+C  REFERENCE : NUMERICAL RECIPES, W.H. PRESS ET AL.,
+C              CAMBRIDGE UNIVERSITY PRESS, 1992  ISBN 0 521 43064 X
+C  THIS SUBROUTINE IS CALLED FROM SELCOR
+C-----------------------------------------------------------------------
+ 
+      INTEGER     N,MAXBIT,MAXDIM
+      REAL        X(*),FAC
+      PARAMETER   (MAXBIT=30,MAXDIM=6)
+      INTEGER     I,IM,IN,IPP,J,K,L,IP(MAXDIM),IU(MAXDIM,MAXBIT),
+     *            IV(MAXBIT*MAXDIM),IX(MAXDIM),MDEG(MAXDIM)
+      SAVE        IP,MDEG,IX,IV,IN,FAC
+      EQUIVALENCE (IV,IU)
+      DATA IP /0,1,1,2,1,4/, MDEG /1,2,3,3,4,4/, IX /6*0/
+      DATA IV /6*1,3,1,3,3,1,1,5,7,7,3,3,5,15,11,5,15,13,9,156*0/
+C-----------------------------------------------------------------------
+ 
+      IF (N.LT.0) THEN
+        DO 14 K=1,MAXDIM
+          DO 11 J=1,MDEG(K)
+            IU(K,J)=IU(K,J)*2**(MAXBIT-J)
+ 11       CONTINUE
+          DO 13 J=MDEG(K)+1,MAXBIT
+            IPP=IP(K)
+            I=IU(K,J-MDEG(K))
+            I=IEOR(I,I/2**MDEG(K))
+            DO 12 L=MDEG(K)-1,1,-1
+              IF(IAND(IPP,1).NE.0)I=IEOR(I,IU(K,J-L))
+              IPP=IPP/2
+ 12         CONTINUE
+            IU(K,J)=I
+ 13       CONTINUE
+ 14     CONTINUE
+        FAC=1./2.**MAXBIT
+        IN=0
+      ELSE
+        IM=IN
+        DO 15 J=1,MAXBIT
+          IF(IAND(IM,1).EQ.0)GOTO 1
+          IM=IM/2
+ 15     CONTINUE
+        PAUSE 'MAXBIT TOO SMALL IN SOBSEQ'
+ 1      IM=(J-1)*MAXDIM
+        DO 16 K=1,MIN(N,MAXDIM)
+          IX(K)=IEOR(IX(K),IV(IM+K))
+          X(K)=IX(K)*FAC
+ 16     CONTINUE
+        IN=IN+1
+      ENDIF
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/staend.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/staend.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/staend.f	(revision 286)
@@ -0,0 +1,114 @@
+      SUBROUTINE STAEND
+ 
+C-----------------------------------------------------------------------
+C  STA(RT) END
+C
+C  SUBROUTINE FOR GETTING THE CONTROL PRINTOUT OF THE CONSTANT ARRAYS
+C  PRINT CONTROL OUTPUT
+C  THIS SUBROUTINE IS CALLED FROM MAIN AND START
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,ANNI.
+      COMMON /ANNI/    CAN,CANN
+      DOUBLE PRECISION CAN(50),CANN(50)
+*KEEP,ATMOS.
+      COMMON /ATMOS/   AATM,BATM,CATM,DATM
+      DOUBLE PRECISION AATM(5),BATM(5),CATM(5),DATM(5)
+*KEEP,EDECAY.
+      COMMON /EDECAY/  CETA
+      DOUBLE PRECISION CETA(5)
+*KEEP,KAONS.
+      COMMON /KAONS/   CKA
+      DOUBLE PRECISION CKA(80)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANGE.
+      COMMON /RANGE/   CC
+      DOUBLE PRECISION CC(20)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STRBAR.
+      COMMON /STRBAR/  CSTRBA
+      DOUBLE PRECISION CSTRBA(11)
+*KEND.
+ 
+      INTEGER I
+C-----------------------------------------------------------------------
+ 
+C  PRINT CONTROL OUTPUT
+      WRITE(MONIOU,103) (C(I),I=1,50)
+  103 FORMAT (//' ',10('='),' CONSTANTS AND PARAMETERS ',43('=')
+     *        //' PHYSICAL CONSTANTS (C)' // (1P,4(E15.8,1X),E15.8) )
+      WRITE(MONIOU,110) (CKA(I),I=1,80)
+  110 FORMAT (//' CONSTANTS FOR KAONS CKA(1) TO CKA(40)'
+     *        // (1P,4(E15.8,1X),E15.8) )
+      WRITE(MONIOU,114) (CETA(I),I=1,5)
+  114 FORMAT (//' CONSTANTS FOR ETAS CETA(1) TO CETA(5)'
+     *        // (1P,4(E15.8,1X),E15.8) )
+      WRITE(MONIOU,115) (CSTRBA(I),I=1,11)
+  115 FORMAT (//' CONSTANTS FOR STRANGE BARYONS CSTRBA(1) TO ',
+     *            'CSTRBA(11)'// (1P,4(E15.8,1X),E15.8) )
+      IF ( .NOT. GHEISH ) THEN
+        WRITE(MONIOU,206) (CAN(I),I=1,30)
+  206   FORMAT (//' ANNIHILATION PARAMETERS, SET 1 (CAN)'
+     *          // (1P,4(E15.8,1X),E15.8) )
+        WRITE(MONIOU,209) (CANN(I),I=1,30)
+  209   FORMAT (//' ANNIHILATION PARAMETERS, SET 2 (CANN)'
+     *          // (1P,4(E15.8,1X),E15.8) )
+        WRITE(MONIOU,60) (CC(I),I=1,12)
+   60   FORMAT (//' THRESHOLD ENERGIES OF INTERACTION INTERVALS IN '
+     *             ,'GEV (CC)'// (1P,4(E15.8,1X),E15.8) )
+      ENDIF
+ 
+      WRITE(MONIOU,303) (AATM(I),BATM(I),CATM(I)*1.E-5,I=1,4),
+     *                    AATM(5),CATM(5)*1.E5
+  303 FORMAT (//' ',10('='),' ATMOSPHERE ', 57('=') /
+     * ' ( US STANDARD ATMOSPHERE PARAMETRIZED BY LINSLEY )'//
+     * ' HEIGHT H IN KM GIVES THICKNESS OF ATMOSPHERE T IN G/CM**2'/1P,
+     * ' H =   0 ...  4 KM ---> T = ',
+     * E12.5,' +',E11.4,' * EXP ( - H /',E11.4,' )'/
+     * ' H =   4 ... 10 KM ---> T = ',
+     * E12.5,' +',E11.4,' * EXP ( - H /',E11.4,' )'/
+     * ' H =  10 ... 40 KM ---> T = ',
+     * E12.5,' +',E11.4,' * EXP ( - H /',E11.4,' )'/
+     * ' H =  40 .. 100 KM ---> T = ',
+     * E12.5,' +',E11.4,' * EXP ( - H /',E11.4,' )'/
+     * ' H = 100 ...    KM ---> T = ',
+     * E12.5,' -',E11.4,' * H ' )
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/stankg.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/stankg.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/stankg.f	(revision 286)
@@ -0,0 +1,61 @@
+      SUBROUTINE STANKG
+ 
+C-----------------------------------------------------------------------
+C  STA(RT) NKG
+C
+C  INITIALIZE ARRAYS FOR SINGLE SHOWERS NKG CALCULATED VARIABLES
+C  THIS SUBROUTINE IS CALLED FROM MAIN
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,NKGS.
+      COMMON /NKGS/    CZX,CZY,CZXY,CZYX,SAH,SL,ZNE
+      DOUBLE PRECISION CZX(-10:10,2),CZY(-10:10,2),CZXY(-10:10,2),
+     *                 CZYX(-10:10,2),SAH(10),SL(10),ZNE(10)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      INTEGER I,K
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'STANKG:'
+ 
+C  CLEAR ARRAYS FOR AGE PARAMETER CALCULATION FOR EACH SHOWER
+      DO 17  I = 1,10
+        SAH(I) = 0.D0
+        SL (I) = 0.D0
+        ZNE(I) = 0.D0
+  17  CONTINUE
+C  CLEAR LATERAL ELECTRON DISTRIBUTION COUNTERS FOR EACH SHOWER
+      DO 45  K = 1,2
+      DO 45  I = -10,10
+        CZX (I,K) = 0.D0
+        CZY (I,K) = 0.D0
+        CZXY(I,K) = 0.D0
+        CZYX(I,K) = 0.D0
+  45  CONTINUE
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/start.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/start.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/start.f	(revision 286)
@@ -0,0 +1,682 @@
+      SUBROUTINE START
+ 
+C-----------------------------------------------------------------------
+C  START
+C
+C  PERFORMS INITIALISATIONS AND CHECKS AT THE BEGINNING OF RUN.
+C  CALLS DATAC TO READ IN DATA CARDS.
+C  CHECKS AND INITIALIZES SELECTED HADRONIC INTERACTION MODEL.
+C  THIS SUBROUTINE IS CALLED FROM MAIN
+C
+C  REDESIGN: J. KNAPP   IK1  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,AIR.
+      COMMON /AIR/     COMPOS,PROBTA,AVERAW,AVOGAD
+      DOUBLE PRECISION COMPOS(3),PROBTA(3),AVERAW,AVOGAD
+*KEEP,ANNI.
+      COMMON /ANNI/    CAN,CANN
+      DOUBLE PRECISION CAN(50),CANN(50)
+*KEEP,ATMOS.
+      COMMON /ATMOS/   AATM,BATM,CATM,DATM
+      DOUBLE PRECISION AATM(5),BATM(5),CATM(5),DATM(5)
+*KEEP,ATMOS2.
+      COMMON /ATMOS2/  HLAY,THICKL
+      DOUBLE PRECISION HLAY(5),THICKL(5)
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,DPMFLG.
+      COMMON /DPMFLG/  NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+      INTEGER          NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+*KEEP,EDECAY.
+      COMMON /EDECAY/  CETA
+      DOUBLE PRECISION CETA(5)
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEEP,ETHMAP.
+      COMMON /ETHMAP/  ECTMAP,ELEFT
+      DOUBLE PRECISION ECTMAP,ELEFT
+*KEEP,KAONS.
+      COMMON /KAONS/   CKA
+      DOUBLE PRECISION CKA(80)
+*KEEP,MAGNET.
+      COMMON /MAGNET/  BX,BZ,BVAL,BNORMC,BNORM,COSB,SINB,BLIMIT
+      DOUBLE PRECISION BX,BZ,BVAL,BNORMC
+      REAL             BNORM,COSB,SINB,BLIMIT
+*KEEP,MUMULT.
+      COMMON /MUMULT/  CHC,OMC,FMOLI
+      DOUBLE PRECISION CHC,OMC
+      LOGICAL          FMOLI
+*KEEP,MUPART.
+      COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
+      DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
+      LOGICAL          FMUBRM,FMUORG
+*KEEP,NCSNCS.
+      COMMON /NCSNCS/  SIGN30,SIGN45,SIGN60,SIGO30,SIGO45,SIGO60,
+     *                 SIGA30,SIGA45,SIGA60,PNOA30,PNOA45,PNOA60,
+     *                 SIG30A,SIG45A,SIG60A
+      DOUBLE PRECISION SIGN30(56),SIGN45(56),SIGN60(56),
+     *                 SIGO30(56),SIGO45(56),SIGO60(56),
+     *                 SIGA30(56),SIGA45(56),SIGA60(56),
+     *                 PNOA30(1540,3),PNOA45(1540,3),PNOA60(1540,3),
+     *                 SIG30A(56),SIG45A(56),SIG60A(56)
+*KEEP,NKGI.
+      COMMON /NKGI/    SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
+     *                 DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
+     *                 OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
+      DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
+     *                 ZSL(10),DIST(10),
+     *                 DISX(-10:10),DISY(-10:10),
+     *                 DISXY(-10:10,2),DISYX(-10:10,2),
+     *                 DLAX (-10:10,2),DLAY (-10:10,2),
+     *                 DLAXY(-10:10,2),DLAYX(-10:10,2),
+     *                 OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
+      INTEGER          IALT(2)
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,PRIMSP.
+      COMMON /PRIMSP/  PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX,ISPEC
+      DOUBLE PRECISION PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX
+      INTEGER          ISPEC
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RANGE.
+      COMMON /RANGE/   CC
+      DOUBLE PRECISION CC(20)
+*KEEP,RECORD.
+      COMMON /RECORD/  IRECOR
+      INTEGER          IRECOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKF.
+      COMMON /STACKF/  STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+      INTEGER          MAXSTK
+      PARAMETER        (MAXSTK = 12*340*2)
+      DOUBLE PRECISION STACK(MAXSTK)
+      INTEGER          STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+*KEEP,STRBAR.
+      COMMON /STRBAR/  CSTRBA
+      DOUBLE PRECISION CSTRBA(11)
+*KEEP,VERS.
+      COMMON /VERS/    VERNUM,MVDATE,VERDAT
+      DOUBLE PRECISION VERNUM
+      INTEGER          MVDATE
+      CHARACTER*18     VERDAT
+*KEEP,VENUS.
+      COMMON /VENUS/   ISH0,IVERVN,MTAR99,FVENUS,FVENSG
+      INTEGER          ISH0,IVERVN,MTAR99
+      LOGICAL          FVENUS,FVENSG
+*KEEP,CEREN3.
+      COMMON /CEREN3/  CERCNT,DATAB2,LHCER
+      INTEGER          MAXBF2
+      PARAMETER        (MAXBF2 = 39 * 7)
+      DOUBLE PRECISION CERCNT
+      REAL             DATAB2(MAXBF2)
+      INTEGER          LHCER
+*KEND.
+ 
+      DOUBLE PRECISION COAN,SE,TEMP1,TEMP2,TEMP3,THICK,TTIME,ZE,ZS,ZX
+      INTEGER          I,IA,J,L,N
+      EXTERNAL         THICK
+      CHARACTER*1      MARK
+C-----------------------------------------------------------------------
+ 
+C  SAY HELLO
+      WRITE(MONIOU,112)
+  112 FORMAT(/' ',120('A')//
+     *'   OOO      OOO     OOOO       OOOO    OO   O      O      O   '/
+     *'  O   O    O   O    O    O    O    O   OO   O    O       O O  '/
+     *' O        O     O   O     O   O        OO   O  O        O   O '/
+     *' O        O     O   O    O     OOOO    OO   OO         O     O'/
+     *' O        O     O   OOOO           O   OO   O  O       OOOOOOO'/
+     *'  O   O    O   O    O   O     O    O   OO   O    O     O     O'/
+     *'   OOO      OOO     O     O    OOOO    OO   O      O   O     O'//
+     *' COSMIC RAY SIMULATION FOR KASCADE'///
+     *' A PROGRAM TO SIMULATE EXTENSIVE AIR SHOWERS IN ATMOSPHERE'//
+     *' BASED ON A PROGRAM OF P.K.F. GRIEDER, UNIVERSITY BERN,'
+     *' SWITZERLAND'/
+     *' HDPM MODEL ACCORDING TO J.N. CAPDEVIELLE, COLLEGE DE FRANCE,',
+     *' PARIS, FRANCE'/
+     *' VENUS MODEL ACCORDING TO K. WERNER, UNIVERSITY NANTES, FRANCE'/
+     *' GHEISHA ROUTINES ACCORDING TO H. FESEFELDT, RWTH. AACHEN,'
+     *' GERMANY'/
+     *' EGS4 AND NKG FORMULAS FOR SIMULATION OF EL.MAG. PARTICLES'//)
+ 
+      MARK = '1'
+ 
+      WRITE(MONIOU,912) VERNUM,MARK,VERDAT
+  912 FORMAT(' INSTITUT FUER KERNPHYSIK '/
+     *       ' FORSCHUNGSZENTRUM UND UNIVERSITAET KARLSRUHE'/
+     *       ' POSTFACH 3640'/
+     *       ' D-76021 KARLSRUHE'/
+     *       ' GERMANY'//
+     *       ' IN CASE OF PROBLEMS CONTACT:'/
+     *       '           DIETER HECK             JOHANNES KNAPP'/
+     *       ' E-MAIL:   HECK@IK3.FZK.DE         KNAPP@IK1.FZK.DE'/
+     *       ' FAX:      (49) 7247-82-4075       (49) 7247-82-3548'/
+     *       ' TEL:      (49) 7247-82-3777       (49) 7247-82-3549'//
+     *       ' NUMBER OF VERSION : ',F6.3,A1/
+     *       ' DATE   OF VERSION : ',A18 /)
+ 
+      WRITE(MONIOU,141)
+  141 FORMAT(//' CERENKOV RADIATION IS GENERATED'/
+     *         ' ==============================='//)
+ 
+C  INITIALIZE FIELD WITH PARTICLE MASSES
+      CALL PAMAF
+ 
+ 
+C  READ RUN STEERING DATA CARDS
+      CALL DATAC
+ 
+C  CLEARS BUFFERS FOR HEADER AND FILLS IN PERMANENT INFORMATION
+      DO 889  L = 1,MAXBUF
+        EVTH(L)  = 0.
+        EVTE(L)  = 0.
+        RUNH(L)  = 0.
+        RUNE(L)  = 0.
+        DATAB(L) = 0.
+        DATAB2(L) = 0.
+  889 CONTINUE
+ 
+ 
+C  PERMANENT INFORMATION
+C  CHARACTER STRINGS
+      CRUNH = 'RUNH'
+      CRUNE = 'RUNE'
+      CEVTH = 'EVTH'
+      CEVTE = 'EVTE'
+ 
+      RUNH(2)  = NRRUN
+      RUNE(2)  = NRRUN
+      EVTH(44) = NRRUN
+ 
+C  DATE OF RUN
+      WRITE(MONIOU,101)
+ 101  FORMAT(//' ',10('='),' START OF RUN ',55('='))
+      CALL PRTIME(TTIME)
+      RUNH(3)  = TTIME
+      EVTH(45) = TTIME
+ 
+C  VERSION OF PROGRAM
+      RUNH(4)  = VERNUM
+      EVTH(46) = VERNUM
+ 
+C-----------------------------------------------------------------------
+C  INITIALISATION FOR RANDOM NUMBER GENERATOR
+      IF ( FEGS  .AND.  NSEQ .LT. 2 ) NSEQ = 2
+C  CERENKOV SELECTION DEMANDS ALWAYS EGS CALCULATION
+      FEGS = .TRUE.
+C  IN CASE OF CERENKOV CALCULATIONS THE 3. RANDOM SEQUENCE IS NEEDED
+      IF ( NSEQ .LT. 3 ) NSEQ = 3
+      DO 281  I = 1,NSEQ
+        IF ( .NOT. DEBUG   .AND.  .NOT. DEBDEL   .AND.
+     *      (ISEED(2,I) .GT. 1000  .OR.  ISEED(3,I) .GT. 0) ) THEN
+          WRITE(MONIOU,2811)  I
+2811      FORMAT(/' #########################################'/
+     *            ' ##  IMPROPER INITIALIZATION OF RANDOM  ##'/
+     *            ' ##   NUMBER GENERATOR SEQUENCE ',I6,'  ##'/
+     *            ' ##     IS EXTREMELY TIME CONSUMING     ##'/
+     *            ' ##       PLEASE READ THE MANUALS       ##'/
+     *            ' #########################################'/)
+        ENDIF
+        CALL RMMAQ( ISEED(1,I), I, 'S' )
+  281 CONTINUE
+      KNOR = .TRUE.
+ 
+      WRITE(MONIOU,158) (L,(ISEED(J,L),J=1,3),L=1,NSEQ)
+  158 FORMAT (/' RANDOM NUMBER GENERATOR AT BEGIN OF RUN :'/
+     *        (' SEQUENCE = ',I2,'  SEED = ',I9,'  CALLS = ',I9,
+     *         '  BILLIONS = ',I9))
+ 
+C-----------------------------------------------------------------------
+C  READ CROSS SECTIONS AND PROBABILITIES FOR NUCLEUS-NUCLEUS COLLISIONS
+      OPEN(UNIT=NUCNUC,FILE='NUCNUCCS',STATUS='OLD')
+      READ(NUCNUC,500) SIGN30,SIGN45,SIGN60,SIGO30,SIGO45,SIGO60,
+     *                 SIGA30,SIGA45,SIGA60
+      READ(NUCNUC,500) (PNOA30(I,1),I=1,1540),(PNOA45(I,1),I=1,1540),
+     *                 (PNOA60(I,1),I=1,1540),(PNOA30(I,2),I=1,1540),
+     *                 (PNOA45(I,2),I=1,1540),(PNOA60(I,2),I=1,1540),
+     *                 (PNOA30(I,3),I=1,1540),(PNOA45(I,3),I=1,1540),
+     *                 (PNOA60(I,3),I=1,1540)
+ 500  FORMAT( 5E16.10 )
+      CLOSE(UNIT=NUCNUC)
+ 
+C  INELASTIC CROSS SECTIONS FOR PROJECTICLE WITH MASS NUMBER IA
+      DO 501  IA = 1,56
+        SIG30A(IA) = COMPOS(1)*SIGN30(IA) + COMPOS(2)*SIGO30(IA)
+     *                                    + COMPOS(3)*SIGA30(IA)
+        SIG45A(IA) = COMPOS(1)*SIGN45(IA) + COMPOS(2)*SIGO45(IA)
+     *                                    + COMPOS(3)*SIGA45(IA)
+        SIG60A(IA) = COMPOS(1)*SIGN60(IA) + COMPOS(2)*SIGO60(IA)
+     *                                    + COMPOS(3)*SIGA60(IA)
+ 
+        IF (DEBUG) WRITE(MDEBUG,544) IA,SIG30A(IA),SIG45A(IA),SIG60A(IA)
+ 544    FORMAT(' START : CROSS SECTIONS A-AIR : A=',I2,1P,3E14.6)
+ 501  CONTINUE
+ 
+      WRITE(MONIOU,503)
+ 503  FORMAT (//' ',10('='),' INTERACTION MODELS ',49('='))
+C  HIGH ENERGY HADRONIC INTERACTION MODEL
+      IF ( FVENUS ) THEN
+        WRITE(MONIOU,*) 'VENUS TREATS HIGH ENERGY HADRONIC INTERACTIONS'
+        CALL VENINI
+        IF ( .NOT. GHEISH ) THEN
+          GHEISH = .TRUE.
+          WRITE(MONIOU,*)'GHEISHA OPTION NOT SELECTED, BUT SWITCHED ON'
+        ENDIF
+        IF     ( NFRAGM .EQ. 0 ) THEN
+          WRITE(MONIOU,*)
+     *    ' TOTAL FRAGMENTATION OF PRIMARY NUCLEUS IN FIRST INTERACTION'
+        ELSEIF ( NFRAGM .EQ. 1 ) THEN
+          WRITE(MONIOU,*)
+     *      ' NO FRAGMENTATION, NO EVAPORATION OF REMAINDER'
+        ELSEIF ( NFRAGM .EQ. 2 ) THEN
+          WRITE(MONIOU,1504)
+        ELSEIF ( NFRAGM .EQ. 3 ) THEN
+          WRITE(MONIOU,1505)
+        ELSE
+          NFRAGM = 4
+          WRITE(MONIOU,1507)
+        ENDIF
+        WRITE(MONIOU,*)
+      ELSE
+        WRITE(MONIOU,1506)
+      ENDIF
+1506  FORMAT(' HDPM ROUTINES TREAT HIGH ENERGY HADRONIC INTERACTIONS')
+ 
+ 
+      IF ( .NOT. FVENUS ) THEN
+C  INPUT FLAGS FOR HDPM OPTIONS
+      WRITE(MONIOU,*)'HDPM GENERATOR SPECIFICATIONS ARE:'
+      IF ( NFLAIN .EQ. 0 ) THEN
+        WRITE(MONIOU,*) ' RANDOM NUMBER OF INTERACTIONS IN AIR TARGET'
+        IF ( NFLDIF .EQ. 0 ) THEN
+          WRITE(MONIOU,*) ' NO DIFFRACTIVE SECOND INTERACTIONS'
+        ELSE
+          WRITE(MONIOU,*) ' DIFFRACTIVE SECOND INTERACTIONS'
+        ENDIF
+      ELSE
+        WRITE(MONIOU,*) ' FIXED NUMBER OF INTERACTIONS IN AIR TARGET'
+      ENDIF
+      IF ( NFLPI0 .EQ. 0 ) THEN
+        WRITE(MONIOU,*) ' RAPIDITY OF PI0 ACCORDING TO COLLIDER DATA'
+      ELSE
+        WRITE(MONIOU,*) ' RAPIDITY OF PI0 SAME AS THAT OF CHARGED'
+      ENDIF
+      IF ( NFLPIF .EQ. 0 ) THEN
+        WRITE(MONIOU,*) ' NO FLUCTUATIONS OF NUMBER OF PI0'
+      ELSE
+        WRITE(MONIOU,*)' FLUCTUATIONS OF NUMBER OF PI0 AS MEASURED ',
+     *         'AT THE COLLIDER'
+      ENDIF
+      IF ( NFLCHE .EQ. 0 ) THEN
+        WRITE(MONIOU,*) ' CHARGE EXCHANGE INTERACTION POSSIBLE '
+      ELSE
+        WRITE(MONIOU,*) ' NO CHARGE EXCHANGE INTERACTION POSSIBLE '
+      ENDIF
+      IF     ( NFRAGM .EQ. 0 ) THEN
+        WRITE(MONIOU,*)' TOTAL FRAGMENTION OF PRIMARY NUCLEUS IN ',
+     *          'FIRST INTERACTION'
+      ELSEIF ( NFRAGM .EQ. 1 ) THEN
+        WRITE(MONIOU,*) ' NO FRAGMENTATION, NO EVAPORATION OF REMAINDER'
+      ELSEIF ( NFRAGM .EQ. 2 ) THEN
+        WRITE(MONIOU,1504)
+1504    FORMAT('  NO FRAGMENTATION, EVAPORATION OF REMAINDER ',
+     *           ' (PT AFTER JACEE)')
+      ELSEIF ( NFRAGM .EQ. 3 ) THEN
+        WRITE(MONIOU,1505)
+1505    FORMAT('  NO FRAGMENTATION, EVAPORATION OF REMAINDER ',
+     *           ' (PT AFTER GOLDHABER)')
+      ELSE
+        NFRAGM = 4
+        WRITE(MONIOU,1507)
+1507    FORMAT('  NO FRAGMENTATION, EVAPORATION OF REMAINDER ',
+     *           ' (WITH PT = 0.)')
+      ENDIF
+      ENDIF
+      WRITE(MONIOU,*)
+ 
+C  LOW ENERGY HADRONIC INTERACTION MODEL
+      IF ( GHEISH ) THEN
+        WRITE(MONIOU,*) 'GHEISHA TREATS LOW ENERGY HADRONIC ',
+     *                  'INTERACTIONS'
+        CALL CGHINI
+      ELSE
+        WRITE(MONIOU,*) 'ISOBAR ROUTINES TREAT LOW ENERGY HADRONIC ',
+     *                  'INTERACTIONS'
+        HILOELB = 53.D0
+      ENDIF
+ 
+C  WRITE HADRONIC STEERING FLAGS TO RUNHEADER
+      RUNH(270) = NFLAIN
+      RUNH(271) = NFLDIF
+      RUNH(272) = NFLPI0 + 100. * NFLPIF
+      RUNH(273) = NFLCHE + 100. * NFRAGM
+ 
+      EVTH(65)  = NFLAIN
+      EVTH(66)  = NFLDIF
+      EVTH(67)  = NFLPI0
+      EVTH(68)  = NFLPIF
+      EVTH(69)  = NFLCHE
+      EVTH(70)  = NFRAGM
+ 
+      HILOECM = SQRT(2.D0*PAMA(14)*(PAMA(14) + HILOELB))
+      WRITE(MONIOU,*) 'START: HIGH ENERGY INTERACTION MODEL USED ABOVE'
+      WRITE(MONIOU,*)  '     ',HILOELB,' GEV LAB ENERGY   OR'
+      WRITE(MONIOU,*)  '     ',HILOECM,' GEV CM ENERGY'
+ 
+C  INPUT STEERING FLAGS FOR ELECTROMAGNETIC PART
+      WRITE(MONIOU,*)
+      IF ( FNKG ) THEN
+        WRITE(MONIOU,*)'ELECTROMAGNETIC COMPONENT SIMULATED WITH NKG'
+        IF ( ULIMIT .GT. 2.D7 ) THEN
+          WRITE(MONIOU,*)'#############################################'
+          WRITE(MONIOU,*)'#  W A R N I N G  NKG IS WITHOUT LPM EFFECT #'
+          WRITE(MONIOU,*)'#############################################'
+        ENDIF
+        WRITE(MONIOU,*)
+      ENDIF
+      IF ( FEGS ) THEN
+        WRITE(MONIOU,*)'ELECTROMAGNETIC COMPONENT SIMULATED WITH EGS4'
+        WRITE(MONIOU,*)
+      ENDIF
+      IF ( .NOT. (FNKG .OR. FEGS) ) WRITE(MONIOU,*)
+     *              'ELECTROMAGNETIC COMPONENT IS NOT SIMULATED'
+      IF ( FEGS ) THEN
+        IF ( STEPFC .GT. 10.  .OR.  STEPFC .LE. 0. ) THEN
+          WRITE(MONIOU,*)'STEP LENGTH FACTOR FOR ELECTRON MULTIPLE ',
+     *       'SCATTERING =',STEPFC,' NOT CORRECT'
+          WRITE(MONIOU,*)'PLEASE READ THE MANUALS'
+          STOP
+        ENDIF
+        IF ( STEPFC .LT. 10. ) WRITE(MONIOU,*)'STEP LENGTH ',
+     *            'FACTOR FOR ELECTRON MULTIPLE SCATTERING =',STEPFC
+C  INITIALIZE EGS4 PACKAGE
+        CALL EGSINI
+        IF ( ULIMIT .GT. 2.D7 ) THEN
+          WRITE(MONIOU,*)'#############################################'
+          WRITE(MONIOU,*)'#  W A R N I N G  EGS IS WITHOUT LPM EFFECT #'
+          WRITE(MONIOU,*)'#############################################'
+        ENDIF
+      ENDIF
+C  WRITE STEERING FLAGS FOR ELECTROMAGNETIC PART AS REAL TO HEADER
+      IF ( FNKG ) THEN
+        RUNH(20) = 1.
+        EVTH(74) = 1.
+      ELSE
+        RUNH(20) = 0.
+        EVTH(74) = 0.
+      ENDIF
+      IF ( FEGS ) THEN
+        RUNH(19) = 1.
+        EVTH(73) = 1.
+      ELSE
+        RUNH(19) = 0.
+        EVTH(73) = 0.
+      ENDIF
+ 
+      EVTH(95) = STEPFC
+ 
+C  PROGRAM CONFIGURATIONS FOR EVENT HEADER
+      IF ( GHEISH ) THEN
+        EVTH(75) = 1.
+      ELSE
+        EVTH(75) = 0.
+      ENDIF
+      IF ( FVENUS ) THEN
+        EVTH(76) = 1.
+      ELSE
+        EVTH(76) = 0.
+      ENDIF
+      EVTH(139) = 0.
+      EVTH(140) = 0.
+      EVTH(141) = 0.
+      EVTH(142) = 0.
+      EVTH(143) = 0.
+      EVTH(144) = 0.
+      EVTH(145) = 0.
+      EVTH(77) = 1.
+      EVTH(78) = 0.
+      EVTH(79) = 0.
+      EVTH(80) = 3.
+ 
+C-----------------------------------------------------------------------
+C  BEGIN OF TAPE FOR IBM,  FOR TRANSPUTER SEE BEGIN OF EVT
+ 
+C-----------------------------------------------------------------------
+C  PHYSICAL CONSTANTS
+      ENEPER  = EXP(1.D0)
+      C(6)    = ( PAMA(5) / PAMA(11) )**2
+      C(7)    = ( PAMA(5) / PAMA(8) )**2
+      C(8)    = ( PAMA(5)**2 + PAMA(2)**2 ) * 0.5D0 / PAMA(5)
+      C(20)   = 10.D0 * C(21)
+      C(27)   = COS( C(26) )
+      C(29)   = COS( C(28) )
+      C(44)   = MAX( PAMA(8)+C(4), PAMA(14)+C(5) )
+      C(45)   = PAMA(8) * PAMA(14) * 2.D0
+      C(46)   = PAMA(8)**2 + PAMA(14)**2
+      C(48)   = (PAMA(8)**2 + PAMA(5)**2) / (2.D0*PAMA(8)*PAMA(5))
+      C(49)   = SQRT(C(48)**2 - 1.D0) / C(48)
+ 
+      CKA(13) = 2.D0 * PAMA(11) * PAMA(14)
+      CKA(14) = PAMA(11)**2 + PAMA(14)**2
+      CKA(17) = SQRT( ( (PAMA(11)**2 + PAMA(5)**2)
+     *          / (2.D0*PAMA(11)) )**2 - PAMA(5)**2 )
+      CKA(18) = SQRT( ( (PAMA(11)**2 + PAMA(8)**2 - PAMA(7)**2)
+     *          / (2.D0*PAMA(11)) )**2 - PAMA(8)**2 )
+      CKA(22) = MAX( C(5)+PAMA(14), PAMA(11)+C(4) )
+      CKA(28) = SQRT(1.D0 + CKA(17)**2/PAMA(5)**2)
+      CKA(29) = SQRT(1.D0 - 1.D0/CKA(28)**2)
+      CKA(30) = SQRT(1.D0 + CKA(18)**2/PAMA(8)**2)
+      CKA(31) = SQRT(1.D0 - 1.D0/CKA(30)**2)
+      CKA(41) = PAMA(16)
+      CKA(42) = (PAMA(11)**2 + PAMA(7)**2 - PAMA(8)**2) /
+     *          (2.D0*PAMA(11)*PAMA(7))
+      CKA(43) = CKA(41) / (2.D0*PAMA(7))
+      CKA(44) = SQRT(1.D0 - 1.D0/CKA(43)**2)
+      CKA(45) = CKA(41) / (2.D0*PAMA(8))
+      CKA(46) = SQRT(1.D0 - 1.D0/CKA(45)**2)
+ 
+C  SET CONSTANTS FOR MUON BREMSSTRAHLUNG
+      CMUON(3)  =  7.D0**OB3
+      CMUON(6)  =  8.D0**OB3
+      CMUON(9)  = 18.D0**OB3
+      CMUON(1)  = LOG( 189.D0 * PAMA(5) / (CMUON(3)*PAMA(2)) )
+      CMUON(4)  = LOG( 189.D0 * PAMA(5) / (CMUON(6)*PAMA(2)) )
+      CMUON(7)  = LOG( 189.D0 * PAMA(5) / (CMUON(9)*PAMA(2)) )
+     *                   + LOG( TB3/CMUON(9) )
+      SE        = SQRT(EXP(1.D0))
+      CMUON(2)  = 189.D0 * SE*PAMA(5)**2/(2.D0*PAMA(2)*CMUON(3))
+      CMUON(5)  = 189.D0 * SE*PAMA(5)**2/(2.D0*PAMA(2)*CMUON(6))
+      CMUON(8)  = 189.D0 * SE*PAMA(5)**2/(2.D0*PAMA(2)*CMUON(9))
+      CMUON(10) = 0.75D0 * PAMA(5) * SE
+      CMUON(3)  = CMUON(3) * CMUON(10)
+      CMUON(6)  = CMUON(6) * CMUON(10)
+      CMUON(9)  = CMUON(9) * CMUON(10)
+      CMUON(11) = LOG( BCUT/PAMA(5) )
+ 
+      DO  1  I = 1,50
+        CANN(I) = 0.D0
+    1 CONTINUE
+      COAN = 0.D0
+      DO 25  N = 1,12
+        COAN    = COAN + CAN(N)
+        CANN(N) = COAN
+   25 CONTINUE
+      COAN = 0.D0
+      DO 26  N = 13,26
+        COAN    = COAN + CAN(N)
+        CANN(N) = COAN
+   26 CONTINUE
+ 
+C-----------------------------------------------------------------------
+C  INITIALIZE CONSTANTS FOR MUON MULTIPLE SCATTERING (MOLIERE)
+C  SEE SUBROUTINE GMOLI OF GEANT321 (CERN)
+      IF (FMOLI) THEN
+        TEMP1 = COMPOS(1) *  7.D0 *  8.D0 / 14.D0
+        TEMP2 = COMPOS(2) *  8.D0 *  9.D0 / 16.D0
+        TEMP3 = COMPOS(3) * 18.D0 * 19.D0 / 40.D0
+        ZS  = TEMP1 + TEMP2 + TEMP3
+        ZE  = -TB3*(TEMP1*LOG(7.D0) +TEMP2*LOG(8.D0) +TEMP3*LOG(18.D0))
+        ZX  =  TEMP1*LOG(1.D0 + 3.34D0 * ( 7.D0/C(50))**2)
+     *        +TEMP2*LOG(1.D0 + 3.34D0 * ( 8.D0/C(50))**2)
+     *        +TEMP3*LOG(1.D0 + 3.34D0 * (18.D0/C(50))**2)
+C  NOTE: CHC IS DEFINED DIFFERENT FROM GEANT WITHOUT DENSITY
+        CHC = 0.39612D-3 * SQRT(ZS)
+C  NOTE: OMC IS DEFINED DIFFERENT FROM GEANT WITHOUT DENSITY
+        OMC = 6702.33D0 * ZS * EXP( (ZE-ZX)/ZS )
+        EVTH(146) = 1.
+      ELSE
+        EVTH(146) = 0.
+      ENDIF
+ 
+C-----------------------------------------------------------------------
+C  TEST ON INPUT VALUES
+ 
+C  PRINT CONTROL OUTPUT
+      IF ( CC(1)         .GE. CC(2)     .OR.
+     *     CC(2)         .GE. CC(3)     .OR.
+     *     CC(3)         .GE. CC(4)     .OR.
+     *     CC(5)         .GE. CC(6)     .OR.
+     *     CC(6)         .GE. CC(7)     .OR.
+     *     CC(7)         .GE. CC(8)     .OR.
+     *     CC(9)         .GE. CC(10)    .OR.
+     *     CC(10)        .GE. CC(11)    .OR.
+     *     CC(11)        .GE. CC(12)    .OR.
+     *     PAMA(14)+C(3) .GT. CC(1)     .OR.
+     *     PAMA(14)+C(4) .GT. CC(2)     .OR.
+     *     C(4)*2.       .GT. CC(3)     .OR.
+     *     C(3)+PAMA(8)  .GT. CC(5)     .OR.
+     *     C(44)         .GT. CC(6)     .OR.
+     *     C(4)+C(5)     .GT. CC(7)     .OR.
+     *     PAMA(14)+C(4) .GE. C(4)*2.   .OR.
+     *     C(44)         .GE. C(4)+C(5)        ) THEN
+        WRITE(MONIOU,106)
+  106   FORMAT (' ERROR OR INCOMPATIBILITY IN CONSTANTS')
+C  PRINT CONTROL OUTPUT
+        WRITE(MONIOU,103) (C(I),I=1,50)
+  103   FORMAT (//' ',10('='),' CONSTANTS AND PARAMETERS ',43('=')
+     *          //' PHYSICAL CONSTANTS (C)' // (1P,4(E15.8,1X),E15.8) )
+        WRITE(MONIOU,110) (CKA(I),I=1,80)
+  110   FORMAT (//' CONSTANTS FOR KAONS CKA(1) TO CKA(40)'
+     *          // (1P,4(E15.8,1X),E15.8) )
+        WRITE(MONIOU,114) (CETA(I),I=1,5)
+  114   FORMAT (//' CONSTANTS FOR ETAS CETA(1) TO CETA(5)'
+     *          // (1P,4(E15.8,1X),E15.8) )
+        WRITE(MONIOU,115) (CSTRBA(I),I=1,11)
+  115   FORMAT (//' CONSTANTS FOR STRANGE BARYONS CSTRBA(1) TO ',
+     *            'CSTRBA(11)'// (1P,4(E15.8,1X),E15.8) )
+        WRITE(MONIOU,206) (CAN(I),I=1,30)
+  206   FORMAT (//' ANNIHILATION PARAMETERS, SET 1 (CAN)'
+     *          // (1P,4(E15.8,1X),E15.8) )
+        WRITE(MONIOU,209) (CANN(I),I=1,30)
+  209   FORMAT (//' ANNIHILATION PARAMETERS, SET 2 (CANN)'
+     *          // (1P,4(E15.8,1X),E15.8) )
+        WRITE(MONIOU,60) (CC(I),I=1,12)
+   60   FORMAT (//' THRESHOLD ENERGIES OF INTERACTION INTERVALS IN GEV',
+     *          ' (CC)'// (1P,4(E15.8,1X),E15.8) )
+        WRITE(MONIOU,106)
+        STOP
+      ENDIF
+ 
+C  FILL CONSTANTS IN RUN HEADER
+      DO 3001  L = 1,50
+        RUNH(24+L)  = C(L)
+        RUNH(154+L) = CAN(L)
+        RUNH(204+L) = CANN(L)
+ 3001 CONTINUE
+      DO 3002  L = 1,20
+        RUNH(74+L)  = CC(L)
+ 3002 CONTINUE
+      DO 3003  L = 1,40
+        RUNH(94+L)  = CKA(L)
+ 3003 CONTINUE
+      DO 3004  L = 1,5
+        RUNH(134+L)  = CETA(L)
+ 3004 CONTINUE
+      DO 3005  L = 1,11
+        RUNH(139+L)  = CSTRBA(L)
+ 3005 CONTINUE
+      DO 3007  L = 1,5
+        RUNH(254+L) = AATM(L)
+        RUNH(259+L) = BATM(L)
+        RUNH(264+L) = CATM(L)
+        DATM(L)     = 1.D0 / CATM(L)
+ 3007 CONTINUE
+ 
+C  SET LOWER BOUNDARIES OF THE AIR LAYERS
+      HLAY(1)   = 0.D0
+      HLAY(2)   = 4.D5
+      HLAY(3)   = 1.D6
+      HLAY(4)   = 4.D6
+      HLAY(5)   = 1.D7
+C  CALCULATE THICKNESS AT LOWER BOUNDARIES OF AIR LAYERS
+      DO 100 L= 1,5
+        THICKL(L) = THICK(HLAY(L))
+ 100  CONTINUE
+ 
+      CALL STAEND
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/strdec.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/strdec.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/strdec.f	(revision 286)
@@ -0,0 +1,163 @@
+      SUBROUTINE STRDEC
+ 
+C-----------------------------------------------------------------------
+C  STR(ANGE BARYON) DEC(AY)
+C
+C  ROUTINE TREATES DECAY OF STRANGE BARYONS (LAMBDA, SIGMA, XI, OMEGA)
+C  DECAY WITH FULL KINEMATIC, ENERGY AND MOMENTA CONSERVED
+C  THIS SUBROUTINE IS CALLED FORM NUCINT
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,IRET.
+      COMMON /IRET/    IRET1,IRET2
+      INTEGER          IRET1,IRET2
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STRBAR.
+      COMMON /STRBAR/  CSTRBA
+      DOUBLE PRECISION CSTRBA(11)
+*KEND.
+ 
+      INTEGER  I,J
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
+ 444  FORMAT(' STRDEC: CURPAR=',1P,9E10.3)
+ 
+C  COPY COORDINATES INTO SECPAR
+      DO  1  J = 5,8
+        SECPAR(J) = CURPAR(J)
+   1  CONTINUE
+ 
+      IF     ( ITYPE .EQ. 18 ) THEN
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1) .LT. CSTRBA(5) ) THEN
+C  DECAY LAMBDA  --->  P + PI(-)
+          CALL DECAY1( ITYPE, 14, 9 )
+        ELSE
+C  DECAY LAMBDA  --->  N + PI(0)
+          CALL DECAY1( ITYPE, 13, 7 )
+        ENDIF
+ 
+      ELSEIF ( ITYPE .EQ. 19 ) THEN
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1) .LT. CSTRBA(6) ) THEN
+C  DECAY SIGMA(+)  --->  P + PI(0)
+          CALL DECAY1( ITYPE, 14, 7 )
+        ELSE
+C  DECAY SIGMA(+)  --->  N + PI(+)
+          CALL DECAY1( ITYPE, 13, 8 )
+        ENDIF
+ 
+      ELSEIF ( ITYPE .EQ. 20  .OR.  ITYPE .EQ. 28 ) THEN
+C  DECAY      SIGMA(0)  --->       LAMBDA + GAMMA
+C  DECAY ANTI-SIGMA(0)  --->  ANTI-LAMBDA + GAMMA
+        CALL DECAY1( ITYPE, ITYPE-2, 1 )
+ 
+      ELSEIF ( ITYPE .EQ. 21 ) THEN
+C  DECAY SIGMA(-)  --->  N + PI(-)
+        CALL DECAY1( ITYPE, 13, 9 )
+ 
+      ELSEIF ( ITYPE .EQ. 22  .OR.  ITYPE .EQ. 30 ) THEN
+C  DECAY      XI(0)  --->       LAMBDA + PI(0)
+C  DECAY ANTI-XI(0)  --->  ANTI-LAMBDA + PI(0)
+        CALL DECAY1( ITYPE, ITYPE-4, 7 )
+ 
+      ELSEIF ( ITYPE .EQ. 23 ) THEN
+C  DECAY XI(-)  --->  LAMBDA + PI(-)
+        CALL DECAY1( ITYPE, 18, 9 )
+ 
+      ELSEIF ( ITYPE .EQ. 24  .OR.  ITYPE .EQ. 32 ) THEN
+        CALL RMMAR( RD,1,1 )
+        IF     ( RD(1) .LT. CSTRBA(10) ) THEN
+C  DECAY      OMEGA(-)  --->       LAMBDA + K(-)
+C  DECAY ANTI-OMEGA(+)  --->  ANTI-LAMBDA + K(+)
+          CALL DECAY1( ITYPE, ITYPE-6, 15-ITYPE/8 )
+        ELSEIF ( RD(1) .LT. CSTRBA(11) ) THEN
+C  DECAY      OMEGA(-)  --->       XI(0) + PI(-)
+C  DECAY ANTI-OMEGA(+)  --->  ANTI-XI(0) + PI(+)
+          CALL DECAY1( ITYPE, ITYPE-2, 12-ITYPE/8 )
+        ELSE
+C  DECAY      OMEGA(-)  --->       XI(-) + PI(0)
+C  DECAY ANTI-OMEGA(+)  --->  ANTI-XI(+) + PI(0)
+          CALL DECAY1( ITYPE, ITYPE-1, 7 )
+        ENDIF
+ 
+      ELSEIF ( ITYPE .EQ. 26 ) THEN
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1) .LT. CSTRBA(5) ) THEN
+C  DECAY ANTI-LAMBDA  --->  ANTI-P + PI(+)
+          CALL DECAY1( ITYPE, 15, 8 )
+        ELSE
+C  DECAY ANTI-LAMBDA  --->  ANTI-N + PI(0)
+          CALL DECAY1( ITYPE, 25, 7 )
+        ENDIF
+ 
+      ELSEIF ( ITYPE .EQ. 27 ) THEN
+        CALL RMMAR( RD,1,1 )
+        IF ( RD(1) .LT. CSTRBA(6) ) THEN
+C  DECAY ANTI-SIGMA(-)  --->  ANTI-P + PI(0)
+          CALL DECAY1( ITYPE, 15, 7 )
+        ELSE
+C  DECAY ANTI-SIGMA(-)  --->  ANTI-N + PI(-)
+          CALL DECAY1( ITYPE, 25, 9 )
+        ENDIF
+ 
+      ELSEIF ( ITYPE .EQ. 29 ) THEN
+C  DECAY ANTI-SIGMA(+)  --->  ANTI-N + PI(+)
+        CALL DECAY1( ITYPE, 25, 8 )
+ 
+      ELSEIF ( ITYPE .EQ. 31 ) THEN
+C  DECAY ANTI-XI(+)  --->  ANTI-LAMBDA + PI(+)
+        CALL DECAY1( ITYPE, 26, 8 )
+ 
+      ELSE
+        WRITE(MONIOU,*) 'STRDEC: UNFORESEEN PARTICLE CODE =',ITYPE
+      ENDIF
+      IRET1 = 1
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/tarint.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/tarint.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/tarint.f	(revision 286)
@@ -0,0 +1,134 @@
+      SUBROUTINE TARINT
+ 
+C-----------------------------------------------------------------------
+C  TAR(GET) INT(ERACTIONS)
+C
+C  ROUTINE DETERMINES HOW MANY INTERACTIONS OCCUR IN TARGET
+C  THIS SUBROUTINE IS CALLED FROM HDPM
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,DPMFLG.
+      COMMON /DPMFLG/  NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+      INTEGER          NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+*KEEP,GNUPR.
+      COMMON /GNUPR/   SE14,SE16,SE40
+      DOUBLE PRECISION SE14(3,14),SE16(3,16),SE40(3,40)
+*KEEP,INTER.
+      COMMON /INTER/   AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
+     *                 IDIF,ITAR
+      DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
+      INTEGER          IDIF,ITAR
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,REST.
+      COMMON /REST/    CONTNE,TAR,LT
+      DOUBLE PRECISION CONTNE(3),TAR
+      INTEGER          LT
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,SIGM.
+      COMMON /SIGM/    SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+      DOUBLE PRECISION SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'TARINT: ITYPE,TAR,NFLAIN',
+     *                                ITYPE,SNGL(TAR),NFLAIN
+ 
+C  NFLAIN EQUAL 0 : NUMBER OF INTERACTIONS IN TARGET CHOSEN RANDOMLY
+      IF ( NFLAIN .EQ. 0 ) THEN
+C  SIGMA IS ALREADY CALCULATED IN BOX2
+        DELSIG = SIGMA - 45.D0
+        DSIGSQ = DELSIG**2
+ 
+C  CHOOSE RANDOM NUMBER
+        CALL RMMAR( RD,1,1 )
+        IF ( DEBUG ) WRITE(MDEBUG,*)'TARINT: DELSIG,DSIGSQ,RD(1),TAR=',
+     *                      SNGL(DELSIG),SNGL(DSIGSQ),RD(1),SNGL(TAR)
+ 
+C  DO INTERACTION WITH CHOSEN TARGET ( N, O, AR )
+        PROB  = 0.D0
+C  TREAT INTERACTION WITH NITROGEN TARGET
+        IF     ( TAR .EQ. 14.D0 ) THEN
+C  SUM OF PROBABILITIES FOR COLLISION WITH NITROGEN TARGET
+          DO 6151  JL = 1,14
+            PROB = PROB +
+     *             SE14(1,JL) + SE14(2,JL)*DELSIG + SE14(3,JL)*DSIGSQ
+            IF ( RD(1) .LE. PROB ) GOTO 7332
+ 6151     CONTINUE
+ 
+C  TREAT INTERACTION WITH OXYGEN TARGET
+        ELSEIF ( TAR .EQ. 16.D0 ) THEN
+C  SUM OF PROBABILITIES FOR COLLISION WITH OXYGEN TARGET
+          DO 6152  JL = 1,16
+            PROB = PROB +
+     *             SE16(1,JL) + SE16(2,JL)*DELSIG + SE16(3,JL)*DSIGSQ
+            IF ( RD(1) .LE. PROB ) GOTO 7332
+ 6152     CONTINUE
+ 
+C  TREAT INTERACTION WITH ARGON TARGET
+        ELSEIF ( TAR .EQ. 40.D0 ) THEN
+C  SUM OF PROBABILITIES FOR COLLISION WITH ARGON TARGET
+          DO 6153  JL = 1,40
+            PROB = PROB +
+     *             SE40(1,JL) + SE40(2,JL)*DELSIG + SE40(3,JL)*DSIGSQ
+            IF ( RD(1) .LE. PROB ) GOTO 7332
+ 6153     CONTINUE
+        ELSE
+          WRITE(MONIOU,*) 'TARINT: UNKNOWN TARGET = ',SNGL(TAR)
+        ENDIF
+        JL  = 1
+ 
+C  NUMBER OF COLLISIONS IN TARGET
+ 7332   CONTINUE
+        GNU = DBLE(JL)
+ 
+      ELSE
+C  NFLAIN EQUAL 1 : AVERAGE NUMBER OF INTERACTIONS IN TARGET IS TAKEN
+C  NEW PARAMETRIZATION OF J.N.CAPDEVIELLE (MARCH 93)
+        GNU = (0.4826D0 + 3.522D-2 * SLOG) * TAR**0.31D0
+      ENDIF
+      IF ( DEBUG ) WRITE(MDEBUG,*)
+     *          'TARINT: # COLLISIONS IN TARGET=',SNGL(GNU)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/thick.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/thick.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/thick.f	(revision 286)
@@ -0,0 +1,107 @@
+C=======================================================================
+
+      DOUBLE PRECISION FUNCTION THICK( ARG )
+
+C-----------------------------------------------------------------------
+C  THICK(NESS OF ATMOSPHERE)
+C
+C  CALCULATES THICKNESS (G/CM**2) OF ATMOSPHERE DEPENDING ON HEIGHT (CM)
+C  (US STANDARD ATMOSPHERE)
+C  THIS FUNCTION IS CALLED FROM MAIN, BOX2, BOX3, CERENE, CERENH, EGS4,
+C  ELECTR, ININKG, INPRM, NKG, PHOTON, AND START
+C  ARGUMENT:
+C   ARG    = HEIGHT IN CM
+C-----------------------------------------------------------------------
+
+      IMPLICIT NONE
+*KEEP,ATMOS.
+      COMMON /ATMOS/   AATM,BATM,CATM,DATM
+      DOUBLE PRECISION AATM(5),BATM(5),CATM(5),DATM(5)
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c Try
+c------------------------------------------------------------
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+*KEND.
+C*******************************************************************
+C     Modificado por Aitor (5-febrero-98)
+      
+      common /aitor/   aitoth
+      double precision aitoth
+C*******************************************************************
+
+      DOUBLE PRECISION ARG,H,RT
+      PARAMETER (RT=6348.0D5)
+C-----------------------------------------------------------------------
+
+CC    IF ( DEBUG ) WRITE(MDEBUG,*) 'THICK : ARG=',SNGL(ARG)
+
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>> Modification (HZA trick) cancelled >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>> JCG Wed Sep 21 10:49:14 MET DST 1998 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      IF     ( ARG .LT. 4.D5 ) THEN
+        THICK = AATM(1) + BATM(1) * EXP ( -ARG * DATM(1) )
+      ELSEIF ( ARG .LT. 1.D6 ) THEN
+        THICK = AATM(2) + BATM(2) * EXP ( -ARG * DATM(2) )
+      ELSEIF ( ARG .LT. 4.D6 ) THEN
+        THICK = AATM(3) + BATM(3) * EXP ( -ARG * DATM(3) )
+      ELSEIF ( ARG .LT. 1.D7 ) THEN
+        THICK = AATM(4) + BATM(4) * EXP ( -ARG * DATM(4) )
+      ELSE
+        THICK = AATM(5) - ARG * CATM(5)
+      ENDIF
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+cC*******************************************************************
+cC     Modificado por Aitor (5-febrero-98)
+c
+c      H = -RT + SQRT(RT**2 + (ARG/COS(aitoth))**2 +(2.0D0*RT*ARG))
+cC*******************************************************************
+c
+cC      R = SQRT(CURPAR(7)**2+CURPAR(8)**2)
+cC      H = SQRT((RT+ARG)**2+R**2)-RT
+cc      print *,'THICK>>',arg,r,h,curpar(7),curpar(8)
+c
+c      IF     ( H .LT. 4.D5 ) THEN
+c        THICK = AATM(1) + BATM(1) * EXP ( -H * DATM(1) )
+c      ELSEIF ( H .LT. 1.D6 ) THEN
+c        THICK = AATM(2) + BATM(2) * EXP ( -H * DATM(2) )
+c      ELSEIF ( H .LT. 4.D6 ) THEN
+c        THICK = AATM(3) + BATM(3) * EXP ( -H * DATM(3) )
+c      ELSEIF ( H .LT. 1.D7 ) THEN
+c        THICK = AATM(4) + BATM(4) * EXP ( -H * DATM(4) )
+c      ELSE
+c        THICK = AATM(5) - H * CATM(5)
+c      ENDIF
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/tobuf.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/tobuf.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/tobuf.f	(revision 286)
@@ -0,0 +1,99 @@
+      SUBROUTINE TOBUF( A,IFL )
+ 
+C-----------------------------------------------------------------------
+C  (WRITE) TO BUF(FER)
+C
+C  WRITES UP TO NSUBBL DATA BLOCKS TO OUTPUT BUFFER AND PUTS THE FULL
+C  BUFFER TO TAPE
+C  THIS SUBROUTINE IS CALLED FROM MAIN, ELECTR, PHOTON, INPRM, OUTEND,
+C  OUTPUT, OUTPT2, AND PHOTON
+C  ARGUMENTS:
+C   A      = ARRAY TO BE WRITTEN TO TAPE
+C   IFL    = STARTING OF FINAL OUTPUT
+C          = 0  NORMAL BLOCK
+C          = 1  NORMAL BLOCK WITH END OF OUTPUT
+C          = 2  ONLY END OF OUTPUT
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,RECORD.
+      COMMON /RECORD/  IRECOR
+      INTEGER          IRECOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      INTEGER   NSUBBL
+      PARAMETER (NSUBBL=21)
+      REAL      A(*)
+C  NSUBBL IS NUMBER OF SUBBLOCKS IN ONE OUTPUT RECORD
+C  (OUTPUT RECORD LENGTH = NSUBBL * 39 * 7 * 4 BYTES  <= 22932 )
+C  IBLK  IS  COUNTER FOR SUBBLOCKS
+C  OUTPUT BUFFER FOR PARTICLE OUTPUT
+      REAL      OUTBUF(MAXBUF,NSUBBL)
+      INTEGER   I,IBLK,IFL,K
+      SAVE      OUTBUF
+      DATA      IBLK / 0 /
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'TOBUF : IFL =',IFL
+ 
+ 
+C  COPY TO BUFFER
+      IF ( IFL .LE. 1 ) THEN
+        IBLK = IBLK + 1
+        DO  1  I = 1,MAXBUF
+          OUTBUF(I,IBLK) = A(I)
+ 1      CONTINUE
+      ENDIF
+ 
+C  WRITE TO TAPE IF BLOCK IS FULL OR IF IFL IS 1
+      IF ( IFL .GE. 1  .OR.  IBLK .EQ. NSUBBL ) THEN
+        NRECS = NRECS + 1
+        NBLKS = NBLKS + IBLK
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+c        WRITE(PATAPE)           ((OUTBUF(I,K),I=1,MAXBUF),K=1,NSUBBL)
+        call jcdatsave(outbuf)
+c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+        IRECOR = IRECOR + MAXBUF * NSUBBL
+        IBLK   = 0
+        DO  2  K = 1,NSUBBL
+        DO  2  I = 1,MAXBUF
+          OUTBUF(I,K) = 0.0
+ 2      CONTINUE
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/tstack.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/tstack.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/tstack.f	(revision 286)
@@ -0,0 +1,107 @@
+      SUBROUTINE TSTACK
+ 
+C-----------------------------------------------------------------------
+C  T(O) STACK
+C
+C  ADDS PARTICLE TO INTERMEDIATE STACK UNTIL REACTION IS FINISHED
+C  THIS SUBROUTINE IS CALLED FROM MANY POINTS ALL OVER THE PROGRAM
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEEP,ETHMAP.
+      COMMON /ETHMAP/  ECTMAP,ELEFT
+      DOUBLE PRECISION ECTMAP,ELEFT
+*KEEP,MUPART.
+      COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
+      DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
+      LOGICAL          FMUBRM,FMUORG
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKF.
+      COMMON /STACKF/  STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+      INTEGER          MAXSTK
+      PARAMETER        (MAXSTK = 12*340*2)
+      DOUBLE PRECISION STACK(MAXSTK)
+      INTEGER          STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+*KEEP,THNVAR.
+      COMMON /THNVAR/  STACKINT,INT_ICOUNT,THINNING
+      INTEGER          MAXICOUNT
+      PARAMETER        (MAXICOUNT=20000)
+      DOUBLE PRECISION STACKINT(MAXICOUNT,13)
+      INTEGER          INT_ICOUNT
+      LOGICAL          THINNING
+*KEND.
+ 
+      INTEGER I,J
+C-----------------------------------------------------------------------
+ 
+      INT_ICOUNT = INT_ICOUNT + 1
+      IF ( DEBUG ) WRITE(MDEBUG,1) INT_ICOUNT,(SECPAR(J),J=1,9)
+ 1    FORMAT(' TSTACK:',I7,1X,1P,9E10.3)
+ 
+      IF ( INT_ICOUNT .GT. MAXICOUNT ) THEN
+        WRITE(MONIOU,10) MAXICOUNT
+ 10     FORMAT(' TSTACK: TOO MANY SECONDARIES FOR THIS REACTION',
+     *     '  EXCEEDED ',I7,'   A T T E N T I O N  PARTICLE IS LOST')
+        INT_ICOUNT = INT_ICOUNT - 1
+        RETURN
+      ENDIF
+ 
+      DO I=1,MAXLEN
+        STACKINT(INT_ICOUNT,I) = SECPAR(I)
+      ENDDO
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/tstend.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/tstend.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/tstend.f	(revision 286)
@@ -0,0 +1,108 @@
+      SUBROUTINE TSTEND
+ 
+C-----------------------------------------------------------------------
+C  T(O) STACK END (OF REACTION)
+C
+C  MOVE INTERMEDIATE REACTION STACK TO THE REAL STACK
+C  THIS SUBROUTINE IS CALLED FROM AAMAIN, BOX3, AND PIGEN
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RESON.
+      COMMON /RESON/   RDRES,RESRAN,IRESPAR
+      REAL             RDRES(2),RESRAN(1000)
+      INTEGER          IRESPAR
+ 
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKF.
+      COMMON /STACKF/  STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+      INTEGER          MAXSTK
+      PARAMETER        (MAXSTK = 12*340*2)
+      DOUBLE PRECISION STACK(MAXSTK)
+      INTEGER          STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+*KEEP,THNVAR.
+      COMMON /THNVAR/  STACKINT,INT_ICOUNT,THINNING
+      INTEGER          MAXICOUNT
+      PARAMETER        (MAXICOUNT=20000)
+      DOUBLE PRECISION STACKINT(MAXICOUNT,13)
+      INTEGER          INT_ICOUNT
+      LOGICAL          THINNING
+*KEND.
+ 
+      DOUBLE PRECISION EEE,EEPP,ETOTA,ETOTAL
+      INTEGER          I,K
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,1) INT_ICOUNT,THINNING
+ 1    FORMAT(' TSTEND: TRANSFER INTERNAL REACTION STACK',
+     *       ' WITH ',I6,' PARTICLES:  ', ' THINNING =',L4)
+ 
+      IF ( INT_ICOUNT .LE. 0 ) RETURN
+ 
+C  PUT ALL PARTICLES FROM INTERMEDIATE STACK TO REAL STACK
+      DO K=1,INT_ICOUNT
+        DO I=1,MAXLEN
+          SECPAR(I) = STACKINT(K,I)
+          STACKINT(K,I) = 0.D0
+        ENDDO
+        CALL TSTOUT
+      ENDDO
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/tstini.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/tstini.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/tstini.f	(revision 286)
@@ -0,0 +1,86 @@
+      SUBROUTINE TSTINI
+ 
+C-----------------------------------------------------------------------
+C  T(O INTERMEDIATE) ST(ACK) INI(TIALIZATION)
+C
+C  INITIALIZE THE INTERMEDIATE STACK FOR A SINGLE REACTION
+C  THIS SUBROUTINE IS CALLED FROM AAMAIN, BOX3, AND PIGEN
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,REJECT.
+      COMMON /REJECT/  AVNREJ,
+     *                 ALTMIN,ANEXP,THICKA,THICKD,CUTLN,EONCUT,
+     *                 FNPRIM
+      DOUBLE PRECISION AVNREJ(10)
+      REAL             ALTMIN(10),ANEXP(10),THICKA(10),THICKD(10),
+     *                 CUTLN,EONCUT
+      LOGICAL          FNPRIM
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKF.
+      COMMON /STACKF/  STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+      INTEGER          MAXSTK
+      PARAMETER        (MAXSTK = 12*340*2)
+      DOUBLE PRECISION STACK(MAXSTK)
+      INTEGER          STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+*KEEP,THNVAR.
+      COMMON /THNVAR/  STACKINT,INT_ICOUNT,THINNING
+      INTEGER          MAXICOUNT
+      PARAMETER        (MAXICOUNT=20000)
+      DOUBLE PRECISION STACKINT(MAXICOUNT,13)
+      INTEGER          INT_ICOUNT
+      LOGICAL          THINNING
+*KEND.
+ 
+      DOUBLE PRECISION EEPP
+      INTEGER          I,J
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,1)
+ 1    FORMAT(' TSTINI: RESET INTERNAL REACTION STACK')
+ 
+      INT_ICOUNT = 0
+ 
+      THINNING = .FALSE.
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/tstout.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/tstout.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/tstout.f	(revision 286)
@@ -0,0 +1,136 @@
+      SUBROUTINE TSTOUT
+ 
+C-----------------------------------------------------------------------
+C  T(O) ST(ACK) OUT
+C
+C  MAKE REAL OUTPUT AFTER ONE INTERACTION HAS FINISHED
+C  ADDS PARTICLE TO STACK AND WRITES IT TO DISK IF NECESSARY
+C  THIS SUBROUTINE IS CALLED FORM MPPROP, PIGEN1, PIGEN2, AND TSTEND
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,BUFFS.
+      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
+      INTEGER          MAXBUF,MAXLEN
+      PARAMETER        (MAXBUF=39*7)
+      PARAMETER        (MAXLEN=12)
+      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
+     *                 RUNE(MAXBUF),DATAB(MAXBUF)
+      INTEGER          LH
+      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
+      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
+      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEEP,ETHMAP.
+      COMMON /ETHMAP/  ECTMAP,ELEFT
+      DOUBLE PRECISION ECTMAP,ELEFT
+*KEEP,MUPART.
+      COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
+      DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
+      LOGICAL          FMUBRM,FMUORG
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKF.
+      COMMON /STACKF/  STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+      INTEGER          MAXSTK
+      PARAMETER        (MAXSTK = 12*340*2)
+      DOUBLE PRECISION STACK(MAXSTK)
+      INTEGER          STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
+*KEND.
+ 
+      DOUBLE PRECISION GLCUT
+      INTEGER          I,ISTK,J
+      DATA             ISTK / MAXSTK /
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,666) ICOUNT,(SECPAR(J),J=1,9)
+ 666  FORMAT(' TSTOUT:',I7,1X,1P,9E10.3)
+ 
+C  CALCULATE APPROPRIATE KINETIC ENERGY CUT AND APPLY IT
+      IF     ( SECPAR(1) .EQ. 5.D0 .OR. SECPAR(1) .EQ. 6.D0 ) THEN
+C  MUONS
+        GLCUT = ELCUT(2) / PAMA(NINT(SECPAR(1))) + 1.D0
+      ELSEIF ( SECPAR(1) .EQ. 2.D0 .OR. SECPAR(1) .EQ. 3.D0 ) THEN
+C  ELECTRONS
+        GLCUT = ELCUT(3) / PAMA(NINT(SECPAR(1))) + 1.D0
+      ELSEIF ( SECPAR(1) .EQ. 1.D0 ) THEN
+C  GAMMAS
+        GLCUT = ELCUT(4)
+      ELSEIF (SECPAR(1) .GE. 100.D0 ) THEN
+C  NUCLEI, CUTTED IF ENERGY/NUCLEON BELOW CUT
+        GLCUT = ELCUT(1) * INT(SECPAR(1)/100 )
+     *                   / PAMA(NINT(SECPAR(1))) + 1.D0
+      ELSE
+C  HADRONS
+        GLCUT = ELCUT(1) / PAMA(NINT(SECPAR(1))) + 1.D0
+      ENDIF
+      IF ( SECPAR(2) .LT. GLCUT ) THEN
+        IF ( SECPAR(1).EQ.5.D0 .OR. SECPAR(1).EQ.6.D0 ) FMUORG = .FALSE.
+        IF (DEBUG) WRITE(MDEBUG,*) 'TSTOUT: PARTICLE BELOW ',
+     *     'ENERGY CUT'
+        RETURN
+      ENDIF
+ 
+      IF ( STACKP .GE. ISTK ) THEN
+        WRITE(EXST,REC=NOUREC+1) (STACK(I),I=       1,ISTK/2)
+        WRITE(EXST,REC=NOUREC+2) (STACK(I),I=ISTK/2+1,ISTK )
+        NOUREC = NOUREC + 2
+        NSHIFT = NSHIFT + 2
+        STACKP = 0
+      ENDIF
+ 
+      NTO    = NTO + 1
+      ICOUNT = ICOUNT + 1
+ 
+      DO  2  J = 1,MAXLEN
+        STACK(STACKP+J) = SECPAR(J)
+ 2    CONTINUE
+      STACKP = STACKP + MAXLEN
+      IF ( SECPAR(1) .LE.  1.D0 ) THEN
+        ELEFT  = ELEFT + SECPAR(2)
+      ELSE
+        ELEFT  = ELEFT + SECPAR(2) * PAMA(NINT(SECPAR(1)))
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/ucopy.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/ucopy.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/ucopy.f	(revision 286)
@@ -0,0 +1,16 @@
+      SUBROUTINE UCOPY (A,B,N)
+ 
+C-----------------------------------------------------------------------
+C CERN PROGLIB# V301    UCOPY           .VERSION KERNFOR  1.0   710701
+C ORIG. 01/01/65 JZ
+C-----------------------------------------------------------------------
+ 
+      DIMENSION A(*),B(*)
+C-----------------------------------------------------------------------
+ 
+C                  NO OVERLAP  OR  BEGINNING OF A ON END OF B
+      IF (N.EQ.0) RETURN
+         DO 21 I=1,N
+   21 B(I)=A(I)
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/update.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/update.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/update.f	(revision 286)
@@ -0,0 +1,460 @@
+      SUBROUTINE UPDATE( HNEW,THCKHN,IPAS )
+ 
+C-----------------------------------------------------------------------
+C  UPDATE(S PARTICLE PARAMETERS)
+C
+C  UPDATES PARTICLE PARAMETERS TO OBSERVATION LEVEL WITH NUMBER IPAS
+C                           OR TO POINT OF INTERACTION OR DECAY (IPAS=0)
+C  FOR CHARGED PARTICLES THE ENERGY LOSS IS COMPUTED FOR THE WHOLE STEP,
+C  SUBDIVIDED BY THE BOUNDARIES OF THE ATMOSPHERIC LAYERS.
+C  THE PARTICLE IS FLYING THE 1ST HALF (DH/2) WITH INITIAL ENERGY
+C  AND ANGLE AND THE 2ND HALF WITH FINAL ENERGY AND ANGLE.
+C  THE TIME CALCULATION FOLLOWS THIS SIMPLIFICATION.
+C  CHARGED PARTICLES ARE DEFLECTED IN THE EARTH MAGNETIC FIELD.
+C  THE ANGLE OF DEFLECTION BY MULTIPLE SCATTERING IS COMPUTED ONLY
+C  FOR MUONS AND ONLY ONCE FOR THE WHOLE STEP.
+C  IF PARTICLES COME TO REST BY STOPPING, THEIR PATH TO THE STOPPING
+C  POINT IS CALCULATED.
+C  CERENKOV RADIATION IS CALCULATED ONLY FOR LOWEST OBSERVATION LEVEL
+C  THIS SUBROUTINE IS CALLED FROM MAIN, BOX3, AND MUTRAC
+C  ARGUMENTS:
+C   HNEW   = ALTITUDE OF PARTICLE AFTER UPDATE
+C   THCKHN = THICKNESS OF HNEW
+C   IPAS   = 0  TRANSPORT TO END OF RANGE OF PARTICLE
+C       .NE. 0  TRANSPORT TO PASSAGE OF OBSERVATION LEVEL IPAS
+C
+C  REDESIGN: D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,ATMOS2.
+      COMMON /ATMOS2/  HLAY,THICKL
+      DOUBLE PRECISION HLAY(5),THICKL(5)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,ELABCT.
+      COMMON /ELABCT/  ELCUT
+      DOUBLE PRECISION ELCUT(4)
+*KEEP,GENER.
+      COMMON /GENER/   GEN,ALEVEL
+      DOUBLE PRECISION GEN,ALEVEL
+*KEEP,IRET.
+      COMMON /IRET/    IRET1,IRET2
+      INTEGER          IRET1,IRET2
+*KEEP,MAGNET.
+      COMMON /MAGNET/  BX,BZ,BVAL,BNORMC,BNORM,COSB,SINB,BLIMIT
+      DOUBLE PRECISION BX,BZ,BVAL,BNORMC
+      REAL             BNORM,COSB,SINB,BLIMIT
+*KEEP,MUMULT.
+      COMMON /MUMULT/  CHC,OMC,FMOLI
+      DOUBLE PRECISION CHC,OMC
+      LOGICAL          FMOLI
+*KEEP,OBSPAR.
+      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
+     *                 THETPR,PHIPR,NOBSLV
+      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
+     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
+      INTEGER          NOBSLV
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,CERHDR.
+      COMMON/CERHDR/   TPART,UPART,VPART,WPART,XPART,YPART,ZPART
+      DOUBLE PRECISION TPART,UPART,VPART,WPART,XPART,YPART,ZPART
+*KEND.
+ 
+      DOUBLE PRECISION ALPHA1,ALPHA2,BETAN,DENS,DH,DR,DTHICK,ELOSS,
+     *                 FNORM1,FNORM2,F1COS1,F1COS2,F1SIN1,F1SIN2,
+     *                 GAMMAN,GAMSQ,GLCUT,GMSQM1,GAM0,HMIDDL,HNEW,OMEGA,
+     *                 PHISCT,PHI1,RADINV,RANNOR,RHOF,
+     *                 SINTH1,SINTH2,SN,SN1,SN2,SN3,SN4,
+     *                 THCKHN,TH0,U10,U12,U20,U22,V,VSCAT,VVV,
+     *                 V10,V12,V20,V22,W10,W12,W20,W22
+      INTEGER          I,IL,ILAY,IPAS
+      LOGICAL          MUS
+      SAVE             VSCAT,PHISCT
+      EXTERNAL         RANNOR,RHOF
+      DOUBLE PRECISION CHIT,DT,GAMK,HEIGH,HNEWC,RATIO,THCKHC
+      INTEGER          ICRNKV
+      LOGICAL          TFLAG
+      EXTERNAL         HEIGH
+C-----------------------------------------------------------------------
+ 
+      IF (DEBUG) WRITE(MDEBUG,457) (CURPAR(I),I=1,9),HNEW
+  457 FORMAT(' UPDATE: CURPAR=',1P,9E10.3/
+     *       '         TO HEIGHT ',0P,F11.1)
+ 
+      IRET2  = 1
+C  TOTAL HEIGHT DIFFERENCE
+      DH     = MAX( H - HNEW, 1.D-10 )
+C  ATMOSPHERE THICKNESS TRAVERSED
+      DTHICK = (THCKHN - THICKH) / COSTHE
+C  TOTAL PATH FOR UNDEFLECTED PARTICLE
+      SN     = DH / COSTHE
+      SN1    = 0.25D0 * SN
+ 
+ 
+C  CALCULATE KINETIC ENERGY CUT
+      IF ( ITYPE .EQ. 5 .OR. ITYPE .EQ. 6 ) THEN
+        MUS   = .TRUE.
+        GLCUT = ELCUT(2) / PAMA(ITYPE) + 1.D0
+      ELSE
+        MUS   = .FALSE.
+        GLCUT = ELCUT(1) / PAMA(ITYPE) + 1.D0
+      ENDIF
+ 
+C  CALCULATE THE ENERGY LOSS FOR CHARGED PARTICLES
+      IF ( SIGNUM(ITYPE) .NE. 0.D0 ) THEN
+C  LOOK WITHIN WHICH LAYER THE PARTICLE STARTS
+        IF     ( H .LE. HLAY(2) ) THEN
+          ILAY = 1
+          TH0  = THICKH
+        ELSEIF ( H .LE. HLAY(3) ) THEN
+          ILAY = 2
+          TH0  = THICKH
+        ELSEIF ( H .LE. HLAY(4) ) THEN
+          ILAY = 3
+          TH0  = THICKH
+        ELSE
+          ILAY = 4
+          TH0    = MAX( THICKH, 2.D-4 )
+        ENDIF
+C  SET START VALUES FOR ITERATION
+        GAM0   = GAMMA
+        IL     = ILAY
+ 1      CONTINUE
+        GAM0   = MAX( GAM0, 1.0001D0 )
+        GAMSQ  = GAM0**2
+        GMSQM1 = GAMSQ - 1.D0
+C  ENERGY LOSS BY IONIZATION
+        ELOSS  = SIGNUM(ITYPE)**2 * C(22) *
+     *              ( GAMSQ * (LOG(GMSQM1) + C(23)) / GMSQM1 - 1.D0 )
+C  LOOK WETHER PARTICLE PENETRATES LAYER BOUNDARY
+        IF ( THICKL(IL) .LT. THCKHN  .AND.  IL .GT. 1 ) THEN
+C  CALCULATE NEW START VALUES AT LAYER BOUNDARY
+          GAM0 = GAM0 - ELOSS * (THICKL(IL) - TH0)
+     *                              / (PAMA(ITYPE)*COSTHE)
+          IF ( GAM0 .LE. 1.D0 ) THEN
+            GAMMAN = 1.0001D0
+            GOTO 3
+          ENDIF
+          TH0  = THICKL(IL)
+          IL   = IL - 1
+          GOTO 1
+        ENDIF
+C  GAMMA VALUE FOR CHARGED PARTICLES AT END OF STEP
+        GAMMAN = GAM0 - ELOSS * (THCKHN-TH0) / (PAMA(ITYPE)*COSTHE)
+ 3      CONTINUE
+ 
+      ELSE
+C  NO LOSS FOR NEUTRAL PARTICLES
+        GAMMAN = GAMMA
+      ENDIF
+ 
+C  PARTICLE HAS TO BE TRACKED TO THE CUTOFF ENERGY FOR CERENKOV PHOTONS
+C  (AS NEUTRAL DO NOT LOOSE ENERGY IN UPDATE, THIS CONDITION IS
+C  FULFILLED BY CHARGED PARTICLES ONLY)
+C  (AS CERENKOV RUNS NOT WITH HORIZONT, NO PROGRAMMING FOR HORIZONT)
+      IF ( GAMMAN .LT. GLCUT ) THEN
+        GAMMAN = 0.9D0 + GLCUT * 0.1D0
+ 
+C  SET START VALUES FOR ITERATION
+        IL     = ILAY
+        CHIT   = 0.D0
+        GAM0   = GAMMA
+        TH0    = MAX( THICKH, 2.D-4 )
+ 2      CONTINUE
+        GAM0   = MAX( GAM0, 1.0001D0 )
+        GAMSQ  = GAM0**2
+        GMSQM1 = GAMSQ - 1.D0
+C  ENERGY LOSS BY IONIZATION
+        ELOSS  = SIGNUM(ITYPE)**2 * C(22) *
+     *             ( GAMSQ * (LOG(GMSQM1) + C(23)) / GMSQM1 -1.D0 )
+        ELOSS  =  ELOSS / (PAMA(ITYPE) * COSTHE)
+        GAMK   = GAM0 - ELOSS * (THICKL(ILAY) - TH0)
+C  LOOK WETHER PARTICLE PENETRATES LAYER BOUNDARY
+        IF (GAMMAN .LT. GAMK .AND. IL. GT. 1 ) THEN
+C  CALCULATE PORTION OF RANGE AND NEW START VALUES AT LAYER BOUNDARY
+          CHIT = CHIT + (THICKL(IL) - TH0) / COSTHE
+          GAM0 = GAMK
+          TH0  = THICKL(IL)
+          IL   = IL - 1
+          GOTO 2
+        ENDIF
+C  PENETRATED MATTER THICKNESS
+        CHI    = CHIT + (GAM0 - GAMMAN) / (ELOSS*COSTHE)
+        IF ( DEBUG ) WRITE(MDEBUG,*)'UPDATE: GAMMAN,CHI=',
+     *                                  SNGL(GAMMAN),SNGL(CHI)
+C  CALCULATE CORRECTED PATH PARAMETERS
+        THCKHC = THICKH + COSTHE * CHI
+        HNEWC  = HEIGH(THCKHC)
+        DT     = SN / (C(25) * BETA * GAMMA)
+        RATIO  = .5D0 * (H-HNEWC) / DH
+        DH     = H - HNEWC
+        SN     = DH / COSTHE
+        SN1    = 0.25D0 * SN
+        TFLAG  = .TRUE.
+      ELSE
+        TFLAG  = .FALSE.
+      ENDIF
+ 
+C-----------------------------------------------------------------------
+      IF ( IPAS .EQ. 0 ) THEN
+C  UPDATE TO THE END POINT OF THE TRACK
+ 
+        IF ( MUS ) THEN
+C  COULOMB SCATTERING ANGLE (FOR MUONS ONLY)
+          IF ( FMOLI) THEN
+C  TREAT MUON MULTIPLE SCATTERING BY MOLIERE THEORY (SEE GEANT)
+C  CALCULATE AVERAGE DENSITY AND NUMBER OF SCATTERING (OMEGA)
+            DENS   = CHI/DH * COSTHE
+            OMEGA  = OMC * CHI /  BETA**2
+            IF ( OMEGA .LE. 20.D0 ) THEN
+C  FEW SCATTERING EVENTS, APPLY PLURAL COULOMB SCATTERING
+              CALL MUCOUL(OMEGA,DENS,VSCAT)
+            ELSE
+C  ENOUGH SCATTERING EVENTS, APPLY MOLIERE'S THEORY
+              CALL MMOLIE(OMEGA,DENS,VSCAT)
+            ENDIF
+          ELSE
+C  TREAT MUON MULTIPLE SCATTERING BY GAUSS DISTRIBUTION
+            VSCAT = RANNOR( 0.D0, C(30) * SQRT( CHI/C(21) )
+     *                          / (PAMA(5) * GAMMA * BETA**2) )
+          ENDIF
+          V = VSCAT
+          CALL RMMAR( RD,1,1 )
+          PHISCT = RD(1) * PI2
+          IF(DEBUG)WRITE(MDEBUG,*)'UPDATE: VSCAT=',SNGL(VSCAT),
+     *                                  ' PHISCT=',SNGL(PHISCT)
+        ENDIF
+ 
+C  CERENKOV RADIATION: LOOK, WHETHER PATH ENDS ABOVE LOWEST OBSERV.LEVEL
+        IF ( TFLAG ) THEN
+          HNEW   = HNEWC
+          THCKHN = THCKHC
+          IF (DEBUG) WRITE(MDEBUG,*)'UPDATE: CHANGED HNEW =',SNGL(HNEW)
+        ENDIF
+        IF ( HNEW .GT. OBSLEV(NOBSLV) ) THEN
+          ICRNKV = 1
+        ELSE
+          ICRNKV = 0
+        ENDIF
+ 
+C  UPDATE TO THE OBSERVATION LEVELS
+      ELSE
+        IF ( MUS ) THEN
+C  COULOMB SCATTERING ANGLE (FOR MUONS ONLY)
+          V = VSCAT * SQRT( DTHICK / CHI )
+        ENDIF
+ 
+C  CERENKOV RADIATION: LOOK, WHETHER LOWEST OBSERVATION LEVEL
+        IF ( IPAS .EQ. NOBSLV ) THEN
+          ICRNKV = 1
+        ELSE
+          ICRNKV = 0
+        ENDIF
+      ENDIF
+ 
+C  REJECT ALL PARTICLES IF BELOW KINETIC ENERGY CUT
+      IF ( GAMMAN .LT. GLCUT .AND. ICRNKV .EQ. 0 ) THEN
+        IF (DEBUG)
+     *    WRITE(MDEBUG,*) 'UPDATE: PARTICLE ',ITYPE,' BELOW ENERGY CUT'
+     *                   ,' CERENKOV LIGHT NOT CALCULATED'
+        RETURN
+      ENDIF
+ 
+C-----------------------------------------------------------------------
+C  CHARGED PARTICLES SUFFER IONIZATION LOSS, DEFLECTION IN MAGNETIC
+C  FIELD AND MUONS IN ADDITION DO MULTIPLE COULOMB SCATTERING
+ 
+      IF ( SIGNUM(ITYPE) .NE. 0.D0 ) THEN
+C  DEFLECTION IN EARTH MAGNETIC FIELD ON FIRST HALF OF STEP
+        ALPHA1 = SIGNUM(ITYPE) *
+     *         MIN( 1.D0, 2.D0*SN1*BNORMC /(PAMA(ITYPE)*BETA*GAMMA) )
+        SINTH1 = SQRT( 1.D0 - COSTHE**2 )
+        U10    = SINTH1 * COS(-PHI)
+        V10    = SINTH1 * SIN(-PHI)
+        W10    = COSTHE
+        FNORM1 = 1.D0 - 0.5D0*ALPHA1**2 * (1.D0 - 0.75D0*ALPHA1**2)
+        F1COS1 = ( 1.D0 - FNORM1 ) * COSB
+        F1SIN1 = ( 1.D0 - FNORM1 ) * SINB
+        VVV = V10 * ALPHA1 * FNORM1
+        U12 = U10 * (1.D0 - F1SIN1*SINB) + W10*F1SIN1*COSB + VVV*SINB
+        V12 = FNORM1 * ( V10 - ALPHA1 * (U10 * SINB - W10 * COSB) )
+        W12 = W10 * (1.D0 - F1COS1*COSB) + U10*F1COS1*SINB - VVV*COSB
+        RADINV = 1.5D0 - 0.5D0 * ( U12**2 + V12**2 + W12**2 )
+        W12 = MIN( 1.D0, RADINV * W12 )
+        IF ( W12 .LE. C(29) ) THEN
+          IF (DEBUG)
+     *    WRITE(MDEBUG,*) 'UPDATE: PARTICLE ',ITYPE,' BELOW ANGLE CUT 1'
+          RETURN
+        ENDIF
+        SN2 = 0.25D0 * DH / W12
+        U12 = RADINV * U12
+        V12 = RADINV * V12
+        IF ( U12**2 + V12**2 .GT. 3.D-38 ) THEN
+          PHI1 = -ATAN2( V12, U12 )
+        ELSE
+          PHI1 = 0.D0
+        ENDIF
+C  CERENKOV RADIATION: FILL PARTICLE COORDINATES INTO COMMON CERHDR
+        IF ( ICRNKV .EQ. 1 ) THEN
+          XPART = X + SN1 * U10 + SN2 * U12
+          YPART = Y - SN1 * V10 - SN2 * V12
+          TPART = T + ( SN1 + SN2 ) / ( C(25) * BETA )
+          ZPART = H - DH * 0.5D0
+          WPART = W12
+          UPART = U12
+          VPART = -V12
+          CALL CERENH( SN1+SN2, BETA )
+        ENDIF
+ 
+C  CHANGE DIRECTION BY COULOMB SCATTERING (FOR MUONS ONLY)
+C  BEFORE SCATTERING : DIRECTION COSINES ARE U12,V12,W12
+C  AFTER  SCATTERING : DIRECTION COSINES ARE U20,V20,W20
+        IF ( MUS ) THEN
+          CALL ADDANG( W12,PHI1, COS(V),PHISCT, W20,PHI1 )
+          IF ( W20 .LT. C(29) ) THEN
+            IF (DEBUG) WRITE(MDEBUG,*) 'UPDATE: MUON BELOW ANGLE CUT'
+            RETURN
+          ENDIF
+          SINTH2 = SQRT( 1.D0 - W20**2 )
+          U20    = SINTH2 * COS( -PHI1 )
+          V20    = SINTH2 * SIN( -PHI1 )
+        ELSE
+          U20    = U12
+          V20    = V12
+          W20    = W12
+        ENDIF
+ 
+C  NEW PATH LENGTH, NEW BETA VALUE BECAUSE OF IONIZATION ENERGY LOSS
+        SN3    = 0.25D0 * DH / W20
+        BETAN  = SQRT( GAMMAN**2 - 1.D0 ) / GAMMAN
+C  DEFLECTION IN EARTH MAGNETIC FIELD ON SECOND HALF OF STEP
+        ALPHA2 = SIGNUM(ITYPE) *
+     *           MIN(1.D0,2.D0*SN3*BNORMC / (PAMA(ITYPE)*BETAN*GAMMAN))
+        FNORM2 = 1.D0 - 0.5D0*ALPHA2**2 * (1.D0 - 0.75D0*ALPHA2**2)
+        F1SIN2 = ( 1.D0 - FNORM2 ) * SINB
+        F1COS2 = ( 1.D0 - FNORM2 ) * COSB
+        VVV = V20 * ALPHA2 * FNORM2
+        U22 = U20*(1.D0 - F1SIN2*SINB) + W20*F1SIN2*COSB + VVV*SINB
+        V22 = FNORM2 * ( V20 - ALPHA2 * (U20 * SINB - W20 * COSB) )
+        W22 = W20*(1.D0 - F1COS2*COSB) + U20*F1COS2*SINB - VVV*COSB
+        RADINV = 1.5D0 - 0.5D0 * ( U22**2 + V22**2 + W22**2 )
+        W22 = MIN( 1.D0, RADINV * W22 )
+        IF ( W22 .LT. C(29) ) THEN
+          IF (DEBUG)
+     *    WRITE(MDEBUG,*) 'UPDATE: PARTICLE ',ITYPE,' BELOW ANGLE CUT 2'
+          RETURN
+        ENDIF
+        SN4 = 0.25D0 * DH / W22
+        U22 = RADINV * U22
+        V22 = RADINV * V22
+        OUTPAR(3) = W22
+        IF ( U22**2 + V22**2 .GT. 3.D-38 ) THEN
+          OUTPAR(4) = -ATAN2( V22, U22 )
+        ELSE
+          OUTPAR(4) = 0.D0
+        ENDIF
+C  UPDATE COORDINATES AND TIME TO THE END OF DISTANCE
+        IF ( TFLAG ) THEN
+          OUTPAR(6) = T + DT* ( RATIO*GAMMA + (1.D0-RATIO)*GAMMAN)
+        ELSE
+          OUTPAR(6) = T + (SN1 + SN2)/(BETA *C(25)) +
+     *                    (SN3 + SN4)/(BETAN*C(25))
+        ENDIF
+        OUTPAR(7) = X + SN1*U10 + SN2*U12 + SN3*U20 + SN4*U22
+        OUTPAR(8) = Y - SN1*V10 - SN2*V12 - SN3*V20 - SN4*V22
+C  CERENKOV RADIATION: FILL PARTICLE COORDINATES INTO COMMON CERHDR
+        IF ( ICRNKV .EQ. 1 ) THEN
+          XPART = OUTPAR(7)
+          YPART = OUTPAR(8)
+          ZPART = HNEW
+          TPART = OUTPAR(6)
+          WPART = W22
+          UPART = U22
+          VPART = -V22
+          CALL CERENH( SN3+SN4, BETAN )
+C  REJECT PARTICLES AFTER PRODUCTION OF CERENKOV LIGHT
+          IF ( GAMMAN .LT. GLCUT ) THEN
+            IF (DEBUG) WRITE(MDEBUG,*) 'UPDATE: PARTICLE ',ITYPE,
+     *           ' BELOW ENERGY CUT AFTER CREATION OF CERENKOV LIGHT'
+            RETURN
+          ENDIF
+        ENDIF
+      ELSE
+ 
+C-----------------------------------------------------------------------
+C  NEUTRAL PARTICLES
+C  NO COULOMB SCATTERING, NO DEFLECTION IN MAGNETIC FIELD
+ 
+C  HORIZONTAL PATH LENGTH
+        DR        = SN * SQRT( 1.D0 - COSTHE**2 )
+C  UPDATE COORDINATES AND TIME
+        OUTPAR(3) = COSTHE
+        OUTPAR(4) = PHI
+        OUTPAR(6) = T + SN / ( C(25) * BETA )
+        OUTPAR(7) = X + DR * COS(PHI)
+        OUTPAR(8) = Y + DR * SIN(PHI)
+      ENDIF
+ 
+C-----------------------------------------------------------------------
+      OUTPAR( 1) = CURPAR(1)
+      OUTPAR( 2) = GAMMAN
+      OUTPAR( 5) = HNEW
+      OUTPAR( 9) = GEN
+      OUTPAR(10) = ALEVEL
+ 
+C  REGULAR END OF UPDATE
+      IRET2 = 0
+ 
+ 
+      IF (DEBUG) WRITE(MDEBUG,458) (OUTPAR(I),I=1,9)
+  458 FORMAT(' UPDATE: OUTPAR=',1P,9E10.3)
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/uphi.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/uphi.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/uphi.f	(revision 286)
@@ -0,0 +1,124 @@
+      SUBROUTINE UPHI(IENTRY,LVL)
+C                                VERSION 4.00  --  26 JAN 1986/1900
+C******************************************************************
+C   UPHI STANDS FOR 'UNIFORM PHI DISTRIBUTION'.
+C   SET COORDINATES FOR NEW PARTICLE OR RESET DIRECTION COSINES OF
+C   OLD ONE.  GENERATE RANDOM AZIMUTH SELECTION AND REPLACE THE
+C   DIRECTION COSINES WITH THEIR NEW VALUES.
+C******************************************************************
+*KEEP,EPCONT.
+      COMMON/EPCONT/   EDEP,RATIO,TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,IDISC,
+     *                 IROLD,IRNEW,RHOFAC, EOLD,ENEW,EKE,ELKE,BETA2,GLE,
+     *                 TSCAT,IAUSFL
+      DOUBLE PRECISION EDEP,RATIO
+      REAL             TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,RHOFAC,EOLD,ENEW,
+     *                 EKE,ELKE,BETA2,GLE,TSCAT
+      INTEGER          IDISC,IROLD,IRNEW,IAUSFL(29)
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,STACKE.
+      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
+      DOUBLE PRECISION E(60),TIME(60)
+      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
+      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
+*KEND.
+      COMMON/UPHIIN/SINC0,SINC1,SIN0(20002),SIN1(20002)
+      COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
+      SAVE A,B,C
+      IF((IENTRY.EQ.2))GO TO1070
+      IF((IENTRY.EQ.3))GO TO1080
+1090  LTHETA=SINC1*THETA+SINC0
+      SINTHE=SIN1(LTHETA)*THETA+SIN0(LTHETA)
+      CTHET=PI5D2-THETA
+      LCTHET=SINC1*CTHET+SINC0
+      COSTHE=SIN1(LCTHET)*CTHET+SIN0(LCTHET)
+C   USE THE FOLLOWING ENTRY IF SINTHE AND COSTHE ARE ALREADY KNOWN.
+C   SELECT PHI UNIFORMLY OVER THE INTERVAL (0,TWO PI). THEN USE
+C   PWLF OF SIN FUNCTION TO GET SIN(PHI) AND COS(PHI).  THE COSINE
+C   IS GOTTEN BY COS(PHI)=SIN(9*PI/4 - PHI).
+1070  CALL RMMAR(RNNO38,1,2)
+      PHI=RNNO38*TWOPI
+      LPHI=SINC1*PHI+SINC0
+      SINPHI=SIN1(LPHI)*PHI+SIN0(LPHI)
+      CPHI=PI5D2-PHI
+      LCPHI=SINC1*CPHI+SINC0
+      COSPHI=SIN1(LCPHI)*CPHI+SIN0(LCPHI)
+C   USE THE FOLLOWING ENTRY FOR THE SECOND OF TWO PARTICLES WHEN WE
+C   KNOW TWO PARTICLES HAVE A RELATIONSHIP IN THEIR CORRECTIONS.
+C   NOTE: SINTHE AND COSTHE CAN BE CHANGED OUTSIDE THROUGH COMMON.
+C   LVL IS A PARAMETER TELLING WHICH PARTICLES TO WORK WITH.
+C   THETA (SINTHE AND COSTHE) ARE ALWAYS RELATIVE TO THE DIRECTION
+C   OF THE INCIDENT PARTICLE BEFORE ITS DIRECTION WAS ADJUSTED.
+C   THUS WHEN TWO PARTICLES NEED TO HAVE THEIR DIRECTIONS COMPUTED,
+C   THE ORIGINAL INCIDENT DIRECTION IS SAVED IN THE VARIABLE A,B,C
+C   SO THAT IT CAN BE USED ON BOTH CALLS.
+C   LVL=1 -- OLD PARTICLE, SAVE ITS DIRECTION AND ADJUST IT
+C   LVL=2 -- NEW PARTICLE. ADJUST DIRECTION USING SAVED A,B,C
+C   LVL=3 -- BREMSSTRAHLUNG GAMMA.  SAVE ELECTRON DIRECTION (NEXT
+C   TO TOP OF STACK), AND THEN ADJUST GAMMA DIRECTION.
+1080  IF (LVL.EQ.2) GO TO1100
+      IF((LVL.EQ.3))GO TO1110
+1120  A=U(NP)
+      B=V(NP)
+      C=W(NP)
+      GO TO 1130
+1110  A=U(NP-1)
+      B=V(NP-1)
+      C=W(NP-1)
+1100  X(NP)=X(NP-1)
+      Y(NP)=Y(NP-1)
+      Z(NP)=Z(NP-1)
+      LPCTE(NP)=LPCTE(NP-1)
+      IR(NP)=IR(NP-1)
+      DNEAR(NP)=DNEAR(NP-1)
+      TIME(NP)=TIME(NP-1)
+      IGEN(NP)=IGEN(NP-1)
+      IOBS(NP)=IOBS(NP-1)
+1130  SINPS2=A*A+B*B
+      IF (SINPS2.LT.1.0E-10) THEN
+       U(NP)=SINTHE*COSPHI
+       V(NP)=SINTHE*SINPHI
+       W(NP)=C*COSTHE
+      ELSE
+       SINPSI=SQRT(SINPS2)
+       US=SINTHE*COSPHI
+       VS=SINTHE*SINPHI
+       SINDEL=B*(1./SINPSI)
+       COSDEL=A*(1./SINPSI)
+       U(NP)=C*COSDEL*US-SINDEL*VS+A*COSTHE
+       V(NP)=C*SINDEL*US+COSDEL*VS+B*COSTHE
+       W(NP)=-SINPSI*US+C*COSTHE
+      END IF
+      RADINV=1.5-0.5*(U(NP)**2+V(NP)**2+W(NP)**2)
+      U(NP)=U(NP)*RADINV
+      V(NP)=V(NP)*RADINV
+      W(NP)=W(NP)*RADINV
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/utqsea.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/utqsea.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/utqsea.f	(revision 286)
@@ -0,0 +1,128 @@
+      SUBROUTINE UTQSEA(X1,X2,X3)
+ 
+C-----------------------------------------------------------------------
+C  UT(ILITY ROUTINE) SEA (QUARK STRUCTURE FUNCTION)
+C
+C  SEA QUARK STRUCTURE FUNCTION INTEGRAL
+C  RETURNS INTEGRAL (XSE(1)->XSE(I)) OF FU(Z) DZ
+C
+C  THIS SUBROUTINE IS CALLED FROM VENLNK
+C
+C  DESIGN   : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      PARAMETER (NSTRU=2049)
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /STRU2/   DELTA0,DELTA1,QSEH(NSTRU),QSEPI(NSTRU)
+     *                ,QVAH(NSTRU),QVAPI(NSTRU),XSE(NSTRU),XVA(NSTRU)
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'UTQSEA:'
+ 
+      X0 = 0.
+      N = NSTRU
+      IF ( ISH .GE. 90 ) THEN
+        IF ( X1.LT.X0 .OR. X2.LT.X1 .OR. X3.LT.X2 ) THEN
+          CALL UTMSG('UTQSEA')
+          WRITE(IFCH,*)'   XI=',X0,X1,X2,X3
+          CALL UTMSGF
+        ENDIF
+      ENDIF
+      I1 = N/3
+      I2 = 2*N/3
+      FAC1 = (X1-X0)/FLOAT(I1-1)
+      DO 11 I=1,I1-1
+        XSE(I)=(I-1.)*FAC1+X0
+ 11   CONTINUE
+      FAC2 = (X2-X1)/FLOAT(I2-I1)
+      DO 12 I=I1,I2-1
+        XSE(I)=FLOAT(I-I1)*FAC2 +X1
+ 12   CONTINUE
+      FAC3 = (X3-X2)/FLOAT(N-I2)
+      DO 13 I=I2,N
+        XSE(I)=MIN( FLOAT(I-I2)*FAC3 +X2, 0.99999999 )
+ 13   CONTINUE
+ 
+      XCUT2 = XCUT**2
+      XCUT4 = XCUT2**2
+      XCUT6 = XCUT2*XCUT4
+      CUTLOG = LOG(XCUT)
+C  COEFFICIENTS FOR HADRONIC SEA QUARK STRUCTURE FUNCTION
+      AH0 = -8. + 37.333333*XCUT2 - 29.866667*XCUT4 + 3.65714286*XCUT6
+      AH1 = 14. - 26.25*XCUT2 + 8.75*XCUT4 - 0.2734375*XCUT6
+      AH2 = -18.666667 + 14.933333*XCUT2 - 1.82857143*XCUT4
+      AH3 = 17.5 - 5.8333333*XCUT2 + 0.182291667*XCUT4
+      AH4 = -11.2 + 1.37142857*XCUT2
+      AH5 = 4.6666667 - 0.14583333*XCUT2
+      AH6 = -1.14285714
+      AH7 = 0.125
+      QAH = 1. - AH1 * XCUT2
+      AHCUT = AH0 * XCUT
+C  COEFFICIENTS FOR PIONIC SEA QUARK STRUCTURE FUNCTION
+      API0 = -5. + 6.6666667*XCUT2 - 0.53333333*XCUT4
+      API1 = 5. - 1.875*XCUT2
+      API2 = -3.3333333 + 0.26666667*XCUT2
+      API3 = 1.25
+      API4 = -0.2
+      QAPI = 1. - API1 * XCUT2
+      APICUT = API0 * XCUT
+ 
+      QSEH(1)  = 0.
+      QSEPI(1) = 0.
+      DO 2 I=2,N
+        Z = XSE(I)
+        ROOT     = SQRT(Z**2 + XCUT2)
+        ROOTLG   = LOG( Z + ROOT ) - CUTLOG
+        QSEH(I)  = 1.265 * ( QAH * ROOTLG - AHCUT
+     *             + ROOT * (AH0 + Z*(AH1 + Z*(AH2 + Z*(AH3
+     *             + Z*(AH4 + Z*(AH5 + Z*(AH6 + Z*AH7))))))) )
+        QSEPI(I) = 0.9 * ( QAPI * ROOTLG - APICUT
+     *             + ROOT * (API0+Z*(API1+Z*(API2+Z*(API3+Z*API4)))) )
+ 2    CONTINUE
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/utqval.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/utqval.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/utqval.f	(revision 286)
@@ -0,0 +1,118 @@
+      SUBROUTINE UTQVAL(Q,NEND)
+ 
+C-----------------------------------------------------------------------
+C  UT(ILITY ROUTINE) VAL(ENCE QUARK STRUCTURE FUNCTION)
+C
+C  VALENCE QUARK STRUCTURE FUNCTION
+C  RETURNS  INTEGRAL (XVA(1)->XVA(I)) FU(Z) DZ
+C  THIS INTEGRAL IS ONLY CALCULATED FOR SMALL VALUES OF XVA UP TO 25
+C  TIMES THE VALUE OF XCUT. FOR LARGER VALUES THE TABULATED VALUES OF
+C  DATASET 'VENUSDAT' ARE TAKEN AND CORRECTED BY THE CONSTANT SHIFT
+C  DELTA0 (FOR HADRONS) OR DELTA1 (FOR PIONS).
+C
+C  THIS SUBROUTINE IS CALLED FROM VENLNK
+C
+C  DESIGN   : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      PARAMETER (NSTRU=2049)
+      COMMON /CIPIO/   IPIO
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /STRU2/   DELTA0,DELTA1,QSEH(NSTRU),QSEPI(NSTRU)
+     *                ,QVAH(NSTRU),QVAPI(NSTRU),XSE(NSTRU),XVA(NSTRU)
+ 
+      DIMENSION        Y0(9),Y1(9),Q(NEND)
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'UTQVAL: IPIO,NEND=',IPIO,NEND
+ 
+      XCUT2 = XCUT**2
+      Q(1)  = 0.
+      Z = XVA(1)
+      DENOMI = 1. / SQRT(Z**2 + XCUT2)
+ 
+      IF ( IPIO .EQ. 0 ) THEN
+C  CALCULATE THE FIRST NEND VALUES OF STRUCTURE FUNCTION FOR HADRONS
+        Y0(1) = 0.
+        DO 3 I=2,NEND
+          FACT = (XVA(I) - Z) * 0.125
+          DO 2 J=2,8
+            Z = Z + FACT
+            DENOMI = 1. / SQRT(Z**2 + XCUT2)
+            Y0(J) = (1.-Z)**3.46 * Z**.419 * (2.74793064*Z + 0.62452969)
+     *              * DENOMI
+ 2        CONTINUE
+          Z = XVA(I)
+          DENOMI = 1. / SQRT(Z**2 + XCUT2)
+          Y0(9) = (1.-Z)**3.46 * Z**.419 * (2.74793064*Z + 0.62452969)
+     *             * DENOMI
+C  INTEGRATION AFTER BODE'S RULE (ABRAMOWITZ + STEGUN, HANDBOOK OF
+C  MATHEMATICAL FUNCTIONS, DOVER PUBLICATIONS (1970), FORMULA 25.4.18)
+          Q(I) =  2.8218694E-4 * FACT *       ( 989. * (Y0(1) + Y0(9))
+     *            +  5888. * (Y0(2) + Y0(8)) -  928. * (Y0(3) + Y0(7))
+     *            + 10496. * (Y0(4) + Y0(6)) - 4540. *  Y0(5) )
+     *                         + Q(I-1)
+          Y0(1) = Y0(9)
+ 3      CONTINUE
+ 
+      ELSE
+C  CALCULATE THE FIRST NEND VALUES OF STRUCTURE FUNCTION FOR PIONS
+        Y1(1) = 0.
+        DO 5 I=2,NEND
+          FACT = (XVA(I) - Z) * 0.125
+          DO 4 J=2,8
+            Z = Z + FACT
+            DENOMI = 1. / SQRT(Z**2 + XCUT2)
+            Y1(J) = (1.-Z)**0.7 * Z**.4 * DENOMI
+ 4        CONTINUE
+          Z = XVA(I)
+          DENOMI = 1. / SQRT(Z**2 + XCUT2)
+          Y1(9) = (1.-Z)**0.7 * Z**.4 * DENOMI
+C  INTEGRATION AFTER BODE'S RULE (ABRAMOWITZ + STEGUN, HANDBOOK OF
+C  MATHEMATICAL FUNCTIONS, DOVER PUBLICATIONS (1970), FORMULA 25.4.18)
+          Q(I) =  2.8218694E-4 * FACT *       ( 989. * (Y1(1) + Y1(9))
+     *            +  5888. * (Y1(2) + Y1(8)) -  928. * (Y1(3) + Y1(7))
+     *            + 10496. * (Y1(4) + Y1(6)) - 4540. *  Y1(5) )
+     *            * 0.1730725  + Q(I-1)
+          Y1(1) = Y1(9)
+ 5      CONTINUE
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/vapor.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/vapor.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/vapor.f	(revision 286)
@@ -0,0 +1,233 @@
+      SUBROUTINE VAPOR(MAPROJ,INEW,JFIN,ITYP,PFRX,PFRY)
+ 
+C-----------------------------------------------------------------------
+C  (E)VAPOR(ATION OF NUCLEONS AND ALPHA PARTICLES FROM FRAGMENT)
+C
+C  TREATES THE REMAINING UNFRAGMENTED NUCLEUS
+C  EVAPORATION FOLLOWING CAMPI APPROXIMATION
+C  SEE: X. CAMPI AND J. HUEFNER, PHYS.REV. C24 (1981) 2199
+C  AND  J.J. GAIMARD, THESE UNIVERSITE PARIS 7, (1990)
+C  THIS SUBROUTINE IS CALLED FROM SDPM AND VSTORE
+C
+C  ARGUMENTS INPUT:
+C   MAPROJ       = NUMBER OF NUCLEONS OF PROJECTILE
+C   INEW         = PARTICLE TYPE OF SPECTATOR FRAGMENT
+C  ARGUMENTS OUTPUT:
+C   JFIN         = NUMBER OF FRAGMENTS
+C   ITYP(1:JFIN) = NATURE (PARTICLE CODE) OF FRAGMENTS (GEANT)
+C   PFRX(1:JFIN) = TRANSVERSE MOMENTUM OF FRAGMENTS IN X-DIRECTION
+C   PFRY(1:JFIN) = TRANSVERSE MOMENTUM OF FRAGMENTS IN Y-DIRECTION
+C
+C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT NONE
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,DPMFLG.
+      COMMON /DPMFLG/  NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+      INTEGER          NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      DOUBLE PRECISION PFR(60),PFRX(60),PFRY(60)
+      DOUBLE PRECISION AFIN,AGLH,APRF,BGLH,EEX,PHIFR,RANNOR,SPFRX,SPFRY
+      INTEGER          ITYP(60),IARM,INEW,ITYPRM,INRM,IS,IZRM,JC,JFIN,
+     *                 K,L,LS,MAPROJ,MF,NFIN,NINTA,NNUC,NPRF,NSTEP
+      EXTERNAL         RANNOR
+C-----------------------------------------------------------------------
+ 
+      IF (DEBUG) WRITE(MDEBUG,*) 'VAPOR : MAPROJ,INEW = ',MAPROJ,INEW
+ 
+      ITYPRM = INEW
+      NPRF   = INEW/100
+      NINTA  = MAPROJ - NPRF
+      IF ( NINTA .EQ. 0 ) THEN
+C  NO NUCLEON HAS INTERACTED
+        JFIN    = 1
+        PFR(1)  = 0.D0
+        ITYP(1) = INEW
+        IF (DEBUG) WRITE(MDEBUG,*) 'VAPOR : JFIN,NINTA= ',JFIN,NINTA
+        RETURN
+      ENDIF
+ 
+C  EXCITATION ENERGY EEX OF PREFRAGMENT
+C  SEE: J.J. GAIMARD, THESE UNIVERSITE PARIS 7, (1990), CHPT. 4.2
+      EEX = 0.D0
+      CALL RMMAR(RD,2*NINTA,1)
+      DO  22  L = 1,NINTA
+        IF ( RD(NINTA+L) .LT. RD(L) ) RD(L) = 1. - RD(L)
+        EEX = EEX + RD(L)
+ 22   CONTINUE
+C  DEPTH OF WOODS-SAXON POTENTIAL TO FERMI SURFACE IS 0.040 GEV
+      IF (DEBUG) WRITE(MDEBUG,*)'VAPOR : EEX = ',SNGL(EEX*0.04D0),' GEV'
+C  EVAPORATION: EACH EVAPORATION STEP NEEDS ABOUT 0.020 GEV, THEREFORE
+C  NSTEP IS EEX * 0.04/0.02 = EEX * 2.
+      NSTEP = INT(EEX*2.D0)
+ 
+      IF ( NSTEP .LE. 0 ) THEN
+C  EXCITATION ENERGY TOO SMALL, NO EVAPORATION
+        JFIN = 1
+        PFR(1)  = 0.D0
+        ITYP(1) = INEW
+        IF (DEBUG) WRITE(MDEBUG,*) 'VAPOR : JFIN,EEX = ',JFIN,SNGL(EEX)
+        RETURN
+      ENDIF
+ 
+C  AFIN IS ATOMIC NUMBER OF FINAL NUCLEUS
+      APRF = FLOAT(NPRF)
+      AFIN = APRF - 1.6D0 * FLOAT(NSTEP)
+      NFIN = MAX( INT(AFIN+0.5D0), 0 )
+C  CORRESPONDS TO DEFINITION; FRAGMENTATION-EVAPORATION
+C  CONVOLUTION EMU07 /MODEL ABRASION EVAPORATION (JNC FZK APRIL 94)
+C  NNUC IS NUMBER OF EVAPORATING NUCLEONS
+      NNUC = NPRF - NFIN
+      IF (DEBUG) WRITE(MDEBUG,*) 'VAPOR : NFIN,NNUC = ',NFIN,NNUC
+      JC = 0
+ 
+      IF     ( NNUC .LE. 0 ) THEN
+C  NO EVAPORATION
+        JFIN = 1
+        PFR(1)  = 0.D0
+        ITYP(1) = INEW
+        RETURN
+ 
+      ELSEIF ( NNUC .GE. 4 ) THEN
+C  EVAPORATION WITH FORMATION OF ALPHA PARTICLES POSSIBLE
+C  IARM, IZRM, INRM ARE NUMBER OF NUCLEONS, PROTONS, NEUTRONS OF
+C  REMAINDER
+        DO  31  LS = 1,NSTEP
+          IARM = ITYPRM/100
+          IF ( IARM .LE. 0 ) GOTO 100
+          IZRM = MOD(ITYPRM,100)
+          INRM = IARM - IZRM
+          JC = JC + 1
+          CALL RMMAR(RD,2,1)
+          IF ( RD(1).LT.0.2 .AND. IZRM.GE.2 .AND. INRM.GE.2 ) THEN
+            ITYP(JC) = 402
+            NNUC   = NNUC - 4
+            ITYPRM = ITYPRM - 402
+          ELSE
+            IF ( RD(2)*(IZRM+INRM) .LT. IZRM ) THEN
+              ITYP(JC) = 14
+              ITYPRM   = ITYPRM - 101
+            ELSE
+              ITYP(JC) = 13
+              ITYPRM   = ITYPRM - 100
+            ENDIF
+            NNUC = NNUC - 1
+          ENDIF
+          IF ( NNUC .LE. 0 ) GOTO 50
+ 31     CONTINUE
+      ENDIF
+ 
+      IF ( NNUC .LT. 4 ) THEN
+C  EVAPORATION WITHOUT FORMATION OF ALPHA PARTICLES
+        CALL RMMAR(RD,NNUC,1)
+        DO  32  IS = 1,NNUC
+          IARM = ITYPRM/100
+          IF ( IARM .LE. 0 ) GOTO 100
+          IZRM = MOD(ITYPRM,100)
+          JC = JC + 1
+          IF ( RD(IS)*IARM .LT. IZRM ) THEN
+            ITYP(JC) = 14
+            ITYPRM   = ITYPRM - 101
+          ELSE
+            ITYP(JC) = 13
+            ITYPRM   = ITYPRM - 100
+          ENDIF
+ 32     CONTINUE
+      ENDIF
+ 
+ 50   CONTINUE
+      JC = JC + 1
+      IF     ( ITYPRM .GT. 101 ) THEN
+        ITYP(JC) = ITYPRM
+      ELSEIF ( ITYPRM .EQ. 101 ) THEN
+        ITYP(JC) = 14
+      ELSEIF ( ITYPRM .EQ. 100 ) THEN
+        ITYP(JC) = 13
+      ELSE
+        JC = JC - 1
+        IF ( ITYPRM .NE. 0 ) WRITE(MONIOU,*)
+     *                  'VAPOR : ILLEGAL PARTICLE ITYPRM =',ITYPRM
+      ENDIF
+ 
+ 100  JFIN = JC
+      IF (DEBUG) WRITE(MDEBUG,*) 'VAPOR : NO   ITYP           PFR'
+      IF     ( NFRAGM .EQ. 2 ) THEN
+C  EVAPORATION WITH PT AFTER PARAMETRIZED JACEE DATA
+        DO  150  MF = 1,JFIN
+          PFR(MF) = RANNOR(0.088D0,0.044D0)
+          IF (DEBUG) WRITE(MDEBUG,*) MF,ITYP(MF),SNGL(PFR(MF))
+ 150    CONTINUE
+      ELSEIF ( NFRAGM .EQ. 3 ) THEN
+C  EVAPORATION WITH PT AFTER GOLDHABER'S MODEL (PHYS.LETT.53B(1974)306)
+        DO  160  MF = 1,JFIN
+          K = MAX( 1, ITYP(MF)/100 )
+          BGLH  = K * (MAPROJ - K) / FLOAT(MAPROJ-1)
+C  THE VALUE 0.103 [GEV] IS SIGMA(0)=P(FERMI)/SQRT(5.)
+*         AGLH = 0.103D0 * SQRT( BGLH )
+C  THE VALUE 0.090 [GEV] IS EXPERIMENTALLY DETERMINED SIGMA(0)
+          AGLH = 0.090D0 * SQRT( BGLH )
+          PFR(MF) = RANNOR(0.D0,AGLH)
+          IF (DEBUG) WRITE(MDEBUG,*) MF,ITYP(MF),SNGL(PFR(MF))
+ 160    CONTINUE
+      ELSE
+C  EVAPORATION WITHOUT TRANSVERSE MOMENTUM
+        DO  165  MF = 1,JFIN
+          PFR(MF) = 0.D0
+          IF (DEBUG) WRITE(MDEBUG,*) MF,ITYP(MF),SNGL(PFR(MF))
+ 165    CONTINUE
+      ENDIF
+C  CALCULATE RESIDUAL TRANSVERSE MOMENTUM
+      SPFRX = 0.D0
+      SPFRY = 0.D0
+      CALL RMMAR(RD,JFIN,1)
+      DO  170  MF = 1,JFIN
+        PHIFR = PI * RD(MF)
+        PFRX(MF) = PFR(MF) * COS(PHIFR)
+        PFRY(MF) = PFR(MF) * SIN(PHIFR)
+        SPFRY = SPFRY + PFRY(MF)
+        SPFRX = SPFRX + PFRX(MF)
+ 170  CONTINUE
+C  CORRECT ALL TRANSVERSE MOMENTA FOR MOMENTUM CONSERVATION
+      SPFRX = SPFRX / JFIN
+      SPFRY = SPFRY / JFIN
+      DO  180  MF = 1,JFIN
+        PFRX(MF) = PFRX(MF) - SPFRX
+        PFRY(MF) = PFRY(MF) - SPFRY
+ 180  CONTINUE
+ 
+      IF (DEBUG) WRITE(MDEBUG,*) 'VAPOR : NINTA,JFIN= ',NINTA,JFIN
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/vendat.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/vendat.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/vendat.f	(revision 286)
@@ -0,0 +1,24 @@
+      BLOCK DATA VENDAT
+ 
+C-----------------------------------------------------------------------
+C  VEN(US) DAT(A INITIALIZATION)
+C
+C  INITIALIZES DATA FOR VENUS LINK
+C
+C  DESIGN   : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+      COMMON /VENLIN/  PTQ1,PTQ2,PTQ3,QMUST1,QMUST2,QMUST3
+     *                ,IDTABL(100)
+ 
+      DATA IDTABL/
+     *   10,  -12,   12,    0,  -14,   14,  110,  120, -120,  -20,
+     *  130, -130, 1220, 1120,-1120,   20,  220, 2130, 1130, 1230,
+     * 2230, 1330, 2330, 3331,-1220,-2130,-1130,-1230,-2230,-1330,
+     *-2330,-3331,  -16,   16, -240,  240, -140,  140, -340,  340,
+     * 2140,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+     *  111,  121, -121, 1111, 1121, 1221, 2221,-1111,-1121,-1221,
+     *-2221,  231,  131, -131, -231,   11,  -11,   13,  -13,    0,
+     *  220,  220,  220,  220,    0,             25*0          /
+ 
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/venini.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/venini.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/venini.f	(revision 286)
@@ -0,0 +1,919 @@
+      SUBROUTINE VENINI
+ 
+C-----------------------------------------------------------------------
+C  VEN(US) INI(TIALISATION)
+C
+C  FIRST INITIALIZATION OF VENUS ARRAYS AND PARAMETERS
+C  THIS SUBROUTINE IS CALLED FROM START
+C
+C  DESIGN   : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+*KEEP,AIR.
+      COMMON /AIR/     COMPOS,PROBTA,AVERAW,AVOGAD
+      DOUBLE PRECISION COMPOS(3),PROBTA(3),AVERAW,AVOGAD
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,VENPAR.
+      COMMON /VENPAR/  PARVAL,NPARAM,PARCHA
+      REAL             PARVAL(100)
+      INTEGER          NPARAM
+      CHARACTER*6      PARCHA(100)
+*KEEP,VENUS.
+      COMMON /VENUS/   ISH0,IVERVN,MTAR99,FVENUS,FVENSG
+      INTEGER          ISH0,IVERVN,MTAR99
+      LOGICAL          FVENUS,FVENSG
+*KEND.
+ 
+      PARAMETER (KOLLMX=2500)
+      PARAMETER (MXEPS=10)
+      PARAMETER (MXTAU=4)
+      PARAMETER (MXVOL=10)
+      PARAMETER (NGAU=129)
+      PARAMETER (NDEP=129)
+      PARAMETER (NDET=129)
+      PARAMETER (NPTF=129)
+      PARAMETER (NPTJ=129)
+      PARAMETER (NSTRU=2049)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CDEN/    MASSNR,RMX,R0
+      COMMON /CGAU/    QGAU(NGAU),XGAU(NGAU)
+      COMMON /CIUTOT/  IUTOTC,IUTOTE
+      COMMON /CJINTC/  CLUST(MXTAU,MXVOL,MXEPS)
+      COMMON /CJINTD/  VOLSUM(MXTAU),VO2SUM(MXTAU),NCLSUM(MXTAU)
+      COMMON /CLEP/    ICINPU,IDSCAT
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /COL/     BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
+     *                ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
+     *                ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
+     *                ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
+     *                ,XDET99(NDET)
+     *                ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
+     *                ,NRTARG(KOLLMX),NTARG
+      COMMON /CPTF/    FPTFS,FPTFSS,FPTFU,FPTFUS,FPTFUU
+     *                ,QPTFS(NPTF),QPTFSS(NPTF),QPTFU(NPTF),QPTFUS(NPTF)
+     *                ,QPTFUU(NPTF),XPTF(NPTF)
+      COMMON /CPTJ/    QPTJ(NPTJ),XPTJ(NPTJ)
+      COMMON /CPTLU/   NPTLU
+      COMMON /CQUAMA / QUAMA
+      DOUBLE PRECISION SEEDC,SEEDI
+      COMMON /CSEED/   SEEDC,SEEDI
+      COMMON /CVSN/    IVERSN
+      COMMON /EPSCR/   EPSCRI
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /NEVNT/   NEVNT
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /PARO3/   ASUHAX(7),ASUHAY(7),OMEGA,SIGPPD,SIGPPE,UENTRO
+     *                ,IWZZZZ
+      COMMON /PARO4/   GRICEL,GRIDEL,GRIGAM,GRIRSQ,GRISLO
+      COMMON /PARO5/   DELEPS,DELVOL
+      COMMON /QUARKM/  SMAS,SSMAS,USMAS,UUMAS
+      COMMON /STRU2/   DELTA0,DELTA1,QSEH(NSTRU),QSEPI(NSTRU)
+     *                ,QVAH(NSTRU),QVAPI(NSTRU),XSE(NSTRU),XVA(NSTRU)
+      COMMON /VENLIN/  PTQ1,PTQ2,PTQ3,QMUST1,QMUST2,QMUST3
+     *                ,IDTABL(100)
+ 
+      EXTERNAL         SDENSI,SGAU,SPTF,SPTJ
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'VENINI:'
+ 
+      IFMT = MONIOU
+      IFCH = MDEBUG
+      ICHOIC = 2
+      NEVNT = 0
+ 
+C     VERSION NUMBER
+C     --------------
+         IVERSN=4125
+         IVERVN=IVERSN
+ 
+C     FRAGMENTATION PARAMETERS/OPTIONS
+C     --------------------------------
+C     PROB. FOR U OR D QUARK PRODUCTION ( =(1-P_STRANGE)/2 ):
+         PUD=0.455
+C     QQ-QQBAR PROBABILITY
+         PDIQUA=0.12
+C     SPIN PROBABILITIES (FOR LIGHT AND HEAVY FLAVOURS):
+         PSPINL=0.50
+         PSPINH=0.75
+C     ISOSPIN PROBABILITY:
+         PISPN=0.50
+C     OPTION FOR P_T DISTRIBUTION (1=EXPONENTIAL,2=GAUSSIAN):
+         IOPTF=1
+C     AVERAGE P_TRANSVERSE
+         PTF=0.40
+C     STRING TENSION:
+         TENSN=1.0
+C     STRING DECAY PARAMETER
+         PAREA=.60
+C     THRESHOLD RESONANCE -> STRING
+         DELREM=1.0
+C     CUTOFF FOR KMAXOR BEYOND WHICH PDIQ=0 IN SR JSPLIT
+         KUTDIQ=4
+C     OPTION FOR BREAKING PROCEDURE (1=AMOR,2=SAMBA)
+         IOPBRK=1
+ 
+C     PROTON-PROTON PARAMETERS/OPTIONS
+C     --------------------------------
+C     OPTION FOR QUARK P_T DISTRIBUTION (1=EXPONENTIAL,2=GAUSSIAN,3=POWE
+         IOPTQ=2
+C     MEAN TRANSVERSE MOMENTUM OF QUARKS
+C      (Q1+Q2*LN(E)+Q3*LN(E)**2, E=SQRT(S)):
+         PTQ1=0.260
+         PTQ2=0.
+         PTQ3=0.
+C     PROBABILITY FOR SEMIHARD INTERACTION (NOT USED IF NEGATIVE):
+C        PHARD=-1.0
+C     CUTOFF PARAMETER FOR P_T DISTR. FOR SEMIHARD INTERACTIONS:
+         PTH=1.0
+C     EFFECTIVE RATIO OF STRANGE SEA OVER U SEA:
+         RSTRAS=0.
+C     EFFECTIVE CUTOFF MASS IN STRUCTURE FUNCTIONS:
+         CUTMSQ=2.0
+         CUTMSS=0.001
+C     VALENCE QUARK FRACTION IN CASE OF DIFFRACTIVE INTERACTION
+         PVALEN=0.30
+C     PHASE SPACE PARAMETERS:
+         DELMSS=0.300
+ 
+C     GRIBOV-REGGE-THEORY PARAMETERS
+C     ------------------------------
+C     GAMMA (IN FM**2):
+         GRIGAM=3.64*0.04
+C     R**2(IN FM**2):
+         GRIRSQ=3.56*0.04
+C     DELTA=INTERCEPT OF REGGE TRAJECTORY-1:
+         GRIDEL=0.07
+C     SLOPE OF REGGE TRAJECTORY (IN FM**2):
+         GRISLO=0.25*0.04
+C     C (DETERMINES RELATIVE WEIGHT OF ELASTIC AND DIFFR CROSS SCTN):
+         GRICEL=1.5
+ 
+C     NUCLEUS-NUCLEUS PARAMETERS
+C     --------------------------
+C     HARD CORE DISTANCE:
+         CORE=0.8
+C     JPSI NUCLEON CROSS SECTION (FM**2):
+         SIGJ=0.2
+ 
+C     RESCATTERING PARAMETERS
+C     -----------------------
+C     REACTION TIME:
+         TAUREA=1.5
+C     OVERLAP PARAMETER (NOT USED IF NEGATIVE)
+         OVERLP=-1.0
+C     BARYON RADIUS:
+         RADIAC=0.65
+C     MESON RADIUS:
+         RADIAS=0.35
+C     CRITICAL ENERGY DENSITY (<0 TO AVOID SECONDARY INTERACTIONS):
+         EPSCRI=1.0
+C     BARYON ENERGY DENSITY
+         EPSBAR=2.0
+C     INTERACTION MASS:
+         AMSIAC=0.8
+C     OPTION TO CALL JINTA1 (1) OR JINTA2 (2)
+         IOJINT=2
+C     PRINT OPTIONS
+         AMPRIF=0.
+         DELVOL=1.0
+         DELEPS=1.0
+ 
+C     CLUSTER DECAY PARAMETERS/OPTIONS
+C     --------------------------------
+C     CORRELATION LENGTH
+C     (CORLEN>1.0: FIRST FIX SHORT CLUSTER BREAKING
+         CORLEN=1.0
+C     MINIMUM MASS
+         AMUSEG=3.0
+C     BAG CONSTANT -1/4
+         BAG4RT=0.200
+C     OPTION FOR ENTROPY CALCULATION:
+C      IOPENT=0: ZERO ENTROPY
+C      IOPENT=1: OSCILLATOR MODEL (0 FOR K.LE.UENTRO)
+C      IOPENT=2: FERMI GAS WITH CONST VOLUME (0 FOR K.LE.UENTRO)
+C      IOPENT=3: FERMI GAS WITH CONST DENSITY (0 FOR K.LE.UENTRO)
+C      IOPENT=4: FERMI GAS WITH CONST VOLUME - NEW (0 FOR K.LE.UENTRO)
+C      IOPENT=5: RESONANCE GAS (HAGEDORN) (0 FOR U.LE.UENTRO)
+         IOPENT=5
+         UENTRO=4.0
+         KENTRO=100000
+C     DECAY TIME (COMOVING FRAME):
+         TAUNLL=1.0
+C     OSCILLATOR QUANTUM
+         OMEGA=0.500
+ 
+C     PRESENTLY NOT USED
+C     ------------------
+ 
+C     CLUSTER DECAY INITIALIZATIONS
+C     -----------------------------
+C     AVERAGE HADRON MASSES, TWO LOWEST MULTIPLETS (IF POSSIBLE):
+C     N/DELTA,LAMBDA/SIGMA,XI,OMEGA,PI/RHO,KAON,DELTA:
+         ASUHAX(1)=1.134
+         ASUHAX(2)=1.301
+         ASUHAX(3)=1.461
+         ASUHAX(4)=1.673
+         ASUHAX(5)=0.6125
+         ASUHAX(6)=0.7915
+         ASUHAX(7)=1.2320
+C     LOWEST MASSES:
+         ASUHAY(1)=0.940
+         ASUHAY(2)=1.200
+         ASUHAY(3)=1.322
+         ASUHAY(4)=1.673
+         ASUHAY(5)=0.1400
+         ASUHAY(6)=0.4977
+         ASUHAY(7)=1.2320
+ 
+C     TECHNICAL PARAMETERS
+C     --------------------
+C     DELTA_ZETA FOR /C4PTL/...WEIPTL()
+         DLZETA=0.5
+C     MIN TAU FOR SPACE-TIME EVOLUTION:
+         TAUMIN=0.
+C     MAX TAU FOR SPACE-TIME EVOLUTION
+         TAUMAX=10.0
+C     TAU STEPS FOR SPACE-TIME EVOTUTION (46+40)
+         NUMTAU=51
+C     RANGE FOR PT DISTRIBUTION
+         PTMX=6.0
+C     RANGE FOR GAUSS DISTRIBUTION
+         GAUMX=8.0
+C     PARAMETER DETERMINING RANGE FOR DENSITY DISTRIBUTION
+         FCTRMX=10.0
+C     TRY-AGAIN PARAMETER
+         NTRYMX=10
+C     MAX TIME FOR JPSI EVOLUTION
+         TAUMX=20.0
+C     TIME STEPS FOR JPSI EVOLUTION
+         NSTTAU=100
+ 
+C     OPTIONS
+C     -------
+C     OPTION FOR MINIMUM ENERGY IN SJCGAM:
+C       IOPENU = 1 : SUM OF HADRON MASSES
+C       IOPENU = 2 : BAG MODEL CURVE WITH MINIMUM AT NONZERO STRANGEN.
+         IOPENU=1
+C     PARAMETER THETA IN BERGER/JAFFE MASS FORMULA
+         THEMAS=0.51225
+C     SEA PROBABILITY (IF .LT. 0. THEN CALCULATED FROM STRUCTURE FNCTS)
+         PROSEA=-1.0
+C     INELASTIC PP CROSS SECTION (FM**2)
+C      (IF NEGATIVE: CALCULATED FROM GRIBOV-REGGE-THEORY):
+CDH      SIGPPI=-1.0
+C     MULTISTRING PARAMETER (Q1+Q2*LN(E)+Q3*LN(E)**2, E=SQRT(S)):
+C      (NOT USED IF RACPRO IS CALLED WITH 'GRI'-OPTION (DEFAULT))
+         QMUST1=0.50
+         QMUST2=0.
+         QMUST3=0.
+C     ENTRO() CALCULATED (1) OR FROM DATA (2)
+         IENTRO=2
+C     DUAL PARTON MODEL (1) OR NOT (ELSE)
+         IDPM=0
+C     ANTIQUARK COLOR EXCHANGE (1) OR NOT (0):
+         IAQU=1
+C     MINIMUM NUMBER OF VALENCE QUARKS:
+         NEQMN=-5
+C     MAXIMUM NUMBER OF VALENCE QUARKS:
+         NEQMX=5
+C     UPPER LIMIT FOR RAPIDITY INTERVAL FOR INTERMITTENCY ANALYSIS
+         YMXIMI=2.0
+C     CLEAN /CPTL/ IF NCLEAN > 0 (EVERY NCLEAN_TH TIME STEP)
+         NCLEAN=0
+C     TRAFO FROM PP-CM INTO LAB-SYSTEM (1) OR NOT (.NE.1)
+         LABSYS=1
+C     MAXIMUM NUMBER OF COLLISIONS:
+         NCOLMX=1000
+C     MAXIMUM RESONANCE SPIN (SPIN IN A GENARAL SENSE: MOD(/ID/,10))
+         MAXRES=99999
+C     MOMENTUM RESCALING (1=YES):
+         IRESCL=1
+C     NUE ENERGY
+         ELEPTI=43.00
+C     MUE  ENERGY
+         ELEPTO=26.24
+C     MUE ANGLE
+         ANGMUE=3.9645/180.*3.1415926
+C     JPSI TO BE PRODUCED (1) OR NOT (0):
+         JPSI=0
+C     JPSI FINAL STATE INTERACTION (1) OR NOT (0):
+         JPSIFI=0
+C     COLLISION TRIGGER (ONLY COLL BETWEEN KO1 AND KO2 ARE USED):
+         KO1KO2=00009999
+C     PRINT OPTION:
+C     ISH=14: CALL UTTIMA
+C     ISH=15: PRINTS PTLS READ FROM DATA FILE IN SR VEANLY
+C     ISH=16: PRINTS SEA PROB.
+C     ISH=17: PRINTS RANDOM NUMBERS
+C     ISH=18: SR JCLUDE, NO-PHASE-SPACE CLUSTERS
+C     ISH=19: SR AINITL, CALL SMASSP
+C     ISH=20: SR VEANLY, PRINTS EVT NR IF EVT IS ACCEPTED
+C     ISH=21: CREATES HISTOGRAM FOR SEA DISTRIBUTION
+C     ISH=22: SR JFRADE, MSG AFTER CALL UTCLEA
+C     ISH=23: CALL JINTFP
+C     ISH=24: CALL JINTCL
+C     ISH=25: CALL JCHPRT
+C     ISH=90,91,92,93,94,95: MORE AND MORE DETAILED MESSAGES.
+      IF ( DEBUG ) THEN
+        ISH  = ISH0
+      ELSE
+        ISH  = 0
+      ENDIF
+C     PRINT OPTION:
+C     ISHSUB=IJMN, IJ SPECIFIES LOCATION WHERE ISH=MN.
+C     IJ=01: SR JCLUDE
+C     IJ=02: SR JETGEN
+C     IJ=03: SR JFRADE, STARTING BEFORE FRAGMENTATION
+C     IJ=04: SR JDECAY
+C     IJ=05: SR JDECAX
+C     IJ=06: SR NUCOLL
+C     IJ=07: SR NUCOGE+-
+C     IJ=08: SR ASTORE
+C     IJ=09: SR JFRADE, STARTING AFTER FRAGMENTATION
+C     IJ=10: SR JFRADE, STARTING BEFORE DECAY
+C     IJ=11: SR JFRADE, STARTING AFTER INTERACTIONS
+C     IJ=12: SR JCENTR, ENTRO() IN DATA FORMAT
+C     IJ=13: SR JCENTP
+C     IJ=14: SR JDECAX IF CLUSTER DECAY
+C     IJ=15: SR JSPLIT
+C     IJ=16: SR JFRADE
+C     IJ=17: SR RACPRO
+C     IJ=18: SR UTCLEA
+C     IJ=19: SR JINTA1, JINTA2, AFTER CALL UTCLEA
+C     IJ=20: SR JDECAS
+C     IJ=21: SR JDECAS (WITHOUT JDECAX)
+         ISHSUB=0
+C     PRINT OPTION:
+C     IF ISHEVT.NE.0: FOR EVT#.NE.ISHEVT ISH IS SET TO 0
+         ISHEVT=0
+C     PRINT MARKS BETWEEN WHOM ISH IS SET TO ISH(INIT):
+         IPAGI=0
+C     VERIFY OPTION FOR INPUT READING:
+         IVI=1
+C     MAXIMUM IMPACT PARAMETER (BMAXIM=0=>CENTRAL):
+         BMAXIM=10000.
+C     MINIMUM IMPACT PARAMETER:
+         BMINIM=0.
+C     STORE ONLY STABLE PTL (0) OR ALSO PARENTS (1):
+         ISTMAX=0
+C     RANDOM GENERATOR SEED
+         SEEDI=ISEED(1,1)
+         SEEDC=ISEED(2,1)+1.D9*ISEED(3,1)
+C     SUPPRESSION (1) OR NOT OF MESSAGES
+         ISUP=0
+C     SUPPRESSION OF CALLING JFRADE (0). JFRADE=FRAGM+DECAY+RESCATTERING
+         IFRADE=1
+C..   DECAY SUPPRESSION. NDECAY SPECIFIES WHICH RESONANCES ARE NOT DECAY
+C..   0000001 : ALL RESONANCES
+C..   0000010 : K_SHORT/LONG (+-20)
+C..   0000100 : LAMBDA (+-2130)
+C..   0001000 : SIGMA (+-1130,+-2230)
+C..   0010000 : CASCADE (+-2330,+-1330)
+C..   0100000 : OMEGA (+-3331)
+C..   1000000 : PI0 (110)
+         NDECAY=1111110
+C..   DECAY SUPPRESSION. NDECAX SPECIFIES WHICH RESONANCES ARE NOT DECAY
+C..   0000001 : JPSI
+C..   0000010 : K_ZERO (+-230)
+C..   0000100 : DELTA (+-1111,+-1121,+-1221,+-2221)
+C..   0001000 : RHO,OMEGA,PHI (111,+-121,221,331)
+C..   0010000 : ETA (220)
+C..   0100000 : ETAPRIME (330)
+C..   1000000 : A0 (112), A+- (+-122)
+         NDECAX=0010000
+C..   DECAY SUPPRESSION. NDECAW SPECIFIES WHICH RESONANCES ARE NOT DECAY
+C..   0000001 : F0 (332)
+C..   0000010 : K* (+-131,+-231)
+         NDECAW=0
+C     FILL ZZZZ HISTOGRAMS (1) OR NOT (0)
+C        IWZZZZ=0
+C     FILL INTERMITTENCY HISTOGRAMS (1) OR NOT (0)
+C        IMIHIS=0
+C     FILL SPACE-TIME HISTOGRAMS (1) OR NOT (0)
+         ISPHIS=0
+C     FILL CLUSTER HISTOGRAMS (1) OR NOT (0)
+C        ICLHIS=0
+C     FILL JPSI HISTOGRAMS (1) OR NOT (0)
+C        IJPHIS=0
+C     RHO/RHO+PHI RATIO
+         RHOPHI=0.5
+C     WSPA: ALL PTLS (1) OR ONLY INTERACTING PTLS (ELSE)
+         ISPALL=1
+C     TMIN IN WSPA
+         WTMINI=-3.0
+C     T-STEP IN WSPA
+         WTSTEP=1.0
+C     ONLY CENTRAL POINT (1) OR LONGITUDINAL DISTRIBUTION (ELSE) IN WSPA
+         IWCENT=0
+C     QUARK MASSES
+         SMAS=0.
+         UUMAS=0.
+         USMAS=0.
+         SSMAS=0.
+ 
+C  CONSTANTS (PROTON MASS, PION MASS, PI, INFINITE)
+C  ---------
+C     PROM=0.94
+      PROM=PAMA(14)
+C     PIOM=0.14
+      PIOM=PAMA(8)
+      PI=3.141592654
+      AINFIN=1.E+30
+ 
+C  INITIALIZATIONS
+C  ---------------
+      LAPROJ=0
+      MAPROJ=0
+      LATARG=0
+      MAPROJ=0
+      IDPROJ=1120
+      IDTARG=1120
+      DO 6 I=1,99
+        PROB(I)=0.
+        ICBAC(I,1)=0
+        ICBAC(I,2)=0
+        ICFOR(I,1)=0
+        ICFOR(I,2)=0
+ 6    CONTINUE
+      PNLL=0.
+ 
+C  FEW INITIALIZATIONS FOR CROSS SECTION CALCULATIONS
+C  --------------------------------------------------
+ 
+      IMSG=0
+      JERR=0
+      NTEVT=0
+      NREVT=0
+      NAEVT=0
+      NRSTR=0
+      NRPTL=0
+      INOIAC=0
+      ILAMAS=0
+      NPTLU=0
+      DO 44 ITAU = 1,MXTAU
+        VOLSUM(ITAU)=0.
+        VO2SUM(ITAU)=0.
+        NCLSUM(ITAU)=0
+ 44   CONTINUE
+      DO 43 IEPS=1,MXEPS
+        DO 43 IVOL=1,MXVOL
+          DO 43 ITAU=1,MXTAU
+            CLUST(ITAU,IVOL,IEPS) = 0.
+ 43   CONTINUE
+      IUTOTC=0
+      IUTOTE=0
+ 
+      IF ( NPARAM .GT. 0 ) THEN
+        DO 3 N=1,NPARAM
+          CALL UTLOW6(PARCHA(N))
+          IF ( DEBUG ) WRITE(MDEBUG,*) PARCHA(N),PARVAL(N)
+          IF    (PARCHA(N).EQ.'AMPRIF')THEN
+                                       AMPRIF=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'AMSIAC')THEN
+                                       AMSIAC=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'AMUSEG')THEN
+                                       AMUSEG=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'ANGMUE')THEN
+                                       ANGMUE=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'BAG4RT')THEN
+                                       BAG4RT=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'BMAXIM')THEN
+                                       BMAXIM=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'BMINIM')THEN
+                                       BMINIM=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'CORE  ')THEN
+                                       CORE  =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'CORLEN')THEN
+                                       CORLEN=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'CUTMSQ')THEN
+                                       CUTMSQ=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'CUTMSS')THEN
+                                       CUTMSS=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'DELEPS')THEN
+                                       DELEPS=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'DELMSS')THEN
+                                       DELMSS=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'DELREM')THEN
+                                       DELREM=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'DELVOL')THEN
+                                       DELVOL=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'ELEPTI')THEN
+                                       ELEPTI=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'ELEPTO')THEN
+                                       ELEPTO=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'EPSCRI')THEN
+                                       EPSCRI=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'FCTRMX')THEN
+                                       FCTRMX=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'GAUMX ')THEN
+                                       GAUMX =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'GRICEL')THEN
+                                       GRICEL=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'GRIDEL')THEN
+                                       GRIDEL=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'GRIGAM')THEN
+                                       GRIGAM=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'GRIRSQ')THEN
+                                       GRIRSQ=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'GRISLO')THEN
+                                       GRISLO=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'IAQU  ')THEN
+                                       IAQU  =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'ICLHIS')THEN
+                                       ICLHIS=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'IDPM  ')THEN
+                                       IDPM  =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'IENTRO')THEN
+                                       IENTRO=NINT(PARVAL(N))
+          ELSEIF(PARCHA(N).EQ.'IFRADE')THEN
+                                       IFRADE=NINT(PARVAL(N))
+          ELSEIF(PARCHA(N).EQ.'IJPHIS')THEN
+                                       IJPHIS=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'IMIHIS')THEN
+                                       IMIHIS=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'IOJINT')THEN
+                                       IOJINT=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'IOPBRK')THEN
+                                       IOPBRK=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'IOPENT')THEN
+                                       IOPENT=PARVAL(N)
+                                       IOPENT = MOD(IOPENT,10)
+          ELSEIF(PARCHA(N).EQ.'IOPENU')THEN
+                                       IOPENU=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'IOPTF ')THEN
+                                       IOPTF =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'IOPTQ ')THEN
+                                       IOPTQ =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'IPAGI ')THEN
+                                       IPAGI =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'IRESCL')THEN
+                                       IRESCL=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'ISH   ')THEN
+                                       ISH   =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'ISHEVT')THEN
+                                       ISHEVT=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'ISHSUB')THEN
+                                       ISHSUB=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'ISPALL')THEN
+                                       ISPALL=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'ISPHIS')THEN
+                                       ISPHIS=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'ISTMAX')THEN
+                                       ISTMAX=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'ISUP  ')THEN
+                                       ISUP  =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'IVERSN')THEN
+                                       IVERSN=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'IVI   ')THEN
+                                       IVI   =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'IWCENT')THEN
+                                       IWCENT=NINT(PARVAL(N))
+          ELSEIF(PARCHA(N).EQ.'IWZZZZ')THEN
+                                       IWZZZZ=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'JPSI  ')THEN
+                                       JPSI  =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'JPSIFI')THEN
+                                       JPSIFI=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'KENTRO')THEN
+                                       KENTRO=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'KO1KO2')THEN
+                                       KO1KO2=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'KUTDIQ')THEN
+                                       KUTDIQ=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'LABSYS')THEN
+                                       LABSYS=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'MAXRES')THEN
+                                       MAXRES=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'NCLEAN')THEN
+                                       NCLEAN=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'NCOLMX')THEN
+                                       NCOLMX=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'NDECAW')THEN
+                                       NDECAW=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'NDECAX')THEN
+                                       NDECAX=NINT(PARVAL(N))
+          ELSEIF(PARCHA(N).EQ.'NDECAY')THEN
+                                       NDECAY=NINT(PARVAL(N))
+          ELSEIF(PARCHA(N).EQ.'NEQMN ')THEN
+                                       NEQMN =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'NEQMX ')THEN
+                                       NEQMX =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'NSTTAU')THEN
+                                       NSTTAU=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'NTRYMX')THEN
+                                       NTRYMX=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'NUMTAU')THEN
+                                       NUMTAU=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'OVERLP')THEN
+                                       OVERLP=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PAREA ')THEN
+                                       PAREA =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PDIQUA')THEN
+                                       PDIQUA=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PISPN ')THEN
+                                       PISPN =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PROSEA')THEN
+                                       PROSEA=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PSPINH')THEN
+                                       PSPINH=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PSPINL')THEN
+                                       PSPINL=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PTF   ')THEN
+                                       PTF   =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PTH   ')THEN
+                                       PTH   =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PHARD ')THEN
+                                       PHARD =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PTMX  ')THEN
+                                       PTMX  =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PTQ1  ')THEN
+                                       PTQ1  =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PTQ2  ')THEN
+                                       PTQ2  =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PTQ3  ')THEN
+                                       PTQ3  =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PUD   ')THEN
+                                       PUD   =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'PVALEN')THEN
+                                       PVALEN=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'QMUST ')THEN
+            CALL UTSTOP('VENINI: *** QMUST NOT USED ANYMORE! *** ')
+          ELSEIF(PARCHA(N).EQ.'QMUST1')THEN
+                                       QMUST1=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'QMUST2')THEN
+                                       QMUST2=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'QMUST3')THEN
+                                       QMUST3=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'RADIAC')THEN
+                                       RADIAC=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'RADIAS')THEN
+                                       RADIAS=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'RHOPHI')THEN
+                                       RHOPHI=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'RSTRAS')THEN
+                                       RSTRAS=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'SEEDI ')THEN
+                                       SEEDI =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'SIGJ  ')THEN
+                                       SIGJ  =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'SIGPPI')THEN
+                                       SIGPPI=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'SMAS  ')THEN
+                                       SMAS  =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'SSMAS ')THEN
+                                       SSMAS =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'TAUMAX')THEN
+                                       TAUMAX=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'TAUMIN')THEN
+                                       TAUMIN=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'TAUMX ')THEN
+                                       TAUMX =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'TAUNLL')THEN
+                                       TAUNLL=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'TAUREA')THEN
+                                       TAUREA=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'TENSN ')THEN
+                                       TENSN =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'THEMAS')THEN
+                                       THEMAS=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'UENTRO')THEN
+                                       UENTRO=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'USMAS ')THEN
+                                       USMAS =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'UUMAS ')THEN
+                                       UUMAS =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'WPROJ ')THEN
+                                       WPROJ =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'WTARG ')THEN
+                                       WTARG =PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'WTMINI')THEN
+                                       WTMINI=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'WTSTEP')THEN
+                                       WTSTEP=PARVAL(N)
+          ELSEIF(PARCHA(N).EQ.'YMXIMI')THEN
+                                       YMXIMI=PARVAL(N)
+          ENDIF
+ 3      CONTINUE
+      ENDIF
+ 
+      IF ( ISPHIS .EQ. 1 ) LABSYS = 0
+      IF ( IDPM .EQ. 1 ) THEN
+        IAQU = 0
+        NEQMN = 2
+        NEQMX = 3
+      ENDIF
+      IF ( IOPENU .EQ. 2 ) THEN
+        CALL SMASSI(THEMAS)
+        IF ( ISH .EQ. 19 ) THEN
+          CALL SMASSP
+          CALL UTSTOP(' VENLNK:                                ')
+        ENDIF
+      ENDIF
+ 
+      IF ( IOJINT .EQ. 2 ) THEN
+        IF     ( EPSCRI .LT. 0. ) THEN
+          RADIAC = 0.
+          RADIAS = 0.
+        ELSEIF ( EPSCRI .GT. 0. ) THEN
+          VOLBAR = PROM/EPSBAR*PI*0.25
+CDH       RADIAC = (VOLBAR*0.5/PI)**0.3333333
+          VOLMES = 0.455/EPSCRI*PI*0.25
+CDH       RADIAS = (VOLMES*0.5/PI)**0.3333333
+        ELSE
+          CALL UTSTOP('EPSCRI MUST NOT BE 0.                   ')
+        ENDIF
+      ENDIF
+ 
+      CALL JDECIN(.FALSE.)
+C  INITIALIZE ALL PT DISTRIBUTIONS
+      CX = PTMX
+      QUAMA = 0.
+      IF ( IOPTF .EQ. 1 ) THEN
+        ROOT  = SQRT(PTMX**2+QUAMA**2)
+        AUXIL = 2./PTF
+        BPTFU = +0.25*PTF**2*EXP(-AUXIL*QUAMA)*(AUXIL*QUAMA+1.)
+        FPTFU = -0.25*PTF**2*EXP(-AUXIL*ROOT)*(AUXIL*ROOT+1.)+BPTFU
+        CALL UTQUAF(SPTF,NPTF,XPTF,QPTFU,0.,.33*CX,.66*CX,CX)
+C       DO 199 N=1,NPTF
+C         WRITE(IFCH,*)'N,X,Q=',N,XPTF(N),QPTFU(N)
+C199    CONTINUE
+      ELSE
+        AUXIL = 0.25*PI/PTF**2
+        BPTFU = +EXP(-AUXIL* QUAMA**2)*0.5/AUXIL
+        FPTFU = -EXP(-AUXIL*(QUAMA**2+PTMX**2))*0.5/AUXIL+BPTFU
+      ENDIF
+ 
+      QUAMA = SMAS
+      IF ( QUAMA .NE. 0. ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          ROOT  = SQRT(PTMX**2+SMAS**2)
+          AUXIL = 2./PTF
+          BPTFS = +0.25*PTF**2*EXP(-AUXIL*SMAS)*(AUXIL*SMAS+1.)
+          FPTFS = -0.25*PTF**2*EXP(-AUXIL*ROOT)*(AUXIL*ROOT+1.)+BPTFS
+          CALL UTQUAF(SPTF,NPTF,XPTF,QPTFS,0.,.33*CX,.66*CX,CX)
+        ELSE
+          AUXIL = 0.25*PI/PTF**2
+          BPTFS = +EXP(-AUXIL* SMAS**2)*0.5/AUXIL
+          FPTFS = -EXP(-AUXIL*(SMAS**2+PTMX**2))*0.5/AUXIL+BPTFS
+        ENDIF
+      ELSE
+        DO 201 N = 1,NPTF
+          QPTFS(N) = QPTFU(N)
+ 201    CONTINUE
+        FPTFS = FPTFU
+      ENDIF
+ 
+      QUAMA = UUMAS
+      IF ( QUAMA .NE. 0. ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          ROOT   = SQRT(PTMX**2+UUMAS**2)
+          AUXIL  = 2./PTF
+          BPTFUU = +0.25*PTF**2*EXP(-AUXIL*UUMAS)*(AUXIL*UUMAS+1.)
+          FPTFUU = -0.25*PTF**2*EXP(-AUXIL*ROOT)*(AUXIL*ROOT+1.)+BPTFUU
+          CALL UTQUAF(SPTF,NPTF,XPTF,QPTFUU,0.,.33*CX,.66*CX,CX)
+        ELSE
+          AUXIL  = 0.25*PI/PTF**2
+          BPTFUU =  EXP(-AUXIL* UUMAS**2)*0.5/AUXIL
+          FPTFUU = -EXP(-AUXIL*(UUMAS**2+PTMX**2))*0.5/AUXIL+BPTFUU
+        ENDIF
+      ELSE
+        DO 202 N = 1,NPTF
+          QPTFUU(N) = QPTFU(N)
+ 202    CONTINUE
+        FPTFUU = FPTFU
+      ENDIF
+ 
+      QUAMA = USMAS
+      IF ( QUAMA .NE. 0. ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          ROOT   = SQRT(PTMX**2+USMAS**2)
+          AUXIL  = 2./PTF
+          BPTFUS =  0.25*PTF**2*EXP(-AUXIL*USMAS)*(AUXIL*USMAS+1.)
+          FPTFUS = -0.25*PTF**2*EXP(-AUXIL*ROOT)*(AUXIL*ROOT+1.)+BPTFUS
+          CALL UTQUAF(SPTF,NPTF,XPTF,QPTFUS,0.,.33*CX,.66*CX,CX)
+        ELSE
+          AUXIL  = 0.25*PI/PTF**2
+          BPTFUS =  EXP(-AUXIL* USMAS**2)*0.5/AUXIL
+          FPTFUS = -EXP(-AUXIL*(USMAS**2+PTMX**2))*0.5/AUXIL+BPTFUS
+        ENDIF
+      ELSE
+        DO 203 N = 1,NPTF
+          QPTFUS(N) = QPTFU(N)
+ 203    CONTINUE
+        FPTFUS = FPTFU
+      ENDIF
+ 
+      QUAMA = SSMAS
+      IF ( QUAMA .NE. 0. ) THEN
+        IF ( IOPTF .EQ. 1 ) THEN
+          ROOT   = SQRT(PTMX**2+SSMAS**2)
+          AUXIL  = 2./PTF
+          BPTFSS = +0.25*PTF**2*EXP(-AUXIL*SSMAS)*(AUXIL*SSMAS+1.)
+          FPTFSS = -0.25*PTF**2*EXP(-AUXIL*ROOT)*(AUXIL*ROOT+1.)+BPTFSS
+          CALL UTQUAF(SPTF,NPTF,XPTF,QPTFSS,0.,.33*CX,.66*CX,CX)
+        ELSE
+          AUXIL  = 0.25*PI/PTF**2
+          BPTFSS =  EXP(-AUXIL* SSMAS**2)*0.5/AUXIL
+          FPTFSS = -EXP(-AUXIL*(SSMAS**2+PTMX**2))*0.5/AUXIL+BPTFSS
+        ENDIF
+      ELSE
+        DO 204 N = 1,NPTF
+          QPTFSS(N) = QPTFU(N)
+ 204    CONTINUE
+        FPTFSS = FPTFU
+      ENDIF
+ 
+C  INITIALIZE FUNCTIONS FOR JPSI GENERATION
+      IF ( JPSI .EQ. 1 ) THEN
+        CX = GAUMX
+        CALL UTQUAF(SGAU,NGAU,XGAU,QGAU,0.,.33*CX,.66*CX,CX)
+        CX = PTMX
+        CALL UTQUAF(SPTJ,NPTJ,XPTJ,QPTJ,0.,.33*CX,.66*CX,CX)
+      ENDIF
+ 
+C INITIALIZE DENSITY DISTRIBUTION INTEGRALS FOR NITROGEN, OXYGEN, ARGON
+      MASSNR = 14.
+      R0 = 1.19*MASSNR**(.3333333) -1.61*MASSNR**(-.3333333)
+      CX = R0+FCTRMX*0.54
+      RMTARG(1) = CX
+      CALL UTQUAF(SDENSI,NDET,XDET14,QDET14,0.,.33*CX,.66*CX,CX)
+ 
+      MASSNR = 16.
+      R0 = 1.19*MASSNR**(.3333333) -1.61*MASSNR**(-.3333333)
+      CX = R0+FCTRMX*0.54
+      RMTARG(2) = CX
+      CALL UTQUAF(SDENSI,NDET,XDET16,QDET16,0.,.33*CX,.66*CX,CX)
+ 
+      MASSNR = 40.
+      R0 = 1.19*MASSNR**(.3333333) -1.61*MASSNR**(-.3333333)
+      CX = R0+FCTRMX*0.54
+      RMTARG(3) = CX
+      CALL UTQUAF(SDENSI,NDET,XDET40,QDET40,0.,.33*CX,.66*CX,CX)
+ 
+C  QDET99 AND XDET99 ARE NOT INITIALIZED
+      MTAR99 = 0
+ 
+      OPEN(UNIT=14,FILE='VENUSDAT',STATUS='OLD')
+      READ(14,*)(IDUMMY, XVA(I), QVAH(I), QVAPI(I), I=1,2049)
+      CLOSE(UNIT=14)
+ 
+      WRITE(IFMT,105) FLOAT(IVERSN)/1000.
+ 105  FORMAT(
+     * ' !-----------------------------------------------------!'
+     */' !      V(ERY) E(NERGETIC) NU(CLEAR) S(CATTERING)      !'
+     */' !      VENUS',F6.3,5X,'-          K. WERNER           !'
+     */' !      SUBROUTINE TURBOVERSION    D. HECK             !'
+     */' !-----------------------------------------------------!')
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/venlnk.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/venlnk.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/venlnk.f	(revision 286)
@@ -0,0 +1,501 @@
+      SUBROUTINE VENLNK
+ 
+C-----------------------------------------------------------------------
+C  VEN(US) L(I)NK (TO CORSIKA)
+C
+C  LINKS VENUS PACKAGE TO CORSIKA, NEEDS FIRST CALL OF VENINI
+C  THIS SUBROUTINE IS CALLED FROM SDPM
+C
+C  DESIGN   : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+*KEEP,INTER.
+      COMMON /INTER/   AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
+     *                 IDIF,ITAR
+      DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
+      INTEGER          IDIF,ITAR
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,REST.
+      COMMON /REST/    CONTNE,TAR,LT
+      DOUBLE PRECISION CONTNE(3),TAR
+      INTEGER          LT
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,VENUS.
+      COMMON /VENUS/   ISH0,IVERVN,MTAR99,FVENUS,FVENSG
+      INTEGER          ISH0,IVERVN,MTAR99
+      LOGICAL          FVENUS,FVENSG
+*KEND.
+ 
+      PARAMETER (KOLLMX=2500)
+      PARAMETER (MXEPS=10)
+      PARAMETER (NDEP=129)
+      PARAMETER (NDET=129)
+      PARAMETER (NPRBMS=20)
+      PARAMETER (NPTQ=129)
+      PARAMETER (NSTRU=2049)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CDEN/    MASSNR,RMX,R0
+      COMMON /CIPIO/   IPIO
+      COMMON /CNSTA/   AINFIN,PI,PIOM,PROM
+      COMMON /COL/     BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
+     *                ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
+     *                ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
+     *                ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
+     *                ,XDET99(NDET)
+     *                ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
+     *                ,NRTARG(KOLLMX),NTARG
+      COMMON /CPRBMS/  PRBMS(NPRBMS)
+      COMMON /CPTQ/    QPTH(NPTQ),QPTQ(NPTQ),XPTQ(NPTQ),QPTQMX,QPTHMX
+      DOUBLE PRECISION SEEDC,SEEDI
+      COMMON /CSEED/   SEEDC,SEEDI
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /NEVNT/   NEVNT
+      COMMON /PARO1/   AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
+     *                ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
+     *                ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
+     *                ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
+     *                ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
+     *                ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
+     *                ,WTSTEP,XCUT
+     *                ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
+     *                ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
+     *                ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
+     *                ,NSTTAU,NTRYMX,NUMTAU
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /PARO3/   ASUHAX(7),ASUHAY(7),OMEGA,SIGPPD,SIGPPE,UENTRO
+     *                ,IWZZZZ
+      COMMON /PARO4/   GRICEL,GRIDEL,GRIGAM,GRIRSQ,GRISLO
+      COMMON /PARO5/   DELEPS,DELVOL
+      COMMON /QUARKM/  SMAS,SSMAS,USMAS,UUMAS
+      COMMON /STRU/    QSEP(NSTRU),QSET(NSTRU),QVAP(NSTRU)
+     *                ,QVAT(NSTRU),XCUTAR,XSTRU(NSTRU)
+     *                ,IDTG
+      COMMON /STRU2/   DELTA0,DELTA1,QSEH(NSTRU),QSEPI(NSTRU)
+     *                ,QVAH(NSTRU),QVAPI(NSTRU),XSE(NSTRU),XVA(NSTRU)
+ 
+      DOUBLE PRECISION ERRER,VALUE
+      INTEGER          IFLAG
+ 
+      COMMON /VENLIN/  PTQ1,PTQ2,PTQ3,QMUST1,QMUST2,QMUST3
+     *                ,IDTABL(100)
+ 
+      EXTERNAL         SDENSI,SPTQ,SSE0,SVA0,SVA1
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'VENLNK: TAR',SNGL(TAR)
+ 
+      NSTRUC = NSTRU
+      IF ( DEBUG ) THEN
+        ISH  = ISH0
+      ELSE
+        ISH  = 0
+      ENDIF
+      NEVNT = SHOWNO
+C  SET RANDOM NUMBER GENERATOR STATUS
+      SEEDC=ISEED(2,1)+1.D9*ISEED(3,1)
+C  CALCULATE ENERGY IN LAB SYSTEM FOR ELASTICITY FOR VARIOUS PROJECTILES
+      IF     ( ITYPE .EQ. 1 ) THEN
+C  TREAT PHOTON PROJECTILES (FROM EGS)
+        CALL RMMAR(RD,1,1)
+        IF ( RD(1) .LE. 0.5 ) THEN
+          ITYPE = 7
+        ELSE
+          ITYPE = 17
+        ENDIF
+        ELAB  = CURPAR(2)
+        CURPAR(2) = ELAB / PAMA(ITYPE)
+      ELSEIF ( ITYPE .LT. 100 ) THEN
+C  TREAT ORDINARY PROJECTILES
+        ELAB  = CURPAR(2) * PAMA(ITYPE)
+      ELSE
+C  TREAT NUCLEI PROJECTILES
+        NPROT = MOD(ITYPE,100)
+        NNEUT = ITYPE/100 - NPROT
+        ELAB  = CURPAR(2) * ( PAMA(14)*NPROT + PAMA(13)*NNEUT )
+      ENDIF
+C  SET TARGET PARAMETERS
+      MATARG = NINT(TAR)
+      IDTARG = 1120
+      AMTARG = PAMA(14)
+      IF     ( TAR. EQ. 14.D0 ) THEN
+        LTARG  = 1
+        LATARG = 7
+      ELSEIF ( TAR .EQ. 16.D0 ) THEN
+        LTARG  = 2
+        LATARG = 8
+      ELSEIF ( TAR .EQ. 40.D0 ) THEN
+        LTARG  = 3
+        LATARG = 18
+      ELSE
+        WRITE(MONIOU,*)'VENLNK: UNDEFINED TARGET TAR=',SNGL(TAR)
+      ENDIF
+ 
+C  FOR THE CASE OF AN ARBITRARY TARGET (NOT AIR)
+      IF ( LTARG .GT. 3 ) THEN
+        MASSNR = MATARG
+        IF ( MASSNR .GT. 1 ) THEN
+          IF ( MASSNR .NE. MTAR99 ) THEN
+            R0 = 1.19*MASSNR**(.3333333) -1.61*MASSNR**(-.3333333)
+            CX = R0+FCTRMX*0.54
+            RMTARG(4) = CX
+            CALL UTQUAF(SDENSI,NDET,XDET99,QDET99,0.,.33*CX,.66*CX,CX)
+            MTAR99 = MATARG
+          ENDIF
+        ELSE
+          RMTARG(4) = 0.
+        ENDIF
+      ENDIF
+ 
+C  SET PROJECTILE PARAMETERS
+      IF ( ITYPE .LT. 100 ) THEN
+        IDPROJ = IDTABL(ITYPE)
+        IF     ( IDPROJ .EQ. 20  .OR.  IDPROJ .EQ. -20 ) THEN
+C  TREAT NEUTRAL KAONS  (K(0)S AND K(0)L)
+          CALL RMMAR(RD,1,1)
+          IF ( RD(1) .LE. 0.5 ) THEN
+            IDPROJ = 230
+          ELSE
+            IDPROJ = -230
+          ENDIF
+        ELSEIF ( IDPROJ .EQ. 2130 ) THEN
+C  VENUS CANNOT TREAT LAMBDA, TAKE INSTEAD SIGMA(0))
+          IDPROJ = 1230
+        ELSEIF ( IDPROJ .EQ. -2130 ) THEN
+C  VENUS CANNOT TREAT ANTI-LAMBDA, TAKE INSTEAD ANTI-SIGMA(0))
+          IDPROJ = -1230
+        ENDIF
+C  ALL OTHER PARTICLE CODES UNCHANGED
+        CALL IDMASS(IDPROJ,AMPROJ)
+        LAPROJ = -1
+        MAPROJ = 1
+        PNLL   = CURPAR(2)*AMPROJ
+      ELSE
+C  PROJECTILE IS NUCLEUS
+        IDPROJ = 1120
+        CALL IDMASS(IDPROJ,AMPROJ)
+        LAPROJ = MOD(ITYPE,100)
+        MAPROJ = ITYPE/100
+        PNLL   = CURPAR(2)*(PAMA(14)+PAMA(13))*0.5
+      ENDIF
+ 
+      IF ( ABS(IDPROJ) .LT. 1000 ) THEN
+        IF ( ABS(IDPROJ) .EQ. 230  .OR.  ABS(IDPROJ) .EQ. 130 ) THEN
+C  DIFFRACTIVE PROBABILITY FOR KAON PROJECTILES
+          WPROJ = 0.24
+        ELSE
+C  DIFFRACTIVE PROBABILITY FOR PION PROJECTILES
+          WPROJ = 0.20
+        ENDIF
+      ELSE
+C  DIFFRACTIVE PROBABILITY FOR BARYON PROJECTILES
+        WPROJ = 0.32
+      ENDIF
+C  DIFFRACTIVE PROBABILITY FOR TARGET (ALWAYS NUCLEONS)
+      WTARG = 0.32
+ 
+      ENGY = SQRT( 2.*SQRT(PNLL**2+AMPROJ**2)*AMTARG+AMTARG**2
+     *                     +AMPROJ**2 )
+      IF ( DEBUG ) WRITE(MDEBUG,*)'VENLNK: ELAB = ',PNLL,
+     *                                   ' ENGY = ',ENGY
+CDH   IF ( ENGY .LT. 12. ) THEN
+      IF ( ENGY .LT. 9.5 ) THEN
+        WRITE (IFMT,*)'VENLNK: ENGY, IDPROJ=',ENGY,IDPROJ
+        CALL UTSTOP('VENLNK: INCIDENT ENERGY TOO SMALL       ')
+      ENDIF
+      ENGYI = ENGY
+      PNLLI = PNLL
+      IF ( PNLL .LT. 1.E2 * AMPROJ ) THEN
+        TRM  = SQRT(PNLL**2+AMPROJ**2)
+        ENGY = SQRT((TRM+AMTARG-PNLL)*(TRM+AMTARG+PNLL))
+      ELSE
+        TRM  = AMPROJ**2*0.5/PNLL+AMTARG
+        ENGY = SQRT(TRM*(2.*PNLL+TRM))
+      ENDIF
+      D1 = ABS(PNLLI-PNLL)/PNLL
+      D2 = ABS(ENGYI-ENGY)/ENGY
+      IF ( D1 .GT. 1.E-3  .OR.  D2 .GT. 1.E-3 ) THEN
+        IF ( ISH .GE. 0 ) THEN
+          CALL UTMSG('VENLNK')
+          WRITE(IFCH,*)'*****  PNLL,PNLLI:',PNLL,PNLLI
+          WRITE(IFCH,*)'*****  ENGY,ENGYI:',ENGY,ENGYI
+          CALL UTMSGF
+        ENDIF
+      ENDIF
+      S = ENGY**2
+      SROOTI = 1./ENGY
+      PNLLX = UTPCM(ENGY,AMPROJ,AMTARG)
+      YHAHA = LOG((SQRT(PNLL**2+S)+PNLL)/ENGY)
+      YPJTL = LOG((SQRT(PNLL**2+AMPROJ**2)+PNLL)/AMPROJ)
+      IF ( ISH .GE. 91 ) WRITE(IFCH,*)'VENLNK: YPJTL=',YPJTL
+ 
+      ENGYLG = LOG(ENGY)
+      QMUST = QMUST1+QMUST2*ENGYLG+QMUST3*ENGYLG**2
+      PTQ = PTQ1+PTQ2*ENGYLG+PTQ3*ENGYLG**2
+CDH   PHARD = 0.030+0.12*(LOG10(S)-LOG10(30.**2))
+      PHARD = 0.030+0.12*(LOG10(S)-2.9542425)
+      PHARD = MIN(1.,PHARD)
+      PHARD = MAX(0.030,PHARD)
+ 
+C  PROJECTILE
+      XCUT  = CUTMSQ*SROOTI
+      XCUT2 = XCUT**2
+      IF ( ABS(IDPROJ) .GE. 1000 ) THEN
+C  STRUCTURE FUNCTION INTEGRAL FOR BARYONS OF PROJECTILE
+        IPIO = 0
+        CALL UINTEG(VALUE,SSE0,0.D0,1.D0,0.D0,1.D-5,1,ERRER,IFLAG)
+        IF ( IFLAG .GT. 3  .AND.  ISH .GT. 0 )
+     *                      WRITE(IFCH,*)'VENLNK: SSE0:IFLAG=',IFLAG
+        QSEPC = VALUE
+        CALL UINTEG(VALUE,SVA0,0.D0,1.D0,0.D0,1.D-5,1,ERRER,IFLAG)
+        IF ( IFLAG .GT. 3  .AND.  ISH .GT. 0 )
+     *                      WRITE(IFCH,*)'VENLNK: SVA0:IFLAG=',IFLAG
+        QVAPC = VALUE
+      ELSE
+C  STRUCTURE FUNCTION INTEGRAL FOR MESONS OF PROJECTILE
+        IPIO = 1
+        A0 = -5.0 + 6.6666667*XCUT2 - 0.53333333*XCUT2**2
+        A1 =  5.0 - 1.875*XCUT2
+        A2 = -3.3333333 + 0.26666667*XCUT2
+        A3 =  1.25
+        A4 = -0.2
+        ROOT  = SQRT(XCUT2+1.)
+        QSEPC = 0.9*( (1.-XCUT2*A1)*( LOG(1.+ROOT)-LOG(XCUT) )
+     *                   - XCUT*A0 + ROOT*(A0+A1+A2+A3+A4) )
+        CALL UINTEG(VALUE,SVA1,0.D0,1.D0,0.D0,1.D-5,1,ERRER,IFLAG)
+        IF ( IFLAG .GT. 3  .AND.  ISH .GT. 0 )
+     *                      WRITE(IFCH,*)'VENLNK: SVA1:IFLAG=',IFLAG
+        QVAPC = VALUE
+      ENDIF
+      IDTG = IPIO
+ 
+C  TARGET
+      IF ( IDTG .EQ. 1 ) THEN
+        IF ( ABS(IDTARG) .GE. 1000 ) THEN
+C  STRUCTURE FUNCTION INTEGRAL FOR BARYONS OF TARGET
+          IPIO = 0
+          CALL UINTEG(VALUE,SSE0,0.D0,1.D0,0.D0,1.D-5,1,ERRER,IFLAG)
+          IF ( IFLAG .GT. 3  .AND.  ISH .GT. 0 )
+     *                        WRITE(IFCH,*)'VENLNK: SSE0:IFLAG=',IFLAG
+          QSETC = VALUE
+          CALL UINTEG(VALUE,SVA0,0.D0,1.D0,0.D0,1.D-5,1,ERRER,IFLAG)
+          IF ( IFLAG .GT. 3  .AND.  ISH .GT. 0 )
+     *                        WRITE(IFCH,*)'VENLNK: SVA0:IFLAG=',IFLAG
+          QVATC = VALUE
+        ELSE
+          IPIO=1
+          QVATC = QVAPC
+          QSETC = QSEPC
+        ENDIF
+      ELSE
+        IF ( ABS(IDTARG) .GE. 1000 ) THEN
+          IPIO = 0
+          QVATC = QVAPC
+          QSETC = QSEPC
+        ELSE
+C  STRUCTURE FUNCTION INTEGRAL FOR BARYONS OF TARGET
+          IPIO=1
+          A0 = -5.0 + 6.6666667*XCUT2 - 0.53333333*XCUT2**2
+          A1 =  5.0 - 1.875*XCUT2
+          A2 = -3.3333333 + 0.26666667*XCUT2
+          A3 =  1.25
+          A4 = -0.2
+          ROOT  = SQRT(XCUT2+1.)
+          QSETC = 0.9*( (1.-XCUT2*A1)*( LOG(1.+ROOT)-LOG(XCUT) )
+     *                     - XCUT*A0 + ROOT*(A0+A1+A2+A3+A4) )
+          CALL UINTEG(VALUE,SVA1,0.D0,1.D0,0.D0,1.D-5,1,ERRER,IFLAG)
+          IF ( IFLAG .GT. 3  .AND.  ISH .GT. 0 )
+     *                        WRITE(IFCH,*)'VENLNK: SVA1:IFLAG=',IFLAG
+          QVATC = VALUE
+        ENDIF
+      ENDIF
+      IF ( ISH .EQ. 16 .OR. DEBUG ) THEN
+        WRITE(IFCH,301) QVAPC, QSEPC, QVATC, QSETC
+ 301    FORMAT(' VENLNK: QVAPC, QSEPC, QVATC, QSETC=',4(F10.7,2X))
+      ENDIF
+ 
+      IF ( PROSEA .GE. 0. ) THEN
+        QVAPC = 1.0
+        QVATC = 1.0
+        QSEPC = PROSEA
+        QSETC = PROSEA
+      ENDIF
+ 
+      XCUT = CUTMSS*SROOTI
+      XCUTAR = XCUT
+      B = MIN( 0.05, XCUT*500. )
+      A = MIN( 0.2*B, XCUT*100. )
+      PNLLLG = LOG(PNLL)
+      DELTA0 = EXP(-2.791922 - 0.2091742 * PNLLLG)
+      DELTA1 = EXP(-3.885293 - 0.2029558 * PNLLLG)
+      CALL UTQSEA(A,B,1.)
+      IF ( XCUT .LT. 0.04  ) THEN
+        NEND=1.+REAL(NSTRUC)*2./PI*ACOS(1.-2./PI*ACOS(1.-25.*XCUT))
+      ELSE
+        NEND = NSTRUC
+      ENDIF
+ 
+      IF ( ABS(IDPROJ) .GE. 1000 ) THEN
+        IPIO = 0
+        DO 203 N = 1,NSTRUC
+          QSEP(N) = QSEH(N)
+ 203    CONTINUE
+        DO 2031 N = NEND,NSTRUC
+          QVAP(N) = QVAH(N) - DELTA0
+ 2031   CONTINUE
+      ELSE
+        IPIO = 1
+        DO 204 N = 1,NSTRUC
+          QSEP(N) = QSEPI(N)
+ 204    CONTINUE
+        DO 2041 N = NEND,NSTRUC
+          QVAP(N) = QVAPI(N) - DELTA1
+ 2041   CONTINUE
+      ENDIF
+      CALL UTQVAL(QVAP,NEND)
+ 
+      IF ( IDTG .EQ. 0 ) THEN
+        IF ( ABS(IDTARG) .GE. 1000 ) THEN
+          IPIO = 0
+          DO 205 N=1,NSTRUC
+            QSET(N) = QSEP(N)
+            QVAT(N) = QVAP(N)
+ 205      CONTINUE
+        ELSE
+          IPIO = 1
+          DO 209 N = 1,NSTRUC
+            QSET(N) = QSEPI(N)
+ 209      CONTINUE
+          DO 2091 N = NEND,NSTRUC
+            QVAT(N) = QVAPI(N) - DELTA1
+ 2091     CONTINUE
+          CALL UTQVAL(QVAT,NEND)
+        ENDIF
+ 
+      ELSE
+        IF ( ABS(IDTARG) .GE. 1000 ) THEN
+          IPIO = 0
+          DO 210 N = 1,NSTRUC
+            QSET(N) = QSEH(N)
+ 210      CONTINUE
+          DO 2101 N = NEND,NSTRUC
+            QVAT(N) = QVAH(N) - DELTA0
+ 2101     CONTINUE
+          CALL UTQVAL(QVAT,NEND)
+ 
+        ELSE
+          IPIO = 1
+          DO 216 N=1,NSTRUC
+            QSET(N) = QSEP(N)
+            QVAT(N) = QVAP(N)
+ 216      CONTINUE
+        ENDIF
+      ENDIF
+ 
+      IF ( ISH .EQ. 21 ) THEN
+        CALL UTHSEA
+        CALL UTSTOP(' VENLNK:                                ')
+      ENDIF
+ 
+      QPTHMX = 0.5/PTH**2-PTH**2/(2.*(PTH**2+PTMX**2)**2)
+      IF     ( IOPTQ .EQ. 2 ) THEN
+        QPTQMX = 1. - EXP(-PI*PTMX**2/(4.*PTQ**2) )
+      ELSEIF ( IOPTQ .EQ. 3 ) THEN
+        QPTQMX = 1. - PTQ**2/(PTQ**2+PTMX**2)
+      ELSE
+        CX = PTMX
+        CALL UTQUAF(SPTQ,NPTQ,XPTQ,QPTQ,0.,.33*CX,.66*CX,CX)
+      ENDIF
+ 
+      SIGPPI = -1.0
+C  CALCULATE ENERGY DEPENDENT CROSS SECTION FOR BARYONS
+      CALL RACPRO('GRI',QMUST,NPRBMS,PRBMS)
+      IF     ( ABS(IDPROJ) .LE. 120  .OR.  ABS(IDPROJ) .EQ. 220 ) THEN
+C  CROSS SECTION FOR PIONS (OR ETA FOR PHOTONS FROM EGS)
+        SIGPPI = SIGPPI * 0.6667
+      ELSEIF ( ABS(IDPROJ) .EQ. 130  .OR.  ABS(IDPROJ) .EQ. 230 ) THEN
+C  CROSS SECTION FOR KAONS
+        SIGPPI = SIGPPI * 0.5541
+      ENDIF
+ 
+      MASSNR = MAPROJ
+      RMPROJ = 0.
+      IF ( MASSNR .GT. 1 ) THEN
+        R0 = 1.19*MASSNR**(.3333333) -1.61*MASSNR**(-.3333333)
+        CX = R0+FCTRMX*0.54
+        RMPROJ = CX
+        CALL UTQUAF(SDENSI,NDEP,XDEP,QDEP,0.,.33*CX,.66*CX,CX)
+      ENDIF
+ 
+      IF ( IDPM .EQ. 1 ) THEN
+        QSEPC = 0.
+        QSETC = 0.
+      ENDIF
+      BMAX = RMPROJ+RMTARG(LTARG)
+ 
+      IF ( ISH .GE. 91 ) WRITE(IFCH,*)'VENLNK: AVENUS IS NOW CALLED'
+      CALL AVENUS
+ 
+C  NOW BRING PARTICLES TO CORSIKA STACK
+      CALL VSTORE
+ 
+      IF ( ISH .GE. 91 ) WRITE(IFCH,*)'VENLNK: (EXIT)'
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/vhmeso.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/vhmeso.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/vhmeso.f	(revision 286)
@@ -0,0 +1,231 @@
+      SUBROUTINE VHMESO( E,AMASS,ASMASS )
+ 
+C-----------------------------------------------------------------------
+C  (STRANGE) H(EAVY) MESO(N)
+C
+C  HANDLES KAON INITIATED HEAVY MESON AND ITS DECAY INTO 1 KAON AND 2 PI
+C  STRANGE HEAVY MESON EMITTED FORWARD
+C  THIS SUBROUTINE IS CALLED FROM BOX72 AND BOX74
+C  ARGUMENTS:
+C   E      = AVAILABLE ENERGY IN CM
+C   AMASS  = MASS OF STRANGE MESON
+C   ASMASS = MASS TO BE LEFT OVER FOR OTHER PARTICLES
+C-----------------------------------------------------------------------
+ 
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*KEEP,BAL.
+      COMMON /BAL/     EBAL
+      DOUBLE PRECISION EBAL(10)
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,KAONS.
+      COMMON /KAONS/   CKA
+      DOUBLE PRECISION CKA(80)
+*KEEP,MULT.
+      COMMON /MULT/    EKINL,MSMM,MULTMA,MULTOT
+      DOUBLE PRECISION EKINL
+      INTEGER          MSMM,MULTMA(37,13),MULTOT(37,13)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEEP,VKIN.
+      COMMON /VKIN/    BETACM
+      DOUBLE PRECISION BETACM
+*KEND.
+ 
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,201) E,AMASS,ASMASS
+ 201  FORMAT(' VHMESO: E,AMASS,ASMASS=',1P,3E10.4)
+ 
+      EDVH   = 0.D0
+      W      = 0.6D0
+ 
+C  GAMMA AND BETA OF HEAVY MESON IN CM AND LAB
+C  E > AMASS + ASMASS  TO KEEP GHMCM > 1.
+      GVHCM  = (E**2 + AMASS**2 - ASMASS**2) / (2.D0 * E * AMASS)
+      BVHCM  = SQRT(GVHCM**2 - 1.D0) / GVHCM
+      GVHLAB = GCM * GVHCM * (1.D0+BETACM*BVHCM)
+      BVHLAB = SQRT(GVHLAB**2 - 1.D0) / GVHLAB
+ 
+C  DECAY OF HEAVY MESON
+ 
+C  KAON PART
+C  CHOSE LONGITUDINAL MOMENTUM RANDOMLY FROM EXPONENTIAL DISTRIBUTION
+      P      = PCL(CKA(2),W)
+      PT     = PTRANS(DUMMY)
+C  CALCULATE REST OF ENERGY FOR OTHER PARTICLES
+      EDVH   = SQRT( PAMA(ITYPE)**2 + P**2 + PT**2 )
+      RESTE  = AMASS - EDVH
+C  GAMMA AND BETA OF KAON
+      GKAVH  = SQRT( P**2 / PAMA(ITYPE)**2 + 1.D0 )
+      BKAVH  = SQRT(GKAVH**2 - 1.D0) / GKAVH
+C  KAON FORWARD OR BACKWARD ?
+      CALL RMMAR( RD,1,1 )
+      IF ( RD(1) .LT. 0.5 ) THEN
+        GKALAB = GVHLAB * GKAVH * (1.D0+BKAVH*BVHLAB)
+        PACC   = P
+      ELSE
+        GKALAB = GVHLAB * GKAVH * (1.D0-BKAVH*BVHLAB)
+        PACC   = -P
+      ENDIF
+C  GET NEW DIRECTION
+      PLLAB2 = PAMA(ITYPE)**2 * (GKALAB**2 - 1.D0)
+      PLLAB2 = MAX( 1.D-6, PLLAB2 )
+      CTHETA = SQRT( PLLAB2 / (PT**2+PLLAB2) )
+      IF ( CTHETA .GE. C(27) ) THEN
+        CALL RMMAR( RD,1,1 )
+        CALL ADDANG( COSTHE,PHI, CTHETA,RD(1)*PI2, SECPAR(3),SECPAR(4) )
+        IF ( SECPAR(3) .GE. C(29) ) THEN
+          SECPAR(2) = GKALAB
+C  CHARGE ASSIGNMENT
+          SECPAR(1) = CURPAR(1)
+          DO  8  J = 5,8
+            SECPAR(J) = CURPAR(J)
+    8     CONTINUE
+          CALL TSTACK
+        ENDIF
+      ENDIF
+ 
+C  PION PART
+ 
+C  WHAT DECAY MODE ?
+C    NDEC=1 : K,PI0,PI0
+C    NDEC=2 : K,PI+,PI-
+C    NDEC=3 : K,PI-,PI+
+      CALL RMMAR( RD,2,1 )
+      IF ( RD(1) .LT. 0.5 ) THEN
+        NDEC = 1
+      ELSE
+        IF ( RD(2) .LT. 0.5 ) THEN
+          NDEC = 2
+        ELSE
+          NDEC = 3
+        ENDIF
+      ENDIF
+ 
+      IPI = 0
+    2 CONTINUE
+      IPI = IPI + 1
+ 
+C  TRANSVERS MOMENTUM
+      PT = PTRANS(DUMMY)
+      IF ( IPI .EQ. 1 ) THEN
+C  LONGITUDINAL MOMENTUM IS SELECTED FROM EXPONENTIAL DISTRIBUTION
+        P = PCL(C(42),W)
+C  CHARGE ASSIGNMENT
+        IF     ( NDEC .EQ. 1 ) THEN
+          SECPAR(1) = 7.D0
+          PMA = PAMA(7)
+        ELSEIF ( NDEC .EQ. 2 ) THEN
+          PMA = PAMA(8)
+          SECPAR(1) = 8.D0
+        ELSE
+          PMA = PAMA(9)
+          SECPAR(1) = 9.D0
+        ENDIF
+      ELSE
+C  LONGITUDINAL MOMENTUM AS ENERGY IS LEFT
+        P2 = RESTE**2 - PMA**2 - PT**2
+        P  = SQRT(MAX( P2, 0.D0 ))
+        IF     ( NDEC .EQ. 1 ) THEN
+          SECPAR(1) = 7.D0
+        ELSEIF ( NDEC .EQ. 2 ) THEN
+          SECPAR(1) = 9.D0
+        ELSE
+          SECPAR(1) = 8.D0
+        ENDIF
+      ENDIF
+C  REST OF ENERGY FOR OTHER PARTICLES
+      EDVH   = EDVH + SQRT( PMA**2 + P**2 + PT**2 )
+      RESTE  = AMASS - EDVH
+ 
+C  GAMMA AND BETA OF PION
+      GPIVH  = SQRT(P**2/PMA**2 + 1.D0)
+      BEPIVH = SQRT(GPIVH**2 - 1.D0) / GPIVH
+C  FOR FIRST PION CHOSE RANDOMLY WHETHER FORWARD OR BACKWARD
+C  FOR SECOND PION DECIDE ACCORDING TO ACCUMULATED P
+      CALL RMMAR( RD,2,1 )
+      IF ( IPI .EQ. 2 ) THEN
+        IF ( PACC .LT. 0.D0 ) THEN
+          RD(1) = 0.
+        ELSE
+          RD(1) = 1.
+        ENDIF
+      ENDIF
+      IF ( RD(1) .LT. 0.5 ) THEN
+C  BACKWARD PION
+        GPILAB = GVHLAB * GPIVH * (1.D0-BEPIVH*BVHLAB)
+        PACC   = PACC - P
+      ELSE
+C  FORWARD PION
+        GPILAB = GVHLAB * GPIVH * (1.D0+BEPIVH*BVHLAB)
+        PACC   = PACC + P
+      ENDIF
+ 
+      PLLAB2 = PMA**2 * (GPILAB**2 - 1.D0)
+      PLLAB2 = MAX( 1.D-6, PLLAB2 )
+      CTHETA = SQRT( PLLAB2 / (PT**2+PLLAB2) )
+      IF ( CTHETA .GE. C(27) ) THEN
+        CALL ADDANG( COSTHE,PHI, CTHETA,RD(2)*PI2, SECPAR(3),SECPAR(4) )
+        IF ( SECPAR(3) .GE. C(29) ) THEN
+          SECPAR(2) = GPILAB
+          DO 11  J = 5,8
+            SECPAR(J) = CURPAR(J)
+   11     CONTINUE
+          CALL TSTACK
+        ENDIF
+      ENDIF
+ 
+      IF ( IPI .LT. 2  .AND.  RESTE .GT. PMA ) GOTO 2
+ 
+      EBAL(5) = EBAL(5) + RESTE
+      MSMM    = MSMM + IPI
+ 
+      RETURN
+      END
+ 
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/vstore.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/vstore.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/vstore.f	(revision 286)
@@ -0,0 +1,504 @@
+      SUBROUTINE VSTORE
+ 
+C-----------------------------------------------------------------------
+C  V(ENUS PARTICLES) STORE (INTO CORSIKA STACK)
+C
+C  STORES VENUS OUTPUT PARTICLES INTO CORSIKA STACK
+C  THIS SUBROUTINE IS CALLED FROM VENLNK
+C
+C  DESIGN   : D. HECK    IK3  FZK KARLSRUHE
+C-----------------------------------------------------------------------
+ 
+*KEEP,CONST.
+      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
+      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
+*KEEP,DPMFLG.
+      COMMON /DPMFLG/  NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+      INTEGER          NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
+*KEEP,ELADPM.
+      COMMON /ELADPM/  ELMEAN,ELMEAA,IELDPM,IELDPA
+      DOUBLE PRECISION ELMEAN(37),ELMEAA(37)
+      INTEGER          IELDPM(37,13),IELDPA(37,13)
+*KEEP,ELASTY.
+      COMMON /ELASTY/  ELAST,IELIS,IELHM,IELNU,IELPI
+      DOUBLE PRECISION ELAST
+      INTEGER          IELIS(20),IELHM(20),IELNU(20),IELPI(20)
+*KEEP,INTER.
+      COMMON /INTER/   AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
+     *                 IDIF,ITAR
+      DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
+     *                 FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
+     *                 RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
+     *                 WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
+      INTEGER          IDIF,ITAR
+*KEEP,ISTA.
+      COMMON /ISTA/    IFINET,IFINNU,IFINKA,IFINPI,IFINHY
+      INTEGER          IFINET,IFINNU,IFINKA,IFINPI,IFINHY
+*KEEP,MULT.
+      COMMON /MULT/    EKINL,MSMM,MULTMA,MULTOT
+      DOUBLE PRECISION EKINL
+      INTEGER          MSMM,MULTMA(37,13),MULTOT(37,13)
+*KEEP,PAM.
+      COMMON /PAM/     PAMA,SIGNUM
+      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
+*KEEP,PARPAR.
+      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
+     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
+      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
+     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
+      INTEGER          ITYPE,LEVL
+*KEEP,PARPAE.
+      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
+      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
+     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
+     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
+     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
+     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
+     *                 (CURPAR(12),ECM )
+*KEEP,RANDPA.
+      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
+      DOUBLE PRECISION FAC,U1,U2
+      REAL             RD(3000)
+      INTEGER          ISEED(103,10),NSEQ
+      LOGICAL          KNOR
+*KEEP,REST.
+      COMMON /REST/    CONTNE,TAR,LT
+      DOUBLE PRECISION CONTNE(3),TAR
+      INTEGER          LT
+*KEEP,RUNPAR.
+      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
+     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
+     *                 MONIOU,MDEBUG,NUCNUC,
+     *                 CETAPE,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE,
+     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+      COMMON /RUNPAC/  DSN,HOST,USER
+      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
+      REAL             STEPFC
+      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
+     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
+     *                 N1STTR,MDBASE
+      INTEGER          CETAPE
+      CHARACTER*79     DSN
+      CHARACTER*20     HOST,USER
+ 
+      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
+     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
+     *                ,GHEISH,GHESIG
+*KEND.
+ 
+      PARAMETER (KOLLMX=2500)
+      PARAMETER (MXPTL=70000)
+      PARAMETER (MXSTR=3000)
+      PARAMETER (NDEP=129)
+      PARAMETER (NDET=129)
+      COMMON /ACCUM/   AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
+     *                ,NRPTL,NRSTR,NTEVT
+      COMMON /CEVT/    BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
+     *                ,KOLEVT,NEVT,NPJEVT,NTGEVT
+      COMMON /COL/     BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
+     *                ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
+     *                ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
+     *                ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
+     *                ,XDET99(NDET)
+     *                ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
+     *                ,NRTARG(KOLLMX),NTARG
+      COMMON /CPTL/    PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
+     *                ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
+     *                ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
+     *                ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
+      COMMON /CSTR/    PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
+     *                ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
+      COMMON /FILES/   IFCH,IFDT,IFHI,IFMT,IFOP
+      COMMON /PARO2/   AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
+     *                ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
+     *                ,YHAHA,YMXIMI,YPJTL
+     *                ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
+     *                ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
+     *                ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
+     *                ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
+     *                ,MODSHO,NDECAX,NDECAY,NEVENT
+      COMMON /PARO3/   ASUHAX(7),ASUHAY(7),OMEGA,SIGPPD,SIGPPE,UENTRO
+     *                ,IWZZZZ
+ 
+      DOUBLE PRECISION EA,ELASTI,EMAX,GAMMAX,COSTET,PHIV,PL2,PT2,PTM
+      DOUBLE PRECISION PFRX(60),PFRY(60)
+      INTEGER          ITYP(60),NRPTLA(MXPTL)
+C-----------------------------------------------------------------------
+ 
+      IF ( DEBUG ) WRITE(MDEBUG,*) 'VSTORE:'
+ 
+C  NUMBER OF SPECTATORS OF REMAINING NUCLEUS IS NREST
+      NREST = ITYPE/100 - NPJEVT
+      IREST = ITYPE
+      NNEW  = 0
+      INEW  = 0
+      ETOT  = 0.
+ 
+      LEVT  = 1
+      LPTL  = 3
+      NPTLS = 0
+      DO  1 I=1,NPTL
+        NRPTLA(I) = -999
+        IF ( ISTPTL(I) .GT. ISTMAX ) GOTO 1
+        NPTLS = NPTLS+1
+        NRPTLA(I) = NPTLS
+ 1    CONTINUE
+ 
+C  EVENT VARIABLES:
+C     LEVT................... RECORD LABEL (LEVT=1)
+C     NREVT.................. EVENT NUMBER
+C     NPTLS ................. NUMBER OF (STORED!) PARTICLES PER EVENT
+C     BIMEVT ................ IMPACT PARAMETER
+C     KOLEVT,COLEVT ......... REAL/EFFECTIVE # OF COLLISIONS
+C     PMXEVT ................ REFERENCE MOMENTUM
+C     EGYEVT ................ PP CM ENERGY (HAD) OR STRING ENERGY (STR)
+C     NPJEVT,NTGEVT ......... # OF PROJ/TARG PARTICIPANTS
+ 
+      GNU = KOLEVT
+      GNU = COLEVT
+C  SET COORDINATES, WHICH ARE IDENTICAL FOR ALL SECONDARY PARTICLES
+      DO  6 I=5,8
+        SECPAR(I) = CURPAR(I)
+ 6    CONTINUE
+CC    GAMMAX = 0.D0
+      EMAX   = 0.D0
+ 
+C  PARTICLE LOOP
+      DO  5 I=1,NPTL
+        IF ( NRPTLA(I) .LE. 0 ) GOTO 5
+ 
+C  PARTICLE VARIABLES:
+C     LPTL ......... RECORD LABEL (LPTL=3)
+C     NREVT ........ EVENT NUMBER
+C     NRPTL ........ PARTICLE NUMBER
+C     I ............ ORIGINAL PTL NUMBER
+C     IDPTL ........ PARTICLE ID
+C     PPTL ......... 5-MOMENTUM (PX,PY,PZ,EN,MASS) IN LAB
+C     IOPTL ........ ORIGIN (-999:PARENT NOT STORED, -1,0:NO PARENT)
+C     JOPTL ........ ORIGIN (SECOND PARENT)
+C     ISTPTL ....... STABLE (=0) OR NOT (=1)
+C     XORPTL ....... SPACE-TIME POINT (X,Y,Z,T) ON PTL TRACK (PP-CM)
+C     TIVPTL ....... TIME INTERVAL OF EXISTENCE
+C     NQJPTL ....... QUARK NUMBERS OF JETS
+ 
+C  ELIMINATE TARGET SPECTATORS
+        IF ( PPTL(3,I) .EQ. 0. ) GOTO 5
+ 
+C  ELIMINATE BACKWARD GOING PARTICLES
+        IF ( PPTL(3,I) .LT. 0. ) GOTO 5
+C  CONVERT PARTICLE CODE  VEN(US) ---> C(O)RS(IKA)
+C  MOST FREQUENT PARTICLES COME FIRST
+        KODVEN = IDPTL(I)
+C  MESONS
+        IF     ( KODVEN .EQ.   110 ) THEN
+          KODCRS = 7
+        ELSEIF ( KODVEN .EQ.   120 ) THEN
+          KODCRS = 8
+        ELSEIF ( KODVEN .EQ.  -120 ) THEN
+          KODCRS = 9
+        ELSEIF ( KODVEN .EQ.   220 ) THEN
+          KODCRS = 17
+C  NUCLEONS
+        ELSEIF ( KODVEN .EQ.  1220 ) THEN
+          KODCRS = 13
+        ELSEIF ( KODVEN .EQ.  1120 ) THEN
+          KODCRS = 14
+        ELSEIF ( KODVEN .EQ. -1120 ) THEN
+          KODCRS = 15
+        ELSEIF ( KODVEN .EQ. -1220 ) THEN
+          KODCRS = 25
+C  STRANGE MESONS
+        ELSEIF ( KODVEN .EQ.   -20 ) THEN
+          KODCRS = 10
+        ELSEIF ( KODVEN .EQ.   130 ) THEN
+          KODCRS = 11
+        ELSEIF ( KODVEN .EQ.  -130 ) THEN
+          KODCRS = 12
+        ELSEIF ( KODVEN .EQ.    20 ) THEN
+          KODCRS = 16
+C  STRANGE BARYONS
+        ELSEIF ( KODVEN .EQ.  2130 ) THEN
+          KODCRS = 18
+        ELSEIF ( KODVEN .EQ.  1130 ) THEN
+          KODCRS = 19
+        ELSEIF ( KODVEN .EQ.  1230 ) THEN
+          KODCRS = 20
+        ELSEIF ( KODVEN .EQ.  2230 ) THEN
+          KODCRS = 21
+        ELSEIF ( KODVEN .EQ.  1330 ) THEN
+          KODCRS = 22
+        ELSEIF ( KODVEN .EQ.  2330 ) THEN
+          KODCRS = 23
+        ELSEIF ( KODVEN .EQ.  3331 ) THEN
+          KODCRS = 24
+        ELSEIF ( KODVEN .EQ. -2130 ) THEN
+          KODCRS = 26
+        ELSEIF ( KODVEN .EQ. -1130 ) THEN
+          KODCRS = 27
+        ELSEIF ( KODVEN .EQ. -1230 ) THEN
+          KODCRS = 28
+        ELSEIF ( KODVEN .EQ. -2230 ) THEN
+          KODCRS = 29
+        ELSEIF ( KODVEN .EQ. -1330 ) THEN
+          KODCRS = 30
+        ELSEIF ( KODVEN .EQ. -2330 ) THEN
+          KODCRS = 31
+        ELSEIF ( KODVEN .EQ. -3331 ) THEN
+          KODCRS = 32
+C  LEPTONS
+        ELSEIF ( KODVEN .EQ.    10 ) THEN
+          KODCRS = 1
+        ELSEIF ( KODVEN .EQ.   -12 ) THEN
+          KODCRS = 2
+        ELSEIF ( KODVEN .EQ.    12 ) THEN
+          KODCRS = 3
+        ELSEIF ( KODVEN .EQ.   -14 ) THEN
+          KODCRS = 5
+        ELSEIF ( KODVEN .EQ.    14 ) THEN
+          KODCRS = 6
+C  NEUTRINOS ARE SKIPPED
+        ELSEIF ( KODVEN .EQ.    11 ) THEN
+          GOTO 5
+        ELSEIF ( KODVEN .EQ.   -11 ) THEN
+          GOTO 5
+        ELSEIF ( KODVEN .EQ.    13 ) THEN
+          GOTO 5
+        ELSEIF ( KODVEN .EQ.   -13 ) THEN
+          GOTO 5
+        ELSE
+          WRITE(MONIOU,*)'VSTORE: UNKNOWN PARTICLE CODE IDPTL=',IDPTL(I)
+          GOTO 5
+        ENDIF
+        SECPAR(1) = KODCRS
+ 
+        IF ( KODCRS .NE. 1  .AND. KODCRS .LE. 65 ) THEN
+C  ORDINARY SECONDARY PARTICLES
+          SECPAR(2) = PPTL(4,I)/PAMA(KODCRS)
+C  LOOK FOR SPECTATOR NUCLEONS
+          IF ( KODCRS .EQ. 13  .OR.  KODCRS .EQ. 14 ) THEN
+C  ELIMINATE TARGET SPECTATORS
+            IF ( SECPAR(2) .LE. 1.002D0 ) GOTO 5
+C  TREAT PROJECTILE SPECTATORS
+            IF ( SECPAR(2) .GT. 0.999D0*GAMMA  .AND.
+     *           SECPAR(2) .LT. 1.001D0*GAMMA  .AND.
+     *           PPTL(1,I).EQ.0.  .AND.  PPTL(2,I).EQ.0. ) THEN
+              IF ( NFRAGM .NE. 0 ) THEN
+C  COMPOSE PROJECTILE SPECTATORS TO REMAINING NUCLEUS
+                NREST = NREST - 1
+                NNEW  = NNEW + 1
+                IF     ( KODCRS .EQ. 14 ) THEN
+                  INEW  = INEW + 101
+                  IREST = IREST - 101
+                ELSEIF ( KODCRS .EQ. 13 ) THEN
+                  INEW  = INEW + 100
+                  IREST = IREST - 100
+                ENDIF
+                GOTO 5
+              ENDIF
+C  DISREGARD PROJECTILE SPECTATORS FOR ELASTICITY
+              GOTO 7
+            ENDIF
+          ENDIF
+ 
+CC        IF ( SECPAR(2) .GT. GAMMAX ) THEN
+CC          GAMMAX = SECPAR(2)
+C  CALCULATE ELASTICITY FROM ENERGY OF FASTEST PARTICLE (LEADER)
+CC          ELASTI = GAMMAX * PAMA(KODCRS) / ELAB
+CC        ENDIF
+          IF ( SECPAR(2)*PAMA(KODCRS) .GT. EMAX ) THEN
+            EMAX = SECPAR(2)*PAMA(KODCRS)
+C  CALCULATE ELASTICITY FROM MOST ENERGETIC PARTICLE (LEADER)
+            ELASTI = EMAX / ELAB
+          ENDIF
+        ELSE
+C  GAMMAS AND NEUTRINOS
+          SECPAR(2) = PPTL(4,I)
+        ENDIF
+ 
+C  COUNTER FOR ENERGY-MULTIPLICITY MATRIX
+        MSMM = MSMM + 1
+ 
+C  DETERMINE ANGLES FROM LONGITUDINAL AND TRANSVERSAL MOMENTA
+ 7      CONTINUE
+        PT2 = DBLE(PPTL(1,I))**2 + DBLE(PPTL(2,I))**2
+        PL2 = DBLE(PPTL(3,I))**2
+ 
+        IF ( PL2+PT2 .LE. 0.D0 ) THEN
+          COSTET = 0.D0
+        ELSE
+          COSTET = PPTL(3,I) / SQRT(PL2+PT2)
+        ENDIF
+        COSTET = MAX( MIN(COSTET, 1.D0), -1.D0 )
+        IF ( PPTL(1,I)  .NE. 0.  .OR.  PPTL(2,I) .NE. 0. ) THEN
+          PHIV = ATAN2( DBLE(PPTL(1,I)), DBLE(PPTL(2,I)) )
+        ELSE
+          PHIV = 0.D0
+        ENDIF
+ 
+ 
+        ETOT = ETOT + PPTL(4,I)
+        CALL ADDANG( COSTHE,PHI, COSTET,PHIV, SECPAR(3),SECPAR(4) )
+        IF ( SECPAR(3) .GE. C(29) ) THEN
+          CALL TSTACK
+        ENDIF
+ 
+C  COUNTERS FOR FIRST INTERACTION
+        IF ( FIRSTI ) THEN
+          IF     ( SECPAR(1) .EQ.  7.D0  .OR.  SECPAR(1) .EQ.  8.D0
+     *       .OR.  SECPAR(1) .EQ.  9.D0                           ) THEN
+            IFINPI = IFINPI + 1
+          ELSEIF ( SECPAR(1) .EQ. 13.D0  .OR.  SECPAR(1) .EQ. 14.D0
+     *       .OR.  SECPAR(1) .EQ. 15.D0 .OR. SECPAR(1) .EQ. 25.D0 ) THEN
+            IFINNU = IFINNU + 1
+          ELSEIF ( SECPAR(1) .EQ. 10.D0  .OR.  SECPAR(1) .EQ. 11.D0
+     *       .OR.  SECPAR(1) .EQ. 12.D0 .OR. SECPAR(1) .EQ. 16.D0 ) THEN
+            IFINKA = IFINKA + 1
+          ELSEIF ( SECPAR(1) .EQ. 17.D0 ) THEN
+            IFINET = IFINET + 1
+          ELSEIF ((SECPAR(1) .GE. 18.D0 .AND. SECPAR(1) .LE. 24.D0)
+     *       .OR. (SECPAR(1) .GE. 26.D0 .AND. SECPAR(1) .LE. 32.D0))THEN
+            IFINHY = IFINHY + 1
+          ENDIF
+        ENDIF
+ 
+ 5    CONTINUE
+ 
+      IF (DEBUG) WRITE(MDEBUG,*) 'VSTORE: NTGEVT,ETOT =',NTGEVT,ETOT
+ 
+      IF ( NFRAGM .NE. 0  .AND.  INEW .GT. 0 ) THEN
+C  TREAT REMAINING NUCLEUS
+        IF ( DEBUG ) WRITE(MDEBUG,150) INEW,(CURPAR(I),I=2,8)
+ 150    FORMAT(' VSTORE: REMNNT=',1P,I10,7E10.3)
+        SECPAR(2) = CURPAR(2)
+        SECPAR(3) = CURPAR(3)
+        SECPAR(4) = CURPAR(4)
+ 
+        IF     ( INEW .EQ. 100 ) THEN
+C  REMAINING NUCLEUS IS SINGLE NEUTRON
+          SECPAR(1) = 13.D0
+          CALL TSTACK
+          ETOT = ETOT + SECPAR(2) * PAMA(13)
+          GOTO 140
+ 
+        ELSEIF ( INEW .EQ. 101 ) THEN
+C  REMAINING NUCLEUS IS SINGLE PROTON
+          SECPAR(1) = 14.D0
+          CALL TSTACK
+          ETOT = ETOT + SECPAR(2) * PAMA(14)
+          GOTO 140
+ 
+        ELSEIF ( NFRAGM .GE. 2 ) THEN
+C  REMAINING NUCLEUS IS EVAPORATING NUCLEONS AND ALPHA PARTICLES
+          NZNEW = MOD(INEW,100)
+          NNNEW = INEW/100 - NZNEW
+          JFIN  = 0
+          CALL VAPOR(MAPROJ,INEW,JFIN,ITYP,PFRX,PFRY)
+          IF ( JFIN .EQ. 0 ) GOTO 139
+C  LOOP TO TREAT THE REMANENTS OF THE DESINTEGRATED FRAGMENT
+          KNEW = 0
+          DO  135  J=1,JFIN
+            EA = GAMMA * PAMA(ITYP(J))
+            IF(DEBUG)WRITE(MDEBUG,*)'VSTORE: J,ITYP,EA=',J,ITYP(J),EA
+C  MOMENTA SQUARED
+            PTM = EA**2 - PAMA(ITYP(J))**2
+            PT2 = PFRX(J)**2 + PFRY(J)**2
+            IF ( PT2 .GE. PTM ) THEN
+              IF(DEBUG)WRITE(MDEBUG,*)'VSTORE: PT REJECT PARTICLE',J
+              GOTO 135
+            ENDIF
+            IF ( PTM .GT. 0.D0 ) THEN
+              COSTET = SQRT( 1.D0 - PT2/PTM )
+            ELSE
+              COSTET = 1.D0
+            ENDIF
+            IF ( PFRX(J) .NE. 0.D0  .OR.  PFRY(J) .NE. 0.D0 ) THEN
+              PHIV = ATAN2( PFRY(J), PFRX(J) )
+            ELSE
+              PHIV = 0.D0
+            ENDIF
+            CALL ADDANG( COSTHE,PHI, COSTET,PHIV, SECPAR(3),SECPAR(4) )
+            IF ( SECPAR(3) .GE. C(29) ) THEN
+              IF ( J .LT. JFIN ) THEN
+                SECPAR(1) = ITYP(J)
+                CALL TSTACK
+              ELSE
+                KNEW  = ITYP(JFIN)
+              ENDIF
+            ELSE
+              IF(DEBUG)WRITE(MDEBUG,*)'VSTORE: ANGLE REJECT PARTICLE',J
+            ENDIF
+ 135      CONTINUE
+ 
+        ELSEIF ( NFRAGM .EQ. 1 ) THEN
+C  REMAINING NUCLEUS IS ONE FRAGMENT
+          NZNEW = MOD(INEW,100)
+          NNNEW = INEW/100 - NZNEW
+          KNEW  = INEW
+        ENDIF
+ 
+        IF     ( KNEW/100 .EQ. 5 ) THEN
+C  REMAINING NUCLEUS: MASS 5 CANNOT BE TREATED IN BOX2
+          IF ( MOD(KNEW,100) .GE. 3 ) THEN
+C  MASS 5: SPLIT OFF ONE PROTON
+            SECPAR(1) = 14.D0
+            CALL TSTACK
+            KNEW = KNEW - 101
+          ELSE
+C  MASS 5: SPLIT OFF ONE NEUTRON
+            SECPAR(1) = 13.D0
+            CALL TSTACK
+            KNEW = KNEW - 100
+          ENDIF
+        ELSEIF ( KNEW/100 .EQ. 8 ) THEN
+C  REMAINING NUCLEUS: MASS 8 CANNOT BE TREATED IN BOX2
+          IF     ( MOD(KNEW,100) .GE. 5 ) THEN
+C  MASS 8: SPLIT OFF ONE PROTON
+            SECPAR(1) = 14.D0
+            CALL TSTACK
+            KNEW = KNEW - 101
+          ELSEIF ( MOD(KNEW,100) .LE. 3 ) THEN
+C  MASS 8: SPLIT OFF ONE NEUTRON
+            SECPAR(1) = 13.D0
+            CALL TSTACK
+            KNEW = KNEW - 100
+          ELSE
+C  MASS 8: SPLIT OFF ONE ALPHA PARTICLE
+            SECPAR(1) = 402.D0
+            CALL TSTACK
+            KNEW = KNEW - 402
+          ENDIF
+        ENDIF
+ 
+        SECPAR(1) = KNEW
+        CALL TSTACK
+      ENDIF
+ 
+ 139  ETOT = ETOT + SECPAR(2)*(PAMA(13)*NNNEW + PAMA(14)*NZNEW)
+ 140  CONTINUE
+      IF ( DEBUG ) WRITE(MDEBUG,*)'VSTORE: ELASTI,ETOT,ELAB=',
+     *                               SNGL(ELASTI),ETOT,ELAB
+ 
+C  FILL ELASTICITY IN MATRICES
+      MEL = MIN ( 1.D0+10.D0*      MAX( 0.D0, ELASTI ) , 11.D0 )
+      MEN = MIN ( 4.D0+ 3.D0*LOG10(MAX( .1D0, EKINL  )), 37.D0 )
+      IELDPM(MEN,MEL) = IELDPM(MEN,MEL) + 1
+      IELDPA(MEN,MEL) = IELDPA(MEN,MEL) + 1
+      IF ( ELASTI .LT. 1.D0 ) THEN
+        ELMEAN(MEN) = ELMEAN(MEN) + ELASTI
+        ELMEAA(MEN) = ELMEAA(MEN) + ELASTI
+      ENDIF
+ 
+      IF ( FIRSTI ) THEN
+        ELAST  = ELASTI
+        FIRSTI = .FALSE.
+      ENDIF
+ 
+      RETURN
+      END
Index: trunk/MagicSoft/Simulation/Corsika/Mmcs/vzero.f
===================================================================
--- trunk/MagicSoft/Simulation/Corsika/Mmcs/vzero.f	(revision 286)
+++ trunk/MagicSoft/Simulation/Corsika/Mmcs/vzero.f	(revision 286)
@@ -0,0 +1,16 @@
+      SUBROUTINE VZERO (IA,N)
+ 
+C-----------------------------------------------------------------------
+C CERN PROGLIB# F121    VZERO           .VERSION KERNFOR  4.16  870601
+C ORIG. 01/07/71, MODIF. 24/05/87 TO SET INTEGER ZERO
+C-----------------------------------------------------------------------
+ 
+      DIMENSION IA(*)
+C-----------------------------------------------------------------------
+ 
+      IF (N.LE.0)  RETURN
+      DO 9 I= 1,N
+    9 IA(I)= 0
+ 
+      RETURN
+      END