diff --git a/geant4/LEMuSR/MEYER/M10.eps b/geant4/LEMuSR/MEYER/M10.eps new file mode 100644 index 0000000..dc500bb --- /dev/null +++ b/geant4/LEMuSR/MEYER/M10.eps @@ -0,0 +1,734 @@ +%!PS-Adobe-2.0 +%%Title: M10.eps +%%Creator: gnuplot 3.7 patchlevel 3 +%%CreationDate: Mon Apr 11 19:41:32 2005 +%%DocumentFonts: (atend) +%%BoundingBox: 50 50 554 770 +%%Orientation: Landscape +%%Pages: (atend) +%%EndComments +/gnudict 256 dict def +gnudict begin +/Color true def +/Solid false def +/gnulinewidth 5.000 def +/userlinewidth gnulinewidth def +/vshift -46 def +/dl {10 mul} def +/hpt_ 31.5 def +/vpt_ 31.5 def +/hpt hpt_ def +/vpt vpt_ def +/M {moveto} bind def +/L {lineto} bind def +/R {rmoveto} bind def +/V {rlineto} bind def +/vpt2 vpt 2 mul def +/hpt2 hpt 2 mul def +/Lshow { currentpoint stroke M + 0 vshift R show } def +/Rshow { currentpoint stroke M + dup stringwidth pop neg vshift R show } def +/Cshow { currentpoint stroke M + dup stringwidth pop -2 div vshift R show } def +/UP { dup vpt_ mul /vpt exch def hpt_ mul /hpt exch def + /hpt2 hpt 2 mul def /vpt2 vpt 2 mul def } def +/DL { Color {setrgbcolor Solid {pop []} if 0 setdash } + {pop pop pop Solid {pop []} if 0 setdash} ifelse } def +/BL { stroke userlinewidth 2 mul setlinewidth } def +/AL { stroke userlinewidth 2 div setlinewidth } def +/UL { dup gnulinewidth mul /userlinewidth exch def + dup 1 lt {pop 1} if 10 mul /udl exch def } def +/PL { stroke userlinewidth setlinewidth } def +/LTb { BL [] 0 0 0 DL } def +/LTa { AL [1 udl mul 2 udl mul] 0 setdash 0 0 0 setrgbcolor } def +/LT0 { PL [] 1 0 0 DL } def +/LT1 { PL [4 dl 2 dl] 0 1 0 DL } def +/LT2 { PL [2 dl 3 dl] 0 0 1 DL } def +/LT3 { PL [1 dl 1.5 dl] 1 0 1 DL } def +/LT4 { PL [5 dl 2 dl 1 dl 2 dl] 0 1 1 DL } def +/LT5 { PL [4 dl 3 dl 1 dl 3 dl] 1 1 0 DL } def +/LT6 { PL [2 dl 2 dl 2 dl 4 dl] 0 0 0 DL } def +/LT7 { PL [2 dl 2 dl 2 dl 2 dl 2 dl 4 dl] 1 0.3 0 DL } def +/LT8 { PL [2 dl 2 dl 2 dl 2 dl 2 dl 2 dl 2 dl 4 dl] 0.5 0.5 0.5 DL } def +/Pnt { stroke [] 0 setdash + gsave 1 setlinecap M 0 0 V stroke grestore } def +/Dia { stroke [] 0 setdash 2 copy vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath stroke + Pnt } def +/Pls { stroke [] 0 setdash vpt sub M 0 vpt2 V + currentpoint stroke M + hpt neg vpt neg R hpt2 0 V stroke + } def +/Box { stroke [] 0 setdash 2 copy exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath stroke + Pnt } def +/Crs { stroke [] 0 setdash exch hpt sub exch vpt add M + hpt2 vpt2 neg V currentpoint stroke M + hpt2 neg 0 R hpt2 vpt2 V stroke } def +/TriU { stroke [] 0 setdash 2 copy vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath stroke + Pnt } def +/Star { 2 copy Pls Crs } def +/BoxF { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath fill } def +/TriUF { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath fill } def +/TriD { stroke [] 0 setdash 2 copy vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath stroke + Pnt } def +/TriDF { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath fill} def +/DiaF { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath fill } def +/Pent { stroke [] 0 setdash 2 copy gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath stroke grestore Pnt } def +/PentF { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath fill grestore } def +/Circle { stroke [] 0 setdash 2 copy + hpt 0 360 arc stroke Pnt } def +/CircleF { stroke [] 0 setdash hpt 0 360 arc fill } def +/C0 { BL [] 0 setdash 2 copy moveto vpt 90 450 arc } bind def +/C1 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc closepath fill + vpt 0 360 arc closepath } bind def +/C2 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C3 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C4 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 180 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C5 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc + 2 copy moveto + 2 copy vpt 180 270 arc closepath fill + vpt 0 360 arc } bind def +/C6 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C7 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C8 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 270 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C9 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 270 450 arc closepath fill + vpt 0 360 arc closepath } bind def +/C10 { BL [] 0 setdash 2 copy 2 copy moveto vpt 270 360 arc closepath fill + 2 copy moveto + 2 copy vpt 90 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C11 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 180 arc closepath fill + 2 copy moveto + 2 copy vpt 270 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C12 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 180 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C13 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc closepath fill + 2 copy moveto + 2 copy vpt 180 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C14 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 360 arc closepath fill + vpt 0 360 arc } bind def +/C15 { BL [] 0 setdash 2 copy vpt 0 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/Rec { newpath 4 2 roll moveto 1 index 0 rlineto 0 exch rlineto + neg 0 rlineto closepath } bind def +/Square { dup Rec } bind def +/Bsquare { vpt sub exch vpt sub exch vpt2 Square } bind def +/S0 { BL [] 0 setdash 2 copy moveto 0 vpt rlineto BL Bsquare } bind def +/S1 { BL [] 0 setdash 2 copy vpt Square fill Bsquare } bind def +/S2 { BL [] 0 setdash 2 copy exch vpt sub exch vpt Square fill Bsquare } bind def +/S3 { BL [] 0 setdash 2 copy exch vpt sub exch vpt2 vpt Rec fill Bsquare } bind def +/S4 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt Square fill Bsquare } bind def +/S5 { BL [] 0 setdash 2 copy 2 copy vpt Square fill + exch vpt sub exch vpt sub vpt Square fill Bsquare } bind def +/S6 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt vpt2 Rec fill Bsquare } bind def +/S7 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt vpt2 Rec fill + 2 copy vpt Square fill + Bsquare } bind def +/S8 { BL [] 0 setdash 2 copy vpt sub vpt Square fill Bsquare } bind def +/S9 { BL [] 0 setdash 2 copy vpt sub vpt vpt2 Rec fill Bsquare } bind def +/S10 { BL [] 0 setdash 2 copy vpt sub vpt Square fill 2 copy exch vpt sub exch vpt Square fill + Bsquare } bind def +/S11 { BL [] 0 setdash 2 copy vpt sub vpt Square fill 2 copy exch vpt sub exch vpt2 vpt Rec fill + Bsquare } bind def +/S12 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill Bsquare } bind def +/S13 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill + 2 copy vpt Square fill Bsquare } bind def +/S14 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill + 2 copy exch vpt sub exch vpt Square fill Bsquare } bind def +/S15 { BL [] 0 setdash 2 copy Bsquare fill Bsquare } bind def +/D0 { gsave translate 45 rotate 0 0 S0 stroke grestore } bind def +/D1 { gsave translate 45 rotate 0 0 S1 stroke grestore } bind def +/D2 { gsave translate 45 rotate 0 0 S2 stroke grestore } bind def +/D3 { gsave translate 45 rotate 0 0 S3 stroke grestore } bind def +/D4 { gsave translate 45 rotate 0 0 S4 stroke grestore } bind def +/D5 { gsave translate 45 rotate 0 0 S5 stroke grestore } bind def +/D6 { gsave translate 45 rotate 0 0 S6 stroke grestore } bind def +/D7 { gsave translate 45 rotate 0 0 S7 stroke grestore } bind def +/D8 { gsave translate 45 rotate 0 0 S8 stroke grestore } bind def +/D9 { gsave translate 45 rotate 0 0 S9 stroke grestore } bind def +/D10 { gsave translate 45 rotate 0 0 S10 stroke grestore } bind def +/D11 { gsave translate 45 rotate 0 0 S11 stroke grestore } bind def +/D12 { gsave translate 45 rotate 0 0 S12 stroke grestore } bind def +/D13 { gsave translate 45 rotate 0 0 S13 stroke grestore } bind def +/D14 { gsave translate 45 rotate 0 0 S14 stroke grestore } bind def +/D15 { gsave translate 45 rotate 0 0 S15 stroke grestore } bind def +/DiaE { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath stroke } def +/BoxE { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath stroke } def +/TriUE { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath stroke } def +/TriDE { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath stroke } def +/PentE { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath stroke grestore } def +/CircE { stroke [] 0 setdash + hpt 0 360 arc stroke } def +/Opaque { gsave closepath 1 setgray fill grestore 0 setgray closepath } def +/DiaW { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V Opaque stroke } def +/BoxW { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V Opaque stroke } def +/TriUW { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V Opaque stroke } def +/TriDW { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V Opaque stroke } def +/PentW { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + Opaque stroke grestore } def +/CircW { stroke [] 0 setdash + hpt 0 360 arc Opaque stroke } def +/BoxFill { gsave Rec 1 setgray fill grestore } def +/Symbol-Oblique /Symbol findfont [1 0 .167 1 0 0] makefont +dup length dict begin {1 index /FID eq {pop pop} {def} ifelse} forall +currentdict end definefont pop +end +%%EndProlog +%%Page: 1 1 +gnudict begin +gsave +50 50 translate +0.100 0.100 scale +90 rotate +0 -5040 translate +0 setgray +newpath +(Helvetica) findfont 140 scalefont setfont +1.000 UL +LTb +1.000 UL +LTa +714 420 M +6248 0 V +1.000 UL +LTb +714 420 M +63 0 V +6185 0 R +-63 0 V +630 420 M +( 0) Rshow +1.000 UL +LTa +714 865 M +6248 0 V +1.000 UL +LTb +714 865 M +63 0 V +6185 0 R +-63 0 V +630 865 M +( 0.1) Rshow +1.000 UL +LTa +714 1310 M +6248 0 V +1.000 UL +LTb +714 1310 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.2) Rshow +1.000 UL +LTa +714 1756 M +6248 0 V +1.000 UL +LTb +714 1756 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.3) Rshow +1.000 UL +LTa +714 2201 M +6248 0 V +1.000 UL +LTb +714 2201 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.4) Rshow +1.000 UL +LTa +714 2646 M +6248 0 V +1.000 UL +LTb +714 2646 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.5) Rshow +1.000 UL +LTa +714 3091 M +6248 0 V +1.000 UL +LTb +714 3091 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.6) Rshow +1.000 UL +LTa +714 3536 M +6248 0 V +1.000 UL +LTb +714 3536 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.7) Rshow +1.000 UL +LTa +714 3982 M +6248 0 V +1.000 UL +LTb +714 3982 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.8) Rshow +1.000 UL +LTa +714 4427 M +6248 0 V +1.000 UL +LTb +714 4427 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.9) Rshow +1.000 UL +LTa +714 4872 M +6248 0 V +1.000 UL +LTb +714 4872 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 1) Rshow +1.000 UL +LTa +714 420 M +0 4452 V +1.000 UL +LTb +714 420 M +0 63 V +0 4389 R +0 -63 V +714 280 M +( 0) Cshow +1.000 UL +LTa +1408 420 M +0 4452 V +1.000 UL +LTb +1408 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 5) Cshow +1.000 UL +LTa +2102 420 M +0 4452 V +1.000 UL +LTb +2102 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 10) Cshow +1.000 UL +LTa +2797 420 M +0 4452 V +1.000 UL +LTb +2797 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 15) Cshow +1.000 UL +LTa +3491 420 M +0 4452 V +1.000 UL +LTb +3491 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 20) Cshow +1.000 UL +LTa +4185 420 M +0 4452 V +1.000 UL +LTb +4185 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 25) Cshow +1.000 UL +LTa +4879 420 M +0 4452 V +1.000 UL +LTb +4879 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 30) Cshow +1.000 UL +LTa +5574 420 M +0 4109 V +0 280 R +0 63 V +1.000 UL +LTb +5574 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 35) Cshow +1.000 UL +LTa +6268 420 M +0 4109 V +0 280 R +0 63 V +1.000 UL +LTb +6268 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 40) Cshow +1.000 UL +LTa +6962 420 M +0 4452 V +1.000 UL +LTb +6962 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 45) Cshow +1.000 UL +LTb +714 420 M +6248 0 V +0 4452 V +-6248 0 V +714 420 L +140 2646 M +currentpoint gsave translate 90 rotate 0 0 M +(Meyer's distribution) Cshow +grestore +3838 70 M +(scatt. angle [deg]) Cshow +1.000 UP +1.000 UL +LT0 +6311 4739 M +('M10.keV' us 1:2) Rshow +783 4872 Pls +853 4843 Pls +922 4814 Pls +992 4785 Pls +1061 4756 Pls +1131 4712 Pls +1200 4619 Pls +1269 4527 Pls +1339 4434 Pls +1408 4342 Pls +1478 4238 Pls +1547 4121 Pls +1616 4003 Pls +1686 3869 Pls +1755 3734 Pls +1825 3601 Pls +1894 3467 Pls +1964 3334 Pls +2033 3201 Pls +2102 3067 Pls +2172 2939 Pls +2241 2811 Pls +2311 2682 Pls +2380 2554 Pls +2450 2430 Pls +2519 2323 Pls +2588 2215 Pls +2658 2108 Pls +2727 2001 Pls +2797 1903 Pls +2866 1818 Pls +2936 1733 Pls +3005 1648 Pls +3074 1563 Pls +3144 1489 Pls +3213 1420 Pls +3283 1354 Pls +3352 1297 Pls +3421 1239 Pls +3491 1193 Pls +3560 1147 Pls +3630 1101 Pls +3699 1055 Pls +3769 1011 Pls +3838 978 Pls +3907 945 Pls +3977 912 Pls +4046 879 Pls +4116 850 Pls +4185 826 Pls +4255 802 Pls +4324 778 Pls +4393 755 Pls +4463 735 Pls +4532 717 Pls +4602 700 Pls +4671 682 Pls +4740 665 Pls +4810 652 Pls +4879 640 Pls +4949 629 Pls +5018 617 Pls +5088 605 Pls +5157 596 Pls +5226 587 Pls +5296 578 Pls +5365 569 Pls +5435 560 Pls +5504 554 Pls +5574 547 Pls +5643 540 Pls +5712 534 Pls +5782 529 Pls +5851 524 Pls +5921 520 Pls +5990 516 Pls +6060 512 Pls +6129 508 Pls +6198 504 Pls +6268 500 Pls +6337 496 Pls +6407 492 Pls +6476 488 Pls +6545 483 Pls +6615 481 Pls +6684 479 Pls +6754 477 Pls +6823 474 Pls +6893 472 Pls +6962 470 Pls +6594 4739 Pls +1.000 UL +LT1 +6311 4599 M +(exp\(-x*x/200.\)) Rshow +6395 4599 M +399 0 V +714 4872 M +63 -5 V +63 -13 V +63 -23 V +63 -32 V +64 -41 V +63 -49 V +63 -57 V +63 -65 V +63 -72 V +63 -80 V +63 -86 V +63 -92 V +63 -98 V +64 -103 V +63 -107 V +63 -112 V +63 -114 V +63 -117 V +63 -120 V +63 -121 V +63 -122 V +63 -123 V +64 -122 V +63 -123 V +63 -121 V +63 -120 V +63 -118 V +63 -115 V +63 -114 V +63 -110 V +63 -107 V +64 -104 V +63 -101 V +63 -96 V +63 -93 V +63 -89 V +63 -85 V +63 -80 V +63 -77 V +63 -72 V +64 -69 V +63 -64 V +63 -61 V +63 -56 V +63 -53 V +63 -50 V +63 -46 V +63 -42 V +63 -39 V +64 -37 V +63 -33 V +63 -30 V +63 -28 V +63 -26 V +63 -23 V +63 -22 V +63 -19 V +63 -17 V +64 -16 V +63 -14 V +63 -13 V +63 -11 V +63 -10 V +63 -9 V +63 -8 V +63 -8 V +63 -6 V +64 -6 V +63 -4 V +63 -5 V +63 -4 V +63 -3 V +63 -3 V +63 -2 V +63 -3 V +63 -2 V +64 -1 V +63 -2 V +63 -1 V +63 -1 V +63 -1 V +63 -1 V +63 0 V +63 -1 V +63 0 V +64 -1 V +63 0 V +63 -1 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 -1 V +64 0 V +63 0 V +63 0 V +63 0 V +63 0 V +stroke +grestore +end +showpage +%%Trailer +%%DocumentFonts: Helvetica +%%Pages: 1 diff --git a/geant4/LEMuSR/MEYER/M10.keV b/geant4/LEMuSR/MEYER/M10.keV new file mode 100644 index 0000000..a5743d4 --- /dev/null +++ b/geant4/LEMuSR/MEYER/M10.keV @@ -0,0 +1,167 @@ +0.5 1 0 +1 0.99351 0.0357481 +1.5 0.98702 0.0710264 +2 0.98053 0.105832 +2.5 0.974041 0.140163 +3 0.964167 0.173408 +3.5 0.943389 0.203577 +4 0.922611 0.232237 +4.5 0.901832 0.259387 +5 0.881054 0.285026 +5.5 0.857766 0.30825 +6 0.83169 0.328679 +6.5 0.805237 0.347053 +7 0.775073 0.361776 +7.5 0.744909 0.374314 +8 0.714917 0.384761 +8.5 0.684995 0.39308 +9 0.655074 0.399237 +9.5 0.625152 0.403233 +10 0.595231 0.405073 +10.5 0.566391 0.405532 +11 0.537611 0.403961 +11.5 0.508832 0.400324 +12 0.480052 0.394622 +12.5 0.452135 0.387601 +13 0.428038 0.381995 +13.5 0.403941 0.374666 +14 0.379845 0.36562 +14.5 0.355748 0.354859 +15 0.333765 0.344571 +15.5 0.314688 0.335826 +16 0.295611 0.32573 +16.5 0.276534 0.314285 +17 0.257457 0.301498 +17.5 0.240716 0.290187 +18 0.225189 0.279208 +18.5 0.21038 0.268056 +19 0.19745 0.258329 +19.5 0.18452 0.247699 +20 0.173957 0.239428 +20.5 0.163673 0.230816 +21 0.153388 0.22149 +21.5 0.143103 0.211455 +22 0.133193 0.201278 +22.5 0.125753 0.194237 +23 0.118313 0.186686 +23.5 0.110873 0.178626 +24 0.103433 0.170059 +24.5 0.0967697 0.16229 +25 0.0914364 0.156345 +25.5 0.086103 0.150039 +26 0.0807697 0.143374 +26.5 0.0754364 0.136352 +27 0.0709517 0.130535 +27.5 0.0670204 0.125456 +28 0.063089 0.120115 +28.5 0.0591577 0.114514 +29 0.0552264 0.108655 +29.5 0.0523566 0.10466 +30 0.0496858 0.100881 +30.5 0.0470149 0.0969269 +31 0.0443441 0.0927989 +31.5 0.041722 0.0886018 +32 0.0396678 0.0854598 +32.5 0.0376137 0.0821853 +33 0.0355596 0.0787792 +33.5 0.0335055 0.0752425 +34 0.0316272 0.0719762 +34.5 0.0301299 0.0694702 +35 0.0286327 0.0668695 +35.5 0.0271354 0.064175 +36 0.0256381 0.0613873 +36.5 0.0244597 0.0592799 +37 0.0235393 0.0577323 +37.5 0.0226189 0.0561271 +38 0.0216985 0.0544646 +38.5 0.0207781 0.0527455 +39 0.0198577 0.0509702 +39.5 0.0189373 0.0491392 +40 0.0180169 0.0472529 +40.5 0.0170965 0.045312 +41 0.0161761 0.0433168 +41.5 0.0152557 0.041268 +42 0.0143353 0.0391661 +42.5 0.013698 0.0377927 +43 0.0132167 0.0368168 +43.5 0.0127354 0.0358126 +44 0.0122542 0.0347803 +44.5 0.0117729 0.0337203 +45 0.0112916 0.0326328 +45.5 0.0108103 0.0315181 +46 0.010329 0.0303765 +46.5 0.00984769 0.0292083 +47 0.00936639 0.0280139 +47.5 0.0088851 0.0267934 +48 0.00840381 0.0255473 +48.5 0.00807864 0.0247543 +49 0.00780923 0.0241159 +49.5 0.00753982 0.0234628 +50 0.00727041 0.0227952 +50.5 0.007001 0.0221132 +51 0.00673158 0.0214171 +51.5 0.00646217 0.0207071 +52 0.00619276 0.0199833 +52.5 0.00592335 0.0192459 +53 0.00565394 0.0184951 +53.5 0.00538453 0.0177311 +54 0.00511512 0.016954 +54.5 0.00493893 0.0164751 +55 0.00478199 0.0160521 +55.5 0.00462504 0.0156214 +56 0.0044681 0.0151829 +56.5 0.00431115 0.0147369 +57 0.00415421 0.0142835 +57.5 0.00399726 0.0138227 +58 0.00384032 0.0133547 +58.5 0.00368337 0.0128797 +59 0.00352643 0.0123976 +59.5 0.00336948 0.0119088 +60 0.00321254 0.0114132 +60.5 0.00307638 0.0109852 +61 0.00294201 0.0105579 +61.5 0.00280764 0.0101251 +62 0.00267327 0.00968679 +62.5 0.0025389 0.00924312 +63 0.00240453 0.00879422 +63.5 0.00227016 0.00834018 +64 0.00213579 0.00788111 +64.5 0.00200142 0.00741713 +65 0.00186704 0.00694834 +65.5 0.00173267 0.00647487 +66 0.0015983 0.00599681 +66.5 0.00146393 0.00551429 +67 0.00132956 0.00502741 +67.5 0.00119519 0.0045363 +68 0.00106082 0.00404106 +68.5 0.000926448 0.00354181 +69 0.000792077 0.00303867 +69.5 0.000657706 0.00253176 +70 0.000523335 0.00202119 +70.5 0.000388965 0.00150707 +71 0.000254594 0.000989538 +71.5 0.000120223 0.0004687 +72 0 0 +72.5 0 0 +73 0 0 +73.5 0 0 +74 0 0 +74.5 0 0 +75 0 0 +75.5 0 0 +76 0 0 +76.5 0 0 +77 0 0 +77.5 0 0 +78 0 0 +78.5 0 0 +79 0 0 +79.5 0 0 +80 0 0 +80.5 0 0 +81 0 0 +81.5 0 0 +82 0 0 +82.5 0 0 +83 0 0 +83.5 0 0 diff --git a/geant4/LEMuSR/MEYER/M10.pdf b/geant4/LEMuSR/MEYER/M10.pdf new file mode 100644 index 0000000..c9e1d4b Binary files /dev/null and b/geant4/LEMuSR/MEYER/M10.pdf differ diff --git a/geant4/LEMuSR/MEYER/M10sin.eps b/geant4/LEMuSR/MEYER/M10sin.eps new file mode 100644 index 0000000..859b971 --- /dev/null +++ b/geant4/LEMuSR/MEYER/M10sin.eps @@ -0,0 +1,805 @@ +%!PS-Adobe-2.0 +%%Title: Ma10sin.eps +%%Creator: gnuplot 3.7 patchlevel 3 +%%CreationDate: Mon Apr 11 19:49:42 2005 +%%DocumentFonts: (atend) +%%BoundingBox: 50 50 554 770 +%%Orientation: Landscape +%%Pages: (atend) +%%EndComments +/gnudict 256 dict def +gnudict begin +/Color true def +/Solid false def +/gnulinewidth 5.000 def +/userlinewidth gnulinewidth def +/vshift -46 def +/dl {10 mul} def +/hpt_ 31.5 def +/vpt_ 31.5 def +/hpt hpt_ def +/vpt vpt_ def +/M {moveto} bind def +/L {lineto} bind def +/R {rmoveto} bind def +/V {rlineto} bind def +/vpt2 vpt 2 mul def +/hpt2 hpt 2 mul def +/Lshow { currentpoint stroke M + 0 vshift R show } def +/Rshow { currentpoint stroke M + dup stringwidth pop neg vshift R show } def +/Cshow { currentpoint stroke M + dup stringwidth pop -2 div vshift R show } def +/UP { dup vpt_ mul /vpt exch def hpt_ mul /hpt exch def + /hpt2 hpt 2 mul def /vpt2 vpt 2 mul def } def +/DL { Color {setrgbcolor Solid {pop []} if 0 setdash } + {pop pop pop Solid {pop []} if 0 setdash} ifelse } def +/BL { stroke userlinewidth 2 mul setlinewidth } def +/AL { stroke userlinewidth 2 div setlinewidth } def +/UL { dup gnulinewidth mul /userlinewidth exch def + dup 1 lt {pop 1} if 10 mul /udl exch def } def +/PL { stroke userlinewidth setlinewidth } def +/LTb { BL [] 0 0 0 DL } def +/LTa { AL [1 udl mul 2 udl mul] 0 setdash 0 0 0 setrgbcolor } def +/LT0 { PL [] 1 0 0 DL } def +/LT1 { PL [4 dl 2 dl] 0 1 0 DL } def +/LT2 { PL [2 dl 3 dl] 0 0 1 DL } def +/LT3 { PL [1 dl 1.5 dl] 1 0 1 DL } def +/LT4 { PL [5 dl 2 dl 1 dl 2 dl] 0 1 1 DL } def +/LT5 { PL [4 dl 3 dl 1 dl 3 dl] 1 1 0 DL } def +/LT6 { PL [2 dl 2 dl 2 dl 4 dl] 0 0 0 DL } def +/LT7 { PL [2 dl 2 dl 2 dl 2 dl 2 dl 4 dl] 1 0.3 0 DL } def +/LT8 { PL [2 dl 2 dl 2 dl 2 dl 2 dl 2 dl 2 dl 4 dl] 0.5 0.5 0.5 DL } def +/Pnt { stroke [] 0 setdash + gsave 1 setlinecap M 0 0 V stroke grestore } def +/Dia { stroke [] 0 setdash 2 copy vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath stroke + Pnt } def +/Pls { stroke [] 0 setdash vpt sub M 0 vpt2 V + currentpoint stroke M + hpt neg vpt neg R hpt2 0 V stroke + } def +/Box { stroke [] 0 setdash 2 copy exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath stroke + Pnt } def +/Crs { stroke [] 0 setdash exch hpt sub exch vpt add M + hpt2 vpt2 neg V currentpoint stroke M + hpt2 neg 0 R hpt2 vpt2 V stroke } def +/TriU { stroke [] 0 setdash 2 copy vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath stroke + Pnt } def +/Star { 2 copy Pls Crs } def +/BoxF { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath fill } def +/TriUF { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath fill } def +/TriD { stroke [] 0 setdash 2 copy vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath stroke + Pnt } def +/TriDF { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath fill} def +/DiaF { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath fill } def +/Pent { stroke [] 0 setdash 2 copy gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath stroke grestore Pnt } def +/PentF { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath fill grestore } def +/Circle { stroke [] 0 setdash 2 copy + hpt 0 360 arc stroke Pnt } def +/CircleF { stroke [] 0 setdash hpt 0 360 arc fill } def +/C0 { BL [] 0 setdash 2 copy moveto vpt 90 450 arc } bind def +/C1 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc closepath fill + vpt 0 360 arc closepath } bind def +/C2 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C3 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C4 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 180 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C5 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc + 2 copy moveto + 2 copy vpt 180 270 arc closepath fill + vpt 0 360 arc } bind def +/C6 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C7 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C8 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 270 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C9 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 270 450 arc closepath fill + vpt 0 360 arc closepath } bind def +/C10 { BL [] 0 setdash 2 copy 2 copy moveto vpt 270 360 arc closepath fill + 2 copy moveto + 2 copy vpt 90 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C11 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 180 arc closepath fill + 2 copy moveto + 2 copy vpt 270 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C12 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 180 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C13 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc closepath fill + 2 copy moveto + 2 copy vpt 180 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C14 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 360 arc closepath fill + vpt 0 360 arc } bind def +/C15 { BL [] 0 setdash 2 copy vpt 0 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/Rec { newpath 4 2 roll moveto 1 index 0 rlineto 0 exch rlineto + neg 0 rlineto closepath } bind def +/Square { dup Rec } bind def +/Bsquare { vpt sub exch vpt sub exch vpt2 Square } bind def +/S0 { BL [] 0 setdash 2 copy moveto 0 vpt rlineto BL Bsquare } bind def +/S1 { BL [] 0 setdash 2 copy vpt Square fill Bsquare } bind def +/S2 { BL [] 0 setdash 2 copy exch vpt sub exch vpt Square fill Bsquare } bind def +/S3 { BL [] 0 setdash 2 copy exch vpt sub exch vpt2 vpt Rec fill Bsquare } bind def +/S4 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt Square fill Bsquare } bind def +/S5 { BL [] 0 setdash 2 copy 2 copy vpt Square fill + exch vpt sub exch vpt sub vpt Square fill Bsquare } bind def +/S6 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt vpt2 Rec fill Bsquare } bind def +/S7 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt vpt2 Rec fill + 2 copy vpt Square fill + Bsquare } bind def +/S8 { BL [] 0 setdash 2 copy vpt sub vpt Square fill Bsquare } bind def +/S9 { BL [] 0 setdash 2 copy vpt sub vpt vpt2 Rec fill Bsquare } bind def +/S10 { BL [] 0 setdash 2 copy vpt sub vpt Square fill 2 copy exch vpt sub exch vpt Square fill + Bsquare } bind def +/S11 { BL [] 0 setdash 2 copy vpt sub vpt Square fill 2 copy exch vpt sub exch vpt2 vpt Rec fill + Bsquare } bind def +/S12 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill Bsquare } bind def +/S13 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill + 2 copy vpt Square fill Bsquare } bind def +/S14 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill + 2 copy exch vpt sub exch vpt Square fill Bsquare } bind def +/S15 { BL [] 0 setdash 2 copy Bsquare fill Bsquare } bind def +/D0 { gsave translate 45 rotate 0 0 S0 stroke grestore } bind def +/D1 { gsave translate 45 rotate 0 0 S1 stroke grestore } bind def +/D2 { gsave translate 45 rotate 0 0 S2 stroke grestore } bind def +/D3 { gsave translate 45 rotate 0 0 S3 stroke grestore } bind def +/D4 { gsave translate 45 rotate 0 0 S4 stroke grestore } bind def +/D5 { gsave translate 45 rotate 0 0 S5 stroke grestore } bind def +/D6 { gsave translate 45 rotate 0 0 S6 stroke grestore } bind def +/D7 { gsave translate 45 rotate 0 0 S7 stroke grestore } bind def +/D8 { gsave translate 45 rotate 0 0 S8 stroke grestore } bind def +/D9 { gsave translate 45 rotate 0 0 S9 stroke grestore } bind def +/D10 { gsave translate 45 rotate 0 0 S10 stroke grestore } bind def +/D11 { gsave translate 45 rotate 0 0 S11 stroke grestore } bind def +/D12 { gsave translate 45 rotate 0 0 S12 stroke grestore } bind def +/D13 { gsave translate 45 rotate 0 0 S13 stroke grestore } bind def +/D14 { gsave translate 45 rotate 0 0 S14 stroke grestore } bind def +/D15 { gsave translate 45 rotate 0 0 S15 stroke grestore } bind def +/DiaE { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath stroke } def +/BoxE { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath stroke } def +/TriUE { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath stroke } def +/TriDE { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath stroke } def +/PentE { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath stroke grestore } def +/CircE { stroke [] 0 setdash + hpt 0 360 arc stroke } def +/Opaque { gsave closepath 1 setgray fill grestore 0 setgray closepath } def +/DiaW { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V Opaque stroke } def +/BoxW { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V Opaque stroke } def +/TriUW { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V Opaque stroke } def +/TriDW { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V Opaque stroke } def +/PentW { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + Opaque stroke grestore } def +/CircW { stroke [] 0 setdash + hpt 0 360 arc Opaque stroke } def +/BoxFill { gsave Rec 1 setgray fill grestore } def +/Symbol-Oblique /Symbol findfont [1 0 .167 1 0 0] makefont +dup length dict begin {1 index /FID eq {pop pop} {def} ifelse} forall +currentdict end definefont pop +end +%%EndProlog +%%Page: 1 1 +gnudict begin +gsave +50 50 translate +0.100 0.100 scale +90 rotate +0 -5040 translate +0 setgray +newpath +(Helvetica) findfont 140 scalefont setfont +1.000 UL +LTb +1.000 UL +LTa +714 420 M +6248 0 V +1.000 UL +LTb +714 420 M +63 0 V +6185 0 R +-63 0 V +630 420 M +( 0) Rshow +1.000 UL +LTa +714 915 M +6248 0 V +1.000 UL +LTb +714 915 M +63 0 V +6185 0 R +-63 0 V +630 915 M +( 0.1) Rshow +1.000 UL +LTa +714 1409 M +6248 0 V +1.000 UL +LTb +714 1409 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.2) Rshow +1.000 UL +LTa +714 1904 M +6248 0 V +1.000 UL +LTb +714 1904 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.3) Rshow +1.000 UL +LTa +714 2399 M +6248 0 V +1.000 UL +LTb +714 2399 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.4) Rshow +1.000 UL +LTa +714 2893 M +6248 0 V +1.000 UL +LTb +714 2893 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.5) Rshow +1.000 UL +LTa +714 3388 M +6248 0 V +1.000 UL +LTb +714 3388 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.6) Rshow +1.000 UL +LTa +714 3883 M +6248 0 V +1.000 UL +LTb +714 3883 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.7) Rshow +1.000 UL +LTa +714 4377 M +6248 0 V +1.000 UL +LTb +714 4377 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.8) Rshow +1.000 UL +LTa +714 4872 M +6248 0 V +1.000 UL +LTb +714 4872 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.9) Rshow +1.000 UL +LTa +714 420 M +0 4452 V +1.000 UL +LTb +714 420 M +0 63 V +0 4389 R +0 -63 V +714 280 M +( 0) Cshow +1.000 UL +LTa +1408 420 M +0 4452 V +1.000 UL +LTb +1408 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 5) Cshow +1.000 UL +LTa +2102 420 M +0 4452 V +1.000 UL +LTb +2102 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 10) Cshow +1.000 UL +LTa +2797 420 M +0 4452 V +1.000 UL +LTb +2797 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 15) Cshow +1.000 UL +LTa +3491 420 M +0 4109 V +0 280 R +0 63 V +1.000 UL +LTb +3491 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 20) Cshow +1.000 UL +LTa +4185 420 M +0 4109 V +0 280 R +0 63 V +1.000 UL +LTb +4185 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 25) Cshow +1.000 UL +LTa +4879 420 M +0 4109 V +0 280 R +0 63 V +1.000 UL +LTb +4879 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 30) Cshow +1.000 UL +LTa +5574 420 M +0 4109 V +0 280 R +0 63 V +1.000 UL +LTb +5574 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 35) Cshow +1.000 UL +LTa +6268 420 M +0 4109 V +0 280 R +0 63 V +1.000 UL +LTb +6268 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 40) Cshow +1.000 UL +LTa +6962 420 M +0 4452 V +1.000 UL +LTb +6962 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 45) Cshow +1.000 UL +LTb +714 420 M +6248 0 V +0 4452 V +-6248 0 V +714 420 L +140 2646 M +currentpoint gsave translate 90 rotate 0 0 M +(distribution) Cshow +grestore +3838 70 M +([deg]) Cshow +1.000 UP +1.000 UL +LT0 +6311 4739 M +('M20.keV' us 1:3) Rshow +749 420 Pls +783 773 Pls +818 1122 Pls +853 1466 Pls +888 1806 Pls +922 2135 Pls +957 2433 Pls +992 2717 Pls +1026 2986 Pls +1061 3240 Pls +1096 3470 Pls +1131 3673 Pls +1165 3856 Pls +1200 4003 Pls +1235 4128 Pls +1269 4232 Pls +1304 4316 Pls +1339 4379 Pls +1374 4420 Pls +1408 4439 Pls +1443 4446 Pls +1478 4432 Pls +1512 4398 Pls +1547 4343 Pls +1582 4275 Pls +1616 4221 Pls +1651 4150 Pls +1686 4062 Pls +1721 3957 Pls +1755 3856 Pls +1790 3771 Pls +1825 3672 Pls +1859 3560 Pls +1894 3435 Pls +1929 3323 Pls +1964 3215 Pls +1998 3105 Pls +2033 3010 Pls +2068 2905 Pls +2102 2824 Pls +2137 2739 Pls +2172 2648 Pls +2207 2549 Pls +2241 2447 Pls +2276 2378 Pls +2311 2304 Pls +2345 2224 Pls +2380 2140 Pls +2415 2062 Pls +2450 2003 Pls +2484 1941 Pls +2519 1875 Pls +2554 1805 Pls +2588 1747 Pls +2623 1697 Pls +2658 1644 Pls +2693 1589 Pls +2727 1530 Pls +2762 1490 Pls +2797 1453 Pls +2831 1413 Pls +2866 1372 Pls +2901 1330 Pls +2936 1299 Pls +2970 1266 Pls +3005 1232 Pls +3040 1197 Pls +3074 1164 Pls +3109 1139 Pls +3144 1113 Pls +3178 1086 Pls +3213 1058 Pls +3248 1037 Pls +3283 1022 Pls +3317 1006 Pls +3352 989 Pls +3387 972 Pls +3421 955 Pls +3456 936 Pls +3491 917 Pls +3526 898 Pls +3560 877 Pls +3595 856 Pls +3630 835 Pls +3664 821 Pls +3699 811 Pls +3734 801 Pls +3769 791 Pls +3803 780 Pls +3838 769 Pls +3873 758 Pls +3907 746 Pls +3942 734 Pls +3977 722 Pls +4012 709 Pls +4046 697 Pls +4081 688 Pls +4116 682 Pls +4150 675 Pls +4185 669 Pls +4220 662 Pls +4255 654 Pls +4289 647 Pls +4324 640 Pls +4359 632 Pls +4393 624 Pls +4428 616 Pls +4463 608 Pls +4498 603 Pls +4532 599 Pls +4567 594 Pls +4602 590 Pls +4636 585 Pls +4671 581 Pls +4706 576 Pls +4740 571 Pls +4775 566 Pls +4810 561 Pls +4845 556 Pls +4879 550 Pls +4914 546 Pls +4949 541 Pls +4983 536 Pls +5018 532 Pls +5053 527 Pls +5088 522 Pls +5122 517 Pls +5157 512 Pls +5192 507 Pls +5226 502 Pls +5261 496 Pls +5296 491 Pls +5331 485 Pls +5365 480 Pls +5400 474 Pls +5435 468 Pls +5469 463 Pls +5504 457 Pls +5539 451 Pls +5574 445 Pls +5608 439 Pls +5643 432 Pls +5678 426 Pls +5712 420 Pls +5747 420 Pls +5782 420 Pls +5817 420 Pls +5851 420 Pls +5886 420 Pls +5921 420 Pls +5955 420 Pls +5990 420 Pls +6025 420 Pls +6060 420 Pls +6094 420 Pls +6129 420 Pls +6164 420 Pls +6198 420 Pls +6233 420 Pls +6268 420 Pls +6302 420 Pls +6337 420 Pls +6372 420 Pls +6407 420 Pls +6441 420 Pls +6476 420 Pls +6511 420 Pls +6594 4739 Pls +1.000 UL +LT1 +6311 4599 M +(exp\(-x*x/55.\)*sin\(x/180*3.14\)*14.7) Rshow +6395 4599 M +399 0 V +749 737 M +58 525 V +58 509 V +58 484 V +59 449 V +58 408 V +58 359 V +58 306 V +58 250 V +59 192 V +58 133 V +58 76 V +58 21 V +58 -30 V +59 -77 V +58 -118 V +58 -153 V +58 -181 V +58 -205 V +59 -220 V +58 -232 V +58 -236 V +58 -237 V +58 -232 V +59 -225 V +58 -215 V +58 -202 V +58 -187 V +58 -172 V +59 -156 V +58 -140 V +58 -125 V +58 -110 V +58 -96 V +59 -83 V +58 -70 V +58 -61 V +58 -50 V +58 -42 V +59 -35 V +58 -29 V +58 -23 V +58 -19 V +58 -15 V +59 -12 V +58 -10 V +58 -7 V +58 -6 V +58 -5 V +59 -3 V +58 -3 V +58 -2 V +58 -1 V +58 -1 V +59 -1 V +58 -1 V +58 0 V +58 0 V +58 0 V +59 -1 V +58 0 V +58 0 V +58 0 V +58 0 V +59 0 V +58 0 V +58 0 V +58 0 V +58 0 V +59 0 V +58 0 V +58 0 V +58 0 V +58 0 V +59 0 V +58 0 V +58 0 V +58 0 V +59 0 V +58 0 V +58 0 V +58 0 V +58 0 V +59 0 V +58 0 V +58 0 V +58 0 V +58 0 V +59 0 V +58 0 V +58 0 V +58 0 V +58 0 V +59 0 V +58 0 V +58 0 V +58 0 V +58 0 V +59 0 V +58 0 V +stroke +grestore +end +showpage +%%Trailer +%%DocumentFonts: Helvetica +%%Pages: 1 diff --git a/geant4/LEMuSR/MEYER/M10sin.pdf b/geant4/LEMuSR/MEYER/M10sin.pdf new file mode 100644 index 0000000..3d27250 Binary files /dev/null and b/geant4/LEMuSR/MEYER/M10sin.pdf differ diff --git a/geant4/LEMuSR/MEYER/M20.keV b/geant4/LEMuSR/MEYER/M20.keV new file mode 100644 index 0000000..6a4c7db --- /dev/null +++ b/geant4/LEMuSR/MEYER/M20.keV @@ -0,0 +1,167 @@ +0.25 1 0 +0.5 0.993513 0.0714331 +0.75 0.987026 0.141932 +1 0.980539 0.211496 +1.25 0.974052 0.280122 +1.5 0.964213 0.346606 +1.75 0.943444 0.406954 +2 0.922675 0.464309 +2.25 0.901907 0.51867 +2.5 0.881138 0.570036 +2.75 0.857883 0.61662 +3 0.831818 0.65763 +3.25 0.805398 0.694578 +3.5 0.775248 0.724233 +3.75 0.745097 0.749546 +4 0.715117 0.770701 +4.25 0.685209 0.787622 +4.5 0.655301 0.800238 +4.75 0.625393 0.808549 +5 0.595485 0.812558 +5.25 0.566648 0.813804 +5.5 0.537881 0.811008 +5.75 0.509114 0.804079 +6 0.480348 0.793016 +6.25 0.452393 0.779221 +6.5 0.428307 0.768354 +6.75 0.404221 0.754029 +7 0.380135 0.736248 +7.25 0.356049 0.715014 +7.5 0.334012 0.694589 +7.75 0.314943 0.677392 +8 0.295875 0.657464 +8.25 0.276806 0.634807 +8.5 0.257738 0.609422 +8.75 0.240951 0.58687 +9 0.225432 0.565096 +9.25 0.210588 0.542846 +9.5 0.197664 0.523563 +9.75 0.18474 0.502434 +10 0.174136 0.485941 +10.25 0.163856 0.46886 +10.5 0.153576 0.450315 +10.75 0.143296 0.430307 +11 0.133336 0.40982 +11.25 0.125899 0.395852 +11.5 0.118463 0.380827 +11.75 0.111026 0.364747 +12 0.10359 0.347611 +12.25 0.096884 0.331926 +12.5 0.0915531 0.320098 +12.75 0.0862222 0.307515 +13 0.0808912 0.294177 +13.25 0.0755603 0.280086 +13.5 0.0710447 0.268323 +13.75 0.0671152 0.258176 +14 0.0631856 0.247475 +14.25 0.0592561 0.236221 +14.5 0.0553265 0.224414 +14.75 0.0524258 0.216299 +15 0.0497562 0.208746 +15.25 0.0470865 0.200818 +15.5 0.0444169 0.192515 +15.75 0.0417789 0.183978 +16 0.0397257 0.177687 +16.25 0.0376725 0.171109 +16.5 0.0356193 0.164243 +16.75 0.033566 0.157091 +17 0.031672 0.150409 +17.25 0.0301754 0.145378 +17.5 0.0286788 0.140138 +17.75 0.0271822 0.13469 +18 0.0256856 0.129035 +18.25 0.0244893 0.124701 +18.5 0.0235693 0.121626 +18.75 0.0226493 0.118424 +19 0.0217293 0.115095 +19.25 0.0208093 0.111638 +19.5 0.0198893 0.108053 +19.75 0.0189694 0.104342 +20 0.0180494 0.100504 +20.25 0.0171294 0.0965393 +20.5 0.0162094 0.0924486 +20.75 0.0152894 0.0882321 +21 0.0143694 0.08389 +21.25 0.0137161 0.0809972 +21.5 0.013235 0.0790439 +21.75 0.0127539 0.0770247 +22 0.0122729 0.0749396 +22.25 0.0117918 0.0727889 +22.5 0.0113107 0.0705726 +22.75 0.0108296 0.068291 +23 0.0103485 0.0659441 +23.25 0.00986747 0.0635322 +23.5 0.00938639 0.0610554 +23.75 0.00890531 0.0585139 +24 0.00842423 0.0559078 +24.25 0.0080902 0.0542229 +24.5 0.00782091 0.0529312 +24.75 0.00755161 0.0516032 +25 0.00728232 0.050239 +25.25 0.00701303 0.0488387 +25.5 0.00674374 0.0474024 +25.75 0.00647445 0.0459301 +26 0.00620516 0.044422 +26.25 0.00593587 0.0428782 +26.5 0.00566658 0.0412987 +26.75 0.00539729 0.0396838 +27 0.00512799 0.0380334 +27.25 0.00494651 0.0370046 +27.5 0.00478963 0.0361375 +27.75 0.00463276 0.0352497 +28 0.00447588 0.0343412 +28.25 0.00431901 0.0334121 +28.5 0.00416213 0.0324624 +28.75 0.00400526 0.0314922 +29 0.00384838 0.0305016 +29.25 0.00369151 0.0294907 +29.5 0.00353463 0.0284594 +29.75 0.00337775 0.027408 +30 0.00322088 0.0263364 +30.25 0.00308359 0.025406 +30.5 0.00294928 0.0244828 +30.75 0.00281497 0.0235425 +31 0.00268065 0.022585 +31.25 0.00254634 0.0216106 +31.5 0.00241203 0.0206192 +31.75 0.00227772 0.0196108 +32 0.00214341 0.0185857 +32.25 0.0020091 0.0175437 +32.5 0.00187479 0.016485 +32.75 0.00174048 0.0154097 +33 0.00160617 0.0143178 +33.25 0.00147186 0.0132094 +33.5 0.00133755 0.0120846 +33.75 0.00120323 0.0109433 +34 0.00106892 0.00978579 +34.25 0.000934612 0.00861199 +34.5 0.000800302 0.00742201 +34.75 0.000665991 0.00621593 +35 0.00053168 0.00499382 +35.25 0.000397369 0.00375574 +35.5 0.000263058 0.00250177 +35.75 0.000128747 0.00123197 +36 0 0 +36.25 0 0 +36.5 0 0 +36.75 0 0 +37 0 0 +37.25 0 0 +37.5 0 0 +37.75 0 0 +38 0 0 +38.25 0 0 +38.5 0 0 +38.75 0 0 +39 0 0 +39.25 0 0 +39.5 0 0 +39.75 0 0 +40 0 0 +40.25 0 0 +40.5 0 0 +40.75 0 0 +41 0 0 +41.25 0 0 +41.5 0 0 +41.75 0 0 diff --git a/geant4/LEMuSR/MEYER/M20sin.eps b/geant4/LEMuSR/MEYER/M20sin.eps new file mode 100644 index 0000000..7cc6f40 --- /dev/null +++ b/geant4/LEMuSR/MEYER/M20sin.eps @@ -0,0 +1,805 @@ +%!PS-Adobe-2.0 +%%Title: M20sin.eps +%%Creator: gnuplot 3.7 patchlevel 3 +%%CreationDate: Tue Apr 12 08:56:48 2005 +%%DocumentFonts: (atend) +%%BoundingBox: 50 50 554 770 +%%Orientation: Landscape +%%Pages: (atend) +%%EndComments +/gnudict 256 dict def +gnudict begin +/Color true def +/Solid false def +/gnulinewidth 5.000 def +/userlinewidth gnulinewidth def +/vshift -46 def +/dl {10 mul} def +/hpt_ 31.5 def +/vpt_ 31.5 def +/hpt hpt_ def +/vpt vpt_ def +/M {moveto} bind def +/L {lineto} bind def +/R {rmoveto} bind def +/V {rlineto} bind def +/vpt2 vpt 2 mul def +/hpt2 hpt 2 mul def +/Lshow { currentpoint stroke M + 0 vshift R show } def +/Rshow { currentpoint stroke M + dup stringwidth pop neg vshift R show } def +/Cshow { currentpoint stroke M + dup stringwidth pop -2 div vshift R show } def +/UP { dup vpt_ mul /vpt exch def hpt_ mul /hpt exch def + /hpt2 hpt 2 mul def /vpt2 vpt 2 mul def } def +/DL { Color {setrgbcolor Solid {pop []} if 0 setdash } + {pop pop pop Solid {pop []} if 0 setdash} ifelse } def +/BL { stroke userlinewidth 2 mul setlinewidth } def +/AL { stroke userlinewidth 2 div setlinewidth } def +/UL { dup gnulinewidth mul /userlinewidth exch def + dup 1 lt {pop 1} if 10 mul /udl exch def } def +/PL { stroke userlinewidth setlinewidth } def +/LTb { BL [] 0 0 0 DL } def +/LTa { AL [1 udl mul 2 udl mul] 0 setdash 0 0 0 setrgbcolor } def +/LT0 { PL [] 1 0 0 DL } def +/LT1 { PL [4 dl 2 dl] 0 1 0 DL } def +/LT2 { PL [2 dl 3 dl] 0 0 1 DL } def +/LT3 { PL [1 dl 1.5 dl] 1 0 1 DL } def +/LT4 { PL [5 dl 2 dl 1 dl 2 dl] 0 1 1 DL } def +/LT5 { PL [4 dl 3 dl 1 dl 3 dl] 1 1 0 DL } def +/LT6 { PL [2 dl 2 dl 2 dl 4 dl] 0 0 0 DL } def +/LT7 { PL [2 dl 2 dl 2 dl 2 dl 2 dl 4 dl] 1 0.3 0 DL } def +/LT8 { PL [2 dl 2 dl 2 dl 2 dl 2 dl 2 dl 2 dl 4 dl] 0.5 0.5 0.5 DL } def +/Pnt { stroke [] 0 setdash + gsave 1 setlinecap M 0 0 V stroke grestore } def +/Dia { stroke [] 0 setdash 2 copy vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath stroke + Pnt } def +/Pls { stroke [] 0 setdash vpt sub M 0 vpt2 V + currentpoint stroke M + hpt neg vpt neg R hpt2 0 V stroke + } def +/Box { stroke [] 0 setdash 2 copy exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath stroke + Pnt } def +/Crs { stroke [] 0 setdash exch hpt sub exch vpt add M + hpt2 vpt2 neg V currentpoint stroke M + hpt2 neg 0 R hpt2 vpt2 V stroke } def +/TriU { stroke [] 0 setdash 2 copy vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath stroke + Pnt } def +/Star { 2 copy Pls Crs } def +/BoxF { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath fill } def +/TriUF { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath fill } def +/TriD { stroke [] 0 setdash 2 copy vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath stroke + Pnt } def +/TriDF { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath fill} def +/DiaF { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath fill } def +/Pent { stroke [] 0 setdash 2 copy gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath stroke grestore Pnt } def +/PentF { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath fill grestore } def +/Circle { stroke [] 0 setdash 2 copy + hpt 0 360 arc stroke Pnt } def +/CircleF { stroke [] 0 setdash hpt 0 360 arc fill } def +/C0 { BL [] 0 setdash 2 copy moveto vpt 90 450 arc } bind def +/C1 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc closepath fill + vpt 0 360 arc closepath } bind def +/C2 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C3 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C4 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 180 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C5 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc + 2 copy moveto + 2 copy vpt 180 270 arc closepath fill + vpt 0 360 arc } bind def +/C6 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C7 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C8 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 270 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C9 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 270 450 arc closepath fill + vpt 0 360 arc closepath } bind def +/C10 { BL [] 0 setdash 2 copy 2 copy moveto vpt 270 360 arc closepath fill + 2 copy moveto + 2 copy vpt 90 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C11 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 180 arc closepath fill + 2 copy moveto + 2 copy vpt 270 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C12 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 180 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C13 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc closepath fill + 2 copy moveto + 2 copy vpt 180 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C14 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 360 arc closepath fill + vpt 0 360 arc } bind def +/C15 { BL [] 0 setdash 2 copy vpt 0 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/Rec { newpath 4 2 roll moveto 1 index 0 rlineto 0 exch rlineto + neg 0 rlineto closepath } bind def +/Square { dup Rec } bind def +/Bsquare { vpt sub exch vpt sub exch vpt2 Square } bind def +/S0 { BL [] 0 setdash 2 copy moveto 0 vpt rlineto BL Bsquare } bind def +/S1 { BL [] 0 setdash 2 copy vpt Square fill Bsquare } bind def +/S2 { BL [] 0 setdash 2 copy exch vpt sub exch vpt Square fill Bsquare } bind def +/S3 { BL [] 0 setdash 2 copy exch vpt sub exch vpt2 vpt Rec fill Bsquare } bind def +/S4 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt Square fill Bsquare } bind def +/S5 { BL [] 0 setdash 2 copy 2 copy vpt Square fill + exch vpt sub exch vpt sub vpt Square fill Bsquare } bind def +/S6 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt vpt2 Rec fill Bsquare } bind def +/S7 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt vpt2 Rec fill + 2 copy vpt Square fill + Bsquare } bind def +/S8 { BL [] 0 setdash 2 copy vpt sub vpt Square fill Bsquare } bind def +/S9 { BL [] 0 setdash 2 copy vpt sub vpt vpt2 Rec fill Bsquare } bind def +/S10 { BL [] 0 setdash 2 copy vpt sub vpt Square fill 2 copy exch vpt sub exch vpt Square fill + Bsquare } bind def +/S11 { BL [] 0 setdash 2 copy vpt sub vpt Square fill 2 copy exch vpt sub exch vpt2 vpt Rec fill + Bsquare } bind def +/S12 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill Bsquare } bind def +/S13 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill + 2 copy vpt Square fill Bsquare } bind def +/S14 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill + 2 copy exch vpt sub exch vpt Square fill Bsquare } bind def +/S15 { BL [] 0 setdash 2 copy Bsquare fill Bsquare } bind def +/D0 { gsave translate 45 rotate 0 0 S0 stroke grestore } bind def +/D1 { gsave translate 45 rotate 0 0 S1 stroke grestore } bind def +/D2 { gsave translate 45 rotate 0 0 S2 stroke grestore } bind def +/D3 { gsave translate 45 rotate 0 0 S3 stroke grestore } bind def +/D4 { gsave translate 45 rotate 0 0 S4 stroke grestore } bind def +/D5 { gsave translate 45 rotate 0 0 S5 stroke grestore } bind def +/D6 { gsave translate 45 rotate 0 0 S6 stroke grestore } bind def +/D7 { gsave translate 45 rotate 0 0 S7 stroke grestore } bind def +/D8 { gsave translate 45 rotate 0 0 S8 stroke grestore } bind def +/D9 { gsave translate 45 rotate 0 0 S9 stroke grestore } bind def +/D10 { gsave translate 45 rotate 0 0 S10 stroke grestore } bind def +/D11 { gsave translate 45 rotate 0 0 S11 stroke grestore } bind def +/D12 { gsave translate 45 rotate 0 0 S12 stroke grestore } bind def +/D13 { gsave translate 45 rotate 0 0 S13 stroke grestore } bind def +/D14 { gsave translate 45 rotate 0 0 S14 stroke grestore } bind def +/D15 { gsave translate 45 rotate 0 0 S15 stroke grestore } bind def +/DiaE { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath stroke } def +/BoxE { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath stroke } def +/TriUE { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath stroke } def +/TriDE { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath stroke } def +/PentE { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath stroke grestore } def +/CircE { stroke [] 0 setdash + hpt 0 360 arc stroke } def +/Opaque { gsave closepath 1 setgray fill grestore 0 setgray closepath } def +/DiaW { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V Opaque stroke } def +/BoxW { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V Opaque stroke } def +/TriUW { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V Opaque stroke } def +/TriDW { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V Opaque stroke } def +/PentW { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + Opaque stroke grestore } def +/CircW { stroke [] 0 setdash + hpt 0 360 arc Opaque stroke } def +/BoxFill { gsave Rec 1 setgray fill grestore } def +/Symbol-Oblique /Symbol findfont [1 0 .167 1 0 0] makefont +dup length dict begin {1 index /FID eq {pop pop} {def} ifelse} forall +currentdict end definefont pop +end +%%EndProlog +%%Page: 1 1 +gnudict begin +gsave +50 50 translate +0.100 0.100 scale +90 rotate +0 -5040 translate +0 setgray +newpath +(Helvetica) findfont 140 scalefont setfont +1.000 UL +LTb +1.000 UL +LTa +714 420 M +6248 0 V +1.000 UL +LTb +714 420 M +63 0 V +6185 0 R +-63 0 V +630 420 M +( 0) Rshow +1.000 UL +LTa +714 915 M +6248 0 V +1.000 UL +LTb +714 915 M +63 0 V +6185 0 R +-63 0 V +630 915 M +( 0.1) Rshow +1.000 UL +LTa +714 1409 M +6248 0 V +1.000 UL +LTb +714 1409 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.2) Rshow +1.000 UL +LTa +714 1904 M +6248 0 V +1.000 UL +LTb +714 1904 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.3) Rshow +1.000 UL +LTa +714 2399 M +6248 0 V +1.000 UL +LTb +714 2399 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.4) Rshow +1.000 UL +LTa +714 2893 M +6248 0 V +1.000 UL +LTb +714 2893 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.5) Rshow +1.000 UL +LTa +714 3388 M +6248 0 V +1.000 UL +LTb +714 3388 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.6) Rshow +1.000 UL +LTa +714 3883 M +6248 0 V +1.000 UL +LTb +714 3883 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.7) Rshow +1.000 UL +LTa +714 4377 M +6248 0 V +1.000 UL +LTb +714 4377 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.8) Rshow +1.000 UL +LTa +714 4872 M +6248 0 V +1.000 UL +LTb +714 4872 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.9) Rshow +1.000 UL +LTa +714 420 M +0 4452 V +1.000 UL +LTb +714 420 M +0 63 V +0 4389 R +0 -63 V +714 280 M +( 0) Cshow +1.000 UL +LTa +1408 420 M +0 4452 V +1.000 UL +LTb +1408 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 5) Cshow +1.000 UL +LTa +2102 420 M +0 4452 V +1.000 UL +LTb +2102 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 10) Cshow +1.000 UL +LTa +2797 420 M +0 4452 V +1.000 UL +LTb +2797 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 15) Cshow +1.000 UL +LTa +3491 420 M +0 4109 V +0 280 R +0 63 V +1.000 UL +LTb +3491 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 20) Cshow +1.000 UL +LTa +4185 420 M +0 4109 V +0 280 R +0 63 V +1.000 UL +LTb +4185 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 25) Cshow +1.000 UL +LTa +4879 420 M +0 4109 V +0 280 R +0 63 V +1.000 UL +LTb +4879 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 30) Cshow +1.000 UL +LTa +5574 420 M +0 4109 V +0 280 R +0 63 V +1.000 UL +LTb +5574 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 35) Cshow +1.000 UL +LTa +6268 420 M +0 4109 V +0 280 R +0 63 V +1.000 UL +LTb +6268 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 40) Cshow +1.000 UL +LTa +6962 420 M +0 4452 V +1.000 UL +LTb +6962 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 45) Cshow +1.000 UL +LTb +714 420 M +6248 0 V +0 4452 V +-6248 0 V +714 420 L +140 2646 M +currentpoint gsave translate 90 rotate 0 0 M +(distribution) Cshow +grestore +3838 70 M +([deg]) Cshow +1.000 UP +1.000 UL +LT0 +6311 4739 M +('M20.keV' us 1:3) Rshow +749 420 Pls +783 773 Pls +818 1122 Pls +853 1466 Pls +888 1806 Pls +922 2135 Pls +957 2433 Pls +992 2717 Pls +1026 2986 Pls +1061 3240 Pls +1096 3470 Pls +1131 3673 Pls +1165 3856 Pls +1200 4003 Pls +1235 4128 Pls +1269 4232 Pls +1304 4316 Pls +1339 4379 Pls +1374 4420 Pls +1408 4439 Pls +1443 4446 Pls +1478 4432 Pls +1512 4398 Pls +1547 4343 Pls +1582 4275 Pls +1616 4221 Pls +1651 4150 Pls +1686 4062 Pls +1721 3957 Pls +1755 3856 Pls +1790 3771 Pls +1825 3672 Pls +1859 3560 Pls +1894 3435 Pls +1929 3323 Pls +1964 3215 Pls +1998 3105 Pls +2033 3010 Pls +2068 2905 Pls +2102 2824 Pls +2137 2739 Pls +2172 2648 Pls +2207 2549 Pls +2241 2447 Pls +2276 2378 Pls +2311 2304 Pls +2345 2224 Pls +2380 2140 Pls +2415 2062 Pls +2450 2003 Pls +2484 1941 Pls +2519 1875 Pls +2554 1805 Pls +2588 1747 Pls +2623 1697 Pls +2658 1644 Pls +2693 1589 Pls +2727 1530 Pls +2762 1490 Pls +2797 1453 Pls +2831 1413 Pls +2866 1372 Pls +2901 1330 Pls +2936 1299 Pls +2970 1266 Pls +3005 1232 Pls +3040 1197 Pls +3074 1164 Pls +3109 1139 Pls +3144 1113 Pls +3178 1086 Pls +3213 1058 Pls +3248 1037 Pls +3283 1022 Pls +3317 1006 Pls +3352 989 Pls +3387 972 Pls +3421 955 Pls +3456 936 Pls +3491 917 Pls +3526 898 Pls +3560 877 Pls +3595 856 Pls +3630 835 Pls +3664 821 Pls +3699 811 Pls +3734 801 Pls +3769 791 Pls +3803 780 Pls +3838 769 Pls +3873 758 Pls +3907 746 Pls +3942 734 Pls +3977 722 Pls +4012 709 Pls +4046 697 Pls +4081 688 Pls +4116 682 Pls +4150 675 Pls +4185 669 Pls +4220 662 Pls +4255 654 Pls +4289 647 Pls +4324 640 Pls +4359 632 Pls +4393 624 Pls +4428 616 Pls +4463 608 Pls +4498 603 Pls +4532 599 Pls +4567 594 Pls +4602 590 Pls +4636 585 Pls +4671 581 Pls +4706 576 Pls +4740 571 Pls +4775 566 Pls +4810 561 Pls +4845 556 Pls +4879 550 Pls +4914 546 Pls +4949 541 Pls +4983 536 Pls +5018 532 Pls +5053 527 Pls +5088 522 Pls +5122 517 Pls +5157 512 Pls +5192 507 Pls +5226 502 Pls +5261 496 Pls +5296 491 Pls +5331 485 Pls +5365 480 Pls +5400 474 Pls +5435 468 Pls +5469 463 Pls +5504 457 Pls +5539 451 Pls +5574 445 Pls +5608 439 Pls +5643 432 Pls +5678 426 Pls +5712 420 Pls +5747 420 Pls +5782 420 Pls +5817 420 Pls +5851 420 Pls +5886 420 Pls +5921 420 Pls +5955 420 Pls +5990 420 Pls +6025 420 Pls +6060 420 Pls +6094 420 Pls +6129 420 Pls +6164 420 Pls +6198 420 Pls +6233 420 Pls +6268 420 Pls +6302 420 Pls +6337 420 Pls +6372 420 Pls +6407 420 Pls +6441 420 Pls +6476 420 Pls +6511 420 Pls +6594 4739 Pls +1.000 UL +LT1 +6311 4599 M +(exp\(-x*x/55.\)*sin\(x/180*3.14\)*14.7) Rshow +6395 4599 M +399 0 V +714 420 M +63 574 V +63 562 V +63 536 V +63 499 V +64 453 V +63 397 V +63 335 V +63 269 V +63 200 V +63 131 V +63 65 V +63 1 V +63 -56 V +64 -108 V +63 -152 V +63 -189 V +63 -217 V +63 -238 V +63 -250 V +63 -256 V +63 -257 V +63 -250 V +64 -241 V +63 -228 V +63 -211 V +63 -194 V +63 -176 V +63 -157 V +63 -138 V +63 -121 V +63 -104 V +64 -89 V +63 -75 V +63 -63 V +63 -52 V +63 -43 V +63 -34 V +63 -28 V +63 -22 V +63 -17 V +64 -14 V +63 -11 V +63 -8 V +63 -6 V +63 -4 V +63 -4 V +63 -2 V +63 -2 V +63 -2 V +64 -1 V +63 0 V +63 -1 V +63 0 V +63 0 V +63 -1 V +63 0 V +63 0 V +63 0 V +64 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +64 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +64 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +64 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +63 0 V +64 0 V +63 0 V +63 0 V +63 0 V +63 0 V +stroke +grestore +end +showpage +%%Trailer +%%DocumentFonts: Helvetica +%%Pages: 1 diff --git a/geant4/LEMuSR/MEYER/M30.keV b/geant4/LEMuSR/MEYER/M30.keV new file mode 100644 index 0000000..b92bacc --- /dev/null +++ b/geant4/LEMuSR/MEYER/M30.keV @@ -0,0 +1,111 @@ +0.25 1 0 +0.5 0.990251 0.160806 +0.75 0.980502 0.318444 +1 0.970753 0.472909 +1.25 0.943207 0.612639 +1.5 0.911995 0.740436 +1.75 0.880783 0.858084 +2 0.84433 0.959627 +2.25 0.804711 1.0452 +2.5 0.759399 1.10958 +2.75 0.714265 1.15953 +3 0.669317 1.19514 +3.25 0.62437 1.21614 +3.5 0.579965 1.22369 +3.75 0.536733 1.21948 +4 0.493501 1.20124 +4.25 0.451294 1.17162 +4.5 0.415097 1.14488 +4.75 0.378899 1.10639 +5 0.342701 1.05616 +5.25 0.313856 1.01805 +5.5 0.285199 0.971222 +5.75 0.256542 0.91511 +6 0.232174 0.865709 +6.25 0.209704 0.815799 +6.5 0.190281 0.770961 +6.75 0.173374 0.730441 +7 0.157925 0.690826 +7.25 0.142476 0.646215 +7.5 0.129003 0.605895 +7.75 0.117827 0.572379 +8 0.106651 0.535254 +8.25 0.0963976 0.499303 +8.5 0.088386 0.472015 +8.75 0.0803744 0.442142 +9 0.0726174 0.411129 +9.25 0.0667118 0.388398 +9.5 0.0608063 0.363766 +9.75 0.0549008 0.337233 +10 0.0507941 0.32014 +10.25 0.046782 0.302337 +10.5 0.04277 0.283246 +10.75 0.0394798 0.267763 +11 0.0363941 0.252644 +11.25 0.0333085 0.236535 +11.5 0.0307317 0.223133 +11.75 0.0284825 0.211337 +12 0.0262334 0.198821 +12.25 0.0243634 0.18852 +12.5 0.0229808 0.181471 +12.75 0.0215982 0.173979 +13 0.0202156 0.166045 +13.25 0.018833 0.15767 +13.5 0.0174504 0.148854 +13.75 0.0160678 0.139599 +14 0.0146852 0.129905 +14.25 0.0136393 0.122803 +14.5 0.0129163 0.118327 +14.75 0.0121933 0.113622 +15 0.0114703 0.108687 +15.25 0.0107473 0.103523 +15.5 0.0100243 0.0981307 +15.75 0.00930134 0.0925096 +16 0.00857836 0.0866604 +16.25 0.00804106 0.0824885 +16.5 0.00763635 0.0795281 +16.75 0.00723165 0.0764401 +17 0.00682694 0.0732246 +17.25 0.00642224 0.0698818 +17.5 0.00601753 0.0664119 +17.75 0.00561283 0.0628153 +18 0.00520812 0.0590922 +18.25 0.0049143 0.0565179 +18.5 0.00467854 0.0545286 +18.75 0.00444278 0.0524655 +19 0.00420702 0.0503287 +19.25 0.00397126 0.0481185 +19.5 0.0037355 0.045835 +19.75 0.00349974 0.0434784 +20 0.00326398 0.0410487 +20.25 0.00305295 0.038861 +20.5 0.0028511 0.0367263 +20.75 0.00264925 0.0345295 +21 0.0024474 0.0322706 +21.25 0.00224555 0.0299498 +21.5 0.0020437 0.0275673 +21.75 0.00184185 0.0251231 +22 0.00164 0.0226174 +22.25 0.00143816 0.0200504 +22.5 0.00123631 0.0174223 +22.75 0.00103446 0.0147331 +23 0.000832607 0.0119831 +23.25 0.000630758 0.0091724 +23.5 0.000428908 0.00630118 +23.75 0.000227059 0.00336962 +24 2.52097e-05 0.00037787 +24.25 0 0 +24.5 0 0 +24.75 0 0 +25 0 0 +25.25 0 0 +25.5 0 0 +25.75 0 0 +26 0 0 +26.25 0 0 +26.5 0 0 +26.75 0 0 +27 0 0 +27.25 0 0 +27.5 0 0 +27.75 0 0 diff --git a/geant4/LEMuSR/MEYER/M5.keV b/geant4/LEMuSR/MEYER/M5.keV new file mode 100644 index 0000000..0fbb5c9 --- /dev/null +++ b/geant4/LEMuSR/MEYER/M5.keV @@ -0,0 +1,203 @@ +0.5 1 0 +1 0.996752 0.00898079 +1.5 0.993505 0.0179024 +2 0.990257 0.0267641 +2.5 0.98701 0.0355652 +3 0.983762 0.0443052 +3.5 0.980515 0.0529833 +4 0.977267 0.061599 +4.5 0.974019 0.0701516 +5 0.970772 0.0786404 +5.5 0.964082 0.0867551 +6 0.953685 0.0943763 +6.5 0.943287 0.101804 +7 0.93289 0.109037 +7.5 0.922492 0.116076 +8 0.912095 0.12292 +8.5 0.901697 0.129569 +9 0.8913 0.136023 +9.5 0.880902 0.14228 +10 0.870505 0.148342 +10.5 0.857554 0.153751 +11 0.844505 0.158899 +11.5 0.831456 0.163804 +12 0.818407 0.168465 +12.5 0.804942 0.172794 +13 0.789848 0.176508 +13.5 0.774753 0.179944 +14 0.759659 0.1831 +14.5 0.744565 0.185979 +15 0.729524 0.188593 +15.5 0.714551 0.190948 +16 0.699579 0.193028 +16.5 0.684606 0.194834 +17 0.669633 0.196365 +17.5 0.65466 0.197622 +18 0.639687 0.198607 +18.5 0.624714 0.199319 +19 0.609741 0.199759 +19.5 0.594768 0.199928 +20 0.580324 0.20001 +20.5 0.565922 0.199845 +21 0.551521 0.199422 +21.5 0.537119 0.19874 +22 0.522718 0.197801 +22.5 0.508316 0.196605 +23 0.493915 0.195154 +23.5 0.479513 0.193448 +24 0.465111 0.191488 +24.5 0.451664 0.189677 +25 0.439606 0.188224 +25.5 0.427548 0.18656 +26 0.415489 0.184684 +26.5 0.403431 0.182598 +27 0.391373 0.180303 +27.5 0.379315 0.1778 +28 0.367257 0.17509 +28.5 0.355198 0.172173 +29 0.34314 0.169052 +29.5 0.333314 0.166844 +30 0.323768 0.164611 +30.5 0.314222 0.162215 +31 0.304675 0.159658 +31.5 0.295129 0.156941 +32 0.285583 0.154064 +32.5 0.276037 0.151029 +33 0.26649 0.147837 +33.5 0.256944 0.144488 +34 0.248055 0.141359 +34.5 0.240286 0.138731 +35 0.232516 0.135977 +35.5 0.224747 0.133098 +36 0.216977 0.130093 +36.5 0.210001 0.127446 +37 0.203531 0.124998 +37.5 0.197061 0.122447 +38 0.19059 0.119794 +38.5 0.18412 0.117038 +39 0.178777 0.114907 +39.5 0.173631 0.112819 +40 0.168484 0.110651 +40.5 0.163338 0.108402 +41 0.158191 0.106075 +41.5 0.153045 0.103668 +42 0.147898 0.101184 +42.5 0.142752 0.0986228 +43 0.137605 0.095985 +43.5 0.132933 0.0936053 +44 0.12921 0.0918317 +44.5 0.125487 0.0900024 +45 0.121764 0.0881181 +45.5 0.118041 0.0861791 +46 0.114318 0.0841862 +46.5 0.110595 0.0821398 +47 0.106872 0.0800406 +47.5 0.103149 0.0778891 +48 0.0994258 0.0756859 +48.5 0.0965613 0.0740903 +49 0.0938924 0.0726059 +49.5 0.0912236 0.0710841 +50 0.0885548 0.0695253 +50.5 0.0858859 0.0679299 +51 0.0832171 0.0662985 +51.5 0.0805483 0.0646314 +52 0.0778794 0.0629292 +52.5 0.0752106 0.0611922 +53 0.0727493 0.059591 +53.5 0.070782 0.0583656 +54 0.0688148 0.0571144 +54.5 0.0668475 0.0558378 +55 0.0648803 0.0545361 +55.5 0.062913 0.0532096 +56 0.0609458 0.0518588 +56.5 0.0589785 0.0504839 +57 0.0570113 0.0490854 +57.5 0.055044 0.0476636 +58 0.053567 0.0466457 +58.5 0.0522305 0.045733 +59 0.050894 0.0448041 +59.5 0.0495575 0.0438591 +60 0.048221 0.0428984 +60.5 0.0468845 0.0419223 +61 0.045548 0.0409309 +61.5 0.0442115 0.0399245 +62 0.042875 0.0389034 +62.5 0.0416183 0.0379406 +63 0.0405904 0.0371738 +63.5 0.0395625 0.0363957 +64 0.0385346 0.0356063 +64.5 0.0375067 0.034806 +65 0.0364788 0.0339949 +65.5 0.0354509 0.0331733 +66 0.034423 0.0323413 +66.5 0.0333951 0.0314991 +67 0.0323672 0.030647 +67.5 0.0315455 0.0299812 +68 0.0307963 0.0293764 +68.5 0.0300471 0.0287642 +69 0.0292978 0.0281448 +69.5 0.0285486 0.0275183 +70 0.0277993 0.0268848 +70.5 0.0270501 0.0262446 +71 0.0263008 0.0255977 +71.5 0.0255516 0.0249444 +72 0.0248663 0.0243474 +72.5 0.0244057 0.0239653 +73 0.0239451 0.0235788 +73.5 0.0234846 0.023188 +74 0.023024 0.0227931 +74.5 0.0225634 0.022394 +75 0.0221029 0.0219909 +75.5 0.0216423 0.021584 +76 0.0211817 0.0211733 +76.5 0.0207211 0.0207588 +77 0.0202606 0.0203408 +77.5 0.0198 0.0199193 +78 0.0193394 0.0194944 +78.5 0.0188788 0.0190662 +79 0.0184183 0.0186349 +79.5 0.0179577 0.0182005 +80 0.0174971 0.0177631 +80.5 0.0170366 0.0173228 +81 0.016576 0.0168798 +81.5 0.0161154 0.0164341 +82 0.0156548 0.0159859 +82.5 0.0151943 0.0155352 +83 0.0147337 0.0150822 +83.5 0.0142731 0.014627 +84 0.013906 0.0142654 +84.5 0.0136651 0.0140318 +85 0.0134243 0.0137966 +85.5 0.0131834 0.0135599 +86 0.0129426 0.0133219 +86.5 0.0127017 0.0130825 +87 0.0124609 0.0128417 +87.5 0.0122201 0.0125998 +88 0.0119792 0.0123566 +88.5 0.0117384 0.0121124 +89 0.0114975 0.011867 +89.5 0.0112567 0.0116206 +90 0.0110159 0.0113733 +90.5 0.010775 0.0111251 +91 0.0105342 0.010876 +91.5 0.0102933 0.0106261 +92 0.0100525 0.0103755 +92.5 0.00981164 0.0101242 +93 0.0095708 0.00987233 +93.5 0.00932995 0.00961987 +94 0.00908911 0.0093669 +94.5 0.00884827 0.00911348 +95 0.00860743 0.00885967 +95.5 0.00836658 0.00860553 +96 0.0081924 0.00841962 +96.5 0.00805759 0.00827379 +97 0.00792277 0.00812758 +97.5 0.00778795 0.00798104 +98 0.00765314 0.00783418 +98.5 0.00751832 0.00768704 +99 0.00738351 0.00753965 +99.5 0.00724869 0.00739205 +100 0.00711388 0.00724426 +100.5 0.00697906 0.00709633 +101 0.00684425 0.00694827 +101.5 1.96893e-305 -1.98021 diff --git a/geant4/LEMuSR/MEYER/M50.keV b/geant4/LEMuSR/MEYER/M50.keV new file mode 100644 index 0000000..245f489 --- /dev/null +++ b/geant4/LEMuSR/MEYER/M50.keV @@ -0,0 +1,134 @@ +0.125 1 0 +0.25 0.991892 0.222817 +0.375 0.983784 0.44199 +0.5 0.975677 0.657519 +0.625 0.964224 0.866397 +0.75 0.938266 1.05383 +0.875 0.912308 1.2296 +1 0.88635 1.3937 +1.125 0.857911 1.54168 +1.25 0.825333 1.66851 +1.375 0.790363 1.77532 +1.5 0.752679 1.85971 +1.625 0.715166 1.92763 +1.75 0.677784 1.97907 +1.875 0.640403 2.01372 +2 0.603022 2.03157 +2.125 0.56671 2.03646 +2.25 0.530755 2.02641 +2.375 0.4948 2.00021 +2.5 0.458846 1.95785 +2.625 0.428372 1.92397 +2.75 0.398268 1.87813 +2.875 0.368163 1.81878 +3 0.338838 1.74993 +3.125 0.315005 1.69752 +3.25 0.291172 1.6344 +3.375 0.267339 1.56058 +3.5 0.244888 1.48444 +3.625 0.22549 1.41743 +3.75 0.207408 1.35026 +3.875 0.191254 1.28797 +4 0.176749 1.22991 +4.125 0.1639 1.17723 +4.25 0.151052 1.11879 +4.375 0.138203 1.05459 +4.5 0.127794 1.00378 +4.625 0.118499 0.957314 +4.75 0.109204 0.906678 +4.875 0.0999093 0.851876 +5 0.0929137 0.813026 +5.125 0.0862508 0.774027 +5.25 0.0795878 0.732041 +5.375 0.0730317 0.688077 +5.5 0.0681202 0.65704 +5.625 0.0632088 0.623803 +5.75 0.0582974 0.588367 +5.875 0.0537771 0.554767 +6 0.0504404 0.531618 +6.125 0.0471037 0.506975 +6.25 0.043767 0.480839 +6.375 0.040766 0.456974 +6.5 0.0381998 0.436736 +6.625 0.0356336 0.415351 +6.75 0.0330673 0.392818 +6.875 0.0309346 0.374384 +7 0.029064 0.358228 +7.125 0.0271935 0.341237 +7.25 0.0253229 0.32341 +7.375 0.0240364 0.312337 +7.5 0.0228866 0.302494 +7.625 0.0217367 0.292138 +7.75 0.0205869 0.281269 +7.875 0.019437 0.269886 +8 0.0182872 0.25799 +8.125 0.0171373 0.245581 +8.25 0.0159874 0.232659 +8.375 0.0148376 0.219225 +8.5 0.0138407 0.207572 +8.625 0.0132394 0.201497 +8.75 0.0126381 0.195153 +8.875 0.0120368 0.188541 +9 0.0114356 0.181661 +9.125 0.0108343 0.174514 +9.25 0.010233 0.167098 +9.375 0.00963171 0.159416 +9.5 0.00903042 0.151466 +9.625 0.00842914 0.143248 +9.75 0.00802566 0.138169 +9.875 0.00768908 0.134077 +10 0.0073525 0.129836 +10.125 0.00701592 0.125445 +10.25 0.00667934 0.120904 +10.375 0.00634277 0.116214 +10.5 0.00600619 0.111374 +10.625 0.00566961 0.106386 +10.75 0.00533303 0.101248 +10.875 0.00502675 0.0965427 +11 0.00483068 0.0938429 +11.125 0.00463461 0.0910561 +11.25 0.00443854 0.0881824 +11.375 0.00424246 0.0852218 +11.5 0.00404639 0.0821744 +11.625 0.00385032 0.0790403 +11.75 0.00365424 0.0758195 +11.875 0.00345817 0.0725121 +12 0.0032621 0.069118 +12.125 0.00308532 0.0660504 +12.25 0.00291745 0.0630975 +12.375 0.00274958 0.0600706 +12.5 0.0025817 0.0569697 +12.625 0.00241383 0.0537949 +12.75 0.00224596 0.0505462 +12.875 0.00207809 0.0472236 +13 0.00191022 0.0438273 +13.125 0.00174235 0.0403572 +13.25 0.00157448 0.0368134 +13.375 0.00140661 0.033196 +13.5 0.00123874 0.0295051 +13.625 0.00107087 0.0257406 +13.75 0.000902998 0.0219027 +13.875 0.000735128 0.0179913 +14 0.000567257 0.0140066 +14.125 0.000399386 0.00994868 +14.25 0.000231516 0.00581749 +14.375 6.36452e-05 0.00161313 +14.5 0 0 +14.625 0 0 +14.75 0 0 +14.875 0 0 +15 0 0 +15.125 0 0 +15.25 0 0 +15.375 0 0 +15.5 0 0 +15.625 0 0 +15.75 0 0 +15.875 0 0 +16 0 0 +16.125 0 0 +16.25 0 0 +16.375 0 0 +16.5 0 0 +16.625 0 0 +16.75 0 0 diff --git a/geant4/LEMuSR/MEYER/Mall.eps b/geant4/LEMuSR/MEYER/Mall.eps new file mode 100644 index 0000000..622ca0d --- /dev/null +++ b/geant4/LEMuSR/MEYER/Mall.eps @@ -0,0 +1,1129 @@ +%!PS-Adobe-2.0 +%%Title: Mall.eps +%%Creator: gnuplot 3.7 patchlevel 3 +%%CreationDate: Mon Apr 11 19:40:19 2005 +%%DocumentFonts: (atend) +%%BoundingBox: 50 50 554 770 +%%Orientation: Landscape +%%Pages: (atend) +%%EndComments +/gnudict 256 dict def +gnudict begin +/Color true def +/Solid false def +/gnulinewidth 5.000 def +/userlinewidth gnulinewidth def +/vshift -46 def +/dl {10 mul} def +/hpt_ 31.5 def +/vpt_ 31.5 def +/hpt hpt_ def +/vpt vpt_ def +/M {moveto} bind def +/L {lineto} bind def +/R {rmoveto} bind def +/V {rlineto} bind def +/vpt2 vpt 2 mul def +/hpt2 hpt 2 mul def +/Lshow { currentpoint stroke M + 0 vshift R show } def +/Rshow { currentpoint stroke M + dup stringwidth pop neg vshift R show } def +/Cshow { currentpoint stroke M + dup stringwidth pop -2 div vshift R show } def +/UP { dup vpt_ mul /vpt exch def hpt_ mul /hpt exch def + /hpt2 hpt 2 mul def /vpt2 vpt 2 mul def } def +/DL { Color {setrgbcolor Solid {pop []} if 0 setdash } + {pop pop pop Solid {pop []} if 0 setdash} ifelse } def +/BL { stroke userlinewidth 2 mul setlinewidth } def +/AL { stroke userlinewidth 2 div setlinewidth } def +/UL { dup gnulinewidth mul /userlinewidth exch def + dup 1 lt {pop 1} if 10 mul /udl exch def } def +/PL { stroke userlinewidth setlinewidth } def +/LTb { BL [] 0 0 0 DL } def +/LTa { AL [1 udl mul 2 udl mul] 0 setdash 0 0 0 setrgbcolor } def +/LT0 { PL [] 1 0 0 DL } def +/LT1 { PL [4 dl 2 dl] 0 1 0 DL } def +/LT2 { PL [2 dl 3 dl] 0 0 1 DL } def +/LT3 { PL [1 dl 1.5 dl] 1 0 1 DL } def +/LT4 { PL [5 dl 2 dl 1 dl 2 dl] 0 1 1 DL } def +/LT5 { PL [4 dl 3 dl 1 dl 3 dl] 1 1 0 DL } def +/LT6 { PL [2 dl 2 dl 2 dl 4 dl] 0 0 0 DL } def +/LT7 { PL [2 dl 2 dl 2 dl 2 dl 2 dl 4 dl] 1 0.3 0 DL } def +/LT8 { PL [2 dl 2 dl 2 dl 2 dl 2 dl 2 dl 2 dl 4 dl] 0.5 0.5 0.5 DL } def +/Pnt { stroke [] 0 setdash + gsave 1 setlinecap M 0 0 V stroke grestore } def +/Dia { stroke [] 0 setdash 2 copy vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath stroke + Pnt } def +/Pls { stroke [] 0 setdash vpt sub M 0 vpt2 V + currentpoint stroke M + hpt neg vpt neg R hpt2 0 V stroke + } def +/Box { stroke [] 0 setdash 2 copy exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath stroke + Pnt } def +/Crs { stroke [] 0 setdash exch hpt sub exch vpt add M + hpt2 vpt2 neg V currentpoint stroke M + hpt2 neg 0 R hpt2 vpt2 V stroke } def +/TriU { stroke [] 0 setdash 2 copy vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath stroke + Pnt } def +/Star { 2 copy Pls Crs } def +/BoxF { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath fill } def +/TriUF { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath fill } def +/TriD { stroke [] 0 setdash 2 copy vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath stroke + Pnt } def +/TriDF { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath fill} def +/DiaF { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath fill } def +/Pent { stroke [] 0 setdash 2 copy gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath stroke grestore Pnt } def +/PentF { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath fill grestore } def +/Circle { stroke [] 0 setdash 2 copy + hpt 0 360 arc stroke Pnt } def +/CircleF { stroke [] 0 setdash hpt 0 360 arc fill } def +/C0 { BL [] 0 setdash 2 copy moveto vpt 90 450 arc } bind def +/C1 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc closepath fill + vpt 0 360 arc closepath } bind def +/C2 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C3 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C4 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 180 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C5 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc + 2 copy moveto + 2 copy vpt 180 270 arc closepath fill + vpt 0 360 arc } bind def +/C6 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C7 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C8 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 270 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C9 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 270 450 arc closepath fill + vpt 0 360 arc closepath } bind def +/C10 { BL [] 0 setdash 2 copy 2 copy moveto vpt 270 360 arc closepath fill + 2 copy moveto + 2 copy vpt 90 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C11 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 180 arc closepath fill + 2 copy moveto + 2 copy vpt 270 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C12 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 180 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C13 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc closepath fill + 2 copy moveto + 2 copy vpt 180 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C14 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 360 arc closepath fill + vpt 0 360 arc } bind def +/C15 { BL [] 0 setdash 2 copy vpt 0 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/Rec { newpath 4 2 roll moveto 1 index 0 rlineto 0 exch rlineto + neg 0 rlineto closepath } bind def +/Square { dup Rec } bind def +/Bsquare { vpt sub exch vpt sub exch vpt2 Square } bind def +/S0 { BL [] 0 setdash 2 copy moveto 0 vpt rlineto BL Bsquare } bind def +/S1 { BL [] 0 setdash 2 copy vpt Square fill Bsquare } bind def +/S2 { BL [] 0 setdash 2 copy exch vpt sub exch vpt Square fill Bsquare } bind def +/S3 { BL [] 0 setdash 2 copy exch vpt sub exch vpt2 vpt Rec fill Bsquare } bind def +/S4 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt Square fill Bsquare } bind def +/S5 { BL [] 0 setdash 2 copy 2 copy vpt Square fill + exch vpt sub exch vpt sub vpt Square fill Bsquare } bind def +/S6 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt vpt2 Rec fill Bsquare } bind def +/S7 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt vpt2 Rec fill + 2 copy vpt Square fill + Bsquare } bind def +/S8 { BL [] 0 setdash 2 copy vpt sub vpt Square fill Bsquare } bind def +/S9 { BL [] 0 setdash 2 copy vpt sub vpt vpt2 Rec fill Bsquare } bind def +/S10 { BL [] 0 setdash 2 copy vpt sub vpt Square fill 2 copy exch vpt sub exch vpt Square fill + Bsquare } bind def +/S11 { BL [] 0 setdash 2 copy vpt sub vpt Square fill 2 copy exch vpt sub exch vpt2 vpt Rec fill + Bsquare } bind def +/S12 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill Bsquare } bind def +/S13 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill + 2 copy vpt Square fill Bsquare } bind def +/S14 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill + 2 copy exch vpt sub exch vpt Square fill Bsquare } bind def +/S15 { BL [] 0 setdash 2 copy Bsquare fill Bsquare } bind def +/D0 { gsave translate 45 rotate 0 0 S0 stroke grestore } bind def +/D1 { gsave translate 45 rotate 0 0 S1 stroke grestore } bind def +/D2 { gsave translate 45 rotate 0 0 S2 stroke grestore } bind def +/D3 { gsave translate 45 rotate 0 0 S3 stroke grestore } bind def +/D4 { gsave translate 45 rotate 0 0 S4 stroke grestore } bind def +/D5 { gsave translate 45 rotate 0 0 S5 stroke grestore } bind def +/D6 { gsave translate 45 rotate 0 0 S6 stroke grestore } bind def +/D7 { gsave translate 45 rotate 0 0 S7 stroke grestore } bind def +/D8 { gsave translate 45 rotate 0 0 S8 stroke grestore } bind def +/D9 { gsave translate 45 rotate 0 0 S9 stroke grestore } bind def +/D10 { gsave translate 45 rotate 0 0 S10 stroke grestore } bind def +/D11 { gsave translate 45 rotate 0 0 S11 stroke grestore } bind def +/D12 { gsave translate 45 rotate 0 0 S12 stroke grestore } bind def +/D13 { gsave translate 45 rotate 0 0 S13 stroke grestore } bind def +/D14 { gsave translate 45 rotate 0 0 S14 stroke grestore } bind def +/D15 { gsave translate 45 rotate 0 0 S15 stroke grestore } bind def +/DiaE { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath stroke } def +/BoxE { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath stroke } def +/TriUE { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath stroke } def +/TriDE { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath stroke } def +/PentE { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath stroke grestore } def +/CircE { stroke [] 0 setdash + hpt 0 360 arc stroke } def +/Opaque { gsave closepath 1 setgray fill grestore 0 setgray closepath } def +/DiaW { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V Opaque stroke } def +/BoxW { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V Opaque stroke } def +/TriUW { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V Opaque stroke } def +/TriDW { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V Opaque stroke } def +/PentW { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + Opaque stroke grestore } def +/CircW { stroke [] 0 setdash + hpt 0 360 arc Opaque stroke } def +/BoxFill { gsave Rec 1 setgray fill grestore } def +/Symbol-Oblique /Symbol findfont [1 0 .167 1 0 0] makefont +dup length dict begin {1 index /FID eq {pop pop} {def} ifelse} forall +currentdict end definefont pop +end +%%EndProlog +%%Page: 1 1 +gnudict begin +gsave +50 50 translate +0.100 0.100 scale +90 rotate +0 -5040 translate +0 setgray +newpath +(Helvetica) findfont 140 scalefont setfont +1.000 UL +LTb +1.000 UL +LTa +714 420 M +6248 0 V +1.000 UL +LTb +714 420 M +63 0 V +6185 0 R +-63 0 V +630 420 M +( 0) Rshow +1.000 UL +LTa +714 1310 M +6248 0 V +1.000 UL +LTb +714 1310 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.2) Rshow +1.000 UL +LTa +714 2201 M +6248 0 V +1.000 UL +LTb +714 2201 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.4) Rshow +1.000 UL +LTa +714 3091 M +6248 0 V +1.000 UL +LTb +714 3091 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.6) Rshow +1.000 UL +LTa +714 3982 M +6248 0 V +1.000 UL +LTb +714 3982 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.8) Rshow +1.000 UL +LTa +714 4872 M +6248 0 V +1.000 UL +LTb +714 4872 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 1) Rshow +1.000 UL +LTa +714 420 M +0 4452 V +1.000 UL +LTb +714 420 M +0 63 V +0 4389 R +0 -63 V +714 280 M +( 0) Cshow +1.000 UL +LTa +1755 420 M +0 4452 V +1.000 UL +LTb +1755 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 20) Cshow +1.000 UL +LTa +2797 420 M +0 4452 V +1.000 UL +LTb +2797 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 40) Cshow +1.000 UL +LTa +3838 420 M +0 4452 V +1.000 UL +LTb +3838 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 60) Cshow +1.000 UL +LTa +4879 420 M +0 4452 V +1.000 UL +LTb +4879 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 80) Cshow +1.000 UL +LTa +5921 420 M +0 3829 V +0 560 R +0 63 V +1.000 UL +LTb +5921 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 100) Cshow +1.000 UL +LTa +6962 420 M +0 4452 V +1.000 UL +LTb +6962 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 120) Cshow +1.000 UL +LTb +714 420 M +6248 0 V +0 4452 V +-6248 0 V +714 420 L +140 2646 M +currentpoint gsave translate 90 rotate 0 0 M +(Meyer's distribution) Cshow +grestore +3838 70 M +(scatt. angle [deg]) Cshow +1.000 UP +1.000 UL +LT0 +6311 4739 M +('M5.keV') Rshow +740 4872 Pls +766 4858 Pls +792 4843 Pls +818 4829 Pls +844 4814 Pls +870 4800 Pls +896 4785 Pls +922 4771 Pls +948 4756 Pls +974 4742 Pls +1000 4712 Pls +1026 4666 Pls +1052 4620 Pls +1078 4573 Pls +1105 4527 Pls +1131 4481 Pls +1157 4434 Pls +1183 4388 Pls +1209 4342 Pls +1235 4296 Pls +1261 4238 Pls +1287 4180 Pls +1313 4122 Pls +1339 4064 Pls +1365 4004 Pls +1391 3937 Pls +1417 3869 Pls +1443 3802 Pls +1469 3735 Pls +1495 3668 Pls +1521 3601 Pls +1547 3535 Pls +1573 3468 Pls +1599 3401 Pls +1625 3335 Pls +1651 3268 Pls +1677 3201 Pls +1703 3135 Pls +1729 3068 Pls +1755 3004 Pls +1781 2940 Pls +1807 2876 Pls +1833 2811 Pls +1859 2747 Pls +1886 2683 Pls +1912 2619 Pls +1938 2555 Pls +1964 2491 Pls +1990 2431 Pls +2016 2377 Pls +2042 2324 Pls +2068 2270 Pls +2094 2216 Pls +2120 2163 Pls +2146 2109 Pls +2172 2055 Pls +2198 2002 Pls +2224 1948 Pls +2250 1904 Pls +2276 1862 Pls +2302 1819 Pls +2328 1777 Pls +2354 1734 Pls +2380 1692 Pls +2406 1649 Pls +2432 1607 Pls +2458 1564 Pls +2484 1525 Pls +2510 1490 Pls +2536 1455 Pls +2562 1421 Pls +2588 1386 Pls +2614 1355 Pls +2640 1326 Pls +2667 1297 Pls +2693 1269 Pls +2719 1240 Pls +2745 1216 Pls +2771 1193 Pls +2797 1170 Pls +2823 1147 Pls +2849 1124 Pls +2875 1102 Pls +2901 1079 Pls +2927 1056 Pls +2953 1033 Pls +2979 1012 Pls +3005 995 Pls +3031 979 Pls +3057 962 Pls +3083 946 Pls +3109 929 Pls +3135 912 Pls +3161 896 Pls +3187 879 Pls +3213 863 Pls +3239 850 Pls +3265 838 Pls +3291 826 Pls +3317 814 Pls +3343 802 Pls +3369 791 Pls +3395 779 Pls +3421 767 Pls +3448 755 Pls +3474 744 Pls +3500 735 Pls +3526 726 Pls +3552 718 Pls +3578 709 Pls +3604 700 Pls +3630 691 Pls +3656 683 Pls +3682 674 Pls +3708 665 Pls +3734 659 Pls +3760 653 Pls +3786 647 Pls +3812 641 Pls +3838 635 Pls +3864 629 Pls +3890 623 Pls +3916 617 Pls +3942 611 Pls +3968 605 Pls +3994 601 Pls +4020 596 Pls +4046 592 Pls +4072 587 Pls +4098 582 Pls +4124 578 Pls +4150 573 Pls +4176 569 Pls +4202 564 Pls +4229 560 Pls +4255 557 Pls +4281 554 Pls +4307 550 Pls +4333 547 Pls +4359 544 Pls +4385 540 Pls +4411 537 Pls +4437 534 Pls +4463 531 Pls +4489 529 Pls +4515 527 Pls +4541 525 Pls +4567 523 Pls +4593 520 Pls +4619 518 Pls +4645 516 Pls +4671 514 Pls +4697 512 Pls +4723 510 Pls +4749 508 Pls +4775 506 Pls +4801 504 Pls +4827 502 Pls +4853 500 Pls +4879 498 Pls +4905 496 Pls +4931 494 Pls +4957 492 Pls +4983 490 Pls +5010 488 Pls +5036 486 Pls +5062 484 Pls +5088 482 Pls +5114 481 Pls +5140 480 Pls +5166 479 Pls +5192 478 Pls +5218 477 Pls +5244 475 Pls +5270 474 Pls +5296 473 Pls +5322 472 Pls +5348 471 Pls +5374 470 Pls +5400 469 Pls +5426 468 Pls +5452 467 Pls +5478 466 Pls +5504 465 Pls +5530 464 Pls +5556 463 Pls +5582 462 Pls +5608 460 Pls +5634 459 Pls +5660 458 Pls +5686 457 Pls +5712 456 Pls +5738 456 Pls +5764 455 Pls +5791 455 Pls +5817 454 Pls +5843 453 Pls +5869 453 Pls +5895 452 Pls +5921 452 Pls +5947 451 Pls +5973 450 Pls +5999 420 Pls +6594 4739 Pls +1.000 UP +1.000 UL +LT1 +6311 4599 M +('M10.keV') Rshow +740 4872 Crs +766 4843 Crs +792 4814 Crs +818 4785 Crs +844 4756 Crs +870 4712 Crs +896 4619 Crs +922 4527 Crs +948 4434 Crs +974 4342 Crs +1000 4238 Crs +1026 4121 Crs +1052 4003 Crs +1078 3869 Crs +1105 3734 Crs +1131 3601 Crs +1157 3467 Crs +1183 3334 Crs +1209 3201 Crs +1235 3067 Crs +1261 2939 Crs +1287 2811 Crs +1313 2682 Crs +1339 2554 Crs +1365 2430 Crs +1391 2323 Crs +1417 2215 Crs +1443 2108 Crs +1469 2001 Crs +1495 1903 Crs +1521 1818 Crs +1547 1733 Crs +1573 1648 Crs +1599 1563 Crs +1625 1489 Crs +1651 1420 Crs +1677 1354 Crs +1703 1297 Crs +1729 1239 Crs +1755 1193 Crs +1781 1147 Crs +1807 1101 Crs +1833 1055 Crs +1859 1011 Crs +1886 978 Crs +1912 945 Crs +1938 912 Crs +1964 879 Crs +1990 850 Crs +2016 826 Crs +2042 802 Crs +2068 778 Crs +2094 755 Crs +2120 735 Crs +2146 717 Crs +2172 700 Crs +2198 682 Crs +2224 665 Crs +2250 652 Crs +2276 640 Crs +2302 629 Crs +2328 617 Crs +2354 605 Crs +2380 596 Crs +2406 587 Crs +2432 578 Crs +2458 569 Crs +2484 560 Crs +2510 554 Crs +2536 547 Crs +2562 540 Crs +2588 534 Crs +2614 529 Crs +2640 524 Crs +2667 520 Crs +2693 516 Crs +2719 512 Crs +2745 508 Crs +2771 504 Crs +2797 500 Crs +2823 496 Crs +2849 492 Crs +2875 488 Crs +2901 483 Crs +2927 481 Crs +2953 479 Crs +2979 477 Crs +3005 474 Crs +3031 472 Crs +3057 470 Crs +3083 468 Crs +3109 466 Crs +3135 464 Crs +3161 461 Crs +3187 459 Crs +3213 457 Crs +3239 456 Crs +3265 455 Crs +3291 453 Crs +3317 452 Crs +3343 451 Crs +3369 450 Crs +3395 449 Crs +3421 447 Crs +3448 446 Crs +3474 445 Crs +3500 444 Crs +3526 443 Crs +3552 442 Crs +3578 441 Crs +3604 441 Crs +3630 440 Crs +3656 439 Crs +3682 438 Crs +3708 438 Crs +3734 437 Crs +3760 436 Crs +3786 436 Crs +3812 435 Crs +3838 434 Crs +3864 434 Crs +3890 433 Crs +3916 432 Crs +3942 432 Crs +3968 431 Crs +3994 431 Crs +4020 430 Crs +4046 429 Crs +4072 429 Crs +4098 428 Crs +4124 428 Crs +4150 427 Crs +4176 426 Crs +4202 426 Crs +4229 425 Crs +4255 425 Crs +4281 424 Crs +4307 423 Crs +4333 423 Crs +4359 422 Crs +4385 422 Crs +4411 421 Crs +4437 420 Crs +4463 420 Crs +4489 420 Crs +4515 420 Crs +4541 420 Crs +4567 420 Crs +4593 420 Crs +4619 420 Crs +4645 420 Crs +4671 420 Crs +4697 420 Crs +4723 420 Crs +4749 420 Crs +4775 420 Crs +4801 420 Crs +4827 420 Crs +4853 420 Crs +4879 420 Crs +4905 420 Crs +4931 420 Crs +4957 420 Crs +4983 420 Crs +5010 420 Crs +5036 420 Crs +5062 420 Crs +6594 4599 Crs +1.000 UP +1.000 UL +LT2 +6311 4459 M +('M20.keV') Rshow +727 4872 Star +740 4843 Star +753 4814 Star +766 4785 Star +779 4757 Star +792 4713 Star +805 4620 Star +818 4528 Star +831 4436 Star +844 4343 Star +857 4240 Star +870 4124 Star +883 4006 Star +896 3872 Star +909 3738 Star +922 3605 Star +935 3472 Star +948 3338 Star +961 3205 Star +974 3072 Star +987 2944 Star +1000 2816 Star +1013 2688 Star +1026 2560 Star +1039 2435 Star +1052 2328 Star +1065 2221 Star +1078 2114 Star +1091 2007 Star +1105 1908 Star +1118 1823 Star +1131 1738 Star +1144 1654 Star +1157 1569 Star +1170 1494 Star +1183 1425 Star +1196 1359 Star +1209 1301 Star +1222 1244 Star +1235 1196 Star +1248 1150 Star +1261 1105 Star +1274 1059 Star +1287 1014 Star +1300 981 Star +1313 948 Star +1326 915 Star +1339 882 Star +1352 852 Star +1365 828 Star +1378 804 Star +1391 781 Star +1404 757 Star +1417 737 Star +1430 719 Star +1443 702 Star +1456 684 Star +1469 667 Star +1482 654 Star +1495 642 Star +1508 630 Star +1521 618 Star +1534 606 Star +1547 597 Star +1560 588 Star +1573 579 Star +1586 570 Star +1599 561 Star +1612 555 Star +1625 548 Star +1638 541 Star +1651 535 Star +1664 529 Star +1677 525 Star +1690 521 Star +1703 517 Star +1716 513 Star +1729 509 Star +1742 505 Star +1755 501 Star +1768 496 Star +1781 492 Star +1794 488 Star +1807 484 Star +1820 481 Star +1833 479 Star +1846 477 Star +1859 475 Star +1872 473 Star +1886 470 Star +1899 468 Star +1912 466 Star +1925 464 Star +1938 462 Star +1951 460 Star +1964 458 Star +1977 456 Star +1990 455 Star +2003 454 Star +2016 452 Star +2029 451 Star +2042 450 Star +2055 449 Star +2068 448 Star +2081 446 Star +2094 445 Star +2107 444 Star +2120 443 Star +2133 442 Star +2146 441 Star +2159 441 Star +2172 440 Star +2185 439 Star +2198 439 Star +2211 438 Star +2224 437 Star +2237 436 Star +2250 436 Star +2263 435 Star +2276 434 Star +2289 434 Star +2302 433 Star +2315 433 Star +2328 432 Star +2341 431 Star +2354 431 Star +2367 430 Star +2380 430 Star +2393 429 Star +2406 428 Star +2419 428 Star +2432 427 Star +2445 427 Star +2458 426 Star +2471 425 Star +2484 425 Star +2497 424 Star +2510 424 Star +2523 423 Star +2536 422 Star +2549 422 Star +2562 421 Star +2575 421 Star +2588 420 Star +2601 420 Star +2614 420 Star +2627 420 Star +2640 420 Star +2653 420 Star +2667 420 Star +2680 420 Star +2693 420 Star +2706 420 Star +2719 420 Star +2732 420 Star +2745 420 Star +2758 420 Star +2771 420 Star +2784 420 Star +2797 420 Star +2810 420 Star +2823 420 Star +2836 420 Star +2849 420 Star +2862 420 Star +2875 420 Star +2888 420 Star +6594 4459 Star +1.000 UP +1.000 UL +LT3 +6311 4319 M +('M50.keV') Rshow +721 4872 Box +727 4836 Box +734 4800 Box +740 4764 Box +747 4713 Box +753 4597 Box +760 4482 Box +766 4366 Box +773 4240 Box +779 4095 Box +786 3939 Box +792 3771 Box +799 3604 Box +805 3438 Box +812 3271 Box +818 3105 Box +825 2943 Box +831 2783 Box +838 2623 Box +844 2463 Box +851 2327 Box +857 2193 Box +864 2059 Box +870 1929 Box +877 1823 Box +883 1717 Box +890 1611 Box +896 1511 Box +903 1424 Box +909 1344 Box +916 1272 Box +922 1207 Box +929 1150 Box +935 1093 Box +942 1036 Box +948 989 Box +955 948 Box +961 906 Box +968 865 Box +974 834 Box +981 804 Box +987 774 Box +994 745 Box +1000 723 Box +1007 702 Box +1013 680 Box +1020 660 Box +1026 645 Box +1033 630 Box +1039 615 Box +1046 602 Box +1052 590 Box +1059 579 Box +1065 567 Box +1072 558 Box +1078 549 Box +1085 541 Box +1091 533 Box +1098 527 Box +1105 522 Box +1111 517 Box +1118 512 Box +1124 507 Box +1131 501 Box +1137 496 Box +1144 491 Box +1150 486 Box +1157 482 Box +1163 479 Box +1170 476 Box +1176 474 Box +1183 471 Box +1189 468 Box +1196 466 Box +1202 463 Box +1209 460 Box +1215 458 Box +1222 456 Box +1228 454 Box +1235 453 Box +1241 451 Box +1248 450 Box +1254 448 Box +1261 447 Box +1267 445 Box +1274 444 Box +1280 442 Box +1287 442 Box +1293 441 Box +1300 440 Box +1306 439 Box +1313 438 Box +1319 437 Box +1326 436 Box +1332 435 Box +1339 435 Box +1345 434 Box +1352 433 Box +1358 432 Box +1365 432 Box +1371 431 Box +1378 430 Box +1384 429 Box +1391 429 Box +1397 428 Box +1404 427 Box +1410 426 Box +1417 426 Box +1423 425 Box +1430 424 Box +1436 423 Box +1443 423 Box +1449 422 Box +1456 421 Box +1462 420 Box +1469 420 Box +1475 420 Box +1482 420 Box +1488 420 Box +1495 420 Box +1502 420 Box +1508 420 Box +1515 420 Box +1521 420 Box +1528 420 Box +1534 420 Box +1541 420 Box +1547 420 Box +1554 420 Box +1560 420 Box +1567 420 Box +1573 420 Box +1580 420 Box +1586 420 Box +6594 4319 Box +stroke +grestore +end +showpage +%%Trailer +%%DocumentFonts: Helvetica +%%Pages: 1 diff --git a/geant4/LEMuSR/MEYER/Mall.pdf b/geant4/LEMuSR/MEYER/Mall.pdf new file mode 100644 index 0000000..4b1d871 Binary files /dev/null and b/geant4/LEMuSR/MEYER/Mall.pdf differ diff --git a/geant4/LEMuSR/MEYER/Mall2.eps b/geant4/LEMuSR/MEYER/Mall2.eps new file mode 100644 index 0000000..1b3c6ba --- /dev/null +++ b/geant4/LEMuSR/MEYER/Mall2.eps @@ -0,0 +1,977 @@ +%!PS-Adobe-2.0 +%%Title: Mall2.eps +%%Creator: gnuplot 3.7 patchlevel 3 +%%CreationDate: Mon Apr 11 19:39:42 2005 +%%DocumentFonts: (atend) +%%BoundingBox: 50 50 554 770 +%%Orientation: Landscape +%%Pages: (atend) +%%EndComments +/gnudict 256 dict def +gnudict begin +/Color true def +/Solid false def +/gnulinewidth 5.000 def +/userlinewidth gnulinewidth def +/vshift -46 def +/dl {10 mul} def +/hpt_ 31.5 def +/vpt_ 31.5 def +/hpt hpt_ def +/vpt vpt_ def +/M {moveto} bind def +/L {lineto} bind def +/R {rmoveto} bind def +/V {rlineto} bind def +/vpt2 vpt 2 mul def +/hpt2 hpt 2 mul def +/Lshow { currentpoint stroke M + 0 vshift R show } def +/Rshow { currentpoint stroke M + dup stringwidth pop neg vshift R show } def +/Cshow { currentpoint stroke M + dup stringwidth pop -2 div vshift R show } def +/UP { dup vpt_ mul /vpt exch def hpt_ mul /hpt exch def + /hpt2 hpt 2 mul def /vpt2 vpt 2 mul def } def +/DL { Color {setrgbcolor Solid {pop []} if 0 setdash } + {pop pop pop Solid {pop []} if 0 setdash} ifelse } def +/BL { stroke userlinewidth 2 mul setlinewidth } def +/AL { stroke userlinewidth 2 div setlinewidth } def +/UL { dup gnulinewidth mul /userlinewidth exch def + dup 1 lt {pop 1} if 10 mul /udl exch def } def +/PL { stroke userlinewidth setlinewidth } def +/LTb { BL [] 0 0 0 DL } def +/LTa { AL [1 udl mul 2 udl mul] 0 setdash 0 0 0 setrgbcolor } def +/LT0 { PL [] 1 0 0 DL } def +/LT1 { PL [4 dl 2 dl] 0 1 0 DL } def +/LT2 { PL [2 dl 3 dl] 0 0 1 DL } def +/LT3 { PL [1 dl 1.5 dl] 1 0 1 DL } def +/LT4 { PL [5 dl 2 dl 1 dl 2 dl] 0 1 1 DL } def +/LT5 { PL [4 dl 3 dl 1 dl 3 dl] 1 1 0 DL } def +/LT6 { PL [2 dl 2 dl 2 dl 4 dl] 0 0 0 DL } def +/LT7 { PL [2 dl 2 dl 2 dl 2 dl 2 dl 4 dl] 1 0.3 0 DL } def +/LT8 { PL [2 dl 2 dl 2 dl 2 dl 2 dl 2 dl 2 dl 4 dl] 0.5 0.5 0.5 DL } def +/Pnt { stroke [] 0 setdash + gsave 1 setlinecap M 0 0 V stroke grestore } def +/Dia { stroke [] 0 setdash 2 copy vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath stroke + Pnt } def +/Pls { stroke [] 0 setdash vpt sub M 0 vpt2 V + currentpoint stroke M + hpt neg vpt neg R hpt2 0 V stroke + } def +/Box { stroke [] 0 setdash 2 copy exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath stroke + Pnt } def +/Crs { stroke [] 0 setdash exch hpt sub exch vpt add M + hpt2 vpt2 neg V currentpoint stroke M + hpt2 neg 0 R hpt2 vpt2 V stroke } def +/TriU { stroke [] 0 setdash 2 copy vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath stroke + Pnt } def +/Star { 2 copy Pls Crs } def +/BoxF { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath fill } def +/TriUF { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath fill } def +/TriD { stroke [] 0 setdash 2 copy vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath stroke + Pnt } def +/TriDF { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath fill} def +/DiaF { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath fill } def +/Pent { stroke [] 0 setdash 2 copy gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath stroke grestore Pnt } def +/PentF { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath fill grestore } def +/Circle { stroke [] 0 setdash 2 copy + hpt 0 360 arc stroke Pnt } def +/CircleF { stroke [] 0 setdash hpt 0 360 arc fill } def +/C0 { BL [] 0 setdash 2 copy moveto vpt 90 450 arc } bind def +/C1 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc closepath fill + vpt 0 360 arc closepath } bind def +/C2 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C3 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C4 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 180 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C5 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc + 2 copy moveto + 2 copy vpt 180 270 arc closepath fill + vpt 0 360 arc } bind def +/C6 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C7 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C8 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 270 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C9 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 270 450 arc closepath fill + vpt 0 360 arc closepath } bind def +/C10 { BL [] 0 setdash 2 copy 2 copy moveto vpt 270 360 arc closepath fill + 2 copy moveto + 2 copy vpt 90 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C11 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 180 arc closepath fill + 2 copy moveto + 2 copy vpt 270 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C12 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 180 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C13 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc closepath fill + 2 copy moveto + 2 copy vpt 180 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C14 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 360 arc closepath fill + vpt 0 360 arc } bind def +/C15 { BL [] 0 setdash 2 copy vpt 0 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/Rec { newpath 4 2 roll moveto 1 index 0 rlineto 0 exch rlineto + neg 0 rlineto closepath } bind def +/Square { dup Rec } bind def +/Bsquare { vpt sub exch vpt sub exch vpt2 Square } bind def +/S0 { BL [] 0 setdash 2 copy moveto 0 vpt rlineto BL Bsquare } bind def +/S1 { BL [] 0 setdash 2 copy vpt Square fill Bsquare } bind def +/S2 { BL [] 0 setdash 2 copy exch vpt sub exch vpt Square fill Bsquare } bind def +/S3 { BL [] 0 setdash 2 copy exch vpt sub exch vpt2 vpt Rec fill Bsquare } bind def +/S4 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt Square fill Bsquare } bind def +/S5 { BL [] 0 setdash 2 copy 2 copy vpt Square fill + exch vpt sub exch vpt sub vpt Square fill Bsquare } bind def +/S6 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt vpt2 Rec fill Bsquare } bind def +/S7 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt vpt2 Rec fill + 2 copy vpt Square fill + Bsquare } bind def +/S8 { BL [] 0 setdash 2 copy vpt sub vpt Square fill Bsquare } bind def +/S9 { BL [] 0 setdash 2 copy vpt sub vpt vpt2 Rec fill Bsquare } bind def +/S10 { BL [] 0 setdash 2 copy vpt sub vpt Square fill 2 copy exch vpt sub exch vpt Square fill + Bsquare } bind def +/S11 { BL [] 0 setdash 2 copy vpt sub vpt Square fill 2 copy exch vpt sub exch vpt2 vpt Rec fill + Bsquare } bind def +/S12 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill Bsquare } bind def +/S13 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill + 2 copy vpt Square fill Bsquare } bind def +/S14 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill + 2 copy exch vpt sub exch vpt Square fill Bsquare } bind def +/S15 { BL [] 0 setdash 2 copy Bsquare fill Bsquare } bind def +/D0 { gsave translate 45 rotate 0 0 S0 stroke grestore } bind def +/D1 { gsave translate 45 rotate 0 0 S1 stroke grestore } bind def +/D2 { gsave translate 45 rotate 0 0 S2 stroke grestore } bind def +/D3 { gsave translate 45 rotate 0 0 S3 stroke grestore } bind def +/D4 { gsave translate 45 rotate 0 0 S4 stroke grestore } bind def +/D5 { gsave translate 45 rotate 0 0 S5 stroke grestore } bind def +/D6 { gsave translate 45 rotate 0 0 S6 stroke grestore } bind def +/D7 { gsave translate 45 rotate 0 0 S7 stroke grestore } bind def +/D8 { gsave translate 45 rotate 0 0 S8 stroke grestore } bind def +/D9 { gsave translate 45 rotate 0 0 S9 stroke grestore } bind def +/D10 { gsave translate 45 rotate 0 0 S10 stroke grestore } bind def +/D11 { gsave translate 45 rotate 0 0 S11 stroke grestore } bind def +/D12 { gsave translate 45 rotate 0 0 S12 stroke grestore } bind def +/D13 { gsave translate 45 rotate 0 0 S13 stroke grestore } bind def +/D14 { gsave translate 45 rotate 0 0 S14 stroke grestore } bind def +/D15 { gsave translate 45 rotate 0 0 S15 stroke grestore } bind def +/DiaE { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath stroke } def +/BoxE { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath stroke } def +/TriUE { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath stroke } def +/TriDE { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath stroke } def +/PentE { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath stroke grestore } def +/CircE { stroke [] 0 setdash + hpt 0 360 arc stroke } def +/Opaque { gsave closepath 1 setgray fill grestore 0 setgray closepath } def +/DiaW { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V Opaque stroke } def +/BoxW { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V Opaque stroke } def +/TriUW { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V Opaque stroke } def +/TriDW { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V Opaque stroke } def +/PentW { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + Opaque stroke grestore } def +/CircW { stroke [] 0 setdash + hpt 0 360 arc Opaque stroke } def +/BoxFill { gsave Rec 1 setgray fill grestore } def +/Symbol-Oblique /Symbol findfont [1 0 .167 1 0 0] makefont +dup length dict begin {1 index /FID eq {pop pop} {def} ifelse} forall +currentdict end definefont pop +end +%%EndProlog +%%Page: 1 1 +gnudict begin +gsave +50 50 translate +0.100 0.100 scale +90 rotate +0 -5040 translate +0 setgray +newpath +(Helvetica) findfont 140 scalefont setfont +1.000 UL +LTb +1.000 UL +LTa +714 420 M +6248 0 V +1.000 UL +LTb +714 420 M +63 0 V +6185 0 R +-63 0 V +630 420 M +( 0) Rshow +1.000 UL +LTa +714 1310 M +6248 0 V +1.000 UL +LTb +714 1310 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.2) Rshow +1.000 UL +LTa +714 2201 M +6248 0 V +1.000 UL +LTb +714 2201 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.4) Rshow +1.000 UL +LTa +714 3091 M +6248 0 V +1.000 UL +LTb +714 3091 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.6) Rshow +1.000 UL +LTa +714 3982 M +6248 0 V +1.000 UL +LTb +714 3982 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.8) Rshow +1.000 UL +LTa +714 4872 M +6248 0 V +1.000 UL +LTb +714 4872 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 1) Rshow +1.000 UL +LTa +714 420 M +0 4452 V +1.000 UL +LTb +714 420 M +0 63 V +0 4389 R +0 -63 V +714 280 M +( 0) Cshow +1.000 UL +LTa +1408 420 M +0 4452 V +1.000 UL +LTb +1408 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 5) Cshow +1.000 UL +LTa +2102 420 M +0 4452 V +1.000 UL +LTb +2102 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 10) Cshow +1.000 UL +LTa +2797 420 M +0 4452 V +1.000 UL +LTb +2797 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 15) Cshow +1.000 UL +LTa +3491 420 M +0 4452 V +1.000 UL +LTb +3491 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 20) Cshow +1.000 UL +LTa +4185 420 M +0 4452 V +1.000 UL +LTb +4185 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 25) Cshow +1.000 UL +LTa +4879 420 M +0 4452 V +1.000 UL +LTb +4879 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 30) Cshow +1.000 UL +LTa +5574 420 M +0 3829 V +0 560 R +0 63 V +1.000 UL +LTb +5574 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 35) Cshow +1.000 UL +LTa +6268 420 M +0 3829 V +0 560 R +0 63 V +1.000 UL +LTb +6268 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 40) Cshow +1.000 UL +LTa +6962 420 M +0 4452 V +1.000 UL +LTb +6962 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 45) Cshow +1.000 UL +LTb +714 420 M +6248 0 V +0 4452 V +-6248 0 V +714 420 L +140 2646 M +currentpoint gsave translate 90 rotate 0 0 M +(Meyer's distribution) Cshow +grestore +3838 70 M +(scatt. angle [deg]) Cshow +1.000 UP +1.000 UL +LT0 +6311 4739 M +('M5.keV') Rshow +783 4872 Pls +853 4858 Pls +922 4843 Pls +992 4829 Pls +1061 4814 Pls +1131 4800 Pls +1200 4785 Pls +1269 4771 Pls +1339 4756 Pls +1408 4742 Pls +1478 4712 Pls +1547 4666 Pls +1616 4620 Pls +1686 4573 Pls +1755 4527 Pls +1825 4481 Pls +1894 4434 Pls +1964 4388 Pls +2033 4342 Pls +2102 4296 Pls +2172 4238 Pls +2241 4180 Pls +2311 4122 Pls +2380 4064 Pls +2450 4004 Pls +2519 3937 Pls +2588 3869 Pls +2658 3802 Pls +2727 3735 Pls +2797 3668 Pls +2866 3601 Pls +2936 3535 Pls +3005 3468 Pls +3074 3401 Pls +3144 3335 Pls +3213 3268 Pls +3283 3201 Pls +3352 3135 Pls +3421 3068 Pls +3491 3004 Pls +3560 2940 Pls +3630 2876 Pls +3699 2811 Pls +3769 2747 Pls +3838 2683 Pls +3907 2619 Pls +3977 2555 Pls +4046 2491 Pls +4116 2431 Pls +4185 2377 Pls +4255 2324 Pls +4324 2270 Pls +4393 2216 Pls +4463 2163 Pls +4532 2109 Pls +4602 2055 Pls +4671 2002 Pls +4740 1948 Pls +4810 1904 Pls +4879 1862 Pls +4949 1819 Pls +5018 1777 Pls +5088 1734 Pls +5157 1692 Pls +5226 1649 Pls +5296 1607 Pls +5365 1564 Pls +5435 1525 Pls +5504 1490 Pls +5574 1455 Pls +5643 1421 Pls +5712 1386 Pls +5782 1355 Pls +5851 1326 Pls +5921 1297 Pls +5990 1269 Pls +6060 1240 Pls +6129 1216 Pls +6198 1193 Pls +6268 1170 Pls +6337 1147 Pls +6407 1124 Pls +6476 1102 Pls +6545 1079 Pls +6615 1056 Pls +6684 1033 Pls +6754 1012 Pls +6823 995 Pls +6893 979 Pls +6962 962 Pls +6594 4739 Pls +1.000 UP +1.000 UL +LT1 +6311 4599 M +('M10.keV') Rshow +783 4872 Crs +853 4843 Crs +922 4814 Crs +992 4785 Crs +1061 4756 Crs +1131 4712 Crs +1200 4619 Crs +1269 4527 Crs +1339 4434 Crs +1408 4342 Crs +1478 4238 Crs +1547 4121 Crs +1616 4003 Crs +1686 3869 Crs +1755 3734 Crs +1825 3601 Crs +1894 3467 Crs +1964 3334 Crs +2033 3201 Crs +2102 3067 Crs +2172 2939 Crs +2241 2811 Crs +2311 2682 Crs +2380 2554 Crs +2450 2430 Crs +2519 2323 Crs +2588 2215 Crs +2658 2108 Crs +2727 2001 Crs +2797 1903 Crs +2866 1818 Crs +2936 1733 Crs +3005 1648 Crs +3074 1563 Crs +3144 1489 Crs +3213 1420 Crs +3283 1354 Crs +3352 1297 Crs +3421 1239 Crs +3491 1193 Crs +3560 1147 Crs +3630 1101 Crs +3699 1055 Crs +3769 1011 Crs +3838 978 Crs +3907 945 Crs +3977 912 Crs +4046 879 Crs +4116 850 Crs +4185 826 Crs +4255 802 Crs +4324 778 Crs +4393 755 Crs +4463 735 Crs +4532 717 Crs +4602 700 Crs +4671 682 Crs +4740 665 Crs +4810 652 Crs +4879 640 Crs +4949 629 Crs +5018 617 Crs +5088 605 Crs +5157 596 Crs +5226 587 Crs +5296 578 Crs +5365 569 Crs +5435 560 Crs +5504 554 Crs +5574 547 Crs +5643 540 Crs +5712 534 Crs +5782 529 Crs +5851 524 Crs +5921 520 Crs +5990 516 Crs +6060 512 Crs +6129 508 Crs +6198 504 Crs +6268 500 Crs +6337 496 Crs +6407 492 Crs +6476 488 Crs +6545 483 Crs +6615 481 Crs +6684 479 Crs +6754 477 Crs +6823 474 Crs +6893 472 Crs +6962 470 Crs +6594 4599 Crs +1.000 UP +1.000 UL +LT2 +6311 4459 M +('M20.keV') Rshow +749 4872 Star +783 4843 Star +818 4814 Star +853 4785 Star +888 4757 Star +922 4713 Star +957 4620 Star +992 4528 Star +1026 4436 Star +1061 4343 Star +1096 4240 Star +1131 4124 Star +1165 4006 Star +1200 3872 Star +1235 3738 Star +1269 3605 Star +1304 3472 Star +1339 3338 Star +1374 3205 Star +1408 3072 Star +1443 2944 Star +1478 2816 Star +1512 2688 Star +1547 2560 Star +1582 2435 Star +1616 2328 Star +1651 2221 Star +1686 2114 Star +1721 2007 Star +1755 1908 Star +1790 1823 Star +1825 1738 Star +1859 1654 Star +1894 1569 Star +1929 1494 Star +1964 1425 Star +1998 1359 Star +2033 1301 Star +2068 1244 Star +2102 1196 Star +2137 1150 Star +2172 1105 Star +2207 1059 Star +2241 1014 Star +2276 981 Star +2311 948 Star +2345 915 Star +2380 882 Star +2415 852 Star +2450 828 Star +2484 804 Star +2519 781 Star +2554 757 Star +2588 737 Star +2623 719 Star +2658 702 Star +2693 684 Star +2727 667 Star +2762 654 Star +2797 642 Star +2831 630 Star +2866 618 Star +2901 606 Star +2936 597 Star +2970 588 Star +3005 579 Star +3040 570 Star +3074 561 Star +3109 555 Star +3144 548 Star +3178 541 Star +3213 535 Star +3248 529 Star +3283 525 Star +3317 521 Star +3352 517 Star +3387 513 Star +3421 509 Star +3456 505 Star +3491 501 Star +3526 496 Star +3560 492 Star +3595 488 Star +3630 484 Star +3664 481 Star +3699 479 Star +3734 477 Star +3769 475 Star +3803 473 Star +3838 470 Star +3873 468 Star +3907 466 Star +3942 464 Star +3977 462 Star +4012 460 Star +4046 458 Star +4081 456 Star +4116 455 Star +4150 454 Star +4185 452 Star +4220 451 Star +4255 450 Star +4289 449 Star +4324 448 Star +4359 446 Star +4393 445 Star +4428 444 Star +4463 443 Star +4498 442 Star +4532 441 Star +4567 441 Star +4602 440 Star +4636 439 Star +4671 439 Star +4706 438 Star +4740 437 Star +4775 436 Star +4810 436 Star +4845 435 Star +4879 434 Star +4914 434 Star +4949 433 Star +4983 433 Star +5018 432 Star +5053 431 Star +5088 431 Star +5122 430 Star +5157 430 Star +5192 429 Star +5226 428 Star +5261 428 Star +5296 427 Star +5331 427 Star +5365 426 Star +5400 425 Star +5435 425 Star +5469 424 Star +5504 424 Star +5539 423 Star +5574 422 Star +5608 422 Star +5643 421 Star +5678 421 Star +5712 420 Star +5747 420 Star +5782 420 Star +5817 420 Star +5851 420 Star +5886 420 Star +5921 420 Star +5955 420 Star +5990 420 Star +6025 420 Star +6060 420 Star +6094 420 Star +6129 420 Star +6164 420 Star +6198 420 Star +6233 420 Star +6268 420 Star +6302 420 Star +6337 420 Star +6372 420 Star +6407 420 Star +6441 420 Star +6476 420 Star +6511 420 Star +6594 4459 Star +1.000 UP +1.000 UL +LT3 +6311 4319 M +('M50.keV') Rshow +731 4872 Box +749 4836 Box +766 4800 Box +783 4764 Box +801 4713 Box +818 4597 Box +835 4482 Box +853 4366 Box +870 4240 Box +888 4095 Box +905 3939 Box +922 3771 Box +940 3604 Box +957 3438 Box +974 3271 Box +992 3105 Box +1009 2943 Box +1026 2783 Box +1044 2623 Box +1061 2463 Box +1078 2327 Box +1096 2193 Box +1113 2059 Box +1131 1929 Box +1148 1823 Box +1165 1717 Box +1183 1611 Box +1200 1511 Box +1217 1424 Box +1235 1344 Box +1252 1272 Box +1269 1207 Box +1287 1150 Box +1304 1093 Box +1321 1036 Box +1339 989 Box +1356 948 Box +1374 906 Box +1391 865 Box +1408 834 Box +1426 804 Box +1443 774 Box +1460 745 Box +1478 723 Box +1495 702 Box +1512 680 Box +1530 660 Box +1547 645 Box +1564 630 Box +1582 615 Box +1599 602 Box +1616 590 Box +1634 579 Box +1651 567 Box +1669 558 Box +1686 549 Box +1703 541 Box +1721 533 Box +1738 527 Box +1755 522 Box +1773 517 Box +1790 512 Box +1807 507 Box +1825 501 Box +1842 496 Box +1859 491 Box +1877 486 Box +1894 482 Box +1912 479 Box +1929 476 Box +1946 474 Box +1964 471 Box +1981 468 Box +1998 466 Box +2016 463 Box +2033 460 Box +2050 458 Box +2068 456 Box +2085 454 Box +2102 453 Box +2120 451 Box +2137 450 Box +2155 448 Box +2172 447 Box +2189 445 Box +2207 444 Box +2224 442 Box +2241 442 Box +2259 441 Box +2276 440 Box +2293 439 Box +2311 438 Box +2328 437 Box +2345 436 Box +2363 435 Box +2380 435 Box +2397 434 Box +2415 433 Box +2432 432 Box +2450 432 Box +2467 431 Box +2484 430 Box +2502 429 Box +2519 429 Box +2536 428 Box +2554 427 Box +2571 426 Box +2588 426 Box +2606 425 Box +2623 424 Box +2640 423 Box +2658 423 Box +2675 422 Box +2693 421 Box +2710 420 Box +2727 420 Box +2745 420 Box +2762 420 Box +2779 420 Box +2797 420 Box +2814 420 Box +2831 420 Box +2849 420 Box +2866 420 Box +2883 420 Box +2901 420 Box +2918 420 Box +2936 420 Box +2953 420 Box +2970 420 Box +2988 420 Box +3005 420 Box +3022 420 Box +3040 420 Box +6594 4319 Box +stroke +grestore +end +showpage +%%Trailer +%%DocumentFonts: Helvetica +%%Pages: 1 diff --git a/geant4/LEMuSR/MEYER/Mall2.pdf b/geant4/LEMuSR/MEYER/Mall2.pdf new file mode 100644 index 0000000..e75a604 Binary files /dev/null and b/geant4/LEMuSR/MEYER/Mall2.pdf differ diff --git a/geant4/LEMuSR/MEYER/Mallsin.eps b/geant4/LEMuSR/MEYER/Mallsin.eps new file mode 100644 index 0000000..db30591 --- /dev/null +++ b/geant4/LEMuSR/MEYER/Mallsin.eps @@ -0,0 +1,978 @@ +%!PS-Adobe-2.0 +%%Title: Mallsin.eps +%%Creator: gnuplot 3.7 patchlevel 3 +%%CreationDate: Tue Apr 12 08:59:12 2005 +%%DocumentFonts: (atend) +%%BoundingBox: 50 50 554 770 +%%Orientation: Landscape +%%Pages: (atend) +%%EndComments +/gnudict 256 dict def +gnudict begin +/Color true def +/Solid false def +/gnulinewidth 5.000 def +/userlinewidth gnulinewidth def +/vshift -46 def +/dl {10 mul} def +/hpt_ 31.5 def +/vpt_ 31.5 def +/hpt hpt_ def +/vpt vpt_ def +/M {moveto} bind def +/L {lineto} bind def +/R {rmoveto} bind def +/V {rlineto} bind def +/vpt2 vpt 2 mul def +/hpt2 hpt 2 mul def +/Lshow { currentpoint stroke M + 0 vshift R show } def +/Rshow { currentpoint stroke M + dup stringwidth pop neg vshift R show } def +/Cshow { currentpoint stroke M + dup stringwidth pop -2 div vshift R show } def +/UP { dup vpt_ mul /vpt exch def hpt_ mul /hpt exch def + /hpt2 hpt 2 mul def /vpt2 vpt 2 mul def } def +/DL { Color {setrgbcolor Solid {pop []} if 0 setdash } + {pop pop pop Solid {pop []} if 0 setdash} ifelse } def +/BL { stroke userlinewidth 2 mul setlinewidth } def +/AL { stroke userlinewidth 2 div setlinewidth } def +/UL { dup gnulinewidth mul /userlinewidth exch def + dup 1 lt {pop 1} if 10 mul /udl exch def } def +/PL { stroke userlinewidth setlinewidth } def +/LTb { BL [] 0 0 0 DL } def +/LTa { AL [1 udl mul 2 udl mul] 0 setdash 0 0 0 setrgbcolor } def +/LT0 { PL [] 1 0 0 DL } def +/LT1 { PL [4 dl 2 dl] 0 1 0 DL } def +/LT2 { PL [2 dl 3 dl] 0 0 1 DL } def +/LT3 { PL [1 dl 1.5 dl] 1 0 1 DL } def +/LT4 { PL [5 dl 2 dl 1 dl 2 dl] 0 1 1 DL } def +/LT5 { PL [4 dl 3 dl 1 dl 3 dl] 1 1 0 DL } def +/LT6 { PL [2 dl 2 dl 2 dl 4 dl] 0 0 0 DL } def +/LT7 { PL [2 dl 2 dl 2 dl 2 dl 2 dl 4 dl] 1 0.3 0 DL } def +/LT8 { PL [2 dl 2 dl 2 dl 2 dl 2 dl 2 dl 2 dl 4 dl] 0.5 0.5 0.5 DL } def +/Pnt { stroke [] 0 setdash + gsave 1 setlinecap M 0 0 V stroke grestore } def +/Dia { stroke [] 0 setdash 2 copy vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath stroke + Pnt } def +/Pls { stroke [] 0 setdash vpt sub M 0 vpt2 V + currentpoint stroke M + hpt neg vpt neg R hpt2 0 V stroke + } def +/Box { stroke [] 0 setdash 2 copy exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath stroke + Pnt } def +/Crs { stroke [] 0 setdash exch hpt sub exch vpt add M + hpt2 vpt2 neg V currentpoint stroke M + hpt2 neg 0 R hpt2 vpt2 V stroke } def +/TriU { stroke [] 0 setdash 2 copy vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath stroke + Pnt } def +/Star { 2 copy Pls Crs } def +/BoxF { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath fill } def +/TriUF { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath fill } def +/TriD { stroke [] 0 setdash 2 copy vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath stroke + Pnt } def +/TriDF { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath fill} def +/DiaF { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath fill } def +/Pent { stroke [] 0 setdash 2 copy gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath stroke grestore Pnt } def +/PentF { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath fill grestore } def +/Circle { stroke [] 0 setdash 2 copy + hpt 0 360 arc stroke Pnt } def +/CircleF { stroke [] 0 setdash hpt 0 360 arc fill } def +/C0 { BL [] 0 setdash 2 copy moveto vpt 90 450 arc } bind def +/C1 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc closepath fill + vpt 0 360 arc closepath } bind def +/C2 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C3 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C4 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 180 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C5 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc + 2 copy moveto + 2 copy vpt 180 270 arc closepath fill + vpt 0 360 arc } bind def +/C6 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C7 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 270 arc closepath fill + vpt 0 360 arc closepath } bind def +/C8 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 270 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C9 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 270 450 arc closepath fill + vpt 0 360 arc closepath } bind def +/C10 { BL [] 0 setdash 2 copy 2 copy moveto vpt 270 360 arc closepath fill + 2 copy moveto + 2 copy vpt 90 180 arc closepath fill + vpt 0 360 arc closepath } bind def +/C11 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 180 arc closepath fill + 2 copy moveto + 2 copy vpt 270 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C12 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 180 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C13 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 0 90 arc closepath fill + 2 copy moveto + 2 copy vpt 180 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/C14 { BL [] 0 setdash 2 copy moveto + 2 copy vpt 90 360 arc closepath fill + vpt 0 360 arc } bind def +/C15 { BL [] 0 setdash 2 copy vpt 0 360 arc closepath fill + vpt 0 360 arc closepath } bind def +/Rec { newpath 4 2 roll moveto 1 index 0 rlineto 0 exch rlineto + neg 0 rlineto closepath } bind def +/Square { dup Rec } bind def +/Bsquare { vpt sub exch vpt sub exch vpt2 Square } bind def +/S0 { BL [] 0 setdash 2 copy moveto 0 vpt rlineto BL Bsquare } bind def +/S1 { BL [] 0 setdash 2 copy vpt Square fill Bsquare } bind def +/S2 { BL [] 0 setdash 2 copy exch vpt sub exch vpt Square fill Bsquare } bind def +/S3 { BL [] 0 setdash 2 copy exch vpt sub exch vpt2 vpt Rec fill Bsquare } bind def +/S4 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt Square fill Bsquare } bind def +/S5 { BL [] 0 setdash 2 copy 2 copy vpt Square fill + exch vpt sub exch vpt sub vpt Square fill Bsquare } bind def +/S6 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt vpt2 Rec fill Bsquare } bind def +/S7 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt vpt2 Rec fill + 2 copy vpt Square fill + Bsquare } bind def +/S8 { BL [] 0 setdash 2 copy vpt sub vpt Square fill Bsquare } bind def +/S9 { BL [] 0 setdash 2 copy vpt sub vpt vpt2 Rec fill Bsquare } bind def +/S10 { BL [] 0 setdash 2 copy vpt sub vpt Square fill 2 copy exch vpt sub exch vpt Square fill + Bsquare } bind def +/S11 { BL [] 0 setdash 2 copy vpt sub vpt Square fill 2 copy exch vpt sub exch vpt2 vpt Rec fill + Bsquare } bind def +/S12 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill Bsquare } bind def +/S13 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill + 2 copy vpt Square fill Bsquare } bind def +/S14 { BL [] 0 setdash 2 copy exch vpt sub exch vpt sub vpt2 vpt Rec fill + 2 copy exch vpt sub exch vpt Square fill Bsquare } bind def +/S15 { BL [] 0 setdash 2 copy Bsquare fill Bsquare } bind def +/D0 { gsave translate 45 rotate 0 0 S0 stroke grestore } bind def +/D1 { gsave translate 45 rotate 0 0 S1 stroke grestore } bind def +/D2 { gsave translate 45 rotate 0 0 S2 stroke grestore } bind def +/D3 { gsave translate 45 rotate 0 0 S3 stroke grestore } bind def +/D4 { gsave translate 45 rotate 0 0 S4 stroke grestore } bind def +/D5 { gsave translate 45 rotate 0 0 S5 stroke grestore } bind def +/D6 { gsave translate 45 rotate 0 0 S6 stroke grestore } bind def +/D7 { gsave translate 45 rotate 0 0 S7 stroke grestore } bind def +/D8 { gsave translate 45 rotate 0 0 S8 stroke grestore } bind def +/D9 { gsave translate 45 rotate 0 0 S9 stroke grestore } bind def +/D10 { gsave translate 45 rotate 0 0 S10 stroke grestore } bind def +/D11 { gsave translate 45 rotate 0 0 S11 stroke grestore } bind def +/D12 { gsave translate 45 rotate 0 0 S12 stroke grestore } bind def +/D13 { gsave translate 45 rotate 0 0 S13 stroke grestore } bind def +/D14 { gsave translate 45 rotate 0 0 S14 stroke grestore } bind def +/D15 { gsave translate 45 rotate 0 0 S15 stroke grestore } bind def +/DiaE { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V closepath stroke } def +/BoxE { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V closepath stroke } def +/TriUE { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V closepath stroke } def +/TriDE { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V closepath stroke } def +/PentE { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + closepath stroke grestore } def +/CircE { stroke [] 0 setdash + hpt 0 360 arc stroke } def +/Opaque { gsave closepath 1 setgray fill grestore 0 setgray closepath } def +/DiaW { stroke [] 0 setdash vpt add M + hpt neg vpt neg V hpt vpt neg V + hpt vpt V hpt neg vpt V Opaque stroke } def +/BoxW { stroke [] 0 setdash exch hpt sub exch vpt add M + 0 vpt2 neg V hpt2 0 V 0 vpt2 V + hpt2 neg 0 V Opaque stroke } def +/TriUW { stroke [] 0 setdash vpt 1.12 mul add M + hpt neg vpt -1.62 mul V + hpt 2 mul 0 V + hpt neg vpt 1.62 mul V Opaque stroke } def +/TriDW { stroke [] 0 setdash vpt 1.12 mul sub M + hpt neg vpt 1.62 mul V + hpt 2 mul 0 V + hpt neg vpt -1.62 mul V Opaque stroke } def +/PentW { stroke [] 0 setdash gsave + translate 0 hpt M 4 {72 rotate 0 hpt L} repeat + Opaque stroke grestore } def +/CircW { stroke [] 0 setdash + hpt 0 360 arc Opaque stroke } def +/BoxFill { gsave Rec 1 setgray fill grestore } def +/Symbol-Oblique /Symbol findfont [1 0 .167 1 0 0] makefont +dup length dict begin {1 index /FID eq {pop pop} {def} ifelse} forall +currentdict end definefont pop +end +%%EndProlog +%%Page: 1 1 +gnudict begin +gsave +50 50 translate +0.100 0.100 scale +90 rotate +0 -5040 translate +0 setgray +newpath +(Helvetica) findfont 140 scalefont setfont +1.000 UL +LTb +1.000 UL +LTa +714 420 M +6248 0 V +1.000 UL +LTb +714 420 M +63 0 V +6185 0 R +-63 0 V +630 420 M +( 0) Rshow +1.000 UL +LTa +714 1056 M +6248 0 V +1.000 UL +LTb +714 1056 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.2) Rshow +1.000 UL +LTa +714 1692 M +6248 0 V +1.000 UL +LTb +714 1692 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.4) Rshow +1.000 UL +LTa +714 2328 M +6248 0 V +1.000 UL +LTb +714 2328 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.6) Rshow +1.000 UL +LTa +714 2964 M +6248 0 V +1.000 UL +LTb +714 2964 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 0.8) Rshow +1.000 UL +LTa +714 3600 M +6248 0 V +1.000 UL +LTb +714 3600 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 1) Rshow +1.000 UL +LTa +714 4236 M +6248 0 V +1.000 UL +LTb +714 4236 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 1.2) Rshow +1.000 UL +LTa +714 4872 M +6248 0 V +1.000 UL +LTb +714 4872 M +63 0 V +6185 0 R +-63 0 V +-6269 0 R +( 1.4) Rshow +1.000 UL +LTa +714 420 M +0 4452 V +1.000 UL +LTb +714 420 M +0 63 V +0 4389 R +0 -63 V +714 280 M +( 0) Cshow +1.000 UL +LTa +1408 420 M +0 4452 V +1.000 UL +LTb +1408 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 5) Cshow +1.000 UL +LTa +2102 420 M +0 4452 V +1.000 UL +LTb +2102 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 10) Cshow +1.000 UL +LTa +2797 420 M +0 4452 V +1.000 UL +LTb +2797 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 15) Cshow +1.000 UL +LTa +3491 420 M +0 4452 V +1.000 UL +LTb +3491 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 20) Cshow +1.000 UL +LTa +4185 420 M +0 4452 V +1.000 UL +LTb +4185 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 25) Cshow +1.000 UL +LTa +4879 420 M +0 4452 V +1.000 UL +LTb +4879 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 30) Cshow +1.000 UL +LTa +5574 420 M +0 3829 V +0 560 R +0 63 V +1.000 UL +LTb +5574 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 35) Cshow +1.000 UL +LTa +6268 420 M +0 3829 V +0 560 R +0 63 V +1.000 UL +LTb +6268 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 40) Cshow +1.000 UL +LTa +6962 420 M +0 4452 V +1.000 UL +LTb +6962 420 M +0 63 V +0 4389 R +0 -63 V +0 -4529 R +( 45) Cshow +1.000 UL +LTb +714 420 M +6248 0 V +0 4452 V +-6248 0 V +714 420 L +140 2646 M +currentpoint gsave translate 90 rotate 0 0 M +(distribution) Cshow +grestore +3838 70 M +([deg]) Cshow +1.000 UP +1.000 UL +LT0 +6311 4739 M +('M5.keV' us 1:3) Rshow +783 420 Pls +853 449 Pls +922 477 Pls +992 505 Pls +1061 533 Pls +1131 561 Pls +1200 588 Pls +1269 616 Pls +1339 643 Pls +1408 670 Pls +1478 696 Pls +1547 720 Pls +1616 744 Pls +1686 767 Pls +1755 789 Pls +1825 811 Pls +1894 832 Pls +1964 853 Pls +2033 872 Pls +2102 892 Pls +2172 909 Pls +2241 925 Pls +2311 941 Pls +2380 956 Pls +2450 969 Pls +2519 981 Pls +2588 992 Pls +2658 1002 Pls +2727 1011 Pls +2797 1020 Pls +2866 1027 Pls +2936 1034 Pls +3005 1040 Pls +3074 1044 Pls +3144 1048 Pls +3213 1052 Pls +3283 1054 Pls +3352 1055 Pls +3421 1056 Pls +3491 1056 Pls +3560 1056 Pls +3630 1054 Pls +3699 1052 Pls +3769 1049 Pls +3838 1045 Pls +3907 1041 Pls +3977 1035 Pls +4046 1029 Pls +4116 1023 Pls +4185 1019 Pls +4255 1013 Pls +4324 1007 Pls +4393 1001 Pls +4463 993 Pls +4532 985 Pls +4602 977 Pls +4671 968 Pls +4740 958 Pls +4810 951 Pls +4879 943 Pls +4949 936 Pls +5018 928 Pls +5088 919 Pls +5157 910 Pls +5226 900 Pls +5296 890 Pls +5365 879 Pls +5435 870 Pls +5504 861 Pls +5574 852 Pls +5643 843 Pls +5712 834 Pls +5782 825 Pls +5851 817 Pls +5921 809 Pls +5990 801 Pls +6060 792 Pls +6129 785 Pls +6198 779 Pls +6268 772 Pls +6337 765 Pls +6407 757 Pls +6476 750 Pls +6545 742 Pls +6615 734 Pls +6684 725 Pls +6754 718 Pls +6823 712 Pls +6893 706 Pls +6962 700 Pls +6594 4739 Pls +1.000 UP +1.000 UL +LT1 +6311 4599 M +('M10.keV' us 1:3) Rshow +783 420 Crs +853 534 Crs +922 646 Crs +992 757 Crs +1061 866 Crs +1131 971 Crs +1200 1067 Crs +1269 1159 Crs +1339 1245 Crs +1408 1326 Crs +1478 1400 Crs +1547 1465 Crs +1616 1524 Crs +1686 1570 Crs +1755 1610 Crs +1825 1644 Crs +1894 1670 Crs +1964 1690 Crs +2033 1702 Crs +2102 1708 Crs +2172 1710 Crs +2241 1705 Crs +2311 1693 Crs +2380 1675 Crs +2450 1653 Crs +2519 1635 Crs +2588 1611 Crs +2658 1583 Crs +2727 1548 Crs +2797 1516 Crs +2866 1488 Crs +2936 1456 Crs +3005 1419 Crs +3074 1379 Crs +3144 1343 Crs +3213 1308 Crs +3283 1272 Crs +3352 1241 Crs +3421 1208 Crs +3491 1181 Crs +3560 1154 Crs +3630 1124 Crs +3699 1092 Crs +3769 1060 Crs +3838 1038 Crs +3907 1014 Crs +3977 988 Crs +4046 961 Crs +4116 936 Crs +4185 917 Crs +4255 897 Crs +4324 876 Crs +4393 854 Crs +4463 835 Crs +4532 819 Crs +4602 802 Crs +4671 784 Crs +4740 766 Crs +4810 753 Crs +4879 741 Crs +4949 728 Crs +5018 715 Crs +5088 702 Crs +5157 692 Crs +5226 681 Crs +5296 671 Crs +5365 659 Crs +5435 649 Crs +5504 641 Crs +5574 633 Crs +5643 624 Crs +5712 615 Crs +5782 609 Crs +5851 604 Crs +5921 598 Crs +5990 593 Crs +6060 588 Crs +6129 582 Crs +6198 576 Crs +6268 570 Crs +6337 564 Crs +6407 558 Crs +6476 551 Crs +6545 545 Crs +6615 540 Crs +6684 537 Crs +6754 534 Crs +6823 531 Crs +6893 527 Crs +6962 524 Crs +6594 4599 Crs +1.000 UP +1.000 UL +LT2 +6311 4459 M +('M20.keV'us 1:3) Rshow +749 420 Star +783 647 Star +818 871 Star +853 1093 Star +888 1311 Star +922 1522 Star +957 1714 Star +992 1897 Star +1026 2069 Star +1061 2233 Star +1096 2381 Star +1131 2511 Star +1165 2629 Star +1200 2723 Star +1235 2804 Star +1269 2871 Star +1304 2925 Star +1339 2965 Star +1374 2991 Star +1408 3004 Star +1443 3008 Star +1478 2999 Star +1512 2977 Star +1547 2942 Star +1582 2898 Star +1616 2863 Star +1651 2818 Star +1686 2761 Star +1721 2694 Star +1755 2629 Star +1790 2574 Star +1825 2511 Star +1859 2439 Star +1894 2358 Star +1929 2286 Star +1964 2217 Star +1998 2146 Star +2033 2085 Star +2068 2018 Star +2102 1965 Star +2137 1911 Star +2172 1852 Star +2207 1788 Star +2241 1723 Star +2276 1679 Star +2311 1631 Star +2345 1580 Star +2380 1525 Star +2415 1476 Star +2450 1438 Star +2484 1398 Star +2519 1355 Star +2554 1311 Star +2588 1273 Star +2623 1241 Star +2658 1207 Star +2693 1171 Star +2727 1134 Star +2762 1108 Star +2797 1084 Star +2831 1059 Star +2866 1032 Star +2901 1005 Star +2936 985 Star +2970 964 Star +3005 942 Star +3040 920 Star +3074 898 Star +3109 882 Star +3144 866 Star +3178 848 Star +3213 830 Star +3248 817 Star +3283 807 Star +3317 797 Star +3352 786 Star +3387 775 Star +3421 764 Star +3456 752 Star +3491 740 Star +3526 727 Star +3560 714 Star +3595 701 Star +3630 687 Star +3664 678 Star +3699 671 Star +3734 665 Star +3769 658 Star +3803 651 Star +3838 644 Star +3873 637 Star +3907 630 Star +3942 622 Star +3977 614 Star +4012 606 Star +4046 598 Star +4081 592 Star +4116 588 Star +4150 584 Star +4185 580 Star +4220 575 Star +4255 571 Star +4289 566 Star +4324 561 Star +4359 556 Star +4393 551 Star +4428 546 Star +4463 541 Star +4498 538 Star +4532 535 Star +4567 532 Star +4602 529 Star +4636 526 Star +4671 523 Star +4706 520 Star +4740 517 Star +4775 514 Star +4810 511 Star +4845 507 Star +4879 504 Star +4914 501 Star +4949 498 Star +4983 495 Star +5018 492 Star +5053 489 Star +5088 486 Star +5122 482 Star +5157 479 Star +5192 476 Star +5226 472 Star +5261 469 Star +5296 466 Star +5331 462 Star +5365 458 Star +5400 455 Star +5435 451 Star +5469 447 Star +5504 444 Star +5539 440 Star +5574 436 Star +5608 432 Star +5643 428 Star +5678 424 Star +5712 420 Star +5747 420 Star +5782 420 Star +5817 420 Star +5851 420 Star +5886 420 Star +5921 420 Star +5955 420 Star +5990 420 Star +6025 420 Star +6060 420 Star +6094 420 Star +6129 420 Star +6164 420 Star +6198 420 Star +6233 420 Star +6268 420 Star +6302 420 Star +6337 420 Star +6372 420 Star +6407 420 Star +6441 420 Star +6476 420 Star +6511 420 Star +6594 4459 Star +1.000 UP +1.000 UL +LT3 +6311 4319 M +('M30.keV' us 1:3) Rshow +749 420 Box +783 931 Box +818 1433 Box +853 1924 Box +888 2368 Box +922 2775 Box +957 3149 Box +992 3472 Box +1026 3744 Box +1061 3948 Box +1096 4107 Box +1131 4221 Box +1165 4287 Box +1200 4311 Box +1235 4298 Box +1269 4240 Box +1304 4146 Box +1339 4061 Box +1374 3938 Box +1408 3779 Box +1443 3657 Box +1478 3508 Box +1512 3330 Box +1547 3173 Box +1582 3014 Box +1616 2872 Box +1651 2743 Box +1686 2617 Box +1721 2475 Box +1755 2347 Box +1790 2240 Box +1825 2122 Box +1859 2008 Box +1894 1921 Box +1929 1826 Box +1964 1727 Box +1998 1655 Box +2033 1577 Box +2068 1492 Box +2102 1438 Box +2137 1381 Box +2172 1321 Box +2207 1271 Box +2241 1223 Box +2276 1172 Box +2311 1130 Box +2345 1092 Box +2380 1052 Box +2415 1019 Box +2450 997 Box +2484 973 Box +2519 948 Box +2554 921 Box +2588 893 Box +2623 864 Box +2658 833 Box +2693 811 Box +2727 796 Box +2762 781 Box +2797 766 Box +2831 749 Box +2866 732 Box +2901 714 Box +2936 696 Box +2970 682 Box +3005 673 Box +3040 663 Box +3074 653 Box +3109 642 Box +3144 631 Box +3178 620 Box +3213 608 Box +3248 600 Box +3283 593 Box +3317 587 Box +3352 580 Box +3387 573 Box +3421 566 Box +3456 558 Box +3491 551 Box +3526 544 Box +3560 537 Box +3595 530 Box +3630 523 Box +3664 515 Box +3699 508 Box +3734 500 Box +3769 492 Box +3803 484 Box +3838 475 Box +3873 467 Box +3907 458 Box +3942 449 Box +3977 440 Box +4012 431 Box +4046 421 Box +4081 420 Box +4116 420 Box +4150 420 Box +4185 420 Box +4220 420 Box +4255 420 Box +4289 420 Box +4324 420 Box +4359 420 Box +4393 420 Box +4428 420 Box +4463 420 Box +4498 420 Box +4532 420 Box +4567 420 Box +6594 4319 Box +stroke +grestore +end +showpage +%%Trailer +%%DocumentFonts: Helvetica +%%Pages: 1 diff --git a/geant4/LEMuSR/MEYER/Mallsin.pdf b/geant4/LEMuSR/MEYER/Mallsin.pdf new file mode 100644 index 0000000..48097ce Binary files /dev/null and b/geant4/LEMuSR/MEYER/Mallsin.pdf differ diff --git a/geant4/LEMuSR/MEYER/a.out b/geant4/LEMuSR/MEYER/a.out new file mode 100755 index 0000000..743679b Binary files /dev/null and b/geant4/LEMuSR/MEYER/a.out differ diff --git a/geant4/LEMuSR/MEYER/g b/geant4/LEMuSR/MEYER/g new file mode 100644 index 0000000..4c82428 --- /dev/null +++ b/geant4/LEMuSR/MEYER/g @@ -0,0 +1,2 @@ +gnuplot + diff --git a/geant4/LEMuSR/MEYER/meyer.cc b/geant4/LEMuSR/MEYER/meyer.cc new file mode 100644 index 0000000..3ed9bea --- /dev/null +++ b/geant4/LEMuSR/MEYER/meyer.cc @@ -0,0 +1,888 @@ +/* + fIRST IMPLEMENTATION BY ANLSEM,H. IN FORTRAN + C++ CONVERSION T.K.PARAISO 04-2005 + + !!! IMPORTANT !!! + + Notice: + Tables definition changes between FORTRAN and C++: + 1/ Fortran indices start at 1 and C++ indices start at 0 + 2/ Tables are defined as table[column][row] in Fortran + table[row][column] in c++ + + usefull reference + http://gershwin.ens.fr/vdaniel/Doc-Locale/Langages-Program-Scientific/Fortran/Tutorial/arrays.htm + +*/ + +#include "meyer.h" +#include +#include +#include +#include +#include +using namespace std; + + +meyer::meyer() +{;} + +meyer::~meyer() +{;} + + +void meyer::GFunctions(double* g1,double* g2, double tau) + +{ + + //Diese Routine gibt in Abhaengigkeit von der reduzierten Dicke 'tau' + //Funktionswerte fuer g1 und g2 zurueck. g1 und g2 sind dabei die von + //Meyer angegebenen tabellierten Funktionen fuer die Berechnung von Halbwerts- + //breiten von Streuwinkelverteilungen. (L.Meyer, phys.stat.sol. (b) 44, 253 + //(1971)) + + + double help; + + int i; + + + double tau_[] = {0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, + 2.5, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, 7.0, 8.0, 9.0, + 10.0, 12.0, 14.0, 16.0, 18.0, 20.0 }; + + double g1_[] = {0.050,0.115,0.183,0.245,0.305,0.363,0.419,0.473,0.525,0.575, + 0.689,0.799,0.905,1.010,1.100,1.190,1.370,1.540,1.700,1.850, + 1.990,2.270,2.540,2.800,3.050,3.290 }; + + double g2_[] = {0.00,1.25,0.91,0.79,0.73,0.69,0.65,0.63,0.61,0.59, + 0.56,0.53,0.50,0.47,0.45,0.43,0.40,0.37,0.34,0.32, + 0.30,0.26,0.22,0.18,0.15,0.13 }; + + + if (tau kann ich nicht ... => STOP"< Tabelle A + thetaSchlangeMax = 4.0; + } + else if (tau<=8.) + { + //! => Tabelle B + thetaSchlangeMax = 7.0; + } + else if (tau<=20.) + { + //! => Tabelle C + thetaSchlangeMax = 20.0; + } + else + { + std::cout<< "Subroutine ''Get_F_Function_Meyer'':"< kann ich nicht ... => STOP"<50.) + { + thetaStep = .5; + } + + else if (thetaMax>25) + { + thetaStep = .25; + } + else if (thetaMax>12.5) + { + thetaStep = .125; + } + else + { + thetaStep = .0625; + } + + + //Tabelle der F-Werte erstellen: + + nBin = 0; + std::cout<<"thetamax = "<nBinMax) + { + std::cout<< "nBin > nBinMax => EXIT"; + break; + } + + value[nBin] = sin(theta)*F; + + fValues[nBin+1] = F; // ! fuer Testzwecke + fValuesFolded[nBin+1] = sin(theta/180*M_PI)*F;// ! fuer Testzwecke + + + }// end of do loop + + + //Berechnen der Flaecheninhalte der einzelnen Kanaele sowie der Integrale: + + bigtheta:for( i = 1;i<= nBin; i++) + { + area[i] = (value[i]+value[i-1])/2.* thetaStep; + integ[i] = integ[i-1] + area[i]; + } + + + //Normiere totale Flaeche auf 1: + + rHelp = integ[nBin]; + for( i = 1; i<=nBin; i++) + { + value[i] = value[i] / rHelp; + area[i] = area[i] / rHelp; + integ[i] = integ[i] / rHelp; + } + + + //vorerst noch: gib Tabelle in Datei und Histogrammfile aus: + + //! Berechne die Werte fuer theta=0: + + F_Functions_Meyer(tau,0.,&f1,&f2); + F = Meyer_faktor4*Meyer_faktor4 * Ekin*Ekin /2 /M_PI * (f1 - Meyer_faktor3*f2);// TAO, Anselm was: Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2); + fValues[1] = F; + fValuesFolded[1] = 0.; + + //! Gib die Werte in das Tabellenfile aus: + + ofstream Mprint("tkm.out"); + theta = thetaStep; + if (!Mprint.is_open()) exit(8); + for( i = 1; i<=nBin+1;i++) + { + Mprint << theta<< " "<< fValues[i]/fValues[1]<<" " << fValuesFolded[i]< Reihe mit hoeherem Index + //iColumn = 2 => Reihe mit kleinerem Index + + + iColumn = 1; + + // 5 continue; + do{ + + if (column_<=8) + { + //! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + //! Werte aus 1. Tabelle: 0.2 <= tau <= 1.8 + + column = column_; + // std::cout<<"thetaSchlange = "<> 20*(a/r0)^(4/3) sein muss. Fuer Protonen auf +c Graphit ist laut Referenz a/r0 gleich 0.26 (mit Dichte von 3.5 g/ccm habe +c ich einen Wert von 0.29 abgeschaetzt). Fuer Myonen hat man den selben +c Wert zu nehmen. Damit ergibt sich die Forderung, dass n >> 3.5 sein muss. +c +c (2) unabhaengig von (1) n >> 5 sein muss, was (1) also mit einschliesst. +c +c Mit n = Pi*r0*r0*Teilchen/Flaeche ergibt sich fuer eine Foliendicke von +c 3 ug/cm^2 als Abschaetzung fuer n ein Wert von 37. (r0 ueber r0 = 0.5 N^(1/3) +c und 3.5 g/ccm zu 8.9e-9 cm abgeschaetzt). D.h., dass die Bedingungen in +c unserem Fall gut erfuellt sind. +c In dem Paper wird eine Formel fuer Halbwertsbreiten angegeben. Ich habe nicht +c kontrolliert, in wie weit die Form der Verteilung tatsaechlich einer Gauss- +c verteilung entspricht. Zumindest im Bereich der Vorwaertsstreuung sollte +c die in diesem Programm verwendete Gaussverteilung aber eine sehr gute +c Naeherung abgeben. Abweichungen bei groesseren Winkeln koennten jedoch u. U. +c die absolute Streuintensitaet in Vorwaertsrichtung verfaelschen. + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c HIER GEHT DER PROGRAMMTEXT RICHTIG LOS +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + + + + + +c=============================================================================== + + options /extend_source + + subroutine Get_F_Function_Meyer(tau,Ekin) +c ========================================= + + implicit none + + real tau + real Ekin + + real thetaSchlange,thetaSchlangeMax + real theta,thetaMax,thetaStep + real f1,f2,F + + +c------------------------------------ +c - Parameter: + + real Z1, Z2 ! die atomaren Nummern von Projektil und Target +c real a0 ! Bohrscher Radius in cm + real screeningPar ! Screeningparameter 'a' in cm fuer Teilchen der + ! Kernladungszahl Z1=1 in Kohlenstoff (Z2 = 6) + ! bei Streichung von Z1 (vgl. Referenz, S. 268) + + real r0Meyer ! r0(C) berechnet aus dem screeningParameter 'a' + ! und dem ebenfalls bei Meyer angegebenem + ! Verhaeltnis a/r0=0.26 (vgl. Referenz, S. 263 oben) + real eSquare ! elektrische Ladung zum Quadrat in keV*cm + + real Pi ! die Kreiszahl + +c parameter (a0 = 5.29E-9) + parameter (Z1 = 1, Z2 = 6, ScreeningPar = 2.5764E-9) + parameter (r0Meyer = 9.909E-9, eSquare = 1.44E-10) + parameter (Pi = 3.141592654) + + real Meyer_Faktor3 + real Meyer_Faktor4 + real zzz ! 'Hilfsparameter' + real Meyer_Faktor5 + + parameter (Meyer_faktor3 = (screeningPar/r0Meyer) * (screeningPar/r0Meyer)) + parameter (Meyer_faktor4 = screeningPar / (2.*Z1*Z2*eSquare) * Pi/180.) + parameter (zzz = screeningPar / (2.*Z1*Z2*eSquare)) + parameter (Meyer_faktor5 = zzz*zzz / (8*Pi*Pi)) + +c------------------------------------ + + integer nBin,nBinMax + parameter (nBinMax=201) + real value(0:nBinMax) /0.,nBinMax*0./ + real area(nBinMax) / nBinMax*0./ + real integ(0:nBinMax) /0.,nBinMax*0./ + common /MeyerTable/ value,area,integ,thetaStep,nBin + + integer i + real rhelp + + integer HB_memsize + parameter(HB_memsize=500000) + real memory(HB_memsize) + COMMON /PAWC/ memory + + +c nur noch fuer Testzwecke: + + real fValues(203) + real fValuesFolded(203) + + integer idh + parameter (idh = 50) + + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + character filename*20 ! Name der Ausgabe-Dateien + COMMON /filename/ filename + +c------------------------------------------------------------------------------- + +c Festlegen des maximalen Theta-Wertes sowie der Schrittweite: + + if (tau.LT.0.2) then + write(*,*) 'Subroutine ''Get_F_Function_Meyer'':' + write(*,*) 'Effektive Dicke ist kleiner als 0.2 => kann ich nicht ... => STOP' + call exit + elseif (tau.LE.2.) then + ! => Tabelle A + thetaSchlangeMax = 4.0 + elseif (tau.LE.8.) then + ! => Tabelle B + thetaSchlangeMax = 7.0 + elseif (tau.LE.20.) then + ! => Tabelle C + thetaSchlangeMax = 20.0 + else + write(*,*) 'Subroutine ''Get_F_Function_Meyer'':' + write(*,*) 'Effektive Dicke ist groesser als 20 => kann ich nicht ... => STOP' + call exit + endif + + thetaMax = thetaSchlangeMax / Meyer_Faktor4 / Ekin + if (thetaMax.GT.50) then + thetaStep = .5 + elseif (thetaMax.GT.25) then + thetaStep = .25 + elseif (thetaMax.GT.12.5) then + thetaStep = .125 + else + thetaStep = .0625 + endif + + +c Tabelle der F-Werte erstellen: + + nBin = 0 + do theta = thetaStep, thetaMax, thetaStep + + ! Berechne aus theta das 'reduzierte' thetaSchlange (dabei gleich + ! noch von degree bei theta in Radiant bei thetaSchlange umrechnen): + + thetaSchlange = Meyer_faktor4 * Ekin * theta + + ! Auslesen der Tabellenwerte fuer die f-Funktionen: + + call F_Functions_Meyer(tau,thetaSchlange,f1,f2) + if (thetaSchlange.EQ.-1) then + ! wir sind jenseits von thetaSchlangeMax + goto 10 + endif + + ! Berechnen der Streuintensitaet: + F = Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2) + + nBin = nBin + 1 + if (nBin.GT.nBinMax) then + write(*,*) 'nBin > nBinMax => EXIT' + call exit + endif + value(nBin) = sind(theta)*F + + fValues(nBin+1) = F ! fuer Testzwecke + fValuesFolded(nBin+1) = sind(theta)*F ! fuer Testzwecke + + enddo + + +c Berechnen der Flaecheninhalte der einzelnen Kanaele sowie der Integrale: + +10 do i = 1, nBin + area(i) = (value(i)+value(i-1))/2. * thetaStep + integ(i) = integ(i-1) + area(i) + enddo + + +c Normiere totale Flaeche auf 1: + + rHelp = integ(nBin) + do i = 1, nBin + value(i) = value(i) / rHelp + area(i) = area(i) / rHelp + integ(i) = integ(i) / rHelp + enddo + + +c vorerst noch: gib Tabelle in Datei und Histogrammfile aus: + + ! Berechne die Werte fuer theta=0: + + call F_Functions_Meyer(tau,0.,f1,f2) + F = Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2) + fValues(1) = F + fValuesFolded(1) = 0. + + ! Gib die Werte in das Tabellenfile aus: + +c theta = 0. +c open (10,file=outDir//':'//filename//'.TAB',status='NEW') +c do i = 1, nBin+1 +c write(10,*) theta, fValues(i), fValuesFolded(i) +c theta = theta + thetaStep +c enddo +c close (10) + + + ! Buchen und Fuellen der Histogramme: + + call HBOOK1(idh,'F',nBin+1,-0.5*thetaStep,(real(nBin)+0.5)*thetaStep,0.) + call HPAK(idh,fValues) + call HRPUT(idh,outDir//':'//filename//'.RZ','N') + call HDELET(idh) + + call HBOOK1(idh+1,'F*sin([q])',nBin+1,-0.5*thetaStep,(real(nBin)+0.5)*thetaStep,0.) + call HPAK(idh+1,fValuesFolded) + call HRPUT(idh+1,outDir//':'//filename//'.RZ','U') + call HDELET(idh+1) + + + END + + +c=============================================================================== + + options /extend_source + + subroutine throwMeyerAngle (theta) +c ================================== + + implicit none + + real lowerbound,y1,y2,f,root,radiant,fraction + integer bin,nBin + integer nBinMax + parameter (nBinMax=201) + + real theta,thetaStep + real value(0:nBinMax) /0.,nBinMax*0./ + real area(nBinMax) / nBinMax*0./ + real integ(0:nBinMax) /0.,nBinMax*0./ + common /MeyerTable/ value,area,integ,thetaStep,nBin + + real rhelp + + real random + integer seed + common /seed/ seed + + +c bin: Nummer des Bins, innerhalb dessen das Integral den Wert von +c random erreicht oder ueberschreitet: + + random = ran(seed) + + bin = 1 + do while (random.GT.integ(bin)) + bin = bin + 1 + if (bin.GT.nBin) then + write(*,*) 'error 1' + call exit + endif + enddo + + fraction = (random-integ(bin-1)) / (integ(bin)-integ(bin-1)) + y1 = value(bin-1) + y2 = value(bin) + f = thetaStep / (y2-y1) + rHelp = y1*f + + radiant = rHelp*rHelp + fraction*thetaStep*(y1+y2)*f + root = SQRT(radiant) + lowerBound = real(bin-1)*thetaStep + if (f.GT.0) then + theta = lowerBound - rHelp + root + else + theta = lowerBound - rHelp - root + endif + + + END + + +c=============================================================================== + + options /extend_source + + subroutine F_Functions_Meyer(tau,thetaSchlange,f1,f2) +c ===================================================== + + implicit none + +c Diese Routine gibt in Abhaengigkeit von 'thetaSchlange' und 'tau' +c Funktionswerte fuer f1 und f2 zurueck. f1 und f2 entsprechen dabei den +c bei Meyer angegebenen Funktion gleichen Namens. Die in dieser Routine +c verwendeten Tabellen sind eben dieser Referenz entnommen: +c L.Meyer, phys.stat.sol. (b) 44, 253 (1971) + + real tau,thetaSchlange + real f1, f2, f1_(2), f2_(2) + + integer column_,column,row + + integer iColumn + real weightCol, weightRow + +c------------------------------------------------------------------------------- diff --git a/geant4/LEMuSR/MEYER/meyer.h b/geant4/LEMuSR/MEYER/meyer.h new file mode 100644 index 0000000..351da12 --- /dev/null +++ b/geant4/LEMuSR/MEYER/meyer.h @@ -0,0 +1,27 @@ +#ifndef meyer_h +#define meyer_h 1 + +#include +#include +#include +#include +#include +#include +#include + + +class meyer +{ + public: + meyer(); + ~meyer(); + + + void GFunctions(double*, double*, double); + void Get_F_Function_Meyer(double tau, double Ekin, double Z1, double Z2, double m1, double m2); + void F_Functions_Meyer( double tau,double thetaSchlange,double *f1,double *f2); + + +}; + +#endif diff --git a/geant4/LEMuSR/MEYER/mk.sh b/geant4/LEMuSR/MEYER/mk.sh new file mode 100644 index 0000000..064470f --- /dev/null +++ b/geant4/LEMuSR/MEYER/mk.sh @@ -0,0 +1 @@ +g++ testmeyer.cc meyer.cc diff --git a/geant4/LEMuSR/MEYER/mtest.for b/geant4/LEMuSR/MEYER/mtest.for new file mode 100644 index 0000000..494d82a --- /dev/null +++ b/geant4/LEMuSR/MEYER/mtest.for @@ -0,0 +1,698 @@ + PROGRAM mtest + IMPLICIT NONE + + + write(*,*)'SUBROUTINE G_Functions:' + + + SUBROUTINE G_Functions(G1,G2,tau) +c ================================= + +c Diese Routine gibt in Abhaengigkeit von der reduzierten Dicke 'tau' +c Funktionswerte fuer g1 und g2 zurueck. g1 und g2 sind dabei die von +c Meyer angegebenen tabellierten Funktionen fuer die Berechnung von Halbwerts- +c breiten von Streuwinkelverteilungen. (L.Meyer, phys.stat.sol. (b) 44, 253 +c (1971)) + + IMPLICIT NONE + + real tau,g1,g2 + real tau_(26),g1_(26),g2_(26) + real help + + integer i + + DATA tau_ /0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, + + 2.5, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, 7.0, 8.0, 9.0, + + 10.0, 12.0, 14.0, 16.0, 18.0, 20.0 / + + DATA g1_ /0.050,0.115,0.183,0.245,0.305,0.363,0.419,0.473,0.525,0.575, + + 0.689,0.799,0.905,1.010,1.100,1.190,1.370,1.540,1.700,1.850, + + 1.990,2.270,2.540,2.800,3.050,3.290 / + DATA g2_ / 0.00,1.25,0.91,0.79,0.73,0.69,0.65,0.63,0.61,0.59, + + 0.56,0.53,0.50,0.47,0.45,0.43,0.40,0.37,0.34,0.32, + + 0.30,0.26,0.22,0.18,0.15,0.13 / + + if (tau.LT.tau_(1)) then + write(*,*) + write(*,*)'SUBROUTINE G_Functions:' + write(*,*)' Fehler bei Berechnung der g-Funktionen fuer Winkelaufstreuung:' + write(*,*)' aktuelles tau ist kleiner als kleinster Tabellenwert:' + write(*,*)' tau = ',tau + write(*,*)' tau_(1) = ',tau_(1) + write(*,*) + STOP + endif + + i = 1 + + 10 i = i + 1 + if (i.EQ.27) then + write(*,*) + write(*,*)'SUBROUTINE G_Functions:' + write(*,*)' Fehler bei Berechnung der g-Funktionen fuer Winkelaufstreuung:' + write(*,*)' aktuelles tau ist groesser als groesster Tabellenwert:' + write(*,*)' tau = ',tau + write(*,*)' tau_(26) = ',tau_(26) + write(*,*) + STOP + elseif (tau.gt.tau_(i)) then + goto 10 + endif + + +c lineare Interpolation zwischen Tabellenwerten: + + help = (tau-tau_(i-1))/(tau_(i)-tau_(i-1)) + + g1 = g1_(i-1) + help*(g1_(i)-g1_(i-1)) + g2 = g2_(i-1) + help*(g2_(i)-g2_(i-1)) + + + END + + +c=============================================================================== + + options /extend_source + + subroutine Get_F_Function_Meyer(tau,Ekin) +c ========================================= + + implicit none + + real tau + real Ekin + + real thetaSchlange,thetaSchlangeMax + real theta,thetaMax,thetaStep + real f1,f2,F + + +c------------------------------------ +c - Parameter: + + real Z1, Z2 ! die atomaren Nummern von Projektil und Target +c real a0 ! Bohrscher Radius in cm + real screeningPar ! Screeningparameter 'a' in cm fuer Teilchen der + ! Kernladungszahl Z1=1 in Kohlenstoff (Z2 = 6) + ! bei Streichung von Z1 (vgl. Referenz, S. 268) + + real r0Meyer ! r0(C) berechnet aus dem screeningParameter 'a' + ! und dem ebenfalls bei Meyer angegebenem + ! Verhaeltnis a/r0=0.26 (vgl. Referenz, S. 263 oben) + real eSquare ! elektrische Ladung zum Quadrat in keV*cm + + real Pi ! die Kreiszahl + +c parameter (a0 = 5.29E-9) + parameter (Z1 = 1, Z2 = 6, ScreeningPar = 2.5764E-9) + parameter (r0Meyer = 9.909E-9, eSquare = 1.44E-10) + parameter (Pi = 3.141592654) + + real Meyer_Faktor3 + real Meyer_Faktor4 + real zzz ! 'Hilfsparameter' + real Meyer_Faktor5 + + parameter (Meyer_faktor3 = (screeningPar/r0Meyer) * (screeningPar/r0Meyer)) + parameter (Meyer_faktor4 = screeningPar / (2.*Z1*Z2*eSquare) * Pi/180.) + parameter (zzz = screeningPar / (2.*Z1*Z2*eSquare)) + parameter (Meyer_faktor5 = zzz*zzz / (8*Pi*Pi)) + +c------------------------------------ + + integer nBin,nBinMax + parameter (nBinMax=201) + real value(0:nBinMax) /0.,nBinMax*0./ + real area(nBinMax) / nBinMax*0./ + real integ(0:nBinMax) /0.,nBinMax*0./ + common /MeyerTable/ value,area,integ,thetaStep,nBin + + integer i + real rhelp + + integer HB_memsize + parameter(HB_memsize=500000) + real memory(HB_memsize) + COMMON /PAWC/ memory + + +c nur noch fuer Testzwecke: + + real fValues(203) + real fValuesFolded(203) + + integer idh + parameter (idh = 50) + + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + character filename*20 ! Name der Ausgabe-Dateien + COMMON /filename/ filename + +c------------------------------------------------------------------------------- + +c Festlegen des maximalen Theta-Wertes sowie der Schrittweite: + + if (tau.LT.0.2) then + write(*,*) 'Subroutine ''Get_F_Function_Meyer'':' + write(*,*) 'Effektive Dicke ist kleiner als 0.2 => kann ich nicht ... => STOP' + call exit + elseif (tau.LE.2.) then + ! => Tabelle A + thetaSchlangeMax = 4.0 + elseif (tau.LE.8.) then + ! => Tabelle B + thetaSchlangeMax = 7.0 + elseif (tau.LE.20.) then + ! => Tabelle C + thetaSchlangeMax = 20.0 + else + write(*,*) 'Subroutine ''Get_F_Function_Meyer'':' + write(*,*) 'Effektive Dicke ist groesser als 20 => kann ich nicht ... => STOP' + call exit + endif + + thetaMax = thetaSchlangeMax / Meyer_Faktor4 / Ekin + if (thetaMax.GT.50) then + thetaStep = .5 + elseif (thetaMax.GT.25) then + thetaStep = .25 + elseif (thetaMax.GT.12.5) then + thetaStep = .125 + else + thetaStep = .0625 + endif + + +c Tabelle der F-Werte erstellen: + + nBin = 0 + do theta = thetaStep, thetaMax, thetaStep + + ! Berechne aus theta das 'reduzierte' thetaSchlange (dabei gleich + ! noch von degree bei theta in Radiant bei thetaSchlange umrechnen): + + thetaSchlange = Meyer_faktor4 * Ekin * theta + + ! Auslesen der Tabellenwerte fuer die f-Funktionen: + + call F_Functions_Meyer(tau,thetaSchlange,f1,f2) + if (thetaSchlange.EQ.-1) then + ! wir sind jenseits von thetaSchlangeMax + goto 10 + endif + + ! Berechnen der Streuintensitaet: + F = Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2) + + nBin = nBin + 1 + if (nBin.GT.nBinMax) then + write(*,*) 'nBin > nBinMax => EXIT' + call exit + endif + value(nBin) = sind(theta)*F + + fValues(nBin+1) = F ! fuer Testzwecke + fValuesFolded(nBin+1) = sind(theta)*F ! fuer Testzwecke + + enddo + + +c Berechnen der Flaecheninhalte der einzelnen Kanaele sowie der Integrale: + + 10 do i = 1, nBin + area(i) = (value(i)+value(i-1))/2. * thetaStep + integ(i) = integ(i-1) + area(i) + enddo + + +c Normiere totale Flaeche auf 1: + + rHelp = integ(nBin) + do i = 1, nBin + value(i) = value(i) / rHelp + area(i) = area(i) / rHelp + integ(i) = integ(i) / rHelp + enddo + + +c vorerst noch: gib Tabelle in Datei und Histogrammfile aus: + + ! Berechne die Werte fuer theta=0: + + call F_Functions_Meyer(tau,0.,f1,f2) + F = Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2) + fValues(1) = F + fValuesFolded(1) = 0. + + ! Gib die Werte in das Tabellenfile aus: + +c theta = 0. +c open (10,file=outDir//':'//filename//'.TAB',status='NEW') +c do i = 1, nBin+1 +c write(10,*) theta, fValues(i), fValuesFolded(i) +c theta = theta + thetaStep +c enddo +c close (10) + + + ! Buchen und Fuellen der Histogramme: + + call HBOOK1(idh,'F',nBin+1,-0.5*thetaStep,(real(nBin)+0.5)*thetaStep,0.) + call HPAK(idh,fValues) + call HRPUT(idh,outDir//':'//filename//'.RZ','N') + call HDELET(idh) + + call HBOOK1(idh+1,'F*sin([q])',nBin+1,-0.5*thetaStep,(real(nBin)+0.5)*thetaStep,0.) + call HPAK(idh+1,fValuesFolded) + call HRPUT(idh+1,outDir//':'//filename//'.RZ','U') + call HDELET(idh+1) + + + END + + +c=============================================================================== + + options /extend_source + + subroutine throwMeyerAngle (theta) +c ================================== + + implicit none + + real lowerbound,y1,y2,f,root,radiant,fraction + integer bin,nBin + integer nBinMax + parameter (nBinMax=201) + + real theta,thetaStep + real value(0:nBinMax) /0.,nBinMax*0./ + real area(nBinMax) / nBinMax*0./ + real integ(0:nBinMax) /0.,nBinMax*0./ + common /MeyerTable/ value,area,integ,thetaStep,nBin + + real rhelp + + real random + integer seed + common /seed/ seed + + +c bin: Nummer des Bins, innerhalb dessen das Integral den Wert von +c random erreicht oder ueberschreitet: + + random = ran(seed) + + bin = 1 + do while (random.GT.integ(bin)) + bin = bin + 1 + if (bin.GT.nBin) then + write(*,*) 'error 1' + call exit + endif + enddo + + fraction = (random-integ(bin-1)) / (integ(bin)-integ(bin-1)) + y1 = value(bin-1) + y2 = value(bin) + f = thetaStep / (y2-y1) + rHelp = y1*f + + radiant = rHelp*rHelp + fraction*thetaStep*(y1+y2)*f + root = SQRT(radiant) + lowerBound = real(bin-1)*thetaStep + if (f.GT.0) then + theta = lowerBound - rHelp + root + else + theta = lowerBound - rHelp - root + endif + + + END + + +c=============================================================================== + + options /extend_source + + subroutine F_Functions_Meyer(tau,thetaSchlange,f1,f2) +c ===================================================== + + implicit none + +c Diese Routine gibt in Abhaengigkeit von 'thetaSchlange' und 'tau' +c Funktionswerte fuer f1 und f2 zurueck. f1 und f2 entsprechen dabei den +c bei Meyer angegebenen Funktion gleichen Namens. Die in dieser Routine +c verwendeten Tabellen sind eben dieser Referenz entnommen: +c L.Meyer, phys.stat.sol. (b) 44, 253 (1971) + + real tau,thetaSchlange + real f1, f2, f1_(2), f2_(2) + + integer column_,column,row + + integer iColumn + real weightCol, weightRow + +c------------------------------------------------------------------------------- + +c die Tabellendaten der Referenz (Tabellen 2 und 3): + + integer nColumn + parameter (nColumn = 25) + real tau_(nColumn) / + + 0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.5, 3.0, + + 3.5, 4.0, 4.5, 5.0, 6.0, 7.0, 8.0, 10., 12., 14., 16., 18., 20. / + + integer nRowA + parameter (nRowA = 25) + real thetaSchlangeA(nRowA) / + + .00, .05, .10, .15, .20, .25, .30, .35, .40, .45, .50, .60, + + .70, .80, .90, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.5, 3.0, 3.5, 4.0 / + + integer nRowB + parameter (nRowB = 24) + real thetaSchlangeB(nRowB) / + + 0.0, 0.2, 0.4, 0.5, 0.6, 0.8, 1.0, 1.2, 1.4, 1.5, 1.6, 1.8, + + 2.0, 2.2, 2.4, 2.6, 2.8, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, 7.0 / + + integer nRowC + parameter (nRowC = 24) + real thetaSchlangeC(nRowC) / + + 0.0, 0.5, 1.0, 1.5, 2.0, 2.5, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, + + 7.0, 8.0, 9.0, 10., 11., 12., 13., 14., 15., 16., 18., 20. / + + + real f1_A(9,nRowA) + + /1.69E+2,4.55E+1,2.11E+1,1.25E+1,8.48E+0,6.21E+0,4.80E+0,3.86E+0,3.20E+0, + + 9.82E+1,3.72E+1,1.97E+1,1.20E+1,8.27E+0,6.11E+0,4.74E+0,3.83E+0,3.17E+0, + + 3.96E+1,2.58E+1,1.65E+1,1.09E+1,7.73E+0,5.82E+0,4.58E+0,3.72E+0,3.10E+0, + + 1.76E+1,1.58E+1,1.27E+1,9.26E+0,6.93E+0,5.38E+0,4.31E+0,3.55E+0,2.99E+0, + + 8.62E+0,1.01E+1,9.45E+0,7.58E+0,6.02E+0,4.85E+0,3.98E+0,3.33E+0,2.84E+0, + + 4.65E+0,6.55E+0,6.91E+0,6.06E+0,5.11E+0,4.28E+0,3.62E+0,3.08E+0,2.66E+0, + + 2.74E+0,4.45E+0,5.03E+0,4.78E+0,4.27E+0,3.72E+0,3.23E+0,2.82E+0,2.47E+0, + + 1.77E+0,3.02E+0,3.71E+0,3.76E+0,3.53E+0,3.20E+0,2.86E+0,2.55E+0,2.27E+0, + + 1.22E+0,2.19E+0,2.78E+0,2.96E+0,2.91E+0,2.73E+0,2.51E+0,2.28E+0,2.07E+0, + + 8.82E-1,1.59E+0,2.12E+0,2.35E+0,2.39E+0,2.32E+0,2.19E+0,2.03E+0,1.87E+0, + + 6.55E-1,1.20E+0,1.64E+0,1.88E+0,1.97E+0,1.96E+0,1.90E+0,1.79E+0,1.68E+0, + + 3.80E-1,7.15E-1,1.01E+0,1.22E+0,1.35E+0,1.40E+0,1.41E+0,1.39E+0,1.34E+0, + + 2.26E-1,4.45E-1,6.44E-1,8.08E-1,9.28E-1,1.01E+0,1.05E+0,1.06E+0,1.05E+0, + + 1.39E-1,2.80E-1,4.21E-1,5.45E-1,6.46E-1,7.22E-1,7.75E-1,8.07E-1,8.21E-1, + + 8.22E-2,1.76E-1,2.78E-1,3.71E-1,4.53E-1,5.21E-1,5.74E-1,6.12E-1,6.37E-1, + + 5.04E-2,1.11E-1,1.86E-1,2.57E-1,3.22E-1,3.79E-1,4.27E-1,4.65E-1,4.94E-1, + + 2.51E-2,5.60E-2,9.24E-2,1.31E-1,1.69E-1,2.02E-1,2.40E-1,2.71E-1,2.97E-1, + + 1.52E-2,3.20E-2,5.08E-2,7.23E-2,9.51E-2,1.18E-1,1.41E-1,1.63E-1,1.83E-1, + + 1.03E-2,2.05E-2,3.22E-2,4.55E-2,6.01E-2,7.53E-2,9.02E-2,1.05E-1,1.19E-1, + + 8.80E-3,1.48E-2,2.25E-2,3.13E-2,4.01E-2,5.03E-2,6.01E-2,7.01E-2,8.01E-2, + + 6.10E-3,1.15E-2,1.71E-2,2.28E-2,2.89E-2,3.52E-2,4.18E-2,4.86E-2,5.55E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,1.71E-2,1.98E-2,2.28E-2,2.58E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,8.90E-3,1.02E-2,1.16E-2,1.31E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,4.90E-3,5.70E-3,6.40E-3,7.20E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,2.90E-3,3.40E-3,3.90E-3,4.30E-3/ + + real f1_B(9,nRowB) + + /2.71E+0,1.92E+0,1.46E+0,1.16E+0,9.52E-1,8.03E-1,6.90E-1,5.32E-1,4.28E-1, + + 2.45E+0,1.79E+0,1.39E+0,1.12E+0,9.23E-1,7.82E-1,6.75E-1,5.23E-1,4.23E-1, + + 1.87E+0,1.48E+0,1.20E+0,9.96E-1,8.42E-1,7.24E-1,6.32E-1,4.98E-1,4.07E-1, + + 1.56E+0,1.30E+0,1.09E+0,9.19E-1,7.89E-1,6.86E-1,6.03E-1,4.80E-1,3.95E-1, + + 1.28E+0,1.11E+0,9.62E-1,8.33E-1,7.27E-1,6.40E-1,5.69E-1,4.59E-1,3.81E-1, + + 8.23E-1,7.90E-1,7.29E-1,6.64E-1,6.01E-1,5.44E-1,4.94E-1,4.12E-1,3.49E-1, + + 5.14E-1,5.36E-1,5.29E-1,5.07E-1,4.78E-1,4.47E-1,4.16E-1,3.60E-1,3.13E-1, + + 3.19E-1,3.58E-1,3.76E-1,3.78E-1,3.70E-1,3.57E-1,3.45E-1,3.08E-1,2.76E-1, + + 2.02E-1,2.40E-1,2.64E-1,2.77E-1,2.82E-1,2.80E-1,2.65E-1,2.59E-1,2.39E-1, + + 1.67E-1,1.96E-1,2.20E-1,2.36E-1,2.44E-1,2.47E-1,2.45E-1,2.35E-1,2.21E-1, + + 1.33E-1,1.61E-1,1.85E-1,2.02E-1,2.12E-1,2.18E-1,2.18E-1,2.14E-1,2.03E-1, + + 8.99E-2,1.12E-1,1.32E-1,1.48E-1,1.59E-1,1.67E-1,1.68E-1,1.75E-1,1.72E-1, + + 6.24E-2,7.94E-2,9.50E-2,1.09E-1,1.20E-1,1.29E-1,1.35E-1,1.42E-1,1.43E-1, + + 4.55E-2,5.74E-2,6.98E-2,8.11E-2,9.09E-2,9.92E-2,1.06E-1,1.15E-1,1.19E-1, + + 3.35E-2,4.22E-2,5.19E-2,6.11E-2,6.95E-2,7.69E-2,8.33E-2,9.28E-2,9.85E-2, + + 2.50E-2,3.16E-2,3.92E-2,4.66E-2,5.35E-2,6.00E-2,6.57E-2,7.49E-2,8.13E-2, + + 1.90E-2,2.40E-2,2.99E-2,3.58E-2,4.16E-2,4.70E-2,5.20E-2,6.05E-2,6.70E-2, + + 1.47E-2,1.86E-2,2.32E-2,2.79E-2,3.25E-2,3.70E-2,4.12E-2,4.89E-2,5.51E-2, + + 8.10E-3,1.04E-2,1.30E-2,1.57E-2,1.84E-2,2.12E-2,2.40E-2,2.93E-2,3.42E-2, + + 4.80E-3,6.20E-3,7.70E-3,9.30E-3,1.09E-2,1.26E-2,1.44E-2,1.79E-2,2.14E-2, + + 2.80E-3,3.80E-3,4.70E-3,5.70E-3,6.70E-3,7.50E-3,8.90E-3,1.13E-2,1.36E-2, + + 1.70E-3,2.30E-3,2.90E-3,3.60E-3,4.20E-3,4.90E-3,5.60E-3,7.20E-3,8.80E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,2.00E-3,2.80E-3,3.50E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,8.80E-4,1.20E-3,1.60E-3/ + + real f1_C(7,nRowC) + + /3.65E-1,2.62E-1,2.05E-1,1.67E-1,1.41E-1,1.21E-1,1.05E-1, + + 3.33E-1,2.50E-1,1.95E-1,1.61E-1,1.36E-1,1.18E-1,1.03E-1, + + 2.75E-1,2.18E-1,1.76E-1,1.48E-1,1.27E-1,1.11E-1,9.80E-2, + + 2.04E-1,1.75E-1,1.50E-1,1.29E-1,1.13E-1,1.01E-1,9.00E-2, + + 1.41E-1,1.31E-1,1.19E-1,1.08E-1,9.71E-2,8.88E-2,8.01E-2, + + 9.32E-2,9.42E-2,9.10E-2,8.75E-2,8.00E-2,7.44E-2,6.91E-2, + + 5.98E-2,6.52E-2,6.72E-2,6.62E-2,6.40E-2,6.12E-2,5.82E-2, + + 3.83E-2,4.45E-2,4.80E-2,4.96E-2,4.98E-2,4.90E-2,4.77E-2, + + 2.46E-2,3.01E-2,3.40E-2,3.65E-2,3.79E-2,3.84E-2,3.83E-2, + + 1.59E-2,2.03E-2,2.39E-2,2.66E-2,2.85E-2,2.97E-2,3.04E-2, + + 1.04E-2,1.37E-2,1.66E-2,1.92E-2,2.12E-2,2.27E-2,2.37E-2, + + 4.39E-3,6.26E-3,8.26E-3,9.96E-3,1.15E-2,1.29E-2,1.41E-2, + + 2.06E-3,3.02E-3,4.24E-3,5.28E-3,6.32E-3,7.32E-3,8.26E-3, + + 1.21E-3,1.69E-3,2.24E-3,2.85E-3,3.50E-3,4.16E-3,4.82E-3, + + 8.50E-4,1.10E-3,1.38E-3,1.65E-3,2.03E-3,2.45E-3,2.88E-3, + + 5.90E-4,7.40E-4,8.50E-4,9.90E-4,1.23E-3,1.49E-3,1.71E-3, + + 3.90E-4,4.60E-4,5.20E-4,6.30E-4,7.65E-4,9.65E-4,1.12E-3, + + 2.40E-4,2.70E-4,3.10E-4,3.98E-4,4.97E-4,6.03E-4,7.18E-4, + + 1.50E-4,1.70E-4,2.15E-4,2.70E-4,3.35E-4,4.35E-4,5.00E-4, + + 1.00E-4,1.20E-4,1.46E-4,1.90E-4,2.40E-4,2.88E-4,3.43E-4, + + 0.00 ,0.00 ,1.04E-4,1.41E-4,1.80E-4,2.10E-4,2.50E-4, + + 0.00 ,0.00 ,8.20E-5,1.06E-4,1.38E-4,1.58E-4,1.85E-4, + + 0.00 ,0.00 ,5.40E-5,7.00E-5,8.60E-5,1.03E-4,1.20E-4, + + 0.00 ,0.00 ,4.20E-5,5.40E-5,6.50E-5,7.70E-5,8.80E-5/ + + real f2_A(9,nRowA) + + / 3.52E+3, 3.27E+2, 9.08E+1, 3.85E+1, 2.00E+1, 1.18E+1, 7.55E+0, 5.16E+0, 3.71E+0, + + 2.58E+2, 1.63E+2, 7.30E+1, 3.42E+1, 1.85E+1, 1.11E+1, 7.18E+0, 4.96E+0, 3.59E+0, + + -1.12E+2, 4.84E+0, 3.56E+1, 2.34E+1, 1.45E+1, 9.33E+0, 6.37E+0, 4.51E+0, 3.32E+0, + + -5.60E+1,-1.12E+1, 9.87E+0, 1.24E+1, 9.59E+0, 7.01E+0, 5.16E+0, 3.83E+0, 2.91E+0, + + -2.13E+1,-1.22E+1,-2.23E+0, 3.88E+0, 5.15E+0, 4.65E+0, 3.87E+0, 3.12E+0, 2.45E+0, + + -8.25E+0,-9.58E+0,-5.59E+0,-1.40E+0, 1.76E+0, 2.71E+0, 2.71E+0, 2.35E+0, 1.95E+0, + + -3.22E+0,-6.12E+0,-5.28E+0,-2.87E+0,-1.92E-1, 1.32E+0, 1.69E+0, 1.74E+0, 1.48E+0, + + -1.11E+0,-3.40E+0,-4.12E+0,-3.08E+0,-6.30E-1, 3.60E-1, 9.20E-1, 1.03E+0, 1.04E+0, + + -2.27E-1,-2.00E+0,-2.93E+0,-2.69E+0,-1.48E+0,-3.14E-1, 2.69E-1, 5.28E-1, 6.09E-1, + + 1.54E-1,-1.09E+0,-2.10E+0,-2.15E+0,-1.47E+0,-6.77E-1,-1.80E-1, 1.08E-1, 2.70E-1, + + 3.28E-1,-6.30E-1,-1.50E+0,-1.68E+0,-1.34E+0,-8.43E-1,-4.60E-1,-1.85E-1,-4.67E-3, + + 3.32E-1,-2.06E-1,-7.32E-1,-9.90E-1,-9.42E-1,-8.20E-1,-6.06E-1,-4.51E-1,-3.01E-1, + + 2.72E-1,-3.34E-2,-3.49E-1,-5.65E-1,-6.03E-1,-5.79E-1,-5.05E-1,-4.31E-1,-3.45E-1, + + 2.02E-1, 2.80E-2,-1.54E-1,-3.00E-1,-3.59E-1,-3.76E-1,-4.60E-1,-3.40E-1,-3.08E-1, + + 1.38E-1, 4.84E-2,-5.56E-2,-1.44E-1,-2.04E-1,-2.39E-1,-2.54E-1,-2.49E-1,-2.48E-1, + + 9.47E-2, 4.86E-2,-1.08E-2,-6.44E-2,-1.02E-1,-1.34E-1,-1.62E-1,-1.79E-1,-1.87E-1, + + 5.33E-2, 3.71E-2, 1.85E-2, 1.63E-3,-1.69E-2,-3.69E-2,-5.66E-2,-7.78E-2,-9.33E-2, + + 3.38E-2, 2.40E-2, 1.62E-2, 9.90E-3, 3.76E-3,-4.93E-3,-1.66E-2,-3.05E-2,-4.22E-2, + + 2.12E-2, 1.56E-2, 1.05E-2, 7.80E-3, 7.92E-3, 6.30E-3, 3.20E-4,-8.50E-3,-1.66E-2, + + 1.40E-2, 9.20E-3, 5.30E-3, 4.70E-3, 6.31E-3, 8.40E-3, 5.30E-3, 8.80E-4,-3.30E-3, + + 9.20E-3, 4.70E-3, 1.70E-3, 2.60E-3, 4.49E-3, 6.60E-3, 6.00E-3, 4.70E-3, 2.80E-3, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 / + + real f2_B(9,nRowB) + + / 2.75E+0, 1.94E+0, 9.13E-1, 6.06E-1, 4.26E-1, 3.14E-1, 2.40E-1, 1.51E-1, 1.03E-1, + + 1.94E+0, 1.16E+0, 7.56E-1, 5.26E-1, 3.81E-1, 2.87E-1, 2.23E-1, 1.43E-1, 9.78E-2, + + 5.85E-1, 5.04E-1, 4.10E-1, 3.30E-1, 2.69E-1, 2.17E-1, 1.78E-1, 1.22E-1, 8.71E-2, + + 7.83E-2, 2.00E-1, 2.35E-1, 2.19E-1, 1.97E-1, 1.73E-1, 1.48E-1, 1.08E-1, 7.93E-2, + + -1.82E-1, 1.56E-2, 1.04E-1, 1.36E-1, 1.38E-1, 1.31E-1, 1.19E-1, 9.46E-2, 7.19E-2, + + -2.71E-1,-1.66E-1,-7.29E-2,-4.74E-3, 3.60E-2, 5.50E-2, 6.28E-2, 5.98E-2, 5.09E-2, + + -1.87E-1,-1.58E-1,-1.09E-1,-5.80E-2,-2.03E-2, 2.48E-3, 1.99E-2, 3.36E-2, 3.27E-2, + + -1.01E-1,-1.05E-1,-8.95E-2,-6.63E-2,-3.93E-2,-2.38E-2,-9.22E-3, 8.47E-3, 1.52E-2, + + -5.19E-2,-6.47E-2,-6.51E-2,-5.62E-2,-4.51E-2,-3.49E-2,-2.45E-2,-8.19E-3, 2.05E-3, + + -3.68E-2,-4.89E-2,-5.36E-2,-5.06E-2,-4.27E-2,-3.65E-2,-2.80E-2,-1.33E-2,-3.47E-3, + + -2.33E-2,-3.69E-2,-4.41E-2,-4.38E-2,-3.97E-2,-3.50E-2,-2.88E-2,-1.60E-2,-6.68E-3, + + -8.76E-3,-2.07E-2,-2.90E-2,-3.17E-2,-3.09E-2,-2.92E-2,-2.63E-2,-1.79E-2,-1.03E-2, + + -1.20E-3,-1.11E-2,-1.90E-2,-2.20E-2,-2.32E-2,-2.24E-2,-2.10E-2,-1.66E-2,-1.11E-2, + + 1.72E-3,-4.82E-3,-1.02E-2,-1.42E-2,-1.65E-2,-1.66E-2,-1.60E-2,-1.39E-2,-1.09E-2, + + 2.68E-3,-1.18E-3,-5.19E-3,-8.30E-5,-1.01E-2,-1.14E-2,-1.16E-2,-1.16E-2,-9.99E-3, + + 2.81E-3, 8.21E-4,-1.96E-3,-3.99E-3,-5.89E-3,-7.13E-3,-8.15E-3,-9.05E-3,-8.60E-3, + + 2.61E-3, 1.35E-3,-2.99E-4,-1.79E-3,-3.12E-3,-4.44E-3,-5.61E-3,-7.01E-3,-7.27E-3, + + 2.06E-3, 1.45E-3, 4.64E-4,-5.97E-4,-1.71E-3,-2.79E-3,-3.84E-3,-5.29E-3,-5.90E-3, + + 1.07E-3, 9.39E-4, 8.22E-4, 3.58E-4,-1.15E-4,-6.60E-4,-1.18E-3,-2.15E-3,-2.88E-3, + + 4.97E-4, 5.46E-4, 6.15E-4, 5.56E-4, 3.14E-4, 9.80E-5,-1.30E-4,-5.98E-4,-1.07E-4, + + 1.85E-4, 3.11E-4, 4.25E-4, 4.08E-4, 3.63E-4, 3.04E-4, 2.24E-4, 2.80E-5,-2.10E-4, + + 4.80E-5, 1.48E-4, 2.44E-4, 2.80E-4, 3.01E-4, 3.11E-4, 3.13E-4, 2.40E-4, 1.10E-4, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 1.39E-4, 1.80E-4, 1.80E-4, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 4.38E-5, 7.30E-5, 8.40E-5/ + + real f2_C(7,nRowC) + + / 7.36E-2, 4.21E-2, 2.69E-2, 1.83E-2, 1.34E-2, 1.01E-2, 7.88E-3, + + 5.79E-2, 3.61E-2, 2.34E-2, 1.64E-2, 1.21E-2, 9.26E-3, 7.28E-3, + + 2.94E-2, 2.17E-2, 1.60E-2, 1.23E-2, 9.49E-3, 7.45E-3, 5.95E-3, + + 2.30E-3, 7.07E-3, 7.76E-3, 7.02E-3, 6.13E-3, 5.17E-3, 4.34E-3, + + -7.50E-3,-2.00E-3, 9.93E-4, 2.36E-3, 2.82E-3, 2.86E-3, 2.72E-3, + + -8.27E-3,-5.37E-3,-2.58E-3,-7.96E-4, 3.75E-4, 9.71E-4, 1.28E-3, + + -5.79E-3,-5.12E-3,-3.86E-3,-2.46E-3,-1.20E-3,-3.74E-4, 1.74E-4, + + -3.26E-3,-3.43E-3,-3.26E-3,-2.68E-3,-1.84E-3,-1.12E-3,-4.54E-4, + + -1.46E-3,-1.49E-3,-2.20E-3,-2.18E-3,-1.85E-3,-1.40E-3,-8.15E-4, + + -4.29E-4,-9.44E-4,-1.29E-3,-1.50E-3,-1.51E-3,-1.36E-3,-9.57E-4, + + -3.30E-5,-3.66E-4,-6.78E-4,-9.38E-4,-1.09E-3,-1.09E-3,-9.56E-4, + + 1.50E-4, 3.10E-5,-1.38E-4,-3.06E-4,-4.67E-4,-5.48E-4,-6.08E-4, + + 1.00E-4, 8.50E-5, 2.30E-5,-6.60E-5,-1.58E-4,-2.40E-4,-3.05E-4, + + 5.40E-5, 6.50E-5, 4.90E-5, 1.20E-5,-3.60E-5,-8.90E-5,-1.31E-4, + + 2.90E-5, 4.30E-5, 4.40E-5, 2.90E-5, 5.10E-6,-2.20E-5,-4.80E-5, + + 1.40E-5, 2.40E-5, 2.80E-5, 2.60E-5, 1.90E-5, 7.50E-6,-1.10E-5, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 / + + +c=============================================================================== + +c Bestimme, welche Reihen der Tabellen fuer Interpolation benoetigt werden: + + if (tau.LT.tau_(1)) then + write(*,*) 'tau is less than the lowest tabulated value:' + write(*,*) 'tau = ',tau + write(*,*) 'minimum = ',tau_(1) + call exit + elseif (tau.GT.tau_(nColumn)) then + write(*,*) 'tau is greater than the highest tabulated value:' + write(*,*) 'tau = ',tau + write(*,*) 'maximum = ',tau_(nColumn) + call exit + endif + + column_ = 2 + do while (tau.GT.tau_(column_)) + column_ = column_ + 1 + enddo + ! Das Gewicht der Reihe zu groesserem Tau: + weightCol = (tau-tau_(column_-1)) / (tau_(column_)-tau_(column_-1)) + + +c Besorge fuer gegebenes 'thetaSchlange' die interpolierten f1- und f2 -Werte +c der beiden relevanten Reihen: +c iColumn = 1 => Reihe mit hoeherem Index +c iColumn = 2 => Reihe mit kleinerem Index + + + iColumn = 1 + + + 5 continue + + if (column_.LE.9) then ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 1. Tabelle: 0.2 <= tau <= 1.8 + + column = column_ + + if (thetaSchlange.LT.thetaSchlangeA(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeA(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeA(nRowA)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeA(nRowA) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeA(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeA(row-1)) / + + (thetaSchlangeA(row)-thetaSchlangeA(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_A(column,row-1) + + + weightRow * f1_A(column,row) + f2_(iColumn) = (1.-weightRow) * f2_A(column,row-1) + + + weightRow * f2_A(column,row) + + + elseif (column_.LE.18) then ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 2. Tabelle: 2.0 <= tau <= 7.0 + + column = column_ - 9 + + if (thetaSchlange.LT.thetaSchlangeB(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeB(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeB(nRowB)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeB(nRowB) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeB(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeB(row-1)) / + + (thetaSchlangeB(row)-thetaSchlangeB(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_B(column,row-1) + + + weightRow * f1_B(column,row) + f2_(iColumn) = (1.-weightRow) * f2_B(column,row-1) + + + weightRow * f2_B(column,row) + + + else ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 3. Tabelle: 8.0 <= tau <= 20. + + column = column_ - 18 + + if (thetaSchlange.LT.thetaSchlangeC(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeC(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeC(nRowC)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeC(nRowC) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeC(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeC(row-1)) / + + (thetaSchlangeC(row)-thetaSchlangeC(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_C(column,row-1) + + + weightRow * f1_C(column,row) + f2_(iColumn) = (1.-weightRow) * f2_C(column,row-1) + + + weightRow * f2_C(column,row) + + + endif ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + + if (iColumn.EQ.1) then + column_ = column_ - 1 + iColumn = 2 + goto 5 + endif + + f1 = weightCol*f1_(1) + (1.-weightCol)*f1_(2) + f2 = weightCol*f2_(1) + (1.-weightCol)*f2_(2) + + + END + + +c=============================================================================== + END PROGRAM mtest diff --git a/geant4/LEMuSR/MEYER/mutrack.for b/geant4/LEMuSR/MEYER/mutrack.for new file mode 100644 index 0000000..8de2f9a --- /dev/null +++ b/geant4/LEMuSR/MEYER/mutrack.for @@ -0,0 +1,5466 @@ +c +c------------------------------------------------------------------------------ +c +c Changes starting on 17-Oct-2000, TP, PSI +c +c - add position of muons at TD foil and position of +c foil electrons when hitting MCP3 to NTuple +c - start changes for migration to NT and Unix; avoid using +c logicals or environment variables; cancel OPTIONS/EXTEND_SOURCE; +c use lower case filenames always +c +c****************************************************************************** +c* ... MUTRACK.FOR (Stand: Februar '96) * +c* * +c* Dieses Programm integriert Teilchenbahnen in der UHV-Kammer der NEMU- * +c* Apparatur. Startpunkte koennen zwischen der Moderatorfolie und dem MCP2 * +c* frei gewaehlt werden, Endpunkt der Berechnungen ist (sofern die Teilchen * +c* nicht vorher schon ausscheiden) die Ebene des MCP2. Bis jetzt koennen * +c* also nur Bewegungen in Strahlrichtung, nicht entgegen derselben berechnet * +c* werden. * +c* Das Programm selbst rechnet den zweistufigen Beschleuniger als ideal, * +c* bietet aber die Moeglichkeit Simulationen von TP oder AH (Programm 'Accel')* +c* mit realem Beschleuniger einzulesen. Die Integration der Teilchenbahnen * +c* erstreckt sich bei diesen Simulationen bis etwa zum He-Schild, MUTRACK * +c* rechnet dann von dort aus weiter. * +c* Verschiedene Einstellungen koennen in ineinandergreifenden Schleifen in * +c* aequidistanten Schritten variiert werden (z.B. Spannungen des Transport- * +c* Systems, Startgroessen der Teilchen, Masse und Ladung ...). Ein Teil dieser* +c* Groessen kann aber auch alternativ nach verschiedenen frei waehlbaren * +c* Zufallsverteilungen gewurfelt werden. * +c* Die Integrationsergebnisse koennen in der Form von NTupeln abgespeichert * +c* werden, was sie der Darstellung und Auswertung mit dem CERN-Programm PAW * +c* zugaenglich macht. * +c* Neben der reinen Integrationsarbeit fuehrt Mutrack Statistiken ueber * +c* verschiedene Groessen (z.Z. verschiedene Flugzeiten und Ortsverteilungen) * +c* die Mittelwerte und Standandartabweichungen sowie Minimal- und Maximalwerte* +c* umfassen. * +c* Diese Groessen koennen einfach ausgegeben oder in einem Tabellenfile abge- * +c* speichert werden, welches von PHYSICA mittels der Fortran-Routine * +c* 'READ_DATA' eingelesen werden kann. Verschiedene PHYSICA-Makros * +c* (.PCM-files) ermoeglichen dann die Darstellung dieser statistischen * +c* Groessen in Form von 2D- und 3D-Graphiken. (z.B. Abhaengigkeit der Trans- * +c* mission von HV-Settings des Transportsystems). * +c* Die momentan vorhandenen Routinen heissen * +c* * +c* MUINIT.PCM * +c* HELP.PCM * +c* MUPLOT_1DIM.PCM * +c* MUPLOT_2DIM.PCM * +c* TYPE_LOGHEADER.PCM * +c* TYPE_PARAMS_GRAPHIC.PCM * +c* TYPE_PARAMS_TEXT.PCM * +c* * +c* Nach dem Start (von dem Directory aus, in dem obige Routinen abgelegt sind)* +c* muss PHYSICA mit dem Befehl '@MUINIT' initialisiert werden. Danach koennen * +c* obige Routinen ueber Aliasse angesprochen werden. Weitere Informationen * +c* hierzu erhaelt man, indem man in PHYSICA nach der Initialisierung 'MUHELP' * +c* eingibt. * +c* Der Sourcecode fuer Mutrack ist ueber verschiedene .FOR-Dateien verteilt, * +c* die jeweils zu einem Problembereich gehoerige Subroutinen enthalten. Die * +c* zur Zeit vorhandenen Files und die darin enthaltenen Routinen sind: +c* +c* MUTRACK.FOR +c* SUB_ARTLIST.FOR +c* SUB_OUTPUT.FOR +c* SUB_INPUT.FOR +c* SUB_INTEGR_FO.FOR +c* SUB_INTEGR_L1.FOR +c* SUB_INTEGR_L3.FOR +c* SUB_INTEGR_M2.FOR +c* SUB_PICTURE.FOR +c* SUB_TRIGGER.FOR +c* +c* +c* Includefiles mit COMMON-Blöcken: +c* +c* COM_DIRS.INC +c* COM_KAMMER.INC +c* COM_LUNS.INC +c* COM_MUTRACK.INC +c* COM_OUTPUT.INC +c* COM_TD_EXT.INC +c* COM_TD_INT.INC +c* COM_WINKEL.INC +c* GEO_KAMMER.INPUT +c* GEO_TRIGGER.INC +c* +c* +c* Icludefile mit Defaultwerten fuer eine Reihe benutzerdefinierbarer und Programm- +c* interner Groessen: +c* +c* INITIALIZE.INC +c* +c* +c* Includefiles fuer die Potentialmappen: +c* +c* MAP_DEF_FO.INC +c* MAP_DEF_L1.INC +c* MAP_DEF_L3.INC +c* MAP_DEF_M2.INC +c* +c* READ_MAP.INC +c* +c* +c* Benoetigte Eingabfiles: +c* +c* MUTRACK.INPUT (fuer die Integrationen zu verwendende Einstellungen) +c* kammer_geo.INPUT (Spezifizierung der Kammergeometrie) +c* mappenName.INFO (Dateien mit Angaben ueber zugehoerige Potentialmappen) +c* mappenName.MAPPE (die Potentialmappen) +c* MUTRACK_NR.DAT (zuletzt vergebene Nummern der Ausgabedateien, wird +c* von Mutrack verwaltet). +c* +c* +c* Fuer die Erstellung der Potentialmappen mit dem Triumf-Programm stehen folgende +c* Hilfsmittel zur Verfuegung: +c* +c* BESCHL-INIT.FOR +c* LENSE-INIT.FOR +c* +c* Diese Boundary-Routinen stellen folgende Moeglichkeiten zur Verfuegung: +c* +c* Initialisierung von Scratch, von 2D und von 3D-Mappen. Kontrollmoeglichkeiten +c* ueber die Ausgabe der Potentialbereiche. +c* +c* Die Mappen koennen von PHYSICA aus mittels der FORTRAN-Routine ' ' +c* und den .PCM-Makros ' ' ... angeschaut und ausgegeben werden. +c* +c* +c* +c* Liste der moeglichen Ausgabefiles: +c* +c* MU_nnnn.LOG +c* MU_nnnn.GEO +c* MU_nnnn.PHYSICA +c* MU_nnnn.NTP +c* MU_nnnn._tab +c* +c* Diese Version von MUTRACK enthaelt nur noch rudimentaere Anteile des ursprueng- +c* lichen Programmes von Thomas Wutzke. Hauptunterschiede und Erweiterungen sind: +c* +c* # Ersetzen der Euler-Integration durch ein schrittweitenkontrolliertes +c* Runge-Kutta Verfahren. Der dieser Implementation zugrundeliegende Algo- +c* rythmus entstammt dabei dem Buch 'NUMERICAL RECIPES, The Art of Scientific +c* Computing' (Fortran Version) von Press, Flannery, Teukolsky und Vetterling, +c* Cambridge University Press (1989). +c* +c* # Verbesserter Algorythmus zur Berechnung der Feldstaerken aus den Potential- +c* Mappen. +c* +c* # Implementierung des gesamten Statistikaparates. (Zuvor waren PAW-Ntupel die +c* einzige Ausgabeform abgesehen von den Debuginformationen). +c* +c* # Uebersichtlichere Gestalltung der Ein- und Ausgabe, sowie der Debug-Infos. +c* +c* # Implementierung der Moeglichkeit, verschiedenen Parameter in Schleifen zu +c* durchlaufen. +c* +c* # Implementierung der fuer die graphische Darstellung mit PHYSICA notwendigen +c* Routinen. +c* +c* # Implementierung des Triggerdetektors. +c* +c* # Implementierung der Graphikausgabe der Teilchenbahnen (diese Routinen wurden +c* in ihrer ersten Fassung von Michael Birke geschrieben). +c* +c* # Umstellen der Potentialmappen auf 'unformattiert' und Einschraenken der +c* Mappen auf den wirklich benoetigten Bereich (d.h. z.B. Ausnutzen der +c* Symmetrie der Linsen, wodurch die Mappengroesse bei den Linsen mehr als +c* halbiert werden konnte. +c* +c* # Implementierung der Moeglichkeit, die Kammergeometrie (d.h. die Positionen +c* der verwendeten Elemente) sowie die Potentialmappen (z.B. fuer unter- +c* schiedliche Linsenkonfigurationen) ueber ein .INPUT-Eingabefile ohne +c* Umschreiben des Sourcecodes aendern zu koennen. +c* +c* Das Programm verwendet fuer Graphikdarstellung und NTupel-Erzeugung Routinen der +c* zum PAW-Komplex gehoerenden CERN-Bibliotheken 'HPLOT' und 'HBOOK'. +c* +c* Am Anfang der Deatei 'COM_MUTRACK.INC' findet sich eine Liste der wichtigsten +c* Aenderungen ueber die verschiedenen Versionen ab 1.4.1. +c* +c* Gruss, Anselm Hofer +c****************************************************************************** +c + +C =============== + program MUTRACK +C =============== + +c Deklarationen: + + Implicit None + + INCLUDE 'com_mutrack.inc' + INCLUDE 'com_dirs.inc' + INCLUDE 'com_td_ext.inc' + INCLUDE 'com_winkel.inc' + INCLUDE 'com_kammer.inc' + INCLUDE 'geo_trigger.inc' + + +c die SCHLEIFENVARIABLEN fuer die 'do 200 ...'-Schleifenund und damit +c zusammenhaengendes (Common-Bloecke werden fuer die NTupel-Ausgabe benoetigt): + +c - 'virtuelle' Flugstreckenverlaengerungen: + + real delta_L1,delta_L2 + +c - Energieverlust in der Triggerfolie und Dicke derselben: + + real E_loss + +c - Drehwinkel: +c (alfaTgt, alfaSp, alfaTD und ihre Winkelfunktionen werden in 'COM_WINKEL.INC' +c erledigt: COMMON /ANGELS/) + + real y_intersectSP ! Benoetigt fuer Schnittpkt. der Trajektorie + real yUppLeft, yLowLeft ! mit forderer Spiegelebene + + real x_intersectTD ! Benoetigt fuer Schnittpkt. der Trajektorie + ! mit TD-Folie + real x_intersectTDMap ! ... mit TD-Mappe + common /x_intersectTD/ x_intersectTD,x_intersectTDMap + +c - Masse und Ladung: + + real m, m_ ! Masse, Laufvariable fuer Massen-Schleife + real q, q_ ! Ladung, Laufvariable fuer Ladungs-Schleife + integer qInt + COMMON /charge/ qInt ! fuer 'NTP_charge' + + integer nNeutral,nCharged ! fuer Ausgabe des gewuerfelten neutralen anteils + COMMON /nNeutral/ nNeutral,nCharged + +c - MCP2: + + real U_MCP2 ! Spannung am MCP2 + + +c - Triggerdetektor: U_F, U_V, U_H und U_MCP3 werden in 'COM_TD_EXT.INC' +c erledigt. (COMMON /TRIGGERSETTINGS/) + +c - Transportsystem: + + real U_Tgt ! Target-Spannung + real U_Gua ! Spannung am Guardring + real U_G1 ! Spannung am ersten Gitter + real U_L1 ! Spannung an Linse 1 + real U_Sp ! Spiegelspannung + real U_L2 ! Spannung an Linse 2 + real U_L3 ! Spannung an Linse 3 + + COMMON /U_L2/ U_L2 ! fuer die Addition der 'L2andFo'-Mappe + + real last_U_L2 / -1.E10 / ! fuer die Addition der 'L2andFo'-Mappe + real last_U_F / -1.E10 / + +c - Magnetfeldstaerken: + + real B_Helm ! Magnetfeld der Helmholtzspulen + real B_TD ! Magnetfeld der Kompensationsspule am TD + +c - Startparameter: + + integer randomloop_ ! Laufvariable fuer zufallsverteilte Starts + real E0_ ! Laufvariable fuer Startenergie_Schleife + real theta0_ ! Laufvarialbe fuer Startwinkel-Schleife + real Sin_theta0, Cos_theta0 ! Startwinkel gegen x-Achse + real phi0_ ! Laufvariable fuer Startwinkel-Schleife + real Sin_phi0, Cos_phi0 ! azimuthaler Startwinkel (phi0=0: y-Achse) + real y0_ ! Laufvariable fuer Startpositions_Schleife + real z0_ ! Laufvariable fuer Startpositions_Schleife + real r0 ! Radius beim Wuerfeln der Startposition + real phi_r0 ! Winkel beim Wuerfeln der Startposition + + ! x0(3),v0(3),E0,theta0,phi0 werden in 'COM_MUTRACK.INC' declariert + + +c allgemeine Trajektoriengroessen + + real dt ! zeitl. Aenderung + real v_xy ! Geschwindigkeit in x/y-Ebene + real v_square, v0_Betrag, v_Betrag + real Ekin ! kinetische Energie + real a1,a2 ! Beschleunigung in 1. bzw. 2. Beschl.Stufe + real aFoil ! Beschleunigung zwischen Massegitter und Folie + real radiusQuad ! RadiusQuadrat + real radiusQuad_ ! RadiusQuadrat + real radius + + real S1xM2 ! Zeit vom Start bis zur MCP2-Ebene + real S1M2 ! Zeit vom Start bis zum MCP2 (Treffer voarausgesetzt) + real S1Fo ! Zeit vom Start bis zur Folie + real S1FoOnly ! Zeit vom Start bis zur Folie + real FoM2 ! Zeit zwischen Folie und MCP2 + real FoM2Only ! wie FoM2, falls keine anderen TOFs verlangt + real S1M3 ! Zeit vom Start bis Eintreffen der FE auf MCP3 + real M3M2 ! Zeit vom Eintreffen der FE auf MCP3 bis MCP2 + + real alfa ! Bahnwinkel gegen die Triggerfolienebene + real E_Verlust /0./ ! Energieverlust in der Folie + real delta_E_Verlust ! Streuung des Energieverlustes in der Folie + real thetaAufstreu ! Ablenkung aus vorheriger Richtung in der Folie + real phiAufstreu ! azimuthaler Winkel der Ablenkung gegenueber Horiz. + COMMON /FOLIE/ E_Verlust,thetaAufstreu,phiAufstreu + + real Beschl_Faktor ! Faktor bei Berechn. der Beschleunigung im EFeld + COMMON /BESCHL_FAKTOR/ Beschl_Faktor + + real length1 ! = d_Folie_Achse + MappenLaenge_FO + real length2 ! = xTD - d_Folie_Achse - MappenLaenge_FO ! = xTD-length1 + + +c Groessen der Folienelektronen ('FE'): + + integer nFE ! jeweilige Anzahl an FE (2 <= nFE <= 5) + real E0FE ! Startenergie der Folienelektronen + real ct0,st0,cf0,sf0 ! die Winkelfunktionen der Startwinkel der FE + real f0 ! 'phi0' fuer die FE + real x0FE(3) ! Startort der Folienelektronen auf der TD-Folie + real xFE(3),vFE(3) ! Ort und Geschw. der FE + real tFE ! Zeit + real tFE_min ! kuerzeste gueltige FE-Flugzeit je Projektil + integer tFE_(5) /-1,-1,-1,-1,-1/ ! Flugzeit jedes FE in ps (fuer NTP) +c +c---------------- +c +c-TP-10/2000 add variables to have position information of muons at +c TD and FE at MCP3 in NTuple; up to 5 electrons possible +c + real xFE_MCP(5), yFE_MCP(5), zFE_MCP(5) + common /TrigDet/ x0FE, xFE_MCP, yFE_MCP, zFE_MCP +c +c---------------- +c + COMMON /S1xM2/ S1xM2 ! fuer NTupel + COMMON /TIMES/ S1M2,S1Fo,FoM2,S1M3,M3M2,tFE_ ! fuer NTupel + common /FoM2Only/ FoM2Only + COMMON /S1FoOnly/ S1FoOnly + +c Variablen fuer den allgemeinen Programmablauf: + + integer qIndxMu + common /qIndxMu/ qIndxMu + + integer ntpid(1) ! fuer das Einlesen des NTupels von ACCEL oder von + integer ntpnr ! FoilFile + + integer firstEventNr + external firstEventNr + + logical NTPalreadyWritten + + real Spiegel_Faktor ! Faktor bei Berechn. der Reflektionszeit im Spiegel + + integer bis_Spiegel ! verschiedene Label + integer bis_L3_Mappe, bis_MCP2_Mappe, MCP2_Mappe + + character uhrzeit*8 + + integer percent_done + logical fill_NTP + + real radiusQuad_HeShield + real radiusQuad_LNShield + real radiusQuad_L1 + real radiusQuad_L2 + real radiusQuad_L3 + real radiusQuad_Blende + real radiusQuad_Rohr + real radiusQuad_MCP2 ! Radiusquadrat des MCP2 + real radiusQuad_MCP2active ! Radiusquadrat der aktiven Flaeche des MCP2 + real radiusQuad_Sp ! Radiusquadrat der Spiegeldraehte + real rWires_Sp ! Radius der Spiegeldraehte + + logical check_Blende /.false./ + + real xChangeKoord ! legt den Ort nach dem Spiegel fest, bei + parameter (xChangeKoord = 75.) ! dem das Koordinatensystem gewechselt wird + + integer n_return ! die Returnvariable fuer Aufruf von 'TD_CALC' + integer zaehler ! Zaehler fuer Monitoring der Trajektorie in den + ! Gebieten, in denen stepwise integriert werden + ! muss + logical flag, flag_ok + integer okStepsCounter + + integer i, k ! integer-Hilfsvariablen + real help1, help2 ! real-Hilfsvariablen + real help3, help4 ! real-Hilfsvariablen + + real YieldPlus,YieldNeutral ! Ladungsanteile nach TD-Foliendurchgang + + integer startLabel ! das Einsprunglabel beim Teilchenstart + + character helpChar*7, ant*1 + character HistogramTitle*32 /'Schnitt bei x = (i. Teil)'/ + +d real dtmin_L1, dtmin_Sp, dtmin_L2andFo, dtmin_FO, dtmin_L3, dtmin_M2 +d real dtmax_L1, dtmax_Sp, dtmax_L2andFo, dtmax_FO, dtmax_L3, dtmax_M2 +d real x_dtmin_L1(3), x_dtmax_L1(3), x_dtmin_FO(3), x_dtmax_FO(3) +d real x_dtmin_L2andFo(3), x_dtmax_L2andFo(3) +d real x_dtmin_L3(3), x_dtmax_L3(3), x_dtmin_M2(3), x_dtmax_M2(3) +d real x_dtmin_Sp(3), x_dtmax_Sp(3) +d +d ! /ntp_steps/ enthaelt auch 'steps' (ueber COM-MUTRACK.INC) +d COMMON /ntp_steps/ dtmin_L1, x_dtmin_L1, dtmax_L1, x_dtmax_L1, +d + dtmin_Sp, x_dtmin_Sp, dtmax_Sp, x_dtmax_Sp, +d + dtmin_L2andFo, x_dtmin_L2andFo, dtmax_L2andFo, x_dtmax_L2andFo, +d + dtmin_FO, x_dtmin_FO, dtmax_FO, x_dtmax_FO, +d + dtmin_L3, x_dtmin_L3, dtmax_L3, x_dtmax_L3, +d + dtmin_M2, x_dtmin_M2, dtmax_M2, x_dtmax_M2 + + real x40(2:3),v40(3),t40,E40 ! Speicher fuer Trajektoriengroessen bei x=40mm + COMMON /NTP_40mm/ x40,v40,t40,E40 + +cMBc logical writeTraj2File +cMBc common /writeTraj2File/ writeTraj2File + + +c Variablen fuer Test ob Draht getroffen wurde: + + real distToWire(2) + integer DrahtNr + logical WireHit + + real WireRadiusQuad_G1,WireRadiusQuad_G2 + real WireRadiusQuad_Sp + + +c Variablen fuer die Graphikausgabe: + + real xKoord(1000),xKoord_(1000) ! Koordinatenfelder fuer die + real yKoord(1000),yKoord_(1000) ! Graphikausgabe + real zKoord(1000),zKoord_(1000) ! +cMBc real tKoord(1000),tKoord_(1000) ! + integer nKoord,nKoordSave ! Anzahl der Koordinaten + +cMBc COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord,tKoord + COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord + + +c Variablen fuer HBOOK und PAW: + + integer istat ! fuer HBOOK-Fehlermeldungen + + integer HB_memsize + parameter(HB_memsize=1000000) + real memory(HB_memsize) + + common /pawc/ memory ! Der Arbeitsbereich fuer HBOOK + + +c Konstanten: + + real c ! Lichtgeschwindigkeit in mm/ns + real meanLifeTime ! mittlere Myon-Lebensdauer in ns + + parameter (c = 299.7925, meanLifeTime = 2197) + +c------------------------------------------------------------------------------- +c Konstanten und Variable fuer Berechnung der Winkelaufstreuung in Triggerfolie +c mittels Meyer-Formel (L.Meyer, phys.stat.sol. (b) 44, 253 (1971)): + + real g1, g2 ! Tabellierte Funktionen der Referenz + real effRedThick ! effektive reduzierte Dicke ('tau' der Referenz) + + +c - Parameter: + + real Z1, Z2 ! die atomaren Nummern von Projektil und Target + real a0 ! Bohrscher Radius in cm + real screeningPar ! Screeningparameter 'a' in cm fuer Teilchen der + ! Kernladungszahl Z1=1 in Kohlenstoff (Z2 = 6) + ! bei Streichung von Z1 (vgl. Referenz, S. 268) + + real r0Meyer ! r0(C) berechnet aus dem screeningParameter 'a' + ! und dem ebenfalls bei Meyer angegebenem + ! Verhaeltnis a/r0=0.26 (vgl. Referenz, S. 263 oben) + real eSquare ! elektrische Ladung zum Quadrat in keV*cm + real HWHM2sigma ! Umrechnungsfaktor von (halber!) Halbwertsbreite + ! nach Sigma der Gaussfunktion + + real Na ! die Avogadrokonstante + real mMolC ! molare Masse von C in ug + real Pi ! die Kreiszahl + + parameter (Z1 = 1, Z2 = 6, a0 = 5.29E-9, ScreeningPar = 2.5764E-9) + parameter (r0Meyer = 9.909E-9, eSquare = 1.44E-10, HWHM2sigma = 1./1.17741) + parameter (Na = 6.022e23, mMolC = 12.011e6, Pi = 3.141592654) + + +c - Bei der Berechnung von Sigma auftretende Vorfaktoren. +c (Meyer_faktor 1 wird benoetigt fuer Berechnung der reduzierten Dicke aus der +c 'ug/cm2'-Angabe der Foliendicke. Meyer_faktor2 und Meyer_faktor3 werden +c direkt fuer die Berechnung von sigma aus den beiden tabellierten Funktionen +c g1 und g2 verwendet): + + real Meyer_Faktor1, Meyer_Faktor2, Meyer_Faktor3 + + parameter (Meyer_faktor1 = Pi*screeningPar*screeningPar * Na/mMolC) + ! Na/mMolC = 1/m(C-Atom) + parameter (Meyer_faktor2 = (2*Z1*Z2 * eSquare)/ScreeningPar * 180./Pi + + * HWHM2sigma) + parameter (Meyer_faktor3 = (screeningPar/r0Meyer) * (screeningPar/r0Meyer)) + + +c------------------------------------------------------------------------------- +c Kommentar zur Berechnung der Winkelaufstreuung nach Meyer: +c +c Als Bedingung fuer die Gueltigkeit der Rechnung wird verlangt, dass +c +c (1) die Anzahl n der Stoesse >> 20*(a/r0)^(4/3) sein muss. Fuer Protonen auf +c Graphit ist laut Referenz a/r0 gleich 0.26 (mit Dichte von 3.5 g/ccm habe +c ich einen Wert von 0.29 abgeschaetzt). Fuer Myonen hat man den selben +c Wert zu nehmen. Damit ergibt sich die Forderung, dass n >> 3.5 sein muss. +c +c (2) unabhaengig von (1) n >> 5 sein muss, was (1) also mit einschliesst. +c +c Mit n = Pi*r0*r0*Teilchen/Flaeche ergibt sich fuer eine Foliendicke von +c 3 ug/cm^2 als Abschaetzung fuer n ein Wert von 37. (r0 ueber r0 = 0.5 N^(1/3) +c und 3.5 g/ccm zu 8.9e-9 cm abgeschaetzt). D.h., dass die Bedingungen in +c unserem Fall gut erfuellt sind. +c In dem Paper wird eine Formel fuer Halbwertsbreiten angegeben. Ich habe nicht +c kontrolliert, in wie weit die Form der Verteilung tatsaechlich einer Gauss- +c verteilung entspricht. Zumindest im Bereich der Vorwaertsstreuung sollte +c die in diesem Programm verwendete Gaussverteilung aber eine sehr gute +c Naeherung abgeben. Abweichungen bei groesseren Winkeln koennten jedoch u. U. +c die absolute Streuintensitaet in Vorwaertsrichtung verfaelschen. + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c HIER GEHT DER PROGRAMMTEXT RICHTIG LOS +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + +c Initialisierungen: + + INCLUDE 'initialize.inc' + + +c Einlesen der Parameter aus 'MUTRACK.INPUT' und Setzen der entsprechenden +c Voreinstellungen. Einlesen der Kammergeometrie sowie der INFO-files der +c Feldmappen: + + call read_inputFile + + +c Berechnen der RadiusQuadrate: + + radiusQuad_HeShield = rHeShield*rHeShield + radiusQuad_LNShield = rLNShield*rLNShield + radiusQuad_Rohr = radius_Rohr*radius_Rohr + radiusQuad_L1 = iRadiusCyl_L1*iRadiusCyl_L1 + radiusQuad_L2 = iRadiusCyl_L2*iRadiusCyl_L2 + radiusQuad_L3 = iRadiusCyl_L3*iRadiusCyl_L3 + radiusQuad_Blende = radius_Blende*radius_Blende + radiusQuad_MCP2 = radius_MCP2*radius_MCP2 + radiusQuad_MCP2active = radius_MCP2active*radius_MCP2active + WireRadiusQuad_G1 = dWires_G1/2. * dWires_G1/2. + WireRadiusQuad_G2 = dWires_G2/2. * dWires_G2/2. + WireRadiusQuad_Sp = dWires_Sp/2. * dWires_Sp/2. + rWires_Sp = dWires_Sp/2. + radiusQuad_Sp = rWires_Sp * rWires_Sp + + +c Einlesen der Feldmappen: + + write(*,*)'----------------------------------------'// + + '----------------------------------------' + if (.NOT.(par(1,UL1).EQ.0. .AND. n_par(UL1).LE.1)) call READ_MAP_L1 + + if (.NOT.(idealMirror .OR. (par(1,USp).EQ.0. .AND. n_par(USp).LE.1))) then + call read_Map_SP_1 + call read_Map_SP_2 + call read_Map_SP_3 + endif + + if (TriggerInBeam .AND. .NOT.lense2 .AND. + ! 'lense2' muss noch in sub_input richtig gesetzt werden! (-> foilfile) + + .NOT.(par(1,UFolie).EQ.0. .AND. n_par(UFolie).LE.1) ) then + call READ_MAP_FO + endif + + if (.NOT.(par(1,UL3).EQ.0. .AND. n_par(UL3).LE.1)) then + if (.NOT.(par(1,UMCP2).EQ.0. .AND. n_par(UMCP2).LE.1)) then + if (xLeaveMap_L3.GT.xEnterMap_M2) then + write(*,*) + write(*,*)' Potentialmappen von Linse 3 und MCP2 ueberlappen!' + write(*,*)' Dies ist in der aktuellen Implementierung des Programmes' + write(*,*)' nicht vorgesehen!' + write(*,*) + write(*,*)' -> STOP' + write(*,*) + STOP + endif + endif + call READ_MAP_L3 + endif + + if (.NOT.(par(1,UMCP2).EQ.0. .AND. n_par(UMCP2).LE.1)) call READ_MAP_M2 + + +c Eingelesene Simulationsparameter auf Schirm geben und bestaetigen lassen. +c Die Ausgabefiles initialisieren: + + call initialize_output + + +c falls ein 'FoilFile' erstellt werden soll, schreibe das .INFO-files: + + if (createFoilFile) call make_INFOFile + if (Use_MUTRACK) Use_ACCEL = .false. + + +c Defaultwert fuer 'fill_NTP' setzen (wird weiter unten ueberschrieben, falls +c fuer das Fuellen des NTupels spezielle Triggerbedingung verlangt ist): + + if (createNTP) then + fill_NTP = .true. + else + fill_NTP = .false. + endif + + +c CERN-Pakete initialisieren (Groesse des COMMONblocks PAWC uebermitteln): + + if (.NOT.fromScratch.OR.Graphics.OR.createNTP.OR.createFoilFile) call HLIMIT(HB_memsize) + + +c Graphikausgabe initialisieren: + + if (GRAPHICS) then + call masstab_setzen + CALL HPLSET ('VSIZ',.6) ! AXIS VALUES SIZE + write(HistogramTitle(17:22),'(F6.1)') schnitt_x + write(HistogramTitle(25:25),'(I1)') schnitt_p + CALL HPLSET ('TSIZ',.7) ! HISTOGRAM TITLE SIZE + CALL HBOOK2 (50,HistogramTitle,100,-30.,30.,100,-30.,30.,20.) + endif + + +c falls fruehere Simulation fortgefuehrt werden soll, oeffne entsprechende Datei: + + if (.NOT.fromScratch) then + if (use_ACCEL) then + call HROPEN(lunREAD,'ACCEL',ACCEL_Dir//':'//fileName_ACCEL//'.NTP', + + ' ',1024,istat) + else + call HROPEN(lunREAD,'MUread',outDir//':'//fileName_MUTRACK//'.NTP', + + ' ',1024,istat) + endif + + call HRIN(0,99999,0) + call HIDALL(ntpid,ntpNr) + call HDELET(ntpid(1)) + i = NTP_read - ntpid(1) + call HRIN(NTP_read-i,9999,i) ! NTP_read = NTP_write+1 + call HBNAME(NTP_read,' ',0,'$CLEAR') ! alles resetten + + ! fuer die benoetigten Bloecke des CWN die entsprechenden Speicher- + ! lokalisationen uebermitteln: + + if (random_E0) call HBNAME(NTP_read,'E0',E0,'$SET') + if (random_pos) call HBNAME(NTP_read,'x0',x0,'$SET') + if (random_angle) call HBNAME(NTP_read,'angle0',theta0,'$SET') ! theta0,phi0 + if (UseDecay_prevSim) call HBNAME(NTP_read,'lifetime',lifetime,'$SET') + + if (smearS1Fo .AND. use_MUTRACK) then + call HBNAME(NTP_read,'S1FoS',S1FoOnly,'$SET') + endif + + call HBNAME(NTP_read,'dest',gebiet,'$SET') ! gebiet,destiny + call HBNAME(NTP_read,'Traj',t,'$SET') ! t,x,v + + endif + + +c NTP-relevante Befehle: + +c BAD LUCK!!! Das Packen der Real-Variablen im folgenden hat KEINERLEI VER- +c KLEINERUNG DER FILEGROESSE bewirkt!!!! (fuer die Integers habe ich noch +c keinen Test gemacht). -> wohl besser wieder herausnehmen. Ich verliere +c u.U. nur Genauigkeit und habe nur einen eingeschraenkten Wertebereich zur +c Verfuegung! + + if (createNtp.OR.createFoilFile) then + + !c Datei fuer NTupelausgabe oeffnen: + call HROPEN(lunNTP,'MUwrite',outDir//':'//filename//'.NTP', + + 'N',1024,istat) + if (istat.NE.0) then + write(*,*) + write(*,*)'error ',istat,' opening HBOOK-file' + write(*,*) + STOP + endif + + call HBNT(NTP_write,filename,'D') ! D: Disk resident CWN buchen + + !c die Bloecke des CWN definieren: + + if (.NOT.OneLoop) call HBNAME(NTP_write,'LOOP',schleifenNr,'loop[1,1000]:u') + if (M2_triggered .OR. Fo_triggered.AND.upToTDFoilOnly) then + ! -> Gebiet und Destiny stehen hier sowieso fest, nimm + ! diese Groessen daher erst gar nicht mehr in das NTupel auf! + else + call HBNAME(NTP_write,'DEST',gebiet,'Gebiet[0,20]:u,dest[-10,10]:i') + endif + if (NTP_Start .OR. createFoilFile.AND.random_pos) then + call HBNAME(NTP_write,'X0',x0,'x0,y0,z0') + endif + if (NTP_Start) call HBNAME(NTP_write,'V0',v0,'vx0,vy0,vz0') + if (NTP_Start .OR. createFoilFile.AND.random_E0) then + call HBNAME(NTP_write,'E0',E0,'E0') + endif + if (NTP_Start .OR. createFoilFile.AND.random_angle) then + call HBNAME(NTP_write,'ANGLE0',theta0,'theta0,phi0') + endif + if (NTP_lifetime .OR. createFoilFile.AND.UseDecay) then + call HBNAME(NTP_write,'LIFETIME',lifetime,'lifetime:r') + endif + if (NTP_40mm) call HBNAME(NTP_write,'X=40MM',x40, + + 'y40,z40,vx40,vy40,vz40,t40,E40') + if (NTP_S1xM2) call HBNAME(NTP_write,'S1xM2',S1xM2,'S1xM2') + if (NTP_Times) then + if (TriggerInBeam) then + if (generate_FE) then + call HBNAME(NTP_write,'TIMES',S1M2, + + 'S1M2,S1Fo,FoM2,S1M3,M3M2:r,TFE(5):i') + else + call HBNAME(NTP_write,'TIMES',S1M2, + + 'S1M2,S1Fo,FoM2') + endif + else + call HBNAME(NTP_write,'TIMES',S1M2, + + 'S1M2') + endif + endif + if (NTP_FoM2Only) then + call HBNAME(NTP_write,'FoM2',FoM2Only,'FoM2') + endif + if (NTP_Folie) then + call HBNAME(NTP_write,'FOLIE',E_Verlust, + + 'ELoss,thetStreu,phiStreu') +c +c-------------------------- +c +c-TP-10/2000 add position at foil and MCP3 (FE) +c + call HBNAME(NTP_write, 'TrigDet', x0FE, + + 'x0FE,y0FE,z0FE,xFE(5),yFE(5),zFE(5)') +c +c-------------------------- +c + endif + if (NTP_charge) call HBNAME(NTP_write,'CHARGE',qInt,'q[-5,5]:i') + if (NTP_stop.OR.createFoilFile) then + call HBNAME(NTP_write,'TRAJ',t,'t,x,y,z,vx,vy,vz') + endif +c if (createFoilFile .AND. smearS1Fo .AND. .NOT.NTP_times) then + if (smearS1Fo) then + call HBNAME(NTP_write,'S1FoS',S1FoOnly,'S1FoS') + endif + if (NTP_stop) then + call HBNAME(NTP_write,'EKIN',Ekin,'Ekin') + endif +d if (NTP_steps) then +d call HBNAME(NTP_write,'STEP',steps,'steps[1,100000]:u,'// +d + 'dtminL1, xdtminL1, ydtminL1, zdtminL1,'// +d + 'dtmaxL1, xdtmaxL1, ydtmaxL1, zdtmaxL1,'// +d + 'dtminL2, xdtminL2, ydtminL2, zdtminL2,'// +d + 'dtmaxL2, xdtmaxL2, ydtmaxL2, zdtmaxL2,'// +d + 'dtminFO, xdtminFO, ydtminFO, zdtminFO,'// +d + 'dtmaxFO, xdtmaxFO, ydtmaxFO, zdtmaxFO,'// +d + 'dtminL3, xdtminL3, ydtminL3, zdtminL3,'// +d + 'dtmaxL3, xdtmaxL3, ydtmaxL3, zdtmaxL3,'// +d + 'dtminM2, xdtminM2, ydtminM2, zdtminM2,'// +d + 'dtmaxM2, xdtmaxM2, ydtmaxM2, zdtmaxM2') +d endif + endif + + +c die Label definieren: + + assign 7 to bis_Spiegel + assign 14 to bis_L3_Mappe + assign 16 to bis_MCP2_Mappe + assign 17 to MCP2_Mappe + + +c die Einsprungposition fuer den Beginn der Trajektorienberechnungen setzen: + + if (Use_MUTRACK) then + assign 113 to startLabel + elseif (Use_ACCEL) then + assign 3 to startLabel + elseif (Gebiet0.EQ.target .OR. Gebiet0.EQ.upToGrid1) then + assign 1 to startLabel + elseif (Gebiet0.EQ.upToGrid2) then + assign 2 to startLabel + elseif (Gebiet0.EQ.upToHeShield) then + assign 3 to startLabel + elseif (Gebiet0.EQ.upToLNShield) then + assign 4 to startLabel + elseif (Gebiet0.EQ.upToL1Map) then + assign 5 to startLabel + elseif (Gebiet0.EQ.upToExL1) then + assign 6 to startLabel + elseif (Gebiet0.EQ.upToEnSp) then + assign 7 to startLabel + elseif (Gebiet0.EQ.upToExSp) then + assign 8 to startLabel + elseif (Gebiet0.EQ.upToChKoord) then + assign 9 to startLabel + elseif (Gebiet0.EQ.upToEnTD) then + assign 10 to startLabel + elseif (Gebiet0.EQ.upToExTD) then + if (log_alpha0_KS) then + assign 111 to startLabel + else + assign 112 to startLabel + endif + elseif (Gebiet0.EQ.upToL2andFoMap) then +c assign 12 to startLabel + elseif (Gebiet0.EQ.upToExL2) then +c assign 13 to startLabel + elseif (Gebiet0.EQ.upToL3Map) then + assign 12 to startLabel + elseif (Gebiet0.EQ.upToExL3) then + assign 13 to startLabel + elseif (Gebiet0.EQ.upToM2Map) then + assign 14 to startLabel + elseif (Gebiet0.EQ.upToMCP2) then + assign 15 to startLabel + endif + + +c Abkuerzungen 'Length1' und 'length2' setzen: + + length1 = d_Folie_Achse + MappenLaenge_FO + length2 = xTD - d_Folie_Achse - MappenLaenge_FO + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c ab hier beginnen die Schleifen: +c (Bemerkung: eine Laufvariable darf kein Feldelement sein!) +c +c Besonderheit der Massen- und der Ladungsschleife: +c Wurde im INPUT-File in der Variablen 'artList' eine Teilchenart spezifi- +c ziert (-> 'artList_defined'), so werden die Parameter Masse und Ladung nicht +c entsprechend den Inhalten von par(n,mass) bzw. par(n,charge) eingestellt, +c sondern entsprechend den zu den Teilchenarten gehoerenden Werten fuer diese +c Groessen. In diesem Fall besteht die Massenschleife aus genau einem (Leer-) +c Durchlauf, waehrend die Ladungsschleife fuer jede Teilchenart einen Durchlauf +c macht, in welcher dann die Einstellung von Ladung UND Masse stattfindet. +c +c Bei Aenderungen in der Abfolge der Schleifen muss die Anweisungszeile +c 'DATA reihenfolge /.../' in 'INITIALIZE.INC' entsprechend editiert werden! +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c zusaetliche Flugstrecken vor TD und MCP2 (gehen NUR in t, NICHT in x ein!!): +c ---------------------------------------------------------------------------- + + do 200 Delta_L1 = par(1,DeltaL1),par(2,DeltaL1),par(3,DeltaL1) + parWert(DeltaL1) = Delta_L1 + do 200 Delta_L2 = par(1,DeltaL2),par(2,DeltaL2),par(3,DeltaL2) + parWert(DeltaL2) = Delta_L2 + +c Foliendicke und Energieverlust: +c ------------------------------- + + do 200 E_loss = par(1,Eloss),par(2,Eloss),par(3,Eloss) ! Eloss + parWert(Eloss) = E_loss + mean_E_Verlust = E_loss + + do 200 Thickness = par(1,Thickn),par(2,Thickn),par(3,Thickn)! Thickness + parWert(Thickn) = Thickness + +c MCP2: +c ----- + + do 200 U_MCP2 = par(1,UMCP2),par(2,UMCP2),par(3,UMCP2) ! U(MCP2) + parWert(UMCP2) = U_MCP2 + +c Winkel: +c ------- + + do 200 alfaTgt = par(1,alfTgt),par(2,alfTgt),par(3,alfTgt) ! ALPHA(TARGET) + parWert(alfTgt) = alfaTgt + Sin_alfaTgt= sind(alfaTgt) + Cos_alfaTgt= cosd(alfaTgt) + + do 200 alfaSp = par(1,alfSp),par(2,alfSp),par(3,alfSp) ! ALPHA(SPIEGEL) + parWert(alfSp) = alfaSp + Sin_alfaSp = sind(alfaSp) + Cos_alfaSp = cosd(alfaSp) + Tan_alfaSp = tand(alfaSp) + help1 = dSpiegel/2.+DreharmLaenge + ! Berechne die y-Werte der 'oberen linken' (yUppLeft) und der + ! 'unteren linken' (yLowLeft) Spiegelecke: + if (idealMirror) then + yUppLeft = + bSpiegel/2. * Sin_alfaSp + + + help1 * Cos_alfaSp + yLowLeft = - bSpiegel/2. * Sin_alfaSp + + + help1 * Cos_alfaSp + endif + ! Berechne Schnittpunkt y_intersectSp der vorderen Spiegelebene bzw. + ! der vorderen Mappenkante mit der Geraden x = xSpiegel: + if (.NOT.idealMirror) help1 = help1 + xSpGrid1 + y_intersectSp = help1/Cos_alfaSp + + do 200 alfaTD = par(1,alfTD),par(2,alfTD),par(3,alfTD) ! ALPHA(TRIGGERDETEKTOR) + parWert(alfTD) = alfaTD + Sin_alfaTD = sind(alfaTD) + Cos_alfaTD = cosd(alfaTD) + Tan_alfaTD = tand(alfaTD) + ! Berechne Schnittpunkt 'x_intersectTD' der x-Achse mit der Folien- + ! ebene bzw im Fall von 'GridInFrontOfFoil' mit dem Gitter vor der + ! Triggerfolie: + help1 = d_Folie_Achse + if (gridInFrontOfFoil) help1 = help1 + d_Grid_Folie + x_intersectTD = xTD - help1/Cos_alfaTD + help1 = d_Folie_Achse + mappenLaenge_Fo + x_intersectTDMap = xTD - help1/Cos_alfaTD + +c TriggerDetektor: +c ---------------- + + do 200 U_V = par(1,UVorne),par(2,UVorne),par(3,UVorne) ! U(VORNE) + parWert(UVorne) = U_V + do 200 U_H = par(1,UHinten),par(2,UHinten),par(3,UHinten) ! U(HINTEN) + parWert(UHinten) = U_H + do 200 U_MCP3 = par(1,UMCP3),par(2,UMCP3),par(3,UMCP3) ! U(MCP3) + parWert(UMCP3) = U_MCP3 + do 200 U_F = par(1,UFolie),par(2,UFolie),par(3,UFolie) ! U(FOLIE) + parWert(UFolie) = U_F + +c Transportsystem: +c ---------------- + + do 200 U_L2 = par(1,UL2),par(2,UL2),par(3,UL2) ! U(Linse 2) + parWert(UL2) = U_L2 + +c gegebenenfalls die Mappe 'L2andFo' zusammenbauen: + if (lense2) then + if ( .NOT.(par(1,UL2).EQ.0. .AND. n_par(UL2).LE.1) .OR. + + .NOT.(par(1,UFolie).EQ.0. .AND. n_par(UFolie).LE.1) ) then + ! Addiere die Mappen nur erneut, falls die jetztige Konfiguration + ! nicht mit der letzten uebereinstimmt: + if (U_L2.NE.last_U_L2 .OR. U_F.NE.last_U_F) then + call ADD_MAP_L2andFo + last_U_L2 = U_L2 + last_U_F = U_F + endif + endif + endif + + do 200 U_Sp = par(1,USp),par(2,USp),par(3,USp) ! U(SPIEGEL) + parWert(USp) = U_Sp + + do 200 U_L1 = par(1,UL1),par(2,UL1),par(3,UL1) ! U(Linse 1) + parWert(UL1) = U_L1 + + do 200 U_L3 = par(1,UL3),par(2,UL3),par(3,UL3) ! U(Linse 3) + parWert(UL3) = U_L3 + +c die Magnetfelder: +c ----------------- + + do 200 B_Helm = par(1,BHelm),par(2,BHelm),par(3,BHelm) ! Helmholtzsp. + parWert(BHelm) = B_Helm + + do 200 B_TD = par(1,BTD),par(2,BTD),par(3,BTD) ! TD-Spule + parWert(BTD) = B_TD + +c Masse und Ladung: +c ----------------- + + do 200 m_ = par(1,mass),par(2,mass),par(3,mass) ! MASSE + if (.NOT.artList_defined) then + m = m_ + parWert(mass) = m + endif + + do 200 q_ = par(1,charge),par(2,charge),par(3,charge) ! LADUNG + if (.NOT.artList_defined) then + q = q_ + parWert(charge) = q + else + qIndxMu = q_ ! fuer Verwendung in function firstEventNr! + ArtNr = Art_Nr(q_) + m = Art_Masse(ArtNr) + q = Art_Ladung(ArtNr) + parWert(mass) = m + parWert(charge) = q + endif + ! gegebenenfalls ein Flag fuer die Beruecksichtigung des Myonen- + ! zerfalles setzen: + if (useDecay) then ! 'useDecay' setzt 'artList_defined' voraus + if (ArtNr.LE.4) then! es ist ein Myon involviert + useDecay_ = .true. + else ! kein Myon involviert + useDecay_ = .false. + endif + endif + + +c Beschleuniger: +c -------------- + + do 200 U_Tgt = par(1,UTgt),par(2,UTgt),par(3,UTgt) ! U(TARGET) + parWert(UTgt) = U_Tgt + do 200 U_Gua = par(1,UGua),par(2,UGua),par(3,UGua) ! U(GUARD) + parWert(UGua) = U_Gua + do 200 U_G1 = par(1,UG1),par(2,UG1),par(3,UG1) ! U(GITTER) + parWert(UG1) = U_G1 + parIndx(5) = parIndx(5) + 1 + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c haeufig benoetigte Faktoren, die von der aktuellen Masse, Ladung und Hoch- +c spannungen abhaengen: +c (bei Linse 2 wird die Spannung direkt auf die Potentialmappe aufmultipliziert. +c Daher wird dort 'Beschl_Faktor' verwendet und kein 'Beschl_Faktor_L2' benoetigt) + + Energie_Faktor = m / (2.*c*c) + Beschl_Faktor = q / m * c*c + Beschl_Faktor_L1 = Beschl_Faktor * U_L1 + Beschl_Faktor_Sp = Beschl_Faktor * U_Sp + Beschl_Faktor_FO = Beschl_Faktor * U_F + Beschl_Faktor_L3 = Beschl_Faktor * U_L3 + Beschl_Faktor_M2 = Beschl_Faktor * U_MCP2 + + aFoil = - Beschl_Faktor * U_F / d_Grid_Folie + if (U_Sp.EQ.0. .OR. q.EQ.0.) then + Spiegel_Faktor = 0 + else + Spiegel_Faktor = 2.*dspiegel / (Beschl_Faktor * U_Sp) !<-- pruefen! + endif + + ! Die Beschleunigungen in den beiden (idealen) Beschleunigerstufen: + a1 = Beschl_Faktor * (U_Tgt - U_G1) / (XGrid1 - XTarget) + a2 = Beschl_Faktor * U_G1 / (XGrid2 - xGrid1) + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Falls 'fromScratch': +c Die in den ab hier beginnenden Startparameter-Schleifen gesetzten Werte +c werden gegebenenfalls weiter unten durch zufallsverteilte Offsets modi- +c fiziert. (-> 'Zufallschleife': 'do 100 randomloop_ = 1, n_par(0)) +c Andernfalls: +c Wurden waehrend ACCEL oder 'foilfile' fuer die Startparameter Zufalls- +c verteilungen verwendet, so werden die entsprechenden Groessen aus dem +c betreffenden NTupel eingelesen. +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Startparameter: +c --------------- + + do 200 E0_ = par(1,ener),par(2,ener),par(3,ener) ! E0 + if (.NOT.random_E0) then + E0 = E0_ + v0_Betrag = sqrt(E0/Energie_Faktor) + endif + + if (E0InterFromFile) then + lowerE0 = E0Low(nInt(E0_)) + upperE0 = E0Low(nint(E0_+1)) + endif + + +c falls Energieverlustberechnung aus ICRU-Tabelle verlangt ist und mittlerer +c Energieverlust nicht fuer jedes Teilchen extra berechnet werden soll (sinnvoll +c wenn alle Teilchen gleiche Startenergie haben oder Streuung der Startenergien +c klein ist, so dass die Streuung des mittleren Energieverlustes vernachlaessigt +c werden kann): + + if (log_E_Verlust_ICRU .AND. .NOT.calculate_each) then + if (random_E0_equal) then + Ekin = E0_ + (upperE0+lowerE0)/2. + else + Ekin = E0_ + endif + if (Gebiet0.EQ.target .OR. Gebiet0.EQ.upToGrid1) then + Ekin = Ekin + q*(U_Tgt - U_F) + elseif (Gebiet0.EQ.upToGrid2) then + Ekin = Ekin + q*(U_G1 - U_F) + endif + call CALC_ELOSS_ICRU(Ekin,q,m,Thickness,mean_E_Verlust) + endif + + if (log_Meyer_F_Function) then + if (random_E0_equal) then + Ekin = E0_ + (upperE0+lowerE0)/2. + else + Ekin = E0_ + endif + if (Gebiet0.EQ.target .OR. Gebiet0.EQ.upToGrid1) then + Ekin = Ekin + q*(U_Tgt - U_F) + elseif (Gebiet0.EQ.upToGrid2) then + Ekin = Ekin + q*(U_G1 - U_F) + endif + effRedThick = Meyer_Faktor1 * Thickness + call Get_F_Function_Meyer(effRedThick,Ekin) + endif + + do 200 theta0_ = par(1,thetAng),par(2,thetAng),par(3,thetAng) ! theta0 + if (.NOT.random_angle) then + theta0 = theta0_ + Cos_theta0 = cosd(theta0) + Sin_theta0 = sind(theta0) + endif + do 200 phi0_ = par(1,phiAng),par(2,phiAng),par(3,phiAng) ! phi0 + if (.NOT.random_angle) then + phi0 = phi0_ + Cos_phi0 = cosd(phi0) + Sin_phi0 = sind(phi0) + endif + + do 200 y0_ = par(1,yPos),par(2,yPos),par(3,yPos) ! y0 + if (.NOT.random_pos) then + x0(2) = y0_ + endif + + do 200 z0_ = par(1,zPos),par(2,zPos),par(3,zPos) ! z0 + if (.NOT.random_pos) then + x0(3) = z0_ + endif + +c die folgenden parWert(n) werden u.U. in der 'Zufallsschleife' weiter unten +c abgeaendert. Hier werden sie in jedem Fall fuer Tabellenausgaben, Debug- +c angelegenheiten u.s.w. erst einmal mit den aktuellen Werten der +c entsprechenden Schleifen gefuellt: + + parWert(ener) = E0_ + parWert(thetAng) = theta0_ + parWert(phiAng) = phi0_ + parWert(yPos) = y0_ + parWert(zPos) = z0_ + + +c falls fruehere Simulation fortgefuehrt wird: +c Berechne diejenige Eventnummer in NTP_read, ab welcher die relevanten +c Simulationsparameter von ACCEL bzw. des 'FoilFiles' mit den gegenwaertigen +c MUTRACK-(Schleifen)-Parametern uebereinstimmen: + + if (.NOT.fromScratch) eventNr = firstEventNr() + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Hier folgen die Befehle, die zu Beginn jeder neuen Schleife faellig sind: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + SchleifenNr = SchleifenNr + 1 ! Schleifen zaehlen + okStepsCounter = 0 ! 'okStepsCounter' dient der Bestimmung + ! der mittleren Anzahl von Integrations- + ! schritten bis zum Ziel + nNeutral = 0 ! noch wurden keine Teilchen in der TD-Folie + nCharged = 0 ! neutralisiert + +c Die Statistikspeicher resetten: +c Falls nur ein Teilchenstart pro Schleife erfolgt, nimm die Statistik ueber +c alle Schleifen. (Dann erfolgt der Reset nur bei der ersten Schleife): + + flag_ok = (.NOT.(OneStartPerLoop .AND. SchleifenNr.GT.1)) + + if (flag_ok) call reset_statistics + + +c Die Kammer zeichnen: +c Wird pro Schleife nur ein Teilchen gestartet ('OneStartPerLoop'; d.h. kein +c oder genau ein 'Zufallsstart'), so trage alle Trajektorien in die gleiche +c Graphik ein. Zeichne die Kammer dann also nur bei der ersten Schleife. + + if (GRAPHICS .AND. flag_ok) then + CALL IZPICT ('CHAM_1','M') ! ERZEUGEN VON BILDERN IM PAWC-COMM-BLOCK + CALL IZPICT ('CHAM_2','M') + CALL IZPICT ('HISTO','M') + CALL IZPICT ('TEXT','M') + call plot_chamber(schnitt_p) + call Graphics_Text ! Text fuer Textwindow erstellen + call text_plot ! Ausgabe des Textes + endif + + +c Ausgabe der aktuellen Settings: +c Auch dies im Falle von 'OneStartPerLoop' nur bei der ersten Schleife: + + if ((n_outWhere.NE.0 .OR. smallLogFile) .AND. flag_ok) then + call output_new_loop(q_) ! (q_) wegen der neutral fractions + endif + + +c Ausgabe der Prozentzahl schon gerechneten Trajektorien vorbereiten: + + if (log_percent) then + call time(uhrzeit) + percent_done = 0 + write(*,1001)Uhrzeit,' %: 0' + endif +1001 format ($,6x,A,A) + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c bei 'fromScratch': +c Hier wird gegebenenfalls bei Zufallsverteilung von Startparametern ein ent- +c sprechend gewuerfelter Offset auf den aktuellen Wert aufgeschlagen. +c Ansonsten: +c Lies bei Zufallsverteilungen die entsprechenden Startwerte aus dem NTupel +c ein. +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + do 100 randomloop_ = 1, n_par(0) + + if (.NOT.fromScratch) then + + eventNr = eventNr + 1 ! Eventnummer im NTP + + if (smearS1Fo.AND.use_MUTRACK) call HGNTB(NTP_read,'S1FoS',eventNr,istat) + if (istat.NE.0) then + write(*,*) + write(*,*)' error executing ''call HGNTB(',NTP_read,',''S1FoS'',eventNr,istat)''' + write(*,*)' eventNr = ',eventNr + write(*,*)' -> STOP' + write(*,*) + call exit + endif + + ! Einlesen von 'Gebiet' und 'destiny': + call HGNTB(NTP_read,'dest',eventNr,istat) + ! gegebenenfallsvon freuher verwendete Gebietskodierung + ! (ohne Linse2) aktualisieren + if (gebiet.GE.10 .AND. MutrackVersionIndx.LE.1) gebiet = gebiet+2 + +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''dest'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + ! Einlesen der Trajektoriendaten 't,x(3),v(3)': + call HGNTB(NTP_read,'Traj',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''Traj'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + + if (Use_Accel) then + ! Uebersetzen der von ACCEL verwendeten code_Nummern fuer die + ! moeglichen Teilchenschicksale in von MUTRACK verwendete + ! code_Nummern: + if (destiny.EQ.-5) then + destiny = code_frontOfMapAc + elseif (destiny.EQ.-4) then + destiny = code_leftMapAc + elseif (destiny.EQ.-3) then + gebiet = upToGrid2 + destiny = code_grid + elseif (destiny.EQ.-2) then + gebiet = upToGrid1 + destiny = code_grid + elseif (destiny.EQ.-1) then + destiny = code_hit_TgtHolder + elseif (destiny.EQ.code_ok) then + Gebiet = upToHeShield + elseif (destiny.EQ.+1) then + destiny = code_decay + elseif (destiny.EQ.+2) then + destiny = code_reflektiert + elseif (destiny.EQ.+3) then + destiny = code_wand + elseif (destiny.EQ.+4) then + destiny = code_lost + elseif (destiny.EQ.+5) then + destiny = code_dtsmall + else + write(*,*)'UNKNOWN ACCEL-CODE-NR: destiny = ',destiny + call exit + endif + + ! Auf xGrid2 zurueckrechnen, damit unabhaengiger Test auf + ! Treffer des He-Fensters gemacht werden kann (nur, falls + ! Teilchen nicht schon anderweitig gestorben ist). Auch + ! notwendig fuer Graphikausgabe. + + if (destiny.EQ.0) then + dt = (xGrid2-x(1))/v(1) ! < 0. + t = t + dt + x(1) = xGrid2 + x(2) = x(2)+v(2)*dt + x(3) = x(3)+v(3)*dt + endif + + ! falls Kryo verdreht ist, rechne in Kammerkoordinaten um: + + if (alfaTgt.NE.0.) then + if (alfaTgtVertically) then + help1 = x(1) + x(1) = help1 * Cos_alfaTgt - x(3) * Sin_alfaTgt + x(3) = help1 * Sin_alfaTgt + x(3) * Cos_alfaTgt + help1 = v(1) + v(1) = help1 * Cos_alfaTgt - v(3) * Sin_alfaTgt + v(3) = help1 * Sin_alfaTgt + v(3) * Cos_alfaTgt + else + help1 = x(1) + x(1) = help1 * Cos_alfaTgt - x(2) * Sin_alfaTgt + x(2) = help1 * Sin_alfaTgt + x(2) * Cos_alfaTgt + help1 = v(1) + v(1) = help1 * Cos_alfaTgt - v(2) * Sin_alfaTgt + v(2) = help1 * Sin_alfaTgt + v(2) * Cos_alfaTgt + endif + endif + + endif + + endif + + if (random_E0) then ! random_ENERGIE + if (fromScratch) then + if (random_E0_equal) then ! -> gleichverteilt +300 E0 = E0_ + lowerE0 + (upperE0 - lowerE0)*ran(seed) + if (E0.LT.0) goto 300 + elseif (random_E0_gauss) then ! -> gaussverteilt +310 call Gauss_Verteilung(sigmaE0,help1) + E0 = E0_ + help1 + if (E0.LT.0) goto 310 + endif + else + ! Einlesen von 'E0' aus NTP: + call HGNTB(NTP_read,'E0',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(NTP_read,''E0'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + endif + parWert(ener) = E0 + v0_Betrag = sqrt(E0/Energie_Faktor) + endif + + if (random_pos) then ! random_POSITION + if (fromScratch) then + if (random_y0z0_equal) then ! -> rechteckig, gleichverteilt + x0(2) = StartBreite * (ran(seed)-.5) + x0(3) = StartHoehe * (ran(seed)-.5) + elseif (random_y0z0_Gauss) then ! -> rechteckig, Gaussverteilt +320 r0 = abs(sigmaPosition*sqrt(-2.*log(1.-ran(seed)))) + phi_r0= 360.*ran(seed) + x0(2) = r0 * cosd(phi_r0) + if (abs(x0(2)).GT.StartBreite/2.) goto 320 + x0(3) = r0 * sind(phi_r0) + if (abs(x0(3)).GT.StartHoehe/2.) goto 320 + elseif (random_r0_equal) then ! -> rund, gleichverteilt + r0 = StartRadius * sqrt(ran(seed)) + phi_r0= 360. * ran(seed) + x0(2) = r0 * cosd(phi_r0) + x0(3) = r0 * sind(phi_r0) + elseif (random_r0_Gauss) then ! -> rund, Gaussverteilt +330 r0 = abs(sigmaPosition*sqrt(-2.*log(1.-ran(seed)))) + if (r0.GT.StartRadius) goto 330 + phi_r0= 360.*ran(seed) + x0(2) = r0 * cosd(phi_r0) + x0(3) = r0 * sind(phi_r0) + endif + x0(2) = y0_ + x0(2) + x0(3) = z0_ + x0(3) + else + ! Einlesen von 'x0(3)' aus NTP: + call HGNTB(NTP_read,'x0',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''x0'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + endif + parWert(yPos) = x0(2) + parWert(zPos) = x0(3) + endif + + if (random_angle) then ! random_WINKEL + if (fromScratch) then +340 if (random_lambert) then ! -> Lambert-verteilt + call lambert_verteilung(StartLambertOrd, + + Cos_theta0,Sin_theta0) + theta0 = acosd(Cos_theta0) + elseif (random_gauss) then + call Gauss_Verteilung_theta(sigmaWinkel,theta0) + Cos_theta0 = cosd(theta0) + Sin_theta0 = sind(theta0) + endif + + phi0 = 360.*ran(seed) + Cos_phi0 = cosd(phi0) + Sin_phi0 = sind(phi0) + + if (angle_offset) then + +c -> Es soll aus gewuerfelter Startrichtung (theta0,phi0) und durch die Winkel- +c schleifen vorgegebenen Startrichtung (theta0_,phi0_) die tatsaechliche +c Startrichtung berechnet werden. Dafuer werden die gewuerfelten Winkel als +c 'Streuwinkel' betrachtet. +c Vorgehensweise: +c Es werden die Komponenten eines Geschwindigkeitsvektors mit Betrag=1 und durch +c theta0_,phi0_ bestimmter Richtung berechnet. Danach werden die Komponenten des +c mit theta0,phi0 gestreuten Geschwindigkeitsvektors und die zugehoerigen Winkel +c gewonnen, die dann als neuetheta0,phi0 als die tatsaechlichen Startwinkel +c verwendet werden. Das alles geschieht vollkommen analog zur Winkelaufstreuung +c in der Triggerfolie. +c v wird als Hilfsvariable missbraucht. + + ! Berechnung der 'Geschwindigkeitskomponenten': + v(1) = cosd(theta0_) + help1 = sind(theta0_) + v(2) = help1 * cosd(phi0_) + v(3) = help1 * sind(phi0_) + ! v_xy ist stets groesser 0 ausser wenn die Zentralrichtung + ! senkrecht nach oben oder unten gerichtet ist. Diese Wahl ist + ! aber sowieso wenig sinnvoll: + v_xy = SQRT(v(1)*v(1) + v(2)*v(2)) + if (v_xy.EQ.0.) then + write(*,*) + write(*,*)' Bei Zufallsverteilung fuer Startwinkel darf die durch die Winkelschleifen' + write(*,*)' vorgegebene Zentralrichtung nicht senkrecht nach oben oder nach unten weisen!' + write(*,*)' -> STOP' + STOP + endif + ! berechne neue 'Geschwindigkeitskomponenten': + help1 = v(1) + help2 = v(2) + help3 = Sin_theta0*Cos_phi0/v_xy + help4 = Sin_theta0*Sin_phi0 + v(1) = Cos_theta0*help1 - help3*help2 - help4*help1*v(3)/v_xy + if (v(1).LT.0.) goto 340 + v(2) = Cos_theta0*help2 + help3*help1 - help4*help2*v(3)/v_xy + v(3) = Cos_theta0*v(3) + help4*v_xy + ! Berechne tatsaechlichen Startwinkel: + if (v(2).EQ.0. .AND. v(3).EQ.0.) then + if (v(1).GE.0) then + theta0 = 0. + else + theta0 = 180. + endif + phi0 = 0. + else + theta0 = acosd(v(1)) + phi0 = atan2d(v(3),v(2)) + if (phi0.LT.0) phi0 = phi0+360. + endif + Cos_theta0 = cosd(theta0) + Sin_theta0 = sind(theta0) + Cos_phi0 = cosd(phi0) + Sin_phi0 = sind(phi0) + endif + + if (theta0.GT.90.) goto 340 + + else + + ! Einlesen von 'theta0' und 'phi0' aus NTP: + call HGNTB(NTP_read,'angle0',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''angle0'',eventNr,istat)''' +c write(*,*)' eventNr = ',eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + + endif + + parWert(thetAng) = theta0 + parWert(phiAng) = phi0 + + endif + + ! Berechnung der Start-Geschwindigkeitskomponenten: + v0(1) = v0_Betrag * Cos_theta0 + v0(2) = v0_Betrag * Sin_theta0 * Cos_phi0 + v0(3) = v0_Betrag * Sin_theta0 * Sin_phi0 + + if (fromScratch) then + ! den Zeit-Speicher resetten: + t = 0. + ! Startparameter in Koordinatenspeicher uebergeben: + do i = 1, 3 + x(i) = x0(i) + v(i) = v0(i) + enddo + endif + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Hier folgen die restl. Vorbereitungen zum Start des individuellen Projektils: +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c n_dtsmall resetten: + + n_dtsmall = 0 + + +c Aufstreuwinkel resetten: + + thetaAufstreu = 0. + phiAufstreu = 0. + + +c x-Komponente der Startgeschwindigkeit ueberpruefen: + + if (v0(1).LT.0) then + write(*,*) + write(*,*) ' >>>> v(x) beim Start negativ!' + write(*,*) + call exit + endif + + +c die Lebensdauer wuerfeln: +c (wird eine fruehere Simulation fortgefuehrt und wurde dort bereits der Myonen- +c zerfall beruecksichtigt, so verwende die dort gewuerfelten Lebenszeiten) + + if (UseDecay_) then + if (.NOT.UseDecay_prevSim) then +350 lifeTime = -meanlifeTime * Log(Ran(seed) + 1.0E-37) + if (lifeTime.LE.0.) goto 350 + elseif (.NOT.fromScratch) then + call HGNTB(NTP_read,'lifetime',eventNr,istat) +c if (istat.NE.0) then +c write(*,*) +c write(*,*)' error executing ''call HGNTB(',NTP_read,',''lifetime'',eventNr,istat)''' +c write(*,*)' eventNr = ', eventNr +c write(*,*)' -> STOP' +c write(*,*) +c call exit +c endif + endif + endif + + +c die Ladung resetten (falls in der Folie Neutralisierung stattgefunden hat): +c ('qInt' wird fuer 'NTP_charge' benoetigt) + + q = parWert(charge) + qInt = int(q) + + +c Ausgabe der Prozentzahl schon gerechneter Trajektorien: + + if (log_percent) then + if (100.*real(start_nr(1))/real(n_par(0)) + + .GE.percent_done+5) then + percent_done = percent_done + 5 + write(*,1002) percent_done + endif + endif +1002 format ($,'+',I3) + + +c andere Variablen auf den richtigen Stand bringen: + + if (fromScratch) then + destiny = code_ok ! bis jetzt ist dem Teilchen noch nichts zugestossen + Gebiet = Gebiet0 + endif + + start_nr(1) = start_nr(1) + 1 ! Projektil-Startnummer erhoehen + steps = 0 ! es wurden noch keine Integrationsschritte durchgefuehrt + NTPalreadyWritten = .false. ! fuer 'createFoilFile' + + +c die DEBUG-Daten ausgeben: + + if (Debug .AND. start_Nr(1).LE.DEBUG_Anzahl) then + Debug_ = .true. + call output_new_particle + call Output_Debug + else + Debug_ = .false. + endif + + +c StartKoordinaten fuer Graphikausgabe sichern: + + if (graphics .AND. (start_Nr(1).LE.graphics_Anzahl .OR. OneStartPerLoop)) then + graphics_ = .true. + if (Use_ACCEL) then + nKoord = 1 + xKoord(1) = x0(1) + yKoord(1) = x0(2) + zKoord(1) = x0(3) + else + nKoord = 0 + endif + if (.NOT.(Use_MUTRACK.OR.Gebiet0.EQ.upToExTD)) call Save_Graphics_Koord + else + graphics_ = .false. + endif + + +c gegebenenfalls 'fill_NTP' resetten: + + if (Fo_triggered.OR.M2_triggered.OR.xM2_triggered) fill_NTP = .false. + + +c Falls Schrittweiteninformationen im NTupel verlangt sind: Speicher resetten +c und Startkoordinaten sichern: + +d if (NTP_steps) then +d dtmin_L1 = +1.e10 +d x_dtmin_L1(1) = 0 +d x_dtmin_L1(2) = 0 +d x_dtmin_L1(3) = 0 +d dtmax_L1 = -1.e10 +d x_dtmax_L1(1) = 0 +d x_dtmax_L1(2) = 0 +d x_dtmax_L1(3) = 0 +d +d dtmin_L2andFo = +1.e10 +d x_dtmin_L2andFo(1) = 0 +d x_dtmin_L2andFo(2) = 0 +d x_dtmin_L2andFo(3) = 0 +d dtmax_L2andFo = -1.e10 +d x_dtmax_L2andFo(1) = 0 +d x_dtmax_L2andFo(2) = 0 +d x_dtmax_L2andFo(3) = 0 +d +d dtmin_FO = +1.e10 +d x_dtmin_FO(1) = 0 +d x_dtmin_FO(2) = 0 +d x_dtmin_FO(3) = 0 +d dtmax_FO = -1.e10 +d x_dtmax_FO(1) = 0 +d x_dtmax_FO(2) = 0 +d x_dtmax_FO(3) = 0 +d +d dtmin_L3 = +1.e10 +d x_dtmin_L3(1) = 0 +d x_dtmin_L3(2) = 0 +d x_dtmin_L3(3) = 0 +d dtmax_L3 = -1.e10 +d x_dtmax_L3(1) = 0 +d x_dtmax_L3(2) = 0 +d x_dtmax_L3(3) = 0 +d +d dtmin_M2 = +1.e10 +d x_dtmin_M2(1) = 0 +d x_dtmin_M2(2) = 0 +d x_dtmin_M2(3) = 0 +d dtmax_M2 = -1.e10 +d x_dtmax_M2(1) = 0 +d x_dtmax_M2(2) = 0 +d x_dtmax_M2(3) = 0 +d endif + + if (NTP_40mm) then + x40(2) = 0. + x40(3) = 0. + v40(1) = 0. + v40(2) = 0. + v40(3) = 0. + t40 = 0. + E40 = 0. + endif + + +c Die Flugzeiten resetten: + + S1xM2 = 0. + S1M2 = 0. + S1Fo = 0. + FoM2 = 0. + S1M3 = 0. + M3M2 = 0. + + +c Falls das Teilchen schon nicht mehr existiert, gehe gleich zur Ausgabe: + + if (destiny.NE.code_ok) goto 555 ! (nur bei '.NOT.fromScratch' moeglich) + + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c hier starten die Projektile: +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + + goto startLabel ! StartLabel = Gebiet0 als label + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c erste Beschleunigerstufe: (homogenes Feld) + +1 Gebiet = upToGrid1 + steps = Steps + 1 + + if (a1.NE.0.) then + help1 = v(1)*v(1) + 2.*a1*(xGrid1-x(1)) + if (help1.LT.0) then ! Reflektion noch vor 1. Gitter + dt = -2*v(1)/a1 + t = t + dt + !x(1) bleibt unveraendert + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + v(1) = -v(1) + !v(2) bleibt unveraendert + !v(3) bleibt unveraendert + destiny = code_reflektiert + goto 555 + endif + dt = (sqrt(help1) - v(1))/a1 + ! (ergibt sich aus x=v*t+1/2*a*t**2 mit richtiger V.Z.-Wahl ('+')) + v(1) = v(1) + a1*dt + else + if (v(1).EQ.0) then + write(*,*) + write(*,*)'ERROR: v(x) beim Start = 0. und '// + + 'Beschleunigung = 0' + write(*,*) + STOP + endif + dt = (xGrid1-xTarget) / v(1) + endif + + t = t + dt + !v(2) bleibt unveraendert + !v(3) bleibt unveraendert + x(1) = xGrid1 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + +c - Aufgeschlagen? + + if (Abs(x(2)).gt.dygrid1/2. .OR. + + Abs(x(3)).gt.dzgrid1/2.) then + flag = .true. + destiny = code_wand + else + flag = .false. + endif + +c - Gitterstab getroffen? + + if (testOnWireHit) then + DrahtNr = nInt(x(2)/dist_Wires_G1) + distToWire(1) = 0. + distToWire(2) = x(2) - DrahtNr * dist_Wires_G1 + call Test_WireHit(distToWire,WireRadiusQuad_G1,v(1),v(2),WireHit) + if (WireHit) then + flag = .true. + destiny = code_grid + endif + endif + +c - Koordinatentransformation in Kammersystem: + + if (alfaTgt.NE.0.) then + if (alfaTgtVertically) then + help1 = x(3) + help2 = v(1) + help3 = v(3) + x(1) = xgrid1 * Cos_alfaTgt - help1 * Sin_alfaTgt + x(3) = xgrid1 * Sin_alfaTgt + help1 * Cos_alfaTgt + v(1) = help2 * Cos_alfaTgt - help3 * Sin_alfaTgt + v(3) = help2 * Sin_alfaTgt + help3 * Cos_alfaTgt + else + help1 = x(2) + help2 = v(1) + help3 = v(2) + x(1) = xgrid1 * Cos_alfaTgt - help1 * Sin_alfaTgt + x(2) = xgrid1 * Sin_alfaTgt + help1 * Cos_alfaTgt + v(1) = help2 * Cos_alfaTgt - help3 * Sin_alfaTgt + v(2) = help2 * Sin_alfaTgt + help3 * Cos_alfaTgt + endif + endif + +c - zerfallen? + + if (useDecay_) call Decay_Test(*555) + +c - falls aufgeschlagen: + + if (flag) goto 555 + +c - Koordinatentransformation zurueck in Beschleunigersystem: + + if (alfaTgt.NE.0.) then + if (alfaTgtVertically) then + x(1) = xGrid1 + x(3) = help1 + v(1) = help2 + v(3) = help3 + else + x(1) = xGrid1 + x(2) = help1 + v(1) = help2 + v(2) = help3 + endif + endif + +c - Datenausgabe: + + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zweite Beschleunigerstufe: (homogenes Feld) + +2 Gebiet = upToGrid2 + steps = Steps + 1 + + if (a2.NE.0.) then + help1 = v(1)*v(1) + 2.*a2*(XGrid2-XGrid1) + if (help1.LT.0) then ! Reflektion noch vor 2. Gitter + dt = -2*v(1)/a2 + t = t + dt + !x(1) bleibt unveraendert + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + v(1) = -v(1) + !v(2) bleibt unveraendert + !v(3) bleibt unveraendert + destiny = code_reflektiert + goto 555 + endif + dt = (sqrt(help1) - v(1))/a2 + v(1) = v(1) + a2*dt + else + if (v(1).EQ.0) then ! (kann nur bei Start in 2. Stufe passieren) + write(*,*) + write(*,*)'ERROR: v(x) beim Start = 0. und '// + + 'Beschleunigung = 0' + write(*,*) + STOP + endif + dt = (XGrid2-XGrid1) / v(1) + endif + + t = t + dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + +c - Aufgeschlagen? + + if (Abs(x(2)).gt.dygrid2/2. .OR. + + Abs(x(3)).gt.dzgrid2/2.) then + flag = .true. + destiny = code_wand + else + flag = .false. ! <- noetig, falls Start auf 1. Gitter + endif + +c - Gitterstab getroffen? + + if (testOnWireHit) then + DrahtNr = nInt(x(2)/dist_Wires_G2) + distToWire(1) = 0 + distToWire(2) = x(2) - DrahtNr * dist_Wires_G2 + call Test_WireHit(distToWire,WireRadiusQuad_G2,v(1),v(2),WireHit) + if (WireHit) then + flag = .true. + destiny = code_grid + endif + endif + +c - Koordinatentransformation in Kammersystem: + + if (alfaTgt.NE.0.) then + if (alfaTgtVertically) then + x(1) = xgrid2 * Cos_alfaTgt - x(3) * Sin_alfaTgt + x(3) = xgrid2 * Sin_alfaTgt + x(3) * Cos_alfaTgt + help1 = v(1) + v(1) = help1 * Cos_alfaTgt - v(3) * Sin_alfaTgt + v(3) = help1 * Sin_alfaTgt + v(3) * Cos_alfaTgt + else + x(1) = xgrid2 * Cos_alfaTgt - x(2) * Sin_alfaTgt + x(2) = xgrid2 * Sin_alfaTgt + x(2) * Cos_alfaTgt + help1 = v(1) + v(1) = help1 * Cos_alfaTgt - v(2) * Sin_alfaTgt + v(2) = help1 * Sin_alfaTgt + v(2) * Cos_alfaTgt + endif + else + x(1) = xgrid2 + endif + +c - zerfallen? + + if (useDecay_) call Decay_Test(*555) + +c - falls aufgeschlagen: + + if (flag) goto 555 + +c - Datenausgabe: + + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen zweitem Gitter und He-Shield: (feldfrei) + +3 Gebiet = upToHeShield + Steps = Steps + 1 + + radiusQuad = x(1)*x(1) + x(2)*x(2) + help1 = v(1)*v(1)+v(2)*v(2) + help2 = x(1)*v(1)+x(2)*v(2) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_HeShield))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen das Schild + x(3) = x(3) + dt*v(3) ! durchquert + + if (useDecay_) call Decay_Test(*555) + if (Abs(x(2)).gt.DYHESHIELD/2. .OR. + + Abs(x(3)).gt.DZHESHIELD/2.) then + destiny = code_wand + goto 555 + endif + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c Groessen bei x=40 mm berechnen: + + if (NTP_40mm) then + dt = (40-x(1))/v(1) + x40(2) = x(2)+v(2)*dt + x40(3) = x(3)+v(3)*dt + v40(1) = v(1) + v40(2) = v(2) + v40(3) = v(3) + t40 = t + dt + ! help1 = v(1)*v(1)+v(2)*v(2) noch bekannt von 'upToHeShield' + v_square = help1 + v(3)*v(3) + E40 = v_square * Energie_Faktor + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen He-Shield und LN-Shield: (feldfrei) + +4 Gebiet = upToLNShield + Steps = Steps + 1 + + radiusQuad = x(1)*x(1) + x(2)*x(2) + ! help1 = v(1)*v(1)+v(2)*v(2) ! noch bekannt von 'upToHeShield' + help2 = x(1)*v(1)+x(2)*v(2) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_LNShield))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen das Schild + x(3) = x(3) + dt*v(3) ! durchquert + + if (useDecay_) call Decay_Test(*555) + if (abs(x(2)).gt.dyLNShield/2. .OR. + + Abs(x(3)).gt.dzLNShield/2.) then + destiny = code_wand + goto 555 + endif + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen LN-Shield und Beginn der L1-Mappe: (feldfrei) + +5 Gebiet = upToL1Map + Steps = Steps + 1 + + dt = (xEnterMap_L1 - x(1)) / v(1) + + t = t + dt + x(1) = xEnterMap_L1 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + if (radiusQuad.GT.radiusQuad_L1) then ! Teilchen fliegt an L1 vorbei + destiny = code_vorbei + goto 555 + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb L1: (inhom. Felder -> Integrationen) + +6 Gebiet = upToExL1 ! GebietsNummer fuer L1 setzen + +c Teste, ob das Teilchen ueberhaupt eine Beschleunigung erfaehrt (Spannung=0?, +c Ladung=0?). Falls nicht, steppe gleich bis zum Mappenende: + + if (Beschl_Faktor_L1.EQ.0) then +d dtmax_L1 = 0. +d dtmin_L1 = 0. + dt = (xLeaveMap_L1 - x(1)) / v(1) ! Zeit bis zum Mappenende + x(1) = xLeaveMap_L1 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + goto 5106 + endif + +c............................................................................... +c Das Teilchen spuert eine Beschleunigung, es muss also integriert werden. +c Gehe als ersten Versuch 0.5 mm in das Gebiet hinein: + + dt = .5/v(1) + zaehler = 0 + +c............................................................................... +c hierher wird zurueckgesprungen, solange die Integration in der L1 bleibt + +5006 call INTEGRATIONSSTEP_RUNGE_KUTTA_L1(dt) +d if (NTP_steps) then +d if (dt.LT.dtmin_L1) then +d dtmin_L1 = dt +d x_dtmin_L1(1) = x(1) +d x_dtmin_L1(2) = x(2) +d x_dtmin_L1(3) = x(3) +d endif +d if (dt.GT.dtmax_L1) then +d dtmax_L1 = dt +d x_dtmax_L1(1) = x(1) +d x_dtmax_L1(2) = x(2) +d x_dtmax_L1(3) = x(3) +d endif +d endif + +c............................................................................... +5106 Steps = Steps + 1 ! neuer Ort, Zeit und Geschwindigkeit sind festgelegt + +c do some tests: + + if (destiny.EQ.code_dtSmall) then ! n_dtsmall>maxBelowDtSmall + goto 555 + elseif (destiny.EQ.code_wand) then ! aufgeschlagen + radiusQuad = x(2)*x(2) + x(3)*x(3) ! -> den Ort berechnen, an + help1 = v(2)*v(2)+v(3)*v(3) ! dem das Teilchen auf- + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_L1))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + goto 555 +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'L1-1: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (x(1).LT.xEnterMap_L1) then + if (v(1).LT.0) then ! reflektiert? + destiny = code_reflektiert + goto 555 + else ! darf nicht sein! + write(*,*) + write(*,*)' L1: x(1).LT.xEnterMap .AND. v(1).GE.0. -> STOP' + write(*,*) + STOP + endif + elseif (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + elseif (x(1).GE.xLeaveMap_L1) then ! Verlasse L1 + dt = (xLeaveMap_L1 - x(1))/v(1) ! rechne zurueck auf exaktes + t = t + dt ! Mappenende + x(1) = xLeaveMap_L1 + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + goto bis_Spiegel ! -> Mache bei upToEnSp weiter +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'L1-2: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + endif + + +c verarbeite alle 'imonitor' Schritte die Koordinaten fuer GRAPHICS und DEBUG: + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5006 ! naechster Integrationsschritt in L1-Mappe + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen Linse 1 und Spiegel: (feldfrei) + +7 Gebiet = upToEnSp + Steps = Steps + 1 + +c - berechne Schnittpunkt mit forderer Spiegelebene: + + help2 = v(2)/v(1) ! Steigung der Bahn in der x-y-Ebene + + if (help2.GE.Tan_alfaSp) then + ! Teilchen fliegt am Spiegel vorbei + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + if (useDecay_) call Decay_Test(*555) + destiny = code_vorbei + goto 555 + else + ! help1 == neues x(1) + help1 = (x(2) - y_intersectSP + xSpiegel*Tan_alfaSp + + - xLeaveMap_L1*help2) / (Tan_alfaSp - help2) + + dt = (help1-x(1)) / v(1) + t = t + dt + x(1) = help1 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + endif + + if (useDecay_) call Decay_Test(*555) + if (Debug_) call Output_Debug + + +c Berechnung der Trajektorie bei idealem Spiegel: + + if (idealMirror) then ! ~~~ 40: if ~~~~~~~~~~~ + +c - pruefe, ob das Teilchen die ForderSEITE des Spiegels trifft: + + if ( x(2).GT.yUppLeft .OR. x(2).LT.yLowLeft .OR. + + abs(x(3)).GT.HSpiegel/2.) then + ! -> Teilchen fliegt am Spiegel vorbei + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + destiny = code_vorbei + goto 555 + endif + + +c - pruefe, ob das Teilchen einen Gitterstab des Spiegels trifft: + + if (testOnWireHit) then + help1 = x(2)-yLowLeft ! Abstand zum Bezugspunkt + DrahtNr = nInt(help1/(Sin_alfaSp*dist_Wires_Sp)) + distToWire(2) = help1 - DrahtNr * Sin_alfaSp*dist_Wires_Sp + distToWire(1) = distToWire(2)/Tan_alfaSp + call Test_WireHit(distToWire,WireRadiusQuad_Sp,v(1),v(2),WireHit) + if (WireHit) then + destiny = code_grid + goto 555 + endif + endif + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c im Spiegel: (homogenes Feld) + +8 Gebiet = upToExSp + Steps = Steps + 1 + +c - pruefe, ob Teilchen nicht zuviel Energie senkrecht zum Spiegel hat: + + if (Spiegel_Faktor.EQ.0.) then ! Spannung=0. oder q=0 + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + destiny = code_durchSpiegel + goto 555 + endif + + ! help1 == Winkel in xy-Ebene zwischen Bewegungsrichtung und Spiegelfront + + help1 = alfaSp - atand(v(2)/v(1)) + + ! help2 = Geschw.Komponente senkrecht auf den Spiegel gerichtet + ! help3 = Geschw.Komponente parallel zum Spiegel, zu positiven y hin + + v_xy = sqrt( v(1)*v(1) + v(2)*v(2) ) + help2 = sind(help1) * v_xy + help3 = cosd(help1) * v_xy + + if (help2*help2*Energie_Faktor.GE.q*U_Sp) then + ! Teilchen tritt durch Spiegel durch + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + destiny = code_durchSpiegel + goto 555 + endif + + if (Graphics_) call Save_Graphics_Koord + + +c - berechne Zeit, bis Teilchen wieder auf Spiegelforderseite ist: + + dt = help2 * Spiegel_Faktor ! Spiegel_Faktor == 2 / a + t = t + dt + +c - berechne Versetzung in xy-Ebene, parallel zur Spiegelebene, +c in 'positiver y-Richtung' (speichere in 'help1'): + + help1 = help3*dt + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +c falls Graphikausgabe verlangt ist: +c Um die Teilchenbahn im Innern des Spiegels anzudeuten, berechne die Orte bei +c t+dt/4, t+td/2 und t+3dt/4. Bestimme dafuer erst die jeweilige Versetzung +c senkrecht zur Spiegelebene aus dx = vx * t + 1/2 * a * t**2. +c (speichere in help4): + + if (Graphics_) then + + help4 = help2*dt*.25 - (dt*dt*.0625)/Spiegel_faktor + nKoord = nKoord + 1 + xKoord(nKoord) = x(1)+help4*Sin_alfaSp+help1*.25*Cos_alfaSp + yKoord(nKoord) = x(2)-help4*Cos_alfaSp+help1*.25*Sin_alfaSp + zKoord(nKoord) = x(3) + v(3)*dt*.25 + + help4 = help2*dt*.50 - (dt*dt*.2500)/Spiegel_faktor + nKoord = nKoord + 1 + xKoord(nKoord) = x(1)+help4*Sin_alfaSp+help1*.50*Cos_alfaSp + yKoord(nKoord) = x(2)-help4*Cos_alfaSp+help1*.50*Sin_alfaSp + zKoord(nKoord) = x(3)+v(3)*dt*.50 + + help4 = help2*dt*.75 - (dt*dt*.5625)/Spiegel_faktor + nKoord = nKoord + 1 + xKoord(nKoord) = x(1)+help4*Sin_alfaSp+help1*.75*Cos_alfaSp + yKoord(nKoord) = x(2)-help4*Cos_alfaSp+help1*.75*Sin_alfaSp + zKoord(nKoord) = x(3)+v(3)*dt*.75 + + endif +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +c - berechne Austrittsort: + + x(1) = x(1) + help1 * Cos_alfaSp + x(2) = x(2) + help1 * Sin_alfaSp + x(3) = x(3) + v(3)*dt + + +c - berechne Austrittsgeschwindigkeit (help2 geht bei Spiegelung in -help2 ueber): + + v(1) = help3 * Cos_alfaSp - help2 * Sin_alfaSp + v(2) = help2 * Cos_alfaSp + help3 * Sin_alfaSp + + if (v(2).LE.0) then + write(*,*) + write(*,*)'ERROR: nach Spiegel ist v(y) <= 0.' + write(*,*) + STOP + endif + + if (useDecay_) call Decay_Test(*555) + + +c - pruefe, ob Austrittspunkt auf forderer Spiegelflaeche liegt: + + if (x(2).GT.yUppLeft .OR. x(2).LT.yLowLeft .OR. + + abs(x(3)).GT.hSpiegel/2.) then + ! Teilchen trifft auf Spiegelwand + destiny = code_wand + goto 555 + endif + + +c - pruefe, ob das Teilchen einen Gitterstab des Spiegels trifft: + + if (testOnWireHit) then + help1 = x(2)-yLowLeft ! Abstand zum Bezugspunkt + DrahtNr = nInt(help1/(Sin_alfaSp*dist_Wires_Sp)) + distToWire(2) = help1 - DrahtNr * Sin_alfaSp*dist_Wires_Sp + distToWire(1) = distToWire(2)/Tan_alfaSp + call Test_WireHit(distToWire,WireRadiusQuad_Sp,v(1),v(2),WireHit) + if (WireHit) then + destiny = code_grid + goto 555 + endif + endif + + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + goto 9 + + endif ! ~~~ 40: endif ~~~~ + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb der Spiegelmappe (dx = 0.050 mm, dy = 0.050 mm) + + Gebiet = upToExSp + nKoordSave = nKoord + +c Die Anweisungen dieses Abschnitts verlaufen analog zu denen +c von Linse 1. -> Fuer Kommentare siehe dort! + + if (Beschl_Faktor_Sp.EQ.0. .OR. q.EQ.0) then +d dtmax_Sp = 0. +d dtmin_Sp = 0. + dt = (600-x(1))/v(1) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + destiny = code_durchSpiegel + goto 555 + endif + + dt = 0.5/v(1) + + reachedEndOfMap = .false. + zaehler = 0 + + +c Rechne in Spiegelmappen-Koordinaten um: +c Im Spiegelmappensystem: x-Achse verlaueft entlang der forderen Mappenkante, +c y-Achse aus dem Spiegel heraus. (entgegen der Richtung zunehmender Mappen- +c j-indizierung!) + + +5008 help1= x(1) - xSpiegel + x(1) = - x(2)*Cos_alfaSp + help1*Sin_alfaSp + + + (dSpiegel/2.+DreharmLaenge+xSpGrid1) + x(2) = x(2)*Sin_alfaSP + help1*Cos_alfaSP + help1= v(1) + v(1) = - v(2)*Cos_alfaSp + help1*Sin_alfaSp + v(2) = v(2)*Sin_alfaSP + help1*Cos_alfaSP + + +c mache Integrationsschritt: + + call INTEGRATIONSSTEP_RUNGE_KUTTA_Sp(dt) ! setzt u.U. auch 'destiny' + + Steps = Steps + 1 + + +c do some tests: + + if (Steps.GE.MaxStep) destiny = code_lost ! Teilchen verloren + + +c - Potentialmappe nach Reflektion wieder verlasssen? + + if (x(1).LT.0) then + reachedEndOfMap = .true. + +c - Spiegelrahmen getroffen? + + elseif (x(1).GE.xSpGrid1 .AND. + + (abs(x(2)).GT.bSpiegel/2. .OR. abs(x(3)).GT.hSpiegel/2.)) then + destiny = code_wand + +c - Gitterstab getroffen? + + else + help1 = min(abs(x(1)-xSpGrid1),abs(x(1)-xSpGrid1)) + if (help1.LE.rWires_Sp) then + DrahtNr = nInt(x(2)/dist_Wires_Sp) + distToWire(2) = x(2) - DrahtNr * dist_Wires_Sp + if ( (help1*help1 + distToWire(2)*distToWire(2)).LE. + + radiusQuad_Sp) destiny = code_grid + endif + + endif + +c if (destiny.NE.code_ok) then +c if (x(1).LT.xSpGrid1) then +c if (v(1).GT.0) then +c gebiet = UpToGrid +c else +c gebiet = upToExMap +c endif +c else +c gebiet = RetToGrid +c endif +c endif + + +c Rechne in Kammerkoordinaten zurueck: + + help1= x(1)-(dSpiegel/2.+DreharmLaenge+xSpGrid1) + x(1) = help1*Sin_alfaSP + x(2)*Cos_alfaSP + xSpiegel + x(2) = - help1*Cos_alfaSP + x(2)*Sin_alfaSP + help1= v(1) + v(1) = help1*Sin_alfaSP + v(2)*Cos_alfaSP + v(2) = - help1*Cos_alfaSP + v(2)*Sin_alfaSP + +d if (NTP_steps) then +d if (dt.LT.dtmin_Sp) then +d dtmin_Sp = dt +d x_dtmin_Sp(1) = x(1) +d x_dtmin_Sp(2) = x(2) +d x_dtmin_Sp(3) = x(3) +d endif +d if (dt.GT.dtmax_Sp) then +d dtmax_Sp = dt +d x_dtmax_Sp(1) = x(1) +d x_dtmax_Sp(2) = x(2) +d x_dtmax_Sp(3) = x(3) +d endif +d endif + + +c zerfallen? + + if (useDecay_) call Decay_Test(*555) + + +c Bahnberechnung abgebrochen? + + if (destiny.NE.code_ok) goto 555 + + +c verarbeite alle 'imonitor' Schritte die Koordinaten fuer GRAPHICS und DEBUG: + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (GRAPHICS_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + if (.NOT.reachedEndOfMap) goto 5008 ! naechster Integrationsschritt + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen Spiegel und Koordinatenwechsel-Ebene y=xChangeKoord: (feldfrei) + +9 Gebiet = upToChKoord + Steps = Steps + 1 + + if (x(2).LT.xChangeKoord) then + ! gegebenenfalls flag fuer Graphikausgabe des Punktes setzen + flag = .true. + else + flag = .false. + endif + + dt = (xChangeKoord - x(2)) / v(2) + t = t + dt + x(1) = x(1) + v(1)*dt + x(2) = xChangeKoord + x(3) = x(3) + v(3)*dt + + help4 = x(1)-xSpiegel + radiusQuad = help4*help4 + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(1)*v(1)+v(3)*v(3) + help2 = help4*v(1)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + if (useDecay_) call Decay_Test(*555) + if (Graphics_.AND.flag) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +c falls Graphikausgabe verlangt ist: Gib jetzt die Trajektorie im 'horizontalen' +c Teil der Kammer aus und resette nKoord: + + if (Graphics_) then + + call plot_horizontal + if (schnitt_p.eq.1) call schnitt ! Schnittebene + + ! die letzten Koordinaten fuer Plot der Trajektorie im 2. Kammerteil + ! uebernehmen (in neues KoordinatenSystem transformiert): + + k = nKoord + + if (idealMirror) then + nKoord = 7 + else + if (nKoord.LT.nKoordSave) then + ! => ein 'turn over' fand statt waehrend das Teilchen in der + ! Spiegelmappe war => x(999) -> x(1), x(1000) -> x(2) + nKoord = nKoord + (999-nKoordSave) + else + nKoord = nKoord - nKoordSave + 1 + endif + nKoord = nKoord-2 + endif + + do i = nKoord, 1, -1 + xKoord_(i) = yKoord(k) + yKoord_(i) = xSpiegel - xKoord(k) + zKoord_(i) = zKoord(k) + k = k - 1 + if (k.EQ.0) then + k = 998 + endif + enddo + do i = 1, nKoord + xKoord(i) = xKoord_(i) + yKoord(i) = yKoord_(i) + zKoord(i) = zKoord_(i) + enddo + endif + + +c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +c - Vollziehe Koordinatenwechsel: neuer Ursprung in der Spiegelaufhaengung, +c x-Richtung in bisherige y-Richtung (also wiederum entlang Strahlachse), +c y-Richtung in bisheriger negativer x-Richtung. z-Richtung bleibt gleich. + + help1 = x(2) + x(2) = xSpiegel - x(1) + x(1) = help1 + help1 = v(1) + v(1) = v(2) + v(2) = - help1 + + if (Debug_) then + write (lun(1),*) 'KOORDINATENWECHSEL:' + call Output_Debug + endif + + +c Beruecksichtige gegebenenfalls die Flugzeit in 'delta_L1', welches 'vor dem +c Triggerdetektor' eingeschoben werden kann: + + dt = Delta_L1 / v(1) + x(1) = x(1)+v(1)*dt + x(2) = x(2)+v(2)*dt + x(3) = x(3)+v(3)*dt + t = t + dt + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + + if (lense2) then ! ~~~~~~~~~~~~~~ ******* ~~~~~~~~~~~~~~~ + +c Bei 'lense2' wird fuer das Feld der Linse 2 und das Feld der TD-Folie eine +c gemeinsame Mappe verwendet. Hierbei ist allerdings der Triggerwinkel auf 0 +c Grad festgelegt. Da es in Zukunft in der Praxis wohl kaum noch vorkommen wird, +c dass der Triggerdetektor verdreht wird, sollte diese Einschraenkung jedoch +c keine grossen Auswirkungen haben. +c Ist der Triggerdetektor nicht im Strahl, so wird der Anteil der Triggerfolie +c gleich Null gesetzt. + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c zwischen KOORDINATENWECHSEL und Beginn der L2andFo-Mappe: (feldfrei) + +10 Gebiet = upToL2andFoMap + Steps = Steps + 1 + + dt = (xEnterMap_L2andFo - x(1)) / v(1) + t = t + dt + x(1) = xEnterMap_L2andFo + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + if (radiusQuad.GT.radiusQuad_L2) then ! Teilchen fliegt an L2 vorbei + destiny = code_vorbei + goto 555 + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb der gemeinsamen Mappe von Linse 2 und dem Feld vor der Trigger- +c Detektor-Folie: + +11 Gebiet = upToExL2 ! Gebietsnummer fuer L2 setzen + +c Die Anweisungen dieses Abschnitts verlaufen analog zu denen +c von Linse 1. -> Fuer Kommentare siehe dort! + + if (Beschl_Faktor.EQ.0. .OR. (U_L2.EQ.0. AND. U_F.EQ.0.)) then +c WRITE(*,*) 'HALLOHALLO!' +d dtmax_L2andFo = 0. +d dtmin_L2andFo = 0. + dt = (xEndLense_L2 - x(1)) / v(1) ! Zeit bis zum Linsenende + x(1) = xEndLense_L2 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_L2) then + destiny = code_wand + radiusQuad_ = radiusQuad_L2 + goto 5111 + endif + if (TriggerInBeam) then + Gebiet = upToEnTD ! Gebietsnummer fuer upToTD setzen + ! Zeit bis zum Mappenende (falls TD im Strahl: bis Triggerfolie) + dt = (xLeaveMap_L2andFo - xEndLense_L2) / v(1) + x(1) = xLeaveMap_L2andFo + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + destiny = code_wand + radiusQuad_ = radiusQuad_Rohr + endif + endif + goto 5111 + endif + + dt = .5/v(1) + zaehler = 0 + reachedEndOfMap = .false. + + +c die Integrationsroutine will x bereits relativ zum Mappenanfang geliefert +c bekommen: + +5011 x(1) = x(1) - xEnterMap_L2andFo + call INTEGRATIONSSTEP_RUNGE_KUTTA_L2(dt) + x(1) = x(1) + xEnterMap_L2andFo + +d if (NTP_steps) then +d if (dt.LT.dtmin_L2andFo) then +d dtmin_L2andFo = dt +d x_dtmin_L2andFo(1) = x(1) +d x_dtmin_L2andFo(2) = x(2) +d x_dtmin_L2andFo(3) = x(3) +d endif +d if (dt.GT.dtmax_L2andFo) then +d dtmax_L2andFo = dt +d x_dtmax_L2andFo(1) = x(1) +d x_dtmax_L2andFo(2) = x(2) +d x_dtmax_L2andFo(3) = x(3) +d endif +d endif + +5111 Steps = Steps + 1 + + if (destiny.EQ.code_dtSmall) then ! n_dtsmall>maxBelowDtSmall + goto 555 + elseif (destiny.EQ.code_wand) then ! aufgeschlagen + radiusQuad = x(2)*x(2) + x(3)*x(3) ! -> den Ort berechnen, an + help1 = v(2)*v(2)+v(3)*v(3) ! dem das Teilchen auf- + help2 = x(2)*v(2)+x(3)*v(3) ! schlaegt + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_))-help2)/help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + goto 555 + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (Gebiet.EQ.upToExL2) then ! ----> noch innerhalb von Linse 2 + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_L2) then + destiny = code_wand + radiusQuad_ = radiusQuad_L2 + goto 5111 + endif + + if (x(1).LT.xEnterMap_L2andFo) then + if (v(1).LT.0) then ! reflektiert + destiny = code_reflektiert + goto 555 + else ! darf nicht sein! + write(*,*) + write(*,*)' L2: x(1).LT.xEnterMap .AND. v(1).GE.0. -> STOP' + write(*,*) + call exit + endif + elseif (x(1).GT.xEndLense_L2) then ! Verlasse L2 + Gebiet = upToEnTD + endif + + else ! ----> zw. Linse 2 und TD-Folie: + +c if (x(1).EQ.xLeaveMap_L2andFo) then ! Verlasse Mappe + if (reachedEndOfMap) then ! Verlasse Mappe + +c WRITE(*,*) 'HALLO: x(1).EQ.xLeaveMap_L2andFo !!' + ! ==================================================== + ! muss in Integrationsroutine richtig abgestimmt sein! + ! ==================================================== + + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + if (TriggerInBeam) then + ! rechne in Triggerkoordinaten um (Folie == x=0) + x(1) = 0 + goto 112 + else + goto bis_L3_Mappe + endif + endif + + if (radiusQuad.GT.radiusQuad_Rohr) then + destiny = code_wand + radiusQuad_ = radiusQuad_Rohr + goto 5111 + endif + + endif + + if (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + endif + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5011 ! naechster Integrationsschritt in gleicher Feldmappe + + endif ! if (lense2) then.... ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + + if (.NOT.TriggerInBeam) goto bis_L3_Mappe + + +c zwischen Koordinatenwechselebene und Triggerfolie: (feldfrei) +12 Gebiet = upToEnTD + +c Die Anweisungen dieses Abschnitts verlaufen in weiten Teilen parallel zu denen +c von Linse 1. -> Fuer Kommentare zu diesen Bereichen siehe dort! + + if (Beschl_Faktor_FO.EQ.0. .OR. gridInFrontOfFoil) then + ! => keine Integration in der Folienmappe + Steps = Steps + 1 + help1 = v(2)/v(1) ! Steigung der Bahn in der x-y-Ebene +d dtmin_FO = 0. +d dtmax_FO = 0. + +c - berechne Schnittpunkt der Trajektorie mit Ebene der Triggerfolie bzw. bei +c 'GridInFrontOfFoil' mit Ebene des Gitters vor der Triggerfolie: +c Folienebene : y'= (x_intersectTD - x') / Tan_alfaTD +c Trajektorie : y'= y + v(2)/v(1)*(x'-x) = y + help1*(x'-x) +c => Schnittpunkt: x'= (x_intersectTD/Tan_alfaTD - y + help1*x)/(help1 + 1/Tan_alfaTD) +c = (x_intersectTD + Tan_alfaTD*(help1*x-y))/(1+help1*Tan_alfaTD) +c (erste Gleichung hat Probleme bei Tan_alfaTD = 0!) + + if (atand(help1).EQ.alfaTD-90) then ! ueberpruefen<<<<<<<<<<<<<<<<<< + ! Teilchen fliegt parallel zur Folie => fliegt an TD vorbei + destiny = code_vorbei + goto 555 + else ! help2 == neues x(1) + if (Tan_alfaTD.EQ.0) then + dt = (x_intersectTD-x(1)) / v(1) + x(1) = x_intersectTD + else + help2 = (x_intersectTD+Tan_alfaTD* + + (help1*xChangeKoord-x(2)))/(1+help1*Tan_alfaTD) + if (help2.LT.xChangeKoord) then + ! Teilchen fliegt 'steiler' als Folienebene + ! -> kein Schnittpunkt mit dt.gt.0 => fliegt an TD vorbei + destiny = code_vorbei + goto 555 + else ! Bahntangente kreuzt Folienebene + dt = (help2-x(1)) / v(1) + x(1) = help2 + endif + endif + endif + +c -> Teilchenort in Folienebene bzw. bei 'GridInFrontOfFoil' in Ebene des +c geerdeten Gitters vor der Triggerfolie: + + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + +c Koordinatentransformation vom Kammersystem in das System des Triggerdetektors: +c (Ursprung in Folienmitte, x-Achse senkrecht zur Folie, y-Achse parallel zur +c Folie. Wenn der TD nicht verdreht ist, verlaufen die Achsen parallel zu +c denen des Kammersystems): + + if (alfaTD.NE.0) then + x(2) = (xTD-x(1))*Sin_alfaTD + x(2)*Cos_alfaTD + help1= v(1) ! zur Zwischenspeicherung + v(1) = help1*Cos_alfaTD + v(2)*Sin_alfaTD + v(2) = -help1*Sin_alfaTD + v(2)*Cos_alfaTD + endif + + if (.NOT.GridInFrontOfFoil) then + x(1) = 0 + else + ! -> berechne Schnittpunkt der Trajektorie mit Folienebene unter + ! der Annahme einer idealen Potentialrampe: + + if (aFoil.NE.0.) then + help1 = v(1)*v(1) + 2.*aFoil*(d_Grid_Folie) + if (help1.LT.0) then ! Reflektion noch vor Folie + dt = -2*v(1)/aFoil + t = t + dt + x(1) = - d_Grid_Folie + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + v(1) = -v(1) + destiny = code_reflektiert + goto 555 + endif + dt = (sqrt(help1) - v(1))/aFoil + ! (ergibt sich aus x=v*t+1/2*a*t**2 mit richtiger V.Z.-Wahl ('+')) + v(1) = v(1) + aFoil*dt + else + dt = d_Grid_Folie / v(1) + endif + + t = t + dt + x(1) = 0 ! im Triggersystem + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + endif ! if (GridInFrontOfFoil) ... + + goto 112 + +c............................................................................... + else ! (if Beschl_Faktor_FO.EQ.0 .OR. GridInFrontOfFoil) then ... + + ! => Integration in der Folienmappe: + ! alte Version: ab xChangeKoord wurde integriert, wobei das EFeld im + ! Bereich vor der Mappe als 0 zurueckgegeben wurde. + ! Ab Version 1.2.9: Bis Schnittpunkt der Trajektorie mit Beginn der + ! Potentialmappe wird extrapoliert, dann erst integriert: + + +c Einschub ab Version 1.2.9: *************************************************** + + Steps = Steps + 1 + help1 = v(2)/v(1) ! Steigung der Bahn in der x-y-Ebene + +c - berechne Schnittpunkt der Trajektorie mit Beginn der Potentialmappe: +c Mappenebene : y'= (x_intersectTDMap - x') / Tan_alfaTD +c Trajektorie : y'= y + v(2)/v(1)*(x'-x) = y + help1*(x'-x) +c => Schnittpunkt: x'= (x_intersectTDMap/Tan_alfaTD - y + help1*x)/(help1 + 1/Tan_alfaTD) +c = (x_intersectTDMap + Tan_alfaTD*(help1*x-y))/(1+help1*Tan_alfaTD) +c (erste Gleichung hat Probleme bei Tan_alfaTD = 0!) + + if (atand(help1).EQ.alfaTD-90) then ! ueberpruefen<<<<<<<<<<<<<<<<<< + ! Teilchen fliegt parallel zur Mappe => fliegt an TD vorbei + destiny = code_vorbei + goto 555 + + ! stimmt so u.U. noch nicht ganz. Kommt aber eigentlich eh nie vor! + ! (stimmt bis jetzt wohl nur fuer positive alpha(TD) + + else + if (Tan_alfaTD.EQ.0) then + dt = (x_intersectTDMap-x(1)) / v(1) + x(1) = x_intersectTDMap + else + ! help2 == neues x(1): + help2 = (x_intersectTDMap+Tan_alfaTD* + + (help1*xChangeKoord-x(2)))/(1+help1*Tan_alfaTD) + ! folgendes herauskommentiert, da es teilweise passierte, dass + ! der Mappenanfang ueber xChangekoord hinausreichte und die + ! Trajektorien dann faelschlicherweise abgebrochen worden sind. + +c if (help2.LT.xChangeKoord) then +c ! Teilchen fliegt 'steiler' als Mappenebene +c ! -> kein Schnittpunkt mit dt.gt.0 => fliegt an TD vorbei +c destiny = code_vorbei +c goto 555 +c else ! Bahntangente kreuzt Mappenebene + dt = (help2-x(1)) / v(1) + x(1) = help2 +c endif + endif + endif + +c -> Teilchenort in Mappenebene: + + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + +c Ende des Einschubes ab Version 1.2.9: **************************************** +c => Jetzt erfolgt Start in die Folienmappe: + + reachedEndOfMap = .false. ! Folienebene wurde noch nicht erreicht + dt = .5/v(1) ! 1. Testschritt 0.5 mm in x-Richtung + zaehler = 0 + + +c Rechne in Folienmappen-Koordinaten um: + +5012 if (alfaTD.NE.0) then + help1= x(1)-xTD + x(1) = help1*Cos_alfaTD + x(2)*Sin_alfaTD + length1 + x(2) = -help1*Sin_alfaTD + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD + v(2)*Sin_alfaTd + v(2) = -help1*Sin_alfaTD + v(2)*Cos_alfaTd + else + x(1) = x(1) - length2 + endif + + +c mache Integrationssschritt: + + call INTEGRATIONSSTEP_RUNGE_KUTTA_FO(dt) + +d if (NTP_steps) then +d if (dt.LT.dtmin_FO) then +d dtmin_FO = dt +d x_dtmin_FO(1) = x(1) +d x_dtmin_FO(2) = x(2) +d x_dtmin_FO(3) = x(3) +d endif +d if (dt.GT.dtmax_FO) then +d dtmax_FO = dt +d x_dtmax_FO(1) = x(1) +d x_dtmax_FO(2) = x(2) +d x_dtmax_FO(3) = x(3) +d endif +d endif + + +c Rechne in Kammerkoordinaten zurueck: + + if (alfaTD.NE.0) then + help1= x(1)-length1 + x(1) = help1*Cos_alfaTD - x(2)*Sin_alfaTD + xTD + x(2) = help1*Sin_alfaTD + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + length2 + endif + + Steps = Steps + 1 ! neuer Ort, Zeit und Geschwindigkeit sind festgelegt + +c do some tests: + + if (destiny.EQ.code_dtSmall) then ! n_dtSmall>maxBelowDtSmall + goto 555 + endif + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then ! aufgeschlagen + help1 = v(2)*v(2)+v(3)*v(3) ! -> den Ort berechnen, an + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (destiny.EQ.code_reflektiert) then ! reflektiert + goto 555 +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'FO-1: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + elseif (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + endif + if (reachedEndOfMap) then ! Folienebene erreicht + ! rechne in Triggerkoordinaten um (Folie == x=0) + if (alfaTD.NE.0) then + x(2) = (xTD-x(1))*Sin_alfaTD + x(2)*Cos_alfaTD + help1= v(1) ! zur Zwischenspeicherung + v(1) = help1*Cos_alfaTD + v(2)*Sin_alfaTD + v(2) = -help1*Sin_alfaTD + v(2)*Cos_alfaTD + endif + x(1) = 0 + goto 112 + endif + +c verarbeite alle 'imonitor' Schritte die Koordinaten fuer GRAPHICS und DEBUG: + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5012 ! naechster Integrationsschritt in FELD VOR FOLIE + +c............................................................................... + endif ! (if Beschl_Faktor_FO.EQ.0) then ... + +c Einsprunglabel fuer Starts auf der Triggerfolie mit Startwinkelangaben +c im Kammersystem => transformiere Geschwindigkeitsvektor in das Triggersystem: + +111 if (alfaTD.NE.0) then + help1= v(1) ! zur Zwischenspeicherung + v(1) = help1*Cos_alfaTD + v(2)*Sin_alfaTD + v(2) = -help1*Sin_alfaTD + v(2)*Cos_alfaTD + endif + + +c - pruefe, ob das Projektil die Folie trifft: + +112 radiusQuad = x(2)*x(2) + x(3)*x(3) + If (radiusQuad.GT.radiusQuad_Folie) then + ! zurueckrechnen in das Kammersystem: + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + + destiny = code_vorbei + goto 555 + endif + + +c So verlangt, schreibe die aktuellen Trajektoriengroessen in das 'FoilFile': +c (hier ist sichergestellt, dass die Folie getroffen worden ist, Wechsel- +c wirkungen mit der Folie wurden aber noch nicht beruecksichtigt). +c HIER WERDEN 'X' UND 'V' IM TRIGGERSYSTEM ABGESPEICHERT! + + if (createFoilFile) then + ! falls die Flugzeit bis zur Triggerfolie verschmiert in das + ! NTupel aufgenommen werden soll: + if (smearS1Fo) then + call Gauss_Verteilung(sigmaS1Fo,help4) + S1FoOnly = t + help4 + endif + if (NTP_stop) then + Ekin=(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))*Energie_Faktor + endif + call HFNT(NTP_write) + NTPalreadyWritten = .true. + endif + + +c - Zeitpunkt bei Erreichen der Folie sichern: + +113 S1Fo = t + if (createNTP.AND.Fo_triggered) fill_NTP = .true. + if (statNeeded(Nr_S1Fo)) call fill_statMem(S1Fo,Nr_S1Fo) + + + +c - Speichern der Koordinaten fuer die Statistiken: + + if (statNeeded(Nr_y_Fo)) then + call fill_statMem( x(2),Nr_y_Fo) + endif + if (statNeeded(Nr_z_Fo)) then + call fill_statMem( x(3),Nr_z_Fo) + endif + if (statNeeded(Nr_r_Fo)) then + radius = SQRT(x(2)*x(2) + x(3)*x(3)) + call fill_statMem(radius,Nr_r_Fo) + endif + + +c - speichere Auftreffort des Projektils fuer die Berechnung der Folienelektronen: + + if (generate_FE) then + x0FE(1) = x(1) + x0FE(2) = x(2) + x0FE(3) = x(3) + endif + + +c - falls nur bis zur Folie gerechnet werden soll, beende hier die Integration: + + if (upToTDFoilOnly) then + ! zurueckrechnen in das Kammersystem: + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + if (generate_FE) Gebiet = UpToExTD + goto 555 + endif + + +c - pruefe, ob das Projektil auf das Stuetzgitter aufschlaegt: + + if (testOnWireHit .AND. ran(seed).GT.TransTDFoil) then + destiny = code_Stuetzgitter + ! zurueckrechnen in das Kammersystem: + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + goto 555 + endif + + +c - Energieverlust und Winkelaufstreuung: + + if (log_E_Verlust .OR. log_Aufstreu) then + if (Debug_) then + Steps = Steps + 1 + call Output_Debug + endif + v_square = v(1)*v(1) + v(2)*v(2) + v(3)*v(3) + v_Betrag = SQRT(v_square) + Ekin = v_square * Energie_Faktor + endif + +c -- Energieverlust (vorerst nur Gaussverteilt): + + if (log_E_Verlust_defined.OR.log_Meyer_Gauss) then + ! Berechne Bahnwinkel relativ zur Folienebene fuer effektive Folien- + ! dicke: + alfa = atand(SQRT(v(2)*v(2)+v(3)*v(3))/v(1)) + endif + + if (log_E_Verlust) then + if (calculate_each) then + call CALC_ELOSS_ICRU(Ekin,q,m,Thickness,E_Verlust) + else + E_Verlust = mean_E_Verlust + endif + if (log_E_Verlust_defined) E_Verlust = E_Verlust / cosd(alfa) + if (debug_) write (lunLOG,*) ' mittlerer Energieverlust: ',E_Verlust + + ! Now we have the mean energy loss. We still have to modify it + ! according to the distribution of energy losses, i.e. + ! E_Verlust -> E_Verlust + delta_E_Verlust: + + delta_E_Verlust = 0. + if (log_E_Straggling_sigma) then +400 call Gauss_Verteilung(sigmaE,delta_E_Verlust) + if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust + if (E_Verlust+delta_E_Verlust.LT.0.) goto 400 + elseif (log_E_Straggling_equal) then +410 delta_E_Verlust = lowerE + (upperE - lowerE)*ran(seed) + if (E_Verlust+delta_E_Verlust.LT.0) goto 410 + elseif (log_E_Straggling_Lindhard) then + ! Streuung in Abhaengigkeit von mittlerer Energie in Folie: + call E_Straggling_Lindhard(Ekin-0.5*E_Verlust,m,sigmaE) +420 call Gauss_Verteilung(sigmaE,delta_E_Verlust) + if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust + if (E_Verlust+delta_E_Verlust.LT.0.) goto 420 + elseif (log_E_Straggling_Yang) then + ! Streuung in Abhaengigkeit von mittlerer Energie in Folie! + call E_Straggling_Yang(Ekin-0.5*E_Verlust,m,sigmaE) +430 call Gauss_Verteilung(sigmaE,delta_E_Verlust) + if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust + if (E_Verlust+delta_E_Verlust.LT.0.) goto 430 + endif + + if (E_Verlust+delta_E_Verlust.GE.Ekin) then + destiny = code_stopped_in_foil + goto 555 + endif + E_Verlust = E_Verlust + delta_E_Verlust + + ! help1 == Reduzierungsfaktor fuer Geschw.Betrag + help1 = sqrt( (Ekin - E_Verlust)/Ekin ) + v(1) = help1 * v(1) + v(2) = help1 * v(2) + v(3) = help1 * v(3) + v_Betrag = help1 * v_Betrag + if (debug_) write (lunLOG,*) ' Energieverlust: ',E_Verlust + endif + +c -- Winkelaufstreuung (vorerst nur Gaussverteilt): + + if (log_aufstreu) then + if (log_Meyer_F_Function) then + call throwMeyerAngle(thetaAufstreu) + else + if (log_Meyer_Gauss) then + if (log_E_Verlust) Ekin = Ekin - .5 * E_Verlust ! mittlere Energie + effRedThick = Meyer_Faktor1 * Thickness / cosd(alfa) + call g_Functions(g1,g2,effRedThick) + sigmaAufstreu = Meyer_Faktor2 / Ekin * (g1 + Meyer_Faktor3*g2) + if (debug_) then + write (lunLOG,*) ' effekt. red. Dicke: ',effRedThick + write (lunLOG,*) ' Sigma(Streuwinkel): ',sigmaAufstreu + endif + endif + + call Gauss_Verteilung_theta(sigmaAufstreu,thetaAufstreu) + endif + + st0 = sind(thetaAufstreu) + ct0 = cosd(thetaAufstreu) + phiAufstreu = 360.*ran(seed) + + v_xy = SQRT(v(1)*v(1) + v(2)*v(2)) ! v_xy stets groesser 0 + ! wegen v(1)>0 + + help1 = v(1) + help2 = v(2) + help3 = v_Betrag*st0*cosd(phiAufstreu)/v_xy + help4 = st0*sind(phiAufstreu) + + v(1) = ct0*help1 - help3*help2 - help4*help1*v(3)/v_xy + v(2) = ct0*help2 + help3*help1 - help4*help2*v(3)/v_xy + v(3) = ct0*v(3) + help4*v_xy + if (debug_) write (lunLOG,*) ' Aufstreuung: theta, phi =', + + thetaAufstreu,phiAufstreu + endif + + if (Debug_ .AND. (log_E_Verlust .OR. log_Aufstreu)) then + call Output_Debug + endif + + +c - Neutralisierung in der Folie? + + if (log_neutralize) then + if (neutral_fract(q_).EQ.-1.0) then + v_square = v(1)*v(1) + v(2)*v(2) + v(3)*v(3) + Ekin = v_square * Energie_Faktor + call chargeStateYields(Ekin,m,YieldPlus,YieldNeutral) + YieldNeutral = 100. * YieldNeutral + else + YieldNeutral = neutral_fract(q_) + endif + if (100.*ran(seed).LE.YieldNeutral) then + q = 0. + qInt = 0 + if (debug_) then + write (lunLOG,*) ' Teilchen wurde neutralisiert' + endif + nNeutral = nNeutral + 1 + else + nCharged = nCharged + 1 + endif + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c im TriggerDetektor: (homogene Felder) + + +13 Gebiet = upToExTD + Steps = Steps + 1 + +c der Weg des Projektils innerhalb der Triggerkammer: + + call TRIGGER(m,q,t,x,v,Debug_,graphics_,n_return) + + +c Koordinatentransformation vom System des Triggerdetektors in das Kammersystem: +c ('d_Achse_Ground' == Abstand zwischen TD-Achse und 'Ground'-Gitter) + + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + + +c Was ist im TD mit dem Teilchen passiert? + + if (n_return.NE.0) then ! -->> das Projektil kam nicht bei GROUND an + if (n_return.GT.100 .AND. n_return.LE.120) then ! -> abgebrochen + statTD(1,n_return-100) = statTD(1,n_return-100)+1 ! Grund notieren + destiny = code_lostInTD ! im TD verloren + elseif (n_return.GT.0..AND.n_return.LE.75) then ! -> pfosten getroffen! + pfostenHit(n_return,1) = pfostenHit(n_return,1)+1 + destiny = code_wand + elseif (n_return.EQ.-5) then ! -> im TD auf Gitterstab + statTD(1,17) = statTD(1,17)+1 ! + destiny = code_grid + elseif (n_return.EQ.-9) then ! -> NICHT im MCP3 registriert + statTD(1,18) = statTD(1,18)+1 ! + destiny = code_notRegInM3 + elseif (n_return.EQ.-10) then ! -> im MCP3 registriert + statTD(1,16) = statTD(1,16)+1 ! '16' zaehlt MCP3-Treffer + destiny = code_wand + endif + goto 555 ! naechstes Projektil + else ! -->> das Projektil kam bei GROUND an + statTD(1,15) = statTD(1,15)+1 ! '15' zaehlt GROUND-Treffer + endif + + if (useDecay_) call Decay_Test(*555) + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen KOORDINATENWECHSEL BZW. GROUND-GITTER und Beginn der L3-Mappe: +c (feldfrei) + +14 Gebiet = upToL3Map + Steps = Steps + 1 + + dt = (xEnterMap_L3 - x(1)) / V(1) + t = t + dt + x(1) = xEnterMap_L3 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + + if (radiusQuad.GT.radiusQuad_L3) then ! Teilchen fliegt an L3 vorbei + destiny = code_vorbei + goto 555 + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c innerhalb L3: (inhom. Felder -> Integrationen) + + +15 Gebiet = upToExL3 ! Gebietsnummer fuer L3 setzen + +c Die Anweisungen dieses Abschnitts verlaufen analog zu denen +c von Linse 1. -> Fuer Kommentare siehe dort! + + if (Beschl_Faktor_L3.EQ.0. .OR. q.EQ.0) then ! q=0 -> in Folie neutralisiert +d dtmax_L3 = 0. +d dtmin_L3 = 0. + dt = (xLeaveMap_L3 - x(1)) / v(1) ! Zeit bis zum Mappenende + x(1) = xLeaveMap_L3 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_L3) destiny = code_wand + goto 5115 + endif + + dt = .5/v(1) + zaehler = 0 + +5015 call INTEGRATIONSSTEP_RUNGE_KUTTA_L3(dt) +d if (NTP_steps) then +d if (dt.LT.dtmin_L3) then +d dtmin_L3 = dt +d x_dtmin_L3(1) = x(1) +d x_dtmin_L3(2) = x(2) +d x_dtmin_L3(3) = x(3) +d endif +d if (dt.GT.dtmax_L3) then +d dtmax_L3 = dt +d x_dtmax_L3(1) = x(1) +d x_dtmax_L3(2) = x(2) +d x_dtmax_L3(3) = x(3) +d endif +d endif + +5115 Steps = Steps + 1 + + if (destiny.EQ.code_dtSmall) then ! n_dtsmall>maxBelowDtSmall + goto 555 + elseif (destiny.EQ.code_wand) then ! aufgeschlagen + radiusQuad = x(2)*x(2) + x(3)*x(3) ! -> den Ort berechnen, an + help1 = v(2)*v(2)+v(3)*v(3) ! dem das Teilchen auf- + help2 = x(2)*v(2)+x(3)*v(3) ! schlaegt + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_L3))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + goto 555 +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'L3-1: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (x(1).LT.xEnterMap_L3) then + if (v(1).LT.0) then ! reflektiert? + destiny = code_reflektiert + goto 555 + else ! darf nicht sein! + write(*,*) + write(*,*)' L3: x(1).LT.xEnterMap .AND. v(1).GE.0. -> STOP' + write(*,*) + STOP + endif + elseif (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + elseif (x(1).GE.xLeaveMap_L3) then ! Verlasse L3 + dt = (xLeaveMap_L3 - x(1))/v(1) ! rechne zurueck auf exaktes + t = t + dt ! Mappenende + x(1) = xLeaveMap_L3 + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + goto bis_MCP2_Mappe +c elseif (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'L3-2: ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP + endif + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5015 ! naechster Integrationsschritt in gleicher Feldmappe + + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c zwischen L3-Mappe und MCP2-Mappe (feldfrei) + + +16 Gebiet = upToM2Map + + if (x(1).EQ.xEnterMap_M2) goto MCP2_Mappe + Steps = Steps + 1 + + dt = (xEnterMap_M2 - x(1)) / v(1) + + t = t + dt + x(1) = xEnterMap_M2 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + help1 = v(2)*v(2)+v(3)*v(3) + help2 = x(2)*v(2)+x(3)*v(3) + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) ! den Ort berechnen, an dem + x(2) = x(2) + dt*v(2) ! das Teilchen auf das Rohr + x(3) = x(3) + dt*v(3) ! aufschlaegt + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_wand + goto 555 + endif + if (useDecay_) call Decay_Test(*555) + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +c vor MCP2: (inhom. Felder -> Integrationen) + +17 Gebiet = upToMCP2 + +c Beruecksichtige gegebenenfalls die Flugzeit in 'delta_L2', welches 'vor dem +c MCP2' eingeschoben werden kann. Addiert wird vorerst nur die Flugzeit in +c dieser zusaetzlichen Flugstrecke. Korrekterweise muessten alle nachfolgenden +c Positionen um 'delta_L2' verschoben werden. Dies zu implementieren ist +c allerdings momentan aus Zeitgruenden nicht moeglich. + + dt = Delta_L2 / v(1) + t = t + dt + + +c Die Anweisungen dieses Abschnitts verlaufen analog zu denen +c von Linse 1. -> Fuer Kommentare siehe dort! + + if (Beschl_Faktor_M2.EQ.0. .OR. q.EQ.0) then ! q=0 -> in Folie neutralisiert +d dtmax_M2 = 0. +d dtmin_M2 = 0. + if (xBlende.GT.x(1)) then + dt = (xBlende - x(1)) / v(1) ! Zeit bis zur Blende + x(1) = xBlende + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) then + destiny = code_wand + elseif (radiusQuad.GE.radiusQuad_Blende) then + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + destiny = code_hitBlende + goto 555 + endif + endif + dt = (xMCP2 - x(1)) / v(1) ! Zeit bis MCP2 + x(1) = xMCP2 + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GT.radiusQuad_Rohr) destiny = code_wand + reachedEndOfMap = .true. + goto 5117 + endif + + dt = .5/v(1) + + reachedEndOfMap = .false. + zaehler = 0 + if (xBlende.GT.0) check_Blende = .true. + +5017 call INTEGRATIONSSTEP_RUNGE_KUTTA_M2(dt) +d if (NTP_steps) then +d if (dt.LT.dtmin_M2) then +d dtmin_M2 = dt +d x_dtmin_M2(1) = x(1) +d x_dtmin_M2(2) = x(2) +d x_dtmin_M2(3) = x(3) +d endif +d if (dt.GT.dtmax_M2) then +d dtmax_M2 = dt +d x_dtmax_M2(1) = x(1) +d x_dtmax_M2(2) = x(2) +d x_dtmax_M2(3) = x(3) +d endif +d endif + +5117 Steps = Steps + 1 + + if (destiny.EQ.code_dtSmall) then ! n_dtsmall>maxBelowDtSmall + goto 555 + elseif (check_Blende.AND.x(1).GE.xBlende) then + dt = (xBlende - x(1)) / v(1) ! zurueck zur Blende ... + x(1) = xBlende + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + radiusQuad = x(2)*x(2) + x(3)*x(3) + if (radiusQuad.GE.radiusQuad_Blende) then + destiny = code_hitBlende + goto 555 + endif + dt = -dt ! ... wieder zum aktuellen Ort + x(1) = xBlende + v(1)*dt + x(2) = x(2) + v(2)*dt + x(3) = x(3) + v(3)*dt + t = t + dt + check_Blende = .false. + elseif (destiny.EQ.code_wand) then + radiusQuad = x(2)*x(2) + x(3)*x(3) ! -> den Ort berechnen, an + help1 = v(2)*v(2)+v(3)*v(3) ! dem das Teilchen auf- + help2 = x(2)*v(2)+x(3)*v(3) ! schlaegt + dt = (SQRT(help2*help2-help1*(radiusQuad-radiusQuad_Rohr))-help2) + + /help1 + t = t + dt + x(1) = x(1) + dt*v(1) + x(2) = x(2) + dt*v(2) + x(3) = x(3) + dt*v(3) + if (useDecay_) call Decay_Test(*555) ! vor Aufschlag zerfallen? + goto 555 + elseif (useDecay_) then ! zerfallen? + call Decay_Test(*555) + endif + + if (destiny.EQ.code_reflektiert) then ! reflektiert + goto 555 + elseif (reachedEndOfMap) then ! MCP2-Ebene erreicht +c if (destiny.NE.code_ok) then ! voruebergehend fuer Testzwecke +c write(*,*) +c write(*,*)'M2 ''destiny.NE.code_ok'' where it should -> STOP' +c write(*,*)' destiny = ',destiny,': ',code_text(destiny) +c write(*,*) +c STOP +c endif + if (createNTP.AND.xM2_triggered) fill_NTP = .true. + S1xM2 = t + if (statNeeded(Nr_S1xM2))call fill_statMem(S1xM2,Nr_S1xM2) + radiusQuad = x(2)*x(2) + x(3)*x(3) + radius = SQRT(radiusQuad) + if (statNeeded(Nr_y_xM2)) call fill_statMem( x(2),Nr_y_xM2) + if (statNeeded(Nr_z_xM2)) call fill_statMem( x(3),Nr_z_xM2) + if (statNeeded(Nr_r_xM2)) call fill_statMem(radius,Nr_r_xM2) + if (radiusQuad.LE.radiusQuad_MCP2active) then + S1M2 = t ! Zeiten werden sowohl fuer Statistiken + FoM2 = t - S1Fo ! als auch fuer NTupel benoetigt + if (statNeeded(Nr_S1M2)) call fill_statMem(S1M2,Nr_S1M2) + if (statNeeded(Nr_FoM2)) call fill_statMem(FoM2,Nr_FoM2) + if (createNTP.AND.M2_triggered) fill_NTP = .true. + if (statNeeded(Nr_y_M2)) call fill_statMem( x(2),Nr_y_M2) + if (statNeeded(Nr_z_M2)) call fill_statMem( x(3),Nr_z_M2) + if (statNeeded(Nr_r_M2)) call fill_statMem(radius,Nr_r_M2) + else ! am MCP2 vorbei + if (radiusQuad.LE.radiusQuad_MCP2) then + destiny = code_hitMCP2inactive + else + destiny = code_vorbei + if (Graphics_) then ! Damit diese Trajektorie 40mm ueber die + nKoord = nKoord + 1 ! MCP2-Ebene hinausgezeichnet wird + dt = 40./v(1) + t = t + dt + xKoord(nKoord) = x(1)+40. + yKoord(nKoord) = x(2)+v(2)*dt + zKoord(nKoord) = x(3)+v(3)*dt + goto 556 + endif + endif + endif + + goto 555 + elseif (Steps.GE.MaxStep) then ! Teilchen verloren + destiny = code_lost + goto 555 + endif + + if (GRAPHICS_.or.Debug_) then + zaehler = zaehler + 1 + if (zaehler.EQ.iMonitor) then + if (Graphics_) call Save_Graphics_Koord + if (Debug_) call Output_Debug + zaehler = 0 + endif + endif + + goto 5017 ! naechster Integrationsschritt im Feld vor MCP2 + + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c HIER IST DER PROGRAMMKODE FUER DIE TRAJEKTORIENBERECHNUNG +c DER PROJEKTILE BEENDET! +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + +555 if (Graphics_) call Save_Graphics_Koord +556 if (Debug_) call Output_Debug + + +c Gib Trajektorie in Graphikfenster aus: + + if (Graphics_) then + if (Gebiet.LE.upToChKoord) then ! Bahnberechnung wurde vor + call plot_horizontal ! Koordinatenwechsel abgebrochen + if (schnitt_p.eq.1) call schnitt + else + call plot_vertikal + if (schnitt_p.eq.2) call schnitt + endif + nKoord = 0 + endif + + +c Pruefe, ob Teilchen reflektiert wurde: + + if ((Gebiet.EQ.upToExL1 .OR. Gebiet.EQ.upToEnTD .OR. + + Gebiet.EQ.upToExL3 .OR. Gebiet.EQ.upToMCP2) .AND. + + v(1).LE.0.) then + destiny = code_reflektiert + endif + + +c Zaehle mit, bei wie vielen Teilchen trotz dtMaxStep abgebrochen werden: + + if (destiny.EQ.code_lostInTD) then + lostInTD_counter = lostInTD_counter + 1 + elseif (destiny.EQ.code_lost) then + lost_counter = lost_counter + 1 + endif + + +c bei DEBUG: Ausgabe des Teilchenschicksals und des aktuellen Gebiets: + + if (debug_) then + indx = index(code_text(destiny),':') + if (indx.EQ.0) then + write(lun(1),*) 'destiny : ',code_text(destiny) + else + write(lun(1),*) 'destiny : ',code_text(destiny)(1:indx-1) + endif + indx = index(Gebiet_text(Gebiet),':') + if (indx.EQ.0) then + write(lun(1),*) 'Gebiet : ',Gebiet_text(Gebiet) + else + write(lun(1),*) 'Gebiet : ',Gebiet_text(Gebiet)(1:indx-1) + endif + endif + + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c HIER STARTEN DIE FOLIENELEKTRONEN +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + + if (generate_FE) then ! ~~~ 1: if ~~~~~~~~~~~~ + if (Gebiet.GE.UpToExTD) then ! ~~~ 2: if ~~~~~~~~~~~~ + +c sekundaerelektronen + nFE = int(4.*ran(seed))+2 ! Anzahl wuerfeln: [2,5] + tFE_min = 0. ! tFE_min: kuerzeste FE-Flugzeit: + ! bekam noch keinen Wert zugewiesen + +c - die Laufzeiten der Folienelektronen: +c +c---------------------------------------- +c +c-TP-10/2000 reset of end positions of electrons +c + do k = 1, 3 + xFE_MCP(k) = 0. + yFE_MCP(k) = 0. + zFE_MCP(k) = 0. + enddo +c +c---------------------------------------- +c + + do 450, k = 1, nFE + + xFE(1) = x0FE(1) + xFE(2) = x0FE(2) + xFE(3) = x0FE(3) + + E0FE = 0.003*ran(seed) ! Start-Energie wuerfeln: [0,3) eV + v_Betrag = sqrt(2.*E0FE/511.015)*c ! Startgeschwindigkeit + call Lambert_Verteilung(1.,ct0,st0) ! Startwinkel wuerfeln + f0 = 360.*ran(seed) + cf0 = cosd(f0) + sf0 = sind(f0) + vFE(1) = v_Betrag * ct0 ! Geschwindigkeitskomponenten + vFE(2) = v_Betrag * st0*cf0 + vFE(3) = v_Betrag * st0*sf0 + + tFE = 0. + + nKoord = 0 + start_nr(2) = start_nr(2) + 1 ! (2): FE + call TRIGGER(511.015,-1.,tFE,xFE,vFE,DEBUG_FE.AND.Debug_, + + plot_FE,n_return) + if (plot_FE) call plot_vertikal + + if (n_return.NE.-10) then +C - das FE kam nicht am MCP3 an -> + if (n_return.GT.100 .AND. n_return.LE.120) then ! -> abgebrochen + statTD(2,n_return-100) = statTD(2,n_return-100)+1 ! Grund notieren + elseif (n_return.GT.0 .AND. n_return.LE.75) then ! -> pfosten getroffen! + pfostenHit(n_return,2) = pfostenHit(n_return,2)+1 + elseif (n_return.EQ.0) then ! -> GROUND getroffen + statTD(2,15) = statTD(2,15)+1 ! '15' zaehlt GROUND-Treffer + elseif (n_return.EQ.-5) then ! -> im TD auf Gitterstab + statTD(2,17) = statTD(2,17)+1 + elseif (n_return.EQ.-9) then ! -> NICHT im MCP3 registriert + statTD(2,18) = statTD(2,18)+1 + endif + tFE_(k) = -1 ! -1: FE kam nicht bei MCP3 an +c +c--------------------------------------- +c +c-TP-10/2000 +c + xFE_MCP(k) = -100. + yFE_MCP(k) = -100. + zFE_MCP(k) = -100. +c +c--------------------------------------- +c + goto 450 ! naechstes FE + + endif + +c - das FE kam beim MCP3 an -> + + statTD(2,16) = statTD(2,16)+1 ! '16' zaehlt MCP3-Treffer + tFE_(k)=int(1000.*tFE) ! tFE in ps. (braucht als Integer + ! weniger Speicherplatz) +c +c--------------------------------------- +c +c-TP-10/2000 +c + xFE_MCP(k) = xFE(1) + yFE_MCP(k) = xFE(2) + zFE_MCP(k) = xFE(3) +c +c--------------------------------------- +c + + + +c fuer die Statistik: die Flugzeiten saemtlicher das MCP3 erreichender FE abspeichern: + + if (statNeeded(Nr_t_FE)) call fill_statMem(tFE,Nr_t_FE) + + +c kuerzeste Elektronenflugzeit fuer das aktuelle Projektilteilchen notieren: + + if (tFE_min.EQ.0. .OR. tFE.LT.tFE_min) tFE_min = tFE + + +450 continue ! -> naechstes Folienelektron + + +c die Flugzeiten der nicht gestartenen Folienelektronen (nFE+1 bis 5) auf 0. setzen: + + do while (nFE.LT.5) + nFE = nFE + 1 + tFE_(nFE) = 0. + enddo + + +c Jetzt sind die Folienelektronen durchgelaufen. + +c Fuelle Statistiken fuer die 'gemessenen' Teilchenflugzeiten (mit Beruecksichti- +c gung der Flugzeiten der Folienelektronen). M3M2 aber nur, wenn MCP2 auch +c getroffen wurde: + + if (tFE_min.NE.0.) then + S1M3 = S1Fo + tFE_min ! +, da Stop verzoegert + if (statNeeded(Nr_S1M3)) then + call fill_statMem(S1M3,Nr_S1M3) + endif + if (destiny.EQ.code_ok) then + M3M2 = FoM2 - tFE_min ! -, da Start verzoegert + if (statNeeded(Nr_M3M2)) call fill_statMem(M3M2,Nr_M3M2) + endif + endif + + else ! ~~~ 2: else ~~~~~~~~~~ + + do k= 1, 5 + tFE_(k) = 0. ! nicht gestartet + enddo + + endif ! ~~~ 2: endif ~~~~~~~~~ + endif ! ~~~ 1: endif~~~~~~~~~~ + +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +c ES FOLGEN DATENAUSGABE, SPRUNG IN NEUE SCHLEIFE UND PROGRAMMENDE +czzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz + +c trage das NTupel ein: + +c So verlangt, schreibe die aktuellen Trajektoriengroessen in das NTupel: +c (falls bei 'createFoilFile' 'NTPalreadyWritten' nicht gesetzt ist schied +c dieses Teilchen schon vor der Triggerfolie aus. Ist es dagegen gesetzt wurden +c die Trajektoriendaten mit dem Erreichen der Triggerfolie abgespeichert um sie +c in den im Triggersystem gueltigen Werten zu haben): + + if (fill_NTP .OR. createFoilFile) then + if (NTPalreadyWritten) then + NTPalreadyWritten = .false. + else + if (NTP_stop) then + Ekin=(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))*Energie_Faktor + endif + if (smearS1Fo .AND. .NOT.use_MUTRACK) then + if (s1fo.NE.0) then + call Gauss_Verteilung(sigmaS1Fo,help4) + S1FoOnly = S1Fo + help4 + else + S1FoOnly = 0. + endif + endif + FoM2Only = FoM2 + call HFNT(NTP_write) + endif + endif + + +c Nimm das Schicksal des Teilchens in den zugehoerigen Statistikspeicher auf: + + if (destiny.GT.0) destiny = destiny + (Gebiet-1)*highest_code_Nr + statDestiny(destiny) = statDestiny(destiny) + 1 + + if (destiny.EQ.code_ok) okStepsCounter = okStepsCounter + steps + + +c -> das naechste Projektil kann kommen +100 continue + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Jetzt sind alle Projektile dieser Schleife abgearbeitet! + +c Mittlere Anzahl an Integrationsschritten fuer Trajektorien mit destiny = +c 'code_ok' ausgeben: + + if (statDestiny(code_ok).NE.0) then + write(*,'(6x,A,F7.2)')'Mittlere Anzahl an Integrationsschritten bis zum Ziel: ', + + real(okStepsCounter)/real(statDestiny(code_ok)) + endif + +c das Summary ausgeben und die Werte in die Tabellen schreiben: +c Falls nur ein Teilchenstart pro Schleife erfolgt, werte die Statistiken +c erst nach der letzten Schleife aus: + + NotLastLoop = .NOT.(SchleifenNr.EQ.SchleifenZahl) + flag_ok = .NOT.(OneStartPerLoop.AND.NotLastLoop) + + if (flag_ok) then + call eval_statistics + if (n_outWhere.GT.0 .OR. smallLogFile) call Summary + if (createTabellen .or. createPhysTab) call output_tabellen + endif + + +c das PostScript-file erstellen: + +c Wird pro Schleife nur ein Teilchen gestartet ('OneStartPerLoop'; d.h. kein +c oder genau ein 'Zufallsstart'), so trage alle Trajektorien in die gleiche +c Graphik ein. Das Postskript braucht dann also erst bei der letzten Schleife +c erstellt zu werden: + + if (GRAPHICS .AND. flag_ok) then + call schnitt_plot ! Ausgabe der Graphik der Schnittebene + + if (n_postSkript.LE.0) then + goto 620 + elseif (n_postSkript.EQ.1) then + if (n_outWhere.LT.2) then + write(*,*)'.....................................'// + + '.........................................' + write(*,'(2X,A18,I3,A,I3)')'Schleife ', + + SchleifenNr,' von ',SchleifenZahl + endif + write(*,1003)'(P) Ps-file erstellen', + + '(R) Restliche ps-files erstellen' + write(*,1003)'(N) ps-file Nicht erstellen', + + '(K) Keine ps-files mehr erstellen' + write(*,1003)'(G) Graphikausgabe beenden', + + '(A) programm Abbrechen' +1003 format(T6,A,T40,A) + + helpChar = 'n' +600 write(*,1004)' [RETURN] = (N) -> ' +1004 format($,x,A) + read(*,'(A)') helpChar + + do i = 1,7 ! bis zu sechs blanks werden akzeptiert + ant = helpChar(i:i) + if (ant.NE.' ') goto 610 + enddo + ant = 'N' + +610 write(*,*)'==========================='// + + '=====================================================' + + call str$upcase(ant,ant) + if (ant.EQ.'N') then + goto 620 + elseif (ant.EQ.'R') then + n_postSkript = 2 + elseif (ant.EQ.'K') then + n_postSkript = 0 + goto 620 + elseif (ant.EQ.'G') then + call HPLEND + GRAPHICS = .false. + goto 200 + elseif (ant.EQ.'A') then + call HPLEND + call TERMINATE_OUTPUT + STOP + elseif (ant.NE.'P') then + goto 600 + endif + endif + + write (helpChar(1:7),'(''_'',I6)') SchleifenNr + if (filename.NE.' ') then + call MAKE_PS(filename//helpChar) + else + call MAKE_PS('MUTRACK'//helpChar) + endif + + +620 continue + + CALL IZPICT ('CHAM_1','S') ! LOESCHEN DER BILDER IM PAWC-COMMON-BLOCK + CALL IZPICT ('CHAM_2','S') + CALL IZPICT ('HISTO','S') + CALL IZPICT ('TEXT','S') + + call iclrwk (1,flag_ok) ! CLEAREN DER WORKSTATIONS + call iclrwk (3,flag_ok) + call iclrwk (4,flag_ok) + call iclrwk (5,flag_ok) + + CALL HRESET (50,' ') ! RESETTEN DES HISTOGRAMMS + + endif + +c -> das gleiche von vorne mit neuen Settings (d.h. neue Schleife) + +200 continue +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + +c Jetzt sind alle Schleifen abgearbeitet -> fertigmachen zum Programmende: + +c - HIGZ-Graphikbibliothek schliessen: + + if (Graphics) call HPLEND + +c - HBOOK-Datei schliessen: + + if (.NOT.fromScratch) then + if (use_ACCEL) then + call HREND('ACCEL') + elseif (Use_MUTRACK) then + call HREND('MUread') + endif + close (lunRead) + endif + + call TERMINATE_OUTPUT + + + END + + +C=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Lambert_Verteilung(n_Lambert,cos_theta,sin_theta) +c ============================================================ + + IMPLICIT NONE + + real cos_theta,sin_theta + + real n_Lambert ! Ordnung der Lambert-Verteilung + real randomVar + integer seed + common /seed/ seed + + randomVar = ran(seed) + + if (n_Lambert.EQ.0.) then + cos_theta = (1.-randomVar) + sin_theta = sqrt(1.-cos_theta*cos_theta) + elseif (n_Lambert.EQ.1.) then + cos_theta = sqrt(1.-randomVar) + sin_theta = sqrt(randomVar) + else + cos_theta = (1.-randomVar)**(1./(n_Lambert + 1)) + sin_theta = sqrt(1.-cos_theta*cos_theta) + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Gauss_Verteilung(sigma,wert) +c ======================================= + + IMPLICIT NONE + + real sigma ! Breite der Gaussverteilung + real wert ! gewuerfelte Returnvariable + real radius,phi + + integer seed + common /seed/ seed + + real zwoPi + parameter (zwoPi = 2.*3.1415927) + +c Da die eindimensionale Gaussfunktion nicht integrierbar ist, wird erst +c ein Punkt in der Ebene mit der entsprechenden zweidimensionalen Gaussfunktion +c gewuerfelt. Von diesem Punkt wird dann die x-Komponente zurueckgegeben, die +c eindimensional Gaussverteilt ist: + + radius = sigma*Sqrt(-2.*log(1.-ran(seed))) + phi = zwoPi * ran(seed) + wert = radius * cos(phi) + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Gauss_Verteilung_theta(sigma,theta) +c ============================================== + + IMPLICIT NONE + + real sigma,theta + real radius,phi,ratio + + integer i, seed + common /seed/ seed + +c Man beachte, dass hier Winkel gewuerfelt werden! D.h., dass die Variable +c 'radius' einen Radius in einer 2dimensionalen 'Winkel'-Ebene darstellt. +c Es wird angenommen, dass sigma in degree angegeben wird (daher die sind()- +c Funktion in der Zuweisung fuer 'ratio' anstelle der sin()-Fkt.). + + i = 1 + +1 radius = sigma*Sqrt(-2.*log(1.-ran(seed))) + phi = 360.*ran(seed) + theta = abs(radius * cosd(phi)) + ! nur theta zwischen 0 und 90 deg sollen eine Chance haben: + if (theta.GT.90) then + i = i + 1 + if (i.LE.10000) then + goto 1 + else + write(*,*) + write(*,*) 'SUBROUTINE Gauss_Verteilung_theta:' + write(*,*) ' Nach 10000 Versuchen noch keinen Winkel < 90 degree gewuerfelt.' + write(*,*) ' Vorgegebenes Sigma der Winkelverteilung: ',sigma + write(*,*) + STOP + endif + endif + +c Zitat aus TP's 'TESTSEED.FOR', aus welchem diese Routine abgeschrieben +c ist: +c +c Now we habe a GAUSSIAN, but we need for multiple scattering +c GAUSSIAN*SIN(x) =: g(x). This is not integrateable analytically, but +c we can choose the VON NEUMANN REJECTION to get what we want. +c As auxiliary function we choose the GAUSSIAN =: f(x), because it +c satisfies g(x) <= f(x) for all x. +c We must build the ratio g(x)/f(x) = sin(x) and compare it to +c another random number: + + ratio = sind(theta) + if (ran(seed).GT.ratio) goto 1 ! Verteilung zurechtbiegen + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE G_Functions(G1,G2,tau) +c ================================= + +c Diese Routine gibt in Abhaengigkeit von der reduzierten Dicke 'tau' +c Funktionswerte fuer g1 und g2 zurueck. g1 und g2 sind dabei die von +c Meyer angegebenen tabellierten Funktionen fuer die Berechnung von Halbwerts- +c breiten von Streuwinkelverteilungen. (L.Meyer, phys.stat.sol. (b) 44, 253 +c (1971)) + + IMPLICIT NONE + + real tau,g1,g2 + real tau_(26),g1_(26),g2_(26) + real help + + integer i + + DATA tau_ /0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, + + 2.5, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, 7.0, 8.0, 9.0, + + 10.0, 12.0, 14.0, 16.0, 18.0, 20.0 / + + DATA g1_ /0.050,0.115,0.183,0.245,0.305,0.363,0.419,0.473,0.525,0.575, + + 0.689,0.799,0.905,1.010,1.100,1.190,1.370,1.540,1.700,1.850, + + 1.990,2.270,2.540,2.800,3.050,3.290 / + DATA g2_ / 0.00,1.25,0.91,0.79,0.73,0.69,0.65,0.63,0.61,0.59, + + 0.56,0.53,0.50,0.47,0.45,0.43,0.40,0.37,0.34,0.32, + + 0.30,0.26,0.22,0.18,0.15,0.13 / + + if (tau.LT.tau_(1)) then + write(*,*) + write(*,*)'SUBROUTINE G_Functions:' + write(*,*)' Fehler bei Berechnung der g-Funktionen fuer Winkelaufstreuung:' + write(*,*)' aktuelles tau ist kleiner als kleinster Tabellenwert:' + write(*,*)' tau = ',tau + write(*,*)' tau_(1) = ',tau_(1) + write(*,*) + STOP + endif + + i = 1 + +10 i = i + 1 + if (i.EQ.27) then + write(*,*) + write(*,*)'SUBROUTINE G_Functions:' + write(*,*)' Fehler bei Berechnung der g-Funktionen fuer Winkelaufstreuung:' + write(*,*)' aktuelles tau ist groesser als groesster Tabellenwert:' + write(*,*)' tau = ',tau + write(*,*)' tau_(26) = ',tau_(26) + write(*,*) + STOP + elseif (tau.gt.tau_(i)) then + goto 10 + endif + + +c lineare Interpolation zwischen Tabellenwerten: + + help = (tau-tau_(i-1))/(tau_(i)-tau_(i-1)) + + g1 = g1_(i-1) + help*(g1_(i)-g1_(i-1)) + g2 = g2_(i-1) + help*(g2_(i)-g2_(i-1)) + + + END + + +c=============================================================================== + + options /extend_source + + subroutine Get_F_Function_Meyer(tau,Ekin) +c ========================================= + + implicit none + + real tau + real Ekin + + real thetaSchlange,thetaSchlangeMax + real theta,thetaMax,thetaStep + real f1,f2,F + + +c------------------------------------ +c - Parameter: + + real Z1, Z2 ! die atomaren Nummern von Projektil und Target +c real a0 ! Bohrscher Radius in cm + real screeningPar ! Screeningparameter 'a' in cm fuer Teilchen der + ! Kernladungszahl Z1=1 in Kohlenstoff (Z2 = 6) + ! bei Streichung von Z1 (vgl. Referenz, S. 268) + + real r0Meyer ! r0(C) berechnet aus dem screeningParameter 'a' + ! und dem ebenfalls bei Meyer angegebenem + ! Verhaeltnis a/r0=0.26 (vgl. Referenz, S. 263 oben) + real eSquare ! elektrische Ladung zum Quadrat in keV*cm + + real Pi ! die Kreiszahl + +c parameter (a0 = 5.29E-9) + parameter (Z1 = 1, Z2 = 6, ScreeningPar = 2.5764E-9) + parameter (r0Meyer = 9.909E-9, eSquare = 1.44E-10) + parameter (Pi = 3.141592654) + + real Meyer_Faktor3 + real Meyer_Faktor4 + real zzz ! 'Hilfsparameter' + real Meyer_Faktor5 + + parameter (Meyer_faktor3 = (screeningPar/r0Meyer) * (screeningPar/r0Meyer)) + parameter (Meyer_faktor4 = screeningPar / (2.*Z1*Z2*eSquare) * Pi/180.) + parameter (zzz = screeningPar / (2.*Z1*Z2*eSquare)) + parameter (Meyer_faktor5 = zzz*zzz / (8*Pi*Pi)) + +c------------------------------------ + + integer nBin,nBinMax + parameter (nBinMax=201) + real value(0:nBinMax) /0.,nBinMax*0./ + real area(nBinMax) / nBinMax*0./ + real integ(0:nBinMax) /0.,nBinMax*0./ + common /MeyerTable/ value,area,integ,thetaStep,nBin + + integer i + real rhelp + + integer HB_memsize + parameter(HB_memsize=500000) + real memory(HB_memsize) + COMMON /PAWC/ memory + + +c nur noch fuer Testzwecke: + + real fValues(203) + real fValuesFolded(203) + + integer idh + parameter (idh = 50) + + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + character filename*20 ! Name der Ausgabe-Dateien + COMMON /filename/ filename + +c------------------------------------------------------------------------------- + +c Festlegen des maximalen Theta-Wertes sowie der Schrittweite: + + if (tau.LT.0.2) then + write(*,*) 'Subroutine ''Get_F_Function_Meyer'':' + write(*,*) 'Effektive Dicke ist kleiner als 0.2 => kann ich nicht ... => STOP' + call exit + elseif (tau.LE.2.) then + ! => Tabelle A + thetaSchlangeMax = 4.0 + elseif (tau.LE.8.) then + ! => Tabelle B + thetaSchlangeMax = 7.0 + elseif (tau.LE.20.) then + ! => Tabelle C + thetaSchlangeMax = 20.0 + else + write(*,*) 'Subroutine ''Get_F_Function_Meyer'':' + write(*,*) 'Effektive Dicke ist groesser als 20 => kann ich nicht ... => STOP' + call exit + endif + + thetaMax = thetaSchlangeMax / Meyer_Faktor4 / Ekin + if (thetaMax.GT.50) then + thetaStep = .5 + elseif (thetaMax.GT.25) then + thetaStep = .25 + elseif (thetaMax.GT.12.5) then + thetaStep = .125 + else + thetaStep = .0625 + endif + + +c Tabelle der F-Werte erstellen: + + nBin = 0 + do theta = thetaStep, thetaMax, thetaStep + + ! Berechne aus theta das 'reduzierte' thetaSchlange (dabei gleich + ! noch von degree bei theta in Radiant bei thetaSchlange umrechnen): + + thetaSchlange = Meyer_faktor4 * Ekin * theta + + ! Auslesen der Tabellenwerte fuer die f-Funktionen: + + call F_Functions_Meyer(tau,thetaSchlange,f1,f2) + if (thetaSchlange.EQ.-1) then + ! wir sind jenseits von thetaSchlangeMax + goto 10 + endif + + ! Berechnen der Streuintensitaet: + F = Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2) + + nBin = nBin + 1 + if (nBin.GT.nBinMax) then + write(*,*) 'nBin > nBinMax => EXIT' + call exit + endif + value(nBin) = sind(theta)*F + + fValues(nBin+1) = F ! fuer Testzwecke + fValuesFolded(nBin+1) = sind(theta)*F ! fuer Testzwecke + + enddo + + +c Berechnen der Flaecheninhalte der einzelnen Kanaele sowie der Integrale: + +10 do i = 1, nBin + area(i) = (value(i)+value(i-1))/2. * thetaStep + integ(i) = integ(i-1) + area(i) + enddo + + +c Normiere totale Flaeche auf 1: + + rHelp = integ(nBin) + do i = 1, nBin + value(i) = value(i) / rHelp + area(i) = area(i) / rHelp + integ(i) = integ(i) / rHelp + enddo + + +c vorerst noch: gib Tabelle in Datei und Histogrammfile aus: + + ! Berechne die Werte fuer theta=0: + + call F_Functions_Meyer(tau,0.,f1,f2) + F = Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2) + fValues(1) = F + fValuesFolded(1) = 0. + + ! Gib die Werte in das Tabellenfile aus: + +c theta = 0. +c open (10,file=outDir//':'//filename//'.TAB',status='NEW') +c do i = 1, nBin+1 +c write(10,*) theta, fValues(i), fValuesFolded(i) +c theta = theta + thetaStep +c enddo +c close (10) + + + ! Buchen und Fuellen der Histogramme: + + call HBOOK1(idh,'F',nBin+1,-0.5*thetaStep,(real(nBin)+0.5)*thetaStep,0.) + call HPAK(idh,fValues) + call HRPUT(idh,outDir//':'//filename//'.RZ','N') + call HDELET(idh) + + call HBOOK1(idh+1,'F*sin([q])',nBin+1,-0.5*thetaStep,(real(nBin)+0.5)*thetaStep,0.) + call HPAK(idh+1,fValuesFolded) + call HRPUT(idh+1,outDir//':'//filename//'.RZ','U') + call HDELET(idh+1) + + + END + + +c=============================================================================== + + options /extend_source + + subroutine throwMeyerAngle (theta) +c ================================== + + implicit none + + real lowerbound,y1,y2,f,root,radiant,fraction + integer bin,nBin + integer nBinMax + parameter (nBinMax=201) + + real theta,thetaStep + real value(0:nBinMax) /0.,nBinMax*0./ + real area(nBinMax) / nBinMax*0./ + real integ(0:nBinMax) /0.,nBinMax*0./ + common /MeyerTable/ value,area,integ,thetaStep,nBin + + real rhelp + + real random + integer seed + common /seed/ seed + + +c bin: Nummer des Bins, innerhalb dessen das Integral den Wert von +c random erreicht oder ueberschreitet: + + random = ran(seed) + + bin = 1 + do while (random.GT.integ(bin)) + bin = bin + 1 + if (bin.GT.nBin) then + write(*,*) 'error 1' + call exit + endif + enddo + + fraction = (random-integ(bin-1)) / (integ(bin)-integ(bin-1)) + y1 = value(bin-1) + y2 = value(bin) + f = thetaStep / (y2-y1) + rHelp = y1*f + + radiant = rHelp*rHelp + fraction*thetaStep*(y1+y2)*f + root = SQRT(radiant) + lowerBound = real(bin-1)*thetaStep + if (f.GT.0) then + theta = lowerBound - rHelp + root + else + theta = lowerBound - rHelp - root + endif + + + END + + +c=============================================================================== + + options /extend_source + + subroutine F_Functions_Meyer(tau,thetaSchlange,f1,f2) +c ===================================================== + + implicit none + +c Diese Routine gibt in Abhaengigkeit von 'thetaSchlange' und 'tau' +c Funktionswerte fuer f1 und f2 zurueck. f1 und f2 entsprechen dabei den +c bei Meyer angegebenen Funktion gleichen Namens. Die in dieser Routine +c verwendeten Tabellen sind eben dieser Referenz entnommen: +c L.Meyer, phys.stat.sol. (b) 44, 253 (1971) + + real tau,thetaSchlange + real f1, f2, f1_(2), f2_(2) + + integer column_,column,row + + integer iColumn + real weightCol, weightRow + +c------------------------------------------------------------------------------- + +c die Tabellendaten der Referenz (Tabellen 2 und 3): + + integer nColumn + parameter (nColumn = 25) + real tau_(nColumn) / + + 0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.5, 3.0, + + 3.5, 4.0, 4.5, 5.0, 6.0, 7.0, 8.0, 10., 12., 14., 16., 18., 20. / + + integer nRowA + parameter (nRowA = 25) + real thetaSchlangeA(nRowA) / + + .00, .05, .10, .15, .20, .25, .30, .35, .40, .45, .50, .60, + + .70, .80, .90, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.5, 3.0, 3.5, 4.0 / + + integer nRowB + parameter (nRowB = 24) + real thetaSchlangeB(nRowB) / + + 0.0, 0.2, 0.4, 0.5, 0.6, 0.8, 1.0, 1.2, 1.4, 1.5, 1.6, 1.8, + + 2.0, 2.2, 2.4, 2.6, 2.8, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, 7.0 / + + integer nRowC + parameter (nRowC = 24) + real thetaSchlangeC(nRowC) / + + 0.0, 0.5, 1.0, 1.5, 2.0, 2.5, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, + + 7.0, 8.0, 9.0, 10., 11., 12., 13., 14., 15., 16., 18., 20. / + + + real f1_A(9,nRowA) + + /1.69E+2,4.55E+1,2.11E+1,1.25E+1,8.48E+0,6.21E+0,4.80E+0,3.86E+0,3.20E+0, + + 9.82E+1,3.72E+1,1.97E+1,1.20E+1,8.27E+0,6.11E+0,4.74E+0,3.83E+0,3.17E+0, + + 3.96E+1,2.58E+1,1.65E+1,1.09E+1,7.73E+0,5.82E+0,4.58E+0,3.72E+0,3.10E+0, + + 1.76E+1,1.58E+1,1.27E+1,9.26E+0,6.93E+0,5.38E+0,4.31E+0,3.55E+0,2.99E+0, + + 8.62E+0,1.01E+1,9.45E+0,7.58E+0,6.02E+0,4.85E+0,3.98E+0,3.33E+0,2.84E+0, + + 4.65E+0,6.55E+0,6.91E+0,6.06E+0,5.11E+0,4.28E+0,3.62E+0,3.08E+0,2.66E+0, + + 2.74E+0,4.45E+0,5.03E+0,4.78E+0,4.27E+0,3.72E+0,3.23E+0,2.82E+0,2.47E+0, + + 1.77E+0,3.02E+0,3.71E+0,3.76E+0,3.53E+0,3.20E+0,2.86E+0,2.55E+0,2.27E+0, + + 1.22E+0,2.19E+0,2.78E+0,2.96E+0,2.91E+0,2.73E+0,2.51E+0,2.28E+0,2.07E+0, + + 8.82E-1,1.59E+0,2.12E+0,2.35E+0,2.39E+0,2.32E+0,2.19E+0,2.03E+0,1.87E+0, + + 6.55E-1,1.20E+0,1.64E+0,1.88E+0,1.97E+0,1.96E+0,1.90E+0,1.79E+0,1.68E+0, + + 3.80E-1,7.15E-1,1.01E+0,1.22E+0,1.35E+0,1.40E+0,1.41E+0,1.39E+0,1.34E+0, + + 2.26E-1,4.45E-1,6.44E-1,8.08E-1,9.28E-1,1.01E+0,1.05E+0,1.06E+0,1.05E+0, + + 1.39E-1,2.80E-1,4.21E-1,5.45E-1,6.46E-1,7.22E-1,7.75E-1,8.07E-1,8.21E-1, + + 8.22E-2,1.76E-1,2.78E-1,3.71E-1,4.53E-1,5.21E-1,5.74E-1,6.12E-1,6.37E-1, + + 5.04E-2,1.11E-1,1.86E-1,2.57E-1,3.22E-1,3.79E-1,4.27E-1,4.65E-1,4.94E-1, + + 2.51E-2,5.60E-2,9.24E-2,1.31E-1,1.69E-1,2.02E-1,2.40E-1,2.71E-1,2.97E-1, + + 1.52E-2,3.20E-2,5.08E-2,7.23E-2,9.51E-2,1.18E-1,1.41E-1,1.63E-1,1.83E-1, + + 1.03E-2,2.05E-2,3.22E-2,4.55E-2,6.01E-2,7.53E-2,9.02E-2,1.05E-1,1.19E-1, + + 8.80E-3,1.48E-2,2.25E-2,3.13E-2,4.01E-2,5.03E-2,6.01E-2,7.01E-2,8.01E-2, + + 6.10E-3,1.15E-2,1.71E-2,2.28E-2,2.89E-2,3.52E-2,4.18E-2,4.86E-2,5.55E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,1.71E-2,1.98E-2,2.28E-2,2.58E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,8.90E-3,1.02E-2,1.16E-2,1.31E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,4.90E-3,5.70E-3,6.40E-3,7.20E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,2.90E-3,3.40E-3,3.90E-3,4.30E-3/ + + real f1_B(9,nRowB) + + /2.71E+0,1.92E+0,1.46E+0,1.16E+0,9.52E-1,8.03E-1,6.90E-1,5.32E-1,4.28E-1, + + 2.45E+0,1.79E+0,1.39E+0,1.12E+0,9.23E-1,7.82E-1,6.75E-1,5.23E-1,4.23E-1, + + 1.87E+0,1.48E+0,1.20E+0,9.96E-1,8.42E-1,7.24E-1,6.32E-1,4.98E-1,4.07E-1, + + 1.56E+0,1.30E+0,1.09E+0,9.19E-1,7.89E-1,6.86E-1,6.03E-1,4.80E-1,3.95E-1, + + 1.28E+0,1.11E+0,9.62E-1,8.33E-1,7.27E-1,6.40E-1,5.69E-1,4.59E-1,3.81E-1, + + 8.23E-1,7.90E-1,7.29E-1,6.64E-1,6.01E-1,5.44E-1,4.94E-1,4.12E-1,3.49E-1, + + 5.14E-1,5.36E-1,5.29E-1,5.07E-1,4.78E-1,4.47E-1,4.16E-1,3.60E-1,3.13E-1, + + 3.19E-1,3.58E-1,3.76E-1,3.78E-1,3.70E-1,3.57E-1,3.45E-1,3.08E-1,2.76E-1, + + 2.02E-1,2.40E-1,2.64E-1,2.77E-1,2.82E-1,2.80E-1,2.65E-1,2.59E-1,2.39E-1, + + 1.67E-1,1.96E-1,2.20E-1,2.36E-1,2.44E-1,2.47E-1,2.45E-1,2.35E-1,2.21E-1, + + 1.33E-1,1.61E-1,1.85E-1,2.02E-1,2.12E-1,2.18E-1,2.18E-1,2.14E-1,2.03E-1, + + 8.99E-2,1.12E-1,1.32E-1,1.48E-1,1.59E-1,1.67E-1,1.68E-1,1.75E-1,1.72E-1, + + 6.24E-2,7.94E-2,9.50E-2,1.09E-1,1.20E-1,1.29E-1,1.35E-1,1.42E-1,1.43E-1, + + 4.55E-2,5.74E-2,6.98E-2,8.11E-2,9.09E-2,9.92E-2,1.06E-1,1.15E-1,1.19E-1, + + 3.35E-2,4.22E-2,5.19E-2,6.11E-2,6.95E-2,7.69E-2,8.33E-2,9.28E-2,9.85E-2, + + 2.50E-2,3.16E-2,3.92E-2,4.66E-2,5.35E-2,6.00E-2,6.57E-2,7.49E-2,8.13E-2, + + 1.90E-2,2.40E-2,2.99E-2,3.58E-2,4.16E-2,4.70E-2,5.20E-2,6.05E-2,6.70E-2, + + 1.47E-2,1.86E-2,2.32E-2,2.79E-2,3.25E-2,3.70E-2,4.12E-2,4.89E-2,5.51E-2, + + 8.10E-3,1.04E-2,1.30E-2,1.57E-2,1.84E-2,2.12E-2,2.40E-2,2.93E-2,3.42E-2, + + 4.80E-3,6.20E-3,7.70E-3,9.30E-3,1.09E-2,1.26E-2,1.44E-2,1.79E-2,2.14E-2, + + 2.80E-3,3.80E-3,4.70E-3,5.70E-3,6.70E-3,7.50E-3,8.90E-3,1.13E-2,1.36E-2, + + 1.70E-3,2.30E-3,2.90E-3,3.60E-3,4.20E-3,4.90E-3,5.60E-3,7.20E-3,8.80E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,2.00E-3,2.80E-3,3.50E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,8.80E-4,1.20E-3,1.60E-3/ + + real f1_C(7,nRowC) + + /3.65E-1,2.62E-1,2.05E-1,1.67E-1,1.41E-1,1.21E-1,1.05E-1, + + 3.33E-1,2.50E-1,1.95E-1,1.61E-1,1.36E-1,1.18E-1,1.03E-1, + + 2.75E-1,2.18E-1,1.76E-1,1.48E-1,1.27E-1,1.11E-1,9.80E-2, + + 2.04E-1,1.75E-1,1.50E-1,1.29E-1,1.13E-1,1.01E-1,9.00E-2, + + 1.41E-1,1.31E-1,1.19E-1,1.08E-1,9.71E-2,8.88E-2,8.01E-2, + + 9.32E-2,9.42E-2,9.10E-2,8.75E-2,8.00E-2,7.44E-2,6.91E-2, + + 5.98E-2,6.52E-2,6.72E-2,6.62E-2,6.40E-2,6.12E-2,5.82E-2, + + 3.83E-2,4.45E-2,4.80E-2,4.96E-2,4.98E-2,4.90E-2,4.77E-2, + + 2.46E-2,3.01E-2,3.40E-2,3.65E-2,3.79E-2,3.84E-2,3.83E-2, + + 1.59E-2,2.03E-2,2.39E-2,2.66E-2,2.85E-2,2.97E-2,3.04E-2, + + 1.04E-2,1.37E-2,1.66E-2,1.92E-2,2.12E-2,2.27E-2,2.37E-2, + + 4.39E-3,6.26E-3,8.26E-3,9.96E-3,1.15E-2,1.29E-2,1.41E-2, + + 2.06E-3,3.02E-3,4.24E-3,5.28E-3,6.32E-3,7.32E-3,8.26E-3, + + 1.21E-3,1.69E-3,2.24E-3,2.85E-3,3.50E-3,4.16E-3,4.82E-3, + + 8.50E-4,1.10E-3,1.38E-3,1.65E-3,2.03E-3,2.45E-3,2.88E-3, + + 5.90E-4,7.40E-4,8.50E-4,9.90E-4,1.23E-3,1.49E-3,1.71E-3, + + 3.90E-4,4.60E-4,5.20E-4,6.30E-4,7.65E-4,9.65E-4,1.12E-3, + + 2.40E-4,2.70E-4,3.10E-4,3.98E-4,4.97E-4,6.03E-4,7.18E-4, + + 1.50E-4,1.70E-4,2.15E-4,2.70E-4,3.35E-4,4.35E-4,5.00E-4, + + 1.00E-4,1.20E-4,1.46E-4,1.90E-4,2.40E-4,2.88E-4,3.43E-4, + + 0.00 ,0.00 ,1.04E-4,1.41E-4,1.80E-4,2.10E-4,2.50E-4, + + 0.00 ,0.00 ,8.20E-5,1.06E-4,1.38E-4,1.58E-4,1.85E-4, + + 0.00 ,0.00 ,5.40E-5,7.00E-5,8.60E-5,1.03E-4,1.20E-4, + + 0.00 ,0.00 ,4.20E-5,5.40E-5,6.50E-5,7.70E-5,8.80E-5/ + + real f2_A(9,nRowA) + + / 3.52E+3, 3.27E+2, 9.08E+1, 3.85E+1, 2.00E+1, 1.18E+1, 7.55E+0, 5.16E+0, 3.71E+0, + + 2.58E+2, 1.63E+2, 7.30E+1, 3.42E+1, 1.85E+1, 1.11E+1, 7.18E+0, 4.96E+0, 3.59E+0, + + -1.12E+2, 4.84E+0, 3.56E+1, 2.34E+1, 1.45E+1, 9.33E+0, 6.37E+0, 4.51E+0, 3.32E+0, + + -5.60E+1,-1.12E+1, 9.87E+0, 1.24E+1, 9.59E+0, 7.01E+0, 5.16E+0, 3.83E+0, 2.91E+0, + + -2.13E+1,-1.22E+1,-2.23E+0, 3.88E+0, 5.15E+0, 4.65E+0, 3.87E+0, 3.12E+0, 2.45E+0, + + -8.25E+0,-9.58E+0,-5.59E+0,-1.40E+0, 1.76E+0, 2.71E+0, 2.71E+0, 2.35E+0, 1.95E+0, + + -3.22E+0,-6.12E+0,-5.28E+0,-2.87E+0,-1.92E-1, 1.32E+0, 1.69E+0, 1.74E+0, 1.48E+0, + + -1.11E+0,-3.40E+0,-4.12E+0,-3.08E+0,-6.30E-1, 3.60E-1, 9.20E-1, 1.03E+0, 1.04E+0, + + -2.27E-1,-2.00E+0,-2.93E+0,-2.69E+0,-1.48E+0,-3.14E-1, 2.69E-1, 5.28E-1, 6.09E-1, + + 1.54E-1,-1.09E+0,-2.10E+0,-2.15E+0,-1.47E+0,-6.77E-1,-1.80E-1, 1.08E-1, 2.70E-1, + + 3.28E-1,-6.30E-1,-1.50E+0,-1.68E+0,-1.34E+0,-8.43E-1,-4.60E-1,-1.85E-1,-4.67E-3, + + 3.32E-1,-2.06E-1,-7.32E-1,-9.90E-1,-9.42E-1,-8.20E-1,-6.06E-1,-4.51E-1,-3.01E-1, + + 2.72E-1,-3.34E-2,-3.49E-1,-5.65E-1,-6.03E-1,-5.79E-1,-5.05E-1,-4.31E-1,-3.45E-1, + + 2.02E-1, 2.80E-2,-1.54E-1,-3.00E-1,-3.59E-1,-3.76E-1,-4.60E-1,-3.40E-1,-3.08E-1, + + 1.38E-1, 4.84E-2,-5.56E-2,-1.44E-1,-2.04E-1,-2.39E-1,-2.54E-1,-2.49E-1,-2.48E-1, + + 9.47E-2, 4.86E-2,-1.08E-2,-6.44E-2,-1.02E-1,-1.34E-1,-1.62E-1,-1.79E-1,-1.87E-1, + + 5.33E-2, 3.71E-2, 1.85E-2, 1.63E-3,-1.69E-2,-3.69E-2,-5.66E-2,-7.78E-2,-9.33E-2, + + 3.38E-2, 2.40E-2, 1.62E-2, 9.90E-3, 3.76E-3,-4.93E-3,-1.66E-2,-3.05E-2,-4.22E-2, + + 2.12E-2, 1.56E-2, 1.05E-2, 7.80E-3, 7.92E-3, 6.30E-3, 3.20E-4,-8.50E-3,-1.66E-2, + + 1.40E-2, 9.20E-3, 5.30E-3, 4.70E-3, 6.31E-3, 8.40E-3, 5.30E-3, 8.80E-4,-3.30E-3, + + 9.20E-3, 4.70E-3, 1.70E-3, 2.60E-3, 4.49E-3, 6.60E-3, 6.00E-3, 4.70E-3, 2.80E-3, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 / + + real f2_B(9,nRowB) + + / 2.75E+0, 1.94E+0, 9.13E-1, 6.06E-1, 4.26E-1, 3.14E-1, 2.40E-1, 1.51E-1, 1.03E-1, + + 1.94E+0, 1.16E+0, 7.56E-1, 5.26E-1, 3.81E-1, 2.87E-1, 2.23E-1, 1.43E-1, 9.78E-2, + + 5.85E-1, 5.04E-1, 4.10E-1, 3.30E-1, 2.69E-1, 2.17E-1, 1.78E-1, 1.22E-1, 8.71E-2, + + 7.83E-2, 2.00E-1, 2.35E-1, 2.19E-1, 1.97E-1, 1.73E-1, 1.48E-1, 1.08E-1, 7.93E-2, + + -1.82E-1, 1.56E-2, 1.04E-1, 1.36E-1, 1.38E-1, 1.31E-1, 1.19E-1, 9.46E-2, 7.19E-2, + + -2.71E-1,-1.66E-1,-7.29E-2,-4.74E-3, 3.60E-2, 5.50E-2, 6.28E-2, 5.98E-2, 5.09E-2, + + -1.87E-1,-1.58E-1,-1.09E-1,-5.80E-2,-2.03E-2, 2.48E-3, 1.99E-2, 3.36E-2, 3.27E-2, + + -1.01E-1,-1.05E-1,-8.95E-2,-6.63E-2,-3.93E-2,-2.38E-2,-9.22E-3, 8.47E-3, 1.52E-2, + + -5.19E-2,-6.47E-2,-6.51E-2,-5.62E-2,-4.51E-2,-3.49E-2,-2.45E-2,-8.19E-3, 2.05E-3, + + -3.68E-2,-4.89E-2,-5.36E-2,-5.06E-2,-4.27E-2,-3.65E-2,-2.80E-2,-1.33E-2,-3.47E-3, + + -2.33E-2,-3.69E-2,-4.41E-2,-4.38E-2,-3.97E-2,-3.50E-2,-2.88E-2,-1.60E-2,-6.68E-3, + + -8.76E-3,-2.07E-2,-2.90E-2,-3.17E-2,-3.09E-2,-2.92E-2,-2.63E-2,-1.79E-2,-1.03E-2, + + -1.20E-3,-1.11E-2,-1.90E-2,-2.20E-2,-2.32E-2,-2.24E-2,-2.10E-2,-1.66E-2,-1.11E-2, + + 1.72E-3,-4.82E-3,-1.02E-2,-1.42E-2,-1.65E-2,-1.66E-2,-1.60E-2,-1.39E-2,-1.09E-2, + + 2.68E-3,-1.18E-3,-5.19E-3,-8.30E-5,-1.01E-2,-1.14E-2,-1.16E-2,-1.16E-2,-9.99E-3, + + 2.81E-3, 8.21E-4,-1.96E-3,-3.99E-3,-5.89E-3,-7.13E-3,-8.15E-3,-9.05E-3,-8.60E-3, + + 2.61E-3, 1.35E-3,-2.99E-4,-1.79E-3,-3.12E-3,-4.44E-3,-5.61E-3,-7.01E-3,-7.27E-3, + + 2.06E-3, 1.45E-3, 4.64E-4,-5.97E-4,-1.71E-3,-2.79E-3,-3.84E-3,-5.29E-3,-5.90E-3, + + 1.07E-3, 9.39E-4, 8.22E-4, 3.58E-4,-1.15E-4,-6.60E-4,-1.18E-3,-2.15E-3,-2.88E-3, + + 4.97E-4, 5.46E-4, 6.15E-4, 5.56E-4, 3.14E-4, 9.80E-5,-1.30E-4,-5.98E-4,-1.07E-4, + + 1.85E-4, 3.11E-4, 4.25E-4, 4.08E-4, 3.63E-4, 3.04E-4, 2.24E-4, 2.80E-5,-2.10E-4, + + 4.80E-5, 1.48E-4, 2.44E-4, 2.80E-4, 3.01E-4, 3.11E-4, 3.13E-4, 2.40E-4, 1.10E-4, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 1.39E-4, 1.80E-4, 1.80E-4, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 4.38E-5, 7.30E-5, 8.40E-5/ + + real f2_C(7,nRowC) + + / 7.36E-2, 4.21E-2, 2.69E-2, 1.83E-2, 1.34E-2, 1.01E-2, 7.88E-3, + + 5.79E-2, 3.61E-2, 2.34E-2, 1.64E-2, 1.21E-2, 9.26E-3, 7.28E-3, + + 2.94E-2, 2.17E-2, 1.60E-2, 1.23E-2, 9.49E-3, 7.45E-3, 5.95E-3, + + 2.30E-3, 7.07E-3, 7.76E-3, 7.02E-3, 6.13E-3, 5.17E-3, 4.34E-3, + + -7.50E-3,-2.00E-3, 9.93E-4, 2.36E-3, 2.82E-3, 2.86E-3, 2.72E-3, + + -8.27E-3,-5.37E-3,-2.58E-3,-7.96E-4, 3.75E-4, 9.71E-4, 1.28E-3, + + -5.79E-3,-5.12E-3,-3.86E-3,-2.46E-3,-1.20E-3,-3.74E-4, 1.74E-4, + + -3.26E-3,-3.43E-3,-3.26E-3,-2.68E-3,-1.84E-3,-1.12E-3,-4.54E-4, + + -1.46E-3,-1.49E-3,-2.20E-3,-2.18E-3,-1.85E-3,-1.40E-3,-8.15E-4, + + -4.29E-4,-9.44E-4,-1.29E-3,-1.50E-3,-1.51E-3,-1.36E-3,-9.57E-4, + + -3.30E-5,-3.66E-4,-6.78E-4,-9.38E-4,-1.09E-3,-1.09E-3,-9.56E-4, + + 1.50E-4, 3.10E-5,-1.38E-4,-3.06E-4,-4.67E-4,-5.48E-4,-6.08E-4, + + 1.00E-4, 8.50E-5, 2.30E-5,-6.60E-5,-1.58E-4,-2.40E-4,-3.05E-4, + + 5.40E-5, 6.50E-5, 4.90E-5, 1.20E-5,-3.60E-5,-8.90E-5,-1.31E-4, + + 2.90E-5, 4.30E-5, 4.40E-5, 2.90E-5, 5.10E-6,-2.20E-5,-4.80E-5, + + 1.40E-5, 2.40E-5, 2.80E-5, 2.60E-5, 1.90E-5, 7.50E-6,-1.10E-5, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 / + + +c=============================================================================== + +c Bestimme, welche Reihen der Tabellen fuer Interpolation benoetigt werden: + + if (tau.LT.tau_(1)) then + write(*,*) 'tau is less than the lowest tabulated value:' + write(*,*) 'tau = ',tau + write(*,*) 'minimum = ',tau_(1) + call exit + elseif (tau.GT.tau_(nColumn)) then + write(*,*) 'tau is greater than the highest tabulated value:' + write(*,*) 'tau = ',tau + write(*,*) 'maximum = ',tau_(nColumn) + call exit + endif + + column_ = 2 + do while (tau.GT.tau_(column_)) + column_ = column_ + 1 + enddo + ! Das Gewicht der Reihe zu groesserem Tau: + weightCol = (tau-tau_(column_-1)) / (tau_(column_)-tau_(column_-1)) + + +c Besorge fuer gegebenes 'thetaSchlange' die interpolierten f1- und f2 -Werte +c der beiden relevanten Reihen: +c iColumn = 1 => Reihe mit hoeherem Index +c iColumn = 2 => Reihe mit kleinerem Index + + + iColumn = 1 + + +5 continue + + if (column_.LE.9) then ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 1. Tabelle: 0.2 <= tau <= 1.8 + + column = column_ + + if (thetaSchlange.LT.thetaSchlangeA(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeA(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeA(nRowA)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeA(nRowA) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeA(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeA(row-1)) / + + (thetaSchlangeA(row)-thetaSchlangeA(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_A(column,row-1) + + + weightRow * f1_A(column,row) + f2_(iColumn) = (1.-weightRow) * f2_A(column,row-1) + + + weightRow * f2_A(column,row) + + + elseif (column_.LE.18) then ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 2. Tabelle: 2.0 <= tau <= 7.0 + + column = column_ - 9 + + if (thetaSchlange.LT.thetaSchlangeB(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeB(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeB(nRowB)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeB(nRowB) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeB(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeB(row-1)) / + + (thetaSchlangeB(row)-thetaSchlangeB(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_B(column,row-1) + + + weightRow * f1_B(column,row) + f2_(iColumn) = (1.-weightRow) * f2_B(column,row-1) + + + weightRow * f2_B(column,row) + + + else ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 3. Tabelle: 8.0 <= tau <= 20. + + column = column_ - 18 + + if (thetaSchlange.LT.thetaSchlangeC(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeC(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeC(nRowC)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeC(nRowC) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeC(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeC(row-1)) / + + (thetaSchlangeC(row)-thetaSchlangeC(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_C(column,row-1) + + + weightRow * f1_C(column,row) + f2_(iColumn) = (1.-weightRow) * f2_C(column,row-1) + + + weightRow * f2_C(column,row) + + + endif ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + + if (iColumn.EQ.1) then + column_ = column_ - 1 + iColumn = 2 + goto 5 + endif + + f1 = weightCol*f1_(1) + (1.-weightCol)*f1_(2) + f2 = weightCol*f2_(1) + (1.-weightCol)*f2_(2) + + + END + + +c=============================================================================== + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE reset_statistics +c =========================== + + IMPLICIT NONE + + integer Nr,n,k + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c der allgemeine Statistikspeicher: (*) : braucht nicht resettet zu werden +c --------------------------------- +c +c statMem(1,Nr): 1. Wert: x(1) (*) +c statMem(2,Nr): Summe_ueber_i( x(i)-x(1) ) +c statMem(3,Nr): Summe_ueber_i( (x(i)-x(1))**2. ) +c statMem(4,Nr): kleinster Wert +c statMem(5,Nr): groesster Wert +c statMem(6,Nr): Mittelwert (*) +c statMem(7,Nr): Varianz (*) +c statMem(8,Nr): Anzahl der Werte +c statMem(9,Nr): Anzahl der Werte in Prozent von 'StartsProSchleife' (*) +c ('StartsProSchleife' == n_par(0)) +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Ergebnis-Statistik-Speicher resetten: + + do Nr = 1, stat_Anzahl + statMem(2,Nr) = 0. ! Summe der Werte + statMem(3,Nr) = 0. ! Summe der Quadrate + statMem(4,Nr) = 1.e10 ! Minimalwert + statMem(5,Nr) = -1.e10 ! Maximalwert + statMem(8,Nr) = 0. ! Anzahl + enddo + +c die Scaler fuer den Returncode des TDs und die Pfostenhits sowie die +c StartZaehler resetten: + + do n = 1, 2 ! (1: Projektile, 2: FolienElektronen) + start_nr(n) = 0 + do k = 1, 18 + statTD(n,k) = 0. + enddo + do k = 1, 75 + pfostenHit(k,n) = 0. + enddo + enddo + + +c der Statistikspeicher fuer das Teilchen-Schicksal: + + do k = smallest_code_Nr, Gebiete_Anzahl*highest_code_Nr + statDestiny(k) = 0 + enddo + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE fill_statMem(wert,Nr) +c ================================ + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + real wert + integer Nr + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Wird die Varianz der Verteilung einer Groesse x gemaess der Formel +c +c Var(x) = SQRT( - **2 ) , < > -> Erwartungswert +c +c mit +c = 1/n * Summe_ueber_i( x(i) ) +c = 1/n * Summe_ueber_i( x(i)**2 ) +c +c berechnet, so tritt manchmal aufgrund der beschraenkten Genauigkeit der +c numerischen Speicher das Problem auf, dass bei grossen Werten x(i) und +c kleiner Streuung der Ausdruck unter der Wurzel negativ wird, was erstens +c unphysikalisch ist und zweitens zum Programmabbruch fuehrt. +c +c Dieses Problem liesse sich vermeiden, wenn man die Groessen x(i) relativ +c zu ihrem Erwartungswert angeben wuerde, der aber erst im nachhinein bekannt +c ist. +c +c Als Naeherungsloesung verwende ich daher fuer die Berechnung der Varianz die +c x(i) relativ zu x(1), also zum ersten Wert gemessen, der gerade bei kleiner +c Streuung, bei der das numerische Problem auftritt, nahe am Erwartungswert +c liegen sollte. +c +c statMem(1,Nr): 1. Wert: x(1) +c statMem(2,Nr): Summe_ueber_i( x(i)-x(1) ) +c statMem(3,Nr): Summe_ueber_i( (x(i)-x(1))**2. ) +c statMem(4,Nr): kleinster Wert +c statMem(5,Nr): groesster Wert +c statMem(6,Nr): Mittelwert (*) +c statMem(7,Nr): Varianz (*) +c statMem(8,Nr): Anzahl der Werte +c statMem(9,Nr): Anzahl der Werte in Prozent von 'StartsProSchleife' (*) +c ('StartsProSchleife' == n_par(0)) +c +c (*): wird im SUB 'eval_statistics' berechnet. +c +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + +c Zaehle mit: + + statMem(8,Nr) = statMem(8,Nr) + 1. + + +c Speichere den ersten Wert: + + if (statMem(8,Nr).EQ.1) statMem(1,Nr) = wert + + +c Summiere die Abweichungen vom ersten Wert: + + statMem(2,Nr) = statMem(2,Nr) + (wert-statMem(1,Nr)) + + +c Summiere die Quadratischen Abweichungen vom ersten Wert: + + statMem(3,Nr) = statMem(3,Nr) + (wert-statMem(1,Nr))**2. + + +c Speichere den kleinsten Wert (wurde noch kein Wert aufgenommen, so ist +c statMem(4,Nr) = 1.e10): + + if (statMem(4,Nr).GT.wert) statMem(4,Nr) = wert + + +c Speichere den groessten Wert (wurde noch kein Wert aufgenommen, so ist +c statMem(5,Nr) = -1.e10): + + if (statMem(5,Nr).LT.wert) statMem(5,Nr) = wert + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE eval_statistics +c ========================== + + IMPLICIT NONE + +c statMem(1,Nr): 1. Wert: x(1) +c statMem(2,Nr): Summe_ueber_i( x(i)-x(1) ) +c statMem(3,Nr): Summe_ueber_i( (x(i)-x(1))**2. ) +c statMem(4,Nr): kleinster Wert +c statMem(5,Nr): groesster Wert +c statMem(6,Nr): Mittelwert +c statMem(7,Nr): Varianz +c statMem(8,Nr): Anzahl der Werte +c statMem(9,Nr): Anzahl der Werte in Prozent von 'StartsProSchleife' +c ('StartsProSchleife' == n_par(0)) + + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + real n ! Anzahl der Werte, == statMem(8,Nr) + real radiant + + integer Nr,l + + + do Nr = 1, Stat_Anzahl + if (statNeeded(Nr)) then + n = statMem(8,Nr) + if (n.ne.0.) then + + !c Berechne Mittelwert: + statMem(6,Nr) = statMem(2,Nr)/n + statMem(1,Nr) + + !c Berechne Varianz: + radiant = ( statMem(3,Nr) - (statMem(2,Nr)**2. )/n)/n + statMem(7,Nr) = sqrt(radiant) + + !c Berechne Anteil an allen gestarteten in Prozent + statMem(9,Nr) = 100.*n/real(n_par(0)) + + else + + do l = 1, 9 + statMem(l,Nr) = 0. + enddo + + endif + endif + enddo + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE SAVE_GRAPHICS_KOORD +c ============================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_WINKEL.INC' + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + +c Variablen fuer die Graphikausgabe: + + real xKoord(1000) ! Koordinatenfelder fuer die + real yKoord(1000) ! Graphikausgabe + real zKoord(1000) ! +cMBc real tKoord(1000) ! + integer nKoord ! Anzahl der Koordinaten + +cMBc COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord,tKoord ! fuer Graphikaufruf + COMMON /GRAPHIX/ xKoord,yKoord,zKoord,nKoord ! fuer Graphikaufruf + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + nKoord = nKoord + 1 + + xKoord(nKoord) = x(1) + yKoord(nKoord) = x(2) + zKoord(nKoord) = x(3) +cMBc tKoord(nKoord) = t + + if (nKoord.EQ.1000) then + if (Gebiet.LE.upToChKoord) then ! Bahnberechnung wurde vor + call plot_horizontal ! Koordinatenwechsel abgebrochen + else + call plot_vertikal + endif + xKoord(1) = xKoord( 999) ! die letzten beiden uebernehmen, + yKoord(1) = yKoord( 999) ! damit gegebenenfalls der Richtungs- + zKoord(1) = zKoord( 999) ! pfeil gezeichnet werden kann. +cMBc tKoord(1) = tKoord( 999) + xKoord(2) = xKoord(1000) + yKoord(2) = yKoord(1000) + zKoord(2) = zKoord(1000) +cMBc tKoord(2) = tKoord(1000) + nKoord = 2 + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Output_Debug +c ======================= + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + INCLUDE 'mutrack$sourcedirectory:COM_WINKEL.INC' + INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC' + + real Ekin, temp1, temp2 + + Ekin = (v(1)*v(1) + v(2)*v(2) + v(3)*v(3)) * Energie_Faktor + + if (Gebiet.EQ.1 .AND. alfaTgt.NE.0) then + if (alfaTgtVertically) then + temp1 = xGrid1*Cos_alfaTgt - x(3)*Sin_alfaTgt + temp2 = xGrid1*Sin_alfaTgt + x(3)*Cos_alfaTgt + write(lun(1),1) steps,Gebiet,t,temp1,x(2),temp2,v,Ekin + else + temp1 = xGrid1*Cos_alfaTgt - x(2)*Sin_alfaTgt + temp2 = xGrid1*Sin_alfaTgt + x(2)*Cos_alfaTgt + write(lun(1),1) steps,Gebiet,t,temp1,temp2,x(3),v,Ekin + endif + else + write(lun(1),1) steps,Gebiet,t,x,v,Ekin + endif + +1 format(X,I4,X,I2,4X,F6.1,2X,F7.2,X,F6.2,X,F6.2,2X,F6.2,X, + + F6.2,X,F6.2,2X,G13.6) + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE Decay_Test(*) +c ======================== + + IMPLICIT NONE + + INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC' + + real dt + + if (t.GT.lifeTime) then ! Teilchen zerfallen + dt = t - lifeTime + t = lifeTime + x(1) = x(1) - dt*v(1) + x(2) = x(2) - dt*v(2) + x(3) = x(3) - dt*v(3) + destiny = code_decay + RETURN 1 + endif + + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE chargeStateYields(E,masse,Yield_plus,Yield_zero) +c =========================================================== + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Die Funktion sowie die Parameter sind uebernommen aus: +c +c M.Gonin, R.Kallenbach, P.Bochsler: 'Charge exchange of hydrogen atoms +c in carbon foils at 0.4 - 120 keV', Rev.Sci.Instrum. 65 (3), March 1994 +c +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + IMPLICIT NONE + + real E ! kinetische Energie in keV + real masse ! in keV / c**2 + + real a_zero,a_minus + real k_Fermi,k_zero,k_minus + real zwo_k_Fermi + real k_Fermi_Quad,k_zero_Quad,k_minus_Quad + real vc_minus,vc_plus,v_Bohr,v_rel + + parameter ( a_zero = 0.953, a_minus = 0.029 ) + parameter ( k_Fermi = 1.178 ) ! [v_Bohr] + parameter ( k_Fermi_Quad = k_Fermi * k_Fermi ) + parameter ( zwo_k_fermi = 2. * k_Fermi ) + parameter ( k_zero = 0.991*k_Fermi ) ! [v_Bohr] + parameter ( k_zero_Quad = k_zero * k_zero ) + parameter ( k_minus = 0.989*k_Fermi ) ! [v_Bohr] + parameter ( k_minus_Quad = k_minus * k_minus ) + parameter ( vc_minus = 0.284, vc_plus = 0.193 ) ! [v_Bohr] + parameter ( v_Bohr = 7.2974E-3 ) ! [c] + + real Q_zero,Q_minus,D + real Yield_minus,Yield_zero,Yield_plus + + real help1,help2,help3 + + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + if (E.LT.0) then + write(*,*) + write(*,*) 'error in subroutine ''chargeStateYields'':' + write(*,*) 'E = ',E,' < 0!' + write(*,*) '-> STOP' + write(*,*) + STOP + endif + + +c Energie in Geschwindigkeit umrechnen (in Einheiten von v_Bohr): + +c - klassisch: + + v_rel = SQRT(2.*E/masse) / v_Bohr + +c - relativistisch: + +c help1 = 1. + E/masse +c v_rel = SQRT(1. - 1./(help1*help1)) / v_Bohr + + +c Die geladenen Anteile berechnen (vgl. obige Referenz): + + help1 = v_rel*v_rel + help2 = zwo_k_Fermi*v_rel + Q_zero = 1. + (k_zero_Quad - k_Fermi_Quad - help1) / help2 + Q_minus = 1. + (k_minus_Quad - k_Fermi_Quad - help1) / help2 + + + help1 = a_zero * Q_zero + help2 = a_minus * Q_minus + help3 = (1.-Q_zero)*(1.-Q_minus) + D = help1*(help2 + (1.-Q_minus)) + help3 + + Yield_minus = help1*help2 / D + Yield_plus = help3 / D + + Yield_minus = Yield_minus * exp(-vc_minus/v_rel) + Yield_plus = Yield_plus * exp(-vc_plus /v_rel) + + Yield_zero = 1. - (Yield_minus + Yield_plus) + +c write(6,*) 'E vrel Neutral Plus Minus' +c write(6,*) E, v_rel, yield_zero, yield_plus, yield_minus + + END + + +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE test_wireHit(distToWire,WireRadiusQuad,v_x,v_y,WireHit) +c ================================================================== + +c Diese Routine ueberprueft, ob bei gegebenem Abstandsvektor 'distToWire' +c zwischen Teilchen und Draht und gegebener Geschwindigkeit v eines Teilchens +c bei geradliniger Bewegung und Drahtradius 'WireRadius' ein Schnittpunkt +c von Teilchenbahn und Drahtumfang existiert, ob also der Draht getroffen wird. +c Dafuer genuegt es zu pruefen, ob der Radiant der 'Mitternachtsformel' fuer die +c entsprechende quadratische Gleichung groesser oder gleich Null ist: + + IMPLICIT NONE + + real DistToWire(2),WireRadiusQuad,v_x,v_y + logical WireHit + + real steigung, help, radiant + +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + if (abs(v_x).GT.abs(v_y)) then + steigung = v_y/v_x + help = distToWire(2) - distToWire(1) * steigung + radiant = (1+steigung*steigung)*WireRadiusQuad - help*help + else + steigung = v_x/v_y + help = distToWire(1) - distToWire(2) * steigung + radiant = (1+steigung*steigung)*WireRadiusQuad - help*help + endif + + if (radiant.ge.0) then + wireHit = .true. + else + wireHit = .false. + endif + + + END + + +c=============================================================================== diff --git a/geant4/LEMuSR/MEYER/testmeyer.cc b/geant4/LEMuSR/MEYER/testmeyer.cc new file mode 100644 index 0000000..822201d --- /dev/null +++ b/geant4/LEMuSR/MEYER/testmeyer.cc @@ -0,0 +1,195 @@ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include"meyer.h" + +void GFunctions(double*,double*, const double tau); + + + + meyer GET; + +int main() +{ + + + // DECLARATION OF MEYER's PARAMETERS + + /* Meyer's p255: "We consider a beam of initially parallel particles + with mass m1 and atomic number Z1 which penetrates a material + layer of thickness t with N atoms per unit volume of mass m2 and + atomic number Z2. We assume that each scattering centre will be + effective according to the scattering cross section + dsigma/dÅ‹=¶a²f(Å‹)/ŋ² within a spherical volume of radius r0 + */ + + + double a, a0, N; // screnqing parameter a + double Z1, Z2, D; // charges numbers Z + double epsilon, b; // reduced energy epsilon + double mass1, mass2; // masses of incident & target particles + double v; // velocity of incident particle + double eta, theta; // eta = epsilon*sin(theta/2), (theta, scatt. angle) + // cross section variable by Lindhard, Nielsen and Scharff + double eSquare = 1.44E-10; // squared electric charge of electron in keV*cm + + double tau,thetaSchlange, thick; + double Energy; + + std::cout<< "thickness? in µm/cm²" << std::endl; + std::cin>>thick; + thick=thick*1.0e-6/2;// density= 2g/cm³, + // we want the conversion of thick in centimeter! + + std::cout<<"Enter energy in keV: "; + std::cin>>Energy; + + + + // meyer's functions + double g1,g2; + double f1,f2; + + + + // EXPRESSION OF MEYER's PARAMETERS + + // The screening parameter + // (Z1 = 1, Z2 = 6, ScreeningPar = 2.5764E-9) + Z1 = 1; Z2 = 6; + a0=0.529e-8;//unit centimeter + D= exp(2/3*log(Z1))+exp(2/3*log(Z2)); + a=0.885*a0/sqrt(D);//the screening parameter + + // The reduced energy + mass1=1/9; + mass2=12; + // b= 2*Z1*Z2*eSquare*(mass1+mass2)/(mass1*mass2*v*v); + //b= Z1*Z2 * e²[keV*cm] * (m1+m2)/m2 * 1/Energy[keV] + b= Z1*Z2*eSquare*(mass1+mass2)/(mass2*Energy); + epsilon = a/b; + std::cout<<"\n€: "<>thetaSchlange; + + + GET.GFunctions(&g1,&g2,tau); + + std::cout<< "g1("<> 20*(a/r0)^(4/3) sein muss. Fuer Protonen auf +c Graphit ist laut Referenz a/r0 gleich 0.26 (mit Dichte von 3.5 g/ccm habe +c ich einen Wert von 0.29 abgeschaetzt). Fuer Myonen hat man den selben +c Wert zu nehmen. Damit ergibt sich die Forderung, dass n >> 3.5 sein muss. +c +c (2) unabhaengig von (1) n >> 5 sein muss, was (1) also mit einschliesst. +c +c Mit n = Pi*r0*r0*Teilchen/Flaeche ergibt sich fuer eine Foliendicke von +c 3 ug/cm^2 als Abschaetzung fuer n ein Wert von 37. (r0 ueber r0 = 0.5 N^(1/3) +c und 3.5 g/ccm zu 8.9e-9 cm abgeschaetzt). D.h., dass die Bedingungen in +c unserem Fall gut erfuellt sind. +c In dem Paper wird eine Formel fuer Halbwertsbreiten angegeben. Ich habe nicht +c kontrolliert, in wie weit die Form der Verteilung tatsaechlich einer Gauss- +c verteilung entspricht. Zumindest im Bereich der Vorwaertsstreuung sollte +c die in diesem Programm verwendete Gaussverteilung aber eine sehr gute +c Naeherung abgeben. Abweichungen bei groesseren Winkeln koennten jedoch u. U. +c die absolute Streuintensitaet in Vorwaertsrichtung verfaelschen. + + + + + +c (...) + + +c 1071 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +c Falls 'fromScratch': +c Die in den ab hier beginnenden Startparameter-Schleifen gesetzten Werte +c werden gegebenenfalls weiter unten durch zufallsverteilte Offsets modi- +c fiziert. (-> 'Zufallschleife': 'do 100 randomloop_ = 1, n_par(0)) +c Andernfalls: +c Wurden waehrend ACCEL oder 'foilfile' fuer die Startparameter Zufalls- +c verteilungen verwendet, so werden die entsprechenden Groessen aus dem +c betreffenden NTupel eingelesen. +c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +c Startparameter: +c --------------- + + do 200 E0_ = par(1,ener),par(2,ener),par(3,ener) ! E0 + if (.NOT.random_E0) then + E0 = E0_ + v0_Betrag = sqrt(E0/Energie_Faktor) + endif + + if (E0InterFromFile) then + lowerE0 = E0Low(nInt(E0_)) + upperE0 = E0Low(nint(E0_+1)) + endif + + +c falls Energieverlustberechnung aus ICRU-Tabelle verlangt ist und mittlerer +c Energieverlust nicht fuer jedes Teilchen extra berechnet werden soll (sinnvoll +c wenn alle Teilchen gleiche Startenergie haben oder Streuung der Startenergien +c klein ist, so dass die Streuung des mittleren Energieverlustes vernachlaessigt +c werden kann): + + if (log_E_Verlust_ICRU .AND. .NOT.calculate_each) then + if (random_E0_equal) then + Ekin = E0_ + (upperE0+lowerE0)/2. + else + Ekin = E0_ + endif + if (Gebiet0.EQ.target .OR. Gebiet0.EQ.upToGrid1) then + Ekin = Ekin + q*(U_Tgt - U_F) + elseif (Gebiet0.EQ.upToGrid2) then + Ekin = Ekin + q*(U_G1 - U_F) + endif + call CALC_ELOSS_ICRU(Ekin,q,m,Thickness,mean_E_Verlust) + endif + + if (log_Meyer_F_Function) then + if (random_E0_equal) then + Ekin = E0_ + (upperE0+lowerE0)/2. + else + Ekin = E0_ + endif + if (Gebiet0.EQ.target .OR. Gebiet0.EQ.upToGrid1) then + Ekin = Ekin + q*(U_Tgt - U_F) + elseif (Gebiet0.EQ.upToGrid2) then + Ekin = Ekin + q*(U_G1 - U_F) + endif + effRedThick = Meyer_Faktor1 * Thickness + call Get_F_Function_Meyer(effRedThick,Ekin) + endif + + do 200 theta0_ = par(1,thetAng),par(2,thetAng),par(3,thetAng) ! theta0 + if (.NOT.random_angle) then + theta0 = theta0_ + Cos_theta0 = cosd(theta0) + Sin_theta0 = sind(theta0) + endif + do 200 phi0_ = par(1,phiAng),par(2,phiAng),par(3,phiAng) ! phi0 + if (.NOT.random_angle) then + phi0 = phi0_ + Cos_phi0 = cosd(phi0) + Sin_phi0 = sind(phi0) + endif + + do 200 y0_ = par(1,yPos),par(2,yPos),par(3,yPos) ! y0 + if (.NOT.random_pos) then + x0(2) = y0_ + endif + + do 200 z0_ = par(1,zPos),par(2,zPos),par(3,zPos) ! z0 + if (.NOT.random_pos) then + x0(3) = z0_ + endif + +c die folgenden parWert(n) werden u.U. in der 'Zufallsschleife' weiter unten +c abgeaendert. Hier werden sie in jedem Fall fuer Tabellenausgaben, Debug- +c angelegenheiten u.s.w. erst einmal mit den aktuellen Werten der +c entsprechenden Schleifen gefuellt: + + parWert(ener) = E0_ + parWert(thetAng) = theta0_ + parWert(phiAng) = phi0_ + parWert(yPos) = y0_ + parWert(zPos) = z0_ + + +c falls fruehere Simulation fortgefuehrt wird: +c Berechne diejenige Eventnummer in NTP_read, ab welcher die relevanten +c Simulationsparameter von ACCEL bzw. des 'FoilFiles' mit den gegenwaertigen +c MUTRACK-(Schleifen)-Parametern uebereinstimmen: + + if (.NOT.fromScratch) eventNr = firstEventNr() + + + + + + +c (...) + + + + + +c 3106 +c Einsprunglabel fuer Starts auf der Triggerfolie mit Startwinkelangaben +c im Kammersystem => transformiere Geschwindigkeitsvektor in das Triggersystem: + +111 if (alfaTD.NE.0) then + help1= v(1) ! zur Zwischenspeicherung + v(1) = help1*Cos_alfaTD + v(2)*Sin_alfaTD + v(2) = -help1*Sin_alfaTD + v(2)*Cos_alfaTD + endif + + +c - pruefe, ob das Projektil die Folie trifft: + +112 radiusQuad = x(2)*x(2) + x(3)*x(3) + If (radiusQuad.GT.radiusQuad_Folie) then + ! zurueckrechnen in das Kammersystem: + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + + destiny = code_vorbei + goto 555 + endif + + +c So verlangt, schreibe die aktuellen Trajektoriengroessen in das 'FoilFile': +c (hier ist sichergestellt, dass die Folie getroffen worden ist, Wechsel- +c wirkungen mit der Folie wurden aber noch nicht beruecksichtigt). +c HIER WERDEN 'X' UND 'V' IM TRIGGERSYSTEM ABGESPEICHERT! + + if (createFoilFile) then + ! falls die Flugzeit bis zur Triggerfolie verschmiert in das + ! NTupel aufgenommen werden soll: + if (smearS1Fo) then + call Gauss_Verteilung(sigmaS1Fo,help4) + S1FoOnly = t + help4 + endif + if (NTP_stop) then + Ekin=(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))*Energie_Faktor + endif + call HFNT(NTP_write) + NTPalreadyWritten = .true. + endif + + +c - Zeitpunkt bei Erreichen der Folie sichern: + +113 S1Fo = t + if (createNTP.AND.Fo_triggered) fill_NTP = .true. + if (statNeeded(Nr_S1Fo)) call fill_statMem(S1Fo,Nr_S1Fo) + + + +c - Speichern der Koordinaten fuer die Statistiken: + + if (statNeeded(Nr_y_Fo)) then + call fill_statMem( x(2),Nr_y_Fo) + endif + if (statNeeded(Nr_z_Fo)) then + call fill_statMem( x(3),Nr_z_Fo) + endif + if (statNeeded(Nr_r_Fo)) then + radius = SQRT(x(2)*x(2) + x(3)*x(3)) + call fill_statMem(radius,Nr_r_Fo) + endif + + +c - speichere Auftreffort des Projektils fuer die Berechnung der Folienelektronen: + + if (generate_FE) then + x0FE(1) = x(1) + x0FE(2) = x(2) + x0FE(3) = x(3) + endif + + +c - falls nur bis zur Folie gerechnet werden soll, beende hier die Integration: + + if (upToTDFoilOnly) then + ! zurueckrechnen in das Kammersystem: + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + if (generate_FE) Gebiet = UpToExTD + goto 555 + endif + + +c - pruefe, ob das Projektil auf das Stuetzgitter aufschlaegt: + + if (testOnWireHit .AND. ran(seed).GT.TransTDFoil) then + destiny = code_Stuetzgitter + ! zurueckrechnen in das Kammersystem: + if (alfaTD.NE.0) then + help1= x(1) + x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - + + x(2)*Sin_alfaTD + xTD + x(2) = (help1-d_Folie_Achse)*Sin_alfaTD + + + x(2)*Cos_alfaTD + help1= v(1) + v(1) = help1*Cos_alfaTD - v(2)*Sin_alfaTD + v(2) = help1*Sin_alfaTD + v(2)*Cos_alfaTD + else + x(1) = x(1) + xTD - d_Folie_Achse + endif + goto 555 + endif + + +c - Energieverlust und Winkelaufstreuung: + + if (log_E_Verlust .OR. log_Aufstreu) then + if (Debug_) then + Steps = Steps + 1 + call Output_Debug + endif + v_square = v(1)*v(1) + v(2)*v(2) + v(3)*v(3) + v_Betrag = SQRT(v_square) + Ekin = v_square * Energie_Faktor + endif + +c -- Energieverlust (vorerst nur Gaussverteilt): + + if (log_E_Verlust_defined.OR.log_Meyer_Gauss) then + ! Berechne Bahnwinkel relativ zur Folienebene fuer effektive Folien- + ! dicke: + alfa = atand(SQRT(v(2)*v(2)+v(3)*v(3))/v(1)) + endif + + if (log_E_Verlust) then + if (calculate_each) then + call CALC_ELOSS_ICRU(Ekin,q,m,Thickness,E_Verlust) + else + E_Verlust = mean_E_Verlust + endif + if (log_E_Verlust_defined) E_Verlust = E_Verlust / cosd(alfa) + if (debug_) write (lunLOG,*) ' mittlerer Energieverlust: ',E_Verlust + + ! Now we have the mean energy loss. We still have to modify it + ! according to the distribution of energy losses, i.e. + ! E_Verlust -> E_Verlust + delta_E_Verlust: + + delta_E_Verlust = 0. + if (log_E_Straggling_sigma) then +400 call Gauss_Verteilung(sigmaE,delta_E_Verlust) + if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust + if (E_Verlust+delta_E_Verlust.LT.0.) goto 400 + elseif (log_E_Straggling_equal) then +410 delta_E_Verlust = lowerE + (upperE - lowerE)*ran(seed) + if (E_Verlust+delta_E_Verlust.LT.0) goto 410 + elseif (log_E_Straggling_Lindhard) then + ! Streuung in Abhaengigkeit von mittlerer Energie in Folie: + call E_Straggling_Lindhard(Ekin-0.5*E_Verlust,m,sigmaE) +420 call Gauss_Verteilung(sigmaE,delta_E_Verlust) + if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust + if (E_Verlust+delta_E_Verlust.LT.0.) goto 420 + elseif (log_E_Straggling_Yang) then + ! Streuung in Abhaengigkeit von mittlerer Energie in Folie! + call E_Straggling_Yang(Ekin-0.5*E_Verlust,m,sigmaE) +430 call Gauss_Verteilung(sigmaE,delta_E_Verlust) + if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust + if (E_Verlust+delta_E_Verlust.LT.0.) goto 430 + endif + + if (E_Verlust+delta_E_Verlust.GE.Ekin) then + destiny = code_stopped_in_foil + goto 555 + endif + E_Verlust = E_Verlust + delta_E_Verlust + + ! help1 == Reduzierungsfaktor fuer Geschw.Betrag + help1 = sqrt( (Ekin - E_Verlust)/Ekin ) + v(1) = help1 * v(1) + v(2) = help1 * v(2) + v(3) = help1 * v(3) + v_Betrag = help1 * v_Betrag + if (debug_) write (lunLOG,*) ' Energieverlust: ',E_Verlust + endif + +c -- Winkelaufstreuung (vorerst nur Gaussverteilt): + + if (log_aufstreu) then + if (log_Meyer_F_Function) then + call throwMeyerAngle(thetaAufstreu) + else + if (log_Meyer_Gauss) then + if (log_E_Verlust) Ekin = Ekin - .5 * E_Verlust ! mittlere Energie + effRedThick = Meyer_Faktor1 * Thickness / cosd(alfa) + call g_Functions(g1,g2,effRedThick) + sigmaAufstreu = Meyer_Faktor2 / Ekin * (g1 + Meyer_Faktor3*g2) + if (debug_) then + write (lunLOG,*) ' effekt. red. Dicke: ',effRedThick + write (lunLOG,*) ' Sigma(Streuwinkel): ',sigmaAufstreu + endif + endif + + call Gauss_Verteilung_theta(sigmaAufstreu,thetaAufstreu) + endif + + st0 = sind(thetaAufstreu) + ct0 = cosd(thetaAufstreu) + phiAufstreu = 360.*ran(seed) + + v_xy = SQRT(v(1)*v(1) + v(2)*v(2)) ! v_xy stets groesser 0 + ! wegen v(1)>0 + + help1 = v(1) + help2 = v(2) + help3 = v_Betrag*st0*cosd(phiAufstreu)/v_xy + help4 = st0*sind(phiAufstreu) + + v(1) = ct0*help1 - help3*help2 - help4*help1*v(3)/v_xy + v(2) = ct0*help2 + help3*help1 - help4*help2*v(3)/v_xy + v(3) = ct0*v(3) + help4*v_xy + if (debug_) write (lunLOG,*) ' Aufstreuung: theta, phi =', + + thetaAufstreu,phiAufstreu + endif + + if (Debug_ .AND. (log_E_Verlust .OR. log_Aufstreu)) then + call Output_Debug + endif + + +c - Neutralisierung in der Folie? + + if (log_neutralize) then + if (neutral_fract(q_).EQ.-1.0) then + v_square = v(1)*v(1) + v(2)*v(2) + v(3)*v(3) + Ekin = v_square * Energie_Faktor + call chargeStateYields(Ekin,m,YieldPlus,YieldNeutral) + YieldNeutral = 100. * YieldNeutral + else + YieldNeutral = neutral_fract(q_) + endif + if (100.*ran(seed).LE.YieldNeutral) then + q = 0. + qInt = 0 + if (debug_) then + write (lunLOG,*) ' Teilchen wurde neutralisiert' + endif + nNeutral = nNeutral + 1 + else + nCharged = nCharged + 1 + endif + endif + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + + +c (...) +c4300 +c=============================================================================== + + + OPTIONS /EXTEND_SOURCE + + SUBROUTINE G_Functions(G1,G2,tau) +c ================================= + +c Diese Routine gibt in Abhaengigkeit von der reduzierten Dicke 'tau' +c Funktionswerte fuer g1 und g2 zurueck. g1 und g2 sind dabei die von +c Meyer angegebenen tabellierten Funktionen fuer die Berechnung von Halbwerts- +c breiten von Streuwinkelverteilungen. (L.Meyer, phys.stat.sol. (b) 44, 253 +c (1971)) + + IMPLICIT NONE + + real tau,g1,g2 + real tau_(26),g1_(26),g2_(26) + real help + + integer i + + DATA tau_ /0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, + + 2.5, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, 7.0, 8.0, 9.0, + + 10.0, 12.0, 14.0, 16.0, 18.0, 20.0 / + + DATA g1_ /0.050,0.115,0.183,0.245,0.305,0.363,0.419,0.473,0.525,0.575, + + 0.689,0.799,0.905,1.010,1.100,1.190,1.370,1.540,1.700,1.850, + + 1.990,2.270,2.540,2.800,3.050,3.290 / + DATA g2_ / 0.00,1.25,0.91,0.79,0.73,0.69,0.65,0.63,0.61,0.59, + + 0.56,0.53,0.50,0.47,0.45,0.43,0.40,0.37,0.34,0.32, + + 0.30,0.26,0.22,0.18,0.15,0.13 / + + if (tau.LT.tau_(1)) then + write(*,*) + write(*,*)'SUBROUTINE G_Functions:' + write(*,*)' Fehler bei Berechnung der g-Funktionen fuer Winkelaufstreuung:' + write(*,*)' aktuelles tau ist kleiner als kleinster Tabellenwert:' + write(*,*)' tau = ',tau + write(*,*)' tau_(1) = ',tau_(1) + write(*,*) + STOP + endif + + i = 1 + +10 i = i + 1 + if (i.EQ.27) then + write(*,*) + write(*,*)'SUBROUTINE G_Functions:' + write(*,*)' Fehler bei Berechnung der g-Funktionen fuer Winkelaufstreuung:' + write(*,*)' aktuelles tau ist groesser als groesster Tabellenwert:' + write(*,*)' tau = ',tau + write(*,*)' tau_(26) = ',tau_(26) + write(*,*) + STOP + elseif (tau.gt.tau_(i)) then + goto 10 + endif + + +c lineare Interpolation zwischen Tabellenwerten: + + help = (tau-tau_(i-1))/(tau_(i)-tau_(i-1)) + + g1 = g1_(i-1) + help*(g1_(i)-g1_(i-1)) + g2 = g2_(i-1) + help*(g2_(i)-g2_(i-1)) + + + END + + +c=============================================================================== + + options /extend_source + + subroutine Get_F_Function_Meyer(tau,Ekin) +c ========================================= + + implicit none + + real tau + real Ekin + + real thetaSchlange,thetaSchlangeMax + real theta,thetaMax,thetaStep + real f1,f2,F + + +c------------------------------------ +c - Parameter: + + real Z1, Z2 ! die atomaren Nummern von Projektil und Target +c real a0 ! Bohrscher Radius in cm + real screeningPar ! Screeningparameter 'a' in cm fuer Teilchen der + ! Kernladungszahl Z1=1 in Kohlenstoff (Z2 = 6) + ! bei Streichung von Z1 (vgl. Referenz, S. 268) + + real r0Meyer ! r0(C) berechnet aus dem screeningParameter 'a' + ! und dem ebenfalls bei Meyer angegebenem + ! Verhaeltnis a/r0=0.26 (vgl. Referenz, S. 263 oben) + real eSquare ! elektrische Ladung zum Quadrat in keV*cm + + real Pi ! die Kreiszahl + +c parameter (a0 = 5.29E-9) + parameter (Z1 = 1, Z2 = 6, ScreeningPar = 2.5764E-9) + parameter (r0Meyer = 9.909E-9, eSquare = 1.44E-10) + parameter (Pi = 3.141592654) + + real Meyer_Faktor3 + real Meyer_Faktor4 + real zzz ! 'Hilfsparameter' + real Meyer_Faktor5 + + parameter (Meyer_faktor3 = (screeningPar/r0Meyer) * (screeningPar/r0Meyer)) + parameter (Meyer_faktor4 = screeningPar / (2.*Z1*Z2*eSquare) * Pi/180.) + parameter (zzz = screeningPar / (2.*Z1*Z2*eSquare)) + parameter (Meyer_faktor5 = zzz*zzz / (8*Pi*Pi)) + +c------------------------------------ + + integer nBin,nBinMax + parameter (nBinMax=201) + real value(0:nBinMax) /0.,nBinMax*0./ + real area(nBinMax) / nBinMax*0./ + real integ(0:nBinMax) /0.,nBinMax*0./ + common /MeyerTable/ value,area,integ,thetaStep,nBin + + integer i + real rhelp + + integer HB_memsize + parameter(HB_memsize=500000) + real memory(HB_memsize) + COMMON /PAWC/ memory + + +c nur noch fuer Testzwecke: + + real fValues(203) + real fValuesFolded(203) + + integer idh + parameter (idh = 50) + + INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC' + character filename*20 ! Name der Ausgabe-Dateien + COMMON /filename/ filename + +c------------------------------------------------------------------------------- + +c Festlegen des maximalen Theta-Wertes sowie der Schrittweite: + + if (tau.LT.0.2) then + write(*,*) 'Subroutine ''Get_F_Function_Meyer'':' + write(*,*) 'Effektive Dicke ist kleiner als 0.2 => kann ich nicht ... => STOP' + call exit + elseif (tau.LE.2.) then + ! => Tabelle A + thetaSchlangeMax = 4.0 + elseif (tau.LE.8.) then + ! => Tabelle B + thetaSchlangeMax = 7.0 + elseif (tau.LE.20.) then + ! => Tabelle C + thetaSchlangeMax = 20.0 + else + write(*,*) 'Subroutine ''Get_F_Function_Meyer'':' + write(*,*) 'Effektive Dicke ist groesser als 20 => kann ich nicht ... => STOP' + call exit + endif + + thetaMax = thetaSchlangeMax / Meyer_Faktor4 / Ekin + if (thetaMax.GT.50) then + thetaStep = .5 + elseif (thetaMax.GT.25) then + thetaStep = .25 + elseif (thetaMax.GT.12.5) then + thetaStep = .125 + else + thetaStep = .0625 + endif + + +c Tabelle der F-Werte erstellen: + + nBin = 0 + do theta = thetaStep, thetaMax, thetaStep + + ! Berechne aus theta das 'reduzierte' thetaSchlange (dabei gleich + ! noch von degree bei theta in Radiant bei thetaSchlange umrechnen): + + thetaSchlange = Meyer_faktor4 * Ekin * theta + + ! Auslesen der Tabellenwerte fuer die f-Funktionen: + + call F_Functions_Meyer(tau,thetaSchlange,f1,f2) + if (thetaSchlange.EQ.-1) then + ! wir sind jenseits von thetaSchlangeMax + goto 10 + endif + + ! Berechnen der Streuintensitaet: + F = Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2) + + nBin = nBin + 1 + if (nBin.GT.nBinMax) then + write(*,*) 'nBin > nBinMax => EXIT' + call exit + endif + value(nBin) = sind(theta)*F + + fValues(nBin+1) = F ! fuer Testzwecke + fValuesFolded(nBin+1) = sind(theta)*F ! fuer Testzwecke + + enddo + + +c Berechnen der Flaecheninhalte der einzelnen Kanaele sowie der Integrale: + +10 do i = 1, nBin + area(i) = (value(i)+value(i-1))/2. * thetaStep + integ(i) = integ(i-1) + area(i) + enddo + + +c Normiere totale Flaeche auf 1: + + rHelp = integ(nBin) + do i = 1, nBin + value(i) = value(i) / rHelp + area(i) = area(i) / rHelp + integ(i) = integ(i) / rHelp + enddo + + +c vorerst noch: gib Tabelle in Datei und Histogrammfile aus: + + ! Berechne die Werte fuer theta=0: + + call F_Functions_Meyer(tau,0.,f1,f2) + F = Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2) + fValues(1) = F + fValuesFolded(1) = 0. + + ! Gib die Werte in das Tabellenfile aus: + +c theta = 0. +c open (10,file=outDir//':'//filename//'.TAB',status='NEW') +c do i = 1, nBin+1 +c write(10,*) theta, fValues(i), fValuesFolded(i) +c theta = theta + thetaStep +c enddo +c close (10) + + + ! Buchen und Fuellen der Histogramme: + + call HBOOK1(idh,'F',nBin+1,-0.5*thetaStep,(real(nBin)+0.5)*thetaStep,0.) + call HPAK(idh,fValues) + call HRPUT(idh,outDir//':'//filename//'.RZ','N') + call HDELET(idh) + + call HBOOK1(idh+1,'F*sin([q])',nBin+1,-0.5*thetaStep,(real(nBin)+0.5)*thetaStep,0.) + call HPAK(idh+1,fValuesFolded) + call HRPUT(idh+1,outDir//':'//filename//'.RZ','U') + call HDELET(idh+1) + + + END + + +c=============================================================================== + + options /extend_source + + subroutine throwMeyerAngle (theta) +c ================================== + + implicit none + + real lowerbound,y1,y2,f,root,radiant,fraction + integer bin,nBin + integer nBinMax + parameter (nBinMax=201) + + real theta,thetaStep + real value(0:nBinMax) /0.,nBinMax*0./ + real area(nBinMax) / nBinMax*0./ + real integ(0:nBinMax) /0.,nBinMax*0./ + common /MeyerTable/ value,area,integ,thetaStep,nBin + + real rhelp + + real random + integer seed + common /seed/ seed + + +c bin: Nummer des Bins, innerhalb dessen das Integral den Wert von +c random erreicht oder ueberschreitet: + + random = ran(seed) + + bin = 1 + do while (random.GT.integ(bin)) + bin = bin + 1 + if (bin.GT.nBin) then + write(*,*) 'error 1' + call exit + endif + enddo + + fraction = (random-integ(bin-1)) / (integ(bin)-integ(bin-1)) + y1 = value(bin-1) + y2 = value(bin) + f = thetaStep / (y2-y1) + rHelp = y1*f + + radiant = rHelp*rHelp + fraction*thetaStep*(y1+y2)*f + root = SQRT(radiant) + lowerBound = real(bin-1)*thetaStep + if (f.GT.0) then + theta = lowerBound - rHelp + root + else + theta = lowerBound - rHelp - root + endif + + + END + + +c=============================================================================== + + options /extend_source + + subroutine F_Functions_Meyer(tau,thetaSchlange,f1,f2) +c ===================================================== + + implicit none + +c Diese Routine gibt in Abhaengigkeit von 'thetaSchlange' und 'tau' +c Funktionswerte fuer f1 und f2 zurueck. f1 und f2 entsprechen dabei den +c bei Meyer angegebenen Funktion gleichen Namens. Die in dieser Routine +c verwendeten Tabellen sind eben dieser Referenz entnommen: +c L.Meyer, phys.stat.sol. (b) 44, 253 (1971) + + real tau,thetaSchlange + real f1, f2, f1_(2), f2_(2) + + integer column_,column,row + + integer iColumn + real weightCol, weightRow + +c------------------------------------------------------------------------------- + +c die Tabellendaten der Referenz (Tabellen 2 und 3): + + integer nColumn + parameter (nColumn = 25) + real tau_(nColumn) / + + 0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.5, 3.0, + + 3.5, 4.0, 4.5, 5.0, 6.0, 7.0, 8.0, 10., 12., 14., 16., 18., 20. / + + integer nRowA + parameter (nRowA = 25) + real thetaSchlangeA(nRowA) / + + .00, .05, .10, .15, .20, .25, .30, .35, .40, .45, .50, .60, + + .70, .80, .90, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.5, 3.0, 3.5, 4.0 / + + integer nRowB + parameter (nRowB = 24) + real thetaSchlangeB(nRowB) / + + 0.0, 0.2, 0.4, 0.5, 0.6, 0.8, 1.0, 1.2, 1.4, 1.5, 1.6, 1.8, + + 2.0, 2.2, 2.4, 2.6, 2.8, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, 7.0 / + + integer nRowC + parameter (nRowC = 24) + real thetaSchlangeC(nRowC) / + + 0.0, 0.5, 1.0, 1.5, 2.0, 2.5, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, + + 7.0, 8.0, 9.0, 10., 11., 12., 13., 14., 15., 16., 18., 20. / + + + real f1_A(9,nRowA) + + /1.69E+2,4.55E+1,2.11E+1,1.25E+1,8.48E+0,6.21E+0,4.80E+0,3.86E+0,3.20E+0, + + 9.82E+1,3.72E+1,1.97E+1,1.20E+1,8.27E+0,6.11E+0,4.74E+0,3.83E+0,3.17E+0, + + 3.96E+1,2.58E+1,1.65E+1,1.09E+1,7.73E+0,5.82E+0,4.58E+0,3.72E+0,3.10E+0, + + 1.76E+1,1.58E+1,1.27E+1,9.26E+0,6.93E+0,5.38E+0,4.31E+0,3.55E+0,2.99E+0, + + 8.62E+0,1.01E+1,9.45E+0,7.58E+0,6.02E+0,4.85E+0,3.98E+0,3.33E+0,2.84E+0, + + 4.65E+0,6.55E+0,6.91E+0,6.06E+0,5.11E+0,4.28E+0,3.62E+0,3.08E+0,2.66E+0, + + 2.74E+0,4.45E+0,5.03E+0,4.78E+0,4.27E+0,3.72E+0,3.23E+0,2.82E+0,2.47E+0, + + 1.77E+0,3.02E+0,3.71E+0,3.76E+0,3.53E+0,3.20E+0,2.86E+0,2.55E+0,2.27E+0, + + 1.22E+0,2.19E+0,2.78E+0,2.96E+0,2.91E+0,2.73E+0,2.51E+0,2.28E+0,2.07E+0, + + 8.82E-1,1.59E+0,2.12E+0,2.35E+0,2.39E+0,2.32E+0,2.19E+0,2.03E+0,1.87E+0, + + 6.55E-1,1.20E+0,1.64E+0,1.88E+0,1.97E+0,1.96E+0,1.90E+0,1.79E+0,1.68E+0, + + 3.80E-1,7.15E-1,1.01E+0,1.22E+0,1.35E+0,1.40E+0,1.41E+0,1.39E+0,1.34E+0, + + 2.26E-1,4.45E-1,6.44E-1,8.08E-1,9.28E-1,1.01E+0,1.05E+0,1.06E+0,1.05E+0, + + 1.39E-1,2.80E-1,4.21E-1,5.45E-1,6.46E-1,7.22E-1,7.75E-1,8.07E-1,8.21E-1, + + 8.22E-2,1.76E-1,2.78E-1,3.71E-1,4.53E-1,5.21E-1,5.74E-1,6.12E-1,6.37E-1, + + 5.04E-2,1.11E-1,1.86E-1,2.57E-1,3.22E-1,3.79E-1,4.27E-1,4.65E-1,4.94E-1, + + 2.51E-2,5.60E-2,9.24E-2,1.31E-1,1.69E-1,2.02E-1,2.40E-1,2.71E-1,2.97E-1, + + 1.52E-2,3.20E-2,5.08E-2,7.23E-2,9.51E-2,1.18E-1,1.41E-1,1.63E-1,1.83E-1, + + 1.03E-2,2.05E-2,3.22E-2,4.55E-2,6.01E-2,7.53E-2,9.02E-2,1.05E-1,1.19E-1, + + 8.80E-3,1.48E-2,2.25E-2,3.13E-2,4.01E-2,5.03E-2,6.01E-2,7.01E-2,8.01E-2, + + 6.10E-3,1.15E-2,1.71E-2,2.28E-2,2.89E-2,3.52E-2,4.18E-2,4.86E-2,5.55E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,1.71E-2,1.98E-2,2.28E-2,2.58E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,8.90E-3,1.02E-2,1.16E-2,1.31E-2, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,4.90E-3,5.70E-3,6.40E-3,7.20E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,2.90E-3,3.40E-3,3.90E-3,4.30E-3/ + + real f1_B(9,nRowB) + + /2.71E+0,1.92E+0,1.46E+0,1.16E+0,9.52E-1,8.03E-1,6.90E-1,5.32E-1,4.28E-1, + + 2.45E+0,1.79E+0,1.39E+0,1.12E+0,9.23E-1,7.82E-1,6.75E-1,5.23E-1,4.23E-1, + + 1.87E+0,1.48E+0,1.20E+0,9.96E-1,8.42E-1,7.24E-1,6.32E-1,4.98E-1,4.07E-1, + + 1.56E+0,1.30E+0,1.09E+0,9.19E-1,7.89E-1,6.86E-1,6.03E-1,4.80E-1,3.95E-1, + + 1.28E+0,1.11E+0,9.62E-1,8.33E-1,7.27E-1,6.40E-1,5.69E-1,4.59E-1,3.81E-1, + + 8.23E-1,7.90E-1,7.29E-1,6.64E-1,6.01E-1,5.44E-1,4.94E-1,4.12E-1,3.49E-1, + + 5.14E-1,5.36E-1,5.29E-1,5.07E-1,4.78E-1,4.47E-1,4.16E-1,3.60E-1,3.13E-1, + + 3.19E-1,3.58E-1,3.76E-1,3.78E-1,3.70E-1,3.57E-1,3.45E-1,3.08E-1,2.76E-1, + + 2.02E-1,2.40E-1,2.64E-1,2.77E-1,2.82E-1,2.80E-1,2.65E-1,2.59E-1,2.39E-1, + + 1.67E-1,1.96E-1,2.20E-1,2.36E-1,2.44E-1,2.47E-1,2.45E-1,2.35E-1,2.21E-1, + + 1.33E-1,1.61E-1,1.85E-1,2.02E-1,2.12E-1,2.18E-1,2.18E-1,2.14E-1,2.03E-1, + + 8.99E-2,1.12E-1,1.32E-1,1.48E-1,1.59E-1,1.67E-1,1.68E-1,1.75E-1,1.72E-1, + + 6.24E-2,7.94E-2,9.50E-2,1.09E-1,1.20E-1,1.29E-1,1.35E-1,1.42E-1,1.43E-1, + + 4.55E-2,5.74E-2,6.98E-2,8.11E-2,9.09E-2,9.92E-2,1.06E-1,1.15E-1,1.19E-1, + + 3.35E-2,4.22E-2,5.19E-2,6.11E-2,6.95E-2,7.69E-2,8.33E-2,9.28E-2,9.85E-2, + + 2.50E-2,3.16E-2,3.92E-2,4.66E-2,5.35E-2,6.00E-2,6.57E-2,7.49E-2,8.13E-2, + + 1.90E-2,2.40E-2,2.99E-2,3.58E-2,4.16E-2,4.70E-2,5.20E-2,6.05E-2,6.70E-2, + + 1.47E-2,1.86E-2,2.32E-2,2.79E-2,3.25E-2,3.70E-2,4.12E-2,4.89E-2,5.51E-2, + + 8.10E-3,1.04E-2,1.30E-2,1.57E-2,1.84E-2,2.12E-2,2.40E-2,2.93E-2,3.42E-2, + + 4.80E-3,6.20E-3,7.70E-3,9.30E-3,1.09E-2,1.26E-2,1.44E-2,1.79E-2,2.14E-2, + + 2.80E-3,3.80E-3,4.70E-3,5.70E-3,6.70E-3,7.50E-3,8.90E-3,1.13E-2,1.36E-2, + + 1.70E-3,2.30E-3,2.90E-3,3.60E-3,4.20E-3,4.90E-3,5.60E-3,7.20E-3,8.80E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,2.00E-3,2.80E-3,3.50E-3, + + 0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,0.00 ,8.80E-4,1.20E-3,1.60E-3/ + + real f1_C(7,nRowC) + + /3.65E-1,2.62E-1,2.05E-1,1.67E-1,1.41E-1,1.21E-1,1.05E-1, + + 3.33E-1,2.50E-1,1.95E-1,1.61E-1,1.36E-1,1.18E-1,1.03E-1, + + 2.75E-1,2.18E-1,1.76E-1,1.48E-1,1.27E-1,1.11E-1,9.80E-2, + + 2.04E-1,1.75E-1,1.50E-1,1.29E-1,1.13E-1,1.01E-1,9.00E-2, + + 1.41E-1,1.31E-1,1.19E-1,1.08E-1,9.71E-2,8.88E-2,8.01E-2, + + 9.32E-2,9.42E-2,9.10E-2,8.75E-2,8.00E-2,7.44E-2,6.91E-2, + + 5.98E-2,6.52E-2,6.72E-2,6.62E-2,6.40E-2,6.12E-2,5.82E-2, + + 3.83E-2,4.45E-2,4.80E-2,4.96E-2,4.98E-2,4.90E-2,4.77E-2, + + 2.46E-2,3.01E-2,3.40E-2,3.65E-2,3.79E-2,3.84E-2,3.83E-2, + + 1.59E-2,2.03E-2,2.39E-2,2.66E-2,2.85E-2,2.97E-2,3.04E-2, + + 1.04E-2,1.37E-2,1.66E-2,1.92E-2,2.12E-2,2.27E-2,2.37E-2, + + 4.39E-3,6.26E-3,8.26E-3,9.96E-3,1.15E-2,1.29E-2,1.41E-2, + + 2.06E-3,3.02E-3,4.24E-3,5.28E-3,6.32E-3,7.32E-3,8.26E-3, + + 1.21E-3,1.69E-3,2.24E-3,2.85E-3,3.50E-3,4.16E-3,4.82E-3, + + 8.50E-4,1.10E-3,1.38E-3,1.65E-3,2.03E-3,2.45E-3,2.88E-3, + + 5.90E-4,7.40E-4,8.50E-4,9.90E-4,1.23E-3,1.49E-3,1.71E-3, + + 3.90E-4,4.60E-4,5.20E-4,6.30E-4,7.65E-4,9.65E-4,1.12E-3, + + 2.40E-4,2.70E-4,3.10E-4,3.98E-4,4.97E-4,6.03E-4,7.18E-4, + + 1.50E-4,1.70E-4,2.15E-4,2.70E-4,3.35E-4,4.35E-4,5.00E-4, + + 1.00E-4,1.20E-4,1.46E-4,1.90E-4,2.40E-4,2.88E-4,3.43E-4, + + 0.00 ,0.00 ,1.04E-4,1.41E-4,1.80E-4,2.10E-4,2.50E-4, + + 0.00 ,0.00 ,8.20E-5,1.06E-4,1.38E-4,1.58E-4,1.85E-4, + + 0.00 ,0.00 ,5.40E-5,7.00E-5,8.60E-5,1.03E-4,1.20E-4, + + 0.00 ,0.00 ,4.20E-5,5.40E-5,6.50E-5,7.70E-5,8.80E-5/ + + real f2_A(9,nRowA) + + / 3.52E+3, 3.27E+2, 9.08E+1, 3.85E+1, 2.00E+1, 1.18E+1, 7.55E+0, 5.16E+0, 3.71E+0, + + 2.58E+2, 1.63E+2, 7.30E+1, 3.42E+1, 1.85E+1, 1.11E+1, 7.18E+0, 4.96E+0, 3.59E+0, + + -1.12E+2, 4.84E+0, 3.56E+1, 2.34E+1, 1.45E+1, 9.33E+0, 6.37E+0, 4.51E+0, 3.32E+0, + + -5.60E+1,-1.12E+1, 9.87E+0, 1.24E+1, 9.59E+0, 7.01E+0, 5.16E+0, 3.83E+0, 2.91E+0, + + -2.13E+1,-1.22E+1,-2.23E+0, 3.88E+0, 5.15E+0, 4.65E+0, 3.87E+0, 3.12E+0, 2.45E+0, + + -8.25E+0,-9.58E+0,-5.59E+0,-1.40E+0, 1.76E+0, 2.71E+0, 2.71E+0, 2.35E+0, 1.95E+0, + + -3.22E+0,-6.12E+0,-5.28E+0,-2.87E+0,-1.92E-1, 1.32E+0, 1.69E+0, 1.74E+0, 1.48E+0, + + -1.11E+0,-3.40E+0,-4.12E+0,-3.08E+0,-6.30E-1, 3.60E-1, 9.20E-1, 1.03E+0, 1.04E+0, + + -2.27E-1,-2.00E+0,-2.93E+0,-2.69E+0,-1.48E+0,-3.14E-1, 2.69E-1, 5.28E-1, 6.09E-1, + + 1.54E-1,-1.09E+0,-2.10E+0,-2.15E+0,-1.47E+0,-6.77E-1,-1.80E-1, 1.08E-1, 2.70E-1, + + 3.28E-1,-6.30E-1,-1.50E+0,-1.68E+0,-1.34E+0,-8.43E-1,-4.60E-1,-1.85E-1,-4.67E-3, + + 3.32E-1,-2.06E-1,-7.32E-1,-9.90E-1,-9.42E-1,-8.20E-1,-6.06E-1,-4.51E-1,-3.01E-1, + + 2.72E-1,-3.34E-2,-3.49E-1,-5.65E-1,-6.03E-1,-5.79E-1,-5.05E-1,-4.31E-1,-3.45E-1, + + 2.02E-1, 2.80E-2,-1.54E-1,-3.00E-1,-3.59E-1,-3.76E-1,-4.60E-1,-3.40E-1,-3.08E-1, + + 1.38E-1, 4.84E-2,-5.56E-2,-1.44E-1,-2.04E-1,-2.39E-1,-2.54E-1,-2.49E-1,-2.48E-1, + + 9.47E-2, 4.86E-2,-1.08E-2,-6.44E-2,-1.02E-1,-1.34E-1,-1.62E-1,-1.79E-1,-1.87E-1, + + 5.33E-2, 3.71E-2, 1.85E-2, 1.63E-3,-1.69E-2,-3.69E-2,-5.66E-2,-7.78E-2,-9.33E-2, + + 3.38E-2, 2.40E-2, 1.62E-2, 9.90E-3, 3.76E-3,-4.93E-3,-1.66E-2,-3.05E-2,-4.22E-2, + + 2.12E-2, 1.56E-2, 1.05E-2, 7.80E-3, 7.92E-3, 6.30E-3, 3.20E-4,-8.50E-3,-1.66E-2, + + 1.40E-2, 9.20E-3, 5.30E-3, 4.70E-3, 6.31E-3, 8.40E-3, 5.30E-3, 8.80E-4,-3.30E-3, + + 9.20E-3, 4.70E-3, 1.70E-3, 2.60E-3, 4.49E-3, 6.60E-3, 6.00E-3, 4.70E-3, 2.80E-3, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 / + + real f2_B(9,nRowB) + + / 2.75E+0, 1.94E+0, 9.13E-1, 6.06E-1, 4.26E-1, 3.14E-1, 2.40E-1, 1.51E-1, 1.03E-1, + + 1.94E+0, 1.16E+0, 7.56E-1, 5.26E-1, 3.81E-1, 2.87E-1, 2.23E-1, 1.43E-1, 9.78E-2, + + 5.85E-1, 5.04E-1, 4.10E-1, 3.30E-1, 2.69E-1, 2.17E-1, 1.78E-1, 1.22E-1, 8.71E-2, + + 7.83E-2, 2.00E-1, 2.35E-1, 2.19E-1, 1.97E-1, 1.73E-1, 1.48E-1, 1.08E-1, 7.93E-2, + + -1.82E-1, 1.56E-2, 1.04E-1, 1.36E-1, 1.38E-1, 1.31E-1, 1.19E-1, 9.46E-2, 7.19E-2, + + -2.71E-1,-1.66E-1,-7.29E-2,-4.74E-3, 3.60E-2, 5.50E-2, 6.28E-2, 5.98E-2, 5.09E-2, + + -1.87E-1,-1.58E-1,-1.09E-1,-5.80E-2,-2.03E-2, 2.48E-3, 1.99E-2, 3.36E-2, 3.27E-2, + + -1.01E-1,-1.05E-1,-8.95E-2,-6.63E-2,-3.93E-2,-2.38E-2,-9.22E-3, 8.47E-3, 1.52E-2, + + -5.19E-2,-6.47E-2,-6.51E-2,-5.62E-2,-4.51E-2,-3.49E-2,-2.45E-2,-8.19E-3, 2.05E-3, + + -3.68E-2,-4.89E-2,-5.36E-2,-5.06E-2,-4.27E-2,-3.65E-2,-2.80E-2,-1.33E-2,-3.47E-3, + + -2.33E-2,-3.69E-2,-4.41E-2,-4.38E-2,-3.97E-2,-3.50E-2,-2.88E-2,-1.60E-2,-6.68E-3, + + -8.76E-3,-2.07E-2,-2.90E-2,-3.17E-2,-3.09E-2,-2.92E-2,-2.63E-2,-1.79E-2,-1.03E-2, + + -1.20E-3,-1.11E-2,-1.90E-2,-2.20E-2,-2.32E-2,-2.24E-2,-2.10E-2,-1.66E-2,-1.11E-2, + + 1.72E-3,-4.82E-3,-1.02E-2,-1.42E-2,-1.65E-2,-1.66E-2,-1.60E-2,-1.39E-2,-1.09E-2, + + 2.68E-3,-1.18E-3,-5.19E-3,-8.30E-5,-1.01E-2,-1.14E-2,-1.16E-2,-1.16E-2,-9.99E-3, + + 2.81E-3, 8.21E-4,-1.96E-3,-3.99E-3,-5.89E-3,-7.13E-3,-8.15E-3,-9.05E-3,-8.60E-3, + + 2.61E-3, 1.35E-3,-2.99E-4,-1.79E-3,-3.12E-3,-4.44E-3,-5.61E-3,-7.01E-3,-7.27E-3, + + 2.06E-3, 1.45E-3, 4.64E-4,-5.97E-4,-1.71E-3,-2.79E-3,-3.84E-3,-5.29E-3,-5.90E-3, + + 1.07E-3, 9.39E-4, 8.22E-4, 3.58E-4,-1.15E-4,-6.60E-4,-1.18E-3,-2.15E-3,-2.88E-3, + + 4.97E-4, 5.46E-4, 6.15E-4, 5.56E-4, 3.14E-4, 9.80E-5,-1.30E-4,-5.98E-4,-1.07E-4, + + 1.85E-4, 3.11E-4, 4.25E-4, 4.08E-4, 3.63E-4, 3.04E-4, 2.24E-4, 2.80E-5,-2.10E-4, + + 4.80E-5, 1.48E-4, 2.44E-4, 2.80E-4, 3.01E-4, 3.11E-4, 3.13E-4, 2.40E-4, 1.10E-4, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 1.39E-4, 1.80E-4, 1.80E-4, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 4.38E-5, 7.30E-5, 8.40E-5/ + + real f2_C(7,nRowC) + + / 7.36E-2, 4.21E-2, 2.69E-2, 1.83E-2, 1.34E-2, 1.01E-2, 7.88E-3, + + 5.79E-2, 3.61E-2, 2.34E-2, 1.64E-2, 1.21E-2, 9.26E-3, 7.28E-3, + + 2.94E-2, 2.17E-2, 1.60E-2, 1.23E-2, 9.49E-3, 7.45E-3, 5.95E-3, + + 2.30E-3, 7.07E-3, 7.76E-3, 7.02E-3, 6.13E-3, 5.17E-3, 4.34E-3, + + -7.50E-3,-2.00E-3, 9.93E-4, 2.36E-3, 2.82E-3, 2.86E-3, 2.72E-3, + + -8.27E-3,-5.37E-3,-2.58E-3,-7.96E-4, 3.75E-4, 9.71E-4, 1.28E-3, + + -5.79E-3,-5.12E-3,-3.86E-3,-2.46E-3,-1.20E-3,-3.74E-4, 1.74E-4, + + -3.26E-3,-3.43E-3,-3.26E-3,-2.68E-3,-1.84E-3,-1.12E-3,-4.54E-4, + + -1.46E-3,-1.49E-3,-2.20E-3,-2.18E-3,-1.85E-3,-1.40E-3,-8.15E-4, + + -4.29E-4,-9.44E-4,-1.29E-3,-1.50E-3,-1.51E-3,-1.36E-3,-9.57E-4, + + -3.30E-5,-3.66E-4,-6.78E-4,-9.38E-4,-1.09E-3,-1.09E-3,-9.56E-4, + + 1.50E-4, 3.10E-5,-1.38E-4,-3.06E-4,-4.67E-4,-5.48E-4,-6.08E-4, + + 1.00E-4, 8.50E-5, 2.30E-5,-6.60E-5,-1.58E-4,-2.40E-4,-3.05E-4, + + 5.40E-5, 6.50E-5, 4.90E-5, 1.20E-5,-3.60E-5,-8.90E-5,-1.31E-4, + + 2.90E-5, 4.30E-5, 4.40E-5, 2.90E-5, 5.10E-6,-2.20E-5,-4.80E-5, + + 1.40E-5, 2.40E-5, 2.80E-5, 2.60E-5, 1.90E-5, 7.50E-6,-1.10E-5, + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , + + 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , 0.00 / + + +c=============================================================================== + +c Bestimme, welche Reihen der Tabellen fuer Interpolation benoetigt werden: + + if (tau.LT.tau_(1)) then + write(*,*) 'tau is less than the lowest tabulated value:' + write(*,*) 'tau = ',tau + write(*,*) 'minimum = ',tau_(1) + call exit + elseif (tau.GT.tau_(nColumn)) then + write(*,*) 'tau is greater than the highest tabulated value:' + write(*,*) 'tau = ',tau + write(*,*) 'maximum = ',tau_(nColumn) + call exit + endif + + column_ = 2 + do while (tau.GT.tau_(column_)) + column_ = column_ + 1 + enddo + ! Das Gewicht der Reihe zu groesserem Tau: + weightCol = (tau-tau_(column_-1)) / (tau_(column_)-tau_(column_-1)) + + +c Besorge fuer gegebenes 'thetaSchlange' die interpolierten f1- und f2 -Werte +c der beiden relevanten Reihen: +c iColumn = 1 => Reihe mit hoeherem Index +c iColumn = 2 => Reihe mit kleinerem Index + + + iColumn = 1 + + +5 continue + + if (column_.LE.9) then ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 1. Tabelle: 0.2 <= tau <= 1.8 + + column = column_ + + if (thetaSchlange.LT.thetaSchlangeA(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeA(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeA(nRowA)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeA(nRowA) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeA(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeA(row-1)) / + + (thetaSchlangeA(row)-thetaSchlangeA(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_A(column,row-1) + + + weightRow * f1_A(column,row) + f2_(iColumn) = (1.-weightRow) * f2_A(column,row-1) + + + weightRow * f2_A(column,row) + + + elseif (column_.LE.18) then ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 2. Tabelle: 2.0 <= tau <= 7.0 + + column = column_ - 9 + + if (thetaSchlange.LT.thetaSchlangeB(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeB(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeB(nRowB)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeB(nRowB) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeB(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeB(row-1)) / + + (thetaSchlangeB(row)-thetaSchlangeB(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_B(column,row-1) + + + weightRow * f1_B(column,row) + f2_(iColumn) = (1.-weightRow) * f2_B(column,row-1) + + + weightRow * f2_B(column,row) + + + else ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ! Werte aus 3. Tabelle: 8.0 <= tau <= 20. + + column = column_ - 18 + + if (thetaSchlange.LT.thetaSchlangeC(1)) then + write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:' + write(*,*) 'thetaSchlange = ',thetaSchlange + write(*,*) 'minimum = ',thetaSchlangeC(1) + call exit + elseif (thetaSchlange.GT.thetaSchlangeC(nRowC)) then +c write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:' +c write(*,*) 'thetaSchlange = ',thetaSchlange +c write(*,*) 'maximum = ',thetaSchlangeC(nRowC) +c call exit + thetaSchlange = -1. + RETURN + endif + + row = 2 + do while (thetaSchlange.GT.thetaSchlangeC(row)) + row = row + 1 + enddo + ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange: + weightRow = (thetaSchlange-thetaSchlangeC(row-1)) / + + (thetaSchlangeC(row)-thetaSchlangeC(row-1)) + + f1_(iColumn) = (1.-weightRow) * f1_C(column,row-1) + + + weightRow * f1_C(column,row) + f2_(iColumn) = (1.-weightRow) * f2_C(column,row-1) + + + weightRow * f2_C(column,row) + + + endif ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + + if (iColumn.EQ.1) then + column_ = column_ - 1 + iColumn = 2 + goto 5 + endif + + f1 = weightCol*f1_(1) + (1.-weightCol)*f1_(2) + f2 = weightCol*f2_(1) + (1.-weightCol)*f2_(2) + + + END + + +c=============================================================================== +