diff --git a/lib/nr/ansi/data/dates1.dat b/lib/nr/ansi/data/dates1.dat new file mode 100644 index 0000000..f50b706 --- /dev/null +++ b/lib/nr/ansi/data/dates1.dat @@ -0,0 +1,18 @@ +List of dates for testing routines in Chapter 1 +16 entries +12 31 -1 End of millennium +01 01 1 One day later +10 04 1582 Day before Gregorian calendar +10 15 1582 Gregorian calendar adopted +01 17 1706 Benjamin Franklin born +04 14 1865 Abraham Lincoln shot +04 18 1906 San Francisco earthquake +05 07 1915 Sinking of the Lusitania +07 20 1923 Pancho Villa assassinated +05 23 1934 Bonnie and Clyde eliminated +07 22 1934 John Dillinger shot +04 03 1936 Bruno Hauptman electrocuted +05 06 1937 Hindenburg disaster +07 26 1956 Sinking of the Andrea Doria +06 05 1976 Teton dam collapse +05 23 1968 Julian Day 2440000 diff --git a/lib/nr/ansi/data/fncval.dat b/lib/nr/ansi/data/fncval.dat new file mode 100644 index 0000000..f37ba11 --- /dev/null +++ b/lib/nr/ansi/data/fncval.dat @@ -0,0 +1,668 @@ +Values of Special Functions in format x,F(x) or x,y,F(x,y) +Dawson integral +4 Values +0.04 0.0399573606 +0.16 0.1572970920 +1.6 0.3999398943 +10.0 0.0502538471 +Ordinary Bessel Functions nu,x,jnu(x),ynu(x),jnup(x),ynup(x) +20 Values +2.0 1.0 1.149034849E-01 -1.650682607E+00 2.102436159E-01 2.520152392E+00 +2.0 2.0 3.528340286E-01 -6.174081042E-01 2.238907791E-01 5.103756726E-01 +2.0 5.0 4.656511628E-02 3.676628826E-01 -3.462051841E-01 7.979903490E-04 +2.0 10.0 2.546303137E-01 -5.868082442E-03 -7.453316568E-03 2.501890407E-01 +2.0 50.0 -5.971280079E-02 9.579316873E-02 -9.512331609E-02 -6.062739531E-02 +5.0 1.0 2.497577302E-04 -2.604058666E+02 1.227850313E-03 1.268750910E+03 +5.0 2.0 7.039629756E-03 -9.935989128E+00 1.639664542E-02 2.207402959E+01 +5.0 5.0 2.611405461E-01 -4.536948225E-01 1.300918143E-01 2.615525351E-01 +5.0 10.0 -2.340615282E-01 1.354030477E-01 -1.025719220E-01 -2.126510357E-01 +5.0 50.0 -8.140024770E-02 -7.854841391E-02 7.898100205E-02 -8.020323269E-02 +10.0 1.0 2.630615124E-10 -1.216180143E+08 2.618635056E-09 1.209399938E+09 +10.0 2.0 2.515386283E-07 -1.291845422E+05 1.234650294E-06 6.313628817E+05 +10.0 5.0 1.467802647E-03 -2.512911010E+01 2.584677845E-03 4.249433700E+01 +10.0 10.0 2.074861066E-01 -3.598141522E-01 8.436957863E-02 1.605148864E-01 +10.0 50.0 -1.138478491E-01 5.723897182E-03 -4.422891214E-03 -1.116145748E-01 +20.0 1.0 3.873503009E-25 -4.113970315E+22 7.737778395E-24 8.217106466E+23 +20.0 2.0 3.918972805E-19 -4.081651389E+16 3.900270468E-18 4.060105807E+17 +20.0 5.0 2.770330052E-11 -5.933965297E+08 1.074693821E-10 2.294022549E+09 +20.0 10.0 1.151336925E-05 -1.597483848E+03 2.011953903E-05 2.737803151E+03 +20.0 50.0 -1.167043528E-01 1.644263395E-02 -1.368329398E-02 -1.071717186E-01 +Modified Bessel Functions nu,x,inu(x),knu(x),inup(x),knup(x) +28 Values +2.0 0.2 5.016687514E-03 4.951242929E+01 5.033395889E-02 -4.999002654E+02 +2.0 1.0 1.357476698E-01 1.624838899E+00 2.936637645E-01 -3.851585027E+00 +2.0 2.0 6.889484477E-01 2.537597546E-01 9.016884069E-01 -3.936256364E-01 +2.0 2.5 1.276466148E+00 1.214602063E-01 1.495543327E+00 -1.710589814E-01 +2.0 3.0 2.245212441E+00 6.151045847E-02 2.456561923E+00 -8.116340344E-02 +2.0 5.0 1.750561497E+01 5.308943712E-03 1.733339616E+01 -6.168190930E-03 +2.0 10.0 2.281518968E+03 2.150981701E-05 2.214684510E+03 -2.295073686E-05 +2.0 20.0 3.931278522E+07 6.329543612E-10 3.852369486E+07 -6.516012331E-10 +3.0 1.0 2.216842492E-02 7.101262825E+00 6.924239499E-02 -2.292862737E+01 +3.0 2.0 2.127399592E-01 6.473853909E-01 3.698385088E-01 -1.224837841E+00 +3.0 5.0 1.033115017E+01 8.291768415E-03 1.130692487E+01 -1.028400476E-02 +3.0 10.0 1.758380717E+03 2.725270026E-05 1.754004753E+03 -2.968562708E-05 +3.0 50.0 2.677764139E+20 3.727936774E-23 2.655764792E+20 -3.771608045E-23 +5.0 1.0 2.714631560E-04 3.609605896E+02 1.379804441E-03 -1.849035364E+03 +5.0 2.0 9.825679323E-03 9.431049101E+00 2.616437167E-02 -2.577353868E+01 +5.0 5.0 2.157974547E+00 3.270627371E-02 2.950260216E+00 -4.796533952E-02 +5.0 10.0 7.771882864E+02 5.754184999E-05 8.378963946E+02 -6.663236215E-05 +5.0 50.0 2.278548308E+20 4.367182254E-23 2.267244113E+20 -4.432002477E-23 +10.0 1.0 2.752948040E-10 1.807132899E+08 2.765437823E-09 -1.817137940E+09 +10.0 2.0 3.016963879E-07 1.624824040E+05 1.535703963E-06 -8.302224962E+05 +10.0 5.0 4.580044419E-03 9.758562829E+00 1.015562998E-02 -2.202940355E+01 +10.0 10.0 2.189170616E+01 1.614255300E-03 3.042758634E+01 -2.324264134E-03 +10.0 50.0 1.071597159E+20 9.150988210E-23 1.082473779E+20 -9.419859989E-23 +20.0 1.0 3.966835986E-25 6.294369360E+22 7.943111714E-24 -1.260529076E+24 +20.0 2.0 4.310560576E-19 5.770856853E+16 4.331042808E-18 -5.801141519E+17 +20.0 5.0 5.024239358E-11 4.827000521E+08 2.068719274E-10 -1.993195442E+09 +20.0 10.0 1.250799736E-04 1.787442782E+02 2.784778118E-04 -4.015325804E+02 +20.0 50.0 5.442008403E+18 1.706148380E-21 5.814242572E+18 -1.852264589E-21 +Spherical Bessel Functions n,x,sjn(x),syn(x),sjnp(x),synp(x) +11 Values +0 0.1 9.9833417E-01 -9.9500417E+00 -3.3300012E-02 1.0049875E+02 +0 1.0 8.4147098E-01 -5.4030231E-01 -3.0116868E-01 1.3817733E+00 +0 5.0 -1.9178485E-01 -5.6732437E-02 9.5089408E-02 -1.8043837E-01 +0 50.0 -5.2474971E-03 -1.9299321E-02 1.9404271E-02 -4.8615107E-03 +1 0.1 3.3300012E-02 -1.0049875E+02 3.3233393E-01 2.0000250E+03 +1 1.0 3.0116868E-01 -1.3817733E+00 2.3913363E-01 2.2232443E+00 +1 5.0 -9.5089408E-02 1.8043837E-01 -1.5374909E-01 -1.2890778E-01 +1 50.0 -1.9404271E-02 4.8615107E-03 -4.4713263E-03 -1.9493781E-02 +20 1.0 7.5377957E-26 -3.2395922E+23 1.5058053E-24 6.7948312E+24 +20 5.0 5.4277268E-12 -9.2679514E+08 2.1071414E-11 3.7715819E+09 +20 50.0 -1.5785030E-02 1.3759531E-02 -1.2204181E-02 -1.4702296E-02 +Airy Functions +8 Values +-3.5 -0.37553382 0.16893984 -0.34344343 -0.69311628 +-2.0 0.22740743 -0.41230259 0.61825902 0.27879517 +-1.0 0.53556088 0.10399739 -0.01016057 0.59237563 +-0.01 0.35761619 0.61044364 -0.25880157 0.44831896 + 0.00 0.35502805 0.61492663 -0.25881940 0.44828836 + 0.01 0.35243992 0.61940962 -0.25880174 0.44831926 + 0.5 0.23169361 0.85427704 -0.22491053 0.54457256 + 1.00 0.13529242 1.20742359 -0.15914744 0.93243593 +Elliptic Integral First Kind RF +3 Values + 0.1 0.1 0.1 3.16227766 + 0.0 1.0 2.0 1.31102878 +100.0 100.0 100.0 0.1 +Elliptic Integral Second Kind RD +3 Values + 0.1 0.1 0.1 31.6227766 + 0.0 2.0 1.0 1.79721036 +100.0 100.0 100.0 0.001 +Elliptic Integral Third Kind RJ +3 Values + 0.1 0.1 0.1 0.1 31.6227766 + 2.0 3.0 4.0 5.0 0.142975797 +100.0 100.0 100.0 100.0 0.001 +Elliptic Integral Degenerate RC +5 Values + 0.1 0.1 3.16227766 + 0.0 0.25 3.14159265 + 0.0625 0.125 3.14159265 + 2.25 2.0 0.69314718 +100.0 100.0 0.1 +Legendre Elliptic Integral First Kind +9 Values + 5.0 2.0 0.08726660 + 5.0 30.0 0.08729413 + 5.0 88.0 0.08737730 +30.0 2.0 0.52362636 +30.0 30.0 0.52942863 +30.0 88.0 0.54927042 +90.0 2.0 1.57127495 +90.0 30.0 1.68575035 +90.0 88.0 4.74271727 +Legendre Elliptic Integral Second Kind +9 Values + 5.0 2.0 0.08726633 + 5.0 30.0 0.08723881 + 5.0 88.0 0.08715588 +30.0 2.0 0.52357119 +30.0 30.0 0.51788193 +30.0 88.0 0.50003003 +90.0 2.0 1.57031792 +90.0 30.0 1.46746221 +90.0 88.0 1.00258409 +Legendre Elliptic Integral Third Kind +12 Values +15.0 0.4 30.0 0.264953 +60.0 0.6 90.0 1.71951 +90.0 0.0 30.0 1.68575 +90.0 0.9 75.0 12.46407 +15.0 1.0 15.0 0.268156 +45.0 0.0625 30.0 0.813845 +45.0 0.625 30.0 0.921130 +45.0 1.25 30.0 1.132136 +45.0 -0.25 30.0 0.769872 +90.0 0.0625 30.0 1.743055 +90.0 0.625 30.0 2.800989 +90.0 -0.25 30.0 1.501762 +Fresnel Integrals +6 Values + 0.1 0.0005236 0.0999975 + 1.0 0.4382591 0.7798934 + 1.5 0.6975050 0.4452612 + 2.0 0.3434157 0.4882534 + 5.0 0.4991914 0.5636312 +20.0 0.4840845 0.4999873 +Exponential Integral En n,x,En(x) +13 Values +0 1.0 0.3678794 +2 0.0 1.0000000 +3 0.0 0.5000000 +4 0.0 0.3333333 +2 0.5 0.3266439 +3 0.5 0.2216044 +4 0.5 0.1652428 +10 0.5 0.0634583 +20 0.5 0.0310612 +2 5.0 0.9964690E-03 +20 5.0 0.2782746E-03 +2 50.0 0.3711783E-23 +20 50.0 0.2766423E-23 +Cosine and Sine Integrals +17 Values + 0.1 -1.727868E+00 9.994446E-02 + 0.2 -1.042206E+00 1.995561E-01 + 0.6 -2.227071E-02 5.881288E-01 + 0.7 1.005147E-01 6.812222E-01 + 1.8 4.568111E-01 1.505817E+00 + 1.9 4.419403E-01 1.557775E+00 + 2.0 4.229808E-01 1.605413E+00 + 2.1 4.005120E-01 1.648699E+00 + 2.2 3.750746E-01 1.687625E+00 + 3.3 2.467829E-02 1.848081E+00 + 6.3 -1.988822E-02 1.418174E+00 + 6.4 -4.181411E-03 1.419223E+00 + 6.5 1.110152E-02 1.421794E+00 + 6.6 2.582314E-02 1.425816E+00 +10.0 -4.545644E-02 1.658348E+00 +12.5 -1.140835E-02 1.492337E+00 +15.0 4.627868E-02 1.618194E+00 +Exponential Integral Ei +21 Values + 0.1 -1.62281 + 0.2 -0.821761 + 0.3 -0.302669 + 0.4 0.104768 + 0.5 0.454220 + 0.6 0.769881 + 0.7 1.06491 + 0.8 1.34740 + 0.9 1.62281 + 2.2 5.73261 + 2.4 6.60067 + 3.5 13.9254 + 3.9 18.3157 + 5.0 40.1853 + 5.4 54.1935 + 12.5 23565.1 + 13.0 37197.7 + 13.5 58827.0 + 14.0 93193.0 + 14.5 147866. + 15.0 234955. +Gamma Function +17 Values + 1.0 1.000000 + 1.2 0.918169 + 1.4 0.887264 + 1.6 0.893515 + 1.8 0.931384 + 2.0 1.000000 + 0.2 4.590845 + 0.4 2.218160 + 0.6 1.489192 + 0.8 1.164230 +-0.2 -5.821149 +-0.4 -3.722981 +-0.6 -3.696933 +-0.8 -5.738555 +10.0 3.6288000E05 +20.0 1.2164510E17 +30.0 8.8417620E30 +N-factorial +18 Values +1 1 +2 2 +3 6 +4 24 +5 120 +6 720 +7 5040 +8 40320 +9 362880 +10 3628800 +11 39916800 +12 479001600 +13 6227020800 +14 87178291200 +15 1.3076755E12 +20 2.4329042E18 +25 1.5511222E25 +30 2.6525281E32 +Binomial Coefficients +20 Values +1 0 1 +6 1 6 +6 3 20 +6 5 6 +15 1 15 +15 3 455 +15 5 3003 +15 7 6435 +15 9 5005 +15 11 1365 +15 13 105 +25 1 25 +25 3 2300 +25 5 53130 +25 7 480700 +25 9 2042975 +25 11 4457400 +25 13 5200300 +25 15 3268760 +25 17 1081575 +Beta Function +15 Values +1.0 1.0 1.000000 +0.2 1.0 5.000000 +1.0 0.2 5.000000 +0.4 1.0 2.500000 +1.0 0.4 2.500000 +0.6 1.0 1.666667 +0.8 1.0 1.250000 +6.0 6.0 3.607504E-04 +6.0 5.0 7.936508E-04 +6.0 4.0 1.984127E-03 +6.0 3.0 5.952381E-03 +6.0 2.0 0.238095E-01 +7.0 7.0 8.325008E-05 +5.0 5.0 1.587302E-03 +4.0 4.0 7.142857E-03 +3.0 3.0 0.333333E-01 +2.0 2.0 1.666667E-01 +Incomplete Gamma Function +20 Values +0.1 3.1622777E-02 0.7420263 +0.1 3.1622777E-01 0.9119753 +0.1 1.5811388 0.9898955 +0.5 7.0710678E-02 0.2931279 +0.5 7.0710678E-01 0.7656418 +0.5 3.5355339 0.9921661 +1.0 0.1000000 0.0951626 +1.0 1.0000000 0.6321206 +1.0 5.0000000 0.9932621 +1.1 1.0488088E-01 0.0757471 +1.1 1.0488088 0.6076457 +1.1 5.2440442 0.9933425 +2.0 1.4142136E-01 0.0091054 +2.0 1.4142136 0.4130643 +2.0 7.0710678 0.9931450 +6.0 2.4494897 0.0387318 +6.0 12.247449 0.9825937 +11.0 16.583124 0.9404267 +26.0 25.495098 0.4863866 +41.0 44.821870 0.7359709 +Error Function +20 Values +0.0 0.000000 +0.1 0.1124629 +0.2 0.2227026 +0.3 0.3286268 +0.4 0.4283924 +0.5 0.5204999 +0.6 0.6038561 +0.7 0.6778012 +0.8 0.7421010 +0.9 0.7969082 +1.0 0.8427008 +1.1 0.8802051 +1.2 0.9103140 +1.3 0.9340079 +1.4 0.9522851 +1.5 0.9661051 +1.6 0.9763484 +1.7 0.9837905 +1.8 0.9890905 +1.9 0.9927904 +Incomplete Beta Function +20 Values +0.5 0.5 0.01 0.0637686 +0.5 0.5 0.10 0.2048328 +0.5 0.5 1.00 1.0000000 +1.0 0.5 0.01 0.0050126 +1.0 0.5 0.10 0.0513167 +1.0 0.5 1.00 1.0000000 +1.0 1.0 0.5 0.5000000 +5.0 5.0 0.5 0.5000000 +10.0 0.5 0.9 0.1516409 +10.0 5.0 0.5 0.0897827 +10.0 5.0 1.0 1.0000000 +10.0 10.0 0.5 0.5000000 +20.0 5.0 0.8 0.4598773 +20.0 10.0 0.6 0.2146816 +20.0 10.0 0.8 0.9507365 +20.0 20.0 0.5 0.5000000 +20.0 20.0 0.6 0.8979414 +30.0 10.0 0.7 0.2241297 +30.0 10.0 0.8 0.7586405 +40.0 20.0 0.7 0.7001783 +Bessel Function J0 +20 Values +-5.0 -0.1775968 +-4.0 -0.3971498 +-3.0 -0.2600520 +-2.0 0.2238908 +-1.0 0.7651976 + 0.0 1.0000000 + 1.0 0.7651977 + 2.0 0.2238908 + 3.0 -0.2600520 + 4.0 -0.3971498 + 5.0 -0.1775968 + 6.0 0.1506453 + 7.0 0.3000793 + 8.0 0.1716508 + 9.0 -0.0903336 +10.0 -0.2459358 +11.0 -0.1711903 +12.0 0.0476893 +13.0 0.2069261 +14.0 0.1710735 +15.0 -0.0142245 +Bessel Function Y0 +15 Values + 0.1 -1.5342387 + 1.0 0.0882570 + 2.0 0.51037567 + 3.0 0.37685001 + 4.0 -0.0169407 + 5.0 -0.3085176 + 6.0 -0.2881947 + 7.0 -0.0259497 + 8.0 0.2235215 + 9.0 0.2499367 +10.0 0.0556712 +11.0 -0.1688473 +12.0 -0.2252373 +13.0 -0.0782079 +14.0 0.1271926 +15.0 0.2054743 +Bessel Function J1 +20 Values +-5.0 0.3275791 +-4.0 0.0660433 +-3.0 -0.3390590 +-2.0 -0.5767248 +-1.0 -0.4400506 + 0.0 0.0000000 + 1.0 0.4400506 + 2.0 0.5767248 + 3.0 0.3390590 + 4.0 -0.0660433 + 5.0 -0.3275791 + 6.0 -0.2766839 + 7.0 -0.0046828 + 8.0 0.2346364 + 9.0 0.2453118 +10.0 0.0434728 +11.0 -0.1767853 +12.0 -0.2234471 +13.0 -0.0703181 +14.0 0.1333752 +15.0 0.2051040 +Bessel Function Y1 +15 Values + 0.1 -6.4589511 + 1.0 -0.7812128 + 2.0 -0.1070324 + 3.0 0.3246744 + 4.0 0.3979257 + 5.0 0.1478631 + 6.0 -0.1750103 + 7.0 -0.3026672 + 8.0 -0.1580605 + 9.0 0.1043146 +10.0 0.2490154 +11.0 0.1637055 +12.0 -0.0570992 +13.0 -0.2100814 +14.0 -0.1666448 +15.0 0.0210736 +Bessel Function Jn, n>=2 +20 Values +2 1.0 1.149034849E-01 +2 2.0 3.528340286E-01 +2 5.0 4.656511628E-02 +2 10.0 2.546303137E-01 +2 50.0 -5.971280079E-02 +5 1.0 2.497577302E-04 +5 2.0 7.039629756E-03 +5 5.0 2.611405461E-01 +5 10.0 -2.340615282E-01 +5 50.0 -8.140024770E-02 +10 1.0 2.630615124E-10 +10 2.0 2.515386283E-07 +10 5.0 1.467802647E-03 +10 10.0 2.074861066E-01 +10 50.0 -1.138478491E-01 +20 1.0 3.873503009E-25 +20 2.0 3.918972805E-19 +20 5.0 2.770330052E-11 +20 10.0 1.151336925E-05 +20 50.0 -1.167043528E-01 +Bessel Function Yn, n>=2 +20 Values +2 1.0 -1.650682607 +2 2.0 -6.174081042E-01 +2 5.0 3.676628826E-01 +2 10.0 -5.868082460E-03 +2 50.0 9.579316873E-02 +5 1.0 -2.604058666E02 +5 2.0 -9.935989128 +5 5.0 -4.536948225E-01 +5 10.0 1.354030477E-01 +5 50.0 -7.854841391E-02 +10 1.0 -1.216180143E08 +10 2.0 -1.291845422E05 +10 5.0 -2.512911010E01 +10 10.0 -3.598141522E-01 +10 50.0 5.723897182E-03 +20 1.0 -4.113970315E22 +20 2.0 -4.081651389E16 +20 5.0 -5.933965297E08 +20 10.0 -1.597483848E03 +20 50.0 1.644263395E-02 +Modified Bessel Function I0 +20 Values +0.0 1.0000000 +0.2 1.0100250 +0.4 1.0404018 +0.6 1.0920453 +0.8 1.1665149 +1.0 1.2660658 +1.2 1.3937256 +1.4 1.5533951 +1.6 1.7499807 +1.8 1.9895593 +2.0 2.2795852 +2.5 3.2898391 +3.0 4.8807925 +3.5 7.3782035 +4.0 11.301922 +4.5 17.481172 +5.0 27.239871 +6.0 67.234406 +8.0 427.56411 +10.0 2815.7167 +Modified Bessel Function K0 +20 Values +0.1 2.4270690 +0.2 1.7527038 +0.4 1.1145291 +0.6 0.77752208 +0.8 0.56534710 +1.0 0.42102445 +1.2 0.31850821 +1.4 0.24365506 +1.6 0.18795475 +1.8 0.14593140 +2.0 0.11389387 +2.5 6.2347553E-02 +3.0 3.4739500E-02 +3.5 1.9598897E-02 +4.0 1.1159676E-02 +4.5 6.3998572E-03 +5.0 3.6910983E-03 +6.0 1.2439943E-03 +8.0 1.4647071E-04 +10.0 1.7780062E-05 +Modified Bessel Function I1 +20 Values +0.0 0.00000000 +0.2 0.10050083 +0.4 0.20402675 +0.6 0.31370403 +0.8 0.43286480 +1.0 0.56515912 +1.2 0.71467794 +1.4 0.88609197 +1.6 1.0848107 +1.8 1.3171674 +2.0 1.5906369 +2.5 2.5167163 +3.0 3.9533700 +3.5 6.2058350 +4.0 9.7594652 +4.5 15.389221 +5.0 24.335643 +6.0 61.341937 +8.0 399.87313 +10.0 2670.9883 +Modified Bessel Function K1 +20 Values +0.1 9.8538451 +0.2 4.7759725 +0.4 2.1843544 +0.6 1.3028349 +0.8 0.86178163 +1.0 0.60190724 +1.2 0.43459241 +1.4 0.32083589 +1.6 0.24063392 +1.8 0.18262309 +2.0 0.13986588 +2.5 7.3890816E-02 +3.0 4.0156431E-02 +3.5 2.2239393E-02 +4.0 1.2483499E-02 +4.5 7.0780949E-03 +5.0 4.0446134E-03 +6.0 1.3439197E-03 +8.0 1.5536921E-04 +10.0 1.8648773E-05 +Modified Bessel Function Kn, n>=2 +28 Values +2 0.2 49.512430 +2 1.0 1.6248389 +2 2.0 2.5375975E-01 +2 2.5 1.2146021E-01 +2 3.0 6.1510459E-02 +2 5.0 5.3089437E-03 +2 10.0 2.1509817E-05 +2 20.0 6.3295437E-10 +3 1.0 7.101262825 +3 2.0 6.473853909E-01 +3 5.0 8.291768415E-03 +3 10.0 2.725270026E-05 +3 50.0 3.72793677E-23 +5 1.0 3.609605896E02 +5 2.0 9.431049101 +5 5.0 3.270627371E-02 +5 10.0 5.754184999E-05 +5 50.0 4.36718224E-23 +10 1.0 1.807132899E08 +10 2.0 1.624824040E05 +10 5.0 9.758562829 +10 10.0 1.614255300E-03 +10 50.0 9.15098819E-23 +20 1.0 6.294369369E22 +20 2.0 5.770856853E16 +20 5.0 4.827000521E08 +20 10.0 1.787442782E02 +20 50.0 1.70614838E-21 +Modified Bessel Function In, n>=2 +28 Values +2 0.2 5.0166876E-03 +2 1.0 1.3574767E-01 +2 2.0 6.8894844E-01 +2 2.5 1.2764661 +2 3.0 2.2452125 +2 5.0 17.505615 +2 10.0 2281.5189 +2 20.0 3.9312785E07 +3 1.0 2.216842492E-02 +3 2.0 2.127399592E-01 +3 5.0 1.033115017E01 +3 10.0 1.758380717E01 +3 50.0 2.67776414E20 +5 1.0 2.714631560E-04 +5 2.0 9.825679323E-03 +5 5.0 2.157974547 +5 10.0 7.771882864E02 +5 50.0 2.27854831E20 +10 1.0 2.752948040E-10 +10 2.0 3.016963879E-07 +10 5.0 4.580044419E-03 +10 10.0 2.189170616E01 +10 50.0 1.07159716E20 +20 1.0 3.966835986E-25 +20 2.0 4.310560576E-19 +20 5.0 5.024239358E-11 +20 10.0 1.250799736E-04 +20 50.0 5.44200840E18 +Legendre Polynomials +19 Values +1 0 1.0 1.224745 +10 0 1.0 3.240370 +20 0 1.0 4.527693 +1 0 0.7071067 0.866025 +10 0 0.7071067 0.373006 +20 0 0.7071067 -0.874140 +1 0 0.0 0.000000 +10 0 0.0 -0.797435 +20 0 0.0 0.797766 +2 2 0.7071067 0.484123 +10 2 0.7071067 -0.204789 +20 2 0.7071067 0.910208 +2 2 0.0 0.968246 +10 2 0.0 0.804785 +20 2 0.0 -0.799672 +10 10 0.7071067 0.042505 +20 10 0.7071067 -0.707252 +10 10 0.0 1.360172 +20 10 0.0 -0.853705 +Jacobian Elliptic Function +20 Values +0.0 0.1 0.099833 +0.0 0.2 0.19867 +0.0 0.5 0.47943 +0.0 1.0 0.84147 +0.0 2.0 0.90930 +0.5 0.1 0.099751 +0.5 0.2 0.19802 +0.5 0.5 0.47075 +0.5 1.0 0.80300 +0.5 2.0 0.99466 +1.0 0.1 0.099668 +1.0 0.2 0.19738 +1.0 0.5 0.46212 +1.0 1.0 0.76159 +1.0 2.0 0.96403 +1.0 4.0 0.99933 +1.0 -0.2 -0.19738 +1.0 -0.5 -0.46212 +1.0 -1.0 -0.76159 +1.0 -2.0 -0.96403 diff --git a/lib/nr/ansi/data/matrx1.dat b/lib/nr/ansi/data/matrx1.dat new file mode 100644 index 0000000..3ec3367 --- /dev/null +++ b/lib/nr/ansi/data/matrx1.dat @@ -0,0 +1,44 @@ +MATRICES FOR INPUT TO TEST ROUTINES +Size of matrix (NxN), Number of solutions: +3 2 +Matrix A: +1.0 0.0 0.0 +0.0 2.0 0.0 +0.0 0.0 3.0 +Solution vectors: +1.0 0.0 0.0 +1.0 1.0 1.0 +NEXT PROBLEM +Size of matrix (NxN), Number of solutions: +3 2 +Matrix A: +1.0 2.0 3.0 +2.0 2.0 3.0 +3.0 3.0 3.0 +Solution vectors: +1.0 1.0 1.0 +1.0 2.0 3.0 +NEXT PROBLEM: +Size of matrix (NxN), Number of solutions: +5 2 +Matrix A: +1.0 2.0 3.0 4.0 5.0 +2.0 3.0 4.0 5.0 1.0 +3.0 4.0 5.0 1.0 2.0 +4.0 5.0 1.0 2.0 3.0 +5.0 1.0 2.0 3.0 4.0 +Solution vectors: +1.0 1.0 1.0 1.0 1.0 +1.0 2.0 3.0 4.0 5.0 +NEXT PROBLEM: +Size of matrix (NxN), Number of solutions: +5 2 +Matrix A: +1.4 2.1 2.1 7.4 9.6 +1.6 1.5 1.1 0.7 5.0 +3.8 8.0 9.6 5.4 8.8 +4.6 8.2 8.4 0.4 8.0 +2.6 2.9 0.1 9.6 7.7 +Solution vectors: +1.1 1.6 4.7 9.1 0.1 +4.0 9.3 8.4 0.4 4.1 diff --git a/lib/nr/ansi/data/matrx2.dat b/lib/nr/ansi/data/matrx2.dat new file mode 100644 index 0000000..033f1ab --- /dev/null +++ b/lib/nr/ansi/data/matrx2.dat @@ -0,0 +1,44 @@ +FILE OF TRIDIAGONAL MATRICES FOR PROGRAM 'TRIDAG' +Dimension of matrix +3 +Diagonal elements (N) +1.0 2.0 3.0 +Super-diagonal elements (N-1) +2.0 3.0 +Sub-diagonal elements (N-1) +2.0 3.0 +Right-hand side vector (N) +1.0 2.0 3.0 +NEXT PROBLEM: +Dimension of matrix +5 +Diagonal elements (N) +1.0 1.0 1.0 1.0 1.0 +Super-diagonal elements (N-1) +1.0 2.0 3.0 4.0 +Sub-diagonal elements (N-1) +2.0 3.0 4.0 5.0 +Right-hand side vector (N) +1.0 2.0 3.0 4.0 5.0 +NEXT PROBLEM: +Dimension of matrix +5 +Diagonal elements (N) +1.0 2.0 3.0 4.0 5.0 +Super-diagonal elements (N-1) +2.0 3.0 4.0 5.0 +Sub-diagonal elements (N-1) +2.0 3.0 4.0 5.0 +Right-hand side vector (N) +1.0 1.0 1.0 1.0 1.0 +NEXT PROBLEM: +Dimension of matrix +6 +Diagonal elements (N) +9.7 9.5 5.2 3.5 5.1 6.0 +Super-diagonal elements (N-1) +6.0 1.2 0.7 3.0 1.5 +Sub-diagonal elements (N-1) +2.1 9.4 3.3 7.5 8.8 +Right-hand side vector (N) +2.0 7.5 0.6 7.4 9.8 8.8 diff --git a/lib/nr/ansi/data/matrx3.dat b/lib/nr/ansi/data/matrx3.dat new file mode 100644 index 0000000..e1dbf33 --- /dev/null +++ b/lib/nr/ansi/data/matrx3.dat @@ -0,0 +1,28 @@ +FILE OF MATRICES FOR SVDCMP: +Number of Rows, Columns +5 3 +Matrix +1.0 2.0 3.0 +2.0 3.0 4.0 +3.0 4.0 5.0 +4.0 5.0 6.0 +5.0 6.0 7.0 +NEXT PROBLEM: +Number of Rows, Columns +5 5 +Matrix +1.0 2.0 3.0 4.0 5.0 +2.0 2.0 3.0 4.0 5.0 +3.0 3.0 3.0 4.0 5.0 +4.0 4.0 4.0 4.0 5.0 +5.0 5.0 5.0 5.0 5.0 +NEXT PROBLEM: +Number of Rows, Columns +6 6 +Matrix +3.0 5.3 5.6 3.5 6.8 5.7 +0.4 8.2 6.7 1.9 2.2 5.3 +7.8 8.3 7.7 3.3 1.9 4.8 +5.5 8.8 3.0 1.0 5.1 6.4 +5.1 5.1 3.6 5.8 5.7 4.9 +3.5 2.7 5.7 8.2 9.6 2.9 diff --git a/lib/nr/ansi/data/spctrl.dat b/lib/nr/ansi/data/spctrl.dat new file mode 100644 index 0000000..45437b0 --- /dev/null +++ b/lib/nr/ansi/data/spctrl.dat @@ -0,0 +1,300 @@ + 0.097911 0.367270 0.500363 0.425597 + 0.058794 -0.383898 -0.811678 -0.852240 + -0.540416 0.077375 0.609527 0.949625 + 0.934536 0.547584 0.065175 -0.343537 + -0.364521 -0.234990 -0.060539 0.070118 + -0.053797 -0.195746 -0.378981 -0.302282 + 0.078039 0.496074 0.873213 0.920654 + 0.639311 0.016809 -0.545344 -0.847283 + -0.757841 -0.419941 0.050494 0.412930 + 0.443676 0.355997 0.190416 0.004934 + 0.098812 0.334695 0.487672 0.390609 + 0.091482 -0.471872 -0.822832 -0.862922 + -0.541732 0.037119 0.632220 0.969027 + 0.938331 0.524281 0.054555 -0.316386 + -0.417168 -0.258567 -0.002089 0.081358 + -0.010683 -0.250513 -0.395420 -0.292397 + 0.037531 0.541725 0.858324 0.979284 + 0.632282 0.052913 -0.513068 -0.861395 + -0.844621 -0.381213 0.032628 0.441947 + 0.494978 0.353964 0.103450 0.050774 + 0.186340 0.348806 0.477618 0.439581 + 0.030414 -0.376526 -0.748378 -0.839505 + -0.572722 0.070455 0.592158 0.997204 + 0.871991 0.573119 0.016951 -0.299401 + -0.380699 -0.213378 -0.045667 0.014124 + -0.083163 -0.211765 -0.394188 -0.329720 + 0.056738 0.487655 0.899056 0.923687 + 0.679856 0.053336 -0.580099 -0.898054 + -0.777465 -0.449933 0.008536 0.397103 + 0.442733 0.382489 0.126694 0.008359 + 0.174158 0.298124 0.492837 0.387331 + 0.092230 -0.421991 -0.760395 -0.836616 + -0.490595 0.002870 0.662405 0.970864 + 0.870277 0.485316 0.037991 -0.338729 + -0.430330 -0.232343 -0.048044 0.032509 + -0.019183 -0.230955 -0.379461 -0.286177 + 0.009042 0.568075 0.874133 0.912020 + 0.610105 0.098793 -0.487907 -0.815460 + -0.839317 -0.455718 0.033628 0.359049 + 0.489247 0.299280 0.142992 0.076076 + 0.164557 0.331189 0.435143 0.371382 + 0.028573 -0.429901 -0.789573 -0.827289 + -0.516383 0.019417 0.660162 0.998339 + 0.943339 0.553927 0.064096 -0.268127 + -0.343639 -0.208262 -0.080817 0.014051 + -0.091364 -0.251841 -0.332385 -0.253401 + 0.004142 0.562365 0.857352 0.980905 + 0.640451 0.070460 -0.560346 -0.860592 + -0.800160 -0.411101 0.035681 0.419918 + 0.456588 0.380944 0.103726 0.061474 + 0.146002 0.335740 0.530424 0.424361 + 0.001236 -0.376993 -0.768314 -0.816661 + -0.574880 0.001497 0.631647 0.908096 + 0.882109 0.558594 0.042774 -0.296324 + -0.405426 -0.211205 -0.029234 0.085678 + -0.036877 -0.276193 -0.370418 -0.333459 + 0.030051 0.509729 0.935126 0.962784 + 0.662392 0.072465 -0.579946 -0.894496 + -0.846667 -0.445903 0.094651 0.436459 + 0.451768 0.372502 0.171457 0.074792 + 0.140627 0.311938 0.514634 0.414529 + 0.037810 -0.377700 -0.813998 -0.880491 + -0.504330 0.016679 0.596882 0.918905 + 0.889236 0.478435 0.036437 -0.323710 + -0.398283 -0.293001 -0.081568 0.036554 + -0.019824 -0.221855 -0.387019 -0.334675 + 0.080294 0.491516 0.922518 0.963173 + 0.661262 0.013510 -0.562322 -0.893592 + -0.764120 -0.466779 0.016865 0.438673 + 0.475335 0.347867 0.122441 0.095509 + 0.122242 0.374897 0.432223 0.394942 + 0.089702 -0.404219 -0.756637 -0.845088 + -0.516642 0.039524 0.654199 0.984378 + 0.896149 0.525603 0.033058 -0.247243 + -0.355035 -0.228370 0.007792 0.008678 + -0.064855 -0.231288 -0.374441 -0.332992 + 0.005931 0.508226 0.942214 1.002574 + 0.586029 0.075539 -0.508032 -0.893993 + -0.798908 -0.387166 0.083562 0.384966 + 0.487865 0.332096 0.181928 0.008358 + 0.135767 0.352306 0.478585 0.401968 + 0.054226 -0.399437 -0.819389 -0.826667 + -0.533762 0.002544 0.677559 0.921943 + 0.884705 0.488659 0.032441 -0.260313 + -0.387379 -0.218315 -0.088176 0.045573 + -0.084575 -0.283227 -0.431495 -0.305018 + 0.020692 0.495659 0.903865 0.979479 + 0.641578 0.096499 -0.532013 -0.818501 + -0.801651 -0.458958 0.051335 0.414244 + 0.489763 0.336589 0.117080 0.084142 + 0.125365 0.301872 0.512340 0.445291 + 0.073475 -0.448532 -0.801094 -0.842954 + -0.528140 0.025966 0.603184 0.946022 + 0.882719 0.539963 0.098792 -0.289700 + -0.387006 -0.195881 -0.081170 0.023650 + -0.026617 -0.253341 -0.408916 -0.343958 + 0.066436 0.554518 0.915065 0.979764 + 0.615021 0.095966 -0.535727 -0.900540 + -0.747872 -0.456808 0.018016 0.432158 + 0.453624 0.354854 0.139914 0.073312 + 0.107453 0.362039 0.483963 0.428043 + 0.095897 -0.416062 -0.752085 -0.881777 + -0.506618 0.019157 0.634220 0.906013 + 0.942182 0.536385 0.055480 -0.316476 + -0.351742 -0.213961 -0.053189 0.060703 + 0.001519 -0.246973 -0.384560 -0.331215 + 0.009580 0.493835 0.911937 0.951883 + 0.603137 0.054710 -0.524431 -0.897798 + -0.780356 -0.408528 0.033938 0.424251 + 0.528502 0.376326 0.176091 0.045445 + 0.164536 0.375618 0.525160 0.426136 + 0.008985 -0.447627 -0.807413 -0.859091 + -0.559236 0.011335 0.590186 0.936487 + 0.856904 0.530043 0.012522 -0.335937 + -0.412646 -0.209519 -0.053693 0.051147 + -0.053526 -0.222614 -0.410404 -0.279051 + 0.019434 0.520151 0.924055 0.905338 + 0.599860 0.072868 -0.495636 -0.852138 + -0.842475 -0.410295 0.045931 0.374146 + 0.507044 0.304955 0.110229 0.014329 + 0.099445 0.313920 0.442175 0.440693 + 0.057408 -0.424944 -0.804769 -0.813377 + -0.567945 0.061968 0.598933 0.986802 + 0.848188 0.515720 0.047513 -0.329140 + -0.349152 -0.242236 -0.078811 0.079854 + -0.024022 -0.265492 -0.355148 -0.309431 + 0.096588 0.575235 0.849259 0.941124 + 0.595528 0.055573 -0.503313 -0.883673 + -0.816723 -0.439862 0.048003 0.440092 + 0.494922 0.379278 0.180705 0.057666 + 0.108089 0.332832 0.464212 0.374919 + 0.021429 -0.471234 -0.757271 -0.809901 + -0.497724 0.082059 0.657500 0.948854 + 0.896929 0.511290 0.073270 -0.317564 + -0.361846 -0.280574 -0.033892 0.037408 + -0.073339 -0.285403 -0.429735 -0.246847 + 0.031412 0.567831 0.933083 0.974899 + 0.648928 0.090599 -0.513837 -0.874769 + -0.778362 -0.450210 0.063260 0.403755 + 0.485675 0.325856 0.126301 0.056894 + 0.153595 0.366111 0.464019 0.377563 + 0.004612 -0.414628 -0.761011 -0.867799 + -0.499577 0.091861 0.654241 0.997871 + 0.942204 0.483009 0.091923 -0.335708 + -0.338226 -0.278998 -0.008505 0.053219 + -0.058173 -0.219469 -0.352340 -0.302103 + 0.052941 0.528985 0.893284 0.981896 + 0.606492 0.065509 -0.534164 -0.857461 + -0.802981 -0.388117 0.004868 0.442722 + 0.435563 0.314212 0.183261 0.077975 + 0.176073 0.295736 0.482821 0.374858 + 0.076716 -0.422508 -0.837674 -0.807773 + -0.531693 0.074174 0.649856 0.953869 + 0.851023 0.573365 0.006548 -0.324274 + -0.335403 -0.199929 0.004564 0.097017 + -0.040870 -0.271010 -0.415173 -0.263773 + 0.018949 0.509171 0.912486 0.909274 + 0.663260 0.016081 -0.488704 -0.868258 + -0.747901 -0.388979 0.024781 0.367971 + 0.522698 0.305092 0.186602 0.098019 + 0.166066 0.381537 0.442624 0.424076 + 0.025891 -0.452799 -0.814807 -0.810631 + -0.572332 0.070288 0.605258 0.956582 + 0.903865 0.495041 0.050691 -0.276583 + -0.421594 -0.278223 -0.006641 0.091677 + -0.035410 -0.200884 -0.356414 -0.292225 + 0.088560 0.537159 0.860301 0.960125 + 0.597692 0.067915 -0.500009 -0.852144 + -0.810110 -0.401515 0.002545 0.396196 + 0.437215 0.334308 0.113528 0.034839 + 0.154359 0.297152 0.512050 0.402023 + 0.053790 -0.411957 -0.776809 -0.804607 + -0.545230 0.004483 0.606468 1.004181 + 0.877637 0.520703 0.014247 -0.327739 + -0.427206 -0.228288 -0.067409 0.002191 + -0.059131 -0.221008 -0.343540 -0.253384 + 0.047465 0.485443 0.899890 0.910847 + 0.663669 0.037764 -0.517929 -0.876655 + -0.751527 -0.433621 0.018924 0.441145 + 0.523340 0.391304 0.156069 0.020190 + 0.184455 0.323097 0.455107 0.361767 + 0.089370 -0.385349 -0.794025 -0.903242 + -0.532589 0.034371 0.668037 0.928333 + 0.929222 0.547698 0.097208 -0.311597 + -0.367236 -0.232687 -0.051130 0.048259 + -0.060719 -0.260017 -0.418074 -0.303872 + 0.072928 0.484907 0.855767 0.976362 + 0.610166 0.014785 -0.486794 -0.846244 + -0.748778 -0.394212 0.009820 0.358356 + 0.526840 0.354162 0.190473 0.028436 + 0.176236 0.322849 0.462059 0.370479 + 0.064294 -0.384773 -0.792332 -0.806280 + -0.523412 0.078413 0.661642 0.926860 + 0.922979 0.544351 0.025883 -0.340230 + -0.354519 -0.247419 -0.003119 0.082101 + -0.012022 -0.198200 -0.391275 -0.330999 + 0.072228 0.554047 0.940904 0.963250 + 0.607121 0.019336 -0.555746 -0.832664 + -0.760450 -0.395728 0.061648 0.383536 + 0.522079 0.316498 0.134781 0.021790 + 0.168653 0.344387 0.485338 0.429979 + 0.091185 -0.386099 -0.803865 -0.847632 + -0.547286 0.015153 0.586225 0.939693 + 0.849235 0.559308 0.012852 -0.294433 + -0.399566 -0.258405 -0.066580 0.087800 + -0.042150 -0.269474 -0.332681 -0.322917 + 0.056257 0.541328 0.884606 0.941629 + 0.630189 0.065754 -0.561263 -0.903853 + -0.790730 -0.450923 0.096406 0.379047 + 0.518242 0.362239 0.096277 0.042876 + 0.161780 0.378011 0.458697 0.358680 + 0.082284 -0.444665 -0.803149 -0.815407 + -0.489638 0.091010 0.635438 0.941832 + 0.856547 0.564492 0.099813 -0.318179 + -0.419672 -0.290083 -0.013989 0.083569 + -0.055919 -0.257622 -0.430436 -0.277385 + 0.006100 0.515979 0.908006 0.993760 + 0.618310 0.001543 -0.535351 -0.899117 + -0.829096 -0.456206 0.000256 0.376039 + 0.480801 0.382116 0.150624 0.018162 + 0.166605 0.306360 0.447567 0.406553 + 0.077535 -0.439301 -0.842485 -0.819257 + -0.544317 0.078440 0.623969 0.977282 + 0.903853 0.526331 0.094650 -0.329740 + -0.350568 -0.286092 -0.062614 0.015146 + -0.088102 -0.281699 -0.397238 -0.311890 + 0.036393 0.481938 0.889484 0.955059 + 0.662317 0.005069 -0.503866 -0.861251 + -0.781591 -0.391141 0.042585 0.378318 + 0.520022 0.321098 0.110956 0.008048 + 0.139262 0.313787 0.474640 0.407562 + 0.058446 -0.454213 -0.845370 -0.813975 + -0.480999 0.010004 0.665455 0.931345 + 0.931231 0.562228 0.023416 -0.256999 + -0.333008 -0.200222 -0.044808 0.065249 + -0.071637 -0.273911 -0.332033 -0.306899 + 0.020117 0.480633 0.907756 0.986501 + 0.596889 0.038615 -0.566205 -0.817764 + -0.756176 -0.403098 0.035555 0.444095 + 0.510418 0.307940 0.179051 0.061500 + 0.098928 0.345776 0.464550 0.435004 + 0.060468 -0.383262 -0.788087 -0.831224 + -0.523793 0.033440 0.633217 0.944808 + 0.920680 0.483308 0.058446 -0.254890 + -0.402245 -0.206168 0.002455 0.098080 + 0.001098 -0.204013 -0.342597 -0.276006 + 0.076104 0.519721 0.848375 0.954724 + 0.595388 0.017591 -0.554098 -0.823085 + -0.832739 -0.394980 0.031532 0.407808 + 0.506202 0.365729 0.112260 0.015105 + 0.156834 0.390595 0.502499 0.376821 + 0.022250 -0.468862 -0.828902 -0.865065 + -0.521754 0.008702 0.582262 0.990812 + 0.858668 0.479814 0.004871 -0.339759 + -0.382635 -0.254824 -0.058774 0.040762 + -0.064244 -0.207980 -0.406088 -0.248284 + 0.065140 0.502790 0.909789 0.948749 + 0.594440 0.095172 -0.482355 -0.813955 + -0.750694 -0.449014 0.038131 0.432970 + 0.460675 0.310682 0.140371 0.003175 + 0.148347 0.304243 0.480985 0.429534 + 0.059744 -0.451427 -0.761063 -0.903347 + -0.542992 0.066439 0.606244 0.972373 + 0.849850 0.538147 0.037460 -0.270762 + -0.385688 -0.243512 -0.051111 0.040176 + -0.046009 -0.222313 -0.415061 -0.344722 + 0.065446 0.521380 0.896401 0.990178 + 0.672997 0.031288 -0.488687 -0.839813 + -0.747661 -0.454405 0.003323 0.431151 + 0.498745 0.359902 0.147358 0.026276 + 0.119546 0.357631 0.468306 0.368227 + 0.007975 -0.405726 -0.835639 -0.826552 + -0.498900 0.075505 0.610725 0.999256 + 0.849490 0.538016 0.030475 -0.274609 + -0.394095 -0.244471 -0.007600 0.048182 + -0.090882 -0.213751 -0.363397 -0.248384 + 0.085440 0.574230 0.947322 0.982645 + 0.653703 0.025142 -0.537558 -0.809595 + -0.807243 -0.444492 0.099258 0.365283 + 0.499182 0.301096 0.155158 0.094121 + 0.180500 0.367823 0.453490 0.358748 + 0.090581 -0.409058 -0.779713 -0.805878 + -0.572210 0.007475 0.614132 0.921802 + 0.927101 0.504223 0.068253 -0.268464 + -0.380833 -0.238024 -0.012982 0.007172 + -0.009599 -0.259873 -0.391673 -0.293916 + 0.070242 0.564174 0.881125 0.968656 + 0.648719 0.063631 -0.568027 -0.824792 + -0.806184 -0.454851 0.026379 0.404643 + 0.448427 0.351062 0.126076 0.097715 + 0.138137 0.355728 0.525115 0.349266 + 0.055674 -0.447023 -0.779438 -0.871175 + -0.572309 0.074596 0.583332 0.926666 + 0.866427 0.571239 0.061118 -0.282493 + -0.340329 -0.231417 -0.031789 0.092093 + -0.067833 -0.236263 -0.415730 -0.255997 + 0.061875 0.484668 0.912390 0.998998 + 0.608189 0.011819 -0.575031 -0.844429 + -0.785034 -0.465118 0.005862 0.381676 + 0.500147 0.331682 0.186613 0.002278 diff --git a/lib/nr/ansi/data/table1.dat b/lib/nr/ansi/data/table1.dat new file mode 100644 index 0000000..f3ca558 --- /dev/null +++ b/lib/nr/ansi/data/table1.dat @@ -0,0 +1,13 @@ +Contingency Table for CNTAB1 and CNTAB2 +Accidental Deaths by Month and Type (1979) +Month: jan feb mar apr may jun jul aug sep oct nov dec + +Motor Vehicle 3298 3304 4241 4291 4594 4710 4914 4942 4861 4914 4563 4892 +Falls 1150 1034 1089 1126 1142 1100 1112 1099 1114 1079 999 1181 +Drowning 180 190 370 530 800 1130 1320 990 580 320 250 212 +Fires 874 768 630 516 385 324 277 272 271 381 533 760 +Choking 299 264 258 247 273 269 251 269 271 279 297 266 +Fire-arms 168 142 122 140 153 142 147 160 162 172 266 230 +Poisons 298 277 346 263 253 239 268 228 240 260 252 241 +Gas-poison 267 193 144 127 70 63 55 53 60 118 150 172 +Other 1264 1234 1172 1220 1547 1339 1419 1453 1359 1308 1264 1246 diff --git a/lib/nr/ansi/data/table2.dat b/lib/nr/ansi/data/table2.dat new file mode 100644 index 0000000..647a0a3 --- /dev/null +++ b/lib/nr/ansi/data/table2.dat @@ -0,0 +1,24 @@ +Table for use with chapter 13 routines +Average solar radiation (watts/sq.m.) for selected cities +Month: jul aug sep oct nov dec jan feb mar apr may jun ave lat + +Atlanta, GA 257 246 201 166 30 102 106 140 184 236 258 271 192 34.0 +Barrow, AK 208 123 56 20 0 0 0 18 87 184 248 256 100 71.0 +Bismark, ND 296 251 185 132 78 60 76 121 170 217 267 284 178 47.0 +Boise, ID 324 275 221 152 88 60 69 113 164 235 284 309 191 43.5 +Boston, MA 240 206 165 115 70 58 67 96 142 176 228 242 150 42.5 +Caribou, ME 246 218 161 102 53 51 66 111 178 194 229 232 153 47.0 +Cleveland, OH 267 239 182 127 68 56 60 87 151 182 253 271 162 41.5 +Dodge City, KS 311 287 239 184 138 113 123 153 202 256 275 315 216 38.0 +El Paso, TX 324 309 278 224 178 151 160 209 266 317 346 353 260 32.0 +Fresno, CA 323 293 243 182 117 77 90 143 212 264 308 337 216 37.0 +Greensboro, NC 263 235 197 156 118 95 97 134 171 227 257 273 185 36.0 +Honolulu, HI 305 293 271 245 208 176 175 200 234 262 300 297 247 21.0 +Little Rock, AR 270 250 214 167 118 91 96 127 173 220 256 272 188 35.0 +Miami, FL 260 246 216 188 171 154 166 201 238 263 267 257 219 26.0 +New York, NY 251 238 175 127 77 62 71 102 151 183 220 255 159 41.0 +Omaha, NE 275 252 192 142 96 80 99 134 172 224 248 272 182 21.0 +Rapid City, SD 288 262 208 152 99 76 90 135 193 235 259 287 190 44.0 +Seattle, WA 242 209 150 84 44 29 34 60 118 174 216 228 132 47.5 +Tucson, AZ 304 286 281 216 172 144 151 195 264 322 358 343 253 41.0 +Washington, DC 267 190 196 145 75 64 101 124 153 182 215 247 163 39.0 diff --git a/lib/nr/ansi/data/tarray.dat b/lib/nr/ansi/data/tarray.dat new file mode 100644 index 0000000..66ee534 --- /dev/null +++ b/lib/nr/ansi/data/tarray.dat @@ -0,0 +1,11 @@ +Test data for chapter 8: + 29.82 71.51 3.30 87.44 53.42 63.16 89.10 25.75 93.16 27.72 + 71.58 48.34 53.11 18.34 27.13 60.31 83.34 22.81 66.84 52.91 + 53.42 15.22 8.01 53.39 76.12 79.09 67.61 38.39 24.81 73.21 + 13.42 52.10 34.86 99.83 38.46 81.59 61.75 79.62 93.39 3.21 + 99.34 92.22 94.29 7.03 6.67 89.35 83.14 9.01 12.68 62.22 + 2.95 85.02 95.82 73.96 49.29 77.72 36.65 3.48 48.98 71.83 + 1.41 9.48 32.37 89.95 28.39 79.36 54.05 46.08 11.67 37.78 + 77.17 74.33 10.13 4.62 49.95 68.40 19.40 34.06 4.11 98.40 + 42.44 64.14 89.41 52.99 71.79 3.94 19.73 44.91 71.44 59.10 + 27.54 15.67 67.95 55.61 26.05 25.01 82.09 89.67 57.08 38.27 diff --git a/lib/nr/ansi/data/text.dat b/lib/nr/ansi/data/text.dat new file mode 100644 index 0000000..9c0827a --- /dev/null +++ b/lib/nr/ansi/data/text.dat @@ -0,0 +1,525 @@ + This is a file of text, for use in testing programs. + +Visible characters on the typewriter keyboard: +~!@#$%^&*()_+ +`1234567890-= +QWERTYUIOP{}| +qwertyuiop[]\ +ASDFGHJKL:" +asdfghjkl;' +ZXCVBNM<>? +zxcvbnm,./ + +Several blocks of text: +IT was nearly midnight on the eve of St. Thomas's, the +shortest day in the year. A desolating wind wandered +from the north over the hill whereon Oak had watched +the yellow waggon and its occupant in the sunshine of +a few days earlier. + Norcombe Hill -- not far from lonely Toller-Down + -- was one of the spots which suggest to a passer-by +that he is in the presence of a shape approaching the +indestructible as nearly as any to be found on earth. +It was a featureless convexity of chalk and soil -- an +ordinary specimen of those smoothly-outlined protuber+ +ances of the globe which may remain undisturbed on +some great day of confusion, when far grander heights +and dizzy granite precipices topple down. +The hill was covered on its northern side by an +ancient and decaying plantation of beeches, whose +upper verge formed a line over the crest, fringing its +arched curve against the sky, like a mane. To-night +these trees sheltered the southern slope from the keenest +blasts, which smote the wood and floundered through +it with a sound as of grumbling, or gushed over its +crowning boughs in a weakened moan. The dry leaves +in the ditch simmered and boiled in the same breezes, +a tongue of air occasionally ferreting out a few, and +sending them spinning across the grass. A group or +two of the latest in date amongst the dead multitude +had remained till this very mid-winter time on the twigs +which bore them and in falling rattled against the trunks +with smart taps: +Betwenne this half-wooded, half naked hill, and the +vague still horizon that its summit indistinctly com+ +manded, was a mysterious sheet of fathomless shade + -- the sounds from which suggested that what it con+ +cealed bore some reduced resemblance to features here. +The thin grasses, more or less coating the hill, were +touched by the wind in breezes of differing powers, and +almost of differing natures -- one rubbing the blades +heavily, another raking them piercingly, another brushing +them like a soft broom. The instinctive act of human+ +kind was to stand and listen, and learn how the trees +to each other in the regular antiphonies of a cathedral +choir; how hedges and other shapes to leeward them +caught the note, lowering it to the tenderest sob; and +how the hurrying gust then plunged into the south, to +be heard no more. +The sky was clear -- remarkably clear -- and the +twinkling of all the stars seemed to be but throbs of +one body, timed by a common pulse. The North Star +was directly in the wind's eye, and since evening the +Bear had swung round it outwardly to the east, till he +was now at a right angle with the meridian. A +difference of colour in the stars -- oftener read of than +seen in England-was really perceptible here. The +sovereign brilliancy of Sirius pierced the eye with a steely +glitter, the star called Capella was yellow, Aldebaran and +Betelgueux shone with a fiery red. +To persons standing alone on a hill during a clear +midnight such as this, the roll of the world eastward is +almost a palpable movement. The sensation may be +caused by the panoramic glide of the stars past earthly +objects, which is perceptible in a few minutes of still+ +ness, or by the better outlook upon space that a hill +affords, or by the wind, or by the solitude ; but whatever +be its origin, the impression of riding along is vivid and +abiding. The poetry of motion is a phrase much in +use, and to enjoy the epic form of that gratification it +is necessary to stand on a hill at a small hour of the +night, and, having first expanded with a sense of differ+ +ence from the mass of civilised mankind, who are +dreamwrapt and disregardful of all such proceedings at +this time, long and quietly watch your stately progress +through the stars. After such a nocturnal reconnoitre +it is hard to get back to earth, and to believe that the +consciousness of such majestic speeding is derived from +a tiny human frame. +Suddenly an unexpected series of sounds began to +be heard +in this place up against the sky. They had a +clearness which was to be found nowhere in the wind, +and a sequence which was to be found nowhere in +nature. They were the notes of Farmer Oak's flute. +The tune was not floating unhindered into the open +air : it seemed muffled in some way, and was altogether +too curtailed in power to spread high or wide. It came +from the direction of a small dark object under the +plantation hedge -- a shepherd's hut -- now presenting +an outline to which an uninitiated person might have +been puzzled to attach either meaning or use. +The image as a whole was that of a small Noah's +Ark on a small Ararat, allowing the traditionary outlines +and general form of the Ark which are followed by toy+ +makers -- and by these means are established in men's +imaginations among their firmest, because earliest im+ +pressions -- to pass as an approximate pattern. The +hut stood on little wheels, which raised its floor about a +foot from the ground. Such shepherds' huts are dragged +into the fields when the lambing season comes on, to +shelter the shepherd in his- enforced nightly attendance. +It was only latterly that people had begun to call +Gabriel !Farmer' Oak. During the twelvemonth pre+ +ceding this time he had been enabled by sustained +efforts of industry and chronic good spirits to lease the +small shepp farm of which Norcombe Hill was a portion, +and stock it with two hundred sheep. Previously he +had been a bailiff for a short time, and earlier still a +shepherd only, having from his childhood assisted his +father in tending the floeks of large proprietors, till old +Gabriel sank to rest. +This venture, unaided and alone, into the paths of +farming as master and not as man, with an advance of +sheep not yet paid for, was a critical juncture with +Gabriel Oak, and he recognised his position clearly. +The first movement in his new progress was the lambing +of his ewes, and sheep having been his speciality from +his "youth, he wisely refrained from deputing -- the task +of tending them at this season to a hireling or a novice. +The wind continued to beat-about the corners of the +hut, but the flute-playing ceased. A rectangular space +of light +appeared in the side of the hut, and in the +opening the outline of Farmer Oak's figure. He carried +a lantern in his hand, and closing the door behind him, +came forward and busied himself about this nook of the +field for nearly twenty minutes, the lantern light appear+ +ing and disappearing here and there, and brightening +him or darkening him as he stood before or behind it. +Oak's motions, though they had a quiet-energy, were +slow, and their deliberateness accorded well with his +occupation. Fitness being the basis of beauty, nobody +could-have denied that his steady swings and turns" +in and- about the flock had elements of grace, Yet, +although if occasion demanded he could do or think a +thing with as mercurial a dash as can the men of towns +who are more to the manner born, his special power, +morally, physically, and mentally, was static, owing +little or nothing to momentum as a rule. +A close examination of the ground hereabout, even +by the wan starlight only, revealed how a portion of +what would have been casually called a wild slope had +been appropriated by Farmer Oak for his great purpose +this winter. Detached hurdles thatched with straw +were stuck into the ground at various scattered points, +amid and under which the whitish forms of his meek +ewes moved and rustled. The ring of the sheep-bell, +which had been silent during his absence, recommenced, +in tones that had more mellowness than clearness, owing +to an increasing growth of surrounding wool. This +continued till Oak withdrew again from the flock. He + -- returned to the hut, bringing in his arms a new-born +lamb, consisting of four legs large enough for a full+ +grown sheep, united by a seemingly inconsiderable mem+ +brane about half the substance of the legs collectively, +which constituted the animal's entire body just at present. +The little speck of life he placed on a wisp of hay +before the small stove, where a can of milk was simmer+ +ing. Oak extinguished the lantern by blowing into it +and then pinching the snuff, the cot being lighted +by a candle suspended by a twisted wire. A rather +hard couch, formed of a few corn sacks thrown carelessly +down, covered half the floor of this little +habitation, and +here the young man stretched himself along, loosened +his woollen cravat, and closed his eyes. In about the +time a person unaccustomed to bodily labour would have +decided upon which side to lie, Farmer Oak was asleep. +The inside of the hut, as it now presented itself, was +cosy and alluring, and the scarlet handful of fire in +addition to the candle, reflecting its own genial colour +upon whatever it could reach, flung associations of +enjoyment even over utensils and tools. In the corner +stood the sheep-crook, and along a shelf at one side +were ranged bottles and canisters of the simple prepara+ +tions pertaining to ovine surgery and physic; spirits of +wine, turpentine, tar, magnesia, ginger, and castor-oil +being the chief. On a triangular shelf across the corner +stood bread, bacon, cheese, and a cup for ale or cider, +which was supplied from a flagon beneath. Beside the +provisions lay the flute whose notes had lately been +called forth by the lonely watcher to beguile a tedious +hour. The house was ventilated by two round holes, +like the lights of a ship's cabin, with wood slides+ +The lamb, revived by the warmth' began to bleat' +instant meaning, as expected sounds will. Passing +from the profoundest sleep to the most alert wakefulness +with the same ease that had accompanied the reverse +operation, he looked at his watch, found that the hour+ +hand had shifted again, put on his hat, took the lamb +in his arms, and carried it into the darkness. After +placing the little creature with its mother, he stood and +carefully examined the sky, to ascertain the time of +night from the altitudes of the stars. +The Dog-star and Aldebaran, pointing to the restless +Pleiades, were half-way up the Southern sky, and between +them hung Orion, which gorgeous constellation never +burnt more vividly than now, as it soared forth above +the rim of the landscape. Castor and Pollux will +the north-west; far away through the plantation Vega +and Cassiopeia's chair stood daintily poised on the +uppermost boughs. +"One o'clock,' said Gabriel. +Being a man not without a frequent consciousness +that there was some charm in this life he led, he stood +still after looking at the sky as a useful instrument, and +regarded it in an appreciative spirit, as a work of art +superlatively beautiful. For a moment he seemed +impressed with the speaking loneliness of the scene, or +rather with the complete abstraction from all its compass +of the sights and sounds of man. Human shapes,interferences, +troubles, and joys were all as if they were not, and there +seemed to be on the shaded hemisphere of the globe no sentient being +save himself; he could fancy them all gone round to the sunny side. + Occupied this, with eyes stretched afar, Oak gradually per+ +ceived that what he had previously taken to be a star low +down behind the outskirts of the plantation was in reality no +such thing. It was an artificial light, almost close at hand. + To find themselves utterly alone at night where company +is desirable and expected makes some people fearful; but a +case more trying by far to the nerves is to discover some +mysterious companionship when intuition, sensation, memory, +analogy, testimony, probability, induction -- every kind of +evidence in the logician's list -- have united to persuade con+ +sciousness that it is quite in isolation. + Farmer Oak went towards the plantation and pushed +through its lower boughs to the windy side. A dim mass under +the slope reminded him that a shed occupied a place here, +the site being a cutting into the slope of the hill, so that at +its back part the roof was almost level with the ground. In +front it was formed of board nailed to posts and covered with +tar as apreservative. Through crevices in the roof and side +spread streaks and spots of light, a combination of which made +the radiance that had attracted him. Oak stepped up behind, +where,leaning down upon the roof and putting his eye close +to a hole, he could see into the interior clearly. + The place contained two women and two cows. By the side +of the latter a steaming bran-mash stood in a bucket. One +of the women was past middle age. Her companion was ap+ +parently young and graceful; he could form no decided opinion +upon her looks, her position being almost beneath his eye, so +that he saw her in a bird's-eye view, as Milton's Satan first saw +Paradise. She wore no bonnet or het, but had enveloped her+ +self in a large cloak, which was carelessly flung over her head +as a covering. + "There, now we'll go home," said the elder of the two, resting + her knuckles upon her hips, and looking at their goings-on as +a whole. "I do hope Daisy will fetch round again now. I have +never been more frightened in my life, but I don't mind break+ +ing my rest if she recovers." + The young woman, whose eyelids were apparently inclined +to fall together on the smallest provocation of silence,yawned +in sympathy. + "I wish we were rich enough to pay a man to do these +things," she said. + "As we are not, we must do them ourselves," said the other; +"for you must help me if you stay." +"Well, my hat is gone, however," continued the younger. "It +went over the hedge, I think. The idea of such a slight wind +catching it." + The cow standing erect was of the Devon breed, and was +encased in a tight warm hide of rich Indian red, as absolutely +uniform from eyes to tail as if the animal had been dipped in +a dye of that colour, her long back being mathematically level. +The other was spotted,grey and white. Beside her Oak now +noticed a little calf about a day old, looking idiotically at +the two women, which showed that it had not long been +accustomed to the phenomenon of eyesight, and often turn+ +ing to the lantern, which it apparently mistook for the moon. +inherited instinct having as yet had little time for correction +by experience. Between the sheep and the cows Lucina had +been busy on Norcombe hill lately. + "I think we had better send for some oatmeal," said the +"Yes, aunt; and I'll ride over for it as soon as it is +light. ' +" But there's no side-saddle.' +"I can ride on the other : trust me.' +Oak, upon hearing these remarks, became more +curious to observe her features, but this prospect being +denied him by the hooding efect of the cloak, and by his +aerial position, he felt himself drawing upon his fancy +for their details. In making even horizontal and clear +inspections we colour and mould according to the warts +within us whatever our eyes bring in. Had Gabriel +been able from the first to get a distinct view of her + +countenance, his estimate of it as very handsome or +slightly so would have been as his soul required a +divinity at the moment or was ready supplied with one. +Having for some time known the want of a satisfactory +form to fill an increasing void within him, his position +moreover affording the widest scope for his fancy, he +painted her a beauty. +By one of those whimsical coincidences in which +Nature, like a busy mother, seems to spare a moment +from her unremitting labours to turn and make her +children smile, the girl now dropped the cloak, and +forth tumbled ropes of black hair over a red jacket. +Oak knew her instantly as the heroine of the yellow +waggon, myrtles, and looking-glass : prosily, as the +woman who owed him twopence. +They placed the calf beside its mother again, took +up the lantern, and went out, the light sinking down +the hill till it was no more than a nebula. Gabriel +Oak returned to his flock. +A GIRL ON HORSEBACK -- CONVERSATION +THE sluggish day began to break. Even its position +terrestrially is one of the elements of a new interest, +and for no particular reason save that the incident of +the night had occurred there, Oak went again into +the plantation. Lingering and musing here, he heard +the steps of a horse at the foot of the hill, and soon +there appeared in view an auburn pony with a girl on +its back, ascending by the path leading past the cattle+ +shed. She was the young woman of the night before. +Gabriel instantly thought of the hat she had mentioned +as having lost in the wind; possibly she had come to +look for it. He hastily scanned the ditch and after +walking about ten yards along it, found the hat among the +leaves. Gabriel took it in his hand and returned to his +hut. Here he ensconced himself, and peeped through +the loophole in the direction of the riders approach. +She came up and looked around -- then on the other +side of the hedge. Gabriel was about to advance and +restore the missing article when an unexpected per+ +formance induced him to suspend the action for the +present. The path, after passing the cowshed, bisected +the plantation. It was not a bridle-path -- merely a +pedestrian's track, and the boughs spread horizontally +at a height not greater than seven feet above the ground, +which made it impossible to ride erect beneath them. +The girl, who wore no riding-habit, looked around for +a moment, as if to assure herself that all humanity was +out of view, then dexterously dropped backwards flat +upon the pony's back, her head over its tail, her feet +against its shoulders, and her eyes to the sky. The +rapidity of her glide into this position was that of a +kingfisher -- its noiselessness that of a hawk. Gabriel's +eyes had scarcely been able to follow her. The tall lank +pony seemed used to such doings, and ambled +along unconcerned. Thus she passed under the level boughs. +The performer seemed quite at home anywhere +between a horse's head and its tail, and the necessity +for this abnormal attitude having ceased with the +passage of the plantation, she began to adopt another, +even more obviously convenient than the first. She had +no side-saddle, and it was very apparent that a firm +seat upon the smooth leather beneath her was un+ +attainable sideways. Springing to her accustomed +perpendicular like a bowed sapling, and satisfying her, +self that nobody was in sight, she seated herself in the +manner demanded by the saddle, though hardly expected +of the woman, and trotted off in the direction of Tewnell +Mill. +Oak was amused, perhaps a little astonished, and +hanging up the hat in his hut, went again among his +ewes. An hour passed, the girl returned, properly +seated now, with a bag of bran in front of her. On +nearing the cattle-shed she was met by a boy bringing +a milking-pail, who held the reins of the pony whilst +she slid off. The boy led away the horse, leaving the +pail with the young woman. +Soon soft spirts alternating with loud spirts came +in regular succession from within the shed, the obvious +sounds of a person milking a cow. Gabriel took the +lost hat in his hand, and waited beside the path she +would follow in leaving the hill. +She came, the pail in one hand, hanging against her +knee. The left arm was extended as a balance, enough +of it being shown bare to make Oak wish that the event +ha happened in the summer, when the whole would +have been revealed. There was a bright air and manner +about her now, by which she seemed to imply that the +desirability of her existence could not be questioned; +and this rather saucy assumption failed in being offensive, +because a beholder felt it to be, upon the whole, true. +Like exceptional emphasis in the tone of a genius, that +which would have made mediocrity ridiculous was an +addition to recognised power. It was with some +surprise that she saw Gabriel's face rising like the +moon behind the hedge. +The adjustment of the farmer's hazy conceptions of +her +charms to the portrait of herself she now presented +him with was less a diminuition than a difference. The +starting-point selected by the judgment was. her height +She seemed tall, but the pail was a small one, and the +hedge diminutive; hence, making allowance for error +by comparison with these, she could have been not +above the height to be chosen by women as best. All +features of consequence were severe and regular. It +may have been observed by persons who go about the +shires with eyes for beauty, that in Englishwoman a +classically-formed face is seldom found to be united +with a figure of the same pattern, the highly-finished +features being generally too large for the remainder of +the frame ; that a graceful and proportionate figure of +eight heads usually goes off into random facial curves. +Without throwing a Nymphean tissue over a milkmaid, +let it be said that here criticism checked itself as out +of place, and looked at her proportions with a long +consciousness of pleasure. From the contours of her +figure in its upper part, she must have had a beautiful +neek and shoulders ; but since her infancy nobody had +ever seen them. Had she been put into a low dress +she would have run and thrust her head into a bush. +Yet she was not a shy girl by any means; it was merely +her instinct to draw the line dividing the seen from the +unseen higher than they do it in towns. +That the girl's thoughts hovered about her face +and form as soon as she caught Oak's eyes conning the +same page was natural, and almost certain. The self+ +consciousness shown would have been vanity if a little +more pronounced, dignity if a little less. Rays of male +vision seem to have a tickling effect upon virgin faces +in rural districts ; she brushed hers with her hand, as if +Gabriel had been irritating its pink surface by actual +touch, and the free air of her previous movements was +reduced at the same time to a chastened phase of +itself. Yet it was the man who blushed, the maid not +at all. +" I found a hat,' said Oak. +" It is mine,' said she, and, from a sense of proportion, +kept down to a small smile an inclination to laugh dis+ +tinctly : "it flew away last night.' +" One o'clock this morning ? ' +" Well -- it was.' She was surprised. " How did you +know ? ' she said. +" I was here.' +" You are Farmer Oak, are you not ? ' +" That or thereabouts. I'm lately come to this place.' +" A large farm ? ' she inquired, casting her eyes round, +and swinging back her hair, which was black in the +shaded hollows of its mass; but it being now an hour +past sunrise, the rays touched its prominent curves with +a colour of their own. +" No ; not large. About a hundred.' (In speaking +of farms the word "acres ' is omitted by the natives, by +analogy to such old expressions as "a stag of ten.') +' "I wanted my hat this morning,' she went on. +had to ride to Tewnell Mill.' +"Yes you had.' +"How do you know?' +"I saw you! +"Where?' she inquired, a misgiving bringing every +muscle of her lineaments and frame to a standstill. +"Here-going through the plantation, and all down +the hill,' said Farmer Oak, with an aspect excessively +knowing with regard to some matter in his mind, as he +gazed at a remote point in the direction named, and then +turned back to meet his colloquist's eyes. +A perception caused him to withdraw his own eyes +from hers as suddenly as if he had been caught in a +theft. Recollection of the strange antics she had +indulged in when passing through the trees, was suc+ +ceeded in the girl by a nettled palpitation, and that' by +a hot face. It was a time to see a woman redden who +was not given to reddening s a rule; not a point in +the milkmaid but was of the deepest rose-colour. From +the Maiden's Blush, through all varieties of the Provence +down to the Crimson Tuscany, the countenance of Oak's +acquaintance quickly graduated ; whereupon he, in con+ +siderateness, turned away his head. +The sympathetic man still looked the other way, and +wondered when she would recover coolness sufficient to +justify him in facing her again. He heard what seemed +to be the flitting of a +dead leaf upon the breeze, and +looked. She had gone away. +With an air between that of Tragedy and Comedy ! +Gabriel returned to his work. +Five mornings and evenings passed. The young +woman came regularly to milk the healthy cow or to +attend to the sick one, but never allowed her vision to +stray in the direction of Oak's person. His want of +tact had deeply offended her -- not by seeing what he +could not help, but by letting her know that he had +seen it. For, as without law there is no sin, without +eyes there is no indecorum; and she appeared to feel +that Gabriel's espial had made her an indecorous woman +without her own connivance. It was food for great regret +with him; it was also a contretemps which touched into +life a latent heat he had experienced in that direction. +The acquaintanceship might, however, have ended in +a slow forgetting, but for an incident which occurred at +the end of the same week. One afternoon it began to +freeze, and the frost increased with evening, which drew +on like a stealthy tightening of bonds. It was a time +when in cottages the breath of the sleepers freezes to +the sheets; when round the drawing-room fire of a +thick-walled mansion the sitters' backs are cold, even +whilst their faces are all aglow. Many a small bird went +to bed supperless that night among the bare boughs. +As the milking-hour drew near, Oak kept his usual +watch upon the cowshed. At last he felt cold, and +shaking an extra quantity of bedding round the yeaning +ewes he entered the hut and heaped more fuel upon +the stove. The wind came in at the bottom of the door, +and to prevent it Oak laid a sack there and wheeled the +cot round a little more to the south. Then the wind +spouted in at a ventilating hole -- of which there was one +on each side of the hut. +Gabriel had always known that when the fire was +lighted and the door closed one of these must be kept +open -- that chosen being always on the side away from +the wind. Closing the slide to windward, he turned to +open the other; on second -- -thoughts the farmer con+ +sidered that he would first sit down leaving both +closed for a minute or two, till the temperature of the +hut was a little raised. He sat down. +His head began to ache in an unwonted manner, and, +fancying himself weary by reason of the broken rests of +the preceding nights, Oak decided to get up, open the +slide, and then allow himself to fall asleep. He fell +asleep, however, without having performed the necessary +preliminary. diff --git a/lib/nr/ansi/disk.id b/lib/nr/ansi/disk.id new file mode 100644 index 0000000..e291c82 --- /dev/null +++ b/lib/nr/ansi/disk.id @@ -0,0 +1,3 @@ +Numerical Recipes in ANSI C +2.10 +Disk 1 of 1 diff --git a/lib/nr/ansi/examples/xairy.c b/lib/nr/ansi/examples/xairy.c new file mode 100644 index 0000000..1cf097a --- /dev/null +++ b/lib/nr/ansi/examples/xairy.c @@ -0,0 +1,40 @@ + +/* Driver for routine airy */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float ai,bi,aip,bip,x,xai,xbi,xaip,xbip; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Airy Functions",14)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s\n%14s %16s %17s %16s\n%14s %16s %17s %16s\n", + "x","ai","bi","aip","bip","xai","xbi","xaip","xbip"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f %f %f",&x,&ai,&bi,&aip,&bip); + airy(x,&xai,&xbi,&xaip,&xbip); + printf("%5.2f\n\t%16.6e %16.6e %16.6e %16.6e\n",x,ai,bi,aip,bip); + printf("\t%16.6e %16.6e %16.6e %16.6e\n",xai,xbi,xaip,xbip); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xamebsa.c b/lib/nr/ansi/examples/xamebsa.c new file mode 100644 index 0000000..2790fc4 --- /dev/null +++ b/lib/nr/ansi/examples/xamebsa.c @@ -0,0 +1,90 @@ + +/* Driver for routine amebsa */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 4 +#define MP 5 +#define FTOL 1.0E-6 +#define N 4 +#define RAD 0.3 +#define AUG 2.0 + +long idum=(-64); + +float tfunk(float p[]) +{ + int j; + float q,r,sumd=0.0,sumr=0.0; + static float wid[N+1]={0.0,1.0,3.0,10.0,30.0}; + + for (j=1;j<=N;j++) { + q=p[j]*wid[j]; + r=(float)(q >= 0 ? (int)(q+0.5) : -(int)(0.5-q)); + sumr += q*q; + sumd += (q-r)*(q-r); + } + return 1+sumr*(1+(sumd > RAD*RAD ? AUG : AUG*sumd/(RAD*RAD))); +} + +int main(void) +{ + int i,iiter,iter,j,jiter,ndim=NP,nit; + float temptr,yb,ybb; + float **p,*x,*y,*pb; + static float xoff[NP+1]={0.0,10.0,10.0,10.0,10.0}; + + p=matrix(1,MP,1,NP); + x=vector(1,NP); + y=vector(1,MP); + pb=vector(1,NP); + for (i=1;i<=MP;i++) + for (j=1;j<=NP;j++) p[i][j]=0.0; + for (;;) { + for (j=2;j<=MP;j++) p[j][j-1]=1.0; + for (i=1;i<=MP;i++) { + for (j=1;j<=NP;j++) x[j]=(p[i][j] += xoff[j]); + y[i]=tfunk(x); + } + yb=1.0e30; + printf("Input t, iiter:\n"); + if (scanf("%f %d",&temptr,&iiter) == EOF) break; + ybb=1.0e30; + nit=0; + for (jiter=1;jiter<=100;jiter++) { + iter=iiter; + temptr *= 0.8; + amebsa(p,y,ndim,pb,&yb,FTOL,tfunk,&iter,temptr); + nit += iiter-iter; + if (yb < ybb) { + ybb=yb; + printf("%6d %10.3e ",nit,temptr); + for (j=1;j<=NP;j++) printf("%10.5f ",pb[j]); + printf("%15.7e\n",yb); + } + if (iter > 0) break; + } + printf("Vertices of final 3-D simplex and\n"); + printf("float values at the vertices:\n"); + printf("%3s %10s %12s %12s %14s\n\n", + "i","x[i]","y[i]","z[i]","function"); + for (i=1;i<=MP;i++) { + printf("%3d ",i); + for (j=1;j<=NP;j++) printf("%12.6f ",p[i][j]); + printf("%15.7e\n",y[i]); + } + printf("%3d ",99); + for (j=1;j<=NP;j++) printf("%12.6f ",pb[j]); + printf("%15.7e\n",yb); + } + free_vector(pb,1,NP); + free_vector(y,1,MP); + free_vector(x,1,NP); + free_matrix(p,1,MP,1,NP); + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xamoeba.c b/lib/nr/ansi/examples/xamoeba.c new file mode 100644 index 0000000..7d87d72 --- /dev/null +++ b/lib/nr/ansi/examples/xamoeba.c @@ -0,0 +1,49 @@ + +/* Driver for routine amoeba */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MP 4 +#define NP 3 +#define FTOL 1.0e-6 + +float func(float x[]) +{ + return 0.6-bessj0(SQR(x[1]-0.5)+SQR(x[2]-0.6)+SQR(x[3]-0.7)); +} + +int main(void) +{ + int i,nfunc,j,ndim=NP; + float *x,*y,**p; + + x=vector(1,NP); + y=vector(1,MP); + p=matrix(1,MP,1,NP); + for (i=1;i<=MP;i++) { + for (j=1;j<=NP;j++) + x[j]=p[i][j]=(i == (j+1) ? 1.0 : 0.0); + y[i]=func(x); + } + amoeba(p,y,ndim,FTOL,func,&nfunc); + printf("\nNumber of function evaluations: %3d\n",nfunc); + printf("Vertices of final 3-d simplex and\n"); + printf("function values at the vertices:\n\n"); + printf("%3s %10s %12s %12s %14s\n\n", + "i","x[i]","y[i]","z[i]","function"); + for (i=1;i<=MP;i++) { + printf("%3d ",i); + for (j=1;j<=NP;j++) printf("%12.6f ",p[i][j]); + printf("%12.6f\n",y[i]); + } + printf("\nTrue minimum is at (0.5,0.6,0.7)\n"); + free_matrix(p,1,MP,1,NP); + free_vector(y,1,MP); + free_vector(x,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xanneal.c b/lib/nr/ansi/examples/xanneal.c new file mode 100644 index 0000000..bcc0f21 --- /dev/null +++ b/lib/nr/ansi/examples/xanneal.c @@ -0,0 +1,38 @@ + +/* Driver for routine anneal */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NCITY 10 + +int main(void) +{ + int i,ii,*iorder; + long idum=(-111); + float *x,*y; + + iorder=ivector(1,NCITY); + x=vector(1,NCITY); + y=vector(1,NCITY); + for (i=1;i<=NCITY;i++) { + x[i]=ran3(&idum); + y[i]=ran3(&idum); + iorder[i]=i; + } + anneal(x,y,iorder,NCITY); + printf("*** System Frozen ***\n"); + printf("Final path:\n"); + printf("%8s %9s %12s\n","city","x","y"); + for (i=1;i<=NCITY;i++) { + ii=iorder[i]; + printf("%4d %10.4f %10.4f\n",ii,x[ii],y[ii]); + } + free_vector(y,1,NCITY); + free_vector(x,1,NCITY); + free_ivector(iorder,1,NCITY); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xarcode.c b/lib/nr/ansi/examples/xarcode.c new file mode 100644 index 0000000..8c172e8 --- /dev/null +++ b/lib/nr/ansi/examples/xarcode.c @@ -0,0 +1,80 @@ + +/* Driver for routines arcmak and arcode */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MC 512 + +#define NWK 20 + +#define MAXLINE 256 + +int main(void) +{ + int k; + unsigned long i,j,lc,lcode=MAXLINE,n,nch,nrad,nt,nfreq[257],tmp,zero=0; + unsigned char *code,mess[MAXLINE],ness[MAXLINE]; + arithcode acode; + FILE *fp; + + code=cvector(0,MAXLINE); + acode.ilob=lvector(1,NWK); + acode.iupb=lvector(1,NWK); + acode.ncumfq=lvector(1,MC+2); + if ((fp = fopen("text.dat","r")) == NULL) + nrerror("Input file text.dat not found.\n"); + for (j=1;j<=256;j++) nfreq[j]=0; + while ((k=getc(fp)) != EOF) { + if ((k -= 31) >= 1) nfreq[k]++; + } + fclose(fp); + nch=96; + nrad=256; + /* here is the initialization that constructs the code */ + arcmak(nfreq,(int)nch,(int)nrad,&acode); + /* now ready to prompt for lines to encode */ + for (;;) { + printf("Enter a line:\n"); + if (gets((char *)&mess[1]) == NULL) break; + n=strlen((char *)&mess[1]); + /* shift from 256 character alphabet to 96 printing characters */ + for (j=1;j<=n;j++) mess[j] -= 32; + /* message initialization */ + lc=1; + arcode(&zero,&code,&lcode,&lc,0,&acode); + /* here we arithmetically encode mess(1:n) */ + for (j=1;j<=n;j++) { + tmp=mess[j]; + arcode(&tmp,&code,&lcode,&lc,1,&acode); + } + /* message termination */ + arcode(&nch,&code,&lcode,&lc,1,&acode); + printf("Length of line input, coded= %lu %lu\n",n,lc-1); + /* here we decode the message, hopefully to get the original back */ + lc=1; + arcode(&zero,&code,&lcode,&lc,0,&acode); + for (j=1;j<=lcode;j++) { + arcode(&i,&code,&lcode,&lc,-1,&acode); + if (i == nch) break; + else ness[j]=(unsigned char)i; + } + if (j > lcode) nrerror("Arith. coding: Never get here"); + nt=j-1; + printf("Decoded output:\n"); + for (j=1;j<=nt;j++) printf("%c",(char)(ness[j]+32)); + printf("\n"); + if (nt != n) printf("Error ! j decoded != n input.\n"); + } + free_cvector(code,0,MAXLINE); + free_lvector(acode.ncumfq,1,MC+2); + free_lvector(acode.iupb,1,NWK); + free_lvector(acode.ilob,1,NWK); + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xavevar.c b/lib/nr/ansi/examples/xavevar.c new file mode 100644 index 0000000..39006c9 --- /dev/null +++ b/lib/nr/ansi/examples/xavevar.c @@ -0,0 +1,31 @@ + +/* Driver for routine avevar */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPTS 1000 +#define EPS 0.1 + +int main(void) +{ + int i,j; + long idum=(-5); + float ave,shift,vrnce,*data; + + data=vector(1,NPTS); + /* generate gaussian distributed data */ + printf("\n%9s %11s %12s\n","shift","average","variance"); + for (i=1;i<=11;i++) { + shift=(i-1)*EPS; + for (j=1;j<=NPTS;j++) + data[j]=shift+i*gasdev(&idum); + avevar(data,NPTS,&ave,&vrnce); + printf("%8.2f %11.2f %12.2f\n",shift,ave,vrnce); + } + free_vector(data,1,NPTS); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbalanc.c b/lib/nr/ansi/examples/xbalanc.c new file mode 100644 index 0000000..8a29c9d --- /dev/null +++ b/lib/nr/ansi/examples/xbalanc.c @@ -0,0 +1,55 @@ + +/* Driver for routine balanc */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 5 + +int main(void) +{ + int i,j; + float *c,*r,**a; + + c=vector(1,NP); + r=vector(1,NP); + a=matrix(1,NP,1,NP); + for (i=1;i<=NP;i++) + for (j=1;j<=NP;j++) + a[i][j] = (((i & 1) && !(j & 1)) ? 100.0 : 1.0); + /* Write norms */ + for (i=1;i<=NP;i++) { + r[i]=c[i]=0.0; + for (j=1;j<=NP;j++) { + r[i] += fabs(a[i][j]); + c[i] += fabs(a[j][i]); + } + } + printf("rows:\n"); + for (i=1;i<=NP;i++) printf("%12.2f",r[i]); + printf("\ncolumns:\n"); + for (i=1;i<=NP;i++) printf("%12.2f",c[i]); + printf("\n\n***** Balancing matrix *****\n\n"); + balanc(a,NP); + /* Write norms */ + for (i=1;i<=NP;i++) { + r[i]=c[i]=0.0; + for (j=1;j<=NP;j++) { + r[i] += fabs(a[i][j]); + c[i] += fabs(a[j][i]); + } + } + printf("rows:\n"); + for (i=1;i<=NP;i++) printf("%12.2f",r[i]); + printf("\ncolumns:\n"); + for (i=1;i<=NP;i++) printf("%12.2f",c[i]); + printf("\n"); + free_matrix(a,1,NP,1,NP); + free_vector(r,1,NP); + free_vector(c,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbandec.c b/lib/nr/ansi/examples/xbandec.c new file mode 100644 index 0000000..922a003 --- /dev/null +++ b/lib/nr/ansi/examples/xbandec.c @@ -0,0 +1,38 @@ + +/* Driver for routine bandec */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +int main(void) +{ + float d,**a,**al,*b,*x; + unsigned long i,j,*indx; + long idum=(-1); + + a=matrix(1,7,1,4); + x=vector(1,7); + b=vector(1,7); + al=matrix(1,7,1,2); + indx=lvector(1,7); + for (i=1;i<=7;i++) { + x[i]=ran1(&idum); + for (j=1;j<=4;j++) { + a[i][j]=ran1(&idum); + } + } + banmul(a,7,2,1,x,b); + for (i=1;i<=7;i++) printf("%ld %12.6f %12.6f\n",i,b[i],x[i]); + bandec(a,7,2,1,al,indx,&d); + banbks(a,7,2,1,al,indx,b); + for (i=1;i<=7;i++) printf("%ld %12.6f %12.6f\n",i,b[i],x[i]); + free_lvector(indx,1,7); + free_matrix(al,1,7,1,2); + free_vector(b,1,7); + free_vector(x,1,7); + free_matrix(a,1,7,1,4); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbanmul.c b/lib/nr/ansi/examples/xbanmul.c new file mode 100644 index 0000000..eca60c3 --- /dev/null +++ b/lib/nr/ansi/examples/xbanmul.c @@ -0,0 +1,52 @@ + +/* Driver for routine banmul */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 7 +#define M1 2 +#define M2 1 +#define MP (M1+1+M2) + +int main(void) +{ + unsigned long i,j,k; + float **a,**aa,*ax,*b,*x; + + a=matrix(1,NP,1,MP); + aa=matrix(1,NP,1,NP); + ax=vector(1,NP); + b=vector(1,NP); + x=vector(1,NP); + for (i=1;i<=M1;i++) for (j=1;j<=NP;j++) a[j][i]=10.0*j+i; + /* Lower band */ + for (i=1;i<=NP;i++) a[i][M1+1]=i; + /* Diagonal */ + for (i=1;i<=M2;i++) for (j=1;j<=NP;j++) a[j][M1+1+i]=0.1*j+i; + /* Upper band */ + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) { + k=i-M1-1; + if (j>=LMAX(1,1+k) && j<=LMIN(M1+M2+1+k,NP)) + aa[i][j]=a[i][j-k]; + else aa[i][j]=0.0; + } + } + for (i=1;i<=NP;i++) x[i]=i/10.0; + banmul(a,NP,M1,M2,x,b); + for (i=1;i<=NP;i++) { + for (ax[i]=0.0,j=1;j<=NP;j++) ax[i] += aa[i][j]*x[j]; + } + printf("\tReference vector\tbanmul vector\n"); + for (i=1;i<=NP;i++) printf("\t%12.4f\t%12.4f\n",ax[i],b[i]); + free_vector(x,1,NP); + free_vector(b,1,NP); + free_vector(ax,1,NP); + free_matrix(aa,1,NP,1,NP); + free_matrix(a,1,NP,1,MP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbcucof.c b/lib/nr/ansi/examples/xbcucof.c new file mode 100644 index 0000000..79c22b0 --- /dev/null +++ b/lib/nr/ansi/examples/xbcucof.c @@ -0,0 +1,38 @@ + +/* Driver for routine bcucof */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +int main(void) +{ + int i,j; + float d1,d2,ee,x1x2; + float y[5],y1[5],y2[5],y12[5],**c; + static float x1[]={0.0,0.0,2.0,2.0,0.0}; + static float x2[]={0.0,0.0,0.0,2.0,2.0}; + + c=matrix(1,4,1,4); + d1=x1[2]-x1[1]; + d2=x2[4]-x2[1]; + for (i=1;i<=4;i++) { + x1x2=x1[i]*x2[i]; + ee=exp(-x1x2); + y[i]=x1x2*ee; + y1[i]=x2[i]*(1.0-x1x2)*ee; + y2[i]=x1[i]*(1.0-x1x2)*ee; + y12[i]=(1.0-3.0*x1x2+x1x2*x1x2)*ee; + } + bcucof(y,y1,y2,y12,d1,d2,c); + printf("\nCoefficients for bicubic interpolation:\n\n"); + for (i=1;i<=4;i++) { + for (j=1;j<=4;j++) printf("%12.6f",c[i][j]); + printf("\n"); + } + free_matrix(c,1,4,1,4); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbcuint.c b/lib/nr/ansi/examples/xbcuint.c new file mode 100644 index 0000000..457732f --- /dev/null +++ b/lib/nr/ansi/examples/xbcuint.c @@ -0,0 +1,42 @@ + +/* Driver for routine bcuint */ + +#include +#define NRANSI +#include "nr.h" + +int main(void) +{ + int i; + float ansy,ansy1,ansy2,ey,ey1,ey2; + float x1,x1l,x1u,x1x2,x2,x2l,x2u,xxyy; + float y[5],y1[5],y12[5],y2[5]; + static float xx[]={0.0,0.0,2.0,2.0,0.0}; + static float yy[]={0.0,0.0,0.0,2.0,2.0}; + + x1l=xx[1]; + x1u=xx[2]; + x2l=yy[1]; + x2u=yy[4]; + for (i=1;i<=4;i++) { + xxyy=xx[i]*yy[i]; + y[i]=xxyy*xxyy; + y1[i]=2.0*yy[i]*xxyy; + y2[i]=2.0*xx[i]*xxyy; + y12[i]=4.0*xxyy; + } + printf("\n%6s %8s %7s %11s %6s %10s %6s %10s \n\n", + "x1","x2","y","expect","y1","expect","y2","expect"); + for (i=1;i<=10;i++) { + x2=(x1=0.2*i); + bcuint(y,y1,y2,y12,x1l,x1u,x2l,x2u,x1,x2,&ansy,&ansy1,&ansy2); + x1x2=x1*x2; + ey=x1x2*x1x2; + ey1=2.0*x2*x1x2; + ey2=2.0*x1*x1x2; + printf("%8.4f %8.4f %8.4f %8.4f %8.4f %8.4f %8.4f %8.4f\n", + x1,x2,ansy,ey,ansy1,ey1,ansy2,ey2); + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbeschb.c b/lib/nr/ansi/examples/xbeschb.c new file mode 100644 index 0000000..681dba8 --- /dev/null +++ b/lib/nr/ansi/examples/xbeschb.c @@ -0,0 +1,29 @@ + +/* Driver for routine beschb */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +int main(void) +{ + double gam1,gam2,gampl,gammi,x,xgam1,xgam2,xgampl,xgammi; + + for (;;) { + printf("Enter x:\n"); + if (scanf("%lf",&x) == EOF) break; + beschb(x,&xgam1,&xgam2,&xgampl,&xgammi); + printf("%5s\n%17s %16s %17s %15s\n%17s %16s %17s %15s\n", + "x","gam1","gam2","gampl","gammi","xgam1","xgam2","xgampl","xgammi"); + gampl=1/exp(gammln((float)(1+x))); + gammi=1/exp(gammln((float)(1-x))); + gam1=(gammi-gampl)/(2*x); + gam2=(gammi+gampl)/2; + printf("%5.2f\n\t%16.6e %16.6e %16.6e %16.6e\n",x,gam1,gam2,gampl,gammi); + printf("\t%16.6e %16.6e %16.6e %16.6e\n",xgam1,xgam2,xgampl,xgammi); + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbessi.c b/lib/nr/ansi/examples/xbessi.c new file mode 100644 index 0000000..ff761e2 --- /dev/null +++ b/lib/nr/ansi/examples/xbessi.c @@ -0,0 +1,37 @@ + +/* Driver for routine bessi */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval,n; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Modified Bessel Function In",27)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%4s %7s %15s %20s\n","n","x","actual","bessi(n,x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%d %f %f",&n,&x,&val); + printf("%4d %8.2f %18.7e %18.7e\n",n,x,val,bessi(n,x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbessi0.c b/lib/nr/ansi/examples/xbessi0.c new file mode 100644 index 0000000..b5de999 --- /dev/null +++ b/lib/nr/ansi/examples/xbessi0.c @@ -0,0 +1,37 @@ + +/* Driver for routine bessi0 */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Modified Bessel Function I0",27)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %12s %13s \n","x","actual","bessi0(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f",&x,&val); + printf("%6.2f %12.7f %12.7f\n",x,val,bessi0(x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbessi1.c b/lib/nr/ansi/examples/xbessi1.c new file mode 100644 index 0000000..2895fac --- /dev/null +++ b/lib/nr/ansi/examples/xbessi1.c @@ -0,0 +1,37 @@ + +/* Driver for routine bessi1 */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Modified Bessel Function I1",27)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %12s %13s \n","x","actual","bessi1(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f",&x,&val); + printf("%6.2f %12.7f %12.7f\n",x,val,bessi1(x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbessik.c b/lib/nr/ansi/examples/xbessik.c new file mode 100644 index 0000000..d062266 --- /dev/null +++ b/lib/nr/ansi/examples/xbessik.c @@ -0,0 +1,40 @@ + +/* Driver for routine bessik */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float ri,rk,rip,rkp,x,xnu,xri,xrk,xrip,xrkp; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Modified Bessel Functions",25)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %7s\n%14s %16s %17s %16s\n%14s %16s %17s %16s\n", + "xnu","x","ri","rk","rip","rkp","xri","xrk","xrip","xrkp"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f %f %f %f",&xnu,&x,&ri,&rk,&rip,&rkp); + bessik(x,xnu,&xri,&xrk,&xrip,&xrkp); + printf("%5.2f %5.2f\n\t%16.6e %16.6e %16.6e %16.6e\n",xnu,x,ri,rk,rip,rkp); + printf("\t%16.6e %16.6e %16.6e %16.6e\n",xri,xrk,xrip,xrkp); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbessj.c b/lib/nr/ansi/examples/xbessj.c new file mode 100644 index 0000000..f18461c --- /dev/null +++ b/lib/nr/ansi/examples/xbessj.c @@ -0,0 +1,37 @@ + +/* Driver for routine bessj */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval,n; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Bessel Function Jn",18)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%4s %7s %15s %20s \n","n","x","actual","bessj(n,x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%d %f %f",&n,&x,&val); + printf("%4d %8.2f %18.6e %18.6e\n",n,x,val,bessj(n,x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbessj0.c b/lib/nr/ansi/examples/xbessj0.c new file mode 100644 index 0000000..fb06f1d --- /dev/null +++ b/lib/nr/ansi/examples/xbessj0.c @@ -0,0 +1,37 @@ + +/* Driver for routine bessj0 */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Bessel Function J0",18)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %12s %13s \n","x","actual","bessj0(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f",&x,&val); + printf("%6.2f %12.7f %12.7f \n",x,val,bessj0(x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbessj1.c b/lib/nr/ansi/examples/xbessj1.c new file mode 100644 index 0000000..86d0124 --- /dev/null +++ b/lib/nr/ansi/examples/xbessj1.c @@ -0,0 +1,37 @@ + +/* Driver for routine bessj1 */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Bessel Function J1",18)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %12s %13s \n","x","actual","bessj1(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f",&x,&val); + printf("%6.2f %12.7f %12.7f\n",x,val,bessj1(x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbessjy.c b/lib/nr/ansi/examples/xbessjy.c new file mode 100644 index 0000000..c922ea2 --- /dev/null +++ b/lib/nr/ansi/examples/xbessjy.c @@ -0,0 +1,40 @@ + +/* Driver for routine bessjy */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float rj,ry,rjp,ryp,x,xnu,xrj,xry,xrjp,xryp; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Ordinary Bessel Functions",25)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %7s\n%14s %16s %17s %16s\n%14s %16s %17s %16s\n", + "xnu","x","rj","ry","rjp","ryp","xrj","xry","xrjp","xryp"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f %f %f %f",&xnu,&x,&rj,&ry,&rjp,&ryp); + bessjy(x,xnu,&xrj,&xry,&xrjp,&xryp); + printf("%5.2f %5.2f\n\t%16.6e %16.6e %16.6e %16.6e\n",xnu,x,rj,ry,rjp,ryp); + printf("\t%16.6e %16.6e %16.6e %16.6e\n",xrj,xry,xrjp,xryp); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbessk.c b/lib/nr/ansi/examples/xbessk.c new file mode 100644 index 0000000..ae03e0e --- /dev/null +++ b/lib/nr/ansi/examples/xbessk.c @@ -0,0 +1,37 @@ + +/* Driver for routine bessk */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval,n; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Modified Bessel Function Kn",27)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%4s %7s %14s %19s\n","n","x","actual","bessk(n,x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%d %f %f",&n,&x,&val); + printf("%4d %8.2f %18.7e %16.7e \n",n,x,val,bessk(n,x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbessk0.c b/lib/nr/ansi/examples/xbessk0.c new file mode 100644 index 0000000..97f3c2c --- /dev/null +++ b/lib/nr/ansi/examples/xbessk0.c @@ -0,0 +1,37 @@ + +/* Driver for routine bessk0 */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Modified Bessel Function K0",27)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %13s %18s \n","x","actual","bessk0(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f",&x,&val); + printf("%6.2f %16.7e %16.7e\n",x,val,bessk0(x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbessk1.c b/lib/nr/ansi/examples/xbessk1.c new file mode 100644 index 0000000..b437dea --- /dev/null +++ b/lib/nr/ansi/examples/xbessk1.c @@ -0,0 +1,37 @@ + +/* Driver for routine bessk1 */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Modified Bessel Function K1",27)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %13s %17s \n","x","actual","bessk1(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f",&x,&val); + printf("%6.2f %16.7e %16.7e\n",x,val,bessk1(x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbessy.c b/lib/nr/ansi/examples/xbessy.c new file mode 100644 index 0000000..163e209 --- /dev/null +++ b/lib/nr/ansi/examples/xbessy.c @@ -0,0 +1,37 @@ + +/* Driver for routine bessy */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval,n; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Bessel Function Yn",18)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%4s %7s %15s %20s \n","n","x","actual","bessy(n,x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%d %f %f",&n,&x,&val); + printf("%4d %8.2f %18.6e %18.6e\n",n,x,val,bessy(n,x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbessy0.c b/lib/nr/ansi/examples/xbessy0.c new file mode 100644 index 0000000..cbd262d --- /dev/null +++ b/lib/nr/ansi/examples/xbessy0.c @@ -0,0 +1,37 @@ + +/* Driver for routine bessy0 */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Bessel Function Y0",18)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %12s %13s \n","x","actual","bessy0(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f",&x,&val); + printf("%6.2f %12.7f %12.7f\n",x,val,bessy0(x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbessy1.c b/lib/nr/ansi/examples/xbessy1.c new file mode 100644 index 0000000..cc35e3a --- /dev/null +++ b/lib/nr/ansi/examples/xbessy1.c @@ -0,0 +1,37 @@ + +/* Driver for routine bessy1 */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Bessel Function Y1",18)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %12s %13s \n","x","actual","bessy1(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f",&x,&val); + printf("%6.2f %12.7f %12.7f\n",x,val,bessy1(x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbeta.c b/lib/nr/ansi/examples/xbeta.c new file mode 100644 index 0000000..573fc30 --- /dev/null +++ b/lib/nr/ansi/examples/xbeta.c @@ -0,0 +1,37 @@ + +/* Driver for routine beta */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,w,z; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Beta Function",13)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %6s %16s %20s\n","w","z","actual","beta(w,z)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f",&w,&z,&val); + printf("%6.2f %6.2f %18.6e %18.6e\n",w,z,val,beta(w,z)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbetai.c b/lib/nr/ansi/examples/xbetai.c new file mode 100644 index 0000000..d6b9d6b --- /dev/null +++ b/lib/nr/ansi/examples/xbetai.c @@ -0,0 +1,39 @@ + +/* Driver for routine betai */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float a,b,x,val; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Incomplete Beta Function",24)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %10s %12s %14s %13s \n", + "a","b","x","actual","betai(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f %f",&a,&b,&x,&val); + printf("%6.2f %12.6f %12.6f %12.6f %12.6f\n", + a,b,x,val,betai(a,b,x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbico.c b/lib/nr/ansi/examples/xbico.c new file mode 100644 index 0000000..1d25db6 --- /dev/null +++ b/lib/nr/ansi/examples/xbico.c @@ -0,0 +1,37 @@ + +/* Driver for routine bico */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,k,n,nval; + float binco; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Binomial Coefficients",21)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%6s %6s %12s %12s \n","n","k","actual","bico(n,k)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%d %d %f ",&n,&k,&binco); + printf("%6d %6d %12.0f %12.0f \n",n,k,binco,bico(n,k)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbnldev.c b/lib/nr/ansi/examples/xbnldev.c new file mode 100644 index 0000000..cb1e4e5 --- /dev/null +++ b/lib/nr/ansi/examples/xbnldev.c @@ -0,0 +1,49 @@ + +/* Driver for routine bnldev */ + +#include +#define NRANSI +#include "nr.h" + +#define N 20 +#define NPTS 1000 +#define ISCAL 200 +#define NN 100 +#define LLEN 50 + +int main(void) +{ + char txt[LLEN+1]; + int i,j,k,klim,dist[N+1]; + long idum=(-133); + float pp,xm,dd; + + for (;;) { + for (j=0;j<=N;j++) dist[j]=0; + do { + printf("Mean of binomial distribution (0.0 to %d.0)",N); + printf(" - Negative to end:\n"); + scanf("%f",&xm); + } while (xm > N); + if (xm < 0.0) break; + pp=xm/NN; + for (i=1;i<=NPTS;i++) { + j=bnldev(pp,NN,&idum); + if (j >= 0 && j <= N) ++dist[j]; + } + printf("Binomial-distributed deviate, mean %5.2f of %6d points\n", + xm,NPTS); + printf("%4s %8s %10s\n","x","p(x)","graph:"); + for (j=0;j LLEN) klim=LLEN; + for (k=1;k<=klim;k++) txt[k]='*'; + txt[LLEN]='\0'; + printf("%4d %9.4f %s\n",j,dd,txt); + } + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbrent.c b/lib/nr/ansi/examples/xbrent.c new file mode 100644 index 0000000..4981703 --- /dev/null +++ b/lib/nr/ansi/examples/xbrent.c @@ -0,0 +1,47 @@ + +/* Driver for routine brent */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define TOL 1.0e-6 +#define EQL 1.0e-4 + +float func(float x) +{ + return bessj0(x); +} + +int main(void) +{ + int i,iflag,j,nmin=0; + float ax,bx,cx,fa,fb,fc,xmin,bren,amin[21]; + + printf("\nMinima of the function bessj0\n"); + printf("%10s %8s %17s %12s\n","min. #","x","bessj0(x)","bessj1(x)"); + for (i=1;i<=100;i++) { + ax=i; + bx=i+1.0; + mnbrak(&ax,&bx,&cx,&fa,&fb,&fc,func); + bren=brent(ax,bx,cx,func,TOL,&xmin); + if (nmin == 0) { + amin[1]=xmin; + nmin=1; + printf("%7d %15.6f %12.6f %12.6f\n", + nmin,xmin,bessj0(xmin),bessj1(xmin)); + } else { + iflag=0; + for (j=1;j<=nmin;j++) + if (fabs(xmin-amin[j]) <= (EQL*xmin)) iflag=1; + if (iflag == 0) { + amin[++nmin]=xmin; + printf("%7d %15.6f %12.6f %12.6f\n", + nmin,xmin,bessj0(xmin),bessj1(xmin)); + } + } + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbroydn.c b/lib/nr/ansi/examples/xbroydn.c new file mode 100644 index 0000000..5a19555 --- /dev/null +++ b/lib/nr/ansi/examples/xbroydn.c @@ -0,0 +1,36 @@ + +/* Driver for routine broydn */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +void funcv(int n,float x[],float f[]) +{ + f[1]=SQR(x[1])+SQR(x[2])-2.0; + f[2]=exp(x[1]-1.0)+x[2]*SQR(x[2])-2.0; +} + +#define N 2 + +int main(void) +{ + int i,check; + float *x,*f; + + x=vector(1,N); + f=vector(1,N); + x[1]=2.0; + x[2]=0.5; + broydn(x,N,&check,funcv); + funcv(N,x,f); + if (check) printf("Convergence problems.\n"); + printf("%7s %3s %12s\n","Index","x","f"); + for (i=1;i<=N;i++) printf("%5d %12.6f %12.6f\n",i,x[i],f[i]); + free_vector(f,1,N); + free_vector(x,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xbsstep.c b/lib/nr/ansi/examples/xbsstep.c new file mode 100644 index 0000000..735f8c7 --- /dev/null +++ b/lib/nr/ansi/examples/xbsstep.c @@ -0,0 +1,54 @@ + +/* Driver for routine bsstep */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 4 + +float dxsav,*xp,**yp; /* defining declarations */ +int kmax,kount; + +int nrhs; /* counts function evaluations */ + +void derivs(float x,float y[],float dydx[]) +{ + nrhs++; + dydx[1] = -y[2]; + dydx[2]=y[1]-(1.0/x)*y[2]; + dydx[3]=y[2]-(2.0/x)*y[3]; + dydx[4]=y[3]-(3.0/x)*y[4]; +} + +int main(void) +{ + int i,nbad,nok; + float eps=1.0e-4,h1=0.1,hmin=0.0,x1=1.0,x2=10.0,*ystart; + + ystart=vector(1,N); + xp=vector(1,200); + yp=matrix(1,10,1,200); + ystart[1]=bessj0(x1); + ystart[2]=bessj1(x1); + ystart[3]=bessj(2,x1); + ystart[4]=bessj(3,x1); + nrhs=0; + kmax=100; + dxsav=(x2-x1)/20.0; + odeint(ystart,N,x1,x2,eps,h1,hmin,&nok,&nbad,derivs,bsstep); + printf("\n%s %13s %3d\n","successful steps:"," ",nok); + printf("%s %20s %3d\n","bad steps:"," ",nbad); + printf("%s %9s %3d\n","function evaluations:"," ",nrhs); + printf("\n%s %3d\n","stored intermediate values: ",kount); + printf("\n%8s %18s %15s\n","x","integral","bessj(3,x)"); + for (i=1;i<=kount;i++) + printf("%10.4f %16.6f %14.6f\n", + xp[i],yp[4][i],bessj(3,xp[i])); + free_matrix(yp,1,10,1,200); + free_vector(xp,1,200); + free_vector(ystart,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xcaldat.c b/lib/nr/ansi/examples/xcaldat.c new file mode 100644 index 0000000..35753c5 --- /dev/null +++ b/lib/nr/ansi/examples/xcaldat.c @@ -0,0 +1,41 @@ + +/* Driver for routine caldat */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + int i,id,idd,im,imm,iy,iyy,n; + long j; + char dummy[MAXSTR]; + static char *name[]={"","january","february","march", + "april","may","june","july","august", + "september","october","november","december"}; + FILE *fp; + + /* Check whether caldat properly undoes the operation of julday */ + if ((fp = fopen("dates1.dat","r")) == NULL) + nrerror("Data file dates1.dat not found\n"); + fgets(dummy,MAXSTR,fp); + fscanf(fp,"%d %*s ",&n); + printf("\n %14s %43s\n","original date:","reconstructed date"); + printf("%8s %5s %6s %15s %12s %5s %6s\n","month","day","year", + "julian day","month","day","year"); + for (i=1;i<=n;i++) { + fscanf(fp,"%d %d %d ",&im,&id,&iy); + fgets(dummy,MAXSTR,fp); + j=julday(im,id,iy); + caldat(j,&imm,&idd,&iyy); + printf("%10s %3d %6d %13ld %16s %3d %6d\n",name[im], + id,iy,j,name[imm],idd,iyy); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xchder.c b/lib/nr/ansi/examples/xchder.c new file mode 100644 index 0000000..501cb2f --- /dev/null +++ b/lib/nr/ansi/examples/xchder.c @@ -0,0 +1,45 @@ + +/* Driver for routine chder */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define NVAL 40 +#define PIO2 1.5707963 + +float func(float x) +{ + return x*x*(x*x-2.0)*sin(x); +} + +float fder(float x) +{ + return 4.0*x*(x*x-1.0)*sin(x)+x*x*(x*x-2.0)*cos(x); +} + +int main(void) +{ + int i,mval; + float a=(-PIO2),b=PIO2,x; + float c[NVAL],cder[NVAL]; + + chebft(a,b,c,NVAL,func); + /* Test derivative */ + for (;;) { + printf("\nHow many terms in Chebyshev evaluation?\n"); + printf("Enter n between 6 and %2d. (n=0 to end).\n",NVAL); + scanf("%d",&mval); + if ((mval <= 0) || (mval > NVAL)) break; + chder(a,b,c,cder,mval); + printf("\n%9s %14s %16s\n","x","actual","Cheby. deriv."); + for (i = -8;i<=8;i++) { + x=i*PIO2/10.0; + printf("%12.6f %12.6f %12.6f\n", + x,fder(x),chebev(a,b,cder,mval,x)); + } + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xchebev.c b/lib/nr/ansi/examples/xchebev.c new file mode 100644 index 0000000..85d3222 --- /dev/null +++ b/lib/nr/ansi/examples/xchebev.c @@ -0,0 +1,38 @@ + +/* Driver for routine chebev */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define NVAL 40 +#define PIO2 1.5707963 + +float func(float x) +{ + return x*x*(x*x-2.0)*sin(x); +} + +int main(void) +{ + int i,mval; + float a=(-PIO2),b=PIO2,x,c[NVAL]; + + chebft(a,b,c,NVAL,func); + /* Test Chebyshev evaluation routine */ + for (;;) { + printf("\nHow many terms in Chebyshev evaluation?\n"); + printf("Enter n between 6 and %2d. (n=0 to end).\n",NVAL); + scanf("%d",&mval); + if ((mval <= 0) || (mval > NVAL)) break; + printf("\n%9s %14s %16s \n","x","actual","chebyshev fit"); + for (i = -8;i<=8;i++) { + x=i*PIO2/10.0; + printf("%12.6f %12.6f %12.6f\n", + x,func(x),chebev(a,b,c,mval,x)); + } + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xchebft.c b/lib/nr/ansi/examples/xchebft.c new file mode 100644 index 0000000..3695165 --- /dev/null +++ b/lib/nr/ansi/examples/xchebft.c @@ -0,0 +1,50 @@ + +/* Driver for routine chebft */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define NVAL 40 +#define PIO2 1.5707963 + +float func(float x) +{ + return x*x*(x*x-2.0)*sin(x); +} + +int main(void) +{ + float a=(-PIO2),b=PIO2,dum,f; + float t0,t1,term,x,y,c[NVAL]; + int i,j,mval; + + chebft(a,b,c,NVAL,func); + /* test result */ + for (;;) { + printf("\nHow many terms in Chebyshev evaluation?\n"); + printf("Enter n between 6 and %2d. (n=0 to end).\n",NVAL); + scanf("%d",&mval); + if ((mval <= 0) || (mval > NVAL)) break; + printf("\n%9s %14s %16s\n","x","actual","chebyshev fit"); + for (i = -8;i<=8;i++) { + x=i*PIO2/10.0; + y=(x-0.5*(b+a))/(0.5*(b-a)); + /* Evaluate Chebyshev polynomial without CHEBEV */ + t0=1.0; + t1=y; + f=c[1]*t1+c[0]*0.5; + for (j=2;j +#include +#define NRANSI +#include "nr.h" + +#define NVAL 40 +#define PIO2 1.5707963 + +float func(float x) +{ + return x*x*(x*x-2.0)*sin(x); +} + +int main(void) +{ + int i,j,mval; + float a=(-PIO2),b=PIO2,poly,x,y; + float c[NVAL],d[NVAL]; + + chebft(a,b,c,NVAL,func); + for (;;) { + printf("\nHow many terms in Chebyshev evaluation?\n"); + printf("Enter n between 6 and %2d. (n=0 to end).\n",NVAL); + scanf("%d",&mval); + if ((mval <= 0) || (mval > NVAL)) break; + chebpc(c,d,mval); + /* Test polynomial */ + printf("\n%9s %14s %14s\n","x","actual","polynomial"); + for (i = -8;i<=8;i++) { + x=i*PIO2/10.0; + y=(x-0.5*(b+a))/(0.5*(b-a)); + poly=d[mval-1]; + for (j=mval-2;j>=0;j--) poly=poly*y+d[j]; + printf("%12.6f %12.6f %12.6f\n",x,func(x),poly); + } + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xchint.c b/lib/nr/ansi/examples/xchint.c new file mode 100644 index 0000000..8720b86 --- /dev/null +++ b/lib/nr/ansi/examples/xchint.c @@ -0,0 +1,45 @@ + +/* Driver for routine chint */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define NVAL 40 +#define PIO2 1.5707963 + +float func(float x) +{ + return x*x*(x*x-2.0)*sin(x); +} + +float fint(float x) +{ + return 4.0*x*(x*x-7.0)*sin(x)-(x*x*(x*x-14.0)+28.0)*cos(x); +} + +int main(void) +{ + int i,mval; + float a=(-PIO2),b=PIO2,x; + float c[NVAL],cint[NVAL]; + + chebft(a,b,c,NVAL,func); + /* test integral */ + for (;;) { + printf("\nHow many terms in Chebyshev evaluation?\n"); + printf("Enter n between 6 and %2d. (n=0 to end).\n",NVAL); + scanf("%d",&mval); + if ((mval <= 0) || (mval > NVAL)) break; + chint(a,b,c,cint,mval); + printf("\n%9s %14s %16s\n","x","actual","Cheby. integ."); + for (i = -8;i<=8;i++) { + x=i*PIO2/10.0; + printf("%12.6f %12.6f %12.6f\n", + x,fint(x)-fint(-PIO2),chebev(a,b,cint,mval,x)); + } + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xcholsl.c b/lib/nr/ansi/examples/xcholsl.c new file mode 100644 index 0000000..d07489a --- /dev/null +++ b/lib/nr/ansi/examples/xcholsl.c @@ -0,0 +1,65 @@ + +/* Driver for routine cholsl */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 3 + +int main(void) +{ + int i,j,k; + float sum,**a,**atest,**chol,*p,*x; + static float aorig[N+1][N+1]= + {0.0,0.0,0.0,0.0, + 0.0,100.0,15.0,0.01, + 0.0,15.0,2.3,0.01, + 0.0,0.01,0.01,1.0}; + static float b[N+1]={0.0,0.4,0.02,99.0}; + + a=matrix(1,N,1,N); + atest=matrix(1,N,1,N); + chol=matrix(1,N,1,N); + p=vector(1,N); + x=vector(1,N); + for (i=1;i<=N;i++) + for (j=1;j<=N;j++) a[i][j]=aorig[i][j]; + choldc(a,N,p); + printf("Original matrix:\n"); + for (i=1;i<=N;i++) { + for (j=1;j<=N;j++) { + chol[i][j]=((i > j) ? a[i][j] : (i == j ? p[i] : 0.0)); + if (i > j) chol[i][j]=a[i][j]; + else chol[i][j]=(i == j ? p[i] : 0.0); + printf("%16.6e",aorig[i][j]); + } + printf("\n"); + } + printf("\n"); + printf("Product of Cholesky factors:\n"); + for (i=1;i<=N;i++) { + for (j=1;j<=N;j++) { + for (sum=0.0,k=1;k<=N;k++) sum += chol[i][k]*chol[j][k]; + atest[i][j]=sum; + printf("%16.6e",atest[i][j]); + } + printf("\n"); + } + printf("\n"); + printf("Check solution vector:\n"); + cholsl(a,N,p,b,x); + for (i=1;i<=N;i++) { + for (sum=0.0,j=1;j<=N;j++) sum += aorig[i][j]*x[j]; + p[i]=sum; + printf("%16.6e%16.6e\n",p[i],b[i]); + } + free_vector(x,1,N); + free_vector(p,1,N); + free_matrix(chol,1,N,1,N); + free_matrix(atest,1,N,1,N); + free_matrix(a,1,N,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xchsone.c b/lib/nr/ansi/examples/xchsone.c new file mode 100644 index 0000000..3842837 --- /dev/null +++ b/lib/nr/ansi/examples/xchsone.c @@ -0,0 +1,39 @@ + +/* Driver for routine chsone */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NBINS 10 +#define NPTS 2000 + +int main(void) +{ + long idum=(-15); + int i,ibin,j; + float chsq,df,prob,x,*bins,*ebins; + + bins=vector(1,NBINS); + ebins=vector(1,NBINS); + for (j=1;j<=NBINS;j++) bins[j]=0.0; + for (i=1;i<=NPTS;i++) { + x=expdev(&idum); + ibin=(int) (x*NBINS/3.0)+1; + if (ibin <= NBINS) ++bins[ibin]; + } + for (i=1;i<=NBINS;i++) + ebins[i]=3.0*NPTS/NBINS*exp(-3.0*(i-0.5)/NBINS); + chsone(bins,ebins,NBINS,0,&df,&chsq,&prob); + printf("%15s %15s\n","expected","observed"); + for (i=1;i<=NBINS;i++) + printf("%14.2f %15.2f\n",ebins[i],bins[i]); + printf("\n%19s %10.4f\n","chi-squared:",chsq); + printf("%19s %10.4f\n","probability:",prob); + free_vector(ebins,1,NBINS); + free_vector(bins,1,NBINS); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xchstwo.c b/lib/nr/ansi/examples/xchstwo.c new file mode 100644 index 0000000..99df684 --- /dev/null +++ b/lib/nr/ansi/examples/xchstwo.c @@ -0,0 +1,43 @@ + +/* Driver for routine chstwo */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NBINS 10 +#define NPTS 2000 + +int main(void) +{ + long idum=(-17); + int i,ibin,j; + float chsq,df,prob,x,*bins1,*bins2; + + bins1=vector(1,NBINS); + bins2=vector(1,NBINS); + for (j=1;j<=NBINS;j++) { + bins1[j]=0.0; + bins2[j]=0.0; + } + for (i=1;i<=NPTS;i++) { + x=expdev(&idum); + ibin=(int) (x*NBINS/3.0+1); + if (ibin <= NBINS) ++bins1[ibin]; + x=expdev(&idum); + ibin=(int) (x*NBINS/3.0+1); + if (ibin <= NBINS) ++bins2[ibin]; + } + chstwo(bins1,bins2,NBINS,0,&df,&chsq,&prob); + printf("\n%15s %15s\n","dataset 1","dataset 2"); + for (i=1;i<=NBINS;i++) + printf("%13.2f %15.2f\n",bins1[i],bins2[i]); + printf("\n%18s %12.4f\n","chi-squared:",chsq); + printf("%18s %12.4f\n","probability:",prob); + free_vector(bins2,1,NBINS); + free_vector(bins1,1,NBINS); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xcisi.c b/lib/nr/ansi/examples/xcisi.c new file mode 100644 index 0000000..0a43dd8 --- /dev/null +++ b/lib/nr/ansi/examples/xcisi.c @@ -0,0 +1,40 @@ + +/* Driver for routine cisi */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float ci,si,x,xci,xsi; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Cosine and Sine Integrals",25)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %12s %12s %12s %12s \n", + "x","actual","ci(x)","actual","si(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f",&x,&xci,&xsi); + cisi(x,&ci,&si); + printf("%6.2f %12.6f %12.6f %12.6f %12.6f\n", + x,xci,ci,xsi,si); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xcntab1.c b/lib/nr/ansi/examples/xcntab1.c new file mode 100644 index 0000000..174e3e2 --- /dev/null +++ b/lib/nr/ansi/examples/xcntab1.c @@ -0,0 +1,55 @@ + +/* Driver for routine cntab1 */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NDAT 9 +#define NMON 12 +#define MAXSTR 80 + +int main(void) +{ + int i,j,**nmbr; + float ccc,chisq,cramrv,df,prob; + char dummy[MAXSTR],fate[NDAT+1][16],mon[NMON+1][6],txt[16]; + FILE *fp; + + nmbr=imatrix(1,NDAT,1,NMON); + if ((fp = fopen("table1.dat","r")) == NULL) + nrerror("Data file table1.dat not found\n"); + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + fscanf(fp,"%16c",txt); + txt[15]='\0'; + for (i=1;i<=12;i++) fscanf(fp," %s",mon[i]); + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + for (i=1;i<=NDAT;i++) { + fscanf(fp,"%16[^0123456789]",fate[i]); + fate[i][15]='\0'; + for (j=1;j<=12;j++) + fscanf(fp,"%d ",&nmbr[i][j]); + } + fclose(fp); + printf("\n%s",txt); + for (i=1;i<=12;i++) printf("%5s",mon[i]); + printf("\n\n"); + for (i=1;i<=NDAT;i++) { + printf("%s",fate[i]); + for (j=1;j<=12;j++) printf("%5d",nmbr[i][j]); + printf("\n"); + } + cntab1(nmbr,NDAT,NMON,&chisq,&df,&prob,&cramrv,&ccc); + printf("\n%15s chi-squared %20.2f\n"," ",chisq); + printf("%15s degrees of freedom%20.2f\n"," ",df); + printf("%15s probability %20.4f\n"," ",prob); + printf("%15s cramer-v %20.4f\n"," ",cramrv); + printf("%15s contingency coeff.%20.4f\n"," ",ccc); + free_imatrix(nmbr,1,NDAT,1,NMON); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xcntab2.c b/lib/nr/ansi/examples/xcntab2.c new file mode 100644 index 0000000..3abb3b6 --- /dev/null +++ b/lib/nr/ansi/examples/xcntab2.c @@ -0,0 +1,58 @@ + +/* Driver for routine cntab2 */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NI 9 +#define NMON 12 +#define MAXSTR 80 + +int main(void) +{ + float h,hx,hxgy,hy,hygx,uxgy,uxy,uygx; + int i,j,**nmbr; + char dummy[MAXSTR],fate[NI+1][16],mon[NMON+1][6],txt[16]; + FILE *fp; + + nmbr=imatrix(1,NI,1,NMON); + if ((fp = fopen("table1.dat","r")) == NULL) + nrerror("Data file table1.dat not found\n"); + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + fscanf(fp,"%16c",txt); + txt[15]='\0'; + for (i=1;i<=12;i++) fscanf(fp," %s",mon[i]); + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + for (i=1;i<=NI;i++) { + fscanf(fp,"%16[^0123456789]",fate[i]); + fate[i][15]='\0'; + for (j=1;j<=12;j++) + fscanf(fp,"%d ",&nmbr[i][j]); + } + fclose(fp); + printf("\n%s",txt); + for (i=1;i<=12;i++) printf("%5s",mon[i]); + printf("\n\n"); + for (i=1;i<=NI;i++) { + printf("%s",fate[i]); + for (j=1;j<=12;j++) printf("%5d",nmbr[i][j]); + printf("\n"); + } + cntab2(nmbr,NI,NMON,&h,&hx,&hy,&hygx,&hxgy,&uygx,&uxgy,&uxy); + printf("\n entropy of table %10.4f\n",h); + printf(" entropy of x-distribution %10.4f\n",hx); + printf(" entropy of y-distribution %10.4f\n",hy); + printf(" entropy of y given x %10.4f\n",hygx); + printf(" entropy of x given y %10.4f\n",hxgy); + printf(" dependency of y on x %10.4f\n",uygx); + printf(" dependency of x on y %10.4f\n",uxgy); + printf(" symmetrical dependency %10.4f\n",uxy); + free_imatrix(nmbr,1,NI,1,NMON); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xconvlv.c b/lib/nr/ansi/examples/xconvlv.c new file mode 100644 index 0000000..df55adf --- /dev/null +++ b/lib/nr/ansi/examples/xconvlv.c @@ -0,0 +1,54 @@ + +/* Driver for routine convlv */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 16 /* data array size */ +#define M 9 /* response function dimension - must be odd */ +#define N2 (2*N) + +int main(void) +{ + unsigned long i,j; + int isign; + float cmp,*data,*respns,*resp,*ans; + + data=vector(1,N); + respns=vector(1,N); + resp=vector(1,N); + ans=vector(1,N2); + for (i=1;i<=N;i++) + if ((i >= N/2-N/8) && (i <= N/2+N/8)) + data[i]=1.0; + else + data[i]=0.0; + for (i=1;i<=M;i++) { + if ((i > 2) && (i < 7)) + respns[i]=1.0; + else + respns[i]=0.0; + resp[i]=respns[i]; + } + isign=1; + convlv(data,N,resp,M,isign,ans); + /* compare with a direct convolution */ + printf("%3s %14s %13s\n","i","CONVLV","Expected"); + for (i=1;i<=N;i++) { + cmp=0.0; + for (j=1;j<=M/2;j++) { + cmp += data[((i-j-1+N) % N)+1]*respns[j+1]; + cmp += data[((i+j-1) % N)+1]*respns[M-j+1]; + } + cmp += data[i]*respns[1]; + printf("%3ld %15.6f %12.6f\n",i,ans[i],cmp); + } + free_vector(ans,1,N2); + free_vector(resp,1,N); + free_vector(respns,1,N); + free_vector(data,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xcorrel.c b/lib/nr/ansi/examples/xcorrel.c new file mode 100644 index 0000000..1978ba3 --- /dev/null +++ b/lib/nr/ansi/examples/xcorrel.c @@ -0,0 +1,41 @@ + +/* Driver for routine correl */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 64 +#define N2 (2*N) + +int main(void) +{ + unsigned long i,j; + float cmp,*data1,*data2,*ans; + + data1=vector(1,N); + data2=vector(1,N); + ans=vector(1,N2); + for (i=1;i<=N;i++) { + if ((i > N/2-N/8) && (i < N/2+N/8)) + data1[i]=1.0; + else + data1[i]=0.0; + data2[i]=data1[i]; + } + correl(data1,data2,N,ans); + /* Calculate directly */ + printf("%3s %14s %18s\n","n","CORREL","direct calc."); + for (i=0;i<=16;i++) { + cmp=0.0; + for (j=1;j<=N;j++) + cmp += data1[((i+j-1) % N)+1]*data2[j]; + printf("%3ld %15.6f %15.6f\n",i,ans[i+1],cmp); + } + free_vector(ans,1,N2); + free_vector(data2,1,N); + free_vector(data1,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xcosft1.c b/lib/nr/ansi/examples/xcosft1.c new file mode 100644 index 0000000..1f3edaa --- /dev/null +++ b/lib/nr/ansi/examples/xcosft1.c @@ -0,0 +1,61 @@ + +/* Driver for routine cosft1 */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define EPS 1.0e-3 +#define NP 17 +#define WIDTH 30.0 +#define PI 3.1415926 + +int main(void) +{ + int i,j,nlim; + float big,per,scal,small,*data; + + data=vector(1,NP); + for (;;) { + printf("Period of cosine in channels (2-%2d)\n",NP); + scanf("%f",&per); + if (per <= 0.0) break; + for (i=1;i<=NP;i++) + data[i]=cos(2.0*PI*(i-1)/per); + cosft1(data,NP-1); + big = -1.0e10; + small=1.0e10; + for (i=1;i<=NP;i++) { + if (data[i] < small) small=data[i]; + if (data[i] > big) big=data[i]; + } + scal=WIDTH/(big-small); + for (i=1;i<=NP;i++) { + nlim=(int) (0.5+scal*(data[i]-small)+EPS); + printf("%4d %6.2f ",i,data[i]); + for (j=1;j<=nlim+1;j++) printf("*"); + printf("\n"); + } + printf("press RETURN to continue ...\n"); + (void) getchar(); + cosft1(data,NP-1); + big = -1.0e10; + small=1.0e10; + for (i=1;i<=NP;i++) { + if (data[i] < small) small=data[i]; + if (data[i] > big) big=data[i]; + } + scal=WIDTH/(big-small); + for (i=1;i<=NP;i++) { + nlim=(int) (0.5+scal*(data[i]-small)+EPS); + printf("%4d ",i); + for (j=1;j<=nlim+1;j++) printf("*"); + printf("\n"); + } + } + free_vector(data,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xcosft2.c b/lib/nr/ansi/examples/xcosft2.c new file mode 100644 index 0000000..233ac83 --- /dev/null +++ b/lib/nr/ansi/examples/xcosft2.c @@ -0,0 +1,61 @@ + +/* Driver for routine cosft2 */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define EPS 1.0e-3 +#define NP 16 +#define WIDTH 30.0 +#define PI 3.1415926 + +int main(void) +{ + int i,j,nlim; + float big,per,scal,small,*data; + + data=vector(1,NP); + for (;;) { + printf("Period of cosine in channels (2-%2d)\n",NP); + scanf("%f",&per); + if (per <= 0.0) break; + for (i=1;i<=NP;i++) + data[i]=cos(2.0*PI*(i-0.5)/per); + cosft2(data,NP,1); + big = -1.0e10; + small=1.0e10; + for (i=1;i<=NP;i++) { + if (data[i] < small) small=data[i]; + if (data[i] > big) big=data[i]; + } + scal=WIDTH/(big-small); + for (i=1;i<=NP;i++) { + nlim=(int) (0.5+scal*(data[i]-small)+EPS); + printf("%4d %6.2f ",i,data[i]); + for (j=1;j<=nlim+1;j++) printf("*"); + printf("\n"); + } + printf("press RETURN to continue ...\n"); + (void) getchar(); + cosft2(data,NP,-1); + big = -1.0e10; + small=1.0e10; + for (i=1;i<=NP;i++) { + if (data[i] < small) small=data[i]; + if (data[i] > big) big=data[i]; + } + scal=WIDTH/(big-small); + for (i=1;i<=NP;i++) { + nlim=(int) (0.5+scal*(data[i]-small)+EPS); + printf("%4d ",i); + for (j=1;j<=nlim+1;j++) printf("*"); + printf("\n"); + } + } + free_vector(data,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xcovsrt.c b/lib/nr/ansi/examples/xcovsrt.c new file mode 100644 index 0000000..694f796 --- /dev/null +++ b/lib/nr/ansi/examples/xcovsrt.c @@ -0,0 +1,57 @@ + +/* Driver for routine covsrt */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MA 10 +#define MFIT 5 + +int main(void) +{ + int i,j,*ia; + float **covar; + + ia=ivector(1,MA); + covar=matrix(1,MA,1,MA); + for (i=1;i<=MA;i++) + for (j=1;j<=MA;j++) { + covar[i][j]=0.0; + if ((i <= MFIT) && (j <= MFIT)) + covar[i][j]=i+j-1; + } + printf("\noriginal matrix\n"); + for (i=1;i<=MA;i++) { + for (j=1;j<=MA;j++) printf("%4.1f",covar[i][j]); + printf("\n"); + } + printf("press RETURN to continue...\n"); + (void) getchar(); + printf("\nTest #1 - full fitting\n"); + for (i=1;i<=MA;i++) ia[i]=1; + covsrt(covar,MA,ia,MA); + for (i=1;i<=MA;i++) { + for (j=1;j<=MA;j++) printf("%4.1f",covar[i][j]); + printf("\n"); + } + printf("press RETURN to continue...\n"); + (void) getchar(); + printf("\nTest #2 - spread\n"); + for (i=1;i<=MA;i++) + for (j=1;j<=MA;j++) { + covar[i][j]=0.0; + if ((i <= MFIT) && (j <= MFIT)) covar[i][j]=i+j-1; + } + for (i=1;i<=MA;i+=2) ia[i]=0; + covsrt(covar,MA,ia,MFIT); + for (i=1;i<=MA;i++) { + for (j=1;j<=MA;j++) printf("%4.1f",covar[i][j]); + printf("\n"); + } + free_matrix(covar,1,MA,1,MA); + free_ivector(ia,1,MA); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xcrank.c b/lib/nr/ansi/examples/xcrank.c new file mode 100644 index 0000000..f9d6d32 --- /dev/null +++ b/lib/nr/ansi/examples/xcrank.c @@ -0,0 +1,76 @@ + +/* Driver for routine crank */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NDAT 20 +#define NMON 12 +#define MAXSTR 80 + +int main(void) +{ + int i,j; + float *data,*order,*s,**rays; + char dummy[MAXSTR],txt[MAXSTR],city[NDAT+1][17],mon[NMON+1][5]; + FILE *fp; + + data=vector(1,NDAT); + order=vector(1,NDAT); + s=vector(1,NMON); + rays=matrix(1,NDAT,1,NMON); + if ((fp = fopen("table2.dat","r")) == NULL) + nrerror("Data file table2.dat not found\n"); + fgets(dummy,MAXSTR,fp); + fgets(txt,MAXSTR,fp); + fscanf(fp,"%*15c"); + for (i=1;i<=NMON;i++) fscanf(fp," %s",mon[i]); + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + for (i=1;i<=NDAT;i++) { + fscanf(fp,"%[^0123456789]",city[i]); + city[i][16]='\0'; + for (j=1;j<=NMON;j++) fscanf(fp,"%f",&rays[i][j]); + fgets(dummy,MAXSTR,fp); + } + fclose(fp); + printf("%s\n%16s",txt," "); + for (i=1;i<=12;i++) printf(" %s",mon[i]); + printf("\n"); + for (i=1;i<=NDAT;i++) { + printf("%s",city[i]); + for (j=1;j<=12;j++) + printf("%4d",(int) (0.5+rays[i][j])); + printf("\n"); + } + printf(" press return to continue ...\n"); + getchar(); + /* Replace solar flux in each column by rank order */ + for (j=1;j<=12;j++) { + for (i=1;i<=NDAT;i++) { + data[i]=rays[i][j]; + order[i]=i; + } + sort2(NDAT,data,order); + crank(NDAT,data,&s[j]); + for (i=1;i<=NDAT;i++) + rays[(int) (0.5+order[i])][j]=data[i]; + } + printf("%16s"," "); + for (i=1;i<=12;i++) printf(" %s",mon[i]); + printf("\n"); + for (i=1;i<=NDAT;i++) { + printf("%s",city[i]); + for (j=1;j<=12;j++) + printf("%4d",(int) (0.5+rays[i][j])); + printf("\n"); + } + free_matrix(rays,1,NDAT,1,NMON); + free_vector(s,1,NMON); + free_vector(order,1,NDAT); + free_vector(data,1,NDAT); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xcyclic.c b/lib/nr/ansi/examples/xcyclic.c new file mode 100644 index 0000000..511c065 --- /dev/null +++ b/lib/nr/ansi/examples/xcyclic.c @@ -0,0 +1,54 @@ + +/* Driver for routine cyclic */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 20 + +int main(void) +{ + float alpha,beta,d,*a,*b,*c,*r,*x,**aa; + int i,j,*indx; + long idum=(-23); + + indx=ivector(1,N); + a=vector(1,N); + b=vector(1,N); + c=vector(1,N); + r=vector(1,N); + x=vector(1,N); + aa=matrix(1,N,1,N); + for (i=1;i<=N;i++) + for (j=1;j<=N;j++) aa[i][j]=0.0; + for (i=1;i<=N;i++) { + b[i]=ran2(&idum); + aa[i][i]=b[i]; + r[i]=ran2(&idum); + } + for (i=1;i +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Dawson integral",15)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %12s %11s \n","x","actual","dawson(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f",&x,&val); + printf("%6.2f %12.6f %12.6f\n",x,val,dawson(x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xdbrent.c b/lib/nr/ansi/examples/xdbrent.c new file mode 100644 index 0000000..9883a87 --- /dev/null +++ b/lib/nr/ansi/examples/xdbrent.c @@ -0,0 +1,53 @@ + +/* Driver for routine dbrent */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define TOL 1.0e-6 +#define EQL 1.0e-4 + +float dfunc(float x) +{ + return -bessj1(x); +} + +float func(float x) +{ + return bessj0(x); +} + +int main(void) +{ + int i,iflag,j,nmin=0; + float ax,bx,cx,fa,fb,fc,xmin,dbr,amin[21]; + + printf("\nMinima of the function bessj0\n"); + printf("%10s %8s %16s %12s %11s\n", + "min. #","x","bessj0(x)","bessj1(x)","DBRENT"); + for (i=1;i<=100;i++) { + ax=i; + bx=i+1.0; + mnbrak(&ax,&bx,&cx,&fa,&fb,&fc,func); + dbr=dbrent(ax,bx,cx,func,dfunc,TOL,&xmin); + if (nmin == 0) { + amin[1]=xmin; + nmin=1; + printf("%7d %15.6f %12.6f %12.6f %12.6f\n", + nmin,xmin,func(xmin),dfunc(xmin),dbr); + } else { + iflag=0; + for (j=1;j<=nmin;j++) + if (fabs(xmin-amin[j]) <= EQL*xmin) iflag=1; + if (iflag == 0) { + amin[++nmin]=xmin; + printf("%7d %15.6f %12.6f %12.6f %12.6f\n", + nmin,xmin,func(xmin),dfunc(xmin),dbr); + } + } + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xddpoly.c b/lib/nr/ansi/examples/xddpoly.c new file mode 100644 index 0000000..2ae746a --- /dev/null +++ b/lib/nr/ansi/examples/xddpoly.c @@ -0,0 +1,45 @@ + +/* Driver for routine ddpoly */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NC 5 +#define ND NC-1 +#define NP 20 + +int main(void) +{ + int i,j,k; + float x,pwr,*pd,**d; + static float c[NC+1]={-1.0,5.0,-10.0,10.0,-5.0,1.0}; + static char *a[ND+1]={"polynomial:", "first deriv:", + "second deriv:","third deriv:","fourth deriv:"}; + + pd=vector(0,ND); + d=matrix(0,ND,1,NP); + for (i=1;i<=NP;i++) { + x=0.1*i; + ddpoly(c,NC,x,pd,ND); + for (j=0;j<=ND;j++) d[j][i]=pd[j]; + } + for (i=0;i<=ND;i++) { + printf("%6s %s \n"," ",a[i]); + printf("%12s %17s %15s\n","x","DDPOLY","actual"); + for (j=1;j<=NP;j++) { + x=0.1*j; + pwr=1.0; + for (k=1;k<=NC-i;k++) pwr *= x-1.0; + printf("%15.6f %15.6f %15.6f\n",x,d[i][j], + (factrl(NC)/factrl(NC-i))*pwr); + } + printf("press ENTER to continue...\n"); + (void) getchar(); + } + free_matrix(d,0,ND,1,NP); + free_vector(pd,0,ND); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xdecchk.c b/lib/nr/ansi/examples/xdecchk.c new file mode 100644 index 0000000..aabe4ec --- /dev/null +++ b/lib/nr/ansi/examples/xdecchk.c @@ -0,0 +1,59 @@ + +/* Driver for routine decchk */ + +#include +#define NRANSI +#include "nr.h" + +#define MAXLINE 128 + +int main(void) +{ + int j,k,l,n,nbad=0,ntot=0; + int iok,jok; + char lin[MAXLINE+2],ch,chh; + + /* test all jump transpositions of the form 86jlk41 */ + lin[0]='8'; + lin[1]='6'; + lin[5]='4'; + lin[6]='1'; + for (j=48;j<=57;j++) { + for (k=48;k<=57;k++) { + for (l=48;l<=57;l++) { + lin[3]=l; + if (j != k) { + ntot++; + lin[2]=j; + lin[4]=k; + iok=decchk(lin,7,&ch); + lin[7]=ch; + iok=decchk(lin,8,&chh); + lin[2]=k; + lin[4]=j; + jok=decchk(lin,8,&chh); + if (!iok || jok) nbad++; + } + } + } + } + printf("%s %14s %3d\n","Total tries:"," ",ntot); + printf("%s %16s %3d\n","Bad tries:"," ",nbad); + printf("%s %11s %4.2f\n","Fraction good:"," ",((float)(ntot-nbad))/ntot); + for (;;) { + printf("enter string terminated by x:\n"); + if (gets(lin) == NULL) break; + for (j=0;j +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NDIM 3 + +int ncom; /* defining declarations */ +float *pcom,*xicom; +void (*nrdfun)(float [], float []); + +void dfunc(float x[], float df[]) +{ + int i; + + for (i=1;i<=3;i++) df[i]=(x[i]-1.0)*(x[i]-1.0); +} + +int main(void) +{ + ncom=NDIM; + pcom=vector(1,ncom); + xicom=vector(1,ncom); + nrdfun=dfunc; + printf("\nEnter vector direction along which to\n"); + printf("plot the function. Minimum is in the\n"); + printf("direction 1.0 1.0 1.0 - enter x y z:\n\n"); + pcom[1]=pcom[2]=pcom[3]=0.0; + scanf("%f %f %f",&xicom[1],&xicom[2],&xicom[3]); + scrsho(df1dim); + free_vector(xicom,1,ncom); + free_vector(pcom,1,ncom); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xdfpmin.c b/lib/nr/ansi/examples/xdfpmin.c new file mode 100644 index 0000000..9ac5af7 --- /dev/null +++ b/lib/nr/ansi/examples/xdfpmin.c @@ -0,0 +1,55 @@ + +/* Driver for routine dfpmin */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +static int nfunc,ndfunc; + +float func(float x[]) +{ + float x1p2sqr=SQR(2.0+x[1]); + + nfunc++; + return 10.0* + SQR(SQR(x[2])*(3.0-x[1])-SQR(x[1])*(3.0+x[1]))+ + x1p2sqr/(1.0+x1p2sqr); +} + +void dfunc(float x[],float df[]) +{ + float x1sqr=SQR(x[1]),x2sqr=SQR(x[2]),x1p2=x[1]+2.0; + float x1p2sqr=SQR(x1p2); + + ndfunc++; + df[1]=20.0*(x2sqr*(3.0-x[1])-x1sqr*(3.0+x[1]))*(-x2sqr-6.0*x[1]-3.0*x1sqr)+ + 2.0*x1p2/(1.0+x1p2sqr)-2.0*x1p2*x1p2sqr/SQR((1.0+x1p2sqr)); + df[2]=40.0*(x2sqr*(3.0-x[1])-x1sqr*(3.0+x[1]))*x[2]*(3.0-x[1]); +} + +#define NDIM 2 +#define GTOL 1.0e-4 + +int main(void) +{ + int iter; + float *p,fret; + + p=vector(1,NDIM); + printf("True minimum is at (-2.0,+-0.89442719)\n"); + nfunc=ndfunc=0; + p[1]=0.1; + p[2]=4.2; + printf("Starting vector: (%7.4f,%7.4f)\n",p[1],p[2]); + dfpmin(p,NDIM,GTOL,&iter,&fret,func,dfunc); + printf("Iterations: %3d\n",iter); + printf("Func. evals: %3d\n",nfunc); + printf("Deriv. evals: %3d\n",ndfunc); + printf("Solution vector: (%9.6f,%9.6f)\n",p[1],p[2]); + printf("Func. value at solution %14.6g\n",fret); + free_vector(p,1,NDIM); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xdfridr.c b/lib/nr/ansi/examples/xdfridr.c new file mode 100644 index 0000000..1f8df8b --- /dev/null +++ b/lib/nr/ansi/examples/xdfridr.c @@ -0,0 +1,27 @@ + +/* Driver for routine dfridr */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +float func(float x) +{ + return tan(x); +} + +int main(void) +{ + float x,h,dx,err; + + printf("input x, h\n"); + while (scanf("%f %f",&x,&h) != EOF) { + dx=dfridr(func,x,h,&err); + printf("dfridr=%12.6f %12.6f %12.6f\n",dx,1.0/SQR(cos(x)),err); + } + + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xdftint.c b/lib/nr/ansi/examples/xdftint.c new file mode 100644 index 0000000..191f771 --- /dev/null +++ b/lib/nr/ansi/examples/xdftint.c @@ -0,0 +1,52 @@ + +/* Driver for routine dftint */ + +#include +#include +#define NRANSI +#include "nr.h" + +static float c,d; + +float coscxd(float x) +{ + return cos(c*x+d); +} + +#define ci(x) (sin((w-c)*x-d)/(2.0*(w-c))+sin((w+c)*x+d)/(2.0*(w+c))) +#define si(x) (-cos((w-c)*x-d)/(2.0*(w-c))-cos((w+c)*x+d)/(2.0*(w+c))) + +void getans(float w,float a,float b,float *cans,float *sans) +{ + *cans=ci(b)-ci(a); + *sans=si(b)-si(a); +} + +int main(void) +{ + float a,b,cans,cosint,sans,sinint,w; + + printf(" Omega Integral cosine*test func Err"); + printf(" Integral sine*test func Err\n"); + for (;;) { + printf("input c,d:\n"); + if (scanf("%f %f",&c,&d) == EOF) break; + for (;;) { + printf("input a,b:\n"); + if (scanf("%f %f",&a,&b) == EOF) break; + if (a == b) break; + for (;;) { + printf("input w:\n"); + if (scanf("%f",&w) == EOF) break; + if (w < 0.0) break; + dftint(coscxd,a,b,w,&cosint,&sinint); + getans(w,a,b,&cans,&sans); + printf("%15.6e %15.6e %15.6e %15.6e %15.6e\n", + w,cans,cosint-cans,sans,sinint-sans); + } + } + } + printf("normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xdlinmin.c b/lib/nr/ansi/examples/xdlinmin.c new file mode 100644 index 0000000..e32d342 --- /dev/null +++ b/lib/nr/ansi/examples/xdlinmin.c @@ -0,0 +1,55 @@ + +/* Driver for routine dlinmin */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NDIM 3 +#define PIO2 1.5707963 + +float func(float x[]) +{ + int i; + float f=0.0; + + for (i=1;i<=3;i++) f += (x[i]-1.0)*(x[i]-1.0); + return f; +} + +void dfunc(float x[],float df[]) +{ + int i; + + for (i=1;i<=3;i++) df[i]=2.0*(x[i]-1.0); +} + +int main(void) +{ + int i,j; + float fret,sr2,x,*p,*xi; + + p=vector(1,NDIM); + xi=vector(1,NDIM); + printf("\nMinimum of a 3-d quadratic centered\n"); + printf("at (1.0,1.0,1.0). Minimum is found\n"); + printf("along a series of radials.\n\n"); + printf("%9s %12s %12s %14s \n","x","y","z","minimum"); + for (i=0;i<=10;i++) { + x=PIO2*i/10.0; + sr2=sqrt(2.0); + xi[1]=sr2*cos(x); + xi[2]=sr2*sin(x); + xi[3]=1.0; + p[1]=p[2]=p[3]=0.0; + dlinmin(p,xi,NDIM,&fret,func,dfunc); + for (j=1;j<=3;j++) printf("%12.6f ",p[j]); + printf("%12.6f\n",fret); + } + free_vector(xi,1,NDIM); + free_vector(p,1,NDIM); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xeclass.c b/lib/nr/ansi/examples/xeclass.c new file mode 100644 index 0000000..3667781 --- /dev/null +++ b/lib/nr/ansi/examples/xeclass.c @@ -0,0 +1,43 @@ + +/* Driver for routine eclass */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define M 11 +#define N 15 + +int main(void) +{ + int i,j,k,lclas=0,nclass,*nf,*nflag,*nsav; + static int lista[]={0,1,1,5,2,6,2,7,11,3,4,12}, + listb[]={0,5,9,13,6,10,14,3,7,15,8,4}; + + nf=ivector(1,N); + nflag=ivector(1,N); + nsav=ivector(1,N); + eclass(nf,N,lista,listb,M); + for (i=1;i<=N;i++) nflag[i]=1; + printf("\nNumbers from 1-%d divided according to\n",N); + printf("their value modulo 4:\n\n"); + for (i=1;i<=N;i++) { + nclass=nf[i]; + if (nflag[nclass]) { + nflag[nclass]=0; + lclas++; + k=0; + for (j=i;j<=N;j++) + if (nf[j] == nf[i]) nsav[++k]=j; + printf("Class %2d: ",lclas); + for (j=1;j<=k;j++) printf("%3d",nsav[j]); + printf("\n"); + } + } + free_ivector(nsav,1,N); + free_ivector(nflag,1,N); + free_ivector(nf,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xeclazz.c b/lib/nr/ansi/examples/xeclazz.c new file mode 100644 index 0000000..559a152 --- /dev/null +++ b/lib/nr/ansi/examples/xeclazz.c @@ -0,0 +1,45 @@ + +/* Driver for routine eclazz */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 15 + +int equiv(int i,int j) +{ + return (i % 4) == (j % 4); +} + +int main(void) +{ + int i,j,k,lclas=0,nclass,*nf,*nflag,*nsav; + + nf=ivector(1,N); + nflag=ivector(1,N); + nsav=ivector(1,N); + eclazz(nf,N,equiv); + for (i=1;i<=N;i++) nflag[i]=1; + printf("\nNumbers from 1-%d divided according to\n",N); + printf("their value modulo 4:\n"); + for (i=1;i<=N;i++) { + nclass=nf[i]; + if (nflag[nclass]) { + nflag[nclass]=0; + lclas++; + k=0; + for (j=i;j<=N;j++) + if (nf[j] == nf[i]) nsav[++k]=j; + printf("Class %2d: ",lclas); + for (j=1;j<=k;j++) printf("%3d",nsav[j]); + printf("\n"); + } + } + free_ivector(nsav,1,N); + free_ivector(nflag,1,N); + free_ivector(nf,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xei.c b/lib/nr/ansi/examples/xei.c new file mode 100644 index 0000000..c05a23d --- /dev/null +++ b/lib/nr/ansi/examples/xei.c @@ -0,0 +1,37 @@ + +/* Driver for routine ei */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Exponential Integral Ei",23)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %12s %11s \n","x","actual","ei(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f",&x,&val); + printf("%6.2f %12.6f %12.6f\n",x,val,ei(x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xeigsrt.c b/lib/nr/ansi/examples/xeigsrt.c new file mode 100644 index 0000000..5c10059 --- /dev/null +++ b/lib/nr/ansi/examples/xeigsrt.c @@ -0,0 +1,59 @@ + +/* Driver for routine eigsrt */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 10 + +int main(void) +{ + int i,j,nrot; + static float c[NP][NP]= + {5.0,4.3,3.0,2.0,1.0,0.0,-1.0,-2.0,-3.0,-4.0, + 4.3,5.1,4.0,3.0,2.0,1.0,0.0,-1.0,-2.0,-3.0, + 3.0,4.0,5.0,4.0,3.0,2.0,1.0,0.0,-1.0,-2.0, + 2.0,3.0,4.0,5.0,4.0,3.0,2.0,1.0,0.0,-1.0, + 1.0,2.0,3.0,4.0,5.0,4.0,3.0,2.0,1.0,0.0, + 0.0,1.0,2.0,3.0,4.0,5.0,4.0,3.0,2.0,1.0, + -1.0,0.0,1.0,2.0,3.0,4.0,5.0,4.0,3.0,2.0, + -2.0,-1.0,0.0,1.0,2.0,3.0,4.0,5.0,4.0,3.0, + -3.0,-2.0,-1.0,0.0,1.0,2.0,3.0,4.0,5.0,4.0, + -4.0,-3.0,-2.0,-1.0,0.0,1.0,2.0,3.0,4.0,5.0}; + float *d,**v,**e; + + d=vector(1,NP); + v=matrix(1,NP,1,NP); + e=convert_matrix(&c[0][0],1,NP,1,NP); + printf("****** Finding Eigenvectors ******\n"); + jacobi(e,NP,d,v,&nrot); + printf("unsorted eigenvectors:\n"); + for (i=1;i<=NP;i++) { + printf("eigenvalue %3d = %12.6f\n",i,d[i]); + printf("eigenvector:\n"); + for (j=1;j<=NP;j++) { + printf("%12.6f",v[j][i]); + if ((j % 5) == 0) printf("\n"); + } + printf("\n"); + } + printf("\n****** Sorting Eigenvectors ******\n\n"); + eigsrt(d,v,NP); + printf("sorted eigenvectors:\n"); + for (i=1;i<=NP;i++) { + printf("eigenvalue %3d = %12.6f\n",i,d[i]); + printf("eigenvector:\n"); + for (j=1;j<=NP;j++) { + printf("%12.6f",v[j][i]); + if ((j % 5) == 0) printf("\n"); + } + printf("\n"); + } + free_convert_matrix(e,1,NP,1,NP); + free_matrix(v,1,NP,1,NP); + free_vector(d,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xelle.c b/lib/nr/ansi/examples/xelle.c new file mode 100644 index 0000000..b1bd50f --- /dev/null +++ b/lib/nr/ansi/examples/xelle.c @@ -0,0 +1,43 @@ + +/* Driver for routine elle */ + +#include +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +#define FAC (3.1415926535/180.0) + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float ak,alpha,phi,val; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Legendre Elliptic Integral Second Kind",38)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %10s %11s %22s\n","phi","sin(alpha)","actual","elle(phi,ak)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f",&phi,&alpha,&val); + alpha=alpha*FAC; + ak=sin(alpha); + phi=phi*FAC; + printf("%6.2f %6.2f %18.6e %18.6e\n",phi,ak,val,elle(phi,ak)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xellf.c b/lib/nr/ansi/examples/xellf.c new file mode 100644 index 0000000..62dc8b4 --- /dev/null +++ b/lib/nr/ansi/examples/xellf.c @@ -0,0 +1,43 @@ + +/* Driver for routine ellf */ + +#include +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +#define FAC (3.1415926535/180.0) + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float ak,alpha,phi,val; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Legendre Elliptic Integral First Kind",37)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %10s %11s %22s\n","phi","sin(alpha)","actual","ellf(phi,ak)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f",&phi,&alpha,&val); + alpha=alpha*FAC; + ak=sin(alpha); + phi=phi*FAC; + printf("%6.2f %6.2f %18.6e %18.6e\n",phi,ak,val,ellf(phi,ak)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xellpi.c b/lib/nr/ansi/examples/xellpi.c new file mode 100644 index 0000000..5b64084 --- /dev/null +++ b/lib/nr/ansi/examples/xellpi.c @@ -0,0 +1,47 @@ + +/* Driver for routine ellpi */ + +#include +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +#define FAC (3.1415926535/180.0) + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float ak,alpha,en,phi,val; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Legendre Elliptic Integral Third Kind",37)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%6s %6s %6s %10s %23s\n", + "phi","-en","sin(alpha)","actual","ellpi(phi,ak)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f %f",&phi,&en,&alpha,&val); + alpha=alpha*FAC; + ak=sin(alpha); + en = -en; + phi=phi*FAC; + printf("%6.2f %6.2f %6.2f %18.6e %18.6e\n", + phi,en,ak,val,ellpi(phi,en,ak)); + + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xelmhes.c b/lib/nr/ansi/examples/xelmhes.c new file mode 100644 index 0000000..28d8213 --- /dev/null +++ b/lib/nr/ansi/examples/xelmhes.c @@ -0,0 +1,46 @@ + +/* Driver for routine elmhes */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 5 + +int main(void) +{ + int i,j; + static float b[NP][NP]= + {1.0,2.0,300.0,4.0,5.0, + 2.0,3.0,400.0,5.0,6.0, + 3.0,4.0,5.0,6.0,7.0, + 4.0,5.0,600.0,7.0,8.0, + 5.0,6.0,700.0,8.0,9.0}; + float **a; + + a=convert_matrix(&b[0][0],1,NP,1,NP); + printf("***** original matrix *****\n"); + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) printf("%12.2f",a[i][j]); + printf("\n"); + } + printf("***** balance matrix *****\n"); + balanc(a,NP); + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) printf("%12.2f",a[i][j]); + printf("\n"); + } + printf("***** reduce to hessenberg form *****\n"); + elmhes(a,NP); + for (j=1;j<=NP-2;j++) + for (i=j+2;i<=NP;i++) + a[i][j]=0.0; + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) printf("%12.2e",a[i][j]); + printf("\n"); + } + free_convert_matrix(a,1,NP,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xerfcc.c b/lib/nr/ansi/examples/xerfcc.c new file mode 100644 index 0000000..9c313aa --- /dev/null +++ b/lib/nr/ansi/examples/xerfcc.c @@ -0,0 +1,38 @@ + +/* Driver for routine erfcc */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float x,val; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Error Function",14)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\ncomplementary error function\n"); + printf("%5s %12s %13s\n","x","actual","erfcc(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f",&x,&val); + val=1.0-val; + printf("%6.2f %12.7f %12.7f\n",x,val,erfcc(x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xerff.c b/lib/nr/ansi/examples/xerff.c new file mode 100644 index 0000000..b6ba97d --- /dev/null +++ b/lib/nr/ansi/examples/xerff.c @@ -0,0 +1,37 @@ + +/* Driver for routine erff */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Error Function",14)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%4s %12s %12s\n","x","actual","erf(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f",&x,&val); + printf("%6.2f %12.7f %12.7f\n",x,val,erff(x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xerffc.c b/lib/nr/ansi/examples/xerffc.c new file mode 100644 index 0000000..ebfb571 --- /dev/null +++ b/lib/nr/ansi/examples/xerffc.c @@ -0,0 +1,38 @@ + +/* Driver for routine erffc */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float x,val; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Error Function",14)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\ncomplementary error function\n"); + printf("%5s %12s %13s\n","x","actual","erfc(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f",&x,&val); + val=1.0-val; + printf("%6.2f %12.7f %12.7f\n",x,val,erffc(x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xeulsum.c b/lib/nr/ansi/examples/xeulsum.c new file mode 100644 index 0000000..52c3452 --- /dev/null +++ b/lib/nr/ansi/examples/xeulsum.c @@ -0,0 +1,41 @@ + +/* Driver for routine eulsum */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NVAL 40 + +int main(void) +{ + int i,j,mval; + float sum,term,x,xpower,*wksp; + + wksp=vector(1,NVAL); + /* evaluate ln(1+x)=x-x^2/2+x^3/3-x^4/4 ... for -1 NVAL)) break; + printf("%9s %14s %14s\n","x","actual","polynomial"); + for (i = -8;i<=8;i++) { + x=i/10.0; + sum=0.0; + xpower = -1; + for (j=1;j<=mval;j++) { + xpower *= (-x); + term=xpower/j; + eulsum(&sum,term,j,wksp); + } + printf("%12.6f %12.6f %12.6f\n",x,log(1.0+x),sum); + } + } + free_vector(wksp,1,NVAL); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xevlmem.c b/lib/nr/ansi/examples/xevlmem.c new file mode 100644 index 0000000..eb15b7e --- /dev/null +++ b/lib/nr/ansi/examples/xevlmem.c @@ -0,0 +1,35 @@ + +/* Driver for routine evlmem */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 1000 +#define M 10 +#define NFDT 16 + +int main(void) +{ + int i; + float fdt,pm,*cof,*data; + FILE *fp; + + cof=vector(1,M); + data=vector(1,N); + if ((fp = fopen("spctrl.dat","r")) == NULL) + nrerror("Data file spctrl.dat not found\n"); + for (i=1;i<=N;i++) fscanf(fp,"%f",&data[i]); + fclose(fp); + memcof(data,N,M,&pm,cof); + printf("Power spectum estimate of data in spctrl.dat\n"); + printf(" f*delta power\n"); + for (fdt=0.0;fdt<=0.5;fdt+=0.5/NFDT) + printf("%12.6f %12.6f\n",fdt,evlmem(fdt,cof,M,pm)); + free_vector(data,1,N); + free_vector(cof,1,M); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xexpdev.c b/lib/nr/ansi/examples/xexpdev.c new file mode 100644 index 0000000..8255d53 --- /dev/null +++ b/lib/nr/ansi/examples/xexpdev.c @@ -0,0 +1,39 @@ + +/* Driver for routine expdev */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define NPTS 10000 +#define EE 2.718281828 + +int main(void) +{ + long idum=(1); + int i,j,total=0,x[21]; + float expect,xx,y,trig[21]; + + for (i=0;i<=20;i++) { + trig[i]=i/20.0; + x[i]=0; + } + for (i=1;i<=NPTS;i++) { + y=expdev(&idum); + for (j=1;j<=20;j++) + if ((y < trig[j]) && (y > trig[j-1])) ++x[j]; + } + for (i=1;i<=20;i++) total += x[i]; + printf("\nexponential distribution with %7d points\n",NPTS); + printf(" interval observed expected\n\n"); + for (i=1;i<=20;i++) { + xx=(float) x[i]/total; + expect=exp(-(trig[i-1]+trig[i])/2.0); + expect *= (0.05*EE/(EE-1)); + printf("%6.2f %6.2f %12.6f %12.6f \n", + trig[i-1],trig[i],xx,expect); + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xexpint.c b/lib/nr/ansi/examples/xexpint.c new file mode 100644 index 0000000..bc108b1 --- /dev/null +++ b/lib/nr/ansi/examples/xexpint.c @@ -0,0 +1,37 @@ + +/* Driver for routine expint */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval,n; + float val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Exponential Integral En",23)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%4s %7s %15s %21s \n","n","x","actual","expint(n,x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%d %f %f",&n,&x,&val); + printf("%4d %8.2f %18.6e %18.6e\n",n,x,val,expint(n,x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xf1dim.c b/lib/nr/ansi/examples/xf1dim.c new file mode 100644 index 0000000..2795dfb --- /dev/null +++ b/lib/nr/ansi/examples/xf1dim.c @@ -0,0 +1,39 @@ + +/* Driver for routine f1dim */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +float func(float x[]) +{ + int i; + float f=0.0; + + for (i=1;i<=3;i++) f += (x[i]-1.0)*(x[i]-1.0); + return f; +} + +#define NDIM 3 + +int ncom; /* defining declarations */ +float *pcom,*xicom,(*nrfunc)(float []); + +int main(void) +{ + ncom=NDIM; + pcom=vector(1,ncom); + xicom=vector(1,ncom); + nrfunc=func; + pcom[1]=pcom[2]=pcom[3]=0.0; + printf("\nEnter vector direction along which to\n"); + printf("plot the function. Minimum is in the\n"); + printf("direction 1.0 1.0 1.0 - enter x y z:\n"); + scanf(" %f %f %f",&xicom[1],&xicom[2],&xicom[3]); + scrsho(f1dim); + free_vector(xicom,1,ncom); + free_vector(pcom,1,ncom); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfactln.c b/lib/nr/ansi/examples/xfactln.c new file mode 100644 index 0000000..8a89390 --- /dev/null +++ b/lib/nr/ansi/examples/xfactln.c @@ -0,0 +1,38 @@ + +/* Driver for routine factln */ + +#include +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,n,nval; + float val; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"N-factorial",11)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\nlog of n_factorial\n"); + printf("\n%6s %19s %21s\n","n","actual","factln(n)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%d %f",&n,&val); + printf("%6d %20.7f %20.7f\n",n,log(val),factln(n)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfactrl.c b/lib/nr/ansi/examples/xfactrl.c new file mode 100644 index 0000000..f635472 --- /dev/null +++ b/lib/nr/ansi/examples/xfactrl.c @@ -0,0 +1,41 @@ + +/* Driver for routine factrl */ + +#include +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + float actual; + int i,n,nval; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"N-factorial",11)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%6s %18s %20s \n","n","actual","factrl(n)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%d %f ",&n,&actual); + if (actual < 1.0e10) + printf("%6d %20.0f %20.0f\n",n,actual,factrl(n)); + else + printf("%6d %20e %20e \n",n,actual,factrl(n)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfasper.c b/lib/nr/ansi/examples/xfasper.c new file mode 100644 index 0000000..a75b939 --- /dev/null +++ b/lib/nr/ansi/examples/xfasper.c @@ -0,0 +1,44 @@ + +/* Driver for routine fasper */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 90 +#define MP 4096 +#define NPR 11 +#define TWOPI 6.2831853 + +int main(void) +{ + long idum=(-4); + unsigned long j=0,jmax,n,nout; + float prob,*px,*py,*x,*y; + + x=vector(1,NP); + y=vector(1,NP); + px=vector(1,MP); + py=vector(1,MP); + for (n=1;n<=NP+10;n++) { + if (n != 3 && n != 4 && n != 6 && n != 21 && + n != 38 && n != 51 && n != 67 && n != 68 && + n != 83 && n != 93) { + x[++j]=n; + y[j]=0.75*cos(0.6*x[j])+gasdev(&idum); + } + } + fasper(x,y,j,4.0,1.0,px,py,MP,&nout,&jmax,&prob); + printf("fasper results for test signal (cos(0.6x) + noise):\n"); + printf("nout,jmax,prob=%ld %ld %12.6g\n",nout,jmax,prob); + for (n=LMAX(1,jmax-NPR/2);n<=LMIN(nout,jmax+NPR/2);n++) + printf("%ld %12.6f %12.6f\n",n,TWOPI*px[n],py[n]); + free_vector(py,1,MP); + free_vector(px,1,MP); + free_vector(y,1,NP); + free_vector(x,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfgauss.c b/lib/nr/ansi/examples/xfgauss.c new file mode 100644 index 0000000..f3a833f --- /dev/null +++ b/lib/nr/ansi/examples/xfgauss.c @@ -0,0 +1,45 @@ + +/* Driver for routine fgauss */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPT 3 +#define NLIN 2 +#define NA 3*NLIN + +int main(void) +{ + int i,j; + float e1,e2,f,x,y; + static float a[NA+1]={0.0,3.0,0.2,0.5,1.0,0.7,0.3}; + float dyda[NA+1],df[NA+1]; + + printf("\n%6s %8s %8s %7s %7s %7s %7s %7s\n", + "x","y","dyda1","dyda2","dyda3","dyda4","dyda5","dyda6"); + for (i=1;i<=NPT;i++) { + x=0.3*i; + fgauss(x,a,&y,dyda,NA); + e1=exp(-SQR((x-a[2])/a[3])); + e2=exp(-SQR((x-a[5])/a[6])); + f=a[1]*e1+a[4]*e2; + df[1]=e1; + df[4]=e2; + df[2]=a[1]*e1*2.0*(x-a[2])/(a[3]*a[3]); + df[5]=a[4]*e2*2.0*(x-a[5])/(a[6]*a[6]); + df[3]=a[1]*e1*2.0*SQR(x-a[2])/(a[3]*a[3]*a[3]); + df[6]=a[4]*e2*2.0*SQR(x-a[5])/(a[6]*a[6]*a[6]); + printf("from FGAUSS\n"); + printf("%8.4f %8.4f",x,y); + for (j=1;j<=6;j++) printf("%8.4f",dyda[j]); + printf("\nindependent calc.\n"); + printf("%8.4f %8.4f",x,f); + for (j=1;j<=6;j++) printf("%8.4f",df[j]); + printf("\n\n"); + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfit.c b/lib/nr/ansi/examples/xfit.c new file mode 100644 index 0000000..d35d209 --- /dev/null +++ b/lib/nr/ansi/examples/xfit.c @@ -0,0 +1,44 @@ + +/* Driver for routine fit */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPT 100 +#define SPREAD 0.5 + +int main(void) +{ + long idum=(-117); + int i,mwt; + float a,b,chi2,q,siga,sigb,*x,*y,*sig; + + x=vector(1,NPT); + y=vector(1,NPT); + sig=vector(1,NPT); + for (i=1;i<=NPT;i++) { + x[i]=0.1*i; + y[i] = -2.0*x[i]+1.0+SPREAD*gasdev(&idum); + sig[i]=SPREAD; + } + for (mwt=0;mwt<=1;mwt++) { + fit(x,y,NPT,sig,mwt,&a,&b,&siga,&sigb,&chi2,&q); + if (mwt == 0) + printf("\nIgnoring standard deviations\n"); + else + printf("\nIncluding standard deviations\n"); + printf("%12s %9.6f %18s %9.6f \n", + "a = ",a,"uncertainty:",siga); + printf("%12s %9.6f %18s %9.6f \n", + "b = ",b,"uncertainty:",sigb); + printf("%19s %14.6f \n","chi-squared: ",chi2); + printf("%23s %10.6f \n","goodness-of-fit: ",q); + } + free_vector(sig,1,NPT); + free_vector(y,1,NPT); + free_vector(x,1,NPT); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfitexy.c b/lib/nr/ansi/examples/xfitexy.c new file mode 100644 index 0000000..9b381eb --- /dev/null +++ b/lib/nr/ansi/examples/xfitexy.c @@ -0,0 +1,62 @@ + +/* Driver for routine fitexy */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPT 30 + +int main(void) +{ + long idum=(-1); + int j; + float a,b,chi2,q,sa,sb,siga,sigb; + float *x,*y,*dx,*dy,*dz; + + x=vector(1,NPT); + y=vector(1,NPT); + dx=vector(1,NPT); + dy=vector(1,NPT); + dz=vector(1,NPT); + for (j=1;j<=NPT;j++) { + dx[j]=0.1+ran1(&idum); + dy[j]=0.1+ran1(&idum); + dz[j]=0.0; + x[j]=10.0+10.0*gasdev(&idum); + y[j]=2.0*x[j]-5.0+dy[j]*gasdev(&idum); + x[j] += dx[j]*gasdev(&idum); + } + printf("Values of a,b,siga,sigb,chi2,q:\n"); + printf("Fit with x and y errors gives:\n"); + fitexy(x,y,NPT,dx,dy,&a,&b,&siga,&sigb,&chi2,&q); + printf("%11.6f %11.6f %11.6f %11.6f %11.6f %11.6f\n\n", + a,b,siga,sigb,chi2,q); + printf("Setting x errors to zero gives:\n"); + fitexy(x,y,NPT,dz,dy,&a,&b,&siga,&sigb,&chi2,&q); + printf("%11.6f %11.6f %11.6f %11.6f %11.6f %11.6f\n", + a,b,siga,sigb,chi2,q); + printf("...to be compared with fit result:\n"); + fit(x,y,NPT,dy,1,&a,&b,&siga,&sigb,&chi2,&q); + printf("%11.6f %11.6f %11.6f %11.6f %11.6f %11.6f\n\n", + a,b,siga,sigb,chi2,q); + printf("Setting y errors to zero gives:\n"); + fitexy(x,y,NPT,dx,dz,&a,&b,&siga,&sigb,&chi2,&q); + printf("%11.6f %11.6f %11.6f %11.6f %11.6f %11.6f\n", + a,b,siga,sigb,chi2,q); + printf("...to be compared with fit result:\n"); + fit(y,x,NPT,dx,1,&a,&b,&siga,&sigb,&chi2,&q); + sa=sqrt(siga*siga+SQR(sigb*(a/b)))/b; + sb=sigb/(b*b); + printf("%11.6f %11.6f %11.6f %11.6f %11.6f %11.6f\n", + -a/b,1.0/b,sa,sb,chi2,q); + free_vector(dz,1,NPT); + free_vector(dy,1,NPT); + free_vector(dx,1,NPT); + free_vector(y,1,NPT); + free_vector(x,1,NPT); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfixrts.c b/lib/nr/ansi/examples/xfixrts.c new file mode 100644 index 0000000..ed76976 --- /dev/null +++ b/lib/nr/ansi/examples/xfixrts.c @@ -0,0 +1,56 @@ + +/* Driver for routine fixrts */ + +#include +#define NRANSI +#include "nr.h" +#include "complex.h" + +#define NPOLES 6 +#define NP1 (NPOLES+1) +#define ONE Complex(1.0,0.0) +#define TRUE 1 + +int main(void) +{ + int i,polish=TRUE; + static float d[NP1]= + {0.0,6.0,-15.0,20.0,-15.0,6.0,0.0}; + fcomplex zcoef[NP1],zeros[NP1],z1,z2; + + /* finding roots of (z-1.0)^6=1.0 */ + /* first write roots */ + zcoef[NPOLES]=ONE; + for (i=NPOLES-1;i>=0;i--) + zcoef[i] = Complex(-d[NPOLES-i],0.0); + zroots(zcoef,NPOLES,zeros,polish); + printf("Roots of (z-1.0)^6 = 1.0\n"); + printf("%24s %27s \n","Root","(z-1.0)^6"); + for (i=1;i<=NPOLES;i++) { + z1=Csub(zeros[i],ONE); + z2=Cmul(z1,z1); + z1=Cmul(z1,z2); + z1=Cmul(z1,z1); + printf("%6d %12.6f %12.6f %12.6f %12.6f\n", + i,zeros[i].r,zeros[i].i,z1.r,z1.i); + } + /* now fix them to lie within unit circle */ + fixrts(d,NPOLES); + /* check results */ + zcoef[NPOLES]=ONE; + for (i=NPOLES-1;i>=0;i--) + zcoef[i] = Complex(-d[NPOLES-i],0.0); + zroots(zcoef,NPOLES,zeros,polish); + printf("\nRoots reflected in unit circle\n"); + printf("%24s %27s \n","Root","(z-1.0)^6"); + for (i=1;i<=NPOLES;i++) { + z1=Csub(zeros[i],ONE); + z2=Cmul(z1,z1); + z1=Cmul(z1,z2); + z1=Cmul(z1,z1); + printf("%6d %12.6f %12.6f %12.6f %12.6f\n", + i,zeros[i].r,zeros[i].i,z1.r,z1.i); + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfleg.c b/lib/nr/ansi/examples/xfleg.c new file mode 100644 index 0000000..c705aab --- /dev/null +++ b/lib/nr/ansi/examples/xfleg.c @@ -0,0 +1,33 @@ + +/* Driver for routine fleg */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NVAL 5 +#define DX 0.2 +#define NPOLY 5 + +int main(void) +{ + int i,j; + float x,*afunc; + + afunc=vector(1,NPOLY); + printf("\n%3s\n","Legendre polynomials"); + printf("%9s %9s %9s %9s %9s\n","n=1","n=2","n=3","n=4","n=5"); + for (i=1;i<=NVAL;i++) { + x=i*DX; + fleg(x,afunc,NPOLY); + printf("x =%5.2f\n",x); + for (j=1;j<=NPOLY;j++) printf("%10.4f",afunc[j]); + printf(" routine FLEG\n"); + for (j=1;j<=NPOLY;j++) printf("%10.4f",plgndr(j-1,0,x)); + printf(" routine PLGNDR\n\n"); + } + free_vector(afunc,1,NPOLY); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xflmoon.c b/lib/nr/ansi/examples/xflmoon.c new file mode 100644 index 0000000..7c4fed9 --- /dev/null +++ b/lib/nr/ansi/examples/xflmoon.c @@ -0,0 +1,54 @@ + +/* Driver for routine flmoon */ + +#include +#define NRANSI +#include "nr.h" + +#define ZON (-5.0) + +int main(void) +{ + int i,i1,i2,i3,id,im,iy,n,nph=2; + float timzon=ZON/24.0,frac,secs; + long j1,j2; + static char *phase[]={"new moon","first quarter", + "full moon","last quarter"}; + + printf("Date of the next few phases of the moon\n"); + printf("Enter today\'s date (e.g. 12 15 1992) : \n"); + scanf("%d %d %d",&im,&id,&iy); + /* Approximate number of full moons since january 1900 */ + n=(int)(12.37*(iy-1900+((im-0.5)/12.0))); + j1=julday(im,id,iy); + flmoon(n,nph,&j2,&frac); + n += (int) ((j1-j2)/29.53 + (j1 >= j2 ? 0.5 : -0.5)); + printf("\n%10s %19s %9s\n","date","time(EST)","phase"); + for (i=1;i<=20;i++) { + flmoon(n,nph,&j2,&frac); + frac=24.0*(frac+timzon); + if (frac < 0.0) { + --j2; + frac += 24.0; + } + if (frac > 12.0) { + ++j2; + frac -= 12.0; + } else + frac += 12.0; + i1=(int) frac; + secs=3600.0*(frac-i1); + i2=(int) (secs/60.0); + i3=(int) (secs-60*i2+0.5); + caldat(j2,&im,&id,&iy); + printf("%5d %3d %5d %7d:%2d:%2d %s\n", + im,id,iy,i1,i2,i3,phase[nph]); + if (nph == 3) { + nph=0; + ++n; + } else + ++nph; + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfour1.c b/lib/nr/ansi/examples/xfour1.c new file mode 100644 index 0000000..60496fd --- /dev/null +++ b/lib/nr/ansi/examples/xfour1.c @@ -0,0 +1,98 @@ + +/* Driver for routine four1 */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +void prntft(float data[],unsigned long nn) +{ + unsigned long n; + + printf("%4s %13s %13s %12s %13s\n", + "n","real(n)","imag.(n)","real(N-n)","imag.(N-n)"); + printf(" 0 %14.6f %12.6f %12.6f %12.6f\n", + data[1],data[2],data[1],data[2]); + for (n=3;n<=nn+1;n+=2) { + printf("%4lu %14.6f %12.6f %12.6f %12.6f\n", + ((n-1)/2),data[n],data[n+1], + data[2*nn+2-n],data[2*nn+3-n]); + } + printf(" press return to continue ...\n"); + (void) getchar(); + return; +} + +#define NN 32 +#define NN2 (2*NN) + +int main(void) +{ + long i; + int isign; + float *data,*dcmp; + + data=vector(1,NN2); + dcmp=vector(1,NN2); + printf("h(t)=real-valued even-function\n"); + printf("h(n)=h(N-n) and real?\n"); + for (i=1;i +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define SWAP(a,b) {iswap=(a);(a)=(b);(b)=iswap;} +#define FSWAP(a,b) {flswap=(a);(a)=(b);(b)=flswap;} + +#define NX 8 +#define NY 32 +#define NZ 4 +#define NDAT (2*NX*NY*NZ) + +#define TEMPFILE1 "frfstmp1" +#define TEMPFILE2 "frfstmp2" +#define TEMPFILE3 "frfstmp3" +#define TEMPFILE4 "frfstmp4" + +#if defined(MSDOS) || defined(_MSDOS) || defined(_MSDOS_) || defined(__MSDOS__) +#define BINREADWRITE "wb+" +#else +#define BINREADWRITE "w+" +#endif + +char *fnames[4]={TEMPFILE1,TEMPFILE2,TEMPFILE3,TEMPFILE4}; + +int main(void) +{ + int cc,nnv=3,nwrite; + long idum=(-23); + unsigned long dim[4],i,j,k,l,ll,iswap; + float diff,smax,sum,sum1=0.0,sum2=0.0,tot,*data1,*data2,*data1p,*data2p; + FILE *flswap,*file[5]; + + data1=vector(1,NDAT); + data2=vector(1,NDAT); + dim[1]=NX; + dim[2]=NY; + dim[3]=NZ; + tot=(float)NX*(float)NY*(float)NZ; + for (j=1;j<=4;j++) + if ((file[j]=fopen(fnames[j-1],BINREADWRITE)) == NULL) + nrerror("Couldn't open temporary file"); + for (i=1;i<=dim[3];i++) + for (j=1;j<=dim[2];j++) + for (k=1;k<=dim[1];k++) { + l=k+(j-1)*dim[1]+(i-1)*dim[2]*dim[1]; + l=(l<<1)-1; + data2[l]=data1[l]=2*ran1(&idum)-1; + l++; + data2[l]=data1[l]=2*ran1(&idum)-1; + } + nwrite=NDAT >> 1; + cc=fwrite(&data1[1],sizeof(float),nwrite,file[1]); + if (cc != nwrite) nrerror("write error in xfourfs"); + cc=fwrite(&data1[nwrite+1],sizeof(float),nwrite,file[2]); + if (cc != nwrite) nrerror("write error in xfourfs"); + rewind(file[1]); + rewind(file[2]); + printf("**************** now doing fourfs *********\n"); + fourfs(file,dim,nnv,1); + for (j=1;j<=4;j++) rewind(file[j]); + cc=fread(&data1[1],sizeof(float),nwrite,file[3]); + if (cc != nwrite) nrerror("read error in xfourfs"); + cc=fread(&data1[nwrite+1],sizeof(float),nwrite,file[4]); + if (cc != nwrite) nrerror("read error in xfourfs"); + printf("**************** now doing fourn *********\n"); + fourn(data2,dim,nnv,1); + sum=smax=0.0; + for (i=1;i<=dim[3];i++) + for (j=1;j<=dim[2];j++) + for (k=1;k<=dim[1];k++) { + l=k+(j-1)*dim[1]+(i-1)*dim[2]*dim[1]; + l=(l<<1)-1; + ll=i+(j-1)*dim[3]+(k-1)*dim[3]*dim[2]; + ll=(ll<<1)-1; + diff=sqrt(SQR(data2[ll]-data1[l])+SQR(data2[ll+1]-data1[l+1])); + sum2 += SQR(data1[l])+SQR(data1[l+1]); + sum += diff; + if (diff > smax) smax=diff; + } + sum2=sqrt(sum2/tot); + sum=sum/tot; + printf("(r.m.s.) value, (max,ave) discrepancy= %12.7f %12.7f %12.7f\n", + sum2,smax,sum); + /* now check the inverse transforms */ + SWAP(dim[1],dim[3]); + /* This step swap step is conceptually a reversal, but for + three dimensions a swap accomplishes that. */ + FSWAP(file[1],file[3]) + FSWAP(file[4],file[2]) + for (j=1;j<=4;j++) rewind(file[j]); + printf("**************** now doing fourfs *********\n"); + fourfs(file,dim,nnv,-1); + for (j=1;j<=4;j++) rewind(file[j]); + cc=fread(&data1[1],sizeof(float),nwrite,file[3]); + if (cc != nwrite) nrerror("read error in xfourfs"); + cc=fread(&data1[nwrite+1],sizeof(float),nwrite,file[4]); + if (cc != nwrite) nrerror("read error in xfourfs"); + SWAP(dim[1],dim[3]); + printf("**************** now doing fourn *********\n"); + fourn(data2,dim,nnv,-1); + sum=smax=0.0; + data1p=data1; + data2p=data2; + for (j=1;j<=NDAT;j+=2) { + sum1 += SQR(data2p[1])+SQR(data2p[2]); + diff=sqrt(SQR(data2p[1]-data1p[1])+SQR(data2p[2]-data1p[2])); + sum += diff; + if (diff > smax) smax=diff; + data1p += 2; + data2p += 2; + } + sum=sum/tot; + sum1=sqrt(sum1/tot); + printf("(r.m.s.) value, (max,ave) discrepancy= %12.7f %12.7f %12.7f\n", + sum1,smax,sum); + printf("ratio of r.m.s. values, expected ratio= %12.6f %12.6f\n", + sum1/sum2,sqrt(tot)); + for (j=1;j<=4;j++) + if (fclose(file[j]) == EOF) nrerror("Couldn't close temporary file"); + free_vector(data2,1,NDAT); + free_vector(data1,1,NDAT); + for (j=1;j<=4;j++) + if (remove(fnames[j-1])) nrerror("Couldn't delete temporary file"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfourn.c b/lib/nr/ansi/examples/xfourn.c new file mode 100644 index 0000000..f6f916c --- /dev/null +++ b/lib/nr/ansi/examples/xfourn.c @@ -0,0 +1,58 @@ + +/* Driver for routine fourn */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NDIM 3 +#define NDAT2 1024 + +int main(void) +{ + int isign; + long idum=(-23); + unsigned long i,j,k,l,ndum=2,*nn; + float *data1,*data2; + + nn=lvector(1,NDIM); + data1=vector(1,NDAT2); + data2=vector(1,NDAT2); + for (i=1;i<=NDIM;i++) nn[i]=(ndum <<= 1); + for (i=1;i<=nn[3];i++) + for (j=1;j<=nn[2];j++) + for (k=1;k<=nn[1];k++) { + l=k+(j-1)*nn[1]+(i-1)*nn[2]*nn[1]; + l=(l<<1)-1; + /* real part of component */ + data2[l]=data1[l]=2*ran1(&idum)-1; + /* imaginary part of component */ + l++; + data2[l]=data1[l]=2*ran1(&idum)-1; + } + isign=1; + fourn(data2,nn,NDIM,isign); + /* here would be any processing to be done in Fourier space */ + isign = -1; + fourn(data2,nn,NDIM,isign); + printf("Double 3-dimensional transform\n\n"); + printf("%22s %24s %20s\n", + "Double transf.","Original data","Ratio"); + printf("%10s %13s %12s %13s %11s %13s\n\n", + "real","imag.","real","imag.","real","imag."); + for (i=1;i<=4;i++) { + k=2*(j=2*i); + l=k+(j-1)*nn[1]+(i-1)*nn[2]*nn[1]; + l=(l<<1)-1; + printf("%12.2f %12.2f %10.2f %12.2f %14.2f %12.2f\n", + data2[l],data2[l+1],data1[l],data1[l+1], + data2[l]/data1[l],data2[l+1]/data1[l+1]); + } + printf("\nThe product of transform lengths is: %4lu\n",nn[1]*nn[2]*nn[3]); + free_vector(data2,1,NDAT2); + free_vector(data1,1,NDAT2); + free_lvector(nn,1,NDIM); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfpoly.c b/lib/nr/ansi/examples/xfpoly.c new file mode 100644 index 0000000..fd35699 --- /dev/null +++ b/lib/nr/ansi/examples/xfpoly.c @@ -0,0 +1,32 @@ + +/* Driver for routine fpoly */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NVAL 15 +#define DX 0.1 +#define NPOLY 5 + +int main(void) +{ + int i,j; + float x,*afunc; + + afunc=vector(1,NPOLY); + printf("\n%38s\n","powers of x"); + printf("%8s %10s %9s %9s %9s %9s\n", + "x","x**0","x**1","x**2","x**3","x**4"); + for (i=1;i<=NVAL;i++) { + x=i*DX; + fpoly(x,afunc,NPOLY); + printf("%10.4f",x); + for (j=1;j<=NPOLY;j++) printf("%10.4f",afunc[j]); + printf("\n"); + } + free_vector(afunc,1,NPOLY); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfred2.c b/lib/nr/ansi/examples/xfred2.c new file mode 100644 index 0000000..e78d2c4 --- /dev/null +++ b/lib/nr/ansi/examples/xfred2.c @@ -0,0 +1,41 @@ + +/* Driver for routine fred2 */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 8 +#define PI 3.1415927 + +float g(float t) +{ + return sqrt(t)-pow(PI/2.0,2.25)*pow(t,0.75)/2.25; +} + +float ak(float t,float s) +{ + return pow(t*s,0.75); +} + +int main(void) +{ + int i; + float a=0.0,b=PI/2.0,*f; + float *t,*w; + + t=vector(1,N); + f=vector(1,N); + w=vector(1,N); + fred2(N,a,b,t,f,w,g,ak); + /* Compare with exact solution */ + printf("Abscissa, Calc soln, True soln\n"); + for (i=1;i<=N;i++) printf("%10.6f %10.6f %10.6f\n",t[i],f[i],sqrt(t[i])); + free_vector(w,1,N); + free_vector(f,1,N); + free_vector(t,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfredin.c b/lib/nr/ansi/examples/xfredin.c new file mode 100644 index 0000000..e8c30ea --- /dev/null +++ b/lib/nr/ansi/examples/xfredin.c @@ -0,0 +1,44 @@ + +/* Driver for routine fredin */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 8 +#define PI 3.1415927 + +float g(float t) +{ + return sqrt(t)-pow(PI/2.0,2.25)*pow(t,0.75)/2.25; +} + +float ak(float t,float s) +{ + return pow(t*s,0.75); +} + +int main(void) +{ + float a=0.0,ans,b=PI/2.0,x,*f; + float *t,*w; + + t=vector(1,N); + f=vector(1,N); + w=vector(1,N); + fred2(N,a,b,t,f,w,g,ak); + for (;;) { + printf("Enter T between 0 and PI/2\n"); + if (scanf("%f",&x) == EOF) break; + ans=fredin(x,N,a,b,t,f,w,g,ak); + printf("T, Calculated answer, True answer\n"); + printf("%10.6f %10.6f %10.6f\n",x,ans,sqrt(x)); + } + free_vector(w,1,N); + free_vector(f,1,N); + free_vector(t,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfrenel.c b/lib/nr/ansi/examples/xfrenel.c new file mode 100644 index 0000000..5e946de --- /dev/null +++ b/lib/nr/ansi/examples/xfrenel.c @@ -0,0 +1,40 @@ + +/* Driver for routine frenel */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float c,s,x,xc,xs; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Fresnel Integrals",17)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%5s %12s %14s %16s %14s \n", + "x","actual","c(x)","actual","s(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f",&x,&xs,&xc); + frenel(x,&s,&c); + printf("%6.2f %15.6e %15.6e %15.6e %15.6e\n", + x,xs,s,xc,c); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xfrprmn.c b/lib/nr/ansi/examples/xfrprmn.c new file mode 100644 index 0000000..926f5a8 --- /dev/null +++ b/lib/nr/ansi/examples/xfrprmn.c @@ -0,0 +1,51 @@ + +/* Driver for routine frprmn */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NDIM 3 +#define FTOL 1.0e-6 +#define PIO2 1.5707963 + +float func(float x[]) +{ + return 1.0-bessj0(x[1]-0.5)*bessj0(x[2]-0.5)*bessj0(x[3]-0.5); +} + +void dfunc(float x[],float df[]) +{ + df[1]=bessj1(x[1]-0.5)*bessj0(x[2]-0.5)*bessj0(x[3]-0.5); + df[2]=bessj0(x[1]-0.5)*bessj1(x[2]-0.5)*bessj0(x[3]-0.5); + df[3]=bessj0(x[1]-0.5)*bessj0(x[2]-0.5)*bessj1(x[3]-0.5); +} + +int main(void) +{ + int iter,k; + float angl,fret,*p; + + p=vector(1,NDIM); + printf("Program finds the minimum of a function\n"); + printf("with different trial starting vectors.\n"); + printf("True minimum is (0.5,0.5,0.5)\n"); + for (k=0;k<=4;k++) { + angl=PIO2*k/4.0; + p[1]=2.0*cos(angl); + p[2]=2.0*sin(angl); + p[3]=0.0; + printf("\nStarting vector: (%6.4f,%6.4f,%6.4f)\n", + p[1],p[2],p[3]); + frprmn(p,NDIM,FTOL,&iter,&fret,func,dfunc); + printf("Iterations: %3d\n",iter); + printf("Solution vector: (%6.4f,%6.4f,%6.4f)\n", + p[1],p[2],p[3]); + printf("Func. value at solution %14f\n",fret); + } + free_vector(p,1,NDIM); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xftest.c b/lib/nr/ansi/examples/xftest.c new file mode 100644 index 0000000..4e9a01b --- /dev/null +++ b/lib/nr/ansi/examples/xftest.c @@ -0,0 +1,41 @@ + +/* Driver for routine ftest */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPTS 1000 +#define MPTS 500 +#define EPS 0.01 +#define NVAL 11 + +int main(void) +{ + long idum=(-13); + int i,j; + float f,factor,prob,vrnce,*data1,*data2,*data3; + + data1=vector(1,NPTS); + data2=vector(1,MPTS); + data3=vector(1,MPTS); + /* Generate two gaussian distributions with different variances */ + printf("\n%16s %5.2f\n","Variance 1 = ",1.0); + printf("%13s %11s %16s\n","Variance 2","Ratio","Probability"); + for (j=1;j<=NPTS;j++) data1[j]=gasdev(&idum); + for (j=1;j<=MPTS;j++) data2[j]=gasdev(&idum); + for (i=1;i<=NVAL;i++) { + vrnce=1.0+(i-1)*EPS; + factor=sqrt(vrnce); + for (j=1;j<=MPTS;j++) data3[j]=factor*data2[j]; + ftest(data1,NPTS,data3,MPTS,&f,&prob); + printf("%11.4f %13.4f %13.4f\n",vrnce,f,prob); + } + free_vector(data3,1,MPTS); + free_vector(data2,1,MPTS); + free_vector(data1,1,NPTS); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xgamdev.c b/lib/nr/ansi/examples/xgamdev.c new file mode 100644 index 0000000..c965f72 --- /dev/null +++ b/lib/nr/ansi/examples/xgamdev.c @@ -0,0 +1,47 @@ + +/* Driver for routine gamdev */ + +#include +#define NRANSI +#include "nr.h" + +#define N 20 +#define NPTS 10000 +#define ISCAL 200 +#define LLEN 50 + +int main(void) +{ + char words[LLEN+1]; + long idum=(-13); + int i,ia,j,k,klim,dist[N+1]; + float dd; + + for (;;) { + for (j=0;j<=N;j++) dist[j]=0; + do { + printf("Select order of Gamma distribution (n=1..%d), -1 to end\n",N); + scanf("%d",&ia); + } while (ia > N); + if (ia < 0) break; + for (i=1;i<=NPTS;i++) { + j=(int) gamdev(ia,&idum); + if ((j >= 0) && (j <= N)) ++dist[j]; + } + printf("\ngamma-distribution deviate, order %2d of %6d points\n", + ia,NPTS); + printf("%6s %7s %9s \n","x","p(x)","graph:"); + for (j=0;j LLEN) klim=LLEN; + for (k=1;k<=klim;k++) words[k]='*'; + printf("%6d %8.4f ",j,dd); + for (k=1;k<=klim;k++) printf("%c",words[k]); + printf("\n"); + } + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xgammln.c b/lib/nr/ansi/examples/xgammln.c new file mode 100644 index 0000000..5f7da6b --- /dev/null +++ b/lib/nr/ansi/examples/xgammln.c @@ -0,0 +1,42 @@ + +/* Driver for routine gammln */ + +#include +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float actual,calc,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Gamma Function",14)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%10s %21s %21s\n","x","actual","gammln(x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f",&x,&actual); + if (x > 0.0) { + calc=(x<1.0 ? gammln(x+1.0)-log(x) : gammln(x)); + printf("%12.2f %20.6f %20.6f\n",x, + log(actual),calc); + } + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xgammp.c b/lib/nr/ansi/examples/xgammp.c new file mode 100644 index 0000000..9eabda0 --- /dev/null +++ b/lib/nr/ansi/examples/xgammp.c @@ -0,0 +1,37 @@ + +/* Driver for routine gammp */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float a,val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Incomplete Gamma Function",25)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%4s %11s %14s %14s \n","a","x","actual","gammp(a,x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f",&a,&x,&val); + printf("%6.2f %12.6f %12.6f %12.6f \n",a,x,val,gammp(a,x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xgammq.c b/lib/nr/ansi/examples/xgammq.c new file mode 100644 index 0000000..8c5b092 --- /dev/null +++ b/lib/nr/ansi/examples/xgammq.c @@ -0,0 +1,37 @@ + +/* Driver for routine gammq */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float a,val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Incomplete Gamma Function",25)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%4s %11s %14s %14s \n","a","x","actual","gammq(a,x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f",&a,&x,&val); + printf("%6.2f %12.6f %12.6f %12.6f\n",a,x,(1.0-val),gammq(a,x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xgasdev.c b/lib/nr/ansi/examples/xgasdev.c new file mode 100644 index 0000000..de78805 --- /dev/null +++ b/lib/nr/ansi/examples/xgasdev.c @@ -0,0 +1,41 @@ + +/* Driver for routine gasdev */ + +#include +#define NRANSI +#include "nr.h" + +#define N 20 +#define NOVER2 (N/2) +#define NPTS 10000 +#define ISCAL 400 +#define LLEN 50 + +int main(void) +{ + char words[LLEN+1]; + int i,j,k,klim,dist[N+1]; + long idum=(-13); + float dd,x; + + for (j=0;j<=N;j++) dist[j]=0; + for (i=1;i<=NPTS;i++) { + x=0.25*N*gasdev(&idum); + j=(int)(x > 0 ? x+0.5 : x-0.5); + if ((j >= -NOVER2) && (j <= NOVER2)) ++dist[j+NOVER2]; + } + printf("Normally distributed deviate of %6d points\n",NPTS); + printf ("%5s %10s %9s\n","x","p(x)","graph:"); + for (j=0;j<=N;j++) { + dd=(float) dist[j]/NPTS; + for (k=1;k<=LLEN;k++) words[k]=' '; + klim=(int) (ISCAL*dd); + if (klim > LLEN) klim=LLEN; + for (k=1;k<=klim;k++) words[k]='*'; + printf("%8.4f %8.4f ",j/(0.25*N),dd); + for (k=1;k<=LLEN;k++) printf("%c",words[k]); + printf("\n"); + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xgaucof.c b/lib/nr/ansi/examples/xgaucof.c new file mode 100644 index 0000000..18badc6 --- /dev/null +++ b/lib/nr/ansi/examples/xgaucof.c @@ -0,0 +1,44 @@ + +/* Driver for routine gaucof */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 64 +#define SQRTPI 1.7724539 + +int main(void) +{ + /* Test with Gauss-Hermite */ + int i,n; + float amu0,check,*a,*b,*x,*w; + + a=vector(1,NP); + b=vector(1,NP); + x=vector(1,NP); + w=vector(1,NP); + for (;;) { + printf("Enter N:\n"); + if (scanf("%d",&n) == EOF) break; + for (i=1;i +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 64 +#define SQRTPI 1.7724539 + +float func(float x) +{ + return cos(x); +} + +int main(void) +{ + int i,n; + float check,xx,*x,*w; + + x=vector(1,NP); + w=vector(1,NP); + for (;;) { + printf("Enter N\n"); + if (scanf("%d",&n) == EOF) break; + gauher(x,w,n); + printf("%3s %10s %14s\n","#","x(i)","w(i)"); + for (i=1;i<=n;i++) printf("%3d %14.6e %14.6e\n",i,x[i],w[i]); + for (check=0.0,i=1;i<=n;i++) check += w[i]; + printf("\nCheck value: %15.7e should be: %15.7e\n",check,SQRTPI); + /* demonstrate the use of GAUHER for an integral */ + for (xx=0.0,i=1;i<=n;i++) xx += w[i]*func(x[i]); + printf("\nIntegral from gauher: %12.6f\n",xx); + printf("Actual value: %12.6f\n",SQRTPI*exp(-0.25)); + } + free_vector(w,1,NP); + free_vector(x,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xgaujac.c b/lib/nr/ansi/examples/xgaujac.c new file mode 100644 index 0000000..cd16d9d --- /dev/null +++ b/lib/nr/ansi/examples/xgaujac.c @@ -0,0 +1,51 @@ + +/* Driver for routine gaujac */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 64 +#define PIBY2 1.5707963 + +float func(float ak,float x) +{ + return 1.0/sqrt(1.0-ak*ak*(1.0+x)/2.0); +} + +int main(void) +{ + int i,n; + float ak,alf=(-0.5),bet=(-0.5),checkw,checkx,xx,*x,*w; + + x=vector(1,NP); + w=vector(1,NP); + for (;;) { + printf("Enter N\n"); + if (scanf("%d",&n) == EOF) break; + gaujac(x,w,n,alf,bet); + printf("%3s %10s %14s\n","#","x(i)","w(i)"); + for (i=1;i<=n;i++) printf("%3d %14.6e %14.6e\n",i,x[i],w[i]); + checkx=checkw=0.0; + for (i=1;i<=n;i++) { + checkx += x[i]; + checkw += w[i]; + } + printf("\nCheck value: %15.7e should be: %15.7e\n", + checkx,n*(bet-alf)/(alf+bet+2*n)); + printf("\nCheck value: %15.7e should be: %15.7e\n", + checkw,exp(gammln(1.0+alf)+gammln(1.0+bet)- + gammln(2.0+alf+bet))*pow(2.0,alf+bet+1.0)); + /* demonstrate the use of GAUJAC for an integral */ + ak=0.5; + for (xx=0.0,i=1;i<=n;i++) xx += w[i]*func(ak,x[i]); + printf("\nIntegral from gaujac: %12.6f\n",xx); + printf("Actual value: %12.6f\n",2.0*ellf(PIBY2,ak)); + } + free_vector(w,1,NP); + free_vector(x,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xgaulag.c b/lib/nr/ansi/examples/xgaulag.c new file mode 100644 index 0000000..0adcc25 --- /dev/null +++ b/lib/nr/ansi/examples/xgaulag.c @@ -0,0 +1,47 @@ + +/* Driver for routine gaulag */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 64 + +float func(float x) +{ + return bessj0(x); +} + +int main(void) +{ + int i,n; + float alf=1.0,checkw,checkx,xx,*x,*w; + + x=vector(1,NP); + w=vector(1,NP); + for (;;) { + printf("Enter N\n"); + if (scanf("%d",&n) == EOF) break; + gaulag(x,w,n,alf); + printf("%3s %10s %14s\n","#","x(i)","w(i)"); + for (i=1;i<=n;i++) printf("%3d %14.6e %14.6e\n",i,x[i],w[i]); + checkx=checkw=0.0; + for (i=1;i<=n;i++) { + checkx += x[i]; + checkw += w[i]; + } + printf("\nCheck value: %15.7e should be: %15.7e\n",checkx,n*(n+alf)); + printf("\nCheck value: %15.7e should be: %15.7e\n",checkw, + exp(gammln(1.0+alf))); + /* demonstrate the use of GAULAG for an integral */ + for (xx=0.0,i=1;i<=n;i++) xx += w[i]*func(x[i]); + printf("\nIntegral from gaulag: %12.6f\n",xx); + printf("Actual value: %12.6f\n",1.0/(2.0*sqrt(2.0))); + } + free_vector(w,1,NP); + free_vector(x,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xgauleg.c b/lib/nr/ansi/examples/xgauleg.c new file mode 100644 index 0000000..d397da2 --- /dev/null +++ b/lib/nr/ansi/examples/xgauleg.c @@ -0,0 +1,43 @@ + +/* Driver for routine gauleg */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPOINT 10 +#define X1 0.0 +#define X2 1.0 +#define X3 10.0 + +float func(float x) +{ + return x*exp(-x); +} + +int main(void) +{ + int i; + float xx=0.0; + float *x,*w; + + x=vector(1,NPOINT); + w=vector(1,NPOINT); + gauleg(X1,X2,x,w,NPOINT); + printf("\n%2s %10s %12s\n","#","x[i]","w[i]"); + for (i=1;i<=NPOINT;i++) + printf("%2d %12.6f %12.6f\n",i,x[i],w[i]); + /* Demonstrate the use of gauleg for integration */ + gauleg(X1,X3,x,w,NPOINT); + for (i=1;i<=NPOINT;i++) + xx += (w[i]*func(x[i])); + printf("\nIntegral from GAULEG: %12.6f\n",xx); + printf("Actual value: %12.6f\n", + (1.0+X1)*exp(-X1)-(1.0+X3)*exp(-X3)); + free_vector(w,1,NPOINT); + free_vector(x,1,NPOINT); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xgaussj.c b/lib/nr/ansi/examples/xgaussj.c new file mode 100644 index 0000000..54120ba --- /dev/null +++ b/lib/nr/ansi/examples/xgaussj.c @@ -0,0 +1,88 @@ + +/* Driver for routine gaussj */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 20 +#define MP 20 +#define MAXSTR 80 + +int main(void) +{ + int j,k,l,m,n; + float **a,**ai,**u,**b,**x,**t; + char dummy[MAXSTR]; + FILE *fp; + + a=matrix(1,NP,1,NP); + ai=matrix(1,NP,1,NP); + u=matrix(1,NP,1,NP); + b=matrix(1,NP,1,MP); + x=matrix(1,NP,1,MP); + t=matrix(1,NP,1,MP); + if ((fp = fopen("matrx1.dat","r")) == NULL) + nrerror("Data file matrx1.dat not found\n"); + while (!feof(fp)) { + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + fscanf(fp,"%d %d ",&n,&m); + fgets(dummy,MAXSTR,fp); + for (k=1;k<=n;k++) + for (l=1;l<=n;l++) fscanf(fp,"%f ",&a[k][l]); + fgets(dummy,MAXSTR,fp); + for (l=1;l<=m;l++) + for (k=1;k<=n;k++) fscanf(fp,"%f ",&b[k][l]); + /* save matrices for later testing of results */ + for (l=1;l<=n;l++) { + for (k=1;k<=n;k++) ai[k][l]=a[k][l]; + for (k=1;k<=m;k++) x[l][k]=b[l][k]; + } + /* invert matrix */ + gaussj(ai,n,x,m); + printf("\nInverse of matrix a : \n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",ai[k][l]); + printf("\n"); + } + /* check inverse */ + printf("\na times a-inverse:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) { + u[k][l]=0.0; + for (j=1;j<=n;j++) + u[k][l] += (a[k][j]*ai[j][l]); + } + for (l=1;l<=n;l++) printf("%12.6f",u[k][l]); + printf("\n"); + } + /* check vector solutions */ + printf("\nCheck the following for equality:\n"); + printf("%21s %14s\n","original","matrix*sol'n"); + for (l=1;l<=m;l++) { + printf("vector %2d: \n",l); + for (k=1;k<=n;k++) { + t[k][l]=0.0; + for (j=1;j<=n;j++) + t[k][l] += (a[k][j]*x[j][l]); + printf("%8s %12.6f %12.6f\n"," ", + b[k][l],t[k][l]); + } + } + printf("***********************************\n"); + printf("press RETURN for next problem:\n"); + (void) getchar(); + } + fclose(fp); + free_matrix(t,1,NP,1,MP); + free_matrix(x,1,NP,1,MP); + free_matrix(b,1,NP,1,MP); + free_matrix(u,1,NP,1,NP); + free_matrix(ai,1,NP,1,NP); + free_matrix(a,1,NP,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xgcf.c b/lib/nr/ansi/examples/xgcf.c new file mode 100644 index 0000000..ae5033c --- /dev/null +++ b/lib/nr/ansi/examples/xgcf.c @@ -0,0 +1,42 @@ + +/* Driver for routine gcf */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float a,val,x,gammcf,gln; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Incomplete Gamma Function",25)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%4s %11s %14s %13s %13s %8s\n","a","x", + "actual","gcf(a,x)","gammln(a)","gln"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f",&a,&x,&val); + if (x >= (a+1.0)) { + gcf(&gammcf,a,x,&gln); + printf("%6.2f%13.6f%13.6f%13.6f%12.6f%13.6f\n", + a,x,(1.0-val),gammcf,gammln(a),gln); + } + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xgolden.c b/lib/nr/ansi/examples/xgolden.c new file mode 100644 index 0000000..b5720a5 --- /dev/null +++ b/lib/nr/ansi/examples/xgolden.c @@ -0,0 +1,47 @@ + +/* Driver for routine golden */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define TOL 1.0e-6 +#define EQL 1.0e-3 + +float func(float x) +{ + return bessj0(x); +} + +int main(void) +{ + int i,iflag,j,nmin=0; + float ax,bx,cx,fa,fb,fc,xmin,gold,amin[21]; + + printf("Minima of the function bessj0\n"); + printf("%10s %8s %17s %12s\n","min. #","x","bessj0(x)","bessj1(x)"); + for (i=1;i<=100;i++) { + ax=i; + bx=i+1.0; + mnbrak(&ax,&bx,&cx,&fa,&fb,&fc,func); + gold=golden(ax,bx,cx,func,TOL,&xmin); + if (nmin == 0) { + amin[1]=xmin; + nmin=1; + printf("%7d %15.6f %12.6f %12.6f\n", + nmin,xmin,bessj0(xmin),bessj1(xmin)); + } else { + iflag=0; + for (j=1;j<=nmin;j++) + if (fabs(xmin-amin[j]) <= EQL*xmin) iflag=1; + if (iflag == 0) { + amin[++nmin]=xmin; + printf("%7d %15.6f %12.6f %12.6f\n", + nmin,xmin,bessj0(xmin),bessj1(xmin)); + } + } + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xgser.c b/lib/nr/ansi/examples/xgser.c new file mode 100644 index 0000000..36c4f6f --- /dev/null +++ b/lib/nr/ansi/examples/xgser.c @@ -0,0 +1,40 @@ + +/* Driver for routine gser */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float a,gamser,gln,val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Incomplete Gamma Function",25)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%4s %11s %14s %14s %12s %8s\n","a","x", + "actual","gser(a,x)","gammln(a)","gln"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f",&a,&x,&val); + gser(&gamser,a,x,&gln); + printf("%6.2f %12.6f %12.6f %12.6f %12.6f %12.6f\n", + a,x,val,gamser,gammln(a),gln); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xhpsel.c b/lib/nr/ansi/examples/xhpsel.c new file mode 100644 index 0000000..a47af39 --- /dev/null +++ b/lib/nr/ansi/examples/xhpsel.c @@ -0,0 +1,41 @@ + +/* Driver for routine hpsel */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 +#define NP 100 + +int main(void) +{ + char txt[MAXSTR]; + unsigned long i,k; + float *a,*heap,check; + FILE *fp; + + a=vector(1,NP); + heap=vector(1,NP); + if ((fp = fopen("tarray.dat","r")) == NULL) + nrerror("Data file tarray.dat not found\n"); + fgets(txt,MAXSTR,fp); + for (i=1;i<=NP;i++) fscanf(fp,"%f",&a[i]); + fclose(fp); + for (;;) { + printf("Input k\n"); + if (scanf("%lu",&k) == EOF) break; + hpsel(k,NP,a,heap); + check=select(NP+1-k,NP,a); + printf("heap[1], check= %6.2f %6.2f\n",heap[1],check); + printf("heap of numbers of size %lu\n",k); + for (i=1;i<=k;i++) printf("%lu %6.2f\n",i,heap[i]); + } + free_vector(heap,1,NP); + free_vector(a,1,NP); + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xhpsort.c b/lib/nr/ansi/examples/xhpsort.c new file mode 100644 index 0000000..6348dd6 --- /dev/null +++ b/lib/nr/ansi/examples/xhpsort.c @@ -0,0 +1,40 @@ + +/* Driver for routine hpsort */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 +#define NP 100 + +int main(void) +{ + char txt[MAXSTR]; + int i,j; + float *a; + FILE *fp; + + a=vector(1,NP); + if ((fp = fopen("tarray.dat","r")) == NULL) + nrerror("Data file tarray.dat not found\n"); + fgets(txt,MAXSTR,fp); + for (i=1;i<=NP;i++) fscanf(fp,"%f",&a[i]); + fclose(fp); + printf("\noriginal array:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + hpsort(NP,a); + printf("\nsorted array:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + free_vector(a,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xhqr.c b/lib/nr/ansi/examples/xhqr.c new file mode 100644 index 0000000..2d751a4 --- /dev/null +++ b/lib/nr/ansi/examples/xhqr.c @@ -0,0 +1,41 @@ + +/* Driver for routine hqr */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 5 + +int main(void) +{ + int i,j; + static float c[NP][NP]= + {1.0,2.0,0.0,0.0,0.0, + -2.0,3.0,0.0,0.0,0.0, + 3.0,4.0,50.0,0.0,0.0, + -4.0,5.0,-60.0,7.0,0.0, + -5.0,6.0,-70.0,8.0,-9.0}; + float *wr,*wi,**a; + + wr=vector(1,NP); + wi=vector(1,NP); + a=convert_matrix(&c[0][0],1,NP,1,NP); + printf("matrix:\n"); + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) printf("%12.2f",a[i][j]); + printf("\n"); + } + balanc(a,NP); + elmhes(a,NP); + hqr(a,NP,wr,wi); + printf("eigenvalues:\n"); + printf("%11s %16s \n","real","imag."); + for (i=1;i<=NP;i++) printf("%15f %14f\n",wr[i],wi[i]); + free_convert_matrix(a,1,NP,1,NP); + free_vector(wi,1,NP); + free_vector(wr,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xhuffman.c b/lib/nr/ansi/examples/xhuffman.c new file mode 100644 index 0000000..2b7c055 --- /dev/null +++ b/lib/nr/ansi/examples/xhuffman.c @@ -0,0 +1,82 @@ + +/* Driver for routines hufmak, hufenc, hufdec */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MC 512 +#define MQ (2*MC-1) + +#define MAXLINE 256 + +int main(void) +{ + int k; + unsigned long i,j,ilong,n,nb,nh,nlong,nt,lcode=MAXLINE,nch,nfreq[257]; + unsigned char *code,mess[MAXLINE],ness[MAXLINE]; + huffcode hcode; + FILE *fp; + + code=cvector(0,MAXLINE); + hcode.icod=lvector(1,MQ); + hcode.ncod=lvector(1,MQ); + hcode.left=lvector(1,MQ); + hcode.right=lvector(1,MQ); + for (j=1;j<=MQ;j++) hcode.icod[j]=hcode.ncod[j]=0; + /* construct a letter frequency table from the file text.dat */ + if ((fp = fopen("text.dat","r")) == NULL) + nrerror("Input file text.dat not found.\n"); + for (j=1;j<=256;j++) nfreq[j]=0; + while ((k=getc(fp)) != EOF) { + if ((k -= 31) >= 1) nfreq[k]++; + } + fclose(fp); + nch=96; + /* here is the initialization that constructs the code */ + hufmak(nfreq,nch,&ilong,&nlong,&hcode); + printf("ind char nfreq ncod icod\n"); + for (j=1;j<=nch;j++) + if (nfreq[j]) printf("%3lu %c %6lu %6lu %6lu\n", + j,(char)(j+31),nfreq[j],hcode.ncod[j],hcode.icod[j]); + for (;;) { + /* now ready to prompt for lines to encode */ + printf("Enter a line:\n"); + if (gets((char *)&mess[1]) == NULL) break; + n=strlen((char *)&mess[1]); + /* shift from 256 character alphabet to 96 printing characters */ + for (j=1;j<=n;j++) mess[j] -= 32; + /* here we Huffman encode mess[1..n] */ + nb=0; + for (j=1;j<=n;j++) hufenc((unsigned long)mess[j],&code,&lcode,&nb,&hcode); + nh=(nb>>3)+1; + /* message termination (encode a single long character) */ + hufenc(ilong,&code,&lcode,&nb,&hcode); + /* here we decode the message, hopefully to get the original back */ + nb=0; + for (j=1;j<=MAXLINE;j++) { + hufdec(&i,code,nh,&nb,&hcode); + if (i == nch) break; + else ness[j]=(unsigned char)i; + } + if (j > lcode) nrerror("Huffman coding: Never get here"); + nt=j-1; + printf("Length of line input,coded= %lu %lu\n",n,nh); + printf("Decoded output:\n"); + for (j=1;j<=nt;j++) printf("%c",(char)(ness[j]+32)); + printf("\n"); + if (nt != n) printf("Error! : n decoded != n input\n"); + if (nt-n == 1) printf("May be harmless spurious character.\n"); + } + free_cvector(code,0,MAXLINE); + free_lvector(hcode.right,1,MQ); + free_lvector(hcode.left,1,MQ); + free_lvector(hcode.ncod,1,MQ); + free_lvector(hcode.icod,1,MQ); + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xhunt.c b/lib/nr/ansi/examples/xhunt.c new file mode 100644 index 0000000..8eb9172 --- /dev/null +++ b/lib/nr/ansi/examples/xhunt.c @@ -0,0 +1,45 @@ + +/* Driver for routine hunt */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 100 + +int main(void) +{ + unsigned long i,j,ji; + float x,*xx; + + xx=vector(1,N); + /* create array to be searched */ + for (i=1;i<=N;i++) + xx[i]=exp(i/20.0)-74.0; + printf("\n result of: j=0 indicates x too small\n"); + printf("%14s j=100 indicates x too large"," "); + printf("\n%12s %8s %4s %11s %13s \n", + "locate:","guess","j","xx(j)","xx(j+1)"); + /* do test */ + for (i=1;i<=19;i++) { + x = -100.0+10.0*i; + /* trial parameter */ + j=(ji=5*i); + /* begin search */ + hunt(xx,N,x,&j); + if ((j < N) && (j > 0)) + printf("%12.5f %6lu %6lu %12.6f %12.6f \n", + x,ji,j,xx[j],xx[j+1]); + else if (j == N) + printf("%12.5f %6lu %6lu %12.6f %s \n", + x,ji,j,xx[j]," upper lim"); + else + printf("%12.5f %6lu %6lu %s %12.6f \n", + x,ji,j," lower lim",xx[j+1]); + } + free_vector(xx,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xhypgeo.c b/lib/nr/ansi/examples/xhypgeo.c new file mode 100644 index 0000000..4c379bb --- /dev/null +++ b/lib/nr/ansi/examples/xhypgeo.c @@ -0,0 +1,44 @@ + +/* Driver for routine hypgeo */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" +#include "complex.h" + +fcomplex Clog(fcomplex a) +{ + fcomplex b; + + b.r=log(Cabs(a)); + b.i=atan2(a.i,a.r); + return b; +} + +int main(void) +{ + fcomplex a,b,c,z,zi,q1,q2,q3,q4; + float x,y; + + a=Complex(0.5,0.0); + b=Complex(1.0,0.0); + c=Complex(1.5,0.0); + for (;;) { + printf("INPUT X,Y OF COMPLEX ARGUMENT:\n"); + if (scanf("%f %f",&x,&y) == EOF) break; + z=Complex(x,y); + q1=hypgeo(a,b,c,Cmul(z,z)); + q2=RCmul(0.5,Cdiv(Clog(Cdiv(Cadd(b,z),Csub(b,z))),z)); + q3=hypgeo(a,b,c,RCmul(-1.0,Cmul(z,z))); + zi=Complex(-y,x); + q4=RCmul(0.5,Cdiv(Clog(Cdiv(Cadd(b,zi),Csub(b,zi))),zi)); + printf("2F1(0.5,1.0,1.5;z^2) =%12.6f %12.6f\n",q1.r,q1.i); + printf("check using log form: %12.6f %12.6f\n",q2.r,q2.i); + printf("2F1(0.5,1.0,1.5;-z^2)=%12.6f %12.6f\n",q3.r,q3.i); + printf("check using log form: %12.6f %12.6f\n",q4.r,q4.i); + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xicrc.c b/lib/nr/ansi/examples/xicrc.c new file mode 100644 index 0000000..94fff1f --- /dev/null +++ b/lib/nr/ansi/examples/xicrc.c @@ -0,0 +1,41 @@ + +/* Driver for routine icrc */ + +#include +#define NRANSI +#include "nr.h" + +#define LOBYTE(x) ((unsigned char)((x) & 0xFF)) +#define HIBYTE(x) ((unsigned char)((x) >> 8)) + +int main(void) +{ + unsigned char lin[256]; + unsigned short i1,i2; + unsigned long n; + + for (;;) { + printf("Enter length and string: \n"); + if (scanf("%lu %s",&n,&lin[1]) == EOF) break; + lin[n+1]=0; + printf("%s\n",&lin[1]); + i1=icrc(0,lin,n,(short)0,1); + lin[n+1]=HIBYTE(i1); + lin[n+2]=LOBYTE(i1); + i2=icrc(i1,lin,n+2,(short)0,1); + printf(" XMODEM: String CRC, Packet CRC= 0x%x 0x%x\n",i1,i2); + i1=icrc(i2,lin,n,(short)0xff,-1); + lin[n+1] = ~LOBYTE(i1); + lin[n+2] = ~HIBYTE(i1); + i2=icrc(i1,lin,n+2,(short)0xff,-1); + printf(" X.25: String CRC, Packet CRC= 0x%x 0x%x\n",i1,i2); + i1=icrc(i2,lin,n,(short)0,-1); + lin[n+1]=LOBYTE(i1); + lin[n+2]=HIBYTE(i1); + i2=icrc(i1,lin,n+2,(short)0,-1); + printf(" CRC-CCITT: String CRC, Packet CRC= 0x%x 0x%x\n",i1,i2); + } + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xigray.c b/lib/nr/ansi/examples/xigray.c new file mode 100644 index 0000000..3950208 --- /dev/null +++ b/lib/nr/ansi/examples/xigray.c @@ -0,0 +1,31 @@ + +/* Driver for routine igray */ + +#include +#define NRANSI +#include "nr.h" + +int main(void) +{ + unsigned long jp,n,ng,nmax,nmin,nni,nxor; + + for (;;) { + printf("input nmin,nmax: \n"); + if (scanf("%lu %lu",&nmin,&nmax) == EOF) break; + jp=(nmax-nmin)/11; + if (jp < 1) jp=1; + printf("n, Gray[n], Gray(Gray[n]), Gray[n] ^ Gray[n+1]\n"); + for (n=nmin;n<=nmax;n++) { + ng=igray(n,1); + nni=igray(ng,-1); + if (nni != n) printf("WRONG ! AT %d %d %d\n",n,ng,nni); + if (!((n-nmin) % jp)) { + nxor=ng ^ igray(n+1,1); + printf("%lu %lu %lu %lu\n",n,ng,nni,nxor); + } + } + } + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xindexx.c b/lib/nr/ansi/examples/xindexx.c new file mode 100644 index 0000000..1c1e720 --- /dev/null +++ b/lib/nr/ansi/examples/xindexx.c @@ -0,0 +1,42 @@ + +/* Driver for routine indexx */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 100 +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + unsigned long i,j,*indx; + float *a; + FILE *fp; + + indx=lvector(1,NP); + a=vector(1,NP); + if ((fp = fopen("tarray.dat","r")) == NULL) + nrerror("Data file tarray.dat not found\n"); + fgets(txt,MAXSTR,fp); + for (i=1;i<=NP;i++) fscanf(fp,"%f",&a[i]); + fclose(fp); + indexx(NP,a,indx); + printf("\noriginal array:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + printf("\nsorted array:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[indx[10*i+j]]); + printf("\n"); + } + free_vector(a,1,NP); + free_lvector(indx,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xirbit1.c b/lib/nr/ansi/examples/xirbit1.c new file mode 100644 index 0000000..b56fc63 --- /dev/null +++ b/lib/nr/ansi/examples/xirbit1.c @@ -0,0 +1,41 @@ + +/* Driver for routine irbit1 */ + +#include +#define NRANSI +#include "nr.h" + +#define NBIN 15 +#define NTRIES 10000 + +int main(void) +{ + int i,iflg,ipts=0,j,n; + unsigned long iseed=12345; + float twoinv,delay[NBIN+1]; + + /* Calculate distribution of runs of zeros */ + for (i=1;i<=NBIN;i++) delay[i]=0.0; + printf("distribution of runs of n zeros\n"); + printf("%6s %22s %18s\n","n","probability","expected"); + for (i=1;i<=NTRIES;i++) { + if (irbit1(&iseed) == 1) { + ++ipts; + iflg=0; + for (j=1;j<=NBIN;j++) { + if ((irbit1(&iseed) == 1) && (iflg == 0)) { + iflg=1; + ++delay[j]; + } + } + } + } + twoinv=0.5; + for (n=1;n<=NBIN;n++) { + printf("%6d %19.4f %20.4f\n", + (n-1),delay[n]/ipts,twoinv); + twoinv /= 2.0; + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xirbit2.c b/lib/nr/ansi/examples/xirbit2.c new file mode 100644 index 0000000..d026cc9 --- /dev/null +++ b/lib/nr/ansi/examples/xirbit2.c @@ -0,0 +1,41 @@ + +/* Driver for routine irbit2 */ + +#include +#define NRANSI +#include "nr.h" + +#define NBIN 15 +#define NTRIES 10000 + +static unsigned long twoton[16]={0x1L,0x2L,0x4L,0x8L,0x10L,0x20L,0x40L,0x80L, + 0x100L,0x200L,0x400L,0x800L,0x1000L,0x2000L,0x4000L,0x8000L}; + +int main(void) +{ + int i,iflg,ipts=0,j,n; + unsigned long iseed=111; + float delay[NBIN+1]; + + /* Calculate distribution of runs of zeros */ + for (i=1;i<=NBIN;i++) delay[i]=0.0; + for (i=1;i<=NTRIES;i++) { + if (irbit2(&iseed) == 1) { + ++ipts; + iflg=0; + for (j=1;j<=NBIN;j++) { + if ((irbit2(&iseed) == 1) && (iflg == 0)) { + iflg=1; + ++delay[j]; + } + } + } + } + printf("distribution of runs of n zeros\n"); + printf("%6s %22s %18s \n","n","probability","expected"); + for (n=1;n<=NBIN;n++) + printf("%6d %19.4f %20.4f\n", + (n-1),delay[n]/ipts,1.0/(double)twoton[n]); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xjacobi.c b/lib/nr/ansi/examples/xjacobi.c new file mode 100644 index 0000000..f1ab1b6 --- /dev/null +++ b/lib/nr/ansi/examples/xjacobi.c @@ -0,0 +1,95 @@ + +/* Driver for routine jacobi */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 10 +#define NMAT 3 + +int main(void) +{ + int i,j,k,kk,l,ll,nrot; + static float a[3][3]= + {1.0,2.0,3.0, + 2.0,2.0,3.0, + 3.0,3.0,3.0}; + static float b[5][5]= + {-2.0,-1.0,0.0,1.0,2.0, + -1.0,-1.0,0.0,1.0,2.0, + 0.0,0.0,0.0,1.0,2.0, + 1.0,1.0,1.0,1.0,2.0, + 2.0,2.0,2.0,2.0,2.0}; + static float c[NP][NP]= + {5.0,4.3,3.0,2.0,1.0,0.0,-1.0,-2.0,-3.0,-4.0, + 4.3,5.1,4.0,3.0,2.0,1.0,0.0,-1.0,-2.0,-3.0, + 3.0,4.0,5.0,4.0,3.0,2.0,1.0,0.0,-1.0,-2.0, + 2.0,3.0,4.0,5.0,4.0,3.0,2.0,1.0,0.0,-1.0, + 1.0,2.0,3.0,4.0,5.0,4.0,3.0,2.0,1.0,0.0, + 0.0,1.0,2.0,3.0,4.0,5.0,4.0,3.0,2.0,1.0, + -1.0,0.0,1.0,2.0,3.0,4.0,5.0,4.0,3.0,2.0, + -2.0,-1.0,0.0,1.0,2.0,3.0,4.0,5.0,4.0,3.0, + -3.0,-2.0,-1.0,0.0,1.0,2.0,3.0,4.0,5.0,4.0, + -4.0,-3.0,-2.0,-1.0,0.0,1.0,2.0,3.0,4.0,5.0}; + float *d,*r,**v,**e; + static int num[4]={0,3,5,10}; + + d=vector(1,NP); + r=vector(1,NP); + v=matrix(1,NP,1,NP); + for (i=1;i<=NMAT;i++) { + if (i == 1) e=convert_matrix(&a[0][0],1,num[i],1,num[i]); + else if (i == 2) e=convert_matrix(&b[0][0],1,num[i],1,num[i]); + else if (i == 3) e=convert_matrix(&c[0][0],1,num[i],1,num[i]); + jacobi(e,num[i],d,v,&nrot); + printf("matrix number %2d\n",i); + printf("number of JACOBI rotations: %3d\n",nrot); + printf("eigenvalues: \n"); + for (j=1;j<=num[i];j++) { + printf("%12.6f",d[j]); + if ((j % 5) == 0) printf("\n"); + } + printf("\neigenvectors:\n"); + for (j=1;j<=num[i];j++) { + printf("%9s %3d \n","number",j); + for (k=1;k<=num[i];k++) { + printf("%12.6f",v[k][j]); + if ((k % 5) == 0) printf("\n"); + } + printf("\n"); + } + /* eigenvector test */ + printf("eigenvector test\n"); + for (j=1;j<=num[i];j++) { + for (l=1;l<=num[i];l++) { + r[l]=0.0; + for (k=1;k<=num[i];k++) { + if (k > l) { + kk=l; + ll=k; + } else { + kk=k; + ll=l; + } + r[l] += (e[ll][kk]*v[k][j]); + } + } + printf("vector number %3d\n",j); + printf("%11s %14s %10s\n", + "vector","mtrx*vec.","ratio"); + for (l=1;l<=num[i];l++) + printf("%12.6f %12.6f %12.6f\n", + v[l][j],r[l],r[l]/v[l][j]); + } + printf("press RETURN to continue...\n"); + (void) getchar(); + free_convert_matrix(e,1,num[i],1,num[i]); + } + free_matrix(v,1,NP,1,NP); + free_vector(r,1,NP); + free_vector(d,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xjulday.c b/lib/nr/ansi/examples/xjulday.c new file mode 100644 index 0000000..91b5798 --- /dev/null +++ b/lib/nr/ansi/examples/xjulday.c @@ -0,0 +1,44 @@ + +/* Driver for routine julday */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + int i,id,im,iy,n; + char txt[MAXSTR]; + static char *name[]={"","january","february","march", + "april","may","june","july","august","september", + "october","november","december"}; + FILE *fp; + + if ((fp = fopen("dates1.dat","r")) == NULL) + nrerror("Data file dates1.dat not found\n"); + fgets(txt,MAXSTR,fp); + fscanf(fp,"%d %*s ",&n); + printf("\n%5s %8s %6s %12s %9s\n","month","day","year", + "julian day","event"); + for (i=1;i<=n;i++) { + fscanf(fp,"%d %d %d ",&im,&id,&iy); + fgets(txt,MAXSTR,fp); + printf("%-10s %3d %6d %10ld %5s %s",name[im],id,iy, + julday(im,id,iy)," ",txt); + } + fclose(fp); + printf("\nYour choices: (negative to end)\n"); + printf("month day year (e.g. 1 13 1905)\n"); + for (i=1;i<=20;i++) { + printf("\nmm dd yyyy ?\n"); + scanf("%d %d %d",&im,&id,&iy); + if (im < 0) return 0; + printf("julian day: %ld \n",julday(im,id,iy)); + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xkendl1.c b/lib/nr/ansi/examples/xkendl1.c new file mode 100644 index 0000000..217ab81 --- /dev/null +++ b/lib/nr/ansi/examples/xkendl1.c @@ -0,0 +1,51 @@ + +/* Driver for routine kendl1 */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NDAT 200 + +int main(void) +{ + int i,j; + long idum; + float prob,tau,z,*data1,*data2; + static char *txt[5]={"RAN0","RAN1","RAN2","RAN3","RAN4"}; + + data1=vector(1,NDAT); + data2=vector(1,NDAT); + /* Look for correlations in RAN0, RAN1, RAN2, RAN3 and RAN4 */ + printf("\nPair correlations of RAN0 ... RAN4\n\n"); + printf("%9s %17s %16s %18s\n", + "Program","Kendall tau","Std. Dev.","Probability"); + for (i=1;i<=5;i++) { + idum=(-1357); + for (j=1;j<=NDAT;j++) { + if (i == 1) { + data1[j]=ran0(&idum); + data2[j]=ran0(&idum); + } else if (i == 2) { + data1[j]=ran1(&idum); + data2[j]=ran1(&idum); + } else if (i == 3) { + data1[j]=ran2(&idum); + data2[j]=ran2(&idum); + } else if (i == 4) { + data1[j]=ran3(&idum); + data2[j]=ran3(&idum); + } else if (i == 5) { + data1[j]=ran4(&idum); + data2[j]=ran4(&idum); + } + } + kendl1(data1,data2,NDAT,&tau,&z,&prob); + printf("%8s %17.6f %17.6f %17.6f\n",txt[i-1],tau,z,prob); + } + free_vector(data2,1,NDAT); + free_vector(data1,1,NDAT); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xkendl2.c b/lib/nr/ansi/examples/xkendl2.c new file mode 100644 index 0000000..2ee66e8 --- /dev/null +++ b/lib/nr/ansi/examples/xkendl2.c @@ -0,0 +1,70 @@ + +/* Driver for routine kendl2 */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NDAT 1000 +#define IP 8 +#define JP 8 + +int main(void) +{ + int ifunc,i=IP,j=JP,k,l,m,n,twoton; + unsigned long iseed; + float prob,tau,z,**tab; + static char *txt[8]= + {"000","001","010","011","100","101","110","111"}; + + /* Look for 'ones-after-zeros' in IRBIT1 and IRBIT2 sequences */ + tab=matrix(1,IP,1,JP); + printf("Are ones followed by zeros and vice-versa?\n"); + for (ifunc=1;ifunc<=2;ifunc++) { + iseed=2468; + if (ifunc == 1) + printf("test of irbit1:\n"); + else + printf("test of irbit2:\n"); + for (k=1;k<=i;k++) + for (l=1;l<=j;l++) tab[k][l]=0.0; + for (m=1;m<=NDAT;m++) { + k=1; + twoton=1; + for (n=0;n<=2;n++) { + if (ifunc == 1) + k += (irbit1(&iseed)*twoton); + else + k += (irbit2(&iseed)*twoton); + twoton *= 2; + } + l=1; + twoton=1; + for (n=0;n<=2;n++) { + if (ifunc == 1) + l += (irbit1(&iseed)*twoton); + else + l += (irbit2(&iseed)*twoton); + twoton *= 2; + } + ++tab[k][l]; + } + kendl2(tab,i,j,&tau,&z,&prob); + printf(" "); + for (n=0;n<=7;n++) printf("%6s",txt[n]); + printf("\n"); + for (n=1;n<=8;n++) { + printf("%3s",txt[n-1]); + for (m=1;m<=8;m++) + printf("%6d",(int) (0.5+tab[n][m])); + printf("\n"); + } + printf("\n%17s %14s %16s\n", + "kendall tau","std. dev.","probability"); + printf("%15.6f %15.6f %15.6f\n\n",tau,z,prob); + } + free_matrix(tab,1,IP,1,JP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xks2d1s.c b/lib/nr/ansi/examples/xks2d1s.c new file mode 100644 index 0000000..352828b --- /dev/null +++ b/lib/nr/ansi/examples/xks2d1s.c @@ -0,0 +1,64 @@ + +/* Driver for routine ks2d1s */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NMAX 1000 + +int main(void) +{ + long idum; + unsigned long j,jtrial,n1,ntrial; + float d,factor,prob,u,v,*x1,*y1; + + x1=vector(1,NMAX); + y1=vector(1,NMAX); + for (;;) { + printf("How many points?\n"); + if (scanf("%lu",&n1) == EOF) break; + if (n1 > NMAX) { + printf("n1 too large.\n"); + continue; + } + printf("What factor nonlinearity (0 to 1)?\n"); + for (;;) { + if (scanf("%f",&factor) == EOF) { + factor = -1.0; + break; + } + if (factor < 0.0) { + printf("factor less than 0\n"); + continue; + } + if (factor > 1.0) { + printf("factor greater than 1\n"); + continue; + } + break; + } + if (factor == -1.0) break; + printf("How many trials?\n"); + if (scanf("%lu",&ntrial) == EOF) break; + idum = -289-ntrial-n1; + for (jtrial=1;jtrial<=ntrial;jtrial++) { + for (j=1;j<=n1;j++) { + u=ran1(&idum); + u=u*((1.0-factor)+u*factor); + x1[j]=2.0*u-1.0; + v=ran1(&idum); + v=v*((1.0-factor)+v*factor); + y1[j]=2.0*v-1.0; + } + ks2d1s(x1,y1,n1,quadvl,&d,&prob); + printf("d, prob= %12.6f %12.6f\n",d,prob); + } + } + free_vector(y1,1,NMAX); + free_vector(x1,1,NMAX); + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xks2d2s.c b/lib/nr/ansi/examples/xks2d2s.c new file mode 100644 index 0000000..f697533 --- /dev/null +++ b/lib/nr/ansi/examples/xks2d2s.c @@ -0,0 +1,66 @@ + +/* Driver for routine ks2d2s */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NMAX 1000 + +int main(void) +{ + long idum; + unsigned long j,jtrial,n1,n2,ntrial; + float d,prob,shrink,u,v; + float *x1,*y1,*x2,*y2; + + x1=vector(1,NMAX); + y1=vector(1,NMAX); + x2=vector(1,NMAX); + y2=vector(1,NMAX); + for (;;) { + printf("Input N1,N2\n"); + if (scanf("%lu %lu",&n1,&n2) == EOF) break; + if (n1 > NMAX) { + printf("n1 too large.\n"); + continue; + } + if (n2 > NMAX) { + printf("n2 too large.\n"); + continue; + } + printf("What shrinkage?\n"); + if (scanf("%f",&shrink) == EOF) break; + printf("How many trials?\n"); + if (scanf("%lu",&ntrial) == EOF) break; + if (ntrial > NMAX) { + printf("Too many trials.\n"); + continue; + } + idum = -287-ntrial-n1-n2; + for (jtrial=1;jtrial<=ntrial;jtrial++) { + for (j=1;j<=n1;j++) { + u=gasdev(&idum); + v=gasdev(&idum)*shrink; + x1[j]=u+v; + y1[j]=u-v; + } + for (j=1;j<=n2;j++) { + u=gasdev(&idum)*shrink; + v=gasdev(&idum); + x2[j]=u+v; + y2[j]=u-v; + } + ks2d2s(x1,y1,n1,x2,y2,n2,&d,&prob); + printf("d, prob= %12.6f %12.6f\n",d,prob); + } + } + free_vector(y2,1,NMAX); + free_vector(x2,1,NMAX); + free_vector(y1,1,NMAX); + free_vector(x1,1,NMAX); + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xksone.c b/lib/nr/ansi/examples/xksone.c new file mode 100644 index 0000000..654c7c8 --- /dev/null +++ b/lib/nr/ansi/examples/xksone.c @@ -0,0 +1,38 @@ + +/* Driver for routine ksone */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPTS 1000 +#define EPS 0.1 + +float func(float x) +{ + return 1.0 - erfcc(x/sqrt(2.0)); +} + +int main(void) +{ + long idum=(-5); + int i,j; + float d,factr,prob,varnce,*data; + + data=vector(1,NPTS); + printf("%19s %16s %15s\n\n", + "variance ratio","k-s statistic","probability"); + for (i=1;i<=11;i++) { + varnce=1.0+(i-1)*EPS; + factr=sqrt(varnce); + for (j=1;j<=NPTS;j++) + data[j]=factr*fabs(gasdev(&idum)); + ksone(data,NPTS,func,&d,&prob); + printf("%16.6f %16.6f %16.6f \n",varnce,d,prob); + } + free_vector(data,1,NPTS); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xkstwo.c b/lib/nr/ansi/examples/xkstwo.c new file mode 100644 index 0000000..6d35deb --- /dev/null +++ b/lib/nr/ansi/examples/xkstwo.c @@ -0,0 +1,37 @@ + +/* Driver for routine kstwo */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N1 2000 +#define N2 1000 +#define EPS 0.1 + +int main(void) +{ + long idum=(-1357); + int i,j; + float d,factr,prob,varnce,*data1,*data2; + + data1=vector(1,N1); + data2=vector(1,N2); + for (i=1;i<=N1;i++) data1[i]=gasdev(&idum); + printf("%18s %15s %14s\n", + "variance ratio","k-s statistic","probability"); + for (i=1;i<=11;i++) { + varnce=1.0+(i-1)*EPS; + factr=sqrt(varnce); + for (j=1;j<=N2;j++) + data2[j]=factr*gasdev(&idum); + kstwo(data1,N1,data2,N2,&d,&prob); + printf("%15.6f %15.6f %15.6f\n",varnce,d,prob); + } + free_vector(data2,1,N2); + free_vector(data1,1,N1); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xlaguer.c b/lib/nr/ansi/examples/xlaguer.c new file mode 100644 index 0000000..9bfbc55 --- /dev/null +++ b/lib/nr/ansi/examples/xlaguer.c @@ -0,0 +1,47 @@ + +/* Driver for routine laguer */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "complex.h" + +#define M 4 /* degree of polynomial */ +#define MP1 (M+1) /* no. of polynomial coefficients */ +#define NTRY 21 +#define NTRY1 NTRY+1 +#define EPS 1.e-6 + +int main(void) +{ + fcomplex y[NTRY1],x; + static fcomplex a[MP1]={{0.0,2.0}, + {0.0,0.0}, + {-1.0,-2.0}, + {0.0,0.0}, + {1.0,0.0} }; + int i,iflag,its,j,n=0; + + printf("\nRoots of polynomial x^4-(1+2i)*x^2+2i\n"); + printf("\n%15s %15s %7s\n","Real","Complex","#iter"); + for (i=1;i<=NTRY;i++) { + x=Complex((i-11.0)/10.0,(i-11.0)/10.0); + laguer(a,M,&x,&its); + if (n == 0) { + n=1; + y[1]=x; + printf("%5d %12.6f %12.6f %5d\n",n,x.r,x.i,its); + } else { + iflag=0; + for (j=1;j<=n;j++) + if (Cabs(Csub(x,y[j])) <= EPS*Cabs(x)) iflag=1; + if (iflag == 0) { + y[++n]=x; + printf("%5d %12.6f %12.6f %5d\n",n,x.r,x.i,its); + } + } + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xlfit.c b/lib/nr/ansi/examples/xlfit.c new file mode 100644 index 0000000..5d4e30f --- /dev/null +++ b/lib/nr/ansi/examples/xlfit.c @@ -0,0 +1,80 @@ + +/* Driver for routine lfit */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPT 100 +#define SPREAD 0.1 +#define NTERM 5 + +void funcs(float x,float afunc[],int ma) +{ + int i; + + afunc[1]=1.0; + afunc[2]=x; + for (i=3;i<=ma;i++) afunc[i]=sin(i*x); +} + +int main(void) +{ + long idum=(-911); + int i,j,*ia; + float chisq,*a,*x,*y,*sig,**covar; + + ia=ivector(1,NTERM); + a=vector(1,NTERM); + x=vector(1,NPT); + y=vector(1,NPT); + sig=vector(1,NPT); + covar=matrix(1,NTERM,1,NTERM); + + for (i=1;i<=NPT;i++) { + x[i]=0.1*i; + funcs(x[i],a,NTERM); + y[i]=0.0; + for (j=1;j<=NTERM;j++) y[i] += j*a[j]; + y[i] += SPREAD*gasdev(&idum); + sig[i]=SPREAD; + } + for (i=1;i<=NTERM;i++) ia[i]=1; + lfit(x,y,sig,NPT,a,ia,NTERM,covar,&chisq,funcs); + printf("\n%11s %21s\n","parameter","uncertainty"); + for (i=1;i<=NTERM;i++) + printf(" a[%1d] = %8.6f %12.6f\n", + i,a[i],sqrt(covar[i][i])); + printf("chi-squared = %12f\n",chisq); + printf("full covariance matrix\n"); + for (i=1;i<=NTERM;i++) { + for (j=1;j<=NTERM;j++) printf("%12f",covar[i][j]); + printf("\n"); + } + printf("\npress RETURN to continue...\n"); + (void) getchar(); + /* Now check results of restricting fit parameters */ + for (i=2;i<=NTERM;i+=2) ia[i]=0; + lfit(x,y,sig,NPT,a,ia,NTERM,covar,&chisq,funcs); + printf("\n%11s %21s\n","parameter","uncertainty"); + for (i=1;i<=NTERM;i++) + printf(" a[%1d] = %8.6f %12.6f\n", + i,a[i],sqrt(covar[i][i])); + printf("chi-squared = %12f\n",chisq); + printf("full covariance matrix\n"); + for (i=1;i<=NTERM;i++) { + for (j=1;j<=NTERM;j++) printf("%12f",covar[i][j]); + printf("\n"); + } + printf("\n"); + free_matrix(covar,1,NTERM,1,NTERM); + free_vector(sig,1,NPT); + free_vector(y,1,NPT); + free_vector(x,1,NPT); + free_vector(a,1,NTERM); + free_ivector(ia,1,NTERM); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xlinbcg.c b/lib/nr/ansi/examples/xlinbcg.c new file mode 100644 index 0000000..2b0aadd --- /dev/null +++ b/lib/nr/ansi/examples/xlinbcg.c @@ -0,0 +1,65 @@ + +/* Driver for routine linbcg */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NSIZE 59 +#define NP 20 +#define ITOL 1 +#define TOL 1e-9 +#define ITMAX 75 + +unsigned long ija[NSIZE+1] ={ + 0,22,23,25,27,29,31,33,35,37,39,41,43,45,47,49,51,53,55,57, + 59,60,2,1,3,2,4,3,5,4,6,5,7,6,8,7,9,8,10,9,11,10,12,11,13,12, + 14,13,15,14,16,15,17,16,18,17,19,18,20,19}; + +double sa[NSIZE+1] ={ + 0.0,3.0,3.0,3.0,3.0,3.0,3.0,3.0,3.0,3.0,3.0,3.0,3.0,3.0,3.0,3.0,3.0, + 3.0,3.0,3.0,3.0,0.0,2.0,-2.0,2.0,-2.0,2.0,-2.0,2.0,-2.0,2.0,-2.0, + 2.0,-2.0,2.0,-2.0,2.0,-2.0,2.0,-2.0,2.0,-2.0,2.0,-2.0,2.0,-2.0,2.0, + -2.0,2.0,-2.0,2.0,-2.0,2.0,-2.0,2.0,-2.0,2.0,-2.0,2.0,-2.0}; + +int main(void) +{ + int i,ii,iter; + double *b,*bcmp,*x,err; + + b=dvector(1,NP); + bcmp=dvector(1,NP); + x=dvector(1,NP); + for (i=1;i<=NP;i++) { + x[i]=0.0; + b[i]=1.0; + } + b[1]=3.0; + b[NP] = -1.0; + linbcg(NP,b,x,ITOL,TOL,ITMAX,&iter,&err); + printf("%s %15e\n","Estimated error:",err); + printf("%s %6d\n","Iterations needed:",iter); + printf("\nSolution vector:\n"); + for (ii=1;ii<=NP/5;ii++) { + for (i=5*(ii-1)+1;i<=5*ii;i++) printf("%12.6f",x[i]); + printf("\n"); + } + for (i=1;i<=(NP % 5);i++) + printf("%12.6f",x[5*(NP/5)+i]); + printf("\n"); + dsprsax(sa,ija,x,bcmp,NP); + /* this is a double precision version of sprsax */ + printf("\npress RETURN to continue...\n"); + (void) getchar(); + printf("test of solution vector:\n"); + printf("%9s %12s\n","a*x","b"); + for (i=1;i<=NP;i++) + printf("%12.6f %12.6f\n",bcmp[i],b[i]); + free_dvector(x,1,NP); + free_dvector(bcmp,1,NP); + free_dvector(b,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xlinmin.c b/lib/nr/ansi/examples/xlinmin.c new file mode 100644 index 0000000..bc36244 --- /dev/null +++ b/lib/nr/ansi/examples/xlinmin.c @@ -0,0 +1,48 @@ + +/* Driver for routine linmin */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NDIM 3 +#define PIO2 1.5707963 + +float func(float x[]) +{ + int i; + float f=0.0; + + for (i=1;i<=3;i++) f += (x[i]-1.0)*(x[i]-1.0); + return f; +} + +int main(void) +{ + int i,j; + float fret,sr2,x,*p,*xi; + + p=vector(1,NDIM); + xi=vector(1,NDIM); + printf("\nMinimum of a 3-d quadratic centered\n"); + printf("at (1.0,1.0,1.0). Minimum is found\n"); + printf("along a series of radials.\n\n"); + printf("%9s %12s %12s %14s \n","x","y","z","minimum"); + for (i=0;i<=10;i++) { + x=PIO2*i/10.0; + sr2=sqrt(2.0); + xi[1]=sr2*cos(x); + xi[2]=sr2*sin(x); + xi[3]=1.0; + p[1]=p[2]=p[3]=0.0; + linmin(p,xi,NDIM,&fret,func); + for (j=1;j<=3;j++) printf("%12.6f ",p[j]); + printf("%12.6f\n",fret); + } + free_vector(xi,1,NDIM); + free_vector(p,1,NDIM); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xlocate.c b/lib/nr/ansi/examples/xlocate.c new file mode 100644 index 0000000..5525677 --- /dev/null +++ b/lib/nr/ansi/examples/xlocate.c @@ -0,0 +1,41 @@ + +/* Driver for routine locate */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 100 + +int main(void) +{ + unsigned long i,j; + float x,*xx; + + xx=vector(1,N); + /* create array to be searched */ + for (i=1;i<=N;i++) + xx[i]=exp(i/20.0)-74.0; + printf("\nresult of: j=0 indicates x too small\n"); + printf("%11s j=100 indicates x too large"," "); + printf("\n%10s %6s %11s %12s \n","locate ","j","xx(j)","xx(j+1)"); + /* perform test */ + for (i=1;i<=19;i++) { + x = -100.0+200.0*i/20.0; + locate(xx,N,x,&j); + if ((j < N) && (j > 0)) + printf("%10.4f %6lu %12.6f %12.6f\n", + x,j,xx[j],xx[j+1]); + else if (j == N) + printf("%10.4f %6lu %12.6f %s\n", + x,j,xx[j]," upper lim"); + else + printf("%10.4f %6lu %s %12.6f \n", + x,j," lower lim",xx[j+1]); + } + free_vector(xx,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xlubksb.c b/lib/nr/ansi/examples/xlubksb.c new file mode 100644 index 0000000..0855161 --- /dev/null +++ b/lib/nr/ansi/examples/xlubksb.c @@ -0,0 +1,72 @@ + +/* Driver for routine lubksb */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 20 +#define MAXSTR 80 + +int main(void) +{ + int j,k,l,m,n,*indx; + float p,*x,**a,**b,**c; + char dummy[MAXSTR]; + FILE *fp; + + indx=ivector(1,NP); + x=vector(1,NP); + a=matrix(1,NP,1,NP); + b=matrix(1,NP,1,NP); + c=matrix(1,NP,1,NP); + if ((fp = fopen("matrx1.dat","r")) == NULL) + nrerror("Data file matrx1.dat not found\n"); + while (!feof(fp)) { + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + fscanf(fp,"%d %d ",&n,&m); + fgets(dummy,MAXSTR,fp); + for (k=1;k<=n;k++) + for (l=1;l<=n;l++) fscanf(fp,"%f ",&a[k][l]); + fgets(dummy,MAXSTR,fp); + for (l=1;l<=m;l++) + for (k=1;k<=n;k++) fscanf(fp,"%f ",&b[k][l]); + /* Save matrix a for later testing */ + for (l=1;l<=n;l++) + for (k=1;k<=n;k++) c[k][l]=a[k][l]; + /* Do LU decomposition */ + ludcmp(c,n,indx,&p); + /* Solve equations for each right-hand vector */ + for (k=1;k<=m;k++) { + for (l=1;l<=n;l++) x[l]=b[l][k]; + lubksb(c,n,indx,x); + /* Test results with original matrix */ + printf("right-hand side vector:\n"); + for (l=1;l<=n;l++) + printf("%12.6f",b[l][k]); + printf("\n%s%s\n","result of matrix applied", + " to sol'n vector"); + for (l=1;l<=n;l++) { + b[l][k]=0.0; + for (j=1;j<=n;j++) + b[l][k] += (a[l][j]*x[j]); + } + for (l=1;l<=n;l++) + printf("%12.6f",b[l][k]); + printf("\n*********************************\n"); + } + printf("press RETURN for next problem:\n"); + (void) getchar(); + } + fclose(fp); + free_matrix(c,1,NP,1,NP); + free_matrix(b,1,NP,1,NP); + free_matrix(a,1,NP,1,NP); + free_vector(x,1,NP); + free_ivector(indx,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xludcmp.c b/lib/nr/ansi/examples/xludcmp.c new file mode 100644 index 0000000..c67eeb1 --- /dev/null +++ b/lib/nr/ansi/examples/xludcmp.c @@ -0,0 +1,109 @@ + +/* Driver for routine ludcmp */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 20 +#define MAXSTR 80 + +int main(void) +{ + int j,k,l,m,n,dum,*indx,*jndx; + float d,**a,**xl,**xu,**x; + char dummy[MAXSTR]; + FILE *fp; + + indx=ivector(1,NP); + jndx=ivector(1,NP); + a=matrix(1,NP,1,NP); + xl=matrix(1,NP,1,NP); + xu=matrix(1,NP,1,NP); + x=matrix(1,NP,1,NP); + if ((fp = fopen("matrx1.dat","r")) == NULL) + nrerror("Data file matrx1.dat not found\n"); + while (!feof(fp)) { + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + fscanf(fp,"%d %d ",&n,&m); + fgets(dummy,MAXSTR,fp); + for (k=1;k<=n;k++) + for (l=1;l<=n;l++) fscanf(fp,"%f ",&a[k][l]); + fgets(dummy,MAXSTR,fp); + for (l=1;l<=m;l++) + for (k=1;k<=n;k++) fscanf(fp,"%f ",&x[k][l]); + /* Print out a-matrix for comparison with product of + lower and upper decomposition matrices */ + printf("original matrix:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",a[k][l]); + printf("\n"); + } + /* Perform the decomposition */ + ludcmp(a,n,indx,&d); + /* Compose separately the lower and upper matrices */ + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) { + if (l > k) { + xu[k][l]=a[k][l]; + xl[k][l]=0.0; + } else if (l < k) { + xu[k][l]=0.0; + xl[k][l]=a[k][l]; + } else { + xu[k][l]=a[k][l]; + xl[k][l]=1.0; + } + } + } + /* Compute product of lower and upper matrices for + comparison with original matrix */ + for (k=1;k<=n;k++) { + jndx[k]=k; + for (l=1;l<=n;l++) { + x[k][l]=0.0; + for (j=1;j<=n;j++) + x[k][l] += (xl[k][j]*xu[j][l]); + } + } + printf("\n%s%s\n","product of lower and upper ", + "matrices (rows unscrambled):"); + for (k=1;k<=n;k++) { + dum=jndx[indx[k]]; + jndx[indx[k]]=jndx[k]; + jndx[k]=dum; + } + for (k=1;k<=n;k++) + for (j=1;j<=n;j++) + if (jndx[j] == k) { + for (l=1;l<=n;l++) + printf("%12.6f",x[j][l]); + printf("\n"); + } + printf("\nlower matrix of the decomposition:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",xl[k][l]); + printf("\n"); + } + printf("\nupper matrix of the decomposition:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",xu[k][l]); + printf("\n"); + } + printf("\n***********************************\n"); + printf("press return for next problem:\n"); + (void) getchar(); + } + fclose(fp); + free_matrix(x,1,NP,1,NP); + free_matrix(xu,1,NP,1,NP); + free_matrix(xl,1,NP,1,NP); + free_matrix(a,1,NP,1,NP); + free_ivector(jndx,1,NP); + free_ivector(indx,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xmachar.c b/lib/nr/ansi/examples/xmachar.c new file mode 100644 index 0000000..640ff5f --- /dev/null +++ b/lib/nr/ansi/examples/xmachar.c @@ -0,0 +1,30 @@ + +/* Driver for routine machar */ + +#include +#define NRANSI +#include "nr.h" + +int main(void) +{ + int ibeta,iexp,irnd,it,machep,maxexp,minexp,negep,ngrd; + float eps,epsneg,xmax,xmin; + + machar(&ibeta,&it,&irnd,&ngrd,&machep,&negep,&iexp,&minexp,&maxexp, + &eps,&epsneg,&xmin,&xmax); + printf("ibeta = %d\n",ibeta); + printf("it = %d\n",it); + printf("irnd = %d\n",irnd); + printf("ngrd = %d\n",ngrd); + printf("machep = %d\n",machep); + printf("negep = %d\n",negep); + printf("iexp = %d\n",iexp); + printf("minexp = %d\n",minexp); + printf("maxexp = %d\n",maxexp); + printf("eps = %12.6g\n",eps); + printf("epsneg = %12.6g\n",epsneg); + printf("xmin = %12.6g\n",xmin); + printf("xmax = %12.6g\n",xmax); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xmedfit.c b/lib/nr/ansi/examples/xmedfit.c new file mode 100644 index 0000000..61ed52e --- /dev/null +++ b/lib/nr/ansi/examples/xmedfit.c @@ -0,0 +1,45 @@ + +/* Driver for routine medfit */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPT 100 +#define SPREAD 0.1 +#define NDATA NPT + +int main(void) +{ + long idum=(-1984); + int i,mwt=1; + float a,abdev,b,chi2,q,siga,sigb; + float *x,*y,*sig; + + x=vector(1,NDATA); + y=vector(1,NDATA); + sig=vector(1,NDATA); + for (i=1;i<=NPT;i++) { + x[i]=0.1*i; + y[i] = -2.0*x[i]+1.0+SPREAD*gasdev(&idum); + sig[i]=SPREAD; + } + fit(x,y,NPT,sig,mwt,&a,&b,&siga,&sigb,&chi2,&q); + printf("\nAccording to routine FIT the result is:\n"); + printf(" a = %8.4f uncertainty: %8.4f\n",a,siga); + printf(" b = %8.4f uncertainty: %8.4f\n",b,sigb); + printf(" chi-squared: %8.4f for %4d points\n",chi2,NPT); + printf(" goodness-of-fit: %8.4f\n",q); + printf("\nAccording to routine MEDFIT the result is:\n"); + medfit(x,y,NPT,&a,&b,&abdev); + printf(" a = %8.4f\n",a); + printf(" b = %8.4f\n",b); + printf(" absolute deviation (per data point): %8.4f\n",abdev); + printf(" (note: gaussian SPREAD is %8.4f)\n",SPREAD); + free_vector(sig,1,NDATA); + free_vector(y,1,NDATA); + free_vector(x,1,NDATA); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xmemcof.c b/lib/nr/ansi/examples/xmemcof.c new file mode 100644 index 0000000..d68614b --- /dev/null +++ b/lib/nr/ansi/examples/xmemcof.c @@ -0,0 +1,33 @@ + +/* Driver for routine memcof */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 1000 +#define M 10 + +int main(void) +{ + int i; + float pm,*cof,*data; + FILE *fp; + + cof=vector(1,M); + data=vector(1,N); + if ((fp = fopen("spctrl.dat","r")) == NULL) + nrerror("Data file spctrl.dat not found\n"); + for (i=1;i<=N;i++) fscanf(fp,"%f",&data[i]); + fclose(fp); + memcof(data,N,M,&pm,cof); + printf("Coefficients for spectral estimation of spctrl.dat\n\n"); + for (i=1;i<=M;i++) printf("a[%2d] = %12.6f \n",i,cof[i]); + printf("\na0 =%12.6f\n",pm); + free_vector(data,1,N); + free_vector(cof,1,M); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xmgfas.c b/lib/nr/ansi/examples/xmgfas.c new file mode 100644 index 0000000..1fe7fed --- /dev/null +++ b/lib/nr/ansi/examples/xmgfas.c @@ -0,0 +1,43 @@ + +/* Driver for routine mgfas */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NSTEP 4 +#define JMAX 33 + +int main(void) +{ + int i,j,midl=JMAX/2+1; + double **f,**u; + + f=dmatrix(1,JMAX,1,JMAX); + u=dmatrix(1,JMAX,1,JMAX); + for (i=1;i<=JMAX;i++) + for (j=1;j<=JMAX;j++) + u[i][j]=0.0; + u[midl][midl]=2.0; + mgfas(u,JMAX,2); + printf("MGFAS solution:\n"); + for (i=1;i<=JMAX;i+=NSTEP) { + for (j=1;j<=JMAX;j+=NSTEP) printf("%8.4f",u[i][j]); + printf("\n"); + } + printf("\n Test that solution satisfies difference equations:\n"); + for (i=NSTEP+1;i +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NSTEP 4 +#define JMAX 33 + +int main(void) +{ + int i,j,midl=JMAX/2+1; + double **f,**u; + + f=dmatrix(1,JMAX,1,JMAX); + u=dmatrix(1,JMAX,1,JMAX); + for (i=1;i<=JMAX;i++) + for (j=1;j<=JMAX;j++) + u[i][j]=0.0; + u[midl][midl]=2.0; + mglin(u,JMAX,2); + printf("MGLIN solution:\n"); + for (i=1;i<=JMAX;i+=NSTEP) { + for (j=1;j<=JMAX;j+=NSTEP) printf("%8.4f",u[i][j]); + printf("\n"); + } + printf("\n Test that solution satisfies difference equations:\n"); + for (i=NSTEP+1;i +#include +#define NRANSI +#include "nr.h" + +#define NMAX 10 + +/* Test function */ +float func(float x) +{ + return 1.0/sqrt(x); +} + +/* Integral of test function */ +float fint(float x) +{ + return 2.0*sqrt(x); +} + +int main(void) +{ + float a=0.0,b=1.0,s; + int i; + + printf("\nIntegral of func computed with MIDPNT\n"); + printf("Actual value of integral is %7.4f\n",(fint(b)-fint(a))); + printf("%6s %29s \n","n","Approx. integral"); + for (i=1;i<=NMAX;i++) { + s=midpnt(func,a,b,i); + printf("%6d %24.6f\n",i,s); + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xmiser.c b/lib/nr/ansi/examples/xmiser.c new file mode 100644 index 0000000..550dafe --- /dev/null +++ b/lib/nr/ansi/examples/xmiser.c @@ -0,0 +1,57 @@ + +/* Driver for routine miser */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +long idum; /* for ranno */ + +int ndim; /* for func */ +float xoff; + +float func(float pt[]) +{ + int j; + float ans,sum; + + for (sum=0.0,j=1;j<=ndim;j++) sum += (100.0*SQR(pt[j]-xoff)); + ans=(sum < 80.0 ? exp(-sum) : 0.0); + ans *= pow(5.64189,(double)ndim); + return ans; +} + +int main(void) +{ + unsigned long n; + int j,nt,ntries; + float ave,dith,sumav,sumsd,var,*regn; + + printf("IDUM=\n"); + scanf("%ld",&idum); + if (idum > 0) idum = -idum; + for (;;) { + printf("ENTER N,NDIM,XOFF,DITH,NTRIES\n"); + if (scanf("%ld %d %f %f %d",&n,&ndim,&xoff,&dith,&ntries) == EOF) break; + regn=vector(1,2*ndim); + sumav=sumsd=0.0; + for (nt=1;nt<=ntries;nt++) { + for (j=1;j<=ndim;j++) { + regn[j]=0.0; + regn[ndim+j]=1.0; + } + miser(func,regn,ndim,n,dith,&ave,&var); + sumav += SQR(ave-1.0); + sumsd += sqrt(fabs(var)); + } + sumav=sqrt(sumav/ntries); + sumsd /= ntries; + printf("Fractional error: actual,indicated= %12.6f% 12.6f\n",sumav,sumsd); + free_vector(regn,1,2*ndim); + } + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xmmid.c b/lib/nr/ansi/examples/xmmid.c new file mode 100644 index 0000000..8d9a662 --- /dev/null +++ b/lib/nr/ansi/examples/xmmid.c @@ -0,0 +1,56 @@ + +/* Driver for routine mmid */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NVAR 4 +#define X1 1.0 +#define HTOT 0.5 + +void derivs(float x,float y[],float dydx[]) +{ + dydx[1] = -y[2]; + dydx[2]=y[1]-(1.0/x)*y[2]; + dydx[3]=y[2]-(2.0/x)*y[3]; + dydx[4]=y[3]-(3.0/x)*y[4]; +} + +int main(void) +{ + int i; + float b1,b2,b3,b4,xf=X1+HTOT,*y,*yout,*dydx; + + y=vector(1,NVAR); + yout=vector(1,NVAR); + dydx=vector(1,NVAR); + y[1]=bessj0(X1); + y[2]=bessj1(X1); + y[3]=bessj(2,X1); + y[4]=bessj(3,X1); + derivs(X1,y,dydx); + b1=bessj0(xf); + b2=bessj1(xf); + b3=bessj(2,xf); + b4=bessj(3,xf); + printf("First four Bessel functions:\n"); + for (i=5;i<=50;i+=5) { + mmid(y,dydx,NVAR,X1,HTOT,i,yout,derivs); + printf("\n%s %5.2f %s %5.2f %s %2d %s \n", + "x=",X1," to ",X1+HTOT," in ",i," steps"); + printf("%14s %9s\n","integration","bessj"); + printf("%12.6f %12.6f\n",yout[1],b1); + printf("%12.6f %12.6f\n",yout[2],b2); + printf("%12.6f %12.6f\n",yout[3],b3); + printf("%12.6f %12.6f\n",yout[4],b4); + printf("\nPress RETURN to continue...\n"); + (void) getchar(); + } + free_vector(dydx,1,NVAR); + free_vector(yout,1,NVAR); + free_vector(y,1,NVAR); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xmnbrak.c b/lib/nr/ansi/examples/xmnbrak.c new file mode 100644 index 0000000..a8f2229 --- /dev/null +++ b/lib/nr/ansi/examples/xmnbrak.c @@ -0,0 +1,28 @@ + +/* Driver for routine mnbrak */ + +#include +#define NRANSI +#include "nr.h" + +float func(float x) +{ + return bessj0(x); +} + +int main(void) +{ + float ax,bx,cx,fa,fb,fc; + int i; + + for (i=1;i<=10;i++) { + ax=i*0.5; + bx=(i+1.0)*0.5; + mnbrak(&ax,&bx,&cx,&fa,&fb,&fc,func); + printf("%14s %12s %12s\n","a","b","c"); + printf("%3s %14.6f %12.6f %12.6f\n","x",ax,bx,cx); + printf("%3s %14.6f %12.6f %12.6f\n","f",fa,fb,fc); + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xmnewt.c b/lib/nr/ansi/examples/xmnewt.c new file mode 100644 index 0000000..6161791 --- /dev/null +++ b/lib/nr/ansi/examples/xmnewt.c @@ -0,0 +1,73 @@ + +/* Driver for routine mnewt */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +void usrfun(float *x,int n,float *fvec,float **fjac) +{ + int i; + + fjac[1][1] = -2.0*x[1]; + fjac[1][2] = -2.0*x[2]; + fjac[1][3] = -2.0*x[3]; + fjac[1][4]=1.0; + for (i=1;i<=n;i++) fjac[2][i]=2.0*x[i]; + fjac[3][1]=1.0; + fjac[3][2] = -1.0; + fjac[3][3]=0.0; + fjac[3][4]=0.0; + fjac[4][1]=0.0; + fjac[4][2]=1.0; + fjac[4][3] = -1.0; + fjac[4][4]=0.0; + fvec[1] = -SQR(x[1])-SQR(x[2])-SQR(x[3])+x[4]; + fvec[2]=SQR(x[1])+SQR(x[2])+SQR(x[3])+SQR(x[4])-1.0; + fvec[3]=x[1]-x[2]; + fvec[4]=x[2]-x[3]; +} + +#define NTRIAL 5 +#define TOLX 1.0e-6 +#define N 4 +#define TOLF 1.0e-6 + +int main(void) +{ + int i,j,k,kk; + float xx,*x,*fvec,**fjac; + + fjac=matrix(1,N,1,N); + fvec=vector(1,N); + x=vector(1,N); + for (kk=1;kk<=2;kk++) { + for (k=1;k<=3;k++) { + xx=0.2001*k*(2*kk-3); + printf("Starting vector number %2d\n",k); + for (i=1;i<=4;i++) { + x[i]=xx+0.2*i; + printf("%7s%1d%s %5.2f\n", + "x[",i,"] = ",x[i]); + } + printf("\n"); + for (j=1;j<=NTRIAL;j++) { + mnewt(1,x,N,TOLX,TOLF); + usrfun(x,N,fvec,fjac); + printf("%5s %13s %13s\n","i","x[i]","f"); + for (i=1;i<=N;i++) + printf("%5d %14.6f %15.6f\n", + i,x[i],fvec[i]); + printf("\npress RETURN to continue...\n"); + (void) getchar(); + } + } + } + free_vector(x,1,N); + free_vector(fvec,1,N); + free_matrix(fjac,1,N,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xmoment.c b/lib/nr/ansi/examples/xmoment.c new file mode 100644 index 0000000..800316f --- /dev/null +++ b/lib/nr/ansi/examples/xmoment.c @@ -0,0 +1,42 @@ + +/* Driver for routine moment */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define PI 3.14159265 +#define NPTS 5000 +#define NBIN 100 +#define NPPNB (NPTS+NBIN) + +int main(void) +{ + int i=0,k,nlim; + float adev,ave,curt,sdev,skew,vrnce,x,*data; + + data=vector(1,NPPNB); + for (x=PI/NBIN;x<=PI;x+=PI/NBIN) { + nlim=(int) (0.5+sin(x)*PI/2.0*NPTS/NBIN); + for (k=1;k<=nlim;k++) data[++i]=x; + } + printf("moments of a sinusoidal distribution\n\n"); + moment(data,i,&ave,&adev,&sdev,&vrnce,&skew,&curt); + printf("%39s %11s\n\n","calculated","expected"); + printf("%s %17s %12.4f %12.4f\n","Mean :"," ",ave,PI/2.0); + printf("%s %4s %12.4f %12.4f\n", + "Average Deviation :"," ",adev,(PI/2.0)-1.0); + printf("%s %3s %12.4f %12.4f\n", + "Standard Deviation :"," ",sdev,0.683667); + printf("%s %13s %12.4f %12.4f\n", + "Variance :"," ",vrnce,0.467401); + printf("%s %13s %12.4f %12.4f\n", + "Skewness :"," ",skew,0.0); + printf("%s %13s %12.4f %12.4f\n", + "Kurtosis :"," ",curt,-0.806249); + free_vector(data,1,NPPNB); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xmppi.c b/lib/nr/ansi/examples/xmppi.c new file mode 100644 index 0000000..6310ae1 --- /dev/null +++ b/lib/nr/ansi/examples/xmppi.c @@ -0,0 +1,75 @@ + +/* Driver for mp routines */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define IAOFF 48 +#define NMAX 1024 + +void mpsqr2(int n) +{ + int j,m; + unsigned char *x,*y,*t,*q,*r,*s; + + x=cvector(1,NMAX); + y=cvector(1,NMAX); + t=cvector(1,NMAX); + q=cvector(1,NMAX); + r=cvector(1,NMAX); + s=cvector(1,3*NMAX); + t[1]=2; + for (j=2;j<=n;j++) t[j]=0; + mpsqrt(x,x,t,n,n); + mpmov(y,x,n); + printf("sqrt(2)=\n"); + s[1]=y[1]+IAOFF; + s[2]='.'; + /* caution: next step is N**2! omit it for large N */ + mp2dfr(&y[1],&s[2],n-1,&m); + s[m+3]=0; + printf(" %64s\n",&s[1]); + printf("Result rounded to 1 less base-256 place:\n"); + /* use s as scratch space */ + mpsad(s,x,n,128); + mpmov(y,&s[1],n-1); + s[1]=y[1]+IAOFF; + s[2]='.'; + /* caution: next step is N**2! omit it for large N */ + mp2dfr(&y[1],&s[2],n-2,&m); + s[m+3]=0; + printf(" %64s\n",&s[1]); + printf("2-sqrt(2)=\n"); + /* Calculate this the hard way to exercise the mpdiv function */ + mpdiv(q,r,t,x,n,n); + s[1]=r[1]+IAOFF; + s[2]='.'; + /* caution: next step is N**2! omit it for large N */ + mp2dfr(&r[1],&s[2],n-1,&m); + s[m+3]=0; + printf(" %64s\n",&s[1]); + free_cvector(s,1,3*NMAX); + free_cvector(r,1,NMAX); + free_cvector(q,1,NMAX); + free_cvector(t,1,NMAX); + free_cvector(y,1,NMAX); + free_cvector(x,1,NMAX); +} + +int main(void) +{ + int n; + + for (;;) { + printf("Input n\n"); + if (scanf("%d",&n) == EOF) break; + mpsqr2(n); + mppi(n); + } + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xmprove.c b/lib/nr/ansi/examples/xmprove.c new file mode 100644 index 0000000..8032dff --- /dev/null +++ b/lib/nr/ansi/examples/xmprove.c @@ -0,0 +1,54 @@ + +/* Driver for routine mprove */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 5 +#define NP N + +int main(void) +{ + int i,j,*indx; + long idum=(-13); + float d,*x,**a,**aa; + static float ainit[NP][NP]= + {1.0,2.0,3.0,4.0,5.0, + 2.0,3.0,4.0,5.0,1.0, + 1.0,1.0,1.0,1.0,1.0, + 4.0,5.0,1.0,2.0,3.0, + 5.0,1.0,2.0,3.0,4.0}; + static float b[N+1]={0.0,1.0,1.0,1.0,1.0,1.0}; + + indx=ivector(1,N); + x=vector(1,N); + a=convert_matrix(&ainit[0][0],1,N,1,N); + aa=matrix(1,N,1,N); + for (i=1;i<=N;i++) { + x[i]=b[i]; + for (j=1;j<=N;j++) + aa[i][j]=a[i][j]; + } + ludcmp(aa,N,indx,&d); + lubksb(aa,N,indx,x); + printf("\nSolution vector for the equations:\n"); + for (i=1;i<=N;i++) printf("%12.6f",x[i]); + printf("\n"); + /* now phoney up x and let mprove fix it */ + for (i=1;i<=N;i++) x[i] *= (1.0+0.2*ran3(&idum)); + printf("\nSolution vector with noise added:\n"); + for (i=1;i<=N;i++) printf("%12.6f",x[i]); + printf("\n"); + mprove(a,aa,N,indx,b,x); + printf("\nSolution vector recovered by mprove:\n"); + for (i=1;i<=N;i++) printf("%12.6f",x[i]); + printf("\n"); + free_matrix(aa,1,N,1,N); + free_convert_matrix(a,1,N,1,N); + free_vector(x,1,N); + free_ivector(indx,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xmrqcof.c b/lib/nr/ansi/examples/xmrqcof.c new file mode 100644 index 0000000..881824d --- /dev/null +++ b/lib/nr/ansi/examples/xmrqcof.c @@ -0,0 +1,73 @@ + +/* Driver for routine mrqcof */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPT 100 +#define MA 6 +#define SPREAD 0.1 + +int main(void) +{ + long idum=(-911); + int i,j,mfit=MA,*ia; + float chisq,*beta,*x,*y,*sig,**covar,**alpha; + static float a[MA+1]= + {0.0,5.0,2.0,3.0,2.0,5.0,3.0}; + static float gues[MA+1]= + {0.0,4.9,2.1,2.9,2.1,4.9,3.1}; + + ia=ivector(1,MA); + beta=vector(1,MA); + x=vector(1,NPT); + y=vector(1,NPT); + sig=vector(1,NPT); + covar=matrix(1,MA,1,MA); + alpha=matrix(1,MA,1,MA); + /* First try sum of two gaussians */ + for (i=1;i<=NPT;i++) { + x[i]=0.1*i; + y[i]=0.0; + y[i] += a[1]*exp(-SQR((x[i]-a[2])/a[3])); + y[i] += a[4]*exp(-SQR((x[i]-a[5])/a[6])); + y[i] *= (1.0+SPREAD*gasdev(&idum)); + sig[i]=SPREAD*y[i]; + } + for (i=1;i<=mfit;i++) ia[i]=1; + for (i=1;i<=mfit;i++) a[i]=gues[i]; + mrqcof(x,y,sig,NPT,a,ia,MA,alpha,beta,&chisq,fgauss); + printf("\nmatrix alpha\n"); + for (i=1;i<=MA;i++) { + for (j=1;j<=MA;j++) printf("%12.4f",alpha[i][j]); + printf("\n"); + } + printf("vector beta\n"); + for (i=1;i<=MA;i++) printf("%12.4f",beta[i]); + printf("\nchi-squared: %12.4f\n\n",chisq); + /* Next fix one line and improve the other */ + mfit=3; + for (i=1;i<=mfit;i++) ia[i]=0; + for (i=1;i<=MA;i++) a[i]=gues[i]; + mrqcof(x,y,sig,NPT,a,ia,MA,alpha,beta,&chisq,fgauss); + printf("matrix alpha\n"); + for (i=1;i<=mfit;i++) { + for (j=1;j<=mfit;j++) printf("%12.4f",alpha[i][j]); + printf("\n"); + } + printf("vector beta\n"); + for (i=1;i<=mfit;i++) printf("%12.4f",beta[i]); + printf("\nchi-squared: %12.4f\n\n",chisq); + free_matrix(alpha,1,MA,1,MA); + free_matrix(covar,1,MA,1,MA); + free_vector(sig,1,NPT); + free_vector(y,1,NPT); + free_vector(x,1,NPT); + free_vector(beta,1,MA); + free_ivector(ia,1,MA); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xmrqmin.c b/lib/nr/ansi/examples/xmrqmin.c new file mode 100644 index 0000000..0f25896 --- /dev/null +++ b/lib/nr/ansi/examples/xmrqmin.c @@ -0,0 +1,91 @@ + +/* Driver for routine mrqmin */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPT 100 +#define MA 6 +#define SPREAD 0.001 + +int main(void) +{ + long idum=(-911); + int i,*ia,iter,itst,j,k,mfit=MA; + float alamda,chisq,ochisq,*x,*y,*sig,**covar,**alpha; + static float a[MA+1]= + {0.0,5.0,2.0,3.0,2.0,5.0,3.0}; + static float gues[MA+1]= + {0.0,4.5,2.2,2.8,2.5,4.9,2.8}; + + ia=ivector(1,MA); + x=vector(1,NPT); + y=vector(1,NPT); + sig=vector(1,NPT); + covar=matrix(1,MA,1,MA); + alpha=matrix(1,MA,1,MA); + /* First try a sum of two Gaussians */ + for (i=1;i<=NPT;i++) { + x[i]=0.1*i; + y[i]=0.0; + for (j=1;j<=MA;j+=3) { + y[i] += a[j]*exp(-SQR((x[i]-a[j+1])/a[j+2])); + } + y[i] *= (1.0+SPREAD*gasdev(&idum)); + sig[i]=SPREAD*y[i]; + } + for (i=1;i<=mfit;i++) ia[i]=1; + for (i=1;i<=MA;i++) a[i]=gues[i]; + for (iter=1;iter<=2;iter++) { + alamda = -1; + mrqmin(x,y,sig,NPT,a,ia,MA,covar,alpha,&chisq,fgauss,&alamda); + k=1; + itst=0; + for (;;) { + printf("\n%s %2d %17s %10.4f %10s %9.2e\n","Iteration #",k, + "chi-squared:",chisq,"alamda:",alamda); + printf("%8s %8s %8s %8s %8s %8s\n", + "a[1]","a[2]","a[3]","a[4]","a[5]","a[6]"); + for (i=1;i<=6;i++) printf("%9.4f",a[i]); + printf("\n"); + k++; + ochisq=chisq; + mrqmin(x,y,sig,NPT,a,ia,MA,covar,alpha,&chisq,fgauss,&alamda); + if (chisq > ochisq) + itst=0; + else if (fabs(ochisq-chisq) < 0.1) + itst++; + if (itst < 4) continue; + alamda=0.0; + mrqmin(x,y,sig,NPT,a,ia,MA,covar,alpha,&chisq,fgauss,&alamda); + printf("\nUncertainties:\n"); + for (i=1;i<=6;i++) printf("%9.4f",sqrt(covar[i][i])); + printf("\n"); + printf("\nExpected results:\n"); + printf(" %7.2f %8.2f %8.2f %8.2f %8.2f %8.2f\n", + 5.0,2.0,3.0,2.0,5.0,3.0); + break; + } + if (iter == 1) { + printf("press return to continue with constraint\n"); + (void) getchar(); + printf("holding a[2] and a[5] constant\n"); + for (j=1;j<=MA;j++) a[j] += 0.1; + a[2]=2.0; + ia[2]=0; + a[5]=5.0; + ia[5]=0; + } + } + free_matrix(alpha,1,MA,1,MA); + free_matrix(covar,1,MA,1,MA); + free_vector(sig,1,NPT); + free_vector(y,1,NPT); + free_vector(x,1,NPT); + free_ivector(ia,1,MA); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xnewt.c b/lib/nr/ansi/examples/xnewt.c new file mode 100644 index 0000000..780d08e --- /dev/null +++ b/lib/nr/ansi/examples/xnewt.c @@ -0,0 +1,36 @@ + +/* Driver for routine newt */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +void funcv(int n,float x[],float f[]) +{ + f[1]=SQR(x[1])+SQR(x[2])-2.0; + f[2]=exp(x[1]-1.0)+x[2]*SQR(x[2])-2.0; +} + +#define N 2 + +int main(void) +{ + int i,check; + float *x,*f; + + x=vector(1,N); + f=vector(1,N); + x[1]=2.0; + x[2]=0.5; + newt(x,N,&check,funcv); + funcv(N,x,f); + if (check) printf("Convergence problems.\n"); + printf("%7s %3s %12s\n","Index","x","f"); + for (i=1;i<=N;i++) printf("%5d %12.6f %12.6f\n",i,x[i],f[i]); + free_vector(f,1,N); + free_vector(x,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xodeint.c b/lib/nr/ansi/examples/xodeint.c new file mode 100644 index 0000000..cbebaf7 --- /dev/null +++ b/lib/nr/ansi/examples/xodeint.c @@ -0,0 +1,54 @@ + +/* Driver for routine odeint */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 4 + +float dxsav,*xp,**yp; /* defining declarations */ +int kmax,kount; + +int nrhs; /* counts function evaluations */ + +void derivs(float x,float y[],float dydx[]) +{ + nrhs++; + dydx[1] = -y[2]; + dydx[2]=y[1]-(1.0/x)*y[2]; + dydx[3]=y[2]-(2.0/x)*y[3]; + dydx[4]=y[3]-(3.0/x)*y[4]; +} + +int main(void) +{ + int i,nbad,nok; + float eps=1.0e-4,h1=0.1,hmin=0.0,x1=1.0,x2=10.0,*ystart; + + ystart=vector(1,N); + xp=vector(1,200); + yp=matrix(1,10,1,200); + ystart[1]=bessj0(x1); + ystart[2]=bessj1(x1); + ystart[3]=bessj(2,x1); + ystart[4]=bessj(3,x1); + nrhs=0; + kmax=100; + dxsav=(x2-x1)/20.0; + odeint(ystart,N,x1,x2,eps,h1,hmin,&nok,&nbad,derivs,rkqs); + printf("\n%s %13s %3d\n","successful steps:"," ",nok); + printf("%s %20s %3d\n","bad steps:"," ",nbad); + printf("%s %9s %3d\n","function evaluations:"," ",nrhs); + printf("\n%s %3d\n","stored intermediate values: ",kount); + printf("\n%8s %18s %15s\n","x","integral","bessj(3,x)"); + for (i=1;i<=kount;i++) + printf("%10.4f %16.6f %14.6f\n", + xp[i],yp[4][i],bessj(3,xp[i])); + free_matrix(yp,1,10,1,200); + free_vector(xp,1,200); + free_vector(ystart,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xorthog.c b/lib/nr/ansi/examples/xorthog.c new file mode 100644 index 0000000..11c7f3b --- /dev/null +++ b/lib/nr/ansi/examples/xorthog.c @@ -0,0 +1,64 @@ + +/* Driver for routine orthog */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 64 + +float func(float x) +{ + return 1.0/SQR(1.0+x); +} + +int main(void) +{ + int i,n; + float amu0,check,xx,*a,*b,*x,*w,*anu,*alpha,*beta; + + a=vector(1,NP); + b=vector(1,NP); + x=vector(1,NP); + w=vector(1,NP); + anu=vector(1,2*NP); + alpha=vector(1,2*NP-1); + beta=vector(1,2*NP-1); + + /* Test with w[x] = -log x */ + for (;;) { + printf("Enter N\n"); + if (scanf("%d",&n) == EOF) break; + alpha[1]=0.5; + beta[1]=1.0; + for (i=2;i<=2*n-1;i++) { + alpha[i]=0.5; + beta[i]=1.0/(4.0*(4.0-1.0/((i-1)*(i-1)))); + } + anu[1]=1.0; + anu[2] = -0.25; + for (i=2;i<=2*n-1;i++) anu[i+1] = -anu[i]*i*(i-1)/(2.0*(i+1)*(2*i-1)); + orthog(n,anu,alpha,beta,a,b); + amu0=1.0; + gaucof(n,a,b,amu0,x,w); + printf("%3s %10s %14s\n","#","x(i)","w(i)"); + for (i=1;i<=n;i++) printf("%3d %14.6e %14.6e\n",i,x[i],w[i]); + for (check=0.0,i=1;i<=n;i++) check += w[i]; + printf("\nCheck value: %15.7e should be: %15.7e\n",check,amu0); + /* demonstrate the use of ORTHOG for an integral */ + for (xx=0.0,i=1;i<=n;i++) xx += w[i]*func(x[i]); + printf("\nIntegral from orthog: %12.6f\n",xx); + printf("Actual value: %12.6f\n",log(2.0)); + } + free_vector(beta,1,2*NP-1); + free_vector(alpha,1,2*NP-1); + free_vector(anu,1,2*NP); + free_vector(w,1,NP); + free_vector(x,1,NP); + free_vector(b,1,NP); + free_vector(a,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xpade.c b/lib/nr/ansi/examples/xpade.c new file mode 100644 index 0000000..7ae2804 --- /dev/null +++ b/lib/nr/ansi/examples/xpade.c @@ -0,0 +1,51 @@ + +/* Driver for routine pade */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +double fn(double x) +{ + return (x == 0.0 ? 1.0 : log(1.0+x)/x); +} + +#define NMAX 100 + +int main(void) +{ + int j,k,n; + float resid; + double b,d,fac,x,*c,*cc; + + c=dvector(0,NMAX); + cc=dvector(0,NMAX); + for (;;) { + printf("Enter n for PADE routine:\n"); + if (scanf("%d",&n) == EOF) break; + fac=1; + for (j=1;j<=2*n+1;j++) { + c[j-1]=fac/((double) j); + cc[j-1]=c[j-1]; + fac = -fac; + } + pade(c,n,&resid); + printf("Norm of residual vector= %16.8e\n",resid); + printf("point, func. value, pade series, power series\n"); + for (j=1;j<=21;j++) { + x=(j-1)*0.25; + for (b=0.0,k=2*n+1;k>=1;k--) { + b *= x; + b += cc[k-1]; + } + d=ratval(x,c,n,n); + printf("%16.8f %16.8f %16.8f %16.8f\n",x,fn(x),d,b); + } + } + free_dvector(cc,0,NMAX); + free_dvector(c,0,NMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xpccheb.c b/lib/nr/ansi/examples/xpccheb.c new file mode 100644 index 0000000..80f3b40 --- /dev/null +++ b/lib/nr/ansi/examples/xpccheb.c @@ -0,0 +1,69 @@ + +/* Driver for routine pccheb */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NCHECK 15 +#define NFEW 13 +#define NMANY 17 +#define NMAX 100 +#define PI 3.14159265 + +int main(void) +{ + int i,j; + float a=(-PI),b=PI,fac,f,sum,sume,py,py2,*c,*d,*e,*ee; + + c=vector(0,NMAX-1); + d=vector(0,NMAX-1); + e=vector(0,NMAX-1); + ee=vector(0,NMAX-1); + /* put power series of cos(PI*y) into e */ + fac=1.0; + e[0]=ee[0]=0.0; + for (j=0;j +#include +#define NRANSI +#include "nr.h" + +#define NVAL 40 +#define PIO2 1.5707963 + +float func(float x) +{ + return x*x*(x*x-2.0)*sin(x); +} + +int main(void) +{ + int i,j,mval; + float a=(-PIO2),b=PIO2,poly,x; + float c[NVAL],d[NVAL]; + + chebft(a,b,c,NVAL,func); + for (;;) { + printf("\nHow many terms in Chebyshev evaluation?\n"); + printf("Enter n between 6 and %2d. (n=0 to end).\n",NVAL); + scanf("%d",&mval); + if ((mval <= 0) || (mval > NVAL)) break; + chebpc(c,d,mval); + pcshft(a,b,d,mval); + /* Test shifted polynomial */ + printf("\n%9s %14s %14s\n","x","actual","polynomial"); + for (i = -8;i<=8;i++) { + x=i*PIO2/10.0; + poly=d[mval-1]; + for (j=mval-2;j>=0;j--) poly=poly*x+d[j]; + printf("%12.6f %12.6f %12.6f\n",x,func(x),poly); + } + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xpearsn.c b/lib/nr/ansi/examples/xpearsn.c new file mode 100644 index 0000000..2c60ab5 --- /dev/null +++ b/lib/nr/ansi/examples/xpearsn.c @@ -0,0 +1,30 @@ + +/* Driver for routine pearsn */ + +#include +#define NRANSI +#include "nr.h" + +#define N 10 + +int main(void) +{ + int i; + float prob,r,z; + static float dose[N+1]= + {0.0,56.1,64.1,70.0,66.6,82.0,91.3,90.0,99.7,115.3,110.0}; + static float spore[N+1]= + {0.0,0.11,0.40,0.37,0.48,0.75,0.66,0.71,1.20,1.01,0.95}; + + printf("\nEffect of Gamma Rays on Man-in-the-Moon Marigolds\n"); + printf("%16s %23s\n","Count Rate (cpm)","Pollen Index"); + for (i=1;i<=N;i++) + printf("%10.2f %25.2f \n",dose[i],spore[i]); + pearsn(dose,spore,N,&r,&prob,&z); + printf("\n%30s %16s\n","PEARSN","Expected"); + printf("%s %8s %9f %15f\n","Corr. Coeff."," ",r,0.9069586); + printf("%s %9s %9f %15f\n","Probability"," ",prob,0.2926505e-3); + printf("%s %10s %9f %15f\n","Fisher's z"," ",z,1.510110); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xperiod.c b/lib/nr/ansi/examples/xperiod.c new file mode 100644 index 0000000..a2a3a93 --- /dev/null +++ b/lib/nr/ansi/examples/xperiod.c @@ -0,0 +1,43 @@ + +/* Driver for routine period */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 90 +#define NPR 11 +#define TWOPI 6.2831853 + +int main(void) +{ + long idum=(-4); + int j=0,jmax,n,nout; + float prob,*px,*py,*x,*y; + + x=vector(1,NP); + y=vector(1,NP); + px=vector(1,2*NP); + py=vector(1,2*NP); + for (n=1;n<=NP+10;n++) { + if (n != 3 && n != 4 && n != 6 && n != 21 && + n != 38 && n != 51 && n != 67 && n != 68 && + n != 83 && n != 93) { + x[++j]=n; + y[j]=0.75*cos(0.6*x[j])+gasdev(&idum); + } + } + period(x,y,j,4.0,1.0,px,py,2*NP,&nout,&jmax,&prob); + printf("period results for test signal (cos(0.6x) + noise):\n"); + printf("nout,jmax,prob=%d %d %12.6g\n",nout,jmax,prob); + for (n=LMAX(1,jmax-NPR/2);n<=LMIN(nout,jmax+NPR/2);n++) + printf("%d %12.6f %12.6f\n",n,TWOPI*px[n],py[n]); + free_vector(py,1,2*NP); + free_vector(px,1,2*NP); + free_vector(y,1,NP); + free_vector(x,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xpiksr2.c b/lib/nr/ansi/examples/xpiksr2.c new file mode 100644 index 0000000..7d5d66f --- /dev/null +++ b/lib/nr/ansi/examples/xpiksr2.c @@ -0,0 +1,59 @@ + +/* Driver for routine piksr2 */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 100 +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,j; + float *a,*b; + FILE *fp; + + a=vector(1,NP); + b=vector(1,NP); + if ((fp = fopen("tarray.dat","r")) == NULL) + nrerror("Data file tarray.dat not found\n"); + fgets(txt,MAXSTR,fp); + for (i=1;i<=NP;i++) fscanf(fp,"%f",&a[i]); + fclose(fp); + /* generate b-array */ + for (i=1;i<=NP;i++) b[i]=i; + /* sort a and mix b */ + piksr2(NP,a,b); + printf("\nAfter sorting a and mixing b, array a is:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + printf("\n... and array b is:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",b[10*i+j]); + printf("\n"); + } + printf("press return to continue ...\n"); + (void) getchar(); + /* sort b and mix a */ + piksr2(NP,b,a); + printf("\nAfter sorting b and mixing a, array a is:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + printf("\n... and array b is:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",b[10*i+j]); + printf("\n"); + } + free_vector(b,1,NP); + free_vector(a,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xpiksrt.c b/lib/nr/ansi/examples/xpiksrt.c new file mode 100644 index 0000000..f74c7a0 --- /dev/null +++ b/lib/nr/ansi/examples/xpiksrt.c @@ -0,0 +1,40 @@ + +/* Driver for routine piksrt */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 +#define NP 100 + +int main(void) +{ + char txt[MAXSTR]; + int i,j; + float *a; + FILE *fp; + + a=vector(1,NP); + if ((fp = fopen("tarray.dat","r")) == NULL) + nrerror("Data file tarray.dat not found\n"); + fgets(txt,MAXSTR,fp); + for (i=1;i<=NP;i++) fscanf(fp,"%f",&a[i]); + fclose(fp); + printf("original array:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + piksrt(NP,a); + printf("sorted array:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + free_vector(a,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xplgndr.c b/lib/nr/ansi/examples/xplgndr.c new file mode 100644 index 0000000..3fa1afd --- /dev/null +++ b/lib/nr/ansi/examples/xplgndr.c @@ -0,0 +1,45 @@ + +/* Driver for routine plgndr */ + +#include +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,j,m,n,nval; + float fac,val,x; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Legendre Polynomials",20)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%4s %4s %10s %17s %24s\n","n", + "m","x","actual","plgndr(n,m,x)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%d %d %f %f",&n,&m,&x,&val); + fac=1.0; + if (m > 0) + for (j=n-m+1;j<=n+m;j++) fac *= j; + fac *= 2.0/(2.0*n+1.0); + val *= sqrt(fac); + printf("%4d %4d %13.6f %19.6e %19.6e\n", + n,m,x,val,plgndr(n,m,x)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xpoidev.c b/lib/nr/ansi/examples/xpoidev.c new file mode 100644 index 0000000..667d689 --- /dev/null +++ b/lib/nr/ansi/examples/xpoidev.c @@ -0,0 +1,47 @@ + +/* Driver for routine poidev */ + +#include +#define NRANSI +#include "nr.h" + +#define N 20 +#define NPTS 10000 +#define ISCAL 200 +#define LLEN 50 + +int main(void) +{ + char txt[LLEN+1]; + long idum=(-13); + int i,j,k,klim,dist[N+1]; + float xm,dd; + + for (;;) { + for (j=0;j<=N;j++) dist[j]=0; + do { + printf("Mean of Poisson distribution (0.0 N); + if (xm < 0.0) break; + for (i=1;i<=NPTS;i++) { + j=(int) (0.5+poidev(xm,&idum)); + if ((j >= 0) && (j <= N)) ++dist[j]; + } + printf("Poisson-distributed deviate, mean %5.2f of %6d points\n", + xm,NPTS); + printf("%5s %8s %10s\n","x","p(x)","graph:"); + for (j=0;j<=N;j++) { + dd=(float) dist[j]/NPTS; + for (k=0;k<=LLEN;k++) txt[k]=' '; + klim=(int) (ISCAL*dd); + if (klim > LLEN) klim=LLEN; + for (k=1;k<=klim;k++) txt[k]='*'; + txt[LLEN]='\0'; + printf("%6d %8.4f %s\n",j,dd,txt); + } + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xpolcoe.c b/lib/nr/ansi/examples/xpolcoe.c new file mode 100644 index 0000000..cefe491 --- /dev/null +++ b/lib/nr/ansi/examples/xpolcoe.c @@ -0,0 +1,63 @@ + +/* Driver for routine polcoe */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 4 +#define PI 3.1415926 + +int main(void) +{ + int i,j,nfunc; + float f,sum,x,*coeff,*xa,*ya; + + coeff=vector(0,NP); + xa=vector(0,NP); + ya=vector(0,NP); + for (nfunc=1;nfunc<=2;nfunc++) { + if (nfunc == 1) { + printf("sine function from 0 to PI\n\n"); + for (i=0;i<=NP;i++) { + xa[i]=(i+1)*PI/(NP+1); + ya[i]=sin(xa[i]); + } + } else if (nfunc == 2) { + printf("exponential function from 0 to 1\n\n"); + for (i=0;i<=NP;i++) { + xa[i]=1.0*(i+1)/(NP+1); + ya[i]=exp(xa[i]); + } + } else { + break; + } + polcoe(xa,ya,NP,coeff); + printf(" coefficients\n"); + for (i=0;i<=NP;i++) printf("%12.6f",coeff[i]); + printf("\n\n%9s %13s %15s\n","x","f(x)","polynomial"); + for (i=1;i<=10;i++) { + if (nfunc == 1) { + x=(-0.05+i/10.0)*PI; + f=sin(x); + } else if (nfunc == 2) { + x = -0.05+i/10.0; + f=exp(x); + } + sum=coeff[NP]; + for (j=NP-1;j>=0;j--) + sum=coeff[j]+sum*x; + printf("%12.6f %12.6f %12.6f\n",x,f,sum); + } + printf("\n************************************\n"); + printf("press RETURN\n"); + (void) getchar(); + } + free_vector(ya,0,NP); + free_vector(xa,0,NP); + free_vector(coeff,0,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xpolcof.c b/lib/nr/ansi/examples/xpolcof.c new file mode 100644 index 0000000..5d1f558 --- /dev/null +++ b/lib/nr/ansi/examples/xpolcof.c @@ -0,0 +1,63 @@ + +/* Driver for routine polcof */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 4 +#define PI 3.1415926 + +int main(void) +{ + int i,j,nfunc; + float f,sum,x,*coeff,*xa,*ya; + + coeff=vector(0,NP); + xa=vector(0,NP); + ya=vector(0,NP); + for (nfunc=1;nfunc<=2;nfunc++) { + if (nfunc == 1) { + printf("sine function from 0 to PI\n\n"); + for (i=0;i<=NP;i++) { + xa[i]=(i+1)*PI/(NP+1); + ya[i]=sin(xa[i]); + } + } else if (nfunc == 2) { + printf("exponential function from 0 to 1\n\n"); + for (i=0;i<=NP;i++) { + xa[i]=1.0*(i+1)/(NP+1); + ya[i]=exp(xa[i]); + } + } else { + break; + } + polcof(xa,ya,NP,coeff); + printf(" coefficients\n"); + for (i=0;i<=NP;i++) printf("%12.6f",coeff[i]); + printf("\n\n%9s %13s %15s\n","x","f(x)","polynomial"); + for (i=1;i<=10;i++) { + if (nfunc == 1) { + x=(-0.05+i/10.0)*PI; + f=sin(x); + } else if (nfunc == 2) { + x = -0.05+i/10.0; + f=exp(x); + } + sum=coeff[NP]; + for (j=NP-1;j>=0;j--) + sum=coeff[j]+sum*x; + printf("%12.6f %12.6f %12.6f\n",x,f,sum); + } + printf("\n************************************\n"); + printf("press RETURN\n"); + (void) getchar(); + } + free_vector(ya,0,NP); + free_vector(xa,0,NP); + free_vector(coeff,0,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xpoldiv.c b/lib/nr/ansi/examples/xpoldiv.c new file mode 100644 index 0000000..db7be91 --- /dev/null +++ b/lib/nr/ansi/examples/xpoldiv.c @@ -0,0 +1,37 @@ + +/* Driver for routine poldiv */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 5 +#define NV 3 + +int main(void) +{ + int i; + static float u[N+1]={-1.0,5.0,-10.0,10.0,-5.0,1.0}; + static float v[NV+1]={1.0,3.0,3.0,1.0}; + float *q,*r; + + q=vector(0,N); + r=vector(0,N); + poldiv(u,N,v,NV,q,r); + printf("\n%10s %10s %10s %10s %10s %10s\n\n", + "x^0","x^1","x^2","x^3","x^4","x^5"); + printf("quotient polynomial coefficients:\n"); + for (i=0;i<=5;i++) printf("%10.2f ",q[i]); + printf("\nexpected quotient coefficients:\n"); + printf("%10.2f %10.2f %10.2f %10.2f %10.2f %10.2f\n\n", + 31.0,-8.0,1.0,0.0,0.0,0.0); + printf("remainder polynomial coefficients:\n"); + for (i=0;i<=3;i++) printf("%10.2f ",r[i]); + printf("\nexpected remainder coefficients:\n"); + printf("%10.2f %10.2f %10.2f %10.2f\n",-32.0,-80.0,-80.0,0.0); + free_vector(r,0,N); + free_vector(q,0,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xpolin2.c b/lib/nr/ansi/examples/xpolin2.c new file mode 100644 index 0000000..bba2306 --- /dev/null +++ b/lib/nr/ansi/examples/xpolin2.c @@ -0,0 +1,48 @@ + +/* Driver for routine polin2 */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 5 +#define PI 3.1415926 + +int main(void) +{ + int i,j; + float dy,f,x1,x2,y,*x1a,*x2a,**ya; + + x1a=vector(1,N); + x2a=vector(1,N); + ya=matrix(1,N,1,N); + for (i=1;i<=N;i++) { + x1a[i]=i*PI/N; + for (j=1;j<=N;j++) { + x2a[j]=1.0*j/N; + ya[i][j]=sin(x1a[i])*exp(x2a[j]); + } + } + /* test 2-dimensional interpolation */ + printf("\nTwo dimensional interpolation of sin(x1)exp(x2)\n"); + printf("%9s %12s %13s %16s %11s\n", + "x1","x2","f(x)","interpolated","error"); + for (i=1;i<=4;i++) { + x1=(-0.1+i/5.0)*PI; + for (j=1;j<=4;j++) { + x2 = -0.1+j/5.0; + f=sin(x1)*exp(x2); + polin2(x1a,x2a,ya,N,N,x1,x2,&y,&dy); + printf("%12.6f %12.6f %12.6f %12.6f %15.6f\n", + x1,x2,f,y,dy); + } + printf ("***********************************\n"); + } + free_matrix(ya,1,N,1,N); + free_vector(x2a,1,N); + free_vector(x1a,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xpolint.c b/lib/nr/ansi/examples/xpolint.c new file mode 100644 index 0000000..3881db3 --- /dev/null +++ b/lib/nr/ansi/examples/xpolint.c @@ -0,0 +1,62 @@ + +/* Driver for routine polint */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define PI 3.1415926 + +int main(void) +{ + int i,n,nfunc; + float dy,f,x,y,*xa,*ya; + + printf("generation of interpolation tables\n"); + printf(" ... sin(x) 0 +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NDIM 3 +#define FTOL 1.0e-6 + +float func(float x[]) +{ + return 0.5-bessj0(SQR(x[1]-1.0)+SQR(x[2]-2.0)+SQR(x[3]-3.0)); +} + +int main(void) +{ + int i,iter,j; + float fret,**xi; + static float p[]={0.0,1.5,1.5,2.5}; + + xi=matrix(1,NDIM,1,NDIM); + for (i=1;i<=NDIM;i++) + for (j=1;j<=NDIM;j++) + xi[i][j]=(i == j ? 1.0 : 0.0); + powell(p,xi,NDIM,FTOL,&iter,&fret,func); + printf("Iterations: %3d\n\n",iter); + printf("Minimum found at: \n"); + for (i=1;i<=NDIM;i++) printf("%12.6f",p[i]); + printf("\n\nMinimum function value = %12.6f \n\n",fret); + printf("True minimum of function is at:\n"); + printf("%12.6f %12.6f %12.6f\n",1.0,2.0,3.0); + free_matrix(xi,1,NDIM,1,NDIM); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xpredic.c b/lib/nr/ansi/examples/xpredic.c new file mode 100644 index 0000000..80c85f7 --- /dev/null +++ b/lib/nr/ansi/examples/xpredic.c @@ -0,0 +1,42 @@ + +/* Driver for routine predic */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPTS 500 +#define NPOLES 10 +#define NFUT 20 +#define PI 3.1415926 + +float f(int n,int npts) +{ + return exp(-(1.0*n)/npts)*sin(2.0*PI*n/50.0) + +exp(-(2.0*n)/npts)*sin(2.2*PI*n/50.0); +} + +int main(void) +{ + int i; + float dum,*d,*future,*data; + + d=vector(1,NPOLES); + future=vector(1,NFUT); + data=vector(1,NPTS); + for (i=1;i<=NPTS;i++) + data[i]=f(i,NPTS); + memcof(data,NPTS,NPOLES,&dum,d); + fixrts(d,NPOLES); + predic(data,NPTS,d,NPOLES,future,NFUT); + printf("%6s %11s %12s\n","I","Actual","PREDIC"); + for (i=1;i<=NFUT;i++) + printf("%6d %12.6f %12.6f\n",i,f(i+NPTS,NPTS),future[i]); + free_vector(data,1,NPTS); + free_vector(future,1,NFUT); + free_vector(d,1,NPOLES); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xprobks.c b/lib/nr/ansi/examples/xprobks.c new file mode 100644 index 0000000..547aca6 --- /dev/null +++ b/lib/nr/ansi/examples/xprobks.c @@ -0,0 +1,35 @@ + +/* Driver for routine probks */ + +#include +#define NRANSI +#include "nr.h" + +#define NPTS 20 +#define EPS 0.1 +#define ISCAL 40 + +int main(void) +{ + int i,j,jmax; + char txt[ISCAL+1]; + float alam,aval; + + printf("probability function for kolmogorov-smirnov statistic\n\n"); + printf("%7s %10s %13s\n","lambda","value:","graph:"); + for (i=1;i<=NPTS;i++) { + alam=i*EPS; + aval=probks(alam); + jmax=(int) (0.5+(ISCAL-1)*aval); + for (j=0;j +#define NRANSI +#include "nr.h" + +int main(void) +{ + static unsigned long lword[5]={0,1,1,99,99}; + static unsigned long irword[5]={0,1,99,1,99}; + static char *ans[5]={ + "", + "0x604d1dce 0x509c0c23", + "0xd97f8571 0xa66cb41a", + "0x7822309d 0x64300984", + "0xd7f376f0 0x59ba89eb"}; + int i; + + for (i=1;i<=4;i++) { + psdes(&lword[i],&irword[i]); + printf("PSDES now calculates: 0x%x 0x%x\n",lword[i],irword[i]); + printf("Known correct answers are: %s\n",ans[i]); + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xpzextr.c b/lib/nr/ansi/examples/xpzextr.c new file mode 100644 index 0000000..83747fc --- /dev/null +++ b/lib/nr/ansi/examples/xpzextr.c @@ -0,0 +1,51 @@ + +/* Driver for routine pzextr */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NV 4 +#define IMAXX 10 + +float **d,*x; /* defining declaration */ + +int main(void) +{ + int i,iest,j; + float dum,xest,*dy,*yest,*yz; + + dy=vector(1,NV); + yest=vector(1,NV); + yz=vector(1,NV); + x=vector(1,IMAXX); + d=matrix(1,IMAXX,1,IMAXX); + /* Feed values from a rational function */ + /* fn(x)=(1-x+x**3)/(x+1)**n */ + for (i=1;i<=IMAXX;i++) { + iest=i; + xest=1.0/i; + dum=1.0-xest+xest*xest*xest; + for (j=1;j<=NV;j++) { + dum /= (xest+1.0); + yest[j]=dum; + } + pzextr(iest,xest,yest,yz,dy,NV); + printf("\ni = %2d",i); + printf("\nExtrap. function:"); + for (j=1;j<=NV;j++) printf("%12.6f",yz[j]); + printf("\nEstimated error: "); + for (j=1;j<=NV;j++) printf("%12.6f",dy[j]); + printf("\n"); + } + printf("\nactual values: %14.6f %11.6f %11.6f %11.6f\n", + 1.0,1.0,1.0,1.0); + free_matrix(d,1,IMAXX,1,IMAXX); + free_vector(x,1,IMAXX); + free_vector(yz,1,NV); + free_vector(yest,1,NV); + free_vector(dy,1,NV); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xqgaus.c b/lib/nr/ansi/examples/xqgaus.c new file mode 100644 index 0000000..a86d0f2 --- /dev/null +++ b/lib/nr/ansi/examples/xqgaus.c @@ -0,0 +1,33 @@ + +/* Driver for routine qgaus */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define X1 0.0 +#define X2 5.0 +#define NVAL 10 + +float func(float x) +{ + return x*exp(-x); +} + +int main(void) +{ + float dx,ss,x; + int i; + + dx=(X2-X1)/NVAL; + printf("\n%s %10s %13s\n\n","0.0 to","qgaus","expected"); + for (i=1;i<=NVAL;i++) { + x=X1+i*dx; + ss=qgaus(func,X1,x); + printf("%5.2f %12.6f %12.6f\n",x,ss, + (-(1.0+x)*exp(-x)+(1.0+X1)*exp(-X1))); + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xqrdcmp.c b/lib/nr/ansi/examples/xqrdcmp.c new file mode 100644 index 0000000..c489933 --- /dev/null +++ b/lib/nr/ansi/examples/xqrdcmp.c @@ -0,0 +1,115 @@ + +/* Driver for routine qrdcmp */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 20 +#define MAXSTR 80 + +int main(void) +{ + int i,j,k,l,m,n,sing; + float con,**a,*c,*d,**q,**qt,**r,**x; + char dummy[MAXSTR]; + FILE *fp; + + a=matrix(1,NP,1,NP); + c=vector(1,NP); + d=vector(1,NP); + q=matrix(1,NP,1,NP); + qt=matrix(1,NP,1,NP); + r=matrix(1,NP,1,NP); + x=matrix(1,NP,1,NP); + if ((fp = fopen("matrx1.dat","r")) == NULL) + nrerror("Data file matrx1.dat not found\n"); + while (!feof(fp)) { + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + fscanf(fp,"%d %d ",&n,&m); + fgets(dummy,MAXSTR,fp); + for (k=1;k<=n;k++) + for (l=1;l<=n;l++) fscanf(fp,"%f ",&a[k][l]); + fgets(dummy,MAXSTR,fp); + for (l=1;l<=m;l++) + for (k=1;k<=n;k++) fscanf(fp,"%f ",&x[k][l]); + /* Print out a-matrix for comparison with product of + Q and R decomposition matrices */ + printf("Original matrix:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",a[k][l]); + printf("\n"); + } + /* Perform the decomposition */ + qrdcmp(a,n,c,d,&sing); + if (sing) fprintf(stderr,"Singularity in QR decomposition.\n"); + /* find the Q and R matrices */ + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) { + if (l > k) { + r[k][l]=a[k][l]; + q[k][l]=0.0; + } else if (l < k) { + r[k][l]=q[k][l]=0.0; + } else { + r[k][l]=d[k]; + q[k][l]=1.0; + } + } + } + for (i=n-1;i>=1;i--) { + for (con=0.0,k=i;k<=n;k++) con += a[k][i]*a[k][i]; + con /= 2.0; + for (k=i;k<=n;k++) { + for (l=i;l<=n;l++) { + qt[k][l]=0.0; + for (j=i;j<=n;j++) { + qt[k][l] += q[j][l]*a[k][i]*a[j][i]/con; + } + } + } + for (k=i;k<=n;k++) + for (l=i;l<=n;l++) q[k][l] -= qt[k][l]; + } + /* compute product of Q and R matrices for comparison + with original matrix. */ + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) { + x[k][l]=0.0; + for (j=1;j<=n;j++) + x[k][l] += q[k][j]*r[j][l]; + } + } + printf("\nProduct of Q and R matrices:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",x[k][l]); + printf("\n"); + } + printf("\nQ matrix of the decomposition:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",q[k][l]); + printf("\n"); + } + printf("\nR matrix of the decomposition:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",r[k][l]); + printf("\n"); + } + printf("\n***********************************\n"); + printf("press return for next problem:\n"); + (void) getchar(); + } + fclose(fp); + free_matrix(x,1,NP,1,NP); + free_matrix(r,1,NP,1,NP); + free_matrix(qt,1,NP,1,NP); + free_matrix(q,1,NP,1,NP); + free_vector(d,1,NP); + free_vector(c,1,NP); + free_matrix(a,1,NP,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xqromb.c b/lib/nr/ansi/examples/xqromb.c new file mode 100644 index 0000000..3c9d691 --- /dev/null +++ b/lib/nr/ansi/examples/xqromb.c @@ -0,0 +1,33 @@ + +/* Driver for routine qromb */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define PIO2 1.5707963 + +/* Test function */ +float func(float x) +{ + return x*x*(x*x-2.0)*sin(x); +} + +/* Integral of test function func */ +float fint(float x) +{ + return 4.0*x*(x*x-7.0)*sin(x)-(pow(x,4.0)-14.0*x*x+28.0)*cos(x); +} + +int main(void) +{ + float a=0.0,b=PIO2,s; + + printf("Integral of func computed with QROMB\n\n"); + printf("Actual value of integral is %12.6f\n",fint(b)-fint(a)); + s=qromb(func,a,b); + printf("Result from routine QROMB is %11.6f\n",s); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xqromo.c b/lib/nr/ansi/examples/xqromo.c new file mode 100644 index 0000000..b255e6e --- /dev/null +++ b/lib/nr/ansi/examples/xqromo.c @@ -0,0 +1,62 @@ + +/* Driver for routine qromo */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define X1 0.0 +#define X2 1.5707963 +#define X3 3.1415926 +#define AINF 1.0E20 +#define PI 3.1415926 + +static float funcl(float x) +{ + return (float) (sqrt(x)/sin(x)); +} + +static float funcu(float x) +{ + return (float) (sqrt(PI-x)/sin(x)); +} + +static float fncinf(float x) +{ + + return (float) (sin(x)/(x*x)); +} + +static float fncend(float x) +{ + return (float) (exp(-x)/sqrt(x)); +} + +int main(void) +{ + float res1,res2,result; + + printf("\nImproper integrals:\n\n"); + result=qromo(funcl,X1,X2,midsql); + printf("Function: sqrt(x)/sin(x) Interval: (0,pi/2)\n"); + printf("Using: MIDSQL Result: %8.4f\n\n",result); + result=qromo(funcu,X2,X3,midsqu); + printf("Function: sqrt(pi-x)/sin(x) Interval: (pi/2,pi)\n"); + printf("Using: MIDSQU Result: %8.4f\n\n",result); + result=qromo(fncinf,X2,AINF,midinf); + printf("Function: sin(x)/x**2 Interval: (pi/2,infty)\n"); + printf("Using: MIDINF Result: %8.4f\n\n",result); + result=qromo(fncinf,-AINF,-X2,midinf); + printf("Function: sin(x)/x**2 Interval: (-infty,-pi/2)\n"); + printf("Using: MIDINF Result: %8.4f\n\n",result); + res1=qromo(fncend,X1,X2,midsql); + res2=qromo(fncend,X2,AINF,midinf); + printf("Function: exp(-x)/sqrt(x) Interval: (0.0,infty)\n"); + printf("Using: MIDSQL,MIDINF Result: %8.4f\n\n",res1+res2); + res2=qromo(fncend,X2,AINF,midexp); + printf("Function: exp(-x)/sqrt(x) Interval: (0.0,infty)\n"); + printf("Using: MIDSQL,MIDEXP Result: %8.4f\n\n",res1+res2); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xqroot.c b/lib/nr/ansi/examples/xqroot.c new file mode 100644 index 0000000..adee791 --- /dev/null +++ b/lib/nr/ansi/examples/xqroot.c @@ -0,0 +1,49 @@ + +/* Driver for routine qroot */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 6 /* degree of polynomial */ +#define EPS 1.0e-6 +#define NTRY 10 +#define TINY 1.0e-5 + +int main(void) +{ + int i,j,nflag,nroot=0; + static float p[N+1]={10.0,-18.0,25.0,-24.0,16.0,-6.0,1.0}; + float *b,*c; + + b=vector(1,NTRY); + c=vector(1,NTRY); + printf("\nP(x)=x^6-6x^5+16x^4-24x^3+25x^2-18x+10\n"); + printf("Quadratic factors x^2+bx+c\n\n"); + printf("%6s %10s %12s \n\n","factor","b","c"); + for (i=1;i<=NTRY;i++) { + c[i]=0.5*i; + b[i] = -0.5*i; + qroot(p,N,&b[i],&c[i],EPS); + if (nroot == 0) { + printf("%4d %15.6f %12.6f\n",nroot,b[i],c[i]); + nroot=1; + } else { + nflag=0; + for (j=1;j<=nroot;j++) + if ((fabs(b[i]-b[j]) < TINY) + && (fabs(c[i]-c[j]) < TINY)) + nflag=1; + if (nflag == 0) { + printf("%4d %15.6f %12.6f\n",nroot,b[i],c[i]); + ++nroot; + } + } + } + free_vector(c,1,NTRY); + free_vector(b,1,NTRY); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xqrsolv.c b/lib/nr/ansi/examples/xqrsolv.c new file mode 100644 index 0000000..731d5de --- /dev/null +++ b/lib/nr/ansi/examples/xqrsolv.c @@ -0,0 +1,75 @@ + +/* Driver for routine qrdcmp */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 20 +#define MAXSTR 80 + +int main(void) +{ + int j,k,l,m,n,sing; + float *x,**a,**ai,**b,*c,*d; + char dummy[MAXSTR]; + FILE *fp; + + x=vector(1,NP); + a=matrix(1,NP,1,NP); + b=matrix(1,NP,1,NP); + ai=matrix(1,NP,1,NP); + c=vector(1,NP); + d=vector(1,NP); + if ((fp = fopen("matrx1.dat","r")) == NULL) + nrerror("Data file matrx1.dat not found\n"); + while (!feof(fp)) { + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + fscanf(fp,"%d %d ",&n,&m); + fgets(dummy,MAXSTR,fp); + for (k=1;k<=n;k++) + for (l=1;l<=n;l++) fscanf(fp,"%f ",&a[k][l]); + fgets(dummy,MAXSTR,fp); + for (l=1;l<=m;l++) + for (k=1;k<=n;k++) fscanf(fp,"%f ",&b[k][l]); + /* Save matrix a for later testing */ + for (l=1;l<=n;l++) + for (k=1;k<=n;k++) ai[k][l]=a[k][l]; + /* Do qr decomposition */ + qrdcmp(a,n,c,d,&sing); + if (sing) fprintf(stderr,"Singularity in QR decomposition.\n"); + /* Solve equations for each right-hand vector */ + for (k=1;k<=m;k++) { + for (l=1;l<=n;l++) x[l]=b[l][k]; + qrsolv(a,n,c,d,x); + /* Test results with original matrix */ + printf("right-hand side vector:\n"); + for (l=1;l<=n;l++) + printf("%12.6f",b[l][k]); + printf("\n%s%s\n","result of matrix applied", + " to sol'n vector"); + for (l=1;l<=n;l++) { + b[l][k]=0.0; + for (j=1;j<=n;j++) + b[l][k] += (ai[l][j]*x[j]); + } + for (l=1;l<=n;l++) + printf("%12.6f",b[l][k]); + printf("\n*********************************\n"); + } + printf("press RETURN for next problem:\n"); + (void) getchar(); + } + fclose(fp); + free_vector(d,1,NP); + free_vector(c,1,NP); + free_matrix(ai,1,NP,1,NP); + free_matrix(b,1,NP,1,NP); + free_matrix(a,1,NP,1,NP); + free_vector(x,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xqrupdt.c b/lib/nr/ansi/examples/xqrupdt.c new file mode 100644 index 0000000..e505f63 --- /dev/null +++ b/lib/nr/ansi/examples/xqrupdt.c @@ -0,0 +1,159 @@ + +/* Driver for routine qrdupd */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 20 +#define MAXSTR 80 + +int main(void) +{ + int i,j,k,l,m,n,sing; + float con,**a,**au,*c,*d,**q,**qt,**r,**s,*u,*v,**x; + char dummy[MAXSTR]; + FILE *fp; + + a=matrix(1,NP,1,NP); + au=matrix(1,NP,1,NP); + c=vector(1,NP); + d=vector(1,NP); + q=matrix(1,NP,1,NP); + qt=matrix(1,NP,1,NP); + r=matrix(1,NP,1,NP); + s=matrix(1,NP,1,NP); + u=vector(1,NP); + v=vector(1,NP); + x=matrix(1,NP,1,NP); + if ((fp = fopen("matrx1.dat","r")) == NULL) + nrerror("Data file matrx1.dat not found\n"); + while (!feof(fp)) { + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + fscanf(fp,"%d %d ",&n,&m); + fgets(dummy,MAXSTR,fp); + for (k=1;k<=n;k++) + for (l=1;l<=n;l++) fscanf(fp,"%f ",&a[k][l]); + fgets(dummy,MAXSTR,fp); + for (l=1;l<=m;l++) + for (k=1;k<=n;k++) fscanf(fp,"%f ",&s[k][l]); + /* Print out a-matrix for comparison with product of + Q and R decomposition matrices */ + printf("Original matrix:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",a[k][l]); + printf("\n"); + } + /* updated matrix we'll use later */ + for (k=1;k<=n;k++) + for (l=1;l<=n;l++) + au[k][l]=a[k][l]+s[k][1]*s[l][2]; + /* Perform the decomposition */ + qrdcmp(a,n,c,d,&sing); + if (sing) fprintf(stderr,"Singularity in QR decomposition.\n"); + /* find the Q and R matrices */ + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) { + if (l > k) { + r[k][l]=a[k][l]; + q[k][l]=0.0; + } else if (l < k) { + r[k][l]=q[k][l]=0.0; + } else { + r[k][l]=d[k]; + q[k][l]=1.0; + } + } + } + for (i=n-1;i>=1;i--) { + for (con=0.0,k=i;k<=n;k++) con += a[k][i]*a[k][i]; + con /= 2.0; + for (k=i;k<=n;k++) { + for (l=i;l<=n;l++) { + qt[k][l]=0.0; + for (j=i;j<=n;j++) { + qt[k][l] += q[j][l]*a[k][i]*a[j][i]/con; + } + } + } + for (k=i;k<=n;k++) + for (l=i;l<=n;l++) q[k][l] -= qt[k][l]; + } + /* compute product of Q and R matrices for comparison + with original matrix. */ + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) { + x[k][l]=0.0; + for (j=1;j<=n;j++) + x[k][l] += q[k][j]*r[j][l]; + } + } + printf("\nProduct of Q and R matrices:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",x[k][l]); + printf("\n"); + } + printf("\nQ matrix of the decomposition:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",q[k][l]); + printf("\n"); + } + printf("\nR matrix of the decomposition:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",r[k][l]); + printf("\n"); + } + /* Q transpose */ + for (k=1;k<=n;k++) + for (l=1;l<=n;l++) + qt[k][l]=q[l][k]; + for (k=1;k<=n;k++) { + v[k]=s[k][2]; + for (u[k]=0.0,l=1;l<=n;l++) u[k] += qt[k][l]*s[l][1]; + } + qrupdt(r,qt,n,u,v); + for (k=1;k<=n;k++) + for (l=1;l<=n;l++) + for (x[k][l]=0.0,j=1;j<=n;j++) x[k][l] += qt[j][k]*r[j][l]; + printf("Updated matrix:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",au[k][l]); + printf("\n"); + } + printf("\nProduct of new Q and R matrices:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",x[k][l]); + printf("\n"); + } + printf("\nNew Q matrix:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",qt[l][k]); + printf("\n"); + } + printf("\nNew R matrix:\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) printf("%12.6f",r[k][l]); + printf("\n"); + } + printf("\n***********************************\n"); + printf("press return for next problem:\n"); + (void) getchar(); + } + fclose(fp); + free_matrix(x,1,NP,1,NP); + free_vector(v,1,NP); + free_vector(u,1,NP); + free_matrix(s,1,NP,1,NP); + free_matrix(r,1,NP,1,NP); + free_matrix(qt,1,NP,1,NP); + free_matrix(q,1,NP,1,NP); + free_vector(d,1,NP); + free_vector(c,1,NP); + free_matrix(au,1,NP,1,NP); + free_matrix(a,1,NP,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xqsimp.c b/lib/nr/ansi/examples/xqsimp.c new file mode 100644 index 0000000..450a25b --- /dev/null +++ b/lib/nr/ansi/examples/xqsimp.c @@ -0,0 +1,33 @@ + +/* Driver for routine qsimp */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define PIO2 1.5707963 + +/* Test function */ +float func(float x) +{ + return x*x*(x*x-2.0)*sin(x); +} + +/* Integral of test function */ +float fint(float x) +{ + return 4.0*x*(x*x-7.0)*sin(x)-(pow(x,4.0)-14.0*x*x+28.0)*cos(x); +} + +int main(void) +{ + float a=0.0,b=PIO2,s; + + printf("Integral of func computed with QSIMP\n\n"); + printf("Actual value of integral is %12.6f\n",fint(b)-fint(a)); + s=qsimp(func,a,b); + printf("Result from routine QSIMP is %11.6f\n",s); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xqtrap.c b/lib/nr/ansi/examples/xqtrap.c new file mode 100644 index 0000000..1c01c6e --- /dev/null +++ b/lib/nr/ansi/examples/xqtrap.c @@ -0,0 +1,33 @@ + +/* Driver for routine qtrap */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define PIO2 1.5707963 + +/* Test function */ +float func(float x) +{ + return x*x*(x*x-2.0)*sin(x); +} + +/* Integral of test function */ +float fint(float x) +{ + return 4.0*x*(x*x-7.0)*sin(x)-(pow(x,4.0)-14.0*x*x+28.0)*cos(x); +} + +int main(void) +{ + float a=0.0,b=PIO2,s; + + printf("Integral of func computed with QTRAP\n\n"); + printf("Actual value of integral is %12.6f\n",fint(b)-fint(a)); + s=qtrap(func,a,b); + printf("Result from routine QTRAP is %12.6f\n",s); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xquad3d.c b/lib/nr/ansi/examples/xquad3d.c new file mode 100644 index 0000000..7ddf442 --- /dev/null +++ b/lib/nr/ansi/examples/xquad3d.c @@ -0,0 +1,55 @@ + +/* Driver for routine quad3d */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define PI 3.1415927 +#define NVAL 10 + +static float xmax; + +float func(float x,float y,float z) +{ + return x*x+y*y+z*z; +} + +float z1(float x,float y) +{ + return (float) -sqrt(xmax*xmax-x*x-y*y); +} + +float z2(float x,float y) +{ + return (float) sqrt(xmax*xmax-x*x-y*y); +} + +float yy1(float x) +{ + return (float) -sqrt(xmax*xmax-x*x); +} + +float yy2(float x) +{ + return (float) sqrt(xmax*xmax-x*x); +} + +int main(void) +{ + int i; + float xmin,s; + + printf("Integral of r^2 over a spherical volume\n\n"); + printf("%13s %10s %11s\n","radius","QUAD3D","Actual"); + for (i=1;i<=NVAL;i++) { + xmax=0.1*i; + xmin = -xmax; + s=quad3d(func,xmin,xmax); + printf("%12.2f %12.6f %11.6f\n", + xmax,s,4.0*PI*pow(xmax,5.0)/5.0); + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xran.c b/lib/nr/ansi/examples/xran.c new file mode 100644 index 0000000..8a40459 --- /dev/null +++ b/lib/nr/ansi/examples/xran.c @@ -0,0 +1,57 @@ + +/* Driver for routines ran0, ran1, ran2, ran3 */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define PI 3.1415926 + +static unsigned long twotoj[16]={0x1L,0x2L,0x4L,0x8L,0x10L,0x20L,0x40L,0x80L, + 0x100L,0x200L,0x400L,0x800L,0x1000L,0x2000L,0x4000L,0x8000L}; + +float fnc(float x1,float x2,float x3,float x4) +{ + return (float) sqrt(x1*x1+x2*x2+x3*x3+x4*x4); +} + +void integ(float (*func)(long *)) +{ + long idum=(-1),iy[4],jpower,k; + int i,j; + float x1,x2,x3,x4,yprob[4]; + + /* Calculates pi statistically using volume of unit n-sphere */ + for (i=1;i<=3;i++) iy[i]=0; + printf("volume of unit n-sphere, n = 2, 3, 4\n"); + printf("# points pi (4/3)*pi (1/2)*pi^2\n\n"); + for (j=1;j<=15;j++) { + for (k=twotoj[j-1];k>=0;k--) { + x1=(*func)(&idum); + x2=(*func)(&idum); + x3=(*func)(&idum); + x4=(*func)(&idum); + if (fnc(x1,x2,0.0,0.0) < 1.0) ++iy[1]; + if (fnc(x1,x2,x3,0.0) < 1.0) ++iy[2]; + if (fnc(x1,x2,x3,x4) < 1.0) ++iy[3]; + } + jpower=twotoj[j]; + for (i=1;i<=3;i++) + yprob[i]=(float) twotoj[i+1]*iy[i]/jpower; + printf("%6ld %12.6f %12.6f %12.6f\n", + jpower,yprob[1],yprob[2],yprob[3]); + } + printf("\nactual %12.6f %12.6f %12.6f\n", + PI,4.0*PI/3.0,0.5*PI*PI); +} + +int main(void) +{ + printf("\nTesting ran0:\n"); integ(ran0); + printf("\nTesting ran1:\n"); integ(ran1); + printf("\nTesting ran2:\n"); integ(ran2); + printf("\nTesting ran3:\n"); integ(ran3); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xran4.c b/lib/nr/ansi/examples/xran4.c new file mode 100644 index 0000000..204f593 --- /dev/null +++ b/lib/nr/ansi/examples/xran4.c @@ -0,0 +1,26 @@ + +/* Driver for routine ran4 */ + +#include +#define NRANSI +#include "nr.h" + +int main(void) +{ + int i; + static long idum[5]={0,-1,99,-99,99}; + static char *ansvax[5]={"","0.275898","0.208204","0.034307","0.838676"}; + static char *ansiee[5]={"","0.219120","0.849246","0.375290","0.457334"}; + float random[5]; + + for (i=1;i<=4;i++) random[i]=ran4(&idum[i]); + printf("ran4 gets values: "); + for (i=1;i<=4;i++) printf("%15.6f",random[i]); + printf("\n IEEE answers: "); + for (i=1;i<=4;i++) printf("%15s",ansiee[i]); + printf("\n VAX answers: "); + for (i=1;i<=4;i++) printf("%15s",ansvax[i]); + printf("\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrank.c b/lib/nr/ansi/examples/xrank.c new file mode 100644 index 0000000..a4dd8e5 --- /dev/null +++ b/lib/nr/ansi/examples/xrank.c @@ -0,0 +1,57 @@ + +/* Driver for routine rank */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 100 +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + unsigned long i,j,k,l,*indx,*irank; + float *a,b[11]; + FILE *fp; + + indx=lvector(1,NP); + irank=lvector(1,NP); + a=vector(1,NP); + if ((fp = fopen("tarray.dat","r")) == NULL) + nrerror("Data file tarray.dat not found\n"); + fgets(txt,MAXSTR,fp); + for (i=1;i<=NP;i++) fscanf(fp,"%f",&a[i]); + fclose(fp); + indexx(NP,a,indx); + rank(NP,indx,irank); + printf("original array is:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + printf("table of ranks is:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7d",irank[10*i+j]); + printf("\n"); + } + printf("press return to continue...\n"); + (void) getchar(); + printf("array sorted according to rank table:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) { + k=10*i+j; + for (l=1;l<=NP;l++) + if (irank[l] == k) b[j]=a[l]; + } + for (j=1;j<=10;j++) printf("%7.2f",b[j]); + printf("\n"); + } + free_vector(a,1,NP); + free_lvector(irank,1,NP); + free_lvector(indx,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xratint.c b/lib/nr/ansi/examples/xratint.c new file mode 100644 index 0000000..9635db7 --- /dev/null +++ b/lib/nr/ansi/examples/xratint.c @@ -0,0 +1,41 @@ + +/* Driver for routine ratint */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPT 6 +#define EPS 1.0 + +float f(float x,float eps) +{ + return x*exp(-x)/(SQR(x-1.0)+eps*eps); +} + +int main(void) +{ + int i; + float dyy,xx,yexp,yy,*x,*y; + + x=vector(1,NPT); + y=vector(1,NPT); + for (i=1;i<=NPT;i++) { + x[i]=i*2.0/NPT; + y[i]=f(x[i],EPS); + } + printf("\nDiagonal rational function interpolation\n"); + printf("\n%5s %13s %14s %12s\n","x","interp.","accuracy","actual"); + for (i=1;i<=10;i++) { + xx=0.2*i; + ratint(x,y,NPT,xx,&yy,&dyy); + yexp=f(xx,EPS); + printf("%6.2f %12.6f %11f %13.6f\n",xx,yy,dyy,yexp); + } + free_vector(y,1,NPT); + free_vector(x,1,NPT); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xratlsq.c b/lib/nr/ansi/examples/xratlsq.c new file mode 100644 index 0000000..ec5fdc6 --- /dev/null +++ b/lib/nr/ansi/examples/xratlsq.c @@ -0,0 +1,41 @@ + +/* Driver for routine ratlsq */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NMAX 100 + +double fn(double t) +{ + return atan(t); +} + +int main(void) +{ + int j,kk,mm; + double a,b,*cof,dev,eee,fit,xs; + + cof=dvector(0,NMAX); + for (;;) { + printf("enter a,b,mm,kk\n"); + if (scanf("%lf %lf %d %d",&a,&b,&mm,&kk) == EOF) break; + ratlsq(fn,a,b,mm,kk,cof,&dev); + for (j=0;j<=mm+kk;j++) printf("cof(%3d)=%27.15e\n",j,cof[j]); + printf("maximum absolute deviation= %12.6f\n",dev); + printf(" x error exact\n"); + printf("--------- ------------ ---------\n"); + for (j=1;j<=50;j++) { + xs=a+(b-a)*(j-1.0)/49.0; + fit=ratval(xs,cof,mm,kk); + eee=fn(xs); + printf("%10.5f %15.7e %15.7e\n",xs,fit-eee,eee); + } + } + free_dvector(cof,0,NMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrc.c b/lib/nr/ansi/examples/xrc.c new file mode 100644 index 0000000..586dfdf --- /dev/null +++ b/lib/nr/ansi/examples/xrc.c @@ -0,0 +1,37 @@ + +/* Driver for routine rc */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,x,y; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Elliptic Integral Degenerate RC",31)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%7s %8s %16s %18s\n","x","y","actual","rc(x,y)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f",&x,&y,&val); + printf("%8.2f %8.2f %18.6e %18.6e\n",x,y,val,rc(x,y)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrd.c b/lib/nr/ansi/examples/xrd.c new file mode 100644 index 0000000..d3de753 --- /dev/null +++ b/lib/nr/ansi/examples/xrd.c @@ -0,0 +1,37 @@ + +/* Driver for routine rd */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,x,y,z; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Elliptic Integral Second Kind RD",32)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%7s %8s %8s %16s %20s\n","x","y","z","actual","rd(x,y,z)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f %f",&x,&y,&z,&val); + printf("%8.2f %8.2f %8.2f %18.6e %18.6e\n",x,y,z,val,rd(x,y,z)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrealft.c b/lib/nr/ansi/examples/xrealft.c new file mode 100644 index 0000000..2600e56 --- /dev/null +++ b/lib/nr/ansi/examples/xrealft.c @@ -0,0 +1,66 @@ + +/* Driver for routine realft */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define EPS 1.0e-3 +#define NP 32 +#define WIDTH 50.0 +#define PI 3.1415926 + +int main(void) +{ + int i,j,n=NP/2,nlim; + float big,per,scal,small,*data,*size; + + data=vector(1,NP); + size=vector(1,NP/2+1); + for (;;) { + printf("Period of sinusoid in channels (2-%2d)\n",NP); + scanf("%f",&per); + if (per <= 0.0) break; + for (i=1;i<=NP;i++) + data[i]=cos(2.0*PI*(i-1)/per); + realft(data,NP,1); + big = -1.0e10; + for (i=2;i<=n;i++) { + size[i]=sqrt(SQR(data[2*i-1])+SQR(data[2*i])); + if (size[i] > big) big=size[i]; + } + size[1]=fabs(data[1]); + if (size[1] > big) big=size[1]; + size[n+1]=fabs(data[2]); + if (size[n+1] > big) big=size[n+1]; + scal=WIDTH/big; + for (i=1;i<=n;i++) { + nlim=(int) (0.5+scal*size[i]+EPS); + printf("%4d ",i); + for (j=1;j<=nlim+1;j++) printf("*"); + printf("\n"); + } + printf("press RETURN to continue ...\n"); + (void) getchar(); + realft(data,NP,-1); + big = -1.0e10; + small=1.0e10; + for (i=1;i<=NP;i++) { + if (data[i] < small) small=data[i]; + if (data[i] > big) big=data[i]; + } + scal=WIDTH/(big-small); + for (i=1;i<=NP;i++) { + nlim=(int) (0.5+scal*(data[i]-small)+EPS); + printf("%4d ",i); + for (j=1;j<=nlim+1;j++) printf("*"); + printf("\n"); + } + } + free_vector(size,1,NP/2+1); + free_vector(data,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrf.c b/lib/nr/ansi/examples/xrf.c new file mode 100644 index 0000000..75a0373 --- /dev/null +++ b/lib/nr/ansi/examples/xrf.c @@ -0,0 +1,37 @@ + +/* Driver for routine rf */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float val,x,y,z; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Elliptic Integral First Kind RF",31)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%7s %8s %8s %16s %20s\n","x","y","z","actual","rf(x,y,z)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f %f",&x,&y,&z,&val); + printf("%8.2f %8.2f %8.2f %18.6e %18.6e\n",x,y,z,val,rf(x,y,z)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrj.c b/lib/nr/ansi/examples/xrj.c new file mode 100644 index 0000000..58bee1e --- /dev/null +++ b/lib/nr/ansi/examples/xrj.c @@ -0,0 +1,37 @@ + +/* Driver for routine rj */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float p,val,x,y,z; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Elliptic Integral Third Kind RJ",31)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%7s %8s %8s %8s %16s %20s\n","x","y","z","p","actual","rj(x,y,z,p)"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f %f %f",&x,&y,&z,&p,&val); + printf("%8.2f %8.2f %8.2f %8.2f %18.6e %18.6e\n",x,y,z,p,val,rj(x,y,z,p)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrk4.c b/lib/nr/ansi/examples/xrk4.c new file mode 100644 index 0000000..cf0e2e3 --- /dev/null +++ b/lib/nr/ansi/examples/xrk4.c @@ -0,0 +1,48 @@ + +/* Driver for routine rk4 */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 4 + +void derivs(float x,float y[],float dydx[]) +{ + dydx[1] = -y[2]; + dydx[2]=y[1]-(1.0/x)*y[2]; + dydx[3]=y[2]-(2.0/x)*y[3]; + dydx[4]=y[3]-(3.0/x)*y[4]; +} + +int main(void) +{ + int i,j; + float h,x=1.0,*y,*dydx,*yout; + + y=vector(1,N); + dydx=vector(1,N); + yout=vector(1,N); + y[1]=bessj0(x); + y[2]=bessj1(x); + y[3]=bessj(2,x); + y[4]=bessj(3,x); + derivs(x,y,dydx); + printf("\n%16s %5s %12s %12s %12s\n", + "Bessel function:","j0","j1","j3","j4"); + for (i=1;i<=5;i++) { + h=0.2*i; + rk4(y,dydx,N,x,h,yout,derivs); + printf("\nfor a step size of: %6.2f\n",h); + printf("%12s","rk4:"); + for (j=1;j<=4;j++) printf(" %12.6f",yout[j]); + printf("\n%12s %12.6f %12.6f %12.6f %12.6f\n","actual:", + bessj0(x+h),bessj1(x+h),bessj(2,x+h),bessj(3,x+h)); + } + free_vector(yout,1,N); + free_vector(dydx,1,N); + free_vector(y,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrkdumb.c b/lib/nr/ansi/examples/xrkdumb.c new file mode 100644 index 0000000..e270b52 --- /dev/null +++ b/lib/nr/ansi/examples/xrkdumb.c @@ -0,0 +1,45 @@ + +/* Driver for routine rkdumb */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NVAR 4 +#define NSTEP 150 + +void derivs(float x,float y[],float dydx[]) +{ + dydx[1] = -y[2]; + dydx[2]=y[1]-(1.0/x)*y[2]; + dydx[3]=y[2]-(2.0/x)*y[3]; + dydx[4]=y[3]-(3.0/x)*y[4]; +} + +extern float **y,*xx; /* referencing declaration */ + +int main(void) +{ + int j; + float x1=1.0,x2=20.0,*vstart; + + vstart=vector(1,NVAR); + /* Note: The arrays xx and y must have indices up to NSTEP+1 */ + xx=vector(1,NSTEP+1); + y=matrix(1,NVAR,1,NSTEP+1); + vstart[1]=bessj0(x1); + vstart[2]=bessj1(x1); + vstart[3]=bessj(2,x1); + vstart[4]=bessj(3,x1); + rkdumb(vstart,NVAR,x1,x2,NSTEP,derivs); + printf("%8s %17s %10s\n","x","integrated","bessj3"); + for (j=10;j<=NSTEP;j+=10) + printf("%10.4f %14.6f %12.6f\n", + xx[j],y[4][j],bessj(3,xx[j])); + free_matrix(y,1,NVAR,1,NSTEP+1); + free_vector(xx,1,NSTEP+1); + free_vector(vstart,1,NVAR); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrkqs.c b/lib/nr/ansi/examples/xrkqs.c new file mode 100644 index 0000000..84964cf --- /dev/null +++ b/lib/nr/ansi/examples/xrkqs.c @@ -0,0 +1,55 @@ + +/* Driver for routine rkqs */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 4 + +void derivs(float x,float y[],float dydx[]) +{ + dydx[1] = -y[2]; + dydx[2]=y[1]-(1.0/x)*y[2]; + dydx[3]=y[2]-(2.0/x)*y[3]; + dydx[4]=y[3]-(3.0/x)*y[4]; +} + +int main(void) +{ + int i,j; + float eps,hdid,hnext,htry,x=1.0,*y,*dydx,*dysav,*ysav,*yscal; + + y=vector(1,N); + dydx=vector(1,N); + dysav=vector(1,N); + ysav=vector(1,N); + yscal=vector(1,N); + ysav[1]=bessj0(x); + ysav[2]=bessj1(x); + ysav[3]=bessj(2,x); + ysav[4]=bessj(3,x); + derivs(x,ysav,dysav); + for (i=1;i<=N;i++) yscal[i]=1.0; + htry=0.6; + printf("%10s %11s %12s %13s\n","eps","htry","hdid","hnext"); + for (i=1;i<=15;i++) { + eps=exp((double) -i); + x=1.0; + for (j=1;j<=N;j++) { + y[j]=ysav[j]; + dydx[j]=dysav[j]; + } + rkqs(y,dydx,N,&x,htry,eps,yscal,&hdid,&hnext,derivs); + printf("%13f %8.2f %14.6f %12.6f \n",eps,htry,hdid,hnext); + } + free_vector(yscal,1,N); + free_vector(ysav,1,N); + free_vector(dysav,1,N); + free_vector(dydx,1,N); + free_vector(y,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrlft3.c b/lib/nr/ansi/examples/xrlft3.c new file mode 100644 index 0000000..42c5231 --- /dev/null +++ b/lib/nr/ansi/examples/xrlft3.c @@ -0,0 +1,68 @@ + +/* Driver for routine rlft3 */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" +#define IPRNT 20 + +static unsigned long compare(char *string, float ***arr1, float ***arr2, + unsigned long len1, unsigned long len2, unsigned long len3, float eps) +{ + unsigned long err=0,i1,i2,i3; + float a1,a2; + + printf("%s\n",string); + for (i1=1;i1<=len1;i1++) + for (i2=1;i2<=len2;i2++) + for (i3=1;i3<=len3;i3++) { + a1=arr1[i1][i2][i3]; + a2=arr2[i1][i2][i3]; + if ((a2 == 0.0 && fabs(a1-a2) > eps) || (fabs((a1-a2)/a2) > eps)) { + if (++err <= IPRNT) + printf("%d %d %d %12.6f %12.6f\n", + i1,i2,i3,a1,a2); + } + } + return err; +} + +#define NX 32 +#define NY 8 +#define NZ 16 + +#define EPS 0.0008 + +int main(void) +{ + long idum=(-3); + unsigned long err,i,j,k,nn1=NX,nn2=NY,nn3=NZ; + float fnorm,***data1,***data2,**speq1; + + fnorm=(float)nn1*(float)nn2*(float)nn3/2.0; + data1=f3tensor(1,nn1,1,nn2,1,nn3); + data2=f3tensor(1,nn1,1,nn2,1,nn3); + speq1=matrix(1,nn1,1,nn2<<1); + for (i=1;i<=nn1;i++) + for (j=1;j<=nn2;j++) + for (k=1;k<=nn3;k++) + data2[i][j][k]=fnorm*(data1[i][j][k]=2*ran1(&idum)-1); + rlft3(data1,speq1,nn1,nn2,nn3,1); + /* here would be any processing in Fourier space */ + rlft3(data1,speq1,nn1,nn2,nn3,-1); + err=compare("data",data1,data2,nn1,nn2,nn3,EPS); + if (err) { + printf("Comparison error at tolerance %12.6f\n",EPS); + printf("Total number of errors is %d\n",err); + } + else { + printf("Data compares OK to tolerance %12.6f\n",EPS); + } + free_matrix(speq1,1,nn1,1,nn2<<1); + free_f3tensor(data2,1,nn1,1,nn2,1,nn3); + free_f3tensor(data1,1,nn1,1,nn2,1,nn3); + return (err > 0); +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrofunc.c b/lib/nr/ansi/examples/xrofunc.c new file mode 100644 index 0000000..1499a6f --- /dev/null +++ b/lib/nr/ansi/examples/xrofunc.c @@ -0,0 +1,41 @@ + +/* Driver for routine rofunc */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define SPREAD 0.05 +#define NDATA 100 + +int ndatat; /* defining declaration */ +float *xt,*yt,aa,abdevt; /* defining declaration */ + +int main(void) +{ + long idum=(-11); + int i; + float b,rf,*x,*y; + + x=vector(1,NDATA); + y=vector(1,NDATA); + ndatat=NDATA; + xt=x; + yt=y; + for (i=1;i<=NDATA;i++) { + x[i]=0.1*i; + y[i] = -2.0*x[i]+1.0+SPREAD*gasdev(&idum); + } + printf("%9s %9s %12s %10s\n","b","a","ROFUNC","ABDEVT"); + for (i = -5;i<=5;i++) { + b = -2.0+0.02*i; + rf=rofunc(b); + printf("%10.2f %9.2f %11.2f %10.2f\n", + b,aa,rf,abdevt); + } + free_vector(y,1,NDATA); + free_vector(x,1,NDATA); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrtbis.c b/lib/nr/ansi/examples/xrtbis.c new file mode 100644 index 0000000..190c271 --- /dev/null +++ b/lib/nr/ansi/examples/xrtbis.c @@ -0,0 +1,38 @@ + +/* Driver for routine rtbis */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 100 +#define NBMAX 20 +#define X1 1.0 +#define X2 50.0 + +static float fx(float x) +{ + return bessj0(x); +} + +int main(void) +{ + int i,nb=NBMAX; + float xacc,root,*xb1,*xb2; + + xb1=vector(1,NBMAX); + xb2=vector(1,NBMAX); + zbrak(fx,X1,X2,N,xb1,xb2,&nb); + printf("\nRoots of bessj0:\n"); + printf("%21s %15s\n","x","f(x)"); + for (i=1;i<=nb;i++) { + xacc=(1.0e-6)*(xb1[i]+xb2[i])/2.0; + root=rtbis(fx,xb1[i],xb2[i],xacc); + printf("root %3d %14.6f %14.6f\n",i,root,fx(root)); + } + free_vector(xb2,1,NBMAX); + free_vector(xb1,1,NBMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrtflsp.c b/lib/nr/ansi/examples/xrtflsp.c new file mode 100644 index 0000000..2a009ea --- /dev/null +++ b/lib/nr/ansi/examples/xrtflsp.c @@ -0,0 +1,38 @@ + +/* Driver for routine rtflsp */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 100 +#define NBMAX 20 +#define X1 1.0 +#define X2 50.0 + +static float fx(float x) +{ + return bessj0(x); +} + +int main(void) +{ + int i,nb=NBMAX; + float xacc,root,*xb1,*xb2; + + xb1=vector(1,NBMAX); + xb2=vector(1,NBMAX); + zbrak(fx,X1,X2,N,xb1,xb2,&nb); + printf("\nRoots of bessj0:\n"); + printf("%21s %15s\n","x","f(x)"); + for (i=1;i<=nb;i++) { + xacc=(1.0e-6)*(xb1[i]+xb2[i])/2.0; + root=rtflsp(fx,xb1[i],xb2[i],xacc); + printf("root %3d %14.6f %14.6f\n",i,root,fx(root)); + } + free_vector(xb2,1,NBMAX); + free_vector(xb1,1,NBMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrtnewt.c b/lib/nr/ansi/examples/xrtnewt.c new file mode 100644 index 0000000..a103c07 --- /dev/null +++ b/lib/nr/ansi/examples/xrtnewt.c @@ -0,0 +1,44 @@ + +/* Driver for routine rtnewt */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 100 +#define NBMAX 20 +#define X1 1.0 +#define X2 50.0 + +static float fx(float x) +{ + return bessj0(x); +} + +static void funcd(float x,float *fn, float *df) +{ + *fn=bessj0(x); + *df = -bessj1(x); +} + +int main(void) +{ + int i,nb=NBMAX; + float xacc,root,*xb1,*xb2; + + xb1=vector(1,NBMAX); + xb2=vector(1,NBMAX); + zbrak(fx,X1,X2,N,xb1,xb2,&nb); + printf("\nRoots of bessj0:\n"); + printf("%21s %15s\n","x","f(x)"); + for (i=1;i<=nb;i++) { + xacc=(1.0e-6)*(xb1[i]+xb2[i])/2.0; + root=rtnewt(funcd,xb1[i],xb2[i],xacc); + printf("root %3d %14.6f %14.6f\n",i,root,fx(root)); + } + free_vector(xb2,1,NBMAX); + free_vector(xb1,1,NBMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrtsafe.c b/lib/nr/ansi/examples/xrtsafe.c new file mode 100644 index 0000000..26313b5 --- /dev/null +++ b/lib/nr/ansi/examples/xrtsafe.c @@ -0,0 +1,44 @@ + +/* Driver for routine rtsafe */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 100 +#define NBMAX 20 +#define X1 1.0 +#define X2 50.0 + +static float fx(float x) +{ + return bessj0(x); +} + +static void funcd(float x,float *fn, float *df) +{ + *fn=bessj0(x); + *df = -bessj1(x); +} + +int main(void) +{ + int i,nb=NBMAX; + float xacc,root,*xb1,*xb2; + + xb1=vector(1,NBMAX); + xb2=vector(1,NBMAX); + zbrak(fx,X1,X2,N,xb1,xb2,&nb); + printf("\nRoots of bessj0:\n"); + printf("%21s %15s\n","x","f(x)"); + for (i=1;i<=nb;i++) { + xacc=(1.0e-6)*(xb1[i]+xb2[i])/2.0; + root=rtsafe(funcd,xb1[i],xb2[i],xacc); + printf("root %3d %14.6f %14.6f\n",i,root,fx(root)); + } + free_vector(xb2,1,NBMAX); + free_vector(xb1,1,NBMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrtsec.c b/lib/nr/ansi/examples/xrtsec.c new file mode 100644 index 0000000..ec709d3 --- /dev/null +++ b/lib/nr/ansi/examples/xrtsec.c @@ -0,0 +1,38 @@ + +/* Driver for routine rtsec */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 100 +#define NBMAX 20 +#define X1 1.0 +#define X2 50.0 + +static float fx(float x) +{ + return bessj0(x); +} + +int main(void) +{ + int i,nb=NBMAX; + float xacc,root,*xb1,*xb2; + + xb1=vector(1,NBMAX); + xb2=vector(1,NBMAX); + zbrak(fx,X1,X2,N,xb1,xb2,&nb); + printf("\nRoots of bessj0:\n"); + printf("%21s %15s\n","x","f(x)"); + for (i=1;i<=nb;i++) { + xacc=(1.0e-6)*(xb1[i]+xb2[i])/2.0; + root=rtsec(fx,xb1[i],xb2[i],xacc); + printf("root %3d %14.6f %14.6f\n",i,root,fx(root)); + } + free_vector(xb2,1,NBMAX); + free_vector(xb1,1,NBMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xrzextr.c b/lib/nr/ansi/examples/xrzextr.c new file mode 100644 index 0000000..0ecaace --- /dev/null +++ b/lib/nr/ansi/examples/xrzextr.c @@ -0,0 +1,52 @@ + +/* Driver for routine rzextr */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NV 4 +#define IMAXX 10 + +float **d,*x; /* defining declaration */ + +int main(void) +{ + int i,iest,j; + float dum,xest,*dy,*yest,*yz; + + dy=vector(1,NV); + yest=vector(1,NV); + yz=vector(1,NV); + x=vector(1,IMAXX); + d=matrix(1,IMAXX,1,IMAXX); + /* Feed values from a rational function */ + /* fn(x)=(1-x+x**3)/(x+1)**n */ + for (i=1;i<=IMAXX;i++) { + iest=i; + xest=1.0/i; + dum=1.0-xest+xest*xest*xest; + for (j=1;j<=NV;j++) { + dum /= (xest+1.0); + yest[j]=dum; + } + rzextr(iest,xest,yest,yz,dy,NV); + printf("\n%s %2d %s %8.4f\n", + "iest = ",i," xest =",xest); + printf("Extrap. function: "); + for (j=1;j<=NV;j++) printf("%12.6f",yz[j]); + printf("\nEstimated error: "); + for (j=1;j<=NV;j++) printf("%12.6f",dy[j]); + printf("\n"); + } + printf("\nActual values: %15.6f %11.6f %11.6f %11.6f \n", + 1.0,1.0,1.0,1.0); + free_matrix(d,1,IMAXX,1,IMAXX); + free_vector(x,1,IMAXX); + free_vector(yz,1,NV); + free_vector(yest,1,NV); + free_vector(dy,1,NV); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsavgol.c b/lib/nr/ansi/examples/xsavgol.c new file mode 100644 index 0000000..f7f6b3b --- /dev/null +++ b/lib/nr/ansi/examples/xsavgol.c @@ -0,0 +1,48 @@ + +/* Driver for routine savgol */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NMAX 1000 +#define NTEST 6 + +int main(void) +{ + int i,j,m,nl,np,nr; + float *c,sum; + static int mtest[NTEST+1]={0,2,2,2,2,4,4}; + static int nltest[NTEST+1]={0,2,3,4,5,4,5}; + static int nrtest[NTEST+1]={0,2,1,0,5,4,5}; + static char *ans[NTEST+1]={"", +" -0.086 0.343 0.486 0.343 -0.086", +" -0.143 0.171 0.343 0.371 0.257", +" 0.086 -0.143 -0.086 0.257 0.886", +" -0.084 0.021 0.103 0.161 0.196 0.207 0.196 0.161 0.103 0.021 -0.084", +" 0.035 -0.128 0.070 0.315 0.417 0.315 0.070 -0.128 0.035", +" 0.042 -0.105 -0.023 0.140 0.280 0.333 0.280 0.140 -0.023 -0.105 0.042"}; + + c=vector(1,NMAX); + printf("M nl nr\n"); + printf("\t\t\tSample Savitzky-Golay Coefficients\n"); + for (i=1;i<=NTEST;i++) { + m=mtest[i]; + nl=nltest[i]; + nr=nrtest[i]; + np=nl+nr+1; + savgol(c,np,nl,nr,0,m); + for (sum=0.0,j=1;j<=np;j++) sum += c[j]; + printf("%1d %1d %1d\n",m,nl,nr); + for (j=nl;j<5;j++) printf("%7s"," "); + for (j=nl+1;j>=1;j--) printf("%7.3f",c[j]); + for (j=0;j +#define NRANSI +#include "nr.h" + +static float fx(float x) +{ + return bessj0(x); +} + +int main(void) +{ + scrsho(fx); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xselect.c b/lib/nr/ansi/examples/xselect.c new file mode 100644 index 0000000..86400d2 --- /dev/null +++ b/lib/nr/ansi/examples/xselect.c @@ -0,0 +1,41 @@ + +/* Driver for routine select */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 +#define NP 100 + +int main(void) +{ + char txt[MAXSTR]; + unsigned long i,k; + float *a,*b,q,s; + FILE *fp; + + a=vector(1,NP); + b=vector(1,NP); + if ((fp = fopen("tarray.dat","r")) == NULL) + nrerror("Data file tarray.dat not found\n"); + fgets(txt,MAXSTR,fp); + for (i=1;i<=NP;i++) fscanf(fp,"%f",&a[i]); + fclose(fp); + for (;;) { + printf("Input k\n"); + if (scanf("%lu",&k) == EOF) break; + for (i=1;i<=NP;i++) b[i]=a[i]; + s=selip(k,NP,a); + q=select(k,NP,b); + printf("Element in sort position %lu is %6.2f\n",k,q); + printf("Cross-check from SELIP routine %6.2f\n",s); + } + free_vector(b,1,NP); + free_vector(a,1,NP); + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xselip.c b/lib/nr/ansi/examples/xselip.c new file mode 100644 index 0000000..6987fd1 --- /dev/null +++ b/lib/nr/ansi/examples/xselip.c @@ -0,0 +1,49 @@ + +/* Driver for routine selip */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 +#define NP 100 + +int main(void) +{ + char txt[MAXSTR]; + unsigned long i,j,k; + float *a,*b,q; + FILE *fp; + + a=vector(1,NP); + b=vector(1,NP); + if ((fp = fopen("tarray.dat","r")) == NULL) + nrerror("Data file tarray.dat not found\n"); + fgets(txt,MAXSTR,fp); + for (i=1;i<=NP;i++) fscanf(fp,"%f",&a[i]); + fclose(fp); + printf("\noriginal array:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + for (i=1;i<=NP;i++) b[i]=selip(i,100,a); + printf("\nsorted array:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",b[10*i+j]); + printf("\n"); + } + for (;;) { + printf("Input k\n"); + if (scanf("%lu",&k) == EOF) break; + q=selip(k,NP,a); + printf("Element in sort position %lu is %6.2f\n",k,q); + } + free_vector(b,1,NP); + free_vector(a,1,NP); + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xshell.c b/lib/nr/ansi/examples/xshell.c new file mode 100644 index 0000000..9670123 --- /dev/null +++ b/lib/nr/ansi/examples/xshell.c @@ -0,0 +1,40 @@ + +/* Driver for routine shell */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 +#define NP 100 + +int main(void) +{ + char txt[MAXSTR]; + unsigned long i,j; + float *a; + FILE *fp; + + a=vector(1,NP); + if ((fp = fopen("tarray.dat","r")) == NULL) + nrerror("Data file tarray.dat not found\n"); + fgets(txt,MAXSTR,fp); + for (i=1;i<=NP;i++) fscanf(fp,"%f",&a[i]); + fclose(fp); + printf("\nOriginal array:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + shell(NP,a); + printf("\nSorted array:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + free_vector(a,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsimplx.c b/lib/nr/ansi/examples/xsimplx.c new file mode 100644 index 0000000..96587ac --- /dev/null +++ b/lib/nr/ansi/examples/xsimplx.c @@ -0,0 +1,64 @@ + +/* Driver for routine simplx */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 4 +#define M 4 +#define NP 5 /* NP >= N+1 */ +#define MP 6 /* MP >= M+2 */ +#define M1 2 /* M1+M2+M3 = M */ +#define M2 1 +#define M3 1 +#define NM1M2 (N+M1+M2) + +int main(void) +{ + int i,icase,j,*izrov,*iposv; + static float c[MP][NP]= + {0.0,1.0,1.0,3.0,-0.5, + 740.0,-1.0,0.0,-2.0,0.0, + 0.0,0.0,-2.0,0.0,7.0, + 0.5,0.0,-1.0,1.0,-2.0, + 9.0,-1.0,-1.0,-1.0,-1.0, + 0.0,0.0,0.0,0.0,0.0}; + float **a; + static char *txt[NM1M2+1]= + {" ","x1","x2","x3","x4","y1","y2","y3"}; + + izrov=ivector(1,N); + iposv=ivector(1,M); + a=convert_matrix(&c[0][0],1,MP,1,NP); + simplx(a,M,N,M1,M2,M3,&icase,izrov,iposv); + if (icase == 1) + printf("\nunbounded objective function\n"); + else if (icase == -1) + printf("\nno solutions satisfy constraints given\n"); + else { + printf("\n%11s"," "); + for (i=1;i<=N;i++) + if (izrov[i] <= NM1M2) printf("%10s",txt[izrov[i]]); + printf("\n"); + for (i=1;i<=M+1;i++) { + if (i == 1 || iposv[i-1] <= NM1M2) { + if (i > 1) + printf("%s",txt[iposv[i-1]]); + else + printf(" "); + printf("%10.2f",a[i][1]); + for (j=2;j<=N+1;j++) + if (izrov[j-1] <= NM1M2) + printf("%10.2f",a[i][j]); + printf("\n"); + } + } + } + free_convert_matrix(a,1,MP,1,NP); + free_ivector(iposv,1,M); + free_ivector(izrov,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsimpr.c b/lib/nr/ansi/examples/xsimpr.c new file mode 100644 index 0000000..0557576 --- /dev/null +++ b/lib/nr/ansi/examples/xsimpr.c @@ -0,0 +1,44 @@ + +/* Driver for routine simpr */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NVAR 3 +#define X1 0.0 +#define HTOT 50.0 + +int main(void) +{ + int i; + float a1=0.5976,a2=1.4023,a3=0.0,*y,*yout,*dfdx,**dfdy,*dydx; + + y=vector(1,NVAR); + yout=vector(1,NVAR); + dfdx=vector(1,NVAR); + dfdy=matrix(1,NVAR,1,NVAR); + dydx=vector(1,NVAR); + y[1]=y[2]=1.0; + y[3]=0.0; + derivs(X1,y,dydx); + jacobn(X1,y,dfdx,dfdy,NVAR); + printf("Test Problem:\n"); + for (i=5;i<=50;i+=5) { + simpr(y,dydx,dfdx,dfdy,NVAR,X1,HTOT,i,yout,derivs); + printf("\n%s %5.2f %s %5.2f %s %2d %s \n", + "x=",X1," to ",X1+HTOT," in ",i," steps"); + printf("%14s %9s\n","integration","bessj"); + printf("%12.6f %12.6f\n",yout[1],a1); + printf("%12.6f %12.6f\n",yout[2],a2); + printf("%12.6f %12.6f\n",yout[3],a3); + } + free_vector(dydx,1,NVAR); + free_matrix(dfdy,1,NVAR,1,NVAR); + free_vector(dfdx,1,NVAR); + free_vector(yout,1,NVAR); + free_vector(y,1,NVAR); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsinft.c b/lib/nr/ansi/examples/xsinft.c new file mode 100644 index 0000000..15483f3 --- /dev/null +++ b/lib/nr/ansi/examples/xsinft.c @@ -0,0 +1,61 @@ + +/* Driver for routine sinft */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define EPS 1.0e-3 +#define NP 16 +#define WIDTH 30.0 +#define PI 3.1415926 + +int main(void) +{ + float big,per,scal,small,*data; + int i,j,nlim; + + data=vector(1,NP); + for (;;) { + printf("\nPeriod of sinusoid in channels (3-%2d)\n",NP); + scanf("%f",&per); + if (per <= 0.0) break; + for (i=1;i<=NP;i++) + data[i]=sin(2.0*PI*(i-1)/per); + sinft(data,NP); + big = -1.0e10; + small=1.0e10; + for (i=1;i<=NP;i++) { + if (data[i] < small) small=data[i]; + if (data[i] > big) big=data[i]; + } + scal=WIDTH/(big-small); + for (i=1;i<=NP;i++) { + nlim=(int) (scal*(data[i]-small)+EPS+0.5); + printf("%4d ",i); + for (j=1;j<=nlim+1;j++) printf("*"); + printf("\n"); + } + printf("press RETURN to continue ...\n"); + (void) getchar(); + sinft(data,NP); + big = -1.0e10; + small=1.0e10; + for (i=1;i<=NP;i++) { + if (data[i] < small) small=data[i]; + if (data[i] > big) big=data[i]; + } + scal=WIDTH/(big-small); + for (i=1;i<=NP;i++) { + nlim=(int) (scal*(data[i]-small)+EPS+0.5); + printf("%4d ",i); + for (j=1;j<=nlim+1;j++) printf("*"); + printf("\n"); + } + } + free_vector(data,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsncndn.c b/lib/nr/ansi/examples/xsncndn.c new file mode 100644 index 0000000..5190e25 --- /dev/null +++ b/lib/nr/ansi/examples/xsncndn.c @@ -0,0 +1,41 @@ + +/* Driver for routine sncndn */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,nval; + float em,emmc,uu,val,sn,cn,dn; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Jacobian Elliptic Function",26)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + printf("%4s %8s %16s %13s %15s %18s\n","mc","u","actual", + "sn","sn^2+cn^2","(mc)*(sn^2)+dn^2"); + for (i=1;i<=nval;i++) { + fscanf(fp,"%f %f %f",&em,&uu,&val); + emmc=1.0-em; + sncndn(uu,emmc,&sn,&cn,&dn); + printf("%5.2f %8.2f %15.5f %15.5f %12.5f %14.5f\n", + emmc,uu,val,sn,(sn*sn+cn*cn),(em*sn*sn+dn*dn)); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsobseq.c b/lib/nr/ansi/examples/xsobseq.c new file mode 100644 index 0000000..8b328b2 --- /dev/null +++ b/lib/nr/ansi/examples/xsobseq.c @@ -0,0 +1,23 @@ + +/* Driver for routine sobseq */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +int main(void) +{ + int i,n1=(-1),n2=3; + float *x; + + x=vector(1,n2); + sobseq(&n1,x); + for (i=1;i<=32;i++) { + sobseq(&n2,x); + printf(" %10.5f %10.5f %10.5f %5d\n",x[1],x[2],x[3],i); + } + free_vector(x,1,n2); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsor.c b/lib/nr/ansi/examples/xsor.c new file mode 100644 index 0000000..1e12035 --- /dev/null +++ b/lib/nr/ansi/examples/xsor.c @@ -0,0 +1,59 @@ + +/* Driver for routine sor */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NSTEP 4 +#define JMAX 33 +#define PI 3.1415926 + +int main(void) +{ + int i,j,midl; + double **a,**b,**c,**d,**e,**f,**u,rjac; + + a=dmatrix(1,JMAX,1,JMAX); + b=dmatrix(1,JMAX,1,JMAX); + c=dmatrix(1,JMAX,1,JMAX); + d=dmatrix(1,JMAX,1,JMAX); + e=dmatrix(1,JMAX,1,JMAX); + f=dmatrix(1,JMAX,1,JMAX); + u=dmatrix(1,JMAX,1,JMAX); + for (i=1;i<=JMAX;i++) + for (j=1;j<=JMAX;j++) { + a[i][j]=b[i][j]=c[i][j]=d[i][j]=1.0; + e[i][j]=(-4.0); + f[i][j]=u[i][j]=0.0; + } + midl=JMAX/2+1; + f[midl][midl]=2.0/((JMAX-1)*(JMAX-1)); + rjac=cos(PI/JMAX); + sor(a,b,c,d,e,f,u,JMAX,rjac); + printf("SOR solution:\n"); + for (i=1;i<=JMAX;i+=NSTEP) { + for (j=1;j<=JMAX;j+=NSTEP) printf("%8.4f",u[i][j]); + printf("\n"); + } + printf("\n Test that solution satisfies difference equations:\n"); + for (i=NSTEP+1;i +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 +#define NP 100 + +int main(void) +{ + char txt[MAXSTR]; + int i,j; + float *a; + FILE *fp; + + a=vector(1,NP); + if ((fp = fopen("tarray.dat","r")) == NULL) + nrerror("Data file tarray.dat not found\n"); + fgets(txt,MAXSTR,fp); + for (i=1;i<=NP;i++) fscanf(fp,"%f",&a[i]); + fclose(fp); + printf("\noriginal array:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + sort(NP,a); + printf("\nsorted array:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + free_vector(a,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsort2.c b/lib/nr/ansi/examples/xsort2.c new file mode 100644 index 0000000..7b94a7f --- /dev/null +++ b/lib/nr/ansi/examples/xsort2.c @@ -0,0 +1,59 @@ + +/* Driver for routine sort2 */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 +#define NP 100 + +int main(void) +{ + char txt[MAXSTR]; + int i,j; + float *a,*b; + FILE *fp; + + a=vector(1,NP); + b=vector(1,NP); + if ((fp = fopen("tarray.dat","r")) == NULL) + nrerror("Data file tarray.dat not found\n"); + fgets(txt,MAXSTR,fp); + for (i=1;i<=NP;i++) fscanf(fp,"%f",&a[i]); + fclose(fp); + /* generate b-array */ + for (i=1;i<=NP;i++) b[i]=i; + /* sort a and mix b */ + sort2(NP,a,b); + printf("\nAfter sorting a and mixing b, array a is:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + printf("\n... and array b is:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",b[10*i+j]); + printf("\n"); + } + printf("press return to continue...\n"); + (void) getchar(); + /* sort b and mix a */ + sort2(NP,b,a); + printf("\nAfter sorting b and mixing a, array a is:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",a[10*i+j]); + printf("\n"); + } + printf("\n... and array b is:\n"); + for (i=0;i<=9;i++) { + for (j=1;j<=10;j++) printf("%7.2f",b[10*i+j]); + printf("\n"); + } + free_vector(b,1,NP); + free_vector(a,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsort3.c b/lib/nr/ansi/examples/xsort3.c new file mode 100644 index 0000000..cf9e125 --- /dev/null +++ b/lib/nr/ansi/examples/xsort3.c @@ -0,0 +1,59 @@ + +/* Driver for routine sort3 */ + +#include +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NLEN 64 + +int main(void) +{ + int i,j; + char dummy[NLEN],amsg[NLEN+1],bmsg[NLEN+1],cmsg[NLEN+1]; + float *a,*b,*c; + FILE *fp; + + a=vector(1,NLEN); + b=vector(1,NLEN); + c=vector(1,NLEN); + (void) strcpy(amsg,"I'd rather have a bottle in front of"); + (void) strcat(amsg," me than a frontal lobotomy."); + printf("\noriginal message:\n%s\n",amsg); + /* read array of random numbers */ + if ((fp = fopen("tarray.dat","r")) == NULL) + nrerror("Data file tarray.dat not found\n"); + fgets(dummy,NLEN,fp); + for (i=1;i<=NLEN;i++) fscanf(fp,"%f",&a[i]); + fclose(fp); + /* create array b and array c */ + for (i=1;i<=NLEN;i++) { + b[i]=i; + c[i]=NLEN+1-i; + } + /* sort array a while mixing b and c */ + sort3(NLEN,a,b,c); + /* scramble message according to array b */ + bmsg[NLEN]=amsg[NLEN]; /* null terminating character */ + for (i=1;i<=NLEN;i++) { + j=b[i]; + bmsg[i-1]=amsg[j-1]; + } + printf("\nscrambled message:\n%s\n",bmsg); + /* unscramble according to array c */ + cmsg[NLEN]=amsg[NLEN]; + for (i=1;i<=NLEN;i++) { + j=c[i]; + cmsg[j-1]=bmsg[i-1]; + } + printf("\nmirrored message:\n%s\n",cmsg); + free_vector(c,1,NLEN); + free_vector(b,1,NLEN); + free_vector(a,1,NLEN); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xspctrm.c b/lib/nr/ansi/examples/xspctrm.c new file mode 100644 index 0000000..d070f7b --- /dev/null +++ b/lib/nr/ansi/examples/xspctrm.c @@ -0,0 +1,40 @@ + +/* Driver for routine spctrm */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define M 16 +#define TRUE 1 +#define FALSE 0 + +int main(void) +{ + int j,k,ovrlap; + float *p,*q; + FILE *fp; + + p=vector(1,M); + q=vector(1,M); + if ((fp = fopen("spctrl.dat","r")) == NULL) + nrerror("Data file spctrl.dat not found\n"); + k=8; + ovrlap=TRUE; + spctrm(fp,p,M,k,ovrlap); + rewind(fp); + k=16; + ovrlap=FALSE; + spctrm(fp,q,M,k,ovrlap); + fclose(fp); + printf("\nSpectrum of data in file spctrl.dat\n"); + printf("%13s %s %5s %s\n"," ","overlapped "," ","non-overlapped"); + for (j=1;j<=M;j++) + printf("%3d %5s %13f %5s %13f\n",j," ",p[j]," ",q[j]); + free_vector(q,1,M); + free_vector(p,1,M); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xspear.c b/lib/nr/ansi/examples/xspear.c new file mode 100644 index 0000000..289a693 --- /dev/null +++ b/lib/nr/ansi/examples/xspear.c @@ -0,0 +1,71 @@ + +/* Driver for routine spear */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NDAT 20 +#define NMON 12 +#define MAXSTR 80 + +int main(void) +{ + int i,j; + float d,probd,probrs,rs,zd,*ave,*data1,*data2,*zlat,**rays; + char dummy[MAXSTR],txt[MAXSTR],city[NDAT+1][17],mon[NMON+1][5]; + FILE *fp; + + ave=vector(1,NDAT); + data1=vector(1,NDAT); + data2=vector(1,NDAT); + zlat=vector(1,NDAT); + rays=matrix(1,NDAT,1,NMON); + if ((fp = fopen("table2.dat","r")) == NULL) + nrerror("Data file table2.dat not found\n"); + fgets(dummy,MAXSTR,fp); + fgets(txt,MAXSTR,fp); + fscanf(fp,"%*15c"); + for (i=1;i<=NMON;i++) fscanf(fp," %s",mon[i]); + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + for (i=1;i<=NDAT;i++) { + fscanf(fp,"%[^0123456789]",city[i]); + city[i][16]='\0'; + for (j=1;j<=NMON;j++) fscanf(fp,"%f",&rays[i][j]); + fscanf(fp,"%f %f ",&ave[i],&zlat[i]); + } + fclose(fp); + printf("%s\n",txt); + printf("%16s"," "); + for (i=1;i<=12;i++) printf("%4s",mon[i]); + printf("\n"); + for (i=1;i<=NDAT;i++) { + printf("%s",city[i]); + for (j=1;j<=12;j++) + printf("%4d",(int) (0.5+rays[i][j])); + printf("\n"); + } + /* Check temperature correlations between different months */ + printf("\nAre sunny summer places also sunny winter places?\n"); + printf("Check correlation of sampled U.S. solar radiation\n"); + printf("(july with other months)\n\n"); + printf("%s %9s %14s %11s %15s %10s\n","month","d", + "st. dev.","probd","spearman-r","probrs"); + for (i=1;i<=NDAT;i++) data1[i]=rays[i][1]; + for (j=1;j<=12;j++) { + for (i=1;i<=NDAT;i++) data2[i]=rays[i][j]; + spear(data1,data2,NDAT,&d,&zd,&probd,&rs,&probrs); + printf("%4s %12.2f %12.6f %12.6f %13.6f %12.6f\n", + mon[j],d,zd,probd,rs,probrs); + } + free_matrix(rays,1,NDAT,1,NMON); + free_vector(zlat,1,NDAT); + free_vector(data2,1,NDAT); + free_vector(data1,1,NDAT); + free_vector(ave,1,NDAT); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsphbes.c b/lib/nr/ansi/examples/xsphbes.c new file mode 100644 index 0000000..0d083e2 --- /dev/null +++ b/lib/nr/ansi/examples/xsphbes.c @@ -0,0 +1,40 @@ + +/* Driver for routine rj */ + +#include +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define MAXSTR 80 + +int main(void) +{ + char txt[MAXSTR]; + int i,n,nval; + float sj,sy,sjp,syp,x,xsj,xsy,xsjp,xsyp; + FILE *fp; + + if ((fp = fopen("fncval.dat","r")) == NULL) + nrerror("Data file fncval.dat not found\n"); + fgets(txt,MAXSTR,fp); + while (strncmp(txt,"Spherical Bessel Functions",26)) { + fgets(txt,MAXSTR,fp); + if (feof(fp)) nrerror("Data not found in fncval.dat\n"); + } + fscanf(fp,"%d %*s",&nval); + printf("\n%s\n",txt); + for (i=1;i<=nval;i++) { + fscanf(fp,"%d %f %f %f %f %f",&n,&x,&sj,&sy,&sjp,&syp); + printf("%5s %4s\n%14s %16s %17s %16s\n%14s %16s %17s %16s\n", + "n","x","sj","sy","sjp","syp","xsj","xsy","xsjp","xsyp"); + sphbes(n,x,&xsj,&xsy,&xsjp,&xsyp); + printf("%5d %5.2f\n\t%16.6e %16.6e %16.6e %16.6e\n",n,x,sj,sy,sjp,syp); + printf("\t%16.6e %16.6e %16.6e %16.6e\n",xsj,xsy,xsjp,xsyp); + } + fclose(fp); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsphfpt.c b/lib/nr/ansi/examples/xsphfpt.c new file mode 100644 index 0000000..c6e3ee5 --- /dev/null +++ b/lib/nr/ansi/examples/xsphfpt.c @@ -0,0 +1,12 @@ + +/* Auxiliary routine for sphfpt */ + +extern int m,n; +extern float c2,dx,gmma; + +void derivs(float x,float y[],float dydx[]) +{ + dydx[1]=y[2]; + dydx[2]=(2.0*x*(m+1.0)*y[2]-(y[3]-c2*x*x)*y[1])/(1.0-x*x); + dydx[3]=0.0; +} diff --git a/lib/nr/ansi/examples/xsplie2.c b/lib/nr/ansi/examples/xsplie2.c new file mode 100644 index 0000000..6df3130 --- /dev/null +++ b/lib/nr/ansi/examples/xsplie2.c @@ -0,0 +1,46 @@ + +/* Driver for routine splie2 */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define M 10 +#define N 10 + +int main(void) +{ + int i,j; + float x1x2,*x1,*x2,**y,**y2; + + x1=vector(1,N); + x2=vector(1,N); + y=matrix(1,M,1,N); + y2=matrix(1,M,1,N); + for (i=1;i<=M;i++) x1[i]=0.2*i; + for (i=1;i<=N;i++) x2[i]=0.2*i; + for (i=1;i<=M;i++) + for (j=1;j<=N;j++) { + x1x2=x1[i]*x2[j]; + y[i][j]=x1x2*x1x2; + } + splie2(x1,x2,y,M,N,y2); + printf("\nsecond derivatives from SPLIE2\n"); + printf("natural spline assumed\n"); + for (i=1;i<=5;i++) { + for (j=1;j<=5;j++) printf("%12.6f",y2[i][j]); + printf("\n"); + } + printf("\nactual second derivatives\n"); + for (i=1;i<=5;i++) { + for (j=1;j<=5;j++) printf("%12.6f",2.0*x1[i]*x1[i]); + printf("\n"); + } + free_matrix(y2,1,M,1,N); + free_matrix(y,1,M,1,N); + free_vector(x2,1,N); + free_vector(x1,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsplin2.c b/lib/nr/ansi/examples/xsplin2.c new file mode 100644 index 0000000..6f3a95a --- /dev/null +++ b/lib/nr/ansi/examples/xsplin2.c @@ -0,0 +1,46 @@ + +/* Driver for routine splin2 */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define M 10 +#define N 10 + +int main(void) +{ + int i,j; + float f,ff,x1x2,xx1,xx2,*x1,*x2,**y,**y2; + + x1=vector(1,N); + x2=vector(1,N); + y=matrix(1,M,1,N); + y2=matrix(1,M,1,N); + for (i=1;i<=M;i++) x1[i]=0.2*i; + for (i=1;i<=N;i++) x2[i]=0.2*i; + for (i=1;i<=M;i++) { + for (j=1;j<=N;j++) { + x1x2=x1[i]*x2[j]; + y[i][j]=x1x2*exp(-x1x2); + } + } + splie2(x1,x2,y,M,N,y2); + printf("%9s %12s %14s %12s\n","x1","x2","splin2","actual"); + for (i=1;i<=10;i++) { + xx1=0.1*i; + xx2=xx1*xx1; + splin2(x1,x2,y,y2,M,N,xx1,xx2,&f); + x1x2=xx1*xx2; + ff=x1x2*exp(-x1x2); + printf("%12.6f %12.6f %12.6f %12.6f\n",xx1,xx2,f,ff); + } + free_matrix(y2,1,M,1,N); + free_matrix(y,1,M,1,N); + free_vector(x2,1,N); + free_vector(x1,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xspline.c b/lib/nr/ansi/examples/xspline.c new file mode 100644 index 0000000..8dc984e --- /dev/null +++ b/lib/nr/ansi/examples/xspline.c @@ -0,0 +1,41 @@ + +/* Driver for routine spline */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 20 +#define PI 3.1415926 + +int main(void) +{ + int i; + float yp1,ypn,*x,*y,*y2; + + x=vector(1,N); + y=vector(1,N); + y2=vector(1,N); + printf("\nsecond-derivatives for sin(x) from 0 to pi\n"); + /* Generate array for interpolation */ + for (i=1;i<=20;i++) { + x[i]=i*PI/N; + y[i]=sin(x[i]); + } + /* calculate 2nd derivative with spline */ + yp1=cos(x[1]); + ypn=cos(x[N]); + spline(x,y,N,yp1,ypn,y2); + /* test result */ + printf("%23s %16s\n","spline","actual"); + printf("%11s %14s %16s\n","angle","2nd deriv","2nd deriv"); + for (i=1;i<=N;i++) + printf("%10.2f %16.6f %16.6f\n",x[i],y2[i],-sin(x[i])); + free_vector(y2,1,N); + free_vector(y,1,N); + free_vector(x,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsplint.c b/lib/nr/ansi/examples/xsplint.c new file mode 100644 index 0000000..e91b1af --- /dev/null +++ b/lib/nr/ansi/examples/xsplint.c @@ -0,0 +1,65 @@ + +/* Driver for routine splint */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 10 +#define PI 3.1415926 + +int main(void) +{ + int i,nfunc; + float f,x,y,yp1,ypn,*xa,*ya,*y2; + + xa=vector(1,NP); + ya=vector(1,NP); + y2=vector(1,NP); + for (nfunc=1;nfunc<=2;nfunc++) { + if (nfunc == 1) { + printf("\nsine function from 0 to pi\n"); + for (i=1;i<=NP;i++) { + xa[i]=i*PI/NP; + ya[i]=sin(xa[i]); + } + yp1=cos(xa[1]); + ypn=cos(xa[NP]); + } else if (nfunc == 2) { + printf("\nexponential function from 0 to 1\n"); + for (i=1;i<=NP;i++) { + xa[i]=1.0*i/NP; + ya[i]=exp(xa[i]); + } + yp1=exp(xa[1]); + ypn=exp(xa[NP]); + } else { + break; + } + /* Call spline to get second derivatives */ + spline(xa,ya,NP,yp1,ypn,y2); + /* Call splint for interpolations */ + printf("\n%9s %13s %17s\n","x","f(x)","interpolation"); + for (i=1;i<=10;i++) { + if (nfunc == 1) { + x=(-0.05+i/10.0)*PI; + f=sin(x); + } else if (nfunc == 2) { + x = -0.05+i/10.0; + f=exp(x); + } + splint(xa,ya,y2,NP,x,&y); + printf("%12.6f %12.6f %12.6f\n",x,f,y); + } + printf("\n***********************************\n"); + printf("Press RETURN\n"); + (void) getchar(); + } + free_vector(y2,1,NP); + free_vector(ya,1,NP); + free_vector(xa,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsprsax.c b/lib/nr/ansi/examples/xsprsax.c new file mode 100644 index 0000000..bcfad29 --- /dev/null +++ b/lib/nr/ansi/examples/xsprsax.c @@ -0,0 +1,43 @@ + +/* Driver for routine sprsax */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 5 +#define NMAX (2*NP*NP+1) + +int main(void) +{ + unsigned long i,j,msize,*ija; + float **a,*sa,*ax,*b; + static float ainit[NP][NP]={ + 3.0,0.0,1.0,0.0,0.0, + 0.0,4.0,0.0,0.0,0.0, + 0.0,7.0,5.0,9.0,0.0, + 0.0,0.0,0.0,0.0,2.0, + 0.0,0.0,0.0,6.0,5.0}; + static float x[NP+1]={0.0,1.0,2.0,3.0,4.0,5.0}; + + ija=lvector(1,NMAX); + ax=vector(1,NP); + b=vector(1,NP); + sa=vector(1,NMAX); + a=convert_matrix(&ainit[0][0],1,NP,1,NP); + sprsin(a,NP,0.5,NMAX,sa,ija); + msize=ija[1]-2; + sprsax(sa,ija,x,b,msize); + for (i=1;i<=msize;i++) + for (ax[i]=0.0,j=1;j<=msize;j++) ax[i] += a[i][j]*x[j]; + printf("\tReference\tsprsax result\n"); + for (i=1;i<=msize;i++) printf("\t%5.2f\t\t%5.2f\n",ax[i],b[i]); + free_convert_matrix(a,1,NP,1,NP); + free_vector(sa,1,NMAX); + free_vector(b,1,NP); + free_vector(ax,1,NP); + free_lvector(ija,1,NMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsprsin.c b/lib/nr/ansi/examples/xsprsin.c new file mode 100644 index 0000000..0804017 --- /dev/null +++ b/lib/nr/ansi/examples/xsprsin.c @@ -0,0 +1,53 @@ + +/* Driver for routine sprsin */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 5 +#define NMAX (2*NP*NP+1) + +int main(void) +{ + unsigned long i,j,msize,*ija; + float **a,**aa,*sa; + static float ainit[NP][NP]={ + 3.0,0.0,1.0,0.0,0.0, + 0.0,4.0,0.0,0.0,0.0, + 0.0,7.0,5.0,9.0,0.0, + 0.0,0.0,0.0,0.0,2.0, + 0.0,0.0,0.0,6.0,5.0}; + + ija=lvector(1,NMAX); + sa=vector(1,NMAX); + aa=matrix(1,NP,1,NP); + a=convert_matrix(&ainit[0][0],1,NP,1,NP); + sprsin(a,NP,0.5,NMAX,sa,ija); + msize=ija[ija[1]-1]-1; + sa[NP+1]=0.0; + printf("index\tija\t\tsa\n"); + for (i=1;i<=msize;i++) printf("%lu\t%lu\t%12.6f\n",i,ija[i],sa[i]); + for (i=1;i<=NP;i++) for (j=1;j<=NP;j++) aa[i][j]=0.0; + for (i=1;i<=NP;i++) { + aa[i][i]=sa[i]; + for (j=ija[i];j<=ija[i+1]-1;j++) aa[i][ija[j]]=sa[j]; + } + printf("Original Matrix\n"); + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) printf("%5.2f\t",a[i][j]); + printf("\n"); + } + printf("Reconstructed Matrix\n"); + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) printf("%5.2f\t",aa[i][j]); + printf("\n"); + } + free_convert_matrix(a,1,NP,1,NP); + free_matrix(aa,1,NP,1,NP); + free_vector(sa,1,NMAX); + free_lvector(ija,1,NMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsprspm.c b/lib/nr/ansi/examples/xsprspm.c new file mode 100644 index 0000000..48cc766 --- /dev/null +++ b/lib/nr/ansi/examples/xsprspm.c @@ -0,0 +1,84 @@ + +/* Driver for routine sprspm */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 5 +#define NMAX (2*NP*NP+1) + +int main(void) +{ + unsigned long i,j,k,*ija,*ijb,*ijbt,*ijc; + float *sa,*sb,*sbt,*sc,**a,**b,**c,**ab; + static float ainit[NP][NP]={ + 1.0,0.5,0.0,0.0,0.0, + 0.5,2.0,0.5,0.0,0.0, + 0.0,0.5,3.0,0.5,0.0, + 0.0,0.0,0.5,4.0,0.5, + 0.0,0.0,0.0,0.5,5.0}; + static float binit[NP][NP]={ + 1.0,1.0,0.0,0.0,0.0, + 1.0,2.0,1.0,0.0,0.0, + 0.0,1.0,3.0,1.0,0.0, + 0.0,0.0,1.0,4.0,1.0, + 0.0,0.0,0.0,1.0,5.0}; + + ija=lvector(1,NMAX); + ijb=lvector(1,NMAX); + ijbt=lvector(1,NMAX); + ijc=lvector(1,NMAX); + sa=vector(1,NMAX); + sb=vector(1,NMAX); + sbt=vector(1,NMAX); + sc=vector(1,NMAX); + c=matrix(1,NP,1,NP); + ab=matrix(1,NP,1,NP); + a=convert_matrix(&ainit[0][0],1,NP,1,NP); + b=convert_matrix(&binit[0][0],1,NP,1,NP); + sprsin(a,NP,0.5,NMAX,sa,ija); + sprsin(b,NP,0.5,NMAX,sb,ijb); + sprstp(sb,ijb,sbt,ijbt); + /* specify tridiagonal output, using fact that a is tridiagonal */ + for (i=1;i<=ija[ija[1]-1]-1;i++) ijc[i]=ija[i]; + sprspm(sa,ija,sbt,ijbt,sc,ijc); + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) { + ab[i][j]=0.0; + for (k=1;k<=NP;k++) { + ab[i][j]=ab[i][j]+a[i][k]*b[k][j]; + } + } + } + printf("Reference matrix:\n"); + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) printf("%5.2f\t",ab[i][j]); + printf("\n"); + } + printf("sprspm matrix (should show only tridiagonals):\n"); + for (i=1;i<=NP;i++) for (j=1;j<=NP;j++) c[i][j]=0.0; + for (i=1;i<=NP;i++) { + c[i][i]=sc[i]; + for (j=ijc[i];j<=ijc[i+1]-1;j++) c[i][ijc[j]]=sc[j]; + } + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) printf("%5.2f\t",c[i][j]); + printf("\n"); + } + free_convert_matrix(b,1,NP,1,NP); + free_convert_matrix(a,1,NP,1,NP); + free_matrix(ab,1,NP,1,NP); + free_matrix(c,1,NP,1,NP); + free_vector(sc,1,NMAX); + free_vector(sbt,1,NMAX); + free_vector(sb,1,NMAX); + free_vector(sa,1,NMAX); + free_lvector(ijc,1,NMAX); + free_lvector(ijbt,1,NMAX); + free_lvector(ijb,1,NMAX); + free_lvector(ija,1,NMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsprstm.c b/lib/nr/ansi/examples/xsprstm.c new file mode 100644 index 0000000..f7b6c1b --- /dev/null +++ b/lib/nr/ansi/examples/xsprstm.c @@ -0,0 +1,84 @@ + +/* Driver for routine sprstm */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 5 +#define NMAX (2*NP*NP+1) +#define THRESH 0.99 + +int main(void) +{ + unsigned long i,j,k,*ija,*ijb,*ijbt,*ijc,msize; + float *sa,*sb,*sbt,*sc,**a,**b,**c,**ab; + static float ainit[NP][NP]={ + 1.0,0.5,0.0,0.0,0.0, + 0.5,2.0,0.5,0.0,0.0, + 0.0,0.5,3.0,0.5,0.0, + 0.0,0.0,0.5,4.0,0.5, + 0.0,0.0,0.0,0.5,5.0}; + static float binit[NP][NP]={ + 1.0,1.0,0.0,0.0,0.0, + 1.0,2.0,1.0,0.0,0.0, + 0.0,1.0,3.0,1.0,0.0, + 0.0,0.0,1.0,4.0,1.0, + 0.0,0.0,0.0,1.0,5.0}; + + ija=lvector(1,NMAX); + ijb=lvector(1,NMAX); + ijbt=lvector(1,NMAX); + ijc=lvector(1,NMAX); + sa=vector(1,NMAX); + sb=vector(1,NMAX); + sbt=vector(1,NMAX); + sc=vector(1,NMAX); + c=matrix(1,NP,1,NP); + ab=matrix(1,NP,1,NP); + a=convert_matrix(&ainit[0][0],1,NP,1,NP); + b=convert_matrix(&binit[0][0],1,NP,1,NP); + sprsin(a,NP,0.5,NMAX,sa,ija); + sprsin(b,NP,0.5,NMAX,sb,ijb); + sprstp(sb,ijb,sbt,ijbt); + msize=ija[ija[1]-1]-1; + sprstm(sa,ija,sbt,ijbt,THRESH,msize,sc,ijc); + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) { + ab[i][j]=0.0; + for (k=1;k<=NP;k++) { + ab[i][j]=ab[i][j]+a[i][k]*b[k][j]; + } + } + } + printf("Reference matrix:\n"); + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) printf("%5.2f\t",ab[i][j]); + printf("\n"); + } + printf("sprstm matrix (off-diag. elements of mag >): %12.6f\n",THRESH); + for (i=1;i<=NP;i++) for (j=1;j<=NP;j++) c[i][j]=0.0; + for (i=1;i<=NP;i++) { + c[i][i]=sc[i]; + for (j=ijc[i];j<=ijc[i+1]-1;j++) c[i][ijc[j]]=sc[j]; + } + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) printf("%5.2f\t",c[i][j]); + printf("\n"); + } + free_convert_matrix(b,1,NP,1,NP); + free_convert_matrix(a,1,NP,1,NP); + free_matrix(ab,1,NP,1,NP); + free_matrix(c,1,NP,1,NP); + free_vector(sc,1,NMAX); + free_vector(sbt,1,NMAX); + free_vector(sb,1,NMAX); + free_vector(sa,1,NMAX); + free_lvector(ijc,1,NMAX); + free_lvector(ijbt,1,NMAX); + free_lvector(ijb,1,NMAX); + free_lvector(ija,1,NMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsprstp.c b/lib/nr/ansi/examples/xsprstp.c new file mode 100644 index 0000000..8916623 --- /dev/null +++ b/lib/nr/ansi/examples/xsprstp.c @@ -0,0 +1,54 @@ + +/* Driver for routine sprstp */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 5 +#define NMAX (2*NP*NP+1) + +int main(void) +{ + unsigned long i,j,*ija,*ijat; + float **a,**at,*sa,*sat; + static float ainit[NP][NP]={ + 3.0,0.0,1.0,0.0,0.0, + 0.0,4.0,0.0,0.0,0.0, + 0.0,7.0,5.0,9.0,0.0, + 0.0,0.0,0.0,0.0,2.0, + 0.0,0.0,0.0,6.0,5.0}; + + ija=lvector(1,NMAX); + ijat=lvector(1,NMAX); + sa=vector(1,NMAX); + sat=vector(1,NMAX); + at=matrix(1,NP,1,NP); + a=convert_matrix(&ainit[0][0],1,NP,1,NP); + sprsin(a,NP,0.5,NMAX,sa,ija); + sprstp(sa,ija,sat,ijat); + for (i=1;i<=NP;i++) for (j=1;j<=NP;j++) at[i][j]=0.0; + for (i=1;i<=NP;i++) { + at[i][i]=sat[i]; + for (j=ijat[i];j<=ijat[i+1]-1;j++) at[i][ijat[j]]=sat[j]; + } + printf("Original Matrix\n"); + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) printf("%5.2f\t",a[i][j]); + printf("\n"); + } + printf("Transpose\n"); + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) printf("%5.2f\t",at[i][j]); + printf("\n"); + } + free_convert_matrix(a,1,NP,1,NP); + free_matrix(at,1,NP,1,NP); + free_vector(sat,1,NMAX); + free_vector(sa,1,NMAX); + free_lvector(ijat,1,NMAX); + free_lvector(ija,1,NMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsprstx.c b/lib/nr/ansi/examples/xsprstx.c new file mode 100644 index 0000000..617010d --- /dev/null +++ b/lib/nr/ansi/examples/xsprstx.c @@ -0,0 +1,43 @@ + +/* Driver for routine sprstx */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 5 +#define NMAX (2*NP*NP+1) + +int main(void) +{ + unsigned long i,j,msize,*ija; + float **a,*sa,*ax,*b; + static float ainit[NP][NP]={ + 3.0,0.0,1.0,0.0,0.0, + 0.0,4.0,0.0,0.0,0.0, + 0.0,7.0,5.0,9.0,0.0, + 0.0,0.0,0.0,0.0,2.0, + 0.0,0.0,0.0,6.0,5.0}; + static float x[NP+1]={0.0,1.0,2.0,3.0,4.0,5.0}; + + ija=lvector(1,NMAX); + ax=vector(1,NP); + b=vector(1,NP); + sa=vector(1,NMAX); + a=convert_matrix(&ainit[0][0],1,NP,1,NP); + sprsin(a,NP,0.5,NMAX,sa,ija); + msize=ija[1]-2; + sprstx(sa,ija,x,b,msize); + for (i=1;i<=msize;i++) + for (ax[i]=0.0,j=1;j<=msize;j++) ax[i] += a[j][i]*x[j]; + printf("\tReference\tsprstx result\n"); + for (i=1;i<=msize;i++) printf("\t%5.2f\t\t%5.2f\n",ax[i],b[i]); + free_convert_matrix(a,1,NP,1,NP); + free_vector(sa,1,NMAX); + free_vector(b,1,NP); + free_vector(ax,1,NP); + free_lvector(ija,1,NMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xstifbs.c b/lib/nr/ansi/examples/xstifbs.c new file mode 100644 index 0000000..e43799d --- /dev/null +++ b/lib/nr/ansi/examples/xstifbs.c @@ -0,0 +1,31 @@ + +/* Driver for routine stifbs */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +int kmax,kount; /* defining declarations */ +float *xp,**yp,dxsav; + +int main(void) +{ + float eps,hstart,x1=0.0,x2=50.0,y[4]; + int nbad,nok; + + for (;;) { + printf("Enter eps,hstart\n"); + if (scanf("%f %f",&eps,&hstart) == EOF) break; + kmax=0; + y[1]=y[2]=1.0; + y[3]=0.0; + odeint(y,3,x1,x2,eps,hstart,0.0,&nok,&nbad,derivs,stifbs); + printf("\n%s %13s %3d\n","successful steps:"," ",nok); + printf("%s %20s %3d\n","bad steps:"," ",nbad); + printf("Y(END) = %12.6f %12.6f %12.6f\n",y[1],y[2],y[3]); + } + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xstiff.c b/lib/nr/ansi/examples/xstiff.c new file mode 100644 index 0000000..ffc3e54 --- /dev/null +++ b/lib/nr/ansi/examples/xstiff.c @@ -0,0 +1,31 @@ + +/* Driver for routine stiff */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +int kmax,kount; /* defining declarations */ +float *xp,**yp,dxsav; + +int main(void) +{ + float eps,hstart,x1=0.0,x2=50.0,y[4]; + int nbad,nok; + + for (;;) { + printf("Enter eps,hstart\n"); + if (scanf("%f %f",&eps,&hstart) == EOF) break; + kmax=0; + y[1]=y[2]=1.0; + y[3]=0.0; + odeint(y,3,x1,x2,eps,hstart,0.0,&nok,&nbad,derivs,stiff); + printf("\n%s %13s %3d\n","successful steps:"," ",nok); + printf("%s %20s %3d\n","bad steps:"," ",nbad); + printf("Y(END) = %12.6f %12.6f %12.6f\n",y[1],y[2],y[3]); + } + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xstoerm.c b/lib/nr/ansi/examples/xstoerm.c new file mode 100644 index 0000000..a16a66c --- /dev/null +++ b/lib/nr/ansi/examples/xstoerm.c @@ -0,0 +1,60 @@ + +/* Driver for routine stoerm */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NVAR 4 +#define X1 0.0 +#define HTOT 1.570796 + +float d2y1(float x) +{ + return sin(x)+x; +} + +float d2y2(float x) +{ + return cos(x)+x*x-2; +} + +void derivs(float x,float y[],float dydx[]) +{ + dydx[1]=x-y[1]; + dydx[2]=x*x-y[2]; +} + +int main(void) +{ + int i; + float a1,a2,xf,*y,*yout,*d2y; + + y=vector(1,NVAR); + yout=vector(1,NVAR); + d2y=vector(1,NVAR); + y[1]=0.0; + y[2] = -1.0; + y[3]=2.0; + y[4]=0.0; + derivs(X1,y,d2y); + xf=X1+HTOT; + a1=d2y1(xf); + a2=d2y2(xf); + printf("Stoermer's Rule:\n"); + for (i=5;i<=45;i+=10) { + stoerm(y,d2y,NVAR,X1,HTOT,i,yout,derivs); + printf("\n%s %5.2f %s %5.2f %s %2d %s \n", + "x=",X1," to ",X1+HTOT," in ",i," steps"); + printf("%14s %9s\n","integration","answers"); + printf("%12.6f %12.6f\n",yout[1],a1); + printf("%12.6f %12.6f\n",yout[2],a2); + } + free_vector(d2y,1,NVAR); + free_vector(yout,1,NVAR); + free_vector(y,1,NVAR); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsvbksb.c b/lib/nr/ansi/examples/xsvbksb.c new file mode 100644 index 0000000..e99d305 --- /dev/null +++ b/lib/nr/ansi/examples/xsvbksb.c @@ -0,0 +1,87 @@ + +/* Driver for routine svbksb, which calls routine svdcmp */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 20 +#define MP 20 +#define MAXSTR 80 + +int main(void) +{ + int j,k,l,m,n; + float wmax,wmin,*w,*x,*c; + float **a,**b,**u,**v; + char dummy[MAXSTR]; + FILE *fp; + + w=vector(1,NP); + x=vector(1,NP); + c=vector(1,NP); + a=matrix(1,NP,1,NP); + b=matrix(1,NP,1,MP); + u=matrix(1,NP,1,NP); + v=matrix(1,NP,1,NP); + if ((fp = fopen("matrx1.dat","r")) == NULL) + nrerror("Data file matrx1.dat not found\n"); + while (!feof(fp)) { + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + fscanf(fp,"%d %d ",&n,&m); + fgets(dummy,MAXSTR,fp); + for (k=1;k<=n;k++) + for (l=1;l<=n;l++) fscanf(fp,"%f ",&a[k][l]); + fgets(dummy,MAXSTR,fp); + for (l=1;l<=m;l++) + for (k=1;k<=n;k++) fscanf(fp,"%f ",&b[k][l]); + /* copy a into u */ + for (k=1;k<=n;k++) + for (l=1;l<=n;l++) u[k][l]=a[k][l]; + /* decompose matrix a */ + svdcmp(u,n,n,w,v); + /* find maximum singular value */ + wmax=0.0; + for (k=1;k<=n;k++) + if (w[k] > wmax) wmax=w[k]; + /* define "small" */ + wmin=wmax*(1.0e-6); + /* zero the "small" singular values */ + for (k=1;k<=n;k++) + if (w[k] < wmin) w[k]=0.0; + /* backsubstitute for each right-hand side vector */ + for (l=1;l<=m;l++) { + printf("\nVector number %2d\n",l); + for (k=1;k<=n;k++) c[k]=b[k][l]; + svbksb(u,w,v,n,n,c,x); + printf(" solution vector is:\n"); + for (k=1;k<=n;k++) printf("%12.6f",x[k]); + printf("\n original right-hand side vector:\n"); + for (k=1;k<=n;k++) printf("%12.6f",c[k]); + printf("\n (matrix)*(sol'n vector):\n"); + for (k=1;k<=n;k++) { + c[k]=0.0; + for (j=1;j<=n;j++) + c[k] += a[k][j]*x[j]; + } + for (k=1;k<=n;k++) printf("%12.6f",c[k]); + printf("\n"); + } + printf ("***********************************\n"); + printf("press RETURN for next problem\n"); + (void) getchar(); + } + fclose(fp); + free_matrix(v,1,NP,1,NP); + free_matrix(u,1,NP,1,NP); + free_matrix(b,1,NP,1,MP); + free_matrix(a,1,NP,1,NP); + free_vector(c,1,NP); + free_vector(x,1,NP); + free_vector(w,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsvdcmp.c b/lib/nr/ansi/examples/xsvdcmp.c new file mode 100644 index 0000000..8506c55 --- /dev/null +++ b/lib/nr/ansi/examples/xsvdcmp.c @@ -0,0 +1,86 @@ + +/* Driver for routine svdcmp */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 20 +#define MP 20 +#define MAXSTR 80 + +int main(void) +{ + int j,k,l,m,n; + float *w,**a,**u,**v; + char dummy[MAXSTR]; + FILE *fp; + + w=vector(1,NP); + a=matrix(1,MP,1,NP); + u=matrix(1,MP,1,NP); + v=matrix(1,NP,1,NP); + /* read input matrices */ + if ((fp = fopen("matrx3.dat","r")) == NULL) + nrerror("Data file matrx3.dat not found\n"); + while (!feof(fp)) { + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + fscanf(fp,"%d %d ",&m,&n); + fgets(dummy,MAXSTR,fp); + /* copy original matrix into u */ + for (k=1;k<=m;k++) + for (l=1;l<=n;l++) { + fscanf(fp,"%f ",&a[k][l]); + u[k][l]=a[k][l]; + } + /* perform decomposition */ + svdcmp(u,m,n,w,v); + /* write results */ + printf("Decomposition matrices:\n"); + printf("Matrix u\n"); + for (k=1;k<=m;k++) { + for (l=1;l<=n;l++) + printf("%12.6f",u[k][l]); + printf("\n"); + } + printf("Diagonal of matrix w\n"); + for (k=1;k<=n;k++) + printf("%12.6f",w[k]); + printf("\nMatrix v-transpose\n"); + for (k=1;k<=n;k++) { + for (l=1;l<=n;l++) + printf("%12.6f",v[l][k]); + printf("\n"); + } + printf("\nCheck product against original matrix:\n"); + printf("Original matrix:\n"); + for (k=1;k<=m;k++) { + for (l=1;l<=n;l++) + printf("%12.6f",a[k][l]); + printf("\n"); + } + printf("Product u*w*(v-transpose):\n"); + for (k=1;k<=m;k++) { + for (l=1;l<=n;l++) { + a[k][l]=0.0; + for (j=1;j<=n;j++) + a[k][l] += u[k][j]*w[j]*v[l][j]; + } + for (l=1;l<=n;l++) printf("%12.6f",a[k][l]); + printf("\n"); + } + printf("***********************************\n"); + printf("press RETURN for next problem\n"); + (void) getchar(); + } + fclose(fp); + free_matrix(v,1,NP,1,NP); + free_matrix(u,1,MP,1,NP); + free_matrix(a,1,MP,1,NP); + free_vector(w,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsvdfit.c b/lib/nr/ansi/examples/xsvdfit.c new file mode 100644 index 0000000..870ad42 --- /dev/null +++ b/lib/nr/ansi/examples/xsvdfit.c @@ -0,0 +1,56 @@ + +/* Driver for routine svdfit */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPT 100 +#define SPREAD 0.02 +#define NPOL 5 + +int main(void) +{ + long idum=(-911); + int i; + float chisq,*x,*y,*sig,*a,*w,**cvm,**u,**v; + + x=vector(1,NPT); + y=vector(1,NPT); + sig=vector(1,NPT); + a=vector(1,NPOL); + w=vector(1,NPOL); + cvm=matrix(1,NPOL,1,NPOL); + u=matrix(1,NPT,1,NPOL); + v=matrix(1,NPOL,1,NPOL); + for (i=1;i<=NPT;i++) { + x[i]=0.02*i; + y[i]=1.0+x[i]*(2.0+x[i]*(3.0+x[i]*(4.0+x[i]*5.0))); + y[i] *= (1.0+SPREAD*gasdev(&idum)); + sig[i]=y[i]*SPREAD; + } + svdfit(x,y,sig,NPT,a,NPOL,u,v,w,&chisq,fpoly); + svdvar(v,NPOL,w,cvm); + printf("\npolynomial fit:\n\n"); + for (i=1;i<=NPOL;i++) + printf("%12.6f %s %10.6f\n",a[i]," +-",sqrt(cvm[i][i])); + printf("\nChi-squared %12.6f\n",chisq); + svdfit(x,y,sig,NPT,a,NPOL,u,v,w,&chisq,fleg); + svdvar(v,NPOL,w,cvm); + printf("\nLegendre polynomial fit:\n\n"); + for (i=1;i<=NPOL;i++) + printf("%12.6f %s %10.6f\n",a[i]," +-",sqrt(cvm[i][i])); + printf("\nChi-squared %12.6f\n",chisq); + free_matrix(v,1,NPOL,1,NPOL); + free_matrix(u,1,NPT,1,NPOL); + free_matrix(cvm,1,NPOL,1,NPOL); + free_vector(w,1,NPOL); + free_vector(a,1,NPOL); + free_vector(sig,1,NPT); + free_vector(y,1,NPT); + free_vector(x,1,NPT); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xsvdvar.c b/lib/nr/ansi/examples/xsvdvar.c new file mode 100644 index 0000000..76a760d --- /dev/null +++ b/lib/nr/ansi/examples/xsvdvar.c @@ -0,0 +1,55 @@ + +/* Driver for routine svdvar */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 6 +#define MA 3 + +int main(void) +{ + int i,j; + float **cvm,**v; + static float vtemp[NP][NP]= + {1.0,1.0,1.0,1.0,1.0,1.0, + 2.0,2.0,2.0,2.0,2.0,2.0, + 3.0,3.0,3.0,3.0,3.0,3.0, + 4.0,4.0,4.0,4.0,4.0,4.0, + 5.0,5.0,5.0,5.0,5.0,5.0, + 6.0,6.0,6.0,6.0,6.0,6.0}; + static float w[NP+1]= + {0.0,0.0,1.0,2.0,3.0,4.0,5.0}; + static float tru[MA][MA]= + {1.25,2.5,3.75, + 2.5,5.0,7.5, + 3.75,7.5,11.25}; + + cvm=matrix(1,MA,1,MA); + v=convert_matrix(&vtemp[0][0],1,NP,1,NP); + printf("\nmatrix v\n"); + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) printf("%12.6f",v[i][j]); + printf("\n"); + } + printf("\nvector w\n"); + for (i=1;i<=NP;i++) printf("%12.6f",w[i]); + printf("\n"); + svdvar(v,MA,w,cvm); + printf("\ncovariance matrix from svdvar\n"); + for (i=1;i<=MA;i++) { + for (j=1;j<=MA;j++) printf("%12.6f",cvm[i][j]); + printf("\n"); + } + printf("\nexpected covariance matrix\n"); + for (i=1;i<=MA;i++) { + for (j=1;j<=MA;j++) printf("%12.6f",tru[i-1][j-1]); + printf("\n"); + } + free_convert_matrix(v,1,NP,1,NP); + free_matrix(cvm,1,MA,1,MA); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xtoeplz.c b/lib/nr/ansi/examples/xtoeplz.c new file mode 100644 index 0000000..224d8ef --- /dev/null +++ b/lib/nr/ansi/examples/xtoeplz.c @@ -0,0 +1,32 @@ + +/* Driver for routine toeplz */ + +#include +#define NRANSI +#include "nr.h" + +#define N 5 +#define TWON (2*N) + +int main(void) +{ + int i,j; + float sum,r[TWON+1],x[N+1],y[N+1]; + + for (i=1;i<=N;i++) y[i]=0.1*i; + for (i=1;i +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPTS 500 +#define EPS 0.01 +#define NSHFT 11 +#define ANOISE 0.3 + +int main(void) +{ + long idum=(-5); + int i,j; + float ave1,ave2,ave3; + float offset,prob1,prob2,shift,t1,t2; + float var1,var2,var3,*data1,*data2,*data3; + + data1=vector(1,NPTS); + data2=vector(1,NPTS); + data3=vector(1,NPTS); + printf("%29s %31s\n","Correlated:","Uncorrelated:"); + printf("%7s %11s %17s %11s %17s\n", + "Shift","t","Probability","t","Probability"); + offset=(NSHFT/2)*EPS; + for (j=1;j<=NPTS;j++) { + data1[j]=gasdev(&idum); + data2[j]=data1[j]+ANOISE*gasdev(&idum); + data3[j]=gasdev(&idum); + data3[j] += ANOISE*gasdev(&idum); + } + avevar(data1,NPTS,&ave1,&var1); + avevar(data2,NPTS,&ave2,&var2); + avevar(data3,NPTS,&ave3,&var3); + for (j=1;j<=NPTS;j++) { + data1[j] -= ave1-offset; + data2[j] -= ave2; + data3[j] -= ave3; + } + for (i=1;i<=NSHFT;i++) { + shift=i*EPS; + for (j=1;j<=NPTS;j++) { + data2[j] += EPS; + data3[j] += EPS; + } + tptest(data1,data2,NPTS,&t1,&prob1); + tptest(data1,data3,NPTS,&t2,&prob2); + printf("%6.2f %14.4f %12.4f %16.4f %12.4f\n", + shift,t1,prob1,t2,prob2); + } + free_vector(data3,1,NPTS); + free_vector(data2,1,NPTS); + free_vector(data1,1,NPTS); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xtqli.c b/lib/nr/ansi/examples/xtqli.c new file mode 100644 index 0000000..17d03e6 --- /dev/null +++ b/lib/nr/ansi/examples/xtqli.c @@ -0,0 +1,63 @@ + +/* Driver for routine tqli */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 10 +#define TINY 1.0e-6 + +int main(void) +{ + int i,j,k; + float *d,*e,*f,**a; + static float c[NP][NP]={ + 5.0, 4.3, 3.0, 2.0, 1.0, 0.0,-1.0,-2.0,-3.0,-4.0, + 4.3, 5.1, 4.0, 3.0, 2.0, 1.0, 0.0,-1.0,-2.0,-3.0, + 3.0, 4.0, 5.0, 4.0, 3.0, 2.0, 1.0, 0.0,-1.0,-2.0, + 2.0, 3.0, 4.0, 5.0, 4.0, 3.0, 2.0, 1.0, 0.0,-1.0, + 1.0, 2.0, 3.0, 4.0, 5.0, 4.0, 3.0, 2.0, 1.0, 0.0, + 0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 4.0, 3.0, 2.0, 1.0, + -1.0, 0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 4.0, 3.0, 2.0, + -2.0,-1.0, 0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 4.0, 3.0, + -3.0,-2.0,-1.0, 0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 4.0, + -4.0,-3.0,-2.0,-1.0, 0.0, 1.0, 2.0, 3.0, 4.0, 5.0}; + + d=vector(1,NP); + e=vector(1,NP); + f=vector(1,NP); + a=matrix(1,NP,1,NP); + for (i=1;i<=NP;i++) + for (j=1;j<=NP;j++) a[i][j]=c[i-1][j-1]; + tred2(a,NP,d,e); + tqli(d,e,NP,a); + printf("\nEigenvectors for a real symmetric matrix\n"); + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) { + f[j]=0.0; + for (k=1;k<=NP;k++) + f[j] += (c[j-1][k-1]*a[k][i]); + } + printf("%s %3d %s %10.6f\n","eigenvalue",i," =",d[i]); + printf("%11s %14s %9s\n","vector","mtrx*vect.","ratio"); + for (j=1;j<=NP;j++) { + if (fabs(a[j][i]) < TINY) + printf("%12.6f %12.6f %12s\n", + a[j][i],f[j],"div. by 0"); + else + printf("%12.6f %12.6f %12.6f\n", + a[j][i],f[j],f[j]/a[j][i]); + } + printf("Press ENTER to continue...\n"); + (void) getchar(); + } + free_matrix(a,1,NP,1,NP); + free_vector(f,1,NP); + free_vector(e,1,NP); + free_vector(d,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xtrapzd.c b/lib/nr/ansi/examples/xtrapzd.c new file mode 100644 index 0000000..52f5d47 --- /dev/null +++ b/lib/nr/ansi/examples/xtrapzd.c @@ -0,0 +1,38 @@ + +/* Driver for routine trapzd */ + +#include +#include +#define NRANSI +#include "nr.h" + +#define NMAX 14 +#define PIO2 1.5707963 + +/* Test function */ +float func(float x) +{ + return (x*x)*(x*x-2.0)*sin(x); +} + +/* Integral of test function */ +float fint(float x) +{ + return 4.0*x*(x*x-7.0)*sin(x)-(pow(x,4.0)-14.0*(x*x)+28.0)*cos(x); +} + +int main(void) +{ + int i; + float a=0.0,b=PIO2,s; + + printf("\nIntegral of func with 2^(n-1) points\n"); + printf("Actual value of integral is %10.6f\n",fint(b)-fint(a)); + printf("%6s %24s\n","n","approx. integral"); + for (i=1;i<=NMAX;i++) { + s=trapzd(func,a,b,i); + printf("%6d %20.6f\n",i,s); + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xtred2.c b/lib/nr/ansi/examples/xtred2.c new file mode 100644 index 0000000..e7fda8b --- /dev/null +++ b/lib/nr/ansi/examples/xtred2.c @@ -0,0 +1,66 @@ + +/* Driver for routine tred2 */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 10 + +int main(void) +{ + int i,j,k,l,m; + float *d,*e,**a,**f; + static float c[NP][NP]={ + 5.0, 4.3, 3.0, 2.0, 1.0, 0.0,-1.0,-2.0,-3.0,-4.0, + 4.3, 5.1, 4.0, 3.0, 2.0, 1.0, 0.0,-1.0,-2.0,-3.0, + 3.0, 4.0, 5.0, 4.0, 3.0, 2.0, 1.0, 0.0,-1.0,-2.0, + 2.0, 3.0, 4.0, 5.0, 4.0, 3.0, 2.0, 1.0, 0.0,-1.0, + 1.0, 2.0, 3.0, 4.0, 5.0, 4.0, 3.0, 2.0, 1.0, 0.0, + 0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 4.0, 3.0, 2.0, 1.0, + -1.0, 0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 4.0, 3.0, 2.0, + -2.0,-1.0, 0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 4.0, 3.0, + -3.0,-2.0,-1.0, 0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 4.0, + -4.0,-3.0,-2.0,-1.0, 0.0, 1.0, 2.0, 3.0, 4.0, 5.0}; + + d=vector(1,NP); + e=vector(1,NP); + a=matrix(1,NP,1,NP); + f=matrix(1,NP,1,NP); + for (i=1;i<=NP;i++) + for (j=1;j<=NP;j++) a[i][j]=c[i-1][j-1]; + tred2(a,NP,d,e); + printf("diagonal elements\n"); + for (i=1;i<=NP;i++) { + printf("%12.6f",d[i]); + if ((i % 5) == 0) printf("\n"); + } + printf("off-diagonal elements\n"); + for (i=2;i<=NP;i++) { + printf("%12.6f",e[i]); + if ((i % 5) == 0) printf("\n"); + } + /* Check transformation matrix */ + for (j=1;j<=NP;j++) { + for (k=1;k<=NP;k++) { + f[j][k]=0.0; + for (l=1;l<=NP;l++) { + for (m=1;m<=NP;m++) + f[j][k] += a[l][j]*c[l-1][m-1]*a[m][k]; + } + } + } + /* How does it look? */ + printf("tridiagonal matrix\n"); + for (i=1;i<=NP;i++) { + for (j=1;j<=NP;j++) printf("%7.2f",f[i][j]); + printf("\n"); + } + free_matrix(f,1,NP,1,NP); + free_matrix(a,1,NP,1,NP); + free_vector(e,1,NP); + free_vector(d,1,NP); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xtridag.c b/lib/nr/ansi/examples/xtridag.c new file mode 100644 index 0000000..6fba0db --- /dev/null +++ b/lib/nr/ansi/examples/xtridag.c @@ -0,0 +1,72 @@ + +/* Driver for routine tridag */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NP 20 +#define MAXSTR 80 + +int main(void) +{ + unsigned long k,n; + float *diag,*superd,*subd,*rhs,*u; + char dummy[MAXSTR]; + FILE *fp; + + diag=vector(1,NP); + superd=vector(1,NP); + subd=vector(1,NP); + rhs=vector(1,NP); + u=vector(1,NP); + if ((fp = fopen("matrx2.dat","r")) == NULL) + nrerror("Data file matrx2.dat not found\n"); + while (!feof(fp)) { + fgets(dummy,MAXSTR,fp); + fgets(dummy,MAXSTR,fp); + fscanf(fp,"%ld ",&n); + fgets(dummy,MAXSTR,fp); + for (k=1;k<=n;k++) fscanf(fp,"%f ",&diag[k]); + fgets(dummy,MAXSTR,fp); + for (k=1;k +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPTS 1024 +#define MPTS 512 +#define EPS 0.02 +#define NSHFT 10 + +int main(void) +{ + long idum=(-5); + int i,j; + float prob,t,*data1,*data2; + + data1=vector(1,NPTS); + data2=vector(1,MPTS); + /* Generate gaussian distributed data */ + printf("%6s %8s %16s\n","shift","t","probability"); + for (i=1;i<=NPTS;i++) data1[i]=gasdev(&idum); + for (i=1;i<=MPTS;i++) data2[i]=(NSHFT/2.0)*EPS+gasdev(&idum); + for (i=1;i<=NSHFT+1;i++) { + ttest(data1,NPTS,data2,MPTS,&t,&prob); + printf("%6.2f %10.2f %10.2f\n",(i-1)*EPS,t,prob); + for (j=1;j<=NPTS;j++) data1[j] += EPS; + } + free_vector(data2,1,MPTS); + free_vector(data1,1,NPTS); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xtutest.c b/lib/nr/ansi/examples/xtutest.c new file mode 100644 index 0000000..e9ee3de --- /dev/null +++ b/lib/nr/ansi/examples/xtutest.c @@ -0,0 +1,43 @@ + +/* Driver for routine tutest */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NPTS 5000 +#define MPTS 1000 +#define EPS 0.02 +#define VAR1 1.0 +#define VAR2 4.0 +#define NSHFT 10 + +int main(void) +{ + long idum=(-51773); + int i,j; + float fctr1,fctr2,prob,t,*data1,*data2; + + data1=vector(1,NPTS); + data2=vector(1,MPTS); + /* Generate two gaussian distributions of different variance */ + fctr1=sqrt(VAR1); + for (i=1;i<=NPTS;i++) data1[i]=fctr1*gasdev(&idum); + fctr2=sqrt(VAR2); + for (i=1;i<=MPTS;i++) + data2[i]=NSHFT/2.0*EPS+fctr2*gasdev(&idum); + printf("\nDistribution #1 : variance = %6.2f\n",VAR1); + printf("Distribution #2 : variance = %6.2f\n\n",VAR2); + printf("%7s %8s %16s\n","shift","t","probability"); + for (i=1;i<=NSHFT+1;i++) { + tutest(data1,NPTS,data2,MPTS,&t,&prob); + printf("%6.2f %10.2f %11.2f\n",(i-1)*EPS,t,prob); + for (j=1;j<=NPTS;j++) data1[j] += EPS; + } + free_vector(data2,1,MPTS); + free_vector(data1,1,NPTS); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xtwofft.c b/lib/nr/ansi/examples/xtwofft.c new file mode 100644 index 0000000..df336b3 --- /dev/null +++ b/lib/nr/ansi/examples/xtwofft.c @@ -0,0 +1,66 @@ + +/* Driver for routine twofft */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 32 +#define N2 (2*N) +#define PER 8 +#define PI 3.1415926 + +void prntft(float data[],unsigned long nn) +{ + unsigned long n; + + printf("%4s %13s %13s %12s %13s\n", + "n","real(n)","imag.(n)","real(N-n)","imag.(N-n)"); + printf(" 0 %14.6f %12.6f %12.6f %12.6f\n", + data[1],data[2],data[1],data[2]); + for (n=3;n<=nn+1;n+=2) { + printf("%4lu %14.6f %12.6f %12.6f %12.6f\n", + ((n-1)/2),data[n],data[n+1], + data[2*nn+2-n],data[2*nn+3-n]); + } + printf(" press return to continue ...\n"); + (void) getchar(); + return; +} + +int main(void) +{ + unsigned long i; + int isign; + float *data1,*data2,*fft1,*fft2; + + data1=vector(1,N); + data2=vector(1,N); + fft1=vector(1,N2); + fft2=vector(1,N2); + for (i=1;i<=N;i++) { + data1[i]=floor(0.5+cos(i*2.0*PI/PER)); + data2[i]=floor(0.5+sin(i*2.0*PI/PER)); + } + twofft(data1,data2,fft1,fft2,N); + printf("Fourier transform of first function:\n"); + prntft(fft1,N); + printf("Fourier transform of second function:\n"); + prntft(fft2,N); + /* Invert transform */ + isign = -1; + four1(fft1,N,isign); + printf("inverted transform = first function:\n"); + prntft(fft1,N); + four1(fft2,N,isign); + printf("inverted transform = second function:\n"); + prntft(fft2,N); + free_vector(fft2,1,N2); + free_vector(fft1,1,N2); + free_vector(data2,1,N); + free_vector(data1,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xvander.c b/lib/nr/ansi/examples/xvander.c new file mode 100644 index 0000000..d7b5ac1 --- /dev/null +++ b/lib/nr/ansi/examples/xvander.c @@ -0,0 +1,43 @@ + +/* Driver for routine vander */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 5 + +int main(void) +{ + int i,j; + double sum=0.0,*w,*term; + static double x[]={0.0,1.0,1.5,2.0,2.5,3.0}; + static double q[]={0.0,1.0,1.5,2.0,2.5,3.0}; + + w=dvector(1,N); + term=dvector(1,N); + vander(x,w,q,N); + printf("\nSolution vector:\n"); + for (i=1;i<=N;i++) + printf("%7s%1d%2s %12f \n","w[",i,"]=",w[i]); + printf("\nTest of solution vector:\n"); + printf("%14s %11s\n","mtrx*sol'n","original"); + for (i=1;i<=N;i++) { + term[i]=w[i]; + sum += w[i]; + } + printf("%12.4f %12.4f\n",sum,q[1]); + for (i=2;i<=N;i++) { + sum=0.0; + for (j=1;j<=N;j++) { + term[j] *= x[j]; + sum += term[j]; + } + printf("%12.4f %12.4f\n",sum,q[i]); + } + free_dvector(term,1,N); + free_dvector(w,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xvegas.c b/lib/nr/ansi/examples/xvegas.c new file mode 100644 index 0000000..87d7c34 --- /dev/null +++ b/lib/nr/ansi/examples/xvegas.c @@ -0,0 +1,59 @@ + +/* Driver for routine vegas */ + +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +long idum; /* for ranno */ + +int ndim; /* for fxn */ +float xoff; + +float fxn(float pt[],float wgt) +{ + int j; + float ans,sum; + + for (sum=0.0,j=1;j<=ndim;j++) sum += (100.0*SQR(pt[j]-xoff)); + ans=(sum < 80.0 ? exp(-sum) : 0.0); + ans *= pow(5.64189,(double)ndim); + return ans; +} + +int main(void) +{ + int init,itmax,j,ncall,nprn; + float avgi,chi2a,sd,xoff; + float *regn; + + regn=vector(1,20); + printf("IDUM=\n"); + scanf("%ld",&idum); + if (idum > 0) idum = -idum; + for (;;) { + printf("ENTER NDIM,XOFF,NCALL,ITMAX,NPRN\n"); + if (scanf("%d %f %d %d %d",&ndim,&xoff,&ncall,&itmax,&nprn) == EOF) break; + avgi=sd=chi2a=0.0; + for (j=1;j<=ndim;j++) { + regn[j]=0.0; + regn[j+ndim]=1.0; + } + init = -1; + vegas(regn,ndim,fxn,init,ncall,itmax,nprn,&avgi,&sd,&chi2a); + printf("Number of iterations performed: %d\n",itmax); + printf("Integral, Standard Dev., Chi-sq. = %12.6f %12.6f% 12.6f\n", + avgi,sd,chi2a); + init = 1; + vegas(regn,ndim,fxn,init,ncall,itmax,nprn,&avgi,&sd,&chi2a); + printf("Additional iterations performed: %d \n",itmax); + printf("Integral, Standard Dev., Chi-sq. = %12.6f %12.6f% 12.6f\n", + avgi,sd,chi2a); + } + free_vector(regn,1,20); + printf("Normal completion\n"); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xvoltra.c b/lib/nr/ansi/examples/xvoltra.c new file mode 100644 index 0000000..b99b065 --- /dev/null +++ b/lib/nr/ansi/examples/xvoltra.c @@ -0,0 +1,43 @@ + +/* Driver for routine voltra */ +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +float g(int k,float t) +{ + return (k == 1 ? cosh(t)+t*sin(t) : 2.0*sin(t)+t*(SQR(sin(t))+exp(t))); +} + +float ak(int k,int l,float t,float s) +{ + return ((k == 1) ? + (l == 1 ? -exp(t-s) : -cos(t-s)) : + (l == 1 ? -exp(t+s) : -t*cos(s))); +} + +#define N 30 +#define H 0.05 +#define M 2 + +int main(void) +{ + int nn; + float t0=0.0,*t,**f; + + t=vector(1,N); + f=matrix(1,M,1,N); + voltra(N,M,t0,H,t,f,g,ak); + /* exact soln is f[1]=exp(-t), f[2]=2sin(t) */ + printf(" abscissa, voltra answer1, real answer1,"); + printf(" voltra answer2, real answer2\n"); + for (nn=1;nn<=N;nn++) + printf("%12.6f %12.6f %12.6f %12.6f %12.6f\n", + t[nn],f[1][nn],exp(-t[nn]),f[2][nn],2.0*sin(t[nn])); + free_vector(t,1,N); + free_matrix(f,1,M,1,N); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xwt1.c b/lib/nr/ansi/examples/xwt1.c new file mode 100644 index 0000000..61774c9 --- /dev/null +++ b/lib/nr/ansi/examples/xwt1.c @@ -0,0 +1,54 @@ + +/* Driver for routine wt1 */ +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define NMAX 512 +#define NCEN 333 +#define NWID 33 + +int main(void) +{ + unsigned long i,nused; + int itest,k; + float *u,*v,*w,frac,thresh,tmp; + + u=vector(1,NMAX); + v=vector(1,NMAX); + w=vector(1,NMAX); + for (;;) { + printf("Enter k (4, -4, 12, or 20) and frac (0.0 to 1.0):\n"); + if (scanf("%d %f",&k,&frac) == EOF) break; + frac=FMIN(1.0,FMAX(0.0,frac)); + itest=(k == -4 ? 1 : 0); + if (k < 0) k = -k; + if (k != 4 && k != 12 && k != 20) continue; + for (i=1;i<=NMAX;i++) + w[i]=v[i]=(i > NCEN-NWID && i < NCEN+NWID ? + ((float)(i-NCEN+NWID)*(float)(NCEN+NWID-i))/(NWID*NWID) : 0.0); + if (!itest) pwtset(k); + wt1(v,NMAX,1,itest ? daub4 : pwt); + for (i=1;i<=NMAX;i++) u[i]=fabs(v[i]); + thresh=select((int)((1.0-frac)*NMAX),NMAX,u); + nused=0; + for (i=1;i<=NMAX;i++) { + if (fabs(v[i]) <= thresh) + v[i]=0.0; + else + nused++; + } + wt1(v,NMAX,-1,itest ? daub4 : pwt); + for (thresh=0.0,i=1;i<=NMAX;i++) + if ((tmp=fabs(v[i]-w[i])) > thresh) thresh=tmp; + printf("k,NMAX,nused= %d %d %d\n",k,NMAX,nused); + printf("discrepancy= %12.6f\n",thresh); + } + free_vector(w,1,NMAX); + free_vector(v,1,NMAX); + free_vector(u,1,NMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xwtn.c b/lib/nr/ansi/examples/xwtn.c new file mode 100644 index 0000000..ff48f74 --- /dev/null +++ b/lib/nr/ansi/examples/xwtn.c @@ -0,0 +1,43 @@ + +/* Driver for routine wtn */ +#include +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define EPS 1.0e-06 +#define NX 8 +#define NY 16 + +int main(void) +{ + unsigned long i,j,l,nerror=0,ntot=NX*NY; + float *a,*aorg; + static unsigned long ndim[]={0,NX,NY}; + + aorg=vector(1,ntot); + a=vector(1,ntot); + pwtset(12); + for (i=1;i<=NX;i++) + for (j=1;j<=NY;j++) { + l=i+(j-1)*NX; + aorg[l]=a[l]=(i == j ? -1.0 : 1.0/sqrt(fabs((float)(i-j)))); + } + wtn(a,ndim,2,1,pwt); + /* here, one might set the smallest components to zero, encode and transmit + the remaining components as a compressed form of the "image" */ + wtn(a,ndim,2,-1,pwt); + for (l=1;l<=ntot;l++) { + if (fabs(aorg[l]-a[l]) >= EPS) { + printf("Compare Error at element %ld\n",l); + nerror++; + } + } + if (nerror) printf("Number of comparision errors: %ld\n",nerror); + else printf("transform-inverse transform check OK\n"); + free_vector(a,1,ntot); + free_vector(aorg,1,ntot); + return nerror; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xzbrac.c b/lib/nr/ansi/examples/xzbrac.c new file mode 100644 index 0000000..c0f0699 --- /dev/null +++ b/lib/nr/ansi/examples/xzbrac.c @@ -0,0 +1,31 @@ + +/* Driver for routine zbrac */ + +#include +#define NRANSI +#include "nr.h" + +static float fx(float x) +{ + return bessj0(x); +} + +int main(void) +{ + int succes,i; + float x1,x2; + + printf("%21s %23s\n","bracketing values:","function values:"); + printf("%6s %10s %21s %12s\n","x1","x2","bessj0(x1)","bessj0(x2)"); + for (i=1;i<=10;i++) { + x1=i; + x2=x1+1.0; + succes=zbrac(fx,&x1,&x2); + if (succes) { + printf("%7.2f %10.2f %6s %12.6f %12.6f \n", + x1,x2," ",fx(x1),fx(x2)); + } + } + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xzbrak.c b/lib/nr/ansi/examples/xzbrak.c new file mode 100644 index 0000000..b4b6f38 --- /dev/null +++ b/lib/nr/ansi/examples/xzbrak.c @@ -0,0 +1,37 @@ + +/* Driver for routine zbrak */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 100 +#define NBMAX 20 +#define X1 1.0 +#define X2 50.0 + +static float fx(float x) +{ + return bessj0(x); +} + +int main(void) +{ + int i,nb=NBMAX; + float *xb1,*xb2; + + xb1=vector(1,NBMAX); + xb2=vector(1,NBMAX); + zbrak(fx,X1,X2,N,xb1,xb2,&nb); + printf("\nbrackets for roots of bessj0:\n"); + printf("%21s %10s %16s %10s\n","lower","upper","f(lower)","f(upper)"); + for (i=1;i<=nb;i++) + printf("%s %2d %10.4f %10.4f %3s %10.4f %10.4f\n", + " root ",i,xb1[i],xb2[i]," ", + fx(xb1[i]),fx(xb2[i])); + free_vector(xb2,1,NBMAX); + free_vector(xb1,1,NBMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xzbrent.c b/lib/nr/ansi/examples/xzbrent.c new file mode 100644 index 0000000..9aa62c7 --- /dev/null +++ b/lib/nr/ansi/examples/xzbrent.c @@ -0,0 +1,38 @@ + +/* Driver for routine zbrent */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 100 +#define NBMAX 20 +#define X1 1.0 +#define X2 50.0 + +static float fx(float x) +{ + return bessj0(x); +} + +int main(void) +{ + int i,nb=NBMAX; + float tol,root,*xb1,*xb2; + + xb1=vector(1,NBMAX); + xb2=vector(1,NBMAX); + zbrak(fx,X1,X2,N,xb1,xb2,&nb); + printf("\nRoots of bessj0:\n"); + printf("%21s %15s\n","x","f(x)"); + for (i=1;i<=nb;i++) { + tol=(1.0e-6)*(xb1[i]+xb2[i])/2.0; + root=zbrent(fx,xb1[i],xb2[i],tol); + printf("root %3d %14.6f %14.6f\n",i,root,fx(root)); + } + free_vector(xb2,1,NBMAX); + free_vector(xb1,1,NBMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xzrhqr.c b/lib/nr/ansi/examples/xzrhqr.c new file mode 100644 index 0000000..930dc08 --- /dev/null +++ b/lib/nr/ansi/examples/xzrhqr.c @@ -0,0 +1,30 @@ + +/* Driver for routine zrhqr */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define M 4 /* degree of polynomial */ +#define MP1 (M+1) /* no. of polynomial coefficients */ + +int main(void) +{ + static float a[MP1]={-1.0,0.0,0.0,0.0,1.0}; + float *rti,*rtr; + int i; + + rti=vector(1,M); + rtr=vector(1,M); + printf("\nRoots of polynomial x^4-1\n"); + printf("\n%15s %15s\n","Real","Complex"); + zrhqr(a,M,rtr,rti); + for (i=1;i<=M;i++) { + printf("%5d %12.6f %12.6f\n",i,rtr[i],rti[i]); + } + free_vector(rtr,1,M); + free_vector(rti,1,M); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xzriddr.c b/lib/nr/ansi/examples/xzriddr.c new file mode 100644 index 0000000..f0f1e7c --- /dev/null +++ b/lib/nr/ansi/examples/xzriddr.c @@ -0,0 +1,38 @@ + +/* Driver for routine zriddr */ + +#include +#define NRANSI +#include "nr.h" +#include "nrutil.h" + +#define N 100 +#define NBMAX 20 +#define X1 1.0 +#define X2 50.0 + +static float fx(float x) +{ + return bessj0(x); +} + +int main(void) +{ + int i,nb=NBMAX; + float xacc,root,*xb1,*xb2; + + xb1=vector(1,NBMAX); + xb2=vector(1,NBMAX); + zbrak(fx,X1,X2,N,xb1,xb2,&nb); + printf("\nRoots of bessj0:\n"); + printf("%21s %15s\n","x","f(x)"); + for (i=1;i<=nb;i++) { + xacc=(1.0e-6)*(xb1[i]+xb2[i])/2.0; + root=zriddr(fx,xb1[i],xb2[i],xacc); + printf("root %3d %14.6f %14.6f\n",i,root,fx(root)); + } + free_vector(xb2,1,NBMAX); + free_vector(xb1,1,NBMAX); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/examples/xzroots.c b/lib/nr/ansi/examples/xzroots.c new file mode 100644 index 0000000..0593565 --- /dev/null +++ b/lib/nr/ansi/examples/xzroots.c @@ -0,0 +1,45 @@ + +/* Driver for routine zroots */ + +#include +#define NRANSI +#include "nr.h" +#include "complex.h" + +#define M 4 +#define MP1 (M+1) +#define TRUE 1 +#define FALSE 0 + +int main(void) +{ + int i,polish; + fcomplex roots[MP1]; + static fcomplex a[MP1]={{0.0,2.0}, + {0.0,0.0}, + {-1.0,-2.0}, + {0.0,0.0}, + {1.0,0.0} }; + + printf("\nRoots of the polynomial x^4-(1+2i)*x^2+2i\n"); + polish=FALSE; + zroots(a,M,roots,polish); + printf("\nUnpolished roots:\n"); + printf("%14s %13s %13s\n","root #","real","imag."); + for (i=1;i<=M;i++) + printf("%11d %18.6f %12.6f\n",i,roots[i].r,roots[i].i); + printf("\nCorrupted roots:\n"); + for (i=1;i<=M;i++) + roots[i]=RCmul(1+0.01*i,roots[i]); + printf("%14s %13s %13s\n","root #","real","imag."); + for (i=1;i<=M;i++) + printf("%11d %18.6f %12.6f\n",i,roots[i].r,roots[i].i); + polish=TRUE; + zroots(a,M,roots,polish); + printf("\nPolished roots:\n"); + printf("%14s %13s %13s\n","root #","real","imag."); + for (i=1;i<=M;i++) + printf("%11d %18.6f %12.6f \n",i,roots[i].r,roots[i].i); + return 0; +} +#undef NRANSI diff --git a/lib/nr/ansi/index.htm b/lib/nr/ansi/index.htm new file mode 100644 index 0000000..ca93a38 --- /dev/null +++ b/lib/nr/ansi/index.htm @@ -0,0 +1,46 @@ +NRcdrom ANSI C. Server/Internet Use Prohibited. + +

Numerical Recipes ANSI C Files

+ +The best way to find a routine of interest is by one of the following +two links. (You will be able to go back and forth between the two by +clicking on the chapter number links, and you will also be able to get +to the Example routines that demonstrate the Recipes.)

+ +

+
  • Numerical Recipes Routines by Chapter and +Section +
  • Numerical Recipes Table of Contents +
    •  + +

    Access via Directories:

    + +Here is direct access to the directories containing miscellaneous files:

    + +

    +
  • Directory of utility files (includes .h files). +
  • Directory of data files used by Example routines. +
    •  + +Here is direct access to the directories containing the Recipes and +the Example routines. Caution: These directories contain many files +each; older browsers may choke. It is generally better to access +through the above Numerical Recipes Routines by +Chapter and Section link.

    + +

    +
  • Directory of all the Recipes files +
  • Directory of all the Examples files. +
    •  + +Finally, here are

    + +

    +
  • Version information +
  • Troubleshooting and other tips and hints +
  • Notes on using Numerical Recipes with +various Windows compilers +
    •  + + + diff --git a/lib/nr/ansi/info.htm b/lib/nr/ansi/info.htm new file mode 100644 index 0000000..f59ee8b --- /dev/null +++ b/lib/nr/ansi/info.htm @@ -0,0 +1,83 @@ +NRcdrom. Server/Internet Use Prohibited. + +

    Troubleshooting

    + +1. When I click on a recipe or example file (ending in .c), +it doesn't display correctly in my browser and/or it opens +an inappropriate external application.

    + + +You need to teach your browser how to handle C files with +.c and .h extensions. +

      +
    1. In Netscape (version 4.XX -- similar in other +versions), you go to Edit/Preferences... +and choose Navigator/Applications. Now go to step 3. + +
    2. For Microsoft Internet Explorer, you go to View/Folder Options... +from the menu bar of any open folder (not from Microsoft Internet +Explorer!). Choose File Types. Now go to step 3. + +
    3. Highlight, and then page +through with down arrow, all the file types, looking for any +that list extension "C" or "H" under "File type details". +If you find one, then Edit it. If you don't find one, then +create a New Type. In either case set the MIME type to +text/plain, and be sure that the extensions are .c and .h . + +
    4. For Netscape, now choose whether to display the file within +Netscape, or to use an external application. In the latter +case, you might choose a simple text editor (notepad, emacs, etc.), +or you might choose a C development environment (Microsoft Visual +C++, etc.). If you want the option of saving the file to disk +as the default, then check the "Ask me" box. + +
    5. For Microsoft Internet Explorer, now edit or create an +action named "open", and choose an external application to +use. You might choose a simple text editor (notepad, emacs, etc.), +or you might choose a C development environment (Microsoft Visual +C++, etc.). +
    + +If these instructions are not sufficient, you'll need to consult +the help files for your browser. All our source code files +are plain text files with conventional extensions.

    + + + +2. OK, I can see the files, but how do I save selected +files to (e.g.) a working directory for a programming project?

    + + +

      +
    1. If you are already displaying the contents of the file, +go back to where you see a browser page with a link to the file. +
    2. For Netscape, hold down the Shift key and then left-click on +the link. You will get a Save As dialog box from which you +can select a destination folder. +
    3. For Microsoft Internet Explorer, right-click on the link, +and then choose Save Target As in the context menu. You will get +a dialog box from which you can select a destination folder. +
    + +If this doesn't work, you can always just get out of your +browser and copy the files from their folders to your +destination folder. They are not in any way encoded.

    + + +3. Your links are all messed up! The links are in lower-case, +but the file names are in upper case. (Or: some of your links +are longer than 8 letters, but the file names are truncated to +8 letters.)

    + + +This should never happen in Windows. If it happens in UNIX +or Linux, it means that you are using a Windows (not UNIX/Linux) +version of the CDROM, and that you have mounted it incorrectly, +without mapping the file system to long file names and upper/lower +case. Since the Windows disk is not licensed for use on UNIX/Linux +systems at all, we can offer you no assistance.

    + + + + diff --git a/lib/nr/ansi/other/bccbug.c b/lib/nr/ansi/other/bccbug.c new file mode 100644 index 0000000..e3cb559 --- /dev/null +++ b/lib/nr/ansi/other/bccbug.c @@ -0,0 +1,10 @@ +/* The following function is recommended by Borland Technical Support to + "fix" the error "Floating Point Formats Not Linked". To use this file, + compile it along with your own files on the compiler command line. You + do not need to call it, just compile it along with your files. */ + +void LinkFloat(void) +{ + float a=0, *b=&a; + a=*b; +} diff --git a/lib/nr/ansi/other/complex.c b/lib/nr/ansi/other/complex.c new file mode 100644 index 0000000..05cd117 --- /dev/null +++ b/lib/nr/ansi/other/complex.c @@ -0,0 +1,250 @@ +#include + +typedef struct FCOMPLEX {float r,i;} fcomplex; + +#if defined(__STDC__) || defined(ANSI) || defined(NRANSI) /* ANSI */ + +fcomplex Cadd(fcomplex a, fcomplex b) +{ + fcomplex c; + c.r=a.r+b.r; + c.i=a.i+b.i; + return c; +} + +fcomplex Csub(fcomplex a, fcomplex b) +{ + fcomplex c; + c.r=a.r-b.r; + c.i=a.i-b.i; + return c; +} + + +fcomplex Cmul(fcomplex a, fcomplex b) +{ + fcomplex c; + c.r=a.r*b.r-a.i*b.i; + c.i=a.i*b.r+a.r*b.i; + return c; +} + +fcomplex Complex(float re, float im) +{ + fcomplex c; + c.r=re; + c.i=im; + return c; +} + +fcomplex Conjg(fcomplex z) +{ + fcomplex c; + c.r=z.r; + c.i = -z.i; + return c; +} + +fcomplex Cdiv(fcomplex a, fcomplex b) +{ + fcomplex c; + float r,den; + if (fabs(b.r) >= fabs(b.i)) { + r=b.i/b.r; + den=b.r+r*b.i; + c.r=(a.r+r*a.i)/den; + c.i=(a.i-r*a.r)/den; + } else { + r=b.r/b.i; + den=b.i+r*b.r; + c.r=(a.r*r+a.i)/den; + c.i=(a.i*r-a.r)/den; + } + return c; +} + +float Cabs(fcomplex z) +{ + float x,y,ans,temp; + x=fabs(z.r); + y=fabs(z.i); + if (x == 0.0) + ans=y; + else if (y == 0.0) + ans=x; + else if (x > y) { + temp=y/x; + ans=x*sqrt(1.0+temp*temp); + } else { + temp=x/y; + ans=y*sqrt(1.0+temp*temp); + } + return ans; +} + +fcomplex Csqrt(fcomplex z) +{ + fcomplex c; + float x,y,w,r; + if ((z.r == 0.0) && (z.i == 0.0)) { + c.r=0.0; + c.i=0.0; + return c; + } else { + x=fabs(z.r); + y=fabs(z.i); + if (x >= y) { + r=y/x; + w=sqrt(x)*sqrt(0.5*(1.0+sqrt(1.0+r*r))); + } else { + r=x/y; + w=sqrt(y)*sqrt(0.5*(r+sqrt(1.0+r*r))); + } + if (z.r >= 0.0) { + c.r=w; + c.i=z.i/(2.0*w); + } else { + c.i=(z.i >= 0) ? w : -w; + c.r=z.i/(2.0*c.i); + } + return c; + } +} + +fcomplex RCmul(float x, fcomplex a) +{ + fcomplex c; + c.r=x*a.r; + c.i=x*a.i; + return c; +} + +#else /* ANSI */ +/* traditional - K&R */ + +fcomplex Cadd(a,b) +fcomplex a,b; +{ + fcomplex c; + c.r=a.r+b.r; + c.i=a.i+b.i; + return c; +} + +fcomplex Csub(a,b) +fcomplex a,b; +{ + fcomplex c; + c.r=a.r-b.r; + c.i=a.i-b.i; + return c; +} + + +fcomplex Cmul(a,b) +fcomplex a,b; +{ + fcomplex c; + c.r=a.r*b.r-a.i*b.i; + c.i=a.i*b.r+a.r*b.i; + return c; +} + +fcomplex Complex(re,im) +float im,re; +{ + fcomplex c; + c.r=re; + c.i=im; + return c; +} + +fcomplex Conjg(z) +fcomplex z; +{ + fcomplex c; + c.r=z.r; + c.i = -z.i; + return c; +} + +fcomplex Cdiv(a,b) +fcomplex a,b; +{ + fcomplex c; + float r,den; + if (fabs(b.r) >= fabs(b.i)) { + r=b.i/b.r; + den=b.r+r*b.i; + c.r=(a.r+r*a.i)/den; + c.i=(a.i-r*a.r)/den; + } else { + r=b.r/b.i; + den=b.i+r*b.r; + c.r=(a.r*r+a.i)/den; + c.i=(a.i*r-a.r)/den; + } + return c; +} + +float Cabs(z) +fcomplex z; +{ + float x,y,ans,temp; + x=fabs(z.r); + y=fabs(z.i); + if (x == 0.0) + ans=y; + else if (y == 0.0) + ans=x; + else if (x > y) { + temp=y/x; + ans=x*sqrt(1.0+temp*temp); + } else { + temp=x/y; + ans=y*sqrt(1.0+temp*temp); + } + return ans; +} + +fcomplex Csqrt(z) +fcomplex z; +{ + fcomplex c; + float x,y,w,r; + if ((z.r == 0.0) && (z.i == 0.0)) { + c.r=0.0; + c.i=0.0; + return c; + } else { + x=fabs(z.r); + y=fabs(z.i); + if (x >= y) { + r=y/x; + w=sqrt(x)*sqrt(0.5*(1.0+sqrt(1.0+r*r))); + } else { + r=x/y; + w=sqrt(y)*sqrt(0.5*(r+sqrt(1.0+r*r))); + } + if (z.r >= 0.0) { + c.r=w; + c.i=z.i/(2.0*w); + } else { + c.i=(z.i >= 0) ? w : -w; + c.r=z.i/(2.0*c.i); + } + return c; + } +} + +fcomplex RCmul(x,a) +fcomplex a; +float x; +{ + fcomplex c; + c.r=x*a.r; + c.i=x*a.i; + return c; +} + +#endif /* ANSI */ diff --git a/lib/nr/ansi/other/complex.h b/lib/nr/ansi/other/complex.h new file mode 100644 index 0000000..72f0f38 --- /dev/null +++ b/lib/nr/ansi/other/complex.h @@ -0,0 +1,36 @@ +#ifndef _NR_COMPLEX_H_ +#define _NR_COMPLEX_H_ + +#ifndef _FCOMPLEX_DECLARE_T_ +typedef struct FCOMPLEX {float r,i;} fcomplex; +#define _FCOMPLEX_DECLARE_T_ +#endif /* _FCOMPLEX_DECLARE_T_ */ + +#if defined(__STDC__) || defined(ANSI) || defined(NRANSI) /* ANSI */ + +fcomplex Cadd(fcomplex a, fcomplex b); +fcomplex Csub(fcomplex a, fcomplex b); +fcomplex Cmul(fcomplex a, fcomplex b); +fcomplex Complex(float re, float im); +fcomplex Conjg(fcomplex z); +fcomplex Cdiv(fcomplex a, fcomplex b); +float Cabs(fcomplex z); +fcomplex Csqrt(fcomplex z); +fcomplex RCmul(float x, fcomplex a); + +#else /* ANSI */ +/* traditional - K&R */ + +fcomplex Cadd(); +fcomplex Csub(); +fcomplex Cmul(); +fcomplex Complex(); +fcomplex Conjg(); +fcomplex Cdiv(); +float Cabs(); +fcomplex Csqrt(); +fcomplex RCmul(); + +#endif /* ANSI */ + +#endif /* _NR_COMPLEX_H_ */ diff --git a/lib/nr/ansi/other/nr.h b/lib/nr/ansi/other/nr.h new file mode 100644 index 0000000..8042c39 --- /dev/null +++ b/lib/nr/ansi/other/nr.h @@ -0,0 +1,890 @@ +#ifndef _NR_H_ +#define _NR_H_ + +#ifndef _FCOMPLEX_DECLARE_T_ +typedef struct FCOMPLEX {float r,i;} fcomplex; +#define _FCOMPLEX_DECLARE_T_ +#endif /* _FCOMPLEX_DECLARE_T_ */ + +#ifndef _ARITHCODE_DECLARE_T_ +typedef struct { + unsigned long *ilob,*iupb,*ncumfq,jdif,nc,minint,nch,ncum,nrad; +} arithcode; +#define _ARITHCODE_DECLARE_T_ +#endif /* _ARITHCODE_DECLARE_T_ */ + +#ifndef _HUFFCODE_DECLARE_T_ +typedef struct { + unsigned long *icod,*ncod,*left,*right,nch,nodemax; +} huffcode; +#define _HUFFCODE_DECLARE_T_ +#endif /* _HUFFCODE_DECLARE_T_ */ + +#include + +#if defined(__STDC__) || defined(ANSI) || defined(NRANSI) /* ANSI */ + +void addint(double **uf, double **uc, double **res, int nf); +void airy(float x, float *ai, float *bi, float *aip, float *bip); +void amebsa(float **p, float y[], int ndim, float pb[], float *yb, + float ftol, float (*funk)(float []), int *iter, float temptr); +void amoeba(float **p, float y[], int ndim, float ftol, + float (*funk)(float []), int *iter); +float amotry(float **p, float y[], float psum[], int ndim, + float (*funk)(float []), int ihi, float fac); +float amotsa(float **p, float y[], float psum[], int ndim, float pb[], + float *yb, float (*funk)(float []), int ihi, float *yhi, float fac); +void anneal(float x[], float y[], int iorder[], int ncity); +double anorm2(double **a, int n); +void arcmak(unsigned long nfreq[], unsigned long nchh, unsigned long nradd, + arithcode *acode); +void arcode(unsigned long *ich, unsigned char **codep, unsigned long *lcode, + unsigned long *lcd, int isign, arithcode *acode); +void arcsum(unsigned long iin[], unsigned long iout[], unsigned long ja, + int nwk, unsigned long nrad, unsigned long nc); +void asolve(unsigned long n, double b[], double x[], int itrnsp); +void atimes(unsigned long n, double x[], double r[], int itrnsp); +void avevar(float data[], unsigned long n, float *ave, float *var); +void balanc(float **a, int n); +void banbks(float **a, unsigned long n, int m1, int m2, float **al, + unsigned long indx[], float b[]); +void bandec(float **a, unsigned long n, int m1, int m2, float **al, + unsigned long indx[], float *d); +void banmul(float **a, unsigned long n, int m1, int m2, float x[], float b[]); +void bcucof(float y[], float y1[], float y2[], float y12[], float d1, + float d2, float **c); +void bcuint(float y[], float y1[], float y2[], float y12[], + float x1l, float x1u, float x2l, float x2u, float x1, + float x2, float *ansy, float *ansy1, float *ansy2); +void beschb(double x, double *gam1, double *gam2, double *gampl, + double *gammi); +float bessi(int n, float x); +float bessi0(float x); +float bessi1(float x); +void bessik(float x, float xnu, float *ri, float *rk, float *rip, + float *rkp); +float bessj(int n, float x); +float bessj0(float x); +float bessj1(float x); +void bessjy(float x, float xnu, float *rj, float *ry, float *rjp, + float *ryp); +float bessk(int n, float x); +float bessk0(float x); +float bessk1(float x); +float bessy(int n, float x); +float bessy0(float x); +float bessy1(float x); +float beta(float z, float w); +float betacf(float a, float b, float x); +float betai(float a, float b, float x); +float bico(int n, int k); +void bksub(int ne, int nb, int jf, int k1, int k2, float ***c); +float bnldev(float pp, int n, long *idum); +float brent(float ax, float bx, float cx, + float (*f)(float), float tol, float *xmin); +void broydn(float x[], int n, int *check, + void (*vecfunc)(int, float [], float [])); +void bsstep(float y[], float dydx[], int nv, float *xx, float htry, + float eps, float yscal[], float *hdid, float *hnext, + void (*derivs)(float, float [], float [])); +void caldat(long julian, int *mm, int *id, int *iyyy); +void chder(float a, float b, float c[], float cder[], int n); +float chebev(float a, float b, float c[], int m, float x); +void chebft(float a, float b, float c[], int n, float (*func)(float)); +void chebpc(float c[], float d[], int n); +void chint(float a, float b, float c[], float cint[], int n); +float chixy(float bang); +void choldc(float **a, int n, float p[]); +void cholsl(float **a, int n, float p[], float b[], float x[]); +void chsone(float bins[], float ebins[], int nbins, int knstrn, + float *df, float *chsq, float *prob); +void chstwo(float bins1[], float bins2[], int nbins, int knstrn, + float *df, float *chsq, float *prob); +void cisi(float x, float *ci, float *si); +void cntab1(int **nn, int ni, int nj, float *chisq, + float *df, float *prob, float *cramrv, float *ccc); +void cntab2(int **nn, int ni, int nj, float *h, float *hx, float *hy, + float *hygx, float *hxgy, float *uygx, float *uxgy, float *uxy); +void convlv(float data[], unsigned long n, float respns[], unsigned long m, + int isign, float ans[]); +void copy(double **aout, double **ain, int n); +void correl(float data1[], float data2[], unsigned long n, float ans[]); +void cosft(float y[], int n, int isign); +void cosft1(float y[], int n); +void cosft2(float y[], int n, int isign); +void covsrt(float **covar, int ma, int ia[], int mfit); +void crank(unsigned long n, float w[], float *s); +void cyclic(float a[], float b[], float c[], float alpha, float beta, + float r[], float x[], unsigned long n); +void daub4(float a[], unsigned long n, int isign); +float dawson(float x); +float dbrent(float ax, float bx, float cx, + float (*f)(float), float (*df)(float), float tol, float *xmin); +void ddpoly(float c[], int nc, float x, float pd[], int nd); +int decchk(char string[], int n, char *ch); +void derivs(float x, float y[], float dydx[]); +float df1dim(float x); +void dfour1(double data[], unsigned long nn, int isign); +void dfpmin(float p[], int n, float gtol, int *iter, float *fret, + float (*func)(float []), void (*dfunc)(float [], float [])); +float dfridr(float (*func)(float), float x, float h, float *err); +void dftcor(float w, float delta, float a, float b, float endpts[], + float *corre, float *corim, float *corfac); +void dftint(float (*func)(float), float a, float b, float w, + float *cosint, float *sinint); +void difeq(int k, int k1, int k2, int jsf, int is1, int isf, + int indexv[], int ne, float **s, float **y); +void dlinmin(float p[], float xi[], int n, float *fret, + float (*func)(float []), void (*dfunc)(float [], float[])); +double dpythag(double a, double b); +void drealft(double data[], unsigned long n, int isign); +void dsprsax(double sa[], unsigned long ija[], double x[], double b[], + unsigned long n); +void dsprstx(double sa[], unsigned long ija[], double x[], double b[], + unsigned long n); +void dsvbksb(double **u, double w[], double **v, int m, int n, double b[], + double x[]); +void dsvdcmp(double **a, int m, int n, double w[], double **v); +void eclass(int nf[], int n, int lista[], int listb[], int m); +void eclazz(int nf[], int n, int (*equiv)(int, int)); +float ei(float x); +void eigsrt(float d[], float **v, int n); +float elle(float phi, float ak); +float ellf(float phi, float ak); +float ellpi(float phi, float en, float ak); +void elmhes(float **a, int n); +float erfcc(float x); +float erff(float x); +float erffc(float x); +void eulsum(float *sum, float term, int jterm, float wksp[]); +float evlmem(float fdt, float d[], int m, float xms); +float expdev(long *idum); +float expint(int n, float x); +float f1(float x); +float f1dim(float x); +float f2(float y); +float f3(float z); +float factln(int n); +float factrl(int n); +void fasper(float x[], float y[], unsigned long n, float ofac, float hifac, + float wk1[], float wk2[], unsigned long nwk, unsigned long *nout, + unsigned long *jmax, float *prob); +void fdjac(int n, float x[], float fvec[], float **df, + void (*vecfunc)(int, float [], float [])); +void fgauss(float x, float a[], float *y, float dyda[], int na); +void fill0(double **u, int n); +void fit(float x[], float y[], int ndata, float sig[], int mwt, + float *a, float *b, float *siga, float *sigb, float *chi2, float *q); +void fitexy(float x[], float y[], int ndat, float sigx[], float sigy[], + float *a, float *b, float *siga, float *sigb, float *chi2, float *q); +void fixrts(float d[], int m); +void fleg(float x, float pl[], int nl); +void flmoon(int n, int nph, long *jd, float *frac); +float fmin(float x[]); +void four1(float data[], unsigned long nn, int isign); +void fourew(FILE *file[5], int *na, int *nb, int *nc, int *nd); +void fourfs(FILE *file[5], unsigned long nn[], int ndim, int isign); +void fourn(float data[], unsigned long nn[], int ndim, int isign); +void fpoly(float x, float p[], int np); +void fred2(int n, float a, float b, float t[], float f[], float w[], + float (*g)(float), float (*ak)(float, float)); +float fredin(float x, int n, float a, float b, float t[], float f[], float w[], + float (*g)(float), float (*ak)(float, float)); +void frenel(float x, float *s, float *c); +void frprmn(float p[], int n, float ftol, int *iter, float *fret, + float (*func)(float []), void (*dfunc)(float [], float [])); +void ftest(float data1[], unsigned long n1, float data2[], unsigned long n2, + float *f, float *prob); +float gamdev(int ia, long *idum); +float gammln(float xx); +float gammp(float a, float x); +float gammq(float a, float x); +float gasdev(long *idum); +void gaucof(int n, float a[], float b[], float amu0, float x[], float w[]); +void gauher(float x[], float w[], int n); +void gaujac(float x[], float w[], int n, float alf, float bet); +void gaulag(float x[], float w[], int n, float alf); +void gauleg(float x1, float x2, float x[], float w[], int n); +void gaussj(float **a, int n, float **b, int m); +void gcf(float *gammcf, float a, float x, float *gln); +float golden(float ax, float bx, float cx, float (*f)(float), float tol, + float *xmin); +void gser(float *gamser, float a, float x, float *gln); +void hpsel(unsigned long m, unsigned long n, float arr[], float heap[]); +void hpsort(unsigned long n, float ra[]); +void hqr(float **a, int n, float wr[], float wi[]); +void hufapp(unsigned long index[], unsigned long nprob[], unsigned long n, + unsigned long i); +void hufdec(unsigned long *ich, unsigned char *code, unsigned long lcode, + unsigned long *nb, huffcode *hcode); +void hufenc(unsigned long ich, unsigned char **codep, unsigned long *lcode, + unsigned long *nb, huffcode *hcode); +void hufmak(unsigned long nfreq[], unsigned long nchin, unsigned long *ilong, + unsigned long *nlong, huffcode *hcode); +void hunt(float xx[], unsigned long n, float x, unsigned long *jlo); +void hypdrv(float s, float yy[], float dyyds[]); +fcomplex hypgeo(fcomplex a, fcomplex b, fcomplex c, fcomplex z); +void hypser(fcomplex a, fcomplex b, fcomplex c, fcomplex z, + fcomplex *series, fcomplex *deriv); +unsigned short icrc(unsigned short crc, unsigned char *bufptr, + unsigned long len, short jinit, int jrev); +unsigned short icrc1(unsigned short crc, unsigned char onech); +unsigned long igray(unsigned long n, int is); +void iindexx(unsigned long n, long arr[], unsigned long indx[]); +void indexx(unsigned long n, float arr[], unsigned long indx[]); +void interp(double **uf, double **uc, int nf); +int irbit1(unsigned long *iseed); +int irbit2(unsigned long *iseed); +void jacobi(float **a, int n, float d[], float **v, int *nrot); +void jacobn(float x, float y[], float dfdx[], float **dfdy, int n); +long julday(int mm, int id, int iyyy); +void kendl1(float data1[], float data2[], unsigned long n, float *tau, float *z, + float *prob); +void kendl2(float **tab, int i, int j, float *tau, float *z, float *prob); +void kermom(double w[], double y, int m); +void ks2d1s(float x1[], float y1[], unsigned long n1, + void (*quadvl)(float, float, float *, float *, float *, float *), + float *d1, float *prob); +void ks2d2s(float x1[], float y1[], unsigned long n1, float x2[], float y2[], + unsigned long n2, float *d, float *prob); +void ksone(float data[], unsigned long n, float (*func)(float), float *d, + float *prob); +void kstwo(float data1[], unsigned long n1, float data2[], unsigned long n2, + float *d, float *prob); +void laguer(fcomplex a[], int m, fcomplex *x, int *its); +void lfit(float x[], float y[], float sig[], int ndat, float a[], int ia[], + int ma, float **covar, float *chisq, void (*funcs)(float, float [], int)); +void linbcg(unsigned long n, double b[], double x[], int itol, double tol, + int itmax, int *iter, double *err); +void linmin(float p[], float xi[], int n, float *fret, + float (*func)(float [])); +void lnsrch(int n, float xold[], float fold, float g[], float p[], float x[], + float *f, float stpmax, int *check, float (*func)(float [])); +void load(float x1, float v[], float y[]); +void load1(float x1, float v1[], float y[]); +void load2(float x2, float v2[], float y[]); +void locate(float xx[], unsigned long n, float x, unsigned long *j); +void lop(double **out, double **u, int n); +void lubksb(float **a, int n, int *indx, float b[]); +void ludcmp(float **a, int n, int *indx, float *d); +void machar(int *ibeta, int *it, int *irnd, int *ngrd, + int *machep, int *negep, int *iexp, int *minexp, int *maxexp, + float *eps, float *epsneg, float *xmin, float *xmax); +void matadd(double **a, double **b, double **c, int n); +void matsub(double **a, double **b, double **c, int n); +void medfit(float x[], float y[], int ndata, float *a, float *b, float *abdev); +void memcof(float data[], int n, int m, float *xms, float d[]); +int metrop(float de, float t); +void mgfas(double **u, int n, int maxcyc); +void mglin(double **u, int n, int ncycle); +float midexp(float (*funk)(float), float aa, float bb, int n); +float midinf(float (*funk)(float), float aa, float bb, int n); +float midpnt(float (*func)(float), float a, float b, int n); +float midsql(float (*funk)(float), float aa, float bb, int n); +float midsqu(float (*funk)(float), float aa, float bb, int n); +void miser(float (*func)(float []), float regn[], int ndim, unsigned long npts, + float dith, float *ave, float *var); +void mmid(float y[], float dydx[], int nvar, float xs, float htot, + int nstep, float yout[], void (*derivs)(float, float[], float[])); +void mnbrak(float *ax, float *bx, float *cx, float *fa, float *fb, + float *fc, float (*func)(float)); +void mnewt(int ntrial, float x[], int n, float tolx, float tolf); +void moment(float data[], int n, float *ave, float *adev, float *sdev, + float *var, float *skew, float *curt); +void mp2dfr(unsigned char a[], unsigned char s[], int n, int *m); +void mpadd(unsigned char w[], unsigned char u[], unsigned char v[], int n); +void mpdiv(unsigned char q[], unsigned char r[], unsigned char u[], + unsigned char v[], int n, int m); +void mpinv(unsigned char u[], unsigned char v[], int n, int m); +void mplsh(unsigned char u[], int n); +void mpmov(unsigned char u[], unsigned char v[], int n); +void mpmul(unsigned char w[], unsigned char u[], unsigned char v[], int n, + int m); +void mpneg(unsigned char u[], int n); +void mppi(int n); +void mprove(float **a, float **alud, int n, int indx[], float b[], + float x[]); +void mpsad(unsigned char w[], unsigned char u[], int n, int iv); +void mpsdv(unsigned char w[], unsigned char u[], int n, int iv, int *ir); +void mpsmu(unsigned char w[], unsigned char u[], int n, int iv); +void mpsqrt(unsigned char w[], unsigned char u[], unsigned char v[], int n, + int m); +void mpsub(int *is, unsigned char w[], unsigned char u[], unsigned char v[], + int n); +void mrqcof(float x[], float y[], float sig[], int ndata, float a[], + int ia[], int ma, float **alpha, float beta[], float *chisq, + void (*funcs)(float, float [], float *, float [], int)); +void mrqmin(float x[], float y[], float sig[], int ndata, float a[], + int ia[], int ma, float **covar, float **alpha, float *chisq, + void (*funcs)(float, float [], float *, float [], int), float *alamda); +void newt(float x[], int n, int *check, + void (*vecfunc)(int, float [], float [])); +void odeint(float ystart[], int nvar, float x1, float x2, + float eps, float h1, float hmin, int *nok, int *nbad, + void (*derivs)(float, float [], float []), + void (*rkqs)(float [], float [], int, float *, float, float, + float [], float *, float *, void (*)(float, float [], float []))); +void orthog(int n, float anu[], float alpha[], float beta[], float a[], + float b[]); +void pade(double cof[], int n, float *resid); +void pccheb(float d[], float c[], int n); +void pcshft(float a, float b, float d[], int n); +void pearsn(float x[], float y[], unsigned long n, float *r, float *prob, + float *z); +void period(float x[], float y[], int n, float ofac, float hifac, + float px[], float py[], int np, int *nout, int *jmax, float *prob); +void piksr2(int n, float arr[], float brr[]); +void piksrt(int n, float arr[]); +void pinvs(int ie1, int ie2, int je1, int jsf, int jc1, int k, + float ***c, float **s); +float plgndr(int l, int m, float x); +float poidev(float xm, long *idum); +void polcoe(float x[], float y[], int n, float cof[]); +void polcof(float xa[], float ya[], int n, float cof[]); +void poldiv(float u[], int n, float v[], int nv, float q[], float r[]); +void polin2(float x1a[], float x2a[], float **ya, int m, int n, + float x1, float x2, float *y, float *dy); +void polint(float xa[], float ya[], int n, float x, float *y, float *dy); +void powell(float p[], float **xi, int n, float ftol, int *iter, float *fret, + float (*func)(float [])); +void predic(float data[], int ndata, float d[], int m, float future[], int nfut); +float probks(float alam); +void psdes(unsigned long *lword, unsigned long *irword); +void pwt(float a[], unsigned long n, int isign); +void pwtset(int n); +float pythag(float a, float b); +void pzextr(int iest, float xest, float yest[], float yz[], float dy[], + int nv); +float qgaus(float (*func)(float), float a, float b); +void qrdcmp(float **a, int n, float *c, float *d, int *sing); +float qromb(float (*func)(float), float a, float b); +float qromo(float (*func)(float), float a, float b, + float (*choose)(float (*)(float), float, float, int)); +void qroot(float p[], int n, float *b, float *c, float eps); +void qrsolv(float **a, int n, float c[], float d[], float b[]); +void qrupdt(float **r, float **qt, int n, float u[], float v[]); +float qsimp(float (*func)(float), float a, float b); +float qtrap(float (*func)(float), float a, float b); +float quad3d(float (*func)(float, float, float), float x1, float x2); +void quadct(float x, float y, float xx[], float yy[], unsigned long nn, + float *fa, float *fb, float *fc, float *fd); +void quadmx(float **a, int n); +void quadvl(float x, float y, float *fa, float *fb, float *fc, float *fd); +float ran0(long *idum); +float ran1(long *idum); +float ran2(long *idum); +float ran3(long *idum); +float ran4(long *idum); +void rank(unsigned long n, unsigned long indx[], unsigned long irank[]); +void ranpt(float pt[], float regn[], int n); +void ratint(float xa[], float ya[], int n, float x, float *y, float *dy); +void ratlsq(double (*fn)(double), double a, double b, int mm, int kk, + double cof[], double *dev); +double ratval(double x, double cof[], int mm, int kk); +float rc(float x, float y); +float rd(float x, float y, float z); +void realft(float data[], unsigned long n, int isign); +void rebin(float rc, int nd, float r[], float xin[], float xi[]); +void red(int iz1, int iz2, int jz1, int jz2, int jm1, int jm2, int jmf, + int ic1, int jc1, int jcf, int kc, float ***c, float **s); +void relax(double **u, double **rhs, int n); +void relax2(double **u, double **rhs, int n); +void resid(double **res, double **u, double **rhs, int n); +float revcst(float x[], float y[], int iorder[], int ncity, int n[]); +void reverse(int iorder[], int ncity, int n[]); +float rf(float x, float y, float z); +float rj(float x, float y, float z, float p); +void rk4(float y[], float dydx[], int n, float x, float h, float yout[], + void (*derivs)(float, float [], float [])); +void rkck(float y[], float dydx[], int n, float x, float h, + float yout[], float yerr[], void (*derivs)(float, float [], float [])); +void rkdumb(float vstart[], int nvar, float x1, float x2, int nstep, + void (*derivs)(float, float [], float [])); +void rkqs(float y[], float dydx[], int n, float *x, + float htry, float eps, float yscal[], float *hdid, float *hnext, + void (*derivs)(float, float [], float [])); +void rlft3(float ***data, float **speq, unsigned long nn1, + unsigned long nn2, unsigned long nn3, int isign); +float rofunc(float b); +void rotate(float **r, float **qt, int n, int i, float a, float b); +void rsolv(float **a, int n, float d[], float b[]); +void rstrct(double **uc, double **uf, int nc); +float rtbis(float (*func)(float), float x1, float x2, float xacc); +float rtflsp(float (*func)(float), float x1, float x2, float xacc); +float rtnewt(void (*funcd)(float, float *, float *), float x1, float x2, + float xacc); +float rtsafe(void (*funcd)(float, float *, float *), float x1, float x2, + float xacc); +float rtsec(float (*func)(float), float x1, float x2, float xacc); +void rzextr(int iest, float xest, float yest[], float yz[], float dy[], int nv); +void savgol(float c[], int np, int nl, int nr, int ld, int m); +void score(float xf, float y[], float f[]); +void scrsho(float (*fx)(float)); +float select(unsigned long k, unsigned long n, float arr[]); +float selip(unsigned long k, unsigned long n, float arr[]); +void shell(unsigned long n, float a[]); +void shoot(int n, float v[], float f[]); +void shootf(int n, float v[], float f[]); +void simp1(float **a, int mm, int ll[], int nll, int iabf, int *kp, + float *bmax); +void simp2(float **a, int m, int n, int *ip, int kp); +void simp3(float **a, int i1, int k1, int ip, int kp); +void simplx(float **a, int m, int n, int m1, int m2, int m3, int *icase, + int izrov[], int iposv[]); +void simpr(float y[], float dydx[], float dfdx[], float **dfdy, + int n, float xs, float htot, int nstep, float yout[], + void (*derivs)(float, float [], float [])); +void sinft(float y[], int n); +void slvsm2(double **u, double **rhs); +void slvsml(double **u, double **rhs); +void sncndn(float uu, float emmc, float *sn, float *cn, float *dn); +double snrm(unsigned long n, double sx[], int itol); +void sobseq(int *n, float x[]); +void solvde(int itmax, float conv, float slowc, float scalv[], + int indexv[], int ne, int nb, int m, float **y, float ***c, float **s); +void sor(double **a, double **b, double **c, double **d, double **e, + double **f, double **u, int jmax, double rjac); +void sort(unsigned long n, float arr[]); +void sort2(unsigned long n, float arr[], float brr[]); +void sort3(unsigned long n, float ra[], float rb[], float rc[]); +void spctrm(FILE *fp, float p[], int m, int k, int ovrlap); +void spear(float data1[], float data2[], unsigned long n, float *d, float *zd, + float *probd, float *rs, float *probrs); +void sphbes(int n, float x, float *sj, float *sy, float *sjp, float *syp); +void splie2(float x1a[], float x2a[], float **ya, int m, int n, float **y2a); +void splin2(float x1a[], float x2a[], float **ya, float **y2a, int m, int n, + float x1, float x2, float *y); +void spline(float x[], float y[], int n, float yp1, float ypn, float y2[]); +void splint(float xa[], float ya[], float y2a[], int n, float x, float *y); +void spread(float y, float yy[], unsigned long n, float x, int m); +void sprsax(float sa[], unsigned long ija[], float x[], float b[], + unsigned long n); +void sprsin(float **a, int n, float thresh, unsigned long nmax, float sa[], + unsigned long ija[]); +void sprspm(float sa[], unsigned long ija[], float sb[], unsigned long ijb[], + float sc[], unsigned long ijc[]); +void sprstm(float sa[], unsigned long ija[], float sb[], unsigned long ijb[], + float thresh, unsigned long nmax, float sc[], unsigned long ijc[]); +void sprstp(float sa[], unsigned long ija[], float sb[], unsigned long ijb[]); +void sprstx(float sa[], unsigned long ija[], float x[], float b[], + unsigned long n); +void stifbs(float y[], float dydx[], int nv, float *xx, + float htry, float eps, float yscal[], float *hdid, float *hnext, + void (*derivs)(float, float [], float [])); +void stiff(float y[], float dydx[], int n, float *x, + float htry, float eps, float yscal[], float *hdid, float *hnext, + void (*derivs)(float, float [], float [])); +void stoerm(float y[], float d2y[], int nv, float xs, + float htot, int nstep, float yout[], + void (*derivs)(float, float [], float [])); +void svbksb(float **u, float w[], float **v, int m, int n, float b[], + float x[]); +void svdcmp(float **a, int m, int n, float w[], float **v); +void svdfit(float x[], float y[], float sig[], int ndata, float a[], + int ma, float **u, float **v, float w[], float *chisq, + void (*funcs)(float, float [], int)); +void svdvar(float **v, int ma, float w[], float **cvm); +void toeplz(float r[], float x[], float y[], int n); +void tptest(float data1[], float data2[], unsigned long n, float *t, float *prob); +void tqli(float d[], float e[], int n, float **z); +float trapzd(float (*func)(float), float a, float b, int n); +void tred2(float **a, int n, float d[], float e[]); +void tridag(float a[], float b[], float c[], float r[], float u[], + unsigned long n); +float trncst(float x[], float y[], int iorder[], int ncity, int n[]); +void trnspt(int iorder[], int ncity, int n[]); +void ttest(float data1[], unsigned long n1, float data2[], unsigned long n2, + float *t, float *prob); +void tutest(float data1[], unsigned long n1, float data2[], unsigned long n2, + float *t, float *prob); +void twofft(float data1[], float data2[], float fft1[], float fft2[], + unsigned long n); +void vander(double x[], double w[], double q[], int n); +void vegas(float regn[], int ndim, float (*fxn)(float [], float), int init, + unsigned long ncall, int itmx, int nprn, float *tgral, float *sd, + float *chi2a); +void voltra(int n, int m, float t0, float h, float *t, float **f, + float (*g)(int, float), float (*ak)(int, int, float, float)); +void wt1(float a[], unsigned long n, int isign, + void (*wtstep)(float [], unsigned long, int)); +void wtn(float a[], unsigned long nn[], int ndim, int isign, + void (*wtstep)(float [], unsigned long, int)); +void wwghts(float wghts[], int n, float h, + void (*kermom)(double [], double ,int)); +int zbrac(float (*func)(float), float *x1, float *x2); +void zbrak(float (*fx)(float), float x1, float x2, int n, float xb1[], + float xb2[], int *nb); +float zbrent(float (*func)(float), float x1, float x2, float tol); +void zrhqr(float a[], int m, float rtr[], float rti[]); +float zriddr(float (*func)(float), float x1, float x2, float xacc); +void zroots(fcomplex a[], int m, fcomplex roots[], int polish); + +#else /* ANSI */ +/* traditional - K&R */ + +void addint(); +void airy(); +void amebsa(); +void amoeba(); +float amotry(); +float amotsa(); +void anneal(); +double anorm2(); +void arcmak(); +void arcode(); +void arcsum(); +void asolve(); +void atimes(); +void avevar(); +void balanc(); +void banbks(); +void bandec(); +void banmul(); +void bcucof(); +void bcuint(); +void beschb(); +float bessi(); +float bessi0(); +float bessi1(); +void bessik(); +float bessj(); +float bessj0(); +float bessj1(); +void bessjy(); +float bessk(); +float bessk0(); +float bessk1(); +float bessy(); +float bessy0(); +float bessy1(); +float beta(); +float betacf(); +float betai(); +float bico(); +void bksub(); +float bnldev(); +float brent(); +void broydn(); +void bsstep(); +void caldat(); +void chder(); +float chebev(); +void chebft(); +void chebpc(); +void chint(); +float chixy(); +void choldc(); +void cholsl(); +void chsone(); +void chstwo(); +void cisi(); +void cntab1(); +void cntab2(); +void convlv(); +void copy(); +void correl(); +void cosft(); +void cosft1(); +void cosft2(); +void covsrt(); +void crank(); +void cyclic(); +void daub4(); +float dawson(); +float dbrent(); +void ddpoly(); +int decchk(); +void derivs(); +float df1dim(); +void dfour1(); +void dfpmin(); +float dfridr(); +void dftcor(); +void dftint(); +void difeq(); +void dlinmin(); +double dpythag(); +void drealft(); +void dsprsax(); +void dsprstx(); +void dsvbksb(); +void dsvdcmp(); +void eclass(); +void eclazz(); +float ei(); +void eigsrt(); +float elle(); +float ellf(); +float ellpi(); +void elmhes(); +float erfcc(); +float erff(); +float erffc(); +void eulsum(); +float evlmem(); +float expdev(); +float expint(); +float f1(); +float f1dim(); +float f2(); +float f3(); +float factln(); +float factrl(); +void fasper(); +void fdjac(); +void fgauss(); +void fill0(); +void fit(); +void fitexy(); +void fixrts(); +void fleg(); +void flmoon(); +float fmin(); +void four1(); +void fourew(); +void fourfs(); +void fourn(); +void fpoly(); +void fred2(); +float fredin(); +void frenel(); +void frprmn(); +void ftest(); +float gamdev(); +float gammln(); +float gammp(); +float gammq(); +float gasdev(); +void gaucof(); +void gauher(); +void gaujac(); +void gaulag(); +void gauleg(); +void gaussj(); +void gcf(); +float golden(); +void gser(); +void hpsel(); +void hpsort(); +void hqr(); +void hufapp(); +void hufdec(); +void hufenc(); +void hufmak(); +void hunt(); +void hypdrv(); +fcomplex hypgeo(); +void hypser(); +unsigned short icrc(); +unsigned short icrc1(); +unsigned long igray(); +void iindexx(); +void indexx(); +void interp(); +int irbit1(); +int irbit2(); +void jacobi(); +void jacobn(); +long julday(); +void kendl1(); +void kendl2(); +void kermom(); +void ks2d1s(); +void ks2d2s(); +void ksone(); +void kstwo(); +void laguer(); +void lfit(); +void linbcg(); +void linmin(); +void lnsrch(); +void load(); +void load1(); +void load2(); +void locate(); +void lop(); +void lubksb(); +void ludcmp(); +void machar(); +void matadd(); +void matsub(); +void medfit(); +void memcof(); +int metrop(); +void mgfas(); +void mglin(); +float midexp(); +float midinf(); +float midpnt(); +float midsql(); +float midsqu(); +void miser(); +void mmid(); +void mnbrak(); +void mnewt(); +void moment(); +void mp2dfr(); +void mpadd(); +void mpdiv(); +void mpinv(); +void mplsh(); +void mpmov(); +void mpmul(); +void mpneg(); +void mppi(); +void mprove(); +void mpsad(); +void mpsdv(); +void mpsmu(); +void mpsqrt(); +void mpsub(); +void mrqcof(); +void mrqmin(); +void newt(); +void odeint(); +void orthog(); +void pade(); +void pccheb(); +void pcshft(); +void pearsn(); +void period(); +void piksr2(); +void piksrt(); +void pinvs(); +float plgndr(); +float poidev(); +void polcoe(); +void polcof(); +void poldiv(); +void polin2(); +void polint(); +void powell(); +void predic(); +float probks(); +void psdes(); +void pwt(); +void pwtset(); +float pythag(); +void pzextr(); +float qgaus(); +void qrdcmp(); +float qromb(); +float qromo(); +void qroot(); +void qrsolv(); +void qrupdt(); +float qsimp(); +float qtrap(); +float quad3d(); +void quadct(); +void quadmx(); +void quadvl(); +float ran0(); +float ran1(); +float ran2(); +float ran3(); +float ran4(); +void rank(); +void ranpt(); +void ratint(); +void ratlsq(); +double ratval(); +float rc(); +float rd(); +void realft(); +void rebin(); +void red(); +void relax(); +void relax2(); +void resid(); +float revcst(); +void reverse(); +float rf(); +float rj(); +void rk4(); +void rkck(); +void rkdumb(); +void rkqs(); +void rlft3(); +float rofunc(); +void rotate(); +void rsolv(); +void rstrct(); +float rtbis(); +float rtflsp(); +float rtnewt(); +float rtsafe(); +float rtsec(); +void rzextr(); +void savgol(); +void score(); +void scrsho(); +float select(); +float selip(); +void shell(); +void shoot(); +void shootf(); +void simp1(); +void simp2(); +void simp3(); +void simplx(); +void simpr(); +void sinft(); +void slvsm2(); +void slvsml(); +void sncndn(); +double snrm(); +void sobseq(); +void solvde(); +void sor(); +void sort(); +void sort2(); +void sort3(); +void spctrm(); +void spear(); +void sphbes(); +void splie2(); +void splin2(); +void spline(); +void splint(); +void spread(); +void sprsax(); +void sprsin(); +void sprspm(); +void sprstm(); +void sprstp(); +void sprstx(); +void stifbs(); +void stiff(); +void stoerm(); +void svbksb(); +void svdcmp(); +void svdfit(); +void svdvar(); +void toeplz(); +void tptest(); +void tqli(); +float trapzd(); +void tred2(); +void tridag(); +float trncst(); +void trnspt(); +void ttest(); +void tutest(); +void twofft(); +void vander(); +void vegas(); +void voltra(); +void wt1(); +void wtn(); +void wwghts(); +int zbrac(); +void zbrak(); +float zbrent(); +void zrhqr(); +float zriddr(); +void zroots(); + +#endif /* ANSI */ + +#endif /* _NR_H_ */ diff --git a/lib/nr/ansi/other/nrutil.c b/lib/nr/ansi/other/nrutil.c new file mode 100644 index 0000000..6d9e217 --- /dev/null +++ b/lib/nr/ansi/other/nrutil.c @@ -0,0 +1,614 @@ +#if defined(__STDC__) || defined(ANSI) || defined(NRANSI) /* ANSI */ + +#include +#include +#include +#define NR_END 1 +#define FREE_ARG char* + +void nrerror(char error_text[]) +/* Numerical Recipes standard error handler */ +{ + fprintf(stderr,"Numerical Recipes run-time error...\n"); + fprintf(stderr,"%s\n",error_text); + fprintf(stderr,"...now exiting to system...\n"); + exit(1); +} + +float *vector(long nl, long nh) +/* allocate a float vector with subscript range v[nl..nh] */ +{ + float *v; + + v=(float *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(float))); + if (!v) nrerror("allocation failure in vector()"); + return v-nl+NR_END; +} + +int *ivector(long nl, long nh) +/* allocate an int vector with subscript range v[nl..nh] */ +{ + int *v; + + v=(int *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(int))); + if (!v) nrerror("allocation failure in ivector()"); + return v-nl+NR_END; +} + +unsigned char *cvector(long nl, long nh) +/* allocate an unsigned char vector with subscript range v[nl..nh] */ +{ + unsigned char *v; + + v=(unsigned char *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(unsigned char))); + if (!v) nrerror("allocation failure in cvector()"); + return v-nl+NR_END; +} + +unsigned long *lvector(long nl, long nh) +/* allocate an unsigned long vector with subscript range v[nl..nh] */ +{ + unsigned long *v; + + v=(unsigned long *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(long))); + if (!v) nrerror("allocation failure in lvector()"); + return v-nl+NR_END; +} + +double *dvector(long nl, long nh) +/* allocate a double vector with subscript range v[nl..nh] */ +{ + double *v; + + v=(double *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(double))); + if (!v) nrerror("allocation failure in dvector()"); + return v-nl+NR_END; +} + +float **matrix(long nrl, long nrh, long ncl, long nch) +/* allocate a float matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + float **m; + + /* allocate pointers to rows */ + m=(float **) malloc((size_t)((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + /* allocate rows and set pointers to them */ + m[nrl]=(float *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(float))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +double **dmatrix(long nrl, long nrh, long ncl, long nch) +/* allocate a double matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + double **m; + + /* allocate pointers to rows */ + m=(double **) malloc((size_t)((nrow+NR_END)*sizeof(double*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + /* allocate rows and set pointers to them */ + m[nrl]=(double *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(double))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +int **imatrix(long nrl, long nrh, long ncl, long nch) +/* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + int **m; + + /* allocate pointers to rows */ + m=(int **) malloc((size_t)((nrow+NR_END)*sizeof(int*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + + /* allocate rows and set pointers to them */ + m[nrl]=(int *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(int))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +float **submatrix(float **a, long oldrl, long oldrh, long oldcl, long oldch, + long newrl, long newcl) +/* point a submatrix [newrl..][newcl..] to a[oldrl..oldrh][oldcl..oldch] */ +{ + long i,j,nrow=oldrh-oldrl+1,ncol=oldcl-newcl; + float **m; + + /* allocate array of pointers to rows */ + m=(float **) malloc((size_t) ((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure in submatrix()"); + m += NR_END; + m -= newrl; + + /* set pointers to rows */ + for(i=oldrl,j=newrl;i<=oldrh;i++,j++) m[j]=a[i]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +float **convert_matrix(float *a, long nrl, long nrh, long ncl, long nch) +/* allocate a float matrix m[nrl..nrh][ncl..nch] that points to the matrix +declared in the standard C manner as a[nrow][ncol], where nrow=nrh-nrl+1 +and ncol=nch-ncl+1. The routine should be called with the address +&a[0][0] as the first argument. */ +{ + long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1; + float **m; + + /* allocate pointers to rows */ + m=(float **) malloc((size_t) ((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure in convert_matrix()"); + m += NR_END; + m -= nrl; + + /* set pointers to rows */ + m[nrl]=a-ncl; + for(i=1,j=nrl+1;i +#define NR_END 1 +#define FREE_ARG char* + +void nrerror(error_text) +char error_text[]; +/* Numerical Recipes standard error handler */ +{ + void exit(); + + fprintf(stderr,"Numerical Recipes run-time error...\n"); + fprintf(stderr,"%s\n",error_text); + fprintf(stderr,"...now exiting to system...\n"); + exit(1); +} + +float *vector(nl,nh) +long nh,nl; +/* allocate a float vector with subscript range v[nl..nh] */ +{ + float *v; + + v=(float *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(float))); + if (!v) nrerror("allocation failure in vector()"); + return v-nl+NR_END; +} + +int *ivector(nl,nh) +long nh,nl; +/* allocate an int vector with subscript range v[nl..nh] */ +{ + int *v; + + v=(int *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(int))); + if (!v) nrerror("allocation failure in ivector()"); + return v-nl+NR_END; +} + +unsigned char *cvector(nl,nh) +long nh,nl; +/* allocate an unsigned char vector with subscript range v[nl..nh] */ +{ + unsigned char *v; + + v=(unsigned char *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(unsigned char))); + if (!v) nrerror("allocation failure in cvector()"); + return v-nl+NR_END; +} + +unsigned long *lvector(nl,nh) +long nh,nl; +/* allocate an unsigned long vector with subscript range v[nl..nh] */ +{ + unsigned long *v; + + v=(unsigned long *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(long))); + if (!v) nrerror("allocation failure in lvector()"); + return v-nl+NR_END; +} + +double *dvector(nl,nh) +long nh,nl; +/* allocate a double vector with subscript range v[nl..nh] */ +{ + double *v; + + v=(double *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(double))); + if (!v) nrerror("allocation failure in dvector()"); + return v-nl+NR_END; +} + +float **matrix(nrl,nrh,ncl,nch) +long nch,ncl,nrh,nrl; +/* allocate a float matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + float **m; + + /* allocate pointers to rows */ + m=(float **) malloc((unsigned int)((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + /* allocate rows and set pointers to them */ + m[nrl]=(float *) malloc((unsigned int)((nrow*ncol+NR_END)*sizeof(float))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +double **dmatrix(nrl,nrh,ncl,nch) +long nch,ncl,nrh,nrl; +/* allocate a double matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + double **m; + + /* allocate pointers to rows */ + m=(double **) malloc((unsigned int)((nrow+NR_END)*sizeof(double*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + /* allocate rows and set pointers to them */ + m[nrl]=(double *) malloc((unsigned int)((nrow*ncol+NR_END)*sizeof(double))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +int **imatrix(nrl,nrh,ncl,nch) +long nch,ncl,nrh,nrl; +/* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + int **m; + + /* allocate pointers to rows */ + m=(int **) malloc((unsigned int)((nrow+NR_END)*sizeof(int*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + + /* allocate rows and set pointers to them */ + m[nrl]=(int *) malloc((unsigned int)((nrow*ncol+NR_END)*sizeof(int))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +float **submatrix(a,oldrl,oldrh,oldcl,oldch,newrl,newcl) +float **a; +long newcl,newrl,oldch,oldcl,oldrh,oldrl; +/* point a submatrix [newrl..][newcl..] to a[oldrl..oldrh][oldcl..oldch] */ +{ + long i,j,nrow=oldrh-oldrl+1,ncol=oldcl-newcl; + float **m; + + /* allocate array of pointers to rows */ + m=(float **) malloc((unsigned int) ((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure in submatrix()"); + m += NR_END; + m -= newrl; + + /* set pointers to rows */ + for(i=oldrl,j=newrl;i<=oldrh;i++,j++) m[j]=a[i]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +float **convert_matrix(a,nrl,nrh,ncl,nch) +float *a; +long nch,ncl,nrh,nrl; +/* allocate a float matrix m[nrl..nrh][ncl..nch] that points to the matrix +declared in the standard C manner as a[nrow][ncol], where nrow=nrh-nrl+1 +and ncol=nch-ncl+1. The routine should be called with the address +&a[0][0] as the first argument. */ +{ + long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1; + float **m; + + /* allocate pointers to rows */ + m=(float **) malloc((unsigned int) ((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure in convert_matrix()"); + m += NR_END; + m -= nrl; + + /* set pointers to rows */ + m[nrl]=a-ncl; + for(i=1,j=nrl+1;i (dmaxarg2) ?\ + (dmaxarg1) : (dmaxarg2)) + +static double dminarg1,dminarg2; +#define DMIN(a,b) (dminarg1=(a),dminarg2=(b),(dminarg1) < (dminarg2) ?\ + (dminarg1) : (dminarg2)) + +static float maxarg1,maxarg2; +#define FMAX(a,b) (maxarg1=(a),maxarg2=(b),(maxarg1) > (maxarg2) ?\ + (maxarg1) : (maxarg2)) + +static float minarg1,minarg2; +#define FMIN(a,b) (minarg1=(a),minarg2=(b),(minarg1) < (minarg2) ?\ + (minarg1) : (minarg2)) + +static long lmaxarg1,lmaxarg2; +#define LMAX(a,b) (lmaxarg1=(a),lmaxarg2=(b),(lmaxarg1) > (lmaxarg2) ?\ + (lmaxarg1) : (lmaxarg2)) + +static long lminarg1,lminarg2; +#define LMIN(a,b) (lminarg1=(a),lminarg2=(b),(lminarg1) < (lminarg2) ?\ + (lminarg1) : (lminarg2)) + +static int imaxarg1,imaxarg2; +#define IMAX(a,b) (imaxarg1=(a),imaxarg2=(b),(imaxarg1) > (imaxarg2) ?\ + (imaxarg1) : (imaxarg2)) + +static int iminarg1,iminarg2; +#define IMIN(a,b) (iminarg1=(a),iminarg2=(b),(iminarg1) < (iminarg2) ?\ + (iminarg1) : (iminarg2)) + +#define SIGN(a,b) ((b) >= 0.0 ? fabs(a) : -fabs(a)) + +#if defined(__STDC__) || defined(ANSI) || defined(NRANSI) /* ANSI */ + +void nrerror(char error_text[]); +float *vector(long nl, long nh); +int *ivector(long nl, long nh); +unsigned char *cvector(long nl, long nh); +unsigned long *lvector(long nl, long nh); +double *dvector(long nl, long nh); +float **matrix(long nrl, long nrh, long ncl, long nch); +double **dmatrix(long nrl, long nrh, long ncl, long nch); +int **imatrix(long nrl, long nrh, long ncl, long nch); +float **submatrix(float **a, long oldrl, long oldrh, long oldcl, long oldch, + long newrl, long newcl); +float **convert_matrix(float *a, long nrl, long nrh, long ncl, long nch); +float ***f3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh); +void free_vector(float *v, long nl, long nh); +void free_ivector(int *v, long nl, long nh); +void free_cvector(unsigned char *v, long nl, long nh); +void free_lvector(unsigned long *v, long nl, long nh); +void free_dvector(double *v, long nl, long nh); +void free_matrix(float **m, long nrl, long nrh, long ncl, long nch); +void free_dmatrix(double **m, long nrl, long nrh, long ncl, long nch); +void free_imatrix(int **m, long nrl, long nrh, long ncl, long nch); +void free_submatrix(float **b, long nrl, long nrh, long ncl, long nch); +void free_convert_matrix(float **b, long nrl, long nrh, long ncl, long nch); +void free_f3tensor(float ***t, long nrl, long nrh, long ncl, long nch, + long ndl, long ndh); + +#else /* ANSI */ +/* traditional - K&R */ + +void nrerror(); +float *vector(); +float **matrix(); +float **submatrix(); +float **convert_matrix(); +float ***f3tensor(); +double *dvector(); +double **dmatrix(); +int *ivector(); +int **imatrix(); +unsigned char *cvector(); +unsigned long *lvector(); +void free_vector(); +void free_dvector(); +void free_ivector(); +void free_cvector(); +void free_lvector(); +void free_matrix(); +void free_submatrix(); +void free_convert_matrix(); +void free_dmatrix(); +void free_imatrix(); +void free_f3tensor(); + +#endif /* ANSI */ + +#endif /* _NR_UTILS_H_ */ diff --git a/lib/nr/ansi/progs.htm b/lib/nr/ansi/progs.htm new file mode 100644 index 0000000..fa9c85d --- /dev/null +++ b/lib/nr/ansi/progs.htm @@ -0,0 +1,776 @@ +NRcdrom Progs. Server/Internet Use Prohibited. + +

    Numerical Recipes Routines by Chapter and Section

    + +Chapter number links jump to the corresponding place in the +book Table of Contents. (Click on the Chapter number to get back.) +Routine name links jump to the listing +of the program. Example links jump to an example program that +shows the use of the routine.

    +

    Chapter +1

    + +
  • [1.0] +flmoon calculate phases of the moon by date + (example)
  • [1.1] +julday Julian Day number from calendar date + (example)
  • [1.1] +badluk Friday the 13th when the moon is full +
  • [1.1] +caldat calendar date from Julian day number + (example)
    •  +

    Chapter +2

    + +
  • [2.1] +gaussj Gauss-Jordan matrix inversion and linear equation solution + (example)
  • [2.3] +ludcmp linear equation solution, LU decomposition + (example)
  • [2.3] +lubksb linear equation solution, backsubstitution + (example)
  • [2.4] +tridag solution of tridiagonal systems + (example)
  • [2.4] +banmul multiply vector by band diagonal matrix + (example)
  • [2.4] +bandec band diagonal systems, decomposition + (example)
  • [2.4] +banbks band diagonal systems, backsubstitution +
  • [2.5] +mprove linear equation solution, iterative improvement + (example)
  • [2.6] +svbksb singular value backsubstitution + (example)
  • [2.6] +svdcmp singular value decomposition of a matrix + (example)
  • [2.6] +pythag calculate (a^2+b^2)^{1/2} without overflow +
  • [2.7] +cyclic solution of cyclic tridiagonal systems + (example)
  • [2.7] +sprsin convert matrix to sparse format + (example)
  • [2.7] +sprsax product of sparse matrix and vector + (example)
  • [2.7] +sprstx product of transpose sparse matrix and vector + (example)
  • [2.7] +sprstp transpose of sparse matrix + (example)
  • [2.7] +sprspm pattern multiply two sparse matrices + (example)
  • [2.7] +sprstm threshold multiply two sparse matrices + (example)
  • [2.7] +linbcg biconjugate gradient solution of sparse systems + (example)
  • [2.7] +snrm used by linbcg for vector norm +
  • [2.7] +atimes used by linbcg for sparse multiplication +
  • [2.7] +asolve used by linbcg for preconditioner +
  • [2.8] +vander solve Vandermonde systems + (example)
  • [2.8] +toeplz solve Toeplitz systems + (example)
  • [2.9] +choldc Cholesky decomposition +
  • [2.9] +cholsl Cholesky backsubstitution + (example)
  • [2.10] +qrdcmp QR decomposition + (example)
  • [2.10] +qrsolv QR backsubstitution + (example)
  • [2.10] +rsolv right triangular backsubstitution +
  • [2.10] +qrupdt update a QR decomposition + (example)
  • [2.10] +rotate Jacobi rotation used by qrupdt +
    •  +

    Chapter +3

    + +
  • [3.1] +polint polynomial interpolation + (example)
  • [3.2] +ratint rational function interpolation + (example)
  • [3.3] +spline construct a cubic spline + (example)
  • [3.3] +splint cubic spline interpolation + (example)
  • [3.4] +locate search an ordered table by bisection + (example)
  • [3.4] +hunt search a table when calls are correlated + (example)
  • [3.5] +polcoe polynomial coefficients from table of values + (example)
  • [3.5] +polcof polynomial coefficients from table of values + (example)
  • [3.6] +polin2 two-dimensional polynomial interpolation + (example)
  • [3.6] +bcucof construct two-dimensional bicubic + (example)
  • [3.6] +bcuint two-dimensional bicubic interpolation + (example)
  • [3.6] +splie2 construct two-dimensional spline + (example)
  • [3.6] +splin2 two-dimensional spline interpolation + (example)
    •  +

    Chapter +4

    + +
  • [4.2] +trapzd trapezoidal rule + (example)
  • [4.2] +qtrap integrate using trapezoidal rule + (example)
  • [4.2] +qsimp integrate using Simpson's rule + (example)
  • [4.3] +qromb integrate using Romberg adaptive method + (example)
  • [4.4] +midpnt extended midpoint rule + (example)
  • [4.4] +qromo integrate using open Romberg adaptive method + (example)
  • [4.4] +midinf integrate a function on a semi-infinite interval +
  • [4.4] +midsql integrate a function with lower square-root singularity +
  • [4.4] +midsqu integrate a function with upper square-root singularity +
  • [4.4] +midexp integrate a function that decreases exponentially +
  • [4.5] +qgaus integrate a function by Gaussian quadratures + (example)
  • [4.5] +gauleg Gauss-Legendre weights and abscissas + (example)
  • [4.5] +gaulag Gauss-Laguerre weights and abscissas + (example)
  • [4.5] +gauher Gauss-Hermite weights and abscissas + (example)
  • [4.5] +gaujac Gauss-Jacobi weights and abscissas + (example)
  • [4.5] +gaucof quadrature weights from orthogonal polynomials + (example)
  • [4.5] +orthog construct nonclassical orthogonal polynomials + (example)
  • [4.6] +quad3d integrate a function over a three-dimensional space + (example)
    •  +

    Chapter +5

    + +
  • [5.1] +eulsum sum a series by Euler--van Wijngaarden algorithm + (example)
  • [5.3] +ddpoly evaluate a polynomial and its derivatives + (example)
  • [5.3] +poldiv divide one polynomial by another + (example)
  • [5.3] +ratval evaluate a rational function +
  • [5.7] +dfridr numerical derivative by Ridders' method + (example)
  • [5.8] +chebft fit a Chebyshev polynomial to a function + (example)
  • [5.8] +chebev Chebyshev polynomial evaluation + (example)
  • [5.9] +chder derivative of a function already Chebyshev fitted + (example)
  • [5.9] +chint integrate a function already Chebyshev fitted + (example)
  • [5.10] +chebpc polynomial coefficients from a Chebyshev fit + (example)
  • [5.10] +pcshft polynomial coefficients of a shifted polynomial + (example)
  • [5.11] +pccheb inverse of chebpc; use to economize power series + (example)
  • [5.12] +pade Pade approximant from power series coefficients + (example)
  • [5.13] +ratlsq rational fit by least-squares method + (example)
    •  +

    Chapter +6

    + +
  • [6.1] +gammln logarithm of gamma function + (example)
  • [6.1] +factrl factorial function + (example)
  • [6.1] +bico binomial coefficients function + (example)
  • [6.1] +factln logarithm of factorial function + (example)
  • [6.1] +beta beta function + (example)
  • [6.2] +gammp incomplete gamma function + (example)
  • [6.2] +gammq complement of incomplete gamma function + (example)
  • [6.2] +gser series used by gammp and gammq + (example)
  • [6.2] +gcf continued fraction used by gammp and gammq + (example)
  • [6.2] +erf error function +
  • [6.2] +erfc complementary error function +
  • [6.2] +erfcc complementary error function, concise routine + (example)
  • [6.3] +expint exponential integral E_n + (example)
  • [6.3] +ei exponential integral Ei + (example)
  • [6.4] +betai incomplete beta function + (example)
  • [6.4] +betacf continued fraction used by betai +
  • [6.5] +bessj0 Bessel function J_0 + (example)
  • [6.5] +bessy0 Bessel function Y_0 + (example)
  • [6.5] +bessj1 Bessel function J_1 + (example)
  • [6.5] +bessy1 Bessel function Y_1 + (example)
  • [6.5] +bessy Bessel function Y of general integer order + (example)
  • [6.5] +bessj Bessel function J of general integer order + (example)
  • [6.6] +bessi0 modified Bessel function I_0 + (example)
  • [6.6] +bessk0 modified Bessel function K_0 + (example)
  • [6.6] +bessi1 modified Bessel function I_1 + (example)
  • [6.6] +bessk1 modified Bessel function K_1 + (example)
  • [6.6] +bessk modified Bessel function K of integer order + (example)
  • [6.6] +bessi modified Bessel function I of integer order + (example)
  • [6.7] +bessjy Bessel functions of fractional order + (example)
  • [6.7] +beschb Chebyshev expansion used by bessjy + (example)
  • [6.7] +bessik modified Bessel functions of fractional order + (example)
  • [6.7] +airy Airy functions +
  • [6.7] +sphbes spherical Bessel functions j_n and y_n + (example)
  • [6.8] +plgndr Legendre polynomials, associated (spherical harmonics) + (example)
  • [6.9] +frenel Fresnel integrals S(x) and C(x) + (example)
  • [6.9] +cisi cosine and sine integrals Ci and Si +
  • [6.10] +dawson Dawson's integral + (example)
  • [6.11] +rf Carlson's elliptic integral of the first kind + (example)
  • [6.11] +rd Carlson's elliptic integral of the second kind + (example)
  • [6.11] +rj Carlson's elliptic integral of the third kind + (example)
  • [6.11] +rc Carlson's degenerate elliptic integral + (example)
  • [6.11] +ellf Legendre elliptic integral of the first kind + (example)
  • [6.11] +elle Legendre elliptic integral of the second kind + (example)
  • [6.11] +ellpi Legendre elliptic integral of the third kind + (example)
  • [6.11] +sncndn Jacobian elliptic functions + (example)
  • [6.12] +hypgeo complex hypergeometric function + (example)
  • [6.12] +hypser complex hypergeometric function, series evaluation +
  • [6.12] +hypdrv complex hypergeometric function, derivative of +
    •  +

    Chapter +7

    + +
  • [7.1] +ran0 random deviate by Park and Miller minimal standard +
  • [7.1] +ran1 random deviate, minimal standard plus shuffle +
  • [7.1] +ran2 random deviate by L'Ecuyer long period plus shuffle +
  • [7.1] +ran3 random deviate by Knuth subtractive method +
  • [7.2] +expdev exponential random deviates + (example)
  • [7.2] +gasdev normally distributed random deviates + (example)
  • [7.3] +gamdev gamma-law distribution random deviates + (example)
  • [7.3] +poidev Poisson distributed random deviates + (example)
  • [7.3] +bnldev binomial distributed random deviates + (example)
  • [7.4] +irbit1 random bit sequence + (example)
  • [7.4] +irbit2 random bit sequence + (example)
  • [7.5] +psdes ``pseudo-DES'' hashing of 64 bits + (example)
  • [7.5] +ran4 random deviates from DES-like hashing + (example)
  • [7.7] +sobseq Sobol's quasi-random sequence + (example)
  • [7.8] +vegas adaptive multidimensional Monte Carlo integration + (example)
  • [7.8] +rebin sample rebinning used by vegas +
  • [7.8] +miser recursive multidimensional Monte Carlo integration + (example)
  • [7.8] +ranpt get random point, used by miser +
    •  +

    Chapter +8

    + +
  • [8.1] +piksrt sort an array by straight insertion + (example)
  • [8.1] +piksr2 sort two arrays by straight insertion + (example)
  • [8.1] +shell sort an array by Shell's method + (example)
  • [8.2] +sort sort an array by quicksort method + (example)
  • [8.2] +sort2 sort two arrays by quicksort method + (example)
  • [8.3] +hpsort sort an array by heapsort method + (example)
  • [8.4] +indexx construct an index for an array + (example)
  • [8.4] +sort3 sort, use an index to sort 3 or more arrays + (example)
  • [8.4] +rank construct a rank table for an array + (example)
  • [8.5] +select find the Nth largest in an array + (example)
  • [8.5] +selip find the Nth largest, without altering an array + (example)
  • [8.5] +hpsel find M largest values, without altering an array + (example)
  • [8.6] +eclass determine equivalence classes from list + (example)
  • [8.6] +eclazz determine equivalence classes from procedure + (example)
    •  +

    Chapter +9

    + +
  • [9.0] +scrsho graph a function to search for roots + (example)
  • [9.1] +zbrac outward search for brackets on roots + (example)
  • [9.1] +zbrak inward search for brackets on roots + (example)
  • [9.1] +rtbis find root of a function by bisection + (example)
  • [9.2] +rtflsp find root of a function by false-position + (example)
  • [9.2] +rtsec find root of a function by secant method + (example)
  • [9.2] +zriddr find root of a function by Ridders' method + (example)
  • [9.3] +zbrent find root of a function by Brent's method + (example)
  • [9.4] +rtnewt find root of a function by Newton-Raphson + (example)
  • [9.4] +rtsafe find root of a function by Newton-Raphson and bisection + (example)
  • [9.5] +laguer find a root of a polynomial by Laguerre's method + (example)
  • [9.5] +zroots roots of a polynomial by Laguerre's method with deflation + (example)
  • [9.5] +zrhqr roots of a polynomial by eigenvalue methods + (example)
  • [9.5] +qroot complex or double root of a polynomial, Bairstow + (example)
  • [9.6] +mnewt Newton's method for systems of equations + (example)
  • [9.7] +lnsrch search along a line, used by newt +
  • [9.7] +newt globally convergent multi-dimensional Newton's method + (example)
  • [9.7] +fdjac finite-difference Jacobian, used by newt +
  • [9.7] +fmin norm of a vector function, used by newt +
  • [9.7] +broydn secant method for systems of equations + (example)
    •  +

    Chapter +10

    + +
  • [10.1] +mnbrak bracket the minimum of a function + (example)
  • [10.1] +golden find minimum of a function by golden section search + (example)
  • [10.2] +brent find minimum of a function by Brent's method + (example)
  • [10.3] +dbrent find minimum of a function using derivative information + (example)
  • [10.4] +amoeba minimize in N-dimensions by downhill simplex method + (example)
  • [10.4] +amotry evaluate a trial point, used by amoeba +
  • [10.5] +powell minimize in N-dimensions by Powell's method + (example)
  • [10.5] +linmin minimum of a function along a ray in N-dimensions + (example)
  • [10.5] +f1dim function used by LINMIN + (example)
  • [10.6] +frprmn minimize in N-dimensions by conjugate gradient + (example)
  • [10.6] +df1dim alternative function used by LINMIN + (example)
  • [10.7] +dfpmin minimize in N-dimensions by variable metric method + (example)
  • [10.8] +simplx linear programming maximization of a linear function + (example)
  • [10.8] +simp1 linear programming, used by SIMPLX +
  • [10.8] +simp2 linear programming, used by SIMPLX +
  • [10.8] +simp3 linear programming, used by SIMPLX +
  • [10.9] +anneal traveling salesman problem by simulated annealing + (example)
  • [10.9] +revcst cost of a reversal, used by anneal +
  • [10.9] +reverse do a reversal, used by anneal +
  • [10.9] +trncst cost of a transposition, used by anneal +
  • [10.9] +trnspt do a transposition, used by anneal +
  • [10.9] +metrop Metropolis algorithm, used by anneal +
  • [10.9] +amebsa simulated annealing in continuous spaces + (example)
  • [10.9] +amotsa evaluate a trial point, used by amebsa +
    •  +

    Chapter +11

    + +
  • [11.1] +jacobi eigenvalues and eigenvectors of a symmetric matrix + (example)
  • [11.1] +eigsrt eigenvectors, sorts into order by eigenvalue + (example)
  • [11.2] +tred2 Householder reduction of a real, symmetric matrix + (example)
  • [11.3] +tqli eigensolution of a symmetric tridiagonal matrix + (example)
  • [11.5] +balanc balance a nonsymmetric matrix + (example)
  • [11.5] +elmhes reduce a general matrix to Hessenberg form + (example)
  • [11.6] +hqr eigenvalues of a Hessenberg matrix + (example)
    •  +

    Chapter +12

    + +
  • [12.2] +four1 fast Fourier transform (FFT) in one dimension + (example)
  • [12.3] +twofft fast Fourier transform of two real functions + (example)
  • [12.3] +realft fast Fourier transform of a single real function + (example)
  • [12.3] +sinft fast sine transform + (example)
  • [12.3] +cosft1 fast cosine transform with endpoints + (example)
  • [12.3] +cosft2 ``staggered'' fast cosine transform + (example)
  • [12.4] +fourn fast Fourier transform in multidimensions + (example)
  • [12.5] +rlft3 FFT of real data in two or three dimensions + (example)
  • [12.6] +fourfs FFT for huge data sets on external media + (example)
  • [12.6] +fourew rewind and permute files, used by fourfs +
    •  +

    Chapter +13

    + +
  • [13.1] +convlv convolution or deconvolution of data using FFT + (example)
  • [13.2] +correl correlation or autocorrelation of data using FFT + (example)
  • [13.4] +spctrm power spectrum estimation using FFT + (example)
  • [13.6] +memcof evaluate maximum entropy (MEM) coefficients + (example)
  • [13.6] +fixrts reflect roots of a polynomial into unit circle + (example)
  • [13.6] +predic linear prediction using MEM coefficients + (example)
  • [13.7] +evlmem power spectral estimation from MEM coefficients + (example)
  • [13.8] +period power spectrum of unevenly sampled data + (example)
  • [13.8] +fasper power spectrum of unevenly sampled larger data sets + (example)
  • [13.8] +spread extirpolate value into array, used by fasper +
  • [13.9] +dftcor compute endpoint corrections for Fourier integrals +
  • [13.9] +dftint high-accuracy Fourier integrals + (example)
  • [13.10] +wt1 one-dimensional discrete wavelet transform +
  • [13.10] +daub4 Daubechies 4-coefficient wavelet filter +
  • [13.10] +pwtset initialize coefficients for pwt +
  • [13.10] +pwt partial wavelet transform +
  • [13.10] +wtn multidimensional discrete wavelet transform +
    •  +

    Chapter +14

    + +
  • [14.1] +moment calculate moments of a data set + (example)
  • [14.2] +ttest Student's t-test for difference of means + (example)
  • [14.2] +avevar calculate mean and variance of a data set + (example)
  • [14.2] +tutest Student's t-test for means, case of unequal variances + (example)
  • [14.2] +tptest Student's t-test for means, case of paired data + (example)
  • [14.2] +ftest F-test for difference of variances + (example)
  • [14.3] +chsone chi-square test for difference between data and model + (example)
  • [14.3] +chstwo chi-square test for difference between two data sets + (example)
  • [14.3] +ksone Kolmogorov-Smirnov test of data against model + (example)
  • [14.3] +kstwo Kolmogorov-Smirnov test between two data sets + (example)
  • [14.3] +probks Kolmogorov-Smirnov probability function + (example)
  • [14.4] +cntab1 contingency table analysis using chi-square + (example)
  • [14.4] +cntab2 contingency table analysis using entropy measure + (example)
  • [14.5] +pearsn Pearson's correlation between two data sets + (example)
  • [14.6] +spear Spearman's rank correlation between two data sets + (example)
  • [14.6] +crank replaces array elements by their rank + (example)
  • [14.6] +kendl1 correlation between two data sets, Kendall's tau + (example)
  • [14.6] +kendl2 contingency table analysis using Kendall's tau + (example)
  • [14.7] +ks2d1s K--S test in two dimensions, data vs. model + (example)
  • [14.7] +quadct count points by quadrants, used by ks2d1s +
  • [14.7] +quadvl quadrant probabilities, used by ks2d1s +
  • [14.7] +ks2d2s K--S test in two dimensions, data vs. data + (example)
  • [14.8] +savgol Savitzky-Golay smoothing coefficients + (example)
    •  +

    Chapter +15

    + +
  • [15.2] +fit least-squares fit data to a straight line + (example)
  • [15.3] +fitexy fit data to a straight line, errors in both x and y + (example)
  • [15.3] +chixy used by fitexy to calculate a chi^2 +
  • [15.4] +lfit general linear least-squares fit by normal equations + (example)
  • [15.4] +covsrt rearrange covariance matrix, used by LFIT + (example)
  • [15.4] +svdfit linear least-squares fit by singular value decomposition + (example)
  • [15.4] +svdvar variances from singular value decomposition + (example)
  • [15.4] +fpoly fit a polynomial using LFIT or SVDFIT + (example)
  • [15.4] +fleg fit a Legendre polynomial using LFIT or SVDFIT + (example)
  • [15.5] +mrqmin nonlinear least-squares fit, Marquardt's method + (example)
  • [15.5] +mrqcof used by MRQMIN to evaluate coefficients + (example)
  • [15.5] +fgauss fit a sum of Gaussians using MRQMIN + (example)
  • [15.7] +medfit fit data to a straight line robustly, least absolute deviation + (example)
  • [15.7] +rofunc fit data robustly, used by MEDFIT + (example)
    •  +

    Chapter +16

    + +
  • [16.1] +rk4 integrate one step of ODEs, fourth-order Runge-Kutta + (example)
  • [16.1] +rkdumb integrate ODEs by fourth-order Runge-Kutta + (example)
  • [16.2] +rkqs integrate one step of ODEs with accuracy monitoring + (example)
  • [16.2] +rkck Cash-Karp-Runge-Kutta step used by rkqs +
  • [16.2] +odeint integrate ODEs with accuracy monitoring + (example)
  • [16.3] +mmid integrate ODEs by modified midpoint method + (example)
  • [16.4] +bsstep integrate ODEs, Bulirsch-Stoer step + (example)
  • [16.4] +pzextr polynomial extrapolation, used by BSSTEP + (example)
  • [16.4] +rzextr rational function extrapolation, used by BSSTEP + (example)
  • [16.5] +stoerm integrate conservative second-order ODEs + (example)
  • [16.6] +stiff integrate stiff ODEs by fourth-order Rosenbrock + (example)
  • [16.6] +jacobn sample Jacobian routine for stiff +
  • [16.6] +derivs sample derivatives routine for stiff +
  • [16.6] +simpr integrate stiff ODEs by semi-implicit midpoint rule + (example)
  • [16.6] +stifbs integrate stiff ODEs, Bulirsch-Stoer step + (example)
    •  +

    Chapter +17

    + +
  • [17.1] +shoot solve two point boundary value problem by shooting +
  • [17.2] +shootf ditto, by shooting to a fitting point +
  • [17.3] +solvde two point boundary value problem, solve by relaxation +
  • [17.3] +bksub backsubstitution, used by SOLVDE +
  • [17.3] +pinvs diagonalize a sub-block, used by SOLVDE +
  • [17.3] +red reduce columns of a matrix, used by SOLVDE +
  • [17.4] +sfroid spheroidal functions by method of SOLVDE +
  • [17.4] +difeq spheroidal matrix coefficients, used by SFROID +
  • [17.4] +sphoot spheroidal functions by method of shoot +
  • [17.4] +sphfpt spheroidal functions by method of shootf + (example)
    •  +

    Chapter +18

    + +
  • [18.1] +fred2 solve linear Fredholm equations of the second kind + (example)
  • [18.1] +fredin interpolate solutions obtained with fred2 + (example)
  • [18.2] +voltra linear Volterra equations of the second kind + (example)
  • [18.3] +wwghts quadrature weights for an arbitrarily singular kernel +
  • [18.3] +kermom sample routine for moments of a singular kernel +
  • [18.3] +quadmx sample routine for a quadrature matrix +
  • [18.3] +fredex example of solving a singular Fredholm equation +
    •  +

    Chapter +19

    + +
  • [19.5] +sor elliptic PDE solved by successive overrelaxation method + (example)
  • [19.6] +mglin linear elliptic PDE solved by multigrid method + (example)
  • [19.6] +rstrct half-weighting restriction, used by mglin, mgfas +
  • [19.6] +interp bilinear prolongation, used by mglin, mgfas +
  • [19.6] +addint interpolate and add, used by mglin +
  • [19.6] +slvsml solve on coarsest grid, used by mglin +
  • [19.6] +relax Gauss-Seidel relaxation, used by mglin +
  • [19.6] +resid calculate residual, used by mglin +
  • [19.6] +copy utility used by mglin, mgfas +
  • [19.6] +fill0 utility used by mglin +
  • [19.6] +mgfas nonlinear elliptic PDE solved by multigrid method + (example)
  • [19.6] +relax2 Gauss-Seidel relaxation, used by mgfas +
  • [19.6] +slvsm2 solve on coarsest grid, used by mgfas +
  • [19.6] +lop applies nonlinear operator, used by mgfas +
  • [19.6] +matadd utility used by mgfas +
  • [19.6] +matsub utility used by mgfas +
  • [19.6] +anorm2 utility used by mgfas +
    •  +

    Chapter +20

    + +
  • [20.1] +machar diagnose computer's floating arithmetic + (example)
  • [20.2] +igray Gray code and its inverse + (example)
  • [20.3] +icrc1 cyclic redundancy checksum, used by icrc +
  • [20.3] +icrc cyclic redundancy checksum + (example)
  • [20.3] +decchk decimal check digit calculation or verification + (example)
  • [20.4] +hufmak construct a Huffman code +
  • [20.4] +hufapp append bits to a Huffman code, used by hufmak +
  • [20.4] +hufenc use Huffman code to encode and compress a character +
  • [20.4] +hufdec use Huffman code to decode and decompress a character +
  • [20.5] +arcmak construct an arithmetic code +
  • [20.5] +arcode encode or decode a character using arithmetic coding + (example)
  • [20.5] +arcsum add integer to byte string, used by arcode +
  • [20.6] +mpops multiple precision arithmetic, simpler operations +
  • [20.6] +mpmul multiple precision multiply, using FFT methods +
  • [20.6] +mpinv multiple precision reciprocal +
  • [20.6] +mpdiv multiple precision divide and remainder +
  • [20.6] +mpsqrt multiple precision square root +
  • [20.6] +mp2dfr multiple precision conversion to decimal base +
  • [20.6] +mppi multiple precision example, compute many digits of pi + (example)
    •  + diff --git a/lib/nr/ansi/recipes/addint.c b/lib/nr/ansi/recipes/addint.c new file mode 100644 index 0000000..4039e99 --- /dev/null +++ b/lib/nr/ansi/recipes/addint.c @@ -0,0 +1,11 @@ + +void addint(double **uf, double **uc, double **res, int nf) +{ + void interp(double **uf, double **uc, int nf); + int i,j; + + interp(res,uc,nf); + for (j=1;j<=nf;j++) + for (i=1;i<=nf;i++) + uf[i][j] += res[i][j]; +} diff --git a/lib/nr/ansi/recipes/airy.c b/lib/nr/ansi/recipes/airy.c new file mode 100644 index 0000000..95307c2 --- /dev/null +++ b/lib/nr/ansi/recipes/airy.c @@ -0,0 +1,43 @@ + +#include +#define PI 3.1415927 +#define THIRD (1.0/3.0) +#define TWOTHR (2.0*THIRD) +#define ONOVRT 0.57735027 + +void airy(float x, float *ai, float *bi, float *aip, float *bip) +{ + void bessik(float x, float xnu, float *ri, float *rk, float *rip, + float *rkp); + void bessjy(float x, float xnu, float *rj, float *ry, float *rjp, + float *ryp); + float absx,ri,rip,rj,rjp,rk,rkp,rootx,ry,ryp,z; + + absx=fabs(x); + rootx=sqrt(absx); + z=TWOTHR*absx*rootx; + if (x > 0.0) { + bessik(z,THIRD,&ri,&rk,&rip,&rkp); + *ai=rootx*ONOVRT*rk/PI; + *bi=rootx*(rk/PI+2.0*ONOVRT*ri); + bessik(z,TWOTHR,&ri,&rk,&rip,&rkp); + *aip = -x*ONOVRT*rk/PI; + *bip=x*(rk/PI+2.0*ONOVRT*ri); + } else if (x < 0.0) { + bessjy(z,THIRD,&rj,&ry,&rjp,&ryp); + *ai=0.5*rootx*(rj-ONOVRT*ry); + *bi = -0.5*rootx*(ry+ONOVRT*rj); + bessjy(z,TWOTHR,&rj,&ry,&rjp,&ryp); + *aip=0.5*absx*(ONOVRT*ry+rj); + *bip=0.5*absx*(ONOVRT*rj-ry); + } else { + *ai=0.35502805; + *bi=(*ai)/ONOVRT; + *aip = -0.25881940; + *bip = -(*aip)/ONOVRT; + } +} +#undef PI +#undef THIRD +#undef TWOTHR +#undef ONOVRT diff --git a/lib/nr/ansi/recipes/amebsa.c b/lib/nr/ansi/recipes/amebsa.c new file mode 100644 index 0000000..e34bdd3 --- /dev/null +++ b/lib/nr/ansi/recipes/amebsa.c @@ -0,0 +1,87 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define GET_PSUM \ + for (n=1;n<=ndim;n++) {\ + for (sum=0.0,m=1;m<=mpts;m++) sum += p[m][n];\ + psum[n]=sum;} +extern long idum; +float tt; + +void amebsa(float **p, float y[], int ndim, float pb[], float *yb, float ftol, + float (*funk)(float []), int *iter, float temptr) +{ + float amotsa(float **p, float y[], float psum[], int ndim, float pb[], + float *yb, float (*funk)(float []), int ihi, float *yhi, float fac); + float ran1(long *idum); + int i,ihi,ilo,j,m,n,mpts=ndim+1; + float rtol,sum,swap,yhi,ylo,ynhi,ysave,yt,ytry,*psum; + + psum=vector(1,ndim); + tt = -temptr; + GET_PSUM + for (;;) { + ilo=1; + ihi=2; + ynhi=ylo=y[1]+tt*log(ran1(&idum)); + yhi=y[2]+tt*log(ran1(&idum)); + if (ylo > yhi) { + ihi=1; + ilo=2; + ynhi=yhi; + yhi=ylo; + ylo=ynhi; + } + for (i=3;i<=mpts;i++) { + yt=y[i]+tt*log(ran1(&idum)); + if (yt <= ylo) { + ilo=i; + ylo=yt; + } + if (yt > yhi) { + ynhi=yhi; + ihi=i; + yhi=yt; + } else if (yt > ynhi) { + ynhi=yt; + } + } + rtol=2.0*fabs(yhi-ylo)/(fabs(yhi)+fabs(ylo)); + if (rtol < ftol || *iter < 0) { + swap=y[1]; + y[1]=y[ilo]; + y[ilo]=swap; + for (n=1;n<=ndim;n++) { + swap=p[1][n]; + p[1][n]=p[ilo][n]; + p[ilo][n]=swap; + } + break; + } + *iter -= 2; + ytry=amotsa(p,y,psum,ndim,pb,yb,funk,ihi,&yhi,-1.0); + if (ytry <= ylo) { + ytry=amotsa(p,y,psum,ndim,pb,yb,funk,ihi,&yhi,2.0); + } else if (ytry >= ynhi) { + ysave=yhi; + ytry=amotsa(p,y,psum,ndim,pb,yb,funk,ihi,&yhi,0.5); + if (ytry >= ysave) { + for (i=1;i<=mpts;i++) { + if (i != ilo) { + for (j=1;j<=ndim;j++) { + psum[j]=0.5*(p[i][j]+p[ilo][j]); + p[i][j]=psum[j]; + } + y[i]=(*funk)(psum); + } + } + *iter -= ndim; + GET_PSUM + } + } else ++(*iter); + } + free_vector(psum,1,ndim); +} +#undef GET_PSUM +#undef NRANSI diff --git a/lib/nr/ansi/recipes/amoeba.c b/lib/nr/ansi/recipes/amoeba.c new file mode 100644 index 0000000..e1a3bad --- /dev/null +++ b/lib/nr/ansi/recipes/amoeba.c @@ -0,0 +1,66 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define TINY 1.0e-10 +#define NMAX 5000 +#define GET_PSUM \ + for (j=1;j<=ndim;j++) {\ + for (sum=0.0,i=1;i<=mpts;i++) sum += p[i][j];\ + psum[j]=sum;} +#define SWAP(a,b) {swap=(a);(a)=(b);(b)=swap;} + +void amoeba(float **p, float y[], int ndim, float ftol, + float (*funk)(float []), int *nfunk) +{ + float amotry(float **p, float y[], float psum[], int ndim, + float (*funk)(float []), int ihi, float fac); + int i,ihi,ilo,inhi,j,mpts=ndim+1; + float rtol,sum,swap,ysave,ytry,*psum; + + psum=vector(1,ndim); + *nfunk=0; + GET_PSUM + for (;;) { + ilo=1; + ihi = y[1]>y[2] ? (inhi=2,1) : (inhi=1,2); + for (i=1;i<=mpts;i++) { + if (y[i] <= y[ilo]) ilo=i; + if (y[i] > y[ihi]) { + inhi=ihi; + ihi=i; + } else if (y[i] > y[inhi] && i != ihi) inhi=i; + } + rtol=2.0*fabs(y[ihi]-y[ilo])/(fabs(y[ihi])+fabs(y[ilo])+TINY); + if (rtol < ftol) { + SWAP(y[1],y[ilo]) + for (i=1;i<=ndim;i++) SWAP(p[1][i],p[ilo][i]) + break; + } + if (*nfunk >= NMAX) nrerror("NMAX exceeded"); + *nfunk += 2; + ytry=amotry(p,y,psum,ndim,funk,ihi,-1.0); + if (ytry <= y[ilo]) + ytry=amotry(p,y,psum,ndim,funk,ihi,2.0); + else if (ytry >= y[inhi]) { + ysave=y[ihi]; + ytry=amotry(p,y,psum,ndim,funk,ihi,0.5); + if (ytry >= ysave) { + for (i=1;i<=mpts;i++) { + if (i != ilo) { + for (j=1;j<=ndim;j++) + p[i][j]=psum[j]=0.5*(p[i][j]+p[ilo][j]); + y[i]=(*funk)(psum); + } + } + *nfunk += ndim; + GET_PSUM + } + } else --(*nfunk); + } + free_vector(psum,1,ndim); +} +#undef SWAP +#undef GET_PSUM +#undef NMAX +#undef NRANSI diff --git a/lib/nr/ansi/recipes/amotry.c b/lib/nr/ansi/recipes/amotry.c new file mode 100644 index 0000000..24b07cc --- /dev/null +++ b/lib/nr/ansi/recipes/amotry.c @@ -0,0 +1,26 @@ + +#define NRANSI +#include "nrutil.h" + +float amotry(float **p, float y[], float psum[], int ndim, + float (*funk)(float []), int ihi, float fac) +{ + int j; + float fac1,fac2,ytry,*ptry; + + ptry=vector(1,ndim); + fac1=(1.0-fac)/ndim; + fac2=fac1-fac; + for (j=1;j<=ndim;j++) ptry[j]=psum[j]*fac1-p[ihi][j]*fac2; + ytry=(*funk)(ptry); + if (ytry < y[ihi]) { + y[ihi]=ytry; + for (j=1;j<=ndim;j++) { + psum[j] += ptry[j]-p[ihi][j]; + p[ihi][j]=ptry[j]; + } + } + free_vector(ptry,1,ndim); + return ytry; +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/amotsa.c b/lib/nr/ansi/recipes/amotsa.c new file mode 100644 index 0000000..cfa5dac --- /dev/null +++ b/lib/nr/ansi/recipes/amotsa.c @@ -0,0 +1,38 @@ + +#include +#define NRANSI +#include "nrutil.h" + +extern long idum; +extern float tt; + +float amotsa(float **p, float y[], float psum[], int ndim, float pb[], + float *yb, float (*funk)(float []), int ihi, float *yhi, float fac) +{ + float ran1(long *idum); + int j; + float fac1,fac2,yflu,ytry,*ptry; + + ptry=vector(1,ndim); + fac1=(1.0-fac)/ndim; + fac2=fac1-fac; + for (j=1;j<=ndim;j++) + ptry[j]=psum[j]*fac1-p[ihi][j]*fac2; + ytry=(*funk)(ptry); + if (ytry <= *yb) { + for (j=1;j<=ndim;j++) pb[j]=ptry[j]; + *yb=ytry; + } + yflu=ytry-tt*log(ran1(&idum)); + if (yflu < *yhi) { + y[ihi]=ytry; + *yhi=yflu; + for (j=1;j<=ndim;j++) { + psum[j] += ptry[j]-p[ihi][j]; + p[ihi][j]=ptry[j]; + } + } + free_vector(ptry,1,ndim); + return yflu; +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/anneal.c b/lib/nr/ansi/recipes/anneal.c new file mode 100644 index 0000000..8f22434 --- /dev/null +++ b/lib/nr/ansi/recipes/anneal.c @@ -0,0 +1,76 @@ + +#include +#include +#define TFACTR 0.9 +#define ALEN(a,b,c,d) sqrt(((b)-(a))*((b)-(a))+((d)-(c))*((d)-(c))) + +void anneal(float x[], float y[], int iorder[], int ncity) +{ + int irbit1(unsigned long *iseed); + int metrop(float de, float t); + float ran3(long *idum); + float revcst(float x[], float y[], int iorder[], int ncity, int n[]); + void reverse(int iorder[], int ncity, int n[]); + float trncst(float x[], float y[], int iorder[], int ncity, int n[]); + void trnspt(int iorder[], int ncity, int n[]); + int ans,nover,nlimit,i1,i2; + int i,j,k,nsucc,nn,idec; + static int n[7]; + long idum; + unsigned long iseed; + float path,de,t; + + nover=100*ncity; + nlimit=10*ncity; + path=0.0; + t=0.5; + for (i=1;i= n[1]) ++n[2]; + nn=1+((n[1]-n[2]+ncity-1) % ncity); + } while (nn<3); + idec=irbit1(&iseed); + if (idec == 0) { + n[3]=n[2]+(int) (abs(nn-2)*ran3(&idum))+1; + n[3]=1+((n[3]-1) % ncity); + de=trncst(x,y,iorder,ncity,n); + ans=metrop(de,t); + if (ans) { + ++nsucc; + path += de; + trnspt(iorder,ncity,n); + } + } else { + de=revcst(x,y,iorder,ncity,n); + ans=metrop(de,t); + if (ans) { + ++nsucc; + path += de; + reverse(iorder,ncity,n); + } + } + if (nsucc >= nlimit) break; + } + printf("\n %s %10.6f %s %12.6f \n","T =",t, + " Path Length =",path); + printf("Successful Moves: %6d\n",nsucc); + t *= TFACTR; + if (nsucc == 0) return; + } +} +#undef TFACTR +#undef ALEN diff --git a/lib/nr/ansi/recipes/anorm2.c b/lib/nr/ansi/recipes/anorm2.c new file mode 100644 index 0000000..0ae94ff --- /dev/null +++ b/lib/nr/ansi/recipes/anorm2.c @@ -0,0 +1,13 @@ + +#include + +double anorm2(double **a, int n) +{ + int i,j; + double sum=0.0; + + for (j=1;j<=n;j++) + for (i=1;i<=n;i++) + sum += a[i][j]*a[i][j]; + return sqrt(sum)/n; +} diff --git a/lib/nr/ansi/recipes/arcmak.c b/lib/nr/ansi/recipes/arcmak.c new file mode 100644 index 0000000..034a26e --- /dev/null +++ b/lib/nr/ansi/recipes/arcmak.c @@ -0,0 +1,34 @@ + +#define NRANSI +#include "nrutil.h" +#include +#define MC 512 +#ifdef ULONG_MAX +#define MAXINT (ULONG_MAX >> 1) +#else +#define MAXINT 2147483647 +#endif + +typedef struct { + unsigned long *ilob,*iupb,*ncumfq,jdif,nc,minint,nch,ncum,nrad; +} arithcode; + +void arcmak(unsigned long nfreq[], unsigned long nchh, unsigned long nradd, + arithcode *acode) +{ + unsigned long j; + + if (nchh > MC) nrerror("input radix may not exceed MC in arcmak."); + if (nradd > 256) nrerror("output radix may not exceed 256 in arcmak."); + + acode->minint=MAXINT/nradd; + acode->nch=nchh; + acode->nrad=nradd; + acode->ncumfq[1]=0; + for (j=2;j<=acode->nch+1;j++) + acode->ncumfq[j]=acode->ncumfq[j-1]+IMAX(nfreq[j-1],1); + acode->ncum=acode->ncumfq[acode->nch+2]=acode->ncumfq[acode->nch+1]+1; +} +#undef MC +#undef MAXINT +#undef NRANSI diff --git a/lib/nr/ansi/recipes/arcode.c b/lib/nr/ansi/recipes/arcode.c new file mode 100644 index 0000000..008ba60 --- /dev/null +++ b/lib/nr/ansi/recipes/arcode.c @@ -0,0 +1,86 @@ + +#include +#include +#define NWK 20 +#define JTRY(j,k,m) ((long)((((double)(k))*((double)(j)))/((double)(m)))) + +typedef struct { + unsigned long *ilob,*iupb,*ncumfq,jdif,nc,minint,nch,ncum,nrad; +} arithcode; + +void arcode(unsigned long *ich, unsigned char **codep, unsigned long *lcode, + unsigned long *lcd, int isign, arithcode *acode) +{ + void arcsum(unsigned long iin[], unsigned long iout[], unsigned long ja, + int nwk, unsigned long nrad, unsigned long nc); + void nrerror(char error_text[]); + int j,k; + unsigned long ihi,ja,jh,jl,m; + + if (!isign) { + acode->jdif=acode->nrad-1; + for (j=NWK;j>=1;j--) { + acode->iupb[j]=acode->nrad-1; + acode->ilob[j]=0; + acode->nc=j; + if (acode->jdif > acode->minint) return; + acode->jdif=(acode->jdif+1)*acode->nrad-1; + } + nrerror("NWK too small in arcode."); + } else { + if (isign > 0) { + if (*ich > acode->nch) nrerror("bad ich in arcode."); + } + else { + ja=(*codep)[*lcd]-acode->ilob[acode->nc]; + for (j=acode->nc+1;j<=NWK;j++) { + ja *= acode->nrad; + ja += ((*codep)[*lcd+j-acode->nc]-acode->ilob[j]); + } + ihi=acode->nch+1; + *ich=0; + while (ihi-(*ich) > 1) { + m=(*ich+ihi)>>1; + if (ja >= JTRY(acode->jdif,acode->ncumfq[m+1],acode->ncum)) + *ich=m; + else ihi=m; + } + if (*ich == acode->nch) return; + } + jh=JTRY(acode->jdif,acode->ncumfq[*ich+2],acode->ncum); + jl=JTRY(acode->jdif,acode->ncumfq[*ich+1],acode->ncum); + acode->jdif=jh-jl; + arcsum(acode->ilob,acode->iupb,jh,NWK,acode->nrad,acode->nc); + arcsum(acode->ilob,acode->ilob,jl,NWK,acode->nrad,acode->nc); + for (j=acode->nc;j<=NWK;j++) { + if (*ich != acode->nch && acode->iupb[j] != acode->ilob[j]) break; + if (*lcd > *lcode) { + fprintf(stderr,"Reached the end of the 'code' array.\n"); + fprintf(stderr,"Attempting to expand its size.\n"); + *lcode += *lcode/2; + if ((*codep=(unsigned char *)realloc(*codep, + (unsigned)(*lcode*sizeof(unsigned char)))) == NULL) { + nrerror("Size expansion failed"); + } + } + if (isign > 0) (*codep)[*lcd]=(unsigned char)acode->ilob[j]; + ++(*lcd); + } + if (j > NWK) return; + acode->nc=j; + for(j=0;acode->jdifminint;j++) + acode->jdif *= acode->nrad; + if (acode->nc-j < 1) nrerror("NWK too small in arcode."); + if (j) { + for (k=acode->nc;k<=NWK;k++) { + acode->iupb[k-j]=acode->iupb[k]; + acode->ilob[k-j]=acode->ilob[k]; + } + } + acode->nc -= j; + for (k=NWK-j+1;k<=NWK;k++) acode->iupb[k]=acode->ilob[k]=0; + } + return; +} +#undef NWK +#undef JTRY diff --git a/lib/nr/ansi/recipes/arcsum.c b/lib/nr/ansi/recipes/arcsum.c new file mode 100644 index 0000000..7b62dbc --- /dev/null +++ b/lib/nr/ansi/recipes/arcsum.c @@ -0,0 +1,18 @@ + +void arcsum(unsigned long iin[], unsigned long iout[], unsigned long ja, + int nwk, unsigned long nrad, unsigned long nc) +{ + int j,karry=0; + unsigned long jtmp; + + for (j=nwk;j>nc;j--) { + jtmp=ja; + ja /= nrad; + iout[j]=iin[j]+(jtmp-ja*nrad)+karry; + if (iout[j] >= nrad) { + iout[j] -= nrad; + karry=1; + } else karry=0; + } + iout[nc]=iin[nc]+ja+karry; +} diff --git a/lib/nr/ansi/recipes/asolve.c b/lib/nr/ansi/recipes/asolve.c new file mode 100644 index 0000000..a0e2718 --- /dev/null +++ b/lib/nr/ansi/recipes/asolve.c @@ -0,0 +1,10 @@ + +extern unsigned long ija[]; +extern double sa[]; + +void asolve(unsigned long n, double b[], double x[], int itrnsp) +{ + unsigned long i; + + for(i=1;i<=n;i++) x[i]=(sa[i] != 0.0 ? b[i]/sa[i] : b[i]); +} diff --git a/lib/nr/ansi/recipes/atimes.c b/lib/nr/ansi/recipes/atimes.c new file mode 100644 index 0000000..9f54e4f --- /dev/null +++ b/lib/nr/ansi/recipes/atimes.c @@ -0,0 +1,14 @@ + +extern unsigned long ija[]; +extern double sa[]; + +void atimes(unsigned long n, double x[], double r[], int itrnsp) +{ + void dsprsax(double sa[], unsigned long ija[], double x[], double b[], + unsigned long n); + void dsprstx(double sa[], unsigned long ija[], double x[], double b[], + unsigned long n); + + if (itrnsp) dsprstx(sa,ija,x,r,n); + else dsprsax(sa,ija,x,r,n); +} diff --git a/lib/nr/ansi/recipes/avevar.c b/lib/nr/ansi/recipes/avevar.c new file mode 100644 index 0000000..956f6ff --- /dev/null +++ b/lib/nr/ansi/recipes/avevar.c @@ -0,0 +1,16 @@ + +void avevar(float data[], unsigned long n, float *ave, float *var) +{ + unsigned long j; + float s,ep; + + for (*ave=0.0,j=1;j<=n;j++) *ave += data[j]; + *ave /= n; + *var=ep=0.0; + for (j=1;j<=n;j++) { + s=data[j]-(*ave); + ep += s; + *var += s*s; + } + *var=(*var-ep*ep/n)/(n-1); +} diff --git a/lib/nr/ansi/recipes/badluk.c b/lib/nr/ansi/recipes/badluk.c new file mode 100644 index 0000000..844ea8a --- /dev/null +++ b/lib/nr/ansi/recipes/badluk.c @@ -0,0 +1,52 @@ + +#include +#include +#define ZON -5.0 +#define IYBEG 1900 +#define IYEND 2000 + +int main(void) /* Program badluk */ +{ + void flmoon(int n, int nph, long *jd, float *frac); + long julday(int mm, int id, int iyyy); + int ic,icon,idwk,im,iyyy,n; + float timzon = ZON/24.0,frac; + long jd,jday; + + printf("\nFull moons on Friday the 13th from %5d to %5d\n",IYBEG,IYEND); + for (iyyy=IYBEG;iyyy<=IYEND;iyyy++) { + for (im=1;im<=12;im++) { + jday=julday(im,13,iyyy); + idwk=(int) ((jday+1) % 7); + if (idwk == 5) { + n=(int)(12.37*(iyyy-1900+(im-0.5)/12.0)); + icon=0; + for (;;) { + flmoon(n,2,&jd,&frac); + frac=24.0*(frac+timzon); + if (frac < 0.0) { + --jd; + frac += 24.0; + } + if (frac > 12.0) { + ++jd; + frac -= 12.0; + } else + frac += 12.0; + if (jd == jday) { + printf("\n%2d/13/%4d\n",im,iyyy); + printf("%s %5.1f %s\n","Full moon",frac, + " hrs after midnight (EST)"); + break; + } else { + ic=(jday >= jd ? 1 : -1); + if (ic == (-icon)) break; + icon=ic; + n += ic; + } + } + } + } + } + return 0; +} diff --git a/lib/nr/ansi/recipes/balanc.c b/lib/nr/ansi/recipes/balanc.c new file mode 100644 index 0000000..1f107f7 --- /dev/null +++ b/lib/nr/ansi/recipes/balanc.c @@ -0,0 +1,44 @@ + +#include +#define RADIX 2.0 + +void balanc(float **a, int n) +{ + int last,j,i; + float s,r,g,f,c,sqrdx; + + sqrdx=RADIX*RADIX; + last=0; + while (last == 0) { + last=1; + for (i=1;i<=n;i++) { + r=c=0.0; + for (j=1;j<=n;j++) + if (j != i) { + c += fabs(a[j][i]); + r += fabs(a[i][j]); + } + if (c && r) { + g=r/RADIX; + f=1.0; + s=c+r; + while (cg) { + f /= RADIX; + c /= sqrdx; + } + if ((c+r)/f < 0.95*s) { + last=0; + g=1.0/f; + for (j=1;j<=n;j++) a[i][j] *= g; + for (j=1;j<=n;j++) a[j][i] *= f; + } + } + } + } +} +#undef RADIX diff --git a/lib/nr/ansi/recipes/banbks.c b/lib/nr/ansi/recipes/banbks.c new file mode 100644 index 0000000..804f9ca --- /dev/null +++ b/lib/nr/ansi/recipes/banbks.c @@ -0,0 +1,27 @@ + +#define SWAP(a,b) {dum=(a);(a)=(b);(b)=dum;} + +void banbks(float **a, unsigned long n, int m1, int m2, float **al, + unsigned long indx[], float b[]) +{ + unsigned long i,k,l; + int mm; + float dum; + + mm=m1+m2+1; + l=m1; + for (k=1;k<=n;k++) { + i=indx[k]; + if (i != k) SWAP(b[k],b[i]) + if (l < n) l++; + for (i=k+1;i<=l;i++) b[i] -= al[k][i-k]*b[k]; + } + l=1; + for (i=n;i>=1;i--) { + dum=b[i]; + for (k=2;k<=l;k++) dum -= a[i][k]*b[k+i-1]; + b[i]=dum/a[i][1]; + if (l < mm) l++; + } +} +#undef SWAP diff --git a/lib/nr/ansi/recipes/bandec.c b/lib/nr/ansi/recipes/bandec.c new file mode 100644 index 0000000..99eb819 --- /dev/null +++ b/lib/nr/ansi/recipes/bandec.c @@ -0,0 +1,47 @@ + +#include +#define SWAP(a,b) {dum=(a);(a)=(b);(b)=dum;} +#define TINY 1.0e-20 + +void bandec(float **a, unsigned long n, int m1, int m2, float **al, + unsigned long indx[], float *d) +{ + unsigned long i,j,k,l; + int mm; + float dum; + + mm=m1+m2+1; + l=m1; + for (i=1;i<=m1;i++) { + for (j=m1+2-i;j<=mm;j++) a[i][j-l]=a[i][j]; + l--; + for (j=mm-l;j<=mm;j++) a[i][j]=0.0; + } + *d=1.0; + l=m1; + for (k=1;k<=n;k++) { + dum=a[k][1]; + i=k; + if (l < n) l++; + for (j=k+1;j<=l;j++) { + if (fabs(a[j][1]) > fabs(dum)) { + dum=a[j][1]; + i=j; + } + } + indx[k]=i; + if (dum == 0.0) a[k][1]=TINY; + if (i != k) { + *d = -(*d); + for (j=1;j<=mm;j++) SWAP(a[k][j],a[i][j]) + } + for (i=k+1;i<=l;i++) { + dum=a[i][1]/a[k][1]; + al[k][i-k]=dum; + for (j=2;j<=mm;j++) a[i][j-1]=a[i][j]-dum*a[k][j]; + a[i][mm]=0.0; + } + } +} +#undef SWAP +#undef TINY diff --git a/lib/nr/ansi/recipes/banmul.c b/lib/nr/ansi/recipes/banmul.c new file mode 100644 index 0000000..d3270e0 --- /dev/null +++ b/lib/nr/ansi/recipes/banmul.c @@ -0,0 +1,16 @@ + +#define NRANSI +#include "nrutil.h" + +void banmul(float **a, unsigned long n, int m1, int m2, float x[], float b[]) +{ + unsigned long i,j,k,tmploop; + + for (i=1;i<=n;i++) { + k=i-m1-1; + tmploop=LMIN(m1+m2+1,n-k); + b[i]=0.0; + for (j=LMAX(1,1-k);j<=tmploop;j++) b[i] += a[i][j]*x[j+k]; + } +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/bcucof.c b/lib/nr/ansi/recipes/bcucof.c new file mode 100644 index 0000000..a3b7cd3 --- /dev/null +++ b/lib/nr/ansi/recipes/bcucof.c @@ -0,0 +1,40 @@ + +void bcucof(float y[], float y1[], float y2[], float y12[], float d1, float d2, + float **c) +{ + static int wt[16][16]= + { 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0, + -3,0,0,3,0,0,0,0,-2,0,0,-1,0,0,0,0, + 2,0,0,-2,0,0,0,0,1,0,0,1,0,0,0,0, + 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0, + 0,0,0,0,-3,0,0,3,0,0,0,0,-2,0,0,-1, + 0,0,0,0,2,0,0,-2,0,0,0,0,1,0,0,1, + -3,3,0,0,-2,-1,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,-3,3,0,0,-2,-1,0,0, + 9,-9,9,-9,6,3,-3,-6,6,-6,-3,3,4,2,1,2, + -6,6,-6,6,-4,-2,2,4,-3,3,3,-3,-2,-1,-1,-2, + 2,-2,0,0,1,1,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,2,-2,0,0,1,1,0,0, + -6,6,-6,6,-3,-3,3,3,-4,4,2,-2,-2,-2,-1,-1, + 4,-4,4,-4,2,2,-2,-2,2,-2,-2,2,1,1,1,1}; + int l,k,j,i; + float xx,d1d2,cl[16],x[16]; + + d1d2=d1*d2; + for (i=1;i<=4;i++) { + x[i-1]=y[i]; + x[i+3]=y1[i]*d1; + x[i+7]=y2[i]*d2; + x[i+11]=y12[i]*d1d2; + } + for (i=0;i<=15;i++) { + xx=0.0; + for (k=0;k<=15;k++) xx += wt[i][k]*x[k]; + cl[i]=xx; + } + l=0; + for (i=1;i<=4;i++) + for (j=1;j<=4;j++) c[i][j]=cl[l++]; +} diff --git a/lib/nr/ansi/recipes/bcuint.c b/lib/nr/ansi/recipes/bcuint.c new file mode 100644 index 0000000..92ab17b --- /dev/null +++ b/lib/nr/ansi/recipes/bcuint.c @@ -0,0 +1,31 @@ + +#define NRANSI +#include "nrutil.h" + +void bcuint(float y[], float y1[], float y2[], float y12[], float x1l, + float x1u, float x2l, float x2u, float x1, float x2, float *ansy, + float *ansy1, float *ansy2) +{ + void bcucof(float y[], float y1[], float y2[], float y12[], float d1, + float d2, float **c); + int i; + float t,u,d1,d2,**c; + + c=matrix(1,4,1,4); + d1=x1u-x1l; + d2=x2u-x2l; + bcucof(y,y1,y2,y12,d1,d2,c); + if (x1u == x1l || x2u == x2l) nrerror("Bad input in routine bcuint"); + t=(x1-x1l)/d1; + u=(x2-x2l)/d2; + *ansy=(*ansy2)=(*ansy1)=0.0; + for (i=4;i>=1;i--) { + *ansy=t*(*ansy)+((c[i][4]*u+c[i][3])*u+c[i][2])*u+c[i][1]; + *ansy2=t*(*ansy2)+(3.0*c[i][4]*u+2.0*c[i][3])*u+c[i][2]; + *ansy1=u*(*ansy1)+(3.0*c[4][i]*t+2.0*c[3][i])*t+c[2][i]; + } + *ansy1 /= d1; + *ansy2 /= d2; + free_matrix(c,1,4,1,4); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/beschb.c b/lib/nr/ansi/recipes/beschb.c new file mode 100644 index 0000000..9b668e0 --- /dev/null +++ b/lib/nr/ansi/recipes/beschb.c @@ -0,0 +1,25 @@ + +#define NUSE1 5 +#define NUSE2 5 + +void beschb(double x, double *gam1, double *gam2, double *gampl, double *gammi) +{ + float chebev(float a, float b, float c[], int m, float x); + float xx; + static float c1[] = { + -1.142022680371168e0,6.5165112670737e-3, + 3.087090173086e-4,-3.4706269649e-6,6.9437664e-9, + 3.67795e-11,-1.356e-13}; + static float c2[] = { + 1.843740587300905e0,-7.68528408447867e-2, + 1.2719271366546e-3,-4.9717367042e-6,-3.31261198e-8, + 2.423096e-10,-1.702e-13,-1.49e-15}; + + xx=8.0*x*x-1.0; + *gam1=chebev(-1.0,1.0,c1,NUSE1,xx); + *gam2=chebev(-1.0,1.0,c2,NUSE2,xx); + *gampl= *gam2-x*(*gam1); + *gammi= *gam2+x*(*gam1); +} +#undef NUSE1 +#undef NUSE2 diff --git a/lib/nr/ansi/recipes/bessi.c b/lib/nr/ansi/recipes/bessi.c new file mode 100644 index 0000000..d24e6bf --- /dev/null +++ b/lib/nr/ansi/recipes/bessi.c @@ -0,0 +1,38 @@ + +#include +#define ACC 40.0 +#define BIGNO 1.0e10 +#define BIGNI 1.0e-10 + +float bessi(int n, float x) +{ + float bessi0(float x); + void nrerror(char error_text[]); + int j; + float bi,bim,bip,tox,ans; + + if (n < 2) nrerror("Index n less than 2 in bessi"); + if (x == 0.0) + return 0.0; + else { + tox=2.0/fabs(x); + bip=ans=0.0; + bi=1.0; + for (j=2*(n+(int) sqrt(ACC*n));j>0;j--) { + bim=bip+j*tox*bi; + bip=bi; + bi=bim; + if (fabs(bi) > BIGNO) { + ans *= BIGNI; + bi *= BIGNI; + bip *= BIGNI; + } + if (j == n) ans=bip; + } + ans *= bessi0(x)/bi; + return x < 0.0 && (n & 1) ? -ans : ans; + } +} +#undef ACC +#undef BIGNO +#undef BIGNI diff --git a/lib/nr/ansi/recipes/bessi0.c b/lib/nr/ansi/recipes/bessi0.c new file mode 100644 index 0000000..8575faa --- /dev/null +++ b/lib/nr/ansi/recipes/bessi0.c @@ -0,0 +1,22 @@ + +#include + +float bessi0(float x) +{ + float ax,ans; + double y; + + if ((ax=fabs(x)) < 3.75) { + y=x/3.75; + y*=y; + ans=1.0+y*(3.5156229+y*(3.0899424+y*(1.2067492 + +y*(0.2659732+y*(0.360768e-1+y*0.45813e-2))))); + } else { + y=3.75/ax; + ans=(exp(ax)/sqrt(ax))*(0.39894228+y*(0.1328592e-1 + +y*(0.225319e-2+y*(-0.157565e-2+y*(0.916281e-2 + +y*(-0.2057706e-1+y*(0.2635537e-1+y*(-0.1647633e-1 + +y*0.392377e-2)))))))); + } + return ans; +} diff --git a/lib/nr/ansi/recipes/bessi1.c b/lib/nr/ansi/recipes/bessi1.c new file mode 100644 index 0000000..e27f992 --- /dev/null +++ b/lib/nr/ansi/recipes/bessi1.c @@ -0,0 +1,23 @@ + +#include + +float bessi1(float x) +{ + float ax,ans; + double y; + + if ((ax=fabs(x)) < 3.75) { + y=x/3.75; + y*=y; + ans=ax*(0.5+y*(0.87890594+y*(0.51498869+y*(0.15084934 + +y*(0.2658733e-1+y*(0.301532e-2+y*0.32411e-3)))))); + } else { + y=3.75/ax; + ans=0.2282967e-1+y*(-0.2895312e-1+y*(0.1787654e-1 + -y*0.420059e-2)); + ans=0.39894228+y*(-0.3988024e-1+y*(-0.362018e-2 + +y*(0.163801e-2+y*(-0.1031555e-1+y*ans)))); + ans *= (exp(ax)/sqrt(ax)); + } + return x < 0.0 ? -ans : ans; +} diff --git a/lib/nr/ansi/recipes/bessik.c b/lib/nr/ansi/recipes/bessik.c new file mode 100644 index 0000000..6835215 --- /dev/null +++ b/lib/nr/ansi/recipes/bessik.c @@ -0,0 +1,127 @@ + +#include +#define EPS 1.0e-10 +#define FPMIN 1.0e-30 +#define MAXIT 10000 +#define XMIN 2.0 +#define PI 3.141592653589793 + +void bessik(float x, float xnu, float *ri, float *rk, float *rip, float *rkp) +{ + void beschb(double x, double *gam1, double *gam2, double *gampl, + double *gammi); + void nrerror(char error_text[]); + int i,l,nl; + double a,a1,b,c,d,del,del1,delh,dels,e,f,fact,fact2,ff,gam1,gam2, + gammi,gampl,h,p,pimu,q,q1,q2,qnew,ril,ril1,rimu,rip1,ripl, + ritemp,rk1,rkmu,rkmup,rktemp,s,sum,sum1,x2,xi,xi2,xmu,xmu2; + + if (x <= 0.0 || xnu < 0.0) nrerror("bad arguments in bessik"); + nl=(int)(xnu+0.5); + xmu=xnu-nl; + xmu2=xmu*xmu; + xi=1.0/x; + xi2=2.0*xi; + h=xnu*xi; + if (h < FPMIN) h=FPMIN; + b=xi2*xnu; + d=0.0; + c=h; + for (i=1;i<=MAXIT;i++) { + b += xi2; + d=1.0/(b+d); + c=b+1.0/c; + del=c*d; + h=del*h; + if (fabs(del-1.0) < EPS) break; + } + if (i > MAXIT) nrerror("x too large in bessik; try asymptotic expansion"); + ril=FPMIN; + ripl=h*ril; + ril1=ril; + rip1=ripl; + fact=xnu*xi; + for (l=nl;l>=1;l--) { + ritemp=fact*ril+ripl; + fact -= xi; + ripl=fact*ritemp+ril; + ril=ritemp; + } + f=ripl/ril; + if (x < XMIN) { + x2=0.5*x; + pimu=PI*xmu; + fact = (fabs(pimu) < EPS ? 1.0 : pimu/sin(pimu)); + d = -log(x2); + e=xmu*d; + fact2 = (fabs(e) < EPS ? 1.0 : sinh(e)/e); + beschb(xmu,&gam1,&gam2,&gampl,&gammi); + ff=fact*(gam1*cosh(e)+gam2*fact2*d); + sum=ff; + e=exp(e); + p=0.5*e/gampl; + q=0.5/(e*gammi); + c=1.0; + d=x2*x2; + sum1=p; + for (i=1;i<=MAXIT;i++) { + ff=(i*ff+p+q)/(i*i-xmu2); + c *= (d/i); + p /= (i-xmu); + q /= (i+xmu); + del=c*ff; + sum += del; + del1=c*(p-i*ff); + sum1 += del1; + if (fabs(del) < fabs(sum)*EPS) break; + } + if (i > MAXIT) nrerror("bessk series failed to converge"); + rkmu=sum; + rk1=sum1*xi2; + } else { + b=2.0*(1.0+x); + d=1.0/b; + h=delh=d; + q1=0.0; + q2=1.0; + a1=0.25-xmu2; + q=c=a1; + a = -a1; + s=1.0+q*delh; + for (i=2;i<=MAXIT;i++) { + a -= 2*(i-1); + c = -a*c/i; + qnew=(q1-b*q2)/a; + q1=q2; + q2=qnew; + q += c*qnew; + b += 2.0; + d=1.0/(b+a*d); + delh=(b*d-1.0)*delh; + h += delh; + dels=q*delh; + s += dels; + if (fabs(dels/s) < EPS) break; + } + if (i > MAXIT) nrerror("bessik: failure to converge in cf2"); + h=a1*h; + rkmu=sqrt(PI/(2.0*x))*exp(-x)/s; + rk1=rkmu*(xmu+x+0.5-h)*xi; + } + rkmup=xmu*xi*rkmu-rk1; + rimu=xi/(f*rkmu-rkmup); + *ri=(rimu*ril1)/ril; + *rip=(rimu*rip1)/ril; + for (i=1;i<=nl;i++) { + rktemp=(xmu+i)*xi2*rk1+rkmu; + rkmu=rk1; + rk1=rktemp; + } + *rk=rkmu; + *rkp=xnu*xi*rkmu-rk1; +} +#undef EPS +#undef FPMIN +#undef MAXIT +#undef XMIN +#undef PI diff --git a/lib/nr/ansi/recipes/bessj.c b/lib/nr/ansi/recipes/bessj.c new file mode 100644 index 0000000..3fc4027 --- /dev/null +++ b/lib/nr/ansi/recipes/bessj.c @@ -0,0 +1,56 @@ + +#include +#define ACC 40.0 +#define BIGNO 1.0e10 +#define BIGNI 1.0e-10 + +float bessj(int n, float x) +{ + float bessj0(float x); + float bessj1(float x); + void nrerror(char error_text[]); + int j,jsum,m; + float ax,bj,bjm,bjp,sum,tox,ans; + + if (n < 2) nrerror("Index n less than 2 in bessj"); + ax=fabs(x); + if (ax == 0.0) + return 0.0; + else if (ax > (float) n) { + tox=2.0/ax; + bjm=bessj0(ax); + bj=bessj1(ax); + for (j=1;j0;j--) { + bjm=j*tox*bj-bjp; + bjp=bj; + bj=bjm; + if (fabs(bj) > BIGNO) { + bj *= BIGNI; + bjp *= BIGNI; + ans *= BIGNI; + sum *= BIGNI; + } + if (jsum) sum += bj; + jsum=!jsum; + if (j == n) ans=bjp; + } + sum=2.0*sum-bj; + ans /= sum; + } + return x < 0.0 && (n & 1) ? -ans : ans; +} +#undef ACC +#undef BIGNO +#undef BIGNI diff --git a/lib/nr/ansi/recipes/bessj0.c b/lib/nr/ansi/recipes/bessj0.c new file mode 100644 index 0000000..650b959 --- /dev/null +++ b/lib/nr/ansi/recipes/bessj0.c @@ -0,0 +1,28 @@ + +#include + +float bessj0(float x) +{ + float ax,z; + double xx,y,ans,ans1,ans2; + + if ((ax=fabs(x)) < 8.0) { + y=x*x; + ans1=57568490574.0+y*(-13362590354.0+y*(651619640.7 + +y*(-11214424.18+y*(77392.33017+y*(-184.9052456))))); + ans2=57568490411.0+y*(1029532985.0+y*(9494680.718 + +y*(59272.64853+y*(267.8532712+y*1.0)))); + ans=ans1/ans2; + } else { + z=8.0/ax; + y=z*z; + xx=ax-0.785398164; + ans1=1.0+y*(-0.1098628627e-2+y*(0.2734510407e-4 + +y*(-0.2073370639e-5+y*0.2093887211e-6))); + ans2 = -0.1562499995e-1+y*(0.1430488765e-3 + +y*(-0.6911147651e-5+y*(0.7621095161e-6 + -y*0.934945152e-7))); + ans=sqrt(0.636619772/ax)*(cos(xx)*ans1-z*sin(xx)*ans2); + } + return ans; +} diff --git a/lib/nr/ansi/recipes/bessj1.c b/lib/nr/ansi/recipes/bessj1.c new file mode 100644 index 0000000..62d2343 --- /dev/null +++ b/lib/nr/ansi/recipes/bessj1.c @@ -0,0 +1,29 @@ + +#include + +float bessj1(float x) +{ + float ax,z; + double xx,y,ans,ans1,ans2; + + if ((ax=fabs(x)) < 8.0) { + y=x*x; + ans1=x*(72362614232.0+y*(-7895059235.0+y*(242396853.1 + +y*(-2972611.439+y*(15704.48260+y*(-30.16036606)))))); + ans2=144725228442.0+y*(2300535178.0+y*(18583304.74 + +y*(99447.43394+y*(376.9991397+y*1.0)))); + ans=ans1/ans2; + } else { + z=8.0/ax; + y=z*z; + xx=ax-2.356194491; + ans1=1.0+y*(0.183105e-2+y*(-0.3516396496e-4 + +y*(0.2457520174e-5+y*(-0.240337019e-6)))); + ans2=0.04687499995+y*(-0.2002690873e-3 + +y*(0.8449199096e-5+y*(-0.88228987e-6 + +y*0.105787412e-6))); + ans=sqrt(0.636619772/ax)*(cos(xx)*ans1-z*sin(xx)*ans2); + if (x < 0.0) ans = -ans; + } + return ans; +} diff --git a/lib/nr/ansi/recipes/bessjy.c b/lib/nr/ansi/recipes/bessjy.c new file mode 100644 index 0000000..544430f --- /dev/null +++ b/lib/nr/ansi/recipes/bessjy.c @@ -0,0 +1,156 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define EPS 1.0e-10 +#define FPMIN 1.0e-30 +#define MAXIT 10000 +#define XMIN 2.0 +#define PI 3.141592653589793 + +void bessjy(float x, float xnu, float *rj, float *ry, float *rjp, float *ryp) +{ + void beschb(double x, double *gam1, double *gam2, double *gampl, + double *gammi); + int i,isign,l,nl; + double a,b,br,bi,c,cr,ci,d,del,del1,den,di,dlr,dli,dr,e,f,fact,fact2, + fact3,ff,gam,gam1,gam2,gammi,gampl,h,p,pimu,pimu2,q,r,rjl, + rjl1,rjmu,rjp1,rjpl,rjtemp,ry1,rymu,rymup,rytemp,sum,sum1, + temp,w,x2,xi,xi2,xmu,xmu2; + + if (x <= 0.0 || xnu < 0.0) nrerror("bad arguments in bessjy"); + nl=(x < XMIN ? (int)(xnu+0.5) : IMAX(0,(int)(xnu-x+1.5))); + xmu=xnu-nl; + xmu2=xmu*xmu; + xi=1.0/x; + xi2=2.0*xi; + w=xi2/PI; + isign=1; + h=xnu*xi; + if (h < FPMIN) h=FPMIN; + b=xi2*xnu; + d=0.0; + c=h; + for (i=1;i<=MAXIT;i++) { + b += xi2; + d=b-d; + if (fabs(d) < FPMIN) d=FPMIN; + c=b-1.0/c; + if (fabs(c) < FPMIN) c=FPMIN; + d=1.0/d; + del=c*d; + h=del*h; + if (d < 0.0) isign = -isign; + if (fabs(del-1.0) < EPS) break; + } + if (i > MAXIT) nrerror("x too large in bessjy; try asymptotic expansion"); + rjl=isign*FPMIN; + rjpl=h*rjl; + rjl1=rjl; + rjp1=rjpl; + fact=xnu*xi; + for (l=nl;l>=1;l--) { + rjtemp=fact*rjl+rjpl; + fact -= xi; + rjpl=fact*rjtemp-rjl; + rjl=rjtemp; + } + if (rjl == 0.0) rjl=EPS; + f=rjpl/rjl; + if (x < XMIN) { + x2=0.5*x; + pimu=PI*xmu; + fact = (fabs(pimu) < EPS ? 1.0 : pimu/sin(pimu)); + d = -log(x2); + e=xmu*d; + fact2 = (fabs(e) < EPS ? 1.0 : sinh(e)/e); + beschb(xmu,&gam1,&gam2,&gampl,&gammi); + ff=2.0/PI*fact*(gam1*cosh(e)+gam2*fact2*d); + e=exp(e); + p=e/(gampl*PI); + q=1.0/(e*PI*gammi); + pimu2=0.5*pimu; + fact3 = (fabs(pimu2) < EPS ? 1.0 : sin(pimu2)/pimu2); + r=PI*pimu2*fact3*fact3; + c=1.0; + d = -x2*x2; + sum=ff+r*q; + sum1=p; + for (i=1;i<=MAXIT;i++) { + ff=(i*ff+p+q)/(i*i-xmu2); + c *= (d/i); + p /= (i-xmu); + q /= (i+xmu); + del=c*(ff+r*q); + sum += del; + del1=c*p-i*del; + sum1 += del1; + if (fabs(del) < (1.0+fabs(sum))*EPS) break; + } + if (i > MAXIT) nrerror("bessy series failed to converge"); + rymu = -sum; + ry1 = -sum1*xi2; + rymup=xmu*xi*rymu-ry1; + rjmu=w/(rymup-f*rymu); + } else { + a=0.25-xmu2; + p = -0.5*xi; + q=1.0; + br=2.0*x; + bi=2.0; + fact=a*xi/(p*p+q*q); + cr=br+q*fact; + ci=bi+p*fact; + den=br*br+bi*bi; + dr=br/den; + di = -bi/den; + dlr=cr*dr-ci*di; + dli=cr*di+ci*dr; + temp=p*dlr-q*dli; + q=p*dli+q*dlr; + p=temp; + for (i=2;i<=MAXIT;i++) { + a += 2*(i-1); + bi += 2.0; + dr=a*dr+br; + di=a*di+bi; + if (fabs(dr)+fabs(di) < FPMIN) dr=FPMIN; + fact=a/(cr*cr+ci*ci); + cr=br+cr*fact; + ci=bi-ci*fact; + if (fabs(cr)+fabs(ci) < FPMIN) cr=FPMIN; + den=dr*dr+di*di; + dr /= den; + di /= -den; + dlr=cr*dr-ci*di; + dli=cr*di+ci*dr; + temp=p*dlr-q*dli; + q=p*dli+q*dlr; + p=temp; + if (fabs(dlr-1.0)+fabs(dli) < EPS) break; + } + if (i > MAXIT) nrerror("cf2 failed in bessjy"); + gam=(p-f)/q; + rjmu=sqrt(w/((p-f)*gam+q)); + rjmu=SIGN(rjmu,rjl); + rymu=rjmu*gam; + rymup=rymu*(p+q/gam); + ry1=xmu*xi*rymu-rymup; + } + fact=rjmu/rjl; + *rj=rjl1*fact; + *rjp=rjp1*fact; + for (i=1;i<=nl;i++) { + rytemp=(xmu+i)*xi2*ry1-rymu; + rymu=ry1; + ry1=rytemp; + } + *ry=rymu; + *ryp=xnu*xi*rymu-ry1; +} +#undef EPS +#undef FPMIN +#undef MAXIT +#undef XMIN +#undef PI +#undef NRANSI diff --git a/lib/nr/ansi/recipes/bessk.c b/lib/nr/ansi/recipes/bessk.c new file mode 100644 index 0000000..4294654 --- /dev/null +++ b/lib/nr/ansi/recipes/bessk.c @@ -0,0 +1,20 @@ + +float bessk(int n, float x) +{ + float bessk0(float x); + float bessk1(float x); + void nrerror(char error_text[]); + int j; + float bk,bkm,bkp,tox; + + if (n < 2) nrerror("Index n less than 2 in bessk"); + tox=2.0/x; + bkm=bessk0(x); + bk=bessk1(x); + for (j=1;j + +float bessk0(float x) +{ + float bessi0(float x); + double y,ans; + + if (x <= 2.0) { + y=x*x/4.0; + ans=(-log(x/2.0)*bessi0(x))+(-0.57721566+y*(0.42278420 + +y*(0.23069756+y*(0.3488590e-1+y*(0.262698e-2 + +y*(0.10750e-3+y*0.74e-5)))))); + } else { + y=2.0/x; + ans=(exp(-x)/sqrt(x))*(1.25331414+y*(-0.7832358e-1 + +y*(0.2189568e-1+y*(-0.1062446e-1+y*(0.587872e-2 + +y*(-0.251540e-2+y*0.53208e-3)))))); + } + return ans; +} diff --git a/lib/nr/ansi/recipes/bessk1.c b/lib/nr/ansi/recipes/bessk1.c new file mode 100644 index 0000000..2b4d1dc --- /dev/null +++ b/lib/nr/ansi/recipes/bessk1.c @@ -0,0 +1,21 @@ + +#include + +float bessk1(float x) +{ + float bessi1(float x); + double y,ans; + + if (x <= 2.0) { + y=x*x/4.0; + ans=(log(x/2.0)*bessi1(x))+(1.0/x)*(1.0+y*(0.15443144 + +y*(-0.67278579+y*(-0.18156897+y*(-0.1919402e-1 + +y*(-0.110404e-2+y*(-0.4686e-4))))))); + } else { + y=2.0/x; + ans=(exp(-x)/sqrt(x))*(1.25331414+y*(0.23498619 + +y*(-0.3655620e-1+y*(0.1504268e-1+y*(-0.780353e-2 + +y*(0.325614e-2+y*(-0.68245e-3))))))); + } + return ans; +} diff --git a/lib/nr/ansi/recipes/bessy.c b/lib/nr/ansi/recipes/bessy.c new file mode 100644 index 0000000..7f6e0f0 --- /dev/null +++ b/lib/nr/ansi/recipes/bessy.c @@ -0,0 +1,20 @@ + +float bessy(int n, float x) +{ + float bessy0(float x); + float bessy1(float x); + void nrerror(char error_text[]); + int j; + float by,bym,byp,tox; + + if (n < 2) nrerror("Index n less than 2 in bessy"); + tox=2.0/x; + by=bessy1(x); + bym=bessy0(x); + for (j=1;j + +float bessy0(float x) +{ + float bessj0(float x); + float z; + double xx,y,ans,ans1,ans2; + + if (x < 8.0) { + y=x*x; + ans1 = -2957821389.0+y*(7062834065.0+y*(-512359803.6 + +y*(10879881.29+y*(-86327.92757+y*228.4622733)))); + ans2=40076544269.0+y*(745249964.8+y*(7189466.438 + +y*(47447.26470+y*(226.1030244+y*1.0)))); + ans=(ans1/ans2)+0.636619772*bessj0(x)*log(x); + } else { + z=8.0/x; + y=z*z; + xx=x-0.785398164; + ans1=1.0+y*(-0.1098628627e-2+y*(0.2734510407e-4 + +y*(-0.2073370639e-5+y*0.2093887211e-6))); + ans2 = -0.1562499995e-1+y*(0.1430488765e-3 + +y*(-0.6911147651e-5+y*(0.7621095161e-6 + +y*(-0.934945152e-7)))); + ans=sqrt(0.636619772/x)*(sin(xx)*ans1+z*cos(xx)*ans2); + } + return ans; +} diff --git a/lib/nr/ansi/recipes/bessy1.c b/lib/nr/ansi/recipes/bessy1.c new file mode 100644 index 0000000..7973464 --- /dev/null +++ b/lib/nr/ansi/recipes/bessy1.c @@ -0,0 +1,31 @@ + +#include + +float bessy1(float x) +{ + float bessj1(float x); + float z; + double xx,y,ans,ans1,ans2; + + if (x < 8.0) { + y=x*x; + ans1=x*(-0.4900604943e13+y*(0.1275274390e13 + +y*(-0.5153438139e11+y*(0.7349264551e9 + +y*(-0.4237922726e7+y*0.8511937935e4))))); + ans2=0.2499580570e14+y*(0.4244419664e12 + +y*(0.3733650367e10+y*(0.2245904002e8 + +y*(0.1020426050e6+y*(0.3549632885e3+y))))); + ans=(ans1/ans2)+0.636619772*(bessj1(x)*log(x)-1.0/x); + } else { + z=8.0/x; + y=z*z; + xx=x-2.356194491; + ans1=1.0+y*(0.183105e-2+y*(-0.3516396496e-4 + +y*(0.2457520174e-5+y*(-0.240337019e-6)))); + ans2=0.04687499995+y*(-0.2002690873e-3 + +y*(0.8449199096e-5+y*(-0.88228987e-6 + +y*0.105787412e-6))); + ans=sqrt(0.636619772/x)*(sin(xx)*ans1+z*cos(xx)*ans2); + } + return ans; +} diff --git a/lib/nr/ansi/recipes/beta.c b/lib/nr/ansi/recipes/beta.c new file mode 100644 index 0000000..ee757cf --- /dev/null +++ b/lib/nr/ansi/recipes/beta.c @@ -0,0 +1,9 @@ + +#include + +float beta(float z, float w) +{ + float gammln(float xx); + + return exp(gammln(z)+gammln(w)-gammln(z+w)); +} diff --git a/lib/nr/ansi/recipes/betacf.c b/lib/nr/ansi/recipes/betacf.c new file mode 100644 index 0000000..46d38c3 --- /dev/null +++ b/lib/nr/ansi/recipes/betacf.c @@ -0,0 +1,45 @@ + +#include +#define MAXIT 100 +#define EPS 3.0e-7 +#define FPMIN 1.0e-30 + +float betacf(float a, float b, float x) +{ + void nrerror(char error_text[]); + int m,m2; + float aa,c,d,del,h,qab,qam,qap; + + qab=a+b; + qap=a+1.0; + qam=a-1.0; + c=1.0; + d=1.0-qab*x/qap; + if (fabs(d) < FPMIN) d=FPMIN; + d=1.0/d; + h=d; + for (m=1;m<=MAXIT;m++) { + m2=2*m; + aa=m*(b-m)*x/((qam+m2)*(a+m2)); + d=1.0+aa*d; + if (fabs(d) < FPMIN) d=FPMIN; + c=1.0+aa/c; + if (fabs(c) < FPMIN) c=FPMIN; + d=1.0/d; + h *= d*c; + aa = -(a+m)*(qab+m)*x/((a+m2)*(qap+m2)); + d=1.0+aa*d; + if (fabs(d) < FPMIN) d=FPMIN; + c=1.0+aa/c; + if (fabs(c) < FPMIN) c=FPMIN; + d=1.0/d; + del=d*c; + h *= del; + if (fabs(del-1.0) < EPS) break; + } + if (m > MAXIT) nrerror("a or b too big, or MAXIT too small in betacf"); + return h; +} +#undef MAXIT +#undef EPS +#undef FPMIN diff --git a/lib/nr/ansi/recipes/betai.c b/lib/nr/ansi/recipes/betai.c new file mode 100644 index 0000000..b6baf38 --- /dev/null +++ b/lib/nr/ansi/recipes/betai.c @@ -0,0 +1,19 @@ + +#include + +float betai(float a, float b, float x) +{ + float betacf(float a, float b, float x); + float gammln(float xx); + void nrerror(char error_text[]); + float bt; + + if (x < 0.0 || x > 1.0) nrerror("Bad x in routine betai"); + if (x == 0.0 || x == 1.0) bt=0.0; + else + bt=exp(gammln(a+b)-gammln(a)-gammln(b)+a*log(x)+b*log(1.0-x)); + if (x < (a+1.0)/(a+b+2.0)) + return bt*betacf(a,b,x)/a; + else + return 1.0-bt*betacf(b,a,1.0-x)/b; +} diff --git a/lib/nr/ansi/recipes/bico.c b/lib/nr/ansi/recipes/bico.c new file mode 100644 index 0000000..25f8f40 --- /dev/null +++ b/lib/nr/ansi/recipes/bico.c @@ -0,0 +1,9 @@ + +#include + +float bico(int n, int k) +{ + float factln(int n); + + return floor(0.5+exp(factln(n)-factln(k)-factln(n-k))); +} diff --git a/lib/nr/ansi/recipes/bksub.c b/lib/nr/ansi/recipes/bksub.c new file mode 100644 index 0000000..f3ddeb4 --- /dev/null +++ b/lib/nr/ansi/recipes/bksub.c @@ -0,0 +1,23 @@ + +void bksub(int ne, int nb, int jf, int k1, int k2, float ***c) +{ + int nbf,im,kp,k,j,i; + float xx; + + nbf=ne-nb; + im=1; + for (k=k2;k>=k1;k--) { + if (k == k1) im=nbf+1; + kp=k+1; + for (j=1;j<=nbf;j++) { + xx=c[j][jf][kp]; + for (i=im;i<=ne;i++) + c[i][jf][k] -= c[i][j][k]*xx; + } + } + for (k=k1;k<=k2;k++) { + kp=k+1; + for (i=1;i<=nb;i++) c[i][1][k]=c[i+nbf][jf][k]; + for (i=1;i<=nbf;i++) c[i+nb][1][k]=c[i][jf][kp]; + } +} diff --git a/lib/nr/ansi/recipes/bnldev.c b/lib/nr/ansi/recipes/bnldev.c new file mode 100644 index 0000000..4b98d11 --- /dev/null +++ b/lib/nr/ansi/recipes/bnldev.c @@ -0,0 +1,55 @@ + +#include +#define PI 3.141592654 + +float bnldev(float pp, int n, long *idum) +{ + float gammln(float xx); + float ran1(long *idum); + int j; + static int nold=(-1); + float am,em,g,angle,p,bnl,sq,t,y; + static float pold=(-1.0),pc,plog,pclog,en,oldg; + + p=(pp <= 0.5 ? pp : 1.0-pp); + am=n*p; + if (n < 25) { + bnl=0.0; + for (j=1;j<=n;j++) + if (ran1(idum) < p) ++bnl; + } else if (am < 1.0) { + g=exp(-am); + t=1.0; + for (j=0;j<=n;j++) { + t *= ran1(idum); + if (t < g) break; + } + bnl=(j <= n ? j : n); + } else { + if (n != nold) { + en=n; + oldg=gammln(en+1.0); + nold=n; + } if (p != pold) { + pc=1.0-p; + plog=log(p); + pclog=log(pc); + pold=p; + } + sq=sqrt(2.0*am*pc); + do { + do { + angle=PI*ran1(idum); + y=tan(angle); + em=sq*y+am; + } while (em < 0.0 || em >= (en+1.0)); + em=floor(em); + t=1.2*sq*(1.0+y*y)*exp(oldg-gammln(em+1.0) + -gammln(en-em+1.0)+em*plog+(en-em)*pclog); + } while (ran1(idum) > t); + bnl=em; + } + if (p != pp) bnl=n-bnl; + return bnl; +} +#undef PI diff --git a/lib/nr/ansi/recipes/brent.c b/lib/nr/ansi/recipes/brent.c new file mode 100644 index 0000000..7a9bb6c --- /dev/null +++ b/lib/nr/ansi/recipes/brent.c @@ -0,0 +1,75 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define ITMAX 100 +#define CGOLD 0.3819660 +#define ZEPS 1.0e-10 +#define SHFT(a,b,c,d) (a)=(b);(b)=(c);(c)=(d); + +float brent(float ax, float bx, float cx, float (*f)(float), float tol, + float *xmin) +{ + int iter; + float a,b,d,etemp,fu,fv,fw,fx,p,q,r,tol1,tol2,u,v,w,x,xm; + float e=0.0; + + a=(ax < cx ? ax : cx); + b=(ax > cx ? ax : cx); + x=w=v=bx; + fw=fv=fx=(*f)(x); + for (iter=1;iter<=ITMAX;iter++) { + xm=0.5*(a+b); + tol2=2.0*(tol1=tol*fabs(x)+ZEPS); + if (fabs(x-xm) <= (tol2-0.5*(b-a))) { + *xmin=x; + return fx; + } + if (fabs(e) > tol1) { + r=(x-w)*(fx-fv); + q=(x-v)*(fx-fw); + p=(x-v)*q-(x-w)*r; + q=2.0*(q-r); + if (q > 0.0) p = -p; + q=fabs(q); + etemp=e; + e=d; + if (fabs(p) >= fabs(0.5*q*etemp) || p <= q*(a-x) || p >= q*(b-x)) + d=CGOLD*(e=(x >= xm ? a-x : b-x)); + else { + d=p/q; + u=x+d; + if (u-a < tol2 || b-u < tol2) + d=SIGN(tol1,xm-x); + } + } else { + d=CGOLD*(e=(x >= xm ? a-x : b-x)); + } + u=(fabs(d) >= tol1 ? x+d : x+SIGN(tol1,d)); + fu=(*f)(u); + if (fu <= fx) { + if (u >= x) a=x; else b=x; + SHFT(v,w,x,u) + SHFT(fv,fw,fx,fu) + } else { + if (u < x) a=u; else b=u; + if (fu <= fw || w == x) { + v=w; + w=u; + fv=fw; + fw=fu; + } else if (fu <= fv || v == x || v == w) { + v=u; + fv=fu; + } + } + } + nrerror("Too many iterations in brent"); + *xmin=x; + return fx; +} +#undef ITMAX +#undef CGOLD +#undef ZEPS +#undef SHFT +#undef NRANSI diff --git a/lib/nr/ansi/recipes/broydn.c b/lib/nr/ansi/recipes/broydn.c new file mode 100644 index 0000000..4baf7c6 --- /dev/null +++ b/lib/nr/ansi/recipes/broydn.c @@ -0,0 +1,167 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define MAXITS 200 +#define EPS 1.0e-7 +#define TOLF 1.0e-4 +#define TOLX EPS +#define STPMX 100.0 +#define TOLMIN 1.0e-6 +#define FREERETURN {free_vector(fvec,1,n);free_vector(xold,1,n);\ + free_vector(w,1,n);free_vector(t,1,n);free_vector(s,1,n);\ + free_matrix(r,1,n,1,n);free_matrix(qt,1,n,1,n);free_vector(p,1,n);\ + free_vector(g,1,n);free_vector(fvcold,1,n);free_vector(d,1,n);\ + free_vector(c,1,n);return;} + +int nn; +float *fvec; +void (*nrfuncv)(int n, float v[], float f[]); + +void broydn(float x[], int n, int *check, + void (*vecfunc)(int, float [], float [])) +{ + void fdjac(int n, float x[], float fvec[], float **df, + void (*vecfunc)(int, float [], float [])); + float fmin(float x[]); + void lnsrch(int n, float xold[], float fold, float g[], float p[], float x[], + float *f, float stpmax, int *check, float (*func)(float [])); + void qrdcmp(float **a, int n, float *c, float *d, int *sing); + void qrupdt(float **r, float **qt, int n, float u[], float v[]); + void rsolv(float **a, int n, float d[], float b[]); + int i,its,j,k,restrt,sing,skip; + float den,f,fold,stpmax,sum,temp,test,*c,*d,*fvcold; + float *g,*p,**qt,**r,*s,*t,*w,*xold; + + c=vector(1,n); + d=vector(1,n); + fvcold=vector(1,n); + g=vector(1,n); + p=vector(1,n); + qt=matrix(1,n,1,n); + r=matrix(1,n,1,n); + s=vector(1,n); + t=vector(1,n); + w=vector(1,n); + xold=vector(1,n); + fvec=vector(1,n); + nn=n; + nrfuncv=vecfunc; + f=fmin(x); + test=0.0; + for (i=1;i<=n;i++) + if (fabs(fvec[i]) > test)test=fabs(fvec[i]); + if (test < 0.01*TOLF) { + *check=0; + FREERETURN + } + for (sum=0.0,i=1;i<=n;i++) sum += SQR(x[i]); + stpmax=STPMX*FMAX(sqrt(sum),(float)n); + restrt=1; + for (its=1;its<=MAXITS;its++) { + if (restrt) { + fdjac(n,x,fvec,r,vecfunc); + qrdcmp(r,n,c,d,&sing); + if (sing) nrerror("singular Jacobian in broydn"); + for (i=1;i<=n;i++) { + for (j=1;j<=n;j++) qt[i][j]=0.0; + qt[i][i]=1.0; + } + for (k=1;k= EPS*(fabs(fvec[i])+fabs(fvcold[i]))) skip=0; + else w[i]=0.0; + } + if (!skip) { + for (i=1;i<=n;i++) { + for (sum=0.0,j=1;j<=n;j++) sum += qt[i][j]*w[j]; + t[i]=sum; + } + for (den=0.0,i=1;i<=n;i++) den += SQR(s[i]); + for (i=1;i<=n;i++) s[i] /= den; + qrupdt(r,qt,n,t,s); + for (i=1;i<=n;i++) { + if (r[i][i] == 0.0) nrerror("r singular in broydn"); + d[i]=r[i][i]; + } + } + } + for (i=1;i<=n;i++) { + for (sum=0.0,j=1;j<=n;j++) sum += qt[i][j]*fvec[j]; + p[i] = -sum; + } + for (i=n;i>=1;i--) { + for (sum=0.0,j=1;j<=i;j++) sum -= r[j][i]*p[j]; + g[i]=sum; + } + for (i=1;i<=n;i++) { + xold[i]=x[i]; + fvcold[i]=fvec[i]; + } + fold=f; + rsolv(r,n,d,p); + lnsrch(n,xold,fold,g,p,x,&f,stpmax,check,fmin); + test=0.0; + for (i=1;i<=n;i++) + if (fabs(fvec[i]) > test) test=fabs(fvec[i]); + if (test < TOLF) { + *check=0; + FREERETURN + } + if (*check) { + if (restrt) FREERETURN + else { + test=0.0; + den=FMAX(f,0.5*n); + for (i=1;i<=n;i++) { + temp=fabs(g[i])*FMAX(fabs(x[i]),1.0)/den; + if (temp > test) test=temp; + } + if (test < TOLMIN) FREERETURN + else restrt=1; + } + } else { + restrt=0; + test=0.0; + for (i=1;i<=n;i++) { + temp=(fabs(x[i]-xold[i]))/FMAX(fabs(x[i]),1.0); + if (temp > test) test=temp; + } + if (test < TOLX) FREERETURN + } + } + nrerror("MAXITS exceeded in broydn"); + FREERETURN +} +#undef MAXITS +#undef EPS +#undef TOLF +#undef TOLMIN +#undef TOLX +#undef STPMX +#undef FREERETURN +#undef NRANSI diff --git a/lib/nr/ansi/recipes/bsstep.c b/lib/nr/ansi/recipes/bsstep.c new file mode 100644 index 0000000..1f90190 --- /dev/null +++ b/lib/nr/ansi/recipes/bsstep.c @@ -0,0 +1,141 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define KMAXX 8 +#define IMAXX (KMAXX+1) +#define SAFE1 0.25 +#define SAFE2 0.7 +#define REDMAX 1.0e-5 +#define REDMIN 0.7 +#define TINY 1.0e-30 +#define SCALMX 0.1 + +float **d,*x; + +void bsstep(float y[], float dydx[], int nv, float *xx, float htry, float eps, + float yscal[], float *hdid, float *hnext, + void (*derivs)(float, float [], float [])) +{ + void mmid(float y[], float dydx[], int nvar, float xs, float htot, + int nstep, float yout[], void (*derivs)(float, float[], float[])); + void pzextr(int iest, float xest, float yest[], float yz[], float dy[], + int nv); + int i,iq,k,kk,km; + static int first=1,kmax,kopt; + static float epsold = -1.0,xnew; + float eps1,errmax,fact,h,red,scale,work,wrkmin,xest; + float *err,*yerr,*ysav,*yseq; + static float a[IMAXX+1]; + static float alf[KMAXX+1][KMAXX+1]; + static int nseq[IMAXX+1]={0,2,4,6,8,10,12,14,16,18}; + int reduct,exitflag=0; + + d=matrix(1,nv,1,KMAXX); + err=vector(1,KMAXX); + x=vector(1,KMAXX); + yerr=vector(1,nv); + ysav=vector(1,nv); + yseq=vector(1,nv); + if (eps != epsold) { + *hnext = xnew = -1.0e29; + eps1=SAFE1*eps; + a[1]=nseq[1]+1; + for (k=1;k<=KMAXX;k++) a[k+1]=a[k]+nseq[k+1]; + for (iq=2;iq<=KMAXX;iq++) { + for (k=1;k a[kopt]*alf[kopt-1][kopt]) break; + kmax=kopt; + } + h=htry; + for (i=1;i<=nv;i++) ysav[i]=y[i]; + if (*xx != xnew || h != (*hnext)) { + first=1; + kopt=kmax; + } + reduct=0; + for (;;) { + for (k=1;k<=kmax;k++) { + xnew=(*xx)+h; + if (xnew == (*xx)) nrerror("step size underflow in bsstep"); + mmid(ysav,dydx,nv,*xx,h,nseq[k],yseq,derivs); + xest=SQR(h/nseq[k]); + pzextr(k,xest,yseq,y,yerr,nv); + if (k != 1) { + errmax=TINY; + for (i=1;i<=nv;i++) errmax=FMAX(errmax,fabs(yerr[i]/yscal[i])); + errmax /= eps; + km=k-1; + err[km]=pow(errmax/SAFE1,1.0/(2*km+1)); + } + if (k != 1 && (k >= kopt-1 || first)) { + if (errmax < 1.0) { + exitflag=1; + break; + } + if (k == kmax || k == kopt+1) { + red=SAFE2/err[km]; + break; + } + else if (k == kopt && alf[kopt-1][kopt] < err[km]) { + red=1.0/err[km]; + break; + } + else if (kopt == kmax && alf[km][kmax-1] < err[km]) { + red=alf[km][kmax-1]*SAFE2/err[km]; + break; + } + else if (alf[km][kopt] < err[km]) { + red=alf[km][kopt-1]/err[km]; + break; + } + } + } + if (exitflag) break; + red=FMIN(red,REDMIN); + red=FMAX(red,REDMAX); + h *= red; + reduct=1; + } + *xx=xnew; + *hdid=h; + first=0; + wrkmin=1.0e35; + for (kk=1;kk<=km;kk++) { + fact=FMAX(err[kk],SCALMX); + work=fact*a[kk+1]; + if (work < wrkmin) { + scale=fact; + wrkmin=work; + kopt=kk+1; + } + } + *hnext=h/scale; + if (kopt >= k && kopt != kmax && !reduct) { + fact=FMAX(scale/alf[kopt-1][kopt],SCALMX); + if (a[kopt+1]*fact <= wrkmin) { + *hnext=h/fact; + kopt++; + } + } + free_vector(yseq,1,nv); + free_vector(ysav,1,nv); + free_vector(yerr,1,nv); + free_vector(x,1,KMAXX); + free_vector(err,1,KMAXX); + free_matrix(d,1,nv,1,KMAXX); +} +#undef KMAXX +#undef IMAXX +#undef SAFE1 +#undef SAFE2 +#undef REDMAX +#undef REDMIN +#undef TINY +#undef SCALMX +#undef NRANSI diff --git a/lib/nr/ansi/recipes/caldat.c b/lib/nr/ansi/recipes/caldat.c new file mode 100644 index 0000000..278cfa1 --- /dev/null +++ b/lib/nr/ansi/recipes/caldat.c @@ -0,0 +1,28 @@ + +#include +#define IGREG 2299161 + +void caldat(long julian, int *mm, int *id, int *iyyy) +{ + long ja,jalpha,jb,jc,jd,je; + + if (julian >= IGREG) { + jalpha=(long)(((double) (julian-1867216)-0.25)/36524.25); + ja=julian+1+jalpha-(long) (0.25*jalpha); + } else if (julian < 0) { + ja=julian+36525*(1-julian/36525); + } else + ja=julian; + jb=ja+1524; + jc=(long)(6680.0+((double) (jb-2439870)-122.1)/365.25); + jd=(long)(365*jc+(0.25*jc)); + je=(long)((jb-jd)/30.6001); + *id=jb-jd-(long) (30.6001*je); + *mm=je-1; + if (*mm > 12) *mm -= 12; + *iyyy=jc-4715; + if (*mm > 2) --(*iyyy); + if (*iyyy <= 0) --(*iyyy); + if (julian < 0) *iyyy -= 100*(1-julian/36525); +} +#undef IGREG diff --git a/lib/nr/ansi/recipes/chder.c b/lib/nr/ansi/recipes/chder.c new file mode 100644 index 0000000..dcea1ea --- /dev/null +++ b/lib/nr/ansi/recipes/chder.c @@ -0,0 +1,14 @@ + +void chder(float a, float b, float c[], float cder[], int n) +{ + int j; + float con; + + cder[n-1]=0.0; + cder[n-2]=2*(n-1)*c[n-1]; + for (j=n-3;j>=0;j--) + cder[j]=cder[j+2]+2*(j+1)*c[j+1]; + con=2.0/(b-a); + for (j=0;j 0.0) nrerror("x not in range in routine chebev"); + y2=2.0*(y=(2.0*x-a-b)/(b-a)); + for (j=m-1;j>=1;j--) { + sv=d; + d=y2*d-dd+c[j]; + dd=sv; + } + return y*d-dd+0.5*c[0]; +} diff --git a/lib/nr/ansi/recipes/chebft.c b/lib/nr/ansi/recipes/chebft.c new file mode 100644 index 0000000..a730c6d --- /dev/null +++ b/lib/nr/ansi/recipes/chebft.c @@ -0,0 +1,29 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define PI 3.141592653589793 + +void chebft(float a, float b, float c[], int n, float (*func)(float)) +{ + int k,j; + float fac,bpa,bma,*f; + + f=vector(0,n-1); + bma=0.5*(b-a); + bpa=0.5*(b+a); + for (k=0;k=1;j--) { + for (k=n-j;k>=1;k--) { + sv=d[k]; + d[k]=2.0*d[k-1]-dd[k]; + dd[k]=sv; + } + sv=d[0]; + d[0] = -dd[0]+c[j]; + dd[0]=sv; + } + for (j=n-1;j>=1;j--) + d[j]=d[j-1]-dd[j]; + d[0] = -dd[0]+0.5*c[0]; + free_vector(dd,0,n-1); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/chint.c b/lib/nr/ansi/recipes/chint.c new file mode 100644 index 0000000..0ade1c9 --- /dev/null +++ b/lib/nr/ansi/recipes/chint.c @@ -0,0 +1,16 @@ + +void chint(float a, float b, float c[], float cint[], int n) +{ + int j; + float sum=0.0,fac=1.0,con; + + con=0.25*(b-a); + for (j=1;j<=n-2;j++) { + cint[j]=con*(c[j-1]-c[j+1])/j; + sum += fac*cint[j]; + fac = -fac; + } + cint[n-1]=con*c[n-2]/(n-1); + sum += fac*cint[n-1]; + cint[0]=2.0*sum; +} diff --git a/lib/nr/ansi/recipes/chixy.c b/lib/nr/ansi/recipes/chixy.c new file mode 100644 index 0000000..d0c45a8 --- /dev/null +++ b/lib/nr/ansi/recipes/chixy.c @@ -0,0 +1,30 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define BIG 1.0e30 + +extern int nn; +extern float *xx,*yy,*sx,*sy,*ww,aa,offs; + +float chixy(float bang) +{ + int j; + float ans,avex=0.0,avey=0.0,sumw=0.0,b; + + b=tan(bang); + for (j=1;j<=nn;j++) { + ww[j] = SQR(b*sx[j])+SQR(sy[j]); + sumw += (ww[j] = (ww[j] < 1.0/BIG ? BIG : 1.0/ww[j])); + avex += ww[j]*xx[j]; + avey += ww[j]*yy[j]; + } + avex /= sumw; + avey /= sumw; + aa=avey-b*avex; + for (ans = -offs,j=1;j<=nn;j++) + ans += ww[j]*SQR(yy[j]-aa-b*xx[j]); + return ans; +} +#undef BIG +#undef NRANSI diff --git a/lib/nr/ansi/recipes/choldc.c b/lib/nr/ansi/recipes/choldc.c new file mode 100644 index 0000000..d0702c3 --- /dev/null +++ b/lib/nr/ansi/recipes/choldc.c @@ -0,0 +1,20 @@ + +#include + +void choldc(float **a, int n, float p[]) +{ + void nrerror(char error_text[]); + int i,j,k; + float sum; + + for (i=1;i<=n;i++) { + for (j=i;j<=n;j++) { + for (sum=a[i][j],k=i-1;k>=1;k--) sum -= a[i][k]*a[j][k]; + if (i == j) { + if (sum <= 0.0) + nrerror("choldc failed"); + p[i]=sqrt(sum); + } else a[j][i]=sum/p[i]; + } + } +} diff --git a/lib/nr/ansi/recipes/cholsl.c b/lib/nr/ansi/recipes/cholsl.c new file mode 100644 index 0000000..2bada4c --- /dev/null +++ b/lib/nr/ansi/recipes/cholsl.c @@ -0,0 +1,15 @@ + +void cholsl(float **a, int n, float p[], float b[], float x[]) +{ + int i,k; + float sum; + + for (i=1;i<=n;i++) { + for (sum=b[i],k=i-1;k>=1;k--) sum -= a[i][k]*x[k]; + x[i]=sum/p[i]; + } + for (i=n;i>=1;i--) { + for (sum=x[i],k=i+1;k<=n;k++) sum -= a[k][i]*x[k]; + x[i]=sum/p[i]; + } +} diff --git a/lib/nr/ansi/recipes/chsone.c b/lib/nr/ansi/recipes/chsone.c new file mode 100644 index 0000000..060ab75 --- /dev/null +++ b/lib/nr/ansi/recipes/chsone.c @@ -0,0 +1,18 @@ + +void chsone(float bins[], float ebins[], int nbins, int knstrn, float *df, + float *chsq, float *prob) +{ + float gammq(float a, float x); + void nrerror(char error_text[]); + int j; + float temp; + + *df=nbins-knstrn; + *chsq=0.0; + for (j=1;j<=nbins;j++) { + if (ebins[j] <= 0.0) nrerror("Bad expected number in chsone"); + temp=bins[j]-ebins[j]; + *chsq += temp*temp/ebins[j]; + } + *prob=gammq(0.5*(*df),0.5*(*chsq)); +} diff --git a/lib/nr/ansi/recipes/chstwo.c b/lib/nr/ansi/recipes/chstwo.c new file mode 100644 index 0000000..47f69d0 --- /dev/null +++ b/lib/nr/ansi/recipes/chstwo.c @@ -0,0 +1,19 @@ + +void chstwo(float bins1[], float bins2[], int nbins, int knstrn, float *df, + float *chsq, float *prob) +{ + float gammq(float a, float x); + int j; + float temp; + + *df=nbins-knstrn; + *chsq=0.0; + for (j=1;j<=nbins;j++) + if (bins1[j] == 0.0 && bins2[j] == 0.0) + --(*df); + else { + temp=bins1[j]-bins2[j]; + *chsq += temp*temp/(bins1[j]+bins2[j]); + } + *prob=gammq(0.5*(*df),0.5*(*chsq)); +} diff --git a/lib/nr/ansi/recipes/cisi.c b/lib/nr/ansi/recipes/cisi.c new file mode 100644 index 0000000..dfffa8d --- /dev/null +++ b/lib/nr/ansi/recipes/cisi.c @@ -0,0 +1,81 @@ + +#include +#include "complex.h" +#define EPS 6.0e-8 +#define EULER 0.57721566 +#define MAXIT 100 +#define PIBY2 1.5707963 +#define FPMIN 1.0e-30 +#define TMIN 2.0 +#define TRUE 1 +#define ONE Complex(1.0,0.0) + +void cisi(float x, float *ci, float *si) +{ + void nrerror(char error_text[]); + int i,k,odd; + float a,err,fact,sign,sum,sumc,sums,t,term; + fcomplex h,b,c,d,del; + + t=fabs(x); + if (t == 0.0) { + *si=0.0; + *ci = -1.0/FPMIN; + return; + } + if (t > TMIN) { + b=Complex(1.0,t); + c=Complex(1.0/FPMIN,0.0); + d=h=Cdiv(ONE,b); + for (i=2;i<=MAXIT;i++) { + a = -(i-1)*(i-1); + b=Cadd(b,Complex(2.0,0.0)); + d=Cdiv(ONE,Cadd(RCmul(a,d),b)); + c=Cadd(b,Cdiv(Complex(a,0.0),c)); + del=Cmul(c,d); + h=Cmul(h,del); + if (fabs(del.r-1.0)+fabs(del.i) < EPS) break; + } + if (i > MAXIT) nrerror("cf failed in cisi"); + h=Cmul(Complex(cos(t),-sin(t)),h); + *ci = -h.r; + *si=PIBY2+h.i; + } else { + if (t < sqrt(FPMIN)) { + sumc=0.0; + sums=t; + } else { + sum=sums=sumc=0.0; + sign=fact=1.0; + odd=TRUE; + for (k=1;k<=MAXIT;k++) { + fact *= t/k; + term=fact/k; + sum += sign*term; + err=term/fabs(sum); + if (odd) { + sign = -sign; + sums=sum; + sum=sumc; + } else { + sumc=sum; + sum=sums; + } + if (err < EPS) break; + odd=!odd; + } + if (k > MAXIT) nrerror("maxits exceeded in cisi"); + } + *si=sums; + *ci=sumc+log(t)+EULER; + } + if (x < 0.0) *si = -(*si); +} +#undef EPS +#undef EULER +#undef MAXIT +#undef PIBY2 +#undef FPMIN +#undef TMIN +#undef TRUE +#undef ONE diff --git a/lib/nr/ansi/recipes/cntab1.c b/lib/nr/ansi/recipes/cntab1.c new file mode 100644 index 0000000..0498d18 --- /dev/null +++ b/lib/nr/ansi/recipes/cntab1.c @@ -0,0 +1,48 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define TINY 1.0e-30 + +void cntab1(int **nn, int ni, int nj, float *chisq, float *df, float *prob, + float *cramrv, float *ccc) +{ + float gammq(float a, float x); + int nnj,nni,j,i,minij; + float sum=0.0,expctd,*sumi,*sumj,temp; + + sumi=vector(1,ni); + sumj=vector(1,nj); + nni=ni; + nnj=nj; + for (i=1;i<=ni;i++) { + sumi[i]=0.0; + for (j=1;j<=nj;j++) { + sumi[i] += nn[i][j]; + sum += nn[i][j]; + } + if (sumi[i] == 0.0) --nni; + } + for (j=1;j<=nj;j++) { + sumj[j]=0.0; + for (i=1;i<=ni;i++) sumj[j] += nn[i][j]; + if (sumj[j] == 0.0) --nnj; + } + *df=nni*nnj-nni-nnj+1; + *chisq=0.0; + for (i=1;i<=ni;i++) { + for (j=1;j<=nj;j++) { + expctd=sumj[j]*sumi[i]/sum; + temp=nn[i][j]-expctd; + *chisq += temp*temp/(expctd+TINY); + } + } + *prob=gammq(0.5*(*df),0.5*(*chisq)); + minij = nni < nnj ? nni-1 : nnj-1; + *cramrv=sqrt(*chisq/(sum*minij)); + *ccc=sqrt(*chisq/(*chisq+sum)); + free_vector(sumj,1,nj); + free_vector(sumi,1,ni); +} +#undef TINY +#undef NRANSI diff --git a/lib/nr/ansi/recipes/cntab2.c b/lib/nr/ansi/recipes/cntab2.c new file mode 100644 index 0000000..2d06ff5 --- /dev/null +++ b/lib/nr/ansi/recipes/cntab2.c @@ -0,0 +1,55 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define TINY 1.0e-30 + +void cntab2(int **nn, int ni, int nj, float *h, float *hx, float *hy, + float *hygx, float *hxgy, float *uygx, float *uxgy, float *uxy) +{ + int i,j; + float sum=0.0,p,*sumi,*sumj; + + sumi=vector(1,ni); + sumj=vector(1,nj); + for (i=1;i<=ni;i++) { + sumi[i]=0.0; + for (j=1;j<=nj;j++) { + sumi[i] += nn[i][j]; + sum += nn[i][j]; + } + } + for (j=1;j<=nj;j++) { + sumj[j]=0.0; + for (i=1;i<=ni;i++) + sumj[j] += nn[i][j]; + } + *hx=0.0; + for (i=1;i<=ni;i++) + if (sumi[i]) { + p=sumi[i]/sum; + *hx -= p*log(p); + } + *hy=0.0; + for (j=1;j<=nj;j++) + if (sumj[j]) { + p=sumj[j]/sum; + *hy -= p*log(p); + } + *h=0.0; + for (i=1;i<=ni;i++) + for (j=1;j<=nj;j++) + if (nn[i][j]) { + p=nn[i][j]/sum; + *h -= p*log(p); + } + *hygx=(*h)-(*hx); + *hxgy=(*h)-(*hy); + *uygx=(*hy-*hygx)/(*hy+TINY); + *uxgy=(*hx-*hxgy)/(*hx+TINY); + *uxy=2.0*(*hx+*hy-*h)/(*hx+*hy+TINY); + free_vector(sumj,1,nj); + free_vector(sumi,1,ni); +} +#undef TINY +#undef NRANSI diff --git a/lib/nr/ansi/recipes/complex.c b/lib/nr/ansi/recipes/complex.c new file mode 100644 index 0000000..73cbe33 --- /dev/null +++ b/lib/nr/ansi/recipes/complex.c @@ -0,0 +1,125 @@ +/* CAUTION: This is the ANSI C (only) version of the Numerical Recipes + utility file complex.c. Do not confuse this file with the same-named + file complex.c that is supplied in the same subdirectory or archive + as the header file complex.h. *That* file contains both ANSI and + traditional K&R versions, along with #ifdef macros to select the + correct version. *This* file contains only ANSI C. */ + +#include + +typedef struct FCOMPLEX {float r,i;} fcomplex; + +fcomplex Cadd(fcomplex a, fcomplex b) +{ + fcomplex c; + c.r=a.r+b.r; + c.i=a.i+b.i; + return c; +} + +fcomplex Csub(fcomplex a, fcomplex b) +{ + fcomplex c; + c.r=a.r-b.r; + c.i=a.i-b.i; + return c; +} + + +fcomplex Cmul(fcomplex a, fcomplex b) +{ + fcomplex c; + c.r=a.r*b.r-a.i*b.i; + c.i=a.i*b.r+a.r*b.i; + return c; +} + +fcomplex Complex(float re, float im) +{ + fcomplex c; + c.r=re; + c.i=im; + return c; +} + +fcomplex Conjg(fcomplex z) +{ + fcomplex c; + c.r=z.r; + c.i = -z.i; + return c; +} + +fcomplex Cdiv(fcomplex a, fcomplex b) +{ + fcomplex c; + float r,den; + if (fabs(b.r) >= fabs(b.i)) { + r=b.i/b.r; + den=b.r+r*b.i; + c.r=(a.r+r*a.i)/den; + c.i=(a.i-r*a.r)/den; + } else { + r=b.r/b.i; + den=b.i+r*b.r; + c.r=(a.r*r+a.i)/den; + c.i=(a.i*r-a.r)/den; + } + return c; +} + +float Cabs(fcomplex z) +{ + float x,y,ans,temp; + x=fabs(z.r); + y=fabs(z.i); + if (x == 0.0) + ans=y; + else if (y == 0.0) + ans=x; + else if (x > y) { + temp=y/x; + ans=x*sqrt(1.0+temp*temp); + } else { + temp=x/y; + ans=y*sqrt(1.0+temp*temp); + } + return ans; +} + +fcomplex Csqrt(fcomplex z) +{ + fcomplex c; + float x,y,w,r; + if ((z.r == 0.0) && (z.i == 0.0)) { + c.r=0.0; + c.i=0.0; + return c; + } else { + x=fabs(z.r); + y=fabs(z.i); + if (x >= y) { + r=y/x; + w=sqrt(x)*sqrt(0.5*(1.0+sqrt(1.0+r*r))); + } else { + r=x/y; + w=sqrt(y)*sqrt(0.5*(r+sqrt(1.0+r*r))); + } + if (z.r >= 0.0) { + c.r=w; + c.i=z.i/(2.0*w); + } else { + c.i=(z.i >= 0) ? w : -w; + c.r=z.i/(2.0*c.i); + } + return c; + } +} + +fcomplex RCmul(float x, fcomplex a) +{ + fcomplex c; + c.r=x*a.r; + c.i=x*a.i; + return c; +} diff --git a/lib/nr/ansi/recipes/convlv.c b/lib/nr/ansi/recipes/convlv.c new file mode 100644 index 0000000..de4f09c --- /dev/null +++ b/lib/nr/ansi/recipes/convlv.c @@ -0,0 +1,36 @@ + +#define NRANSI +#include "nrutil.h" + +void convlv(float data[], unsigned long n, float respns[], unsigned long m, + int isign, float ans[]) +{ + void realft(float data[], unsigned long n, int isign); + void twofft(float data1[], float data2[], float fft1[], float fft2[], + unsigned long n); + unsigned long i,no2; + float dum,mag2,*fft; + + fft=vector(1,n<<1); + for (i=1;i<=(m-1)/2;i++) + respns[n+1-i]=respns[m+1-i]; + for (i=(m+3)/2;i<=n-(m-1)/2;i++) + respns[i]=0.0; + twofft(data,respns,fft,ans,n); + no2=n>>1; + for (i=2;i<=n+2;i+=2) { + if (isign == 1) { + ans[i-1]=(fft[i-1]*(dum=ans[i-1])-fft[i]*ans[i])/no2; + ans[i]=(fft[i]*dum+fft[i-1]*ans[i])/no2; + } else if (isign == -1) { + if ((mag2=SQR(ans[i-1])+SQR(ans[i])) == 0.0) + nrerror("Deconvolving at response zero in convlv"); + ans[i-1]=(fft[i-1]*(dum=ans[i-1])+fft[i]*ans[i])/mag2/no2; + ans[i]=(fft[i]*dum-fft[i-1]*ans[i])/mag2/no2; + } else nrerror("No meaning for isign in convlv"); + } + ans[2]=ans[n+1]; + realft(ans,n,-1); + free_vector(fft,1,n<<1); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/copy.c b/lib/nr/ansi/recipes/copy.c new file mode 100644 index 0000000..ea41575 --- /dev/null +++ b/lib/nr/ansi/recipes/copy.c @@ -0,0 +1,9 @@ + +void copy(double **aout, double **ain, int n) +{ + int i,j; + for (i=1;i<=n;i++) + for (j=1;j<=n;j++) + aout[j][i]=ain[j][i]; + +} diff --git a/lib/nr/ansi/recipes/correl.c b/lib/nr/ansi/recipes/correl.c new file mode 100644 index 0000000..aac855a --- /dev/null +++ b/lib/nr/ansi/recipes/correl.c @@ -0,0 +1,24 @@ + +#define NRANSI +#include "nrutil.h" + +void correl(float data1[], float data2[], unsigned long n, float ans[]) +{ + void realft(float data[], unsigned long n, int isign); + void twofft(float data1[], float data2[], float fft1[], float fft2[], + unsigned long n); + unsigned long no2,i; + float dum,*fft; + + fft=vector(1,n<<1); + twofft(data1,data2,fft,ans,n); + no2=n>>1; + for (i=2;i<=n+2;i+=2) { + ans[i-1]=(fft[i-1]*(dum=ans[i-1])+fft[i]*ans[i])/no2; + ans[i]=(fft[i]*dum-fft[i-1]*ans[i])/no2; + } + ans[2]=ans[n+1]; + realft(ans,n,-1); + free_vector(fft,1,n<<1); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/cosft1.c b/lib/nr/ansi/recipes/cosft1.c new file mode 100644 index 0000000..970ce9d --- /dev/null +++ b/lib/nr/ansi/recipes/cosft1.c @@ -0,0 +1,36 @@ + +#include +#define PI 3.141592653589793 + +void cosft1(float y[], int n) +{ + void realft(float data[], unsigned long n, int isign); + int j,n2; + float sum,y1,y2; + double theta,wi=0.0,wpi,wpr,wr=1.0,wtemp; + + theta=PI/n; + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + sum=0.5*(y[1]-y[n+1]); + y[1]=0.5*(y[1]+y[n+1]); + n2=n+2; + for (j=2;j<=(n>>1);j++) { + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + y1=0.5*(y[j]+y[n2-j]); + y2=(y[j]-y[n2-j]); + y[j]=y1-wi*y2; + y[n2-j]=y1+wi*y2; + sum += wr*y2; + } + realft(y,n,1); + y[n+1]=y[2]; + y[2]=sum; + for (j=4;j<=n;j+=2) { + sum += y[j]; + y[j]=sum; + } +} +#undef PI diff --git a/lib/nr/ansi/recipes/cosft2.c b/lib/nr/ansi/recipes/cosft2.c new file mode 100644 index 0000000..832a676 --- /dev/null +++ b/lib/nr/ansi/recipes/cosft2.c @@ -0,0 +1,64 @@ + +#include +#define PI 3.141592653589793 + +void cosft2(float y[], int n, int isign) +{ + void realft(float data[], unsigned long n, int isign); + int i; + float sum,sum1,y1,y2,ytemp; + double theta,wi=0.0,wi1,wpi,wpr,wr=1.0,wr1,wtemp; + + theta=0.5*PI/n; + wr1=cos(theta); + wi1=sin(theta); + wpr = -2.0*wi1*wi1; + wpi=sin(2.0*theta); + if (isign == 1) { + for (i=1;i<=n/2;i++) { + y1=0.5*(y[i]+y[n-i+1]); + y2=wi1*(y[i]-y[n-i+1]); + y[i]=y1+y2; + y[n-i+1]=y1-y2; + wr1=(wtemp=wr1)*wpr-wi1*wpi+wr1; + wi1=wi1*wpr+wtemp*wpi+wi1; + } + realft(y,n,1); + for (i=3;i<=n;i+=2) { + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + y1=y[i]*wr-y[i+1]*wi; + y2=y[i+1]*wr+y[i]*wi; + y[i]=y1; + y[i+1]=y2; + } + sum=0.5*y[2]; + for (i=n;i>=2;i-=2) { + sum1=sum; + sum += y[i]; + y[i]=sum1; + } + } else if (isign == -1) { + ytemp=y[n]; + for (i=n;i>=4;i-=2) y[i]=y[i-2]-y[i]; + y[2]=2.0*ytemp; + for (i=3;i<=n;i+=2) { + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + y1=y[i]*wr+y[i+1]*wi; + y2=y[i+1]*wr-y[i]*wi; + y[i]=y1; + y[i+1]=y2; + } + realft(y,n,-1); + for (i=1;i<=n/2;i++) { + y1=y[i]+y[n-i+1]; + y2=(0.5/wi1)*(y[i]-y[n-i+1]); + y[i]=0.5*(y1+y2); + y[n-i+1]=0.5*(y1-y2); + wr1=(wtemp=wr1)*wpr-wi1*wpi+wr1; + wi1=wi1*wpr+wtemp*wpi+wi1; + } + } +} +#undef PI diff --git a/lib/nr/ansi/recipes/covsrt.c b/lib/nr/ansi/recipes/covsrt.c new file mode 100644 index 0000000..32f3f70 --- /dev/null +++ b/lib/nr/ansi/recipes/covsrt.c @@ -0,0 +1,20 @@ + +#define SWAP(a,b) {swap=(a);(a)=(b);(b)=swap;} + +void covsrt(float **covar, int ma, int ia[], int mfit) +{ + int i,j,k; + float swap; + + for (i=mfit+1;i<=ma;i++) + for (j=1;j<=i;j++) covar[i][j]=covar[j][i]=0.0; + k=mfit; + for (j=ma;j>=1;j--) { + if (ia[j]) { + for (i=1;i<=ma;i++) SWAP(covar[i][k],covar[i][j]) + for (i=1;i<=ma;i++) SWAP(covar[k][i],covar[j][i]) + k--; + } + } +} +#undef SWAP diff --git a/lib/nr/ansi/recipes/crank.c b/lib/nr/ansi/recipes/crank.c new file mode 100644 index 0000000..164357c --- /dev/null +++ b/lib/nr/ansi/recipes/crank.c @@ -0,0 +1,22 @@ + +void crank(unsigned long n, float w[], float *s) +{ + unsigned long j=1,ji,jt; + float t,rank; + + *s=0.0; + while (j < n) { + if (w[j+1] != w[j]) { + w[j]=j; + ++j; + } else { + for (jt=j+1;jt<=n && w[jt]==w[j];jt++); + rank=0.5*(j+jt-1); + for (ji=j;ji<=(jt-1);ji++) w[ji]=rank; + t=jt-j; + *s += t*t*t-t; + j=jt; + } + } + if (j == n) w[n]=n; +} diff --git a/lib/nr/ansi/recipes/cyclic.c b/lib/nr/ansi/recipes/cyclic.c new file mode 100644 index 0000000..435f38c --- /dev/null +++ b/lib/nr/ansi/recipes/cyclic.c @@ -0,0 +1,33 @@ + +#define NRANSI +#include "nrutil.h" + +void cyclic(float a[], float b[], float c[], float alpha, float beta, + float r[], float x[], unsigned long n) +{ + void tridag(float a[], float b[], float c[], float r[], float u[], + unsigned long n); + unsigned long i; + float fact,gamma,*bb,*u,*z; + + if (n <= 2) nrerror("n too small in cyclic"); + bb=vector(1,n); + u=vector(1,n); + z=vector(1,n); + gamma = -b[1]; + bb[1]=b[1]-gamma; + bb[n]=b[n]-alpha*beta/gamma; + for (i=2;i> 1)+1; + if (isign >= 0) { + for (i=1,j=1;j<=n-3;j+=2,i++) { + wksp[i]=C0*a[j]+C1*a[j+1]+C2*a[j+2]+C3*a[j+3]; + wksp[i+nh] = C3*a[j]-C2*a[j+1]+C1*a[j+2]-C0*a[j+3]; + } + wksp[i]=C0*a[n-1]+C1*a[n]+C2*a[1]+C3*a[2]; + wksp[i+nh] = C3*a[n-1]-C2*a[n]+C1*a[1]-C0*a[2]; + } else { + wksp[1]=C2*a[nh]+C1*a[n]+C0*a[1]+C3*a[nh1]; + wksp[2] = C3*a[nh]-C0*a[n]+C1*a[1]-C2*a[nh1]; + for (i=1,j=3;i +#define NRANSI +#include "nrutil.h" +#define NMAX 6 +#define H 0.4 +#define A1 (2.0/3.0) +#define A2 0.4 +#define A3 (2.0/7.0) + +float dawson(float x) +{ + int i,n0; + float d1,d2,e1,e2,sum,x2,xp,xx,ans; + static float c[NMAX+1]; + static int init = 0; + + if (init == 0) { + init=1; + for (i=1;i<=NMAX;i++) c[i]=exp(-SQR((2.0*i-1.0)*H)); + } + if (fabs(x) < 0.2) { + x2=x*x; + ans=x*(1.0-A1*x2*(1.0-A2*x2*(1.0-A3*x2))); + } else { + xx=fabs(x); + n0=2*(int)(0.5*xx/H+0.5); + xp=xx-n0*H; + e1=exp(2.0*xp*H); + e2=e1*e1; + d1=n0+1; + d2=d1-2.0; + sum=0.0; + for (i=1;i<=NMAX;i++,d1+=2.0,d2-=2.0,e1*=e2) + sum += c[i]*(e1/d1+1.0/(d2*e1)); + ans=0.5641895835*SIGN(exp(-xp*xp),x)*sum; + } + return ans; +} +#undef NMAX +#undef H +#undef A1 +#undef A2 +#undef A3 +#undef NRANSI diff --git a/lib/nr/ansi/recipes/dbrent.c b/lib/nr/ansi/recipes/dbrent.c new file mode 100644 index 0000000..4875d47 --- /dev/null +++ b/lib/nr/ansi/recipes/dbrent.c @@ -0,0 +1,93 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define ITMAX 100 +#define ZEPS 1.0e-10 +#define MOV3(a,b,c, d,e,f) (a)=(d);(b)=(e);(c)=(f); + +float dbrent(float ax, float bx, float cx, float (*f)(float), + float (*df)(float), float tol, float *xmin) +{ + int iter,ok1,ok2; + float a,b,d,d1,d2,du,dv,dw,dx,e=0.0; + float fu,fv,fw,fx,olde,tol1,tol2,u,u1,u2,v,w,x,xm; + + a=(ax < cx ? ax : cx); + b=(ax > cx ? ax : cx); + x=w=v=bx; + fw=fv=fx=(*f)(x); + dw=dv=dx=(*df)(x); + for (iter=1;iter<=ITMAX;iter++) { + xm=0.5*(a+b); + tol1=tol*fabs(x)+ZEPS; + tol2=2.0*tol1; + if (fabs(x-xm) <= (tol2-0.5*(b-a))) { + *xmin=x; + return fx; + } + if (fabs(e) > tol1) { + d1=2.0*(b-a); + d2=d1; + if (dw != dx) d1=(w-x)*dx/(dx-dw); + if (dv != dx) d2=(v-x)*dx/(dx-dv); + u1=x+d1; + u2=x+d2; + ok1 = (a-u1)*(u1-b) > 0.0 && dx*d1 <= 0.0; + ok2 = (a-u2)*(u2-b) > 0.0 && dx*d2 <= 0.0; + olde=e; + e=d; + if (ok1 || ok2) { + if (ok1 && ok2) + d=(fabs(d1) < fabs(d2) ? d1 : d2); + else if (ok1) + d=d1; + else + d=d2; + if (fabs(d) <= fabs(0.5*olde)) { + u=x+d; + if (u-a < tol2 || b-u < tol2) + d=SIGN(tol1,xm-x); + } else { + d=0.5*(e=(dx >= 0.0 ? a-x : b-x)); + } + } else { + d=0.5*(e=(dx >= 0.0 ? a-x : b-x)); + } + } else { + d=0.5*(e=(dx >= 0.0 ? a-x : b-x)); + } + if (fabs(d) >= tol1) { + u=x+d; + fu=(*f)(u); + } else { + u=x+SIGN(tol1,d); + fu=(*f)(u); + if (fu > fx) { + *xmin=x; + return fx; + } + } + du=(*df)(u); + if (fu <= fx) { + if (u >= x) a=x; else b=x; + MOV3(v,fv,dv, w,fw,dw) + MOV3(w,fw,dw, x,fx,dx) + MOV3(x,fx,dx, u,fu,du) + } else { + if (u < x) a=u; else b=u; + if (fu <= fw || w == x) { + MOV3(v,fv,dv, w,fw,dw) + MOV3(w,fw,dw, u,fu,du) + } else if (fu < fv || v == x || v == w) { + MOV3(v,fv,dv, u,fu,du) + } + } + } + nrerror("Too many iterations in routine dbrent"); + return 0.0; +} +#undef ITMAX +#undef ZEPS +#undef MOV3 +#undef NRANSI diff --git a/lib/nr/ansi/recipes/ddpoly.c b/lib/nr/ansi/recipes/ddpoly.c new file mode 100644 index 0000000..c8fdab2 --- /dev/null +++ b/lib/nr/ansi/recipes/ddpoly.c @@ -0,0 +1,19 @@ + +void ddpoly(float c[], int nc, float x, float pd[], int nd) +{ + int nnd,j,i; + float cnst=1.0; + + pd[0]=c[nc]; + for (j=1;j<=nd;j++) pd[j]=0.0; + for (i=nc-1;i>=0;i--) { + nnd=(nd < (nc-i) ? nd : nc-i); + for (j=nnd;j>=1;j--) + pd[j]=pd[j]*x+pd[j-1]; + pd[0]=pd[0]*x+c[i]; + } + for (i=2;i<=nd;i++) { + cnst *= i; + pd[i] *= cnst; + } +} diff --git a/lib/nr/ansi/recipes/decchk.c b/lib/nr/ansi/recipes/decchk.c new file mode 100644 index 0000000..84dbc2a --- /dev/null +++ b/lib/nr/ansi/recipes/decchk.c @@ -0,0 +1,23 @@ + +int decchk(char string[], int n, char *ch) +{ + char c; + int j,k=0,m=0; + static int ip[10][8]={0,1,5,8,9,4,2,7,1,5, 8,9,4,2,7,0,2,7,0,1, + 5,8,9,4,3,6,3,6,3,6, 3,6,4,2,7,0,1,5,8,9, 5,8,9,4,2,7,0,1,6,3, + 6,3,6,3,6,3,7,0,1,5, 8,9,4,2,8,9,4,2,7,0, 1,5,9,4,2,7,0,1,5,8}; + static int ij[10][10]={0,1,2,3,4,5,6,7,8,9, 1,2,3,4,0,6,7,8,9,5, + 2,3,4,0,1,7,8,9,5,6, 3,4,0,1,2,8,9,5,6,7, 4,0,1,2,3,9,5,6,7,8, + 5,9,8,7,6,0,4,3,2,1, 6,5,9,8,7,1,0,4,3,2, 7,6,5,9,8,2,1,0,4,3, + 8,7,6,5,9,3,2,1,0,4, 9,8,7,6,5,4,3,2,1,0}; + + for (j=0;j= 48 && c <= 57) + k=ij[k][ip[(c+2) % 10][7 & m++]]; + } + for (j=0;j<=9;j++) + if (!ij[k][ip[j][m & 7]]) break; + *ch=j+48; + return k==0; +} diff --git a/lib/nr/ansi/recipes/df1dim.c b/lib/nr/ansi/recipes/df1dim.c new file mode 100644 index 0000000..f185ad2 --- /dev/null +++ b/lib/nr/ansi/recipes/df1dim.c @@ -0,0 +1,24 @@ + +#define NRANSI +#include "nrutil.h" + +extern int ncom; +extern float *pcom,*xicom,(*nrfunc)(float []); +extern void (*nrdfun)(float [], float []); + +float df1dim(float x) +{ + int j; + float df1=0.0; + float *xt,*df; + + xt=vector(1,ncom); + df=vector(1,ncom); + for (j=1;j<=ncom;j++) xt[j]=pcom[j]+x*xicom[j]; + (*nrdfun)(xt,df); + for (j=1;j<=ncom;j++) df1 += df[j]*xicom[j]; + free_vector(df,1,ncom); + free_vector(xt,1,ncom); + return df1; +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/dfour1.c b/lib/nr/ansi/recipes/dfour1.c new file mode 100644 index 0000000..b2b103f --- /dev/null +++ b/lib/nr/ansi/recipes/dfour1.c @@ -0,0 +1,50 @@ + +#include +#define SWAP(a,b) tempr=(a);(a)=(b);(b)=tempr + +void dfour1(double data[], unsigned long nn, int isign) +{ + unsigned long n,mmax,m,j,istep,i; + double wtemp,wr,wpr,wpi,wi,theta; + double tempr,tempi; + + n=nn << 1; + j=1; + for (i=1;i i) { + SWAP(data[j],data[i]); + SWAP(data[j+1],data[i+1]); + } + m=n >> 1; + while (m >= 2 && j > m) { + j -= m; + m >>= 1; + } + j += m; + } + mmax=2; + while (n > mmax) { + istep=mmax << 1; + theta=isign*(6.28318530717959/mmax); + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0; + wi=0.0; + for (m=1;m +#define NRANSI +#include "nrutil.h" +#define ITMAX 200 +#define EPS 3.0e-8 +#define TOLX (4*EPS) +#define STPMX 100.0 + +#define FREEALL free_vector(xi,1,n);free_vector(pnew,1,n); \ +free_matrix(hessin,1,n,1,n);free_vector(hdg,1,n);free_vector(g,1,n); \ +free_vector(dg,1,n); + +void dfpmin(float p[], int n, float gtol, int *iter, float *fret, + float(*func)(float []), void (*dfunc)(float [], float [])) +{ + void lnsrch(int n, float xold[], float fold, float g[], float p[], float x[], + float *f, float stpmax, int *check, float (*func)(float [])); + int check,i,its,j; + float den,fac,fad,fae,fp,stpmax,sum=0.0,sumdg,sumxi,temp,test; + float *dg,*g,*hdg,**hessin,*pnew,*xi; + + dg=vector(1,n); + g=vector(1,n); + hdg=vector(1,n); + hessin=matrix(1,n,1,n); + pnew=vector(1,n); + xi=vector(1,n); + fp=(*func)(p); + (*dfunc)(p,g); + for (i=1;i<=n;i++) { + for (j=1;j<=n;j++) hessin[i][j]=0.0; + hessin[i][i]=1.0; + xi[i] = -g[i]; + sum += p[i]*p[i]; + } + stpmax=STPMX*FMAX(sqrt(sum),(float)n); + for (its=1;its<=ITMAX;its++) { + *iter=its; + lnsrch(n,p,fp,g,xi,pnew,fret,stpmax,&check,func); + fp = *fret; + for (i=1;i<=n;i++) { + xi[i]=pnew[i]-p[i]; + p[i]=pnew[i]; + } + test=0.0; + for (i=1;i<=n;i++) { + temp=fabs(xi[i])/FMAX(fabs(p[i]),1.0); + if (temp > test) test=temp; + } + if (test < TOLX) { + FREEALL + return; + } + for (i=1;i<=n;i++) dg[i]=g[i]; + (*dfunc)(p,g); + test=0.0; + den=FMAX(*fret,1.0); + for (i=1;i<=n;i++) { + temp=fabs(g[i])*FMAX(fabs(p[i]),1.0)/den; + if (temp > test) test=temp; + } + if (test < gtol) { + FREEALL + return; + } + for (i=1;i<=n;i++) dg[i]=g[i]-dg[i]; + for (i=1;i<=n;i++) { + hdg[i]=0.0; + for (j=1;j<=n;j++) hdg[i] += hessin[i][j]*dg[j]; + } + fac=fae=sumdg=sumxi=0.0; + for (i=1;i<=n;i++) { + fac += dg[i]*xi[i]; + fae += dg[i]*hdg[i]; + sumdg += SQR(dg[i]); + sumxi += SQR(xi[i]); + } + if (fac > sqrt(EPS*sumdg*sumxi)) { + fac=1.0/fac; + fad=1.0/fae; + for (i=1;i<=n;i++) dg[i]=fac*xi[i]-fad*hdg[i]; + for (i=1;i<=n;i++) { + for (j=i;j<=n;j++) { + hessin[i][j] += fac*xi[i]*xi[j] + -fad*hdg[i]*hdg[j]+fae*dg[i]*dg[j]; + hessin[j][i]=hessin[i][j]; + } + } + } + for (i=1;i<=n;i++) { + xi[i]=0.0; + for (j=1;j<=n;j++) xi[i] -= hessin[i][j]*g[j]; + } + } + nrerror("too many iterations in dfpmin"); + FREEALL +} +#undef ITMAX +#undef EPS +#undef TOLX +#undef STPMX +#undef FREEALL +#undef NRANSI diff --git a/lib/nr/ansi/recipes/dfridr.c b/lib/nr/ansi/recipes/dfridr.c new file mode 100644 index 0000000..0fc67b9 --- /dev/null +++ b/lib/nr/ansi/recipes/dfridr.c @@ -0,0 +1,44 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define CON 1.4 +#define CON2 (CON*CON) +#define BIG 1.0e30 +#define NTAB 10 +#define SAFE 2.0 + +float dfridr(float (*func)(float), float x, float h, float *err) +{ + int i,j; + float errt,fac,hh,**a,ans; + + if (h == 0.0) nrerror("h must be nonzero in dfridr."); + a=matrix(1,NTAB,1,NTAB); + hh=h; + a[1][1]=((*func)(x+hh)-(*func)(x-hh))/(2.0*hh); + *err=BIG; + for (i=2;i<=NTAB;i++) { + hh /= CON; + a[1][i]=((*func)(x+hh)-(*func)(x-hh))/(2.0*hh); + fac=CON2; + for (j=2;j<=i;j++) { + a[j][i]=(a[j-1][i]*fac-a[j-1][i-1])/(fac-1.0); + fac=CON2*fac; + errt=FMAX(fabs(a[j][i]-a[j-1][i]),fabs(a[j][i]-a[j-1][i-1])); + if (errt <= *err) { + *err=errt; + ans=a[j][i]; + } + } + if (fabs(a[i][i]-a[i-1][i-1]) >= SAFE*(*err)) break; + } + free_matrix(a,1,NTAB,1,NTAB); + return ans; +} +#undef CON +#undef CON2 +#undef BIG +#undef NTAB +#undef SAFE +#undef NRANSI diff --git a/lib/nr/ansi/recipes/dftcor.c b/lib/nr/ansi/recipes/dftcor.c new file mode 100644 index 0000000..0a4a0bf --- /dev/null +++ b/lib/nr/ansi/recipes/dftcor.c @@ -0,0 +1,58 @@ + +#include + +void dftcor(float w, float delta, float a, float b, float endpts[], + float *corre, float *corim, float *corfac) +{ + void nrerror(char error_text[]); + float a0i,a0r,a1i,a1r,a2i,a2r,a3i,a3r,arg,c,cl,cr,s,sl,sr,t; + float t2,t4,t6; + double cth,ctth,spth2,sth,sth4i,stth,th,th2,th4,tmth2,tth4i; + + th=w*delta; + if (a >= b || th < 0.0e0 || th > 3.1416e0) nrerror("bad arguments to dftcor"); + if (fabs(th) < 5.0e-2) { + t=th; + t2=t*t; + t4=t2*t2; + t6=t4*t2; + *corfac=1.0-(11.0/720.0)*t4+(23.0/15120.0)*t6; + a0r=(-2.0/3.0)+t2/45.0+(103.0/15120.0)*t4-(169.0/226800.0)*t6; + a1r=(7.0/24.0)-(7.0/180.0)*t2+(5.0/3456.0)*t4-(7.0/259200.0)*t6; + a2r=(-1.0/6.0)+t2/45.0-(5.0/6048.0)*t4+t6/64800.0; + a3r=(1.0/24.0)-t2/180.0+(5.0/24192.0)*t4-t6/259200.0; + a0i=t*(2.0/45.0+(2.0/105.0)*t2-(8.0/2835.0)*t4+(86.0/467775.0)*t6); + a1i=t*(7.0/72.0-t2/168.0+(11.0/72576.0)*t4-(13.0/5987520.0)*t6); + a2i=t*(-7.0/90.0+t2/210.0-(11.0/90720.0)*t4+(13.0/7484400.0)*t6); + a3i=t*(7.0/360.0-t2/840.0+(11.0/362880.0)*t4-(13.0/29937600.0)*t6); + } else { + cth=cos(th); + sth=sin(th); + ctth=cth*cth-sth*sth; + stth=2.0e0*sth*cth; + th2=th*th; + th4=th2*th2; + tmth2=3.0e0-th2; + spth2=6.0e0+th2; + sth4i=1.0/(6.0e0*th4); + tth4i=2.0e0*sth4i; + *corfac=tth4i*spth2*(3.0e0-4.0e0*cth+ctth); + a0r=sth4i*(-42.0e0+5.0e0*th2+spth2*(8.0e0*cth-ctth)); + a0i=sth4i*(th*(-12.0e0+6.0e0*th2)+spth2*stth); + a1r=sth4i*(14.0e0*tmth2-7.0e0*spth2*cth); + a1i=sth4i*(30.0e0*th-5.0e0*spth2*sth); + a2r=tth4i*(-4.0e0*tmth2+2.0e0*spth2*cth); + a2i=tth4i*(-12.0e0*th+2.0e0*spth2*sth); + a3r=sth4i*(2.0e0*tmth2-spth2*cth); + a3i=sth4i*(6.0e0*th-spth2*sth); + } + cl=a0r*endpts[1]+a1r*endpts[2]+a2r*endpts[3]+a3r*endpts[4]; + sl=a0i*endpts[1]+a1i*endpts[2]+a2i*endpts[3]+a3i*endpts[4]; + cr=a0r*endpts[8]+a1r*endpts[7]+a2r*endpts[6]+a3r*endpts[5]; + sr = -a0i*endpts[8]-a1i*endpts[7]-a2i*endpts[6]-a3i*endpts[5]; + arg=w*(b-a); + c=cos(arg); + s=sin(arg); + *corre=cl+c*cr-s*sr; + *corim=sl+s*cr+c*sr; +} diff --git a/lib/nr/ansi/recipes/dftint.c b/lib/nr/ansi/recipes/dftint.c new file mode 100644 index 0000000..2641ab3 --- /dev/null +++ b/lib/nr/ansi/recipes/dftint.c @@ -0,0 +1,70 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define M 64 +#define NDFT 1024 +#define MPOL 6 +#define TWOPI (2.0*3.14159265) + +void dftint(float (*func)(float), float a, float b, float w, float *cosint, + float *sinint) +{ + void dftcor(float w, float delta, float a, float b, float endpts[], + float *corre, float *corim, float *corfac); + void polint(float xa[], float ya[], int n, float x, float *y, float *dy); + void realft(float data[], unsigned long n, int isign); + static int init=0; + int j,nn; + static float aold = -1.e30,bold = -1.e30,delta,(*funcold)(float); + static float data[NDFT+1],endpts[9]; + float c,cdft,cerr,corfac,corim,corre,en,s; + float sdft,serr,*cpol,*spol,*xpol; + + cpol=vector(1,MPOL); + spol=vector(1,MPOL); + xpol=vector(1,MPOL); + if (init != 1 || a != aold || b != bold || func != funcold) { + init=1; + aold=a; + bold=b; + funcold=func; + delta=(b-a)/M; + for (j=1;j<=M+1;j++) + data[j]=(*func)(a+(j-1)*delta); + for (j=M+2;j<=NDFT;j++) + data[j]=0.0; + for (j=1;j<=4;j++) { + endpts[j]=data[j]; + endpts[j+4]=data[M-3+j]; + } + realft(data,NDFT,1); + data[2]=0.0; + } + en=w*delta*NDFT/TWOPI+1.0; + nn=IMIN(IMAX((int)(en-0.5*MPOL+1.0),1),NDFT/2-MPOL+1); + for (j=1;j<=MPOL;j++,nn++) { + cpol[j]=data[2*nn-1]; + spol[j]=data[2*nn]; + xpol[j]=nn; + } + polint(xpol,cpol,MPOL,en,&cdft,&cerr); + polint(xpol,spol,MPOL,en,&sdft,&serr); + dftcor(w,delta,a,b,endpts,&corre,&corim,&corfac); + cdft *= corfac; + sdft *= corfac; + cdft += corre; + sdft += corim; + c=delta*cos(w*a); + s=delta*sin(w*a); + *cosint=c*cdft-s*sdft; + *sinint=s*cdft+c*sdft; + free_vector(cpol,1,MPOL); + free_vector(spol,1,MPOL); + free_vector(xpol,1,MPOL); +} +#undef M +#undef NDFT +#undef MPOL +#undef TWOPI +#undef NRANSI diff --git a/lib/nr/ansi/recipes/difeq.c b/lib/nr/ansi/recipes/difeq.c new file mode 100644 index 0000000..7498c8b --- /dev/null +++ b/lib/nr/ansi/recipes/difeq.c @@ -0,0 +1,59 @@ + +extern int mm,n,mpt; +extern float h,c2,anorm,x[]; + +void difeq(int k, int k1, int k2, int jsf, int is1, int isf, int indexv[], + int ne, float **s, float **y) +{ + float temp,temp1,temp2; + + if (k == k1) { + if (n+mm & 1) { + s[3][3+indexv[1]]=1.0; + s[3][3+indexv[2]]=0.0; + s[3][3+indexv[3]]=0.0; + s[3][jsf]=y[1][1]; + } else { + s[3][3+indexv[1]]=0.0; + s[3][3+indexv[2]]=1.0; + s[3][3+indexv[3]]=0.0; + s[3][jsf]=y[2][1]; + } + } else if (k > k2) { + s[1][3+indexv[1]] = -(y[3][mpt]-c2)/(2.0*(mm+1.0)); + s[1][3+indexv[2]]=1.0; + s[1][3+indexv[3]] = -y[1][mpt]/(2.0*(mm+1.0)); + s[1][jsf]=y[2][mpt]-(y[3][mpt]-c2)*y[1][mpt]/(2.0*(mm+1.0)); + s[2][3+indexv[1]]=1.0; + s[2][3+indexv[2]]=0.0; + s[2][3+indexv[3]]=0.0; + s[2][jsf]=y[1][mpt]-anorm; + } else { + s[1][indexv[1]] = -1.0; + s[1][indexv[2]] = -0.5*h; + s[1][indexv[3]]=0.0; + s[1][3+indexv[1]]=1.0; + s[1][3+indexv[2]] = -0.5*h; + s[1][3+indexv[3]]=0.0; + temp1=x[k]+x[k-1]; + temp=h/(1.0-temp1*temp1*0.25); + temp2=0.5*(y[3][k]+y[3][k-1])-c2*0.25*temp1*temp1; + s[2][indexv[1]]=temp*temp2*0.5; + s[2][indexv[2]] = -1.0-0.5*temp*(mm+1.0)*temp1; + s[2][indexv[3]]=0.25*temp*(y[1][k]+y[1][k-1]); + s[2][3+indexv[1]]=s[2][indexv[1]]; + s[2][3+indexv[2]]=2.0+s[2][indexv[2]]; + s[2][3+indexv[3]]=s[2][indexv[3]]; + s[3][indexv[1]]=0.0; + s[3][indexv[2]]=0.0; + s[3][indexv[3]] = -1.0; + s[3][3+indexv[1]]=0.0; + s[3][3+indexv[2]]=0.0; + s[3][3+indexv[3]]=1.0; + s[1][jsf]=y[1][k]-y[1][k-1]-0.5*h*(y[2][k]+y[2][k-1]); + s[2][jsf]=y[2][k]-y[2][k-1]-temp*((x[k]+x[k-1]) + *0.5*(mm+1.0)*(y[2][k]+y[2][k-1])-temp2 + *0.5*(y[1][k]+y[1][k-1])); + s[3][jsf]=y[3][k]-y[3][k-1]; + } +} diff --git a/lib/nr/ansi/recipes/dlinmin.c b/lib/nr/ansi/recipes/dlinmin.c new file mode 100644 index 0000000..a510565 --- /dev/null +++ b/lib/nr/ansi/recipes/dlinmin.c @@ -0,0 +1,43 @@ + +#define NRANSI +#include "nrutil.h" +#define TOL 2.0e-4 + +int ncom; +float *pcom,*xicom,(*nrfunc)(float []); +void (*nrdfun)(float [], float []); + +void dlinmin(float p[], float xi[], int n, float *fret, float (*func)(float []), + void (*dfunc)(float [], float [])) +{ + float dbrent(float ax, float bx, float cx, + float (*f)(float), float (*df)(float), float tol, float *xmin); + float f1dim(float x); + float df1dim(float x); + void mnbrak(float *ax, float *bx, float *cx, float *fa, float *fb, + float *fc, float (*func)(float)); + int j; + float xx,xmin,fx,fb,fa,bx,ax; + + ncom=n; + pcom=vector(1,n); + xicom=vector(1,n); + nrfunc=func; + nrdfun=dfunc; + for (j=1;j<=n;j++) { + pcom[j]=p[j]; + xicom[j]=xi[j]; + } + ax=0.0; + xx=1.0; + mnbrak(&ax,&xx,&bx,&fa,&fx,&fb,f1dim); + *fret=dbrent(ax,xx,bx,f1dim,df1dim,TOL,&xmin); + for (j=1;j<=n;j++) { + xi[j] *= xmin; + p[j] += xi[j]; + } + free_vector(xicom,1,n); + free_vector(pcom,1,n); +} +#undef TOL +#undef NRANSI diff --git a/lib/nr/ansi/recipes/dpythag.c b/lib/nr/ansi/recipes/dpythag.c new file mode 100644 index 0000000..70eb6c5 --- /dev/null +++ b/lib/nr/ansi/recipes/dpythag.c @@ -0,0 +1,14 @@ + +#include +#define NRANSI +#include "nrutil.h" + +double dpythag(double a, double b) +{ + double absa,absb; + absa=fabs(a); + absb=fabs(b); + if (absa > absb) return absa*sqrt(1.0+DSQR(absb/absa)); + else return (absb == 0.0 ? 0.0 : absb*sqrt(1.0+DSQR(absa/absb))); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/drealft.c b/lib/nr/ansi/recipes/drealft.c new file mode 100644 index 0000000..cb7bd33 --- /dev/null +++ b/lib/nr/ansi/recipes/drealft.c @@ -0,0 +1,46 @@ + +#include + +void drealft(double data[], unsigned long n, int isign) +{ + void dfour1(double data[], unsigned long nn, int isign); + unsigned long i,i1,i2,i3,i4,np3; + double c1=0.5,c2,h1r,h1i,h2r,h2i; + double wr,wi,wpr,wpi,wtemp,theta; + + theta=3.141592653589793/(double) (n>>1); + if (isign == 1) { + c2 = -0.5; + dfour1(data,n>>1,1); + } else { + c2=0.5; + theta = -theta; + } + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0+wpr; + wi=wpi; + np3=n+3; + for (i=2;i<=(n>>2);i++) { + i4=1+(i3=np3-(i2=1+(i1=i+i-1))); + h1r=c1*(data[i1]+data[i3]); + h1i=c1*(data[i2]-data[i4]); + h2r = -c2*(data[i2]+data[i4]); + h2i=c2*(data[i1]-data[i3]); + data[i1]=h1r+wr*h2r-wi*h2i; + data[i2]=h1i+wr*h2i+wi*h2r; + data[i3]=h1r-wr*h2r+wi*h2i; + data[i4] = -h1i+wr*h2i+wi*h2r; + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + } + if (isign == 1) { + data[1] = (h1r=data[1])+data[2]; + data[2] = h1r-data[2]; + } else { + data[1]=c1*((h1r=data[1])+data[2]); + data[2]=c1*(h1r-data[2]); + dfour1(data,n>>1,-1); + } +} diff --git a/lib/nr/ansi/recipes/dsprsax.c b/lib/nr/ansi/recipes/dsprsax.c new file mode 100644 index 0000000..4c7af75 --- /dev/null +++ b/lib/nr/ansi/recipes/dsprsax.c @@ -0,0 +1,12 @@ + +void dsprsax(double sa[], unsigned long ija[], double x[], double b[], unsigned long n) +{ + void nrerror(char error_text[]); + unsigned long i,k; + + if (ija[1] != n+2) nrerror("dsprsax: mismatched vector and matrix"); + for (i=1;i<=n;i++) { + b[i]=sa[i]*x[i]; + for (k=ija[i];k<=ija[i+1]-1;k++) b[i] += sa[k]*x[ija[k]]; + } +} diff --git a/lib/nr/ansi/recipes/dsprstx.c b/lib/nr/ansi/recipes/dsprstx.c new file mode 100644 index 0000000..db27378 --- /dev/null +++ b/lib/nr/ansi/recipes/dsprstx.c @@ -0,0 +1,14 @@ + +void dsprstx(double sa[], unsigned long ija[], double x[], double b[], unsigned long n) +{ + void nrerror(char error_text[]); + unsigned long i,j,k; + if (ija[1] != n+2) nrerror("mismatched vector and matrix in dsprstx"); + for (i=1;i<=n;i++) b[i]=sa[i]*x[i]; + for (i=1;i<=n;i++) { + for (k=ija[i];k<=ija[i+1]-1;k++) { + j=ija[k]; + b[j] += sa[k]*x[i]; + } + } +} diff --git a/lib/nr/ansi/recipes/dsvbksb.c b/lib/nr/ansi/recipes/dsvbksb.c new file mode 100644 index 0000000..2865eeb --- /dev/null +++ b/lib/nr/ansi/recipes/dsvbksb.c @@ -0,0 +1,26 @@ + +#define NRANSI +#include "nrutil.h" + +void dsvbksb(double **u, double w[], double **v, int m, int n, double b[], double x[]) +{ + int jj,j,i; + double s,*tmp; + + tmp=dvector(1,n); + for (j=1;j<=n;j++) { + s=0.0; + if (w[j]) { + for (i=1;i<=m;i++) s += u[i][j]*b[i]; + s /= w[j]; + } + tmp[j]=s; + } + for (j=1;j<=n;j++) { + s=0.0; + for (jj=1;jj<=n;jj++) s += v[j][jj]*tmp[jj]; + x[j]=s; + } + free_dvector(tmp,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/dsvdcmp.c b/lib/nr/ansi/recipes/dsvdcmp.c new file mode 100644 index 0000000..1634b58 --- /dev/null +++ b/lib/nr/ansi/recipes/dsvdcmp.c @@ -0,0 +1,183 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void dsvdcmp(double **a, int m, int n, double w[], double **v) +{ + double dpythag(double a, double b); + int flag,i,its,j,jj,k,l,nm; + double anorm,c,f,g,h,s,scale,x,y,z,*rv1; + + rv1=dvector(1,n); + g=scale=anorm=0.0; + for (i=1;i<=n;i++) { + l=i+1; + rv1[i]=scale*g; + g=s=scale=0.0; + if (i <= m) { + for (k=i;k<=m;k++) scale += fabs(a[k][i]); + if (scale) { + for (k=i;k<=m;k++) { + a[k][i] /= scale; + s += a[k][i]*a[k][i]; + } + f=a[i][i]; + g = -SIGN(sqrt(s),f); + h=f*g-s; + a[i][i]=f-g; + for (j=l;j<=n;j++) { + for (s=0.0,k=i;k<=m;k++) s += a[k][i]*a[k][j]; + f=s/h; + for (k=i;k<=m;k++) a[k][j] += f*a[k][i]; + } + for (k=i;k<=m;k++) a[k][i] *= scale; + } + } + w[i]=scale *g; + g=s=scale=0.0; + if (i <= m && i != n) { + for (k=l;k<=n;k++) scale += fabs(a[i][k]); + if (scale) { + for (k=l;k<=n;k++) { + a[i][k] /= scale; + s += a[i][k]*a[i][k]; + } + f=a[i][l]; + g = -SIGN(sqrt(s),f); + h=f*g-s; + a[i][l]=f-g; + for (k=l;k<=n;k++) rv1[k]=a[i][k]/h; + for (j=l;j<=m;j++) { + for (s=0.0,k=l;k<=n;k++) s += a[j][k]*a[i][k]; + for (k=l;k<=n;k++) a[j][k] += s*rv1[k]; + } + for (k=l;k<=n;k++) a[i][k] *= scale; + } + } + anorm=DMAX(anorm,(fabs(w[i])+fabs(rv1[i]))); + } + for (i=n;i>=1;i--) { + if (i < n) { + if (g) { + for (j=l;j<=n;j++) v[j][i]=(a[i][j]/a[i][l])/g; + for (j=l;j<=n;j++) { + for (s=0.0,k=l;k<=n;k++) s += a[i][k]*v[k][j]; + for (k=l;k<=n;k++) v[k][j] += s*v[k][i]; + } + } + for (j=l;j<=n;j++) v[i][j]=v[j][i]=0.0; + } + v[i][i]=1.0; + g=rv1[i]; + l=i; + } + for (i=IMIN(m,n);i>=1;i--) { + l=i+1; + g=w[i]; + for (j=l;j<=n;j++) a[i][j]=0.0; + if (g) { + g=1.0/g; + for (j=l;j<=n;j++) { + for (s=0.0,k=l;k<=m;k++) s += a[k][i]*a[k][j]; + f=(s/a[i][i])*g; + for (k=i;k<=m;k++) a[k][j] += f*a[k][i]; + } + for (j=i;j<=m;j++) a[j][i] *= g; + } else for (j=i;j<=m;j++) a[j][i]=0.0; + ++a[i][i]; + } + for (k=n;k>=1;k--) { + for (its=1;its<=30;its++) { + flag=1; + for (l=k;l>=1;l--) { + nm=l-1; + if ((double)(fabs(rv1[l])+anorm) == anorm) { + flag=0; + break; + } + if ((double)(fabs(w[nm])+anorm) == anorm) break; + } + if (flag) { + c=0.0; + s=1.0; + for (i=l;i<=k;i++) { + f=s*rv1[i]; + rv1[i]=c*rv1[i]; + if ((double)(fabs(f)+anorm) == anorm) break; + g=w[i]; + h=dpythag(f,g); + w[i]=h; + h=1.0/h; + c=g*h; + s = -f*h; + for (j=1;j<=m;j++) { + y=a[j][nm]; + z=a[j][i]; + a[j][nm]=y*c+z*s; + a[j][i]=z*c-y*s; + } + } + } + z=w[k]; + if (l == k) { + if (z < 0.0) { + w[k] = -z; + for (j=1;j<=n;j++) v[j][k] = -v[j][k]; + } + break; + } + if (its == 30) nrerror("no convergence in 30 dsvdcmp iterations"); + x=w[l]; + nm=k-1; + y=w[nm]; + g=rv1[nm]; + h=rv1[k]; + f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y); + g=dpythag(f,1.0); + f=((x-z)*(x+z)+h*((y/(f+SIGN(g,f)))-h))/x; + c=s=1.0; + for (j=l;j<=nm;j++) { + i=j+1; + g=rv1[i]; + y=w[i]; + h=s*g; + g=c*g; + z=dpythag(f,h); + rv1[j]=z; + c=f/z; + s=h/z; + f=x*c+g*s; + g = g*c-x*s; + h=y*s; + y *= c; + for (jj=1;jj<=n;jj++) { + x=v[jj][j]; + z=v[jj][i]; + v[jj][j]=x*c+z*s; + v[jj][i]=z*c-x*s; + } + z=dpythag(f,h); + w[j]=z; + if (z) { + z=1.0/z; + c=f*z; + s=h*z; + } + f=c*g+s*y; + x=c*y-s*g; + for (jj=1;jj<=m;jj++) { + y=a[jj][j]; + z=a[jj][i]; + a[jj][j]=y*c+z*s; + a[jj][i]=z*c-y*s; + } + } + rv1[l]=0.0; + rv1[k]=f; + w[k]=x; + } + } + free_dvector(rv1,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/eclass.c b/lib/nr/ansi/recipes/eclass.c new file mode 100644 index 0000000..89d2098 --- /dev/null +++ b/lib/nr/ansi/recipes/eclass.c @@ -0,0 +1,16 @@ + +void eclass(int nf[], int n, int lista[], int listb[], int m) +{ + int l,k,j; + + for (k=1;k<=n;k++) nf[k]=k; + for (l=1;l<=m;l++) { + j=lista[l]; + while (nf[j] != j) j=nf[j]; + k=listb[l]; + while (nf[k] != k) k=nf[k]; + if (j != k) nf[j]=k; + } + for (j=1;j<=n;j++) + while (nf[j] != nf[nf[j]]) nf[j]=nf[nf[j]]; +} diff --git a/lib/nr/ansi/recipes/eclazz.c b/lib/nr/ansi/recipes/eclazz.c new file mode 100644 index 0000000..8591ab3 --- /dev/null +++ b/lib/nr/ansi/recipes/eclazz.c @@ -0,0 +1,15 @@ + +void eclazz(int nf[], int n, int (*equiv)(int, int)) +{ + int kk,jj; + + nf[1]=1; + for (jj=2;jj<=n;jj++) { + nf[jj]=jj; + for (kk=1;kk<=(jj-1);kk++) { + nf[kk]=nf[nf[kk]]; + if ((*equiv)(jj,kk)) nf[nf[nf[kk]]]=jj; + } + } + for (jj=1;jj<=n;jj++) nf[jj]=nf[nf[jj]]; +} diff --git a/lib/nr/ansi/recipes/ei.c b/lib/nr/ansi/recipes/ei.c new file mode 100644 index 0000000..e7ccce4 --- /dev/null +++ b/lib/nr/ansi/recipes/ei.c @@ -0,0 +1,46 @@ + +#include +#define EULER 0.57721566 +#define MAXIT 100 +#define FPMIN 1.0e-30 +#define EPS 6.0e-8 + +float ei(float x) +{ + void nrerror(char error_text[]); + int k; + float fact,prev,sum,term; + + if (x <= 0.0) nrerror("Bad argument in ei"); + if (x < FPMIN) return log(x)+EULER; + if (x <= -log(EPS)) { + sum=0.0; + fact=1.0; + for (k=1;k<=MAXIT;k++) { + fact *= x/k; + term=fact/k; + sum += term; + if (term < EPS*sum) break; + } + if (k > MAXIT) nrerror("Series failed in ei"); + return sum+log(x)+EULER; + } else { + sum=0.0; + term=1.0; + for (k=1;k<=MAXIT;k++) { + prev=term; + term *= k/x; + if (term < EPS) break; + if (term < prev) sum += term; + else { + sum -= prev; + break; + } + } + return exp(x)*(1.0+sum)/x; + } +} +#undef EPS +#undef EULER +#undef MAXIT +#undef FPMIN diff --git a/lib/nr/ansi/recipes/eigsrt.c b/lib/nr/ansi/recipes/eigsrt.c new file mode 100644 index 0000000..b9c995e --- /dev/null +++ b/lib/nr/ansi/recipes/eigsrt.c @@ -0,0 +1,21 @@ + +void eigsrt(float d[], float **v, int n) +{ + int k,j,i; + float p; + + for (i=1;i= p) p=d[k=j]; + if (k != i) { + d[k]=d[i]; + d[i]=p; + for (j=1;j<=n;j++) { + p=v[j][i]; + v[j][i]=v[j][k]; + v[j][k]=p; + } + } + } +} diff --git a/lib/nr/ansi/recipes/elle.c b/lib/nr/ansi/recipes/elle.c new file mode 100644 index 0000000..9298084 --- /dev/null +++ b/lib/nr/ansi/recipes/elle.c @@ -0,0 +1,17 @@ + +#include +#define NRANSI +#include "nrutil.h" + +float elle(float phi, float ak) +{ + float rd(float x, float y, float z); + float rf(float x, float y, float z); + float cc,q,s; + + s=sin(phi); + cc=SQR(cos(phi)); + q=(1.0-s*ak)*(1.0+s*ak); + return s*(rf(cc,q,1.0)-(SQR(s*ak))*rd(cc,q,1.0)/3.0); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/ellf.c b/lib/nr/ansi/recipes/ellf.c new file mode 100644 index 0000000..8d157e6 --- /dev/null +++ b/lib/nr/ansi/recipes/ellf.c @@ -0,0 +1,14 @@ + +#include +#define NRANSI +#include "nrutil.h" + +float ellf(float phi, float ak) +{ + float rf(float x, float y, float z); + float s; + + s=sin(phi); + return s*rf(SQR(cos(phi)),(1.0-s*ak)*(1.0+s*ak),1.0); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/ellpi.c b/lib/nr/ansi/recipes/ellpi.c new file mode 100644 index 0000000..508413d --- /dev/null +++ b/lib/nr/ansi/recipes/ellpi.c @@ -0,0 +1,18 @@ + +#include +#define NRANSI +#include "nrutil.h" + +float ellpi(float phi, float en, float ak) +{ + float rf(float x, float y, float z); + float rj(float x, float y, float z, float p); + float cc,enss,q,s; + + s=sin(phi); + enss=en*s*s; + cc=SQR(cos(phi)); + q=(1.0-s*ak)*(1.0+s*ak); + return s*(rf(cc,q,1.0)-enss*rj(cc,q,1.0,1.0+enss)/3.0); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/elmhes.c b/lib/nr/ansi/recipes/elmhes.c new file mode 100644 index 0000000..c3a50b6 --- /dev/null +++ b/lib/nr/ansi/recipes/elmhes.c @@ -0,0 +1,37 @@ + +#include +#define SWAP(g,h) {y=(g);(g)=(h);(h)=y;} + +void elmhes(float **a, int n) +{ + int m,j,i; + float y,x; + + for (m=2;m fabs(x)) { + x=a[j][m-1]; + i=j; + } + } + if (i != m) { + for (j=m-1;j<=n;j++) SWAP(a[i][j],a[m][j]) + for (j=1;j<=n;j++) SWAP(a[j][i],a[j][m]) + } + if (x) { + for (i=m+1;i<=n;i++) { + if ((y=a[i][m-1]) != 0.0) { + y /= x; + a[i][m-1]=y; + for (j=m;j<=n;j++) + a[i][j] -= y*a[m][j]; + for (j=1;j<=n;j++) + a[j][m] += y*a[j][i]; + } + } + } + } +} +#undef SWAP diff --git a/lib/nr/ansi/recipes/erfcc.c b/lib/nr/ansi/recipes/erfcc.c new file mode 100644 index 0000000..90b2df1 --- /dev/null +++ b/lib/nr/ansi/recipes/erfcc.c @@ -0,0 +1,14 @@ + +#include + +float erfcc(float x) +{ + float t,z,ans; + + z=fabs(x); + t=1.0/(1.0+0.5*z); + ans=t*exp(-z*z-1.26551223+t*(1.00002368+t*(0.37409196+t*(0.09678418+ + t*(-0.18628806+t*(0.27886807+t*(-1.13520398+t*(1.48851587+ + t*(-0.82215223+t*0.17087277))))))))); + return x >= 0.0 ? ans : 2.0-ans; +} diff --git a/lib/nr/ansi/recipes/erff.c b/lib/nr/ansi/recipes/erff.c new file mode 100644 index 0000000..079f9ff --- /dev/null +++ b/lib/nr/ansi/recipes/erff.c @@ -0,0 +1,7 @@ + +float erff(float x) +{ + float gammp(float a, float x); + + return x < 0.0 ? -gammp(0.5,x*x) : gammp(0.5,x*x); +} diff --git a/lib/nr/ansi/recipes/erffc.c b/lib/nr/ansi/recipes/erffc.c new file mode 100644 index 0000000..075958c --- /dev/null +++ b/lib/nr/ansi/recipes/erffc.c @@ -0,0 +1,8 @@ + +float erffc(float x) +{ + float gammp(float a, float x); + float gammq(float a, float x); + + return x < 0.0 ? 1.0+gammp(0.5,x*x) : gammq(0.5,x*x); +} diff --git a/lib/nr/ansi/recipes/eulsum.c b/lib/nr/ansi/recipes/eulsum.c new file mode 100644 index 0000000..fd77d7a --- /dev/null +++ b/lib/nr/ansi/recipes/eulsum.c @@ -0,0 +1,27 @@ + +#include + +void eulsum(float *sum, float term, int jterm, float wksp[]) +{ + int j; + static int nterm; + float tmp,dum; + + if (jterm == 1) { + nterm=1; + *sum=0.5*(wksp[1]=term); + } else { + tmp=wksp[1]; + wksp[1]=term; + for (j=1;j<=nterm-1;j++) { + dum=wksp[j+1]; + wksp[j+1]=0.5*(wksp[j]+tmp); + tmp=dum; + } + wksp[nterm+1]=0.5*(wksp[nterm]+tmp); + if (fabs(wksp[nterm+1]) <= fabs(wksp[nterm])) + *sum += (0.5*wksp[++nterm]); + else + *sum += wksp[nterm+1]; + } +} diff --git a/lib/nr/ansi/recipes/evlmem.c b/lib/nr/ansi/recipes/evlmem.c new file mode 100644 index 0000000..01cd42f --- /dev/null +++ b/lib/nr/ansi/recipes/evlmem.c @@ -0,0 +1,20 @@ + +#include + +float evlmem(float fdt, float d[], int m, float xms) +{ + int i; + float sumr=1.0,sumi=0.0; + double wr=1.0,wi=0.0,wpr,wpi,wtemp,theta; + + theta=6.28318530717959*fdt; + wpr=cos(theta); + wpi=sin(theta); + for (i=1;i<=m;i++) { + wr=(wtemp=wr)*wpr-wi*wpi; + wi=wi*wpr+wtemp*wpi; + sumr -= d[i]*wr; + sumi -= d[i]*wi; + } + return xms/(sumr*sumr+sumi*sumi); +} diff --git a/lib/nr/ansi/recipes/expdev.c b/lib/nr/ansi/recipes/expdev.c new file mode 100644 index 0000000..0f87aad --- /dev/null +++ b/lib/nr/ansi/recipes/expdev.c @@ -0,0 +1,13 @@ + +#include + +float expdev(long *idum) +{ + float ran1(long *idum); + float dum; + + do + dum=ran1(idum); + while (dum == 0.0); + return -log(dum); +} diff --git a/lib/nr/ansi/recipes/expint.c b/lib/nr/ansi/recipes/expint.c new file mode 100644 index 0000000..1def7ee --- /dev/null +++ b/lib/nr/ansi/recipes/expint.c @@ -0,0 +1,65 @@ + +#include +#define MAXIT 100 +#define EULER 0.5772156649 +#define FPMIN 1.0e-30 +#define EPS 1.0e-7 + +float expint(int n, float x) +{ + void nrerror(char error_text[]); + int i,ii,nm1; + float a,b,c,d,del,fact,h,psi,ans; + + nm1=n-1; + if (n < 0 || x < 0.0 || (x==0.0 && (n==0 || n==1))) + nrerror("bad arguments in expint"); + else { + if (n == 0) ans=exp(-x)/x; + else { + if (x == 0.0) ans=1.0/nm1; + + else { + if (x > 1.0) { + b=x+n; + c=1.0/FPMIN; + d=1.0/b; + h=d; + for (i=1;i<=MAXIT;i++) { + a = -i*(nm1+i); + b += 2.0; + d=1.0/(a*d+b); + c=b+a/c; + del=c*d; + h *= del; + if (fabs(del-1.0) < EPS) { + ans=h*exp(-x); + return ans; + } + } + nrerror("continued fraction failed in expint"); + } else { + ans = (nm1!=0 ? 1.0/nm1 : -log(x)-EULER); + fact=1.0; + for (i=1;i<=MAXIT;i++) { + fact *= -x/i; + if (i != nm1) del = -fact/(i-nm1); + else { + psi = -EULER; + for (ii=1;ii<=nm1;ii++) psi += 1.0/ii; + del=fact*(-log(x)+psi); + } + ans += del; + if (fabs(del) < fabs(ans)*EPS) return ans; + } + nrerror("series failed in expint"); + } + } + } + } + return ans; +} +#undef MAXIT +#undef EPS +#undef FPMIN +#undef EULER diff --git a/lib/nr/ansi/recipes/f1dim.c b/lib/nr/ansi/recipes/f1dim.c new file mode 100644 index 0000000..d8c17a2 --- /dev/null +++ b/lib/nr/ansi/recipes/f1dim.c @@ -0,0 +1,19 @@ + +#define NRANSI +#include "nrutil.h" + +extern int ncom; +extern float *pcom,*xicom,(*nrfunc)(float []); + +float f1dim(float x) +{ + int j; + float f,*xt; + + xt=vector(1,ncom); + for (j=1;j<=ncom;j++) xt[j]=pcom[j]+x*xicom[j]; + f=(*nrfunc)(xt); + free_vector(xt,1,ncom); + return f; +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/factln.c b/lib/nr/ansi/recipes/factln.c new file mode 100644 index 0000000..ce185fe --- /dev/null +++ b/lib/nr/ansi/recipes/factln.c @@ -0,0 +1,12 @@ + +float factln(int n) +{ + float gammln(float xx); + void nrerror(char error_text[]); + static float a[101]; + + if (n < 0) nrerror("Negative factorial in routine factln"); + if (n <= 1) return 0.0; + if (n <= 100) return a[n] ? a[n] : (a[n]=gammln(n+1.0)); + else return gammln(n+1.0); +} diff --git a/lib/nr/ansi/recipes/factrl.c b/lib/nr/ansi/recipes/factrl.c new file mode 100644 index 0000000..ca7c4a1 --- /dev/null +++ b/lib/nr/ansi/recipes/factrl.c @@ -0,0 +1,19 @@ + +#include + +float factrl(int n) +{ + float gammln(float xx); + void nrerror(char error_text[]); + static int ntop=4; + static float a[33]={1.0,1.0,2.0,6.0,24.0}; + int j; + + if (n < 0) nrerror("Negative factorial in routine factrl"); + if (n > 32) return exp(gammln(n+1.0)); + while (ntop +#define NRANSI +#include "nrutil.h" +#define MOD(a,b) while(a >= b) a -= b; +#define MACC 4 + +void fasper(float x[], float y[], unsigned long n, float ofac, float hifac, + float wk1[], float wk2[], unsigned long nwk, unsigned long *nout, + unsigned long *jmax, float *prob) +{ + void avevar(float data[], unsigned long n, float *ave, float *var); + void realft(float data[], unsigned long n, int isign); + void spread(float y, float yy[], unsigned long n, float x, int m); + unsigned long j,k,ndim,nfreq,nfreqt; + float ave,ck,ckk,cterm,cwt,den,df,effm,expy,fac,fndim,hc2wt; + float hs2wt,hypo,pmax,sterm,swt,var,xdif,xmax,xmin; + + *nout=0.5*ofac*hifac*n; + nfreqt=ofac*hifac*n*MACC; + nfreq=64; + while (nfreq < nfreqt) nfreq <<= 1; + ndim=nfreq << 1; + if (ndim > nwk) nrerror("workspaces too small in fasper"); + avevar(y,n,&ave,&var); + if (var == 0.0) nrerror("zero variance in fasper"); + xmin=x[1]; + xmax=xmin; + for (j=2;j<=n;j++) { + if (x[j] < xmin) xmin=x[j]; + if (x[j] > xmax) xmax=x[j]; + } + xdif=xmax-xmin; + for (j=1;j<=ndim;j++) wk1[j]=wk2[j]=0.0; + fac=ndim/(xdif*ofac); + fndim=ndim; + for (j=1;j<=n;j++) { + ck=(x[j]-xmin)*fac; + MOD(ck,fndim) + ckk=2.0*(ck++); + MOD(ckk,fndim) + ++ckk; + spread(y[j]-ave,wk1,ndim,ck,MACC); + spread(1.0,wk2,ndim,ckk,MACC); + } + realft(wk1,ndim,1); + realft(wk2,ndim,1); + df=1.0/(xdif*ofac); + pmax = -1.0; + for (k=3,j=1;j<=(*nout);j++,k+=2) { + hypo=sqrt(wk2[k]*wk2[k]+wk2[k+1]*wk2[k+1]); + hc2wt=0.5*wk2[k]/hypo; + hs2wt=0.5*wk2[k+1]/hypo; + cwt=sqrt(0.5+hc2wt); + swt=SIGN(sqrt(0.5-hc2wt),hs2wt); + den=0.5*n+hc2wt*wk2[k]+hs2wt*wk2[k+1]; + cterm=SQR(cwt*wk1[k]+swt*wk1[k+1])/den; + sterm=SQR(cwt*wk1[k+1]-swt*wk1[k])/(n-den); + wk1[j]=j*df; + wk2[j]=(cterm+sterm)/(2.0*var); + if (wk2[j] > pmax) pmax=wk2[(*jmax=j)]; + } + expy=exp(-pmax); + effm=2.0*(*nout)/ofac; + *prob=effm*expy; + if (*prob > 0.01) *prob=1.0-pow(1.0-expy,effm); +} +#undef MOD +#undef MACC +#undef NRANSI diff --git a/lib/nr/ansi/recipes/fdjac.c b/lib/nr/ansi/recipes/fdjac.c new file mode 100644 index 0000000..b54ebf1 --- /dev/null +++ b/lib/nr/ansi/recipes/fdjac.c @@ -0,0 +1,27 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define EPS 1.0e-4 + +void fdjac(int n, float x[], float fvec[], float **df, + void (*vecfunc)(int, float [], float [])) +{ + int i,j; + float h,temp,*f; + + f=vector(1,n); + for (j=1;j<=n;j++) { + temp=x[j]; + h=EPS*fabs(temp); + if (h == 0.0) h=EPS; + x[j]=temp+h; + h=x[j]-temp; + (*vecfunc)(n,x,f); + x[j]=temp; + for (i=1;i<=n;i++) df[i][j]=(f[i]-fvec[i])/h; + } + free_vector(f,1,n); +} +#undef EPS +#undef NRANSI diff --git a/lib/nr/ansi/recipes/fgauss.c b/lib/nr/ansi/recipes/fgauss.c new file mode 100644 index 0000000..e4ef300 --- /dev/null +++ b/lib/nr/ansi/recipes/fgauss.c @@ -0,0 +1,19 @@ + +#include + +void fgauss(float x, float a[], float *y, float dyda[], int na) +{ + int i; + float fac,ex,arg; + + *y=0.0; + for (i=1;i<=na-1;i+=3) { + arg=(x-a[i+1])/a[i+2]; + ex=exp(-arg*arg); + fac=a[i]*ex*2.0*arg; + *y += a[i]*ex; + dyda[i]=ex; + dyda[i+1]=fac/a[i+2]; + dyda[i+2]=fac*arg/a[i+2]; + } +} diff --git a/lib/nr/ansi/recipes/fill0.c b/lib/nr/ansi/recipes/fill0.c new file mode 100644 index 0000000..9aea927 --- /dev/null +++ b/lib/nr/ansi/recipes/fill0.c @@ -0,0 +1,8 @@ + +void fill0(double **u, int n) +{ + int i,j; + for (j=1;j<=n;j++) + for (i=1;i<=n;i++) + u[i][j]=0.0; +} diff --git a/lib/nr/ansi/recipes/fit.c b/lib/nr/ansi/recipes/fit.c new file mode 100644 index 0000000..dd4d52f --- /dev/null +++ b/lib/nr/ansi/recipes/fit.c @@ -0,0 +1,61 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void fit(float x[], float y[], int ndata, float sig[], int mwt, float *a, + float *b, float *siga, float *sigb, float *chi2, float *q) +{ + float gammq(float a, float x); + int i; + float wt,t,sxoss,sx=0.0,sy=0.0,st2=0.0,ss,sigdat; + + *b=0.0; + if (mwt) { + ss=0.0; + for (i=1;i<=ndata;i++) { + wt=1.0/SQR(sig[i]); + ss += wt; + sx += x[i]*wt; + sy += y[i]*wt; + } + } else { + for (i=1;i<=ndata;i++) { + sx += x[i]; + sy += y[i]; + } + ss=ndata; + } + sxoss=sx/ss; + if (mwt) { + for (i=1;i<=ndata;i++) { + t=(x[i]-sxoss)/sig[i]; + st2 += t*t; + *b += t*y[i]/sig[i]; + } + } else { + for (i=1;i<=ndata;i++) { + t=x[i]-sxoss; + st2 += t*t; + *b += t*y[i]; + } + } + *b /= st2; + *a=(sy-sx*(*b))/ss; + *siga=sqrt((1.0+sx*sx/(ss*st2))/ss); + *sigb=sqrt(1.0/st2); + *chi2=0.0; + *q=1.0; + if (mwt == 0) { + for (i=1;i<=ndata;i++) + *chi2 += SQR(y[i]-(*a)-(*b)*x[i]); + sigdat=sqrt((*chi2)/(ndata-2)); + *siga *= sigdat; + *sigb *= sigdat; + } else { + for (i=1;i<=ndata;i++) + *chi2 += SQR((y[i]-(*a)-(*b)*x[i])/sig[i]); + if (ndata>2) *q=gammq(0.5*(ndata-2),0.5*(*chi2)); + } +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/fitexy.c b/lib/nr/ansi/recipes/fitexy.c new file mode 100644 index 0000000..9ec8db9 --- /dev/null +++ b/lib/nr/ansi/recipes/fitexy.c @@ -0,0 +1,97 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define POTN 1.571000 +#define BIG 1.0e30 +#define PI 3.14159265 +#define ACC 1.0e-3 + +int nn; +float *xx,*yy,*sx,*sy,*ww,aa,offs; + +void fitexy(float x[], float y[], int ndat, float sigx[], float sigy[], + float *a, float *b, float *siga, float *sigb, float *chi2, float *q) +{ + void avevar(float data[], unsigned long n, float *ave, float *var); + float brent(float ax, float bx, float cx, + float (*f)(float), float tol, float *xmin); + float chixy(float bang); + void fit(float x[], float y[], int ndata, float sig[], int mwt, + float *a, float *b, float *siga, float *sigb, float *chi2, float *q); + float gammq(float a, float x); + void mnbrak(float *ax, float *bx, float *cx, float *fa, float *fb, + float *fc, float (*func)(float)); + float zbrent(float (*func)(float), float x1, float x2, float tol); + int j; + float swap,amx,amn,varx,vary,ang[7],ch[7],scale,bmn,bmx,d1,d2,r2, + dum1,dum2,dum3,dum4,dum5; + + xx=vector(1,ndat); + yy=vector(1,ndat); + sx=vector(1,ndat); + sy=vector(1,ndat); + ww=vector(1,ndat); + avevar(x,ndat,&dum1,&varx); + avevar(y,ndat,&dum1,&vary); + scale=sqrt(varx/vary); + nn=ndat; + for (j=1;j<=ndat;j++) { + xx[j]=x[j]; + yy[j]=y[j]*scale; + sx[j]=sigx[j]; + sy[j]=sigy[j]*scale; + ww[j]=sqrt(SQR(sx[j])+SQR(sy[j])); + } + fit(xx,yy,nn,ww,1,&dum1,b,&dum2,&dum3,&dum4,&dum5); + offs=ang[1]=0.0; + ang[2]=atan(*b); + ang[4]=0.0; + ang[5]=ang[2]; + ang[6]=POTN; + for (j=4;j<=6;j++) ch[j]=chixy(ang[j]); + mnbrak(&ang[1],&ang[2],&ang[3],&ch[1],&ch[2],&ch[3],chixy); + *chi2=brent(ang[1],ang[2],ang[3],chixy,ACC,b); + *chi2=chixy(*b); + *a=aa; + *q=gammq(0.5*(nn-2),*chi2*0.5); + for (r2=0.0,j=1;j<=nn;j++) r2 += ww[j]; + r2=1.0/r2; + bmx=BIG; + bmn=BIG; + offs=(*chi2)+1.0; + for (j=1;j<=6;j++) { + if (ch[j] > offs) { + d1=fabs(ang[j]-(*b)); + while (d1 >= PI) d1 -= PI; + d2=PI-d1; + if (ang[j] < *b) { + swap=d1; + d1=d2; + d2=swap; + } + if (d1 < bmx) bmx=d1; + if (d2 < bmn) bmn=d2; + } + } + if (bmx < BIG) { + bmx=zbrent(chixy,*b,*b+bmx,ACC)-(*b); + amx=aa-(*a); + bmn=zbrent(chixy,*b,*b-bmn,ACC)-(*b); + amn=aa-(*a); + *sigb=sqrt(0.5*(bmx*bmx+bmn*bmn))/(scale*SQR(cos(*b))); + *siga=sqrt(0.5*(amx*amx+amn*amn)+r2)/scale; + } else (*sigb)=(*siga)=BIG; + *a /= scale; + *b=tan(*b)/scale; + free_vector(ww,1,ndat); + free_vector(sy,1,ndat); + free_vector(sx,1,ndat); + free_vector(yy,1,ndat); + free_vector(xx,1,ndat); +} +#undef POTN +#undef BIG +#undef PI +#undef ACC +#undef NRANSI diff --git a/lib/nr/ansi/recipes/fixrts.c b/lib/nr/ansi/recipes/fixrts.c new file mode 100644 index 0000000..814c478 --- /dev/null +++ b/lib/nr/ansi/recipes/fixrts.c @@ -0,0 +1,35 @@ + +#include +#include "complex.h" +#define NMAX 100 +#define ZERO Complex(0.0,0.0) +#define ONE Complex(1.0,0.0) + +void fixrts(float d[], int m) +{ + void zroots(fcomplex a[], int m, fcomplex roots[], int polish); + int i,j,polish; + fcomplex a[NMAX],roots[NMAX]; + + a[m]=ONE; + for (j=m-1;j>=0;j--) + a[j]=Complex(-d[m-j],0.0); + polish=1; + zroots(a,m,roots,polish); + for (j=1;j<=m;j++) + if (Cabs(roots[j]) > 1.0) + roots[j]=Cdiv(ONE,Conjg(roots[j])); + a[0]=Csub(ZERO,roots[1]); + a[1]=ONE; + for (j=2;j<=m;j++) { + a[j]=ONE; + for (i=j;i>=2;i--) + a[i-1]=Csub(a[i-2],Cmul(roots[j],a[i-1])); + a[0]=Csub(ZERO,Cmul(roots[j],a[0])); + } + for (j=0;j<=m-1;j++) + d[m-j] = -a[j].r; +} +#undef NMAX +#undef ZERO +#undef ONE diff --git a/lib/nr/ansi/recipes/fleg.c b/lib/nr/ansi/recipes/fleg.c new file mode 100644 index 0000000..6039ada --- /dev/null +++ b/lib/nr/ansi/recipes/fleg.c @@ -0,0 +1,19 @@ + +void fleg(float x, float pl[], int nl) +{ + int j; + float twox,f2,f1,d; + + pl[1]=1.0; + pl[2]=x; + if (nl > 2) { + twox=2.0*x; + f2=x; + d=1.0; + for (j=3;j<=nl;j++) { + f1=d++; + f2 += twox; + pl[j]=(f2*pl[j-1]-f1*pl[j-2])/d; + } + } +} diff --git a/lib/nr/ansi/recipes/flmoon.c b/lib/nr/ansi/recipes/flmoon.c new file mode 100644 index 0000000..bcdbb14 --- /dev/null +++ b/lib/nr/ansi/recipes/flmoon.c @@ -0,0 +1,27 @@ + +#include +#define RAD (3.14159265/180.0) + +void flmoon(int n, int nph, long *jd, float *frac) +{ + void nrerror(char error_text[]); + int i; + float am,as,c,t,t2,xtra; + + c=n+nph/4.0; + t=c/1236.85; + t2=t*t; + as=359.2242+29.105356*c; + am=306.0253+385.816918*c+0.010730*t2; + *jd=2415020+28L*n+7L*nph; + xtra=0.75933+1.53058868*c+((1.178e-4)-(1.55e-7)*t)*t2; + if (nph == 0 || nph == 2) + xtra += (0.1734-3.93e-4*t)*sin(RAD*as)-0.4068*sin(RAD*am); + else if (nph == 1 || nph == 3) + xtra += (0.1721-4.0e-4*t)*sin(RAD*as)-0.6280*sin(RAD*am); + else nrerror("nph is unknown in flmoon"); + i=(int)(xtra >= 0.0 ? floor(xtra) : ceil(xtra-1.0)); + *jd += i; + *frac=xtra-i; +} +#undef RAD diff --git a/lib/nr/ansi/recipes/fmin.c b/lib/nr/ansi/recipes/fmin.c new file mode 100644 index 0000000..8719e27 --- /dev/null +++ b/lib/nr/ansi/recipes/fmin.c @@ -0,0 +1,18 @@ + +#define NRANSI +#include "nrutil.h" + +extern int nn; +extern float *fvec; +extern void (*nrfuncv)(int n, float v[], float f[]); + +float fmin(float x[]) +{ + int i; + float sum; + + (*nrfuncv)(nn,x,fvec); + for (sum=0.0,i=1;i<=nn;i++) sum += SQR(fvec[i]); + return 0.5*sum; +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/four1.c b/lib/nr/ansi/recipes/four1.c new file mode 100644 index 0000000..b727ab7 --- /dev/null +++ b/lib/nr/ansi/recipes/four1.c @@ -0,0 +1,50 @@ + +#include +#define SWAP(a,b) tempr=(a);(a)=(b);(b)=tempr + +void four1(float data[], unsigned long nn, int isign) +{ + unsigned long n,mmax,m,j,istep,i; + double wtemp,wr,wpr,wpi,wi,theta; + float tempr,tempi; + + n=nn << 1; + j=1; + for (i=1;i i) { + SWAP(data[j],data[i]); + SWAP(data[j+1],data[i+1]); + } + m=nn; + while (m >= 2 && j > m) { + j -= m; + m >>= 1; + } + j += m; + } + mmax=2; + while (n > mmax) { + istep=mmax << 1; + theta=isign*(6.28318530717959/mmax); + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0; + wi=0.0; + for (m=1;m +#define SWAP(a,b) ftemp=(a);(a)=(b);(b)=ftemp + +void fourew(FILE *file[5], int *na, int *nb, int *nc, int *nd) +{ + int i; + FILE *ftemp; + + for (i=1;i<=4;i++) rewind(file[i]); + SWAP(file[2],file[4]); + SWAP(file[1],file[3]); + *na=3; + *nb=4; + *nc=1; + *nd=2; +} +#undef SWAP diff --git a/lib/nr/ansi/recipes/fourfs.c b/lib/nr/ansi/recipes/fourfs.c new file mode 100644 index 0000000..3b6ee1d --- /dev/null +++ b/lib/nr/ansi/recipes/fourfs.c @@ -0,0 +1,157 @@ + +#include +#include +#define NRANSI +#include "nrutil.h" +#define KBF 128 + +void fourfs(FILE *file[5], unsigned long nn[], int ndim, int isign) +{ + void fourew(FILE *file[5], int *na, int *nb, int *nc, int *nd); + unsigned long j,j12,jk,k,kk,n=1,mm,kc=0,kd,ks,kr,nr,ns,nv; + int cc,na,nb,nc,nd; + float tempr,tempi,*afa,*afb,*afc; + double wr,wi,wpr,wpi,wtemp,theta; + static int mate[5] = {0,2,1,4,3}; + + afa=vector(1,KBF); + afb=vector(1,KBF); + afc=vector(1,KBF); + for (j=1;j<=ndim;j++) { + n *= nn[j]; + if (nn[j] <= 1) nrerror("invalid float or wrong ndim in fourfs"); + } + nv=1; + jk=nn[nv]; + mm=n; + ns=n/KBF; + nr=ns >> 1; + kd=KBF >> 1; + ks=n; + fourew(file,&na,&nb,&nc,&nd); + for (;;) { + theta=isign*3.141592653589793/(n/mm); + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0; + wi=0.0; + mm >>= 1; + for (j12=1;j12<=2;j12++) { + kr=0; + do { + cc=fread(&afa[1],sizeof(float),KBF,file[na]); + if (cc != KBF) nrerror("read error in fourfs"); + cc=fread(&afb[1],sizeof(float),KBF,file[nb]); + if (cc != KBF) nrerror("read error in fourfs"); + for (j=1;j<=KBF;j+=2) { + tempr=((float)wr)*afb[j]-((float)wi)*afb[j+1]; + tempi=((float)wi)*afb[j]+((float)wr)*afb[j+1]; + afb[j]=afa[j]-tempr; + afa[j] += tempr; + afb[j+1]=afa[j+1]-tempi; + afa[j+1] += tempi; + } + kc += kd; + if (kc == mm) { + kc=0; + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + } + cc=fwrite(&afa[1],sizeof(float),KBF,file[nc]); + if (cc != KBF) nrerror("write error in fourfs"); + cc=fwrite(&afb[1],sizeof(float),KBF,file[nd]); + if (cc != KBF) nrerror("write error in fourfs"); + } while (++kr < nr); + if (j12 == 1 && ks != n && ks == KBF) { + na=mate[na]; + nb=na; + } + if (nr == 0) break; + } + fourew(file,&na,&nb,&nc,&nd); + jk >>= 1; + while (jk == 1) { + mm=n; + jk=nn[++nv]; + } + ks >>= 1; + if (ks > KBF) { + for (j12=1;j12<=2;j12++) { + for (kr=1;kr<=ns;kr+=ks/KBF) { + for (k=1;k<=ks;k+=KBF) { + cc=fread(&afa[1],sizeof(float),KBF,file[na]); + if (cc != KBF) nrerror("read error in fourfs"); + cc=fwrite(&afa[1],sizeof(float),KBF,file[nc]); + if (cc != KBF) nrerror("write error in fourfs"); + } + nc=mate[nc]; + } + na=mate[na]; + } + fourew(file,&na,&nb,&nc,&nd); + } else if (ks == KBF) nb=na; + else break; + } + j=1; + for (;;) { + theta=isign*3.141592653589793/(n/mm); + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0; + wi=0.0; + mm >>= 1; + ks=kd; + kd >>= 1; + for (j12=1;j12<=2;j12++) { + for (kr=1;kr<=ns;kr++) { + cc=fread(&afc[1],sizeof(float),KBF,file[na]); + if (cc != KBF) nrerror("read error in fourfs"); + kk=1; + k=ks+1; + for (;;) { + tempr=((float)wr)*afc[kk+ks]-((float)wi)*afc[kk+ks+1]; + tempi=((float)wi)*afc[kk+ks]+((float)wr)*afc[kk+ks+1]; + afa[j]=afc[kk]+tempr; + afb[j]=afc[kk]-tempr; + afa[++j]=afc[++kk]+tempi; + afb[j++]=afc[kk++]-tempi; + if (kk < k) continue; + kc += kd; + if (kc == mm) { + kc=0; + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + } + kk += ks; + if (kk > KBF) break; + else k=kk+ks; + } + if (j > KBF) { + cc=fwrite(&afa[1],sizeof(float),KBF,file[nc]); + if (cc != KBF) nrerror("write error in fourfs"); + cc=fwrite(&afb[1],sizeof(float),KBF,file[nd]); + if (cc != KBF) nrerror("write error in fourfs"); + j=1; + } + } + na=mate[na]; + } + fourew(file,&na,&nb,&nc,&nd); + jk >>= 1; + if (jk > 1) continue; + mm=n; + do { + if (nv < ndim) jk=nn[++nv]; + else { + free_vector(afc,1,KBF); + free_vector(afb,1,KBF); + free_vector(afa,1,KBF); + return; + } + } while (jk == 1); + } +} +#undef KBF +#undef NRANSI diff --git a/lib/nr/ansi/recipes/fourn.c b/lib/nr/ansi/recipes/fourn.c new file mode 100644 index 0000000..1847396 --- /dev/null +++ b/lib/nr/ansi/recipes/fourn.c @@ -0,0 +1,70 @@ + +#include +#define SWAP(a,b) tempr=(a);(a)=(b);(b)=tempr + +void fourn(float data[], unsigned long nn[], int ndim, int isign) +{ + int idim; + unsigned long i1,i2,i3,i2rev,i3rev,ip1,ip2,ip3,ifp1,ifp2; + unsigned long ibit,k1,k2,n,nprev,nrem,ntot; + float tempi,tempr; + double theta,wi,wpi,wpr,wr,wtemp; + + for (ntot=1,idim=1;idim<=ndim;idim++) + ntot *= nn[idim]; + nprev=1; + for (idim=ndim;idim>=1;idim--) { + n=nn[idim]; + nrem=ntot/(n*nprev); + ip1=nprev << 1; + ip2=ip1*n; + ip3=ip2*nrem; + i2rev=1; + for (i2=1;i2<=ip2;i2+=ip1) { + if (i2 < i2rev) { + for (i1=i2;i1<=i2+ip1-2;i1+=2) { + for (i3=i1;i3<=ip3;i3+=ip2) { + i3rev=i2rev+i3-i2; + SWAP(data[i3],data[i3rev]); + SWAP(data[i3+1],data[i3rev+1]); + } + } + } + ibit=ip2 >> 1; + while (ibit >= ip1 && i2rev > ibit) { + i2rev -= ibit; + ibit >>= 1; + } + i2rev += ibit; + } + ifp1=ip1; + while (ifp1 < ip2) { + ifp2=ifp1 << 1; + theta=isign*6.28318530717959/(ifp2/ip1); + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0; + wi=0.0; + for (i3=1;i3<=ifp1;i3+=ip1) { + for (i1=i3;i1<=i3+ip1-2;i1+=2) { + for (i2=i1;i2<=ip3;i2+=ifp2) { + k1=i2; + k2=k1+ifp1; + tempr=(float)wr*data[k2]-(float)wi*data[k2+1]; + tempi=(float)wr*data[k2+1]+(float)wi*data[k2]; + data[k2]=data[k1]-tempr; + data[k2+1]=data[k1+1]-tempi; + data[k1] += tempr; + data[k1+1] += tempi; + } + } + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + } + ifp1=ifp2; + } + nprev *= n; + } +} +#undef SWAP diff --git a/lib/nr/ansi/recipes/fpoly.c b/lib/nr/ansi/recipes/fpoly.c new file mode 100644 index 0000000..d34bd72 --- /dev/null +++ b/lib/nr/ansi/recipes/fpoly.c @@ -0,0 +1,8 @@ + +void fpoly(float x, float p[], int np) +{ + int j; + + p[1]=1.0; + for (j=2;j<=np;j++) p[j]=p[j-1]*x; +} diff --git a/lib/nr/ansi/recipes/fred2.c b/lib/nr/ansi/recipes/fred2.c new file mode 100644 index 0000000..5a11ef8 --- /dev/null +++ b/lib/nr/ansi/recipes/fred2.c @@ -0,0 +1,27 @@ + +#define NRANSI +#include "nrutil.h" + +void fred2(int n, float a, float b, float t[], float f[], float w[], + float (*g)(float), float (*ak)(float, float)) +{ + void gauleg(float x1, float x2, float x[], float w[], int n); + void lubksb(float **a, int n, int *indx, float b[]); + void ludcmp(float **a, int n, int *indx, float *d); + int i,j,*indx; + float d,**omk; + + indx=ivector(1,n); + omk=matrix(1,n,1,n); + gauleg(a,b,t,w,n); + for (i=1;i<=n;i++) { + for (j=1;j<=n;j++) + omk[i][j]=(float)(i == j)-(*ak)(t[i],t[j])*w[j]; + f[i]=(*g)(t[i]); + } + ludcmp(omk,n,indx,&d); + lubksb(omk,n,indx,f); + free_matrix(omk,1,n,1,n); + free_ivector(indx,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/fredex.c b/lib/nr/ansi/recipes/fredex.c new file mode 100644 index 0000000..69bbb38 --- /dev/null +++ b/lib/nr/ansi/recipes/fredex.c @@ -0,0 +1,35 @@ + +#include +#include +#define NRANSI +#include "nrutil.h" +#define PI 3.14159265 +#define N 40 + +int main(void) /* Program fredex */ +{ + void lubksb(float **a, int n, int *indx, float b[]); + void ludcmp(float **a, int n, int *indx, float *d); + void quadmx(float **a, int n); + float **a,d,*g,x; + int *indx,j; + + indx=ivector(1,N); + a=matrix(1,N,1,N); + g=vector(1,N); + quadmx(a,N); + ludcmp(a,N,indx,&d); + for (j=1;j<=N;j++) g[j]=sin((j-1)*PI/(N-1)); + lubksb(a,N,indx,g); + for (j=1;j<=N;j++) { + x=(j-1)*PI/(N-1); + printf("%6.2d %12.6f %12.6f\n",j,x,g[j]); + } + free_vector(g,1,N); + free_matrix(a,1,N,1,N); + free_ivector(indx,1,N); + return 0; +} +#undef N +#undef PI +#undef NRANSI diff --git a/lib/nr/ansi/recipes/fredin.c b/lib/nr/ansi/recipes/fredin.c new file mode 100644 index 0000000..4bb8965 --- /dev/null +++ b/lib/nr/ansi/recipes/fredin.c @@ -0,0 +1,10 @@ + +float fredin(float x, int n, float a, float b, float t[], float f[], + float w[], float (*g)(float), float (*ak)(float, float)) +{ + int i; + float sum=0.0; + + for (i=1;i<=n;i++) sum += (*ak)(x,t[i])*w[i]*f[i]; + return (*g)(x)+sum; +} diff --git a/lib/nr/ansi/recipes/frenel.c b/lib/nr/ansi/recipes/frenel.c new file mode 100644 index 0000000..7be0f0a --- /dev/null +++ b/lib/nr/ansi/recipes/frenel.c @@ -0,0 +1,86 @@ + +#include +#include "complex.h" +#define EPS 6.0e-8 +#define MAXIT 100 +#define FPMIN 1.0e-30 +#define XMIN 1.5 +#define PI 3.1415927 +#define PIBY2 (PI/2.0) +#define TRUE 1 +#define ONE Complex(1.0,0.0) + +void frenel(float x, float *s, float *c) +{ + void nrerror(char error_text[]); + int k,n,odd; + float a,ax,fact,pix2,sign,sum,sumc,sums,term,test; + fcomplex b,cc,d,h,del,cs; + + ax=fabs(x); + if (ax < sqrt(FPMIN)) { + *s=0.0; + *c=ax; + } else if (ax <= XMIN) { + sum=sums=0.0; + sumc=ax; + sign=1.0; + fact=PIBY2*ax*ax; + odd=TRUE; + term=ax; + n=3; + for (k=1;k<=MAXIT;k++) { + term *= fact/k; + sum += sign*term/n; + test=fabs(sum)*EPS; + if (odd) { + sign = -sign; + sums=sum; + sum=sumc; + } else { + sumc=sum; + sum=sums; + } + if (term < test) break; + odd=!odd; + n += 2; + } + if (k > MAXIT) nrerror("series failed in frenel"); + *s=sums; + *c=sumc; + } else { + pix2=PI*ax*ax; + b=Complex(1.0,-pix2); + cc=Complex(1.0/FPMIN,0.0); + d=h=Cdiv(ONE,b); + n = -1; + for (k=2;k<=MAXIT;k++) { + n += 2; + a = -n*(n+1); + b=Cadd(b,Complex(4.0,0.0)); + d=Cdiv(ONE,Cadd(RCmul(a,d),b)); + cc=Cadd(b,Cdiv(Complex(a,0.0),cc)); + del=Cmul(cc,d); + h=Cmul(h,del); + if (fabs(del.r-1.0)+fabs(del.i) < EPS) break; + } + if (k > MAXIT) nrerror("cf failed in frenel"); + h=Cmul(Complex(ax,-ax),h); + cs=Cmul(Complex(0.5,0.5), + Csub(ONE,Cmul(Complex(cos(0.5*pix2),sin(0.5*pix2)),h))); + *c=cs.r; + *s=cs.i; + } + if (x < 0.0) { + *c = -(*c); + *s = -(*s); + } +} +#undef EPS +#undef MAXIT +#undef FPMIN +#undef XMIN +#undef PI +#undef PIBY2 +#undef TRUE +#undef ONE diff --git a/lib/nr/ansi/recipes/frprmn.c b/lib/nr/ansi/recipes/frprmn.c new file mode 100644 index 0000000..2bea593 --- /dev/null +++ b/lib/nr/ansi/recipes/frprmn.c @@ -0,0 +1,56 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define ITMAX 200 +#define EPS 1.0e-10 +#define FREEALL free_vector(xi,1,n);free_vector(h,1,n);free_vector(g,1,n); + +void frprmn(float p[], int n, float ftol, int *iter, float *fret, + float (*func)(float []), void (*dfunc)(float [], float [])) +{ + void linmin(float p[], float xi[], int n, float *fret, + float (*func)(float [])); + int j,its; + float gg,gam,fp,dgg; + float *g,*h,*xi; + + g=vector(1,n); + h=vector(1,n); + xi=vector(1,n); + fp=(*func)(p); + (*dfunc)(p,xi); + for (j=1;j<=n;j++) { + g[j] = -xi[j]; + xi[j]=h[j]=g[j]; + } + for (its=1;its<=ITMAX;its++) { + *iter=its; + linmin(p,xi,n,fret,func); + if (2.0*fabs(*fret-fp) <= ftol*(fabs(*fret)+fabs(fp)+EPS)) { + FREEALL + return; + } + fp= *fret; + (*dfunc)(p,xi); + dgg=gg=0.0; + for (j=1;j<=n;j++) { + gg += g[j]*g[j]; + dgg += (xi[j]+g[j])*xi[j]; + } + if (gg == 0.0) { + FREEALL + return; + } + gam=dgg/gg; + for (j=1;j<=n;j++) { + g[j] = -xi[j]; + xi[j]=h[j]=g[j]+gam*h[j]; + } + } + nrerror("Too many iterations in frprmn"); +} +#undef ITMAX +#undef EPS +#undef FREEALL +#undef NRANSI diff --git a/lib/nr/ansi/recipes/ftest.c b/lib/nr/ansi/recipes/ftest.c new file mode 100644 index 0000000..4d0969c --- /dev/null +++ b/lib/nr/ansi/recipes/ftest.c @@ -0,0 +1,22 @@ + +void ftest(float data1[], unsigned long n1, float data2[], unsigned long n2, + float *f, float *prob) +{ + void avevar(float data[], unsigned long n, float *ave, float *var); + float betai(float a, float b, float x); + float var1,var2,ave1,ave2,df1,df2; + + avevar(data1,n1,&ave1,&var1); + avevar(data2,n2,&ave2,&var2); + if (var1 > var2) { + *f=var1/var2; + df1=n1-1; + df2=n2-1; + } else { + *f=var2/var1; + df1=n2-1; + df2=n1-1; + } + *prob = 2.0*betai(0.5*df2,0.5*df1,df2/(df2+df1*(*f))); + if (*prob > 1.0) *prob=2.0-*prob; +} diff --git a/lib/nr/ansi/recipes/gamdev.c b/lib/nr/ansi/recipes/gamdev.c new file mode 100644 index 0000000..6f364d1 --- /dev/null +++ b/lib/nr/ansi/recipes/gamdev.c @@ -0,0 +1,32 @@ + +#include + +float gamdev(int ia, long *idum) +{ + float ran1(long *idum); + void nrerror(char error_text[]); + int j; + float am,e,s,v1,v2,x,y; + + if (ia < 1) nrerror("Error in routine gamdev"); + if (ia < 6) { + x=1.0; + for (j=1;j<=ia;j++) x *= ran1(idum); + x = -log(x); + } else { + do { + do { + do { + v1=ran1(idum); + v2=2.0*ran1(idum)-1.0; + } while (v1*v1+v2*v2 > 1.0); + y=v2/v1; + am=ia-1; + s=sqrt(2.0*am+1.0); + x=s*y+am; + } while (x <= 0.0); + e=(1.0+y*y)*exp(am*log(x/am)-s*y); + } while (ran1(idum) > e); + } + return x; +} diff --git a/lib/nr/ansi/recipes/gammln.c b/lib/nr/ansi/recipes/gammln.c new file mode 100644 index 0000000..be90f82 --- /dev/null +++ b/lib/nr/ansi/recipes/gammln.c @@ -0,0 +1,18 @@ + +#include + +float gammln(float xx) +{ + double x,y,tmp,ser; + static double cof[6]={76.18009172947146,-86.50532032941677, + 24.01409824083091,-1.231739572450155, + 0.1208650973866179e-2,-0.5395239384953e-5}; + int j; + + y=x=xx; + tmp=x+5.5; + tmp -= (x+0.5)*log(tmp); + ser=1.000000000190015; + for (j=0;j<=5;j++) ser += cof[j]/++y; + return -tmp+log(2.5066282746310005*ser/x); +} diff --git a/lib/nr/ansi/recipes/gammp.c b/lib/nr/ansi/recipes/gammp.c new file mode 100644 index 0000000..92ae5d0 --- /dev/null +++ b/lib/nr/ansi/recipes/gammp.c @@ -0,0 +1,17 @@ + +float gammp(float a, float x) +{ + void gcf(float *gammcf, float a, float x, float *gln); + void gser(float *gamser, float a, float x, float *gln); + void nrerror(char error_text[]); + float gamser,gammcf,gln; + + if (x < 0.0 || a <= 0.0) nrerror("Invalid arguments in routine gammp"); + if (x < (a+1.0)) { + gser(&gamser,a,x,&gln); + return gamser; + } else { + gcf(&gammcf,a,x,&gln); + return 1.0-gammcf; + } +} diff --git a/lib/nr/ansi/recipes/gammq.c b/lib/nr/ansi/recipes/gammq.c new file mode 100644 index 0000000..5a2e889 --- /dev/null +++ b/lib/nr/ansi/recipes/gammq.c @@ -0,0 +1,17 @@ + +float gammq(float a, float x) +{ + void gcf(float *gammcf, float a, float x, float *gln); + void gser(float *gamser, float a, float x, float *gln); + void nrerror(char error_text[]); + float gamser,gammcf,gln; + + if (x < 0.0 || a <= 0.0) nrerror("Invalid arguments in routine gammq"); + if (x < (a+1.0)) { + gser(&gamser,a,x,&gln); + return 1.0-gamser; + } else { + gcf(&gammcf,a,x,&gln); + return gammcf; + } +} diff --git a/lib/nr/ansi/recipes/gasdev.c b/lib/nr/ansi/recipes/gasdev.c new file mode 100644 index 0000000..6a9d563 --- /dev/null +++ b/lib/nr/ansi/recipes/gasdev.c @@ -0,0 +1,26 @@ + +#include + +float gasdev(long *idum) +{ + float ran1(long *idum); + static int iset=0; + static float gset; + float fac,rsq,v1,v2; + + if (*idum < 0) iset=0; + if (iset == 0) { + do { + v1=2.0*ran1(idum)-1.0; + v2=2.0*ran1(idum)-1.0; + rsq=v1*v1+v2*v2; + } while (rsq >= 1.0 || rsq == 0.0); + fac=sqrt(-2.0*log(rsq)/rsq); + gset=v1*fac; + iset=1; + return v2*fac; + } else { + iset=0; + return gset; + } +} diff --git a/lib/nr/ansi/recipes/gaucof.c b/lib/nr/ansi/recipes/gaucof.c new file mode 100644 index 0000000..7af6bf1 --- /dev/null +++ b/lib/nr/ansi/recipes/gaucof.c @@ -0,0 +1,26 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void gaucof(int n, float a[], float b[], float amu0, float x[], float w[]) +{ + void eigsrt(float d[], float **v, int n); + void tqli(float d[], float e[], int n, float **z); + int i,j; + float **z; + + z=matrix(1,n,1,n); + for (i=1;i<=n;i++) { + if (i != 1) b[i]=sqrt(b[i]); + for (j=1;j<=n;j++) z[i][j]=(float)(i == j); + } + tqli(a,b,n,z); + eigsrt(a,z,n); + for (i=1;i<=n;i++) { + x[i]=a[i]; + w[i]=amu0*z[1][i]*z[1][i]; + } + free_matrix(z,1,n,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/gauher.c b/lib/nr/ansi/recipes/gauher.c new file mode 100644 index 0000000..353c2c0 --- /dev/null +++ b/lib/nr/ansi/recipes/gauher.c @@ -0,0 +1,48 @@ + +#include +#define EPS 3.0e-14 +#define PIM4 0.7511255444649425 +#define MAXIT 10 + +void gauher(float x[], float w[], int n) +{ + void nrerror(char error_text[]); + int i,its,j,m; + double p1,p2,p3,pp,z,z1; + + m=(n+1)/2; + for (i=1;i<=m;i++) { + if (i == 1) { + z=sqrt((double)(2*n+1))-1.85575*pow((double)(2*n+1),-0.16667); + } else if (i == 2) { + z -= 1.14*pow((double)n,0.426)/z; + } else if (i == 3) { + z=1.86*z-0.86*x[1]; + } else if (i == 4) { + z=1.91*z-0.91*x[2]; + } else { + z=2.0*z-x[i-2]; + } + for (its=1;its<=MAXIT;its++) { + p1=PIM4; + p2=0.0; + for (j=1;j<=n;j++) { + p3=p2; + p2=p1; + p1=z*sqrt(2.0/j)*p2-sqrt(((double)(j-1))/j)*p3; + } + pp=sqrt((double)2*n)*p2; + z1=z; + z=z1-p1/pp; + if (fabs(z-z1) <= EPS) break; + } + if (its > MAXIT) nrerror("too many iterations in gauher"); + x[i]=z; + x[n+1-i] = -z; + w[i]=2.0/(pp*pp); + w[n+1-i]=w[i]; + } +} +#undef EPS +#undef PIM4 +#undef MAXIT diff --git a/lib/nr/ansi/recipes/gaujac.c b/lib/nr/ansi/recipes/gaujac.c new file mode 100644 index 0000000..a24fddb --- /dev/null +++ b/lib/nr/ansi/recipes/gaujac.c @@ -0,0 +1,70 @@ + +#include +#define EPS 3.0e-14 +#define MAXIT 10 + +void gaujac(float x[], float w[], int n, float alf, float bet) +{ + float gammln(float xx); + void nrerror(char error_text[]); + int i,its,j; + float alfbet,an,bn,r1,r2,r3; + double a,b,c,p1,p2,p3,pp,temp,z,z1; + + for (i=1;i<=n;i++) { + if (i == 1) { + an=alf/n; + bn=bet/n; + r1=(1.0+alf)*(2.78/(4.0+n*n)+0.768*an/n); + r2=1.0+1.48*an+0.96*bn+0.452*an*an+0.83*an*bn; + z=1.0-r1/r2; + } else if (i == 2) { + r1=(4.1+alf)/((1.0+alf)*(1.0+0.156*alf)); + r2=1.0+0.06*(n-8.0)*(1.0+0.12*alf)/n; + r3=1.0+0.012*bet*(1.0+0.25*fabs(alf))/n; + z -= (1.0-z)*r1*r2*r3; + } else if (i == 3) { + r1=(1.67+0.28*alf)/(1.0+0.37*alf); + r2=1.0+0.22*(n-8.0)/n; + r3=1.0+8.0*bet/((6.28+bet)*n*n); + z -= (x[1]-z)*r1*r2*r3; + } else if (i == n-1) { + r1=(1.0+0.235*bet)/(0.766+0.119*bet); + r2=1.0/(1.0+0.639*(n-4.0)/(1.0+0.71*(n-4.0))); + r3=1.0/(1.0+20.0*alf/((7.5+alf)*n*n)); + z += (z-x[n-3])*r1*r2*r3; + } else if (i == n) { + r1=(1.0+0.37*bet)/(1.67+0.28*bet); + r2=1.0/(1.0+0.22*(n-8.0)/n); + r3=1.0/(1.0+8.0*alf/((6.28+alf)*n*n)); + z += (z-x[n-2])*r1*r2*r3; + } else { + z=3.0*x[i-1]-3.0*x[i-2]+x[i-3]; + } + alfbet=alf+bet; + for (its=1;its<=MAXIT;its++) { + temp=2.0+alfbet; + p1=(alf-bet+temp*z)/2.0; + p2=1.0; + for (j=2;j<=n;j++) { + p3=p2; + p2=p1; + temp=2*j+alfbet; + a=2*j*(j+alfbet)*(temp-2.0); + b=(temp-1.0)*(alf*alf-bet*bet+temp*(temp-2.0)*z); + c=2.0*(j-1+alf)*(j-1+bet)*temp; + p1=(b*p2-c*p3)/a; + } + pp=(n*(alf-bet-temp*z)*p1+2.0*(n+alf)*(n+bet)*p2)/(temp*(1.0-z*z)); + z1=z; + z=z1-p1/pp; + if (fabs(z-z1) <= EPS) break; + } + if (its > MAXIT) nrerror("too many iterations in gaujac"); + x[i]=z; + w[i]=exp(gammln(alf+n)+gammln(bet+n)-gammln(n+1.0)- + gammln(n+alfbet+1.0))*temp*pow(2.0,alfbet)/(pp*p2); + } +} +#undef EPS +#undef MAXIT diff --git a/lib/nr/ansi/recipes/gaulag.c b/lib/nr/ansi/recipes/gaulag.c new file mode 100644 index 0000000..29ae0e2 --- /dev/null +++ b/lib/nr/ansi/recipes/gaulag.c @@ -0,0 +1,43 @@ + +#include +#define EPS 3.0e-14 +#define MAXIT 10 + +void gaulag(float x[], float w[], int n, float alf) +{ + float gammln(float xx); + void nrerror(char error_text[]); + int i,its,j; + float ai; + double p1,p2,p3,pp,z,z1; + + for (i=1;i<=n;i++) { + if (i == 1) { + z=(1.0+alf)*(3.0+0.92*alf)/(1.0+2.4*n+1.8*alf); + } else if (i == 2) { + z += (15.0+6.25*alf)/(1.0+0.9*alf+2.5*n); + } else { + ai=i-2; + z += ((1.0+2.55*ai)/(1.9*ai)+1.26*ai*alf/ + (1.0+3.5*ai))*(z-x[i-2])/(1.0+0.3*alf); + } + for (its=1;its<=MAXIT;its++) { + p1=1.0; + p2=0.0; + for (j=1;j<=n;j++) { + p3=p2; + p2=p1; + p1=((2*j-1+alf-z)*p2-(j-1+alf)*p3)/j; + } + pp=(n*p1-(n+alf)*p2)/z; + z1=z; + z=z1-p1/pp; + if (fabs(z-z1) <= EPS) break; + } + if (its > MAXIT) nrerror("too many iterations in gaulag"); + x[i]=z; + w[i] = -exp(gammln(alf+n)-gammln((float)n))/(pp*n*p2); + } +} +#undef EPS +#undef MAXIT diff --git a/lib/nr/ansi/recipes/gauleg.c b/lib/nr/ansi/recipes/gauleg.c new file mode 100644 index 0000000..6d7eacc --- /dev/null +++ b/lib/nr/ansi/recipes/gauleg.c @@ -0,0 +1,33 @@ + +#include +#define EPS 3.0e-11 + +void gauleg(float x1, float x2, float x[], float w[], int n) +{ + int m,j,i; + double z1,z,xm,xl,pp,p3,p2,p1; + + m=(n+1)/2; + xm=0.5*(x2+x1); + xl=0.5*(x2-x1); + for (i=1;i<=m;i++) { + z=cos(3.141592654*(i-0.25)/(n+0.5)); + do { + p1=1.0; + p2=0.0; + for (j=1;j<=n;j++) { + p3=p2; + p2=p1; + p1=((2.0*j-1.0)*z*p2-(j-1.0)*p3)/j; + } + pp=n*(z*p1-p2)/(z*z-1.0); + z1=z; + z=z1-p1/pp; + } while (fabs(z-z1) > EPS); + x[i]=xm-xl*z; + x[n+1-i]=xm+xl*z; + w[i]=2.0*xl/((1.0-z*z)*pp*pp); + w[n+1-i]=w[i]; + } +} +#undef EPS diff --git a/lib/nr/ansi/recipes/gaussj.c b/lib/nr/ansi/recipes/gaussj.c new file mode 100644 index 0000000..1ace074 --- /dev/null +++ b/lib/nr/ansi/recipes/gaussj.c @@ -0,0 +1,60 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define SWAP(a,b) {temp=(a);(a)=(b);(b)=temp;} + +void gaussj(float **a, int n, float **b, int m) +{ + int *indxc,*indxr,*ipiv; + int i,icol,irow,j,k,l,ll; + float big,dum,pivinv,temp; + + indxc=ivector(1,n); + indxr=ivector(1,n); + ipiv=ivector(1,n); + for (j=1;j<=n;j++) ipiv[j]=0; + for (i=1;i<=n;i++) { + big=0.0; + for (j=1;j<=n;j++) + if (ipiv[j] != 1) + for (k=1;k<=n;k++) { + if (ipiv[k] == 0) { + if (fabs(a[j][k]) >= big) { + big=fabs(a[j][k]); + irow=j; + icol=k; + } + } + } + ++(ipiv[icol]); + if (irow != icol) { + for (l=1;l<=n;l++) SWAP(a[irow][l],a[icol][l]) + for (l=1;l<=m;l++) SWAP(b[irow][l],b[icol][l]) + } + indxr[i]=irow; + indxc[i]=icol; + if (a[icol][icol] == 0.0) nrerror("gaussj: Singular Matrix"); + pivinv=1.0/a[icol][icol]; + a[icol][icol]=1.0; + for (l=1;l<=n;l++) a[icol][l] *= pivinv; + for (l=1;l<=m;l++) b[icol][l] *= pivinv; + for (ll=1;ll<=n;ll++) + if (ll != icol) { + dum=a[ll][icol]; + a[ll][icol]=0.0; + for (l=1;l<=n;l++) a[ll][l] -= a[icol][l]*dum; + for (l=1;l<=m;l++) b[ll][l] -= b[icol][l]*dum; + } + } + for (l=n;l>=1;l--) { + if (indxr[l] != indxc[l]) + for (k=1;k<=n;k++) + SWAP(a[k][indxr[l]],a[k][indxc[l]]); + } + free_ivector(ipiv,1,n); + free_ivector(indxr,1,n); + free_ivector(indxc,1,n); +} +#undef SWAP +#undef NRANSI diff --git a/lib/nr/ansi/recipes/gcf.c b/lib/nr/ansi/recipes/gcf.c new file mode 100644 index 0000000..0b0351f --- /dev/null +++ b/lib/nr/ansi/recipes/gcf.c @@ -0,0 +1,36 @@ + +#include +#define ITMAX 100 +#define EPS 3.0e-7 +#define FPMIN 1.0e-30 + +void gcf(float *gammcf, float a, float x, float *gln) +{ + float gammln(float xx); + void nrerror(char error_text[]); + int i; + float an,b,c,d,del,h; + + *gln=gammln(a); + b=x+1.0-a; + c=1.0/FPMIN; + d=1.0/b; + h=d; + for (i=1;i<=ITMAX;i++) { + an = -i*(i-a); + b += 2.0; + d=an*d+b; + if (fabs(d) < FPMIN) d=FPMIN; + c=b+an/c; + if (fabs(c) < FPMIN) c=FPMIN; + d=1.0/d; + del=d*c; + h *= del; + if (fabs(del-1.0) < EPS) break; + } + if (i > ITMAX) nrerror("a too large, ITMAX too small in gcf"); + *gammcf=exp(-x+a*log(x)-(*gln))*h; +} +#undef ITMAX +#undef EPS +#undef FPMIN diff --git a/lib/nr/ansi/recipes/golden.c b/lib/nr/ansi/recipes/golden.c new file mode 100644 index 0000000..f2527fd --- /dev/null +++ b/lib/nr/ansi/recipes/golden.c @@ -0,0 +1,44 @@ + +#include +#define R 0.61803399 +#define C (1.0-R) +#define SHFT2(a,b,c) (a)=(b);(b)=(c); +#define SHFT3(a,b,c,d) (a)=(b);(b)=(c);(c)=(d); + +float golden(float ax, float bx, float cx, float (*f)(float), float tol, + float *xmin) +{ + float f1,f2,x0,x1,x2,x3; + + x0=ax; + x3=cx; + if (fabs(cx-bx) > fabs(bx-ax)) { + x1=bx; + x2=bx+C*(cx-bx); + } else { + x2=bx; + x1=bx-C*(bx-ax); + } + f1=(*f)(x1); + f2=(*f)(x2); + while (fabs(x3-x0) > tol*(fabs(x1)+fabs(x2))) { + if (f2 < f1) { + SHFT3(x0,x1,x2,R*x1+C*x3) + SHFT2(f1,f2,(*f)(x2)) + } else { + SHFT3(x3,x2,x1,R*x2+C*x0) + SHFT2(f2,f1,(*f)(x1)) + } + } + if (f1 < f2) { + *xmin=x1; + return f1; + } else { + *xmin=x2; + return f2; + } +} +#undef C +#undef R +#undef SHFT2 +#undef SHFT3 diff --git a/lib/nr/ansi/recipes/gser.c b/lib/nr/ansi/recipes/gser.c new file mode 100644 index 0000000..ebc1b4d --- /dev/null +++ b/lib/nr/ansi/recipes/gser.c @@ -0,0 +1,35 @@ + +#include +#define ITMAX 100 +#define EPS 3.0e-7 + +void gser(float *gamser, float a, float x, float *gln) +{ + float gammln(float xx); + void nrerror(char error_text[]); + int n; + float sum,del,ap; + + *gln=gammln(a); + if (x <= 0.0) { + if (x < 0.0) nrerror("x less than 0 in routine gser"); + *gamser=0.0; + return; + } else { + ap=a; + del=sum=1.0/a; + for (n=1;n<=ITMAX;n++) { + ++ap; + del *= x/ap; + sum += del; + if (fabs(del) < fabs(sum)*EPS) { + *gamser=sum*exp(-x+a*log(x)-(*gln)); + return; + } + } + nrerror("a too large, ITMAX too small in routine gser"); + return; + } +} +#undef ITMAX +#undef EPS diff --git a/lib/nr/ansi/recipes/hpsel.c b/lib/nr/ansi/recipes/hpsel.c new file mode 100644 index 0000000..9d1c0d3 --- /dev/null +++ b/lib/nr/ansi/recipes/hpsel.c @@ -0,0 +1,27 @@ + +void hpsel(unsigned long m, unsigned long n, float arr[], float heap[]) +{ + void sort(unsigned long n, float arr[]); + void nrerror(char error_text[]); + unsigned long i,j,k; + float swap; + + if (m > n/2 || m < 1) nrerror("probable misuse of hpsel"); + for (i=1;i<=m;i++) heap[i]=arr[i]; + sort(m,heap); + for (i=m+1;i<=n;i++) { + if (arr[i] > heap[1]) { + heap[1]=arr[i]; + for (j=1;;) { + k=j << 1; + if (k > m) break; + if (k != m && heap[k] > heap[k+1]) k++; + if (heap[j] <= heap[k]) break; + swap=heap[k]; + heap[k]=heap[j]; + heap[j]=swap; + j=k; + } + } + } +} diff --git a/lib/nr/ansi/recipes/hpsort.c b/lib/nr/ansi/recipes/hpsort.c new file mode 100644 index 0000000..20b9585 --- /dev/null +++ b/lib/nr/ansi/recipes/hpsort.c @@ -0,0 +1,33 @@ + +void hpsort(unsigned long n, float ra[]) +{ + unsigned long i,ir,j,l; + float rra; + + if (n < 2) return; + l=(n >> 1)+1; + ir=n; + for (;;) { + if (l > 1) { + rra=ra[--l]; + } else { + rra=ra[ir]; + ra[ir]=ra[1]; + if (--ir == 1) { + ra[1]=rra; + break; + } + } + i=l; + j=l+l; + while (j <= ir) { + if (j < ir && ra[j] < ra[j+1]) j++; + if (rra < ra[j]) { + ra[i]=ra[j]; + i=j; + j <<= 1; + } else break; + } + ra[i]=rra; + } +} diff --git a/lib/nr/ansi/recipes/hqr.c b/lib/nr/ansi/recipes/hqr.c new file mode 100644 index 0000000..aac7d4f --- /dev/null +++ b/lib/nr/ansi/recipes/hqr.c @@ -0,0 +1,130 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void hqr(float **a, int n, float wr[], float wi[]) +{ + int nn,m,l,k,j,its,i,mmin; + float z,y,x,w,v,u,t,s,r,q,p,anorm; + + anorm=0.0; + for (i=1;i<=n;i++) + for (j=IMAX(i-1,1);j<=n;j++) + anorm += fabs(a[i][j]); + nn=n; + t=0.0; + while (nn >= 1) { + its=0; + do { + for (l=nn;l>=2;l--) { + s=fabs(a[l-1][l-1])+fabs(a[l][l]); + if (s == 0.0) s=anorm; + if ((float)(fabs(a[l][l-1]) + s) == s) { + a[l][l-1]=0.0; + break; + } + } + x=a[nn][nn]; + if (l == nn) { + wr[nn]=x+t; + wi[nn--]=0.0; + } else { + y=a[nn-1][nn-1]; + w=a[nn][nn-1]*a[nn-1][nn]; + if (l == (nn-1)) { + p=0.5*(y-x); + q=p*p+w; + z=sqrt(fabs(q)); + x += t; + if (q >= 0.0) { + z=p+SIGN(z,p); + wr[nn-1]=wr[nn]=x+z; + if (z) wr[nn]=x-w/z; + wi[nn-1]=wi[nn]=0.0; + } else { + wr[nn-1]=wr[nn]=x+p; + wi[nn-1]= -(wi[nn]=z); + } + nn -= 2; + } else { + if (its == 30) nrerror("Too many iterations in hqr"); + if (its == 10 || its == 20) { + t += x; + for (i=1;i<=nn;i++) a[i][i] -= x; + s=fabs(a[nn][nn-1])+fabs(a[nn-1][nn-2]); + y=x=0.75*s; + w = -0.4375*s*s; + } + ++its; + for (m=(nn-2);m>=l;m--) { + z=a[m][m]; + r=x-z; + s=y-z; + p=(r*s-w)/a[m+1][m]+a[m][m+1]; + q=a[m+1][m+1]-z-r-s; + r=a[m+2][m+1]; + s=fabs(p)+fabs(q)+fabs(r); + p /= s; + q /= s; + r /= s; + if (m == l) break; + u=fabs(a[m][m-1])*(fabs(q)+fabs(r)); + v=fabs(p)*(fabs(a[m-1][m-1])+fabs(z)+fabs(a[m+1][m+1])); + if ((float)(u+v) == v) break; + } + for (i=m+2;i<=nn;i++) { + a[i][i-2]=0.0; + if (i != (m+2)) a[i][i-3]=0.0; + } + for (k=m;k<=nn-1;k++) { + if (k != m) { + p=a[k][k-1]; + q=a[k+1][k-1]; + r=0.0; + if (k != (nn-1)) r=a[k+2][k-1]; + if ((x=fabs(p)+fabs(q)+fabs(r)) != 0.0) { + p /= x; + q /= x; + r /= x; + } + } + if ((s=SIGN(sqrt(p*p+q*q+r*r),p)) != 0.0) { + if (k == m) { + if (l != m) + a[k][k-1] = -a[k][k-1]; + } else + a[k][k-1] = -s*x; + p += s; + x=p/s; + y=q/s; + z=r/s; + q /= p; + r /= p; + for (j=k;j<=nn;j++) { + p=a[k][j]+q*a[k+1][j]; + if (k != (nn-1)) { + p += r*a[k+2][j]; + a[k+2][j] -= p*z; + } + a[k+1][j] -= p*y; + a[k][j] -= p*x; + } + mmin = nn>1)) { + if ((j = i << 1) < n && nprob[index[j]] > nprob[index[j+1]]) j++; + if (nprob[k] <= nprob[index[j]]) break; + index[i]=index[j]; + i=j; + } + index[i]=k; +} diff --git a/lib/nr/ansi/recipes/hufdec.c b/lib/nr/ansi/recipes/hufdec.c new file mode 100644 index 0000000..36f236d --- /dev/null +++ b/lib/nr/ansi/recipes/hufdec.c @@ -0,0 +1,26 @@ + +typedef struct { + unsigned long *icod,*ncod,*left,*right,nch,nodemax; +} huffcode; + +void hufdec(unsigned long *ich, unsigned char *code, unsigned long lcode, + unsigned long *nb, huffcode *hcode) +{ + long nc,node; + static unsigned char setbit[8]={0x1,0x2,0x4,0x8,0x10,0x20,0x40,0x80}; + + node=hcode->nodemax; + for (;;) { + nc=(*nb >> 3); + if (++nc > lcode) { + *ich=hcode->nch; + return; + } + node=(code[nc] & setbit[7 & (*nb)++] ? + hcode->right[node] : hcode->left[node]); + if (node <= hcode->nch) { + *ich=node-1; + return; + } + } +} diff --git a/lib/nr/ansi/recipes/hufenc.c b/lib/nr/ansi/recipes/hufenc.c new file mode 100644 index 0000000..e8befdf --- /dev/null +++ b/lib/nr/ansi/recipes/hufenc.c @@ -0,0 +1,38 @@ + +#include +#include + +typedef struct { + unsigned long *icod,*ncod,*left,*right,nch,nodemax; +} huffcode; + +void hufenc(unsigned long ich, unsigned char **codep, unsigned long *lcode, + unsigned long *nb, huffcode *hcode) +{ + void nrerror(char error_text[]); + int l,n; + unsigned long k,nc; + static unsigned long setbit[32]={0x1L,0x2L,0x4L,0x8L,0x10L,0x20L, + 0x40L,0x80L,0x100L,0x200L,0x400L,0x800L,0x1000L,0x2000L, + 0x4000L,0x8000L,0x10000L,0x20000L,0x40000L,0x80000L,0x100000L, + 0x200000L,0x400000L,0x800000L,0x1000000L,0x2000000L,0x4000000L, + 0x8000000L,0x10000000L,0x20000000L,0x40000000L,0x80000000L}; + + k=ich+1; + if (k > hcode->nch || k < 1) nrerror("ich out of range in hufenc."); + for (n=hcode->ncod[k]-1;n>=0;n--,++(*nb)) { + nc=(*nb >> 3); + if (++nc >= *lcode) { + fprintf(stderr,"Reached the end of the 'code' array.\n"); + fprintf(stderr,"Attempting to expand its size.\n"); + *lcode *= 1.5; + if ((*codep=(unsigned char *)realloc(*codep, + (unsigned)(*lcode*sizeof(unsigned char)))) == NULL) { + nrerror("Size expansion failed."); + } + } + l=(*nb) & 7; + if (!l) (*codep)[nc]=0; + if (hcode->icod[k] & setbit[n]) (*codep)[nc] |= setbit[l]; + } +} diff --git a/lib/nr/ansi/recipes/hufmak.c b/lib/nr/ansi/recipes/hufmak.c new file mode 100644 index 0000000..d07b24a --- /dev/null +++ b/lib/nr/ansi/recipes/hufmak.c @@ -0,0 +1,69 @@ + +#define NRANSI +#include "nrutil.h" + +typedef struct { + unsigned long *icod,*ncod,*left,*right,nch,nodemax; +} huffcode; + +void hufmak(unsigned long nfreq[], unsigned long nchin, unsigned long *ilong, + unsigned long *nlong, huffcode *hcode) +{ + void hufapp(unsigned long index[], unsigned long nprob[], unsigned long n, + unsigned long i); + int ibit; + long node,*up; + unsigned long j,k,*index,n,nused,*nprob; + static unsigned long setbit[32]={0x1L,0x2L,0x4L,0x8L,0x10L,0x20L, + 0x40L,0x80L,0x100L,0x200L,0x400L,0x800L,0x1000L,0x2000L, + 0x4000L,0x8000L,0x10000L,0x20000L,0x40000L,0x80000L,0x100000L, + 0x200000L,0x400000L,0x800000L,0x1000000L,0x2000000L,0x4000000L, + 0x8000000L,0x10000000L,0x20000000L,0x40000000L,0x80000000L}; + + hcode->nch=nchin; + index=lvector(1,(long)(2*hcode->nch-1)); + up=(long *)lvector(1,(long)(2*hcode->nch-1)); + nprob=lvector(1,(long)(2*hcode->nch-1)); + for (nused=0,j=1;j<=hcode->nch;j++) { + nprob[j]=nfreq[j]; + hcode->icod[j]=hcode->ncod[j]=0; + if (nfreq[j]) index[++nused]=j; + } + for (j=nused;j>=1;j--) hufapp(index,nprob,nused,j); + k=hcode->nch; + while (nused > 1) { + node=index[1]; + index[1]=index[nused--]; + hufapp(index,nprob,nused,1); + nprob[++k]=nprob[index[1]]+nprob[node]; + hcode->left[k]=node; + hcode->right[k]=index[1]; + up[index[1]] = -(long)k; + up[node]=index[1]=k; + hufapp(index,nprob,nused,1); + } + up[hcode->nodemax=k]=0; + for (j=1;j<=hcode->nch;j++) { + if (nprob[j]) { + for (n=0,ibit=0,node=up[j];node;node=up[node],ibit++) { + if (node < 0) { + n |= setbit[ibit]; + node = -node; + } + } + hcode->icod[j]=n; + hcode->ncod[j]=ibit; + } + } + *nlong=0; + for (j=1;j<=hcode->nch;j++) { + if (hcode->ncod[j] > *nlong) { + *nlong=hcode->ncod[j]; + *ilong=j-1; + } + } + free_lvector(nprob,1,(long)(2*hcode->nch-1)); + free_lvector((unsigned long *)up,1,(long)(2*hcode->nch-1)); + free_lvector(index,1,(long)(2*hcode->nch-1)); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/hunt.c b/lib/nr/ansi/recipes/hunt.c new file mode 100644 index 0000000..97b8e85 --- /dev/null +++ b/lib/nr/ansi/recipes/hunt.c @@ -0,0 +1,51 @@ + +void hunt(float xx[], unsigned long n, float x, unsigned long *jlo) +{ + unsigned long jm,jhi,inc; + int ascnd; + + ascnd=(xx[n] >= xx[1]); + if (*jlo <= 0 || *jlo > n) { + *jlo=0; + jhi=n+1; + } else { + inc=1; + if (x >= xx[*jlo] == ascnd) { + if (*jlo == n) return; + jhi=(*jlo)+1; + while (x >= xx[jhi] == ascnd) { + *jlo=jhi; + inc += inc; + jhi=(*jlo)+inc; + if (jhi > n) { + jhi=n+1; + break; + } + } + } else { + if (*jlo == 1) { + *jlo=0; + return; + } + jhi=(*jlo)--; + while (x < xx[*jlo] == ascnd) { + jhi=(*jlo); + inc <<= 1; + if (inc >= jhi) { + *jlo=0; + break; + } + else *jlo=jhi-inc; + } + } + } + while (jhi-(*jlo) != 1) { + jm=(jhi+(*jlo)) >> 1; + if (x >= xx[jm] == ascnd) + *jlo=jm; + else + jhi=jm; + } + if (x == xx[n]) *jlo=n-1; + if (x == xx[1]) *jlo=1; +} diff --git a/lib/nr/ansi/recipes/hypdrv.c b/lib/nr/ansi/recipes/hypdrv.c new file mode 100644 index 0000000..cdfb254 --- /dev/null +++ b/lib/nr/ansi/recipes/hypdrv.c @@ -0,0 +1,23 @@ + +#include "complex.h" +#define ONE Complex(1.0,0.0) + +extern fcomplex aa,bb,cc,z0,dz; + +void hypdrv(float s, float yy[], float dyyds[]) +{ + fcomplex z,y[3],dyds[3]; + + y[1]=Complex(yy[1],yy[2]); + y[2]=Complex(yy[3],yy[4]); + z=Cadd(z0,RCmul(s,dz)); + dyds[1]=Cmul(y[2],dz); + dyds[2]=Cmul(Csub(Cmul(Cmul(aa,bb),y[1]),Cmul(Csub(cc, + Cmul(Cadd(Cadd(aa,bb),ONE),z)),y[2])), + Cdiv(dz,Cmul(z,Csub(ONE,z)))); + dyyds[1]=dyds[1].r; + dyyds[2]=dyds[1].i; + dyyds[3]=dyds[2].r; + dyyds[4]=dyds[2].i; +} +#undef ONE diff --git a/lib/nr/ansi/recipes/hypgeo.c b/lib/nr/ansi/recipes/hypgeo.c new file mode 100644 index 0000000..80900d2 --- /dev/null +++ b/lib/nr/ansi/recipes/hypgeo.c @@ -0,0 +1,54 @@ + +#include +#include "complex.h" +#define NRANSI +#include "nrutil.h" +#define EPS 1.0e-6 + +fcomplex aa,bb,cc,z0,dz; + +int kmax,kount; +float *xp,**yp,dxsav; + +fcomplex hypgeo(fcomplex a, fcomplex b, fcomplex c, fcomplex z) +{ + void bsstep(float y[], float dydx[], int nv, float *xx, float htry, + float eps, float yscal[], float *hdid, float *hnext, + void (*derivs)(float, float [], float [])); + void hypdrv(float s, float yy[], float dyyds[]); + void hypser(fcomplex a, fcomplex b, fcomplex c, fcomplex z, + fcomplex *series, fcomplex *deriv); + void odeint(float ystart[], int nvar, float x1, float x2, + float eps, float h1, float hmin, int *nok, int *nbad, + void (*derivs)(float, float [], float []), + void (*rkqs)(float [], float [], int, float *, float, float, + float [], float *, float *, void (*)(float, float [], float []))); + int nbad,nok; + fcomplex ans,y[3]; + float *yy; + + kmax=0; + if (z.r*z.r+z.i*z.i <= 0.25) { + hypser(a,b,c,z,&ans,&y[2]); + return ans; + } + else if (z.r < 0.0) z0=Complex(-0.5,0.0); + else if (z.r <= 1.0) z0=Complex(0.5,0.0); + else z0=Complex(0.0,z.i >= 0.0 ? 0.5 : -0.5); + aa=a; + bb=b; + cc=c; + dz=Csub(z,z0); + hypser(aa,bb,cc,z0,&y[1],&y[2]); + yy=vector(1,4); + yy[1]=y[1].r; + yy[2]=y[1].i; + yy[3]=y[2].r; + yy[4]=y[2].i; + odeint(yy,4,0.0,1.0,EPS,0.1,0.0001,&nok,&nbad,hypdrv,bsstep); + y[1]=Complex(yy[1],yy[2]); + free_vector(yy,1,4); + return y[1]; +} +#undef EPS +#undef NRANSI diff --git a/lib/nr/ansi/recipes/hypser.c b/lib/nr/ansi/recipes/hypser.c new file mode 100644 index 0000000..63390c9 --- /dev/null +++ b/lib/nr/ansi/recipes/hypser.c @@ -0,0 +1,34 @@ + +#include "complex.h" +#define ONE Complex(1.0,0.0) + +void hypser(fcomplex a, fcomplex b, fcomplex c, fcomplex z, fcomplex *series, + fcomplex *deriv) +{ + void nrerror(char error_text[]); + int n; + fcomplex aa,bb,cc,fac,temp; + + deriv->r=0.0; + deriv->i=0.0; + fac=Complex(1.0,0.0); + temp=fac; + aa=a; + bb=b; + cc=c; + for (n=1;n<=1000;n++) { + fac=Cmul(fac,Cdiv(Cmul(aa,bb),cc)); + deriv->r+=fac.r; + deriv->i+=fac.i; + fac=Cmul(fac,RCmul(1.0/n,z)); + *series=Cadd(temp,fac); + if (series->r == temp.r && series->i == temp.i) return; + temp= *series; + aa=Cadd(aa,ONE); + bb=Cadd(bb,ONE); + cc=Cadd(cc,ONE); + + } + nrerror("convergence failure in hypser"); +} +#undef ONE diff --git a/lib/nr/ansi/recipes/icrc.c b/lib/nr/ansi/recipes/icrc.c new file mode 100644 index 0000000..9707ca4 --- /dev/null +++ b/lib/nr/ansi/recipes/icrc.c @@ -0,0 +1,30 @@ + +typedef unsigned char uchar; +#define LOBYTE(x) ((uchar)((x) & 0xFF)) +#define HIBYTE(x) ((uchar)((x) >> 8)) + +unsigned short icrc(unsigned short crc, unsigned char *bufptr, + unsigned long len, short jinit, int jrev) +{ + unsigned short icrc1(unsigned short crc, unsigned char onech); + static unsigned short icrctb[256],init=0; + static uchar rchr[256]; + unsigned short j,cword=crc; + static uchar it[16]={0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15}; + + if (!init) { + init=1; + for (j=0;j<=255;j++) { + icrctb[j]=icrc1(j << 8,(uchar)0); + rchr[j]=(uchar)(it[j & 0xF] << 4 | it[j >> 4]); + } + } + if (jinit >= 0) cword=((uchar) jinit) | (((uchar) jinit) << 8); + else if (jrev < 0) cword=rchr[HIBYTE(cword)] | rchr[LOBYTE(cword)] << 8; + for (j=1;j<=len;j++) + cword=icrctb[(jrev < 0 ? rchr[bufptr[j]] : + bufptr[j]) ^ HIBYTE(cword)] ^ LOBYTE(cword) << 8; + return (jrev >= 0 ? cword : rchr[HIBYTE(cword)] | rchr[LOBYTE(cword)] << 8); +} +#undef LOBYTE +#undef HIBYTE diff --git a/lib/nr/ansi/recipes/icrc1.c b/lib/nr/ansi/recipes/icrc1.c new file mode 100644 index 0000000..62e6aef --- /dev/null +++ b/lib/nr/ansi/recipes/icrc1.c @@ -0,0 +1,14 @@ + +unsigned short icrc1(unsigned short crc, unsigned char onech) +{ + int i; + unsigned short ans=(crc ^ onech << 8); + + for (i=0;i<8;i++) { + if (ans & 0x8000) + ans = (ans <<= 1) ^ 4129; + else + ans <<= 1; + } + return ans; +} diff --git a/lib/nr/ansi/recipes/igray.c b/lib/nr/ansi/recipes/igray.c new file mode 100644 index 0000000..404e4f3 --- /dev/null +++ b/lib/nr/ansi/recipes/igray.c @@ -0,0 +1,16 @@ + +unsigned long igray(unsigned long n, int is) +{ + int ish; + unsigned long ans,idiv; + + if (is >= 0) + return n ^ (n >> 1); + ish=1; + ans=n; + for (;;) { + ans ^= (idiv=ans >> ish); + if (idiv <= 1 || ish == 16) return ans; + ish <<= 1; + } +} diff --git a/lib/nr/ansi/recipes/iindexx.c b/lib/nr/ansi/recipes/iindexx.c new file mode 100644 index 0000000..f98be0b --- /dev/null +++ b/lib/nr/ansi/recipes/iindexx.c @@ -0,0 +1,72 @@ + +#define NRANSI +#include "nrutil.h" +#define SWAP(a,b) itemp=(a);(a)=(b);(b)=itemp; +#define M 7 +#define NSTACK 50 + +void iindexx(unsigned long n, long arr[], unsigned long indx[]) +{ + unsigned long i,indxt,ir=n,itemp,j,k,l=1; + int jstack=0,*istack; + long a; + + istack=ivector(1,NSTACK); + for (j=1;j<=n;j++) indx[j]=j; + for (;;) { + if (ir-l < M) { + for (j=l+1;j<=ir;j++) { + indxt=indx[j]; + a=arr[indxt]; + for (i=j-1;i>=l;i--) { + if (arr[indx[i]] <= a) break; + indx[i+1]=indx[i]; + } + indx[i+1]=indxt; + } + if (jstack == 0) break; + ir=istack[jstack--]; + l=istack[jstack--]; + } else { + k=(l+ir) >> 1; + SWAP(indx[k],indx[l+1]); + if (arr[indx[l]] > arr[indx[ir]]) { + SWAP(indx[l],indx[ir]) + } + if (arr[indx[l+1]] > arr[indx[ir]]) { + SWAP(indx[l+1],indx[ir]) + } + if (arr[indx[l]] > arr[indx[l+1]]) { + SWAP(indx[l],indx[l+1]) + } + i=l+1; + j=ir; + indxt=indx[l+1]; + a=arr[indxt]; + for (;;) { + do i++; while (arr[indx[i]] < a); + do j--; while (arr[indx[j]] > a); + if (j < i) break; + SWAP(indx[i],indx[j]) + } + indx[l+1]=indx[j]; + indx[j]=indxt; + jstack += 2; + if (jstack > NSTACK) nrerror("NSTACK too small in iindexx."); + if (ir-i+1 >= j-l) { + istack[jstack]=ir; + istack[jstack-1]=i; + ir=j-1; + } else { + istack[jstack]=j-1; + istack[jstack-1]=l; + l=i; + } + } + } + free_ivector(istack,1,NSTACK); +} +#undef M +#undef NSTACK +#undef SWAP +#undef NRANSI diff --git a/lib/nr/ansi/recipes/indexx.c b/lib/nr/ansi/recipes/indexx.c new file mode 100644 index 0000000..c5d2a32 --- /dev/null +++ b/lib/nr/ansi/recipes/indexx.c @@ -0,0 +1,72 @@ + +#define NRANSI +#include "nrutil.h" +#define SWAP(a,b) itemp=(a);(a)=(b);(b)=itemp; +#define M 7 +#define NSTACK 50 + +void indexx(unsigned long n, float arr[], unsigned long indx[]) +{ + unsigned long i,indxt,ir=n,itemp,j,k,l=1; + int jstack=0,*istack; + float a; + + istack=ivector(1,NSTACK); + for (j=1;j<=n;j++) indx[j]=j; + for (;;) { + if (ir-l < M) { + for (j=l+1;j<=ir;j++) { + indxt=indx[j]; + a=arr[indxt]; + for (i=j-1;i>=l;i--) { + if (arr[indx[i]] <= a) break; + indx[i+1]=indx[i]; + } + indx[i+1]=indxt; + } + if (jstack == 0) break; + ir=istack[jstack--]; + l=istack[jstack--]; + } else { + k=(l+ir) >> 1; + SWAP(indx[k],indx[l+1]); + if (arr[indx[l]] > arr[indx[ir]]) { + SWAP(indx[l],indx[ir]) + } + if (arr[indx[l+1]] > arr[indx[ir]]) { + SWAP(indx[l+1],indx[ir]) + } + if (arr[indx[l]] > arr[indx[l+1]]) { + SWAP(indx[l],indx[l+1]) + } + i=l+1; + j=ir; + indxt=indx[l+1]; + a=arr[indxt]; + for (;;) { + do i++; while (arr[indx[i]] < a); + do j--; while (arr[indx[j]] > a); + if (j < i) break; + SWAP(indx[i],indx[j]) + } + indx[l+1]=indx[j]; + indx[j]=indxt; + jstack += 2; + if (jstack > NSTACK) nrerror("NSTACK too small in indexx."); + if (ir-i+1 >= j-l) { + istack[jstack]=ir; + istack[jstack-1]=i; + ir=j-1; + } else { + istack[jstack]=j-1; + istack[jstack-1]=l; + l=i; + } + } + } + free_ivector(istack,1,NSTACK); +} +#undef M +#undef NSTACK +#undef SWAP +#undef NRANSI diff --git a/lib/nr/ansi/recipes/interp.c b/lib/nr/ansi/recipes/interp.c new file mode 100644 index 0000000..b29a75b --- /dev/null +++ b/lib/nr/ansi/recipes/interp.c @@ -0,0 +1,15 @@ + +void interp(double **uf, double **uc, int nf) +{ + int ic,iif,jc,jf,nc; + nc=nf/2+1; + for (jc=1,jf=1;jc<=nc;jc++,jf+=2) + for (ic=1;ic<=nc;ic++) uf[2*ic-1][jf]=uc[ic][jc]; + for (jf=1;jf<=nf;jf+=2) + for (iif=2;iif> 17) & 1 + ^ (*iseed >> 4) & 1 + ^ (*iseed >> 1) & 1 + ^ (*iseed & 1); + *iseed=(*iseed << 1) | newbit; + return (int) newbit; +} diff --git a/lib/nr/ansi/recipes/irbit2.c b/lib/nr/ansi/recipes/irbit2.c new file mode 100644 index 0000000..f914296 --- /dev/null +++ b/lib/nr/ansi/recipes/irbit2.c @@ -0,0 +1,22 @@ + +#define IB1 1 +#define IB2 2 +#define IB5 16 +#define IB18 131072 +#define MASK (IB1+IB2+IB5) + +int irbit2(unsigned long *iseed) +{ + if (*iseed & IB18) { + *iseed=((*iseed ^ MASK) << 1) | IB1; + return 1; + } else { + *iseed <<= 1; + return 0; + } +} +#undef MASK +#undef IB18 +#undef IB5 +#undef IB2 +#undef IB1 diff --git a/lib/nr/ansi/recipes/jacobi.c b/lib/nr/ansi/recipes/jacobi.c new file mode 100644 index 0000000..dd1ebf2 --- /dev/null +++ b/lib/nr/ansi/recipes/jacobi.c @@ -0,0 +1,88 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define ROTATE(a,i,j,k,l) g=a[i][j];h=a[k][l];a[i][j]=g-s*(h+g*tau);\ + a[k][l]=h+s*(g-h*tau); + +void jacobi(float **a, int n, float d[], float **v, int *nrot) +{ + int j,iq,ip,i; + float tresh,theta,tau,t,sm,s,h,g,c,*b,*z; + + b=vector(1,n); + z=vector(1,n); + for (ip=1;ip<=n;ip++) { + for (iq=1;iq<=n;iq++) v[ip][iq]=0.0; + v[ip][ip]=1.0; + } + for (ip=1;ip<=n;ip++) { + b[ip]=d[ip]=a[ip][ip]; + z[ip]=0.0; + } + *nrot=0; + for (i=1;i<=50;i++) { + sm=0.0; + for (ip=1;ip<=n-1;ip++) { + for (iq=ip+1;iq<=n;iq++) + sm += fabs(a[ip][iq]); + } + if (sm == 0.0) { + free_vector(z,1,n); + free_vector(b,1,n); + return; + } + if (i < 4) + tresh=0.2*sm/(n*n); + else + tresh=0.0; + for (ip=1;ip<=n-1;ip++) { + for (iq=ip+1;iq<=n;iq++) { + g=100.0*fabs(a[ip][iq]); + if (i > 4 && (float)(fabs(d[ip])+g) == (float)fabs(d[ip]) + && (float)(fabs(d[iq])+g) == (float)fabs(d[iq])) + a[ip][iq]=0.0; + else if (fabs(a[ip][iq]) > tresh) { + h=d[iq]-d[ip]; + if ((float)(fabs(h)+g) == (float)fabs(h)) + t=(a[ip][iq])/h; + else { + theta=0.5*h/(a[ip][iq]); + t=1.0/(fabs(theta)+sqrt(1.0+theta*theta)); + if (theta < 0.0) t = -t; + } + c=1.0/sqrt(1+t*t); + s=t*c; + tau=s/(1.0+c); + h=t*a[ip][iq]; + z[ip] -= h; + z[iq] += h; + d[ip] -= h; + d[iq] += h; + a[ip][iq]=0.0; + for (j=1;j<=ip-1;j++) { + ROTATE(a,j,ip,j,iq) + } + for (j=ip+1;j<=iq-1;j++) { + ROTATE(a,ip,j,j,iq) + } + for (j=iq+1;j<=n;j++) { + ROTATE(a,ip,j,iq,j) + } + for (j=1;j<=n;j++) { + ROTATE(v,j,ip,j,iq) + } + ++(*nrot); + } + } + } + for (ip=1;ip<=n;ip++) { + b[ip] += z[ip]; + d[ip]=b[ip]; + z[ip]=0.0; + } + } + nrerror("Too many iterations in routine jacobi"); +} +#undef ROTATE +#undef NRANSI diff --git a/lib/nr/ansi/recipes/jacobn.c b/lib/nr/ansi/recipes/jacobn.c new file mode 100644 index 0000000..ecb6845 --- /dev/null +++ b/lib/nr/ansi/recipes/jacobn.c @@ -0,0 +1,23 @@ + +void jacobn(float x, float y[], float dfdx[], float **dfdy, int n) +{ + int i; + + for (i=1;i<=n;i++) dfdx[i]=0.0; + dfdy[1][1] = -0.013-1000.0*y[3]; + dfdy[1][2]=0.0; + dfdy[1][3] = -1000.0*y[1]; + dfdy[2][1]=0.0; + dfdy[2][2] = -2500.0*y[3]; + dfdy[2][3] = -2500.0*y[2]; + dfdy[3][1] = -0.013-1000.0*y[3]; + dfdy[3][2] = -2500.0*y[3]; + dfdy[3][3] = -1000.0*y[1]-2500.0*y[2]; +} + +void derivs(float x, float y[], float dydx[]) +{ + dydx[1] = -0.013*y[1]-1000.0*y[1]*y[3]; + dydx[2] = -2500.0*y[2]*y[3]; + dydx[3] = -0.013*y[1]-1000.0*y[1]*y[3]-2500.0*y[2]*y[3]; +} diff --git a/lib/nr/ansi/recipes/julday.c b/lib/nr/ansi/recipes/julday.c new file mode 100644 index 0000000..ff26ac1 --- /dev/null +++ b/lib/nr/ansi/recipes/julday.c @@ -0,0 +1,26 @@ + +#include +#define IGREG (15+31L*(10+12L*1582)) + +long julday(int mm, int id, int iyyy) +{ + void nrerror(char error_text[]); + long jul; + int ja,jy=iyyy,jm; + + if (jy == 0) nrerror("julday: there is no year zero."); + if (jy < 0) ++jy; + if (mm > 2) { + jm=mm+1; + } else { + --jy; + jm=mm+13; + } + jul = (long) (floor(365.25*jy)+floor(30.6001*jm)+id+1720995); + if (id+31L*(mm+12L*iyyy) >= IGREG) { + ja=(int)(0.01*jy); + jul += 2-ja+(int) (0.25*ja); + } + return jul; +} +#undef IGREG diff --git a/lib/nr/ansi/recipes/kendl1.c b/lib/nr/ansi/recipes/kendl1.c new file mode 100644 index 0000000..6fdfb2e --- /dev/null +++ b/lib/nr/ansi/recipes/kendl1.c @@ -0,0 +1,31 @@ + +#include + +void kendl1(float data1[], float data2[], unsigned long n, float *tau, + float *z, float *prob) +{ + float erfcc(float x); + unsigned long n2=0,n1=0,k,j; + long is=0; + float svar,aa,a2,a1; + + for (j=1;j 0.0 ? ++is : --is; + } else { + if (a1) ++n1; + if (a2) ++n2; + } + } + } + *tau=is/(sqrt((double) n1)*sqrt((double) n2)); + svar=(4.0*n+10.0)/(9.0*n*(n-1.0)); + *z=(*tau)/sqrt(svar); + *prob=erfcc(fabs(*z)/1.4142136); +} diff --git a/lib/nr/ansi/recipes/kendl2.c b/lib/nr/ansi/recipes/kendl2.c new file mode 100644 index 0000000..43b0f39 --- /dev/null +++ b/lib/nr/ansi/recipes/kendl2.c @@ -0,0 +1,35 @@ + +#include + +void kendl2(float **tab, int i, int j, float *tau, float *z, float *prob) +{ + float erfcc(float x); + long nn,mm,m2,m1,lj,li,l,kj,ki,k; + float svar,s=0.0,points,pairs,en2=0.0,en1=0.0; + + nn=i*j; + points=tab[i][j]; + for (k=0;k<=nn-2;k++) { + ki=(k/j); + kj=k-j*ki; + points += tab[ki+1][kj+1]; + for (l=k+1;l<=nn-1;l++) { + li=l/j; + lj=l-j*li; + mm=(m1=li-ki)*(m2=lj-kj); + pairs=tab[ki+1][kj+1]*tab[li+1][lj+1]; + if (mm) { + en1 += pairs; + en2 += pairs; + s += (mm > 0 ? pairs : -pairs); + } else { + if (m1) en1 += pairs; + if (m2) en2 += pairs; + } + } + } + *tau=s/sqrt(en1*en2); + svar=(4.0*points+10.0)/(9.0*points*(points-1.0)); + *z=(*tau)/sqrt(svar); + *prob=erfcc(fabs(*z)/1.4142136); +} diff --git a/lib/nr/ansi/recipes/kermom.c b/lib/nr/ansi/recipes/kermom.c new file mode 100644 index 0000000..0ab4174 --- /dev/null +++ b/lib/nr/ansi/recipes/kermom.c @@ -0,0 +1,29 @@ + +#include + +extern double x; + +void kermom(double w[], double y, int m) +{ + double d,df,clog,x2,x3,x4,y2; + + if (y >= x) { + d=y-x; + df=2.0*sqrt(d)*d; + w[1]=df/3.0; + w[2]=df*(x/3.0+d/5.0); + w[3]=df*((x/3.0 + 0.4*d)*x + d*d/7.0); + w[4]=df*(((x/3.0 + 0.6*d)*x + 3.0*d*d/7.0)*x+d*d*d/9.0); + } else { + x3=(x2=x*x)*x; + x4=x2*x2; + y2=y*y; + d=x-y; + w[1]=d*((clog=log(d))-1.0); + w[2] = -0.25*(3.0*x+y-2.0*clog*(x+y))*d; + w[3]=(-11.0*x3+y*(6.0*x2+y*(3.0*x+2.0*y)) + +6.0*clog*(x3-y*y2))/18.0; + w[4]=(-25.0*x4+y*(12.0*x3+y*(6.0*x2+y* + (4.0*x+3.0*y)))+12.0*clog*(x4-(y2*y2)))/48.0; + } +} diff --git a/lib/nr/ansi/recipes/ks2d1s.c b/lib/nr/ansi/recipes/ks2d1s.c new file mode 100644 index 0000000..e7eddfd --- /dev/null +++ b/lib/nr/ansi/recipes/ks2d1s.c @@ -0,0 +1,32 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void ks2d1s(float x1[], float y1[], unsigned long n1, + void (*quadvl)(float, float, float *, float *, float *, float *), + float *d1, float *prob) +{ + void pearsn(float x[], float y[], unsigned long n, float *r, float *prob, + float *z); + float probks(float alam); + void quadct(float x, float y, float xx[], float yy[], unsigned long nn, + float *fa, float *fb, float *fc, float *fd); + unsigned long j; + float dum,dumm,fa,fb,fc,fd,ga,gb,gc,gd,r1,rr,sqen; + + *d1=0.0; + for (j=1;j<=n1;j++) { + quadct(x1[j],y1[j],x1,y1,n1,&fa,&fb,&fc,&fd); + (*quadvl)(x1[j],y1[j],&ga,&gb,&gc,&gd); + *d1=FMAX(*d1,fabs(fa-ga)); + *d1=FMAX(*d1,fabs(fb-gb)); + *d1=FMAX(*d1,fabs(fc-gc)); + *d1=FMAX(*d1,fabs(fd-gd)); + } + pearsn(x1,y1,n1,&r1,&dum,&dumm); + sqen=sqrt((double)n1); + rr=sqrt(1.0-r1*r1); + *prob=probks(*d1*sqen/(1.0+rr*(0.25-0.75/sqen))); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/ks2d2s.c b/lib/nr/ansi/recipes/ks2d2s.c new file mode 100644 index 0000000..f3b813c --- /dev/null +++ b/lib/nr/ansi/recipes/ks2d2s.c @@ -0,0 +1,42 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void ks2d2s(float x1[], float y1[], unsigned long n1, float x2[], float y2[], + unsigned long n2, float *d, float *prob) +{ + void pearsn(float x[], float y[], unsigned long n, float *r, float *prob, + float *z); + float probks(float alam); + void quadct(float x, float y, float xx[], float yy[], unsigned long nn, + float *fa, float *fb, float *fc, float *fd); + unsigned long j; + float d1,d2,dum,dumm,fa,fb,fc,fd,ga,gb,gc,gd,r1,r2,rr,sqen; + + d1=0.0; + for (j=1;j<=n1;j++) { + quadct(x1[j],y1[j],x1,y1,n1,&fa,&fb,&fc,&fd); + quadct(x1[j],y1[j],x2,y2,n2,&ga,&gb,&gc,&gd); + d1=FMAX(d1,fabs(fa-ga)); + d1=FMAX(d1,fabs(fb-gb)); + d1=FMAX(d1,fabs(fc-gc)); + d1=FMAX(d1,fabs(fd-gd)); + } + d2=0.0; + for (j=1;j<=n2;j++) { + quadct(x2[j],y2[j],x1,y1,n1,&fa,&fb,&fc,&fd); + quadct(x2[j],y2[j],x2,y2,n2,&ga,&gb,&gc,&gd); + d2=FMAX(d2,fabs(fa-ga)); + d2=FMAX(d2,fabs(fb-gb)); + d2=FMAX(d2,fabs(fc-gc)); + d2=FMAX(d2,fabs(fd-gd)); + } + *d=0.5*(d1+d2); + sqen=sqrt(n1*n2/(double)(n1+n2)); + pearsn(x1,y1,n1,&r1,&dum,&dumm); + pearsn(x2,y2,n2,&r2,&dum,&dumm); + rr=sqrt(1.0-0.5*(r1*r1+r2*r2)); + *prob=probks(*d*sqen/(1.0+rr*(0.25-0.75/sqen))); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/ksone.c b/lib/nr/ansi/recipes/ksone.c new file mode 100644 index 0000000..303021f --- /dev/null +++ b/lib/nr/ansi/recipes/ksone.c @@ -0,0 +1,27 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void ksone(float data[], unsigned long n, float (*func)(float), float *d, + float *prob) +{ + float probks(float alam); + void sort(unsigned long n, float arr[]); + unsigned long j; + float dt,en,ff,fn,fo=0.0; + + sort(n,data); + en=n; + *d=0.0; + for (j=1;j<=n;j++) { + fn=j/en; + ff=(*func)(data[j]); + dt=FMAX(fabs(fo-ff),fabs(fn-ff)); + if (dt > *d) *d=dt; + fo=fn; + } + en=sqrt(en); + *prob=probks((en+0.12+0.11/en)*(*d)); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/kstwo.c b/lib/nr/ansi/recipes/kstwo.c new file mode 100644 index 0000000..303e0ff --- /dev/null +++ b/lib/nr/ansi/recipes/kstwo.c @@ -0,0 +1,24 @@ + +#include + +void kstwo(float data1[], unsigned long n1, float data2[], unsigned long n2, + float *d, float *prob) +{ + float probks(float alam); + void sort(unsigned long n, float arr[]); + unsigned long j1=1,j2=1; + float d1,d2,dt,en1,en2,en,fn1=0.0,fn2=0.0; + + sort(n1,data1); + sort(n2,data2); + en1=n1; + en2=n2; + *d=0.0; + while (j1 <= n1 && j2 <= n2) { + if ((d1=data1[j1]) <= (d2=data2[j2])) fn1=j1++/en1; + if (d2 <= d1) fn2=j2++/en2; + if ((dt=fabs(fn2-fn1)) > *d) *d=dt; + } + en=sqrt(en1*en2/(en1+en2)); + *prob=probks((en+0.12+0.11/en)*(*d)); +} diff --git a/lib/nr/ansi/recipes/laguer.c b/lib/nr/ansi/recipes/laguer.c new file mode 100644 index 0000000..a8379f4 --- /dev/null +++ b/lib/nr/ansi/recipes/laguer.c @@ -0,0 +1,55 @@ + +#include +#include "complex.h" +#define NRANSI +#include "nrutil.h" +#define EPSS 1.0e-7 +#define MR 8 +#define MT 10 +#define MAXIT (MT*MR) + +void laguer(fcomplex a[], int m, fcomplex *x, int *its) +{ + int iter,j; + float abx,abp,abm,err; + fcomplex dx,x1,b,d,f,g,h,sq,gp,gm,g2; + static float frac[MR+1] = {0.0,0.5,0.25,0.75,0.13,0.38,0.62,0.88,1.0}; + + for (iter=1;iter<=MAXIT;iter++) { + *its=iter; + b=a[m]; + err=Cabs(b); + d=f=Complex(0.0,0.0); + abx=Cabs(*x); + for (j=m-1;j>=0;j--) { + f=Cadd(Cmul(*x,f),d); + d=Cadd(Cmul(*x,d),b); + b=Cadd(Cmul(*x,b),a[j]); + err=Cabs(b)+abx*err; + } + err *= EPSS; + if (Cabs(b) <= err) return; + g=Cdiv(d,b); + g2=Cmul(g,g); + h=Csub(g2,RCmul(2.0,Cdiv(f,b))); + sq=Csqrt(RCmul((float) (m-1),Csub(RCmul((float) m,h),g2))); + gp=Cadd(g,sq); + gm=Csub(g,sq); + abp=Cabs(gp); + abm=Cabs(gm); + if (abp < abm) gp=gm; + dx=((FMAX(abp,abm) > 0.0 ? Cdiv(Complex((float) m,0.0),gp) + : RCmul(1+abx,Complex(cos((float)iter),sin((float)iter))))); + x1=Csub(*x,dx); + if (x->r == x1.r && x->i == x1.i) return; + if (iter % MT) *x=x1; + else *x=Csub(*x,RCmul(frac[iter/MT],dx)); + } + nrerror("too many iterations in laguer"); + return; +} +#undef EPSS +#undef MR +#undef MT +#undef MAXIT +#undef NRANSI diff --git a/lib/nr/ansi/recipes/lfit.c b/lib/nr/ansi/recipes/lfit.c new file mode 100644 index 0000000..1fff683 --- /dev/null +++ b/lib/nr/ansi/recipes/lfit.c @@ -0,0 +1,55 @@ + +#define NRANSI +#include "nrutil.h" + +void lfit(float x[], float y[], float sig[], int ndat, float a[], int ia[], + int ma, float **covar, float *chisq, void (*funcs)(float, float [], int)) +{ + void covsrt(float **covar, int ma, int ia[], int mfit); + void gaussj(float **a, int n, float **b, int m); + int i,j,k,l,m,mfit=0; + float ym,wt,sum,sig2i,**beta,*afunc; + + beta=matrix(1,ma,1,1); + afunc=vector(1,ma); + for (j=1;j<=ma;j++) + if (ia[j]) mfit++; + if (mfit == 0) nrerror("lfit: no parameters to be fitted"); + for (j=1;j<=mfit;j++) { + for (k=1;k<=mfit;k++) covar[j][k]=0.0; + beta[j][1]=0.0; + } + for (i=1;i<=ndat;i++) { + (*funcs)(x[i],afunc,ma); + ym=y[i]; + if (mfit < ma) { + for (j=1;j<=ma;j++) + if (!ia[j]) ym -= a[j]*afunc[j]; + } + sig2i=1.0/SQR(sig[i]); + for (j=0,l=1;l<=ma;l++) { + if (ia[l]) { + wt=afunc[l]*sig2i; + for (j++,k=0,m=1;m<=l;m++) + if (ia[m]) covar[j][++k] += wt*afunc[m]; + beta[j][1] += ym*wt; + } + } + } + for (j=2;j<=mfit;j++) + for (k=1;k +#include +#define NRANSI +#include "nrutil.h" +#define EPS 1.0e-14 + +void linbcg(unsigned long n, double b[], double x[], int itol, double tol, + int itmax, int *iter, double *err) +{ + void asolve(unsigned long n, double b[], double x[], int itrnsp); + void atimes(unsigned long n, double x[], double r[], int itrnsp); + double snrm(unsigned long n, double sx[], int itol); + unsigned long j; + double ak,akden,bk,bkden,bknum,bnrm,dxnrm,xnrm,zm1nrm,znrm; + double *p,*pp,*r,*rr,*z,*zz; + + p=dvector(1,n); + pp=dvector(1,n); + r=dvector(1,n); + rr=dvector(1,n); + z=dvector(1,n); + zz=dvector(1,n); + + *iter=0; + atimes(n,x,r,0); + for (j=1;j<=n;j++) { + r[j]=b[j]-r[j]; + rr[j]=r[j]; + } + if (itol == 1) { + bnrm=snrm(n,b,itol); + asolve(n,r,z,0); + } + else if (itol == 2) { + asolve(n,b,z,0); + bnrm=snrm(n,z,itol); + asolve(n,r,z,0); + } + else if (itol == 3 || itol == 4) { + asolve(n,b,z,0); + bnrm=snrm(n,z,itol); + asolve(n,r,z,0); + znrm=snrm(n,z,itol); + } else nrerror("illegal itol in linbcg"); + while (*iter <= itmax) { + ++(*iter); + asolve(n,rr,zz,1); + for (bknum=0.0,j=1;j<=n;j++) bknum += z[j]*rr[j]; + if (*iter == 1) { + for (j=1;j<=n;j++) { + p[j]=z[j]; + pp[j]=zz[j]; + } + } + else { + bk=bknum/bkden; + for (j=1;j<=n;j++) { + p[j]=bk*p[j]+z[j]; + pp[j]=bk*pp[j]+zz[j]; + } + } + bkden=bknum; + atimes(n,p,z,0); + for (akden=0.0,j=1;j<=n;j++) akden += z[j]*pp[j]; + ak=bknum/akden; + atimes(n,pp,zz,1); + for (j=1;j<=n;j++) { + x[j] += ak*p[j]; + r[j] -= ak*z[j]; + rr[j] -= ak*zz[j]; + } + asolve(n,r,z,0); + if (itol == 1) + *err=snrm(n,r,itol)/bnrm; + else if (itol == 2) + *err=snrm(n,z,itol)/bnrm; + else if (itol == 3 || itol == 4) { + zm1nrm=znrm; + znrm=snrm(n,z,itol); + if (fabs(zm1nrm-znrm) > EPS*znrm) { + dxnrm=fabs(ak)*snrm(n,p,itol); + *err=znrm/fabs(zm1nrm-znrm)*dxnrm; + } else { + *err=znrm/bnrm; + continue; + } + xnrm=snrm(n,x,itol); + if (*err <= 0.5*xnrm) *err /= xnrm; + else { + *err=znrm/bnrm; + continue; + } + } + printf("iter=%4d err=%12.6f\n",*iter,*err); + if (*err <= tol) break; + } + + free_dvector(p,1,n); + free_dvector(pp,1,n); + free_dvector(r,1,n); + free_dvector(rr,1,n); + free_dvector(z,1,n); + free_dvector(zz,1,n); +} +#undef EPS +#undef NRANSI diff --git a/lib/nr/ansi/recipes/linmin.c b/lib/nr/ansi/recipes/linmin.c new file mode 100644 index 0000000..c0e9fcc --- /dev/null +++ b/lib/nr/ansi/recipes/linmin.c @@ -0,0 +1,39 @@ + +#define NRANSI +#include "nrutil.h" +#define TOL 2.0e-4 + +int ncom; +float *pcom,*xicom,(*nrfunc)(float []); + +void linmin(float p[], float xi[], int n, float *fret, float (*func)(float [])) +{ + float brent(float ax, float bx, float cx, + float (*f)(float), float tol, float *xmin); + float f1dim(float x); + void mnbrak(float *ax, float *bx, float *cx, float *fa, float *fb, + float *fc, float (*func)(float)); + int j; + float xx,xmin,fx,fb,fa,bx,ax; + + ncom=n; + pcom=vector(1,n); + xicom=vector(1,n); + nrfunc=func; + for (j=1;j<=n;j++) { + pcom[j]=p[j]; + xicom[j]=xi[j]; + } + ax=0.0; + xx=1.0; + mnbrak(&ax,&xx,&bx,&fa,&fx,&fb,f1dim); + *fret=brent(ax,xx,bx,f1dim,TOL,&xmin); + for (j=1;j<=n;j++) { + xi[j] *= xmin; + p[j] += xi[j]; + } + free_vector(xicom,1,n); + free_vector(pcom,1,n); +} +#undef TOL +#undef NRANSI diff --git a/lib/nr/ansi/recipes/lnsrch.c b/lib/nr/ansi/recipes/lnsrch.c new file mode 100644 index 0000000..8816dc8 --- /dev/null +++ b/lib/nr/ansi/recipes/lnsrch.c @@ -0,0 +1,64 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define ALF 1.0e-4 +#define TOLX 1.0e-7 + +void lnsrch(int n, float xold[], float fold, float g[], float p[], float x[], + float *f, float stpmax, int *check, float (*func)(float [])) +{ + int i; + float a,alam,alam2,alamin,b,disc,f2,rhs1,rhs2,slope,sum,temp, + test,tmplam; + + *check=0; + for (sum=0.0,i=1;i<=n;i++) sum += p[i]*p[i]; + sum=sqrt(sum); + if (sum > stpmax) + for (i=1;i<=n;i++) p[i] *= stpmax/sum; + for (slope=0.0,i=1;i<=n;i++) + slope += g[i]*p[i]; + if (slope >= 0.0) nrerror("Roundoff problem in lnsrch."); + test=0.0; + for (i=1;i<=n;i++) { + temp=fabs(p[i])/FMAX(fabs(xold[i]),1.0); + if (temp > test) test=temp; + } + alamin=TOLX/test; + alam=1.0; + for (;;) { + for (i=1;i<=n;i++) x[i]=xold[i]+alam*p[i]; + *f=(*func)(x); + if (alam < alamin) { + for (i=1;i<=n;i++) x[i]=xold[i]; + *check=1; + return; + } else if (*f <= fold+ALF*alam*slope) return; + else { + if (alam == 1.0) + tmplam = -slope/(2.0*(*f-fold-slope)); + else { + rhs1 = *f-fold-alam*slope; + rhs2=f2-fold-alam2*slope; + a=(rhs1/(alam*alam)-rhs2/(alam2*alam2))/(alam-alam2); + b=(-alam2*rhs1/(alam*alam)+alam*rhs2/(alam2*alam2))/(alam-alam2); + if (a == 0.0) tmplam = -slope/(2.0*b); + else { + disc=b*b-3.0*a*slope; + if (disc < 0.0) tmplam=0.5*alam; + else if (b <= 0.0) tmplam=(-b+sqrt(disc))/(3.0*a); + else tmplam=-slope/(b+sqrt(disc)); + } + if (tmplam > 0.5*alam) + tmplam=0.5*alam; + } + } + alam2=alam; + f2 = *f; + alam=FMAX(tmplam,0.1*alam); + } +} +#undef ALF +#undef TOLX +#undef NRANSI diff --git a/lib/nr/ansi/recipes/locate.c b/lib/nr/ansi/recipes/locate.c new file mode 100644 index 0000000..133de9d --- /dev/null +++ b/lib/nr/ansi/recipes/locate.c @@ -0,0 +1,20 @@ + +void locate(float xx[], unsigned long n, float x, unsigned long *j) +{ + unsigned long ju,jm,jl; + int ascnd; + + jl=0; + ju=n+1; + ascnd=(xx[n] >= xx[1]); + while (ju-jl > 1) { + jm=(ju+jl) >> 1; + if (x >= xx[jm] == ascnd) + jl=jm; + else + ju=jm; + } + if (x == xx[1]) *j=1; + else if(x == xx[n]) *j=n-1; + else *j=jl; +} diff --git a/lib/nr/ansi/recipes/lop.c b/lib/nr/ansi/recipes/lop.c new file mode 100644 index 0000000..96bccc9 --- /dev/null +++ b/lib/nr/ansi/recipes/lop.c @@ -0,0 +1,15 @@ + +void lop(double **out, double **u, int n) +{ + int i,j; + double h,h2i; + + h=1.0/(n-1); + h2i=1.0/(h*h); + for (j=2;j=1;i--) { + sum=b[i]; + for (j=i+1;j<=n;j++) sum -= a[i][j]*b[j]; + b[i]=sum/a[i][i]; + } +} diff --git a/lib/nr/ansi/recipes/ludcmp.c b/lib/nr/ansi/recipes/ludcmp.c new file mode 100644 index 0000000..caf57df --- /dev/null +++ b/lib/nr/ansi/recipes/ludcmp.c @@ -0,0 +1,58 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define TINY 1.0e-20 + +void ludcmp(float **a, int n, int *indx, float *d) +{ + int i,imax,j,k; + float big,dum,sum,temp; + float *vv; + + vv=vector(1,n); + *d=1.0; + for (i=1;i<=n;i++) { + big=0.0; + for (j=1;j<=n;j++) + if ((temp=fabs(a[i][j])) > big) big=temp; + if (big == 0.0) nrerror("Singular matrix in routine ludcmp"); + vv[i]=1.0/big; + } + for (j=1;j<=n;j++) { + for (i=1;i= big) { + big=dum; + imax=i; + } + } + if (j != imax) { + for (k=1;k<=n;k++) { + dum=a[imax][k]; + a[imax][k]=a[j][k]; + a[j][k]=dum; + } + *d = -(*d); + vv[imax]=vv[j]; + } + indx[j]=imax; + if (a[j][j] == 0.0) a[j][j]=TINY; + if (j != n) { + dum=1.0/(a[j][j]); + for (i=j+1;i<=n;i++) a[i][j] *= dum; + } + } + free_vector(vv,1,n); +} +#undef TINY +#undef NRANSI diff --git a/lib/nr/ansi/recipes/machar.c b/lib/nr/ansi/recipes/machar.c new file mode 100644 index 0000000..922a228 --- /dev/null +++ b/lib/nr/ansi/recipes/machar.c @@ -0,0 +1,134 @@ + +#include +#define CONV(i) ((float)(i)) + +void machar(int *ibeta, int *it, int *irnd, int *ngrd, int *machep, int *negep, + int *iexp, int *minexp, int *maxexp, float *eps, float *epsneg, + float *xmin, float *xmax) +{ + int i,itemp,iz,j,k,mx,nxres; + float a,b,beta,betah,betain,one,t,temp,temp1,tempa,two,y,z,zero; + + one=CONV(1); + two=one+one; + zero=one-one; + a=one; + do { + a += a; + temp=a+one; + temp1=temp-a; + } while (temp1-one == zero); + b=one; + do { + b += b; + temp=a+b; + itemp=(int)(temp-a); + } while (itemp == 0); + *ibeta=itemp; + beta=CONV(*ibeta); + *it=0; + b=one; + do { + ++(*it); + b *= beta; + temp=b+one; + temp1=temp-b; + } while (temp1-one == zero); + *irnd=0; + betah=beta/two; + temp=a+betah; + if (temp-a != zero) *irnd=1; + tempa=a+beta; + temp=tempa+betah; + if (*irnd == 0 && temp-tempa != zero) *irnd=2; + *negep=(*it)+3; + betain=one/beta; + a=one; + for (i=1;i<=(*negep);i++) a *= betain; + b=a; + for (;;) { + temp=one-a; + if (temp-one != zero) break; + a *= beta; + --(*negep); + } + *negep = -(*negep); + *epsneg=a; + *machep = -(*it)-3; + a=b; + for (;;) { + temp=one+a; + if (temp-one != zero) break; + a *= beta; + ++(*machep); + } + *eps=a; + *ngrd=0; + temp=one+(*eps); + if (*irnd == 0 && temp*one-one != zero) *ngrd=1; + i=0; + k=1; + z=betain; + t=one+(*eps); + nxres=0; + for (;;) { + y=z; + z=y*y; + a=z*one; + temp=z*t; + if (a+a == zero || fabs(z) >= y) break; + temp1=temp*betain; + if (temp1*beta == z) break; + ++i; + k += k; + } + if (*ibeta != 10) { + *iexp=i+1; + mx=k+k; + } else { + *iexp=2; + iz=(*ibeta); + while (k >= iz) { + iz *= *ibeta; + ++(*iexp); + } + mx=iz+iz-1; + } + for (;;) { + *xmin=y; + y *= betain; + a=y*one; + temp=y*t; + if (a+a != zero && fabs(y) < *xmin) { + ++k; + temp1=temp*betain; + if (temp1*beta == y && temp != y) { + nxres=3; + *xmin=y; + break; + } + } + else break; + } + *minexp = -k; + if (mx <= k+k-3 && *ibeta != 10) { + mx += mx; + ++(*iexp); + } + *maxexp=mx+(*minexp); + *irnd += nxres; + if (*irnd >= 2) *maxexp -= 2; + i=(*maxexp)+(*minexp); + if (*ibeta == 2 && !i) --(*maxexp); + if (i > 20) --(*maxexp); + if (a != y) *maxexp -= 2; + *xmax=one-(*epsneg); + if ((*xmax)*one != *xmax) *xmax=one-beta*(*epsneg); + *xmax /= (*xmin*beta*beta*beta); + i=(*maxexp)+(*minexp)+3; + for (j=1;j<=i;j++) { + if (*ibeta == 2) *xmax += *xmax; + else *xmax *= beta; + } +} +#undef CONV diff --git a/lib/nr/ansi/recipes/matadd.c b/lib/nr/ansi/recipes/matadd.c new file mode 100644 index 0000000..90e0e24 --- /dev/null +++ b/lib/nr/ansi/recipes/matadd.c @@ -0,0 +1,9 @@ + +void matadd(double **a, double **b, double **c, int n) +{ + int i,j; + + for (j=1;j<=n;j++) + for (i=1;i<=n;i++) + c[i][j]=a[i][j]+b[i][j]; +} diff --git a/lib/nr/ansi/recipes/matsub.c b/lib/nr/ansi/recipes/matsub.c new file mode 100644 index 0000000..1e10f0e --- /dev/null +++ b/lib/nr/ansi/recipes/matsub.c @@ -0,0 +1,9 @@ + +void matsub(double **a, double **b, double **c, int n) +{ + int i,j; + + for (j=1;j<=n;j++) + for (i=1;i<=n;i++) + c[i][j]=a[i][j]-b[i][j]; +} diff --git a/lib/nr/ansi/recipes/medfit.c b/lib/nr/ansi/recipes/medfit.c new file mode 100644 index 0000000..25ab60e --- /dev/null +++ b/lib/nr/ansi/recipes/medfit.c @@ -0,0 +1,66 @@ + +#include +#define NRANSI +#include "nrutil.h" +int ndatat; +float *xt,*yt,aa,abdevt; + +void medfit(float x[], float y[], int ndata, float *a, float *b, float *abdev) +{ + float rofunc(float b); + int j; + float bb,b1,b2,del,f,f1,f2,sigb,temp; + float sx=0.0,sy=0.0,sxy=0.0,sxx=0.0,chisq=0.0; + + ndatat=ndata; + xt=x; + yt=y; + for (j=1;j<=ndata;j++) { + sx += x[j]; + sy += y[j]; + sxy += x[j]*y[j]; + sxx += x[j]*x[j]; + } + del=ndata*sxx-sx*sx; + aa=(sxx*sy-sx*sxy)/del; + bb=(ndata*sxy-sx*sy)/del; + for (j=1;j<=ndata;j++) + chisq += (temp=y[j]-(aa+bb*x[j]),temp*temp); + sigb=sqrt(chisq/del); + b1=bb; + f1=rofunc(b1); + if (sigb > 0.0) { + b2=bb+SIGN(3.0*sigb,f1); + f2=rofunc(b2); + if (b2 == b1) { + *a=aa; + *b=bb; + *abdev=abdevt/ndata; + return; + } + while (f1*f2 > 0.0) { + bb=b2+1.6*(b2-b1); + b1=b2; + f1=f2; + b2=bb; + f2=rofunc(b2); + } + sigb=0.01*sigb; + while (fabs(b2-b1) > sigb) { + bb=b1+0.5*(b2-b1); + if (bb == b1 || bb == b2) break; + f=rofunc(bb); + if (f*f1 >= 0.0) { + f1=f; + b1=bb; + } else { + f2=f; + b2=bb; + } + } + } + *a=aa; + *b=bb; + *abdev=abdevt/ndata; +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/memcof.c b/lib/nr/ansi/recipes/memcof.c new file mode 100644 index 0000000..343aa2b --- /dev/null +++ b/lib/nr/ansi/recipes/memcof.c @@ -0,0 +1,46 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void memcof(float data[], int n, int m, float *xms, float d[]) +{ + int k,j,i; + float p=0.0,*wk1,*wk2,*wkm; + + wk1=vector(1,n); + wk2=vector(1,n); + wkm=vector(1,m); + for (j=1;j<=n;j++) p += SQR(data[j]); + *xms=p/n; + wk1[1]=data[1]; + wk2[n-1]=data[n]; + for (j=2;j<=n-1;j++) { + wk1[j]=data[j]; + wk2[j-1]=data[j]; + } + for (k=1;k<=m;k++) { + float num=0.0,denom=0.0; + for (j=1;j<=(n-k);j++) { + num += wk1[j]*wk2[j]; + denom += SQR(wk1[j])+SQR(wk2[j]); + } + d[k]=2.0*num/denom; + *xms *= (1.0-SQR(d[k])); + for (i=1;i<=(k-1);i++) + d[i]=wkm[i]-d[k]*wkm[k-i]; + if (k == m) { + free_vector(wkm,1,m); + free_vector(wk2,1,n); + free_vector(wk1,1,n); + return; + } + for (i=1;i<=k;i++) wkm[i]=d[i]; + for (j=1;j<=(n-k-1);j++) { + wk1[j] -= wkm[k]*wk2[j]; + wk2[j]=wk2[j+1]-wkm[k]*wk1[j+1]; + } + } + nrerror("never get here in memcof."); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/metrop.c b/lib/nr/ansi/recipes/metrop.c new file mode 100644 index 0000000..8c68870 --- /dev/null +++ b/lib/nr/ansi/recipes/metrop.c @@ -0,0 +1,10 @@ + +#include + +int metrop(float de, float t) +{ + float ran3(long *idum); + static long gljdum=1; + + return de < 0.0 || ran3(&gljdum) < exp(-de/t); +} diff --git a/lib/nr/ansi/recipes/mgfas.c b/lib/nr/ansi/recipes/mgfas.c new file mode 100644 index 0000000..ac9a163 --- /dev/null +++ b/lib/nr/ansi/recipes/mgfas.c @@ -0,0 +1,102 @@ + +#define NRANSI +#include "nrutil.h" +#define NPRE 1 +#define NPOST 1 +#define ALPHA 0.33 +#define NGMAX 15 + +void mgfas(double **u, int n, int maxcyc) +{ + double anorm2(double **a, int n); + void copy(double **aout, double **ain, int n); + void interp(double **uf, double **uc, int nf); + void lop(double **out, double **u, int n); + void matadd(double **a, double **b, double **c, int n); + void matsub(double **a, double **b, double **c, int n); + void relax2(double **u, double **rhs, int n); + void rstrct(double **uc, double **uf, int nc); + void slvsm2(double **u, double **rhs); + unsigned int j,jcycle,jj,jm1,jpost,jpre,nf,ng=0,ngrid,nn; + double **irho[NGMAX+1],**irhs[NGMAX+1],**itau[NGMAX+1], + **itemp[NGMAX+1],**iu[NGMAX+1]; + double res,trerr; + + nn=n; + while (nn >>= 1) ng++; + if (n != 1+(1L << ng)) nrerror("n-1 must be a power of 2 in mgfas."); + if (ng > NGMAX) nrerror("increase NGMAX in mglin."); + nn=n/2+1; + ngrid=ng-1; + irho[ngrid]=dmatrix(1,nn,1,nn); + rstrct(irho[ngrid],u,nn); + while (nn > 3) { + nn=nn/2+1; + irho[--ngrid]=dmatrix(1,nn,1,nn); + rstrct(irho[ngrid],irho[ngrid+1],nn); + } + nn=3; + iu[1]=dmatrix(1,nn,1,nn); + irhs[1]=dmatrix(1,nn,1,nn); + itau[1]=dmatrix(1,nn,1,nn); + itemp[1]=dmatrix(1,nn,1,nn); + slvsm2(iu[1],irho[1]); + free_dmatrix(irho[1],1,nn,1,nn); + ngrid=ng; + for (j=2;j<=ngrid;j++) { + nn=2*nn-1; + iu[j]=dmatrix(1,nn,1,nn); + irhs[j]=dmatrix(1,nn,1,nn); + itau[j]=dmatrix(1,nn,1,nn); + itemp[j]=dmatrix(1,nn,1,nn); + interp(iu[j],iu[j-1],nn); + copy(irhs[j],(j != ngrid ? irho[j] : u),nn); + for (jcycle=1;jcycle<=maxcyc;jcycle++) { + nf=nn; + for (jj=j;jj>=2;jj--) { + for (jpre=1;jpre<=NPRE;jpre++) + relax2(iu[jj],irhs[jj],nf); + lop(itemp[jj],iu[jj],nf); + nf=nf/2+1; + jm1=jj-1; + rstrct(itemp[jm1],itemp[jj],nf); + rstrct(iu[jm1],iu[jj],nf); + lop(itau[jm1],iu[jm1],nf); + matsub(itau[jm1],itemp[jm1],itau[jm1],nf); + if (jj == j) + trerr=ALPHA*anorm2(itau[jm1],nf); + rstrct(irhs[jm1],irhs[jj],nf); + matadd(irhs[jm1],itau[jm1],irhs[jm1],nf); + } + slvsm2(iu[1],irhs[1]); + nf=3; + for (jj=2;jj<=j;jj++) { + jm1=jj-1; + rstrct(itemp[jm1],iu[jj],nf); + matsub(iu[jm1],itemp[jm1],itemp[jm1],nf); + nf=2*nf-1; + interp(itau[jj],itemp[jm1],nf); + matadd(iu[jj],itau[jj],iu[jj],nf); + for (jpost=1;jpost<=NPOST;jpost++) + relax2(iu[jj],irhs[jj],nf); + } + lop(itemp[j],iu[j],nf); + matsub(itemp[j],irhs[j],itemp[j],nf); + res=anorm2(itemp[j],nf); + if (res < trerr) break; + } + } + copy(u,iu[ngrid],n); + for (nn=n,j=ng;j>=1;j--,nn=nn/2+1) { + free_dmatrix(itemp[j],1,nn,1,nn); + free_dmatrix(itau[j],1,nn,1,nn); + free_dmatrix(irhs[j],1,nn,1,nn); + free_dmatrix(iu[j],1,nn,1,nn); + if (j != ng && j != 1) free_dmatrix(irho[j],1,nn,1,nn); + } +} +#undef NGMAX +#undef NPRE +#undef NPOST +#undef ALPHA +#undef NRANSI diff --git a/lib/nr/ansi/recipes/mglin.c b/lib/nr/ansi/recipes/mglin.c new file mode 100644 index 0000000..1e201e1 --- /dev/null +++ b/lib/nr/ansi/recipes/mglin.c @@ -0,0 +1,80 @@ + +#define NRANSI +#include "nrutil.h" +#define NPRE 1 +#define NPOST 1 +#define NGMAX 15 + +void mglin(double **u, int n, int ncycle) +{ + void addint(double **uf, double **uc, double **res, int nf); + void copy(double **aout, double **ain, int n); + void fill0(double **u, int n); + void interp(double **uf, double **uc, int nf); + void relax(double **u, double **rhs, int n); + void resid(double **res, double **u, double **rhs, int n); + void rstrct(double **uc, double **uf, int nc); + void slvsml(double **u, double **rhs); + unsigned int j,jcycle,jj,jpost,jpre,nf,ng=0,ngrid,nn; + double **ires[NGMAX+1],**irho[NGMAX+1],**irhs[NGMAX+1],**iu[NGMAX+1]; + + nn=n; + while (nn >>= 1) ng++; + if (n != 1+(1L << ng)) nrerror("n-1 must be a power of 2 in mglin."); + if (ng > NGMAX) nrerror("increase NGMAX in mglin."); + nn=n/2+1; + ngrid=ng-1; + irho[ngrid]=dmatrix(1,nn,1,nn); + rstrct(irho[ngrid],u,nn); + while (nn > 3) { + nn=nn/2+1; + irho[--ngrid]=dmatrix(1,nn,1,nn); + rstrct(irho[ngrid],irho[ngrid+1],nn); + } + nn=3; + iu[1]=dmatrix(1,nn,1,nn); + irhs[1]=dmatrix(1,nn,1,nn); + slvsml(iu[1],irho[1]); + free_dmatrix(irho[1],1,nn,1,nn); + ngrid=ng; + for (j=2;j<=ngrid;j++) { + nn=2*nn-1; + iu[j]=dmatrix(1,nn,1,nn); + irhs[j]=dmatrix(1,nn,1,nn); + ires[j]=dmatrix(1,nn,1,nn); + interp(iu[j],iu[j-1],nn); + copy(irhs[j],(j != ngrid ? irho[j] : u),nn); + for (jcycle=1;jcycle<=ncycle;jcycle++) { + nf=nn; + for (jj=j;jj>=2;jj--) { + for (jpre=1;jpre<=NPRE;jpre++) + relax(iu[jj],irhs[jj],nf); + resid(ires[jj],iu[jj],irhs[jj],nf); + nf=nf/2+1; + rstrct(irhs[jj-1],ires[jj],nf); + fill0(iu[jj-1],nf); + } + slvsml(iu[1],irhs[1]); + nf=3; + for (jj=2;jj<=j;jj++) { + nf=2*nf-1; + addint(iu[jj],iu[jj-1],ires[jj],nf); + for (jpost=1;jpost<=NPOST;jpost++) + relax(iu[jj],irhs[jj],nf); + } + } + } + copy(u,iu[ngrid],n); + for (nn=n,j=ng;j>=2;j--,nn=nn/2+1) { + free_dmatrix(ires[j],1,nn,1,nn); + free_dmatrix(irhs[j],1,nn,1,nn); + free_dmatrix(iu[j],1,nn,1,nn); + if (j != ng) free_dmatrix(irho[j],1,nn,1,nn); + } + free_dmatrix(irhs[1],1,3,1,3); + free_dmatrix(iu[1],1,3,1,3); +} +#undef NPRE +#undef NPOST +#undef NGMAX +#undef NRANSI diff --git a/lib/nr/ansi/recipes/midexp.c b/lib/nr/ansi/recipes/midexp.c new file mode 100644 index 0000000..50d7106 --- /dev/null +++ b/lib/nr/ansi/recipes/midexp.c @@ -0,0 +1,32 @@ + +#include +#define FUNC(x) ((*funk)(-log(x))/(x)) + +float midexp(float (*funk)(float), float aa, float bb, int n) +{ + float x,tnm,sum,del,ddel,a,b; + static float s; + int it,j; + + b=exp(-aa); + a=0.0; + if (n == 1) { + return (s=(b-a)*FUNC(0.5*(a+b))); + } else { + for(it=1,j=1;j +#define FUNC(x) (2.0*(x)*(*funk)(aa+(x)*(x))) + +float midsql(float (*funk)(float), float aa, float bb, int n) +{ + float x,tnm,sum,del,ddel,a,b; + static float s; + int it,j; + + b=sqrt(bb-aa); + a=0.0; + if (n == 1) { + return (s=(b-a)*FUNC(0.5*(a+b))); + } else { + for(it=1,j=1;j +#define FUNC(x) (2.0*(x)*(*funk)(bb-(x)*(x))) + +float midsqu(float (*funk)(float), float aa, float bb, int n) +{ + float x,tnm,sum,del,ddel,a,b; + static float s; + int it,j; + + b=sqrt(bb-aa); + a=0.0; + if (n == 1) { + return (s=(b-a)*FUNC(0.5*(a+b))); + } else { + for(it=1,j=1;j +#include +#define NRANSI +#include "nrutil.h" +#define PFAC 0.1 +#define MNPT 15 +#define MNBS 60 +#define TINY 1.0e-30 +#define BIG 1.0e30 + +static long iran=0; + +void miser(float (*func)(float []), float regn[], int ndim, unsigned long npts, + float dith, float *ave, float *var) +{ + void ranpt(float pt[], float regn[], int n); + float *regn_temp; + unsigned long n,npre,nptl,nptr; + int j,jb; + float avel,varl; + float fracl,fval; + float rgl,rgm,rgr,s,sigl,siglb,sigr,sigrb; + float sum,sumb,summ,summ2; + float *fmaxl,*fmaxr,*fminl,*fminr; + float *pt,*rmid; + + pt=vector(1,ndim); + if (npts < MNBS) { + summ=summ2=0.0; + for (n=1;n<=npts;n++) { + ranpt(pt,regn,ndim); + fval=(*func)(pt); + summ += fval; + summ2 += fval * fval; + } + *ave=summ/npts; + *var=FMAX(TINY,(summ2-summ*summ/npts)/(npts*npts)); + } + else { + rmid=vector(1,ndim); + npre=LMAX((unsigned long)(npts*PFAC),MNPT); + fmaxl=vector(1,ndim); + fmaxr=vector(1,ndim); + fminl=vector(1,ndim); + fminr=vector(1,ndim); + for (j=1;j<=ndim;j++) { + iran=(iran*2661+36979) % 175000; + s=SIGN(dith,(float)(iran-87500)); + rmid[j]=(0.5+s)*regn[j]+(0.5-s)*regn[ndim+j]; + fminl[j]=fminr[j]=BIG; + fmaxl[j]=fmaxr[j] = -BIG; + } + for (n=1;n<=npre;n++) { + ranpt(pt,regn,ndim); + fval=(*func)(pt); + for (j=1;j<=ndim;j++) { + if (pt[j]<=rmid[j]) { + fminl[j]=FMIN(fminl[j],fval); + fmaxl[j]=FMAX(fmaxl[j],fval); + } + else { + fminr[j]=FMIN(fminr[j],fval); + fmaxr[j]=FMAX(fmaxr[j],fval); + } + } + } + sumb=BIG; + jb=0; + siglb=sigrb=1.0; + for (j=1;j<=ndim;j++) { + if (fmaxl[j] > fminl[j] && fmaxr[j] > fminr[j]) { + sigl=FMAX(TINY,pow(fmaxl[j]-fminl[j],2.0/3.0)); + sigr=FMAX(TINY,pow(fmaxr[j]-fminr[j],2.0/3.0)); + sum=sigl+sigr; + if (sum<=sumb) { + sumb=sum; + jb=j; + siglb=sigl; + sigrb=sigr; + } + } + } + free_vector(fminr,1,ndim); + free_vector(fminl,1,ndim); + free_vector(fmaxr,1,ndim); + free_vector(fmaxl,1,ndim); + if (!jb) jb=1+(ndim*iran)/175000; + rgl=regn[jb]; + rgm=rmid[jb]; + rgr=regn[ndim+jb]; + fracl=fabs((rgm-rgl)/(rgr-rgl)); + nptl=(unsigned long)(MNPT+(npts-npre-2*MNPT)*fracl*siglb + /(fracl*siglb+(1.0-fracl)*sigrb)); + nptr=npts-npre-nptl; + regn_temp=vector(1,2*ndim); + for (j=1;j<=ndim;j++) { + regn_temp[j]=regn[j]; + regn_temp[ndim+j]=regn[ndim+j]; + } + regn_temp[ndim+jb]=rmid[jb]; + miser(func,regn_temp,ndim,nptl,dith,&avel,&varl); + regn_temp[jb]=rmid[jb]; + regn_temp[ndim+jb]=regn[ndim+jb]; + miser(func,regn_temp,ndim,nptr,dith,ave,var); + free_vector(regn_temp,1,2*ndim); + *ave=fracl*avel+(1-fracl)*(*ave); + *var=fracl*fracl*varl+(1-fracl)*(1-fracl)*(*var); + free_vector(rmid,1,ndim); + } + free_vector(pt,1,ndim); +} +#undef MNPT +#undef MNBS +#undef TINY +#undef BIG +#undef PFAC +#undef NRANSI diff --git a/lib/nr/ansi/recipes/mmid.c b/lib/nr/ansi/recipes/mmid.c new file mode 100644 index 0000000..8e11fac --- /dev/null +++ b/lib/nr/ansi/recipes/mmid.c @@ -0,0 +1,35 @@ + +#define NRANSI +#include "nrutil.h" + +void mmid(float y[], float dydx[], int nvar, float xs, float htot, int nstep, + float yout[], void (*derivs)(float, float[], float[])) +{ + int n,i; + float x,swap,h2,h,*ym,*yn; + + ym=vector(1,nvar); + yn=vector(1,nvar); + h=htot/nstep; + for (i=1;i<=nvar;i++) { + ym[i]=y[i]; + yn[i]=y[i]+h*dydx[i]; + } + x=xs+h; + (*derivs)(x,yn,yout); + h2=2.0*h; + for (n=2;n<=nstep;n++) { + for (i=1;i<=nvar;i++) { + swap=ym[i]+h2*yout[i]; + ym[i]=yn[i]; + yn[i]=swap; + } + x += h; + (*derivs)(x,yn,yout); + } + for (i=1;i<=nvar;i++) + yout[i]=0.5*(ym[i]+yn[i]+h*yout[i]); + free_vector(yn,1,nvar); + free_vector(ym,1,nvar); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/mnbrak.c b/lib/nr/ansi/recipes/mnbrak.c new file mode 100644 index 0000000..b1862cb --- /dev/null +++ b/lib/nr/ansi/recipes/mnbrak.c @@ -0,0 +1,65 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define GOLD 1.618034 +#define GLIMIT 100.0 +#define TINY 1.0e-20 +#define SHFT(a,b,c,d) (a)=(b);(b)=(c);(c)=(d); + +void mnbrak(float *ax, float *bx, float *cx, float *fa, float *fb, float *fc, + float (*func)(float)) +{ + float ulim,u,r,q,fu,dum; + + *fa=(*func)(*ax); + *fb=(*func)(*bx); + if (*fb > *fa) { + SHFT(dum,*ax,*bx,dum) + SHFT(dum,*fb,*fa,dum) + } + *cx=(*bx)+GOLD*(*bx-*ax); + *fc=(*func)(*cx); + while (*fb > *fc) { + r=(*bx-*ax)*(*fb-*fc); + q=(*bx-*cx)*(*fb-*fa); + u=(*bx)-((*bx-*cx)*q-(*bx-*ax)*r)/ + (2.0*SIGN(FMAX(fabs(q-r),TINY),q-r)); + ulim=(*bx)+GLIMIT*(*cx-*bx); + if ((*bx-u)*(u-*cx) > 0.0) { + fu=(*func)(u); + if (fu < *fc) { + *ax=(*bx); + *bx=u; + *fa=(*fb); + *fb=fu; + return; + } else if (fu > *fb) { + *cx=u; + *fc=fu; + return; + } + u=(*cx)+GOLD*(*cx-*bx); + fu=(*func)(u); + } else if ((*cx-u)*(u-ulim) > 0.0) { + fu=(*func)(u); + if (fu < *fc) { + SHFT(*bx,*cx,u,*cx+GOLD*(*cx-*bx)) + SHFT(*fb,*fc,fu,(*func)(u)) + } + } else if ((u-ulim)*(ulim-*cx) >= 0.0) { + u=ulim; + fu=(*func)(u); + } else { + u=(*cx)+GOLD*(*cx-*bx); + fu=(*func)(u); + } + SHFT(*ax,*bx,*cx,u) + SHFT(*fa,*fb,*fc,fu) + } +} +#undef GOLD +#undef GLIMIT +#undef TINY +#undef SHFT +#undef NRANSI diff --git a/lib/nr/ansi/recipes/mnewt.c b/lib/nr/ansi/recipes/mnewt.c new file mode 100644 index 0000000..f93cf39 --- /dev/null +++ b/lib/nr/ansi/recipes/mnewt.c @@ -0,0 +1,39 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void usrfun(float *x,int n,float *fvec,float **fjac); +#define FREERETURN {free_matrix(fjac,1,n,1,n);free_vector(fvec,1,n);\ + free_vector(p,1,n);free_ivector(indx,1,n);return;} + +void mnewt(int ntrial, float x[], int n, float tolx, float tolf) +{ + void lubksb(float **a, int n, int *indx, float b[]); + void ludcmp(float **a, int n, int *indx, float *d); + int k,i,*indx; + float errx,errf,d,*fvec,**fjac,*p; + + indx=ivector(1,n); + p=vector(1,n); + fvec=vector(1,n); + fjac=matrix(1,n,1,n); + for (k=1;k<=ntrial;k++) { + usrfun(x,n,fvec,fjac); + errf=0.0; + for (i=1;i<=n;i++) errf += fabs(fvec[i]); + if (errf <= tolf) FREERETURN + for (i=1;i<=n;i++) p[i] = -fvec[i]; + ludcmp(fjac,n,indx,&d); + lubksb(fjac,n,indx,p); + errx=0.0; + for (i=1;i<=n;i++) { + errx += fabs(p[i]); + x[i] += p[i]; + } + if (errx <= tolx) FREERETURN + } + FREERETURN +} +#undef FREERETURN +#undef NRANSI diff --git a/lib/nr/ansi/recipes/moment.c b/lib/nr/ansi/recipes/moment.c new file mode 100644 index 0000000..acd875d --- /dev/null +++ b/lib/nr/ansi/recipes/moment.c @@ -0,0 +1,30 @@ + +#include + +void moment(float data[], int n, float *ave, float *adev, float *sdev, + float *var, float *skew, float *curt) +{ + void nrerror(char error_text[]); + int j; + float ep=0.0,s,p; + + if (n <= 1) nrerror("n must be at least 2 in moment"); + s=0.0; + for (j=1;j<=n;j++) s += data[j]; + *ave=s/n; + *adev=(*var)=(*skew)=(*curt)=0.0; + for (j=1;j<=n;j++) { + *adev += fabs(s=data[j]-(*ave)); + ep += s; + *var += (p=s*s); + *skew += (p *= s); + *curt += (p *= s); + } + *adev /= n; + *var=(*var-ep*ep/n)/(n-1); + *sdev=sqrt(*var); + if (*var) { + *skew /= (n*(*var)*(*sdev)); + *curt=(*curt)/(n*(*var)*(*var))-3.0; + } else nrerror("No skew/kurtosis when variance = 0 (in moment)"); +} diff --git a/lib/nr/ansi/recipes/mp2dfr.c b/lib/nr/ansi/recipes/mp2dfr.c new file mode 100644 index 0000000..df17738 --- /dev/null +++ b/lib/nr/ansi/recipes/mp2dfr.c @@ -0,0 +1,17 @@ + +#define IAZ 48 + +void mp2dfr(unsigned char a[], unsigned char s[], int n, int *m) +{ + void mplsh(unsigned char u[], int n); + void mpsmu(unsigned char w[], unsigned char u[], int n, int iv); + int j; + + *m=(int) (2.408*n); + for (j=1;j<=(*m);j++) { + mpsmu(a,a,n,10); + s[j]=a[1]+IAZ; + mplsh(a,n); + } +} +#undef IAZ diff --git a/lib/nr/ansi/recipes/mpdiv.c b/lib/nr/ansi/recipes/mpdiv.c new file mode 100644 index 0000000..8926607 --- /dev/null +++ b/lib/nr/ansi/recipes/mpdiv.c @@ -0,0 +1,33 @@ + +#define NRANSI +#include "nrutil.h" +#define MACC 6 + +void mpdiv(unsigned char q[], unsigned char r[], unsigned char u[], + unsigned char v[], int n, int m) +{ + void mpinv(unsigned char u[], unsigned char v[], int n, int m); + void mpmov(unsigned char u[], unsigned char v[], int n); + void mpmul(unsigned char w[], unsigned char u[], unsigned char v[], int n, + int m); + void mpsad(unsigned char w[], unsigned char u[], int n, int iv); + void mpsub(int *is, unsigned char w[], unsigned char u[], unsigned char v[], + int n); + int is; + unsigned char *rr,*s; + + rr=cvector(1,(n+MACC)<<1); + s=cvector(1,(n+MACC)<<1); + mpinv(s,v,n+MACC,m); + mpmul(rr,s,u,n+MACC,n); + mpsad(s,rr,n+MACC-1,1); + mpmov(q,&s[2],n-m+1); + mpmul(rr,q,v,n-m+1,m); + mpsub(&is,&rr[1],u,&rr[1],n); + if (is) nrerror("MACC too small in mpdiv"); + mpmov(r,&rr[n-m+1],m); + free_cvector(s,1,(n+MACC)<<1); + free_cvector(rr,1,(n+MACC)<<1); +} +#undef MACC +#undef NRANSI diff --git a/lib/nr/ansi/recipes/mpinv.c b/lib/nr/ansi/recipes/mpinv.c new file mode 100644 index 0000000..c5cf9ee --- /dev/null +++ b/lib/nr/ansi/recipes/mpinv.c @@ -0,0 +1,50 @@ + +#define NRANSI +#include "nrutil.h" +#define MF 4 +#define BI (1.0/256) + +void mpinv(unsigned char u[], unsigned char v[], int n, int m) +{ + void mpmov(unsigned char u[], unsigned char v[], int n); + void mpmul(unsigned char w[], unsigned char u[], unsigned char v[], int n, + int m); + void mpneg(unsigned char u[], int n); + unsigned char *rr,*s; + int i,j,maxmn,mm; + float fu,fv; + + maxmn=IMAX(n,m); + rr=cvector(1,1+(maxmn<<1)); + s=cvector(1,maxmn); + mm=IMIN(MF,m); + fv=(float) v[mm]; + for (j=mm-1;j>=1;j--) { + fv *= BI; + fv += v[j]; + } + fu=1.0/fv; + for (j=1;j<=n;j++) { + i=(int) fu; + u[j]=(unsigned char) i; + fu=256.0*(fu-i); + } + for (;;) { + mpmul(rr,u,v,n,m); + mpmov(s,&rr[1],n); + mpneg(s,n); + s[1] -= 254; + mpmul(rr,s,u,n,n); + mpmov(u,&rr[1],n); + for (j=2;j=1;j--) { + t=b[j]/(nn>>1)+cy+0.5; + cy=(unsigned long) (t/RX); + b[j]=t-cy*RX; + } + if (cy >= RX) nrerror("cannot happen in fftmul"); + w[1]=(unsigned char) cy; + for (j=2;j<=n+m;j++) + w[j]=(unsigned char) b[j-1]; + free_dvector(b,1,nn); + free_dvector(a,1,nn); +} +#undef RX +#undef NRANSI diff --git a/lib/nr/ansi/recipes/mpops.c b/lib/nr/ansi/recipes/mpops.c new file mode 100644 index 0000000..c785431 --- /dev/null +++ b/lib/nr/ansi/recipes/mpops.c @@ -0,0 +1,93 @@ + +#define LOBYTE(x) ((unsigned char) ((x) & 0xff)) +#define HIBYTE(x) ((unsigned char) ((x) >> 8 & 0xff)) + + +void mpadd(unsigned char w[], unsigned char u[], unsigned char v[], int n) +{ + int j; + unsigned short ireg=0; + + for (j=n;j>=1;j--) { + ireg=u[j]+v[j]+HIBYTE(ireg); + w[j+1]=LOBYTE(ireg); + } + w[1]=HIBYTE(ireg); +} + +void mpsub(int *is, unsigned char w[], unsigned char u[], unsigned char v[], + int n) +{ + int j; + unsigned short ireg=256; + + for (j=n;j>=1;j--) { + ireg=255+u[j]-v[j]+HIBYTE(ireg); + w[j]=LOBYTE(ireg); + } + *is=HIBYTE(ireg)-1; +} + +void mpsad(unsigned char w[], unsigned char u[], int n, int iv) +{ + int j; + unsigned short ireg; + + ireg=256*iv; + for (j=n;j>=1;j--) { + ireg=u[j]+HIBYTE(ireg); + w[j+1]=LOBYTE(ireg); + } + w[1]=HIBYTE(ireg); +} + +void mpsmu(unsigned char w[], unsigned char u[], int n, int iv) +{ + int j; + unsigned short ireg=0; + + for (j=n;j>=1;j--) { + ireg=u[j]*iv+HIBYTE(ireg); + w[j+1]=LOBYTE(ireg); + } + w[1]=HIBYTE(ireg); +} + +void mpsdv(unsigned char w[], unsigned char u[], int n, int iv, int *ir) +{ + int i,j; + + *ir=0; + for (j=1;j<=n;j++) { + i=256*(*ir)+u[j]; + w[j]=(unsigned char) (i/iv); + *ir=i % iv; + } +} + +void mpneg(unsigned char u[], int n) +{ + int j; + unsigned short ireg=256; + + for (j=n;j>=1;j--) { + ireg=255-u[j]+HIBYTE(ireg); + u[j]=LOBYTE(ireg); + } +} + +void mpmov(unsigned char u[], unsigned char v[], int n) +{ + int j; + + for (j=1;j<=n;j++) u[j]=v[j]; +} + +void mplsh(unsigned char u[], int n) +{ + int j; + + for (j=1;j<=n;j++) u[j]=u[j+1]; +} +#undef LOBYTE +#undef HIBYTE diff --git a/lib/nr/ansi/recipes/mppi.c b/lib/nr/ansi/recipes/mppi.c new file mode 100644 index 0000000..af98697 --- /dev/null +++ b/lib/nr/ansi/recipes/mppi.c @@ -0,0 +1,76 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define IAOFF 48 + +void mppi(int n) +{ + void mp2dfr(unsigned char a[], unsigned char s[], int n, int *m); + void mpadd(unsigned char w[], unsigned char u[], unsigned char v[], int n); + void mpinv(unsigned char u[], unsigned char v[], int n, int m); + void mplsh(unsigned char u[], int n); + void mpmov(unsigned char u[], unsigned char v[], int n); + void mpmul(unsigned char w[], unsigned char u[], unsigned char v[], int n, + int m); + void mpsdv(unsigned char w[], unsigned char u[], int n, int iv, int *ir); + void mpsqrt(unsigned char w[], unsigned char u[], unsigned char v[], int n, + int m); + int ir,j,m; + unsigned char mm,*x,*y,*sx,*sxi,*t,*s,*pi; + + x=cvector(1,n+1); + y=cvector(1,n<<1); + sx=cvector(1,n); + sxi=cvector(1,n); + t=cvector(1,n<<1); + s=cvector(1,3*n); + pi=cvector(1,n+1); + t[1]=2; + for (j=2;j<=n;j++) t[j]=0; + mpsqrt(x,x,t,n,n); + mpadd(pi,t,x,n); + mplsh(pi,n); + mpsqrt(sx,sxi,x,n,n); + mpmov(y,sx,n); + for (;;) { + mpadd(x,sx,sxi,n); + mpsdv(x,&x[1],n,2,&ir); + mpsqrt(sx,sxi,x,n,n); + mpmul(t,y,sx,n,n); + mpadd(&t[1],&t[1],sxi,n); + x[1]++; + y[1]++; + mpinv(s,y,n,n); + mpmul(y,&t[2],s,n,n); + mplsh(y,n); + mpmul(t,x,s,n,n); + mm=t[2]-1; + for (j=3;j<=n;j++) { + if (t[j] != mm) break; + } + m=t[n+1]-mm; + if (j <= n || m > 1 || m < -1) { + mpmul(s,pi,&t[1],n,n); + mpmov(pi,&s[1],n); + continue; + } + printf("pi=\n"); + s[1]=pi[1]+IAOFF; + s[2]='.'; + m=mm; + mp2dfr(&pi[1],&s[2],n-1,&m); + s[m+3]=0; + printf(" %64s\n",&s[1]); + free_cvector(pi,1,n+1); + free_cvector(s,1,3*n); + free_cvector(t,1,n<<1); + free_cvector(sxi,1,n); + free_cvector(sx,1,n); + free_cvector(y,1,n<<1); + free_cvector(x,1,n+1); + return; + } +} +#undef IAOFF +#undef NRANSI diff --git a/lib/nr/ansi/recipes/mprove.c b/lib/nr/ansi/recipes/mprove.c new file mode 100644 index 0000000..f5bcd9d --- /dev/null +++ b/lib/nr/ansi/recipes/mprove.c @@ -0,0 +1,22 @@ + +#define NRANSI +#include "nrutil.h" + +void mprove(float **a, float **alud, int n, int indx[], float b[], float x[]) +{ + void lubksb(float **a, int n, int *indx, float b[]); + int j,i; + double sdp; + float *r; + + r=vector(1,n); + for (i=1;i<=n;i++) { + sdp = -b[i]; + for (j=1;j<=n;j++) sdp += a[i][j]*x[j]; + r[i]=sdp; + } + lubksb(alud,n,indx,r); + for (i=1;i<=n;i++) x[i] -= r[i]; + free_vector(r,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/mpsqrt.c b/lib/nr/ansi/recipes/mpsqrt.c new file mode 100644 index 0000000..359103f --- /dev/null +++ b/lib/nr/ansi/recipes/mpsqrt.c @@ -0,0 +1,60 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define MF 3 +#define BI (1.0/256) + +void mpsqrt(unsigned char w[], unsigned char u[], unsigned char v[], int n, + int m) +{ + void mplsh(unsigned char u[], int n); + void mpmov(unsigned char u[], unsigned char v[], int n); + void mpmul(unsigned char w[], unsigned char u[], unsigned char v[], int n, + int m); + void mpneg(unsigned char u[], int n); + void mpsdv(unsigned char w[], unsigned char u[], int n, int iv, int *ir); + int i,ir,j,mm; + float fu,fv; + unsigned char *r,*s; + + r=cvector(1,n<<1); + s=cvector(1,n<<1); + mm=IMIN(m,MF); + fv=(float) v[mm]; + for (j=mm-1;j>=1;j--) { + fv *= BI; + fv += v[j]; + } + fu=1.0/sqrt(fv); + for (j=1;j<=n;j++) { + i=(int) fu; + u[j]=(unsigned char) i; + fu=256.0*(fu-i); + } + for (;;) { + mpmul(r,u,u,n,n); + mplsh(r,n); + mpmul(s,r,v,n,IMIN(m,n)); + mplsh(s,n); + mpneg(s,n); + s[1] -= 253; + mpsdv(s,s,n,2,&ir); + for (j=2;j +#define NRANSI +#include "nrutil.h" +#define MAXITS 200 +#define TOLF 1.0e-4 +#define TOLMIN 1.0e-6 +#define TOLX 1.0e-7 +#define STPMX 100.0 + +int nn; +float *fvec; +void (*nrfuncv)(int n, float v[], float f[]); +#define FREERETURN {free_vector(fvec,1,n);free_vector(xold,1,n);\ + free_vector(p,1,n);free_vector(g,1,n);free_matrix(fjac,1,n,1,n);\ + free_ivector(indx,1,n);return;} + +void newt(float x[], int n, int *check, + void (*vecfunc)(int, float [], float [])) +{ + void fdjac(int n, float x[], float fvec[], float **df, + void (*vecfunc)(int, float [], float [])); + float fmin(float x[]); + void lnsrch(int n, float xold[], float fold, float g[], float p[], float x[], + float *f, float stpmax, int *check, float (*func)(float [])); + void lubksb(float **a, int n, int *indx, float b[]); + void ludcmp(float **a, int n, int *indx, float *d); + int i,its,j,*indx; + float d,den,f,fold,stpmax,sum,temp,test,**fjac,*g,*p,*xold; + + indx=ivector(1,n); + fjac=matrix(1,n,1,n); + g=vector(1,n); + p=vector(1,n); + xold=vector(1,n); + fvec=vector(1,n); + nn=n; + nrfuncv=vecfunc; + f=fmin(x); + test=0.0; + for (i=1;i<=n;i++) + if (fabs(fvec[i]) > test) test=fabs(fvec[i]); + if (test < 0.01*TOLF) { + *check=0; + FREERETURN + } + for (sum=0.0,i=1;i<=n;i++) sum += SQR(x[i]); + stpmax=STPMX*FMAX(sqrt(sum),(float)n); + for (its=1;its<=MAXITS;its++) { + fdjac(n,x,fvec,fjac,vecfunc); + for (i=1;i<=n;i++) { + for (sum=0.0,j=1;j<=n;j++) sum += fjac[j][i]*fvec[j]; + g[i]=sum; + } + for (i=1;i<=n;i++) xold[i]=x[i]; + fold=f; + for (i=1;i<=n;i++) p[i] = -fvec[i]; + ludcmp(fjac,n,indx,&d); + lubksb(fjac,n,indx,p); + lnsrch(n,xold,fold,g,p,x,&f,stpmax,check,fmin); + test=0.0; + for (i=1;i<=n;i++) + if (fabs(fvec[i]) > test) test=fabs(fvec[i]); + if (test < TOLF) { + *check=0; + FREERETURN + } + if (*check) { + test=0.0; + den=FMAX(f,0.5*n); + for (i=1;i<=n;i++) { + temp=fabs(g[i])*FMAX(fabs(x[i]),1.0)/den; + if (temp > test) test=temp; + } + *check=(test < TOLMIN ? 1 : 0); + FREERETURN + } + test=0.0; + for (i=1;i<=n;i++) { + temp=(fabs(x[i]-xold[i]))/FMAX(fabs(x[i]),1.0); + if (temp > test) test=temp; + } + if (test < TOLX) FREERETURN + } + nrerror("MAXITS exceeded in newt"); +} +#undef MAXITS +#undef TOLF +#undef TOLMIN +#undef TOLX +#undef STPMX +#undef FREERETURN +#undef NRANSI diff --git a/lib/nr/ansi/recipes/nrutil.c b/lib/nr/ansi/recipes/nrutil.c new file mode 100644 index 0000000..b08d4bf --- /dev/null +++ b/lib/nr/ansi/recipes/nrutil.c @@ -0,0 +1,293 @@ +/* CAUTION: This is the ANSI C (only) version of the Numerical Recipes + utility file nrutil.c. Do not confuse this file with the same-named + file nrutil.c that is supplied in the same subdirectory or archive + as the header file nrutil.h. *That* file contains both ANSI and + traditional K&R versions, along with #ifdef macros to select the + correct version. *This* file contains only ANSI C. */ + +#include +#include +#include +#define NR_END 1 +#define FREE_ARG char* + +void nrerror(char error_text[]) +/* Numerical Recipes standard error handler */ +{ + fprintf(stderr,"Numerical Recipes run-time error...\n"); + fprintf(stderr,"%s\n",error_text); + fprintf(stderr,"...now exiting to system...\n"); + exit(1); +} + +float *vector(long nl, long nh) +/* allocate a float vector with subscript range v[nl..nh] */ +{ + float *v; + + v=(float *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(float))); + if (!v) nrerror("allocation failure in vector()"); + return v-nl+NR_END; +} + +int *ivector(long nl, long nh) +/* allocate an int vector with subscript range v[nl..nh] */ +{ + int *v; + + v=(int *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(int))); + if (!v) nrerror("allocation failure in ivector()"); + return v-nl+NR_END; +} + +unsigned char *cvector(long nl, long nh) +/* allocate an unsigned char vector with subscript range v[nl..nh] */ +{ + unsigned char *v; + + v=(unsigned char *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(unsigned char))); + if (!v) nrerror("allocation failure in cvector()"); + return v-nl+NR_END; +} + +unsigned long *lvector(long nl, long nh) +/* allocate an unsigned long vector with subscript range v[nl..nh] */ +{ + unsigned long *v; + + v=(unsigned long *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(long))); + if (!v) nrerror("allocation failure in lvector()"); + return v-nl+NR_END; +} + +double *dvector(long nl, long nh) +/* allocate a double vector with subscript range v[nl..nh] */ +{ + double *v; + + v=(double *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(double))); + if (!v) nrerror("allocation failure in dvector()"); + return v-nl+NR_END; +} + +float **matrix(long nrl, long nrh, long ncl, long nch) +/* allocate a float matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + float **m; + + /* allocate pointers to rows */ + m=(float **) malloc((size_t)((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + /* allocate rows and set pointers to them */ + m[nrl]=(float *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(float))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +double **dmatrix(long nrl, long nrh, long ncl, long nch) +/* allocate a double matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + double **m; + + /* allocate pointers to rows */ + m=(double **) malloc((size_t)((nrow+NR_END)*sizeof(double*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + /* allocate rows and set pointers to them */ + m[nrl]=(double *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(double))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +int **imatrix(long nrl, long nrh, long ncl, long nch) +/* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + int **m; + + /* allocate pointers to rows */ + m=(int **) malloc((size_t)((nrow+NR_END)*sizeof(int*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + + /* allocate rows and set pointers to them */ + m[nrl]=(int *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(int))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +float **submatrix(float **a, long oldrl, long oldrh, long oldcl, long oldch, + long newrl, long newcl) +/* point a submatrix [newrl..][newcl..] to a[oldrl..oldrh][oldcl..oldch] */ +{ + long i,j,nrow=oldrh-oldrl+1,ncol=oldcl-newcl; + float **m; + + /* allocate array of pointers to rows */ + m=(float **) malloc((size_t) ((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure in submatrix()"); + m += NR_END; + m -= newrl; + + /* set pointers to rows */ + for(i=oldrl,j=newrl;i<=oldrh;i++,j++) m[j]=a[i]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +float **convert_matrix(float *a, long nrl, long nrh, long ncl, long nch) +/* allocate a float matrix m[nrl..nrh][ncl..nch] that points to the matrix +declared in the standard C manner as a[nrow][ncol], where nrow=nrh-nrl+1 +and ncol=nch-ncl+1. The routine should be called with the address +&a[0][0] as the first argument. */ +{ + long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1; + float **m; + + /* allocate pointers to rows */ + m=(float **) malloc((size_t) ((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure in convert_matrix()"); + m += NR_END; + m -= nrl; + + /* set pointers to rows */ + m[nrl]=a-ncl; + for(i=1,j=nrl+1;i +#define NRANSI +#include "nrutil.h" +#define MAXSTP 10000 +#define TINY 1.0e-30 + +extern int kmax,kount; +extern float *xp,**yp,dxsav; + +void odeint(float ystart[], int nvar, float x1, float x2, float eps, float h1, + float hmin, int *nok, int *nbad, + void (*derivs)(float, float [], float []), + void (*rkqs)(float [], float [], int, float *, float, float, float [], + float *, float *, void (*)(float, float [], float []))) +{ + int nstp,i; + float xsav,x,hnext,hdid,h; + float *yscal,*y,*dydx; + + yscal=vector(1,nvar); + y=vector(1,nvar); + dydx=vector(1,nvar); + x=x1; + h=SIGN(h1,x2-x1); + *nok = (*nbad) = kount = 0; + for (i=1;i<=nvar;i++) y[i]=ystart[i]; + if (kmax > 0) xsav=x-dxsav*2.0; + for (nstp=1;nstp<=MAXSTP;nstp++) { + (*derivs)(x,y,dydx); + for (i=1;i<=nvar;i++) + yscal[i]=fabs(y[i])+fabs(dydx[i]*h)+TINY; + if (kmax > 0 && kount < kmax-1 && fabs(x-xsav) > fabs(dxsav)) { + xp[++kount]=x; + for (i=1;i<=nvar;i++) yp[i][kount]=y[i]; + xsav=x; + } + if ((x+h-x2)*(x+h-x1) > 0.0) h=x2-x; + (*rkqs)(y,dydx,nvar,&x,h,eps,yscal,&hdid,&hnext,derivs); + if (hdid == h) ++(*nok); else ++(*nbad); + if ((x-x2)*(x2-x1) >= 0.0) { + for (i=1;i<=nvar;i++) ystart[i]=y[i]; + if (kmax) { + xp[++kount]=x; + for (i=1;i<=nvar;i++) yp[i][kount]=y[i]; + } + free_vector(dydx,1,nvar); + free_vector(y,1,nvar); + free_vector(yscal,1,nvar); + return; + } + if (fabs(hnext) <= hmin) nrerror("Step size too small in odeint"); + h=hnext; + } + nrerror("Too many steps in routine odeint"); +} +#undef MAXSTP +#undef TINY +#undef NRANSI diff --git a/lib/nr/ansi/recipes/orthog.c b/lib/nr/ansi/recipes/orthog.c new file mode 100644 index 0000000..8c0f728 --- /dev/null +++ b/lib/nr/ansi/recipes/orthog.c @@ -0,0 +1,30 @@ + +#define NRANSI +#include "nrutil.h" + +void orthog(int n, float anu[], float alpha[], float beta[], float a[], + float b[]) +{ + int k,l; + float **sig; + int looptmp; + + sig=matrix(1,2*n+1,1,2*n+1); + looptmp=2*n; + for (l=3;l<=looptmp;l++) sig[1][l]=0.0; + looptmp++; + for (l=2;l<=looptmp;l++) sig[2][l]=anu[l-1]; + a[1]=alpha[1]+anu[2]/anu[1]; + b[1]=0.0; + for (k=3;k<=n+1;k++) { + looptmp=2*n-k+3; + for (l=k;l<=looptmp;l++) { + sig[k][l]=sig[k-1][l+1]+(alpha[l-1]-a[k-2])*sig[k-1][l]- + b[k-2]*sig[k-2][l]+beta[l-1]*sig[k-1][l-1]; + } + a[k-1]=alpha[k-1]+sig[k][k+1]/sig[k][k]-sig[k-1][k]/sig[k-1][k-1]; + b[k-1]=sig[k][k]/sig[k-1][k-1]; + } + free_matrix(sig,1,2*n+1,1,2*n+1); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/pade.c b/lib/nr/ansi/recipes/pade.c new file mode 100644 index 0000000..51cf322 --- /dev/null +++ b/lib/nr/ansi/recipes/pade.c @@ -0,0 +1,56 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define BIG 1.0e30 + +void pade(double cof[], int n, float *resid) +{ + void lubksb(float **a, int n, int *indx, float b[]); + void ludcmp(float **a, int n, int *indx, float *d); + void mprove(float **a, float **alud, int n, int indx[], float b[], + float x[]); + int j,k,*indx; + float d,rr,rrold,sum,**q,**qlu,*x,*y,*z; + + indx=ivector(1,n); + q=matrix(1,n,1,n); + qlu=matrix(1,n,1,n); + x=vector(1,n); + y=vector(1,n); + z=vector(1,n); + for (j=1;j<=n;j++) { + y[j]=x[j]=cof[n+j]; + for (k=1;k<=n;k++) { + q[j][k]=cof[j-k+n]; + qlu[j][k]=q[j][k]; + } + } + ludcmp(qlu,n,indx,&d); + lubksb(qlu,n,indx,x); + rr=BIG; + do { + rrold=rr; + for (j=1;j<=n;j++) z[j]=x[j]; + mprove(q,qlu,n,indx,y,x); + for (rr=0.0,j=1;j<=n;j++) + rr += SQR(z[j]-x[j]); + } while (rr < rrold); + *resid=sqrt(rrold); + for (k=1;k<=n;k++) { + for (sum=cof[k],j=1;j<=k;j++) sum -= z[j]*cof[k-j]; + y[k]=sum; + } + for (j=1;j<=n;j++) { + cof[j]=y[j]; + cof[j+n] = -z[j]; + } + free_vector(z,1,n); + free_vector(y,1,n); + free_vector(x,1,n); + free_matrix(qlu,1,n,1,n); + free_matrix(q,1,n,1,n); + free_ivector(indx,1,n); +} +#undef BIG +#undef NRANSI diff --git a/lib/nr/ansi/recipes/pccheb.c b/lib/nr/ansi/recipes/pccheb.c new file mode 100644 index 0000000..6598330 --- /dev/null +++ b/lib/nr/ansi/recipes/pccheb.c @@ -0,0 +1,20 @@ + +void pccheb(float d[], float c[], int n) +{ + int j,jm,jp,k; + float fac,pow; + + pow=1.0; + c[0]=2.0*d[0]; + for (k=1;k=0;j-=2,jm--,jp++) { + c[j] += fac; + fac *= ((float)jm)/((float)jp); + } + pow += pow; + } +} diff --git a/lib/nr/ansi/recipes/pcshft.c b/lib/nr/ansi/recipes/pcshft.c new file mode 100644 index 0000000..b6c9aa6 --- /dev/null +++ b/lib/nr/ansi/recipes/pcshft.c @@ -0,0 +1,17 @@ + +void pcshft(float a, float b, float d[], int n) +{ + int k,j; + float fac,cnst; + + cnst=2.0/(b-a); + fac=cnst; + for (j=1;j=j;k--) + d[k] -= cnst*d[k+1]; +} diff --git a/lib/nr/ansi/recipes/pearsn.c b/lib/nr/ansi/recipes/pearsn.c new file mode 100644 index 0000000..5b6ab92 --- /dev/null +++ b/lib/nr/ansi/recipes/pearsn.c @@ -0,0 +1,33 @@ + +#include +#define TINY 1.0e-20 + +void pearsn(float x[], float y[], unsigned long n, float *r, float *prob, + float *z) +{ + float betai(float a, float b, float x); + float erfcc(float x); + unsigned long j; + float yt,xt,t,df; + float syy=0.0,sxy=0.0,sxx=0.0,ay=0.0,ax=0.0; + + for (j=1;j<=n;j++) { + ax += x[j]; + ay += y[j]; + } + ax /= n; + ay /= n; + for (j=1;j<=n;j++) { + xt=x[j]-ax; + yt=y[j]-ay; + sxx += xt*xt; + syy += yt*yt; + sxy += xt*yt; + } + *r=sxy/(sqrt(sxx*syy)+TINY); + *z=0.5*log((1.0+(*r)+TINY)/(1.0-(*r)+TINY)); + df=n-2; + t=(*r)*sqrt(df/((1.0-(*r)+TINY)*(1.0+(*r)+TINY))); + *prob=betai(0.5*df,0.5,df/(df+t*t)); +} +#undef TINY diff --git a/lib/nr/ansi/recipes/period.c b/lib/nr/ansi/recipes/period.c new file mode 100644 index 0000000..6217858 --- /dev/null +++ b/lib/nr/ansi/recipes/period.c @@ -0,0 +1,80 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define TWOPID 6.2831853071795865 + +void period(float x[], float y[], int n, float ofac, float hifac, float px[], + float py[], int np, int *nout, int *jmax, float *prob) +{ + void avevar(float data[], unsigned long n, float *ave, float *var); + int i,j; + float ave,c,cc,cwtau,effm,expy,pnow,pymax,s,ss,sumc,sumcy,sums,sumsh, + sumsy,swtau,var,wtau,xave,xdif,xmax,xmin,yy; + double arg,wtemp,*wi,*wpi,*wpr,*wr; + + wi=dvector(1,n); + wpi=dvector(1,n); + wpr=dvector(1,n); + wr=dvector(1,n); + *nout=0.5*ofac*hifac*n; + if (*nout > np) nrerror("output arrays too short in period"); + avevar(y,n,&ave,&var); + if (var == 0.0) nrerror("zero variance in period"); + xmax=xmin=x[1]; + for (j=1;j<=n;j++) { + if (x[j] > xmax) xmax=x[j]; + if (x[j] < xmin) xmin=x[j]; + } + xdif=xmax-xmin; + xave=0.5*(xmax+xmin); + pymax=0.0; + pnow=1.0/(xdif*ofac); + for (j=1;j<=n;j++) { + arg=TWOPID*((x[j]-xave)*pnow); + wpr[j] = -2.0*SQR(sin(0.5*arg)); + wpi[j]=sin(arg); + wr[j]=cos(arg); + wi[j]=wpi[j]; + } + for (i=1;i<=(*nout);i++) { + px[i]=pnow; + sumsh=sumc=0.0; + for (j=1;j<=n;j++) { + c=wr[j]; + s=wi[j]; + sumsh += s*c; + sumc += (c-s)*(c+s); + } + wtau=0.5*atan2(2.0*sumsh,sumc); + swtau=sin(wtau); + cwtau=cos(wtau); + sums=sumc=sumsy=sumcy=0.0; + for (j=1;j<=n;j++) { + s=wi[j]; + c=wr[j]; + ss=s*cwtau-c*swtau; + cc=c*cwtau+s*swtau; + sums += ss*ss; + sumc += cc*cc; + yy=y[j]-ave; + sumsy += yy*ss; + sumcy += yy*cc; + wr[j]=((wtemp=wr[j])*wpr[j]-wi[j]*wpi[j])+wr[j]; + wi[j]=(wi[j]*wpr[j]+wtemp*wpi[j])+wi[j]; + } + py[i]=0.5*(sumcy*sumcy/sumc+sumsy*sumsy/sums)/var; + if (py[i] >= pymax) pymax=py[(*jmax=i)]; + pnow += 1.0/(ofac*xdif); + } + expy=exp(-pymax); + effm=2.0*(*nout)/ofac; + *prob=effm*expy; + if (*prob > 0.01) *prob=1.0-pow(1.0-expy,effm); + free_dvector(wr,1,n); + free_dvector(wpr,1,n); + free_dvector(wpi,1,n); + free_dvector(wi,1,n); +} +#undef TWOPID +#undef NRANSI diff --git a/lib/nr/ansi/recipes/piksr2.c b/lib/nr/ansi/recipes/piksr2.c new file mode 100644 index 0000000..791e4ad --- /dev/null +++ b/lib/nr/ansi/recipes/piksr2.c @@ -0,0 +1,19 @@ + +void piksr2(int n, float arr[], float brr[]) +{ + int i,j; + float a,b; + + for (j=2;j<=n;j++) { + a=arr[j]; + b=brr[j]; + i=j-1; + while (i > 0 && arr[i] > a) { + arr[i+1]=arr[i]; + brr[i+1]=brr[i]; + i--; + } + arr[i+1]=a; + brr[i+1]=b; + } +} diff --git a/lib/nr/ansi/recipes/piksrt.c b/lib/nr/ansi/recipes/piksrt.c new file mode 100644 index 0000000..92c06fd --- /dev/null +++ b/lib/nr/ansi/recipes/piksrt.c @@ -0,0 +1,16 @@ + +void piksrt(int n, float arr[]) +{ + int i,j; + float a; + + for (j=2;j<=n;j++) { + a=arr[j]; + i=j-1; + while (i > 0 && arr[i] > a) { + arr[i+1]=arr[i]; + i--; + } + arr[i+1]=a; + } +} diff --git a/lib/nr/ansi/recipes/pinvs.c b/lib/nr/ansi/recipes/pinvs.c new file mode 100644 index 0000000..60dfb7f --- /dev/null +++ b/lib/nr/ansi/recipes/pinvs.c @@ -0,0 +1,67 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void pinvs(int ie1, int ie2, int je1, int jsf, int jc1, int k, float ***c, + float **s) +{ + int js1,jpiv,jp,je2,jcoff,j,irow,ipiv,id,icoff,i,*indxr; + float pivinv,piv,dum,big,*pscl; + + indxr=ivector(ie1,ie2); + pscl=vector(ie1,ie2); + je2=je1+ie2-ie1; + js1=je2+1; + for (i=ie1;i<=ie2;i++) { + big=0.0; + for (j=je1;j<=je2;j++) + if (fabs(s[i][j]) > big) big=fabs(s[i][j]); + if (big == 0.0) nrerror("Singular matrix - row all 0, in pinvs"); + pscl[i]=1.0/big; + indxr[i]=0; + } + for (id=ie1;id<=ie2;id++) { + piv=0.0; + for (i=ie1;i<=ie2;i++) { + if (indxr[i] == 0) { + big=0.0; + for (j=je1;j<=je2;j++) { + if (fabs(s[i][j]) > big) { + jp=j; + big=fabs(s[i][j]); + } + } + if (big*pscl[i] > piv) { + ipiv=i; + jpiv=jp; + piv=big*pscl[i]; + } + } + } + if (s[ipiv][jpiv] == 0.0) nrerror("Singular matrix in routine pinvs"); + indxr[ipiv]=jpiv; + pivinv=1.0/s[ipiv][jpiv]; + for (j=je1;j<=jsf;j++) s[ipiv][j] *= pivinv; + s[ipiv][jpiv]=1.0; + for (i=ie1;i<=ie2;i++) { + if (indxr[i] != jpiv) { + if (s[i][jpiv]) { + dum=s[i][jpiv]; + for (j=je1;j<=jsf;j++) + s[i][j] -= dum*s[ipiv][j]; + s[i][jpiv]=0.0; + } + } + } + } + jcoff=jc1-js1; + icoff=ie1-je1; + for (i=ie1;i<=ie2;i++) { + irow=indxr[i]+icoff; + for (j=js1;j<=jsf;j++) c[irow][j+jcoff][k]=s[i][j]; + } + free_vector(pscl,ie1,ie2); + free_ivector(indxr,ie1,ie2); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/plgndr.c b/lib/nr/ansi/recipes/plgndr.c new file mode 100644 index 0000000..632c039 --- /dev/null +++ b/lib/nr/ansi/recipes/plgndr.c @@ -0,0 +1,36 @@ + +#include + +float plgndr(int l, int m, float x) +{ + void nrerror(char error_text[]); + float fact,pll,pmm,pmmp1,somx2; + int i,ll; + + if (m < 0 || m > l || fabs(x) > 1.0) + nrerror("Bad arguments in routine plgndr"); + pmm=1.0; + if (m > 0) { + somx2=sqrt((1.0-x)*(1.0+x)); + fact=1.0; + for (i=1;i<=m;i++) { + pmm *= -fact*somx2; + fact += 2.0; + } + } + if (l == m) + return pmm; + else { + pmmp1=x*(2*m+1)*pmm; + if (l == (m+1)) + return pmmp1; + else { + for (ll=m+2;ll<=l;ll++) { + pll=(x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m); + pmm=pmmp1; + pmmp1=pll; + } + return pll; + } + } +} diff --git a/lib/nr/ansi/recipes/poidev.c b/lib/nr/ansi/recipes/poidev.c new file mode 100644 index 0000000..93e8d92 --- /dev/null +++ b/lib/nr/ansi/recipes/poidev.c @@ -0,0 +1,41 @@ + +#include +#define PI 3.141592654 + +float poidev(float xm, long *idum) +{ + float gammln(float xx); + float ran1(long *idum); + static float sq,alxm,g,oldm=(-1.0); + float em,t,y; + + if (xm < 12.0) { + if (xm != oldm) { + oldm=xm; + g=exp(-xm); + } + em = -1; + t=1.0; + do { + ++em; + t *= ran1(idum); + } while (t > g); + } else { + if (xm != oldm) { + oldm=xm; + sq=sqrt(2.0*xm); + alxm=log(xm); + g=xm*alxm-gammln(xm+1.0); + } + do { + do { + y=tan(PI*ran1(idum)); + em=sq*y+xm; + } while (em < 0.0); + em=floor(em); + t=0.9*(1.0+y*y)*exp(em*alxm-gammln(em+1.0)-g); + } while (ran1(idum) > t); + } + return em; +} +#undef PI diff --git a/lib/nr/ansi/recipes/polcoe.c b/lib/nr/ansi/recipes/polcoe.c new file mode 100644 index 0000000..2f57895 --- /dev/null +++ b/lib/nr/ansi/recipes/polcoe.c @@ -0,0 +1,31 @@ + +#define NRANSI +#include "nrutil.h" + +void polcoe(float x[], float y[], int n, float cof[]) +{ + int k,j,i; + float phi,ff,b,*s; + + s=vector(0,n); + for (i=0;i<=n;i++) s[i]=cof[i]=0.0; + s[n] = -x[0]; + for (i=1;i<=n;i++) { + for (j=n-i;j<=n-1;j++) + s[j] -= x[i]*s[j+1]; + s[n] -= x[i]; + } + for (j=0;j<=n;j++) { + phi=n+1; + for (k=n;k>=1;k--) + phi=k*s[k]+x[j]*phi; + ff=y[j]/phi; + b=1.0; + for (k=n;k>=0;k--) { + cof[k] += b*ff; + b=s[k]+x[j]*b; + } + } + free_vector(s,0,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/polcof.c b/lib/nr/ansi/recipes/polcof.c new file mode 100644 index 0000000..8219455 --- /dev/null +++ b/lib/nr/ansi/recipes/polcof.c @@ -0,0 +1,37 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void polcof(float xa[], float ya[], int n, float cof[]) +{ + void polint(float xa[], float ya[], int n, float x, float *y, float *dy); + int k,j,i; + float xmin,dy,*x,*y; + + x=vector(0,n); + y=vector(0,n); + for (j=0;j<=n;j++) { + x[j]=xa[j]; + y[j]=ya[j]; + } + for (j=0;j<=n;j++) { + polint(x-1,y-1,n+1-j,0.0,&cof[j],&dy); + xmin=1.0e38; + k = -1; + for (i=0;i<=n-j;i++) { + if (fabs(x[i]) < xmin) { + xmin=fabs(x[i]); + k=i; + } + if (x[i]) y[i]=(y[i]-cof[j])/x[i]; + } + for (i=k+1;i<=n-j;i++) { + y[i-1]=y[i]; + x[i-1]=x[i]; + } + } + free_vector(y,0,n); + free_vector(x,0,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/poldiv.c b/lib/nr/ansi/recipes/poldiv.c new file mode 100644 index 0000000..fe9637b --- /dev/null +++ b/lib/nr/ansi/recipes/poldiv.c @@ -0,0 +1,15 @@ + +void poldiv(float u[], int n, float v[], int nv, float q[], float r[]) +{ + int k,j; + + for (j=0;j<=n;j++) { + r[j]=u[j]; + q[j]=0.0; + } + for (k=n-nv;k>=0;k--) { + q[k]=r[nv+k]/v[nv]; + for (j=nv+k-1;j>=k;j--) r[j] -= q[k]*v[j-k]; + } + for (j=nv;j<=n;j++) r[j]=0.0; +} diff --git a/lib/nr/ansi/recipes/polin2.c b/lib/nr/ansi/recipes/polin2.c new file mode 100644 index 0000000..732062d --- /dev/null +++ b/lib/nr/ansi/recipes/polin2.c @@ -0,0 +1,19 @@ + +#define NRANSI +#include "nrutil.h" + +void polin2(float x1a[], float x2a[], float **ya, int m, int n, float x1, + float x2, float *y, float *dy) +{ + void polint(float xa[], float ya[], int n, float x, float *y, float *dy); + int j; + float *ymtmp; + + ymtmp=vector(1,m); + for (j=1;j<=m;j++) { + polint(x2a,ya[j],n,x2,&ymtmp[j],dy); + } + polint(x1a,ymtmp,m,x1,y,dy); + free_vector(ymtmp,1,m); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/polint.c b/lib/nr/ansi/recipes/polint.c new file mode 100644 index 0000000..a024ba8 --- /dev/null +++ b/lib/nr/ansi/recipes/polint.c @@ -0,0 +1,39 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void polint(float xa[], float ya[], int n, float x, float *y, float *dy) +{ + int i,m,ns=1; + float den,dif,dift,ho,hp,w; + float *c,*d; + + dif=fabs(x-xa[1]); + c=vector(1,n); + d=vector(1,n); + for (i=1;i<=n;i++) { + if ( (dift=fabs(x-xa[i])) < dif) { + ns=i; + dif=dift; + } + c[i]=ya[i]; + d[i]=ya[i]; + } + *y=ya[ns--]; + for (m=1;m +#define NRANSI +#include "nrutil.h" +#define TINY 1.0e-25 +#define ITMAX 200 + +void powell(float p[], float **xi, int n, float ftol, int *iter, float *fret, + float (*func)(float [])) +{ + void linmin(float p[], float xi[], int n, float *fret, + float (*func)(float [])); + int i,ibig,j; + float del,fp,fptt,t,*pt,*ptt,*xit; + + pt=vector(1,n); + ptt=vector(1,n); + xit=vector(1,n); + *fret=(*func)(p); + for (j=1;j<=n;j++) pt[j]=p[j]; + for (*iter=1;;++(*iter)) { + fp=(*fret); + ibig=0; + del=0.0; + for (i=1;i<=n;i++) { + for (j=1;j<=n;j++) xit[j]=xi[j][i]; + fptt=(*fret); + linmin(p,xit,n,fret,func); + if (fptt-(*fret) > del) { + del=fptt-(*fret); + ibig=i; + } + } + if (2.0*(fp-(*fret)) <= ftol*(fabs(fp)+fabs(*fret))+TINY) { + free_vector(xit,1,n); + free_vector(ptt,1,n); + free_vector(pt,1,n); + return; + } + if (*iter == ITMAX) nrerror("powell exceeding maximum iterations."); + for (j=1;j<=n;j++) { + ptt[j]=2.0*p[j]-pt[j]; + xit[j]=p[j]-pt[j]; + pt[j]=p[j]; + } + fptt=(*func)(ptt); + if (fptt < fp) { + t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)-del*SQR(fp-fptt); + if (t < 0.0) { + linmin(p,xit,n,fret,func); + for (j=1;j<=n;j++) { + xi[j][ibig]=xi[j][n]; + xi[j][n]=xit[j]; + } + } + } + } +} +#undef ITMAX +#undef NRANSI diff --git a/lib/nr/ansi/recipes/predic.c b/lib/nr/ansi/recipes/predic.c new file mode 100644 index 0000000..7716833 --- /dev/null +++ b/lib/nr/ansi/recipes/predic.c @@ -0,0 +1,22 @@ + +#define NRANSI +#include "nrutil.h" + +void predic(float data[], int ndata, float d[], int m, float future[], + int nfut) +{ + int k,j; + float sum,discrp,*reg; + + reg=vector(1,m); + for (j=1;j<=m;j++) reg[j]=data[ndata+1-j]; + for (j=1;j<=nfut;j++) { + discrp=0.0; + sum=discrp; + for (k=1;k<=m;k++) sum += d[k]*reg[k]; + for (k=m;k>=2;k--) reg[k]=reg[k-1]; + future[j]=reg[1]=sum; + } + free_vector(reg,1,m); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/probks.c b/lib/nr/ansi/recipes/probks.c new file mode 100644 index 0000000..85148fa --- /dev/null +++ b/lib/nr/ansi/recipes/probks.c @@ -0,0 +1,22 @@ + +#include +#define EPS1 0.001 +#define EPS2 1.0e-8 + +float probks(float alam) +{ + int j; + float a2,fac=2.0,sum=0.0,term,termbf=0.0; + + a2 = -2.0*alam*alam; + for (j=1;j<=100;j++) { + term=fac*exp(a2*j*j); + sum += term; + if (fabs(term) <= EPS1*termbf || fabs(term) <= EPS2*sum) return sum; + fac = -fac; + termbf=fabs(term); + } + return 1.0; +} +#undef EPS1 +#undef EPS2 diff --git a/lib/nr/ansi/recipes/psdes.c b/lib/nr/ansi/recipes/psdes.c new file mode 100644 index 0000000..9c5a985 --- /dev/null +++ b/lib/nr/ansi/recipes/psdes.c @@ -0,0 +1,22 @@ + +#define NITER 4 + +void psdes(unsigned long *lword, unsigned long *irword) +{ + unsigned long i,ia,ib,iswap,itmph=0,itmpl=0; + static unsigned long c1[NITER]={ + 0xbaa96887L, 0x1e17d32cL, 0x03bcdc3cL, 0x0f33d1b2L}; + static unsigned long c2[NITER]={ + 0x4b0f3b58L, 0xe874f0c3L, 0x6955c5a6L, 0x55a7ca46L}; + + for (i=0;i> 16; + ib=itmpl*itmpl+ ~(itmph*itmph); + *irword=(*lword) ^ (((ia = (ib >> 16) | + ((ib & 0xffff) << 16)) ^ c2[i])+itmpl*itmph); + *lword=iswap; + } +} +#undef NITER diff --git a/lib/nr/ansi/recipes/pwt.c b/lib/nr/ansi/recipes/pwt.c new file mode 100644 index 0000000..783511d --- /dev/null +++ b/lib/nr/ansi/recipes/pwt.c @@ -0,0 +1,51 @@ + +#define NRANSI +#include "nrutil.h" + +typedef struct { + int ncof,ioff,joff; + float *cc,*cr; +} wavefilt; + +extern wavefilt wfilt; + +void pwt(float a[], unsigned long n, int isign) +{ + float ai,ai1,*wksp; + unsigned long i,ii,j,jf,jr,k,n1,ni,nj,nh,nmod; + + if (n < 4) return; + wksp=vector(1,n); + nmod=wfilt.ncof*n; + n1=n-1; + nh=n >> 1; + for (j=1;j<=n;j++) wksp[j]=0.0; + if (isign >= 0) { + for (ii=1,i=1;i<=n;i+=2,ii++) { + ni=i+nmod+wfilt.ioff; + nj=i+nmod+wfilt.joff; + for (k=1;k<=wfilt.ncof;k++) { + jf=n1 & (ni+k); + jr=n1 & (nj+k); + wksp[ii] += wfilt.cc[k]*a[jf+1]; + wksp[ii+nh] += wfilt.cr[k]*a[jr+1]; + } + } + } else { + for (ii=1,i=1;i<=n;i+=2,ii++) { + ai=a[ii]; + ai1=a[ii+nh]; + ni=i+nmod+wfilt.ioff; + nj=i+nmod+wfilt.joff; + for (k=1;k<=wfilt.ncof;k++) { + jf=(n1 & (ni+k))+1; + jr=(n1 & (nj+k))+1; + wksp[jf] += wfilt.cc[k]*ai; + wksp[jr] += wfilt.cr[k]*ai1; + } + } + } + for (j=1;j<=n;j++) a[j]=wksp[j]; + free_vector(wksp,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/pwtset.c b/lib/nr/ansi/recipes/pwtset.c new file mode 100644 index 0000000..3a247e1 --- /dev/null +++ b/lib/nr/ansi/recipes/pwtset.c @@ -0,0 +1,48 @@ + +typedef struct { + int ncof,ioff,joff; + float *cc,*cr; +} wavefilt; + +wavefilt wfilt; + +void pwtset(int n) +{ + void nrerror(char error_text[]); + int k; + float sig = -1.0; + static float c4[5]={0.0,0.4829629131445341,0.8365163037378079, + 0.2241438680420134,-0.1294095225512604}; + static float c12[13]={0.0,0.111540743350, 0.494623890398, 0.751133908021, + 0.315250351709,-0.226264693965,-0.129766867567, + 0.097501605587, 0.027522865530,-0.031582039318, + 0.000553842201, 0.004777257511,-0.001077301085}; + static float c20[21]={0.0,0.026670057901, 0.188176800078, 0.527201188932, + 0.688459039454, 0.281172343661,-0.249846424327, + -0.195946274377, 0.127369340336, 0.093057364604, + -0.071394147166,-0.029457536822, 0.033212674059, + 0.003606553567,-0.010733175483, 0.001395351747, + 0.001992405295,-0.000685856695,-0.000116466855, + 0.000093588670,-0.000013264203}; + static float c4r[5],c12r[13],c20r[21]; + + wfilt.ncof=n; + if (n == 4) { + wfilt.cc=c4; + wfilt.cr=c4r; + } + else if (n == 12) { + wfilt.cc=c12; + wfilt.cr=c12r; + } + else if (n == 20) { + wfilt.cc=c20; + wfilt.cr=c20r; + } + else nrerror("unimplemented value n in pwtset"); + for (k=1;k<=n;k++) { + wfilt.cr[wfilt.ncof+1-k]=sig*wfilt.cc[k]; + sig = -sig; + } + wfilt.ioff = wfilt.joff = -(n >> 1); +} diff --git a/lib/nr/ansi/recipes/pythag.c b/lib/nr/ansi/recipes/pythag.c new file mode 100644 index 0000000..26b1572 --- /dev/null +++ b/lib/nr/ansi/recipes/pythag.c @@ -0,0 +1,14 @@ + +#include +#define NRANSI +#include "nrutil.h" + +float pythag(float a, float b) +{ + float absa,absb; + absa=fabs(a); + absb=fabs(b); + if (absa > absb) return absa*sqrt(1.0+SQR(absb/absa)); + else return (absb == 0.0 ? 0.0 : absb*sqrt(1.0+SQR(absa/absb))); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/pzextr.c b/lib/nr/ansi/recipes/pzextr.c new file mode 100644 index 0000000..039e2de --- /dev/null +++ b/lib/nr/ansi/recipes/pzextr.c @@ -0,0 +1,36 @@ + +#define NRANSI +#include "nrutil.h" + +extern float **d,*x; + +void pzextr(int iest, float xest, float yest[], float yz[], float dy[], int nv) +{ + int k1,j; + float q,f2,f1,delta,*c; + + c=vector(1,nv); + x[iest]=xest; + for (j=1;j<=nv;j++) dy[j]=yz[j]=yest[j]; + if (iest == 1) { + for (j=1;j<=nv;j++) d[j][1]=yest[j]; + } else { + for (j=1;j<=nv;j++) c[j]=yest[j]; + for (k1=1;k1 +#define NRANSI +#include "nrutil.h" + +void qrdcmp(float **a, int n, float *c, float *d, int *sing) +{ + int i,j,k; + float scale,sigma,sum,tau; + + *sing=0; + for (k=1;k +#define EPS 1.0e-6 +#define JMAX 20 +#define JMAXP (JMAX+1) +#define K 5 + +float qromb(float (*func)(float), float a, float b) +{ + void polint(float xa[], float ya[], int n, float x, float *y, float *dy); + float trapzd(float (*func)(float), float a, float b, int n); + void nrerror(char error_text[]); + float ss,dss; + float s[JMAXP],h[JMAXP+1]; + int j; + + h[1]=1.0; + for (j=1;j<=JMAX;j++) { + s[j]=trapzd(func,a,b,j); + if (j >= K) { + polint(&h[j-K],&s[j-K],K,0.0,&ss,&dss); + if (fabs(dss) <= EPS*fabs(ss)) return ss; + } + h[j+1]=0.25*h[j]; + } + nrerror("Too many steps in routine qromb"); + return 0.0; +} +#undef EPS +#undef JMAX +#undef JMAXP +#undef K diff --git a/lib/nr/ansi/recipes/qromo.c b/lib/nr/ansi/recipes/qromo.c new file mode 100644 index 0000000..20f1518 --- /dev/null +++ b/lib/nr/ansi/recipes/qromo.c @@ -0,0 +1,31 @@ + +#include +#define EPS 1.0e-6 +#define JMAX 14 +#define JMAXP (JMAX+1) +#define K 5 + +float qromo(float (*func)(float), float a, float b, + float (*choose)(float(*)(float), float, float, int)) +{ + void polint(float xa[], float ya[], int n, float x, float *y, float *dy); + void nrerror(char error_text[]); + int j; + float ss,dss,h[JMAXP+1],s[JMAXP]; + + h[1]=1.0; + for (j=1;j<=JMAX;j++) { + s[j]=(*choose)(func,a,b,j); + if (j >= K) { + polint(&h[j-K],&s[j-K],K,0.0,&ss,&dss); + if (fabs(dss) <= EPS*fabs(ss)) return ss; + } + h[j+1]=h[j]/9.0; + } + nrerror("Too many steps in routing qromo"); + return 0.0; +} +#undef EPS +#undef JMAX +#undef JMAXP +#undef K diff --git a/lib/nr/ansi/recipes/qroot.c b/lib/nr/ansi/recipes/qroot.c new file mode 100644 index 0000000..9af2977 --- /dev/null +++ b/lib/nr/ansi/recipes/qroot.c @@ -0,0 +1,46 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define ITMAX 20 +#define TINY 1.0e-6 + +void qroot(float p[], int n, float *b, float *c, float eps) +{ + void poldiv(float u[], int n, float v[], int nv, float q[], float r[]); + int iter; + float sc,sb,s,rc,rb,r,dv,delc,delb; + float *q,*qq,*rem; + float d[3]; + + q=vector(0,n); + qq=vector(0,n); + rem=vector(0,n); + d[2]=1.0; + for (iter=1;iter<=ITMAX;iter++) { + d[1]=(*b); + d[0]=(*c); + poldiv(p,n,d,2,q,rem); + s=rem[0]; + r=rem[1]; + poldiv(q,(n-1),d,2,qq,rem); + sb = -(*c)*(rc = -rem[1]); + rb = -(*b)*rc+(sc = -rem[0]); + dv=1.0/(sb*rc-sc*rb); + delb=(r*sc-s*rc)*dv; + delc=(-r*sb+s*rb)*dv; + *b += (delb=(r*sc-s*rc)*dv); + *c += (delc=(-r*sb+s*rb)*dv); + if ((fabs(delb) <= eps*fabs(*b) || fabs(*b) < TINY) + && (fabs(delc) <= eps*fabs(*c) || fabs(*c) < TINY)) { + free_vector(rem,0,n); + free_vector(qq,0,n); + free_vector(q,0,n); + return; + } + } + nrerror("Too many iterations in routine qroot"); +} +#undef ITMAX +#undef TINY +#undef NRANSI diff --git a/lib/nr/ansi/recipes/qrsolv.c b/lib/nr/ansi/recipes/qrsolv.c new file mode 100644 index 0000000..a97bb1f --- /dev/null +++ b/lib/nr/ansi/recipes/qrsolv.c @@ -0,0 +1,14 @@ + +void qrsolv(float **a, int n, float c[], float d[], float b[]) +{ + void rsolv(float **a, int n, float d[], float b[]); + int i,j; + float sum,tau; + + for (j=1;j +#define NRANSI +#include "nrutil.h" + +void qrupdt(float **r, float **qt, int n, float u[], float v[]) +{ + void rotate(float **r, float **qt, int n, int i, float a, float b); + int i,j,k; + + for (k=n;k>=1;k--) { + if (u[k]) break; + } + if (k < 1) k=1; + for (i=k-1;i>=1;i--) { + rotate(r,qt,n,i,u[i],-u[i+1]); + if (u[i] == 0.0) u[i]=fabs(u[i+1]); + else if (fabs(u[i]) > fabs(u[i+1])) + u[i]=fabs(u[i])*sqrt(1.0+SQR(u[i+1]/u[i])); + else u[i]=fabs(u[i+1])*sqrt(1.0+SQR(u[i]/u[i+1])); + } + for (j=1;j<=n;j++) r[1][j] += u[1]*v[j]; + for (i=1;i +#define EPS 1.0e-6 +#define JMAX 20 + +float qsimp(float (*func)(float), float a, float b) +{ + float trapzd(float (*func)(float), float a, float b, int n); + void nrerror(char error_text[]); + int j; + float s,st,ost=0.0,os=0.0; + + for (j=1;j<=JMAX;j++) { + st=trapzd(func,a,b,j); + s=(4.0*st-ost)/3.0; + if (j > 5) + if (fabs(s-os) < EPS*fabs(os) || + (s == 0.0 && os == 0.0)) return s; + os=s; + ost=st; + } + nrerror("Too many steps in routine qsimp"); + return 0.0; +} +#undef EPS +#undef JMAX diff --git a/lib/nr/ansi/recipes/qtrap.c b/lib/nr/ansi/recipes/qtrap.c new file mode 100644 index 0000000..777ecc2 --- /dev/null +++ b/lib/nr/ansi/recipes/qtrap.c @@ -0,0 +1,24 @@ + +#include +#define EPS 1.0e-5 +#define JMAX 20 + +float qtrap(float (*func)(float), float a, float b) +{ + float trapzd(float (*func)(float), float a, float b, int n); + void nrerror(char error_text[]); + int j; + float s,olds=0.0; + + for (j=1;j<=JMAX;j++) { + s=trapzd(func,a,b,j); + if (j > 5) + if (fabs(s-olds) < EPS*fabs(olds) || + (s == 0.0 && olds == 0.0)) return s; + olds=s; + } + nrerror("Too many steps in routine qtrap"); + return 0.0; +} +#undef EPS +#undef JMAX diff --git a/lib/nr/ansi/recipes/quad3d.c b/lib/nr/ansi/recipes/quad3d.c new file mode 100644 index 0000000..c8850a1 --- /dev/null +++ b/lib/nr/ansi/recipes/quad3d.c @@ -0,0 +1,37 @@ + +static float xsav,ysav; +static float (*nrfunc)(float,float,float); + +float quad3d(float (*func)(float, float, float), float x1, float x2) +{ + float qgaus(float (*func)(float), float a, float b); + float f1(float x); + + nrfunc=func; + return qgaus(f1,x1,x2); +} + +float f1(float x) +{ + float qgaus(float (*func)(float), float a, float b); + float f2(float y); + float yy1(float),yy2(float); + + xsav=x; + return qgaus(f2,yy1(x),yy2(x)); +} + +float f2(float y) +{ + float qgaus(float (*func)(float), float a, float b); + float f3(float z); + float z1(float,float),z2(float,float); + + ysav=y; + return qgaus(f3,z1(xsav,y),z2(xsav,y)); +} + +float f3(float z) +{ + return (*nrfunc)(xsav,ysav,z); +} diff --git a/lib/nr/ansi/recipes/quadct.c b/lib/nr/ansi/recipes/quadct.c new file mode 100644 index 0000000..3d70425 --- /dev/null +++ b/lib/nr/ansi/recipes/quadct.c @@ -0,0 +1,20 @@ + +void quadct(float x, float y, float xx[], float yy[], unsigned long nn, + float *fa, float *fb, float *fc, float *fd) +{ + unsigned long k,na,nb,nc,nd; + float ff; + na=nb=nc=nd=0; + for (k=1;k<=nn;k++) { + if (yy[k] > y) { + xx[k] > x ? ++na : ++nb; + } else { + xx[k] > x ? ++nd : ++nc; + } + } + ff=1.0/nn; + *fa=ff*na; + *fb=ff*nb; + *fc=ff*nc; + *fd=ff*nd; +} diff --git a/lib/nr/ansi/recipes/quadmx.c b/lib/nr/ansi/recipes/quadmx.c new file mode 100644 index 0000000..a5e0fa2 --- /dev/null +++ b/lib/nr/ansi/recipes/quadmx.c @@ -0,0 +1,29 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define PI 3.14159265 + +double x; + +void quadmx(float **a, int n) +{ + void kermom(double w[], double y, int m); + void wwghts(float wghts[], int n, float h, + void (*kermom)(double [], double ,int)); + int j,k; + float h,*wt,xx,cx; + + wt=vector(1,n); + h=PI/(n-1); + for (j=1;j<=n;j++) { + x=xx=(j-1)*h; + wwghts(wt,n,h,kermom); + cx=cos(xx); + for (k=1;k<=n;k++) a[j][k]=wt[k]*cx*cos((k-1)*h); + ++a[j][j]; + } + free_vector(wt,1,n); +} +#undef PI +#undef NRANSI diff --git a/lib/nr/ansi/recipes/quadvl.c b/lib/nr/ansi/recipes/quadvl.c new file mode 100644 index 0000000..444b366 --- /dev/null +++ b/lib/nr/ansi/recipes/quadvl.c @@ -0,0 +1,18 @@ + +#define NRANSI +#include "nrutil.h" + +void quadvl(float x, float y, float *fa, float *fb, float *fc, float *fd) +{ + float qa,qb,qc,qd; + + qa=FMIN(2.0,FMAX(0.0,1.0-x)); + qb=FMIN(2.0,FMAX(0.0,1.0-y)); + qc=FMIN(2.0,FMAX(0.0,x+1.0)); + qd=FMIN(2.0,FMAX(0.0,y+1.0)); + *fa=0.25*qa*qb; + *fb=0.25*qb*qc; + *fc=0.25*qc*qd; + *fd=0.25*qd*qa; +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/ran0.c b/lib/nr/ansi/recipes/ran0.c new file mode 100644 index 0000000..238e5f3 --- /dev/null +++ b/lib/nr/ansi/recipes/ran0.c @@ -0,0 +1,27 @@ + +#define IA 16807 +#define IM 2147483647 +#define AM (1.0/IM) +#define IQ 127773 +#define IR 2836 +#define MASK 123459876 + +float ran0(long *idum) +{ + long k; + float ans; + + *idum ^= MASK; + k=(*idum)/IQ; + *idum=IA*(*idum-k*IQ)-IR*k; + if (*idum < 0) *idum += IM; + ans=AM*(*idum); + *idum ^= MASK; + return ans; +} +#undef IA +#undef IM +#undef AM +#undef IQ +#undef IR +#undef MASK diff --git a/lib/nr/ansi/recipes/ran1.c b/lib/nr/ansi/recipes/ran1.c new file mode 100644 index 0000000..a7fd219 --- /dev/null +++ b/lib/nr/ansi/recipes/ran1.c @@ -0,0 +1,48 @@ + +#define IA 16807 +#define IM 2147483647 +#define AM (1.0/IM) +#define IQ 127773 +#define IR 2836 +#define NTAB 32 +#define NDIV (1+(IM-1)/NTAB) +#define EPS 1.2e-7 +#define RNMX (1.0-EPS) + +float ran1(long *idum) +{ + int j; + long k; + static long iy=0; + static long iv[NTAB]; + float temp; + + if (*idum <= 0 || !iy) { + if (-(*idum) < 1) *idum=1; + else *idum = -(*idum); + for (j=NTAB+7;j>=0;j--) { + k=(*idum)/IQ; + *idum=IA*(*idum-k*IQ)-IR*k; + if (*idum < 0) *idum += IM; + if (j < NTAB) iv[j] = *idum; + } + iy=iv[0]; + } + k=(*idum)/IQ; + *idum=IA*(*idum-k*IQ)-IR*k; + if (*idum < 0) *idum += IM; + j=iy/NDIV; + iy=iv[j]; + iv[j] = *idum; + if ((temp=AM*iy) > RNMX) return RNMX; + else return temp; +} +#undef IA +#undef IM +#undef AM +#undef IQ +#undef IR +#undef NTAB +#undef NDIV +#undef EPS +#undef RNMX diff --git a/lib/nr/ansi/recipes/ran2.c b/lib/nr/ansi/recipes/ran2.c new file mode 100644 index 0000000..69a06c0 --- /dev/null +++ b/lib/nr/ansi/recipes/ran2.c @@ -0,0 +1,64 @@ + +#define IM1 2147483563 +#define IM2 2147483399 +#define AM (1.0/IM1) +#define IMM1 (IM1-1) +#define IA1 40014 +#define IA2 40692 +#define IQ1 53668 +#define IQ2 52774 +#define IR1 12211 +#define IR2 3791 +#define NTAB 32 +#define NDIV (1+IMM1/NTAB) +#define EPS 1.2e-7 +#define RNMX (1.0-EPS) + +float ran2(long *idum) +{ + int j; + long k; + static long idum2=123456789; + static long iy=0; + static long iv[NTAB]; + float temp; + + if (*idum <= 0) { + if (-(*idum) < 1) *idum=1; + else *idum = -(*idum); + idum2=(*idum); + for (j=NTAB+7;j>=0;j--) { + k=(*idum)/IQ1; + *idum=IA1*(*idum-k*IQ1)-k*IR1; + if (*idum < 0) *idum += IM1; + if (j < NTAB) iv[j] = *idum; + } + iy=iv[0]; + } + k=(*idum)/IQ1; + *idum=IA1*(*idum-k*IQ1)-k*IR1; + if (*idum < 0) *idum += IM1; + k=idum2/IQ2; + idum2=IA2*(idum2-k*IQ2)-k*IR2; + if (idum2 < 0) idum2 += IM2; + j=iy/NDIV; + iy=iv[j]-idum2; + iv[j] = *idum; + if (iy < 1) iy += IMM1; + if ((temp=AM*iy) > RNMX) return RNMX; + else return temp; +} +#undef IM1 +#undef IM2 +#undef AM +#undef IMM1 +#undef IA1 +#undef IA2 +#undef IQ1 +#undef IQ2 +#undef IR1 +#undef IR2 +#undef NTAB +#undef NDIV +#undef EPS +#undef RNMX diff --git a/lib/nr/ansi/recipes/ran3.c b/lib/nr/ansi/recipes/ran3.c new file mode 100644 index 0000000..d84910c --- /dev/null +++ b/lib/nr/ansi/recipes/ran3.c @@ -0,0 +1,48 @@ + +#include +#define MBIG 1000000000 +#define MSEED 161803398 +#define MZ 0 +#define FAC (1.0/MBIG) + +float ran3(long *idum) +{ + static int inext,inextp; + static long ma[56]; + static int iff=0; + long mj,mk; + int i,ii,k; + + if (*idum < 0 || iff == 0) { + iff=1; + mj=labs(MSEED-labs(*idum)); + mj %= MBIG; + ma[55]=mj; + mk=1; + for (i=1;i<=54;i++) { + ii=(21*i) % 55; + ma[ii]=mk; + mk=mj-mk; + if (mk < MZ) mk += MBIG; + mj=ma[ii]; + } + for (k=1;k<=4;k++) + for (i=1;i<=55;i++) { + ma[i] -= ma[1+(i+30) % 55]; + if (ma[i] < MZ) ma[i] += MBIG; + } + inext=0; + inextp=31; + *idum=1; + } + if (++inext == 56) inext=1; + if (++inextp == 56) inextp=1; + mj=ma[inext]-ma[inextp]; + if (mj < MZ) mj += MBIG; + ma[inext]=mj; + return mj*FAC; +} +#undef MBIG +#undef MSEED +#undef MZ +#undef FAC diff --git a/lib/nr/ansi/recipes/ran4.c b/lib/nr/ansi/recipes/ran4.c new file mode 100644 index 0000000..fb266c9 --- /dev/null +++ b/lib/nr/ansi/recipes/ran4.c @@ -0,0 +1,25 @@ + +float ran4(long *idum) +{ + void psdes(unsigned long *lword, unsigned long *irword); + unsigned long irword,itemp,lword; + static long idums = 0; +#if defined(vax) || defined(_vax_) || defined(__vax__) || defined(VAX) + static unsigned long jflone = 0x00004080; + static unsigned long jflmsk = 0xffff007f; +#else + static unsigned long jflone = 0x3f800000; + static unsigned long jflmsk = 0x007fffff; +#endif + + if (*idum < 0) { + idums = -(*idum); + *idum=1; + } + irword=(*idum); + lword=idums; + psdes(&lword,&irword); + itemp=jflone | (jflmsk & irword); + ++(*idum); + return (*(float *)&itemp)-1.0; +} diff --git a/lib/nr/ansi/recipes/rank.c b/lib/nr/ansi/recipes/rank.c new file mode 100644 index 0000000..26daea7 --- /dev/null +++ b/lib/nr/ansi/recipes/rank.c @@ -0,0 +1,7 @@ + +void rank(unsigned long n, unsigned long indx[], unsigned long irank[]) +{ + unsigned long j; + + for (j=1;j<=n;j++) irank[indx[j]]=j; +} diff --git a/lib/nr/ansi/recipes/ranpt.c b/lib/nr/ansi/recipes/ranpt.c new file mode 100644 index 0000000..9d963f6 --- /dev/null +++ b/lib/nr/ansi/recipes/ranpt.c @@ -0,0 +1,11 @@ + +extern long idum; + +void ranpt(float pt[], float regn[], int n) +{ + float ran1(long *idum); + int j; + + for (j=1;j<=n;j++) + pt[j]=regn[j]+(regn[n+j]-regn[j])*ran1(&idum); +} diff --git a/lib/nr/ansi/recipes/ratint.c b/lib/nr/ansi/recipes/ratint.c new file mode 100644 index 0000000..af42b2c --- /dev/null +++ b/lib/nr/ansi/recipes/ratint.c @@ -0,0 +1,47 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define TINY 1.0e-25 +#define FREERETURN {free_vector(d,1,n);free_vector(c,1,n);return;} + +void ratint(float xa[], float ya[], int n, float x, float *y, float *dy) +{ + int m,i,ns=1; + float w,t,hh,h,dd,*c,*d; + + c=vector(1,n); + d=vector(1,n); + hh=fabs(x-xa[1]); + for (i=1;i<=n;i++) { + h=fabs(x-xa[i]); + if (h == 0.0) { + *y=ya[i]; + *dy=0.0; + FREERETURN + } else if (h < hh) { + ns=i; + hh=h; + } + c[i]=ya[i]; + d[i]=ya[i]+TINY; + } + *y=ya[ns--]; + for (m=1;m +#include +#define NRANSI +#include "nrutil.h" +#define NPFAC 8 +#define MAXIT 5 +#define PIO2 (3.141592653589793/2.0) +#define BIG 1.0e30 + +void ratlsq(double (*fn)(double), double a, double b, int mm, int kk, + double cof[], double *dev) +{ + double ratval(double x, double cof[], int mm, int kk); + void dsvbksb(double **u, double w[], double **v, int m, int n, double b[], + double x[]); + void dsvdcmp(double **a, int m, int n, double w[], double **v); + int i,it,j,ncof,npt; + double devmax,e,hth,power,sum,*bb,*coff,*ee,*fs,**u,**v,*w,*wt,*xs; + + ncof=mm+kk+1; + npt=NPFAC*ncof; + bb=dvector(1,npt); + coff=dvector(0,ncof-1); + ee=dvector(1,npt); + fs=dvector(1,npt); + u=dmatrix(1,npt,1,ncof); + v=dmatrix(1,ncof,1,ncof); + w=dvector(1,ncof); + wt=dvector(1,npt); + xs=dvector(1,npt); + *dev=BIG; + for (i=1;i<=npt;i++) { + if (i < npt/2) { + hth=PIO2*(i-1)/(npt-1.0); + xs[i]=a+(b-a)*DSQR(sin(hth)); + } else { + hth=PIO2*(npt-i)/(npt-1.0); + xs[i]=b-(b-a)*DSQR(sin(hth)); + } + fs[i]=(*fn)(xs[i]); + wt[i]=1.0; + ee[i]=1.0; + } + e=0.0; + for (it=1;it<=MAXIT;it++) { + for (i=1;i<=npt;i++) { + power=wt[i]; + bb[i]=power*(fs[i]+SIGN(e,ee[i])); + for (j=1;j<=mm+1;j++) { + u[i][j]=power; + power *= xs[i]; + } + power = -bb[i]; + for (j=mm+2;j<=ncof;j++) { + power *= xs[i]; + u[i][j]=power; + } + } + dsvdcmp(u,npt,ncof,w,v); + dsvbksb(u,w,v,npt,ncof,bb,coff-1); + devmax=sum=0.0; + for (j=1;j<=npt;j++) { + ee[j]=ratval(xs[j],coff,mm,kk)-fs[j]; + wt[j]=fabs(ee[j]); + sum += wt[j]; + if (wt[j] > devmax) devmax=wt[j]; + } + e=sum/npt; + if (devmax <= *dev) { + for (j=0;j=0;j--) sumn=sumn*x+cof[j]; + for (sumd=0.0,j=mm+kk;j>=mm+1;j--) sumd=(sumd+cof[j])*x; + return sumn/(1.0+sumd); +} diff --git a/lib/nr/ansi/recipes/rc.c b/lib/nr/ansi/recipes/rc.c new file mode 100644 index 0000000..1feb386 --- /dev/null +++ b/lib/nr/ansi/recipes/rc.c @@ -0,0 +1,54 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define ERRTOL 0.04 +#define TINY 1.69e-38 +#define SQRTNY 1.3e-19 +#define BIG 3.e37 +#define TNBG (TINY*BIG) +#define COMP1 (2.236/SQRTNY) +#define COMP2 (TNBG*TNBG/25.0) +#define THIRD (1.0/3.0) +#define C1 0.3 +#define C2 (1.0/7.0) +#define C3 0.375 +#define C4 (9.0/22.0) + +float rc(float x, float y) +{ + float alamb,ave,s,w,xt,yt; + if (x < 0.0 || y == 0.0 || (x+fabs(y)) < TINY || (x+fabs(y)) > BIG || + (y<-COMP1 && x > 0.0 && x < COMP2)) + nrerror("invalid arguments in rc"); + if (y > 0.0) { + xt=x; + yt=y; + w=1.0; + } else { + xt=x-y; + yt = -y; + w=sqrt(x)/sqrt(xt); + } + do { + alamb=2.0*sqrt(xt)*sqrt(yt)+yt; + xt=0.25*(xt+alamb); + yt=0.25*(yt+alamb); + ave=THIRD*(xt+yt+yt); + s=(yt-ave)/ave; + } while (fabs(s) > ERRTOL); + return w*(1.0+s*s*(C1+s*(C2+s*(C3+s*C4))))/sqrt(ave); +} +#undef ERRTOL +#undef TINY +#undef SQRTNY +#undef BIG +#undef TNBG +#undef COMP1 +#undef COMP2 +#undef THIRD +#undef C1 +#undef C2 +#undef C3 +#undef C4 +#undef NRANSI diff --git a/lib/nr/ansi/recipes/rd.c b/lib/nr/ansi/recipes/rd.c new file mode 100644 index 0000000..ba588a5 --- /dev/null +++ b/lib/nr/ansi/recipes/rd.c @@ -0,0 +1,59 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define ERRTOL 0.05 +#define TINY 1.0e-25 +#define BIG 4.5e21 +#define C1 (3.0/14.0) +#define C2 (1.0/6.0) +#define C3 (9.0/22.0) +#define C4 (3.0/26.0) +#define C5 (0.25*C3) +#define C6 (1.5*C4) + +float rd(float x, float y, float z) +{ + float alamb,ave,delx,dely,delz,ea,eb,ec,ed,ee,fac,sqrtx,sqrty, + sqrtz,sum,xt,yt,zt; + + if (FMIN(x,y) < 0.0 || FMIN(x+y,z) < TINY || FMAX(FMAX(x,y),z) > BIG) + nrerror("invalid arguments in rd"); + xt=x; + yt=y; + zt=z; + sum=0.0; + fac=1.0; + do { + sqrtx=sqrt(xt); + sqrty=sqrt(yt); + sqrtz=sqrt(zt); + alamb=sqrtx*(sqrty+sqrtz)+sqrty*sqrtz; + sum += fac/(sqrtz*(zt+alamb)); + fac=0.25*fac; + xt=0.25*(xt+alamb); + yt=0.25*(yt+alamb); + zt=0.25*(zt+alamb); + ave=0.2*(xt+yt+3.0*zt); + delx=(ave-xt)/ave; + dely=(ave-yt)/ave; + delz=(ave-zt)/ave; + } while (FMAX(FMAX(fabs(delx),fabs(dely)),fabs(delz)) > ERRTOL); + ea=delx*dely; + eb=delz*delz; + ec=ea-eb; + ed=ea-6.0*eb; + ee=ed+ec+ec; + return 3.0*sum+fac*(1.0+ed*(-C1+C5*ed-C6*delz*ee) + +delz*(C2*ee+delz*(-C3*ec+delz*C4*ea)))/(ave*sqrt(ave)); +} +#undef ERRTOL +#undef TINY +#undef BIG +#undef C1 +#undef C2 +#undef C3 +#undef C4 +#undef C5 +#undef C6 +#undef NRANSI diff --git a/lib/nr/ansi/recipes/realft.c b/lib/nr/ansi/recipes/realft.c new file mode 100644 index 0000000..7db2e2d --- /dev/null +++ b/lib/nr/ansi/recipes/realft.c @@ -0,0 +1,46 @@ + +#include + +void realft(float data[], unsigned long n, int isign) +{ + void four1(float data[], unsigned long nn, int isign); + unsigned long i,i1,i2,i3,i4,np3; + float c1=0.5,c2,h1r,h1i,h2r,h2i; + double wr,wi,wpr,wpi,wtemp,theta; + + theta=3.141592653589793/(double) (n>>1); + if (isign == 1) { + c2 = -0.5; + four1(data,n>>1,1); + } else { + c2=0.5; + theta = -theta; + } + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0+wpr; + wi=wpi; + np3=n+3; + for (i=2;i<=(n>>2);i++) { + i4=1+(i3=np3-(i2=1+(i1=i+i-1))); + h1r=c1*(data[i1]+data[i3]); + h1i=c1*(data[i2]-data[i4]); + h2r = -c2*(data[i2]+data[i4]); + h2i=c2*(data[i1]-data[i3]); + data[i1]=h1r+wr*h2r-wi*h2i; + data[i2]=h1i+wr*h2i+wi*h2r; + data[i3]=h1r-wr*h2r+wi*h2i; + data[i4] = -h1i+wr*h2i+wi*h2r; + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + } + if (isign == 1) { + data[1] = (h1r=data[1])+data[2]; + data[2] = h1r-data[2]; + } else { + data[1]=c1*((h1r=data[1])+data[2]); + data[2]=c1*(h1r-data[2]); + four1(data,n>>1,-1); + } +} diff --git a/lib/nr/ansi/recipes/rebin.c b/lib/nr/ansi/recipes/rebin.c new file mode 100644 index 0000000..050f479 --- /dev/null +++ b/lib/nr/ansi/recipes/rebin.c @@ -0,0 +1,17 @@ + +void rebin(float rc, int nd, float r[], float xin[], float xi[]) +{ + int i,k=0; + float dr=0.0,xn=0.0,xo=0.0; + + for (i=1;i dr) + dr += r[++k]; + if (k > 1) xo=xi[k-1]; + xn=xi[k]; + dr -= rc; + xin[i]=xn-(xn-xo)*dr/r[k]; + } + for (i=1;i +#define ALEN(a,b,c,d) sqrt(((b)-(a))*((b)-(a))+((d)-(c))*((d)-(c))) + +float revcst(float x[], float y[], int iorder[], int ncity, int n[]) +{ + float xx[5],yy[5],de; + int j,ii; + + n[3]=1 + ((n[1]+ncity-2) % ncity); + n[4]=1 + (n[2] % ncity); + for (j=1;j<=4;j++) { + ii=iorder[n[j]]; + xx[j]=x[ii]; + yy[j]=y[ii]; + } + de = -ALEN(xx[1],xx[3],yy[1],yy[3]); + de -= ALEN(xx[2],xx[4],yy[2],yy[4]); + de += ALEN(xx[1],xx[4],yy[1],yy[4]); + de += ALEN(xx[2],xx[3],yy[2],yy[3]); + return de; +} +#undef ALEN diff --git a/lib/nr/ansi/recipes/reverse.c b/lib/nr/ansi/recipes/reverse.c new file mode 100644 index 0000000..6524fe3 --- /dev/null +++ b/lib/nr/ansi/recipes/reverse.c @@ -0,0 +1,14 @@ + +void reverse(int iorder[], int ncity, int n[]) +{ + int nn,j,k,l,itmp; + + nn=(1+((n[2]-n[1]+ncity) % ncity))/2; + for (j=1;j<=nn;j++) { + k=1 + ((n[1]+j-2) % ncity); + l=1 + ((n[2]-j+ncity) % ncity); + itmp=iorder[k]; + iorder[k]=iorder[l]; + iorder[l]=itmp; + } +} diff --git a/lib/nr/ansi/recipes/rf.c b/lib/nr/ansi/recipes/rf.c new file mode 100644 index 0000000..80a030f --- /dev/null +++ b/lib/nr/ansi/recipes/rf.c @@ -0,0 +1,49 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define ERRTOL 0.08 +#define TINY 1.5e-38 +#define BIG 3.0e37 +#define THIRD (1.0/3.0) +#define C1 (1.0/24.0) +#define C2 0.1 +#define C3 (3.0/44.0) +#define C4 (1.0/14.0) + +float rf(float x, float y, float z) +{ + float alamb,ave,delx,dely,delz,e2,e3,sqrtx,sqrty,sqrtz,xt,yt,zt; + + if (FMIN(FMIN(x,y),z) < 0.0 || FMIN(FMIN(x+y,x+z),y+z) < TINY || + FMAX(FMAX(x,y),z) > BIG) + nrerror("invalid arguments in rf"); + xt=x; + yt=y; + zt=z; + do { + sqrtx=sqrt(xt); + sqrty=sqrt(yt); + sqrtz=sqrt(zt); + alamb=sqrtx*(sqrty+sqrtz)+sqrty*sqrtz; + xt=0.25*(xt+alamb); + yt=0.25*(yt+alamb); + zt=0.25*(zt+alamb); + ave=THIRD*(xt+yt+zt); + delx=(ave-xt)/ave; + dely=(ave-yt)/ave; + delz=(ave-zt)/ave; + } while (FMAX(FMAX(fabs(delx),fabs(dely)),fabs(delz)) > ERRTOL); + e2=delx*dely-delz*delz; + e3=delx*dely*delz; + return (1.0+(C1*e2-C2-C3*e3)*e2+C4*e3)/sqrt(ave); +} +#undef ERRTOL +#undef TINY +#undef BIG +#undef THIRD +#undef C1 +#undef C2 +#undef C3 +#undef C4 +#undef NRANSI diff --git a/lib/nr/ansi/recipes/rj.c b/lib/nr/ansi/recipes/rj.c new file mode 100644 index 0000000..0a73d11 --- /dev/null +++ b/lib/nr/ansi/recipes/rj.c @@ -0,0 +1,86 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define ERRTOL 0.05 +#define TINY 2.5e-13 +#define BIG 9.0e11 +#define C1 (3.0/14.0) +#define C2 (1.0/3.0) +#define C3 (3.0/22.0) +#define C4 (3.0/26.0) +#define C5 (0.75*C3) +#define C6 (1.5*C4) +#define C7 (0.5*C2) +#define C8 (C3+C3) + +float rj(float x, float y, float z, float p) +{ + float rc(float x, float y); + float rf(float x, float y, float z); + float a,alamb,alpha,ans,ave,b,beta,delp,delx,dely,delz,ea,eb,ec, + ed,ee,fac,pt,rcx,rho,sqrtx,sqrty,sqrtz,sum,tau,xt,yt,zt; + + if (FMIN(FMIN(x,y),z) < 0.0 || FMIN(FMIN(FMIN(x+y,x+z),y+z),fabs(p)) < TINY + || FMAX(FMAX(FMAX(x,y),z),fabs(p)) > BIG) + nrerror("invalid arguments in rj"); + sum=0.0; + fac=1.0; + if (p > 0.0) { + xt=x; + yt=y; + zt=z; + pt=p; + } else { + xt=FMIN(FMIN(x,y),z); + zt=FMAX(FMAX(x,y),z); + yt=x+y+z-xt-zt; + a=1.0/(yt-p); + b=a*(zt-yt)*(yt-xt); + pt=yt+b; + rho=xt*zt/yt; + tau=p*pt/yt; + rcx=rc(rho,tau); + } + do { + sqrtx=sqrt(xt); + sqrty=sqrt(yt); + sqrtz=sqrt(zt); + alamb=sqrtx*(sqrty+sqrtz)+sqrty*sqrtz; + alpha=SQR(pt*(sqrtx+sqrty+sqrtz)+sqrtx*sqrty*sqrtz); + beta=pt*SQR(pt+alamb); + sum += fac*rc(alpha,beta); + fac=0.25*fac; + xt=0.25*(xt+alamb); + yt=0.25*(yt+alamb); + zt=0.25*(zt+alamb); + pt=0.25*(pt+alamb); + ave=0.2*(xt+yt+zt+pt+pt); + delx=(ave-xt)/ave; + dely=(ave-yt)/ave; + delz=(ave-zt)/ave; + delp=(ave-pt)/ave; + } while (FMAX(FMAX(FMAX(fabs(delx),fabs(dely)), + fabs(delz)),fabs(delp)) > ERRTOL); + ea=delx*(dely+delz)+dely*delz; + eb=delx*dely*delz; + ec=delp*delp; + ed=ea-3.0*ec; + ee=eb+2.0*delp*(ea-ec); + ans=3.0*sum+fac*(1.0+ed*(-C1+C5*ed-C6*ee)+eb*(C7+delp*(-C8+delp*C4)) + +delp*ea*(C2-delp*C3)-C2*delp*ec)/(ave*sqrt(ave)); + if (p <= 0.0) ans=a*(b*ans+3.0*(rcx-rf(xt,yt,zt))); + return ans; +} +#undef ERRTOL +#undef TINY +#undef BIG +#undef C1 +#undef C2 +#undef C3 +#undef C4 +#undef C5 +#undef C6 +#undef C7 +#undef C8 +#undef NRANSI diff --git a/lib/nr/ansi/recipes/rk4.c b/lib/nr/ansi/recipes/rk4.c new file mode 100644 index 0000000..6c4dc90 --- /dev/null +++ b/lib/nr/ansi/recipes/rk4.c @@ -0,0 +1,32 @@ + +#define NRANSI +#include "nrutil.h" + +void rk4(float y[], float dydx[], int n, float x, float h, float yout[], + void (*derivs)(float, float [], float [])) +{ + int i; + float xh,hh,h6,*dym,*dyt,*yt; + + dym=vector(1,n); + dyt=vector(1,n); + yt=vector(1,n); + hh=h*0.5; + h6=h/6.0; + xh=x+hh; + for (i=1;i<=n;i++) yt[i]=y[i]+hh*dydx[i]; + (*derivs)(xh,yt,dyt); + for (i=1;i<=n;i++) yt[i]=y[i]+hh*dyt[i]; + (*derivs)(xh,yt,dym); + for (i=1;i<=n;i++) { + yt[i]=y[i]+h*dym[i]; + dym[i] += dyt[i]; + } + (*derivs)(x+h,yt,dyt); + for (i=1;i<=n;i++) + yout[i]=y[i]+h6*(dydx[i]+dyt[i]+2.0*dym[i]); + free_vector(yt,1,n); + free_vector(dyt,1,n); + free_vector(dym,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/rkck.c b/lib/nr/ansi/recipes/rkck.c new file mode 100644 index 0000000..e9aabd3 --- /dev/null +++ b/lib/nr/ansi/recipes/rkck.c @@ -0,0 +1,52 @@ + +#define NRANSI +#include "nrutil.h" + +void rkck(float y[], float dydx[], int n, float x, float h, float yout[], + float yerr[], void (*derivs)(float, float [], float [])) +{ + int i; + static float a2=0.2,a3=0.3,a4=0.6,a5=1.0,a6=0.875,b21=0.2, + b31=3.0/40.0,b32=9.0/40.0,b41=0.3,b42 = -0.9,b43=1.2, + b51 = -11.0/54.0, b52=2.5,b53 = -70.0/27.0,b54=35.0/27.0, + b61=1631.0/55296.0,b62=175.0/512.0,b63=575.0/13824.0, + b64=44275.0/110592.0,b65=253.0/4096.0,c1=37.0/378.0, + c3=250.0/621.0,c4=125.0/594.0,c6=512.0/1771.0, + dc5 = -277.00/14336.0; + float dc1=c1-2825.0/27648.0,dc3=c3-18575.0/48384.0, + dc4=c4-13525.0/55296.0,dc6=c6-0.25; + float *ak2,*ak3,*ak4,*ak5,*ak6,*ytemp; + + ak2=vector(1,n); + ak3=vector(1,n); + ak4=vector(1,n); + ak5=vector(1,n); + ak6=vector(1,n); + ytemp=vector(1,n); + for (i=1;i<=n;i++) + ytemp[i]=y[i]+b21*h*dydx[i]; + (*derivs)(x+a2*h,ytemp,ak2); + for (i=1;i<=n;i++) + ytemp[i]=y[i]+h*(b31*dydx[i]+b32*ak2[i]); + (*derivs)(x+a3*h,ytemp,ak3); + for (i=1;i<=n;i++) + ytemp[i]=y[i]+h*(b41*dydx[i]+b42*ak2[i]+b43*ak3[i]); + (*derivs)(x+a4*h,ytemp,ak4); + for (i=1;i<=n;i++) + ytemp[i]=y[i]+h*(b51*dydx[i]+b52*ak2[i]+b53*ak3[i]+b54*ak4[i]); + (*derivs)(x+a5*h,ytemp,ak5); + for (i=1;i<=n;i++) + ytemp[i]=y[i]+h*(b61*dydx[i]+b62*ak2[i]+b63*ak3[i]+b64*ak4[i]+b65*ak5[i]); + (*derivs)(x+a6*h,ytemp,ak6); + for (i=1;i<=n;i++) + yout[i]=y[i]+h*(c1*dydx[i]+c3*ak3[i]+c4*ak4[i]+c6*ak6[i]); + for (i=1;i<=n;i++) + yerr[i]=h*(dc1*dydx[i]+dc3*ak3[i]+dc4*ak4[i]+dc5*ak5[i]+dc6*ak6[i]); + free_vector(ytemp,1,n); + free_vector(ak6,1,n); + free_vector(ak5,1,n); + free_vector(ak4,1,n); + free_vector(ak3,1,n); + free_vector(ak2,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/rkdumb.c b/lib/nr/ansi/recipes/rkdumb.c new file mode 100644 index 0000000..586e14e --- /dev/null +++ b/lib/nr/ansi/recipes/rkdumb.c @@ -0,0 +1,41 @@ + +#define NRANSI +#include "nrutil.h" + +float **y,*xx; + +void rkdumb(float vstart[], int nvar, float x1, float x2, int nstep, + void (*derivs)(float, float [], float [])) +{ + void rk4(float y[], float dydx[], int n, float x, float h, float yout[], + void (*derivs)(float, float [], float [])); + int i,k; + float x,h; + float *v,*vout,*dv; + + v=vector(1,nvar); + vout=vector(1,nvar); + dv=vector(1,nvar); + for (i=1;i<=nvar;i++) { + v[i]=vstart[i]; + y[i][1]=v[i]; + } + xx[1]=x1; + x=x1; + h=(x2-x1)/nstep; + for (k=1;k<=nstep;k++) { + (*derivs)(x,v,dv); + rk4(v,dv,nvar,x,h,vout,derivs); + if ((float)(x+h) == x) nrerror("Step size too small in routine rkdumb"); + x += h; + xx[k+1]=x; + for (i=1;i<=nvar;i++) { + v[i]=vout[i]; + y[i][k+1]=v[i]; + } + } + free_vector(dv,1,nvar); + free_vector(vout,1,nvar); + free_vector(v,1,nvar); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/rkqs.c b/lib/nr/ansi/recipes/rkqs.c new file mode 100644 index 0000000..dab9897 --- /dev/null +++ b/lib/nr/ansi/recipes/rkqs.c @@ -0,0 +1,44 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define SAFETY 0.9 +#define PGROW -0.2 +#define PSHRNK -0.25 +#define ERRCON 1.89e-4 + +void rkqs(float y[], float dydx[], int n, float *x, float htry, float eps, + float yscal[], float *hdid, float *hnext, + void (*derivs)(float, float [], float [])) +{ + void rkck(float y[], float dydx[], int n, float x, float h, + float yout[], float yerr[], void (*derivs)(float, float [], float [])); + int i; + float errmax,h,htemp,xnew,*yerr,*ytemp; + + yerr=vector(1,n); + ytemp=vector(1,n); + h=htry; + for (;;) { + rkck(y,dydx,n,*x,h,ytemp,yerr,derivs); + errmax=0.0; + for (i=1;i<=n;i++) errmax=FMAX(errmax,fabs(yerr[i]/yscal[i])); + errmax /= eps; + if (errmax <= 1.0) break; + htemp=SAFETY*h*pow(errmax,PSHRNK); + h=(h >= 0.0 ? FMAX(htemp,0.1*h) : FMIN(htemp,0.1*h)); + xnew=(*x)+h; + if (xnew == *x) nrerror("stepsize underflow in rkqs"); + } + if (errmax > ERRCON) *hnext=SAFETY*h*pow(errmax,PGROW); + else *hnext=5.0*h; + *x += (*hdid=h); + for (i=1;i<=n;i++) y[i]=ytemp[i]; + free_vector(ytemp,1,n); + free_vector(yerr,1,n); +} +#undef SAFETY +#undef PGROW +#undef PSHRNK +#undef ERRCON +#undef NRANSI diff --git a/lib/nr/ansi/recipes/rlft3.c b/lib/nr/ansi/recipes/rlft3.c new file mode 100644 index 0000000..9ada6d9 --- /dev/null +++ b/lib/nr/ansi/recipes/rlft3.c @@ -0,0 +1,67 @@ + +#include + +void rlft3(float ***data, float **speq, unsigned long nn1, unsigned long nn2, + unsigned long nn3, int isign) +{ + void fourn(float data[], unsigned long nn[], int ndim, int isign); + void nrerror(char error_text[]); + unsigned long i1,i2,i3,j1,j2,j3,nn[4],ii3; + double theta,wi,wpi,wpr,wr,wtemp; + float c1,c2,h1r,h1i,h2r,h2i; + + if (1+&data[nn1][nn2][nn3]-&data[1][1][1] != nn1*nn2*nn3) + nrerror("rlft3: problem with dimensions or contiguity of data array\n"); + c1=0.5; + c2 = -0.5*isign; + theta=isign*(6.28318530717959/nn3); + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + nn[1]=nn1; + nn[2]=nn2; + nn[3]=nn3 >> 1; + if (isign == 1) { + fourn(&data[1][1][1]-1,nn,3,isign); + for (i1=1;i1<=nn1;i1++) + for (i2=1,j2=0;i2<=nn2;i2++) { + speq[i1][++j2]=data[i1][i2][1]; + speq[i1][++j2]=data[i1][i2][2]; + } + } + for (i1=1;i1<=nn1;i1++) { + j1=(i1 != 1 ? nn1-i1+2 : 1); + wr=1.0; + wi=0.0; + for (ii3=1,i3=1;i3<=(nn3>>2)+1;i3++,ii3+=2) { + for (i2=1;i2<=nn2;i2++) { + if (i3 == 1) { + j2=(i2 != 1 ? ((nn2-i2)<<1)+3 : 1); + h1r=c1*(data[i1][i2][1]+speq[j1][j2]); + h1i=c1*(data[i1][i2][2]-speq[j1][j2+1]); + h2i=c2*(data[i1][i2][1]-speq[j1][j2]); + h2r= -c2*(data[i1][i2][2]+speq[j1][j2+1]); + data[i1][i2][1]=h1r+h2r; + data[i1][i2][2]=h1i+h2i; + speq[j1][j2]=h1r-h2r; + speq[j1][j2+1]=h2i-h1i; + } else { + j2=(i2 != 1 ? nn2-i2+2 : 1); + j3=nn3+3-(i3<<1); + h1r=c1*(data[i1][i2][ii3]+data[j1][j2][j3]); + h1i=c1*(data[i1][i2][ii3+1]-data[j1][j2][j3+1]); + h2i=c2*(data[i1][i2][ii3]-data[j1][j2][j3]); + h2r= -c2*(data[i1][i2][ii3+1]+data[j1][j2][j3+1]); + data[i1][i2][ii3]=h1r+wr*h2r-wi*h2i; + data[i1][i2][ii3+1]=h1i+wr*h2i+wi*h2r; + data[j1][j2][j3]=h1r-wr*h2r+wi*h2i; + data[j1][j2][j3+1]= -h1i+wr*h2i+wi*h2r; + } + } + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + } + } + if (isign == -1) + fourn(&data[1][1][1]-1,nn,3,isign); +} diff --git a/lib/nr/ansi/recipes/rlftfrag.c b/lib/nr/ansi/recipes/rlftfrag.c new file mode 100644 index 0000000..9b9dff3 --- /dev/null +++ b/lib/nr/ansi/recipes/rlftfrag.c @@ -0,0 +1,92 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define N2 256 +#define N3 256 + +int main(void) /* example1 */ +{ + void rlft3(float ***data, float **speq, unsigned long nn1, + unsigned long nn2, unsigned long nn3, int isign); + float ***data, **speq; + + data=f3tensor(1,1,1,N2,1,N3); + speq=matrix(1,1,1,2*N2); + rlft3(data,speq,1,N2,N3,1); + rlft3(data,speq,1,N2,N3,-1); + free_matrix(speq,1,1,1,2*N2); + free_f3tensor(data,1,1,1,N2,1,N3); + return 0; +} +#undef N3 +#undef N2 + +#define N1 32 +#define N2 64 +#define N3 16 + +int main(void) /* example2 */ +{ + void rlft3(float ***data, float **speq, unsigned long nn1, + unsigned long nn2, unsigned long nn3, int isign); + int j; + float ***data,**speq; + + data=f3tensor(1,N1,1,N2,1,N3); + speq=matrix(1,N1,1,2*N2); + rlft3(data,speq,N1,N2,N3,1); + free_matrix(speq,1,N1,1,2*N2); + free_f3tensor(data,1,N1,1,N2,1,N3); + return 0; +} +#undef N1 +#undef N2 +#undef N3 + +#define N 32 + +int main(void) /* example3 */ +{ + void rlft3(float ***data, float **speq, unsigned long nn1, + unsigned long nn2, unsigned long nn3, int isign); + int j; + float fac,r,i,***data1,***data2,**speq1,**speq2,*sp1,*sp2; + + data1=f3tensor(1,N,1,N,1,N); + data2=f3tensor(1,N,1,N,1,N); + speq1=matrix(1,N,1,2*N); + speq2=matrix(1,N,1,2*N); + + rlft3(data1,speq1,N,N,N,1); + rlft3(data2,speq2,N,N,N,1); + fac=2.0/(N*N*N); + sp1 = &data1[1][1][1]; + sp2 = &data2[1][1][1]; + for (j=1;j<=N*N*N/2;j++) { + r = sp1[0]*sp2[0] - sp1[1]*sp2[1]; + i = sp1[0]*sp2[1] + sp1[1]*sp2[0]; + sp1[0] = fac*r; + sp1[1] = fac*i; + sp1 += 2; + sp2 += 2; + } + sp1 = &speq1[1][1]; + sp2 = &speq2[1][1]; + for (j=1;j<=N*N;j++) { + r = sp1[0]*sp2[0] - sp1[1]*sp2[1]; + i = sp1[0]*sp2[1] + sp1[1]*sp2[0]; + sp1[0] = fac*r; + sp1[1] = fac*i; + sp1 += 2; + sp2 += 2; + } + rlft3(data1,speq1,N,N,N,-1); + free_matrix(speq2,1,N,1,2*N); + free_matrix(speq1,1,N,1,2*N); + free_f3tensor(data2,1,N,1,N,1,N); + free_f3tensor(data1,1,N,1,N,1,N); + return 0; +} +#undef N +#undef NRANSI diff --git a/lib/nr/ansi/recipes/rofunc.c b/lib/nr/ansi/recipes/rofunc.c new file mode 100644 index 0000000..fcb1988 --- /dev/null +++ b/lib/nr/ansi/recipes/rofunc.c @@ -0,0 +1,36 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define EPS 1.0e-7 + +extern int ndatat; +extern float *xt,*yt,aa,abdevt; + +float rofunc(float b) +{ + float select(unsigned long k, unsigned long n, float arr[]); + int j; + float *arr,d,sum=0.0; + + arr=vector(1,ndatat); + for (j=1;j<=ndatat;j++) arr[j]=yt[j]-b*xt[j]; + if (ndatat & 1) { + aa=select((ndatat+1)>>1,ndatat,arr); + } + else { + j=ndatat >> 1; + aa=0.5*(select(j,ndatat,arr)+select(j+1,ndatat,arr)); + } + abdevt=0.0; + for (j=1;j<=ndatat;j++) { + d=yt[j]-(b*xt[j]+aa); + abdevt += fabs(d); + if (yt[j] != 0.0) d /= fabs(yt[j]); + if (fabs(d) > EPS) sum += (d >= 0.0 ? xt[j] : -xt[j]); + } + free_vector(arr,1,ndatat); + return sum; +} +#undef EPS +#undef NRANSI diff --git a/lib/nr/ansi/recipes/rotate.c b/lib/nr/ansi/recipes/rotate.c new file mode 100644 index 0000000..b2a2e0a --- /dev/null +++ b/lib/nr/ansi/recipes/rotate.c @@ -0,0 +1,36 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void rotate(float **r, float **qt, int n, int i, float a, float b) +{ + int j; + float c,fact,s,w,y; + + if (a == 0.0) { + c=0.0; + s=(b >= 0.0 ? 1.0 : -1.0); + } else if (fabs(a) > fabs(b)) { + fact=b/a; + c=SIGN(1.0/sqrt(1.0+(fact*fact)),a); + s=fact*c; + } else { + fact=a/b; + s=SIGN(1.0/sqrt(1.0+(fact*fact)),b); + c=fact*s; + } + for (j=i;j<=n;j++) { + y=r[i][j]; + w=r[i+1][j]; + r[i][j]=c*y-s*w; + r[i+1][j]=s*y+c*w; + } + for (j=1;j<=n;j++) { + y=qt[i][j]; + w=qt[i+1][j]; + qt[i][j]=c*y-s*w; + qt[i+1][j]=s*y+c*w; + } +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/rsolv.c b/lib/nr/ansi/recipes/rsolv.c new file mode 100644 index 0000000..1a7439e --- /dev/null +++ b/lib/nr/ansi/recipes/rsolv.c @@ -0,0 +1,12 @@ + +void rsolv(float **a, int n, float d[], float b[]) +{ + int i,j; + float sum; + + b[n] /= d[n]; + for (i=n-1;i>=1;i--) { + for (sum=0.0,j=i+1;j<=n;j++) sum += a[i][j]*b[j]; + b[i]=(b[i]-sum)/d[i]; + } +} diff --git a/lib/nr/ansi/recipes/rstrct.c b/lib/nr/ansi/recipes/rstrct.c new file mode 100644 index 0000000..be52128 --- /dev/null +++ b/lib/nr/ansi/recipes/rstrct.c @@ -0,0 +1,20 @@ + +void rstrct(double **uc, double **uf, int nc) +{ + int ic,iif,jc,jf,ncc=2*nc-1; + + for (jf=3,jc=2;jc +#define JMAX 40 + +float rtbis(float (*func)(float), float x1, float x2, float xacc) +{ + void nrerror(char error_text[]); + int j; + float dx,f,fmid,xmid,rtb; + + f=(*func)(x1); + fmid=(*func)(x2); + if (f*fmid >= 0.0) nrerror("Root must be bracketed for bisection in rtbis"); + rtb = f < 0.0 ? (dx=x2-x1,x1) : (dx=x1-x2,x2); + for (j=1;j<=JMAX;j++) { + fmid=(*func)(xmid=rtb+(dx *= 0.5)); + if (fmid <= 0.0) rtb=xmid; + if (fabs(dx) < xacc || fmid == 0.0) return rtb; + } + nrerror("Too many bisections in rtbis"); + return 0.0; +} +#undef JMAX diff --git a/lib/nr/ansi/recipes/rtflsp.c b/lib/nr/ansi/recipes/rtflsp.c new file mode 100644 index 0000000..ec1f75b --- /dev/null +++ b/lib/nr/ansi/recipes/rtflsp.c @@ -0,0 +1,43 @@ + +#include +#define MAXIT 30 + +float rtflsp(float (*func)(float), float x1, float x2, float xacc) +{ + void nrerror(char error_text[]); + int j; + float fl,fh,xl,xh,swap,dx,del,f,rtf; + + fl=(*func)(x1); + fh=(*func)(x2); + if (fl*fh > 0.0) nrerror("Root must be bracketed in rtflsp"); + if (fl < 0.0) { + xl=x1; + xh=x2; + } else { + xl=x2; + xh=x1; + swap=fl; + fl=fh; + fh=swap; + } + dx=xh-xl; + for (j=1;j<=MAXIT;j++) { + rtf=xl+dx*fl/(fl-fh); + f=(*func)(rtf); + if (f < 0.0) { + del=xl-rtf; + xl=rtf; + fl=f; + } else { + del=xh-rtf; + xh=rtf; + fh=f; + } + dx=xh-xl; + if (fabs(del) < xacc || f == 0.0) return rtf; + } + nrerror("Maximum number of iterations exceeded in rtflsp"); + return 0.0; +} +#undef MAXIT diff --git a/lib/nr/ansi/recipes/rtnewt.c b/lib/nr/ansi/recipes/rtnewt.c new file mode 100644 index 0000000..ebd5ac4 --- /dev/null +++ b/lib/nr/ansi/recipes/rtnewt.c @@ -0,0 +1,24 @@ + +#include +#define JMAX 20 + +float rtnewt(void (*funcd)(float, float *, float *), float x1, float x2, + float xacc) +{ + void nrerror(char error_text[]); + int j; + float df,dx,f,rtn; + + rtn=0.5*(x1+x2); + for (j=1;j<=JMAX;j++) { + (*funcd)(rtn,&f,&df); + dx=f/df; + rtn -= dx; + if ((x1-rtn)*(rtn-x2) < 0.0) + nrerror("Jumped out of brackets in rtnewt"); + if (fabs(dx) < xacc) return rtn; + } + nrerror("Maximum number of iterations exceeded in rtnewt"); + return 0.0; +} +#undef JMAX diff --git a/lib/nr/ansi/recipes/rtsafe.c b/lib/nr/ansi/recipes/rtsafe.c new file mode 100644 index 0000000..241360a --- /dev/null +++ b/lib/nr/ansi/recipes/rtsafe.c @@ -0,0 +1,54 @@ + +#include +#define MAXIT 100 + +float rtsafe(void (*funcd)(float, float *, float *), float x1, float x2, + float xacc) +{ + void nrerror(char error_text[]); + int j; + float df,dx,dxold,f,fh,fl; + float temp,xh,xl,rts; + + (*funcd)(x1,&fl,&df); + (*funcd)(x2,&fh,&df); + if ((fl > 0.0 && fh > 0.0) || (fl < 0.0 && fh < 0.0)) + nrerror("Root must be bracketed in rtsafe"); + if (fl == 0.0) return x1; + if (fh == 0.0) return x2; + if (fl < 0.0) { + xl=x1; + xh=x2; + } else { + xh=x1; + xl=x2; + } + rts=0.5*(x1+x2); + dxold=fabs(x2-x1); + dx=dxold; + (*funcd)(rts,&f,&df); + for (j=1;j<=MAXIT;j++) { + if ((((rts-xh)*df-f)*((rts-xl)*df-f) > 0.0) + || (fabs(2.0*f) > fabs(dxold*df))) { + dxold=dx; + dx=0.5*(xh-xl); + rts=xl+dx; + if (xl == rts) return rts; + } else { + dxold=dx; + dx=f/df; + temp=rts; + rts -= dx; + if (temp == rts) return rts; + } + if (fabs(dx) < xacc) return rts; + (*funcd)(rts,&f,&df); + if (f < 0.0) + xl=rts; + else + xh=rts; + } + nrerror("Maximum number of iterations exceeded in rtsafe"); + return 0.0; +} +#undef MAXIT diff --git a/lib/nr/ansi/recipes/rtsec.c b/lib/nr/ansi/recipes/rtsec.c new file mode 100644 index 0000000..3247c61 --- /dev/null +++ b/lib/nr/ansi/recipes/rtsec.c @@ -0,0 +1,34 @@ + +#include +#define MAXIT 30 + +float rtsec(float (*func)(float), float x1, float x2, float xacc) +{ + void nrerror(char error_text[]); + int j; + float fl,f,dx,swap,xl,rts; + + fl=(*func)(x1); + f=(*func)(x2); + if (fabs(fl) < fabs(f)) { + rts=x1; + xl=x2; + swap=fl; + fl=f; + f=swap; + } else { + xl=x1; + rts=x2; + } + for (j=1;j<=MAXIT;j++) { + dx=(xl-rts)*f/(f-fl); + xl=rts; + fl=f; + rts += dx; + f=(*func)(rts); + if (fabs(dx) < xacc || f == 0.0) return rts; + } + nrerror("Maximum number of iterations exceeded in rtsec"); + return 0.0; +} +#undef MAXIT diff --git a/lib/nr/ansi/recipes/rzextr.c b/lib/nr/ansi/recipes/rzextr.c new file mode 100644 index 0000000..92160fb --- /dev/null +++ b/lib/nr/ansi/recipes/rzextr.c @@ -0,0 +1,45 @@ + +#define NRANSI +#include "nrutil.h" + +extern float **d,*x; + +void rzextr(int iest, float xest, float yest[], float yz[], float dy[], int nv) +{ + int k,j; + float yy,v,ddy,c,b1,b,*fx; + + fx=vector(1,iest); + x[iest]=xest; + if (iest == 1) + for (j=1;j<=nv;j++) { + yz[j]=yest[j]; + d[j][1]=yest[j]; + dy[j]=yest[j]; + } + else { + for (k=1;k +#define NRANSI +#include "nrutil.h" + +void savgol(float c[], int np, int nl, int nr, int ld, int m) +{ + void lubksb(float **a, int n, int *indx, float b[]); + void ludcmp(float **a, int n, int *indx, float *d); + int imj,ipj,j,k,kk,mm,*indx; + float d,fac,sum,**a,*b; + + if (np < nl+nr+1 || nl < 0 || nr < 0 || ld > m || nl+nr < m) + nrerror("bad args in savgol"); + indx=ivector(1,m+1); + a=matrix(1,m+1,1,m+1); + b=vector(1,m+1); + for (ipj=0;ipj<=(m << 1);ipj++) { + sum=(ipj ? 0.0 : 1.0); + for (k=1;k<=nr;k++) sum += pow((double)k,(double)ipj); + for (k=1;k<=nl;k++) sum += pow((double)-k,(double)ipj); + mm=IMIN(ipj,2*m-ipj); + for (imj = -mm;imj<=mm;imj+=2) a[1+(ipj+imj)/2][1+(ipj-imj)/2]=sum; + } + ludcmp(a,m+1,indx,&d); + for (j=1;j<=m+1;j++) b[j]=0.0; + b[ld+1]=1.0; + lubksb(a,m+1,indx,b); + for (kk=1;kk<=np;kk++) c[kk]=0.0; + for (k = -nl;k<=nr;k++) { + sum=b[1]; + fac=1.0; + for (mm=1;mm<=m;mm++) sum += b[mm+1]*(fac *= k); + kk=((np-k) % np)+1; + c[kk]=sum; + } + free_vector(b,1,m+1); + free_matrix(a,1,m+1,1,m+1); + free_ivector(indx,1,m+1); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/scrsho.c b/lib/nr/ansi/recipes/scrsho.c new file mode 100644 index 0000000..c63a58a --- /dev/null +++ b/lib/nr/ansi/recipes/scrsho.c @@ -0,0 +1,65 @@ + +#include +#define ISCR 60 +#define JSCR 21 +#define BLANK ' ' +#define ZERO '-' +#define YY 'l' +#define XX '-' +#define FF 'x' + +void scrsho(float (*fx)(float)) +{ + int jz,j,i; + float ysml,ybig,x2,x1,x,dyj,dx,y[ISCR+1]; + char scr[ISCR+1][JSCR+1]; + + for (;;) { + printf("\nEnter x1 x2 (x1=x2 to stop):\n"); + scanf("%f %f",&x1,&x2); + if (x1 == x2) break; + for (j=1;j<=JSCR;j++) + scr[1][j]=scr[ISCR][j]=YY; + for (i=2;i<=(ISCR-1);i++) { + scr[i][1]=scr[i][JSCR]=XX; + for (j=2;j<=(JSCR-1);j++) + scr[i][j]=BLANK; + } + dx=(x2-x1)/(ISCR-1); + x=x1; + ysml=ybig=0.0; + for (i=1;i<=ISCR;i++) { + y[i]=(*fx)(x); + if (y[i] < ysml) ysml=y[i]; + if (y[i] > ybig) ybig=y[i]; + x += dx; + } + if (ybig == ysml) ybig=ysml+1.0; + dyj=(JSCR-1)/(ybig-ysml); + jz=1-(int) (ysml*dyj); + for (i=1;i<=ISCR;i++) { + scr[i][jz]=ZERO; + j=1+(int) ((y[i]-ysml)*dyj); + scr[i][j]=FF; + } + printf(" %10.3f ",ybig); + for (i=1;i<=ISCR;i++) printf("%c",scr[i][JSCR]); + printf("\n"); + for (j=(JSCR-1);j>=2;j--) { + printf("%12s"," "); + for (i=1;i<=ISCR;i++) printf("%c",scr[i][j]); + printf("\n"); + } + printf(" %10.3f ",ysml); + for (i=1;i<=ISCR;i++) printf("%c",scr[i][1]); + printf("\n"); + printf("%8s %10.3f %44s %10.3f\n"," ",x1," ",x2); + } +} +#undef ISCR +#undef JSCR +#undef BLANK +#undef ZERO +#undef YY +#undef XX +#undef FF diff --git a/lib/nr/ansi/recipes/select.c b/lib/nr/ansi/recipes/select.c new file mode 100644 index 0000000..1ce9483 --- /dev/null +++ b/lib/nr/ansi/recipes/select.c @@ -0,0 +1,45 @@ + +#define SWAP(a,b) temp=(a);(a)=(b);(b)=temp; + +float select(unsigned long k, unsigned long n, float arr[]) +{ + unsigned long i,ir,j,l,mid; + float a,temp; + + l=1; + ir=n; + for (;;) { + if (ir <= l+1) { + if (ir == l+1 && arr[ir] < arr[l]) { + SWAP(arr[l],arr[ir]) + } + return arr[k]; + } else { + mid=(l+ir) >> 1; + SWAP(arr[mid],arr[l+1]) + if (arr[l] > arr[ir]) { + SWAP(arr[l],arr[ir]) + } + if (arr[l+1] > arr[ir]) { + SWAP(arr[l+1],arr[ir]) + } + if (arr[l] > arr[l+1]) { + SWAP(arr[l],arr[l+1]) + } + i=l+1; + j=ir; + a=arr[l+1]; + for (;;) { + do i++; while (arr[i] < a); + do j--; while (arr[j] > a); + if (j < i) break; + SWAP(arr[i],arr[j]) + } + arr[l+1]=arr[j]; + arr[j]=a; + if (j >= k) ir=j-1; + if (j <= k) l=i; + } + } +} +#undef SWAP diff --git a/lib/nr/ansi/recipes/selip.c b/lib/nr/ansi/recipes/selip.c new file mode 100644 index 0000000..ec077b9 --- /dev/null +++ b/lib/nr/ansi/recipes/selip.c @@ -0,0 +1,73 @@ + +#define NRANSI +#include "nrutil.h" +#define M 64 +#define BIG 1.0e30 +#define FREEALL free_vector(sel,1,M+2);free_lvector(isel,1,M+2); + +float selip(unsigned long k, unsigned long n, float arr[]) +{ + void shell(unsigned long n, float a[]); + unsigned long i,j,jl,jm,ju,kk,mm,nlo,nxtmm,*isel; + float ahi,alo,sum,*sel; + + if (k < 1 || k > n || n <= 0) nrerror("bad input to selip"); + isel=lvector(1,M+2); + sel=vector(1,M+2); + kk=k; + ahi=BIG; + alo = -BIG; + for (;;) { + mm=nlo=0; + sum=0.0; + nxtmm=M+1; + for (i=1;i<=n;i++) { + if (arr[i] >= alo && arr[i] <= ahi) { + mm++; + if (arr[i] == alo) nlo++; + if (mm <= M) sel[mm]=arr[i]; + else if (mm == nxtmm) { + nxtmm=mm+mm/M; + sel[1 + ((i+mm+kk) % M)]=arr[i]; + } + sum += arr[i]; + } + } + if (kk <= nlo) { + FREEALL + return alo; + } + else if (mm <= M) { + shell(mm,sel); + ahi = sel[kk]; + FREEALL + return ahi; + } + sel[M+1]=sum/mm; + shell(M+1,sel); + sel[M+2]=ahi; + for (j=1;j<=M+2;j++) isel[j]=0; + for (i=1;i<=n;i++) { + if (arr[i] >= alo && arr[i] <= ahi) { + jl=0; + ju=M+2; + while (ju-jl > 1) { + jm=(ju+jl)/2; + if (arr[i] >= sel[jm]) jl=jm; + else ju=jm; + } + isel[ju]++; + } + } + j=1; + while (kk > isel[j]) { + alo=sel[j]; + kk -= isel[j++]; + } + ahi=sel[j]; + } +} +#undef M +#undef BIG +#undef FREEALL +#undef NRANSI diff --git a/lib/nr/ansi/recipes/sfroid.c b/lib/nr/ansi/recipes/sfroid.c new file mode 100644 index 0000000..e43ec7b --- /dev/null +++ b/lib/nr/ansi/recipes/sfroid.c @@ -0,0 +1,84 @@ + +#include +#include +#define NRANSI +#include "nrutil.h" +#define NE 3 +#define M 41 +#define NB 1 +#define NSI NE +#define NYJ NE +#define NYK M +#define NCI NE +#define NCJ (NE-NB+1) +#define NCK (M+1) +#define NSJ (2*NE+1) + +int mm,n,mpt=M; +float h,c2=0.0,anorm,x[M+1]; + +int main(void) /* Program sfroid */ +{ + float plgndr(int l, int m, float x); + void solvde(int itmax, float conv, float slowc, float scalv[], + int indexv[], int ne, int nb, int m, float **y, float ***c, float **s); + int i,itmax,k,indexv[NE+1]; + float conv,deriv,fac1,fac2,q1,slowc,scalv[NE+1]; + float **y,**s,***c; + + y=matrix(1,NYJ,1,NYK); + s=matrix(1,NSI,1,NSJ); + c=f3tensor(1,NCI,1,NCJ,1,NCK); + itmax=100; + conv=5.0e-6; + slowc=1.0; + h=1.0/(M-1); + printf("\nenter m n\n"); + scanf("%d %d",&mm,&n); + if (n+mm & 1) { + indexv[1]=1; + indexv[2]=2; + indexv[3]=3; + } else { + indexv[1]=2; + indexv[2]=1; + indexv[3]=3; + } + anorm=1.0; + if (mm) { + q1=n; + for (i=1;i<=mm;i++) anorm = -0.5*anorm*(n+i)*(q1--/i); + } + for (k=1;k<=(M-1);k++) { + x[k]=(k-1)*h; + fac1=1.0-x[k]*x[k]; + fac2=exp((-mm/2.0)*log(fac1)); + y[1][k]=plgndr(n,mm,x[k])*fac2; + deriv = -((n-mm+1)*plgndr(n+1,mm,x[k])- + (n+1)*x[k]*plgndr(n,mm,x[k]))/fac1; + y[2][k]=mm*x[k]*y[1][k]/fac1+deriv*fac2; + y[3][k]=n*(n+1)-mm*(mm+1); + } + x[M]=1.0; + y[1][M]=anorm; + y[3][M]=n*(n+1)-mm*(mm+1); + y[2][M]=(y[3][M]-c2)*y[1][M]/(2.0*(mm+1.0)); + scalv[1]=fabs(anorm); + scalv[2]=(y[2][M] > scalv[1] ? y[2][M] : scalv[1]); + scalv[3]=(y[3][M] > 1.0 ? y[3][M] : 1.0); + for (;;) { + printf("\nEnter c**2 or 999 to end.\n"); + scanf("%f",&c2); + if (c2 == 999) { + free_f3tensor(c,1,NCI,1,NCJ,1,NCK); + free_matrix(s,1,NSI,1,NSJ); + free_matrix(y,1,NYJ,1,NYK); + return 0; + } + solvde(itmax,conv,slowc,scalv,indexv,NE,NB,M,y,c,s); + printf("\n %s %2d %s %2d %s %7.3f %s %10.6f\n", + "m =",mm," n =",n," c**2 =",c2, + " lamda =",y[3][1]+mm*(mm+1)); + } +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/shell.c b/lib/nr/ansi/recipes/shell.c new file mode 100644 index 0000000..b78eef8 --- /dev/null +++ b/lib/nr/ansi/recipes/shell.c @@ -0,0 +1,24 @@ + +void shell(unsigned long n, float a[]) +{ + unsigned long i,j,inc; + float v; + inc=1; + do { + inc *= 3; + inc++; + } while (inc <= n); + do { + inc /= 3; + for (i=inc+1;i<=n;i++) { + v=a[i]; + j=i; + while (a[j-inc] > v) { + a[j]=a[j-inc]; + j -= inc; + if (j <= inc) break; + } + a[j]=v; + } + } while (inc > 1); +} diff --git a/lib/nr/ansi/recipes/shoot.c b/lib/nr/ansi/recipes/shoot.c new file mode 100644 index 0000000..69348d4 --- /dev/null +++ b/lib/nr/ansi/recipes/shoot.c @@ -0,0 +1,37 @@ + +#define NRANSI +#include "nrutil.h" +#define EPS 1.0e-6 + +extern int nvar; +extern float x1,x2; + +int kmax,kount; +float *xp,**yp,dxsav; + +void shoot(int n, float v[], float f[]) +{ + void derivs(float x, float y[], float dydx[]); + void load(float x1, float v[], float y[]); + void odeint(float ystart[], int nvar, float x1, float x2, + float eps, float h1, float hmin, int *nok, int *nbad, + void (*derivs)(float, float [], float []), + void (*rkqs)(float [], float [], int, float *, float, float, + float [], float *, float *, void (*)(float, float [], float []))); + void rkqs(float y[], float dydx[], int n, float *x, + float htry, float eps, float yscal[], float *hdid, float *hnext, + void (*derivs)(float, float [], float [])); + void score(float xf, float y[], float f[]); + int nbad,nok; + float h1,hmin=0.0,*y; + + y=vector(1,nvar); + kmax=0; + h1=(x2-x1)/100.0; + load(x1,v,y); + odeint(y,nvar,x1,x2,EPS,h1,hmin,&nok,&nbad,derivs,rkqs); + score(x2,y,f); + free_vector(y,1,nvar); +} +#undef EPS +#undef NRANSI diff --git a/lib/nr/ansi/recipes/shootf.c b/lib/nr/ansi/recipes/shootf.c new file mode 100644 index 0000000..42c9040 --- /dev/null +++ b/lib/nr/ansi/recipes/shootf.c @@ -0,0 +1,46 @@ + +#define NRANSI +#include "nrutil.h" +#define EPS 1.0e-6 + +extern int nn2,nvar; +extern float x1,x2,xf; + +int kmax,kount; +float *xp,**yp,dxsav; + +void shootf(int n, float v[], float f[]) +{ + void derivs(float x, float y[], float dydx[]); + void load1(float x1, float v1[], float y[]); + void load2(float x2, float v2[], float y[]); + void odeint(float ystart[], int nvar, float x1, float x2, + float eps, float h1, float hmin, int *nok, int *nbad, + void (*derivs)(float, float [], float []), + void (*rkqs)(float [], float [], int, float *, float, float, + float [], float *, float *, void (*)(float, float [], float []))); + void rkqs(float y[], float dydx[], int n, float *x, + float htry, float eps, float yscal[], float *hdid, float *hnext, + void (*derivs)(float, float [], float [])); + void score(float xf, float y[], float f[]); + int i,nbad,nok; + float h1,hmin=0.0,*f1,*f2,*y; + + f1=vector(1,nvar); + f2=vector(1,nvar); + y=vector(1,nvar); + kmax=0; + h1=(x2-x1)/100.0; + load1(x1,v,y); + odeint(y,nvar,x1,xf,EPS,h1,hmin,&nok,&nbad,derivs,rkqs); + score(xf,y,f1); + load2(x2,&v[nn2],y); + odeint(y,nvar,x2,xf,EPS,h1,hmin,&nok,&nbad,derivs,rkqs); + score(xf,y,f2); + for (i=1;i<=n;i++) f[i]=f1[i]-f2[i]; + free_vector(y,1,nvar); + free_vector(f2,1,nvar); + free_vector(f1,1,nvar); +} +#undef EPS +#undef NRANSI diff --git a/lib/nr/ansi/recipes/simp1.c b/lib/nr/ansi/recipes/simp1.c new file mode 100644 index 0000000..276857f --- /dev/null +++ b/lib/nr/ansi/recipes/simp1.c @@ -0,0 +1,26 @@ + +#include + +void simp1(float **a, int mm, int ll[], int nll, int iabf, int *kp, + float *bmax) +{ + int k; + float test; + + if (nll <= 0) + *bmax=0.0; + else { + *kp=ll[1]; + *bmax=a[mm+1][*kp+1]; + for (k=2;k<=nll;k++) { + if (iabf == 0) + test=a[mm+1][ll[k]+1]-(*bmax); + else + test=fabs(a[mm+1][ll[k]+1])-fabs(*bmax); + if (test > 0.0) { + *bmax=a[mm+1][ll[k]+1]; + *kp=ll[k]; + } + } + } +} diff --git a/lib/nr/ansi/recipes/simp2.c b/lib/nr/ansi/recipes/simp2.c new file mode 100644 index 0000000..0d66f37 --- /dev/null +++ b/lib/nr/ansi/recipes/simp2.c @@ -0,0 +1,32 @@ + +#define EPS 1.0e-6 + +void simp2(float **a, int m, int n, int *ip, int kp) +{ + int k,i; + float qp,q0,q,q1; + + *ip=0; + for (i=1;i<=m;i++) + if (a[i+1][kp+1] < -EPS) break; + if (i>m) return; + q1 = -a[i+1][1]/a[i+1][kp+1]; + *ip=i; + for (i=*ip+1;i<=m;i++) { + if (a[i+1][kp+1] < -EPS) { + q = -a[i+1][1]/a[i+1][kp+1]; + if (q < q1) { + *ip=i; + q1=q; + } else if (q == q1) { + for (k=1;k<=n;k++) { + qp = -a[*ip+1][k+1]/a[*ip+1][kp+1]; + q0 = -a[i+1][k+1]/a[i+1][kp+1]; + if (q0 != qp) break; + } + if (q0 < qp) *ip=i; + } + } + } +} +#undef EPS diff --git a/lib/nr/ansi/recipes/simp3.c b/lib/nr/ansi/recipes/simp3.c new file mode 100644 index 0000000..f1a8a81 --- /dev/null +++ b/lib/nr/ansi/recipes/simp3.c @@ -0,0 +1,18 @@ + +void simp3(float **a, int i1, int k1, int ip, int kp) +{ + int kk,ii; + float piv; + + piv=1.0/a[ip+1][kp+1]; + for (ii=1;ii<=i1+1;ii++) + if (ii-1 != ip) { + a[ii][kp+1] *= piv; + for (kk=1;kk<=k1+1;kk++) + if (kk-1 != kp) + a[ii][kk] -= a[ip+1][kk]*a[ii][kp+1]; + } + for (kk=1;kk<=k1+1;kk++) + if (kk-1 != kp) a[ip+1][kk] *= -piv; + a[ip+1][kp+1]=piv; +} diff --git a/lib/nr/ansi/recipes/simplx.c b/lib/nr/ansi/recipes/simplx.c new file mode 100644 index 0000000..9d52a66 --- /dev/null +++ b/lib/nr/ansi/recipes/simplx.c @@ -0,0 +1,97 @@ + +#define NRANSI +#include "nrutil.h" +#define EPS 1.0e-6 +#define FREEALL free_ivector(l3,1,m);free_ivector(l1,1,n+1); + +void simplx(float **a, int m, int n, int m1, int m2, int m3, int *icase, + int izrov[], int iposv[]) +{ + void simp1(float **a, int mm, int ll[], int nll, int iabf, int *kp, + float *bmax); + void simp2(float **a, int m, int n, int *ip, int kp); + void simp3(float **a, int i1, int k1, int ip, int kp); + int i,ip,is,k,kh,kp,nl1; + int *l1,*l3; + float q1,bmax; + + if (m != (m1+m2+m3)) nrerror("Bad input constraint counts in simplx"); + l1=ivector(1,n+1); + l3=ivector(1,m); + nl1=n; + for (k=1;k<=n;k++) l1[k]=izrov[k]=k; + for (i=1;i<=m;i++) { + if (a[i+1][1] < 0.0) nrerror("Bad input tableau in simplx"); + iposv[i]=n+i; + } + if (m2+m3) { + for (i=1;i<=m2;i++) l3[i]=1; + for (k=1;k<=(n+1);k++) { + q1=0.0; + for (i=m1+1;i<=m;i++) q1 += a[i+1][k]; + a[m+2][k] = -q1; + } + for (;;) { + simp1(a,m+1,l1,nl1,0,&kp,&bmax); + if (bmax <= EPS && a[m+2][1] < -EPS) { + *icase = -1; + FREEALL return; + } else if (bmax <= EPS && a[m+2][1] <= EPS) { + for (ip=m1+m2+1;ip<=m;ip++) { + if (iposv[ip] == (ip+n)) { + simp1(a,ip,l1,nl1,1,&kp,&bmax); + if (bmax > EPS) + goto one; + } + } + for (i=m1+1;i<=m1+m2;i++) + if (l3[i-m1] == 1) + for (k=1;k<=n+1;k++) + a[i+1][k] = -a[i+1][k]; + break; + } + simp2(a,m,n,&ip,kp); + if (ip == 0) { + *icase = -1; + FREEALL return; + } + one: simp3(a,m+1,n,ip,kp); + if (iposv[ip] >= (n+m1+m2+1)) { + for (k=1;k<=nl1;k++) + if (l1[k] == kp) break; + --nl1; + for (is=k;is<=nl1;is++) l1[is]=l1[is+1]; + } else { + kh=iposv[ip]-m1-n; + if (kh >= 1 && l3[kh]) { + l3[kh]=0; + ++a[m+2][kp+1]; + for (i=1;i<=m+2;i++) + a[i][kp+1] = -a[i][kp+1]; + } + } + is=izrov[kp]; + izrov[kp]=iposv[ip]; + iposv[ip]=is; + } + } + for (;;) { + simp1(a,0,l1,nl1,0,&kp,&bmax); + if (bmax <= EPS) { + *icase=0; + FREEALL return; + } + simp2(a,m,n,&ip,kp); + if (ip == 0) { + *icase=1; + FREEALL return; + } + simp3(a,m,n,ip,kp); + is=izrov[kp]; + izrov[kp]=iposv[ip]; + iposv[ip]=is; + } +} +#undef EPS +#undef FREEALL +#undef NRANSI diff --git a/lib/nr/ansi/recipes/simpr.c b/lib/nr/ansi/recipes/simpr.c new file mode 100644 index 0000000..e0e2147 --- /dev/null +++ b/lib/nr/ansi/recipes/simpr.c @@ -0,0 +1,50 @@ + +#define NRANSI +#include "nrutil.h" + +void simpr(float y[], float dydx[], float dfdx[], float **dfdy, int n, + float xs, float htot, int nstep, float yout[], + void (*derivs)(float, float [], float [])) +{ + void lubksb(float **a, int n, int *indx, float b[]); + void ludcmp(float **a, int n, int *indx, float *d); + int i,j,nn,*indx; + float d,h,x,**a,*del,*ytemp; + + indx=ivector(1,n); + a=matrix(1,n,1,n); + del=vector(1,n); + ytemp=vector(1,n); + h=htot/nstep; + for (i=1;i<=n;i++) { + for (j=1;j<=n;j++) a[i][j] = -h*dfdy[i][j]; + ++a[i][i]; + } + ludcmp(a,n,indx,&d); + for (i=1;i<=n;i++) + yout[i]=h*(dydx[i]+h*dfdx[i]); + lubksb(a,n,indx,yout); + for (i=1;i<=n;i++) + ytemp[i]=y[i]+(del[i]=yout[i]); + x=xs+h; + (*derivs)(x,ytemp,yout); + for (nn=2;nn<=nstep;nn++) { + for (i=1;i<=n;i++) + yout[i]=h*yout[i]-del[i]; + lubksb(a,n,indx,yout); + for (i=1;i<=n;i++) + ytemp[i] += (del[i] += 2.0*yout[i]); + x += h; + (*derivs)(x,ytemp,yout); + } + for (i=1;i<=n;i++) + yout[i]=h*yout[i]-del[i]; + lubksb(a,n,indx,yout); + for (i=1;i<=n;i++) + yout[i] += ytemp[i]; + free_vector(ytemp,1,n); + free_vector(del,1,n); + free_matrix(a,1,n,1,n); + free_ivector(indx,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/sinft.c b/lib/nr/ansi/recipes/sinft.c new file mode 100644 index 0000000..c9e6b0a --- /dev/null +++ b/lib/nr/ansi/recipes/sinft.c @@ -0,0 +1,32 @@ + +#include + +void sinft(float y[], int n) +{ + void realft(float data[], unsigned long n, int isign); + int j,n2=n+2; + float sum,y1,y2; + double theta,wi=0.0,wr=1.0,wpi,wpr,wtemp; + + theta=3.14159265358979/(double) n; + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + y[1]=0.0; + for (j=2;j<=(n>>1)+1;j++) { + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + y1=wi*(y[j]+y[n2-j]); + y2=0.5*(y[j]-y[n2-j]); + y[j]=y1+y2; + y[n2-j]=y1-y2; + } + realft(y,n,1); + y[1]*=0.5; + sum=y[2]=0.0; + for (j=1;j<=n-1;j+=2) { + sum += y[j]; + y[j]=y[j+1]; + y[j+1]=sum; + } +} diff --git a/lib/nr/ansi/recipes/slvsm2.c b/lib/nr/ansi/recipes/slvsm2.c new file mode 100644 index 0000000..9758602 --- /dev/null +++ b/lib/nr/ansi/recipes/slvsm2.c @@ -0,0 +1,13 @@ + +#include + +void slvsm2(double **u, double **rhs) +{ + void fill0(double **u, int n); + double disc,fact,h=0.5; + + fill0(u,3); + fact=2.0/(h*h); + disc=sqrt(fact*fact+rhs[2][2]); + u[2][2] = -rhs[2][2]/(fact+disc); +} diff --git a/lib/nr/ansi/recipes/slvsml.c b/lib/nr/ansi/recipes/slvsml.c new file mode 100644 index 0000000..829327a --- /dev/null +++ b/lib/nr/ansi/recipes/slvsml.c @@ -0,0 +1,9 @@ + +void slvsml(double **u, double **rhs) +{ + void fill0(double **u, int n); + double h=0.5; + + fill0(u,3); + u[2][2] = -h*h*rhs[2][2]/4.0; +} diff --git a/lib/nr/ansi/recipes/sncndn.c b/lib/nr/ansi/recipes/sncndn.c new file mode 100644 index 0000000..afdcfe6 --- /dev/null +++ b/lib/nr/ansi/recipes/sncndn.c @@ -0,0 +1,60 @@ + +#include +#define CA 0.0003 + +void sncndn(float uu, float emmc, float *sn, float *cn, float *dn) +{ + float a,b,c,d,emc,u; + float em[14],en[14]; + int i,ii,l,bo; + + emc=emmc; + u=uu; + if (emc) { + bo=(emc < 0.0); + if (bo) { + d=1.0-emc; + emc /= -1.0/d; + u *= (d=sqrt(d)); + } + a=1.0; + *dn=1.0; + for (i=1;i<=13;i++) { + l=i; + em[i]=a; + en[i]=(emc=sqrt(emc)); + c=0.5*(a+emc); + if (fabs(a-emc) <= CA*a) break; + emc *= a; + a=c; + } + u *= c; + *sn=sin(u); + *cn=cos(u); + if (*sn) { + a=(*cn)/(*sn); + c *= a; + for (ii=l;ii>=1;ii--) { + b=em[ii]; + a *= c; + c *= (*dn); + *dn=(en[ii]+a)/(b+a); + a=c/b; + } + a=1.0/sqrt(c*c+1.0); + *sn=(*sn >= 0.0 ? a : -a); + *cn=c*(*sn); + } + if (bo) { + a=(*dn); + *dn=(*cn); + *cn=a; + *sn /= d; + } + } else { + *cn=1.0/cosh(u); + *dn=(*cn); + *sn=tanh(u); + } +} +#undef CA diff --git a/lib/nr/ansi/recipes/snrm.c b/lib/nr/ansi/recipes/snrm.c new file mode 100644 index 0000000..6259feb --- /dev/null +++ b/lib/nr/ansi/recipes/snrm.c @@ -0,0 +1,20 @@ + +#include + +double snrm(unsigned long n, double sx[], int itol) +{ + unsigned long i,isamax; + double ans; + + if (itol <= 3) { + ans = 0.0; + for (i=1;i<=n;i++) ans += sx[i]*sx[i]; + return sqrt(ans); + } else { + isamax=1; + for (i=1;i<=n;i++) { + if (fabs(sx[i]) > fabs(sx[isamax])) isamax=i; + } + return fabs(sx[isamax]); + } +} diff --git a/lib/nr/ansi/recipes/sobseq.c b/lib/nr/ansi/recipes/sobseq.c new file mode 100644 index 0000000..e0ec626 --- /dev/null +++ b/lib/nr/ansi/recipes/sobseq.c @@ -0,0 +1,53 @@ + +#define NRANSI +#include "nrutil.h" +#define MAXBIT 30 +#define MAXDIM 6 + +void sobseq(int *n, float x[]) +{ + int j,k,l; + unsigned long i,im,ipp; + static float fac; + static unsigned long in,ix[MAXDIM+1],*iu[MAXBIT+1]; + static unsigned long mdeg[MAXDIM+1]={0,1,2,3,3,4,4}; + static unsigned long ip[MAXDIM+1]={0,0,1,1,2,1,4}; + static unsigned long iv[MAXDIM*MAXBIT+1]={ + 0,1,1,1,1,1,1,3,1,3,3,1,1,5,7,7,3,3,5,15,11,5,15,13,9}; + + if (*n < 0) { + for (k=1;k<=MAXDIM;k++) ix[k]=0; + in=0; + if (iv[1] != 1) return; + fac=1.0/(1L << MAXBIT); + for (j=1,k=0;j<=MAXBIT;j++,k+=MAXDIM) iu[j] = &iv[k]; + for (k=1;k<=MAXDIM;k++) { + for (j=1;j<=mdeg[k];j++) iu[j][k] <<= (MAXBIT-j); + for (j=mdeg[k]+1;j<=MAXBIT;j++) { + ipp=ip[k]; + i=iu[j-mdeg[k]][k]; + i ^= (i >> mdeg[k]); + for (l=mdeg[k]-1;l>=1;l--) { + if (ipp & 1) i ^= iu[j-l][k]; + ipp >>= 1; + } + iu[j][k]=i; + } + } + } else { + im=in++; + for (j=1;j<=MAXBIT;j++) { + if (!(im & 1)) break; + im >>= 1; + } + if (j > MAXBIT) nrerror("MAXBIT too small in sobseq"); + im=(j-1)*MAXDIM; + for (k=1;k<=IMIN(*n,MAXDIM);k++) { + ix[k] ^= iv[im+k]; + x[k]=ix[k]*fac; + } + } +} +#undef MAXBIT +#undef MAXDIM +#undef NRANSI diff --git a/lib/nr/ansi/recipes/solvde.c b/lib/nr/ansi/recipes/solvde.c new file mode 100644 index 0000000..42d3882 --- /dev/null +++ b/lib/nr/ansi/recipes/solvde.c @@ -0,0 +1,90 @@ + +#include +#include +#define NRANSI +#include "nrutil.h" + +void solvde(int itmax, float conv, float slowc, float scalv[], int indexv[], + int ne, int nb, int m, float **y, float ***c, float **s) +{ + void bksub(int ne, int nb, int jf, int k1, int k2, float ***c); + void difeq(int k, int k1, int k2, int jsf, int is1, int isf, + int indexv[], int ne, float **s, float **y); + void pinvs(int ie1, int ie2, int je1, int jsf, int jc1, int k, + float ***c, float **s); + void red(int iz1, int iz2, int jz1, int jz2, int jm1, int jm2, int jmf, + int ic1, int jc1, int jcf, int kc, float ***c, float **s); + int ic1,ic2,ic3,ic4,it,j,j1,j2,j3,j4,j5,j6,j7,j8,j9; + int jc1,jcf,jv,k,k1,k2,km,kp,nvars,*kmax; + float err,errj,fac,vmax,vz,*ermax; + + kmax=ivector(1,ne); + ermax=vector(1,ne); + k1=1; + k2=m; + nvars=ne*m; + j1=1; + j2=nb; + j3=nb+1; + j4=ne; + j5=j4+j1; + j6=j4+j2; + j7=j4+j3; + j8=j4+j4; + j9=j8+j1; + ic1=1; + ic2=ne-nb; + ic3=ic2+1; + ic4=ne; + jc1=1; + jcf=ic3; + for (it=1;it<=itmax;it++) { + k=k1; + difeq(k,k1,k2,j9,ic3,ic4,indexv,ne,s,y); + pinvs(ic3,ic4,j5,j9,jc1,k1,c,s); + for (k=k1+1;k<=k2;k++) { + kp=k-1; + difeq(k,k1,k2,j9,ic1,ic4,indexv,ne,s,y); + red(ic1,ic4,j1,j2,j3,j4,j9,ic3,jc1,jcf,kp,c,s); + pinvs(ic1,ic4,j3,j9,jc1,k,c,s); + } + k=k2+1; + difeq(k,k1,k2,j9,ic1,ic2,indexv,ne,s,y); + red(ic1,ic2,j5,j6,j7,j8,j9,ic3,jc1,jcf,k2,c,s); + pinvs(ic1,ic2,j7,j9,jcf,k2+1,c,s); + bksub(ne,nb,jcf,k1,k2,c); + err=0.0; + for (j=1;j<=ne;j++) { + jv=indexv[j]; + errj=vmax=0.0; + km=0; + for (k=k1;k<=k2;k++) { + vz=fabs(c[jv][1][k]); + if (vz > vmax) { + vmax=vz; + km=k; + } + errj += vz; + } + err += errj/scalv[j]; + ermax[j]=c[jv][1][km]/scalv[j]; + kmax[j]=km; + } + err /= nvars; + fac=(err > slowc ? slowc/err : 1.0); + for (j=1;j<=ne;j++) { + jv=indexv[j]; + for (k=k1;k<=k2;k++) + y[j][k] -= fac*c[jv][1][k]; + } + printf("\n%8s %9s %9s\n","Iter.","Error","FAC"); + printf("%6d %12.6f %11.6f\n",it,err,fac); + if (err < conv) { + free_vector(ermax,1,ne); + free_ivector(kmax,1,ne); + return; + } + } + nrerror("Too many iterations in solvde"); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/sor.c b/lib/nr/ansi/recipes/sor.c new file mode 100644 index 0000000..a5017a5 --- /dev/null +++ b/lib/nr/ansi/recipes/sor.c @@ -0,0 +1,43 @@ + +#include +#define MAXITS 1000 +#define EPS 1.0e-5 + +void sor(double **a, double **b, double **c, double **d, double **e, + double **f, double **u, int jmax, double rjac) +{ + void nrerror(char error_text[]); + int ipass,j,jsw,l,lsw,n; + double anorm,anormf=0.0,omega=1.0,resid; + + for (j=2;j=l;i--) { + if (arr[i] <= a) break; + arr[i+1]=arr[i]; + } + arr[i+1]=a; + } + if (jstack == 0) break; + ir=istack[jstack--]; + l=istack[jstack--]; + } else { + k=(l+ir) >> 1; + SWAP(arr[k],arr[l+1]) + if (arr[l] > arr[ir]) { + SWAP(arr[l],arr[ir]) + } + if (arr[l+1] > arr[ir]) { + SWAP(arr[l+1],arr[ir]) + } + if (arr[l] > arr[l+1]) { + SWAP(arr[l],arr[l+1]) + } + i=l+1; + j=ir; + a=arr[l+1]; + for (;;) { + do i++; while (arr[i] < a); + do j--; while (arr[j] > a); + if (j < i) break; + SWAP(arr[i],arr[j]); + } + arr[l+1]=arr[j]; + arr[j]=a; + jstack += 2; + if (jstack > NSTACK) nrerror("NSTACK too small in sort."); + if (ir-i+1 >= j-l) { + istack[jstack]=ir; + istack[jstack-1]=i; + ir=j-1; + } else { + istack[jstack]=j-1; + istack[jstack-1]=l; + l=i; + } + } + } + free_lvector(istack,1,NSTACK); +} +#undef M +#undef NSTACK +#undef SWAP +#undef NRANSI diff --git a/lib/nr/ansi/recipes/sort2.c b/lib/nr/ansi/recipes/sort2.c new file mode 100644 index 0000000..c70d408 --- /dev/null +++ b/lib/nr/ansi/recipes/sort2.c @@ -0,0 +1,83 @@ + +#define NRANSI +#include "nrutil.h" +#define SWAP(a,b) temp=(a);(a)=(b);(b)=temp; +#define M 7 +#define NSTACK 50 + +void sort2(unsigned long n, float arr[], float brr[]) +{ + unsigned long i,ir=n,j,k,l=1,*istack; + int jstack=0; + float a,b,temp; + + istack=lvector(1,NSTACK); + for (;;) { + if (ir-l < M) { + for (j=l+1;j<=ir;j++) { + a=arr[j]; + b=brr[j]; + for (i=j-1;i>=l;i--) { + if (arr[i] <= a) break; + arr[i+1]=arr[i]; + brr[i+1]=brr[i]; + } + arr[i+1]=a; + brr[i+1]=b; + } + if (!jstack) { + free_lvector(istack,1,NSTACK); + return; + } + ir=istack[jstack]; + l=istack[jstack-1]; + jstack -= 2; + } else { + k=(l+ir) >> 1; + SWAP(arr[k],arr[l+1]) + SWAP(brr[k],brr[l+1]) + if (arr[l] > arr[ir]) { + SWAP(arr[l],arr[ir]) + SWAP(brr[l],brr[ir]) + } + if (arr[l+1] > arr[ir]) { + SWAP(arr[l+1],arr[ir]) + SWAP(brr[l+1],brr[ir]) + } + if (arr[l] > arr[l+1]) { + SWAP(arr[l],arr[l+1]) + SWAP(brr[l],brr[l+1]) + } + i=l+1; + j=ir; + a=arr[l+1]; + b=brr[l+1]; + for (;;) { + do i++; while (arr[i] < a); + do j--; while (arr[j] > a); + if (j < i) break; + SWAP(arr[i],arr[j]) + SWAP(brr[i],brr[j]) + } + arr[l+1]=arr[j]; + arr[j]=a; + brr[l+1]=brr[j]; + brr[j]=b; + jstack += 2; + if (jstack > NSTACK) nrerror("NSTACK too small in sort2."); + if (ir-i+1 >= j-l) { + istack[jstack]=ir; + istack[jstack-1]=i; + ir=j-1; + } else { + istack[jstack]=j-1; + istack[jstack-1]=l; + l=i; + } + } + } +} +#undef M +#undef NSTACK +#undef SWAP +#undef NRANSI diff --git a/lib/nr/ansi/recipes/sort3.c b/lib/nr/ansi/recipes/sort3.c new file mode 100644 index 0000000..3ff3cb5 --- /dev/null +++ b/lib/nr/ansi/recipes/sort3.c @@ -0,0 +1,23 @@ + +#define NRANSI +#include "nrutil.h" + +void sort3(unsigned long n, float ra[], float rb[], float rc[]) +{ + void indexx(unsigned long n, float arr[], unsigned long indx[]); + unsigned long j,*iwksp; + float *wksp; + + iwksp=lvector(1,n); + wksp=vector(1,n); + indexx(n,ra,iwksp); + for (j=1;j<=n;j++) wksp[j]=ra[j]; + for (j=1;j<=n;j++) ra[j]=wksp[iwksp[j]]; + for (j=1;j<=n;j++) wksp[j]=rb[j]; + for (j=1;j<=n;j++) rb[j]=wksp[iwksp[j]]; + for (j=1;j<=n;j++) wksp[j]=rc[j]; + for (j=1;j<=n;j++) rc[j]=wksp[iwksp[j]]; + free_vector(wksp,1,n); + free_lvector(iwksp,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/spctrm.c b/lib/nr/ansi/recipes/spctrm.c new file mode 100644 index 0000000..91d5575 --- /dev/null +++ b/lib/nr/ansi/recipes/spctrm.c @@ -0,0 +1,58 @@ + +#include +#include +#define NRANSI +#include "nrutil.h" +#define WINDOW(j,a,b) (1.0-fabs((((j)-1)-(a))*(b))) /* Bartlett */ + +void spctrm(FILE *fp, float p[], int m, int k, int ovrlap) +{ + void four1(float data[], unsigned long nn, int isign); + int mm,m44,m43,m4,kk,joffn,joff,j2,j; + float w,facp,facm,*w1,*w2,sumw=0.0,den=0.0; + + mm=m+m; + m43=(m4=mm+mm)+3; + m44=m43+1; + w1=vector(1,m4); + w2=vector(1,m); + facm=m; + facp=1.0/m; + for (j=1;j<=mm;j++) sumw += SQR(WINDOW(j,facm,facp)); + for (j=1;j<=m;j++) p[j]=0.0; + if (ovrlap) + for (j=1;j<=m;j++) fscanf(fp,"%f",&w2[j]); + for (kk=1;kk<=k;kk++) { + for (joff = -1;joff<=0;joff++) { + if (ovrlap) { + for (j=1;j<=m;j++) w1[joff+j+j]=w2[j]; + for (j=1;j<=m;j++) fscanf(fp,"%f",&w2[j]); + joffn=joff+mm; + for (j=1;j<=m;j++) w1[joffn+j+j]=w2[j]; + } else { + for (j=joff+2;j<=m4;j+=2) + fscanf(fp,"%f",&w1[j]); + } + } + for (j=1;j<=mm;j++) { + j2=j+j; + w=WINDOW(j,facm,facp); + w1[j2] *= w; + w1[j2-1] *= w; + } + four1(w1,mm,1); + p[1] += (SQR(w1[1])+SQR(w1[2])); + for (j=2;j<=m;j++) { + j2=j+j; + p[j] += (SQR(w1[j2])+SQR(w1[j2-1]) + +SQR(w1[m44-j2])+SQR(w1[m43-j2])); + } + den += sumw; + } + den *= m4; + for (j=1;j<=m;j++) p[j] /= den; + free_vector(w2,1,m); + free_vector(w1,1,m4); +} +#undef WINDOW +#undef NRANSI diff --git a/lib/nr/ansi/recipes/spear.c b/lib/nr/ansi/recipes/spear.c new file mode 100644 index 0000000..438f74f --- /dev/null +++ b/lib/nr/ansi/recipes/spear.c @@ -0,0 +1,47 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void spear(float data1[], float data2[], unsigned long n, float *d, float *zd, + float *probd, float *rs, float *probrs) +{ + float betai(float a, float b, float x); + void crank(unsigned long n, float w[], float *s); + float erfcc(float x); + void sort2(unsigned long n, float arr[], float brr[]); + unsigned long j; + float vard,t,sg,sf,fac,en3n,en,df,aved,*wksp1,*wksp2; + + wksp1=vector(1,n); + wksp2=vector(1,n); + for (j=1;j<=n;j++) { + wksp1[j]=data1[j]; + wksp2[j]=data2[j]; + } + sort2(n,wksp1,wksp2); + crank(n,wksp1,&sf); + sort2(n,wksp2,wksp1); + crank(n,wksp2,&sg); + *d=0.0; + for (j=1;j<=n;j++) + *d += SQR(wksp1[j]-wksp2[j]); + en=n; + en3n=en*en*en-en; + aved=en3n/6.0-(sf+sg)/12.0; + fac=(1.0-sf/en3n)*(1.0-sg/en3n); + vard=((en-1.0)*en*en*SQR(en+1.0)/36.0)*fac; + *zd=(*d-aved)/sqrt(vard); + *probd=erfcc(fabs(*zd)/1.4142136); + *rs=(1.0-(6.0/en3n)*(*d+(sf+sg)/12.0))/sqrt(fac); + fac=(*rs+1.0)*(1.0-(*rs)); + if (fac > 0.0) { + t=(*rs)*sqrt((en-2.0)/fac); + df=en-2.0; + *probrs=betai(0.5*df,0.5,df/(df+t*t)); + } else + *probrs=0.0; + free_vector(wksp2,1,n); + free_vector(wksp1,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/sphbes.c b/lib/nr/ansi/recipes/sphbes.c new file mode 100644 index 0000000..45cc776 --- /dev/null +++ b/lib/nr/ansi/recipes/sphbes.c @@ -0,0 +1,21 @@ + +#include +#define RTPIO2 1.2533141 + +void sphbes(int n, float x, float *sj, float *sy, float *sjp, float *syp) +{ + void bessjy(float x, float xnu, float *rj, float *ry, float *rjp, + float *ryp); + void nrerror(char error_text[]); + float factor,order,rj,rjp,ry,ryp; + + if (n < 0 || x <= 0.0) nrerror("bad arguments in sphbes"); + order=n+0.5; + bessjy(x,order,&rj,&ry,&rjp,&ryp); + factor=RTPIO2/sqrt(x); + *sj=factor*rj; + *sy=factor*ry; + *sjp=factor*rjp-(*sj)/(2.0*x); + *syp=factor*ryp-(*sy)/(2.0*x); +} +#undef RTPIO2 diff --git a/lib/nr/ansi/recipes/sphfpt.c b/lib/nr/ansi/recipes/sphfpt.c new file mode 100644 index 0000000..bc55e12 --- /dev/null +++ b/lib/nr/ansi/recipes/sphfpt.c @@ -0,0 +1,81 @@ + +#include +#include +#define NRANSI +#include "nrutil.h" +#define N1 2 +#define N2 1 +#define NTOT (N1+N2) +#define DXX 1.0e-4 + +int m,n; +float c2,dx,gmma; + +int nn2,nvar; +float x1,x2,xf; + +int main(void) /* Program sphfpt */ +{ + void newt(float x[], int n, int *check, + void (*vecfunc)(int, float [], float [])); + void shootf(int n, float v[], float f[]); + int check,i; + float q1,*v1,*v2,*v; + + v=vector(1,NTOT); + v1=v; + v2 = &v[N2]; + nvar=NTOT; + nn2=N2; + dx=DXX; + for (;;) { + printf("input m,n,c-squared\n"); + if (scanf("%d %d %f",&m,&n,&c2) == EOF) break; + if (n < m || m < 0) continue; + gmma=1.0; + q1=n; + for (i=1;i<=m;i++) gmma *= -0.5*(n+i)*(q1--/i); + v1[1]=n*(n+1)-m*(m+1)+c2/2.0; + v2[2]=v1[1]; + v2[1]=gmma*(1.0-(v2[2]-c2)*dx/(2*(m+1))); + x1 = -1.0+dx; + x2=1.0-dx; + xf=0.0; + newt(v,NTOT,&check,shootf); + if (check) { + printf("shootf failed; bad initial guess\n"); + } else { + printf("\tmu(m,n)\n"); + printf("%12.6f\n",v[1]); + } + } + free_vector(v,1,NTOT); + return 0; +} + +void load1(float x1, float v1[], float y[]) +{ + float y1 = (n-m & 1 ? -gmma : gmma); + y[3]=v1[1]; + y[2] = -(y[3]-c2)*y1/(2*(m+1)); + y[1]=y1+y[2]*dx; +} + +void load2(float x2, float v2[], float y[]) +{ + y[3]=v2[2]; + y[1]=v2[1]; + y[2]=(y[3]-c2)*y[1]/(2*(m+1)); +} + +void score(float xf, float y[], float f[]) +{ + int i; + + for (i=1;i<=3;i++) f[i]=y[i]; +} +#undef N1 +#undef N2 +#undef NTOT +#undef DXX +#undef NRANSI diff --git a/lib/nr/ansi/recipes/sphoot.c b/lib/nr/ansi/recipes/sphoot.c new file mode 100644 index 0000000..675e669 --- /dev/null +++ b/lib/nr/ansi/recipes/sphoot.c @@ -0,0 +1,66 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define N2 1 + +int m,n; +float c2,dx,gmma; + +int nvar; +float x1,x2; + +int main(void) /* Program sphoot */ +{ + void newt(float x[], int n, int *check, + void (*vecfunc)(int, float [], float [])); + void shoot(int n, float v[], float f[]); + int check,i; + float q1,*v; + + v=vector(1,N2); + dx=1.0e-4; + nvar=3; + for (;;) { + printf("input m,n,c-squared\n"); + if (scanf("%d %d %f",&m,&n,&c2) == EOF) break; + if (n < m || m < 0) continue; + gmma=1.0; + q1=n; + for (i=1;i<=m;i++) gmma *= -0.5*(n+i)*(q1--/i); + v[1]=n*(n+1)-m*(m+1)+c2/2.0; + x1 = -1.0+dx; + x2=0.0; + newt(v,N2,&check,shoot); + if (check) { + printf("shoot failed; bad initial guess\n"); + } else { + printf("\tmu(m,n)\n"); + printf("%12.6f\n",v[1]); + } + } + free_vector(v,1,N2); + return 0; +} + +void load(float x1, float v[], float y[]) +{ + float y1 = (n-m & 1 ? -gmma : gmma); + y[3]=v[1]; + y[2] = -(y[3]-c2)*y1/(2*(m+1)); + y[1]=y1+y[2]*dx; +} + +void score(float xf, float y[], float f[]) +{ + f[1]=(n-m & 1 ? y[1] : y[2]); +} + +void derivs(float x, float y[], float dydx[]) +{ + dydx[1]=y[2]; + dydx[2]=(2.0*x*(m+1.0)*y[2]-(y[3]-c2*x*x)*y[1])/(1.0-x*x); + dydx[3]=0.0; +} +#undef N2 +#undef NRANSI diff --git a/lib/nr/ansi/recipes/splie2.c b/lib/nr/ansi/recipes/splie2.c new file mode 100644 index 0000000..dafc7af --- /dev/null +++ b/lib/nr/ansi/recipes/splie2.c @@ -0,0 +1,9 @@ + +void splie2(float x1a[], float x2a[], float **ya, int m, int n, float **y2a) +{ + void spline(float x[], float y[], int n, float yp1, float ypn, float y2[]); + int j; + + for (j=1;j<=m;j++) + spline(x2a,ya[j],n,1.0e30,1.0e30,y2a[j]); +} diff --git a/lib/nr/ansi/recipes/splin2.c b/lib/nr/ansi/recipes/splin2.c new file mode 100644 index 0000000..511cc68 --- /dev/null +++ b/lib/nr/ansi/recipes/splin2.c @@ -0,0 +1,22 @@ + +#define NRANSI +#include "nrutil.h" + +void splin2(float x1a[], float x2a[], float **ya, float **y2a, int m, int n, + float x1, float x2, float *y) +{ + void spline(float x[], float y[], int n, float yp1, float ypn, float y2[]); + void splint(float xa[], float ya[], float y2a[], int n, float x, float *y); + int j; + float *ytmp,*yytmp; + + ytmp=vector(1,m); + yytmp=vector(1,m); + for (j=1;j<=m;j++) + splint(x2a,ya[j],y2a[j],n,x2,&yytmp[j]); + spline(x1a,yytmp,m,1.0e30,1.0e30,ytmp); + splint(x1a,yytmp,ytmp,m,x1,y); + free_vector(yytmp,1,m); + free_vector(ytmp,1,m); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/spline.c b/lib/nr/ansi/recipes/spline.c new file mode 100644 index 0000000..2fb4034 --- /dev/null +++ b/lib/nr/ansi/recipes/spline.c @@ -0,0 +1,35 @@ + +#define NRANSI +#include "nrutil.h" + +void spline(float x[], float y[], int n, float yp1, float ypn, float y2[]) +{ + int i,k; + float p,qn,sig,un,*u; + + u=vector(1,n-1); + if (yp1 > 0.99e30) + y2[1]=u[1]=0.0; + else { + y2[1] = -0.5; + u[1]=(3.0/(x[2]-x[1]))*((y[2]-y[1])/(x[2]-x[1])-yp1); + } + for (i=2;i<=n-1;i++) { + sig=(x[i]-x[i-1])/(x[i+1]-x[i-1]); + p=sig*y2[i-1]+2.0; + y2[i]=(sig-1.0)/p; + u[i]=(y[i+1]-y[i])/(x[i+1]-x[i]) - (y[i]-y[i-1])/(x[i]-x[i-1]); + u[i]=(6.0*u[i]/(x[i+1]-x[i-1])-sig*u[i-1])/p; + } + if (ypn > 0.99e30) + qn=un=0.0; + else { + qn=0.5; + un=(3.0/(x[n]-x[n-1]))*(ypn-(y[n]-y[n-1])/(x[n]-x[n-1])); + } + y2[n]=(un-qn*u[n-1])/(qn*y2[n-1]+1.0); + for (k=n-1;k>=1;k--) + y2[k]=y2[k]*y2[k+1]+u[k]; + free_vector(u,1,n-1); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/splint.c b/lib/nr/ansi/recipes/splint.c new file mode 100644 index 0000000..adc093b --- /dev/null +++ b/lib/nr/ansi/recipes/splint.c @@ -0,0 +1,20 @@ + +void splint(float xa[], float ya[], float y2a[], int n, float x, float *y) +{ + void nrerror(char error_text[]); + int klo,khi,k; + float h,b,a; + + klo=1; + khi=n; + while (khi-klo > 1) { + k=(khi+klo) >> 1; + if (xa[k] > x) khi=k; + else klo=k; + } + h=xa[khi]-xa[klo]; + if (h == 0.0) nrerror("Bad xa input to routine splint"); + a=(xa[khi]-x)/h; + b=(x-xa[klo])/h; + *y=a*ya[klo]+b*ya[khi]+((a*a*a-a)*y2a[klo]+(b*b*b-b)*y2a[khi])*(h*h)/6.0; +} diff --git a/lib/nr/ansi/recipes/spread.c b/lib/nr/ansi/recipes/spread.c new file mode 100644 index 0000000..3e0d927 --- /dev/null +++ b/lib/nr/ansi/recipes/spread.c @@ -0,0 +1,27 @@ + +#define NRANSI +#include "nrutil.h" + +void spread(float y, float yy[], unsigned long n, float x, int m) +{ + int ihi,ilo,ix,j,nden; + static long nfac[11]={0,1,1,2,6,24,120,720,5040,40320,362880}; + float fac; + + if (m > 10) nrerror("factorial table too small in spread"); + ix=(int)x; + if (x == (float)ix) yy[ix] += y; + else { + ilo=LMIN(LMAX((long)(x-0.5*m+1.0),1),n-m+1); + ihi=ilo+m-1; + nden=nfac[m]; + fac=x-ilo; + for (j=ilo+1;j<=ihi;j++) fac *= (x-j); + yy[ihi] += y*fac/(nden*(x-ihi)); + for (j=ihi-1;j>=ilo;j--) { + nden=(nden/(j+1-ilo))*(j-ihi); + yy[j] += y*fac/(nden*(x-j)); + } + } +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/sprsax.c b/lib/nr/ansi/recipes/sprsax.c new file mode 100644 index 0000000..fe06560 --- /dev/null +++ b/lib/nr/ansi/recipes/sprsax.c @@ -0,0 +1,15 @@ + +void sprsax(float sa[], unsigned long ija[], float x[], float b[], + unsigned long n) +{ + void nrerror(char error_text[]); + unsigned long i,k; + + if (ija[1] != n+2) nrerror("sprsax: mismatched vector and matrix"); + for (i=1;i<=n;i++) { + b[i]=sa[i]*x[i]; + for (k=ija[i];k<=ija[i+1]-1;k++) + b[i] += sa[k]*x[ija[k]]; + + } +} diff --git a/lib/nr/ansi/recipes/sprsin.c b/lib/nr/ansi/recipes/sprsin.c new file mode 100644 index 0000000..802d3c2 --- /dev/null +++ b/lib/nr/ansi/recipes/sprsin.c @@ -0,0 +1,24 @@ + +#include + +void sprsin(float **a, int n, float thresh, unsigned long nmax, float sa[], + unsigned long ija[]) +{ + void nrerror(char error_text[]); + int i,j; + unsigned long k; + + for (j=1;j<=n;j++) sa[j]=a[j][j]; + ija[1]=n+2; + k=n+1; + for (i=1;i<=n;i++) { + for (j=1;j<=n;j++) { + if (fabs(a[i][j]) >= thresh && i != j) { + if (++k > nmax) nrerror("sprsin: nmax too small"); + sa[k]=a[i][j]; + ija[k]=j; + } + } + ija[i+1]=k+1; + } +} diff --git a/lib/nr/ansi/recipes/sprspm.c b/lib/nr/ansi/recipes/sprspm.c new file mode 100644 index 0000000..15ee8a7 --- /dev/null +++ b/lib/nr/ansi/recipes/sprspm.c @@ -0,0 +1,46 @@ + +void sprspm(float sa[], unsigned long ija[], float sb[], unsigned long ijb[], + float sc[], unsigned long ijc[]) +{ + void nrerror(char error_text[]); + unsigned long i,ijma,ijmb,j,m,ma,mb,mbb,mn; + float sum; + + if (ija[1] != ijb[1] || ija[1] != ijc[1]) + nrerror("sprspm: sizes do not match"); + for (i=1;i<=ijc[1]-2;i++) { + j=m=i; + mn=ijc[i]; + sum=sa[i]*sb[i]; + for (;;) { + mb=ijb[j]; + for (ma=ija[i];ma<=ija[i+1]-1;ma++) { + ijma=ija[ma]; + if (ijma == j) sum += sa[ma]*sb[j]; + else { + while (mb < ijb[j+1]) { + ijmb=ijb[mb]; + if (ijmb == i) { + sum += sa[i]*sb[mb++]; + continue; + } else if (ijmb < ijma) { + mb++; + continue; + } else if (ijmb == ijma) { + sum += sa[ma]*sb[mb++]; + continue; + } + break; + } + } + } + for (mbb=mb;mbb<=ijb[j+1]-1;mbb++) { + if (ijb[mbb] == i) sum += sa[i]*sb[mbb]; + } + sc[m]=sum; + sum=0.0; + if (mn >= ijc[i+1]) break; + j=ijc[m=mn++]; + } + } +} diff --git a/lib/nr/ansi/recipes/sprstm.c b/lib/nr/ansi/recipes/sprstm.c new file mode 100644 index 0000000..37b2f95 --- /dev/null +++ b/lib/nr/ansi/recipes/sprstm.c @@ -0,0 +1,49 @@ + +#include + +void sprstm(float sa[], unsigned long ija[], float sb[], unsigned long ijb[], + float thresh, unsigned long nmax, float sc[], unsigned long ijc[]) +{ + void nrerror(char error_text[]); + unsigned long i,ijma,ijmb,j,k,ma,mb,mbb; + float sum; + + if (ija[1] != ijb[1]) nrerror("sprstm: sizes do not match"); + ijc[1]=k=ija[1]; + for (i=1;i<=ija[1]-2;i++) { + for (j=1;j<=ijb[1]-2;j++) { + if (i == j) sum=sa[i]*sb[j]; else sum=0.0e0; + mb=ijb[j]; + for (ma=ija[i];ma<=ija[i+1]-1;ma++) { + ijma=ija[ma]; + if (ijma == j) sum += sa[ma]*sb[j]; + else { + while (mb < ijb[j+1]) { + ijmb=ijb[mb]; + if (ijmb == i) { + sum += sa[i]*sb[mb++]; + continue; + } else if (ijmb < ijma) { + mb++; + continue; + } else if (ijmb == ijma) { + sum += sa[ma]*sb[mb++]; + continue; + } + break; + } + } + } + for (mbb=mb;mbb<=ijb[j+1]-1;mbb++) { + if (ijb[mbb] == i) sum += sa[i]*sb[mbb]; + } + if (i == j) sc[i]=sum; + else if (fabs(sum) > thresh) { + if (k > nmax) nrerror("sprstm: nmax too small"); + sc[k]=sum; + ijc[k++]=j; + } + } + ijc[i+1]=k; + } +} diff --git a/lib/nr/ansi/recipes/sprstp.c b/lib/nr/ansi/recipes/sprstp.c new file mode 100644 index 0000000..682198f --- /dev/null +++ b/lib/nr/ansi/recipes/sprstp.c @@ -0,0 +1,51 @@ + +void sprstp(float sa[], unsigned long ija[], float sb[], unsigned long ijb[]) +{ + void iindexx(unsigned long n, long arr[], unsigned long indx[]); + unsigned long j,jl,jm,jp,ju,k,m,n2,noff,inc,iv; + float v; + + n2=ija[1]; + for (j=1;j<=n2-2;j++) sb[j]=sa[j]; + iindexx(ija[n2-1]-ija[1],(long *)&ija[n2-1],&ijb[n2-1]); + jp=0; + for (k=ija[1];k<=ija[n2-1]-1;k++) { + m=ijb[k]+n2-1; + sb[k]=sa[m]; + for (j=jp+1;j<=ija[m];j++) ijb[j]=k; + jp=ija[m]; + jl=1; + ju=n2-1; + while (ju-jl > 1) { + jm=(ju+jl)/2; + if (ija[jm] > m) ju=jm; else jl=jm; + } + ijb[k]=jl; + } + for (j=jp+1;j iv) { + ijb[m]=ijb[m-inc]; + sb[m]=sb[m-inc]; + m -= inc; + if (m-noff <= inc) break; + } + ijb[m]=iv; + sb[m]=v; + } + } while (inc > 1); + } +} diff --git a/lib/nr/ansi/recipes/sprstx.c b/lib/nr/ansi/recipes/sprstx.c new file mode 100644 index 0000000..0e39a03 --- /dev/null +++ b/lib/nr/ansi/recipes/sprstx.c @@ -0,0 +1,16 @@ + +void sprstx(float sa[], unsigned long ija[], float x[], float b[], + unsigned long n) +{ + void nrerror(char error_text[]); + unsigned long i,j,k; + + if (ija[1] != n+2) nrerror("mismatched vector and matrix in sprstx"); + for (i=1;i<=n;i++) b[i]=sa[i]*x[i]; + for (i=1;i<=n;i++) { + for (k=ija[i];k<=ija[i+1]-1;k++) { + j=ija[k]; + b[j] += sa[k]*x[i]; + } + } +} diff --git a/lib/nr/ansi/recipes/stifbs.c b/lib/nr/ansi/recipes/stifbs.c new file mode 100644 index 0000000..7ffe43f --- /dev/null +++ b/lib/nr/ansi/recipes/stifbs.c @@ -0,0 +1,151 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define KMAXX 7 +#define IMAXX (KMAXX+1) +#define SAFE1 0.25 +#define SAFE2 0.7 +#define REDMAX 1.0e-5 +#define REDMIN 0.7 +#define TINY 1.0e-30 +#define SCALMX 0.1 + +float **d,*x; + +void stifbs(float y[], float dydx[], int nv, float *xx, float htry, float eps, + float yscal[], float *hdid, float *hnext, + void (*derivs)(float, float [], float [])) +{ + void jacobn(float x, float y[], float dfdx[], float **dfdy, int n); + void simpr(float y[], float dydx[], float dfdx[], float **dfdy, + int n, float xs, float htot, int nstep, float yout[], + void (*derivs)(float, float [], float [])); + void pzextr(int iest, float xest, float yest[], float yz[], float dy[], + int nv); + int i,iq,k,kk,km; + static int first=1,kmax,kopt,nvold = -1; + static float epsold = -1.0,xnew; + float eps1,errmax,fact,h,red,scale,work,wrkmin,xest; + float *dfdx,**dfdy,*err,*yerr,*ysav,*yseq; + static float a[IMAXX+1]; + static float alf[KMAXX+1][KMAXX+1]; + static int nseq[IMAXX+1]={0,2,6,10,14,22,34,50,70}; + int reduct,exitflag=0; + + d=matrix(1,nv,1,KMAXX); + dfdx=vector(1,nv); + dfdy=matrix(1,nv,1,nv); + err=vector(1,KMAXX); + x=vector(1,KMAXX); + yerr=vector(1,nv); + ysav=vector(1,nv); + yseq=vector(1,nv); + if(eps != epsold || nv != nvold) { + *hnext = xnew = -1.0e29; + eps1=SAFE1*eps; + a[1]=nseq[1]+1; + for (k=1;k<=KMAXX;k++) a[k+1]=a[k]+nseq[k+1]; + for (iq=2;iq<=KMAXX;iq++) { + for (k=1;k a[kopt]*alf[kopt-1][kopt]) break; + kmax=kopt; + } + h=htry; + for (i=1;i<=nv;i++) ysav[i]=y[i]; + jacobn(*xx,y,dfdx,dfdy,nv); + if (*xx != xnew || h != (*hnext)) { + first=1; + kopt=kmax; + } + reduct=0; + for (;;) { + for (k=1;k<=kmax;k++) { + xnew=(*xx)+h; + if (xnew == (*xx)) nrerror("step size underflow in stifbs"); + simpr(ysav,dydx,dfdx,dfdy,nv,*xx,h,nseq[k],yseq,derivs); + xest=SQR(h/nseq[k]); + pzextr(k,xest,yseq,y,yerr,nv); + if (k != 1) { + errmax=TINY; + for (i=1;i<=nv;i++) errmax=FMAX(errmax,fabs(yerr[i]/yscal[i])); + errmax /= eps; + km=k-1; + err[km]=pow(errmax/SAFE1,1.0/(2*km+1)); + } + if (k != 1 && (k >= kopt-1 || first)) { + if (errmax < 1.0) { + exitflag=1; + break; + } + if (k == kmax || k == kopt+1) { + red=SAFE2/err[km]; + break; + } + else if (k == kopt && alf[kopt-1][kopt] < err[km]) { + red=1.0/err[km]; + break; + } + else if (kopt == kmax && alf[km][kmax-1] < err[km]) { + red=alf[km][kmax-1]*SAFE2/err[km]; + break; + } + else if (alf[km][kopt] < err[km]) { + red=alf[km][kopt-1]/err[km]; + break; + } + } + } + if (exitflag) break; + red=FMIN(red,REDMIN); + red=FMAX(red,REDMAX); + h *= red; + reduct=1; + } + *xx=xnew; + *hdid=h; + first=0; + wrkmin=1.0e35; + for (kk=1;kk<=km;kk++) { + fact=FMAX(err[kk],SCALMX); + work=fact*a[kk+1]; + if (work < wrkmin) { + scale=fact; + wrkmin=work; + kopt=kk+1; + } + } + *hnext=h/scale; + if (kopt >= k && kopt != kmax && !reduct) { + fact=FMAX(scale/alf[kopt-1][kopt],SCALMX); + if (a[kopt+1]*fact <= wrkmin) { + *hnext=h/fact; + kopt++; + } + } + free_vector(yseq,1,nv); + free_vector(ysav,1,nv); + free_vector(yerr,1,nv); + free_vector(x,1,KMAXX); + free_vector(err,1,KMAXX); + free_matrix(dfdy,1,nv,1,nv); + free_vector(dfdx,1,nv); + free_matrix(d,1,nv,1,KMAXX); +} +#undef KMAXX +#undef IMAXX +#undef SAFE1 +#undef SAFE2 +#undef REDMAX +#undef REDMIN +#undef TINY +#undef SCALMX +#undef NRANSI diff --git a/lib/nr/ansi/recipes/stiff.c b/lib/nr/ansi/recipes/stiff.c new file mode 100644 index 0000000..3bf9963 --- /dev/null +++ b/lib/nr/ansi/recipes/stiff.c @@ -0,0 +1,154 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define SAFETY 0.9 +#define GROW 1.5 +#define PGROW -0.25 +#define SHRNK 0.5 +#define PSHRNK (-1.0/3.0) +#define ERRCON 0.1296 +#define MAXTRY 40 +#define GAM (1.0/2.0) +#define A21 2.0 +#define A31 (48.0/25.0) +#define A32 (6.0/25.0) +#define C21 -8.0 +#define C31 (372.0/25.0) +#define C32 (12.0/5.0) +#define C41 (-112.0/125.0) +#define C42 (-54.0/125.0) +#define C43 (-2.0/5.0) +#define B1 (19.0/9.0) +#define B2 (1.0/2.0) +#define B3 (25.0/108.0) +#define B4 (125.0/108.0) +#define E1 (17.0/54.0) +#define E2 (7.0/36.0) +#define E3 0.0 +#define E4 (125.0/108.0) +#define C1X (1.0/2.0) +#define C2X (-3.0/2.0) +#define C3X (121.0/50.0) +#define C4X (29.0/250.0) +#define A2X 1.0 +#define A3X (3.0/5.0) + +void stiff(float y[], float dydx[], int n, float *x, float htry, float eps, + float yscal[], float *hdid, float *hnext, + void (*derivs)(float, float [], float [])) +{ + void jacobn(float x, float y[], float dfdx[], float **dfdy, int n); + void lubksb(float **a, int n, int *indx, float b[]); + void ludcmp(float **a, int n, int *indx, float *d); + int i,j,jtry,*indx; + float d,errmax,h,xsav,**a,*dfdx,**dfdy,*dysav,*err; + float *g1,*g2,*g3,*g4,*ysav; + + indx=ivector(1,n); + a=matrix(1,n,1,n); + dfdx=vector(1,n); + dfdy=matrix(1,n,1,n); + dysav=vector(1,n); + err=vector(1,n); + g1=vector(1,n); + g2=vector(1,n); + g3=vector(1,n); + g4=vector(1,n); + ysav=vector(1,n); + xsav=(*x); + for (i=1;i<=n;i++) { + ysav[i]=y[i]; + dysav[i]=dydx[i]; + } + jacobn(xsav,ysav,dfdx,dfdy,n); + h=htry; + for (jtry=1;jtry<=MAXTRY;jtry++) { + for (i=1;i<=n;i++) { + for (j=1;j<=n;j++) a[i][j] = -dfdy[i][j]; + a[i][i] += 1.0/(GAM*h); + } + ludcmp(a,n,indx,&d); + for (i=1;i<=n;i++) + g1[i]=dysav[i]+h*C1X*dfdx[i]; + lubksb(a,n,indx,g1); + for (i=1;i<=n;i++) + y[i]=ysav[i]+A21*g1[i]; + *x=xsav+A2X*h; + (*derivs)(*x,y,dydx); + for (i=1;i<=n;i++) + g2[i]=dydx[i]+h*C2X*dfdx[i]+C21*g1[i]/h; + lubksb(a,n,indx,g2); + for (i=1;i<=n;i++) + y[i]=ysav[i]+A31*g1[i]+A32*g2[i]; + *x=xsav+A3X*h; + (*derivs)(*x,y,dydx); + for (i=1;i<=n;i++) + g3[i]=dydx[i]+h*C3X*dfdx[i]+(C31*g1[i]+C32*g2[i])/h; + lubksb(a,n,indx,g3); + for (i=1;i<=n;i++) + g4[i]=dydx[i]+h*C4X*dfdx[i]+(C41*g1[i]+C42*g2[i]+C43*g3[i])/h; + lubksb(a,n,indx,g4); + for (i=1;i<=n;i++) { + y[i]=ysav[i]+B1*g1[i]+B2*g2[i]+B3*g3[i]+B4*g4[i]; + err[i]=E1*g1[i]+E2*g2[i]+E3*g3[i]+E4*g4[i]; + } + *x=xsav+h; + if (*x == xsav) nrerror("stepsize not significant in stiff"); + errmax=0.0; + for (i=1;i<=n;i++) errmax=FMAX(errmax,fabs(err[i]/yscal[i])); + errmax /= eps; + if (errmax <= 1.0) { + *hdid=h; + *hnext=(errmax > ERRCON ? SAFETY*h*pow(errmax,PGROW) : GROW*h); + free_vector(ysav,1,n); + free_vector(g4,1,n); + free_vector(g3,1,n); + free_vector(g2,1,n); + free_vector(g1,1,n); + free_vector(err,1,n); + free_vector(dysav,1,n); + free_matrix(dfdy,1,n,1,n); + free_vector(dfdx,1,n); + free_matrix(a,1,n,1,n); + free_ivector(indx,1,n); + return; + } else { + *hnext=SAFETY*h*pow(errmax,PSHRNK); + h=(h >= 0.0 ? FMAX(*hnext,SHRNK*h) : FMIN(*hnext,SHRNK*h)); + } + } + nrerror("exceeded MAXTRY in stiff"); +} +#undef SAFETY +#undef GROW +#undef PGROW +#undef SHRNK +#undef PSHRNK +#undef ERRCON +#undef MAXTRY +#undef GAM +#undef A21 +#undef A31 +#undef A32 +#undef C21 +#undef C31 +#undef C32 +#undef C41 +#undef C42 +#undef C43 +#undef B1 +#undef B2 +#undef B3 +#undef B4 +#undef E1 +#undef E2 +#undef E3 +#undef E4 +#undef C1X +#undef C2X +#undef C3X +#undef C4X +#undef A2X +#undef A3X +#undef NRANSI diff --git a/lib/nr/ansi/recipes/stoerm.c b/lib/nr/ansi/recipes/stoerm.c new file mode 100644 index 0000000..fd9ae56 --- /dev/null +++ b/lib/nr/ansi/recipes/stoerm.c @@ -0,0 +1,35 @@ + +#define NRANSI +#include "nrutil.h" + +void stoerm(float y[], float d2y[], int nv, float xs, float htot, int nstep, + float yout[], void (*derivs)(float, float [], float [])) +{ + int i,n,neqns,nn; + float h,h2,halfh,x,*ytemp; + + ytemp=vector(1,nv); + h=htot/nstep; + halfh=0.5*h; + neqns=nv/2; + for (i=1;i<=neqns;i++) { + n=neqns+i; + ytemp[i]=y[i]+(ytemp[n]=h*(y[n]+halfh*d2y[i])); + } + x=xs+h; + (*derivs)(x,ytemp,yout); + h2=h*h; + for (nn=2;nn<=nstep;nn++) { + for (i=1;i<=neqns;i++) + ytemp[i] += (ytemp[(n=neqns+i)] += h2*yout[i]); + x += h; + (*derivs)(x,ytemp,yout); + } + for (i=1;i<=neqns;i++) { + n=neqns+i; + yout[n]=ytemp[n]/h+halfh*yout[i]; + yout[i]=ytemp[i]; + } + free_vector(ytemp,1,nv); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/svbksb.c b/lib/nr/ansi/recipes/svbksb.c new file mode 100644 index 0000000..51e7fa2 --- /dev/null +++ b/lib/nr/ansi/recipes/svbksb.c @@ -0,0 +1,26 @@ + +#define NRANSI +#include "nrutil.h" + +void svbksb(float **u, float w[], float **v, int m, int n, float b[], float x[]) +{ + int jj,j,i; + float s,*tmp; + + tmp=vector(1,n); + for (j=1;j<=n;j++) { + s=0.0; + if (w[j]) { + for (i=1;i<=m;i++) s += u[i][j]*b[i]; + s /= w[j]; + } + tmp[j]=s; + } + for (j=1;j<=n;j++) { + s=0.0; + for (jj=1;jj<=n;jj++) s += v[j][jj]*tmp[jj]; + x[j]=s; + } + free_vector(tmp,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/svdcmp.c b/lib/nr/ansi/recipes/svdcmp.c new file mode 100644 index 0000000..cdbdfe3 --- /dev/null +++ b/lib/nr/ansi/recipes/svdcmp.c @@ -0,0 +1,184 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void svdcmp(float **a, int m, int n, float w[], float **v) +{ + float pythag(float a, float b); + int flag,i,its,j,jj,k,l,nm; + float anorm,c,f,g,h,s,scale,x,y,z,*rv1; + + rv1=vector(1,n); + g=scale=anorm=0.0; + for (i=1;i<=n;i++) { + l=i+1; + rv1[i]=scale*g; + g=s=scale=0.0; + if (i <= m) { + for (k=i;k<=m;k++) scale += fabs(a[k][i]); + if (scale) { + for (k=i;k<=m;k++) { + a[k][i] /= scale; + s += a[k][i]*a[k][i]; + } + f=a[i][i]; + g = -SIGN(sqrt(s),f); + h=f*g-s; + a[i][i]=f-g; + for (j=l;j<=n;j++) { + for (s=0.0,k=i;k<=m;k++) s += a[k][i]*a[k][j]; + f=s/h; + for (k=i;k<=m;k++) a[k][j] += f*a[k][i]; + } + for (k=i;k<=m;k++) a[k][i] *= scale; + } + } + w[i]=scale *g; + g=s=scale=0.0; + if (i <= m && i != n) { + for (k=l;k<=n;k++) scale += fabs(a[i][k]); + if (scale) { + for (k=l;k<=n;k++) { + a[i][k] /= scale; + s += a[i][k]*a[i][k]; + } + f=a[i][l]; + g = -SIGN(sqrt(s),f); + h=f*g-s; + a[i][l]=f-g; + for (k=l;k<=n;k++) rv1[k]=a[i][k]/h; + for (j=l;j<=m;j++) { + for (s=0.0,k=l;k<=n;k++) s += a[j][k]*a[i][k]; + for (k=l;k<=n;k++) a[j][k] += s*rv1[k]; + } + for (k=l;k<=n;k++) a[i][k] *= scale; + } + } + anorm=FMAX(anorm,(fabs(w[i])+fabs(rv1[i]))); + } + for (i=n;i>=1;i--) { + if (i < n) { + if (g) { + for (j=l;j<=n;j++) + v[j][i]=(a[i][j]/a[i][l])/g; + for (j=l;j<=n;j++) { + for (s=0.0,k=l;k<=n;k++) s += a[i][k]*v[k][j]; + for (k=l;k<=n;k++) v[k][j] += s*v[k][i]; + } + } + for (j=l;j<=n;j++) v[i][j]=v[j][i]=0.0; + } + v[i][i]=1.0; + g=rv1[i]; + l=i; + } + for (i=IMIN(m,n);i>=1;i--) { + l=i+1; + g=w[i]; + for (j=l;j<=n;j++) a[i][j]=0.0; + if (g) { + g=1.0/g; + for (j=l;j<=n;j++) { + for (s=0.0,k=l;k<=m;k++) s += a[k][i]*a[k][j]; + f=(s/a[i][i])*g; + for (k=i;k<=m;k++) a[k][j] += f*a[k][i]; + } + for (j=i;j<=m;j++) a[j][i] *= g; + } else for (j=i;j<=m;j++) a[j][i]=0.0; + ++a[i][i]; + } + for (k=n;k>=1;k--) { + for (its=1;its<=30;its++) { + flag=1; + for (l=k;l>=1;l--) { + nm=l-1; + if ((float)(fabs(rv1[l])+anorm) == anorm) { + flag=0; + break; + } + if ((float)(fabs(w[nm])+anorm) == anorm) break; + } + if (flag) { + c=0.0; + s=1.0; + for (i=l;i<=k;i++) { + f=s*rv1[i]; + rv1[i]=c*rv1[i]; + if ((float)(fabs(f)+anorm) == anorm) break; + g=w[i]; + h=pythag(f,g); + w[i]=h; + h=1.0/h; + c=g*h; + s = -f*h; + for (j=1;j<=m;j++) { + y=a[j][nm]; + z=a[j][i]; + a[j][nm]=y*c+z*s; + a[j][i]=z*c-y*s; + } + } + } + z=w[k]; + if (l == k) { + if (z < 0.0) { + w[k] = -z; + for (j=1;j<=n;j++) v[j][k] = -v[j][k]; + } + break; + } + if (its == 30) nrerror("no convergence in 30 svdcmp iterations"); + x=w[l]; + nm=k-1; + y=w[nm]; + g=rv1[nm]; + h=rv1[k]; + f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y); + g=pythag(f,1.0); + f=((x-z)*(x+z)+h*((y/(f+SIGN(g,f)))-h))/x; + c=s=1.0; + for (j=l;j<=nm;j++) { + i=j+1; + g=rv1[i]; + y=w[i]; + h=s*g; + g=c*g; + z=pythag(f,h); + rv1[j]=z; + c=f/z; + s=h/z; + f=x*c+g*s; + g = g*c-x*s; + h=y*s; + y *= c; + for (jj=1;jj<=n;jj++) { + x=v[jj][j]; + z=v[jj][i]; + v[jj][j]=x*c+z*s; + v[jj][i]=z*c-x*s; + } + z=pythag(f,h); + w[j]=z; + if (z) { + z=1.0/z; + c=f*z; + s=h*z; + } + f=c*g+s*y; + x=c*y-s*g; + for (jj=1;jj<=m;jj++) { + y=a[jj][j]; + z=a[jj][i]; + a[jj][j]=y*c+z*s; + a[jj][i]=z*c-y*s; + } + } + rv1[l]=0.0; + rv1[k]=f; + w[k]=x; + } + } + free_vector(rv1,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/svdfit.c b/lib/nr/ansi/recipes/svdfit.c new file mode 100644 index 0000000..72d6f4b --- /dev/null +++ b/lib/nr/ansi/recipes/svdfit.c @@ -0,0 +1,42 @@ + +#define NRANSI +#include "nrutil.h" +#define TOL 1.0e-5 + +void svdfit(float x[], float y[], float sig[], int ndata, float a[], int ma, + float **u, float **v, float w[], float *chisq, + void (*funcs)(float, float [], int)) +{ + void svbksb(float **u, float w[], float **v, int m, int n, float b[], + float x[]); + void svdcmp(float **a, int m, int n, float w[], float **v); + int j,i; + float wmax,tmp,thresh,sum,*b,*afunc; + + b=vector(1,ndata); + afunc=vector(1,ma); + for (i=1;i<=ndata;i++) { + (*funcs)(x[i],afunc,ma); + tmp=1.0/sig[i]; + for (j=1;j<=ma;j++) u[i][j]=afunc[j]*tmp; + b[i]=y[i]*tmp; + } + svdcmp(u,ndata,ma,w,v); + wmax=0.0; + for (j=1;j<=ma;j++) + if (w[j] > wmax) wmax=w[j]; + thresh=TOL*wmax; + for (j=1;j<=ma;j++) + if (w[j] < thresh) w[j]=0.0; + svbksb(u,w,v,ndata,ma,b,a); + *chisq=0.0; + for (i=1;i<=ndata;i++) { + (*funcs)(x[i],afunc,ma); + for (sum=0.0,j=1;j<=ma;j++) sum += a[j]*afunc[j]; + *chisq += (tmp=(y[i]-sum)/sig[i],tmp*tmp); + } + free_vector(afunc,1,ma); + free_vector(b,1,ndata); +} +#undef TOL +#undef NRANSI diff --git a/lib/nr/ansi/recipes/svdvar.c b/lib/nr/ansi/recipes/svdvar.c new file mode 100644 index 0000000..07a8059 --- /dev/null +++ b/lib/nr/ansi/recipes/svdvar.c @@ -0,0 +1,23 @@ + +#define NRANSI +#include "nrutil.h" + +void svdvar(float **v, int ma, float w[], float **cvm) +{ + int k,j,i; + float sum,*wti; + + wti=vector(1,ma); + for (i=1;i<=ma;i++) { + wti[i]=0.0; + if (w[i]) wti[i]=1.0/(w[i]*w[i]); + } + for (i=1;i<=ma;i++) { + for (j=1;j<=i;j++) { + for (sum=0.0,k=1;k<=ma;k++) sum += v[i][k]*v[j][k]*wti[k]; + cvm[j][i]=cvm[i][j]=sum; + } + } + free_vector(wti,1,ma); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/toeplz.c b/lib/nr/ansi/recipes/toeplz.c new file mode 100644 index 0000000..57f168d --- /dev/null +++ b/lib/nr/ansi/recipes/toeplz.c @@ -0,0 +1,60 @@ + +#define NRANSI +#include "nrutil.h" +#define FREERETURN {free_vector(h,1,n);free_vector(g,1,n);return;} + +void toeplz(float r[], float x[], float y[], int n) +{ + int j,k,m,m1,m2; + float pp,pt1,pt2,qq,qt1,qt2,sd,sgd,sgn,shn,sxn; + float *g,*h; + + if (r[n] == 0.0) nrerror("toeplz-1 singular principal minor"); + g=vector(1,n); + h=vector(1,n); + x[1]=y[1]/r[n]; + if (n == 1) FREERETURN + g[1]=r[n-1]/r[n]; + h[1]=r[n+1]/r[n]; + for (m=1;m<=n;m++) { + m1=m+1; + sxn = -y[m1]; + sd = -r[n]; + for (j=1;j<=m;j++) { + sxn += r[n+m1-j]*x[j]; + sd += r[n+m1-j]*g[m-j+1]; + } + if (sd == 0.0) nrerror("toeplz-2 singular principal minor"); + x[m1]=sxn/sd; + for (j=1;j<=m;j++) x[j] -= x[m1]*g[m-j+1]; + if (m1 == n) FREERETURN + sgn = -r[n-m1]; + shn = -r[n+m1]; + sgd = -r[n]; + for (j=1;j<=m;j++) { + sgn += r[n+j-m1]*g[j]; + shn += r[n+m1-j]*h[j]; + sgd += r[n+j-m1]*h[m-j+1]; + } + if (sgd == 0.0) nrerror("toeplz-3 singular principal minor"); + g[m1]=sgn/sgd; + h[m1]=shn/sd; + k=m; + m2=(m+1) >> 1; + pp=g[m1]; + qq=h[m1]; + for (j=1;j<=m2;j++) { + pt1=g[j]; + pt2=g[k]; + qt1=h[j]; + qt2=h[k]; + g[j]=pt1-pp*qt2; + g[k]=pt2-pp*qt1; + h[j]=qt1-qq*pt2; + h[k--]=qt2-qq*pt1; + } + } + nrerror("toeplz - should not arrive here!"); +} +#undef FREERETURN +#undef NRANSI diff --git a/lib/nr/ansi/recipes/tptest.c b/lib/nr/ansi/recipes/tptest.c new file mode 100644 index 0000000..5faec34 --- /dev/null +++ b/lib/nr/ansi/recipes/tptest.c @@ -0,0 +1,20 @@ + +#include + +void tptest(float data1[], float data2[], unsigned long n, float *t, + float *prob) +{ + void avevar(float data[], unsigned long n, float *ave, float *var); + float betai(float a, float b, float x); + unsigned long j; + float var1,var2,ave1,ave2,sd,df,cov=0.0; + + avevar(data1,n,&ave1,&var1); + avevar(data2,n,&ave2,&var2); + for (j=1;j<=n;j++) + cov += (data1[j]-ave1)*(data2[j]-ave2); + cov /= df=n-1; + sd=sqrt((var1+var2-2.0*cov)/n); + *t=(ave1-ave2)/sd; + *prob=betai(0.5*df,0.5,df/(df+(*t)*(*t))); +} diff --git a/lib/nr/ansi/recipes/tqli.c b/lib/nr/ansi/recipes/tqli.c new file mode 100644 index 0000000..187a78e --- /dev/null +++ b/lib/nr/ansi/recipes/tqli.c @@ -0,0 +1,57 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void tqli(float d[], float e[], int n, float **z) +{ + float pythag(float a, float b); + int m,l,iter,i,k; + float s,r,p,g,f,dd,c,b; + + for (i=2;i<=n;i++) e[i-1]=e[i]; + e[n]=0.0; + for (l=1;l<=n;l++) { + iter=0; + do { + for (m=l;m<=n-1;m++) { + dd=fabs(d[m])+fabs(d[m+1]); + if ((float)(fabs(e[m])+dd) == dd) break; + } + if (m != l) { + if (iter++ == 30) nrerror("Too many iterations in tqli"); + g=(d[l+1]-d[l])/(2.0*e[l]); + r=pythag(g,1.0); + g=d[m]-d[l]+e[l]/(g+SIGN(r,g)); + s=c=1.0; + p=0.0; + for (i=m-1;i>=l;i--) { + f=s*e[i]; + b=c*e[i]; + e[i+1]=(r=pythag(f,g)); + if (r == 0.0) { + d[i+1] -= p; + e[m]=0.0; + break; + } + s=f/r; + c=g/r; + g=d[i+1]-p; + r=(d[i]-g)*s+2.0*c*b; + d[i+1]=g+(p=s*r); + g=c*r-b; + for (k=1;k<=n;k++) { + f=z[k][i+1]; + z[k][i+1]=s*z[k][i]+c*f; + z[k][i]=c*z[k][i]-s*f; + } + } + if (r == 0.0 && i >= l) continue; + d[l] -= p; + e[l]=g; + e[m]=0.0; + } + } while (m != l); + } +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/trapzd.c b/lib/nr/ansi/recipes/trapzd.c new file mode 100644 index 0000000..aecca37 --- /dev/null +++ b/lib/nr/ansi/recipes/trapzd.c @@ -0,0 +1,22 @@ + +#define FUNC(x) ((*func)(x)) + +float trapzd(float (*func)(float), float a, float b, int n) +{ + float x,tnm,sum,del; + static float s; + int it,j; + + if (n == 1) { + return (s=0.5*(b-a)*(FUNC(a)+FUNC(b))); + } else { + for (it=1,j=1;j + +void tred2(float **a, int n, float d[], float e[]) +{ + int l,k,j,i; + float scale,hh,h,g,f; + + for (i=n;i>=2;i--) { + l=i-1; + h=scale=0.0; + if (l > 1) { + for (k=1;k<=l;k++) + scale += fabs(a[i][k]); + if (scale == 0.0) + e[i]=a[i][l]; + else { + for (k=1;k<=l;k++) { + a[i][k] /= scale; + h += a[i][k]*a[i][k]; + } + f=a[i][l]; + g=(f >= 0.0 ? -sqrt(h) : sqrt(h)); + e[i]=scale*g; + h -= f*g; + a[i][l]=f-g; + f=0.0; + for (j=1;j<=l;j++) { + a[j][i]=a[i][j]/h; + g=0.0; + for (k=1;k<=j;k++) + g += a[j][k]*a[i][k]; + for (k=j+1;k<=l;k++) + g += a[k][j]*a[i][k]; + e[j]=g/h; + f += e[j]*a[i][j]; + } + hh=f/(h+h); + for (j=1;j<=l;j++) { + f=a[i][j]; + e[j]=g=e[j]-hh*f; + for (k=1;k<=j;k++) + a[j][k] -= (f*e[k]+g*a[i][k]); + } + } + } else + e[i]=a[i][l]; + d[i]=h; + } + d[1]=0.0; + e[1]=0.0; + /* Contents of this loop can be omitted if eigenvectors not + wanted except for statement d[i]=a[i][i]; */ + for (i=1;i<=n;i++) { + l=i-1; + if (d[i]) { + for (j=1;j<=l;j++) { + g=0.0; + for (k=1;k<=l;k++) + g += a[i][k]*a[k][j]; + for (k=1;k<=l;k++) + a[k][j] -= g*a[k][i]; + } + } + d[i]=a[i][i]; + a[i][i]=1.0; + for (j=1;j<=l;j++) a[j][i]=a[i][j]=0.0; + } +} diff --git a/lib/nr/ansi/recipes/tridag.c b/lib/nr/ansi/recipes/tridag.c new file mode 100644 index 0000000..c7fc07b --- /dev/null +++ b/lib/nr/ansi/recipes/tridag.c @@ -0,0 +1,24 @@ + +#define NRANSI +#include "nrutil.h" + +void tridag(float a[], float b[], float c[], float r[], float u[], + unsigned long n) +{ + unsigned long j; + float bet,*gam; + + gam=vector(1,n); + if (b[1] == 0.0) nrerror("Error 1 in tridag"); + u[1]=r[1]/(bet=b[1]); + for (j=2;j<=n;j++) { + gam[j]=c[j-1]/bet; + bet=b[j]-a[j]*gam[j]; + if (bet == 0.0) nrerror("Error 2 in tridag"); + u[j]=(r[j]-a[j]*u[j-1])/bet; + } + for (j=(n-1);j>=1;j--) + u[j] -= gam[j+1]*u[j+1]; + free_vector(gam,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/trncst.c b/lib/nr/ansi/recipes/trncst.c new file mode 100644 index 0000000..dc69870 --- /dev/null +++ b/lib/nr/ansi/recipes/trncst.c @@ -0,0 +1,26 @@ + +#include +#define ALEN(a,b,c,d) sqrt(((b)-(a))*((b)-(a))+((d)-(c))*((d)-(c))) + +float trncst(float x[], float y[], int iorder[], int ncity, int n[]) +{ + float xx[7],yy[7],de; + int j,ii; + + n[4]=1 + (n[3] % ncity); + n[5]=1 + ((n[1]+ncity-2) % ncity); + n[6]=1 + (n[2] % ncity); + for (j=1;j<=6;j++) { + ii=iorder[n[j]]; + xx[j]=x[ii]; + yy[j]=y[ii]; + } + de = -ALEN(xx[2],xx[6],yy[2],yy[6]); + de -= ALEN(xx[1],xx[5],yy[1],yy[5]); + de -= ALEN(xx[3],xx[4],yy[3],yy[4]); + de += ALEN(xx[1],xx[3],yy[1],yy[3]); + de += ALEN(xx[2],xx[4],yy[2],yy[4]); + de += ALEN(xx[5],xx[6],yy[5],yy[6]); + return de; +} +#undef ALEN diff --git a/lib/nr/ansi/recipes/trnspt.c b/lib/nr/ansi/recipes/trnspt.c new file mode 100644 index 0000000..27cdefa --- /dev/null +++ b/lib/nr/ansi/recipes/trnspt.c @@ -0,0 +1,30 @@ + +#define NRANSI +#include "nrutil.h" + +void trnspt(int iorder[], int ncity, int n[]) +{ + int m1,m2,m3,nn,j,jj,*jorder; + + jorder=ivector(1,ncity); + m1=1 + ((n[2]-n[1]+ncity) % ncity); + m2=1 + ((n[5]-n[4]+ncity) % ncity); + m3=1 + ((n[3]-n[6]+ncity) % ncity); + nn=1; + for (j=1;j<=m1;j++) { + jj=1 + ((j+n[1]-2) % ncity); + jorder[nn++]=iorder[jj]; + } + for (j=1;j<=m2;j++) { + jj=1+((j+n[4]-2) % ncity); + jorder[nn++]=iorder[jj]; + } + for (j=1;j<=m3;j++) { + jj=1 + ((j+n[6]-2) % ncity); + jorder[nn++]=iorder[jj]; + } + for (j=1;j<=ncity;j++) + iorder[j]=jorder[j]; + free_ivector(jorder,1,ncity); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/ttest.c b/lib/nr/ansi/recipes/ttest.c new file mode 100644 index 0000000..e2f0839 --- /dev/null +++ b/lib/nr/ansi/recipes/ttest.c @@ -0,0 +1,17 @@ + +#include + +void ttest(float data1[], unsigned long n1, float data2[], unsigned long n2, + float *t, float *prob) +{ + void avevar(float data[], unsigned long n, float *ave, float *var); + float betai(float a, float b, float x); + float var1,var2,svar,df,ave1,ave2; + + avevar(data1,n1,&ave1,&var1); + avevar(data2,n2,&ave2,&var2); + df=n1+n2-2; + svar=((n1-1)*var1+(n2-1)*var2)/df; + *t=(ave1-ave2)/sqrt(svar*(1.0/n1+1.0/n2)); + *prob=betai(0.5*df,0.5,df/(df+(*t)*(*t))); +} diff --git a/lib/nr/ansi/recipes/tutest.c b/lib/nr/ansi/recipes/tutest.c new file mode 100644 index 0000000..5bc56eb --- /dev/null +++ b/lib/nr/ansi/recipes/tutest.c @@ -0,0 +1,19 @@ + +#include +#define NRANSI +#include "nrutil.h" + +void tutest(float data1[], unsigned long n1, float data2[], unsigned long n2, + float *t, float *prob) +{ + void avevar(float data[], unsigned long n, float *ave, float *var); + float betai(float a, float b, float x); + float var1,var2,df,ave1,ave2; + + avevar(data1,n1,&ave1,&var1); + avevar(data2,n2,&ave2,&var2); + *t=(ave1-ave2)/sqrt(var1/n1+var2/n2); + df=SQR(var1/n1+var2/n2)/(SQR(var1/n1)/(n1-1)+SQR(var2/n2)/(n2-1)); + *prob=betai(0.5*df,0.5,df/(df+SQR(*t))); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/twofft.c b/lib/nr/ansi/recipes/twofft.c new file mode 100644 index 0000000..288d61b --- /dev/null +++ b/lib/nr/ansi/recipes/twofft.c @@ -0,0 +1,31 @@ + +void twofft(float data1[], float data2[], float fft1[], float fft2[], + unsigned long n) +{ + void four1(float data[], unsigned long nn, int isign); + unsigned long nn3,nn2,jj,j; + float rep,rem,aip,aim; + + nn3=1+(nn2=2+n+n); + for (j=1,jj=2;j<=n;j++,jj+=2) { + fft1[jj-1]=data1[j]; + fft1[jj]=data2[j]; + } + four1(fft1,n,1); + fft2[1]=fft1[2]; + fft1[2]=fft2[2]=0.0; + for (j=3;j<=n+1;j+=2) { + rep=0.5*(fft1[j]+fft1[nn2-j]); + rem=0.5*(fft1[j]-fft1[nn2-j]); + aip=0.5*(fft1[j+1]+fft1[nn3-j]); + aim=0.5*(fft1[j+1]-fft1[nn3-j]); + fft1[j]=rep; + fft1[j+1]=aim; + fft1[nn2-j]=rep; + fft1[nn3-j] = -aim; + fft2[j]=aip; + fft2[j+1] = -rem; + fft2[nn2-j]=aip; + fft2[nn3-j]=rem; + } +} diff --git a/lib/nr/ansi/recipes/vander.c b/lib/nr/ansi/recipes/vander.c new file mode 100644 index 0000000..20b0760 --- /dev/null +++ b/lib/nr/ansi/recipes/vander.c @@ -0,0 +1,35 @@ + +#define NRANSI +#include "nrutil.h" + +void vander(double x[], double w[], double q[], int n) +{ + int i,j,k; + double b,s,t,xx; + double *c; + + c=dvector(1,n); + if (n == 1) w[1]=q[1]; + else { + for (i=1;i<=n;i++) c[i]=0.0; + c[n] = -x[1]; + for (i=2;i<=n;i++) { + xx = -x[i]; + for (j=(n+1-i);j<=(n-1);j++) c[j] += xx*c[j+1]; + c[n] += xx; + } + for (i=1;i<=n;i++) { + xx=x[i]; + t=b=1.0; + s=q[n]; + for (k=n;k>=2;k--) { + b=c[k]+xx*b; + s += q[k-1]*b; + t=xx*t+b; + } + w[i]=s/t; + } + } + free_dvector(c,1,n); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/vegas.c b/lib/nr/ansi/recipes/vegas.c new file mode 100644 index 0000000..075b2c6 --- /dev/null +++ b/lib/nr/ansi/recipes/vegas.c @@ -0,0 +1,178 @@ + +#include +#include +#define NRANSI +#include "nrutil.h" +#define ALPH 1.5 +#define NDMX 50 +#define MXDIM 10 +#define TINY 1.0e-30 + +extern long idum; + +void vegas(float regn[], int ndim, float (*fxn)(float [], float), int init, + unsigned long ncall, int itmx, int nprn, float *tgral, float *sd, + float *chi2a) +{ + float ran2(long *idum); + void rebin(float rc, int nd, float r[], float xin[], float xi[]); + static int i,it,j,k,mds,nd,ndo,ng,npg,ia[MXDIM+1],kg[MXDIM+1]; + static float calls,dv2g,dxg,f,f2,f2b,fb,rc,ti,tsi,wgt,xjac,xn,xnd,xo; + static float d[NDMX+1][MXDIM+1],di[NDMX+1][MXDIM+1],dt[MXDIM+1], + dx[MXDIM+1], r[NDMX+1],x[MXDIM+1],xi[MXDIM+1][NDMX+1],xin[NDMX+1]; + static double schi,si,swgt; + + if (init <= 0) { + mds=ndo=1; + for (j=1;j<=ndim;j++) xi[j][1]=1.0; + } + if (init <= 1) si=swgt=schi=0.0; + if (init <= 2) { + nd=NDMX; + ng=1; + if (mds) { + ng=(int)pow(ncall/2.0+0.25,1.0/ndim); + mds=1; + if ((2*ng-NDMX) >= 0) { + mds = -1; + npg=ng/NDMX+1; + nd=ng/npg; + ng=npg*nd; + } + } + for (k=1,i=1;i<=ndim;i++) k *= ng; + npg=IMAX(ncall/k,2); + calls=(float)npg * (float)k; + dxg=1.0/ng; + for (dv2g=1,i=1;i<=ndim;i++) dv2g *= dxg; + dv2g=SQR(calls*dv2g)/npg/npg/(npg-1.0); + xnd=nd; + dxg *= xnd; + xjac=1.0/calls; + for (j=1;j<=ndim;j++) { + dx[j]=regn[j+ndim]-regn[j]; + xjac *= dx[j]; + } + if (nd != ndo) { + for (i=1;i<=IMAX(nd,ndo);i++) r[i]=1.0; + for (j=1;j<=ndim;j++) rebin(ndo/xnd,nd,r,xin,xi[j]); + ndo=nd; + } + if (nprn >= 0) { + printf("%s: ndim= %3d ncall= %8.0f\n", + " Input parameters for vegas",ndim,calls); + printf("%28s it=%5d itmx=%5d\n"," ",it,itmx); + printf("%28s nprn=%3d ALPH=%5.2f\n"," ",nprn,ALPH); + printf("%28s mds=%3d nd=%4d\n"," ",mds,nd); + for (j=1;j<=ndim;j++) { + printf("%30s xl[%2d]= %11.4g xu[%2d]= %11.4g\n", + " ",j,regn[j],j,regn[j+ndim]); + } + } + } + for (it=1;it<=itmx;it++) { + ti=tsi=0.0; + for (j=1;j<=ndim;j++) { + kg[j]=1; + for (i=1;i<=nd;i++) d[i][j]=di[i][j]=0.0; + } + for (;;) { + fb=f2b=0.0; + for (k=1;k<=npg;k++) { + wgt=xjac; + for (j=1;j<=ndim;j++) { + xn=(kg[j]-ran2(&idum))*dxg+1.0; + ia[j]=IMAX(IMIN((int)(xn),NDMX),1); + if (ia[j] > 1) { + xo=xi[j][ia[j]]-xi[j][ia[j]-1]; + rc=xi[j][ia[j]-1]+(xn-ia[j])*xo; + } else { + xo=xi[j][ia[j]]; + rc=(xn-ia[j])*xo; + } + x[j]=regn[j]+rc*dx[j]; + wgt *= xo*xnd; + } + f=wgt*(*fxn)(x,wgt); + f2=f*f; + fb += f; + f2b += f2; + for (j=1;j<=ndim;j++) { + di[ia[j]][j] += f; + if (mds >= 0) d[ia[j]][j] += f2; + } + } + f2b=sqrt(f2b*npg); + f2b=(f2b-fb)*(f2b+fb); + if (f2b <= 0.0) f2b=TINY; + ti += fb; + tsi += f2b; + if (mds < 0) { + for (j=1;j<=ndim;j++) d[ia[j]][j] += f2b; + } + for (k=ndim;k>=1;k--) { + kg[k] %= ng; + if (++kg[k] != 1) break; + } + if (k < 1) break; + } + tsi *= dv2g; + wgt=1.0/tsi; + si += wgt*ti; + schi += wgt*ti*ti; + swgt += wgt; + *tgral=si/swgt; + *chi2a=(schi-si*(*tgral))/(it-0.9999); + if (*chi2a < 0.0) *chi2a = 0.0; + *sd=sqrt(1.0/swgt); + tsi=sqrt(tsi); + if (nprn >= 0) { + printf("%s %3d : integral = %14.7g +/- %9.2g\n", + " iteration no.",it,ti,tsi); + printf("%s integral =%14.7g+/-%9.2g chi**2/IT n = %9.2g\n", + " all iterations: ",*tgral,*sd,*chi2a); + if (nprn) { + for (j=1;j<=ndim;j++) { + printf(" DATA FOR axis %2d\n",j); + printf("%6s%13s%11s%13s%11s%13s\n", + "X","delta i","X","delta i","X","delta i"); + for (i=1+nprn/2;i<=nd;i += nprn+2) { + printf("%8.5f%12.4g%12.5f%12.4g%12.5f%12.4g\n", + xi[j][i],di[i][j],xi[j][i+1], + di[i+1][j],xi[j][i+2],di[i+2][j]); + } + } + } + } + for (j=1;j<=ndim;j++) { + xo=d[1][j]; + xn=d[2][j]; + d[1][j]=(xo+xn)/2.0; + dt[j]=d[1][j]; + for (i=2;i= 0) { + for (nn=n;nn>=4;nn>>=1) (*wtstep)(a,nn,isign); + } else { + for (nn=4;nn<=n;nn<<=1) (*wtstep)(a,nn,isign); + } +} diff --git a/lib/nr/ansi/recipes/wtn.c b/lib/nr/ansi/recipes/wtn.c new file mode 100644 index 0000000..f2aeacd --- /dev/null +++ b/lib/nr/ansi/recipes/wtn.c @@ -0,0 +1,37 @@ + +#define NRANSI +#include "nrutil.h" + +void wtn(float a[], unsigned long nn[], int ndim, int isign, + void (*wtstep)(float [], unsigned long, int)) +{ + unsigned long i1,i2,i3,k,n,nnew,nprev=1,nt,ntot=1; + int idim; + float *wksp; + + for (idim=1;idim<=ndim;idim++) ntot *= nn[idim]; + wksp=vector(1,ntot); + for (idim=1;idim<=ndim;idim++) { + n=nn[idim]; + nnew=n*nprev; + if (n > 4) { + for (i2=0;i2= 0) { + for(nt=n;nt>=4;nt >>= 1) + (*wtstep)(wksp,nt,isign); + } else { + for(nt=4;nt<=n;nt <<= 1) + (*wtstep)(wksp,nt,isign); + } + + for (i3=i1+i2,k=1;k<=n;k++,i3+=nprev) a[i3]=wksp[k]; + } + } + } + nprev=nnew; + } + free_vector(wksp,1,ntot); +} +#undef NRANSI diff --git a/lib/nr/ansi/recipes/wwghts.c b/lib/nr/ansi/recipes/wwghts.c new file mode 100644 index 0000000..21db6ca --- /dev/null +++ b/lib/nr/ansi/recipes/wwghts.c @@ -0,0 +1,52 @@ + +void wwghts(float wghts[], int n, float h, + void (*kermom)(double [], double ,int)) +{ + int j,k; + double wold[5],wnew[5],w[5],hh,hi,c,fac,a,b; + + hh=h; + hi=1.0/hh; + for (j=1;j<=n;j++) wghts[j]=0.0; + (*kermom)(wold,0.0,4); + if (n >= 4) { + b=0.0; + for (j=1;j<=n-3;j++) { + c=j-1; + a=b; + b=a+hh; + if (j == n-3) b=(n-1)*hh; + (*kermom)(wnew,b,4); + for (fac=1.0,k=1;k<=4;k++,fac*=hi) + w[k]=(wnew[k]-wold[k])*fac; + wghts[j] += ( + ((c+1.0)*(c+2.0)*(c+3.0)*w[1] + -(11.0+c*(12.0+c*3.0))*w[2] + +3.0*(c+2.0)*w[3]-w[4])/6.0); + wghts[j+1] += ( + (-c*(c+2.0)*(c+3.0)*w[1] + +(6.0+c*(10.0+c*3.0))*w[2] + -(3.0*c+5.0)*w[3]+w[4])*0.5); + wghts[j+2] += ( + (c*(c+1.0)*(c+3.0)*w[1] + -(3.0+c*(8.0+c*3.0))*w[2] + +(3.0*c+4.0)*w[3]-w[4])*0.5); + wghts[j+3] += ( + (-c*(c+1.0)*(c+2.0)*w[1] + +(2.0+c*(6.0+c*3.0))*w[2] + -3.0*(c+1.0)*w[3]+w[4])/6.0); + for (k=1;k<=4;k++) wold[k]=wnew[k]; + } + } else if (n == 3) { + (*kermom)(wnew,hh+hh,3); + w[1]=wnew[1]-wold[1]; + w[2]=hi*(wnew[2]-wold[2]); + w[3]=hi*hi*(wnew[3]-wold[3]); + wghts[1]=w[1]-1.5*w[2]+0.5*w[3]; + wghts[2]=2.0*w[2]-w[3]; + wghts[3]=0.5*(w[3]-w[2]); + } else if (n == 2) { + (*kermom)(wnew,hh,2); + wghts[1]=wnew[1]-wold[1]-(wghts[2]=hi*(wnew[2]-wold[2])); + } +} diff --git a/lib/nr/ansi/recipes/zbrac.c b/lib/nr/ansi/recipes/zbrac.c new file mode 100644 index 0000000..2569208 --- /dev/null +++ b/lib/nr/ansi/recipes/zbrac.c @@ -0,0 +1,25 @@ + +#include +#define FACTOR 1.6 +#define NTRY 50 + +int zbrac(float (*func)(float), float *x1, float *x2) +{ + void nrerror(char error_text[]); + int j; + float f1,f2; + + if (*x1 == *x2) nrerror("Bad initial range in zbrac"); + f1=(*func)(*x1); + f2=(*func)(*x2); + for (j=1;j<=NTRY;j++) { + if (f1*f2 < 0.0) return 1; + if (fabs(f1) < fabs(f2)) + f1=(*func)(*x1 += FACTOR*(*x1-*x2)); + else + f2=(*func)(*x2 += FACTOR*(*x2-*x1)); + } + return 0; +} +#undef FACTOR +#undef NTRY diff --git a/lib/nr/ansi/recipes/zbrak.c b/lib/nr/ansi/recipes/zbrak.c new file mode 100644 index 0000000..266abeb --- /dev/null +++ b/lib/nr/ansi/recipes/zbrak.c @@ -0,0 +1,22 @@ + +void zbrak(float (*fx)(float), float x1, float x2, int n, float xb1[], + float xb2[], int *nb) +{ + int nbb,i; + float x,fp,fc,dx; + + nbb=0; + dx=(x2-x1)/n; + fp=(*fx)(x=x1); + for (i=1;i<=n;i++) { + fc=(*fx)(x += dx); + if (fc*fp <= 0.0) { + xb1[++nbb]=x-dx; + xb2[nbb]=x; + if(*nb == nbb) return; + + } + fp=fc; + } + *nb = nbb; +} diff --git a/lib/nr/ansi/recipes/zbrent.c b/lib/nr/ansi/recipes/zbrent.c new file mode 100644 index 0000000..bdcfaeb --- /dev/null +++ b/lib/nr/ansi/recipes/zbrent.c @@ -0,0 +1,73 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define ITMAX 100 +#define EPS 3.0e-8 + +float zbrent(float (*func)(float), float x1, float x2, float tol) +{ + int iter; + float a=x1,b=x2,c=x2,d,e,min1,min2; + float fa=(*func)(a),fb=(*func)(b),fc,p,q,r,s,tol1,xm; + + if ((fa > 0.0 && fb > 0.0) || (fa < 0.0 && fb < 0.0)) + nrerror("Root must be bracketed in zbrent"); + fc=fb; + for (iter=1;iter<=ITMAX;iter++) { + if ((fb > 0.0 && fc > 0.0) || (fb < 0.0 && fc < 0.0)) { + c=a; + fc=fa; + e=d=b-a; + } + if (fabs(fc) < fabs(fb)) { + a=b; + b=c; + c=a; + fa=fb; + fb=fc; + fc=fa; + } + tol1=2.0*EPS*fabs(b)+0.5*tol; + xm=0.5*(c-b); + if (fabs(xm) <= tol1 || fb == 0.0) return b; + if (fabs(e) >= tol1 && fabs(fa) > fabs(fb)) { + s=fb/fa; + if (a == c) { + p=2.0*xm*s; + q=1.0-s; + } else { + q=fa/fc; + r=fb/fc; + p=s*(2.0*xm*q*(q-r)-(b-a)*(r-1.0)); + q=(q-1.0)*(r-1.0)*(s-1.0); + } + if (p > 0.0) q = -q; + p=fabs(p); + min1=3.0*xm*q-fabs(tol1*q); + min2=fabs(e*q); + if (2.0*p < (min1 < min2 ? min1 : min2)) { + e=d; + d=p/q; + } else { + d=xm; + e=d; + } + } else { + d=xm; + e=d; + } + a=b; + fa=fb; + if (fabs(d) > tol1) + b += d; + else + b += SIGN(tol1,xm); + fb=(*func)(b); + } + nrerror("Maximum number of iterations exceeded in zbrent"); + return 0.0; +} +#undef ITMAX +#undef EPS +#undef NRANSI diff --git a/lib/nr/ansi/recipes/zrhqr.c b/lib/nr/ansi/recipes/zrhqr.c new file mode 100644 index 0000000..365c663 --- /dev/null +++ b/lib/nr/ansi/recipes/zrhqr.c @@ -0,0 +1,36 @@ + +#define NRANSI +#include "nrutil.h" +#define MAXM 50 + +void zrhqr(float a[], int m, float rtr[], float rti[]) +{ + void balanc(float **a, int n); + void hqr(float **a, int n, float wr[], float wi[]); + int j,k; + float **hess,xr,xi; + + hess=matrix(1,MAXM,1,MAXM); + if (m > MAXM || a[m] == 0.0) nrerror("bad args in zrhqr"); + for (k=1;k<=m;k++) { + hess[1][k] = -a[m-k]/a[m]; + for (j=2;j<=m;j++) hess[j][k]=0.0; + if (k != m) hess[k+1][k]=1.0; + } + balanc(hess,m); + hqr(hess,m,rtr,rti); + for (j=2;j<=m;j++) { + xr=rtr[j]; + xi=rti[j]; + for (k=j-1;k>=1;k--) { + if (rtr[k] <= xr) break; + rtr[k+1]=rtr[k]; + rti[k+1]=rti[k]; + } + rtr[k+1]=xr; + rti[k+1]=xi; + } + free_matrix(hess,1,MAXM,1,MAXM); +} +#undef MAXM +#undef NRANSI diff --git a/lib/nr/ansi/recipes/zriddr.c b/lib/nr/ansi/recipes/zriddr.c new file mode 100644 index 0000000..582bf4e --- /dev/null +++ b/lib/nr/ansi/recipes/zriddr.c @@ -0,0 +1,54 @@ + +#include +#define NRANSI +#include "nrutil.h" +#define MAXIT 60 +#define UNUSED (-1.11e30) + +float zriddr(float (*func)(float), float x1, float x2, float xacc) +{ + int j; + float ans,fh,fl,fm,fnew,s,xh,xl,xm,xnew; + + fl=(*func)(x1); + fh=(*func)(x2); + if ((fl > 0.0 && fh < 0.0) || (fl < 0.0 && fh > 0.0)) { + xl=x1; + xh=x2; + ans=UNUSED; + for (j=1;j<=MAXIT;j++) { + xm=0.5*(xl+xh); + fm=(*func)(xm); + s=sqrt(fm*fm-fl*fh); + if (s == 0.0) return ans; + xnew=xm+(xm-xl)*((fl >= fh ? 1.0 : -1.0)*fm/s); + if (fabs(xnew-ans) <= xacc) return ans; + ans=xnew; + fnew=(*func)(ans); + if (fnew == 0.0) return ans; + if (SIGN(fm,fnew) != fm) { + xl=xm; + fl=fm; + xh=ans; + fh=fnew; + } else if (SIGN(fl,fnew) != fl) { + xh=ans; + fh=fnew; + } else if (SIGN(fh,fnew) != fh) { + xl=ans; + fl=fnew; + } else nrerror("never get here."); + if (fabs(xh-xl) <= xacc) return ans; + } + nrerror("zriddr exceed maximum iterations"); + } + else { + if (fl == 0.0) return x1; + if (fh == 0.0) return x2; + nrerror("root must be bracketed in zriddr."); + } + return 0.0; +} +#undef MAXIT +#undef UNUSED +#undef NRANSI diff --git a/lib/nr/ansi/recipes/zroots.c b/lib/nr/ansi/recipes/zroots.c new file mode 100644 index 0000000..603fb6c --- /dev/null +++ b/lib/nr/ansi/recipes/zroots.c @@ -0,0 +1,39 @@ + +#include +#include "complex.h" +#define EPS 2.0e-6 +#define MAXM 100 + +void zroots(fcomplex a[], int m, fcomplex roots[], int polish) +{ + void laguer(fcomplex a[], int m, fcomplex *x, int *its); + int i,its,j,jj; + fcomplex x,b,c,ad[MAXM]; + + for (j=0;j<=m;j++) ad[j]=a[j]; + for (j=m;j>=1;j--) { + x=Complex(0.0,0.0); + laguer(ad,j,&x,&its); + if (fabs(x.i) <= 2.0*EPS*fabs(x.r)) x.i=0.0; + roots[j]=x; + b=ad[j]; + for (jj=j-1;jj>=0;jj--) { + c=ad[jj]; + ad[jj]=b; + b=Cadd(Cmul(x,b),c); + } + } + if (polish) + for (j=1;j<=m;j++) + laguer(a,m,&roots[j],&its); + for (j=2;j<=m;j++) { + x=roots[j]; + for (i=j-1;i>=1;i--) { + if (roots[i].r <= x.r) break; + roots[i+1]=roots[i]; + } + roots[i+1]=x; + } +} +#undef EPS +#undef MAXM diff --git a/lib/nr/ansi/toc.htm b/lib/nr/ansi/toc.htm new file mode 100644 index 0000000..e6f4a29 --- /dev/null +++ b/lib/nr/ansi/toc.htm @@ -0,0 +1,285 @@ +Numerical Recipes Table of Contents + +

    Contents of Numerical Recipes

    +

    (Second Edition in C++, C, or Fortran)

    + + (Page numbers may vary slightly among the language versions.) + + +
  • Preface to the Second Edition xi +
  • Preface to the First Edition xiv +
  • Legal Matters xvi +
  • Computer Programs by Chapter and Section xix +
    •  + +

    1 Preliminaries

    + +
  • 1.0 Introduction 1 +
  • 1.1 Program Organization and Control Structures 5 +
  • 1.2 Error, Accuracy, and Stability 18 +
    •  + +

    2 Solution of Linear Algebraic Equations

    + +
  • 2.0 Introduction 22 +
  • 2.1 Gauss-Jordan Elimination 27 +
  • 2.2 Gaussian Elimination with Backsubstitution 33 +
  • 2.3 LU Decomposition and Its Applications 34 +
  • 2.4 Tridiagonal and Band Diagonal Systems of Equations 42 +
  • 2.5 Iterative Improvement of a Solution to Linear Equations 47 +
  • 2.6 Singular Value Decomposition 51 +
  • 2.7 Sparse Linear Systems 63 +
  • 2.8 Vandermonde Matrices and Toeplitz Matrices 82 +
  • 2.9 Cholesky Decomposition 89 +
  • 2.10 QR Decomposition 91 +
  • 2.11 Is Matrix Inversion an $N^3$ Process? 95 +
    •  + +

    3 Interpolation and Extrapolation

    + +
  • 3.0 Introduction 99 +
  • 3.1 Polynomial Interpolation and Extrapolation 102 +
  • 3.2 Rational Function Interpolation and Extrapolation 104 +
  • 3.3 Cubic Spline Interpolation 107 +
  • 3.4 How to Search an Ordered Table 110 +
  • 3.5 Coefficients of the Interpolating Polynomial 113 +
  • 3.6 Interpolation in Two or More Dimensions 116 +
    •  + +

    4 Integration of Functions

    + +
  • 4.0 Introduction 123 +
  • 4.1 Classical Formulas for Equally Spaced Abscissas 124 +
  • 4.2 Elementary Algorithms 130 +
  • 4.3 Romberg Integration 134 +
  • 4.4 Improper Integrals 135 +
  • 4.5 Gaussian Quadratures and Orthogonal Polynomials 140 +
  • 4.6 Multidimensional Integrals 155 +
    •  + +

    5 Evaluation of Functions

    + +
  • 5.0 Introduction 159 +
  • 5.1 Series and Their Convergence 159 +
  • 5.2 Evaluation of Continued Fractions 163 +
  • 5.3 Polynomials and Rational Functions 167 +
  • 5.4 Complex Arithmetic 171 +
  • 5.5 Recurrence Relations and Clenshaw's Recurrence Formula 172 +
  • 5.6 Quadratic and Cubic Equations 178 +
  • 5.7 Numerical Derivatives 180 +
  • 5.8 Chebyshev Approximation 184 +
  • 5.9 Derivatives or Integrals of a Chebyshev-approximated +Function 189 +
  • 5.10 Polynomial Approximation from Chebyshev Coefficients 191 +
  • 5.11 Economization of Power Series 192 +
  • 5.12 Pad\'e Approximants 194 +
  • 5.13 Rational Chebyshev Approximation 197 +
  • 5.14 Evaluation of Functions by Path Integration 201 +
    •  + +

    6 Special Functions

    + +
  • 6.0 Introduction 205 +
  • 6.1 Gamma Function, Beta Function, Factorials, Binomial +Coefficients 206 +
  • 6.2 Incomplete Gamma Function, Error Function, Chi-Square +Probability +Function, Cumulative Poisson Function 209 +
  • 6.3 Exponential Integrals 215 +
  • 6.4 Incomplete Beta Function, Student's Distribution, +F-Distribution,Cumulative Binomial Distribution 219 +
  • 6.5 Bessel Functions of Integer Order 223 +
  • 6.6 Modified Bessel Functions of Integer Order 229 +
  • 6.7 Bessel Functions of Fractional Order, Airy Functions, +SphericalBessel Functions 234 +
  • 6.8 Spherical Harmonics 246 +
  • 6.9 Fresnel Integrals, Cosine and Sine Integrals 248 +
  • 6.10 Dawson's Integral 252 +
  • 6.11 Elliptic Integrals and Jacobian Elliptic Functions 254 +
  • 6.12 Hypergeometric Functions 263 +
    •  + +

    7 Random Numbers

    + +
  • 7.0 Introduction 266 +
  • 7.1 Uniform Deviates 267 +
  • 7.2 Transformation Method: Exponential and Normal Deviates 277 +
  • 7.3 Rejection Method: Gamma, Poisson, Binomial Deviates 281 +
  • 7.4 Generation of Random Bits 287 +
  • 7.5 Random Sequences Based on Data Encryption 290 +
  • 7.6 Simple Monte Carlo Integration 295 +
  • 7.7 Quasi- (that is, Sub-) Random Sequences 299 +
  • 7.8 Adaptive and Recursive Monte Carlo Methods 306 +
    •  + +

    8 Sorting

    + +
  • 8.0 Introduction 320 +
  • 8.1 Straight Insertion and Shell's Method 321 +
  • 8.2 Quicksort 323 +
  • 8.3 Heapsort 327 +
  • 8.4 Indexing and Ranking 329 +
  • 8.5 Selecting the $M$th Largest 333 +
  • 8.6 Determination of Equivalence Classes 337 +
    •  + +

    9 Root Finding and Nonlinear Sets of Equations

    + +
  • 9.0 Introduction 340 +
  • 9.1 Bracketing and Bisection 343 +
  • 9.2 Secant Method, False Position Method, and Ridders' Method 347 +
  • 9.3 Van Wijngaarden--Dekker--Brent Method 352 +
  • 9.4 Newton-Raphson Method Using Derivative 355 +
  • 9.5 Roots of Polynomials 362 +
  • 9.6 Newton-Raphson Method for Nonlinear Systems of Equations 372 +
  • 9.7 Globally Convergent Methods for Nonlinear Systems of +Equations 376 +
    •  + +

    10 Minimization or Maximization of Functions

    + +
  • 10.0 Introduction 387 +
  • 10.1 Golden Section Search in One Dimension 390 +
  • 10.2 Parabolic Interpolation and Brent's Method in One Dimension 395 +
  • 10.3 One-Dimensional Search with First Derivatives 399 +
  • 10.4 Downhill Simplex Method in Multidimensions 402 +
  • 10.5 Direction Set (Powell's) Methods in Multidimensions 406 +
  • 10.6 Conjugate Gradient Methods in Multidimensions 413 +
  • 10.7 Variable Metric Methods in Multidimensions 418 +
  • 10.8 Linear Programming and the Simplex Method 423 +
  • 10.9 Simulated Annealing Methods 436 +
    •  + +

    11 Eigensystems

    + +
  • 11.0 Introduction 449 +
  • 11.1 Jacobi Transformations of a Symmetric Matrix 456 +
  • 11.2 Reduction of a Symmetric Matrix to Tridiagonal Form: +Givens and Householder Reductions 462 +
  • 11.3 Eigenvalues and Eigenvectors of a Tridiagonal Matrix 469 +
  • 11.4 Hermitian Matrices 475 +
  • 11.5 Reduction of a General Matrix to Hessenberg Form 476 +
  • 11.6 The QR Algorithm for Real Hessenberg Matrices 480 +
  • 11.7 Improving Eigenvalues and/or Finding Eigenvectors by +Inverse Iteration 487 +
    •  + +

    12 Fast Fourier Transform

    + +
  • 12.0 Introduction 490 +
  • 12.1 Fourier Transform of Discretely Sampled Data 494 +
  • 12.2 Fast Fourier Transform (FFT) 498 +
  • 12.3 FFT of Real Functions, Sine and Cosine Transforms 504 +
  • 12.4 FFT in Two or More Dimensions 515 +
  • 12.5 Fourier Transforms of Real Data in Two and Three Dimensions 519 +
  • 12.6 External Storage or Memory-Local FFTs 525 +
    •  + +

    13 Fourier and Spectral Applications

    + +
  • 13.0 Introduction 530 +
  • 13.1 Convolution and Deconvolution Using the FFT 531 +
  • 13.2 Correlation and Autocorrelation Using the FFT 538 +
  • 13.3 Optimal (Wiener) Filtering with the FFT 539 +
  • 13.4 Power Spectrum Estimation Using the FFT 542 +
  • 13.5 Digital Filtering in the Time Domain 551 +
  • 13.6 Linear Prediction and Linear Predictive Coding 557 +
  • 13.7 Power Spectrum Estimation by the Maximum Entropy +(All Poles) Method 565 +
  • 13.8 Spectral Analysis of Unevenly Sampled Data 569 +
  • 13.9 Computing Fourier Integrals Using the FFT 577 +
  • 13.10 Wavelet Transforms 584 +
  • 13.11 Numerical Use of the Sampling Theorem 600 +
    •  + +

    14 Statistical Description of Data

    + +
  • 14.0 Introduction 603 +
  • 14.1 Moments of a Distribution: Mean, Variance, Skewness, +and So Forth 604 +
  • 14.2 Do Two Distributions Have the Same Means or Variances? 609 +
  • 14.3 Are Two Distributions Different? 614 +
  • 14.4 Contingency Table Analysis of Two Distributions 622 +
  • 14.5 Linear Correlation 630 +
  • 14.6 Nonparametric or Rank Correlation 633 +
  • 14.7 Do Two-Dimensional Distributions Differ? 640 +
  • 14.8 Savitzky-Golay Smoothing Filters 644 +
    •  + +

    15 Modeling of Data

    + +
  • 15.0 Introduction 650 +
  • 15.1 Least Squares as a Maximum Likelihood Estimator 651 +
  • 15.2 Fitting Data to a Straight Line 655 +
  • 15.3 Straight-Line Data with Errors in Both Coordinates 660 +
  • 15.4 General Linear Least Squares 665 +
  • 15.5 Nonlinear Models 675 +
  • 15.6 Confidence Limits on Estimated Model Parameters 684 +
  • 15.7 Robust Estimation 694 +
    •  + +

    16 Integration of Ordinary Differential Equations

    + +
  • 16.0 Introduction 701 +
  • 16.1 Runge-Kutta Method 704 +
  • 16.2 Adaptive Stepsize Control for Runge-Kutta 708 +
  • 16.3 Modified Midpoint Method 716 +
  • 16.4 Richardson Extrapolation and the Bulirsch-Stoer Method 718 +
  • 16.5 Second-Order Conservative Equations 726 +
  • 16.6 Stiff Sets of Equations 727 +
  • 16.7 Multistep, Multivalue, and Predictor-Corrector Methods 740 +
    •  + +

    17 Two Point Boundary Value Problems

    + +
  • 17.0 Introduction 745 +
  • 17.1 The Shooting Method 749 +
  • 17.2 Shooting to a Fitting Point 751 +
  • 17.3 Relaxation Methods 753 +
  • 17.4 A Worked Example: Spheroidal Harmonics 764 +
  • 17.5 Automated Allocation of Mesh Points 774 +
  • 17.6 Handling Internal Boundary Conditions or Singular Points 775 +
    •  + +

    18 Integral Equations and Inverse Theory

    + +
  • 18.0 Introduction 779 +
  • 18.1 Fredholm Equations of the Second Kind 782 +
  • 18.2 Volterra Equations 786 +
  • 18.3 Integral Equations with Singular Kernels 788 +
  • 18.4 Inverse Problems and the Use of A Priori Information 795 +
  • 18.5 Linear Regularization Methods 799 +
  • 18.6 Backus-Gilbert Method 806 +
  • 18.7 Maximum Entropy Image Restoration 809 +
    •  + +

    19 Partial Differential Equations

    + +
  • 19.0 Introduction 818 +
  • 19.1 Flux-Conservative Initial Value Problems 825 +
  • 19.2 Diffusive Initial Value Problems 838 +
  • 19.3 Initial Value Problems in Multidimensions 844 +
  • 19.4 Fourier and Cyclic Reduction Methods for Boundary +Value Problems 848 +
  • 19.5 Relaxation Methods for Boundary Value Problems 854 +
  • 19.6 Multigrid Methods for Boundary Value Problems 862 +
    •  + +

    20 Less-Numerical Algorithms

    + +
  • 20.0 Introduction 881 +
  • 20.1 Diagnosing Machine Parameters 881 +
  • 20.2 Gray Codes 886 +
  • 20.3 Cyclic Redundancy and Other Checksums 888 +
  • 20.4 Huffman Coding and Compression of Data 896 +
  • 20.5 Arithmetic Coding 902 +
  • 20.6 Arithmetic at Arbitrary Precision 906 +
    •  + + +
  • References 916 +
  • Index of Programs and Dependencies 921 +
  • General Index 935 +
    •  + + diff --git a/lib/nr/ansi/wincmpl.htm b/lib/nr/ansi/wincmpl.htm new file mode 100644 index 0000000..f238aa9 --- /dev/null +++ b/lib/nr/ansi/wincmpl.htm @@ -0,0 +1,544 @@ +Windows Compiler Notes + +

    Notes on Using Numerical Recipes in C
    with +Various Windows Compilers

    + + + +
    +
+USING THE NUMERICAL RECIPES IN C WITH THE BORLAND 
+C++ BUILDER VISUAL ENVIRONMENT
+
+Let's assume that you have installed the C Recipes in
+a directory that we will refer to symbolically as CDIR.
+Typically CDIR will be something like "C:\numrec\c.210\ansi",
+and this directory will contain the subdirectories
+"recipes", "examples", "other" and "data".  In the instructions
+below, you will need to substitute you actual installation
+directory path wherever we have written CDIR.
+
+We consider the case in which you are going to write a 
+program than uses the Numerical Recipe named svdcmp.c.  
+In this example, we use the Numerical Recipes Example Routine
+named xsvdcmp.c as our program, since it is a typical
+program making use of svdcmp.c.  This program may be found
+in the "examples" subdirectory of the installation directory.
+
+There are several ways in which to use your compiler to
+prepare an executable program.  We are just detailing one of 
+the possibilities, one that we have found convenient.
+
+1. First, create a working directory named "xsvdcmp" as
+a subdirectory of CDIR.  (You may name the subdirectory
+anything you like and locate it in some other place.
+However, we have chosen the name xsvdcmp because 
+that is the name of the program we will prepare, and we have
+chosen the CDIR location to keep the pathnames short in
+our example.)
+
+2. Into this working directory, copy the files that will
+be necessary for the project.  These files include:
+
+CDIR\examples\xsvdcmp.c
+CDIR\recipes\svdcmp.c
+CDIR\recipes\pythag.c
+CDIR\other\nrutil.c
+CDIR\data\matrx3.dat
+
+Routine xsvdcmp.c is the main program.  It calls svdcmp(),
+which, in turn, makes calls to pythag().  The file nrutil.c is a
+file of Numerical Recipes utility functions that are used by
+many of the Recipes and Example Programs. The data file 
+matrx3.dat is a file containing  test matrices, and is 
+used by xsvdcmp.c as a source of input data.
+
+(Note that it is not actually essential that the source files 
+xsvdcmp.c, svdcmp.c, pythag.c and nrutil.cbe copied into
+a working directory.  They could be compiled in their
+original location.  However, in some cases you will want
+to modify the Numerical Recipes codes to suit your own
+applications, and collecting the codes into a working
+directory is a way of ensuring that the changes you make
+do not affect any of your other projects.)
+
+3. Start up the C++ Builder visual programming environment.
+
+4. Make the menu selection "File/New.../Console Wizard".  
+Our notation here is meant to indicate that you click on the
+"File" menu item, then select "New..." from the drop-down
+list, and finally select "Console Wizard" from the panel of
+options that appears.
+
+In the "Console Wizard" setup box, select:
+	Window Type: Console
+	Execution Type: EXE
+Then click on "Finish".
+
+5. This will produce a project window with a generic program
+name something like  "Project1.c".  We will next name our 
+project "p_xsvdcmp" and generate a program named 
+"p_svdcmp.cpp" by the following procedure:
+
+6. Make the menu selection "File/Save Project As ..."
+
+Use the file-selection dialogue box that comes up to navigate the the 
+directory CDIR\xsvdcmp\ and save the project as "p_svdcmp.bpr".  
+(Again, you could name it anything you like, but stay with this for 
+now.)  The program window will now have the title p_svdcmp.cpp, 
+and will have contents something like this:
+
+
+	#pragma hdrstop
+	#include 
+
+	//---------------------------------------
+	#pragma argsused
+	int main(int argc, char* argv[])
+	{
+	        return 0;
+	}
+ 
+
+This bit of code framework is provided compliments of the
+vendor.  It can be turned into a workable C program by filling
+in the routine "main()" with whatever programming instructions
+you want to carry out.  Presumably, one of these instructions will
+involve a call to the routine svdcmp.c, since that is the point
+of this exercise.
+
+7. In the present case, for example, we could judiciously copy
+the contents of the program xsvdcmp.c into this file, putting
+the "include" statements near the top and the function "main()" 
+of xsvdcmp.c in place of the one-line "main()" routine that has 
+been automatically provided.  This, however, leaves some 
+Borland-specific statements (particularly, the one about 
+"condefs.h") in the program, and makes it less portable.  We 
+generally try to isolate  vendor-specific code into a separate 
+file, and the following steps show how to do that.
+
+8. Erase the code that has been provided, and replace it with 
+the two statements:
+
+	#include 
+	#define main
+
+9. Add the necessary files to your project, using the menu 
+selection "Project/Add to Project" to navigate to and select 
+each of the source code files that has been copied into the 
+working directory:
+
+	CDIR\xsvdcmp\xsvdcmp.c
+	CDIR\xsvdcmp\svdcmp.c
+	CDIR\xsvdcmp\pythag.c
+	CDIR\xsvdcmp\nrutil.c
+
+10. Your main project source code p_svdcmp.cpp will then 
+read:
+
+	#include 
+	USEUNIT("xsvdcmp.c");
+	USEUNIT("svdcmp.c");
+	USEUNIT("pythag.c");
+	USEUNIT("nrutil.c");
+	#define main
+
+11.  There is one more issue.  Program xsvdcmp.c has 
+include-statements that will try to include "nr.h" and
+"nrutil.h", which it will look for in the working directory 
+"CDIR\xsvdcmp".  The actual location of these files is the 
+"other" subdirectory of the Numerical Recipes installation
+directory. There are at least two solutions to this problem:
+
+     a. Use the menu selection "Project/Options/
+     Directories/Conditionals", and add the text "..\other;" 
+     to the beginning of the include path.
+
+     OR
+
+     b. Create a file named "nr.h" in the working directory,
+     and in this file place the single line:  #include "..\other\nr.h".
+     Do the same for "nrutil.h".  Then when you include these 
+     files, they will in turn include the corresponding files in the 
+     "CDIR\other" directory.
+
+The virtue of either method is that your installation will have 
+only single bona-fide "nr.h" and "nrutil.h" files (the ones in the 
+"CDIR\other" directory), rather than having copies in multiple 
+locations.  Therefore, if you ever want to upgrade to a new 
+version, or make a correction to this file, you only need to 
+edit a single file.  
+
+12. Now it is time to compile.  Just choose the menu selection
+"Project/Build p_svdcmp", wait for all the compilation and 
+linking to take place.  If there are any error messages 
+(other than innocuous compiler warnings), you will need to do 
+some debugging.
+
+13. You may now run the program with the menu selection 
+"Run/Run", and witness the program output in the console 
+window that appears. 
+
+14. There is one final wrinkle.  The "xsvdcmp.c" program 
+reads in several matrices, one-by-one, and pauses between 
+each case so that you can see the output.  Some of the 
+Numerical Recipes Example Routines, on the other hand, 
+have the property that they just do a calculation, print some 
+output, and then terminate.  
+
+Unfortunately, under Borland C++ Builder, the completion 
+of a console application causes the console window to 
+close immediately, with the result that you get only a brief 
+glimpse at the data you have  computed.
+
+The solution to this problem is to create a file named 
+nrexit.c with the following contents:
+
+	#include 
+	using namespace std;
+
+	// Function used to stall exit in Borland C++ Builder
+
+	void nrexit(void)
+	{
+	        cin.get();
+	        return;
+	}
+
+	#pragma exit nrexit
+
+If you add this source file to your project along with the main
+routine and recipes, then you will find that upon completing your 
+program, the system will leave the console window open until 
+you press a key on the keyboard.
+
+
+USING THE NUMERICAL RECIPES IN C WITH BORLAND 
+C++ BUILDER FROM A DOS COMMAND LINE
+
+It is also possible use the Borland C++ Builder compiler to 
+compile and link Numerical Recipes programs from a DOS 
+command line.  In doing so, you give up the great advantages 
+of the integrated visual programming environment.  However, 
+you gain the ability to embed your compilation instructions into 
+scripts or makefiles.
+
+As above, we assume that the C Recipes are installed in a
+directory that we shall refer to symbolically as CDIR.  In this 
+directory there are subdirectories "recipes" containing the 
+Numerical Recipes, "examples" containing the Numerical 
+Recipes Example Routines, "other" containing the utility 
+routines, and "data" containing data files for testing.  In all 
+of the instructions below, you will need to change the symbol 
+CDIR to the actual path of this installation directory.
+
+We consider the case that you are going to write a 
+program than uses the Numerical Recipe named svdcmp.c.  
+In this example, we use the Numerical Recipes Example Routine
+named xsvdcmp.c as our program, since it is a typical
+program making use of svdcmp.c.  This program may be found
+in the "examples" subdirectory of CDIR.
+
+1. First, create a working directory named "xsvdcmp" as a 
+subdirectory of CDIR
+
+> mkdir xsvdcmp
+
+2. Move into this subdirectory
+
+> cd xsvdcmp
+
+3. Move the necessary files into the working directory
+
+> copy ..\examples\xsvdcmp.c
+> copy ..\recipes\svdcmp.c
+> copy ..\recipes\pythag.c
+> copy ..\other\nrutil.c
+> copy ..\data\matrx3.dat
+
+Routine xsvdcmp.c is the main program.  It calls svdcmp(),
+which, in turn, makes calls to pythag().  The file nrutil.c is a
+file of Numerical Recipes utility functions that are used by
+many of the Recipes and Example Programs.  The data file 
+matrx3.dat is a file containing  test matrices, and is used by
+xsvdcmp.c as a source of input data.
+
+4. The header files "nr.h" and "nrutil.h" are also needed.  
+
+You could copy these from the directory "CDIR\other".  We 
+suggest instead that you create a file named "nr.h" and put
+in this file the single line
+
+#include "..\other\nr.h"
+
+Do a similar thing for "nrutil.h".  Then when you include these 
+files, they will in turn include the corresponding files in the 
+"CDIR\other" directory.
+
+The virtue of this method is that your installation will have only one
+bona-fide include file (the one in the "other" directory), rather than 
+having copies in multiple locations.  Therefore, if you ever want
+to upgrade to new versions, or to make corrections, you only
+need to modify the master file.  
+
+5. Next, compile each of the source files, producing a corresponding
+object file .obj for each one:
+
+> bcc32 -c -w- -Od xsvdcmp.c
+> bcc32 -c -w- -Od svdcmp.c
+> bcc32 -c -w- -Od pythag.c
+> bcc32 -c -2- -Od nrutil.c
+
+The first of these commands, for example, compiles the source
+file xsvdcmp.c and produces the object file xsvdcmp.obj.
+
+6. Then link all of the object files to produce an executable 
+named "xsvdcmp.exe".
+
+> ILINK32 /ap /w- /x /C xsvdcmp.obj svdcmp.obj pythag.obj nrutil.obj
+     c0x32.obj cw32.lib import32.lib
+
+(This command should be a single line.)
+
+The first four object files on this line are object files
+produced in the previous step.  The following object file and
+libraries are compiler-related and should just be
+added routinely to your link commands.
+
+7. Following the linking operation, you may run the executable:
+
+> xsvdcmp
+
+
+
+USING THE NUMERICAL RECIPES IN C WITH THE 
+MICROSOFT VISUAL C++ DEVELOPMENT ENVIRONMENT
+
+Let's assume that the C Recipes have been installed in a
+directory that we shall refer to symbolically as CDIR.  In this 
+directory there are subdirectories "recipes" containing the 
+Numerical Recipes, "examples" containing the Numerical 
+Recipes Example Routines, "other" containing the utilities, 
+and "data" containing data files for testing.  You will need to 
+change any references to the symbol CDIR below to the actual 
+name of the directory in which these subdirectories are located.
+
+We shall consider the case that you are going to write a 
+program than uses the Numerical Recipe named svdcmp.c.  
+In this example, we use the Numerical Recipes Example Routine
+named xsvdcmp.c as our program, since it is a typical
+program making use of svdcmp.c.  This program may be found
+in the "examples" subdirectory of CDIR.
+
+There are several ways in which to use your compiler to
+prepare the executable program. We are just detailing one of 
+the possibilities, one that we have found convenient.
+
+1. First, create a working directory named "xsvdcmp" as
+a subdirectory of CDIR. ( You may name the subdirectory
+anything you like and locate it in some other place. 
+However, we have chosen the name xsvdcmp because 
+that is the name of the program we will prepare, and we have
+chosen the CDIR location to keep the pathnames short in
+our example.)
+
+2. Into this working directory, copy the files that will
+be necessary for the project.  These files include:
+
+CDIR\examples\xsvdcmp.c
+CDIR\sources\svdcmp.c
+CDIR\sources\pythag.c
+CDIR\other\nrutil.c
+CDIR\data\matrx3.dat
+
+Routine xsvdcmp.c is the main program.  It calls svdcmp(),
+which, in turn, makes calls to pythag().  The data file 
+matrx3.dat is a file containing test matrices, and is  used 
+by xsvdcmp.c as a source of input data.
+
+(Note that it is not actually essential that the source
+files xsvdcmp.c, svdcmp.c and pythag.c be copied into
+a working directory.  They could be compiled in their
+original location.  However, in some cases you will want
+to modify the Numerical Recipes codes to suit your own
+applications, and collecting the codes into a working
+directory is a way of ensuring that the changes you make
+do not affect any of your other projects.)
+
+3. Start up the Visual C++ programming environment.
+
+4. Make the menu selection "File/New/Win32 Console Application"
+Our notation here is meant to indicate that you click on the "File" 
+menu item, then select "New..." from the drop-down list, and finally 
+select "Win32 Console Application" from the panel of options that 
+appears.  You will also need to fill in this information in the panel:
+
+	Project Name: xsvdcmp
+	Location: CDIR\xsvdcmp
+	"Create new workspace" should be checked
+
+In the "Location:" entry, you should replace the symbol CDIR by 
+the actual path name of the directory in which the xsvdcmp 
+subdirectory has been created.
+
+Click OK and you will then be asked "What kind of Console 
+Application?". The answer is "Empty Project"
+
+You will then be shown a summary of your choices. Click on OK.
+
+5. Next add the necessary source code files to your project.
+
+     Select "Project/Add to Project/Files"
+     Use file selector to select each of the souce code files 
+     in the working directory: xsvdcmp.c, svdcmp.c, 
+     pythag.c and nrutil.c
+
+6.   There is one more issue.  Program xsvdcmp.c has 
+include-statements that will try to include "nr.h" and
+"nrutil.h", which it will look for in the working directory 
+"CDIR\xsvdcmp".  The actual location of these files is the 
+"CDIR\other" subdirectory of the Numerical Recipes installation
+directory. There are at least two solutions to this problem:
+
+     a. Use the menu selection "Project/Settings/C-C++".
+     Under "Category", select "Preprocessor", and then in
+    the "Additional include directories" box, insert "..\other"
+
+     OR
+
+     b. Create a file named "nr.h" in the working directory,
+     and in this file place the single line:  #include "..\other\nr.h".
+     Do the same for "nrutil.h".
+
+The virtue of either method is that your installation will have 
+only single bona-fide "nr.h" and "nrutil.h" files (the ones in the 
+"CDIR\other" directory), rather than having copies in multiple 
+locations.  Therefore, if you ever want to upgrade to a new 
+version, or make a correction to this file, you only need to 
+edit a single file.  
+
+7. Then compile and link the program with the menu selection
+"Build/Build xsvdcmp.exe".  If there are any errors reported you
+will need to do some debugging. 
+
+8. Run the program by selecting "Build/Execute xsvdcmp.exe"
+from the menu.
+
+
+
+USING THE NUMERICAL RECIPES IN C WITH MICROSOFT 
+VISUAL C++ FROM A DOS COMMAND LINE
+
+It is also possible use the Microsoft Visual C++ compiler to 
+compile and link Numerical Recipes programs from a DOS 
+command line.  In doing so, you give up the great advantages 
+of the integrated visual programming environment.  However,
+you gain the ability to embed your compilation instructions into
+scripts or makefiles.
+
+As above, we assume that the C Recipes are installed in a
+directory that we shall refer to symbolically as CDIR.  In this 
+directory there are subdirectories "recipes" containing the 
+Numerical Recipes, "examples" containing the Numerical 
+Recipes Example Routines, "other" containing the utility routines,
+and "data" containing data files for testing.  In all of the instructions 
+below, you will need to change the symbol CDIR to the actual path 
+of this installation directory.
+
+We shall consider the case that you are going to write a 
+program than uses the Numerical Recipe named svdcmp.c.  
+In this example, we use the Numerical Recipes Example Routine
+named xsvdcmp.c as our program, since it is a typical
+program making use of svdcmp.c.  This program may be found
+in the "examples" subdirectory in the Numerical Recipes 
+installation.
+
+1. First, create a working directory named "xsvdcmp" as
+a subdirectory of CDIR
+
+> mkdir xsvdcmp
+
+2. Move into that subdirectory
+
+> cd xsvdcmp
+
+3. Move the necessary files into your working directory
+
+> copy ..\examples\xsvdcmp.c
+> copy ..\recipes\svdcmp.c
+> copy ..\recipes\pythag.c
+> copy ..\other\nrutil.c
+> copy ..\data\matrx3.dat
+
+Routine xsvdcmp.c is the main program.  It calls svdcmp,
+which, in turn, makes a call to pythag.  The file nrutil.c is a
+file of Numerical Recipes utility functions that are used by
+many of the Recipes and Example Programs.  The data 
+file matrx3.dat is a file containing test matrices, and is used 
+by xsvdcmp.c as a source of input data.
+
+4. The header files "nr.h" and "nrutil.h" are also needed.  
+You may copy them from the directory "CDIR\other".  We 
+suggest instead that you create a file named "nr.h" and in 
+this file put the single line
+
+#include "..\other\nr.h"
+
+Do the same for "nrutil.h". Then when you include these 
+files,  the will in turn include the corresponding files in the 
+"CDIR\other" directory.
+
+The virtue of either method is that your installation will have only
+single bona-fide include files "nr.h" and "nrutil.h" (the ones in 
+the "CDIR\other" directory), rather than having copies in 
+multiple locations.  Therefore, if you ever want to upgrade to 
+new versions, or to make corrections, you only need to modify 
+the master file.  
+
+5. Next, compile each of the source files, producing a 
+corresponding object file .obj for each one.
+
+> CL /c /w xsvdcmp.c
+> CL /c /w svdcmp.c
+> CL /c /w pythag.c
+> CL /c /w nrutil.c
+
+The compile command used here assumes that the 
+environment variables PATH and INCLUDE have been 
+properly set, so that the compiler, include files and libraries 
+can be found.  (When you install Visual C++, the setup 
+creates a batch file,  VCVARS32.BAT, containing 
+commands to modify the PATH,  LIB, and INCLUDE 
+environment variables. If these variables haven't been 
+set properly, run VCVARS32.BAT before you compile 
+at the command prompt. VCVARS32.BAT is located 
+in the \bin subdirectory of the Visual C++ installation. 
+
+6. Link all of the object files to produce an executable 
+named "xsvdcmp.exe".
+
+> LINK xsvdcmp.obj svdcmp.obj pythag.obj nrutil.obj
+
+(This command assumes that the LIB environment variable is
+properly defined.  See the note above about VCVARS32.BAT.)
+The four object files on this line are object files produced in 
+the previous step. If there are any error messages
+issued, then you will need to do some debugging before
+continuing.
+
+7. Following the linking operation, you may run the executable:
+
+> xsvdcmp
+
+We have described compiling and linking as a two-step
+operation.  In fact, it is common to do both in a single step.
+See your compiler manual for details.
+
+
    + + diff --git a/lib/nr/cpp/other/nr.h b/lib/nr/cpp/other/nr.h new file mode 100644 index 0000000..a25d91f --- /dev/null +++ b/lib/nr/cpp/other/nr.h @@ -0,0 +1,479 @@ +#ifndef _NR_H_ +#define _NR_H_ +#include +#include +#include "nrutil.h" +#include "nrtypes.h" +using namespace std; + +namespace NR { + +void addint(Mat_O_DP &uf, Mat_I_DP &uc, Mat_O_DP &res); +void airy(const DP x, DP &ai, DP &bi, DP &aip, DP &bip); +void amebsa(Mat_IO_DP &p, Vec_IO_DP &y, Vec_O_DP &pb, DP &yb, const DP ftol, + DP funk(Vec_I_DP &), int &iter, const DP temptr); +void amoeba(Mat_IO_DP &p, Vec_IO_DP &y, const DP ftol, DP funk(Vec_I_DP &), + int &nfunk); +DP amotry(Mat_IO_DP &p, Vec_O_DP &y, Vec_IO_DP &psum, DP funk(Vec_I_DP &), + const int ihi, const DP fac); +DP amotsa(Mat_IO_DP &p, Vec_O_DP &y, Vec_IO_DP &psum, Vec_O_DP &pb, DP &yb, + DP funk(Vec_I_DP &), const int ihi, DP &yhi, const DP fac); +void anneal(Vec_I_DP &x, Vec_I_DP &y, Vec_IO_INT &iorder); +DP anorm2(Mat_I_DP &a); +void arcmak(Vec_I_ULNG &nfreq, unsigned long nchh, unsigned long nradd, + arithcode &acode); +void arcode(unsigned long &ich, string &code, unsigned long &lcd, + const int isign, arithcode &acode); +void arcsum(Vec_I_ULNG &iin, Vec_O_ULNG &iout, unsigned long ja, + const int nwk, const unsigned long nrad, const unsigned long nc); +void asolve(Vec_I_DP &b, Vec_O_DP &x, const int itrnsp); +void atimes(Vec_I_DP &x, Vec_O_DP &r, const int itrnsp); +void avevar(Vec_I_DP &data, DP &ave, DP &var); +void balanc(Mat_IO_DP &a); +void banbks(Mat_I_DP &a, const int m1, const int m2, Mat_I_DP &al, + Vec_I_INT &indx, Vec_IO_DP &b); +void bandec(Mat_IO_DP &a, const int m1, const int m2, Mat_O_DP &al, + Vec_O_INT &indx, DP &d); +void banmul(Mat_I_DP &a, const int m1, const int m2, Vec_I_DP &x, + Vec_O_DP &b); +void bcucof(Vec_I_DP &y, Vec_I_DP &y1, Vec_I_DP &y2, Vec_I_DP &y12, + const DP d1, const DP d2, Mat_O_DP &c); +void bcuint(Vec_I_DP &y, Vec_I_DP &y1, Vec_I_DP &y2, Vec_I_DP &y12, + const DP x1l, const DP x1u, const DP x2l, const DP x2u, + const DP x1, const DP x2, DP &ansy, DP &ansy1, DP &ansy2); +void beschb(const DP x, DP &gam1, DP &gam2, DP &gampl, DP &gammi); +DP bessi(const int n, const DP x); +DP bessi0(const DP x); +DP bessi1(const DP x); +void bessik(const DP x, const DP xnu, DP &ri, DP &rk, DP &rip, DP &rkp); +DP bessj(const int n, const DP x); +DP bessj0(const DP x); +DP bessj1(const DP x); +void bessjy(const DP x, const DP xnu, DP &rj, DP &ry, DP &rjp, DP &ryp); +DP bessk(const int n, const DP x); +DP bessk0(const DP x); +DP bessk1(const DP x); +DP bessy(const int n, const DP x); +DP bessy0(const DP x); +DP bessy1(const DP x); +DP beta(const DP z, const DP w); +DP betacf(const DP a, const DP b, const DP x); +DP betai(const DP a, const DP b, const DP x); +DP bico(const int n, const int k); +void bksub(const int ne, const int nb, const int jf, const int k1, + const int k2, Mat3D_IO_DP &c); +DP bnldev(const DP pp, const int n, int &idum); +DP brent(const DP ax, const DP bx, const DP cx, DP f(const DP), + const DP tol, DP &xmin); +void broydn(Vec_IO_DP &x, bool &check, void vecfunc(Vec_I_DP &, Vec_O_DP &)); +void bsstep(Vec_IO_DP &y, Vec_IO_DP &dydx, DP &xx, const DP htry, + const DP eps, Vec_I_DP &yscal, DP &hdid, DP &hnext, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &)); +void caldat(const int julian, int &mm, int &id, int &iyyy); +void chder(const DP a, const DP b, Vec_I_DP &c, Vec_O_DP &cder, const int n); +DP chebev(const DP a, const DP b, Vec_I_DP &c, const int m, const DP x); +void chebft(const DP a, const DP b, Vec_O_DP &c, DP func(const DP)); +void chebpc(Vec_I_DP &c, Vec_O_DP &d); +void chint(const DP a, const DP b, Vec_I_DP &c, Vec_O_DP &cint, const int n); +DP chixy(const DP bang); +void choldc(Mat_IO_DP &a, Vec_O_DP &p); +void cholsl(Mat_I_DP &a, Vec_I_DP &p, Vec_I_DP &b, Vec_O_DP &x); +void chsone(Vec_I_DP &bins, Vec_I_DP &ebins, const int knstrn, DP &df, + DP &chsq, DP &prob); +void chstwo(Vec_I_DP &bins1, Vec_I_DP &bins2, const int knstrn, DP &df, + DP &chsq, DP &prob); +void cisi(const DP x, complex &cs); +void cntab1(Mat_I_INT &nn, DP &chisq, DP &df, DP &prob, DP &cramrv, DP &ccc); +void cntab2(Mat_I_INT &nn, DP &h, DP &hx, DP &hy, DP &hygx, DP &hxgy, + DP &uygx, DP &uxgy, DP &uxy); +void convlv(Vec_I_DP &data, Vec_I_DP &respns, const int isign, + Vec_O_DP &ans); +void copy(Mat_O_DP &aout, Mat_I_DP &ain); +void correl(Vec_I_DP &data1, Vec_I_DP &data2, Vec_O_DP &ans); +void cosft1(Vec_IO_DP &y); +void cosft2(Vec_IO_DP &y, const int isign); +void covsrt(Mat_IO_DP &covar, Vec_I_BOOL &ia, const int mfit); +void crank(Vec_IO_DP &w, DP &s); +void cyclic(Vec_I_DP &a, Vec_I_DP &b, Vec_I_DP &c, const DP alpha, + const DP beta, Vec_I_DP &r, Vec_O_DP &x); +void daub4(Vec_IO_DP &a, const int n, const int isign); +DP dawson(const DP x); +DP dbrent(const DP ax, const DP bx, const DP cx, DP f(const DP), + DP df(const DP), const DP tol, DP &xmin); +void ddpoly(Vec_I_DP &c, const DP x, Vec_O_DP &pd); +bool decchk(string str, char &ch); +void derivs_s(const DP x, Vec_I_DP &y, Vec_O_DP &dydx); +DP df1dim(const DP x); +void dfpmin(Vec_IO_DP &p, const DP gtol, int &iter, DP &fret, + DP func(Vec_I_DP &), void dfunc(Vec_I_DP &, Vec_O_DP &)); +DP dfridr(DP func(const DP), const DP x, const DP h, DP &err); +void dftcor(const DP w, const DP delta, const DP a, const DP b, + Vec_I_DP &endpts, DP &corre, DP &corim, DP &corfac); +void dftint(DP func(const DP), const DP a, const DP b, const DP w, + DP &cosint, DP &sinint); +void difeq(const int k, const int k1, const int k2, const int jsf, + const int is1, const int isf, Vec_I_INT &indexv, Mat_O_DP &s, + Mat_I_DP &y); +void dlinmin(Vec_IO_DP &p, Vec_IO_DP &xi, DP &fret, DP func(Vec_I_DP &), + void dfunc(Vec_I_DP &, Vec_O_DP &)); +void eclass(Vec_O_INT &nf, Vec_I_INT &lista, Vec_I_INT &listb); +void eclazz(Vec_O_INT &nf, bool equiv(const int, const int)); +DP ei(const DP x); +void eigsrt(Vec_IO_DP &d, Mat_IO_DP &v); +DP elle(const DP phi, const DP ak); +DP ellf(const DP phi, const DP ak); +DP ellpi(const DP phi, const DP en, const DP ak); +void elmhes(Mat_IO_DP &a); +DP erfcc(const DP x); +DP erff(const DP x); +DP erffc(const DP x); +void eulsum(DP &sum, const DP term, const int jterm, Vec_IO_DP &wksp); +DP evlmem(const DP fdt, Vec_I_DP &d, const DP xms); +DP expdev(int &idum); +DP expint(const int n, const DP x); +DP f1dim(const DP x); +DP factln(const int n); +DP factrl(const int n); +void fasper(Vec_I_DP &x, Vec_I_DP &y, const DP ofac, const DP hifac, + Vec_O_DP &wk1, Vec_O_DP &wk2, int &nout, int &jmax, DP &prob); +void fdjac(Vec_IO_DP &x, Vec_I_DP &fvec, Mat_O_DP &df, + void vecfunc(Vec_I_DP &, Vec_O_DP &)); +void fgauss(const DP x, Vec_I_DP &a, DP &y, Vec_O_DP &dyda); +void fit(Vec_I_DP &x, Vec_I_DP &y, Vec_I_DP &sig, const bool mwt, DP &a, + DP &b, DP &siga, DP &sigb, DP &chi2, DP &q); +void fitexy(Vec_I_DP &x, Vec_I_DP &y, Vec_I_DP &sigx, Vec_I_DP &sigy, + DP &a, DP &b, DP &siga, DP &sigb, DP &chi2, DP &q); +void fixrts(Vec_IO_DP &d); +void fleg(const DP x, Vec_O_DP &pl); +void flmoon(const int n, const int nph, int &jd, DP &frac); +DP fmin(Vec_I_DP &x); +void four1(Vec_IO_DP &data, const int isign); +void fourew(Vec_FSTREAM_p &file, int &na, int &nb, int &nc, int &nd); +void fourfs(Vec_FSTREAM_p &file, Vec_I_INT &nn, const int isign); +void fourn(Vec_IO_DP &data, Vec_I_INT &nn, const int isign); +void fpoly(const DP x, Vec_O_DP &p); +void fred2(const DP a, const DP b, Vec_O_DP &t, Vec_O_DP &f, Vec_O_DP &w, + DP g(const DP), DP ak(const DP, const DP)); +DP fredin(const DP x, const DP a, const DP b, Vec_I_DP &t, Vec_I_DP &f, + Vec_I_DP &w, DP g(const DP), DP ak(const DP, const DP)); +void frenel(const DP x, complex &cs); +void frprmn(Vec_IO_DP &p, const DP ftol, int &iter, DP &fret, + DP func(Vec_I_DP &), void dfunc(Vec_I_DP &, Vec_O_DP &)); +void ftest(Vec_I_DP &data1, Vec_I_DP &data2, DP &f, DP &prob); +DP gamdev(const int ia, int &idum); +DP gammln(const DP xx); +DP gammp(const DP a, const DP x); +DP gammq(const DP a, const DP x); +DP gasdev(int &idum); +void gaucof(Vec_IO_DP &a, Vec_IO_DP &b, const DP amu0, Vec_O_DP &x, + Vec_O_DP &w); +void gauher(Vec_O_DP &x, Vec_O_DP &w); +void gaujac(Vec_O_DP &x, Vec_O_DP &w, const DP alf, const DP bet); +void gaulag(Vec_O_DP &x, Vec_O_DP &w, const DP alf); +void gauleg(const DP x1, const DP x2, Vec_O_DP &x, Vec_O_DP &w); +void gaussj(Mat_IO_DP &a, Mat_IO_DP &b); +void gcf(DP &gammcf, const DP a, const DP x, DP &gln); +DP golden(const DP ax, const DP bx, const DP cx, DP f(const DP), + const DP tol, DP &xmin); +void gser(DP &gamser, const DP a, const DP x, DP &gln); +void hpsel(Vec_I_DP &arr, Vec_O_DP &heap); +void hpsort(Vec_IO_DP &ra); +void hqr(Mat_IO_DP &a, Vec_O_CPLX_DP &wri); +void hufapp(Vec_IO_ULNG &index, Vec_I_ULNG &nprob, const unsigned long n, + const unsigned long m); +void hufdec(unsigned long &ich, string &code, const unsigned long lcode, + unsigned long &nb, huffcode &hcode); +void hufenc(const unsigned long ich, string &code, unsigned long &nb, + huffcode &hcode); +void hufmak(Vec_I_ULNG &nfreq, const unsigned long nchin, + unsigned long &ilong, unsigned long &nlong, huffcode &hcode); +void hunt(Vec_I_DP &xx, const DP x, int &jlo); +void hypdrv(const DP s, Vec_I_DP &yy, Vec_O_DP &dyyds); +complex hypgeo(const complex &a, const complex &b, + const complex &c, const complex &z); +void hypser(const complex &a, const complex &b, + const complex &c, const complex &z, + complex &series, complex &deriv); +unsigned short icrc(const unsigned short crc, const string &bufptr, + const short jinit, const int jrev); +unsigned short icrc1(const unsigned short crc, const unsigned char onech); +unsigned long igray(const unsigned long n, const int is); +void indexx(Vec_I_DP &arr, Vec_O_INT &indx); +void indexx(Vec_I_INT &arr, Vec_O_INT &indx); +void interp(Mat_O_DP &uf, Mat_I_DP &uc); +int irbit1(unsigned long &iseed); +int irbit2(unsigned long &iseed); +void jacobi(Mat_IO_DP &a, Vec_O_DP &d, Mat_O_DP &v, int &nrot); +void jacobn_s(const DP x, Vec_I_DP &y, Vec_O_DP &dfdx, Mat_O_DP &dfdy); +int julday(const int mm, const int id, const int iyyy); +void kendl1(Vec_I_DP &data1, Vec_I_DP &data2, DP &tau, DP &z, DP &prob); +void kendl2(Mat_I_DP &tab, DP &tau, DP &z, DP &prob); +void kermom(Vec_O_DP &w, const DP y); +void ks2d1s(Vec_I_DP &x1, Vec_I_DP &y1, void quadvl(const DP, const DP, + DP &, DP &, DP &, DP &), DP &d1, DP &prob); +void ks2d2s(Vec_I_DP &x1, Vec_I_DP &y1, Vec_I_DP &x2, Vec_I_DP &y2, DP &d, + DP &prob); +void ksone(Vec_IO_DP &data, DP func(const DP), DP &d, DP &prob); +void kstwo(Vec_IO_DP &data1, Vec_IO_DP &data2, DP &d, DP &prob); +void laguer(Vec_I_CPLX_DP &a, complex &x, int &its); +void lfit(Vec_I_DP &x, Vec_I_DP &y, Vec_I_DP &sig, Vec_IO_DP &a, + Vec_I_BOOL &ia, Mat_O_DP &covar, DP &chisq, + void funcs(const DP, Vec_O_DP &)); +void linbcg(Vec_I_DP &b, Vec_IO_DP &x, const int itol, const DP tol, + const int itmax, int &iter, DP &err); +void linmin(Vec_IO_DP &p, Vec_IO_DP &xi, DP &fret, DP func(Vec_I_DP &)); +void lnsrch(Vec_I_DP &xold, const DP fold, Vec_I_DP &g, Vec_IO_DP &p, + Vec_O_DP &x, DP &f, const DP stpmax, bool &check, DP func(Vec_I_DP &)); +void locate(Vec_I_DP &xx, const DP x, int &j); +void lop(Mat_O_DP &out, Mat_I_DP &u); +void lubksb(Mat_I_DP &a, Vec_I_INT &indx, Vec_IO_DP &b); +void ludcmp(Mat_IO_DP &a, Vec_O_INT &indx, DP &d); +void machar(int &ibeta, int &it, int &irnd, int &ngrd, int &machep, + int &negep, int &iexp, int &minexp, int &maxexp, DP &eps, DP &epsneg, + DP &xmin, DP &xmax); +void matadd(Mat_I_DP &a, Mat_I_DP &b, Mat_O_DP &c); +void matsub(Mat_I_DP &a, Mat_I_DP &b, Mat_O_DP &c); +void medfit(Vec_I_DP &x, Vec_I_DP &y, DP &a, DP &b, DP &abdev); +void memcof(Vec_I_DP &data, DP &xms, Vec_O_DP &d); +bool metrop(const DP de, const DP t); +void mgfas(Mat_IO_DP &u, const int maxcyc); +void mglin(Mat_IO_DP &u, const int ncycle); +DP midexp(DP funk(const DP), const DP aa, const DP bb, const int n); +DP midinf(DP funk(const DP), const DP aa, const DP bb, const int n); +DP midpnt(DP func(const DP), const DP a, const DP b, const int n); +DP midsql(DP funk(const DP), const DP aa, const DP bb, const int n); +DP midsqu(DP funk(const DP), const DP aa, const DP bb, const int n); +void miser(DP func(Vec_I_DP &), Vec_I_DP ®n, const int npts, + const DP dith, DP &ave, DP &var); +void mmid(Vec_I_DP &y, Vec_I_DP &dydx, const DP xs, const DP htot, + const int nstep, Vec_O_DP &yout, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &)); +void mnbrak(DP &ax, DP &bx, DP &cx, DP &fa, DP &fb, DP &fc, + DP func(const DP)); +void mnewt(const int ntrial, Vec_IO_DP &x, const DP tolx, const DP tolf); +void moment(Vec_I_DP &data, DP &ave, DP &adev, DP &sdev, DP &var, DP &skew, + DP &curt); +void mp2dfr(Vec_IO_UCHR &a, string &s); +void mpadd(Vec_O_UCHR &w, Vec_I_UCHR &u, Vec_I_UCHR &v); +void mpdiv(Vec_O_UCHR &q, Vec_O_UCHR &r, Vec_I_UCHR &u, Vec_I_UCHR &v); +void mpinv(Vec_O_UCHR &u, Vec_I_UCHR &v); +void mplsh(Vec_IO_UCHR &u); +void mpmov(Vec_O_UCHR &u, Vec_I_UCHR &v); +void mpmul(Vec_O_UCHR &w, Vec_I_UCHR &u, Vec_I_UCHR &v); +void mpneg(Vec_IO_UCHR &u); +void mppi(const int np); +void mprove(Mat_I_DP &a, Mat_I_DP &alud, Vec_I_INT &indx, Vec_I_DP &b, + Vec_IO_DP &x); +void mpsad(Vec_O_UCHR &w, Vec_I_UCHR &u, const int iv); +void mpsdv(Vec_O_UCHR &w, Vec_I_UCHR &u, const int iv, int &ir); +void mpsmu(Vec_O_UCHR &w, Vec_I_UCHR &u, const int iv); +void mpsqrt(Vec_O_UCHR &w, Vec_O_UCHR &u, Vec_I_UCHR &v); +void mpsub(int &is, Vec_O_UCHR &w, Vec_I_UCHR &u, Vec_I_UCHR &v); +void mrqcof(Vec_I_DP &x, Vec_I_DP &y, Vec_I_DP &sig, Vec_I_DP &a, + Vec_I_BOOL &ia, Mat_O_DP &alpha, Vec_O_DP &beta, DP &chisq, + void funcs(const DP, Vec_I_DP &,DP &, Vec_O_DP &)); +void mrqmin(Vec_I_DP &x, Vec_I_DP &y, Vec_I_DP &sig, Vec_IO_DP &a, + Vec_I_BOOL &ia, Mat_O_DP &covar, Mat_O_DP &alpha, DP &chisq, + void funcs(const DP, Vec_I_DP &, DP &, Vec_O_DP &), DP &alamda); +void newt(Vec_IO_DP &x, bool &check, void vecfunc(Vec_I_DP &, Vec_O_DP &)); +void odeint(Vec_IO_DP &ystart, const DP x1, const DP x2, const DP eps, + const DP h1, const DP hmin, int &nok, int &nbad, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &), + void rkqs(Vec_IO_DP &, Vec_IO_DP &, DP &, const DP, const DP, + Vec_I_DP &, DP &, DP &, void (*)(const DP, Vec_I_DP &, Vec_O_DP &))); +void orthog(Vec_I_DP &anu, Vec_I_DP &alpha, Vec_I_DP &beta, Vec_O_DP &a, + Vec_O_DP &b); +void pade(Vec_IO_DP &cof, DP &resid); +void pccheb(Vec_I_DP &d, Vec_O_DP &c); +void pcshft(const DP a, const DP b, Vec_IO_DP &d); +void pearsn(Vec_I_DP &x, Vec_I_DP &y, DP &r, DP &prob, DP &z); +void period(Vec_I_DP &x, Vec_I_DP &y, const DP ofac, const DP hifac, + Vec_O_DP &px, Vec_O_DP &py, int &nout, int &jmax, DP &prob); +void piksr2(Vec_IO_DP &arr, Vec_IO_DP &brr); +void piksrt(Vec_IO_DP &arr); +void pinvs(const int ie1, const int ie2, const int je1, const int jsf, + const int jc1, const int k, Mat3D_O_DP &c, Mat_IO_DP &s); +DP plgndr(const int l, const int m, const DP x); +DP poidev(const DP xm, int &idum); +void polcoe(Vec_I_DP &x, Vec_I_DP &y, Vec_O_DP &cof); +void polcof(Vec_I_DP &xa, Vec_I_DP &ya, Vec_O_DP &cof); +void poldiv(Vec_I_DP &u, Vec_I_DP &v, Vec_O_DP &q, Vec_O_DP &r); +void polin2(Vec_I_DP &x1a, Vec_I_DP &x2a, Mat_I_DP &ya, const DP x1, + const DP x2, DP &y, DP &dy); +void polint(Vec_I_DP &xa, Vec_I_DP &ya, const DP x, DP &y, DP &dy); +void powell(Vec_IO_DP &p, Mat_IO_DP &xi, const DP ftol, int &iter, + DP &fret, DP func(Vec_I_DP &)); +void predic(Vec_I_DP &data, Vec_I_DP &d, Vec_O_DP &future); +DP probks(const DP alam); +void psdes(unsigned long &lword, unsigned long &irword); +void pwt(Vec_IO_DP &a, const int n, const int isign); +void pwtset(const int n); +DP pythag(const DP a, const DP b); +void pzextr(const int iest, const DP xest, Vec_I_DP &yest, Vec_O_DP &yz, + Vec_O_DP &dy); +DP qgaus(DP func(const DP), const DP a, const DP b); +void qrdcmp(Mat_IO_DP &a, Vec_O_DP &c, Vec_O_DP &d, bool &sing); +DP qromb(DP func(const DP), DP a, DP b); +DP qromo(DP func(const DP), const DP a, const DP b, + DP choose(DP (*)(const DP), const DP, const DP, const int)); +void qroot(Vec_I_DP &p, DP &b, DP &c, const DP eps); +void qrsolv(Mat_I_DP &a, Vec_I_DP &c, Vec_I_DP &d, Vec_IO_DP &b); +void qrupdt(Mat_IO_DP &r, Mat_IO_DP &qt, Vec_IO_DP &u, Vec_I_DP &v); +DP qsimp(DP func(const DP), const DP a, const DP b); +DP qtrap(DP func(const DP), const DP a, const DP b); +DP quad3d(DP func(const DP, const DP, const DP), const DP x1, const DP x2); +void quadct(const DP x, const DP y, Vec_I_DP &xx, Vec_I_DP &yy, DP &fa, + DP &fb, DP &fc, DP &fd); +void quadmx(Mat_O_DP &a); +void quadvl(const DP x, const DP y, DP &fa, DP &fb, DP &fc, DP &fd); +DP ran0(int &idum); +DP ran1(int &idum); +DP ran2(int &idum); +DP ran3(int &idum); +DP ran4(int &idum); +void rank(Vec_I_INT &indx, Vec_O_INT &irank); +void ranpt(Vec_O_DP &pt, Vec_I_DP ®n); +void ratint(Vec_I_DP &xa, Vec_I_DP &ya, const DP x, DP &y, DP &dy); +void ratlsq(DP fn(const DP), const DP a, const DP b, const int mm, + const int kk, Vec_O_DP &cof, DP &dev); +DP ratval(const DP x, Vec_I_DP &cof, const int mm, const int kk); +DP rc(const DP x, const DP y); +DP rd(const DP x, const DP y, const DP z); +void realft(Vec_IO_DP &data, const int isign); +void rebin(const DP rc, const int nd, Vec_I_DP &r, Vec_O_DP &xin, + Mat_IO_DP &xi, const int j); +void red(const int iz1, const int iz2, const int jz1, const int jz2, + const int jm1, const int jm2, const int jmf, const int ic1, + const int jc1, const int jcf, const int kc, Mat3D_I_DP &c, + Mat_IO_DP &s); +void relax(Mat_IO_DP &u, Mat_I_DP &rhs); +void relax2(Mat_IO_DP &u, Mat_I_DP &rhs); +void resid(Mat_O_DP &res, Mat_I_DP &u, Mat_I_DP &rhs); +DP revcst(Vec_I_DP &x, Vec_I_DP &y, Vec_I_INT &iorder, Vec_IO_INT &n); +void reverse(Vec_IO_INT &iorder, Vec_I_INT &n); +DP rf(const DP x, const DP y, const DP z); +DP rj(const DP x, const DP y, const DP z, const DP p); +void rk4(Vec_I_DP &y, Vec_I_DP &dydx, const DP x, const DP h, + Vec_O_DP &yout, void derivs(const DP, Vec_I_DP &, Vec_O_DP &)); +void rkck(Vec_I_DP &y, Vec_I_DP &dydx, const DP x, + const DP h, Vec_O_DP &yout, Vec_O_DP &yerr, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &)); +void rkdumb(Vec_I_DP &vstart, const DP x1, const DP x2, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &)); +void rkqs(Vec_IO_DP &y, Vec_IO_DP &dydx, DP &x, const DP htry, + const DP eps, Vec_I_DP &yscal, DP &hdid, DP &hnext, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &)); +void rlft3(Mat3D_IO_DP &data, Mat_IO_DP &speq, const int isign); +DP rofunc(const DP b); +void rotate(Mat_IO_DP &r, Mat_IO_DP &qt, const int i, const DP a, + const DP b); +void rsolv(Mat_I_DP &a, Vec_I_DP &d, Vec_IO_DP &b); +void rstrct(Mat_O_DP &uc, Mat_I_DP &uf); +DP rtbis(DP func(const DP), const DP x1, const DP x2, const DP xacc); +DP rtflsp(DP func(const DP), const DP x1, const DP x2, const DP xacc); +DP rtnewt(void funcd(const DP, DP &, DP &), const DP x1, const DP x2, + const DP xacc); +DP rtsafe(void funcd(const DP, DP &, DP &), const DP x1, const DP x2, + const DP xacc); +DP rtsec(DP func(const DP), const DP x1, const DP x2, const DP xacc); +void rzextr(const int iest, const DP xest, Vec_I_DP &yest, Vec_O_DP &yz, + Vec_O_DP &dy); +void savgol(Vec_O_DP &c, const int np, const int nl, const int nr, + const int ld, const int m); +void scrsho(DP fx(const DP)); +DP select(const int k, Vec_IO_DP &arr); +DP selip(const int k, Vec_I_DP &arr); +void shell(const int n, Vec_IO_DP &a); +void shoot(Vec_I_DP &v, Vec_O_DP &f); +void shootf(Vec_I_DP &v, Vec_O_DP &f); +void simp1(Mat_I_DP &a, const int mm, Vec_I_INT &ll, const int nll, + const int iabf, int &kp, DP &bmax); +void simp2(Mat_I_DP &a, const int m, const int n, int &ip, const int kp); +void simp3(Mat_IO_DP &a, const int i1, const int k1, const int ip, + const int kp); +void simplx(Mat_IO_DP &a, const int m1, const int m2, const int m3, + int &icase, Vec_O_INT &izrov, Vec_O_INT &iposv); +void simpr(Vec_I_DP &y, Vec_I_DP &dydx, Vec_I_DP &dfdx, Mat_I_DP &dfdy, + const DP xs, const DP htot, const int nstep, Vec_O_DP &yout, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &)); +void sinft(Vec_IO_DP &y); +void slvsm2(Mat_O_DP &u, Mat_I_DP &rhs); +void slvsml(Mat_O_DP &u, Mat_I_DP &rhs); +void sncndn(const DP uu, const DP emmc, DP &sn, DP &cn, DP &dn); +DP snrm(Vec_I_DP &sx, const int itol); +void sobseq(const int n, Vec_O_DP &x); +void solvde(const int itmax, const DP conv, const DP slowc, + Vec_I_DP &scalv, Vec_I_INT &indexv, const int nb, Mat_IO_DP &y); +void sor(Mat_I_DP &a, Mat_I_DP &b, Mat_I_DP &c, Mat_I_DP &d, Mat_I_DP &e, + Mat_I_DP &f, Mat_IO_DP &u, const DP rjac); +void sort(Vec_IO_DP &arr); +void sort2(Vec_IO_DP &arr, Vec_IO_DP &brr); +void sort3(Vec_IO_DP &ra, Vec_IO_DP &rb, Vec_IO_DP &rc); +void spctrm(ifstream &fp, Vec_O_DP &p, const int k, const bool ovrlap); +void spear(Vec_I_DP &data1, Vec_I_DP &data2, DP &d, DP &zd, DP &probd, + DP &rs, DP &probrs); +void sphbes(const int n, const DP x, DP &sj, DP &sy, DP &sjp, DP &syp); +void splie2(Vec_I_DP &x1a, Vec_I_DP &x2a, Mat_I_DP &ya, Mat_O_DP &y2a); +void splin2(Vec_I_DP &x1a, Vec_I_DP &x2a, Mat_I_DP &ya, Mat_I_DP &y2a, + const DP x1, const DP x2, DP &y); +void spline(Vec_I_DP &x, Vec_I_DP &y, const DP yp1, const DP ypn, + Vec_O_DP &y2); +void splint(Vec_I_DP &xa, Vec_I_DP &ya, Vec_I_DP &y2a, const DP x, DP &y); +void spread(const DP y, Vec_IO_DP &yy, const DP x, const int m); +void sprsax(Vec_I_DP &sa, Vec_I_INT &ija, Vec_I_DP &x, Vec_O_DP &b); +void sprsin(Mat_I_DP &a, const DP thresh, Vec_O_DP &sa, Vec_O_INT &ija); +void sprspm(Vec_I_DP &sa, Vec_I_INT &ija, Vec_I_DP &sb, Vec_I_INT &ijb, + Vec_O_DP &sc, Vec_I_INT &ijc); +void sprstm(Vec_I_DP &sa, Vec_I_INT &ija, Vec_I_DP &sb, Vec_I_INT &ijb, + const DP thresh, Vec_O_DP &sc, Vec_O_INT &ijc); +void sprstp(Vec_I_DP &sa, Vec_I_INT &ija, Vec_O_DP &sb, Vec_O_INT &ijb); +void sprstx(Vec_I_DP &sa, Vec_I_INT &ija, Vec_I_DP &x, Vec_O_DP &b); +void stifbs(Vec_IO_DP &y, Vec_IO_DP &dydx, DP &xx, const DP htry, + const DP eps, Vec_I_DP &yscal, DP &hdid, DP &hnext, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &)); +void stiff(Vec_IO_DP &y, Vec_IO_DP &dydx, DP &x, const DP htry, + const DP eps, Vec_I_DP &yscal, DP &hdid, DP &hnext, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &)); +void stoerm(Vec_I_DP &y, Vec_I_DP &d2y, const DP xs, + const DP htot, const int nstep, Vec_O_DP &yout, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &)); +void svbksb(Mat_I_DP &u, Vec_I_DP &w, Mat_I_DP &v, Vec_I_DP &b, Vec_O_DP &x); +void svdcmp(Mat_IO_DP &a, Vec_O_DP &w, Mat_O_DP &v); +void svdfit(Vec_I_DP &x, Vec_I_DP &y, Vec_I_DP &sig, Vec_O_DP &a, + Mat_O_DP &u, Mat_O_DP &v, Vec_O_DP &w, DP &chisq, + void funcs(const DP, Vec_O_DP &)); +void svdvar(Mat_I_DP &v, Vec_I_DP &w, Mat_O_DP &cvm); +void toeplz(Vec_I_DP &r, Vec_O_DP &x, Vec_I_DP &y); +void tptest(Vec_I_DP &data1, Vec_I_DP &data2, DP &t, DP &prob); +void tqli(Vec_IO_DP &d, Vec_IO_DP &e, Mat_IO_DP &z); +DP trapzd(DP func(const DP), const DP a, const DP b, const int n); +void tred2(Mat_IO_DP &a, Vec_O_DP &d, Vec_O_DP &e); +void tridag(Vec_I_DP &a, Vec_I_DP &b, Vec_I_DP &c, Vec_I_DP &r, Vec_O_DP &u); +DP trncst(Vec_I_DP &x, Vec_I_DP &y, Vec_I_INT &iorder, Vec_IO_INT &n); +void trnspt(Vec_IO_INT &iorder, Vec_I_INT &n); +void ttest(Vec_I_DP &data1, Vec_I_DP &data2, DP &t, DP &prob); +void tutest(Vec_I_DP &data1, Vec_I_DP &data2, DP &t, DP &prob); +void twofft(Vec_I_DP &data1, Vec_I_DP &data2, Vec_O_DP &fft1, + Vec_O_DP &fft2); +void vander(Vec_I_DP &x, Vec_O_DP &w, Vec_I_DP &q); +void vegas(Vec_I_DP ®n, DP fxn(Vec_I_DP &, const DP), const int init, + const int ncall, const int itmx, const int nprn, DP &tgral, DP &sd, + DP &chi2a); +void voltra(const DP t0, const DP h, Vec_O_DP &t, Mat_O_DP &f, + DP g(const int, const DP), + DP ak(const int, const int, const DP, const DP)); +void wt1(Vec_IO_DP &a, const int isign, + void wtstep(Vec_IO_DP &, const int, const int)); +void wtn(Vec_IO_DP &a, Vec_I_INT &nn, const int isign, + void wtstep(Vec_IO_DP &, const int, const int)); +void wwghts(Vec_O_DP &wghts, const DP h, + void kermom(Vec_O_DP &w, const DP y)); +bool zbrac(DP func(const DP), DP &x1, DP &x2); +void zbrak(DP fx(const DP), const DP x1, const DP x2, const int n, + Vec_O_DP &xb1, Vec_O_DP &xb2, int &nroot); +DP zbrent(DP func(const DP), const DP x1, const DP x2, const DP tol); +void zrhqr(Vec_I_DP &a, Vec_O_CPLX_DP &rt); +DP zriddr(DP func(const DP), const DP x1, const DP x2, const DP xacc); +void zroots(Vec_I_CPLX_DP &a, Vec_O_CPLX_DP &roots, const bool &polish); +} +#endif /* _NR_H_ */ diff --git a/lib/nr/cpp/other/nrexit.cpp b/lib/nr/cpp/other/nrexit.cpp new file mode 100644 index 0000000..c3e157c --- /dev/null +++ b/lib/nr/cpp/other/nrexit.cpp @@ -0,0 +1,13 @@ + +#include +using namespace std; + +// Function used to stall exit in Borland C++Builder + +void nrexit(void) +{ + cin.get(); + return; +} + +#pragma exit nrexit diff --git a/lib/nr/cpp/other/nrtypes.h b/lib/nr/cpp/other/nrtypes.h new file mode 100644 index 0000000..1af86f8 --- /dev/null +++ b/lib/nr/cpp/other/nrtypes.h @@ -0,0 +1,3 @@ +#include "nrtypes_nr.h" + +//#include "nrtypes_lib.h" diff --git a/lib/nr/cpp/other/nrtypes_lib.h b/lib/nr/cpp/other/nrtypes_lib.h new file mode 100644 index 0000000..e21913d --- /dev/null +++ b/lib/nr/cpp/other/nrtypes_lib.h @@ -0,0 +1,92 @@ +#ifndef _NR_TYPES_H_ +#define _NR_TYPES_H_ + +#include +#include +#include "nrutil.h" +using namespace std; + +typedef double DP; + +// Vector Types + +typedef const NRVec Vec_I_BOOL; +typedef const NRVec Vec_BOOL, Vec_O_BOOL, Vec_IO_BOOL; + +typedef const NRVec Vec_I_CHR; +typedef const NRVec Vec_CHR, Vec_O_CHR, Vec_IO_CHR; + +typedef const NRVec Vec_I_UCHR; +typedef const NRVec Vec_UCHR, Vec_O_UCHR, Vec_IO_UCHR; + +typedef const NRVec Vec_I_INT; +typedef const NRVec Vec_INT, Vec_O_INT, Vec_IO_INT; + +typedef const NRVec Vec_I_UINT; +typedef const NRVec Vec_UINT, Vec_O_UINT, Vec_IO_UINT; + +typedef const NRVec Vec_I_LNG; +typedef const NRVec Vec_LNG, Vec_O_LNG, Vec_IO_LNG; + +typedef const NRVec Vec_I_ULNG; +typedef const NRVec Vec_ULNG, Vec_O_ULNG, Vec_IO_ULNG; + +typedef const NRVec Vec_I_SP; +typedef const NRVec Vec_SP, Vec_O_SP, Vec_IO_SP; + +typedef const NRVec Vec_I_DP; +typedef const NRVec Vec_DP, Vec_O_DP, Vec_IO_DP; + +typedef const NRVec > Vec_I_CPLX_SP; +typedef const NRVec > Vec_CPLX_SP, Vec_O_CPLX_SP, Vec_IO_CPLX_SP; + +typedef const NRVec > Vec_I_CPLX_DP; +typedef const NRVec > Vec_CPLX_DP, Vec_O_CPLX_DP, Vec_IO_CPLX_DP; + +// Matrix Types + +typedef const NRMat Mat_I_BOOL; +typedef const NRMat Mat_BOOL, Mat_O_BOOL, Mat_IO_BOOL; + +typedef const NRMat Mat_I_CHR; +typedef const NRMat Mat_CHR, Mat_O_CHR, Mat_IO_CHR; + +typedef const NRMat Mat_I_UCHR; +typedef const NRMat Mat_UCHR, Mat_O_UCHR, Mat_IO_UCHR; + +typedef const NRMat Mat_I_INT; +typedef const NRMat Mat_INT, Mat_O_INT, Mat_IO_INT; + +typedef const NRMat Mat_I_UINT; +typedef const NRMat Mat_UINT, Mat_O_UINT, Mat_IO_UINT; + +typedef const NRMat Mat_I_LNG; +typedef const NRMat Mat_LNG, Mat_O_LNG, Mat_IO_LNG; + +typedef const NRVec Mat_I_ULNG; +typedef const NRMat Mat_ULNG, Mat_O_ULNG, Mat_IO_ULNG; + +typedef const NRMat Mat_I_SP; +typedef const NRMat Mat_SP, Mat_O_SP, Mat_IO_SP; + +typedef const NRMat Mat_I_DP; +typedef const NRMat Mat_DP, Mat_O_DP, Mat_IO_DP; + +typedef const NRMat > Mat_I_CPLX_SP; +typedef const NRMat > Mat_CPLX_SP, Mat_O_CPLX_SP, Mat_IO_CPLX_SP; + +typedef const NRMat > Mat_I_CPLX_DP; +typedef const NRMat > Mat_CPLX_DP, Mat_O_CPLX_DP, Mat_IO_CPLX_DP; + +// 3D Matrix Types + +typedef const NRMat3d Mat3D_I_DP; +typedef NRMat3d Mat3D_DP, Mat3D_O_DP, Mat3D_IO_DP; + +// Miscellaneous Types + +typedef NRVec Vec_ULNG_p; +typedef const NRVec *> Vec_Mat_DP_p; +typedef NRVec Vec_FSTREAM_p; + +#endif /* _NR_TYPES_H_ */ diff --git a/lib/nr/cpp/other/nrtypes_nr.h b/lib/nr/cpp/other/nrtypes_nr.h new file mode 100644 index 0000000..2174ca0 --- /dev/null +++ b/lib/nr/cpp/other/nrtypes_nr.h @@ -0,0 +1,92 @@ +#ifndef _NR_TYPES_H_ +#define _NR_TYPES_H_ + +#include +#include +#include "nrutil.h" +using namespace std; + +typedef double DP; + +// Vector Types + +typedef const NRVec Vec_I_BOOL; +typedef NRVec Vec_BOOL, Vec_O_BOOL, Vec_IO_BOOL; + +typedef const NRVec Vec_I_CHR; +typedef NRVec Vec_CHR, Vec_O_CHR, Vec_IO_CHR; + +typedef const NRVec Vec_I_UCHR; +typedef NRVec Vec_UCHR, Vec_O_UCHR, Vec_IO_UCHR; + +typedef const NRVec Vec_I_INT; +typedef NRVec Vec_INT, Vec_O_INT, Vec_IO_INT; + +typedef const NRVec Vec_I_UINT; +typedef NRVec Vec_UINT, Vec_O_UINT, Vec_IO_UINT; + +typedef const NRVec Vec_I_LNG; +typedef NRVec Vec_LNG, Vec_O_LNG, Vec_IO_LNG; + +typedef const NRVec Vec_I_ULNG; +typedef NRVec Vec_ULNG, Vec_O_ULNG, Vec_IO_ULNG; + +typedef const NRVec Vec_I_SP; +typedef NRVec Vec_SP, Vec_O_SP, Vec_IO_SP; + +typedef const NRVec Vec_I_DP; +typedef NRVec Vec_DP, Vec_O_DP, Vec_IO_DP; + +typedef const NRVec > Vec_I_CPLX_SP; +typedef NRVec > Vec_CPLX_SP, Vec_O_CPLX_SP, Vec_IO_CPLX_SP; + +typedef const NRVec > Vec_I_CPLX_DP; +typedef NRVec > Vec_CPLX_DP, Vec_O_CPLX_DP, Vec_IO_CPLX_DP; + +// Matrix Types + +typedef const NRMat Mat_I_BOOL; +typedef NRMat Mat_BOOL, Mat_O_BOOL, Mat_IO_BOOL; + +typedef const NRMat Mat_I_CHR; +typedef NRMat Mat_CHR, Mat_O_CHR, Mat_IO_CHR; + +typedef const NRMat Mat_I_UCHR; +typedef NRMat Mat_UCHR, Mat_O_UCHR, Mat_IO_UCHR; + +typedef const NRMat Mat_I_INT; +typedef NRMat Mat_INT, Mat_O_INT, Mat_IO_INT; + +typedef const NRMat Mat_I_UINT; +typedef NRMat Mat_UINT, Mat_O_UINT, Mat_IO_UINT; + +typedef const NRMat Mat_I_LNG; +typedef NRMat Mat_LNG, Mat_O_LNG, Mat_IO_LNG; + +typedef const NRVec Mat_I_ULNG; +typedef NRMat Mat_ULNG, Mat_O_ULNG, Mat_IO_ULNG; + +typedef const NRMat Mat_I_SP; +typedef NRMat Mat_SP, Mat_O_SP, Mat_IO_SP; + +typedef const NRMat Mat_I_DP; +typedef NRMat Mat_DP, Mat_O_DP, Mat_IO_DP; + +typedef const NRMat > Mat_I_CPLX_SP; +typedef NRMat > Mat_CPLX_SP, Mat_O_CPLX_SP, Mat_IO_CPLX_SP; + +typedef const NRMat > Mat_I_CPLX_DP; +typedef NRMat > Mat_CPLX_DP, Mat_O_CPLX_DP, Mat_IO_CPLX_DP; + +// 3D Matrix Types + +typedef const NRMat3d Mat3D_I_DP; +typedef NRMat3d Mat3D_DP, Mat3D_O_DP, Mat3D_IO_DP; + +// Miscellaneous Types + +typedef NRVec Vec_ULNG_p; +typedef NRVec *> Vec_Mat_DP_p; +typedef NRVec Vec_FSTREAM_p; + +#endif /* _NR_TYPES_H_ */ diff --git a/lib/nr/cpp/other/nrutil.h b/lib/nr/cpp/other/nrutil.h new file mode 100644 index 0000000..5b397c9 --- /dev/null +++ b/lib/nr/cpp/other/nrutil.h @@ -0,0 +1,5 @@ +#include "nrutil_nr.h" + +//#include "nrutil_tnt.h" + +//#include "nrutil_mtl.h" diff --git a/lib/nr/cpp/other/nrutil_mtl.h b/lib/nr/cpp/other/nrutil_mtl.h new file mode 100644 index 0000000..afa4709 --- /dev/null +++ b/lib/nr/cpp/other/nrutil_mtl.h @@ -0,0 +1,351 @@ +#ifndef _NR_UTIL_H_ +#define _NR_UTIL_H_ + +#include +#include +#include +#include +using namespace std; + +typedef double DP; + +template +inline const T SQR(const T a) {return a*a;} + +template +inline const T MAX(const T &a, const T &b) + {return b > a ? (b) : (a);} + +inline float MAX(const double &a, const float &b) + {return b > a ? (b) : float(a);} + +inline float MAX(const float &a, const double &b) + {return b > a ? float(b) : (a);} + +template +inline const T MIN(const T &a, const T &b) + {return b < a ? (b) : (a);} + +inline float MIN(const double &a, const float &b) + {return b < a ? (b) : float(a);} + +inline float MIN(const float &a, const double &b) + {return b < a ? float(b) : (a);} + +template +inline const T SIGN(const T &a, const T &b) + {return b >= 0 ? (a >= 0 ? a : -a) : (a >= 0 ? -a : a);} + +inline float SIGN(const float &a, const double &b) + {return b >= 0 ? (a >= 0 ? a : -a) : (a >= 0 ? -a : a);} + +inline float SIGN(const double &a, const float &b) + {return b >= 0 ? (a >= 0 ? a : -a) : (a >= 0 ? -a : a);} + +template +inline void SWAP(T &a, T &b) + {T dum=a; a=b; b=dum;} + +namespace NR { + inline void nrerror(const string error_text) + // Numerical Recipes standard error handler + { + cerr << "Numerical Recipes run-time error..." << endl; + cerr << error_text << endl; + cerr << "...now exiting to system..." << endl; + exit(1); + } +} + +#include "mtl/mtl.h" +using namespace mtl; + +// mtl Wrapper File +// This is the file that "joins" the mtl Vector<> and Matrix<> classes +// to the NRVec and NRMat classes by the Wrapper Class Method + +// NRVec contains a Vector and a &Vector. All its constructors, except the +// conversion constructor, create the Vector and point the &Vector to it. +// The conversion constructor only points the &Vector. All operations +// (size, subscript) are through the &Vector, which as a reference +// (not pointer) has no indirection overhead. + +template +class NRVec { +// Use the std::vector based dense1D for our Vector type +typedef dense1D Vector; +protected: //access required in NRVec below + Vector myvec; + Vector &myref; +public: + NRVec() : myvec(), myref(myvec) {} + explicit NRVec(const int n) : myvec(n), myref(myvec) {} + NRVec(const T &a, int n) : myvec(n), myref(myvec) { + for (int i=0; i(const T *a, int n) : myvec(n), myref(myvec) { + for (int i=0; i(Vector &rhs) : myref(rhs) {} + // conversion constructor makes a special NRVec pointing to Vector's data + // this handles Vector actual args sent to NRVec formal args in functions + NRVec(const NRVec& rhs) : myvec(rhs.myref.size()), myref(myvec) + {copy(rhs.myref,myref);} + // copy constructor. mtl copy constructor + // does shallow copy only. so use copy() instead + inline NRVec& operator=(const NRVec& rhs) { + if (myref.size() != rhs.myref.size()) + myref.resize(rhs.myref.size()); + copy(rhs.myref,myref); return *this;} + inline int size() const {return myref.size();} + inline T & operator[](const int i) const {return myref[i];} + inline operator Vector() const {return myref;} + // conversion operator to Vector + // handles NRVec function return types when used in Vector expressions + ~NRVec() {} +}; + +//The std:vector class has a specialization for vector that doesn't +//work with the above wrapper class scheme. So implement our own +//specialization as a derived class of NRVec. This could cause +//problems if you mix mtl::Vector with NRVec! + +template <> class NRVec : public NRVec { +public: + NRVec() : NRVec() {} + explicit NRVec(const int n) : NRVec(n) {} + NRVec(const bool &a, int n) : NRVec(int(a),n) {} + NRVec(const bool *a, int n) : NRVec(n) { + for (int i=0; i +class NRMat { +// Use the matrix generator to select a matrix type +typedef matrix< T, + rectangle<>, + dense<>, + row_major>::type Matrix; +protected: + Matrix mymat; + Matrix &myref; +public: + NRMat() : mymat(), myref(mymat) {} + NRMat(int n, int m) : mymat(n,m), myref(mymat) {} + NRMat(const T& a, int n, int m) : mymat(n,m), myref(mymat) { + for (int i=0; i< n; i++) + for (int j=0; j(Matrix &rhs) : myref(rhs) {} + NRMat(const NRMat& rhs) : + mymat(rhs.myref.nrows(),rhs.myref.ncols()), myref(mymat) + {copy(rhs.myref,myref);} + inline NRMat& operator=(const NRMat& rhs) { + if (myref.nrows() != rhs.myref.nrows() && myref.ncols() != + rhs.myref.ncols()) { + cerr << "assignment with incompatible matrix sizes\n"; + abort(); + } + copy(rhs.myref,myref); return *this; + } + typename Matrix::OneD operator[](const int i) const {return myref[i];} + //return type is whatever Matrix returns for a single [] dereference + inline int nrows() const {return myref.nrows();} + inline int ncols() const {return myref.ncols();} + inline operator Matrix() const {return myref;} + ~NRMat() {} +}; + +template <> class NRMat : public NRMat { +public: + NRMat() : NRMat() {} + explicit NRMat(int n, int m) : NRMat(n,m) {} + NRMat(const bool &a, int n, int m) : NRMat(int(a),n,m) {} + NRMat(const bool *a, int n, int m) : NRMat(n,m) { + for (int i=0; i< n; i++) + for (int j=0; j +class NRMat3d { +private: + int nn; + int mm; + int kk; + T ***v; +public: + NRMat3d(); + NRMat3d(int n, int m, int k); + inline T** operator[](const int i); //subscripting: pointer to row i + inline const T* const * operator[](const int i) const; + inline int dim1() const; + inline int dim2() const; + inline int dim3() const; + ~NRMat3d(); +}; + +template +NRMat3d::NRMat3d(): nn(0), mm(0), kk(0), v(0) {} + +template +NRMat3d::NRMat3d(int n, int m, int k) : nn(n), mm(m), kk(k), v(new T**[n]) +{ + int i,j; + v[0] = new T*[n*m]; + v[0][0] = new T[n*m*k]; + for(j=1; j +inline T** NRMat3d::operator[](const int i) //subscripting: pointer to row i +{ + return v[i]; +} + +template +inline const T* const * NRMat3d::operator[](const int i) const +{ + return v[i]; +} + +template +inline int NRMat3d::dim1() const +{ + return nn; +} + +template +inline int NRMat3d::dim2() const +{ + return mm; +} + +template +inline int NRMat3d::dim3() const +{ + return kk; +} + +template +NRMat3d::~NRMat3d() +{ + if (v != 0) { + delete[] (v[0][0]); + delete[] (v[0]); + delete[] (v); + } +} + +//The next 3 classes are used in artihmetic coding, Huffman coding, and +//wavelet transforms respectively. This is as good a place as any to put them! + +class arithcode { +private: + NRVec *ilob_p,*iupb_p,*ncumfq_p; +public: + NRVec &ilob,&iupb,&ncumfq; + unsigned long jdif,nc,minint,nch,ncum,nrad; + arithcode(unsigned long n1, unsigned long n2, unsigned long n3) + : ilob_p(new NRVec(n1)), + iupb_p(new NRVec(n2)), + ncumfq_p(new NRVec(n3)), + ilob(*ilob_p),iupb(*iupb_p),ncumfq(*ncumfq_p) {} + ~arithcode() { + if (ilob_p != 0) delete ilob_p; + if (iupb_p != 0) delete iupb_p; + if (ncumfq_p != 0) delete ncumfq_p; + } +}; + +class huffcode { +private: + NRVec *icod_p,*ncod_p,*left_p,*right_p; +public: + NRVec &icod,&ncod,&left,&right; + int nch,nodemax; + huffcode(unsigned long n1, unsigned long n2, unsigned long n3, + unsigned long n4) : + icod_p(new NRVec(n1)), + ncod_p(new NRVec(n2)), + left_p(new NRVec(n3)), + right_p(new NRVec(n4)), + icod(*icod_p),ncod(*ncod_p),left(*left_p),right(*right_p) {} + ~huffcode() { + if (icod_p != 0) delete icod_p; + if (ncod_p != 0) delete ncod_p; + if (left_p != 0) delete left_p; + if (right_p != 0) delete right_p; + } +}; + +class wavefilt { +private: + NRVec *cc_p,*cr_p; +public: + int ncof,ioff,joff; + NRVec &cc,&cr; + wavefilt() : cc(*cc_p),cr(*cr_p) {} + wavefilt(const DP *a, const int n) : //initialize to array + cc_p(new NRVec(n)),cr_p(new NRVec(n)), + ncof(n),ioff(-(n >> 1)),joff(-(n >> 1)),cc(*cc_p),cr(*cr_p) { + int i; + for (i=0; i + +inline const complex operator+(const double &a, + const complex &b) { return float(a)+b; } + +inline const complex operator+(const complex &a, + const double &b) { return a+float(b); } + +inline const complex operator-(const double &a, + const complex &b) { return float(a)-b; } + +inline const complex operator-(const complex &a, + const double &b) { return a-float(b); } + +inline const complex operator*(const double &a, + const complex &b) { return float(a)*b; } + +inline const complex operator*(const complex &a, + const double &b) { return a*float(b); } + +inline const complex operator/(const double &a, + const complex &b) { return float(a)/b; } + +inline const complex operator/(const complex &a, + const double &b) { return a/float(b); } + +//some compilers choke on pow(float,double) in single precision. also atan2 + +inline float pow (float x, double y) {return pow(double(x),y);} +inline float pow (double x, float y) {return pow(x,double(y));} +inline float atan2 (float x, double y) {return atan2(double(x),y);} +inline float atan2 (double x, float y) {return atan2(x,double(y));} +#endif /* _NR_UTIL_H_ */ diff --git a/lib/nr/cpp/other/nrutil_nr.h b/lib/nr/cpp/other/nrutil_nr.h new file mode 100644 index 0000000..22f5f74 --- /dev/null +++ b/lib/nr/cpp/other/nrutil_nr.h @@ -0,0 +1,472 @@ +#ifndef _NR_UTIL_H_ +#define _NR_UTIL_H_ + +#include +#include +#include +#include +using namespace std; + +typedef double DP; + +template +inline const T SQR(const T a) {return a*a;} + +template +inline const T MAX(const T &a, const T &b) + {return b > a ? (b) : (a);} + +inline float MAX(const double &a, const float &b) + {return b > a ? (b) : float(a);} + +inline float MAX(const float &a, const double &b) + {return b > a ? float(b) : (a);} + +template +inline const T MIN(const T &a, const T &b) + {return b < a ? (b) : (a);} + +inline float MIN(const double &a, const float &b) + {return b < a ? (b) : float(a);} + +inline float MIN(const float &a, const double &b) + {return b < a ? float(b) : (a);} + +template +inline const T SIGN(const T &a, const T &b) + {return b >= 0 ? (a >= 0 ? a : -a) : (a >= 0 ? -a : a);} + +inline float SIGN(const float &a, const double &b) + {return b >= 0 ? (a >= 0 ? a : -a) : (a >= 0 ? -a : a);} + +inline float SIGN(const double &a, const float &b) + {return b >= 0 ? (a >= 0 ? a : -a) : (a >= 0 ? -a : a);} + +template +inline void SWAP(T &a, T &b) + {T dum=a; a=b; b=dum;} + +namespace NR { + inline void nrerror(const string error_text) + // Numerical Recipes standard error handler + { + cerr << "Numerical Recipes run-time error..." << endl; + cerr << error_text << endl; + cerr << "...now exiting to system..." << endl; + exit(1); + } +} + +template +class NRVec { +private: + int nn; // size of array. upper index is nn-1 + T *v; +public: + NRVec(); + explicit NRVec(int n); // Zero-based array + NRVec(const T &a, int n); //initialize to constant value + NRVec(const T *a, int n); // Initialize to array + NRVec(const NRVec &rhs); // Copy constructor + NRVec & operator=(const NRVec &rhs); //assignment + NRVec & operator=(const T &a); //assign a to every element + inline T & operator[](const int i); //i'th element + inline const T & operator[](const int i) const; + inline int size() const; + ~NRVec(); +}; + +template +NRVec::NRVec() : nn(0), v(0) {} + +template +NRVec::NRVec(int n) : nn(n), v(new T[n]) {} + +template +NRVec::NRVec(const T& a, int n) : nn(n), v(new T[n]) +{ + for(int i=0; i +NRVec::NRVec(const T *a, int n) : nn(n), v(new T[n]) +{ + for(int i=0; i +NRVec::NRVec(const NRVec &rhs) : nn(rhs.nn), v(new T[nn]) +{ + for(int i=0; i +NRVec & NRVec::operator=(const NRVec &rhs) +// postcondition: normal assignment via copying has been performed; +// if vector and rhs were different sizes, vector +// has been resized to match the size of rhs +{ + if (this != &rhs) + { + if (nn != rhs.nn) { + if (v != 0) delete [] (v); + nn=rhs.nn; + v= new T[nn]; + } + for (int i=0; i +NRVec & NRVec::operator=(const T &a) //assign a to every element +{ + for (int i=0; i +inline T & NRVec::operator[](const int i) //subscripting +{ + return v[i]; +} + +template +inline const T & NRVec::operator[](const int i) const //subscripting +{ + return v[i]; +} + +template +inline int NRVec::size() const +{ + return nn; +} + +template +NRVec::~NRVec() +{ + if (v != 0) + delete[] (v); +} + +template +class NRMat { +private: + int nn; + int mm; + T **v; +public: + NRMat(); + NRMat(int n, int m); // Zero-based array + NRMat(const T &a, int n, int m); //Initialize to constant + NRMat(const T *a, int n, int m); // Initialize to array + NRMat(const NRMat &rhs); // Copy constructor + NRMat & operator=(const NRMat &rhs); //assignment + NRMat & operator=(const T &a); //assign a to every element + inline T* operator[](const int i); //subscripting: pointer to row i + inline const T* operator[](const int i) const; + inline int nrows() const; + inline int ncols() const; + ~NRMat(); +}; + +template +NRMat::NRMat() : nn(0), mm(0), v(0) {} + +template +NRMat::NRMat(int n, int m) : nn(n), mm(m), v(new T*[n]) +{ + v[0] = new T[m*n]; + for (int i=1; i< n; i++) + v[i] = v[i-1] + m; +} + +template +NRMat::NRMat(const T &a, int n, int m) : nn(n), mm(m), v(new T*[n]) +{ + int i,j; + v[0] = new T[m*n]; + for (i=1; i< n; i++) + v[i] = v[i-1] + m; + for (i=0; i< n; i++) + for (j=0; j +NRMat::NRMat(const T *a, int n, int m) : nn(n), mm(m), v(new T*[n]) +{ + int i,j; + v[0] = new T[m*n]; + for (i=1; i< n; i++) + v[i] = v[i-1] + m; + for (i=0; i< n; i++) + for (j=0; j +NRMat::NRMat(const NRMat &rhs) : nn(rhs.nn), mm(rhs.mm), v(new T*[nn]) +{ + int i,j; + v[0] = new T[mm*nn]; + for (i=1; i< nn; i++) + v[i] = v[i-1] + mm; + for (i=0; i< nn; i++) + for (j=0; j +NRMat & NRMat::operator=(const NRMat &rhs) +// postcondition: normal assignment via copying has been performed; +// if matrix and rhs were different sizes, matrix +// has been resized to match the size of rhs +{ + if (this != &rhs) { + int i,j; + if (nn != rhs.nn || mm != rhs.mm) { + if (v != 0) { + delete[] (v[0]); + delete[] (v); + } + nn=rhs.nn; + mm=rhs.mm; + v = new T*[nn]; + v[0] = new T[mm*nn]; + } + for (i=1; i< nn; i++) + v[i] = v[i-1] + mm; + for (i=0; i< nn; i++) + for (j=0; j +NRMat & NRMat::operator=(const T &a) //assign a to every element +{ + for (int i=0; i< nn; i++) + for (int j=0; j +inline T* NRMat::operator[](const int i) //subscripting: pointer to row i +{ + return v[i]; +} + +template +inline const T* NRMat::operator[](const int i) const +{ + return v[i]; +} + +template +inline int NRMat::nrows() const +{ + return nn; +} + +template +inline int NRMat::ncols() const +{ + return mm; +} + +template +NRMat::~NRMat() +{ + if (v != 0) { + delete[] (v[0]); + delete[] (v); + } +} + +template +class NRMat3d { +private: + int nn; + int mm; + int kk; + T ***v; +public: + NRMat3d(); + NRMat3d(int n, int m, int k); + inline T** operator[](const int i); //subscripting: pointer to row i + inline const T* const * operator[](const int i) const; + inline int dim1() const; + inline int dim2() const; + inline int dim3() const; + ~NRMat3d(); +}; + +template +NRMat3d::NRMat3d(): nn(0), mm(0), kk(0), v(0) {} + +template +NRMat3d::NRMat3d(int n, int m, int k) : nn(n), mm(m), kk(k), v(new T**[n]) +{ + int i,j; + v[0] = new T*[n*m]; + v[0][0] = new T[n*m*k]; + for(j=1; j +inline T** NRMat3d::operator[](const int i) //subscripting: pointer to row i +{ + return v[i]; +} + +template +inline const T* const * NRMat3d::operator[](const int i) const +{ + return v[i]; +} + +template +inline int NRMat3d::dim1() const +{ + return nn; +} + +template +inline int NRMat3d::dim2() const +{ + return mm; +} + +template +inline int NRMat3d::dim3() const +{ + return kk; +} + +template +NRMat3d::~NRMat3d() +{ + if (v != 0) { + delete[] (v[0][0]); + delete[] (v[0]); + delete[] (v); + } +} + +//The next 3 classes are used in artihmetic coding, Huffman coding, and +//wavelet transforms respectively. This is as good a place as any to put them! + +class arithcode { +private: + NRVec *ilob_p,*iupb_p,*ncumfq_p; +public: + NRVec &ilob,&iupb,&ncumfq; + unsigned long jdif,nc,minint,nch,ncum,nrad; + arithcode(unsigned long n1, unsigned long n2, unsigned long n3) + : ilob_p(new NRVec(n1)), + iupb_p(new NRVec(n2)), + ncumfq_p(new NRVec(n3)), + ilob(*ilob_p),iupb(*iupb_p),ncumfq(*ncumfq_p) {} + ~arithcode() { + if (ilob_p != 0) delete ilob_p; + if (iupb_p != 0) delete iupb_p; + if (ncumfq_p != 0) delete ncumfq_p; + } +}; + +class huffcode { +private: + NRVec *icod_p,*ncod_p,*left_p,*right_p; +public: + NRVec &icod,&ncod,&left,&right; + int nch,nodemax; + huffcode(unsigned long n1, unsigned long n2, unsigned long n3, + unsigned long n4) : + icod_p(new NRVec(n1)), + ncod_p(new NRVec(n2)), + left_p(new NRVec(n3)), + right_p(new NRVec(n4)), + icod(*icod_p),ncod(*ncod_p),left(*left_p),right(*right_p) {} + ~huffcode() { + if (icod_p != 0) delete icod_p; + if (ncod_p != 0) delete ncod_p; + if (left_p != 0) delete left_p; + if (right_p != 0) delete right_p; + } +}; + +class wavefilt { +private: + NRVec *cc_p,*cr_p; +public: + int ncof,ioff,joff; + NRVec &cc,&cr; + wavefilt() : cc(*cc_p),cr(*cr_p) {} + wavefilt(const DP *a, const int n) : //initialize to array + cc_p(new NRVec(n)),cr_p(new NRVec(n)), + ncof(n),ioff(-(n >> 1)),joff(-(n >> 1)),cc(*cc_p),cr(*cr_p) { + int i; + for (i=0; i + +inline const complex operator+(const double &a, + const complex &b) { return float(a)+b; } + +inline const complex operator+(const complex &a, + const double &b) { return a+float(b); } + +inline const complex operator-(const double &a, + const complex &b) { return float(a)-b; } + +inline const complex operator-(const complex &a, + const double &b) { return a-float(b); } + +inline const complex operator*(const double &a, + const complex &b) { return float(a)*b; } + +inline const complex operator*(const complex &a, + const double &b) { return a*float(b); } + +inline const complex operator/(const double &a, + const complex &b) { return float(a)/b; } + +inline const complex operator/(const complex &a, + const double &b) { return a/float(b); } + +//some compilers choke on pow(float,double) in single precision. also atan2 + +inline float pow (float x, double y) {return pow(double(x),y);} +inline float pow (double x, float y) {return pow(x,double(y));} +inline float atan2 (float x, double y) {return atan2(double(x),y);} +inline float atan2 (double x, float y) {return atan2(x,double(y));} +#endif /* _NR_UTIL_H_ */ diff --git a/lib/nr/cpp/other/nrutil_tnt.h b/lib/nr/cpp/other/nrutil_tnt.h new file mode 100644 index 0000000..adee8df --- /dev/null +++ b/lib/nr/cpp/other/nrutil_tnt.h @@ -0,0 +1,309 @@ +#ifndef _NR_UTIL_H_ +#define _NR_UTIL_H_ + +#include +#include +#include +#include +using namespace std; + +typedef double DP; + +template +inline const T SQR(const T a) {return a*a;} + +template +inline const T MAX(const T &a, const T &b) + {return b > a ? (b) : (a);} + +inline float MAX(const double &a, const float &b) + {return b > a ? (b) : float(a);} + +inline float MAX(const float &a, const double &b) + {return b > a ? float(b) : (a);} + +template +inline const T MIN(const T &a, const T &b) + {return b < a ? (b) : (a);} + +inline float MIN(const double &a, const float &b) + {return b < a ? (b) : float(a);} + +inline float MIN(const float &a, const double &b) + {return b < a ? float(b) : (a);} + +template +inline const T SIGN(const T &a, const T &b) + {return b >= 0 ? (a >= 0 ? a : -a) : (a >= 0 ? -a : a);} + +inline float SIGN(const float &a, const double &b) + {return b >= 0 ? (a >= 0 ? a : -a) : (a >= 0 ? -a : a);} + +inline float SIGN(const double &a, const float &b) + {return b >= 0 ? (a >= 0 ? a : -a) : (a >= 0 ? -a : a);} + +template +inline void SWAP(T &a, T &b) + {T dum=a; a=b; b=dum;} + +namespace NR { + inline void nrerror(const string error_text) + // Numerical Recipes standard error handler + { + cerr << "Numerical Recipes run-time error..." << endl; + cerr << error_text << endl; + cerr << "...now exiting to system..." << endl; + exit(1); + } +} + +#include "tnt/tnt.h" +#include "tnt/vec.h" +#include "tnt/cmat.h" + +// TNT Wrapper File +// This is the file that "joins" the TNT Vector<> and Matrix<> classes +// to the NRVec and NRMat classes by the Wrapper Class Method + +// NRVec contains a Vector and a &Vector. All its constructors, except the +// conversion constructor, create the Vector and point the &Vector to it. +// The conversion constructor only points the &Vector. All operations +// (size, subscript) are through the &Vector, which as a reference +// (not pointer) has no indirection overhead. + +template +class NRVec { +private: + TNT::Vector myvec; + TNT::Vector &myref; +public: + NRVec() : myvec(), myref(myvec) {} + explicit NRVec(const int n) : myvec(n), myref(myvec) {} + NRVec(const T &a, int n) : myvec(n,a), myref(myvec) {} + NRVec(const T *a, int n) : myvec(n,a), myref(myvec) {} + NRVec(TNT::Vector &rhs) : myref(rhs) {} + // conversion constructor makes a special NRVec pointing to Vector's data + // this handles Vector actual args sent to NRVec formal args in functions + NRVec(const NRVec& rhs) : myvec(rhs.myref), myref(myvec) {} + // copy constructor calls Vector copy constructor + inline NRVec& operator=(const NRVec& rhs) { myref=rhs.myref; return *this;} + // assignment operator calls Vector assignment operator + inline NRVec& operator=(const T& rhs) { myvec=rhs; return *this;} + // scalar assignment calls Vector assignment operator + inline int size() const {return myref.size();} + inline T & operator[](const int i) const {return myref[i];} + // return element i + inline operator TNT::Vector() const {return myref;} + // conversion operator to Vector + // this handles NRVec function return types when used in Vector expressions + ~NRVec() {} +}; + +template +class NRMat { +private: + TNT::Matrix mymat; + TNT::Matrix &myref; +public: + NRMat() : mymat(), myref(mymat) {} + NRMat(int n, int m) : mymat(n,m), myref(mymat) {} + NRMat(const T& a, int n, int m) : mymat(n,m,a), myref(mymat) {} + //Initialize to constant + NRMat(const T* a, int n, int m) : mymat(n,m,a), myref(mymat) {} + //Initialize to array + NRMat(TNT::Matrix &rhs) : myref(rhs) {} + // conversion constructor from Matrix + NRMat(const NRMat& rhs) : mymat(rhs.myref), myref(mymat) {} + // copy constructor + inline NRMat& operator=(const NRMat& rhs) { myref=rhs.myref; return *this;} + // assignment operator + inline NRMat& operator=(const T& rhs) { mymat=rhs; return *this;} + // scalar assignment calls Matrix assignment operator + inline T* operator[](const int i) const {return myref[i];} + //subscripting: pointer to row i + //return type is whatever Matrix returns for a single [] dereference + inline int nrows() const {return myref.num_rows();} + inline int ncols() const {return myref.num_cols();} + inline operator TNT::Matrix() const {return myref;} + // conversion operator to Matrix + ~NRMat() {} +}; + +template +class NRMat3d { +private: + int nn; + int mm; + int kk; + T ***v; +public: + NRMat3d(); + NRMat3d(int n, int m, int k); + inline T** operator[](const int i); //subscripting: pointer to row i + inline const T* const * operator[](const int i) const; + inline int dim1() const; + inline int dim2() const; + inline int dim3() const; + ~NRMat3d(); +}; + +template +NRMat3d::NRMat3d(): nn(0), mm(0), kk(0), v(0) {} + +template +NRMat3d::NRMat3d(int n, int m, int k) : nn(n), mm(m), kk(k), v(new T**[n]) +{ + int i,j; + v[0] = new T*[n*m]; + v[0][0] = new T[n*m*k]; + for(j=1; j +inline T** NRMat3d::operator[](const int i) //subscripting: pointer to row i +{ + return v[i]; +} + +template +inline const T* const * NRMat3d::operator[](const int i) const +{ + return v[i]; +} + +template +inline int NRMat3d::dim1() const +{ + return nn; +} + +template +inline int NRMat3d::dim2() const +{ + return mm; +} + +template +inline int NRMat3d::dim3() const +{ + return kk; +} + +template +NRMat3d::~NRMat3d() +{ + if (v != 0) { + delete[] (v[0][0]); + delete[] (v[0]); + delete[] (v); + } +} + +//The next 3 classes are used in artihmetic coding, Huffman coding, and +//wavelet transforms respectively. This is as good a place as any to put them! + +class arithcode { +private: + NRVec *ilob_p,*iupb_p,*ncumfq_p; +public: + NRVec &ilob,&iupb,&ncumfq; + unsigned long jdif,nc,minint,nch,ncum,nrad; + arithcode(unsigned long n1, unsigned long n2, unsigned long n3) + : ilob_p(new NRVec(n1)), + iupb_p(new NRVec(n2)), + ncumfq_p(new NRVec(n3)), + ilob(*ilob_p),iupb(*iupb_p),ncumfq(*ncumfq_p) {} + ~arithcode() { + if (ilob_p != 0) delete ilob_p; + if (iupb_p != 0) delete iupb_p; + if (ncumfq_p != 0) delete ncumfq_p; + } +}; + +class huffcode { +private: + NRVec *icod_p,*ncod_p,*left_p,*right_p; +public: + NRVec &icod,&ncod,&left,&right; + int nch,nodemax; + huffcode(unsigned long n1, unsigned long n2, unsigned long n3, + unsigned long n4) : + icod_p(new NRVec(n1)), + ncod_p(new NRVec(n2)), + left_p(new NRVec(n3)), + right_p(new NRVec(n4)), + icod(*icod_p),ncod(*ncod_p),left(*left_p),right(*right_p) {} + ~huffcode() { + if (icod_p != 0) delete icod_p; + if (ncod_p != 0) delete ncod_p; + if (left_p != 0) delete left_p; + if (right_p != 0) delete right_p; + } +}; + +class wavefilt { +private: + NRVec *cc_p,*cr_p; +public: + int ncof,ioff,joff; + NRVec &cc,&cr; + wavefilt() : cc(*cc_p),cr(*cr_p) {} + wavefilt(const DP *a, const int n) : //initialize to array + cc_p(new NRVec(n)),cr_p(new NRVec(n)), + ncof(n),ioff(-(n >> 1)),joff(-(n >> 1)),cc(*cc_p),cr(*cr_p) { + int i; + for (i=0; i + +inline const complex operator+(const double &a, + const complex &b) { return float(a)+b; } + +inline const complex operator+(const complex &a, + const double &b) { return a+float(b); } + +inline const complex operator-(const double &a, + const complex &b) { return float(a)-b; } + +inline const complex operator-(const complex &a, + const double &b) { return a-float(b); } + +inline const complex operator*(const double &a, + const complex &b) { return float(a)*b; } + +inline const complex operator*(const complex &a, + const double &b) { return a*float(b); } + +inline const complex operator/(const double &a, + const complex &b) { return float(a)/b; } + +inline const complex operator/(const complex &a, + const double &b) { return a/float(b); } + +//some compilers choke on pow(float,double) in single precision. also atan2 + +inline float pow (float x, double y) {return pow(double(x),y);} +inline float pow (double x, float y) {return pow(x,double(y));} +inline float atan2 (float x, double y) {return atan2(double(x),y);} +inline float atan2 (double x, float y) {return atan2(x,double(y));} +#endif /* _NR_UTIL_H_ */ diff --git a/lib/nr/cpp/other/nrutil_val.h b/lib/nr/cpp/other/nrutil_val.h new file mode 100644 index 0000000..f5693e2 --- /dev/null +++ b/lib/nr/cpp/other/nrutil_val.h @@ -0,0 +1,377 @@ +#ifndef _NR_UTIL_H_ +#define _NR_UTIL_H_ + +#include +#include +#include +#include +using namespace std; + +typedef double DP; + +template +inline const T SQR(const T a) {return a*a;} + +template +inline const T MAX(const T &a, const T &b) + {return b > a ? (b) : (a);} + +inline float MAX(const double &a, const float &b) + {return b > a ? (b) : float(a);} + +inline float MAX(const float &a, const double &b) + {return b > a ? float(b) : (a);} + +template +inline const T MIN(const T &a, const T &b) + {return b < a ? (b) : (a);} + +inline float MIN(const double &a, const float &b) + {return b < a ? (b) : float(a);} + +inline float MIN(const float &a, const double &b) + {return b < a ? float(b) : (a);} + +template +inline const T SIGN(const T &a, const T &b) + {return b >= 0 ? (a >= 0 ? a : -a) : (a >= 0 ? -a : a);} + +inline float SIGN(const float &a, const double &b) + {return b >= 0 ? (a >= 0 ? a : -a) : (a >= 0 ? -a : a);} + +inline float SIGN(const double &a, const float &b) + {return b >= 0 ? (a >= 0 ? a : -a) : (a >= 0 ? -a : a);} + +template +inline void SWAP(T &a, T &b) + {T dum=a; a=b; b=dum;} + +namespace NR { + inline void nrerror(const string error_text) + // Numerical Recipes standard error handler + { + cerr << "Numerical Recipes run-time error..." << endl; + cerr << error_text << endl; + cerr << "...now exiting to system..." << endl; + exit(1); + } +} + +#define NRVec valarray +#include + +template +class NRMat { +private: + int nn; + int mm; + T **v; +public: + NRMat(); + NRMat(int n, int m); // Zero-based array + NRMat(const T &a, int n, int m); //Initialize to constant + NRMat(const T *a, int n, int m); // Initialize to array + NRMat(const NRMat &rhs); // Copy constructor + NRMat & operator=(const NRMat &rhs); //assignment + NRMat & operator=(const T &a); //assign a to every element + inline T* operator[](const int i); //subscripting: pointer to row i + inline const T* operator[](const int i) const; + inline int nrows() const; + inline int ncols() const; + ~NRMat(); +}; + +template +NRMat::NRMat() : nn(0), mm(0), v(0) {} + +template +NRMat::NRMat(int n, int m) : nn(n), mm(m), v(new T*[n]) +{ + v[0] = new T[m*n]; + for (int i=1; i< n; i++) + v[i] = v[i-1] + m; +} + +template +NRMat::NRMat(const T &a, int n, int m) : nn(n), mm(m), v(new T*[n]) +{ + int i,j; + v[0] = new T[m*n]; + for (i=1; i< n; i++) + v[i] = v[i-1] + m; + for (i=0; i< n; i++) + for (j=0; j +NRMat::NRMat(const T *a, int n, int m) : nn(n), mm(m), v(new T*[n]) +{ + int i,j; + v[0] = new T[m*n]; + for (i=1; i< n; i++) + v[i] = v[i-1] + m; + for (i=0; i< n; i++) + for (j=0; j +NRMat::NRMat(const NRMat &rhs) : nn(rhs.nn), mm(rhs.mm), v(new T*[nn]) +{ + int i,j; + v[0] = new T[mm*nn]; + for (i=1; i< nn; i++) + v[i] = v[i-1] + mm; + for (i=0; i< nn; i++) + for (j=0; j +NRMat & NRMat::operator=(const NRMat &rhs) +// postcondition: normal assignment via copying has been performed; +// if matrix and rhs were different sizes, matrix +// has been resized to match the size of rhs +{ + if (this != &rhs) { + int i,j; + if (nn != rhs.nn || mm != rhs.mm) { + if (v != 0) { + delete[] (v[0]); + delete[] (v); + } + nn=rhs.nn; + mm=rhs.mm; + v = new T*[nn]; + v[0] = new T[mm*nn]; + } + for (i=1; i< nn; i++) + v[i] = v[i-1] + mm; + for (i=0; i< nn; i++) + for (j=0; j +NRMat & NRMat::operator=(const T &a) //assign a to every element +{ + for (int i=0; i< nn; i++) + for (int j=0; j +inline T* NRMat::operator[](const int i) //subscripting: pointer to row i +{ + return v[i]; +} + +template +inline const T* NRMat::operator[](const int i) const +{ + return v[i]; +} + +template +inline int NRMat::nrows() const +{ + return nn; +} + +template +inline int NRMat::ncols() const +{ + return mm; +} + +template +NRMat::~NRMat() +{ + if (v != 0) { + delete[] (v[0]); + delete[] (v); + } +} + +template +class NRMat3d { +private: + int nn; + int mm; + int kk; + T ***v; +public: + NRMat3d(); + NRMat3d(int n, int m, int k); + inline T** operator[](const int i); //subscripting: pointer to row i + inline const T* const * operator[](const int i) const; + inline int dim1() const; + inline int dim2() const; + inline int dim3() const; + ~NRMat3d(); +}; + +template +NRMat3d::NRMat3d(): nn(0), mm(0), kk(0), v(0) {} + +template +NRMat3d::NRMat3d(int n, int m, int k) : nn(n), mm(m), kk(k), v(new T**[n]) +{ + int i,j; + v[0] = new T*[n*m]; + v[0][0] = new T[n*m*k]; + for(j=1; j +inline T** NRMat3d::operator[](const int i) //subscripting: pointer to row i +{ + return v[i]; +} + +template +inline const T* const * NRMat3d::operator[](const int i) const +{ + return v[i]; +} + +template +inline int NRMat3d::dim1() const +{ + return nn; +} + +template +inline int NRMat3d::dim2() const +{ + return mm; +} + +template +inline int NRMat3d::dim3() const +{ + return kk; +} + +template +NRMat3d::~NRMat3d() +{ + if (v != 0) { + delete[] (v[0][0]); + delete[] (v[0]); + delete[] (v); + } +} + +//The next 3 classes are used in artihmetic coding, Huffman coding, and +//wavelet transforms respectively. This is as good a place as any to put them! + +class arithcode { +private: + NRVec *ilob_p,*iupb_p,*ncumfq_p; +public: + NRVec &ilob,&iupb,&ncumfq; + unsigned long jdif,nc,minint,nch,ncum,nrad; + arithcode(unsigned long n1, unsigned long n2, unsigned long n3) + : ilob_p(new NRVec(n1)), + iupb_p(new NRVec(n2)), + ncumfq_p(new NRVec(n3)), + ilob(*ilob_p),iupb(*iupb_p),ncumfq(*ncumfq_p) {} + ~arithcode() { + if (ilob_p != 0) delete ilob_p; + if (iupb_p != 0) delete iupb_p; + if (ncumfq_p != 0) delete ncumfq_p; + } +}; + +class huffcode { +private: + NRVec *icod_p,*ncod_p,*left_p,*right_p; +public: + NRVec &icod,&ncod,&left,&right; + int nch,nodemax; + huffcode(unsigned long n1, unsigned long n2, unsigned long n3, + unsigned long n4) : + icod_p(new NRVec(n1)), + ncod_p(new NRVec(n2)), + left_p(new NRVec(n3)), + right_p(new NRVec(n4)), + icod(*icod_p),ncod(*ncod_p),left(*left_p),right(*right_p) {} + ~huffcode() { + if (icod_p != 0) delete icod_p; + if (ncod_p != 0) delete ncod_p; + if (left_p != 0) delete left_p; + if (right_p != 0) delete right_p; + } +}; + +class wavefilt { +private: + NRVec *cc_p,*cr_p; +public: + int ncof,ioff,joff; + NRVec &cc,&cr; + wavefilt() : cc(*cc_p),cr(*cr_p) {} + wavefilt(const DP *a, const int n) : //initialize to array + cc_p(new NRVec(n)),cr_p(new NRVec(n)), + ncof(n),ioff(-(n >> 1)),joff(-(n >> 1)),cc(*cc_p),cr(*cr_p) { + int i; + for (i=0; i + +inline const complex operator+(const double &a, + const complex &b) { return float(a)+b; } + +inline const complex operator+(const complex &a, + const double &b) { return a+float(b); } + +inline const complex operator-(const double &a, + const complex &b) { return float(a)-b; } + +inline const complex operator-(const complex &a, + const double &b) { return a-float(b); } + +inline const complex operator*(const double &a, + const complex &b) { return float(a)*b; } + +inline const complex operator*(const complex &a, + const double &b) { return a*float(b); } + +inline const complex operator/(const double &a, + const complex &b) { return float(a)/b; } + +inline const complex operator/(const complex &a, + const double &b) { return a/float(b); } + +//some compilers choke on pow(float,double) in single precision. also atan2 + +inline float pow (float x, double y) {return pow(double(x),y);} +inline float pow (double x, float y) {return pow(x,double(y));} +inline float atan2 (float x, double y) {return atan2(double(x),y);} +inline float atan2 (double x, float y) {return atan2(x,double(y));} +#endif /* _NR_UTIL_H_ */ diff --git a/lib/nr/cpp/other/print_array.h b/lib/nr/cpp/other/print_array.h new file mode 100644 index 0000000..ac97d69 --- /dev/null +++ b/lib/nr/cpp/other/print_array.h @@ -0,0 +1,26 @@ +#ifndef _PRINT_ARR_ +#define _PRINT_ARR_ + +#include +#include +#include "nrutil.h" +using namespace std; + +template +void print_array(const NRVec &a, const int n_per_row, const int col_width) +{ + int i,j=0; + + int n_elements=a.size(); + for (i=0; i < n_elements; i++) { + if (j == n_per_row) { + cout << endl; + j=0; + } + cout << setw(col_width) << a[i]; + j++; + } + cout << endl; +} + +#endif /* _PRINT_ARR_ */ diff --git a/lib/nr/cpp/recipes/addint.cpp b/lib/nr/cpp/recipes/addint.cpp new file mode 100644 index 0000000..139173c --- /dev/null +++ b/lib/nr/cpp/recipes/addint.cpp @@ -0,0 +1,12 @@ +#include "nr.h" + +void NR::addint(Mat_O_DP &uf, Mat_I_DP &uc, Mat_O_DP &res) +{ + int i,j; + + int nf=uf.nrows(); + interp(res,uc); + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::airy(const DP x, DP &ai, DP &bi, DP &aip, DP &bip) +{ + const DP PI=3.141592653589793238, ONOVRT=0.577350269189626; + const DP THIRD=(1.0/3.0), TWOTHR=2.0*THIRD; + DP absx,ri,rip,rj,rjp,rk,rkp,rootx,ry,ryp,z; + + absx=fabs(x); + rootx=sqrt(absx); + z=TWOTHR*absx*rootx; + if (x > 0.0) { + bessik(z,THIRD,ri,rk,rip,rkp); + ai=rootx*ONOVRT*rk/PI; + bi=rootx*(rk/PI+2.0*ONOVRT*ri); + bessik(z,TWOTHR,ri,rk,rip,rkp); + aip = -x*ONOVRT*rk/PI; + bip=x*(rk/PI+2.0*ONOVRT*ri); + } else if (x < 0.0) { + bessjy(z,THIRD,rj,ry,rjp,ryp); + ai=0.5*rootx*(rj-ONOVRT*ry); + bi = -0.5*rootx*(ry+ONOVRT*rj); + bessjy(z,TWOTHR,rj,ry,rjp,ryp); + aip=0.5*absx*(ONOVRT*ry+rj); + bip=0.5*absx*(ONOVRT*rj-ry); + } else { + ai=0.355028053887817; + bi=ai/ONOVRT; + aip = -0.258819403792807; + bip = -aip/ONOVRT; + } +} diff --git a/lib/nr/cpp/recipes/amebsa.cpp b/lib/nr/cpp/recipes/amebsa.cpp new file mode 100644 index 0000000..f11756a --- /dev/null +++ b/lib/nr/cpp/recipes/amebsa.cpp @@ -0,0 +1,89 @@ +#include +#include "nr.h" +using namespace std; + +namespace { + inline void get_psum(Mat_I_DP &p, Vec_O_DP &psum) + { + int n,m; + DP sum; + + int mpts=p.nrows(); + int ndim=p.ncols(); + for (n=0;n yhi) { + ihi=0; + ilo=1; + ynhi=yhi; + yhi=ylo; + ylo=ynhi; + } + for (i=3;i<=mpts;i++) { + yt=y[i-1]+tt*log(ran1(idum)); + if (yt <= ylo) { + ilo=i-1; + ylo=yt; + } + if (yt > yhi) { + ynhi=yhi; + ihi=i-1; + yhi=yt; + } else if (yt > ynhi) { + ynhi=yt; + } + } + rtol=2.0*fabs(yhi-ylo)/(fabs(yhi)+fabs(ylo)); + if (rtol < ftol || iter < 0) { + SWAP(y[0],y[ilo]); + for (n=0;n= ynhi) { + ysave=yhi; + ytry=amotsa(p,y,psum,pb,yb,funk,ihi,yhi,0.5); + if (ytry >= ysave) { + for (i=0;i +#include "nr.h" +using namespace std; + +namespace { + inline void get_psum(Mat_I_DP &p, Vec_O_DP &psum) + { + int i,j; + DP sum; + + int mpts=p.nrows(); + int ndim=p.ncols(); + for (j=0;jy[1] ? (inhi=1,0) : (inhi=0,1); + for (i=0;i y[ihi]) { + inhi=ihi; + ihi=i; + } else if (y[i] > y[inhi] && i != ihi) inhi=i; + } + rtol=2.0*fabs(y[ihi]-y[ilo])/(fabs(y[ihi])+fabs(y[ilo])+TINY); + if (rtol < ftol) { + SWAP(y[0],y[ilo]); + for (i=0;i= NMAX) nrerror("NMAX exceeded"); + nfunk += 2; + ytry=amotry(p,y,psum,funk,ihi,-1.0); + if (ytry <= y[ilo]) + ytry=amotry(p,y,psum,funk,ihi,2.0); + else if (ytry >= y[inhi]) { + ysave=y[ihi]; + ytry=amotry(p,y,psum,funk,ihi,0.5); + if (ytry >= ysave) { + for (i=0;i +#include "nr.h" +using namespace std; + +extern int idum; +extern DP tt; + +DP NR::amotsa(Mat_IO_DP &p, Vec_O_DP &y, Vec_IO_DP &psum, Vec_O_DP &pb, DP &yb, + DP funk(Vec_I_DP &), const int ihi, DP &yhi, const DP fac) +{ + int j; + DP fac1,fac2,yflu,ytry; + + int ndim=p.ncols(); + Vec_DP ptry(ndim); + fac1=(1.0-fac)/ndim; + fac2=fac1-fac; + for (j=0;j +#include +#include +#include +#include "nr.h" +using namespace std; + +namespace { + inline DP alen(const DP a, const DP b, const DP c, const DP d) + { + return sqrt((b-a)*(b-a)+(d-c)*(d-c)); + } +} + +void NR::anneal(Vec_I_DP &x, Vec_I_DP &y, Vec_IO_INT &iorder) +{ + const DP TFACTR=0.9; + bool ans; + int i,i1,i2,idec,idum,j,k,nn,nover,nlimit,nsucc; + static Vec_INT n(6); + unsigned long iseed; + DP path,de,t; + + int ncity=x.size(); + nover=100*ncity; + nlimit=10*ncity; + path=0.0; + t=0.5; + for (i=0;i= n[0]) ++n[1]; + nn=(n[0]-n[1]+ncity-1) % ncity; + } while (nn<2); + idec=irbit1(iseed); + if (idec == 0) { + n[2]=n[1]+int(abs(nn-1)*ran3(idum))+1; + n[2] %= ncity; + de=trncst(x,y,iorder,n); + ans=metrop(de,t); + if (ans) { + ++nsucc; + path += de; + trnspt(iorder,n); + } + } else { + de=revcst(x,y,iorder,n); + ans=metrop(de,t); + if (ans) { + ++nsucc; + path += de; + reverse(iorder,n); + } + } + if (nsucc >= nlimit) break; + } + cout << endl << "T = " << setw(12) << t; + cout << " Path Length = " << setw(12) << path << endl; + cout << "Successful Moves: " << nsucc << endl; + t *= TFACTR; + if (nsucc == 0) return; + } +} diff --git a/lib/nr/cpp/recipes/anorm2.cpp b/lib/nr/cpp/recipes/anorm2.cpp new file mode 100644 index 0000000..82f2ed6 --- /dev/null +++ b/lib/nr/cpp/recipes/anorm2.cpp @@ -0,0 +1,15 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::anorm2(Mat_I_DP &a) +{ + int i,j; + DP sum=0.0; + + int n=a.nrows(); + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::arcmak(Vec_I_ULNG &nfreq, unsigned long nchh, unsigned long nradd, + arithcode &acode) +{ + const unsigned long MAXULNG=numeric_limits::max(); + unsigned long j; + + unsigned long MC=acode.ncumfq.size()-2; + if (nchh > MC) nrerror("input radix may not exceed MC in arcmak."); + if (nradd > 256) nrerror("output radix may not exceed 256 in arcmak."); + + acode.minint=MAXULNG/nradd; + acode.nch=nchh; + acode.nrad=nradd; + acode.ncumfq[0]=0; + for (j=1;j<=acode.nch;j++) + acode.ncumfq[j]=acode.ncumfq[j-1]+MAX(nfreq[j-1],(unsigned long) 1); + acode.ncum=acode.ncumfq[acode.nch+1]=acode.ncumfq[acode.nch]+1; +} diff --git a/lib/nr/cpp/recipes/arcode.cpp b/lib/nr/cpp/recipes/arcode.cpp new file mode 100644 index 0000000..c16fb09 --- /dev/null +++ b/lib/nr/cpp/recipes/arcode.cpp @@ -0,0 +1,72 @@ +#include "nr.h" + +namespace { + inline unsigned long JTRY(const unsigned long j, const unsigned long k, + const unsigned long m) + { + return (unsigned long) (DP(j)*DP(k)/DP (m)); + } +} + +void NR::arcode(unsigned long &ich, string &code, unsigned long &lcd, + const int isign, arithcode &acode) +{ + int j,k; + unsigned long ihi,ja,jh,jl,m; + + int NWK=acode.ilob.size(); + if (isign == 0) { + acode.jdif=acode.nrad-1; + for (j=NWK-1;j>=0;j--) { + acode.iupb[j]=acode.nrad-1; + acode.ilob[j]=0; + acode.nc=j; + if (acode.jdif > acode.minint) return; + acode.jdif=(acode.jdif+1)*acode.nrad-1; + } + nrerror("NWK too small in arcode."); + } else { + if (isign > 0) { + if (ich > acode.nch) nrerror("bad ich in arcode."); + } else { + ja=(unsigned char) code[lcd]-acode.ilob[acode.nc]; + for (j=acode.nc+1;j 1) { + m=(ich+ihi)>>1; + if (ja >= JTRY(acode.jdif,acode.ncumfq[m],acode.ncum)) + ich=m; + else ihi=m; + } + if (ich == acode.nch) return; + } + jh=JTRY(acode.jdif,acode.ncumfq[ich+1],acode.ncum); + jl=JTRY(acode.jdif,acode.ncumfq[ich],acode.ncum); + acode.jdif=jh-jl; + arcsum(acode.ilob,acode.iupb,jh,NWK,acode.nrad,acode.nc); + arcsum(acode.ilob,acode.ilob,jl,NWK,acode.nrad,acode.nc); + for (j=acode.nc;j 0) code += (unsigned char)acode.ilob[j]; + lcd++; + } + if (j+1 > NWK) return; + acode.nc=j; + for(j=0;acode.jdif acode.nc) nrerror("NWK too small in arcode."); + if (j != 0) { + for (k=acode.nc;knc;j--) { + jtmp=ja; + ja /= nrad; + iout[j]=iin[j]+(jtmp-ja*nrad)+karry; + if (iout[j] >= nrad) { + iout[j] -= nrad; + karry=1; + } else karry=0; + } + iout[nc]=iin[nc]+ja+karry; +} diff --git a/lib/nr/cpp/recipes/asolve.cpp b/lib/nr/cpp/recipes/asolve.cpp new file mode 100644 index 0000000..94c5882 --- /dev/null +++ b/lib/nr/cpp/recipes/asolve.cpp @@ -0,0 +1,12 @@ +#include "nr.h" + +extern Vec_INT *ija_p; +extern Vec_DP *sa_p; + +void NR::asolve(Vec_I_DP &b, Vec_O_DP &x, const int itrnsp) +{ + int i; + + int n=b.size(); + for(i=0;i +#include +#include +#include "nr.h" +using namespace std; + +int main(void) // Program badluk +{ + const int IYBEG=2000,IYEND=2100; + const DP ZON=-5.0; + int ic,icon,idwk,im,iyyy,jd,jday,n; + DP timzon=ZON/24.0,frac; + + cout << endl << "Full moons on Friday the 13th from "; + cout << setw(5) << IYBEG << " to " << setw(5) << IYEND << endl; + for (iyyy=IYBEG;iyyy<=IYEND;iyyy++) { + for (im=1;im<=12;im++) { + jday=NR::julday(im,13,iyyy); + idwk=int((jday+1) % 7); + if (idwk == 5) { + n=int(12.37*(iyyy-1900+(im-0.5)/12.0)); + icon=0; + for (;;) { + NR::flmoon(n,2,jd,frac); + frac=24.0*(frac+timzon); + if (frac < 0.0) { + --jd; + frac += 24.0; + } + if (frac > 12.0) { + ++jd; + frac -= 12.0; + } else + frac += 12.0; + if (jd == jday) { + cout << endl << setw(2) << im; + cout << "/13/" << setw(4) << iyyy << endl; + cout << fixed << setprecision(1); + cout << "Full moon" << setw(6) << frac; + cout << " hrs after midnight (EST)" << endl; + break; + } else { + ic=(jday >= jd ? 1 : -1); + if (ic == (-icon)) break; + icon=ic; + n += ic; + } + } + } + } + } + return 0; +} diff --git a/lib/nr/cpp/recipes/balanc.cpp b/lib/nr/cpp/recipes/balanc.cpp new file mode 100644 index 0000000..98f89e5 --- /dev/null +++ b/lib/nr/cpp/recipes/balanc.cpp @@ -0,0 +1,45 @@ +#include +#include +#include "nr.h" +using namespace std; + +void NR::balanc(Mat_IO_DP &a) +{ + const DP RADIX = numeric_limits::radix; + int i,j,last=0; + DP s,r,g,f,c,sqrdx; + + int n=a.nrows(); + sqrdx=RADIX*RADIX; + while (last == 0) { + last=1; + for (i=0;ig) { + f /= RADIX; + c /= sqrdx; + } + if ((c+r)/f < 0.95*s) { + last=0; + g=1.0/f; + for (j=0;j=0;i--) { + dum=b[i]; + for (k=1;k +#include "nr.h" +using namespace std; + +void NR::bandec(Mat_IO_DP &a, const int m1, const int m2, Mat_O_DP &al, + Vec_O_INT &indx, DP &d) +{ + const DP TINY=1.0e-20; + int i,j,k,l,mm; + DP dum; + + int n=a.nrows(); + mm=m1+m2+1; + l=m1; + for (i=0;i fabs(dum)) { + dum=a[j][0]; + i=j; + } + } + indx[k]=i+1; + if (dum == 0.0) a[k][0]=TINY; + if (i != k) { + d = -d; + for (j=0;j=0;i--) { + ansy=t*ansy+((c[i][3]*u+c[i][2])*u+c[i][1])*u+c[i][0]; + ansy2=t*ansy2+(3.0*c[i][3]*u+2.0*c[i][2])*u+c[i][1]; + ansy1=u*ansy1+(3.0*c[3][i]*t+2.0*c[2][i])*t+c[1][i]; + } + ansy1 /= d1; + ansy2 /= d2; +} diff --git a/lib/nr/cpp/recipes/beschb.cpp b/lib/nr/cpp/recipes/beschb.cpp new file mode 100644 index 0000000..dabbae7 --- /dev/null +++ b/lib/nr/cpp/recipes/beschb.cpp @@ -0,0 +1,22 @@ +#include "nr.h" + +void NR::beschb(const DP x, DP &gam1, DP &gam2, DP &gampl, DP &gammi) +{ + const int NUSE1=7, NUSE2=8; + static const DP c1_d[7] = { + -1.142022680371168e0,6.5165112670737e-3, + 3.087090173086e-4,-3.4706269649e-6,6.9437664e-9, + 3.67795e-11,-1.356e-13}; + static const DP c2_d[8] = { + 1.843740587300905e0,-7.68528408447867e-2, + 1.2719271366546e-3,-4.9717367042e-6,-3.31261198e-8, + 2.423096e-10,-1.702e-13,-1.49e-15}; + DP xx; + static Vec_DP c1(c1_d,7),c2(c2_d,8); + + xx=8.0*x*x-1.0; + gam1=chebev(-1.0,1.0,c1,NUSE1,xx); + gam2=chebev(-1.0,1.0,c2,NUSE2,xx); + gampl= gam2-x*gam1; + gammi= gam2+x*gam1; +} diff --git a/lib/nr/cpp/recipes/bessi.cpp b/lib/nr/cpp/recipes/bessi.cpp new file mode 100644 index 0000000..aac4069 --- /dev/null +++ b/lib/nr/cpp/recipes/bessi.cpp @@ -0,0 +1,34 @@ +#include +#include +#include "nr.h" +using namespace std; + +DP NR::bessi(const int n, const DP x) +{ + const DP ACC=200.0; + const int IEXP=numeric_limits::max_exponent/2; + int j,k; + DP bi,bim,bip,dum,tox,ans; + + if (n < 2) nrerror("Index n less than 2 in bessi"); + if (x*x <= 8.0*numeric_limits::min()) return 0.0; + else { + tox=2.0/fabs(x); + bip=ans=0.0; + bi=1.0; + for (j=2*(n+int(sqrt(ACC*n)));j>0;j--) { + bim=bip+j*tox*bi; + bip=bi; + bi=bim; + dum=frexp(bi,&k); + if (k > IEXP) { + ans=ldexp(ans,-IEXP); + bi=ldexp(bi,-IEXP); + bip=ldexp(bip,-IEXP); + } + if (j == n) ans=bip; + } + ans *= bessi0(x)/bi; + return x < 0.0 && (n & 1) ? -ans : ans; + } +} diff --git a/lib/nr/cpp/recipes/bessi0.cpp b/lib/nr/cpp/recipes/bessi0.cpp new file mode 100644 index 0000000..8e40a62 --- /dev/null +++ b/lib/nr/cpp/recipes/bessi0.cpp @@ -0,0 +1,22 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::bessi0(const DP x) +{ + DP ax,ans,y; + + if ((ax=fabs(x)) < 3.75) { + y=x/3.75; + y*=y; + ans=1.0+y*(3.5156229+y*(3.0899424+y*(1.2067492 + +y*(0.2659732+y*(0.360768e-1+y*0.45813e-2))))); + } else { + y=3.75/ax; + ans=(exp(ax)/sqrt(ax))*(0.39894228+y*(0.1328592e-1 + +y*(0.225319e-2+y*(-0.157565e-2+y*(0.916281e-2 + +y*(-0.2057706e-1+y*(0.2635537e-1+y*(-0.1647633e-1 + +y*0.392377e-2)))))))); + } + return ans; +} diff --git a/lib/nr/cpp/recipes/bessi1.cpp b/lib/nr/cpp/recipes/bessi1.cpp new file mode 100644 index 0000000..75c61b3 --- /dev/null +++ b/lib/nr/cpp/recipes/bessi1.cpp @@ -0,0 +1,23 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::bessi1(const DP x) +{ + DP ax,ans,y; + + if ((ax=fabs(x)) < 3.75) { + y=x/3.75; + y*=y; + ans=ax*(0.5+y*(0.87890594+y*(0.51498869+y*(0.15084934 + +y*(0.2658733e-1+y*(0.301532e-2+y*0.32411e-3)))))); + } else { + y=3.75/ax; + ans=0.2282967e-1+y*(-0.2895312e-1+y*(0.1787654e-1 + -y*0.420059e-2)); + ans=0.39894228+y*(-0.3988024e-1+y*(-0.362018e-2 + +y*(0.163801e-2+y*(-0.1031555e-1+y*ans)))); + ans *= (exp(ax)/sqrt(ax)); + } + return x < 0.0 ? -ans : ans; +} diff --git a/lib/nr/cpp/recipes/bessik.cpp b/lib/nr/cpp/recipes/bessik.cpp new file mode 100644 index 0000000..66027bc --- /dev/null +++ b/lib/nr/cpp/recipes/bessik.cpp @@ -0,0 +1,121 @@ +#include +#include +#include "nr.h" +using namespace std; + +void NR::bessik(const DP x, const DP xnu, DP &ri, DP &rk, DP &rip, DP &rkp) +{ + const int MAXIT=10000; + const DP EPS=numeric_limits::epsilon(); + const DP FPMIN=numeric_limits::min()/EPS; + const DP XMIN=2.0, PI=3.141592653589793; + DP a,a1,b,c,d,del,del1,delh,dels,e,f,fact,fact2,ff,gam1,gam2, + gammi,gampl,h,p,pimu,q,q1,q2,qnew,ril,ril1,rimu,rip1,ripl, + ritemp,rk1,rkmu,rkmup,rktemp,s,sum,sum1,x2,xi,xi2,xmu,xmu2; + int i,l,nl; + + if (x <= 0.0 || xnu < 0.0) nrerror("bad arguments in bessik"); + nl=int(xnu+0.5); + xmu=xnu-nl; + xmu2=xmu*xmu; + xi=1.0/x; + xi2=2.0*xi; + h=xnu*xi; + if (h < FPMIN) h=FPMIN; + b=xi2*xnu; + d=0.0; + c=h; + for (i=0;i= MAXIT) + nrerror("x too large in bessik; try asymptotic expansion"); + ril=FPMIN; + ripl=h*ril; + ril1=ril; + rip1=ripl; + fact=xnu*xi; + for (l=nl-1;l >= 0;l--) { + ritemp=fact*ril+ripl; + fact -= xi; + ripl=fact*ritemp+ril; + ril=ritemp; + } + f=ripl/ril; + if (x < XMIN) { + x2=0.5*x; + pimu=PI*xmu; + fact = (fabs(pimu) < EPS ? 1.0 : pimu/sin(pimu)); + d = -log(x2); + e=xmu*d; + fact2 = (fabs(e) < EPS ? 1.0 : sinh(e)/e); + beschb(xmu,gam1,gam2,gampl,gammi); + ff=fact*(gam1*cosh(e)+gam2*fact2*d); + sum=ff; + e=exp(e); + p=0.5*e/gampl; + q=0.5/(e*gammi); + c=1.0; + d=x2*x2; + sum1=p; + for (i=1;i<=MAXIT;i++) { + ff=(i*ff+p+q)/(i*i-xmu2); + c *= (d/i); + p /= (i-xmu); + q /= (i+xmu); + del=c*ff; + sum += del; + del1=c*(p-i*ff); + sum1 += del1; + if (fabs(del) < fabs(sum)*EPS) break; + } + if (i > MAXIT) nrerror("bessk series failed to converge"); + rkmu=sum; + rk1=sum1*xi2; + } else { + b=2.0*(1.0+x); + d=1.0/b; + h=delh=d; + q1=0.0; + q2=1.0; + a1=0.25-xmu2; + q=c=a1; + a = -a1; + s=1.0+q*delh; + for (i=1;i= MAXIT) nrerror("bessik: failure to converge in cf2"); + h=a1*h; + rkmu=sqrt(PI/(2.0*x))*exp(-x)/s; + rk1=rkmu*(xmu+x+0.5-h)*xi; + } + rkmup=xmu*xi*rkmu-rk1; + rimu=xi/(f*rkmu-rkmup); + ri=(rimu*ril1)/ril; + rip=(rimu*rip1)/ril; + for (i=1;i <= nl;i++) { + rktemp=(xmu+i)*xi2*rk1+rkmu; + rkmu=rk1; + rk1=rktemp; + } + rk=rkmu; + rkp=xnu*xi*rkmu-rk1; +} diff --git a/lib/nr/cpp/recipes/bessj.cpp b/lib/nr/cpp/recipes/bessj.cpp new file mode 100644 index 0000000..634ef43 --- /dev/null +++ b/lib/nr/cpp/recipes/bessj.cpp @@ -0,0 +1,52 @@ +#include +#include +#include "nr.h" +using namespace std; + +DP NR::bessj(const int n, const DP x) +{ + const DP ACC=160.0; + const int IEXP=numeric_limits::max_exponent/2; + bool jsum; + int j,k,m; + DP ax,bj,bjm,bjp,dum,sum,tox,ans; + + if (n < 2) nrerror("Index n less than 2 in bessj"); + ax=fabs(x); + if (ax*ax <= 8.0*numeric_limits::min()) return 0.0; + else if (ax > DP(n)) { + tox=2.0/ax; + bjm=bessj0(ax); + bj=bessj1(ax); + for (j=1;j0;j--) { + bjm=j*tox*bj-bjp; + bjp=bj; + bj=bjm; + dum=frexp(bj,&k); + if (k > IEXP) { + bj=ldexp(bj,-IEXP); + bjp=ldexp(bjp,-IEXP); + ans=ldexp(ans,-IEXP); + sum=ldexp(sum,-IEXP); + } + if (jsum) sum += bj; + jsum=!jsum; + if (j == n) ans=bjp; + } + sum=2.0*sum-bj; + ans /= sum; + } + return x < 0.0 && (n & 1) ? -ans : ans; +} diff --git a/lib/nr/cpp/recipes/bessj0.cpp b/lib/nr/cpp/recipes/bessj0.cpp new file mode 100644 index 0000000..426f175 --- /dev/null +++ b/lib/nr/cpp/recipes/bessj0.cpp @@ -0,0 +1,28 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::bessj0(const DP x) +{ + DP ax,z,xx,y,ans,ans1,ans2; + + if ((ax=fabs(x)) < 8.0) { + y=x*x; + ans1=57568490574.0+y*(-13362590354.0+y*(651619640.7 + +y*(-11214424.18+y*(77392.33017+y*(-184.9052456))))); + ans2=57568490411.0+y*(1029532985.0+y*(9494680.718 + +y*(59272.64853+y*(267.8532712+y*1.0)))); + ans=ans1/ans2; + } else { + z=8.0/ax; + y=z*z; + xx=ax-0.785398164; + ans1=1.0+y*(-0.1098628627e-2+y*(0.2734510407e-4 + +y*(-0.2073370639e-5+y*0.2093887211e-6))); + ans2 = -0.1562499995e-1+y*(0.1430488765e-3 + +y*(-0.6911147651e-5+y*(0.7621095161e-6 + -y*0.934945152e-7))); + ans=sqrt(0.636619772/ax)*(cos(xx)*ans1-z*sin(xx)*ans2); + } + return ans; +} diff --git a/lib/nr/cpp/recipes/bessj1.cpp b/lib/nr/cpp/recipes/bessj1.cpp new file mode 100644 index 0000000..3ba8c14 --- /dev/null +++ b/lib/nr/cpp/recipes/bessj1.cpp @@ -0,0 +1,29 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::bessj1(const DP x) +{ + DP ax,z,xx,y,ans,ans1,ans2; + + if ((ax=fabs(x)) < 8.0) { + y=x*x; + ans1=x*(72362614232.0+y*(-7895059235.0+y*(242396853.1 + +y*(-2972611.439+y*(15704.48260+y*(-30.16036606)))))); + ans2=144725228442.0+y*(2300535178.0+y*(18583304.74 + +y*(99447.43394+y*(376.9991397+y*1.0)))); + ans=ans1/ans2; + } else { + z=8.0/ax; + y=z*z; + xx=ax-2.356194491; + ans1=1.0+y*(0.183105e-2+y*(-0.3516396496e-4 + +y*(0.2457520174e-5+y*(-0.240337019e-6)))); + ans2=0.04687499995+y*(-0.2002690873e-3 + +y*(0.8449199096e-5+y*(-0.88228987e-6 + +y*0.105787412e-6))); + ans=sqrt(0.636619772/ax)*(cos(xx)*ans1-z*sin(xx)*ans2); + if (x < 0.0) ans = -ans; + } + return ans; +} diff --git a/lib/nr/cpp/recipes/bessjy.cpp b/lib/nr/cpp/recipes/bessjy.cpp new file mode 100644 index 0000000..2e47b99 --- /dev/null +++ b/lib/nr/cpp/recipes/bessjy.cpp @@ -0,0 +1,150 @@ +#include +#include +#include "nr.h" +using namespace std; + +void NR::bessjy(const DP x, const DP xnu, DP &rj, DP &ry, DP &rjp, DP &ryp) +{ + const int MAXIT=10000; + const DP EPS=numeric_limits::epsilon(); + const DP FPMIN=numeric_limits::min()/EPS; + const DP XMIN=2.0, PI=3.141592653589793; + DP a,b,br,bi,c,cr,ci,d,del,del1,den,di,dlr,dli,dr,e,f,fact,fact2, + fact3,ff,gam,gam1,gam2,gammi,gampl,h,p,pimu,pimu2,q,r,rjl, + rjl1,rjmu,rjp1,rjpl,rjtemp,ry1,rymu,rymup,rytemp,sum,sum1, + temp,w,x2,xi,xi2,xmu,xmu2; + int i,isign,l,nl; + + if (x <= 0.0 || xnu < 0.0) + nrerror("bad arguments in bessjy"); + nl=(x < XMIN ? int(xnu+0.5) : MAX(0,int(xnu-x+1.5))); + xmu=xnu-nl; + xmu2=xmu*xmu; + xi=1.0/x; + xi2=2.0*xi; + w=xi2/PI; + isign=1; + h=xnu*xi; + if (h < FPMIN) h=FPMIN; + b=xi2*xnu; + d=0.0; + c=h; + for (i=0;i= MAXIT) + nrerror("x too large in bessjy; try asymptotic expansion"); + rjl=isign*FPMIN; + rjpl=h*rjl; + rjl1=rjl; + rjp1=rjpl; + fact=xnu*xi; + for (l=nl-1;l>=0;l--) { + rjtemp=fact*rjl+rjpl; + fact -= xi; + rjpl=fact*rjtemp-rjl; + rjl=rjtemp; + } + if (rjl == 0.0) rjl=EPS; + f=rjpl/rjl; + if (x < XMIN) { + x2=0.5*x; + pimu=PI*xmu; + fact = (fabs(pimu) < EPS ? 1.0 : pimu/sin(pimu)); + d = -log(x2); + e=xmu*d; + fact2 = (fabs(e) < EPS ? 1.0 : sinh(e)/e); + beschb(xmu,gam1,gam2,gampl,gammi); + ff=2.0/PI*fact*(gam1*cosh(e)+gam2*fact2*d); + e=exp(e); + p=e/(gampl*PI); + q=1.0/(e*PI*gammi); + pimu2=0.5*pimu; + fact3 = (fabs(pimu2) < EPS ? 1.0 : sin(pimu2)/pimu2); + r=PI*pimu2*fact3*fact3; + c=1.0; + d = -x2*x2; + sum=ff+r*q; + sum1=p; + for (i=1;i<=MAXIT;i++) { + ff=(i*ff+p+q)/(i*i-xmu2); + c *= (d/i); + p /= (i-xmu); + q /= (i+xmu); + del=c*(ff+r*q); + sum += del; + del1=c*p-i*del; + sum1 += del1; + if (fabs(del) < (1.0+fabs(sum))*EPS) break; + } + if (i > MAXIT) + nrerror("bessy series failed to converge"); + rymu = -sum; + ry1 = -sum1*xi2; + rymup=xmu*xi*rymu-ry1; + rjmu=w/(rymup-f*rymu); + } else { + a=0.25-xmu2; + p = -0.5*xi; + q=1.0; + br=2.0*x; + bi=2.0; + fact=a*xi/(p*p+q*q); + cr=br+q*fact; + ci=bi+p*fact; + den=br*br+bi*bi; + dr=br/den; + di = -bi/den; + dlr=cr*dr-ci*di; + dli=cr*di+ci*dr; + temp=p*dlr-q*dli; + q=p*dli+q*dlr; + p=temp; + for (i=1;i= MAXIT) nrerror("cf2 failed in bessjy"); + gam=(p-f)/q; + rjmu=sqrt(w/((p-f)*gam+q)); + rjmu=SIGN(rjmu,rjl); + rymu=rjmu*gam; + rymup=rymu*(p+q/gam); + ry1=xmu*xi*rymu-rymup; + } + fact=rjmu/rjl; + rj=rjl1*fact; + rjp=rjp1*fact; + for (i=1;i<=nl;i++) { + rytemp=(xmu+i)*xi2*ry1-rymu; + rymu=ry1; + ry1=rytemp; + } + ry=rymu; + ryp=xnu*xi*rymu-ry1; +} diff --git a/lib/nr/cpp/recipes/bessk.cpp b/lib/nr/cpp/recipes/bessk.cpp new file mode 100644 index 0000000..5da6790 --- /dev/null +++ b/lib/nr/cpp/recipes/bessk.cpp @@ -0,0 +1,18 @@ +#include "nr.h" + +DP NR::bessk(const int n, const DP x) +{ + int j; + DP bk,bkm,bkp,tox; + + if (n < 2) nrerror("Index n less than 2 in bessk"); + tox=2.0/x; + bkm=bessk0(x); + bk=bessk1(x); + for (j=1;j +#include "nr.h" +using namespace std; + +DP NR::bessk0(const DP x) +{ + DP y,ans; + + if (x <= 2.0) { + y=x*x/4.0; + ans=(-log(x/2.0)*bessi0(x))+(-0.57721566+y*(0.42278420 + +y*(0.23069756+y*(0.3488590e-1+y*(0.262698e-2 + +y*(0.10750e-3+y*0.74e-5)))))); + } else { + y=2.0/x; + ans=(exp(-x)/sqrt(x))*(1.25331414+y*(-0.7832358e-1 + +y*(0.2189568e-1+y*(-0.1062446e-1+y*(0.587872e-2 + +y*(-0.251540e-2+y*0.53208e-3)))))); + } + return ans; +} diff --git a/lib/nr/cpp/recipes/bessk1.cpp b/lib/nr/cpp/recipes/bessk1.cpp new file mode 100644 index 0000000..1243e59 --- /dev/null +++ b/lib/nr/cpp/recipes/bessk1.cpp @@ -0,0 +1,21 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::bessk1(const DP x) +{ + DP y,ans; + + if (x <= 2.0) { + y=x*x/4.0; + ans=(log(x/2.0)*bessi1(x))+(1.0/x)*(1.0+y*(0.15443144 + +y*(-0.67278579+y*(-0.18156897+y*(-0.1919402e-1 + +y*(-0.110404e-2+y*(-0.4686e-4))))))); + } else { + y=2.0/x; + ans=(exp(-x)/sqrt(x))*(1.25331414+y*(0.23498619 + +y*(-0.3655620e-1+y*(0.1504268e-1+y*(-0.780353e-2 + +y*(0.325614e-2+y*(-0.68245e-3))))))); + } + return ans; +} diff --git a/lib/nr/cpp/recipes/bessy.cpp b/lib/nr/cpp/recipes/bessy.cpp new file mode 100644 index 0000000..30cf33b --- /dev/null +++ b/lib/nr/cpp/recipes/bessy.cpp @@ -0,0 +1,18 @@ +#include "nr.h" + +DP NR::bessy(const int n, const DP x) +{ + int j; + DP by,bym,byp,tox; + + if (n < 2) nrerror("Index n less than 2 in bessy"); + tox=2.0/x; + by=bessy1(x); + bym=bessy0(x); + for (j=1;j +#include "nr.h" +using namespace std; + +DP NR::bessy0(const DP x) +{ + DP z,xx,y,ans,ans1,ans2; + + if (x < 8.0) { + y=x*x; + ans1 = -2957821389.0+y*(7062834065.0+y*(-512359803.6 + +y*(10879881.29+y*(-86327.92757+y*228.4622733)))); + ans2=40076544269.0+y*(745249964.8+y*(7189466.438 + +y*(47447.26470+y*(226.1030244+y*1.0)))); + ans=(ans1/ans2)+0.636619772*bessj0(x)*log(x); + } else { + z=8.0/x; + y=z*z; + xx=x-0.785398164; + ans1=1.0+y*(-0.1098628627e-2+y*(0.2734510407e-4 + +y*(-0.2073370639e-5+y*0.2093887211e-6))); + ans2 = -0.1562499995e-1+y*(0.1430488765e-3 + +y*(-0.6911147651e-5+y*(0.7621095161e-6 + +y*(-0.934945152e-7)))); + ans=sqrt(0.636619772/x)*(sin(xx)*ans1+z*cos(xx)*ans2); + } + return ans; +} diff --git a/lib/nr/cpp/recipes/bessy1.cpp b/lib/nr/cpp/recipes/bessy1.cpp new file mode 100644 index 0000000..bf9809d --- /dev/null +++ b/lib/nr/cpp/recipes/bessy1.cpp @@ -0,0 +1,30 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::bessy1(const DP x) +{ + DP z,xx,y,ans,ans1,ans2; + + if (x < 8.0) { + y=x*x; + ans1=x*(-0.4900604943e13+y*(0.1275274390e13 + +y*(-0.5153438139e11+y*(0.7349264551e9 + +y*(-0.4237922726e7+y*0.8511937935e4))))); + ans2=0.2499580570e14+y*(0.4244419664e12 + +y*(0.3733650367e10+y*(0.2245904002e8 + +y*(0.1020426050e6+y*(0.3549632885e3+y))))); + ans=(ans1/ans2)+0.636619772*(bessj1(x)*log(x)-1.0/x); + } else { + z=8.0/x; + y=z*z; + xx=x-2.356194491; + ans1=1.0+y*(0.183105e-2+y*(-0.3516396496e-4 + +y*(0.2457520174e-5+y*(-0.240337019e-6)))); + ans2=0.04687499995+y*(-0.2002690873e-3 + +y*(0.8449199096e-5+y*(-0.88228987e-6 + +y*0.105787412e-6))); + ans=sqrt(0.636619772/x)*(sin(xx)*ans1+z*cos(xx)*ans2); + } + return ans; +} diff --git a/lib/nr/cpp/recipes/beta.cpp b/lib/nr/cpp/recipes/beta.cpp new file mode 100644 index 0000000..20600c3 --- /dev/null +++ b/lib/nr/cpp/recipes/beta.cpp @@ -0,0 +1,8 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::beta(const DP z, const DP w) +{ + return exp(gammln(z)+gammln(w)-gammln(z+w)); +} diff --git a/lib/nr/cpp/recipes/betacf.cpp b/lib/nr/cpp/recipes/betacf.cpp new file mode 100644 index 0000000..a8f91b8 --- /dev/null +++ b/lib/nr/cpp/recipes/betacf.cpp @@ -0,0 +1,43 @@ +#include +#include +#include "nr.h" +using namespace std; + +DP NR::betacf(const DP a, const DP b, const DP x) +{ + const int MAXIT=100; + const DP EPS=numeric_limits::epsilon(); + const DP FPMIN=numeric_limits::min()/EPS; + int m,m2; + DP aa,c,d,del,h,qab,qam,qap; + + qab=a+b; + qap=a+1.0; + qam=a-1.0; + c=1.0; + d=1.0-qab*x/qap; + if (fabs(d) < FPMIN) d=FPMIN; + d=1.0/d; + h=d; + for (m=1;m<=MAXIT;m++) { + m2=2*m; + aa=m*(b-m)*x/((qam+m2)*(a+m2)); + d=1.0+aa*d; + if (fabs(d) < FPMIN) d=FPMIN; + c=1.0+aa/c; + if (fabs(c) < FPMIN) c=FPMIN; + d=1.0/d; + h *= d*c; + aa = -(a+m)*(qab+m)*x/((a+m2)*(qap+m2)); + d=1.0+aa*d; + if (fabs(d) < FPMIN) d=FPMIN; + c=1.0+aa/c; + if (fabs(c) < FPMIN) c=FPMIN; + d=1.0/d; + del=d*c; + h *= del; + if (fabs(del-1.0) <= EPS) break; + } + if (m > MAXIT) nrerror("a or b too big, or MAXIT too small in betacf"); + return h; +} diff --git a/lib/nr/cpp/recipes/betai.cpp b/lib/nr/cpp/recipes/betai.cpp new file mode 100644 index 0000000..241feb5 --- /dev/null +++ b/lib/nr/cpp/recipes/betai.cpp @@ -0,0 +1,17 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::betai(const DP a, const DP b, const DP x) +{ + DP bt; + + if (x < 0.0 || x > 1.0) nrerror("Bad x in routine betai"); + if (x == 0.0 || x == 1.0) bt=0.0; + else + bt=exp(gammln(a+b)-gammln(a)-gammln(b)+a*log(x)+b*log(1.0-x)); + if (x < (a+1.0)/(a+b+2.0)) + return bt*betacf(a,b,x)/a; + else + return 1.0-bt*betacf(b,a,1.0-x)/b; +} diff --git a/lib/nr/cpp/recipes/bico.cpp b/lib/nr/cpp/recipes/bico.cpp new file mode 100644 index 0000000..425b679 --- /dev/null +++ b/lib/nr/cpp/recipes/bico.cpp @@ -0,0 +1,8 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::bico(const int n, const int k) +{ + return floor(0.5+exp(factln(n)-factln(k)-factln(n-k))); +} diff --git a/lib/nr/cpp/recipes/bksub.cpp b/lib/nr/cpp/recipes/bksub.cpp new file mode 100644 index 0000000..54786be --- /dev/null +++ b/lib/nr/cpp/recipes/bksub.cpp @@ -0,0 +1,25 @@ +#include "nr.h" + +void NR::bksub(const int ne, const int nb, const int jf, const int k1, + const int k2, Mat3D_IO_DP &c) +{ + int nbf,im,kp,k,j,i; + DP xx; + + nbf=ne-nb; + im=1; + for (k=k2-1;k>=k1;k--) { + if (k == k1) im=nbf+1; + kp=k+1; + for (j=0;j +#include "nr.h" +using namespace std; + +DP NR::bnldev(const DP pp, const int n, int &idum) +{ + const DP PI=3.141592653589793238; + int j; + static int nold=(-1); + DP am,em,g,angle,p,bnl,sq,t,y; + static DP pold=(-1.0),pc,plog,pclog,en,oldg; + + p=(pp <= 0.5 ? pp : 1.0-pp); + am=n*p; + if (n < 25) { + bnl=0.0; + for (j=0;j= (en+1.0)); + em=floor(em); + t=1.2*sq*(1.0+y*y)*exp(oldg-gammln(em+1.0) + -gammln(en-em+1.0)+em*plog+(en-em)*pclog); + } while (ran1(idum) > t); + bnl=em; + } + if (p != pp) bnl=n-bnl; + return bnl; +} diff --git a/lib/nr/cpp/recipes/brent.cpp b/lib/nr/cpp/recipes/brent.cpp new file mode 100644 index 0000000..0f01cfa --- /dev/null +++ b/lib/nr/cpp/recipes/brent.cpp @@ -0,0 +1,79 @@ +#include +#include +#include "nr.h" +using namespace std; + +namespace { + inline void shft3(DP &a, DP &b, DP &c, const DP d) + { + a=b; + b=c; + c=d; + } +} + +DP NR::brent(const DP ax, const DP bx, const DP cx, DP f(const DP), + const DP tol, DP &xmin) +{ + const int ITMAX=100; + const DP CGOLD=0.3819660; + const DP ZEPS=numeric_limits::epsilon()*1.0e-3; + int iter; + DP a,b,d=0.0,etemp,fu,fv,fw,fx; + DP p,q,r,tol1,tol2,u,v,w,x,xm; + DP e=0.0; + + a=(ax < cx ? ax : cx); + b=(ax > cx ? ax : cx); + x=w=v=bx; + fw=fv=fx=f(x); + for (iter=0;iter tol1) { + r=(x-w)*(fx-fv); + q=(x-v)*(fx-fw); + p=(x-v)*q-(x-w)*r; + q=2.0*(q-r); + if (q > 0.0) p = -p; + q=fabs(q); + etemp=e; + e=d; + if (fabs(p) >= fabs(0.5*q*etemp) || p <= q*(a-x) || p >= q*(b-x)) + d=CGOLD*(e=(x >= xm ? a-x : b-x)); + else { + d=p/q; + u=x+d; + if (u-a < tol2 || b-u < tol2) + d=SIGN(tol1,xm-x); + } + } else { + d=CGOLD*(e=(x >= xm ? a-x : b-x)); + } + u=(fabs(d) >= tol1 ? x+d : x+SIGN(tol1,d)); + fu=f(u); + if (fu <= fx) { + if (u >= x) a=x; else b=x; + shft3(v,w,x,u); + shft3(fv,fw,fx,fu); + } else { + if (u < x) a=u; else b=u; + if (fu <= fw || w == x) { + v=w; + w=u; + fv=fw; + fw=fu; + } else if (fu <= fv || v == x || v == w) { + v=u; + fv=fu; + } + } + } + nrerror("Too many iterations in brent"); + xmin=x; + return fx; +} diff --git a/lib/nr/cpp/recipes/broydn.cpp b/lib/nr/cpp/recipes/broydn.cpp new file mode 100644 index 0000000..10218ea --- /dev/null +++ b/lib/nr/cpp/recipes/broydn.cpp @@ -0,0 +1,143 @@ +#include +#include +#include "nr.h" +using namespace std; + +Vec_DP *fvec_p; +void (*nrfuncv)(Vec_I_DP &v, Vec_O_DP &f); + +void NR::broydn(Vec_IO_DP &x, bool &check, void vecfunc(Vec_I_DP &, Vec_O_DP &)) +{ + const int MAXITS=200; + const DP EPS=numeric_limits::epsilon(); + const DP TOLF=1.0e-8, TOLX=EPS, STPMX=100.0, TOLMIN=1.0e-12; + bool restrt,sing,skip; + int i,its,j,k; + DP den,f,fold,stpmax,sum,temp,test; + + int n=x.size(); + Mat_DP qt(n,n),r(n,n); + Vec_DP c(n),d(n),fvcold(n),g(n),p(n),s(n),t(n),w(n),xold(n); + fvec_p=new Vec_DP(n); + nrfuncv=vecfunc; + Vec_DP &fvec=*fvec_p; + f=fmin(x); + test=0.0; + for (i=0;i test) test=fabs(fvec[i]); + if (test < 0.01*TOLF) { + check=false; + delete fvec_p; + return; + } + for (sum=0.0,i=0;i= EPS*(fabs(fvec[i])+fabs(fvcold[i]))) skip=false; + else w[i]=0.0; + } + if (!skip) { + for (i=0;i=0;i--) { + for (sum=0.0,j=0;j<=i;j++) sum -= r[j][i]*p[j]; + g[i]=sum; + } + for (i=0;i test) test=fabs(fvec[i]); + if (test < TOLF) { + check=false; + delete fvec_p; + return; + } + if (check) { + if (restrt) { + delete fvec_p; + return; + } else { + test=0.0; + den=MAX(f,0.5*n); + for (i=0;i test) test=temp; + } + if (test < TOLMIN) { + delete fvec_p; + return; + } + else restrt=true; + } + } else { + restrt=false; + test=0.0; + for (i=0;i test) test=temp; + } + if (test < TOLX) { + delete fvec_p; + return; + } + } + } + nrerror("MAXITS exceeded in broydn"); + return; +} diff --git a/lib/nr/cpp/recipes/bsstep.cpp b/lib/nr/cpp/recipes/bsstep.cpp new file mode 100644 index 0000000..8f383ad --- /dev/null +++ b/lib/nr/cpp/recipes/bsstep.cpp @@ -0,0 +1,118 @@ +#include +#include "nr.h" +using namespace std; + +Vec_DP *x_p; +Mat_DP *d_p; + +void NR::bsstep(Vec_IO_DP &y, Vec_IO_DP &dydx, DP &xx, const DP htry, + const DP eps, Vec_I_DP &yscal, DP &hdid, DP &hnext, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &)) +{ + const int KMAXX=8, IMAXX=(KMAXX+1); + const DP SAFE1=0.25, SAFE2=0.7, REDMAX=1.0e-5, REDMIN=0.7; + const DP TINY=1.0e-30, SCALMX=0.1; + static const int nseq_d[IMAXX]={2,4,6,8,10,12,14,16,18}; + static int first=1,kmax,kopt; + static DP epsold = -1.0,xnew; + static Vec_DP a(IMAXX); + static Mat_DP alf(KMAXX,KMAXX); + bool exitflag=false; + int i,iq,k,kk,km,reduct; + DP eps1,errmax,fact,h,red,scale,work,wrkmin,xest; + Vec_INT nseq(nseq_d,IMAXX); + Vec_DP err(KMAXX); + + int nv=y.size(); + Vec_DP yerr(nv),ysav(nv),yseq(nv); + x_p=new Vec_DP(KMAXX); + d_p=new Mat_DP(nv,KMAXX); + if (eps != epsold) { + hnext = xnew = -1.0e29; + eps1=SAFE1*eps; + a[0]=nseq[0]+1; + for (k=0;k a[kopt]*alf[kopt-1][kopt]) break; + kmax=kopt; + } + h=htry; + for (i=0;i= kopt-1 || first)) { + if (errmax < 1.0) { + exitflag=true; + break; + } + if (k == kmax || k == kopt+1) { + red=SAFE2/err[km]; + break; + } + else if (k == kopt && alf[kopt-1][kopt] < err[km]) { + red=1.0/err[km]; + break; + } + else if (kopt == kmax && alf[km][kmax-1] < err[km]) { + red=alf[km][kmax-1]*SAFE2/err[km]; + break; + } + else if (alf[km][kopt] < err[km]) { + red=alf[km][kopt-1]/err[km]; + break; + } + } + } + if (exitflag) break; + red=MIN(red,REDMIN); + red=MAX(red,REDMAX); + h *= red; + reduct=1; + } + xx=xnew; + hdid=h; + first=0; + wrkmin=1.0e35; + for (kk=0;kk<=km;kk++) { + fact=MAX(err[kk],SCALMX); + work=fact*a[kk+1]; + if (work < wrkmin) { + scale=fact; + wrkmin=work; + kopt=kk+1; + } + } + hnext=h/scale; + if (kopt >= k && kopt != kmax && !reduct) { + fact=MAX(scale/alf[kopt-1][kopt],SCALMX); + if (a[kopt+1]*fact <= wrkmin) { + hnext=h/fact; + kopt++; + } + } + delete d_p; + delete x_p; +} diff --git a/lib/nr/cpp/recipes/caldat.cpp b/lib/nr/cpp/recipes/caldat.cpp new file mode 100644 index 0000000..398f366 --- /dev/null +++ b/lib/nr/cpp/recipes/caldat.cpp @@ -0,0 +1,28 @@ +#include +#include "nr.h" +using namespace std; + +void NR::caldat(const int julian, int &mm, int &id, int &iyyy) +{ + const int IGREG=2299161; + int ja,jalpha,jb,jc,jd,je; + + if (julian >= IGREG) { + jalpha=int((DP(julian-1867216)-0.25)/36524.25); + ja=julian+1+jalpha-int(0.25*jalpha); + } else if (julian < 0) { + ja=julian+36525*(1-julian/36525); + } else + ja=julian; + jb=ja+1524; + jc=int(6680.0+(DP(jb-2439870)-122.1)/365.25); + jd=int(365*jc+(0.25*jc)); + je=int((jb-jd)/30.6001); + id=jb-jd-int(30.6001*je); + mm=je-1; + if (mm > 12) mm -= 12; + iyyy=jc-4715; + if (mm > 2) --iyyy; + if (iyyy <= 0) --iyyy; + if (julian < 0) iyyy -= 100*(1-julian/36525); +} diff --git a/lib/nr/cpp/recipes/chder.cpp b/lib/nr/cpp/recipes/chder.cpp new file mode 100644 index 0000000..595169b --- /dev/null +++ b/lib/nr/cpp/recipes/chder.cpp @@ -0,0 +1,15 @@ +#include "nr.h" + +void NR::chder(const DP a, const DP b, Vec_I_DP &c, Vec_O_DP &cder, const int n) +{ + int j; + DP con; + + cder[n-1]=0.0; + cder[n-2]=2*(n-1)*c[n-1]; + for (j=n-2;j>0;j--) + cder[j-1]=cder[j+1]+2*j*c[j]; + con=2.0/(b-a); + for (j=0;j 0.0) + nrerror("x not in range in routine chebev"); + y2=2.0*(y=(2.0*x-a-b)/(b-a)); + for (j=m-1;j>0;j--) { + sv=d; + d=y2*d-dd+c[j]; + dd=sv; + } + return y*d-dd+0.5*c[0]; +} diff --git a/lib/nr/cpp/recipes/chebft.cpp b/lib/nr/cpp/recipes/chebft.cpp new file mode 100644 index 0000000..24f6798 --- /dev/null +++ b/lib/nr/cpp/recipes/chebft.cpp @@ -0,0 +1,26 @@ +#include +#include "nr.h" +using namespace std; + +void NR::chebft(const DP a, const DP b, Vec_O_DP &c, DP func(const DP)) +{ + const DP PI=3.141592653589793; + int k,j; + DP fac,bpa,bma,y,sum; + + int n=c.size(); + Vec_DP f(n); + bma=0.5*(b-a); + bpa=0.5*(b+a); + for (k=0;k0;j--) { + for (k=n-j;k>0;k--) { + sv=d[k]; + d[k]=2.0*d[k-1]-dd[k]; + dd[k]=sv; + } + sv=d[0]; + d[0] = -dd[0]+c[j]; + dd[0]=sv; + } + for (j=n-1;j>0;j--) + d[j]=d[j-1]-dd[j]; + d[0] = -dd[0]+0.5*c[0]; +} diff --git a/lib/nr/cpp/recipes/chint.cpp b/lib/nr/cpp/recipes/chint.cpp new file mode 100644 index 0000000..3d18456 --- /dev/null +++ b/lib/nr/cpp/recipes/chint.cpp @@ -0,0 +1,17 @@ +#include "nr.h" + +void NR::chint(const DP a, const DP b, Vec_I_DP &c, Vec_O_DP &cint, const int n) +{ + int j; + DP sum=0.0,fac=1.0,con; + + con=0.25*(b-a); + for (j=1;j +#include "nr.h" +using namespace std; + +extern Vec_DP *xx_p,*yy_p,*sx_p,*sy_p,*ww_p; +extern DP aa,offs; + +DP NR::chixy(const DP bang) +{ + const DP BIG=1.0e30; + int j; + DP ans,avex=0.0,avey=0.0,sumw=0.0,b; + + Vec_DP &xx=*xx_p, &yy=*yy_p; + Vec_DP &sx=*sx_p, &sy=*sy_p, &ww=*ww_p; + int nn=xx.size(); + b=tan(bang); + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::choldc(Mat_IO_DP &a, Vec_O_DP &p) +{ + int i,j,k; + DP sum; + + int n=a.nrows(); + for (i=0;i=0;k--) sum -= a[i][k]*a[j][k]; + if (i == j) { + if (sum <= 0.0) + nrerror("choldc failed"); + p[i]=sqrt(sum); + } else a[j][i]=sum/p[i]; + } + } +} diff --git a/lib/nr/cpp/recipes/cholsl.cpp b/lib/nr/cpp/recipes/cholsl.cpp new file mode 100644 index 0000000..11ac0fa --- /dev/null +++ b/lib/nr/cpp/recipes/cholsl.cpp @@ -0,0 +1,17 @@ +#include "nr.h" + +void NR::cholsl(Mat_I_DP &a, Vec_I_DP &p, Vec_I_DP &b, Vec_O_DP &x) +{ + int i,k; + DP sum; + + int n=a.nrows(); + for (i=0;i=0;k--) sum -= a[i][k]*x[k]; + x[i]=sum/p[i]; + } + for (i=n-1;i>=0;i--) { + for (sum=x[i],k=i+1;k +#include +#include +#include "nr.h" +using namespace std; + +void NR::cisi(const DP x, complex &cs) +{ + const int MAXIT=100; + const DP EULER=0.577215664901533, PIBY2=1.570796326794897, TMIN=2.0; + const DP EPS=numeric_limits::epsilon(); + const DP FPMIN=numeric_limits::min()*4.0; + const DP BIG=numeric_limits::max()*EPS; + int i,k; + bool odd; + DP a,err,fact,sign,sum,sumc,sums,t,term; + complex h,b,c,d,del; + + t=fabs(x); + if (t == 0.0) { + cs= -BIG; + return; + } + if (t > TMIN) { + b=complex(1.0,t); + c=complex(BIG,0.0); + d=h=1.0/b; + for (i=1;i= MAXIT) nrerror("cf failed in cisi"); + h=complex(cos(t),-sin(t))*h; + cs= -conj(h)+complex(0.0,PIBY2); + } else { + if (t < sqrt(FPMIN)) { + sumc=0.0; + sums=t; + } else { + sum=sums=sumc=0.0; + sign=fact=1.0; + odd=true; + for (k=1;k<=MAXIT;k++) { + fact *= t/k; + term=fact/k; + sum += sign*term; + err=term/fabs(sum); + if (odd) { + sign = -sign; + sums=sum; + sum=sumc; + } else { + sumc=sum; + sum=sums; + } + if (err < EPS) break; + odd=!odd; + } + if (k > MAXIT) nrerror("maxits exceeded in cisi"); + } + cs=complex(sumc+log(t)+EULER,sums); + } + if (x < 0.0) cs = conj(cs); +} diff --git a/lib/nr/cpp/recipes/cntab1.cpp b/lib/nr/cpp/recipes/cntab1.cpp new file mode 100644 index 0000000..72fefbb --- /dev/null +++ b/lib/nr/cpp/recipes/cntab1.cpp @@ -0,0 +1,42 @@ +#include +#include "nr.h" +using namespace std; + +void NR::cntab1(Mat_I_INT &nn, DP &chisq, DP &df, DP &prob, DP &cramrv, DP &ccc) +{ + const DP TINY=1.0e-30; + int i,j,nnj,nni,minij; + DP sum=0.0,expctd,temp; + + int ni=nn.nrows(); + int nj=nn.ncols(); + Vec_DP sumi(ni),sumj(nj); + nni=ni; + nnj=nj; + for (i=0;i +#include "nr.h" +using namespace std; + +void NR::cntab2(Mat_I_INT &nn, DP &h, DP &hx, DP &hy, DP &hygx, DP &hxgy, + DP &uygx, DP &uxgy, DP &uxy) +{ + const DP TINY=1.0e-30; + int i,j; + DP sum=0.0,p; + + int ni=nn.nrows(); + int nj=nn.ncols(); + Vec_DP sumi(ni),sumj(nj); + for (i=0;i>1; + if (isign == 1) { + for (i=2;i>1; + for (i=2;i +#include "nr.h" +using namespace std; + +void NR::cosft1(Vec_IO_DP &y) +{ + const DP PI=3.141592653589793238; + int j; + DP sum,y1,y2,theta,wi=0.0,wpi,wpr,wr=1.0,wtemp; + + int n=y.size()-1; + Vec_DP yy(n); + theta=PI/n; + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + sum=0.5*(y[0]-y[n]); + yy[0]=0.5*(y[0]+y[n]); + for (j=1;j +#include "nr.h" +using namespace std; + +void NR::cosft2(Vec_IO_DP &y, const int isign) +{ + const DP PI=3.141592653589793238; + int i; + DP sum,sum1,y1,y2,ytemp,theta,wi=0.0,wi1,wpi,wpr,wr=1.0,wr1,wtemp; + + int n=y.size(); + theta=0.5*PI/n; + wr1=cos(theta); + wi1=sin(theta); + wpr = -2.0*wi1*wi1; + wpi=sin(2.0*theta); + if (isign == 1) { + for (i=0;i0;i-=2) { + sum1=sum; + sum += y[i]; + y[i]=sum1; + } + } else if (isign == -1) { + ytemp=y[n-1]; + for (i=n-1;i>2;i-=2) + y[i]=y[i-2]-y[i]; + y[1]=2.0*ytemp; + for (i=2;i=0;j--) { + if (ia[j]) { + for (i=0;i> 1; + if (isign >= 0) { + for (i=0,j=0;j +#include "nr.h" +using namespace std; + +DP NR::dawson(const DP x) +{ + const int NMAX=6; + const DP H=0.4, A1=2.0/3.0, A2=0.4, A3=2.0/7.0; + int i,n0; + static bool init = true; + DP d1,d2,e1,e2,sum,x2,xp,xx,ans; + static Vec_DP c(NMAX); + + if (init) { + init=false; + for (i=0;i +#include +#include "nr.h" +using namespace std; + +namespace { + inline void mov3(DP &a, DP &b, DP &c, const DP d, const DP e, + const DP f) + { + a=d; b=e; c=f; + } +} + +DP NR::dbrent(const DP ax, const DP bx, const DP cx, DP f(const DP), + DP df(const DP), const DP tol, DP &xmin) +{ + const int ITMAX=100; + const DP ZEPS=numeric_limits::epsilon()*1.0e-3; + bool ok1,ok2; + int iter; + DP a,b,d=0.0,d1,d2,du,dv,dw,dx,e=0.0; + DP fu,fv,fw,fx,olde,tol1,tol2,u,u1,u2,v,w,x,xm; + + a=(ax < cx ? ax : cx); + b=(ax > cx ? ax : cx); + x=w=v=bx; + fw=fv=fx=f(x); + dw=dv=dx=df(x); + for (iter=0;iter tol1) { + d1=2.0*(b-a); + d2=d1; + if (dw != dx) d1=(w-x)*dx/(dx-dw); + if (dv != dx) d2=(v-x)*dx/(dx-dv); + u1=x+d1; + u2=x+d2; + ok1 = (a-u1)*(u1-b) > 0.0 && dx*d1 <= 0.0; + ok2 = (a-u2)*(u2-b) > 0.0 && dx*d2 <= 0.0; + olde=e; + e=d; + if (ok1 || ok2) { + if (ok1 && ok2) + d=(fabs(d1) < fabs(d2) ? d1 : d2); + else if (ok1) + d=d1; + else + d=d2; + if (fabs(d) <= fabs(0.5*olde)) { + u=x+d; + if (u-a < tol2 || b-u < tol2) + d=SIGN(tol1,xm-x); + } else { + d=0.5*(e=(dx >= 0.0 ? a-x : b-x)); + } + } else { + d=0.5*(e=(dx >= 0.0 ? a-x : b-x)); + } + } else { + d=0.5*(e=(dx >= 0.0 ? a-x : b-x)); + } + if (fabs(d) >= tol1) { + u=x+d; + fu=f(u); + } else { + u=x+SIGN(tol1,d); + fu=f(u); + if (fu > fx) { + xmin=x; + return fx; + } + } + du=df(u); + if (fu <= fx) { + if (u >= x) a=x; else b=x; + mov3(v,fv,dv,w,fw,dw); + mov3(w,fw,dw,x,fx,dx); + mov3(x,fx,dx,u,fu,du); + } else { + if (u < x) a=u; else b=u; + if (fu <= fw || w == x) { + mov3(v,fv,dv,w,fw,dw); + mov3(w,fw,dw,u,fu,du); + } else if (fu < fv || v == x || v == w) { + mov3(v,fv,dv,u,fu,du); + } + } + } + nrerror("Too many iterations in routine dbrent"); + return 0.0; +} diff --git a/lib/nr/cpp/recipes/ddpoly.cpp b/lib/nr/cpp/recipes/ddpoly.cpp new file mode 100644 index 0000000..9b143db --- /dev/null +++ b/lib/nr/cpp/recipes/ddpoly.cpp @@ -0,0 +1,22 @@ +#include "nr.h" + +void NR::ddpoly(Vec_I_DP &c, const DP x, Vec_O_DP &pd) +{ + int nnd,j,i; + DP cnst=1.0; + + int nc=c.size()-1; + int nd=pd.size()-1; + pd[0]=c[nc]; + for (j=1;j=0;i--) { + nnd=(nd < (nc-i) ? nd : nc-i); + for (j=nnd;j>0;j--) + pd[j]=pd[j]*x+pd[j-1]; + pd[0]=pd[0]*x+c[i]; + } + for (i=2;i= 48 && c <= 57) + k=ij[k][ip[(c+2) % 10][7 & m++]]; + } + for (j=0;j<10;j++) + if (ij[k][ip[j][m & 7]] == 0) break; + ch=char(j+48); + return k==0; +} diff --git a/lib/nr/cpp/recipes/df1dim.cpp b/lib/nr/cpp/recipes/df1dim.cpp new file mode 100644 index 0000000..cb7e6b4 --- /dev/null +++ b/lib/nr/cpp/recipes/df1dim.cpp @@ -0,0 +1,19 @@ +#include "nr.h" + +extern int ncom; +extern DP (*nrfunc)(Vec_I_DP &); +extern void (*nrdfun)(Vec_I_DP &, Vec_O_DP &); +extern Vec_DP *pcom_p,*xicom_p; + +DP NR::df1dim(const DP x) +{ + int j; + DP df1=0.0; + Vec_DP xt(ncom),df(ncom); + + Vec_DP &pcom=*pcom_p,&xicom=*xicom_p; + for (j=0;j +#include +#include "nr.h" +using namespace std; + +void NR::dfpmin(Vec_IO_DP &p, const DP gtol, int &iter, DP &fret, + DP func(Vec_I_DP &), void dfunc(Vec_I_DP &, Vec_O_DP &)) +{ + const int ITMAX=200; + const DP EPS=numeric_limits::epsilon(); + const DP TOLX=4*EPS,STPMX=100.0; + bool check; + int i,its,j; + DP den,fac,fad,fae,fp,stpmax,sum=0.0,sumdg,sumxi,temp,test; + + int n=p.size(); + Vec_DP dg(n),g(n),hdg(n),pnew(n),xi(n); + Mat_DP hessin(n,n); + fp=func(p); + dfunc(p,g); + for (i=0;i test) test=temp; + } + if (test < TOLX) + return; + for (i=0;i test) test=temp; + } + if (test < gtol) + return; + for (i=0;i sqrt(EPS*sumdg*sumxi)) { + fac=1.0/fac; + fad=1.0/fae; + for (i=0;i +#include +#include "nr.h" +using namespace std; + +DP NR::dfridr(DP func(const DP), const DP x, const DP h, DP &err) +{ + const int NTAB=10; + const DP CON=1.4, CON2=(CON*CON); + const DP BIG=numeric_limits::max(); + const DP SAFE=2.0; + int i,j; + DP errt,fac,hh,ans; + Mat_DP a(NTAB,NTAB); + + if (h == 0.0) nrerror("h must be nonzero in dfridr."); + hh=h; + a[0][0]=(func(x+hh)-func(x-hh))/(2.0*hh); + err=BIG; + for (i=1;i= SAFE*err) break; + } + return ans; +} diff --git a/lib/nr/cpp/recipes/dftcor.cpp b/lib/nr/cpp/recipes/dftcor.cpp new file mode 100644 index 0000000..41c546d --- /dev/null +++ b/lib/nr/cpp/recipes/dftcor.cpp @@ -0,0 +1,58 @@ +#include +#include "nr.h" +using namespace std; + +void NR::dftcor(const DP w, const DP delta, const DP a, const DP b, + Vec_I_DP &endpts, DP &corre, DP &corim, DP &corfac) +{ + DP a0i,a0r,a1i,a1r,a2i,a2r,a3i,a3r,arg,c,cl,cr,s,sl,sr,t,t2,t4,t6, + cth,ctth,spth2,sth,sth4i,stth,th,th2,th4,tmth2,tth4i; + + th=w*delta; + if (a >= b || th < 0.0e0 || th > 3.1416e0) + nrerror("bad arguments to dftcor"); + if (fabs(th) < 5.0e-2) { + t=th; + t2=t*t; + t4=t2*t2; + t6=t4*t2; + corfac=1.0-(11.0/720.0)*t4+(23.0/15120.0)*t6; + a0r=(-2.0/3.0)+t2/45.0+(103.0/15120.0)*t4-(169.0/226800.0)*t6; + a1r=(7.0/24.0)-(7.0/180.0)*t2+(5.0/3456.0)*t4-(7.0/259200.0)*t6; + a2r=(-1.0/6.0)+t2/45.0-(5.0/6048.0)*t4+t6/64800.0; + a3r=(1.0/24.0)-t2/180.0+(5.0/24192.0)*t4-t6/259200.0; + a0i=t*(2.0/45.0+(2.0/105.0)*t2-(8.0/2835.0)*t4+(86.0/467775.0)*t6); + a1i=t*(7.0/72.0-t2/168.0+(11.0/72576.0)*t4-(13.0/5987520.0)*t6); + a2i=t*(-7.0/90.0+t2/210.0-(11.0/90720.0)*t4+(13.0/7484400.0)*t6); + a3i=t*(7.0/360.0-t2/840.0+(11.0/362880.0)*t4-(13.0/29937600.0)*t6); + } else { + cth=cos(th); + sth=sin(th); + ctth=cth*cth-sth*sth; + stth=2.0e0*sth*cth; + th2=th*th; + th4=th2*th2; + tmth2=3.0e0-th2; + spth2=6.0e0+th2; + sth4i=1.0/(6.0e0*th4); + tth4i=2.0e0*sth4i; + corfac=tth4i*spth2*(3.0e0-4.0e0*cth+ctth); + a0r=sth4i*(-42.0e0+5.0e0*th2+spth2*(8.0e0*cth-ctth)); + a0i=sth4i*(th*(-12.0e0+6.0e0*th2)+spth2*stth); + a1r=sth4i*(14.0e0*tmth2-7.0e0*spth2*cth); + a1i=sth4i*(30.0e0*th-5.0e0*spth2*sth); + a2r=tth4i*(-4.0e0*tmth2+2.0e0*spth2*cth); + a2i=tth4i*(-12.0e0*th+2.0e0*spth2*sth); + a3r=sth4i*(2.0e0*tmth2-spth2*cth); + a3i=sth4i*(6.0e0*th-spth2*sth); + } + cl=a0r*endpts[0]+a1r*endpts[1]+a2r*endpts[2]+a3r*endpts[3]; + sl=a0i*endpts[0]+a1i*endpts[1]+a2i*endpts[2]+a3i*endpts[3]; + cr=a0r*endpts[7]+a1r*endpts[6]+a2r*endpts[5]+a3r*endpts[4]; + sr= -a0i*endpts[7]-a1i*endpts[6]-a2i*endpts[5]-a3i*endpts[4]; + arg=w*(b-a); + c=cos(arg); + s=sin(arg); + corre=cl+c*cr-s*sr; + corim=sl+s*cr+c*sr; +} diff --git a/lib/nr/cpp/recipes/dftint.cpp b/lib/nr/cpp/recipes/dftint.cpp new file mode 100644 index 0000000..693895d --- /dev/null +++ b/lib/nr/cpp/recipes/dftint.cpp @@ -0,0 +1,53 @@ +#include +#include "nr.h" +using namespace std; + +void NR::dftint(DP func(const DP), const DP a, const DP b, const DP w, + DP &cosint, DP &sinint) +{ + static int init=0; + static DP (*funcold)(const DP); + static DP aold = -1.e30,bold = -1.e30,delta; + const int M=64,NDFT=1024,MPOL=6; + const DP TWOPI=6.283185307179586476; + int j,nn; + DP c,cdft,cerr,corfac,corim,corre,en,s,sdft,serr; + static Vec_DP data(NDFT),endpts(8); + Vec_DP cpol(MPOL),spol(MPOL),xpol(MPOL); + + if (init != 1 || a != aold || b != bold || func != funcold) { + init=1; + aold=a; + bold=b; + funcold=func; + delta=(b-a)/M; + for (j=0;j k2-1) { + s[0][3+indexv[0]] = -(y[2][mpt-1]-c2)/(2.0*(mm+1.0)); + s[0][3+indexv[1]]=1.0; + s[0][3+indexv[2]] = -y[0][mpt-1]/(2.0*(mm+1.0)); + s[0][jsf]=y[1][mpt-1]-(y[2][mpt-1]-c2)*y[0][mpt-1]/ + (2.0*(mm+1.0)); + s[1][3+indexv[0]]=1.0; + s[1][3+indexv[1]]=0.0; + s[1][3+indexv[2]]=0.0; + s[1][jsf]=y[0][mpt-1]-anorm; + } else { + s[0][indexv[0]] = -1.0; + s[0][indexv[1]] = -0.5*h; + s[0][indexv[2]]=0.0; + s[0][3+indexv[0]]=1.0; + s[0][3+indexv[1]] = -0.5*h; + s[0][3+indexv[2]]=0.0; + temp1=x[k]+x[k-1]; + temp=h/(1.0-temp1*temp1*0.25); + temp2=0.5*(y[2][k]+y[2][k-1])-c2*0.25*temp1*temp1; + s[1][indexv[0]]=temp*temp2*0.5; + s[1][indexv[1]] = -1.0-0.5*temp*(mm+1.0)*temp1; + s[1][indexv[2]]=0.25*temp*(y[0][k]+y[0][k-1]); + s[1][3+indexv[0]]=s[1][indexv[0]]; + s[1][3+indexv[1]]=2.0+s[1][indexv[1]]; + s[1][3+indexv[2]]=s[1][indexv[2]]; + s[2][indexv[0]]=0.0; + s[2][indexv[1]]=0.0; + s[2][indexv[2]] = -1.0; + s[2][3+indexv[0]]=0.0; + s[2][3+indexv[1]]=0.0; + s[2][3+indexv[2]]=1.0; + s[0][jsf]=y[0][k]-y[0][k-1]-0.5*h*(y[1][k]+y[1][k-1]); + s[1][jsf]=y[1][k]-y[1][k-1]-temp*((x[k]+x[k-1]) + *0.5*(mm+1.0)*(y[1][k]+y[1][k-1])-temp2 + *0.5*(y[0][k]+y[0][k-1])); + s[2][jsf]=y[2][k]-y[2][k-1]; + } +} diff --git a/lib/nr/cpp/recipes/dlinmin.cpp b/lib/nr/cpp/recipes/dlinmin.cpp new file mode 100644 index 0000000..797b01d --- /dev/null +++ b/lib/nr/cpp/recipes/dlinmin.cpp @@ -0,0 +1,36 @@ +#include "nr.h" + +int ncom; +DP (*nrfunc)(Vec_I_DP &); +void (*nrdfun)(Vec_I_DP &, Vec_O_DP &); +Vec_DP *pcom_p,*xicom_p; + +void NR::dlinmin(Vec_IO_DP &p, Vec_IO_DP &xi, DP &fret, DP func(Vec_I_DP &), + void dfunc(Vec_I_DP &, Vec_O_DP &)) +{ + const DP TOL=2.0e-8; + int j; + DP xx,xmin,fx,fb,fa,bx,ax; + + int n=p.size(); + ncom=n; + pcom_p=new Vec_DP(n); + xicom_p=new Vec_DP(n); + nrfunc=func; + nrdfun=dfunc; + Vec_DP &pcom=*pcom_p,&xicom=*xicom_p; + for (j=0;j +#include +#include "nr.h" +using namespace std; + +DP NR::ei(const DP x) +{ + const int MAXIT=100; + const DP EULER=0.577215664901533; + const DP EPS=numeric_limits::epsilon(); + const DP FPMIN=numeric_limits::min()/EPS; + int k; + DP fact,prev,sum,term; + + if (x <= 0.0) nrerror("Bad argument in ei"); + if (x < FPMIN) return log(x)+EULER; + if (x <= -log(EPS)) { + sum=0.0; + fact=1.0; + for (k=1;k<=MAXIT;k++) { + fact *= x/k; + term=fact/k; + sum += term; + if (term < EPS*sum) break; + } + if (k > MAXIT) nrerror("Series failed in ei"); + return sum+log(x)+EULER; + } else { + sum=0.0; + term=1.0; + for (k=1;k<=MAXIT;k++) { + prev=term; + term *= k/x; + if (term < EPS) break; + if (term < prev) sum += term; + else { + sum -= prev; + break; + } + } + return exp(x)*(1.0+sum)/x; + } +} diff --git a/lib/nr/cpp/recipes/eigsrt.cpp b/lib/nr/cpp/recipes/eigsrt.cpp new file mode 100644 index 0000000..700c327 --- /dev/null +++ b/lib/nr/cpp/recipes/eigsrt.cpp @@ -0,0 +1,23 @@ +#include "nr.h" + +void NR::eigsrt(Vec_IO_DP &d, Mat_IO_DP &v) +{ + int i,j,k; + DP p; + + int n=d.size(); + for (i=0;i= p) p=d[k=j]; + if (k != i) { + d[k]=d[i]; + d[i]=p; + for (j=0;j +#include "nr.h" +using namespace std; + +DP NR::elle(const DP phi, const DP ak) +{ + DP cc,q,s; + + s=sin(phi); + cc=SQR(cos(phi)); + q=(1.0-s*ak)*(1.0+s*ak); + return s*(rf(cc,q,1.0)-(SQR(s*ak))*rd(cc,q,1.0)/3.0); +} diff --git a/lib/nr/cpp/recipes/ellf.cpp b/lib/nr/cpp/recipes/ellf.cpp new file mode 100644 index 0000000..c4bce07 --- /dev/null +++ b/lib/nr/cpp/recipes/ellf.cpp @@ -0,0 +1,11 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::ellf(const DP phi, const DP ak) +{ + DP s; + + s=sin(phi); + return s*rf(SQR(cos(phi)),(1.0-s*ak)*(1.0+s*ak),1.0); +} diff --git a/lib/nr/cpp/recipes/ellpi.cpp b/lib/nr/cpp/recipes/ellpi.cpp new file mode 100644 index 0000000..bcf1503 --- /dev/null +++ b/lib/nr/cpp/recipes/ellpi.cpp @@ -0,0 +1,14 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::ellpi(const DP phi, const DP en, const DP ak) +{ + DP cc,enss,q,s; + + s=sin(phi); + enss=en*s*s; + cc=SQR(cos(phi)); + q=(1.0-s*ak)*(1.0+s*ak); + return s*(rf(cc,q,1.0)-enss*rj(cc,q,1.0,1.0+enss)/3.0); +} diff --git a/lib/nr/cpp/recipes/elmhes.cpp b/lib/nr/cpp/recipes/elmhes.cpp new file mode 100644 index 0000000..519e6a8 --- /dev/null +++ b/lib/nr/cpp/recipes/elmhes.cpp @@ -0,0 +1,35 @@ +#include +#include "nr.h" +using namespace std; + +void NR::elmhes(Mat_IO_DP &a) +{ + int i,j,m; + DP y,x; + + int n=a.nrows(); + for (m=1;m fabs(x)) { + x=a[j][m-1]; + i=j; + } + } + if (i != m) { + for (j=m-1;j +#include "nr.h" +using namespace std; + +DP NR::erfcc(const DP x) +{ + DP t,z,ans; + + z=fabs(x); + t=1.0/(1.0+0.5*z); + ans=t*exp(-z*z-1.26551223+t*(1.00002368+t*(0.37409196+t*(0.09678418+ + t*(-0.18628806+t*(0.27886807+t*(-1.13520398+t*(1.48851587+ + t*(-0.82215223+t*0.17087277))))))))); + return (x >= 0.0 ? ans : 2.0-ans); +} diff --git a/lib/nr/cpp/recipes/erff.cpp b/lib/nr/cpp/recipes/erff.cpp new file mode 100644 index 0000000..344c140 --- /dev/null +++ b/lib/nr/cpp/recipes/erff.cpp @@ -0,0 +1,6 @@ +#include "nr.h" + +DP NR::erff(const DP x) +{ + return x < 0.0 ? -gammp(0.5,x*x) : gammp(0.5,x*x); +} diff --git a/lib/nr/cpp/recipes/erffc.cpp b/lib/nr/cpp/recipes/erffc.cpp new file mode 100644 index 0000000..2188803 --- /dev/null +++ b/lib/nr/cpp/recipes/erffc.cpp @@ -0,0 +1,6 @@ +#include "nr.h" + +DP NR::erffc(const DP x) +{ + return x < 0.0 ? 1.0+gammp(0.5,x*x) : gammq(0.5,x*x); +} diff --git a/lib/nr/cpp/recipes/eulsum.cpp b/lib/nr/cpp/recipes/eulsum.cpp new file mode 100644 index 0000000..c9b5f24 --- /dev/null +++ b/lib/nr/cpp/recipes/eulsum.cpp @@ -0,0 +1,29 @@ +#include +#include "nr.h" +using namespace std; + +void NR::eulsum(DP &sum, const DP term, const int jterm, Vec_IO_DP &wksp) +{ + int j; + static int nterm; + DP tmp,dum; + + if (jterm == 0) { + nterm=1; + sum=0.5*(wksp[0]=term); + } else { + if (nterm+1 > wksp.size()) nrerror("wksp too small in euler"); + tmp=wksp[0]; + wksp[0]=term; + for (j=1;j +#include "nr.h" +using namespace std; + +DP NR::evlmem(const DP fdt, Vec_I_DP &d, const DP xms) +{ + int i; + DP sumr=1.0,sumi=0.0,wr=1.0,wi=0.0,wpr,wpi,wtemp,theta; + + int m=d.size(); + theta=6.28318530717959*fdt; + wpr=cos(theta); + wpi=sin(theta); + for (i=0;i +#include "nr.h" +using namespace std; + +DP NR::expdev(int &idum) +{ + DP dum; + + do + dum=ran1(idum); + while (dum == 0.0); + return -log(dum); +} diff --git a/lib/nr/cpp/recipes/expint.cpp b/lib/nr/cpp/recipes/expint.cpp new file mode 100644 index 0000000..04917b4 --- /dev/null +++ b/lib/nr/cpp/recipes/expint.cpp @@ -0,0 +1,61 @@ +#include +#include +#include "nr.h" +using namespace std; + +DP NR::expint(const int n, const DP x) +{ + const int MAXIT=100; + const DP EULER=0.577215664901533; + const DP EPS=numeric_limits::epsilon(); + const DP BIG=numeric_limits::max()*EPS; + int i,ii,nm1; + DP a,b,c,d,del,fact,h,psi,ans; + + nm1=n-1; + if (n < 0 || x < 0.0 || (x==0.0 && (n==0 || n==1))) + nrerror("bad arguments in expint"); + else { + if (n == 0) ans=exp(-x)/x; + else { + if (x == 0.0) ans=1.0/nm1; + else { + if (x > 1.0) { + b=x+n; + c=BIG; + d=1.0/b; + h=d; + for (i=1;i<=MAXIT;i++) { + a = -i*(nm1+i); + b += 2.0; + d=1.0/(a*d+b); + c=b+a/c; + del=c*d; + h *= del; + if (fabs(del-1.0) <= EPS) { + ans=h*exp(-x); + return ans; + } + } + nrerror("continued fraction failed in expint"); + } else { + ans = (nm1!=0 ? 1.0/nm1 : -log(x)-EULER); + fact=1.0; + for (i=1;i<=MAXIT;i++) { + fact *= -x/i; + if (i != nm1) del = -fact/(i-nm1); + else { + psi = -EULER; + for (ii=1;ii<=nm1;ii++) psi += 1.0/ii; + del=fact*(-log(x)+psi); + } + ans += del; + if (fabs(del) < fabs(ans)*EPS) return ans; + } + nrerror("series failed in expint"); + } + } + } + } + return ans; +} diff --git a/lib/nr/cpp/recipes/f1dim.cpp b/lib/nr/cpp/recipes/f1dim.cpp new file mode 100644 index 0000000..cdaef29 --- /dev/null +++ b/lib/nr/cpp/recipes/f1dim.cpp @@ -0,0 +1,16 @@ +#include "nr.h" + +extern int ncom; +extern DP (*nrfunc)(Vec_I_DP &); +extern Vec_DP *pcom_p,*xicom_p; + +DP NR::f1dim(const DP x) +{ + int j; + + Vec_DP xt(ncom); + Vec_DP &pcom=*pcom_p,&xicom=*xicom_p; + for (j=0;j +#include "nr.h" +using namespace std; + +DP NR::factrl(const int n) +{ + static int ntop=4; + static DP a[33]={1.0,1.0,2.0,6.0,24.0}; + int j; + + if (n < 0) nrerror("Negative factorial in routine factrl"); + if (n > 32) return exp(gammln(n+1.0)); + while (ntop +#include "nr.h" +using namespace std; + +void NR::fasper(Vec_I_DP &x, Vec_I_DP &y, const DP ofac, const DP hifac, + Vec_O_DP &wk1, Vec_O_DP &wk2, int &nout, int &jmax, DP &prob) +{ + const int MACC=4; + int j,k,ndim,nfreq,nfreqt; + DP ave,ck,ckk,cterm,cwt,den,df,effm,expy,fac,fndim,hc2wt,hs2wt, + hypo,pmax,sterm,swt,var,xdif,xmax,xmin; + + int n=x.size(); + int nwk=wk1.size(); + nout=0.5*ofac*hifac*n; + nfreqt=ofac*hifac*n*MACC; + nfreq=64; + while (nfreq < nfreqt) nfreq <<= 1; + ndim=nfreq << 1; + if (ndim > nwk) nrerror("workspaces too small in fasper"); + avevar(y,ave,var); + if (var == 0.0) nrerror("zero variance in fasper"); + xmin=x[0]; + xmax=xmin; + for (j=1;j xmax) xmax=x[j]; + } + xdif=xmax-xmin; + Vec_DP wk1_t(0.0,ndim); + Vec_DP wk2_t(0.0,ndim); + fac=ndim/(xdif*ofac); + fndim=ndim; + for (j=0;j pmax) pmax=wk2[jmax=j]; + } + expy=exp(-pmax); + effm=2.0*nout/ofac; + prob=effm*expy; + if (prob > 0.01) prob=1.0-pow(1.0-expy,effm); +} diff --git a/lib/nr/cpp/recipes/fdjac.cpp b/lib/nr/cpp/recipes/fdjac.cpp new file mode 100644 index 0000000..9b4a0f8 --- /dev/null +++ b/lib/nr/cpp/recipes/fdjac.cpp @@ -0,0 +1,25 @@ +#include +#include "nr.h" +using namespace std; + +void NR::fdjac(Vec_IO_DP &x, Vec_I_DP &fvec, Mat_O_DP &df, + void vecfunc(Vec_I_DP &, Vec_O_DP &)) +{ + const DP EPS=1.0e-8; + int i,j; + DP h,temp; + + int n=x.size(); + Vec_DP f(n); + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::fgauss(const DP x, Vec_I_DP &a, DP &y, Vec_O_DP &dyda) +{ + int i; + DP fac,ex,arg; + + int na=a.size(); + y=0.0; + for (i=0;i +#include "nr.h" +using namespace std; + +void NR::fit(Vec_I_DP &x, Vec_I_DP &y, Vec_I_DP &sig, const bool mwt, DP &a, + DP &b, DP &siga, DP &sigb, DP &chi2, DP &q) +{ + int i; + DP wt,t,sxoss,sx=0.0,sy=0.0,st2=0.0,ss,sigdat; + + int ndata=x.size(); + b=0.0; + if (mwt) { + ss=0.0; + for (i=0;i2) q=gammq(0.5*(ndata-2),0.5*chi2); + } +} diff --git a/lib/nr/cpp/recipes/fitexy.cpp b/lib/nr/cpp/recipes/fitexy.cpp new file mode 100644 index 0000000..6f254cc --- /dev/null +++ b/lib/nr/cpp/recipes/fitexy.cpp @@ -0,0 +1,75 @@ +#include +#include "nr.h" +using namespace std; + +Vec_DP *xx_p,*yy_p,*sx_p,*sy_p,*ww_p; +DP aa,offs; + +void NR::fitexy(Vec_I_DP &x, Vec_I_DP &y, Vec_I_DP &sigx, Vec_I_DP &sigy, + DP &a, DP &b, DP &siga, DP &sigb, DP &chi2, DP &q) +{ + int j; + const DP POTN=1.571000,BIG=1.0e30,ACC=1.0e-3; + const DP PI=3.141592653589793238; + DP amx,amn,varx,vary,ang[7],ch[7],scale,bmn,bmx,d1,d2,r2, + dum1,dum2,dum3,dum4,dum5; + + int ndat=x.size(); + xx_p=new Vec_DP(ndat); + yy_p=new Vec_DP(ndat); + sx_p=new Vec_DP(ndat); + sy_p=new Vec_DP(ndat); + ww_p=new Vec_DP(ndat); + Vec_DP &xx=*xx_p, &yy=*yy_p; + Vec_DP &sx=*sx_p, &sy=*sy_p, &ww=*ww_p; + avevar(x,dum1,varx); + avevar(y,dum1,vary); + scale=sqrt(varx/vary); + for (j=0;j offs) { + d1=fabs(ang[j]-b); + while (d1 >= PI) d1 -= PI; + d2=PI-d1; + if (ang[j] < b) + SWAP(d1,d2); + if (d1 < bmx) bmx=d1; + if (d2 < bmn) bmn=d2; + } + } + if (bmx < BIG) { + bmx=zbrent(chixy,b,b+bmx,ACC)-b; + amx=aa-a; + bmn=zbrent(chixy,b,b-bmn,ACC)-b; + amn=aa-a; + sigb=sqrt(0.5*(bmx*bmx+bmn*bmn))/(scale*SQR(cos(b))); + siga=sqrt(0.5*(amx*amx+amn*amn)+r2)/scale; + } else sigb=siga=BIG; + a /= scale; + b=tan(b)/scale; + delete ww_p; delete sy_p; delete sx_p; delete yy_p; delete xx_p; +} diff --git a/lib/nr/cpp/recipes/fixrts.cpp b/lib/nr/cpp/recipes/fixrts.cpp new file mode 100644 index 0000000..e9e0e3d --- /dev/null +++ b/lib/nr/cpp/recipes/fixrts.cpp @@ -0,0 +1,30 @@ +#include +#include +#include "nr.h" +using namespace std; + +void NR::fixrts(Vec_IO_DP &d) +{ + bool polish=true; + int i,j; + + int m=d.size(); + Vec_CPLX_DP a(m+1),roots(m); + a[m]=1.0; + for (j=0;j 1.0) + roots[j]=1.0/conj(roots[j]); + a[0]= -roots[0]; + a[1]=1.0; + for (j=1;j=1;i--) + a[i]=a[i-1]-roots[j]*a[i]; + a[0]= -roots[j]*a[0]; + } + for (j=0;j 2) { + twox=2.0*x; + f2=x; + d=1.0; + for (j=2;j +#include "nr.h" +using namespace std; + +void NR::flmoon(const int n, const int nph, int &jd, DP &frac) +{ + const DP RAD=3.141592653589793238/180.0; + int i; + DP am,as,c,t,t2,xtra; + + c=n+nph/4.0; + t=c/1236.85; + t2=t*t; + as=359.2242+29.105356*c; + am=306.0253+385.816918*c+0.010730*t2; + jd=2415020+28*n+7*nph; + xtra=0.75933+1.53058868*c+((1.178e-4)-(1.55e-7)*t)*t2; + if (nph == 0 || nph == 2) + xtra += (0.1734-3.93e-4*t)*sin(RAD*as)-0.4068*sin(RAD*am); + else if (nph == 1 || nph == 3) + xtra += (0.1721-4.0e-4*t)*sin(RAD*as)-0.6280*sin(RAD*am); + else nrerror("nph is unknown in flmoon"); + i=int(xtra >= 0.0 ? floor(xtra) : ceil(xtra-1.0)); + jd += i; + frac=xtra-i; +} diff --git a/lib/nr/cpp/recipes/fmin.cpp b/lib/nr/cpp/recipes/fmin.cpp new file mode 100644 index 0000000..5a1838a --- /dev/null +++ b/lib/nr/cpp/recipes/fmin.cpp @@ -0,0 +1,16 @@ +#include "nr.h" + +extern Vec_DP *fvec_p; +extern void (*nrfuncv)(Vec_I_DP &v, Vec_O_DP &f); + +DP NR::fmin(Vec_I_DP &x) +{ + int i; + DP sum; + + Vec_DP &fvec=*fvec_p; + nrfuncv(x,fvec); + int n=x.size(); + for (sum=0.0,i=0;i +#include "nr.h" +using namespace std; + +void NR::four1(Vec_IO_DP &data, const int isign) +{ + int n,mmax,m,j,istep,i; + DP wtemp,wr,wpr,wpi,wi,theta,tempr,tempi; + + int nn=data.size()/2; + n=nn << 1; + j=1; + for (i=1;i i) { + SWAP(data[j-1],data[i-1]); + SWAP(data[j],data[i]); + } + m=nn; + while (m >= 2 && j > m) { + j -= m; + m >>= 1; + } + j += m; + } + mmax=2; + while (n > mmax) { + istep=mmax << 1; + theta=isign*(6.28318530717959/mmax); + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0; + wi=0.0; + for (m=1;m +#include "nr.h" +using namespace std; + +void NR::fourew(Vec_FSTREAM_p &file, int &na, int &nb, int &nc, int &nd) +{ + int i; + + for (i=0;i<4;i++) (*file[i]).seekp(0); + for (i=0;i<4;i++) (*file[i]).seekg(0); + SWAP(file[1],file[3]); + SWAP(file[0],file[2]); + na=2; + nb=3; + nc=0; + nd=1; +} diff --git a/lib/nr/cpp/recipes/fourfs.cpp b/lib/nr/cpp/recipes/fourfs.cpp new file mode 100644 index 0000000..35280e2 --- /dev/null +++ b/lib/nr/cpp/recipes/fourfs.cpp @@ -0,0 +1,164 @@ +#include +#include +#include +#include "nr.h" +using namespace std; + +void NR::fourfs(Vec_FSTREAM_p &file, Vec_I_INT &nn, const int isign) +{ + const int KBF=128; + static int mate[4]={1,0,3,2}; + int cc,cc0,j,j12,jk,k,kk,n=1,mm,kc=0,kd,ks,kr,na,nb,nc,nd,nr,ns,nv; + DP tempr,tempi,wr,wi,wpr,wpi,wtemp,theta; + Vec_DP afa(KBF),afb(KBF),afc(KBF); + + int ndim=nn.size(); + for (j=0;j> 1; + kd=KBF >> 1; + ks=n; + fourew(file,na,nb,nc,nd); + for (;;) { + theta=isign*3.141592653589793/(n/mm); + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0; + wi=0.0; + mm >>= 1; + for (j12=0;j12<2;j12++) { + kr=0; + do { + cc0=(*file[na]).tellg()/sizeof(DP); + (*file[na]).read((char *) &afa[0],KBF*sizeof(DP)); + cc=(*file[na]).tellg()/sizeof(DP); + if ((cc-cc0) != KBF) nrerror("read error 1 in fourfs"); + cc0=(*file[nb]).tellg()/sizeof(DP); + (*file[nb]).read((char *) &afb[0],KBF*sizeof(DP)); + cc=(*file[nb]).tellg()/sizeof(DP); + if ((cc-cc0) != KBF) nrerror("read error 2 in fourfs"); + for (j=0;j>= 1; + while (jk == 1) { + mm=n; + jk=nn[++nv]; + } + ks >>= 1; + if (ks > KBF) { + for (j12=0;j12<2;j12++) { + for (kr=0;kr>= 1; + ks=kd; + kd >>= 1; + for (j12=0;j12<2;j12++) { + for (kr=0;kr KBF-1) break; + else k=kk+ks; + } + if (j > KBF-1) { + cc0=(*file[nc]).tellp()/sizeof(DP); + (*file[nc]).write((char *) &afa[0],KBF*sizeof(DP)); + cc=(*file[nc]).tellp()/sizeof(DP); + if ((cc-cc0) != KBF) nrerror("write error 4 in fourfs"); + cc0=(*file[nd]).tellp()/sizeof(DP); + (*file[nd]).write((char *) &afb[0],KBF*sizeof(DP)); + cc=(*file[nd]).tellp()/sizeof(DP); + if ((cc-cc0) != KBF) nrerror("write error 5 in fourfs"); + j=0; + } + } + na=mate[na]; + } + fourew(file,na,nb,nc,nd); + jk >>= 1; + if (jk > 1) continue; + mm=n; + do { + if (nv < ndim-1) jk=nn[++nv]; + else return; + } while (jk == 1); + } +} diff --git a/lib/nr/cpp/recipes/fourn.cpp b/lib/nr/cpp/recipes/fourn.cpp new file mode 100644 index 0000000..b9f7eba --- /dev/null +++ b/lib/nr/cpp/recipes/fourn.cpp @@ -0,0 +1,67 @@ +#include +#include "nr.h" +using namespace std; + +void NR::fourn(Vec_IO_DP &data, Vec_I_INT &nn, const int isign) +{ + int idim,i1,i2,i3,i2rev,i3rev,ip1,ip2,ip3,ifp1,ifp2; + int ibit,k1,k2,n,nprev,nrem,ntot; + DP tempi,tempr,theta,wi,wpi,wpr,wr,wtemp; + + int ndim=nn.size(); + ntot=data.size()/2; + nprev=1; + for (idim=ndim-1;idim>=0;idim--) { + n=nn[idim]; + nrem=ntot/(n*nprev); + ip1=nprev << 1; + ip2=ip1*n; + ip3=ip2*nrem; + i2rev=0; + for (i2=0;i2> 1; + while (ibit >= ip1 && i2rev+1 > ibit) { + i2rev -= ibit; + ibit >>= 1; + } + i2rev += ibit; + } + ifp1=ip1; + while (ifp1 < ip2) { + ifp2=ifp1 << 1; + theta=isign*6.28318530717959/(ifp2/ip1); + wtemp=sin(0.5*theta); + wpr= -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0; + wi=0.0; + for (i3=0;i3 +#include +#include +#include "nr.h" +using namespace std; + +int main(void) // Program fredex +{ + const int N=40; + const DP PI=3.141592653589793238; + int j; + DP d,x; + Vec_INT indx(N); + Vec_DP g(N); + Mat_DP a(N,N); + + NR::quadmx(a); + NR::ludcmp(a,indx,d); + for (j=0;j +#include +#include +#include "nr.h" +using namespace std; + +void NR::frenel(const DP x, complex &cs) +{ + const int MAXIT=100; + const DP EPS=numeric_limits::epsilon(); + const DP FPMIN=numeric_limits::min(); + const DP BIG=numeric_limits::max()*EPS; + const DP PI=3.141592653589793238, PIBY2=(PI/2.0), XMIN=1.5; + bool odd; + int k,n; + DP a,ax,fact,pix2,sign,sum,sumc,sums,term,test; + complex b,cc,d,h,del; + + ax=fabs(x); + if (ax < sqrt(FPMIN)) { + cs=ax; + } else if (ax <= XMIN) { + sum=sums=0.0; + sumc=ax; + sign=1.0; + fact=PIBY2*ax*ax; + odd=true; + term=ax; + n=3; + for (k=1;k<=MAXIT;k++) { + term *= fact/k; + sum += sign*term/n; + test=fabs(sum)*EPS; + if (odd) { + sign = -sign; + sums=sum; + sum=sumc; + } else { + sumc=sum; + sum=sums; + } + if (term < test) break; + odd=!odd; + n += 2; + } + if (k > MAXIT) nrerror("series failed in frenel"); + cs=complex(sumc,sums); + } else { + pix2=PI*ax*ax; + b=complex(1.0,-pix2); + cc=BIG; + d=h=1.0/b; + n = -1; + for (k=2;k<=MAXIT;k++) { + n += 2; + a = -n*(n+1); + b += 4.0; + d=1.0/(a*d+b); + cc=b+a/cc; + del=cc*d; + h *= del; + if (fabs(real(del)-1.0)+fabs(imag(del)) <= EPS) break; + } + if (k > MAXIT) nrerror("cf failed in frenel"); + h *= complex(ax,-ax); + cs=complex(0.5,0.5) + *(1.0-complex(cos(0.5*pix2),sin(0.5*pix2))*h); + } + if (x < 0.0) { + cs = -cs; + } + return; +} diff --git a/lib/nr/cpp/recipes/frprmn.cpp b/lib/nr/cpp/recipes/frprmn.cpp new file mode 100644 index 0000000..8fdfa44 --- /dev/null +++ b/lib/nr/cpp/recipes/frprmn.cpp @@ -0,0 +1,43 @@ +#include +#include "nr.h" +using namespace std; + +void NR::frprmn(Vec_IO_DP &p, const DP ftol, int &iter, DP &fret, + DP func(Vec_I_DP &), void dfunc(Vec_I_DP &, Vec_O_DP &)) +{ + const int ITMAX=200; + const DP EPS=1.0e-18; + int j,its; + DP gg,gam,fp,dgg; + + int n=p.size(); + Vec_DP g(n),h(n),xi(n); + fp=func(p); + dfunc(p,xi); + for (j=0;j var2) { + f=var1/var2; + df1=n1-1; + df2=n2-1; + } else { + f=var2/var1; + df1=n2-1; + df2=n1-1; + } + prob = 2.0*betai(0.5*df2,0.5*df1,df2/(df2+df1*f)); + if (prob > 1.0) prob=2.0-prob; +} diff --git a/lib/nr/cpp/recipes/gamdev.cpp b/lib/nr/cpp/recipes/gamdev.cpp new file mode 100644 index 0000000..874416c --- /dev/null +++ b/lib/nr/cpp/recipes/gamdev.cpp @@ -0,0 +1,31 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::gamdev(const int ia, int &idum) +{ + int j; + DP am,e,s,v1,v2,x,y; + + if (ia < 1) nrerror("Error in routine gamdev"); + if (ia < 6) { + x=1.0; + for (j=1;j<=ia;j++) x *= ran1(idum); + x = -log(x); + } else { + do { + do { + do { + v1=ran1(idum); + v2=2.0*ran1(idum)-1.0; + } while (v1*v1+v2*v2 > 1.0); + y=v2/v1; + am=ia-1; + s=sqrt(2.0*am+1.0); + x=s*y+am; + } while (x <= 0.0); + e=(1.0+y*y)*exp(am*log(x/am)-s*y); + } while (ran1(idum) > e); + } + return x; +} diff --git a/lib/nr/cpp/recipes/gammln.cpp b/lib/nr/cpp/recipes/gammln.cpp new file mode 100644 index 0000000..9dcc527 --- /dev/null +++ b/lib/nr/cpp/recipes/gammln.cpp @@ -0,0 +1,19 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::gammln(const DP xx) +{ + int j; + DP x,y,tmp,ser; + static const DP cof[6]={76.18009172947146,-86.50532032941677, + 24.01409824083091,-1.231739572450155,0.1208650973866179e-2, + -0.5395239384953e-5}; + + y=x=xx; + tmp=x+5.5; + tmp -= (x+0.5)*log(tmp); + ser=1.000000000190015; + for (j=0;j<6;j++) ser += cof[j]/++y; + return -tmp+log(2.5066282746310005*ser/x); +} diff --git a/lib/nr/cpp/recipes/gammp.cpp b/lib/nr/cpp/recipes/gammp.cpp new file mode 100644 index 0000000..c65f3ee --- /dev/null +++ b/lib/nr/cpp/recipes/gammp.cpp @@ -0,0 +1,16 @@ +#include "nr.h" + +DP NR::gammp(const DP a, const DP x) +{ + DP gamser,gammcf,gln; + + if (x < 0.0 || a <= 0.0) + nrerror("Invalid arguments in routine gammp"); + if (x < a+1.0) { + gser(gamser,a,x,gln); + return gamser; + } else { + gcf(gammcf,a,x,gln); + return 1.0-gammcf; + } +} diff --git a/lib/nr/cpp/recipes/gammq.cpp b/lib/nr/cpp/recipes/gammq.cpp new file mode 100644 index 0000000..ff79659 --- /dev/null +++ b/lib/nr/cpp/recipes/gammq.cpp @@ -0,0 +1,16 @@ +#include "nr.h" + +DP NR::gammq(const DP a, const DP x) +{ + DP gamser,gammcf,gln; + + if (x < 0.0 || a <= 0.0) + nrerror("Invalid arguments in routine gammq"); + if (x < a+1.0) { + gser(gamser,a,x,gln); + return 1.0-gamser; + } else { + gcf(gammcf,a,x,gln); + return gammcf; + } +} diff --git a/lib/nr/cpp/recipes/gasdev.cpp b/lib/nr/cpp/recipes/gasdev.cpp new file mode 100644 index 0000000..0b0cd19 --- /dev/null +++ b/lib/nr/cpp/recipes/gasdev.cpp @@ -0,0 +1,26 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::gasdev(int &idum) +{ + static int iset=0; + static DP gset; + DP fac,rsq,v1,v2; + + if (idum < 0) iset=0; + if (iset == 0) { + do { + v1=2.0*ran1(idum)-1.0; + v2=2.0*ran1(idum)-1.0; + rsq=v1*v1+v2*v2; + } while (rsq >= 1.0 || rsq == 0.0); + fac=sqrt(-2.0*log(rsq)/rsq); + gset=v1*fac; + iset=1; + return v2*fac; + } else { + iset=0; + return gset; + } +} diff --git a/lib/nr/cpp/recipes/gaucof.cpp b/lib/nr/cpp/recipes/gaucof.cpp new file mode 100644 index 0000000..90b220e --- /dev/null +++ b/lib/nr/cpp/recipes/gaucof.cpp @@ -0,0 +1,22 @@ +#include +#include "nr.h" +using namespace std; + +void NR::gaucof(Vec_IO_DP &a, Vec_IO_DP &b, const DP amu0, Vec_O_DP &x, + Vec_O_DP &w) +{ + int i,j; + + int n=a.size(); + Mat_DP z(n,n); + for (i=0;i +#include "nr.h" +using namespace std; + +void NR::gauher(Vec_O_DP &x, Vec_O_DP &w) +{ + const DP EPS=1.0e-14,PIM4=0.7511255444649425; + const int MAXIT=10; + int i,its,j,m; + DP p1,p2,p3,pp,z,z1; + + int n=x.size(); + m=(n+1)/2; + for (i=0;i= MAXIT) nrerror("too many iterations in gauher"); + x[i]=z; + x[n-1-i] = -z; + w[i]=2.0/(pp*pp); + w[n-1-i]=w[i]; + } +} diff --git a/lib/nr/cpp/recipes/gaujac.cpp b/lib/nr/cpp/recipes/gaujac.cpp new file mode 100644 index 0000000..32be13e --- /dev/null +++ b/lib/nr/cpp/recipes/gaujac.cpp @@ -0,0 +1,68 @@ +#include +#include "nr.h" +using namespace std; + +void NR::gaujac(Vec_O_DP &x, Vec_O_DP &w, const DP alf, const DP bet) +{ + const int MAXIT=10; + const DP EPS=1.0e-14; + int i,its,j; + DP alfbet,an,bn,r1,r2,r3; + DP a,b,c,p1,p2,p3,pp,temp,z,z1; + + int n=x.size(); + for (i=0;i MAXIT) nrerror("too many iterations in gaujac"); + x[i]=z; + w[i]=exp(gammln(alf+n)+gammln(bet+n)-gammln(n+1.0)- + gammln(n+alfbet+1.0))*temp*pow(2.0,alfbet)/(pp*p2); + } +} diff --git a/lib/nr/cpp/recipes/gaulag.cpp b/lib/nr/cpp/recipes/gaulag.cpp new file mode 100644 index 0000000..ed26e34 --- /dev/null +++ b/lib/nr/cpp/recipes/gaulag.cpp @@ -0,0 +1,40 @@ +#include +#include "nr.h" +using namespace std; + +void NR::gaulag(Vec_O_DP &x, Vec_O_DP &w, const DP alf) +{ + const int MAXIT=10; + const DP EPS=1.0e-14; + int i,its,j; + DP ai,p1,p2,p3,pp,z,z1; + + int n=x.size(); + for (i=0;i= MAXIT) nrerror("too many iterations in gaulag"); + x[i]=z; + w[i] = -exp(gammln(alf+n)-gammln(DP(n)))/(pp*n*p2); + } +} diff --git a/lib/nr/cpp/recipes/gauleg.cpp b/lib/nr/cpp/recipes/gauleg.cpp new file mode 100644 index 0000000..a8e517d --- /dev/null +++ b/lib/nr/cpp/recipes/gauleg.cpp @@ -0,0 +1,34 @@ +#include +#include "nr.h" +using namespace std; + +void NR::gauleg(const DP x1, const DP x2, Vec_O_DP &x, Vec_O_DP &w) +{ + const DP EPS=1.0e-14; + int m,j,i; + DP z1,z,xm,xl,pp,p3,p2,p1; + + int n=x.size(); + m=(n+1)/2; + xm=0.5*(x2+x1); + xl=0.5*(x2-x1); + for (i=0;i EPS); + x[i]=xm-xl*z; + x[n-1-i]=xm+xl*z; + w[i]=2.0*xl/((1.0-z*z)*pp*pp); + w[n-1-i]=w[i]; + } +} diff --git a/lib/nr/cpp/recipes/gaussj.cpp b/lib/nr/cpp/recipes/gaussj.cpp new file mode 100644 index 0000000..097c829 --- /dev/null +++ b/lib/nr/cpp/recipes/gaussj.cpp @@ -0,0 +1,52 @@ +#include +#include "nr.h" +using namespace std; + +void NR::gaussj(Mat_IO_DP &a, Mat_IO_DP &b) +{ + int i,icol,irow,j,k,l,ll; + DP big,dum,pivinv; + + int n=a.nrows(); + int m=b.ncols(); + Vec_INT indxc(n),indxr(n),ipiv(n); + for (j=0;j= big) { + big=fabs(a[j][k]); + irow=j; + icol=k; + } + } + } + ++(ipiv[icol]); + if (irow != icol) { + for (l=0;l=0;l--) { + if (indxr[l] != indxc[l]) + for (k=0;k +#include +#include "nr.h" +using namespace std; + +void NR::gcf(DP &gammcf, const DP a, const DP x, DP &gln) +{ + const int ITMAX=100; + const DP EPS=numeric_limits::epsilon(); + const DP FPMIN=numeric_limits::min()/EPS; + int i; + DP an,b,c,d,del,h; + + gln=gammln(a); + b=x+1.0-a; + c=1.0/FPMIN; + d=1.0/b; + h=d; + for (i=1;i<=ITMAX;i++) { + an = -i*(i-a); + b += 2.0; + d=an*d+b; + if (fabs(d) < FPMIN) d=FPMIN; + c=b+an/c; + if (fabs(c) < FPMIN) c=FPMIN; + d=1.0/d; + del=d*c; + h *= del; + if (fabs(del-1.0) <= EPS) break; + } + if (i > ITMAX) nrerror("a too large, ITMAX too small in gcf"); + gammcf=exp(-x+a*log(x)-gln)*h; +} diff --git a/lib/nr/cpp/recipes/golden.cpp b/lib/nr/cpp/recipes/golden.cpp new file mode 100644 index 0000000..fb2147b --- /dev/null +++ b/lib/nr/cpp/recipes/golden.cpp @@ -0,0 +1,53 @@ +#include +#include "nr.h" +using namespace std; + +namespace { + inline void shft2(DP &a, DP &b, const DP c) + { + a=b; + b=c; + } + + inline void shft3(DP &a, DP &b, DP &c, const DP d) + { + a=b; + b=c; + c=d; + } +} + +DP NR::golden(const DP ax, const DP bx, const DP cx, DP f(const DP), + const DP tol, DP &xmin) +{ + const DP R=0.61803399,C=1.0-R; + DP f1,f2,x0,x1,x2,x3; + + x0=ax; + x3=cx; + if (fabs(cx-bx) > fabs(bx-ax)) { + x1=bx; + x2=bx+C*(cx-bx); + } else { + x2=bx; + x1=bx-C*(bx-ax); + } + f1=f(x1); + f2=f(x2); + while (fabs(x3-x0) > tol*(fabs(x1)+fabs(x2))) { + if (f2 < f1) { + shft3(x0,x1,x2,R*x2+C*x3); + shft2(f1,f2,f(x2)); + } else { + shft3(x3,x2,x1,R*x1+C*x0); + shft2(f2,f1,f(x1)); + } + } + if (f1 < f2) { + xmin=x1; + return f1; + } else { + xmin=x2; + return f2; + } +} diff --git a/lib/nr/cpp/recipes/gser.cpp b/lib/nr/cpp/recipes/gser.cpp new file mode 100644 index 0000000..6162f49 --- /dev/null +++ b/lib/nr/cpp/recipes/gser.cpp @@ -0,0 +1,33 @@ +#include +#include +#include "nr.h" +using namespace std; + +void NR::gser(DP &gamser, const DP a, const DP x, DP &gln) +{ + const int ITMAX=100; + const DP EPS=numeric_limits::epsilon(); + int n; + DP sum,del,ap; + + gln=gammln(a); + if (x <= 0.0) { + if (x < 0.0) nrerror("x less than 0 in routine gser"); + gamser=0.0; + return; + } else { + ap=a; + del=sum=1.0/a; + for (n=0;n n/2 || m < 1) nrerror("probable misuse of hpsel"); + for (i=0;i heap[0]) { + heap[0]=arr[i]; + for (j=0;;) { + k=(j << 1)+1; + if (k > m-1) break; + if (k != (m-1) && heap[k] > heap[k+1]) k++; + if (heap[j] <= heap[k]) break; + SWAP(heap[k],heap[j]); + j=k; + } + } + } +} diff --git a/lib/nr/cpp/recipes/hpsort.cpp b/lib/nr/cpp/recipes/hpsort.cpp new file mode 100644 index 0000000..ab73a0e --- /dev/null +++ b/lib/nr/cpp/recipes/hpsort.cpp @@ -0,0 +1,34 @@ +#include "nr.h" + +namespace { + void sift_down(Vec_IO_DP &ra, const int l, const int r) + { + int j,jold; + DP a; + + a=ra[l]; + jold=l; + j=l+1; + while (j <= r) { + if (j < r && ra[j] < ra[j+1]) j++; + if (a >= ra[j]) break; + ra[jold]=ra[j]; + jold=j; + j=2*j+1; + } + ra[jold]=a; + } +} + +void NR::hpsort(Vec_IO_DP &ra) +{ + int i; + + int n=ra.size(); + for (i=n/2-1; i>=0; i--) + sift_down(ra,i,n-1); + for (i=n-1; i>0; i--) { + SWAP(ra[0],ra[i]); + sift_down(ra,0,i-1); + } +} diff --git a/lib/nr/cpp/recipes/hqr.cpp b/lib/nr/cpp/recipes/hqr.cpp new file mode 100644 index 0000000..3565183 --- /dev/null +++ b/lib/nr/cpp/recipes/hqr.cpp @@ -0,0 +1,128 @@ +#include +#include +#include "nr.h" +using namespace std; + +void NR::hqr(Mat_IO_DP &a, Vec_O_CPLX_DP &wri) +{ + int nn,m,l,k,j,its,i,mmin; + DP z,y,x,w,v,u,t,s,r,q,p,anorm; + + int n=a.nrows(); + anorm=0.0; + for (i=0;i= 0) { + its=0; + do { + for (l=nn;l>0;l--) { + s=fabs(a[l-1][l-1])+fabs(a[l][l]); + if (s == 0.0) s=anorm; + if (fabs(a[l][l-1]) + s == s) { + a[l][l-1] = 0.0; + break; + } + } + x=a[nn][nn]; + if (l == nn) { + wri[nn--]=x+t; + } else { + y=a[nn-1][nn-1]; + w=a[nn][nn-1]*a[nn-1][nn]; + if (l == nn-1) { + p=0.5*(y-x); + q=p*p+w; + z=sqrt(fabs(q)); + x += t; + if (q >= 0.0) { + z=p+SIGN(z,p); + wri[nn-1]=wri[nn]=x+z; + if (z != 0.0) wri[nn]=x-w/z; + } else { + wri[nn]=complex(x+p,z); + wri[nn-1]=conj(wri[nn]); + } + nn -= 2; + } else { + if (its == 30) nrerror("Too many iterations in hqr"); + if (its == 10 || its == 20) { + t += x; + for (i=0;i=l;m--) { + z=a[m][m]; + r=x-z; + s=y-z; + p=(r*s-w)/a[m+1][m]+a[m][m+1]; + q=a[m+1][m+1]-z-r-s; + r=a[m+2][m+1]; + s=fabs(p)+fabs(q)+fabs(r); + p /= s; + q /= s; + r /= s; + if (m == l) break; + u=fabs(a[m][m-1])*(fabs(q)+fabs(r)); + v=fabs(p)*(fabs(a[m-1][m-1])+fabs(z)+fabs(a[m+1][m+1])); + if (u+v == v) break; + } + for (i=m;i> 1)) { + if ((j = 2*i+1) < n-1 + && nprob[index[j]] > nprob[index[j+1]]) j++; + if (nprob[k] <= nprob[index[j]]) break; + index[i]=index[j]; + i=j; + } + index[i]=k; +} diff --git a/lib/nr/cpp/recipes/hufdec.cpp b/lib/nr/cpp/recipes/hufdec.cpp new file mode 100644 index 0000000..a62acd3 --- /dev/null +++ b/lib/nr/cpp/recipes/hufdec.cpp @@ -0,0 +1,25 @@ +#include +#include "nr.h" +using namespace std; + +void NR::hufdec(unsigned long &ich, string &code, const unsigned long lcode, + unsigned long &nb, huffcode &hcode) +{ + unsigned long nc; + static unsigned char setbit[8]={0x1,0x2,0x4,0x8,0x10,0x20,0x40,0x80}; + + int node=hcode.nodemax-1; + for (;;) { + nc=nb >> 3; + if (nc >= lcode) { + ich=hcode.nch; + return; + } + node=((code[nc] & setbit[7 & nb++]) != 0 ? + hcode.right[node] : hcode.left[node]); + if (node < hcode.nch) { + ich=node; + return; + } + } +} diff --git a/lib/nr/cpp/recipes/hufenc.cpp b/lib/nr/cpp/recipes/hufenc.cpp new file mode 100644 index 0000000..8d78eb4 --- /dev/null +++ b/lib/nr/cpp/recipes/hufenc.cpp @@ -0,0 +1,27 @@ +#include +#include "nr.h" +using namespace std; + +void NR::hufenc(const unsigned long ich, string &code, unsigned long &nb, + huffcode &hcode) +{ + int m,n; + unsigned long k,nc; + static unsigned long setbit[32]={0x1L,0x2L,0x4L,0x8L,0x10L,0x20L, + 0x40L,0x80L,0x100L,0x200L,0x400L,0x800L,0x1000L,0x2000L, + 0x4000L,0x8000L,0x10000L,0x20000L,0x40000L,0x80000L,0x100000L, + 0x200000L,0x400000L,0x800000L,0x1000000L,0x2000000L,0x4000000L, + 0x8000000L,0x10000000L,0x20000000L,0x40000000L,0x80000000L}; + + k=ich; + if (k >= hcode.nch) + nrerror("ich out of range in hufenc."); + for (n=hcode.ncod[k]-1;n >= 0;n--,++nb) { + nc=nb >> 3; + if (code.length() < nc+1) + code.resize(2*(nc+1)); + m=nb & 7; + if (m == 0) code[nc]=0; + if ((hcode.icod[k] & setbit[n]) != 0) code[nc] |= setbit[m]; + } +} diff --git a/lib/nr/cpp/recipes/hufmak.cpp b/lib/nr/cpp/recipes/hufmak.cpp new file mode 100644 index 0000000..745a8bf --- /dev/null +++ b/lib/nr/cpp/recipes/hufmak.cpp @@ -0,0 +1,58 @@ +#include "nr.h" + +void NR::hufmak(Vec_I_ULNG &nfreq, const unsigned long nchin, + unsigned long &ilong, unsigned long &nlong, huffcode &hcode) +{ + int ibit,j,node; + unsigned long k,n,nused; + static unsigned long setbit[32]={0x1L,0x2L,0x4L,0x8L,0x10L,0x20L, + 0x40L,0x80L,0x100L,0x200L,0x400L,0x800L,0x1000L,0x2000L, + 0x4000L,0x8000L,0x10000L,0x20000L,0x40000L,0x80000L,0x100000L, + 0x200000L,0x400000L,0x800000L,0x1000000L,0x2000000L,0x4000000L, + 0x8000000L,0x10000000L,0x20000000L,0x40000000L,0x80000000L}; + + hcode.nch=nchin; + Vec_ULNG index(2*hcode.nch-1); + Vec_ULNG nprob(2*hcode.nch-1); + Vec_INT up(2*hcode.nch-1); + for (nused=0,j=0;j=0;j--) + hufapp(index,nprob,nused,j); + k=hcode.nch; + while (nused > 1) { + node=index[0]; + index[0]=index[(nused--)-1]; + hufapp(index,nprob,nused,0); + nprob[k]=nprob[index[0]]+nprob[node]; + hcode.left[k]=node; + hcode.right[k++]=index[0]; + up[index[0]] = -int(k); + index[0]=k-1; + up[node]=k; + hufapp(index,nprob,nused,0); + } + up[(hcode.nodemax=k)-1]=0; + for (j=0;j nlong) { + nlong=hcode.ncod[j]; + ilong=j; + } + } +} diff --git a/lib/nr/cpp/recipes/hunt.cpp b/lib/nr/cpp/recipes/hunt.cpp new file mode 100644 index 0000000..9937a06 --- /dev/null +++ b/lib/nr/cpp/recipes/hunt.cpp @@ -0,0 +1,53 @@ +#include "nr.h" + +void NR::hunt(Vec_I_DP &xx, const DP x, int &jlo) +{ + int jm,jhi,inc; + bool ascnd; + + int n=xx.size(); + ascnd=(xx[n-1] >= xx[0]); + if (jlo < 0 || jlo > n-1) { + jlo=-1; + jhi=n; + } else { + inc=1; + if (x >= xx[jlo] == ascnd) { + if (jlo == n-1) return; + jhi=jlo+1; + while (x >= xx[jhi] == ascnd) { + jlo=jhi; + inc += inc; + jhi=jlo+inc; + if (jhi > n-1) { + jhi=n; + break; + } + } + } else { + if (jlo == 0) { + jlo=-1; + return; + } + jhi=jlo--; + while (x < xx[jlo] == ascnd) { + jhi=jlo; + inc <<= 1; + if (inc >= jhi) { + jlo=-1; + break; + } + else jlo=jhi-inc; + } + } + } + while (jhi-jlo != 1) { + jm=(jhi+jlo) >> 1; + if (x >= xx[jm] == ascnd) + jlo=jm; + else + jhi=jm; + } + if (x == xx[n-1]) jlo=n-2; + if (x == xx[0]) jlo=0; +} diff --git a/lib/nr/cpp/recipes/hypdrv.cpp b/lib/nr/cpp/recipes/hypdrv.cpp new file mode 100644 index 0000000..2e356d1 --- /dev/null +++ b/lib/nr/cpp/recipes/hypdrv.cpp @@ -0,0 +1,20 @@ +#include +#include "nr.h" +using namespace std; + +extern complex aa,bb,cc,z0,dz; + +void NR::hypdrv(const DP s, Vec_I_DP &yy, Vec_O_DP &dyyds) +{ + complex z,y[2],dyds[2]; + + y[0]=complex(yy[0],yy[1]); + y[1]=complex(yy[2],yy[3]); + z=z0+s*dz; + dyds[0]=y[1]*dz; + dyds[1]=(aa*bb*y[0]-(cc-(aa+bb+1.0)*z)*y[1])*dz/(z*(1.0-z)); + dyyds[0]=real(dyds[0]); + dyyds[1]=imag(dyds[0]); + dyyds[2]=real(dyds[1]); + dyyds[3]=imag(dyds[1]); +} diff --git a/lib/nr/cpp/recipes/hypgeo.cpp b/lib/nr/cpp/recipes/hypgeo.cpp new file mode 100644 index 0000000..2bec382 --- /dev/null +++ b/lib/nr/cpp/recipes/hypgeo.cpp @@ -0,0 +1,41 @@ +#include +#include +#include "nr.h" +using namespace std; + +complex aa,bb,cc,z0,dz; + +int kmax,kount; +DP dxsav; +Vec_DP *xp_p; +Mat_DP *yp_p; + +complex NR::hypgeo(const complex &a, const complex &b, + const complex &c, const complex &z) +{ + const DP EPS=1.0e-14; + int nbad,nok; + complex ans,y[2]; + Vec_DP yy(4); + + kmax=0; + if (norm(z) <= 0.25) { + hypser(a,b,c,z,ans,y[1]); + return ans; + } + else if (real(z) < 0.0) z0=complex(-0.5,0.0); + else if (real(z) <= 1.0) z0=complex(0.5,0.0); + else z0=complex(0.0,imag(z) >= 0.0 ? 0.5 : -0.5); + aa=a; + bb=b; + cc=c; + dz=z-z0; + hypser(aa,bb,cc,z0,y[0],y[1]); + yy[0]=real(y[0]); + yy[1]=imag(y[0]); + yy[2]=real(y[1]); + yy[3]=imag(y[1]); + odeint(yy,0.0,1.0,EPS,0.1,0.0001,nok,nbad,hypdrv,bsstep); + y[0]=complex(yy[0],yy[1]); + return y[0]; +} diff --git a/lib/nr/cpp/recipes/hypser.cpp b/lib/nr/cpp/recipes/hypser.cpp new file mode 100644 index 0000000..17b8763 --- /dev/null +++ b/lib/nr/cpp/recipes/hypser.cpp @@ -0,0 +1,30 @@ +#include +#include "nr.h" +using namespace std; + +void NR::hypser(const complex &a, const complex &b, + const complex &c, const complex &z, + complex &series, complex &deriv) +{ + int n; + complex aa,bb,cc,fac,temp; + + deriv=0.0; + fac=1.0; + temp=fac; + aa=a; + bb=b; + cc=c; + for (n=1;n<=1000;n++) { + fac *= ((aa*bb)/cc); + deriv += fac; + fac *= ((1.0/n)*z); + series=temp+fac; + if (series == temp) return; + temp=series; + aa += 1.0; + bb += 1.0; + cc += 1.0; + } + nrerror("convergence failure in hypser"); +} diff --git a/lib/nr/cpp/recipes/icrc.cpp b/lib/nr/cpp/recipes/icrc.cpp new file mode 100644 index 0000000..379580a --- /dev/null +++ b/lib/nr/cpp/recipes/icrc.cpp @@ -0,0 +1,41 @@ +#include "nr.h" + +namespace { + inline unsigned char lobyte(const unsigned short x) + { + return (unsigned char)((x) & 0xff); + } + + inline unsigned char hibyte(const unsigned short x) + { + return (unsigned char)((x >> 8) & 0xff); + } +} + +unsigned short NR::icrc(const unsigned short crc, const string &bufptr, + const short jinit, const int jrev) +{ + static unsigned short icrctb[256],init=0; + static unsigned char rchr[256]; + unsigned short j,cword=crc; + static unsigned char it[16]={0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15}; + + unsigned long len=bufptr.length(); + if (init == 0) { + init=1; + for (j=0;j<256;j++) { + icrctb[j]=icrc1(j << 8,0); + rchr[j]=(unsigned char)((it[j & 0xf] << 4) | (it[j >> 4])); + } + } + if (jinit >= 0) + cword=(jinit | (jinit << 8)); + else if (jrev < 0) + cword=(rchr[hibyte(cword)] | (rchr[lobyte(cword)] << 8)); + for (j=0;j= 0 ? cword : + rchr[hibyte(cword)] | (rchr[lobyte(cword)] << 8)); +} diff --git a/lib/nr/cpp/recipes/icrc1.cpp b/lib/nr/cpp/recipes/icrc1.cpp new file mode 100644 index 0000000..7a385dd --- /dev/null +++ b/lib/nr/cpp/recipes/icrc1.cpp @@ -0,0 +1,15 @@ +#include "nr.h" + +unsigned short NR::icrc1(const unsigned short crc, const unsigned char onech) +{ + int i; + unsigned short ans=(crc ^ onech << 8); + + for (i=0;i<8;i++) { + if (ans & 0x8000) + ans = (ans <<= 1) ^ 4129; + else + ans <<= 1; + } + return ans; +} diff --git a/lib/nr/cpp/recipes/igray.cpp b/lib/nr/cpp/recipes/igray.cpp new file mode 100644 index 0000000..0512fbc --- /dev/null +++ b/lib/nr/cpp/recipes/igray.cpp @@ -0,0 +1,17 @@ +#include "nr.h" + +unsigned long NR::igray(const unsigned long n, const int is) +{ + int ish; + unsigned long ans,idiv; + + if (is >= 0) + return n ^ (n >> 1); + ish=1; + ans=n; + for (;;) { + ans ^= (idiv=ans >> ish); + if (idiv <= 1 || ish == 16) return ans; + ish <<= 1; + } +} diff --git a/lib/nr/cpp/recipes/indexx.cpp b/lib/nr/cpp/recipes/indexx.cpp new file mode 100644 index 0000000..259e3a7 --- /dev/null +++ b/lib/nr/cpp/recipes/indexx.cpp @@ -0,0 +1,127 @@ +#include "nr.h" + +void NR::indexx(Vec_I_DP &arr, Vec_O_INT &indx) +{ + const int M=7,NSTACK=50; + int i,indxt,ir,j,k,jstack=-1,l=0; + DP a; + Vec_INT istack(NSTACK); + + int n=arr.size(); + ir=n-1; + for (j=0;j=l;i--) { + if (arr[indx[i]] <= a) break; + indx[i+1]=indx[i]; + } + indx[i+1]=indxt; + } + if (jstack < 0) break; + ir=istack[jstack--]; + l=istack[jstack--]; + } else { + k=(l+ir) >> 1; + SWAP(indx[k],indx[l+1]); + if (arr[indx[l]] > arr[indx[ir]]) { + SWAP(indx[l],indx[ir]); + } + if (arr[indx[l+1]] > arr[indx[ir]]) { + SWAP(indx[l+1],indx[ir]); + } + if (arr[indx[l]] > arr[indx[l+1]]) { + SWAP(indx[l],indx[l+1]); + } + i=l+1; + j=ir; + indxt=indx[l+1]; + a=arr[indxt]; + for (;;) { + do i++; while (arr[indx[i]] < a); + do j--; while (arr[indx[j]] > a); + if (j < i) break; + SWAP(indx[i],indx[j]); + } + indx[l+1]=indx[j]; + indx[j]=indxt; + jstack += 2; + if (jstack >= NSTACK) nrerror("NSTACK too small in indexx."); + if (ir-i+1 >= j-l) { + istack[jstack]=ir; + istack[jstack-1]=i; + ir=j-1; + } else { + istack[jstack]=j-1; + istack[jstack-1]=l; + l=i; + } + } + } +} + +void NR::indexx(Vec_I_INT &arr, Vec_O_INT &indx) +{ + const int M=7,NSTACK=50; + int i,indxt,ir,j,k,jstack=-1,l=0; + int a; + Vec_INT istack(NSTACK); + + int n=arr.size(); + ir=n-1; + for (j=0;j=l;i--) { + if (arr[indx[i]] <= a) break; + indx[i+1]=indx[i]; + } + indx[i+1]=indxt; + } + if (jstack < 0) break; + ir=istack[jstack--]; + l=istack[jstack--]; + } else { + k=(l+ir) >> 1; + SWAP(indx[k],indx[l+1]); + if (arr[indx[l]] > arr[indx[ir]]) { + SWAP(indx[l],indx[ir]); + } + if (arr[indx[l+1]] > arr[indx[ir]]) { + SWAP(indx[l+1],indx[ir]); + } + if (arr[indx[l]] > arr[indx[l+1]]) { + SWAP(indx[l],indx[l+1]); + } + i=l+1; + j=ir; + indxt=indx[l+1]; + a=arr[indxt]; + for (;;) { + do i++; while (arr[indx[i]] < a); + do j--; while (arr[indx[j]] > a); + if (j < i) break; + SWAP(indx[i],indx[j]); + } + indx[l+1]=indx[j]; + indx[j]=indxt; + jstack += 2; + if (jstack >= NSTACK) nrerror("NSTACK too small in indexx."); + if (ir-i+1 >= j-l) { + istack[jstack]=ir; + istack[jstack-1]=i; + ir=j-1; + } else { + istack[jstack]=j-1; + istack[jstack-1]=l; + l=i; + } + } + } +} diff --git a/lib/nr/cpp/recipes/interp.cpp b/lib/nr/cpp/recipes/interp.cpp new file mode 100644 index 0000000..1f2b462 --- /dev/null +++ b/lib/nr/cpp/recipes/interp.cpp @@ -0,0 +1,17 @@ +#include "nr.h" + +void NR::interp(Mat_O_DP &uf, Mat_I_DP &uc) +{ + int ic,iif,jc,jf,nc; + + int nf=uf.nrows(); + nc=nf/2+1; + for (jc=0;jc> 17) & 1) + ^ ((iseed >> 4) & 1) + ^ ((iseed >> 1) & 1) + ^ (iseed & 1); + iseed=(iseed << 1) | newbit; + return int(newbit); +} diff --git a/lib/nr/cpp/recipes/irbit2.cpp b/lib/nr/cpp/recipes/irbit2.cpp new file mode 100644 index 0000000..b5b6878 --- /dev/null +++ b/lib/nr/cpp/recipes/irbit2.cpp @@ -0,0 +1,15 @@ +#include "nr.h" + +int NR::irbit2(unsigned long &iseed) +{ + const unsigned long IB1=1,IB2=2,IB5=16,IB18=131072; + const unsigned long MASK=IB1+IB2+IB5; + + if (iseed & IB18) { + iseed=((iseed ^ MASK) << 1) | IB1; + return 1; + } else { + iseed <<= 1; + return 0; + } +} diff --git a/lib/nr/cpp/recipes/jacobi.cpp b/lib/nr/cpp/recipes/jacobi.cpp new file mode 100644 index 0000000..d8eb3e1 --- /dev/null +++ b/lib/nr/cpp/recipes/jacobi.cpp @@ -0,0 +1,89 @@ +#include +#include "nr.h" +using namespace std; + +namespace { + inline void rot(Mat_IO_DP &a, const DP s, const DP tau, const int i, + const int j, const int k, const int l) + { + DP g,h; + + g=a[i][j]; + h=a[k][l]; + a[i][j]=g-s*(h+g*tau); + a[k][l]=h+s*(g-h*tau); + } +} + +void NR::jacobi(Mat_IO_DP &a, Vec_O_DP &d, Mat_O_DP &v, int &nrot) +{ + int i,j,ip,iq; + DP tresh,theta,tau,t,sm,s,h,g,c; + + int n=d.size(); + Vec_DP b(n),z(n); + for (ip=0;ip 4 && (fabs(d[ip])+g) == fabs(d[ip]) + && (fabs(d[iq])+g) == fabs(d[iq])) + a[ip][iq]=0.0; + else if (fabs(a[ip][iq]) > tresh) { + h=d[iq]-d[ip]; + if ((fabs(h)+g) == fabs(h)) + t=(a[ip][iq])/h; + else { + theta=0.5*h/(a[ip][iq]); + t=1.0/(fabs(theta)+sqrt(1.0+theta*theta)); + if (theta < 0.0) t = -t; + } + c=1.0/sqrt(1+t*t); + s=t*c; + tau=s/(1.0+c); + h=t*a[ip][iq]; + z[ip] -= h; + z[iq] += h; + d[ip] -= h; + d[iq] += h; + a[ip][iq]=0.0; + for (j=0;j +#include "nr.h" +using namespace std; + +int NR::julday(const int mm, const int id, const int iyyy) +{ + const int IGREG=15+31*(10+12*1582); + int ja,jul,jy=iyyy,jm; + + if (jy == 0) nrerror("julday: there is no year zero."); + if (jy < 0) ++jy; + if (mm > 2) { + jm=mm+1; + } else { + --jy; + jm=mm+13; + } + jul = int(floor(365.25*jy)+floor(30.6001*jm)+id+1720995); + if (id+31*(mm+12*iyyy) >= IGREG) { + ja=int(0.01*jy); + jul += 2-ja+int(0.25*ja); + } + return jul; +} diff --git a/lib/nr/cpp/recipes/kendl1.cpp b/lib/nr/cpp/recipes/kendl1.cpp new file mode 100644 index 0000000..ebcd98e --- /dev/null +++ b/lib/nr/cpp/recipes/kendl1.cpp @@ -0,0 +1,30 @@ +#include +#include "nr.h" +using namespace std; + +void NR::kendl1(Vec_I_DP &data1, Vec_I_DP &data2, DP &tau, DP &z, DP &prob) +{ + int is=0,j,k,n2=0,n1=0; + DP svar,aa,a2,a1; + + int n=data1.size(); + for (j=0;j 0.0 ? ++is : --is; + } else { + if (a1 != 0.0) ++n1; + if (a2 != 0.0) ++n2; + } + } + } + tau=is/(sqrt(DP(n1))*sqrt(DP(n2))); + svar=(4.0*n+10.0)/(9.0*n*(n-1.0)); + z=tau/sqrt(svar); + prob=erfcc(fabs(z)/1.4142136); +} diff --git a/lib/nr/cpp/recipes/kendl2.cpp b/lib/nr/cpp/recipes/kendl2.cpp new file mode 100644 index 0000000..0c9f36a --- /dev/null +++ b/lib/nr/cpp/recipes/kendl2.cpp @@ -0,0 +1,37 @@ +#include +#include "nr.h" +using namespace std; + +void NR::kendl2(Mat_I_DP &tab, DP &tau, DP &z, DP &prob) +{ + int k,l,nn,mm,m2,m1,lj,li,kj,ki; + DP svar,s=0.0,points,pairs,en2=0.0,en1=0.0; + + int i=tab.nrows(); + int j=tab.ncols(); + nn=i*j; + points=tab[i-1][j-1]; + for (k=0;k<=nn-2;k++) { + ki=(k/j); + kj=k-j*ki; + points += tab[ki][kj]; + for (l=k+1;l<=nn-1;l++) { + li=l/j; + lj=l-j*li; + mm=(m1=li-ki)*(m2=lj-kj); + pairs=tab[ki][kj]*tab[li][lj]; + if (mm != 0) { + en1 += pairs; + en2 += pairs; + s += (mm > 0 ? pairs : -pairs); + } else { + if (m1 != 0) en1 += pairs; + if (m2 != 0) en2 += pairs; + } + } + } + tau=s/sqrt(en1*en2); + svar=(4.0*points+10.0)/(9.0*points*(points-1.0)); + z=tau/sqrt(svar); + prob=erfcc(fabs(z)/1.4142136); +} diff --git a/lib/nr/cpp/recipes/kermom.cpp b/lib/nr/cpp/recipes/kermom.cpp new file mode 100644 index 0000000..eb6e9eb --- /dev/null +++ b/lib/nr/cpp/recipes/kermom.cpp @@ -0,0 +1,31 @@ +#include +#include "nr.h" +using namespace std; + +extern DP x; + +void NR::kermom(Vec_O_DP &w, const DP y) +{ + DP d,df,clog,x2,x3,x4,y2; + + int m=w.size(); + if (y >= x) { + d=y-x; + df=2.0*sqrt(d)*d; + w[0]=df/3.0; + w[1]=df*(x/3.0+d/5.0); + w[2]=df*((x/3.0 + 0.4*d)*x + d*d/7.0); + w[3]=df*(((x/3.0 + 0.6*d)*x + 3.0*d*d/7.0)*x+d*d*d/9.0); + } else { + x3=(x2=x*x)*x; + x4=x2*x2; + y2=y*y; + d=x-y; + w[0]=d*((clog=log(d))-1.0); + w[1] = -0.25*(3.0*x+y-2.0*clog*(x+y))*d; + w[2]=(-11.0*x3+y*(6.0*x2+y*(3.0*x+2.0*y)) + +6.0*clog*(x3-y*y2))/18.0; + w[3]=(-25.0*x4+y*(12.0*x3+y*(6.0*x2+y* + (4.0*x+3.0*y)))+12.0*clog*(x4-(y2*y2)))/48.0; + } +} diff --git a/lib/nr/cpp/recipes/ks2d1s.cpp b/lib/nr/cpp/recipes/ks2d1s.cpp new file mode 100644 index 0000000..200cc23 --- /dev/null +++ b/lib/nr/cpp/recipes/ks2d1s.cpp @@ -0,0 +1,25 @@ +#include +#include "nr.h" +using namespace std; + +void NR::ks2d1s(Vec_I_DP &x1, Vec_I_DP &y1, void quadvl(const DP, const DP, + DP &, DP &, DP &, DP &), DP &d1, DP &prob) +{ + int j; + DP dum,dumm,fa,fb,fc,fd,ga,gb,gc,gd,r1,rr,sqen; + + int n1=x1.size(); + d1=0.0; + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::ks2d2s(Vec_I_DP &x1, Vec_I_DP &y1, Vec_I_DP &x2, Vec_I_DP &y2, DP &d, + DP &prob) +{ + int j; + DP d1,d2,dum,dumm,fa,fb,fc,fd,ga,gb,gc,gd,r1,r2,rr,sqen; + + int n1=x1.size(); + int n2=x2.size(); + d1=0.0; + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::ksone(Vec_IO_DP &data, DP func(const DP), DP &d, DP &prob) +{ + int j; + DP dt,en,ff,fn,fo=0.0; + + int n=data.size(); + sort(data); + en=n; + d=0.0; + for (j=0;j d) d=dt; + fo=fn; + } + en=sqrt(en); + prob=probks((en+0.12+0.11/en)*d); +} diff --git a/lib/nr/cpp/recipes/kstwo.cpp b/lib/nr/cpp/recipes/kstwo.cpp new file mode 100644 index 0000000..258dfb2 --- /dev/null +++ b/lib/nr/cpp/recipes/kstwo.cpp @@ -0,0 +1,24 @@ +#include +#include "nr.h" +using namespace std; + +void NR::kstwo(Vec_IO_DP &data1, Vec_IO_DP &data2, DP &d, DP &prob) +{ + int j1=0,j2=0; + DP d1,d2,dt,en1,en2,en,fn1=0.0,fn2=0.0; + + int n1=data1.size(); + int n2=data2.size(); + sort(data1); + sort(data2); + en1=n1; + en2=n2; + d=0.0; + while (j1 < n1 && j2 < n2) { + if ((d1=data1[j1]) <= (d2=data2[j2])) fn1=j1++/en1; + if (d2 <= d1) fn2=j2++/en2; + if ((dt=fabs(fn2-fn1)) > d) d=dt; + } + en=sqrt(en1*en2/(en1+en2)); + prob=probks((en+0.12+0.11/en)*d); +} diff --git a/lib/nr/cpp/recipes/laguer.cpp b/lib/nr/cpp/recipes/laguer.cpp new file mode 100644 index 0000000..094ff13 --- /dev/null +++ b/lib/nr/cpp/recipes/laguer.cpp @@ -0,0 +1,49 @@ +#include +#include +#include +#include "nr.h" +using namespace std; + +void NR::laguer(Vec_I_CPLX_DP &a, complex &x, int &its) +{ + const int MR=8,MT=10,MAXIT=MT*MR; + const DP EPS=numeric_limits::epsilon(); + static const DP frac[MR+1]= + {0.0,0.5,0.25,0.75,0.13,0.38,0.62,0.88,1.0}; + int iter,j; + DP abx,abp,abm,err; + complex dx,x1,b,d,f,g,h,sq,gp,gm,g2; + + int m=a.size()-1; + for (iter=1;iter<=MAXIT;iter++) { + its=iter; + b=a[m]; + err=abs(b); + d=f=0.0; + abx=abs(x); + for (j=m-1;j>=0;j--) { + f=x*f+d; + d=x*d+b; + b=x*b+a[j]; + err=abs(b)+abx*err; + } + err *= EPS; + if (abs(b) <= err) return; + g=d/b; + g2=g*g; + h=g2-2.0*f/b; + sq=sqrt(DP(m-1)*(DP(m)*h-g2)); + gp=g+sq; + gm=g-sq; + abp=abs(gp); + abm=abs(gm); + if (abp < abm) gp=gm; + dx=MAX(abp,abm) > 0.0 ? DP(m)/gp : polar(1+abx,DP(iter)); + x1=x-dx; + if (x == x1) return; + if (iter % MT != 0) x=x1; + else x -= frac[iter/MT]*dx; + } + nrerror("too many iterations in laguer"); + return; +} diff --git a/lib/nr/cpp/recipes/lfit.cpp b/lib/nr/cpp/recipes/lfit.cpp new file mode 100644 index 0000000..c2d97e2 --- /dev/null +++ b/lib/nr/cpp/recipes/lfit.cpp @@ -0,0 +1,59 @@ +#include "nr.h" + +void NR::lfit(Vec_I_DP &x, Vec_I_DP &y, Vec_I_DP &sig, Vec_IO_DP &a, + Vec_I_BOOL &ia, Mat_O_DP &covar, DP &chisq, + void funcs(const DP, Vec_O_DP &)) +{ + int i,j,k,l,m,mfit=0; + DP ym,wt,sum,sig2i; + + int ndat=x.size(); + int ma=a.size(); + Vec_DP afunc(ma); + Mat_DP beta(ma,1); + for (j=0;j +#include +#include +#include "nr.h" +using namespace std; + +void NR::linbcg(Vec_I_DP &b, Vec_IO_DP &x, const int itol, const DP tol, + const int itmax, int &iter, DP &err) +{ + DP ak,akden,bk,bkden=1.0,bknum,bnrm,dxnrm,xnrm,zm1nrm,znrm; + const DP EPS=1.0e-14; + int j; + + int n=b.size(); + Vec_DP p(n),pp(n),r(n),rr(n),z(n),zz(n); + iter=0; + atimes(x,r,0); + for (j=0;j EPS*znrm) { + dxnrm=fabs(ak)*snrm(p,itol); + err=znrm/fabs(zm1nrm-znrm)*dxnrm; + } else { + err=znrm/bnrm; + continue; + } + xnrm=snrm(x,itol); + if (err <= 0.5*xnrm) err /= xnrm; + else { + err=znrm/bnrm; + continue; + } + } + cout << "iter=" << setw(4) << iter+1 << setw(12) << err << endl; + if (err <= tol) break; + } +} diff --git a/lib/nr/cpp/recipes/linmin.cpp b/lib/nr/cpp/recipes/linmin.cpp new file mode 100644 index 0000000..f00f4bf --- /dev/null +++ b/lib/nr/cpp/recipes/linmin.cpp @@ -0,0 +1,33 @@ +#include "nr.h" + +int ncom; +DP (*nrfunc)(Vec_I_DP &); +Vec_DP *pcom_p,*xicom_p; + +void NR::linmin(Vec_IO_DP &p, Vec_IO_DP &xi, DP &fret, DP func(Vec_I_DP &)) +{ + int j; + const DP TOL=1.0e-8; + DP xx,xmin,fx,fb,fa,bx,ax; + + int n=p.size(); + ncom=n; + pcom_p=new Vec_DP(n); + xicom_p=new Vec_DP(n); + nrfunc=func; + Vec_DP &pcom=*pcom_p,&xicom=*xicom_p; + for (j=0;j +#include +#include "nr.h" +using namespace std; + +void NR::lnsrch(Vec_I_DP &xold, const DP fold, Vec_I_DP &g, Vec_IO_DP &p, + Vec_O_DP &x, DP &f, const DP stpmax, bool &check, DP func(Vec_I_DP &)) +{ + const DP ALF=1.0e-4, TOLX=numeric_limits::epsilon(); + int i; + DP a,alam,alam2=0.0,alamin,b,disc,f2=0.0; + DP rhs1,rhs2,slope,sum,temp,test,tmplam; + + int n=xold.size(); + check=false; + sum=0.0; + for (i=0;i stpmax) + for (i=0;i= 0.0) nrerror("Roundoff problem in lnsrch."); + test=0.0; + for (i=0;i test) test=temp; + } + alamin=TOLX/test; + alam=1.0; + for (;;) { + for (i=0;i0.5*alam) + tmplam=0.5*alam; + } + } + alam2=alam; + f2 = f; + alam=MAX(tmplam,0.1*alam); + } +} diff --git a/lib/nr/cpp/recipes/locate.cpp b/lib/nr/cpp/recipes/locate.cpp new file mode 100644 index 0000000..8d1115a --- /dev/null +++ b/lib/nr/cpp/recipes/locate.cpp @@ -0,0 +1,22 @@ +#include "nr.h" + +void NR::locate(Vec_I_DP &xx, const DP x, int &j) +{ + int ju,jm,jl; + bool ascnd; + + int n=xx.size(); + jl=-1; + ju=n; + ascnd=(xx[n-1] >= xx[0]); + while (ju-jl > 1) { + jm=(ju+jl) >> 1; + if (x >= xx[jm] == ascnd) + jl=jm; + else + ju=jm; + } + if (x == xx[0]) j=0; + else if (x == xx[n-1]) j=n-2; + else j=jl; +} diff --git a/lib/nr/cpp/recipes/lop.cpp b/lib/nr/cpp/recipes/lop.cpp new file mode 100644 index 0000000..51cb1ff --- /dev/null +++ b/lib/nr/cpp/recipes/lop.cpp @@ -0,0 +1,17 @@ +#include "nr.h" + +void NR::lop(Mat_O_DP &out, Mat_I_DP &u) +{ + int i,j; + DP h,h2i; + + int n=u.nrows(); + h=1.0/(n-1); + h2i=1.0/(h*h); + for (j=1;j=0;i--) { + sum=b[i]; + for (j=i+1;j +#include "nr.h" +using namespace std; + +void NR::ludcmp(Mat_IO_DP &a, Vec_O_INT &indx, DP &d) +{ + const DP TINY=1.0e-20; + int i,imax,j,k; + DP big,dum,sum,temp; + + int n=a.nrows(); + Vec_DP vv(n); + d=1.0; + for (i=0;i big) big=temp; + if (big == 0.0) nrerror("Singular matrix in routine ludcmp"); + vv[i]=1.0/big; + } + for (j=0;j= big) { + big=dum; + imax=i; + } + } + if (j != imax) { + for (k=0;k +#include "nr.h" +using namespace std; + +void NR::machar(int &ibeta, int &it, int &irnd, int &ngrd, int &machep, + int &negep, int &iexp, int &minexp, int &maxexp, DP &eps, DP &epsneg, + DP &xmin, DP &xmax) +{ + int i,itemp,iz,j,k,mx,nxres; + DP a,b,beta,betah,betain,one,t,temp,temp1,tempa,two,y,z,zero; + + one=DP(1); + two=one+one; + zero=one-one; + a=one; + do { + a += a; + temp=a+one; + temp1=temp-a; + } while (temp1-one == zero); + b=one; + do { + b += b; + temp=a+b; + itemp=int(temp-a); + } while (itemp == 0); + ibeta=itemp; + beta=DP(ibeta); + it=0; + b=one; + do { + ++it; + b *= beta; + temp=b+one; + temp1=temp-b; + } while (temp1-one == zero); + irnd=0; + betah=beta/two; + temp=a+betah; + if (temp-a != zero) irnd=1; + tempa=a+beta; + temp=tempa+betah; + if (irnd == 0 && temp-tempa != zero) irnd=2; + negep=it+3; + betain=one/beta; + a=one; + for (i=1;i<=negep;i++) a *= betain; + b=a; + for (;;) { + temp=one-a; + if (temp-one != zero) break; + a *= beta; + --negep; + } + negep = -negep; + epsneg=a; + machep = -it-3; + a=b; + for (;;) { + temp=one+a; + if (temp-one != zero) break; + a *= beta; + ++machep; + } + eps=a; + ngrd=0; + temp=one+eps; + if (irnd == 0 && temp*one-one != zero) ngrd=1; + i=0; + k=1; + z=betain; + t=one+eps; + nxres=0; + for (;;) { + y=z; + z=y*y; + a=z*one; + temp=z*t; + if (a+a == zero || fabs(z) >= y) break; + temp1=temp*betain; + if (temp1*beta == z) break; + ++i; + k += k; + } + if (ibeta != 10) { + iexp=i+1; + mx=k+k; + } else { + iexp=2; + iz=ibeta; + while (k >= iz) { + iz *= ibeta; + ++iexp; + } + mx=iz+iz-1; + } + for (;;) { + xmin=y; + y *= betain; + a=y*one; + temp=y*t; + if (a+a != zero && fabs(y) < xmin) { + ++k; + temp1=temp*betain; + if (temp1*beta == y && temp != y) { + nxres=3; + xmin=y; + break; + } + } + else break; + } + minexp = -k; + if (mx <= k+k-3 && ibeta != 10) { + mx += mx; + ++iexp; + } + maxexp=mx+minexp; + irnd += nxres; + if (irnd >= 2) maxexp -= 2; + i=maxexp+minexp; + if (ibeta == 2 && !i) --maxexp; + if (i > 20) --maxexp; + if (a != y) maxexp -= 2; + xmax=one-epsneg; + if (xmax*one != xmax) xmax=one-beta*epsneg; + xmax /= (xmin*beta*beta*beta); + i=maxexp+minexp+3; + for (j=1;j<=i;j++) { + if (ibeta == 2) xmax += xmax; + else xmax *= beta; + } +} diff --git a/lib/nr/cpp/recipes/matadd.cpp b/lib/nr/cpp/recipes/matadd.cpp new file mode 100644 index 0000000..d6890c7 --- /dev/null +++ b/lib/nr/cpp/recipes/matadd.cpp @@ -0,0 +1,11 @@ +#include "nr.h" + +void NR::matadd(Mat_I_DP &a, Mat_I_DP &b, Mat_O_DP &c) +{ + int i,j; + + int n=a.nrows(); + for (j=0;j +#include "nr.h" +using namespace std; + +DP aa,abdevt; +const Vec_DP *xt_p,*yt_p; + +void NR::medfit(Vec_I_DP &x, Vec_I_DP &y, DP &a, DP &b, DP &abdev) +{ + int j; + DP bb,b1,b2,del,f,f1,f2,sigb,temp; + DP sx=0.0,sy=0.0,sxy=0.0,sxx=0.0,chisq=0.0; + + int ndata=x.size(); + xt_p= &x; + yt_p= &y; + for (j=0;j 0.0) { + b2=bb+SIGN(3.0*sigb,f1); + f2=rofunc(b2); + if (b2 == b1) { + a=aa; + b=bb; + abdev=abdevt/ndata; + return; + } + while (f1*f2 > 0.0) { + bb=b2+1.6*(b2-b1); + b1=b2; + f1=f2; + b2=bb; + f2=rofunc(b2); + } + sigb=0.01*sigb; + while (fabs(b2-b1) > sigb) { + bb=b1+0.5*(b2-b1); + if (bb == b1 || bb == b2) break; + f=rofunc(bb); + if (f*f1 >= 0.0) { + f1=f; + b1=bb; + } else { + f2=f; + b2=bb; + } + } + } + a=aa; + b=bb; + abdev=abdevt/ndata; +} diff --git a/lib/nr/cpp/recipes/memcof.cpp b/lib/nr/cpp/recipes/memcof.cpp new file mode 100644 index 0000000..c0e6216 --- /dev/null +++ b/lib/nr/cpp/recipes/memcof.cpp @@ -0,0 +1,40 @@ +#include +#include "nr.h" +using namespace std; + +void NR::memcof(Vec_I_DP &data, DP &xms, Vec_O_DP &d) +{ + int k,j,i; + DP p=0.0; + + int n=data.size(); + int m=d.size(); + Vec_DP wk1(n),wk2(n),wkm(m); + for (j=0;j +#include "nr.h" +using namespace std; + +bool NR::metrop(const DP de, const DP t) +{ + static int gljdum=1; + + return de < 0.0 || ran3(gljdum) < exp(-de/t); +} diff --git a/lib/nr/cpp/recipes/mgfas.cpp b/lib/nr/cpp/recipes/mgfas.cpp new file mode 100644 index 0000000..5365ebd --- /dev/null +++ b/lib/nr/cpp/recipes/mgfas.cpp @@ -0,0 +1,99 @@ +#include "nr.h" + +namespace { + void mg(const int j, Mat_IO_DP &u, Mat_I_DP &rhs, Vec_Mat_DP_p &rho, + DP &trerr) + { + using namespace NR; + const int NPRE=1,NPOST=1; + const DP ALPHA=0.33; + int jpost,jpre,nc,nf; + DP dum=-1.0; + + nf=u.nrows(); + nc=(nf+1)/2; + Mat_DP temp(nf,nf); + if (j == 0) { + matadd(rhs,*rho[j],temp); + slvsm2(u,temp); + } else { + Mat_DP v(nc,nc),ut(nc,nc),tau(nc,nc),tempc(nc,nc); + for (jpre=0;jpre 0.0) + trerr=ALPHA*anorm2(tau); + mg(j-1,v,tau,rho,dum); + matsub(v,ut,tempc); + interp(temp,tempc); + matadd(u,temp,u); + for (jpost=0;jpost>= 1) ng++; + if ((n-1) != (1 << ng)) + nrerror("n-1 must be a power of 2 in mgfas."); + Vec_Mat_DP_p rho(ng); + nn=n; + ngrid=ng-1; + rho[ngrid]=new Mat_DP(nn,nn); + copy(*rho[ngrid],u); + while (nn > 3) { + nn=nn/2+1; + rho[--ngrid]=new Mat_DP(nn,nn); + rstrct(*rho[ngrid],*rho[ngrid+1]); + } + nn=3; + uj=new Mat_DP(nn,nn); + slvsm2(*uj,*rho[0]); + for (j=1;j>= 1) ng++; + if ((n-1) != (1 << ng)) + nrerror("n-1 must be a power of 2 in mglin."); + Vec_Mat_DP_p rho(ng); + nn=n; + ngrid=ng-1; + rho[ngrid] = new Mat_DP(nn,nn); + copy(*rho[ngrid],u); + while (nn > 3) { + nn=nn/2+1; + rho[--ngrid]=new Mat_DP(nn,nn); + rstrct(*rho[ngrid],*rho[ngrid+1]); + } + nn=3; + uj=new Mat_DP(nn,nn); + slvsml(*uj,*rho[0]); + for (j=1;j +#include "nr.h" +using namespace std; + +namespace { + DP func(DP funk(const DP), const DP x) + { + return funk(-log(x))/x; + } +} + +DP NR::midexp(DP funk(const DP), const DP aa, const DP bb, const int n) +{ + DP x,tnm,sum,del,ddel,a,b; + static DP s; + int it,j; + + b=exp(-aa); + a=0.0; + if (n == 1) { + return (s=(b-a)*func(funk,0.5*(a+b))); + } else { + for(it=1,j=1;j +#include "nr.h" +using namespace std; + +namespace { + DP func(DP funk(const DP), const DP aa, const DP x) + { + return 2.0*x*funk(aa+x*x); + } +} + +DP NR::midsql(DP funk(const DP), const DP aa, const DP bb, const int n) +{ + DP x,tnm,sum,del,ddel,a,b; + static DP s; + int it,j; + + b=sqrt(bb-aa); + a=0.0; + if (n == 1) { + return (s=(b-a)*func(funk,aa,0.5*(a+b))); + } else { + for(it=1,j=1;j +#include "nr.h" +using namespace std; + +namespace { + DP func(DP funk(const DP), const DP bb, const DP x) + { + return 2.0*x*funk(bb-x*x); + } +} + +DP NR::midsqu(DP funk(const DP), const DP aa, const DP bb, const int n) +{ + DP x,tnm,sum,del,ddel,a,b; + static DP s; + int it,j; + + b=sqrt(bb-aa); + a=0.0; + if (n == 1) { + return (s=(b-a)*func(funk,bb,0.5*(a+b))); + } else { + for(it=1,j=1;j +#include "nr.h" +using namespace std; + +void NR::miser(DP func(Vec_I_DP &), Vec_I_DP ®n, const int npts, + const DP dith, DP &ave, DP &var) +{ + const int MNPT=15, MNBS=60; + const DP PFAC=0.1, TINY=1.0e-30, BIG=1.0e30; + static int iran=0; + int j,jb,n,ndim,npre,nptl,nptr; + DP avel,varl,fracl,fval,rgl,rgm,rgr,s,sigl,siglb,sigr,sigrb; + DP sum,sumb,summ,summ2; + + ndim=regn.size()/2; + Vec_DP pt(ndim); + if (npts < MNBS) { + summ=summ2=0.0; + for (n=0;n fminl[j] && fmaxr[j] > fminr[j]) { + sigl=MAX(TINY,pow(fmaxl[j]-fminl[j],2.0/3.0)); + sigr=MAX(TINY,pow(fmaxr[j]-fminr[j],2.0/3.0)); + sum=sigl+sigr; + if (sum<=sumb) { + sumb=sum; + jb=j; + siglb=sigl; + sigrb=sigr; + } + } + } + if (jb == -1) jb=(ndim*iran)/175000; + rgl=regn[jb]; + rgm=rmid[jb]; + rgr=regn[ndim+jb]; + fracl=fabs((rgm-rgl)/(rgr-rgl)); + nptl=int(MNPT+(npts-npre-2*MNPT)*fracl*siglb + /(fracl*siglb+(1.0-fracl)*sigrb)); + nptr=npts-npre-nptl; + Vec_DP regn_temp(2*ndim); + for (j=0;j +#include "nr.h" +using namespace std; + +namespace { + inline void shft3(DP &a, DP &b, DP &c, const DP d) + { + a=b; + b=c; + c=d; + } +} + +void NR::mnbrak(DP &ax, DP &bx, DP &cx, DP &fa, DP &fb, DP &fc, + DP func(const DP)) +{ + const DP GOLD=1.618034,GLIMIT=100.0,TINY=1.0e-20; + DP ulim,u,r,q,fu; + + fa=func(ax); + fb=func(bx); + if (fb > fa) { + SWAP(ax,bx); + SWAP(fb,fa); + } + cx=bx+GOLD*(bx-ax); + fc=func(cx); + while (fb > fc) { + r=(bx-ax)*(fb-fc); + q=(bx-cx)*(fb-fa); + u=bx-((bx-cx)*q-(bx-ax)*r)/ + (2.0*SIGN(MAX(fabs(q-r),TINY),q-r)); + ulim=bx+GLIMIT*(cx-bx); + if ((bx-u)*(u-cx) > 0.0) { + fu=func(u); + if (fu < fc) { + ax=bx; + bx=u; + fa=fb; + fb=fu; + return; + } else if (fu > fb) { + cx=u; + fc=fu; + return; + } + u=cx+GOLD*(cx-bx); + fu=func(u); + } else if ((cx-u)*(u-ulim) > 0.0) { + fu=func(u); + if (fu < fc) { + shft3(bx,cx,u,cx+GOLD*(cx-bx)); + shft3(fb,fc,fu,func(u)); + } + } else if ((u-ulim)*(ulim-cx) >= 0.0) { + u=ulim; + fu=func(u); + } else { + u=cx+GOLD*(cx-bx); + fu=func(u); + } + shft3(ax,bx,cx,u); + shft3(fa,fb,fc,fu); + } +} diff --git a/lib/nr/cpp/recipes/mnewt.cpp b/lib/nr/cpp/recipes/mnewt.cpp new file mode 100644 index 0000000..567c58f --- /dev/null +++ b/lib/nr/cpp/recipes/mnewt.cpp @@ -0,0 +1,32 @@ +#include +#include "nr.h" +using namespace std; + +void usrfun(Vec_I_DP &x, Vec_O_DP &fvec, Mat_O_DP &fjac); + +void NR::mnewt(const int ntrial, Vec_IO_DP &x, const DP tolx, const DP tolf) +{ + int k,i; + DP errx,errf,d; + + int n=x.size(); + Vec_INT indx(n); + Vec_DP p(n),fvec(n); + Mat_DP fjac(n,n); + for (k=0;k +#include "nr.h" +using namespace std; + +void NR::moment(Vec_I_DP &data, DP &ave, DP &adev, DP &sdev, DP &var, DP &skew, + DP &curt) +{ + int j; + DP ep=0.0,s,p; + + int n=data.size(); + if (n <= 1) nrerror("n must be at least 2 in moment"); + s=0.0; + for (j=0;j n) nrerror("Divisor longer than dividend in mpdiv"); + mm=m+MACC; + Vec_UCHR s(mm),rr(mm),ss(mm+1),qq(n-m+1),t(n); + mpinv(s,v); + mpmul(rr,s,u); + mpsad(ss,rr,1); + mplsh(ss); + mplsh(ss); + mpmov(qq,ss); + mpmov(q,qq); + mpmul(t,qq,v); + mplsh(t); + mpsub(is,t,u,t); + if (is != 0) nrerror("MACC too small in mpdiv"); + for (i=0;im) + for (i=m;i=0;j--) { + fv *= BI; + fv += v[j]; + } + fu=1.0/fv; + for (j=0;j=0;j--) { + t=b[j]/(nn >> 1)+cy+0.5; + cy=(unsigned long) (t/RX); + b[j]=t-cy*RX; + } + if (cy >= RX) nrerror("cannot happen in mpmul"); + for (j=0;j> 8) & 0xff);} +} + +void NR::mpadd(Vec_O_UCHR &w, Vec_I_UCHR &u, Vec_I_UCHR &v) +{ + int j,n_min,p_min; + unsigned short ireg=0; + + int n=u.size(); + int m=v.size(); + int p=w.size(); + n_min=MIN(n,m); + p_min=MIN(n_min,p-1); + for (j=p_min-1;j>=0;j--) { + ireg=u[j]+v[j]+hibyte(ireg); + w[j+1]=lobyte(ireg); + } + w[0]=hibyte(ireg); + if (p > p_min+1) + for (j=p_min+1;j=0;j--) { + ireg=255+u[j]-v[j]+hibyte(ireg); + w[j]=lobyte(ireg); + } + is=hibyte(ireg)-1; + if (p > p_min) + for (j=p_min;j=0;j--) { + ireg=u[j]+hibyte(ireg); + if (j+1 < p) w[j+1]=lobyte(ireg); + } + w[0]=hibyte(ireg); + for (j=n+1;j=0;j--) { + ireg=u[j]*iv+hibyte(ireg); + if (j < p-1) w[j+1]=lobyte(ireg); + } + w[0]=hibyte(ireg); + for (j=n+1;j p_min) + for (j=p_min;j=0;j--) { + ireg=255-u[j]+hibyte(ireg); + u[j]=lobyte(ireg); + } +} + +void NR::mpmov(Vec_O_UCHR &u, Vec_I_UCHR &v) +{ + int j,n_min; + + int n=u.size(); + int m=v.size(); + n_min=MIN(n,m); + for (j=0;j n_min) + for(j=n_min;j +#include +#include "nr.h" +using namespace std; + +void NR::mppi(const int np) +{ + const unsigned int IAOFF=48,MACC=2; + int ir,j,n; + unsigned char mm; + string s; + + n=np+MACC; + Vec_UCHR x(n),y(n),sx(n),sxi(n); + Vec_UCHR z(n),t(n),pi(n); + Vec_UCHR ss(2*n),tt(2*n); + t[0]=2; + for (j=1;j +#include "nr.h" +using namespace std; + +void NR::mpsqrt(Vec_O_UCHR &w, Vec_O_UCHR &u, Vec_I_UCHR &v) +{ + const int MF=3; + const DP BI=1.0/256.0; + int i,ir,j,mm; + DP fu,fv; + + int n=u.size(); + int m=v.size(); + Vec_UCHR r(2*n),x(n+m),s(2*n+m),t(3*n+m); + mm=MIN(m,MF); + fv=DP(v[mm-1]); + for (j=mm-2;j>=0;j--) { + fv *= BI; + fv += v[j]; + } + fu=1.0/sqrt(fv); + for (j=0;j +#include +#include "nr.h" +using namespace std; + +Vec_DP *fvec_p; +void (*nrfuncv)(Vec_I_DP &v, Vec_O_DP &f); + +void NR::newt(Vec_IO_DP &x, bool &check, void vecfunc(Vec_I_DP &, Vec_O_DP &)) +{ + const int MAXITS=200; + const DP TOLF=1.0e-8,TOLMIN=1.0e-12,STPMX=100.0; + const DP TOLX=numeric_limits::epsilon(); + int i,j,its; + DP d,den,f,fold,stpmax,sum,temp,test; + + int n=x.size(); + Vec_INT indx(n); + Vec_DP g(n),p(n),xold(n); + Mat_DP fjac(n,n); + fvec_p=new Vec_DP(n); + nrfuncv=vecfunc; + Vec_DP &fvec=*fvec_p; + f=fmin(x); + test=0.0; + for (i=0;i test) test=fabs(fvec[i]); + if (test < 0.01*TOLF) { + check=false; + delete fvec_p; + return; + } + sum=0.0; + for (i=0;i test) test=fabs(fvec[i]); + if (test < TOLF) { + check=false; + delete fvec_p; + return; + } + if (check) { + test=0.0; + den=MAX(f,0.5*n); + for (i=0;i test) test=temp; + } + check=(test < TOLMIN); + delete fvec_p; + return; + } + test=0.0; + for (i=0;i test) test=temp; + } + if (test < TOLX) { + delete fvec_p; + return; + } + } + nrerror("MAXITS exceeded in newt"); +} diff --git a/lib/nr/cpp/recipes/odeint.cpp b/lib/nr/cpp/recipes/odeint.cpp new file mode 100644 index 0000000..db4a9e0 --- /dev/null +++ b/lib/nr/cpp/recipes/odeint.cpp @@ -0,0 +1,54 @@ +#include +#include "nr.h" +using namespace std; + +extern DP dxsav; +extern int kmax,kount; +extern Vec_DP *xp_p; +extern Mat_DP *yp_p; + +void NR::odeint(Vec_IO_DP &ystart, const DP x1, const DP x2, const DP eps, + const DP h1, const DP hmin, int &nok, int &nbad, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &), + void rkqs(Vec_IO_DP &, Vec_IO_DP &, DP &, const DP, const DP, + Vec_I_DP &, DP &, DP &, void (*)(const DP, Vec_I_DP &, Vec_O_DP &))) +{ + const int MAXSTP=10000; + const DP TINY=1.0e-30; + int i,nstp; + DP xsav,x,hnext,hdid,h; + + int nvar=ystart.size(); + Vec_DP yscal(nvar),y(nvar),dydx(nvar); + Vec_DP &xp=*xp_p; + Mat_DP &yp=*yp_p; + x=x1; + h=SIGN(h1,x2-x1); + nok = nbad = kount = 0; + for (i=0;i 0) xsav=x-dxsav*2.0; + for (nstp=0;nstp 0 && kount < kmax-1 && fabs(x-xsav) > fabs(dxsav)) { + for (i=0;i 0.0) h=x2-x; + rkqs(y,dydx,x,h,eps,yscal,hdid,hnext,derivs); + if (hdid == h) ++nok; else ++nbad; + if ((x-x2)*(x2-x1) >= 0.0) { + for (i=0;i +#include "nr.h" +using namespace std; + +void NR::pade(Vec_IO_DP &cof, DP &resid) +{ + const DP BIG=1.0e30; + int j,k; + DP d,rr,rrold,sum; + + int n=(cof.size()-1)/2; + Mat_DP q(n,n),qlu(n,n); + Vec_INT indx(n); + Vec_DP x(n),y(n),z(n); + for (j=0;j=0;j-=2,jm--,jp++) { + c[j] += fac; + fac *= DP(jm)/DP(jp); + } + pow += pow; + } +} diff --git a/lib/nr/cpp/recipes/pcshft.cpp b/lib/nr/cpp/recipes/pcshft.cpp new file mode 100644 index 0000000..a43754c --- /dev/null +++ b/lib/nr/cpp/recipes/pcshft.cpp @@ -0,0 +1,19 @@ +#include "nr.h" + +void NR::pcshft(const DP a, const DP b, Vec_IO_DP &d) +{ + int k,j; + DP fac,cnst; + + int n=d.size(); + cnst=2.0/(b-a); + fac=cnst; + for (j=1;j=j;k--) + d[k] -= cnst*d[k+1]; +} diff --git a/lib/nr/cpp/recipes/pearsn.cpp b/lib/nr/cpp/recipes/pearsn.cpp new file mode 100644 index 0000000..3672f3c --- /dev/null +++ b/lib/nr/cpp/recipes/pearsn.cpp @@ -0,0 +1,32 @@ +#include +#include "nr.h" +using namespace std; + +void NR::pearsn(Vec_I_DP &x, Vec_I_DP &y, DP &r, DP &prob, DP &z) +{ + const DP TINY=1.0e-20; + int j; + DP yt,xt,t,df; + DP syy=0.0,sxy=0.0,sxx=0.0,ay=0.0,ax=0.0; + + int n=x.size(); + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::period(Vec_I_DP &x, Vec_I_DP &y, const DP ofac, const DP hifac, + Vec_O_DP &px, Vec_O_DP &py, int &nout, int &jmax, DP &prob) +{ + const DP TWOPI=6.283185307179586476; + int i,j; + DP ave,c,cc,cwtau,effm,expy,pnow,pymax,s,ss,sumc,sumcy,sums,sumsh, + sumsy,swtau,var,wtau,xave,xdif,xmax,xmin,yy,arg,wtemp; + + int n=x.size(); + int np=px.size(); + Vec_DP wi(n),wpi(n),wpr(n),wr(n); + nout=0.5*ofac*hifac*n; + if (nout > np) nrerror("output arrays too short in period"); + avevar(y,ave,var); + if (var == 0.0) nrerror("zero variance in period"); + xmax=xmin=x[0]; + for (j=0;j xmax) xmax=x[j]; + if (x[j] < xmin) xmin=x[j]; + } + xdif=xmax-xmin; + xave=0.5*(xmax+xmin); + pymax=0.0; + pnow=1.0/(xdif*ofac); + for (j=0;j= pymax) pymax=py[jmax=i]; + pnow += 1.0/(ofac*xdif); + } + expy=exp(-pymax); + effm=2.0*nout/ofac; + prob=effm*expy; + if (prob > 0.01) prob=1.0-pow(1.0-expy,effm); +} diff --git a/lib/nr/cpp/recipes/piksr2.cpp b/lib/nr/cpp/recipes/piksr2.cpp new file mode 100644 index 0000000..f3903b8 --- /dev/null +++ b/lib/nr/cpp/recipes/piksr2.cpp @@ -0,0 +1,21 @@ +#include "nr.h" + +void NR::piksr2(Vec_IO_DP &arr, Vec_IO_DP &brr) +{ + int i,j; + DP a,b; + + int n=arr.size(); + for (j=1;j 0 && arr[i-1] > a) { + arr[i]=arr[i-1]; + brr[i]=brr[i-1]; + i--; + } + arr[i]=a; + brr[i]=b; + } +} diff --git a/lib/nr/cpp/recipes/piksrt.cpp b/lib/nr/cpp/recipes/piksrt.cpp new file mode 100644 index 0000000..6e6812f --- /dev/null +++ b/lib/nr/cpp/recipes/piksrt.cpp @@ -0,0 +1,18 @@ +#include "nr.h" + +void NR::piksrt(Vec_IO_DP &arr) +{ + int i,j; + DP a; + + int n=arr.size(); + for (j=1;j 0 && arr[i-1] > a) { + arr[i]=arr[i-1]; + i--; + } + arr[i]=a; + } +} diff --git a/lib/nr/cpp/recipes/pinvs.cpp b/lib/nr/cpp/recipes/pinvs.cpp new file mode 100644 index 0000000..0e66640 --- /dev/null +++ b/lib/nr/cpp/recipes/pinvs.cpp @@ -0,0 +1,65 @@ +#include +#include "nr.h" +using namespace std; + +void NR::pinvs(const int ie1, const int ie2, const int je1, const int jsf, + const int jc1, const int k, Mat3D_O_DP &c, Mat_IO_DP &s) +{ + int jpiv,jp,je2,jcoff,j,irow,ipiv,id,icoff,i; + DP pivinv,piv,dum,big; + + const int iesize=ie2-ie1; + Vec_INT indxr(iesize); + Vec_DP pscl(iesize); + je2=je1+iesize; + for (i=ie1;i big) big=fabs(s[i][j]); + if (big == 0.0) + nrerror("Singular matrix - row all 0, in pinvs"); + pscl[i-ie1]=1.0/big; + indxr[i-ie1]=0; + } + for (id=0;id big) { + jp=j; + big=fabs(s[i][j]); + } + } + if (big*pscl[i-ie1] > piv) { + ipiv=i; + jpiv=jp; + piv=big*pscl[i-ie1]; + } + } + } + if (s[ipiv][jpiv] == 0.0) + nrerror("Singular matrix in routine pinvs"); + indxr[ipiv-ie1]=jpiv+1; + pivinv=1.0/s[ipiv][jpiv]; + for (j=je1;j<=jsf;j++) s[ipiv][j] *= pivinv; + s[ipiv][jpiv]=1.0; + for (i=ie1;i +#include "nr.h" +using namespace std; + +DP NR::plgndr(const int l, const int m, const DP x) +{ + int i,ll; + DP fact,pll,pmm,pmmp1,somx2; + + if (m < 0 || m > l || fabs(x) > 1.0) + nrerror("Bad arguments in routine plgndr"); + pmm=1.0; + if (m > 0) { + somx2=sqrt((1.0-x)*(1.0+x)); + fact=1.0; + for (i=1;i<=m;i++) { + pmm *= -fact*somx2; + fact += 2.0; + } + } + if (l == m) + return pmm; + else { + pmmp1=x*(2*m+1)*pmm; + if (l == (m+1)) + return pmmp1; + else { + for (ll=m+2;ll<=l;ll++) { + pll=(x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m); + pmm=pmmp1; + pmmp1=pll; + } + return pll; + } + } +} diff --git a/lib/nr/cpp/recipes/poidev.cpp b/lib/nr/cpp/recipes/poidev.cpp new file mode 100644 index 0000000..1ad10a8 --- /dev/null +++ b/lib/nr/cpp/recipes/poidev.cpp @@ -0,0 +1,39 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::poidev(const DP xm, int &idum) +{ + const DP PI=3.141592653589793238; + static DP sq,alxm,g,oldm=(-1.0); + DP em,t,y; + + if (xm < 12.0) { + if (xm != oldm) { + oldm=xm; + g=exp(-xm); + } + em = -1; + t=1.0; + do { + ++em; + t *= ran1(idum); + } while (t > g); + } else { + if (xm != oldm) { + oldm=xm; + sq=sqrt(2.0*xm); + alxm=log(xm); + g=xm*alxm-gammln(xm+1.0); + } + do { + do { + y=tan(PI*ran1(idum)); + em=sq*y+xm; + } while (em < 0.0); + em=floor(em); + t=0.9*(1.0+y*y)*exp(em*alxm-gammln(em+1.0)-g); + } while (ran1(idum) > t); + } + return em; +} diff --git a/lib/nr/cpp/recipes/polcoe.cpp b/lib/nr/cpp/recipes/polcoe.cpp new file mode 100644 index 0000000..0d8451c --- /dev/null +++ b/lib/nr/cpp/recipes/polcoe.cpp @@ -0,0 +1,28 @@ +#include "nr.h" + +void NR::polcoe(Vec_I_DP &x, Vec_I_DP &y, Vec_O_DP &cof) +{ + int k,j,i; + DP phi,ff,b; + + int n=x.size(); + Vec_DP s(n); + for (i=0;i0;k--) + phi=k*s[k]+x[j]*phi; + ff=y[j]/phi; + b=1.0; + for (k=n-1;k>=0;k--) { + cof[k] += b*ff; + b=s[k]+x[j]*b; + } + } +} diff --git a/lib/nr/cpp/recipes/polcof.cpp b/lib/nr/cpp/recipes/polcof.cpp new file mode 100644 index 0000000..7b22648 --- /dev/null +++ b/lib/nr/cpp/recipes/polcof.cpp @@ -0,0 +1,38 @@ +#include +#include "nr.h" +using namespace std; + +void NR::polcof(Vec_I_DP &xa, Vec_I_DP &ya, Vec_O_DP &cof) +{ + int k,j,i; + DP xmin,dy; + + int n=xa.size(); + Vec_DP x(n),y(n); + for (j=0;j=0;k--) { + q[k]=r[nv+k]/v[nv]; + for (j=nv+k-1;j>=k;j--) r[j] -= q[k]*v[j-k]; + } + for (j=nv;j<=n;j++) r[j]=0.0; +} diff --git a/lib/nr/cpp/recipes/polin2.cpp b/lib/nr/cpp/recipes/polin2.cpp new file mode 100644 index 0000000..8ffe7af --- /dev/null +++ b/lib/nr/cpp/recipes/polin2.cpp @@ -0,0 +1,16 @@ +#include "nr.h" + +void NR::polin2(Vec_I_DP &x1a, Vec_I_DP &x2a, Mat_I_DP &ya, const DP x1, + const DP x2, DP &y, DP &dy) +{ + int j,k; + + int m=x1a.size(); + int n=x2a.size(); + Vec_DP ymtmp(m),ya_t(n); + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::polint(Vec_I_DP &xa, Vec_I_DP &ya, const DP x, DP &y, DP &dy) +{ + int i,m,ns=0; + DP den,dif,dift,ho,hp,w; + + int n=xa.size(); + Vec_DP c(n),d(n); + dif=fabs(x-xa[0]); + for (i=0;i +#include "nr.h" +using namespace std; + +void NR::powell(Vec_IO_DP &p, Mat_IO_DP &xi, const DP ftol, int &iter, + DP &fret, DP func(Vec_I_DP &)) +{ + const int ITMAX=200; + const DP TINY=1.0e-25; + int i,j,ibig; + DP del,fp,fptt,t; + + int n=p.size(); + Vec_DP pt(n),ptt(n),xit(n); + fret=func(p); + for (j=0;j del) { + del=fptt-fret; + ibig=i+1; + } + } + if (2.0*(fp-fret) <= ftol*(fabs(fp)+fabs(fret))+TINY) { + return; + } + if (iter == ITMAX) nrerror("powell exceeding maximum iterations."); + for (j=0;j=1;k--) reg[k]=reg[k-1]; + future[j]=reg[0]=sum; + } +} diff --git a/lib/nr/cpp/recipes/probks.cpp b/lib/nr/cpp/recipes/probks.cpp new file mode 100644 index 0000000..1213c7c --- /dev/null +++ b/lib/nr/cpp/recipes/probks.cpp @@ -0,0 +1,20 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::probks(const DP alam) +{ + const DP EPS1=1.0e-6,EPS2=1.0e-16; + int j; + DP a2,fac=2.0,sum=0.0,term,termbf=0.0; + + a2 = -2.0*alam*alam; + for (j=1;j<=100;j++) { + term=fac*exp(a2*j*j); + sum += term; + if (fabs(term) <= EPS1*termbf || fabs(term) <= EPS2*sum) return sum; + fac = -fac; + termbf=fabs(term); + } + return 1.0; +} diff --git a/lib/nr/cpp/recipes/psdes.cpp b/lib/nr/cpp/recipes/psdes.cpp new file mode 100644 index 0000000..e371bc2 --- /dev/null +++ b/lib/nr/cpp/recipes/psdes.cpp @@ -0,0 +1,21 @@ +#include "nr.h" + +void NR::psdes(unsigned long &lword, unsigned long &irword) +{ + const int NITER=4; + static const unsigned long c1[NITER]={ + 0xbaa96887L, 0x1e17d32cL, 0x03bcdc3cL, 0x0f33d1b2L}; + static const unsigned long c2[NITER]={ + 0x4b0f3b58L, 0xe874f0c3L, 0x6955c5a6L, 0x55a7ca46L}; + unsigned long i,ia,ib,iswap,itmph=0,itmpl=0; + + for (i=0;i> 16; + ib=itmpl*itmpl+ ~(itmph*itmph); + irword=lword ^ (((ia = (ib >> 16) | + ((ib & 0xffff) << 16)) ^ c2[i])+itmpl*itmph); + lword=iswap; + } +} diff --git a/lib/nr/cpp/recipes/pwt.cpp b/lib/nr/cpp/recipes/pwt.cpp new file mode 100644 index 0000000..b9959e7 --- /dev/null +++ b/lib/nr/cpp/recipes/pwt.cpp @@ -0,0 +1,43 @@ +#include "nr.h" + +extern wavefilt *wfilt_p; + +void NR::pwt(Vec_IO_DP &a, const int n, const int isign) +{ + DP ai,ai1; + int i,ii,j,jf,jr,k,n1,ni,nj,nh,nmod; + + if (n < 4) return; + wavefilt &wfilt=*wfilt_p; + Vec_DP wksp(n); + nmod=wfilt.ncof*n; + n1=n-1; + nh=n >> 1; + for (j=0;j= 0) { + for (ii=0,i=0;i +#include "nr.h" +using namespace std; + +DP NR::pythag(const DP a, const DP b) +{ + DP absa,absb; + + absa=fabs(a); + absb=fabs(b); + if (absa > absb) return absa*sqrt(1.0+SQR(absb/absa)); + else return (absb == 0.0 ? 0.0 : absb*sqrt(1.0+SQR(absa/absb))); +} diff --git a/lib/nr/cpp/recipes/pzextr.cpp b/lib/nr/cpp/recipes/pzextr.cpp new file mode 100644 index 0000000..7210283 --- /dev/null +++ b/lib/nr/cpp/recipes/pzextr.cpp @@ -0,0 +1,37 @@ +#include "nr.h" + +extern Vec_DP *x_p; +extern Mat_DP *d_p; + +void NR::pzextr(const int iest, const DP xest, Vec_I_DP &yest, Vec_O_DP &yz, + Vec_O_DP &dy) +{ + int j,k1; + DP q,f2,f1,delta; + + int nv=yz.size(); + Vec_DP c(nv); + Vec_DP &x=*x_p; + Mat_DP &d=*d_p; + x[iest]=xest; + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::qrdcmp(Mat_IO_DP &a, Vec_O_DP &c, Vec_O_DP &d, bool &sing) +{ + int i,j,k; + DP scale,sigma,sum,tau; + + int n=a.nrows(); + sing=false; + for (k=0;k +#include "nr.h" +using namespace std; + +DP NR::qromb(DP func(const DP), DP a, DP b) +{ + const int JMAX=20, JMAXP=JMAX+1, K=5; + const DP EPS=1.0e-10; + DP ss,dss; + Vec_DP s(JMAX),h(JMAXP),s_t(K),h_t(K); + int i,j; + + h[0]=1.0; + for (j=1;j<=JMAX;j++) { + s[j-1]=trapzd(func,a,b,j); + if (j >= K) { + for (i=0;i +#include "nr.h" +using namespace std; + +DP NR::qromo(DP func(const DP), const DP a, const DP b, + DP choose(DP (*)(const DP), const DP, const DP, const int)) +{ + const int JMAX=14, JMAXP=JMAX+1, K=5; + const DP EPS=3.0e-9; + int i,j; + DP ss,dss; + Vec_DP h(JMAXP),s(JMAX),h_t(K),s_t(K); + + h[0]=1.0; + for (j=1;j<=JMAX;j++) { + s[j-1]=choose(func,a,b,j); + if (j >= K) { + for (i=0;i +#include "nr.h" +using namespace std; + +void NR::qroot(Vec_I_DP &p, DP &b, DP &c, const DP eps) +{ + const int ITMAX=20; + const DP TINY=1.0e-14; + int iter; + DP sc,sb,s,rc,rb,r,dv,delc,delb; + Vec_DP d(3); + + int n=p.size()-1; + Vec_DP q(n+1),qq(n+1),rem(n+1); + d[2]=1.0; + for (iter=0;iter +#include "nr.h" +using namespace std; + +void NR::qrupdt(Mat_IO_DP &r, Mat_IO_DP &qt, Vec_IO_DP &u, Vec_I_DP &v) +{ + int i,k; + + int n=u.size(); + for (k=n-1;k>=0;k--) + if (u[k] != 0.0) break; + if (k < 0) k=0; + for (i=k-1;i>=0;i--) { + rotate(r,qt,i,u[i],-u[i+1]); + if (u[i] == 0.0) + u[i]=fabs(u[i+1]); + else if (fabs(u[i]) > fabs(u[i+1])) + u[i]=fabs(u[i])*sqrt(1.0+SQR(u[i+1]/u[i])); + else u[i]=fabs(u[i+1])*sqrt(1.0+SQR(u[i]/u[i+1])); + } + for (i=0;i +#include "nr.h" +using namespace std; + +DP NR::qsimp(DP func(const DP), const DP a, const DP b) +{ + const int JMAX=20; + const DP EPS=1.0e-10; + int j; + DP s,st,ost=0.0,os=0.0; + + for (j=0;j 5) + if (fabs(s-os) < EPS*fabs(os) || + (s == 0.0 && os == 0.0)) return s; + os=s; + ost=st; + } + nrerror("Too many steps in routine qsimp"); + return 0.0; +} diff --git a/lib/nr/cpp/recipes/qtrap.cpp b/lib/nr/cpp/recipes/qtrap.cpp new file mode 100644 index 0000000..29c4873 --- /dev/null +++ b/lib/nr/cpp/recipes/qtrap.cpp @@ -0,0 +1,21 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::qtrap(DP func(const DP), const DP a, const DP b) +{ + const int JMAX=20; + const DP EPS=1.0e-10; + int j; + DP s,olds=0.0; + + for (j=0;j 5) + if (fabs(s-olds) < EPS*fabs(olds) || + (s == 0.0 && olds == 0.0)) return s; + olds=s; + } + nrerror("Too many steps in routine qtrap"); + return 0.0; +} diff --git a/lib/nr/cpp/recipes/quad3d.cpp b/lib/nr/cpp/recipes/quad3d.cpp new file mode 100644 index 0000000..3e426b5 --- /dev/null +++ b/lib/nr/cpp/recipes/quad3d.cpp @@ -0,0 +1,33 @@ +#include "nr.h" + +extern DP yy1(const DP),yy2(const DP); +extern DP z1(const DP, const DP); +extern DP z2(const DP, const DP); + +namespace NRquad3d { + DP xsav,ysav; + DP (*nrfunc)(const DP, const DP, const DP); + + DP f3(const DP z) + { + return nrfunc(xsav,ysav,z); + } + + DP f2(const DP y) + { + ysav=y; + return NR::qgaus(f3,z1(xsav,y),z2(xsav,y)); + } + + DP f1(const DP x) + { + xsav=x; + return NR::qgaus(f2,yy1(x),yy2(x)); + } +} + +DP NR::quad3d(DP func(const DP, const DP, const DP), const DP x1, const DP x2) +{ + NRquad3d::nrfunc=func; + return qgaus(NRquad3d::f1,x1,x2); +} diff --git a/lib/nr/cpp/recipes/quadct.cpp b/lib/nr/cpp/recipes/quadct.cpp new file mode 100644 index 0000000..19300fa --- /dev/null +++ b/lib/nr/cpp/recipes/quadct.cpp @@ -0,0 +1,22 @@ +#include "nr.h" + +void NR::quadct(const DP x, const DP y, Vec_I_DP &xx, Vec_I_DP &yy, DP &fa, + DP &fb, DP &fc, DP &fd) +{ + int k,na,nb,nc,nd; + DP ff; + + int nn=xx.size(); + na=nb=nc=nd=0; + for (k=0;k y) + xx[k] > x ? ++na : ++nb; + else + xx[k] > x ? ++nd : ++nc; + } + ff=1.0/nn; + fa=ff*na; + fb=ff*nb; + fc=ff*nc; + fd=ff*nd; +} diff --git a/lib/nr/cpp/recipes/quadmx.cpp b/lib/nr/cpp/recipes/quadmx.cpp new file mode 100644 index 0000000..4f91179 --- /dev/null +++ b/lib/nr/cpp/recipes/quadmx.cpp @@ -0,0 +1,24 @@ +#include +#include "nr.h" +using namespace std; + +DP x; + +void NR::quadmx(Mat_O_DP &a) +{ + const DP PI=3.14159263589793238; + int j,k; + DP h,xx,cx; + + int n=a.nrows(); + Vec_DP wt(n); + h=PI/(n-1); + for (j=0;j=0;j--) { + k=idum/IQ; + idum=IA*(idum-k*IQ)-IR*k; + if (idum < 0) idum += IM; + if (j < NTAB) iv[j] = idum; + } + iy=iv[0]; + } + k=idum/IQ; + idum=IA*(idum-k*IQ)-IR*k; + if (idum < 0) idum += IM; + j=iy/NDIV; + iy=iv[j]; + iv[j] = idum; + if ((temp=AM*iy) > RNMX) return RNMX; + else return temp; +} diff --git a/lib/nr/cpp/recipes/ran2.cpp b/lib/nr/cpp/recipes/ran2.cpp new file mode 100644 index 0000000..8649044 --- /dev/null +++ b/lib/nr/cpp/recipes/ran2.cpp @@ -0,0 +1,38 @@ +#include "nr.h" + +DP NR::ran2(int &idum) +{ + const int IM1=2147483563,IM2=2147483399; + const int IA1=40014,IA2=40692,IQ1=53668,IQ2=52774; + const int IR1=12211,IR2=3791,NTAB=32,IMM1=IM1-1; + const int NDIV=1+IMM1/NTAB; + const DP EPS=3.0e-16,RNMX=1.0-EPS,AM=1.0/DP(IM1); + static int idum2=123456789,iy=0; + static Vec_INT iv(NTAB); + int j,k; + DP temp; + + if (idum <= 0) { + idum=(idum==0 ? 1 : -idum); + idum2=idum; + for (j=NTAB+7;j>=0;j--) { + k=idum/IQ1; + idum=IA1*(idum-k*IQ1)-k*IR1; + if (idum < 0) idum += IM1; + if (j < NTAB) iv[j] = idum; + } + iy=iv[0]; + } + k=idum/IQ1; + idum=IA1*(idum-k*IQ1)-k*IR1; + if (idum < 0) idum += IM1; + k=idum2/IQ2; + idum2=IA2*(idum2-k*IQ2)-k*IR2; + if (idum2 < 0) idum2 += IM2; + j=iy/NDIV; + iy=iv[j]-idum2; + iv[j] = idum; + if (iy < 1) iy += IMM1; + if ((temp=AM*iy) > RNMX) return RNMX; + else return temp; +} diff --git a/lib/nr/cpp/recipes/ran3.cpp b/lib/nr/cpp/recipes/ran3.cpp new file mode 100644 index 0000000..d492a58 --- /dev/null +++ b/lib/nr/cpp/recipes/ran3.cpp @@ -0,0 +1,42 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::ran3(int &idum) +{ + static int inext,inextp; + static int iff=0; + const int MBIG=1000000000,MSEED=161803398,MZ=0; + const DP FAC=(1.0/MBIG); + static Vec_INT ma(56); + int i,ii,k,mj,mk; + + if (idum < 0 || iff == 0) { + iff=1; + mj=labs(MSEED-labs(idum)); + mj %= MBIG; + ma[55]=mj; + mk=1; + for (i=1;i<=54;i++) { + ii=(21*i) % 55; + ma[ii]=mk; + mk=mj-mk; + if (mk < int(MZ)) mk += MBIG; + mj=ma[ii]; + } + for (k=0;k<4;k++) + for (i=1;i<=55;i++) { + ma[i] -= ma[1+(i+30) % 55]; + if (ma[i] < int(MZ)) ma[i] += MBIG; + } + inext=0; + inextp=31; + idum=1; + } + if (++inext == 56) inext=1; + if (++inextp == 56) inextp=1; + mj=ma[inext]-ma[inextp]; + if (mj < int(MZ)) mj += MBIG; + ma[inext]=mj; + return mj*FAC; +} diff --git a/lib/nr/cpp/recipes/ran4.cpp b/lib/nr/cpp/recipes/ran4.cpp new file mode 100644 index 0000000..69a0557 --- /dev/null +++ b/lib/nr/cpp/recipes/ran4.cpp @@ -0,0 +1,25 @@ +#include "nr.h" + +DP NR::ran4(int &idum) +{ +#if defined(vax) || defined(_vax_) || defined(__vax__) || defined(VAX) + static const unsigned long jflone = 0x00004080; + static const unsigned long jflmsk = 0xffff007f; +#else + static const unsigned long jflone = 0x3f800000; + static const unsigned long jflmsk = 0x007fffff; +#endif + unsigned long irword,itemp,lword; + static int idums = 0; + + if (idum < 0) { + idums = -idum; + idum=1; + } + irword=idum; + lword=idums; + psdes(lword,irword); + itemp=jflone | (jflmsk & irword); + ++idum; + return (*(float *)&itemp)-1.0; +} diff --git a/lib/nr/cpp/recipes/rank.cpp b/lib/nr/cpp/recipes/rank.cpp new file mode 100644 index 0000000..5f88156 --- /dev/null +++ b/lib/nr/cpp/recipes/rank.cpp @@ -0,0 +1,9 @@ +#include "nr.h" + +void NR::rank(Vec_I_INT &indx, Vec_O_INT &irank) +{ + int j; + + int n=indx.size(); + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::ratint(Vec_I_DP &xa, Vec_I_DP &ya, const DP x, DP &y, DP &dy) +{ + const DP TINY=1.0e-25; + int m,i,ns=0; + DP w,t,hh,h,dd; + + int n=xa.size(); + Vec_DP c(n),d(n); + hh=fabs(x-xa[0]); + for (i=0;i +#include +#include +#include "nr.h" +using namespace std; + +void NR::ratlsq(DP fn(const DP), const DP a, const DP b, const int mm, + const int kk, Vec_O_DP &cof, DP &dev) +{ + const int NPFAC=8,MAXIT=5; + const DP BIG=1.0e30,PIO2=1.570796326794896619; + int i,it,j,ncof,npt; + DP devmax,e,hth,power,sum; + + ncof=mm+kk+1; + npt=NPFAC*ncof; + Vec_DP bb(npt),coff(ncof),ee(npt),fs(npt),w(ncof),wt(npt),xs(npt); + Mat_DP u(npt,ncof),v(ncof,ncof); + dev=BIG; + for (i=0;i devmax) devmax=wt[j]; + } + e=sum/npt; + if (devmax <= dev) { + for (j=0;j=0;j--) sumn=sumn*x+cof[j]; + for (sumd=0.0,j=mm+kk;j>mm;j--) sumd=(sumd+cof[j])*x; + return sumn/(1.0+sumd); +} diff --git a/lib/nr/cpp/recipes/rc.cpp b/lib/nr/cpp/recipes/rc.cpp new file mode 100644 index 0000000..2b178cb --- /dev/null +++ b/lib/nr/cpp/recipes/rc.cpp @@ -0,0 +1,32 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::rc(const DP x, const DP y) +{ + const DP ERRTOL=0.0012, TINY=1.69e-38, SQRTNY=1.3e-19, BIG=3.0e37; + const DP TNBG=TINY*BIG, COMP1=2.236/SQRTNY, COMP2=TNBG*TNBG/25.0; + const DP THIRD=1.0/3.0, C1=0.3, C2=1.0/7.0, C3=0.375, C4=9.0/22.0; + DP alamb,ave,s,w,xt,yt; + + if (x < 0.0 || y == 0.0 || (x+fabs(y)) < TINY || (x+fabs(y)) > BIG || + (y<-COMP1 && x > 0.0 && x < COMP2)) + nrerror("invalid arguments in rc"); + if (y > 0.0) { + xt=x; + yt=y; + w=1.0; + } else { + xt=x-y; + yt= -y; + w=sqrt(x)/sqrt(xt); + } + do { + alamb=2.0*sqrt(xt)*sqrt(yt)+yt; + xt=0.25*(xt+alamb); + yt=0.25*(yt+alamb); + ave=THIRD*(xt+yt+yt); + s=(yt-ave)/ave; + } while (fabs(s) > ERRTOL); + return w*(1.0+s*s*(C1+s*(C2+s*(C3+s*C4))))/sqrt(ave); +} diff --git a/lib/nr/cpp/recipes/rd.cpp b/lib/nr/cpp/recipes/rd.cpp new file mode 100644 index 0000000..95e0bbd --- /dev/null +++ b/lib/nr/cpp/recipes/rd.cpp @@ -0,0 +1,42 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::rd(const DP x, const DP y, const DP z) +{ + const DP ERRTOL=0.0015, TINY=1.0e-25, BIG=4.5e21; + const DP C1=3.0/14.0, C2=1.0/6.0, C3=9.0/22.0; + const DP C4=3.0/26.0, C5=0.25*C3, C6=1.5*C4; + DP alamb,ave,delx,dely,delz,ea,eb,ec,ed,ee,fac,sqrtx,sqrty, + sqrtz,sum,xt,yt,zt; + + if (MIN(x,y) < 0.0 || MIN(x+y,z) < TINY || MAX(MAX(x,y),z) > BIG) + nrerror("invalid arguments in rd"); + xt=x; + yt=y; + zt=z; + sum=0.0; + fac=1.0; + do { + sqrtx=sqrt(xt); + sqrty=sqrt(yt); + sqrtz=sqrt(zt); + alamb=sqrtx*(sqrty+sqrtz)+sqrty*sqrtz; + sum += fac/(sqrtz*(zt+alamb)); + fac=0.25*fac; + xt=0.25*(xt+alamb); + yt=0.25*(yt+alamb); + zt=0.25*(zt+alamb); + ave=0.2*(xt+yt+3.0*zt); + delx=(ave-xt)/ave; + dely=(ave-yt)/ave; + delz=(ave-zt)/ave; + } while (MAX(MAX(fabs(delx),fabs(dely)),fabs(delz)) > ERRTOL); + ea=delx*dely; + eb=delz*delz; + ec=ea-eb; + ed=ea-6.0*eb; + ee=ed+ec+ec; + return 3.0*sum+fac*(1.0+ed*(-C1+C5*ed-C6*delz*ee) + +delz*(C2*ee+delz*(-C3*ec+delz*C4*ea)))/(ave*sqrt(ave)); +} diff --git a/lib/nr/cpp/recipes/realft.cpp b/lib/nr/cpp/recipes/realft.cpp new file mode 100644 index 0000000..2724fdf --- /dev/null +++ b/lib/nr/cpp/recipes/realft.cpp @@ -0,0 +1,46 @@ +#include +#include "nr.h" +using namespace std; + +void NR::realft(Vec_IO_DP &data, const int isign) +{ + int i,i1,i2,i3,i4; + DP c1=0.5,c2,h1r,h1i,h2r,h2i,wr,wi,wpr,wpi,wtemp,theta; + + int n=data.size(); + theta=3.141592653589793238/DP(n>>1); + if (isign == 1) { + c2 = -0.5; + four1(data,1); + } else { + c2=0.5; + theta = -theta; + } + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0+wpr; + wi=wpi; + for (i=1;i<(n>>2);i++) { + i2=1+(i1=i+i); + i4=1+(i3=n-i1); + h1r=c1*(data[i1]+data[i3]); + h1i=c1*(data[i2]-data[i4]); + h2r= -c2*(data[i2]+data[i4]); + h2i=c2*(data[i1]-data[i3]); + data[i1]=h1r+wr*h2r-wi*h2i; + data[i2]=h1i+wr*h2i+wi*h2r; + data[i3]=h1r-wr*h2r+wi*h2i; + data[i4]= -h1i+wr*h2i+wi*h2r; + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + } + if (isign == 1) { + data[0] = (h1r=data[0])+data[1]; + data[1] = h1r-data[1]; + } else { + data[0]=c1*((h1r=data[0])+data[1]); + data[1]=c1*(h1r-data[1]); + four1(data,-1); + } +} diff --git a/lib/nr/cpp/recipes/rebin.cpp b/lib/nr/cpp/recipes/rebin.cpp new file mode 100644 index 0000000..67f2d50 --- /dev/null +++ b/lib/nr/cpp/recipes/rebin.cpp @@ -0,0 +1,19 @@ +#include "nr.h" + +void NR::rebin(const DP rc, const int nd, Vec_I_DP &r, Vec_O_DP &xin, + Mat_IO_DP &xi, const int j) +{ + int i,k=0; + DP dr=0.0,xn=0.0,xo=0.0; + + for (i=0;i dr) + dr += r[(++k)-1]; + if (k > 1) xo=xi[j][k-2]; + xn=xi[j][k-1]; + dr -= rc; + xin[i]=xn-(xn-xo)*dr/r[k-1]; + } + for (i=0;i +#include "nr.h" +using namespace std; + +namespace { + inline DP alen(const DP a, const DP b, const DP c, const DP d) + { + return sqrt((b-a)*(b-a)+(d-c)*(d-c)); + } +} + +DP NR::revcst(Vec_I_DP &x, Vec_I_DP &y, Vec_I_INT &iorder, Vec_IO_INT &n) +{ + int j,ii; + DP de; + Vec_DP xx(4),yy(4); + + int ncity=x.size(); + n[2]=(n[0]+ncity-1) % ncity; + n[3]=(n[1]+1) % ncity; + for (j=0;j<4;j++) { + ii=iorder[n[j]]; + xx[j]=x[ii]; + yy[j]=y[ii]; + } + de = -alen(xx[0],xx[2],yy[0],yy[2]); + de -= alen(xx[1],xx[3],yy[1],yy[3]); + de += alen(xx[0],xx[3],yy[0],yy[3]); + de += alen(xx[1],xx[2],yy[1],yy[2]); + return de; +} diff --git a/lib/nr/cpp/recipes/reverse.cpp b/lib/nr/cpp/recipes/reverse.cpp new file mode 100644 index 0000000..851dbf5 --- /dev/null +++ b/lib/nr/cpp/recipes/reverse.cpp @@ -0,0 +1,16 @@ +#include "nr.h" + +void NR::reverse(Vec_IO_INT &iorder, Vec_I_INT &n) +{ + int nn,j,k,l,itmp; + + int ncity=iorder.size(); + nn=(1+((n[1]-n[0]+ncity) % ncity))/2; + for (j=0;j +#include "nr.h" +using namespace std; + +DP NR::rf(const DP x, const DP y, const DP z) +{ + const DP ERRTOL=0.0025, TINY=1.5e-38, BIG=3.0e37, THIRD=1.0/3.0; + const DP C1=1.0/24.0, C2=0.1, C3=3.0/44.0, C4=1.0/14.0; + DP alamb,ave,delx,dely,delz,e2,e3,sqrtx,sqrty,sqrtz,xt,yt,zt; + + if (MIN(MIN(x,y),z) < 0.0 || MIN(MIN(x+y,x+z),y+z) < TINY || + MAX(MAX(x,y),z) > BIG) + nrerror("invalid arguments in rf"); + xt=x; + yt=y; + zt=z; + do { + sqrtx=sqrt(xt); + sqrty=sqrt(yt); + sqrtz=sqrt(zt); + alamb=sqrtx*(sqrty+sqrtz)+sqrty*sqrtz; + xt=0.25*(xt+alamb); + yt=0.25*(yt+alamb); + zt=0.25*(zt+alamb); + ave=THIRD*(xt+yt+zt); + delx=(ave-xt)/ave; + dely=(ave-yt)/ave; + delz=(ave-zt)/ave; + } while (MAX(MAX(fabs(delx),fabs(dely)),fabs(delz)) > ERRTOL); + e2=delx*dely-delz*delz; + e3=delx*dely*delz; + return (1.0+(C1*e2-C2-C3*e3)*e2+C4*e3)/sqrt(ave); +} diff --git a/lib/nr/cpp/recipes/rj.cpp b/lib/nr/cpp/recipes/rj.cpp new file mode 100644 index 0000000..dc64f06 --- /dev/null +++ b/lib/nr/cpp/recipes/rj.cpp @@ -0,0 +1,63 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::rj(const DP x, const DP y, const DP z, const DP p) +{ + const DP ERRTOL=0.0015, TINY=2.5e-13, BIG=9.0e11; + const DP C1=3.0/14.0, C2=1.0/3.0, C3=3.0/22.0, C4=3.0/26.0; + const DP C5=0.75*C3, C6=1.5*C4, C7=0.5*C2, C8=C3+C3; + DP a,alamb,alpha,ans,ave,b,beta,delp,delx,dely,delz,ea,eb,ec,ed,ee, + fac,pt,rcx,rho,sqrtx,sqrty,sqrtz,sum,tau,xt,yt,zt; + + if (MIN(MIN(x,y),z) < 0.0 || MIN(MIN(x+y,x+z),MIN(y+z,fabs(p))) < TINY + || MAX(MAX(x,y),MAX(z,fabs(p))) > BIG) + nrerror("invalid arguments in rj"); + sum=0.0; + fac=1.0; + if (p > 0.0) { + xt=x; + yt=y; + zt=z; + pt=p; + } else { + xt=MIN(MIN(x,y),z); + zt=MAX(MAX(x,y),z); + yt=x+y+z-xt-zt; + a=1.0/(yt-p); + b=a*(zt-yt)*(yt-xt); + pt=yt+b; + rho=xt*zt/yt; + tau=p*pt/yt; + rcx=rc(rho,tau); + } + do { + sqrtx=sqrt(xt); + sqrty=sqrt(yt); + sqrtz=sqrt(zt); + alamb=sqrtx*(sqrty+sqrtz)+sqrty*sqrtz; + alpha=SQR(pt*(sqrtx+sqrty+sqrtz)+sqrtx*sqrty*sqrtz); + beta=pt*SQR(pt+alamb); + sum += fac*rc(alpha,beta); + fac=0.25*fac; + xt=0.25*(xt+alamb); + yt=0.25*(yt+alamb); + zt=0.25*(zt+alamb); + pt=0.25*(pt+alamb); + ave=0.2*(xt+yt+zt+pt+pt); + delx=(ave-xt)/ave; + dely=(ave-yt)/ave; + delz=(ave-zt)/ave; + delp=(ave-pt)/ave; + } while (MAX(MAX(fabs(delx),fabs(dely)), + MAX(fabs(delz),fabs(delp))) > ERRTOL); + ea=delx*(dely+delz)+dely*delz; + eb=delx*dely*delz; + ec=delp*delp; + ed=ea-3.0*ec; + ee=eb+2.0*delp*(ea-ec); + ans=3.0*sum+fac*(1.0+ed*(-C1+C5*ed-C6*ee)+eb*(C7+delp*(-C8+delp*C4)) + +delp*ea*(C2-delp*C3)-C2*delp*ec)/(ave*sqrt(ave)); + if (p <= 0.0) ans=a*(b*ans+3.0*(rcx-rf(xt,yt,zt))); + return ans; +} diff --git a/lib/nr/cpp/recipes/rk4.cpp b/lib/nr/cpp/recipes/rk4.cpp new file mode 100644 index 0000000..09a006f --- /dev/null +++ b/lib/nr/cpp/recipes/rk4.cpp @@ -0,0 +1,25 @@ +#include "nr.h" + +void NR::rk4(Vec_I_DP &y, Vec_I_DP &dydx, const DP x, const DP h, + Vec_O_DP &yout, void derivs(const DP, Vec_I_DP &, Vec_O_DP &)) +{ + int i; + DP xh,hh,h6; + + int n=y.size(); + Vec_DP dym(n),dyt(n),yt(n); + hh=h*0.5; + h6=h/6.0; + xh=x+hh; + for (i=0;i +#include "nr.h" +using namespace std; + +void NR::rkqs(Vec_IO_DP &y, Vec_IO_DP &dydx, DP &x, const DP htry, + const DP eps, Vec_I_DP &yscal, DP &hdid, DP &hnext, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &)) +{ + const DP SAFETY=0.9, PGROW=-0.2, PSHRNK=-0.25, ERRCON=1.89e-4; + int i; + DP errmax,h,htemp,xnew; + + int n=y.size(); + h=htry; + Vec_DP yerr(n),ytemp(n); + for (;;) { + rkck(y,dydx,x,h,ytemp,yerr,derivs); + errmax=0.0; + for (i=0;i= 0.0 ? MAX(htemp,0.1*h) : MIN(htemp,0.1*h)); + xnew=x+h; + if (xnew == x) nrerror("stepsize underflow in rkqs"); + } + if (errmax > ERRCON) hnext=SAFETY*h*pow(errmax,PGROW); + else hnext=5.0*h; + x += (hdid=h); + for (i=0;i +#include "nr.h" +using namespace std; + +void NR::rlft3(Mat3D_IO_DP &data, Mat_IO_DP &speq, const int isign) +{ + int i1,i2,i3,j1,j2,j3,ii3,k1,k2,k3,k4; + DP theta,wi,wpi,wpr,wr,wtemp; + DP c1,c2,h1r,h1i,h2r,h2i; + Vec_INT nn(3); + + int nn1=data.dim1(); + int nn2=data.dim2(); + int nn3=data.dim3(); + c1=0.5; + c2= -0.5*isign; + theta=isign*(6.28318530717959/nn3); + wtemp=sin(0.5*theta); + wpr= -2.0*wtemp*wtemp; + wpi=sin(theta); + nn[0]=nn1; + nn[1]=nn2; + nn[2]=nn3 >> 1; + Vec_DP data_v(&data[0][0][0],nn1*nn2*nn3); + if (isign == 1) { + fourn(data_v,nn,isign); + k1=0; + for (i1=0;i1>1);ii3+=2) { + k1=i1*nn2*nn3; + k3=j1*nn2*nn3; + for (i2=0;i2 +#include +#include "nr.h" +using namespace std; + +extern DP aa,abdevt; +extern const Vec_DP *xt_p,*yt_p; + +DP NR::rofunc(const DP b) +{ + const DP EPS=numeric_limits::epsilon(); + int j; + DP d,sum=0.0; + + const Vec_DP &xt=*xt_p,&yt=*yt_p; + int ndatat=xt.size(); + Vec_DP arr(ndatat); + for (j=0;j>1,arr); + } else { + j=ndatat >> 1; + aa=0.5*(select(j-1,arr)+select(j,arr)); + } + abdevt=0.0; + for (j=0;j EPS) sum += (d >= 0.0 ? xt[j] : -xt[j]); + } + return sum; +} diff --git a/lib/nr/cpp/recipes/rotate.cpp b/lib/nr/cpp/recipes/rotate.cpp new file mode 100644 index 0000000..5556691 --- /dev/null +++ b/lib/nr/cpp/recipes/rotate.cpp @@ -0,0 +1,36 @@ +#include +#include "nr.h" +using namespace std; + +void NR::rotate(Mat_IO_DP &r, Mat_IO_DP &qt, const int i, const DP a, + const DP b) +{ + int j; + DP c,fact,s,w,y; + + int n=r.nrows(); + if (a == 0.0) { + c=0.0; + s=(b >= 0.0 ? 1.0 : -1.0); + } else if (fabs(a) > fabs(b)) { + fact=b/a; + c=SIGN(1.0/sqrt(1.0+(fact*fact)),a); + s=fact*c; + } else { + fact=a/b; + s=SIGN(1.0/sqrt(1.0+(fact*fact)),b); + c=fact*s; + } + for (j=i;j=0;i--) { + for (sum=0.0,j=i+1;j +#include "nr.h" +using namespace std; + +DP NR::rtbis(DP func(const DP), const DP x1, const DP x2, const DP xacc) +{ + const int JMAX=40; + int j; + DP dx,f,fmid,xmid,rtb; + + f=func(x1); + fmid=func(x2); + if (f*fmid >= 0.0) nrerror("Root must be bracketed for bisection in rtbis"); + rtb = f < 0.0 ? (dx=x2-x1,x1) : (dx=x1-x2,x2); + for (j=0;j +#include "nr.h" +using namespace std; + +DP NR::rtflsp(DP func(const DP), const DP x1, const DP x2, const DP xacc) +{ + const int MAXIT=30; + int j; + DP fl,fh,xl,xh,dx,del,f,rtf; + + fl=func(x1); + fh=func(x2); + if (fl*fh > 0.0) nrerror("Root must be bracketed in rtflsp"); + if (fl < 0.0) { + xl=x1; + xh=x2; + } else { + xl=x2; + xh=x1; + SWAP(fl,fh); + } + dx=xh-xl; + for (j=0;j +#include "nr.h" +using namespace std; + +DP NR::rtnewt(void funcd(const DP, DP &, DP &), const DP x1, const DP x2, + const DP xacc) +{ + const int JMAX=20; + int j; + DP df,dx,f,rtn; + + rtn=0.5*(x1+x2); + for (j=0;j +#include "nr.h" +using namespace std; + +DP NR::rtsafe(void funcd(const DP, DP &, DP &), const DP x1, const DP x2, + const DP xacc) +{ + const int MAXIT=100; + int j; + DP df,dx,dxold,f,fh,fl,temp,xh,xl,rts; + + funcd(x1,fl,df); + funcd(x2,fh,df); + if ((fl > 0.0 && fh > 0.0) || (fl < 0.0 && fh < 0.0)) + nrerror("Root must be bracketed in rtsafe"); + if (fl == 0.0) return x1; + if (fh == 0.0) return x2; + if (fl < 0.0) { + xl=x1; + xh=x2; + } else { + xh=x1; + xl=x2; + } + rts=0.5*(x1+x2); + dxold=fabs(x2-x1); + dx=dxold; + funcd(rts,f,df); + for (j=0;j 0.0) + || (fabs(2.0*f) > fabs(dxold*df))) { + dxold=dx; + dx=0.5*(xh-xl); + rts=xl+dx; + if (xl == rts) return rts; + } else { + dxold=dx; + dx=f/df; + temp=rts; + rts -= dx; + if (temp == rts) return rts; + } + if (fabs(dx) < xacc) return rts; + funcd(rts,f,df); + if (f < 0.0) + xl=rts; + else + xh=rts; + } + nrerror("Maximum number of iterations exceeded in rtsafe"); + return 0.0; +} diff --git a/lib/nr/cpp/recipes/rtsec.cpp b/lib/nr/cpp/recipes/rtsec.cpp new file mode 100644 index 0000000..3793079 --- /dev/null +++ b/lib/nr/cpp/recipes/rtsec.cpp @@ -0,0 +1,31 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::rtsec(DP func(const DP), const DP x1, const DP x2, const DP xacc) +{ + const int MAXIT=30; + int j; + DP fl,f,dx,xl,rts; + + fl=func(x1); + f=func(x2); + if (fabs(fl) < fabs(f)) { + rts=x1; + xl=x2; + SWAP(fl,f); + } else { + xl=x1; + rts=x2; + } + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::savgol(Vec_O_DP &c, const int np, const int nl, const int nr, + const int ld, const int m) +{ + int j,k,imj,ipj,kk,mm; + DP d,fac,sum; + + if (np < nl+nr+1 || nl < 0 || nr < 0 || ld > m || nl+nr < m) + nrerror("bad args in savgol"); + Vec_INT indx(m+1); + Mat_DP a(m+1,m+1); + Vec_DP b(m+1); + for (ipj=0;ipj<=(m << 1);ipj++) { + sum=(ipj ? 0.0 : 1.0); + for (k=1;k<=nr;k++) sum += pow(DP(k),DP(ipj)); + for (k=1;k<=nl;k++) sum += pow(DP(-k),DP(ipj)); + mm=MIN(ipj,2*m-ipj); + for (imj = -mm;imj<=mm;imj+=2) a[(ipj+imj)/2][(ipj-imj)/2]=sum; + } + ludcmp(a,indx,d); + for (j=0;j +#include +#include +#include "nr.h" +using namespace std; + +void NR::scrsho(DP fx(const DP)) +{ + const int ISCR=60, JSCR=21; + const char BLANK=' ', ZERO='-', YY='l', XX='-', FF='x'; + int jz,j,i; + DP ysml,ybig,x2,x1,x,dyj,dx; + Vec_DP y(ISCR); + string scr[JSCR]; + + for (;;) { + cout << endl << "Enter x1 x2 (x1=x2 to stop):" << endl; + cin >> x1 >> x2; + if (x1 == x2) break; + scr[0]=YY; + for (i=1;i<(ISCR-1);i++) + scr[0] += XX; + scr[0] += YY; + for (j=1;j<(JSCR-1);j++) { + scr[j]=YY; + for (i=1;i<(ISCR-1);i++) + scr[j] += BLANK; + scr[j] += YY; + } + scr[JSCR-1]=scr[0]; + dx=(x2-x1)/(ISCR-1); + x=x1; + ysml=ybig=0.0; + for (i=0;i ybig) ybig=y[i]; + x += dx; + } + if (ybig == ysml) ybig=ysml+1.0; + dyj=(JSCR-1)/(ybig-ysml); + jz=int(-ysml*dyj); + for (i=0;i=1;j--) + cout << " " << scr[j] << endl; + cout << setw(11) << ysml << " " << scr[0] << endl; + cout << setw(19) << x1 << setw(55) << x2; + } +} diff --git a/lib/nr/cpp/recipes/select.cpp b/lib/nr/cpp/recipes/select.cpp new file mode 100644 index 0000000..b8179f7 --- /dev/null +++ b/lib/nr/cpp/recipes/select.cpp @@ -0,0 +1,40 @@ +#include "nr.h" + +DP NR::select(const int k, Vec_IO_DP &arr) +{ + int i,ir,j,l,mid; + DP a; + + int n=arr.size(); + l=0; + ir=n-1; + for (;;) { + if (ir <= l+1) { + if (ir == l+1 && arr[ir] < arr[l]) + SWAP(arr[l],arr[ir]); + return arr[k]; + } else { + mid=(l+ir) >> 1; + SWAP(arr[mid],arr[l+1]); + if (arr[l] > arr[ir]) + SWAP(arr[l],arr[ir]); + if (arr[l+1] > arr[ir]) + SWAP(arr[l+1],arr[ir]); + if (arr[l] > arr[l+1]) + SWAP(arr[l],arr[l+1]); + i=l+1; + j=ir; + a=arr[l+1]; + for (;;) { + do i++; while (arr[i] < a); + do j--; while (arr[j] > a); + if (j < i) break; + SWAP(arr[i],arr[j]); + } + arr[l+1]=arr[j]; + arr[j]=a; + if (j >= k) ir=j-1; + if (j <= k) l=i; + } + } +} diff --git a/lib/nr/cpp/recipes/selip.cpp b/lib/nr/cpp/recipes/selip.cpp new file mode 100644 index 0000000..9c4a08d --- /dev/null +++ b/lib/nr/cpp/recipes/selip.cpp @@ -0,0 +1,64 @@ +#include "nr.h" + +DP NR::selip(const int k, Vec_I_DP &arr) +{ + const int M=64; + const DP BIG=1.0e30; + int i,j,jl,jm,ju,kk,mm,nlo,nxtmm; + DP ahi,alo,sum; + Vec_INT isel(M+2); + Vec_DP sel(M+2); + + int n=arr.size(); + if (k < 0 || k > n-1) nrerror("bad input to selip"); + kk=k; + ahi=BIG; + alo = -BIG; + for (;;) { + mm=nlo=0; + sum=0.0; + nxtmm=M+1; + for (i=0;i= alo && arr[i] <= ahi) { + mm++; + if (arr[i] == alo) nlo++; + if (mm <= M) sel[mm-1]=arr[i]; + else if (mm == nxtmm) { + nxtmm=mm+mm/M; + sel[(i+2+mm+kk) % M]=arr[i]; + } + sum += arr[i]; + } + } + if (kk < nlo) { + return alo; + } + else if (mm < M+1) { + shell(mm,sel); + ahi = sel[kk]; + return ahi; + } + sel[M]=sum/mm; + shell(M+1,sel); + sel[M+1]=ahi; + for (j=0;j= alo && arr[i] <= ahi) { + jl=0; + ju=M+2; + while (ju-jl > 1) { + jm=(ju+jl)/2; + if (arr[i] >= sel[jm-1]) jl=jm; + else ju=jm; + } + isel[ju-1]++; + } + } + j=0; + while (kk >= isel[j]) { + alo=sel[j]; + kk -= isel[j++]; + } + ahi=sel[j]; + } +} diff --git a/lib/nr/cpp/recipes/sfroid.cpp b/lib/nr/cpp/recipes/sfroid.cpp new file mode 100644 index 0000000..b93f566 --- /dev/null +++ b/lib/nr/cpp/recipes/sfroid.cpp @@ -0,0 +1,74 @@ +#include +#include +#include +#include "nr.h" +using namespace std; + +const int M=40; +int mm,n,mpt=M+1; +DP h,c2=0.0,anorm; +Vec_DP *x_p; + +int main(void) // Program sfroid +{ + const int NE=3,NB=1,NYJ=NE,NYK=M+1; + int i,itmax,k; + DP conv,deriv,fac1,fac2,q1,slowc; + Vec_INT indexv(NE); + Vec_DP scalv(NE); + Mat_DP y(NYJ,NYK); + + x_p=new Vec_DP(M+1); + Vec_DP &x=*x_p; + itmax=100; + conv=1.0e-14; + slowc=1.0; + h=1.0/M; + cout << endl << "Enter m n" << endl; + cin >> mm >> n; + if ((n+mm & 1) != 0) { + indexv[0]=0; + indexv[1]=1; + indexv[2]=2; + } else { + indexv[0]=1; + indexv[1]=0; + indexv[2]=2; + } + anorm=1.0; + if (mm != 0) { + q1=n; + for (i=1;i<=mm;i++) anorm = -0.5*anorm*(n+i)*(q1--/i); + } + for (k=0;k scalv[0] ? y[1][M] : scalv[0]); + scalv[2]=(y[2][M] > 1.0 ? y[2][M] : 1.0); + for (;;) { + cout << endl << "Enter c**2 or 999 to end" << endl; + cin >> c2; + if (c2 == 999) { + delete x_p; + return 0; + } + NR::solvde(itmax,conv,slowc,scalv,indexv,NB,y); + cout << endl << " m = " << setw(3) << mm; + cout << " n = " << setw(3) << n << " c**2 = "; + cout << fixed << setprecision(3) << setw(7) << c2; + cout << " lamda = " << setprecision(6) << (y[2][0]+mm*(mm+1)); + cout << endl; + } +} diff --git a/lib/nr/cpp/recipes/shell.cpp b/lib/nr/cpp/recipes/shell.cpp new file mode 100644 index 0000000..a480fd2 --- /dev/null +++ b/lib/nr/cpp/recipes/shell.cpp @@ -0,0 +1,26 @@ +#include "nr.h" + +void NR::shell(const int m, Vec_IO_DP &a) +{ + int i,j,inc; + DP v; + + inc=1; + do { + inc *= 3; + inc++; + } while (inc <= m); + do { + inc /= 3; + for (i=inc;i v) { + a[j]=a[j-inc]; + j -= inc; + if (j < inc) break; + } + a[j]=v; + } + } while (inc > 1); +} diff --git a/lib/nr/cpp/recipes/shoot.cpp b/lib/nr/cpp/recipes/shoot.cpp new file mode 100644 index 0000000..4fc43c7 --- /dev/null +++ b/lib/nr/cpp/recipes/shoot.cpp @@ -0,0 +1,27 @@ +#include "nr.h" + +extern int nvar; +extern DP x1,x2; + +int kmax,kount; +DP dxsav; +Vec_DP *xp_p; +Mat_DP *yp_p; + +void derivs(const DP x, Vec_I_DP &y, Vec_O_DP &dydx); +void load(const DP x1, Vec_I_DP &v, Vec_O_DP &y); +void score(const DP xf, Vec_I_DP &y, Vec_O_DP &f); + +void NR::shoot(Vec_I_DP &v, Vec_O_DP &f) +{ + const DP EPS=1.0e-14; + int nbad,nok; + DP h1,hmin=0.0; + + Vec_DP y(nvar); + kmax=0; + h1=(x2-x1)/100.0; + load(x1,v,y); + odeint(y,x1,x2,EPS,h1,hmin,nok,nbad,derivs,rkqs); + score(x2,y,f); +} diff --git a/lib/nr/cpp/recipes/shootf.cpp b/lib/nr/cpp/recipes/shootf.cpp new file mode 100644 index 0000000..66dee76 --- /dev/null +++ b/lib/nr/cpp/recipes/shootf.cpp @@ -0,0 +1,34 @@ +#include "nr.h" + +extern int n2; +extern DP x1,x2,xf; + +int kmax,kount; +DP dxsav; +Mat_DP *yp_p; +Vec_DP *xp_p; + +void derivs(const DP x, Vec_I_DP &y, Vec_O_DP &dydx); +void load1(const DP x1, Vec_I_DP &v1, Vec_O_DP &y); +void load2(const DP x2, Vec_I_DP &v2, Vec_O_DP &y); +void score(const DP xf, Vec_I_DP &y, Vec_O_DP &f); + +void NR::shootf(Vec_I_DP &v, Vec_O_DP &f) +{ + const DP EPS=1.0e-14; + int i,nbad,nok; + DP h1,hmin=0.0; + + int nvar=v.size(); + Vec_DP f1(nvar),f2(nvar),y(nvar); + Vec_DP v2(&v[n2],nvar-n2); + kmax=0; + h1=(x2-x1)/100.0; + load1(x1,v,y); + odeint(y,x1,xf,EPS,h1,hmin,nok,nbad,derivs,rkqs); + score(xf,y,f1); + load2(x2,v2,y); + odeint(y,x2,xf,EPS,h1,hmin,nok,nbad,derivs,rkqs); + score(xf,y,f2); + for (i=0;i +#include "nr.h" +using namespace std; + +void NR::simp1(Mat_I_DP &a, const int mm, Vec_I_INT &ll, const int nll, + const int iabf, int &kp, DP &bmax) +{ + int k; + DP test; + + if (nll <= 0) + bmax=0.0; + else { + kp=ll[0]; + bmax=a[mm][kp]; + for (k=1;k 0.0) { + bmax=a[mm][ll[k]]; + kp=ll[k]; + } + } + } +} diff --git a/lib/nr/cpp/recipes/simp2.cpp b/lib/nr/cpp/recipes/simp2.cpp new file mode 100644 index 0000000..c1e7d25 --- /dev/null +++ b/lib/nr/cpp/recipes/simp2.cpp @@ -0,0 +1,31 @@ +#include "nr.h" + +void NR::simp2(Mat_I_DP &a, const int m, const int n, int &ip, const int kp) +{ + const DP EPS=1.0e-14; + int k,i; + DP qp,q0,q,q1; + + ip=0; + for (i=0;im) return; + q1 = -a[i+1][0]/a[i+1][kp]; + ip=i+1; + for (i=ip;i EPS) + goto one; + } + } + for (i=m1+1;i<=m1+m2;i++) + if (l3[i-m1-1] == 1) + for (k=0;k= (n+m1+m2)) { + for (k=0;k= 1 && l3[kh-1]) { + l3[kh-1]=0; + ++a[m+1][kp]; + for (i=0;i +#include "nr.h" +using namespace std; + +void NR::sinft(Vec_IO_DP &y) +{ + int j; + DP sum,y1,y2,theta,wi=0.0,wr=1.0,wpi,wpr,wtemp; + + int n=y.size(); + theta=3.141592653589793238/DP(n); + wtemp=sin(0.5*theta); + wpr= -2.0*wtemp*wtemp; + wpi=sin(theta); + y[0]=0.0; + for (j=1;j<(n>>1)+1;j++) { + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + y1=wi*(y[j]+y[n-j]); + y2=0.5*(y[j]-y[n-j]); + y[j]=y1+y2; + y[n-j]=y1-y2; + } + realft(y,1); + y[0]*=0.5; + sum=y[1]=0.0; + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::slvsm2(Mat_O_DP &u, Mat_I_DP &rhs) +{ + int i,j; + DP disc,fact,h=0.5; + + for (i=0;i<3;i++) + for (j=0;j<3;j++) + u[i][j]=0.0; + fact=2.0/(h*h); + disc=sqrt(fact*fact+rhs[1][1]); + u[1][1]= -rhs[1][1]/(fact+disc); +} diff --git a/lib/nr/cpp/recipes/slvsml.cpp b/lib/nr/cpp/recipes/slvsml.cpp new file mode 100644 index 0000000..503467e --- /dev/null +++ b/lib/nr/cpp/recipes/slvsml.cpp @@ -0,0 +1,12 @@ +#include "nr.h" + +void NR::slvsml(Mat_O_DP &u, Mat_I_DP &rhs) +{ + int i,j; + DP h=0.5; + + for (i=0;i<3;i++) + for (j=0;j<3;j++) + u[i][j]=0.0; + u[1][1] = -h*h*rhs[1][1]/4.0; +} diff --git a/lib/nr/cpp/recipes/sncndn.cpp b/lib/nr/cpp/recipes/sncndn.cpp new file mode 100644 index 0000000..83b07cc --- /dev/null +++ b/lib/nr/cpp/recipes/sncndn.cpp @@ -0,0 +1,61 @@ +#include +#include "nr.h" +using namespace std; + +void NR::sncndn(const DP uu, const DP emmc, DP &sn, DP &cn, DP &dn) +{ + const DP CA=1.0e-8; + bool bo; + int i,ii,l; + DP a,b,c,d,emc,u; + Vec_DP em(13),en(13); + + emc=emmc; + u=uu; + if (emc != 0.0) { + bo=(emc < 0.0); + if (bo) { + d=1.0-emc; + emc /= -1.0/d; + u *= (d=sqrt(d)); + } + a=1.0; + dn=1.0; + for (i=0;i<13;i++) { + l=i; + em[i]=a; + en[i]=(emc=sqrt(emc)); + c=0.5*(a+emc); + if (fabs(a-emc) <= CA*a) break; + emc *= a; + a=c; + } + u *= c; + sn=sin(u); + cn=cos(u); + if (sn != 0.0) { + a=cn/sn; + c *= a; + for (ii=l;ii>=0;ii--) { + b=em[ii]; + a *= c; + c *= dn; + dn=(en[ii]+a)/(b+a); + a=c/b; + } + a=1.0/sqrt(c*c+1.0); + sn=(sn >= 0.0 ? a : -a); + cn=c*sn; + } + if (bo) { + a=dn; + dn=cn; + cn=a; + sn /= d; + } + } else { + cn=1.0/cosh(u); + dn=cn; + sn=tanh(u); + } +} diff --git a/lib/nr/cpp/recipes/snrm.cpp b/lib/nr/cpp/recipes/snrm.cpp new file mode 100644 index 0000000..28fb166 --- /dev/null +++ b/lib/nr/cpp/recipes/snrm.cpp @@ -0,0 +1,22 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::snrm(Vec_I_DP &sx, const int itol) +{ + int i,isamax; + DP ans; + + int n=sx.size(); + if (itol <= 3) { + ans = 0.0; + for (i=0;i fabs(sx[isamax])) isamax=i; + } + return fabs(sx[isamax]); + } +} diff --git a/lib/nr/cpp/recipes/sobseq.cpp b/lib/nr/cpp/recipes/sobseq.cpp new file mode 100644 index 0000000..5f256c1 --- /dev/null +++ b/lib/nr/cpp/recipes/sobseq.cpp @@ -0,0 +1,49 @@ +#include "nr.h" + +void NR::sobseq(const int n, Vec_O_DP &x) +{ + const int MAXBIT=30,MAXDIM=6; + int j,k,l; + unsigned long i,im,ipp; + static int mdeg[MAXDIM]={1,2,3,3,4,4}; + static unsigned long in; + static Vec_ULNG ix(MAXDIM); + static Vec_ULNG_p iu(MAXBIT); + static unsigned long ip[MAXDIM]={0,1,1,2,1,4}; + static unsigned long iv[MAXDIM*MAXBIT]= + {1,1,1,1,1,1,3,1,3,3,1,1,5,7,7,3,3,5,15,11,5,15,13,9}; + static DP fac; + + if (n < 0) { + for (k=0;k> mdeg[k]); + for (l=mdeg[k]-1;l>=1;l--) { + if (ipp & 1) i ^= iu[j-l][k]; + ipp >>= 1; + } + iu[j][k]=i; + } + } + } else { + im=in++; + for (j=0;j>= 1; + } + if (j >= MAXBIT) nrerror("MAXBIT too small in sobseq"); + im=j*MAXDIM; + for (k=0;k +#include +#include +#include "nr.h" +using namespace std; + +void NR::solvde(const int itmax, const DP conv, const DP slowc, + Vec_I_DP &scalv, Vec_I_INT &indexv, const int nb, Mat_IO_DP &y) +{ + int ic1,ic2,ic3,ic4,it,j,j1,j2,j3,j4,j5,j6,j7,j8,j9; + int jc1,jcf,jv,k,k1,k2,km,kp,nvars; + DP err,errj,fac,vmax,vz; + + int ne=y.nrows(); + int m=y.ncols(); + Vec_INT kmax(ne); + Vec_DP ermax(ne); + Mat3D_DP c(ne,ne-nb+1,m+1); + Mat_DP s(ne,2*ne+1); + k1=0; k2=m; + nvars=ne*m; + j1=0,j2=nb,j3=nb,j4=ne,j5=j4+j1; + j6=j4+j2,j7=j4+j3,j8=j4+j4,j9=j8+j1; + ic1=0,ic2=ne-nb,ic3=ic2,ic4=ne; + jc1=0,jcf=ic3; + for (it=0;it vmax) { + vmax=vz; + km=k+1; + } + errj += vz; + } + err += errj/scalv[j]; + ermax[j]=c[jv][0][km-1]/scalv[j]; + kmax[j]=km; + } + err /= nvars; + fac=(err > slowc ? slowc/err : 1.0); + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::sor(Mat_I_DP &a, Mat_I_DP &b, Mat_I_DP &c, Mat_I_DP &d, Mat_I_DP &e, + Mat_I_DP &f, Mat_IO_DP &u, const DP rjac) +{ + const int MAXITS=1000; + const DP EPS=1.0e-13; + int j,l,n,ipass,jsw,lsw; + DP anorm,anormf=0.0,omega=1.0,resid; + + int jmax=a.nrows(); + for (j=1;j=l;i--) { + if (arr[i] <= a) break; + arr[i+1]=arr[i]; + } + arr[i+1]=a; + } + if (jstack < 0) break; + ir=istack[jstack--]; + l=istack[jstack--]; + } else { + k=(l+ir) >> 1; + SWAP(arr[k],arr[l+1]); + if (arr[l] > arr[ir]) { + SWAP(arr[l],arr[ir]); + } + if (arr[l+1] > arr[ir]) { + SWAP(arr[l+1],arr[ir]); + } + if (arr[l] > arr[l+1]) { + SWAP(arr[l],arr[l+1]); + } + i=l+1; + j=ir; + a=arr[l+1]; + for (;;) { + do i++; while (arr[i] < a); + do j--; while (arr[j] > a); + if (j < i) break; + SWAP(arr[i],arr[j]); + } + arr[l+1]=arr[j]; + arr[j]=a; + jstack += 2; + if (jstack >= NSTACK) nrerror("NSTACK too small in sort."); + if (ir-i+1 >= j-l) { + istack[jstack]=ir; + istack[jstack-1]=i; + ir=j-1; + } else { + istack[jstack]=j-1; + istack[jstack-1]=l; + l=i; + } + } + } +} diff --git a/lib/nr/cpp/recipes/sort2.cpp b/lib/nr/cpp/recipes/sort2.cpp new file mode 100644 index 0000000..b64e7e0 --- /dev/null +++ b/lib/nr/cpp/recipes/sort2.cpp @@ -0,0 +1,72 @@ +#include "nr.h" + +void NR::sort2(Vec_IO_DP &arr, Vec_IO_DP &brr) +{ + const int M=7,NSTACK=50; + int i,ir,j,k,jstack=-1,l=0; + DP a,b; + Vec_INT istack(NSTACK); + + int n=arr.size(); + ir=n-1; + for (;;) { + if (ir-l < M) { + for (j=l+1;j<=ir;j++) { + a=arr[j]; + b=brr[j]; + for (i=j-1;i>=l;i--) { + if (arr[i] <= a) break; + arr[i+1]=arr[i]; + brr[i+1]=brr[i]; + } + arr[i+1]=a; + brr[i+1]=b; + } + if (jstack < 0) break; + ir=istack[jstack--]; + l=istack[jstack--]; + } else { + k=(l+ir) >> 1; + SWAP(arr[k],arr[l+1]); + SWAP(brr[k],brr[l+1]); + if (arr[l] > arr[ir]) { + SWAP(arr[l],arr[ir]); + SWAP(brr[l],brr[ir]); + } + if (arr[l+1] > arr[ir]) { + SWAP(arr[l+1],arr[ir]); + SWAP(brr[l+1],brr[ir]); + } + if (arr[l] > arr[l+1]) { + SWAP(arr[l],arr[l+1]); + SWAP(brr[l],brr[l+1]); + } + i=l+1; + j=ir; + a=arr[l+1]; + b=brr[l+1]; + for (;;) { + do i++; while (arr[i] < a); + do j--; while (arr[j] > a); + if (j < i) break; + SWAP(arr[i],arr[j]); + SWAP(brr[i],brr[j]); + } + arr[l+1]=arr[j]; + arr[j]=a; + brr[l+1]=brr[j]; + brr[j]=b; + jstack += 2; + if (jstack >= NSTACK) nrerror("NSTACK too small in sort2."); + if (ir-i+1 >= j-l) { + istack[jstack]=ir; + istack[jstack-1]=i; + ir=j-1; + } else { + istack[jstack]=j-1; + istack[jstack-1]=l; + l=i; + } + } + } +} diff --git a/lib/nr/cpp/recipes/sort3.cpp b/lib/nr/cpp/recipes/sort3.cpp new file mode 100644 index 0000000..8fd281e --- /dev/null +++ b/lib/nr/cpp/recipes/sort3.cpp @@ -0,0 +1,17 @@ +#include "nr.h" + +void NR::sort3(Vec_IO_DP &ra, Vec_IO_DP &rb, Vec_IO_DP &rc) +{ + int j; + + int n=ra.size(); + Vec_INT iwksp(n); + Vec_DP wksp(n); + indexx(ra,iwksp); + for (j=0;j +#include +#include "nr.h" +using namespace std; + +namespace { + inline DP window(const int j, const DP a, const DP b) + { + return 1.0-fabs((j-a)*b); // Bartlett + // return 1.0; // Square + // return 1.0-SQR((j-a)*b); // Welch + } +} + +void NR::spctrm(ifstream &fp, Vec_O_DP &p, const int k, const bool ovrlap) +{ + int mm,m4,kk,joffn,joff,j2,j; + DP w,facp,facm,sumw=0.0,den=0.0; + + int m=p.size(); + mm=m << 1; + m4=mm << 1; + Vec_DP w1(m4),w2(m); + facm=m; + facp=1.0/m; + for (j=0;j> w2[j]; + for (kk=0;kk> w2[j]; + joffn=joff+mm-1; + for (j=0;j> w1[j]; + } + } + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::spear(Vec_I_DP &data1, Vec_I_DP &data2, DP &d, DP &zd, DP &probd, + DP &rs, DP &probrs) +{ + int j; + DP vard,t,sg,sf,fac,en3n,en,df,aved; + + int n=data1.size(); + Vec_DP wksp1(n),wksp2(n); + for (j=0;j 0.0) { + t=rs*sqrt((en-2.0)/fac); + df=en-2.0; + probrs=betai(0.5*df,0.5,df/(df+t*t)); + } else + probrs=0.0; +} diff --git a/lib/nr/cpp/recipes/sphbes.cpp b/lib/nr/cpp/recipes/sphbes.cpp new file mode 100644 index 0000000..2dc1af5 --- /dev/null +++ b/lib/nr/cpp/recipes/sphbes.cpp @@ -0,0 +1,18 @@ +#include +#include "nr.h" +using namespace std; + +void NR::sphbes(const int n, const DP x, DP &sj, DP &sy, DP &sjp, DP &syp) +{ + const DP RTPIO2=1.253314137315500251; + DP factor,order,rj,rjp,ry,ryp; + + if (n < 0 || x <= 0.0) nrerror("bad arguments in sphbes"); + order=n+0.5; + bessjy(x,order,rj,ry,rjp,ryp); + factor=RTPIO2/sqrt(x); + sj=factor*rj; + sy=factor*ry; + sjp=factor*rjp-sj/(2.0*x); + syp=factor*ryp-sy/(2.0*x); +} diff --git a/lib/nr/cpp/recipes/sphfpt.cpp b/lib/nr/cpp/recipes/sphfpt.cpp new file mode 100644 index 0000000..2fba710 --- /dev/null +++ b/lib/nr/cpp/recipes/sphfpt.cpp @@ -0,0 +1,77 @@ +#include +#include +#include +#include "nr.h" +using namespace std; + +int m,n; +DP c2,dx,gmma; + +int n2; +DP x1,x2,xf; + +int main(void) // Program sphfpt +{ + const int N1=2,N2=1,NTOT=N1+N2; + const DP DXX=1.0e-8; + bool check; + int i; + DP q1; + Vec_DP v(NTOT); + + n2=N2; + dx=DXX; + for (;;) { + cout << endl << "input m,n,c-squared (n >= m, c=999 to end)" << endl; + cin >> m >> n >> c2; + if (c2 == 999) break; + if (n < m || m < 0) continue; + gmma=1.0; + q1=n; + for (i=1;i<=m;i++) gmma *= -0.5*(n+i)*(q1--/i); + v[0]=n*(n+1)-m*(m+1)+c2/2.0; + v[2]=v[0]; + v[1]=gmma*(1.0-(v[2]-c2)*dx/(2*(m+1))); + x1= -1.0+dx; + x2=1.0-dx; + xf=0.0; + NR::newt(v,check,NR::shootf); + if (check) { + cout << "shootf failed; bad initial guess" << endl; + } else { + cout << " " << "mu(m,n)" << endl; + cout << fixed << setprecision(6); + cout << setw(12) << v[0] << endl; + } + } + return 0; +} + +void load1(const DP x1, Vec_I_DP &v1, Vec_O_DP &y) +{ + DP y1 = ((n-m & 1) != 0 ? -gmma : gmma); + y[2]=v1[0]; + y[1] = -(y[2]-c2)*y1/(2*(m+1)); + y[0]=y1+y[1]*dx; +} + +void load2(const DP x2, Vec_I_DP &v2, Vec_O_DP &y) +{ + y[2]=v2[1]; + y[0]=v2[0]; + y[1]=(y[2]-c2)*y[0]/(2*(m+1)); +} + +void score(const DP xf, Vec_I_DP &y, Vec_O_DP &f) +{ + int i; + + for (i=0;i<3;i++) f[i]=y[i]; +} + +void derivs(const DP x, Vec_I_DP &y, Vec_O_DP &dydx) +{ + dydx[0]=y[1]; + dydx[1]=(2.0*x*(m+1.0)*y[1]-(y[2]-c2*x*x)*y[0])/(1.0-x*x); + dydx[2]=0.0; +} diff --git a/lib/nr/cpp/recipes/sphoot.cpp b/lib/nr/cpp/recipes/sphoot.cpp new file mode 100644 index 0000000..6f47668 --- /dev/null +++ b/lib/nr/cpp/recipes/sphoot.cpp @@ -0,0 +1,63 @@ +#include +#include +#include "nr.h" +using namespace std; + +int m,n; +DP c2,dx,gmma; + +int nvar; +DP x1,x2; + +int main(void) // Program sphoot +{ + const int N2=1; + bool check; + int i; + DP q1; + Vec_DP v(N2); + + dx=1.0e-8; + nvar=3; + for (;;) { + cout << endl << "input m,n,c-squared (999 to end)" << endl; + cin >> m >> n >> c2; + if (c2 == 999) break; + if (n < m || m < 0) continue; + gmma=1.0; + q1=n; + for (i=1;i<=m;i++) gmma *= -0.5*(n+i)*(q1--/i); + v[0]=n*(n+1)-m*(m+1)+c2/2.0; + x1= -1.0+dx; + x2=0.0; + NR::newt(v,check,NR::shoot); + if (check) { + cout << "shoot failed; bad initial guess" << endl; + } else { + cout << " " << "mu(m,n)" << endl; + cout << fixed << setprecision(6); + cout << setw(12) << v[0] << endl; + } + } + return 0; +} + +void load(const DP x1, Vec_I_DP &v, Vec_O_DP &y) +{ + DP y1 = ((n-m & 1) != 0 ? -gmma : gmma); + y[2]=v[0]; + y[1] = -(y[2]-c2)*y1/(2*(m+1)); + y[0]=y1+y[1]*dx; +} + +void score(const DP xf, Vec_I_DP &y, Vec_O_DP &f) +{ + f[0]=((n-m & 1) != 0 ? y[0] : y[1]); +} + +void derivs(const DP x, Vec_I_DP &y, Vec_O_DP &dydx) +{ + dydx[0]=y[1]; + dydx[1]=(2.0*x*(m+1.0)*y[1]-(y[2]-c2*x*x)*y[0])/(1.0-x*x); + dydx[2]=0.0; +} diff --git a/lib/nr/cpp/recipes/splie2.cpp b/lib/nr/cpp/recipes/splie2.cpp new file mode 100644 index 0000000..b648f75 --- /dev/null +++ b/lib/nr/cpp/recipes/splie2.cpp @@ -0,0 +1,15 @@ +#include "nr.h" + +void NR::splie2(Vec_I_DP &x1a, Vec_I_DP &x2a, Mat_I_DP &ya, Mat_O_DP &y2a) +{ + int m,n,j,k; + + m=x1a.size(); + n=x2a.size(); + Vec_DP ya_t(n),y2a_t(n); + for (j=0;j 0.99e30) + y2[0]=u[0]=0.0; + else { + y2[0] = -0.5; + u[0]=(3.0/(x[1]-x[0]))*((y[1]-y[0])/(x[1]-x[0])-yp1); + } + for (i=1;i 0.99e30) + qn=un=0.0; + else { + qn=0.5; + un=(3.0/(x[n-1]-x[n-2]))*(ypn-(y[n-1]-y[n-2])/(x[n-1]-x[n-2])); + } + y2[n-1]=(un-qn*u[n-2])/(qn*y2[n-2]+1.0); + for (k=n-2;k>=0;k--) + y2[k]=y2[k]*y2[k+1]+u[k]; +} diff --git a/lib/nr/cpp/recipes/splint.cpp b/lib/nr/cpp/recipes/splint.cpp new file mode 100644 index 0000000..86cd95c --- /dev/null +++ b/lib/nr/cpp/recipes/splint.cpp @@ -0,0 +1,22 @@ +#include "nr.h" + +void NR::splint(Vec_I_DP &xa, Vec_I_DP &ya, Vec_I_DP &y2a, const DP x, DP &y) +{ + int k; + DP h,b,a; + + int n=xa.size(); + int klo=0; + int khi=n-1; + while (khi-klo > 1) { + k=(khi+klo) >> 1; + if (xa[k] > x) khi=k; + else klo=k; + } + h=xa[khi]-xa[klo]; + if (h == 0.0) nrerror("Bad xa input to routine splint"); + a=(xa[khi]-x)/h; + b=(x-xa[klo])/h; + y=a*ya[klo]+b*ya[khi]+((a*a*a-a)*y2a[klo] + +(b*b*b-b)*y2a[khi])*(h*h)/6.0; +} diff --git a/lib/nr/cpp/recipes/spread.cpp b/lib/nr/cpp/recipes/spread.cpp new file mode 100644 index 0000000..2efc3d3 --- /dev/null +++ b/lib/nr/cpp/recipes/spread.cpp @@ -0,0 +1,25 @@ +#include "nr.h" + +void NR::spread(const DP y, Vec_IO_DP &yy, const DP x, const int m) +{ + static int nfac[11]={0,1,1,2,6,24,120,720,5040,40320,362880}; + int ihi,ilo,ix,j,nden; + DP fac; + + int n=yy.size(); + if (m > 10) nrerror("factorial table too small in spread"); + ix=int(x); + if (x == DP(ix)) yy[ix-1] += y; + else { + ilo=MIN(MAX(int(x-0.5*m),0),int(n-m)); + ihi=ilo+m; + nden=nfac[m]; + fac=x-ilo-1; + for (j=ilo+1;jilo;j--) { + nden=(nden/(j-ilo))*(j-ihi); + yy[j-1] += y*fac/(nden*(x-j)); + } + } +} diff --git a/lib/nr/cpp/recipes/sprsax.cpp b/lib/nr/cpp/recipes/sprsax.cpp new file mode 100644 index 0000000..65accea --- /dev/null +++ b/lib/nr/cpp/recipes/sprsax.cpp @@ -0,0 +1,16 @@ +#include "nr.h" + +void NR::sprsax(Vec_I_DP &sa, Vec_I_INT &ija, Vec_I_DP &x, Vec_O_DP &b) +{ + int i,k; + + int n=x.size(); + if (ija[0] != n+1) + nrerror("sprsax: mismatched vector and matrix"); + for (i=0;i +#include "nr.h" +using namespace std; + +void NR::sprsin(Mat_I_DP &a, const DP thresh, Vec_O_DP &sa, Vec_O_INT &ija) +{ + int i,j,k; + + int n=a.nrows(); + int nmax=sa.size(); + for (j=0;j= thresh && i != j) { + if (++k > nmax) nrerror("sprsin: sa and ija too small"); + sa[k]=a[i][j]; + ija[k]=j; + } + } + ija[i+1]=k+1; + } +} diff --git a/lib/nr/cpp/recipes/sprspm.cpp b/lib/nr/cpp/recipes/sprspm.cpp new file mode 100644 index 0000000..f92d17c --- /dev/null +++ b/lib/nr/cpp/recipes/sprspm.cpp @@ -0,0 +1,47 @@ +#include "nr.h" + +void NR::sprspm(Vec_I_DP &sa, Vec_I_INT &ija, Vec_I_DP &sb, Vec_I_INT &ijb, + Vec_O_DP &sc, Vec_I_INT &ijc) +{ + int i,ijma,ijmb,j,m,ma,mb,mbb,mn; + DP sum; + + if (ija[0] != ijb[0] || ija[0] != ijc[0]) + nrerror("sprspm: sizes do not match"); + for (i=0;i= ijc[i+1]) break; + j=ijc[(m= ++mn)-1]; + } + } +} diff --git a/lib/nr/cpp/recipes/sprstm.cpp b/lib/nr/cpp/recipes/sprstm.cpp new file mode 100644 index 0000000..be81f6a --- /dev/null +++ b/lib/nr/cpp/recipes/sprstm.cpp @@ -0,0 +1,50 @@ +#include +#include "nr.h" +using namespace std; + +void NR::sprstm(Vec_I_DP &sa, Vec_I_INT &ija, Vec_I_DP &sb, Vec_I_INT &ijb, + const DP thresh, Vec_O_DP &sc, Vec_O_INT &ijc) +{ + int i,ijma,ijmb,j,k,ma,mb,mbb; + DP sum; + + if (ija[0] != ijb[0]) nrerror("sprstm: sizes do not match"); + int nmax=sc.size(); + ijc[0]=k=ija[0]; + for (i=0;i thresh) { + if (k > nmax-1) nrerror("sprstm: sc and ijc too small"); + sc[k]=sum; + ijc[k++]=j; + } + } + ijc[i+1]=k; + } +} diff --git a/lib/nr/cpp/recipes/sprstp.cpp b/lib/nr/cpp/recipes/sprstp.cpp new file mode 100644 index 0000000..bfd8f63 --- /dev/null +++ b/lib/nr/cpp/recipes/sprstp.cpp @@ -0,0 +1,57 @@ +#include "nr.h" + +void NR::sprstp(Vec_I_DP &sa, Vec_I_INT &ija, Vec_O_DP &sb, Vec_O_INT &ijb) +{ + int j,jl,jm,jp,ju,k,m,n2,noff,inc,iv; + DP v; + + n2=ija[0]; + for (j=0;j 1) { + jm=(ju+jl)/2; + if (ija[jm] > m) ju=jm; else jl=jm; + } + ijb[k]=jl; + } + for (j=jp;j iv) { + ijb[m]=ijb[m-inc]; + sb[m]=sb[m-inc]; + m -= inc; + if (m-noff+1 <= inc) break; + } + ijb[m]=iv; + sb[m]=v; + } + } while (inc > 1); + } +} diff --git a/lib/nr/cpp/recipes/sprstx.cpp b/lib/nr/cpp/recipes/sprstx.cpp new file mode 100644 index 0000000..01d5a6b --- /dev/null +++ b/lib/nr/cpp/recipes/sprstx.cpp @@ -0,0 +1,17 @@ +#include "nr.h" + +void NR::sprstx(Vec_I_DP &sa, Vec_I_INT &ija, Vec_I_DP &x, Vec_O_DP &b) +{ + int i,j,k; + + int n=x.size(); + if (ija[0] != (n+1)) + nrerror("mismatched vector and matrix in sprstx"); + for (i=0;i +#include "nr.h" +using namespace std; + +Vec_DP *x_p; +Mat_DP *d_p; + +void NR::stifbs(Vec_IO_DP &y, Vec_IO_DP &dydx, DP &xx, const DP htry, + const DP eps, Vec_I_DP &yscal, DP &hdid, DP &hnext, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &)) +{ + const int KMAXX=7,IMAXX=KMAXX+1; + const DP SAFE1=0.25,SAFE2=0.7,REDMAX=1.0e-5,REDMIN=0.7; + const DP TINY=1.0e-30,SCALMX=0.1; + bool exitflag=false; + int i,iq,k,kk,km,reduct; + static int first=1,kmax,kopt,nvold = -1; + DP eps1,errmax,fact,h,red,scale,work,wrkmin,xest; + static DP epsold = -1.0,xnew; + static Vec_DP a(IMAXX); + static Mat_DP alf(KMAXX,KMAXX); + static int nseq_d[IMAXX]={2,6,10,14,22,34,50,70}; + Vec_INT nseq(nseq_d,IMAXX); + + int nv=y.size(); + d_p=new Mat_DP(nv,KMAXX); + x_p=new Vec_DP(KMAXX); + Vec_DP dfdx(nv),err(KMAXX),yerr(nv),ysav(nv),yseq(nv); + Mat_DP dfdy(nv,nv); + if (eps != epsold || nv != nvold) { + hnext = xnew = -1.0e29; + eps1=SAFE1*eps; + a[0]=nseq[0]+1; + for (k=0;k a[kopt]*alf[kopt-1][kopt]) break; + kmax=kopt; + } + h=htry; + for (i=0;i= kopt-1 || first)) { + if (errmax < 1.0) { + exitflag=true; + break; + } + if (k == kmax || k == kopt+1) { + red=SAFE2/err[km]; + break; + } + else if (k == kopt && alf[kopt-1][kopt] < err[km]) { + red=1.0/err[km]; + break; + } + else if (kopt == kmax && alf[km][kmax-1] < err[km]) { + red=alf[km][kmax-1]*SAFE2/err[km]; + break; + } + else if (alf[km][kopt] < err[km]) { + red=alf[km][kopt-1]/err[km]; + break; + } + } + } + if (exitflag) break; + red=MIN(red,REDMIN); + red=MAX(red,REDMAX); + h *= red; + reduct=1; + } + xx=xnew; + hdid=h; + first=0; + wrkmin=1.0e35; + for (kk=0;kk<=km;kk++) { + fact=MAX(err[kk],SCALMX); + work=fact*a[kk+1]; + if (work < wrkmin) { + scale=fact; + wrkmin=work; + kopt=kk+1; + } + } + hnext=h/scale; + if (kopt >= k && kopt != kmax && !reduct) { + fact=MAX(scale/alf[kopt-1][kopt],SCALMX); + if (a[kopt+1]*fact <= wrkmin) { + hnext=h/fact; + kopt++; + } + } + delete d_p; + delete x_p; +} diff --git a/lib/nr/cpp/recipes/stiff.cpp b/lib/nr/cpp/recipes/stiff.cpp new file mode 100644 index 0000000..205c50f --- /dev/null +++ b/lib/nr/cpp/recipes/stiff.cpp @@ -0,0 +1,77 @@ +#include +#include "nr.h" +using namespace std; + +void NR::stiff(Vec_IO_DP &y, Vec_IO_DP &dydx, DP &x, const DP htry, + const DP eps, Vec_I_DP &yscal, DP &hdid, DP &hnext, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &)) +{ + const DP SAFETY=0.9,GROW=1.5,PGROW= -0.25,SHRNK=0.5; + const DP PSHRNK=(-1.0/3.0),ERRCON=0.1296; + const int MAXTRY=40; + const DP GAM=1.0/2.0,A21=2.0,A31=48.0/25.0,A32=6.0/25.0,C21= -8.0, + C31=372.0/25.0,C32=12.0/5.0,C41=(-112.0/125.0), + C42=(-54.0/125.0),C43=(-2.0/5.0),B1=19.0/9.0,B2=1.0/2.0, + B3=25.0/108.0,B4=125.0/108.0,E1=17.0/54.0,E2=7.0/36.0,E3=0.0, + E4=125.0/108.0,C1X=1.0/2.0,C2X=(-3.0/2.0),C3X=(121.0/50.0), + C4X=(29.0/250.0),A2X=1.0,A3X=3.0/5.0; + int i,j,jtry; + DP d,errmax,h,xsav; + + int n=y.size(); + Mat_DP a(n,n),dfdy(n,n); + Vec_INT indx(n); + Vec_DP dfdx(n),dysav(n),err(n),ysav(n),g1(n),g2(n),g3(n),g4(n); + xsav=x; + for (i=0;i ERRCON ? SAFETY*h*pow(errmax,PGROW) : GROW*h); + return; + } else { + hnext=SAFETY*h*pow(errmax,PSHRNK); + h=(h >= 0.0 ? MAX(hnext,SHRNK*h) : MIN(hnext,SHRNK*h)); + } + } + nrerror("exceeded MAXTRY in stiff"); +} diff --git a/lib/nr/cpp/recipes/stoerm.cpp b/lib/nr/cpp/recipes/stoerm.cpp new file mode 100644 index 0000000..2ec84fe --- /dev/null +++ b/lib/nr/cpp/recipes/stoerm.cpp @@ -0,0 +1,33 @@ +#include "nr.h" + +void NR::stoerm(Vec_I_DP &y, Vec_I_DP &d2y, const DP xs, + const DP htot, const int nstep, Vec_O_DP &yout, + void derivs(const DP, Vec_I_DP &, Vec_O_DP &)) +{ + int i,nn,n,neqns; + DP h,h2,halfh,x; + + int nv=y.size(); + Vec_DP ytemp(nv); + h=htot/nstep; + halfh=0.5*h; + neqns=nv/2; + for (i=0;i +#include "nr.h" +using namespace std; + +void NR::svdcmp(Mat_IO_DP &a, Vec_O_DP &w, Mat_O_DP &v) +{ + bool flag; + int i,its,j,jj,k,l,nm; + DP anorm,c,f,g,h,s,scale,x,y,z; + + int m=a.nrows(); + int n=a.ncols(); + Vec_DP rv1(n); + g=scale=anorm=0.0; + for (i=0;i=0;i--) { + if (i < n-1) { + if (g != 0.0) { + for (j=l;j=0;i--) { + l=i+1; + g=w[i]; + for (j=l;j=0;k--) { + for (its=0;its<30;its++) { + flag=true; + for (l=k;l>=0;l--) { + nm=l-1; + if (fabs(rv1[l])+anorm == anorm) { + flag=false; + break; + } + if (fabs(w[nm])+anorm == anorm) break; + } + if (flag) { + c=0.0; + s=1.0; + for (i=l-1;i wmax) wmax=w[j]; + thresh=TOL*wmax; + for (j=0;j> 1; + pp=g[m1]; + qq=h[m1]; + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::tptest(Vec_I_DP &data1, Vec_I_DP &data2, DP &t, DP &prob) +{ + int j; + DP var1,var2,ave1,ave2,sd,df,cov=0.0; + + int n=data1.size(); + avevar(data1,ave1,var1); + avevar(data2,ave2,var2); + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::tqli(Vec_IO_DP &d, Vec_IO_DP &e, Mat_IO_DP &z) +{ + int m,l,iter,i,k; + DP s,r,p,g,f,dd,c,b; + + int n=d.size(); + for (i=1;i=l;i--) { + f=s*e[i]; + b=c*e[i]; + e[i+1]=(r=pythag(f,g)); + if (r == 0.0) { + d[i+1] -= p; + e[m]=0.0; + break; + } + s=f/r; + c=g/r; + g=d[i+1]-p; + r=(d[i]-g)*s+2.0*c*b; + d[i+1]=g+(p=s*r); + g=c*r-b; + // Next loop can be omitted if eigenvectors not wanted + for (k=0;k= l) continue; + d[l] -= p; + e[l]=g; + e[m]=0.0; + } + } while (m != l); + } +} diff --git a/lib/nr/cpp/recipes/trapzd.cpp b/lib/nr/cpp/recipes/trapzd.cpp new file mode 100644 index 0000000..f20577d --- /dev/null +++ b/lib/nr/cpp/recipes/trapzd.cpp @@ -0,0 +1,20 @@ +#include "nr.h" + +DP NR::trapzd(DP func(const DP), const DP a, const DP b, const int n) +{ + DP x,tnm,sum,del; + static DP s; + int it,j; + + if (n == 1) { + return (s=0.5*(b-a)*(func(a)+func(b))); + } else { + for (it=1,j=1;j +#include "nr.h" +using namespace std; + +void NR::tred2(Mat_IO_DP &a, Vec_O_DP &d, Vec_O_DP &e) +{ + int l,k,j,i; + DP scale,hh,h,g,f; + + int n=d.size(); + for (i=n-1;i>0;i--) { + l=i-1; + h=scale=0.0; + if (l > 0) { + for (k=0;k= 0.0 ? -sqrt(h) : sqrt(h)); + e[i]=scale*g; + h -= f*g; + a[i][l]=f-g; + f=0.0; + for (j=0;j=0;j--) + u[j] -= gam[j+1]*u[j+1]; +} diff --git a/lib/nr/cpp/recipes/trncst.cpp b/lib/nr/cpp/recipes/trncst.cpp new file mode 100644 index 0000000..ac5458a --- /dev/null +++ b/lib/nr/cpp/recipes/trncst.cpp @@ -0,0 +1,34 @@ +#include +#include "nr.h" +using namespace std; + +namespace { + inline DP alen(const DP a, const DP b, const DP c, const DP d) + { + return sqrt((b-a)*(b-a)+(d-c)*(d-c)); + } +} + +DP NR::trncst(Vec_I_DP &x, Vec_I_DP &y, Vec_I_INT &iorder, Vec_IO_INT &n) +{ + int j,ii; + DP de; + Vec_DP xx(6),yy(6); + + int ncity=x.size(); + n[3]=(n[2]+1) % ncity; + n[4]=(n[0]+ncity-1) % ncity; + n[5]=(n[1]+1) % ncity; + for (j=0;j<6;j++) { + ii=iorder[n[j]]; + xx[j]=x[ii]; + yy[j]=y[ii]; + } + de = -alen(xx[1],xx[5],yy[1],yy[5]); + de -= alen(xx[0],xx[4],yy[0],yy[4]); + de -= alen(xx[2],xx[3],yy[2],yy[3]); + de += alen(xx[0],xx[2],yy[0],yy[2]); + de += alen(xx[1],xx[3],yy[1],yy[3]); + de += alen(xx[4],xx[5],yy[4],yy[5]); + return de; +} diff --git a/lib/nr/cpp/recipes/trnspt.cpp b/lib/nr/cpp/recipes/trnspt.cpp new file mode 100644 index 0000000..734f287 --- /dev/null +++ b/lib/nr/cpp/recipes/trnspt.cpp @@ -0,0 +1,27 @@ +#include "nr.h" + +void NR::trnspt(Vec_IO_INT &iorder, Vec_I_INT &n) +{ + int m1,m2,m3,nn,j,jj; + + int ncity=iorder.size(); + Vec_INT jorder(ncity); + m1=(n[1]-n[0]+ncity) % ncity; + m2=(n[4]-n[3]+ncity) % ncity; + m3=(n[2]-n[5]+ncity) % ncity; + nn=0; + for (j=0;j<=m1;j++) { + jj=(j+n[0]) % ncity; + jorder[nn++]=iorder[jj]; + } + for (j=0;j<=m2;j++) { + jj=(j+n[3]) % ncity; + jorder[nn++]=iorder[jj]; + } + for (j=0;j<=m3;j++) { + jj=(j+n[5]) % ncity; + jorder[nn++]=iorder[jj]; + } + for (j=0;j +#include "nr.h" +using namespace std; + +void NR::ttest(Vec_I_DP &data1, Vec_I_DP &data2, DP &t, DP &prob) +{ + DP var1,var2,svar,df,ave1,ave2; + + int n1=data1.size(); + int n2=data2.size(); + avevar(data1,ave1,var1); + avevar(data2,ave2,var2); + df=n1+n2-2; + svar=((n1-1)*var1+(n2-1)*var2)/df; + t=(ave1-ave2)/sqrt(svar*(1.0/n1+1.0/n2)); + prob=betai(0.5*df,0.5,df/(df+t*t)); +} diff --git a/lib/nr/cpp/recipes/tutest.cpp b/lib/nr/cpp/recipes/tutest.cpp new file mode 100644 index 0000000..597d4ce --- /dev/null +++ b/lib/nr/cpp/recipes/tutest.cpp @@ -0,0 +1,16 @@ +#include +#include "nr.h" +using namespace std; + +void NR::tutest(Vec_I_DP &data1, Vec_I_DP &data2, DP &t, DP &prob) +{ + DP var1,var2,df,ave1,ave2; + + int n1=data1.size(); + int n2=data2.size(); + avevar(data1,ave1,var1); + avevar(data2,ave2,var2); + t=(ave1-ave2)/sqrt(var1/n1+var2/n2); + df=SQR(var1/n1+var2/n2)/(SQR(var1/n1)/(n1-1)+SQR(var2/n2)/(n2-1)); + prob=betai(0.5*df,0.5,df/(df+SQR(t))); +} diff --git a/lib/nr/cpp/recipes/twofft.cpp b/lib/nr/cpp/recipes/twofft.cpp new file mode 100644 index 0000000..95e77b3 --- /dev/null +++ b/lib/nr/cpp/recipes/twofft.cpp @@ -0,0 +1,32 @@ +#include "nr.h" + +void NR::twofft(Vec_I_DP &data1, Vec_I_DP &data2, Vec_O_DP &fft1, + Vec_O_DP &fft2) +{ + int nn3,nn2,jj,j; + DP rep,rem,aip,aim; + + int n=data1.size(); + nn3=1+(nn2=n+n); + for (j=0,jj=0;j0;k--) { + b=c[k]+xx*b; + s += q[k-1]*b; + t=xx*t+b; + } + w[i]=s/t; + } + } +} diff --git a/lib/nr/cpp/recipes/vegas.cpp b/lib/nr/cpp/recipes/vegas.cpp new file mode 100644 index 0000000..9632056 --- /dev/null +++ b/lib/nr/cpp/recipes/vegas.cpp @@ -0,0 +1,181 @@ +#include +#include +#include +#include "nr.h" +using namespace std; + +extern int idum; + +void NR::vegas(Vec_I_DP ®n, DP fxn(Vec_I_DP &, const DP), const int init, + const int ncall, const int itmx, const int nprn, DP &tgral, DP &sd, + DP &chi2a) +{ + const int NDMX=50, MXDIM=10; + const DP ALPH=1.5, TINY=1.0e-30; + static int i,it,j,k,mds,nd,ndo,ng,npg; + static DP calls,dv2g,dxg,f,f2,f2b,fb,rc,ti; + static DP tsi,wgt,xjac,xn,xnd,xo,schi,si,swgt; + static Vec_INT ia(MXDIM),kg(MXDIM); + static Vec_DP dt(MXDIM),dx(MXDIM),r(NDMX),x(MXDIM),xin(NDMX); + static Mat_DP d(NDMX,MXDIM),di(NDMX,MXDIM),xi(MXDIM,NDMX); + + int ndim=regn.size()/2; + if (init <= 0) { + mds=ndo=1; + for (j=0;j= 0) { + mds = -1; + npg=ng/NDMX+1; + nd=ng/npg; + ng=npg*nd; + } + } + for (k=1,i=0;i= 0) { + cout << " Input parameters for vegas"; + cout << " ndim= " << setw(4) << ndim; + cout << " ncall= " << setw(8) << calls << endl; + cout << setw(34) << " it=" << setw(5) << it; + cout << " itmx=" << setw(5) << itmx << endl; + cout << setw(34) << " nprn=" << setw(5) << nprn; + cout << " ALPH=" << setw(9) << ALPH << endl; + cout << setw(34) << " mds=" << setw(5) << mds; + cout << " nd=" << setw(5) << nd << endl; + for (j=0;j= 0) { + for (nn=n;nn>=4;nn>>=1) wtstep(a,nn,isign); + } else { + for (nn=4;nn<=n;nn<<=1) wtstep(a,nn,isign); + } +} diff --git a/lib/nr/cpp/recipes/wtn.cpp b/lib/nr/cpp/recipes/wtn.cpp new file mode 100644 index 0000000..8b04b01 --- /dev/null +++ b/lib/nr/cpp/recipes/wtn.cpp @@ -0,0 +1,31 @@ +#include "nr.h" + +void NR::wtn(Vec_IO_DP &a, Vec_I_INT &nn, const int isign, + void wtstep(Vec_IO_DP &, const int, const int)) +{ + int idim,i1,i2,i3,k,n,nnew,nprev=1,nt,ntot=1; + + int ndim=nn.size(); + for (idim=0;idim 4) { + for (i2=0;i2= 0) { + for(nt=n;nt>=4;nt >>= 1) + wtstep(wksp,nt,isign); + } else { + for(nt=4;nt<=n;nt <<= 1) + wtstep(wksp,nt,isign); + } + for (i3=i1+i2,k=0;k= 4) { + Vec_DP wold(4),wnew(4),w(4); + kermom(wold,0.0); + b=0.0; + for (j=0;j +#include "nr.h" +using namespace std; + +bool NR::zbrac(DP func(const DP), DP &x1, DP &x2) +{ + const int NTRY=50; + const DP FACTOR=1.6; + int j; + DP f1,f2; + + if (x1 == x2) nrerror("Bad initial range in zbrac"); + f1=func(x1); + f2=func(x2); + for (j=0;j +#include +#include "nr.h" +using namespace std; + +DP NR::zbrent(DP func(const DP), const DP x1, const DP x2, const DP tol) +{ + const int ITMAX=100; + const DP EPS=numeric_limits::epsilon(); + int iter; + DP a=x1,b=x2,c=x2,d,e,min1,min2; + DP fa=func(a),fb=func(b),fc,p,q,r,s,tol1,xm; + + if ((fa > 0.0 && fb > 0.0) || (fa < 0.0 && fb < 0.0)) + nrerror("Root must be bracketed in zbrent"); + fc=fb; + for (iter=0;iter 0.0 && fc > 0.0) || (fb < 0.0 && fc < 0.0)) { + c=a; + fc=fa; + e=d=b-a; + } + if (fabs(fc) < fabs(fb)) { + a=b; + b=c; + c=a; + fa=fb; + fb=fc; + fc=fa; + } + tol1=2.0*EPS*fabs(b)+0.5*tol; + xm=0.5*(c-b); + if (fabs(xm) <= tol1 || fb == 0.0) return b; + if (fabs(e) >= tol1 && fabs(fa) > fabs(fb)) { + s=fb/fa; + if (a == c) { + p=2.0*xm*s; + q=1.0-s; + } else { + q=fa/fc; + r=fb/fc; + p=s*(2.0*xm*q*(q-r)-(b-a)*(r-1.0)); + q=(q-1.0)*(r-1.0)*(s-1.0); + } + if (p > 0.0) q = -q; + p=fabs(p); + min1=3.0*xm*q-fabs(tol1*q); + min2=fabs(e*q); + if (2.0*p < (min1 < min2 ? min1 : min2)) { + e=d; + d=p/q; + } else { + d=xm; + e=d; + } + } else { + d=xm; + e=d; + } + a=b; + fa=fb; + if (fabs(d) > tol1) + b += d; + else + b += SIGN(tol1,xm); + fb=func(b); + } + nrerror("Maximum number of iterations exceeded in zbrent"); + return 0.0; +} diff --git a/lib/nr/cpp/recipes/zrhqr.cpp b/lib/nr/cpp/recipes/zrhqr.cpp new file mode 100644 index 0000000..8b91a9d --- /dev/null +++ b/lib/nr/cpp/recipes/zrhqr.cpp @@ -0,0 +1,27 @@ +#include +#include "nr.h" +using namespace std; + +void NR::zrhqr(Vec_I_DP &a, Vec_O_CPLX_DP &rt) +{ + int j,k; + complex x; + + int m=a.size()-1; + Mat_DP hess(m,m); + for (k=0;k=0;k--) { + if (real(rt[k]) <= real(x)) break; + rt[k+1]=rt[k]; + } + rt[k+1]=x; + } +} diff --git a/lib/nr/cpp/recipes/zriddr.cpp b/lib/nr/cpp/recipes/zriddr.cpp new file mode 100644 index 0000000..887f0b7 --- /dev/null +++ b/lib/nr/cpp/recipes/zriddr.cpp @@ -0,0 +1,50 @@ +#include +#include "nr.h" +using namespace std; + +DP NR::zriddr(DP func(const DP), const DP x1, const DP x2, const DP xacc) +{ + const int MAXIT=60; + const DP UNUSED=-1.11e30; + int j; + DP ans,fh,fl,fm,fnew,s,xh,xl,xm,xnew; + + fl=func(x1); + fh=func(x2); + if ((fl > 0.0 && fh < 0.0) || (fl < 0.0 && fh > 0.0)) { + xl=x1; + xh=x2; + ans=UNUSED; + for (j=0;j= fh ? 1.0 : -1.0)*fm/s); + if (fabs(xnew-ans) <= xacc) return ans; + ans=xnew; + fnew=func(ans); + if (fnew == 0.0) return ans; + if (SIGN(fm,fnew) != fm) { + xl=xm; + fl=fm; + xh=ans; + fh=fnew; + } else if (SIGN(fl,fnew) != fl) { + xh=ans; + fh=fnew; + } else if (SIGN(fh,fnew) != fh) { + xl=ans; + fl=fnew; + } else nrerror("never get here."); + if (fabs(xh-xl) <= xacc) return ans; + } + nrerror("zriddr exceed maximum iterations"); + } + else { + if (fl == 0.0) return x1; + if (fh == 0.0) return x2; + nrerror("root must be bracketed in zriddr."); + } + return 0.0; +} diff --git a/lib/nr/cpp/recipes/zroots.cpp b/lib/nr/cpp/recipes/zroots.cpp new file mode 100644 index 0000000..c5f736b --- /dev/null +++ b/lib/nr/cpp/recipes/zroots.cpp @@ -0,0 +1,41 @@ +#include +#include +#include "nr.h" +using namespace std; + +void NR::zroots(Vec_I_CPLX_DP &a, Vec_O_CPLX_DP &roots, const bool &polish) +{ + const DP EPS=1.0e-14; + int i,its,j,jj; + complex x,b,c; + + int m=a.size()-1; + Vec_CPLX_DP ad(m+1); + for (j=0;j<=m;j++) ad[j]=a[j]; + for (j=m-1;j>=0;j--) { + x=0.0; + Vec_CPLX_DP ad_v(j+2); + for (jj=0;jj(real(x),0.0); + roots[j]=x; + b=ad[j+1]; + for (jj=j;jj>=0;jj--) { + c=ad[jj]; + ad[jj]=b; + b=x*b+c; + } + } + if (polish) + for (j=0;j=0;i--) { + if (real(roots[i]) <= real(x)) break; + roots[i+1]=roots[i]; + } + roots[i+1]=x; + } +} diff --git a/lib/nr/k_and_r/other/bccbug.c b/lib/nr/k_and_r/other/bccbug.c new file mode 100644 index 0000000..e3cb559 --- /dev/null +++ b/lib/nr/k_and_r/other/bccbug.c @@ -0,0 +1,10 @@ +/* The following function is recommended by Borland Technical Support to + "fix" the error "Floating Point Formats Not Linked". To use this file, + compile it along with your own files on the compiler command line. You + do not need to call it, just compile it along with your files. */ + +void LinkFloat(void) +{ + float a=0, *b=&a; + a=*b; +} diff --git a/lib/nr/k_and_r/other/complex.c b/lib/nr/k_and_r/other/complex.c new file mode 100644 index 0000000..05cd117 --- /dev/null +++ b/lib/nr/k_and_r/other/complex.c @@ -0,0 +1,250 @@ +#include + +typedef struct FCOMPLEX {float r,i;} fcomplex; + +#if defined(__STDC__) || defined(ANSI) || defined(NRANSI) /* ANSI */ + +fcomplex Cadd(fcomplex a, fcomplex b) +{ + fcomplex c; + c.r=a.r+b.r; + c.i=a.i+b.i; + return c; +} + +fcomplex Csub(fcomplex a, fcomplex b) +{ + fcomplex c; + c.r=a.r-b.r; + c.i=a.i-b.i; + return c; +} + + +fcomplex Cmul(fcomplex a, fcomplex b) +{ + fcomplex c; + c.r=a.r*b.r-a.i*b.i; + c.i=a.i*b.r+a.r*b.i; + return c; +} + +fcomplex Complex(float re, float im) +{ + fcomplex c; + c.r=re; + c.i=im; + return c; +} + +fcomplex Conjg(fcomplex z) +{ + fcomplex c; + c.r=z.r; + c.i = -z.i; + return c; +} + +fcomplex Cdiv(fcomplex a, fcomplex b) +{ + fcomplex c; + float r,den; + if (fabs(b.r) >= fabs(b.i)) { + r=b.i/b.r; + den=b.r+r*b.i; + c.r=(a.r+r*a.i)/den; + c.i=(a.i-r*a.r)/den; + } else { + r=b.r/b.i; + den=b.i+r*b.r; + c.r=(a.r*r+a.i)/den; + c.i=(a.i*r-a.r)/den; + } + return c; +} + +float Cabs(fcomplex z) +{ + float x,y,ans,temp; + x=fabs(z.r); + y=fabs(z.i); + if (x == 0.0) + ans=y; + else if (y == 0.0) + ans=x; + else if (x > y) { + temp=y/x; + ans=x*sqrt(1.0+temp*temp); + } else { + temp=x/y; + ans=y*sqrt(1.0+temp*temp); + } + return ans; +} + +fcomplex Csqrt(fcomplex z) +{ + fcomplex c; + float x,y,w,r; + if ((z.r == 0.0) && (z.i == 0.0)) { + c.r=0.0; + c.i=0.0; + return c; + } else { + x=fabs(z.r); + y=fabs(z.i); + if (x >= y) { + r=y/x; + w=sqrt(x)*sqrt(0.5*(1.0+sqrt(1.0+r*r))); + } else { + r=x/y; + w=sqrt(y)*sqrt(0.5*(r+sqrt(1.0+r*r))); + } + if (z.r >= 0.0) { + c.r=w; + c.i=z.i/(2.0*w); + } else { + c.i=(z.i >= 0) ? w : -w; + c.r=z.i/(2.0*c.i); + } + return c; + } +} + +fcomplex RCmul(float x, fcomplex a) +{ + fcomplex c; + c.r=x*a.r; + c.i=x*a.i; + return c; +} + +#else /* ANSI */ +/* traditional - K&R */ + +fcomplex Cadd(a,b) +fcomplex a,b; +{ + fcomplex c; + c.r=a.r+b.r; + c.i=a.i+b.i; + return c; +} + +fcomplex Csub(a,b) +fcomplex a,b; +{ + fcomplex c; + c.r=a.r-b.r; + c.i=a.i-b.i; + return c; +} + + +fcomplex Cmul(a,b) +fcomplex a,b; +{ + fcomplex c; + c.r=a.r*b.r-a.i*b.i; + c.i=a.i*b.r+a.r*b.i; + return c; +} + +fcomplex Complex(re,im) +float im,re; +{ + fcomplex c; + c.r=re; + c.i=im; + return c; +} + +fcomplex Conjg(z) +fcomplex z; +{ + fcomplex c; + c.r=z.r; + c.i = -z.i; + return c; +} + +fcomplex Cdiv(a,b) +fcomplex a,b; +{ + fcomplex c; + float r,den; + if (fabs(b.r) >= fabs(b.i)) { + r=b.i/b.r; + den=b.r+r*b.i; + c.r=(a.r+r*a.i)/den; + c.i=(a.i-r*a.r)/den; + } else { + r=b.r/b.i; + den=b.i+r*b.r; + c.r=(a.r*r+a.i)/den; + c.i=(a.i*r-a.r)/den; + } + return c; +} + +float Cabs(z) +fcomplex z; +{ + float x,y,ans,temp; + x=fabs(z.r); + y=fabs(z.i); + if (x == 0.0) + ans=y; + else if (y == 0.0) + ans=x; + else if (x > y) { + temp=y/x; + ans=x*sqrt(1.0+temp*temp); + } else { + temp=x/y; + ans=y*sqrt(1.0+temp*temp); + } + return ans; +} + +fcomplex Csqrt(z) +fcomplex z; +{ + fcomplex c; + float x,y,w,r; + if ((z.r == 0.0) && (z.i == 0.0)) { + c.r=0.0; + c.i=0.0; + return c; + } else { + x=fabs(z.r); + y=fabs(z.i); + if (x >= y) { + r=y/x; + w=sqrt(x)*sqrt(0.5*(1.0+sqrt(1.0+r*r))); + } else { + r=x/y; + w=sqrt(y)*sqrt(0.5*(r+sqrt(1.0+r*r))); + } + if (z.r >= 0.0) { + c.r=w; + c.i=z.i/(2.0*w); + } else { + c.i=(z.i >= 0) ? w : -w; + c.r=z.i/(2.0*c.i); + } + return c; + } +} + +fcomplex RCmul(x,a) +fcomplex a; +float x; +{ + fcomplex c; + c.r=x*a.r; + c.i=x*a.i; + return c; +} + +#endif /* ANSI */ diff --git a/lib/nr/k_and_r/other/nrutil.c b/lib/nr/k_and_r/other/nrutil.c new file mode 100644 index 0000000..6d9e217 --- /dev/null +++ b/lib/nr/k_and_r/other/nrutil.c @@ -0,0 +1,614 @@ +#if defined(__STDC__) || defined(ANSI) || defined(NRANSI) /* ANSI */ + +#include +#include +#include +#define NR_END 1 +#define FREE_ARG char* + +void nrerror(char error_text[]) +/* Numerical Recipes standard error handler */ +{ + fprintf(stderr,"Numerical Recipes run-time error...\n"); + fprintf(stderr,"%s\n",error_text); + fprintf(stderr,"...now exiting to system...\n"); + exit(1); +} + +float *vector(long nl, long nh) +/* allocate a float vector with subscript range v[nl..nh] */ +{ + float *v; + + v=(float *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(float))); + if (!v) nrerror("allocation failure in vector()"); + return v-nl+NR_END; +} + +int *ivector(long nl, long nh) +/* allocate an int vector with subscript range v[nl..nh] */ +{ + int *v; + + v=(int *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(int))); + if (!v) nrerror("allocation failure in ivector()"); + return v-nl+NR_END; +} + +unsigned char *cvector(long nl, long nh) +/* allocate an unsigned char vector with subscript range v[nl..nh] */ +{ + unsigned char *v; + + v=(unsigned char *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(unsigned char))); + if (!v) nrerror("allocation failure in cvector()"); + return v-nl+NR_END; +} + +unsigned long *lvector(long nl, long nh) +/* allocate an unsigned long vector with subscript range v[nl..nh] */ +{ + unsigned long *v; + + v=(unsigned long *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(long))); + if (!v) nrerror("allocation failure in lvector()"); + return v-nl+NR_END; +} + +double *dvector(long nl, long nh) +/* allocate a double vector with subscript range v[nl..nh] */ +{ + double *v; + + v=(double *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(double))); + if (!v) nrerror("allocation failure in dvector()"); + return v-nl+NR_END; +} + +float **matrix(long nrl, long nrh, long ncl, long nch) +/* allocate a float matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + float **m; + + /* allocate pointers to rows */ + m=(float **) malloc((size_t)((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + /* allocate rows and set pointers to them */ + m[nrl]=(float *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(float))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +double **dmatrix(long nrl, long nrh, long ncl, long nch) +/* allocate a double matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + double **m; + + /* allocate pointers to rows */ + m=(double **) malloc((size_t)((nrow+NR_END)*sizeof(double*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + /* allocate rows and set pointers to them */ + m[nrl]=(double *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(double))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +int **imatrix(long nrl, long nrh, long ncl, long nch) +/* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + int **m; + + /* allocate pointers to rows */ + m=(int **) malloc((size_t)((nrow+NR_END)*sizeof(int*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + + /* allocate rows and set pointers to them */ + m[nrl]=(int *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(int))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +float **submatrix(float **a, long oldrl, long oldrh, long oldcl, long oldch, + long newrl, long newcl) +/* point a submatrix [newrl..][newcl..] to a[oldrl..oldrh][oldcl..oldch] */ +{ + long i,j,nrow=oldrh-oldrl+1,ncol=oldcl-newcl; + float **m; + + /* allocate array of pointers to rows */ + m=(float **) malloc((size_t) ((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure in submatrix()"); + m += NR_END; + m -= newrl; + + /* set pointers to rows */ + for(i=oldrl,j=newrl;i<=oldrh;i++,j++) m[j]=a[i]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +float **convert_matrix(float *a, long nrl, long nrh, long ncl, long nch) +/* allocate a float matrix m[nrl..nrh][ncl..nch] that points to the matrix +declared in the standard C manner as a[nrow][ncol], where nrow=nrh-nrl+1 +and ncol=nch-ncl+1. The routine should be called with the address +&a[0][0] as the first argument. */ +{ + long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1; + float **m; + + /* allocate pointers to rows */ + m=(float **) malloc((size_t) ((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure in convert_matrix()"); + m += NR_END; + m -= nrl; + + /* set pointers to rows */ + m[nrl]=a-ncl; + for(i=1,j=nrl+1;i +#define NR_END 1 +#define FREE_ARG char* + +void nrerror(error_text) +char error_text[]; +/* Numerical Recipes standard error handler */ +{ + void exit(); + + fprintf(stderr,"Numerical Recipes run-time error...\n"); + fprintf(stderr,"%s\n",error_text); + fprintf(stderr,"...now exiting to system...\n"); + exit(1); +} + +float *vector(nl,nh) +long nh,nl; +/* allocate a float vector with subscript range v[nl..nh] */ +{ + float *v; + + v=(float *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(float))); + if (!v) nrerror("allocation failure in vector()"); + return v-nl+NR_END; +} + +int *ivector(nl,nh) +long nh,nl; +/* allocate an int vector with subscript range v[nl..nh] */ +{ + int *v; + + v=(int *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(int))); + if (!v) nrerror("allocation failure in ivector()"); + return v-nl+NR_END; +} + +unsigned char *cvector(nl,nh) +long nh,nl; +/* allocate an unsigned char vector with subscript range v[nl..nh] */ +{ + unsigned char *v; + + v=(unsigned char *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(unsigned char))); + if (!v) nrerror("allocation failure in cvector()"); + return v-nl+NR_END; +} + +unsigned long *lvector(nl,nh) +long nh,nl; +/* allocate an unsigned long vector with subscript range v[nl..nh] */ +{ + unsigned long *v; + + v=(unsigned long *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(long))); + if (!v) nrerror("allocation failure in lvector()"); + return v-nl+NR_END; +} + +double *dvector(nl,nh) +long nh,nl; +/* allocate a double vector with subscript range v[nl..nh] */ +{ + double *v; + + v=(double *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(double))); + if (!v) nrerror("allocation failure in dvector()"); + return v-nl+NR_END; +} + +float **matrix(nrl,nrh,ncl,nch) +long nch,ncl,nrh,nrl; +/* allocate a float matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + float **m; + + /* allocate pointers to rows */ + m=(float **) malloc((unsigned int)((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + /* allocate rows and set pointers to them */ + m[nrl]=(float *) malloc((unsigned int)((nrow*ncol+NR_END)*sizeof(float))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +double **dmatrix(nrl,nrh,ncl,nch) +long nch,ncl,nrh,nrl; +/* allocate a double matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + double **m; + + /* allocate pointers to rows */ + m=(double **) malloc((unsigned int)((nrow+NR_END)*sizeof(double*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + /* allocate rows and set pointers to them */ + m[nrl]=(double *) malloc((unsigned int)((nrow*ncol+NR_END)*sizeof(double))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +int **imatrix(nrl,nrh,ncl,nch) +long nch,ncl,nrh,nrl; +/* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + int **m; + + /* allocate pointers to rows */ + m=(int **) malloc((unsigned int)((nrow+NR_END)*sizeof(int*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + + /* allocate rows and set pointers to them */ + m[nrl]=(int *) malloc((unsigned int)((nrow*ncol+NR_END)*sizeof(int))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +float **submatrix(a,oldrl,oldrh,oldcl,oldch,newrl,newcl) +float **a; +long newcl,newrl,oldch,oldcl,oldrh,oldrl; +/* point a submatrix [newrl..][newcl..] to a[oldrl..oldrh][oldcl..oldch] */ +{ + long i,j,nrow=oldrh-oldrl+1,ncol=oldcl-newcl; + float **m; + + /* allocate array of pointers to rows */ + m=(float **) malloc((unsigned int) ((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure in submatrix()"); + m += NR_END; + m -= newrl; + + /* set pointers to rows */ + for(i=oldrl,j=newrl;i<=oldrh;i++,j++) m[j]=a[i]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +float **convert_matrix(a,nrl,nrh,ncl,nch) +float *a; +long nch,ncl,nrh,nrl; +/* allocate a float matrix m[nrl..nrh][ncl..nch] that points to the matrix +declared in the standard C manner as a[nrow][ncol], where nrow=nrh-nrl+1 +and ncol=nch-ncl+1. The routine should be called with the address +&a[0][0] as the first argument. */ +{ + long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1; + float **m; + + /* allocate pointers to rows */ + m=(float **) malloc((unsigned int) ((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure in convert_matrix()"); + m += NR_END; + m -= nrl; + + /* set pointers to rows */ + m[nrl]=a-ncl; + for(i=1,j=nrl+1;i +#define PI 3.1415927 +#define THIRD (1.0/3.0) +#define TWOTHR (2.0*THIRD) +#define ONOVRT 0.57735027 + +void airy(x,ai,bi,aip,bip) +float *ai,*aip,*bi,*bip,x; +{ + void bessik(),bessjy(); + float absx,ri,rip,rj,rjp,rk,rkp,rootx,ry,ryp,z; + + absx=fabs(x); + rootx=sqrt(absx); + z=TWOTHR*absx*rootx; + if (x > 0.0) { + bessik(z,THIRD,&ri,&rk,&rip,&rkp); + *ai=rootx*ONOVRT*rk/PI; + *bi=rootx*(rk/PI+2.0*ONOVRT*ri); + bessik(z,TWOTHR,&ri,&rk,&rip,&rkp); + *aip = -x*ONOVRT*rk/PI; + *bip=x*(rk/PI+2.0*ONOVRT*ri); + } else if (x < 0.0) { + bessjy(z,THIRD,&rj,&ry,&rjp,&ryp); + *ai=0.5*rootx*(rj-ONOVRT*ry); + *bi = -0.5*rootx*(ry+ONOVRT*rj); + bessjy(z,TWOTHR,&rj,&ry,&rjp,&ryp); + *aip=0.5*absx*(ONOVRT*ry+rj); + *bip=0.5*absx*(ONOVRT*rj-ry); + } else { + *ai=0.35502805; + *bi=(*ai)/ONOVRT; + *aip = -0.25881940; + *bip = -(*aip)/ONOVRT; + } +} +#undef PI +#undef THIRD +#undef TWOTHR +#undef ONOVRT diff --git a/lib/nr/k_and_r/recipes/amebsa.c b/lib/nr/k_and_r/recipes/amebsa.c new file mode 100644 index 0000000..f0249d1 --- /dev/null +++ b/lib/nr/k_and_r/recipes/amebsa.c @@ -0,0 +1,84 @@ + +#include +#include "nrutil.h" +#define GET_PSUM \ + for (n=1;n<=ndim;n++) {\ + for (sum=0.0,m=1;m<=mpts;m++) sum += p[m][n];\ + psum[n]=sum;} +extern long idum; +float tt; + +void amebsa(p,y,ndim,pb,yb,ftol,funk,iter,temptr) +float (*funk)(),**p,*yb,ftol,pb[],temptr,y[]; +int *iter,ndim; +{ + float amotsa(),ran1(); + int i,ihi,ilo,j,m,n,mpts=ndim+1; + float rtol,sum,swap,yhi,ylo,ynhi,ysave,yt,ytry,*psum; + + psum=vector(1,ndim); + tt = -temptr; + GET_PSUM + for (;;) { + ilo=1; + ihi=2; + ynhi=ylo=y[1]+tt*log(ran1(&idum)); + yhi=y[2]+tt*log(ran1(&idum)); + if (ylo > yhi) { + ihi=1; + ilo=2; + ynhi=yhi; + yhi=ylo; + ylo=ynhi; + } + for (i=3;i<=mpts;i++) { + yt=y[i]+tt*log(ran1(&idum)); + if (yt <= ylo) { + ilo=i; + ylo=yt; + } + if (yt > yhi) { + ynhi=yhi; + ihi=i; + yhi=yt; + } else if (yt > ynhi) { + ynhi=yt; + } + } + rtol=2.0*fabs(yhi-ylo)/(fabs(yhi)+fabs(ylo)); + if (rtol < ftol || *iter < 0) { + swap=y[1]; + y[1]=y[ilo]; + y[ilo]=swap; + for (n=1;n<=ndim;n++) { + swap=p[1][n]; + p[1][n]=p[ilo][n]; + p[ilo][n]=swap; + } + break; + } + *iter -= 2; + ytry=amotsa(p,y,psum,ndim,pb,yb,funk,ihi,&yhi,-1.0); + if (ytry <= ylo) { + ytry=amotsa(p,y,psum,ndim,pb,yb,funk,ihi,&yhi,2.0); + } else if (ytry >= ynhi) { + ysave=yhi; + ytry=amotsa(p,y,psum,ndim,pb,yb,funk,ihi,&yhi,0.5); + if (ytry >= ysave) { + for (i=1;i<=mpts;i++) { + if (i != ilo) { + for (j=1;j<=ndim;j++) { + psum[j]=0.5*(p[i][j]+p[ilo][j]); + p[i][j]=psum[j]; + } + y[i]=(*funk)(psum); + } + } + *iter -= ndim; + GET_PSUM + } + } else ++(*iter); + } + free_vector(psum,1,ndim); +} +#undef GET_PSUM diff --git a/lib/nr/k_and_r/recipes/amoeba.c b/lib/nr/k_and_r/recipes/amoeba.c new file mode 100644 index 0000000..86f609b --- /dev/null +++ b/lib/nr/k_and_r/recipes/amoeba.c @@ -0,0 +1,64 @@ + +#include +#include "nrutil.h" +#define TINY 1.0e-10 +#define NMAX 5000 +#define GET_PSUM \ + for (j=1;j<=ndim;j++) {\ + for (sum=0.0,i=1;i<=mpts;i++) sum += p[i][j];\ + psum[j]=sum;} +#define SWAP(a,b) {swap=(a);(a)=(b);(b)=swap;} + +void amoeba(p,y,ndim,ftol,funk,nfunk) +float (*funk)(),**p,ftol,y[]; +int *nfunk,ndim; +{ + float amotry(); + int i,ihi,ilo,inhi,j,mpts=ndim+1; + float rtol,sum,swap,ysave,ytry,*psum; + + psum=vector(1,ndim); + *nfunk=0; + GET_PSUM + for (;;) { + ilo=1; + ihi = y[1]>y[2] ? (inhi=2,1) : (inhi=1,2); + for (i=1;i<=mpts;i++) { + if (y[i] <= y[ilo]) ilo=i; + if (y[i] > y[ihi]) { + inhi=ihi; + ihi=i; + } else if (y[i] > y[inhi] && i != ihi) inhi=i; + } + rtol=2.0*fabs(y[ihi]-y[ilo])/(fabs(y[ihi])+fabs(y[ilo])+TINY); + if (rtol < ftol) { + SWAP(y[1],y[ilo]) + for (i=1;i<=ndim;i++) SWAP(p[1][i],p[ilo][i]) + break; + } + if (*nfunk >= NMAX) nrerror("NMAX exceeded"); + *nfunk += 2; + ytry=amotry(p,y,psum,ndim,funk,ihi,-1.0); + if (ytry <= y[ilo]) + ytry=amotry(p,y,psum,ndim,funk,ihi,2.0); + else if (ytry >= y[inhi]) { + ysave=y[ihi]; + ytry=amotry(p,y,psum,ndim,funk,ihi,0.5); + if (ytry >= ysave) { + for (i=1;i<=mpts;i++) { + if (i != ilo) { + for (j=1;j<=ndim;j++) + p[i][j]=psum[j]=0.5*(p[i][j]+p[ilo][j]); + y[i]=(*funk)(psum); + } + } + *nfunk += ndim; + GET_PSUM + } + } else --(*nfunk); + } + free_vector(psum,1,ndim); +} +#undef SWAP +#undef GET_PSUM +#undef NMAX diff --git a/lib/nr/k_and_r/recipes/amotry.c b/lib/nr/k_and_r/recipes/amotry.c new file mode 100644 index 0000000..c3bc71c --- /dev/null +++ b/lib/nr/k_and_r/recipes/amotry.c @@ -0,0 +1,25 @@ + +#include "nrutil.h" + +float amotry(p,y,psum,ndim,funk,ihi,fac) +float (*funk)(),**p,fac,psum[],y[]; +int ihi,ndim; +{ + int j; + float fac1,fac2,ytry,*ptry; + + ptry=vector(1,ndim); + fac1=(1.0-fac)/ndim; + fac2=fac1-fac; + for (j=1;j<=ndim;j++) ptry[j]=psum[j]*fac1-p[ihi][j]*fac2; + ytry=(*funk)(ptry); + if (ytry < y[ihi]) { + y[ihi]=ytry; + for (j=1;j<=ndim;j++) { + psum[j] += ptry[j]-p[ihi][j]; + p[ihi][j]=ptry[j]; + } + } + free_vector(ptry,1,ndim); + return ytry; +} diff --git a/lib/nr/k_and_r/recipes/amotsa.c b/lib/nr/k_and_r/recipes/amotsa.c new file mode 100644 index 0000000..2b076aa --- /dev/null +++ b/lib/nr/k_and_r/recipes/amotsa.c @@ -0,0 +1,37 @@ + +#include +#include "nrutil.h" + +extern long idum; +extern float tt; + +float amotsa(p,y,psum,ndim,pb,yb,funk,ihi,yhi,fac) +float (*funk)(),**p,*yb,*yhi,fac,pb[],psum[],y[]; +int ihi,ndim; +{ + float ran1(); + int j; + float fac1,fac2,yflu,ytry,*ptry; + + ptry=vector(1,ndim); + fac1=(1.0-fac)/ndim; + fac2=fac1-fac; + for (j=1;j<=ndim;j++) + ptry[j]=psum[j]*fac1-p[ihi][j]*fac2; + ytry=(*funk)(ptry); + if (ytry <= *yb) { + for (j=1;j<=ndim;j++) pb[j]=ptry[j]; + *yb=ytry; + } + yflu=ytry-tt*log(ran1(&idum)); + if (yflu < *yhi) { + y[ihi]=ytry; + *yhi=yflu; + for (j=1;j<=ndim;j++) { + psum[j] += ptry[j]-p[ihi][j]; + p[ihi][j]=ptry[j]; + } + } + free_vector(ptry,1,ndim); + return yflu; +} diff --git a/lib/nr/k_and_r/recipes/anneal.c b/lib/nr/k_and_r/recipes/anneal.c new file mode 100644 index 0000000..28bf613 --- /dev/null +++ b/lib/nr/k_and_r/recipes/anneal.c @@ -0,0 +1,74 @@ + +#include +#include +#define TFACTR 0.9 +#define ALEN(a,b,c,d) sqrt(((b)-(a))*((b)-(a))+((d)-(c))*((d)-(c))) + +void anneal(x,y,iorder,ncity) +float x[],y[]; +int iorder[],ncity; +{ + float ran3(),revcst(),trncst(); + int irbit1(),metrop(); + void reverse(),trnspt(); + int ans,nover,nlimit,i1,i2; + int i,j,k,nsucc,nn,idec; + static int n[7]; + long idum; + unsigned long iseed; + float path,de,t; + + nover=100*ncity; + nlimit=10*ncity; + path=0.0; + t=0.5; + for (i=1;i= n[1]) ++n[2]; + nn=1+((n[1]-n[2]+ncity-1) % ncity); + } while (nn<3); + idec=irbit1(&iseed); + if (idec == 0) { + n[3]=n[2]+(int) (abs(nn-2)*ran3(&idum))+1; + n[3]=1+((n[3]-1) % ncity); + de=trncst(x,y,iorder,ncity,n); + ans=metrop(de,t); + if (ans) { + ++nsucc; + path += de; + trnspt(iorder,ncity,n); + } + } else { + de=revcst(x,y,iorder,ncity,n); + ans=metrop(de,t); + if (ans) { + ++nsucc; + path += de; + reverse(iorder,ncity,n); + } + } + if (nsucc >= nlimit) break; + } + printf("\n %s %10.6f %s %12.6f \n","T =",t, + " Path Length =",path); + printf("Successful Moves: %6d\n",nsucc); + t *= TFACTR; + if (nsucc == 0) return; + } +} +#undef TFACTR +#undef ALEN diff --git a/lib/nr/k_and_r/recipes/anorm2.c b/lib/nr/k_and_r/recipes/anorm2.c new file mode 100644 index 0000000..5806304 --- /dev/null +++ b/lib/nr/k_and_r/recipes/anorm2.c @@ -0,0 +1,15 @@ + +#include + +double anorm2(a,n) +double **a; +int n; +{ + int i,j; + double sum=0.0; + + for (j=1;j<=n;j++) + for (i=1;i<=n;i++) + sum += a[i][j]*a[i][j]; + return sqrt(sum)/n; +} diff --git a/lib/nr/k_and_r/recipes/arcmak.c b/lib/nr/k_and_r/recipes/arcmak.c new file mode 100644 index 0000000..e871d5a --- /dev/null +++ b/lib/nr/k_and_r/recipes/arcmak.c @@ -0,0 +1,32 @@ + +#include "nrutil.h" +#define MC 512 +#ifdef ULONG_MAX +#define MAXINT (ULONG_MAX >> 1) +#else +#define MAXINT 2147483647 +#endif + +typedef struct { + unsigned long *ilob,*iupb,*ncumfq,jdif,nc,minint,nch,ncum,nrad; +} arithcode; + +void arcmak(nfreq,nchh,nradd,acode) +arithcode *acode; +unsigned long nchh,nfreq[],nradd; +{ + unsigned long j; + + if (nchh > MC) nrerror("input radix may not exceed MC in arcmak."); + if (nradd > 256) nrerror("output radix may not exceed 256 in arcmak."); + + acode->minint=MAXINT/nradd; + acode->nch=nchh; + acode->nrad=nradd; + acode->ncumfq[1]=0; + for (j=2;j<=acode->nch+1;j++) + acode->ncumfq[j]=acode->ncumfq[j-1]+IMAX(nfreq[j-1],1); + acode->ncum=acode->ncumfq[acode->nch+2]=acode->ncumfq[acode->nch+1]+1; +} +#undef MC +#undef MAXINT diff --git a/lib/nr/k_and_r/recipes/arcode.c b/lib/nr/k_and_r/recipes/arcode.c new file mode 100644 index 0000000..b6334e0 --- /dev/null +++ b/lib/nr/k_and_r/recipes/arcode.c @@ -0,0 +1,88 @@ + +#include +#define NWK 20 +#define JTRY(j,k,m) ((long)((((double)(k))*((double)(j)))/((double)(m)))) + +typedef struct { + unsigned long *ilob,*iupb,*ncumfq,jdif,nc,minint,nch,ncum,nrad; +} arithcode; + +void arcode(ich,codep,lcode,lcd,isign,acode) +arithcode *acode; +int isign; +unsigned char **codep; +unsigned long *ich,*lcd,*lcode; +{ + char *realloc(); + void arcsum(); + void nrerror(); + int j,k; + unsigned long ihi,ja,jh,jl,m; + + if (!isign) { + acode->jdif=acode->nrad-1; + for (j=NWK;j>=1;j--) { + acode->iupb[j]=acode->nrad-1; + acode->ilob[j]=0; + acode->nc=j; + if (acode->jdif > acode->minint) return; + acode->jdif=(acode->jdif+1)*acode->nrad-1; + } + nrerror("NWK too small in arcode."); + } else { + if (isign > 0) { + if (*ich > acode->nch) nrerror("bad ich in arcode."); + } + else { + ja=(*codep)[*lcd]-acode->ilob[acode->nc]; + for (j=acode->nc+1;j<=NWK;j++) { + ja *= acode->nrad; + ja += ((*codep)[*lcd+j-acode->nc]-acode->ilob[j]); + } + ihi=acode->nch+1; + *ich=0; + while (ihi-(*ich) > 1) { + m=(*ich+ihi)>>1; + if (ja >= JTRY(acode->jdif,acode->ncumfq[m+1],acode->ncum)) + *ich=m; + else ihi=m; + } + if (*ich == acode->nch) return; + } + jh=JTRY(acode->jdif,acode->ncumfq[*ich+2],acode->ncum); + jl=JTRY(acode->jdif,acode->ncumfq[*ich+1],acode->ncum); + acode->jdif=jh-jl; + arcsum(acode->ilob,acode->iupb,jh,NWK,acode->nrad,acode->nc); + arcsum(acode->ilob,acode->ilob,jl,NWK,acode->nrad,acode->nc); + for (j=acode->nc;j<=NWK;j++) { + if (*ich != acode->nch && acode->iupb[j] != acode->ilob[j]) break; + if (*lcd > *lcode) { + fprintf(stderr,"Reached the end of the 'code' array.\n"); + fprintf(stderr,"Attempting to expand its size.\n"); + *lcode += *lcode/2; + if ((*codep=(unsigned char *)realloc(*codep, + (unsigned)(*lcode*sizeof(unsigned char)))) == NULL) { + nrerror("Size expansion failed"); + } + } + if (isign > 0) (*codep)[*lcd]=(unsigned char)acode->ilob[j]; + ++(*lcd); + } + if (j > NWK) return; + acode->nc=j; + for(j=0;acode->jdifminint;j++) + acode->jdif *= acode->nrad; + if (acode->nc-j < 1) nrerror("NWK too small in arcode."); + if (j) { + for (k=acode->nc;k<=NWK;k++) { + acode->iupb[k-j]=acode->iupb[k]; + acode->ilob[k-j]=acode->ilob[k]; + } + } + acode->nc -= j; + for (k=NWK-j+1;k<=NWK;k++) acode->iupb[k]=acode->ilob[k]=0; + } + return; +} +#undef NWK +#undef JTRY diff --git a/lib/nr/k_and_r/recipes/arcsum.c b/lib/nr/k_and_r/recipes/arcsum.c new file mode 100644 index 0000000..f203e48 --- /dev/null +++ b/lib/nr/k_and_r/recipes/arcsum.c @@ -0,0 +1,19 @@ + +void arcsum(iin,iout,ja,nwk,nrad,nc) +int nwk; +unsigned long iin[],iout[],ja,nc,nrad; +{ + int j,karry=0; + unsigned long jtmp; + + for (j=nwk;j>nc;j--) { + jtmp=ja; + ja /= nrad; + iout[j]=iin[j]+(jtmp-ja*nrad)+karry; + if (iout[j] >= nrad) { + iout[j] -= nrad; + karry=1; + } else karry=0; + } + iout[nc]=iin[nc]+ja+karry; +} diff --git a/lib/nr/k_and_r/recipes/asolve.c b/lib/nr/k_and_r/recipes/asolve.c new file mode 100644 index 0000000..112fba3 --- /dev/null +++ b/lib/nr/k_and_r/recipes/asolve.c @@ -0,0 +1,13 @@ + +extern unsigned long ija[]; +extern double sa[]; + +void asolve(n,b,x,itrnsp) +double b[],x[]; +int itrnsp; +unsigned long n; +{ + unsigned long i; + + for(i=1;i<=n;i++) x[i]=(sa[i] != 0.0 ? b[i]/sa[i] : b[i]); +} diff --git a/lib/nr/k_and_r/recipes/atimes.c b/lib/nr/k_and_r/recipes/atimes.c new file mode 100644 index 0000000..3c4e017 --- /dev/null +++ b/lib/nr/k_and_r/recipes/atimes.c @@ -0,0 +1,14 @@ + +extern unsigned long ija[]; +extern double sa[]; + +void atimes(n,x,r,itrnsp) +double r[],x[]; +int itrnsp; +unsigned long n; +{ + void dsprsax(),dsprstx(); + + if (itrnsp) dsprstx(sa,ija,x,r,n); + else dsprsax(sa,ija,x,r,n); +} diff --git a/lib/nr/k_and_r/recipes/avevar.c b/lib/nr/k_and_r/recipes/avevar.c new file mode 100644 index 0000000..622e2a3 --- /dev/null +++ b/lib/nr/k_and_r/recipes/avevar.c @@ -0,0 +1,18 @@ + +void avevar(data,n,ave,var) +float *ave,*var,data[]; +unsigned long n; +{ + unsigned long j; + float s,ep; + + for (*ave=0.0,j=1;j<=n;j++) *ave += data[j]; + *ave /= n; + *var=ep=0.0; + for (j=1;j<=n;j++) { + s=data[j]-(*ave); + ep += s; + *var += s*s; + } + *var=(*var-ep*ep/n)/(n-1); +} diff --git a/lib/nr/k_and_r/recipes/badluk.c b/lib/nr/k_and_r/recipes/badluk.c new file mode 100644 index 0000000..fcce750 --- /dev/null +++ b/lib/nr/k_and_r/recipes/badluk.c @@ -0,0 +1,52 @@ + +#include +#include +#define ZON -5.0 +#define IYBEG 1900 +#define IYEND 2000 + +main() /* Program badluk */ +{ + long julday(); + void flmoon(); + int ic,icon,idwk,im,iyyy,n; + float timzon = ZON/24.0,frac; + long jd,jday; + + printf("\nFull moons on Friday the 13th from %5d to %5d\n",IYBEG,IYEND); + for (iyyy=IYBEG;iyyy<=IYEND;iyyy++) { + for (im=1;im<=12;im++) { + jday=julday(im,13,iyyy); + idwk=(int) ((jday+1) % 7); + if (idwk == 5) { + n=(int)(12.37*(iyyy-1900+(im-0.5)/12.0)); + icon=0; + for (;;) { + flmoon(n,2,&jd,&frac); + frac=24.0*(frac+timzon); + if (frac < 0.0) { + --jd; + frac += 24.0; + } + if (frac > 12.0) { + ++jd; + frac -= 12.0; + } else + frac += 12.0; + if (jd == jday) { + printf("\n%2d/13/%4d\n",im,iyyy); + printf("%s %5.1f %s\n","Full moon",frac, + " hrs after midnight (EST)"); + break; + } else { + ic=(jday >= jd ? 1 : -1); + if (ic == (-icon)) break; + icon=ic; + n += ic; + } + } + } + } + } + return 0; +} diff --git a/lib/nr/k_and_r/recipes/balanc.c b/lib/nr/k_and_r/recipes/balanc.c new file mode 100644 index 0000000..7d4e18b --- /dev/null +++ b/lib/nr/k_and_r/recipes/balanc.c @@ -0,0 +1,46 @@ + +#include +#define RADIX 2.0 + +void balanc(a,n) +float **a; +int n; +{ + int last,j,i; + float s,r,g,f,c,sqrdx; + + sqrdx=RADIX*RADIX; + last=0; + while (last == 0) { + last=1; + for (i=1;i<=n;i++) { + r=c=0.0; + for (j=1;j<=n;j++) + if (j != i) { + c += fabs(a[j][i]); + r += fabs(a[i][j]); + } + if (c && r) { + g=r/RADIX; + f=1.0; + s=c+r; + while (cg) { + f /= RADIX; + c /= sqrdx; + } + if ((c+r)/f < 0.95*s) { + last=0; + g=1.0/f; + for (j=1;j<=n;j++) a[i][j] *= g; + for (j=1;j<=n;j++) a[j][i] *= f; + } + } + } + } +} +#undef RADIX diff --git a/lib/nr/k_and_r/recipes/banbks.c b/lib/nr/k_and_r/recipes/banbks.c new file mode 100644 index 0000000..2f07fd4 --- /dev/null +++ b/lib/nr/k_and_r/recipes/banbks.c @@ -0,0 +1,29 @@ + +#define SWAP(a,b) {dum=(a);(a)=(b);(b)=dum;} + +void banbks(a,n,m1,m2,al,indx,b) +float **a,**al,b[]; +int m1,m2; +unsigned long indx[],n; +{ + unsigned long i,k,l; + int mm; + float dum; + + mm=m1+m2+1; + l=m1; + for (k=1;k<=n;k++) { + i=indx[k]; + if (i != k) SWAP(b[k],b[i]) + if (l < n) l++; + for (i=k+1;i<=l;i++) b[i] -= al[k][i-k]*b[k]; + } + l=1; + for (i=n;i>=1;i--) { + dum=b[i]; + for (k=2;k<=l;k++) dum -= a[i][k]*b[k+i-1]; + b[i]=dum/a[i][1]; + if (l < mm) l++; + } +} +#undef SWAP diff --git a/lib/nr/k_and_r/recipes/bandec.c b/lib/nr/k_and_r/recipes/bandec.c new file mode 100644 index 0000000..9efba8e --- /dev/null +++ b/lib/nr/k_and_r/recipes/bandec.c @@ -0,0 +1,49 @@ + +#include +#define SWAP(a,b) {dum=(a);(a)=(b);(b)=dum;} +#define TINY 1.0e-20 + +void bandec(a,n,m1,m2,al,indx,d) +float **a,**al,*d; +int m1,m2; +unsigned long indx[],n; +{ + unsigned long i,j,k,l; + int mm; + float dum; + + mm=m1+m2+1; + l=m1; + for (i=1;i<=m1;i++) { + for (j=m1+2-i;j<=mm;j++) a[i][j-l]=a[i][j]; + l--; + for (j=mm-l;j<=mm;j++) a[i][j]=0.0; + } + *d=1.0; + l=m1; + for (k=1;k<=n;k++) { + dum=a[k][1]; + i=k; + if (l < n) l++; + for (j=k+1;j<=l;j++) { + if (fabs(a[j][1]) > fabs(dum)) { + dum=a[j][1]; + i=j; + } + } + indx[k]=i; + if (dum == 0.0) a[k][1]=TINY; + if (i != k) { + *d = -(*d); + for (j=1;j<=mm;j++) SWAP(a[k][j],a[i][j]) + } + for (i=k+1;i<=l;i++) { + dum=a[i][1]/a[k][1]; + al[k][i-k]=dum; + for (j=2;j<=mm;j++) a[i][j-1]=a[i][j]-dum*a[k][j]; + a[i][mm]=0.0; + } + } +} +#undef SWAP +#undef TINY diff --git a/lib/nr/k_and_r/recipes/banmul.c b/lib/nr/k_and_r/recipes/banmul.c new file mode 100644 index 0000000..e517172 --- /dev/null +++ b/lib/nr/k_and_r/recipes/banmul.c @@ -0,0 +1,17 @@ + +#include "nrutil.h" + +void banmul(a,n,m1,m2,x,b) +float **a,b[],x[]; +int m1,m2; +unsigned long n; +{ + unsigned long i,j,k,tmploop; + + for (i=1;i<=n;i++) { + k=i-m1-1; + tmploop=LMIN(m1+m2+1,n-k); + b[i]=0.0; + for (j=LMAX(1,1-k);j<=tmploop;j++) b[i] += a[i][j]*x[j+k]; + } +} diff --git a/lib/nr/k_and_r/recipes/bcucof.c b/lib/nr/k_and_r/recipes/bcucof.c new file mode 100644 index 0000000..3b20bb0 --- /dev/null +++ b/lib/nr/k_and_r/recipes/bcucof.c @@ -0,0 +1,40 @@ + +void bcucof(y,y1,y2,y12,d1,d2,c) +float **c,d1,d2,y12[],y1[],y2[],y[]; +{ + static int wt[16][16]= + { 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0, + -3,0,0,3,0,0,0,0,-2,0,0,-1,0,0,0,0, + 2,0,0,-2,0,0,0,0,1,0,0,1,0,0,0,0, + 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0, + 0,0,0,0,-3,0,0,3,0,0,0,0,-2,0,0,-1, + 0,0,0,0,2,0,0,-2,0,0,0,0,1,0,0,1, + -3,3,0,0,-2,-1,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,-3,3,0,0,-2,-1,0,0, + 9,-9,9,-9,6,3,-3,-6,6,-6,-3,3,4,2,1,2, + -6,6,-6,6,-4,-2,2,4,-3,3,3,-3,-2,-1,-1,-2, + 2,-2,0,0,1,1,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,2,-2,0,0,1,1,0,0, + -6,6,-6,6,-3,-3,3,3,-4,4,2,-2,-2,-2,-1,-1, + 4,-4,4,-4,2,2,-2,-2,2,-2,-2,2,1,1,1,1}; + int l,k,j,i; + float xx,d1d2,cl[16],x[16]; + + d1d2=d1*d2; + for (i=1;i<=4;i++) { + x[i-1]=y[i]; + x[i+3]=y1[i]*d1; + x[i+7]=y2[i]*d2; + x[i+11]=y12[i]*d1d2; + } + for (i=0;i<=15;i++) { + xx=0.0; + for (k=0;k<=15;k++) xx += wt[i][k]*x[k]; + cl[i]=xx; + } + l=0; + for (i=1;i<=4;i++) + for (j=1;j<=4;j++) c[i][j]=cl[l++]; +} diff --git a/lib/nr/k_and_r/recipes/bcuint.c b/lib/nr/k_and_r/recipes/bcuint.c new file mode 100644 index 0000000..3a3df7b --- /dev/null +++ b/lib/nr/k_and_r/recipes/bcuint.c @@ -0,0 +1,27 @@ + +#include "nrutil.h" + +void bcuint(y,y1,y2,y12,x1l,x1u,x2l,x2u,x1,x2,ansy,ansy1,ansy2) +float *ansy,*ansy1,*ansy2,x1,x1l,x1u,x2,x2l,x2u,y12[],y1[],y2[],y[]; +{ + void bcucof(); + int i; + float t,u,d1,d2,**c; + + c=matrix(1,4,1,4); + d1=x1u-x1l; + d2=x2u-x2l; + bcucof(y,y1,y2,y12,d1,d2,c); + if (x1u == x1l || x2u == x2l) nrerror("Bad input in routine bcuint"); + t=(x1-x1l)/d1; + u=(x2-x2l)/d2; + *ansy=(*ansy2)=(*ansy1)=0.0; + for (i=4;i>=1;i--) { + *ansy=t*(*ansy)+((c[i][4]*u+c[i][3])*u+c[i][2])*u+c[i][1]; + *ansy2=t*(*ansy2)+(3.0*c[i][4]*u+2.0*c[i][3])*u+c[i][2]; + *ansy1=u*(*ansy1)+(3.0*c[4][i]*t+2.0*c[3][i])*t+c[2][i]; + } + *ansy1 /= d1; + *ansy2 /= d2; + free_matrix(c,1,4,1,4); +} diff --git a/lib/nr/k_and_r/recipes/beschb.c b/lib/nr/k_and_r/recipes/beschb.c new file mode 100644 index 0000000..93c7f8c --- /dev/null +++ b/lib/nr/k_and_r/recipes/beschb.c @@ -0,0 +1,26 @@ + +#define NUSE1 5 +#define NUSE2 5 + +void beschb(x,gam1,gam2,gampl,gammi) +double *gam1,*gam2,*gammi,*gampl,x; +{ + float chebev(); + float xx; + static float c1[] = { + -1.142022680371168e0,6.5165112670737e-3, + 3.087090173086e-4,-3.4706269649e-6,6.9437664e-9, + 3.67795e-11,-1.356e-13}; + static float c2[] = { + 1.843740587300905e0,-7.68528408447867e-2, + 1.2719271366546e-3,-4.9717367042e-6,-3.31261198e-8, + 2.423096e-10,-1.702e-13,-1.49e-15}; + + xx=8.0*x*x-1.0; + *gam1=chebev(-1.0,1.0,c1,NUSE1,xx); + *gam2=chebev(-1.0,1.0,c2,NUSE2,xx); + *gampl= *gam2-x*(*gam1); + *gammi= *gam2+x*(*gam1); +} +#undef NUSE1 +#undef NUSE2 diff --git a/lib/nr/k_and_r/recipes/bessi.c b/lib/nr/k_and_r/recipes/bessi.c new file mode 100644 index 0000000..d987b77 --- /dev/null +++ b/lib/nr/k_and_r/recipes/bessi.c @@ -0,0 +1,40 @@ + +#include +#define ACC 40.0 +#define BIGNO 1.0e10 +#define BIGNI 1.0e-10 + +float bessi(n,x) +float x; +int n; +{ + float bessi0(); + void nrerror(); + int j; + float bi,bim,bip,tox,ans; + + if (n < 2) nrerror("Index n less than 2 in bessi"); + if (x == 0.0) + return 0.0; + else { + tox=2.0/fabs(x); + bip=ans=0.0; + bi=1.0; + for (j=2*(n+(int) sqrt(ACC*n));j>0;j--) { + bim=bip+j*tox*bi; + bip=bi; + bi=bim; + if (fabs(bi) > BIGNO) { + ans *= BIGNI; + bi *= BIGNI; + bip *= BIGNI; + } + if (j == n) ans=bip; + } + ans *= bessi0(x)/bi; + return x < 0.0 && (n & 1) ? -ans : ans; + } +} +#undef ACC +#undef BIGNO +#undef BIGNI diff --git a/lib/nr/k_and_r/recipes/bessi0.c b/lib/nr/k_and_r/recipes/bessi0.c new file mode 100644 index 0000000..67862c1 --- /dev/null +++ b/lib/nr/k_and_r/recipes/bessi0.c @@ -0,0 +1,23 @@ + +#include + +float bessi0(x) +float x; +{ + float ax,ans; + double y; + + if ((ax=fabs(x)) < 3.75) { + y=x/3.75; + y*=y; + ans=1.0+y*(3.5156229+y*(3.0899424+y*(1.2067492 + +y*(0.2659732+y*(0.360768e-1+y*0.45813e-2))))); + } else { + y=3.75/ax; + ans=(exp(ax)/sqrt(ax))*(0.39894228+y*(0.1328592e-1 + +y*(0.225319e-2+y*(-0.157565e-2+y*(0.916281e-2 + +y*(-0.2057706e-1+y*(0.2635537e-1+y*(-0.1647633e-1 + +y*0.392377e-2)))))))); + } + return ans; +} diff --git a/lib/nr/k_and_r/recipes/bessi1.c b/lib/nr/k_and_r/recipes/bessi1.c new file mode 100644 index 0000000..4b15151 --- /dev/null +++ b/lib/nr/k_and_r/recipes/bessi1.c @@ -0,0 +1,24 @@ + +#include + +float bessi1(x) +float x; +{ + float ax,ans; + double y; + + if ((ax=fabs(x)) < 3.75) { + y=x/3.75; + y*=y; + ans=ax*(0.5+y*(0.87890594+y*(0.51498869+y*(0.15084934 + +y*(0.2658733e-1+y*(0.301532e-2+y*0.32411e-3)))))); + } else { + y=3.75/ax; + ans=0.2282967e-1+y*(-0.2895312e-1+y*(0.1787654e-1 + -y*0.420059e-2)); + ans=0.39894228+y*(-0.3988024e-1+y*(-0.362018e-2 + +y*(0.163801e-2+y*(-0.1031555e-1+y*ans)))); + ans *= (exp(ax)/sqrt(ax)); + } + return x < 0.0 ? -ans : ans; +} diff --git a/lib/nr/k_and_r/recipes/bessik.c b/lib/nr/k_and_r/recipes/bessik.c new file mode 100644 index 0000000..cecc9c7 --- /dev/null +++ b/lib/nr/k_and_r/recipes/bessik.c @@ -0,0 +1,127 @@ + +#include +#define EPS 1.0e-10 +#define FPMIN 1.0e-30 +#define MAXIT 10000 +#define XMIN 2.0 +#define PI 3.141592653589793 + +void bessik(x,xnu,ri,rk,rip,rkp) +float *ri,*rip,*rk,*rkp,x,xnu; +{ + void beschb(); + void nrerror(); + int i,l,nl; + double a,a1,b,c,d,del,del1,delh,dels,e,f,fact,fact2,ff,gam1,gam2, + gammi,gampl,h,p,pimu,q,q1,q2,qnew,ril,ril1,rimu,rip1,ripl, + ritemp,rk1,rkmu,rkmup,rktemp,s,sum,sum1,x2,xi,xi2,xmu,xmu2; + + if (x <= 0.0 || xnu < 0.0) nrerror("bad arguments in bessik"); + nl=(int)(xnu+0.5); + xmu=xnu-nl; + xmu2=xmu*xmu; + xi=1.0/x; + xi2=2.0*xi; + h=xnu*xi; + if (h < FPMIN) h=FPMIN; + b=xi2*xnu; + d=0.0; + c=h; + for (i=1;i<=MAXIT;i++) { + b += xi2; + d=1.0/(b+d); + c=b+1.0/c; + del=c*d; + h=del*h; + if (fabs(del-1.0) < EPS) break; + } + if (i > MAXIT) nrerror("x too large in bessik; try asymptotic expansion"); + ril=FPMIN; + ripl=h*ril; + ril1=ril; + rip1=ripl; + fact=xnu*xi; + for (l=nl;l>=1;l--) { + ritemp=fact*ril+ripl; + fact -= xi; + ripl=fact*ritemp+ril; + ril=ritemp; + } + f=ripl/ril; + if (x < XMIN) { + x2=0.5*x; + pimu=PI*xmu; + fact = (fabs(pimu) < EPS ? 1.0 : pimu/sin(pimu)); + d = -log(x2); + e=xmu*d; + fact2 = (fabs(e) < EPS ? 1.0 : sinh(e)/e); + beschb(xmu,&gam1,&gam2,&gampl,&gammi); + ff=fact*(gam1*cosh(e)+gam2*fact2*d); + sum=ff; + e=exp(e); + p=0.5*e/gampl; + q=0.5/(e*gammi); + c=1.0; + d=x2*x2; + sum1=p; + for (i=1;i<=MAXIT;i++) { + ff=(i*ff+p+q)/(i*i-xmu2); + c *= (d/i); + p /= (i-xmu); + q /= (i+xmu); + del=c*ff; + sum += del; + del1=c*(p-i*ff); + sum1 += del1; + if (fabs(del) < fabs(sum)*EPS) break; + } + if (i > MAXIT) nrerror("bessk series failed to converge"); + rkmu=sum; + rk1=sum1*xi2; + } else { + b=2.0*(1.0+x); + d=1.0/b; + h=delh=d; + q1=0.0; + q2=1.0; + a1=0.25-xmu2; + q=c=a1; + a = -a1; + s=1.0+q*delh; + for (i=2;i<=MAXIT;i++) { + a -= 2*(i-1); + c = -a*c/i; + qnew=(q1-b*q2)/a; + q1=q2; + q2=qnew; + q += c*qnew; + b += 2.0; + d=1.0/(b+a*d); + delh=(b*d-1.0)*delh; + h += delh; + dels=q*delh; + s += dels; + if (fabs(dels/s) < EPS) break; + } + if (i > MAXIT) nrerror("bessik: failure to converge in cf2"); + h=a1*h; + rkmu=sqrt(PI/(2.0*x))*exp(-x)/s; + rk1=rkmu*(xmu+x+0.5-h)*xi; + } + rkmup=xmu*xi*rkmu-rk1; + rimu=xi/(f*rkmu-rkmup); + *ri=(rimu*ril1)/ril; + *rip=(rimu*rip1)/ril; + for (i=1;i<=nl;i++) { + rktemp=(xmu+i)*xi2*rk1+rkmu; + rkmu=rk1; + rk1=rktemp; + } + *rk=rkmu; + *rkp=xnu*xi*rkmu-rk1; +} +#undef EPS +#undef FPMIN +#undef MAXIT +#undef XMIN +#undef PI diff --git a/lib/nr/k_and_r/recipes/bessj.c b/lib/nr/k_and_r/recipes/bessj.c new file mode 100644 index 0000000..6397a0d --- /dev/null +++ b/lib/nr/k_and_r/recipes/bessj.c @@ -0,0 +1,57 @@ + +#include +#define ACC 40.0 +#define BIGNO 1.0e10 +#define BIGNI 1.0e-10 + +float bessj(n,x) +float x; +int n; +{ + float bessj0(),bessj1(); + void nrerror(); + int j,jsum,m; + float ax,bj,bjm,bjp,sum,tox,ans; + + if (n < 2) nrerror("Index n less than 2 in bessj"); + ax=fabs(x); + if (ax == 0.0) + return 0.0; + else if (ax > (float) n) { + tox=2.0/ax; + bjm=bessj0(ax); + bj=bessj1(ax); + for (j=1;j0;j--) { + bjm=j*tox*bj-bjp; + bjp=bj; + bj=bjm; + if (fabs(bj) > BIGNO) { + bj *= BIGNI; + bjp *= BIGNI; + ans *= BIGNI; + sum *= BIGNI; + } + if (jsum) sum += bj; + jsum=!jsum; + if (j == n) ans=bjp; + } + sum=2.0*sum-bj; + ans /= sum; + } + return x < 0.0 && (n & 1) ? -ans : ans; +} +#undef ACC +#undef BIGNO +#undef BIGNI diff --git a/lib/nr/k_and_r/recipes/bessj0.c b/lib/nr/k_and_r/recipes/bessj0.c new file mode 100644 index 0000000..6c6c869 --- /dev/null +++ b/lib/nr/k_and_r/recipes/bessj0.c @@ -0,0 +1,29 @@ + +#include + +float bessj0(x) +float x; +{ + float ax,z; + double xx,y,ans,ans1,ans2; + + if ((ax=fabs(x)) < 8.0) { + y=x*x; + ans1=57568490574.0+y*(-13362590354.0+y*(651619640.7 + +y*(-11214424.18+y*(77392.33017+y*(-184.9052456))))); + ans2=57568490411.0+y*(1029532985.0+y*(9494680.718 + +y*(59272.64853+y*(267.8532712+y*1.0)))); + ans=ans1/ans2; + } else { + z=8.0/ax; + y=z*z; + xx=ax-0.785398164; + ans1=1.0+y*(-0.1098628627e-2+y*(0.2734510407e-4 + +y*(-0.2073370639e-5+y*0.2093887211e-6))); + ans2 = -0.1562499995e-1+y*(0.1430488765e-3 + +y*(-0.6911147651e-5+y*(0.7621095161e-6 + -y*0.934945152e-7))); + ans=sqrt(0.636619772/ax)*(cos(xx)*ans1-z*sin(xx)*ans2); + } + return ans; +} diff --git a/lib/nr/k_and_r/recipes/bessj1.c b/lib/nr/k_and_r/recipes/bessj1.c new file mode 100644 index 0000000..b15f5f0 --- /dev/null +++ b/lib/nr/k_and_r/recipes/bessj1.c @@ -0,0 +1,30 @@ + +#include + +float bessj1(x) +float x; +{ + float ax,z; + double xx,y,ans,ans1,ans2; + + if ((ax=fabs(x)) < 8.0) { + y=x*x; + ans1=x*(72362614232.0+y*(-7895059235.0+y*(242396853.1 + +y*(-2972611.439+y*(15704.48260+y*(-30.16036606)))))); + ans2=144725228442.0+y*(2300535178.0+y*(18583304.74 + +y*(99447.43394+y*(376.9991397+y*1.0)))); + ans=ans1/ans2; + } else { + z=8.0/ax; + y=z*z; + xx=ax-2.356194491; + ans1=1.0+y*(0.183105e-2+y*(-0.3516396496e-4 + +y*(0.2457520174e-5+y*(-0.240337019e-6)))); + ans2=0.04687499995+y*(-0.2002690873e-3 + +y*(0.8449199096e-5+y*(-0.88228987e-6 + +y*0.105787412e-6))); + ans=sqrt(0.636619772/ax)*(cos(xx)*ans1-z*sin(xx)*ans2); + if (x < 0.0) ans = -ans; + } + return ans; +} diff --git a/lib/nr/k_and_r/recipes/bessjy.c b/lib/nr/k_and_r/recipes/bessjy.c new file mode 100644 index 0000000..3d3996f --- /dev/null +++ b/lib/nr/k_and_r/recipes/bessjy.c @@ -0,0 +1,154 @@ + +#include +#include "nrutil.h" +#define EPS 1.0e-10 +#define FPMIN 1.0e-30 +#define MAXIT 10000 +#define XMIN 2.0 +#define PI 3.141592653589793 + +void bessjy(x,xnu,rj,ry,rjp,ryp) +float *rj,*rjp,*ry,*ryp,x,xnu; +{ + void beschb(); + int i,isign,l,nl; + double a,b,br,bi,c,cr,ci,d,del,del1,den,di,dlr,dli,dr,e,f,fact,fact2, + fact3,ff,gam,gam1,gam2,gammi,gampl,h,p,pimu,pimu2,q,r,rjl, + rjl1,rjmu,rjp1,rjpl,rjtemp,ry1,rymu,rymup,rytemp,sum,sum1, + temp,w,x2,xi,xi2,xmu,xmu2; + + if (x <= 0.0 || xnu < 0.0) nrerror("bad arguments in bessjy"); + nl=(x < XMIN ? (int)(xnu+0.5) : IMAX(0,(int)(xnu-x+1.5))); + xmu=xnu-nl; + xmu2=xmu*xmu; + xi=1.0/x; + xi2=2.0*xi; + w=xi2/PI; + isign=1; + h=xnu*xi; + if (h < FPMIN) h=FPMIN; + b=xi2*xnu; + d=0.0; + c=h; + for (i=1;i<=MAXIT;i++) { + b += xi2; + d=b-d; + if (fabs(d) < FPMIN) d=FPMIN; + c=b-1.0/c; + if (fabs(c) < FPMIN) c=FPMIN; + d=1.0/d; + del=c*d; + h=del*h; + if (d < 0.0) isign = -isign; + if (fabs(del-1.0) < EPS) break; + } + if (i > MAXIT) nrerror("x too large in bessjy; try asymptotic expansion"); + rjl=isign*FPMIN; + rjpl=h*rjl; + rjl1=rjl; + rjp1=rjpl; + fact=xnu*xi; + for (l=nl;l>=1;l--) { + rjtemp=fact*rjl+rjpl; + fact -= xi; + rjpl=fact*rjtemp-rjl; + rjl=rjtemp; + } + if (rjl == 0.0) rjl=EPS; + f=rjpl/rjl; + if (x < XMIN) { + x2=0.5*x; + pimu=PI*xmu; + fact = (fabs(pimu) < EPS ? 1.0 : pimu/sin(pimu)); + d = -log(x2); + e=xmu*d; + fact2 = (fabs(e) < EPS ? 1.0 : sinh(e)/e); + beschb(xmu,&gam1,&gam2,&gampl,&gammi); + ff=2.0/PI*fact*(gam1*cosh(e)+gam2*fact2*d); + e=exp(e); + p=e/(gampl*PI); + q=1.0/(e*PI*gammi); + pimu2=0.5*pimu; + fact3 = (fabs(pimu2) < EPS ? 1.0 : sin(pimu2)/pimu2); + r=PI*pimu2*fact3*fact3; + c=1.0; + d = -x2*x2; + sum=ff+r*q; + sum1=p; + for (i=1;i<=MAXIT;i++) { + ff=(i*ff+p+q)/(i*i-xmu2); + c *= (d/i); + p /= (i-xmu); + q /= (i+xmu); + del=c*(ff+r*q); + sum += del; + del1=c*p-i*del; + sum1 += del1; + if (fabs(del) < (1.0+fabs(sum))*EPS) break; + } + if (i > MAXIT) nrerror("bessy series failed to converge"); + rymu = -sum; + ry1 = -sum1*xi2; + rymup=xmu*xi*rymu-ry1; + rjmu=w/(rymup-f*rymu); + } else { + a=0.25-xmu2; + p = -0.5*xi; + q=1.0; + br=2.0*x; + bi=2.0; + fact=a*xi/(p*p+q*q); + cr=br+q*fact; + ci=bi+p*fact; + den=br*br+bi*bi; + dr=br/den; + di = -bi/den; + dlr=cr*dr-ci*di; + dli=cr*di+ci*dr; + temp=p*dlr-q*dli; + q=p*dli+q*dlr; + p=temp; + for (i=2;i<=MAXIT;i++) { + a += 2*(i-1); + bi += 2.0; + dr=a*dr+br; + di=a*di+bi; + if (fabs(dr)+fabs(di) < FPMIN) dr=FPMIN; + fact=a/(cr*cr+ci*ci); + cr=br+cr*fact; + ci=bi-ci*fact; + if (fabs(cr)+fabs(ci) < FPMIN) cr=FPMIN; + den=dr*dr+di*di; + dr /= den; + di /= -den; + dlr=cr*dr-ci*di; + dli=cr*di+ci*dr; + temp=p*dlr-q*dli; + q=p*dli+q*dlr; + p=temp; + if (fabs(dlr-1.0)+fabs(dli) < EPS) break; + } + if (i > MAXIT) nrerror("cf2 failed in bessjy"); + gam=(p-f)/q; + rjmu=sqrt(w/((p-f)*gam+q)); + rjmu=SIGN(rjmu,rjl); + rymu=rjmu*gam; + rymup=rymu*(p+q/gam); + ry1=xmu*xi*rymu-rymup; + } + fact=rjmu/rjl; + *rj=rjl1*fact; + *rjp=rjp1*fact; + for (i=1;i<=nl;i++) { + rytemp=(xmu+i)*xi2*ry1-rymu; + rymu=ry1; + ry1=rytemp; + } + *ry=rymu; + *ryp=xnu*xi*rymu-ry1; +} +#undef EPS +#undef FPMIN +#undef MAXIT +#undef XMIN +#undef PI diff --git a/lib/nr/k_and_r/recipes/bessk.c b/lib/nr/k_and_r/recipes/bessk.c new file mode 100644 index 0000000..b4e2a97 --- /dev/null +++ b/lib/nr/k_and_r/recipes/bessk.c @@ -0,0 +1,21 @@ + +float bessk(n,x) +float x; +int n; +{ + float bessk0(),bessk1(); + void nrerror(); + int j; + float bk,bkm,bkp,tox; + + if (n < 2) nrerror("Index n less than 2 in bessk"); + tox=2.0/x; + bkm=bessk0(x); + bk=bessk1(x); + for (j=1;j + +float bessk0(x) +float x; +{ + float bessi0(); + double y,ans; + + if (x <= 2.0) { + y=x*x/4.0; + ans=(-log(x/2.0)*bessi0(x))+(-0.57721566+y*(0.42278420 + +y*(0.23069756+y*(0.3488590e-1+y*(0.262698e-2 + +y*(0.10750e-3+y*0.74e-5)))))); + } else { + y=2.0/x; + ans=(exp(-x)/sqrt(x))*(1.25331414+y*(-0.7832358e-1 + +y*(0.2189568e-1+y*(-0.1062446e-1+y*(0.587872e-2 + +y*(-0.251540e-2+y*0.53208e-3)))))); + } + return ans; +} diff --git a/lib/nr/k_and_r/recipes/bessk1.c b/lib/nr/k_and_r/recipes/bessk1.c new file mode 100644 index 0000000..1e0e106 --- /dev/null +++ b/lib/nr/k_and_r/recipes/bessk1.c @@ -0,0 +1,22 @@ + +#include + +float bessk1(x) +float x; +{ + float bessi1(); + double y,ans; + + if (x <= 2.0) { + y=x*x/4.0; + ans=(log(x/2.0)*bessi1(x))+(1.0/x)*(1.0+y*(0.15443144 + +y*(-0.67278579+y*(-0.18156897+y*(-0.1919402e-1 + +y*(-0.110404e-2+y*(-0.4686e-4))))))); + } else { + y=2.0/x; + ans=(exp(-x)/sqrt(x))*(1.25331414+y*(0.23498619 + +y*(-0.3655620e-1+y*(0.1504268e-1+y*(-0.780353e-2 + +y*(0.325614e-2+y*(-0.68245e-3))))))); + } + return ans; +} diff --git a/lib/nr/k_and_r/recipes/bessy.c b/lib/nr/k_and_r/recipes/bessy.c new file mode 100644 index 0000000..addd089 --- /dev/null +++ b/lib/nr/k_and_r/recipes/bessy.c @@ -0,0 +1,21 @@ + +float bessy(n,x) +float x; +int n; +{ + float bessy0(),bessy1(); + void nrerror(); + int j; + float by,bym,byp,tox; + + if (n < 2) nrerror("Index n less than 2 in bessy"); + tox=2.0/x; + by=bessy1(x); + bym=bessy0(x); + for (j=1;j + +float bessy0(x) +float x; +{ + float bessj0(); + float z; + double xx,y,ans,ans1,ans2; + + if (x < 8.0) { + y=x*x; + ans1 = -2957821389.0+y*(7062834065.0+y*(-512359803.6 + +y*(10879881.29+y*(-86327.92757+y*228.4622733)))); + ans2=40076544269.0+y*(745249964.8+y*(7189466.438 + +y*(47447.26470+y*(226.1030244+y*1.0)))); + ans=(ans1/ans2)+0.636619772*bessj0(x)*log(x); + } else { + z=8.0/x; + y=z*z; + xx=x-0.785398164; + ans1=1.0+y*(-0.1098628627e-2+y*(0.2734510407e-4 + +y*(-0.2073370639e-5+y*0.2093887211e-6))); + ans2 = -0.1562499995e-1+y*(0.1430488765e-3 + +y*(-0.6911147651e-5+y*(0.7621095161e-6 + +y*(-0.934945152e-7)))); + ans=sqrt(0.636619772/x)*(sin(xx)*ans1+z*cos(xx)*ans2); + } + return ans; +} diff --git a/lib/nr/k_and_r/recipes/bessy1.c b/lib/nr/k_and_r/recipes/bessy1.c new file mode 100644 index 0000000..dd9fc5e --- /dev/null +++ b/lib/nr/k_and_r/recipes/bessy1.c @@ -0,0 +1,32 @@ + +#include + +float bessy1(x) +float x; +{ + float bessj1(); + float z; + double xx,y,ans,ans1,ans2; + + if (x < 8.0) { + y=x*x; + ans1=x*(-0.4900604943e13+y*(0.1275274390e13 + +y*(-0.5153438139e11+y*(0.7349264551e9 + +y*(-0.4237922726e7+y*0.8511937935e4))))); + ans2=0.2499580570e14+y*(0.4244419664e12 + +y*(0.3733650367e10+y*(0.2245904002e8 + +y*(0.1020426050e6+y*(0.3549632885e3+y))))); + ans=(ans1/ans2)+0.636619772*(bessj1(x)*log(x)-1.0/x); + } else { + z=8.0/x; + y=z*z; + xx=x-2.356194491; + ans1=1.0+y*(0.183105e-2+y*(-0.3516396496e-4 + +y*(0.2457520174e-5+y*(-0.240337019e-6)))); + ans2=0.04687499995+y*(-0.2002690873e-3 + +y*(0.8449199096e-5+y*(-0.88228987e-6 + +y*0.105787412e-6))); + ans=sqrt(0.636619772/x)*(sin(xx)*ans1+z*cos(xx)*ans2); + } + return ans; +} diff --git a/lib/nr/k_and_r/recipes/beta.c b/lib/nr/k_and_r/recipes/beta.c new file mode 100644 index 0000000..f9dcffa --- /dev/null +++ b/lib/nr/k_and_r/recipes/beta.c @@ -0,0 +1,10 @@ + +#include + +float beta(z,w) +float w,z; +{ + float gammln(); + + return exp(gammln(z)+gammln(w)-gammln(z+w)); +} diff --git a/lib/nr/k_and_r/recipes/betacf.c b/lib/nr/k_and_r/recipes/betacf.c new file mode 100644 index 0000000..73dac6b --- /dev/null +++ b/lib/nr/k_and_r/recipes/betacf.c @@ -0,0 +1,46 @@ + +#include +#define MAXIT 100 +#define EPS 3.0e-7 +#define FPMIN 1.0e-30 + +float betacf(a,b,x) +float a,b,x; +{ + void nrerror(); + int m,m2; + float aa,c,d,del,h,qab,qam,qap; + + qab=a+b; + qap=a+1.0; + qam=a-1.0; + c=1.0; + d=1.0-qab*x/qap; + if (fabs(d) < FPMIN) d=FPMIN; + d=1.0/d; + h=d; + for (m=1;m<=MAXIT;m++) { + m2=2*m; + aa=m*(b-m)*x/((qam+m2)*(a+m2)); + d=1.0+aa*d; + if (fabs(d) < FPMIN) d=FPMIN; + c=1.0+aa/c; + if (fabs(c) < FPMIN) c=FPMIN; + d=1.0/d; + h *= d*c; + aa = -(a+m)*(qab+m)*x/((a+m2)*(qap+m2)); + d=1.0+aa*d; + if (fabs(d) < FPMIN) d=FPMIN; + c=1.0+aa/c; + if (fabs(c) < FPMIN) c=FPMIN; + d=1.0/d; + del=d*c; + h *= del; + if (fabs(del-1.0) < EPS) break; + } + if (m > MAXIT) nrerror("a or b too big, or MAXIT too small in betacf"); + return h; +} +#undef MAXIT +#undef EPS +#undef FPMIN diff --git a/lib/nr/k_and_r/recipes/betai.c b/lib/nr/k_and_r/recipes/betai.c new file mode 100644 index 0000000..80997ff --- /dev/null +++ b/lib/nr/k_and_r/recipes/betai.c @@ -0,0 +1,19 @@ + +#include + +float betai(a,b,x) +float a,b,x; +{ + float betacf(),gammln(); + void nrerror(); + float bt; + + if (x < 0.0 || x > 1.0) nrerror("Bad x in routine betai"); + if (x == 0.0 || x == 1.0) bt=0.0; + else + bt=exp(gammln(a+b)-gammln(a)-gammln(b)+a*log(x)+b*log(1.0-x)); + if (x < (a+1.0)/(a+b+2.0)) + return bt*betacf(a,b,x)/a; + else + return 1.0-bt*betacf(b,a,1.0-x)/b; +} diff --git a/lib/nr/k_and_r/recipes/bico.c b/lib/nr/k_and_r/recipes/bico.c new file mode 100644 index 0000000..e6ffd56 --- /dev/null +++ b/lib/nr/k_and_r/recipes/bico.c @@ -0,0 +1,10 @@ + +#include + +float bico(n,k) +int k,n; +{ + float factln(); + + return floor(0.5+exp(factln(n)-factln(k)-factln(n-k))); +} diff --git a/lib/nr/k_and_r/recipes/bksub.c b/lib/nr/k_and_r/recipes/bksub.c new file mode 100644 index 0000000..f3bf250 --- /dev/null +++ b/lib/nr/k_and_r/recipes/bksub.c @@ -0,0 +1,25 @@ + +void bksub(ne,nb,jf,k1,k2,c) +float ***c; +int jf,k1,k2,nb,ne; +{ + int nbf,im,kp,k,j,i; + float xx; + + nbf=ne-nb; + im=1; + for (k=k2;k>=k1;k--) { + if (k == k1) im=nbf+1; + kp=k+1; + for (j=1;j<=nbf;j++) { + xx=c[j][jf][kp]; + for (i=im;i<=ne;i++) + c[i][jf][k] -= c[i][j][k]*xx; + } + } + for (k=k1;k<=k2;k++) { + kp=k+1; + for (i=1;i<=nb;i++) c[i][1][k]=c[i+nbf][jf][k]; + for (i=1;i<=nbf;i++) c[i+nb][1][k]=c[i][jf][kp]; + } +} diff --git a/lib/nr/k_and_r/recipes/bnldev.c b/lib/nr/k_and_r/recipes/bnldev.c new file mode 100644 index 0000000..9658a83 --- /dev/null +++ b/lib/nr/k_and_r/recipes/bnldev.c @@ -0,0 +1,57 @@ + +#include +#define PI 3.141592654 + +float bnldev(pp,n,idum) +float pp; +int n; +long *idum; +{ + float gammln(),ran1(); + int j; + static int nold=(-1); + float am,em,g,angle,p,bnl,sq,t,y; + static float pold=(-1.0),pc,plog,pclog,en,oldg; + + p=(pp <= 0.5 ? pp : 1.0-pp); + am=n*p; + if (n < 25) { + bnl=0.0; + for (j=1;j<=n;j++) + if (ran1(idum) < p) ++bnl; + } else if (am < 1.0) { + g=exp(-am); + t=1.0; + for (j=0;j<=n;j++) { + t *= ran1(idum); + if (t < g) break; + } + bnl=(j <= n ? j : n); + } else { + if (n != nold) { + en=n; + oldg=gammln(en+1.0); + nold=n; + } if (p != pold) { + pc=1.0-p; + plog=log(p); + pclog=log(pc); + pold=p; + } + sq=sqrt(2.0*am*pc); + do { + do { + angle=PI*ran1(idum); + y=tan(angle); + em=sq*y+am; + } while (em < 0.0 || em >= (en+1.0)); + em=floor(em); + t=1.2*sq*(1.0+y*y)*exp(oldg-gammln(em+1.0) + -gammln(en-em+1.0)+em*plog+(en-em)*pclog); + } while (ran1(idum) > t); + bnl=em; + } + if (p != pp) bnl=n-bnl; + return bnl; +} +#undef PI diff --git a/lib/nr/k_and_r/recipes/brent.c b/lib/nr/k_and_r/recipes/brent.c new file mode 100644 index 0000000..a73eddf --- /dev/null +++ b/lib/nr/k_and_r/recipes/brent.c @@ -0,0 +1,73 @@ + +#include +#include "nrutil.h" +#define ITMAX 100 +#define CGOLD 0.3819660 +#define ZEPS 1.0e-10 +#define SHFT(a,b,c,d) (a)=(b);(b)=(c);(c)=(d); + +float brent(ax,bx,cx,f,tol,xmin) +float (*f)(),*xmin,ax,bx,cx,tol; +{ + int iter; + float a,b,d,etemp,fu,fv,fw,fx,p,q,r,tol1,tol2,u,v,w,x,xm; + float e=0.0; + + a=(ax < cx ? ax : cx); + b=(ax > cx ? ax : cx); + x=w=v=bx; + fw=fv=fx=(*f)(x); + for (iter=1;iter<=ITMAX;iter++) { + xm=0.5*(a+b); + tol2=2.0*(tol1=tol*fabs(x)+ZEPS); + if (fabs(x-xm) <= (tol2-0.5*(b-a))) { + *xmin=x; + return fx; + } + if (fabs(e) > tol1) { + r=(x-w)*(fx-fv); + q=(x-v)*(fx-fw); + p=(x-v)*q-(x-w)*r; + q=2.0*(q-r); + if (q > 0.0) p = -p; + q=fabs(q); + etemp=e; + e=d; + if (fabs(p) >= fabs(0.5*q*etemp) || p <= q*(a-x) || p >= q*(b-x)) + d=CGOLD*(e=(x >= xm ? a-x : b-x)); + else { + d=p/q; + u=x+d; + if (u-a < tol2 || b-u < tol2) + d=SIGN(tol1,xm-x); + } + } else { + d=CGOLD*(e=(x >= xm ? a-x : b-x)); + } + u=(fabs(d) >= tol1 ? x+d : x+SIGN(tol1,d)); + fu=(*f)(u); + if (fu <= fx) { + if (u >= x) a=x; else b=x; + SHFT(v,w,x,u) + SHFT(fv,fw,fx,fu) + } else { + if (u < x) a=u; else b=u; + if (fu <= fw || w == x) { + v=w; + w=u; + fv=fw; + fw=fu; + } else if (fu <= fv || v == x || v == w) { + v=u; + fv=fu; + } + } + } + nrerror("Too many iterations in brent"); + *xmin=x; + return fx; +} +#undef ITMAX +#undef CGOLD +#undef ZEPS +#undef SHFT diff --git a/lib/nr/k_and_r/recipes/broydn.c b/lib/nr/k_and_r/recipes/broydn.c new file mode 100644 index 0000000..4846bc0 --- /dev/null +++ b/lib/nr/k_and_r/recipes/broydn.c @@ -0,0 +1,161 @@ + +#include +#include "nrutil.h" +#define MAXITS 200 +#define EPS 1.0e-7 +#define TOLF 1.0e-4 +#define TOLX EPS +#define STPMX 100.0 +#define TOLMIN 1.0e-6 +#define FREERETURN {free_vector(fvec,1,n);free_vector(xold,1,n);\ + free_vector(w,1,n);free_vector(t,1,n);free_vector(s,1,n);\ + free_matrix(r,1,n,1,n);free_matrix(qt,1,n,1,n);free_vector(p,1,n);\ + free_vector(g,1,n);free_vector(fvcold,1,n);free_vector(d,1,n);\ + free_vector(c,1,n);return;} + +int nn; +float *fvec; +void (*nrfuncv)(); + +void broydn(x,n,check,vecfunc) +float x[]; +int *check,n; +void (*vecfunc)(); +{ + float fmin(); + void fdjac(),lnsrch(),qrdcmp(),qrupdt(),rsolv(); + int i,its,j,k,restrt,sing,skip; + float den,f,fold,stpmax,sum,temp,test,*c,*d,*fvcold; + float *g,*p,**qt,**r,*s,*t,*w,*xold; + + c=vector(1,n); + d=vector(1,n); + fvcold=vector(1,n); + g=vector(1,n); + p=vector(1,n); + qt=matrix(1,n,1,n); + r=matrix(1,n,1,n); + s=vector(1,n); + t=vector(1,n); + w=vector(1,n); + xold=vector(1,n); + fvec=vector(1,n); + nn=n; + nrfuncv=vecfunc; + f=fmin(x); + test=0.0; + for (i=1;i<=n;i++) + if (fabs(fvec[i]) > test)test=fabs(fvec[i]); + if (test < 0.01*TOLF) { + *check=0; + FREERETURN + } + for (sum=0.0,i=1;i<=n;i++) sum += SQR(x[i]); + stpmax=STPMX*FMAX(sqrt(sum),(float)n); + restrt=1; + for (its=1;its<=MAXITS;its++) { + if (restrt) { + fdjac(n,x,fvec,r,vecfunc); + qrdcmp(r,n,c,d,&sing); + if (sing) nrerror("singular Jacobian in broydn"); + for (i=1;i<=n;i++) { + for (j=1;j<=n;j++) qt[i][j]=0.0; + qt[i][i]=1.0; + } + for (k=1;k= EPS*(fabs(fvec[i])+fabs(fvcold[i]))) skip=0; + else w[i]=0.0; + } + if (!skip) { + for (i=1;i<=n;i++) { + for (sum=0.0,j=1;j<=n;j++) sum += qt[i][j]*w[j]; + t[i]=sum; + } + for (den=0.0,i=1;i<=n;i++) den += SQR(s[i]); + for (i=1;i<=n;i++) s[i] /= den; + qrupdt(r,qt,n,t,s); + for (i=1;i<=n;i++) { + if (r[i][i] == 0.0) nrerror("r singular in broydn"); + d[i]=r[i][i]; + } + } + } + for (i=1;i<=n;i++) { + for (sum=0.0,j=1;j<=n;j++) sum += qt[i][j]*fvec[j]; + p[i] = -sum; + } + for (i=n;i>=1;i--) { + for (sum=0.0,j=1;j<=i;j++) sum -= r[j][i]*p[j]; + g[i]=sum; + } + for (i=1;i<=n;i++) { + xold[i]=x[i]; + fvcold[i]=fvec[i]; + } + fold=f; + rsolv(r,n,d,p); + lnsrch(n,xold,fold,g,p,x,&f,stpmax,check,fmin); + test=0.0; + for (i=1;i<=n;i++) + if (fabs(fvec[i]) > test) test=fabs(fvec[i]); + if (test < TOLF) { + *check=0; + FREERETURN + } + if (*check) { + if (restrt) FREERETURN + else { + test=0.0; + den=FMAX(f,0.5*n); + for (i=1;i<=n;i++) { + temp=fabs(g[i])*FMAX(fabs(x[i]),1.0)/den; + if (temp > test) test=temp; + } + if (test < TOLMIN) FREERETURN + else restrt=1; + } + } else { + restrt=0; + test=0.0; + for (i=1;i<=n;i++) { + temp=(fabs(x[i]-xold[i]))/FMAX(fabs(x[i]),1.0); + if (temp > test) test=temp; + } + if (test < TOLX) FREERETURN + } + } + nrerror("MAXITS exceeded in broydn"); + FREERETURN +} +#undef MAXITS +#undef EPS +#undef TOLF +#undef TOLMIN +#undef TOLX +#undef STPMX +#undef FREERETURN diff --git a/lib/nr/k_and_r/recipes/bsstep.c b/lib/nr/k_and_r/recipes/bsstep.c new file mode 100644 index 0000000..8e5ac22 --- /dev/null +++ b/lib/nr/k_and_r/recipes/bsstep.c @@ -0,0 +1,137 @@ + +#include +#include "nrutil.h" +#define KMAXX 8 +#define IMAXX (KMAXX+1) +#define SAFE1 0.25 +#define SAFE2 0.7 +#define REDMAX 1.0e-5 +#define REDMIN 0.7 +#define TINY 1.0e-30 +#define SCALMX 0.1 + +float **d,*x; + +void bsstep(y,dydx,nv,xx,htry,eps,yscal,hdid,hnext,derivs) +float *hdid,*hnext,*xx,dydx[],eps,htry,y[],yscal[]; +int nv; +void (*derivs)(); +{ + void mmid(),pzextr(); + int i,iq,k,kk,km; + static int first=1,kmax,kopt; + static float epsold = -1.0,xnew; + float eps1,errmax,fact,h,red,scale,work,wrkmin,xest; + float *err,*yerr,*ysav,*yseq; + static float a[IMAXX+1]; + static float alf[KMAXX+1][KMAXX+1]; + static int nseq[IMAXX+1]={0,2,4,6,8,10,12,14,16,18}; + int reduct,exitflag=0; + + d=matrix(1,nv,1,KMAXX); + err=vector(1,KMAXX); + x=vector(1,KMAXX); + yerr=vector(1,nv); + ysav=vector(1,nv); + yseq=vector(1,nv); + if (eps != epsold) { + *hnext = xnew = -1.0e29; + eps1=SAFE1*eps; + a[1]=nseq[1]+1; + for (k=1;k<=KMAXX;k++) a[k+1]=a[k]+nseq[k+1]; + for (iq=2;iq<=KMAXX;iq++) { + for (k=1;k a[kopt]*alf[kopt-1][kopt]) break; + kmax=kopt; + } + h=htry; + for (i=1;i<=nv;i++) ysav[i]=y[i]; + if (*xx != xnew || h != (*hnext)) { + first=1; + kopt=kmax; + } + reduct=0; + for (;;) { + for (k=1;k<=kmax;k++) { + xnew=(*xx)+h; + if (xnew == (*xx)) nrerror("step size underflow in bsstep"); + mmid(ysav,dydx,nv,*xx,h,nseq[k],yseq,derivs); + xest=SQR(h/nseq[k]); + pzextr(k,xest,yseq,y,yerr,nv); + if (k != 1) { + errmax=TINY; + for (i=1;i<=nv;i++) errmax=FMAX(errmax,fabs(yerr[i]/yscal[i])); + errmax /= eps; + km=k-1; + err[km]=pow(errmax/SAFE1,1.0/(2*km+1)); + } + if (k != 1 && (k >= kopt-1 || first)) { + if (errmax < 1.0) { + exitflag=1; + break; + } + if (k == kmax || k == kopt+1) { + red=SAFE2/err[km]; + break; + } + else if (k == kopt && alf[kopt-1][kopt] < err[km]) { + red=1.0/err[km]; + break; + } + else if (kopt == kmax && alf[km][kmax-1] < err[km]) { + red=alf[km][kmax-1]*SAFE2/err[km]; + break; + } + else if (alf[km][kopt] < err[km]) { + red=alf[km][kopt-1]/err[km]; + break; + } + } + } + if (exitflag) break; + red=FMIN(red,REDMIN); + red=FMAX(red,REDMAX); + h *= red; + reduct=1; + } + *xx=xnew; + *hdid=h; + first=0; + wrkmin=1.0e35; + for (kk=1;kk<=km;kk++) { + fact=FMAX(err[kk],SCALMX); + work=fact*a[kk+1]; + if (work < wrkmin) { + scale=fact; + wrkmin=work; + kopt=kk+1; + } + } + *hnext=h/scale; + if (kopt >= k && kopt != kmax && !reduct) { + fact=FMAX(scale/alf[kopt-1][kopt],SCALMX); + if (a[kopt+1]*fact <= wrkmin) { + *hnext=h/fact; + kopt++; + } + } + free_vector(yseq,1,nv); + free_vector(ysav,1,nv); + free_vector(yerr,1,nv); + free_vector(x,1,KMAXX); + free_vector(err,1,KMAXX); + free_matrix(d,1,nv,1,KMAXX); +} +#undef KMAXX +#undef IMAXX +#undef SAFE1 +#undef SAFE2 +#undef REDMAX +#undef REDMIN +#undef TINY +#undef SCALMX diff --git a/lib/nr/k_and_r/recipes/caldat.c b/lib/nr/k_and_r/recipes/caldat.c new file mode 100644 index 0000000..9cb8d3a --- /dev/null +++ b/lib/nr/k_and_r/recipes/caldat.c @@ -0,0 +1,30 @@ + +#include +#define IGREG 2299161 + +void caldat(julian,mm,id,iyyy) +int *id,*iyyy,*mm; +long julian; +{ + long ja,jalpha,jb,jc,jd,je; + + if (julian >= IGREG) { + jalpha=(long)(((double) (julian-1867216)-0.25)/36524.25); + ja=julian+1+jalpha-(long) (0.25*jalpha); + } else if (julian < 0) { + ja=julian+36525*(1-julian/36525); + } else + ja=julian; + jb=ja+1524; + jc=(long)(6680.0+((double) (jb-2439870)-122.1)/365.25); + jd=(long)(365*jc+(0.25*jc)); + je=(long)((jb-jd)/30.6001); + *id=jb-jd-(long) (30.6001*je); + *mm=je-1; + if (*mm > 12) *mm -= 12; + *iyyy=jc-4715; + if (*mm > 2) --(*iyyy); + if (*iyyy <= 0) --(*iyyy); + if (julian < 0) *iyyy -= 100*(1-julian/36525); +} +#undef IGREG diff --git a/lib/nr/k_and_r/recipes/chder.c b/lib/nr/k_and_r/recipes/chder.c new file mode 100644 index 0000000..21afc74 --- /dev/null +++ b/lib/nr/k_and_r/recipes/chder.c @@ -0,0 +1,16 @@ + +void chder(a,b,c,cder,n) +float a,b,c[],cder[]; +int n; +{ + int j; + float con; + + cder[n-1]=0.0; + cder[n-2]=2*(n-1)*c[n-1]; + for (j=n-3;j>=0;j--) + cder[j]=cder[j+2]+2*(j+1)*c[j+1]; + con=2.0/(b-a); + for (j=0;j 0.0) nrerror("x not in range in routine chebev"); + y2=2.0*(y=(2.0*x-a-b)/(b-a)); + for (j=m-1;j>=1;j--) { + sv=d; + d=y2*d-dd+c[j]; + dd=sv; + } + return y*d-dd+0.5*c[0]; +} diff --git a/lib/nr/k_and_r/recipes/chebft.c b/lib/nr/k_and_r/recipes/chebft.c new file mode 100644 index 0000000..e48a1be --- /dev/null +++ b/lib/nr/k_and_r/recipes/chebft.c @@ -0,0 +1,29 @@ + +#include +#include "nrutil.h" +#define PI 3.141592653589793 + +void chebft(a,b,c,n,func) +float (*func)(),a,b,c[]; +int n; +{ + int k,j; + float fac,bpa,bma,*f; + + f=vector(0,n-1); + bma=0.5*(b-a); + bpa=0.5*(b+a); + for (k=0;k=1;j--) { + for (k=n-j;k>=1;k--) { + sv=d[k]; + d[k]=2.0*d[k-1]-dd[k]; + dd[k]=sv; + } + sv=d[0]; + d[0] = -dd[0]+c[j]; + dd[0]=sv; + } + for (j=n-1;j>=1;j--) + d[j]=d[j-1]-dd[j]; + d[0] = -dd[0]+0.5*c[0]; + free_vector(dd,0,n-1); +} diff --git a/lib/nr/k_and_r/recipes/chint.c b/lib/nr/k_and_r/recipes/chint.c new file mode 100644 index 0000000..bc847f4 --- /dev/null +++ b/lib/nr/k_and_r/recipes/chint.c @@ -0,0 +1,18 @@ + +void chint(a,b,c,cint,n) +float a,b,c[],cint[]; +int n; +{ + int j; + float sum=0.0,fac=1.0,con; + + con=0.25*(b-a); + for (j=1;j<=n-2;j++) { + cint[j]=con*(c[j-1]-c[j+1])/j; + sum += fac*cint[j]; + fac = -fac; + } + cint[n-1]=con*c[n-2]/(n-1); + sum += fac*cint[n-1]; + cint[0]=2.0*sum; +} diff --git a/lib/nr/k_and_r/recipes/chixy.c b/lib/nr/k_and_r/recipes/chixy.c new file mode 100644 index 0000000..9172646 --- /dev/null +++ b/lib/nr/k_and_r/recipes/chixy.c @@ -0,0 +1,29 @@ + +#include +#include "nrutil.h" +#define BIG 1.0e30 + +extern int nn; +extern float *xx,*yy,*sx,*sy,*ww,aa,offs; + +float chixy(bang) +float bang; +{ + int j; + float ans,avex=0.0,avey=0.0,sumw=0.0,b; + + b=tan(bang); + for (j=1;j<=nn;j++) { + ww[j] = SQR(b*sx[j])+SQR(sy[j]); + sumw += (ww[j] = (ww[j] < 1.0/BIG ? BIG : 1.0/ww[j])); + avex += ww[j]*xx[j]; + avey += ww[j]*yy[j]; + } + avex /= sumw; + avey /= sumw; + aa=avey-b*avex; + for (ans = -offs,j=1;j<=nn;j++) + ans += ww[j]*SQR(yy[j]-aa-b*xx[j]); + return ans; +} +#undef BIG diff --git a/lib/nr/k_and_r/recipes/choldc.c b/lib/nr/k_and_r/recipes/choldc.c new file mode 100644 index 0000000..c131fa1 --- /dev/null +++ b/lib/nr/k_and_r/recipes/choldc.c @@ -0,0 +1,22 @@ + +#include + +void choldc(a,n,p) +float **a,p[]; +int n; +{ + void nrerror(); + int i,j,k; + float sum; + + for (i=1;i<=n;i++) { + for (j=i;j<=n;j++) { + for (sum=a[i][j],k=i-1;k>=1;k--) sum -= a[i][k]*a[j][k]; + if (i == j) { + if (sum <= 0.0) + nrerror("choldc failed"); + p[i]=sqrt(sum); + } else a[j][i]=sum/p[i]; + } + } +} diff --git a/lib/nr/k_and_r/recipes/cholsl.c b/lib/nr/k_and_r/recipes/cholsl.c new file mode 100644 index 0000000..3d4dd8f --- /dev/null +++ b/lib/nr/k_and_r/recipes/cholsl.c @@ -0,0 +1,17 @@ + +void cholsl(a,n,p,b,x) +float **a,b[],p[],x[]; +int n; +{ + int i,k; + float sum; + + for (i=1;i<=n;i++) { + for (sum=b[i],k=i-1;k>=1;k--) sum -= a[i][k]*x[k]; + x[i]=sum/p[i]; + } + for (i=n;i>=1;i--) { + for (sum=x[i],k=i+1;k<=n;k++) sum -= a[k][i]*x[k]; + x[i]=sum/p[i]; + } +} diff --git a/lib/nr/k_and_r/recipes/chsone.c b/lib/nr/k_and_r/recipes/chsone.c new file mode 100644 index 0000000..a81d714 --- /dev/null +++ b/lib/nr/k_and_r/recipes/chsone.c @@ -0,0 +1,19 @@ + +void chsone(bins,ebins,nbins,knstrn,df,chsq,prob) +float *chsq,*df,*prob,bins[],ebins[]; +int knstrn,nbins; +{ + float gammq(); + void nrerror(); + int j; + float temp; + + *df=nbins-knstrn; + *chsq=0.0; + for (j=1;j<=nbins;j++) { + if (ebins[j] <= 0.0) nrerror("Bad expected number in chsone"); + temp=bins[j]-ebins[j]; + *chsq += temp*temp/ebins[j]; + } + *prob=gammq(0.5*(*df),0.5*(*chsq)); +} diff --git a/lib/nr/k_and_r/recipes/chstwo.c b/lib/nr/k_and_r/recipes/chstwo.c new file mode 100644 index 0000000..91e747d --- /dev/null +++ b/lib/nr/k_and_r/recipes/chstwo.c @@ -0,0 +1,20 @@ + +void chstwo(bins1,bins2,nbins,knstrn,df,chsq,prob) +float *chsq,*df,*prob,bins1[],bins2[]; +int knstrn,nbins; +{ + float gammq(); + int j; + float temp; + + *df=nbins-knstrn; + *chsq=0.0; + for (j=1;j<=nbins;j++) + if (bins1[j] == 0.0 && bins2[j] == 0.0) + --(*df); + else { + temp=bins1[j]-bins2[j]; + *chsq += temp*temp/(bins1[j]+bins2[j]); + } + *prob=gammq(0.5*(*df),0.5*(*chsq)); +} diff --git a/lib/nr/k_and_r/recipes/cisi.c b/lib/nr/k_and_r/recipes/cisi.c new file mode 100644 index 0000000..dd83a74 --- /dev/null +++ b/lib/nr/k_and_r/recipes/cisi.c @@ -0,0 +1,82 @@ + +#include +#include "complex.h" +#define EPS 6.0e-8 +#define EULER 0.57721566 +#define MAXIT 100 +#define PIBY2 1.5707963 +#define FPMIN 1.0e-30 +#define TMIN 2.0 +#define TRUE 1 +#define ONE Complex(1.0,0.0) + +void cisi(x,ci,si) +float *ci,*si,x; +{ + void nrerror(); + int i,k,odd; + float a,err,fact,sign,sum,sumc,sums,t,term; + fcomplex h,b,c,d,del; + + t=fabs(x); + if (t == 0.0) { + *si=0.0; + *ci = -1.0/FPMIN; + return; + } + if (t > TMIN) { + b=Complex(1.0,t); + c=Complex(1.0/FPMIN,0.0); + d=h=Cdiv(ONE,b); + for (i=2;i<=MAXIT;i++) { + a = -(i-1)*(i-1); + b=Cadd(b,Complex(2.0,0.0)); + d=Cdiv(ONE,Cadd(RCmul(a,d),b)); + c=Cadd(b,Cdiv(Complex(a,0.0),c)); + del=Cmul(c,d); + h=Cmul(h,del); + if (fabs(del.r-1.0)+fabs(del.i) < EPS) break; + } + if (i > MAXIT) nrerror("cf failed in cisi"); + h=Cmul(Complex(cos(t),-sin(t)),h); + *ci = -h.r; + *si=PIBY2+h.i; + } else { + if (t < sqrt(FPMIN)) { + sumc=0.0; + sums=t; + } else { + sum=sums=sumc=0.0; + sign=fact=1.0; + odd=TRUE; + for (k=1;k<=MAXIT;k++) { + fact *= t/k; + term=fact/k; + sum += sign*term; + err=term/fabs(sum); + if (odd) { + sign = -sign; + sums=sum; + sum=sumc; + } else { + sumc=sum; + sum=sums; + } + if (err < EPS) break; + odd=!odd; + } + if (k > MAXIT) nrerror("maxits exceeded in cisi"); + } + *si=sums; + *ci=sumc+log(t)+EULER; + } + if (x < 0.0) *si = -(*si); +} +#undef EPS +#undef EULER +#undef MAXIT +#undef PIBY2 +#undef FPMIN +#undef TMIN +#undef TRUE +#undef ONE diff --git a/lib/nr/k_and_r/recipes/cntab1.c b/lib/nr/k_and_r/recipes/cntab1.c new file mode 100644 index 0000000..4d2c211 --- /dev/null +++ b/lib/nr/k_and_r/recipes/cntab1.c @@ -0,0 +1,47 @@ + +#include +#include "nrutil.h" +#define TINY 1.0e-30 + +void cntab1(nn,ni,nj,chisq,df,prob,cramrv,ccc) +float *ccc,*chisq,*cramrv,*df,*prob; +int **nn,ni,nj; +{ + float gammq(); + int nnj,nni,j,i,minij; + float sum=0.0,expctd,*sumi,*sumj,temp; + + sumi=vector(1,ni); + sumj=vector(1,nj); + nni=ni; + nnj=nj; + for (i=1;i<=ni;i++) { + sumi[i]=0.0; + for (j=1;j<=nj;j++) { + sumi[i] += nn[i][j]; + sum += nn[i][j]; + } + if (sumi[i] == 0.0) --nni; + } + for (j=1;j<=nj;j++) { + sumj[j]=0.0; + for (i=1;i<=ni;i++) sumj[j] += nn[i][j]; + if (sumj[j] == 0.0) --nnj; + } + *df=nni*nnj-nni-nnj+1; + *chisq=0.0; + for (i=1;i<=ni;i++) { + for (j=1;j<=nj;j++) { + expctd=sumj[j]*sumi[i]/sum; + temp=nn[i][j]-expctd; + *chisq += temp*temp/(expctd+TINY); + } + } + *prob=gammq(0.5*(*df),0.5*(*chisq)); + minij = nni < nnj ? nni-1 : nnj-1; + *cramrv=sqrt(*chisq/(sum*minij)); + *ccc=sqrt(*chisq/(*chisq+sum)); + free_vector(sumj,1,nj); + free_vector(sumi,1,ni); +} +#undef TINY diff --git a/lib/nr/k_and_r/recipes/cntab2.c b/lib/nr/k_and_r/recipes/cntab2.c new file mode 100644 index 0000000..3d6179f --- /dev/null +++ b/lib/nr/k_and_r/recipes/cntab2.c @@ -0,0 +1,54 @@ + +#include +#include "nrutil.h" +#define TINY 1.0e-30 + +void cntab2(nn,ni,nj,h,hx,hy,hygx,hxgy,uygx,uxgy,uxy) +float *h,*hx,*hxgy,*hy,*hygx,*uxgy,*uxy,*uygx; +int **nn,ni,nj; +{ + int i,j; + float sum=0.0,p,*sumi,*sumj; + + sumi=vector(1,ni); + sumj=vector(1,nj); + for (i=1;i<=ni;i++) { + sumi[i]=0.0; + for (j=1;j<=nj;j++) { + sumi[i] += nn[i][j]; + sum += nn[i][j]; + } + } + for (j=1;j<=nj;j++) { + sumj[j]=0.0; + for (i=1;i<=ni;i++) + sumj[j] += nn[i][j]; + } + *hx=0.0; + for (i=1;i<=ni;i++) + if (sumi[i]) { + p=sumi[i]/sum; + *hx -= p*log(p); + } + *hy=0.0; + for (j=1;j<=nj;j++) + if (sumj[j]) { + p=sumj[j]/sum; + *hy -= p*log(p); + } + *h=0.0; + for (i=1;i<=ni;i++) + for (j=1;j<=nj;j++) + if (nn[i][j]) { + p=nn[i][j]/sum; + *h -= p*log(p); + } + *hygx=(*h)-(*hx); + *hxgy=(*h)-(*hy); + *uygx=(*hy-*hygx)/(*hy+TINY); + *uxgy=(*hx-*hxgy)/(*hx+TINY); + *uxy=2.0*(*hx+*hy-*h)/(*hx+*hy+TINY); + free_vector(sumj,1,nj); + free_vector(sumi,1,ni); +} +#undef TINY diff --git a/lib/nr/k_and_r/recipes/complex.c b/lib/nr/k_and_r/recipes/complex.c new file mode 100644 index 0000000..2b6d838 --- /dev/null +++ b/lib/nr/k_and_r/recipes/complex.c @@ -0,0 +1,135 @@ +/* CAUTION: This is the traditional K&R C (only) version of the Numerical + Recipes utility file complex.c. Do not confuse this file with the + same-named file complex.c that is supplied in the same subdirectory or + archive as the header file complex.h. *That* file contains both ANSI and + traditional K&R versions, along with #ifdef macros to select the + correct version. *This* file contains only traditional K&R. */ + +#include + +typedef struct FCOMPLEX {float r,i;} fcomplex; + +fcomplex Cadd(a,b) +fcomplex a,b; +{ + fcomplex c; + c.r=a.r+b.r; + c.i=a.i+b.i; + return c; +} + +fcomplex Csub(a,b) +fcomplex a,b; +{ + fcomplex c; + c.r=a.r-b.r; + c.i=a.i-b.i; + return c; +} + + +fcomplex Cmul(a,b) +fcomplex a,b; +{ + fcomplex c; + c.r=a.r*b.r-a.i*b.i; + c.i=a.i*b.r+a.r*b.i; + return c; +} + +fcomplex Complex(re,im) +float im,re; +{ + fcomplex c; + c.r=re; + c.i=im; + return c; +} + +fcomplex Conjg(z) +fcomplex z; +{ + fcomplex c; + c.r=z.r; + c.i = -z.i; + return c; +} + +fcomplex Cdiv(a,b) +fcomplex a,b; +{ + fcomplex c; + float r,den; + if (fabs(b.r) >= fabs(b.i)) { + r=b.i/b.r; + den=b.r+r*b.i; + c.r=(a.r+r*a.i)/den; + c.i=(a.i-r*a.r)/den; + } else { + r=b.r/b.i; + den=b.i+r*b.r; + c.r=(a.r*r+a.i)/den; + c.i=(a.i*r-a.r)/den; + } + return c; +} + +float Cabs(z) +fcomplex z; +{ + float x,y,ans,temp; + x=fabs(z.r); + y=fabs(z.i); + if (x == 0.0) + ans=y; + else if (y == 0.0) + ans=x; + else if (x > y) { + temp=y/x; + ans=x*sqrt(1.0+temp*temp); + } else { + temp=x/y; + ans=y*sqrt(1.0+temp*temp); + } + return ans; +} + +fcomplex Csqrt(z) +fcomplex z; +{ + fcomplex c; + float x,y,w,r; + if ((z.r == 0.0) && (z.i == 0.0)) { + c.r=0.0; + c.i=0.0; + return c; + } else { + x=fabs(z.r); + y=fabs(z.i); + if (x >= y) { + r=y/x; + w=sqrt(x)*sqrt(0.5*(1.0+sqrt(1.0+r*r))); + } else { + r=x/y; + w=sqrt(y)*sqrt(0.5*(r+sqrt(1.0+r*r))); + } + if (z.r >= 0.0) { + c.r=w; + c.i=z.i/(2.0*w); + } else { + c.i=(z.i >= 0) ? w : -w; + c.r=z.i/(2.0*c.i); + } + return c; + } +} + +fcomplex RCmul(x,a) +fcomplex a; +float x; +{ + fcomplex c; + c.r=x*a.r; + c.i=x*a.i; + return c; +} diff --git a/lib/nr/k_and_r/recipes/convlv.c b/lib/nr/k_and_r/recipes/convlv.c new file mode 100644 index 0000000..c2b0b74 --- /dev/null +++ b/lib/nr/k_and_r/recipes/convlv.c @@ -0,0 +1,34 @@ + +#include "nrutil.h" + +void convlv(data,n,respns,m,isign,ans) +float ans[],data[],respns[]; +int isign; +unsigned long m,n; +{ + void realft(),twofft(); + unsigned long i,no2; + float dum,mag2,*fft; + + fft=vector(1,n<<1); + for (i=1;i<=(m-1)/2;i++) + respns[n+1-i]=respns[m+1-i]; + for (i=(m+3)/2;i<=n-(m-1)/2;i++) + respns[i]=0.0; + twofft(data,respns,fft,ans,n); + no2=n>>1; + for (i=2;i<=n+2;i+=2) { + if (isign == 1) { + ans[i-1]=(fft[i-1]*(dum=ans[i-1])-fft[i]*ans[i])/no2; + ans[i]=(fft[i]*dum+fft[i-1]*ans[i])/no2; + } else if (isign == -1) { + if ((mag2=SQR(ans[i-1])+SQR(ans[i])) == 0.0) + nrerror("Deconvolving at response zero in convlv"); + ans[i-1]=(fft[i-1]*(dum=ans[i-1])+fft[i]*ans[i])/mag2/no2; + ans[i]=(fft[i]*dum-fft[i-1]*ans[i])/mag2/no2; + } else nrerror("No meaning for isign in convlv"); + } + ans[2]=ans[n+1]; + realft(ans,n,-1); + free_vector(fft,1,n<<1); +} diff --git a/lib/nr/k_and_r/recipes/copy.c b/lib/nr/k_and_r/recipes/copy.c new file mode 100644 index 0000000..756cb16 --- /dev/null +++ b/lib/nr/k_and_r/recipes/copy.c @@ -0,0 +1,11 @@ + +void copy(aout,ain,n) +double **ain,**aout; +int n; +{ + int i,j; + for (i=1;i<=n;i++) + for (j=1;j<=n;j++) + aout[j][i]=ain[j][i]; + +} diff --git a/lib/nr/k_and_r/recipes/correl.c b/lib/nr/k_and_r/recipes/correl.c new file mode 100644 index 0000000..83ca010 --- /dev/null +++ b/lib/nr/k_and_r/recipes/correl.c @@ -0,0 +1,22 @@ + +#include "nrutil.h" + +void correl(data1,data2,n,ans) +float ans[],data1[],data2[]; +unsigned long n; +{ + void realft(),twofft(); + unsigned long no2,i; + float dum,*fft; + + fft=vector(1,n<<1); + twofft(data1,data2,fft,ans,n); + no2=n>>1; + for (i=2;i<=n+2;i+=2) { + ans[i-1]=(fft[i-1]*(dum=ans[i-1])+fft[i]*ans[i])/no2; + ans[i]=(fft[i]*dum-fft[i-1]*ans[i])/no2; + } + ans[2]=ans[n+1]; + realft(ans,n,-1); + free_vector(fft,1,n<<1); +} diff --git a/lib/nr/k_and_r/recipes/cosft1.c b/lib/nr/k_and_r/recipes/cosft1.c new file mode 100644 index 0000000..d881b82 --- /dev/null +++ b/lib/nr/k_and_r/recipes/cosft1.c @@ -0,0 +1,38 @@ + +#include +#define PI 3.141592653589793 + +void cosft1(y,n) +float y[]; +int n; +{ + void realft(); + int j,n2; + float sum,y1,y2; + double theta,wi=0.0,wpi,wpr,wr=1.0,wtemp; + + theta=PI/n; + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + sum=0.5*(y[1]-y[n+1]); + y[1]=0.5*(y[1]+y[n+1]); + n2=n+2; + for (j=2;j<=(n>>1);j++) { + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + y1=0.5*(y[j]+y[n2-j]); + y2=(y[j]-y[n2-j]); + y[j]=y1-wi*y2; + y[n2-j]=y1+wi*y2; + sum += wr*y2; + } + realft(y,n,1); + y[n+1]=y[2]; + y[2]=sum; + for (j=4;j<=n;j+=2) { + sum += y[j]; + y[j]=sum; + } +} +#undef PI diff --git a/lib/nr/k_and_r/recipes/cosft2.c b/lib/nr/k_and_r/recipes/cosft2.c new file mode 100644 index 0000000..e922e14 --- /dev/null +++ b/lib/nr/k_and_r/recipes/cosft2.c @@ -0,0 +1,66 @@ + +#include +#define PI 3.141592653589793 + +void cosft2(y,n,isign) +float y[]; +int isign,n; +{ + void realft(); + int i; + float sum,sum1,y1,y2,ytemp; + double theta,wi=0.0,wi1,wpi,wpr,wr=1.0,wr1,wtemp; + + theta=0.5*PI/n; + wr1=cos(theta); + wi1=sin(theta); + wpr = -2.0*wi1*wi1; + wpi=sin(2.0*theta); + if (isign == 1) { + for (i=1;i<=n/2;i++) { + y1=0.5*(y[i]+y[n-i+1]); + y2=wi1*(y[i]-y[n-i+1]); + y[i]=y1+y2; + y[n-i+1]=y1-y2; + wr1=(wtemp=wr1)*wpr-wi1*wpi+wr1; + wi1=wi1*wpr+wtemp*wpi+wi1; + } + realft(y,n,1); + for (i=3;i<=n;i+=2) { + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + y1=y[i]*wr-y[i+1]*wi; + y2=y[i+1]*wr+y[i]*wi; + y[i]=y1; + y[i+1]=y2; + } + sum=0.5*y[2]; + for (i=n;i>=2;i-=2) { + sum1=sum; + sum += y[i]; + y[i]=sum1; + } + } else if (isign == -1) { + ytemp=y[n]; + for (i=n;i>=4;i-=2) y[i]=y[i-2]-y[i]; + y[2]=2.0*ytemp; + for (i=3;i<=n;i+=2) { + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + y1=y[i]*wr+y[i+1]*wi; + y2=y[i+1]*wr-y[i]*wi; + y[i]=y1; + y[i+1]=y2; + } + realft(y,n,-1); + for (i=1;i<=n/2;i++) { + y1=y[i]+y[n-i+1]; + y2=(0.5/wi1)*(y[i]-y[n-i+1]); + y[i]=0.5*(y1+y2); + y[n-i+1]=0.5*(y1-y2); + wr1=(wtemp=wr1)*wpr-wi1*wpi+wr1; + wi1=wi1*wpr+wtemp*wpi+wi1; + } + } +} +#undef PI diff --git a/lib/nr/k_and_r/recipes/covsrt.c b/lib/nr/k_and_r/recipes/covsrt.c new file mode 100644 index 0000000..a80217e --- /dev/null +++ b/lib/nr/k_and_r/recipes/covsrt.c @@ -0,0 +1,22 @@ + +#define SWAP(a,b) {swap=(a);(a)=(b);(b)=swap;} + +void covsrt(covar,ma,ia,mfit) +float **covar; +int ia[],ma,mfit; +{ + int i,j,k; + float swap; + + for (i=mfit+1;i<=ma;i++) + for (j=1;j<=i;j++) covar[i][j]=covar[j][i]=0.0; + k=mfit; + for (j=ma;j>=1;j--) { + if (ia[j]) { + for (i=1;i<=ma;i++) SWAP(covar[i][k],covar[i][j]) + for (i=1;i<=ma;i++) SWAP(covar[k][i],covar[j][i]) + k--; + } + } +} +#undef SWAP diff --git a/lib/nr/k_and_r/recipes/crank.c b/lib/nr/k_and_r/recipes/crank.c new file mode 100644 index 0000000..9f434ee --- /dev/null +++ b/lib/nr/k_and_r/recipes/crank.c @@ -0,0 +1,24 @@ + +void crank(n,w,s) +float *s,w[]; +unsigned long n; +{ + unsigned long j=1,ji,jt; + float t,rank; + + *s=0.0; + while (j < n) { + if (w[j+1] != w[j]) { + w[j]=j; + ++j; + } else { + for (jt=j+1;jt<=n && w[jt]==w[j];jt++); + rank=0.5*(j+jt-1); + for (ji=j;ji<=(jt-1);ji++) w[ji]=rank; + t=jt-j; + *s += t*t*t-t; + j=jt; + } + } + if (j == n) w[n]=n; +} diff --git a/lib/nr/k_and_r/recipes/cyclic.c b/lib/nr/k_and_r/recipes/cyclic.c new file mode 100644 index 0000000..9ce3df0 --- /dev/null +++ b/lib/nr/k_and_r/recipes/cyclic.c @@ -0,0 +1,31 @@ + +#include "nrutil.h" + +void cyclic(a,b,c,alpha,beta,r,x,n) +float a[],alpha,b[],beta,c[],r[],x[]; +unsigned long n; +{ + void tridag(); + unsigned long i; + float fact,gamma,*bb,*u,*z; + + if (n <= 2) nrerror("n too small in cyclic"); + bb=vector(1,n); + u=vector(1,n); + z=vector(1,n); + gamma = -b[1]; + bb[1]=b[1]-gamma; + bb[n]=b[n]-alpha*beta/gamma; + for (i=2;i> 1)+1; + if (isign >= 0) { + for (i=1,j=1;j<=n-3;j+=2,i++) { + wksp[i]=C0*a[j]+C1*a[j+1]+C2*a[j+2]+C3*a[j+3]; + wksp[i+nh] = C3*a[j]-C2*a[j+1]+C1*a[j+2]-C0*a[j+3]; + } + wksp[i]=C0*a[n-1]+C1*a[n]+C2*a[1]+C3*a[2]; + wksp[i+nh] = C3*a[n-1]-C2*a[n]+C1*a[1]-C0*a[2]; + } else { + wksp[1]=C2*a[nh]+C1*a[n]+C0*a[1]+C3*a[nh1]; + wksp[2] = C3*a[nh]-C0*a[n]+C1*a[1]-C2*a[nh1]; + for (i=1,j=3;i +#include "nrutil.h" +#define NMAX 6 +#define H 0.4 +#define A1 (2.0/3.0) +#define A2 0.4 +#define A3 (2.0/7.0) + +float dawson(x) +float x; +{ + int i,n0; + float d1,d2,e1,e2,sum,x2,xp,xx,ans; + static float c[NMAX+1]; + static int init = 0; + + if (init == 0) { + init=1; + for (i=1;i<=NMAX;i++) c[i]=exp(-SQR((2.0*i-1.0)*H)); + } + if (fabs(x) < 0.2) { + x2=x*x; + ans=x*(1.0-A1*x2*(1.0-A2*x2*(1.0-A3*x2))); + } else { + xx=fabs(x); + n0=2*(int)(0.5*xx/H+0.5); + xp=xx-n0*H; + e1=exp(2.0*xp*H); + e2=e1*e1; + d1=n0+1; + d2=d1-2.0; + sum=0.0; + for (i=1;i<=NMAX;i++,d1+=2.0,d2-=2.0,e1*=e2) + sum += c[i]*(e1/d1+1.0/(d2*e1)); + ans=0.5641895835*SIGN(exp(-xp*xp),x)*sum; + } + return ans; +} +#undef NMAX +#undef H +#undef A1 +#undef A2 +#undef A3 diff --git a/lib/nr/k_and_r/recipes/dbrent.c b/lib/nr/k_and_r/recipes/dbrent.c new file mode 100644 index 0000000..b935c72 --- /dev/null +++ b/lib/nr/k_and_r/recipes/dbrent.c @@ -0,0 +1,91 @@ + +#include +#include "nrutil.h" +#define ITMAX 100 +#define ZEPS 1.0e-10 +#define MOV3(a,b,c, d,e,f) (a)=(d);(b)=(e);(c)=(f); + +float dbrent(ax,bx,cx,f,df,tol,xmin) +float (*df)(),(*f)(),*xmin,ax,bx,cx,tol; +{ + int iter,ok1,ok2; + float a,b,d,d1,d2,du,dv,dw,dx,e=0.0; + float fu,fv,fw,fx,olde,tol1,tol2,u,u1,u2,v,w,x,xm; + + a=(ax < cx ? ax : cx); + b=(ax > cx ? ax : cx); + x=w=v=bx; + fw=fv=fx=(*f)(x); + dw=dv=dx=(*df)(x); + for (iter=1;iter<=ITMAX;iter++) { + xm=0.5*(a+b); + tol1=tol*fabs(x)+ZEPS; + tol2=2.0*tol1; + if (fabs(x-xm) <= (tol2-0.5*(b-a))) { + *xmin=x; + return fx; + } + if (fabs(e) > tol1) { + d1=2.0*(b-a); + d2=d1; + if (dw != dx) d1=(w-x)*dx/(dx-dw); + if (dv != dx) d2=(v-x)*dx/(dx-dv); + u1=x+d1; + u2=x+d2; + ok1 = (a-u1)*(u1-b) > 0.0 && dx*d1 <= 0.0; + ok2 = (a-u2)*(u2-b) > 0.0 && dx*d2 <= 0.0; + olde=e; + e=d; + if (ok1 || ok2) { + if (ok1 && ok2) + d=(fabs(d1) < fabs(d2) ? d1 : d2); + else if (ok1) + d=d1; + else + d=d2; + if (fabs(d) <= fabs(0.5*olde)) { + u=x+d; + if (u-a < tol2 || b-u < tol2) + d=SIGN(tol1,xm-x); + } else { + d=0.5*(e=(dx >= 0.0 ? a-x : b-x)); + } + } else { + d=0.5*(e=(dx >= 0.0 ? a-x : b-x)); + } + } else { + d=0.5*(e=(dx >= 0.0 ? a-x : b-x)); + } + if (fabs(d) >= tol1) { + u=x+d; + fu=(*f)(u); + } else { + u=x+SIGN(tol1,d); + fu=(*f)(u); + if (fu > fx) { + *xmin=x; + return fx; + } + } + du=(*df)(u); + if (fu <= fx) { + if (u >= x) a=x; else b=x; + MOV3(v,fv,dv, w,fw,dw) + MOV3(w,fw,dw, x,fx,dx) + MOV3(x,fx,dx, u,fu,du) + } else { + if (u < x) a=u; else b=u; + if (fu <= fw || w == x) { + MOV3(v,fv,dv, w,fw,dw) + MOV3(w,fw,dw, u,fu,du) + } else if (fu < fv || v == x || v == w) { + MOV3(v,fv,dv, u,fu,du) + } + } + } + nrerror("Too many iterations in routine dbrent"); + return 0.0; +} +#undef ITMAX +#undef ZEPS +#undef MOV3 diff --git a/lib/nr/k_and_r/recipes/ddpoly.c b/lib/nr/k_and_r/recipes/ddpoly.c new file mode 100644 index 0000000..a52bf2e --- /dev/null +++ b/lib/nr/k_and_r/recipes/ddpoly.c @@ -0,0 +1,21 @@ + +void ddpoly(c,nc,x,pd,nd) +float c[],pd[],x; +int nc,nd; +{ + int nnd,j,i; + float cnst=1.0; + + pd[0]=c[nc]; + for (j=1;j<=nd;j++) pd[j]=0.0; + for (i=nc-1;i>=0;i--) { + nnd=(nd < (nc-i) ? nd : nc-i); + for (j=nnd;j>=1;j--) + pd[j]=pd[j]*x+pd[j-1]; + pd[0]=pd[0]*x+c[i]; + } + for (i=2;i<=nd;i++) { + cnst *= i; + pd[i] *= cnst; + } +} diff --git a/lib/nr/k_and_r/recipes/decchk.c b/lib/nr/k_and_r/recipes/decchk.c new file mode 100644 index 0000000..dfb7536 --- /dev/null +++ b/lib/nr/k_and_r/recipes/decchk.c @@ -0,0 +1,25 @@ + +int decchk(string,n,ch) +char *ch,string[]; +int n; +{ + char c; + int j,k=0,m=0; + static int ip[10][8]={0,1,5,8,9,4,2,7,1,5, 8,9,4,2,7,0,2,7,0,1, + 5,8,9,4,3,6,3,6,3,6, 3,6,4,2,7,0,1,5,8,9, 5,8,9,4,2,7,0,1,6,3, + 6,3,6,3,6,3,7,0,1,5, 8,9,4,2,8,9,4,2,7,0, 1,5,9,4,2,7,0,1,5,8}; + static int ij[10][10]={0,1,2,3,4,5,6,7,8,9, 1,2,3,4,0,6,7,8,9,5, + 2,3,4,0,1,7,8,9,5,6, 3,4,0,1,2,8,9,5,6,7, 4,0,1,2,3,9,5,6,7,8, + 5,9,8,7,6,0,4,3,2,1, 6,5,9,8,7,1,0,4,3,2, 7,6,5,9,8,2,1,0,4,3, + 8,7,6,5,9,3,2,1,0,4, 9,8,7,6,5,4,3,2,1,0}; + + for (j=0;j= 48 && c <= 57) + k=ij[k][ip[(c+2) % 10][7 & m++]]; + } + for (j=0;j<=9;j++) + if (!ij[k][ip[j][m & 7]]) break; + *ch=j+48; + return k==0; +} diff --git a/lib/nr/k_and_r/recipes/df1dim.c b/lib/nr/k_and_r/recipes/df1dim.c new file mode 100644 index 0000000..1707695 --- /dev/null +++ b/lib/nr/k_and_r/recipes/df1dim.c @@ -0,0 +1,23 @@ + +#include "nrutil.h" + +extern int ncom; +extern float *pcom,*xicom,(*nrfunc)(); +extern void (*nrdfun)(); + +float df1dim(x) +float x; +{ + int j; + float df1=0.0; + float *xt,*df; + + xt=vector(1,ncom); + df=vector(1,ncom); + for (j=1;j<=ncom;j++) xt[j]=pcom[j]+x*xicom[j]; + (*nrdfun)(xt,df); + for (j=1;j<=ncom;j++) df1 += df[j]*xicom[j]; + free_vector(df,1,ncom); + free_vector(xt,1,ncom); + return df1; +} diff --git a/lib/nr/k_and_r/recipes/dfour1.c b/lib/nr/k_and_r/recipes/dfour1.c new file mode 100644 index 0000000..0f03a61 --- /dev/null +++ b/lib/nr/k_and_r/recipes/dfour1.c @@ -0,0 +1,53 @@ + +#include +#define SWAP(a,b) tempr=(a);(a)=(b);(b)=tempr + +void dfour1(data,nn,isign) +double data[]; +int isign; +unsigned long nn; +{ + unsigned long n,mmax,m,j,istep,i; + double wtemp,wr,wpr,wpi,wi,theta; + double tempr,tempi; + + n=nn << 1; + j=1; + for (i=1;i i) { + SWAP(data[j],data[i]); + SWAP(data[j+1],data[i+1]); + } + m=n >> 1; + while (m >= 2 && j > m) { + j -= m; + m >>= 1; + } + j += m; + } + mmax=2; + while (n > mmax) { + istep=mmax << 1; + theta=isign*(6.28318530717959/mmax); + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0; + wi=0.0; + for (m=1;m +#include "nrutil.h" +#define ITMAX 200 +#define EPS 3.0e-8 +#define TOLX (4*EPS) +#define STPMX 100.0 + +#define FREEALL free_vector(xi,1,n);free_vector(pnew,1,n); \ +free_matrix(hessin,1,n,1,n);free_vector(hdg,1,n);free_vector(g,1,n); \ +free_vector(dg,1,n); + +void dfpmin(p,n,gtol,iter,fret,func,dfunc) +float (*func)(),*fret,gtol,p[]; +int *iter,n; +void (*dfunc)(); +{ + void lnsrch(); + int check,i,its,j; + float den,fac,fad,fae,fp,stpmax,sum=0.0,sumdg,sumxi,temp,test; + float *dg,*g,*hdg,**hessin,*pnew,*xi; + + dg=vector(1,n); + g=vector(1,n); + hdg=vector(1,n); + hessin=matrix(1,n,1,n); + pnew=vector(1,n); + xi=vector(1,n); + fp=(*func)(p); + (*dfunc)(p,g); + for (i=1;i<=n;i++) { + for (j=1;j<=n;j++) hessin[i][j]=0.0; + hessin[i][i]=1.0; + xi[i] = -g[i]; + sum += p[i]*p[i]; + } + stpmax=STPMX*FMAX(sqrt(sum),(float)n); + for (its=1;its<=ITMAX;its++) { + *iter=its; + lnsrch(n,p,fp,g,xi,pnew,fret,stpmax,&check,func); + fp = *fret; + for (i=1;i<=n;i++) { + xi[i]=pnew[i]-p[i]; + p[i]=pnew[i]; + } + test=0.0; + for (i=1;i<=n;i++) { + temp=fabs(xi[i])/FMAX(fabs(p[i]),1.0); + if (temp > test) test=temp; + } + if (test < TOLX) { + FREEALL + return; + } + for (i=1;i<=n;i++) dg[i]=g[i]; + (*dfunc)(p,g); + test=0.0; + den=FMAX(*fret,1.0); + for (i=1;i<=n;i++) { + temp=fabs(g[i])*FMAX(fabs(p[i]),1.0)/den; + if (temp > test) test=temp; + } + if (test < gtol) { + FREEALL + return; + } + for (i=1;i<=n;i++) dg[i]=g[i]-dg[i]; + for (i=1;i<=n;i++) { + hdg[i]=0.0; + for (j=1;j<=n;j++) hdg[i] += hessin[i][j]*dg[j]; + } + fac=fae=sumdg=sumxi=0.0; + for (i=1;i<=n;i++) { + fac += dg[i]*xi[i]; + fae += dg[i]*hdg[i]; + sumdg += SQR(dg[i]); + sumxi += SQR(xi[i]); + } + if (fac > sqrt(EPS*sumdg*sumxi)) { + fac=1.0/fac; + fad=1.0/fae; + for (i=1;i<=n;i++) dg[i]=fac*xi[i]-fad*hdg[i]; + for (i=1;i<=n;i++) { + for (j=i;j<=n;j++) { + hessin[i][j] += fac*xi[i]*xi[j] + -fad*hdg[i]*hdg[j]+fae*dg[i]*dg[j]; + hessin[j][i]=hessin[i][j]; + } + } + } + for (i=1;i<=n;i++) { + xi[i]=0.0; + for (j=1;j<=n;j++) xi[i] -= hessin[i][j]*g[j]; + } + } + nrerror("too many iterations in dfpmin"); + FREEALL +} +#undef ITMAX +#undef EPS +#undef TOLX +#undef STPMX +#undef FREEALL diff --git a/lib/nr/k_and_r/recipes/dfridr.c b/lib/nr/k_and_r/recipes/dfridr.c new file mode 100644 index 0000000..55867c5 --- /dev/null +++ b/lib/nr/k_and_r/recipes/dfridr.c @@ -0,0 +1,43 @@ + +#include +#include "nrutil.h" +#define CON 1.4 +#define CON2 (CON*CON) +#define BIG 1.0e30 +#define NTAB 10 +#define SAFE 2.0 + +float dfridr(func,x,h,err) +float (*func)(),*err,h,x; +{ + int i,j; + float errt,fac,hh,**a,ans; + + if (h == 0.0) nrerror("h must be nonzero in dfridr."); + a=matrix(1,NTAB,1,NTAB); + hh=h; + a[1][1]=((*func)(x+hh)-(*func)(x-hh))/(2.0*hh); + *err=BIG; + for (i=2;i<=NTAB;i++) { + hh /= CON; + a[1][i]=((*func)(x+hh)-(*func)(x-hh))/(2.0*hh); + fac=CON2; + for (j=2;j<=i;j++) { + a[j][i]=(a[j-1][i]*fac-a[j-1][i-1])/(fac-1.0); + fac=CON2*fac; + errt=FMAX(fabs(a[j][i]-a[j-1][i]),fabs(a[j][i]-a[j-1][i-1])); + if (errt <= *err) { + *err=errt; + ans=a[j][i]; + } + } + if (fabs(a[i][i]-a[i-1][i-1]) >= SAFE*(*err)) break; + } + free_matrix(a,1,NTAB,1,NTAB); + return ans; +} +#undef CON +#undef CON2 +#undef BIG +#undef NTAB +#undef SAFE diff --git a/lib/nr/k_and_r/recipes/dftcor.c b/lib/nr/k_and_r/recipes/dftcor.c new file mode 100644 index 0000000..f85ed78 --- /dev/null +++ b/lib/nr/k_and_r/recipes/dftcor.c @@ -0,0 +1,58 @@ + +#include + +void dftcor(w,delta,a,b,endpts,corre,corim,corfac) +float *corfac,*corim,*corre,a,b,delta,endpts[],w; +{ + void nrerror(); + float a0i,a0r,a1i,a1r,a2i,a2r,a3i,a3r,arg,c,cl,cr,s,sl,sr,t; + float t2,t4,t6; + double cth,ctth,spth2,sth,sth4i,stth,th,th2,th4,tmth2,tth4i; + + th=w*delta; + if (a >= b || th < 0.0e0 || th > 3.1416e0) nrerror("bad arguments to dftcor"); + if (fabs(th) < 5.0e-2) { + t=th; + t2=t*t; + t4=t2*t2; + t6=t4*t2; + *corfac=1.0-(11.0/720.0)*t4+(23.0/15120.0)*t6; + a0r=(-2.0/3.0)+t2/45.0+(103.0/15120.0)*t4-(169.0/226800.0)*t6; + a1r=(7.0/24.0)-(7.0/180.0)*t2+(5.0/3456.0)*t4-(7.0/259200.0)*t6; + a2r=(-1.0/6.0)+t2/45.0-(5.0/6048.0)*t4+t6/64800.0; + a3r=(1.0/24.0)-t2/180.0+(5.0/24192.0)*t4-t6/259200.0; + a0i=t*(2.0/45.0+(2.0/105.0)*t2-(8.0/2835.0)*t4+(86.0/467775.0)*t6); + a1i=t*(7.0/72.0-t2/168.0+(11.0/72576.0)*t4-(13.0/5987520.0)*t6); + a2i=t*(-7.0/90.0+t2/210.0-(11.0/90720.0)*t4+(13.0/7484400.0)*t6); + a3i=t*(7.0/360.0-t2/840.0+(11.0/362880.0)*t4-(13.0/29937600.0)*t6); + } else { + cth=cos(th); + sth=sin(th); + ctth=cth*cth-sth*sth; + stth=2.0e0*sth*cth; + th2=th*th; + th4=th2*th2; + tmth2=3.0e0-th2; + spth2=6.0e0+th2; + sth4i=1.0/(6.0e0*th4); + tth4i=2.0e0*sth4i; + *corfac=tth4i*spth2*(3.0e0-4.0e0*cth+ctth); + a0r=sth4i*(-42.0e0+5.0e0*th2+spth2*(8.0e0*cth-ctth)); + a0i=sth4i*(th*(-12.0e0+6.0e0*th2)+spth2*stth); + a1r=sth4i*(14.0e0*tmth2-7.0e0*spth2*cth); + a1i=sth4i*(30.0e0*th-5.0e0*spth2*sth); + a2r=tth4i*(-4.0e0*tmth2+2.0e0*spth2*cth); + a2i=tth4i*(-12.0e0*th+2.0e0*spth2*sth); + a3r=sth4i*(2.0e0*tmth2-spth2*cth); + a3i=sth4i*(6.0e0*th-spth2*sth); + } + cl=a0r*endpts[1]+a1r*endpts[2]+a2r*endpts[3]+a3r*endpts[4]; + sl=a0i*endpts[1]+a1i*endpts[2]+a2i*endpts[3]+a3i*endpts[4]; + cr=a0r*endpts[8]+a1r*endpts[7]+a2r*endpts[6]+a3r*endpts[5]; + sr = -a0i*endpts[8]-a1i*endpts[7]-a2i*endpts[6]-a3i*endpts[5]; + arg=w*(b-a); + c=cos(arg); + s=sin(arg); + *corre=cl+c*cr-s*sr; + *corim=sl+s*cr+c*sr; +} diff --git a/lib/nr/k_and_r/recipes/dftint.c b/lib/nr/k_and_r/recipes/dftint.c new file mode 100644 index 0000000..68a28c5 --- /dev/null +++ b/lib/nr/k_and_r/recipes/dftint.c @@ -0,0 +1,65 @@ + +#include +#include "nrutil.h" +#define M 64 +#define NDFT 1024 +#define MPOL 6 +#define TWOPI (2.0*3.14159265) + +void dftint(func,a,b,w,cosint,sinint) +float (*func)(),*cosint,*sinint,a,b,w; +{ + void dftcor(),polint(),realft(); + static int init=0; + int j,nn; + static float aold = -1.e30,bold = -1.e30,delta,(*funcold)(); + static float data[NDFT+1],endpts[9]; + float c,cdft,cerr,corfac,corim,corre,en,s; + float sdft,serr,*cpol,*spol,*xpol; + + cpol=vector(1,MPOL); + spol=vector(1,MPOL); + xpol=vector(1,MPOL); + if (init != 1 || a != aold || b != bold || func != funcold) { + init=1; + aold=a; + bold=b; + funcold=func; + delta=(b-a)/M; + for (j=1;j<=M+1;j++) + data[j]=(*func)(a+(j-1)*delta); + for (j=M+2;j<=NDFT;j++) + data[j]=0.0; + for (j=1;j<=4;j++) { + endpts[j]=data[j]; + endpts[j+4]=data[M-3+j]; + } + realft(data,NDFT,1); + data[2]=0.0; + } + en=w*delta*NDFT/TWOPI+1.0; + nn=IMIN(IMAX((int)(en-0.5*MPOL+1.0),1),NDFT/2-MPOL+1); + for (j=1;j<=MPOL;j++,nn++) { + cpol[j]=data[2*nn-1]; + spol[j]=data[2*nn]; + xpol[j]=nn; + } + polint(xpol,cpol,MPOL,en,&cdft,&cerr); + polint(xpol,spol,MPOL,en,&sdft,&serr); + dftcor(w,delta,a,b,endpts,&corre,&corim,&corfac); + cdft *= corfac; + sdft *= corfac; + cdft += corre; + sdft += corim; + c=delta*cos(w*a); + s=delta*sin(w*a); + *cosint=c*cdft-s*sdft; + *sinint=s*cdft+c*sdft; + free_vector(cpol,1,MPOL); + free_vector(spol,1,MPOL); + free_vector(xpol,1,MPOL); +} +#undef M +#undef NDFT +#undef MPOL +#undef TWOPI diff --git a/lib/nr/k_and_r/recipes/difeq.c b/lib/nr/k_and_r/recipes/difeq.c new file mode 100644 index 0000000..fbfbf5c --- /dev/null +++ b/lib/nr/k_and_r/recipes/difeq.c @@ -0,0 +1,60 @@ + +extern int mm,n,mpt; +extern float h,c2,anorm,x[]; + +void difeq(k,k1,k2,jsf,is1,isf,indexv,ne,s,y) +float **s,**y; +int indexv[],is1,isf,jsf,k,k1,k2,ne; +{ + float temp,temp1,temp2; + + if (k == k1) { + if (n+mm & 1) { + s[3][3+indexv[1]]=1.0; + s[3][3+indexv[2]]=0.0; + s[3][3+indexv[3]]=0.0; + s[3][jsf]=y[1][1]; + } else { + s[3][3+indexv[1]]=0.0; + s[3][3+indexv[2]]=1.0; + s[3][3+indexv[3]]=0.0; + s[3][jsf]=y[2][1]; + } + } else if (k > k2) { + s[1][3+indexv[1]] = -(y[3][mpt]-c2)/(2.0*(mm+1.0)); + s[1][3+indexv[2]]=1.0; + s[1][3+indexv[3]] = -y[1][mpt]/(2.0*(mm+1.0)); + s[1][jsf]=y[2][mpt]-(y[3][mpt]-c2)*y[1][mpt]/(2.0*(mm+1.0)); + s[2][3+indexv[1]]=1.0; + s[2][3+indexv[2]]=0.0; + s[2][3+indexv[3]]=0.0; + s[2][jsf]=y[1][mpt]-anorm; + } else { + s[1][indexv[1]] = -1.0; + s[1][indexv[2]] = -0.5*h; + s[1][indexv[3]]=0.0; + s[1][3+indexv[1]]=1.0; + s[1][3+indexv[2]] = -0.5*h; + s[1][3+indexv[3]]=0.0; + temp1=x[k]+x[k-1]; + temp=h/(1.0-temp1*temp1*0.25); + temp2=0.5*(y[3][k]+y[3][k-1])-c2*0.25*temp1*temp1; + s[2][indexv[1]]=temp*temp2*0.5; + s[2][indexv[2]] = -1.0-0.5*temp*(mm+1.0)*temp1; + s[2][indexv[3]]=0.25*temp*(y[1][k]+y[1][k-1]); + s[2][3+indexv[1]]=s[2][indexv[1]]; + s[2][3+indexv[2]]=2.0+s[2][indexv[2]]; + s[2][3+indexv[3]]=s[2][indexv[3]]; + s[3][indexv[1]]=0.0; + s[3][indexv[2]]=0.0; + s[3][indexv[3]] = -1.0; + s[3][3+indexv[1]]=0.0; + s[3][3+indexv[2]]=0.0; + s[3][3+indexv[3]]=1.0; + s[1][jsf]=y[1][k]-y[1][k-1]-0.5*h*(y[2][k]+y[2][k-1]); + s[2][jsf]=y[2][k]-y[2][k-1]-temp*((x[k]+x[k-1]) + *0.5*(mm+1.0)*(y[2][k]+y[2][k-1])-temp2 + *0.5*(y[1][k]+y[1][k-1])); + s[3][jsf]=y[3][k]-y[3][k-1]; + } +} diff --git a/lib/nr/k_and_r/recipes/dlinmin.c b/lib/nr/k_and_r/recipes/dlinmin.c new file mode 100644 index 0000000..379c4a3 --- /dev/null +++ b/lib/nr/k_and_r/recipes/dlinmin.c @@ -0,0 +1,39 @@ + +#include "nrutil.h" +#define TOL 2.0e-4 + +int ncom; +float *pcom,*xicom,(*nrfunc)(); +void (*nrdfun)(); + +void dlinmin(p,xi,n,fret,func,dfunc) +float (*func)(),*fret,p[],xi[]; +int n; +void (*dfunc)(); +{ + float dbrent(),df1dim(),f1dim(); + void mnbrak(); + int j; + float xx,xmin,fx,fb,fa,bx,ax; + + ncom=n; + pcom=vector(1,n); + xicom=vector(1,n); + nrfunc=func; + nrdfun=dfunc; + for (j=1;j<=n;j++) { + pcom[j]=p[j]; + xicom[j]=xi[j]; + } + ax=0.0; + xx=1.0; + mnbrak(&ax,&xx,&bx,&fa,&fx,&fb,f1dim); + *fret=dbrent(ax,xx,bx,f1dim,df1dim,TOL,&xmin); + for (j=1;j<=n;j++) { + xi[j] *= xmin; + p[j] += xi[j]; + } + free_vector(xicom,1,n); + free_vector(pcom,1,n); +} +#undef TOL diff --git a/lib/nr/k_and_r/recipes/dpythag.c b/lib/nr/k_and_r/recipes/dpythag.c new file mode 100644 index 0000000..501163a --- /dev/null +++ b/lib/nr/k_and_r/recipes/dpythag.c @@ -0,0 +1,13 @@ + +#include +#include "nrutil.h" + +double dpythag(a,b) +double a,b; +{ + double absa,absb; + absa=fabs(a); + absb=fabs(b); + if (absa > absb) return absa*sqrt(1.0+DSQR(absb/absa)); + else return (absb == 0.0 ? 0.0 : absb*sqrt(1.0+DSQR(absa/absb))); +} diff --git a/lib/nr/k_and_r/recipes/drealft.c b/lib/nr/k_and_r/recipes/drealft.c new file mode 100644 index 0000000..8ff6b90 --- /dev/null +++ b/lib/nr/k_and_r/recipes/drealft.c @@ -0,0 +1,49 @@ + +#include + +void drealft(data,n,isign) +double data[]; +int isign; +unsigned long n; +{ + void dfour1(); + unsigned long i,i1,i2,i3,i4,np3; + double c1=0.5,c2,h1r,h1i,h2r,h2i; + double wr,wi,wpr,wpi,wtemp,theta; + + theta=3.141592653589793/(double) (n>>1); + if (isign == 1) { + c2 = -0.5; + dfour1(data,n>>1,1); + } else { + c2=0.5; + theta = -theta; + } + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0+wpr; + wi=wpi; + np3=n+3; + for (i=2;i<=(n>>2);i++) { + i4=1+(i3=np3-(i2=1+(i1=i+i-1))); + h1r=c1*(data[i1]+data[i3]); + h1i=c1*(data[i2]-data[i4]); + h2r = -c2*(data[i2]+data[i4]); + h2i=c2*(data[i1]-data[i3]); + data[i1]=h1r+wr*h2r-wi*h2i; + data[i2]=h1i+wr*h2i+wi*h2r; + data[i3]=h1r-wr*h2r+wi*h2i; + data[i4] = -h1i+wr*h2i+wi*h2r; + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + } + if (isign == 1) { + data[1] = (h1r=data[1])+data[2]; + data[2] = h1r-data[2]; + } else { + data[1]=c1*((h1r=data[1])+data[2]); + data[2]=c1*(h1r-data[2]); + dfour1(data,n>>1,-1); + } +} diff --git a/lib/nr/k_and_r/recipes/dsprsax.c b/lib/nr/k_and_r/recipes/dsprsax.c new file mode 100644 index 0000000..8d73811 --- /dev/null +++ b/lib/nr/k_and_r/recipes/dsprsax.c @@ -0,0 +1,14 @@ + +void dsprsax(sa,ija,x,b,n) +double b[],sa[],x[]; +unsigned long ija[],n; +{ + void nrerror(); + unsigned long i,k; + + if (ija[1] != n+2) nrerror("dsprsax: mismatched vector and matrix"); + for (i=1;i<=n;i++) { + b[i]=sa[i]*x[i]; + for (k=ija[i];k<=ija[i+1]-1;k++) b[i] += sa[k]*x[ija[k]]; + } +} diff --git a/lib/nr/k_and_r/recipes/dsprstx.c b/lib/nr/k_and_r/recipes/dsprstx.c new file mode 100644 index 0000000..aae40ae --- /dev/null +++ b/lib/nr/k_and_r/recipes/dsprstx.c @@ -0,0 +1,16 @@ + +void dsprstx(sa,ija,x,b,n) +double b[],sa[],x[]; +unsigned long ija[],n; +{ + void nrerror(); + unsigned long i,j,k; + if (ija[1] != n+2) nrerror("mismatched vector and matrix in dsprstx"); + for (i=1;i<=n;i++) b[i]=sa[i]*x[i]; + for (i=1;i<=n;i++) { + for (k=ija[i];k<=ija[i+1]-1;k++) { + j=ija[k]; + b[j] += sa[k]*x[i]; + } + } +} diff --git a/lib/nr/k_and_r/recipes/dsvbksb.c b/lib/nr/k_and_r/recipes/dsvbksb.c new file mode 100644 index 0000000..8a9b03a --- /dev/null +++ b/lib/nr/k_and_r/recipes/dsvbksb.c @@ -0,0 +1,26 @@ + +#include "nrutil.h" + +void dsvbksb(u,w,v,m,n,b,x) +double **u,**v,b[],w[],x[]; +int m,n; +{ + int jj,j,i; + double s,*tmp; + + tmp=dvector(1,n); + for (j=1;j<=n;j++) { + s=0.0; + if (w[j]) { + for (i=1;i<=m;i++) s += u[i][j]*b[i]; + s /= w[j]; + } + tmp[j]=s; + } + for (j=1;j<=n;j++) { + s=0.0; + for (jj=1;jj<=n;jj++) s += v[j][jj]*tmp[jj]; + x[j]=s; + } + free_dvector(tmp,1,n); +} diff --git a/lib/nr/k_and_r/recipes/dsvdcmp.c b/lib/nr/k_and_r/recipes/dsvdcmp.c new file mode 100644 index 0000000..310b835 --- /dev/null +++ b/lib/nr/k_and_r/recipes/dsvdcmp.c @@ -0,0 +1,183 @@ + +#include +#include "nrutil.h" + +void dsvdcmp(a,m,n,w,v) +double **a,**v,w[]; +int m,n; +{ + double dpythag(); + int flag,i,its,j,jj,k,l,nm; + double anorm,c,f,g,h,s,scale,x,y,z,*rv1; + + rv1=dvector(1,n); + g=scale=anorm=0.0; + for (i=1;i<=n;i++) { + l=i+1; + rv1[i]=scale*g; + g=s=scale=0.0; + if (i <= m) { + for (k=i;k<=m;k++) scale += fabs(a[k][i]); + if (scale) { + for (k=i;k<=m;k++) { + a[k][i] /= scale; + s += a[k][i]*a[k][i]; + } + f=a[i][i]; + g = -SIGN(sqrt(s),f); + h=f*g-s; + a[i][i]=f-g; + for (j=l;j<=n;j++) { + for (s=0.0,k=i;k<=m;k++) s += a[k][i]*a[k][j]; + f=s/h; + for (k=i;k<=m;k++) a[k][j] += f*a[k][i]; + } + for (k=i;k<=m;k++) a[k][i] *= scale; + } + } + w[i]=scale *g; + g=s=scale=0.0; + if (i <= m && i != n) { + for (k=l;k<=n;k++) scale += fabs(a[i][k]); + if (scale) { + for (k=l;k<=n;k++) { + a[i][k] /= scale; + s += a[i][k]*a[i][k]; + } + f=a[i][l]; + g = -SIGN(sqrt(s),f); + h=f*g-s; + a[i][l]=f-g; + for (k=l;k<=n;k++) rv1[k]=a[i][k]/h; + for (j=l;j<=m;j++) { + for (s=0.0,k=l;k<=n;k++) s += a[j][k]*a[i][k]; + for (k=l;k<=n;k++) a[j][k] += s*rv1[k]; + } + for (k=l;k<=n;k++) a[i][k] *= scale; + } + } + anorm=DMAX(anorm,(fabs(w[i])+fabs(rv1[i]))); + } + for (i=n;i>=1;i--) { + if (i < n) { + if (g) { + for (j=l;j<=n;j++) v[j][i]=(a[i][j]/a[i][l])/g; + for (j=l;j<=n;j++) { + for (s=0.0,k=l;k<=n;k++) s += a[i][k]*v[k][j]; + for (k=l;k<=n;k++) v[k][j] += s*v[k][i]; + } + } + for (j=l;j<=n;j++) v[i][j]=v[j][i]=0.0; + } + v[i][i]=1.0; + g=rv1[i]; + l=i; + } + for (i=IMIN(m,n);i>=1;i--) { + l=i+1; + g=w[i]; + for (j=l;j<=n;j++) a[i][j]=0.0; + if (g) { + g=1.0/g; + for (j=l;j<=n;j++) { + for (s=0.0,k=l;k<=m;k++) s += a[k][i]*a[k][j]; + f=(s/a[i][i])*g; + for (k=i;k<=m;k++) a[k][j] += f*a[k][i]; + } + for (j=i;j<=m;j++) a[j][i] *= g; + } else for (j=i;j<=m;j++) a[j][i]=0.0; + ++a[i][i]; + } + for (k=n;k>=1;k--) { + for (its=1;its<=30;its++) { + flag=1; + for (l=k;l>=1;l--) { + nm=l-1; + if ((double)(fabs(rv1[l])+anorm) == anorm) { + flag=0; + break; + } + if ((double)(fabs(w[nm])+anorm) == anorm) break; + } + if (flag) { + c=0.0; + s=1.0; + for (i=l;i<=k;i++) { + f=s*rv1[i]; + rv1[i]=c*rv1[i]; + if ((double)(fabs(f)+anorm) == anorm) break; + g=w[i]; + h=dpythag(f,g); + w[i]=h; + h=1.0/h; + c=g*h; + s = -f*h; + for (j=1;j<=m;j++) { + y=a[j][nm]; + z=a[j][i]; + a[j][nm]=y*c+z*s; + a[j][i]=z*c-y*s; + } + } + } + z=w[k]; + if (l == k) { + if (z < 0.0) { + w[k] = -z; + for (j=1;j<=n;j++) v[j][k] = -v[j][k]; + } + break; + } + if (its == 30) nrerror("no convergence in 30 dsvdcmp iterations"); + x=w[l]; + nm=k-1; + y=w[nm]; + g=rv1[nm]; + h=rv1[k]; + f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y); + g=dpythag(f,1.0); + f=((x-z)*(x+z)+h*((y/(f+SIGN(g,f)))-h))/x; + c=s=1.0; + for (j=l;j<=nm;j++) { + i=j+1; + g=rv1[i]; + y=w[i]; + h=s*g; + g=c*g; + z=dpythag(f,h); + rv1[j]=z; + c=f/z; + s=h/z; + f=x*c+g*s; + g = g*c-x*s; + h=y*s; + y *= c; + for (jj=1;jj<=n;jj++) { + x=v[jj][j]; + z=v[jj][i]; + v[jj][j]=x*c+z*s; + v[jj][i]=z*c-x*s; + } + z=dpythag(f,h); + w[j]=z; + if (z) { + z=1.0/z; + c=f*z; + s=h*z; + } + f=c*g+s*y; + x=c*y-s*g; + for (jj=1;jj<=m;jj++) { + y=a[jj][j]; + z=a[jj][i]; + a[jj][j]=y*c+z*s; + a[jj][i]=z*c-y*s; + } + } + rv1[l]=0.0; + rv1[k]=f; + w[k]=x; + } + } + free_dvector(rv1,1,n); +} diff --git a/lib/nr/k_and_r/recipes/eclass.c b/lib/nr/k_and_r/recipes/eclass.c new file mode 100644 index 0000000..3a219eb --- /dev/null +++ b/lib/nr/k_and_r/recipes/eclass.c @@ -0,0 +1,17 @@ + +void eclass(nf,n,lista,listb,m) +int lista[],listb[],m,n,nf[]; +{ + int l,k,j; + + for (k=1;k<=n;k++) nf[k]=k; + for (l=1;l<=m;l++) { + j=lista[l]; + while (nf[j] != j) j=nf[j]; + k=listb[l]; + while (nf[k] != k) k=nf[k]; + if (j != k) nf[j]=k; + } + for (j=1;j<=n;j++) + while (nf[j] != nf[nf[j]]) nf[j]=nf[nf[j]]; +} diff --git a/lib/nr/k_and_r/recipes/eclazz.c b/lib/nr/k_and_r/recipes/eclazz.c new file mode 100644 index 0000000..b6b324d --- /dev/null +++ b/lib/nr/k_and_r/recipes/eclazz.c @@ -0,0 +1,16 @@ + +void eclazz(nf,n,equiv) +int (*equiv)(),n,nf[]; +{ + int kk,jj; + + nf[1]=1; + for (jj=2;jj<=n;jj++) { + nf[jj]=jj; + for (kk=1;kk<=(jj-1);kk++) { + nf[kk]=nf[nf[kk]]; + if ((*equiv)(jj,kk)) nf[nf[nf[kk]]]=jj; + } + } + for (jj=1;jj<=n;jj++) nf[jj]=nf[nf[jj]]; +} diff --git a/lib/nr/k_and_r/recipes/ei.c b/lib/nr/k_and_r/recipes/ei.c new file mode 100644 index 0000000..5f7b72f --- /dev/null +++ b/lib/nr/k_and_r/recipes/ei.c @@ -0,0 +1,47 @@ + +#include +#define EULER 0.57721566 +#define MAXIT 100 +#define FPMIN 1.0e-30 +#define EPS 6.0e-8 + +float ei(x) +float x; +{ + void nrerror(); + int k; + float fact,prev,sum,term; + + if (x <= 0.0) nrerror("Bad argument in ei"); + if (x < FPMIN) return log(x)+EULER; + if (x <= -log(EPS)) { + sum=0.0; + fact=1.0; + for (k=1;k<=MAXIT;k++) { + fact *= x/k; + term=fact/k; + sum += term; + if (term < EPS*sum) break; + } + if (k > MAXIT) nrerror("Series failed in ei"); + return sum+log(x)+EULER; + } else { + sum=0.0; + term=1.0; + for (k=1;k<=MAXIT;k++) { + prev=term; + term *= k/x; + if (term < EPS) break; + if (term < prev) sum += term; + else { + sum -= prev; + break; + } + } + return exp(x)*(1.0+sum)/x; + } +} +#undef EPS +#undef EULER +#undef MAXIT +#undef FPMIN diff --git a/lib/nr/k_and_r/recipes/eigsrt.c b/lib/nr/k_and_r/recipes/eigsrt.c new file mode 100644 index 0000000..f4c0a64 --- /dev/null +++ b/lib/nr/k_and_r/recipes/eigsrt.c @@ -0,0 +1,23 @@ + +void eigsrt(d,v,n) +float **v,d[]; +int n; +{ + int k,j,i; + float p; + + for (i=1;i= p) p=d[k=j]; + if (k != i) { + d[k]=d[i]; + d[i]=p; + for (j=1;j<=n;j++) { + p=v[j][i]; + v[j][i]=v[j][k]; + v[j][k]=p; + } + } + } +} diff --git a/lib/nr/k_and_r/recipes/elle.c b/lib/nr/k_and_r/recipes/elle.c new file mode 100644 index 0000000..b53d4af --- /dev/null +++ b/lib/nr/k_and_r/recipes/elle.c @@ -0,0 +1,15 @@ + +#include +#include "nrutil.h" + +float elle(phi,ak) +float ak,phi; +{ + float rd(),rf(); + float cc,q,s; + + s=sin(phi); + cc=SQR(cos(phi)); + q=(1.0-s*ak)*(1.0+s*ak); + return s*(rf(cc,q,1.0)-(SQR(s*ak))*rd(cc,q,1.0)/3.0); +} diff --git a/lib/nr/k_and_r/recipes/ellf.c b/lib/nr/k_and_r/recipes/ellf.c new file mode 100644 index 0000000..d953dea --- /dev/null +++ b/lib/nr/k_and_r/recipes/ellf.c @@ -0,0 +1,13 @@ + +#include +#include "nrutil.h" + +float ellf(phi,ak) +float ak,phi; +{ + float rf(); + float s; + + s=sin(phi); + return s*rf(SQR(cos(phi)),(1.0-s*ak)*(1.0+s*ak),1.0); +} diff --git a/lib/nr/k_and_r/recipes/ellpi.c b/lib/nr/k_and_r/recipes/ellpi.c new file mode 100644 index 0000000..c49db03 --- /dev/null +++ b/lib/nr/k_and_r/recipes/ellpi.c @@ -0,0 +1,16 @@ + +#include +#include "nrutil.h" + +float ellpi(phi,en,ak) +float ak,en,phi; +{ + float rf(),rj(); + float cc,enss,q,s; + + s=sin(phi); + enss=en*s*s; + cc=SQR(cos(phi)); + q=(1.0-s*ak)*(1.0+s*ak); + return s*(rf(cc,q,1.0)-enss*rj(cc,q,1.0,1.0+enss)/3.0); +} diff --git a/lib/nr/k_and_r/recipes/elmhes.c b/lib/nr/k_and_r/recipes/elmhes.c new file mode 100644 index 0000000..b368a07 --- /dev/null +++ b/lib/nr/k_and_r/recipes/elmhes.c @@ -0,0 +1,39 @@ + +#include +#define SWAP(g,h) {y=(g);(g)=(h);(h)=y;} + +void elmhes(a,n) +float **a; +int n; +{ + int m,j,i; + float y,x; + + for (m=2;m fabs(x)) { + x=a[j][m-1]; + i=j; + } + } + if (i != m) { + for (j=m-1;j<=n;j++) SWAP(a[i][j],a[m][j]) + for (j=1;j<=n;j++) SWAP(a[j][i],a[j][m]) + } + if (x) { + for (i=m+1;i<=n;i++) { + if ((y=a[i][m-1]) != 0.0) { + y /= x; + a[i][m-1]=y; + for (j=m;j<=n;j++) + a[i][j] -= y*a[m][j]; + for (j=1;j<=n;j++) + a[j][m] += y*a[j][i]; + } + } + } + } +} +#undef SWAP diff --git a/lib/nr/k_and_r/recipes/erfcc.c b/lib/nr/k_and_r/recipes/erfcc.c new file mode 100644 index 0000000..2cce6a6 --- /dev/null +++ b/lib/nr/k_and_r/recipes/erfcc.c @@ -0,0 +1,15 @@ + +#include + +float erfcc(x) +float x; +{ + float t,z,ans; + + z=fabs(x); + t=1.0/(1.0+0.5*z); + ans=t*exp(-z*z-1.26551223+t*(1.00002368+t*(0.37409196+t*(0.09678418+ + t*(-0.18628806+t*(0.27886807+t*(-1.13520398+t*(1.48851587+ + t*(-0.82215223+t*0.17087277))))))))); + return x >= 0.0 ? ans : 2.0-ans; +} diff --git a/lib/nr/k_and_r/recipes/erff.c b/lib/nr/k_and_r/recipes/erff.c new file mode 100644 index 0000000..47975aa --- /dev/null +++ b/lib/nr/k_and_r/recipes/erff.c @@ -0,0 +1,8 @@ + +float erff(x) +float x; +{ + float gammp(); + + return x < 0.0 ? -gammp(0.5,x*x) : gammp(0.5,x*x); +} diff --git a/lib/nr/k_and_r/recipes/erffc.c b/lib/nr/k_and_r/recipes/erffc.c new file mode 100644 index 0000000..49a8eb2 --- /dev/null +++ b/lib/nr/k_and_r/recipes/erffc.c @@ -0,0 +1,8 @@ + +float erffc(x) +float x; +{ + float gammp(),gammq(); + + return x < 0.0 ? 1.0+gammp(0.5,x*x) : gammq(0.5,x*x); +} diff --git a/lib/nr/k_and_r/recipes/eulsum.c b/lib/nr/k_and_r/recipes/eulsum.c new file mode 100644 index 0000000..b4ba189 --- /dev/null +++ b/lib/nr/k_and_r/recipes/eulsum.c @@ -0,0 +1,29 @@ + +#include + +void eulsum(sum,term,jterm,wksp) +float *sum,term,wksp[]; +int jterm; +{ + int j; + static int nterm; + float tmp,dum; + + if (jterm == 1) { + nterm=1; + *sum=0.5*(wksp[1]=term); + } else { + tmp=wksp[1]; + wksp[1]=term; + for (j=1;j<=nterm-1;j++) { + dum=wksp[j+1]; + wksp[j+1]=0.5*(wksp[j]+tmp); + tmp=dum; + } + wksp[nterm+1]=0.5*(wksp[nterm]+tmp); + if (fabs(wksp[nterm+1]) <= fabs(wksp[nterm])) + *sum += (0.5*wksp[++nterm]); + else + *sum += wksp[nterm+1]; + } +} diff --git a/lib/nr/k_and_r/recipes/evlmem.c b/lib/nr/k_and_r/recipes/evlmem.c new file mode 100644 index 0000000..5235a7d --- /dev/null +++ b/lib/nr/k_and_r/recipes/evlmem.c @@ -0,0 +1,22 @@ + +#include + +float evlmem(fdt,d,m,xms) +float d[],fdt,xms; +int m; +{ + int i; + float sumr=1.0,sumi=0.0; + double wr=1.0,wi=0.0,wpr,wpi,wtemp,theta; + + theta=6.28318530717959*fdt; + wpr=cos(theta); + wpi=sin(theta); + for (i=1;i<=m;i++) { + wr=(wtemp=wr)*wpr-wi*wpi; + wi=wi*wpr+wtemp*wpi; + sumr -= d[i]*wr; + sumi -= d[i]*wi; + } + return xms/(sumr*sumr+sumi*sumi); +} diff --git a/lib/nr/k_and_r/recipes/expdev.c b/lib/nr/k_and_r/recipes/expdev.c new file mode 100644 index 0000000..b6474f9 --- /dev/null +++ b/lib/nr/k_and_r/recipes/expdev.c @@ -0,0 +1,14 @@ + +#include + +float expdev(idum) +long *idum; +{ + float ran1(); + float dum; + + do + dum=ran1(idum); + while (dum == 0.0); + return -log(dum); +} diff --git a/lib/nr/k_and_r/recipes/expint.c b/lib/nr/k_and_r/recipes/expint.c new file mode 100644 index 0000000..ce54351 --- /dev/null +++ b/lib/nr/k_and_r/recipes/expint.c @@ -0,0 +1,67 @@ + +#include +#define MAXIT 100 +#define EULER 0.5772156649 +#define FPMIN 1.0e-30 +#define EPS 1.0e-7 + +float expint(n,x) +float x; +int n; +{ + void nrerror(); + int i,ii,nm1; + float a,b,c,d,del,fact,h,psi,ans; + + nm1=n-1; + if (n < 0 || x < 0.0 || (x==0.0 && (n==0 || n==1))) + nrerror("bad arguments in expint"); + else { + if (n == 0) ans=exp(-x)/x; + else { + if (x == 0.0) ans=1.0/nm1; + + else { + if (x > 1.0) { + b=x+n; + c=1.0/FPMIN; + d=1.0/b; + h=d; + for (i=1;i<=MAXIT;i++) { + a = -i*(nm1+i); + b += 2.0; + d=1.0/(a*d+b); + c=b+a/c; + del=c*d; + h *= del; + if (fabs(del-1.0) < EPS) { + ans=h*exp(-x); + return ans; + } + } + nrerror("continued fraction failed in expint"); + } else { + ans = (nm1!=0 ? 1.0/nm1 : -log(x)-EULER); + fact=1.0; + for (i=1;i<=MAXIT;i++) { + fact *= -x/i; + if (i != nm1) del = -fact/(i-nm1); + else { + psi = -EULER; + for (ii=1;ii<=nm1;ii++) psi += 1.0/ii; + del=fact*(-log(x)+psi); + } + ans += del; + if (fabs(del) < fabs(ans)*EPS) return ans; + } + nrerror("series failed in expint"); + } + } + } + } + return ans; +} +#undef MAXIT +#undef EPS +#undef FPMIN +#undef EULER diff --git a/lib/nr/k_and_r/recipes/f1dim.c b/lib/nr/k_and_r/recipes/f1dim.c new file mode 100644 index 0000000..ca4eb49 --- /dev/null +++ b/lib/nr/k_and_r/recipes/f1dim.c @@ -0,0 +1,18 @@ + +#include "nrutil.h" + +extern int ncom; +extern float *pcom,*xicom,(*nrfunc)(); + +float f1dim(x) +float x; +{ + int j; + float f,*xt; + + xt=vector(1,ncom); + for (j=1;j<=ncom;j++) xt[j]=pcom[j]+x*xicom[j]; + f=(*nrfunc)(xt); + free_vector(xt,1,ncom); + return f; +} diff --git a/lib/nr/k_and_r/recipes/factln.c b/lib/nr/k_and_r/recipes/factln.c new file mode 100644 index 0000000..6b9782c --- /dev/null +++ b/lib/nr/k_and_r/recipes/factln.c @@ -0,0 +1,13 @@ + +float factln(n) +int n; +{ + float gammln(); + void nrerror(); + static float a[101]; + + if (n < 0) nrerror("Negative factorial in routine factln"); + if (n <= 1) return 0.0; + if (n <= 100) return a[n] ? a[n] : (a[n]=gammln(n+1.0)); + else return gammln(n+1.0); +} diff --git a/lib/nr/k_and_r/recipes/factrl.c b/lib/nr/k_and_r/recipes/factrl.c new file mode 100644 index 0000000..2999fcf --- /dev/null +++ b/lib/nr/k_and_r/recipes/factrl.c @@ -0,0 +1,20 @@ + +#include + +float factrl(n) +int n; +{ + float gammln(); + void nrerror(); + static int ntop=4; + static float a[33]={1.0,1.0,2.0,6.0,24.0}; + int j; + + if (n < 0) nrerror("Negative factorial in routine factrl"); + if (n > 32) return exp(gammln(n+1.0)); + while (ntop +#include "nrutil.h" +#define MOD(a,b) while(a >= b) a -= b; +#define MACC 4 + +void fasper(x,y,n,ofac,hifac,wk1,wk2,nwk,nout,jmax,prob) +float *prob,hifac,ofac,wk1[],wk2[],x[],y[]; +unsigned long *jmax,*nout,n,nwk; +{ + void avevar(),realft(),spread(); + unsigned long j,k,ndim,nfreq,nfreqt; + float ave,ck,ckk,cterm,cwt,den,df,effm,expy,fac,fndim,hc2wt; + float hs2wt,hypo,pmax,sterm,swt,var,xdif,xmax,xmin; + + *nout=0.5*ofac*hifac*n; + nfreqt=ofac*hifac*n*MACC; + nfreq=64; + while (nfreq < nfreqt) nfreq <<= 1; + ndim=nfreq << 1; + if (ndim > nwk) nrerror("workspaces too small in fasper"); + avevar(y,n,&ave,&var); + if (var == 0.0) nrerror("zero variance in fasper"); + xmin=x[1]; + xmax=xmin; + for (j=2;j<=n;j++) { + if (x[j] < xmin) xmin=x[j]; + if (x[j] > xmax) xmax=x[j]; + } + xdif=xmax-xmin; + for (j=1;j<=ndim;j++) wk1[j]=wk2[j]=0.0; + fac=ndim/(xdif*ofac); + fndim=ndim; + for (j=1;j<=n;j++) { + ck=(x[j]-xmin)*fac; + MOD(ck,fndim) + ckk=2.0*(ck++); + MOD(ckk,fndim) + ++ckk; + spread(y[j]-ave,wk1,ndim,ck,MACC); + spread(1.0,wk2,ndim,ckk,MACC); + } + realft(wk1,ndim,1); + realft(wk2,ndim,1); + df=1.0/(xdif*ofac); + pmax = -1.0; + for (k=3,j=1;j<=(*nout);j++,k+=2) { + hypo=sqrt(wk2[k]*wk2[k]+wk2[k+1]*wk2[k+1]); + hc2wt=0.5*wk2[k]/hypo; + hs2wt=0.5*wk2[k+1]/hypo; + cwt=sqrt(0.5+hc2wt); + swt=SIGN(sqrt(0.5-hc2wt),hs2wt); + den=0.5*n+hc2wt*wk2[k]+hs2wt*wk2[k+1]; + cterm=SQR(cwt*wk1[k]+swt*wk1[k+1])/den; + sterm=SQR(cwt*wk1[k+1]-swt*wk1[k])/(n-den); + wk1[j]=j*df; + wk2[j]=(cterm+sterm)/(2.0*var); + if (wk2[j] > pmax) pmax=wk2[(*jmax=j)]; + } + expy=exp(-pmax); + effm=2.0*(*nout)/ofac; + *prob=effm*expy; + if (*prob > 0.01) *prob=1.0-pow(1.0-expy,effm); +} +#undef MOD +#undef MACC diff --git a/lib/nr/k_and_r/recipes/fdjac.c b/lib/nr/k_and_r/recipes/fdjac.c new file mode 100644 index 0000000..ab0b900 --- /dev/null +++ b/lib/nr/k_and_r/recipes/fdjac.c @@ -0,0 +1,27 @@ + +#include +#include "nrutil.h" +#define EPS 1.0e-4 + +void fdjac(n,x,fvec,df,vecfunc) +float **df,fvec[],x[]; +int n; +void (*vecfunc)(); +{ + int i,j; + float h,temp,*f; + + f=vector(1,n); + for (j=1;j<=n;j++) { + temp=x[j]; + h=EPS*fabs(temp); + if (h == 0.0) h=EPS; + x[j]=temp+h; + h=x[j]-temp; + (*vecfunc)(n,x,f); + x[j]=temp; + for (i=1;i<=n;i++) df[i][j]=(f[i]-fvec[i])/h; + } + free_vector(f,1,n); +} +#undef EPS diff --git a/lib/nr/k_and_r/recipes/fgauss.c b/lib/nr/k_and_r/recipes/fgauss.c new file mode 100644 index 0000000..4a46efe --- /dev/null +++ b/lib/nr/k_and_r/recipes/fgauss.c @@ -0,0 +1,21 @@ + +#include + +void fgauss(x,a,y,dyda,na) +float *y,a[],dyda[],x; +int na; +{ + int i; + float fac,ex,arg; + + *y=0.0; + for (i=1;i<=na-1;i+=3) { + arg=(x-a[i+1])/a[i+2]; + ex=exp(-arg*arg); + fac=a[i]*ex*2.0*arg; + *y += a[i]*ex; + dyda[i]=ex; + dyda[i+1]=fac/a[i+2]; + dyda[i+2]=fac*arg/a[i+2]; + } +} diff --git a/lib/nr/k_and_r/recipes/fill0.c b/lib/nr/k_and_r/recipes/fill0.c new file mode 100644 index 0000000..1fdb992 --- /dev/null +++ b/lib/nr/k_and_r/recipes/fill0.c @@ -0,0 +1,10 @@ + +void fill0(u,n) +double **u; +int n; +{ + int i,j; + for (j=1;j<=n;j++) + for (i=1;i<=n;i++) + u[i][j]=0.0; +} diff --git a/lib/nr/k_and_r/recipes/fit.c b/lib/nr/k_and_r/recipes/fit.c new file mode 100644 index 0000000..cabb834 --- /dev/null +++ b/lib/nr/k_and_r/recipes/fit.c @@ -0,0 +1,60 @@ + +#include +#include "nrutil.h" + +void fit(x,y,ndata,sig,mwt,a,b,siga,sigb,chi2,q) +float *a,*b,*chi2,*q,*siga,*sigb,sig[],x[],y[]; +int mwt,ndata; +{ + float gammq(); + int i; + float wt,t,sxoss,sx=0.0,sy=0.0,st2=0.0,ss,sigdat; + + *b=0.0; + if (mwt) { + ss=0.0; + for (i=1;i<=ndata;i++) { + wt=1.0/SQR(sig[i]); + ss += wt; + sx += x[i]*wt; + sy += y[i]*wt; + } + } else { + for (i=1;i<=ndata;i++) { + sx += x[i]; + sy += y[i]; + } + ss=ndata; + } + sxoss=sx/ss; + if (mwt) { + for (i=1;i<=ndata;i++) { + t=(x[i]-sxoss)/sig[i]; + st2 += t*t; + *b += t*y[i]/sig[i]; + } + } else { + for (i=1;i<=ndata;i++) { + t=x[i]-sxoss; + st2 += t*t; + *b += t*y[i]; + } + } + *b /= st2; + *a=(sy-sx*(*b))/ss; + *siga=sqrt((1.0+sx*sx/(ss*st2))/ss); + *sigb=sqrt(1.0/st2); + *chi2=0.0; + *q=1.0; + if (mwt == 0) { + for (i=1;i<=ndata;i++) + *chi2 += SQR(y[i]-(*a)-(*b)*x[i]); + sigdat=sqrt((*chi2)/(ndata-2)); + *siga *= sigdat; + *sigb *= sigdat; + } else { + for (i=1;i<=ndata;i++) + *chi2 += SQR((y[i]-(*a)-(*b)*x[i])/sig[i]); + if (ndata>2) *q=gammq(0.5*(ndata-2),0.5*(*chi2)); + } +} diff --git a/lib/nr/k_and_r/recipes/fitexy.c b/lib/nr/k_and_r/recipes/fitexy.c new file mode 100644 index 0000000..fbddb2a --- /dev/null +++ b/lib/nr/k_and_r/recipes/fitexy.c @@ -0,0 +1,88 @@ + +#include +#include "nrutil.h" +#define POTN 1.571000 +#define BIG 1.0e30 +#define PI 3.14159265 +#define ACC 1.0e-3 + +int nn; +float *xx,*yy,*sx,*sy,*ww,aa,offs; + +void fitexy(x,y,ndat,sigx,sigy,a,b,siga,sigb,chi2,q) +float *a,*b,*chi2,*q,*siga,*sigb,sigx[],sigy[],x[],y[]; +int ndat; +{ + float brent(),chixy(),gammq(),zbrent(); + void avevar(),fit(),mnbrak(); + int j; + float swap,amx,amn,varx,vary,ang[7],ch[7],scale,bmn,bmx,d1,d2,r2, + dum1,dum2,dum3,dum4,dum5; + + xx=vector(1,ndat); + yy=vector(1,ndat); + sx=vector(1,ndat); + sy=vector(1,ndat); + ww=vector(1,ndat); + avevar(x,ndat,&dum1,&varx); + avevar(y,ndat,&dum1,&vary); + scale=sqrt(varx/vary); + nn=ndat; + for (j=1;j<=ndat;j++) { + xx[j]=x[j]; + yy[j]=y[j]*scale; + sx[j]=sigx[j]; + sy[j]=sigy[j]*scale; + ww[j]=sqrt(SQR(sx[j])+SQR(sy[j])); + } + fit(xx,yy,nn,ww,1,&dum1,b,&dum2,&dum3,&dum4,&dum5); + offs=ang[1]=0.0; + ang[2]=atan(*b); + ang[4]=0.0; + ang[5]=ang[2]; + ang[6]=POTN; + for (j=4;j<=6;j++) ch[j]=chixy(ang[j]); + mnbrak(&ang[1],&ang[2],&ang[3],&ch[1],&ch[2],&ch[3],chixy); + *chi2=brent(ang[1],ang[2],ang[3],chixy,ACC,b); + *chi2=chixy(*b); + *a=aa; + *q=gammq(0.5*(nn-2),*chi2*0.5); + for (r2=0.0,j=1;j<=nn;j++) r2 += ww[j]; + r2=1.0/r2; + bmx=BIG; + bmn=BIG; + offs=(*chi2)+1.0; + for (j=1;j<=6;j++) { + if (ch[j] > offs) { + d1=fabs(ang[j]-(*b)); + while (d1 >= PI) d1 -= PI; + d2=PI-d1; + if (ang[j] < *b) { + swap=d1; + d1=d2; + d2=swap; + } + if (d1 < bmx) bmx=d1; + if (d2 < bmn) bmn=d2; + } + } + if (bmx < BIG) { + bmx=zbrent(chixy,*b,*b+bmx,ACC)-(*b); + amx=aa-(*a); + bmn=zbrent(chixy,*b,*b-bmn,ACC)-(*b); + amn=aa-(*a); + *sigb=sqrt(0.5*(bmx*bmx+bmn*bmn))/(scale*SQR(cos(*b))); + *siga=sqrt(0.5*(amx*amx+amn*amn)+r2)/scale; + } else (*sigb)=(*siga)=BIG; + *a /= scale; + *b=tan(*b)/scale; + free_vector(ww,1,ndat); + free_vector(sy,1,ndat); + free_vector(sx,1,ndat); + free_vector(yy,1,ndat); + free_vector(xx,1,ndat); +} +#undef POTN +#undef BIG +#undef PI +#undef ACC diff --git a/lib/nr/k_and_r/recipes/fixrts.c b/lib/nr/k_and_r/recipes/fixrts.c new file mode 100644 index 0000000..e71a914 --- /dev/null +++ b/lib/nr/k_and_r/recipes/fixrts.c @@ -0,0 +1,37 @@ + +#include +#include "complex.h" +#define NMAX 100 +#define ZERO Complex(0.0,0.0) +#define ONE Complex(1.0,0.0) + +void fixrts(d,m) +float d[]; +int m; +{ + void zroots(); + int i,j,polish; + fcomplex a[NMAX],roots[NMAX]; + + a[m]=ONE; + for (j=m-1;j>=0;j--) + a[j]=Complex(-d[m-j],0.0); + polish=1; + zroots(a,m,roots,polish); + for (j=1;j<=m;j++) + if (Cabs(roots[j]) > 1.0) + roots[j]=Cdiv(ONE,Conjg(roots[j])); + a[0]=Csub(ZERO,roots[1]); + a[1]=ONE; + for (j=2;j<=m;j++) { + a[j]=ONE; + for (i=j;i>=2;i--) + a[i-1]=Csub(a[i-2],Cmul(roots[j],a[i-1])); + a[0]=Csub(ZERO,Cmul(roots[j],a[0])); + } + for (j=0;j<=m-1;j++) + d[m-j] = -a[j].r; +} +#undef NMAX +#undef ZERO +#undef ONE diff --git a/lib/nr/k_and_r/recipes/fleg.c b/lib/nr/k_and_r/recipes/fleg.c new file mode 100644 index 0000000..09f3423 --- /dev/null +++ b/lib/nr/k_and_r/recipes/fleg.c @@ -0,0 +1,21 @@ + +void fleg(x,pl,nl) +float pl[],x; +int nl; +{ + int j; + float twox,f2,f1,d; + + pl[1]=1.0; + pl[2]=x; + if (nl > 2) { + twox=2.0*x; + f2=x; + d=1.0; + for (j=3;j<=nl;j++) { + f1=d++; + f2 += twox; + pl[j]=(f2*pl[j-1]-f1*pl[j-2])/d; + } + } +} diff --git a/lib/nr/k_and_r/recipes/flmoon.c b/lib/nr/k_and_r/recipes/flmoon.c new file mode 100644 index 0000000..9e5b988 --- /dev/null +++ b/lib/nr/k_and_r/recipes/flmoon.c @@ -0,0 +1,30 @@ + +#include +#define RAD (3.14159265/180.0) + +void flmoon(n,nph,jd,frac) +float *frac; +int n,nph; +long *jd; +{ + void nrerror(); + int i; + float am,as,c,t,t2,xtra; + + c=n+nph/4.0; + t=c/1236.85; + t2=t*t; + as=359.2242+29.105356*c; + am=306.0253+385.816918*c+0.010730*t2; + *jd=2415020+28L*n+7L*nph; + xtra=0.75933+1.53058868*c+((1.178e-4)-(1.55e-7)*t)*t2; + if (nph == 0 || nph == 2) + xtra += (0.1734-3.93e-4*t)*sin(RAD*as)-0.4068*sin(RAD*am); + else if (nph == 1 || nph == 3) + xtra += (0.1721-4.0e-4*t)*sin(RAD*as)-0.6280*sin(RAD*am); + else nrerror("nph is unknown in flmoon"); + i=(int)(xtra >= 0.0 ? floor(xtra) : ceil(xtra-1.0)); + *jd += i; + *frac=xtra-i; +} +#undef RAD diff --git a/lib/nr/k_and_r/recipes/fmin.c b/lib/nr/k_and_r/recipes/fmin.c new file mode 100644 index 0000000..b3a595d --- /dev/null +++ b/lib/nr/k_and_r/recipes/fmin.c @@ -0,0 +1,17 @@ + +#include "nrutil.h" + +extern int nn; +extern float *fvec; +extern void (*nrfuncv)(); + +float fmin(x) +float x[]; +{ + int i; + float sum; + + (*nrfuncv)(nn,x,fvec); + for (sum=0.0,i=1;i<=nn;i++) sum += SQR(fvec[i]); + return 0.5*sum; +} diff --git a/lib/nr/k_and_r/recipes/four1.c b/lib/nr/k_and_r/recipes/four1.c new file mode 100644 index 0000000..7a1acfe --- /dev/null +++ b/lib/nr/k_and_r/recipes/four1.c @@ -0,0 +1,53 @@ + +#include +#define SWAP(a,b) tempr=(a);(a)=(b);(b)=tempr + +void four1(data,nn,isign) +float data[]; +int isign; +unsigned long nn; +{ + unsigned long n,mmax,m,j,istep,i; + double wtemp,wr,wpr,wpi,wi,theta; + float tempr,tempi; + + n=nn << 1; + j=1; + for (i=1;i i) { + SWAP(data[j],data[i]); + SWAP(data[j+1],data[i+1]); + } + m=nn; + while (m >= 2 && j > m) { + j -= m; + m >>= 1; + } + j += m; + } + mmax=2; + while (n > mmax) { + istep=mmax << 1; + theta=isign*(6.28318530717959/mmax); + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0; + wi=0.0; + for (m=1;m +#define SWAP(a,b) ftemp=(a);(a)=(b);(b)=ftemp + +void fourew(file,na,nb,nc,nd) +FILE *file[5]; +int *na,*nb,*nc,*nd; +{ + int i; + FILE *ftemp; + + for (i=1;i<=4;i++) rewind(file[i]); + SWAP(file[2],file[4]); + SWAP(file[1],file[3]); + *na=3; + *nb=4; + *nc=1; + *nd=2; +} +#undef SWAP diff --git a/lib/nr/k_and_r/recipes/fourfs.c b/lib/nr/k_and_r/recipes/fourfs.c new file mode 100644 index 0000000..798fd19 --- /dev/null +++ b/lib/nr/k_and_r/recipes/fourfs.c @@ -0,0 +1,158 @@ + +#include +#include +#include "nrutil.h" +#define KBF 128 + +void fourfs(file,nn,ndim,isign) +FILE *file[5]; +int isign,ndim; +unsigned long nn[]; +{ + void fourew(); + unsigned long j,j12,jk,k,kk,n=1,mm,kc=0,kd,ks,kr,nr,ns,nv; + int cc,na,nb,nc,nd; + float tempr,tempi,*afa,*afb,*afc; + double wr,wi,wpr,wpi,wtemp,theta; + static int mate[5] = {0,2,1,4,3}; + + afa=vector(1,KBF); + afb=vector(1,KBF); + afc=vector(1,KBF); + for (j=1;j<=ndim;j++) { + n *= nn[j]; + if (nn[j] <= 1) nrerror("invalid float or wrong ndim in fourfs"); + } + nv=1; + jk=nn[nv]; + mm=n; + ns=n/KBF; + nr=ns >> 1; + kd=KBF >> 1; + ks=n; + fourew(file,&na,&nb,&nc,&nd); + for (;;) { + theta=isign*3.141592653589793/(n/mm); + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0; + wi=0.0; + mm >>= 1; + for (j12=1;j12<=2;j12++) { + kr=0; + do { + cc=fread(&afa[1],sizeof(float),KBF,file[na]); + if (cc != KBF) nrerror("read error in fourfs"); + cc=fread(&afb[1],sizeof(float),KBF,file[nb]); + if (cc != KBF) nrerror("read error in fourfs"); + for (j=1;j<=KBF;j+=2) { + tempr=((float)wr)*afb[j]-((float)wi)*afb[j+1]; + tempi=((float)wi)*afb[j]+((float)wr)*afb[j+1]; + afb[j]=afa[j]-tempr; + afa[j] += tempr; + afb[j+1]=afa[j+1]-tempi; + afa[j+1] += tempi; + } + kc += kd; + if (kc == mm) { + kc=0; + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + } + cc=fwrite(&afa[1],sizeof(float),KBF,file[nc]); + if (cc != KBF) nrerror("write error in fourfs"); + cc=fwrite(&afb[1],sizeof(float),KBF,file[nd]); + if (cc != KBF) nrerror("write error in fourfs"); + } while (++kr < nr); + if (j12 == 1 && ks != n && ks == KBF) { + na=mate[na]; + nb=na; + } + if (nr == 0) break; + } + fourew(file,&na,&nb,&nc,&nd); + jk >>= 1; + while (jk == 1) { + mm=n; + jk=nn[++nv]; + } + ks >>= 1; + if (ks > KBF) { + for (j12=1;j12<=2;j12++) { + for (kr=1;kr<=ns;kr+=ks/KBF) { + for (k=1;k<=ks;k+=KBF) { + cc=fread(&afa[1],sizeof(float),KBF,file[na]); + if (cc != KBF) nrerror("read error in fourfs"); + cc=fwrite(&afa[1],sizeof(float),KBF,file[nc]); + if (cc != KBF) nrerror("write error in fourfs"); + } + nc=mate[nc]; + } + na=mate[na]; + } + fourew(file,&na,&nb,&nc,&nd); + } else if (ks == KBF) nb=na; + else break; + } + j=1; + for (;;) { + theta=isign*3.141592653589793/(n/mm); + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0; + wi=0.0; + mm >>= 1; + ks=kd; + kd >>= 1; + for (j12=1;j12<=2;j12++) { + for (kr=1;kr<=ns;kr++) { + cc=fread(&afc[1],sizeof(float),KBF,file[na]); + if (cc != KBF) nrerror("read error in fourfs"); + kk=1; + k=ks+1; + for (;;) { + tempr=((float)wr)*afc[kk+ks]-((float)wi)*afc[kk+ks+1]; + tempi=((float)wi)*afc[kk+ks]+((float)wr)*afc[kk+ks+1]; + afa[j]=afc[kk]+tempr; + afb[j]=afc[kk]-tempr; + afa[++j]=afc[++kk]+tempi; + afb[j++]=afc[kk++]-tempi; + if (kk < k) continue; + kc += kd; + if (kc == mm) { + kc=0; + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + } + kk += ks; + if (kk > KBF) break; + else k=kk+ks; + } + if (j > KBF) { + cc=fwrite(&afa[1],sizeof(float),KBF,file[nc]); + if (cc != KBF) nrerror("write error in fourfs"); + cc=fwrite(&afb[1],sizeof(float),KBF,file[nd]); + if (cc != KBF) nrerror("write error in fourfs"); + j=1; + } + } + na=mate[na]; + } + fourew(file,&na,&nb,&nc,&nd); + jk >>= 1; + if (jk > 1) continue; + mm=n; + do { + if (nv < ndim) jk=nn[++nv]; + else { + free_vector(afc,1,KBF); + free_vector(afb,1,KBF); + free_vector(afa,1,KBF); + return; + } + } while (jk == 1); + } +} +#undef KBF diff --git a/lib/nr/k_and_r/recipes/fourn.c b/lib/nr/k_and_r/recipes/fourn.c new file mode 100644 index 0000000..c5ece99 --- /dev/null +++ b/lib/nr/k_and_r/recipes/fourn.c @@ -0,0 +1,73 @@ + +#include +#define SWAP(a,b) tempr=(a);(a)=(b);(b)=tempr + +void fourn(data,nn,ndim,isign) +float data[]; +int isign,ndim; +unsigned long nn[]; +{ + int idim; + unsigned long i1,i2,i3,i2rev,i3rev,ip1,ip2,ip3,ifp1,ifp2; + unsigned long ibit,k1,k2,n,nprev,nrem,ntot; + float tempi,tempr; + double theta,wi,wpi,wpr,wr,wtemp; + + for (ntot=1,idim=1;idim<=ndim;idim++) + ntot *= nn[idim]; + nprev=1; + for (idim=ndim;idim>=1;idim--) { + n=nn[idim]; + nrem=ntot/(n*nprev); + ip1=nprev << 1; + ip2=ip1*n; + ip3=ip2*nrem; + i2rev=1; + for (i2=1;i2<=ip2;i2+=ip1) { + if (i2 < i2rev) { + for (i1=i2;i1<=i2+ip1-2;i1+=2) { + for (i3=i1;i3<=ip3;i3+=ip2) { + i3rev=i2rev+i3-i2; + SWAP(data[i3],data[i3rev]); + SWAP(data[i3+1],data[i3rev+1]); + } + } + } + ibit=ip2 >> 1; + while (ibit >= ip1 && i2rev > ibit) { + i2rev -= ibit; + ibit >>= 1; + } + i2rev += ibit; + } + ifp1=ip1; + while (ifp1 < ip2) { + ifp2=ifp1 << 1; + theta=isign*6.28318530717959/(ifp2/ip1); + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0; + wi=0.0; + for (i3=1;i3<=ifp1;i3+=ip1) { + for (i1=i3;i1<=i3+ip1-2;i1+=2) { + for (i2=i1;i2<=ip3;i2+=ifp2) { + k1=i2; + k2=k1+ifp1; + tempr=(float)wr*data[k2]-(float)wi*data[k2+1]; + tempi=(float)wr*data[k2+1]+(float)wi*data[k2]; + data[k2]=data[k1]-tempr; + data[k2+1]=data[k1+1]-tempi; + data[k1] += tempr; + data[k1+1] += tempi; + } + } + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + } + ifp1=ifp2; + } + nprev *= n; + } +} +#undef SWAP diff --git a/lib/nr/k_and_r/recipes/fpoly.c b/lib/nr/k_and_r/recipes/fpoly.c new file mode 100644 index 0000000..c1fe651 --- /dev/null +++ b/lib/nr/k_and_r/recipes/fpoly.c @@ -0,0 +1,10 @@ + +void fpoly(x,p,np) +float p[],x; +int np; +{ + int j; + + p[1]=1.0; + for (j=2;j<=np;j++) p[j]=p[j-1]*x; +} diff --git a/lib/nr/k_and_r/recipes/fred2.c b/lib/nr/k_and_r/recipes/fred2.c new file mode 100644 index 0000000..addd15f --- /dev/null +++ b/lib/nr/k_and_r/recipes/fred2.c @@ -0,0 +1,24 @@ + +#include "nrutil.h" + +void fred2(n,a,b,t,f,w,g,ak) +float (*ak)(),(*g)(),a,b,f[],t[],w[]; +int n; +{ + void gauleg(),lubksb(),ludcmp(); + int i,j,*indx; + float d,**omk; + + indx=ivector(1,n); + omk=matrix(1,n,1,n); + gauleg(a,b,t,w,n); + for (i=1;i<=n;i++) { + for (j=1;j<=n;j++) + omk[i][j]=(float)(i == j)-(*ak)(t[i],t[j])*w[j]; + f[i]=(*g)(t[i]); + } + ludcmp(omk,n,indx,&d); + lubksb(omk,n,indx,f); + free_matrix(omk,1,n,1,n); + free_ivector(indx,1,n); +} diff --git a/lib/nr/k_and_r/recipes/fredex.c b/lib/nr/k_and_r/recipes/fredex.c new file mode 100644 index 0000000..c70b49d --- /dev/null +++ b/lib/nr/k_and_r/recipes/fredex.c @@ -0,0 +1,31 @@ + +#include +#include +#include "nrutil.h" +#define PI 3.14159265 +#define N 40 + +main() /* Program fredex */ +{ + void lubksb(),ludcmp(),quadmx(); + float **a,d,*g,x; + int *indx,j; + + indx=ivector(1,N); + a=matrix(1,N,1,N); + g=vector(1,N); + quadmx(a,N); + ludcmp(a,N,indx,&d); + for (j=1;j<=N;j++) g[j]=sin((j-1)*PI/(N-1)); + lubksb(a,N,indx,g); + for (j=1;j<=N;j++) { + x=(j-1)*PI/(N-1); + printf("%6.2d %12.6f %12.6f\n",j,x,g[j]); + } + free_vector(g,1,N); + free_matrix(a,1,N,1,N); + free_ivector(indx,1,N); + return 0; +} +#undef N +#undef PI diff --git a/lib/nr/k_and_r/recipes/fredin.c b/lib/nr/k_and_r/recipes/fredin.c new file mode 100644 index 0000000..e074673 --- /dev/null +++ b/lib/nr/k_and_r/recipes/fredin.c @@ -0,0 +1,11 @@ + +float fredin(x,n,a,b,t,f,w,g,ak) +float (*ak)(),(*g)(),a,b,f[],t[],w[],x; +int n; +{ + int i; + float sum=0.0; + + for (i=1;i<=n;i++) sum += (*ak)(x,t[i])*w[i]*f[i]; + return (*g)(x)+sum; +} diff --git a/lib/nr/k_and_r/recipes/frenel.c b/lib/nr/k_and_r/recipes/frenel.c new file mode 100644 index 0000000..faaee13 --- /dev/null +++ b/lib/nr/k_and_r/recipes/frenel.c @@ -0,0 +1,87 @@ + +#include +#include "complex.h" +#define EPS 6.0e-8 +#define MAXIT 100 +#define FPMIN 1.0e-30 +#define XMIN 1.5 +#define PI 3.1415927 +#define PIBY2 (PI/2.0) +#define TRUE 1 +#define ONE Complex(1.0,0.0) + +void frenel(x,s,c) +float *c,*s,x; +{ + void nrerror(); + int k,n,odd; + float a,ax,fact,pix2,sign,sum,sumc,sums,term,test; + fcomplex b,cc,d,h,del,cs; + + ax=fabs(x); + if (ax < sqrt(FPMIN)) { + *s=0.0; + *c=ax; + } else if (ax <= XMIN) { + sum=sums=0.0; + sumc=ax; + sign=1.0; + fact=PIBY2*ax*ax; + odd=TRUE; + term=ax; + n=3; + for (k=1;k<=MAXIT;k++) { + term *= fact/k; + sum += sign*term/n; + test=fabs(sum)*EPS; + if (odd) { + sign = -sign; + sums=sum; + sum=sumc; + } else { + sumc=sum; + sum=sums; + } + if (term < test) break; + odd=!odd; + n += 2; + } + if (k > MAXIT) nrerror("series failed in frenel"); + *s=sums; + *c=sumc; + } else { + pix2=PI*ax*ax; + b=Complex(1.0,-pix2); + cc=Complex(1.0/FPMIN,0.0); + d=h=Cdiv(ONE,b); + n = -1; + for (k=2;k<=MAXIT;k++) { + n += 2; + a = -n*(n+1); + b=Cadd(b,Complex(4.0,0.0)); + d=Cdiv(ONE,Cadd(RCmul(a,d),b)); + cc=Cadd(b,Cdiv(Complex(a,0.0),cc)); + del=Cmul(cc,d); + h=Cmul(h,del); + if (fabs(del.r-1.0)+fabs(del.i) < EPS) break; + } + if (k > MAXIT) nrerror("cf failed in frenel"); + h=Cmul(Complex(ax,-ax),h); + cs=Cmul(Complex(0.5,0.5), + Csub(ONE,Cmul(Complex(cos(0.5*pix2),sin(0.5*pix2)),h))); + *c=cs.r; + *s=cs.i; + } + if (x < 0.0) { + *c = -(*c); + *s = -(*s); + } +} +#undef EPS +#undef MAXIT +#undef FPMIN +#undef XMIN +#undef PI +#undef PIBY2 +#undef TRUE +#undef ONE diff --git a/lib/nr/k_and_r/recipes/frprmn.c b/lib/nr/k_and_r/recipes/frprmn.c new file mode 100644 index 0000000..3f02c3d --- /dev/null +++ b/lib/nr/k_and_r/recipes/frprmn.c @@ -0,0 +1,55 @@ + +#include +#include "nrutil.h" +#define ITMAX 200 +#define EPS 1.0e-10 +#define FREEALL free_vector(xi,1,n);free_vector(h,1,n);free_vector(g,1,n); + +void frprmn(p,n,ftol,iter,fret,func,dfunc) +float (*func)(),*fret,ftol,p[]; +int *iter,n; +void (*dfunc)(); +{ + void linmin(); + int j,its; + float gg,gam,fp,dgg; + float *g,*h,*xi; + + g=vector(1,n); + h=vector(1,n); + xi=vector(1,n); + fp=(*func)(p); + (*dfunc)(p,xi); + for (j=1;j<=n;j++) { + g[j] = -xi[j]; + xi[j]=h[j]=g[j]; + } + for (its=1;its<=ITMAX;its++) { + *iter=its; + linmin(p,xi,n,fret,func); + if (2.0*fabs(*fret-fp) <= ftol*(fabs(*fret)+fabs(fp)+EPS)) { + FREEALL + return; + } + fp= *fret; + (*dfunc)(p,xi); + dgg=gg=0.0; + for (j=1;j<=n;j++) { + gg += g[j]*g[j]; + dgg += (xi[j]+g[j])*xi[j]; + } + if (gg == 0.0) { + FREEALL + return; + } + gam=dgg/gg; + for (j=1;j<=n;j++) { + g[j] = -xi[j]; + xi[j]=h[j]=g[j]+gam*h[j]; + } + } + nrerror("Too many iterations in frprmn"); +} +#undef ITMAX +#undef EPS +#undef FREEALL diff --git a/lib/nr/k_and_r/recipes/ftest.c b/lib/nr/k_and_r/recipes/ftest.c new file mode 100644 index 0000000..55ac3af --- /dev/null +++ b/lib/nr/k_and_r/recipes/ftest.c @@ -0,0 +1,23 @@ + +void ftest(data1,n1,data2,n2,f,prob) +float *f,*prob,data1[],data2[]; +unsigned long n1,n2; +{ + float betai(); + void avevar(); + float var1,var2,ave1,ave2,df1,df2; + + avevar(data1,n1,&ave1,&var1); + avevar(data2,n2,&ave2,&var2); + if (var1 > var2) { + *f=var1/var2; + df1=n1-1; + df2=n2-1; + } else { + *f=var2/var1; + df1=n2-1; + df2=n1-1; + } + *prob = 2.0*betai(0.5*df2,0.5*df1,df2/(df2+df1*(*f))); + if (*prob > 1.0) *prob=2.0-*prob; +} diff --git a/lib/nr/k_and_r/recipes/gamdev.c b/lib/nr/k_and_r/recipes/gamdev.c new file mode 100644 index 0000000..f2963f3 --- /dev/null +++ b/lib/nr/k_and_r/recipes/gamdev.c @@ -0,0 +1,34 @@ + +#include + +float gamdev(ia,idum) +int ia; +long *idum; +{ + float ran1(); + void nrerror(); + int j; + float am,e,s,v1,v2,x,y; + + if (ia < 1) nrerror("Error in routine gamdev"); + if (ia < 6) { + x=1.0; + for (j=1;j<=ia;j++) x *= ran1(idum); + x = -log(x); + } else { + do { + do { + do { + v1=ran1(idum); + v2=2.0*ran1(idum)-1.0; + } while (v1*v1+v2*v2 > 1.0); + y=v2/v1; + am=ia-1; + s=sqrt(2.0*am+1.0); + x=s*y+am; + } while (x <= 0.0); + e=(1.0+y*y)*exp(am*log(x/am)-s*y); + } while (ran1(idum) > e); + } + return x; +} diff --git a/lib/nr/k_and_r/recipes/gammln.c b/lib/nr/k_and_r/recipes/gammln.c new file mode 100644 index 0000000..adf554d --- /dev/null +++ b/lib/nr/k_and_r/recipes/gammln.c @@ -0,0 +1,19 @@ + +#include + +float gammln(xx) +float xx; +{ + double x,y,tmp,ser; + static double cof[6]={76.18009172947146,-86.50532032941677, + 24.01409824083091,-1.231739572450155, + 0.1208650973866179e-2,-0.5395239384953e-5}; + int j; + + y=x=xx; + tmp=x+5.5; + tmp -= (x+0.5)*log(tmp); + ser=1.000000000190015; + for (j=0;j<=5;j++) ser += cof[j]/++y; + return -tmp+log(2.5066282746310005*ser/x); +} diff --git a/lib/nr/k_and_r/recipes/gammp.c b/lib/nr/k_and_r/recipes/gammp.c new file mode 100644 index 0000000..d35d7ab --- /dev/null +++ b/lib/nr/k_and_r/recipes/gammp.c @@ -0,0 +1,17 @@ + +float gammp(a,x) +float a,x; +{ + void gcf(),gser(); + void nrerror(); + float gamser,gammcf,gln; + + if (x < 0.0 || a <= 0.0) nrerror("Invalid arguments in routine gammp"); + if (x < (a+1.0)) { + gser(&gamser,a,x,&gln); + return gamser; + } else { + gcf(&gammcf,a,x,&gln); + return 1.0-gammcf; + } +} diff --git a/lib/nr/k_and_r/recipes/gammq.c b/lib/nr/k_and_r/recipes/gammq.c new file mode 100644 index 0000000..4237693 --- /dev/null +++ b/lib/nr/k_and_r/recipes/gammq.c @@ -0,0 +1,17 @@ + +float gammq(a,x) +float a,x; +{ + void gcf(),gser(); + void nrerror(); + float gamser,gammcf,gln; + + if (x < 0.0 || a <= 0.0) nrerror("Invalid arguments in routine gammq"); + if (x < (a+1.0)) { + gser(&gamser,a,x,&gln); + return 1.0-gamser; + } else { + gcf(&gammcf,a,x,&gln); + return gammcf; + } +} diff --git a/lib/nr/k_and_r/recipes/gasdev.c b/lib/nr/k_and_r/recipes/gasdev.c new file mode 100644 index 0000000..b7296d5 --- /dev/null +++ b/lib/nr/k_and_r/recipes/gasdev.c @@ -0,0 +1,27 @@ + +#include + +float gasdev(idum) +long *idum; +{ + float ran1(); + static int iset=0; + static float gset; + float fac,rsq,v1,v2; + + if (*idum < 0) iset=0; + if (iset == 0) { + do { + v1=2.0*ran1(idum)-1.0; + v2=2.0*ran1(idum)-1.0; + rsq=v1*v1+v2*v2; + } while (rsq >= 1.0 || rsq == 0.0); + fac=sqrt(-2.0*log(rsq)/rsq); + gset=v1*fac; + iset=1; + return v2*fac; + } else { + iset=0; + return gset; + } +} diff --git a/lib/nr/k_and_r/recipes/gaucof.c b/lib/nr/k_and_r/recipes/gaucof.c new file mode 100644 index 0000000..8d4cd33 --- /dev/null +++ b/lib/nr/k_and_r/recipes/gaucof.c @@ -0,0 +1,25 @@ + +#include +#include "nrutil.h" + +void gaucof(n,a,b,amu0,x,w) +float a[],amu0,b[],w[],x[]; +int n; +{ + void eigsrt(),tqli(); + int i,j; + float **z; + + z=matrix(1,n,1,n); + for (i=1;i<=n;i++) { + if (i != 1) b[i]=sqrt(b[i]); + for (j=1;j<=n;j++) z[i][j]=(float)(i == j); + } + tqli(a,b,n,z); + eigsrt(a,z,n); + for (i=1;i<=n;i++) { + x[i]=a[i]; + w[i]=amu0*z[1][i]*z[1][i]; + } + free_matrix(z,1,n,1,n); +} diff --git a/lib/nr/k_and_r/recipes/gauher.c b/lib/nr/k_and_r/recipes/gauher.c new file mode 100644 index 0000000..7ae942f --- /dev/null +++ b/lib/nr/k_and_r/recipes/gauher.c @@ -0,0 +1,50 @@ + +#include +#define EPS 3.0e-14 +#define PIM4 0.7511255444649425 +#define MAXIT 10 + +void gauher(x,w,n) +float w[],x[]; +int n; +{ + void nrerror(); + int i,its,j,m; + double p1,p2,p3,pp,z,z1; + + m=(n+1)/2; + for (i=1;i<=m;i++) { + if (i == 1) { + z=sqrt((double)(2*n+1))-1.85575*pow((double)(2*n+1),-0.16667); + } else if (i == 2) { + z -= 1.14*pow((double)n,0.426)/z; + } else if (i == 3) { + z=1.86*z-0.86*x[1]; + } else if (i == 4) { + z=1.91*z-0.91*x[2]; + } else { + z=2.0*z-x[i-2]; + } + for (its=1;its<=MAXIT;its++) { + p1=PIM4; + p2=0.0; + for (j=1;j<=n;j++) { + p3=p2; + p2=p1; + p1=z*sqrt(2.0/j)*p2-sqrt(((double)(j-1))/j)*p3; + } + pp=sqrt((double)2*n)*p2; + z1=z; + z=z1-p1/pp; + if (fabs(z-z1) <= EPS) break; + } + if (its > MAXIT) nrerror("too many iterations in gauher"); + x[i]=z; + x[n+1-i] = -z; + w[i]=2.0/(pp*pp); + w[n+1-i]=w[i]; + } +} +#undef EPS +#undef PIM4 +#undef MAXIT diff --git a/lib/nr/k_and_r/recipes/gaujac.c b/lib/nr/k_and_r/recipes/gaujac.c new file mode 100644 index 0000000..df860f6 --- /dev/null +++ b/lib/nr/k_and_r/recipes/gaujac.c @@ -0,0 +1,72 @@ + +#include +#define EPS 3.0e-14 +#define MAXIT 10 + +void gaujac(x,w,n,alf,bet) +float alf,bet,w[],x[]; +int n; +{ + float gammln(); + void nrerror(); + int i,its,j; + float alfbet,an,bn,r1,r2,r3; + double a,b,c,p1,p2,p3,pp,temp,z,z1; + + for (i=1;i<=n;i++) { + if (i == 1) { + an=alf/n; + bn=bet/n; + r1=(1.0+alf)*(2.78/(4.0+n*n)+0.768*an/n); + r2=1.0+1.48*an+0.96*bn+0.452*an*an+0.83*an*bn; + z=1.0-r1/r2; + } else if (i == 2) { + r1=(4.1+alf)/((1.0+alf)*(1.0+0.156*alf)); + r2=1.0+0.06*(n-8.0)*(1.0+0.12*alf)/n; + r3=1.0+0.012*bet*(1.0+0.25*fabs(alf))/n; + z -= (1.0-z)*r1*r2*r3; + } else if (i == 3) { + r1=(1.67+0.28*alf)/(1.0+0.37*alf); + r2=1.0+0.22*(n-8.0)/n; + r3=1.0+8.0*bet/((6.28+bet)*n*n); + z -= (x[1]-z)*r1*r2*r3; + } else if (i == n-1) { + r1=(1.0+0.235*bet)/(0.766+0.119*bet); + r2=1.0/(1.0+0.639*(n-4.0)/(1.0+0.71*(n-4.0))); + r3=1.0/(1.0+20.0*alf/((7.5+alf)*n*n)); + z += (z-x[n-3])*r1*r2*r3; + } else if (i == n) { + r1=(1.0+0.37*bet)/(1.67+0.28*bet); + r2=1.0/(1.0+0.22*(n-8.0)/n); + r3=1.0/(1.0+8.0*alf/((6.28+alf)*n*n)); + z += (z-x[n-2])*r1*r2*r3; + } else { + z=3.0*x[i-1]-3.0*x[i-2]+x[i-3]; + } + alfbet=alf+bet; + for (its=1;its<=MAXIT;its++) { + temp=2.0+alfbet; + p1=(alf-bet+temp*z)/2.0; + p2=1.0; + for (j=2;j<=n;j++) { + p3=p2; + p2=p1; + temp=2*j+alfbet; + a=2*j*(j+alfbet)*(temp-2.0); + b=(temp-1.0)*(alf*alf-bet*bet+temp*(temp-2.0)*z); + c=2.0*(j-1+alf)*(j-1+bet)*temp; + p1=(b*p2-c*p3)/a; + } + pp=(n*(alf-bet-temp*z)*p1+2.0*(n+alf)*(n+bet)*p2)/(temp*(1.0-z*z)); + z1=z; + z=z1-p1/pp; + if (fabs(z-z1) <= EPS) break; + } + if (its > MAXIT) nrerror("too many iterations in gaujac"); + x[i]=z; + w[i]=exp(gammln(alf+n)+gammln(bet+n)-gammln(n+1.0)- + gammln(n+alfbet+1.0))*temp*pow(2.0,alfbet)/(pp*p2); + } +} +#undef EPS +#undef MAXIT diff --git a/lib/nr/k_and_r/recipes/gaulag.c b/lib/nr/k_and_r/recipes/gaulag.c new file mode 100644 index 0000000..6b86fcb --- /dev/null +++ b/lib/nr/k_and_r/recipes/gaulag.c @@ -0,0 +1,45 @@ + +#include +#define EPS 3.0e-14 +#define MAXIT 10 + +void gaulag(x,w,n,alf) +float alf,w[],x[]; +int n; +{ + float gammln(); + void nrerror(); + int i,its,j; + float ai; + double p1,p2,p3,pp,z,z1; + + for (i=1;i<=n;i++) { + if (i == 1) { + z=(1.0+alf)*(3.0+0.92*alf)/(1.0+2.4*n+1.8*alf); + } else if (i == 2) { + z += (15.0+6.25*alf)/(1.0+0.9*alf+2.5*n); + } else { + ai=i-2; + z += ((1.0+2.55*ai)/(1.9*ai)+1.26*ai*alf/ + (1.0+3.5*ai))*(z-x[i-2])/(1.0+0.3*alf); + } + for (its=1;its<=MAXIT;its++) { + p1=1.0; + p2=0.0; + for (j=1;j<=n;j++) { + p3=p2; + p2=p1; + p1=((2*j-1+alf-z)*p2-(j-1+alf)*p3)/j; + } + pp=(n*p1-(n+alf)*p2)/z; + z1=z; + z=z1-p1/pp; + if (fabs(z-z1) <= EPS) break; + } + if (its > MAXIT) nrerror("too many iterations in gaulag"); + x[i]=z; + w[i] = -exp(gammln(alf+n)-gammln((float)n))/(pp*n*p2); + } +} +#undef EPS +#undef MAXIT diff --git a/lib/nr/k_and_r/recipes/gauleg.c b/lib/nr/k_and_r/recipes/gauleg.c new file mode 100644 index 0000000..ddcade2 --- /dev/null +++ b/lib/nr/k_and_r/recipes/gauleg.c @@ -0,0 +1,35 @@ + +#include +#define EPS 3.0e-11 + +void gauleg(x1,x2,x,w,n) +float w[],x1,x2,x[]; +int n; +{ + int m,j,i; + double z1,z,xm,xl,pp,p3,p2,p1; + + m=(n+1)/2; + xm=0.5*(x2+x1); + xl=0.5*(x2-x1); + for (i=1;i<=m;i++) { + z=cos(3.141592654*(i-0.25)/(n+0.5)); + do { + p1=1.0; + p2=0.0; + for (j=1;j<=n;j++) { + p3=p2; + p2=p1; + p1=((2.0*j-1.0)*z*p2-(j-1.0)*p3)/j; + } + pp=n*(z*p1-p2)/(z*z-1.0); + z1=z; + z=z1-p1/pp; + } while (fabs(z-z1) > EPS); + x[i]=xm-xl*z; + x[n+1-i]=xm+xl*z; + w[i]=2.0*xl/((1.0-z*z)*pp*pp); + w[n+1-i]=w[i]; + } +} +#undef EPS diff --git a/lib/nr/k_and_r/recipes/gaussj.c b/lib/nr/k_and_r/recipes/gaussj.c new file mode 100644 index 0000000..635455c --- /dev/null +++ b/lib/nr/k_and_r/recipes/gaussj.c @@ -0,0 +1,60 @@ + +#include +#include "nrutil.h" +#define SWAP(a,b) {temp=(a);(a)=(b);(b)=temp;} + +void gaussj(a,n,b,m) +float **a,**b; +int m,n; +{ + int *indxc,*indxr,*ipiv; + int i,icol,irow,j,k,l,ll; + float big,dum,pivinv,temp; + + indxc=ivector(1,n); + indxr=ivector(1,n); + ipiv=ivector(1,n); + for (j=1;j<=n;j++) ipiv[j]=0; + for (i=1;i<=n;i++) { + big=0.0; + for (j=1;j<=n;j++) + if (ipiv[j] != 1) + for (k=1;k<=n;k++) { + if (ipiv[k] == 0) { + if (fabs(a[j][k]) >= big) { + big=fabs(a[j][k]); + irow=j; + icol=k; + } + } + } + ++(ipiv[icol]); + if (irow != icol) { + for (l=1;l<=n;l++) SWAP(a[irow][l],a[icol][l]) + for (l=1;l<=m;l++) SWAP(b[irow][l],b[icol][l]) + } + indxr[i]=irow; + indxc[i]=icol; + if (a[icol][icol] == 0.0) nrerror("gaussj: Singular Matrix"); + pivinv=1.0/a[icol][icol]; + a[icol][icol]=1.0; + for (l=1;l<=n;l++) a[icol][l] *= pivinv; + for (l=1;l<=m;l++) b[icol][l] *= pivinv; + for (ll=1;ll<=n;ll++) + if (ll != icol) { + dum=a[ll][icol]; + a[ll][icol]=0.0; + for (l=1;l<=n;l++) a[ll][l] -= a[icol][l]*dum; + for (l=1;l<=m;l++) b[ll][l] -= b[icol][l]*dum; + } + } + for (l=n;l>=1;l--) { + if (indxr[l] != indxc[l]) + for (k=1;k<=n;k++) + SWAP(a[k][indxr[l]],a[k][indxc[l]]); + } + free_ivector(ipiv,1,n); + free_ivector(indxr,1,n); + free_ivector(indxc,1,n); +} +#undef SWAP diff --git a/lib/nr/k_and_r/recipes/gcf.c b/lib/nr/k_and_r/recipes/gcf.c new file mode 100644 index 0000000..0502a8d --- /dev/null +++ b/lib/nr/k_and_r/recipes/gcf.c @@ -0,0 +1,37 @@ + +#include +#define ITMAX 100 +#define EPS 3.0e-7 +#define FPMIN 1.0e-30 + +void gcf(gammcf,a,x,gln) +float *gammcf,*gln,a,x; +{ + float gammln(); + void nrerror(); + int i; + float an,b,c,d,del,h; + + *gln=gammln(a); + b=x+1.0-a; + c=1.0/FPMIN; + d=1.0/b; + h=d; + for (i=1;i<=ITMAX;i++) { + an = -i*(i-a); + b += 2.0; + d=an*d+b; + if (fabs(d) < FPMIN) d=FPMIN; + c=b+an/c; + if (fabs(c) < FPMIN) c=FPMIN; + d=1.0/d; + del=d*c; + h *= del; + if (fabs(del-1.0) < EPS) break; + } + if (i > ITMAX) nrerror("a too large, ITMAX too small in gcf"); + *gammcf=exp(-x+a*log(x)-(*gln))*h; +} +#undef ITMAX +#undef EPS +#undef FPMIN diff --git a/lib/nr/k_and_r/recipes/golden.c b/lib/nr/k_and_r/recipes/golden.c new file mode 100644 index 0000000..f6c57c1 --- /dev/null +++ b/lib/nr/k_and_r/recipes/golden.c @@ -0,0 +1,44 @@ + +#include +#define R 0.61803399 +#define C (1.0-R) +#define SHFT2(a,b,c) (a)=(b);(b)=(c); +#define SHFT3(a,b,c,d) (a)=(b);(b)=(c);(c)=(d); + +float golden(ax,bx,cx,f,tol,xmin) +float (*f)(),*xmin,ax,bx,cx,tol; +{ + float f1,f2,x0,x1,x2,x3; + + x0=ax; + x3=cx; + if (fabs(cx-bx) > fabs(bx-ax)) { + x1=bx; + x2=bx+C*(cx-bx); + } else { + x2=bx; + x1=bx-C*(bx-ax); + } + f1=(*f)(x1); + f2=(*f)(x2); + while (fabs(x3-x0) > tol*(fabs(x1)+fabs(x2))) { + if (f2 < f1) { + SHFT3(x0,x1,x2,R*x1+C*x3) + SHFT2(f1,f2,(*f)(x2)) + } else { + SHFT3(x3,x2,x1,R*x2+C*x0) + SHFT2(f2,f1,(*f)(x1)) + } + } + if (f1 < f2) { + *xmin=x1; + return f1; + } else { + *xmin=x2; + return f2; + } +} +#undef C +#undef R +#undef SHFT2 +#undef SHFT3 diff --git a/lib/nr/k_and_r/recipes/gser.c b/lib/nr/k_and_r/recipes/gser.c new file mode 100644 index 0000000..97aa612 --- /dev/null +++ b/lib/nr/k_and_r/recipes/gser.c @@ -0,0 +1,36 @@ + +#include +#define ITMAX 100 +#define EPS 3.0e-7 + +void gser(gamser,a,x,gln) +float *gamser,*gln,a,x; +{ + float gammln(); + void nrerror(); + int n; + float sum,del,ap; + + *gln=gammln(a); + if (x <= 0.0) { + if (x < 0.0) nrerror("x less than 0 in routine gser"); + *gamser=0.0; + return; + } else { + ap=a; + del=sum=1.0/a; + for (n=1;n<=ITMAX;n++) { + ++ap; + del *= x/ap; + sum += del; + if (fabs(del) < fabs(sum)*EPS) { + *gamser=sum*exp(-x+a*log(x)-(*gln)); + return; + } + } + nrerror("a too large, ITMAX too small in routine gser"); + return; + } +} +#undef ITMAX +#undef EPS diff --git a/lib/nr/k_and_r/recipes/hpsel.c b/lib/nr/k_and_r/recipes/hpsel.c new file mode 100644 index 0000000..83af74c --- /dev/null +++ b/lib/nr/k_and_r/recipes/hpsel.c @@ -0,0 +1,29 @@ + +void hpsel(m,n,arr,heap) +float arr[],heap[]; +unsigned long m,n; +{ + void sort(); + void nrerror(); + unsigned long i,j,k; + float swap; + + if (m > n/2 || m < 1) nrerror("probable misuse of hpsel"); + for (i=1;i<=m;i++) heap[i]=arr[i]; + sort(m,heap); + for (i=m+1;i<=n;i++) { + if (arr[i] > heap[1]) { + heap[1]=arr[i]; + for (j=1;;) { + k=j << 1; + if (k > m) break; + if (k != m && heap[k] > heap[k+1]) k++; + if (heap[j] <= heap[k]) break; + swap=heap[k]; + heap[k]=heap[j]; + heap[j]=swap; + j=k; + } + } + } +} diff --git a/lib/nr/k_and_r/recipes/hpsort.c b/lib/nr/k_and_r/recipes/hpsort.c new file mode 100644 index 0000000..54101bc --- /dev/null +++ b/lib/nr/k_and_r/recipes/hpsort.c @@ -0,0 +1,35 @@ + +void hpsort(n,ra) +float ra[]; +unsigned long n; +{ + unsigned long i,ir,j,l; + float rra; + + if (n < 2) return; + l=(n >> 1)+1; + ir=n; + for (;;) { + if (l > 1) { + rra=ra[--l]; + } else { + rra=ra[ir]; + ra[ir]=ra[1]; + if (--ir == 1) { + ra[1]=rra; + break; + } + } + i=l; + j=l+l; + while (j <= ir) { + if (j < ir && ra[j] < ra[j+1]) j++; + if (rra < ra[j]) { + ra[i]=ra[j]; + i=j; + j <<= 1; + } else break; + } + ra[i]=rra; + } +} diff --git a/lib/nr/k_and_r/recipes/hqr.c b/lib/nr/k_and_r/recipes/hqr.c new file mode 100644 index 0000000..84f3dc3 --- /dev/null +++ b/lib/nr/k_and_r/recipes/hqr.c @@ -0,0 +1,130 @@ + +#include +#include "nrutil.h" + +void hqr(a,n,wr,wi) +float **a,wi[],wr[]; +int n; +{ + int nn,m,l,k,j,its,i,mmin; + float z,y,x,w,v,u,t,s,r,q,p,anorm; + + anorm=0.0; + for (i=1;i<=n;i++) + for (j=IMAX(i-1,1);j<=n;j++) + anorm += fabs(a[i][j]); + nn=n; + t=0.0; + while (nn >= 1) { + its=0; + do { + for (l=nn;l>=2;l--) { + s=fabs(a[l-1][l-1])+fabs(a[l][l]); + if (s == 0.0) s=anorm; + if ((float)(fabs(a[l][l-1]) + s) == s) { + a[l][l-1]=0.0; + break; + } + } + x=a[nn][nn]; + if (l == nn) { + wr[nn]=x+t; + wi[nn--]=0.0; + } else { + y=a[nn-1][nn-1]; + w=a[nn][nn-1]*a[nn-1][nn]; + if (l == (nn-1)) { + p=0.5*(y-x); + q=p*p+w; + z=sqrt(fabs(q)); + x += t; + if (q >= 0.0) { + z=p+SIGN(z,p); + wr[nn-1]=wr[nn]=x+z; + if (z) wr[nn]=x-w/z; + wi[nn-1]=wi[nn]=0.0; + } else { + wr[nn-1]=wr[nn]=x+p; + wi[nn-1]= -(wi[nn]=z); + } + nn -= 2; + } else { + if (its == 30) nrerror("Too many iterations in hqr"); + if (its == 10 || its == 20) { + t += x; + for (i=1;i<=nn;i++) a[i][i] -= x; + s=fabs(a[nn][nn-1])+fabs(a[nn-1][nn-2]); + y=x=0.75*s; + w = -0.4375*s*s; + } + ++its; + for (m=(nn-2);m>=l;m--) { + z=a[m][m]; + r=x-z; + s=y-z; + p=(r*s-w)/a[m+1][m]+a[m][m+1]; + q=a[m+1][m+1]-z-r-s; + r=a[m+2][m+1]; + s=fabs(p)+fabs(q)+fabs(r); + p /= s; + q /= s; + r /= s; + if (m == l) break; + u=fabs(a[m][m-1])*(fabs(q)+fabs(r)); + v=fabs(p)*(fabs(a[m-1][m-1])+fabs(z)+fabs(a[m+1][m+1])); + if ((float)(u+v) == v) break; + } + for (i=m+2;i<=nn;i++) { + a[i][i-2]=0.0; + if (i != (m+2)) a[i][i-3]=0.0; + } + for (k=m;k<=nn-1;k++) { + if (k != m) { + p=a[k][k-1]; + q=a[k+1][k-1]; + r=0.0; + if (k != (nn-1)) r=a[k+2][k-1]; + if ((x=fabs(p)+fabs(q)+fabs(r)) != 0.0) { + p /= x; + q /= x; + r /= x; + } + } + if ((s=SIGN(sqrt(p*p+q*q+r*r),p)) != 0.0) { + if (k == m) { + if (l != m) + a[k][k-1] = -a[k][k-1]; + } else + a[k][k-1] = -s*x; + p += s; + x=p/s; + y=q/s; + z=r/s; + q /= p; + r /= p; + for (j=k;j<=nn;j++) { + p=a[k][j]+q*a[k+1][j]; + if (k != (nn-1)) { + p += r*a[k+2][j]; + a[k+2][j] -= p*z; + } + a[k+1][j] -= p*y; + a[k][j] -= p*x; + } + mmin = nn>1)) { + if ((j = i << 1) < n && nprob[index[j]] > nprob[index[j+1]]) j++; + if (nprob[k] <= nprob[index[j]]) break; + index[i]=index[j]; + i=j; + } + index[i]=k; +} diff --git a/lib/nr/k_and_r/recipes/hufdec.c b/lib/nr/k_and_r/recipes/hufdec.c new file mode 100644 index 0000000..2e05769 --- /dev/null +++ b/lib/nr/k_and_r/recipes/hufdec.c @@ -0,0 +1,28 @@ + +typedef struct { + unsigned long *icod,*ncod,*left,*right,nch,nodemax; +} huffcode; + +void hufdec(ich,code,lcode,nb,hcode) +huffcode *hcode; +unsigned char *code; +unsigned long *ich,*nb,lcode; +{ + long nc,node; + static unsigned char setbit[8]={0x1,0x2,0x4,0x8,0x10,0x20,0x40,0x80}; + + node=hcode->nodemax; + for (;;) { + nc=(*nb >> 3); + if (++nc > lcode) { + *ich=hcode->nch; + return; + } + node=(code[nc] & setbit[7 & (*nb)++] ? + hcode->right[node] : hcode->left[node]); + if (node <= hcode->nch) { + *ich=node-1; + return; + } + } +} diff --git a/lib/nr/k_and_r/recipes/hufenc.c b/lib/nr/k_and_r/recipes/hufenc.c new file mode 100644 index 0000000..cb588da --- /dev/null +++ b/lib/nr/k_and_r/recipes/hufenc.c @@ -0,0 +1,40 @@ + +#include + +typedef struct { + unsigned long *icod,*ncod,*left,*right,nch,nodemax; +} huffcode; + +void hufenc(ich,codep,lcode,nb,hcode) +huffcode *hcode; +unsigned char **codep; +unsigned long *lcode,*nb,ich; +{ + char *realloc(); + void nrerror(); + int l,n; + unsigned long k,nc; + static unsigned long setbit[32]={0x1L,0x2L,0x4L,0x8L,0x10L,0x20L, + 0x40L,0x80L,0x100L,0x200L,0x400L,0x800L,0x1000L,0x2000L, + 0x4000L,0x8000L,0x10000L,0x20000L,0x40000L,0x80000L,0x100000L, + 0x200000L,0x400000L,0x800000L,0x1000000L,0x2000000L,0x4000000L, + 0x8000000L,0x10000000L,0x20000000L,0x40000000L,0x80000000L}; + + k=ich+1; + if (k > hcode->nch || k < 1) nrerror("ich out of range in hufenc."); + for (n=hcode->ncod[k]-1;n>=0;n--,++(*nb)) { + nc=(*nb >> 3); + if (++nc >= *lcode) { + fprintf(stderr,"Reached the end of the 'code' array.\n"); + fprintf(stderr,"Attempting to expand its size.\n"); + *lcode *= 1.5; + if ((*codep=(unsigned char *)realloc(*codep, + (unsigned)(*lcode*sizeof(unsigned char)))) == NULL) { + nrerror("Size expansion failed."); + } + } + l=(*nb) & 7; + if (!l) (*codep)[nc]=0; + if (hcode->icod[k] & setbit[n]) (*codep)[nc] |= setbit[l]; + } +} diff --git a/lib/nr/k_and_r/recipes/hufmak.c b/lib/nr/k_and_r/recipes/hufmak.c new file mode 100644 index 0000000..cc9337d --- /dev/null +++ b/lib/nr/k_and_r/recipes/hufmak.c @@ -0,0 +1,67 @@ + +#include "nrutil.h" + +typedef struct { + unsigned long *icod,*ncod,*left,*right,nch,nodemax; +} huffcode; + +void hufmak(nfreq,nchin,ilong,nlong,hcode) +huffcode *hcode; +unsigned long *ilong,*nlong,nchin,nfreq[]; +{ + void hufapp(); + int ibit; + long node,*up; + unsigned long j,k,*index,n,nused,*nprob; + static unsigned long setbit[32]={0x1L,0x2L,0x4L,0x8L,0x10L,0x20L, + 0x40L,0x80L,0x100L,0x200L,0x400L,0x800L,0x1000L,0x2000L, + 0x4000L,0x8000L,0x10000L,0x20000L,0x40000L,0x80000L,0x100000L, + 0x200000L,0x400000L,0x800000L,0x1000000L,0x2000000L,0x4000000L, + 0x8000000L,0x10000000L,0x20000000L,0x40000000L,0x80000000L}; + + hcode->nch=nchin; + index=lvector(1,(long)(2*hcode->nch-1)); + up=(long *)lvector(1,(long)(2*hcode->nch-1)); + nprob=lvector(1,(long)(2*hcode->nch-1)); + for (nused=0,j=1;j<=hcode->nch;j++) { + nprob[j]=nfreq[j]; + hcode->icod[j]=hcode->ncod[j]=0; + if (nfreq[j]) index[++nused]=j; + } + for (j=nused;j>=1;j--) hufapp(index,nprob,nused,j); + k=hcode->nch; + while (nused > 1) { + node=index[1]; + index[1]=index[nused--]; + hufapp(index,nprob,nused,1); + nprob[++k]=nprob[index[1]]+nprob[node]; + hcode->left[k]=node; + hcode->right[k]=index[1]; + up[index[1]] = -(long)k; + up[node]=index[1]=k; + hufapp(index,nprob,nused,1); + } + up[hcode->nodemax=k]=0; + for (j=1;j<=hcode->nch;j++) { + if (nprob[j]) { + for (n=0,ibit=0,node=up[j];node;node=up[node],ibit++) { + if (node < 0) { + n |= setbit[ibit]; + node = -node; + } + } + hcode->icod[j]=n; + hcode->ncod[j]=ibit; + } + } + *nlong=0; + for (j=1;j<=hcode->nch;j++) { + if (hcode->ncod[j] > *nlong) { + *nlong=hcode->ncod[j]; + *ilong=j-1; + } + } + free_lvector(nprob,1,(long)(2*hcode->nch-1)); + free_lvector((unsigned long *)up,1,(long)(2*hcode->nch-1)); + free_lvector(index,1,(long)(2*hcode->nch-1)); +} diff --git a/lib/nr/k_and_r/recipes/hunt.c b/lib/nr/k_and_r/recipes/hunt.c new file mode 100644 index 0000000..965d936 --- /dev/null +++ b/lib/nr/k_and_r/recipes/hunt.c @@ -0,0 +1,53 @@ + +void hunt(xx,n,x,jlo) +float x,xx[]; +unsigned long *jlo,n; +{ + unsigned long jm,jhi,inc; + int ascnd; + + ascnd=(xx[n] >= xx[1]); + if (*jlo <= 0 || *jlo > n) { + *jlo=0; + jhi=n+1; + } else { + inc=1; + if (x >= xx[*jlo] == ascnd) { + if (*jlo == n) return; + jhi=(*jlo)+1; + while (x >= xx[jhi] == ascnd) { + *jlo=jhi; + inc += inc; + jhi=(*jlo)+inc; + if (jhi > n) { + jhi=n+1; + break; + } + } + } else { + if (*jlo == 1) { + *jlo=0; + return; + } + jhi=(*jlo)--; + while (x < xx[*jlo] == ascnd) { + jhi=(*jlo); + inc <<= 1; + if (inc >= jhi) { + *jlo=0; + break; + } + else *jlo=jhi-inc; + } + } + } + while (jhi-(*jlo) != 1) { + jm=(jhi+(*jlo)) >> 1; + if (x >= xx[jm] == ascnd) + *jlo=jm; + else + jhi=jm; + } + if (x == xx[n]) *jlo=n-1; + if (x == xx[1]) *jlo=1; +} diff --git a/lib/nr/k_and_r/recipes/hypdrv.c b/lib/nr/k_and_r/recipes/hypdrv.c new file mode 100644 index 0000000..d5de0aa --- /dev/null +++ b/lib/nr/k_and_r/recipes/hypdrv.c @@ -0,0 +1,24 @@ + +#include "complex.h" +#define ONE Complex(1.0,0.0) + +extern fcomplex aa,bb,cc,z0,dz; + +void hypdrv(s,yy,dyyds) +float dyyds[],s,yy[]; +{ + fcomplex z,y[3],dyds[3]; + + y[1]=Complex(yy[1],yy[2]); + y[2]=Complex(yy[3],yy[4]); + z=Cadd(z0,RCmul(s,dz)); + dyds[1]=Cmul(y[2],dz); + dyds[2]=Cmul(Csub(Cmul(Cmul(aa,bb),y[1]),Cmul(Csub(cc, + Cmul(Cadd(Cadd(aa,bb),ONE),z)),y[2])), + Cdiv(dz,Cmul(z,Csub(ONE,z)))); + dyyds[1]=dyds[1].r; + dyyds[2]=dyds[1].i; + dyyds[3]=dyds[2].r; + dyyds[4]=dyds[2].i; +} +#undef ONE diff --git a/lib/nr/k_and_r/recipes/hypgeo.c b/lib/nr/k_and_r/recipes/hypgeo.c new file mode 100644 index 0000000..17ed86e --- /dev/null +++ b/lib/nr/k_and_r/recipes/hypgeo.c @@ -0,0 +1,43 @@ + +#include +#include "complex.h" +#include "nrutil.h" +#define EPS 1.0e-6 + +fcomplex aa,bb,cc,z0,dz; + +int kmax,kount; +float *xp,**yp,dxsav; + +fcomplex hypgeo(a,b,c,z) +fcomplex a,b,c,z; +{ + void bsstep(),hypdrv(),hypser(),odeint(); + int nbad,nok; + fcomplex ans,y[3]; + float *yy; + + kmax=0; + if (z.r*z.r+z.i*z.i <= 0.25) { + hypser(a,b,c,z,&ans,&y[2]); + return ans; + } + else if (z.r < 0.0) z0=Complex(-0.5,0.0); + else if (z.r <= 1.0) z0=Complex(0.5,0.0); + else z0=Complex(0.0,z.i >= 0.0 ? 0.5 : -0.5); + aa=a; + bb=b; + cc=c; + dz=Csub(z,z0); + hypser(aa,bb,cc,z0,&y[1],&y[2]); + yy=vector(1,4); + yy[1]=y[1].r; + yy[2]=y[1].i; + yy[3]=y[2].r; + yy[4]=y[2].i; + odeint(yy,4,0.0,1.0,EPS,0.1,0.0001,&nok,&nbad,hypdrv,bsstep); + y[1]=Complex(yy[1],yy[2]); + free_vector(yy,1,4); + return y[1]; +} +#undef EPS diff --git a/lib/nr/k_and_r/recipes/hypser.c b/lib/nr/k_and_r/recipes/hypser.c new file mode 100644 index 0000000..eebbfd4 --- /dev/null +++ b/lib/nr/k_and_r/recipes/hypser.c @@ -0,0 +1,34 @@ + +#include "complex.h" +#define ONE Complex(1.0,0.0) + +void hypser(a,b,c,z,series,deriv) +fcomplex *deriv,*series,a,b,c,z; +{ + void nrerror(); + int n; + fcomplex aa,bb,cc,fac,temp; + + deriv->r=0.0; + deriv->i=0.0; + fac=Complex(1.0,0.0); + temp=fac; + aa=a; + bb=b; + cc=c; + for (n=1;n<=1000;n++) { + fac=Cmul(fac,Cdiv(Cmul(aa,bb),cc)); + deriv->r+=fac.r; + deriv->i+=fac.i; + fac=Cmul(fac,RCmul(1.0/n,z)); + *series=Cadd(temp,fac); + if (series->r == temp.r && series->i == temp.i) return; + temp= *series; + aa=Cadd(aa,ONE); + bb=Cadd(bb,ONE); + cc=Cadd(cc,ONE); + + } + nrerror("convergence failure in hypser"); +} +#undef ONE diff --git a/lib/nr/k_and_r/recipes/icrc.c b/lib/nr/k_and_r/recipes/icrc.c new file mode 100644 index 0000000..ace1f97 --- /dev/null +++ b/lib/nr/k_and_r/recipes/icrc.c @@ -0,0 +1,34 @@ + +typedef unsigned char uchar; +#define LOBYTE(x) ((uchar)((x) & 0xFF)) +#define HIBYTE(x) ((uchar)((x) >> 8)) + +unsigned short icrc(crc,bufptr,len,jinit,jrev) +int jrev; +short jinit; +unsigned char *bufptr; +unsigned long len; +unsigned short crc; +{ + unsigned short icrc1(); + static unsigned short icrctb[256],init=0; + static uchar rchr[256]; + unsigned short j,cword=crc; + static uchar it[16]={0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15}; + + if (!init) { + init=1; + for (j=0;j<=255;j++) { + icrctb[j]=icrc1(j << 8,(uchar)0); + rchr[j]=(uchar)(it[j & 0xF] << 4 | it[j >> 4]); + } + } + if (jinit >= 0) cword=((uchar) jinit) | (((uchar) jinit) << 8); + else if (jrev < 0) cword=rchr[HIBYTE(cword)] | rchr[LOBYTE(cword)] << 8; + for (j=1;j<=len;j++) + cword=icrctb[(jrev < 0 ? rchr[bufptr[j]] : + bufptr[j]) ^ HIBYTE(cword)] ^ LOBYTE(cword) << 8; + return (jrev >= 0 ? cword : rchr[HIBYTE(cword)] | rchr[LOBYTE(cword)] << 8); +} +#undef LOBYTE +#undef HIBYTE diff --git a/lib/nr/k_and_r/recipes/icrc1.c b/lib/nr/k_and_r/recipes/icrc1.c new file mode 100644 index 0000000..c1aa383 --- /dev/null +++ b/lib/nr/k_and_r/recipes/icrc1.c @@ -0,0 +1,16 @@ + +unsigned short icrc1(crc,onech) +unsigned char onech; +unsigned short crc; +{ + int i; + unsigned short ans=(crc ^ onech << 8); + + for (i=0;i<8;i++) { + if (ans & 0x8000) + ans = (ans <<= 1) ^ 4129; + else + ans <<= 1; + } + return ans; +} diff --git a/lib/nr/k_and_r/recipes/igray.c b/lib/nr/k_and_r/recipes/igray.c new file mode 100644 index 0000000..a600eb8 --- /dev/null +++ b/lib/nr/k_and_r/recipes/igray.c @@ -0,0 +1,18 @@ + +unsigned long igray(n,is) +int is; +unsigned long n; +{ + int ish; + unsigned long ans,idiv; + + if (is >= 0) + return n ^ (n >> 1); + ish=1; + ans=n; + for (;;) { + ans ^= (idiv=ans >> ish); + if (idiv <= 1 || ish == 16) return ans; + ish <<= 1; + } +} diff --git a/lib/nr/k_and_r/recipes/iindexx.c b/lib/nr/k_and_r/recipes/iindexx.c new file mode 100644 index 0000000..807f4be --- /dev/null +++ b/lib/nr/k_and_r/recipes/iindexx.c @@ -0,0 +1,72 @@ + +#include "nrutil.h" +#define SWAP(a,b) itemp=(a);(a)=(b);(b)=itemp; +#define M 7 +#define NSTACK 50 + +void iindexx(n,arr,indx) +long arr[]; +unsigned long indx[],n; +{ + unsigned long i,indxt,ir=n,itemp,j,k,l=1; + int jstack=0,*istack; + long a; + + istack=ivector(1,NSTACK); + for (j=1;j<=n;j++) indx[j]=j; + for (;;) { + if (ir-l < M) { + for (j=l+1;j<=ir;j++) { + indxt=indx[j]; + a=arr[indxt]; + for (i=j-1;i>=l;i--) { + if (arr[indx[i]] <= a) break; + indx[i+1]=indx[i]; + } + indx[i+1]=indxt; + } + if (jstack == 0) break; + ir=istack[jstack--]; + l=istack[jstack--]; + } else { + k=(l+ir) >> 1; + SWAP(indx[k],indx[l+1]); + if (arr[indx[l]] > arr[indx[ir]]) { + SWAP(indx[l],indx[ir]) + } + if (arr[indx[l+1]] > arr[indx[ir]]) { + SWAP(indx[l+1],indx[ir]) + } + if (arr[indx[l]] > arr[indx[l+1]]) { + SWAP(indx[l],indx[l+1]) + } + i=l+1; + j=ir; + indxt=indx[l+1]; + a=arr[indxt]; + for (;;) { + do i++; while (arr[indx[i]] < a); + do j--; while (arr[indx[j]] > a); + if (j < i) break; + SWAP(indx[i],indx[j]) + } + indx[l+1]=indx[j]; + indx[j]=indxt; + jstack += 2; + if (jstack > NSTACK) nrerror("NSTACK too small in iindexx."); + if (ir-i+1 >= j-l) { + istack[jstack]=ir; + istack[jstack-1]=i; + ir=j-1; + } else { + istack[jstack]=j-1; + istack[jstack-1]=l; + l=i; + } + } + } + free_ivector(istack,1,NSTACK); +} +#undef M +#undef NSTACK +#undef SWAP diff --git a/lib/nr/k_and_r/recipes/indexx.c b/lib/nr/k_and_r/recipes/indexx.c new file mode 100644 index 0000000..344aa43 --- /dev/null +++ b/lib/nr/k_and_r/recipes/indexx.c @@ -0,0 +1,72 @@ + +#include "nrutil.h" +#define SWAP(a,b) itemp=(a);(a)=(b);(b)=itemp; +#define M 7 +#define NSTACK 50 + +void indexx(n,arr,indx) +float arr[]; +unsigned long indx[],n; +{ + unsigned long i,indxt,ir=n,itemp,j,k,l=1; + int jstack=0,*istack; + float a; + + istack=ivector(1,NSTACK); + for (j=1;j<=n;j++) indx[j]=j; + for (;;) { + if (ir-l < M) { + for (j=l+1;j<=ir;j++) { + indxt=indx[j]; + a=arr[indxt]; + for (i=j-1;i>=l;i--) { + if (arr[indx[i]] <= a) break; + indx[i+1]=indx[i]; + } + indx[i+1]=indxt; + } + if (jstack == 0) break; + ir=istack[jstack--]; + l=istack[jstack--]; + } else { + k=(l+ir) >> 1; + SWAP(indx[k],indx[l+1]); + if (arr[indx[l]] > arr[indx[ir]]) { + SWAP(indx[l],indx[ir]) + } + if (arr[indx[l+1]] > arr[indx[ir]]) { + SWAP(indx[l+1],indx[ir]) + } + if (arr[indx[l]] > arr[indx[l+1]]) { + SWAP(indx[l],indx[l+1]) + } + i=l+1; + j=ir; + indxt=indx[l+1]; + a=arr[indxt]; + for (;;) { + do i++; while (arr[indx[i]] < a); + do j--; while (arr[indx[j]] > a); + if (j < i) break; + SWAP(indx[i],indx[j]) + } + indx[l+1]=indx[j]; + indx[j]=indxt; + jstack += 2; + if (jstack > NSTACK) nrerror("NSTACK too small in indexx."); + if (ir-i+1 >= j-l) { + istack[jstack]=ir; + istack[jstack-1]=i; + ir=j-1; + } else { + istack[jstack]=j-1; + istack[jstack-1]=l; + l=i; + } + } + } + free_ivector(istack,1,NSTACK); +} +#undef M +#undef NSTACK +#undef SWAP diff --git a/lib/nr/k_and_r/recipes/interp.c b/lib/nr/k_and_r/recipes/interp.c new file mode 100644 index 0000000..613a917 --- /dev/null +++ b/lib/nr/k_and_r/recipes/interp.c @@ -0,0 +1,17 @@ + +void interp(uf,uc,nf) +double **uc,**uf; +int nf; +{ + int ic,iif,jc,jf,nc; + nc=nf/2+1; + for (jc=1,jf=1;jc<=nc;jc++,jf+=2) + for (ic=1;ic<=nc;ic++) uf[2*ic-1][jf]=uc[ic][jc]; + for (jf=1;jf<=nf;jf+=2) + for (iif=2;iif> 17) & 1 + ^ (*iseed >> 4) & 1 + ^ (*iseed >> 1) & 1 + ^ (*iseed & 1); + *iseed=(*iseed << 1) | newbit; + return (int) newbit; +} diff --git a/lib/nr/k_and_r/recipes/irbit2.c b/lib/nr/k_and_r/recipes/irbit2.c new file mode 100644 index 0000000..15ae50a --- /dev/null +++ b/lib/nr/k_and_r/recipes/irbit2.c @@ -0,0 +1,23 @@ + +#define IB1 1 +#define IB2 2 +#define IB5 16 +#define IB18 131072 +#define MASK (IB1+IB2+IB5) + +int irbit2(iseed) +unsigned long *iseed; +{ + if (*iseed & IB18) { + *iseed=((*iseed ^ MASK) << 1) | IB1; + return 1; + } else { + *iseed <<= 1; + return 0; + } +} +#undef MASK +#undef IB18 +#undef IB5 +#undef IB2 +#undef IB1 diff --git a/lib/nr/k_and_r/recipes/jacobi.c b/lib/nr/k_and_r/recipes/jacobi.c new file mode 100644 index 0000000..0700cff --- /dev/null +++ b/lib/nr/k_and_r/recipes/jacobi.c @@ -0,0 +1,88 @@ + +#include +#include "nrutil.h" +#define ROTATE(a,i,j,k,l) g=a[i][j];h=a[k][l];a[i][j]=g-s*(h+g*tau);\ + a[k][l]=h+s*(g-h*tau); + +void jacobi(a,n,d,v,nrot) +float **a,**v,d[]; +int *nrot,n; +{ + int j,iq,ip,i; + float tresh,theta,tau,t,sm,s,h,g,c,*b,*z; + + b=vector(1,n); + z=vector(1,n); + for (ip=1;ip<=n;ip++) { + for (iq=1;iq<=n;iq++) v[ip][iq]=0.0; + v[ip][ip]=1.0; + } + for (ip=1;ip<=n;ip++) { + b[ip]=d[ip]=a[ip][ip]; + z[ip]=0.0; + } + *nrot=0; + for (i=1;i<=50;i++) { + sm=0.0; + for (ip=1;ip<=n-1;ip++) { + for (iq=ip+1;iq<=n;iq++) + sm += fabs(a[ip][iq]); + } + if (sm == 0.0) { + free_vector(z,1,n); + free_vector(b,1,n); + return; + } + if (i < 4) + tresh=0.2*sm/(n*n); + else + tresh=0.0; + for (ip=1;ip<=n-1;ip++) { + for (iq=ip+1;iq<=n;iq++) { + g=100.0*fabs(a[ip][iq]); + if (i > 4 && (float)(fabs(d[ip])+g) == (float)fabs(d[ip]) + && (float)(fabs(d[iq])+g) == (float)fabs(d[iq])) + a[ip][iq]=0.0; + else if (fabs(a[ip][iq]) > tresh) { + h=d[iq]-d[ip]; + if ((float)(fabs(h)+g) == (float)fabs(h)) + t=(a[ip][iq])/h; + else { + theta=0.5*h/(a[ip][iq]); + t=1.0/(fabs(theta)+sqrt(1.0+theta*theta)); + if (theta < 0.0) t = -t; + } + c=1.0/sqrt(1+t*t); + s=t*c; + tau=s/(1.0+c); + h=t*a[ip][iq]; + z[ip] -= h; + z[iq] += h; + d[ip] -= h; + d[iq] += h; + a[ip][iq]=0.0; + for (j=1;j<=ip-1;j++) { + ROTATE(a,j,ip,j,iq) + } + for (j=ip+1;j<=iq-1;j++) { + ROTATE(a,ip,j,j,iq) + } + for (j=iq+1;j<=n;j++) { + ROTATE(a,ip,j,iq,j) + } + for (j=1;j<=n;j++) { + ROTATE(v,j,ip,j,iq) + } + ++(*nrot); + } + } + } + for (ip=1;ip<=n;ip++) { + b[ip] += z[ip]; + d[ip]=b[ip]; + z[ip]=0.0; + } + } + nrerror("Too many iterations in routine jacobi"); +} +#undef ROTATE diff --git a/lib/nr/k_and_r/recipes/jacobn.c b/lib/nr/k_and_r/recipes/jacobn.c new file mode 100644 index 0000000..2a80c79 --- /dev/null +++ b/lib/nr/k_and_r/recipes/jacobn.c @@ -0,0 +1,26 @@ + +void jacobn(x,y,dfdx,dfdy,n) +float **dfdy,dfdx[],x,y[]; +int n; +{ + int i; + + for (i=1;i<=n;i++) dfdx[i]=0.0; + dfdy[1][1] = -0.013-1000.0*y[3]; + dfdy[1][2]=0.0; + dfdy[1][3] = -1000.0*y[1]; + dfdy[2][1]=0.0; + dfdy[2][2] = -2500.0*y[3]; + dfdy[2][3] = -2500.0*y[2]; + dfdy[3][1] = -0.013-1000.0*y[3]; + dfdy[3][2] = -2500.0*y[3]; + dfdy[3][3] = -1000.0*y[1]-2500.0*y[2]; +} + +void derivs(x,y,dydx) +float dydx[],x,y[]; +{ + dydx[1] = -0.013*y[1]-1000.0*y[1]*y[3]; + dydx[2] = -2500.0*y[2]*y[3]; + dydx[3] = -0.013*y[1]-1000.0*y[1]*y[3]-2500.0*y[2]*y[3]; +} diff --git a/lib/nr/k_and_r/recipes/julday.c b/lib/nr/k_and_r/recipes/julday.c new file mode 100644 index 0000000..034a2b5 --- /dev/null +++ b/lib/nr/k_and_r/recipes/julday.c @@ -0,0 +1,27 @@ + +#include +#define IGREG (15+31L*(10+12L*1582)) + +long julday(mm,id,iyyy) +int id,iyyy,mm; +{ + void nrerror(); + long jul; + int ja,jy=iyyy,jm; + + if (jy == 0) nrerror("julday: there is no year zero."); + if (jy < 0) ++jy; + if (mm > 2) { + jm=mm+1; + } else { + --jy; + jm=mm+13; + } + jul = (long) (floor(365.25*jy)+floor(30.6001*jm)+id+1720995); + if (id+31L*(mm+12L*iyyy) >= IGREG) { + ja=(int)(0.01*jy); + jul += 2-ja+(int) (0.25*ja); + } + return jul; +} +#undef IGREG diff --git a/lib/nr/k_and_r/recipes/kendl1.c b/lib/nr/k_and_r/recipes/kendl1.c new file mode 100644 index 0000000..20c740d --- /dev/null +++ b/lib/nr/k_and_r/recipes/kendl1.c @@ -0,0 +1,32 @@ + +#include + +void kendl1(data1,data2,n,tau,z,prob) +float *prob,*tau,*z,data1[],data2[]; +unsigned long n; +{ + float erfcc(); + unsigned long n2=0,n1=0,k,j; + long is=0; + float svar,aa,a2,a1; + + for (j=1;j 0.0 ? ++is : --is; + } else { + if (a1) ++n1; + if (a2) ++n2; + } + } + } + *tau=is/(sqrt((double) n1)*sqrt((double) n2)); + svar=(4.0*n+10.0)/(9.0*n*(n-1.0)); + *z=(*tau)/sqrt(svar); + *prob=erfcc(fabs(*z)/1.4142136); +} diff --git a/lib/nr/k_and_r/recipes/kendl2.c b/lib/nr/k_and_r/recipes/kendl2.c new file mode 100644 index 0000000..2558a11 --- /dev/null +++ b/lib/nr/k_and_r/recipes/kendl2.c @@ -0,0 +1,37 @@ + +#include + +void kendl2(tab,i,j,tau,z,prob) +float **tab,*prob,*tau,*z; +int i,j; +{ + float erfcc(); + long nn,mm,m2,m1,lj,li,l,kj,ki,k; + float svar,s=0.0,points,pairs,en2=0.0,en1=0.0; + + nn=i*j; + points=tab[i][j]; + for (k=0;k<=nn-2;k++) { + ki=(k/j); + kj=k-j*ki; + points += tab[ki+1][kj+1]; + for (l=k+1;l<=nn-1;l++) { + li=l/j; + lj=l-j*li; + mm=(m1=li-ki)*(m2=lj-kj); + pairs=tab[ki+1][kj+1]*tab[li+1][lj+1]; + if (mm) { + en1 += pairs; + en2 += pairs; + s += (mm > 0 ? pairs : -pairs); + } else { + if (m1) en1 += pairs; + if (m2) en2 += pairs; + } + } + } + *tau=s/sqrt(en1*en2); + svar=(4.0*points+10.0)/(9.0*points*(points-1.0)); + *z=(*tau)/sqrt(svar); + *prob=erfcc(fabs(*z)/1.4142136); +} diff --git a/lib/nr/k_and_r/recipes/kermom.c b/lib/nr/k_and_r/recipes/kermom.c new file mode 100644 index 0000000..17970dd --- /dev/null +++ b/lib/nr/k_and_r/recipes/kermom.c @@ -0,0 +1,31 @@ + +#include + +extern double x; + +void kermom(w,y,m) +double w[],y; +int m; +{ + double d,df,clog,x2,x3,x4,y2; + + if (y >= x) { + d=y-x; + df=2.0*sqrt(d)*d; + w[1]=df/3.0; + w[2]=df*(x/3.0+d/5.0); + w[3]=df*((x/3.0 + 0.4*d)*x + d*d/7.0); + w[4]=df*(((x/3.0 + 0.6*d)*x + 3.0*d*d/7.0)*x+d*d*d/9.0); + } else { + x3=(x2=x*x)*x; + x4=x2*x2; + y2=y*y; + d=x-y; + w[1]=d*((clog=log(d))-1.0); + w[2] = -0.25*(3.0*x+y-2.0*clog*(x+y))*d; + w[3]=(-11.0*x3+y*(6.0*x2+y*(3.0*x+2.0*y)) + +6.0*clog*(x3-y*y2))/18.0; + w[4]=(-25.0*x4+y*(12.0*x3+y*(6.0*x2+y* + (4.0*x+3.0*y)))+12.0*clog*(x4-(y2*y2)))/48.0; + } +} diff --git a/lib/nr/k_and_r/recipes/ks2d1s.c b/lib/nr/k_and_r/recipes/ks2d1s.c new file mode 100644 index 0000000..95bae99 --- /dev/null +++ b/lib/nr/k_and_r/recipes/ks2d1s.c @@ -0,0 +1,28 @@ + +#include +#include "nrutil.h" + +void ks2d1s(x1,y1,n1,quadvl,d1,prob) +float *d1,*prob,x1[],y1[]; +unsigned long n1; +void (*quadvl)(); +{ + float probks(); + void pearsn(),quadct(); + unsigned long j; + float dum,dumm,fa,fb,fc,fd,ga,gb,gc,gd,r1,rr,sqen; + + *d1=0.0; + for (j=1;j<=n1;j++) { + quadct(x1[j],y1[j],x1,y1,n1,&fa,&fb,&fc,&fd); + (*quadvl)(x1[j],y1[j],&ga,&gb,&gc,&gd); + *d1=FMAX(*d1,fabs(fa-ga)); + *d1=FMAX(*d1,fabs(fb-gb)); + *d1=FMAX(*d1,fabs(fc-gc)); + *d1=FMAX(*d1,fabs(fd-gd)); + } + pearsn(x1,y1,n1,&r1,&dum,&dumm); + sqen=sqrt((double)n1); + rr=sqrt(1.0-r1*r1); + *prob=probks(*d1*sqen/(1.0+rr*(0.25-0.75/sqen))); +} diff --git a/lib/nr/k_and_r/recipes/ks2d2s.c b/lib/nr/k_and_r/recipes/ks2d2s.c new file mode 100644 index 0000000..08f938c --- /dev/null +++ b/lib/nr/k_and_r/recipes/ks2d2s.c @@ -0,0 +1,38 @@ + +#include +#include "nrutil.h" + +void ks2d2s(x1,y1,n1,x2,y2,n2,d,prob) +float *d,*prob,x1[],x2[],y1[],y2[]; +unsigned long n1,n2; +{ + float probks(); + void pearsn(),quadct(); + unsigned long j; + float d1,d2,dum,dumm,fa,fb,fc,fd,ga,gb,gc,gd,r1,r2,rr,sqen; + + d1=0.0; + for (j=1;j<=n1;j++) { + quadct(x1[j],y1[j],x1,y1,n1,&fa,&fb,&fc,&fd); + quadct(x1[j],y1[j],x2,y2,n2,&ga,&gb,&gc,&gd); + d1=FMAX(d1,fabs(fa-ga)); + d1=FMAX(d1,fabs(fb-gb)); + d1=FMAX(d1,fabs(fc-gc)); + d1=FMAX(d1,fabs(fd-gd)); + } + d2=0.0; + for (j=1;j<=n2;j++) { + quadct(x2[j],y2[j],x1,y1,n1,&fa,&fb,&fc,&fd); + quadct(x2[j],y2[j],x2,y2,n2,&ga,&gb,&gc,&gd); + d2=FMAX(d2,fabs(fa-ga)); + d2=FMAX(d2,fabs(fb-gb)); + d2=FMAX(d2,fabs(fc-gc)); + d2=FMAX(d2,fabs(fd-gd)); + } + *d=0.5*(d1+d2); + sqen=sqrt(n1*n2/(double)(n1+n2)); + pearsn(x1,y1,n1,&r1,&dum,&dumm); + pearsn(x2,y2,n2,&r2,&dum,&dumm); + rr=sqrt(1.0-0.5*(r1*r1+r2*r2)); + *prob=probks(*d*sqen/(1.0+rr*(0.25-0.75/sqen))); +} diff --git a/lib/nr/k_and_r/recipes/ksone.c b/lib/nr/k_and_r/recipes/ksone.c new file mode 100644 index 0000000..e46e969 --- /dev/null +++ b/lib/nr/k_and_r/recipes/ksone.c @@ -0,0 +1,26 @@ + +#include +#include "nrutil.h" + +void ksone(data,n,func,d,prob) +float (*func)(),*d,*prob,data[]; +unsigned long n; +{ + float probks(); + void sort(); + unsigned long j; + float dt,en,ff,fn,fo=0.0; + + sort(n,data); + en=n; + *d=0.0; + for (j=1;j<=n;j++) { + fn=j/en; + ff=(*func)(data[j]); + dt=FMAX(fabs(fo-ff),fabs(fn-ff)); + if (dt > *d) *d=dt; + fo=fn; + } + en=sqrt(en); + *prob=probks((en+0.12+0.11/en)*(*d)); +} diff --git a/lib/nr/k_and_r/recipes/kstwo.c b/lib/nr/k_and_r/recipes/kstwo.c new file mode 100644 index 0000000..72407ad --- /dev/null +++ b/lib/nr/k_and_r/recipes/kstwo.c @@ -0,0 +1,25 @@ + +#include + +void kstwo(data1,n1,data2,n2,d,prob) +float *d,*prob,data1[],data2[]; +unsigned long n1,n2; +{ + float probks(); + void sort(); + unsigned long j1=1,j2=1; + float d1,d2,dt,en1,en2,en,fn1=0.0,fn2=0.0; + + sort(n1,data1); + sort(n2,data2); + en1=n1; + en2=n2; + *d=0.0; + while (j1 <= n1 && j2 <= n2) { + if ((d1=data1[j1]) <= (d2=data2[j2])) fn1=j1++/en1; + if (d2 <= d1) fn2=j2++/en2; + if ((dt=fabs(fn2-fn1)) > *d) *d=dt; + } + en=sqrt(en1*en2/(en1+en2)); + *prob=probks((en+0.12+0.11/en)*(*d)); +} diff --git a/lib/nr/k_and_r/recipes/laguer.c b/lib/nr/k_and_r/recipes/laguer.c new file mode 100644 index 0000000..8b5557d --- /dev/null +++ b/lib/nr/k_and_r/recipes/laguer.c @@ -0,0 +1,55 @@ + +#include +#include "complex.h" +#include "nrutil.h" +#define EPSS 1.0e-7 +#define MR 8 +#define MT 10 +#define MAXIT (MT*MR) + +void laguer(a,m,x,its) +fcomplex *x,a[]; +int *its,m; +{ + int iter,j; + float abx,abp,abm,err; + fcomplex dx,x1,b,d,f,g,h,sq,gp,gm,g2; + static float frac[MR+1] = {0.0,0.5,0.25,0.75,0.13,0.38,0.62,0.88,1.0}; + + for (iter=1;iter<=MAXIT;iter++) { + *its=iter; + b=a[m]; + err=Cabs(b); + d=f=Complex(0.0,0.0); + abx=Cabs(*x); + for (j=m-1;j>=0;j--) { + f=Cadd(Cmul(*x,f),d); + d=Cadd(Cmul(*x,d),b); + b=Cadd(Cmul(*x,b),a[j]); + err=Cabs(b)+abx*err; + } + err *= EPSS; + if (Cabs(b) <= err) return; + g=Cdiv(d,b); + g2=Cmul(g,g); + h=Csub(g2,RCmul(2.0,Cdiv(f,b))); + sq=Csqrt(RCmul((float) (m-1),Csub(RCmul((float) m,h),g2))); + gp=Cadd(g,sq); + gm=Csub(g,sq); + abp=Cabs(gp); + abm=Cabs(gm); + if (abp < abm) gp=gm; + dx=((FMAX(abp,abm) > 0.0 ? Cdiv(Complex((float) m,0.0),gp) + : RCmul(1+abx,Complex(cos((float)iter),sin((float)iter))))); + x1=Csub(*x,dx); + if (x->r == x1.r && x->i == x1.i) return; + if (iter % MT) *x=x1; + else *x=Csub(*x,RCmul(frac[iter/MT],dx)); + } + nrerror("too many iterations in laguer"); + return; +} +#undef EPSS +#undef MR +#undef MT +#undef MAXIT diff --git a/lib/nr/k_and_r/recipes/lfit.c b/lib/nr/k_and_r/recipes/lfit.c new file mode 100644 index 0000000..1beb830 --- /dev/null +++ b/lib/nr/k_and_r/recipes/lfit.c @@ -0,0 +1,54 @@ + +#include "nrutil.h" + +void lfit(x,y,sig,ndat,a,ia,ma,covar,chisq,funcs) +float **covar,*chisq,a[],sig[],x[],y[]; +int ia[],ma,ndat; +void (*funcs)(); +{ + void covsrt(),gaussj(); + int i,j,k,l,m,mfit=0; + float ym,wt,sum,sig2i,**beta,*afunc; + + beta=matrix(1,ma,1,1); + afunc=vector(1,ma); + for (j=1;j<=ma;j++) + if (ia[j]) mfit++; + if (mfit == 0) nrerror("lfit: no parameters to be fitted"); + for (j=1;j<=mfit;j++) { + for (k=1;k<=mfit;k++) covar[j][k]=0.0; + beta[j][1]=0.0; + } + for (i=1;i<=ndat;i++) { + (*funcs)(x[i],afunc,ma); + ym=y[i]; + if (mfit < ma) { + for (j=1;j<=ma;j++) + if (!ia[j]) ym -= a[j]*afunc[j]; + } + sig2i=1.0/SQR(sig[i]); + for (j=0,l=1;l<=ma;l++) { + if (ia[l]) { + wt=afunc[l]*sig2i; + for (j++,k=0,m=1;m<=l;m++) + if (ia[m]) covar[j][++k] += wt*afunc[m]; + beta[j][1] += ym*wt; + } + } + } + for (j=2;j<=mfit;j++) + for (k=1;k +#include +#include "nrutil.h" +#define EPS 1.0e-14 + +void linbcg(n,b,x,itol,tol,itmax,iter,err) +double *err,b[],tol,x[]; +int *iter,itmax,itol; +unsigned long n; +{ + double snrm(); + void asolve(),atimes(); + unsigned long j; + double ak,akden,bk,bkden,bknum,bnrm,dxnrm,xnrm,zm1nrm,znrm; + double *p,*pp,*r,*rr,*z,*zz; + + p=dvector(1,n); + pp=dvector(1,n); + r=dvector(1,n); + rr=dvector(1,n); + z=dvector(1,n); + zz=dvector(1,n); + + *iter=0; + atimes(n,x,r,0); + for (j=1;j<=n;j++) { + r[j]=b[j]-r[j]; + rr[j]=r[j]; + } + if (itol == 1) { + bnrm=snrm(n,b,itol); + asolve(n,r,z,0); + } + else if (itol == 2) { + asolve(n,b,z,0); + bnrm=snrm(n,z,itol); + asolve(n,r,z,0); + } + else if (itol == 3 || itol == 4) { + asolve(n,b,z,0); + bnrm=snrm(n,z,itol); + asolve(n,r,z,0); + znrm=snrm(n,z,itol); + } else nrerror("illegal itol in linbcg"); + while (*iter <= itmax) { + ++(*iter); + asolve(n,rr,zz,1); + for (bknum=0.0,j=1;j<=n;j++) bknum += z[j]*rr[j]; + if (*iter == 1) { + for (j=1;j<=n;j++) { + p[j]=z[j]; + pp[j]=zz[j]; + } + } + else { + bk=bknum/bkden; + for (j=1;j<=n;j++) { + p[j]=bk*p[j]+z[j]; + pp[j]=bk*pp[j]+zz[j]; + } + } + bkden=bknum; + atimes(n,p,z,0); + for (akden=0.0,j=1;j<=n;j++) akden += z[j]*pp[j]; + ak=bknum/akden; + atimes(n,pp,zz,1); + for (j=1;j<=n;j++) { + x[j] += ak*p[j]; + r[j] -= ak*z[j]; + rr[j] -= ak*zz[j]; + } + asolve(n,r,z,0); + if (itol == 1) + *err=snrm(n,r,itol)/bnrm; + else if (itol == 2) + *err=snrm(n,z,itol)/bnrm; + else if (itol == 3 || itol == 4) { + zm1nrm=znrm; + znrm=snrm(n,z,itol); + if (fabs(zm1nrm-znrm) > EPS*znrm) { + dxnrm=fabs(ak)*snrm(n,p,itol); + *err=znrm/fabs(zm1nrm-znrm)*dxnrm; + } else { + *err=znrm/bnrm; + continue; + } + xnrm=snrm(n,x,itol); + if (*err <= 0.5*xnrm) *err /= xnrm; + else { + *err=znrm/bnrm; + continue; + } + } + printf("iter=%4d err=%12.6f\n",*iter,*err); + if (*err <= tol) break; + } + + free_dvector(p,1,n); + free_dvector(pp,1,n); + free_dvector(r,1,n); + free_dvector(rr,1,n); + free_dvector(z,1,n); + free_dvector(zz,1,n); +} +#undef EPS diff --git a/lib/nr/k_and_r/recipes/linmin.c b/lib/nr/k_and_r/recipes/linmin.c new file mode 100644 index 0000000..4ecb811 --- /dev/null +++ b/lib/nr/k_and_r/recipes/linmin.c @@ -0,0 +1,36 @@ + +#include "nrutil.h" +#define TOL 2.0e-4 + +int ncom; +float *pcom,*xicom,(*nrfunc)(); + +void linmin(p,xi,n,fret,func) +float (*func)(),*fret,p[],xi[]; +int n; +{ + float brent(),f1dim(); + void mnbrak(); + int j; + float xx,xmin,fx,fb,fa,bx,ax; + + ncom=n; + pcom=vector(1,n); + xicom=vector(1,n); + nrfunc=func; + for (j=1;j<=n;j++) { + pcom[j]=p[j]; + xicom[j]=xi[j]; + } + ax=0.0; + xx=1.0; + mnbrak(&ax,&xx,&bx,&fa,&fx,&fb,f1dim); + *fret=brent(ax,xx,bx,f1dim,TOL,&xmin); + for (j=1;j<=n;j++) { + xi[j] *= xmin; + p[j] += xi[j]; + } + free_vector(xicom,1,n); + free_vector(pcom,1,n); +} +#undef TOL diff --git a/lib/nr/k_and_r/recipes/lnsrch.c b/lib/nr/k_and_r/recipes/lnsrch.c new file mode 100644 index 0000000..ab97344 --- /dev/null +++ b/lib/nr/k_and_r/recipes/lnsrch.c @@ -0,0 +1,63 @@ + +#include +#include "nrutil.h" +#define ALF 1.0e-4 +#define TOLX 1.0e-7 + +void lnsrch(n,xold,fold,g,p,x,f,stpmax,check,func) +float (*func)(),*f,fold,g[],p[],stpmax,x[],xold[]; +int *check,n; +{ + int i; + float a,alam,alam2,alamin,b,disc,f2,rhs1,rhs2,slope,sum,temp, + test,tmplam; + + *check=0; + for (sum=0.0,i=1;i<=n;i++) sum += p[i]*p[i]; + sum=sqrt(sum); + if (sum > stpmax) + for (i=1;i<=n;i++) p[i] *= stpmax/sum; + for (slope=0.0,i=1;i<=n;i++) + slope += g[i]*p[i]; + if (slope >= 0.0) nrerror("Roundoff problem in lnsrch."); + test=0.0; + for (i=1;i<=n;i++) { + temp=fabs(p[i])/FMAX(fabs(xold[i]),1.0); + if (temp > test) test=temp; + } + alamin=TOLX/test; + alam=1.0; + for (;;) { + for (i=1;i<=n;i++) x[i]=xold[i]+alam*p[i]; + *f=(*func)(x); + if (alam < alamin) { + for (i=1;i<=n;i++) x[i]=xold[i]; + *check=1; + return; + } else if (*f <= fold+ALF*alam*slope) return; + else { + if (alam == 1.0) + tmplam = -slope/(2.0*(*f-fold-slope)); + else { + rhs1 = *f-fold-alam*slope; + rhs2=f2-fold-alam2*slope; + a=(rhs1/(alam*alam)-rhs2/(alam2*alam2))/(alam-alam2); + b=(-alam2*rhs1/(alam*alam)+alam*rhs2/(alam2*alam2))/(alam-alam2); + if (a == 0.0) tmplam = -slope/(2.0*b); + else { + disc=b*b-3.0*a*slope; + if (disc < 0.0) tmplam=0.5*alam; + else if (b <= 0.0) tmplam=(-b+sqrt(disc))/(3.0*a); + else tmplam=-slope/(b+sqrt(disc)); + } + if (tmplam > 0.5*alam) + tmplam=0.5*alam; + } + } + alam2=alam; + f2 = *f; + alam=FMAX(tmplam,0.1*alam); + } +} +#undef ALF +#undef TOLX diff --git a/lib/nr/k_and_r/recipes/locate.c b/lib/nr/k_and_r/recipes/locate.c new file mode 100644 index 0000000..e6cf7da --- /dev/null +++ b/lib/nr/k_and_r/recipes/locate.c @@ -0,0 +1,22 @@ + +void locate(xx,n,x,j) +float x,xx[]; +unsigned long *j,n; +{ + unsigned long ju,jm,jl; + int ascnd; + + jl=0; + ju=n+1; + ascnd=(xx[n] >= xx[1]); + while (ju-jl > 1) { + jm=(ju+jl) >> 1; + if (x >= xx[jm] == ascnd) + jl=jm; + else + ju=jm; + } + if (x == xx[1]) *j=1; + else if(x == xx[n]) *j=n-1; + else *j=jl; +} diff --git a/lib/nr/k_and_r/recipes/lop.c b/lib/nr/k_and_r/recipes/lop.c new file mode 100644 index 0000000..60937af --- /dev/null +++ b/lib/nr/k_and_r/recipes/lop.c @@ -0,0 +1,17 @@ + +void lop(out,u,n) +double **out,**u; +int n; +{ + int i,j; + double h,h2i; + + h=1.0/(n-1); + h2i=1.0/(h*h); + for (j=2;j=1;i--) { + sum=b[i]; + for (j=i+1;j<=n;j++) sum -= a[i][j]*b[j]; + b[i]=sum/a[i][i]; + } +} diff --git a/lib/nr/k_and_r/recipes/ludcmp.c b/lib/nr/k_and_r/recipes/ludcmp.c new file mode 100644 index 0000000..272b839 --- /dev/null +++ b/lib/nr/k_and_r/recipes/ludcmp.c @@ -0,0 +1,58 @@ + +#include +#include "nrutil.h" +#define TINY 1.0e-20 + +void ludcmp(a,n,indx,d) +float **a,*d; +int *indx,n; +{ + int i,imax,j,k; + float big,dum,sum,temp; + float *vv; + + vv=vector(1,n); + *d=1.0; + for (i=1;i<=n;i++) { + big=0.0; + for (j=1;j<=n;j++) + if ((temp=fabs(a[i][j])) > big) big=temp; + if (big == 0.0) nrerror("Singular matrix in routine ludcmp"); + vv[i]=1.0/big; + } + for (j=1;j<=n;j++) { + for (i=1;i= big) { + big=dum; + imax=i; + } + } + if (j != imax) { + for (k=1;k<=n;k++) { + dum=a[imax][k]; + a[imax][k]=a[j][k]; + a[j][k]=dum; + } + *d = -(*d); + vv[imax]=vv[j]; + } + indx[j]=imax; + if (a[j][j] == 0.0) a[j][j]=TINY; + if (j != n) { + dum=1.0/(a[j][j]); + for (i=j+1;i<=n;i++) a[i][j] *= dum; + } + } + free_vector(vv,1,n); +} +#undef TINY diff --git a/lib/nr/k_and_r/recipes/machar.c b/lib/nr/k_and_r/recipes/machar.c new file mode 100644 index 0000000..016a014 --- /dev/null +++ b/lib/nr/k_and_r/recipes/machar.c @@ -0,0 +1,134 @@ + +#include +#define CONV(i) ((float)(i)) + +void machar(int *ibeta, int *it, int *irnd, int *ngrd, int *machep, int *negep, +int *iexp, int *minexp, int *maxexp, float *eps, float *epsneg, +float *xmin, float *xmax) +{ + int i,itemp,iz,j,k,mx,nxres; + float a,b,beta,betah,betain,one,t,temp,temp1,tempa,two,y,z,zero; + + one=CONV(1); + two=one+one; + zero=one-one; + a=one; + do { + a += a; + temp=a+one; + temp1=temp-a; + } while (temp1-one == zero); + b=one; + do { + b += b; + temp=a+b; + itemp=(int)(temp-a); + } while (itemp == 0); + *ibeta=itemp; + beta=CONV(*ibeta); + *it=0; + b=one; + do { + ++(*it); + b *= beta; + temp=b+one; + temp1=temp-b; + } while (temp1-one == zero); + *irnd=0; + betah=beta/two; + temp=a+betah; + if (temp-a != zero) *irnd=1; + tempa=a+beta; + temp=tempa+betah; + if (*irnd == 0 && temp-tempa != zero) *irnd=2; + *negep=(*it)+3; + betain=one/beta; + a=one; + for (i=1;i<=(*negep);i++) a *= betain; + b=a; + for (;;) { + temp=one-a; + if (temp-one != zero) break; + a *= beta; + --(*negep); + } + *negep = -(*negep); + *epsneg=a; + *machep = -(*it)-3; + a=b; + for (;;) { + temp=one+a; + if (temp-one != zero) break; + a *= beta; + ++(*machep); + } + *eps=a; + *ngrd=0; + temp=one+(*eps); + if (*irnd == 0 && temp*one-one != zero) *ngrd=1; + i=0; + k=1; + z=betain; + t=one+(*eps); + nxres=0; + for (;;) { + y=z; + z=y*y; + a=z*one; + temp=z*t; + if (a+a == zero || fabs(z) >= y) break; + temp1=temp*betain; + if (temp1*beta == z) break; + ++i; + k += k; + } + if (*ibeta != 10) { + *iexp=i+1; + mx=k+k; + } else { + *iexp=2; + iz=(*ibeta); + while (k >= iz) { + iz *= *ibeta; + ++(*iexp); + } + mx=iz+iz-1; + } + for (;;) { + *xmin=y; + y *= betain; + a=y*one; + temp=y*t; + if (a+a != zero && fabs(y) < *xmin) { + ++k; + temp1=temp*betain; + if (temp1*beta == y && temp != y) { + nxres=3; + *xmin=y; + break; + } + } + else break; + } + *minexp = -k; + if (mx <= k+k-3 && *ibeta != 10) { + mx += mx; + ++(*iexp); + } + *maxexp=mx+(*minexp); + *irnd += nxres; + if (*irnd >= 2) *maxexp -= 2; + i=(*maxexp)+(*minexp); + if (*ibeta == 2 && !i) --(*maxexp); + if (i > 20) --(*maxexp); + if (a != y) *maxexp -= 2; + *xmax=one-(*epsneg); + if ((*xmax)*one != *xmax) *xmax=one-beta*(*epsneg); + *xmax /= (*xmin*beta*beta*beta); + i=(*maxexp)+(*minexp)+3; + for (j=1;j<=i;j++) { + if (*ibeta == 2) *xmax += *xmax; + else *xmax *= beta; + } +} +#undef CONV diff --git a/lib/nr/k_and_r/recipes/matadd.c b/lib/nr/k_and_r/recipes/matadd.c new file mode 100644 index 0000000..9b8d65c --- /dev/null +++ b/lib/nr/k_and_r/recipes/matadd.c @@ -0,0 +1,11 @@ + +void matadd(a,b,c,n) +double **a,**b,**c; +int n; +{ + int i,j; + + for (j=1;j<=n;j++) + for (i=1;i<=n;i++) + c[i][j]=a[i][j]+b[i][j]; +} diff --git a/lib/nr/k_and_r/recipes/matsub.c b/lib/nr/k_and_r/recipes/matsub.c new file mode 100644 index 0000000..867cba3 --- /dev/null +++ b/lib/nr/k_and_r/recipes/matsub.c @@ -0,0 +1,11 @@ + +void matsub(a,b,c,n) +double **a,**b,**c; +int n; +{ + int i,j; + + for (j=1;j<=n;j++) + for (i=1;i<=n;i++) + c[i][j]=a[i][j]-b[i][j]; +} diff --git a/lib/nr/k_and_r/recipes/medfit.c b/lib/nr/k_and_r/recipes/medfit.c new file mode 100644 index 0000000..fcfa64c --- /dev/null +++ b/lib/nr/k_and_r/recipes/medfit.c @@ -0,0 +1,66 @@ + +#include +#include "nrutil.h" +int ndatat; +float *xt,*yt,aa,abdevt; + +void medfit(x,y,ndata,a,b,abdev) +float *a,*abdev,*b,x[],y[]; +int ndata; +{ + float rofunc(); + int j; + float bb,b1,b2,del,f,f1,f2,sigb,temp; + float sx=0.0,sy=0.0,sxy=0.0,sxx=0.0,chisq=0.0; + + ndatat=ndata; + xt=x; + yt=y; + for (j=1;j<=ndata;j++) { + sx += x[j]; + sy += y[j]; + sxy += x[j]*y[j]; + sxx += x[j]*x[j]; + } + del=ndata*sxx-sx*sx; + aa=(sxx*sy-sx*sxy)/del; + bb=(ndata*sxy-sx*sy)/del; + for (j=1;j<=ndata;j++) + chisq += (temp=y[j]-(aa+bb*x[j]),temp*temp); + sigb=sqrt(chisq/del); + b1=bb; + f1=rofunc(b1); + if (sigb > 0.0) { + b2=bb+SIGN(3.0*sigb,f1); + f2=rofunc(b2); + if (b2 == b1) { + *a=aa; + *b=bb; + *abdev=abdevt/ndata; + return; + } + while (f1*f2 > 0.0) { + bb=b2+1.6*(b2-b1); + b1=b2; + f1=f2; + b2=bb; + f2=rofunc(b2); + } + sigb=0.01*sigb; + while (fabs(b2-b1) > sigb) { + bb=b1+0.5*(b2-b1); + if (bb == b1 || bb == b2) break; + f=rofunc(bb); + if (f*f1 >= 0.0) { + f1=f; + b1=bb; + } else { + f2=f; + b2=bb; + } + } + } + *a=aa; + *b=bb; + *abdev=abdevt/ndata; +} diff --git a/lib/nr/k_and_r/recipes/memcof.c b/lib/nr/k_and_r/recipes/memcof.c new file mode 100644 index 0000000..45b33ee --- /dev/null +++ b/lib/nr/k_and_r/recipes/memcof.c @@ -0,0 +1,46 @@ + +#include +#include "nrutil.h" + +void memcof(data,n,m,xms,d) +float *xms,d[],data[]; +int m,n; +{ + int k,j,i; + float p=0.0,*wk1,*wk2,*wkm; + + wk1=vector(1,n); + wk2=vector(1,n); + wkm=vector(1,m); + for (j=1;j<=n;j++) p += SQR(data[j]); + *xms=p/n; + wk1[1]=data[1]; + wk2[n-1]=data[n]; + for (j=2;j<=n-1;j++) { + wk1[j]=data[j]; + wk2[j-1]=data[j]; + } + for (k=1;k<=m;k++) { + float num=0.0,denom=0.0; + for (j=1;j<=(n-k);j++) { + num += wk1[j]*wk2[j]; + denom += SQR(wk1[j])+SQR(wk2[j]); + } + d[k]=2.0*num/denom; + *xms *= (1.0-SQR(d[k])); + for (i=1;i<=(k-1);i++) + d[i]=wkm[i]-d[k]*wkm[k-i]; + if (k == m) { + free_vector(wkm,1,m); + free_vector(wk2,1,n); + free_vector(wk1,1,n); + return; + } + for (i=1;i<=k;i++) wkm[i]=d[i]; + for (j=1;j<=(n-k-1);j++) { + wk1[j] -= wkm[k]*wk2[j]; + wk2[j]=wk2[j+1]-wkm[k]*wk1[j+1]; + } + } + nrerror("never get here in memcof."); +} diff --git a/lib/nr/k_and_r/recipes/metrop.c b/lib/nr/k_and_r/recipes/metrop.c new file mode 100644 index 0000000..c4526e3 --- /dev/null +++ b/lib/nr/k_and_r/recipes/metrop.c @@ -0,0 +1,11 @@ + +#include + +int metrop(de,t) +float de,t; +{ + float ran3(); + static long gljdum=1; + + return de < 0.0 || ran3(&gljdum) < exp(-de/t); +} diff --git a/lib/nr/k_and_r/recipes/mgfas.c b/lib/nr/k_and_r/recipes/mgfas.c new file mode 100644 index 0000000..4c43ea6 --- /dev/null +++ b/lib/nr/k_and_r/recipes/mgfas.c @@ -0,0 +1,95 @@ + +#include "nrutil.h" +#define NPRE 1 +#define NPOST 1 +#define ALPHA 0.33 +#define NGMAX 15 + +void mgfas(u,n,maxcyc) +double **u; +int maxcyc,n; +{ + double anorm2(); + void copy(),interp(),lop(),matadd(),matsub(),relax2(),rstrct(),slvsm2(); + unsigned int j,jcycle,jj,jm1,jpost,jpre,nf,ng=0,ngrid,nn; + double **irho[NGMAX+1],**irhs[NGMAX+1],**itau[NGMAX+1], + **itemp[NGMAX+1],**iu[NGMAX+1]; + double res,trerr; + + nn=n; + while (nn >>= 1) ng++; + if (n != 1+(1L << ng)) nrerror("n-1 must be a power of 2 in mgfas."); + if (ng > NGMAX) nrerror("increase NGMAX in mglin."); + nn=n/2+1; + ngrid=ng-1; + irho[ngrid]=dmatrix(1,nn,1,nn); + rstrct(irho[ngrid],u,nn); + while (nn > 3) { + nn=nn/2+1; + irho[--ngrid]=dmatrix(1,nn,1,nn); + rstrct(irho[ngrid],irho[ngrid+1],nn); + } + nn=3; + iu[1]=dmatrix(1,nn,1,nn); + irhs[1]=dmatrix(1,nn,1,nn); + itau[1]=dmatrix(1,nn,1,nn); + itemp[1]=dmatrix(1,nn,1,nn); + slvsm2(iu[1],irho[1]); + free_dmatrix(irho[1],1,nn,1,nn); + ngrid=ng; + for (j=2;j<=ngrid;j++) { + nn=2*nn-1; + iu[j]=dmatrix(1,nn,1,nn); + irhs[j]=dmatrix(1,nn,1,nn); + itau[j]=dmatrix(1,nn,1,nn); + itemp[j]=dmatrix(1,nn,1,nn); + interp(iu[j],iu[j-1],nn); + copy(irhs[j],(j != ngrid ? irho[j] : u),nn); + for (jcycle=1;jcycle<=maxcyc;jcycle++) { + nf=nn; + for (jj=j;jj>=2;jj--) { + for (jpre=1;jpre<=NPRE;jpre++) + relax2(iu[jj],irhs[jj],nf); + lop(itemp[jj],iu[jj],nf); + nf=nf/2+1; + jm1=jj-1; + rstrct(itemp[jm1],itemp[jj],nf); + rstrct(iu[jm1],iu[jj],nf); + lop(itau[jm1],iu[jm1],nf); + matsub(itau[jm1],itemp[jm1],itau[jm1],nf); + if (jj == j) + trerr=ALPHA*anorm2(itau[jm1],nf); + rstrct(irhs[jm1],irhs[jj],nf); + matadd(irhs[jm1],itau[jm1],irhs[jm1],nf); + } + slvsm2(iu[1],irhs[1]); + nf=3; + for (jj=2;jj<=j;jj++) { + jm1=jj-1; + rstrct(itemp[jm1],iu[jj],nf); + matsub(iu[jm1],itemp[jm1],itemp[jm1],nf); + nf=2*nf-1; + interp(itau[jj],itemp[jm1],nf); + matadd(iu[jj],itau[jj],iu[jj],nf); + for (jpost=1;jpost<=NPOST;jpost++) + relax2(iu[jj],irhs[jj],nf); + } + lop(itemp[j],iu[j],nf); + matsub(itemp[j],irhs[j],itemp[j],nf); + res=anorm2(itemp[j],nf); + if (res < trerr) break; + } + } + copy(u,iu[ngrid],n); + for (nn=n,j=ng;j>=1;j--,nn=nn/2+1) { + free_dmatrix(itemp[j],1,nn,1,nn); + free_dmatrix(itau[j],1,nn,1,nn); + free_dmatrix(irhs[j],1,nn,1,nn); + free_dmatrix(iu[j],1,nn,1,nn); + if (j != ng && j != 1) free_dmatrix(irho[j],1,nn,1,nn); + } +} +#undef NGMAX +#undef NPRE +#undef NPOST +#undef ALPHA diff --git a/lib/nr/k_and_r/recipes/mglin.c b/lib/nr/k_and_r/recipes/mglin.c new file mode 100644 index 0000000..7e0eade --- /dev/null +++ b/lib/nr/k_and_r/recipes/mglin.c @@ -0,0 +1,73 @@ + +#include "nrutil.h" +#define NPRE 1 +#define NPOST 1 +#define NGMAX 15 + +void mglin(u,n,ncycle) +double **u; +int n,ncycle; +{ + void addint(),copy(),fill0(),interp(),relax(),resid(),rstrct(),slvsml(); + unsigned int j,jcycle,jj,jpost,jpre,nf,ng=0,ngrid,nn; + double **ires[NGMAX+1],**irho[NGMAX+1],**irhs[NGMAX+1],**iu[NGMAX+1]; + + nn=n; + while (nn >>= 1) ng++; + if (n != 1+(1L << ng)) nrerror("n-1 must be a power of 2 in mglin."); + if (ng > NGMAX) nrerror("increase NGMAX in mglin."); + nn=n/2+1; + ngrid=ng-1; + irho[ngrid]=dmatrix(1,nn,1,nn); + rstrct(irho[ngrid],u,nn); + while (nn > 3) { + nn=nn/2+1; + irho[--ngrid]=dmatrix(1,nn,1,nn); + rstrct(irho[ngrid],irho[ngrid+1],nn); + } + nn=3; + iu[1]=dmatrix(1,nn,1,nn); + irhs[1]=dmatrix(1,nn,1,nn); + slvsml(iu[1],irho[1]); + free_dmatrix(irho[1],1,nn,1,nn); + ngrid=ng; + for (j=2;j<=ngrid;j++) { + nn=2*nn-1; + iu[j]=dmatrix(1,nn,1,nn); + irhs[j]=dmatrix(1,nn,1,nn); + ires[j]=dmatrix(1,nn,1,nn); + interp(iu[j],iu[j-1],nn); + copy(irhs[j],(j != ngrid ? irho[j] : u),nn); + for (jcycle=1;jcycle<=ncycle;jcycle++) { + nf=nn; + for (jj=j;jj>=2;jj--) { + for (jpre=1;jpre<=NPRE;jpre++) + relax(iu[jj],irhs[jj],nf); + resid(ires[jj],iu[jj],irhs[jj],nf); + nf=nf/2+1; + rstrct(irhs[jj-1],ires[jj],nf); + fill0(iu[jj-1],nf); + } + slvsml(iu[1],irhs[1]); + nf=3; + for (jj=2;jj<=j;jj++) { + nf=2*nf-1; + addint(iu[jj],iu[jj-1],ires[jj],nf); + for (jpost=1;jpost<=NPOST;jpost++) + relax(iu[jj],irhs[jj],nf); + } + } + } + copy(u,iu[ngrid],n); + for (nn=n,j=ng;j>=2;j--,nn=nn/2+1) { + free_dmatrix(ires[j],1,nn,1,nn); + free_dmatrix(irhs[j],1,nn,1,nn); + free_dmatrix(iu[j],1,nn,1,nn); + if (j != ng) free_dmatrix(irho[j],1,nn,1,nn); + } + free_dmatrix(irhs[1],1,3,1,3); + free_dmatrix(iu[1],1,3,1,3); +} +#undef NPRE +#undef NPOST +#undef NGMAX diff --git a/lib/nr/k_and_r/recipes/midexp.c b/lib/nr/k_and_r/recipes/midexp.c new file mode 100644 index 0000000..11c8f3f --- /dev/null +++ b/lib/nr/k_and_r/recipes/midexp.c @@ -0,0 +1,34 @@ + +#include +#define FUNC(x) ((*funk)(-log(x))/(x)) + +float midexp(funk,aa,bb,n) +float (*funk)(),aa,bb; +int n; +{ + float x,tnm,sum,del,ddel,a,b; + static float s; + int it,j; + + b=exp(-aa); + a=0.0; + if (n == 1) { + return (s=(b-a)*FUNC(0.5*(a+b))); + } else { + for(it=1,j=1;j +#define FUNC(x) (2.0*(x)*(*funk)(aa+(x)*(x))) + +float midsql(funk,aa,bb,n) +float (*funk)(),aa,bb; +int n; +{ + float x,tnm,sum,del,ddel,a,b; + static float s; + int it,j; + + b=sqrt(bb-aa); + a=0.0; + if (n == 1) { + return (s=(b-a)*FUNC(0.5*(a+b))); + } else { + for(it=1,j=1;j +#define FUNC(x) (2.0*(x)*(*funk)(bb-(x)*(x))) + +float midsqu(funk,aa,bb,n) +float (*funk)(),aa,bb; +int n; +{ + float x,tnm,sum,del,ddel,a,b; + static float s; + int it,j; + + b=sqrt(bb-aa); + a=0.0; + if (n == 1) { + return (s=(b-a)*FUNC(0.5*(a+b))); + } else { + for(it=1,j=1;j +#include "nrutil.h" +#define PFAC 0.1 +#define MNPT 15 +#define MNBS 60 +#define TINY 1.0e-30 +#define BIG 1.0e30 + +static long iran=0; + +void miser(func,regn,ndim,npts,dith,ave,var) +float (*func)(),*ave,*var,dith,regn[]; +int ndim; +unsigned long npts; +{ + void ranpt(); + float *regn_temp; + unsigned long n,npre,nptl,nptr; + int j,jb; + float avel,varl; + float fracl,fval; + float rgl,rgm,rgr,s,sigl,siglb,sigr,sigrb; + float sum,sumb,summ,summ2; + float *fmaxl,*fmaxr,*fminl,*fminr; + float *pt,*rmid; + + pt=vector(1,ndim); + if (npts < MNBS) { + summ=summ2=0.0; + for (n=1;n<=npts;n++) { + ranpt(pt,regn,ndim); + fval=(*func)(pt); + summ += fval; + summ2 += fval * fval; + } + *ave=summ/npts; + *var=FMAX(TINY,(summ2-summ*summ/npts)/(npts*npts)); + } + else { + rmid=vector(1,ndim); + npre=LMAX((unsigned long)(npts*PFAC),MNPT); + fmaxl=vector(1,ndim); + fmaxr=vector(1,ndim); + fminl=vector(1,ndim); + fminr=vector(1,ndim); + for (j=1;j<=ndim;j++) { + iran=(iran*2661+36979) % 175000; + s=SIGN(dith,(float)(iran-87500)); + rmid[j]=(0.5+s)*regn[j]+(0.5-s)*regn[ndim+j]; + fminl[j]=fminr[j]=BIG; + fmaxl[j]=fmaxr[j] = -BIG; + } + for (n=1;n<=npre;n++) { + ranpt(pt,regn,ndim); + fval=(*func)(pt); + for (j=1;j<=ndim;j++) { + if (pt[j]<=rmid[j]) { + fminl[j]=FMIN(fminl[j],fval); + fmaxl[j]=FMAX(fmaxl[j],fval); + } + else { + fminr[j]=FMIN(fminr[j],fval); + fmaxr[j]=FMAX(fmaxr[j],fval); + } + } + } + sumb=BIG; + jb=0; + siglb=sigrb=1.0; + for (j=1;j<=ndim;j++) { + if (fmaxl[j] > fminl[j] && fmaxr[j] > fminr[j]) { + sigl=FMAX(TINY,pow(fmaxl[j]-fminl[j],2.0/3.0)); + sigr=FMAX(TINY,pow(fmaxr[j]-fminr[j],2.0/3.0)); + sum=sigl+sigr; + if (sum<=sumb) { + sumb=sum; + jb=j; + siglb=sigl; + sigrb=sigr; + } + } + } + free_vector(fminr,1,ndim); + free_vector(fminl,1,ndim); + free_vector(fmaxr,1,ndim); + free_vector(fmaxl,1,ndim); + if (!jb) jb=1+(ndim*iran)/175000; + rgl=regn[jb]; + rgm=rmid[jb]; + rgr=regn[ndim+jb]; + fracl=fabs((rgm-rgl)/(rgr-rgl)); + nptl=(unsigned long)(MNPT+(npts-npre-2*MNPT)*fracl*siglb + /(fracl*siglb+(1.0-fracl)*sigrb)); + nptr=npts-npre-nptl; + regn_temp=vector(1,2*ndim); + for (j=1;j<=ndim;j++) { + regn_temp[j]=regn[j]; + regn_temp[ndim+j]=regn[ndim+j]; + } + regn_temp[ndim+jb]=rmid[jb]; + miser(func,regn_temp,ndim,nptl,dith,&avel,&varl); + regn_temp[jb]=rmid[jb]; + regn_temp[ndim+jb]=regn[ndim+jb]; + miser(func,regn_temp,ndim,nptr,dith,ave,var); + free_vector(regn_temp,1,2*ndim); + *ave=fracl*avel+(1-fracl)*(*ave); + *var=fracl*fracl*varl+(1-fracl)*(1-fracl)*(*var); + free_vector(rmid,1,ndim); + } + free_vector(pt,1,ndim); +} +#undef MNPT +#undef MNBS +#undef TINY +#undef BIG +#undef PFAC diff --git a/lib/nr/k_and_r/recipes/mmid.c b/lib/nr/k_and_r/recipes/mmid.c new file mode 100644 index 0000000..01f8fcd --- /dev/null +++ b/lib/nr/k_and_r/recipes/mmid.c @@ -0,0 +1,35 @@ + +#include "nrutil.h" + +void mmid(y,dydx,nvar,xs,htot,nstep,yout,derivs) +float dydx[],htot,xs,y[],yout[]; +int nstep,nvar; +void (*derivs)(); +{ + int n,i; + float x,swap,h2,h,*ym,*yn; + + ym=vector(1,nvar); + yn=vector(1,nvar); + h=htot/nstep; + for (i=1;i<=nvar;i++) { + ym[i]=y[i]; + yn[i]=y[i]+h*dydx[i]; + } + x=xs+h; + (*derivs)(x,yn,yout); + h2=2.0*h; + for (n=2;n<=nstep;n++) { + for (i=1;i<=nvar;i++) { + swap=ym[i]+h2*yout[i]; + ym[i]=yn[i]; + yn[i]=swap; + } + x += h; + (*derivs)(x,yn,yout); + } + for (i=1;i<=nvar;i++) + yout[i]=0.5*(ym[i]+yn[i]+h*yout[i]); + free_vector(yn,1,nvar); + free_vector(ym,1,nvar); +} diff --git a/lib/nr/k_and_r/recipes/mnbrak.c b/lib/nr/k_and_r/recipes/mnbrak.c new file mode 100644 index 0000000..629086d --- /dev/null +++ b/lib/nr/k_and_r/recipes/mnbrak.c @@ -0,0 +1,63 @@ + +#include +#include "nrutil.h" +#define GOLD 1.618034 +#define GLIMIT 100.0 +#define TINY 1.0e-20 +#define SHFT(a,b,c,d) (a)=(b);(b)=(c);(c)=(d); + +void mnbrak(ax,bx,cx,fa,fb,fc,func) +float (*func)(),*ax,*bx,*cx,*fa,*fb,*fc; +{ + float ulim,u,r,q,fu,dum; + + *fa=(*func)(*ax); + *fb=(*func)(*bx); + if (*fb > *fa) { + SHFT(dum,*ax,*bx,dum) + SHFT(dum,*fb,*fa,dum) + } + *cx=(*bx)+GOLD*(*bx-*ax); + *fc=(*func)(*cx); + while (*fb > *fc) { + r=(*bx-*ax)*(*fb-*fc); + q=(*bx-*cx)*(*fb-*fa); + u=(*bx)-((*bx-*cx)*q-(*bx-*ax)*r)/ + (2.0*SIGN(FMAX(fabs(q-r),TINY),q-r)); + ulim=(*bx)+GLIMIT*(*cx-*bx); + if ((*bx-u)*(u-*cx) > 0.0) { + fu=(*func)(u); + if (fu < *fc) { + *ax=(*bx); + *bx=u; + *fa=(*fb); + *fb=fu; + return; + } else if (fu > *fb) { + *cx=u; + *fc=fu; + return; + } + u=(*cx)+GOLD*(*cx-*bx); + fu=(*func)(u); + } else if ((*cx-u)*(u-ulim) > 0.0) { + fu=(*func)(u); + if (fu < *fc) { + SHFT(*bx,*cx,u,*cx+GOLD*(*cx-*bx)) + SHFT(*fb,*fc,fu,(*func)(u)) + } + } else if ((u-ulim)*(ulim-*cx) >= 0.0) { + u=ulim; + fu=(*func)(u); + } else { + u=(*cx)+GOLD*(*cx-*bx); + fu=(*func)(u); + } + SHFT(*ax,*bx,*cx,u) + SHFT(*fa,*fb,*fc,fu) + } +} +#undef GOLD +#undef GLIMIT +#undef TINY +#undef SHFT diff --git a/lib/nr/k_and_r/recipes/mnewt.c b/lib/nr/k_and_r/recipes/mnewt.c new file mode 100644 index 0000000..05e4dae --- /dev/null +++ b/lib/nr/k_and_r/recipes/mnewt.c @@ -0,0 +1,38 @@ + +#include +#include "nrutil.h" + +void usrfun(); +#define FREERETURN {free_matrix(fjac,1,n,1,n);free_vector(fvec,1,n);\ + free_vector(p,1,n);free_ivector(indx,1,n);return;} + +void mnewt(ntrial,x,n,tolx,tolf) +float tolf,tolx,x[]; +int n,ntrial; +{ + void lubksb(),ludcmp(); + int k,i,*indx; + float errx,errf,d,*fvec,**fjac,*p; + + indx=ivector(1,n); + p=vector(1,n); + fvec=vector(1,n); + fjac=matrix(1,n,1,n); + for (k=1;k<=ntrial;k++) { + usrfun(x,n,fvec,fjac); + errf=0.0; + for (i=1;i<=n;i++) errf += fabs(fvec[i]); + if (errf <= tolf) FREERETURN + for (i=1;i<=n;i++) p[i] = -fvec[i]; + ludcmp(fjac,n,indx,&d); + lubksb(fjac,n,indx,p); + errx=0.0; + for (i=1;i<=n;i++) { + errx += fabs(p[i]); + x[i] += p[i]; + } + if (errx <= tolx) FREERETURN + } + FREERETURN +} +#undef FREERETURN diff --git a/lib/nr/k_and_r/recipes/moment.c b/lib/nr/k_and_r/recipes/moment.c new file mode 100644 index 0000000..517ab28 --- /dev/null +++ b/lib/nr/k_and_r/recipes/moment.c @@ -0,0 +1,31 @@ + +#include + +void moment(data,n,ave,adev,sdev,var,skew,curt) +float *adev,*ave,*curt,*sdev,*skew,*var,data[]; +int n; +{ + void nrerror(); + int j; + float ep=0.0,s,p; + + if (n <= 1) nrerror("n must be at least 2 in moment"); + s=0.0; + for (j=1;j<=n;j++) s += data[j]; + *ave=s/n; + *adev=(*var)=(*skew)=(*curt)=0.0; + for (j=1;j<=n;j++) { + *adev += fabs(s=data[j]-(*ave)); + ep += s; + *var += (p=s*s); + *skew += (p *= s); + *curt += (p *= s); + } + *adev /= n; + *var=(*var-ep*ep/n)/(n-1); + *sdev=sqrt(*var); + if (*var) { + *skew /= (n*(*var)*(*sdev)); + *curt=(*curt)/(n*(*var)*(*var))-3.0; + } else nrerror("No skew/kurtosis when variance = 0 (in moment)"); +} diff --git a/lib/nr/k_and_r/recipes/mp2dfr.c b/lib/nr/k_and_r/recipes/mp2dfr.c new file mode 100644 index 0000000..cb42859 --- /dev/null +++ b/lib/nr/k_and_r/recipes/mp2dfr.c @@ -0,0 +1,18 @@ + +#define IAZ 48 + +void mp2dfr(a,s,n,m) +int *m,n; +unsigned char a[],s[]; +{ + void mplsh(),mpsmu(); + int j; + + *m=(int) (2.408*n); + for (j=1;j<=(*m);j++) { + mpsmu(a,a,n,10); + s[j]=a[1]+IAZ; + mplsh(a,n); + } +} +#undef IAZ diff --git a/lib/nr/k_and_r/recipes/mpdiv.c b/lib/nr/k_and_r/recipes/mpdiv.c new file mode 100644 index 0000000..cc32226 --- /dev/null +++ b/lib/nr/k_and_r/recipes/mpdiv.c @@ -0,0 +1,26 @@ + +#include "nrutil.h" +#define MACC 6 + +void mpdiv(q,r,u,v,n,m) +int m,n; +unsigned char q[],r[],u[],v[]; +{ + void mpinv(),mpmov(),mpmul(),mpsad(),mpsub(); + int is; + unsigned char *rr,*s; + + rr=cvector(1,(n+MACC)<<1); + s=cvector(1,(n+MACC)<<1); + mpinv(s,v,n+MACC,m); + mpmul(rr,s,u,n+MACC,n); + mpsad(s,rr,n+MACC-1,1); + mpmov(q,&s[2],n-m+1); + mpmul(rr,q,v,n-m+1,m); + mpsub(&is,&rr[1],u,&rr[1],n); + if (is) nrerror("MACC too small in mpdiv"); + mpmov(r,&rr[n-m+1],m); + free_cvector(s,1,(n+MACC)<<1); + free_cvector(rr,1,(n+MACC)<<1); +} +#undef MACC diff --git a/lib/nr/k_and_r/recipes/mpinv.c b/lib/nr/k_and_r/recipes/mpinv.c new file mode 100644 index 0000000..8a6cd1b --- /dev/null +++ b/lib/nr/k_and_r/recipes/mpinv.c @@ -0,0 +1,47 @@ + +#include "nrutil.h" +#define MF 4 +#define BI (1.0/256) + +void mpinv(u,v,n,m) +int m,n; +unsigned char u[],v[]; +{ + void mpmov(),mpmul(),mpneg(); + unsigned char *rr,*s; + int i,j,maxmn,mm; + float fu,fv; + + maxmn=IMAX(n,m); + rr=cvector(1,1+(maxmn<<1)); + s=cvector(1,maxmn); + mm=IMIN(MF,m); + fv=(float) v[mm]; + for (j=mm-1;j>=1;j--) { + fv *= BI; + fv += v[j]; + } + fu=1.0/fv; + for (j=1;j<=n;j++) { + i=(int) fu; + u[j]=(unsigned char) i; + fu=256.0*(fu-i); + } + for (;;) { + mpmul(rr,u,v,n,m); + mpmov(s,&rr[1],n); + mpneg(s,n); + s[1] -= 254; + mpmul(rr,s,u,n,n); + mpmov(u,&rr[1],n); + for (j=2;j=1;j--) { + t=b[j]/(nn>>1)+cy+0.5; + cy=(unsigned long) (t/RX); + b[j]=t-cy*RX; + } + if (cy >= RX) nrerror("cannot happen in fftmul"); + w[1]=(unsigned char) cy; + for (j=2;j<=n+m;j++) + w[j]=(unsigned char) b[j-1]; + free_dvector(b,1,nn); + free_dvector(a,1,nn); +} +#undef RX diff --git a/lib/nr/k_and_r/recipes/mpops.c b/lib/nr/k_and_r/recipes/mpops.c new file mode 100644 index 0000000..bb6899d --- /dev/null +++ b/lib/nr/k_and_r/recipes/mpops.c @@ -0,0 +1,108 @@ + +#define LOBYTE(x) ((unsigned char) ((x) & 0xff)) +#define HIBYTE(x) ((unsigned char) ((x) >> 8 & 0xff)) + + +void mpadd(w,u,v,n) +int n; +unsigned char u[],v[],w[]; +{ + int j; + unsigned short ireg=0; + + for (j=n;j>=1;j--) { + ireg=u[j]+v[j]+HIBYTE(ireg); + w[j+1]=LOBYTE(ireg); + } + w[1]=HIBYTE(ireg); +} + +void mpsub(is,w,u,v,n) +int *is,n; +unsigned char u[],v[],w[]; +{ + int j; + unsigned short ireg=256; + + for (j=n;j>=1;j--) { + ireg=255+u[j]-v[j]+HIBYTE(ireg); + w[j]=LOBYTE(ireg); + } + *is=HIBYTE(ireg)-1; +} + +void mpsad(w,u,n,iv) +int iv,n; +unsigned char u[],w[]; +{ + int j; + unsigned short ireg; + + ireg=256*iv; + for (j=n;j>=1;j--) { + ireg=u[j]+HIBYTE(ireg); + w[j+1]=LOBYTE(ireg); + } + w[1]=HIBYTE(ireg); +} + +void mpsmu(w,u,n,iv) +int iv,n; +unsigned char u[],w[]; +{ + int j; + unsigned short ireg=0; + + for (j=n;j>=1;j--) { + ireg=u[j]*iv+HIBYTE(ireg); + w[j+1]=LOBYTE(ireg); + } + w[1]=HIBYTE(ireg); +} + +void mpsdv(w,u,n,iv,ir) +int *ir,iv,n; +unsigned char u[],w[]; +{ + int i,j; + + *ir=0; + for (j=1;j<=n;j++) { + i=256*(*ir)+u[j]; + w[j]=(unsigned char) (i/iv); + *ir=i % iv; + } +} + +void mpneg(u,n) +int n; +unsigned char u[]; +{ + int j; + unsigned short ireg=256; + + for (j=n;j>=1;j--) { + ireg=255-u[j]+HIBYTE(ireg); + u[j]=LOBYTE(ireg); + } +} + +void mpmov(u,v,n) +int n; +unsigned char u[],v[]; +{ + int j; + + for (j=1;j<=n;j++) u[j]=v[j]; +} + +void mplsh(u,n) +int n; +unsigned char u[]; +{ + int j; + + for (j=1;j<=n;j++) u[j]=u[j+1]; +} +#undef LOBYTE +#undef HIBYTE diff --git a/lib/nr/k_and_r/recipes/mppi.c b/lib/nr/k_and_r/recipes/mppi.c new file mode 100644 index 0000000..b074c28 --- /dev/null +++ b/lib/nr/k_and_r/recipes/mppi.c @@ -0,0 +1,66 @@ + +#include +#include "nrutil.h" +#define IAOFF 48 + +void mppi(n) +int n; +{ + void mp2dfr(),mpadd(),mpinv(),mplsh(),mpmov(),mpmul(),mpsdv(),mpsqrt(); + int ir,j,m; + unsigned char mm,*x,*y,*sx,*sxi,*t,*s,*pi; + + x=cvector(1,n+1); + y=cvector(1,n<<1); + sx=cvector(1,n); + sxi=cvector(1,n); + t=cvector(1,n<<1); + s=cvector(1,3*n); + pi=cvector(1,n+1); + t[1]=2; + for (j=2;j<=n;j++) t[j]=0; + mpsqrt(x,x,t,n,n); + mpadd(pi,t,x,n); + mplsh(pi,n); + mpsqrt(sx,sxi,x,n,n); + mpmov(y,sx,n); + for (;;) { + mpadd(x,sx,sxi,n); + mpsdv(x,&x[1],n,2,&ir); + mpsqrt(sx,sxi,x,n,n); + mpmul(t,y,sx,n,n); + mpadd(&t[1],&t[1],sxi,n); + x[1]++; + y[1]++; + mpinv(s,y,n,n); + mpmul(y,&t[2],s,n,n); + mplsh(y,n); + mpmul(t,x,s,n,n); + mm=t[2]-1; + for (j=3;j<=n;j++) { + if (t[j] != mm) break; + } + m=t[n+1]-mm; + if (j <= n || m > 1 || m < -1) { + mpmul(s,pi,&t[1],n,n); + mpmov(pi,&s[1],n); + continue; + } + printf("pi=\n"); + s[1]=pi[1]+IAOFF; + s[2]='.'; + m=mm; + mp2dfr(&pi[1],&s[2],n-1,&m); + s[m+3]=0; + printf(" %64s\n",&s[1]); + free_cvector(pi,1,n+1); + free_cvector(s,1,3*n); + free_cvector(t,1,n<<1); + free_cvector(sxi,1,n); + free_cvector(sx,1,n); + free_cvector(y,1,n<<1); + free_cvector(x,1,n+1); + return; + } +} +#undef IAOFF diff --git a/lib/nr/k_and_r/recipes/mprove.c b/lib/nr/k_and_r/recipes/mprove.c new file mode 100644 index 0000000..deed84f --- /dev/null +++ b/lib/nr/k_and_r/recipes/mprove.c @@ -0,0 +1,22 @@ + +#include "nrutil.h" + +void mprove(a,alud,n,indx,b,x) +float **a,**alud,b[],x[]; +int indx[],n; +{ + void lubksb(); + int j,i; + double sdp; + float *r; + + r=vector(1,n); + for (i=1;i<=n;i++) { + sdp = -b[i]; + for (j=1;j<=n;j++) sdp += a[i][j]*x[j]; + r[i]=sdp; + } + lubksb(alud,n,indx,r); + for (i=1;i<=n;i++) x[i] -= r[i]; + free_vector(r,1,n); +} diff --git a/lib/nr/k_and_r/recipes/mpsqrt.c b/lib/nr/k_and_r/recipes/mpsqrt.c new file mode 100644 index 0000000..1594e15 --- /dev/null +++ b/lib/nr/k_and_r/recipes/mpsqrt.c @@ -0,0 +1,54 @@ + +#include +#include "nrutil.h" +#define MF 3 +#define BI (1.0/256) + +void mpsqrt(w,u,v,n,m) +int m,n; +unsigned char u[],v[],w[]; +{ + void mplsh(),mpmov(),mpmul(),mpneg(),mpsdv(); + int i,ir,j,mm; + float fu,fv; + unsigned char *r,*s; + + r=cvector(1,n<<1); + s=cvector(1,n<<1); + mm=IMIN(m,MF); + fv=(float) v[mm]; + for (j=mm-1;j>=1;j--) { + fv *= BI; + fv += v[j]; + } + fu=1.0/sqrt(fv); + for (j=1;j<=n;j++) { + i=(int) fu; + u[j]=(unsigned char) i; + fu=256.0*(fu-i); + } + for (;;) { + mpmul(r,u,u,n,n); + mplsh(r,n); + mpmul(s,r,v,n,IMIN(m,n)); + mplsh(s,n); + mpneg(s,n); + s[1] -= 253; + mpsdv(s,s,n,2,&ir); + for (j=2;j +#include "nrutil.h" +#define MAXITS 200 +#define TOLF 1.0e-4 +#define TOLMIN 1.0e-6 +#define TOLX 1.0e-7 +#define STPMX 100.0 + +int nn; +float *fvec; +void (*nrfuncv)(); +#define FREERETURN {free_vector(fvec,1,n);free_vector(xold,1,n);\ + free_vector(p,1,n);free_vector(g,1,n);free_matrix(fjac,1,n,1,n);\ + free_ivector(indx,1,n);return;} + +void newt(x,n,check,vecfunc) +float x[]; +int *check,n; +void (*vecfunc)(); +{ + float fmin(); + void fdjac(),lnsrch(),lubksb(),ludcmp(); + int i,its,j,*indx; + float d,den,f,fold,stpmax,sum,temp,test,**fjac,*g,*p,*xold; + + indx=ivector(1,n); + fjac=matrix(1,n,1,n); + g=vector(1,n); + p=vector(1,n); + xold=vector(1,n); + fvec=vector(1,n); + nn=n; + nrfuncv=vecfunc; + f=fmin(x); + test=0.0; + for (i=1;i<=n;i++) + if (fabs(fvec[i]) > test) test=fabs(fvec[i]); + if (test < 0.01*TOLF) { + *check=0; + FREERETURN + } + for (sum=0.0,i=1;i<=n;i++) sum += SQR(x[i]); + stpmax=STPMX*FMAX(sqrt(sum),(float)n); + for (its=1;its<=MAXITS;its++) { + fdjac(n,x,fvec,fjac,vecfunc); + for (i=1;i<=n;i++) { + for (sum=0.0,j=1;j<=n;j++) sum += fjac[j][i]*fvec[j]; + g[i]=sum; + } + for (i=1;i<=n;i++) xold[i]=x[i]; + fold=f; + for (i=1;i<=n;i++) p[i] = -fvec[i]; + ludcmp(fjac,n,indx,&d); + lubksb(fjac,n,indx,p); + lnsrch(n,xold,fold,g,p,x,&f,stpmax,check,fmin); + test=0.0; + for (i=1;i<=n;i++) + if (fabs(fvec[i]) > test) test=fabs(fvec[i]); + if (test < TOLF) { + *check=0; + FREERETURN + } + if (*check) { + test=0.0; + den=FMAX(f,0.5*n); + for (i=1;i<=n;i++) { + temp=fabs(g[i])*FMAX(fabs(x[i]),1.0)/den; + if (temp > test) test=temp; + } + *check=(test < TOLMIN ? 1 : 0); + FREERETURN + } + test=0.0; + for (i=1;i<=n;i++) { + temp=(fabs(x[i]-xold[i]))/FMAX(fabs(x[i]),1.0); + if (temp > test) test=temp; + } + if (test < TOLX) FREERETURN + } + nrerror("MAXITS exceeded in newt"); +} +#undef MAXITS +#undef TOLF +#undef TOLMIN +#undef TOLX +#undef STPMX +#undef FREERETURN diff --git a/lib/nr/k_and_r/recipes/nrutil.c b/lib/nr/k_and_r/recipes/nrutil.c new file mode 100644 index 0000000..b6b2200 --- /dev/null +++ b/lib/nr/k_and_r/recipes/nrutil.c @@ -0,0 +1,327 @@ +/* CAUTION: This is the traditional K&R C (only) version of the Numerical + Recipes utility file nrutil.c. Do not confuse this file with the + same-named file nrutil.c that is supplied in the same subdirectory or + archive as the header file nrutil.h. *That* file contains both ANSI and + traditional K&R versions, along with #ifdef macros to select the + correct version. *This* file contains only traditional K&R. */ + +#include +#define NR_END 1 +#define FREE_ARG char* + +void nrerror(error_text) +char error_text[]; +/* Numerical Recipes standard error handler */ +{ + void exit(); + + fprintf(stderr,"Numerical Recipes run-time error...\n"); + fprintf(stderr,"%s\n",error_text); + fprintf(stderr,"...now exiting to system...\n"); + exit(1); +} + +float *vector(nl,nh) +long nh,nl; +/* allocate a float vector with subscript range v[nl..nh] */ +{ + float *v; + + v=(float *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(float))); + if (!v) nrerror("allocation failure in vector()"); + return v-nl+NR_END; +} + +int *ivector(nl,nh) +long nh,nl; +/* allocate an int vector with subscript range v[nl..nh] */ +{ + int *v; + + v=(int *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(int))); + if (!v) nrerror("allocation failure in ivector()"); + return v-nl+NR_END; +} + +unsigned char *cvector(nl,nh) +long nh,nl; +/* allocate an unsigned char vector with subscript range v[nl..nh] */ +{ + unsigned char *v; + + v=(unsigned char *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(unsigned char))); + if (!v) nrerror("allocation failure in cvector()"); + return v-nl+NR_END; +} + +unsigned long *lvector(nl,nh) +long nh,nl; +/* allocate an unsigned long vector with subscript range v[nl..nh] */ +{ + unsigned long *v; + + v=(unsigned long *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(long))); + if (!v) nrerror("allocation failure in lvector()"); + return v-nl+NR_END; +} + +double *dvector(nl,nh) +long nh,nl; +/* allocate a double vector with subscript range v[nl..nh] */ +{ + double *v; + + v=(double *)malloc((unsigned int) ((nh-nl+1+NR_END)*sizeof(double))); + if (!v) nrerror("allocation failure in dvector()"); + return v-nl+NR_END; +} + +float **matrix(nrl,nrh,ncl,nch) +long nch,ncl,nrh,nrl; +/* allocate a float matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + float **m; + + /* allocate pointers to rows */ + m=(float **) malloc((unsigned int)((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + /* allocate rows and set pointers to them */ + m[nrl]=(float *) malloc((unsigned int)((nrow*ncol+NR_END)*sizeof(float))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +double **dmatrix(nrl,nrh,ncl,nch) +long nch,ncl,nrh,nrl; +/* allocate a double matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + double **m; + + /* allocate pointers to rows */ + m=(double **) malloc((unsigned int)((nrow+NR_END)*sizeof(double*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + /* allocate rows and set pointers to them */ + m[nrl]=(double *) malloc((unsigned int)((nrow*ncol+NR_END)*sizeof(double))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +int **imatrix(nrl,nrh,ncl,nch) +long nch,ncl,nrh,nrl; +/* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; + int **m; + + /* allocate pointers to rows */ + m=(int **) malloc((unsigned int)((nrow+NR_END)*sizeof(int*))); + if (!m) nrerror("allocation failure 1 in matrix()"); + m += NR_END; + m -= nrl; + + + /* allocate rows and set pointers to them */ + m[nrl]=(int *) malloc((unsigned int)((nrow*ncol+NR_END)*sizeof(int))); + if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); + m[nrl] += NR_END; + m[nrl] -= ncl; + + for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +float **submatrix(a,oldrl,oldrh,oldcl,oldch,newrl,newcl) +float **a; +long newcl,newrl,oldch,oldcl,oldrh,oldrl; +/* point a submatrix [newrl..][newcl..] to a[oldrl..oldrh][oldcl..oldch] */ +{ + long i,j,nrow=oldrh-oldrl+1,ncol=oldcl-newcl; + float **m; + + /* allocate array of pointers to rows */ + m=(float **) malloc((unsigned int) ((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure in submatrix()"); + m += NR_END; + m -= newrl; + + /* set pointers to rows */ + for(i=oldrl,j=newrl;i<=oldrh;i++,j++) m[j]=a[i]+ncol; + + /* return pointer to array of pointers to rows */ + return m; +} + +float **convert_matrix(a,nrl,nrh,ncl,nch) +float *a; +long nch,ncl,nrh,nrl; +/* allocate a float matrix m[nrl..nrh][ncl..nch] that points to the matrix +declared in the standard C manner as a[nrow][ncol], where nrow=nrh-nrl+1 +and ncol=nch-ncl+1. The routine should be called with the address +&a[0][0] as the first argument. */ +{ + long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1; + float **m; + + /* allocate pointers to rows */ + m=(float **) malloc((unsigned int) ((nrow+NR_END)*sizeof(float*))); + if (!m) nrerror("allocation failure in convert_matrix()"); + m += NR_END; + m -= nrl; + + /* set pointers to rows */ + m[nrl]=a-ncl; + for(i=1,j=nrl+1;i +#include "nrutil.h" +#define MAXSTP 10000 +#define TINY 1.0e-30 + +extern int kmax,kount; +extern float *xp,**yp,dxsav; + +void odeint(ystart,nvar,x1,x2,eps,h1,hmin,nok,nbad,derivs,rkqs) +float eps,h1,hmin,x1,x2,ystart[]; +int *nbad,*nok,nvar; +void (*derivs)(),(*rkqs)(); +{ + int nstp,i; + float xsav,x,hnext,hdid,h; + float *yscal,*y,*dydx; + + yscal=vector(1,nvar); + y=vector(1,nvar); + dydx=vector(1,nvar); + x=x1; + h=SIGN(h1,x2-x1); + *nok = (*nbad) = kount = 0; + for (i=1;i<=nvar;i++) y[i]=ystart[i]; + if (kmax > 0) xsav=x-dxsav*2.0; + for (nstp=1;nstp<=MAXSTP;nstp++) { + (*derivs)(x,y,dydx); + for (i=1;i<=nvar;i++) + yscal[i]=fabs(y[i])+fabs(dydx[i]*h)+TINY; + if (kmax > 0 && kount < kmax-1 && fabs(x-xsav) > fabs(dxsav)) { + xp[++kount]=x; + for (i=1;i<=nvar;i++) yp[i][kount]=y[i]; + xsav=x; + } + if ((x+h-x2)*(x+h-x1) > 0.0) h=x2-x; + (*rkqs)(y,dydx,nvar,&x,h,eps,yscal,&hdid,&hnext,derivs); + if (hdid == h) ++(*nok); else ++(*nbad); + if ((x-x2)*(x2-x1) >= 0.0) { + for (i=1;i<=nvar;i++) ystart[i]=y[i]; + if (kmax) { + xp[++kount]=x; + for (i=1;i<=nvar;i++) yp[i][kount]=y[i]; + } + free_vector(dydx,1,nvar); + free_vector(y,1,nvar); + free_vector(yscal,1,nvar); + return; + } + if (fabs(hnext) <= hmin) nrerror("Step size too small in odeint"); + h=hnext; + } + nrerror("Too many steps in routine odeint"); +} +#undef MAXSTP +#undef TINY diff --git a/lib/nr/k_and_r/recipes/orthog.c b/lib/nr/k_and_r/recipes/orthog.c new file mode 100644 index 0000000..8b07798 --- /dev/null +++ b/lib/nr/k_and_r/recipes/orthog.c @@ -0,0 +1,29 @@ + +#include "nrutil.h" + +void orthog(n,anu,alpha,beta,a,b) +float a[],alpha[],anu[],b[],beta[]; +int n; +{ + int k,l; + float **sig; + int looptmp; + + sig=matrix(1,2*n+1,1,2*n+1); + looptmp=2*n; + for (l=3;l<=looptmp;l++) sig[1][l]=0.0; + looptmp++; + for (l=2;l<=looptmp;l++) sig[2][l]=anu[l-1]; + a[1]=alpha[1]+anu[2]/anu[1]; + b[1]=0.0; + for (k=3;k<=n+1;k++) { + looptmp=2*n-k+3; + for (l=k;l<=looptmp;l++) { + sig[k][l]=sig[k-1][l+1]+(alpha[l-1]-a[k-2])*sig[k-1][l]- + b[k-2]*sig[k-2][l]+beta[l-1]*sig[k-1][l-1]; + } + a[k-1]=alpha[k-1]+sig[k][k+1]/sig[k][k]-sig[k-1][k]/sig[k-1][k-1]; + b[k-1]=sig[k][k]/sig[k-1][k-1]; + } + free_matrix(sig,1,2*n+1,1,2*n+1); +} diff --git a/lib/nr/k_and_r/recipes/pade.c b/lib/nr/k_and_r/recipes/pade.c new file mode 100644 index 0000000..53770cd --- /dev/null +++ b/lib/nr/k_and_r/recipes/pade.c @@ -0,0 +1,54 @@ + +#include +#include "nrutil.h" +#define BIG 1.0e30 + +void pade(cof,n,resid) +double cof[]; +float *resid; +int n; +{ + void lubksb(),ludcmp(),mprove(); + int j,k,*indx; + float d,rr,rrold,sum,**q,**qlu,*x,*y,*z; + + indx=ivector(1,n); + q=matrix(1,n,1,n); + qlu=matrix(1,n,1,n); + x=vector(1,n); + y=vector(1,n); + z=vector(1,n); + for (j=1;j<=n;j++) { + y[j]=x[j]=cof[n+j]; + for (k=1;k<=n;k++) { + q[j][k]=cof[j-k+n]; + qlu[j][k]=q[j][k]; + } + } + ludcmp(qlu,n,indx,&d); + lubksb(qlu,n,indx,x); + rr=BIG; + do { + rrold=rr; + for (j=1;j<=n;j++) z[j]=x[j]; + mprove(q,qlu,n,indx,y,x); + for (rr=0.0,j=1;j<=n;j++) + rr += SQR(z[j]-x[j]); + } while (rr < rrold); + *resid=sqrt(rrold); + for (k=1;k<=n;k++) { + for (sum=cof[k],j=1;j<=k;j++) sum -= z[j]*cof[k-j]; + y[k]=sum; + } + for (j=1;j<=n;j++) { + cof[j]=y[j]; + cof[j+n] = -z[j]; + } + free_vector(z,1,n); + free_vector(y,1,n); + free_vector(x,1,n); + free_matrix(qlu,1,n,1,n); + free_matrix(q,1,n,1,n); + free_ivector(indx,1,n); +} +#undef BIG diff --git a/lib/nr/k_and_r/recipes/pccheb.c b/lib/nr/k_and_r/recipes/pccheb.c new file mode 100644 index 0000000..556fd3f --- /dev/null +++ b/lib/nr/k_and_r/recipes/pccheb.c @@ -0,0 +1,22 @@ + +void pccheb(d,c,n) +float c[],d[]; +int n; +{ + int j,jm,jp,k; + float fac,pow; + + pow=1.0; + c[0]=2.0*d[0]; + for (k=1;k=0;j-=2,jm--,jp++) { + c[j] += fac; + fac *= ((float)jm)/((float)jp); + } + pow += pow; + } +} diff --git a/lib/nr/k_and_r/recipes/pcshft.c b/lib/nr/k_and_r/recipes/pcshft.c new file mode 100644 index 0000000..2895015 --- /dev/null +++ b/lib/nr/k_and_r/recipes/pcshft.c @@ -0,0 +1,19 @@ + +void pcshft(a,b,d,n) +float a,b,d[]; +int n; +{ + int k,j; + float fac,cnst; + + cnst=2.0/(b-a); + fac=cnst; + for (j=1;j=j;k--) + d[k] -= cnst*d[k+1]; +} diff --git a/lib/nr/k_and_r/recipes/pearsn.c b/lib/nr/k_and_r/recipes/pearsn.c new file mode 100644 index 0000000..2750dad --- /dev/null +++ b/lib/nr/k_and_r/recipes/pearsn.c @@ -0,0 +1,33 @@ + +#include +#define TINY 1.0e-20 + +void pearsn(x,y,n,r,prob,z) +float *prob,*r,*z,x[],y[]; +unsigned long n; +{ + float betai(),erfcc(); + unsigned long j; + float yt,xt,t,df; + float syy=0.0,sxy=0.0,sxx=0.0,ay=0.0,ax=0.0; + + for (j=1;j<=n;j++) { + ax += x[j]; + ay += y[j]; + } + ax /= n; + ay /= n; + for (j=1;j<=n;j++) { + xt=x[j]-ax; + yt=y[j]-ay; + sxx += xt*xt; + syy += yt*yt; + sxy += xt*yt; + } + *r=sxy/(sqrt(sxx*syy)+TINY); + *z=0.5*log((1.0+(*r)+TINY)/(1.0-(*r)+TINY)); + df=n-2; + t=(*r)*sqrt(df/((1.0-(*r)+TINY)*(1.0+(*r)+TINY))); + *prob=betai(0.5*df,0.5,df/(df+t*t)); +} +#undef TINY diff --git a/lib/nr/k_and_r/recipes/period.c b/lib/nr/k_and_r/recipes/period.c new file mode 100644 index 0000000..7d0d291 --- /dev/null +++ b/lib/nr/k_and_r/recipes/period.c @@ -0,0 +1,79 @@ + +#include +#include "nrutil.h" +#define TWOPID 6.2831853071795865 + +void period(x,y,n,ofac,hifac,px,py,np,nout,jmax,prob) +float *prob,hifac,ofac,px[],py[],x[],y[]; +int *jmax,*nout,n,np; +{ + void avevar(); + int i,j; + float ave,c,cc,cwtau,effm,expy,pnow,pymax,s,ss,sumc,sumcy,sums,sumsh, + sumsy,swtau,var,wtau,xave,xdif,xmax,xmin,yy; + double arg,wtemp,*wi,*wpi,*wpr,*wr; + + wi=dvector(1,n); + wpi=dvector(1,n); + wpr=dvector(1,n); + wr=dvector(1,n); + *nout=0.5*ofac*hifac*n; + if (*nout > np) nrerror("output arrays too short in period"); + avevar(y,n,&ave,&var); + if (var == 0.0) nrerror("zero variance in period"); + xmax=xmin=x[1]; + for (j=1;j<=n;j++) { + if (x[j] > xmax) xmax=x[j]; + if (x[j] < xmin) xmin=x[j]; + } + xdif=xmax-xmin; + xave=0.5*(xmax+xmin); + pymax=0.0; + pnow=1.0/(xdif*ofac); + for (j=1;j<=n;j++) { + arg=TWOPID*((x[j]-xave)*pnow); + wpr[j] = -2.0*SQR(sin(0.5*arg)); + wpi[j]=sin(arg); + wr[j]=cos(arg); + wi[j]=wpi[j]; + } + for (i=1;i<=(*nout);i++) { + px[i]=pnow; + sumsh=sumc=0.0; + for (j=1;j<=n;j++) { + c=wr[j]; + s=wi[j]; + sumsh += s*c; + sumc += (c-s)*(c+s); + } + wtau=0.5*atan2(2.0*sumsh,sumc); + swtau=sin(wtau); + cwtau=cos(wtau); + sums=sumc=sumsy=sumcy=0.0; + for (j=1;j<=n;j++) { + s=wi[j]; + c=wr[j]; + ss=s*cwtau-c*swtau; + cc=c*cwtau+s*swtau; + sums += ss*ss; + sumc += cc*cc; + yy=y[j]-ave; + sumsy += yy*ss; + sumcy += yy*cc; + wr[j]=((wtemp=wr[j])*wpr[j]-wi[j]*wpi[j])+wr[j]; + wi[j]=(wi[j]*wpr[j]+wtemp*wpi[j])+wi[j]; + } + py[i]=0.5*(sumcy*sumcy/sumc+sumsy*sumsy/sums)/var; + if (py[i] >= pymax) pymax=py[(*jmax=i)]; + pnow += 1.0/(ofac*xdif); + } + expy=exp(-pymax); + effm=2.0*(*nout)/ofac; + *prob=effm*expy; + if (*prob > 0.01) *prob=1.0-pow(1.0-expy,effm); + free_dvector(wr,1,n); + free_dvector(wpr,1,n); + free_dvector(wpi,1,n); + free_dvector(wi,1,n); +} +#undef TWOPID diff --git a/lib/nr/k_and_r/recipes/piksr2.c b/lib/nr/k_and_r/recipes/piksr2.c new file mode 100644 index 0000000..506a0dd --- /dev/null +++ b/lib/nr/k_and_r/recipes/piksr2.c @@ -0,0 +1,21 @@ + +void piksr2(n,arr,brr) +float arr[],brr[]; +int n; +{ + int i,j; + float a,b; + + for (j=2;j<=n;j++) { + a=arr[j]; + b=brr[j]; + i=j-1; + while (i > 0 && arr[i] > a) { + arr[i+1]=arr[i]; + brr[i+1]=brr[i]; + i--; + } + arr[i+1]=a; + brr[i+1]=b; + } +} diff --git a/lib/nr/k_and_r/recipes/piksrt.c b/lib/nr/k_and_r/recipes/piksrt.c new file mode 100644 index 0000000..81b8c7c --- /dev/null +++ b/lib/nr/k_and_r/recipes/piksrt.c @@ -0,0 +1,18 @@ + +void piksrt(n,arr) +float arr[]; +int n; +{ + int i,j; + float a; + + for (j=2;j<=n;j++) { + a=arr[j]; + i=j-1; + while (i > 0 && arr[i] > a) { + arr[i+1]=arr[i]; + i--; + } + arr[i+1]=a; + } +} diff --git a/lib/nr/k_and_r/recipes/pinvs.c b/lib/nr/k_and_r/recipes/pinvs.c new file mode 100644 index 0000000..c2cefb0 --- /dev/null +++ b/lib/nr/k_and_r/recipes/pinvs.c @@ -0,0 +1,66 @@ + +#include +#include "nrutil.h" + +void pinvs(ie1,ie2,je1,jsf,jc1,k,c,s) +float ***c,**s; +int ie1,ie2,jc1,je1,jsf,k; +{ + int js1,jpiv,jp,je2,jcoff,j,irow,ipiv,id,icoff,i,*indxr; + float pivinv,piv,dum,big,*pscl; + + indxr=ivector(ie1,ie2); + pscl=vector(ie1,ie2); + je2=je1+ie2-ie1; + js1=je2+1; + for (i=ie1;i<=ie2;i++) { + big=0.0; + for (j=je1;j<=je2;j++) + if (fabs(s[i][j]) > big) big=fabs(s[i][j]); + if (big == 0.0) nrerror("Singular matrix - row all 0, in pinvs"); + pscl[i]=1.0/big; + indxr[i]=0; + } + for (id=ie1;id<=ie2;id++) { + piv=0.0; + for (i=ie1;i<=ie2;i++) { + if (indxr[i] == 0) { + big=0.0; + for (j=je1;j<=je2;j++) { + if (fabs(s[i][j]) > big) { + jp=j; + big=fabs(s[i][j]); + } + } + if (big*pscl[i] > piv) { + ipiv=i; + jpiv=jp; + piv=big*pscl[i]; + } + } + } + if (s[ipiv][jpiv] == 0.0) nrerror("Singular matrix in routine pinvs"); + indxr[ipiv]=jpiv; + pivinv=1.0/s[ipiv][jpiv]; + for (j=je1;j<=jsf;j++) s[ipiv][j] *= pivinv; + s[ipiv][jpiv]=1.0; + for (i=ie1;i<=ie2;i++) { + if (indxr[i] != jpiv) { + if (s[i][jpiv]) { + dum=s[i][jpiv]; + for (j=je1;j<=jsf;j++) + s[i][j] -= dum*s[ipiv][j]; + s[i][jpiv]=0.0; + } + } + } + } + jcoff=jc1-js1; + icoff=ie1-je1; + for (i=ie1;i<=ie2;i++) { + irow=indxr[i]+icoff; + for (j=js1;j<=jsf;j++) c[irow][j+jcoff][k]=s[i][j]; + } + free_vector(pscl,ie1,ie2); + free_ivector(indxr,ie1,ie2); +} diff --git a/lib/nr/k_and_r/recipes/plgndr.c b/lib/nr/k_and_r/recipes/plgndr.c new file mode 100644 index 0000000..b5dd629 --- /dev/null +++ b/lib/nr/k_and_r/recipes/plgndr.c @@ -0,0 +1,38 @@ + +#include + +float plgndr(l,m,x) +float x; +int l,m; +{ + void nrerror(); + float fact,pll,pmm,pmmp1,somx2; + int i,ll; + + if (m < 0 || m > l || fabs(x) > 1.0) + nrerror("Bad arguments in routine plgndr"); + pmm=1.0; + if (m > 0) { + somx2=sqrt((1.0-x)*(1.0+x)); + fact=1.0; + for (i=1;i<=m;i++) { + pmm *= -fact*somx2; + fact += 2.0; + } + } + if (l == m) + return pmm; + else { + pmmp1=x*(2*m+1)*pmm; + if (l == (m+1)) + return pmmp1; + else { + for (ll=m+2;ll<=l;ll++) { + pll=(x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m); + pmm=pmmp1; + pmmp1=pll; + } + return pll; + } + } +} diff --git a/lib/nr/k_and_r/recipes/poidev.c b/lib/nr/k_and_r/recipes/poidev.c new file mode 100644 index 0000000..8d07b85 --- /dev/null +++ b/lib/nr/k_and_r/recipes/poidev.c @@ -0,0 +1,42 @@ + +#include +#define PI 3.141592654 + +float poidev(xm,idum) +float xm; +long *idum; +{ + float gammln(),ran1(); + static float sq,alxm,g,oldm=(-1.0); + float em,t,y; + + if (xm < 12.0) { + if (xm != oldm) { + oldm=xm; + g=exp(-xm); + } + em = -1; + t=1.0; + do { + ++em; + t *= ran1(idum); + } while (t > g); + } else { + if (xm != oldm) { + oldm=xm; + sq=sqrt(2.0*xm); + alxm=log(xm); + g=xm*alxm-gammln(xm+1.0); + } + do { + do { + y=tan(PI*ran1(idum)); + em=sq*y+xm; + } while (em < 0.0); + em=floor(em); + t=0.9*(1.0+y*y)*exp(em*alxm-gammln(em+1.0)-g); + } while (ran1(idum) > t); + } + return em; +} +#undef PI diff --git a/lib/nr/k_and_r/recipes/polcoe.c b/lib/nr/k_and_r/recipes/polcoe.c new file mode 100644 index 0000000..7b1fb8c --- /dev/null +++ b/lib/nr/k_and_r/recipes/polcoe.c @@ -0,0 +1,31 @@ + +#include "nrutil.h" + +void polcoe(x,y,n,cof) +float cof[],x[],y[]; +int n; +{ + int k,j,i; + float phi,ff,b,*s; + + s=vector(0,n); + for (i=0;i<=n;i++) s[i]=cof[i]=0.0; + s[n] = -x[0]; + for (i=1;i<=n;i++) { + for (j=n-i;j<=n-1;j++) + s[j] -= x[i]*s[j+1]; + s[n] -= x[i]; + } + for (j=0;j<=n;j++) { + phi=n+1; + for (k=n;k>=1;k--) + phi=k*s[k]+x[j]*phi; + ff=y[j]/phi; + b=1.0; + for (k=n;k>=0;k--) { + cof[k] += b*ff; + b=s[k]+x[j]*b; + } + } + free_vector(s,0,n); +} diff --git a/lib/nr/k_and_r/recipes/polcof.c b/lib/nr/k_and_r/recipes/polcof.c new file mode 100644 index 0000000..e85df1f --- /dev/null +++ b/lib/nr/k_and_r/recipes/polcof.c @@ -0,0 +1,37 @@ + +#include +#include "nrutil.h" + +void polcof(xa,ya,n,cof) +float cof[],xa[],ya[]; +int n; +{ + void polint(); + int k,j,i; + float xmin,dy,*x,*y; + + x=vector(0,n); + y=vector(0,n); + for (j=0;j<=n;j++) { + x[j]=xa[j]; + y[j]=ya[j]; + } + for (j=0;j<=n;j++) { + polint(x-1,y-1,n+1-j,0.0,&cof[j],&dy); + xmin=1.0e38; + k = -1; + for (i=0;i<=n-j;i++) { + if (fabs(x[i]) < xmin) { + xmin=fabs(x[i]); + k=i; + } + if (x[i]) y[i]=(y[i]-cof[j])/x[i]; + } + for (i=k+1;i<=n-j;i++) { + y[i-1]=y[i]; + x[i-1]=x[i]; + } + } + free_vector(y,0,n); + free_vector(x,0,n); +} diff --git a/lib/nr/k_and_r/recipes/poldiv.c b/lib/nr/k_and_r/recipes/poldiv.c new file mode 100644 index 0000000..62cc403 --- /dev/null +++ b/lib/nr/k_and_r/recipes/poldiv.c @@ -0,0 +1,17 @@ + +void poldiv(u,n,v,nv,q,r) +float q[],r[],u[],v[]; +int n,nv; +{ + int k,j; + + for (j=0;j<=n;j++) { + r[j]=u[j]; + q[j]=0.0; + } + for (k=n-nv;k>=0;k--) { + q[k]=r[nv+k]/v[nv]; + for (j=nv+k-1;j>=k;j--) r[j] -= q[k]*v[j-k]; + } + for (j=nv;j<=n;j++) r[j]=0.0; +} diff --git a/lib/nr/k_and_r/recipes/polin2.c b/lib/nr/k_and_r/recipes/polin2.c new file mode 100644 index 0000000..99248aa --- /dev/null +++ b/lib/nr/k_and_r/recipes/polin2.c @@ -0,0 +1,18 @@ + +#include "nrutil.h" + +void polin2(x1a,x2a,ya,m,n,x1,x2,y,dy) +float **ya,*dy,*y,x1,x1a[],x2,x2a[]; +int m,n; +{ + void polint(); + int j; + float *ymtmp; + + ymtmp=vector(1,m); + for (j=1;j<=m;j++) { + polint(x2a,ya[j],n,x2,&ymtmp[j],dy); + } + polint(x1a,ymtmp,m,x1,y,dy); + free_vector(ymtmp,1,m); +} diff --git a/lib/nr/k_and_r/recipes/polint.c b/lib/nr/k_and_r/recipes/polint.c new file mode 100644 index 0000000..7181efa --- /dev/null +++ b/lib/nr/k_and_r/recipes/polint.c @@ -0,0 +1,39 @@ + +#include +#include "nrutil.h" + +void polint(xa,ya,n,x,y,dy) +float *dy,*y,x,xa[],ya[]; +int n; +{ + int i,m,ns=1; + float den,dif,dift,ho,hp,w; + float *c,*d; + + dif=fabs(x-xa[1]); + c=vector(1,n); + d=vector(1,n); + for (i=1;i<=n;i++) { + if ( (dift=fabs(x-xa[i])) < dif) { + ns=i; + dif=dift; + } + c[i]=ya[i]; + d[i]=ya[i]; + } + *y=ya[ns--]; + for (m=1;m +#include "nrutil.h" +#define TINY 1.0e-25 +#define ITMAX 200 + +void powell(p,xi,n,ftol,iter,fret,func) +float (*func)(),**xi,*fret,ftol,p[]; +int *iter,n; +{ + void linmin(); + int i,ibig,j; + float del,fp,fptt,t,*pt,*ptt,*xit; + + pt=vector(1,n); + ptt=vector(1,n); + xit=vector(1,n); + *fret=(*func)(p); + for (j=1;j<=n;j++) pt[j]=p[j]; + for (*iter=1;;++(*iter)) { + fp=(*fret); + ibig=0; + del=0.0; + for (i=1;i<=n;i++) { + for (j=1;j<=n;j++) xit[j]=xi[j][i]; + fptt=(*fret); + linmin(p,xit,n,fret,func); + if (fptt-(*fret) > del) { + del=fptt-(*fret); + ibig=i; + } + } + if (2.0*(fp-(*fret)) <= ftol*(fabs(fp)+fabs(*fret))+TINY) { + free_vector(xit,1,n); + free_vector(ptt,1,n); + free_vector(pt,1,n); + return; + } + if (*iter == ITMAX) nrerror("powell exceeding maximum iterations."); + for (j=1;j<=n;j++) { + ptt[j]=2.0*p[j]-pt[j]; + xit[j]=p[j]-pt[j]; + pt[j]=p[j]; + } + fptt=(*func)(ptt); + if (fptt < fp) { + t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)-del*SQR(fp-fptt); + if (t < 0.0) { + linmin(p,xit,n,fret,func); + for (j=1;j<=n;j++) { + xi[j][ibig]=xi[j][n]; + xi[j][n]=xit[j]; + } + } + } + } +} +#undef ITMAX diff --git a/lib/nr/k_and_r/recipes/predic.c b/lib/nr/k_and_r/recipes/predic.c new file mode 100644 index 0000000..9ae6991 --- /dev/null +++ b/lib/nr/k_and_r/recipes/predic.c @@ -0,0 +1,21 @@ + +#include "nrutil.h" + +void predic(data,ndata,d,m,future,nfut) +float d[],data[],future[]; +int m,ndata,nfut; +{ + int k,j; + float sum,discrp,*reg; + + reg=vector(1,m); + for (j=1;j<=m;j++) reg[j]=data[ndata+1-j]; + for (j=1;j<=nfut;j++) { + discrp=0.0; + sum=discrp; + for (k=1;k<=m;k++) sum += d[k]*reg[k]; + for (k=m;k>=2;k--) reg[k]=reg[k-1]; + future[j]=reg[1]=sum; + } + free_vector(reg,1,m); +} diff --git a/lib/nr/k_and_r/recipes/probks.c b/lib/nr/k_and_r/recipes/probks.c new file mode 100644 index 0000000..c51bc39 --- /dev/null +++ b/lib/nr/k_and_r/recipes/probks.c @@ -0,0 +1,23 @@ + +#include +#define EPS1 0.001 +#define EPS2 1.0e-8 + +float probks(alam) +float alam; +{ + int j; + float a2,fac=2.0,sum=0.0,term,termbf=0.0; + + a2 = -2.0*alam*alam; + for (j=1;j<=100;j++) { + term=fac*exp(a2*j*j); + sum += term; + if (fabs(term) <= EPS1*termbf || fabs(term) <= EPS2*sum) return sum; + fac = -fac; + termbf=fabs(term); + } + return 1.0; +} +#undef EPS1 +#undef EPS2 diff --git a/lib/nr/k_and_r/recipes/psdes.c b/lib/nr/k_and_r/recipes/psdes.c new file mode 100644 index 0000000..7c8ce71 --- /dev/null +++ b/lib/nr/k_and_r/recipes/psdes.c @@ -0,0 +1,23 @@ + +#define NITER 4 + +void psdes(lword,irword) +unsigned long *irword,*lword; +{ + unsigned long i,ia,ib,iswap,itmph=0,itmpl=0; + static unsigned long c1[NITER]={ + 0xbaa96887L, 0x1e17d32cL, 0x03bcdc3cL, 0x0f33d1b2L}; + static unsigned long c2[NITER]={ + 0x4b0f3b58L, 0xe874f0c3L, 0x6955c5a6L, 0x55a7ca46L}; + + for (i=0;i> 16; + ib=itmpl*itmpl+ ~(itmph*itmph); + *irword=(*lword) ^ (((ia = (ib >> 16) | + ((ib & 0xffff) << 16)) ^ c2[i])+itmpl*itmph); + *lword=iswap; + } +} +#undef NITER diff --git a/lib/nr/k_and_r/recipes/pwt.c b/lib/nr/k_and_r/recipes/pwt.c new file mode 100644 index 0000000..3744843 --- /dev/null +++ b/lib/nr/k_and_r/recipes/pwt.c @@ -0,0 +1,52 @@ + +#include "nrutil.h" + +typedef struct { + int ncof,ioff,joff; + float *cc,*cr; +} wavefilt; + +extern wavefilt wfilt; + +void pwt(a,n,isign) +float a[]; +int isign; +unsigned long n; +{ + float ai,ai1,*wksp; + unsigned long i,ii,j,jf,jr,k,n1,ni,nj,nh,nmod; + + if (n < 4) return; + wksp=vector(1,n); + nmod=wfilt.ncof*n; + n1=n-1; + nh=n >> 1; + for (j=1;j<=n;j++) wksp[j]=0.0; + if (isign >= 0) { + for (ii=1,i=1;i<=n;i+=2,ii++) { + ni=i+nmod+wfilt.ioff; + nj=i+nmod+wfilt.joff; + for (k=1;k<=wfilt.ncof;k++) { + jf=n1 & (ni+k); + jr=n1 & (nj+k); + wksp[ii] += wfilt.cc[k]*a[jf+1]; + wksp[ii+nh] += wfilt.cr[k]*a[jr+1]; + } + } + } else { + for (ii=1,i=1;i<=n;i+=2,ii++) { + ai=a[ii]; + ai1=a[ii+nh]; + ni=i+nmod+wfilt.ioff; + nj=i+nmod+wfilt.joff; + for (k=1;k<=wfilt.ncof;k++) { + jf=(n1 & (ni+k))+1; + jr=(n1 & (nj+k))+1; + wksp[jf] += wfilt.cc[k]*ai; + wksp[jr] += wfilt.cr[k]*ai1; + } + } + } + for (j=1;j<=n;j++) a[j]=wksp[j]; + free_vector(wksp,1,n); +} diff --git a/lib/nr/k_and_r/recipes/pwtset.c b/lib/nr/k_and_r/recipes/pwtset.c new file mode 100644 index 0000000..3b65ab1 --- /dev/null +++ b/lib/nr/k_and_r/recipes/pwtset.c @@ -0,0 +1,49 @@ + +typedef struct { + int ncof,ioff,joff; + float *cc,*cr; +} wavefilt; + +wavefilt wfilt; + +void pwtset(n) +int n; +{ + void nrerror(); + int k; + float sig = -1.0; + static float c4[5]={0.0,0.4829629131445341,0.8365163037378079, + 0.2241438680420134,-0.1294095225512604}; + static float c12[13]={0.0,0.111540743350, 0.494623890398, 0.751133908021, + 0.315250351709,-0.226264693965,-0.129766867567, + 0.097501605587, 0.027522865530,-0.031582039318, + 0.000553842201, 0.004777257511,-0.001077301085}; + static float c20[21]={0.0,0.026670057901, 0.188176800078, 0.527201188932, + 0.688459039454, 0.281172343661,-0.249846424327, + -0.195946274377, 0.127369340336, 0.093057364604, + -0.071394147166,-0.029457536822, 0.033212674059, + 0.003606553567,-0.010733175483, 0.001395351747, + 0.001992405295,-0.000685856695,-0.000116466855, + 0.000093588670,-0.000013264203}; + static float c4r[5],c12r[13],c20r[21]; + + wfilt.ncof=n; + if (n == 4) { + wfilt.cc=c4; + wfilt.cr=c4r; + } + else if (n == 12) { + wfilt.cc=c12; + wfilt.cr=c12r; + } + else if (n == 20) { + wfilt.cc=c20; + wfilt.cr=c20r; + } + else nrerror("unimplemented value n in pwtset"); + for (k=1;k<=n;k++) { + wfilt.cr[wfilt.ncof+1-k]=sig*wfilt.cc[k]; + sig = -sig; + } + wfilt.ioff = wfilt.joff = -(n >> 1); +} diff --git a/lib/nr/k_and_r/recipes/pythag.c b/lib/nr/k_and_r/recipes/pythag.c new file mode 100644 index 0000000..734229e --- /dev/null +++ b/lib/nr/k_and_r/recipes/pythag.c @@ -0,0 +1,13 @@ + +#include +#include "nrutil.h" + +float pythag(a,b) +float a,b; +{ + float absa,absb; + absa=fabs(a); + absb=fabs(b); + if (absa > absb) return absa*sqrt(1.0+SQR(absb/absa)); + else return (absb == 0.0 ? 0.0 : absb*sqrt(1.0+SQR(absa/absb))); +} diff --git a/lib/nr/k_and_r/recipes/pzextr.c b/lib/nr/k_and_r/recipes/pzextr.c new file mode 100644 index 0000000..c92f745 --- /dev/null +++ b/lib/nr/k_and_r/recipes/pzextr.c @@ -0,0 +1,36 @@ + +#include "nrutil.h" + +extern float **d,*x; + +void pzextr(iest,xest,yest,yz,dy,nv) +float dy[],xest,yest[],yz[]; +int iest,nv; +{ + int k1,j; + float q,f2,f1,delta,*c; + + c=vector(1,nv); + x[iest]=xest; + for (j=1;j<=nv;j++) dy[j]=yz[j]=yest[j]; + if (iest == 1) { + for (j=1;j<=nv;j++) d[j][1]=yest[j]; + } else { + for (j=1;j<=nv;j++) c[j]=yest[j]; + for (k1=1;k1 +#include "nrutil.h" + +void qrdcmp(a,n,c,d,sing) +float **a,*c,*d; +int *sing,n; +{ + int i,j,k; + float scale,sigma,sum,tau; + + *sing=0; + for (k=1;k +#define EPS 1.0e-6 +#define JMAX 20 +#define JMAXP (JMAX+1) +#define K 5 + +float qromb(func,a,b) +float (*func)(),a,b; +{ + float trapzd(); + void polint(); + void nrerror(); + float ss,dss; + float s[JMAXP],h[JMAXP+1]; + int j; + + h[1]=1.0; + for (j=1;j<=JMAX;j++) { + s[j]=trapzd(func,a,b,j); + if (j >= K) { + polint(&h[j-K],&s[j-K],K,0.0,&ss,&dss); + if (fabs(dss) <= EPS*fabs(ss)) return ss; + } + h[j+1]=0.25*h[j]; + } + nrerror("Too many steps in routine qromb"); + return 0.0; +} +#undef EPS +#undef JMAX +#undef JMAXP +#undef K diff --git a/lib/nr/k_and_r/recipes/qromo.c b/lib/nr/k_and_r/recipes/qromo.c new file mode 100644 index 0000000..ffde098 --- /dev/null +++ b/lib/nr/k_and_r/recipes/qromo.c @@ -0,0 +1,31 @@ + +#include +#define EPS 1.0e-6 +#define JMAX 14 +#define JMAXP (JMAX+1) +#define K 5 + +float qromo(func,a,b,choose) +float (*choose)(),(*func)(),a,b; +{ + void polint(); + void nrerror(); + int j; + float ss,dss,h[JMAXP+1],s[JMAXP]; + + h[1]=1.0; + for (j=1;j<=JMAX;j++) { + s[j]=(*choose)(func,a,b,j); + if (j >= K) { + polint(&h[j-K],&s[j-K],K,0.0,&ss,&dss); + if (fabs(dss) <= EPS*fabs(ss)) return ss; + } + h[j+1]=h[j]/9.0; + } + nrerror("Too many steps in routing qromo"); + return 0.0; +} +#undef EPS +#undef JMAX +#undef JMAXP +#undef K diff --git a/lib/nr/k_and_r/recipes/qroot.c b/lib/nr/k_and_r/recipes/qroot.c new file mode 100644 index 0000000..478859c --- /dev/null +++ b/lib/nr/k_and_r/recipes/qroot.c @@ -0,0 +1,46 @@ + +#include +#include "nrutil.h" +#define ITMAX 20 +#define TINY 1.0e-6 + +void qroot(p,n,b,c,eps) +float *b,*c,eps,p[]; +int n; +{ + void poldiv(); + int iter; + float sc,sb,s,rc,rb,r,dv,delc,delb; + float *q,*qq,*rem; + float d[3]; + + q=vector(0,n); + qq=vector(0,n); + rem=vector(0,n); + d[2]=1.0; + for (iter=1;iter<=ITMAX;iter++) { + d[1]=(*b); + d[0]=(*c); + poldiv(p,n,d,2,q,rem); + s=rem[0]; + r=rem[1]; + poldiv(q,(n-1),d,2,qq,rem); + sb = -(*c)*(rc = -rem[1]); + rb = -(*b)*rc+(sc = -rem[0]); + dv=1.0/(sb*rc-sc*rb); + delb=(r*sc-s*rc)*dv; + delc=(-r*sb+s*rb)*dv; + *b += (delb=(r*sc-s*rc)*dv); + *c += (delc=(-r*sb+s*rb)*dv); + if ((fabs(delb) <= eps*fabs(*b) || fabs(*b) < TINY) + && (fabs(delc) <= eps*fabs(*c) || fabs(*c) < TINY)) { + free_vector(rem,0,n); + free_vector(qq,0,n); + free_vector(q,0,n); + return; + } + } + nrerror("Too many iterations in routine qroot"); +} +#undef ITMAX +#undef TINY diff --git a/lib/nr/k_and_r/recipes/qrsolv.c b/lib/nr/k_and_r/recipes/qrsolv.c new file mode 100644 index 0000000..2e86400 --- /dev/null +++ b/lib/nr/k_and_r/recipes/qrsolv.c @@ -0,0 +1,16 @@ + +void qrsolv(a,n,c,d,b) +float **a,b[],c[],d[]; +int n; +{ + void rsolv(); + int i,j; + float sum,tau; + + for (j=1;j +#include "nrutil.h" + +void qrupdt(r,qt,n,u,v) +float **qt,**r,u[],v[]; +int n; +{ + void rotate(); + int i,j,k; + + for (k=n;k>=1;k--) { + if (u[k]) break; + } + if (k < 1) k=1; + for (i=k-1;i>=1;i--) { + rotate(r,qt,n,i,u[i],-u[i+1]); + if (u[i] == 0.0) u[i]=fabs(u[i+1]); + else if (fabs(u[i]) > fabs(u[i+1])) + u[i]=fabs(u[i])*sqrt(1.0+SQR(u[i+1]/u[i])); + else u[i]=fabs(u[i+1])*sqrt(1.0+SQR(u[i]/u[i+1])); + } + for (j=1;j<=n;j++) r[1][j] += u[1]*v[j]; + for (i=1;i +#define EPS 1.0e-6 +#define JMAX 20 + +float qsimp(func,a,b) +float (*func)(),a,b; +{ + float trapzd(); + void nrerror(); + int j; + float s,st,ost=0.0,os=0.0; + + for (j=1;j<=JMAX;j++) { + st=trapzd(func,a,b,j); + s=(4.0*st-ost)/3.0; + if (j > 5) + if (fabs(s-os) < EPS*fabs(os) || + (s == 0.0 && os == 0.0)) return s; + os=s; + ost=st; + } + nrerror("Too many steps in routine qsimp"); + return 0.0; +} +#undef EPS +#undef JMAX diff --git a/lib/nr/k_and_r/recipes/qtrap.c b/lib/nr/k_and_r/recipes/qtrap.c new file mode 100644 index 0000000..9080dd7 --- /dev/null +++ b/lib/nr/k_and_r/recipes/qtrap.c @@ -0,0 +1,25 @@ + +#include +#define EPS 1.0e-5 +#define JMAX 20 + +float qtrap(func,a,b) +float (*func)(),a,b; +{ + float trapzd(); + void nrerror(); + int j; + float s,olds=0.0; + + for (j=1;j<=JMAX;j++) { + s=trapzd(func,a,b,j); + if (j > 5) + if (fabs(s-olds) < EPS*fabs(olds) || + (s == 0.0 && olds == 0.0)) return s; + olds=s; + } + nrerror("Too many steps in routine qtrap"); + return 0.0; +} +#undef EPS +#undef JMAX diff --git a/lib/nr/k_and_r/recipes/quad3d.c b/lib/nr/k_and_r/recipes/quad3d.c new file mode 100644 index 0000000..aa599db --- /dev/null +++ b/lib/nr/k_and_r/recipes/quad3d.c @@ -0,0 +1,38 @@ + +static float xsav,ysav; +static float (*nrfunc)(); + +float quad3d(func,x1,x2) +float (*func)(),x1,x2; +{ + float f1(),qgaus(); + + nrfunc=func; + return qgaus(f1,x1,x2); +} + +float f1(x) +float x; +{ + float f2(),qgaus(); + float yy1(),yy2(); + + xsav=x; + return qgaus(f2,yy1(x),yy2(x)); +} + +float f2(y) +float y; +{ + float f3(),qgaus(); + float z1(),z2(); + + ysav=y; + return qgaus(f3,z1(xsav,y),z2(xsav,y)); +} + +float f3(z) +float z; +{ + return (*nrfunc)(xsav,ysav,z); +} diff --git a/lib/nr/k_and_r/recipes/quadct.c b/lib/nr/k_and_r/recipes/quadct.c new file mode 100644 index 0000000..54c6490 --- /dev/null +++ b/lib/nr/k_and_r/recipes/quadct.c @@ -0,0 +1,21 @@ + +void quadct(x,y,xx,yy,nn,fa,fb,fc,fd) +float *fa,*fb,*fc,*fd,x,xx[],y,yy[]; +unsigned long nn; +{ + unsigned long k,na,nb,nc,nd; + float ff; + na=nb=nc=nd=0; + for (k=1;k<=nn;k++) { + if (yy[k] > y) { + xx[k] > x ? ++na : ++nb; + } else { + xx[k] > x ? ++nd : ++nc; + } + } + ff=1.0/nn; + *fa=ff*na; + *fb=ff*nb; + *fc=ff*nc; + *fd=ff*nd; +} diff --git a/lib/nr/k_and_r/recipes/quadmx.c b/lib/nr/k_and_r/recipes/quadmx.c new file mode 100644 index 0000000..35d693b --- /dev/null +++ b/lib/nr/k_and_r/recipes/quadmx.c @@ -0,0 +1,27 @@ + +#include +#include "nrutil.h" +#define PI 3.14159265 + +double x; + +void quadmx(a,n) +float **a; +int n; +{ + void kermom(),wwghts(); + int j,k; + float h,*wt,xx,cx; + + wt=vector(1,n); + h=PI/(n-1); + for (j=1;j<=n;j++) { + x=xx=(j-1)*h; + wwghts(wt,n,h,kermom); + cx=cos(xx); + for (k=1;k<=n;k++) a[j][k]=wt[k]*cx*cos((k-1)*h); + ++a[j][j]; + } + free_vector(wt,1,n); +} +#undef PI diff --git a/lib/nr/k_and_r/recipes/quadvl.c b/lib/nr/k_and_r/recipes/quadvl.c new file mode 100644 index 0000000..aeea8d4 --- /dev/null +++ b/lib/nr/k_and_r/recipes/quadvl.c @@ -0,0 +1,17 @@ + +#include "nrutil.h" + +void quadvl(x,y,fa,fb,fc,fd) +float *fa,*fb,*fc,*fd,x,y; +{ + float qa,qb,qc,qd; + + qa=FMIN(2.0,FMAX(0.0,1.0-x)); + qb=FMIN(2.0,FMAX(0.0,1.0-y)); + qc=FMIN(2.0,FMAX(0.0,x+1.0)); + qd=FMIN(2.0,FMAX(0.0,y+1.0)); + *fa=0.25*qa*qb; + *fb=0.25*qb*qc; + *fc=0.25*qc*qd; + *fd=0.25*qd*qa; +} diff --git a/lib/nr/k_and_r/recipes/ran0.c b/lib/nr/k_and_r/recipes/ran0.c new file mode 100644 index 0000000..db2347c --- /dev/null +++ b/lib/nr/k_and_r/recipes/ran0.c @@ -0,0 +1,28 @@ + +#define IA 16807 +#define IM 2147483647 +#define AM (1.0/IM) +#define IQ 127773 +#define IR 2836 +#define MASK 123459876 + +float ran0(idum) +long *idum; +{ + long k; + float ans; + + *idum ^= MASK; + k=(*idum)/IQ; + *idum=IA*(*idum-k*IQ)-IR*k; + if (*idum < 0) *idum += IM; + ans=AM*(*idum); + *idum ^= MASK; + return ans; +} +#undef IA +#undef IM +#undef AM +#undef IQ +#undef IR +#undef MASK diff --git a/lib/nr/k_and_r/recipes/ran1.c b/lib/nr/k_and_r/recipes/ran1.c new file mode 100644 index 0000000..f635f92 --- /dev/null +++ b/lib/nr/k_and_r/recipes/ran1.c @@ -0,0 +1,49 @@ + +#define IA 16807 +#define IM 2147483647 +#define AM (1.0/IM) +#define IQ 127773 +#define IR 2836 +#define NTAB 32 +#define NDIV (1+(IM-1)/NTAB) +#define EPS 1.2e-7 +#define RNMX (1.0-EPS) + +float ran1(idum) +long *idum; +{ + int j; + long k; + static long iy=0; + static long iv[NTAB]; + float temp; + + if (*idum <= 0 || !iy) { + if (-(*idum) < 1) *idum=1; + else *idum = -(*idum); + for (j=NTAB+7;j>=0;j--) { + k=(*idum)/IQ; + *idum=IA*(*idum-k*IQ)-IR*k; + if (*idum < 0) *idum += IM; + if (j < NTAB) iv[j] = *idum; + } + iy=iv[0]; + } + k=(*idum)/IQ; + *idum=IA*(*idum-k*IQ)-IR*k; + if (*idum < 0) *idum += IM; + j=iy/NDIV; + iy=iv[j]; + iv[j] = *idum; + if ((temp=AM*iy) > RNMX) return RNMX; + else return temp; +} +#undef IA +#undef IM +#undef AM +#undef IQ +#undef IR +#undef NTAB +#undef NDIV +#undef EPS +#undef RNMX diff --git a/lib/nr/k_and_r/recipes/ran2.c b/lib/nr/k_and_r/recipes/ran2.c new file mode 100644 index 0000000..dcb87bd --- /dev/null +++ b/lib/nr/k_and_r/recipes/ran2.c @@ -0,0 +1,65 @@ + +#define IM1 2147483563 +#define IM2 2147483399 +#define AM (1.0/IM1) +#define IMM1 (IM1-1) +#define IA1 40014 +#define IA2 40692 +#define IQ1 53668 +#define IQ2 52774 +#define IR1 12211 +#define IR2 3791 +#define NTAB 32 +#define NDIV (1+IMM1/NTAB) +#define EPS 1.2e-7 +#define RNMX (1.0-EPS) + +float ran2(idum) +long *idum; +{ + int j; + long k; + static long idum2=123456789; + static long iy=0; + static long iv[NTAB]; + float temp; + + if (*idum <= 0) { + if (-(*idum) < 1) *idum=1; + else *idum = -(*idum); + idum2=(*idum); + for (j=NTAB+7;j>=0;j--) { + k=(*idum)/IQ1; + *idum=IA1*(*idum-k*IQ1)-k*IR1; + if (*idum < 0) *idum += IM1; + if (j < NTAB) iv[j] = *idum; + } + iy=iv[0]; + } + k=(*idum)/IQ1; + *idum=IA1*(*idum-k*IQ1)-k*IR1; + if (*idum < 0) *idum += IM1; + k=idum2/IQ2; + idum2=IA2*(idum2-k*IQ2)-k*IR2; + if (idum2 < 0) idum2 += IM2; + j=iy/NDIV; + iy=iv[j]-idum2; + iv[j] = *idum; + if (iy < 1) iy += IMM1; + if ((temp=AM*iy) > RNMX) return RNMX; + else return temp; +} +#undef IM1 +#undef IM2 +#undef AM +#undef IMM1 +#undef IA1 +#undef IA2 +#undef IQ1 +#undef IQ2 +#undef IR1 +#undef IR2 +#undef NTAB +#undef NDIV +#undef EPS +#undef RNMX diff --git a/lib/nr/k_and_r/recipes/ran3.c b/lib/nr/k_and_r/recipes/ran3.c new file mode 100644 index 0000000..f13bb25 --- /dev/null +++ b/lib/nr/k_and_r/recipes/ran3.c @@ -0,0 +1,48 @@ + +#define MBIG 1000000000 +#define MSEED 161803398 +#define MZ 0 +#define FAC (1.0/MBIG) + +float ran3(idum) +long *idum; +{ + static int inext,inextp; + static long ma[56]; + static int iff=0; + long mj,mk; + int i,ii,k; + + if (*idum < 0 || iff == 0) { + iff=1; + mj=labs(MSEED-labs(*idum)); + mj %= MBIG; + ma[55]=mj; + mk=1; + for (i=1;i<=54;i++) { + ii=(21*i) % 55; + ma[ii]=mk; + mk=mj-mk; + if (mk < MZ) mk += MBIG; + mj=ma[ii]; + } + for (k=1;k<=4;k++) + for (i=1;i<=55;i++) { + ma[i] -= ma[1+(i+30) % 55]; + if (ma[i] < MZ) ma[i] += MBIG; + } + inext=0; + inextp=31; + *idum=1; + } + if (++inext == 56) inext=1; + if (++inextp == 56) inextp=1; + mj=ma[inext]-ma[inextp]; + if (mj < MZ) mj += MBIG; + ma[inext]=mj; + return mj*FAC; +} +#undef MBIG +#undef MSEED +#undef MZ +#undef FAC diff --git a/lib/nr/k_and_r/recipes/ran4.c b/lib/nr/k_and_r/recipes/ran4.c new file mode 100644 index 0000000..8cd8268 --- /dev/null +++ b/lib/nr/k_and_r/recipes/ran4.c @@ -0,0 +1,26 @@ + +float ran4(idum) +long *idum; +{ + void psdes(); + unsigned long irword,itemp,lword; + static long idums = 0; +#if defined(vax) || defined(_vax_) || defined(__vax__) || defined(VAX) + static unsigned long jflone = 0x00004080; + static unsigned long jflmsk = 0xffff007f; +#else + static unsigned long jflone = 0x3f800000; + static unsigned long jflmsk = 0x007fffff; +#endif + + if (*idum < 0) { + idums = -(*idum); + *idum=1; + } + irword=(*idum); + lword=idums; + psdes(&lword,&irword); + itemp=jflone | (jflmsk & irword); + ++(*idum); + return (*(float *)&itemp)-1.0; +} diff --git a/lib/nr/k_and_r/recipes/rank.c b/lib/nr/k_and_r/recipes/rank.c new file mode 100644 index 0000000..bcc6d91 --- /dev/null +++ b/lib/nr/k_and_r/recipes/rank.c @@ -0,0 +1,8 @@ + +void rank(n,indx,irank) +unsigned long indx[],irank[],n; +{ + unsigned long j; + + for (j=1;j<=n;j++) irank[indx[j]]=j; +} diff --git a/lib/nr/k_and_r/recipes/ranpt.c b/lib/nr/k_and_r/recipes/ranpt.c new file mode 100644 index 0000000..68110b4 --- /dev/null +++ b/lib/nr/k_and_r/recipes/ranpt.c @@ -0,0 +1,13 @@ + +extern long idum; + +void ranpt(pt,regn,n) +float pt[],regn[]; +int n; +{ + float ran1(); + int j; + + for (j=1;j<=n;j++) + pt[j]=regn[j]+(regn[n+j]-regn[j])*ran1(&idum); +} diff --git a/lib/nr/k_and_r/recipes/ratint.c b/lib/nr/k_and_r/recipes/ratint.c new file mode 100644 index 0000000..9f5111c --- /dev/null +++ b/lib/nr/k_and_r/recipes/ratint.c @@ -0,0 +1,47 @@ + +#include +#include "nrutil.h" +#define TINY 1.0e-25 +#define FREERETURN {free_vector(d,1,n);free_vector(c,1,n);return;} + +void ratint(xa,ya,n,x,y,dy) +float *dy,*y,x,xa[],ya[]; +int n; +{ + int m,i,ns=1; + float w,t,hh,h,dd,*c,*d; + + c=vector(1,n); + d=vector(1,n); + hh=fabs(x-xa[1]); + for (i=1;i<=n;i++) { + h=fabs(x-xa[i]); + if (h == 0.0) { + *y=ya[i]; + *dy=0.0; + FREERETURN + } else if (h < hh) { + ns=i; + hh=h; + } + c[i]=ya[i]; + d[i]=ya[i]+TINY; + } + *y=ya[ns--]; + for (m=1;m +#include +#include "nrutil.h" +#define NPFAC 8 +#define MAXIT 5 +#define PIO2 (3.141592653589793/2.0) +#define BIG 1.0e30 + +void ratlsq(fn,a,b,mm,kk,cof,dev) +double (*fn)(),*dev,a,b,cof[]; +int kk,mm; +{ + double ratval(); + void dsvbksb(),dsvdcmp(); + int i,it,j,ncof,npt; + double devmax,e,hth,power,sum,*bb,*coff,*ee,*fs,**u,**v,*w,*wt,*xs; + + ncof=mm+kk+1; + npt=NPFAC*ncof; + bb=dvector(1,npt); + coff=dvector(0,ncof-1); + ee=dvector(1,npt); + fs=dvector(1,npt); + u=dmatrix(1,npt,1,ncof); + v=dmatrix(1,ncof,1,ncof); + w=dvector(1,ncof); + wt=dvector(1,npt); + xs=dvector(1,npt); + *dev=BIG; + for (i=1;i<=npt;i++) { + if (i < npt/2) { + hth=PIO2*(i-1)/(npt-1.0); + xs[i]=a+(b-a)*DSQR(sin(hth)); + } else { + hth=PIO2*(npt-i)/(npt-1.0); + xs[i]=b-(b-a)*DSQR(sin(hth)); + } + fs[i]=(*fn)(xs[i]); + wt[i]=1.0; + ee[i]=1.0; + } + e=0.0; + for (it=1;it<=MAXIT;it++) { + for (i=1;i<=npt;i++) { + power=wt[i]; + bb[i]=power*(fs[i]+SIGN(e,ee[i])); + for (j=1;j<=mm+1;j++) { + u[i][j]=power; + power *= xs[i]; + } + power = -bb[i]; + for (j=mm+2;j<=ncof;j++) { + power *= xs[i]; + u[i][j]=power; + } + } + dsvdcmp(u,npt,ncof,w,v); + dsvbksb(u,w,v,npt,ncof,bb,coff-1); + devmax=sum=0.0; + for (j=1;j<=npt;j++) { + ee[j]=ratval(xs[j],coff,mm,kk)-fs[j]; + wt[j]=fabs(ee[j]); + sum += wt[j]; + if (wt[j] > devmax) devmax=wt[j]; + } + e=sum/npt; + if (devmax <= *dev) { + for (j=0;j=0;j--) sumn=sumn*x+cof[j]; + for (sumd=0.0,j=mm+kk;j>=mm+1;j--) sumd=(sumd+cof[j])*x; + return sumn/(1.0+sumd); +} diff --git a/lib/nr/k_and_r/recipes/rc.c b/lib/nr/k_and_r/recipes/rc.c new file mode 100644 index 0000000..0d82f85 --- /dev/null +++ b/lib/nr/k_and_r/recipes/rc.c @@ -0,0 +1,53 @@ + +#include +#include "nrutil.h" +#define ERRTOL 0.04 +#define TINY 1.69e-38 +#define SQRTNY 1.3e-19 +#define BIG 3.e37 +#define TNBG (TINY*BIG) +#define COMP1 (2.236/SQRTNY) +#define COMP2 (TNBG*TNBG/25.0) +#define THIRD (1.0/3.0) +#define C1 0.3 +#define C2 (1.0/7.0) +#define C3 0.375 +#define C4 (9.0/22.0) + +float rc(x,y) +float x,y; +{ + float alamb,ave,s,w,xt,yt; + if (x < 0.0 || y == 0.0 || (x+fabs(y)) < TINY || (x+fabs(y)) > BIG || + (y<-COMP1 && x > 0.0 && x < COMP2)) + nrerror("invalid arguments in rc"); + if (y > 0.0) { + xt=x; + yt=y; + w=1.0; + } else { + xt=x-y; + yt = -y; + w=sqrt(x)/sqrt(xt); + } + do { + alamb=2.0*sqrt(xt)*sqrt(yt)+yt; + xt=0.25*(xt+alamb); + yt=0.25*(yt+alamb); + ave=THIRD*(xt+yt+yt); + s=(yt-ave)/ave; + } while (fabs(s) > ERRTOL); + return w*(1.0+s*s*(C1+s*(C2+s*(C3+s*C4))))/sqrt(ave); +} +#undef ERRTOL +#undef TINY +#undef SQRTNY +#undef BIG +#undef TNBG +#undef COMP1 +#undef COMP2 +#undef THIRD +#undef C1 +#undef C2 +#undef C3 +#undef C4 diff --git a/lib/nr/k_and_r/recipes/rd.c b/lib/nr/k_and_r/recipes/rd.c new file mode 100644 index 0000000..0e26767 --- /dev/null +++ b/lib/nr/k_and_r/recipes/rd.c @@ -0,0 +1,58 @@ + +#include +#include "nrutil.h" +#define ERRTOL 0.05 +#define TINY 1.0e-25 +#define BIG 4.5e21 +#define C1 (3.0/14.0) +#define C2 (1.0/6.0) +#define C3 (9.0/22.0) +#define C4 (3.0/26.0) +#define C5 (0.25*C3) +#define C6 (1.5*C4) + +float rd(x,y,z) +float x,y,z; +{ + float alamb,ave,delx,dely,delz,ea,eb,ec,ed,ee,fac,sqrtx,sqrty, + sqrtz,sum,xt,yt,zt; + + if (FMIN(x,y) < 0.0 || FMIN(x+y,z) < TINY || FMAX(FMAX(x,y),z) > BIG) + nrerror("invalid arguments in rd"); + xt=x; + yt=y; + zt=z; + sum=0.0; + fac=1.0; + do { + sqrtx=sqrt(xt); + sqrty=sqrt(yt); + sqrtz=sqrt(zt); + alamb=sqrtx*(sqrty+sqrtz)+sqrty*sqrtz; + sum += fac/(sqrtz*(zt+alamb)); + fac=0.25*fac; + xt=0.25*(xt+alamb); + yt=0.25*(yt+alamb); + zt=0.25*(zt+alamb); + ave=0.2*(xt+yt+3.0*zt); + delx=(ave-xt)/ave; + dely=(ave-yt)/ave; + delz=(ave-zt)/ave; + } while (FMAX(FMAX(fabs(delx),fabs(dely)),fabs(delz)) > ERRTOL); + ea=delx*dely; + eb=delz*delz; + ec=ea-eb; + ed=ea-6.0*eb; + ee=ed+ec+ec; + return 3.0*sum+fac*(1.0+ed*(-C1+C5*ed-C6*delz*ee) + +delz*(C2*ee+delz*(-C3*ec+delz*C4*ea)))/(ave*sqrt(ave)); +} +#undef ERRTOL +#undef TINY +#undef BIG +#undef C1 +#undef C2 +#undef C3 +#undef C4 +#undef C5 +#undef C6 diff --git a/lib/nr/k_and_r/recipes/realft.c b/lib/nr/k_and_r/recipes/realft.c new file mode 100644 index 0000000..73a532a --- /dev/null +++ b/lib/nr/k_and_r/recipes/realft.c @@ -0,0 +1,49 @@ + +#include + +void realft(data,n,isign) +float data[]; +int isign; +unsigned long n; +{ + void four1(); + unsigned long i,i1,i2,i3,i4,np3; + float c1=0.5,c2,h1r,h1i,h2r,h2i; + double wr,wi,wpr,wpi,wtemp,theta; + + theta=3.141592653589793/(double) (n>>1); + if (isign == 1) { + c2 = -0.5; + four1(data,n>>1,1); + } else { + c2=0.5; + theta = -theta; + } + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + wr=1.0+wpr; + wi=wpi; + np3=n+3; + for (i=2;i<=(n>>2);i++) { + i4=1+(i3=np3-(i2=1+(i1=i+i-1))); + h1r=c1*(data[i1]+data[i3]); + h1i=c1*(data[i2]-data[i4]); + h2r = -c2*(data[i2]+data[i4]); + h2i=c2*(data[i1]-data[i3]); + data[i1]=h1r+wr*h2r-wi*h2i; + data[i2]=h1i+wr*h2i+wi*h2r; + data[i3]=h1r-wr*h2r+wi*h2i; + data[i4] = -h1i+wr*h2i+wi*h2r; + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + } + if (isign == 1) { + data[1] = (h1r=data[1])+data[2]; + data[2] = h1r-data[2]; + } else { + data[1]=c1*((h1r=data[1])+data[2]); + data[2]=c1*(h1r-data[2]); + four1(data,n>>1,-1); + } +} diff --git a/lib/nr/k_and_r/recipes/rebin.c b/lib/nr/k_and_r/recipes/rebin.c new file mode 100644 index 0000000..df892e8 --- /dev/null +++ b/lib/nr/k_and_r/recipes/rebin.c @@ -0,0 +1,19 @@ + +void rebin(rc,nd,r,xin,xi) +float r[],rc,xi[],xin[]; +int nd; +{ + int i,k=0; + float dr=0.0,xn=0.0,xo=0.0; + + for (i=1;i dr) + dr += r[++k]; + if (k > 1) xo=xi[k-1]; + xn=xi[k]; + dr -= rc; + xin[i]=xn-(xn-xo)*dr/r[k]; + } + for (i=1;i +#define ALEN(a,b,c,d) sqrt(((b)-(a))*((b)-(a))+((d)-(c))*((d)-(c))) + +float revcst(x,y,iorder,ncity,n) +float x[],y[]; +int iorder[],n[],ncity; +{ + float xx[5],yy[5],de; + int j,ii; + + n[3]=1 + ((n[1]+ncity-2) % ncity); + n[4]=1 + (n[2] % ncity); + for (j=1;j<=4;j++) { + ii=iorder[n[j]]; + xx[j]=x[ii]; + yy[j]=y[ii]; + } + de = -ALEN(xx[1],xx[3],yy[1],yy[3]); + de -= ALEN(xx[2],xx[4],yy[2],yy[4]); + de += ALEN(xx[1],xx[4],yy[1],yy[4]); + de += ALEN(xx[2],xx[3],yy[2],yy[3]); + return de; +} +#undef ALEN diff --git a/lib/nr/k_and_r/recipes/reverse.c b/lib/nr/k_and_r/recipes/reverse.c new file mode 100644 index 0000000..5d9ef66 --- /dev/null +++ b/lib/nr/k_and_r/recipes/reverse.c @@ -0,0 +1,15 @@ + +void reverse(iorder,ncity,n) +int iorder[],n[],ncity; +{ + int nn,j,k,l,itmp; + + nn=(1+((n[2]-n[1]+ncity) % ncity))/2; + for (j=1;j<=nn;j++) { + k=1 + ((n[1]+j-2) % ncity); + l=1 + ((n[2]-j+ncity) % ncity); + itmp=iorder[k]; + iorder[k]=iorder[l]; + iorder[l]=itmp; + } +} diff --git a/lib/nr/k_and_r/recipes/rf.c b/lib/nr/k_and_r/recipes/rf.c new file mode 100644 index 0000000..90f78d6 --- /dev/null +++ b/lib/nr/k_and_r/recipes/rf.c @@ -0,0 +1,48 @@ + +#include +#include "nrutil.h" +#define ERRTOL 0.08 +#define TINY 1.5e-38 +#define BIG 3.0e37 +#define THIRD (1.0/3.0) +#define C1 (1.0/24.0) +#define C2 0.1 +#define C3 (3.0/44.0) +#define C4 (1.0/14.0) + +float rf(x,y,z) +float x,y,z; +{ + float alamb,ave,delx,dely,delz,e2,e3,sqrtx,sqrty,sqrtz,xt,yt,zt; + + if (FMIN(FMIN(x,y),z) < 0.0 || FMIN(FMIN(x+y,x+z),y+z) < TINY || + FMAX(FMAX(x,y),z) > BIG) + nrerror("invalid arguments in rf"); + xt=x; + yt=y; + zt=z; + do { + sqrtx=sqrt(xt); + sqrty=sqrt(yt); + sqrtz=sqrt(zt); + alamb=sqrtx*(sqrty+sqrtz)+sqrty*sqrtz; + xt=0.25*(xt+alamb); + yt=0.25*(yt+alamb); + zt=0.25*(zt+alamb); + ave=THIRD*(xt+yt+zt); + delx=(ave-xt)/ave; + dely=(ave-yt)/ave; + delz=(ave-zt)/ave; + } while (FMAX(FMAX(fabs(delx),fabs(dely)),fabs(delz)) > ERRTOL); + e2=delx*dely-delz*delz; + e3=delx*dely*delz; + return (1.0+(C1*e2-C2-C3*e3)*e2+C4*e3)/sqrt(ave); +} +#undef ERRTOL +#undef TINY +#undef BIG +#undef THIRD +#undef C1 +#undef C2 +#undef C3 +#undef C4 diff --git a/lib/nr/k_and_r/recipes/rj.c b/lib/nr/k_and_r/recipes/rj.c new file mode 100644 index 0000000..117bf47 --- /dev/null +++ b/lib/nr/k_and_r/recipes/rj.c @@ -0,0 +1,84 @@ + +#include +#include "nrutil.h" +#define ERRTOL 0.05 +#define TINY 2.5e-13 +#define BIG 9.0e11 +#define C1 (3.0/14.0) +#define C2 (1.0/3.0) +#define C3 (3.0/22.0) +#define C4 (3.0/26.0) +#define C5 (0.75*C3) +#define C6 (1.5*C4) +#define C7 (0.5*C2) +#define C8 (C3+C3) + +float rj(x,y,z,p) +float p,x,y,z; +{ + float rc(),rf(); + float a,alamb,alpha,ans,ave,b,beta,delp,delx,dely,delz,ea,eb,ec, + ed,ee,fac,pt,rcx,rho,sqrtx,sqrty,sqrtz,sum,tau,xt,yt,zt; + + if (FMIN(FMIN(x,y),z) < 0.0 || FMIN(FMIN(FMIN(x+y,x+z),y+z),fabs(p)) < TINY + || FMAX(FMAX(FMAX(x,y),z),fabs(p)) > BIG) + nrerror("invalid arguments in rj"); + sum=0.0; + fac=1.0; + if (p > 0.0) { + xt=x; + yt=y; + zt=z; + pt=p; + } else { + xt=FMIN(FMIN(x,y),z); + zt=FMAX(FMAX(x,y),z); + yt=x+y+z-xt-zt; + a=1.0/(yt-p); + b=a*(zt-yt)*(yt-xt); + pt=yt+b; + rho=xt*zt/yt; + tau=p*pt/yt; + rcx=rc(rho,tau); + } + do { + sqrtx=sqrt(xt); + sqrty=sqrt(yt); + sqrtz=sqrt(zt); + alamb=sqrtx*(sqrty+sqrtz)+sqrty*sqrtz; + alpha=SQR(pt*(sqrtx+sqrty+sqrtz)+sqrtx*sqrty*sqrtz); + beta=pt*SQR(pt+alamb); + sum += fac*rc(alpha,beta); + fac=0.25*fac; + xt=0.25*(xt+alamb); + yt=0.25*(yt+alamb); + zt=0.25*(zt+alamb); + pt=0.25*(pt+alamb); + ave=0.2*(xt+yt+zt+pt+pt); + delx=(ave-xt)/ave; + dely=(ave-yt)/ave; + delz=(ave-zt)/ave; + delp=(ave-pt)/ave; + } while (FMAX(FMAX(FMAX(fabs(delx),fabs(dely)), + fabs(delz)),fabs(delp)) > ERRTOL); + ea=delx*(dely+delz)+dely*delz; + eb=delx*dely*delz; + ec=delp*delp; + ed=ea-3.0*ec; + ee=eb+2.0*delp*(ea-ec); + ans=3.0*sum+fac*(1.0+ed*(-C1+C5*ed-C6*ee)+eb*(C7+delp*(-C8+delp*C4)) + +delp*ea*(C2-delp*C3)-C2*delp*ec)/(ave*sqrt(ave)); + if (p <= 0.0) ans=a*(b*ans+3.0*(rcx-rf(xt,yt,zt))); + return ans; +} +#undef ERRTOL +#undef TINY +#undef BIG +#undef C1 +#undef C2 +#undef C3 +#undef C4 +#undef C5 +#undef C6 +#undef C7 +#undef C8 diff --git a/lib/nr/k_and_r/recipes/rk4.c b/lib/nr/k_and_r/recipes/rk4.c new file mode 100644 index 0000000..0509d7b --- /dev/null +++ b/lib/nr/k_and_r/recipes/rk4.c @@ -0,0 +1,32 @@ + +#include "nrutil.h" + +void rk4(y,dydx,n,x,h,yout,derivs) +float dydx[],h,x,y[],yout[]; +int n; +void (*derivs)(); +{ + int i; + float xh,hh,h6,*dym,*dyt,*yt; + + dym=vector(1,n); + dyt=vector(1,n); + yt=vector(1,n); + hh=h*0.5; + h6=h/6.0; + xh=x+hh; + for (i=1;i<=n;i++) yt[i]=y[i]+hh*dydx[i]; + (*derivs)(xh,yt,dyt); + for (i=1;i<=n;i++) yt[i]=y[i]+hh*dyt[i]; + (*derivs)(xh,yt,dym); + for (i=1;i<=n;i++) { + yt[i]=y[i]+h*dym[i]; + dym[i] += dyt[i]; + } + (*derivs)(x+h,yt,dyt); + for (i=1;i<=n;i++) + yout[i]=y[i]+h6*(dydx[i]+dyt[i]+2.0*dym[i]); + free_vector(yt,1,n); + free_vector(dyt,1,n); + free_vector(dym,1,n); +} diff --git a/lib/nr/k_and_r/recipes/rkck.c b/lib/nr/k_and_r/recipes/rkck.c new file mode 100644 index 0000000..894e17c --- /dev/null +++ b/lib/nr/k_and_r/recipes/rkck.c @@ -0,0 +1,52 @@ + +#include "nrutil.h" + +void rkck(y,dydx,n,x,h,yout,yerr,derivs) +float dydx[],h,x,y[],yerr[],yout[]; +int n; +void (*derivs)(); +{ + int i; + static float a2=0.2,a3=0.3,a4=0.6,a5=1.0,a6=0.875,b21=0.2, + b31=3.0/40.0,b32=9.0/40.0,b41=0.3,b42 = -0.9,b43=1.2, + b51 = -11.0/54.0, b52=2.5,b53 = -70.0/27.0,b54=35.0/27.0, + b61=1631.0/55296.0,b62=175.0/512.0,b63=575.0/13824.0, + b64=44275.0/110592.0,b65=253.0/4096.0,c1=37.0/378.0, + c3=250.0/621.0,c4=125.0/594.0,c6=512.0/1771.0, + dc5 = -277.00/14336.0; + float dc1=c1-2825.0/27648.0,dc3=c3-18575.0/48384.0, + dc4=c4-13525.0/55296.0,dc6=c6-0.25; + float *ak2,*ak3,*ak4,*ak5,*ak6,*ytemp; + + ak2=vector(1,n); + ak3=vector(1,n); + ak4=vector(1,n); + ak5=vector(1,n); + ak6=vector(1,n); + ytemp=vector(1,n); + for (i=1;i<=n;i++) + ytemp[i]=y[i]+b21*h*dydx[i]; + (*derivs)(x+a2*h,ytemp,ak2); + for (i=1;i<=n;i++) + ytemp[i]=y[i]+h*(b31*dydx[i]+b32*ak2[i]); + (*derivs)(x+a3*h,ytemp,ak3); + for (i=1;i<=n;i++) + ytemp[i]=y[i]+h*(b41*dydx[i]+b42*ak2[i]+b43*ak3[i]); + (*derivs)(x+a4*h,ytemp,ak4); + for (i=1;i<=n;i++) + ytemp[i]=y[i]+h*(b51*dydx[i]+b52*ak2[i]+b53*ak3[i]+b54*ak4[i]); + (*derivs)(x+a5*h,ytemp,ak5); + for (i=1;i<=n;i++) + ytemp[i]=y[i]+h*(b61*dydx[i]+b62*ak2[i]+b63*ak3[i]+b64*ak4[i]+b65*ak5[i]); + (*derivs)(x+a6*h,ytemp,ak6); + for (i=1;i<=n;i++) + yout[i]=y[i]+h*(c1*dydx[i]+c3*ak3[i]+c4*ak4[i]+c6*ak6[i]); + for (i=1;i<=n;i++) + yerr[i]=h*(dc1*dydx[i]+dc3*ak3[i]+dc4*ak4[i]+dc5*ak5[i]+dc6*ak6[i]); + free_vector(ytemp,1,n); + free_vector(ak6,1,n); + free_vector(ak5,1,n); + free_vector(ak4,1,n); + free_vector(ak3,1,n); + free_vector(ak2,1,n); +} diff --git a/lib/nr/k_and_r/recipes/rkdumb.c b/lib/nr/k_and_r/recipes/rkdumb.c new file mode 100644 index 0000000..f350c6d --- /dev/null +++ b/lib/nr/k_and_r/recipes/rkdumb.c @@ -0,0 +1,40 @@ + +#include "nrutil.h" + +float **y,*xx; + +void rkdumb(vstart,nvar,x1,x2,nstep,derivs) +float vstart[],x1,x2; +int nstep,nvar; +void (*derivs)(); +{ + void rk4(); + int i,k; + float x,h; + float *v,*vout,*dv; + + v=vector(1,nvar); + vout=vector(1,nvar); + dv=vector(1,nvar); + for (i=1;i<=nvar;i++) { + v[i]=vstart[i]; + y[i][1]=v[i]; + } + xx[1]=x1; + x=x1; + h=(x2-x1)/nstep; + for (k=1;k<=nstep;k++) { + (*derivs)(x,v,dv); + rk4(v,dv,nvar,x,h,vout,derivs); + if ((float)(x+h) == x) nrerror("Step size too small in routine rkdumb"); + x += h; + xx[k+1]=x; + for (i=1;i<=nvar;i++) { + v[i]=vout[i]; + y[i][k+1]=v[i]; + } + } + free_vector(dv,1,nvar); + free_vector(vout,1,nvar); + free_vector(v,1,nvar); +} diff --git a/lib/nr/k_and_r/recipes/rkqs.c b/lib/nr/k_and_r/recipes/rkqs.c new file mode 100644 index 0000000..322a53c --- /dev/null +++ b/lib/nr/k_and_r/recipes/rkqs.c @@ -0,0 +1,42 @@ + +#include +#include "nrutil.h" +#define SAFETY 0.9 +#define PGROW -0.2 +#define PSHRNK -0.25 +#define ERRCON 1.89e-4 + +void rkqs(y,dydx,n,x,htry,eps,yscal,hdid,hnext,derivs) +float *hdid,*hnext,*x,dydx[],eps,htry,y[],yscal[]; +int n; +void (*derivs)(); +{ + void rkck(); + int i; + float errmax,h,htemp,xnew,*yerr,*ytemp; + + yerr=vector(1,n); + ytemp=vector(1,n); + h=htry; + for (;;) { + rkck(y,dydx,n,*x,h,ytemp,yerr,derivs); + errmax=0.0; + for (i=1;i<=n;i++) errmax=FMAX(errmax,fabs(yerr[i]/yscal[i])); + errmax /= eps; + if (errmax <= 1.0) break; + htemp=SAFETY*h*pow(errmax,PSHRNK); + h=(h >= 0.0 ? FMAX(htemp,0.1*h) : FMIN(htemp,0.1*h)); + xnew=(*x)+h; + if (xnew == *x) nrerror("stepsize underflow in rkqs"); + } + if (errmax > ERRCON) *hnext=SAFETY*h*pow(errmax,PGROW); + else *hnext=5.0*h; + *x += (*hdid=h); + for (i=1;i<=n;i++) y[i]=ytemp[i]; + free_vector(ytemp,1,n); + free_vector(yerr,1,n); +} +#undef SAFETY +#undef PGROW +#undef PSHRNK +#undef ERRCON diff --git a/lib/nr/k_and_r/recipes/rlft3.c b/lib/nr/k_and_r/recipes/rlft3.c new file mode 100644 index 0000000..7085346 --- /dev/null +++ b/lib/nr/k_and_r/recipes/rlft3.c @@ -0,0 +1,69 @@ + +#include + +void rlft3(data,speq,nn1,nn2,nn3,isign) +float ***data,**speq; +int isign; +unsigned long nn1,nn2,nn3; +{ + void fourn(); + void nrerror(); + unsigned long i1,i2,i3,j1,j2,j3,nn[4],ii3; + double theta,wi,wpi,wpr,wr,wtemp; + float c1,c2,h1r,h1i,h2r,h2i; + + if (1+&data[nn1][nn2][nn3]-&data[1][1][1] != nn1*nn2*nn3) + nrerror("rlft3: problem with dimensions or contiguity of data array\n"); + c1=0.5; + c2 = -0.5*isign; + theta=isign*(6.28318530717959/nn3); + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + nn[1]=nn1; + nn[2]=nn2; + nn[3]=nn3 >> 1; + if (isign == 1) { + fourn(&data[1][1][1]-1,nn,3,isign); + for (i1=1;i1<=nn1;i1++) + for (i2=1,j2=0;i2<=nn2;i2++) { + speq[i1][++j2]=data[i1][i2][1]; + speq[i1][++j2]=data[i1][i2][2]; + } + } + for (i1=1;i1<=nn1;i1++) { + j1=(i1 != 1 ? nn1-i1+2 : 1); + wr=1.0; + wi=0.0; + for (ii3=1,i3=1;i3<=(nn3>>2)+1;i3++,ii3+=2) { + for (i2=1;i2<=nn2;i2++) { + if (i3 == 1) { + j2=(i2 != 1 ? ((nn2-i2)<<1)+3 : 1); + h1r=c1*(data[i1][i2][1]+speq[j1][j2]); + h1i=c1*(data[i1][i2][2]-speq[j1][j2+1]); + h2i=c2*(data[i1][i2][1]-speq[j1][j2]); + h2r= -c2*(data[i1][i2][2]+speq[j1][j2+1]); + data[i1][i2][1]=h1r+h2r; + data[i1][i2][2]=h1i+h2i; + speq[j1][j2]=h1r-h2r; + speq[j1][j2+1]=h2i-h1i; + } else { + j2=(i2 != 1 ? nn2-i2+2 : 1); + j3=nn3+3-(i3<<1); + h1r=c1*(data[i1][i2][ii3]+data[j1][j2][j3]); + h1i=c1*(data[i1][i2][ii3+1]-data[j1][j2][j3+1]); + h2i=c2*(data[i1][i2][ii3]-data[j1][j2][j3]); + h2r= -c2*(data[i1][i2][ii3+1]+data[j1][j2][j3+1]); + data[i1][i2][ii3]=h1r+wr*h2r-wi*h2i; + data[i1][i2][ii3+1]=h1i+wr*h2i+wi*h2r; + data[j1][j2][j3]=h1r-wr*h2r+wi*h2i; + data[j1][j2][j3+1]= -h1i+wr*h2i+wi*h2r; + } + } + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + } + } + if (isign == -1) + fourn(&data[1][1][1]-1,nn,3,isign); +} diff --git a/lib/nr/k_and_r/recipes/rlftfrag.c b/lib/nr/k_and_r/recipes/rlftfrag.c new file mode 100644 index 0000000..8cda66a --- /dev/null +++ b/lib/nr/k_and_r/recipes/rlftfrag.c @@ -0,0 +1,86 @@ + +#include "nrutil.h" +#define N2 256 +#define N3 256 + +main() /* example1 */ +{ + void rlft3(); + float ***data, **speq; + + data=f3tensor(1,1,1,N2,1,N3); + speq=matrix(1,1,1,2*N2); + rlft3(data,speq,1,N2,N3,1); + rlft3(data,speq,1,N2,N3,-1); + free_matrix(speq,1,1,1,2*N2); + free_f3tensor(data,1,1,1,N2,1,N3); + return 0; +} +#undef N3 +#undef N2 + +#define N1 32 +#define N2 64 +#define N3 16 + +main() /* example2 */ +{ + void rlft3(); + int j; + float ***data,**speq; + + data=f3tensor(1,N1,1,N2,1,N3); + speq=matrix(1,N1,1,2*N2); + rlft3(data,speq,N1,N2,N3,1); + free_matrix(speq,1,N1,1,2*N2); + free_f3tensor(data,1,N1,1,N2,1,N3); + return 0; +} +#undef N1 +#undef N2 +#undef N3 + +#define N 32 + +main() /* example3 */ +{ + void rlft3(); + int j; + float fac,r,i,***data1,***data2,**speq1,**speq2,*sp1,*sp2; + + data1=f3tensor(1,N,1,N,1,N); + data2=f3tensor(1,N,1,N,1,N); + speq1=matrix(1,N,1,2*N); + speq2=matrix(1,N,1,2*N); + + rlft3(data1,speq1,N,N,N,1); + rlft3(data2,speq2,N,N,N,1); + fac=2.0/(N*N*N); + sp1 = &data1[1][1][1]; + sp2 = &data2[1][1][1]; + for (j=1;j<=N*N*N/2;j++) { + r = sp1[0]*sp2[0] - sp1[1]*sp2[1]; + i = sp1[0]*sp2[1] + sp1[1]*sp2[0]; + sp1[0] = fac*r; + sp1[1] = fac*i; + sp1 += 2; + sp2 += 2; + } + sp1 = &speq1[1][1]; + sp2 = &speq2[1][1]; + for (j=1;j<=N*N;j++) { + r = sp1[0]*sp2[0] - sp1[1]*sp2[1]; + i = sp1[0]*sp2[1] + sp1[1]*sp2[0]; + sp1[0] = fac*r; + sp1[1] = fac*i; + sp1 += 2; + sp2 += 2; + } + rlft3(data1,speq1,N,N,N,-1); + free_matrix(speq2,1,N,1,2*N); + free_matrix(speq1,1,N,1,2*N); + free_f3tensor(data2,1,N,1,N,1,N); + free_f3tensor(data1,1,N,1,N,1,N); + return 0; +} +#undef N diff --git a/lib/nr/k_and_r/recipes/rofunc.c b/lib/nr/k_and_r/recipes/rofunc.c new file mode 100644 index 0000000..d63a99c --- /dev/null +++ b/lib/nr/k_and_r/recipes/rofunc.c @@ -0,0 +1,35 @@ + +#include +#include "nrutil.h" +#define EPS 1.0e-7 + +extern int ndatat; +extern float *xt,*yt,aa,abdevt; + +float rofunc(b) +float b; +{ + float select(); + int j; + float *arr,d,sum=0.0; + + arr=vector(1,ndatat); + for (j=1;j<=ndatat;j++) arr[j]=yt[j]-b*xt[j]; + if (ndatat & 1) { + aa=select((ndatat+1)>>1,ndatat,arr); + } + else { + j=ndatat >> 1; + aa=0.5*(select(j,ndatat,arr)+select(j+1,ndatat,arr)); + } + abdevt=0.0; + for (j=1;j<=ndatat;j++) { + d=yt[j]-(b*xt[j]+aa); + abdevt += fabs(d); + if (yt[j] != 0.0) d /= fabs(yt[j]); + if (fabs(d) > EPS) sum += (d >= 0.0 ? xt[j] : -xt[j]); + } + free_vector(arr,1,ndatat); + return sum; +} +#undef EPS diff --git a/lib/nr/k_and_r/recipes/rotate.c b/lib/nr/k_and_r/recipes/rotate.c new file mode 100644 index 0000000..94896e4 --- /dev/null +++ b/lib/nr/k_and_r/recipes/rotate.c @@ -0,0 +1,36 @@ + +#include +#include "nrutil.h" + +void rotate(r,qt,n,i,a,b) +float **qt,**r,a,b; +int i,n; +{ + int j; + float c,fact,s,w,y; + + if (a == 0.0) { + c=0.0; + s=(b >= 0.0 ? 1.0 : -1.0); + } else if (fabs(a) > fabs(b)) { + fact=b/a; + c=SIGN(1.0/sqrt(1.0+(fact*fact)),a); + s=fact*c; + } else { + fact=a/b; + s=SIGN(1.0/sqrt(1.0+(fact*fact)),b); + c=fact*s; + } + for (j=i;j<=n;j++) { + y=r[i][j]; + w=r[i+1][j]; + r[i][j]=c*y-s*w; + r[i+1][j]=s*y+c*w; + } + for (j=1;j<=n;j++) { + y=qt[i][j]; + w=qt[i+1][j]; + qt[i][j]=c*y-s*w; + qt[i+1][j]=s*y+c*w; + } +} diff --git a/lib/nr/k_and_r/recipes/rsolv.c b/lib/nr/k_and_r/recipes/rsolv.c new file mode 100644 index 0000000..b0e1985 --- /dev/null +++ b/lib/nr/k_and_r/recipes/rsolv.c @@ -0,0 +1,14 @@ + +void rsolv(a,n,d,b) +float **a,b[],d[]; +int n; +{ + int i,j; + float sum; + + b[n] /= d[n]; + for (i=n-1;i>=1;i--) { + for (sum=0.0,j=i+1;j<=n;j++) sum += a[i][j]*b[j]; + b[i]=(b[i]-sum)/d[i]; + } +} diff --git a/lib/nr/k_and_r/recipes/rstrct.c b/lib/nr/k_and_r/recipes/rstrct.c new file mode 100644 index 0000000..68e7566 --- /dev/null +++ b/lib/nr/k_and_r/recipes/rstrct.c @@ -0,0 +1,22 @@ + +void rstrct(uc,uf,nc) +double **uc,**uf; +int nc; +{ + int ic,iif,jc,jf,ncc=2*nc-1; + + for (jf=3,jc=2;jc +#define JMAX 40 + +float rtbis(func,x1,x2,xacc) +float (*func)(),x1,x2,xacc; +{ + void nrerror(); + int j; + float dx,f,fmid,xmid,rtb; + + f=(*func)(x1); + fmid=(*func)(x2); + if (f*fmid >= 0.0) nrerror("Root must be bracketed for bisection in rtbis"); + rtb = f < 0.0 ? (dx=x2-x1,x1) : (dx=x1-x2,x2); + for (j=1;j<=JMAX;j++) { + fmid=(*func)(xmid=rtb+(dx *= 0.5)); + if (fmid <= 0.0) rtb=xmid; + if (fabs(dx) < xacc || fmid == 0.0) return rtb; + } + nrerror("Too many bisections in rtbis"); + return 0.0; +} +#undef JMAX diff --git a/lib/nr/k_and_r/recipes/rtflsp.c b/lib/nr/k_and_r/recipes/rtflsp.c new file mode 100644 index 0000000..8e0a74a --- /dev/null +++ b/lib/nr/k_and_r/recipes/rtflsp.c @@ -0,0 +1,44 @@ + +#include +#define MAXIT 30 + +float rtflsp(func,x1,x2,xacc) +float (*func)(),x1,x2,xacc; +{ + void nrerror(); + int j; + float fl,fh,xl,xh,swap,dx,del,f,rtf; + + fl=(*func)(x1); + fh=(*func)(x2); + if (fl*fh > 0.0) nrerror("Root must be bracketed in rtflsp"); + if (fl < 0.0) { + xl=x1; + xh=x2; + } else { + xl=x2; + xh=x1; + swap=fl; + fl=fh; + fh=swap; + } + dx=xh-xl; + for (j=1;j<=MAXIT;j++) { + rtf=xl+dx*fl/(fl-fh); + f=(*func)(rtf); + if (f < 0.0) { + del=xl-rtf; + xl=rtf; + fl=f; + } else { + del=xh-rtf; + xh=rtf; + fh=f; + } + dx=xh-xl; + if (fabs(del) < xacc || f == 0.0) return rtf; + } + nrerror("Maximum number of iterations exceeded in rtflsp"); + return 0.0; +} +#undef MAXIT diff --git a/lib/nr/k_and_r/recipes/rtnewt.c b/lib/nr/k_and_r/recipes/rtnewt.c new file mode 100644 index 0000000..88c661a --- /dev/null +++ b/lib/nr/k_and_r/recipes/rtnewt.c @@ -0,0 +1,25 @@ + +#include +#define JMAX 20 + +float rtnewt(funcd,x1,x2,xacc) +float x1,x2,xacc; +void (*funcd)(); +{ + void nrerror(); + int j; + float df,dx,f,rtn; + + rtn=0.5*(x1+x2); + for (j=1;j<=JMAX;j++) { + (*funcd)(rtn,&f,&df); + dx=f/df; + rtn -= dx; + if ((x1-rtn)*(rtn-x2) < 0.0) + nrerror("Jumped out of brackets in rtnewt"); + if (fabs(dx) < xacc) return rtn; + } + nrerror("Maximum number of iterations exceeded in rtnewt"); + return 0.0; +} +#undef JMAX diff --git a/lib/nr/k_and_r/recipes/rtsafe.c b/lib/nr/k_and_r/recipes/rtsafe.c new file mode 100644 index 0000000..a9452d6 --- /dev/null +++ b/lib/nr/k_and_r/recipes/rtsafe.c @@ -0,0 +1,55 @@ + +#include +#define MAXIT 100 + +float rtsafe(funcd,x1,x2,xacc) +float x1,x2,xacc; +void (*funcd)(); +{ + void nrerror(); + int j; + float df,dx,dxold,f,fh,fl; + float temp,xh,xl,rts; + + (*funcd)(x1,&fl,&df); + (*funcd)(x2,&fh,&df); + if ((fl > 0.0 && fh > 0.0) || (fl < 0.0 && fh < 0.0)) + nrerror("Root must be bracketed in rtsafe"); + if (fl == 0.0) return x1; + if (fh == 0.0) return x2; + if (fl < 0.0) { + xl=x1; + xh=x2; + } else { + xh=x1; + xl=x2; + } + rts=0.5*(x1+x2); + dxold=fabs(x2-x1); + dx=dxold; + (*funcd)(rts,&f,&df); + for (j=1;j<=MAXIT;j++) { + if ((((rts-xh)*df-f)*((rts-xl)*df-f) > 0.0) + || (fabs(2.0*f) > fabs(dxold*df))) { + dxold=dx; + dx=0.5*(xh-xl); + rts=xl+dx; + if (xl == rts) return rts; + } else { + dxold=dx; + dx=f/df; + temp=rts; + rts -= dx; + if (temp == rts) return rts; + } + if (fabs(dx) < xacc) return rts; + (*funcd)(rts,&f,&df); + if (f < 0.0) + xl=rts; + else + xh=rts; + } + nrerror("Maximum number of iterations exceeded in rtsafe"); + return 0.0; +} +#undef MAXIT diff --git a/lib/nr/k_and_r/recipes/rtsec.c b/lib/nr/k_and_r/recipes/rtsec.c new file mode 100644 index 0000000..5174bfe --- /dev/null +++ b/lib/nr/k_and_r/recipes/rtsec.c @@ -0,0 +1,35 @@ + +#include +#define MAXIT 30 + +float rtsec(func,x1,x2,xacc) +float (*func)(),x1,x2,xacc; +{ + void nrerror(); + int j; + float fl,f,dx,swap,xl,rts; + + fl=(*func)(x1); + f=(*func)(x2); + if (fabs(fl) < fabs(f)) { + rts=x1; + xl=x2; + swap=fl; + fl=f; + f=swap; + } else { + xl=x1; + rts=x2; + } + for (j=1;j<=MAXIT;j++) { + dx=(xl-rts)*f/(f-fl); + xl=rts; + fl=f; + rts += dx; + f=(*func)(rts); + if (fabs(dx) < xacc || f == 0.0) return rts; + } + nrerror("Maximum number of iterations exceeded in rtsec"); + return 0.0; +} +#undef MAXIT diff --git a/lib/nr/k_and_r/recipes/rzextr.c b/lib/nr/k_and_r/recipes/rzextr.c new file mode 100644 index 0000000..a220698 --- /dev/null +++ b/lib/nr/k_and_r/recipes/rzextr.c @@ -0,0 +1,45 @@ + +#include "nrutil.h" + +extern float **d,*x; + +void rzextr(iest,xest,yest,yz,dy,nv) +float dy[],xest,yest[],yz[]; +int iest,nv; +{ + int k,j; + float yy,v,ddy,c,b1,b,*fx; + + fx=vector(1,iest); + x[iest]=xest; + if (iest == 1) + for (j=1;j<=nv;j++) { + yz[j]=yest[j]; + d[j][1]=yest[j]; + dy[j]=yest[j]; + } + else { + for (k=1;k +#include "nrutil.h" + +void savgol(c,np,nl,nr,ld,m) +float c[]; +int ld,m,nl,np,nr; +{ + void lubksb(),ludcmp(); + int imj,ipj,j,k,kk,mm,*indx; + float d,fac,sum,**a,*b; + + if (np < nl+nr+1 || nl < 0 || nr < 0 || ld > m || nl+nr < m) + nrerror("bad args in savgol"); + indx=ivector(1,m+1); + a=matrix(1,m+1,1,m+1); + b=vector(1,m+1); + for (ipj=0;ipj<=(m << 1);ipj++) { + sum=(ipj ? 0.0 : 1.0); + for (k=1;k<=nr;k++) sum += pow((double)k,(double)ipj); + for (k=1;k<=nl;k++) sum += pow((double)-k,(double)ipj); + mm=IMIN(ipj,2*m-ipj); + for (imj = -mm;imj<=mm;imj+=2) a[1+(ipj+imj)/2][1+(ipj-imj)/2]=sum; + } + ludcmp(a,m+1,indx,&d); + for (j=1;j<=m+1;j++) b[j]=0.0; + b[ld+1]=1.0; + lubksb(a,m+1,indx,b); + for (kk=1;kk<=np;kk++) c[kk]=0.0; + for (k = -nl;k<=nr;k++) { + sum=b[1]; + fac=1.0; + for (mm=1;mm<=m;mm++) sum += b[mm+1]*(fac *= k); + kk=((np-k) % np)+1; + c[kk]=sum; + } + free_vector(b,1,m+1); + free_matrix(a,1,m+1,1,m+1); + free_ivector(indx,1,m+1); +} diff --git a/lib/nr/k_and_r/recipes/scrsho.c b/lib/nr/k_and_r/recipes/scrsho.c new file mode 100644 index 0000000..e097b56 --- /dev/null +++ b/lib/nr/k_and_r/recipes/scrsho.c @@ -0,0 +1,66 @@ + +#include +#define ISCR 60 +#define JSCR 21 +#define BLANK ' ' +#define ZERO '-' +#define YY 'l' +#define XX '-' +#define FF 'x' + +void scrsho(fx) +float (*fx)(); +{ + int jz,j,i; + float ysml,ybig,x2,x1,x,dyj,dx,y[ISCR+1]; + char scr[ISCR+1][JSCR+1]; + + for (;;) { + printf("\nEnter x1 x2 (x1=x2 to stop):\n"); + scanf("%f %f",&x1,&x2); + if (x1 == x2) break; + for (j=1;j<=JSCR;j++) + scr[1][j]=scr[ISCR][j]=YY; + for (i=2;i<=(ISCR-1);i++) { + scr[i][1]=scr[i][JSCR]=XX; + for (j=2;j<=(JSCR-1);j++) + scr[i][j]=BLANK; + } + dx=(x2-x1)/(ISCR-1); + x=x1; + ysml=ybig=0.0; + for (i=1;i<=ISCR;i++) { + y[i]=(*fx)(x); + if (y[i] < ysml) ysml=y[i]; + if (y[i] > ybig) ybig=y[i]; + x += dx; + } + if (ybig == ysml) ybig=ysml+1.0; + dyj=(JSCR-1)/(ybig-ysml); + jz=1-(int) (ysml*dyj); + for (i=1;i<=ISCR;i++) { + scr[i][jz]=ZERO; + j=1+(int) ((y[i]-ysml)*dyj); + scr[i][j]=FF; + } + printf(" %10.3f ",ybig); + for (i=1;i<=ISCR;i++) printf("%c",scr[i][JSCR]); + printf("\n"); + for (j=(JSCR-1);j>=2;j--) { + printf("%12s"," "); + for (i=1;i<=ISCR;i++) printf("%c",scr[i][j]); + printf("\n"); + } + printf(" %10.3f ",ysml); + for (i=1;i<=ISCR;i++) printf("%c",scr[i][1]); + printf("\n"); + printf("%8s %10.3f %44s %10.3f\n"," ",x1," ",x2); + } +} +#undef ISCR +#undef JSCR +#undef BLANK +#undef ZERO +#undef YY +#undef XX +#undef FF diff --git a/lib/nr/k_and_r/recipes/select.c b/lib/nr/k_and_r/recipes/select.c new file mode 100644 index 0000000..cf02ac5 --- /dev/null +++ b/lib/nr/k_and_r/recipes/select.c @@ -0,0 +1,47 @@ + +#define SWAP(a,b) temp=(a);(a)=(b);(b)=temp; + +float select(k,n,arr) +float arr[]; +unsigned long k,n; +{ + unsigned long i,ir,j,l,mid; + float a,temp; + + l=1; + ir=n; + for (;;) { + if (ir <= l+1) { + if (ir == l+1 && arr[ir] < arr[l]) { + SWAP(arr[l],arr[ir]) + } + return arr[k]; + } else { + mid=(l+ir) >> 1; + SWAP(arr[mid],arr[l+1]) + if (arr[l] > arr[ir]) { + SWAP(arr[l],arr[ir]) + } + if (arr[l+1] > arr[ir]) { + SWAP(arr[l+1],arr[ir]) + } + if (arr[l] > arr[l+1]) { + SWAP(arr[l],arr[l+1]) + } + i=l+1; + j=ir; + a=arr[l+1]; + for (;;) { + do i++; while (arr[i] < a); + do j--; while (arr[j] > a); + if (j < i) break; + SWAP(arr[i],arr[j]) + } + arr[l+1]=arr[j]; + arr[j]=a; + if (j >= k) ir=j-1; + if (j <= k) l=i; + } + } +} +#undef SWAP diff --git a/lib/nr/k_and_r/recipes/selip.c b/lib/nr/k_and_r/recipes/selip.c new file mode 100644 index 0000000..c676a61 --- /dev/null +++ b/lib/nr/k_and_r/recipes/selip.c @@ -0,0 +1,73 @@ + +#include "nrutil.h" +#define M 64 +#define BIG 1.0e30 +#define FREEALL free_vector(sel,1,M+2);free_lvector(isel,1,M+2); + +float selip(k,n,arr) +float arr[]; +unsigned long k,n; +{ + void shell(); + unsigned long i,j,jl,jm,ju,kk,mm,nlo,nxtmm,*isel; + float ahi,alo,sum,*sel; + + if (k < 1 || k > n || n <= 0) nrerror("bad input to selip"); + isel=lvector(1,M+2); + sel=vector(1,M+2); + kk=k; + ahi=BIG; + alo = -BIG; + for (;;) { + mm=nlo=0; + sum=0.0; + nxtmm=M+1; + for (i=1;i<=n;i++) { + if (arr[i] >= alo && arr[i] <= ahi) { + mm++; + if (arr[i] == alo) nlo++; + if (mm <= M) sel[mm]=arr[i]; + else if (mm == nxtmm) { + nxtmm=mm+mm/M; + sel[1 + ((i+mm+kk) % M)]=arr[i]; + } + sum += arr[i]; + } + } + if (kk <= nlo) { + FREEALL + return alo; + } + else if (mm <= M) { + shell(mm,sel); + ahi = sel[kk]; + FREEALL + return ahi; + } + sel[M+1]=sum/mm; + shell(M+1,sel); + sel[M+2]=ahi; + for (j=1;j<=M+2;j++) isel[j]=0; + for (i=1;i<=n;i++) { + if (arr[i] >= alo && arr[i] <= ahi) { + jl=0; + ju=M+2; + while (ju-jl > 1) { + jm=(ju+jl)/2; + if (arr[i] >= sel[jm]) jl=jm; + else ju=jm; + } + isel[ju]++; + } + } + j=1; + while (kk > isel[j]) { + alo=sel[j]; + kk -= isel[j++]; + } + ahi=sel[j]; + } +} +#undef M +#undef BIG +#undef FREEALL diff --git a/lib/nr/k_and_r/recipes/sfroid.c b/lib/nr/k_and_r/recipes/sfroid.c new file mode 100644 index 0000000..8597624 --- /dev/null +++ b/lib/nr/k_and_r/recipes/sfroid.c @@ -0,0 +1,81 @@ + +#include +#include +#include "nrutil.h" +#define NE 3 +#define M 41 +#define NB 1 +#define NSI NE +#define NYJ NE +#define NYK M +#define NCI NE +#define NCJ (NE-NB+1) +#define NCK (M+1) +#define NSJ (2*NE+1) + +int mm,n,mpt=M; +float h,c2=0.0,anorm,x[M+1]; + +main() /* Program sfroid */ +{ + float plgndr(); + void solvde(); + int i,itmax,k,indexv[NE+1]; + float conv,deriv,fac1,fac2,q1,slowc,scalv[NE+1]; + float **y,**s,***c; + + y=matrix(1,NYJ,1,NYK); + s=matrix(1,NSI,1,NSJ); + c=f3tensor(1,NCI,1,NCJ,1,NCK); + itmax=100; + conv=5.0e-6; + slowc=1.0; + h=1.0/(M-1); + printf("\nenter m n\n"); + scanf("%d %d",&mm,&n); + if (n+mm & 1) { + indexv[1]=1; + indexv[2]=2; + indexv[3]=3; + } else { + indexv[1]=2; + indexv[2]=1; + indexv[3]=3; + } + anorm=1.0; + if (mm) { + q1=n; + for (i=1;i<=mm;i++) anorm = -0.5*anorm*(n+i)*(q1--/i); + } + for (k=1;k<=(M-1);k++) { + x[k]=(k-1)*h; + fac1=1.0-x[k]*x[k]; + fac2=exp((-mm/2.0)*log(fac1)); + y[1][k]=plgndr(n,mm,x[k])*fac2; + deriv = -((n-mm+1)*plgndr(n+1,mm,x[k])- + (n+1)*x[k]*plgndr(n,mm,x[k]))/fac1; + y[2][k]=mm*x[k]*y[1][k]/fac1+deriv*fac2; + y[3][k]=n*(n+1)-mm*(mm+1); + } + x[M]=1.0; + y[1][M]=anorm; + y[3][M]=n*(n+1)-mm*(mm+1); + y[2][M]=(y[3][M]-c2)*y[1][M]/(2.0*(mm+1.0)); + scalv[1]=fabs(anorm); + scalv[2]=(y[2][M] > scalv[1] ? y[2][M] : scalv[1]); + scalv[3]=(y[3][M] > 1.0 ? y[3][M] : 1.0); + for (;;) { + printf("\nEnter c**2 or 999 to end.\n"); + scanf("%f",&c2); + if (c2 == 999) { + free_f3tensor(c,1,NCI,1,NCJ,1,NCK); + free_matrix(s,1,NSI,1,NSJ); + free_matrix(y,1,NYJ,1,NYK); + return 0; + } + solvde(itmax,conv,slowc,scalv,indexv,NE,NB,M,y,c,s); + printf("\n %s %2d %s %2d %s %7.3f %s %10.6f\n", + "m =",mm," n =",n," c**2 =",c2, + " lamda =",y[3][1]+mm*(mm+1)); + } +} diff --git a/lib/nr/k_and_r/recipes/shell.c b/lib/nr/k_and_r/recipes/shell.c new file mode 100644 index 0000000..279e5e6 --- /dev/null +++ b/lib/nr/k_and_r/recipes/shell.c @@ -0,0 +1,26 @@ + +void shell(n,a) +float a[]; +unsigned long n; +{ + unsigned long i,j,inc; + float v; + inc=1; + do { + inc *= 3; + inc++; + } while (inc <= n); + do { + inc /= 3; + for (i=inc+1;i<=n;i++) { + v=a[i]; + j=i; + while (a[j-inc] > v) { + a[j]=a[j-inc]; + j -= inc; + if (j <= inc) break; + } + a[j]=v; + } + } while (inc > 1); +} diff --git a/lib/nr/k_and_r/recipes/shoot.c b/lib/nr/k_and_r/recipes/shoot.c new file mode 100644 index 0000000..72c8045 --- /dev/null +++ b/lib/nr/k_and_r/recipes/shoot.c @@ -0,0 +1,27 @@ + +#include "nrutil.h" +#define EPS 1.0e-6 + +extern int nvar; +extern float x1,x2; + +int kmax,kount; +float *xp,**yp,dxsav; + +void shoot(n,v,f) +float f[],v[]; +int n; +{ + void derivs(),load(),odeint(),rkqs(),score(); + int nbad,nok; + float h1,hmin=0.0,*y; + + y=vector(1,nvar); + kmax=0; + h1=(x2-x1)/100.0; + load(x1,v,y); + odeint(y,nvar,x1,x2,EPS,h1,hmin,&nok,&nbad,derivs,rkqs); + score(x2,y,f); + free_vector(y,1,nvar); +} +#undef EPS diff --git a/lib/nr/k_and_r/recipes/shootf.c b/lib/nr/k_and_r/recipes/shootf.c new file mode 100644 index 0000000..2ca8081 --- /dev/null +++ b/lib/nr/k_and_r/recipes/shootf.c @@ -0,0 +1,35 @@ + +#include "nrutil.h" +#define EPS 1.0e-6 + +extern int nn2,nvar; +extern float x1,x2,xf; + +int kmax,kount; +float *xp,**yp,dxsav; + +void shootf(n,v,f) +float f[],v[]; +int n; +{ + void derivs(),load1(),load2(),odeint(),rkqs(),score(); + int i,nbad,nok; + float h1,hmin=0.0,*f1,*f2,*y; + + f1=vector(1,nvar); + f2=vector(1,nvar); + y=vector(1,nvar); + kmax=0; + h1=(x2-x1)/100.0; + load1(x1,v,y); + odeint(y,nvar,x1,xf,EPS,h1,hmin,&nok,&nbad,derivs,rkqs); + score(xf,y,f1); + load2(x2,&v[nn2],y); + odeint(y,nvar,x2,xf,EPS,h1,hmin,&nok,&nbad,derivs,rkqs); + score(xf,y,f2); + for (i=1;i<=n;i++) f[i]=f1[i]-f2[i]; + free_vector(y,1,nvar); + free_vector(f2,1,nvar); + free_vector(f1,1,nvar); +} +#undef EPS diff --git a/lib/nr/k_and_r/recipes/simp1.c b/lib/nr/k_and_r/recipes/simp1.c new file mode 100644 index 0000000..eb110d5 --- /dev/null +++ b/lib/nr/k_and_r/recipes/simp1.c @@ -0,0 +1,27 @@ + +#include + +void simp1(a,mm,ll,nll,iabf,kp,bmax) +float **a,*bmax; +int *kp,iabf,ll[],mm,nll; +{ + int k; + float test; + + if (nll <= 0) + *bmax=0.0; + else { + *kp=ll[1]; + *bmax=a[mm+1][*kp+1]; + for (k=2;k<=nll;k++) { + if (iabf == 0) + test=a[mm+1][ll[k]+1]-(*bmax); + else + test=fabs(a[mm+1][ll[k]+1])-fabs(*bmax); + if (test > 0.0) { + *bmax=a[mm+1][ll[k]+1]; + *kp=ll[k]; + } + } + } +} diff --git a/lib/nr/k_and_r/recipes/simp2.c b/lib/nr/k_and_r/recipes/simp2.c new file mode 100644 index 0000000..ca78808 --- /dev/null +++ b/lib/nr/k_and_r/recipes/simp2.c @@ -0,0 +1,34 @@ + +#define EPS 1.0e-6 + +void simp2(a,m,n,ip,kp) +float **a; +int *ip,kp,m,n; +{ + int k,i; + float qp,q0,q,q1; + + *ip=0; + for (i=1;i<=m;i++) + if (a[i+1][kp+1] < -EPS) break; + if (i>m) return; + q1 = -a[i+1][1]/a[i+1][kp+1]; + *ip=i; + for (i=*ip+1;i<=m;i++) { + if (a[i+1][kp+1] < -EPS) { + q = -a[i+1][1]/a[i+1][kp+1]; + if (q < q1) { + *ip=i; + q1=q; + } else if (q == q1) { + for (k=1;k<=n;k++) { + qp = -a[*ip+1][k+1]/a[*ip+1][kp+1]; + q0 = -a[i+1][k+1]/a[i+1][kp+1]; + if (q0 != qp) break; + } + if (q0 < qp) *ip=i; + } + } + } +} +#undef EPS diff --git a/lib/nr/k_and_r/recipes/simp3.c b/lib/nr/k_and_r/recipes/simp3.c new file mode 100644 index 0000000..6c41423 --- /dev/null +++ b/lib/nr/k_and_r/recipes/simp3.c @@ -0,0 +1,20 @@ + +void simp3(a,i1,k1,ip,kp) +float **a; +int i1,ip,k1,kp; +{ + int kk,ii; + float piv; + + piv=1.0/a[ip+1][kp+1]; + for (ii=1;ii<=i1+1;ii++) + if (ii-1 != ip) { + a[ii][kp+1] *= piv; + for (kk=1;kk<=k1+1;kk++) + if (kk-1 != kp) + a[ii][kk] -= a[ip+1][kk]*a[ii][kp+1]; + } + for (kk=1;kk<=k1+1;kk++) + if (kk-1 != kp) a[ip+1][kk] *= -piv; + a[ip+1][kp+1]=piv; +} diff --git a/lib/nr/k_and_r/recipes/simplx.c b/lib/nr/k_and_r/recipes/simplx.c new file mode 100644 index 0000000..c8a983e --- /dev/null +++ b/lib/nr/k_and_r/recipes/simplx.c @@ -0,0 +1,93 @@ + +#include "nrutil.h" +#define EPS 1.0e-6 +#define FREEALL free_ivector(l3,1,m);free_ivector(l1,1,n+1); + +void simplx(a,m,n,m1,m2,m3,icase,izrov,iposv) +float **a; +int *icase,iposv[],izrov[],m,m1,m2,m3,n; +{ + void simp1(),simp2(),simp3(); + int i,ip,is,k,kh,kp,nl1; + int *l1,*l3; + float q1,bmax; + + if (m != (m1+m2+m3)) nrerror("Bad input constraint counts in simplx"); + l1=ivector(1,n+1); + l3=ivector(1,m); + nl1=n; + for (k=1;k<=n;k++) l1[k]=izrov[k]=k; + for (i=1;i<=m;i++) { + if (a[i+1][1] < 0.0) nrerror("Bad input tableau in simplx"); + iposv[i]=n+i; + } + if (m2+m3) { + for (i=1;i<=m2;i++) l3[i]=1; + for (k=1;k<=(n+1);k++) { + q1=0.0; + for (i=m1+1;i<=m;i++) q1 += a[i+1][k]; + a[m+2][k] = -q1; + } + for (;;) { + simp1(a,m+1,l1,nl1,0,&kp,&bmax); + if (bmax <= EPS && a[m+2][1] < -EPS) { + *icase = -1; + FREEALL return; + } else if (bmax <= EPS && a[m+2][1] <= EPS) { + for (ip=m1+m2+1;ip<=m;ip++) { + if (iposv[ip] == (ip+n)) { + simp1(a,ip,l1,nl1,1,&kp,&bmax); + if (bmax > EPS) + goto one; + } + } + for (i=m1+1;i<=m1+m2;i++) + if (l3[i-m1] == 1) + for (k=1;k<=n+1;k++) + a[i+1][k] = -a[i+1][k]; + break; + } + simp2(a,m,n,&ip,kp); + if (ip == 0) { + *icase = -1; + FREEALL return; + } + one: simp3(a,m+1,n,ip,kp); + if (iposv[ip] >= (n+m1+m2+1)) { + for (k=1;k<=nl1;k++) + if (l1[k] == kp) break; + --nl1; + for (is=k;is<=nl1;is++) l1[is]=l1[is+1]; + } else { + kh=iposv[ip]-m1-n; + if (kh >= 1 && l3[kh]) { + l3[kh]=0; + ++a[m+2][kp+1]; + for (i=1;i<=m+2;i++) + a[i][kp+1] = -a[i][kp+1]; + } + } + is=izrov[kp]; + izrov[kp]=iposv[ip]; + iposv[ip]=is; + } + } + for (;;) { + simp1(a,0,l1,nl1,0,&kp,&bmax); + if (bmax <= EPS) { + *icase=0; + FREEALL return; + } + simp2(a,m,n,&ip,kp); + if (ip == 0) { + *icase=1; + FREEALL return; + } + simp3(a,m,n,ip,kp); + is=izrov[kp]; + izrov[kp]=iposv[ip]; + iposv[ip]=is; + } +} +#undef EPS +#undef FREEALL diff --git a/lib/nr/k_and_r/recipes/simpr.c b/lib/nr/k_and_r/recipes/simpr.c new file mode 100644 index 0000000..912f1ba --- /dev/null +++ b/lib/nr/k_and_r/recipes/simpr.c @@ -0,0 +1,48 @@ + +#include "nrutil.h" + +void simpr(y,dydx,dfdx,dfdy,n,xs,htot,nstep,yout,derivs) +float **dfdy,dfdx[],dydx[],htot,xs,y[],yout[]; +int n,nstep; +void (*derivs)(); +{ + void lubksb(),ludcmp(); + int i,j,nn,*indx; + float d,h,x,**a,*del,*ytemp; + + indx=ivector(1,n); + a=matrix(1,n,1,n); + del=vector(1,n); + ytemp=vector(1,n); + h=htot/nstep; + for (i=1;i<=n;i++) { + for (j=1;j<=n;j++) a[i][j] = -h*dfdy[i][j]; + ++a[i][i]; + } + ludcmp(a,n,indx,&d); + for (i=1;i<=n;i++) + yout[i]=h*(dydx[i]+h*dfdx[i]); + lubksb(a,n,indx,yout); + for (i=1;i<=n;i++) + ytemp[i]=y[i]+(del[i]=yout[i]); + x=xs+h; + (*derivs)(x,ytemp,yout); + for (nn=2;nn<=nstep;nn++) { + for (i=1;i<=n;i++) + yout[i]=h*yout[i]-del[i]; + lubksb(a,n,indx,yout); + for (i=1;i<=n;i++) + ytemp[i] += (del[i] += 2.0*yout[i]); + x += h; + (*derivs)(x,ytemp,yout); + } + for (i=1;i<=n;i++) + yout[i]=h*yout[i]-del[i]; + lubksb(a,n,indx,yout); + for (i=1;i<=n;i++) + yout[i] += ytemp[i]; + free_vector(ytemp,1,n); + free_vector(del,1,n); + free_matrix(a,1,n,1,n); + free_ivector(indx,1,n); +} diff --git a/lib/nr/k_and_r/recipes/sinft.c b/lib/nr/k_and_r/recipes/sinft.c new file mode 100644 index 0000000..94810c8 --- /dev/null +++ b/lib/nr/k_and_r/recipes/sinft.c @@ -0,0 +1,34 @@ + +#include + +void sinft(y,n) +float y[]; +int n; +{ + void realft(); + int j,n2=n+2; + float sum,y1,y2; + double theta,wi=0.0,wr=1.0,wpi,wpr,wtemp; + + theta=3.14159265358979/(double) n; + wtemp=sin(0.5*theta); + wpr = -2.0*wtemp*wtemp; + wpi=sin(theta); + y[1]=0.0; + for (j=2;j<=(n>>1)+1;j++) { + wr=(wtemp=wr)*wpr-wi*wpi+wr; + wi=wi*wpr+wtemp*wpi+wi; + y1=wi*(y[j]+y[n2-j]); + y2=0.5*(y[j]-y[n2-j]); + y[j]=y1+y2; + y[n2-j]=y1-y2; + } + realft(y,n,1); + y[1]*=0.5; + sum=y[2]=0.0; + for (j=1;j<=n-1;j+=2) { + sum += y[j]; + y[j]=y[j+1]; + y[j+1]=sum; + } +} diff --git a/lib/nr/k_and_r/recipes/slvsm2.c b/lib/nr/k_and_r/recipes/slvsm2.c new file mode 100644 index 0000000..c0381f4 --- /dev/null +++ b/lib/nr/k_and_r/recipes/slvsm2.c @@ -0,0 +1,14 @@ + +#include + +void slvsm2(u,rhs) +double **rhs,**u; +{ + void fill0(); + double disc,fact,h=0.5; + + fill0(u,3); + fact=2.0/(h*h); + disc=sqrt(fact*fact+rhs[2][2]); + u[2][2] = -rhs[2][2]/(fact+disc); +} diff --git a/lib/nr/k_and_r/recipes/slvsml.c b/lib/nr/k_and_r/recipes/slvsml.c new file mode 100644 index 0000000..1d34a8b --- /dev/null +++ b/lib/nr/k_and_r/recipes/slvsml.c @@ -0,0 +1,10 @@ + +void slvsml(u,rhs) +double **rhs,**u; +{ + void fill0(); + double h=0.5; + + fill0(u,3); + u[2][2] = -h*h*rhs[2][2]/4.0; +} diff --git a/lib/nr/k_and_r/recipes/sncndn.c b/lib/nr/k_and_r/recipes/sncndn.c new file mode 100644 index 0000000..60e513c --- /dev/null +++ b/lib/nr/k_and_r/recipes/sncndn.c @@ -0,0 +1,61 @@ + +#include +#define CA 0.0003 + +void sncndn(uu,emmc,sn,cn,dn) +float *cn,*dn,*sn,emmc,uu; +{ + float a,b,c,d,emc,u; + float em[14],en[14]; + int i,ii,l,bo; + + emc=emmc; + u=uu; + if (emc) { + bo=(emc < 0.0); + if (bo) { + d=1.0-emc; + emc /= -1.0/d; + u *= (d=sqrt(d)); + } + a=1.0; + *dn=1.0; + for (i=1;i<=13;i++) { + l=i; + em[i]=a; + en[i]=(emc=sqrt(emc)); + c=0.5*(a+emc); + if (fabs(a-emc) <= CA*a) break; + emc *= a; + a=c; + } + u *= c; + *sn=sin(u); + *cn=cos(u); + if (*sn) { + a=(*cn)/(*sn); + c *= a; + for (ii=l;ii>=1;ii--) { + b=em[ii]; + a *= c; + c *= (*dn); + *dn=(en[ii]+a)/(b+a); + a=c/b; + } + a=1.0/sqrt(c*c+1.0); + *sn=(*sn >= 0.0 ? a : -a); + *cn=c*(*sn); + } + if (bo) { + a=(*dn); + *dn=(*cn); + *cn=a; + *sn /= d; + } + } else { + *cn=1.0/cosh(u); + *dn=(*cn); + *sn=tanh(u); + } +} +#undef CA diff --git a/lib/nr/k_and_r/recipes/snrm.c b/lib/nr/k_and_r/recipes/snrm.c new file mode 100644 index 0000000..988e995 --- /dev/null +++ b/lib/nr/k_and_r/recipes/snrm.c @@ -0,0 +1,23 @@ + +#include + +double snrm(n,sx,itol) +double sx[]; +int itol; +unsigned long n; +{ + unsigned long i,isamax; + double ans; + + if (itol <= 3) { + ans = 0.0; + for (i=1;i<=n;i++) ans += sx[i]*sx[i]; + return sqrt(ans); + } else { + isamax=1; + for (i=1;i<=n;i++) { + if (fabs(sx[i]) > fabs(sx[isamax])) isamax=i; + } + return fabs(sx[isamax]); + } +} diff --git a/lib/nr/k_and_r/recipes/sobseq.c b/lib/nr/k_and_r/recipes/sobseq.c new file mode 100644 index 0000000..f45d7ec --- /dev/null +++ b/lib/nr/k_and_r/recipes/sobseq.c @@ -0,0 +1,53 @@ + +#include "nrutil.h" +#define MAXBIT 30 +#define MAXDIM 6 + +void sobseq(n,x) +float x[]; +int *n; +{ + int j,k,l; + unsigned long i,im,ipp; + static float fac; + static unsigned long in,ix[MAXDIM+1],*iu[MAXBIT+1]; + static unsigned long mdeg[MAXDIM+1]={0,1,2,3,3,4,4}; + static unsigned long ip[MAXDIM+1]={0,0,1,1,2,1,4}; + static unsigned long iv[MAXDIM*MAXBIT+1]={ + 0,1,1,1,1,1,1,3,1,3,3,1,1,5,7,7,3,3,5,15,11,5,15,13,9}; + + if (*n < 0) { + for (k=1;k<=MAXDIM;k++) ix[k]=0; + in=0; + if (iv[1] != 1) return; + fac=1.0/(1L << MAXBIT); + for (j=1,k=0;j<=MAXBIT;j++,k+=MAXDIM) iu[j] = &iv[k]; + for (k=1;k<=MAXDIM;k++) { + for (j=1;j<=mdeg[k];j++) iu[j][k] <<= (MAXBIT-j); + for (j=mdeg[k]+1;j<=MAXBIT;j++) { + ipp=ip[k]; + i=iu[j-mdeg[k]][k]; + i ^= (i >> mdeg[k]); + for (l=mdeg[k]-1;l>=1;l--) { + if (ipp & 1) i ^= iu[j-l][k]; + ipp >>= 1; + } + iu[j][k]=i; + } + } + } else { + im=in++; + for (j=1;j<=MAXBIT;j++) { + if (!(im & 1)) break; + im >>= 1; + } + if (j > MAXBIT) nrerror("MAXBIT too small in sobseq"); + im=(j-1)*MAXDIM; + for (k=1;k<=IMIN(*n,MAXDIM);k++) { + ix[k] ^= iv[im+k]; + x[k]=ix[k]*fac; + } + } +} +#undef MAXBIT +#undef MAXDIM diff --git a/lib/nr/k_and_r/recipes/solvde.c b/lib/nr/k_and_r/recipes/solvde.c new file mode 100644 index 0000000..4e67575 --- /dev/null +++ b/lib/nr/k_and_r/recipes/solvde.c @@ -0,0 +1,83 @@ + +#include +#include +#include "nrutil.h" + +void solvde(itmax,conv,slowc,scalv,indexv,ne,nb,m,y,c,s) +float ***c,**s,**y,conv,scalv[],slowc; +int indexv[],itmax,m,nb,ne; +{ + void bksub(),difeq(),pinvs(),red(); + int ic1,ic2,ic3,ic4,it,j,j1,j2,j3,j4,j5,j6,j7,j8,j9; + int jc1,jcf,jv,k,k1,k2,km,kp,nvars,*kmax; + float err,errj,fac,vmax,vz,*ermax; + + kmax=ivector(1,ne); + ermax=vector(1,ne); + k1=1; + k2=m; + nvars=ne*m; + j1=1; + j2=nb; + j3=nb+1; + j4=ne; + j5=j4+j1; + j6=j4+j2; + j7=j4+j3; + j8=j4+j4; + j9=j8+j1; + ic1=1; + ic2=ne-nb; + ic3=ic2+1; + ic4=ne; + jc1=1; + jcf=ic3; + for (it=1;it<=itmax;it++) { + k=k1; + difeq(k,k1,k2,j9,ic3,ic4,indexv,ne,s,y); + pinvs(ic3,ic4,j5,j9,jc1,k1,c,s); + for (k=k1+1;k<=k2;k++) { + kp=k-1; + difeq(k,k1,k2,j9,ic1,ic4,indexv,ne,s,y); + red(ic1,ic4,j1,j2,j3,j4,j9,ic3,jc1,jcf,kp,c,s); + pinvs(ic1,ic4,j3,j9,jc1,k,c,s); + } + k=k2+1; + difeq(k,k1,k2,j9,ic1,ic2,indexv,ne,s,y); + red(ic1,ic2,j5,j6,j7,j8,j9,ic3,jc1,jcf,k2,c,s); + pinvs(ic1,ic2,j7,j9,jcf,k2+1,c,s); + bksub(ne,nb,jcf,k1,k2,c); + err=0.0; + for (j=1;j<=ne;j++) { + jv=indexv[j]; + errj=vmax=0.0; + km=0; + for (k=k1;k<=k2;k++) { + vz=fabs(c[jv][1][k]); + if (vz > vmax) { + vmax=vz; + km=k; + } + errj += vz; + } + err += errj/scalv[j]; + ermax[j]=c[jv][1][km]/scalv[j]; + kmax[j]=km; + } + err /= nvars; + fac=(err > slowc ? slowc/err : 1.0); + for (j=1;j<=ne;j++) { + jv=indexv[j]; + for (k=k1;k<=k2;k++) + y[j][k] -= fac*c[jv][1][k]; + } + printf("\n%8s %9s %9s\n","Iter.","Error","FAC"); + printf("%6d %12.6f %11.6f\n",it,err,fac); + if (err < conv) { + free_vector(ermax,1,ne); + free_ivector(kmax,1,ne); + return; + } + } + nrerror("Too many iterations in solvde"); +} diff --git a/lib/nr/k_and_r/recipes/sor.c b/lib/nr/k_and_r/recipes/sor.c new file mode 100644 index 0000000..9320302 --- /dev/null +++ b/lib/nr/k_and_r/recipes/sor.c @@ -0,0 +1,44 @@ + +#include +#define MAXITS 1000 +#define EPS 1.0e-5 + +void sor(a,b,c,d,e,f,u,jmax,rjac) +double **a,**b,**c,**d,**e,**f,**u,rjac; +int jmax; +{ + void nrerror(); + int ipass,j,jsw,l,lsw,n; + double anorm,anormf=0.0,omega=1.0,resid; + + for (j=2;j=l;i--) { + if (arr[i] <= a) break; + arr[i+1]=arr[i]; + } + arr[i+1]=a; + } + if (jstack == 0) break; + ir=istack[jstack--]; + l=istack[jstack--]; + } else { + k=(l+ir) >> 1; + SWAP(arr[k],arr[l+1]) + if (arr[l] > arr[ir]) { + SWAP(arr[l],arr[ir]) + } + if (arr[l+1] > arr[ir]) { + SWAP(arr[l+1],arr[ir]) + } + if (arr[l] > arr[l+1]) { + SWAP(arr[l],arr[l+1]) + } + i=l+1; + j=ir; + a=arr[l+1]; + for (;;) { + do i++; while (arr[i] < a); + do j--; while (arr[j] > a); + if (j < i) break; + SWAP(arr[i],arr[j]); + } + arr[l+1]=arr[j]; + arr[j]=a; + jstack += 2; + if (jstack > NSTACK) nrerror("NSTACK too small in sort."); + if (ir-i+1 >= j-l) { + istack[jstack]=ir; + istack[jstack-1]=i; + ir=j-1; + } else { + istack[jstack]=j-1; + istack[jstack-1]=l; + l=i; + } + } + } + free_lvector(istack,1,NSTACK); +} +#undef M +#undef NSTACK +#undef SWAP diff --git a/lib/nr/k_and_r/recipes/sort2.c b/lib/nr/k_and_r/recipes/sort2.c new file mode 100644 index 0000000..f18132d --- /dev/null +++ b/lib/nr/k_and_r/recipes/sort2.c @@ -0,0 +1,83 @@ + +#include "nrutil.h" +#define SWAP(a,b) temp=(a);(a)=(b);(b)=temp; +#define M 7 +#define NSTACK 50 + +void sort2(n,arr,brr) +float arr[],brr[]; +unsigned long n; +{ + unsigned long i,ir=n,j,k,l=1,*istack; + int jstack=0; + float a,b,temp; + + istack=lvector(1,NSTACK); + for (;;) { + if (ir-l < M) { + for (j=l+1;j<=ir;j++) { + a=arr[j]; + b=brr[j]; + for (i=j-1;i>=l;i--) { + if (arr[i] <= a) break; + arr[i+1]=arr[i]; + brr[i+1]=brr[i]; + } + arr[i+1]=a; + brr[i+1]=b; + } + if (!jstack) { + free_lvector(istack,1,NSTACK); + return; + } + ir=istack[jstack]; + l=istack[jstack-1]; + jstack -= 2; + } else { + k=(l+ir) >> 1; + SWAP(arr[k],arr[l+1]) + SWAP(brr[k],brr[l+1]) + if (arr[l] > arr[ir]) { + SWAP(arr[l],arr[ir]) + SWAP(brr[l],brr[ir]) + } + if (arr[l+1] > arr[ir]) { + SWAP(arr[l+1],arr[ir]) + SWAP(brr[l+1],brr[ir]) + } + if (arr[l] > arr[l+1]) { + SWAP(arr[l],arr[l+1]) + SWAP(brr[l],brr[l+1]) + } + i=l+1; + j=ir; + a=arr[l+1]; + b=brr[l+1]; + for (;;) { + do i++; while (arr[i] < a); + do j--; while (arr[j] > a); + if (j < i) break; + SWAP(arr[i],arr[j]) + SWAP(brr[i],brr[j]) + } + arr[l+1]=arr[j]; + arr[j]=a; + brr[l+1]=brr[j]; + brr[j]=b; + jstack += 2; + if (jstack > NSTACK) nrerror("NSTACK too small in sort2."); + if (ir-i+1 >= j-l) { + istack[jstack]=ir; + istack[jstack-1]=i; + ir=j-1; + } else { + istack[jstack]=j-1; + istack[jstack-1]=l; + l=i; + } + } + } +} +#undef M +#undef NSTACK +#undef SWAP diff --git a/lib/nr/k_and_r/recipes/sort3.c b/lib/nr/k_and_r/recipes/sort3.c new file mode 100644 index 0000000..17eec78 --- /dev/null +++ b/lib/nr/k_and_r/recipes/sort3.c @@ -0,0 +1,23 @@ + +#include "nrutil.h" + +void sort3(n,ra,rb,rc) +float ra[],rb[],rc[]; +unsigned long n; +{ + void indexx(); + unsigned long j,*iwksp; + float *wksp; + + iwksp=lvector(1,n); + wksp=vector(1,n); + indexx(n,ra,iwksp); + for (j=1;j<=n;j++) wksp[j]=ra[j]; + for (j=1;j<=n;j++) ra[j]=wksp[iwksp[j]]; + for (j=1;j<=n;j++) wksp[j]=rb[j]; + for (j=1;j<=n;j++) rb[j]=wksp[iwksp[j]]; + for (j=1;j<=n;j++) wksp[j]=rc[j]; + for (j=1;j<=n;j++) rc[j]=wksp[iwksp[j]]; + free_vector(wksp,1,n); + free_lvector(iwksp,1,n); +} diff --git a/lib/nr/k_and_r/recipes/spctrm.c b/lib/nr/k_and_r/recipes/spctrm.c new file mode 100644 index 0000000..84febb7 --- /dev/null +++ b/lib/nr/k_and_r/recipes/spctrm.c @@ -0,0 +1,59 @@ + +#include +#include +#include "nrutil.h" +#define WINDOW(j,a,b) (1.0-fabs((((j)-1)-(a))*(b))) /* Bartlett */ + +void spctrm(fp,p,m,k,ovrlap) +FILE *fp; +float p[]; +int k,m,ovrlap; +{ + void four1(); + int mm,m44,m43,m4,kk,joffn,joff,j2,j; + float w,facp,facm,*w1,*w2,sumw=0.0,den=0.0; + + mm=m+m; + m43=(m4=mm+mm)+3; + m44=m43+1; + w1=vector(1,m4); + w2=vector(1,m); + facm=m; + facp=1.0/m; + for (j=1;j<=mm;j++) sumw += SQR(WINDOW(j,facm,facp)); + for (j=1;j<=m;j++) p[j]=0.0; + if (ovrlap) + for (j=1;j<=m;j++) fscanf(fp,"%f",&w2[j]); + for (kk=1;kk<=k;kk++) { + for (joff = -1;joff<=0;joff++) { + if (ovrlap) { + for (j=1;j<=m;j++) w1[joff+j+j]=w2[j]; + for (j=1;j<=m;j++) fscanf(fp,"%f",&w2[j]); + joffn=joff+mm; + for (j=1;j<=m;j++) w1[joffn+j+j]=w2[j]; + } else { + for (j=joff+2;j<=m4;j+=2) + fscanf(fp,"%f",&w1[j]); + } + } + for (j=1;j<=mm;j++) { + j2=j+j; + w=WINDOW(j,facm,facp); + w1[j2] *= w; + w1[j2-1] *= w; + } + four1(w1,mm,1); + p[1] += (SQR(w1[1])+SQR(w1[2])); + for (j=2;j<=m;j++) { + j2=j+j; + p[j] += (SQR(w1[j2])+SQR(w1[j2-1]) + +SQR(w1[m44-j2])+SQR(w1[m43-j2])); + } + den += sumw; + } + den *= m4; + for (j=1;j<=m;j++) p[j] /= den; + free_vector(w2,1,m); + free_vector(w1,1,m4); +} +#undef WINDOW diff --git a/lib/nr/k_and_r/recipes/spear.c b/lib/nr/k_and_r/recipes/spear.c new file mode 100644 index 0000000..6f76971 --- /dev/null +++ b/lib/nr/k_and_r/recipes/spear.c @@ -0,0 +1,44 @@ + +#include +#include "nrutil.h" + +void spear(data1,data2,n,d,zd,probd,rs,probrs) +float *d,*probd,*probrs,*rs,*zd,data1[],data2[]; +unsigned long n; +{ + float betai(),erfcc(); + void crank(),sort2(); + unsigned long j; + float vard,t,sg,sf,fac,en3n,en,df,aved,*wksp1,*wksp2; + + wksp1=vector(1,n); + wksp2=vector(1,n); + for (j=1;j<=n;j++) { + wksp1[j]=data1[j]; + wksp2[j]=data2[j]; + } + sort2(n,wksp1,wksp2); + crank(n,wksp1,&sf); + sort2(n,wksp2,wksp1); + crank(n,wksp2,&sg); + *d=0.0; + for (j=1;j<=n;j++) + *d += SQR(wksp1[j]-wksp2[j]); + en=n; + en3n=en*en*en-en; + aved=en3n/6.0-(sf+sg)/12.0; + fac=(1.0-sf/en3n)*(1.0-sg/en3n); + vard=((en-1.0)*en*en*SQR(en+1.0)/36.0)*fac; + *zd=(*d-aved)/sqrt(vard); + *probd=erfcc(fabs(*zd)/1.4142136); + *rs=(1.0-(6.0/en3n)*(*d+(sf+sg)/12.0))/sqrt(fac); + fac=(*rs+1.0)*(1.0-(*rs)); + if (fac > 0.0) { + t=(*rs)*sqrt((en-2.0)/fac); + df=en-2.0; + *probrs=betai(0.5*df,0.5,df/(df+t*t)); + } else + *probrs=0.0; + free_vector(wksp2,1,n); + free_vector(wksp1,1,n); +} diff --git a/lib/nr/k_and_r/recipes/sphbes.c b/lib/nr/k_and_r/recipes/sphbes.c new file mode 100644 index 0000000..36bc8c4 --- /dev/null +++ b/lib/nr/k_and_r/recipes/sphbes.c @@ -0,0 +1,22 @@ + +#include +#define RTPIO2 1.2533141 + +void sphbes(n,x,sj,sy,sjp,syp) +float *sj,*sjp,*sy,*syp,x; +int n; +{ + void bessjy(); + void nrerror(); + float factor,order,rj,rjp,ry,ryp; + + if (n < 0 || x <= 0.0) nrerror("bad arguments in sphbes"); + order=n+0.5; + bessjy(x,order,&rj,&ry,&rjp,&ryp); + factor=RTPIO2/sqrt(x); + *sj=factor*rj; + *sy=factor*ry; + *sjp=factor*rjp-(*sj)/(2.0*x); + *syp=factor*ryp-(*sy)/(2.0*x); +} +#undef RTPIO2 diff --git a/lib/nr/k_and_r/recipes/sphfpt.c b/lib/nr/k_and_r/recipes/sphfpt.c new file mode 100644 index 0000000..9580919 --- /dev/null +++ b/lib/nr/k_and_r/recipes/sphfpt.c @@ -0,0 +1,80 @@ + +#include +#include +#include "nrutil.h" +#define N1 2 +#define N2 1 +#define NTOT (N1+N2) +#define DXX 1.0e-4 + +int m,n; +float c2,dx,gmma; + +int nn2,nvar; +float x1,x2,xf; + +main() /* Program sphfpt */ +{ + void newt(),shootf(); + int check,i; + float q1,*v1,*v2,*v; + + v=vector(1,NTOT); + v1=v; + v2 = &v[N2]; + nvar=NTOT; + nn2=N2; + dx=DXX; + for (;;) { + printf("input m,n,c-squared\n"); + if (scanf("%d %d %f",&m,&n,&c2) == EOF) break; + if (n < m || m < 0) continue; + gmma=1.0; + q1=n; + for (i=1;i<=m;i++) gmma *= -0.5*(n+i)*(q1--/i); + v1[1]=n*(n+1)-m*(m+1)+c2/2.0; + v2[2]=v1[1]; + v2[1]=gmma*(1.0-(v2[2]-c2)*dx/(2*(m+1))); + x1 = -1.0+dx; + x2=1.0-dx; + xf=0.0; + newt(v,NTOT,&check,shootf); + if (check) { + printf("shootf failed; bad initial guess\n"); + } else { + printf("\tmu(m,n)\n"); + printf("%12.6f\n",v[1]); + } + } + free_vector(v,1,NTOT); + return 0; +} + +void load1(x1,v1,y) +float v1[],x1,y[]; +{ + float y1 = (n-m & 1 ? -gmma : gmma); + y[3]=v1[1]; + y[2] = -(y[3]-c2)*y1/(2*(m+1)); + y[1]=y1+y[2]*dx; +} + +void load2(x2,v2,y) +float v2[],x2,y[]; +{ + y[3]=v2[2]; + y[1]=v2[1]; + y[2]=(y[3]-c2)*y[1]/(2*(m+1)); +} + +void score(xf,y,f) +float f[],xf,y[]; +{ + int i; + + for (i=1;i<=3;i++) f[i]=y[i]; +} +#undef N1 +#undef N2 +#undef NTOT +#undef DXX diff --git a/lib/nr/k_and_r/recipes/sphoot.c b/lib/nr/k_and_r/recipes/sphoot.c new file mode 100644 index 0000000..0b2a367 --- /dev/null +++ b/lib/nr/k_and_r/recipes/sphoot.c @@ -0,0 +1,65 @@ + +#include +#include "nrutil.h" +#define N2 1 + +int m,n; +float c2,dx,gmma; + +int nvar; +float x1,x2; + +main() /* Program sphoot */ +{ + void newt(),shoot(); + int check,i; + float q1,*v; + + v=vector(1,N2); + dx=1.0e-4; + nvar=3; + for (;;) { + printf("input m,n,c-squared\n"); + if (scanf("%d %d %f",&m,&n,&c2) == EOF) break; + if (n < m || m < 0) continue; + gmma=1.0; + q1=n; + for (i=1;i<=m;i++) gmma *= -0.5*(n+i)*(q1--/i); + v[1]=n*(n+1)-m*(m+1)+c2/2.0; + x1 = -1.0+dx; + x2=0.0; + newt(v,N2,&check,shoot); + if (check) { + printf("shoot failed; bad initial guess\n"); + } else { + printf("\tmu(m,n)\n"); + printf("%12.6f\n",v[1]); + } + } + free_vector(v,1,N2); + return 0; +} + +void load(x1,v,y) +float v[],x1,y[]; +{ + float y1 = (n-m & 1 ? -gmma : gmma); + y[3]=v[1]; + y[2] = -(y[3]-c2)*y1/(2*(m+1)); + y[1]=y1+y[2]*dx; +} + +void score(xf,y,f) +float f[],xf,y[]; +{ + f[1]=(n-m & 1 ? y[1] : y[2]); +} + +void derivs(x,y,dydx) +float dydx[],x,y[]; +{ + dydx[1]=y[2]; + dydx[2]=(2.0*x*(m+1.0)*y[2]-(y[3]-c2*x*x)*y[1])/(1.0-x*x); + dydx[3]=0.0; +} +#undef N2 diff --git a/lib/nr/k_and_r/recipes/splie2.c b/lib/nr/k_and_r/recipes/splie2.c new file mode 100644 index 0000000..0954d80 --- /dev/null +++ b/lib/nr/k_and_r/recipes/splie2.c @@ -0,0 +1,11 @@ + +void splie2(x1a,x2a,ya,m,n,y2a) +float **y2a,**ya,x1a[],x2a[]; +int m,n; +{ + void spline(); + int j; + + for (j=1;j<=m;j++) + spline(x2a,ya[j],n,1.0e30,1.0e30,y2a[j]); +} diff --git a/lib/nr/k_and_r/recipes/splin2.c b/lib/nr/k_and_r/recipes/splin2.c new file mode 100644 index 0000000..b2e5859 --- /dev/null +++ b/lib/nr/k_and_r/recipes/splin2.c @@ -0,0 +1,20 @@ + +#include "nrutil.h" + +void splin2(x1a,x2a,ya,y2a,m,n,x1,x2,y) +float **y2a,**ya,*y,x1,x1a[],x2,x2a[]; +int m,n; +{ + void spline(),splint(); + int j; + float *ytmp,*yytmp; + + ytmp=vector(1,m); + yytmp=vector(1,m); + for (j=1;j<=m;j++) + splint(x2a,ya[j],y2a[j],n,x2,&yytmp[j]); + spline(x1a,yytmp,m,1.0e30,1.0e30,ytmp); + splint(x1a,yytmp,ytmp,m,x1,y); + free_vector(yytmp,1,m); + free_vector(ytmp,1,m); +} diff --git a/lib/nr/k_and_r/recipes/spline.c b/lib/nr/k_and_r/recipes/spline.c new file mode 100644 index 0000000..c81ab78 --- /dev/null +++ b/lib/nr/k_and_r/recipes/spline.c @@ -0,0 +1,35 @@ + +#include "nrutil.h" + +void spline(x,y,n,yp1,ypn,y2) +float x[],y2[],y[],yp1,ypn; +int n; +{ + int i,k; + float p,qn,sig,un,*u; + + u=vector(1,n-1); + if (yp1 > 0.99e30) + y2[1]=u[1]=0.0; + else { + y2[1] = -0.5; + u[1]=(3.0/(x[2]-x[1]))*((y[2]-y[1])/(x[2]-x[1])-yp1); + } + for (i=2;i<=n-1;i++) { + sig=(x[i]-x[i-1])/(x[i+1]-x[i-1]); + p=sig*y2[i-1]+2.0; + y2[i]=(sig-1.0)/p; + u[i]=(y[i+1]-y[i])/(x[i+1]-x[i]) - (y[i]-y[i-1])/(x[i]-x[i-1]); + u[i]=(6.0*u[i]/(x[i+1]-x[i-1])-sig*u[i-1])/p; + } + if (ypn > 0.99e30) + qn=un=0.0; + else { + qn=0.5; + un=(3.0/(x[n]-x[n-1]))*(ypn-(y[n]-y[n-1])/(x[n]-x[n-1])); + } + y2[n]=(un-qn*u[n-1])/(qn*y2[n-1]+1.0); + for (k=n-1;k>=1;k--) + y2[k]=y2[k]*y2[k+1]+u[k]; + free_vector(u,1,n-1); +} diff --git a/lib/nr/k_and_r/recipes/splint.c b/lib/nr/k_and_r/recipes/splint.c new file mode 100644 index 0000000..be20852 --- /dev/null +++ b/lib/nr/k_and_r/recipes/splint.c @@ -0,0 +1,22 @@ + +void splint(xa,ya,y2a,n,x,y) +float *y,x,xa[],y2a[],ya[]; +int n; +{ + void nrerror(); + int klo,khi,k; + float h,b,a; + + klo=1; + khi=n; + while (khi-klo > 1) { + k=(khi+klo) >> 1; + if (xa[k] > x) khi=k; + else klo=k; + } + h=xa[khi]-xa[klo]; + if (h == 0.0) nrerror("Bad xa input to routine splint"); + a=(xa[khi]-x)/h; + b=(x-xa[klo])/h; + *y=a*ya[klo]+b*ya[khi]+((a*a*a-a)*y2a[klo]+(b*b*b-b)*y2a[khi])*(h*h)/6.0; +} diff --git a/lib/nr/k_and_r/recipes/spread.c b/lib/nr/k_and_r/recipes/spread.c new file mode 100644 index 0000000..d04594a --- /dev/null +++ b/lib/nr/k_and_r/recipes/spread.c @@ -0,0 +1,28 @@ + +#include "nrutil.h" + +void spread(y,yy,n,x,m) +float x,y,yy[]; +int m; +unsigned long n; +{ + int ihi,ilo,ix,j,nden; + static long nfac[11]={0,1,1,2,6,24,120,720,5040,40320,362880}; + float fac; + + if (m > 10) nrerror("factorial table too small in spread"); + ix=(int)x; + if (x == (float)ix) yy[ix] += y; + else { + ilo=LMIN(LMAX((long)(x-0.5*m+1.0),1),n-m+1); + ihi=ilo+m-1; + nden=nfac[m]; + fac=x-ilo; + for (j=ilo+1;j<=ihi;j++) fac *= (x-j); + yy[ihi] += y*fac/(nden*(x-ihi)); + for (j=ihi-1;j>=ilo;j--) { + nden=(nden/(j+1-ilo))*(j-ihi); + yy[j] += y*fac/(nden*(x-j)); + } + } +} diff --git a/lib/nr/k_and_r/recipes/sprsax.c b/lib/nr/k_and_r/recipes/sprsax.c new file mode 100644 index 0000000..b4562b0 --- /dev/null +++ b/lib/nr/k_and_r/recipes/sprsax.c @@ -0,0 +1,16 @@ + +void sprsax(sa,ija,x,b,n) +float b[],sa[],x[]; +unsigned long ija[],n; +{ + void nrerror(); + unsigned long i,k; + + if (ija[1] != n+2) nrerror("sprsax: mismatched vector and matrix"); + for (i=1;i<=n;i++) { + b[i]=sa[i]*x[i]; + for (k=ija[i];k<=ija[i+1]-1;k++) + b[i] += sa[k]*x[ija[k]]; + + } +} diff --git a/lib/nr/k_and_r/recipes/sprsin.c b/lib/nr/k_and_r/recipes/sprsin.c new file mode 100644 index 0000000..45e3010 --- /dev/null +++ b/lib/nr/k_and_r/recipes/sprsin.c @@ -0,0 +1,26 @@ + +#include + +void sprsin(a,n,thresh,nmax,sa,ija) +float **a,sa[],thresh; +int n; +unsigned long ija[],nmax; +{ + void nrerror(); + int i,j; + unsigned long k; + + for (j=1;j<=n;j++) sa[j]=a[j][j]; + ija[1]=n+2; + k=n+1; + for (i=1;i<=n;i++) { + for (j=1;j<=n;j++) { + if (fabs(a[i][j]) >= thresh && i != j) { + if (++k > nmax) nrerror("sprsin: nmax too small"); + sa[k]=a[i][j]; + ija[k]=j; + } + } + ija[i+1]=k+1; + } +} diff --git a/lib/nr/k_and_r/recipes/sprspm.c b/lib/nr/k_and_r/recipes/sprspm.c new file mode 100644 index 0000000..6c436bc --- /dev/null +++ b/lib/nr/k_and_r/recipes/sprspm.c @@ -0,0 +1,47 @@ + +void sprspm(sa,ija,sb,ijb,sc,ijc) +float sa[],sb[],sc[]; +unsigned long ija[],ijb[],ijc[]; +{ + void nrerror(); + unsigned long i,ijma,ijmb,j,m,ma,mb,mbb,mn; + float sum; + + if (ija[1] != ijb[1] || ija[1] != ijc[1]) + nrerror("sprspm: sizes do not match"); + for (i=1;i<=ijc[1]-2;i++) { + j=m=i; + mn=ijc[i]; + sum=sa[i]*sb[i]; + for (;;) { + mb=ijb[j]; + for (ma=ija[i];ma<=ija[i+1]-1;ma++) { + ijma=ija[ma]; + if (ijma == j) sum += sa[ma]*sb[j]; + else { + while (mb < ijb[j+1]) { + ijmb=ijb[mb]; + if (ijmb == i) { + sum += sa[i]*sb[mb++]; + continue; + } else if (ijmb < ijma) { + mb++; + continue; + } else if (ijmb == ijma) { + sum += sa[ma]*sb[mb++]; + continue; + } + break; + } + } + } + for (mbb=mb;mbb<=ijb[j+1]-1;mbb++) { + if (ijb[mbb] == i) sum += sa[i]*sb[mbb]; + } + sc[m]=sum; + sum=0.0; + if (mn >= ijc[i+1]) break; + j=ijc[m=mn++]; + } + } +} diff --git a/lib/nr/k_and_r/recipes/sprstm.c b/lib/nr/k_and_r/recipes/sprstm.c new file mode 100644 index 0000000..2ec72c0 --- /dev/null +++ b/lib/nr/k_and_r/recipes/sprstm.c @@ -0,0 +1,50 @@ + +#include + +void sprstm(sa,ija,sb,ijb,thresh,nmax,sc,ijc) +float sa[],sb[],sc[],thresh; +unsigned long ija[],ijb[],ijc[],nmax; +{ + void nrerror(); + unsigned long i,ijma,ijmb,j,k,ma,mb,mbb; + float sum; + + if (ija[1] != ijb[1]) nrerror("sprstm: sizes do not match"); + ijc[1]=k=ija[1]; + for (i=1;i<=ija[1]-2;i++) { + for (j=1;j<=ijb[1]-2;j++) { + if (i == j) sum=sa[i]*sb[j]; else sum=0.0e0; + mb=ijb[j]; + for (ma=ija[i];ma<=ija[i+1]-1;ma++) { + ijma=ija[ma]; + if (ijma == j) sum += sa[ma]*sb[j]; + else { + while (mb < ijb[j+1]) { + ijmb=ijb[mb]; + if (ijmb == i) { + sum += sa[i]*sb[mb++]; + continue; + } else if (ijmb < ijma) { + mb++; + continue; + } else if (ijmb == ijma) { + sum += sa[ma]*sb[mb++]; + continue; + } + break; + } + } + } + for (mbb=mb;mbb<=ijb[j+1]-1;mbb++) { + if (ijb[mbb] == i) sum += sa[i]*sb[mbb]; + } + if (i == j) sc[i]=sum; + else if (fabs(sum) > thresh) { + if (k > nmax) nrerror("sprstm: nmax too small"); + sc[k]=sum; + ijc[k++]=j; + } + } + ijc[i+1]=k; + } +} diff --git a/lib/nr/k_and_r/recipes/sprstp.c b/lib/nr/k_and_r/recipes/sprstp.c new file mode 100644 index 0000000..a1544b1 --- /dev/null +++ b/lib/nr/k_and_r/recipes/sprstp.c @@ -0,0 +1,53 @@ + +void sprstp(sa,ija,sb,ijb) +float sa[],sb[]; +unsigned long ija[],ijb[]; +{ + void iindexx(); + unsigned long j,jl,jm,jp,ju,k,m,n2,noff,inc,iv; + float v; + + n2=ija[1]; + for (j=1;j<=n2-2;j++) sb[j]=sa[j]; + iindexx(ija[n2-1]-ija[1],(long *)&ija[n2-1],&ijb[n2-1]); + jp=0; + for (k=ija[1];k<=ija[n2-1]-1;k++) { + m=ijb[k]+n2-1; + sb[k]=sa[m]; + for (j=jp+1;j<=ija[m];j++) ijb[j]=k; + jp=ija[m]; + jl=1; + ju=n2-1; + while (ju-jl > 1) { + jm=(ju+jl)/2; + if (ija[jm] > m) ju=jm; else jl=jm; + } + ijb[k]=jl; + } + for (j=jp+1;j iv) { + ijb[m]=ijb[m-inc]; + sb[m]=sb[m-inc]; + m -= inc; + if (m-noff <= inc) break; + } + ijb[m]=iv; + sb[m]=v; + } + } while (inc > 1); + } +} diff --git a/lib/nr/k_and_r/recipes/sprstx.c b/lib/nr/k_and_r/recipes/sprstx.c new file mode 100644 index 0000000..9265d35 --- /dev/null +++ b/lib/nr/k_and_r/recipes/sprstx.c @@ -0,0 +1,17 @@ + +void sprstx(sa,ija,x,b,n) +float b[],sa[],x[]; +unsigned long ija[],n; +{ + void nrerror(); + unsigned long i,j,k; + + if (ija[1] != n+2) nrerror("mismatched vector and matrix in sprstx"); + for (i=1;i<=n;i++) b[i]=sa[i]*x[i]; + for (i=1;i<=n;i++) { + for (k=ija[i];k<=ija[i+1]-1;k++) { + j=ija[k]; + b[j] += sa[k]*x[i]; + } + } +} diff --git a/lib/nr/k_and_r/recipes/stifbs.c b/lib/nr/k_and_r/recipes/stifbs.c new file mode 100644 index 0000000..45ca73d --- /dev/null +++ b/lib/nr/k_and_r/recipes/stifbs.c @@ -0,0 +1,145 @@ + +#include +#include "nrutil.h" +#define KMAXX 7 +#define IMAXX (KMAXX+1) +#define SAFE1 0.25 +#define SAFE2 0.7 +#define REDMAX 1.0e-5 +#define REDMIN 0.7 +#define TINY 1.0e-30 +#define SCALMX 0.1 + +float **d,*x; + +void stifbs(y,dydx,nv,xx,htry,eps,yscal,hdid,hnext,derivs) +float *hdid,*hnext,*xx,dydx[],eps,htry,y[],yscal[]; +int nv; +void (*derivs)(); +{ + void jacobn(),pzextr(),simpr(); + int i,iq,k,kk,km; + static int first=1,kmax,kopt,nvold = -1; + static float epsold = -1.0,xnew; + float eps1,errmax,fact,h,red,scale,work,wrkmin,xest; + float *dfdx,**dfdy,*err,*yerr,*ysav,*yseq; + static float a[IMAXX+1]; + static float alf[KMAXX+1][KMAXX+1]; + static int nseq[IMAXX+1]={0,2,6,10,14,22,34,50,70}; + int reduct,exitflag=0; + + d=matrix(1,nv,1,KMAXX); + dfdx=vector(1,nv); + dfdy=matrix(1,nv,1,nv); + err=vector(1,KMAXX); + x=vector(1,KMAXX); + yerr=vector(1,nv); + ysav=vector(1,nv); + yseq=vector(1,nv); + if(eps != epsold || nv != nvold) { + *hnext = xnew = -1.0e29; + eps1=SAFE1*eps; + a[1]=nseq[1]+1; + for (k=1;k<=KMAXX;k++) a[k+1]=a[k]+nseq[k+1]; + for (iq=2;iq<=KMAXX;iq++) { + for (k=1;k a[kopt]*alf[kopt-1][kopt]) break; + kmax=kopt; + } + h=htry; + for (i=1;i<=nv;i++) ysav[i]=y[i]; + jacobn(*xx,y,dfdx,dfdy,nv); + if (*xx != xnew || h != (*hnext)) { + first=1; + kopt=kmax; + } + reduct=0; + for (;;) { + for (k=1;k<=kmax;k++) { + xnew=(*xx)+h; + if (xnew == (*xx)) nrerror("step size underflow in stifbs"); + simpr(ysav,dydx,dfdx,dfdy,nv,*xx,h,nseq[k],yseq,derivs); + xest=SQR(h/nseq[k]); + pzextr(k,xest,yseq,y,yerr,nv); + if (k != 1) { + errmax=TINY; + for (i=1;i<=nv;i++) errmax=FMAX(errmax,fabs(yerr[i]/yscal[i])); + errmax /= eps; + km=k-1; + err[km]=pow(errmax/SAFE1,1.0/(2*km+1)); + } + if (k != 1 && (k >= kopt-1 || first)) { + if (errmax < 1.0) { + exitflag=1; + break; + } + if (k == kmax || k == kopt+1) { + red=SAFE2/err[km]; + break; + } + else if (k == kopt && alf[kopt-1][kopt] < err[km]) { + red=1.0/err[km]; + break; + } + else if (kopt == kmax && alf[km][kmax-1] < err[km]) { + red=alf[km][kmax-1]*SAFE2/err[km]; + break; + } + else if (alf[km][kopt] < err[km]) { + red=alf[km][kopt-1]/err[km]; + break; + } + } + } + if (exitflag) break; + red=FMIN(red,REDMIN); + red=FMAX(red,REDMAX); + h *= red; + reduct=1; + } + *xx=xnew; + *hdid=h; + first=0; + wrkmin=1.0e35; + for (kk=1;kk<=km;kk++) { + fact=FMAX(err[kk],SCALMX); + work=fact*a[kk+1]; + if (work < wrkmin) { + scale=fact; + wrkmin=work; + kopt=kk+1; + } + } + *hnext=h/scale; + if (kopt >= k && kopt != kmax && !reduct) { + fact=FMAX(scale/alf[kopt-1][kopt],SCALMX); + if (a[kopt+1]*fact <= wrkmin) { + *hnext=h/fact; + kopt++; + } + } + free_vector(yseq,1,nv); + free_vector(ysav,1,nv); + free_vector(yerr,1,nv); + free_vector(x,1,KMAXX); + free_vector(err,1,KMAXX); + free_matrix(dfdy,1,nv,1,nv); + free_vector(dfdx,1,nv); + free_matrix(d,1,nv,1,KMAXX); +} +#undef KMAXX +#undef IMAXX +#undef SAFE1 +#undef SAFE2 +#undef REDMAX +#undef REDMIN +#undef TINY +#undef SCALMX diff --git a/lib/nr/k_and_r/recipes/stiff.c b/lib/nr/k_and_r/recipes/stiff.c new file mode 100644 index 0000000..9abc07a --- /dev/null +++ b/lib/nr/k_and_r/recipes/stiff.c @@ -0,0 +1,151 @@ + +#include +#include "nrutil.h" +#define SAFETY 0.9 +#define GROW 1.5 +#define PGROW -0.25 +#define SHRNK 0.5 +#define PSHRNK (-1.0/3.0) +#define ERRCON 0.1296 +#define MAXTRY 40 +#define GAM (1.0/2.0) +#define A21 2.0 +#define A31 (48.0/25.0) +#define A32 (6.0/25.0) +#define C21 -8.0 +#define C31 (372.0/25.0) +#define C32 (12.0/5.0) +#define C41 (-112.0/125.0) +#define C42 (-54.0/125.0) +#define C43 (-2.0/5.0) +#define B1 (19.0/9.0) +#define B2 (1.0/2.0) +#define B3 (25.0/108.0) +#define B4 (125.0/108.0) +#define E1 (17.0/54.0) +#define E2 (7.0/36.0) +#define E3 0.0 +#define E4 (125.0/108.0) +#define C1X (1.0/2.0) +#define C2X (-3.0/2.0) +#define C3X (121.0/50.0) +#define C4X (29.0/250.0) +#define A2X 1.0 +#define A3X (3.0/5.0) + +void stiff(y,dydx,n,x,htry,eps,yscal,hdid,hnext,derivs) +float *hdid,*hnext,*x,dydx[],eps,htry,y[],yscal[]; +int n; +void (*derivs)(); +{ + void jacobn(),lubksb(),ludcmp(); + int i,j,jtry,*indx; + float d,errmax,h,xsav,**a,*dfdx,**dfdy,*dysav,*err; + float *g1,*g2,*g3,*g4,*ysav; + + indx=ivector(1,n); + a=matrix(1,n,1,n); + dfdx=vector(1,n); + dfdy=matrix(1,n,1,n); + dysav=vector(1,n); + err=vector(1,n); + g1=vector(1,n); + g2=vector(1,n); + g3=vector(1,n); + g4=vector(1,n); + ysav=vector(1,n); + xsav=(*x); + for (i=1;i<=n;i++) { + ysav[i]=y[i]; + dysav[i]=dydx[i]; + } + jacobn(xsav,ysav,dfdx,dfdy,n); + h=htry; + for (jtry=1;jtry<=MAXTRY;jtry++) { + for (i=1;i<=n;i++) { + for (j=1;j<=n;j++) a[i][j] = -dfdy[i][j]; + a[i][i] += 1.0/(GAM*h); + } + ludcmp(a,n,indx,&d); + for (i=1;i<=n;i++) + g1[i]=dysav[i]+h*C1X*dfdx[i]; + lubksb(a,n,indx,g1); + for (i=1;i<=n;i++) + y[i]=ysav[i]+A21*g1[i]; + *x=xsav+A2X*h; + (*derivs)(*x,y,dydx); + for (i=1;i<=n;i++) + g2[i]=dydx[i]+h*C2X*dfdx[i]+C21*g1[i]/h; + lubksb(a,n,indx,g2); + for (i=1;i<=n;i++) + y[i]=ysav[i]+A31*g1[i]+A32*g2[i]; + *x=xsav+A3X*h; + (*derivs)(*x,y,dydx); + for (i=1;i<=n;i++) + g3[i]=dydx[i]+h*C3X*dfdx[i]+(C31*g1[i]+C32*g2[i])/h; + lubksb(a,n,indx,g3); + for (i=1;i<=n;i++) + g4[i]=dydx[i]+h*C4X*dfdx[i]+(C41*g1[i]+C42*g2[i]+C43*g3[i])/h; + lubksb(a,n,indx,g4); + for (i=1;i<=n;i++) { + y[i]=ysav[i]+B1*g1[i]+B2*g2[i]+B3*g3[i]+B4*g4[i]; + err[i]=E1*g1[i]+E2*g2[i]+E3*g3[i]+E4*g4[i]; + } + *x=xsav+h; + if (*x == xsav) nrerror("stepsize not significant in stiff"); + errmax=0.0; + for (i=1;i<=n;i++) errmax=FMAX(errmax,fabs(err[i]/yscal[i])); + errmax /= eps; + if (errmax <= 1.0) { + *hdid=h; + *hnext=(errmax > ERRCON ? SAFETY*h*pow(errmax,PGROW) : GROW*h); + free_vector(ysav,1,n); + free_vector(g4,1,n); + free_vector(g3,1,n); + free_vector(g2,1,n); + free_vector(g1,1,n); + free_vector(err,1,n); + free_vector(dysav,1,n); + free_matrix(dfdy,1,n,1,n); + free_vector(dfdx,1,n); + free_matrix(a,1,n,1,n); + free_ivector(indx,1,n); + return; + } else { + *hnext=SAFETY*h*pow(errmax,PSHRNK); + h=(h >= 0.0 ? FMAX(*hnext,SHRNK*h) : FMIN(*hnext,SHRNK*h)); + } + } + nrerror("exceeded MAXTRY in stiff"); +} +#undef SAFETY +#undef GROW +#undef PGROW +#undef SHRNK +#undef PSHRNK +#undef ERRCON +#undef MAXTRY +#undef GAM +#undef A21 +#undef A31 +#undef A32 +#undef C21 +#undef C31 +#undef C32 +#undef C41 +#undef C42 +#undef C43 +#undef B1 +#undef B2 +#undef B3 +#undef B4 +#undef E1 +#undef E2 +#undef E3 +#undef E4 +#undef C1X +#undef C2X +#undef C3X +#undef C4X +#undef A2X +#undef A3X diff --git a/lib/nr/k_and_r/recipes/stoerm.c b/lib/nr/k_and_r/recipes/stoerm.c new file mode 100644 index 0000000..0f0ef84 --- /dev/null +++ b/lib/nr/k_and_r/recipes/stoerm.c @@ -0,0 +1,35 @@ + +#include "nrutil.h" + +void stoerm(y,d2y,nv,xs,htot,nstep,yout,derivs) +float d2y[],htot,xs,y[],yout[]; +int nstep,nv; +void (*derivs)(); +{ + int i,n,neqns,nn; + float h,h2,halfh,x,*ytemp; + + ytemp=vector(1,nv); + h=htot/nstep; + halfh=0.5*h; + neqns=nv/2; + for (i=1;i<=neqns;i++) { + n=neqns+i; + ytemp[i]=y[i]+(ytemp[n]=h*(y[n]+halfh*d2y[i])); + } + x=xs+h; + (*derivs)(x,ytemp,yout); + h2=h*h; + for (nn=2;nn<=nstep;nn++) { + for (i=1;i<=neqns;i++) + ytemp[i] += (ytemp[(n=neqns+i)] += h2*yout[i]); + x += h; + (*derivs)(x,ytemp,yout); + } + for (i=1;i<=neqns;i++) { + n=neqns+i; + yout[n]=ytemp[n]/h+halfh*yout[i]; + yout[i]=ytemp[i]; + } + free_vector(ytemp,1,nv); +} diff --git a/lib/nr/k_and_r/recipes/svbksb.c b/lib/nr/k_and_r/recipes/svbksb.c new file mode 100644 index 0000000..515d174 --- /dev/null +++ b/lib/nr/k_and_r/recipes/svbksb.c @@ -0,0 +1,26 @@ + +#include "nrutil.h" + +void svbksb(u,w,v,m,n,b,x) +float **u,**v,b[],w[],x[]; +int m,n; +{ + int jj,j,i; + float s,*tmp; + + tmp=vector(1,n); + for (j=1;j<=n;j++) { + s=0.0; + if (w[j]) { + for (i=1;i<=m;i++) s += u[i][j]*b[i]; + s /= w[j]; + } + tmp[j]=s; + } + for (j=1;j<=n;j++) { + s=0.0; + for (jj=1;jj<=n;jj++) s += v[j][jj]*tmp[jj]; + x[j]=s; + } + free_vector(tmp,1,n); +} diff --git a/lib/nr/k_and_r/recipes/svdcmp.c b/lib/nr/k_and_r/recipes/svdcmp.c new file mode 100644 index 0000000..6da6a4a --- /dev/null +++ b/lib/nr/k_and_r/recipes/svdcmp.c @@ -0,0 +1,184 @@ + +#include +#include "nrutil.h" + +void svdcmp(a,m,n,w,v) +float **a,**v,w[]; +int m,n; +{ + float pythag(); + int flag,i,its,j,jj,k,l,nm; + float anorm,c,f,g,h,s,scale,x,y,z,*rv1; + + rv1=vector(1,n); + g=scale=anorm=0.0; + for (i=1;i<=n;i++) { + l=i+1; + rv1[i]=scale*g; + g=s=scale=0.0; + if (i <= m) { + for (k=i;k<=m;k++) scale += fabs(a[k][i]); + if (scale) { + for (k=i;k<=m;k++) { + a[k][i] /= scale; + s += a[k][i]*a[k][i]; + } + f=a[i][i]; + g = -SIGN(sqrt(s),f); + h=f*g-s; + a[i][i]=f-g; + for (j=l;j<=n;j++) { + for (s=0.0,k=i;k<=m;k++) s += a[k][i]*a[k][j]; + f=s/h; + for (k=i;k<=m;k++) a[k][j] += f*a[k][i]; + } + for (k=i;k<=m;k++) a[k][i] *= scale; + } + } + w[i]=scale *g; + g=s=scale=0.0; + if (i <= m && i != n) { + for (k=l;k<=n;k++) scale += fabs(a[i][k]); + if (scale) { + for (k=l;k<=n;k++) { + a[i][k] /= scale; + s += a[i][k]*a[i][k]; + } + f=a[i][l]; + g = -SIGN(sqrt(s),f); + h=f*g-s; + a[i][l]=f-g; + for (k=l;k<=n;k++) rv1[k]=a[i][k]/h; + for (j=l;j<=m;j++) { + for (s=0.0,k=l;k<=n;k++) s += a[j][k]*a[i][k]; + for (k=l;k<=n;k++) a[j][k] += s*rv1[k]; + } + for (k=l;k<=n;k++) a[i][k] *= scale; + } + } + anorm=FMAX(anorm,(fabs(w[i])+fabs(rv1[i]))); + } + for (i=n;i>=1;i--) { + if (i < n) { + if (g) { + for (j=l;j<=n;j++) + v[j][i]=(a[i][j]/a[i][l])/g; + for (j=l;j<=n;j++) { + for (s=0.0,k=l;k<=n;k++) s += a[i][k]*v[k][j]; + for (k=l;k<=n;k++) v[k][j] += s*v[k][i]; + } + } + for (j=l;j<=n;j++) v[i][j]=v[j][i]=0.0; + } + v[i][i]=1.0; + g=rv1[i]; + l=i; + } + for (i=IMIN(m,n);i>=1;i--) { + l=i+1; + g=w[i]; + for (j=l;j<=n;j++) a[i][j]=0.0; + if (g) { + g=1.0/g; + for (j=l;j<=n;j++) { + for (s=0.0,k=l;k<=m;k++) s += a[k][i]*a[k][j]; + f=(s/a[i][i])*g; + for (k=i;k<=m;k++) a[k][j] += f*a[k][i]; + } + for (j=i;j<=m;j++) a[j][i] *= g; + } else for (j=i;j<=m;j++) a[j][i]=0.0; + ++a[i][i]; + } + for (k=n;k>=1;k--) { + for (its=1;its<=30;its++) { + flag=1; + for (l=k;l>=1;l--) { + nm=l-1; + if ((float)(fabs(rv1[l])+anorm) == anorm) { + flag=0; + break; + } + if ((float)(fabs(w[nm])+anorm) == anorm) break; + } + if (flag) { + c=0.0; + s=1.0; + for (i=l;i<=k;i++) { + f=s*rv1[i]; + rv1[i]=c*rv1[i]; + if ((float)(fabs(f)+anorm) == anorm) break; + g=w[i]; + h=pythag(f,g); + w[i]=h; + h=1.0/h; + c=g*h; + s = -f*h; + for (j=1;j<=m;j++) { + y=a[j][nm]; + z=a[j][i]; + a[j][nm]=y*c+z*s; + a[j][i]=z*c-y*s; + } + } + } + z=w[k]; + if (l == k) { + if (z < 0.0) { + w[k] = -z; + for (j=1;j<=n;j++) v[j][k] = -v[j][k]; + } + break; + } + if (its == 30) nrerror("no convergence in 30 svdcmp iterations"); + x=w[l]; + nm=k-1; + y=w[nm]; + g=rv1[nm]; + h=rv1[k]; + f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y); + g=pythag(f,1.0); + f=((x-z)*(x+z)+h*((y/(f+SIGN(g,f)))-h))/x; + c=s=1.0; + for (j=l;j<=nm;j++) { + i=j+1; + g=rv1[i]; + y=w[i]; + h=s*g; + g=c*g; + z=pythag(f,h); + rv1[j]=z; + c=f/z; + s=h/z; + f=x*c+g*s; + g = g*c-x*s; + h=y*s; + y *= c; + for (jj=1;jj<=n;jj++) { + x=v[jj][j]; + z=v[jj][i]; + v[jj][j]=x*c+z*s; + v[jj][i]=z*c-x*s; + } + z=pythag(f,h); + w[j]=z; + if (z) { + z=1.0/z; + c=f*z; + s=h*z; + } + f=c*g+s*y; + x=c*y-s*g; + for (jj=1;jj<=m;jj++) { + y=a[jj][j]; + z=a[jj][i]; + a[jj][j]=y*c+z*s; + a[jj][i]=z*c-y*s; + } + } + rv1[l]=0.0; + rv1[k]=f; + w[k]=x; + } + } + free_vector(rv1,1,n); +} diff --git a/lib/nr/k_and_r/recipes/svdfit.c b/lib/nr/k_and_r/recipes/svdfit.c new file mode 100644 index 0000000..e46d2ab --- /dev/null +++ b/lib/nr/k_and_r/recipes/svdfit.c @@ -0,0 +1,39 @@ + +#include "nrutil.h" +#define TOL 1.0e-5 + +void svdfit(x,y,sig,ndata,a,ma,u,v,w,chisq,funcs) +float **u,**v,*chisq,a[],sig[],w[],x[],y[]; +int ma,ndata; +void (*funcs)(); +{ + void svbksb(),svdcmp(); + int j,i; + float wmax,tmp,thresh,sum,*b,*afunc; + + b=vector(1,ndata); + afunc=vector(1,ma); + for (i=1;i<=ndata;i++) { + (*funcs)(x[i],afunc,ma); + tmp=1.0/sig[i]; + for (j=1;j<=ma;j++) u[i][j]=afunc[j]*tmp; + b[i]=y[i]*tmp; + } + svdcmp(u,ndata,ma,w,v); + wmax=0.0; + for (j=1;j<=ma;j++) + if (w[j] > wmax) wmax=w[j]; + thresh=TOL*wmax; + for (j=1;j<=ma;j++) + if (w[j] < thresh) w[j]=0.0; + svbksb(u,w,v,ndata,ma,b,a); + *chisq=0.0; + for (i=1;i<=ndata;i++) { + (*funcs)(x[i],afunc,ma); + for (sum=0.0,j=1;j<=ma;j++) sum += a[j]*afunc[j]; + *chisq += (tmp=(y[i]-sum)/sig[i],tmp*tmp); + } + free_vector(afunc,1,ma); + free_vector(b,1,ndata); +} +#undef TOL diff --git a/lib/nr/k_and_r/recipes/svdvar.c b/lib/nr/k_and_r/recipes/svdvar.c new file mode 100644 index 0000000..4e4bdea --- /dev/null +++ b/lib/nr/k_and_r/recipes/svdvar.c @@ -0,0 +1,23 @@ + +#include "nrutil.h" + +void svdvar(v,ma,w,cvm) +float **cvm,**v,w[]; +int ma; +{ + int k,j,i; + float sum,*wti; + + wti=vector(1,ma); + for (i=1;i<=ma;i++) { + wti[i]=0.0; + if (w[i]) wti[i]=1.0/(w[i]*w[i]); + } + for (i=1;i<=ma;i++) { + for (j=1;j<=i;j++) { + for (sum=0.0,k=1;k<=ma;k++) sum += v[i][k]*v[j][k]*wti[k]; + cvm[j][i]=cvm[i][j]=sum; + } + } + free_vector(wti,1,ma); +} diff --git a/lib/nr/k_and_r/recipes/toeplz.c b/lib/nr/k_and_r/recipes/toeplz.c new file mode 100644 index 0000000..eaaad4a --- /dev/null +++ b/lib/nr/k_and_r/recipes/toeplz.c @@ -0,0 +1,60 @@ + +#include "nrutil.h" +#define FREERETURN {free_vector(h,1,n);free_vector(g,1,n);return;} + +void toeplz(r,x,y,n) +float r[],x[],y[]; +int n; +{ + int j,k,m,m1,m2; + float pp,pt1,pt2,qq,qt1,qt2,sd,sgd,sgn,shn,sxn; + float *g,*h; + + if (r[n] == 0.0) nrerror("toeplz-1 singular principal minor"); + g=vector(1,n); + h=vector(1,n); + x[1]=y[1]/r[n]; + if (n == 1) FREERETURN + g[1]=r[n-1]/r[n]; + h[1]=r[n+1]/r[n]; + for (m=1;m<=n;m++) { + m1=m+1; + sxn = -y[m1]; + sd = -r[n]; + for (j=1;j<=m;j++) { + sxn += r[n+m1-j]*x[j]; + sd += r[n+m1-j]*g[m-j+1]; + } + if (sd == 0.0) nrerror("toeplz-2 singular principal minor"); + x[m1]=sxn/sd; + for (j=1;j<=m;j++) x[j] -= x[m1]*g[m-j+1]; + if (m1 == n) FREERETURN + sgn = -r[n-m1]; + shn = -r[n+m1]; + sgd = -r[n]; + for (j=1;j<=m;j++) { + sgn += r[n+j-m1]*g[j]; + shn += r[n+m1-j]*h[j]; + sgd += r[n+j-m1]*h[m-j+1]; + } + if (sgd == 0.0) nrerror("toeplz-3 singular principal minor"); + g[m1]=sgn/sgd; + h[m1]=shn/sd; + k=m; + m2=(m+1) >> 1; + pp=g[m1]; + qq=h[m1]; + for (j=1;j<=m2;j++) { + pt1=g[j]; + pt2=g[k]; + qt1=h[j]; + qt2=h[k]; + g[j]=pt1-pp*qt2; + g[k]=pt2-pp*qt1; + h[j]=qt1-qq*pt2; + h[k--]=qt2-qq*pt1; + } + } + nrerror("toeplz - should not arrive here!"); +} +#undef FREERETURN diff --git a/lib/nr/k_and_r/recipes/tptest.c b/lib/nr/k_and_r/recipes/tptest.c new file mode 100644 index 0000000..4f9a665 --- /dev/null +++ b/lib/nr/k_and_r/recipes/tptest.c @@ -0,0 +1,21 @@ + +#include + +void tptest(data1,data2,n,t,prob) +float *prob,*t,data1[],data2[]; +unsigned long n; +{ + float betai(); + void avevar(); + unsigned long j; + float var1,var2,ave1,ave2,sd,df,cov=0.0; + + avevar(data1,n,&ave1,&var1); + avevar(data2,n,&ave2,&var2); + for (j=1;j<=n;j++) + cov += (data1[j]-ave1)*(data2[j]-ave2); + cov /= df=n-1; + sd=sqrt((var1+var2-2.0*cov)/n); + *t=(ave1-ave2)/sd; + *prob=betai(0.5*df,0.5,df/(df+(*t)*(*t))); +} diff --git a/lib/nr/k_and_r/recipes/tqli.c b/lib/nr/k_and_r/recipes/tqli.c new file mode 100644 index 0000000..7fcb39e --- /dev/null +++ b/lib/nr/k_and_r/recipes/tqli.c @@ -0,0 +1,57 @@ + +#include +#include "nrutil.h" + +void tqli(d,e,n,z) +float **z,d[],e[]; +int n; +{ + float pythag(); + int m,l,iter,i,k; + float s,r,p,g,f,dd,c,b; + + for (i=2;i<=n;i++) e[i-1]=e[i]; + e[n]=0.0; + for (l=1;l<=n;l++) { + iter=0; + do { + for (m=l;m<=n-1;m++) { + dd=fabs(d[m])+fabs(d[m+1]); + if ((float)(fabs(e[m])+dd) == dd) break; + } + if (m != l) { + if (iter++ == 30) nrerror("Too many iterations in tqli"); + g=(d[l+1]-d[l])/(2.0*e[l]); + r=pythag(g,1.0); + g=d[m]-d[l]+e[l]/(g+SIGN(r,g)); + s=c=1.0; + p=0.0; + for (i=m-1;i>=l;i--) { + f=s*e[i]; + b=c*e[i]; + e[i+1]=(r=pythag(f,g)); + if (r == 0.0) { + d[i+1] -= p; + e[m]=0.0; + break; + } + s=f/r; + c=g/r; + g=d[i+1]-p; + r=(d[i]-g)*s+2.0*c*b; + d[i+1]=g+(p=s*r); + g=c*r-b; + for (k=1;k<=n;k++) { + f=z[k][i+1]; + z[k][i+1]=s*z[k][i]+c*f; + z[k][i]=c*z[k][i]-s*f; + } + } + if (r == 0.0 && i >= l) continue; + d[l] -= p; + e[l]=g; + e[m]=0.0; + } + } while (m != l); + } +} diff --git a/lib/nr/k_and_r/recipes/trapzd.c b/lib/nr/k_and_r/recipes/trapzd.c new file mode 100644 index 0000000..5410d8a --- /dev/null +++ b/lib/nr/k_and_r/recipes/trapzd.c @@ -0,0 +1,24 @@ + +#define FUNC(x) ((*func)(x)) + +float trapzd(func,a,b,n) +float (*func)(),a,b; +int n; +{ + float x,tnm,sum,del; + static float s; + int it,j; + + if (n == 1) { + return (s=0.5*(b-a)*(FUNC(a)+FUNC(b))); + } else { + for (it=1,j=1;j + +void tred2(a,n,d,e) +float **a,d[],e[]; +int n; +{ + int l,k,j,i; + float scale,hh,h,g,f; + + for (i=n;i>=2;i--) { + l=i-1; + h=scale=0.0; + if (l > 1) { + for (k=1;k<=l;k++) + scale += fabs(a[i][k]); + if (scale == 0.0) + e[i]=a[i][l]; + else { + for (k=1;k<=l;k++) { + a[i][k] /= scale; + h += a[i][k]*a[i][k]; + } + f=a[i][l]; + g=(f >= 0.0 ? -sqrt(h) : sqrt(h)); + e[i]=scale*g; + h -= f*g; + a[i][l]=f-g; + f=0.0; + for (j=1;j<=l;j++) { + a[j][i]=a[i][j]/h; + g=0.0; + for (k=1;k<=j;k++) + g += a[j][k]*a[i][k]; + for (k=j+1;k<=l;k++) + g += a[k][j]*a[i][k]; + e[j]=g/h; + f += e[j]*a[i][j]; + } + hh=f/(h+h); + for (j=1;j<=l;j++) { + f=a[i][j]; + e[j]=g=e[j]-hh*f; + for (k=1;k<=j;k++) + a[j][k] -= (f*e[k]+g*a[i][k]); + } + } + } else + e[i]=a[i][l]; + d[i]=h; + } + d[1]=0.0; + e[1]=0.0; + /* Contents of this loop can be omitted if eigenvectors not + wanted except for statement d[i]=a[i][i]; */ + for (i=1;i<=n;i++) { + l=i-1; + if (d[i]) { + for (j=1;j<=l;j++) { + g=0.0; + for (k=1;k<=l;k++) + g += a[i][k]*a[k][j]; + for (k=1;k<=l;k++) + a[k][j] -= g*a[k][i]; + } + } + d[i]=a[i][i]; + a[i][i]=1.0; + for (j=1;j<=l;j++) a[j][i]=a[i][j]=0.0; + } +} diff --git a/lib/nr/k_and_r/recipes/tridag.c b/lib/nr/k_and_r/recipes/tridag.c new file mode 100644 index 0000000..db4a1b0 --- /dev/null +++ b/lib/nr/k_and_r/recipes/tridag.c @@ -0,0 +1,23 @@ + +#include "nrutil.h" + +void tridag(a,b,c,r,u,n) +float a[],b[],c[],r[],u[]; +unsigned long n; +{ + unsigned long j; + float bet,*gam; + + gam=vector(1,n); + if (b[1] == 0.0) nrerror("Error 1 in tridag"); + u[1]=r[1]/(bet=b[1]); + for (j=2;j<=n;j++) { + gam[j]=c[j-1]/bet; + bet=b[j]-a[j]*gam[j]; + if (bet == 0.0) nrerror("Error 2 in tridag"); + u[j]=(r[j]-a[j]*u[j-1])/bet; + } + for (j=(n-1);j>=1;j--) + u[j] -= gam[j+1]*u[j+1]; + free_vector(gam,1,n); +} diff --git a/lib/nr/k_and_r/recipes/trncst.c b/lib/nr/k_and_r/recipes/trncst.c new file mode 100644 index 0000000..9d6e3ad --- /dev/null +++ b/lib/nr/k_and_r/recipes/trncst.c @@ -0,0 +1,28 @@ + +#include +#define ALEN(a,b,c,d) sqrt(((b)-(a))*((b)-(a))+((d)-(c))*((d)-(c))) + +float trncst(x,y,iorder,ncity,n) +float x[],y[]; +int iorder[],n[],ncity; +{ + float xx[7],yy[7],de; + int j,ii; + + n[4]=1 + (n[3] % ncity); + n[5]=1 + ((n[1]+ncity-2) % ncity); + n[6]=1 + (n[2] % ncity); + for (j=1;j<=6;j++) { + ii=iorder[n[j]]; + xx[j]=x[ii]; + yy[j]=y[ii]; + } + de = -ALEN(xx[2],xx[6],yy[2],yy[6]); + de -= ALEN(xx[1],xx[5],yy[1],yy[5]); + de -= ALEN(xx[3],xx[4],yy[3],yy[4]); + de += ALEN(xx[1],xx[3],yy[1],yy[3]); + de += ALEN(xx[2],xx[4],yy[2],yy[4]); + de += ALEN(xx[5],xx[6],yy[5],yy[6]); + return de; +} +#undef ALEN diff --git a/lib/nr/k_and_r/recipes/trnspt.c b/lib/nr/k_and_r/recipes/trnspt.c new file mode 100644 index 0000000..72839b8 --- /dev/null +++ b/lib/nr/k_and_r/recipes/trnspt.c @@ -0,0 +1,29 @@ + +#include "nrutil.h" + +void trnspt(iorder,ncity,n) +int iorder[],n[],ncity; +{ + int m1,m2,m3,nn,j,jj,*jorder; + + jorder=ivector(1,ncity); + m1=1 + ((n[2]-n[1]+ncity) % ncity); + m2=1 + ((n[5]-n[4]+ncity) % ncity); + m3=1 + ((n[3]-n[6]+ncity) % ncity); + nn=1; + for (j=1;j<=m1;j++) { + jj=1 + ((j+n[1]-2) % ncity); + jorder[nn++]=iorder[jj]; + } + for (j=1;j<=m2;j++) { + jj=1+((j+n[4]-2) % ncity); + jorder[nn++]=iorder[jj]; + } + for (j=1;j<=m3;j++) { + jj=1 + ((j+n[6]-2) % ncity); + jorder[nn++]=iorder[jj]; + } + for (j=1;j<=ncity;j++) + iorder[j]=jorder[j]; + free_ivector(jorder,1,ncity); +} diff --git a/lib/nr/k_and_r/recipes/ttest.c b/lib/nr/k_and_r/recipes/ttest.c new file mode 100644 index 0000000..8688266 --- /dev/null +++ b/lib/nr/k_and_r/recipes/ttest.c @@ -0,0 +1,18 @@ + +#include + +void ttest(data1,n1,data2,n2,t,prob) +float *prob,*t,data1[],data2[]; +unsigned long n1,n2; +{ + float betai(); + void avevar(); + float var1,var2,svar,df,ave1,ave2; + + avevar(data1,n1,&ave1,&var1); + avevar(data2,n2,&ave2,&var2); + df=n1+n2-2; + svar=((n1-1)*var1+(n2-1)*var2)/df; + *t=(ave1-ave2)/sqrt(svar*(1.0/n1+1.0/n2)); + *prob=betai(0.5*df,0.5,df/(df+(*t)*(*t))); +} diff --git a/lib/nr/k_and_r/recipes/tutest.c b/lib/nr/k_and_r/recipes/tutest.c new file mode 100644 index 0000000..dc49ec3 --- /dev/null +++ b/lib/nr/k_and_r/recipes/tutest.c @@ -0,0 +1,18 @@ + +#include +#include "nrutil.h" + +void tutest(data1,n1,data2,n2,t,prob) +float *prob,*t,data1[],data2[]; +unsigned long n1,n2; +{ + float betai(); + void avevar(); + float var1,var2,df,ave1,ave2; + + avevar(data1,n1,&ave1,&var1); + avevar(data2,n2,&ave2,&var2); + *t=(ave1-ave2)/sqrt(var1/n1+var2/n2); + df=SQR(var1/n1+var2/n2)/(SQR(var1/n1)/(n1-1)+SQR(var2/n2)/(n2-1)); + *prob=betai(0.5*df,0.5,df/(df+SQR(*t))); +} diff --git a/lib/nr/k_and_r/recipes/twofft.c b/lib/nr/k_and_r/recipes/twofft.c new file mode 100644 index 0000000..ad6809a --- /dev/null +++ b/lib/nr/k_and_r/recipes/twofft.c @@ -0,0 +1,32 @@ + +void twofft(data1,data2,fft1,fft2,n) +float data1[],data2[],fft1[],fft2[]; +unsigned long n; +{ + void four1(); + unsigned long nn3,nn2,jj,j; + float rep,rem,aip,aim; + + nn3=1+(nn2=2+n+n); + for (j=1,jj=2;j<=n;j++,jj+=2) { + fft1[jj-1]=data1[j]; + fft1[jj]=data2[j]; + } + four1(fft1,n,1); + fft2[1]=fft1[2]; + fft1[2]=fft2[2]=0.0; + for (j=3;j<=n+1;j+=2) { + rep=0.5*(fft1[j]+fft1[nn2-j]); + rem=0.5*(fft1[j]-fft1[nn2-j]); + aip=0.5*(fft1[j+1]+fft1[nn3-j]); + aim=0.5*(fft1[j+1]-fft1[nn3-j]); + fft1[j]=rep; + fft1[j+1]=aim; + fft1[nn2-j]=rep; + fft1[nn3-j] = -aim; + fft2[j]=aip; + fft2[j+1] = -rem; + fft2[nn2-j]=aip; + fft2[nn3-j]=rem; + } +} diff --git a/lib/nr/k_and_r/recipes/vander.c b/lib/nr/k_and_r/recipes/vander.c new file mode 100644 index 0000000..31dc661 --- /dev/null +++ b/lib/nr/k_and_r/recipes/vander.c @@ -0,0 +1,35 @@ + +#include "nrutil.h" + +void vander(x,w,q,n) +double q[],w[],x[]; +int n; +{ + int i,j,k; + double b,s,t,xx; + double *c; + + c=dvector(1,n); + if (n == 1) w[1]=q[1]; + else { + for (i=1;i<=n;i++) c[i]=0.0; + c[n] = -x[1]; + for (i=2;i<=n;i++) { + xx = -x[i]; + for (j=(n+1-i);j<=(n-1);j++) c[j] += xx*c[j+1]; + c[n] += xx; + } + for (i=1;i<=n;i++) { + xx=x[i]; + t=b=1.0; + s=q[n]; + for (k=n;k>=2;k--) { + b=c[k]+xx*b; + s += q[k-1]*b; + t=xx*t+b; + } + w[i]=s/t; + } + } + free_dvector(c,1,n); +} diff --git a/lib/nr/k_and_r/recipes/vegas.c b/lib/nr/k_and_r/recipes/vegas.c new file mode 100644 index 0000000..3d346cc --- /dev/null +++ b/lib/nr/k_and_r/recipes/vegas.c @@ -0,0 +1,177 @@ + +#include +#include +#include "nrutil.h" +#define ALPH 1.5 +#define NDMX 50 +#define MXDIM 10 +#define TINY 1.0e-30 + +extern long idum; + +void vegas(regn,ndim,fxn,init,ncall,itmx,nprn,tgral,sd,chi2a) +float (*fxn)(),*chi2a,*sd,*tgral,regn[]; +int init,itmx,ndim,nprn; +unsigned long ncall; +{ + float ran2(); + void rebin(); + static int i,it,j,k,mds,nd,ndo,ng,npg,ia[MXDIM+1],kg[MXDIM+1]; + static float calls,dv2g,dxg,f,f2,f2b,fb,rc,ti,tsi,wgt,xjac,xn,xnd,xo; + static float d[NDMX+1][MXDIM+1],di[NDMX+1][MXDIM+1],dt[MXDIM+1], + dx[MXDIM+1], r[NDMX+1],x[MXDIM+1],xi[MXDIM+1][NDMX+1],xin[NDMX+1]; + static double schi,si,swgt; + + if (init <= 0) { + mds=ndo=1; + for (j=1;j<=ndim;j++) xi[j][1]=1.0; + } + if (init <= 1) si=swgt=schi=0.0; + if (init <= 2) { + nd=NDMX; + ng=1; + if (mds) { + ng=(int)pow(ncall/2.0+0.25,1.0/ndim); + mds=1; + if ((2*ng-NDMX) >= 0) { + mds = -1; + npg=ng/NDMX+1; + nd=ng/npg; + ng=npg*nd; + } + } + for (k=1,i=1;i<=ndim;i++) k *= ng; + npg=IMAX(ncall/k,2); + calls=(float)npg * (float)k; + dxg=1.0/ng; + for (dv2g=1,i=1;i<=ndim;i++) dv2g *= dxg; + dv2g=SQR(calls*dv2g)/npg/npg/(npg-1.0); + xnd=nd; + dxg *= xnd; + xjac=1.0/calls; + for (j=1;j<=ndim;j++) { + dx[j]=regn[j+ndim]-regn[j]; + xjac *= dx[j]; + } + if (nd != ndo) { + for (i=1;i<=IMAX(nd,ndo);i++) r[i]=1.0; + for (j=1;j<=ndim;j++) rebin(ndo/xnd,nd,r,xin,xi[j]); + ndo=nd; + } + if (nprn >= 0) { + printf("%s: ndim= %3d ncall= %8.0f\n", + " Input parameters for vegas",ndim,calls); + printf("%28s it=%5d itmx=%5d\n"," ",it,itmx); + printf("%28s nprn=%3d ALPH=%5.2f\n"," ",nprn,ALPH); + printf("%28s mds=%3d nd=%4d\n"," ",mds,nd); + for (j=1;j<=ndim;j++) { + printf("%30s xl[%2d]= %11.4g xu[%2d]= %11.4g\n", + " ",j,regn[j],j,regn[j+ndim]); + } + } + } + for (it=1;it<=itmx;it++) { + ti=tsi=0.0; + for (j=1;j<=ndim;j++) { + kg[j]=1; + for (i=1;i<=nd;i++) d[i][j]=di[i][j]=0.0; + } + for (;;) { + fb=f2b=0.0; + for (k=1;k<=npg;k++) { + wgt=xjac; + for (j=1;j<=ndim;j++) { + xn=(kg[j]-ran2(&idum))*dxg+1.0; + ia[j]=IMAX(IMIN((int)(xn),NDMX),1); + if (ia[j] > 1) { + xo=xi[j][ia[j]]-xi[j][ia[j]-1]; + rc=xi[j][ia[j]-1]+(xn-ia[j])*xo; + } else { + xo=xi[j][ia[j]]; + rc=(xn-ia[j])*xo; + } + x[j]=regn[j]+rc*dx[j]; + wgt *= xo*xnd; + } + f=wgt*(*fxn)(x,wgt); + f2=f*f; + fb += f; + f2b += f2; + for (j=1;j<=ndim;j++) { + di[ia[j]][j] += f; + if (mds >= 0) d[ia[j]][j] += f2; + } + } + f2b=sqrt(f2b*npg); + f2b=(f2b-fb)*(f2b+fb); + if (f2b <= 0.0) f2b=TINY; + ti += fb; + tsi += f2b; + if (mds < 0) { + for (j=1;j<=ndim;j++) d[ia[j]][j] += f2b; + } + for (k=ndim;k>=1;k--) { + kg[k] %= ng; + if (++kg[k] != 1) break; + } + if (k < 1) break; + } + tsi *= dv2g; + wgt=1.0/tsi; + si += wgt*ti; + schi += wgt*ti*ti; + swgt += wgt; + *tgral=si/swgt; + *chi2a=(schi-si*(*tgral))/(it-0.9999); + if (*chi2a < 0.0) *chi2a = 0.0; + *sd=sqrt(1.0/swgt); + tsi=sqrt(tsi); + if (nprn >= 0) { + printf("%s %3d : integral = %14.7g +/- %9.2g\n", + " iteration no.",it,ti,tsi); + printf("%s integral =%14.7g+/-%9.2g chi**2/IT n = %9.2g\n", + " all iterations: ",*tgral,*sd,*chi2a); + if (nprn) { + for (j=1;j<=ndim;j++) { + printf(" DATA FOR axis %2d\n",j); + printf("%6s%13s%11s%13s%11s%13s\n", + "X","delta i","X","delta i","X","delta i"); + for (i=1+nprn/2;i<=nd;i += nprn+2) { + printf("%8.5f%12.4g%12.5f%12.4g%12.5f%12.4g\n", + xi[j][i],di[i][j],xi[j][i+1], + di[i+1][j],xi[j][i+2],di[i+2][j]); + } + } + } + } + for (j=1;j<=ndim;j++) { + xo=d[1][j]; + xn=d[2][j]; + d[1][j]=(xo+xn)/2.0; + dt[j]=d[1][j]; + for (i=2;i= 0) { + for (nn=n;nn>=4;nn>>=1) (*wtstep)(a,nn,isign); + } else { + for (nn=4;nn<=n;nn<<=1) (*wtstep)(a,nn,isign); + } +} diff --git a/lib/nr/k_and_r/recipes/wtn.c b/lib/nr/k_and_r/recipes/wtn.c new file mode 100644 index 0000000..a21ab96 --- /dev/null +++ b/lib/nr/k_and_r/recipes/wtn.c @@ -0,0 +1,38 @@ + +#include "nrutil.h" + +void wtn(a,nn,ndim,isign,wtstep) +float a[]; +int isign,ndim; +unsigned long nn[]; +void (*wtstep)(); +{ + unsigned long i1,i2,i3,k,n,nnew,nprev=1,nt,ntot=1; + int idim; + float *wksp; + + for (idim=1;idim<=ndim;idim++) ntot *= nn[idim]; + wksp=vector(1,ntot); + for (idim=1;idim<=ndim;idim++) { + n=nn[idim]; + nnew=n*nprev; + if (n > 4) { + for (i2=0;i2= 0) { + for(nt=n;nt>=4;nt >>= 1) + (*wtstep)(wksp,nt,isign); + } else { + for(nt=4;nt<=n;nt <<= 1) + (*wtstep)(wksp,nt,isign); + } + + for (i3=i1+i2,k=1;k<=n;k++,i3+=nprev) a[i3]=wksp[k]; + } + } + } + nprev=nnew; + } + free_vector(wksp,1,ntot); +} diff --git a/lib/nr/k_and_r/recipes/wwghts.c b/lib/nr/k_and_r/recipes/wwghts.c new file mode 100644 index 0000000..92ca888 --- /dev/null +++ b/lib/nr/k_and_r/recipes/wwghts.c @@ -0,0 +1,54 @@ + +void wwghts(wghts,n,h,kermom) +float h,wghts[]; +int n; +void (*kermom)(); +{ + int j,k; + double wold[5],wnew[5],w[5],hh,hi,c,fac,a,b; + + hh=h; + hi=1.0/hh; + for (j=1;j<=n;j++) wghts[j]=0.0; + (*kermom)(wold,0.0,4); + if (n >= 4) { + b=0.0; + for (j=1;j<=n-3;j++) { + c=j-1; + a=b; + b=a+hh; + if (j == n-3) b=(n-1)*hh; + (*kermom)(wnew,b,4); + for (fac=1.0,k=1;k<=4;k++,fac*=hi) + w[k]=(wnew[k]-wold[k])*fac; + wghts[j] += ( + ((c+1.0)*(c+2.0)*(c+3.0)*w[1] + -(11.0+c*(12.0+c*3.0))*w[2] + +3.0*(c+2.0)*w[3]-w[4])/6.0); + wghts[j+1] += ( + (-c*(c+2.0)*(c+3.0)*w[1] + +(6.0+c*(10.0+c*3.0))*w[2] + -(3.0*c+5.0)*w[3]+w[4])*0.5); + wghts[j+2] += ( + (c*(c+1.0)*(c+3.0)*w[1] + -(3.0+c*(8.0+c*3.0))*w[2] + +(3.0*c+4.0)*w[3]-w[4])*0.5); + wghts[j+3] += ( + (-c*(c+1.0)*(c+2.0)*w[1] + +(2.0+c*(6.0+c*3.0))*w[2] + -3.0*(c+1.0)*w[3]+w[4])/6.0); + for (k=1;k<=4;k++) wold[k]=wnew[k]; + } + } else if (n == 3) { + (*kermom)(wnew,hh+hh,3); + w[1]=wnew[1]-wold[1]; + w[2]=hi*(wnew[2]-wold[2]); + w[3]=hi*hi*(wnew[3]-wold[3]); + wghts[1]=w[1]-1.5*w[2]+0.5*w[3]; + wghts[2]=2.0*w[2]-w[3]; + wghts[3]=0.5*(w[3]-w[2]); + } else if (n == 2) { + (*kermom)(wnew,hh,2); + wghts[1]=wnew[1]-wold[1]-(wghts[2]=hi*(wnew[2]-wold[2])); + } +} diff --git a/lib/nr/k_and_r/recipes/zbrac.c b/lib/nr/k_and_r/recipes/zbrac.c new file mode 100644 index 0000000..2505833 --- /dev/null +++ b/lib/nr/k_and_r/recipes/zbrac.c @@ -0,0 +1,26 @@ + +#include +#define FACTOR 1.6 +#define NTRY 50 + +int zbrac(func,x1,x2) +float (*func)(),*x1,*x2; +{ + void nrerror(); + int j; + float f1,f2; + + if (*x1 == *x2) nrerror("Bad initial range in zbrac"); + f1=(*func)(*x1); + f2=(*func)(*x2); + for (j=1;j<=NTRY;j++) { + if (f1*f2 < 0.0) return 1; + if (fabs(f1) < fabs(f2)) + f1=(*func)(*x1 += FACTOR*(*x1-*x2)); + else + f2=(*func)(*x2 += FACTOR*(*x2-*x1)); + } + return 0; +} +#undef FACTOR +#undef NTRY diff --git a/lib/nr/k_and_r/recipes/zbrak.c b/lib/nr/k_and_r/recipes/zbrak.c new file mode 100644 index 0000000..817ded3 --- /dev/null +++ b/lib/nr/k_and_r/recipes/zbrak.c @@ -0,0 +1,23 @@ + +void zbrak(fx,x1,x2,n,xb1,xb2,nb) +float (*fx)(),x1,x2,xb1[],xb2[]; +int *nb,n; +{ + int nbb,i; + float x,fp,fc,dx; + + nbb=0; + dx=(x2-x1)/n; + fp=(*fx)(x=x1); + for (i=1;i<=n;i++) { + fc=(*fx)(x += dx); + if (fc*fp <= 0.0) { + xb1[++nbb]=x-dx; + xb2[nbb]=x; + if(*nb == nbb) return; + + } + fp=fc; + } + *nb = nbb; +} diff --git a/lib/nr/k_and_r/recipes/zbrent.c b/lib/nr/k_and_r/recipes/zbrent.c new file mode 100644 index 0000000..4c71b85 --- /dev/null +++ b/lib/nr/k_and_r/recipes/zbrent.c @@ -0,0 +1,72 @@ + +#include +#include "nrutil.h" +#define ITMAX 100 +#define EPS 3.0e-8 + +float zbrent(func,x1,x2,tol) +float (*func)(),tol,x1,x2; +{ + int iter; + float a=x1,b=x2,c=x2,d,e,min1,min2; + float fa=(*func)(a),fb=(*func)(b),fc,p,q,r,s,tol1,xm; + + if ((fa > 0.0 && fb > 0.0) || (fa < 0.0 && fb < 0.0)) + nrerror("Root must be bracketed in zbrent"); + fc=fb; + for (iter=1;iter<=ITMAX;iter++) { + if ((fb > 0.0 && fc > 0.0) || (fb < 0.0 && fc < 0.0)) { + c=a; + fc=fa; + e=d=b-a; + } + if (fabs(fc) < fabs(fb)) { + a=b; + b=c; + c=a; + fa=fb; + fb=fc; + fc=fa; + } + tol1=2.0*EPS*fabs(b)+0.5*tol; + xm=0.5*(c-b); + if (fabs(xm) <= tol1 || fb == 0.0) return b; + if (fabs(e) >= tol1 && fabs(fa) > fabs(fb)) { + s=fb/fa; + if (a == c) { + p=2.0*xm*s; + q=1.0-s; + } else { + q=fa/fc; + r=fb/fc; + p=s*(2.0*xm*q*(q-r)-(b-a)*(r-1.0)); + q=(q-1.0)*(r-1.0)*(s-1.0); + } + if (p > 0.0) q = -q; + p=fabs(p); + min1=3.0*xm*q-fabs(tol1*q); + min2=fabs(e*q); + if (2.0*p < (min1 < min2 ? min1 : min2)) { + e=d; + d=p/q; + } else { + d=xm; + e=d; + } + } else { + d=xm; + e=d; + } + a=b; + fa=fb; + if (fabs(d) > tol1) + b += d; + else + b += SIGN(tol1,xm); + fb=(*func)(b); + } + nrerror("Maximum number of iterations exceeded in zbrent"); + return 0.0; +} +#undef ITMAX +#undef EPS diff --git a/lib/nr/k_and_r/recipes/zrhqr.c b/lib/nr/k_and_r/recipes/zrhqr.c new file mode 100644 index 0000000..0f6e4b7 --- /dev/null +++ b/lib/nr/k_and_r/recipes/zrhqr.c @@ -0,0 +1,35 @@ + +#include "nrutil.h" +#define MAXM 50 + +void zrhqr(a,m,rtr,rti) +float a[],rti[],rtr[]; +int m; +{ + void balanc(),hqr(); + int j,k; + float **hess,xr,xi; + + hess=matrix(1,MAXM,1,MAXM); + if (m > MAXM || a[m] == 0.0) nrerror("bad args in zrhqr"); + for (k=1;k<=m;k++) { + hess[1][k] = -a[m-k]/a[m]; + for (j=2;j<=m;j++) hess[j][k]=0.0; + if (k != m) hess[k+1][k]=1.0; + } + balanc(hess,m); + hqr(hess,m,rtr,rti); + for (j=2;j<=m;j++) { + xr=rtr[j]; + xi=rti[j]; + for (k=j-1;k>=1;k--) { + if (rtr[k] <= xr) break; + rtr[k+1]=rtr[k]; + rti[k+1]=rti[k]; + } + rtr[k+1]=xr; + rti[k+1]=xi; + } + free_matrix(hess,1,MAXM,1,MAXM); +} +#undef MAXM diff --git a/lib/nr/k_and_r/recipes/zriddr.c b/lib/nr/k_and_r/recipes/zriddr.c new file mode 100644 index 0000000..8c06cf0 --- /dev/null +++ b/lib/nr/k_and_r/recipes/zriddr.c @@ -0,0 +1,53 @@ + +#include +#include "nrutil.h" +#define MAXIT 60 +#define UNUSED (-1.11e30) + +float zriddr(func,x1,x2,xacc) +float (*func)(),x1,x2,xacc; +{ + int j; + float ans,fh,fl,fm,fnew,s,xh,xl,xm,xnew; + + fl=(*func)(x1); + fh=(*func)(x2); + if ((fl > 0.0 && fh < 0.0) || (fl < 0.0 && fh > 0.0)) { + xl=x1; + xh=x2; + ans=UNUSED; + for (j=1;j<=MAXIT;j++) { + xm=0.5*(xl+xh); + fm=(*func)(xm); + s=sqrt(fm*fm-fl*fh); + if (s == 0.0) return ans; + xnew=xm+(xm-xl)*((fl >= fh ? 1.0 : -1.0)*fm/s); + if (fabs(xnew-ans) <= xacc) return ans; + ans=xnew; + fnew=(*func)(ans); + if (fnew == 0.0) return ans; + if (SIGN(fm,fnew) != fm) { + xl=xm; + fl=fm; + xh=ans; + fh=fnew; + } else if (SIGN(fl,fnew) != fl) { + xh=ans; + fh=fnew; + } else if (SIGN(fh,fnew) != fh) { + xl=ans; + fl=fnew; + } else nrerror("never get here."); + if (fabs(xh-xl) <= xacc) return ans; + } + nrerror("zriddr exceed maximum iterations"); + } + else { + if (fl == 0.0) return x1; + if (fh == 0.0) return x2; + nrerror("root must be bracketed in zriddr."); + } + return 0.0; +} +#undef MAXIT +#undef UNUSED diff --git a/lib/nr/k_and_r/recipes/zroots.c b/lib/nr/k_and_r/recipes/zroots.c new file mode 100644 index 0000000..b6e30c5 --- /dev/null +++ b/lib/nr/k_and_r/recipes/zroots.c @@ -0,0 +1,41 @@ + +#include +#include "complex.h" +#define EPS 2.0e-6 +#define MAXM 100 + +void zroots(a,m,roots,polish) +fcomplex a[],roots[]; +int m,polish; +{ + void laguer(); + int i,its,j,jj; + fcomplex x,b,c,ad[MAXM]; + + for (j=0;j<=m;j++) ad[j]=a[j]; + for (j=m;j>=1;j--) { + x=Complex(0.0,0.0); + laguer(ad,j,&x,&its); + if (fabs(x.i) <= 2.0*EPS*fabs(x.r)) x.i=0.0; + roots[j]=x; + b=ad[j]; + for (jj=j-1;jj>=0;jj--) { + c=ad[jj]; + ad[jj]=b; + b=Cadd(Cmul(x,b),c); + } + } + if (polish) + for (j=1;j<=m;j++) + laguer(a,m,&roots[j],&its); + for (j=2;j<=m;j++) { + x=roots[j]; + for (i=j-1;i>=1;i--) { + if (roots[i].r <= x.r) break; + roots[i+1]=roots[i]; + } + roots[i+1]=x; + } +} +#undef EPS +#undef MAXM