Remove modules
parent
4f6fb13ff2
commit
02511aebc2
@ -1,3 +0,0 @@
|
||||
from __future__ import absolute_import
|
||||
from .info import __doc__
|
||||
from .info import *
|
||||
@ -1,582 +0,0 @@
|
||||
5.4829629629629641e+00
|
||||
4.3614999999999986e+00
|
||||
5.2602325581395339e+00
|
||||
3.0619230769230770e+00
|
||||
4.4896296296296301e+00
|
||||
3.3681395348837206e+00
|
||||
4.0259523809523818e+00
|
||||
4.3966666666666665e+00
|
||||
4.2999999999999998e+00
|
||||
7.0564705882352934e+00
|
||||
6.1440000000000001e+00
|
||||
4.3543243243243239e+00
|
||||
4.3595121951219520e+00
|
||||
7.1674999999999995e+00
|
||||
6.0100000000000007e+00
|
||||
3.8176923076923064e+00
|
||||
3.8862962962962957e+00
|
||||
4.4436363636363652e+00
|
||||
4.8211111111111098e+00
|
||||
7.1261904761904749e+00
|
||||
3.7118181818181823e+00
|
||||
8.1500000000000004e+00
|
||||
7.7725000000000000e+00
|
||||
4.5788000000000011e+00
|
||||
4.1022222222222222e+00
|
||||
5.2209756097560973e+00
|
||||
5.7300000000000004e+00
|
||||
2.7129629629629628e+00
|
||||
2.4211111111111108e+00
|
||||
2.8095454545454532e+00
|
||||
2.4837209302325594e+00
|
||||
2.4050000000000002e+00
|
||||
4.2750000000000004e+00
|
||||
3.9422222222222221e+00
|
||||
3.8742307692307696e+00
|
||||
2.3256818181818173e+00
|
||||
2.6061538461538465e+00
|
||||
3.0470370370370370e+00
|
||||
1.8579545454545447e+00
|
||||
4.8434090909090912e+00
|
||||
4.7172093023255792e+00
|
||||
2.9300000000000002e+00
|
||||
3.2725000000000000e+00
|
||||
5.7482608695652173e+00
|
||||
4.5774074074074083e+00
|
||||
5.3236363636363633e+00
|
||||
5.9372499999999988e+00
|
||||
5.0633333333333335e+00
|
||||
7.6900000000000004e+00
|
||||
4.9976923076923079e+00
|
||||
5.0788888888888879e+00
|
||||
4.1337209302325579e+00
|
||||
4.6752272727272706e+00
|
||||
2.1450000000000000e+00
|
||||
2.9566666666666670e+00
|
||||
1.1678124999999998e+01
|
||||
1.0795000000000000e+01
|
||||
6.3430000000000009e+00
|
||||
5.9580952380952388e+00
|
||||
9.2199999999999989e+00
|
||||
6.3524999999999991e+00
|
||||
6.3756000000000004e+00
|
||||
7.0014285714285718e+00
|
||||
5.0088372093023246e+00
|
||||
6.2643243243243232e+00
|
||||
6.1133333333333333e+00
|
||||
5.3249999999999993e+00
|
||||
2.7474074074074073e+00
|
||||
4.6804545454545430e+00
|
||||
5.7633333333333336e+00
|
||||
5.0625000000000000e+00
|
||||
4.9824999999999999e+00
|
||||
6.3411999999999997e+00
|
||||
4.5371428571428583e+00
|
||||
3.5171428571428587e+00
|
||||
3.1532558139534879e+00
|
||||
5.2366666666666664e+00
|
||||
5.1399999999999988e+00
|
||||
8.4735714285714288e+00
|
||||
7.1446666666666658e+00
|
||||
3.5134090909090903e+00
|
||||
2.9665909090909079e+00
|
||||
6.0766666666666671e+00
|
||||
3.8666666666666667e+00
|
||||
4.9534615384615384e+00
|
||||
4.8718518518518508e+00
|
||||
4.8771428571428563e+00
|
||||
6.2160975609756104e+00
|
||||
6.8499999999999996e+00
|
||||
4.2533333333333330e+00
|
||||
4.9648148148148143e+00
|
||||
4.9369230769230761e+00
|
||||
5.1770833333333330e+00
|
||||
3.1988372093023254e+00
|
||||
3.6213636363636370e+00
|
||||
9.4099999999999984e+00
|
||||
7.7975000000000003e+00
|
||||
6.8578947368421055e+00
|
||||
7.5875000000000004e+00
|
||||
1.9634090909090893e+00
|
||||
2.4779545454545455e+00
|
||||
5.7725000000000000e+00
|
||||
5.6566666666666663e+00
|
||||
3.5634615384615382e+00
|
||||
3.4437037037037039e+00
|
||||
2.9709090909090894e+00
|
||||
2.8075000000000006e+00
|
||||
5.7266666666666666e+00
|
||||
5.0633333333333335e+00
|
||||
5.6592307692307688e+00
|
||||
4.8769230769230765e+00
|
||||
4.5544186046511639e+00
|
||||
5.0542105263157877e+00
|
||||
8.0066666666666677e+00
|
||||
6.9049999999999994e+00
|
||||
3.1661538461538474e+00
|
||||
2.7900000000000000e+00
|
||||
2.2986363636363647e+00
|
||||
2.8874418604651164e+00
|
||||
3.5874999999999999e+00
|
||||
4.4849999999999994e+00
|
||||
9.3166666666666682e+00
|
||||
9.7884615384615401e+00
|
||||
3.9845454545454548e+00
|
||||
3.8721052631578958e+00
|
||||
4.7133333333333338e+00
|
||||
3.8250000000000002e+00
|
||||
4.3996153846153847e+00
|
||||
3.8052000000000006e+00
|
||||
4.9980952380952370e+00
|
||||
4.2854545454545452e+00
|
||||
3.9000000000000004e+00
|
||||
3.5349999999999997e+00
|
||||
2.4480769230769228e+00
|
||||
3.1014814814814819e+00
|
||||
8.3771428571428572e+00
|
||||
9.8775000000000013e+00
|
||||
3.9299999999999997e+00
|
||||
5.6400000000000006e+00
|
||||
9.2333333333333343e+00
|
||||
7.3440909090909097e+00
|
||||
5.8252380952380962e+00
|
||||
6.1797674418604664e+00
|
||||
4.2533333333333330e+00
|
||||
4.2750000000000004e+00
|
||||
4.2941666666666665e+00
|
||||
4.6457692307692309e+00
|
||||
4.7833333333333332e+00
|
||||
3.3774999999999995e+00
|
||||
3.2266666666666675e+00
|
||||
2.3244444444444445e+00
|
||||
2.4297674418604669e+00
|
||||
2.5704761904761906e+00
|
||||
2.6066666666666669e+00
|
||||
2.1533333333333333e+00
|
||||
3.3025925925925925e+00
|
||||
3.0223809523809528e+00
|
||||
5.0890697674418597e+00
|
||||
4.8595348837209293e+00
|
||||
3.8475000000000001e+00
|
||||
4.0325000000000006e+00
|
||||
4.7977777777777764e+00
|
||||
4.2389285714285716e+00
|
||||
4.8243902439024371e+00
|
||||
6.7746666666666640e+00
|
||||
4.9933333333333332e+00
|
||||
1.2701333333333332e+01
|
||||
1.0377999999999998e+01
|
||||
9.7267999999999990e+00
|
||||
6.4125581395348812e+00
|
||||
3.2033333333333331e+00
|
||||
5.6233333333333340e+00
|
||||
2.8969999999999989e+00
|
||||
8.4913793103448274e+00
|
||||
5.1333333333333329e+00
|
||||
4.6433333333333335e+00
|
||||
2.9820000000000007e+00
|
||||
2.6970370370370373e+00
|
||||
2.9765909090909086e+00
|
||||
3.3188372093023251e+00
|
||||
4.4299999999999997e+00
|
||||
3.7174999999999998e+00
|
||||
4.2815384615384611e+00
|
||||
3.6144444444444441e+00
|
||||
3.9388095238095255e+00
|
||||
3.8513953488372095e+00
|
||||
4.3999999999999995e+00
|
||||
4.6066666666666665e+00
|
||||
4.5448148148148153e+00
|
||||
5.7560000000000002e+00
|
||||
5.3117857142857128e+00
|
||||
2.5165909090909095e+00
|
||||
2.8383720930232559e+00
|
||||
3.8250000000000002e+00
|
||||
6.2425000000000006e+00
|
||||
3.9725925925925933e+00
|
||||
3.7232142857142856e+00
|
||||
4.3255813953488396e+00
|
||||
4.5230952380952374e+00
|
||||
4.6066666666666665e+00
|
||||
4.2233333333333336e+00
|
||||
4.4750000000000014e+00
|
||||
4.5025925925925936e+00
|
||||
5.7267500000000009e+00
|
||||
6.3217647058823534e+00
|
||||
4.0433333333333339e+00
|
||||
4.2074999999999996e+00
|
||||
5.2319230769230769e+00
|
||||
5.7133333333333338e+00
|
||||
1.9861363636363627e+00
|
||||
2.6293181818181823e+00
|
||||
4.6733333333333329e+00
|
||||
6.7050000000000001e+00
|
||||
3.8875999999999999e+00
|
||||
5.0888000000000000e+00
|
||||
5.5153488372093014e+00
|
||||
7.4194444444444452e+00
|
||||
6.1099999999999994e+00
|
||||
5.3824999999999994e+00
|
||||
4.2187499999999991e+00
|
||||
3.8128571428571418e+00
|
||||
3.4400000000000004e+00
|
||||
4.1067441860465115e+00
|
||||
2.6999999999999997e+00
|
||||
2.8600000000000003e+00
|
||||
4.0196153846153839e+00
|
||||
3.8457692307692311e+00
|
||||
3.8817948717948707e+00
|
||||
3.7552272727272711e+00
|
||||
7.4275000000000002e+00
|
||||
8.6899999999999995e+00
|
||||
6.4753846153846162e+00
|
||||
6.0141666666666653e+00
|
||||
8.0438235294117675e+00
|
||||
5.9988235294117649e+00
|
||||
6.7933333333333339e+00
|
||||
3.1400000000000001e+00
|
||||
3.3200000000000003e+00
|
||||
4.1522222222222203e+00
|
||||
3.8577777777777786e+00
|
||||
3.3722727272727266e+00
|
||||
3.3793181818181810e+00
|
||||
4.2266666666666666e+00
|
||||
3.5549999999999997e+00
|
||||
4.5107407407407401e+00
|
||||
3.5775000000000001e+00
|
||||
6.9528571428571420e+00
|
||||
6.0760526315789498e+00
|
||||
4.3299999999999992e+00
|
||||
3.0000000000000000e+00
|
||||
7.0819999999999981e+00
|
||||
6.2977777777777781e+00
|
||||
3.2575000000000003e+00
|
||||
3.5443181818181810e+00
|
||||
9.6750000000000007e+00
|
||||
8.2336363636363643e+00
|
||||
8.7376923076923081e+00
|
||||
8.5203448275862055e+00
|
||||
7.6451724137931034e+00
|
||||
3.8666666666666667e+00
|
||||
3.5866666666666673e+00
|
||||
4.9269230769230763e+00
|
||||
5.9090909090909101e+00
|
||||
4.4325000000000001e+00
|
||||
5.4964102564102548e+00
|
||||
2.8775000000000004e+00
|
||||
3.2966666666666669e+00
|
||||
2.5385185185185191e+00
|
||||
2.6122222222222224e+00
|
||||
4.2142222222222214e+00
|
||||
4.1902631578947371e+00
|
||||
4.6266666666666660e+00
|
||||
3.8533333333333335e+00
|
||||
8.4165000000000010e+00
|
||||
5.5291666666666659e+00
|
||||
2.3225581395348835e+00
|
||||
3.0686363636363638e+00
|
||||
4.0800000000000001e+00
|
||||
3.7133333333333329e+00
|
||||
5.5911538461538459e+00
|
||||
6.5222727272727266e+00
|
||||
3.6168181818181817e+00
|
||||
3.4525000000000015e+00
|
||||
3.1800000000000002e+00
|
||||
4.3366666666666669e+00
|
||||
4.1024999999999991e+00
|
||||
6.4061111111111115e+00
|
||||
6.1661904761904767e+00
|
||||
8.1230000000000011e+00
|
||||
5.8008571428571418e+00
|
||||
6.4733333333333336e+00
|
||||
1.0175000000000001e+01
|
||||
5.0976190476190473e+00
|
||||
5.2099999999999991e+00
|
||||
3.5631818181818171e+00
|
||||
4.1541860465116276e+00
|
||||
5.4874999999999998e+00
|
||||
6.9100000000000001e+00
|
||||
9.7192857142857143e+00
|
||||
9.8164285714285722e+00
|
||||
5.6602564102564097e+00
|
||||
8.7630769230769214e+00
|
||||
1.0220000000000001e+01
|
||||
1.0695000000000000e+01
|
||||
3.3466666666666676e+00
|
||||
3.4067857142857143e+00
|
||||
3.1056818181818184e+00
|
||||
3.2893023255813940e+00
|
||||
5.6650000000000009e+00
|
||||
6.1125000000000007e+00
|
||||
9.8085714285714314e+00
|
||||
1.2693333333333333e+01
|
||||
6.8272222222222219e+00
|
||||
5.9281249999999996e+00
|
||||
4.7619999999999996e+00
|
||||
3.9049999999999998e+00
|
||||
6.0947500000000012e+00
|
||||
5.3353333333333337e+00
|
||||
4.9464705882352931e+00
|
||||
2.7939999999999992e+00
|
||||
3.6475000000000000e+00
|
||||
4.0997222222222245e+00
|
||||
4.8644444444444437e+00
|
||||
5.6488235294117644e+00
|
||||
7.6616666666666688e+00
|
||||
3.9233333333333325e+00
|
||||
4.2925806451612898e+00
|
||||
5.9369565217391322e+00
|
||||
5.0370588235294118e+00
|
||||
3.7346666666666666e+00
|
||||
4.6871428571428577e+00
|
||||
6.2183333333333337e+00
|
||||
4.9388888888888873e+00
|
||||
3.6206249999999986e+00
|
||||
7.6308823529411747e+00
|
||||
4.7541176470588242e+00
|
||||
4.6737209302325571e+00
|
||||
4.8757142857142863e+00
|
||||
6.9187179487179495e+00
|
||||
6.2716666666666656e+00
|
||||
3.2473333333333332e+00
|
||||
2.9200000000000004e+00
|
||||
2.6910810810810815e+00
|
||||
4.6559090909090921e+00
|
||||
8.3445454545454538e+00
|
||||
4.6804545454545439e+00
|
||||
2.2156249999999997e+00
|
||||
1.9752941176470586e+00
|
||||
2.5693478260869576e+00
|
||||
2.1659999999999995e+00
|
||||
5.6924999999999999e+00
|
||||
4.6219444444444466e+00
|
||||
3.3962222222222200e+00
|
||||
3.8658823529411754e+00
|
||||
5.9802439024390246e+00
|
||||
5.5507142857142862e+00
|
||||
7.6572727272727281e+00
|
||||
7.2237837837837819e+00
|
||||
4.6305555555555564e+00
|
||||
3.9100000000000006e+00
|
||||
4.6493750000000000e+00
|
||||
5.5844444444444434e+00
|
||||
3.0119565217391302e+00
|
||||
6.4043750000000008e+00
|
||||
9.5586206896551715e+00
|
||||
7.2057142857142855e+00
|
||||
5.6258333333333317e+00
|
||||
5.7640476190476182e+00
|
||||
7.1963636363636363e+00
|
||||
5.6874418604651167e+00
|
||||
5.4273333333333342e+00
|
||||
6.0615151515151524e+00
|
||||
5.5800000000000018e+00
|
||||
4.1017647058823528e+00
|
||||
2.6497777777777776e+00
|
||||
5.2453333333333330e+00
|
||||
7.3470967741935489e+00
|
||||
4.3131818181818193e+00
|
||||
5.5653333333333324e+00
|
||||
7.0499999999999980e+00
|
||||
3.7619999999999991e+00
|
||||
5.0675757575757592e+00
|
||||
5.9769999999999985e+00
|
||||
6.7249999999999988e+00
|
||||
8.6042307692307691e+00
|
||||
3.5806666666666662e+00
|
||||
3.5815625000000004e+00
|
||||
3.7788636363636381e+00
|
||||
3.7358333333333325e+00
|
||||
5.1269565217391317e+00
|
||||
4.8678571428571429e+00
|
||||
5.5264705882352940e+00
|
||||
4.2017073170731711e+00
|
||||
3.7105882352941166e+00
|
||||
5.3206818181818178e+00
|
||||
2.9713333333333343e+00
|
||||
2.7563888888888886e+00
|
||||
7.6529629629629641e+00
|
||||
6.4521428571428556e+00
|
||||
5.8050000000000006e+00
|
||||
2.0128571428571429e+00
|
||||
4.2888888888888896e+00
|
||||
5.9328571428571450e+00
|
||||
1.0609999999999999e+01
|
||||
3.7197777777777770e+00
|
||||
3.1337500000000009e+00
|
||||
3.2837837837837829e+00
|
||||
4.4520000000000000e+00
|
||||
4.6988235294117651e+00
|
||||
5.7946511627906983e+00
|
||||
4.8130769230769230e+00
|
||||
5.3478125000000007e+00
|
||||
6.2370731707317066e+00
|
||||
7.8106249999999990e+00
|
||||
3.8891304347826114e+00
|
||||
2.3959999999999999e+00
|
||||
4.2005405405405414e+00
|
||||
4.7605128205128180e+00
|
||||
6.9815384615384621e+00
|
||||
9.1547058823529408e+00
|
||||
4.0542857142857134e+00
|
||||
3.8008333333333320e+00
|
||||
3.1255813953488385e+00
|
||||
4.2582352941176467e+00
|
||||
4.8453488372093014e+00
|
||||
5.1150000000000002e+00
|
||||
4.7213513513513510e+00
|
||||
3.4827272727272724e+00
|
||||
3.0505882352941178e+00
|
||||
2.7824444444444429e+00
|
||||
7.7399999999999993e+00
|
||||
1.0409130434782606e+01
|
||||
5.9644444444444451e+00
|
||||
1.0795999999999999e+01
|
||||
8.9992592592592597e+00
|
||||
6.3976923076923091e+00
|
||||
7.1279310344827573e+00
|
||||
4.2302272727272721e+00
|
||||
3.2905882352941180e+00
|
||||
4.7038636363636357e+00
|
||||
3.4220000000000002e+00
|
||||
4.2258823529411762e+00
|
||||
3.2204444444444449e+00
|
||||
2.4581249999999999e+00
|
||||
2.1877777777777769e+00
|
||||
2.1423913043478255e+00
|
||||
2.2755555555555547e+00
|
||||
3.2992857142857148e+00
|
||||
4.5726666666666667e+00
|
||||
4.4771428571428586e+00
|
||||
4.4768181818181816e+00
|
||||
4.5383333333333340e+00
|
||||
4.2769565217391312e+00
|
||||
4.6015384615384614e+00
|
||||
5.7247058823529393e+00
|
||||
4.9804444444444425e+00
|
||||
3.6694444444444434e+00
|
||||
1.1215238095238094e+01
|
||||
9.1850000000000005e+00
|
||||
5.3722222222222227e+00
|
||||
6.2425000000000042e+00
|
||||
7.3538461538461544e+00
|
||||
3.0506250000000006e+00
|
||||
7.5833333333333321e+00
|
||||
4.0663636363636355e+00
|
||||
3.4388235294117653e+00
|
||||
3.5664444444444445e+00
|
||||
3.0406666666666671e+00
|
||||
3.8337142857142852e+00
|
||||
3.7924444444444458e+00
|
||||
5.3774999999999986e+00
|
||||
4.4091111111111108e+00
|
||||
4.1324999999999994e+00
|
||||
3.8061111111111114e+00
|
||||
4.5399999999999991e+00
|
||||
3.6055555555555543e+00
|
||||
3.9333333333333367e+00
|
||||
7.2324324324324314e+00
|
||||
2.5419999999999998e+00
|
||||
3.4575675675675668e+00
|
||||
5.8765116279069751e+00
|
||||
9.4742857142857133e+00
|
||||
3.7115217391304345e+00
|
||||
4.8933333333333326e+00
|
||||
6.4018181818181805e+00
|
||||
4.4633333333333329e+00
|
||||
3.6568750000000003e+00
|
||||
4.3422727272727268e+00
|
||||
4.2013333333333325e+00
|
||||
4.1880555555555556e+00
|
||||
3.4113636363636362e+00
|
||||
4.9605882352941180e+00
|
||||
4.7213333333333320e+00
|
||||
2.1199999999999992e+00
|
||||
3.2251351351351345e+00
|
||||
7.0423333333333336e+00
|
||||
4.8461111111111101e+00
|
||||
3.5000000000000000e+00
|
||||
4.7093333333333343e+00
|
||||
6.8564516129032258e+00
|
||||
5.3060465116279092e+00
|
||||
3.3566666666666656e+00
|
||||
4.4884444444444425e+00
|
||||
3.9066666666666667e+00
|
||||
4.9237837837837830e+00
|
||||
2.8633333333333337e+00
|
||||
2.3141176470588238e+00
|
||||
3.9447727272727278e+00
|
||||
3.9740000000000006e+00
|
||||
3.1935135135135138e+00
|
||||
7.9008333333333338e+00
|
||||
1.2878000000000000e+01
|
||||
7.3702380952380944e+00
|
||||
8.6866666666666656e+00
|
||||
5.4328571428571442e+00
|
||||
5.2213953488372109e+00
|
||||
9.0155555555555562e+00
|
||||
3.6631707317073179e+00
|
||||
3.6888888888888900e+00
|
||||
4.1529545454545467e+00
|
||||
3.5973333333333337e+00
|
||||
3.4672972972972973e+00
|
||||
3.3593333333333320e+00
|
||||
3.2805882352941182e+00
|
||||
4.6777777777777771e+00
|
||||
6.9690909090909088e+00
|
||||
5.7182758620689640e+00
|
||||
2.7732608695652186e+00
|
||||
3.6272222222222235e+00
|
||||
6.5997368421052620e+00
|
||||
3.5273333333333339e+00
|
||||
3.3930555555555548e+00
|
||||
1.0433571428571428e+01
|
||||
9.1080000000000005e+00
|
||||
8.6382608695652188e+00
|
||||
8.7341666666666669e+00
|
||||
7.3107692307692300e+00
|
||||
3.3476744186046501e+00
|
||||
2.6300000000000003e+00
|
||||
4.5486666666666657e+00
|
||||
3.9621428571428572e+00
|
||||
5.5491176470588242e+00
|
||||
2.5150000000000010e+00
|
||||
2.5094444444444446e+00
|
||||
2.1204651162790711e+00
|
||||
4.4307142857142860e+00
|
||||
4.5968571428571421e+00
|
||||
5.1136585365853655e+00
|
||||
4.6394444444444449e+00
|
||||
6.1210000000000004e+00
|
||||
2.0293750000000004e+00
|
||||
3.0340540540540539e+00
|
||||
3.5041304347826112e+00
|
||||
3.1037499999999993e+00
|
||||
5.1755813953488401e+00
|
||||
3.9831250000000002e+00
|
||||
4.4294594594594594e+00
|
||||
4.3844444444444450e+00
|
||||
3.9411111111111108e+00
|
||||
6.6910526315789474e+00
|
||||
8.6833333333333318e+00
|
||||
5.3197058823529408e+00
|
||||
6.9751612903225810e+00
|
||||
5.9539999999999997e+00
|
||||
4.9557777777777785e+00
|
||||
3.4481250000000006e+00
|
||||
4.9451428571428577e+00
|
||||
6.9590322580645161e+00
|
||||
8.6592307692307688e+00
|
||||
8.1816666666666666e+00
|
||||
5.0956249999999992e+00
|
||||
8.1888000000000005e+00
|
||||
1.0237058823529411e+01
|
||||
5.3599999999999994e+00
|
||||
3.6475555555555559e+00
|
||||
3.2793333333333341e+00
|
||||
5.1406060606060597e+00
|
||||
5.8326190476190503e+00
|
||||
5.1949999999999985e+00
|
||||
1.0530500000000000e+01
|
||||
6.6633333333333340e+00
|
||||
5.4306060606060624e+00
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -1,485 +0,0 @@
|
||||
"""
|
||||
Data package in WAFO Toolbox.
|
||||
|
||||
Contents
|
||||
--------
|
||||
atlantic - Significant wave-height data recorded in the Atlantic Ocean
|
||||
gfaks89 - Surface elevation measured at Gullfaks C 24.12.1989
|
||||
gfaksr89 - Reconstructed surface elevation measured at Gullfaks C 24.12.1989.
|
||||
japansea - coastline map of The Japan Sea
|
||||
northsea - coastline map of The Nortsea
|
||||
sea - Surface elevation dataset used in WAT version 1.1.
|
||||
sfa89 - Wind measurements at Statfjord A 24.12.1989
|
||||
sn - Fatigue experiment, constant-amplitude loading.
|
||||
yura87 - Surface elevation measured off the coast of Yura
|
||||
|
||||
|
||||
|
||||
This module gives gives detailed information and easy access to all datasets
|
||||
included in WAFO
|
||||
|
||||
"""
|
||||
import numpy as np
|
||||
|
||||
import os
|
||||
__path2data = os.path.dirname(os.path.realpath(__file__))
|
||||
|
||||
__all__ = ['atlantic', 'gfaks89', 'gfaksr89', 'japansea', 'northsea', 'sea',
|
||||
'sfa89', 'sn', 'yura87']
|
||||
|
||||
_NANS = set(['nan', 'NaN', '-1.#IND00+00', '1.#IND00+00', '-1.#INF00+00'])
|
||||
|
||||
|
||||
def _tofloat(x):
|
||||
return np.nan if x in _NANS else float(x or 0)
|
||||
|
||||
|
||||
_MYCONVERTER = {}
|
||||
for i in range(2):
|
||||
_MYCONVERTER[i] = _tofloat
|
||||
|
||||
|
||||
def _load(file): # @ReservedAssignment
|
||||
""" local load function
|
||||
"""
|
||||
return np.loadtxt(os.path.join(__path2data, file))
|
||||
|
||||
|
||||
def _loadnan(file): # @ReservedAssignment
|
||||
""" local load function accepting nan's
|
||||
"""
|
||||
return np.loadtxt(os.path.join(__path2data, file), converters=_MYCONVERTER)
|
||||
|
||||
|
||||
def atlantic():
|
||||
"""
|
||||
Return Significant wave-height data recorded in the Atlantic Ocean
|
||||
|
||||
Data summary
|
||||
------------
|
||||
Size : 582 X 1
|
||||
Sampling Rate : ~ 14 times a month
|
||||
Device :
|
||||
Source :
|
||||
Format : ascii
|
||||
|
||||
Description
|
||||
------------
|
||||
atlantic.dat contains average significant wave-height data recorded
|
||||
approximately 14 times a month in December-February during 7 years and
|
||||
at 2 locations in the Atlantic Ocean
|
||||
|
||||
Example
|
||||
--------
|
||||
>>> import pylab
|
||||
>>> import wafo
|
||||
>>> Hs = wafo.data.atlantic()
|
||||
>>> np.allclose(Hs[:3], [ 5.48296296, 4.3615 , 5.26023256])
|
||||
True
|
||||
|
||||
h = pylab.plot(Hs)
|
||||
|
||||
Acknowledgement:
|
||||
---------------
|
||||
This dataset were made available by Dr. David Carter
|
||||
and Dr. David Cotton, Satellite Observing Systems, UK.
|
||||
"""
|
||||
return _load('atlantic.dat')
|
||||
|
||||
|
||||
def gfaks89():
|
||||
"""
|
||||
Return Surface elevation measured at Gullfaks C 24.12.1989
|
||||
|
||||
Data summary
|
||||
------------
|
||||
Size : 39000 X 2
|
||||
Sampling Rate : 2.5 Hz
|
||||
Device : EMI laser
|
||||
Source : STATOIL
|
||||
Format : ascii, c1: time c2: surface elevation
|
||||
|
||||
Description
|
||||
------------
|
||||
The wave data was measured 24th December 1989 at the Gullfaks C platform
|
||||
in the North Sea from 17.00 to 21.20. The period from 20.00 to 20.20
|
||||
is missing and contains NaNs. The water depth of 218 m is
|
||||
regarded as deep water for the most important wave components.
|
||||
There are two EMI laser sensors named 219 and 220. This data set is
|
||||
obtained from sensor 219, which is located in the Northwest
|
||||
corner approximately two platform leg diameters away from
|
||||
the closest leg.
|
||||
Thus the wave elevation is not expected to be significantly
|
||||
affected by diffraction effects for incoming waves in the western sector.
|
||||
The wind direction for this period is from the south.
|
||||
Some difficulties in calibration of the instruments have been reported
|
||||
resulting in several consecutive measured values being equal or almost
|
||||
equal in the observed data set.
|
||||
|
||||
This dataset is for non-commercial use only.
|
||||
|
||||
Hm0 = 6.8m, Tm02 = 8s, Tp = 10.5
|
||||
|
||||
Example
|
||||
-------
|
||||
>>> import pylab
|
||||
>>> import wafo
|
||||
>>> x = wafo.data.gfaks89()
|
||||
>>> np.allclose(x[:3, 1], [-0.19667949, -0.46667949, -0.38667949])
|
||||
True
|
||||
|
||||
h = pylab.plot(x[:,0],x[:,1])
|
||||
|
||||
Acknowledgement:
|
||||
---------------
|
||||
This dataset were prepared and made available by Dr. S. Haver,
|
||||
STATOIL, Norway
|
||||
|
||||
See also
|
||||
--------
|
||||
gfaksr89, northsea
|
||||
|
||||
"""
|
||||
return _loadnan('gfaks89.dat')
|
||||
|
||||
|
||||
def gfaksr89():
|
||||
"""
|
||||
Return a reconstruction of surface elevation measured at Gullfaks C
|
||||
24.12.1989.
|
||||
|
||||
|
||||
Data summary
|
||||
------------
|
||||
Size : 39000 X 2
|
||||
Sampling Rate : 2.5 Hz
|
||||
Device : EMI laser
|
||||
Source : STATOIL
|
||||
Format : ascii, c1: time c2: surface elevation
|
||||
|
||||
Description
|
||||
-----------
|
||||
This is a reconstructed version of the data in the GFAKS89.DAT file.
|
||||
The following calls were made to reconstruct the data:
|
||||
|
||||
inds = findoutliers(gfaks89,.02,2,1.23);
|
||||
gfaksr89 = reconstruct(gfaks89,inds,6);
|
||||
|
||||
The wave data was measured 24th December 1989 at the Gullfaks C platform
|
||||
in the North Sea from 17.00 to 21.20. The period from 20.00 to 20.20
|
||||
is missing in the original data. The water depth of 218 m is
|
||||
regarded as deep water for the most important wave components.
|
||||
There are two EMI laser sensors named 219 and 220. This data set is
|
||||
obtained from sensor 219, which is located in the Northwest
|
||||
corner approximately two platform leg diameters away from
|
||||
the closest leg.
|
||||
Thus the wave elevation is not expected to be significantly
|
||||
affected by diffraction effects for incoming waves in the western sector.
|
||||
The wind direction for this period is from the south.
|
||||
Some difficulties in calibration of the instruments have been reported
|
||||
resulting in several consecutive measured values being equal or almost
|
||||
equal in the observed data set.
|
||||
|
||||
Hm0 = 6.8m, Tm02 = 8s, Tp = 10.5
|
||||
|
||||
|
||||
Example
|
||||
-------
|
||||
>>> import pylab
|
||||
>>> import wafo
|
||||
>>> x = wafo.data.gfaksr89()
|
||||
|
||||
h = pylab.plot(x[:,0],x[:,1])
|
||||
|
||||
See also
|
||||
--------
|
||||
gfaks89
|
||||
"""
|
||||
return _loadnan('gfaksr89.dat')
|
||||
|
||||
|
||||
def japansea():
|
||||
"""
|
||||
Return coastline map of The Japan Sea
|
||||
|
||||
|
||||
Data summary
|
||||
------------
|
||||
Size : 692 X 2
|
||||
Sampling Rate :
|
||||
Device :
|
||||
Source : http://crusty.er.usgs.gov/coast/getcoast.html
|
||||
Format : ascii, c1: longitude c2: latitude
|
||||
|
||||
Description
|
||||
-----------
|
||||
JAPANSEA.DAT contains data for plotting a map of The Japan Sea.
|
||||
The data is obtained from USGS coastline extractor.
|
||||
|
||||
Example:
|
||||
-------
|
||||
#the map is seen by
|
||||
|
||||
>>> import pylab
|
||||
>>> import wafo
|
||||
>>> map1 = wafo.data.japansea()
|
||||
>>> np.allclose(map1[1:4, 0], [ 141.960057, 142.058624, 142.103214])
|
||||
True
|
||||
|
||||
h = pylab.plot(map1[:,0],map1[:,1])
|
||||
lon_loc = [131,132,132,135,139.5,139]
|
||||
lat_loc = [46, 43, 40, 35, 38.3, 35.7]
|
||||
loc = ['China','Vladivostok','Japan Sea', 'Japan', 'Yura','Tokyo']
|
||||
algn = 'right'
|
||||
for lon, lat, name in zip(lon_loc,lat_loc,loc):
|
||||
pylab.text(lon,lat,name,horizontalalignment=algn)
|
||||
|
||||
|
||||
# If you have the m_map toolbox (see http://www.ocgy.ubc.ca/~rich/):
|
||||
m_proj('lambert','long',[130 148],'lat',[30 48]);
|
||||
m_line(map(:,1),map(:,2));
|
||||
m_grid('box','fancy','tickdir','out');
|
||||
m_text(131,46,'China');
|
||||
m_text(132,43,'Vladivostok');
|
||||
m_text(132,40,'Japan Sea');
|
||||
m_text(135,35,'Japan');
|
||||
m_text(139.5,38.3,'Yura');
|
||||
m_text(139,35.7,'Tokyo');
|
||||
"""
|
||||
return _loadnan('japansea.dat')
|
||||
|
||||
|
||||
def northsea():
|
||||
"""
|
||||
NORTHSEA coastline map of The Nortsea
|
||||
|
||||
Data summary
|
||||
-------------
|
||||
Size : 60646 X 2
|
||||
Sampling Rate :
|
||||
Device :
|
||||
Source : http://crusty.er.usgs.gov/coast/getcoast.html
|
||||
Format : ascii, c1: longitude c2: latitude
|
||||
|
||||
Description
|
||||
-----------
|
||||
NORTHSEA.DAT contains data for plotting a map of The Northsea.
|
||||
The data is obtained from USGS coastline extractor.
|
||||
|
||||
Example
|
||||
-------
|
||||
# the map is seen by
|
||||
|
||||
>>> import pylab
|
||||
>>> import wafo
|
||||
>>> map1 = wafo.data.northsea()
|
||||
>>> np.allclose(map1[1:4, 0], [ 1.261996, 1.264064, 1.268171])
|
||||
True
|
||||
|
||||
h = pylab.plot(map1[:,0],map1[:,1])
|
||||
lon_pltfrm = [1.8, 2.3, 2., 1.9, 2.6]
|
||||
lat_pltfrm = [61.2, 61.2, 59.9, 58.4, 57.7]
|
||||
pltfrm = ['Statfjord A', 'Gullfaks C', 'Frigg', 'Sleipner', 'Draupner']
|
||||
h = pylab.scatter(lon_pltfrm,lat_pltfrm);
|
||||
algn = 'right'
|
||||
for lon, lat, name in zip(lon_pltfrm,lat_pltfrm,pltfrm):
|
||||
pylab.text(lon,lat,name,horizontalalignment=algn); algn = 'left'
|
||||
|
||||
|
||||
lon_city = [10.8, 10.8, 5.52, 5.2]
|
||||
lat_city = [59.85, 63.4, 58.9, 60.3]
|
||||
city = ['Oslo','Trondheim','Stavanger', 'Bergen']
|
||||
h = pylab.scatter(lon_city,lat_city);
|
||||
algn = 'right'
|
||||
for lon, lat, name in zip(lon_city,lat_city,city):
|
||||
pylab.text(lon,lat,name,horizontalalignment=algn)
|
||||
|
||||
# If you have the mpl_toolkits.basemap installed
|
||||
from mpl_toolkits.basemap import Basemap
|
||||
import matplotlib.pyplot as plt
|
||||
|
||||
# setup Lambert Conformal basemap.
|
||||
m = Basemap(width=1200000,height=900000,projection='lcc',
|
||||
resolution='f',lat_1=56.,lat_2=64,lat_0=58,lon_0=5.)
|
||||
m.drawcoastlines()
|
||||
h = m.scatter(lon_pltfrm,lat_pltfrm);
|
||||
algn = 'right'
|
||||
for lon, lat, name in zip(lon_pltfrm,lat_pltfrm,pltfrm):
|
||||
m.text(lon,lat,name,horizontalalignment=algn); algn = 'left'
|
||||
m.scatter(lon_city,lat_city)
|
||||
algn = 'right'
|
||||
for lon, lat, name in zip(lon_city,lat_city,city):
|
||||
m.text(lon,lat,name,horizontalalignment=algn)
|
||||
"""
|
||||
return _loadnan('northsea.dat')
|
||||
|
||||
|
||||
def sea():
|
||||
"""
|
||||
Return Surface elevation dataset used in WAT version 1.1.
|
||||
|
||||
Data summary
|
||||
------------
|
||||
Size : 9524 X 2
|
||||
Sampling Rate : 4.0 Hz
|
||||
Device : unknown
|
||||
Source : unknown
|
||||
Format : ascii, c1: time c2: surface elevation
|
||||
|
||||
Description
|
||||
-----------
|
||||
The wave data was used in one of WAFO predecessors, i.e. the Wave
|
||||
Analysis Toolbox version 1.1 (WAT)
|
||||
Hm0 = 1.9m, Tm02 = 4.0s, Tp2 = 11.5s Tp1=5.6s
|
||||
|
||||
Example
|
||||
-------
|
||||
>>> import pylab
|
||||
>>> import wafo
|
||||
>>> x = wafo.data.sea()
|
||||
>>> np.allclose(x[:3,1],[-1.2004945 , -1.0904945 , -0.79049454])
|
||||
True
|
||||
|
||||
h = pylab.plot(x[:,0],x[:,1])
|
||||
"""
|
||||
return _load('sea.dat')
|
||||
|
||||
|
||||
def sfa89():
|
||||
"""
|
||||
Return Wind measurements at Statfjord A 24.12.1989
|
||||
|
||||
Data summary
|
||||
------------
|
||||
Size : 144 X 3
|
||||
Sampling Rate : 1/600 Hz
|
||||
Device :
|
||||
Source : DNMI (The Norwegian Meteorological Institute)
|
||||
Format : ascii, c1: time (hours)
|
||||
c2: velocity (m/s)
|
||||
c3: direction (degrees)
|
||||
Description
|
||||
-----------
|
||||
The registration of wind speeds at the Gullfaks field
|
||||
started up on Statfjord A in 1978 and continued until 1990.
|
||||
The dataregistration was transferred to Gullfaks C in Nov 1989.
|
||||
Due to some difficulties of the windregistration on Gullfaks C in
|
||||
the beginning, they continued to use the registered data from
|
||||
Statfjord A.
|
||||
The windspeed is measured in (meter/second), 110 m above mean water
|
||||
level (MWL) and the wind direction is given in degrees for the data.
|
||||
The data are a mean value of every 10 minutes.
|
||||
Wind directions are defined in the meteorological convention, i.e.,
|
||||
0 degrees = wind approaching from North, 90 degrees = wind from East, etc.
|
||||
This dataset is for non-commercial use only.
|
||||
|
||||
Example
|
||||
-------
|
||||
>>> import pylab
|
||||
>>> import wafo
|
||||
>>> x = wafo.data.sfa89()
|
||||
|
||||
h = pylab.plot(x[:,0],x[:,1])
|
||||
|
||||
Acknowledgement
|
||||
----------------
|
||||
These data are made available by Knut A. Iden, DNMI.
|
||||
|
||||
See also
|
||||
--------
|
||||
northsea
|
||||
"""
|
||||
return _load('sfa89.dat')
|
||||
|
||||
|
||||
def sn():
|
||||
"""
|
||||
Return SN Fatigue experiment, constant-amplitude loading.
|
||||
|
||||
|
||||
Data summary
|
||||
------------
|
||||
Size : 40 X 2
|
||||
Source : unknown
|
||||
Format : ascii, c1: Amplitude MPa c2: Number of cycles
|
||||
|
||||
Description
|
||||
-----------
|
||||
A fatigue experiment with constant amplitudes at five levels:
|
||||
10,15,20,25 and 30 MPa. For each level is related 8 observations of
|
||||
the number of cycles to failure.
|
||||
|
||||
The origin of the data is unknown.
|
||||
|
||||
Example
|
||||
-------
|
||||
>>> import pylab
|
||||
>>> import wafo
|
||||
>>> x = wafo.data.sn()
|
||||
|
||||
h = pylab.plot(x[:,0],x[:,1])
|
||||
|
||||
See also
|
||||
--------
|
||||
The same data appear in the directory wdemos/itmkurs/
|
||||
as SN.mat.
|
||||
|
||||
"""
|
||||
return _load('sn.dat')
|
||||
|
||||
|
||||
def yura87():
|
||||
"""
|
||||
Return Surface elevation measured off the coast of Yura.
|
||||
|
||||
|
||||
Data summary
|
||||
-----------
|
||||
Size : 85547 X 4
|
||||
Sampling Rate : 1 Hz
|
||||
Device : ultrasonic wave gauges
|
||||
Source : SRI, Ministry of Transport, Japan
|
||||
Format : ascii, c1: time (sec) c2-4: surface elevation (m)
|
||||
|
||||
Description
|
||||
-----------
|
||||
The wave data was measured at the Poseidon platform
|
||||
in the Japan Sea from 24th November 1987 08.12 hours to 25th November
|
||||
1987 07.57 hours. Poseidon was located 3 km off the coast of Yura
|
||||
in the Yamagata prefecture, in the Japan Sea during the measurements.
|
||||
The most important wave components are to some extent influenced by the
|
||||
water depth of 42 m. The data are measured with three ultrasonic wave
|
||||
gauges located at the sea floor and the relative coordinates of the
|
||||
gauges are as follows (x-axis points to the East, y-axis points to
|
||||
the North):
|
||||
X (m) Y (m)
|
||||
c2: -4.93, 25.02
|
||||
c3: 5.80, 92.12
|
||||
c4: 0.00, 0.00
|
||||
|
||||
This dataset is for non-commercial use only.
|
||||
|
||||
Hm0 = 5.1m, Tm02 = 7.7s, Tp = 12.8s
|
||||
Example
|
||||
-------
|
||||
>>> import pylab
|
||||
>>> import wafo
|
||||
>>> x = wafo.data.yura87()
|
||||
|
||||
h = pylab.plot(x[:,0],x[:,1])
|
||||
|
||||
Acknowledgement:
|
||||
-----------------
|
||||
This dataset were prepared and made available by Dr. Sc. H. Tomita,
|
||||
Ship Research Institute, Ministry of Transport, Japan.
|
||||
|
||||
See also
|
||||
--------
|
||||
japansea
|
||||
"""
|
||||
return _load('yura87.dat')
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
import doctest
|
||||
doctest.testmod()
|
||||
@ -1,692 +0,0 @@
|
||||
nan nan
|
||||
141.960057 40.022926
|
||||
142.058624 39.818752
|
||||
142.103214 39.640392
|
||||
142.157191 39.469073
|
||||
142.136070 39.332957
|
||||
142.070358 39.229696
|
||||
142.046890 39.074805
|
||||
141.927201 38.955116
|
||||
141.805166 38.948076
|
||||
141.727720 38.765023
|
||||
141.638541 38.542073
|
||||
141.638541 38.368408
|
||||
141.629153 38.316777
|
||||
141.396817 38.333205
|
||||
141.143358 38.194742
|
||||
141.054179 37.934243
|
||||
141.087034 37.671397
|
||||
141.143358 37.453142
|
||||
141.143358 37.143360
|
||||
141.164480 36.957960
|
||||
140.976733 36.826537
|
||||
140.854698 36.603588
|
||||
140.812455 36.533182
|
||||
140.756131 36.258603
|
||||
140.744396 35.944127
|
||||
140.887553 35.791583
|
||||
140.922756 35.683628
|
||||
140.767865 35.603836
|
||||
140.589505 35.359765
|
||||
140.479204 35.162631
|
||||
140.237480 35.007740
|
||||
nan nan
|
||||
139.984022 35.233036
|
||||
140.016877 35.369152
|
||||
140.148300 35.495881
|
||||
140.192890 35.622610
|
||||
nan nan
|
||||
139.972288 39.161638
|
||||
140.070855 39.323569
|
||||
140.138913 39.530091
|
||||
140.148300 39.750693
|
||||
140.016877 39.844567
|
||||
nan nan
|
||||
140.237480 35.007740
|
||||
139.993409 34.862236
|
||||
139.951166 35.007740
|
||||
139.984022 35.233036
|
||||
nan nan
|
||||
140.192890 35.622610
|
||||
139.951166 35.622610
|
||||
139.894842 35.451291
|
||||
139.805662 35.305788
|
||||
139.784541 35.153243
|
||||
139.653118 35.233036
|
||||
139.409047 35.261198
|
||||
139.298746 35.115694
|
||||
139.254156 34.918560
|
||||
139.209566 34.726119
|
||||
139.089878 34.618165
|
||||
138.956108 34.636940
|
||||
138.911518 34.871623
|
||||
138.946721 35.035902
|
||||
138.791830 35.052329
|
||||
138.625204 34.925600
|
||||
138.460926 34.763669
|
||||
138.348278 34.580616
|
||||
138.315422 34.554800
|
||||
138.195733 34.571228
|
||||
137.996252 34.608778
|
||||
137.731060 34.618165
|
||||
137.477602 34.618165
|
||||
137.256999 34.554800
|
||||
137.212409 34.554800
|
||||
137.278121 34.636940
|
||||
137.388422 34.709692
|
||||
137.266387 34.726119
|
||||
137.167820 34.744894
|
||||
137.113842 34.798871
|
||||
137.057518 34.709692
|
||||
136.935483 34.817646
|
||||
136.926096 35.017127
|
||||
136.836916 34.981924
|
||||
136.714880 34.754281
|
||||
136.628048 34.618165
|
||||
136.771204 34.536026
|
||||
136.968339 34.416337
|
||||
136.968339 34.179307
|
||||
136.836916 34.270833
|
||||
136.714880 34.216856
|
||||
136.583458 34.198081
|
||||
136.449688 34.134717
|
||||
136.372243 34.040844
|
||||
136.351121 33.977479
|
||||
136.229086 33.813201
|
||||
136.064807 33.555049
|
||||
135.853592 33.454135
|
||||
135.701048 33.498725
|
||||
135.579012 33.555049
|
||||
135.478098 33.702899
|
||||
135.290352 33.803813
|
||||
135.236374 33.977479
|
||||
135.248108 34.134717
|
||||
135.248108 34.261446
|
||||
135.334941 34.334198
|
||||
135.501567 34.564188
|
||||
135.522688 34.636940
|
||||
135.478098 34.662755
|
||||
135.325554 34.643980
|
||||
135.147195 34.608778
|
||||
134.926592 34.681530
|
||||
134.684868 34.726119
|
||||
134.464266 34.716732
|
||||
134.264785 34.580616
|
||||
134.142749 34.526638
|
||||
133.978471 34.435112
|
||||
133.955002 34.425725
|
||||
133.901025 34.463274
|
||||
133.835314 34.489089
|
||||
133.680423 34.444499
|
||||
133.579509 34.435112
|
||||
133.403496 34.371747
|
||||
133.281461 34.362360
|
||||
133.161772 34.308383
|
||||
133.016268 34.280221
|
||||
132.851990 34.233284
|
||||
132.664243 34.198081
|
||||
132.530473 34.298995
|
||||
132.420172 34.270833
|
||||
132.300484 34.015028
|
||||
132.244160 33.885952
|
||||
132.154980 33.867178
|
||||
131.924990 33.932889
|
||||
131.758365 34.005641
|
||||
131.570618 33.949317
|
||||
131.427461 33.949317
|
||||
131.338281 33.914114
|
||||
131.162269 33.968092
|
||||
130.986256 33.996254
|
||||
130.974522 34.207469
|
||||
130.997990 34.317770
|
||||
131.195124 34.362360
|
||||
131.460317 34.416337
|
||||
131.636329 34.571228
|
||||
131.814689 34.681530
|
||||
132.122124 34.827033
|
||||
132.321605 35.045289
|
||||
132.563329 35.179059
|
||||
132.718220 35.387927
|
||||
132.917701 35.486494
|
||||
133.138304 35.549859
|
||||
133.304929 35.521697
|
||||
133.459820 35.477107
|
||||
133.800111 35.505269
|
||||
134.077038 35.495881
|
||||
134.309374 35.540471
|
||||
134.583954 35.594448
|
||||
134.795169 35.631998
|
||||
134.959448 35.639038
|
||||
135.137807 35.693015
|
||||
135.325554 35.702403
|
||||
135.313820 35.559246
|
||||
135.412387 35.531084
|
||||
135.733903 35.477107
|
||||
135.820736 35.495881
|
||||
135.909916 35.568633
|
||||
136.031951 35.631998
|
||||
136.142253 35.693015
|
||||
136.142253 35.944127
|
||||
136.151640 36.176464
|
||||
136.440301 36.382985
|
||||
136.682025 36.631750
|
||||
136.836916 36.932144
|
||||
136.848650 37.143360
|
||||
136.893240 37.312332
|
||||
137.233531 37.469570
|
||||
137.388422 37.453142
|
||||
137.355566 37.312332
|
||||
137.212409 37.248967
|
||||
137.057518 37.126932
|
||||
137.036397 37.082342
|
||||
137.113842 36.915717
|
||||
137.113842 36.737357
|
||||
137.224144 36.727970
|
||||
137.433012 36.756132
|
||||
137.609025 36.906329
|
||||
137.853095 37.011937
|
||||
138.151144 37.091729
|
||||
138.470313 37.284170
|
||||
138.681528 37.453142
|
||||
138.836419 37.654970
|
||||
139.012432 37.847410
|
||||
139.233035 37.960058
|
||||
139.244769 37.969446
|
||||
139.254156 37.976486
|
||||
139.355070 37.976486
|
||||
139.507614 38.152499
|
||||
139.531083 38.307390
|
||||
139.575672 38.438813
|
||||
139.695361 38.628906
|
||||
139.850252 38.835428
|
||||
139.927698 38.997359
|
||||
139.972288 39.161638
|
||||
nan nan
|
||||
140.016877 39.844567
|
||||
139.805662 39.912625
|
||||
139.906576 39.980683
|
||||
nan nan
|
||||
138.604083 38.272187
|
||||
138.580614 38.098521
|
||||
138.625204 38.056278
|
||||
138.514903 37.812208
|
||||
138.360012 37.802820
|
||||
138.327156 37.950671
|
||||
138.449192 38.204129
|
||||
138.604083 38.272187
|
||||
nan nan
|
||||
134.276519 33.268735
|
||||
134.065304 33.379036
|
||||
133.800111 33.454135
|
||||
133.570121 33.397811
|
||||
133.391762 33.296897
|
||||
133.293195 33.111497
|
||||
133.105448 32.879160
|
||||
133.084326 32.712535
|
||||
132.905967 32.693760
|
||||
132.751076 32.804061
|
||||
132.685365 32.879160
|
||||
132.553942 33.083335
|
||||
132.575063 33.167821
|
||||
132.509352 33.278122
|
||||
132.387316 33.360261
|
||||
132.223038 33.360261
|
||||
132.488230 33.536274
|
||||
132.697099 33.756876
|
||||
132.896580 33.977479
|
||||
133.105448 33.949317
|
||||
133.239218 33.895340
|
||||
133.436352 33.932889
|
||||
133.624099 34.005641
|
||||
133.689810 34.134717
|
||||
133.823580 34.226244
|
||||
133.933881 34.317770
|
||||
134.065304 34.334198
|
||||
134.264785 34.289608
|
||||
134.452531 34.198081
|
||||
134.619157 34.188694
|
||||
134.661400 33.996254
|
||||
134.717724 33.822588
|
||||
134.762314 33.803813
|
||||
134.771701 33.794426
|
||||
134.762314 33.766264
|
||||
134.652012 33.665350
|
||||
134.551098 33.618413
|
||||
134.452531 33.517499
|
||||
134.363352 33.369649
|
||||
134.276519 33.268735
|
||||
nan nan
|
||||
135.060362 34.571228
|
||||
135.027506 34.526638
|
||||
134.872615 34.371747
|
||||
134.762314 34.207469
|
||||
134.872615 34.179307
|
||||
134.982916 34.226244
|
||||
135.004038 34.390522
|
||||
135.060362 34.571228
|
||||
nan nan
|
||||
130.864220 33.876565
|
||||
130.920544 33.885952
|
||||
130.831365 33.895340
|
||||
130.676474 33.848403
|
||||
130.521583 33.721674
|
||||
130.423015 33.564436
|
||||
130.279859 33.564436
|
||||
130.178945 33.470563
|
||||
130.035788 33.416585
|
||||
nan nan
|
||||
130.000000 32.676758
|
||||
130.146089 32.712535
|
||||
130.324448 32.628049
|
||||
130.411281 32.759472
|
||||
130.289246 32.813449
|
||||
130.235269 32.897935
|
||||
130.235269 33.083335
|
||||
130.333836 33.149046
|
||||
130.444137 32.944872
|
||||
130.577907 32.766512
|
||||
130.577907 32.599887
|
||||
130.622496 32.581112
|
||||
130.631884 32.581112
|
||||
130.622496 32.386325
|
||||
130.521583 32.179803
|
||||
130.401894 32.095317
|
||||
130.300980 31.935732
|
||||
130.289246 31.710436
|
||||
130.345570 31.464019
|
||||
130.289246 31.323208
|
||||
130.401894 31.229335
|
||||
130.655352 31.123727
|
||||
130.709329 31.341983
|
||||
130.631884 31.520343
|
||||
130.688208 31.663500
|
||||
130.852486 31.625950
|
||||
130.775041 31.569626
|
||||
130.753919 31.445244
|
||||
130.810243 31.248110
|
||||
130.810243 31.011079
|
||||
130.941666 31.048629
|
||||
131.096557 31.161277
|
||||
131.108291 31.304434
|
||||
131.251448 31.435857
|
||||
131.361750 31.388920
|
||||
131.483785 31.625950
|
||||
131.549496 31.879408
|
||||
131.615208 32.114092
|
||||
131.725509 32.386325
|
||||
131.835810 32.552950
|
||||
131.967233 32.712535
|
||||
132.023557 32.794674
|
||||
132.035291 32.841611
|
||||
132.023557 32.998849
|
||||
131.978967 33.073947
|
||||
131.924990 33.174861
|
||||
131.680919 33.221798
|
||||
131.648063 33.306284
|
||||
131.746630 33.517499
|
||||
131.692653 33.627801
|
||||
131.537762 33.583211
|
||||
131.239714 33.573823
|
||||
131.051967 33.766264
|
||||
131.040233 33.857790
|
||||
130.962788 33.857790
|
||||
130.864220 33.876565
|
||||
nan nan
|
||||
130.146089 32.477851
|
||||
130.092112 32.358163
|
||||
130.080378 32.217353
|
||||
130.113233 32.142254
|
||||
130.247003 32.421527
|
||||
130.146089 32.477851
|
||||
nan nan
|
||||
131.117679 30.630892
|
||||
131.084823 30.764662
|
||||
131.030846 30.630892
|
||||
130.962788 30.410290
|
||||
131.030846 30.344578
|
||||
131.117679 30.630892
|
||||
nan nan
|
||||
130.545051 30.353966
|
||||
130.512195 30.410290
|
||||
130.455871 30.325804
|
||||
130.512195 30.210809
|
||||
130.676474 30.192034
|
||||
130.676474 30.325804
|
||||
130.545051 30.353966
|
||||
nan nan
|
||||
130.897076 37.539975
|
||||
130.843099 37.495385
|
||||
130.843099 37.478957
|
||||
130.885342 37.453142
|
||||
130.974522 37.504772
|
||||
130.897076 37.539975
|
||||
nan nan
|
||||
130.035788 33.416585
|
||||
130.000000 33.445983
|
||||
nan nan
|
||||
142.678694 48.000000
|
||||
142.654720 47.880130
|
||||
142.666454 47.650140
|
||||
142.809611 47.448313
|
||||
142.952768 47.335665
|
||||
143.107659 47.194854
|
||||
143.140515 47.028229
|
||||
143.206226 46.915581
|
||||
143.307140 46.840482
|
||||
143.462031 46.772424
|
||||
143.516009 46.802933
|
||||
143.572333 46.755996
|
||||
143.626310 46.582330
|
||||
143.670900 46.415705
|
||||
143.649778 46.225612
|
||||
143.548864 46.070720
|
||||
143.494887 46.270201
|
||||
143.417442 46.537741
|
||||
143.173371 46.605799
|
||||
142.943381 46.687938
|
||||
142.699310 46.697325
|
||||
142.523297 46.558862
|
||||
142.434118 46.361728
|
||||
142.356672 46.148166
|
||||
142.258105 45.955725
|
||||
142.025768 46.049599
|
||||
141.969444 46.354687
|
||||
141.960057 46.657429
|
||||
142.025768 46.983639
|
||||
142.070358 47.194854
|
||||
142.091480 47.441272
|
||||
142.124335 47.671262
|
||||
142.157191 47.894211
|
||||
142.248875 48.000000
|
||||
nan nan
|
||||
148.000000 44.948933
|
||||
147.909284 44.948933
|
||||
147.789595 44.885569
|
||||
147.679294 44.754146
|
||||
147.566646 44.697822
|
||||
147.435223 44.620376
|
||||
147.313188 44.524156
|
||||
147.214621 44.446711
|
||||
147.071464 44.446711
|
||||
147.125441 44.540584
|
||||
147.235742 44.650885
|
||||
147.280332 44.768227
|
||||
147.381246 44.801083
|
||||
147.590114 45.002910
|
||||
147.733271 45.113212
|
||||
147.864694 45.160148
|
||||
147.953874 45.291571
|
||||
148.000000 45.306694
|
||||
nan nan
|
||||
146.937694 43.843574
|
||||
147.015140 43.820106
|
||||
146.928307 43.756741
|
||||
146.761682 43.691030
|
||||
146.663115 43.730926
|
||||
146.761682 43.796637
|
||||
146.937694 43.843574
|
||||
nan nan
|
||||
146.210175 44.446711
|
||||
146.231297 44.486607
|
||||
146.287621 44.446711
|
||||
146.365066 44.399774
|
||||
146.419044 44.303554
|
||||
146.320477 44.249576
|
||||
146.120996 44.097032
|
||||
145.912127 43.939794
|
||||
145.724380 43.796637
|
||||
145.614079 43.667561
|
||||
145.536634 43.796637
|
||||
145.703259 43.946835
|
||||
145.900393 44.113460
|
||||
146.067018 44.280085
|
||||
146.144464 44.430283
|
||||
146.210175 44.446711
|
||||
nan nan
|
||||
145.083695 44.066523
|
||||
145.149406 44.113460
|
||||
145.370008 44.256617
|
||||
145.447454 44.209680
|
||||
145.348887 44.003159
|
||||
145.182262 43.780209
|
||||
145.250320 43.620625
|
||||
145.426332 43.540832
|
||||
145.426332 43.339004
|
||||
145.646935 43.331964
|
||||
145.912127 43.404716
|
||||
145.813560 43.249825
|
||||
145.492044 43.146564
|
||||
145.226851 43.001060
|
||||
145.050839 42.977592
|
||||
144.952272 43.017488
|
||||
144.841970 42.904840
|
||||
144.508720 42.935349
|
||||
144.234140 42.911880
|
||||
143.957214 42.799232
|
||||
143.692021 42.538734
|
||||
143.516009 42.285275
|
||||
143.450297 42.048245
|
||||
143.328262 41.923863
|
||||
143.051335 42.081101
|
||||
142.842467 42.196096
|
||||
142.478708 42.294663
|
||||
142.180659 42.440166
|
||||
141.960057 42.529346
|
||||
141.650275 42.555161
|
||||
141.417938 42.473022
|
||||
141.253660 42.367415
|
||||
141.054179 42.383842
|
||||
140.845310 42.505878
|
||||
140.556650 42.489450
|
||||
140.404105 42.311091
|
||||
140.502672 42.153853
|
||||
140.702153 42.097529
|
||||
140.922756 42.015389
|
||||
141.110503 41.900394
|
||||
141.241925 41.808868
|
||||
141.176214 41.710301
|
||||
140.955612 41.726729
|
||||
140.788986 41.719688
|
||||
140.624708 41.635202
|
||||
140.523794 41.520207
|
||||
140.270336 41.388784
|
||||
140.138913 41.421640
|
||||
140.082589 41.562450
|
||||
140.160034 41.801827
|
||||
140.216358 41.982534
|
||||
140.028612 42.120997
|
||||
nan nan
|
||||
139.927698 42.522306
|
||||
140.094323 42.660769
|
||||
140.326660 42.749949
|
||||
140.514407 42.904840
|
||||
140.568384 43.057384
|
||||
140.469817 43.162992
|
||||
140.514407 43.282680
|
||||
140.744396 43.242784
|
||||
140.964999 43.179420
|
||||
141.152746 43.179420
|
||||
141.363961 43.186460
|
||||
141.495384 43.378901
|
||||
141.462528 43.557260
|
||||
141.462528 43.716845
|
||||
141.596297 43.810718
|
||||
141.727720 44.043055
|
||||
141.739454 44.303554
|
||||
141.805166 44.547624
|
||||
141.870877 44.721290
|
||||
141.805166 44.862100
|
||||
141.727720 45.035766
|
||||
141.683130 45.160148
|
||||
141.694865 45.284531
|
||||
141.793432 45.354936
|
||||
141.903733 45.432381
|
||||
141.992913 45.462890
|
||||
142.124335 45.376057
|
||||
142.136070 45.361976
|
||||
142.180659 45.284531
|
||||
142.347285 45.190657
|
||||
142.490442 45.042807
|
||||
142.610130 44.918424
|
||||
142.765021 44.768227
|
||||
142.931647 44.643845
|
||||
143.140515 44.493647
|
||||
143.339996 44.383346
|
||||
143.516009 44.280085
|
||||
143.736611 44.193252
|
||||
143.936092 44.129888
|
||||
144.144960 44.082951
|
||||
144.332707 44.059483
|
||||
144.443009 43.970303
|
||||
144.654224 43.906938
|
||||
144.863092 43.939794
|
||||
145.083695 44.066523
|
||||
nan nan
|
||||
141.241925 45.230553
|
||||
141.131624 45.167189
|
||||
141.241925 45.096784
|
||||
141.340492 45.089743
|
||||
141.363961 45.230553
|
||||
141.241925 45.230553
|
||||
nan nan
|
||||
141.209070 41.372356
|
||||
141.230191 41.379397
|
||||
141.363961 41.372356
|
||||
141.485996 41.379397
|
||||
141.528239 41.280830
|
||||
141.518852 41.137673
|
||||
141.495384 40.947579
|
||||
141.518852 40.722283
|
||||
141.605685 40.501681
|
||||
141.793432 40.325668
|
||||
141.903733 40.130881
|
||||
141.960057 40.022926
|
||||
nan nan
|
||||
139.906576 39.980683
|
||||
140.082589 40.182511
|
||||
140.070855 40.435969
|
||||
140.061467 40.611982
|
||||
140.148300 40.729324
|
||||
140.282070 40.787995
|
||||
140.314926 40.787995
|
||||
140.336047 40.863093
|
||||
140.347781 41.022678
|
||||
140.413493 41.130632
|
||||
140.547262 41.179916
|
||||
140.657563 41.071962
|
||||
140.744396 40.879521
|
||||
140.821842 40.797382
|
||||
140.943877 40.931151
|
||||
141.075300 40.888908
|
||||
141.197336 40.895949
|
||||
141.319371 41.088389
|
||||
141.331105 41.245627
|
||||
141.185601 41.156448
|
||||
140.943877 41.104817
|
||||
140.878166 41.264402
|
||||
140.943877 41.428681
|
||||
141.042444 41.454496
|
||||
141.209070 41.372356
|
||||
nan nan
|
||||
132.729954 44.838632
|
||||
132.786278 44.909037
|
||||
132.828521 45.113212
|
||||
132.741689 45.244634
|
||||
132.521086 45.284531
|
||||
132.178448 45.237594
|
||||
132.089268 45.120252
|
||||
132.199570 44.941893
|
||||
132.199570 44.777614
|
||||
132.300484 44.667313
|
||||
132.476496 44.596908
|
||||
132.697099 44.681394
|
||||
132.729954 44.838632
|
||||
nan nan
|
||||
139.676457 48.000000
|
||||
139.620262 47.962270
|
||||
139.420781 47.814419
|
||||
139.265890 47.619632
|
||||
139.122733 47.441272
|
||||
138.934986 47.291075
|
||||
138.747240 47.140877
|
||||
138.592349 46.960171
|
||||
138.538371 46.817014
|
||||
138.460926 46.643348
|
||||
138.404602 46.521313
|
||||
138.261445 46.324179
|
||||
138.139409 46.162247
|
||||
138.261445 46.392237
|
||||
138.172265 46.256120
|
||||
138.085432 46.110617
|
||||
137.885951 45.979194
|
||||
137.787384 45.817262
|
||||
137.587903 45.655331
|
||||
137.379035 45.509827
|
||||
137.212409 45.361976
|
||||
137.012928 45.230553
|
||||
136.869772 45.113212
|
||||
136.804060 45.035766
|
||||
136.682025 44.901997
|
||||
136.538868 44.808123
|
||||
136.395711 44.643845
|
||||
136.297144 44.500688
|
||||
136.097663 44.413855
|
||||
135.921650 44.289473
|
||||
135.776146 44.146316
|
||||
135.755025 44.033668
|
||||
135.632989 43.899898
|
||||
135.513301 43.763781
|
||||
135.346676 43.597156
|
||||
135.093217 43.404716
|
||||
134.872615 43.282680
|
||||
134.628544 43.162992
|
||||
134.330496 43.008101
|
||||
134.065304 42.846169
|
||||
133.877557 42.782804
|
||||
133.746134 42.782804
|
||||
133.546653 42.740561
|
||||
133.326051 42.677197
|
||||
133.105448 42.700665
|
||||
132.995147 42.749949
|
||||
132.929435 42.740561
|
||||
132.762810 42.829741
|
||||
132.563329 42.855556
|
||||
132.410785 42.846169
|
||||
132.377929 42.895452
|
||||
132.366195 43.033916
|
||||
132.399051 43.137177
|
||||
132.399051 43.242784
|
||||
132.288749 43.209928
|
||||
132.068147 43.090240
|
||||
132.002435 43.146564
|
||||
132.089268 43.282680
|
||||
131.934377 43.299108
|
||||
131.913256 43.418797
|
||||
131.847544 43.292068
|
||||
131.781833 43.106668
|
||||
131.648063 42.984632
|
||||
131.558884 42.928308
|
||||
131.504906 42.822701
|
||||
131.382871 42.740561
|
||||
131.284304 42.611485
|
||||
131.073089 42.611485
|
||||
130.908810 42.620873
|
||||
130.753919 42.595058
|
||||
130.810243 42.529346
|
||||
130.843099 42.423739
|
||||
130.622496 42.562202
|
||||
nan nan
|
||||
140.028612 42.120997
|
||||
139.883108 42.212523
|
||||
139.894842 42.334559
|
||||
139.927698 42.522306
|
||||
nan nan
|
||||
130.699942 42.374455
|
||||
130.732798 42.278235
|
||||
130.610762 42.301703
|
||||
130.476993 42.268848
|
||||
130.324448 42.130384
|
||||
130.103846 41.956718
|
||||
nan nan
|
||||
130.103846 41.956718
|
||||
130.000000 41.866852
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -1,16 +0,0 @@
|
||||
%SEA Surface elevation dataset used in WAT version 1.1.
|
||||
%
|
||||
% CALL: xn = load('sea.dat');
|
||||
%
|
||||
% Size : 9524 X 2
|
||||
% Sampling Rate : 4.0 Hz
|
||||
% Device : unknown
|
||||
% Source : unknown
|
||||
% Format : ascii, c1: time c2: surface elevation
|
||||
% Description :
|
||||
% The wave data was used in one of WAFO predecessors, i.e. the Wave
|
||||
% Analysis Toolbox version 1.1 (WAT)
|
||||
%
|
||||
% Hm0 = 1.9m, Tm02 = 4.0s, Tp2 = 11.5s Tp1=5.6s
|
||||
%
|
||||
% See also
|
||||
@ -1,144 +0,0 @@
|
||||
0.0000000e+00 1.2400000e+01 2.0700000e+02
|
||||
1.6666667e-01 1.1800000e+01 2.0480000e+02
|
||||
3.3333333e-01 1.1300000e+01 1.9940000e+02
|
||||
5.0000000e-01 1.1800000e+01 1.9560000e+02
|
||||
6.6666667e-01 1.3000000e+01 1.9500000e+02
|
||||
8.3333333e-01 1.3400000e+01 1.9550000e+02
|
||||
1.0000000e+00 1.2000000e+01 1.9250000e+02
|
||||
1.1666667e+00 1.3300000e+01 1.9250000e+02
|
||||
1.3333333e+00 1.4900000e+01 1.9450000e+02
|
||||
1.5000000e+00 1.4400000e+01 1.9790000e+02
|
||||
1.6666667e+00 1.3600000e+01 1.9800000e+02
|
||||
1.8333333e+00 1.2400000e+01 1.8510000e+02
|
||||
2.0000000e+00 1.5100000e+01 2.0260000e+02
|
||||
2.1666667e+00 1.5000000e+01 2.0240000e+02
|
||||
2.3333333e+00 1.4400000e+01 2.0540000e+02
|
||||
2.5000000e+00 1.4600000e+01 2.0430000e+02
|
||||
2.6666667e+00 1.2800000e+01 2.0370000e+02
|
||||
2.8333333e+00 1.2600000e+01 2.0620000e+02
|
||||
3.0000000e+00 1.5500000e+01 2.1350000e+02
|
||||
3.1666667e+00 1.6700000e+01 2.1370000e+02
|
||||
3.3333333e+00 1.7100000e+01 2.1490000e+02
|
||||
3.5000000e+00 1.6500000e+01 2.1430000e+02
|
||||
3.6666667e+00 1.6800000e+01 2.1440000e+02
|
||||
3.8333333e+00 1.5100000e+01 2.1060000e+02
|
||||
4.0000000e+00 1.5600000e+01 2.1050000e+02
|
||||
4.1666667e+00 1.4700000e+01 2.0960000e+02
|
||||
4.3333333e+00 1.3900000e+01 2.0860000e+02
|
||||
4.5000000e+00 1.4200000e+01 2.0660000e+02
|
||||
4.6666667e+00 1.4100000e+01 2.0500000e+02
|
||||
4.8333333e+00 1.4800000e+01 2.0500000e+02
|
||||
5.0000000e+00 1.4600000e+01 2.0050000e+02
|
||||
5.1666667e+00 1.5100000e+01 1.9520000e+02
|
||||
5.3333333e+00 1.5000000e+01 1.9360000e+02
|
||||
5.5000000e+00 1.5600000e+01 1.9170000e+02
|
||||
5.6666667e+00 1.6900000e+01 1.8940000e+02
|
||||
5.8333333e+00 1.5800000e+01 1.8690000e+02
|
||||
6.0000000e+00 1.6500000e+01 1.8230000e+02
|
||||
6.1666667e+00 1.8100000e+01 1.8330000e+02
|
||||
6.3333333e+00 1.8400000e+01 1.8080000e+02
|
||||
6.5000000e+00 1.7900000e+01 1.7960000e+02
|
||||
6.6666667e+00 1.8900000e+01 1.7910000e+02
|
||||
6.8333333e+00 2.0000000e+01 1.7830000e+02
|
||||
7.0000000e+00 2.0000000e+01 1.7830000e+02
|
||||
7.1666667e+00 2.1400000e+01 1.7780000e+02
|
||||
7.3333333e+00 2.0800000e+01 1.7530000e+02
|
||||
7.5000000e+00 2.1800000e+01 1.7380000e+02
|
||||
7.6666667e+00 2.1800000e+01 1.7130000e+02
|
||||
7.8333333e+00 2.2600000e+01 1.7220000e+02
|
||||
8.0000000e+00 2.2700000e+01 1.7260000e+02
|
||||
8.1666667e+00 2.4100000e+01 1.7300000e+02
|
||||
8.3333333e+00 2.3500000e+01 1.7180000e+02
|
||||
8.5000000e+00 2.4100000e+01 1.7080000e+02
|
||||
8.6666667e+00 2.4400000e+01 1.6950000e+02
|
||||
8.8333333e+00 2.4900000e+01 1.7010000e+02
|
||||
9.0000000e+00 2.6500000e+01 1.7290000e+02
|
||||
9.1666667e+00 2.6500000e+01 1.7210000e+02
|
||||
9.3333333e+00 2.6300000e+01 1.7200000e+02
|
||||
9.5000000e+00 2.7300000e+01 1.7250000e+02
|
||||
9.6666667e+00 2.7300000e+01 1.7520000e+02
|
||||
9.8333333e+00 2.7800000e+01 1.7220000e+02
|
||||
1.0000000e+01 2.7200000e+01 1.7460000e+02
|
||||
1.0166667e+01 2.7900000e+01 1.7790000e+02
|
||||
1.0333333e+01 2.8400000e+01 1.7830000e+02
|
||||
1.0500000e+01 2.8300000e+01 1.7590000e+02
|
||||
1.0666667e+01 2.7300000e+01 1.7460000e+02
|
||||
1.0833333e+01 2.7600000e+01 1.7310000e+02
|
||||
1.1000000e+01 2.9300000e+01 1.7520000e+02
|
||||
1.1166667e+01 2.9600000e+01 1.7580000e+02
|
||||
1.1333333e+01 2.8700000e+01 1.7430000e+02
|
||||
1.1500000e+01 2.8200000e+01 1.7300000e+02
|
||||
1.1666667e+01 2.8100000e+01 1.7000000e+02
|
||||
1.1833333e+01 2.9100000e+01 1.6820000e+02
|
||||
1.2000000e+01 2.8800000e+01 1.7040000e+02
|
||||
1.2166667e+01 2.9600000e+01 1.7150000e+02
|
||||
1.2333333e+01 2.9900000e+01 1.7160000e+02
|
||||
1.2500000e+01 2.9500000e+01 1.7210000e+02
|
||||
1.2666667e+01 3.0100000e+01 1.7560000e+02
|
||||
1.2833333e+01 3.0900000e+01 1.7520000e+02
|
||||
1.3000000e+01 3.0900000e+01 1.7550000e+02
|
||||
1.3166667e+01 3.0000000e+01 1.7590000e+02
|
||||
1.3333333e+01 3.0500000e+01 1.7490000e+02
|
||||
1.3500000e+01 3.0500000e+01 1.7340000e+02
|
||||
1.3666667e+01 3.0100000e+01 1.7190000e+02
|
||||
1.3833333e+01 3.1500000e+01 1.7180000e+02
|
||||
1.4000000e+01 3.0700000e+01 1.7190000e+02
|
||||
1.4166667e+01 2.9200000e+01 1.6820000e+02
|
||||
1.4333333e+01 3.1200000e+01 1.6770000e+02
|
||||
1.4500000e+01 3.1900000e+01 1.6970000e+02
|
||||
1.4666667e+01 3.1300000e+01 1.7140000e+02
|
||||
1.4833333e+01 3.1300000e+01 1.7500000e+02
|
||||
1.5000000e+01 3.1500000e+01 1.7470000e+02
|
||||
1.5166667e+01 3.1800000e+01 1.7430000e+02
|
||||
1.5333333e+01 3.1500000e+01 1.7460000e+02
|
||||
1.5500000e+01 3.2800000e+01 1.7610000e+02
|
||||
1.5666667e+01 3.2700000e+01 1.7710000e+02
|
||||
1.5833333e+01 3.1000000e+01 1.7970000e+02
|
||||
1.6000000e+01 3.0100000e+01 1.8010000e+02
|
||||
1.6166667e+01 3.0000000e+01 1.7880000e+02
|
||||
1.6333333e+01 2.9200000e+01 1.7930000e+02
|
||||
1.6500000e+01 2.9900000e+01 1.7890000e+02
|
||||
1.6666667e+01 3.0300000e+01 1.7940000e+02
|
||||
1.6833333e+01 3.0700000e+01 1.7930000e+02
|
||||
1.7000000e+01 3.0600000e+01 1.8020000e+02
|
||||
1.7166667e+01 3.0300000e+01 1.7970000e+02
|
||||
1.7333333e+01 3.1100000e+01 1.7920000e+02
|
||||
1.7500000e+01 2.8900000e+01 1.8200000e+02
|
||||
1.7666667e+01 3.0300000e+01 1.8100000e+02
|
||||
1.7833333e+01 2.9900000e+01 1.7940000e+02
|
||||
1.8000000e+01 3.0800000e+01 1.7920000e+02
|
||||
1.8166667e+01 2.9500000e+01 1.7950000e+02
|
||||
1.8333333e+01 3.0600000e+01 1.7900000e+02
|
||||
1.8500000e+01 3.0800000e+01 1.7880000e+02
|
||||
1.8666667e+01 3.0900000e+01 1.8070000e+02
|
||||
1.8833333e+01 3.0700000e+01 1.8040000e+02
|
||||
1.9000000e+01 3.0700000e+01 1.7990000e+02
|
||||
1.9166667e+01 2.9400000e+01 1.8020000e+02
|
||||
1.9333333e+01 2.9100000e+01 1.7990000e+02
|
||||
1.9500000e+01 3.0600000e+01 1.8040000e+02
|
||||
1.9666667e+01 3.0100000e+01 1.8110000e+02
|
||||
1.9833333e+01 3.0000000e+01 1.8130000e+02
|
||||
2.0000000e+01 2.9300000e+01 1.8300000e+02
|
||||
2.0166667e+01 3.0500000e+01 1.8390000e+02
|
||||
2.0333333e+01 3.0800000e+01 1.8470000e+02
|
||||
2.0500000e+01 2.9600000e+01 1.8530000e+02
|
||||
2.0666667e+01 2.8800000e+01 1.8600000e+02
|
||||
2.0833333e+01 2.9100000e+01 1.8640000e+02
|
||||
2.1000000e+01 2.9800000e+01 1.8570000e+02
|
||||
2.1166667e+01 2.8700000e+01 1.8750000e+02
|
||||
2.1333333e+01 2.8700000e+01 1.8640000e+02
|
||||
2.1500000e+01 2.9300000e+01 1.8610000e+02
|
||||
2.1666667e+01 2.8500000e+01 1.8800000e+02
|
||||
2.1833333e+01 2.7200000e+01 1.9140000e+02
|
||||
2.2000000e+01 2.8100000e+01 1.9130000e+02
|
||||
2.2166667e+01 2.7000000e+01 1.9330000e+02
|
||||
2.2333333e+01 2.6300000e+01 1.9900000e+02
|
||||
2.2500000e+01 2.6100000e+01 2.0270000e+02
|
||||
2.2666667e+01 2.4000000e+01 2.1240000e+02
|
||||
2.2833333e+01 2.4000000e+01 2.1840000e+02
|
||||
2.3000000e+01 2.1600000e+01 2.1300000e+02
|
||||
2.3166667e+01 1.8800000e+01 2.0440000e+02
|
||||
2.3333333e+01 1.7700000e+01 1.9810000e+02
|
||||
2.3500000e+01 1.8500000e+01 1.9840000e+02
|
||||
2.3666667e+01 1.9600000e+01 1.9660000e+02
|
||||
2.3833333e+01 1.9200000e+01 1.9410000e+02
|
||||
@ -1,40 +0,0 @@
|
||||
1.0000000000000000e+01 1.2075320000000000e+06
|
||||
1.0000000000000000e+01 1.0013290000000000e+06
|
||||
1.0000000000000000e+01 1.1642510000000000e+06
|
||||
1.0000000000000000e+01 1.0521420000000000e+06
|
||||
1.0000000000000000e+01 1.3143320000000000e+06
|
||||
1.0000000000000000e+01 9.2781600000000000e+05
|
||||
1.0000000000000000e+01 8.5991500000000000e+05
|
||||
1.0000000000000000e+01 9.8150100000000000e+05
|
||||
1.5000000000000000e+01 1.9180900000000000e+05
|
||||
1.5000000000000000e+01 3.5513600000000000e+05
|
||||
1.5000000000000000e+01 2.5113800000000000e+05
|
||||
1.5000000000000000e+01 3.2085900000000000e+05
|
||||
1.5000000000000000e+01 4.2688000000000000e+05
|
||||
1.5000000000000000e+01 1.9037600000000000e+05
|
||||
1.5000000000000000e+01 3.3071300000000000e+05
|
||||
1.5000000000000000e+01 3.1301500000000000e+05
|
||||
2.0000000000000000e+01 6.8162000000000000e+04
|
||||
2.0000000000000000e+01 1.3884800000000000e+05
|
||||
2.0000000000000000e+01 1.0781100000000000e+05
|
||||
2.0000000000000000e+01 1.4487700000000000e+05
|
||||
2.0000000000000000e+01 1.5860000000000000e+05
|
||||
2.0000000000000000e+01 8.9558000000000000e+04
|
||||
2.0000000000000000e+01 1.7458000000000000e+05
|
||||
2.0000000000000000e+01 1.1393600000000000e+05
|
||||
2.5000000000000000e+01 5.3675000000000000e+04
|
||||
2.5000000000000000e+01 6.3114000000000000e+04
|
||||
2.5000000000000000e+01 6.6566000000000000e+04
|
||||
2.5000000000000000e+01 4.6152000000000000e+04
|
||||
2.5000000000000000e+01 5.5601000000000000e+04
|
||||
2.5000000000000000e+01 6.3908000000000000e+04
|
||||
2.5000000000000000e+01 4.6279000000000000e+04
|
||||
2.5000000000000000e+01 4.3226000000000000e+04
|
||||
3.0000000000000000e+01 1.9547000000000000e+04
|
||||
3.0000000000000000e+01 2.4162000000000000e+04
|
||||
3.0000000000000000e+01 2.7696000000000000e+04
|
||||
3.0000000000000000e+01 3.5947000000000000e+04
|
||||
3.0000000000000000e+01 4.9134000000000000e+04
|
||||
3.0000000000000000e+01 2.5054000000000000e+04
|
||||
3.0000000000000000e+01 3.0502000000000000e+04
|
||||
3.0000000000000000e+01 4.1359000000000000e+04
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 23 KiB |
@ -1,211 +0,0 @@
|
||||
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
|
||||
<!-- Generated by Microsoft Visio 11.0, SVG Export, v1.0 wafo.svg Page-3 -->
|
||||
<svg
|
||||
xmlns:v="http://schemas.microsoft.com/visio/2003/SVGExtensions/"
|
||||
xmlns:dc="http://purl.org/dc/elements/1.1/"
|
||||
xmlns:cc="http://web.resource.org/cc/"
|
||||
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
|
||||
xmlns:svg="http://www.w3.org/2000/svg"
|
||||
xmlns="http://www.w3.org/2000/svg"
|
||||
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
|
||||
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
|
||||
width="8.26772in"
|
||||
height="11.6929in"
|
||||
viewBox="0 0 595.276 841.89"
|
||||
xml:space="preserve"
|
||||
color-interpolation-filters="sRGB"
|
||||
class="st4"
|
||||
id="svg2269"
|
||||
sodipodi:version="0.32"
|
||||
inkscape:version="0.45.1"
|
||||
sodipodi:docname="wafoLogoNewWithBorder.svg"
|
||||
inkscape:output_extension="org.inkscape.output.svg.inkscape"
|
||||
sodipodi:docbase="K:\pab\matlab\wafosvn\wafo\data"
|
||||
inkscape:export-filename="K:\pab\seamocs\wafo\wafoOrig3.png"
|
||||
inkscape:export-xdpi="90"
|
||||
inkscape:export-ydpi="90"><metadata
|
||||
id="metadata2325"><rdf:RDF><cc:Work
|
||||
rdf:about=""><dc:format>image/svg+xml</dc:format><dc:type
|
||||
rdf:resource="http://purl.org/dc/dcmitype/StillImage" /></cc:Work></rdf:RDF></metadata><defs
|
||||
id="defs2323">
|
||||
<title
|
||||
id="title2275">Page-3</title>
|
||||
<v:pageProperties
|
||||
v:shadowOffsetY="-8.50394"
|
||||
v:shadowOffsetX="8.50394"
|
||||
v:drawingUnits="24"
|
||||
v:pageScale="0.0393701"
|
||||
v:drawingScale="0.0393701" />
|
||||
|
||||
|
||||
<title
|
||||
id="title2278">Sheet.1</title>
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
<title
|
||||
id="title2306">Sheet.7</title>
|
||||
|
||||
|
||||
</defs><sodipodi:namedview
|
||||
inkscape:window-height="878"
|
||||
inkscape:window-width="1280"
|
||||
inkscape:pageshadow="2"
|
||||
inkscape:pageopacity="0.0"
|
||||
guidetolerance="10.0"
|
||||
gridtolerance="10.0"
|
||||
objecttolerance="10.0"
|
||||
borderopacity="1.0"
|
||||
bordercolor="#666666"
|
||||
pagecolor="#ffffff"
|
||||
id="base"
|
||||
inkscape:zoom="1.7424566"
|
||||
inkscape:cx="353.93418"
|
||||
inkscape:cy="530.60308"
|
||||
inkscape:window-x="0"
|
||||
inkscape:window-y="88"
|
||||
inkscape:current-layer="svg2269" />
|
||||
<v:documentProperties
|
||||
v:langID="1033"
|
||||
v:viewMarkup="false" />
|
||||
|
||||
<style
|
||||
type="text/css"
|
||||
id="style2271">
|
||||
|
||||
.st1 {fill:#99ccff;stroke:#000000;stroke-linecap:round;stroke-linejoin:round;stroke-width:0.72}
|
||||
.st2 {fill:#99ccff}
|
||||
.st3 {stroke:#000000;stroke-linecap:round;stroke-linejoin:round;stroke-width:0.72}
|
||||
.st4 {fill:none;fill-rule:evenodd;font-size:12;overflow:visible;stroke-linecap:square;stroke-miterlimit:3}
|
||||
|
||||
</style>
|
||||
|
||||
|
||||
<g
|
||||
id="g2184"
|
||||
v:mID="6"
|
||||
v:groupContext="shape"
|
||||
transform="translate(353.50185,-422.77482)"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1">
|
||||
<title
|
||||
id="title2186">Sheet.6</title>
|
||||
<path
|
||||
d="M 61.19,841.89 C 55.291356,841.88968 49.448079,840.75226 43.98,838.54 C 39.072299,836.55264 34.545515,833.73101 30.6,830.2 C 23.504453,836.54775 14.61042,840.53172 5.15,841.6 C 3.4401274,841.79314 1.7207458,841.88996 4.5062722e-016,841.89 L 61.19,841.89 z "
|
||||
class="st1"
|
||||
id="path2188"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />
|
||||
</g><path
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1"
|
||||
id="path2308"
|
||||
class="st2"
|
||||
d="M 215.52095,416.85104 L 215.85095,416.76104 C 220.23289,418.1841 224.80414,418.93924 229.41095,419.00104 L 199.43095,419.00104 L 23.50095,419.00104 C 63.19839,418.99975 98.6955,395.07432 112.46095,359.04104 C 112.84246,357.9133 113.24586,356.79309 113.67095,355.68104 C 121.18932,335.97437 135.26527,319.45825 153.53095,308.91104 C 167.48696,300.8565 183.31742,296.6178 199.43095,296.62104 C 220.89105,296.62261 240.78205,307.86584 251.85095,326.25104 C 252.04387,326.5693 252.23387,326.88931 252.42095,327.21104 C 254.07818,330.08102 255.49952,333.08089 256.67095,336.18104 C 248.94376,330.47985 239.6229,327.34608 230.02095,327.22104 L 229.72095,327.21104 C 207.02353,327.05002 187.61763,343.50509 184.06629,365.92354 C 180.51495,388.34199 193.88502,409.98916 215.52095,416.85104 L 215.52095,416.85104 z M 229.41095,419.00104 C 229.51428,419.00139 229.61762,419.00139 229.72095,419.00104 L 229.41095,419.00104 L 229.41095,419.00104 z M 229.72095,419.00104 L 230.02095,419.00104 L 229.72095,419.00104 L 229.72095,419.00104 z " /><path
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1"
|
||||
id="path2310"
|
||||
class="st3"
|
||||
d="M 215.52095,416.85104 L 215.85095,416.76104 C 220.23289,418.1841 224.80414,418.93924 229.41095,419.00104 L 199.43095,419.00104 L 23.50095,419.00104 C 63.19839,418.99975 98.6955,395.07432 112.46095,359.04104 C 112.84246,357.9133 113.24586,356.79309 113.67095,355.68104 C 121.18932,335.97437 135.26527,319.45825 153.53095,308.91104 C 167.48696,300.8565 183.31742,296.6178 199.43095,296.62104 C 220.89105,296.62261 240.78205,307.86584 251.85095,326.25104 C 252.04387,326.5693 252.23387,326.88931 252.42095,327.21104 C 254.07818,330.08102 255.49952,333.08089 256.67095,336.18104 C 248.94376,330.47985 239.6229,327.34608 230.02095,327.22104 L 229.72095,327.21104 C 207.02353,327.05002 187.61763,343.50509 184.06629,365.92354 C 180.51495,388.34199 193.88502,409.98916 215.52095,416.85104 M 229.41095,419.00104 C 229.51428,419.00139 229.61762,419.00139 229.72095,419.00104 L 229.41095,419.00104 M 229.72095,419.00104 L 230.02095,419.00104 L 229.72095,419.00104" /><g
|
||||
style="stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1"
|
||||
id="shape2-2"
|
||||
v:mID="2"
|
||||
v:groupContext="shape"
|
||||
transform="translate(203.0194,-484.1574)">
|
||||
<title
|
||||
id="title2281">Sheet.2</title>
|
||||
<path
|
||||
d="M 5.46,834.97 C 3.3155278,837.00103 1.4764469,839.33188 -1.1925672e-015,841.89 L 8.57,841.89 L 28.44,841.89 C 29.731238,836.8916 31.649812,832.07668 34.15,827.56 C 23.94872,824.92546 13.109603,827.72497 5.46,834.97 L 5.46,834.97 z "
|
||||
class="st1"
|
||||
id="path2283"
|
||||
style="fill:#99ccff;stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />
|
||||
</g><g
|
||||
style="stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1"
|
||||
id="shape3-4"
|
||||
v:mID="3"
|
||||
v:groupContext="shape"
|
||||
transform="translate(76.5354,-422.965)">
|
||||
<title
|
||||
id="title2286">Sheet.3</title>
|
||||
<path
|
||||
d="M 61.19,796 C 61.189242,787.5946 64.646473,779.55907 70.75,773.78 C 70.155747,772.70486 69.518568,771.65401 68.84,770.63 C 66.677258,767.36928 64.106406,764.39851 61.19,761.79 C 51.454477,770.49674 45.889798,782.93907 45.89,796 C 45.891817,806.49692 49.491912,816.67602 56.09,824.84 C 55.25174,825.13694 54.400932,825.39718 53.54,825.62 C 48.525469,826.91402 43.264531,826.91402 38.25,825.62 C 33.231033,824.32414 28.623577,821.77438 24.86,818.21 C 18.758996,812.43332 15.301988,804.40192 15.3,796 C 15.298262,790.78823 16.184266,785.61424 17.92,780.7 C 18.763907,778.31145 19.804127,775.99688 21.03,773.78 C 22.693324,770.7727 24.689169,767.96175 26.98,765.4 C 28.118655,764.13034 29.327196,762.92514 30.6,761.79 C 28.24732,759.68515 25.683747,757.82865 22.95,756.25 C 21.104007,755.18451 19.186031,754.24891 17.21,753.45 C 13.469155,757.31762 10.254769,761.66175 7.65,766.37 C 5.1498118,770.88668 3.2312383,775.7016 1.94,780.7 C 0.65066517,785.69777 -0.0011772613,790.83859 -2.3665698e-015,796 C 0.0026435879,809.05744 5.5670747,821.49558 15.3,830.2 C 17.65268,832.30485 20.216253,834.16135 22.95,835.74 C 27.681348,838.47278 32.862669,840.33873 38.25,841.25 C 40.774359,841.67605 43.329941,841.89013 45.89,841.89 C 53.94722,841.8901 61.862477,839.76901 68.84,835.74 C 73.571348,838.47278 78.752669,840.33873 84.14,841.25 C 86.667652,841.6766 89.226601,841.89068 91.79,841.89 C 97.688644,841.88968 103.53192,840.75226 109,838.54 C 110.97603,837.74109 112.89401,836.80549 114.74,835.74 C 117.47027,834.16077 120.03047,832.30429 122.38,830.2 C 121.11062,829.06458 119.90542,827.85938 118.77,826.59 C 116.47917,824.02825 114.48332,821.2173 112.82,818.21 C 111.59413,815.99312 110.55391,813.67855 109.71,811.29 C 107.97538,806.37892 107.0894,801.20841 107.09,796 C 107.08826,790.78823 107.97427,785.61424 109.71,780.7 C 110.55391,778.31145 111.59413,775.99688 112.82,773.78 C 114.48332,770.7727 116.47917,767.96175 118.77,765.4 C 119.90542,764.13062 121.11062,762.92542 122.38,761.79 C 118.43448,758.25899 113.9077,755.43736 109,753.45 C 105.25915,757.31762 102.04477,761.66175 99.44,766.37 C 96.939812,770.88668 95.021238,775.7016 93.73,780.7 C 92.440665,785.69777 91.788823,790.83859 91.79,796 C 91.789666,801.15806 92.441502,806.29547 93.73,811.29 C 94.430192,814.00083 95.315606,816.66042 96.38,819.25 C 97.276438,821.43051 98.298142,823.55739 99.44,825.62 C 94.422301,826.91574 89.157699,826.91574 84.14,825.62 C 83.279068,825.39718 82.42826,825.13694 81.59,824.84 C 77.552511,823.41294 73.859549,821.15424 70.75,818.21 C 70.083968,817.57897 69.446657,816.9183 68.84,816.23 C 67.4955,814.70535 66.30629,813.05051 65.29,811.29 C 62.605686,806.64125 61.191691,801.36809 61.19,796 z "
|
||||
class="st1"
|
||||
id="path2288"
|
||||
style="fill:#99ccff;stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />
|
||||
</g><g
|
||||
style="stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1"
|
||||
id="shape4-6"
|
||||
v:mID="4"
|
||||
v:groupContext="shape"
|
||||
transform="translate(198.9204,-422.965)">
|
||||
<title
|
||||
id="title2291">Sheet.4</title>
|
||||
<path
|
||||
d="M 47.81,838.54 C 44.069155,834.67238 40.854769,830.32825 38.25,825.62 C 33.233333,816.5536 30.601077,806.36178 30.6,796 L 0,796 C 0.0019883187,804.40192 3.4589958,812.43332 9.56,818.21 C 7.0683158,822.71453 3.8365461,826.76777 -3.5667036e-014,830.2 C 3.9485244,833.73199 8.4787648,836.55366 13.39,838.54 C 18.858079,840.75226 24.701356,841.88968 30.6,841.89 C 36.498644,841.88968 42.341921,840.75226 47.81,838.54 L 47.81,838.54 z "
|
||||
class="st1"
|
||||
id="path2293"
|
||||
style="fill:#99ccff;stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />
|
||||
</g><g
|
||||
id="shape6-10"
|
||||
v:mID="6"
|
||||
v:groupContext="shape"
|
||||
transform="translate(291.16752,-422.77482)"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1">
|
||||
<title
|
||||
id="title2301">Sheet.6</title>
|
||||
<path
|
||||
d="M 61.19,841.89 C 55.291356,841.88968 49.448079,840.75226 43.98,838.54 C 39.072299,836.55264 34.545515,833.73101 30.6,830.2 C 23.504453,836.54775 14.61042,840.53172 5.15,841.6 C 3.4401274,841.79314 1.7207458,841.88996 4.5062722e-016,841.89 L 61.19,841.89 z "
|
||||
class="st1"
|
||||
id="path2303"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />
|
||||
</g><g
|
||||
style="stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1"
|
||||
id="shape8-15"
|
||||
v:mID="8"
|
||||
v:groupContext="shape"
|
||||
transform="translate(321.3044,-438.2631)">
|
||||
<title
|
||||
id="title2313">Sheet.8</title>
|
||||
<path
|
||||
d="M 0.66,804.97 C 0.22124193,807.04805 4.9337977e-005,809.16614 -8.4213233e-016,811.29 C -0.00173203,823.19594 6.9033391,834.02169 17.7,839.04 C 19.389124,839.82517 21.146421,840.45445 22.95,840.92 C 32.112714,843.28407 41.853704,841.27543 49.333795,835.47954 C 56.813885,829.68364 61.191238,820.75278 61.19,811.29 C 61.188145,801.82898 56.809491,792.901 49.329842,787.1074 C 41.850193,781.3138 32.111014,779.30637 22.95,781.67 C 11.698204,784.57362 3.0624758,793.60065 0.66,804.97 L 0.66,804.97 z "
|
||||
class="st1"
|
||||
id="path2315"
|
||||
style="fill:#99ccff;stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />
|
||||
</g><g
|
||||
style="stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1"
|
||||
id="shape9-17"
|
||||
v:mID="9"
|
||||
v:groupContext="shape"
|
||||
transform="translate(244.8144,-434.6517)">
|
||||
<title
|
||||
id="title2318">Sheet.9</title>
|
||||
<path
|
||||
d="M 27.18,783.49 C 30.37046,781.1256 33.986249,779.39749 37.83,778.4 C 47.926884,775.79129 58.657172,778.50496 66.3,785.6 C 66.369401,785.473 66.439402,785.34634 66.51,785.22 C 68.139028,782.30777 69.755833,780.06867 71.975351,777.57698 L 75.762541,773.51888 C 76.9704,772.83669 74.666372,773.66976 76.150703,773.26302 C 74.017571,771.68987 75.329915,772.78466 75.088378,772.5107 C 71.389442,769.29521 68.011435,767.3416 63.49,765.45 C 57.914597,763.11726 51.933717,761.90749 45.89,761.89 C 41.970674,761.87571 38.065628,762.363 34.27,763.34 C 29.730068,764.51346 25.396538,766.37502 21.42,768.86 C 19.249037,770.21628 17.195223,771.75162 15.28,773.45 C 14.00412,774.58169 12.792244,775.78356 11.65,777.05 C 9.3432484,779.60319 7.3306275,782.40744 5.65,785.41 C 4.4101058,787.62889 3.3564901,789.94684 2.5,792.34 C 0.88804139,797.29563 0.044924941,802.46899 3.7470027e-016,807.68 C 0.00072628219,815.45325 1.9758087,823.09895 5.74,829.9 C 8.2316842,834.40453 11.463454,838.45777 15.3,841.89 C 16.569383,840.75458 17.77458,839.54938 18.91,838.28 C 21.091288,835.84112 23.005505,833.17597 24.62,830.33 C 24.700768,830.1871 24.78077,830.04376 24.86,829.9 C 18.756473,824.12093 15.299242,816.0854 15.3,807.68 L 61.19,807.68 C 61.191474,802.46766 62.080862,797.29365 63.82,792.38 L 19.4,792.38 C 20.593932,790.15426 22.125421,788.1269 23.94,786.37 C 24.243724,786.06684 24.553793,785.77011 24.87,785.48 C 25.606291,784.77851 26.377257,784.11435 27.18,783.49 L 27.18,783.49 z "
|
||||
class="st1"
|
||||
id="path2320"
|
||||
style="fill:#99ccff;stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1"
|
||||
sodipodi:nodetypes="cccsccccsccssssccccssccccccccc" />
|
||||
</g><g
|
||||
id="g2190"
|
||||
v:mID="6"
|
||||
v:groupContext="shape"
|
||||
transform="translate(229.31375,-422.77483)"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1">
|
||||
<title
|
||||
id="title2192">Sheet.6</title>
|
||||
<path
|
||||
d="M 61.19,841.89 C 55.291356,841.88968 49.448079,840.75226 43.98,838.54 C 39.072299,836.55264 34.545515,833.73101 30.6,830.2 C 23.504453,836.54775 14.61042,840.53172 5.15,841.6 C 3.4401274,841.79314 1.7207458,841.88996 4.5062722e-016,841.89 L 61.19,841.89 z "
|
||||
class="st1"
|
||||
id="path2194"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:#000000;stroke-width:1.48000216;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1" />
|
||||
</g><g
|
||||
inkscape:groupmode="layer"
|
||||
id="layer1"
|
||||
inkscape:label="W"
|
||||
style="opacity:0.57471266" /><g
|
||||
inkscape:groupmode="layer"
|
||||
id="layer2"
|
||||
inkscape:label="WAVE"
|
||||
sodipodi:insensitive="true" /></svg>
|
||||
|
Before Width: | Height: | Size: 16 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 13 KiB |
@ -1,243 +0,0 @@
|
||||
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
|
||||
<!-- Generated by Microsoft Visio 11.0, SVG Export, v1.0 wafo.svg Page-3 -->
|
||||
<svg
|
||||
xmlns:v="http://schemas.microsoft.com/visio/2003/SVGExtensions/"
|
||||
xmlns:dc="http://purl.org/dc/elements/1.1/"
|
||||
xmlns:cc="http://web.resource.org/cc/"
|
||||
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
|
||||
xmlns:svg="http://www.w3.org/2000/svg"
|
||||
xmlns="http://www.w3.org/2000/svg"
|
||||
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
|
||||
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
|
||||
width="8.26772in"
|
||||
height="11.6929in"
|
||||
viewBox="0 0 595.276 841.89"
|
||||
xml:space="preserve"
|
||||
color-interpolation-filters="sRGB"
|
||||
class="st4"
|
||||
id="svg2269"
|
||||
sodipodi:version="0.32"
|
||||
inkscape:version="0.45.1"
|
||||
sodipodi:docname="wafoLogoNewWithoutBorder.svg"
|
||||
inkscape:output_extension="org.inkscape.output.svg.inkscape"
|
||||
sodipodi:docbase="L:\wafosvn\wafo\data"
|
||||
inkscape:export-filename="K:\pab\seamocs\wafo\wafoOrig3.png"
|
||||
inkscape:export-xdpi="90"
|
||||
inkscape:export-ydpi="90"><metadata
|
||||
id="metadata2325"><rdf:RDF><cc:Work
|
||||
rdf:about=""><dc:format>image/svg+xml</dc:format><dc:type
|
||||
rdf:resource="http://purl.org/dc/dcmitype/StillImage" /></cc:Work></rdf:RDF></metadata><defs
|
||||
id="defs2323">
|
||||
<title
|
||||
id="title2275">Page-3</title>
|
||||
<v:pageProperties
|
||||
v:shadowOffsetY="-8.50394"
|
||||
v:shadowOffsetX="8.50394"
|
||||
v:drawingUnits="24"
|
||||
v:pageScale="0.0393701"
|
||||
v:drawingScale="0.0393701" />
|
||||
|
||||
|
||||
<title
|
||||
id="title2278">Sheet.1</title>
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
</defs><sodipodi:namedview
|
||||
inkscape:window-height="878"
|
||||
inkscape:window-width="1280"
|
||||
inkscape:pageshadow="2"
|
||||
inkscape:pageopacity="0.0"
|
||||
guidetolerance="10.0"
|
||||
gridtolerance="10.0"
|
||||
objecttolerance="10.0"
|
||||
borderopacity="1.0"
|
||||
bordercolor="#666666"
|
||||
pagecolor="#ffffff"
|
||||
id="base"
|
||||
inkscape:zoom="1.7424566"
|
||||
inkscape:cx="353.93418"
|
||||
inkscape:cy="530.60308"
|
||||
inkscape:window-x="22"
|
||||
inkscape:window-y="0"
|
||||
inkscape:current-layer="svg2269" />
|
||||
<v:documentProperties
|
||||
v:langID="1033"
|
||||
v:viewMarkup="false" />
|
||||
|
||||
<style
|
||||
type="text/css"
|
||||
id="style2271">
|
||||
|
||||
.st1 {fill:#99ccff;stroke:#000000;stroke-linecap:round;stroke-linejoin:round;stroke-width:0.72}
|
||||
.st2 {fill:#99ccff}
|
||||
.st3 {stroke:#000000;stroke-linecap:round;stroke-linejoin:round;stroke-width:0.72}
|
||||
.st4 {fill:none;fill-rule:evenodd;font-size:12;overflow:visible;stroke-linecap:square;stroke-miterlimit:3}
|
||||
|
||||
</style>
|
||||
|
||||
|
||||
<g
|
||||
id="shape7-12"
|
||||
v:mID="7"
|
||||
v:groupContext="shape"
|
||||
transform="matrix(-1,0,0,1,256.67095,-422.88896)"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:none;stroke-opacity:1"
|
||||
inkscape:export-filename="L:\wafosvn\wafo\data\wafoLogoNewWithoutBorder.png"
|
||||
inkscape:export-xdpi="90"
|
||||
inkscape:export-ydpi="90">
|
||||
<title
|
||||
id="title2306">Sheet.7</title>
|
||||
<path
|
||||
d="M 41.15,839.74 L 40.82,839.65 C 36.438057,841.07306 31.866812,841.8282 27.26,841.89 L 57.24,841.89 L 233.17,841.89 C 193.47256,841.88871 157.97545,817.96328 144.21,781.93 C 143.82849,780.80226 143.42509,779.68205 143,778.57 C 135.48163,758.86333 121.40568,742.34721 103.14,731.8 C 89.183986,723.74546 73.353531,719.50676 57.24,719.51 C 35.779898,719.51157 15.888896,730.7548 4.82,749.14 C 4.6270847,749.45826 4.4370768,749.77827 4.25,750.1 C 2.5927697,752.96998 1.1714283,755.96985 1.5743344e-014,759.07 C 7.7271908,753.36881 17.04805,750.23504 26.65,750.11 L 26.95,750.1 C 49.647419,749.93898 69.05332,766.39405 72.604659,788.8125 C 76.155997,811.23095 62.785926,832.87812 41.15,839.74 L 41.15,839.74 z M 27.26,841.89 C 27.156667,841.89035 27.053333,841.89035 26.95,841.89 L 27.26,841.89 L 27.26,841.89 z M 26.95,841.89 L 26.65,841.89 L 26.95,841.89 L 26.95,841.89 z "
|
||||
class="st2"
|
||||
id="path2308"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:none;stroke-opacity:1" />
|
||||
<path
|
||||
d="M 41.15,839.74 L 40.82,839.65 C 36.438057,841.07306 31.866812,841.8282 27.26,841.89 L 57.24,841.89 L 233.17,841.89 C 193.47256,841.88871 157.97545,817.96328 144.21,781.93 C 143.82849,780.80226 143.42509,779.68205 143,778.57 C 135.48163,758.86333 121.40568,742.34721 103.14,731.8 C 89.183986,723.74546 73.353531,719.50676 57.24,719.51 C 35.779898,719.51157 15.888896,730.7548 4.82,749.14 C 4.6270847,749.45826 4.4370768,749.77827 4.25,750.1 C 2.5927697,752.96998 1.1714283,755.96985 1.5743344e-014,759.07 C 7.7271908,753.36881 17.04805,750.23504 26.65,750.11 L 26.95,750.1 C 49.647419,749.93898 69.05332,766.39405 72.604659,788.8125 C 76.155997,811.23095 62.785926,832.87812 41.15,839.74 M 27.26,841.89 C 27.156667,841.89035 27.053333,841.89035 26.95,841.89 L 27.26,841.89 M 26.95,841.89 L 26.65,841.89 L 26.95,841.89"
|
||||
class="st3"
|
||||
id="path2310"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:none;stroke-width:0.72000003;stroke-linecap:round;stroke-linejoin:round;stroke-opacity:1" />
|
||||
</g><g
|
||||
style="stroke:none;stroke-opacity:1"
|
||||
id="shape2-2"
|
||||
v:mID="2"
|
||||
v:groupContext="shape"
|
||||
transform="translate(203.0194,-484.1574)"
|
||||
inkscape:export-filename="L:\wafosvn\wafo\data\wafoLogoNewWithoutBorder.png"
|
||||
inkscape:export-xdpi="90"
|
||||
inkscape:export-ydpi="90">
|
||||
<title
|
||||
id="title2281">Sheet.2</title>
|
||||
<path
|
||||
d="M 5.46,834.97 C 3.3155278,837.00103 1.4764469,839.33188 -1.1925672e-015,841.89 L 8.57,841.89 L 28.44,841.89 C 29.731238,836.8916 31.649812,832.07668 34.15,827.56 C 23.94872,824.92546 13.109603,827.72497 5.46,834.97 L 5.46,834.97 z "
|
||||
class="st1"
|
||||
id="path2283"
|
||||
style="fill:#99ccff;stroke:none;stroke-width:0.72000003;stroke-linecap:round;stroke-linejoin:round;stroke-opacity:1" />
|
||||
</g><g
|
||||
style="stroke:none;stroke-opacity:1"
|
||||
id="shape3-4"
|
||||
v:mID="3"
|
||||
v:groupContext="shape"
|
||||
transform="translate(76.5354,-422.965)"
|
||||
inkscape:export-filename="L:\wafosvn\wafo\data\wafoLogoNewWithoutBorder.png"
|
||||
inkscape:export-xdpi="90"
|
||||
inkscape:export-ydpi="90">
|
||||
<title
|
||||
id="title2286">Sheet.3</title>
|
||||
<path
|
||||
d="M 61.19,796 C 61.189242,787.5946 64.646473,779.55907 70.75,773.78 C 70.155747,772.70486 69.518568,771.65401 68.84,770.63 C 66.677258,767.36928 64.106406,764.39851 61.19,761.79 C 51.454477,770.49674 45.889798,782.93907 45.89,796 C 45.891817,806.49692 49.491912,816.67602 56.09,824.84 C 55.25174,825.13694 54.400932,825.39718 53.54,825.62 C 48.525469,826.91402 43.264531,826.91402 38.25,825.62 C 33.231033,824.32414 28.623577,821.77438 24.86,818.21 C 18.758996,812.43332 15.301988,804.40192 15.3,796 C 15.298262,790.78823 16.184266,785.61424 17.92,780.7 C 18.763907,778.31145 19.804127,775.99688 21.03,773.78 C 22.693324,770.7727 24.689169,767.96175 26.98,765.4 C 28.118655,764.13034 29.327196,762.92514 30.6,761.79 C 28.24732,759.68515 25.683747,757.82865 22.95,756.25 C 21.104007,755.18451 19.186031,754.24891 17.21,753.45 C 13.469155,757.31762 10.254769,761.66175 7.65,766.37 C 5.1498118,770.88668 3.2312383,775.7016 1.94,780.7 C 0.65066517,785.69777 -0.0011772613,790.83859 -2.3665698e-015,796 C 0.0026435879,809.05744 5.5670747,821.49558 15.3,830.2 C 17.65268,832.30485 20.216253,834.16135 22.95,835.74 C 27.681348,838.47278 32.862669,840.33873 38.25,841.25 C 40.774359,841.67605 43.329941,841.89013 45.89,841.89 C 53.94722,841.8901 61.862477,839.76901 68.84,835.74 C 73.571348,838.47278 78.752669,840.33873 84.14,841.25 C 86.667652,841.6766 89.226601,841.89068 91.79,841.89 C 97.688644,841.88968 103.53192,840.75226 109,838.54 C 110.97603,837.74109 112.89401,836.80549 114.74,835.74 C 117.47027,834.16077 120.03047,832.30429 122.38,830.2 C 121.11062,829.06458 119.90542,827.85938 118.77,826.59 C 116.47917,824.02825 114.48332,821.2173 112.82,818.21 C 111.59413,815.99312 110.55391,813.67855 109.71,811.29 C 107.97538,806.37892 107.0894,801.20841 107.09,796 C 107.08826,790.78823 107.97427,785.61424 109.71,780.7 C 110.55391,778.31145 111.59413,775.99688 112.82,773.78 C 114.48332,770.7727 116.47917,767.96175 118.77,765.4 C 119.90542,764.13062 121.11062,762.92542 122.38,761.79 C 118.43448,758.25899 113.9077,755.43736 109,753.45 C 105.25915,757.31762 102.04477,761.66175 99.44,766.37 C 96.939812,770.88668 95.021238,775.7016 93.73,780.7 C 92.440665,785.69777 91.788823,790.83859 91.79,796 C 91.789666,801.15806 92.441502,806.29547 93.73,811.29 C 94.430192,814.00083 95.315606,816.66042 96.38,819.25 C 97.276438,821.43051 98.298142,823.55739 99.44,825.62 C 94.422301,826.91574 89.157699,826.91574 84.14,825.62 C 83.279068,825.39718 82.42826,825.13694 81.59,824.84 C 77.552511,823.41294 73.859549,821.15424 70.75,818.21 C 70.083968,817.57897 69.446657,816.9183 68.84,816.23 C 67.4955,814.70535 66.30629,813.05051 65.29,811.29 C 62.605686,806.64125 61.191691,801.36809 61.19,796 z "
|
||||
class="st1"
|
||||
id="path2288"
|
||||
style="fill:#99ccff;stroke:none;stroke-width:0.72000003;stroke-linecap:round;stroke-linejoin:round;stroke-opacity:1" />
|
||||
</g><g
|
||||
style="stroke:none;stroke-opacity:1"
|
||||
id="shape4-6"
|
||||
v:mID="4"
|
||||
v:groupContext="shape"
|
||||
transform="translate(198.9204,-422.965)"
|
||||
inkscape:export-filename="L:\wafosvn\wafo\data\wafoLogoNewWithoutBorder.png"
|
||||
inkscape:export-xdpi="90"
|
||||
inkscape:export-ydpi="90">
|
||||
<title
|
||||
id="title2291">Sheet.4</title>
|
||||
<path
|
||||
d="M 47.81,838.54 C 44.069155,834.67238 40.854769,830.32825 38.25,825.62 C 33.233333,816.5536 30.601077,806.36178 30.6,796 L 0,796 C 0.0019883187,804.40192 3.4589958,812.43332 9.56,818.21 C 7.0683158,822.71453 3.8365461,826.76777 -3.5667036e-014,830.2 C 3.9485244,833.73199 8.4787648,836.55366 13.39,838.54 C 18.858079,840.75226 24.701356,841.88968 30.6,841.89 C 36.498644,841.88968 42.341921,840.75226 47.81,838.54 L 47.81,838.54 z "
|
||||
class="st1"
|
||||
id="path2293"
|
||||
style="fill:#99ccff;stroke:none;stroke-width:0.72000003;stroke-linecap:round;stroke-linejoin:round;stroke-opacity:1" />
|
||||
</g><g
|
||||
id="shape6-10"
|
||||
v:mID="6"
|
||||
v:groupContext="shape"
|
||||
transform="translate(291.16752,-422.77482)"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:none;stroke-opacity:1"
|
||||
inkscape:export-filename="L:\wafosvn\wafo\data\wafoLogoNewWithoutBorder.png"
|
||||
inkscape:export-xdpi="90"
|
||||
inkscape:export-ydpi="90">
|
||||
<title
|
||||
id="title2301">Sheet.6</title>
|
||||
<path
|
||||
d="M 61.19,841.89 C 55.291356,841.88968 49.448079,840.75226 43.98,838.54 C 39.072299,836.55264 34.545515,833.73101 30.6,830.2 C 23.504453,836.54775 14.61042,840.53172 5.15,841.6 C 3.4401274,841.79314 1.7207458,841.88996 4.5062722e-016,841.89 L 61.19,841.89 z "
|
||||
class="st1"
|
||||
id="path2303"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:none;stroke-width:0.72000003;stroke-linecap:round;stroke-linejoin:round;stroke-opacity:1" />
|
||||
</g><g
|
||||
style="stroke:none;stroke-opacity:1"
|
||||
id="shape8-15"
|
||||
v:mID="8"
|
||||
v:groupContext="shape"
|
||||
transform="translate(321.3044,-438.2631)"
|
||||
inkscape:export-filename="L:\wafosvn\wafo\data\wafoLogoNewWithoutBorder.png"
|
||||
inkscape:export-xdpi="90"
|
||||
inkscape:export-ydpi="90">
|
||||
<title
|
||||
id="title2313">Sheet.8</title>
|
||||
<path
|
||||
d="M 0.66,804.97 C 0.22124193,807.04805 4.9337977e-005,809.16614 -8.4213233e-016,811.29 C -0.00173203,823.19594 6.9033391,834.02169 17.7,839.04 C 19.389124,839.82517 21.146421,840.45445 22.95,840.92 C 32.112714,843.28407 41.853704,841.27543 49.333795,835.47954 C 56.813885,829.68364 61.191238,820.75278 61.19,811.29 C 61.188145,801.82898 56.809491,792.901 49.329842,787.1074 C 41.850193,781.3138 32.111014,779.30637 22.95,781.67 C 11.698204,784.57362 3.0624758,793.60065 0.66,804.97 L 0.66,804.97 z "
|
||||
class="st1"
|
||||
id="path2315"
|
||||
style="fill:#99ccff;stroke:none;stroke-width:0.72000003;stroke-linecap:round;stroke-linejoin:round;stroke-opacity:1" />
|
||||
</g><g
|
||||
style="stroke:none;stroke-opacity:1"
|
||||
id="shape9-17"
|
||||
v:mID="9"
|
||||
v:groupContext="shape"
|
||||
transform="translate(244.8144,-434.6517)"
|
||||
inkscape:export-filename="L:\wafosvn\wafo\data\wafoLogoNewWithoutBorder.png"
|
||||
inkscape:export-xdpi="90"
|
||||
inkscape:export-ydpi="90">
|
||||
<title
|
||||
id="title2318">Sheet.9</title>
|
||||
<path
|
||||
d="M 27.18,783.49 C 30.37046,781.1256 33.986249,779.39749 37.83,778.4 C 47.926884,775.79129 58.657172,778.50496 66.3,785.6 C 66.369401,785.473 66.439402,785.34634 66.51,785.22 C 68.139028,782.30777 69.755833,780.06867 71.975351,777.57698 L 75.762541,773.51888 C 76.9704,772.83669 74.666372,773.66976 76.150703,773.26302 C 74.017571,771.68987 75.329915,772.78466 75.088378,772.5107 C 71.389442,769.29521 68.011435,767.3416 63.49,765.45 C 57.914597,763.11726 51.933717,761.90749 45.89,761.89 C 41.970674,761.87571 38.065628,762.363 34.27,763.34 C 29.730068,764.51346 25.396538,766.37502 21.42,768.86 C 19.249037,770.21628 17.195223,771.75162 15.28,773.45 C 14.00412,774.58169 12.792244,775.78356 11.65,777.05 C 9.3432484,779.60319 7.3306275,782.40744 5.65,785.41 C 4.4101058,787.62889 3.3564901,789.94684 2.5,792.34 C 0.88804139,797.29563 0.044924941,802.46899 3.7470027e-016,807.68 C 0.00072628219,815.45325 1.9758087,823.09895 5.74,829.9 C 8.2316842,834.40453 11.463454,838.45777 15.3,841.89 C 16.569383,840.75458 17.77458,839.54938 18.91,838.28 C 21.091288,835.84112 23.005505,833.17597 24.62,830.33 C 24.700768,830.1871 24.78077,830.04376 24.86,829.9 C 18.756473,824.12093 15.299242,816.0854 15.3,807.68 L 61.19,807.68 C 61.191474,802.46766 62.080862,797.29365 63.82,792.38 L 19.4,792.38 C 20.593932,790.15426 22.125421,788.1269 23.94,786.37 C 24.243724,786.06684 24.553793,785.77011 24.87,785.48 C 25.606291,784.77851 26.377257,784.11435 27.18,783.49 L 27.18,783.49 z "
|
||||
class="st1"
|
||||
id="path2320"
|
||||
style="fill:#99ccff;stroke:none;stroke-width:0.72000003;stroke-linecap:round;stroke-linejoin:round;stroke-opacity:1"
|
||||
sodipodi:nodetypes="cccsccccsccssssccccssccccccccc" />
|
||||
</g><g
|
||||
id="g2184"
|
||||
v:mID="6"
|
||||
v:groupContext="shape"
|
||||
transform="translate(353.50185,-422.77482)"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:none;stroke-opacity:1"
|
||||
inkscape:export-filename="L:\wafosvn\wafo\data\wafoLogoNewWithoutBorder.png"
|
||||
inkscape:export-xdpi="90"
|
||||
inkscape:export-ydpi="90">
|
||||
<title
|
||||
id="title2186">Sheet.6</title>
|
||||
<path
|
||||
d="M 61.19,841.89 C 55.291356,841.88968 49.448079,840.75226 43.98,838.54 C 39.072299,836.55264 34.545515,833.73101 30.6,830.2 C 23.504453,836.54775 14.61042,840.53172 5.15,841.6 C 3.4401274,841.79314 1.7207458,841.88996 4.5062722e-016,841.89 L 61.19,841.89 z "
|
||||
class="st1"
|
||||
id="path2188"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:none;stroke-width:0.72000003;stroke-linecap:round;stroke-linejoin:round;stroke-opacity:1" />
|
||||
</g><g
|
||||
id="g2190"
|
||||
v:mID="6"
|
||||
v:groupContext="shape"
|
||||
transform="translate(229.31375,-422.77483)"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:none;stroke-opacity:1"
|
||||
inkscape:export-filename="L:\wafosvn\wafo\data\wafoLogoNewWithoutBorder.png"
|
||||
inkscape:export-xdpi="90"
|
||||
inkscape:export-ydpi="90">
|
||||
<title
|
||||
id="title2192">Sheet.6</title>
|
||||
<path
|
||||
d="M 61.19,841.89 C 55.291356,841.88968 49.448079,840.75226 43.98,838.54 C 39.072299,836.55264 34.545515,833.73101 30.6,830.2 C 23.504453,836.54775 14.61042,840.53172 5.15,841.6 C 3.4401274,841.79314 1.7207458,841.88996 4.5062722e-016,841.89 L 61.19,841.89 z "
|
||||
class="st1"
|
||||
id="path2194"
|
||||
style="fill:#195fdd;fill-opacity:1;stroke:none;stroke-width:0.72000003;stroke-linecap:round;stroke-linejoin:round;stroke-opacity:1" />
|
||||
</g><g
|
||||
inkscape:groupmode="layer"
|
||||
id="layer1"
|
||||
inkscape:label="W"
|
||||
style="opacity:0.57471266" /><g
|
||||
inkscape:groupmode="layer"
|
||||
id="layer2"
|
||||
inkscape:label="WAVE"
|
||||
sodipodi:insensitive="true" /></svg>
|
||||
|
Before Width: | Height: | Size: 15 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 24 KiB |
File diff suppressed because it is too large
Load Diff
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@ -1,73 +0,0 @@
|
||||
{
|
||||
"metadata": {
|
||||
"name": "WAFO Chapter 3"
|
||||
},
|
||||
"nbformat": 3,
|
||||
"nbformat_minor": 0,
|
||||
"worksheets": [
|
||||
{
|
||||
"cells": [
|
||||
{
|
||||
"cell_type": "markdown",
|
||||
"metadata": {},
|
||||
"source": [
|
||||
"CHAPTER3 Demonstrates distributions of wave characteristics\n",
|
||||
"=============================================================\n",
|
||||
"\n",
|
||||
"Chapter3 contains the commands used in Chapter3 in the tutorial.\n",
|
||||
" \n",
|
||||
"Some of the commands are edited for fast computation. \n",
|
||||
"\n",
|
||||
"Section 3.2 Estimation of wave characteristics from data\n",
|
||||
"----------------------------------------------------------\n",
|
||||
"Example 1\n",
|
||||
"~~~~~~~~~~ "
|
||||
]
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"collapsed": false,
|
||||
"input": [
|
||||
"speed = 'fast'\n",
|
||||
"#speed = 'slow'\n",
|
||||
"\n",
|
||||
"import wafo.data as wd\n",
|
||||
"import wafo.misc as wm\n",
|
||||
"import wafo.objects as wo\n",
|
||||
"xx = wd.sea() \n",
|
||||
"xx[:,1] = wm.detrendma(xx[:,1],len(xx))\n",
|
||||
"ts = wo.mat2timeseries(xx)\n",
|
||||
"Tcrcr, ix = ts.wave_periods(vh=0, pdef='c2c', wdef='tw', rate=8)\n",
|
||||
"Tc, ixc = ts.wave_periods(vh=0, pdef='u2d', wdef='tw', rate=8)"
|
||||
],
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": [
|
||||
{
|
||||
"ename": "AssertionError",
|
||||
"evalue": "",
|
||||
"output_type": "pyerr",
|
||||
"traceback": [
|
||||
"\u001b[1;31m---------------------------------------------------------------------------\u001b[0m\n\u001b[1;31mAssertionError\u001b[0m Traceback (most recent call last)",
|
||||
"\u001b[1;32m<ipython-input-12-5b70e90102e6>\u001b[0m in \u001b[0;36m<module>\u001b[1;34m()\u001b[0m\n\u001b[0;32m 8\u001b[0m \u001b[0mxx\u001b[0m\u001b[1;33m[\u001b[0m\u001b[1;33m:\u001b[0m\u001b[1;33m,\u001b[0m\u001b[1;36m1\u001b[0m\u001b[1;33m]\u001b[0m \u001b[1;33m=\u001b[0m \u001b[0mwm\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0mdetrendma\u001b[0m\u001b[1;33m(\u001b[0m\u001b[0mxx\u001b[0m\u001b[1;33m[\u001b[0m\u001b[1;33m:\u001b[0m\u001b[1;33m,\u001b[0m\u001b[1;36m1\u001b[0m\u001b[1;33m]\u001b[0m\u001b[1;33m,\u001b[0m\u001b[0mlen\u001b[0m\u001b[1;33m(\u001b[0m\u001b[0mxx\u001b[0m\u001b[1;33m)\u001b[0m\u001b[1;33m)\u001b[0m\u001b[1;33m\u001b[0m\u001b[0m\n\u001b[0;32m 9\u001b[0m \u001b[0mts\u001b[0m \u001b[1;33m=\u001b[0m \u001b[0mwo\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0mmat2timeseries\u001b[0m\u001b[1;33m(\u001b[0m\u001b[0mxx\u001b[0m\u001b[1;33m)\u001b[0m\u001b[1;33m\u001b[0m\u001b[0m\n\u001b[1;32m---> 10\u001b[1;33m \u001b[0mTcrcr\u001b[0m\u001b[1;33m,\u001b[0m \u001b[0mix\u001b[0m \u001b[1;33m=\u001b[0m \u001b[0mts\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0mwave_periods\u001b[0m\u001b[1;33m(\u001b[0m\u001b[0mvh\u001b[0m\u001b[1;33m=\u001b[0m\u001b[1;36m0\u001b[0m\u001b[1;33m,\u001b[0m \u001b[0mpdef\u001b[0m\u001b[1;33m=\u001b[0m\u001b[1;34m'c2c'\u001b[0m\u001b[1;33m,\u001b[0m \u001b[0mwdef\u001b[0m\u001b[1;33m=\u001b[0m\u001b[1;34m'tw'\u001b[0m\u001b[1;33m,\u001b[0m \u001b[0mrate\u001b[0m\u001b[1;33m=\u001b[0m\u001b[1;36m8\u001b[0m\u001b[1;33m)\u001b[0m\u001b[1;33m\u001b[0m\u001b[0m\n\u001b[0m\u001b[0;32m 11\u001b[0m \u001b[0mTc\u001b[0m\u001b[1;33m,\u001b[0m \u001b[0mixc\u001b[0m \u001b[1;33m=\u001b[0m \u001b[0mts\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0mwave_periods\u001b[0m\u001b[1;33m(\u001b[0m\u001b[0mvh\u001b[0m\u001b[1;33m=\u001b[0m\u001b[1;36m0\u001b[0m\u001b[1;33m,\u001b[0m \u001b[0mpdef\u001b[0m\u001b[1;33m=\u001b[0m\u001b[1;34m'u2d'\u001b[0m\u001b[1;33m,\u001b[0m \u001b[0mwdef\u001b[0m\u001b[1;33m=\u001b[0m\u001b[1;34m'tw'\u001b[0m\u001b[1;33m,\u001b[0m \u001b[0mrate\u001b[0m\u001b[1;33m=\u001b[0m\u001b[1;36m8\u001b[0m\u001b[1;33m)\u001b[0m\u001b[1;33m\u001b[0m\u001b[0m\n",
|
||||
"\u001b[1;32mc:\\pab\\workspace\\pywafo_svn\\pywafo\\src\\wafo\\objects.pyc\u001b[0m in \u001b[0;36mwave_periods\u001b[1;34m(self, vh, pdef, wdef, index, rate)\u001b[0m\n\u001b[0;32m 1980\u001b[0m \u001b[0mn\u001b[0m \u001b[1;33m=\u001b[0m \u001b[0mceil\u001b[0m\u001b[1;33m(\u001b[0m\u001b[0mself\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0mdata\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0msize\u001b[0m \u001b[1;33m*\u001b[0m \u001b[0mrate\u001b[0m\u001b[1;33m)\u001b[0m\u001b[1;33m\u001b[0m\u001b[0m\n\u001b[0;32m 1981\u001b[0m \u001b[0mti\u001b[0m \u001b[1;33m=\u001b[0m \u001b[0mlinspace\u001b[0m\u001b[1;33m(\u001b[0m\u001b[0mself\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0margs\u001b[0m\u001b[1;33m[\u001b[0m\u001b[1;36m0\u001b[0m\u001b[1;33m]\u001b[0m\u001b[1;33m,\u001b[0m \u001b[0mself\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0margs\u001b[0m\u001b[1;33m[\u001b[0m\u001b[1;33m-\u001b[0m\u001b[1;36m1\u001b[0m\u001b[1;33m]\u001b[0m\u001b[1;33m,\u001b[0m \u001b[0mn\u001b[0m\u001b[1;33m)\u001b[0m\u001b[1;33m\u001b[0m\u001b[0m\n\u001b[1;32m-> 1982\u001b[1;33m \u001b[0mx\u001b[0m \u001b[1;33m=\u001b[0m \u001b[0mstineman_interp\u001b[0m\u001b[1;33m(\u001b[0m\u001b[0mti\u001b[0m\u001b[1;33m,\u001b[0m \u001b[0mself\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0margs\u001b[0m\u001b[1;33m,\u001b[0m \u001b[0mself\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0mdata\u001b[0m\u001b[1;33m)\u001b[0m\u001b[1;33m\u001b[0m\u001b[0m\n\u001b[0m\u001b[0;32m 1983\u001b[0m \u001b[1;32melse\u001b[0m\u001b[1;33m:\u001b[0m\u001b[1;33m\u001b[0m\u001b[0m\n\u001b[0;32m 1984\u001b[0m \u001b[0mx\u001b[0m \u001b[1;33m=\u001b[0m \u001b[0mself\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0mdata\u001b[0m\u001b[1;33m\u001b[0m\u001b[0m\n",
|
||||
"\u001b[1;32mC:\\Python27\\lib\\site-packages\\matplotlib\\mlab.pyc\u001b[0m in \u001b[0;36mstineman_interp\u001b[1;34m(xi, x, y, yp)\u001b[0m\n\u001b[0;32m 2932\u001b[0m \u001b[0mx\u001b[0m\u001b[1;33m=\u001b[0m\u001b[0mnp\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0masarray\u001b[0m\u001b[1;33m(\u001b[0m\u001b[0mx\u001b[0m\u001b[1;33m,\u001b[0m \u001b[0mnp\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0mfloat_\u001b[0m\u001b[1;33m)\u001b[0m\u001b[1;33m\u001b[0m\u001b[0m\n\u001b[0;32m 2933\u001b[0m \u001b[0my\u001b[0m\u001b[1;33m=\u001b[0m\u001b[0mnp\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0masarray\u001b[0m\u001b[1;33m(\u001b[0m\u001b[0my\u001b[0m\u001b[1;33m,\u001b[0m \u001b[0mnp\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0mfloat_\u001b[0m\u001b[1;33m)\u001b[0m\u001b[1;33m\u001b[0m\u001b[0m\n\u001b[1;32m-> 2934\u001b[1;33m \u001b[1;32massert\u001b[0m \u001b[0mx\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0mshape\u001b[0m \u001b[1;33m==\u001b[0m \u001b[0my\u001b[0m\u001b[1;33m.\u001b[0m\u001b[0mshape\u001b[0m\u001b[1;33m\u001b[0m\u001b[0m\n\u001b[0m\u001b[0;32m 2935\u001b[0m \u001b[1;33m\u001b[0m\u001b[0m\n\u001b[0;32m 2936\u001b[0m \u001b[1;32mif\u001b[0m \u001b[0myp\u001b[0m \u001b[1;32mis\u001b[0m \u001b[0mNone\u001b[0m\u001b[1;33m:\u001b[0m\u001b[1;33m\u001b[0m\u001b[0m\n",
|
||||
"\u001b[1;31mAssertionError\u001b[0m: "
|
||||
]
|
||||
}
|
||||
],
|
||||
"prompt_number": 12
|
||||
},
|
||||
{
|
||||
"cell_type": "code",
|
||||
"collapsed": false,
|
||||
"input": [],
|
||||
"language": "python",
|
||||
"metadata": {},
|
||||
"outputs": []
|
||||
}
|
||||
],
|
||||
"metadata": {}
|
||||
}
|
||||
]
|
||||
}
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@ -1,192 +0,0 @@
|
||||
import wafo.plotbackend.plotbackend as plt
|
||||
import numpy as np
|
||||
# pyreport -o chapter1.html chapter1.py
|
||||
|
||||
#! CHAPTER1 demonstrates some applications of WAFO
|
||||
#!================================================
|
||||
#!
|
||||
#! CHAPTER1 gives an overview through examples some of the capabilities of
|
||||
#! WAFO. WAFO is a toolbox of Matlab routines for statistical analysis and
|
||||
#! simulation of random waves and loads.
|
||||
#!
|
||||
#! The commands are edited for fast computation.
|
||||
|
||||
|
||||
#! Section 1.4 Some applications of WAFO
|
||||
#!---------------------------------------
|
||||
#! Section 1.4.1 Simulation from spectrum, estimation of spectrum
|
||||
#!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
#! Simulation of the sea surface from spectrum
|
||||
#! The following code generates 200 seconds of data sampled with 10Hz from
|
||||
#! the Torsethaugen spectrum
|
||||
import wafo.spectrum.models as wsm
|
||||
S = wsm.Torsethaugen(Hm0=6, Tp=8)
|
||||
S1 = S.tospecdata()
|
||||
S1.plot()
|
||||
plt.show()
|
||||
|
||||
|
||||
##
|
||||
import wafo.objects as wo
|
||||
xs = S1.sim(ns=2000, dt=0.1)
|
||||
ts = wo.mat2timeseries(xs)
|
||||
ts.plot_wave('-')
|
||||
plt.show()
|
||||
|
||||
|
||||
#! Estimation of spectrum
|
||||
#!~~~~~~~~~~~~~~~~~~~~~~~
|
||||
#! A common situation is that one wants to estimate the spectrum for wave
|
||||
#! measurements. The following code simulate 20 minutes signal sampled at 4Hz
|
||||
#! and compare the spectral estimate with the original Torsethaugen spectum.
|
||||
plt.clf()
|
||||
Fs = 4
|
||||
xs = S1.sim(ns=np.fix(20 * 60 * Fs), dt=1. / Fs)
|
||||
ts = wo.mat2timeseries(xs)
|
||||
Sest = ts.tospecdata(L=400)
|
||||
S1.plot()
|
||||
Sest.plot('--')
|
||||
plt.axis([0, 3, 0, 5])
|
||||
plt.show()
|
||||
|
||||
#! Section 1.4.2 Probability distributions of wave characteristics.
|
||||
#!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
#! Probability distribution of wave trough period:
|
||||
#! WAFO gives the possibility of computing the exact probability
|
||||
#! distributions for a number of characteristics given a spectral density.
|
||||
#! In the following example we study the trough period extracted from the
|
||||
#! time series and compared with the theoretical density computed with exact
|
||||
#! spectrum, S1, and the estimated spectrum, Sest.
|
||||
plt.clf()
|
||||
import wafo.misc as wm
|
||||
dtyex = S1.to_t_pdf(pdef='Tt', paramt=(0, 10, 51), nit=3)
|
||||
dtyest = Sest.to_t_pdf(pdef='Tt', paramt=(0, 10, 51), nit=3)
|
||||
|
||||
T, index = ts.wave_periods(vh=0, pdef='d2u')
|
||||
bins = wm.good_bins(T, num_bins=25, odd=True)
|
||||
wm.plot_histgrm(T, bins=bins, normed=True)
|
||||
|
||||
dtyex.plot()
|
||||
dtyest.plot('-.')
|
||||
plt.axis([0, 10, 0, 0.35])
|
||||
plt.show()
|
||||
|
||||
#! Section 1.4.3 Directional spectra
|
||||
#!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
#! Here are a few lines of code, which produce directional spectra
|
||||
#! with frequency independent and frequency dependent spreading.
|
||||
plt.clf()
|
||||
plotflag = 1
|
||||
Nt = 101 # number of angles
|
||||
th0 = np.pi / 2 # primary direction of waves
|
||||
Sp = 15 # spreading parameter
|
||||
|
||||
D1 = wsm.Spreading(type='cos', theta0=th0, method=None)
|
||||
D12 = wsm.Spreading(type='cos', theta0=0, method='mitsuyasu')
|
||||
|
||||
SD1 = D1.tospecdata2d(S1)
|
||||
SD12 = D12.tospecdata2d(S1)
|
||||
SD1.plot()
|
||||
SD12.plot() # linestyle='dashdot')
|
||||
plt.show()
|
||||
|
||||
#! 3D Simulation of the sea surface
|
||||
#!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
#! The simulations show that frequency dependent spreading leads to
|
||||
#! much more irregular surface so the orientation of waves is less
|
||||
#! transparent compared to the frequency independent case.
|
||||
#
|
||||
#! Frequency independent spreading
|
||||
#plotflag = 1; iseed = 1;
|
||||
#
|
||||
#Nx = 2 ^ 8;Ny = Nx;Nt = 1;dx = 0.5; dy = dx; dt = 0.25; fftdim = 2;
|
||||
#randn('state', iseed)
|
||||
#Y1 = seasim(SD1, Nx, Ny, Nt, dx, dy, dt, fftdim, plotflag);
|
||||
#wafostamp('', '(ER)')
|
||||
#axis('fill')
|
||||
#disp('Block = 6'), pause(pstate)
|
||||
#
|
||||
###
|
||||
## Frequency dependent spreading
|
||||
#randn('state', iseed)
|
||||
#Y12 = seasim(SD12, Nx, Ny, Nt, dx, dy, dt, fftdim, plotflag);
|
||||
#wafostamp('', '(ER)')
|
||||
#axis('fill')
|
||||
#disp('Block = 7'), pause(pstate)
|
||||
#
|
||||
#! Estimation of directional spectrum
|
||||
#!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
#! The figure is not shown in the Tutorial
|
||||
#
|
||||
# Nx = 3; Ny = 2; Nt = 2 ^ 12; dx = 10; dy = 10;dt = 0.5;
|
||||
# F = seasim(SD12, Nx, Ny, Nt, dx, dy, dt, 1, 0);
|
||||
# Z = permute(F.Z, [3 1 2]);
|
||||
# [X, Y] = meshgrid(F.x, F.y);
|
||||
# N = Nx * Ny;
|
||||
# types = repmat(sensortypeid('n'), N, 1);
|
||||
# bfs = ones(N, 1);
|
||||
# pos = [X(:), Y(:), zeros(N, 1)];
|
||||
# h = inf;
|
||||
# nfft = 128;
|
||||
# nt = 101;
|
||||
# SDe = dat2dspec([F.t Z(:, :)], [pos types, bfs], h, nfft, nt);
|
||||
#plotspec(SDe), hold on
|
||||
#plotspec(SD12, '--'), hold off
|
||||
#disp('Block = 8'), pause(pstate)
|
||||
|
||||
#! Section 1.4.4 Fatigue, Load cycles and Markov models.
|
||||
#! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
#! Switching Markow chain of turningpoints
|
||||
#! In fatigue applications the exact sample path is not important, but
|
||||
#! only the tops and bottoms of the load, called the sequence of turning
|
||||
#! points (TP). From the turning points one can extract load cycles, from
|
||||
#! which damage calculations and fatigue life predictions can be
|
||||
#! performed.
|
||||
#!
|
||||
#! The commands below computes the intensity of rainflowcycles for
|
||||
#! the Gaussian model with spectrum S1 using the Markov approximation.
|
||||
#! The rainflow cycles found in the simulated load signal are shown in the
|
||||
#! figure.
|
||||
|
||||
#clf()
|
||||
#paramu = [-6 6 61];
|
||||
#frfc = spec2cmat(S1, [], 'rfc', [], paramu);
|
||||
#pdfplot(frfc);
|
||||
#hold on
|
||||
#tp = dat2tp(xs);
|
||||
#rfc = tp2rfc(tp);
|
||||
#plot(rfc(:, 2), rfc(:, 1), '.')
|
||||
#wafostamp('', '(ER)')
|
||||
#hold off
|
||||
#disp('Block = 9'), pause(pstate)
|
||||
|
||||
#! Section 1.4.5 Extreme value statistics
|
||||
#!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
# Plot of yura87 data
|
||||
plt.clf()
|
||||
import wafo.data as wd
|
||||
xn = wd.yura87()
|
||||
#xn = load('yura87.dat');
|
||||
plt.subplot(211)
|
||||
plt.plot(xn[::30, 0] / 3600, xn[::30, 1], '.')
|
||||
plt.title('Water level')
|
||||
plt.ylabel('(m)')
|
||||
|
||||
#! Formation of 5 min maxima
|
||||
yura = xn[:85500, 1]
|
||||
yura = np.reshape(yura, (285, 300)).T
|
||||
maxyura = yura.max(axis=0)
|
||||
plt.subplot(212)
|
||||
plt.plot(xn[299:85500:300, 0] / 3600, maxyura, '.')
|
||||
plt.xlabel('Time (h)')
|
||||
plt.ylabel('(m)')
|
||||
plt.title('Maximum 5 min water level')
|
||||
plt.show()
|
||||
|
||||
#! Estimation of GEV for yuramax
|
||||
plt.clf()
|
||||
import wafo.stats as ws
|
||||
phat = ws.genextreme.fit2(maxyura, method='ml')
|
||||
phat.plotfitsummary()
|
||||
plt.show()
|
||||
#disp('Block = 11, Last block')
|
||||
@ -1,327 +0,0 @@
|
||||
import wafo.plotbackend.plotbackend as plt
|
||||
import numpy as np
|
||||
|
||||
# pyreport -o chapter2.html chapter2.py
|
||||
|
||||
#! CHAPTER2 Modelling random loads and stochastic waves
|
||||
#!=======================================================
|
||||
#!
|
||||
#! Chapter2 contains the commands used in Chapter 2 of the tutorial and
|
||||
#! present some tools for analysis of random functions with
|
||||
#! respect to their correlation, spectral and distributional properties.
|
||||
#! The presentation is divided into three examples:
|
||||
#!
|
||||
#! Example1 is devoted to estimation of different parameters in the model.
|
||||
#! Example2 deals with spectral densities and
|
||||
#! Example3 presents the use of WAFO to simulate samples of a Gaussian
|
||||
#! process.
|
||||
#!
|
||||
#! Some of the commands are edited for fast computation.
|
||||
#!
|
||||
#! Section 2.1 Introduction and preliminary analysis
|
||||
#!====================================================
|
||||
#! Example 1: Sea data
|
||||
#!----------------------
|
||||
#! Observed crossings compared to the expected for Gaussian signals
|
||||
|
||||
import wafo
|
||||
import wafo.objects as wo
|
||||
xx = wafo.data.sea()
|
||||
me = xx[:, 1].mean()
|
||||
sa = xx[:, 1].std()
|
||||
xx[:, 1] -= me
|
||||
ts = wo.mat2timeseries(xx)
|
||||
tp = ts.turning_points()
|
||||
|
||||
cc = tp.cycle_pairs()
|
||||
lc = cc.level_crossings()
|
||||
lc.plot()
|
||||
plt.show()
|
||||
|
||||
#! Average number of upcrossings per time unit
|
||||
#!----------------------------------------------
|
||||
#! Next we compute the mean frequency as the average number of upcrossings
|
||||
#! per time unit of the mean level (= 0); this may require interpolation in the
|
||||
#! crossing intensity curve, as follows.
|
||||
T = xx[:, 0].max() - xx[:, 0].min()
|
||||
f0 = np.interp(0, lc.args, lc.data, 0) / T # zero up-crossing frequency
|
||||
print('f0 = %g' % f0)
|
||||
|
||||
#! Turningpoints and irregularity factor
|
||||
#!----------------------------------------
|
||||
|
||||
fm = len(tp.data) / (2 * T) # frequency of maxima
|
||||
alfa = f0 / fm # approx Tm24/Tm02
|
||||
|
||||
print('fm = %g, alpha = %g, ' % (fm, alfa))
|
||||
|
||||
#! Visually examine data
|
||||
#!------------------------
|
||||
#! We finish this section with some remarks about the quality
|
||||
#! of the measured data. Especially sea surface measurements can be
|
||||
#! of poor quality. We shall now check the quality of the dataset {\tt xx}.
|
||||
#! It is always good practice to visually examine the data
|
||||
#! before the analysis to get an impression of the quality,
|
||||
#! non-linearities and narrow-bandedness of the data.
|
||||
#! First we shall plot the data and zoom in on a specific region.
|
||||
#! A part of sea data is visualized with the following commands
|
||||
plt.clf()
|
||||
ts.plot_wave('k-', tp, '*', nfig=1, nsub=1)
|
||||
|
||||
plt.axis([0, 2, -2, 2])
|
||||
plt.show()
|
||||
|
||||
#! Finding possible spurious points
|
||||
#!------------------------------------
|
||||
#! However, if the amount of data is too large for visual examinations one
|
||||
#! could use the following criteria to find possible spurious points. One
|
||||
#! must be careful using the criteria for extremevalue analysis, because
|
||||
#! it might remove extreme waves that are OK and not spurious.
|
||||
|
||||
import wafo.misc as wm
|
||||
dt = ts.sampling_period()
|
||||
# dt = np.diff(xx[:2,0])
|
||||
dcrit = 5 * dt
|
||||
ddcrit = 9.81 / 2 * dt * dt
|
||||
zcrit = 0
|
||||
inds, indg = wm.findoutliers(ts.data, zcrit, dcrit, ddcrit, verbose=True)
|
||||
|
||||
#! Section 2.2 Frequency Modeling of Load Histories
|
||||
#!----------------------------------------------------
|
||||
#! Periodogram: Raw spectrum
|
||||
#!
|
||||
plt.clf()
|
||||
Lmax = 9500
|
||||
S = ts.tospecdata(L=Lmax)
|
||||
S.plot()
|
||||
plt.axis([0, 5, 0, 0.7])
|
||||
plt.show()
|
||||
|
||||
#! Calculate moments
|
||||
#!-------------------
|
||||
mom, text = S.moment(nr=4)
|
||||
print('sigma = %g, m0 = %g' % (sa, np.sqrt(mom[0])))
|
||||
|
||||
#! Section 2.2.1 Random functions in Spectral Domain - Gaussian processes
|
||||
#!--------------------------------------------------------------------------
|
||||
#! Smoothing of spectral estimate
|
||||
#!----------------------------------
|
||||
#! By decreasing Lmax the spectrum estimate becomes smoother.
|
||||
|
||||
plt.clf()
|
||||
Lmax0 = 200
|
||||
Lmax1 = 50
|
||||
S1 = ts.tospecdata(L=Lmax0)
|
||||
S2 = ts.tospecdata(L=Lmax1)
|
||||
S1.plot('-.')
|
||||
S2.plot()
|
||||
plt.show()
|
||||
|
||||
#! Estimated autocovariance
|
||||
#!----------------------------
|
||||
#! Obviously knowing the spectrum one can compute the covariance
|
||||
#! function. The following code will compute the covariance for the
|
||||
#! unimodal spectral density S1 and compare it with estimated
|
||||
#! covariance of the signal xx.
|
||||
plt.clf()
|
||||
Lmax = 85
|
||||
R1 = S1.tocovdata(nr=1)
|
||||
Rest = ts.tocovdata(lag=Lmax)
|
||||
R1.plot('.')
|
||||
Rest.plot()
|
||||
plt.axis([0, 25, -0.1, 0.25])
|
||||
plt.show()
|
||||
|
||||
#! We can see in Figure below that the covariance function corresponding to
|
||||
#! the spectral density S2 significantly differs from the one estimated
|
||||
#! directly from data.
|
||||
#! It can be seen in Figure above that the covariance corresponding to S1
|
||||
#! agrees much better with the estimated covariance function
|
||||
|
||||
plt.clf()
|
||||
R2 = S2.tocovdata(nr=1)
|
||||
R2.plot('.')
|
||||
Rest.plot()
|
||||
plt.show()
|
||||
|
||||
#! Section 2.2.2 Transformed Gaussian models
|
||||
#!-------------------------------------------
|
||||
#! We begin with computing skewness and kurtosis
|
||||
#! for the data set xx and compare it with the second order wave approximation
|
||||
#! proposed by Winterstein:
|
||||
import wafo.stats as ws
|
||||
rho3 = ws.skew(xx[:, 1])
|
||||
rho4 = ws.kurtosis(xx[:, 1])
|
||||
|
||||
sk, ku = S1.stats_nl(moments='sk')
|
||||
|
||||
#! Comparisons of 3 transformations
|
||||
plt.clf()
|
||||
import wafo.transform.models as wtm
|
||||
gh = wtm.TrHermite(mean=me, sigma=sa, skew=sk, kurt=ku).trdata()
|
||||
g = wtm.TrLinear(mean=me, sigma=sa).trdata() # Linear transformation
|
||||
glc, gemp = lc.trdata(mean=me, sigma=sa)
|
||||
|
||||
glc.plot('b-') # Transf. estimated from level-crossings
|
||||
gh.plot('b-.') # Hermite Transf. estimated from moments
|
||||
g.plot('r')
|
||||
plt.grid('on')
|
||||
plt.show()
|
||||
|
||||
#! Test Gaussianity of a stochastic process
|
||||
#!------------------------------------------
|
||||
#! TESTGAUSSIAN simulates e(g(u)-u) = int (g(u)-u)^2 du for Gaussian processes
|
||||
#! given the spectral density, S. The result is plotted if test0 is given.
|
||||
#! This is useful for testing if the process X(t) is Gaussian.
|
||||
#! If 95% of TEST1 is less than TEST0 then X(t) is not Gaussian at a 5% level.
|
||||
#!
|
||||
#! As we see from the figure below: none of the simulated values of test1 is
|
||||
#! above 1.00. Thus the data significantly departs from a Gaussian distribution.
|
||||
plt.clf()
|
||||
test0 = glc.dist2gauss()
|
||||
#! the following test takes time
|
||||
N = len(xx)
|
||||
test1 = S1.testgaussian(ns=N, cases=50, test0=test0)
|
||||
is_gaussian = sum(test1 > test0) > 5
|
||||
print(is_gaussian)
|
||||
plt.show()
|
||||
|
||||
#! Normalplot of data xx
|
||||
#!------------------------
|
||||
#! indicates that the underlying distribution has a "heavy" upper tail and a
|
||||
#! "light" lower tail.
|
||||
plt.clf()
|
||||
import pylab
|
||||
ws.probplot(ts.data.ravel(), dist='norm', plot=pylab)
|
||||
plt.show()
|
||||
#! Section 2.2.3 Spectral densities of sea data
|
||||
#!-----------------------------------------------
|
||||
#! Example 2: Different forms of spectra
|
||||
#!
|
||||
import wafo.spectrum.models as wsm
|
||||
plt.clf()
|
||||
Hm0 = 7
|
||||
Tp = 11
|
||||
spec = wsm.Jonswap(Hm0=Hm0, Tp=Tp).tospecdata()
|
||||
spec.plot()
|
||||
plt.show()
|
||||
|
||||
#! Directional spectrum and Encountered directional spectrum
|
||||
#! Directional spectrum
|
||||
plt.clf()
|
||||
D = wsm.Spreading('cos2s')
|
||||
Sd = D.tospecdata2d(spec)
|
||||
Sd.plot()
|
||||
plt.show()
|
||||
|
||||
|
||||
##!Encountered directional spectrum
|
||||
##!---------------------------------
|
||||
#clf()
|
||||
#Se = spec2spec(Sd,'encdir',0,10);
|
||||
#plotspec(Se), hold on
|
||||
#plotspec(Sd,1,'--'), hold off
|
||||
##!wafostamp('','(ER)')
|
||||
#disp('Block = 17'),pause(pstate)
|
||||
#
|
||||
##!#! Frequency spectra
|
||||
#clf
|
||||
#Sd1 =spec2spec(Sd,'freq');
|
||||
#Sd2 = spec2spec(Se,'enc');
|
||||
#plotspec(spec), hold on
|
||||
#plotspec(Sd1,1,'.'),
|
||||
#plotspec(Sd2),
|
||||
##!wafostamp('','(ER)')
|
||||
#hold off
|
||||
#disp('Block = 18'),pause(pstate)
|
||||
#
|
||||
##!#! Wave number spectrum
|
||||
#clf
|
||||
#Sk = spec2spec(spec,'k1d')
|
||||
#Skd = spec2spec(Sd,'k1d')
|
||||
#plotspec(Sk), hold on
|
||||
#plotspec(Skd,1,'--'), hold off
|
||||
##!wafostamp('','(ER)')
|
||||
#disp('Block = 19'),pause(pstate)
|
||||
#
|
||||
##!#! Effect of waterdepth on spectrum
|
||||
#clf
|
||||
#plotspec(spec,1,'--'), hold on
|
||||
#S20 = spec;
|
||||
#S20.S = S20.S.*phi1(S20.w,20);
|
||||
#S20.h = 20;
|
||||
#plotspec(S20), hold off
|
||||
##!wafostamp('','(ER)')
|
||||
#disp('Block = 20'),pause(pstate)
|
||||
#
|
||||
##!#! Section 2.3 Simulation of transformed Gaussian process
|
||||
##!#! Example 3: Simulation of random sea
|
||||
##! The reconstruct function replaces the spurious points of seasurface by
|
||||
##! simulated data on the basis of the remaining data and a transformed Gaussian
|
||||
##! process. As noted previously one must be careful using the criteria
|
||||
##! for finding spurious points when reconstructing a dataset, because
|
||||
##! these criteria might remove the highest and steepest waves as we can see
|
||||
##! in this plot where the spurious points is indicated with a '+' sign:
|
||||
##!
|
||||
#clf
|
||||
#[y, grec] = reconstruct(xx,inds);
|
||||
#waveplot(y,'-',xx(inds,:),'+',1,1)
|
||||
#axis([0 inf -inf inf])
|
||||
##!wafostamp('','(ER)')
|
||||
#disp('Block = 21'),pause(pstate)
|
||||
#
|
||||
##! Compare transformation (grec) from reconstructed (y)
|
||||
##! with original (glc) from (xx)
|
||||
#clf
|
||||
#trplot(g), hold on
|
||||
#plot(gemp(:,1),gemp(:,2))
|
||||
#plot(glc(:,1),glc(:,2),'-.')
|
||||
#plot(grec(:,1),grec(:,2)), hold off
|
||||
#disp('Block = 22'),pause(pstate)
|
||||
#
|
||||
##!#!
|
||||
#clf
|
||||
#L = 200;
|
||||
#x = dat2gaus(y,grec);
|
||||
#Sx = dat2spec(x,L);
|
||||
#disp('Block = 23'),pause(pstate)
|
||||
#
|
||||
##!#!
|
||||
#clf
|
||||
#dt = spec2dt(Sx)
|
||||
#Ny = fix(2*60/dt) #! = 2 minutes
|
||||
#Sx.tr = grec;
|
||||
#ysim = spec2sdat(Sx,Ny);
|
||||
#waveplot(ysim,'-')
|
||||
##!wafostamp('','(CR)')
|
||||
#disp('Block = 24'),pause(pstate)
|
||||
#
|
||||
#! Estimated spectrum compared to Torsethaugen spectrum
|
||||
#!-------------------------------------------------------
|
||||
|
||||
plt.clf()
|
||||
fp = 1.1
|
||||
dw = 0.01
|
||||
H0 = S1.characteristic('Hm0')[0]
|
||||
St = wsm.Torsethaugen(Hm0=H0,Tp=2*np.pi/fp).tospecdata(np.arange(0,5+dw/2,dw))
|
||||
S1.plot()
|
||||
St.plot('-.')
|
||||
plt.axis([0, 6, 0, 0.4])
|
||||
plt.show()
|
||||
|
||||
|
||||
#! Transformed Gaussian model compared to Gaussian model
|
||||
#!--------------------------------------------------------
|
||||
dt = St.sampling_period()
|
||||
va, sk, ku = St.stats_nl(moments='vsk')
|
||||
#sa = sqrt(va)
|
||||
gh = wtm.TrHermite(mean=me, sigma=sa, skew=sk, kurt=ku, ysigma=sa)
|
||||
|
||||
ysim_t = St.sim(ns=240, dt=0.5)
|
||||
xsim_t = ysim_t.copy()
|
||||
xsim_t[:, 1] = gh.gauss2dat(ysim_t[:, 1])
|
||||
|
||||
ts_y = wo.mat2timeseries(ysim_t)
|
||||
ts_x = wo.mat2timeseries(xsim_t)
|
||||
ts_y.plot_wave(sym1='r.', ts=ts_x, sym2='b', sigma=sa, nsub=5, nfig=1)
|
||||
plt.show()
|
||||
@ -1,615 +0,0 @@
|
||||
from wafo.plotbackend import plotbackend as plt
|
||||
import numpy as np
|
||||
|
||||
#! CHAPTER3 Demonstrates distributions of wave characteristics
|
||||
#!=============================================================
|
||||
#!
|
||||
#! Chapter3 contains the commands used in Chapter3 in the tutorial.
|
||||
#!
|
||||
#! Some of the commands are edited for fast computation.
|
||||
#!
|
||||
#! Section 3.2 Estimation of wave characteristics from data
|
||||
#!----------------------------------------------------------
|
||||
#! Example 1
|
||||
#!~~~~~~~~~~
|
||||
|
||||
speed = 'fast'
|
||||
#speed = 'slow'
|
||||
import scipy.signal as ss
|
||||
import wafo.data as wd
|
||||
import wafo.misc as wm
|
||||
import wafo.objects as wo
|
||||
import wafo.stats as ws
|
||||
import wafo.spectrum.models as wsm
|
||||
xx = wd.sea()
|
||||
xx[:, 1] = ss.detrend(xx[:, 1])
|
||||
ts = wo.mat2timeseries(xx)
|
||||
Tcrcr, ix = ts.wave_periods(vh=0, pdef='c2c', wdef='tw', rate=8)
|
||||
Tc, ixc = ts.wave_periods(vh=0, pdef='u2d', wdef='tw', rate=8)
|
||||
|
||||
#! Histogram of crestperiod compared to the kernel density estimate
|
||||
#!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
import wafo.kdetools as wk
|
||||
plt.clf()
|
||||
print(Tc.mean())
|
||||
print(Tc.max())
|
||||
|
||||
t = np.linspace(0.01,8,200);
|
||||
ftc = wk.TKDE(Tc, L2=0, inc=128)
|
||||
|
||||
plt.plot(t,ftc.eval_grid(t), t, ftc.eval_grid_fast(t),'-.')
|
||||
wm.plot_histgrm(Tc, normed=True)
|
||||
plt.title('Kernel Density Estimates')
|
||||
plt.xlabel('Tc [s]')
|
||||
plt.axis([0, 8, 0, 0.5])
|
||||
plt.show()
|
||||
|
||||
#! Extreme waves - model check: the highest and steepest wave
|
||||
#!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
plt.clf()
|
||||
S, H = ts.wave_height_steepness(kind=0)
|
||||
indS = S.argmax()
|
||||
indH = H.argmax()
|
||||
ts.plot_sp_wave([indH, indS],'k.')
|
||||
plt.show()
|
||||
|
||||
#! Does the highest wave contradict a transformed Gaussian model?
|
||||
#!----------------------------------------------------------------
|
||||
|
||||
# TODO: Fix this
|
||||
|
||||
#clf
|
||||
#inds1 = (5965:5974)'; #! points to remove
|
||||
#Nsim = 10;
|
||||
#[y1, grec1, g2, test, tobs, mu1o, mu1oStd] = ...
|
||||
# reconstruct(xx,inds1,Nsim);
|
||||
#spwaveplot(y1,indA-10)
|
||||
#hold on
|
||||
#plot(xx(inds1,1),xx(inds1,2),'+')
|
||||
#lamb = 2.;
|
||||
#muLstd = tranproc(mu1o-lamb*mu1oStd,fliplr(grec1));
|
||||
#muUstd = tranproc(mu1o+lamb*mu1oStd,fliplr(grec1));
|
||||
#plot (y1(inds1,1), [muLstd muUstd],'b-')
|
||||
#axis([1482 1498 -1 3]),
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block = 6'),
|
||||
#pause(pstate)
|
||||
#
|
||||
##!#! Expected value (solid) compared to data removed
|
||||
#clf
|
||||
#plot(xx(inds1,1),xx(inds1,2),'+'), hold on
|
||||
#mu = tranproc(mu1o,fliplr(grec1));
|
||||
#plot(y1(inds1,1), mu), hold off
|
||||
#disp('Block = 7'), pause(pstate)
|
||||
|
||||
#! Crest height PDF
|
||||
#!------------------
|
||||
#! Transform data so that kde works better
|
||||
plt.clf()
|
||||
wave_data = ts.wave_parameters()
|
||||
Ac = wave_data['Ac']
|
||||
L2 = 0.6
|
||||
|
||||
ws.probplot(Ac**L2, dist='norm', plot=plt)
|
||||
plt.show()
|
||||
|
||||
#!#!
|
||||
plt.clf()#
|
||||
fac = wk.TKDE(Ac,L2=L2)(np.linspace(0.01,3,200), output='plot')
|
||||
fac.plot()
|
||||
# wafostamp([],'(ER)')
|
||||
print(fac.integrate(a=0.01, b=3))
|
||||
print(fac.integrate())
|
||||
print('Block = 8'),
|
||||
# pause(pstate)
|
||||
|
||||
#!#! Empirical crest height CDF
|
||||
plt.clf()
|
||||
Fac = fac.to_cdf()
|
||||
Femp = ws.edf(Ac)
|
||||
Fac.plot()
|
||||
Femp.plot()
|
||||
plt.axis([0, 2, 0, 1])
|
||||
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block = 9'), pause(pstate)
|
||||
|
||||
#!#! Empirical crest height CDF compared to a Transformed Rayleigh approximation
|
||||
|
||||
# facr = trraylpdf(fac.x{1},'Ac',grec1);
|
||||
# Facr = cumtrapz(facr.x{1},facr.f);
|
||||
# hold on
|
||||
# plot(facr.x{1},Facr,'.')
|
||||
# axis([1.25 2.25 0.95 1])
|
||||
# wafostamp([],'(ER)')
|
||||
# disp('Block = 10'), pause(pstate)
|
||||
|
||||
#!#! Joint pdf of crest period and crest amplitude
|
||||
plt.clf()
|
||||
Tcf = wave_data['Tcf']
|
||||
Tcb = wave_data['Tcb']
|
||||
Tc = Tcf + Tcb
|
||||
fTcAc = wk.TKDE([Tc, Ac],L2=0.5, inc=256).eval_grid_fast(output='plot')
|
||||
fTcAc.labels.labx = 'Tc [s]'
|
||||
fTcAc.labels.laby = 'Ac [m]'
|
||||
fTcAc.plot()
|
||||
plt.hold(True)
|
||||
plt.plot(Tc, Ac,'k.')
|
||||
plt.hold(False)
|
||||
plt.show()
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block = 11'), pause(pstate)
|
||||
|
||||
#!#! Example 4: Simple wave characteristics obtained from Jonswap spectrum
|
||||
plt.clf()
|
||||
S = wsm.Jonswap(Hm0=5, Tp=10).tospecdata()
|
||||
m, mt = S.moment(nr=4, even=False)
|
||||
print(m)
|
||||
print(mt)
|
||||
# disp('Block = 12'), pause(pstate)
|
||||
|
||||
plt.clf()
|
||||
S.bandwidth(['alpha'])
|
||||
ch, Sa2, chtxt = S.characteristic(['Hm0', 'Tm02'])
|
||||
|
||||
# disp('Block = 13'), pause(pstate)
|
||||
|
||||
#!#! Section 3.3.2 Explicit form approximations of wave characteristic densities
|
||||
#!#! Longuett-Higgins model for Tc and Ac
|
||||
# plt.clf()
|
||||
# t = np.linspace(0,15,100)
|
||||
# h = np.linspace(0,6,100)
|
||||
# flh = lh83pdf(t, h, [m[0],m[1], m[2])
|
||||
# #disp('Block = 14'), pause(pstate)
|
||||
#
|
||||
# #!#! Transformed Longuett-Higgins model for Tc and Ac
|
||||
# clf
|
||||
# [sk, ku ]=spec2skew(S);
|
||||
# sa = sqrt(m(1));
|
||||
# gh = hermitetr([],[sa sk ku 0]);
|
||||
# flhg = lh83pdf(t,h,[m(1),m(2),m(3)],gh);
|
||||
# disp('Block = 15'), pause(pstate)
|
||||
|
||||
#!#! Cavanie model for Tc and Ac
|
||||
# clf
|
||||
# t = np.linspace(0,10,100);
|
||||
# h = np.linspace(0,7,100);
|
||||
# fcav = cav76pdf(t,h,[m(1) m(2) m(3) m(5)],[]);
|
||||
# disp('Block = 16'), pause(pstate)
|
||||
#
|
||||
# #!#! Example 5 Transformed Rayleigh approximation of crest- vs trough- amplitude
|
||||
# clf
|
||||
# xx = load('sea.dat');
|
||||
# x = xx;
|
||||
# x(:,2) = detrend(x(:,2));
|
||||
# SS = dat2spec2(x);
|
||||
# [sk, ku, me, si ] = spec2skew(SS);
|
||||
# gh = hermitetr([],[si sk ku me]);
|
||||
# Hs = 4*si;
|
||||
# r = (0:0.05:1.1*Hs)';
|
||||
# fac_h = trraylpdf(r,'Ac',gh);
|
||||
# fat_h = trraylpdf(r,'At',gh);
|
||||
# h = (0:0.05:1.7*Hs)';
|
||||
# facat_h = trraylpdf(h,'AcAt',gh);
|
||||
# pdfplot(fac_h)
|
||||
# hold on
|
||||
# pdfplot(fat_h,'--')
|
||||
# hold off
|
||||
# wafostamp([],'(ER)')
|
||||
# disp('Block = 17'), pause(pstate)
|
||||
#
|
||||
# #!#!
|
||||
# clf
|
||||
# TC = dat2tc(xx, me);
|
||||
# tc = tp2mm(TC);
|
||||
# Ac = tc(:,2);
|
||||
# At = -tc(:,1);
|
||||
# AcAt = Ac+At;
|
||||
# disp('Block = 18'), pause(pstate)
|
||||
#
|
||||
# #!#!
|
||||
# clf
|
||||
# Fac_h = [fac_h.x{1} cumtrapz(fac_h.x{1},fac_h.f)];
|
||||
# subplot(3,1,1)
|
||||
# Fac = plotedf(Ac,Fac_h);
|
||||
# hold on
|
||||
# plot(r,1-exp(-8*r.^2/Hs^2),'.')
|
||||
# axis([1. 2. 0.9 1])
|
||||
# title('Ac CDF')
|
||||
#
|
||||
# Fat_h = [fat_h.x{1} cumtrapz(fat_h.x{1},fat_h.f)];
|
||||
# subplot(3,1,2)
|
||||
# Fat = plotedf(At,Fat_h);
|
||||
# hold on
|
||||
# plot(r,1-exp(-8*r.^2/Hs^2),'.')
|
||||
# axis([1. 2. 0.9 1])
|
||||
# title('At CDF')
|
||||
#
|
||||
# Facat_h = [facat_h.x{1} cumtrapz(facat_h.x{1},facat_h.f)];
|
||||
# subplot(3,1,3)
|
||||
# Facat = plotedf(AcAt,Facat_h);
|
||||
# hold on
|
||||
# plot(r,1-exp(-2*r.^2/Hs^2),'.')
|
||||
# axis([1.5 3.5 0.9 1])
|
||||
# title('At+Ac CDF')
|
||||
#
|
||||
# wafostamp([],'(ER)')
|
||||
# disp('Block = 19'), pause(pstate)
|
||||
#
|
||||
# #!#! Section 3.4 Exact wave distributions in transformed Gaussian Sea
|
||||
# #!#! Section 3.4.1 Density of crest period, crest length or encountered crest period
|
||||
# clf
|
||||
# S1 = torsethaugen([],[6 8],1);
|
||||
# D1 = spreading(101,'cos',pi/2,[15],[],0);
|
||||
# D12 = spreading(101,'cos',0,[15],S1.w,1);
|
||||
# SD1 = mkdspec(S1,D1);
|
||||
# SD12 = mkdspec(S1,D12);
|
||||
# disp('Block = 20'), pause(pstate)
|
||||
#
|
||||
# #!#! Crest period
|
||||
# clf
|
||||
# tic
|
||||
# f_tc = spec2tpdf(S1,[],'Tc',[0 11 56],[],4);
|
||||
# toc
|
||||
# pdfplot(f_tc)
|
||||
# wafostamp([],'(ER)')
|
||||
# simpson(f_tc.x{1},f_tc.f)
|
||||
# disp('Block = 21'), pause(pstate)
|
||||
#
|
||||
# #!#! Crest length
|
||||
#
|
||||
# if strncmpi(speed,'slow',1)
|
||||
# opt1 = rindoptset('speed',5,'method',3);
|
||||
# opt2 = rindoptset('speed',5,'nit',2,'method',0);
|
||||
# else
|
||||
# #! fast
|
||||
# opt1 = rindoptset('speed',7,'method',3);
|
||||
# opt2 = rindoptset('speed',7,'nit',2,'method',0);
|
||||
# end
|
||||
#
|
||||
#
|
||||
# clf
|
||||
# if strncmpi(speed,'slow',1)
|
||||
# NITa = 5;
|
||||
# else
|
||||
# disp('NIT=5 may take time, running with NIT=3 in the following')
|
||||
# NITa = 3;
|
||||
# end
|
||||
# #!f_Lc = spec2tpdf2(S1,[],'Lc',[0 200 81],opt1); #! Faster and more accurate
|
||||
# f_Lc = spec2tpdf(S1,[],'Lc',[0 200 81],[],NITa);
|
||||
# pdfplot(f_Lc,'-.')
|
||||
# wafostamp([],'(ER)')
|
||||
# disp('Block = 22'), pause(pstate)
|
||||
#
|
||||
#
|
||||
# f_Lc_1 = spec2tpdf(S1,[],'Lc',[0 200 81],1.5,NITa);
|
||||
# #!f_Lc_1 = spec2tpdf2(S1,[],'Lc',[0 200 81],1.5,opt1);
|
||||
#
|
||||
# hold on
|
||||
# pdfplot(f_Lc_1)
|
||||
# wafostamp([],'(ER)')
|
||||
#
|
||||
# disp('Block = 23'), pause(pstate)
|
||||
# #!#!
|
||||
# clf
|
||||
# simpson(f_Lc.x{1},f_Lc.f)
|
||||
# simpson(f_Lc_1.x{1},f_Lc_1.f)
|
||||
#
|
||||
# disp('Block = 24'), pause(pstate)
|
||||
# #!#!
|
||||
# clf
|
||||
# tic
|
||||
#
|
||||
# f_Lc_d1 = spec2tpdf(rotspec(SD1,pi/2),[],'Lc',[0 300 121],[],NITa);
|
||||
# f_Lc_d12 = spec2tpdf(SD12,[],'Lc',[0 200 81],[],NITa);
|
||||
# #! f_Lc_d1 = spec2tpdf2(rotspec(SD1,pi/2),[],'Lc',[0 300 121],opt1);
|
||||
# #! f_Lc_d12 = spec2tpdf2(SD12,[],'Lc',[0 200 81],opt1);
|
||||
# toc
|
||||
# pdfplot(f_Lc_d1,'-.'), hold on
|
||||
# pdfplot(f_Lc_d12), hold off
|
||||
# wafostamp([],'(ER)')
|
||||
#
|
||||
# disp('Block = 25'), pause(pstate)
|
||||
#
|
||||
# #!#!
|
||||
#
|
||||
#
|
||||
# clf
|
||||
# opt1 = rindoptset('speed',5,'method',3);
|
||||
# SD1r = rotspec(SD1,pi/2);
|
||||
# if strncmpi(speed,'slow',1)
|
||||
# f_Lc_d1_5 = spec2tpdf(SD1r,[], 'Lc',[0 300 121],[],5);
|
||||
# pdfplot(f_Lc_d1_5), hold on
|
||||
# else
|
||||
# #! fast
|
||||
# disp('Run the following example only if you want a check on computing time')
|
||||
# disp('Edit the command file and remove #!')
|
||||
# end
|
||||
# f_Lc_d1_3 = spec2tpdf(SD1r,[],'Lc',[0 300 121],[],3);
|
||||
# f_Lc_d1_2 = spec2tpdf(SD1r,[],'Lc',[0 300 121],[],2);
|
||||
# f_Lc_d1_0 = spec2tpdf(SD1r,[],'Lc',[0 300 121],[],0);
|
||||
# #!f_Lc_d1_n4 = spec2tpdf2(SD1r,[],'Lc',[0 400 161],opt1);
|
||||
#
|
||||
# pdfplot(f_Lc_d1_3), hold on
|
||||
# pdfplot(f_Lc_d1_2)
|
||||
# pdfplot(f_Lc_d1_0)
|
||||
# #!pdfplot(f_Lc_d1_n4)
|
||||
#
|
||||
# #!simpson(f_Lc_d1_n4.x{1},f_Lc_d1_n4.f)
|
||||
#
|
||||
# disp('Block = 26'), pause(pstate)
|
||||
#
|
||||
# #!#! Section 3.4.2 Density of wave period, wave length or encountered wave period
|
||||
# #!#! Example 7: Crest period and high crest waves
|
||||
# clf
|
||||
# tic
|
||||
# xx = load('sea.dat');
|
||||
# x = xx;
|
||||
# x(:,2) = detrend(x(:,2));
|
||||
# SS = dat2spec(x);
|
||||
# si = sqrt(spec2mom(SS,1));
|
||||
# SS.tr = dat2tr(x);
|
||||
# Hs = 4*si
|
||||
# method = 0;
|
||||
# rate = 2;
|
||||
# [S, H, Ac, At, Tcf, Tcb, z_ind, yn] = dat2steep(x,rate,method);
|
||||
# Tc = Tcf+Tcb;
|
||||
# t = linspace(0.01,8,200);
|
||||
# ftc1 = kde(Tc,{'L2',0},t);
|
||||
# pdfplot(ftc1)
|
||||
# hold on
|
||||
# #! f_t = spec2tpdf(SS,[],'Tc',[0 8 81],0,4);
|
||||
# f_t = spec2tpdf(SS,[],'Tc',[0 8 81],0,2);
|
||||
# simpson(f_t.x{1},f_t.f)
|
||||
# pdfplot(f_t,'-.')
|
||||
# hold off
|
||||
# wafostamp([],'(ER)')
|
||||
# toc
|
||||
# disp('Block = 27'), pause(pstate)
|
||||
#
|
||||
# #!#!
|
||||
# clf
|
||||
# tic
|
||||
#
|
||||
# if strncmpi(speed,'slow',1)
|
||||
# NIT = 4;
|
||||
# else
|
||||
# NIT = 2;
|
||||
# end
|
||||
# #! f_t2 = spec2tpdf(SS,[],'Tc',[0 8 81],[Hs/2],4);
|
||||
# tic
|
||||
# f_t2 = spec2tpdf(SS,[],'Tc',[0 8 81],Hs/2,NIT);
|
||||
# toc
|
||||
#
|
||||
# Pemp = sum(Ac>Hs/2)/sum(Ac>0)
|
||||
# simpson(f_t2.x{1},f_t2.f)
|
||||
# index = find(Ac>Hs/2);
|
||||
# ftc1 = kde(Tc(index),{'L2',0},t);
|
||||
# ftc1.f = Pemp*ftc1.f;
|
||||
# pdfplot(ftc1)
|
||||
# hold on
|
||||
# pdfplot(f_t2,'-.')
|
||||
# hold off
|
||||
# wafostamp([],'(ER)')
|
||||
# toc
|
||||
# disp('Block = 28'), pause(pstate)
|
||||
#
|
||||
# #!#! Example 8: Wave period for high crest waves
|
||||
# #! clf
|
||||
# tic
|
||||
# f_tcc2 = spec2tccpdf(SS,[],'t>',[0 12 61],[Hs/2],[0],-1);
|
||||
# toc
|
||||
# simpson(f_tcc2.x{1},f_tcc2.f)
|
||||
# f_tcc3 = spec2tccpdf(SS,[],'t>',[0 12 61],[Hs/2],[0],3,5);
|
||||
# #! f_tcc3 = spec2tccpdf(SS,[],'t>',[0 12 61],[Hs/2],[0],1,5);
|
||||
# simpson(f_tcc3.x{1},f_tcc3.f)
|
||||
# pdfplot(f_tcc2,'-.')
|
||||
# hold on
|
||||
# pdfplot(f_tcc3)
|
||||
# hold off
|
||||
# toc
|
||||
# disp('Block = 29'), pause(pstate)
|
||||
#
|
||||
# #!#!
|
||||
# clf
|
||||
# [TC tc_ind v_ind] = dat2tc(yn,[],'dw');
|
||||
# N = length(tc_ind);
|
||||
# t_ind = tc_ind(1:2:N);
|
||||
# c_ind = tc_ind(2:2:N);
|
||||
# Pemp = sum(yn(t_ind,2)<-Hs/2 & yn(c_ind,2)>Hs/2)/length(t_ind)
|
||||
# ind = find(yn(t_ind,2)<-Hs/2 & yn(c_ind,2)>Hs/2);
|
||||
# spwaveplot(yn,ind(2:4))
|
||||
# wafostamp([],'(ER)')
|
||||
# disp('Block = 30'), pause(pstate)
|
||||
#
|
||||
# #!#!
|
||||
# clf
|
||||
# Tcc = yn(v_ind(1+2*ind),1)-yn(v_ind(1+2*(ind-1)),1);
|
||||
# t = linspace(0.01,14,200);
|
||||
# ftcc1 = kde(Tcc,{'kernel' 'epan','L2',0},t);
|
||||
# ftcc1.f = Pemp*ftcc1.f;
|
||||
# pdfplot(ftcc1,'-.')
|
||||
# wafostamp([],'(ER)')
|
||||
# disp('Block = 31'), pause(pstate)
|
||||
#
|
||||
# tic
|
||||
# f_tcc22_1 = spec2tccpdf(SS,[],'t>',[0 12 61],[Hs/2],[Hs/2],-1);
|
||||
# toc
|
||||
# simpson(f_tcc22_1.x{1},f_tcc22_1.f)
|
||||
# hold on
|
||||
# pdfplot(f_tcc22_1)
|
||||
# hold off
|
||||
# wafostamp([],'(ER)')
|
||||
# disp('Block = 32'), pause(pstate)
|
||||
#
|
||||
# disp('The rest of this chapter deals with joint densities.')
|
||||
# disp('Some calculations may take some time.')
|
||||
# disp('You could experiment with other NIT.')
|
||||
# #!return
|
||||
#
|
||||
# #!#! Section 3.4.3 Joint density of crest period and crest height
|
||||
# #!#! Example 9. Some preliminary analysis of the data
|
||||
# clf
|
||||
# tic
|
||||
# yy = load('gfaksr89.dat');
|
||||
# SS = dat2spec(yy);
|
||||
# si = sqrt(spec2mom(SS,1));
|
||||
# SS.tr = dat2tr(yy);
|
||||
# Hs = 4*si
|
||||
# v = gaus2dat([0 0],SS.tr);
|
||||
# v = v(2)
|
||||
# toc
|
||||
# disp('Block = 33'), pause(pstate)
|
||||
#
|
||||
# #!#!
|
||||
# clf
|
||||
# tic
|
||||
# [TC, tc_ind, v_ind] = dat2tc(yy,v,'dw');
|
||||
# N = length(tc_ind);
|
||||
# t_ind = tc_ind(1:2:N);
|
||||
# c_ind = tc_ind(2:2:N);
|
||||
# v_ind_d = v_ind(1:2:N+1);
|
||||
# v_ind_u = v_ind(2:2:N+1);
|
||||
# T_d = ecross(yy(:,1),yy(:,2),v_ind_d,v);
|
||||
# T_u = ecross(yy(:,1),yy(:,2),v_ind_u,v);
|
||||
#
|
||||
# Tc = T_d(2:end)-T_u(1:end);
|
||||
# Tt = T_u(1:end)-T_d(1:end-1);
|
||||
# Tcf = yy(c_ind,1)-T_u;
|
||||
# Ac = yy(c_ind,2)-v;
|
||||
# At = v-yy(t_ind,2);
|
||||
# toc
|
||||
# disp('Block = 34'), pause(pstate)
|
||||
#
|
||||
# #!#!
|
||||
# clf
|
||||
# tic
|
||||
# t = linspace(0.01,15,200);
|
||||
# kopt3 = kdeoptset('hs',0.25,'L2',0);
|
||||
# ftc1 = kde(Tc,kopt3,t);
|
||||
# ftt1 = kde(Tt,kopt3,t);
|
||||
# pdfplot(ftt1,'k')
|
||||
# hold on
|
||||
# pdfplot(ftc1,'k-.')
|
||||
# f_tc4 = spec2tpdf(SS,[],'Tc',[0 12 81],0,4,5);
|
||||
# f_tc2 = spec2tpdf(SS,[],'Tc',[0 12 81],0,2,5);
|
||||
# f_tc = spec2tpdf(SS,[],'Tc',[0 12 81],0,-1);
|
||||
# pdfplot(f_tc,'b')
|
||||
# hold off
|
||||
# legend('kde(Tt)','kde(Tc)','f_{tc}')
|
||||
# wafostamp([],'(ER)')
|
||||
# toc
|
||||
# disp('Block = 35'), pause(pstate)
|
||||
#
|
||||
# #!#! Example 10: Joint characteristics of a half wave:
|
||||
# #!#! position and height of a crest for a wave with given period
|
||||
# clf
|
||||
# tic
|
||||
# ind = find(4.4<Tc & Tc<4.6);
|
||||
# f_AcTcf = kde([Tcf(ind) Ac(ind)],{'L2',[1 .5]});
|
||||
# pdfplot(f_AcTcf)
|
||||
# hold on
|
||||
# plot(Tcf(ind), Ac(ind),'.');
|
||||
# wafostamp([],'(ER)')
|
||||
# toc
|
||||
# disp('Block = 36'), pause(pstate)
|
||||
#
|
||||
# #!#!
|
||||
# clf
|
||||
# tic
|
||||
# opt1 = rindoptset('speed',5,'method',3);
|
||||
# opt2 = rindoptset('speed',5,'nit',2,'method',0);
|
||||
#
|
||||
# f_tcfac1 = spec2thpdf(SS,[],'TcfAc',[4.5 4.5 46],[0:0.25:8],opt1);
|
||||
# f_tcfac2 = spec2thpdf(SS,[],'TcfAc',[4.5 4.5 46],[0:0.25:8],opt2);
|
||||
#
|
||||
# pdfplot(f_tcfac1,'-.')
|
||||
# hold on
|
||||
# pdfplot(f_tcfac2)
|
||||
# plot(Tcf(ind), Ac(ind),'.');
|
||||
#
|
||||
# simpson(f_tcfac1.x{1},simpson(f_tcfac1.x{2},f_tcfac1.f,1))
|
||||
# simpson(f_tcfac2.x{1},simpson(f_tcfac2.x{2},f_tcfac2.f,1))
|
||||
# f_tcf4=spec2tpdf(SS,[],'Tc',[4.5 4.5 46],[0:0.25:8],6);
|
||||
# f_tcf4.f(46)
|
||||
# toc
|
||||
# wafostamp([],'(ER)')
|
||||
# disp('Block = 37'), pause(pstate)
|
||||
#
|
||||
# #!#!
|
||||
# clf
|
||||
# f_tcac_s = spec2thpdf(SS,[],'TcAc',[0 12 81],[Hs/2:0.1:2*Hs],opt1);
|
||||
# disp('Block = 38'), pause(pstate)
|
||||
#
|
||||
# clf
|
||||
# tic
|
||||
# mom = spec2mom(SS,4,[],0);
|
||||
# t = f_tcac_s.x{1};
|
||||
# h = f_tcac_s.x{2};
|
||||
# flh_g = lh83pdf(t',h',[mom(1),mom(2),mom(3)],SS.tr);
|
||||
# clf
|
||||
# ind=find(Ac>Hs/2);
|
||||
# plot(Tc(ind), Ac(ind),'.');
|
||||
# hold on
|
||||
# pdfplot(flh_g,'k-.')
|
||||
# pdfplot(f_tcac_s)
|
||||
# toc
|
||||
# wafostamp([],'(ER)')
|
||||
# disp('Block = 39'), pause(pstate)
|
||||
#
|
||||
# #!#!
|
||||
# clf
|
||||
# #! f_tcac = spec2thpdf(SS,[],'TcAc',[0 12 81],[0:0.2:8],opt1);
|
||||
# #! pdfplot(f_tcac)
|
||||
# disp('Block = 40'), pause(pstate)
|
||||
#
|
||||
# #!#! Section 3.4.4 Joint density of crest and trough height
|
||||
# #!#! Section 3.4.5 Min-to-max distributions Markov method
|
||||
# #!#! Example 11. (min-max problems with Gullfaks data)
|
||||
# #!#! Joint density of maximum and the following minimum
|
||||
# clf
|
||||
# tic
|
||||
# tp = dat2tp(yy);
|
||||
# Mm = fliplr(tp2mm(tp));
|
||||
# fmm = kde(Mm);
|
||||
# f_mM = spec2mmtpdf(SS,[],'mm',[],[-7 7 51],opt2);
|
||||
#
|
||||
# pdfplot(f_mM,'-.')
|
||||
# hold on
|
||||
# pdfplot(fmm,'k-')
|
||||
# hold off
|
||||
# wafostamp([],'(ER)')
|
||||
# toc
|
||||
# disp('Block = 41'), pause(pstate)
|
||||
#
|
||||
# #!#! The joint density of still water separated maxima and minima.
|
||||
# clf
|
||||
# tic
|
||||
# ind = find(Mm(:,1)>v & Mm(:,2)<v);
|
||||
# Mmv = abs(Mm(ind,:)-v);
|
||||
# fmmv = kde(Mmv);
|
||||
# f_vmm = spec2mmtpdf(SS,[],'vmm',[],[-7 7 51],opt2);
|
||||
# clf
|
||||
# pdfplot(fmmv,'k-')
|
||||
# hold on
|
||||
# pdfplot(f_vmm,'-.')
|
||||
# hold off
|
||||
# wafostamp([],'(ER)')
|
||||
# toc
|
||||
# disp('Block = 42'), pause(pstate)
|
||||
#
|
||||
#
|
||||
# #!#!
|
||||
# clf
|
||||
# tic
|
||||
# facat = kde([Ac At]);
|
||||
# f_acat = spec2mmtpdf(SS,[],'AcAt',[],[-7 7 51],opt2);
|
||||
# clf
|
||||
# pdfplot(f_acat,'-.')
|
||||
# hold on
|
||||
# pdfplot(facat,'k-')
|
||||
# hold off
|
||||
# wafostamp([],'(ER)')
|
||||
# toc
|
||||
# disp('Block = 43'), pause(pstate)
|
||||
|
||||
@ -1,407 +0,0 @@
|
||||
|
||||
#! CHAPTER4 contains the commands used in Chapter 4 of the tutorial
|
||||
#!=================================================================
|
||||
#!
|
||||
#! CALL: Chapter4
|
||||
#!
|
||||
#! Some of the commands are edited for fast computation.
|
||||
#! Each set of commands is followed by a 'pause' command.
|
||||
#!
|
||||
#! This routine also can print the figures;
|
||||
#! For printing the figures on directory ../bilder/ edit the file and put
|
||||
#! printing=1;
|
||||
|
||||
#! Tested on Matlab 5.3
|
||||
#! History
|
||||
#! Revised pab sept2005
|
||||
#! Added sections -> easier to evaluate using cellmode evaluation.
|
||||
#! revised pab Feb2004
|
||||
#! updated call to lc2sdat
|
||||
#! Created by GL July 13, 2000
|
||||
#! from commands used in Chapter 4
|
||||
#!
|
||||
|
||||
#! Chapter 4 Fatigue load analysis and rain-flow cycles
|
||||
#!------------------------------------------------------
|
||||
|
||||
printing = 0
|
||||
|
||||
|
||||
#! Section 4.3.1 Crossing intensity
|
||||
#!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
import numpy as np
|
||||
from wafo.plotbackend import plotbackend as plt
|
||||
import wafo.data as wd
|
||||
import wafo.objects as wo
|
||||
|
||||
xx_sea = wd.sea()
|
||||
ts = wo.mat2timeseries(xx_sea)
|
||||
tp = ts.turning_points()
|
||||
mM = tp.cycle_pairs(kind='min2max')
|
||||
lc = mM.level_crossings(intensity=True)
|
||||
T_sea = ts.args[-1]-ts.args[0]
|
||||
|
||||
plt.subplot(1,2,1)
|
||||
lc.plot()
|
||||
plt.subplot(1,2,2)
|
||||
lc.setplotter(plotmethod='step')
|
||||
lc.plot()
|
||||
plt.show()
|
||||
|
||||
|
||||
m_sea = ts.data.mean()
|
||||
f0_sea = np.interp(m_sea, lc.args,lc.data)
|
||||
extr_sea = len(tp.data)/(2*T_sea)
|
||||
alfa_sea = f0_sea/extr_sea
|
||||
print('alfa = %g ' % alfa_sea)
|
||||
|
||||
#! Section 4.3.2 Extraction of rainflow cycles
|
||||
#!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
#! Min-max and rainflow cycle plots
|
||||
#!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
mM_rfc = tp.cycle_pairs(h=0.3)
|
||||
|
||||
plt.clf()
|
||||
plt.subplot(122),
|
||||
mM.plot()
|
||||
plt.title('min-max cycle pairs')
|
||||
plt.subplot(121),
|
||||
mM_rfc.plot()
|
||||
plt.title('Rainflow filtered cycles')
|
||||
plt.show()
|
||||
|
||||
#! Min-max and rainflow cycle distributions
|
||||
#!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
import wafo.misc as wm
|
||||
ampmM_sea = mM.amplitudes()
|
||||
ampRFC_sea = mM_rfc.amplitudes()
|
||||
plt.clf()
|
||||
plt.subplot(121)
|
||||
wm.plot_histgrm(ampmM_sea,25)
|
||||
ylim = plt.gca().get_ylim()
|
||||
plt.title('min-max amplitude distribution')
|
||||
plt.subplot(122)
|
||||
wm.plot_histgrm(ampRFC_sea,25)
|
||||
plt.gca().set_ylim(ylim)
|
||||
plt.title('Rainflow amplitude distribution')
|
||||
plt.show()
|
||||
|
||||
#!#! Section 4.3.3 Simulation of rainflow cycles
|
||||
#!#! Simulation of cycles in a Markov model
|
||||
# n = 41
|
||||
# param_m = [-1, 1, n]
|
||||
# param_D = [1, n, n]
|
||||
# u_markov=levels(param_m);
|
||||
# G_markov=mktestmat(param_m,[-0.2, 0.2],0.15,1);
|
||||
# T_markov=5000;
|
||||
#xxD_markov=mctpsim({G_markov [,]},T_markov);
|
||||
#xx_markov=[(1:T_markov)' u_markov(xxD_markov)'];
|
||||
#clf
|
||||
#plot(xx_markov(1:50,1),xx_markov(1:50,2))
|
||||
#title('Markov chain of turning points')
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 5'),pause(pstate)
|
||||
#
|
||||
#
|
||||
##!#! Rainflow cycles in a transformed Gaussian model
|
||||
##!#! Hermite transformed wave data and rainflow filtered turning points, h = 0.2.
|
||||
#me = mean(xx_sea(:,2));
|
||||
#sa = std(xx_sea(:,2));
|
||||
#Hm0_sea = 4*sa;
|
||||
#Tp_sea = 1/max(lc_sea(:,2));
|
||||
#spec = jonswap([],[Hm0_sea Tp_sea]);
|
||||
#
|
||||
#[sk, ku] = spec2skew(spec);
|
||||
#spec.tr = hermitetr([],[sa sk ku me]);
|
||||
#param_h = [-1.5 2 51];
|
||||
#spec_norm = spec;
|
||||
#spec_norm.S = spec_norm.S/sa^2;
|
||||
#xx_herm = spec2sdat(spec_norm,[2^15 1],0.1);
|
||||
##! ????? PJ, JR 11-Apr-2001
|
||||
##! NOTE, in the simulation program spec2sdat
|
||||
##!the spectrum must be normalized to variance 1
|
||||
##! ?????
|
||||
#h = 0.2;
|
||||
#[dtp,u_herm,xx_herm_1]=dat2dtp(param_h,xx_herm,h);
|
||||
#clf
|
||||
#plot(xx_herm(:,1),xx_herm(:,2),'k','LineWidth',2); hold on;
|
||||
#plot(xx_herm_1(:,1),xx_herm_1(:,2),'k--','Linewidth',2);
|
||||
#axis([0 50 -1 1]), hold off;
|
||||
#title('Rainflow filtered wave data')
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 6'),pause(pstate)
|
||||
#
|
||||
##!#! Rainflow cycles and rainflow filtered rainflow cycles in the transformed Gaussian process.
|
||||
#tp_herm=dat2tp(xx_herm);
|
||||
#RFC_herm=tp2rfc(tp_herm);
|
||||
#mM_herm=tp2mm(tp_herm);
|
||||
#h=0.2;
|
||||
#[dtp,u,tp_herm_1]=dat2dtp(param_h,xx_herm,h);
|
||||
#RFC_herm_1 = tp2rfc(tp_herm_1);
|
||||
#clf
|
||||
#subplot(121), ccplot(RFC_herm)
|
||||
#title('h=0')
|
||||
#subplot(122), ccplot(RFC_herm_1)
|
||||
#title('h=0.2')
|
||||
#if (printing==1), print -deps ../bilder/fatigue_8.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 7'),pause(pstate)
|
||||
#
|
||||
##!#! Section 4.3.4 Calculating the rainflow matrix
|
||||
#
|
||||
#
|
||||
#Grfc_markov=mctp2rfm({G_markov []});
|
||||
#clf
|
||||
#subplot(121), cmatplot(u_markov,u_markov,G_markov), axis('square')
|
||||
#subplot(122), cmatplot(u_markov,u_markov,Grfc_markov), axis('square')
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 8'),pause(pstate)
|
||||
#
|
||||
##!#!
|
||||
#clf
|
||||
#cmatplot(u_markov,u_markov,{G_markov Grfc_markov},3)
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 9'),pause(pstate)
|
||||
#
|
||||
##!#! Min-max-matrix and theoretical rainflow matrix for test Markov sequence.
|
||||
#cmatplot(u_markov,u_markov,{G_markov Grfc_markov},4)
|
||||
#subplot(121), axis('square'), title('min2max transition matrix')
|
||||
#subplot(122), axis('square'), title('Rainflow matrix')
|
||||
#if (printing==1), print -deps ../bilder/fatigue_9.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 10'),pause(pstate)
|
||||
#
|
||||
##!#! Observed and theoretical rainflow matrix for test Markov sequence.
|
||||
#n=length(u_markov);
|
||||
#Frfc_markov=dtp2rfm(xxD_markov,n);
|
||||
#clf
|
||||
#cmatplot(u_markov,u_markov,{Frfc_markov Grfc_markov*T_markov/2},3)
|
||||
#subplot(121), axis('square'), title('Observed rainflow matrix')
|
||||
#subplot(122), axis('square'), title('Theoretical rainflow matrix')
|
||||
#if (printing==1), print -deps ../bilder/fatigue_10.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 11'),pause(pstate)
|
||||
#
|
||||
##!#! Smoothed observed and calculated rainflow matrix for test Markov sequence.
|
||||
#tp_markov=dat2tp(xx_markov);
|
||||
#RFC_markov=tp2rfc(tp_markov);
|
||||
#h=1;
|
||||
#Frfc_markov_smooth=cc2cmat(param_m,RFC_markov,[],1,h);
|
||||
#clf
|
||||
#cmatplot(u_markov,u_markov,{Frfc_markov_smooth Grfc_markov*T_markov/2},4)
|
||||
#subplot(121), axis('square'), title('Smoothed observed rainflow matrix')
|
||||
#subplot(122), axis('square'), title('Theoretical rainflow matrix')
|
||||
#if (printing==1), print -deps ../bilder/fatigue_11.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 12'),pause(pstate)
|
||||
#
|
||||
##!#! Rainflow matrix from spectrum
|
||||
#clf
|
||||
##!GmM3_herm=spec2mmtpdf(spec,[],'Mm',[],[],2);
|
||||
#GmM3_herm=spec2cmat(spec,[],'Mm',[],param_h,2);
|
||||
#pdfplot(GmM3_herm)
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 13'),pause(pstate)
|
||||
#
|
||||
#
|
||||
##!#! Min-max matrix and theoretical rainflow matrix for Hermite-transformed Gaussian waves.
|
||||
#Grfc_herm=mctp2rfm({GmM3_herm.f []});
|
||||
#u_herm=levels(param_h);
|
||||
#clf
|
||||
#cmatplot(u_herm,u_herm,{GmM3_herm.f Grfc_herm},4)
|
||||
#subplot(121), axis('square'), title('min-max matrix')
|
||||
#subplot(122), axis('square'), title('Theoretical rainflow matrix')
|
||||
#if (printing==1), print -deps ../bilder/fatigue_12.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 14'),pause(pstate)
|
||||
#
|
||||
##!#!
|
||||
#clf
|
||||
#Grfc_direct_herm=spec2cmat(spec,[],'rfc',[],[],2);
|
||||
#subplot(121), pdfplot(GmM3_herm), axis('square'), hold on
|
||||
#subplot(122), pdfplot(Grfc_direct_herm), axis('square'), hold off
|
||||
#if (printing==1), print -deps ../bilder/fig_mmrfcjfr.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 15'),pause(pstate)
|
||||
#
|
||||
#
|
||||
##!#! Observed smoothed and theoretical min-max matrix,
|
||||
##!#! (and observed smoothed and theoretical rainflow matrix for Hermite-transformed Gaussian waves).
|
||||
#tp_herm=dat2tp(xx_herm);
|
||||
#RFC_herm=tp2rfc(tp_herm);
|
||||
#mM_herm=tp2mm(tp_herm);
|
||||
#h=0.2;
|
||||
#FmM_herm_smooth=cc2cmat(param_h,mM_herm,[],1,h);
|
||||
#Frfc_herm_smooth=cc2cmat(param_h,RFC_herm,[],1,h);
|
||||
#T_herm=xx_herm(end,1)-xx_herm(1,1);
|
||||
#clf
|
||||
#cmatplot(u_herm,u_herm,{FmM_herm_smooth GmM3_herm.f*length(mM_herm) ; ...
|
||||
# Frfc_herm_smooth Grfc_herm*length(RFC_herm)},4)
|
||||
#subplot(221), axis('square'), title('Observed smoothed min-max matrix')
|
||||
#subplot(222), axis('square'), title('Theoretical min-max matrix')
|
||||
#subplot(223), axis('square'), title('Observed smoothed rainflow matrix')
|
||||
#subplot(224), axis('square'), title('Theoretical rainflow matrix')
|
||||
#if (printing==1), print -deps ../bilder/fatigue_13.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 16'),pause(pstate)
|
||||
#
|
||||
##!#! Section 4.3.5 Simulation from crossings and rainflow structure
|
||||
#
|
||||
##!#! Crossing spectrum (smooth curve) and obtained spectrum (wiggled curve)
|
||||
##!#! for simulated process with irregularity factor 0.25.
|
||||
#clf
|
||||
#cross_herm=dat2lc(xx_herm);
|
||||
#alpha1=0.25;
|
||||
#alpha2=0.75;
|
||||
#xx_herm_sim1=lc2sdat(cross_herm,500,alpha1);
|
||||
#cross_herm_sim1=dat2lc(xx_herm_sim1);
|
||||
#subplot(211)
|
||||
#plot(cross_herm(:,1),cross_herm(:,2)/max(cross_herm(:,2)))
|
||||
#hold on
|
||||
#stairs(cross_herm_sim1(:,1),...
|
||||
# cross_herm_sim1(:,2)/max(cross_herm_sim1(:,2)))
|
||||
#hold off
|
||||
#title('Crossing intensity, \alpha = 0.25')
|
||||
#subplot(212)
|
||||
#plot(xx_herm_sim1(:,1),xx_herm_sim1(:,2))
|
||||
#title('Simulated load, \alpha = 0.25')
|
||||
#if (printing==1), print -deps ../bilder/fatigue_14_25.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 16'),pause(pstate)
|
||||
#
|
||||
##!#! Crossing spectrum (smooth curve) and obtained spectrum (wiggled curve)
|
||||
##!#! for simulated process with irregularity factor 0.75.
|
||||
#xx_herm_sim2=lc2sdat(cross_herm,500,alpha2);
|
||||
#cross_herm_sim2=dat2lc(xx_herm_sim2);
|
||||
#subplot(211)
|
||||
#plot(cross_herm(:,1),cross_herm(:,2)/max(cross_herm(:,2)))
|
||||
#hold on
|
||||
#stairs(cross_herm_sim2(:,1),...
|
||||
# cross_herm_sim2(:,2)/max(cross_herm_sim2(:,2)))
|
||||
#hold off
|
||||
#title('Crossing intensity, \alpha = 0.75')
|
||||
#subplot(212)
|
||||
#plot(xx_herm_sim2(:,1),xx_herm_sim2(:,2))
|
||||
#title('Simulated load, \alpha = 0.75')
|
||||
#if (printing==1), print -deps ../bilder/fatigue_14_75.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 17'),pause(pstate)
|
||||
#
|
||||
##!#! Section 4.4 Fatigue damage and fatigue life distribution
|
||||
##!#! Section 4.4.1 Introduction
|
||||
#beta=3.2; gam=5.5E-10; T_sea=xx_sea(end,1)-xx_sea(1,1);
|
||||
#d_beta=cc2dam(RFC_sea,beta)/T_sea;
|
||||
#time_fail=1/gam/d_beta/3600 #!in hours of the specific storm
|
||||
#disp('Block 18'),pause(pstate)
|
||||
#
|
||||
##!#! Section 4.4.2 Level crossings
|
||||
##!#! Crossing intensity as calculated from the Markov matrix (solid curve) and from the observed rainflow matrix (dashed curve).
|
||||
#clf
|
||||
#mu_markov=cmat2lc(param_m,Grfc_markov);
|
||||
#muObs_markov=cmat2lc(param_m,Frfc_markov/(T_markov/2));
|
||||
#clf
|
||||
#plot(mu_markov(:,1),mu_markov(:,2),muObs_markov(:,1),muObs_markov(:,2),'--')
|
||||
#title('Theoretical and observed crossing intensity ')
|
||||
#if (printing==1), print -deps ../bilder/fatigue_15.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 19'),pause(pstate)
|
||||
#
|
||||
##!#! Section 4.4.3 Damage
|
||||
##!#! Distribution of damage from different RFC cycles, from calculated theoretical and from observed rainflow matrix.
|
||||
#beta = 4;
|
||||
#Dam_markov = cmat2dam(param_m,Grfc_markov,beta)
|
||||
#DamObs1_markov = cc2dam(RFC_markov,beta)/(T_markov/2)
|
||||
#DamObs2_markov = cmat2dam(param_m,Frfc_markov,beta)/(T_markov/2)
|
||||
#disp('Block 20'),pause(pstate)
|
||||
#
|
||||
#Dmat_markov = cmat2dmat(param_m,Grfc_markov,beta);
|
||||
#DmatObs_markov = cmat2dmat(param_m,Frfc_markov,beta)/(T_markov/2);
|
||||
#clf
|
||||
#subplot(121), cmatplot(u_markov,u_markov,Dmat_markov,4)
|
||||
#title('Theoretical damage matrix')
|
||||
#subplot(122), cmatplot(u_markov,u_markov,DmatObs_markov,4)
|
||||
#title('Observed damage matrix')
|
||||
#if (printing==1), print -deps ../bilder/fatigue_16.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 21'),pause(pstate)
|
||||
#
|
||||
#
|
||||
##!#!
|
||||
##!Damplus_markov = lc2dplus(mu_markov,beta)
|
||||
#pause(pstate)
|
||||
#
|
||||
##!#! Section 4.4.4 Estimation of S-N curve
|
||||
#
|
||||
##!#! Load SN-data and plot in log-log scale.
|
||||
#SN = load('sn.dat');
|
||||
#s = SN(:,1);
|
||||
#N = SN(:,2);
|
||||
#clf
|
||||
#loglog(N,s,'o'), axis([0 14e5 10 30])
|
||||
##!if (printing==1), print -deps ../bilder/fatigue_?.eps end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 22'),pause(pstate)
|
||||
#
|
||||
#
|
||||
##!#! Check of S-N-model on normal probability paper.
|
||||
#
|
||||
#normplot(reshape(log(N),8,5))
|
||||
#if (printing==1), print -deps ../bilder/fatigue_17.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 23'),pause(pstate)
|
||||
#
|
||||
##!#! Estimation of S-N-model on linear scale.
|
||||
#clf
|
||||
#[e0,beta0,s20] = snplot(s,N,12);
|
||||
#title('S-N-data with estimated N(s)','FontSize',20)
|
||||
#set(gca,'FontSize',20)
|
||||
#if (printing==1), print -deps ../bilder/fatigue_18a.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 24'),pause(pstate)
|
||||
#
|
||||
##!#! Estimation of S-N-model on log-log scale.
|
||||
#clf
|
||||
#[e0,beta0,s20] = snplot(s,N,14);
|
||||
#title('S-N-data with estimated N(s)','FontSize',20)
|
||||
#set(gca,'FontSize',20)
|
||||
#if (printing==1), print -deps ../bilder/fatigue_18b.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 25'),pause(pstate)
|
||||
#
|
||||
##!#! Section 4.4.5 From S-N curve to fatigue life distribution
|
||||
##!#! Damage intensity as function of $\beta$
|
||||
#beta = 3:0.1:8;
|
||||
#DRFC = cc2dam(RFC_sea,beta);
|
||||
#dRFC = DRFC/T_sea;
|
||||
#plot(beta,dRFC), axis([3 8 0 0.25])
|
||||
#title('Damage intensity as function of \beta')
|
||||
#if (printing==1), print -deps ../bilder/fatigue_19.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 26'),pause(pstate)
|
||||
#
|
||||
##!#! Fatigue life distribution with sea load.
|
||||
#dam0 = cc2dam(RFC_sea,beta0)/T_sea;
|
||||
#[t0,F0] = ftf(e0,dam0,s20,0.5,1);
|
||||
#[t1,F1] = ftf(e0,dam0,s20,0,1);
|
||||
#[t2,F2] = ftf(e0,dam0,s20,5,1);
|
||||
#plot(t0,F0,t1,F1,t2,F2)
|
||||
#title('Fatigue life distribution function')
|
||||
#if (printing==1), print -deps ../bilder/fatigue_20.eps
|
||||
#end
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block 27, last block')
|
||||
@ -1,238 +0,0 @@
|
||||
## CHAPTER5 contains the commands used in Chapter 5 of the tutorial
|
||||
#
|
||||
# CALL: Chapter5
|
||||
#
|
||||
# Some of the commands are edited for fast computation.
|
||||
# Each set of commands is followed by a 'pause' command.
|
||||
#
|
||||
|
||||
# Tested on Matlab 5.3
|
||||
# History
|
||||
# Added Return values by GL August 2008
|
||||
# Revised pab sept2005
|
||||
# Added sections -> easier to evaluate using cellmode evaluation.
|
||||
# Created by GL July 13, 2000
|
||||
# from commands used in Chapter 5
|
||||
#
|
||||
|
||||
## Chapter 5 Extreme value analysis
|
||||
|
||||
## Section 5.1 Weibull and Gumbel papers
|
||||
from __future__ import division
|
||||
import numpy as np
|
||||
import scipy.interpolate as si
|
||||
from wafo.plotbackend import plotbackend as plt
|
||||
import wafo.data as wd
|
||||
import wafo.objects as wo
|
||||
import wafo.stats as ws
|
||||
import wafo.kdetools as wk
|
||||
pstate = 'off'
|
||||
|
||||
# Significant wave-height data on Weibull paper,
|
||||
|
||||
fig = plt.figure()
|
||||
ax = fig.add_subplot(111)
|
||||
Hs = wd.atlantic()
|
||||
wei = ws.weibull_min.fit(Hs)
|
||||
tmp = ws.probplot(Hs, wei, ws.weibull_min, plot=ax)
|
||||
plt.show()
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block = 1'),pause(pstate)
|
||||
|
||||
##
|
||||
# Significant wave-height data on Gumbel paper,
|
||||
plt.clf()
|
||||
ax = fig.add_subplot(111)
|
||||
gum = ws.gumbel_r.fit(Hs)
|
||||
tmp1 = ws.probplot(Hs, gum, ws.gumbel_r, plot=ax)
|
||||
#wafostamp([],'(ER)')
|
||||
plt.show()
|
||||
#disp('Block = 2'),pause(pstate)
|
||||
|
||||
##
|
||||
# Significant wave-height data on Normal probability paper,
|
||||
plt.clf()
|
||||
ax = fig.add_subplot(111)
|
||||
phat = ws.norm.fit2(np.log(Hs))
|
||||
phat.plotresq()
|
||||
#tmp2 = ws.probplot(np.log(Hs), phat, ws.norm, plot=ax)
|
||||
|
||||
#wafostamp([],'(ER)')
|
||||
plt.show()
|
||||
#disp('Block = 3'),pause(pstate)
|
||||
|
||||
##
|
||||
# Return values in the Gumbel distribution
|
||||
plt.clf()
|
||||
T = np.r_[1:100000]
|
||||
sT = gum[0] - gum[1] * np.log(-np.log1p(-1./T))
|
||||
plt.semilogx(T, sT)
|
||||
plt.hold(True)
|
||||
# ws.edf(Hs).plot()
|
||||
Nmax = len(Hs)
|
||||
N = np.r_[1:Nmax + 1]
|
||||
|
||||
plt.plot(Nmax/N, sorted(Hs, reverse=True), '.')
|
||||
plt.title('Return values in the Gumbel model')
|
||||
plt.xlabel('Return period')
|
||||
plt.ylabel('Return value')
|
||||
#wafostamp([],'(ER)')
|
||||
plt.show()
|
||||
#disp('Block = 4'),pause(pstate)
|
||||
|
||||
## Section 5.2 Generalized Pareto and Extreme Value distributions
|
||||
## Section 5.2.1 Generalized Extreme Value distribution
|
||||
|
||||
# Empirical distribution of significant wave-height with estimated
|
||||
# Generalized Extreme Value distribution,
|
||||
gev = ws.genextreme.fit2(Hs)
|
||||
gev.plotfitsummary()
|
||||
# wafostamp([],'(ER)')
|
||||
# disp('Block = 5a'),pause(pstate)
|
||||
|
||||
plt.clf()
|
||||
x = np.linspace(0,14,200)
|
||||
kde = wk.TKDE(Hs, L2=0.5)(x, output='plot')
|
||||
kde.plot()
|
||||
plt.hold(True)
|
||||
plt.plot(x, gev.pdf(x),'--')
|
||||
# disp('Block = 5b'),pause(pstate)
|
||||
|
||||
# Analysis of yura87 wave data.
|
||||
# Wave data interpolated (spline) and organized in 5-minute intervals
|
||||
# Normalized to mean 0 and std = 1 to get stationary conditions.
|
||||
# maximum level over each 5-minute interval analysed by GEV
|
||||
xn = wd.yura87()
|
||||
XI = np.r_[1:len(xn):0.25] - .99
|
||||
N = len(XI)
|
||||
N = N - np.mod(N, 4*60*5)
|
||||
|
||||
YI = si.interp1d(xn[:, 0], xn[:, 1], kind='linear')(XI)
|
||||
YI = YI.reshape(4*60*5, N/(4*60*5)) # Each column holds 5 minutes of
|
||||
# interpolated data.
|
||||
Y5 = (YI - YI.mean(axis=0)) / YI.std(axis=0)
|
||||
Y5M = Y5.maximum(axis=0)
|
||||
Y5gev = ws.genextreme.fit2(Y5M,method='mps')
|
||||
Y5gev.plotfitsummary()
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block = 6'),pause(pstate)
|
||||
|
||||
## Section 5.2.2 Generalized Pareto distribution
|
||||
|
||||
# Exceedances of significant wave-height data over level 3,
|
||||
gpd3 = ws.genpareto.fit2(Hs[Hs>3]-3, floc=0)
|
||||
gpd3.plotfitsummary()
|
||||
#wafostamp([],'(ER)')
|
||||
|
||||
##
|
||||
plt.figure()
|
||||
# Exceedances of significant wave-height data over level 7,
|
||||
gpd7 = ws.genpareto.fit2(Hs(Hs>7), floc=7)
|
||||
gpd7.plotfitsummary()
|
||||
# wafostamp([],'(ER)')
|
||||
# disp('Block = 6'),pause(pstate)
|
||||
|
||||
##
|
||||
#Simulates 100 values from the GEV distribution with parameters (0.3, 1, 2),
|
||||
# then estimates the parameters using two different methods and plots the
|
||||
# estimated distribution functions together with the empirical distribution.
|
||||
Rgev = ws.genextreme.rvs(0.3,1,2,size=100)
|
||||
gp = ws.genextreme.fit2(Rgev, method='mps');
|
||||
gm = ws.genextreme.fit2(Rgev, *gp.par.tolist(), method='ml')
|
||||
gm.plotfitsummary()
|
||||
|
||||
gp.plotecdf()
|
||||
plt.hold(True)
|
||||
plt.plot(x, gm.cdf(x), '--')
|
||||
plt.hold(False)
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block =7'),pause(pstate)
|
||||
|
||||
##
|
||||
# ;
|
||||
Rgpd = ws.genpareto.rvs(0.4,0, 1,size=100)
|
||||
gp = ws.genpareto.fit2(Rgpd, method='mps')
|
||||
gml = ws.genpareto.fit2(Rgpd, method='ml')
|
||||
|
||||
gp.plotecdf()
|
||||
x = sorted(Rgpd)
|
||||
plt.hold(True)
|
||||
plt.plot(x, gml.cdf(x))
|
||||
# gm = fitgenpar(Rgpd,'method','mom','plotflag',0);
|
||||
# plot(x,cdfgenpar(x,gm),'g--')
|
||||
#gw = fitgenpar(Rgpd,'method','pwm','plotflag',0);
|
||||
#plot(x,cdfgenpar(x,gw),'g:')
|
||||
#gml = fitgenpar(Rgpd,'method','ml','plotflag',0);
|
||||
#plot(x,cdfgenpar(x,gml),'--')
|
||||
#gmps = fitgenpar(Rgpd,'method','mps','plotflag',0);
|
||||
#plot(x,cdfgenpar(x,gmps),'r-.')
|
||||
plt.hold(False)
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block = 8'),pause(pstate)
|
||||
|
||||
##
|
||||
# Return values for the GEV distribution
|
||||
T = np.logspace(1, 5, 10);
|
||||
#[sT, sTlo, sTup] = invgev(1./T,Y5gev,'lowertail',false,'proflog',true);
|
||||
|
||||
#T = 2:100000;
|
||||
#k=Y5gev.params(1); mu=Y5gev.params(3); sigma=Y5gev.params(2);
|
||||
#sT1 = invgev(1./T,Y5gev,'lowertail',false);
|
||||
#sT=mu + sigma/k*(1-(-log(1-1./T)).^k);
|
||||
plt.clf()
|
||||
#plt.semilogx(T,sT,T,sTlo,'r',T,sTup,'r')
|
||||
#plt.hold(True)
|
||||
#N = np.r_[1:len(Y5M)]
|
||||
#Nmax = max(N);
|
||||
#plot(Nmax./N, sorted(Y5M,reverse=True), '.')
|
||||
#plt.title('Return values in the GEV model')
|
||||
#plt.xlabel('Return priod')
|
||||
#plt.ylabel('Return value')
|
||||
#plt.grid(True)
|
||||
#disp('Block = 9'),pause(pstate)
|
||||
|
||||
## Section 5.3 POT-analysis
|
||||
|
||||
# Estimated expected exceedance over level u as function of u.
|
||||
plt.clf()
|
||||
|
||||
mrl = ws.reslife(Hs,'umin',2,'umax',10,'Nu',200);
|
||||
mrl.plot()
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block = 10'),pause(pstate)
|
||||
|
||||
##
|
||||
# Estimated distribution functions of monthly maxima
|
||||
#with the POT method (solid),
|
||||
# fitting a GEV (dashed) and the empirical distribution.
|
||||
|
||||
# POT- method
|
||||
gpd7 = ws.genpareto.fit2(Hs(Hs>7)-7, method='mps', floc=0)
|
||||
khat, loc, sigmahat = gpd7.par
|
||||
|
||||
muhat = len(Hs[Hs>7])/(7*3*2)
|
||||
bhat = sigmahat/muhat**khat
|
||||
ahat = 7-(bhat-sigmahat)/khat
|
||||
x = np.linspace(5,15,200);
|
||||
plt.plot(x,ws.genextreme.cdf(x, khat,bhat,ahat))
|
||||
# disp('Block = 11'),pause(pstate)
|
||||
|
||||
##
|
||||
# Since we have data to compute the monthly maxima mm over
|
||||
#42 months we can also try to fit a
|
||||
# GEV distribution directly:
|
||||
mm = np.zeros((1,41))
|
||||
for i in range(41):
|
||||
mm[i] = max(Hs[((i-1)*14+1):i*14])
|
||||
|
||||
|
||||
gev = ws.genextreme.fit2(mm)
|
||||
|
||||
|
||||
plt.hold(True)
|
||||
gev.plotecdf()
|
||||
|
||||
plt.hold(False)
|
||||
#wafostamp([],'(ER)')
|
||||
#disp('Block = 12, Last block'),pause(pstate)
|
||||
|
||||
@ -1,176 +0,0 @@
|
||||
from tutor_init import *
|
||||
import itertools
|
||||
# import sys
|
||||
log = logging.getLogger(__name__)
|
||||
log.setLevel(logging.DEBUG)
|
||||
|
||||
MARKERS = ('o', 'x', '+', '.', '<', '>', '^', 'v')
|
||||
|
||||
|
||||
def plot_varying_symbols(x, y, color='red', size=5):
|
||||
"""
|
||||
Create a plot with varying symbols
|
||||
Parameters
|
||||
----------
|
||||
x : numpy array with x data of the points
|
||||
y : numpy array with y data of the points
|
||||
color : color of the symbols
|
||||
|
||||
Returns
|
||||
-------
|
||||
|
||||
"""
|
||||
markers = itertools.cycle(MARKERS)
|
||||
for q, p in zip(x, y):
|
||||
plt.plot(q, p, marker=markers.next(), linestyle='', color=color,
|
||||
markersize=size)
|
||||
|
||||
|
||||
def damage_vs_S(S, beta, K):
|
||||
"""
|
||||
Calculate the damage 1/N for a given stress S
|
||||
|
||||
Parameters
|
||||
----------
|
||||
S : Stress [Pa]
|
||||
beta : coefficient, typically 3
|
||||
K : constant
|
||||
|
||||
Returns
|
||||
-------
|
||||
|
||||
"""
|
||||
return K * np.power(S, beta)
|
||||
|
||||
# Section 4.3.1 Crossing intensity
|
||||
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
import wafo.data as wd
|
||||
import wafo.objects as wo
|
||||
import wafo.misc as wm
|
||||
|
||||
xx_sea = wd.sea()
|
||||
|
||||
Tlength = xx_sea[-1, 0] - xx_sea[0, 0]
|
||||
beta = 3
|
||||
K1 = 6.5e-31
|
||||
Np = 200
|
||||
Tp = Tlength / Np
|
||||
A = 100e6
|
||||
log.info("setting sin wave with Tp={} and T={}".format(Tp, Tlength))
|
||||
Nc = 1.0 / damage_vs_S(A, beta, K1)
|
||||
damage = float(Np) / float(Nc)
|
||||
log.info("budget at S={} N={}: damage = {} ".format(A, Nc, damage))
|
||||
#xx_sea[:, 1] = A * np.cos(2 * np.pi * xx_sea[:, 0]/Tp)
|
||||
xx_sea[:, 1] *= 500e6
|
||||
|
||||
log.info("loaded sea time series {}".format(xx_sea.shape))
|
||||
ts = wo.mat2timeseries(xx_sea)
|
||||
|
||||
tp = ts.turning_points()
|
||||
mM = tp.cycle_pairs(kind='min2max')
|
||||
Mm = tp.cycle_pairs(kind='max2min')
|
||||
lc = mM.level_crossings(intensity=True)
|
||||
T_sea = ts.args[-1] - ts.args[0]
|
||||
|
||||
# for i in dir(mM):
|
||||
# print(i)
|
||||
|
||||
|
||||
ts1 = wo.mat2timeseries(xx_sea[:, :])
|
||||
tp1 = ts1.turning_points()
|
||||
sig_tp = ts.turning_points(h=0, wavetype='astm')
|
||||
try:
|
||||
sig_cp = sig_tp.cycle_astm()
|
||||
log.info("Successfully used cycle_astm")
|
||||
except AttributeError:
|
||||
log.warning("Could use cycle_astm")
|
||||
sig_cp = None
|
||||
tp1 = ts1.turning_points()
|
||||
tp2 = ts1.turning_points(wavetype='Mw')
|
||||
mM1 = tp1.cycle_pairs(kind='min2max')
|
||||
Mm1 = tp1.cycle_pairs(kind='max2min')
|
||||
|
||||
tp_rfc = tp1.rainflow_filter(h=100e6)
|
||||
mM_rfc = tp_rfc.cycle_pairs()
|
||||
try:
|
||||
mM_rfc_a = tp1.cycle_astm()
|
||||
except AttributeError:
|
||||
mM_rfc_a = None
|
||||
tc1 = ts1.trough_crest()
|
||||
min_to_max = True
|
||||
rfc_plot = True
|
||||
if min_to_max:
|
||||
m1, M1 = mM1.get_minima_and_maxima()
|
||||
i_min_start = 0
|
||||
else:
|
||||
m1, M1 = Mm1.get_minima_and_maxima()
|
||||
i_min_start = 2
|
||||
|
||||
m_rfc, M_rfc = mM_rfc.get_minima_and_maxima()
|
||||
# m_rfc_a, M_rfc_a = mM_rfc_a.get_minima_and_maxima()
|
||||
ts1.plot('b-')
|
||||
if rfc_plot:
|
||||
plot_varying_symbols(tp_rfc.args[0::2], m_rfc, color='red', size=10)
|
||||
plot_varying_symbols(tp_rfc.args[1::2], M_rfc, color='green', size=10)
|
||||
else:
|
||||
plot_varying_symbols(tp.args[i_min_start::2], m1, color='red', size=10)
|
||||
plot_varying_symbols(tp.args[1::2], M1, color='green', size=10)
|
||||
|
||||
set_windows_title("Sea time series", log)
|
||||
|
||||
plt.figure()
|
||||
plt.subplot(122),
|
||||
mM.plot()
|
||||
plt.title('min-max cycle pairs')
|
||||
plt.subplot(121),
|
||||
mM_rfc.plot()
|
||||
|
||||
title = 'Rainflow filtered cycles'
|
||||
plt.title(title)
|
||||
set_windows_title(title)
|
||||
|
||||
|
||||
# Min-max and rainflow cycle distributions
|
||||
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
# import wafo.misc as wm
|
||||
ampmM_sea = mM.amplitudes()
|
||||
ampRFC_sea = mM_rfc.amplitudes()
|
||||
plt.figure()
|
||||
title = "s_n_curve"
|
||||
set_windows_title(title)
|
||||
S = np.linspace(1e6, 1000e6)
|
||||
plt.loglog(S, damage_vs_S(S, beta, K1))
|
||||
plt.figure()
|
||||
plt.subplot(121)
|
||||
stress_range = (1, 1e9)
|
||||
n_bins = 100
|
||||
wm.plot_histgrm(ampmM_sea, bins=n_bins, range=stress_range)
|
||||
plt.xlim(stress_range)
|
||||
ylim = plt.gca().get_ylim()
|
||||
plt.title('min-max amplitude distribution')
|
||||
plt.subplot(122)
|
||||
if sig_cp is not None:
|
||||
wm.plot_histgrm(sig_cp[:, 0], bins=n_bins, range=stress_range)
|
||||
plt.gca().set_ylim(ylim)
|
||||
title = 'Rainflow amplitude distribution'
|
||||
plt.title(title)
|
||||
plt.semilogy
|
||||
set_windows_title(title)
|
||||
|
||||
hist, bin_edges = np.histogram(
|
||||
sig_cp[
|
||||
:, 0], bins=n_bins, range=stress_range)
|
||||
|
||||
plt.figure()
|
||||
title = "my_bins"
|
||||
plt.title(title)
|
||||
plt.title(title)
|
||||
set_windows_title(title)
|
||||
plt.semilogy
|
||||
plt.bar(bin_edges[:-1], hist, width=stress_range[1] / n_bins)
|
||||
|
||||
print("damage min/max : {}".format(mM_rfc.damage([beta], K1)))
|
||||
|
||||
damage_rfc = K1 * np.sum(sig_cp[:, 0] ** beta)
|
||||
print("damage rfc : {}".format(damage_rfc))
|
||||
plt.show('hold')
|
||||
@ -1,27 +0,0 @@
|
||||
import logging
|
||||
import scipy as sp
|
||||
import numpy as np
|
||||
from numpy import pi, reshape
|
||||
import matplotlib.pyplot as plt
|
||||
import matplotlib
|
||||
matplotlib.use('Qt4Agg')
|
||||
from matplotlib import rcParams
|
||||
rcParams.update({"font.size": 10})
|
||||
|
||||
|
||||
try:
|
||||
from win32api import LoadResource
|
||||
except ImportError:
|
||||
pass
|
||||
|
||||
log = logging.basicConfig(
|
||||
format="%(asctime)s - %(name)s - %(levelname)s - %(message)s",
|
||||
level=logging.DEBUG)
|
||||
|
||||
|
||||
def set_windows_title(title, log=None):
|
||||
if log is not None:
|
||||
log.info("Set windows title {}".format(title))
|
||||
fig = plt.gcf()
|
||||
fig.canvas.set_window_title(title)
|
||||
plt.show()
|
||||
@ -1,2 +0,0 @@
|
||||
from wafo.sg_filter._core import * # pylint: disable=wildcard-import
|
||||
from wafo.sg_filter import demos
|
||||
File diff suppressed because one or more lines are too long
@ -1,488 +0,0 @@
|
||||
import numpy as np
|
||||
from scipy.sparse.linalg import expm
|
||||
from scipy.signal import medfilt
|
||||
from wafo.plotbackend import plotbackend as plt
|
||||
from wafo.sg_filter._core import (SavitzkyGolay, smoothn, Kalman,
|
||||
HodrickPrescott, HampelFilter)
|
||||
|
||||
|
||||
def demo_savitzky_on_noisy_chirp():
|
||||
"""
|
||||
Example
|
||||
-------
|
||||
>>> demo_savitzky_on_noisy_chirp()
|
||||
|
||||
>>> plt.close()
|
||||
"""
|
||||
plt.figure(figsize=(7, 12))
|
||||
|
||||
# generate chirp signal
|
||||
tvec = np.arange(0, 6.28, .02)
|
||||
true_signal = np.sin(tvec * (2.0 + tvec))
|
||||
true_d_signal = (2 + tvec) * np.cos(tvec * (2.0 + tvec))
|
||||
|
||||
# add noise to signal
|
||||
noise = np.random.normal(size=true_signal.shape)
|
||||
signal = true_signal + .15 * noise
|
||||
|
||||
# plot signal
|
||||
plt.subplot(311)
|
||||
plt.plot(signal)
|
||||
plt.title('signal')
|
||||
|
||||
# smooth and plot signal
|
||||
plt.subplot(312)
|
||||
savgol = SavitzkyGolay(n=8, degree=4)
|
||||
s_signal = savgol.smooth(signal)
|
||||
s2 = smoothn(signal, robust=True)
|
||||
plt.plot(s_signal)
|
||||
plt.plot(s2)
|
||||
plt.plot(true_signal, 'r--')
|
||||
plt.title('smoothed signal')
|
||||
|
||||
# smooth derivative of signal and plot it
|
||||
plt.subplot(313)
|
||||
savgol1 = SavitzkyGolay(n=8, degree=1, diff_order=1)
|
||||
|
||||
dt = tvec[1] - tvec[0]
|
||||
d_signal = savgol1.smooth(signal) / dt
|
||||
|
||||
plt.plot(d_signal)
|
||||
plt.plot(true_d_signal, 'r--')
|
||||
plt.title('smoothed derivative of signal')
|
||||
|
||||
|
||||
def demo_kalman_voltimeter():
|
||||
"""
|
||||
Example
|
||||
-------
|
||||
>>> demo_kalman_voltimeter()
|
||||
|
||||
>>> plt.close()
|
||||
"""
|
||||
V0 = 12
|
||||
h = np.atleast_2d(1) # voltimeter measure the voltage itself
|
||||
q = 1e-9 # variance of process noise as the car operates
|
||||
r = 0.05 ** 2 # variance of measurement error
|
||||
b = 0 # no system input
|
||||
u = 0 # no system input
|
||||
filt = Kalman(R=r, A=1, Q=q, H=h, B=b)
|
||||
|
||||
# Generate random voltages and watch the filter operate.
|
||||
n = 50
|
||||
truth = np.random.randn(n) * np.sqrt(q) + V0
|
||||
z = truth + np.random.randn(n) * np.sqrt(r) # measurement
|
||||
x = np.zeros(n)
|
||||
|
||||
for i, zi in enumerate(z):
|
||||
x[i] = filt(zi, u) # perform a Kalman filter iteration
|
||||
|
||||
_hz = plt.plot(z, 'r.', label='observations')
|
||||
# a-posteriori state estimates:
|
||||
_hx = plt.plot(x, 'b-', label='Kalman output')
|
||||
_ht = plt.plot(truth, 'g-', label='true voltage')
|
||||
plt.legend()
|
||||
plt.title('Automobile Voltimeter Example')
|
||||
|
||||
|
||||
def lti_disc(F, L=None, Q=None, dt=1):
|
||||
"""LTI_DISC Discretize LTI ODE with Gaussian Noise.
|
||||
|
||||
Syntax:
|
||||
[A,Q] = lti_disc(F,L,Qc,dt)
|
||||
|
||||
In:
|
||||
F - NxN Feedback matrix
|
||||
L - NxL Noise effect matrix (optional, default identity)
|
||||
Qc - LxL Diagonal Spectral Density (optional, default zeros)
|
||||
dt - Time Step (optional, default 1)
|
||||
|
||||
Out:
|
||||
A - Transition matrix
|
||||
Q - Discrete Process Covariance
|
||||
|
||||
Description:
|
||||
Discretize LTI ODE with Gaussian Noise. The original
|
||||
ODE model is in form
|
||||
|
||||
dx/dt = F x + L w, w ~ N(0,Qc)
|
||||
|
||||
Result of discretization is the model
|
||||
|
||||
x[k] = A x[k-1] + q, q ~ N(0,Q)
|
||||
|
||||
Which can be used for integrating the model
|
||||
exactly over time steps, which are multiples
|
||||
of dt.
|
||||
|
||||
"""
|
||||
n = np.shape(F)[0]
|
||||
if L is None:
|
||||
L = np.eye(n)
|
||||
|
||||
if Q is None:
|
||||
Q = np.zeros((n, n))
|
||||
# Closed form integration of transition matrix
|
||||
A = expm(F * dt)
|
||||
|
||||
# Closed form integration of covariance
|
||||
# by matrix fraction decomposition
|
||||
|
||||
Phi = np.vstack((np.hstack((F, np.dot(np.dot(L, Q), L.T))),
|
||||
np.hstack((np.zeros((n, n)), -F.T))))
|
||||
AB = np.dot(expm(Phi * dt), np.vstack((np.zeros((n, n)), np.eye(n))))
|
||||
# Q = AB[:n, :] / AB[n:(2 * n), :]
|
||||
Q = np.linalg.solve(AB[n:(2 * n), :].T, AB[:n, :].T)
|
||||
return A, Q
|
||||
|
||||
|
||||
def demo_kalman_sine():
|
||||
"""Kalman Filter demonstration with sine signal.
|
||||
|
||||
Example
|
||||
-------
|
||||
>>> demo_kalman_sine()
|
||||
|
||||
>>> plt.close()
|
||||
"""
|
||||
sd = 0.5
|
||||
dt = 0.1
|
||||
w = 1
|
||||
T = np.arange(0, 30 + dt / 2, dt)
|
||||
n = len(T)
|
||||
X = 3 * np.sin(w * T)
|
||||
Y = X + sd * np.random.randn(n)
|
||||
|
||||
''' Initialize KF to values
|
||||
x = 0
|
||||
dx/dt = 0
|
||||
with great uncertainty in derivative
|
||||
'''
|
||||
M = np.zeros((2, 1))
|
||||
P = np.diag([0.1, 2])
|
||||
R = sd ** 2
|
||||
H = np.atleast_2d([1, 0])
|
||||
q = 0.1
|
||||
F = np.atleast_2d([[0, 1],
|
||||
[0, 0]])
|
||||
A, Q = lti_disc(F, L=None, Q=np.diag([0, q]), dt=dt)
|
||||
|
||||
# Track and animate
|
||||
m = M.shape[0]
|
||||
_MM = np.zeros((m, n))
|
||||
_PP = np.zeros((m, m, n))
|
||||
'''In this demonstration we estimate a stationary sine signal from noisy
|
||||
measurements by using the classical Kalman filter.'
|
||||
'''
|
||||
filt = Kalman(R=R, x=M, P=P, A=A, Q=Q, H=H, B=0)
|
||||
|
||||
# Generate random voltages and watch the filter operate.
|
||||
# n = 50
|
||||
# truth = np.random.randn(n) * np.sqrt(q) + V0
|
||||
# z = truth + np.random.randn(n) * np.sqrt(r) # measurement
|
||||
truth = X
|
||||
z = Y
|
||||
x = np.zeros((n, m))
|
||||
|
||||
for i, zi in enumerate(z):
|
||||
x[i] = np.ravel(filt(zi, u=0))
|
||||
|
||||
_hz = plt.plot(z, 'r.', label='observations')
|
||||
# a-posteriori state estimates:
|
||||
_hx = plt.plot(x[:, 0], 'b-', label='Kalman output')
|
||||
_ht = plt.plot(truth, 'g-', label='true voltage')
|
||||
plt.legend()
|
||||
plt.title('Automobile Voltimeter Example')
|
||||
|
||||
|
||||
# for k in range(m):
|
||||
# [M,P] = kf_predict(M,P,A,Q);
|
||||
# [M,P] = kf_update(M,P,Y(k),H,R);
|
||||
#
|
||||
# MM(:,k) = M;
|
||||
# PP(:,:,k) = P;
|
||||
#
|
||||
# %
|
||||
# % Animate
|
||||
# %
|
||||
# if rem(k,10)==1
|
||||
# plot(T,X,'b--',...
|
||||
# T,Y,'ro',...
|
||||
# T(k),M(1),'k*',...
|
||||
# T(1:k),MM(1,1:k),'k-');
|
||||
# legend('Real signal','Measurements','Latest estimate',
|
||||
# 'Filtered estimate')
|
||||
# title('Estimating a noisy sine signal with Kalman filter.');
|
||||
# drawnow;
|
||||
#
|
||||
# pause;
|
||||
# end
|
||||
# end
|
||||
#
|
||||
# clc;
|
||||
# disp('In this demonstration we estimate a stationary sine signal '
|
||||
# 'from noisy measurements by using the classical Kalman filter.');
|
||||
# disp(' ');
|
||||
# disp('The filtering results are now displayed sequantially for 10 time '
|
||||
# 'step at a time.');
|
||||
# disp(' ');
|
||||
# disp('<push any key to see the filtered and smoothed results together>')
|
||||
# pause;
|
||||
# %
|
||||
# % Apply Kalman smoother
|
||||
# %
|
||||
# SM = rts_smooth(MM,PP,A,Q);
|
||||
# plot(T,X,'b--',...
|
||||
# T,MM(1,:),'k-',...
|
||||
# T,SM(1,:),'r-');
|
||||
# legend('Real signal','Filtered estimate','Smoothed estimate')
|
||||
# title('Filtered and smoothed estimate of the original signal');
|
||||
#
|
||||
# clc;
|
||||
# disp('The filtered and smoothed estimates of the signal are now '
|
||||
# 'displayed.')
|
||||
# disp(' ');
|
||||
# disp('RMS errors:');
|
||||
# %
|
||||
# % Errors
|
||||
# %
|
||||
# fprintf('KF = %.3f\nRTS = %.3f\n',...
|
||||
# sqrt(mean((MM(1,:)-X(1,:)).^2)),...
|
||||
# sqrt(mean((SM(1,:)-X(1,:)).^2)));
|
||||
|
||||
|
||||
def demo_hampel():
|
||||
"""
|
||||
Example
|
||||
-------
|
||||
>>> demo_hampel()
|
||||
|
||||
>>> plt.close()
|
||||
"""
|
||||
randint = np.random.randint
|
||||
Y = 5000 + np.random.randn(1000)
|
||||
outliers = randint(0, 1000, size=(10,))
|
||||
Y[outliers] = Y[outliers] + randint(1000, size=(10,))
|
||||
YY, res = HampelFilter(dx=3, t=3, fulloutput=True)(Y)
|
||||
YY1, res1 = HampelFilter(dx=1, t=3, adaptive=0.1, fulloutput=True)(Y)
|
||||
YY2, res2 = HampelFilter(dx=3, t=0, fulloutput=True)(Y) # median
|
||||
plt.figure(1)
|
||||
plot_hampel(Y, YY, res)
|
||||
plt.title('Standard HampelFilter')
|
||||
plt.figure(2)
|
||||
plot_hampel(Y, YY1, res1)
|
||||
plt.title('Adaptive HampelFilter')
|
||||
plt.figure(3)
|
||||
plot_hampel(Y, YY2, res2)
|
||||
plt.title('Median filter')
|
||||
|
||||
|
||||
def plot_hampel(Y, YY, res):
|
||||
X = np.arange(len(YY))
|
||||
plt.plot(X, Y, 'b.') # Original Data
|
||||
plt.plot(X, YY, 'r') # Hampel Filtered Data
|
||||
plt.plot(X, res['Y0'], 'b--') # Nominal Data
|
||||
plt.plot(X, res['LB'], 'r--') # Lower Bounds on Hampel Filter
|
||||
plt.plot(X, res['UB'], 'r--') # Upper Bounds on Hampel Filter
|
||||
i = res['outliers']
|
||||
plt.plot(X[i], Y[i], 'ks') # Identified Outliers
|
||||
|
||||
|
||||
def demo_tide_filter():
|
||||
"""
|
||||
Example
|
||||
-------
|
||||
>>> demo_tide_filter()
|
||||
|
||||
>>> plt.close()
|
||||
"""
|
||||
# import statsmodels.api as sa
|
||||
import wafo.spectrum.models as sm
|
||||
sd = 10
|
||||
Sj = sm.Jonswap(Hm0=4. * sd)
|
||||
S = Sj.tospecdata()
|
||||
|
||||
q = (0.1 * sd) ** 2 # variance of process noise s the car operates
|
||||
r = (100 * sd) ** 2 # variance of measurement error
|
||||
b = 0 # no system input
|
||||
u = 0 # no system input
|
||||
|
||||
from scipy.signal import butter, filtfilt, lfilter_zi # lfilter,
|
||||
freq_tide = 1. / (12 * 60 * 60)
|
||||
freq_wave = 1. / 10
|
||||
freq_filt = freq_wave / 10
|
||||
dt = 1.
|
||||
freq = 1. / dt
|
||||
fn = (freq / 2)
|
||||
|
||||
P = 10 * np.diag([1, 0.01])
|
||||
R = r
|
||||
H = np.atleast_2d([1, 0])
|
||||
|
||||
F = np.atleast_2d([[0, 1],
|
||||
[0, 0]])
|
||||
A, Q = lti_disc(F, L=None, Q=np.diag([0, q]), dt=dt)
|
||||
|
||||
t = np.arange(0, 60 * 12, 1. / freq)
|
||||
w = 2 * np.pi * freq # 1 Hz
|
||||
tide = 100 * np.sin(freq_tide * w * t + 2 * np.pi / 4) + 100
|
||||
y = tide + S.sim(len(t), dt=1. / freq)[:, 1].ravel()
|
||||
# lowess = sa.nonparametric.lowess
|
||||
# y2 = lowess(y, t, frac=0.5)[:,1]
|
||||
|
||||
filt = Kalman(R=R, x=np.array([[tide[0]], [0]]), P=P, A=A, Q=Q, H=H, B=b)
|
||||
filt2 = Kalman(R=R, x=np.array([[tide[0]], [0]]), P=P, A=A, Q=Q, H=H, B=b)
|
||||
# y = tide + 0.5 * np.sin(freq_wave * w * t)
|
||||
# Butterworth filter
|
||||
b, a = butter(9, (freq_filt / fn), btype='low')
|
||||
# y2 = [lowess(y[max(i-60,0):i + 1], t[max(i-60,0):i + 1], frac=.3)[-1,1]
|
||||
# for i in range(len(y))]
|
||||
# y2 = [lfilter(b, a, y[:i + 1])[i] for i in range(len(y))]
|
||||
# y3 = filtfilt(b, a, y[:16]).tolist() + [filtfilt(b, a, y[:i + 1])[i]
|
||||
# for i in range(16, len(y))]
|
||||
# y0 = medfilt(y, 41)
|
||||
_zi = lfilter_zi(b, a)
|
||||
# y2 = lfilter(b, a, y)#, zi=y[0]*zi) # standard filter
|
||||
y3 = filtfilt(b, a, y) # filter with phase shift correction
|
||||
y4 = []
|
||||
y5 = []
|
||||
for _i, j in enumerate(y):
|
||||
tmp = np.ravel(filt(j, u=u))
|
||||
tmp = np.ravel(filt2(tmp[0], u=u))
|
||||
# if i==0:
|
||||
# print(filt.x)
|
||||
# print(filt2.x)
|
||||
y4.append(tmp[0])
|
||||
y5.append(tmp[1])
|
||||
_y0 = medfilt(y4, 41)
|
||||
# print(filt.P)
|
||||
# plot
|
||||
|
||||
plt.plot(t, y, 'r.-', linewidth=2, label='raw data')
|
||||
# plt.plot(t, y2, 'b.-', linewidth=2, label='lowess @ %g Hz' % freq_filt)
|
||||
# plt.plot(t, y2, 'b.-', linewidth=2, label='filter @ %g Hz' % freq_filt)
|
||||
plt.plot(t, y3, 'g.-', linewidth=2, label='filtfilt @ %g Hz' % freq_filt)
|
||||
plt.plot(t, y4, 'k.-', linewidth=2, label='kalman')
|
||||
# plt.plot(t, y5, 'k.', linewidth=2, label='kalman2')
|
||||
plt.plot(t, tide, 'y-', linewidth=2, label='True tide')
|
||||
plt.legend(frameon=False, fontsize=14)
|
||||
plt.xlabel("Time [s]")
|
||||
plt.ylabel("Amplitude")
|
||||
|
||||
|
||||
def demo_savitzky_on_exponential():
|
||||
"""
|
||||
Example
|
||||
-------
|
||||
>>> demo_savitzky_on_exponential()
|
||||
|
||||
>>> plt.close()
|
||||
"""
|
||||
t = np.linspace(-4, 4, 500)
|
||||
y = np.exp(-t ** 2) + np.random.normal(0, 0.05, np.shape(t))
|
||||
n = 11
|
||||
ysg = SavitzkyGolay(n, degree=1, diff_order=0)(y)
|
||||
plt.plot(t, y, t, ysg, '--')
|
||||
|
||||
|
||||
def demo_smoothn_on_1d_cos():
|
||||
"""
|
||||
Example
|
||||
-------
|
||||
>>> demo_smoothn_on_1d_cos()
|
||||
|
||||
>>> plt.close()
|
||||
"""
|
||||
x = np.linspace(0, 100, 2 ** 8)
|
||||
y = np.cos(x / 10) + (x / 50) ** 2 + np.random.randn(np.size(x)) / 10
|
||||
y[np.r_[70, 75, 80]] = np.array([5.5, 5, 6])
|
||||
z = smoothn(y) # Regular smoothing
|
||||
zr = smoothn(y, robust=True) # Robust smoothing
|
||||
_h0 = plt.subplot(121),
|
||||
_h = plt.plot(x, y, 'r.', x, z, 'k', linewidth=2)
|
||||
plt.title('Regular smoothing')
|
||||
plt.subplot(122)
|
||||
plt.plot(x, y, 'r.', x, zr, 'k', linewidth=2)
|
||||
plt.title('Robust smoothing')
|
||||
|
||||
|
||||
def demo_smoothn_on_2d_exp_sin():
|
||||
"""
|
||||
Example
|
||||
-------
|
||||
>>> demo_smoothn_on_2d_exp_sin()
|
||||
|
||||
>>> plt.close()
|
||||
"""
|
||||
xp = np.arange(0, 1, 0.02) # np.r_[0:1:0.02]
|
||||
[x, y] = np.meshgrid(xp, xp)
|
||||
f = np.exp(x + y) + np.sin((x - 2 * y) * 3)
|
||||
fn = f + np.random.randn(*f.shape) * 0.5
|
||||
_fs, s = smoothn(fn, fulloutput=True)
|
||||
fs2 = smoothn(fn, s=2 * s)
|
||||
_h = plt.subplot(131),
|
||||
_h = plt.contourf(xp, xp, fn)
|
||||
_h = plt.subplot(132),
|
||||
_h = plt.contourf(xp, xp, fs2)
|
||||
_h = plt.subplot(133),
|
||||
_h = plt.contourf(xp, xp, f)
|
||||
|
||||
|
||||
def _cardioid(n=1000):
|
||||
t = np.linspace(0, 2 * np.pi, n)
|
||||
x0 = 2 * np.cos(t) * (1 - np.cos(t))
|
||||
y0 = 2 * np.sin(t) * (1 - np.cos(t))
|
||||
x = x0 + np.random.randn(x0.size) * 0.1
|
||||
y = y0 + np.random.randn(y0.size) * 0.1
|
||||
return x, y, x0, y0
|
||||
|
||||
|
||||
def demo_smoothn_on_cardioid():
|
||||
"""
|
||||
Example
|
||||
-------
|
||||
>>> demo_smoothn_on_cardioid()
|
||||
|
||||
>>> plt.close()
|
||||
"""
|
||||
x, y, x0, y0 = _cardioid()
|
||||
z = smoothn(x + 1j * y, robust=False)
|
||||
plt.plot(x0, y0, 'y',
|
||||
x, y, 'r.',
|
||||
np.real(z), np.imag(z), 'k', linewidth=2)
|
||||
|
||||
|
||||
def demo_hodrick_on_cardioid():
|
||||
"""
|
||||
Example
|
||||
-------
|
||||
>>> demo_hodrick_on_cardioid()
|
||||
|
||||
>>> plt.close()
|
||||
"""
|
||||
x, y, x0, y0 = _cardioid()
|
||||
|
||||
smooth = HodrickPrescott(w=20000)
|
||||
# smooth = HampelFilter(adaptive=50)
|
||||
xs, ys = smooth(x), smooth(y)
|
||||
plt.plot(x0, y0, 'y',
|
||||
x, y, 'r.',
|
||||
xs, ys, 'k', linewidth=2)
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
from wafo.testing import test_docstrings
|
||||
test_docstrings(__file__)
|
||||
# demo_savitzky_on_noisy_chirp()
|
||||
# plt.show('hold') # show plot
|
||||
# demo_kalman_sine()
|
||||
# demo_tide_filter()
|
||||
# demo_hampel()
|
||||
# demo_kalman_voltimeter()
|
||||
# demo_savitzky_on_exponential()
|
||||
# plt.figure(1)
|
||||
# demo_hodrick_on_cardioid()
|
||||
# plt.figure(2)
|
||||
# # demo_smoothn_on_1d_cos()
|
||||
# demo_smoothn_on_cardioid()
|
||||
# plt.show('hold')
|
||||
@ -1,11 +0,0 @@
|
||||
#!/usr/bin/env python
|
||||
# -*- coding: utf-8 -*-
|
||||
"""
|
||||
Dummy conftest.py for wafo.
|
||||
|
||||
If you don't know what this is for, just leave it empty.
|
||||
Read more about conftest.py under:
|
||||
https://pytest.org/latest/plugins.html
|
||||
"""
|
||||
from __future__ import print_function, absolute_import, division
|
||||
import pytest # @UnusedImport
|
||||
File diff suppressed because one or more lines are too long
@ -1,25 +0,0 @@
|
||||
"""
|
||||
f2py c_library.pyf c_functions.c -c
|
||||
|
||||
See also http://www.scipy.org/Cookbook/CompilingExtensionsOnWindowsWithMinGW
|
||||
"""
|
||||
import os
|
||||
import sys
|
||||
from wafo.f2py_tools import f2py_call_str
|
||||
|
||||
def compile_all():
|
||||
f2py_call = f2py_call_str()
|
||||
print '=' * 75
|
||||
print 'compiling c_codes'
|
||||
print '=' * 75
|
||||
|
||||
compile_format = f2py_call + ' %s %s -c'
|
||||
|
||||
pyfs = ('c_library.pyf',)
|
||||
files = ('c_functions.c',)
|
||||
|
||||
for pyf, file_ in zip(pyfs, files):
|
||||
os.system(compile_format % (pyf, file_))
|
||||
|
||||
if __name__ == '__main__':
|
||||
compile_all()
|
||||
@ -1,779 +0,0 @@
|
||||
#include "math.h"
|
||||
/*
|
||||
* Install gfortran and run the following to build the module on windows:
|
||||
* f2py c_library.pyf c_functions.c -c --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71
|
||||
*/
|
||||
|
||||
/*
|
||||
* findrfc.c -
|
||||
*
|
||||
* Returns indices to RFC turningpoints of a vector
|
||||
* of turningpoints
|
||||
*
|
||||
* 1998 by Per Andreas Brodtkorb.
|
||||
*/
|
||||
|
||||
void findrfc(double *y1,double hmin, int *ind, int n,int *info) {
|
||||
double xminus, xplus, Tpl, Tmi, *y, Tstart;
|
||||
int i, j, ix=0, NC, iy;
|
||||
info[0] = 0;
|
||||
if (*(y1+0)> *(y1+1)){
|
||||
/* if first is a max , ignore the first max*/
|
||||
y=&(*(y1+1));
|
||||
NC=floor((n-1)/2);
|
||||
Tstart=1;
|
||||
}
|
||||
else {
|
||||
y=y1;
|
||||
NC=floor(n/2);
|
||||
Tstart=0;
|
||||
}
|
||||
|
||||
if (NC<1){
|
||||
return; /* No RFC cycles*/
|
||||
}
|
||||
|
||||
|
||||
if (( *(y+0) > *(y+1)) && ( *(y+1) > *(y+2)) ){
|
||||
info[0] = -1;
|
||||
return; /*This is not a sequence of turningpoints, exit */
|
||||
}
|
||||
if ((*(y+0) < *(y+1)) && (*(y+1)< *(y+2))){
|
||||
info[0]=-1;
|
||||
return; /*This is not a sequence of turningpoints, exit */
|
||||
}
|
||||
|
||||
|
||||
for (i=0; i<NC; i++) {
|
||||
|
||||
Tmi=Tstart+2*i;
|
||||
Tpl=Tstart+2*i+2;
|
||||
xminus=*(y+2*i);
|
||||
xplus=*(y+2*i+2);
|
||||
|
||||
if(i!=0){
|
||||
j=i-1;
|
||||
while((j>=0) && (*(y+2*j+1)<=*(y+2*i+1))){
|
||||
if( (*(y+2*j)<xminus) ){
|
||||
xminus=*(y+2*j);
|
||||
Tmi=Tstart+2*j;
|
||||
} /*if */
|
||||
j--;
|
||||
} /*while j*/
|
||||
} /*if i */
|
||||
if ( xminus >= xplus){
|
||||
if ( (*(y+2*i+1)-xminus) >= hmin){
|
||||
*(ind+ix)=Tmi;
|
||||
ix++;
|
||||
*(ind+ix)=(Tstart+2*i+1);
|
||||
ix++;
|
||||
} /*if*/
|
||||
goto L180;
|
||||
}
|
||||
|
||||
j=i+1;
|
||||
while((j<NC) ) {
|
||||
if (*(y+2*j+1) >= *(y+2*i+1)) goto L170;
|
||||
if( (*(y+2*j+2) <= xplus) ){
|
||||
xplus=*(y+2*j+2);
|
||||
Tpl=(Tstart+2*j+2);
|
||||
}/*if*/
|
||||
j++;
|
||||
} /*while*/
|
||||
|
||||
|
||||
if ( (*(y+2*i+1)-xminus) >= hmin) {
|
||||
*(ind+ix)=Tmi;
|
||||
ix++;
|
||||
*(ind+ix)=(Tstart+2*i+1);
|
||||
ix++;
|
||||
|
||||
} /*if*/
|
||||
goto L180;
|
||||
L170:
|
||||
if (xplus <= xminus ) {
|
||||
if ( (*(y+2*i+1)-xminus) >= hmin){
|
||||
*(ind+ix)=Tmi;
|
||||
ix++;
|
||||
*(ind+ix)=(Tstart+2*i+1);
|
||||
ix++;
|
||||
} /*if*/
|
||||
/*goto L180;*/
|
||||
}
|
||||
else{
|
||||
if ( (*(y+2*i+1)-xplus) >= hmin) {
|
||||
*(ind+ix)=(Tstart+2*i+1);
|
||||
ix++;
|
||||
*(ind+ix)=Tpl;
|
||||
ix++;
|
||||
} /*if*/
|
||||
} /*elseif*/
|
||||
L180:
|
||||
iy=i;
|
||||
} /* for i */
|
||||
info[0] = ix;
|
||||
return ;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
* findcross.c -
|
||||
*
|
||||
* Returns indices to level v crossings of argument vector
|
||||
*
|
||||
* 1998 by Per Andreas Brodtkorb. last modified 23.06-98
|
||||
*/
|
||||
|
||||
|
||||
void findcross(double *y, double v, int *ind, int n, int *info)
|
||||
{ int i,start, ix=0,dcross=0;
|
||||
start=0;
|
||||
if ( y[0]< v){
|
||||
dcross=-1; /* first is a up-crossing*/
|
||||
}
|
||||
else if ( y[0]> v){
|
||||
dcross=1; /* first is a down-crossing*/
|
||||
}
|
||||
else if ( y[0]== v){
|
||||
/* Find out what type of crossing we have next time.. */
|
||||
for (i=1; i<n; i++) {
|
||||
start=i;
|
||||
if ( y[i]< v){
|
||||
ind[ix] = i-1; /* first crossing is a down crossing*/
|
||||
ix++;
|
||||
dcross=-1; /* The next crossing is a up-crossing*/
|
||||
goto L120;
|
||||
}
|
||||
else if ( y[i]> v){
|
||||
ind[ix] = i-1; /* first crossing is a up-crossing*/
|
||||
ix++;
|
||||
dcross=1; /*The next crossing is a down-crossing*/
|
||||
goto L120;
|
||||
}
|
||||
}
|
||||
}
|
||||
L120:
|
||||
for (i=start; i<n-1; i++) {
|
||||
if (( (dcross==-1) && (y[i]<=v) && (y[i+1] > v) ) || ((dcross==1 ) && (y[i]>=v) && (y[i+1] < v) ) ) {
|
||||
|
||||
ind[ix] = i;
|
||||
ix++;
|
||||
dcross=-dcross;
|
||||
}
|
||||
}
|
||||
info[0] = ix;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* DISUFQ Is an internal function to spec2nlsdat
|
||||
*
|
||||
* CALL: disufq(rvec,ivec,rA,iA, w,kw,h,g,nmin,nmax,m,n)
|
||||
*
|
||||
* rvec, ivec = real and imaginary parts of the resultant (size m X n).
|
||||
* rA, iA = real and imaginary parts of the amplitudes (size m X n).
|
||||
* w = vector with angular frequencies (w>=0)
|
||||
* kw = vector with wavenumbers (kw>=0)
|
||||
* h = water depth (h >=0)
|
||||
* g = constant acceleration of gravity
|
||||
* nmin = minimum index where rA(:,nmin) and iA(:,nmin) is
|
||||
* greater than zero.
|
||||
* nmax = maximum index where rA(:,nmax) and iA(:,nmax) is
|
||||
* greater than zero.
|
||||
* m = size(rA,1),size(iA,1)
|
||||
* n = size(rA,2),size(iA,2), or size(rvec,2),size(ivec,2)
|
||||
*
|
||||
* DISUFQ returns the summation of difference frequency and sum
|
||||
* frequency effects in the vector vec = rvec +sqrt(-1)*ivec.
|
||||
* The 2'nd order contribution to the Stokes wave is then calculated by
|
||||
* a simple 1D Fourier transform, real(FFT(vec)).
|
||||
*
|
||||
* Install gfortran and run the following to build the module:
|
||||
* f2py diffsumfunq.pyf disufq1.c -c --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71
|
||||
*
|
||||
* by Per Andreas Brodtkorb 15.08.2001
|
||||
* revised pab 14.03.2002, 01.05.2002 22.07.2002, oct 2008
|
||||
*/
|
||||
|
||||
void disufq(double *rvec, double *ivec,
|
||||
double *rA, double *iA,
|
||||
double *w, double *kw,
|
||||
double h, double g,
|
||||
int nmin, int nmax,
|
||||
int m, int n)
|
||||
{
|
||||
double Epij, Edij;
|
||||
double tmp1, tmp2, tmp3, tmp4, kfact;
|
||||
double w1, w2, kw1, kw2, Cg;
|
||||
double rrA, iiA, riA, irA;
|
||||
int i,jy,ix,iz1,iv1,ixi,jyi;
|
||||
//int iz2, iv2;
|
||||
//Initialize rvec and ivec to zero
|
||||
for (ix=0;ix<n*m;ix++) {
|
||||
rvec[ix] = 0.0;
|
||||
ivec[ix] = 0.0;
|
||||
}
|
||||
|
||||
// kfact is set to 2 in order to exploit the symmetry.
|
||||
// If you set kfact to 1, you must uncomment all statements
|
||||
// including the expressions: rvec[iz2], rvec[iv2], ivec[iz2] and ivec[iv2].
|
||||
|
||||
kfact = 2.0;
|
||||
if (h>10000){ /* deep water /Inifinite water depth */
|
||||
for (ix = nmin-1;ix<nmax;ix++) {
|
||||
ixi = ix*m;
|
||||
iz1 = 2*ixi;
|
||||
//iz2 = n*m-ixi;
|
||||
kw1 = kw[ix];
|
||||
Epij = kw1;
|
||||
for (i=0;i<m;i++,ixi++,iz1++) {
|
||||
rrA = rA[ixi]*rA[ixi]; ///
|
||||
iiA = iA[ixi]*iA[ixi]; ///
|
||||
riA = rA[ixi]*iA[ixi]; ///
|
||||
|
||||
/// Sum frequency effects along the diagonal
|
||||
tmp1 = kfact*(rrA-iiA)*Epij;
|
||||
tmp2 = kfact*2.0*riA*Epij;
|
||||
rvec[iz1] += tmp1;
|
||||
ivec[iz1] += tmp2;
|
||||
|
||||
//rvec[iz2] += tmp1;
|
||||
//ivec[iz2] -= tmp2;
|
||||
//iz2++;
|
||||
|
||||
/// Difference frequency effects are zero along the diagonal
|
||||
/// and are thus not contributing to the mean.
|
||||
}
|
||||
for (jy = ix+1;jy<nmax;jy++){
|
||||
kw2 = kw[jy];
|
||||
Epij = 0.5*(kw2 + kw1);
|
||||
Edij = -0.5*(kw2 - kw1);
|
||||
//printf("Edij = %f Epij = %f \n", Edij,Epij);
|
||||
|
||||
ixi = ix*m;
|
||||
jyi = jy*m;
|
||||
iz1 = ixi+jyi;
|
||||
iv1 = jyi-ixi;
|
||||
//iz2 = (n*m-iz1);
|
||||
//iv2 = (n*m-iv1);
|
||||
for (i = 0;i<m;i++,ixi++,jyi++,iz1++,iv1++) {
|
||||
|
||||
rrA = rA[ixi]*rA[jyi]; ///rrA = rA[i][ix]*rA[i][jy];
|
||||
iiA = iA[ixi]*iA[jyi]; ///iiA = iA[i][ix]*iA[i][jy];
|
||||
riA = rA[ixi]*iA[jyi]; ///riA = rA[i][ix]*iA[i][jy];
|
||||
irA = iA[ixi]*rA[jyi]; ///irA = iA[i][ix]*rA[i][jy];
|
||||
|
||||
/* Sum frequency effects */
|
||||
tmp1 = kfact*2.0*(rrA-iiA)*Epij;
|
||||
tmp2 = kfact*2.0*(riA+irA)*Epij;
|
||||
rvec[iz1] += tmp1;///rvec[i][ix+jy] += tmp1;
|
||||
ivec[iz1] += tmp2;///ivec[i][ix+jy] += tmp2;
|
||||
//rvec[iz2] += tmp1;///rvec[i][n*m-(ix+jy)] += tmp1;
|
||||
//ivec[iz2] -= tmp2;///ivec[i][n*m-(ix+jy)] -= tmp2;
|
||||
// iz2++;
|
||||
|
||||
/* Difference frequency effects */
|
||||
tmp1 = kfact*2.0*(rrA+iiA)*Edij;
|
||||
tmp2 = kfact*2.0*(riA-irA)*Edij;
|
||||
|
||||
rvec[iv1] += tmp1;///rvec[i][jy-ix] += tmp1;
|
||||
ivec[iv1] += tmp2;///ivec[i][jy-ix] += tmp2;
|
||||
|
||||
//rvec[iv2] += tmp1;///rvec[i][n*m-(jy-ix)] += tmp1;
|
||||
//ivec[iv2] -= tmp2;///ivec[i][n*m-(jy-ix)] -= tmp2;
|
||||
//iv2++;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else{ /* Finite water depth */
|
||||
for (ix = nmin-1;ix<nmax;ix++) {
|
||||
kw1 = kw[ix];
|
||||
w1 = w[ix];
|
||||
tmp1 = tanh(kw1*h);
|
||||
/// Cg, wave group velocity
|
||||
Cg = 0.5*g*(tmp1 + kw1*h*(1.0- tmp1*tmp1))/w1; /// OK
|
||||
tmp1 = 0.5*g*(kw1/w1)*(kw1/w1);
|
||||
tmp2 = 0.5*w1*w1/g;
|
||||
tmp3 = g*kw1/(w1*Cg);
|
||||
|
||||
if (kw1*h<300.0){
|
||||
tmp4 = kw1/sinh(2.0*kw1*h);
|
||||
}
|
||||
else{ // To ensure sinh does not overflow.
|
||||
tmp4 = 0.0;
|
||||
}
|
||||
// Difference frequency effects finite water depth
|
||||
Edij = (tmp1-tmp2+tmp3)/(1.0-g*h/(Cg*Cg))-tmp4; /// OK
|
||||
|
||||
// Sum frequency effects finite water depth
|
||||
Epij = (3.0*(tmp1-tmp2)/(1.0-tmp1/kw1*tanh(2.0*kw1*h))+3.0*tmp2-tmp1); /// OK
|
||||
//printf("Edij = %f Epij = %f \n", Edij,Epij);
|
||||
|
||||
ixi = ix*m;
|
||||
iz1 = 2*ixi;
|
||||
//iz2 = n*m-ixi;
|
||||
for (i=0;i<m;i++,ixi++,iz1++) {
|
||||
|
||||
rrA = rA[ixi]*rA[ixi]; ///
|
||||
iiA = iA[ixi]*iA[ixi]; ///
|
||||
riA = rA[ixi]*iA[ixi]; ///
|
||||
|
||||
|
||||
/// Sum frequency effects along the diagonal
|
||||
rvec[iz1] += kfact*(rrA-iiA)*Epij;
|
||||
ivec[iz1] += kfact*2.0*riA*Epij;
|
||||
//rvec[iz2] += kfact*(rrA-iiA)*Epij;
|
||||
//ivec[iz2] -= kfact*2.0*riA*Epij;
|
||||
//iz2++;
|
||||
|
||||
/// Difference frequency effects along the diagonal
|
||||
/// are only contributing to the mean
|
||||
rvec[i] += 2.0*(rrA+iiA)*Edij;
|
||||
}
|
||||
for (jy = ix+1;jy<nmax;jy++) {
|
||||
// w1 = w[ix];
|
||||
// kw1 = kw[ix];
|
||||
w2 = w[jy];
|
||||
kw2 = kw[jy];
|
||||
tmp1 = g*(kw1/w1)*(kw2/w2);
|
||||
tmp2 = 0.5/g*(w1*w1+w2*w2+w1*w2);
|
||||
tmp3 = 0.5*g*(w1*kw2*kw2+w2*kw1*kw1)/(w1*w2*(w1+w2));
|
||||
tmp4 = (1-g*(kw1+kw2)/(w1+w2)/(w1+w2)*tanh((kw1+kw2)*h));
|
||||
Epij = (tmp1-tmp2+tmp3)/tmp4+tmp2-0.5*tmp1; /* OK */
|
||||
|
||||
tmp2 = 0.5/g*(w1*w1+w2*w2-w1*w2); /*OK*/
|
||||
tmp3 = -0.5*g*(w1*kw2*kw2-w2*kw1*kw1)/(w1*w2*(w1-w2));
|
||||
tmp4 = (1.0-g*(kw1-kw2)/(w1-w2)/(w1-w2)*tanh((kw1-kw2)*h));
|
||||
Edij = (tmp1-tmp2+tmp3)/tmp4+tmp2-0.5*tmp1; /* OK */
|
||||
//printf("Edij = %f Epij = %f \n", Edij,Epij);
|
||||
|
||||
ixi = ix*m;
|
||||
jyi = jy*m;
|
||||
iz1 = ixi+jyi;
|
||||
iv1 = jyi-ixi;
|
||||
// iz2 = (n*m-iz1);
|
||||
// iv2 = n*m-iv1;
|
||||
for (i=0;i<m;i++,ixi++,jyi++,iz1++,iv1++) {
|
||||
rrA = rA[ixi]*rA[jyi]; ///rrA = rA[i][ix]*rA[i][jy];
|
||||
iiA = iA[ixi]*iA[jyi]; ///iiA = iA[i][ix]*iA[i][jy];
|
||||
riA = rA[ixi]*iA[jyi]; ///riA = rA[i][ix]*iA[i][jy];
|
||||
irA = iA[ixi]*rA[jyi]; ///irA = iA[i][ix]*rA[i][jy];
|
||||
|
||||
/* Sum frequency effects */
|
||||
tmp1 = kfact*2.0*(rrA-iiA)*Epij;
|
||||
tmp2 = kfact*2.0*(riA+irA)*Epij;
|
||||
rvec[iz1] += tmp1;///rvec[i][jy+ix] += tmp1;
|
||||
ivec[iz1] += tmp2;///ivec[i][jy+ix] += tmp2;
|
||||
//rvec[iz2] += tmp1;///rvec[i][n*m-(jy+ix)] += tmp1;
|
||||
//ivec[iz2] -= tmp2;///ivec[i][n*m-(jy+ix)] -= tmp2;
|
||||
//iz2++;
|
||||
|
||||
/* Difference frequency effects */
|
||||
tmp1 = kfact*2.0*(rrA+iiA)*Edij;
|
||||
tmp2 = kfact*2.0*(riA-irA)*Edij;
|
||||
rvec[iv1] += tmp1;///rvec[i][jy-ix] += tmp1;
|
||||
ivec[iv1] += tmp2;///ivec[i][jy-ix] -= tmp2;
|
||||
|
||||
//rvec[iv2] += tmp1;
|
||||
//ivec[iv2] -= tmp2;
|
||||
//iv2++;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
//return i;
|
||||
}
|
||||
/*
|
||||
* DISUFQ2 Is an internal function to spec2nlsdat
|
||||
*
|
||||
* CALL: disufq2(rsvec,isvec,rdvec,idvec,rA,iA, w,kw,h,g,nmin,nmax,m,n)
|
||||
*
|
||||
* rsvec, isvec = real and imaginary parts of the sum frequency
|
||||
* effects (size m X n).
|
||||
* rdvec, idvec = real and imaginary parts of the difference frequency
|
||||
* effects (size m X n).
|
||||
* rA, iA = real and imaginary parts of the amplitudes (size m X n).
|
||||
* w = vector with angular frequencies (w>=0)
|
||||
* kw = vector with wavenumbers (kw>=0)
|
||||
* h = water depth (h >=0)
|
||||
* g = constant acceleration of gravity
|
||||
* nmin = minimum index where rA(:,nmin) and iA(:,nmin) is
|
||||
* greater than zero.
|
||||
* nmax = maximum index where rA(:,nmax) and iA(:,nmax) is
|
||||
* greater than zero.
|
||||
* m = size(rA,1),size(iA,1)
|
||||
* n = size(rA,2),size(iA,2), or size(rvec,2),size(ivec,2)
|
||||
*
|
||||
* DISUFQ2 returns the summation of sum and difference frequency
|
||||
* frequency effects in the vectors svec = rsvec +sqrt(-1)*isvec and
|
||||
* dvec = rdvec +sqrt(-1)*idvec.
|
||||
* The 2'nd order contribution to the Stokes wave is then calculated by
|
||||
* a simple 1D Fourier transform, real(FFT(svec+dvec)).
|
||||
*
|
||||
*
|
||||
* This is a MEX-file for MATLAB.
|
||||
* by Per Andreas Brodtkorb 15.08.2001
|
||||
* revised pab 14.03.2002, 01.05.2002
|
||||
*/
|
||||
|
||||
void disufq2(double *rsvec, double *isvec,
|
||||
double *rdvec, double *idvec,
|
||||
double *rA, double *iA,
|
||||
double *w, double *kw,
|
||||
double h, double g,
|
||||
int nmin, int nmax,
|
||||
int m, int n)
|
||||
{
|
||||
double Epij, Edij;
|
||||
double tmp1, tmp2, tmp3, tmp4, kfact;
|
||||
double w1, w2, kw1, kw2, Cg;
|
||||
double rrA, iiA, riA, irA;
|
||||
int i,jy,ix,iz1,iv1,ixi,jyi;
|
||||
//int iz2,iv2
|
||||
|
||||
//Initialize rvec and ivec to zero
|
||||
for (ix=0;ix<n*m;ix++) {
|
||||
rsvec[ix] = 0.0;
|
||||
isvec[ix] = 0.0;
|
||||
rdvec[ix] = 0.0;
|
||||
idvec[ix] = 0.0;
|
||||
}
|
||||
|
||||
// kfact is set to 2 in order to exploit the symmetry.
|
||||
// If you set kfact to 1, you must uncomment all statements
|
||||
// including the expressions: rvec[iz2], rvec[iv2], ivec[iz2] and ivec[iv2].
|
||||
|
||||
kfact = 2.0;
|
||||
if (h>10000){ /* deep water /Inifinite water depth */
|
||||
for (ix = nmin-1;ix<nmax;ix++) {
|
||||
ixi = ix*m;
|
||||
iz1 = 2*ixi;
|
||||
//iz2 = n*m-ixi;
|
||||
kw1 = kw[ix];
|
||||
Epij = kw1;
|
||||
for (i=0;i<m;i++,ixi++,iz1++) {
|
||||
rrA = rA[ixi]*rA[ixi]; ///
|
||||
iiA = iA[ixi]*iA[ixi]; ///
|
||||
riA = rA[ixi]*iA[ixi]; ///
|
||||
|
||||
/// Sum frequency effects along the diagonal
|
||||
tmp1 = kfact*(rrA-iiA)*Epij;
|
||||
tmp2 = kfact*2.0*riA*Epij;
|
||||
rsvec[iz1] += tmp1;
|
||||
isvec[iz1] += tmp2;
|
||||
|
||||
//rsvec[iz2] += tmp1;
|
||||
//isvec[iz2] -= tmp2;
|
||||
//iz2++;
|
||||
|
||||
/// Difference frequency effects are zero along the diagonal
|
||||
/// and are thus not contributing to the mean.
|
||||
}
|
||||
for (jy = ix+1;jy<nmax;jy++){
|
||||
kw2 = kw[jy];
|
||||
Epij = 0.5*(kw2 + kw1);
|
||||
Edij = -0.5*(kw2 - kw1);
|
||||
//printf("Edij = %f Epij = %f \n", Edij,Epij);
|
||||
|
||||
ixi = ix*m;
|
||||
jyi = jy*m;
|
||||
iz1 = ixi+jyi;
|
||||
iv1 = jyi-ixi;
|
||||
//iz2 = (n*m-iz1);
|
||||
//iv2 = (n*m-iv1);
|
||||
for (i = 0;i<m;i++,ixi++,jyi++,iz1++,iv1++) {
|
||||
|
||||
rrA = rA[ixi]*rA[jyi]; ///rrA = rA[i][ix]*rA[i][jy];
|
||||
iiA = iA[ixi]*iA[jyi]; ///iiA = iA[i][ix]*iA[i][jy];
|
||||
riA = rA[ixi]*iA[jyi]; ///riA = rA[i][ix]*iA[i][jy];
|
||||
irA = iA[ixi]*rA[jyi]; ///irA = iA[i][ix]*rA[i][jy];
|
||||
|
||||
/* Sum frequency effects */
|
||||
tmp1 = kfact*2.0*(rrA-iiA)*Epij;
|
||||
tmp2 = kfact*2.0*(riA+irA)*Epij;
|
||||
rsvec[iz1] += tmp1; ///rvec[i][ix+jy] += tmp1;
|
||||
isvec[iz1] += tmp2; ///ivec[i][ix+jy] += tmp2;
|
||||
//rsvec[iz2] += tmp1;///rvec[i][n*m-(ix+jy)] += tmp1;
|
||||
//isvec[iz2] -= tmp2;///ivec[i][n*m-(ix+jy)] += tmp2;
|
||||
//iz2++;
|
||||
|
||||
/* Difference frequency effects */
|
||||
tmp1 = kfact*2.0*(rrA+iiA)*Edij;
|
||||
tmp2 = kfact*2.0*(riA-irA)*Edij;
|
||||
|
||||
rdvec[iv1] += tmp1;///rvec[i][jy-ix] += tmp1;
|
||||
idvec[iv1] += tmp2;///ivec[i][jy-ix] += tmp2;
|
||||
|
||||
//rdvec[iv2] += tmp1;///rvec[i][n*m-(jy-ix)] += tmp1;
|
||||
//idvec[iv2] -= tmp2;///ivec[i][n*m-(jy-ix)] -= tmp2;
|
||||
// iv2++;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else{ /* Finite water depth */
|
||||
for (ix = nmin-1;ix<nmax;ix++) {
|
||||
kw1 = kw[ix];
|
||||
w1 = w[ix];
|
||||
tmp1 = tanh(kw1*h);
|
||||
/// Cg, wave group velocity
|
||||
Cg = 0.5*g*(tmp1 + kw1*h*(1.0- tmp1*tmp1))/w1; /// OK
|
||||
tmp1 = 0.5*g*(kw1/w1)*(kw1/w1);
|
||||
tmp2 = 0.5*w1*w1/g;
|
||||
tmp3 = g*kw1/(w1*Cg);
|
||||
|
||||
if (kw1*h<300.0){
|
||||
tmp4 = kw1/sinh(2.0*kw1*h);
|
||||
}
|
||||
else{ // To ensure sinh does not overflow.
|
||||
tmp4 = 0.0;
|
||||
}
|
||||
// Difference frequency effects finite water depth
|
||||
Edij = (tmp1-tmp2+tmp3)/(1.0-g*h/(Cg*Cg))-tmp4; /// OK
|
||||
|
||||
// Sum frequency effects finite water depth
|
||||
Epij = (3.0*(tmp1-tmp2)/(1.0-tmp1/kw1*tanh(2.0*kw1*h))+3.0*tmp2-tmp1); /// OK
|
||||
//printf("Edij = %f Epij = %f \n", Edij,Epij);
|
||||
|
||||
ixi = ix*m;
|
||||
iz1 = 2*ixi;
|
||||
//iz2 = n*m-ixi;
|
||||
for (i=0;i<m;i++,ixi++,iz1++) {
|
||||
|
||||
rrA = rA[ixi]*rA[ixi]; ///
|
||||
iiA = iA[ixi]*iA[ixi]; ///
|
||||
riA = rA[ixi]*iA[ixi]; ///
|
||||
|
||||
|
||||
/// Sum frequency effects along the diagonal
|
||||
rsvec[iz1] += kfact*(rrA-iiA)*Epij;
|
||||
isvec[iz1] += kfact*2.0*riA*Epij;
|
||||
//rsvec[iz2] += kfact*(rrA-iiA)*Epij;
|
||||
//isvec[iz2] -= kfact*2.0*riA*Epij;
|
||||
|
||||
/// Difference frequency effects along the diagonal
|
||||
/// are only contributing to the mean
|
||||
//printf(" %f \n",2.0*(rrA+iiA)*Edij);
|
||||
rdvec[i] += 2.0*(rrA+iiA)*Edij;
|
||||
}
|
||||
for (jy = ix+1;jy<nmax;jy++) {
|
||||
// w1 = w[ix];
|
||||
// kw1 = kw[ix];
|
||||
w2 = w[jy];
|
||||
kw2 = kw[jy];
|
||||
tmp1 = g*(kw1/w1)*(kw2/w2);
|
||||
tmp2 = 0.5/g*(w1*w1+w2*w2+w1*w2);
|
||||
tmp3 = 0.5*g*(w1*kw2*kw2+w2*kw1*kw1)/(w1*w2*(w1+w2));
|
||||
tmp4 = (1-g*(kw1+kw2)/(w1+w2)/(w1+w2)*tanh((kw1+kw2)*h));
|
||||
Epij = (tmp1-tmp2+tmp3)/tmp4+tmp2-0.5*tmp1; /* OK */
|
||||
|
||||
tmp2 = 0.5/g*(w1*w1+w2*w2-w1*w2); /*OK*/
|
||||
tmp3 = -0.5*g*(w1*kw2*kw2-w2*kw1*kw1)/(w1*w2*(w1-w2));
|
||||
tmp4 = (1.0-g*(kw1-kw2)/(w1-w2)/(w1-w2)*tanh((kw1-kw2)*h));
|
||||
Edij = (tmp1-tmp2+tmp3)/tmp4+tmp2-0.5*tmp1; /* OK */
|
||||
//printf("Edij = %f Epij = %f \n", Edij,Epij);
|
||||
|
||||
ixi = ix*m;
|
||||
jyi = jy*m;
|
||||
iz1 = ixi+jyi;
|
||||
iv1 = jyi-ixi;
|
||||
// iz2 = (n*m-iz1);
|
||||
// iv2 = (n*m-iv1);
|
||||
for (i=0;i<m;i++,ixi++,jyi++,iz1++,iv1++) {
|
||||
rrA = rA[ixi]*rA[jyi]; ///rrA = rA[i][ix]*rA[i][jy];
|
||||
iiA = iA[ixi]*iA[jyi]; ///iiA = iA[i][ix]*iA[i][jy];
|
||||
riA = rA[ixi]*iA[jyi]; ///riA = rA[i][ix]*iA[i][jy];
|
||||
irA = iA[ixi]*rA[jyi]; ///irA = iA[i][ix]*rA[i][jy];
|
||||
|
||||
/* Sum frequency effects */
|
||||
tmp1 = kfact*2.0*(rrA-iiA)*Epij;
|
||||
tmp2 = kfact*2.0*(riA+irA)*Epij;
|
||||
rsvec[iz1] += tmp1;///rsvec[i][jy+ix] += tmp1;
|
||||
isvec[iz1] += tmp2;///isvec[i][jy+ix] += tmp2;
|
||||
//rsvec[iz2] += tmp1;///rsvec[i][n*m-(jy+ix)] += tmp1;
|
||||
//isvec[iz2] -= tmp2;///isvec[i][n*m-(jy-ix)] += tmp2;
|
||||
//iz2++;
|
||||
|
||||
/* Difference frequency effects */
|
||||
tmp1 = kfact*2.0*(rrA+iiA)*Edij;
|
||||
tmp2 = kfact*2.0*(riA-irA)*Edij;
|
||||
rdvec[iv1] += tmp1;
|
||||
idvec[iv1] += tmp2;
|
||||
|
||||
//rdvec[iv2] += tmp1;
|
||||
//idvec[iv2] -= tmp2;
|
||||
// iv2++;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
// return i;
|
||||
}
|
||||
|
||||
|
||||
/* ++++++++++ BEGIN RF3 [ampl ampl_mean nr_of_cycle] */
|
||||
/* ++++++++++ Rain flow without time analysis */
|
||||
//By Adam Nieslony
|
||||
//Visit the MATLAB Central File Exchange for latest version
|
||||
//http://www.mathworks.com/matlabcentral/fileexchange/3026
|
||||
void findrfc3_astm(double *array_ext, double *array_out, int n, int *nout) {
|
||||
|
||||
double *pr, *po, a[16384], ampl, mean;
|
||||
int tot_num, index, j, cNr1, cNr2;
|
||||
|
||||
tot_num = n;
|
||||
|
||||
// pointers to the first element of the arrays
|
||||
pr = &array_ext[0];
|
||||
po = &array_out[0];
|
||||
|
||||
// The original rainflow counting by Nieslony, unchanged
|
||||
j = -1;
|
||||
cNr1 = 1;
|
||||
for (index=0; index<tot_num; index++) {
|
||||
a[++j]=*pr++;
|
||||
while ( (j >= 2) && (fabs(a[j-1]-a[j-2]) <= fabs(a[j]-a[j-1])) ) {
|
||||
ampl=fabs( (a[j-1]-a[j-2])/2 );
|
||||
switch(j) {
|
||||
case 0: { break; }
|
||||
case 1: { break; }
|
||||
case 2: {
|
||||
mean=(a[0]+a[1])/2;
|
||||
a[0]=a[1];
|
||||
a[1]=a[2];
|
||||
j=1;
|
||||
if (ampl > 0) {
|
||||
*po++=ampl;
|
||||
*po++=mean;
|
||||
*po++=0.50;
|
||||
}
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
mean=(a[j-1]+a[j-2])/2;
|
||||
a[j-2]=a[j];
|
||||
j=j-2;
|
||||
if (ampl > 0) {
|
||||
*po++=ampl;
|
||||
*po++=mean;
|
||||
*po++=1.00;
|
||||
cNr1++;
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
cNr2 = 1;
|
||||
for (index=0; index<j; index++) {
|
||||
ampl=fabs(a[index]-a[index+1])/2;
|
||||
mean=(a[index]+a[index+1])/2;
|
||||
if (ampl > 0){
|
||||
*po++=ampl;
|
||||
*po++=mean;
|
||||
*po++=0.50;
|
||||
cNr2++;
|
||||
}
|
||||
}
|
||||
// array of ints nout is outputted
|
||||
nout[0] = cNr1;
|
||||
nout[1] = cNr2;
|
||||
}
|
||||
/* ++++++++++ END RF3 */
|
||||
|
||||
|
||||
// ++ BEGIN RF5 [ampl ampl_mean nr_of_cycle cycle_begin_time cycle_period_time]
|
||||
/* ++++++++++ Rain flow with time analysis */
|
||||
//By Adam Nieslony
|
||||
//Visit the MATLAB Central File Exchange for latest version
|
||||
//http://www.mathworks.com/matlabcentral/fileexchange/3026
|
||||
void
|
||||
findrfc5_astm(double *array_ext, double *array_t, double *array_out, int n, int *nout) {
|
||||
double *pr, *pt, *po, a[16384], t[16384], ampl, mean, period, atime;
|
||||
int tot_num, index, j, cNr1, cNr2;
|
||||
|
||||
|
||||
// tot_num = mxGetM(array_ext) * mxGetN(array_ext);
|
||||
tot_num = n;
|
||||
|
||||
// pointers to the first element of the arrays
|
||||
pr = &array_ext[0];
|
||||
pt = &array_t[0];
|
||||
po = &array_out[0];
|
||||
|
||||
// array_out = mxCreateDoubleMatrix(5, tot_num-1, mxREAL);
|
||||
|
||||
// The original rainflow counting by Nieslony, unchanged
|
||||
j = -1;
|
||||
cNr1 = 1;
|
||||
for (index=0; index<tot_num; index++) {
|
||||
a[++j]=*pr++;
|
||||
t[j]=*pt++;
|
||||
while ( (j >= 2) && (fabs(a[j-1]-a[j-2]) <= fabs(a[j]-a[j-1])) ) {
|
||||
ampl=fabs( (a[j-1]-a[j-2])/2 );
|
||||
switch(j)
|
||||
{
|
||||
case 0: { break; }
|
||||
case 1: { break; }
|
||||
case 2: {
|
||||
mean=(a[0]+a[1])/2;
|
||||
period=(t[1]-t[0])*2;
|
||||
atime=t[0];
|
||||
a[0]=a[1];
|
||||
a[1]=a[2];
|
||||
t[0]=t[1];
|
||||
t[1]=t[2];
|
||||
j=1;
|
||||
if (ampl > 0) {
|
||||
*po++=ampl;
|
||||
*po++=mean;
|
||||
*po++=0.50;
|
||||
*po++=atime;
|
||||
*po++=period;
|
||||
}
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
mean=(a[j-1]+a[j-2])/2;
|
||||
period=(t[j-1]-t[j-2])*2;
|
||||
atime=t[j-2];
|
||||
a[j-2]=a[j];
|
||||
t[j-2]=t[j];
|
||||
j=j-2;
|
||||
if (ampl > 0) {
|
||||
*po++=ampl;
|
||||
*po++=mean;
|
||||
*po++=1.00;
|
||||
*po++=atime;
|
||||
*po++=period;
|
||||
cNr1++;
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
cNr2 = 1;
|
||||
for (index=0; index<j; index++) {
|
||||
ampl=fabs(a[index]-a[index+1])/2;
|
||||
mean=(a[index]+a[index+1])/2;
|
||||
period=(t[index+1]-t[index])*2;
|
||||
atime=t[index];
|
||||
if (ampl > 0){
|
||||
*po++=ampl;
|
||||
*po++=mean;
|
||||
*po++=0.50;
|
||||
*po++=atime;
|
||||
*po++=period;
|
||||
cNr2++;
|
||||
}
|
||||
}
|
||||
// /* free the memeory !!!*/
|
||||
// mxSetN(array_out, tot_num - cNr);
|
||||
nout[0] = cNr1;
|
||||
nout[1] = cNr2;
|
||||
}
|
||||
/* ++++++++++ END RF5 */
|
||||
@ -1,24 +0,0 @@
|
||||
Copyright (c) 2003, Adam Niesłony
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are
|
||||
met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
* Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in
|
||||
the documentation and/or other materials provided with the distribution
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
|
||||
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
@ -1,86 +0,0 @@
|
||||
! File c_code.pyf
|
||||
python module c_library
|
||||
interface
|
||||
subroutine findrfc(y1, hmin, ind, n, info)
|
||||
intent(c) findrfc ! findrfc is a C function
|
||||
intent(c) ! all findrfc arguments are considered as C based
|
||||
integer intent(hide), depend(y1) :: n=len(y1)
|
||||
double precision dimension(n), intent(in) :: y1 ! input array
|
||||
double precision intent(in) :: hmin
|
||||
integer dimension(n), intent(out) :: ind ! output array,
|
||||
integer dimension(1), intent(out) :: info
|
||||
end subroutine findrfc
|
||||
subroutine findcross(y, v, ind, n, info)
|
||||
intent(c) findcross ! findcross is a C function
|
||||
intent(c) ! all findcross arguments are considered as C based
|
||||
integer intent(hide), depend(y) :: n=len(y)
|
||||
double precision dimension(n), intent(in) :: y ! input array
|
||||
double precision intent(in) :: v
|
||||
integer dimension(n), intent(out) :: ind ! output array,
|
||||
integer dimension(1),intent(out) :: info
|
||||
end subroutine findcross
|
||||
subroutine disufq(rvec, ivec, rA, iA, w, kw, h, g,nmin,nmax, m, n)
|
||||
intent(c) disufq ! disufq is a C function
|
||||
intent(c) ! all disufq arguments are considered as C based
|
||||
!integer intent(hide), depend(rA),check(n*m==len(iA)) :: n=len(rA)/m
|
||||
!integer intent(hide), depend(rA), check(m==shape(iA,1)) :: m=shape(rA,1)
|
||||
double precision dimension(n*m), intent(in) :: rA, iA ! input array
|
||||
double precision dimension(n/2+1), intent(in) :: w, kw ! input array
|
||||
double precision intent(in) :: h, g
|
||||
integer intent(in) :: nmin, nmax
|
||||
double precision dimension(n*m), intent(out) :: rvec, ivec ! output array,
|
||||
end subroutine disufq
|
||||
subroutine disufq2(rsvec, isvec,rdvec, idvec, rA, iA, w, kw, h, g,nmin,nmax, m, n)
|
||||
intent(c) disufq2 ! disufq2 is a C function
|
||||
intent(c) ! all disufq2 arguments are considered as C based
|
||||
!integer intent(hide), depend(rA),check(n*m==len(iA)) :: n=len(rA)/m
|
||||
!integer intent(hide), depend(rA), check(m==shape(iA,1)) :: m=shape(rA,1)
|
||||
double precision dimension(n*m), intent(in) :: rA, iA ! input array
|
||||
double precision dimension(n/2+1), intent(in) :: w, kw ! input array
|
||||
double precision intent(in) :: h, g
|
||||
integer intent(in) :: nmin, nmax
|
||||
double precision dimension(n*m), intent(out) :: rsvec, isvec, rdvec, idvec ! output array,
|
||||
end subroutine disufq2
|
||||
|
||||
! ===== START NIESLONY RAINFLOW FUNCTIONS
|
||||
! RAINFLOW Revision: 1.1
|
||||
! by Adam Nieslony, 2009
|
||||
subroutine findrfc3_astm(array_ext, array_out, n, nout)
|
||||
intent(c) findrfc3_astm ! rf3 is a C function
|
||||
intent(c) ! all rf3 arguments are
|
||||
! considered as C based
|
||||
|
||||
! n is the length of the input array array_ext
|
||||
integer intent(hide), depend(array_ext) :: n=len(array_ext)
|
||||
|
||||
! of input array x
|
||||
double precision intent(in) :: array_ext(n)
|
||||
|
||||
! the output array
|
||||
double precision intent(out) :: array_out(n,3)
|
||||
|
||||
! nout array, to output additional ints
|
||||
integer dimension(2), intent(out) :: nout
|
||||
end subroutine findrfc3_astm
|
||||
|
||||
subroutine findrfc5_astm(array_ext, array_t, array_out, n, nout)
|
||||
intent(c) findrfc5_astm ! rf5 is a C function
|
||||
intent(c) ! all rf5 arguments are
|
||||
! considered as C based
|
||||
|
||||
! n is the length of the input array array_ext
|
||||
integer intent(hide), depend(array_ext) :: n=len(array_ext)
|
||||
|
||||
! of input array x
|
||||
double precision intent(in) :: array_ext(n), array_t(n)
|
||||
|
||||
! the output array
|
||||
double precision intent(out) :: array_out(n,5)
|
||||
|
||||
! nout array, to output additional ints
|
||||
integer dimension(2), intent(out) :: nout
|
||||
end subroutine findrfc5_astm
|
||||
! ===== END NIESLONY RAINFLOW FUNCTIONS
|
||||
|
||||
end interface
|
||||
end python module c_library
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,18 +0,0 @@
|
||||
'''
|
||||
python setup.py build_src build_ext --inplace
|
||||
|
||||
See also http://www.scipy.org/Cookbook/CompilingExtensionsOnWindowsWithMinGW
|
||||
'''
|
||||
# File setup.py
|
||||
|
||||
|
||||
def configuration(parent_package='', top_path=None):
|
||||
from numpy.distutils.misc_util import Configuration
|
||||
config = Configuration('', parent_package, top_path)
|
||||
|
||||
config.add_extension('c_library',
|
||||
sources=['c_library.pyf', 'c_functions.c'])
|
||||
return config
|
||||
if __name__ == "__main__":
|
||||
from numpy.distutils.core import setup
|
||||
setup(**configuration(top_path='').todict())
|
||||
@ -1,450 +0,0 @@
|
||||
PROGRAM sp2Acdf1
|
||||
C***********************************************************************
|
||||
C This program computes upper and lower bounds for: *
|
||||
C *
|
||||
C density of T_i, for Ac <=h, in a gaussian process i.e. *
|
||||
C *
|
||||
C half wavelength (up-crossing to downcrossing) for crests <h *
|
||||
C or half wavelength (down-crossing to upcrossing) for trough >h *
|
||||
C I.R. 27 Dec. 1999 *
|
||||
C***********************************************************************
|
||||
use GLOBALDATA, only : Nt,Nj,Nd,Nc,Ntd,Ntdc,NI,Mb,
|
||||
&NIT,Nx,TWOPI,XSPLT,SCIS,NSIMmax,COV
|
||||
use rind
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),allocatable :: BIG
|
||||
double precision, dimension(:,:),allocatable :: ansrup
|
||||
double precision, dimension(:,:),allocatable :: ansrlo
|
||||
double precision, dimension(: ),allocatable :: ex,CY
|
||||
double precision, dimension(:,:),allocatable :: xc,fxind
|
||||
double precision, dimension(: ),allocatable :: h
|
||||
double precision, dimension(: ),allocatable :: R0,R1,R2,R3,R4
|
||||
double precision ::CC,U,XddInf,XdInf,XtInf
|
||||
double precision, dimension(:,:),allocatable :: a_up,a_lo
|
||||
integer , dimension(: ),allocatable :: seed
|
||||
integer ,dimension(7) :: indI
|
||||
integer :: Nstart,Ntime,tn,ts,speed,ph,def,seed1,seed_size,icy
|
||||
integer ::it1,it2,status
|
||||
double precision :: ds,dT ! lag spacing for covariances
|
||||
! f90 sp2Acdf1.f rind50.f
|
||||
|
||||
CALL INIT_LEVELS(U,def,Ntime,Nstart,NIT,speed,Nx,dT)
|
||||
!print *,'U,def,Ntime,Nstart,NIT,speed,SCIS,seed1,Nx,dT'
|
||||
!print *,U,def,Ntime,Nstart,NIT,speed,SCIS,seed1,Nx,dT
|
||||
!XSPLT=1.5d0
|
||||
if (SCIS.GT.0) then
|
||||
allocate(COV(1:Nx))
|
||||
call random_seed(SIZE=seed_size)
|
||||
allocate(seed(seed_size))
|
||||
call random_seed(GET=seed(1:seed_size)) ! get current seed
|
||||
seed(1)=seed1 ! change seed
|
||||
call random_seed(PUT=seed(1:seed_size))
|
||||
deallocate(seed)
|
||||
endif
|
||||
CALL INITDATA(speed)
|
||||
!print *,ntime,speed,u,NIT
|
||||
allocate(R0(1:Ntime+1))
|
||||
allocate(R1(1:Ntime+1))
|
||||
allocate(R2(1:Ntime+1))
|
||||
if (abs(def).GT.1) THEN
|
||||
allocate(R3(1:Ntime+1))
|
||||
allocate(R4(1:Ntime+1))
|
||||
!CALL INIT_AMPLITUDES(h,def,Nx)
|
||||
endif
|
||||
allocate(h(1:Nx))
|
||||
CALL INIT_AMPLITUDES(h,def,Nx)
|
||||
CALL INIT_COVARIANCES(Ntime,def,R0,R1,R2,R3,R4)
|
||||
|
||||
NI=4; Nd=2
|
||||
Nc=3; Mb=2
|
||||
|
||||
Nj=0
|
||||
indI(1)=0
|
||||
C ***** The bound 'infinity' is set to 10*sigma *****
|
||||
XdInf=10.d0*SQRT(-R2(1))
|
||||
XtInf=10.d0*SQRT(R0(1))
|
||||
! normalizing constant
|
||||
CC=TWOPI*SQRT(-R0(1)/R2(1))*exp(u*u/(2.d0*R0(1)) )
|
||||
|
||||
allocate(CY(1:Nx))
|
||||
do icy=1,Nx
|
||||
CY(icy)=exp(-0.5*h(icy)*h(icy)/100)/(10*sqrt(twopi))
|
||||
enddo
|
||||
allocate(BIG(1:Ntime+Nc,1:Ntime+Nc),stat=status)
|
||||
if (status.ne.0) then
|
||||
print *,'can not allocate BIG'
|
||||
end if
|
||||
allocate(ex(1:Ntime+Nc),stat=status)
|
||||
if (status.ne.0) then
|
||||
print *,'can not allocate ex'
|
||||
end if
|
||||
allocate(ansrup(1:Ntime,1:Nx))
|
||||
allocate(ansrlo(1:Ntime,1:Nx))
|
||||
ansrup=0.d0
|
||||
ansrlo=0.d0
|
||||
allocate(fxind(1:Nx,1:2))
|
||||
fxind=0.d0 !this is not needed
|
||||
allocate(xc(1:Nc,1:Nx))
|
||||
|
||||
|
||||
allocate(a_up(Mb,NI-1))
|
||||
allocate(a_lo(Mb,NI-1))
|
||||
a_up=0.d0
|
||||
a_lo=0.d0
|
||||
xc(1,1:Nx)=h(1:Nx)
|
||||
xc(2,1:Nx)=u
|
||||
xc(3,1:Nx)=u
|
||||
|
||||
if (def.GT.0) then
|
||||
a_up(1,1)=0.d0
|
||||
a_lo(1,1)=u
|
||||
a_up(1,2)=XdInf
|
||||
a_lo(1,3)=-XdInf
|
||||
a_up(2,1)=1.d0
|
||||
else
|
||||
a_up(1,1)=u
|
||||
a_lo(1,1)=0.d0
|
||||
a_lo(1,2)=-XdInf
|
||||
a_up(1,3)= XdInf
|
||||
a_lo(2,1)=1.d0
|
||||
endif
|
||||
!print *,'Nstart',Nstart
|
||||
Nstart=MAX(3,Nstart)
|
||||
|
||||
|
||||
if (SCIS.GT.0) then
|
||||
open (unit=11, file='COV.out', STATUS='unknown')
|
||||
write(11,*) 0.d0
|
||||
endif
|
||||
|
||||
!print *,'loop starts'
|
||||
do Ntd=Nstart,Ntime
|
||||
|
||||
Ntdc=Ntd+Nc
|
||||
ex=0.d0
|
||||
BIG=0.d0
|
||||
CALL COV_INPUT(BIG(1:Ntdc,1:Ntdc),Ntd,-1,R0,R1,R2,R3,R4) ! positive wave period
|
||||
|
||||
Nt=Ntd-Nd;
|
||||
indI(2)=Nt;
|
||||
indI(3)=Nt+1;
|
||||
indI(4)=Ntd;
|
||||
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex,xc,indI,a_lo,a_up)
|
||||
!print *,'test',fxind/CY(1:Nx)
|
||||
|
||||
do icy=1,Nx
|
||||
ansrup(Ntd,icy)=fxind(icy,1)*CC/CY(icy)
|
||||
ansrlo(Ntd,icy)=fxind(icy,2)*CC/CY(icy)
|
||||
enddo
|
||||
if (SCIS.GT.0) then
|
||||
write(11,*) COV(1) ! save coefficient of variation
|
||||
endif
|
||||
if((Nx.gt.4).or.NIT.gt.4) print *,'Ready: ',Ntd,' of ',Ntime
|
||||
enddo
|
||||
goto 300
|
||||
300 open (unit=11, file='dens.out', STATUS='unknown')
|
||||
|
||||
do ts=1,Ntime
|
||||
do ph=1,Nx
|
||||
write(11,*) ansrup(ts,ph),ansrlo(ts,ph)
|
||||
enddo
|
||||
enddo
|
||||
!111 FORMAT(2x,F12.8)
|
||||
close(11)
|
||||
900 continue
|
||||
deallocate(BIG)
|
||||
deallocate(ex)
|
||||
deallocate(fxind)
|
||||
deallocate(ansrup)
|
||||
deallocate(ansrlo)
|
||||
deallocate(xc)
|
||||
deallocate(R0)
|
||||
deallocate(R1)
|
||||
deallocate(R2)
|
||||
if (allocated(COV) ) then
|
||||
deallocate(COV)
|
||||
endif
|
||||
|
||||
if (allocated(R3)) then
|
||||
deallocate(R3)
|
||||
deallocate(R4)
|
||||
deallocate(h)
|
||||
ENDIF
|
||||
stop
|
||||
!return
|
||||
|
||||
CONTAINS
|
||||
|
||||
|
||||
|
||||
SUBROUTINE INIT_LEVELS
|
||||
& (U,def,Ntime,Nstart,NIT,speed,Nx,dT)
|
||||
IMPLICIT NONE
|
||||
integer, intent(out):: def,Ntime,Nstart,NIT,speed,Nx
|
||||
double precision ,intent(out) :: U,dT
|
||||
|
||||
|
||||
OPEN(UNIT=14,FILE='reflev.in',STATUS= 'UNKNOWN')
|
||||
READ (14,*) U
|
||||
READ (14,*) def
|
||||
READ (14,*) Ntime
|
||||
READ (14,*) Nstart
|
||||
READ (14,*) NIT
|
||||
READ (14,*) speed
|
||||
READ (14,*) SCIS
|
||||
READ (14,*) seed1
|
||||
READ (14,*) Nx
|
||||
|
||||
if (abs(def).GT.1) then
|
||||
READ (14,*) dT
|
||||
if (Ntime.lt.3) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
else
|
||||
if (Ntime.lt.2) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
endif
|
||||
CLOSE(UNIT=14)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_LEVELS
|
||||
|
||||
C******************************************************
|
||||
SUBROUTINE INIT_AMPLITUDES(h,def,Nx)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:), intent(out) :: h
|
||||
integer, intent(in) :: def
|
||||
integer, intent(in) :: Nx
|
||||
integer :: ix
|
||||
|
||||
|
||||
OPEN(UNIT=4,FILE='h.in',STATUS= 'UNKNOWN')
|
||||
|
||||
C
|
||||
C Reading in amplitudes
|
||||
C
|
||||
do ix=1,Nx
|
||||
READ (4,*) H(ix)
|
||||
enddo
|
||||
CLOSE(UNIT=4)
|
||||
!if (def.LT.0) THEN
|
||||
! H=-H
|
||||
!endif
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_AMPLITUDES
|
||||
|
||||
C**************************************************
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
SUBROUTINE INIT_COVARIANCES(Ntime,def,R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:),intent(out) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(out) :: R3,R4
|
||||
integer,intent(in) :: Ntime,def
|
||||
integer :: i
|
||||
open (unit=1, file='Cd0.in',STATUS='unknown')
|
||||
open (unit=2, file='Cd1.in',STATUS='unknown')
|
||||
open (unit=3, file='Cd2.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(1,*) R0(i)
|
||||
read(2,*) R1(i)
|
||||
read(3,*) R2(i)
|
||||
enddo
|
||||
close(1)
|
||||
close(2)
|
||||
close(3)
|
||||
|
||||
if (abs(def).GT.1) then
|
||||
open (unit=4, file='Cd3.in',STATUS='unknown')
|
||||
open (unit=5, file='Cd4.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(4,*) R3(i)
|
||||
read(5,*) R4(i)
|
||||
enddo
|
||||
|
||||
close(4)
|
||||
close(5)
|
||||
endif
|
||||
return
|
||||
END SUBROUTINE INIT_COVARIANCES
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
C**********************************************************************
|
||||
|
||||
SUBROUTINE COV_INPUT(BIG,tn,ts, R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),intent(inout) :: BIG
|
||||
double precision, dimension(:),intent(in) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(in) :: R3,R4
|
||||
integer ,intent(in) :: tn,ts
|
||||
integer :: i,j,shft,Ntd1,N !=Ntdc
|
||||
double precision :: tmp
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows:
|
||||
! For ts>1:
|
||||
! X(t2)..X(ts),..X(tn-1) X''(ts) X'(t1) X'(tn) X(ts) X(t1) X(tn) X'(ts)
|
||||
! = [Xt Xd Xc]
|
||||
!
|
||||
! For ts<=1:
|
||||
! X(t2)..,..X(tn-1) X'(t1) X'(tn) Y X(t1) X(tn)
|
||||
! = [Xt Xd Xc]
|
||||
!Add Y Condition : Y=h
|
||||
|
||||
! where
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
if (ts.LE.1) THEN
|
||||
Ntd1=tn
|
||||
N=Ntd1+Nc;
|
||||
shft=0 ! def=1 want only crest period Tc
|
||||
else
|
||||
Ntd1=tn+1
|
||||
N=Ntd1+4
|
||||
shft=1 ! def=2 or 3 want Tc Ac or Tcf, Ac
|
||||
endif
|
||||
|
||||
do i=1,tn-2
|
||||
!cov(Xt)
|
||||
do j=i,tn-2
|
||||
BIG(i,j) = R0(j-i+1) ! cov(X(ti+1),X(tj+1))
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
BIG(i ,Ntd1+1+shft) = 0.d0 !cov(X(ti+1),Y)
|
||||
BIG(i ,Ntd1+2+shft) = R0(i+1) !cov(X(ti+1),X(t1))
|
||||
BIG(tn-1-i ,Ntd1+3+shft) = R0(i+1) !cov(X(t.. ),X(tn))
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj)
|
||||
BIG(i,Ntd1-1) =-R1(i+1) !cov(X(ti+1),X' (t1))
|
||||
BIG(tn-1-i,Ntd1)= R1(i+1) !cov(X(ti+1),X' (tn))
|
||||
enddo
|
||||
!call echo(big(1:tn,1:tn),tn)
|
||||
!cov(Xd)
|
||||
BIG(Ntd1 ,Ntd1 ) = -R2(1)
|
||||
BIG(Ntd1-1,Ntd1 ) = -R2(tn) !cov(X'(t1),X'(tn))
|
||||
BIG(Ntd1-1,Ntd1-1) = -R2(1)
|
||||
|
||||
!cov(Xc)
|
||||
!print *,'t'
|
||||
BIG(Ntd1+1+shft,Ntd1+1+shft) = 100.d0!100.d0 ! cov(Y,Y)
|
||||
BIG(Ntd1+1+shft,Ntd1+2+shft) = 0.d0
|
||||
BIG(Ntd1+1+shft,Ntd1+3+shft) = 0.d0
|
||||
BIG(Ntd1+2+shft,Ntd1+2+shft) = R0(1) ! cov(X(t1),X (t1))
|
||||
BIG(Ntd1+2+shft,Ntd1+3+shft) = R0(tn) ! cov(X(t1),X (tn))
|
||||
BIG(Ntd1+3+shft,Ntd1+3+shft) = R0(1) ! cov(X(tn),X (tn))
|
||||
!cov(Xd,Xc)
|
||||
BIG(Ntd1 ,Ntd1+1+shft) = 0.d0 !cov(X'(tn),Y)
|
||||
BIG(Ntd1 ,Ntd1+2+shft) = R1(tn) !cov(X'(tn),X(t1))
|
||||
BIG(Ntd1 ,Ntd1+3+shft) = 0.d0 !cov(X'(tn),X(tn))
|
||||
BIG(Ntd1-1,Ntd1+1+shft) = 0.d0 !cov(X'(t1),Y)
|
||||
BIG(Ntd1-1,Ntd1+2+shft) = 0.d0 !cov(X'(t1),X(t1))
|
||||
BIG(Ntd1-1,Ntd1+3+shft) =-R1(tn) !cov(X'(t1),X(tn))
|
||||
|
||||
|
||||
!call echo(big(1:N,1:N),N)
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,N-1
|
||||
do i=j+1,N
|
||||
tmp =BIG(j,i)
|
||||
BIG(i,j)=tmp
|
||||
enddo
|
||||
!call echo(big(1:N,1:N),N)
|
||||
enddo
|
||||
!if (tn.eq.3) then
|
||||
!do j=1,N
|
||||
! do i=j,N
|
||||
! print *,'test',j,i,BIG(j,i)
|
||||
! enddo
|
||||
!call echo(big(1:N,1:N),N)
|
||||
!enddo
|
||||
!endif
|
||||
!call echo(big(1:N,1:N),N)
|
||||
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT
|
||||
|
||||
SUBROUTINE COV_INPUT2(BIG,pt, R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:), intent(out) :: BIG
|
||||
double precision, dimension(:), intent(in) :: R0,R1,R2
|
||||
integer :: pt,i,j
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows;
|
||||
! X(t2)...X(tn-1) X'(t1) X'(tn) X(t1) X(tn) = [Xt Xd Xc]
|
||||
!
|
||||
! where Xd is the derivatives
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
!cov(Xc)
|
||||
BIG(pt+2,pt+2) = R0(1)
|
||||
BIG(pt+1,pt+1) = R0(1)
|
||||
BIG(pt+1,pt+2) = R0(pt)
|
||||
!cov(Xd)
|
||||
BIG(pt,pt) = -R2(1)
|
||||
BIG(pt-1,pt-1) = -R2(1)
|
||||
BIG(pt-1,pt) = -R2(pt)
|
||||
!cov(Xd,Xc)
|
||||
BIG(pt,pt+2) = 0.d0
|
||||
BIG(pt,pt+1) = R1(pt)
|
||||
BIG(pt-1,pt+2) = -R1(pt)
|
||||
BIG(pt-1,pt+1) = 0.d0
|
||||
|
||||
if (pt.GT.2) then
|
||||
!cov(Xt)
|
||||
do i=1,pt-2
|
||||
do j=i,pt-2
|
||||
BIG(i,j) = R0(j-i+1)
|
||||
enddo
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
do i=1,pt-2
|
||||
BIG(i,pt+1) = R0(i+1)
|
||||
BIG(pt-1-i,pt+2) = R0(i+1)
|
||||
enddo
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj))
|
||||
do i=1,pt-2
|
||||
BIG(i,pt-1) = -R1(i+1)
|
||||
BIG(pt-1-i,pt)= R1(i+1)
|
||||
enddo
|
||||
endif
|
||||
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,pt+1
|
||||
do i=j+1,pt+2
|
||||
BIG(i,j)=BIG(j,i)
|
||||
enddo
|
||||
enddo
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT2
|
||||
|
||||
|
||||
END PROGRAM sp2Acdf1
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,356 +0,0 @@
|
||||
PROGRAM sp2mM1
|
||||
C***********************************************************************************
|
||||
C Computes upper lower bounds for density of maximum and the following minimum *
|
||||
C***********************************************************************************
|
||||
use GLOBALDATA, only : Nt,Nj,Nd,Nc,Ntd,Ntdc,NI,Mb,
|
||||
&NIT,Nx,TWOPI,XSPLT,SCIS,NSIMmax,COV
|
||||
use rind
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),allocatable :: BIG
|
||||
double precision, dimension(:,:),allocatable :: ansrup
|
||||
double precision, dimension(:,:),allocatable :: ansrlo
|
||||
double precision, dimension(: ),allocatable :: ex,h
|
||||
double precision, dimension(:,:),allocatable :: xc
|
||||
double precision, dimension(:,:),allocatable :: fxind
|
||||
double precision, dimension(: ),allocatable :: R0,R1,R2,R3,R4
|
||||
double precision ::CC,U,XddInf,XdInf,XtInf
|
||||
double precision, dimension(:,:),allocatable :: a_up,a_lo
|
||||
integer , dimension(: ),allocatable :: seed
|
||||
integer ,dimension(7) :: indI
|
||||
integer :: Nstart,Ntime,tn,ts,speed,seed1,seed_size
|
||||
integer :: status,i,j,ij,Nx1
|
||||
double precision :: ds,dT ! lag spacing for covariances
|
||||
|
||||
! f90 sp2AmM1.f rind52.f
|
||||
|
||||
CALL INIT_LEVELS(Ntime,Nstart,NIT,speed,Nx1,dT)
|
||||
Nx=Nx1*(Nx1-1)/2
|
||||
if (SCIS.GT.0) then
|
||||
allocate(COV(1:Nx))
|
||||
call random_seed(SIZE=seed_size)
|
||||
allocate(seed(seed_size))
|
||||
call random_seed(GET=seed(1:seed_size)) ! get current seed
|
||||
seed(1)=seed1 ! change seed
|
||||
call random_seed(PUT=seed(1:seed_size))
|
||||
deallocate(seed)
|
||||
endif
|
||||
|
||||
CALL INITDATA(speed)
|
||||
|
||||
allocate(R0(1:Ntime+1))
|
||||
allocate(R1(1:Ntime+1))
|
||||
allocate(R2(1:Ntime+1))
|
||||
allocate(R3(1:Ntime+1))
|
||||
allocate(R4(1:Ntime+1))
|
||||
allocate(h(1:Nx1))
|
||||
|
||||
CALL INIT_AMPLITUDES(h,Nx1)
|
||||
CALL INIT_COVARIANCES(Ntime,R0,R1,R2,R3,R4)
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! Y= X'(t2)...X'(tn-1)||X''(t1) X''(tn)||X(t1) X(tn) X'(t1) X'(tn) !!
|
||||
! = [ Xt Xd Xc ] !!
|
||||
! !!
|
||||
! Nt=tn-2, Nd=2, Nc=4 !!
|
||||
! !!
|
||||
! Xt= contains Nt time points in the indicator function !!
|
||||
! Xd= " Nd derivatives !!
|
||||
! Xc= " Nc variables to condition on !!
|
||||
! !!
|
||||
! There are 3 ( NI=4) regions with constant bariers: !!
|
||||
! (indI(1)=0); for i\in (indI(1),indI(2)] Y(i)<0. !!
|
||||
! (indI(2)=Nt) ; for i\in (indI(2)+1,indI(3)], Y(i)<0 (deriv. X''(t1)) !!
|
||||
! (indI(3)=Nt+1); for i\in (indI(3)+1,indI(4)], Y(i)>0 (deriv. X''(tn)) !!
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
||||
NI=4; Nd=2
|
||||
Nc=4; Mb=1
|
||||
|
||||
Nj=0
|
||||
indI(1)=0
|
||||
C ***** The bound 'infinity' is set to 10*sigma *****
|
||||
XdInf=10.d0*SQRT(R4(1))
|
||||
XtInf=10.d0*SQRT(-R2(1))
|
||||
! normalizing constant
|
||||
CC=TWOPI*SQRT(-R2(1)/R4(1))
|
||||
|
||||
allocate(BIG(1:Ntime+Nc,1:Ntime+Nc),stat=status)
|
||||
if (status.ne.0) then
|
||||
print *,'can not allocate BIG'
|
||||
end if
|
||||
allocate(ex(1:Ntime+Nc),stat=status)
|
||||
if (status.ne.0) then
|
||||
print *,'can not allocate ex'
|
||||
end if
|
||||
allocate(ansrup(1:Nx1,1:Nx1))
|
||||
ansrup=0.d0
|
||||
allocate(ansrlo(1:Nx1,1:Nx1))
|
||||
ansrlo=0.d0
|
||||
allocate(fxind(1:Nx,1:2))
|
||||
fxind=0.d0 !this is not needed
|
||||
allocate(xc(1:Nc,1:Nx))
|
||||
|
||||
|
||||
allocate(a_up(Mb,NI-1))
|
||||
allocate(a_lo(Mb,NI-1))
|
||||
|
||||
a_up=0.d0
|
||||
a_lo=0.d0
|
||||
|
||||
ij=0
|
||||
do i=2,Nx1
|
||||
do j=1,i-1
|
||||
ij=ij+1
|
||||
xc(1,ij)=h(i)
|
||||
xc(2,ij)=h(j)
|
||||
enddo
|
||||
enddo
|
||||
xc(3,1:Nx)=0.d0
|
||||
xc(4,1:Nx)=0.d0
|
||||
|
||||
a_lo(1,1)=-Xtinf
|
||||
a_lo(1,2)=-XdInf
|
||||
a_up(1,3)=+XdInf
|
||||
|
||||
|
||||
Nstart=MAX(2,Nstart)
|
||||
|
||||
|
||||
if (SCIS.GT.0) then
|
||||
open (unit=11, file='COV.out', STATUS='unknown')
|
||||
write(11,*) 0.d0
|
||||
endif
|
||||
|
||||
do Ntd=Nstart,Ntime
|
||||
|
||||
Ntdc=Ntd+Nc
|
||||
ex=0.d0
|
||||
BIG=0.d0
|
||||
CALL COV_INPUT(BIG(1:Ntdc,1:Ntdc),Ntd,R0,R1,R2,R3,R4) ! positive wave period
|
||||
|
||||
Nt=Ntd-Nd;
|
||||
indI(2)=Nt;
|
||||
indI(3)=Nt+1;
|
||||
indI(4)=Ntd;
|
||||
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex,xc,indI,a_lo,a_up)
|
||||
ij=0
|
||||
do i=2,Nx1
|
||||
do j=1,i-1
|
||||
ij=ij+1
|
||||
ansrup(i,j)=ansrup(i,j)+fxind(ij,1)*CC*dt
|
||||
ansrlo(i,j)=ansrlo(i,j)+fxind(ij,2)*CC*dt
|
||||
enddo
|
||||
enddo
|
||||
|
||||
if (SCIS.GT.0) then
|
||||
write(11,*) COV(1) ! save coefficient of variation
|
||||
endif
|
||||
print *,'Ready: ',Ntd,' of ',Ntime
|
||||
enddo
|
||||
goto 300
|
||||
300 open (unit=11, file='dens.out', STATUS='unknown')
|
||||
do i=1,Nx1
|
||||
do j=1,Nx1
|
||||
write(11,*) ansrup(i,j),ansrlo(i,j)
|
||||
enddo
|
||||
enddo
|
||||
close(11)
|
||||
900 continue
|
||||
deallocate(BIG)
|
||||
deallocate(ex)
|
||||
deallocate(fxind)
|
||||
deallocate(ansrup)
|
||||
deallocate(ansrlo)
|
||||
deallocate(xc)
|
||||
deallocate(R0)
|
||||
deallocate(R1)
|
||||
deallocate(R2)
|
||||
deallocate(R3)
|
||||
deallocate(R4)
|
||||
deallocate(h)
|
||||
|
||||
if (allocated(COV) ) then
|
||||
deallocate(COV)
|
||||
endif
|
||||
stop
|
||||
!return
|
||||
|
||||
CONTAINS
|
||||
|
||||
|
||||
|
||||
SUBROUTINE INIT_LEVELS
|
||||
& (Ntime,Nstart,NIT,speed,Nx,dT)
|
||||
IMPLICIT NONE
|
||||
integer, intent(out):: Ntime,Nstart,NIT,speed,Nx
|
||||
double precision ,intent(out) :: dT
|
||||
|
||||
|
||||
OPEN(UNIT=14,FILE='reflev.in',STATUS= 'UNKNOWN')
|
||||
READ (14,*) Ntime
|
||||
READ (14,*) Nstart
|
||||
READ (14,*) NIT
|
||||
READ (14,*) speed
|
||||
READ (14,*) SCIS
|
||||
READ (14,*) seed1
|
||||
READ (14,*) Nx
|
||||
READ (14,*) dT
|
||||
|
||||
if (Ntime.lt.2) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
CLOSE(UNIT=14)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_LEVELS
|
||||
|
||||
C******************************************************
|
||||
SUBROUTINE INIT_AMPLITUDES(h,Nx)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:), intent(out) :: h
|
||||
integer, intent(in) :: Nx
|
||||
integer :: ix
|
||||
|
||||
|
||||
OPEN(UNIT=4,FILE='h.in',STATUS= 'UNKNOWN')
|
||||
|
||||
C
|
||||
C Reading in amplitudes
|
||||
C
|
||||
do ix=1,Nx
|
||||
READ (4,*) H(ix)
|
||||
enddo
|
||||
CLOSE(UNIT=4)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_AMPLITUDES
|
||||
|
||||
C**************************************************
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
SUBROUTINE INIT_COVARIANCES(Ntime,R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:),intent(out) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(out) :: R3,R4
|
||||
integer,intent(in) :: Ntime
|
||||
integer :: i
|
||||
open (unit=1, file='Cd0.in',STATUS='unknown')
|
||||
open (unit=2, file='Cd1.in',STATUS='unknown')
|
||||
open (unit=3, file='Cd2.in',STATUS='unknown')
|
||||
open (unit=4, file='Cd3.in',STATUS='unknown')
|
||||
open (unit=5, file='Cd4.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(1,*) R0(i)
|
||||
read(2,*) R1(i)
|
||||
read(3,*) R2(i)
|
||||
read(4,*) R3(i)
|
||||
read(5,*) R4(i)
|
||||
enddo
|
||||
close(1)
|
||||
close(2)
|
||||
close(3)
|
||||
close(3)
|
||||
close(5)
|
||||
return
|
||||
END SUBROUTINE INIT_COVARIANCES
|
||||
|
||||
C**********************************************************************
|
||||
|
||||
SUBROUTINE COV_INPUT(BIG,tn,R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),intent(inout) :: BIG
|
||||
double precision, dimension(:),intent(in) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(in) :: R3,R4
|
||||
integer ,intent(in) :: tn
|
||||
integer :: i,j,N
|
||||
double precision :: tmp
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows:
|
||||
! X'(t2)..X'(ts),...,X'(tn-1) X''(t1),X''(tn) X(t1),X(tn),X'(t1),X'(tn)
|
||||
! = [ Xt | Xd | Xc ]
|
||||
!
|
||||
! where
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
! Computations of all covariances follows simple rules: Cov(X(t),X(s))=r(t,s),
|
||||
! then Cov(X'(t),X(s))=dr(t,s)/dt. Now for stationary X(t) we have
|
||||
! a function r(tau) such that Cov(X(t),X(s))=r(s-t) (or r(t-s) will give the same result).
|
||||
!
|
||||
! Consequently Cov(X'(t),X(s)) = -r'(s-t) = -sign(s-t)*r'(|s-t|)
|
||||
! Cov(X'(t),X'(s)) = -r''(s-t) = -r''(|s-t|)
|
||||
! Cov(X''(t),X'(s)) = r'''(s-t) = sign(s-t)*r'''(|s-t|)
|
||||
! Cov(X''(t),X(s)) = r''(s-t) = r''(|s-t|)
|
||||
! Cov(X''(t),X''(s)) = r''''(s-t) = r''''(|s-t|)
|
||||
|
||||
N=tn+4
|
||||
do i=1,tn-2
|
||||
!cov(Xt)
|
||||
do j=i,tn-2
|
||||
BIG(i,j) = -R2(j-i+1) ! cov(X'(ti+1),X'(tj+1))
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
BIG(i ,tn+1) = R1(i+1) !cov(X'(ti+1),X(t1))
|
||||
BIG(tn-1-i ,tn+2) = -R1(i+1) !cov(X'(ti+1),X(tn))
|
||||
BIG(i ,tn+3) = -R2(i+1) !cov(X'(ti+1),X'(t1))
|
||||
BIG(tn-1-i ,tn+4) = -R2(i+1) !cov(X'(ti+1),X'(tn))
|
||||
!Cov(Xt,Xd)
|
||||
BIG(i,tn-1) = R3(i+1) !cov(X'(ti+1),X''(t1))
|
||||
BIG(tn-1-i,tn) =-R3(i+1) !cov(X'(ti+1),X''(tn))
|
||||
enddo
|
||||
|
||||
!cov(Xd)
|
||||
BIG(tn-1 ,tn-1 ) = R4(1)
|
||||
BIG(tn-1,tn ) = R4(tn) !cov(X''(t1),X''(tn))
|
||||
BIG(tn ,tn ) = R4(1)
|
||||
|
||||
!cov(Xc)
|
||||
BIG(tn+1,tn+1) = R0(1) ! cov(X(t1),X(t1))
|
||||
BIG(tn+1,tn+2) = R0(tn) ! cov(X(t1),X(tn))
|
||||
BIG(tn+1,tn+3) = 0.d0 ! cov(X(t1),X'(t1))
|
||||
BIG(tn+1,tn+4) = R1(tn) ! cov(X(t1),X'(tn))
|
||||
BIG(tn+2,tn+2) = R0(1) ! cov(X(tn),X(tn))
|
||||
BIG(tn+2,tn+3) =-R1(tn) ! cov(X(tn),X'(t1))
|
||||
BIG(tn+2,tn+4) = 0.d0 ! cov(X(tn),X'(tn))
|
||||
BIG(tn+3,tn+3) =-R2(1) ! cov(X'(t1),X'(t1))
|
||||
BIG(tn+3,tn+4) =-R2(tn) ! cov(X'(t1),X'(tn))
|
||||
BIG(tn+4,tn+4) =-R2(1) ! cov(X'(tn),X'(tn))
|
||||
!Xc=X(t1),X(tn),X'(t1),X'(tn)
|
||||
!Xd=X''(t1),X''(tn)
|
||||
!cov(Xd,Xc)
|
||||
BIG(tn-1 ,tn+1) = R2(1) !cov(X''(t1),X(t1))
|
||||
BIG(tn-1 ,tn+2) = R2(tn) !cov(X''(t1),X(tn))
|
||||
BIG(tn-1 ,tn+3) = 0.d0 !cov(X''(t1),X'(t1))
|
||||
BIG(tn-1 ,tn+4) = R3(tn) !cov(X''(t1),X'(tn))
|
||||
BIG(tn ,tn+1) = R2(tn) !cov(X''(tn),X(t1))
|
||||
BIG(tn ,tn+2) = R2(1) !cov(X''(tn),X(tn))
|
||||
BIG(tn ,tn+3) =-R3(tn) !cov(X''(tn),X'(t1))
|
||||
BIG(tn ,tn+4) = 0.d0 !cov(X''(tn),X'(tn))
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,N-1
|
||||
do i=j+1,N
|
||||
tmp =BIG(j,i)
|
||||
BIG(i,j)=tmp
|
||||
enddo
|
||||
enddo
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT
|
||||
|
||||
|
||||
END PROGRAM sp2mM1
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,504 +0,0 @@
|
||||
PROGRAM sp2tccpdf1
|
||||
C***********************************************************************
|
||||
C This program computes upper and lower bounds for the: *
|
||||
C *
|
||||
C density of T= T_1+T_2 in a gaussian process i.e. *
|
||||
C *
|
||||
C wavelengthes for crests <h1 and troughs >h2 *
|
||||
C *
|
||||
C Sylvie and Igor 7 dec. 1999 *
|
||||
C***********************************************************************
|
||||
use GLOBALDATA, only : Nt,Nj,Nd,Nc,Ntd,Ntdc,NI,Mb,
|
||||
& NIT,Nx,TWOPI,XSPLT,SCIS,NSIMmax,COV
|
||||
use rind
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),allocatable :: BIG
|
||||
double precision, dimension(:,:),allocatable :: ansrup
|
||||
double precision, dimension(:,:),allocatable :: ansrlo
|
||||
double precision, dimension(: ),allocatable :: ex,CY1,CY2
|
||||
double precision, dimension(:,:),allocatable :: xc
|
||||
double precision, dimension(:,:),allocatable ::fxind
|
||||
double precision, dimension(: ),allocatable :: h1,h2
|
||||
double precision, dimension(: ),allocatable :: hh1,hh2
|
||||
double precision, dimension(: ),allocatable :: R0,R1,R2
|
||||
double precision ::CC,U,XddInf,XdInf,XtInf
|
||||
double precision, dimension(:,:),allocatable :: a_up,a_lo
|
||||
integer , dimension(: ),allocatable :: seed
|
||||
integer ,dimension(7) :: indI
|
||||
integer :: Ntime,N0,tn,ts,speed,ph,seed1,seed_size,Nx1,Nx2
|
||||
integer :: icy,icy2
|
||||
double precision :: ds,dT ! lag spacing for covariances
|
||||
! DIGITAL:
|
||||
! f90 -g2 -C -automatic -o ~/WAT/V4/sp2tthpdf.exe rind48.f sp2tthpdf.f
|
||||
! SOLARIS:
|
||||
!f90 -g -O -w3 -Bdynamic -fixed -o ../sp2tthpdf.exe rind48.f sp2tthpdf.f
|
||||
|
||||
!print *,'enter sp2thpdf'
|
||||
CALL INIT_LEVELS(U,Ntime,N0,NIT,speed,SCIS,seed1,Nx1,Nx2,dT)
|
||||
|
||||
!print *,'U,Ntime,NIT,speed,SCIS,seed1,Nx,dT'
|
||||
!print *,U,Ntime,NIT,speed,SCIS,seed1,Nx,dT
|
||||
!Nx1=1
|
||||
!Nx2=1
|
||||
|
||||
Nx=Nx1*Nx2
|
||||
!print *,'NN',Nx1,Nx2,Nx
|
||||
|
||||
|
||||
!XSPLT=1.5d0
|
||||
if (SCIS.GT.0) then
|
||||
allocate(COV(1:Nx))
|
||||
call random_seed(SIZE=seed_size)
|
||||
allocate(seed(seed_size))
|
||||
call random_seed(GET=seed(1:seed_size)) ! get current seed
|
||||
seed(1)=seed1 ! change seed
|
||||
call random_seed(PUT=seed(1:seed_size))
|
||||
deallocate(seed)
|
||||
endif
|
||||
CALL INITDATA(speed)
|
||||
!print *,ntime,speed,u,NIT
|
||||
allocate(R0(1:Ntime+1))
|
||||
allocate(R1(1:Ntime+1))
|
||||
allocate(R2(1:Ntime+1))
|
||||
|
||||
allocate(h1(1:Nx1))
|
||||
allocate(h2(1:Nx2))
|
||||
CALL INIT_AMPLITUDES(h1,Nx1,h2,Nx2)
|
||||
CALL INIT_COVARIANCES(Ntime,R0,R1,R2)
|
||||
|
||||
|
||||
allocate(hh1(1:Nx))
|
||||
allocate(hh2(1:Nx))
|
||||
!h transformation
|
||||
do icy=1,Nx1
|
||||
do icy2=1,Nx2
|
||||
hh1((icy-1)*Nx2+icy2)=h1(icy);
|
||||
hh2((icy-1)*Nx2+icy2)=h2(icy2);
|
||||
enddo
|
||||
enddo
|
||||
|
||||
Nj=0
|
||||
indI(1)=0
|
||||
|
||||
C ***** The bound 'infinity' is set to 10*sigma *****
|
||||
XdInf=10.d0*SQRT(-R2(1))
|
||||
XtInf=10.d0*SQRT(R0(1))
|
||||
!h1(1)=XtInf
|
||||
!h2(1)=XtInf
|
||||
! normalizing constant
|
||||
CC=TWOPI*SQRT(-R0(1)/R2(1))*exp(u*u/(2.d0*R0(1)) )
|
||||
allocate(CY1(1:Nx))
|
||||
allocate(CY2(1:Nx))
|
||||
do icy=1,Nx
|
||||
CY1(icy)=exp(-0.5*hh1(icy)*hh1(icy)/100)/(10*sqrt(twopi))
|
||||
CY2(icy)=exp(-0.5*hh2(icy)*hh2(icy)/100)/(10*sqrt(twopi))
|
||||
enddo
|
||||
!print *,CY1
|
||||
allocate(ansrup(1:Ntime,1:Nx))
|
||||
allocate(ansrlo(1:Ntime,1:Nx))
|
||||
ansrup=0.d0
|
||||
ansrlo=0.d0
|
||||
allocate(fxind(1:Nx,1:2))
|
||||
!fxind=0.d0 this is not needed
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! Y={X(t2)..,X(ts),..X(tn-1)||X'(ts) X'(t1) X'(tn)||Y1 Y2 X(ts) X(t1) X(tn)} !!
|
||||
! = [Xt Xd Xc] !!
|
||||
! !!
|
||||
! Nt=tn-2, Nd=3, Nc=2+3 !!
|
||||
! !!
|
||||
! Xt= contains Nt time points in the indicator function !!
|
||||
! Xd= " Nd derivatives !!
|
||||
! Xc= " Nc variables to condition on !!
|
||||
! (Y1,Y2) dummy variables ind. of all other v. inputing h1,h2 into rindd !!
|
||||
! !!
|
||||
! There are 6 ( NI=7) regions with constant bariers: !!
|
||||
! (indI(1)=0); for i\in (indI(1),indI(2)] u<Y(i)<h1 !!
|
||||
! (indI(2)=ts-2); for i\in (indI(2),indI(2)], inf<Y(i)<inf (no restr.) !!
|
||||
! (indI(3)=ts-1); for i\in (indI(3),indI(4)], h2 <Y(i)<u !!
|
||||
! (indI(4)=Nt) ; for i\in (indI(4),indI(5)], Y(i)<0 (deriv. X'(ts)) !!
|
||||
! (indI(5)=Nt+1); for i\in (indI(5),indI(6)], Y(i)>0 (deriv. X'(t1)) !!
|
||||
! (indI(6)=Nt+2); for i\in (indI(6),indI(7)], Y(i)>0 (deriv. X'(tn)) !!
|
||||
! (indI(7)=Nt+3); NI=7. !!
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
||||
NI=7; Nd=3
|
||||
Nc=5; Mb=3
|
||||
allocate(a_up(1:Mb,1:(NI-1)))
|
||||
allocate(a_lo(1:Mb,1:(NI-1)))
|
||||
a_up=0.d0
|
||||
a_lo=0.d0
|
||||
allocate(BIG(1:(Ntime+Nc+1),1:(Ntime+Nc+1)))
|
||||
ALLOCATE(xc(1:Nc,1:Nx))
|
||||
allocate(ex(1:(Ntime+Nc+1)))
|
||||
!print *,size(ex),Ntime
|
||||
ex=0.d0
|
||||
!print *,size(ex),ex
|
||||
xc(1,1:Nx)=hh1(1:Nx)
|
||||
xc(2,1:Nx)=hh2(1:Nx)
|
||||
xc(3,1:Nx)=u
|
||||
xc(4,1:Nx)=u
|
||||
xc(5,1:Nx)=u
|
||||
! upp- down- upp-crossings at t1,ts,tn
|
||||
|
||||
a_lo(1,1)=u
|
||||
a_up(1,2)=XtInf ! X(ts) is redundant
|
||||
a_lo(1,2)=-Xtinf
|
||||
a_up(1,3)=u
|
||||
|
||||
|
||||
a_lo(1,4)=-XdInf
|
||||
a_up(1,5)= XdInf
|
||||
a_up(1,6)= XdInf
|
||||
|
||||
a_up(2,1)=1.d0
|
||||
a_lo(3,3)=1.d0 !signe a voir!!!!!!
|
||||
! print *,a_up
|
||||
! print *,a_lo
|
||||
do tn=N0,Ntime,1
|
||||
! do tn=Ntime,Ntime,1
|
||||
Ntd=tn+1
|
||||
Nt=Ntd-Nd
|
||||
Ntdc=Ntd+Nc
|
||||
indI(4)=Nt
|
||||
indI(5)=Nt+1
|
||||
indI(6)=Nt+2
|
||||
indI(7)=Ntd
|
||||
if (SCIS.gt.0) then
|
||||
if (SCIS.EQ.2) then
|
||||
Nj=max(Nt,0)
|
||||
else
|
||||
Nj=min(max(Nt-5, 0),0)
|
||||
endif
|
||||
endif
|
||||
do ts=3,tn-2
|
||||
!print *,'ts,tn' ,ts,tn,Ntdc
|
||||
CALL COV_INPUT(Big(1:Ntdc,1:Ntdc),tn,ts,R0,R1,R2)!positive wave period
|
||||
indI(2)=ts-2
|
||||
indI(3)=ts-1
|
||||
|
||||
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex(1:Ntdc),
|
||||
& xc,indI,a_lo,a_up)
|
||||
|
||||
ds=dt
|
||||
do icy=1,Nx
|
||||
! ansr(tn,:)=ansr(tn,:)+fxind*CC*ds./(CY1.*CY2)
|
||||
ansrup(tn,icy)=ansrup(tn,icy)+fxind(icy,1)*CC*ds
|
||||
& /(CY1(icy)*CY2(icy))
|
||||
ansrlo(tn,icy)=ansrlo(tn,icy)+fxind(icy,2)*CC*ds
|
||||
& /(CY1(icy)*CY2(icy))
|
||||
enddo
|
||||
enddo ! ts
|
||||
print *,'Ready: ',tn,' of ',Ntime
|
||||
|
||||
enddo !tn
|
||||
|
||||
300 open (unit=11, file='dens.out', STATUS='unknown')
|
||||
|
||||
do ts=1,Ntime
|
||||
do ph=1,Nx
|
||||
!write(11,*) ansrup(ts,ph),ansrlo(ts,ph)
|
||||
write(11,111) ansrup(ts,ph),ansrlo(ts,ph)
|
||||
enddo
|
||||
enddo
|
||||
111 FORMAT(2x,F12.8,2x,F12.8)
|
||||
close(11)
|
||||
900 deallocate(big)
|
||||
deallocate(fxind)
|
||||
deallocate(ansrup)
|
||||
deallocate(ansrlo)
|
||||
deallocate(xc)
|
||||
deallocate(ex)
|
||||
deallocate(R0)
|
||||
deallocate(R1)
|
||||
deallocate(R2)
|
||||
if (allocated(COV) ) then
|
||||
deallocate(COV)
|
||||
endif
|
||||
deallocate(h1)
|
||||
deallocate(h2)
|
||||
deallocate(hh1)
|
||||
deallocate(hh2)
|
||||
deallocate(a_up)
|
||||
deallocate(a_lo)
|
||||
stop
|
||||
!return
|
||||
|
||||
CONTAINS
|
||||
|
||||
|
||||
|
||||
SUBROUTINE INIT_LEVELS
|
||||
& (U,Ntime,N0,NIT,speed,SCIS,seed1,Nx1,Nx2,dT)
|
||||
IMPLICIT NONE
|
||||
integer, intent(out):: Ntime,N0,NIT,speed,Nx1,Nx2,SCIS,seed1
|
||||
double precision ,intent(out) :: U,dT
|
||||
|
||||
|
||||
OPEN(UNIT=14,FILE='reflev.in',STATUS= 'UNKNOWN')
|
||||
READ (14,*) U
|
||||
READ (14,*) Ntime
|
||||
READ (14,*) N0
|
||||
READ (14,*) NIT
|
||||
READ (14,*) speed
|
||||
READ (14,*) SCIS
|
||||
READ (14,*) seed1
|
||||
|
||||
|
||||
READ (14,*) Nx1,Nx2
|
||||
READ (14,*) dT
|
||||
if (Ntime.lt.5) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
|
||||
CLOSE(UNIT=14)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_LEVELS
|
||||
|
||||
C******************************************************
|
||||
SUBROUTINE INIT_AMPLITUDES(h1,Nx1,h2,Nx2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:), intent(out) :: h1,h2
|
||||
integer, intent(in) :: Nx1,Nx2
|
||||
integer :: ix
|
||||
|
||||
|
||||
OPEN(UNIT=4,FILE='h.in',STATUS= 'UNKNOWN')
|
||||
|
||||
C
|
||||
C Reading in amplitudes
|
||||
C
|
||||
do ix=1,Nx1
|
||||
READ (4,*) H1(ix)
|
||||
enddo
|
||||
do ix=1,Nx2
|
||||
READ (4,*) H2(ix)
|
||||
enddo
|
||||
CLOSE(UNIT=4)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_AMPLITUDES
|
||||
|
||||
C**************************************************
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
SUBROUTINE INIT_COVARIANCES(Ntime,R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:),intent(out) :: R0,R1,R2
|
||||
integer,intent(in) :: Ntime
|
||||
integer :: i
|
||||
open (unit=1, file='Cd0.in',STATUS='unknown')
|
||||
open (unit=2, file='Cd1.in',STATUS='unknown')
|
||||
open (unit=3, file='Cd2.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(1,*) R0(i)
|
||||
read(2,*) R1(i)
|
||||
read(3,*) R2(i)
|
||||
enddo
|
||||
close(1)
|
||||
close(2)
|
||||
close(3)
|
||||
|
||||
return
|
||||
END SUBROUTINE INIT_COVARIANCES
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
C**********************************************************************
|
||||
|
||||
SUBROUTINE COV_INPUT(BIG,tn,ts, R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),intent(inout) :: BIG
|
||||
double precision, dimension(:),intent(in) :: R0,R1,R2
|
||||
integer ,intent(in) :: tn,ts
|
||||
integer :: i,j,Ntd1,N !=Ntdc
|
||||
double precision :: tmp
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows:
|
||||
!
|
||||
! ||X(t2)..X(ts),..X(tn-1)||X'(ts) X'(t1) X'(tn)||Y1 Y2 X(ts) X(t1) X(tn)||
|
||||
! = [Xt Xd Xc]
|
||||
! where
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
! Computations of all covariances follows simple rules: Cov(X(t),X(s))=r(t,s),
|
||||
! then Cov(X'(t),X(s))=dr(t,s)/dt. Now for stationary X(t) we have
|
||||
! a function r(tau) such that Cov(X(t),X(s))=r(s-t) (or r(t-s) will give the same result).
|
||||
!
|
||||
! Consequently Cov(X'(t),X(s)) = -r'(s-t) = -sign(s-t)*r'(|s-t|)
|
||||
! Cov(X'(t),X'(s)) = -r''(s-t) = -r''(|s-t|)
|
||||
! Cov(X''(t),X'(s)) = r'''(s-t) = sign(s-t)*r'''(|s-t|)
|
||||
! Cov(X''(t),X(s)) = r''(s-t) = r''(|s-t|)
|
||||
! Cov(X''(t),X''(s)) = r''''(s-t) = r''''(|s-t|)
|
||||
|
||||
Ntd1=tn+1
|
||||
N=Ntd1+Nc
|
||||
do i=1,tn-2
|
||||
!cov(Xt)
|
||||
do j=i,tn-2
|
||||
BIG(i,j) = R0(j-i+1) ! cov(X(ti+1),X(tj+1))
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
BIG(i ,Ntd1+1) = 0.d0 !cov(X(ti+1),Y1)
|
||||
BIG(i ,Ntd1+2) = 0.d0 !cov(X(ti+1),Y2)
|
||||
BIG(i ,Ntd1+4) = R0(i+1) !cov(X(ti+1),X(t1))
|
||||
BIG(tn-1-i ,Ntd1+5) = R0(i+1) !cov(X(t.. ),X(tn))
|
||||
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj)
|
||||
BIG(i,Ntd1-1) =-R1(i+1) !cov(X(ti+1),X'(t1))
|
||||
BIG(tn-1-i,Ntd1)= R1(i+1) !cov(X(ti+1),X'(tn))
|
||||
enddo
|
||||
!cov(Xd)
|
||||
BIG(Ntd1 ,Ntd1 ) = -R2(1)
|
||||
BIG(Ntd1-1,Ntd1 ) = -R2(tn) !cov(X'(t1),X'(tn))
|
||||
BIG(Ntd1-1,Ntd1-1) = -R2(1)
|
||||
BIG(Ntd1-2,Ntd1-1) = -R2(ts) !cov(X'(ts),X'(t1))
|
||||
BIG(Ntd1-2,Ntd1-2) = -R2(1)
|
||||
BIG(Ntd1-2,Ntd1 ) = -R2(tn+1-ts) !cov(X'(ts),X'(tn))
|
||||
|
||||
!cov(Xc)
|
||||
BIG(Ntd1+1,Ntd1+1) = 100.d0 ! cov(Y1 Y1)
|
||||
BIG(Ntd1+1,Ntd1+2) = 0.d0 ! cov(Y1 Y2)
|
||||
BIG(Ntd1+1,Ntd1+3) = 0.d0 ! cov(Y1 X(ts))
|
||||
BIG(Ntd1+1,Ntd1+4) = 0.d0 ! cov(Y1 X(t1))
|
||||
BIG(Ntd1+1,Ntd1+5) = 0.d0 ! cov(Y1 X(tn))
|
||||
BIG(Ntd1+2,Ntd1+2) = 100.d0 ! cov(Y2 Y2)
|
||||
BIG(Ntd1+2,Ntd1+3) = 0.d0 ! cov(Y2 X(ts))
|
||||
BIG(Ntd1+2,Ntd1+4) = 0.d0 ! cov(Y2 X(t1))
|
||||
BIG(Ntd1+2,Ntd1+5) = 0.d0 ! cov(Y2 X(tn))
|
||||
|
||||
BIG(Ntd1+3,Ntd1+3) = R0(1) ! cov(X(ts),X (ts)
|
||||
BIG(Ntd1+3,Ntd1+4) = R0(ts) ! cov(X(ts),X (t1))
|
||||
BIG(Ntd1+3,Ntd1+5) = R0(tn+1-ts) ! cov(X(ts),X (tn))
|
||||
BIG(Ntd1+4,Ntd1+4) = R0(1) ! cov(X(t1),X (t1))
|
||||
BIG(Ntd1+4,Ntd1+5) = R0(tn) ! cov(X(t1),X (tn))
|
||||
BIG(Ntd1+5,Ntd1+5) = R0(1) ! cov(X(tn),X (tn))
|
||||
|
||||
|
||||
!cov(Xd,Xc)
|
||||
BIG(Ntd1 ,Ntd1+1) = 0.d0 !cov(X'(tn),Y1)
|
||||
BIG(Ntd1 ,Ntd1+2) = 0.d0 !cov(X'(tn),Y2)
|
||||
BIG(Ntd1-1 ,Ntd1+1) = 0.d0 !cov(X'(t1),Y1)
|
||||
BIG(Ntd1-1 ,Ntd1+2) = 0.d0 !cov(X'(t1),Y2)
|
||||
BIG(Ntd1-2 ,Ntd1+1) = 0.d0 !cov(X'(ts),Y1)
|
||||
BIG(Ntd1-2 ,Ntd1+2) = 0.d0 !cov(X'(ts),Y2)
|
||||
|
||||
BIG(Ntd1 ,Ntd1+4) = R1(tn) !cov(X'(tn),X(t1))
|
||||
BIG(Ntd1 ,Ntd1+5) = 0.d0 !cov(X'(tn),X(tn))
|
||||
BIG(Ntd1-1,Ntd1+4) = 0.d0 !cov(X'(t1),X(t1))
|
||||
BIG(Ntd1-1,Ntd1+5) =-R1(tn) !cov(X'(t1),X(tn))
|
||||
BIG(Ntd1 ,Ntd1+3) = R1(tn+1-ts) !cov(X'(tn),X (ts))
|
||||
BIG(Ntd1-1,Ntd1+3) =-R1(ts) !cov(X'(t1),X (ts))
|
||||
BIG(Ntd1-2,Ntd1+3) = 0.d0 !cov(X'(ts),X (ts)
|
||||
BIG(Ntd1-2,Ntd1+4) = R1(ts) !cov(X'(ts),X (t1))
|
||||
BIG(Ntd1-2,Ntd1+5) = -R1(tn+1-ts) !cov(X'(ts),X (tn))
|
||||
|
||||
|
||||
do i=1,tn-2
|
||||
j=abs(i+1-ts)
|
||||
!cov(Xt,Xc)
|
||||
BIG(i,Ntd1+3) = R0(j+1) !cov(X(ti+1),X(ts))
|
||||
!Cov(Xt,Xd)
|
||||
if ((i+1-ts).lt.0) then
|
||||
BIG(i,Ntd1-2) = R1(j+1)
|
||||
else !cov(X(ti+1),X'(ts))
|
||||
BIG(i,Ntd1-2) = -R1(j+1)
|
||||
endif
|
||||
enddo
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,N-1
|
||||
do i=j+1,N
|
||||
tmp =BIG(j,i)
|
||||
|
||||
BIG(i,j)=tmp
|
||||
enddo
|
||||
enddo
|
||||
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT
|
||||
|
||||
SUBROUTINE COV_INPUT2(BIG,pt, R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:), intent(out) :: BIG
|
||||
double precision, dimension(:), intent(in) :: R0,R1,R2
|
||||
integer :: pt,i,j
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows;
|
||||
! X(t2)...X(tn-1) X'(t1) X'(tn) X(t1) X(tn) = [Xt Xd Xc]
|
||||
!
|
||||
! where Xd is the derivatives
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
!cov(Xc)
|
||||
BIG(pt+2,pt+2) = R0(1)
|
||||
BIG(pt+1,pt+1) = R0(1)
|
||||
BIG(pt+1,pt+2) = R0(pt)
|
||||
!cov(Xd)
|
||||
BIG(pt,pt) = -R2(1)
|
||||
BIG(pt-1,pt-1) = -R2(1)
|
||||
BIG(pt-1,pt) = -R2(pt)
|
||||
!cov(Xd,Xc)
|
||||
BIG(pt,pt+2) = 0.d0
|
||||
BIG(pt,pt+1) = R1(pt)
|
||||
BIG(pt-1,pt+2) = -R1(pt)
|
||||
BIG(pt-1,pt+1) = 0.d0
|
||||
|
||||
if (pt.GT.2) then
|
||||
!cov(Xt)
|
||||
do i=1,pt-2
|
||||
do j=i,pt-2
|
||||
BIG(i,j) = R0(j-i+1)
|
||||
enddo
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
do i=1,pt-2
|
||||
BIG(i,pt+1) = R0(i+1)
|
||||
BIG(pt-1-i,pt+2) = R0(i+1)
|
||||
enddo
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj))
|
||||
do i=1,pt-2
|
||||
BIG(i,pt-1) = -R1(i+1)
|
||||
BIG(pt-1-i,pt)= R1(i+1)
|
||||
enddo
|
||||
endif
|
||||
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,pt+1
|
||||
do i=j+1,pt+2
|
||||
BIG(i,j)=BIG(j,i)
|
||||
enddo
|
||||
enddo
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT2
|
||||
|
||||
|
||||
END PROGRAM sp2tccpdf1
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,497 +0,0 @@
|
||||
PROGRAM sp2tthpdf1
|
||||
C***********************************************************************
|
||||
C This program computes: *
|
||||
C *
|
||||
C density of T= T_1+T_2 in a gaussian process i.e. *
|
||||
C *
|
||||
C wavelengthes for crests <h1 and troughs >h2 *
|
||||
C *
|
||||
C Sylvie and Igor 7 dec. 1999 *
|
||||
C***********************************************************************
|
||||
use GLOBALDATA, only : Nt,Nj,Nd,Nc,Ntd,Ntdc,NI,Mb,
|
||||
& NIT,Nx,TWOPI,XSPLT,SCIS,NSIMmax,COV
|
||||
use rind
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),allocatable :: BIG
|
||||
double precision, dimension(:,:),allocatable :: ansr
|
||||
double precision, dimension(: ),allocatable :: ex,CY1,CY2
|
||||
double precision, dimension(:,:),allocatable :: xc
|
||||
double precision, dimension(: ),allocatable :: fxind,h1,h2
|
||||
double precision, dimension(: ),allocatable :: hh1,hh2
|
||||
double precision, dimension(: ),allocatable :: R0,R1,R2
|
||||
double precision ::CC,U,XddInf,XdInf,XtInf
|
||||
double precision, dimension(:,:),allocatable :: a_up,a_lo
|
||||
integer , dimension(: ),allocatable :: seed
|
||||
integer ,dimension(7) :: indI
|
||||
integer :: Ntime,tn,ts,speed,ph,seed1,seed_size,Nx1,Nx2,N0
|
||||
integer :: icy,icy2
|
||||
double precision :: ds,dT ! lag spacing for covariances
|
||||
! DIGITAL:
|
||||
! f90 -g2 -C -automatic -o ~/WAT/V4/sp2tthpdf1.exe rind49.f sp2tthpdf1.f
|
||||
! SOLARIS:
|
||||
!f90 -g -O -w3 -Bdynamic -fixed -o ../sp2tthpdf.exe rind49.f sp2tthpdf1.f
|
||||
|
||||
!print *,'enter sp2thpdf'
|
||||
CALL INIT_LEVELS(U,Ntime,N0,NIT,speed,SCIS,seed1,Nx1,Nx2,dT)
|
||||
|
||||
!print *,'U,Ntime,NIT,speed,SCIS,seed1,Nx,dT'
|
||||
!print *,U,Ntime,NIT,speed,SCIS,seed1,Nx,dT
|
||||
!Nx1=1
|
||||
!Nx2=1
|
||||
|
||||
Nx=Nx1*Nx2
|
||||
!print *,'NN',Nx1,Nx2,Nx
|
||||
|
||||
|
||||
!XSPLT=1.5d0
|
||||
if (SCIS.GT.0) then
|
||||
allocate(COV(1:Nx))
|
||||
call random_seed(SIZE=seed_size)
|
||||
allocate(seed(seed_size))
|
||||
call random_seed(GET=seed(1:seed_size)) ! get current seed
|
||||
seed(1)=seed1 ! change seed
|
||||
call random_seed(PUT=seed(1:seed_size))
|
||||
deallocate(seed)
|
||||
endif
|
||||
CALL INITDATA(speed)
|
||||
!print *,ntime,speed,u,NIT
|
||||
allocate(R0(1:Ntime+1))
|
||||
allocate(R1(1:Ntime+1))
|
||||
allocate(R2(1:Ntime+1))
|
||||
|
||||
allocate(h1(1:Nx1))
|
||||
allocate(h2(1:Nx2))
|
||||
CALL INIT_AMPLITUDES(h1,Nx1,h2,Nx2)
|
||||
CALL INIT_COVARIANCES(Ntime,R0,R1,R2)
|
||||
|
||||
|
||||
allocate(hh1(1:Nx))
|
||||
allocate(hh2(1:Nx))
|
||||
!h transformation
|
||||
do icy=1,Nx1
|
||||
do icy2=1,Nx2
|
||||
hh1((icy-1)*Nx2+icy2)=h1(icy);
|
||||
hh2((icy-1)*Nx2+icy2)=h2(icy2);
|
||||
enddo
|
||||
enddo
|
||||
|
||||
Nj=0
|
||||
indI(1)=0
|
||||
|
||||
C ***** The bound 'infinity' is set to 10*sigma *****
|
||||
XdInf=10.d0*SQRT(-R2(1))
|
||||
XtInf=10.d0*SQRT(R0(1))
|
||||
!h1(1)=XtInf
|
||||
!h2(1)=XtInf
|
||||
! normalizing constant
|
||||
CC=TWOPI*SQRT(-R0(1)/R2(1))*exp(u*u/(2.d0*R0(1)) )
|
||||
allocate(CY1(1:Nx))
|
||||
allocate(CY2(1:Nx))
|
||||
do icy=1,Nx
|
||||
CY1(icy)=exp(-0.5*hh1(icy)*hh1(icy)/100)/(10*sqrt(twopi))
|
||||
CY2(icy)=exp(-0.5*hh2(icy)*hh2(icy)/100)/(10*sqrt(twopi))
|
||||
enddo
|
||||
!print *,CY1
|
||||
allocate(ansr(1:Ntime,1:Nx))
|
||||
ansr=0.d0
|
||||
allocate(fxind(1:Nx))
|
||||
fxind=0.d0
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! Y={X(t2)..,X(ts),..X(tn-1)||X'(ts) X'(t1) X'(tn)||Y1 Y2 X(ts) X(t1) X(tn)} !!
|
||||
! = [Xt Xd Xc] !!
|
||||
! !!
|
||||
! Nt=tn-2, Nd=3, Nc=2+3 !!
|
||||
! !!
|
||||
! Xt= contains Nt time points in the indicator function !!
|
||||
! Xd= " Nd derivatives !!
|
||||
! Xc= " Nc variables to condition on !!
|
||||
! (Y1,Y2) dummy variables ind. of all other v. inputing h1,h2 into rindd !!
|
||||
! !!
|
||||
! There are 6 ( NI=7) regions with constant bariers: !!
|
||||
! (indI(1)=0); for i\in (indI(1),indI(2)] u<Y(i)<h1 !!
|
||||
! (indI(2)=ts-2); for i\in (indI(2),indI(2)], inf<Y(i)<inf (no restr.) !!
|
||||
! (indI(3)=ts-1); for i\in (indI(3),indI(4)], h2 <Y(i)<u !!
|
||||
! (indI(4)=Nt) ; for i\in (indI(4),indI(5)], Y(i)<0 (deriv. X'(ts)) !!
|
||||
! (indI(5)=Nt+1); for i\in (indI(5),indI(6)], Y(i)>0 (deriv. X'(t1)) !!
|
||||
! (indI(6)=Nt+2); for i\in (indI(6),indI(7)], Y(i)>0 (deriv. X'(tn)) !!
|
||||
! (indI(7)=Nt+3); NI=7. !!
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
||||
NI=7; Nd=3
|
||||
Nc=5; Mb=3
|
||||
allocate(a_up(1:Mb,1:(NI-1)))
|
||||
allocate(a_lo(1:Mb,1:(NI-1)))
|
||||
a_up=0.d0
|
||||
a_lo=0.d0
|
||||
allocate(BIG(1:(Ntime+Nc+1),1:(Ntime+Nc+1)))
|
||||
ALLOCATE(xc(1:Nc,1:Nx))
|
||||
allocate(ex(1:(Ntime+Nc+1)))
|
||||
!print *,size(ex),Ntime
|
||||
ex=0.d0
|
||||
!print *,size(ex),ex
|
||||
xc(1,1:Nx)=hh1(1:Nx)
|
||||
xc(2,1:Nx)=hh2(1:Nx)
|
||||
xc(3,1:Nx)=u
|
||||
xc(4,1:Nx)=u
|
||||
xc(5,1:Nx)=u
|
||||
! upp- down- upp-crossings at t1,ts,tn
|
||||
|
||||
a_lo(1,1)=u
|
||||
a_up(1,2)=XtInf ! X(ts) is redundant
|
||||
a_lo(1,2)=-Xtinf
|
||||
a_up(1,3)=u
|
||||
|
||||
|
||||
a_lo(1,4)=-XdInf
|
||||
a_up(1,5)= XdInf
|
||||
a_up(1,6)= XdInf
|
||||
|
||||
a_up(2,1)=1.d0
|
||||
a_lo(3,3)=1.d0 !signe a voir!!!!!!
|
||||
! print *,a_up
|
||||
! print *,a_lo
|
||||
do tn=N0,Ntime,1
|
||||
! do tn=Ntime,Ntime,1
|
||||
Ntd=tn+1
|
||||
Nt=Ntd-Nd
|
||||
Ntdc=Ntd+Nc
|
||||
indI(4)=Nt
|
||||
indI(5)=Nt+1
|
||||
indI(6)=Nt+2
|
||||
indI(7)=Ntd
|
||||
if (SCIS.gt.0) then
|
||||
if (SCIS.EQ.2) then
|
||||
Nj=max(Nt,0)
|
||||
else
|
||||
Nj=min(max(Nt-5, 0),0)
|
||||
endif
|
||||
endif
|
||||
do ts=3,tn-2
|
||||
!print *,'ts,tn' ,ts,tn,Ntdc
|
||||
CALL COV_INPUT(Big(1:Ntdc,1:Ntdc),tn,ts,R0,R1,R2)!positive wave period
|
||||
indI(2)=ts-2
|
||||
indI(3)=ts-1
|
||||
|
||||
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex(1:Ntdc),
|
||||
& xc,indI,a_lo,a_up)
|
||||
|
||||
ds=dt
|
||||
do icy=1,Nx
|
||||
! ansr(tn,:)=ansr(tn,:)+fxind*CC*ds./(CY1.*CY2)
|
||||
ansr(tn,icy)=ansr(tn,icy)+fxind(icy)*CC*ds/(CY1(icy)*CY2(icy))
|
||||
enddo
|
||||
enddo ! ts
|
||||
print *,'Ready: ',tn,' of ',Ntime
|
||||
|
||||
enddo !tn
|
||||
!print *,'ansr',ansr
|
||||
300 open (unit=11, file='dens.out', STATUS='unknown')
|
||||
!print *, ansr
|
||||
do ts=1,Ntime
|
||||
do ph=1,Nx
|
||||
write(11,*) ansr(ts,ph),hh1(ph),hh2(ph)
|
||||
! write(11,111) ansr(ts,ph)
|
||||
|
||||
enddo
|
||||
enddo
|
||||
!111 FORMAT(2x,F12.8)
|
||||
close(11)
|
||||
900 deallocate(big)
|
||||
deallocate(fxind)
|
||||
deallocate(ansr)
|
||||
deallocate(xc)
|
||||
deallocate(ex)
|
||||
deallocate(R0)
|
||||
deallocate(R1)
|
||||
deallocate(R2)
|
||||
if (allocated(COV) ) then
|
||||
deallocate(COV)
|
||||
endif
|
||||
deallocate(h1)
|
||||
deallocate(h2)
|
||||
deallocate(hh1)
|
||||
deallocate(hh2)
|
||||
deallocate(a_up)
|
||||
deallocate(a_lo)
|
||||
stop
|
||||
!return
|
||||
|
||||
CONTAINS
|
||||
|
||||
|
||||
|
||||
SUBROUTINE INIT_LEVELS
|
||||
& (U,Ntime,N0,NIT,speed,SCIS,seed1,Nx1,Nx2,dT)
|
||||
IMPLICIT NONE
|
||||
integer, intent(out):: Ntime,N0,NIT,speed,Nx1,Nx2,SCIS,seed1
|
||||
double precision ,intent(out) :: U,dT
|
||||
|
||||
|
||||
OPEN(UNIT=14,FILE='reflev.in',STATUS= 'UNKNOWN')
|
||||
READ (14,*) U
|
||||
READ (14,*) Ntime
|
||||
READ (14,*) N0
|
||||
READ (14,*) NIT
|
||||
READ (14,*) speed
|
||||
READ (14,*) SCIS
|
||||
READ (14,*) seed1
|
||||
|
||||
|
||||
READ (14,*) Nx1,Nx2
|
||||
READ (14,*) dT
|
||||
if (Ntime.lt.3) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
|
||||
CLOSE(UNIT=14)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_LEVELS
|
||||
|
||||
C******************************************************
|
||||
SUBROUTINE INIT_AMPLITUDES(h1,Nx1,h2,Nx2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:), intent(out) :: h1,h2
|
||||
integer, intent(in) :: Nx1,Nx2
|
||||
integer :: ix
|
||||
|
||||
|
||||
OPEN(UNIT=4,FILE='h.in',STATUS= 'UNKNOWN')
|
||||
|
||||
C
|
||||
C Reading in amplitudes
|
||||
C
|
||||
do ix=1,Nx1
|
||||
READ (4,*) H1(ix)
|
||||
enddo
|
||||
do ix=1,Nx2
|
||||
READ (4,*) H2(ix)
|
||||
enddo
|
||||
CLOSE(UNIT=4)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_AMPLITUDES
|
||||
|
||||
C**************************************************
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
SUBROUTINE INIT_COVARIANCES(Ntime,R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:),intent(out) :: R0,R1,R2
|
||||
integer,intent(in) :: Ntime
|
||||
integer :: i
|
||||
open (unit=1, file='Cd0.in',STATUS='unknown')
|
||||
open (unit=2, file='Cd1.in',STATUS='unknown')
|
||||
open (unit=3, file='Cd2.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(1,*) R0(i)
|
||||
read(2,*) R1(i)
|
||||
read(3,*) R2(i)
|
||||
enddo
|
||||
close(1)
|
||||
close(2)
|
||||
close(3)
|
||||
|
||||
return
|
||||
END SUBROUTINE INIT_COVARIANCES
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
C**********************************************************************
|
||||
|
||||
SUBROUTINE COV_INPUT(BIG,tn,ts, R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),intent(inout) :: BIG
|
||||
double precision, dimension(:),intent(in) :: R0,R1,R2
|
||||
integer ,intent(in) :: tn,ts
|
||||
integer :: i,j,Ntd1,N !=Ntdc
|
||||
double precision :: tmp
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows:
|
||||
!
|
||||
! ||X(t2)..X(ts),..X(tn-1)||X'(ts) X'(t1) X'(tn)||Y1 Y2 X(ts) X(t1) X(tn)||
|
||||
! = [Xt Xd Xc]
|
||||
! where
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
! Computations of all covariances follows simple rules: Cov(X(t),X(s))=r(t,s),
|
||||
! then Cov(X'(t),X(s))=dr(t,s)/dt. Now for stationary X(t) we have
|
||||
! a function r(tau) such that Cov(X(t),X(s))=r(s-t) (or r(t-s) will give the same result).
|
||||
!
|
||||
! Consequently Cov(X'(t),X(s)) = -r'(s-t) = -sign(s-t)*r'(|s-t|)
|
||||
! Cov(X'(t),X'(s)) = -r''(s-t) = -r''(|s-t|)
|
||||
! Cov(X''(t),X'(s)) = r'''(s-t) = sign(s-t)*r'''(|s-t|)
|
||||
! Cov(X''(t),X(s)) = r''(s-t) = r''(|s-t|)
|
||||
! Cov(X''(t),X''(s)) = r''''(s-t) = r''''(|s-t|)
|
||||
|
||||
Ntd1=tn+1
|
||||
N=Ntd1+Nc
|
||||
do i=1,tn-2
|
||||
!cov(Xt)
|
||||
do j=i,tn-2
|
||||
BIG(i,j) = R0(j-i+1) ! cov(X(ti+1),X(tj+1))
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
BIG(i ,Ntd1+1) = 0.d0 !cov(X(ti+1),Y1)
|
||||
BIG(i ,Ntd1+2) = 0.d0 !cov(X(ti+1),Y2)
|
||||
BIG(i ,Ntd1+4) = R0(i+1) !cov(X(ti+1),X(t1))
|
||||
BIG(tn-1-i ,Ntd1+5) = R0(i+1) !cov(X(t.. ),X(tn))
|
||||
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj)
|
||||
BIG(i,Ntd1-1) =-R1(i+1) !cov(X(ti+1),X'(t1))
|
||||
BIG(tn-1-i,Ntd1)= R1(i+1) !cov(X(ti+1),X'(tn))
|
||||
enddo
|
||||
!cov(Xd)
|
||||
BIG(Ntd1 ,Ntd1 ) = -R2(1)
|
||||
BIG(Ntd1-1,Ntd1 ) = -R2(tn) !cov(X'(t1),X'(tn))
|
||||
BIG(Ntd1-1,Ntd1-1) = -R2(1)
|
||||
BIG(Ntd1-2,Ntd1-1) = -R2(ts) !cov(X'(ts),X'(t1))
|
||||
BIG(Ntd1-2,Ntd1-2) = -R2(1)
|
||||
BIG(Ntd1-2,Ntd1 ) = -R2(tn+1-ts) !cov(X'(ts),X'(tn))
|
||||
|
||||
!cov(Xc)
|
||||
BIG(Ntd1+1,Ntd1+1) = 100.d0 ! cov(Y1 Y1)
|
||||
BIG(Ntd1+1,Ntd1+2) = 0.d0 ! cov(Y1 Y2)
|
||||
BIG(Ntd1+1,Ntd1+3) = 0.d0 ! cov(Y1 X(ts))
|
||||
BIG(Ntd1+1,Ntd1+4) = 0.d0 ! cov(Y1 X(t1))
|
||||
BIG(Ntd1+1,Ntd1+5) = 0.d0 ! cov(Y1 X(tn))
|
||||
BIG(Ntd1+2,Ntd1+2) = 100.d0 ! cov(Y2 Y2)
|
||||
BIG(Ntd1+2,Ntd1+3) = 0.d0 ! cov(Y2 X(ts))
|
||||
BIG(Ntd1+2,Ntd1+4) = 0.d0 ! cov(Y2 X(t1))
|
||||
BIG(Ntd1+2,Ntd1+5) = 0.d0 ! cov(Y2 X(tn))
|
||||
|
||||
BIG(Ntd1+3,Ntd1+3) = R0(1) ! cov(X(ts),X (ts)
|
||||
BIG(Ntd1+3,Ntd1+4) = R0(ts) ! cov(X(ts),X (t1))
|
||||
BIG(Ntd1+3,Ntd1+5) = R0(tn+1-ts) ! cov(X(ts),X (tn))
|
||||
BIG(Ntd1+4,Ntd1+4) = R0(1) ! cov(X(t1),X (t1))
|
||||
BIG(Ntd1+4,Ntd1+5) = R0(tn) ! cov(X(t1),X (tn))
|
||||
BIG(Ntd1+5,Ntd1+5) = R0(1) ! cov(X(tn),X (tn))
|
||||
|
||||
|
||||
!cov(Xd,Xc)
|
||||
BIG(Ntd1 ,Ntd1+1) = 0.d0 !cov(X'(tn),Y1)
|
||||
BIG(Ntd1 ,Ntd1+2) = 0.d0 !cov(X'(tn),Y2)
|
||||
BIG(Ntd1-1 ,Ntd1+1) = 0.d0 !cov(X'(t1),Y1)
|
||||
BIG(Ntd1-1 ,Ntd1+2) = 0.d0 !cov(X'(t1),Y2)
|
||||
BIG(Ntd1-2 ,Ntd1+1) = 0.d0 !cov(X'(ts),Y1)
|
||||
BIG(Ntd1-2 ,Ntd1+2) = 0.d0 !cov(X'(ts),Y2)
|
||||
|
||||
BIG(Ntd1 ,Ntd1+4) = R1(tn) !cov(X'(tn),X(t1))
|
||||
BIG(Ntd1 ,Ntd1+5) = 0.d0 !cov(X'(tn),X(tn))
|
||||
BIG(Ntd1-1,Ntd1+4) = 0.d0 !cov(X'(t1),X(t1))
|
||||
BIG(Ntd1-1,Ntd1+5) =-R1(tn) !cov(X'(t1),X(tn))
|
||||
BIG(Ntd1 ,Ntd1+3) = R1(tn+1-ts) !cov(X'(tn),X (ts))
|
||||
BIG(Ntd1-1,Ntd1+3) =-R1(ts) !cov(X'(t1),X (ts))
|
||||
BIG(Ntd1-2,Ntd1+3) = 0.d0 !cov(X'(ts),X (ts)
|
||||
BIG(Ntd1-2,Ntd1+4) = R1(ts) !cov(X'(ts),X (t1))
|
||||
BIG(Ntd1-2,Ntd1+5) = -R1(tn+1-ts) !cov(X'(ts),X (tn))
|
||||
|
||||
|
||||
do i=1,tn-2
|
||||
j=abs(i+1-ts)
|
||||
!cov(Xt,Xc)
|
||||
BIG(i,Ntd1+3) = R0(j+1) !cov(X(ti+1),X(ts))
|
||||
!Cov(Xt,Xd)
|
||||
if ((i+1-ts).lt.0) then
|
||||
BIG(i,Ntd1-2) = R1(j+1)
|
||||
else !cov(X(ti+1),X'(ts))
|
||||
BIG(i,Ntd1-2) = -R1(j+1)
|
||||
endif
|
||||
enddo
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,N-1
|
||||
do i=j+1,N
|
||||
tmp =BIG(j,i)
|
||||
|
||||
BIG(i,j)=tmp
|
||||
enddo
|
||||
enddo
|
||||
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT
|
||||
|
||||
SUBROUTINE COV_INPUT2(BIG,pt, R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:), intent(out) :: BIG
|
||||
double precision, dimension(:), intent(in) :: R0,R1,R2
|
||||
integer :: pt,i,j
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows;
|
||||
! X(t2)...X(tn-1) X'(t1) X'(tn) X(t1) X(tn) = [Xt Xd Xc]
|
||||
!
|
||||
! where Xd is the derivatives
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
!cov(Xc)
|
||||
BIG(pt+2,pt+2) = R0(1)
|
||||
BIG(pt+1,pt+1) = R0(1)
|
||||
BIG(pt+1,pt+2) = R0(pt)
|
||||
!cov(Xd)
|
||||
BIG(pt,pt) = -R2(1)
|
||||
BIG(pt-1,pt-1) = -R2(1)
|
||||
BIG(pt-1,pt) = -R2(pt)
|
||||
!cov(Xd,Xc)
|
||||
BIG(pt,pt+2) = 0.d0
|
||||
BIG(pt,pt+1) = R1(pt)
|
||||
BIG(pt-1,pt+2) = -R1(pt)
|
||||
BIG(pt-1,pt+1) = 0.d0
|
||||
|
||||
if (pt.GT.2) then
|
||||
!cov(Xt)
|
||||
do i=1,pt-2
|
||||
do j=i,pt-2
|
||||
BIG(i,j) = R0(j-i+1)
|
||||
enddo
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
do i=1,pt-2
|
||||
BIG(i,pt+1) = R0(i+1)
|
||||
BIG(pt-1-i,pt+2) = R0(i+1)
|
||||
enddo
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj))
|
||||
do i=1,pt-2
|
||||
BIG(i,pt-1) = -R1(i+1)
|
||||
BIG(pt-1-i,pt)= R1(i+1)
|
||||
enddo
|
||||
endif
|
||||
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,pt+1
|
||||
do i=j+1,pt+2
|
||||
BIG(i,j)=BIG(j,i)
|
||||
enddo
|
||||
enddo
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT2
|
||||
|
||||
|
||||
END PROGRAM sp2tthpdf1
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,445 +0,0 @@
|
||||
PROGRAM sp2Acdf
|
||||
C***********************************************************************
|
||||
C This program computes: *
|
||||
C *
|
||||
C density of T_i, for Ac <=h, in a gaussian process i.e. *
|
||||
C *
|
||||
C half wavelength (up-crossing to downcrossing) for crests <h *
|
||||
C or half wavelength (down-crossing to upcrossing) for trough >h *
|
||||
C***********************************************************************
|
||||
use GLOBALDATA, only : Nt,Nj,Nd,Nc,Ntd,Ntdc,NI,Mb,
|
||||
&NIT,Nx,TWOPI,XSPLT,SCIS,NSIMmax,COV
|
||||
use rind
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),allocatable :: BIG
|
||||
double precision, dimension(:,:),allocatable :: ansr
|
||||
double precision, dimension(: ),allocatable :: ex,CY
|
||||
double precision, dimension(:,:),allocatable :: xc
|
||||
double precision, dimension(: ),allocatable :: fxind,h
|
||||
double precision, dimension(: ),allocatable :: R0,R1,R2,R3,R4
|
||||
double precision ::CC,U,XddInf,XdInf,XtInf
|
||||
double precision, dimension(:,:),allocatable :: a_up,a_lo
|
||||
integer , dimension(: ),allocatable :: seed
|
||||
integer ,dimension(7) :: indI
|
||||
integer :: Nstart,Ntime,tn,ts,speed,ph,def,seed1,seed_size,icy
|
||||
integer ::it1,it2,status
|
||||
double precision :: ds,dT ! lag spacing for covariances
|
||||
! f90 sp2Acdf.f rind51.f
|
||||
|
||||
CALL INIT_LEVELS(U,def,Ntime,Nstart,NIT,speed,Nx,dT)
|
||||
!print *,'U,def,Ntime,Nstart,NIT,speed,SCIS,seed1,Nx,dT'
|
||||
!print *,U,def,Ntime,Nstart,NIT,speed,SCIS,seed1,Nx,dT
|
||||
!XSPLT=1.5d0
|
||||
if (SCIS.GT.0) then
|
||||
allocate(COV(1:Nx))
|
||||
call random_seed(SIZE=seed_size)
|
||||
allocate(seed(seed_size))
|
||||
call random_seed(GET=seed(1:seed_size)) ! get current seed
|
||||
seed(1)=seed1 ! change seed
|
||||
call random_seed(PUT=seed(1:seed_size))
|
||||
deallocate(seed)
|
||||
endif
|
||||
CALL INITDATA(speed)
|
||||
!print *,ntime,speed,u,NIT
|
||||
allocate(R0(1:Ntime+1))
|
||||
allocate(R1(1:Ntime+1))
|
||||
allocate(R2(1:Ntime+1))
|
||||
if (abs(def).GT.1) THEN
|
||||
allocate(R3(1:Ntime+1))
|
||||
allocate(R4(1:Ntime+1))
|
||||
!CALL INIT_AMPLITUDES(h,def,Nx)
|
||||
endif
|
||||
allocate(h(1:Nx))
|
||||
CALL INIT_AMPLITUDES(h,def,Nx)
|
||||
CALL INIT_COVARIANCES(Ntime,def,R0,R1,R2,R3,R4)
|
||||
|
||||
NI=4; Nd=2
|
||||
Nc=3; Mb=2
|
||||
|
||||
Nj=0
|
||||
indI(1)=0
|
||||
C ***** The bound 'infinity' is set to 10*sigma *****
|
||||
XdInf=10.d0*SQRT(-R2(1))
|
||||
XtInf=10.d0*SQRT(R0(1))
|
||||
! normalizing constant
|
||||
CC=TWOPI*SQRT(-R0(1)/R2(1))*exp(u*u/(2.d0*R0(1)) )
|
||||
|
||||
allocate(CY(1:Nx))
|
||||
do icy=1,Nx
|
||||
CY(icy)=exp(-0.5*h(icy)*h(icy)/100)/(10*sqrt(twopi))
|
||||
enddo
|
||||
allocate(BIG(1:Ntime+Nc,1:Ntime+Nc),stat=status)
|
||||
if (status.ne.0) then
|
||||
print *,'can not allocate BIG'
|
||||
end if
|
||||
allocate(ex(1:Ntime+Nc),stat=status)
|
||||
if (status.ne.0) then
|
||||
print *,'can not allocate ex'
|
||||
end if
|
||||
allocate(ansr(1:Ntime,1:Nx))
|
||||
ansr=0.d0
|
||||
allocate(fxind(1:Nx))
|
||||
fxind=0.d0 !this is not needed
|
||||
allocate(xc(1:Nc,1:Nx))
|
||||
|
||||
|
||||
allocate(a_up(Mb,NI-1))
|
||||
allocate(a_lo(Mb,NI-1))
|
||||
a_up=0.d0
|
||||
a_lo=0.d0
|
||||
xc(1,1:Nx)=h(1:Nx)
|
||||
xc(2,1:Nx)=u
|
||||
xc(3,1:Nx)=u
|
||||
|
||||
if (def.GT.0) then
|
||||
a_up(1,1)=0.d0
|
||||
a_lo(1,1)=u
|
||||
a_up(1,2)=XdInf
|
||||
a_lo(1,3)=-XdInf
|
||||
a_up(2,1)=1.d0
|
||||
else
|
||||
a_up(1,1)=u
|
||||
a_lo(1,1)=0.d0
|
||||
a_lo(1,2)=-XdInf
|
||||
a_up(1,3)= XdInf
|
||||
a_lo(2,1)=1.d0
|
||||
endif
|
||||
!print *,'Nstart',Nstart
|
||||
Nstart=MAX(3,Nstart)
|
||||
|
||||
|
||||
if (SCIS.GT.0) then
|
||||
open (unit=11, file='COV.out', STATUS='unknown')
|
||||
write(11,*) 0.d0
|
||||
endif
|
||||
|
||||
!print *,'loop starts'
|
||||
do Ntd=Nstart,Ntime
|
||||
|
||||
Ntdc=Ntd+Nc
|
||||
ex=0.d0
|
||||
BIG=0.d0
|
||||
CALL COV_INPUT(BIG(1:Ntdc,1:Ntdc),Ntd,-1,R0,R1,R2,R3,R4) ! positive wave period
|
||||
C CALL ECHO(BIG(1:2,1:2))
|
||||
Nt=Ntd-Nd;
|
||||
indI(2)=Nt;
|
||||
indI(3)=Nt+1;
|
||||
indI(4)=Ntd;
|
||||
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex,xc,indI,a_lo,a_up)
|
||||
!print *,'test',fxind/CY(1:Nx)
|
||||
|
||||
do icy=1,Nx
|
||||
ansr(Ntd,icy)=fxind(icy)*CC/CY(icy)
|
||||
enddo
|
||||
if (SCIS.GT.0) then
|
||||
write(11,*) COV(1) ! save coefficient of variation
|
||||
endif
|
||||
if((Nx.gt.4).or.NIT.gt.5) print *,'Ready: ',Ntd,' of ',Ntime
|
||||
enddo
|
||||
goto 300
|
||||
300 open (unit=11, file='dens.out', STATUS='unknown')
|
||||
|
||||
!print *, ansr
|
||||
do ts=1,Ntime
|
||||
do ph=1,Nx
|
||||
write(11,*) ansr(ts,ph)
|
||||
enddo
|
||||
enddo
|
||||
!111 FORMAT(2x,F12.8)
|
||||
close(11)
|
||||
900 continue
|
||||
deallocate(BIG)
|
||||
deallocate(ex)
|
||||
deallocate(fxind)
|
||||
deallocate(ansr)
|
||||
deallocate(xc)
|
||||
deallocate(R0)
|
||||
deallocate(R1)
|
||||
deallocate(R2)
|
||||
if (allocated(COV) ) then
|
||||
deallocate(COV)
|
||||
endif
|
||||
|
||||
if (allocated(R3)) then
|
||||
deallocate(R3)
|
||||
deallocate(R4)
|
||||
deallocate(h)
|
||||
ENDIF
|
||||
stop
|
||||
!return
|
||||
|
||||
CONTAINS
|
||||
|
||||
|
||||
|
||||
SUBROUTINE INIT_LEVELS
|
||||
& (U,def,Ntime,Nstart,NIT,speed,Nx,dT)
|
||||
IMPLICIT NONE
|
||||
integer, intent(out):: def,Ntime,Nstart,NIT,speed,Nx
|
||||
double precision ,intent(out) :: U,dT
|
||||
|
||||
|
||||
OPEN(UNIT=14,FILE='reflev.in',STATUS= 'UNKNOWN')
|
||||
READ (14,*) U
|
||||
READ (14,*) def
|
||||
READ (14,*) Ntime
|
||||
READ (14,*) Nstart
|
||||
READ (14,*) NIT
|
||||
READ (14,*) speed
|
||||
READ (14,*) SCIS
|
||||
READ (14,*) seed1
|
||||
READ (14,*) Nx
|
||||
|
||||
if (abs(def).GT.1) then
|
||||
READ (14,*) dT
|
||||
if (Ntime.lt.3) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
else
|
||||
if (Ntime.lt.2) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
endif
|
||||
CLOSE(UNIT=14)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_LEVELS
|
||||
|
||||
C******************************************************
|
||||
SUBROUTINE INIT_AMPLITUDES(h,def,Nx)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:), intent(out) :: h
|
||||
integer, intent(in) :: def
|
||||
integer, intent(in) :: Nx
|
||||
integer :: ix
|
||||
|
||||
|
||||
OPEN(UNIT=4,FILE='h.in',STATUS= 'UNKNOWN')
|
||||
|
||||
C
|
||||
C Reading in amplitudes
|
||||
C
|
||||
do ix=1,Nx
|
||||
READ (4,*) H(ix)
|
||||
enddo
|
||||
CLOSE(UNIT=4)
|
||||
!if (def.LT.0) THEN
|
||||
! H=-H
|
||||
!endif
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_AMPLITUDES
|
||||
|
||||
C**************************************************
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
SUBROUTINE INIT_COVARIANCES(Ntime,def,R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:),intent(out) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(out) :: R3,R4
|
||||
integer,intent(in) :: Ntime,def
|
||||
integer :: i
|
||||
open (unit=1, file='Cd0.in',STATUS='unknown')
|
||||
open (unit=2, file='Cd1.in',STATUS='unknown')
|
||||
open (unit=3, file='Cd2.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(1,*) R0(i)
|
||||
read(2,*) R1(i)
|
||||
read(3,*) R2(i)
|
||||
enddo
|
||||
close(1)
|
||||
close(2)
|
||||
close(3)
|
||||
|
||||
if (abs(def).GT.1) then
|
||||
open (unit=4, file='Cd3.in',STATUS='unknown')
|
||||
open (unit=5, file='Cd4.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(4,*) R3(i)
|
||||
read(5,*) R4(i)
|
||||
enddo
|
||||
|
||||
close(4)
|
||||
close(5)
|
||||
endif
|
||||
return
|
||||
END SUBROUTINE INIT_COVARIANCES
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
C**********************************************************************
|
||||
|
||||
SUBROUTINE COV_INPUT(BIG,tn,ts, R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),intent(inout) :: BIG
|
||||
double precision, dimension(:),intent(in) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(in) :: R3,R4
|
||||
integer ,intent(in) :: tn,ts
|
||||
integer :: i,j,shft,Ntd1,N !=Ntdc
|
||||
double precision :: tmp
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows:
|
||||
! For ts>1:
|
||||
! X(t2)..X(ts),..X(tn-1) X''(ts) X'(t1) X'(tn) X(ts) X(t1) X(tn) X'(ts)
|
||||
! = [Xt Xd Xc]
|
||||
!
|
||||
! For ts<=1:
|
||||
! X(t2)..,..X(tn-1) X'(t1) X'(tn) Y X(t1) X(tn)
|
||||
! = [Xt Xd Xc]
|
||||
!Add Y Condition : Y=h
|
||||
|
||||
! where
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
if (ts.LE.1) THEN
|
||||
Ntd1=tn
|
||||
N=Ntd1+Nc;
|
||||
shft=0 ! def=1 want only crest period Tc
|
||||
else
|
||||
Ntd1=tn+1
|
||||
N=Ntd1+4
|
||||
shft=1 ! def=2 or 3 want Tc Ac or Tcf, Ac
|
||||
endif
|
||||
|
||||
do i=1,tn-2
|
||||
!cov(Xt)
|
||||
do j=i,tn-2
|
||||
BIG(i,j) = R0(j-i+1) ! cov(X(ti+1),X(tj+1))
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
BIG(i ,Ntd1+1+shft) = 0.d0 !cov(X(ti+1),Y)
|
||||
BIG(i ,Ntd1+2+shft) = R0(i+1) !cov(X(ti+1),X(t1))
|
||||
BIG(tn-1-i ,Ntd1+3+shft) = R0(i+1) !cov(X(t.. ),X(tn))
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj)
|
||||
BIG(i,Ntd1-1) =-R1(i+1) !cov(X(ti+1),X' (t1))
|
||||
BIG(tn-1-i,Ntd1)= R1(i+1) !cov(X(ti+1),X' (tn))
|
||||
enddo
|
||||
!call echo(big(1:tn,1:tn),tn)
|
||||
!cov(Xd)
|
||||
BIG(Ntd1 ,Ntd1 ) = -R2(1)
|
||||
BIG(Ntd1-1,Ntd1 ) = -R2(tn) !cov(X'(t1),X'(tn))
|
||||
BIG(Ntd1-1,Ntd1-1) = -R2(1)
|
||||
|
||||
!cov(Xc)
|
||||
!print *,'t'
|
||||
BIG(Ntd1+1+shft,Ntd1+1+shft) = 100.d0!100.d0 ! cov(Y,Y)
|
||||
BIG(Ntd1+1+shft,Ntd1+2+shft) = 0.d0
|
||||
BIG(Ntd1+1+shft,Ntd1+3+shft) = 0.d0
|
||||
BIG(Ntd1+2+shft,Ntd1+2+shft) = R0(1) ! cov(X(t1),X (t1))
|
||||
BIG(Ntd1+2+shft,Ntd1+3+shft) = R0(tn) ! cov(X(t1),X (tn))
|
||||
BIG(Ntd1+3+shft,Ntd1+3+shft) = R0(1) ! cov(X(tn),X (tn))
|
||||
!cov(Xd,Xc)
|
||||
BIG(Ntd1 ,Ntd1+1+shft) = 0.d0 !cov(X'(tn),Y)
|
||||
BIG(Ntd1 ,Ntd1+2+shft) = R1(tn) !cov(X'(tn),X(t1))
|
||||
BIG(Ntd1 ,Ntd1+3+shft) = 0.d0 !cov(X'(tn),X(tn))
|
||||
BIG(Ntd1-1,Ntd1+1+shft) = 0.d0 !cov(X'(t1),Y)
|
||||
BIG(Ntd1-1,Ntd1+2+shft) = 0.d0 !cov(X'(t1),X(t1))
|
||||
BIG(Ntd1-1,Ntd1+3+shft) =-R1(tn) !cov(X'(t1),X(tn))
|
||||
|
||||
|
||||
!call echo(big(1:N,1:N),N)
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,N-1
|
||||
do i=j+1,N
|
||||
tmp =BIG(j,i)
|
||||
BIG(i,j)=tmp
|
||||
enddo
|
||||
!call echo(big(1:N,1:N),N)
|
||||
enddo
|
||||
!if (tn.eq.3) then
|
||||
!do j=1,N
|
||||
! do i=j,N
|
||||
! print *,'test',j,i,BIG(j,i)
|
||||
! enddo
|
||||
!call echo(big(1:N,1:N),N)
|
||||
!enddo
|
||||
!endif
|
||||
!call echo(big(1:N,1:N),N)
|
||||
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT
|
||||
|
||||
SUBROUTINE COV_INPUT2(BIG,pt, R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:), intent(out) :: BIG
|
||||
double precision, dimension(:), intent(in) :: R0,R1,R2
|
||||
integer :: pt,i,j
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows;
|
||||
! X(t2)...X(tn-1) X'(t1) X'(tn) X(t1) X(tn) = [Xt Xd Xc]
|
||||
!
|
||||
! where Xd is the derivatives
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
!cov(Xc)
|
||||
BIG(pt+2,pt+2) = R0(1)
|
||||
BIG(pt+1,pt+1) = R0(1)
|
||||
BIG(pt+1,pt+2) = R0(pt)
|
||||
!cov(Xd)
|
||||
BIG(pt,pt) = -R2(1)
|
||||
BIG(pt-1,pt-1) = -R2(1)
|
||||
BIG(pt-1,pt) = -R2(pt)
|
||||
!cov(Xd,Xc)
|
||||
BIG(pt,pt+2) = 0.d0
|
||||
BIG(pt,pt+1) = R1(pt)
|
||||
BIG(pt-1,pt+2) = -R1(pt)
|
||||
BIG(pt-1,pt+1) = 0.d0
|
||||
|
||||
if (pt.GT.2) then
|
||||
!cov(Xt)
|
||||
do i=1,pt-2
|
||||
do j=i,pt-2
|
||||
BIG(i,j) = R0(j-i+1)
|
||||
enddo
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
do i=1,pt-2
|
||||
BIG(i,pt+1) = R0(i+1)
|
||||
BIG(pt-1-i,pt+2) = R0(i+1)
|
||||
enddo
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj))
|
||||
do i=1,pt-2
|
||||
BIG(i,pt-1) = -R1(i+1)
|
||||
BIG(pt-1-i,pt)= R1(i+1)
|
||||
enddo
|
||||
endif
|
||||
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,pt+1
|
||||
do i=j+1,pt+2
|
||||
BIG(i,j)=BIG(j,i)
|
||||
enddo
|
||||
enddo
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT2
|
||||
|
||||
|
||||
END PROGRAM sp2Acdf
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,357 +0,0 @@
|
||||
PROGRAM cov2mmpdf
|
||||
C*******************************************************************************
|
||||
C This program computes joint density of maximum and the following minimum *
|
||||
C*******************************************************************************
|
||||
use GLOBALDATA, only : Nt,Nj,Nd,Nc,Ntd,Ntdc,NI,Mb,
|
||||
&NIT,Nx,TWOPI,XSPLT,SCIS,NSIMmax,COV
|
||||
use rind
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),allocatable :: BIG
|
||||
double precision, dimension(:,:),allocatable :: ansr
|
||||
double precision, dimension(: ),allocatable :: ex
|
||||
double precision, dimension(:,:),allocatable :: xc
|
||||
double precision, dimension(: ),allocatable :: fxind,h
|
||||
double precision, dimension(: ),allocatable :: R0,R1,R2,R3,R4
|
||||
double precision ::CC,U,XddInf,XdInf,XtInf
|
||||
double precision, dimension(:,:),allocatable :: a_up,a_lo
|
||||
integer , dimension(: ),allocatable :: seed
|
||||
integer ,dimension(7) :: indI
|
||||
integer :: Nstart,Ntime,tn,ts,speed,seed1,seed_size
|
||||
integer :: status,i,j,ij,Nx1
|
||||
double precision :: ds,dT ! lag spacing for covariances
|
||||
|
||||
! f90 cov2mmpdf.f rind51.f
|
||||
|
||||
CALL INIT_LEVELS(Ntime,Nstart,NIT,speed,Nx1,dT)
|
||||
Nx=Nx1*(Nx1-1)/2
|
||||
if (SCIS.GT.0) then
|
||||
allocate(COV(1:Nx))
|
||||
call random_seed(SIZE=seed_size)
|
||||
allocate(seed(seed_size))
|
||||
call random_seed(GET=seed(1:seed_size)) ! get current seed
|
||||
seed(1)=seed1 ! change seed
|
||||
call random_seed(PUT=seed(1:seed_size))
|
||||
deallocate(seed)
|
||||
endif
|
||||
|
||||
CALL INITDATA(speed)
|
||||
|
||||
allocate(R0(1:Ntime+1))
|
||||
allocate(R1(1:Ntime+1))
|
||||
allocate(R2(1:Ntime+1))
|
||||
allocate(R3(1:Ntime+1))
|
||||
allocate(R4(1:Ntime+1))
|
||||
allocate(h(1:Nx1))
|
||||
|
||||
CALL INIT_AMPLITUDES(h,Nx1)
|
||||
CALL INIT_COVARIANCES(Ntime,R0,R1,R2,R3,R4)
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! Y= X'(t2)...X'(tn-1)||X''(t1) X''(tn)|| X'(t1) X'(tn) X(t1) X(tn) !!
|
||||
! = [ Xt Xd Xc ] !!
|
||||
! !!
|
||||
! Nt=tn-2, Nd=2, Nc=4 !!
|
||||
! !!
|
||||
! Xt= contains Nt time points in the indicator function !!
|
||||
! Xd= " Nd derivatives !!
|
||||
! Xc= " Nc variables to condition on !!
|
||||
! !!
|
||||
! There are 3 ( NI=4) regions with constant bariers: !!
|
||||
! (indI(1)=0); for i\in (indI(1),indI(2)] Y(i)<0. !!
|
||||
! (indI(2)=Nt) ; for i\in (indI(2)+1,indI(3)], Y(i)<0 (deriv. X''(t1)) !!
|
||||
! (indI(3)=Nt+1); for i\in (indI(3)+1,indI(4)], Y(i)>0 (deriv. X''(tn)) !!
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
||||
NI=4; Nd=2
|
||||
Nc=4; Mb=1
|
||||
|
||||
Nj=0
|
||||
indI(1)=0
|
||||
C ***** The bound 'infinity' is set to 10*sigma *****
|
||||
XdInf=10.d0*SQRT(R4(1))
|
||||
XtInf=10.d0*SQRT(-R2(1))
|
||||
! normalizing constant
|
||||
CC=TWOPI*SQRT(-R2(1)/R4(1))
|
||||
|
||||
allocate(BIG(1:Ntime+Nc,1:Ntime+Nc),stat=status)
|
||||
if (status.ne.0) then
|
||||
print *,'can not allocate BIG'
|
||||
end if
|
||||
allocate(ex(1:Ntime+Nc),stat=status)
|
||||
if (status.ne.0) then
|
||||
print *,'can not allocate ex'
|
||||
end if
|
||||
if (Nx.gt.1) then
|
||||
allocate(ansr(1:Nx1,1:Nx1))
|
||||
else
|
||||
allocate(ansr(1,1:Ntime))
|
||||
end if
|
||||
ansr=0.d0
|
||||
allocate(fxind(1:Nx))
|
||||
fxind=0.d0 !this is not needed
|
||||
allocate(xc(1:Nc,1:Nx))
|
||||
|
||||
|
||||
allocate(a_up(Mb,NI-1))
|
||||
allocate(a_lo(Mb,NI-1))
|
||||
|
||||
a_up=0.d0
|
||||
a_lo=0.d0
|
||||
|
||||
ij=0
|
||||
do i=2,Nx1
|
||||
do j=1,i-1
|
||||
ij=ij+1
|
||||
xc(3,ij)=h(i)
|
||||
xc(4,ij)=h(j)
|
||||
enddo
|
||||
enddo
|
||||
xc(1,1:Nx)=0.d0
|
||||
xc(2,1:Nx)=0.d0
|
||||
|
||||
a_lo(1,1)=-Xtinf
|
||||
a_lo(1,2)=-XdInf
|
||||
a_up(1,3)=+XdInf
|
||||
|
||||
|
||||
Nstart=MAX(2,Nstart)
|
||||
|
||||
|
||||
if (SCIS.GT.0) then
|
||||
open (unit=11, file='COV.out', STATUS='unknown')
|
||||
write(11,*) 0.d0
|
||||
endif
|
||||
|
||||
do Ntd=Nstart,Ntime
|
||||
|
||||
Ntdc=Ntd+Nc
|
||||
ex=0.d0
|
||||
BIG=0.d0
|
||||
CALL COV_INPUT(BIG(1:Ntdc,1:Ntdc),Ntd,R0,R1,R2,R3,R4) ! positive wave period
|
||||
|
||||
Nt=Ntd-Nd;
|
||||
indI(2)=Nt;
|
||||
indI(3)=Nt+1;
|
||||
indI(4)=Ntd;
|
||||
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex,xc,indI,a_lo,a_up)
|
||||
ij=0
|
||||
if (Nx .gt. 1) then
|
||||
do i=2,Nx1
|
||||
do j=1,i-1
|
||||
ij=ij+1
|
||||
ansr(i,j)=ansr(i,j)+fxind(ij)*CC*dt
|
||||
enddo
|
||||
enddo
|
||||
else
|
||||
ansr(1,Ntd)=fxind(1)*CC
|
||||
end if
|
||||
|
||||
if (SCIS.GT.0) then
|
||||
write(11,*) COV(1) ! save coefficient of variation
|
||||
endif
|
||||
print *,'Ready: ',Ntd,' of ',Ntime
|
||||
enddo
|
||||
goto 300
|
||||
300 open (unit=11, file='dens.out', STATUS='unknown')
|
||||
if (Nx.gt.1) then
|
||||
do i=1,Nx1
|
||||
do j=1,Nx1
|
||||
write(11,*) ansr(i,j)
|
||||
enddo
|
||||
enddo
|
||||
else
|
||||
do j=1,Ntime
|
||||
write(11,*) ansr(1,j)
|
||||
enddo
|
||||
end if
|
||||
close(11)
|
||||
900 continue
|
||||
deallocate(BIG)
|
||||
deallocate(ex)
|
||||
deallocate(fxind)
|
||||
deallocate(ansr)
|
||||
deallocate(xc)
|
||||
deallocate(R0)
|
||||
deallocate(R1)
|
||||
deallocate(R2)
|
||||
deallocate(R3)
|
||||
deallocate(R4)
|
||||
deallocate(h)
|
||||
|
||||
if (allocated(COV) ) then
|
||||
deallocate(COV)
|
||||
endif
|
||||
stop
|
||||
!return
|
||||
|
||||
CONTAINS
|
||||
|
||||
|
||||
|
||||
SUBROUTINE INIT_LEVELS
|
||||
& (Ntime,Nstart,NIT,speed,Nx,dT)
|
||||
IMPLICIT NONE
|
||||
integer, intent(out):: Ntime,Nstart,NIT,speed,Nx
|
||||
double precision ,intent(out) :: dT
|
||||
|
||||
|
||||
OPEN(UNIT=14,FILE='reflev.in',STATUS= 'UNKNOWN')
|
||||
READ (14,*) Ntime
|
||||
READ (14,*) Nstart
|
||||
READ (14,*) NIT
|
||||
READ (14,*) speed
|
||||
READ (14,*) SCIS
|
||||
READ (14,*) seed1
|
||||
READ (14,*) Nx
|
||||
READ (14,*) dT
|
||||
|
||||
if (Ntime.lt.2) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
CLOSE(UNIT=14)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_LEVELS
|
||||
|
||||
C******************************************************
|
||||
SUBROUTINE INIT_AMPLITUDES(h,Nx)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:), intent(out) :: h
|
||||
integer, intent(in) :: Nx
|
||||
integer :: ix
|
||||
|
||||
|
||||
OPEN(UNIT=4,FILE='h.in',STATUS= 'UNKNOWN')
|
||||
|
||||
C
|
||||
C Reading in amplitudes
|
||||
C
|
||||
do ix=1,Nx
|
||||
READ (4,*) H(ix)
|
||||
enddo
|
||||
CLOSE(UNIT=4)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_AMPLITUDES
|
||||
|
||||
C**************************************************
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
SUBROUTINE INIT_COVARIANCES(Ntime,R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:),intent(out) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(out) :: R3,R4
|
||||
integer,intent(in) :: Ntime
|
||||
integer :: i
|
||||
open (unit=1, file='Cd0.in',STATUS='unknown')
|
||||
open (unit=2, file='Cd1.in',STATUS='unknown')
|
||||
open (unit=3, file='Cd2.in',STATUS='unknown')
|
||||
open (unit=4, file='Cd3.in',STATUS='unknown')
|
||||
open (unit=5, file='Cd4.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(1,*) R0(i)
|
||||
read(2,*) R1(i)
|
||||
read(3,*) R2(i)
|
||||
read(4,*) R3(i)
|
||||
read(5,*) R4(i)
|
||||
enddo
|
||||
close(1)
|
||||
close(2)
|
||||
close(3)
|
||||
close(3)
|
||||
close(5)
|
||||
return
|
||||
END SUBROUTINE INIT_COVARIANCES
|
||||
|
||||
C**********************************************************************
|
||||
|
||||
SUBROUTINE COV_INPUT(BIG,tn,R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),intent(inout) :: BIG
|
||||
double precision, dimension(:),intent(in) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(in) :: R3,R4
|
||||
integer ,intent(in) :: tn
|
||||
integer :: i,j,N
|
||||
double precision :: tmp
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows:
|
||||
! X'(t2)..X'(ts),...,X'(tn-1) X''(t1),X''(tn) X'(t1),X'(tn),X(t1),X(tn)
|
||||
! = [ Xt | Xd | Xc ]
|
||||
!
|
||||
! where
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
! Computations of all covariances follows simple rules: Cov(X(t),X(s))=r(t,s),
|
||||
! then Cov(X'(t),X(s))=dr(t,s)/dt. Now for stationary X(t) we have
|
||||
! a function r(tau) such that Cov(X(t),X(s))=r(s-t) (or r(t-s) will give the same result).
|
||||
!
|
||||
! Consequently Cov(X'(t),X(s)) = -r'(s-t) = -sign(s-t)*r'(|s-t|)
|
||||
! Cov(X'(t),X'(s)) = -r''(s-t) = -r''(|s-t|)
|
||||
! Cov(X''(t),X'(s)) = r'''(s-t) = sign(s-t)*r'''(|s-t|)
|
||||
! Cov(X''(t),X(s)) = r''(s-t) = r''(|s-t|)
|
||||
! Cov(X''(t),X''(s)) = r''''(s-t) = r''''(|s-t|)
|
||||
|
||||
N=tn+4
|
||||
do i=1,tn-2
|
||||
!cov(Xt)
|
||||
do j=i,tn-2
|
||||
BIG(i,j) = -R2(j-i+1) ! cov(X'(ti+1),X'(tj+1))
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
BIG(i ,tn+3) = R1(i+1) !cov(X'(ti+1),X(t1))
|
||||
BIG(tn-1-i ,tn+4) = -R1(i+1) !cov(X'(ti+1),X(tn))
|
||||
BIG(i ,tn+1) = -R2(i+1) !cov(X'(ti+1),X'(t1))
|
||||
BIG(tn-1-i ,tn+2) = -R2(i+1) !cov(X'(ti+1),X'(tn))
|
||||
!Cov(Xt,Xd)
|
||||
BIG(i,tn-1) = R3(i+1) !cov(X'(ti+1),X''(t1))
|
||||
BIG(tn-1-i,tn) =-R3(i+1) !cov(X'(ti+1),X''(tn))
|
||||
enddo
|
||||
|
||||
!cov(Xd)
|
||||
BIG(tn-1 ,tn-1 ) = R4(1)
|
||||
BIG(tn-1,tn ) = R4(tn) !cov(X''(t1),X''(tn))
|
||||
BIG(tn ,tn ) = R4(1)
|
||||
|
||||
!cov(Xc)
|
||||
BIG(tn+3,tn+3) = R0(1) ! cov(X(t1),X(t1))
|
||||
BIG(tn+3,tn+4) = R0(tn) ! cov(X(t1),X(tn))
|
||||
BIG(tn+1,tn+3) = 0.d0 ! cov(X(t1),X'(t1))
|
||||
BIG(tn+2,tn+3) = R1(tn) ! cov(X(t1),X'(tn))
|
||||
BIG(tn+4,tn+4) = R0(1) ! cov(X(tn),X(tn))
|
||||
BIG(tn+1,tn+4) =-R1(tn) ! cov(X(tn),X'(t1))
|
||||
BIG(tn+2,tn+4) = 0.d0 ! cov(X(tn),X'(tn))
|
||||
BIG(tn+1,tn+1) =-R2(1) ! cov(X'(t1),X'(t1))
|
||||
BIG(tn+1,tn+2) =-R2(tn) ! cov(X'(t1),X'(tn))
|
||||
BIG(tn+2,tn+2) =-R2(1) ! cov(X'(tn),X'(tn))
|
||||
!Xc=X(t1),X(tn),X'(t1),X'(tn)
|
||||
!Xd=X''(t1),X''(tn)
|
||||
!cov(Xd,Xc)
|
||||
BIG(tn-1 ,tn+3) = R2(1) !cov(X''(t1),X(t1))
|
||||
BIG(tn-1 ,tn+4) = R2(tn) !cov(X''(t1),X(tn))
|
||||
BIG(tn-1 ,tn+1) = 0.d0 !cov(X''(t1),X'(t1))
|
||||
BIG(tn-1 ,tn+2) = R3(tn) !cov(X''(t1),X'(tn))
|
||||
BIG(tn ,tn+3) = R2(tn) !cov(X''(tn),X(t1))
|
||||
BIG(tn ,tn+4) = R2(1) !cov(X''(tn),X(tn))
|
||||
BIG(tn ,tn+1) =-R3(tn) !cov(X''(tn),X'(t1))
|
||||
BIG(tn ,tn+2) = 0.d0 !cov(X''(tn),X'(tn))
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,N-1
|
||||
do i=j+1,N
|
||||
tmp =BIG(j,i)
|
||||
BIG(i,j)=tmp
|
||||
enddo
|
||||
enddo
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT
|
||||
|
||||
|
||||
END PROGRAM cov2mmpdf
|
||||
|
||||
@ -1,769 +0,0 @@
|
||||
PROGRAM sp2mmt
|
||||
C*******************************************************************************
|
||||
C This program computes joint density of the maximum and the following *
|
||||
C minimum or level u separated maxima and minima + period/wavelength *
|
||||
C*******************************************************************************
|
||||
use GLOBALDATA, only : Nt,Nj,Nd,Nc,Ntd,Ntdc,NI,Mb,
|
||||
&NIT,Nx,TWOPI,XSPLT,SCIS,NSIMmax,COV
|
||||
use rind
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:), allocatable :: BIG
|
||||
double precision, dimension(:,:,:),allocatable :: ansr
|
||||
double precision, dimension(: ), allocatable :: ex
|
||||
double precision, dimension(:,:), allocatable :: xc
|
||||
double precision, dimension(: ), allocatable :: fxind,h
|
||||
double precision, dimension(: ), allocatable :: R0,R1,R2,R3,R4
|
||||
double precision :: CC,U,XdInf,XtInf
|
||||
double precision, dimension(1,4) :: a_up,a_lo ! size Mb X NI-1
|
||||
integer , dimension(: ), allocatable :: seed
|
||||
integer ,dimension(5) :: indI = 0 ! length NI
|
||||
integer :: Nstart,Ntime,ts,tn,speed,seed1,seed_size
|
||||
integer :: status,i,j,ij,Nx0,Nx1,DEF,isOdd !,TMP
|
||||
LOGICAL :: SYMMETRY=.FALSE.
|
||||
double precision :: dT ! lag spacing for covariances
|
||||
|
||||
! f90 -gline -fieee -Nl126 -C -o intmodule.f rind60.f sp2mmt.f
|
||||
|
||||
CALL INIT_LEVELS(Ntime,Nstart,NIT,speed,SCIS,SEED1,Nx1,dT,u,def)
|
||||
CALL INITDATA(speed)
|
||||
|
||||
if (SCIS.GT.0) then
|
||||
!allocate(COV(1:Nx))
|
||||
call random_seed(SIZE=seed_size)
|
||||
allocate(seed(seed_size))
|
||||
call random_seed(GET=seed(1:seed_size)) ! get current seed
|
||||
seed(1)=seed1 ! change seed
|
||||
call random_seed(PUT=seed(1:seed_size))
|
||||
deallocate(seed)
|
||||
if (ALLOCATED(COV)) then
|
||||
open (unit=11, file='COV.out', STATUS='unknown')
|
||||
write(11,*) 0.d0
|
||||
endif
|
||||
endif
|
||||
|
||||
allocate(R0(1:Ntime+1))
|
||||
allocate(R1(1:Ntime+1))
|
||||
allocate(R2(1:Ntime+1))
|
||||
allocate(R3(1:Ntime+1))
|
||||
allocate(R4(1:Ntime+1))
|
||||
|
||||
Nx0 = Nx1 ! just plain Mm
|
||||
IF (def.GT.1) Nx0=2*Nx1 ! level v separated max2min densities wanted
|
||||
|
||||
|
||||
allocate(h(1:Nx0))
|
||||
|
||||
CALL INIT_AMPLITUDES(h,Nx0)
|
||||
CALL INIT_COVARIANCES(Ntime,R0,R1,R2,R3,R4)
|
||||
! For DEF = 0,1 : (Maxima, Minima and period/wavelength)
|
||||
! = 2,3 : (Level v separated Maxima and Minima and period/wavelength between them)
|
||||
! If Nx==1 then the conditional density for period/wavelength between Maxima and Minima
|
||||
! given the Max and Min is returned
|
||||
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
! Y= X'(t2)..X'(ts)..X'(tn-1)||X''(t1) X''(tn)|| X'(t1) X'(tn) X(t1) X(tn)
|
||||
! = [ Xt Xd Xc ]
|
||||
!
|
||||
! Nt = tn-2, Nd = 2, Nc = 4
|
||||
!
|
||||
! Xt= contains Nt time points in the indicator function
|
||||
! Xd= " Nd derivatives in Jacobian
|
||||
! Xc= " Nc variables to condition on
|
||||
!
|
||||
! There are 3 (NI=4) regions with constant barriers:
|
||||
! (indI(1)=0); for i\in (indI(1),indI(2)] Y(i)<0.
|
||||
! (indI(2)=Nt) ; for i\in (indI(2)+1,indI(3)], Y(i)<0 (deriv. X''(t1))
|
||||
! (indI(3)=Nt+1); for i\in (indI(3)+1,indI(4)], Y(i)>0 (deriv. X''(tn))
|
||||
!
|
||||
!
|
||||
! For DEF = 4,5 (Level v separated Maxima and Minima and period/wavelength from Max to crossing)
|
||||
! If Nx==1 then the conditional joint density for period/wavelength between Maxima, Minima and Max to
|
||||
! level v crossing given the Max and the min is returned
|
||||
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
! Y= X'(t2)..X'(ts)..X'(tn-1)||X''(t1) X''(tn) X'(ts)|| X'(t1) X'(tn) X(t1) X(tn) X(ts)
|
||||
! = [ Xt Xd Xc ]
|
||||
!
|
||||
! Nt = tn-2, Nd = 3, Nc = 5
|
||||
!
|
||||
! Xt= contains Nt time points in the indicator function
|
||||
! Xd= " Nd derivatives
|
||||
! Xc= " Nc variables to condition on
|
||||
!
|
||||
! There are 4 (NI=5) regions with constant barriers:
|
||||
! (indI(1)=0); for i\in (indI(1),indI(2)] Y(i)<0.
|
||||
! (indI(2)=Nt) ; for i\in (indI(2)+1,indI(3)], Y(i)<0 (deriv. X''(t1))
|
||||
! (indI(3)=Nt+1); for i\in (indI(3)+1,indI(4)], Y(i)>0 (deriv. X''(tn))
|
||||
! (indI(4)=Nt+2); for i\in (indI(4)+1,indI(5)], Y(i)<0 (deriv. X'(ts))
|
||||
!
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
!
|
||||
!Revised pab 22.04.2000
|
||||
! - added mean separated min/max + (Tdm, TMd) period distributions
|
||||
! - added scis
|
||||
|
||||
|
||||
C ***** The bound 'infinity' is set to 10*sigma *****
|
||||
XdInf = 10.d0*SQRT(R4(1))
|
||||
XtInf = 10.d0*SQRT(-R2(1))
|
||||
|
||||
Nc = 4
|
||||
NI=4; Nd=2;
|
||||
Mb=1 ;
|
||||
Nj = 0
|
||||
indI(1) = 0
|
||||
Nstart=MAX(2,Nstart)
|
||||
|
||||
isOdd = MOD(Nx1,2)
|
||||
IF (def.LE.1) THEN ! just plain Mm
|
||||
Nx = Nx1*(Nx1-1)/2
|
||||
IJ = (Nx1+isOdd)/2
|
||||
IF (H(1)+H(Nx1).EQ.0.AND.
|
||||
& (H(IJ).EQ.0.OR.H(IJ)+H(IJ+1).EQ.0) ) THEN
|
||||
SYMMETRY=.FALSE.
|
||||
PRINT *,' Integration region symmetric'
|
||||
! May save Nx1-isOdd integrations in each time step
|
||||
! This is not implemented yet.
|
||||
!Nx = Nx1*(Nx1-1)/2-Nx1+isOdd
|
||||
ENDIF
|
||||
|
||||
CC = TWOPI*SQRT(-R2(1)/R4(1)) ! normalizing constant = 1/ expected number of zero-up-crossings of X'
|
||||
|
||||
ELSE ! level u separated Mm
|
||||
Nx = (Nx1-1)*(Nx1-1)
|
||||
IF ( ABS(u).LE.1D-8.AND.H(1)+H(Nx1+1).EQ.0.AND.
|
||||
& (H(Nx1)+H(2*Nx1).EQ.0) ) THEN
|
||||
SYMMETRY=.FALSE.
|
||||
PRINT *,' Integration region symmetric'
|
||||
! Not implemented for DEF <= 3
|
||||
!IF (DEF.LE.3) Nx = (Nx1-1)*(Nx1-2)/2
|
||||
ENDIF
|
||||
|
||||
IF (DEF.GT.3) THEN
|
||||
Nstart = MAX(Nstart,3)
|
||||
Nc = 5
|
||||
NI=5; Nd=3;
|
||||
ENDIF
|
||||
CC = TWOPI*SQRT(-R0(1)/R2(1))*exp(0.5D0*u*u/R0(1)) ! normalizing constant= 1/ expected number of u-up-crossings of X
|
||||
ENDIF
|
||||
|
||||
!print *,'def',def
|
||||
IF (Nx.GT.1) THEN
|
||||
IF ((DEF.EQ.0.OR.DEF.EQ.2)) THEN ! (M,m) or (M,m)v distribution wanted
|
||||
allocate(ansr(Nx1,Nx1,1),stat=status)
|
||||
ELSE ! (M,m,TMm), (M,m,TMm)v (M,m,TMd)v or (M,M,Tdm)v distributions wanted
|
||||
allocate(ansr(Nx1,Nx1,Ntime),stat=status)
|
||||
ENDIF
|
||||
ELSEIF (DEF.GT.3) THEN ! Conditional distribution for (TMd,TMm)v or (Tdm,TMm)v given (M,m) wanted
|
||||
allocate(ansr(1,Ntime,Ntime),stat=status)
|
||||
ELSE ! Conditional distribution for (TMm) or (TMm)v given (M,m) wanted
|
||||
allocate(ansr(1,1,Ntime),stat=status)
|
||||
ENDIF
|
||||
if (status.ne.0) print *,'can not allocate ansr'
|
||||
allocate(BIG(Ntime+Nc+1,Ntime+Nc+1),stat=status)
|
||||
if (status.ne.0) print *,'can not allocate BIG'
|
||||
allocate(ex(1:Ntime+Nc+1),stat=status)
|
||||
if (status.ne.0) print *,'can not allocate ex'
|
||||
allocate(fxind(Nx),xc(Nc,Nx))
|
||||
|
||||
|
||||
! Initialization
|
||||
!~~~~~~~~~~~~~~~~~
|
||||
|
||||
BIG = 0.d0
|
||||
ex = 0.d0
|
||||
ansr = 0.d0
|
||||
a_up = 0.d0
|
||||
a_lo = 0.d0
|
||||
|
||||
xc(:,:) = 0.d0
|
||||
!xc(:,1:Nx) = 0.d0
|
||||
!xc(2,1:Nx) = 0.d0
|
||||
|
||||
a_lo(1,1) = -Xtinf
|
||||
a_lo(1,2) = -XdInf
|
||||
a_up(1,3) = +XdInf
|
||||
a_lo(1,4) = -Xtinf
|
||||
ij = 0
|
||||
IF (DEF.LE.1) THEN ! Max2min and period/wavelength
|
||||
do I=2,Nx1
|
||||
J = IJ+I-1
|
||||
xc(3,IJ+1:J) = h(I)
|
||||
xc(4,IJ+1:J) = h(1:I-1)
|
||||
IJ = J
|
||||
enddo
|
||||
ELSE
|
||||
! Level u separated Max2min
|
||||
xc(Nc,:) = u
|
||||
! H(1) = H(Nx1+1)= u => start do loop at I=2 since by definition we must have: minimum<u-level<Maximum
|
||||
do i=2,Nx1
|
||||
J = IJ+Nx1-1
|
||||
xc(3,IJ+1:J) = h(i) ! Max > u
|
||||
xc(4,IJ+1:J) = h(Nx1+2:2*Nx1) ! Min < u
|
||||
IJ = J
|
||||
enddo
|
||||
|
||||
!CALL ECHO(transpose(xc(3:5,:)))
|
||||
if (DEF.GT.3) GOTO 200
|
||||
ENDIF
|
||||
do Ntd = Nstart,Ntime
|
||||
!Ntd=tn
|
||||
Ntdc = Ntd+Nc
|
||||
Nt = Ntd-Nd;
|
||||
indI(2) = Nt;
|
||||
indI(3) = Nt+1;
|
||||
indI(4) = Ntd;
|
||||
CALL COV_INPUT(BIG(1:Ntdc,1:Ntdc),Ntd,0,R0,R1,R2,R3,R4) ! positive wave period
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex,xc,indI,a_lo,a_up)
|
||||
IF (Nx.LT.2) THEN
|
||||
! Density of TMm given the Max and the Min. Note that the density is not scaled to unity
|
||||
ansr(1,1,Ntd) = fxind(1)*CC
|
||||
GOTO 100
|
||||
ENDIF
|
||||
IJ = 0
|
||||
SELECT CASE (DEF)
|
||||
CASE(:0)
|
||||
! joint density of (M,m)
|
||||
!~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
do i = 2, Nx1
|
||||
J = IJ+i-1
|
||||
ansr(1:i-1,i,1) = ansr(1:i-1,i,1)+fxind(ij+1:J)*CC*dt
|
||||
IJ=J
|
||||
enddo
|
||||
CASE (1)
|
||||
! joint density of (M,m,TMm)
|
||||
do i = 2, Nx1
|
||||
J = IJ+i-1
|
||||
ansr(1:i-1,i,Ntd) = fxind(ij+1:J)*CC
|
||||
IJ = J
|
||||
enddo
|
||||
CASE (2)
|
||||
! joint density of level v separated (M,m)v
|
||||
do i = 2,Nx1
|
||||
J = IJ+Nx1-1
|
||||
ansr(2:Nx1,i,1) = ansr(2:Nx1,i,1)+fxind(ij+1:J)*CC*dt
|
||||
IJ = J
|
||||
enddo
|
||||
CASE (3:)
|
||||
! joint density of level v separated (M,m,TMm)v
|
||||
do i = 2,Nx1
|
||||
J = IJ+Nx1-1
|
||||
ansr(2:Nx1,i,Ntd) = ansr(2:Nx1,i,Ntd)+fxind(ij+1:J)*CC
|
||||
IJ = J
|
||||
enddo
|
||||
END SELECT
|
||||
|
||||
100 if (ALLOCATED(COV)) then
|
||||
write(11,*) COV(:) ! save coefficient of variation
|
||||
endif
|
||||
print *,'Ready: ',Ntd,' of ',Ntime
|
||||
enddo
|
||||
|
||||
goto 800
|
||||
|
||||
200 do tn = Nstart,Ntime
|
||||
Ntd = tn+1
|
||||
Ntdc = Ntd + Nc
|
||||
Nt = Ntd - Nd;
|
||||
indI(2) = Nt;
|
||||
indI(3) = Nt + 1;
|
||||
indI(4) = Nt + 2;
|
||||
indI(5) = Ntd;
|
||||
!CALL COV_INPUT2(BIG(1:Ntdc,1:Ntdc),tn,-2,R0,R1,R2,R3,R4) ! positive wave period
|
||||
IF (SYMMETRY) GOTO 300
|
||||
|
||||
do ts = 2,tn-1
|
||||
CALL COV_INPUT(BIG(1:Ntdc,1:Ntdc),tn,ts,R0,R1,R2,R3,R4) ! positive wave period
|
||||
!print *,'Big='
|
||||
!CALL ECHO(BIG(1:Ntdc,1:MIN(Ntdc,10)))
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex,xc,indI,a_lo,a_up)
|
||||
|
||||
SELECT CASE (def)
|
||||
CASE (:4)
|
||||
IF (Nx.EQ.1) THEN
|
||||
! Joint density (TMd,TMm) given the Max and the min. Note the density is not scaled to unity
|
||||
ansr(1,ts,tn) = fxind(1)*CC
|
||||
|
||||
ELSE
|
||||
! 4, gives level u separated Max2min and wave period from Max to the crossing of level u (M,m,TMd).
|
||||
ij = 0
|
||||
do i = 2,Nx1
|
||||
J = IJ+Nx1-1
|
||||
ansr(2:Nx1,i,ts) = ansr(2:Nx1,i,ts)+
|
||||
& fxind(ij+1:J)*CC*dt
|
||||
IJ = J
|
||||
enddo
|
||||
ENDIF
|
||||
CASE (5:)
|
||||
IF (Nx.EQ.1) THEN
|
||||
! Joint density (Tdm,TMm) given the Max and the min. Note the density is not scaled to unity
|
||||
ansr(1,tn-ts+1,tn) = fxind(1)*CC
|
||||
ELSE
|
||||
|
||||
! 5, gives level u separated Max2min and wave period from the crossing of level u to the min (M,m,Tdm).
|
||||
ij = 0
|
||||
do i = 2,Nx1
|
||||
J = IJ+Nx1-1
|
||||
ansr(2:Nx1,i,tn-ts+1)=ansr(2:Nx1,i,tn-ts+1)+
|
||||
& fxind(ij+1:J)*CC*dt
|
||||
IJ = J
|
||||
enddo
|
||||
ENDIF
|
||||
END SELECT
|
||||
if (ALLOCATED(COV)) then
|
||||
write(11,*) COV(:) ! save coefficient of variation
|
||||
endif
|
||||
enddo
|
||||
GOTO 400
|
||||
300 do ts = 2,FLOOR(DBLE(Ntd)/2.d0) ! Using the symmetry since U = 0 and the transformation is linear
|
||||
CALL COV_INPUT(BIG(1:Ntdc,1:Ntdc),tn,ts,R0,R1,R2,R3,R4) ! positive wave period
|
||||
!print *,'Big='
|
||||
!CALL ECHO(BIG(1:Ntdc,1:Ntdc))
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex,xc,indI,a_lo,a_up)
|
||||
IF (Nx.EQ.1) THEN
|
||||
! Joint density of (TMd,TMm),(Tdm,TMm) given the max and the min. Note that the density is not scaled to unity
|
||||
ansr(1,ts,tn) = fxind(1)*CC
|
||||
IF (ts.LT.tn-ts+1) THEN
|
||||
ansr(1,tn-ts+1,tn) = fxind(1)*CC
|
||||
ENDIF
|
||||
GOTO 350
|
||||
ENDIF
|
||||
IJ = 0
|
||||
SELECT CASE (def)
|
||||
CASE (:4)
|
||||
|
||||
! 4, gives level u separated Max2min and wave period from Max to the crossing of level u (M,m,TMd).
|
||||
do i = 2,Nx1
|
||||
j = ij+Nx1-1
|
||||
ansr(2:Nx1,i,ts) = ansr(2:Nx1,i,ts)+
|
||||
& fxind(ij+1:J)*CC*dt
|
||||
IF (ts.LT.tn-ts+1) THEN
|
||||
ansr(i,2:Nx1,tn-ts+1) =
|
||||
& ansr(i,2:Nx1,tn-ts+1)+fxind(ij+1:J)*CC*dt ! exploiting the symmetry
|
||||
ENDIF
|
||||
IJ = J
|
||||
enddo
|
||||
CASE (5:)
|
||||
! 5, gives level u separated Max2min and wave period from the crossing of level u to min (M,m,Tdm).
|
||||
do i = 2,Nx1
|
||||
J = IJ+Nx1-1
|
||||
|
||||
ansr(2:Nx1,i,tn-ts+1)=ansr(2:Nx1,i,tn-ts+1)+
|
||||
& fxind(ij+1:J)*CC*dt
|
||||
IF (ts.LT.tn-ts+1) THEN
|
||||
ansr(i,2:Nx1,ts) = ansr(i,2:Nx1,ts)+
|
||||
& fxind(ij+1:J)*CC*dt ! exploiting the symmetry
|
||||
ENDIF
|
||||
IJ = J
|
||||
enddo
|
||||
END SELECT
|
||||
350 enddo
|
||||
400 print *,'Ready: ',tn,' of ',Ntime
|
||||
enddo
|
||||
|
||||
|
||||
|
||||
|
||||
800 open (unit=11, file='dens.out', STATUS='unknown')
|
||||
!print *,'ans, IJ,def', shape(ansr),IJ,DEF
|
||||
if (Nx.GT.1) THEN
|
||||
ij = 1
|
||||
IF (DEF.GT.2.OR.DEF.EQ.1) IJ = Ntime
|
||||
!print *,'ans, IJ,def', size(ansr),IJ,DEF
|
||||
do ts = 1,ij
|
||||
do j=1,Nx1
|
||||
do i=1,Nx1
|
||||
write(11,*) ansr(i,j,ts)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
ELSE
|
||||
ij = 1
|
||||
IF (DEF.GT.3) IJ = Ntime
|
||||
!print *,'ans, IJ,def', size(ansr),IJ,DEF
|
||||
do ts = 1,Ntime
|
||||
do j = 1,ij
|
||||
write(11,*) ansr(1,j,ts)
|
||||
enddo
|
||||
enddo
|
||||
ENDIF
|
||||
close(11)
|
||||
900 continue
|
||||
deallocate(BIG)
|
||||
deallocate(ex)
|
||||
deallocate(fxind)
|
||||
deallocate(ansr)
|
||||
deallocate(xc)
|
||||
deallocate(R0)
|
||||
deallocate(R1)
|
||||
deallocate(R2)
|
||||
deallocate(R3)
|
||||
deallocate(R4)
|
||||
deallocate(h)
|
||||
|
||||
if (allocated(COV) ) then
|
||||
deallocate(COV)
|
||||
endif
|
||||
stop
|
||||
!return
|
||||
|
||||
CONTAINS
|
||||
|
||||
|
||||
|
||||
SUBROUTINE INIT_LEVELS
|
||||
& (Ntime,Nstart,NIT,speed,SCIS,SEED1,Nx,dT,u,def)
|
||||
IMPLICIT NONE
|
||||
integer, intent(out):: Ntime,Nstart,NIT,speed,Nx,DEF,SCIS,SEED1
|
||||
double precision ,intent(out) :: dT,U
|
||||
|
||||
|
||||
OPEN(UNIT=14,FILE='reflev.in',STATUS= 'UNKNOWN')
|
||||
READ (14,*) Ntime
|
||||
READ (14,*) Nstart
|
||||
READ (14,*) NIT
|
||||
READ (14,*) speed
|
||||
READ (14,*) SCIS
|
||||
READ (14,*) seed1
|
||||
READ (14,*) Nx
|
||||
READ (14,*) dT
|
||||
READ (14,*) U
|
||||
READ (14,*) DEF
|
||||
|
||||
if (Ntime.lt.2) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
CLOSE(UNIT=14)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_LEVELS
|
||||
|
||||
C******************************************************
|
||||
SUBROUTINE INIT_AMPLITUDES(h,Nx)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:), intent(out) :: h
|
||||
integer, intent(in) :: Nx
|
||||
integer :: ix
|
||||
|
||||
|
||||
OPEN(UNIT=4,FILE='h.in',STATUS= 'UNKNOWN')
|
||||
|
||||
C
|
||||
C Reading in amplitudes
|
||||
C
|
||||
do ix=1,Nx
|
||||
READ (4,*) H(ix)
|
||||
enddo
|
||||
CLOSE(UNIT=4)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_AMPLITUDES
|
||||
|
||||
C**************************************************
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
SUBROUTINE INIT_COVARIANCES(Ntime,R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:),intent(out) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(out) :: R3,R4
|
||||
integer,intent(in) :: Ntime
|
||||
integer :: i
|
||||
open (unit=1, file='Cd0.in',STATUS='unknown')
|
||||
open (unit=2, file='Cd1.in',STATUS='unknown')
|
||||
open (unit=3, file='Cd2.in',STATUS='unknown')
|
||||
open (unit=4, file='Cd3.in',STATUS='unknown')
|
||||
open (unit=5, file='Cd4.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(1,*) R0(i)
|
||||
read(2,*) R1(i)
|
||||
read(3,*) R2(i)
|
||||
read(4,*) R3(i)
|
||||
read(5,*) R4(i)
|
||||
enddo
|
||||
close(1)
|
||||
close(2)
|
||||
close(3)
|
||||
close(3)
|
||||
close(5)
|
||||
return
|
||||
END SUBROUTINE INIT_COVARIANCES
|
||||
|
||||
C**********************************************************************
|
||||
|
||||
SUBROUTINE COV_INPUT2(BIG,tn,ts,R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),intent(inout) :: BIG
|
||||
double precision, dimension(:),intent(in) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(in) :: R3,R4
|
||||
integer ,intent(in) :: tn,ts
|
||||
integer :: i,j,N,shft
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows:
|
||||
! for ts <= 1:
|
||||
! X'(t2)..X'(ts),...,X'(tn-1) X''(t1),X''(tn) X'(t1),X'(tn),X(t1),X(tn)
|
||||
! = [ Xt | Xd | Xc ]
|
||||
!
|
||||
! for ts > =2:
|
||||
! X'(t2)..X'(ts),...,X'(tn-1) X''(t1),X''(tn) X'(t1),X'(tn),X(t1),X(tn) X(ts)
|
||||
! = [ Xt | Xd | Xc ]
|
||||
!
|
||||
! where
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
! Computations of all covariances follows simple rules: Cov(X(t),X(s))=r(t,s),
|
||||
! then Cov(X'(t),X(s))=dr(t,s)/dt. Now for stationary X(t) we have
|
||||
! a function r(tau) such that Cov(X(t),X(s))=r(s-t) (or r(t-s) will give the same result).
|
||||
!
|
||||
! Consequently Cov(X'(t),X(s)) = -r'(s-t) = -sign(s-t)*r'(|s-t|)
|
||||
! Cov(X'(t),X'(s)) = -r''(s-t) = -r''(|s-t|)
|
||||
! Cov(X''(t),X'(s)) = r'''(s-t) = sign(s-t)*r'''(|s-t|)
|
||||
! Cov(X''(t),X(s)) = r''(s-t) = r''(|s-t|)
|
||||
! Cov(X''(t),X''(s)) = r''''(s-t) = r''''(|s-t|)
|
||||
|
||||
if (ts.GT.1) THEN
|
||||
! Assumption: a previous call to covinput has been made
|
||||
! need only to update the last row and column of big:
|
||||
N=tn+5
|
||||
!Cov(Xt,Xc)
|
||||
do i=1,tn-2
|
||||
j=abs(i+1-ts)
|
||||
BIG(i,N) = -sign(R1(j+1),R1(j+1)*dble(ts-i-1)) !cov(X'(ti+1),X(ts))
|
||||
enddo
|
||||
!Cov(Xc)
|
||||
BIG(N ,N) = R0(1) ! cov(X(ts),X(ts))
|
||||
BIG(tn+3 ,N) = R0(ts) ! cov(X(t1),X(ts))
|
||||
BIG(tn+4 ,N) = R0(tn-ts+1) ! cov(X(tn),X(ts))
|
||||
BIG(tn+1 ,N) = -R1(ts) ! cov(X'(t1),X(ts))
|
||||
BIG(tn+2 ,N) = R1(tn-ts+1) ! cov(X'(tn),X(ts))
|
||||
!Cov(Xd,Xc)
|
||||
BIG(tn-1 ,N) = R2(ts) !cov(X''(t1),X(ts))
|
||||
BIG(tn ,N) = R2(tn-ts+1) !cov(X''(tn),X(ts))
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,N-1
|
||||
BIG(N,j) = BIG(j,N)
|
||||
enddo
|
||||
return
|
||||
endif
|
||||
IF (ts.LT.0) THEN
|
||||
shft = 1
|
||||
N=tn+5;
|
||||
ELSE
|
||||
shft = 0
|
||||
N=tn+4;
|
||||
ENDIF
|
||||
|
||||
|
||||
do i=1,tn-2
|
||||
!cov(Xt)
|
||||
do j=i,tn-2
|
||||
BIG(i,j) = -R2(j-i+1) ! cov(X'(ti+1),X'(tj+1))
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
BIG(i ,tn+3) = R1(i+1) !cov(X'(ti+1),X(t1))
|
||||
BIG(tn-1-i ,tn+4) = -R1(i+1) !cov(X'(ti+1),X(tn))
|
||||
BIG(i ,tn+1) = -R2(i+1) !cov(X'(ti+1),X'(t1))
|
||||
BIG(tn-1-i ,tn+2) = -R2(i+1) !cov(X'(ti+1),X'(tn))
|
||||
!Cov(Xt,Xd)
|
||||
BIG(i,tn-1) = R3(i+1) !cov(X'(ti+1),X''(t1))
|
||||
BIG(tn-1-i,tn) =-R3(i+1) !cov(X'(ti+1),X''(tn))
|
||||
enddo
|
||||
|
||||
!cov(Xd)
|
||||
BIG(tn-1 ,tn-1 ) = R4(1)
|
||||
BIG(tn-1 ,tn ) = R4(tn) !cov(X''(t1),X''(tn))
|
||||
BIG(tn ,tn ) = R4(1)
|
||||
|
||||
!cov(Xc)
|
||||
BIG(tn+3 ,tn+3) = R0(1) ! cov(X(t1),X(t1))
|
||||
BIG(tn+3 ,tn+4) = R0(tn) ! cov(X(t1),X(tn))
|
||||
BIG(tn+1 ,tn+3) = 0.d0 ! cov(X(t1),X'(t1))
|
||||
BIG(tn+2 ,tn+3) = R1(tn) ! cov(X(t1),X'(tn))
|
||||
BIG(tn+4 ,tn+4) = R0(1) ! cov(X(tn),X(tn))
|
||||
BIG(tn+1 ,tn+4) =-R1(tn) ! cov(X(tn),X'(t1))
|
||||
BIG(tn+2 ,tn+4) = 0.d0 ! cov(X(tn),X'(tn))
|
||||
BIG(tn+1 ,tn+1) =-R2(1) ! cov(X'(t1),X'(t1))
|
||||
BIG(tn+1 ,tn+2) =-R2(tn) ! cov(X'(t1),X'(tn))
|
||||
BIG(tn+2 ,tn+2) =-R2(1) ! cov(X'(tn),X'(tn))
|
||||
!Xc=X(t1),X(tn),X'(t1),X'(tn)
|
||||
!Xd=X''(t1),X''(tn)
|
||||
!cov(Xd,Xc)
|
||||
BIG(tn-1 ,tn+3) = R2(1) !cov(X''(t1),X(t1))
|
||||
BIG(tn-1 ,tn+4) = R2(tn) !cov(X''(t1),X(tn))
|
||||
BIG(tn-1 ,tn+1) = 0.d0 !cov(X''(t1),X'(t1))
|
||||
BIG(tn-1 ,tn+2) = R3(tn) !cov(X''(t1),X'(tn))
|
||||
BIG(tn ,tn+3) = R2(tn) !cov(X''(tn),X(t1))
|
||||
BIG(tn ,tn+4) = R2(1) !cov(X''(tn),X(tn))
|
||||
BIG(tn ,tn+1) =-R3(tn) !cov(X''(tn),X'(t1))
|
||||
BIG(tn ,tn+2) = 0.d0 !cov(X''(tn),X'(tn))
|
||||
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,N-1
|
||||
do i=j+1,N
|
||||
BIG(i,j) = BIG(j,i)
|
||||
enddo
|
||||
enddo
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT2
|
||||
|
||||
SUBROUTINE COV_INPUT(BIG,tn,ts,R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),intent(inout) :: BIG
|
||||
double precision, dimension(:),intent(in) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(in) :: R3,R4
|
||||
integer ,intent(in) :: tn,ts
|
||||
integer :: i,j,N,shft, tnold = 0
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows:
|
||||
! for ts <= 1:
|
||||
! X'(t2)..X'(ts),...,X'(tn-1) X''(t1),X''(tn) X'(t1),X'(tn),X(t1),X(tn)
|
||||
! = [ Xt | Xd | Xc ]
|
||||
!
|
||||
! for ts > =2:
|
||||
! X'(t2)..X'(ts),...,X'(tn-1) X''(t1),X''(tn) X'(ts) X'(t1),X'(tn),X(t1),X(tn) X(ts)
|
||||
! = [ Xt | Xd | Xc ]
|
||||
!
|
||||
! where
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
! Computations of all covariances follows simple rules: Cov(X(t),X(s)) = r(t,s),
|
||||
! then Cov(X'(t),X(s))=dr(t,s)/dt. Now for stationary X(t) we have
|
||||
! a function r(tau) such that Cov(X(t),X(s))=r(s-t) (or r(t-s) will give the same result).
|
||||
!
|
||||
! Consequently Cov(X'(t),X(s)) = -r'(s-t) = -sign(s-t)*r'(|s-t|)
|
||||
! Cov(X'(t),X'(s)) = -r''(s-t) = -r''(|s-t|)
|
||||
! Cov(X''(t),X'(s)) = r'''(s-t) = sign(s-t)*r'''(|s-t|)
|
||||
! Cov(X''(t),X(s)) = r''(s-t) = r''(|s-t|)
|
||||
! Cov(X''(t),X''(s)) = r''''(s-t) = r''''(|s-t|)
|
||||
SAVE tnold
|
||||
|
||||
if (ts.GT.1) THEN
|
||||
shft = 1
|
||||
N=tn+5+shft
|
||||
!Cov(Xt,Xc)
|
||||
do i=1,tn-2
|
||||
j=abs(i+1-ts)
|
||||
BIG(i,N) = -sign(R1(j+1),R1(j+1)*dble(ts-i-1)) !cov(X'(ti+1),X(ts))
|
||||
enddo
|
||||
!Cov(Xc)
|
||||
BIG(N ,N) = R0(1) ! cov(X(ts),X(ts))
|
||||
BIG(tn+shft+3 ,N) = R0(ts) ! cov(X(t1),X(ts))
|
||||
BIG(tn+shft+4 ,N) = R0(tn-ts+1) ! cov(X(tn),X(ts))
|
||||
BIG(tn+shft+1 ,N) = -R1(ts) ! cov(X'(t1),X(ts))
|
||||
BIG(tn+shft+2 ,N) = R1(tn-ts+1) ! cov(X'(tn),X(ts))
|
||||
!Cov(Xd,Xc)
|
||||
BIG(tn-1 ,N) = R2(ts) !cov(X''(t1),X(ts))
|
||||
BIG(tn ,N) = R2(tn-ts+1) !cov(X''(tn),X(ts))
|
||||
|
||||
!ADD a level u crossing at ts
|
||||
|
||||
!Cov(Xt,Xd)
|
||||
do i = 1,tn-2
|
||||
j = abs(i+1-ts)
|
||||
BIG(i,tn+shft) = -R2(j+1) !cov(X'(ti+1),X'(ts))
|
||||
enddo
|
||||
!Cov(Xd)
|
||||
BIG(tn+shft,tn+shft) = -R2(1) !cov(X'(ts),X'(ts))
|
||||
BIG(tn-1 ,tn+shft) = R3(ts) !cov(X''(t1),X'(ts))
|
||||
BIG(tn ,tn+shft) = -R3(tn-ts+1) !cov(X''(tn),X'(ts))
|
||||
|
||||
!Cov(Xd,Xc)
|
||||
BIG(tn+shft ,N ) = 0.d0 !cov(X'(ts),X(ts))
|
||||
BIG(tn+shft,tn+shft+3) = R1(ts) ! cov(X'(ts),X(t1))
|
||||
BIG(tn+shft,tn+shft+4) = -R1(tn-ts+1) ! cov(X'(ts),X(tn))
|
||||
BIG(tn+shft,tn+shft+1) = -R2(ts) ! cov(X'(ts),X'(t1))
|
||||
BIG(tn+shft,tn+shft+2) = -R2(tn-ts+1) ! cov(X'(ts),X'(tn))
|
||||
|
||||
|
||||
|
||||
IF (tnold.EQ.tn) THEN ! A previous call to covinput with tn==tnold has been made
|
||||
! need only to update row and column N and tn+1 of big:
|
||||
! make lower triangular part equal to upper and then return
|
||||
do j=1,tn+shft
|
||||
BIG(N,j) = BIG(j,N)
|
||||
BIG(tn+shft,j) = BIG(j,tn+shft)
|
||||
enddo
|
||||
do j=tn+shft+1,N-1
|
||||
BIG(N,j) = BIG(j,N)
|
||||
BIG(j,tn+shft) = BIG(tn+shft,j)
|
||||
enddo
|
||||
return
|
||||
ENDIF
|
||||
tnold = tn
|
||||
ELSE
|
||||
N = tn+4
|
||||
shft = 0
|
||||
endif
|
||||
|
||||
|
||||
do i=1,tn-2
|
||||
!cov(Xt)
|
||||
do j=i,tn-2
|
||||
BIG(i,j) = -R2(j-i+1) ! cov(X'(ti+1),X'(tj+1))
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
BIG(i ,tn+shft+3) = R1(i+1) !cov(X'(ti+1),X(t1))
|
||||
BIG(tn-1-i ,tn+shft+4) = -R1(i+1) !cov(X'(ti+1),X(tn))
|
||||
BIG(i ,tn+shft+1) = -R2(i+1) !cov(X'(ti+1),X'(t1))
|
||||
BIG(tn-1-i ,tn+shft+2) = -R2(i+1) !cov(X'(ti+1),X'(tn))
|
||||
!Cov(Xt,Xd)
|
||||
BIG(i,tn-1) = R3(i+1) !cov(X'(ti+1),X''(t1))
|
||||
BIG(tn-1-i,tn) =-R3(i+1) !cov(X'(ti+1),X''(tn))
|
||||
enddo
|
||||
|
||||
!cov(Xd)
|
||||
BIG(tn-1 ,tn-1 ) = R4(1)
|
||||
BIG(tn-1 ,tn ) = R4(tn) !cov(X''(t1),X''(tn))
|
||||
BIG(tn ,tn ) = R4(1)
|
||||
|
||||
!cov(Xc)
|
||||
BIG(tn+shft+3 ,tn+shft+3) = R0(1) ! cov(X(t1),X(t1))
|
||||
BIG(tn+shft+3 ,tn+shft+4) = R0(tn) ! cov(X(t1),X(tn))
|
||||
BIG(tn+shft+1 ,tn+shft+3) = 0.d0 ! cov(X(t1),X'(t1))
|
||||
BIG(tn+shft+2 ,tn+shft+3) = R1(tn) ! cov(X(t1),X'(tn))
|
||||
BIG(tn+shft+4 ,tn+shft+4) = R0(1) ! cov(X(tn),X(tn))
|
||||
BIG(tn+shft+1 ,tn+shft+4) =-R1(tn) ! cov(X(tn),X'(t1))
|
||||
BIG(tn+shft+2 ,tn+shft+4) = 0.d0 ! cov(X(tn),X'(tn))
|
||||
BIG(tn+shft+1 ,tn+shft+1) =-R2(1) ! cov(X'(t1),X'(t1))
|
||||
BIG(tn+shft+1 ,tn+shft+2) =-R2(tn) ! cov(X'(t1),X'(tn))
|
||||
BIG(tn+shft+2 ,tn+shft+2) =-R2(1) ! cov(X'(tn),X'(tn))
|
||||
!Xc=X(t1),X(tn),X'(t1),X'(tn)
|
||||
!Xd=X''(t1),X''(tn)
|
||||
!cov(Xd,Xc)
|
||||
BIG(tn-1 ,tn+shft+3) = R2(1) !cov(X''(t1),X(t1))
|
||||
BIG(tn-1 ,tn+shft+4) = R2(tn) !cov(X''(t1),X(tn))
|
||||
BIG(tn-1 ,tn+shft+1) = 0.d0 !cov(X''(t1),X'(t1))
|
||||
BIG(tn-1 ,tn+shft+2) = R3(tn) !cov(X''(t1),X'(tn))
|
||||
BIG(tn ,tn+shft+3) = R2(tn) !cov(X''(tn),X(t1))
|
||||
BIG(tn ,tn+shft+4) = R2(1) !cov(X''(tn),X(tn))
|
||||
BIG(tn ,tn+shft+1) =-R3(tn) !cov(X''(tn),X'(t1))
|
||||
BIG(tn ,tn+shft+2) = 0.d0 !cov(X''(tn),X'(tn))
|
||||
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,N-1
|
||||
do i=j+1,N
|
||||
BIG(i,j) = BIG(j,i)
|
||||
enddo
|
||||
enddo
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT
|
||||
END PROGRAM sp2mmt
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,498 +0,0 @@
|
||||
PROGRAM sp2tccpdf
|
||||
C***********************************************************************
|
||||
C This program computes: *
|
||||
C *
|
||||
C density of T= T_1+T_2 in a gaussian process i.e. *
|
||||
C *
|
||||
C wavelengthes for crests <h1 and troughs >h2 *
|
||||
C *
|
||||
C Sylvie and Igor 7 dec. 1999 *
|
||||
C***********************************************************************
|
||||
use GLOBALDATA, only : Nt,Nj,Nd,Nc,Ntd,Ntdc,NI,Mb,
|
||||
& NIT,Nx,TWOPI,XSPLT,SCIS,NSIMmax,COV
|
||||
use rind
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),allocatable :: BIG
|
||||
double precision, dimension(:,:),allocatable :: ansr
|
||||
double precision, dimension(: ),allocatable :: ex,CY1,CY2
|
||||
double precision, dimension(:,:),allocatable :: xc
|
||||
double precision, dimension(: ),allocatable :: fxind,h1,h2
|
||||
double precision, dimension(: ),allocatable :: hh1,hh2
|
||||
double precision, dimension(: ),allocatable :: R0,R1,R2
|
||||
double precision ::CC,U,XddInf,XdInf,XtInf
|
||||
double precision, dimension(:,:),allocatable :: a_up,a_lo
|
||||
integer , dimension(: ),allocatable :: seed
|
||||
integer ,dimension(7) :: indI
|
||||
integer :: Ntime,tn,ts,speed,ph,seed1,seed_size,Nx1,Nx2,N0
|
||||
integer :: icy,icy2
|
||||
double precision :: ds,dT ! lag spacing for covariances
|
||||
! DIGITAL:
|
||||
! f90 -g2 -C -automatic -o ~/WAT/V4/sp2tthpdf1.exe rind49.f sp2tthpdf1.f
|
||||
! SOLARIS:
|
||||
!f90 -g -O -w3 -Bdynamic -fixed -o ../sp2tthpdf.exe rind49.f sp2tthpdf1.f
|
||||
|
||||
!print *,'enter sp2thpdf'
|
||||
CALL INIT_LEVELS(U,Ntime,N0,NIT,speed,SCIS,seed1,Nx1,Nx2,dT)
|
||||
|
||||
!print *,'U,Ntime,NIT,speed,SCIS,seed1,Nx,dT'
|
||||
!print *,U,Ntime,NIT,speed,SCIS,seed1,Nx,dT
|
||||
!Nx1=1
|
||||
!Nx2=1
|
||||
|
||||
Nx=Nx1*Nx1
|
||||
!print *,'NN',Nx1,Nx2,Nx
|
||||
|
||||
|
||||
!XSPLT=1.5d0
|
||||
if (SCIS.GT.0) then
|
||||
allocate(COV(1:Nx))
|
||||
call random_seed(SIZE=seed_size)
|
||||
allocate(seed(seed_size))
|
||||
call random_seed(GET=seed(1:seed_size)) ! get current seed
|
||||
seed(1)=seed1 ! change seed
|
||||
call random_seed(PUT=seed(1:seed_size))
|
||||
deallocate(seed)
|
||||
endif
|
||||
CALL INITDATA(speed)
|
||||
!print *,ntime,speed,u,NIT
|
||||
allocate(R0(1:Ntime+1))
|
||||
allocate(R1(1:Ntime+1))
|
||||
allocate(R2(1:Ntime+1))
|
||||
|
||||
allocate(h1(1:Nx1))
|
||||
allocate(h2(1:Nx2))
|
||||
CALL INIT_AMPLITUDES(h1,Nx1,h2,Nx2)
|
||||
CALL INIT_COVARIANCES(Ntime,R0,R1,R2)
|
||||
|
||||
|
||||
allocate(hh1(1:Nx))
|
||||
allocate(hh2(1:Nx))
|
||||
!h transformation
|
||||
do icy=1,Nx1
|
||||
do icy2=1,Nx2
|
||||
hh1((icy-1)*Nx2+icy2)=h1(icy);
|
||||
hh2((icy-1)*Nx2+icy2)=h2(icy2);
|
||||
enddo
|
||||
enddo
|
||||
|
||||
Nj=0
|
||||
indI(1)=0
|
||||
|
||||
C ***** The bound 'infinity' is set to 10*sigma *****
|
||||
XdInf=10.d0*SQRT(-R2(1))
|
||||
XtInf=10.d0*SQRT(R0(1))
|
||||
!h1(1)=XtInf
|
||||
!h2(1)=XtInf
|
||||
! normalizing constant
|
||||
CC=TWOPI*SQRT(-R0(1)/R2(1))*exp(u*u/(2.d0*R0(1)) )
|
||||
allocate(CY1(1:Nx))
|
||||
allocate(CY2(1:Nx))
|
||||
do icy=1,Nx
|
||||
CY1(icy)=exp(-0.5*hh1(icy)*hh1(icy)/100)/(10*sqrt(twopi))
|
||||
CY2(icy)=exp(-0.5*hh2(icy)*hh2(icy)/100)/(10*sqrt(twopi))
|
||||
enddo
|
||||
!print *,CY1
|
||||
allocate(ansr(1:Ntime,1:Nx))
|
||||
ansr=0.d0
|
||||
allocate(fxind(1:Nx))
|
||||
fxind=0.d0
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! Y={X(t2)..,X(ts),..X(tn-1)||X'(ts) X'(t1) X'(tn)||Y1 Y2 X(ts) X(t1) X(tn)} !!
|
||||
! = [Xt Xd Xc] !!
|
||||
! !!
|
||||
! Nt=tn-2, Nd=3, Nc=2+3 !!
|
||||
! !!
|
||||
! Xt= contains Nt time points in the indicator function !!
|
||||
! Xd= " Nd derivatives !!
|
||||
! Xc= " Nc variables to condition on !!
|
||||
! (Y1,Y2) dummy variables ind. of all other v. inputing h1,h2 into rindd !!
|
||||
! !!
|
||||
! There are 6 ( NI=7) regions with constant bariers: !!
|
||||
! (indI(1)=0); for i\in (indI(1),indI(2)] u<Y(i)<h1 !!
|
||||
! (indI(2)=ts-2); for i\in (indI(2),indI(2)], inf<Y(i)<inf (no restr.) !!
|
||||
! (indI(3)=ts-1); for i\in (indI(3),indI(4)], h2 <Y(i)<u !!
|
||||
! (indI(4)=Nt) ; for i\in (indI(4),indI(5)], Y(i)<0 (deriv. X'(ts)) !!
|
||||
! (indI(5)=Nt+1); for i\in (indI(5),indI(6)], Y(i)>0 (deriv. X'(t1)) !!
|
||||
! (indI(6)=Nt+2); for i\in (indI(6),indI(7)], Y(i)>0 (deriv. X'(tn)) !!
|
||||
! (indI(7)=Nt+3); NI=7. !!
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
||||
NI=7; Nd=3
|
||||
Nc=5; Mb=3
|
||||
allocate(a_up(1:Mb,1:(NI-1)))
|
||||
allocate(a_lo(1:Mb,1:(NI-1)))
|
||||
a_up=0.d0
|
||||
a_lo=0.d0
|
||||
allocate(BIG(1:(Ntime+Nc+1),1:(Ntime+Nc+1)))
|
||||
ALLOCATE(xc(1:Nc,1:Nx))
|
||||
allocate(ex(1:(Ntime+Nc+1)))
|
||||
!print *,size(ex),Ntime
|
||||
ex=0.d0
|
||||
!print *,size(ex),ex
|
||||
xc(1,1:Nx)=hh1(1:Nx)
|
||||
xc(2,1:Nx)=hh2(1:Nx)
|
||||
xc(3,1:Nx)=u
|
||||
xc(4,1:Nx)=u
|
||||
xc(5,1:Nx)=u
|
||||
! upp- down- upp-crossings at t1,ts,tn
|
||||
|
||||
a_lo(1,1)=u
|
||||
a_up(1,2)=XtInf ! X(ts) is redundant
|
||||
a_lo(1,2)=-Xtinf
|
||||
a_up(1,3)=u
|
||||
|
||||
|
||||
a_lo(1,4)=-XdInf
|
||||
a_up(1,5)= XdInf
|
||||
a_up(1,6)= XdInf
|
||||
|
||||
a_up(2,1)=1.d0
|
||||
a_lo(3,3)=1.d0 !signe a voir!!!!!!
|
||||
! print *,a_up
|
||||
! print *,a_lo
|
||||
do tn=N0,Ntime,1
|
||||
! do tn=Ntime,Ntime,1
|
||||
Ntd=tn+1
|
||||
Nt=Ntd-Nd
|
||||
Ntdc=Ntd+Nc
|
||||
indI(4)=Nt
|
||||
indI(5)=Nt+1
|
||||
indI(6)=Nt+2
|
||||
indI(7)=Ntd
|
||||
if (SCIS.gt.0) then
|
||||
if (SCIS.EQ.2) then
|
||||
Nj=max(Nt,0)
|
||||
else
|
||||
Nj=min(max(Nt-5, 0),0)
|
||||
endif
|
||||
endif
|
||||
do ts=3,tn-2
|
||||
!print *,'ts,tn' ,ts,tn,Ntdc
|
||||
CALL COV_INPUT(Big(1:Ntdc,1:Ntdc),tn,ts,R0,R1,R2)!positive wave period
|
||||
indI(2)=ts-2
|
||||
indI(3)=ts-1
|
||||
|
||||
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex(1:Ntdc),
|
||||
& xc,indI,a_lo,a_up)
|
||||
|
||||
ds=dt
|
||||
do icy=1,Nx
|
||||
! ansr(tn,:)=ansr(tn,:)+fxind*CC*ds./(CY1.*CY2)
|
||||
ansr(tn,icy)=ansr(tn,icy)+fxind(icy)*CC*ds/(CY1(icy)*CY2(icy))
|
||||
enddo
|
||||
enddo ! ts
|
||||
print *,'Ready: ',tn,' of ',Ntime
|
||||
|
||||
enddo !tn
|
||||
!print *,'ansr',ansr
|
||||
300 open (unit=11, file='dens.out', STATUS='unknown')
|
||||
!print *, ansr
|
||||
do ts=1,Ntime
|
||||
do ph=1,Nx
|
||||
!write(11,*) ansr(ts,ph),hh1(ph),hh2(ph)
|
||||
write(11,111) ansr(ts,ph)
|
||||
|
||||
enddo
|
||||
enddo
|
||||
111 FORMAT(2x,F12.8)
|
||||
close(11)
|
||||
900 deallocate(big)
|
||||
deallocate(fxind)
|
||||
deallocate(ansr)
|
||||
deallocate(xc)
|
||||
deallocate(ex)
|
||||
deallocate(R0)
|
||||
deallocate(R1)
|
||||
deallocate(R2)
|
||||
if (allocated(COV) ) then
|
||||
deallocate(COV)
|
||||
endif
|
||||
deallocate(h1)
|
||||
deallocate(h2)
|
||||
deallocate(hh1)
|
||||
deallocate(hh2)
|
||||
deallocate(a_up)
|
||||
deallocate(a_lo)
|
||||
stop
|
||||
!return
|
||||
|
||||
CONTAINS
|
||||
|
||||
|
||||
|
||||
SUBROUTINE INIT_LEVELS
|
||||
& (U,Ntime,N0,NIT,speed,SCIS,seed1,Nx1,Nx2,dT)
|
||||
IMPLICIT NONE
|
||||
integer, intent(out):: Ntime,N0,NIT,speed,Nx1,Nx2,SCIS,seed1
|
||||
double precision ,intent(out) :: U,dT
|
||||
|
||||
|
||||
OPEN(UNIT=14,FILE='reflev.in',STATUS= 'UNKNOWN')
|
||||
|
||||
READ (14,*) U
|
||||
READ (14,*) Ntime
|
||||
READ (14,*) N0
|
||||
READ (14,*) NIT
|
||||
READ (14,*) speed
|
||||
READ (14,*) SCIS
|
||||
READ (14,*) seed1
|
||||
|
||||
|
||||
READ (14,*) Nx1,Nx2
|
||||
READ (14,*) dT
|
||||
if (Ntime.lt.5) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
|
||||
CLOSE(UNIT=14)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_LEVELS
|
||||
|
||||
C******************************************************
|
||||
SUBROUTINE INIT_AMPLITUDES(h1,Nx1,h2,Nx2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:), intent(out) :: h1,h2
|
||||
integer, intent(in) :: Nx1,Nx2
|
||||
integer :: ix
|
||||
|
||||
|
||||
OPEN(UNIT=4,FILE='h.in',STATUS= 'UNKNOWN')
|
||||
|
||||
C
|
||||
C Reading in amplitudes
|
||||
C
|
||||
do ix=1,Nx1
|
||||
READ (4,*) H1(ix)
|
||||
enddo
|
||||
do ix=1,Nx2
|
||||
READ (4,*) H2(ix)
|
||||
enddo
|
||||
CLOSE(UNIT=4)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_AMPLITUDES
|
||||
|
||||
C**************************************************
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
SUBROUTINE INIT_COVARIANCES(Ntime,R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:),intent(out) :: R0,R1,R2
|
||||
integer,intent(in) :: Ntime
|
||||
integer :: i
|
||||
open (unit=1, file='Cd0.in',STATUS='unknown')
|
||||
open (unit=2, file='Cd1.in',STATUS='unknown')
|
||||
open (unit=3, file='Cd2.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(1,*) R0(i)
|
||||
read(2,*) R1(i)
|
||||
read(3,*) R2(i)
|
||||
enddo
|
||||
close(1)
|
||||
close(2)
|
||||
close(3)
|
||||
|
||||
return
|
||||
END SUBROUTINE INIT_COVARIANCES
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
C**********************************************************************
|
||||
|
||||
SUBROUTINE COV_INPUT(BIG,tn,ts, R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),intent(inout) :: BIG
|
||||
double precision, dimension(:),intent(in) :: R0,R1,R2
|
||||
integer ,intent(in) :: tn,ts
|
||||
integer :: i,j,Ntd1,N !=Ntdc
|
||||
double precision :: tmp
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows:
|
||||
!
|
||||
! ||X(t2)..X(ts),..X(tn-1)||X'(ts) X'(t1) X'(tn)||Y1 Y2 X(ts) X(t1) X(tn)||
|
||||
! = [Xt Xd Xc]
|
||||
! where
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
! Computations of all covariances follows simple rules: Cov(X(t),X(s))=r(t,s),
|
||||
! then Cov(X'(t),X(s))=dr(t,s)/dt. Now for stationary X(t) we have
|
||||
! a function r(tau) such that Cov(X(t),X(s))=r(s-t) (or r(t-s) will give the same result).
|
||||
!
|
||||
! Consequently Cov(X'(t),X(s)) = -r'(s-t) = -sign(s-t)*r'(|s-t|)
|
||||
! Cov(X'(t),X'(s)) = -r''(s-t) = -r''(|s-t|)
|
||||
! Cov(X''(t),X'(s)) = r'''(s-t) = sign(s-t)*r'''(|s-t|)
|
||||
! Cov(X''(t),X(s)) = r''(s-t) = r''(|s-t|)
|
||||
! Cov(X''(t),X''(s)) = r''''(s-t) = r''''(|s-t|)
|
||||
|
||||
Ntd1=tn+1
|
||||
N=Ntd1+Nc
|
||||
do i=1,tn-2
|
||||
!cov(Xt)
|
||||
do j=i,tn-2
|
||||
BIG(i,j) = R0(j-i+1) ! cov(X(ti+1),X(tj+1))
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
BIG(i ,Ntd1+1) = 0.d0 !cov(X(ti+1),Y1)
|
||||
BIG(i ,Ntd1+2) = 0.d0 !cov(X(ti+1),Y2)
|
||||
BIG(i ,Ntd1+4) = R0(i+1) !cov(X(ti+1),X(t1))
|
||||
BIG(tn-1-i ,Ntd1+5) = R0(i+1) !cov(X(t.. ),X(tn))
|
||||
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj)
|
||||
BIG(i,Ntd1-1) =-R1(i+1) !cov(X(ti+1),X'(t1))
|
||||
BIG(tn-1-i,Ntd1)= R1(i+1) !cov(X(ti+1),X'(tn))
|
||||
enddo
|
||||
!cov(Xd)
|
||||
BIG(Ntd1 ,Ntd1 ) = -R2(1)
|
||||
BIG(Ntd1-1,Ntd1 ) = -R2(tn) !cov(X'(t1),X'(tn))
|
||||
BIG(Ntd1-1,Ntd1-1) = -R2(1)
|
||||
BIG(Ntd1-2,Ntd1-1) = -R2(ts) !cov(X'(ts),X'(t1))
|
||||
BIG(Ntd1-2,Ntd1-2) = -R2(1)
|
||||
BIG(Ntd1-2,Ntd1 ) = -R2(tn+1-ts) !cov(X'(ts),X'(tn))
|
||||
|
||||
!cov(Xc)
|
||||
BIG(Ntd1+1,Ntd1+1) = 100.d0 ! cov(Y1 Y1)
|
||||
BIG(Ntd1+1,Ntd1+2) = 0.d0 ! cov(Y1 Y2)
|
||||
BIG(Ntd1+1,Ntd1+3) = 0.d0 ! cov(Y1 X(ts))
|
||||
BIG(Ntd1+1,Ntd1+4) = 0.d0 ! cov(Y1 X(t1))
|
||||
BIG(Ntd1+1,Ntd1+5) = 0.d0 ! cov(Y1 X(tn))
|
||||
BIG(Ntd1+2,Ntd1+2) = 100.d0 ! cov(Y2 Y2)
|
||||
BIG(Ntd1+2,Ntd1+3) = 0.d0 ! cov(Y2 X(ts))
|
||||
BIG(Ntd1+2,Ntd1+4) = 0.d0 ! cov(Y2 X(t1))
|
||||
BIG(Ntd1+2,Ntd1+5) = 0.d0 ! cov(Y2 X(tn))
|
||||
|
||||
BIG(Ntd1+3,Ntd1+3) = R0(1) ! cov(X(ts),X (ts)
|
||||
BIG(Ntd1+3,Ntd1+4) = R0(ts) ! cov(X(ts),X (t1))
|
||||
BIG(Ntd1+3,Ntd1+5) = R0(tn+1-ts) ! cov(X(ts),X (tn))
|
||||
BIG(Ntd1+4,Ntd1+4) = R0(1) ! cov(X(t1),X (t1))
|
||||
BIG(Ntd1+4,Ntd1+5) = R0(tn) ! cov(X(t1),X (tn))
|
||||
BIG(Ntd1+5,Ntd1+5) = R0(1) ! cov(X(tn),X (tn))
|
||||
|
||||
|
||||
!cov(Xd,Xc)
|
||||
BIG(Ntd1 ,Ntd1+1) = 0.d0 !cov(X'(tn),Y1)
|
||||
BIG(Ntd1 ,Ntd1+2) = 0.d0 !cov(X'(tn),Y2)
|
||||
BIG(Ntd1-1 ,Ntd1+1) = 0.d0 !cov(X'(t1),Y1)
|
||||
BIG(Ntd1-1 ,Ntd1+2) = 0.d0 !cov(X'(t1),Y2)
|
||||
BIG(Ntd1-2 ,Ntd1+1) = 0.d0 !cov(X'(ts),Y1)
|
||||
BIG(Ntd1-2 ,Ntd1+2) = 0.d0 !cov(X'(ts),Y2)
|
||||
|
||||
BIG(Ntd1 ,Ntd1+4) = R1(tn) !cov(X'(tn),X(t1))
|
||||
BIG(Ntd1 ,Ntd1+5) = 0.d0 !cov(X'(tn),X(tn))
|
||||
BIG(Ntd1-1,Ntd1+4) = 0.d0 !cov(X'(t1),X(t1))
|
||||
BIG(Ntd1-1,Ntd1+5) =-R1(tn) !cov(X'(t1),X(tn))
|
||||
BIG(Ntd1 ,Ntd1+3) = R1(tn+1-ts) !cov(X'(tn),X (ts))
|
||||
BIG(Ntd1-1,Ntd1+3) =-R1(ts) !cov(X'(t1),X (ts))
|
||||
BIG(Ntd1-2,Ntd1+3) = 0.d0 !cov(X'(ts),X (ts)
|
||||
BIG(Ntd1-2,Ntd1+4) = R1(ts) !cov(X'(ts),X (t1))
|
||||
BIG(Ntd1-2,Ntd1+5) = -R1(tn+1-ts) !cov(X'(ts),X (tn))
|
||||
|
||||
|
||||
do i=1,tn-2
|
||||
j=abs(i+1-ts)
|
||||
!cov(Xt,Xc)
|
||||
BIG(i,Ntd1+3) = R0(j+1) !cov(X(ti+1),X(ts))
|
||||
!Cov(Xt,Xd)
|
||||
if ((i+1-ts).lt.0) then
|
||||
BIG(i,Ntd1-2) = R1(j+1)
|
||||
else !cov(X(ti+1),X'(ts))
|
||||
BIG(i,Ntd1-2) = -R1(j+1)
|
||||
endif
|
||||
enddo
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,N-1
|
||||
do i=j+1,N
|
||||
tmp =BIG(j,i)
|
||||
|
||||
BIG(i,j)=tmp
|
||||
enddo
|
||||
enddo
|
||||
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT
|
||||
|
||||
SUBROUTINE COV_INPUT2(BIG,pt, R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:), intent(out) :: BIG
|
||||
double precision, dimension(:), intent(in) :: R0,R1,R2
|
||||
integer :: pt,i,j
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows;
|
||||
! X(t2)...X(tn-1) X'(t1) X'(tn) X(t1) X(tn) = [Xt Xd Xc]
|
||||
!
|
||||
! where Xd is the derivatives
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
!cov(Xc)
|
||||
BIG(pt+2,pt+2) = R0(1)
|
||||
BIG(pt+1,pt+1) = R0(1)
|
||||
BIG(pt+1,pt+2) = R0(pt)
|
||||
!cov(Xd)
|
||||
BIG(pt,pt) = -R2(1)
|
||||
BIG(pt-1,pt-1) = -R2(1)
|
||||
BIG(pt-1,pt) = -R2(pt)
|
||||
!cov(Xd,Xc)
|
||||
BIG(pt,pt+2) = 0.d0
|
||||
BIG(pt,pt+1) = R1(pt)
|
||||
BIG(pt-1,pt+2) = -R1(pt)
|
||||
BIG(pt-1,pt+1) = 0.d0
|
||||
|
||||
if (pt.GT.2) then
|
||||
!cov(Xt)
|
||||
do i=1,pt-2
|
||||
do j=i,pt-2
|
||||
BIG(i,j) = R0(j-i+1)
|
||||
enddo
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
do i=1,pt-2
|
||||
BIG(i,pt+1) = R0(i+1)
|
||||
BIG(pt-1-i,pt+2) = R0(i+1)
|
||||
enddo
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj))
|
||||
do i=1,pt-2
|
||||
BIG(i,pt-1) = -R1(i+1)
|
||||
BIG(pt-1-i,pt)= R1(i+1)
|
||||
enddo
|
||||
endif
|
||||
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,pt+1
|
||||
do i=j+1,pt+2
|
||||
BIG(i,j)=BIG(j,i)
|
||||
enddo
|
||||
enddo
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT2
|
||||
|
||||
|
||||
END PROGRAM sp2tccpdf
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,440 +0,0 @@
|
||||
PROGRAM sp2tcpdf
|
||||
C***********************************************************************
|
||||
C This program computes: *
|
||||
C *
|
||||
C density of T_i, for Ac <=h, in a gaussian process i.e. *
|
||||
C *
|
||||
C half wavelength (up-crossing to downcrossing) for crests <h *
|
||||
C or half wavelength (down-crossing to upcrossing) for trough >h *
|
||||
C***********************************************************************
|
||||
use GLOBALDATA, only : Nt,Nj,Nd,Nc,Ntd,Ntdc,NI,Mb,
|
||||
&NIT,Nx,TWOPI,XSPLT,SCIS,NSIMmax,COV
|
||||
use rind
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),allocatable :: BIG
|
||||
double precision, dimension(:,:),allocatable :: ansr
|
||||
double precision, dimension(: ),allocatable :: ex,CY
|
||||
double precision, dimension(:,:),allocatable :: xc
|
||||
double precision, dimension(: ),allocatable :: fxind,h
|
||||
double precision, dimension(: ),allocatable :: R0,R1,R2,R3,R4
|
||||
double precision ::CC,U,XddInf,XdInf,XtInf
|
||||
double precision, dimension(2,6) :: a_up=0.d0,a_lo=0.d0
|
||||
integer , dimension(: ),allocatable :: seed
|
||||
integer ,dimension(7) :: indI
|
||||
integer :: Nstart,Ntime,tn,ts,speed,ph,def,seed1,seed_size,icy
|
||||
integer ::it1,it2
|
||||
double precision :: ds,dT ! lag spacing for covariances
|
||||
! DIGITAL:
|
||||
! f90 -o ~/WAT/V1/sp2tcpdf.exe rind44.f sp2tcpdf.f
|
||||
|
||||
!print *,'enter sp2thpdf'
|
||||
CALL INIT_LEVELS(U,def,Ntime,Nstart,NIT,speed,Nx,dT)
|
||||
!print *,'U,def,Ntime,Nstart,NIT,speed,SCIS,seed1,Nx,dT'
|
||||
!print *,U,def,Ntime,Nstart,NIT,speed,SCIS,seed1,Nx,dT
|
||||
!XSPLT=1.5d0
|
||||
if (SCIS.GT.0) then
|
||||
allocate(COV(1:Nx))
|
||||
call random_seed(SIZE=seed_size)
|
||||
allocate(seed(seed_size))
|
||||
call random_seed(GET=seed(1:seed_size)) ! get current seed
|
||||
seed(1)=seed1 ! change seed
|
||||
call random_seed(PUT=seed(1:seed_size))
|
||||
deallocate(seed)
|
||||
endif
|
||||
CALL INITDATA(speed)
|
||||
!print *,ntime,speed,u,NIT
|
||||
allocate(R0(1:Ntime+1))
|
||||
allocate(R1(1:Ntime+1))
|
||||
allocate(R2(1:Ntime+1))
|
||||
if (abs(def).GT.1) THEN
|
||||
!allocate(h(1:Nx))
|
||||
allocate(R3(1:Ntime+1))
|
||||
allocate(R4(1:Ntime+1))
|
||||
!CALL INIT_AMPLITUDES(h,def,Nx)
|
||||
endif
|
||||
allocate(h(1:Nx))
|
||||
CALL INIT_AMPLITUDES(h,def,Nx)
|
||||
CALL INIT_COVARIANCES(Ntime,def,R0,R1,R2,R3,R4)
|
||||
|
||||
print *,'Nx',Nx
|
||||
|
||||
Nj=0
|
||||
indI(1)=0
|
||||
C ***** The bound 'infinity' is set to 10*sigma *****
|
||||
XdInf=10.d0*SQRT(-R2(1))
|
||||
XtInf=10.d0*SQRT(R0(1))
|
||||
print *,'XdInf,XtInf'
|
||||
print *,XdInf,XtInf
|
||||
! normalizing constant
|
||||
CC=TWOPI*SQRT(-R0(1)/R2(1))*exp(u*u/(2.d0*R0(1)) )
|
||||
!fy(h)
|
||||
allocate(CY(1:Nx))
|
||||
do icy=1,Nx
|
||||
CY(icy)=exp(-0.5*h(icy)*h(icy)/100)/(10*sqrt(twopi))
|
||||
enddo
|
||||
|
||||
allocate(ansr(1:Ntime,1:Nx))
|
||||
ansr=0.d0
|
||||
allocate(fxind(1:Nx))
|
||||
fxind=0.d0 !this is not needed
|
||||
|
||||
NI=4; Nd=2
|
||||
Nc=3; Mb=2
|
||||
allocate(BIG(1:Ntime+Nc,1:Ntime+Nc))
|
||||
allocate(xc(1:Nc,1:Nx))
|
||||
allocate(ex(1:Ntime+Nc))
|
||||
ex=0.d0
|
||||
!print *,'nc',Nc,Nx
|
||||
xc(1,1:Nx)=h(1:Nx)
|
||||
print *,'xc',h(1)
|
||||
print *,'test',def;
|
||||
xc(2,1:Nx)=u
|
||||
xc(3,1:Nx)=u
|
||||
if (def.GT.0) then
|
||||
a_up(1,1)=u !+XtInf
|
||||
a_lo(1,1)=u
|
||||
a_up(1,2)=XdInf
|
||||
a_lo(1,3)=-XdInf
|
||||
a_up(2,1)=1.d0
|
||||
else
|
||||
a_up(1,1)=u
|
||||
a_lo(1,1)=u !-XtInf
|
||||
a_lo(1,2)=-XdInf
|
||||
a_up(1,3)= XdInf
|
||||
a_lo(2,1)=1.d0
|
||||
print *,'a_lo',a_lo(2,1)
|
||||
endif
|
||||
!print *,'Nstart',Nstart
|
||||
Nstart=MAX(3,Nstart)
|
||||
!print *,'Nstart',Nstart
|
||||
if (SCIS.GT.0) then
|
||||
open (unit=11, file='COV.out', STATUS='unknown')
|
||||
write(11,*) 0.d0
|
||||
endif
|
||||
do Ntd=Nstart,Ntime
|
||||
!CALL COV_INPUT2(BIG,Ntd, R0,R1,R2)
|
||||
Ntdc=Ntd+Nc;
|
||||
CALL COV_INPUT(BIG,Ntd,-1,R0,R1,R2,R3,R4) ! positive wave period
|
||||
Nt=Ntd-Nd;
|
||||
indI(2)=Nt;
|
||||
indI(3)=Nt+1;
|
||||
indI(4)=Ntd;
|
||||
!Ntdc=Ntd+Nc;
|
||||
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex(1:Ntdc),
|
||||
& xc,indI,a_lo,a_up)
|
||||
! print *,'test',fxind/CY(1:Nx)
|
||||
do icy=1,Nx
|
||||
ansr(Ntd,icy)=fxind(icy)*CC/CY(icy)
|
||||
enddo
|
||||
if (SCIS.GT.0) then
|
||||
write(11,*) COV(1) ! save coefficient of variation
|
||||
endif
|
||||
print *,'Ready: ',Ntd,' of ',Ntime
|
||||
enddo
|
||||
goto 300
|
||||
300 open (unit=11, file='dens.out', STATUS='unknown')
|
||||
|
||||
!print *, ansr
|
||||
do ts=1,Ntime
|
||||
do ph=1,Nx
|
||||
write(11,*) ansr(ts,ph)
|
||||
! write(11,111) ansr(ts,ph)
|
||||
enddo
|
||||
enddo
|
||||
!111 FORMAT(2x,F12.8)
|
||||
close(11)
|
||||
900 deallocate(big)
|
||||
deallocate(fxind)
|
||||
deallocate(ansr)
|
||||
deallocate(xc)
|
||||
deallocate(ex)
|
||||
deallocate(R0)
|
||||
deallocate(R1)
|
||||
deallocate(R2)
|
||||
if (allocated(COV) ) then
|
||||
deallocate(COV)
|
||||
endif
|
||||
|
||||
if (allocated(R3)) then
|
||||
deallocate(R3)
|
||||
deallocate(R4)
|
||||
deallocate(h)
|
||||
ENDIF
|
||||
stop
|
||||
!return
|
||||
|
||||
CONTAINS
|
||||
|
||||
|
||||
|
||||
SUBROUTINE INIT_LEVELS
|
||||
& (U,def,Ntime,Nstart,NIT,speed,Nx,dT)
|
||||
IMPLICIT NONE
|
||||
integer, intent(out):: def,Ntime,Nstart,NIT,speed,Nx
|
||||
double precision ,intent(out) :: U,dT
|
||||
|
||||
|
||||
OPEN(UNIT=14,FILE='reflev.in',STATUS= 'UNKNOWN')
|
||||
READ (14,*) U
|
||||
READ (14,*) def
|
||||
READ (14,*) Ntime
|
||||
READ (14,*) Nstart
|
||||
READ (14,*) NIT
|
||||
READ (14,*) speed
|
||||
READ (14,*) SCIS
|
||||
READ (14,*) seed1
|
||||
READ (14,*) Nx
|
||||
print *,'def',def
|
||||
if (abs(def).GT.1) then
|
||||
READ (14,*) dT
|
||||
if (Ntime.lt.3) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
else
|
||||
if (Ntime.lt.2) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
endif
|
||||
CLOSE(UNIT=14)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_LEVELS
|
||||
|
||||
C******************************************************
|
||||
SUBROUTINE INIT_AMPLITUDES(h,def,Nx)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:), intent(out) :: h
|
||||
integer, intent(in) :: def
|
||||
integer, intent(in) :: Nx
|
||||
integer :: ix
|
||||
|
||||
|
||||
OPEN(UNIT=4,FILE='h.in',STATUS= 'UNKNOWN')
|
||||
|
||||
C
|
||||
C Reading in amplitudes
|
||||
C
|
||||
do ix=1,Nx
|
||||
READ (4,*) H(ix)
|
||||
enddo
|
||||
CLOSE(UNIT=4)
|
||||
!if (def.LT.0) THEN
|
||||
! H=-H
|
||||
!endif
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_AMPLITUDES
|
||||
|
||||
C**************************************************
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
SUBROUTINE INIT_COVARIANCES(Ntime,def,R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:),intent(out) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(out) :: R3,R4
|
||||
integer,intent(in) :: Ntime,def
|
||||
integer :: i
|
||||
open (unit=1, file='Cd0.in',STATUS='unknown')
|
||||
open (unit=2, file='Cd1.in',STATUS='unknown')
|
||||
open (unit=3, file='Cd2.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(1,*) R0(i)
|
||||
read(2,*) R1(i)
|
||||
read(3,*) R2(i)
|
||||
enddo
|
||||
close(1)
|
||||
close(2)
|
||||
close(3)
|
||||
|
||||
if (abs(def).GT.1) then
|
||||
open (unit=4, file='Cd3.in',STATUS='unknown')
|
||||
open (unit=5, file='Cd4.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(4,*) R3(i)
|
||||
read(5,*) R4(i)
|
||||
enddo
|
||||
|
||||
close(4)
|
||||
close(5)
|
||||
endif
|
||||
return
|
||||
END SUBROUTINE INIT_COVARIANCES
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
C**********************************************************************
|
||||
|
||||
SUBROUTINE COV_INPUT(BIG,tn,ts, R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),intent(inout) :: BIG
|
||||
double precision, dimension(:),intent(in) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(in) :: R3,R4
|
||||
integer ,intent(in) :: tn,ts
|
||||
integer :: i,j,shft,Ntd1,N !=Ntdc
|
||||
double precision :: tmp
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows:
|
||||
! For ts>1:
|
||||
! X(t2)..X(ts),..X(tn-1) X''(ts) X'(t1) X'(tn) X(ts) X(t1) X(tn) X'(ts)
|
||||
! = [Xt Xd Xc]
|
||||
!
|
||||
! For ts<=1:
|
||||
! X(t2)..,..X(tn-1) X'(t1) X'(tn) Y X(t1) X(tn)
|
||||
! = [Xt Xd Xc]
|
||||
!Add Y Condition : Y=h
|
||||
|
||||
! where
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
if (ts.LE.1) THEN
|
||||
Ntd1=tn
|
||||
N=Ntd1+Nc;
|
||||
shft=0 ! def=1 want only crest period Tc
|
||||
else
|
||||
Ntd1=tn+1
|
||||
N=Ntd1+4
|
||||
shft=1 ! def=2 or 3 want Tc Ac or Tcf, Ac
|
||||
endif
|
||||
|
||||
do i=1,tn-2
|
||||
!cov(Xt)
|
||||
do j=i,tn-2
|
||||
BIG(i,j) = R0(j-i+1) ! cov(X(ti+1),X(tj+1))
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
BIG(i ,Ntd1+1+shft) = 0.d0 !cov(X(ti+1),Y)
|
||||
BIG(i ,Ntd1+2+shft) = R0(i+1) !cov(X(ti+1),X(t1))
|
||||
BIG(tn-1-i ,Ntd1+3+shft) = R0(i+1) !cov(X(t.. ),X(tn))
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj)
|
||||
BIG(i,Ntd1-1) =-R1(i+1) !cov(X(ti+1),X' (t1))
|
||||
BIG(tn-1-i,Ntd1)= R1(i+1) !cov(X(ti+1),X' (tn))
|
||||
enddo
|
||||
!call echo(big(1:tn,1:tn),tn)
|
||||
!cov(Xd)
|
||||
BIG(Ntd1 ,Ntd1 ) = -R2(1)
|
||||
BIG(Ntd1-1,Ntd1 ) = -R2(tn) !cov(X'(t1),X'(tn))
|
||||
BIG(Ntd1-1,Ntd1-1) = -R2(1)
|
||||
|
||||
!cov(Xc)
|
||||
!print *,'t'
|
||||
BIG(Ntd1+1+shft,Ntd1+1+shft) = 100.d0!100.d0 ! cov(Y,Y)
|
||||
BIG(Ntd1+1+shft,Ntd1+2+shft) = 0.d0
|
||||
BIG(Ntd1+1+shft,Ntd1+3+shft) = 0.d0
|
||||
BIG(Ntd1+2+shft,Ntd1+2+shft) = R0(1) ! cov(X(t1),X (t1))
|
||||
BIG(Ntd1+2+shft,Ntd1+3+shft) = R0(tn) ! cov(X(t1),X (tn))
|
||||
BIG(Ntd1+3+shft,Ntd1+3+shft) = R0(1) ! cov(X(tn),X (tn))
|
||||
!cov(Xd,Xc)
|
||||
BIG(Ntd1 ,Ntd1+1+shft) = 0.d0 !cov(X'(tn),Y)
|
||||
BIG(Ntd1 ,Ntd1+2+shft) = R1(tn) !cov(X'(tn),X(t1))
|
||||
BIG(Ntd1 ,Ntd1+3+shft) = 0.d0 !cov(X'(tn),X(tn))
|
||||
BIG(Ntd1-1,Ntd1+1+shft) = 0.d0 !cov(X'(t1),Y)
|
||||
BIG(Ntd1-1,Ntd1+2+shft) = 0.d0 !cov(X'(t1),X(t1))
|
||||
BIG(Ntd1-1,Ntd1+3+shft) =-R1(tn) !cov(X'(t1),X(tn))
|
||||
|
||||
|
||||
!call echo(big(1:N,1:N),N)
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,N-1
|
||||
do i=j+1,N
|
||||
tmp =BIG(j,i)
|
||||
BIG(i,j)=tmp
|
||||
enddo
|
||||
!call echo(big(1:N,1:N),N)
|
||||
enddo
|
||||
!if (tn.eq.3) then
|
||||
!do j=1,N
|
||||
! do i=j,N
|
||||
! print *,'test',j,i,BIG(j,i)
|
||||
! enddo
|
||||
!call echo(big(1:N,1:N),N)
|
||||
!enddo
|
||||
!endif
|
||||
!call echo(big(1:N,1:N),N)
|
||||
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT
|
||||
|
||||
SUBROUTINE COV_INPUT2(BIG,pt, R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:), intent(out) :: BIG
|
||||
double precision, dimension(:), intent(in) :: R0,R1,R2
|
||||
integer :: pt,i,j
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows;
|
||||
! X(t2)...X(tn-1) X'(t1) X'(tn) X(t1) X(tn) = [Xt Xd Xc]
|
||||
!
|
||||
! where Xd is the derivatives
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
!cov(Xc)
|
||||
BIG(pt+2,pt+2) = R0(1)
|
||||
BIG(pt+1,pt+1) = R0(1)
|
||||
BIG(pt+1,pt+2) = R0(pt)
|
||||
!cov(Xd)
|
||||
BIG(pt,pt) = -R2(1)
|
||||
BIG(pt-1,pt-1) = -R2(1)
|
||||
BIG(pt-1,pt) = -R2(pt)
|
||||
!cov(Xd,Xc)
|
||||
BIG(pt,pt+2) = 0.d0
|
||||
BIG(pt,pt+1) = R1(pt)
|
||||
BIG(pt-1,pt+2) = -R1(pt)
|
||||
BIG(pt-1,pt+1) = 0.d0
|
||||
|
||||
if (pt.GT.2) then
|
||||
!cov(Xt)
|
||||
do i=1,pt-2
|
||||
do j=i,pt-2
|
||||
BIG(i,j) = R0(j-i+1)
|
||||
enddo
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
do i=1,pt-2
|
||||
BIG(i,pt+1) = R0(i+1)
|
||||
BIG(pt-1-i,pt+2) = R0(i+1)
|
||||
enddo
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj))
|
||||
do i=1,pt-2
|
||||
BIG(i,pt-1) = -R1(i+1)
|
||||
BIG(pt-1-i,pt)= R1(i+1)
|
||||
enddo
|
||||
endif
|
||||
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,pt+1
|
||||
do i=j+1,pt+2
|
||||
BIG(i,j)=BIG(j,i)
|
||||
enddo
|
||||
enddo
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT2
|
||||
|
||||
|
||||
END PROGRAM sp2tcpdf
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,569 +0,0 @@
|
||||
PROGRAM sp2thpdf
|
||||
!***********************************************************************
|
||||
! This program computes: *
|
||||
! *
|
||||
! density of S_i,Hi,T_i in a gaussian process i.e. *
|
||||
! *
|
||||
! quart wavelength (up-crossing to crest) and crest amplitude *
|
||||
!
|
||||
! def = 1, gives half wave period, Tc (default).
|
||||
! -1, gives half wave period, Tt.
|
||||
! 2, gives half wave period and wave crest amplitude (Tc,Ac).
|
||||
! -2, gives half wave period and wave trough amplitude (Tt,At).
|
||||
! 3, gives crest front period and wave crest amplitude (Tcf,Ac).
|
||||
! -3, gives trough back period and wave trough amplitude (Ttb,At).
|
||||
! 4, gives minimum of crest front/back period and wave crest
|
||||
! amplitude (max(Tcf,Tcb),Ac).
|
||||
! -4, gives minimum of trough front/back period and wave trough
|
||||
! amplitude (max(Ttf,Ttb),At).
|
||||
!***********************************************************************
|
||||
use GLOBALDATA, only : Nt,Nj,Nd,Nc,Ntd,Ntdc,NI,Mb,
|
||||
& NIT,Nx,TWOPI,XSPLT,SCIS,NSIMmax,COV
|
||||
use rind
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),allocatable :: BIG
|
||||
double precision, dimension(:,:),allocatable :: ansr
|
||||
double precision, dimension(: ),allocatable :: ex
|
||||
double precision, dimension(:,:),allocatable :: xc
|
||||
double precision, dimension(: ),allocatable :: fxind,h
|
||||
double precision, dimension(: ),allocatable :: R0,R1,R2,R3,R4
|
||||
double precision ::CC,U,XddInf,XdInf,XtInf
|
||||
double precision, dimension(2,6) :: a_up=0.d0,a_lo=0.d0
|
||||
integer , dimension(: ),allocatable :: seed
|
||||
integer ,dimension(7) :: indI
|
||||
integer :: Nstart,Ntime,tn,ts,speed,ph,def,seed1,seed_size
|
||||
double precision :: ds,dT ! lag spacing for covariances
|
||||
! DIGITAL:
|
||||
! f90 -g2 -C -automatic -o ../wave/alpha/sp2thpdf.exe rind44.f sp2thpdf.f
|
||||
! SOLARIS:
|
||||
!f90 -g -O -w3 -Bdynamic -fixed -o ../wave/sol2/sp2thpdf.exe rind44.f sp2thpdf.f
|
||||
! linux:
|
||||
! f90 -gline -Nl126 -C -o sp2thpdf.exe rind45.f sp2thpdf.f
|
||||
! HP700
|
||||
!f90 -g -C -o ../exec/hp700/sp2thpdf.exe rind45.f sp2thpdf.f
|
||||
!f90 -g -C +check=all +FPVZID -o ../exec/hp700/sp2thpdf2.exe rind45.f sp2thpdf.f
|
||||
|
||||
|
||||
!print *,'enter sp2thpdf'
|
||||
CALL INIT_LEVELS(U,def,Ntime,Nstart,NIT,speed,SCIS,seed1,Nx,dT)
|
||||
!print *,'U,def,Ntime,Nstart,NIT,speed,SCIS,seed1,Nx,dT'
|
||||
!print *,U,def,Ntime,Nstart,NIT,speed,SCIS,seed1,Nx,dT
|
||||
|
||||
!XSPLT=1.5d0
|
||||
if (SCIS.GT.0) then
|
||||
allocate(COV(1:Nx))
|
||||
call random_seed(SIZE=seed_size)
|
||||
allocate(seed(seed_size))
|
||||
call random_seed(GET=seed(1:seed_size)) ! get current seed
|
||||
seed(1)=seed1 ! change seed
|
||||
call random_seed(PUT=seed(1:seed_size))
|
||||
deallocate(seed)
|
||||
endif
|
||||
CALL INITDATA(speed)
|
||||
!print *,ntime,speed,u,NIT
|
||||
allocate(R0(1:Ntime+1))
|
||||
allocate(R1(1:Ntime+1))
|
||||
allocate(R2(1:Ntime+1))
|
||||
if (abs(def).GT.1) THEN
|
||||
allocate(h(1:Nx))
|
||||
allocate(R3(1:Ntime+1))
|
||||
allocate(R4(1:Ntime+1))
|
||||
|
||||
CALL INIT_AMPLITUDES(h,def,Nx)
|
||||
endif
|
||||
CALL INIT_COVARIANCES(Ntime,def,R0,R1,R2,R3,R4)
|
||||
|
||||
!print *,'Nx',Nx
|
||||
|
||||
Nj=0
|
||||
indI(1)=0
|
||||
C ***** The bound 'infinity' is set to 10*sigma *****
|
||||
XdInf=10.d0*SQRT(-R2(1))
|
||||
XtInf=10.d0*SQRT(R0(1))
|
||||
!print *,'XdInf,XtInf'
|
||||
!print *,XdInf,XtInf
|
||||
! normalizing constant
|
||||
CC=TWOPI*SQRT(-R0(1)/R2(1))*exp(u*u/(2.d0*R0(1)) )
|
||||
if (abs(def).EQ.4) CC=2.d0*CC
|
||||
allocate(ansr(1:Ntime,1:Nx))
|
||||
ansr=0.d0
|
||||
allocate(fxind(1:Nx))
|
||||
!fxind=0.d0 this is not needed
|
||||
|
||||
if (abs(def).GT.1) then
|
||||
GOTO 200
|
||||
endif
|
||||
NI=4; Nd=2
|
||||
Nc=2; Mb=1
|
||||
Nx=1
|
||||
allocate(BIG(1:Ntime+Nc,1:Ntime+Nc))
|
||||
allocate(xc(1:Nc,1:Nx))
|
||||
allocate(ex(1:Ntime+Nc))
|
||||
ex=0.d0
|
||||
xc(1,1)=u
|
||||
xc(2,1)=u
|
||||
|
||||
if (def.GT.0) then
|
||||
a_up(1,1)=u+XtInf
|
||||
a_lo(1,1)=u
|
||||
a_up(1,2)=XdInf
|
||||
a_lo(1,3)=-XdInf
|
||||
else
|
||||
a_up(1,1)=u
|
||||
a_lo(1,1)=u-XtInf
|
||||
a_lo(1,2)=-XdInf
|
||||
a_up(1,3)= XdInf
|
||||
endif
|
||||
!print *,'Nstart',Nstart
|
||||
Nstart=MAX(2,Nstart)
|
||||
!print *,'Nstart',Nstart
|
||||
if (SCIS.GT.0) then
|
||||
open (unit=11, file='COV.out', STATUS='unknown')
|
||||
write(11,*) 0.d0
|
||||
endif
|
||||
do Ntd=Nstart,Ntime
|
||||
!CALL COV_INPUT2(BIG,Ntd, R0,R1,R2)
|
||||
CALL COV_INPUT(BIG,Ntd,-1,R0,R1,R2,R3,R4) ! positive wave period
|
||||
Nt=Ntd-Nd;
|
||||
indI(2)=Nt;
|
||||
indI(3)=Nt+1;
|
||||
indI(4)=Ntd;
|
||||
Ntdc=Ntd+Nc;
|
||||
!if (SCIS.gt.0) then
|
||||
! if (SCIS.EQ.2) then
|
||||
! Nj=max(Nt,0)
|
||||
! else
|
||||
! Nj=min(max(Nt-5, 0),0)
|
||||
! endif
|
||||
!endif
|
||||
!Ex=0.d0
|
||||
!CALL echo(BIG(1:Ntdc,1:min(7,Ntdc)),Ntdc)
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex(1:Ntdc),
|
||||
& xc,indI,a_lo,a_up)
|
||||
ansr(Ntd,1)=fxind(1)*CC
|
||||
if (SCIS.GT.0) then
|
||||
write(11,*) COV(1) ! save coefficient of variation
|
||||
endif
|
||||
print *,'Ready: ',Ntd,' of ',Ntime
|
||||
enddo
|
||||
if (SCIS.GT.0) then
|
||||
close(11)
|
||||
endif
|
||||
goto 300
|
||||
200 continue
|
||||
XddInf=10.d0*SQRT(R4(1))
|
||||
NI=7; Nd=3
|
||||
Nc=4; Mb=2
|
||||
allocate(BIG(1:Ntime+Nc+1,1:Ntime+Nc+1))
|
||||
ALLOCATE(xc(1:Nc,1:Nx))
|
||||
allocate(ex(1:Ntime+Nc+1))
|
||||
|
||||
ex=0.d0
|
||||
xc(1,1:Nx)=h
|
||||
xc(2,1:Nx)=u
|
||||
xc(3,1:Nx)=u
|
||||
xc(4,1:Nx)=0.d0
|
||||
|
||||
if (def.GT.0) then
|
||||
a_up(2,1)=1.d0 !*h
|
||||
a_lo(1,1)=u
|
||||
a_up(1,2)=XtInf ! X(ts) is redundant
|
||||
a_lo(1,2)=-Xtinf
|
||||
a_up(2,2)=1.d0 ! *h
|
||||
a_lo(2,2)=1.d0 ! *h
|
||||
a_up(2,3)=1.d0 !*h
|
||||
a_lo(1,3)=u
|
||||
|
||||
a_lo(1,4)=-XddInf
|
||||
a_up(1,5)= XdInf
|
||||
a_lo(1,6)=-XdInf
|
||||
else !def<0
|
||||
a_up(1,1)=u
|
||||
a_lo(2,1)=1.d0 !*h
|
||||
a_up(1,2)=XtInf ! X(ts) is redundant
|
||||
a_lo(1,2)=-Xtinf
|
||||
a_up(2,2)=1.d0 ! *h
|
||||
a_lo(2,2)=1.d0 ! *h
|
||||
a_up(1,3)=u
|
||||
a_lo(2,3)=1.d0 !*h
|
||||
|
||||
a_up(1,4)=XddInf
|
||||
a_lo(1,5)=-XdInf
|
||||
a_up(1,6)=XdInf
|
||||
endif
|
||||
|
||||
Nstart=MAX(Nstart,3)
|
||||
do tn=Nstart,Ntime,1
|
||||
Ntd=tn+1
|
||||
Nt=Ntd-Nd
|
||||
Ntdc=Ntd+Nc
|
||||
indI(4)=Nt
|
||||
indI(5)=Nt+1
|
||||
indI(6)=Nt+2
|
||||
indI(7)=Ntd
|
||||
if (SCIS.gt.0) then
|
||||
if (SCIS.EQ.2) then
|
||||
Nj=max(Nt,0)
|
||||
else
|
||||
Nj=min(max(Nt-5, 0),0)
|
||||
endif
|
||||
endif
|
||||
do ts=2,FLOOR(DBLE(tn+1)/2.d0)
|
||||
!print *,'ts,tn' ,ts,tn
|
||||
CALL COV_INPUT(Big(1:Ntdc,1:Ntdc),tn,ts,R0,R1,R2,R3,R4) ! positive wave period
|
||||
indI(2)=ts-2
|
||||
indI(3)=ts-1
|
||||
!CALL echo(BIG(1:Ntdc,1:min(7,Ntdc)),Ntdc)
|
||||
!print *,'sp call rind'
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex(1:Ntdc),
|
||||
& xc,indI,a_lo,a_up)
|
||||
!CALL echo(BIG(1:Ntdc,1:min(7,Ntdc)),Ntdc)
|
||||
!print *,'sp rind finished',fxind
|
||||
!goto 900
|
||||
if (abs(def).LT.3) THEN
|
||||
if (ts .EQ.tn-ts+1) then
|
||||
ds=dt
|
||||
else
|
||||
ds=2.d0*dt
|
||||
endif
|
||||
ansr(tn,1:Nx)=ansr(tn,1:Nx)+fxind*CC*ds
|
||||
else
|
||||
ansr(ts,1:Nx)=ansr(ts,1:Nx)+fxind*CC*dT
|
||||
if ((ts.LT.tn-ts+1).and. (abs(def).lt.4)) THEN
|
||||
ansr(tn-ts+1,1:Nx)=ansr(tn-ts+1,1:Nx)+fxind*CC*dT ! exploiting the symmetry
|
||||
endif
|
||||
endif
|
||||
enddo ! ts
|
||||
print *,'Ready: ',tn,' of ',Ntime
|
||||
|
||||
enddo !tn
|
||||
!print *,'ansr',ansr
|
||||
300 open (unit=11, file='dens.out', STATUS='unknown')
|
||||
!print *, ansr
|
||||
do ts=1,Ntime
|
||||
do ph=1,Nx
|
||||
write(11,*) ansr(ts,ph)
|
||||
! write(11,111) ansr(ts,ph)
|
||||
enddo
|
||||
enddo
|
||||
!111 FORMAT(2x,F12.8)
|
||||
close(11)
|
||||
900 deallocate(big)
|
||||
deallocate(fxind)
|
||||
deallocate(ansr)
|
||||
deallocate(xc)
|
||||
deallocate(ex)
|
||||
deallocate(R0)
|
||||
deallocate(R1)
|
||||
deallocate(R2)
|
||||
if (allocated(COV) ) then
|
||||
deallocate(COV)
|
||||
endif
|
||||
if (allocated(R3)) then
|
||||
deallocate(R3)
|
||||
deallocate(R4)
|
||||
deallocate(h)
|
||||
ENDIF
|
||||
stop
|
||||
!return
|
||||
|
||||
CONTAINS
|
||||
|
||||
|
||||
|
||||
SUBROUTINE INIT_LEVELS
|
||||
& (U,def,Ntime,Nstart,NIT,speed,SCIS,seed1,Nx,dT)
|
||||
IMPLICIT NONE
|
||||
integer, intent(out):: def,Ntime,Nstart,NIT,speed,Nx,SCIS,seed1
|
||||
double precision ,intent(out) :: U,dT
|
||||
|
||||
|
||||
OPEN(UNIT=14,FILE='reflev.in',STATUS= 'UNKNOWN')
|
||||
READ (14,*) U
|
||||
READ (14,*) def
|
||||
READ (14,*) Ntime
|
||||
READ (14,*) Nstart
|
||||
READ (14,*) NIT
|
||||
READ (14,*) speed
|
||||
READ (14,*) SCIS
|
||||
READ (14,*) seed1
|
||||
|
||||
if (abs(def).GT.1) then
|
||||
READ (14,*) Nx
|
||||
READ (14,*) dT
|
||||
if (Ntime.lt.3) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
else
|
||||
Nx=1
|
||||
if (Ntime.lt.2) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
endif
|
||||
CLOSE(UNIT=14)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_LEVELS
|
||||
|
||||
C******************************************************
|
||||
SUBROUTINE INIT_AMPLITUDES(h,def,Nx)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:), intent(out) :: h
|
||||
integer, intent(in) :: def
|
||||
integer, intent(in) :: Nx
|
||||
integer :: ix
|
||||
|
||||
|
||||
OPEN(UNIT=4,FILE='h.in',STATUS= 'UNKNOWN')
|
||||
|
||||
C
|
||||
C Reading in amplitudes
|
||||
C
|
||||
do ix=1,Nx
|
||||
READ (4,*) H(ix)
|
||||
enddo
|
||||
CLOSE(UNIT=4)
|
||||
!if (def.LT.0) THEN
|
||||
! H=-H
|
||||
!endif
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_AMPLITUDES
|
||||
|
||||
C**************************************************
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
SUBROUTINE INIT_COVARIANCES(Ntime,def,R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:),intent(out) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(out) :: R3,R4
|
||||
integer,intent(in) :: Ntime,def
|
||||
integer :: i
|
||||
open (unit=1, file='Cd0.in',STATUS='unknown')
|
||||
open (unit=2, file='Cd1.in',STATUS='unknown')
|
||||
open (unit=3, file='Cd2.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(1,*) R0(i)
|
||||
read(2,*) R1(i)
|
||||
read(3,*) R2(i)
|
||||
enddo
|
||||
close(1)
|
||||
close(2)
|
||||
close(3)
|
||||
|
||||
if (abs(def).GT.1) then
|
||||
open (unit=4, file='Cd3.in',STATUS='unknown')
|
||||
open (unit=5, file='Cd4.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(4,*) R3(i)
|
||||
read(5,*) R4(i)
|
||||
enddo
|
||||
|
||||
close(4)
|
||||
close(5)
|
||||
endif
|
||||
return
|
||||
END SUBROUTINE INIT_COVARIANCES
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
C**********************************************************************
|
||||
|
||||
SUBROUTINE COV_INPUT(BIG,tn,ts, R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),intent(inout) :: BIG
|
||||
double precision, dimension(:),intent(in) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(in) :: R3,R4
|
||||
integer ,intent(in) :: tn,ts
|
||||
integer :: i,j,shft,Ntd1,N !=Ntdc
|
||||
double precision :: tmp
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows:
|
||||
! For ts>1:
|
||||
! ||X(t2)..X(ts),..X(tn-1)||X''(ts) X'(t1) X'(tn)||X(ts) X(t1) X(tn) X'(ts)||
|
||||
! = [Xt Xd Xc]
|
||||
!
|
||||
! For ts<=1:
|
||||
! ||X(t2)..,..X(tn-1)||X'(t1) X'(tn)||X(t1) X(tn)||
|
||||
! = [Xt Xd Xc]
|
||||
|
||||
! where
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
if (ts.LE.1) THEN
|
||||
Ntd1=tn
|
||||
N=Ntd1+2;
|
||||
shft=0 ! def=1 want only crest period Tc
|
||||
else
|
||||
Ntd1=tn+1
|
||||
N=Ntd1+4
|
||||
shft=1 ! def=2 or 3 want Tc Ac or Tcf, Ac
|
||||
endif
|
||||
|
||||
do i=1,tn-2
|
||||
!cov(Xt)
|
||||
do j=i,tn-2
|
||||
BIG(i,j) = R0(j-i+1) ! cov(X(ti+1),X(tj+1))
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
BIG(i ,Ntd1+1+shft) = R0(i+1) !cov(X(ti+1),X(t1))
|
||||
BIG(tn-1-i ,Ntd1+2+shft) = R0(i+1) !cov(X(t.. ),X(tn))
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj)
|
||||
BIG(i,Ntd1-1) =-R1(i+1) !cov(X(ti+1),X' (t1))
|
||||
BIG(tn-1-i,Ntd1)= R1(i+1) !cov(X(ti+1),X' (tn))
|
||||
enddo
|
||||
!call echo(big(1:tn,1:tn),tn)
|
||||
!cov(Xd)
|
||||
BIG(Ntd1 ,Ntd1 ) = -R2(1)
|
||||
BIG(Ntd1-1,Ntd1 ) = -R2(tn) !cov(X'(t1),X'(tn))
|
||||
BIG(Ntd1-1,Ntd1-1) = -R2(1)
|
||||
|
||||
!cov(Xc)
|
||||
BIG(Ntd1+1+shft,Ntd1+1+shft) = R0(1) ! cov(X(t1),X (t1))
|
||||
BIG(Ntd1+1+shft,Ntd1+2+shft) = R0(tn) ! cov(X(t1),X (tn))
|
||||
BIG(Ntd1+2+shft,Ntd1+2+shft) = R0(1) ! cov(X(tn),X (tn))
|
||||
!cov(Xd,Xc)
|
||||
BIG(Ntd1 ,Ntd1+1+shft) = R1(tn) !cov(X'(tn),X(t1))
|
||||
BIG(Ntd1 ,Ntd1+2+shft) = 0.d0 !cov(X'(tn),X(tn))
|
||||
BIG(Ntd1-1,Ntd1+1+shft) = 0.d0 !cov(X'(t1),X(t1))
|
||||
BIG(Ntd1-1,Ntd1+2+shft) =-R1(tn) !cov(X'(t1),X(tn))
|
||||
|
||||
|
||||
if (ts.GT.1) then
|
||||
|
||||
!
|
||||
!cov(Xc)
|
||||
BIG(Ntd1+1,Ntd1+1) = R0(1) ! cov(X(ts),X (ts)
|
||||
BIG(Ntd1+1,Ntd1+2) = R0(ts) ! cov(X(ts),X (t1))
|
||||
BIG(Ntd1+1,Ntd1+3) = R0(tn+1-ts) ! cov(X(ts),X (tn))
|
||||
BIG(Ntd1+1,Ntd1+4) = 0.d0 ! cov(X(ts),X'(ts))
|
||||
|
||||
BIG(Ntd1+2,Ntd1+4) = R1(ts) ! cov(X(t1),X'(ts))
|
||||
BIG(Ntd1+3,Ntd1+4) = -R1(tn+1-ts) !cov(X(tn),X'(ts))
|
||||
BIG(Ntd1+4,Ntd1+4) = -R2(1) ! cov(X'(ts),X'(ts))
|
||||
|
||||
!cov(Xd)
|
||||
BIG(Ntd1-2,Ntd1-1) = -R3(ts) !cov(X''(ts),X'(t1))
|
||||
BIG(Ntd1-2,Ntd1-2) = R4(1)
|
||||
BIG(Ntd1-2,Ntd1 ) = R3(tn+1-ts) !cov(X''(ts),X'(tn))
|
||||
!cov(Xd,Xc)
|
||||
BIG(Ntd1 ,Ntd1+4) =-R2(tn+1-ts) !cov(X'(tn),X'(ts))
|
||||
BIG(Ntd1 ,Ntd1+1) = R1(tn+1-ts) !cov(X'(tn),X (ts))
|
||||
|
||||
BIG(Ntd1-1,Ntd1+4) =-R2(ts) !cov(X'(t1),X'(ts))
|
||||
BIG(Ntd1-1,Ntd1+1) =-R1(ts) !cov(X'(t1),X (ts))
|
||||
|
||||
BIG(Ntd1-2,Ntd1+1) = R2(1) !cov(X''(ts),X (ts)
|
||||
BIG(Ntd1-2,Ntd1+2) = R2(ts) !cov(X''(ts),X (t1))
|
||||
BIG(Ntd1-2,Ntd1+3) = R2(tn+1-ts) !cov(X''(ts),X (tn))
|
||||
BIG(Ntd1-2,Ntd1+4) = 0.d0 !cov(X''(ts),X'(ts))
|
||||
!cov(Xt,Xc)
|
||||
do i=1,tn-2
|
||||
j=abs(i+1-ts)
|
||||
BIG(i,Ntd1+1) = R0(j+1) !cov(X(ti+1),X(ts))
|
||||
BIG(i,Ntd1+4) = sign(R1(j+1),R1(j+1)*dble(ts-i-1)) !cov(X(ti+1),X'(ts)) ! check this
|
||||
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),X(ts))
|
||||
BIG(i,Ntd1-2) = R2(j+1) !cov(X(ti+1),X''(ts))
|
||||
enddo
|
||||
endif ! ts>1
|
||||
|
||||
!call echo(big(1:N,1:N),N)
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,N-1
|
||||
do i=j+1,N
|
||||
tmp =BIG(j,i)
|
||||
|
||||
BIG(i,j)=tmp
|
||||
enddo
|
||||
!call echo(big(1:N,1:N),N)
|
||||
|
||||
enddo
|
||||
!call echo(big(1:N,1:N),N)
|
||||
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT
|
||||
|
||||
SUBROUTINE COV_INPUT2(BIG,pt, R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:), intent(out) :: BIG
|
||||
double precision, dimension(:), intent(in) :: R0,R1,R2
|
||||
integer :: pt,i,j
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows;
|
||||
! X(t2)...X(tn-1) X'(t1) X'(tn) X(t1) X(tn) = [Xt Xd Xc]
|
||||
!
|
||||
! where Xd is the derivatives
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
!cov(Xc)
|
||||
BIG(pt+2,pt+2) = R0(1)
|
||||
BIG(pt+1,pt+1) = R0(1)
|
||||
BIG(pt+1,pt+2) = R0(pt)
|
||||
!cov(Xd)
|
||||
BIG(pt,pt) = -R2(1)
|
||||
BIG(pt-1,pt-1) = -R2(1)
|
||||
BIG(pt-1,pt) = -R2(pt)
|
||||
!cov(Xd,Xc)
|
||||
BIG(pt,pt+2) = 0.d0
|
||||
BIG(pt,pt+1) = R1(pt)
|
||||
BIG(pt-1,pt+2) = -R1(pt)
|
||||
BIG(pt-1,pt+1) = 0.d0
|
||||
|
||||
if (pt.GT.2) then
|
||||
!cov(Xt)
|
||||
do i=1,pt-2
|
||||
do j=i,pt-2
|
||||
BIG(i,j) = R0(j-i+1)
|
||||
enddo
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
do i=1,pt-2
|
||||
BIG(i,pt+1) = R0(i+1)
|
||||
BIG(pt-1-i,pt+2) = R0(i+1)
|
||||
enddo
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj))
|
||||
do i=1,pt-2
|
||||
BIG(i,pt-1) = -R1(i+1)
|
||||
BIG(pt-1-i,pt)= R1(i+1)
|
||||
enddo
|
||||
endif
|
||||
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,pt+1
|
||||
do i=j+1,pt+2
|
||||
BIG(i,j)=BIG(j,i)
|
||||
enddo
|
||||
enddo
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT2
|
||||
|
||||
|
||||
END PROGRAM sp2thpdf
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,632 +0,0 @@
|
||||
PROGRAM sp2thpdf
|
||||
!***********************************************************************
|
||||
! This program computes: *
|
||||
! *
|
||||
! density of S_i,Hi,T_i in a gaussian process i.e. *
|
||||
! *
|
||||
! quart wavelength (up-crossing to crest) and crest amplitude *
|
||||
!
|
||||
! def = 1, gives half wave period, Tc (default).
|
||||
! -1, gives half wave period, Tt.
|
||||
! 2, gives half wave period and wave crest amplitude (Tc,Ac).
|
||||
! -2, gives half wave period and wave trough amplitude (Tt,At).
|
||||
! 3, gives crest front period and wave crest amplitude (Tcf,Ac).
|
||||
! -3, gives trough back period and wave trough amplitude (Ttb,At).
|
||||
! 4, gives minimum of crest front/back period and wave crest
|
||||
! amplitude (min(Tcf,Tcb),Ac).
|
||||
! -4, gives minimum of trough front/back period and wave trough
|
||||
! amplitude (min(Ttf,Ttb),At).
|
||||
!***********************************************************************
|
||||
!History:
|
||||
! revised Per A. Brodtkorb 04.04.2000
|
||||
! -
|
||||
! revised Per A. Brodtkorb 23.11.99
|
||||
! - fixed a bug in calculating pdf for def = +/- 4
|
||||
! revised Per A. Brodtkorb 03.11.99
|
||||
! - added def = +/-4
|
||||
! revised Per A. Brodtkorb 23.09.99
|
||||
! - minor changes to covinput
|
||||
! - removed the calculation of the transformation to spec2thpdf.m
|
||||
! by Igor Rychlik
|
||||
|
||||
|
||||
use GLOBALDATA, only : rateLHD,SCIS,NSIMmax,COV,ABSEPS
|
||||
use globalconst
|
||||
use rind
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),allocatable :: BIG
|
||||
double precision, dimension(:,:),allocatable :: ansr
|
||||
double precision, dimension(: ),allocatable :: ex
|
||||
double precision, dimension(:,:),allocatable :: xc
|
||||
double precision, dimension(: ),allocatable :: fxind,h
|
||||
double precision, dimension(: ),allocatable :: R0,R1,R2,R3,R4
|
||||
double precision ::CC,U,XddInf,XdInf,XtInf
|
||||
double precision, dimension(2,6) :: a_up=0.d0,a_lo=0.d0
|
||||
integer, dimension(6) :: INFIN=2
|
||||
integer , dimension(: ),allocatable :: seed
|
||||
integer ,dimension(7) :: indI
|
||||
integer :: Nx,Nt,Nc,Nd,NI,Mb,Ntd, Ntdc
|
||||
integer :: Nstart,Ntime,tn,ts,speed,ph,def,seed1,seed_size
|
||||
double precision :: dT, EPSOLD ! lag spacing for covariances
|
||||
LOGICAL :: init=.TRUE.
|
||||
! DIGITAL:
|
||||
! f90 -g2 -C -automatic -o ../wave/alpha/sp2thpdf.exe rind44.f sp2thpdf.f
|
||||
! SOLARIS:
|
||||
!f90 -g -O -w3 -Bdynamic -fixed -o ../wave/sol2/sp2thpdf.exe rind44.f sp2thpdf.f
|
||||
! linux:
|
||||
! f90 -gline -Nl126 -C -o ../exec/lnx86/sp2thpdf8.exe intmodule.f rind60.f sp2thpdf.f
|
||||
! f90 -gline -Nl126 -C -o sp2thpdf.exe rind45.f sp2thpdf.f
|
||||
! f90 -gline -Nl126 -C -o ../exec/lnx86/sp2thpdf3.exe adaptmodule.f krbvrcmod.f krobovmod.f rcrudemod.f rind55.f sp2thpdf.f
|
||||
! HP700
|
||||
!f90 -g -C -o ../exec/hp700/sp2thpdf.exe rind45.f sp2thpdf.f
|
||||
!f90 -g -C +check=all +FPVZID -o ../exec/hp700/sp2thpdf.exe rind45.f sp2thpdf.f
|
||||
! f90 +gprof +extend_source +Oall +Odataprefetch +Ofastaccess +Oinfo +Oprocelim -C +check=all -o ../exec/hp700/sp2thpdf.exe rind48.f sp2thpdf.f
|
||||
|
||||
!print *,'enter sp2thpdf'
|
||||
|
||||
CALL INIT_LEVELS(U,def,Ntime,Nstart,speed,SCIS,seed1,
|
||||
& Nx,dT,rateLHD)
|
||||
!print *,'U,def,Ntime,Nstart,NIT,speed,SCIS,seed1,Nx,dT'
|
||||
!print *,U,def,Ntime,Nstart,NIT,speed,SCIS,seed1,Nx,dT
|
||||
|
||||
|
||||
if (SCIS.GT.0) then
|
||||
!allocate(COV(1:Nx))
|
||||
call random_seed(SIZE=seed_size)
|
||||
allocate(seed(seed_size))
|
||||
call random_seed(GET=seed(1:seed_size)) ! get current seed
|
||||
seed(1)=seed1 ! change seed
|
||||
call random_seed(PUT=seed(1:seed_size))
|
||||
deallocate(seed)
|
||||
endif
|
||||
CALL INITDATA(speed)
|
||||
!print *,ntime,speed,u,NIT
|
||||
allocate(R0(1:Ntime+1))
|
||||
allocate(R1(1:Ntime+1))
|
||||
allocate(R2(1:Ntime+1))
|
||||
if (abs(def).GT.1) THEN
|
||||
allocate(h(1:Nx))
|
||||
allocate(R3(1:Ntime+1))
|
||||
allocate(R4(1:Ntime+1))
|
||||
CALL INIT_AMPLITUDES(h,def,Nx)
|
||||
endif
|
||||
CALL INIT_COVARIANCES(Ntime,def,R0,R1,R2,R3,R4)
|
||||
|
||||
!print *,'Nx',Nx
|
||||
|
||||
|
||||
indI(1)=0
|
||||
C ***** The bound 'infinity' is set to 10*sigma *****
|
||||
XdInf=10.d0*SQRT(-R2(1))
|
||||
XtInf=10.d0*SQRT(R0(1))
|
||||
!print *,'XdInf,XtInf'
|
||||
!print *,XdInf,XtInf
|
||||
! normalizing constant
|
||||
CC=TWPI*SQRT(-R0(1)/R2(1))*exp(u*u/(2.d0*R0(1)) )
|
||||
allocate(ansr(1:Ntime,1:Nx))
|
||||
ansr=0.d0
|
||||
allocate(fxind(1:Nx))
|
||||
!fxind=0.d0 this is not needed
|
||||
|
||||
if (abs(def).GT.1) GOTO 200
|
||||
|
||||
NI=4; Nd=2
|
||||
Nc=2; Mb=1
|
||||
Nx=1
|
||||
allocate(BIG(1:Ntime+Nc,1:Ntime+Nc))
|
||||
allocate(xc(1:Nc,1:Nx))
|
||||
allocate(ex(1:Ntime+Nc))
|
||||
ex=0.d0
|
||||
xc(1,1)=u
|
||||
xc(2,1)=u
|
||||
! INFIN = INTEGER, array of integration limits flags: size 1 x Nb (in)
|
||||
! if INFIN(I) < 0, Ith limits are (-infinity, infinity);
|
||||
! if INFIN(I) = 0, Ith limits are (-infinity, Hup(I)];
|
||||
! if INFIN(I) = 1, Ith limits are [Hlo(I), infinity);
|
||||
! if INFIN(I) = 2, Ith limits are [Hlo(I), Hup(I)].
|
||||
|
||||
if (def.GT.0) then
|
||||
INFIN(1:2) = 1
|
||||
INFIN(3) = 0
|
||||
a_up(1,1)= u+XtInf
|
||||
a_lo(1,1)= u
|
||||
a_up(1,2)= XdInf
|
||||
a_lo(1,3)=-XdInf
|
||||
else
|
||||
INFIN(1:2) = 0
|
||||
INFIN(3) = 1
|
||||
a_up(1,1)=u
|
||||
a_lo(1,1)=u-XtInf
|
||||
a_lo(1,2)=-XdInf
|
||||
a_up(1,3)= XdInf
|
||||
endif
|
||||
!print *,'Nstart',Nstart
|
||||
Nstart=MAX(2,Nstart)
|
||||
!print *,'Nstart',Nstart
|
||||
if (ALLOCATED(COV)) then
|
||||
open (unit=11, file='COV.out', STATUS='unknown')
|
||||
write(11,*) 0.d0
|
||||
endif
|
||||
do Ntd=Nstart,Ntime
|
||||
!CALL COV_INPUT2(BIG,Ntd, R0,R1,R2)
|
||||
CALL COV_INPUT(BIG,Ntd,-1,R0,R1,R2,R3,R4) ! positive wave period
|
||||
Nt=Ntd-Nd;
|
||||
indI(2)=Nt;
|
||||
indI(3)=Nt+1;
|
||||
indI(4)=Ntd;
|
||||
Ntdc=Ntd+Nc;
|
||||
! IF (Ntd.GT.5.AND.(INIT)) THEN
|
||||
! INIT=.FALSE.
|
||||
! CALL INITDATA(speed)
|
||||
! ENDIF
|
||||
!if (SCIS.gt.1) Nj=Nt
|
||||
!if (SCIS.gt.0) then
|
||||
! if (SCIS.EQ.2) then
|
||||
! Nj=max(Nt,0)
|
||||
! else
|
||||
! Nj=min(max(Nt-5, 0),0)
|
||||
! endif
|
||||
!endif
|
||||
!Ex=0.d0
|
||||
!CALL echo(BIG(1:Ntdc,1:min(7,Ntdc)),Ntdc)
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex(1:Ntdc),xc,
|
||||
& Nt,indI(1:NI),a_lo(1:Mb,1:NI-1),a_up(1:Mb,1:NI-1),
|
||||
& INFIN(1:NI-1))
|
||||
ansr(Ntd,1)=fxind(1)*CC
|
||||
if (ALLOCATED(COV)) then !SCIS.GT.0
|
||||
write(11,*) COV(1) ! save coefficient of variation
|
||||
endif
|
||||
print *,'Ready: ',Ntd,' of ',Ntime
|
||||
enddo
|
||||
if (ALLOCATED(COV)) then
|
||||
close(11)
|
||||
endif
|
||||
goto 300
|
||||
200 continue
|
||||
XddInf=10.d0*SQRT(R4(1))
|
||||
NI=7; Nd=3
|
||||
Nc=4; Mb=2
|
||||
allocate(BIG(1:Ntime+Nc+1,1:Ntime+Nc+1))
|
||||
ALLOCATE(xc(1:Nc,1:Nx))
|
||||
allocate(ex(1:Ntime+Nc+1))
|
||||
|
||||
ex=0.d0
|
||||
xc(1,1:Nx)=h(1:Nx)
|
||||
xc(2,1:Nx)=u
|
||||
xc(3,1:Nx)=u
|
||||
xc(4,1:Nx)=0.d0
|
||||
|
||||
! INFIN = INTEGER, array of integration limits flags: size 1 x Nb (in)
|
||||
! if INFIN(I) < 0, Ith limits are (-infinity, infinity);
|
||||
! if INFIN(I) = 0, Ith limits are (-infinity, Hup(I)];
|
||||
! if INFIN(I) = 1, Ith limits are [Hlo(I), infinity);
|
||||
! if INFIN(I) = 2, Ith limits are [Hlo(I), Hup(I)].
|
||||
if (def.GT.0) then
|
||||
INFIN(2)=-1
|
||||
INFIN(4)=0
|
||||
INFIN(5)=1
|
||||
INFIN(6)=0
|
||||
a_up(2,1)=1.d0 !*h
|
||||
a_lo(1,1)=u
|
||||
a_up(1,2)=XtInf ! X(ts) is redundant
|
||||
a_lo(1,2)=-Xtinf
|
||||
a_up(2,2)=1.d0 ! *h
|
||||
a_lo(2,2)=1.d0 ! *h
|
||||
a_up(2,3)=1.d0 !*h
|
||||
a_lo(1,3)=u
|
||||
|
||||
a_lo(1,4)=-XddInf
|
||||
a_up(1,5)= XdInf
|
||||
a_lo(1,6)=-XdInf
|
||||
else !def<0
|
||||
INFIN(2)=-1
|
||||
INFIN(4)=1
|
||||
INFIN(5)=0
|
||||
INFIN(6)=1
|
||||
a_up(1,1)=u
|
||||
a_lo(2,1)=1.d0 !*h
|
||||
a_up(1,2)=XtInf ! X(ts) is redundant
|
||||
a_lo(1,2)=-Xtinf
|
||||
a_up(2,2)=1.d0 ! *h
|
||||
a_lo(2,2)=1.d0 ! *h
|
||||
a_up(1,3)=u
|
||||
a_lo(2,3)=1.d0 !*h
|
||||
a_up(1,4)=XddInf
|
||||
a_lo(1,5)=-XdInf
|
||||
a_up(1,6)=XdInf
|
||||
endif
|
||||
EPSOLD=ABSEPS
|
||||
Nstart=MAX(Nstart,3)
|
||||
do tn=Nstart,Ntime,1
|
||||
Ntd=tn+1
|
||||
Nt=Ntd-Nd
|
||||
Ntdc=Ntd+Nc
|
||||
indI(4)=Nt
|
||||
indI(5)=Nt+1
|
||||
indI(6)=Nt+2
|
||||
indI(7)=Ntd
|
||||
! IF (Ntd.GT.5.AND.INIT) THEN
|
||||
! INIT=.FALSE.
|
||||
! CALL INITDATA(speed)
|
||||
! ENDIF
|
||||
!if (SCIS.gt.1) Nj=Nt
|
||||
!if (SCIS.gt.0) then
|
||||
! if (SCIS.EQ.2) then
|
||||
! Nj=max(Nt,0)
|
||||
! else
|
||||
! Nj=min(max(Nt-5, 0),0)
|
||||
! endif
|
||||
!endif
|
||||
ABSEPS=MIN(SQRT(DBLE(tn))*EPSOLD*0.5D0,0.1D0)
|
||||
do ts=2,FLOOR(DBLE(tn+1)/2.d0)
|
||||
!print *,'ts,tn' ,ts,tn
|
||||
CALL COV_INPUT(Big(1:Ntdc,1:Ntdc),tn,ts,R0,R1,R2,R3,R4) ! positive wave period
|
||||
indI(2)=ts-2
|
||||
indI(3)=ts-1
|
||||
!CALL echo(BIG(1:Ntdc,1:min(7,Ntdc)),Ntdc)
|
||||
!print *,'sp call rind'
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex(1:Ntdc),xc,
|
||||
& Nt,indI(1:NI),a_lo(1:Mb,1:NI-1),a_up(1:Mb,1:NI-1),
|
||||
& INFIN(1:NI-1))
|
||||
!CALL echo(BIG(1:Ntdc,1:min(7,Ntdc)),Ntdc)
|
||||
!print *,'sp rind finished',fxind
|
||||
!goto 900
|
||||
SELECT CASE (ABS(def))
|
||||
CASE (:2)
|
||||
! 2, gives half wave period and wave crest amplitude (Tc,Ac).
|
||||
! -2, gives half wave period and wave trough amplitude (Tt,At).
|
||||
if (ts .EQ.tn-ts+1) then
|
||||
ansr(tn,1:Nx)=ansr(tn,1:Nx)+fxind*CC*dt
|
||||
else
|
||||
ansr(tn,1:Nx)=ansr(tn,1:Nx)+fxind*CC*2.d0*dt
|
||||
endif
|
||||
CASE (3)
|
||||
! 3, gives crest front period and wave crest amplitude (Tcf,Ac).
|
||||
! -3, gives trough back period and wave trough amplitude (Ttb,At).
|
||||
ansr(ts,1:Nx)=ansr(ts,1:Nx)+fxind*CC*dT
|
||||
if ((ts.LT.tn-ts+1)) THEN
|
||||
ansr(tn-ts+1,1:Nx)=ansr(tn-ts+1,1:Nx)+fxind*CC*dT ! exploiting the symmetry
|
||||
endif
|
||||
CASE (4:)
|
||||
! 4, gives minimum of crest front/back period and wave crest amplitude (min(Tcf,Tcb),Ac).
|
||||
! -4, gives minimum of trough front/back period and wave trough amplitude (min(Ttf,Ttb),At).
|
||||
if (ts .EQ.tn-ts+1) then
|
||||
ansr(ts,1:Nx)=ansr(ts,1:Nx)+fxind*CC*dt
|
||||
else
|
||||
ansr(ts,1:Nx)=ansr(ts,1:Nx)+fxind*CC*2.0*dt
|
||||
endif
|
||||
end select
|
||||
enddo ! ts
|
||||
print *,'Ready: ',tn,' of ',Ntime, ' ABSEPS = ', ABSEPS
|
||||
|
||||
enddo !tn
|
||||
!print *,'ansr',ansr
|
||||
300 open (unit=11, file='dens.out', STATUS='unknown')
|
||||
!print *, ansr
|
||||
do ts=1,Ntime
|
||||
do ph=1,Nx
|
||||
write(11,*) ansr(ts,ph)
|
||||
! write(11,111) ansr(ts,ph)
|
||||
enddo
|
||||
enddo
|
||||
!111 FORMAT(2x,F12.8)
|
||||
close(11)
|
||||
900 deallocate(big)
|
||||
deallocate(fxind)
|
||||
deallocate(ansr)
|
||||
deallocate(xc)
|
||||
deallocate(ex)
|
||||
deallocate(R0)
|
||||
deallocate(R1)
|
||||
deallocate(R2)
|
||||
if (allocated(COV) ) then
|
||||
deallocate(COV)
|
||||
endif
|
||||
if (allocated(R3)) then
|
||||
deallocate(R3)
|
||||
deallocate(R4)
|
||||
deallocate(h)
|
||||
ENDIF
|
||||
stop
|
||||
!return
|
||||
|
||||
CONTAINS
|
||||
|
||||
|
||||
|
||||
SUBROUTINE INIT_LEVELS
|
||||
& (U,def,Ntime,Nstart,speed,SCIS,seed1,Nx,dT,rateLHD)
|
||||
IMPLICIT NONE
|
||||
integer, intent(out):: def,Ntime,Nstart,speed,Nx,SCIS,seed1,
|
||||
& rateLHD
|
||||
double precision ,intent(out) :: U,dT
|
||||
double precision :: XSPLT
|
||||
integer :: NIT
|
||||
|
||||
|
||||
OPEN(UNIT=14,FILE='reflev.in',STATUS= 'UNKNOWN')
|
||||
READ (14,*) U
|
||||
READ (14,*) def
|
||||
READ (14,*) Ntime
|
||||
READ (14,*) Nstart
|
||||
READ (14,*) NIT
|
||||
READ (14,*) speed
|
||||
READ (14,*) SCIS
|
||||
READ (14,*) seed1
|
||||
READ (14,*) Nx
|
||||
READ (14,*) dT
|
||||
READ (14,*) rateLHD
|
||||
READ (14,*) XSPLT
|
||||
if (abs(def).GT.1) then
|
||||
|
||||
if (Ntime.lt.3) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
else
|
||||
Nx=1
|
||||
if (Ntime.lt.2) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
endif
|
||||
CLOSE(UNIT=14)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_LEVELS
|
||||
|
||||
C******************************************************
|
||||
SUBROUTINE INIT_AMPLITUDES(h,def,Nx)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:), intent(out) :: h
|
||||
integer, intent(in) :: def
|
||||
integer, intent(in) :: Nx
|
||||
integer :: ix
|
||||
|
||||
|
||||
OPEN(UNIT=4,FILE='h.in',STATUS= 'UNKNOWN')
|
||||
|
||||
C
|
||||
C Reading in amplitudes
|
||||
C
|
||||
do ix=1,Nx
|
||||
READ (4,*) H(ix)
|
||||
enddo
|
||||
CLOSE(UNIT=4)
|
||||
!if (def.LT.0) THEN
|
||||
! H=-H
|
||||
!endif
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_AMPLITUDES
|
||||
|
||||
C**************************************************
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
SUBROUTINE INIT_COVARIANCES(Ntime,def,R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:),intent(out) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(out) :: R3,R4
|
||||
integer,intent(in) :: Ntime,def
|
||||
integer :: i
|
||||
open (unit=1, file='Cd0.in',STATUS='unknown')
|
||||
open (unit=2, file='Cd1.in',STATUS='unknown')
|
||||
open (unit=3, file='Cd2.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(1,*) R0(i)
|
||||
read(2,*) R1(i)
|
||||
read(3,*) R2(i)
|
||||
enddo
|
||||
close(1)
|
||||
close(2)
|
||||
close(3)
|
||||
|
||||
if (abs(def).GT.1) then
|
||||
open (unit=4, file='Cd3.in',STATUS='unknown')
|
||||
open (unit=5, file='Cd4.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(4,*) R3(i)
|
||||
read(5,*) R4(i)
|
||||
enddo
|
||||
|
||||
close(4)
|
||||
close(5)
|
||||
endif
|
||||
return
|
||||
END SUBROUTINE INIT_COVARIANCES
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
C**********************************************************************
|
||||
|
||||
SUBROUTINE COV_INPUT(BIG,tn,ts, R0,R1,R2,R3,R4)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),intent(inout) :: BIG
|
||||
double precision, dimension(:),intent(in) :: R0,R1,R2
|
||||
double precision, dimension(:),intent(in) :: R3,R4
|
||||
integer ,intent(in) :: tn,ts
|
||||
integer :: i,j,shft,Ntd1,N !=Ntdc
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows:
|
||||
! For ts>1:
|
||||
! ||X(t2)..X(ts),..X(tn-1)||X''(ts) X'(t1) X'(tn)||X(ts) X(t1) X(tn) X'(ts)||
|
||||
! = [Xt Xd Xc]
|
||||
!
|
||||
! For ts<=1:
|
||||
! ||X(t2)..,..X(tn-1)||X'(t1) X'(tn)||X(t1) X(tn)||
|
||||
! = [Xt Xd Xc]
|
||||
|
||||
! where
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
if (ts.LE.1) THEN
|
||||
Ntd1=tn
|
||||
N=Ntd1+2;
|
||||
shft=0 ! def=1 want only crest period Tc
|
||||
else
|
||||
Ntd1=tn+1
|
||||
N=Ntd1+4
|
||||
shft=1 ! def=2 or 3 want Tc Ac or Tcf, Ac
|
||||
endif
|
||||
|
||||
do i=1,tn-2
|
||||
!cov(Xt)
|
||||
do j=i,tn-2
|
||||
BIG(i,j) = R0(j-i+1) ! cov(X(ti+1),X(tj+1))
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
BIG(i ,Ntd1+1+shft) = R0(i+1) !cov(X(ti+1),X(t1))
|
||||
BIG(tn-1-i ,Ntd1+2+shft) = R0(i+1) !cov(X(t.. ),X(tn))
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj)
|
||||
BIG(i,Ntd1-1) =-R1(i+1) !cov(X(ti+1),X' (t1))
|
||||
BIG(tn-1-i,Ntd1)= R1(i+1) !cov(X(ti+1),X' (tn))
|
||||
enddo
|
||||
!call echo(big(1:tn,1:tn),tn)
|
||||
!cov(Xd)
|
||||
BIG(Ntd1 ,Ntd1 ) = -R2(1)
|
||||
BIG(Ntd1-1,Ntd1 ) = -R2(tn) !cov(X'(t1),X'(tn))
|
||||
BIG(Ntd1-1,Ntd1-1) = -R2(1)
|
||||
|
||||
!cov(Xc)
|
||||
BIG(Ntd1+1+shft,Ntd1+1+shft) = R0(1) ! cov(X(t1),X (t1))
|
||||
BIG(Ntd1+1+shft,Ntd1+2+shft) = R0(tn) ! cov(X(t1),X (tn))
|
||||
BIG(Ntd1+2+shft,Ntd1+2+shft) = R0(1) ! cov(X(tn),X (tn))
|
||||
!cov(Xd,Xc)
|
||||
BIG(Ntd1 ,Ntd1+1+shft) = R1(tn) !cov(X'(tn),X(t1))
|
||||
BIG(Ntd1 ,Ntd1+2+shft) = 0.d0 !cov(X'(tn),X(tn))
|
||||
BIG(Ntd1-1,Ntd1+1+shft) = 0.d0 !cov(X'(t1),X(t1))
|
||||
BIG(Ntd1-1,Ntd1+2+shft) =-R1(tn) !cov(X'(t1),X(tn))
|
||||
|
||||
|
||||
if (ts.GT.1) then
|
||||
|
||||
!
|
||||
!cov(Xc)
|
||||
BIG(Ntd1+1,Ntd1+1) = R0(1) ! cov(X(ts),X (ts)
|
||||
BIG(Ntd1+1,Ntd1+2) = R0(ts) ! cov(X(ts),X (t1))
|
||||
BIG(Ntd1+1,Ntd1+3) = R0(tn+1-ts) ! cov(X(ts),X (tn))
|
||||
BIG(Ntd1+1,Ntd1+4) = 0.d0 ! cov(X(ts),X'(ts))
|
||||
|
||||
BIG(Ntd1+2,Ntd1+4) = R1(ts) ! cov(X(t1),X'(ts))
|
||||
BIG(Ntd1+3,Ntd1+4) = -R1(tn+1-ts) !cov(X(tn),X'(ts))
|
||||
BIG(Ntd1+4,Ntd1+4) = -R2(1) ! cov(X'(ts),X'(ts))
|
||||
|
||||
!cov(Xd)
|
||||
BIG(Ntd1-2,Ntd1-1) = -R3(ts) !cov(X''(ts),X'(t1))
|
||||
BIG(Ntd1-2,Ntd1-2) = R4(1)
|
||||
BIG(Ntd1-2,Ntd1 ) = R3(tn+1-ts) !cov(X''(ts),X'(tn))
|
||||
!cov(Xd,Xc)
|
||||
BIG(Ntd1 ,Ntd1+4) =-R2(tn+1-ts) !cov(X'(tn),X'(ts))
|
||||
BIG(Ntd1 ,Ntd1+1) = R1(tn+1-ts) !cov(X'(tn),X (ts))
|
||||
|
||||
BIG(Ntd1-1,Ntd1+4) =-R2(ts) !cov(X'(t1),X'(ts))
|
||||
BIG(Ntd1-1,Ntd1+1) =-R1(ts) !cov(X'(t1),X (ts))
|
||||
|
||||
BIG(Ntd1-2,Ntd1+1) = R2(1) !cov(X''(ts),X (ts)
|
||||
BIG(Ntd1-2,Ntd1+2) = R2(ts) !cov(X''(ts),X (t1))
|
||||
BIG(Ntd1-2,Ntd1+3) = R2(tn+1-ts) !cov(X''(ts),X (tn))
|
||||
BIG(Ntd1-2,Ntd1+4) = 0.d0 !cov(X''(ts),X'(ts))
|
||||
!cov(Xt,Xc)
|
||||
do i=1,tn-2
|
||||
j=abs(i+1-ts)
|
||||
BIG(i,Ntd1+1) = R0(j+1) !cov(X(ti+1),X(ts))
|
||||
BIG(i,Ntd1+4) = sign(R1(j+1),R1(j+1)*dble(ts-i-1)) !cov(X(ti+1),X'(ts)) ! check this
|
||||
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),X(ts))
|
||||
BIG(i,Ntd1-2) = R2(j+1) !cov(X(ti+1),X''(ts))
|
||||
enddo
|
||||
endif ! ts>1
|
||||
|
||||
!call echo(big(1:N,1:N),N)
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,N-1
|
||||
do i=j+1,N
|
||||
BIG(i,j) =BIG(j,i)
|
||||
enddo
|
||||
!call echo(big(1:N,1:N),N)
|
||||
enddo
|
||||
!call echo(big(1:N,1:N),N)
|
||||
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT
|
||||
|
||||
SUBROUTINE COV_INPUT2(BIG,pt, R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:), intent(out) :: BIG
|
||||
double precision, dimension(:), intent(in) :: R0,R1,R2
|
||||
integer :: pt,i,j
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows;
|
||||
! X(t2)...X(tn-1) X'(t1) X'(tn) X(t1) X(tn) = [Xt Xd Xc]
|
||||
!
|
||||
! where Xd is the derivatives
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
!cov(Xc)
|
||||
BIG(pt+2,pt+2) = R0(1)
|
||||
BIG(pt+1,pt+1) = R0(1)
|
||||
BIG(pt+1,pt+2) = R0(pt)
|
||||
!cov(Xd)
|
||||
BIG(pt,pt) = -R2(1)
|
||||
BIG(pt-1,pt-1) = -R2(1)
|
||||
BIG(pt-1,pt) = -R2(pt)
|
||||
!cov(Xd,Xc)
|
||||
BIG(pt,pt+2) = 0.d0
|
||||
BIG(pt,pt+1) = R1(pt)
|
||||
BIG(pt-1,pt+2) = -R1(pt)
|
||||
BIG(pt-1,pt+1) = 0.d0
|
||||
|
||||
if (pt.GT.2) then
|
||||
!cov(Xt)
|
||||
do i=1,pt-2
|
||||
do j=i,pt-2
|
||||
BIG(i,j) = R0(j-i+1)
|
||||
enddo
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
do i=1,pt-2
|
||||
BIG(i,pt+1) = R0(i+1)
|
||||
BIG(pt-1-i,pt+2) = R0(i+1)
|
||||
enddo
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj))
|
||||
do i=1,pt-2
|
||||
BIG(i,pt-1) = -R1(i+1)
|
||||
BIG(pt-1-i,pt)= R1(i+1)
|
||||
enddo
|
||||
endif
|
||||
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,pt+1
|
||||
do i=j+1,pt+2
|
||||
BIG(i,j)=BIG(j,i)
|
||||
enddo
|
||||
enddo
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT2
|
||||
|
||||
END PROGRAM sp2thpdf
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,505 +0,0 @@
|
||||
PROGRAM sp2tthpdf
|
||||
C***********************************************************************
|
||||
C This program computes upper and lower bounds for the: *
|
||||
C *
|
||||
C density of T= T_1+T_2 in a gaussian process i.e. *
|
||||
C *
|
||||
C wavelengthes for crests <h1 and troughs >h2 *
|
||||
C *
|
||||
C Sylvie and Igor 7 dec. 1999 *
|
||||
C***********************************************************************
|
||||
use GLOBALDATA, only : Nt,Nj,Nd,Nc,Ntd,Ntdc,NI,Mb,
|
||||
& NIT,Nx,TWOPI,XSPLT,SCIS,NSIMmax,COV
|
||||
use rind
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),allocatable :: BIG
|
||||
double precision, dimension(:,:),allocatable :: ansrup
|
||||
double precision, dimension(:,:),allocatable :: ansrlo
|
||||
double precision, dimension(: ),allocatable :: ex,CY1,CY2
|
||||
double precision, dimension(:,:),allocatable :: xc
|
||||
double precision, dimension(:,:),allocatable ::fxind
|
||||
double precision, dimension(: ),allocatable :: h1,h2
|
||||
double precision, dimension(: ),allocatable :: hh1,hh2
|
||||
double precision, dimension(: ),allocatable :: R0,R1,R2
|
||||
double precision ::CC,U,XddInf,XdInf,XtInf
|
||||
double precision, dimension(:,:),allocatable :: a_up,a_lo
|
||||
integer , dimension(: ),allocatable :: seed
|
||||
integer ,dimension(7) :: indI
|
||||
integer :: Ntime,N0,tn,ts,speed,ph,seed1,seed_size,Nx1,Nx2
|
||||
integer :: icy,icy2
|
||||
double precision :: ds,dT ! lag spacing for covariances
|
||||
! DIGITAL:
|
||||
! f90 -g2 -C -automatic -o ~/WAT/V4/sp2tthpdf.exe rind48.f sp2tthpdf.f
|
||||
! SOLARIS:
|
||||
!f90 -g -O -w3 -Bdynamic -fixed -o ../sp2tthpdf.exe rind48.f sp2tthpdf.f
|
||||
|
||||
!print *,'enter sp2thpdf'
|
||||
CALL INIT_LEVELS(U,Ntime,N0,NIT,speed,SCIS,seed1,Nx1,Nx2,dT)
|
||||
|
||||
!print *,'U,Ntime,NIT,speed,SCIS,seed1,Nx,dT'
|
||||
!print *,U,Ntime,NIT,speed,SCIS,seed1,Nx,dT
|
||||
!Nx1=1
|
||||
!Nx2=1
|
||||
|
||||
Nx=Nx1*Nx2
|
||||
!print *,'NN',Nx1,Nx2,Nx
|
||||
|
||||
|
||||
!XSPLT=1.5d0
|
||||
if (SCIS.GT.0) then
|
||||
allocate(COV(1:Nx))
|
||||
call random_seed(SIZE=seed_size)
|
||||
allocate(seed(seed_size))
|
||||
call random_seed(GET=seed(1:seed_size)) ! get current seed
|
||||
seed(1)=seed1 ! change seed
|
||||
call random_seed(PUT=seed(1:seed_size))
|
||||
deallocate(seed)
|
||||
endif
|
||||
CALL INITDATA(speed)
|
||||
!print *,ntime,speed,u,NIT
|
||||
allocate(R0(1:Ntime+1))
|
||||
allocate(R1(1:Ntime+1))
|
||||
allocate(R2(1:Ntime+1))
|
||||
|
||||
allocate(h1(1:Nx1))
|
||||
allocate(h2(1:Nx2))
|
||||
CALL INIT_AMPLITUDES(h1,Nx1,h2,Nx2)
|
||||
CALL INIT_COVARIANCES(Ntime,R0,R1,R2)
|
||||
|
||||
|
||||
allocate(hh1(1:Nx))
|
||||
allocate(hh2(1:Nx))
|
||||
!h transformation
|
||||
do icy=1,Nx1
|
||||
do icy2=1,Nx2
|
||||
hh1((icy-1)*Nx2+icy2)=h1(icy);
|
||||
hh2((icy-1)*Nx2+icy2)=h2(icy2);
|
||||
enddo
|
||||
enddo
|
||||
|
||||
Nj=0
|
||||
indI(1)=0
|
||||
|
||||
C ***** The bound 'infinity' is set to 10*sigma *****
|
||||
XdInf=10.d0*SQRT(-R2(1))
|
||||
XtInf=10.d0*SQRT(R0(1))
|
||||
!h1(1)=XtInf
|
||||
!h2(1)=XtInf
|
||||
! normalizing constant
|
||||
CC=TWOPI*SQRT(-R0(1)/R2(1))*exp(u*u/(2.d0*R0(1)) )
|
||||
allocate(CY1(1:Nx))
|
||||
allocate(CY2(1:Nx))
|
||||
do icy=1,Nx
|
||||
CY1(icy)=exp(-0.5*hh1(icy)*hh1(icy)/100)/(10*sqrt(twopi))
|
||||
CY2(icy)=exp(-0.5*hh2(icy)*hh2(icy)/100)/(10*sqrt(twopi))
|
||||
enddo
|
||||
!print *,CY1
|
||||
allocate(ansrup(1:Ntime,1:Nx))
|
||||
allocate(ansrlo(1:Ntime,1:Nx))
|
||||
ansrup=0.d0
|
||||
ansrlo=0.d0
|
||||
allocate(fxind(1:Nx,1:2))
|
||||
!fxind=0.d0 this is not needed
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! Y={X(t2)..,X(ts),..X(tn-1)||X'(ts) X'(t1) X'(tn)||Y1 Y2 X(ts) X(t1) X(tn)} !!
|
||||
! = [Xt Xd Xc] !!
|
||||
! !!
|
||||
! Nt=tn-2, Nd=3, Nc=2+3 !!
|
||||
! !!
|
||||
! Xt= contains Nt time points in the indicator function !!
|
||||
! Xd= " Nd derivatives !!
|
||||
! Xc= " Nc variables to condition on !!
|
||||
! (Y1,Y2) dummy variables ind. of all other v. inputing h1,h2 into rindd !!
|
||||
! !!
|
||||
! There are 6 ( NI=7) regions with constant bariers: !!
|
||||
! (indI(1)=0); for i\in (indI(1),indI(2)] u<Y(i)<h1 !!
|
||||
! (indI(2)=ts-2); for i\in (indI(2),indI(2)], inf<Y(i)<inf (no restr.) !!
|
||||
! (indI(3)=ts-1); for i\in (indI(3),indI(4)], h2 <Y(i)<u !!
|
||||
! (indI(4)=Nt) ; for i\in (indI(4),indI(5)], Y(i)<0 (deriv. X'(ts)) !!
|
||||
! (indI(5)=Nt+1); for i\in (indI(5),indI(6)], Y(i)>0 (deriv. X'(t1)) !!
|
||||
! (indI(6)=Nt+2); for i\in (indI(6),indI(7)], Y(i)>0 (deriv. X'(tn)) !!
|
||||
! (indI(7)=Nt+3); NI=7. !!
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
||||
NI=7; Nd=3
|
||||
Nc=5; Mb=3
|
||||
allocate(a_up(1:Mb,1:(NI-1)))
|
||||
allocate(a_lo(1:Mb,1:(NI-1)))
|
||||
a_up=0.d0
|
||||
a_lo=0.d0
|
||||
allocate(BIG(1:(Ntime+Nc+1),1:(Ntime+Nc+1)))
|
||||
ALLOCATE(xc(1:Nc,1:Nx))
|
||||
allocate(ex(1:(Ntime+Nc+1)))
|
||||
!print *,size(ex),Ntime
|
||||
ex=0.d0
|
||||
!print *,size(ex),ex
|
||||
xc(1,1:Nx)=hh1(1:Nx)
|
||||
xc(2,1:Nx)=hh2(1:Nx)
|
||||
xc(3,1:Nx)=u
|
||||
xc(4,1:Nx)=u
|
||||
xc(5,1:Nx)=u
|
||||
! upp- down- upp-crossings at t1,ts,tn
|
||||
|
||||
a_lo(1,1)=u
|
||||
a_up(1,2)=XtInf ! X(ts) is redundant
|
||||
a_lo(1,2)=-Xtinf
|
||||
a_up(1,3)=u
|
||||
|
||||
|
||||
a_lo(1,4)=-XdInf
|
||||
a_up(1,5)= XdInf
|
||||
a_up(1,6)= XdInf
|
||||
|
||||
a_up(2,1)=1.d0
|
||||
a_lo(3,3)=1.d0 !signe a voir!!!!!!
|
||||
! print *,a_up
|
||||
! print *,a_lo
|
||||
do tn=N0,Ntime,1
|
||||
! do tn=Ntime,Ntime,1
|
||||
Ntd=tn+1
|
||||
Nt=Ntd-Nd
|
||||
Ntdc=Ntd+Nc
|
||||
indI(4)=Nt
|
||||
indI(5)=Nt+1
|
||||
indI(6)=Nt+2
|
||||
indI(7)=Ntd
|
||||
if (SCIS.gt.0) then
|
||||
if (SCIS.EQ.2) then
|
||||
Nj=max(Nt,0)
|
||||
else
|
||||
Nj=min(max(Nt-5, 0),0)
|
||||
endif
|
||||
endif
|
||||
do ts=3,tn-2
|
||||
!print *,'ts,tn' ,ts,tn,Ntdc
|
||||
CALL COV_INPUT(Big(1:Ntdc,1:Ntdc),tn,ts,R0,R1,R2)!positive wave period
|
||||
indI(2)=ts-2
|
||||
indI(3)=ts-1
|
||||
|
||||
|
||||
CALL RINDD(fxind,Big(1:Ntdc,1:Ntdc),ex(1:Ntdc),
|
||||
& xc,indI,a_lo,a_up)
|
||||
|
||||
ds=dt
|
||||
do icy=1,Nx
|
||||
! ansr(tn,:)=ansr(tn,:)+fxind*CC*ds./(CY1.*CY2)
|
||||
ansrup(tn,icy)=ansrup(tn,icy)+fxind(icy,1)*CC*ds
|
||||
& /(CY1(icy)*CY2(icy))
|
||||
ansrlo(tn,icy)=ansrlo(tn,icy)+fxind(icy,2)*CC*ds
|
||||
& /(CY1(icy)*CY2(icy))
|
||||
enddo
|
||||
enddo ! ts
|
||||
print *,'Ready: ',tn,' of ',Ntime
|
||||
|
||||
enddo !tn
|
||||
|
||||
300 open (unit=11, file='dens.out', STATUS='unknown')
|
||||
|
||||
do ts=1,Ntime
|
||||
do ph=1,Nx
|
||||
write(11,*) ansrup(ts,ph),ansrlo(ts,ph)!,hh1(ph),hh2(ph)
|
||||
! write(11,111) ansrup(ts,ph),ansrlo(ts,ph)
|
||||
|
||||
enddo
|
||||
enddo
|
||||
!111 FORMAT(2x,F12.8)
|
||||
close(11)
|
||||
900 deallocate(big)
|
||||
deallocate(fxind)
|
||||
deallocate(ansrup)
|
||||
deallocate(ansrlo)
|
||||
deallocate(xc)
|
||||
deallocate(ex)
|
||||
deallocate(R0)
|
||||
deallocate(R1)
|
||||
deallocate(R2)
|
||||
if (allocated(COV) ) then
|
||||
deallocate(COV)
|
||||
endif
|
||||
deallocate(h1)
|
||||
deallocate(h2)
|
||||
deallocate(hh1)
|
||||
deallocate(hh2)
|
||||
deallocate(a_up)
|
||||
deallocate(a_lo)
|
||||
stop
|
||||
!return
|
||||
|
||||
CONTAINS
|
||||
|
||||
|
||||
|
||||
SUBROUTINE INIT_LEVELS
|
||||
& (U,Ntime,N0,NIT,speed,SCIS,seed1,Nx1,Nx2,dT)
|
||||
IMPLICIT NONE
|
||||
integer, intent(out):: Ntime,N0,NIT,speed,Nx1,Nx2,SCIS,seed1
|
||||
double precision ,intent(out) :: U,dT
|
||||
|
||||
|
||||
OPEN(UNIT=14,FILE='reflev.in',STATUS= 'UNKNOWN')
|
||||
READ (14,*) U
|
||||
READ (14,*) Ntime
|
||||
READ (14,*) N0
|
||||
READ (14,*) NIT
|
||||
READ (14,*) speed
|
||||
READ (14,*) SCIS
|
||||
READ (14,*) seed1
|
||||
|
||||
|
||||
READ (14,*) Nx1,Nx2
|
||||
READ (14,*) dT
|
||||
if (Ntime.lt.3) then
|
||||
print *,'The number of wavelength points is too small, stop'
|
||||
stop
|
||||
end if
|
||||
|
||||
CLOSE(UNIT=14)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_LEVELS
|
||||
|
||||
C******************************************************
|
||||
SUBROUTINE INIT_AMPLITUDES(h1,Nx1,h2,Nx2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:), intent(out) :: h1,h2
|
||||
integer, intent(in) :: Nx1,Nx2
|
||||
integer :: ix
|
||||
|
||||
|
||||
OPEN(UNIT=4,FILE='h.in',STATUS= 'UNKNOWN')
|
||||
|
||||
C
|
||||
C Reading in amplitudes
|
||||
C
|
||||
do ix=1,Nx1
|
||||
READ (4,*) H1(ix)
|
||||
enddo
|
||||
do ix=1,Nx2
|
||||
READ (4,*) H2(ix)
|
||||
enddo
|
||||
CLOSE(UNIT=4)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INIT_AMPLITUDES
|
||||
|
||||
C**************************************************
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
SUBROUTINE INIT_COVARIANCES(Ntime,R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:),intent(out) :: R0,R1,R2
|
||||
integer,intent(in) :: Ntime
|
||||
integer :: i
|
||||
open (unit=1, file='Cd0.in',STATUS='unknown')
|
||||
open (unit=2, file='Cd1.in',STATUS='unknown')
|
||||
open (unit=3, file='Cd2.in',STATUS='unknown')
|
||||
|
||||
do i=1,Ntime
|
||||
read(1,*) R0(i)
|
||||
read(2,*) R1(i)
|
||||
read(3,*) R2(i)
|
||||
enddo
|
||||
close(1)
|
||||
close(2)
|
||||
close(3)
|
||||
|
||||
return
|
||||
END SUBROUTINE INIT_COVARIANCES
|
||||
|
||||
C***********************************************************************
|
||||
C***********************************************************************
|
||||
|
||||
C**********************************************************************
|
||||
|
||||
SUBROUTINE COV_INPUT(BIG,tn,ts, R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:),intent(inout) :: BIG
|
||||
double precision, dimension(:),intent(in) :: R0,R1,R2
|
||||
integer ,intent(in) :: tn,ts
|
||||
integer :: i,j,Ntd1,N !=Ntdc
|
||||
double precision :: tmp
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows:
|
||||
!
|
||||
! ||X(t2)..X(ts),..X(tn-1)||X'(ts) X'(t1) X'(tn)||Y1 Y2 X(ts) X(t1) X(tn)||
|
||||
! = [Xt Xd Xc]
|
||||
! where
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
! Computations of all covariances follows simple rules: Cov(X(t),X(s))=r(t,s),
|
||||
! then Cov(X'(t),X(s))=dr(t,s)/dt. Now for stationary X(t) we have
|
||||
! a function r(tau) such that Cov(X(t),X(s))=r(s-t) (or r(t-s) will give the same result).
|
||||
!
|
||||
! Consequently Cov(X'(t),X(s)) = -r'(s-t) = -sign(s-t)*r'(|s-t|)
|
||||
! Cov(X'(t),X'(s)) = -r''(s-t) = -r''(|s-t|)
|
||||
! Cov(X''(t),X'(s)) = r'''(s-t) = sign(s-t)*r'''(|s-t|)
|
||||
! Cov(X''(t),X(s)) = r''(s-t) = r''(|s-t|)
|
||||
! Cov(X''(t),X''(s)) = r''''(s-t) = r''''(|s-t|)
|
||||
|
||||
Ntd1=tn+1
|
||||
N=Ntd1+Nc
|
||||
do i=1,tn-2
|
||||
!cov(Xt)
|
||||
do j=i,tn-2
|
||||
BIG(i,j) = R0(j-i+1) ! cov(X(ti+1),X(tj+1))
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
BIG(i ,Ntd1+1) = 0.d0 !cov(X(ti+1),Y1)
|
||||
BIG(i ,Ntd1+2) = 0.d0 !cov(X(ti+1),Y2)
|
||||
BIG(i ,Ntd1+4) = R0(i+1) !cov(X(ti+1),X(t1))
|
||||
BIG(tn-1-i ,Ntd1+5) = R0(i+1) !cov(X(t.. ),X(tn))
|
||||
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj)
|
||||
BIG(i,Ntd1-1) =-R1(i+1) !cov(X(ti+1),X'(t1))
|
||||
BIG(tn-1-i,Ntd1)= R1(i+1) !cov(X(ti+1),X'(tn))
|
||||
enddo
|
||||
!cov(Xd)
|
||||
BIG(Ntd1 ,Ntd1 ) = -R2(1)
|
||||
BIG(Ntd1-1,Ntd1 ) = -R2(tn) !cov(X'(t1),X'(tn))
|
||||
BIG(Ntd1-1,Ntd1-1) = -R2(1)
|
||||
BIG(Ntd1-2,Ntd1-1) = -R2(ts) !cov(X'(ts),X'(t1))
|
||||
BIG(Ntd1-2,Ntd1-2) = -R2(1)
|
||||
BIG(Ntd1-2,Ntd1 ) = -R2(tn+1-ts) !cov(X'(ts),X'(tn))
|
||||
|
||||
!cov(Xc)
|
||||
BIG(Ntd1+1,Ntd1+1) = 100.d0 ! cov(Y1 Y1)
|
||||
BIG(Ntd1+1,Ntd1+2) = 0.d0 ! cov(Y1 Y2)
|
||||
BIG(Ntd1+1,Ntd1+3) = 0.d0 ! cov(Y1 X(ts))
|
||||
BIG(Ntd1+1,Ntd1+4) = 0.d0 ! cov(Y1 X(t1))
|
||||
BIG(Ntd1+1,Ntd1+5) = 0.d0 ! cov(Y1 X(tn))
|
||||
BIG(Ntd1+2,Ntd1+2) = 100.d0 ! cov(Y2 Y2)
|
||||
BIG(Ntd1+2,Ntd1+3) = 0.d0 ! cov(Y2 X(ts))
|
||||
BIG(Ntd1+2,Ntd1+4) = 0.d0 ! cov(Y2 X(t1))
|
||||
BIG(Ntd1+2,Ntd1+5) = 0.d0 ! cov(Y2 X(tn))
|
||||
|
||||
BIG(Ntd1+3,Ntd1+3) = R0(1) ! cov(X(ts),X (ts)
|
||||
BIG(Ntd1+3,Ntd1+4) = R0(ts) ! cov(X(ts),X (t1))
|
||||
BIG(Ntd1+3,Ntd1+5) = R0(tn+1-ts) ! cov(X(ts),X (tn))
|
||||
BIG(Ntd1+4,Ntd1+4) = R0(1) ! cov(X(t1),X (t1))
|
||||
BIG(Ntd1+4,Ntd1+5) = R0(tn) ! cov(X(t1),X (tn))
|
||||
BIG(Ntd1+5,Ntd1+5) = R0(1) ! cov(X(tn),X (tn))
|
||||
|
||||
|
||||
!cov(Xd,Xc)
|
||||
BIG(Ntd1 ,Ntd1+1) = 0.d0 !cov(X'(tn),Y1)
|
||||
BIG(Ntd1 ,Ntd1+2) = 0.d0 !cov(X'(tn),Y2)
|
||||
BIG(Ntd1-1 ,Ntd1+1) = 0.d0 !cov(X'(t1),Y1)
|
||||
BIG(Ntd1-1 ,Ntd1+2) = 0.d0 !cov(X'(t1),Y2)
|
||||
BIG(Ntd1-2 ,Ntd1+1) = 0.d0 !cov(X'(ts),Y1)
|
||||
BIG(Ntd1-2 ,Ntd1+2) = 0.d0 !cov(X'(ts),Y2)
|
||||
|
||||
BIG(Ntd1 ,Ntd1+4) = R1(tn) !cov(X'(tn),X(t1))
|
||||
BIG(Ntd1 ,Ntd1+5) = 0.d0 !cov(X'(tn),X(tn))
|
||||
BIG(Ntd1-1,Ntd1+4) = 0.d0 !cov(X'(t1),X(t1))
|
||||
BIG(Ntd1-1,Ntd1+5) =-R1(tn) !cov(X'(t1),X(tn))
|
||||
BIG(Ntd1 ,Ntd1+3) = R1(tn+1-ts) !cov(X'(tn),X (ts))
|
||||
BIG(Ntd1-1,Ntd1+3) =-R1(ts) !cov(X'(t1),X (ts))
|
||||
BIG(Ntd1-2,Ntd1+3) = 0.d0 !cov(X'(ts),X (ts)
|
||||
BIG(Ntd1-2,Ntd1+4) = R1(ts) !cov(X'(ts),X (t1))
|
||||
BIG(Ntd1-2,Ntd1+5) = -R1(tn+1-ts) !cov(X'(ts),X (tn))
|
||||
|
||||
|
||||
do i=1,tn-2
|
||||
j=abs(i+1-ts)
|
||||
!cov(Xt,Xc)
|
||||
BIG(i,Ntd1+3) = R0(j+1) !cov(X(ti+1),X(ts))
|
||||
!Cov(Xt,Xd)
|
||||
if ((i+1-ts).lt.0) then
|
||||
BIG(i,Ntd1-2) = R1(j+1)
|
||||
else !cov(X(ti+1),X'(ts))
|
||||
BIG(i,Ntd1-2) = -R1(j+1)
|
||||
endif
|
||||
enddo
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,N-1
|
||||
do i=j+1,N
|
||||
tmp =BIG(j,i)
|
||||
|
||||
BIG(i,j)=tmp
|
||||
enddo
|
||||
enddo
|
||||
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT
|
||||
|
||||
SUBROUTINE COV_INPUT2(BIG,pt, R0,R1,R2)
|
||||
IMPLICIT NONE
|
||||
double precision, dimension(:,:), intent(out) :: BIG
|
||||
double precision, dimension(:), intent(in) :: R0,R1,R2
|
||||
integer :: pt,i,j
|
||||
! the order of the variables in the covariance matrix
|
||||
! are organized as follows;
|
||||
! X(t2)...X(tn-1) X'(t1) X'(tn) X(t1) X(tn) = [Xt Xd Xc]
|
||||
!
|
||||
! where Xd is the derivatives
|
||||
!
|
||||
! Xt= time points in the indicator function
|
||||
! Xd= derivatives
|
||||
! Xc=variables to condition on
|
||||
|
||||
!cov(Xc)
|
||||
BIG(pt+2,pt+2) = R0(1)
|
||||
BIG(pt+1,pt+1) = R0(1)
|
||||
BIG(pt+1,pt+2) = R0(pt)
|
||||
!cov(Xd)
|
||||
BIG(pt,pt) = -R2(1)
|
||||
BIG(pt-1,pt-1) = -R2(1)
|
||||
BIG(pt-1,pt) = -R2(pt)
|
||||
!cov(Xd,Xc)
|
||||
BIG(pt,pt+2) = 0.d0
|
||||
BIG(pt,pt+1) = R1(pt)
|
||||
BIG(pt-1,pt+2) = -R1(pt)
|
||||
BIG(pt-1,pt+1) = 0.d0
|
||||
|
||||
if (pt.GT.2) then
|
||||
!cov(Xt)
|
||||
do i=1,pt-2
|
||||
do j=i,pt-2
|
||||
BIG(i,j) = R0(j-i+1)
|
||||
enddo
|
||||
enddo
|
||||
!cov(Xt,Xc)
|
||||
do i=1,pt-2
|
||||
BIG(i,pt+1) = R0(i+1)
|
||||
BIG(pt-1-i,pt+2) = R0(i+1)
|
||||
enddo
|
||||
!Cov(Xt,Xd)=cov(X(ti+1),x(tj))
|
||||
do i=1,pt-2
|
||||
BIG(i,pt-1) = -R1(i+1)
|
||||
BIG(pt-1-i,pt)= R1(i+1)
|
||||
enddo
|
||||
endif
|
||||
|
||||
|
||||
! make lower triangular part equal to upper
|
||||
do j=1,pt+1
|
||||
do i=j+1,pt+2
|
||||
BIG(i,j)=BIG(j,i)
|
||||
enddo
|
||||
enddo
|
||||
C write (*,10) ((BIG(j,i),i=N+1,N+6),j=N+1,N+6)
|
||||
C 10 format(6F8.4)
|
||||
RETURN
|
||||
END SUBROUTINE COV_INPUT2
|
||||
|
||||
|
||||
END PROGRAM sp2tthpdf
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,30 +0,0 @@
|
||||
"""
|
||||
f2py c_library.pyf c_functions.c -c
|
||||
|
||||
gfortran -W -Wall -pedantic-errors -fbounds-check -Werror -c dsvdc.f mregmodule.f
|
||||
|
||||
"""
|
||||
import os
|
||||
import sys
|
||||
from wafo.f2py_tools import f2py_call_str
|
||||
|
||||
|
||||
def compile_all():
|
||||
f2py_call = f2py_call_str()
|
||||
print '=' * 75
|
||||
print 'compiling cov2mod'
|
||||
print '=' * 75
|
||||
|
||||
files = ['dsvdc', 'mregmodule', 'intfcmod']
|
||||
compile1_format = 'gfortran -fPIC -c %s.f'
|
||||
format1 = '%s.o ' * len(files)
|
||||
for file_ in files:
|
||||
os.system(compile1_format % file_)
|
||||
file_objects = format1 % tuple(files)
|
||||
|
||||
os.system(f2py_call + ' -m cov2mod -c %s cov2mmpdfreg_intfc.f' %
|
||||
file_objects)
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
compile_all()
|
||||
@ -1,651 +0,0 @@
|
||||
C Version 1994-X-18
|
||||
|
||||
C This is a new version of WAMP program computing crest-trough wavelength
|
||||
C and amplitude density.
|
||||
C
|
||||
C revised pab 2007
|
||||
C -moved all common blocks into modules
|
||||
C -renamed from minmax to sp2mmpdfreg + fixed some bugs
|
||||
C revised pab July 2007
|
||||
! -renamed from sp2mmpdfreg to cov2mmpdfreg
|
||||
|
||||
PROGRAM cov2mmpdfreg
|
||||
USE SIZEMOD
|
||||
USE EPSMOD
|
||||
USE CHECKMOD
|
||||
USE MREGMOD
|
||||
IMPLICIT NONE
|
||||
real*8 Q0,SQ0,Q1,SQ1, AA, BB, DAI, AI , U,V,VV, XL0, XL2, XL4
|
||||
REAL*8 VDERI, CDER,SDER, DER, CONST, F, HHHH,FM, VALUE
|
||||
C INTEGER, PARAMETER :: MMAX = 5, NMAX = 101, RDIM = 10201
|
||||
REAL*8, DIMENSION(NMAX) :: HHT,T,Ulev,Vlev,VT,UT,Vdd,Udd
|
||||
REAL*8, DIMENSION(RDIM) :: R,R1,R2,R3
|
||||
REAL*8, DIMENSION(5*NMAX) :: COV
|
||||
REAL*8, DIMENSION(NMAX,NMAX) :: UVdens
|
||||
C DIMENSION UVdens(NMAX,NMAX),HHT(NMAX)
|
||||
C DIMENSION T(NMAX),Ulev(NMAX),Vlev(NMAX)
|
||||
C DIMENSION VT(NMAX),UT(NMAX),Vdd(NMAX),Udd(NMAX)
|
||||
C DIMENSION COV(5*NMAX),R(RDIM),R1(RDIM),R2(RDIM),R3(RDIM)
|
||||
DIMENSION AA(MMAX-2,MMAX-2),BB(MMAX+1),DAI(MMAX),AI((MMAX+1)*NMAX)
|
||||
|
||||
C
|
||||
C The program computes the joint density of maximum the following minimum
|
||||
C and the distance between Max and min for a zero-mean stationary
|
||||
C Gaussian process with covariance function defined explicitely with 4
|
||||
C derivatives. The process should be normalized so that the first and
|
||||
C the second spectral moments are equal to 1. The values of Max are taken
|
||||
C as the nodes at Hermite-Quadrature and then integrated out so that
|
||||
C the output is a joint density of wavelength T and amplitude H=Max-min.
|
||||
C The Max values are defined by subroutine Gauss_M with the accuracy
|
||||
C input epsu. The principle is that the integral of the marginal density
|
||||
C of f_Max is computed with sufficient accuracy.
|
||||
C
|
||||
REAL*8, DIMENSION(NMAX) :: B0,DB0,DDB0,B1,DB1,DDB1,DB2,DDB2
|
||||
REAL*8, DIMENSION(NMAX) :: Q,SQ,VDER,DBI,BI
|
||||
C DIMENSION B0(NMAX),DB0(NMAX),DDB0(NMAX)
|
||||
C DIMENSION B1(NMAX),DB1(NMAX),DDB1(NMAX)
|
||||
C DIMENSION DB2(NMAX),DDB2(NMAX)
|
||||
C DIMENSION Q(NMAX),SQ(NMAX),VDER(NMAX),DBI(NMAX),BI(NMAX)
|
||||
INTEGER :: J,I,I1,I2,I3,IU, IV, NU,NV,NG,N,NIT, NNIT, INF
|
||||
INTEGER :: fffff
|
||||
C REAL*8 EPS0
|
||||
C INTEGER III01,III11,III21,III31,III41,III51
|
||||
C *,III61,III71,III81,III91,III101 , III0
|
||||
C COMMON/CHECK1/III01,III11,III21,III31,III41,III51
|
||||
C *,III61,III71,III81,III91,III101
|
||||
C COMMON/CHECKQ/III0
|
||||
C COMMON /EPS/ EPS,EPSS,CEPSS
|
||||
|
||||
C
|
||||
C Initiation of all constants and integration nodes 'INITINTEG'
|
||||
C
|
||||
CALL INITINTEG(NIT)
|
||||
c
|
||||
c OBS. we are using the variables R,R1,R2 R3 as a temporary storage
|
||||
C for transformation g of the process.
|
||||
|
||||
|
||||
|
||||
c
|
||||
CALL INITLEVELS(Ulev,NU,Vlev,NV,T,HHT,N,R1,R2,NG)
|
||||
IF( R1(1) .gt. R1(ng)) then
|
||||
do 13 I=1,ng
|
||||
R3(I)=R1(I)
|
||||
R(I) =R2(I)
|
||||
13 continue
|
||||
do 17 i=1,ng
|
||||
R1(i) = R3(ng-i+1)
|
||||
R2(i) = R(ng-i+1)
|
||||
17 continue
|
||||
end if
|
||||
if(abs(R1(ng)-R1(1))*abs(R2(ng)-R2(1)).lt.0.01d0) then
|
||||
print *,'The transformation g is singular, stop'
|
||||
stop
|
||||
end if
|
||||
DO 14 IV=1,Nv
|
||||
V=Vlev(IV)
|
||||
CALL TRANSF(NG,V,R2,R1,VALUE,DER)
|
||||
VT(IV)=VALUE
|
||||
Vdd(IV)=DER
|
||||
14 continue
|
||||
DO 16 IU=1,Nu
|
||||
U = Ulev(IU)
|
||||
CALL TRANSF(NG,U,R2,R1,VALUE,DER)
|
||||
UT(IU) = VALUE
|
||||
Udd(IU) = DER
|
||||
do 16 IV=1,Nv
|
||||
UVdens(IU,IV)=0.0d0
|
||||
16 CONTINUE
|
||||
|
||||
|
||||
CALL COVG(XL0,XL2,XL4,COV,R1,R2,R3,T,N)
|
||||
|
||||
|
||||
Q0=XL4
|
||||
IF (Q0.le.1.0D0+EPS) then
|
||||
Print *,'Covariance structure is singular, stop.'
|
||||
stop
|
||||
end if
|
||||
SQ0 = SQRT(Q0)
|
||||
Q1 = XL0-XL2*XL2/XL4
|
||||
IF (Q1.le.eps) then
|
||||
Print *,'Covariance structure is singular, stop.'
|
||||
stop
|
||||
end if
|
||||
SQ1 = SQRT(Q1)
|
||||
DO 10 I=1,N
|
||||
B0(I) =-COV(I+2*N)
|
||||
DB0(I) =-COV(I+3*N)
|
||||
DDB0(I)=-COV(I+4*N)
|
||||
|
||||
B1(I) =COV(I)+COV(I+2*N)*(XL2/XL4)
|
||||
DB1(I) =COV(I+N)+COV(I+3*N)*(XL2/XL4)
|
||||
DDB1(I)=COV(I+2*N)+XL2*(COV(I+4*N)/XL4)
|
||||
C
|
||||
C Q(I) contains Var(X(T(i))|X'(0),X''(0),X(0))
|
||||
C VDER(I) contains Var(X''(T(i))|X'(0),X''(0),X(0))
|
||||
C
|
||||
Q(I)=XL0 - COV(I+N)*(COV(I+N)/XL2) - B0(I)*(B0(I)/Q0)
|
||||
1 -B1(I)*(B1(I)/Q1)
|
||||
VDER(I)=XL4 - (COV(I+3*N)*COV(I+3*N))/XL2 - (DDB0(I)*DDB0(I))/Q0
|
||||
1 - (DDB1(I)*DDB1(I))/Q1
|
||||
|
||||
|
||||
C
|
||||
C DDB2(I) contains Cov(X''(T(i)),X(T(i))|X'(0),X''(0),X(0))
|
||||
C
|
||||
DDB2(I)=-XL2 - (COV(I+N)*COV(I+3*N))/XL2 - DDB0(I)*(B0(I)/Q0)
|
||||
1 -DDB1(I)*(B1(I)/Q1)
|
||||
IF(Q(I).LE.eps) then
|
||||
SQ(i) =0.0d0
|
||||
DDB2(i)=0.0d0
|
||||
else
|
||||
SQ(I)=SQRT(Q(I))
|
||||
C
|
||||
C VDER(I) contains Var(X''(T(i))|X'(0),X''(0),X(0),X(T(i))
|
||||
C
|
||||
|
||||
VDER(I)=VDER(I) - (DDB2(I)*DDB2(I))/Q(I)
|
||||
end if
|
||||
|
||||
10 CONTINUE
|
||||
DO 15 I=1,N
|
||||
DO 15 J=1,N
|
||||
C
|
||||
C R1 contains Cov(X(T(I)),X'(T(J))|X'(0),X''(0),X(0))
|
||||
C
|
||||
R1(J+(I-1)*N)=R1(J+(I-1)*N) - COV(I+N)*(COV(J+2*N)/XL2)
|
||||
1 - (B0(I)*DB0(J)/Q0) - (B1(I)*DB1(J)/Q1)
|
||||
|
||||
C
|
||||
C R2 contains Cov(X'(T(I)),X'(T(J))|X'(0),X''(0),X(0))
|
||||
C
|
||||
R2(J+(I-1)*N) = -R2(J+(I-1)*N) - COV(I+2*N)*(COV(J+2*N)/XL2)
|
||||
1 - DB0(I)*DB0(J)/Q0 - DB1(I)*(DB1(J)/Q1)
|
||||
C
|
||||
C R3 contains Cov(X''(T(I)),X'(T(J))|X'(0),X''(0),X(0))
|
||||
C
|
||||
R3(J+(I-1)*N) = R3(J+(I-1)*N) - COV(I+3*N)*(COV(J+2*N)/XL2)
|
||||
1 - DB0(J)*(DDB0(I)/Q0) - DDB1(I)*(DB1(J)/Q1)
|
||||
15 CONTINUE
|
||||
|
||||
C The initiations are finished and we are beginning with 3 loops
|
||||
C on T=T(I), U=Ulevels(IU), V=Ulevels(IV), U>V.
|
||||
|
||||
DO 20 I=1,N
|
||||
|
||||
NNIT=NIT
|
||||
IF (Q(I).LE.EPS) GO TO 20
|
||||
|
||||
DO 30 I1=1,I
|
||||
DB2(I1)=R1(I1+(I-1)*N)
|
||||
|
||||
C Cov(X'(T(I1)),X(T(i))|X'(0),X''(0),X(0))
|
||||
C DDB2(I) contains Cov(X''(T(i)),X(T(i))|X'(0),X''(0),X(0))
|
||||
|
||||
30 CONTINUE
|
||||
|
||||
DO 50 I3=1,I
|
||||
DBI(I3) = R3(I3+(I-1)*N) - (DDB2(I)*DB2(I3)/Q(I))
|
||||
BI(I3) = R2(I3+(I-1)*N) - (DB2(I)*DB2(I3)/Q(I))
|
||||
50 CONTINUE
|
||||
DO 51 I3=1,I-1
|
||||
AI(I3)=0.0d0
|
||||
AI(I3+I-1)=DB0(I3)/SQ0
|
||||
AI(I3+2*(I-1))=DB1(I3)/SQ1
|
||||
AI(I3+3*(I-1))=DB2(I3)/SQ(I)
|
||||
51 CONTINUE
|
||||
VDERI=VDER(I)
|
||||
DAI(1)=0.0d0
|
||||
DAI(2)=DDB0(I)/SQ0
|
||||
DAI(3)=DDB1(I)/SQ1
|
||||
DAI(4)=DDB2(I)/SQ(I)
|
||||
AA(1,1)=DB0(I)/SQ0
|
||||
AA(1,2)=DB1(I)/SQ1
|
||||
AA(1,3)=DB2(I)/SQ(I)
|
||||
AA(2,1)=XL2/SQ0
|
||||
AA(2,2)=SQ1
|
||||
AA(2,3)=0.0d0
|
||||
AA(3,1)=B0(I)/SQ0
|
||||
AA(3,2)=B1(I)/SQ1
|
||||
AA(3,3)=SQ(I)
|
||||
IF (BI(I).LE.EPS) NNIT=0
|
||||
IF (NNIT.GT.1) THEN
|
||||
IF(I.LT.1) GO TO 41
|
||||
DO 40 I1=1,I-1
|
||||
DO 40 I2=1,I-1
|
||||
|
||||
C R contains Cov(X'(T(I1)),X'(T(I2))|X'(0),X''(0),X(0),X(I))
|
||||
|
||||
R(I2+(I1-1)*(I-1))=R2(I2+(I1-1)*N)-(DB2(I1)*DB2(I2)/Q(I))
|
||||
|
||||
40 CONTINUE
|
||||
41 CONTINUE
|
||||
END IF
|
||||
|
||||
C Here the covariance of the problem would be innitiated
|
||||
|
||||
INF=0
|
||||
Print *,' Laps to go:',N-I+1
|
||||
DO 80 IV=1,Nv
|
||||
V=VT(IV)
|
||||
! IF (ABS(V).GT.5.0D0) GO TO 80
|
||||
IF (Vdd(IV).LT.EPS0) GO TO 80
|
||||
DO 60 IU=1,Nu
|
||||
U=UT(IU)
|
||||
IF (U.LE.V) go to 60
|
||||
! IF (ABS(U).GT.5.0D0) GO TO 60
|
||||
IF (Udd(IU).LT.EPS0) GO TO 60
|
||||
BB(1)=0.0d0
|
||||
BB(2)=U
|
||||
BB(3)=V
|
||||
! if (IV.EQ.2.AND.IU.EQ.1) THEN
|
||||
! fffff = 10
|
||||
! endif
|
||||
|
||||
CALL MREG(F,R,BI,DBI,AA,BB,AI,DAI,VDERI,3,I-1,NNIT,INF)
|
||||
INF=1
|
||||
UVdens(IU,IV) = UVdens(IU,IV) + Udd(IU)*Vdd(IV)*HHT(I)*F
|
||||
! if (F.GT.0.01.AND.U.GT.2.AND.V.LT.-2) THEN
|
||||
! if (N-I+1 .eq. 38.and.IV.EQ.26.AND.IU.EQ.16) THEN
|
||||
! if (IV.EQ.32.AND.IU.EQ.8.and.I.eq.11) THEN
|
||||
! PRINT * ,' R:', R(1:I)
|
||||
! PRINT * ,' BI:', BI(1:I)
|
||||
! PRINT * ,' DBI:', DBI(1:I)
|
||||
! PRINT * ,' DB2:', DB2(1:I)
|
||||
! PRINT * ,' DB0(1):', DB0(1)
|
||||
! PRINT * ,' DB1(1):', DB1(1)
|
||||
! PRINT * ,' DAI:', DAI
|
||||
! PRINT * ,' BB:', BB
|
||||
! PRINT * ,' VDERI:', VDERI
|
||||
! PRINT * ,' F :', F
|
||||
! PRINT * ,' UVDENS :', UVdens(IU,IV)
|
||||
! fffff = 10
|
||||
! endif
|
||||
|
||||
60 CONTINUE
|
||||
80 continue
|
||||
20 CONTINUE
|
||||
hhhh=0.0d0
|
||||
do 90 Iu=1,Nu
|
||||
do 90 Iv=1,Nv
|
||||
WRITE(10,300) Ulev(iu),Vlev(iv),UVdens(iu,iv)
|
||||
hhhh=hhhh+UVdens(iu,iv)
|
||||
90 continue
|
||||
if (nu.gt.1.and.nv.gt.1) then
|
||||
write(11,*) 'SumSum f_uv *du*dv='
|
||||
1,(Ulev(2)-Ulev(1))*(Vlev(2)-Vlev(1))*hhhh
|
||||
end if
|
||||
|
||||
C sder=sqrt(XL4-XL2*XL2/XL0)
|
||||
C cder=-XL2/sqrt(XL0)
|
||||
C const=1/sqrt(XL0*XL4)
|
||||
C DO 95 IU=1,NU
|
||||
C U=UT(IU)
|
||||
C FM=Udd(IU)*const*exp(-0.5*U*U/XL0)*PMEAN(-cder*U,sder)
|
||||
C WRITE(9,300) Ulev(IU),FM
|
||||
C 95 continue
|
||||
C DO 105 IV=1,NV
|
||||
C V=VT(IV)
|
||||
C VV=cder*V
|
||||
C Fm=Vdd(IV)*const*exp(-0.5*V*V/XL0)*PMEAN(VV,sder)
|
||||
C WRITE(8,300) Vlev(IV),Fm
|
||||
C 105 continue
|
||||
if (III0.eq.0) III0=1
|
||||
|
||||
write(11,*) 'Rate of calls RINDT0:',float(iii01)/float(III0)
|
||||
write(11,*) 'Rate of calls RINDT1:',float(iii11)/float(III0)
|
||||
write(11,*) 'Rate of calls RINDT2:',float(iii21)/float(III0)
|
||||
write(11,*) 'Rate of calls RINDT3:',float(iii31)/float(III0)
|
||||
write(11,*) 'Rate of calls RINDT4:',float(iii41)/float(III0)
|
||||
write(11,*) 'Rate of calls RINDT5:',float(iii51)/float(III0)
|
||||
write(11,*) 'Rate of calls RINDT6:',float(iii61)/float(III0)
|
||||
write(11,*) 'Rate of calls RINDT7:',float(iii71)/float(III0)
|
||||
write(11,*) 'Rate of calls RINDT8:',float(iii81)/float(III0)
|
||||
write(11,*) 'Rate of calls RINDT9:',float(iii91)/float(III0)
|
||||
write(11,*) 'Rate of calls RINDT10:',float(iii101)/float(III0)
|
||||
write(11,*) 'Number of calls of RINDT*',III0
|
||||
|
||||
CLOSE(UNIT=8)
|
||||
CLOSE(UNIT=9)
|
||||
CLOSE(UNIT=10)
|
||||
CLOSE(UNIT=11)
|
||||
|
||||
300 FORMAT(4(3X,F10.6))
|
||||
STOP
|
||||
END
|
||||
|
||||
SUBROUTINE INITLEVELS(ULEVELS,NU,Vlevels,Nv,T,HT,N,TG,XG,NG)
|
||||
USE TBRMOD
|
||||
USE SIZEMOD
|
||||
IMPLICIT NONE
|
||||
C INTEGER, PARAMETER:: NMAX = 101, RDIM = 10201
|
||||
C DIMENSION ULEVELS(1),Vlevels(1),T(1),HT(1),TG(1),XG(1),HH(101)
|
||||
REAL*8, DIMENSION(NMAX), intent(inout) :: ULEVELS,Vlevels,T,HT
|
||||
REAL*8, DIMENSION(RDIM), intent(inout) :: TG,XG
|
||||
INTEGER, intent(inout) :: NG
|
||||
REAL*8 :: UMIN,UMAX,VMIN,VMAX, HU,HV
|
||||
integer :: N, I, NU, NV
|
||||
C REAL*8, DIMENSION(NMAX) :: HH
|
||||
C COMMON/TBR/HH
|
||||
OPEN(UNIT=2,FILE='transf.in')
|
||||
OPEN(UNIT=4,FILE='Mm.in')
|
||||
OPEN(UNIT=3,FILE='t.in')
|
||||
|
||||
|
||||
NG=1
|
||||
12 READ (2,*,END=11) TG(NG),XG(NG)
|
||||
NG=NG+1
|
||||
GO TO 12
|
||||
11 CONTINUE
|
||||
NG=NG-1
|
||||
IF (NG.GT.501) THEN
|
||||
PRINT *,'Vector defining transformation of data > 501, stop'
|
||||
STOP
|
||||
END IF
|
||||
|
||||
|
||||
N=1
|
||||
32 READ (3,*,END=31) T(N)
|
||||
N=N+1
|
||||
GO TO 32
|
||||
31 CONTINUE
|
||||
N=N-1
|
||||
|
||||
CLOSE(UNIT=3)
|
||||
|
||||
IF(N.ge.NMAX) then
|
||||
print *,'The number of wavelength points >',NMAX-1, ' stop'
|
||||
stop
|
||||
end if
|
||||
IF(N.lt.2) then
|
||||
print *,'The number of wavelength points < 2, stop'
|
||||
stop
|
||||
end if
|
||||
|
||||
HT(1)=0.5d0*(T(2)-T(1))
|
||||
HT(N)=0.5d0*(T(N)-T(N-1))
|
||||
HH(1)=-100.0d0
|
||||
HH(N)=-100.0d0
|
||||
DO 10 I=2,N-1
|
||||
HT(I)=0.5d0*(T(I+1)-T(I-1))
|
||||
HH(I)=-100.0d0
|
||||
10 CONTINUE
|
||||
|
||||
|
||||
|
||||
READ(4,*) Umin,Umax,NU
|
||||
READ(4,*) Vmin,Vmax,NV
|
||||
|
||||
IF(NU.gt.NMAX) then
|
||||
print *,'The number of maxima >',NMAX,' stop'
|
||||
stop
|
||||
end if
|
||||
IF(NV.gt.NMAX) then
|
||||
print *,'The number of minima >',NMAX,' stop'
|
||||
stop
|
||||
end if
|
||||
|
||||
IF(NU.LT.1) Then
|
||||
print *,'The number of maxima < 1, stop'
|
||||
stop
|
||||
end if
|
||||
IF(NV.LT.1) Then
|
||||
print *,'The number of minima < 1, stop'
|
||||
stop
|
||||
end if
|
||||
|
||||
Ulevels(1)=Umax
|
||||
IF (NU.lt.2) go to 25
|
||||
HU=(Umax-Umin)/DBLE(NU-1)
|
||||
DO 20 I=1,NU-1
|
||||
ULEVELS(I+1)=Umax-DBLE(I)*HU
|
||||
20 CONTINUE
|
||||
|
||||
25 continue
|
||||
Vlevels(1)=Vmax
|
||||
IF (NV.lt.2) go to 35
|
||||
HV=(Vmax-Vmin)/DBLE(NV-1)
|
||||
DO 30 I=1,Nv-1
|
||||
VLEVELS(I+1)=Vmax-DBLE(I)*HV
|
||||
30 CONTINUE
|
||||
35 continue
|
||||
CLOSE(UNIT=4)
|
||||
RETURN
|
||||
END
|
||||
|
||||
|
||||
SUBROUTINE TRANSF(N,T,A,TIMEV,VALUE,DER)
|
||||
C
|
||||
C N number of data points
|
||||
C TIMEV vector of time points
|
||||
C A a vector of values of a function G(TIME)
|
||||
C T independent time point
|
||||
C VALUE is a value of a function at T, i.e. VALUE=G(T).
|
||||
c DER=G'(t)
|
||||
C
|
||||
USE SIZEMOD
|
||||
IMPLICIT NONE
|
||||
REAL*8, intent(inout):: VALUE, DER,T
|
||||
C INTEGER, PARAMETER :: RDIM = 10201
|
||||
REAL*8, DIMENSION(RDIM), intent(in) :: A,TIMEV
|
||||
integer, intent(in) :: N
|
||||
REAL*8:: T1
|
||||
integer :: I
|
||||
|
||||
IF (T.LT.TIMEV(1)) then
|
||||
der=(A(2)-A(1))/(TIMEV(2)-TIMEV(1))
|
||||
T1=T-TIMEV(1)
|
||||
VALUE=A(1)+T1*DER
|
||||
return
|
||||
end if
|
||||
IF (T.GT.TIMEV(N)) then
|
||||
der = (A(N)-A(N-1))/(TIMEV(N)-TIMEV(N-1))
|
||||
T1 = T-TIMEV(N)
|
||||
VALUE=A(N)+T1*DER
|
||||
return
|
||||
end if
|
||||
DO 5 I=2,N
|
||||
IF (T.LT.TIMEV(I)) GO TO 10
|
||||
5 CONTINUE
|
||||
10 I=I-1
|
||||
T1=T-TIMEV(I)
|
||||
DER=(A(I+1)-A(I))/(TIMEV(i+1)-TIMEV(I))
|
||||
VALUE=A(I)+T1*DER
|
||||
RETURN
|
||||
END
|
||||
|
||||
REAL*8 FUNCTION SPLE(N,T,A,TIMEV)
|
||||
C
|
||||
C N number of data points
|
||||
C TIME vector of time points
|
||||
C A a vector of values of a function G(TIME)
|
||||
C T independent time point
|
||||
C SPLE is a value of a function at T, i.e. SPLE=G(T).
|
||||
C
|
||||
USE SIZEMOD
|
||||
IMPLICIT NONE
|
||||
INTEGER, INTENT(IN):: N
|
||||
|
||||
REAL*8, INTENT(IN) :: T
|
||||
REAL*8, DIMENSION(5*NMAX), INTENT(IN) :: A,TIMEV
|
||||
REAL*8 :: T1
|
||||
INTEGER :: I
|
||||
SPLE=-9.9d0
|
||||
IF (T.LT.TIMEV(1) .OR. T.GT.TIMEV(N)) RETURN
|
||||
DO 5 I=2,N
|
||||
IF (T.LT.TIMEV(I)) GO TO 10
|
||||
5 CONTINUE
|
||||
10 I=I-1
|
||||
T1=T-TIMEV(I)
|
||||
SPLE=A(I)+T1*(A(I+1)-A(I))/(TIMEV(i+1)-TIMEV(I))
|
||||
RETURN
|
||||
END
|
||||
|
||||
|
||||
|
||||
SUBROUTINE COVG(XL0,XL2,XL4,COV,COV1,COV2,COV3,T,N)
|
||||
C
|
||||
C COVG evaluates:
|
||||
C
|
||||
C XL0,XL2,XL4 - spectral moments.
|
||||
C
|
||||
C Covariance function and its four derivatives for a vector T of length N.
|
||||
C It is saved in a vector COV; COV(1,...,N)=r(T), COV(N+1,...,2N)=r'(T), etc.
|
||||
C The vector COV should be of the length 5*N.
|
||||
C
|
||||
C Covariance matrices COV1=r'(T-T), COV2=r''(T-T) and COV3=r'''(T-T)
|
||||
C Dimension of COV1, COV2 should be N*N.
|
||||
C
|
||||
USE SIZEMOD
|
||||
! IMPLICIT NONE
|
||||
C INTEGER, PARAMETER:: NMAX = 101, RDIM = 10201
|
||||
REAL*8, PARAMETER:: ZERO = 0.0d0
|
||||
REAL*8, intent(inout) :: XL0,XL2,XL4
|
||||
REAL*8, DIMENSION(5*NMAX), intent(inout) :: COV
|
||||
REAL*8, DIMENSION(5*NMAX) :: A, TIMEV
|
||||
REAL*8, DIMENSION(RDIM), intent(inout) :: COV1,COV2,COV3
|
||||
REAL*8, DIMENSION(NMAX), intent(in) :: T
|
||||
INTEGER, intent(in) :: N
|
||||
integer :: NT, I, J, II
|
||||
REAL*8 :: TT, T0
|
||||
OPEN(UNIT=32,FILE='Cd0.in')
|
||||
OPEN(UNIT=33,FILE='Cd1.in')
|
||||
OPEN(UNIT=34,FILE='Cd2.in')
|
||||
OPEN(UNIT=35,FILE='Cd3.in')
|
||||
OPEN(UNIT=36,FILE='Cd4.in')
|
||||
C
|
||||
C COV(Y(T),Y(0))
|
||||
C
|
||||
|
||||
NT=1
|
||||
12 READ (32,*,END=11) TIMEV(NT),A(NT)
|
||||
NT=NT+1
|
||||
GO TO 12
|
||||
11 CONTINUE
|
||||
NT=NT-1
|
||||
|
||||
|
||||
XL0=SPLE(NT,ZERO,A,TIMEV)
|
||||
|
||||
DO 10 I=1,N
|
||||
COV(I)=SPLE(NT,T(I),A,TIMEV)
|
||||
10 CONTINUE
|
||||
|
||||
C
|
||||
C DERIVATIVE COV(Y(T),Y(0))
|
||||
C
|
||||
|
||||
NT=1
|
||||
22 READ (33,*,END=21) TIMEV(NT),A(NT)
|
||||
NT=NT+1
|
||||
GO TO 22
|
||||
21 CONTINUE
|
||||
NT=NT-1
|
||||
|
||||
II=0
|
||||
DO 20 I=1,N
|
||||
COV(I+N)=SPLE(NT,T(I),A,TIMEV)
|
||||
DO 20 J=1,N
|
||||
II=II+1
|
||||
T0=T(J)-T(I)
|
||||
TT=ABS(T0)
|
||||
COV1(II)=SPLE(NT,TT,A,TIMEV)
|
||||
IF (T0.LT.0.0d0) COV1(II)=-COV1(II)
|
||||
20 CONTINUE
|
||||
|
||||
C 2-DERIVATIVE COV(Y(T),Y(0))
|
||||
|
||||
NT=1
|
||||
32 READ (34,*,END=31) TIMEV(NT),A(NT)
|
||||
NT=NT+1
|
||||
GO TO 32
|
||||
31 CONTINUE
|
||||
NT=NT-1
|
||||
|
||||
II=0
|
||||
XL2=-SPLE(NT,ZERO,A,TIMEV)
|
||||
|
||||
DO 30 I=1,N
|
||||
COV(I+2*N)=SPLE(NT,T(I),A,TIMEV)
|
||||
DO 30 J=1,N
|
||||
II=II+1
|
||||
TT=ABS(T(J)-T(I))
|
||||
COV2(II)=SPLE(NT,TT,A,TIMEV)
|
||||
30 CONTINUE
|
||||
|
||||
C 3-DERIVATIVE COV(Y(T),Y(0))
|
||||
|
||||
NT=1
|
||||
42 READ (35,*,END=41) TIMEV(NT),A(NT)
|
||||
NT=NT+1
|
||||
GO TO 42
|
||||
41 CONTINUE
|
||||
NT=NT-1
|
||||
|
||||
|
||||
II=0
|
||||
DO 40 I=1,N
|
||||
COV(I+3*N)=SPLE(NT,T(I),A,TIMEV)
|
||||
DO 40 J=1,N
|
||||
II=II+1
|
||||
T0=T(J)-T(I)
|
||||
TT=ABS(T0)
|
||||
COV3(II)=SPLE(NT,TT,A,TIMEV)
|
||||
IF (T0.LT.0.0d0) COV3(II)=-COV3(II)
|
||||
40 CONTINUE
|
||||
|
||||
|
||||
|
||||
C 4-DERIVATIVE COV(Y(T),Y(0))
|
||||
|
||||
NT=1
|
||||
52 READ (36,*,END=51) TIMEV(NT),A(NT)
|
||||
NT=NT+1
|
||||
GO TO 52
|
||||
51 CONTINUE
|
||||
NT=NT-1
|
||||
|
||||
XL4=SPLE(NT,ZERO,A,TIMEV)
|
||||
|
||||
DO 50 I=1,N
|
||||
COV(I+4*N)=SPLE(NT,T(I),A,TIMEV)
|
||||
50 CONTINUE
|
||||
CLOSE(UNIT=32)
|
||||
CLOSE(UNIT=33)
|
||||
CLOSE(UNIT=34)
|
||||
CLOSE(UNIT=35)
|
||||
CLOSE(UNIT=36)
|
||||
RETURN
|
||||
END
|
||||
|
||||
SUBROUTINE INITINTEG(NIT)
|
||||
USE RINTMOD
|
||||
USE EPSMOD
|
||||
USE INFCMOD
|
||||
USE MREGMOD
|
||||
! IMPLICIT NONE
|
||||
INTEGER, intent(inout) :: NIT
|
||||
! INTEGER ISQ1
|
||||
C dimension INF(10),INFO(10)
|
||||
|
||||
C COMMON /RINT/ C,FC
|
||||
C COMMON /EPS/ EPS,EPSS,CEPSS
|
||||
C COMMON /INFC/ ISQ,INF,INFO
|
||||
OPEN(UNIT=1,FILE='accur.in')
|
||||
OPEN(UNIT=8,FILE='min.out')
|
||||
OPEN(UNIT=9,FILE='Max.out')
|
||||
OPEN(UNIT=10,FILE='Maxmin.out')
|
||||
OPEN(UNIT=11,FILE='Maxmin.log')
|
||||
|
||||
READ(1,*) NIT,IAC,ISQ
|
||||
READ(1,*) EPS,EPSS,EPS0
|
||||
|
||||
CLOSE (UNIT=1)
|
||||
|
||||
FC=FI(C)-FI(-C)
|
||||
CEPSS=1.0d0-EPSS
|
||||
|
||||
RETURN
|
||||
END
|
||||
|
||||
@ -1,370 +0,0 @@
|
||||
C Version 1994-X-18
|
||||
|
||||
C This is a new version of WAMP program computing crest-trough wavelength
|
||||
C and amplitude density.
|
||||
C
|
||||
C revised pab 2007
|
||||
C -moved all common blocks into modules
|
||||
C -renamed from minmax to sp2mmpdfreg + fixed some bugs
|
||||
C revised pab July 2007
|
||||
! -renamed from sp2mmpdfreg to cov2mmpdfreg
|
||||
! gfortran -W -Wall -pedantic-errors -fbounds-check -Werror -c dsvdc.f mregmodule.f cov2mmpdfreg.f
|
||||
|
||||
SUBROUTINE INITINTEG(EPS_,EPSS_,EPS0_,C_,IAC_,ISQ_)
|
||||
! Initiation of all constants and integration nodes 'INITINTEG'
|
||||
USE RINTMOD
|
||||
USE EPSMOD
|
||||
USE INFCMOD
|
||||
USE MREGMOD
|
||||
REAL*8 :: EPS_,EPSS_,EPS0_,C_
|
||||
INTEGER :: IAC_,ISQ_
|
||||
Cf2py real*8, optional :: EPS_ = 0.01
|
||||
Cf2py real*8, optional :: EPSS_ = 0.00005
|
||||
Cf2py real*8, optional :: EPS0_ = 0.00005
|
||||
Cf2py real*8, optional :: C_ = 4.5
|
||||
Cf2py integer, optional :: IAC_ = 1
|
||||
Cf2py integer, optional :: ISQ_ = 0
|
||||
! IMPLICIT NONE
|
||||
C COMMON /RINT/ C,FC
|
||||
C COMMON /EPS/ EPS,EPSS,CEPSS
|
||||
C COMMON /INFC/ ISQ,INF,INFO
|
||||
|
||||
IAC = IAC_
|
||||
ISQ = ISQ_
|
||||
EPS = EPS_
|
||||
EPSS = EPSS_
|
||||
EPS0 = EPS0_
|
||||
C = C_
|
||||
|
||||
FC = FI(C)-FI(-C)
|
||||
! CEPSS = 1.0d0-EPSS
|
||||
RETURN
|
||||
END SUBROUTINE INITINTEG
|
||||
|
||||
subroutine cov2mmpdfreg(UVdens,t,COV,ULev,VLev,Tg,Xg,Nt,Nu,Nv,Ng,
|
||||
& NIT)
|
||||
USE SIZEMOD
|
||||
USE EPSMOD
|
||||
USE CHECKMOD
|
||||
USE MREGMOD
|
||||
USE INTFCMOD
|
||||
IMPLICIT NONE
|
||||
INTEGER, INTENT(IN) :: Nt, Nu, Nv, Ng, NIT
|
||||
REAL*8, DIMENSION(Nt,5), intent(in):: COV
|
||||
REAL*8, DIMENSION(Nu,Nv), intent(out):: UVdens
|
||||
REAL*8, DIMENSION(Nu), intent(in):: ULev
|
||||
REAL*8, DIMENSION(Nv), intent(in):: VLev
|
||||
REAL*8, DIMENSION(Ng), intent(in):: Tg, Xg
|
||||
REAL*8, dimension(Nt), intent(in):: T
|
||||
Cf2py integer, intent(hide), depend(t) :: Nt = len(t)
|
||||
Cf2py integer, intent(hide), depend(Ulev) :: Nu = len(Ulev)
|
||||
Cf2py integer, intent(hide), depend(Vlev) :: Nv = len(Vlev)
|
||||
Cf2py integer, intent(hide), depend(Tg) :: Ng = len(Tg)
|
||||
Cf2py integer, optional :: NIT = 2
|
||||
Cf2py real*8, intent(out), depend(Nu,Nv) :: UVdens
|
||||
Cf2py depend(Ng) Xg
|
||||
Cf2py depend(Nt,5) COV
|
||||
real*8 Q0,SQ0,Q1,SQ1, U,V, XL0, XL2, XL4
|
||||
REAL*8 VDERI, DER, F, HHHH, VALUE
|
||||
C REAL*8 VV, CDER,SDER, CONST1, FM
|
||||
C INTEGER, PARAMETER :: MMAX = 5, NMAX = 101, RDIM = 10201
|
||||
REAL*8, DIMENSION(NMAX) :: HHT,VT,UT,Vdd,Udd
|
||||
REAL*8, DIMENSION(RDIM) :: R,R1,R2,R3
|
||||
REAL*8:: AA(MMAX-2,MMAX-2),AI((MMAX+1)*NMAX)
|
||||
REAL*8, DIMENSION(MMAX+1) :: BB, DAI
|
||||
C DIMENSION UVdens(NMAX,NMAX),HHT(NMAX)
|
||||
C DIMENSION T(NMAX),Ulev(NMAX),Vlev(NMAX)
|
||||
C DIMENSION VT(NMAX),UT(NMAX),Vdd(NMAX),Udd(NMAX)
|
||||
C DIMENSION COV(5*NMAX),R(RDIM),R1(RDIM),R2(RDIM),R3(RDIM)
|
||||
|
||||
|
||||
C
|
||||
C The program computes the joint density of maximum the following minimum
|
||||
C and the distance between Max and min for a zero-mean stationary
|
||||
C Gaussian process with covariance function defined explicitely with 4
|
||||
C derivatives. The process should be normalized so that the first and
|
||||
C the second spectral moments are equal to 1. The values of Max are taken
|
||||
C as the nodes at Hermite-Quadrature and then integrated out so that
|
||||
C the output is a joint density of wavelength T and amplitude H=Max-min.
|
||||
C The Max values are defined by subroutine Gauss_M with the accuracy
|
||||
C input epsu. The principle is that the integral of the marginal density
|
||||
C of f_Max is computed with sufficient accuracy.
|
||||
C
|
||||
REAL*8, DIMENSION(NMAX) :: B0,DB0,DDB0,B1,DB1,DDB1,DB2,DDB2
|
||||
REAL*8, DIMENSION(NMAX) :: Q,SQ,VDER,DBI,BI
|
||||
C DIMENSION B0(NMAX),DB0(NMAX),DDB0(NMAX)
|
||||
C DIMENSION B1(NMAX),DB1(NMAX),DDB1(NMAX)
|
||||
C DIMENSION DB2(NMAX),DDB2(NMAX)
|
||||
C DIMENSION Q(NMAX),SQ(NMAX),VDER(NMAX),DBI(NMAX),BI(NMAX)
|
||||
INTEGER :: J,I,I1,I2,I3,IU, IV,N, NNIT, INF
|
||||
C INTEGER :: fffff
|
||||
C REAL*8 EPS0
|
||||
C INTEGER III01,III11,III21,III31,III41,III51
|
||||
C *,III61,III71,III81,III91,III101 , III0
|
||||
C COMMON/CHECK1/III01,III11,III21,III31,III41,III51
|
||||
C *,III61,III71,III81,III91,III101
|
||||
C COMMON/CHECKQ/III0
|
||||
C COMMON /EPS/ EPS,EPSS,CEPSS
|
||||
|
||||
C
|
||||
C Initiation of all constants and integration nodes 'INITINTEG'
|
||||
C
|
||||
! CALL INITINTEG()
|
||||
|
||||
! OPEN(UNIT=8,FILE='min.out')
|
||||
! OPEN(UNIT=9,FILE='Max.out')
|
||||
! OPEN(UNIT=10,FILE='Maxmin.out')
|
||||
! OPEN(UNIT=11,FILE='Maxmin.log')
|
||||
c
|
||||
c OBS. we are using the variables R,R1,R2 R3 as a temporary storage
|
||||
C for transformation g of the process.
|
||||
|
||||
N = Nt
|
||||
CALL INITLEVELS(T,HHT,Nt,NU,Nv)
|
||||
C CALL INITLEVELS(Ulev,NU,Vlev,NV,T,HHT,Nt,R1,R2,NG)
|
||||
IF( Tg(1) .gt. Tg(ng)) then
|
||||
print *,'Error Tg must be strictly increasing'
|
||||
return
|
||||
end if
|
||||
if(abs(Tg(ng)-Tg(1))*abs(Xg(ng)-Xg(1)).lt.0.01d0) then
|
||||
print *,'The transformation g is singular, stop'
|
||||
return
|
||||
end if
|
||||
|
||||
! do IV=1,Nt
|
||||
! print *, 'Cov', COV(IV,:)
|
||||
! end do
|
||||
|
||||
DO IV=1,Nv
|
||||
V=Vlev(IV)
|
||||
CALL TRANSF(NG,V,Xg,Tg,VALUE,DER)
|
||||
VT(IV)=VALUE
|
||||
Vdd(IV)=DER
|
||||
enddo
|
||||
DO IU=1,Nu
|
||||
U = Ulev(IU)
|
||||
CALL TRANSF(NG,U,Xg,Tg,VALUE,DER)
|
||||
UT(IU) = VALUE
|
||||
Udd(IU) = DER
|
||||
do IV=1,Nv
|
||||
UVdens(IU,IV)=0.0d0
|
||||
enddo
|
||||
enddo
|
||||
|
||||
CALL COVG(XL0,XL2,XL4,R1,R2,R3,COV,T,Nt)
|
||||
|
||||
|
||||
Q0=XL4
|
||||
IF (Q0.le.1.0D0+EPS) then
|
||||
Print *,'Covariance structure is singular, stop.'
|
||||
return
|
||||
end if
|
||||
SQ0 = SQRT(Q0)
|
||||
Q1 = XL0-XL2*XL2/XL4
|
||||
IF (Q1.le.EPS) then
|
||||
Print *,'Covariance structure is singular, stop.'
|
||||
return
|
||||
end if
|
||||
SQ1 = SQRT(Q1)
|
||||
DO I=1,Nt
|
||||
B0(I) =-COV(I,3)
|
||||
DB0(I) =-COV(I,4)
|
||||
DDB0(I)=-COV(I,5)
|
||||
|
||||
B1(I) =COV(I,1)+COV(I,3)*(XL2/XL4)
|
||||
DB1(I) =COV(I,2)+COV(I,4)*(XL2/XL4)
|
||||
DDB1(I)=COV(I,3)+XL2*(COV(I,5)/XL4)
|
||||
C
|
||||
C Q(I) contains Var(X(T(i))|X'(0),X''(0),X(0))
|
||||
C VDER(I) contains Var(X''(T(i))|X'(0),X''(0),X(0))
|
||||
C
|
||||
Q(I)=XL0 - COV(I,2)*(COV(I,2)/XL2) - B0(I)*(B0(I)/Q0)
|
||||
1 -B1(I)*(B1(I)/Q1)
|
||||
VDER(I)=XL4 - (COV(I,4)*COV(I,4))/XL2 - (DDB0(I)*DDB0(I))/Q0
|
||||
1 - (DDB1(I)*DDB1(I))/Q1
|
||||
|
||||
|
||||
C
|
||||
C DDB2(I) contains Cov(X''(T(i)),X(T(i))|X'(0),X''(0),X(0))
|
||||
C
|
||||
DDB2(I)=-XL2 - (COV(I,2)*COV(I,4))/XL2 - DDB0(I)*(B0(I)/Q0)
|
||||
1 -DDB1(I)*(B1(I)/Q1)
|
||||
IF(Q(I).LE.eps) then
|
||||
SQ(i) =0.0d0
|
||||
DDB2(i)=0.0d0
|
||||
else
|
||||
SQ(I)=SQRT(Q(I))
|
||||
C
|
||||
C VDER(I) contains Var(X''(T(i))|X'(0),X''(0),X(0),X(T(i))
|
||||
C
|
||||
|
||||
VDER(I)=VDER(I) - (DDB2(I)*DDB2(I))/Q(I)
|
||||
end if
|
||||
|
||||
c10 CONTINUE
|
||||
enddo
|
||||
DO I=1,Nt
|
||||
DO J=1,Nt
|
||||
C
|
||||
C R1 contains Cov(X(T(I)),X'(T(J))|X'(0),X''(0),X(0))
|
||||
C
|
||||
R1(J+(I-1)*N) = R1(J+(I-1)*N) - COV(I,2)*(COV(J,3)/XL2)
|
||||
1 - (B0(I)*DB0(J)/Q0) - (B1(I)*DB1(J)/Q1)
|
||||
|
||||
C
|
||||
C R2 contains Cov(X'(T(I)),X'(T(J))|X'(0),X''(0),X(0))
|
||||
C
|
||||
R2(J+(I-1)*N) = -R2(J+(I-1)*N) - COV(I,3)*(COV(J,3)/XL2)
|
||||
1 - DB0(I)*DB0(J)/Q0 - DB1(I)*(DB1(J)/Q1)
|
||||
C
|
||||
C R3 contains Cov(X''(T(I)),X'(T(J))|X'(0),X''(0),X(0))
|
||||
C
|
||||
R3(J+(I-1)*N) = R3(J+(I-1)*N) - COV(I,4)*(COV(J,3)/XL2)
|
||||
1 - DB0(J)*(DDB0(I)/Q0) - DDB1(I)*(DB1(J)/Q1)
|
||||
c15 CONTINUE
|
||||
enddo
|
||||
enddo
|
||||
|
||||
C The initiations are finished and we are beginning with 3 loops
|
||||
C on T=T(I), U=Ulevels(IU), V=Ulevels(IV), U>V.
|
||||
|
||||
DO I=1,Nt
|
||||
|
||||
NNIT=NIT
|
||||
IF (Q(I).LE.EPS) GO TO 20
|
||||
|
||||
DO I1=1,I
|
||||
DB2(I1)=R1(I1+(I-1)*N)
|
||||
|
||||
C Cov(X'(T(I1)),X(T(i))|X'(0),X''(0),X(0))
|
||||
C DDB2(I) contains Cov(X''(T(i)),X(T(i))|X'(0),X''(0),X(0))
|
||||
|
||||
enddo
|
||||
|
||||
DO I3=1,I
|
||||
DBI(I3) = R3(I3+(I-1)*N) - (DDB2(I)*DB2(I3)/Q(I))
|
||||
BI(I3) = R2(I3+(I-1)*N) - (DB2(I)*DB2(I3)/Q(I))
|
||||
enddo
|
||||
DO I3=1,I-1
|
||||
AI(I3)=0.0d0
|
||||
AI(I3+I-1)=DB0(I3)/SQ0
|
||||
AI(I3+2*(I-1))=DB1(I3)/SQ1
|
||||
AI(I3+3*(I-1))=DB2(I3)/SQ(I)
|
||||
enddo
|
||||
VDERI=VDER(I)
|
||||
DAI(1)=0.0d0
|
||||
DAI(2)=DDB0(I)/SQ0
|
||||
DAI(3)=DDB1(I)/SQ1
|
||||
DAI(4)=DDB2(I)/SQ(I)
|
||||
AA(1,1)=DB0(I)/SQ0
|
||||
AA(1,2)=DB1(I)/SQ1
|
||||
AA(1,3)=DB2(I)/SQ(I)
|
||||
AA(2,1)=XL2/SQ0
|
||||
AA(2,2)=SQ1
|
||||
AA(2,3)=0.0d0
|
||||
AA(3,1)=B0(I)/SQ0
|
||||
AA(3,2)=B1(I)/SQ1
|
||||
AA(3,3)=SQ(I)
|
||||
IF (BI(I).LE.EPS) NNIT=0
|
||||
IF (NNIT.GT.1) THEN
|
||||
IF(I.LT.1) GO TO 41
|
||||
DO I1=1,I-1
|
||||
DO I2=1,I-1
|
||||
C R contains Cov(X'(T(I1)),X'(T(I2))|X'(0),X''(0),X(0),X(I))
|
||||
R(I2+(I1-1)*(I-1))=R2(I2+(I1-1)*N)-(DB2(I1)*DB2(I2)/Q(I))
|
||||
|
||||
enddo
|
||||
enddo
|
||||
41 CONTINUE
|
||||
END IF
|
||||
|
||||
C Here the covariance of the problem would be initiated
|
||||
|
||||
INF=0
|
||||
Print *,' Laps to go:',Nt-I+1
|
||||
DO IV=1,Nv
|
||||
V=VT(IV)
|
||||
! IF (ABS(V).GT.5.0D0) GO TO 80
|
||||
IF (Vdd(IV).LT.EPS0) GO TO 80
|
||||
DO IU=1,Nu
|
||||
U=UT(IU)
|
||||
IF (U.LE.V) go to 60
|
||||
! IF (ABS(U).GT.5.0D0) GO TO 60
|
||||
IF (Udd(IU).LT.EPS0) GO TO 60
|
||||
BB(1)=0.0d0
|
||||
BB(2)=U
|
||||
BB(3)=V
|
||||
! if (IV.EQ.2.AND.IU.EQ.1) THEN
|
||||
! fffff = 10
|
||||
! endif
|
||||
|
||||
CALL MREG(F,R,BI,DBI,AA,BB,AI,DAI,VDERI,3,I-1,NNIT,INF)
|
||||
INF=1
|
||||
UVdens(IU,IV) = UVdens(IU,IV) + Udd(IU)*Vdd(IV)*HHT(I)*F
|
||||
|
||||
! if (F.GT.0.01.AND.U.GT.2.AND.V.LT.-2) THEN
|
||||
! if (N-I+1 .eq. 38.and.IV.EQ.26.AND.IU.EQ.16) THEN
|
||||
! if (IV.EQ.32.AND.IU.EQ.8.and.I.eq.11) THEN
|
||||
! PRINT * ,' R:', R(1:I)
|
||||
! PRINT * ,' BI:', BI(1:I)
|
||||
! PRINT * ,' DBI:', DBI(1:I)
|
||||
! PRINT * ,' DB2:', DB2(1:I)
|
||||
! PRINT * ,' DB0(1):', DB0(1)
|
||||
! PRINT * ,' DB1(1):', DB1(1)
|
||||
! PRINT * ,' DAI:', DAI
|
||||
! PRINT * ,' BB:', BB
|
||||
! PRINT * ,' VDERI:', VDERI
|
||||
! PRINT * ,' F :', F
|
||||
! PRINT * ,' UVDENS :', UVdens(IU,IV)
|
||||
! fffff = 10
|
||||
! endif
|
||||
|
||||
60 CONTINUE
|
||||
enddo
|
||||
80 continue
|
||||
enddo
|
||||
20 CONTINUE
|
||||
enddo
|
||||
|
||||
hhhh=0.0d0
|
||||
do Iu=1,Nu
|
||||
do Iv=1,Nv
|
||||
! WRITE(10,300) Ulev(iu),Vlev(iv),UVdens(iu,iv)
|
||||
hhhh=hhhh+UVdens(iu,iv)
|
||||
enddo
|
||||
enddo
|
||||
if (nu.gt.1.and.nv.gt.1) then
|
||||
VALUE = (Ulev(2)-Ulev(1))*(Vlev(2)-Vlev(1))*hhhh
|
||||
print *,'SumSum f_uv *du*dv=', VALUE
|
||||
end if
|
||||
|
||||
C sder=sqrt(XL4-XL2*XL2/XL0)
|
||||
C cder=-XL2/sqrt(XL0)
|
||||
C const1=1/sqrt(XL0*XL4)
|
||||
C DO 95 IU=1,NU
|
||||
C U=UT(IU)
|
||||
C FM=Udd(IU)*const1*exp(-0.5*U*U/XL0)*PMEAN(-cder*U,sder)
|
||||
C WRITE(9,300) Ulev(IU),FM
|
||||
C 95 continue
|
||||
C DO 105 IV=1,NV
|
||||
C V=VT(IV)
|
||||
C VV=cder*V
|
||||
C Fm=Vdd(IV)*const1*exp(-0.5*V*V/XL0)*PMEAN(VV,sder)
|
||||
C WRITE(8,300) Vlev(IV),Fm
|
||||
C 105 continue
|
||||
if (III0.eq.0) III0=1
|
||||
|
||||
PRINT *, 'Rate of calls RINDT0:',float(iii01)/float(III0)
|
||||
PRINT *, 'Rate of calls RINDT1:',float(iii11)/float(III0)
|
||||
PRINT *, 'Rate of calls RINDT2:',float(iii21)/float(III0)
|
||||
PRINT *, 'Rate of calls RINDT3:',float(iii31)/float(III0)
|
||||
PRINT *, 'Rate of calls RINDT4:',float(iii41)/float(III0)
|
||||
PRINT *, 'Rate of calls RINDT5:',float(iii51)/float(III0)
|
||||
PRINT *, 'Rate of calls RINDT6:',float(iii61)/float(III0)
|
||||
PRINT *, 'Rate of calls RINDT7:',float(iii71)/float(III0)
|
||||
PRINT *, 'Rate of calls RINDT8:',float(iii81)/float(III0)
|
||||
PRINT *, 'Rate of calls RINDT9:',float(iii91)/float(III0)
|
||||
PRINT *, 'Rate of calls RINDT10:',float(iii101)/float(III0)
|
||||
PRINT *, 'Number of calls of RINDT*',III0
|
||||
return
|
||||
END subroutine cov2mmpdfreg
|
||||
@ -1,613 +0,0 @@
|
||||
MODULE SVD
|
||||
IMPLICIT NONE
|
||||
INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(12, 60)
|
||||
|
||||
! Based upon routines from the NSWC (Naval Surface Warfare Center),
|
||||
! which were based upon LAPACK routines.
|
||||
|
||||
! Code converted using TO_F90 by Alan Miller
|
||||
! Date: 2003-11-11 Time: 17:50:44
|
||||
! Revised pab 2007
|
||||
! Converted to fixed form
|
||||
|
||||
|
||||
CONTAINS
|
||||
|
||||
|
||||
SUBROUTINE drotg(da, db, dc, ds)
|
||||
|
||||
! DESIGNED BY C.L.LAWSON, JPL, 1977 SEPT 08
|
||||
!
|
||||
! CONSTRUCT THE GIVENS TRANSFORMATION
|
||||
!
|
||||
! ( DC DS )
|
||||
! G = ( ) , DC**2 + DS**2 = 1 ,
|
||||
! (-DS DC )
|
||||
!
|
||||
! WHICH ZEROS THE SECOND ENTRY OF THE 2-VECTOR (DA,DB)**T .
|
||||
!
|
||||
! THE QUANTITY R = (+/-)SQRT(DA**2 + DB**2) OVERWRITES DA IN
|
||||
! STORAGE. THE VALUE OF DB IS OVERWRITTEN BY A VALUE Z WHICH
|
||||
! ALLOWS DC AND DS TO BE RECOVERED BY THE FOLLOWING ALGORITHM:
|
||||
! IF Z=1 SET DC=0.D0 AND DS=1.D0
|
||||
! IF DABS(Z) < 1 SET DC=SQRT(1-Z**2) AND DS=Z
|
||||
! IF DABS(Z) > 1 SET DC=1/Z AND DS=SQRT(1-DC**2)
|
||||
!
|
||||
! NORMALLY, THE SUBPROGRAM DROT(N,DX,INCX,DY,INCY,DC,DS) WILL
|
||||
! NEXT BE CALLED TO APPLY THE TRANSFORMATION TO A 2 BY N MATRIX.
|
||||
!
|
||||
! ------------------------------------------------------------------
|
||||
|
||||
REAL (dp), INTENT(IN OUT) :: da
|
||||
REAL (dp), INTENT(IN OUT) :: db
|
||||
REAL (dp), INTENT(OUT) :: dc
|
||||
REAL (dp), INTENT(OUT) :: ds
|
||||
|
||||
REAL (dp) :: u, v, r
|
||||
IF (ABS(da) <= ABS(db)) GO TO 10
|
||||
|
||||
! *** HERE ABS(DA) > ABS(DB) ***
|
||||
|
||||
u = da + da
|
||||
v = db / u
|
||||
|
||||
! NOTE THAT U AND R HAVE THE SIGN OF DA
|
||||
|
||||
r = SQRT(.25D0 + v**2) * u
|
||||
|
||||
! NOTE THAT DC IS POSITIVE
|
||||
|
||||
dc = da / r
|
||||
ds = v * (dc + dc)
|
||||
db = ds
|
||||
da = r
|
||||
RETURN
|
||||
|
||||
! *** HERE ABS(DA) <= ABS(DB) ***
|
||||
|
||||
10 IF (db == 0.d0) GO TO 20
|
||||
u = db + db
|
||||
v = da / u
|
||||
|
||||
! NOTE THAT U AND R HAVE THE SIGN OF DB
|
||||
! (R IS IMMEDIATELY STORED IN DA)
|
||||
|
||||
da = SQRT(.25D0 + v**2) * u
|
||||
|
||||
! NOTE THAT DS IS POSITIVE
|
||||
|
||||
ds = db / da
|
||||
dc = v * (ds + ds)
|
||||
IF (dc == 0.d0) GO TO 15
|
||||
db = 1.d0 / dc
|
||||
RETURN
|
||||
15 db = 1.d0
|
||||
RETURN
|
||||
|
||||
! *** HERE DA = DB = 0.D0 ***
|
||||
|
||||
20 dc = 1.d0
|
||||
ds = 0.d0
|
||||
RETURN
|
||||
|
||||
END SUBROUTINE drotg
|
||||
|
||||
|
||||
SUBROUTINE dswap1 (n, dx, dy)
|
||||
! INTERCHANGES TWO VECTORS.
|
||||
! USES UNROLLED LOOPS FOR INCREMENTS EQUAL ONE.
|
||||
! JACK DONGARRA, LINPACK, 3/11/78.
|
||||
! This version is for increments = 1.
|
||||
|
||||
INTEGER, INTENT(IN) :: n
|
||||
REAL (dp), INTENT(IN OUT) :: dx(*)
|
||||
REAL (dp), INTENT(IN OUT) :: dy(*)
|
||||
|
||||
REAL (dp) :: dtemp
|
||||
INTEGER :: i, m, mp1
|
||||
|
||||
IF(n <= 0) RETURN
|
||||
|
||||
! CODE FOR BOTH INCREMENTS EQUAL TO 1
|
||||
!
|
||||
! CLEAN-UP LOOP
|
||||
|
||||
m = MOD(n,3)
|
||||
IF( m == 0 ) GO TO 40
|
||||
DO i = 1,m
|
||||
dtemp = dx(i)
|
||||
dx(i) = dy(i)
|
||||
dy(i) = dtemp
|
||||
END DO
|
||||
IF( n < 3 ) RETURN
|
||||
40 mp1 = m + 1
|
||||
DO i = mp1,n,3
|
||||
dtemp = dx(i)
|
||||
dx(i) = dy(i)
|
||||
dy(i) = dtemp
|
||||
dtemp = dx(i + 1)
|
||||
dx(i + 1) = dy(i + 1)
|
||||
dy(i + 1) = dtemp
|
||||
dtemp = dx(i + 2)
|
||||
dx(i + 2) = dy(i + 2)
|
||||
dy(i + 2) = dtemp
|
||||
END DO
|
||||
RETURN
|
||||
END SUBROUTINE dswap1
|
||||
|
||||
|
||||
SUBROUTINE drot1 (n, dx, dy, c, s)
|
||||
! APPLIES A PLANE ROTATION.
|
||||
! JACK DONGARRA, LINPACK, 3/11/78.
|
||||
! This version is for increments = 1.
|
||||
|
||||
INTEGER, INTENT(IN) :: n
|
||||
REAL (dp), INTENT(IN OUT) :: dx(*)
|
||||
REAL (dp), INTENT(IN OUT) :: dy(*)
|
||||
REAL (dp), INTENT(IN) :: c
|
||||
REAL (dp), INTENT(IN) :: s
|
||||
|
||||
REAL (dp) :: dtemp
|
||||
INTEGER :: i
|
||||
|
||||
IF(n <= 0) RETURN
|
||||
! CODE FOR BOTH INCREMENTS EQUAL TO 1
|
||||
|
||||
DO i = 1,n
|
||||
dtemp = c*dx(i) + s*dy(i)
|
||||
dy(i) = c*dy(i) - s*dx(i)
|
||||
dx(i) = dtemp
|
||||
END DO
|
||||
RETURN
|
||||
END SUBROUTINE drot1
|
||||
|
||||
|
||||
SUBROUTINE dsvdc(x, n, p, s, e, u, v, job, info)
|
||||
|
||||
INTEGER, INTENT(IN) :: n
|
||||
INTEGER, INTENT(IN) :: p
|
||||
REAL (dp), INTENT(IN OUT) :: x(:,:)
|
||||
REAL (dp), INTENT(OUT) :: s(:)
|
||||
REAL (dp), INTENT(OUT) :: e(:)
|
||||
REAL (dp), INTENT(OUT) :: u(:,:)
|
||||
REAL (dp), INTENT(OUT) :: v(:,:)
|
||||
INTEGER, INTENT(IN) :: job
|
||||
INTEGER, INTENT(OUT) :: info
|
||||
|
||||
! DSVDC IS A SUBROUTINE TO REDUCE A DOUBLE PRECISION NXP MATRIX X
|
||||
! BY ORTHOGONAL TRANSFORMATIONS U AND V TO DIAGONAL FORM. THE
|
||||
! DIAGONAL ELEMENTS S(I) ARE THE SINGULAR VALUES OF X. THE
|
||||
! COLUMNS OF U ARE THE CORRESPONDING LEFT SINGULAR VECTORS,
|
||||
! AND THE COLUMNS OF V THE RIGHT SINGULAR VECTORS.
|
||||
!
|
||||
! ON ENTRY
|
||||
!
|
||||
! X DOUBLE PRECISION(LDX,P), WHERE LDX.GE.N.
|
||||
! X CONTAINS THE MATRIX WHOSE SINGULAR VALUE
|
||||
! DECOMPOSITION IS TO BE COMPUTED. X IS
|
||||
! DESTROYED BY DSVDC.
|
||||
!
|
||||
! LDX INTEGER.
|
||||
! LDX IS THE LEADING DIMENSION OF THE ARRAY X.
|
||||
!
|
||||
! N INTEGER.
|
||||
! N IS THE NUMBER OF ROWS OF THE MATRIX X.
|
||||
!
|
||||
! P INTEGER.
|
||||
! P IS THE NUMBER OF COLUMNS OF THE MATRIX X.
|
||||
!
|
||||
! LDU INTEGER.
|
||||
! LDU IS THE LEADING DIMENSION OF THE ARRAY U.
|
||||
! (SEE BELOW).
|
||||
!
|
||||
! LDV INTEGER.
|
||||
! LDV IS THE LEADING DIMENSION OF THE ARRAY V.
|
||||
! (SEE BELOW).
|
||||
!
|
||||
! JOB INTEGER.
|
||||
! JOB CONTROLS THE COMPUTATION OF THE SINGULAR
|
||||
! VECTORS. IT HAS THE DECIMAL EXPANSION AB
|
||||
! WITH THE FOLLOWING MEANING
|
||||
!
|
||||
! A.EQ.0 DO NOT COMPUTE THE LEFT SINGULAR VECTORS.
|
||||
! A.EQ.1 RETURN THE N LEFT SINGULAR VECTORS IN U.
|
||||
! A.GE.2 RETURN THE FIRST MIN(N,P) SINGULAR
|
||||
! VECTORS IN U.
|
||||
! B.EQ.0 DO NOT COMPUTE THE RIGHT SINGULAR VECTORS.
|
||||
! B.EQ.1 RETURN THE RIGHT SINGULAR VECTORS IN V.
|
||||
!
|
||||
! ON RETURN
|
||||
!
|
||||
! S DOUBLE PRECISION(MM), WHERE MM=MIN(N+1,P).
|
||||
! THE FIRST MIN(N,P) ENTRIES OF S CONTAIN THE SINGULAR
|
||||
! VALUES OF X ARRANGED IN DESCENDING ORDER OF MAGNITUDE.
|
||||
!
|
||||
! E DOUBLE PRECISION(P).
|
||||
! E ORDINARILY CONTAINS ZEROS. HOWEVER SEE THE
|
||||
! DISCUSSION OF INFO FOR EXCEPTIONS.
|
||||
!
|
||||
! U DOUBLE PRECISION(LDU,K), WHERE LDU.GE.N. IF
|
||||
! JOBA.EQ.1 THEN K.EQ.N, IF JOBA.GE.2
|
||||
! THEN K.EQ.MIN(N,P).
|
||||
! U CONTAINS THE MATRIX OF LEFT SINGULAR VECTORS.
|
||||
! U IS NOT REFERENCED IF JOBA.EQ.0. IF N.LE.P
|
||||
! OR IF JOBA.EQ.2, THEN U MAY BE IDENTIFIED WITH X
|
||||
! IN THE SUBROUTINE CALL.
|
||||
!
|
||||
! V DOUBLE PRECISION(LDV,P), WHERE LDV.GE.P.
|
||||
! V CONTAINS THE MATRIX OF RIGHT SINGULAR VECTORS.
|
||||
! V IS NOT REFERENCED IF JOB.EQ.0. IF P.LE.N,
|
||||
! THEN V MAY BE IDENTIFIED WITH X IN THE
|
||||
! SUBROUTINE CALL.
|
||||
!
|
||||
! INFO INTEGER.
|
||||
! THE SINGULAR VALUES (AND THEIR CORRESPONDING SINGULAR
|
||||
! VECTORS) S(INFO+1),S(INFO+2),...,S(M) ARE CORRECT
|
||||
! (HERE M=MIN(N,P)). THUS IF INFO.EQ.0, ALL THE
|
||||
! SINGULAR VALUES AND THEIR VECTORS ARE CORRECT.
|
||||
! IN ANY EVENT, THE MATRIX B = TRANS(U)*X*V IS THE
|
||||
! BIDIAGONAL MATRIX WITH THE ELEMENTS OF S ON ITS DIAGONAL
|
||||
! AND THE ELEMENTS OF E ON ITS SUPER-DIAGONAL (TRANS(U)
|
||||
! IS THE TRANSPOSE OF U). THUS THE SINGULAR VALUES
|
||||
! OF X AND B ARE THE SAME.
|
||||
!
|
||||
! LINPACK. THIS VERSION DATED 03/19/79 .
|
||||
! G.W. STEWART, UNIVERSITY OF MARYLAND, ARGONNE NATIONAL LAB.
|
||||
!
|
||||
! DSVDC USES THE FOLLOWING FUNCTIONS AND SUBPROGRAMS.
|
||||
!
|
||||
! EXTERNAL DROT
|
||||
! BLAS DAXPY,DDOT,DSCAL,DSWAP,DNRM2,DROTG
|
||||
! FORTRAN DABS,DMAX1,MAX0,MIN0,MOD,DSQRT
|
||||
|
||||
! INTERNAL VARIABLES
|
||||
|
||||
INTEGER :: iter, j, jobu, k, kase, kk, l, ll, lls, lm1, lp1, ls,
|
||||
& lu, m, maxit,mm, mm1, mp1, nct, nctp1, ncu, nrt, nrtp1
|
||||
REAL (dp) :: t, work(n)
|
||||
REAL (dp) :: b, c, cs, el, emm1, f, g, scale, shift, sl, sm, sn,
|
||||
& smm1, t1, test, ztest
|
||||
LOGICAL :: wantu, wantv
|
||||
|
||||
! SET THE MAXIMUM NUMBER OF ITERATIONS.
|
||||
|
||||
maxit = 30
|
||||
|
||||
! DETERMINE WHAT IS TO BE COMPUTED.
|
||||
|
||||
wantu = .false.
|
||||
wantv = .false.
|
||||
jobu = MOD(job,100)/10
|
||||
ncu = n
|
||||
IF (jobu > 1) ncu = MIN(n,p)
|
||||
IF (jobu /= 0) wantu = .true.
|
||||
IF (MOD(job,10) /= 0) wantv = .true.
|
||||
|
||||
! REDUCE X TO BIDIAGONAL FORM, STORING THE DIAGONAL ELEMENTS
|
||||
! IN S AND THE SUPER-DIAGONAL ELEMENTS IN E.
|
||||
|
||||
info = 0
|
||||
nct = MIN(n-1, p)
|
||||
s(1:nct+1) = 0.0_dp
|
||||
nrt = MAX(0, MIN(p-2,n))
|
||||
lu = MAX(nct,nrt)
|
||||
IF (lu < 1) GO TO 170
|
||||
DO l = 1, lu
|
||||
lp1 = l + 1
|
||||
IF (l > nct) GO TO 20
|
||||
|
||||
! COMPUTE THE TRANSFORMATION FOR THE L-TH COLUMN AND
|
||||
! PLACE THE L-TH DIAGONAL IN S(L).
|
||||
|
||||
s(l) = SQRT( SUM( x(l:n,l)**2 ) )
|
||||
IF (s(l) == 0.0D0) GO TO 10
|
||||
IF (x(l,l) /= 0.0D0) s(l) = SIGN(s(l), x(l,l))
|
||||
x(l:n,l) = x(l:n,l) / s(l)
|
||||
x(l,l) = 1.0D0 + x(l,l)
|
||||
|
||||
10 s(l) = -s(l)
|
||||
|
||||
20 IF (p < lp1) GO TO 50
|
||||
DO j = lp1, p
|
||||
IF (l > nct) GO TO 30
|
||||
IF (s(l) == 0.0D0) GO TO 30
|
||||
|
||||
! APPLY THE TRANSFORMATION.
|
||||
|
||||
t = -DOT_PRODUCT(x(l:n,l), x(l:n,j)) / x(l,l)
|
||||
x(l:n,j) = x(l:n,j) + t * x(l:n,l)
|
||||
|
||||
! PLACE THE L-TH ROW OF X INTO E FOR THE
|
||||
! SUBSEQUENT CALCULATION OF THE ROW TRANSFORMATION.
|
||||
|
||||
30 e(j) = x(l,j)
|
||||
END DO
|
||||
|
||||
50 IF (.NOT.wantu .OR. l > nct) GO TO 70
|
||||
|
||||
! PLACE THE TRANSFORMATION IN U FOR SUBSEQUENT BACK MULTIPLICATION.
|
||||
|
||||
u(l:n,l) = x(l:n,l)
|
||||
|
||||
70 IF (l > nrt) CYCLE
|
||||
|
||||
! COMPUTE THE L-TH ROW TRANSFORMATION AND PLACE THE
|
||||
! L-TH SUPER-DIAGONAL IN E(L).
|
||||
|
||||
e(l) = SQRT( SUM( e(lp1:p)**2 ) )
|
||||
IF (e(l) == 0.0D0) GO TO 80
|
||||
IF (e(lp1) /= 0.0D0) e(l) = SIGN(e(l), e(lp1))
|
||||
e(lp1:lp1+p-l-1) = e(lp1:p) / e(l)
|
||||
e(lp1) = 1.0D0 + e(lp1)
|
||||
|
||||
80 e(l) = -e(l)
|
||||
IF (lp1 > n .OR. e(l) == 0.0D0) GO TO 120
|
||||
|
||||
! APPLY THE TRANSFORMATION.
|
||||
|
||||
work(lp1:n) = 0.0D0
|
||||
DO j = lp1, p
|
||||
work(lp1:lp1+n-l-1) = work(lp1:lp1+n-l-1) + e(j) *
|
||||
& x(lp1:lp1+n-l-1,j)
|
||||
END DO
|
||||
DO j = lp1, p
|
||||
x(lp1:lp1+n-l-1,j) = x(lp1:lp1+n-l-1,j) - (e(j)/e(lp1)) *
|
||||
& work(lp1:lp1+n-l-1)
|
||||
END DO
|
||||
|
||||
120 IF (.NOT.wantv) CYCLE
|
||||
|
||||
! PLACE THE TRANSFORMATION IN V FOR SUBSEQUENT
|
||||
! BACK MULTIPLICATION.
|
||||
|
||||
v(lp1:p,l) = e(lp1:p)
|
||||
END DO
|
||||
|
||||
! SET UP THE FINAL BIDIAGONAL MATRIX OF ORDER M.
|
||||
|
||||
170 m = MIN(p,n+1)
|
||||
nctp1 = nct + 1
|
||||
nrtp1 = nrt + 1
|
||||
IF (nct < p) s(nctp1) = x(nctp1,nctp1)
|
||||
IF (n < m) s(m) = 0.0D0
|
||||
IF (nrtp1 < m) e(nrtp1) = x(nrtp1,m)
|
||||
e(m) = 0.0D0
|
||||
|
||||
! IF REQUIRED, GENERATE U.
|
||||
|
||||
IF (.NOT.wantu) GO TO 300
|
||||
IF (ncu < nctp1) GO TO 200
|
||||
DO j = nctp1, ncu
|
||||
u(1:n,j) = 0.0_dp
|
||||
u(j,j) = 1.0_dp
|
||||
END DO
|
||||
|
||||
200 DO ll = 1, nct
|
||||
l = nct - ll + 1
|
||||
IF (s(l) == 0.0D0) GO TO 250
|
||||
lp1 = l + 1
|
||||
IF (ncu < lp1) GO TO 220
|
||||
DO j = lp1, ncu
|
||||
t = -DOT_PRODUCT(u(l:n,l), u(l:n,j)) / u(l,l)
|
||||
u(l:n,j) = u(l:n,j) + t * u(l:n,l)
|
||||
END DO
|
||||
|
||||
220 u(l:n,l) = -u(l:n,l)
|
||||
u(l,l) = 1.0D0 + u(l,l)
|
||||
lm1 = l - 1
|
||||
IF (lm1 < 1) CYCLE
|
||||
u(1:lm1,l) = 0.0_dp
|
||||
CYCLE
|
||||
|
||||
250 u(1:n,l) = 0.0_dp
|
||||
u(l,l) = 1.0_dp
|
||||
END DO
|
||||
|
||||
! IF IT IS REQUIRED, GENERATE V.
|
||||
|
||||
300 IF (.NOT.wantv) GO TO 350
|
||||
DO ll = 1, p
|
||||
l = p - ll + 1
|
||||
lp1 = l + 1
|
||||
IF (l > nrt) GO TO 320
|
||||
IF (e(l) == 0.0D0) GO TO 320
|
||||
DO j = lp1, p
|
||||
t = -DOT_PRODUCT(v(lp1:lp1+p-l-1,l),
|
||||
& v(lp1:lp1+p-l-1,j)) / v(lp1,l)
|
||||
v(lp1:lp1+p-l-1,j) = v(lp1:lp1+p-l-1,j) + t * v(lp1:lp1+p-l-1,l)
|
||||
END DO
|
||||
|
||||
320 v(1:p,l) = 0.0D0
|
||||
v(l,l) = 1.0D0
|
||||
END DO
|
||||
|
||||
! MAIN ITERATION LOOP FOR THE SINGULAR VALUES.
|
||||
|
||||
350 mm = m
|
||||
iter = 0
|
||||
|
||||
! QUIT IF ALL THE SINGULAR VALUES HAVE BEEN FOUND.
|
||||
|
||||
! ...EXIT
|
||||
360 IF (m == 0) GO TO 620
|
||||
|
||||
! IF TOO MANY ITERATIONS HAVE BEEN PERFORMED, SET FLAG AND RETURN.
|
||||
|
||||
IF (iter < maxit) GO TO 370
|
||||
info = m
|
||||
! ......EXIT
|
||||
GO TO 620
|
||||
|
||||
! THIS SECTION OF THE PROGRAM INSPECTS FOR NEGLIGIBLE ELEMENTS
|
||||
! IN THE S AND E ARRAYS. ON COMPLETION
|
||||
! THE VARIABLES KASE AND L ARE SET AS FOLLOWS.
|
||||
!
|
||||
! KASE = 1 IF S(M) AND E(L-1) ARE NEGLIGIBLE AND L < M
|
||||
! KASE = 2 IF S(L) IS NEGLIGIBLE AND L < M
|
||||
! KASE = 3 IF E(L-1) IS NEGLIGIBLE, L < M, AND
|
||||
! S(L), ..., S(M) ARE NOT NEGLIGIBLE (QR STEP).
|
||||
! KASE = 4 IF E(M-1) IS NEGLIGIBLE (CONVERGENCE).
|
||||
|
||||
370 DO ll = 1, m
|
||||
l = m - ll
|
||||
! ...EXIT
|
||||
IF (l == 0) EXIT
|
||||
test = ABS(s(l)) + ABS(s(l+1))
|
||||
ztest = test + ABS(e(l))
|
||||
IF (ztest /= test) CYCLE
|
||||
e(l) = 0.0D0
|
||||
! ......EXIT
|
||||
EXIT
|
||||
END DO
|
||||
|
||||
IF (l /= m - 1) GO TO 410
|
||||
kase = 4
|
||||
GO TO 480
|
||||
|
||||
410 lp1 = l + 1
|
||||
mp1 = m + 1
|
||||
DO lls = lp1, mp1
|
||||
ls = m - lls + lp1
|
||||
! ...EXIT
|
||||
IF (ls == l) EXIT
|
||||
test = 0.0D0
|
||||
IF (ls /= m) test = test + ABS(e(ls))
|
||||
IF (ls /= l + 1) test = test + ABS(e(ls-1))
|
||||
ztest = test + ABS(s(ls))
|
||||
IF (ztest /= test) CYCLE
|
||||
s(ls) = 0.0D0
|
||||
! ......EXIT
|
||||
EXIT
|
||||
END DO
|
||||
|
||||
IF (ls /= l) GO TO 450
|
||||
kase = 3
|
||||
GO TO 480
|
||||
|
||||
450 IF (ls /= m) GO TO 460
|
||||
kase = 1
|
||||
GO TO 480
|
||||
|
||||
460 kase = 2
|
||||
l = ls
|
||||
480 l = l + 1
|
||||
|
||||
! PERFORM THE TASK INDICATED BY KASE.
|
||||
|
||||
SELECT CASE ( kase )
|
||||
CASE ( 1)
|
||||
GO TO 490
|
||||
CASE ( 2)
|
||||
GO TO 520
|
||||
CASE ( 3)
|
||||
GO TO 540
|
||||
CASE ( 4)
|
||||
GO TO 570
|
||||
END SELECT
|
||||
|
||||
! DEFLATE NEGLIGIBLE S(M).
|
||||
|
||||
490 mm1 = m - 1
|
||||
f = e(m-1)
|
||||
e(m-1) = 0.0D0
|
||||
DO kk = l, mm1
|
||||
k = mm1 - kk + l
|
||||
t1 = s(k)
|
||||
CALL drotg(t1, f, cs, sn)
|
||||
s(k) = t1
|
||||
IF (k == l) GO TO 500
|
||||
f = -sn*e(k-1)
|
||||
e(k-1) = cs*e(k-1)
|
||||
|
||||
500 IF (wantv) CALL drot1(p, v(1:,k), v(1:,m), cs, sn)
|
||||
END DO
|
||||
GO TO 610
|
||||
|
||||
! SPLIT AT NEGLIGIBLE S(L).
|
||||
|
||||
520 f = e(l-1)
|
||||
e(l-1) = 0.0D0
|
||||
DO k = l, m
|
||||
t1 = s(k)
|
||||
CALL drotg(t1, f, cs, sn)
|
||||
s(k) = t1
|
||||
f = -sn*e(k)
|
||||
e(k) = cs*e(k)
|
||||
IF (wantu) CALL drot1(n, u(1:,k), u(1:,l-1), cs, sn)
|
||||
END DO
|
||||
GO TO 610
|
||||
|
||||
! PERFORM ONE QR STEP.
|
||||
!
|
||||
! CALCULATE THE SHIFT.
|
||||
|
||||
540 scale = MAX(ABS(s(m)),ABS(s(m-1)),ABS(e(m-1)),ABS(s(l)),ABS(e(l)))
|
||||
sm = s(m)/scale
|
||||
smm1 = s(m-1)/scale
|
||||
emm1 = e(m-1)/scale
|
||||
sl = s(l)/scale
|
||||
el = e(l)/scale
|
||||
b = ((smm1 + sm)*(smm1 - sm) + emm1**2)/2.0D0
|
||||
c = (sm*emm1)**2
|
||||
shift = 0.0D0
|
||||
IF (b == 0.0D0 .AND. c == 0.0D0) GO TO 550
|
||||
shift = SQRT(b**2+c)
|
||||
IF (b < 0.0D0) shift = -shift
|
||||
shift = c/(b + shift)
|
||||
|
||||
550 f = (sl + sm)*(sl - sm) - shift
|
||||
g = sl*el
|
||||
|
||||
! CHASE ZEROS.
|
||||
|
||||
mm1 = m - 1
|
||||
DO k = l, mm1
|
||||
CALL drotg(f, g, cs, sn)
|
||||
IF (k /= l) e(k-1) = f
|
||||
f = cs*s(k) + sn*e(k)
|
||||
e(k) = cs*e(k) - sn*s(k)
|
||||
g = sn*s(k+1)
|
||||
s(k+1) = cs*s(k+1)
|
||||
IF (wantv) CALL drot1(p, v(1:,k), v(1:,k+1), cs, sn)
|
||||
CALL drotg(f, g, cs, sn)
|
||||
s(k) = f
|
||||
f = cs*e(k) + sn*s(k+1)
|
||||
s(k+1) = -sn*e(k) + cs*s(k+1)
|
||||
g = sn*e(k+1)
|
||||
e(k+1) = cs*e(k+1)
|
||||
IF (wantu .AND. k < n) CALL drot1(n, u(1:,k), u(1:,k+1), cs, sn)
|
||||
END DO
|
||||
e(m-1) = f
|
||||
iter = iter + 1
|
||||
GO TO 610
|
||||
|
||||
! CONVERGENCE.
|
||||
|
||||
! MAKE THE SINGULAR VALUE POSITIVE.
|
||||
|
||||
570 IF (s(l) >= 0.0D0) GO TO 590
|
||||
s(l) = -s(l)
|
||||
IF (wantv) v(1:p,l) = -v(1:p,l)
|
||||
|
||||
! ORDER THE SINGULAR VALUE.
|
||||
|
||||
590 IF (l == mm) GO TO 600
|
||||
! ...EXIT
|
||||
IF (s(l) >= s(l+1)) GO TO 600
|
||||
t = s(l)
|
||||
s(l) = s(l+1)
|
||||
s(l+1) = t
|
||||
IF (wantv .AND. l < p) CALL dswap1(p, v(1:,l), v(1:,l+1))
|
||||
IF (wantu .AND. l < n) CALL dswap1(n, u(1:,l), u(1:,l+1))
|
||||
l = l + 1
|
||||
GO TO 590
|
||||
|
||||
600 iter = 0
|
||||
m = m - 1
|
||||
|
||||
610 GO TO 360
|
||||
|
||||
620 RETURN
|
||||
END SUBROUTINE dsvdc
|
||||
|
||||
END MODULE SVD
|
||||
@ -1,189 +0,0 @@
|
||||
MODULE INTFCMOD
|
||||
IMPLICIT NONE
|
||||
PUBLIC :: INITLEVELS, TRANSF, COVG
|
||||
|
||||
CONTAINS
|
||||
SUBROUTINE INITLEVELS(T,HT,N,NU,Nv)
|
||||
USE TBRMOD
|
||||
USE SIZEMOD
|
||||
IMPLICIT NONE
|
||||
C INTEGER, PARAMETER:: NMAX = 101, RDIM = 10201
|
||||
C DIMENSION ULEVELS(1),Vlevels(1),T(1),HT(1),TG(1),XG(1),HH(101)
|
||||
REAL*8, DIMENSION(:), intent(in) :: T
|
||||
REAL*8, DIMENSION(:), intent(out) :: HT
|
||||
C INTEGER, intent(in) :: NG
|
||||
REAL*8 :: UMIN,UMAX,VMIN,VMAX, HU,HV
|
||||
integer :: N, I, NU, NV
|
||||
C REAL*8, DIMENSION(NMAX) :: HH
|
||||
C COMMON/TBR/HH
|
||||
|
||||
C IF (NG.GT.501) THEN
|
||||
C PRINT *,'Vector defining transformation of data > 501, stop'
|
||||
C STOP
|
||||
C END IF
|
||||
|
||||
|
||||
IF(N.ge.NMAX) then
|
||||
print *,'The number of wavelength points >',NMAX-1, ' stop'
|
||||
stop
|
||||
end if
|
||||
IF(N.lt.2) then
|
||||
print *,'The number of wavelength points < 2, stop'
|
||||
stop
|
||||
end if
|
||||
|
||||
HT(1)=0.5d0*(T(2)-T(1))
|
||||
HT(N)=0.5d0*(T(N)-T(N-1))
|
||||
HH(1)=-100.0d0
|
||||
HH(N)=-100.0d0
|
||||
DO I=2,N-1
|
||||
HT(I)=0.5d0*(T(I+1)-T(I-1))
|
||||
HH(I)=-100.0d0
|
||||
c10 CONTINUE
|
||||
enddo
|
||||
|
||||
|
||||
IF(NU.gt.NMAX) then
|
||||
print *,'The number of maxima >',NMAX,' stop'
|
||||
stop
|
||||
end if
|
||||
IF(NV.gt.NMAX) then
|
||||
print *,'The number of minima >',NMAX,' stop'
|
||||
stop
|
||||
end if
|
||||
|
||||
IF(NU.LT.1) Then
|
||||
print *,'The number of maxima < 1, stop'
|
||||
stop
|
||||
end if
|
||||
IF(NV.LT.1) Then
|
||||
print *,'The number of minima < 1, stop'
|
||||
stop
|
||||
end if
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE INITLEVELS
|
||||
|
||||
|
||||
SUBROUTINE TRANSF(N,T,A,TIMEV,VALUE,DER)
|
||||
C
|
||||
C N number of data points
|
||||
C TIMEV vector of time points
|
||||
C A a vector of values of a function G(TIME)
|
||||
C T independent time point
|
||||
C VALUE is a value of a function at T, i.e. VALUE=G(T).
|
||||
c DER=G'(t)
|
||||
C
|
||||
USE SIZEMOD
|
||||
IMPLICIT NONE
|
||||
REAL*8, intent(inout):: VALUE, DER,T
|
||||
C INTEGER, PARAMETER :: RDIM = 10201
|
||||
REAL*8, DIMENSION(:), intent(in) :: A,TIMEV
|
||||
integer, intent(in) :: N
|
||||
REAL*8:: T1
|
||||
integer :: I
|
||||
|
||||
IF (T.LT.TIMEV(1)) then
|
||||
der=(A(2)-A(1))/(TIMEV(2)-TIMEV(1))
|
||||
T1=T-TIMEV(1)
|
||||
VALUE=A(1)+T1*DER
|
||||
return
|
||||
end if
|
||||
IF (T.GT.TIMEV(N)) then
|
||||
der = (A(N)-A(N-1))/(TIMEV(N)-TIMEV(N-1))
|
||||
T1 = T-TIMEV(N)
|
||||
VALUE=A(N)+T1*DER
|
||||
return
|
||||
end if
|
||||
DO I=2,N
|
||||
IF (T.LT.TIMEV(I)) GO TO 10
|
||||
ENDDO
|
||||
10 I=I-1
|
||||
T1=T-TIMEV(I)
|
||||
DER=(A(I+1)-A(I))/(TIMEV(i+1)-TIMEV(I))
|
||||
VALUE=A(I)+T1*DER
|
||||
RETURN
|
||||
END SUBROUTINE TRANSF
|
||||
|
||||
REAL*8 FUNCTION SPLE(N,T,A,TIMEV)
|
||||
C
|
||||
C N number of data points
|
||||
C TIME vector of time points
|
||||
C A a vector of values of a function G(TIME)
|
||||
C T independent time point
|
||||
C SPLE is a value of a function at T, i.e. SPLE=G(T).
|
||||
C
|
||||
USE SIZEMOD
|
||||
IMPLICIT NONE
|
||||
INTEGER, INTENT(IN):: N
|
||||
|
||||
REAL*8, INTENT(IN) :: T
|
||||
REAL*8, DIMENSION(:), INTENT(IN) :: A,TIMEV
|
||||
REAL*8 :: T1
|
||||
INTEGER :: I
|
||||
SPLE=-9.9d0
|
||||
IF (T.LT.TIMEV(1) .OR. T.GT.TIMEV(N)) RETURN
|
||||
DO I=2,N
|
||||
IF (T.LT.TIMEV(I)) GO TO 10
|
||||
ENDDO
|
||||
10 I=I-1
|
||||
T1=T-TIMEV(I)
|
||||
SPLE=A(I)+T1*(A(I+1)-A(I))/(TIMEV(i+1)-TIMEV(I))
|
||||
RETURN
|
||||
END FUNCTION SPLE
|
||||
|
||||
SUBROUTINE COVG(XL0,XL2,XL4,COV1,COV2,COV3,COV,T,N)
|
||||
C
|
||||
C Covariance function and its four derivatives for a vector T of length N
|
||||
C is assumed in a vector COV; COV(1,...,N,1)=r(T), COV(1,...,N, 2)=r'(T), etc.
|
||||
C The vector COV should be of the shape N x 5.
|
||||
C
|
||||
C COVG Returns:
|
||||
C XL0,XL2,XL4 - spectral moments.
|
||||
C
|
||||
C Covariance matrices COV1=r'(T-T), COV2=r''(T-T) and COV3=r'''(T-T)
|
||||
C Dimension of COV1, COV2 should be atleast N*N.
|
||||
C
|
||||
USE SIZEMOD
|
||||
! IMPLICIT NONE
|
||||
C INTEGER, PARAMETER:: NMAX = 101, RDIM = 10201
|
||||
REAL*8, PARAMETER:: ZERO = 0.0d0
|
||||
REAL*8, intent(inout) :: XL0,XL2,XL4
|
||||
REAL*8, DIMENSION(N,5), intent(in) :: COV
|
||||
REAL*8, DIMENSION(N), intent(in) :: T
|
||||
REAL*8, DIMENSION(RDIM), intent(inout) :: COV1,COV2,COV3
|
||||
INTEGER, intent(in) :: N
|
||||
integer :: I, J, II
|
||||
REAL*8 :: TT, T0
|
||||
C
|
||||
C COV(Y(T),Y(0)) = COV(:,1)
|
||||
C DERIVATIVE COV(Y(T),Y(0)) = COV(:,2)
|
||||
C 2-DERIVATIVE COV(Y(T),Y(0)) = COV(:,3)
|
||||
C 3-DERIVATIVE COV(Y(T),Y(0)) = COV(:,4)
|
||||
C 4-DERIVATIVE COV(Y(T),Y(0)) = COV(:,5)
|
||||
|
||||
XL0 = COV(1,1)
|
||||
XL2 = -COV(1,3)
|
||||
XL4 = COV(1,5)
|
||||
! XL0 = SPLE(NT, ZERO, COV(:,1), T)
|
||||
! XL2 = -SPLE(NT, ZERO, COV(:,3), T)
|
||||
! XL4 = SPLE(NT, ZERO, COV(:,5), T)
|
||||
|
||||
II=0
|
||||
DO I=1,N
|
||||
DO J=1,N
|
||||
II = II+1
|
||||
T0 = T(J)-T(I)
|
||||
TT = ABS(T0)
|
||||
COV1(II) = SPLE(N, TT, COV(:,2), T)
|
||||
COV2(II) = SPLE(N, TT, COV(:,3), T)
|
||||
COV3(II) = SPLE(N, TT, COV(:,4), T)
|
||||
IF (T0.LT.0.0d0) then
|
||||
COV1(II)=-COV1(II)
|
||||
COV3(II)=-COV3(II)
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
RETURN
|
||||
END SUBROUTINE COVG
|
||||
END module intfcmod
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,20 +0,0 @@
|
||||
"""
|
||||
builds mvn.pyd
|
||||
"""
|
||||
import os
|
||||
import sys
|
||||
|
||||
|
||||
from wafo.f2py_tools import f2py_call_str
|
||||
|
||||
def compile_all():
|
||||
f2py_call = f2py_call_str()
|
||||
print '=' * 75
|
||||
print 'compiling mvn'
|
||||
print '=' * 75
|
||||
|
||||
os.system(f2py_call + ' mvn.pyf mvndst.f -c ')
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
compile_all()
|
||||
@ -1,39 +0,0 @@
|
||||
! -*- f90 -*-
|
||||
! Note: the context of this file is case sensitive.
|
||||
|
||||
python module mvn ! in
|
||||
interface ! in :mvn
|
||||
subroutine mvnun(d,n,lower,upper,means,covar,maxpts,abseps,releps,value,inform) ! in :mvn:mvndst.f
|
||||
integer intent(hide) :: d=shape(means,0)
|
||||
integer intent(hide) :: n=shape(means,1)
|
||||
double precision dimension(d) :: lower
|
||||
double precision dimension(d) :: upper
|
||||
double precision dimension(d,n) :: means
|
||||
double precision dimension(d,d) :: covar
|
||||
integer intent(optional) :: maxpts=d*1000
|
||||
double precision intent(optional) :: abseps=1e-6
|
||||
double precision intent(optional) :: releps=1e-6
|
||||
double precision intent(out) :: value
|
||||
integer intent(out) :: inform
|
||||
end subroutine mvnun
|
||||
|
||||
subroutine mvndst(n,lower,upper,infin,correl,maxpts,abseps,releps,error,value,inform) ! in :mvn:mvndst.f
|
||||
integer intent(hide) :: n=len(lower)
|
||||
double precision dimension(n) :: lower
|
||||
double precision dimension(n) :: upper
|
||||
integer dimension(n) :: infin
|
||||
double precision dimension(n*(n-1)/2) :: correl
|
||||
integer intent(optional) :: maxpts=2000
|
||||
double precision intent(optional) :: abseps=1e-6
|
||||
double precision intent(optional) :: releps=1e-6
|
||||
double precision intent(out) :: error
|
||||
double precision intent(out) :: value
|
||||
integer intent(out) :: inform
|
||||
integer :: ivls
|
||||
common /dkblck/ ivls
|
||||
end subroutine mvndst
|
||||
end interface
|
||||
end python module mvn
|
||||
|
||||
! This file was auto-generated with f2py (version:2.39.235_1752).
|
||||
! See http://cens.ioc.ee/projects/f2py2e/
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,25 +0,0 @@
|
||||
"""builds mvnprdmod.pyd."""
|
||||
import os
|
||||
import sys
|
||||
from wafo.f2py_tools import f2py_call_str
|
||||
|
||||
|
||||
def compile_all():
|
||||
f2py_call = f2py_call_str()
|
||||
print '=' * 75
|
||||
print 'compiling mvnprd'
|
||||
print '=' * 75
|
||||
|
||||
files = ['mvnprd', 'mvnprodcorrprb']
|
||||
compile1_format = 'gfortran -fPIC -c %s.f'
|
||||
for file_ in files:
|
||||
os.system(compile1_format % file_)
|
||||
file_objects = '%s.o %s.o' % tuple(files)
|
||||
|
||||
# os.system('f2py.py -m mvnprdmod -c %s mvnprd_interface.f
|
||||
# --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71' % file_objects)
|
||||
os.system(f2py_call + ' -m mvnprdmod -c %s mvnprd_interface.f ' %
|
||||
file_objects)
|
||||
|
||||
if __name__ == '__main__':
|
||||
compile_all()
|
||||
@ -1,93 +0,0 @@
|
||||
# Microsoft Developer Studio Project File - Name="mvnprd" - Package Owner=<4>
|
||||
# Microsoft Developer Studio Generated Build File, Format Version 6.00
|
||||
# ** DO NOT EDIT **
|
||||
|
||||
# TARGTYPE "Win32 (x86) Console Application" 0x0103
|
||||
|
||||
CFG=mvnprd - Win32 Debug
|
||||
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
|
||||
!MESSAGE use the Export Makefile command and run
|
||||
!MESSAGE
|
||||
!MESSAGE NMAKE /f "mvnprd.mak".
|
||||
!MESSAGE
|
||||
!MESSAGE You can specify a configuration when running NMAKE
|
||||
!MESSAGE by defining the macro CFG on the command line. For example:
|
||||
!MESSAGE
|
||||
!MESSAGE NMAKE /f "mvnprd.mak" CFG="mvnprd - Win32 Debug"
|
||||
!MESSAGE
|
||||
!MESSAGE Possible choices for configuration are:
|
||||
!MESSAGE
|
||||
!MESSAGE "mvnprd - Win32 Release" (based on "Win32 (x86) Console Application")
|
||||
!MESSAGE "mvnprd - Win32 Debug" (based on "Win32 (x86) Console Application")
|
||||
!MESSAGE
|
||||
|
||||
# Begin Project
|
||||
# PROP AllowPerConfigDependencies 0
|
||||
# PROP Scc_ProjName ""
|
||||
# PROP Scc_LocalPath ""
|
||||
CPP=cl.exe
|
||||
F90=df.exe
|
||||
RSC=rc.exe
|
||||
|
||||
!IF "$(CFG)" == "mvnprd - Win32 Release"
|
||||
|
||||
# PROP BASE Use_MFC 0
|
||||
# PROP BASE Use_Debug_Libraries 0
|
||||
# PROP BASE Output_Dir "Release"
|
||||
# PROP BASE Intermediate_Dir "Release"
|
||||
# PROP BASE Target_Dir ""
|
||||
# PROP Use_MFC 0
|
||||
# PROP Use_Debug_Libraries 0
|
||||
# PROP Output_Dir "Release"
|
||||
# PROP Intermediate_Dir "Release"
|
||||
# PROP Target_Dir ""
|
||||
# ADD BASE F90 /compile_only /nologo /warn:nofileopt
|
||||
# ADD F90 /compile_only /nologo /warn:nofileopt
|
||||
# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
|
||||
# ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
|
||||
# ADD BASE RSC /l 0x414 /d "NDEBUG"
|
||||
# ADD RSC /l 0x414 /d "NDEBUG"
|
||||
BSC32=bscmake.exe
|
||||
# ADD BASE BSC32 /nologo
|
||||
# ADD BSC32 /nologo
|
||||
LINK32=link.exe
|
||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
||||
|
||||
!ELSEIF "$(CFG)" == "mvnprd - Win32 Debug"
|
||||
|
||||
# PROP BASE Use_MFC 0
|
||||
# PROP BASE Use_Debug_Libraries 1
|
||||
# PROP BASE Output_Dir "Debug"
|
||||
# PROP BASE Intermediate_Dir "Debug"
|
||||
# PROP BASE Target_Dir ""
|
||||
# PROP Use_MFC 0
|
||||
# PROP Use_Debug_Libraries 1
|
||||
# PROP Output_Dir "Debug"
|
||||
# PROP Intermediate_Dir "Debug"
|
||||
# PROP Target_Dir ""
|
||||
# ADD BASE F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
|
||||
# ADD F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
|
||||
# ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
|
||||
# ADD CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
|
||||
# ADD BASE RSC /l 0x414 /d "_DEBUG"
|
||||
# ADD RSC /l 0x414 /d "_DEBUG"
|
||||
BSC32=bscmake.exe
|
||||
# ADD BASE BSC32 /nologo
|
||||
# ADD BSC32 /nologo
|
||||
LINK32=link.exe
|
||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
|
||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
|
||||
|
||||
!ENDIF
|
||||
|
||||
# Begin Target
|
||||
|
||||
# Name "mvnprd - Win32 Release"
|
||||
# Name "mvnprd - Win32 Debug"
|
||||
# Begin Source File
|
||||
|
||||
SOURCE=.\mvnprd.f
|
||||
# End Source File
|
||||
# End Target
|
||||
# End Project
|
||||
@ -1,29 +0,0 @@
|
||||
Microsoft Developer Studio Workspace File, Format Version 6.00
|
||||
# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
|
||||
|
||||
###############################################################################
|
||||
|
||||
Project: "mvnprd"=.\mvnprd.dsp - Package Owner=<4>
|
||||
|
||||
Package=<5>
|
||||
{{{
|
||||
}}}
|
||||
|
||||
Package=<4>
|
||||
{{{
|
||||
}}}
|
||||
|
||||
###############################################################################
|
||||
|
||||
Global:
|
||||
|
||||
Package=<5>
|
||||
{{{
|
||||
}}}
|
||||
|
||||
Package=<3>
|
||||
{{{
|
||||
}}}
|
||||
|
||||
###############################################################################
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,23 +0,0 @@
|
||||
! -*- f90 -*-
|
||||
! Note: the context of this file is case sensitive.
|
||||
|
||||
python module mvnprd ! in
|
||||
interface ! in :mvnprd
|
||||
subroutine mvnprd(a,b,bpd,eps,n,inf,ierc,hinc,prob,bound,ifault) ! in :mvnprd:mvnprd.f
|
||||
double precision dimension(*) :: a
|
||||
double precision dimension(*) :: b
|
||||
double precision dimension(*) :: bpd
|
||||
double precision :: eps
|
||||
integer :: n
|
||||
integer dimension(*) :: inf
|
||||
integer :: ierc
|
||||
double precision :: hinc
|
||||
double precision :: prob
|
||||
double precision :: bound
|
||||
integer :: ifault
|
||||
end subroutine mvnprd
|
||||
end interface
|
||||
end python module mvnprd
|
||||
|
||||
! This file was auto-generated with f2py (version:2_5972).
|
||||
! See http://cens.ioc.ee/projects/f2py2e/
|
||||
@ -1,88 +0,0 @@
|
||||
|
||||
subroutine prbnormtndpc(rho,a,b,NDF,N,abseps,IERC,HNC,PRB,BOUND,
|
||||
* IFAULT)
|
||||
double precision A(N),B(N),rho(N),D(N)
|
||||
integer INFIN(N)
|
||||
integer NDF,N,IERC
|
||||
integer IFAULT
|
||||
double precision HNC
|
||||
C double precision EPS
|
||||
double precision PRB, BOUND
|
||||
double precision, parameter :: infinity = 37.0d0
|
||||
Cf2py integer, intent(hide), depend(rho) :: N = len(rho)
|
||||
Cf2py depend(N) a
|
||||
Cf2py depend(N) b
|
||||
Cf2py integer, optional :: NDF = 0
|
||||
Cf2py double precision, optional :: abseps = 0.001
|
||||
Cf2py double precision, optional :: HNC = 0.24
|
||||
Cf2py integer, optional :: IERC =0
|
||||
Cf2py double precision, intent(out) :: PRB
|
||||
Cf2py double precision, intent(out) :: BOUND
|
||||
Cf2py integer, intent(out) :: IFAULT
|
||||
|
||||
CCf2py intent(in) N,IERC
|
||||
CCf2py intent(in) HINC,EPS
|
||||
CCf2py intent(in) INF
|
||||
CCf2py intent(in) A,B,rho
|
||||
|
||||
|
||||
|
||||
* Set INFIN INTEGER, array of integration limits flags:
|
||||
* if INFIN(I) < 0, Ith limits are (-infinity, infinity);
|
||||
* if INFIN(I) = 0, Ith limits are [LOWER(I), infinity);
|
||||
* if INFIN(I) = 1, Ith limits are (-infinity, UPPER(I)];
|
||||
* if INFIN(I) = 2, Ith limits are [LOWER(I), UPPER(I)].
|
||||
Ndim = 0
|
||||
DO K = 1,N
|
||||
Ndim = Ndim + 1
|
||||
INFIN(Ndim) = 2
|
||||
D(k) = 0.0
|
||||
if (A(K)-D(K).LE.-INFINITY) THEN
|
||||
if (B(K)-D(K) .GE. INFINITY) THEN
|
||||
Ndim = Ndim - 1
|
||||
!INFIN(K) = -1
|
||||
else
|
||||
INFIN(Ndim) = 1
|
||||
endif
|
||||
else if (B(K)-D(K).GE.INFINITY) THEN
|
||||
INFIN(Ndim) = 0
|
||||
endif
|
||||
if (ndim<k) then
|
||||
RHO(Ndim) = RHO(k)
|
||||
A(Ndim) = A(K)
|
||||
B(Ndim) = B(K)
|
||||
C D(Ndim) = D(K)
|
||||
endif
|
||||
ENDDO
|
||||
CALL MVSTUD(NDF,B,A,RHO,ABSEPS,Ndim,INFIN,D,IERC,HNC,
|
||||
& PRB,BOUND,IFAULT)
|
||||
|
||||
C CALL MVNPRD(A, B, BPD, EPS, N, INF, IERC, HINC, PROB, BOUND,
|
||||
C * IFAULT)
|
||||
return
|
||||
end subroutine prbnormtndpc
|
||||
|
||||
subroutine prbnormndpc(prb,abserr,IFT,rho,a,b,N,abseps,releps,
|
||||
& useBreakPoints, useSimpson)
|
||||
use mvnProdCorrPrbMod, ONLY : mvnprodcorrprb
|
||||
integer :: N
|
||||
double precision,dimension(N),intent(in) :: rho,a,b
|
||||
double precision,intent(in) :: abseps
|
||||
double precision,intent(in) :: releps
|
||||
logical, intent(in) :: useBreakPoints
|
||||
logical, intent(in) :: useSimpson
|
||||
double precision,intent(out) :: abserr,prb
|
||||
integer, intent(out) :: IFT
|
||||
|
||||
Cf2py integer, intent(hide), depend(rho) :: N = len(rho)
|
||||
Cf2py depend(N) a
|
||||
Cf2py depend(N) b
|
||||
Cf2py double precision, optional :: abseps = 0.001
|
||||
Cf2py double precision, optional :: releps = 0.001
|
||||
Cf2py logical, optional :: useBreakPoints =1
|
||||
Cf2py logical, optional :: useSimpson = 1
|
||||
|
||||
CALL mvnprodcorrprb(rho,a,b,abseps,releps,useBreakPoints,
|
||||
& useSimpson,abserr,IFT,prb)
|
||||
|
||||
end subroutine prbnormndpc
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,33 +0,0 @@
|
||||
|
||||
C gfortran -fPIC -c mvnprodcorrprb.f
|
||||
C f2py -m mvnprdmod -c mvnprodcorrprb.o mvnprodcorrprb_interface.f --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71
|
||||
|
||||
C module mvnprdmod
|
||||
C contains
|
||||
subroutine prbnormndpc(prb,abserr,IFT,rho,a,b,N,abseps,releps,
|
||||
& useBreakPoints, useSimpson)
|
||||
use mvnProdCorrPrbMod, ONLY : mvnprodcorrprb
|
||||
integer :: N
|
||||
double precision,dimension(N),intent(in) :: rho,a,b
|
||||
double precision,intent(in) :: abseps
|
||||
double precision,intent(in) :: releps
|
||||
logical, intent(in) :: useBreakPoints
|
||||
logical, intent(in) :: useSimpson
|
||||
double precision,intent(out) :: abserr,prb
|
||||
integer, intent(out) :: IFT
|
||||
|
||||
Cf2py integer, intent(hide), depend(rho) :: N = len(rho)
|
||||
Cf2py depend(N) a
|
||||
Cf2py depend(N) b
|
||||
Cf2py double precision, optional :: abseps = 0.001
|
||||
Cf2py double precision, optional :: releps = 0.001
|
||||
Cf2py logical, optional :: useBreakPoints =1
|
||||
Cf2py logical, optional :: useSimpson = 1
|
||||
|
||||
|
||||
|
||||
CALL mvnprodcorrprb(rho,a,b,abseps,releps,useBreakPoints,
|
||||
& useSimpson,abserr,IFT,prb)
|
||||
|
||||
end subroutine prbnormndpc
|
||||
C end module mvnprdmod
|
||||
@ -1,24 +0,0 @@
|
||||
"""
|
||||
f2py c_library.pyf c_functions.c -c
|
||||
"""
|
||||
import os
|
||||
|
||||
def compile_all():
|
||||
|
||||
compile1_txt = 'gfortran -fPIC -c mvnprodcorrprb.f'
|
||||
compile2_txt = 'f2py -m mvnprdmod -c mvnprodcorrprb.o mvnprodcorrprb_interface.f --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71'
|
||||
os.system(compile1_txt)
|
||||
os.system(compile2_txt)
|
||||
# Install gfortran and run the following to build the module:
|
||||
#compile_format = 'f2py %s %s -c --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71'
|
||||
|
||||
# Install microsoft visual c++ .NET 2003 and run the following to build the module:
|
||||
#compile_format = 'f2py %s %s -c'
|
||||
#pyfs = ('c_library.pyf',)
|
||||
#files =('c_functions.c',)
|
||||
|
||||
#for pyf,file in zip(pyfs,files):
|
||||
# os.system(compile_format % (pyf,file))
|
||||
|
||||
if __name__=='__main__':
|
||||
compile_all()
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,33 +0,0 @@
|
||||
|
||||
C gfortran -fPIC -c mvnprodcorrprb.f
|
||||
C f2py -m mvnprdmod -c mvnprodcorrprb.o mvnprodcorrprb_interface.f --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71
|
||||
|
||||
C module mvnprdmod
|
||||
C contains
|
||||
subroutine prbnormndpc(prb,abserr,IFT,rho,a,b,N,abseps,releps,
|
||||
& useBreakPoints, useSimpson)
|
||||
use mvnProdCorrPrbMod, ONLY : mvnprodcorrprb
|
||||
integer :: N
|
||||
double precision,dimension(N),intent(in) :: rho,a,b
|
||||
double precision,intent(in) :: abseps
|
||||
double precision,intent(in) :: releps
|
||||
logical, intent(in) :: useBreakPoints
|
||||
logical, intent(in) :: useSimpson
|
||||
double precision,intent(out) :: abserr,prb
|
||||
integer, intent(out) :: IFT
|
||||
|
||||
Cf2py integer, intent(hide), depend(rho) :: N = len(rho)
|
||||
Cf2py depend(N) a
|
||||
Cf2py depend(N) b
|
||||
Cf2py double precision, optional :: abseps = 0.001
|
||||
Cf2py double precision, optional :: releps = 0.001
|
||||
Cf2py logical, optional :: useBreakPoints =1
|
||||
Cf2py logical, optional :: useSimpson = 1
|
||||
|
||||
|
||||
|
||||
CALL mvnprodcorrprb(rho,a,b,abseps,releps,useBreakPoints,
|
||||
& useSimpson,abserr,IFT,prb)
|
||||
|
||||
end subroutine prbnormndpc
|
||||
C end module mvnprdmod
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,157 +0,0 @@
|
||||
! -*- f90 -*-
|
||||
! Note: the context of this file is case sensitive.
|
||||
|
||||
python module dqk21__user__routines
|
||||
interface dqk21_user_interface
|
||||
function f(centr) result (fc) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:adaptivegausskronrod:dqk21:unknown_interface
|
||||
double precision :: centr
|
||||
double precision :: fc
|
||||
end function f
|
||||
end interface dqk21_user_interface
|
||||
end python module dqk21__user__routines
|
||||
python module dqk15__user__routines
|
||||
interface dqk15_user_interface
|
||||
function f(centr) result (fc) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:adaptivegausskronrod:dqk15:unknown_interface
|
||||
double precision :: centr
|
||||
double precision :: fc
|
||||
end function f
|
||||
end interface dqk15_user_interface
|
||||
end python module dqk15__user__routines
|
||||
python module dqk9__user__routines
|
||||
interface dqk9_user_interface
|
||||
function f(centr) result (fc) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:adaptivegausskronrod:dqk9:unknown_interface
|
||||
double precision :: centr
|
||||
double precision :: fc
|
||||
end function f
|
||||
end interface dqk9_user_interface
|
||||
end python module dqk9__user__routines
|
||||
python module dqkl9__user__routines
|
||||
interface dqkl9_user_interface
|
||||
function f(centr) result (fc) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:adaptivegausskronrod:dqkl9:unknown_interface
|
||||
double precision :: centr
|
||||
double precision :: fc
|
||||
end function f
|
||||
end interface dqkl9_user_interface
|
||||
end python module dqkl9__user__routines
|
||||
python module adaptivegausskronrod ! in
|
||||
interface ! in :adaptivegausskronrod
|
||||
module functioninterface ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90
|
||||
interface ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:functioninterface
|
||||
function f(z) result (val) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:functioninterface:unknown_interface
|
||||
double precision intent(in) :: z
|
||||
double precision :: val
|
||||
end function f
|
||||
end interface
|
||||
end module functioninterface
|
||||
module adaptivegausskronrod ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90
|
||||
subroutine dea3(e0,e1,e2,abserr,result1) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:adaptivegausskronrod
|
||||
double precision intent(in) :: e0
|
||||
double precision intent(in) :: e1
|
||||
double precision intent(in) :: e2
|
||||
double precision intent(out) :: abserr
|
||||
double precision intent(out) :: result1
|
||||
end subroutine dea3
|
||||
subroutine dqagp(f,a,b,npts,points,epsabs,epsrel,limit,result1,abserr,neval,ier) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:adaptivegausskronrod
|
||||
external f
|
||||
double precision intent(in) :: a
|
||||
double precision intent(in) :: b
|
||||
integer optional,intent(in),check(len(points)>=npts),depend(points) :: npts=len(points)
|
||||
double precision dimension(npts),intent(in) :: points
|
||||
double precision intent(in) :: epsabs
|
||||
double precision intent(in) :: epsrel
|
||||
integer intent(in) :: limit
|
||||
double precision intent(out) :: result1
|
||||
double precision intent(out) :: abserr
|
||||
integer intent(out) :: neval
|
||||
integer intent(out) :: ier
|
||||
end subroutine dqagp
|
||||
subroutine dqagpe(f,a,b,npts,points,epsabs,epsrel,limit,result1,abserr,neval,ier,alist,blist,rlist,elist,pts,iord,level,ndin,last) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:adaptivegausskronrod
|
||||
external f
|
||||
double precision intent(in) :: a
|
||||
double precision intent(in) :: b
|
||||
integer optional,intent(in),check(len(points)>=npts),depend(points) :: npts=len(points)
|
||||
double precision dimension(npts),intent(in) :: points
|
||||
double precision intent(in) :: epsabs
|
||||
double precision intent(in) :: epsrel
|
||||
integer intent(in) :: limit
|
||||
double precision intent(out) :: result1
|
||||
double precision intent(out) :: abserr
|
||||
integer intent(out) :: neval
|
||||
integer intent(out) :: ier
|
||||
double precision dimension(limit),intent(out),depend(limit) :: alist
|
||||
double precision dimension(limit),intent(out),depend(limit) :: blist
|
||||
double precision dimension(limit),intent(out),depend(limit) :: rlist
|
||||
double precision dimension(limit),intent(out),depend(limit) :: elist
|
||||
double precision dimension(npts + 2),intent(out),depend(npts) :: pts
|
||||
integer dimension(limit),intent(out),depend(limit) :: iord
|
||||
integer dimension(limit),intent(out),depend(limit) :: level
|
||||
integer dimension(npts + 2),intent(out),depend(npts) :: ndin
|
||||
integer :: last
|
||||
end subroutine dqagpe
|
||||
subroutine dqk21(f,a,b,result1,abserr,resabs,resasc) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:adaptivegausskronrod
|
||||
use dqk21__user__routines
|
||||
external f
|
||||
double precision intent(in) :: a
|
||||
double precision intent(in) :: b
|
||||
double precision intent(out) :: result1
|
||||
double precision intent(out) :: abserr
|
||||
double precision intent(out) :: resabs
|
||||
double precision intent(out) :: resasc
|
||||
end subroutine dqk21
|
||||
subroutine dqk15(f,a,b,result1,abserr,resabs,resasc) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:adaptivegausskronrod
|
||||
use dqk15__user__routines
|
||||
external f
|
||||
double precision intent(in) :: a
|
||||
double precision intent(in) :: b
|
||||
double precision intent(out) :: result1
|
||||
double precision intent(out) :: abserr
|
||||
double precision intent(out) :: resabs
|
||||
double precision intent(out) :: resasc
|
||||
end subroutine dqk15
|
||||
subroutine dqk9(f,a,b,result1,abserr,resabs,resasc) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:adaptivegausskronrod
|
||||
use dqk9__user__routines
|
||||
external f
|
||||
double precision intent(in) :: a
|
||||
double precision intent(in) :: b
|
||||
double precision intent(out) :: result1
|
||||
double precision intent(out) :: abserr
|
||||
double precision intent(out) :: resabs
|
||||
double precision intent(out) :: resasc
|
||||
end subroutine dqk9
|
||||
subroutine dqkl9(f,a,b,result1,abserr,resabs,resasc) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:adaptivegausskronrod
|
||||
use dqkl9__user__routines
|
||||
external f
|
||||
double precision intent(in) :: a
|
||||
double precision intent(in) :: b
|
||||
double precision intent(out) :: result1
|
||||
double precision intent(out) :: abserr
|
||||
double precision intent(out) :: resabs
|
||||
double precision intent(out) :: resasc
|
||||
end subroutine dqkl9
|
||||
subroutine dqpsrt(limit,last,maxerr,ermax,elist,iord,nrmax) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:adaptivegausskronrod
|
||||
integer :: limit
|
||||
integer optional,check(len(elist)>=last),depend(elist) :: last=len(elist)
|
||||
integer :: maxerr
|
||||
double precision :: ermax
|
||||
double precision dimension(last) :: elist
|
||||
integer dimension(last),depend(last) :: iord
|
||||
integer :: nrmax
|
||||
end subroutine dqpsrt
|
||||
subroutine dqelg(n,epstab,result1,abserr,res3la,nres) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:adaptivegausskronrod
|
||||
integer :: n
|
||||
double precision dimension(52) :: epstab
|
||||
double precision :: result1
|
||||
double precision :: abserr
|
||||
double precision dimension(3) :: res3la
|
||||
integer :: nres
|
||||
end subroutine dqelg
|
||||
function d1mach(i) ! in :adaptivegausskronrod:AdaptiveGaussKronrod.f90:adaptivegausskronrod
|
||||
integer intent(in) :: i
|
||||
double precision :: d1mach
|
||||
end function d1mach
|
||||
end module adaptivegausskronrod
|
||||
end interface
|
||||
end python module adaptivegausskronrod
|
||||
|
||||
! This file was auto-generated with f2py (version:2_5972).
|
||||
! See http://cens.ioc.ee/projects/f2py2e/
|
||||
@ -1,390 +0,0 @@
|
||||
C f2py -m -h deamod.pyf dea.f
|
||||
C f2py integrationmod.pyf integration1Dmodule.f90 .f90 -c --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71
|
||||
! f2py --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71 -m integrationmod -c integration1Dmodule.f90
|
||||
|
||||
DOUBLE PRECISION FUNCTION D1MACH(I)
|
||||
implicit none
|
||||
C
|
||||
C Double-precision machine constants.
|
||||
C
|
||||
C D1MACH( 1) = B**(EMIN-1), the smallest positive magnitude.
|
||||
C D1MACH( 2) = B**EMAX*(1 - B**(-T)), the largest magnitude.
|
||||
C D1MACH( 3) = B**(-T), the smallest relative spacing.
|
||||
C D1MACH( 4) = B**(1-T), the largest relative spacing.
|
||||
C D1MACH( 5) = LOG10(B)
|
||||
C
|
||||
C Two more added much later:
|
||||
C
|
||||
C D1MACH( 6) = Infinity.
|
||||
C D1MACH( 7) = Not-a-Number.
|
||||
C
|
||||
C Reference: Fox P.A., Hall A.D., Schryer N.L.,"Framework for a
|
||||
C Portable Library", ACM Transactions on Mathematical
|
||||
C Software, Vol. 4, no. 2, June 1978, PP. 177-188.
|
||||
C
|
||||
INTEGER , INTENT(IN) :: I
|
||||
DOUBLE PRECISION, SAVE :: DMACH(7)
|
||||
DOUBLE PRECISION :: B, EPS
|
||||
DOUBLE PRECISION :: ONE = 1.0D0
|
||||
DOUBLE PRECISION :: ZERO = 0.0D0
|
||||
INTEGER :: EMAX,EMIN,T
|
||||
DATA DMACH /7*0.0D0/
|
||||
! First time through, get values from F90 INTRINSICS:
|
||||
IF (DMACH(1) .EQ. 0.0D0) THEN
|
||||
T = DIGITS(ONE)
|
||||
B = DBLE(RADIX(ONE)) ! base number
|
||||
EPS = SPACING(ONE)
|
||||
EMIN = MINEXPONENT(ONE)
|
||||
EMAX = MAXEXPONENT(ONE)
|
||||
DMACH(1) = B**(EMIN-1) !TINY(ONE)
|
||||
DMACH(2) = (B**(EMAX-1)) * (B-B*EPS) !HUGE(ONE)
|
||||
DMACH(3) = EPS/B ! EPS/B
|
||||
DMACH(4) = EPS
|
||||
DMACH(5) = LOG10(B)
|
||||
DMACH(6) = B**(EMAX+5) !infinity
|
||||
DMACH(7) = ZERO/ZERO !nan
|
||||
ENDIF
|
||||
C
|
||||
D1MACH = DMACH(I)
|
||||
RETURN
|
||||
END FUNCTION D1MACH
|
||||
SUBROUTINE DEA(NEWFLG,SVALUE,LIMEXP,RESULT,ABSERR,EPSTAB,IERR)
|
||||
C***BEGIN PROLOGUE DEA
|
||||
C***DATE WRITTEN 800101 (YYMMDD)
|
||||
C***REVISION DATE 871208 (YYMMDD)
|
||||
C***CATEGORY NO. E5
|
||||
C***KEYWORDS CONVERGENCE ACCELERATION,EPSILON ALGORITHM,EXTRAPOLATION
|
||||
C***AUTHOR PIESSENS, ROBERT, APPLIED MATH. AND PROGR. DIV. -
|
||||
C K. U. LEUVEN
|
||||
C DE DONCKER-KAPENGA, ELISE,WESTERN MICHIGAN UNIVERSITY
|
||||
C KAHANER, DAVID K., NATIONAL BUREAU OF STANDARDS
|
||||
C STARKENBURG, C. B., NATIONAL BUREAU OF STANDARDS
|
||||
C***PURPOSE Given a slowly convergent sequence, this routine attempts
|
||||
C to extrapolate nonlinearly to a better estimate of the
|
||||
C sequence's limiting value, thus improving the rate of
|
||||
C convergence. Routine is based on the epsilon algorithm
|
||||
C of P. Wynn. An estimate of the absolute error is also
|
||||
C given.
|
||||
C***DESCRIPTION
|
||||
C
|
||||
C Epsilon algorithm. Standard fortran subroutine.
|
||||
C Double precision version.
|
||||
C
|
||||
C A R G U M E N T S I N T H E C A L L S E Q U E N C E
|
||||
C
|
||||
C NEWFLG - LOGICAL (INPUT and OUTPUT)
|
||||
C On the first call to DEA set NEWFLG to .TRUE.
|
||||
C (indicating a new sequence). DEA will set NEWFLG
|
||||
C to .FALSE.
|
||||
C
|
||||
C SVALUE - DOUBLE PRECISION (INPUT)
|
||||
C On the first call to DEA set SVALUE to the first
|
||||
C term in the sequence. On subsequent calls set
|
||||
C SVALUE to the subsequent sequence value.
|
||||
C
|
||||
C LIMEXP - INTEGER (INPUT)
|
||||
C An integer equal to or greater than the total
|
||||
C number of sequence terms to be evaluated. Do not
|
||||
C change the value of LIMEXP until a new sequence
|
||||
C is evaluated (NEWFLG=.TRUE.). LIMEXP .GE. 3
|
||||
C
|
||||
C RESULT - DOUBLE PRECISION (OUTPUT)
|
||||
C Best approximation to the sequence's limit.
|
||||
C
|
||||
C ABSERR - DOUBLE PRECISION (OUTPUT)
|
||||
C Estimate of the absolute error.
|
||||
C
|
||||
C EPSTAB - DOUBLE PRECISION (OUTPUT)
|
||||
C Workvector of DIMENSION at least (LIMEXP+7).
|
||||
C
|
||||
C IERR - INTEGER (OUTPUT)
|
||||
C IERR=0 Normal termination of the routine.
|
||||
C IERR=1 The input is invalid because LIMEXP.LT.3.
|
||||
C
|
||||
C T Y P I C A L P R O B L E M S E T U P
|
||||
C
|
||||
C This sample problem uses the trapezoidal rule to evaluate the
|
||||
C integral of the sin function from 0.0 to 0.5*PI (value = 1.0). The
|
||||
C program implements the trapezoidal rule 8 times creating an
|
||||
C increasingly accurate sequence of approximations to the integral.
|
||||
C Each time the trapezoidal rule is used, it uses twice as many
|
||||
C panels as the time before. DEA is called to obtain even more
|
||||
C accurate estimates.
|
||||
C
|
||||
C PROGRAM SAMPLE
|
||||
C IMPLICIT DOUBLE PRECISION (A-H,O-Z)
|
||||
C DOUBLE PRECISION EPSTAB(57)
|
||||
CC [57 = LIMEXP + 7]
|
||||
C LOGICAL NEWFLG
|
||||
C EXTERNAL F
|
||||
C DATA LIMEXP/50/
|
||||
C WRITE(*,*) ' NO. PANELS TRAP. APPROX'
|
||||
C * ,' APPROX W/EA ABSERR'
|
||||
C WRITE(*,*)
|
||||
C HALFPI = DASIN(1.0D+00)
|
||||
CC [UPPER INTEGRATION LIMIT = PI/2]
|
||||
C NEWFLG = .TRUE.
|
||||
CC [SET FLAG - 1ST DEA CALL]
|
||||
C DO 10 I = 0,7
|
||||
C NPARTS = 2 ** I
|
||||
C WIDTH = HALFPI/NPARTS
|
||||
C APPROX = 0.5D+00 * WIDTH * (F(0.0D+00) + F(HALFPI))
|
||||
C DO 11 J = 1,NPARTS-1
|
||||
C APPROX = APPROX + F(J * WIDTH) * WIDTH
|
||||
C 11 CONTINUE
|
||||
CC [END TRAPEZOIDAL RULE APPROX]
|
||||
C SVALUE = APPROX
|
||||
CC [SVALUE = NEW SEQUENCE VALUE]
|
||||
C CALL DEA(NEWFLG,SVALUE,LIMEXP,RESULT,ABSERR,EPSTAB,IERR)
|
||||
CC [CALL DEA FOR BETTER ESTIMATE]
|
||||
C WRITE(*,12) NPARTS,APPROX,RESULT,ABSERR
|
||||
C 12 FORMAT(' ',I4,T20,F16.13,T40,F16.13,T60,D11.4)
|
||||
C 10 CONTINUE
|
||||
C STOP
|
||||
C END
|
||||
C
|
||||
C DOUBLE PRECISION FUNCTION F(X)
|
||||
C DOUBLE PRECISION X
|
||||
C F = DSIN(X)
|
||||
CC [INTEGRAND]
|
||||
C RETURN
|
||||
C END
|
||||
C
|
||||
C Output from the above program will be:
|
||||
C
|
||||
C NO. PANELS TRAP. APPROX APPROX W/EA ABSERR
|
||||
C
|
||||
C 1 .7853981633974 .7853981633974 .7854D+00
|
||||
C 2 .9480594489685 .9480594489685 .9760D+00
|
||||
C 4 .9871158009728 .9994567212570 .2141D+00
|
||||
C 8 .9967851718862 .9999667417647 .3060D-02
|
||||
C 16 .9991966804851 .9999998781041 .6094D-03
|
||||
C 32 .9997991943200 .9999999981026 .5767D-03
|
||||
C 64 .9999498000921 .9999999999982 .3338D-04
|
||||
C 128 .9999874501175 1.0000000000000 .1238D-06
|
||||
C
|
||||
C-----------------------------------------------------------------------
|
||||
C***REFERENCES "Acceleration de la convergence en analyse numerique",
|
||||
C C. Brezinski, "Lecture Notes in Math.", vol. 584,
|
||||
C Springer-Verlag, New York, 1977.
|
||||
C***ROUTINES CALLED D1MACH,XERROR
|
||||
C***END PROLOGUE DEA
|
||||
double precision, dimension(LIMEXP+7), intent(inout) :: EPSTAB
|
||||
double precision, intent(out) :: RESULT !, ABSERR
|
||||
double precision, intent(inout) :: ABSERR
|
||||
double precision, intent(in) :: SVALUE
|
||||
INTEGER, INTENT(IN) :: LIMEXP
|
||||
INTEGER, INTENT(OUT) :: IERR
|
||||
LOGICAL, intent(INOUT) :: NEWFLG
|
||||
DOUBLE PRECISION :: DELTA1,DELTA2,DELTA3,DRELPR,DEPRN,
|
||||
1 ERROR,ERR1,ERR2,ERR3,E0,E1,E2,E3,RES,
|
||||
2 SS,TOL1,TOL2,TOL3
|
||||
double precision, dimension(3) :: RES3LA
|
||||
INTEGER I,IB,IB2,IE,IN,K1,K2,K3,N,NEWELM,NUM,NRES
|
||||
C
|
||||
C
|
||||
C LIMEXP is the maximum number of elements the
|
||||
C epsilon table data can contain. The epsilon table
|
||||
C is stored in the first (LIMEXP+2) entries of EPSTAB.
|
||||
C
|
||||
C
|
||||
C LIST OF MAJOR VARIABLES
|
||||
C -----------------------
|
||||
C E0,E1,E2,E3 - DOUBLE PRECISION
|
||||
C The 4 elements on which the computation of
|
||||
C a new element in the epsilon table is based.
|
||||
C NRES - INTEGER
|
||||
C Number of extrapolation results actually
|
||||
C generated by the epsilon algorithm in prior
|
||||
C calls to the routine.
|
||||
C NEWELM - INTEGER
|
||||
C Number of elements to be computed in the
|
||||
C new diagonal of the epsilon table. The
|
||||
C condensed epsilon table is computed. Only
|
||||
C those elements needed for the computation of
|
||||
C the next diagonal are preserved.
|
||||
C RES - DOUBLE PRECISION
|
||||
C New element in the new diagonal of the
|
||||
C epsilon table.
|
||||
C ERROR - DOUBLE PRECISION
|
||||
C An estimate of the absolute error of RES.
|
||||
C Routine decides whether RESULT=RES or
|
||||
C RESULT=SVALUE by comparing ERROR with
|
||||
C ABSERR from the previous call.
|
||||
C RES3LA - DOUBLE PRECISION
|
||||
C Vector of DIMENSION 3 containing at most
|
||||
C the last 3 results.
|
||||
C
|
||||
C
|
||||
C MACHINE DEPENDENT CONSTANTS
|
||||
C ---------------------------
|
||||
C DRELPR is the largest relative spacing.
|
||||
C
|
||||
C***FIRST EXECUTABLE STATEMENT DEA
|
||||
IF(LIMEXP.LT.3) THEN
|
||||
IERR = 1
|
||||
! CALL XERROR('LIMEXP IS LESS THAN 3',21,1,1)
|
||||
GO TO 110
|
||||
ENDIF
|
||||
IERR = 0
|
||||
RES3LA(1)=EPSTAB(LIMEXP+5)
|
||||
RES3LA(2)=EPSTAB(LIMEXP+6)
|
||||
RES3LA(3)=EPSTAB(LIMEXP+7)
|
||||
RESULT=SVALUE
|
||||
IF(NEWFLG) THEN
|
||||
N=1
|
||||
NRES=0
|
||||
NEWFLG=.FALSE.
|
||||
EPSTAB(N)=SVALUE
|
||||
ABSERR=ABS(RESULT)
|
||||
GO TO 100
|
||||
ELSE
|
||||
N=INT(EPSTAB(LIMEXP+3))
|
||||
NRES=INT(EPSTAB(LIMEXP+4))
|
||||
IF(N.EQ.2) THEN
|
||||
EPSTAB(N)=SVALUE
|
||||
ABSERR=.6D+01*ABS(RESULT-EPSTAB(1))
|
||||
GO TO 100
|
||||
ENDIF
|
||||
ENDIF
|
||||
EPSTAB(N)=SVALUE
|
||||
DRELPR=D1MACH(4)
|
||||
DEPRN=1.0D+01*DRELPR
|
||||
EPSTAB(N+2)=EPSTAB(N)
|
||||
NEWELM=(N-1)/2
|
||||
NUM=N
|
||||
K1=N
|
||||
DO 40 I=1,NEWELM
|
||||
K2=K1-1
|
||||
K3=K1-2
|
||||
RES=EPSTAB(K1+2)
|
||||
E0=EPSTAB(K3)
|
||||
E1=EPSTAB(K2)
|
||||
E2=RES
|
||||
DELTA2=E2-E1
|
||||
ERR2=ABS(DELTA2)
|
||||
TOL2=MAX(ABS(E2),ABS(E1))*DRELPR
|
||||
DELTA3=E1-E0
|
||||
ERR3=ABS(DELTA3)
|
||||
TOL3=MAX(ABS(E1),ABS(E0))*DRELPR
|
||||
IF(ERR2.GT.TOL2.OR.ERR3.GT.TOL3) GO TO 10
|
||||
C
|
||||
C IF E0, E1 AND E2 ARE EQUAL TO WITHIN MACHINE
|
||||
C ACCURACY, CONVERGENCE IS ASSUMED.
|
||||
C RESULT=E2
|
||||
C ABSERR=ABS(E1-E0)+ABS(E2-E1)
|
||||
C
|
||||
RESULT=RES
|
||||
ABSERR=ERR2+ERR3
|
||||
GO TO 50
|
||||
10 IF(I.NE.1) THEN
|
||||
E3=EPSTAB(K1)
|
||||
EPSTAB(K1)=E1
|
||||
DELTA1=E1-E3
|
||||
ERR1=ABS(DELTA1)
|
||||
TOL1=MAX(ABS(E1),ABS(E3))*DRELPR
|
||||
C
|
||||
C IF TWO ELEMENTS ARE VERY CLOSE TO EACH OTHER, OMIT
|
||||
C A PART OF THE TABLE BY ADJUSTING THE VALUE OF N
|
||||
C
|
||||
IF(ERR1.LE.TOL1.OR.ERR2.LE.TOL2.OR.ERR3.LE.TOL3) GO TO 20
|
||||
SS=0.1D+01/DELTA1+0.1D+01/DELTA2-0.1D+01/DELTA3
|
||||
ELSE
|
||||
EPSTAB(K1)=E1
|
||||
IF(ERR2.LE.TOL2.OR.ERR3.LE.TOL3) GO TO 20
|
||||
SS=0.1D+01/DELTA2-0.1D+01/DELTA3
|
||||
ENDIF
|
||||
C
|
||||
C TEST TO DETECT IRREGULAR BEHAVIOUR IN THE TABLE, AND
|
||||
C EVENTUALLY OMIT A PART OF THE TABLE ADJUSTING THE VALUE
|
||||
C OF N
|
||||
C
|
||||
IF(ABS(SS*E1).GT.0.1D-03) GO TO 30
|
||||
20 N=I+I-1
|
||||
IF(NRES.EQ.0) THEN
|
||||
ABSERR=ERR2+ERR3
|
||||
RESULT=RES
|
||||
ELSE IF(NRES.EQ.1) THEN
|
||||
RESULT=RES3LA(1)
|
||||
ELSE IF(NRES.EQ.2) THEN
|
||||
RESULT=RES3LA(2)
|
||||
ELSE
|
||||
RESULT=RES3LA(3)
|
||||
ENDIF
|
||||
GO TO 50
|
||||
C
|
||||
C COMPUTE A NEW ELEMENT AND EVENTUALLY ADJUST
|
||||
C THE VALUE OF RESULT
|
||||
C
|
||||
30 RES=E1+0.1D+01/SS
|
||||
EPSTAB(K1)=RES
|
||||
K1=K1-2
|
||||
IF(NRES.EQ.0) THEN
|
||||
ABSERR=ERR2+ABS(RES-E2)+ERR3
|
||||
RESULT=RES
|
||||
GO TO 40
|
||||
ELSE IF(NRES.EQ.1) THEN
|
||||
ERROR=.6D+01*(ABS(RES-RES3LA(1)))
|
||||
ELSE IF(NRES.EQ.2) THEN
|
||||
ERROR=.2D+01*(ABS(RES-RES3LA(2))+ABS(RES-RES3LA(1)))
|
||||
ELSE
|
||||
ERROR=ABS(RES-RES3LA(3))+ABS(RES-RES3LA(2))
|
||||
1 +ABS(RES-RES3LA(1))
|
||||
ENDIF
|
||||
IF(ERROR.GT.1.0D+01*ABSERR) GO TO 40
|
||||
ABSERR=ERROR
|
||||
RESULT=RES
|
||||
40 CONTINUE
|
||||
C
|
||||
C COMPUTE ERROR ESTIMATE
|
||||
C
|
||||
IF(NRES.EQ.1) THEN
|
||||
ABSERR=.6D+01*(ABS(RESULT-RES3LA(1)))
|
||||
ELSE IF(NRES.EQ.2) THEN
|
||||
ABSERR=.2D+01*ABS(RESULT-RES3LA(2))+ABS(RESULT-RES3LA(1))
|
||||
ELSE IF(NRES.GT.2) THEN
|
||||
ABSERR=ABS(RESULT-RES3LA(3))+ABS(RESULT-RES3LA(2))
|
||||
1 +ABS(RESULT-RES3LA(1))
|
||||
ENDIF
|
||||
C
|
||||
C SHIFT THE TABLE
|
||||
C
|
||||
50 IF(N.EQ.LIMEXP) N=2*(LIMEXP/2)-1
|
||||
IB=1
|
||||
IF((NUM/2)*2.EQ.NUM) IB=2
|
||||
IE=NEWELM+1
|
||||
DO 60 I=1,IE
|
||||
IB2=IB+2
|
||||
EPSTAB(IB)=EPSTAB(IB2)
|
||||
IB=IB2
|
||||
60 CONTINUE
|
||||
IF(NUM.EQ.N) GO TO 80
|
||||
IN=NUM-N+1
|
||||
DO 70 I=1,N
|
||||
EPSTAB(I)=EPSTAB(IN)
|
||||
IN=IN+1
|
||||
70 CONTINUE
|
||||
C
|
||||
C UPDATE RES3LA
|
||||
C
|
||||
80 IF(NRES.EQ.0) THEN
|
||||
RES3LA(1)=RESULT
|
||||
ELSE IF(NRES.EQ.1) THEN
|
||||
RES3LA(2)=RESULT
|
||||
ELSE IF(NRES.EQ.2) THEN
|
||||
RES3LA(3)=RESULT
|
||||
ELSE
|
||||
RES3LA(1)=RES3LA(2)
|
||||
RES3LA(2)=RES3LA(3)
|
||||
RES3LA(3)=RESULT
|
||||
ENDIF
|
||||
90 ABSERR=MAX(ABSERR,DEPRN*ABS(RESULT))
|
||||
NRES=NRES+1
|
||||
100 N=N+1
|
||||
EPSTAB(LIMEXP+3)=DBLE(N)
|
||||
EPSTAB(LIMEXP+4)=DBLE(NRES)
|
||||
EPSTAB(LIMEXP+5)=RES3LA(1)
|
||||
EPSTAB(LIMEXP+6)=RES3LA(2)
|
||||
EPSTAB(LIMEXP+7)=RES3LA(3)
|
||||
110 RETURN
|
||||
END subroutine DEA
|
||||
@ -1,6 +0,0 @@
|
||||
! -*- f90 -*-
|
||||
! Note: the context of this file is case sensitive.
|
||||
|
||||
|
||||
! This file was auto-generated with f2py (version:2_5972).
|
||||
! See http://cens.ioc.ee/projects/f2py2e/
|
||||
@ -1,344 +0,0 @@
|
||||
C f2py -m erfcore -h erfcore.pyf erfcore.f90
|
||||
C f2py erfcore.pyf erfcore.f90 -c --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71
|
||||
C f2py --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71 -m erfcore -c erfcore.f90
|
||||
C
|
||||
|
||||
MODULE ERFCOREMOD
|
||||
IMPLICIT NONE
|
||||
|
||||
INTERFACE CALERF
|
||||
MODULE PROCEDURE CALERF
|
||||
END INTERFACE
|
||||
|
||||
INTERFACE DERF
|
||||
MODULE PROCEDURE DERF
|
||||
END INTERFACE
|
||||
|
||||
INTERFACE DERFC
|
||||
MODULE PROCEDURE DERFC
|
||||
END INTERFACE
|
||||
|
||||
INTERFACE DERFCX
|
||||
MODULE PROCEDURE DERFCX
|
||||
END INTERFACE
|
||||
CONTAINS
|
||||
C--------------------------------------------------------------------
|
||||
C
|
||||
C DERF subprogram computes approximate values for erf(x).
|
||||
C (see comments heading CALERF).
|
||||
C
|
||||
C Author/date: W. J. Cody, January 8, 1985
|
||||
C
|
||||
C--------------------------------------------------------------------
|
||||
FUNCTION DERF( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 0
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERF
|
||||
C--------------------------------------------------------------------
|
||||
C
|
||||
C DERFC subprogram computes approximate values for erfc(x).
|
||||
C (see comments heading CALERF).
|
||||
C
|
||||
C Author/date: W. J. Cody, January 8, 1985
|
||||
C
|
||||
C--------------------------------------------------------------------
|
||||
FUNCTION DERFC( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 1
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERFC
|
||||
C------------------------------------------------------------------
|
||||
C
|
||||
C DERFCX subprogram computes approximate values for exp(x*x) * erfc(x).
|
||||
C (see comments heading CALERF).
|
||||
C
|
||||
C Author/date: W. J. Cody, March 30, 1987
|
||||
C
|
||||
C------------------------------------------------------------------
|
||||
FUNCTION DERFCX( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 2
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERFCX
|
||||
|
||||
SUBROUTINE CALERF(ARG,RESULT,JINT)
|
||||
IMPLICIT NONE
|
||||
C------------------------------------------------------------------
|
||||
C
|
||||
C CALERF packet evaluates erf(x), erfc(x), and exp(x*x)*erfc(x)
|
||||
C for a real argument x. It contains three FUNCTION type
|
||||
C subprograms: ERF, ERFC, and ERFCX (or DERF, DERFC, and DERFCX),
|
||||
C and one SUBROUTINE type subprogram, CALERF. The calling
|
||||
C statements for the primary entries are:
|
||||
C
|
||||
C Y=ERF(X) (or Y=DERF(X)),
|
||||
C
|
||||
C Y=ERFC(X) (or Y=DERFC(X)),
|
||||
C and
|
||||
C Y=ERFCX(X) (or Y=DERFCX(X)).
|
||||
C
|
||||
C The routine CALERF is intended for internal packet use only,
|
||||
C all computations within the packet being concentrated in this
|
||||
C routine. The function subprograms invoke CALERF with the
|
||||
C statement
|
||||
C
|
||||
C CALL CALERF(ARG,RESULT,JINT)
|
||||
C
|
||||
C where the parameter usage is as follows
|
||||
C
|
||||
C Function Parameters for CALERF
|
||||
C call ARG Result JINT
|
||||
C
|
||||
C ERF(ARG) ANY REAL ARGUMENT ERF(ARG) 0
|
||||
C ERFC(ARG) ABS(ARG) .LT. XBIG ERFC(ARG) 1
|
||||
C ERFCX(ARG) XNEG .LT. ARG .LT. XMAX ERFCX(ARG) 2
|
||||
C
|
||||
C The main computation evaluates near-minimax approximations
|
||||
C from "Rational Chebyshev approximations for the error function"
|
||||
C by W. J. Cody, Math. Comp., 1969, PP. 631-638. This
|
||||
C transportable program uses rational functions that theoretically
|
||||
C approximate erf(x) and erfc(x) to at least 18 significant
|
||||
C decimal digits. The accuracy achieved depends on the arithmetic
|
||||
C system, the compiler, the intrinsic functions, and proper
|
||||
C selection of the machine-dependent constants.
|
||||
C
|
||||
C*******************************************************************
|
||||
C*******************************************************************
|
||||
C
|
||||
C Explanation of machine-dependent constants
|
||||
C
|
||||
C XMIN = the smallest positive floating-point number.
|
||||
C XINF = the largest positive finite floating-point number.
|
||||
C XNEG = the largest negative argument acceptable to ERFCX;
|
||||
C the negative of the solution to the equation
|
||||
C 2*exp(x*x) = XINF.
|
||||
C XSMALL = argument below which erf(x) may be represented by
|
||||
C 2*x/sqrt(pi) and above which x*x will not underflow.
|
||||
C A conservative value is the largest machine number X
|
||||
C such that 1.0 + X = 1.0 to machine precision.
|
||||
C XBIG = largest argument acceptable to ERFC; solution to
|
||||
C the equation: W(x) * (1-0.5/x**2) = XMIN, where
|
||||
C W(x) = exp(-x*x)/[x*sqrt(pi)].
|
||||
C XHUGE = argument above which 1.0 - 1/(2*x*x) = 1.0 to
|
||||
C machine precision. A conservative value is
|
||||
C 1/[2*sqrt(XSMALL)]
|
||||
C XMAX = largest acceptable argument to ERFCX; the minimum
|
||||
C of XINF and 1/[sqrt(pi)*XMIN].
|
||||
C
|
||||
C Approximate values for some important machines are:
|
||||
C
|
||||
C XMIN XINF XNEG XSMALL
|
||||
C
|
||||
C C 7600 (S.P.) 3.13E-294 1.26E+322 -27.220 7.11E-15
|
||||
C CRAY-1 (S.P.) 4.58E-2467 5.45E+2465 -75.345 7.11E-15
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (S.P.) 1.18E-38 3.40E+38 -9.382 5.96E-8
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (D.P.) 2.23D-308 1.79D+308 -26.628 1.11D-16
|
||||
C IBM 195 (D.P.) 5.40D-79 7.23E+75 -13.190 1.39D-17
|
||||
C UNIVAC 1108 (D.P.) 2.78D-309 8.98D+307 -26.615 1.73D-18
|
||||
C VAX D-Format (D.P.) 2.94D-39 1.70D+38 -9.345 1.39D-17
|
||||
C VAX G-Format (D.P.) 5.56D-309 8.98D+307 -26.615 1.11D-16
|
||||
C
|
||||
C
|
||||
C XBIG XHUGE XMAX
|
||||
C
|
||||
C C 7600 (S.P.) 25.922 8.39E+6 1.80X+293
|
||||
C CRAY-1 (S.P.) 75.326 8.39E+6 5.45E+2465
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (S.P.) 9.194 2.90E+3 4.79E+37
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (D.P.) 26.543 6.71D+7 2.53D+307
|
||||
C IBM 195 (D.P.) 13.306 1.90D+8 7.23E+75
|
||||
C UNIVAC 1108 (D.P.) 26.582 5.37D+8 8.98D+307
|
||||
C VAX D-Format (D.P.) 9.269 1.90D+8 1.70D+38
|
||||
C VAX G-Format (D.P.) 26.569 6.71D+7 8.98D+307
|
||||
C
|
||||
C*******************************************************************
|
||||
C*******************************************************************
|
||||
C
|
||||
C Error returns
|
||||
C
|
||||
C The program returns ERFC = 0 for ARG .GE. XBIG;
|
||||
C
|
||||
C ERFCX = XINF for ARG .LT. XNEG;
|
||||
C and
|
||||
C ERFCX = 0 for ARG .GE. XMAX.
|
||||
C
|
||||
C
|
||||
C Intrinsic functions required are:
|
||||
C
|
||||
C ABS, AINT, EXP
|
||||
C
|
||||
C
|
||||
C Author: W. J. Cody
|
||||
C Mathematics and Computer Science Division
|
||||
C Argonne National Laboratory
|
||||
C Argonne, IL 60439
|
||||
C
|
||||
C Latest modification: March 19, 1990
|
||||
C Updated to F90 by pab 23.03.2003
|
||||
C
|
||||
C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, INTENT(IN) :: ARG
|
||||
INTEGER, INTENT(IN) :: JINT
|
||||
DOUBLE PRECISION, INTENT(INOUT):: RESULT
|
||||
! Local variables
|
||||
INTEGER :: I
|
||||
DOUBLE PRECISION :: DEL,X,XDEN,XNUM,Y,YSQ
|
||||
C------------------------------------------------------------------
|
||||
C Mathematical constants
|
||||
C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, PARAMETER :: ZERO = 0.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: HALF = 0.05D0
|
||||
DOUBLE PRECISION, PARAMETER :: ONE = 1.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: TWO = 2.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: FOUR = 4.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: SIXTEN = 16.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: SQRPI = 5.6418958354775628695D-1
|
||||
DOUBLE PRECISION, PARAMETER :: THRESH = 0.46875D0
|
||||
C------------------------------------------------------------------
|
||||
C Machine-dependent constants
|
||||
C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, PARAMETER :: XNEG = -26.628D0
|
||||
DOUBLE PRECISION, PARAMETER :: XSMALL = 1.11D-16
|
||||
DOUBLE PRECISION, PARAMETER :: XBIG = 26.543D0
|
||||
DOUBLE PRECISION, PARAMETER :: XHUGE = 6.71D7
|
||||
DOUBLE PRECISION, PARAMETER :: XMAX = 2.53D307
|
||||
DOUBLE PRECISION, PARAMETER :: XINF = 1.79D308
|
||||
!---------------------------------------------------------------
|
||||
! Coefficents to the rational polynomials
|
||||
!--------------------------------------------------------------
|
||||
DOUBLE PRECISION, DIMENSION(5) :: A, Q
|
||||
DOUBLE PRECISION, DIMENSION(4) :: B
|
||||
DOUBLE PRECISION, DIMENSION(9) :: C
|
||||
DOUBLE PRECISION, DIMENSION(8) :: D
|
||||
DOUBLE PRECISION, DIMENSION(6) :: P
|
||||
C------------------------------------------------------------------
|
||||
C Coefficients for approximation to erf in first interval
|
||||
C------------------------------------------------------------------
|
||||
PARAMETER (A = (/ 3.16112374387056560D00,
|
||||
& 1.13864154151050156D02,3.77485237685302021D02,
|
||||
& 3.20937758913846947D03, 1.85777706184603153D-1/))
|
||||
PARAMETER ( B = (/2.36012909523441209D01,2.44024637934444173D02,
|
||||
& 1.28261652607737228D03,2.84423683343917062D03/))
|
||||
C------------------------------------------------------------------
|
||||
C Coefficients for approximation to erfc in second interval
|
||||
C------------------------------------------------------------------
|
||||
PARAMETER ( C=(/5.64188496988670089D-1,8.88314979438837594D0,
|
||||
1 6.61191906371416295D01,2.98635138197400131D02,
|
||||
2 8.81952221241769090D02,1.71204761263407058D03,
|
||||
3 2.05107837782607147D03,1.23033935479799725D03,
|
||||
4 2.15311535474403846D-8/))
|
||||
PARAMETER ( D =(/1.57449261107098347D01,1.17693950891312499D02,
|
||||
1 5.37181101862009858D02,1.62138957456669019D03,
|
||||
2 3.29079923573345963D03,4.36261909014324716D03,
|
||||
3 3.43936767414372164D03,1.23033935480374942D03/))
|
||||
C------------------------------------------------------------------
|
||||
C Coefficients for approximation to erfc in third interval
|
||||
C------------------------------------------------------------------
|
||||
PARAMETER ( P =(/3.05326634961232344D-1,3.60344899949804439D-1,
|
||||
1 1.25781726111229246D-1,1.60837851487422766D-2,
|
||||
2 6.58749161529837803D-4,1.63153871373020978D-2/))
|
||||
PARAMETER (Q =(/2.56852019228982242D00,1.87295284992346047D00,
|
||||
1 5.27905102951428412D-1,6.05183413124413191D-2,
|
||||
2 2.33520497626869185D-3/))
|
||||
C------------------------------------------------------------------
|
||||
X = ARG
|
||||
Y = ABS(X)
|
||||
IF (Y .LE. THRESH) THEN
|
||||
C------------------------------------------------------------------
|
||||
C Evaluate erf for |X| <= 0.46875
|
||||
C------------------------------------------------------------------
|
||||
!YSQ = ZERO
|
||||
IF (Y .GT. XSMALL) THEN
|
||||
YSQ = Y * Y
|
||||
XNUM = A(5)*YSQ
|
||||
XDEN = YSQ
|
||||
DO I = 1, 3
|
||||
XNUM = (XNUM + A(I)) * YSQ
|
||||
XDEN = (XDEN + B(I)) * YSQ
|
||||
END DO
|
||||
RESULT = X * (XNUM + A(4)) / (XDEN + B(4))
|
||||
ELSE
|
||||
RESULT = X * A(4) / B(4)
|
||||
ENDIF
|
||||
IF (JINT .NE. 0) RESULT = ONE - RESULT
|
||||
IF (JINT .EQ. 2) RESULT = EXP(YSQ) * RESULT
|
||||
GO TO 800
|
||||
C------------------------------------------------------------------
|
||||
C Evaluate erfc for 0.46875 <= |X| <= 4.0
|
||||
C------------------------------------------------------------------
|
||||
ELSE IF (Y .LE. FOUR) THEN
|
||||
XNUM = C(9)*Y
|
||||
XDEN = Y
|
||||
DO I = 1, 7
|
||||
XNUM = (XNUM + C(I)) * Y
|
||||
XDEN = (XDEN + D(I)) * Y
|
||||
END DO
|
||||
RESULT = (XNUM + C(8)) / (XDEN + D(8))
|
||||
IF (JINT .NE. 2) THEN
|
||||
YSQ = AINT(Y*SIXTEN)/SIXTEN
|
||||
DEL = (Y-YSQ)*(Y+YSQ)
|
||||
RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT
|
||||
END IF
|
||||
C------------------------------------------------------------------
|
||||
C Evaluate erfc for |X| > 4.0
|
||||
C------------------------------------------------------------------
|
||||
ELSE
|
||||
RESULT = ZERO
|
||||
IF (Y .GE. XBIG) THEN
|
||||
IF ((JINT .NE. 2) .OR. (Y .GE. XMAX)) GO TO 300
|
||||
IF (Y .GE. XHUGE) THEN
|
||||
RESULT = SQRPI / Y
|
||||
GO TO 300
|
||||
END IF
|
||||
END IF
|
||||
YSQ = ONE / (Y * Y)
|
||||
XNUM = P(6)*YSQ
|
||||
XDEN = YSQ
|
||||
DO I = 1, 4
|
||||
XNUM = (XNUM + P(I)) * YSQ
|
||||
XDEN = (XDEN + Q(I)) * YSQ
|
||||
ENDDO
|
||||
RESULT = YSQ *(XNUM + P(5)) / (XDEN + Q(5))
|
||||
RESULT = (SQRPI - RESULT) / Y
|
||||
IF (JINT .NE. 2) THEN
|
||||
YSQ = AINT(Y*SIXTEN)/SIXTEN
|
||||
DEL = (Y-YSQ)*(Y+YSQ)
|
||||
RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT
|
||||
END IF
|
||||
END IF
|
||||
C------------------------------------------------------------------
|
||||
C Fix up for negative argument, erf, etc.
|
||||
C------------------------------------------------------------------
|
||||
300 IF (JINT .EQ. 0) THEN
|
||||
RESULT = (HALF - RESULT) + HALF
|
||||
IF (X .LT. ZERO) RESULT = -RESULT
|
||||
ELSE IF (JINT .EQ. 1) THEN
|
||||
IF (X .LT. ZERO) RESULT = TWO - RESULT
|
||||
ELSE
|
||||
IF (X .LT. ZERO) THEN
|
||||
IF (X .LT. XNEG) THEN
|
||||
RESULT = XINF
|
||||
ELSE
|
||||
YSQ = AINT(X*SIXTEN)/SIXTEN
|
||||
DEL = (X-YSQ)*(X+YSQ)
|
||||
Y = EXP(YSQ*YSQ) * EXP(DEL)
|
||||
RESULT = (Y+Y) - RESULT
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
800 RETURN
|
||||
END SUBROUTINE CALERF
|
||||
END MODULE ERFCOREMOD
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -1,24 +0,0 @@
|
||||
! -*- f90 -*-
|
||||
! Note: the context of this file is case sensitive.
|
||||
|
||||
python module mvnprdcrprb ! in
|
||||
interface ! in :mvnprdcrprb
|
||||
subroutine pymvnprdcrprb(rho,a,b,n,abseps,releps,usebreakpoints,usesimpson,prb,abserr,ift) ! in :mvnprdcrprb:mvnprodcorrprb_interface.f
|
||||
use mvnprodcorrprbmod,,only: mvnprodcorrprb
|
||||
double precision dimension(n),intent(in),depend(n) :: rho
|
||||
double precision dimension(n),intent(in),depend(n) :: a
|
||||
double precision dimension(n),intent(in),depend(n) :: b
|
||||
integer intent(in) :: n
|
||||
double precision intent(in) :: abseps
|
||||
double precision intent(in) :: releps
|
||||
logical intent(in) :: usebreakpoints
|
||||
logical intent(in) :: usesimpson
|
||||
double precision intent(out) :: prb
|
||||
double precision intent(out) :: abserr
|
||||
integer intent(out) :: ift
|
||||
end subroutine pymvnprdcrprb
|
||||
end interface
|
||||
end python module mvnprdcrprb
|
||||
|
||||
! This file was auto-generated with f2py (version:2_5972).
|
||||
! See http://cens.ioc.ee/projects/f2py2e/
|
||||
@ -1,666 +0,0 @@
|
||||
module mvnProdCorrPrbMod
|
||||
implicit none
|
||||
private
|
||||
public :: mvnprodcorrprb
|
||||
double precision, parameter :: mINFINITY = 8.25D0 !
|
||||
! Inputs to integrand
|
||||
integer mNdim ! # of mRho/=0 and mRho/=+/-1 and -inf<a or b<inf
|
||||
double precision, allocatable, dimension(:) :: mRho, mDen
|
||||
double precision, allocatable, dimension(:) :: mA,mB
|
||||
|
||||
|
||||
INTERFACE mvnprodcorrprb
|
||||
MODULE PROCEDURE mvnprodcorrprb
|
||||
END INTERFACE
|
||||
|
||||
INTERFACE FI
|
||||
MODULE PROCEDURE FI
|
||||
END INTERFACE
|
||||
|
||||
INTERFACE FI2
|
||||
MODULE PROCEDURE FI2
|
||||
END INTERFACE
|
||||
|
||||
INTERFACE FIINV
|
||||
MODULE PROCEDURE FIINV
|
||||
END INTERFACE
|
||||
INTERFACE GetBreakPoints
|
||||
MODULE PROCEDURE GetBreakPoints
|
||||
END INTERFACE
|
||||
|
||||
INTERFACE NarrowLimits
|
||||
MODULE PROCEDURE NarrowLimits
|
||||
END INTERFACE
|
||||
|
||||
INTERFACE GetTruncationError
|
||||
MODULE PROCEDURE GetTruncationError
|
||||
END INTERFACE
|
||||
|
||||
INTERFACE integrand
|
||||
MODULE PROCEDURE integrand
|
||||
END INTERFACE
|
||||
|
||||
INTERFACE integrand1
|
||||
MODULE PROCEDURE integrand1
|
||||
END INTERFACE
|
||||
contains
|
||||
SUBROUTINE SORTRE(rarray,indices)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, DIMENSION(:), INTENT(inout) :: rarray
|
||||
INTEGER, DIMENSION(:), OPTIONAL, INTENT(inout) :: indices
|
||||
! local variables
|
||||
double precision :: tmpR
|
||||
INTEGER :: i,im,j,k,m,n, tmpI
|
||||
|
||||
! diminishing increment sort as described by
|
||||
! Donald E. Knuth (1973) "The art of computer programming,",
|
||||
! Vol. 3, pp 84- (sorting and searching)
|
||||
n = size(rarray)
|
||||
! if (present(indices)) then
|
||||
! if the below is commented out then assume indices are already initialized
|
||||
! forall(i=1,n) indices(i) = i
|
||||
! endif
|
||||
100 continue
|
||||
if (n.le.1) goto 800
|
||||
m=1
|
||||
200 continue
|
||||
m=m+m
|
||||
if (m.lt.n) goto 200
|
||||
m=m-1
|
||||
300 continue
|
||||
m=m/2
|
||||
if (m.eq.0) goto 800
|
||||
k=n-m
|
||||
j=1
|
||||
400 continue
|
||||
i=j
|
||||
500 continue
|
||||
im=i+m
|
||||
if (rarray(i).gt.rarray(im)) goto 700
|
||||
600 continue
|
||||
j=j+1
|
||||
if (j.gt.k) goto 300
|
||||
goto 400
|
||||
700 continue
|
||||
tmpR = rarray(i)
|
||||
rarray(i) = rarray(im)
|
||||
rarray(im) = tmpR
|
||||
if (present(indices)) then
|
||||
tmpI = indices(i)
|
||||
indices(i) = indices(im)
|
||||
indices(im) = tmpI
|
||||
endif
|
||||
i=i-m
|
||||
if (i.lt.1) goto 600
|
||||
goto 500
|
||||
800 continue
|
||||
RETURN
|
||||
END SUBROUTINE SORTRE
|
||||
|
||||
subroutine mvnprodcorrprb(rho,a,b,abseps,releps,useBreakPoints,
|
||||
& useSimpson,abserr,errFlg,prb)
|
||||
use AdaptiveGaussKronrod
|
||||
use Integration1DModule
|
||||
! use numerical_libraries
|
||||
implicit none
|
||||
double precision,dimension(:),intent(in) :: rho,a,b
|
||||
double precision,intent(in) :: abseps,releps
|
||||
logical, intent(in) :: useBreakPoints,useSimpson
|
||||
double precision,intent(out) :: abserr,prb
|
||||
integer, intent(out) :: errFlg
|
||||
! Locals
|
||||
double precision, parameter :: ZERO = 0.0D0
|
||||
double precision, parameter :: ZPT1 = 0.1D0
|
||||
double precision, parameter :: ZPTZ5 = 0.05D0
|
||||
double precision, parameter :: ZPTZZ1 = 0.001D0
|
||||
double precision, parameter :: ZPTZZZ1 = 0.0001D0
|
||||
double precision, parameter :: ONE = 1.d0
|
||||
double precision :: small, LTol, val0,val, truncError
|
||||
double precision :: zCutOff, zlo, zup, As, Bs
|
||||
double precision, dimension(1000) :: breakPoints
|
||||
integer :: n, k , limit, Npts, neval
|
||||
logical :: isSingular, isLimitsNarrowed
|
||||
small = MAX(spacing(one),1.0D-16)
|
||||
isSingular = .FALSE.
|
||||
n = size(a,DIM=1)
|
||||
|
||||
LTol = max(abseps,small)
|
||||
errFlg = 0
|
||||
prb = ZERO
|
||||
abserr = small
|
||||
if ( any(b(:)<=a(:)).or.
|
||||
& any(b(:)<=-mINFINITY) .or.
|
||||
& any(mINFINITY<=a(:))) then
|
||||
goto 999 ! end program
|
||||
endif
|
||||
As = - mInfinity
|
||||
Bs = mInfinity
|
||||
zCutOff = abs(max(FIINV(ZPTZ5*LTol),-mINFINITY));
|
||||
zlo = - zCutOff
|
||||
zup = zCutOff
|
||||
|
||||
allocate(mA(n),mB(n),mRho(n),mDen(n))
|
||||
do k = 1,n
|
||||
if (one <= abs(rho(k)) ) then
|
||||
mRho(k) = sign(one,rho(k))
|
||||
mDen(k) = zero
|
||||
else
|
||||
mRho(k) = rho(k)
|
||||
mDen(k) = sqrt(one - rho(k))*sqrt(one + rho(k))
|
||||
endif
|
||||
end do
|
||||
! See if we may narrow down the integration region: zlo, zup
|
||||
CALL NarrowLimits(zlo,zup,As,Bs,zCutOff,n,a,b,mRho,mDen)
|
||||
if (zup <= zlo) goto 999 ! end program
|
||||
|
||||
! Move only significant variables to mA,mB, and mRho
|
||||
! (Note: If you scale them with mDen, the integrand must also be changed)
|
||||
mNdim = 0
|
||||
val0 = one
|
||||
do k = 1, n
|
||||
if (small < abs(mRho(k))) then
|
||||
if ( ONE <= abs(mRho(k))) then
|
||||
! rho(k) == 1
|
||||
isSingular = .TRUE.
|
||||
elseif ((-mINFINITY < a(k)) .OR. (b(k) < mINFINITY)) then
|
||||
mNdim = mNdim + 1
|
||||
mA(mNdim) = a(k) / mDen(k)
|
||||
mB(mNdim) = b(k) / mDen(k)
|
||||
mRho(mNdim) = mRho(k) / mDen(k)
|
||||
mDen(mNdim) = mDen(k)
|
||||
endif
|
||||
else ! independent variables which are evaluated separately
|
||||
val0 = val0 * ( FI( b(k) ) - FI( a(k) ) )
|
||||
endif
|
||||
enddo
|
||||
CALL GetTruncationError(zlo, zup, As, Bs, truncError)
|
||||
select case(mNdim)
|
||||
case (0)
|
||||
if (isSingular) then
|
||||
prb = ( FI( zup ) - FI( zlo ) ) * val0
|
||||
abserr = sqrt(small) + truncError
|
||||
else
|
||||
prb = val0;
|
||||
abserr = small+truncError;
|
||||
endif
|
||||
goto 999 ! end program
|
||||
case (1)
|
||||
if (.not.isSingular) then
|
||||
prb = (FI(mB(1)*mDen(1))-FI(mA(1)*mDen(1))) * val0
|
||||
abserr = small + truncError
|
||||
goto 999 ! end program
|
||||
endif
|
||||
end select
|
||||
if (small < val0) then
|
||||
isLimitsNarrowed = ((-7.D0 < zlo) .or. (zup < 7.D0))
|
||||
Npts = 0
|
||||
if (isLimitsNarrowed.AND.useBreakPoints) then
|
||||
! Provide abscissas for break points
|
||||
CALL GetBreakPoints(zlo,zup,mNdim,mA,mB,mRho,mDen,
|
||||
& breakPoints,Npts)
|
||||
endif
|
||||
LTol = LTol - truncError
|
||||
!
|
||||
if (useSimpson) then
|
||||
call AdaptiveSimpson(integrand,zlo,zup,Npts,breakPoints,LTol
|
||||
& ,errFlg,abserr, val)
|
||||
! call Romberg(integrand,zlo,zup,Npts
|
||||
! $ ,breakPoints,LTol,errFlg,abserr, val)
|
||||
! call AdaptiveIntWithBreaks(integrand,zlo,zup,Npts
|
||||
! $ ,breakPoints,LTol,errFlg,abserr, val)
|
||||
else
|
||||
! CALL IMSL
|
||||
! k = 1 ! integration rule
|
||||
! CALL DQDAG(integrand,zlo, zup, LTol, zero, k,
|
||||
! & val,abserr)
|
||||
! CALL DQDAGP (integrand, zlo, zup, Npts, breakPoints,
|
||||
! & LTol, zero, val,abserr)
|
||||
! call AdaptiveIntWithBreaks(integrand,zlo,zup,Npts
|
||||
! $ ,breakPoints,LTol,errFlg,abserr, val)
|
||||
limit = 100
|
||||
call dqagp(integrand,zlo,zup,Npts,breakPoints,LTol,zero,
|
||||
& limit,val,abserr,neval,errFlg)
|
||||
! call AdaptiveTrapz(integrand,zlo,zup,Npts,breakPoints,LTol
|
||||
! & ,errFlg,abserr, val)
|
||||
endif
|
||||
prb = val * val0;
|
||||
abserr = (abserr + truncError)* val0;
|
||||
else
|
||||
prb = zero
|
||||
abserr = small + truncError
|
||||
endif
|
||||
|
||||
999 continue
|
||||
if (allocated(mDen)) deallocate(mDen)
|
||||
if (allocated(mA)) deallocate(mA,mB,mRho)
|
||||
return
|
||||
end subroutine mvnprodcorrprb
|
||||
|
||||
subroutine GetTruncationError(zlo, zup, As, Bs, truncError)
|
||||
double precision, intent(in) :: zlo, zup, As, Bs
|
||||
double precision, intent(out) :: truncError
|
||||
double precision :: upError,loError
|
||||
! Computes the upper bound for the truncation error
|
||||
upError = integrand1(zup) * abs( FI( Bs ) - FI( zup ) )
|
||||
loError = integrand1(zlo) * abs( FI( zlo ) - FI( As ) )
|
||||
truncError = loError + upError
|
||||
end subroutine GetTruncationError
|
||||
|
||||
subroutine GetBreakPoints(xlo,xup,n,a,b,rho,den,
|
||||
& breakPoints,Npts)
|
||||
implicit none
|
||||
double precision, intent(in) :: xlo, xup
|
||||
double precision,dimension(:), intent(in) :: a,b, rho,den
|
||||
integer, intent(in) :: n
|
||||
double precision,dimension(:), intent(inout) :: breakPoints
|
||||
integer, intent(inout) :: Npts
|
||||
! Locals
|
||||
integer, dimension(2*n) :: indices
|
||||
integer, dimension(4*n) :: indices2
|
||||
double precision, dimension(2*n) :: brkPts
|
||||
double precision, dimension(4*n) :: brkPtsVal
|
||||
double precision, parameter :: zero = 0.0D0, brkSplit = 2.5D0
|
||||
double precision, parameter :: stepSize = 0.24
|
||||
double precision :: brk,brk1,hMin,distance, xLow, dx
|
||||
double precision :: z1, z2, val1,val2
|
||||
integer :: j,k, kL,kU , Nprev, Nk
|
||||
hMin = 1.0D-5
|
||||
kL = 0
|
||||
Npts = 0
|
||||
if (.false.) then
|
||||
if (xup-xlo>stepSize) then
|
||||
Nk = floor((xup-xlo)/stepSize) + 1
|
||||
dx = (xup-xlo)/dble(Nk)
|
||||
do j=1, Nk -1
|
||||
Npts = Npts + 1
|
||||
breakPoints(Npts) = xlo + dx * dble( j )
|
||||
enddo
|
||||
endif
|
||||
else
|
||||
! Compute candidates for the breakpoints
|
||||
brkPts(1:2*n) = xup
|
||||
forall(k=1:n,rho(k) .ne. zero)
|
||||
indices(2*k-1) = k
|
||||
indices(2*k ) = k
|
||||
brkPts(2*k-1) = a(k)/rho(k)
|
||||
brkPts(2*k ) = b(k)/rho(k)
|
||||
end forall
|
||||
! Sort the candidates
|
||||
call sortre(brkPts,indices)
|
||||
! Make unique list of breakpoints
|
||||
|
||||
do k = 1,2*n
|
||||
brk = brkPts(k)
|
||||
if (xlo < brk) then
|
||||
if ( xup <= brk ) exit ! terminate do loop
|
||||
|
||||
! if (Npts>0) then
|
||||
! xLow = max(xlo, breakPoints(Npts))
|
||||
! else
|
||||
! xLow = xlo
|
||||
! endif
|
||||
! if (brk-xLow>stepSize) then
|
||||
! Nk = floor((brk-xLow)/stepSize)
|
||||
! dx = (brk-xLow)/dble(Nk)
|
||||
! do j=1, Nk -1
|
||||
! Npts = Npts + 1
|
||||
! breakPoints(Npts) = brk + dx * dble( j )
|
||||
! enddo
|
||||
! endif
|
||||
|
||||
kU = indices(k)
|
||||
|
||||
!if ( xlo + distance < brk .and. brk + distance < xup )
|
||||
!then
|
||||
if ( den(kU) < 0.2) then
|
||||
distance = max(brkSplit*den(kU),hMin)
|
||||
z1 = brk + distance
|
||||
z2 = brk - distance
|
||||
if (Npts <= 0) then
|
||||
if (xlo + distance < z1) then
|
||||
Npts = Npts + 1
|
||||
breakPoints(Npts) = z1
|
||||
brkPtsVal(Npts) = integrand(z1)
|
||||
indices2(Npts) = kU
|
||||
endif
|
||||
! Nprev = Nprev + 1
|
||||
! breakPoints(Npts + Nprev) = brk
|
||||
if ( z2 + distance < xup) then
|
||||
Npts = Npts + 1
|
||||
breakPoints(Npts) = z2
|
||||
brkPtsVal(Npts) = integrand(z2)
|
||||
indices2(Npts) = kU
|
||||
endif
|
||||
kL = kU
|
||||
elseif (breakPoints(Npts)+ max(distance
|
||||
& ,brkSplit*den(kL)) < z1) then
|
||||
if (breakPoints(Npts) + distance < z1) then
|
||||
Npts = Npts + 1
|
||||
breakPoints(Npts) = z1
|
||||
brkPtsVal(Npts) = integrand(z1)
|
||||
indices2(Npts) = kU
|
||||
kL = kU
|
||||
endif
|
||||
! Nprev = Nprev + 1
|
||||
! breakPoints(Npts + Nprev) = brk
|
||||
if ( z2 + distance < xup) then
|
||||
Npts = Npts + 1
|
||||
breakPoints(Npts) = z2
|
||||
brkPtsVal(Npts) = integrand(z2)
|
||||
indices2(Npts) = kU
|
||||
kL = kU
|
||||
endif
|
||||
else
|
||||
val1 = 0.0d0
|
||||
val2 = 0.0d0
|
||||
brkPts(Npts+1) = integrand(z1)
|
||||
brkPts(Npts+2) = integrand(z2)
|
||||
if ((xlo+ distance < z1) .and. (z1 + distance < xup))
|
||||
& val2 = brkPts(Npts +1)
|
||||
if ((xlo+ distance < z2) .and. (z2 + distance < xup))
|
||||
& val2 = max(val2,brkPts(Npts +2))
|
||||
val1 = breakPoints(Npts)
|
||||
Nprev = 1
|
||||
if (Npts>1) then
|
||||
if (indices2(Npts-1)==kL) then
|
||||
Nprev = 2
|
||||
val1 = max(val1,breakPoints(Npts-1))
|
||||
endif
|
||||
endif
|
||||
if (val1 < val2) then
|
||||
!overwrite previous candidate
|
||||
Npts = Npts - Nprev
|
||||
if (Npts>0) then
|
||||
val1 = breakPoints(Npts)+ distance
|
||||
else
|
||||
val1 = xlo+ distance
|
||||
endif
|
||||
if (val1 < z1) then
|
||||
Npts = Npts + 1
|
||||
breakPoints(Npts) = z1
|
||||
brkPtsVal(Npts) = brkPtsVal(Npts+Nprev)
|
||||
indices2(Npts) = kU
|
||||
endif
|
||||
! Nprev = Nprev + 1
|
||||
! breakPoints(Npts + Nprev) = brk
|
||||
|
||||
if ((val1< z2) .and. (z2 + distance < xup)) then
|
||||
Npts = Npts + 1
|
||||
breakPoints(Npts) = z2
|
||||
brkPtsVal(Npts) = integrand(z2)
|
||||
indices2(Npts) = kU
|
||||
endif
|
||||
if (Npts>0) kL = indices2(Npts)
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
end subroutine GetBreakPoints
|
||||
subroutine NarrowLimits(zMin,zMax,As,Bs,zCutOff,n,a,b,rho,den)
|
||||
implicit none
|
||||
double precision, intent(inout) :: zMin, zMax, As, Bs
|
||||
double precision,dimension(*),intent(in) :: rho,a,b,den
|
||||
double precision, intent(in) :: zCutOff
|
||||
integer, intent(in) :: n
|
||||
! Locals
|
||||
double precision, parameter :: zero = 0.0D0, one = 1.0D0
|
||||
integer :: k
|
||||
|
||||
! Uses the regression equation to limit the
|
||||
! integration limits zMin and zMax
|
||||
|
||||
do k = 1,n
|
||||
if (ZERO < rho(k)) then
|
||||
zMax = max(zMin, min(zMax,(b(k)+den(k)*zCutOff)/rho(k)))
|
||||
zMin = min(zMax, max(zMin,(a(k)-den(k)*zCutOff)/rho(k)))
|
||||
if ( one <= rho(k) ) then
|
||||
if ( b(k) < Bs ) Bs = b(k)
|
||||
if ( As < a(k) ) As = a(k)
|
||||
endif
|
||||
elseif (rho(k)< ZERO) then
|
||||
zMax = max(zMin,min(zMax,(a(k)-den(k)*zCutOff)/rho(k)))
|
||||
zMin = min(zMax,max(zMin,(b(k)+den(k)*zCutOff)/rho(k)))
|
||||
if ( rho(k) <= -one ) then
|
||||
if ( -a(k) < Bs ) Bs = -a(k)
|
||||
if ( As < -b(k) ) As = -b(k)
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
As = min(As,Bs)
|
||||
end subroutine NarrowLimits
|
||||
|
||||
function integrand(z) result (val)
|
||||
implicit none
|
||||
DOUBLE PRECISION, INTENT(IN) :: Z
|
||||
DOUBLE PRECISION :: VAL
|
||||
double precision, parameter :: sqtwopi1 = 0.39894228040143D0
|
||||
double precision, parameter :: half = 0.5D0
|
||||
val = sqtwopi1 * exp(-half * z * z) * integrand1(z)
|
||||
return
|
||||
end function integrand
|
||||
|
||||
function integrand1(z) result (val)
|
||||
implicit none
|
||||
double precision, intent(in) :: z
|
||||
double precision :: val
|
||||
double precision :: xUp,xLo,zRho
|
||||
double precision, parameter :: one = 1.0D0, zero = 0.0D0
|
||||
integer :: I
|
||||
val = one
|
||||
do I = 1, mNdim
|
||||
zRho = z * mRho(I)
|
||||
! Uncomment / mDen below if mRho, mA, mB is not scaled
|
||||
xUp = ( mB(I) - zRho ) !/ mDen(I)
|
||||
xLo = ( mA(I) - zRho ) !/ mDen(I)
|
||||
if (zero<xLo) then
|
||||
val = val * ( FI( -xLo ) - FI( -xUp ) )
|
||||
else
|
||||
val = val * ( FI( xUp ) - FI( xLo ) )
|
||||
endif
|
||||
enddo
|
||||
end function integrand1
|
||||
FUNCTION FIINV(P) RESULT (VAL)
|
||||
IMPLICIT NONE
|
||||
*
|
||||
* ALGORITHM AS241 APPL. STATIST. (1988) VOL. 37, NO. 3
|
||||
*
|
||||
* Produces the normal deviate Z corresponding to a given lower
|
||||
* tail area of P.
|
||||
* Absolute error less than 1e-13
|
||||
* Relative error less than 1e-15 for abs(VAL)>0.1
|
||||
*
|
||||
* The hash sums below are the sums of the mantissas of the
|
||||
* coefficients. They are included for use in checking
|
||||
* transcription.
|
||||
*
|
||||
DOUBLE PRECISION, INTENT(in) :: P
|
||||
DOUBLE PRECISION :: VAL
|
||||
!local variables
|
||||
DOUBLE PRECISION SPLIT1, SPLIT2, CONST1, CONST2, ONE, ZERO, HALF,
|
||||
& A0, A1, A2, A3, A4, A5, A6, A7, B1, B2, B3, B4, B5, B6, B7,
|
||||
& C0, C1, C2, C3, C4, C5, C6, C7, D1, D2, D3, D4, D5, D6, D7,
|
||||
& E0, E1, E2, E3, E4, E5, E6, E7, F1, F2, F3, F4, F5, F6, F7,
|
||||
& Q, R
|
||||
PARAMETER ( SPLIT1 = 0.425D0, SPLIT2 = 5.D0,
|
||||
& CONST1 = 0.180625D0, CONST2 = 1.6D0,
|
||||
& ONE = 1.D0, ZERO = 0.D0, HALF = 0.5D0 )
|
||||
*
|
||||
* Coefficients for P close to 0.5
|
||||
*
|
||||
PARAMETER (
|
||||
* A0 = 3.38713 28727 96366 6080D0,
|
||||
* A1 = 1.33141 66789 17843 7745D+2,
|
||||
* A2 = 1.97159 09503 06551 4427D+3,
|
||||
* A3 = 1.37316 93765 50946 1125D+4,
|
||||
* A4 = 4.59219 53931 54987 1457D+4,
|
||||
* A5 = 6.72657 70927 00870 0853D+4,
|
||||
* A6 = 3.34305 75583 58812 8105D+4,
|
||||
* A7 = 2.50908 09287 30122 6727D+3,
|
||||
* B1 = 4.23133 30701 60091 1252D+1,
|
||||
* B2 = 6.87187 00749 20579 0830D+2,
|
||||
* B3 = 5.39419 60214 24751 1077D+3,
|
||||
* B4 = 2.12137 94301 58659 5867D+4,
|
||||
* B5 = 3.93078 95800 09271 0610D+4,
|
||||
* B6 = 2.87290 85735 72194 2674D+4,
|
||||
* B7 = 5.22649 52788 52854 5610D+3 )
|
||||
* HASH SUM AB 55.88319 28806 14901 4439
|
||||
*
|
||||
* Coefficients for P not close to 0, 0.5 or 1.
|
||||
*
|
||||
PARAMETER (
|
||||
* C0 = 1.42343 71107 49683 57734D0,
|
||||
* C1 = 4.63033 78461 56545 29590D0,
|
||||
* C2 = 5.76949 72214 60691 40550D0,
|
||||
* C3 = 3.64784 83247 63204 60504D0,
|
||||
* C4 = 1.27045 82524 52368 38258D0,
|
||||
* C5 = 2.41780 72517 74506 11770D-1,
|
||||
* C6 = 2.27238 44989 26918 45833D-2,
|
||||
* C7 = 7.74545 01427 83414 07640D-4,
|
||||
* D1 = 2.05319 16266 37758 82187D0,
|
||||
* D2 = 1.67638 48301 83803 84940D0,
|
||||
* D3 = 6.89767 33498 51000 04550D-1,
|
||||
* D4 = 1.48103 97642 74800 74590D-1,
|
||||
* D5 = 1.51986 66563 61645 71966D-2,
|
||||
* D6 = 5.47593 80849 95344 94600D-4,
|
||||
* D7 = 1.05075 00716 44416 84324D-9 )
|
||||
* HASH SUM CD 49.33206 50330 16102 89036
|
||||
*
|
||||
* Coefficients for P near 0 or 1.
|
||||
*
|
||||
PARAMETER (
|
||||
* E0 = 6.65790 46435 01103 77720D0,
|
||||
* E1 = 5.46378 49111 64114 36990D0,
|
||||
* E2 = 1.78482 65399 17291 33580D0,
|
||||
* E3 = 2.96560 57182 85048 91230D-1,
|
||||
* E4 = 2.65321 89526 57612 30930D-2,
|
||||
* E5 = 1.24266 09473 88078 43860D-3,
|
||||
* E6 = 2.71155 55687 43487 57815D-5,
|
||||
* E7 = 2.01033 43992 92288 13265D-7,
|
||||
* F1 = 5.99832 20655 58879 37690D-1,
|
||||
* F2 = 1.36929 88092 27358 05310D-1,
|
||||
* F3 = 1.48753 61290 85061 48525D-2,
|
||||
* F4 = 7.86869 13114 56132 59100D-4,
|
||||
* F5 = 1.84631 83175 10054 68180D-5,
|
||||
* F6 = 1.42151 17583 16445 88870D-7,
|
||||
* F7 = 2.04426 31033 89939 78564D-15 )
|
||||
* HASH SUM EF 47.52583 31754 92896 71629
|
||||
*
|
||||
Q = ( P - HALF)
|
||||
IF ( ABS(Q) .LE. SPLIT1 ) THEN ! Central range.
|
||||
R = CONST1 - Q*Q
|
||||
VAL = Q*( ( ( ((((A7*R + A6)*R + A5)*R + A4)*R + A3)
|
||||
* *R + A2 )*R + A1 )*R + A0 )
|
||||
* /( ( ( ((((B7*R + B6)*R + B5)*R + B4)*R + B3)
|
||||
* *R + B2 )*R + B1 )*R + ONE)
|
||||
ELSE ! near the endpoints
|
||||
R = MIN( P, ONE - P )
|
||||
IF (R .GT.ZERO) THEN ! ( 2.d0*R .GT. CFxCutOff) THEN ! R .GT.0.d0
|
||||
R = SQRT( -LOG(R) )
|
||||
IF ( R .LE. SPLIT2 ) THEN
|
||||
R = R - CONST2
|
||||
VAL = ( ( ( ((((C7*R + C6)*R + C5)*R + C4)*R + C3)
|
||||
* *R + C2 )*R + C1 )*R + C0 )
|
||||
* /( ( ( ((((D7*R + D6)*R + D5)*R + D4)*R + D3)
|
||||
* *R + D2 )*R + D1 )*R + ONE )
|
||||
ELSE
|
||||
R = R - SPLIT2
|
||||
VAL = ( ( ( ((((E7*R + E6)*R + E5)*R + E4)*R + E3)
|
||||
* *R + E2 )*R + E1 )*R + E0 )
|
||||
* /( ( ( ((((F7*R + F6)*R + F5)*R + F4)*R + F3)
|
||||
* *R + F2 )*R + F1 )*R + ONE )
|
||||
END IF
|
||||
ELSE
|
||||
VAL = 37.D0 !XMAX 9.d0
|
||||
END IF
|
||||
IF ( Q < ZERO ) VAL = - VAL
|
||||
END IF
|
||||
RETURN
|
||||
END FUNCTION FIINV
|
||||
FUNCTION FI2( Z ) RESULT (VALUE)
|
||||
! USE GLOBALDATA, ONLY : XMAX
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(in) :: Z
|
||||
DOUBLE PRECISION :: VALUE
|
||||
*
|
||||
* Normal distribution probabilities accurate to 1.e-15.
|
||||
* relative error less than 1e-8;
|
||||
* Z = no. of standard deviations from the mean.
|
||||
*
|
||||
* Based upon algorithm 5666 for the error function, from:
|
||||
* Hart, J.F. et al, 'Computer Approximations', Wiley 1968
|
||||
*
|
||||
* Programmer: Alan Miller
|
||||
*
|
||||
* Latest revision - 30 March 1986
|
||||
*
|
||||
DOUBLE PRECISION :: P0, P1, P2, P3, P4, P5, P6,
|
||||
* Q0, Q1, Q2, Q3, Q4, Q5, Q6, Q7,XMAX,
|
||||
* P, EXPNTL, CUTOFF, ROOTPI, ZABS, Z2
|
||||
PARAMETER(
|
||||
* P0 = 220.20 68679 12376 1D0,
|
||||
* P1 = 221.21 35961 69931 1D0,
|
||||
* P2 = 112.07 92914 97870 9D0,
|
||||
* P3 = 33.912 86607 83830 0D0,
|
||||
* P4 = 6.3739 62203 53165 0D0,
|
||||
* P5 = 0.70038 30644 43688 1D0,
|
||||
* P6 = 0.035262 49659 98910 9D0 )
|
||||
PARAMETER(
|
||||
* Q0 = 440.41 37358 24752 2D0,
|
||||
* Q1 = 793.82 65125 19948 4D0,
|
||||
* Q2 = 637.33 36333 78831 1D0,
|
||||
* Q3 = 296.56 42487 79673 7D0,
|
||||
* Q4 = 86.780 73220 29460 8D0,
|
||||
* Q5 = 16.064 17757 92069 5D0,
|
||||
* Q6 = 1.7556 67163 18264 2D0,
|
||||
* Q7 = 0.088388 34764 83184 4D0 )
|
||||
PARAMETER( ROOTPI = 2.5066 28274 63100 1D0 )
|
||||
PARAMETER( CUTOFF = 7.0710 67811 86547 5D0 )
|
||||
PARAMETER( XMAX = 8.25D0 )
|
||||
*
|
||||
ZABS = ABS(Z)
|
||||
*
|
||||
* |Z| > 37 (or XMAX)
|
||||
*
|
||||
IF ( ZABS .GT. XMAX ) THEN
|
||||
P = 0.d0
|
||||
ELSE
|
||||
*
|
||||
* |Z| <= 37
|
||||
*
|
||||
Z2 = ZABS * ZABS
|
||||
EXPNTL = EXP( -Z2 * 0.5D0 )
|
||||
*
|
||||
* |Z| < CUTOFF = 10/SQRT(2)
|
||||
*
|
||||
IF ( ZABS < CUTOFF ) THEN
|
||||
P = EXPNTL*( (((((P6*ZABS + P5)*ZABS + P4)*ZABS + P3)*ZABS
|
||||
* + P2)*ZABS + P1)*ZABS + P0)/(((((((Q7*ZABS + Q6)*ZABS
|
||||
* + Q5)*ZABS + Q4)*ZABS + Q3)*ZABS + Q2)*ZABS + Q1)*ZABS
|
||||
* + Q0 )
|
||||
*
|
||||
* |Z| >= CUTOFF.
|
||||
*
|
||||
ELSE
|
||||
P = EXPNTL/( ZABS + 1.d0/( ZABS + 2.d0/( ZABS + 3.d0/( ZABS
|
||||
* + 4.d0/( ZABS + 0.65D0 ) ) ) ) )/ROOTPI
|
||||
END IF
|
||||
END IF
|
||||
IF ( Z .GT. 0.d0 ) P = 1.d0 - P
|
||||
VALUE = P
|
||||
RETURN
|
||||
END FUNCTION FI2
|
||||
|
||||
FUNCTION FI( Z ) RESULT (VALUE)
|
||||
USE ERFCOREMOD
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(in) :: Z
|
||||
DOUBLE PRECISION :: VALUE
|
||||
! Local variables
|
||||
DOUBLE PRECISION, PARAMETER:: SQ2M1 = 0.70710678118655D0 ! 1/SQRT(2)
|
||||
DOUBLE PRECISION, PARAMETER:: HALF = 0.5D0
|
||||
VALUE = DERFC(-Z*SQ2M1)*HALF
|
||||
RETURN
|
||||
END FUNCTION FI
|
||||
end module mvnProdCorrPrbMod
|
||||
@ -1,97 +0,0 @@
|
||||
# Microsoft Developer Studio Project File - Name="test_mvnprodcorrprb" - Package Owner=<4>
|
||||
# Microsoft Developer Studio Generated Build File, Format Version 6.00
|
||||
# ** DO NOT EDIT **
|
||||
|
||||
# TARGTYPE "Win32 (x86) Console Application" 0x0103
|
||||
|
||||
CFG=test_mvnprodcorrprb - Win32 Debug
|
||||
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
|
||||
!MESSAGE use the Export Makefile command and run
|
||||
!MESSAGE
|
||||
!MESSAGE NMAKE /f "test_mvnprodcorrprb.mak".
|
||||
!MESSAGE
|
||||
!MESSAGE You can specify a configuration when running NMAKE
|
||||
!MESSAGE by defining the macro CFG on the command line. For example:
|
||||
!MESSAGE
|
||||
!MESSAGE NMAKE /f "test_mvnprodcorrprb.mak" CFG="test_mvnprodcorrprb - Win32 Debug"
|
||||
!MESSAGE
|
||||
!MESSAGE Possible choices for configuration are:
|
||||
!MESSAGE
|
||||
!MESSAGE "test_mvnprodcorrprb - Win32 Release" (based on "Win32 (x86) Console Application")
|
||||
!MESSAGE "test_mvnprodcorrprb - Win32 Debug" (based on "Win32 (x86) Console Application")
|
||||
!MESSAGE
|
||||
|
||||
# Begin Project
|
||||
# PROP AllowPerConfigDependencies 0
|
||||
# PROP Scc_ProjName ""
|
||||
# PROP Scc_LocalPath ""
|
||||
CPP=cl.exe
|
||||
F90=df.exe
|
||||
RSC=rc.exe
|
||||
|
||||
!IF "$(CFG)" == "test_mvnprodcorrprb - Win32 Release"
|
||||
|
||||
# PROP BASE Use_MFC 0
|
||||
# PROP BASE Use_Debug_Libraries 0
|
||||
# PROP BASE Output_Dir "Release"
|
||||
# PROP BASE Intermediate_Dir "Release"
|
||||
# PROP BASE Target_Dir ""
|
||||
# PROP Use_MFC 0
|
||||
# PROP Use_Debug_Libraries 0
|
||||
# PROP Output_Dir "Release"
|
||||
# PROP Intermediate_Dir "Release"
|
||||
# PROP Target_Dir ""
|
||||
# ADD BASE F90 /compile_only /nologo /warn:nofileopt
|
||||
# ADD F90 /compile_only /nologo /warn:nofileopt
|
||||
# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
|
||||
# ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
|
||||
# ADD BASE RSC /l 0x414 /d "NDEBUG"
|
||||
# ADD RSC /l 0x414 /d "NDEBUG"
|
||||
BSC32=bscmake.exe
|
||||
# ADD BASE BSC32 /nologo
|
||||
# ADD BSC32 /nologo
|
||||
LINK32=link.exe
|
||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
||||
|
||||
!ELSEIF "$(CFG)" == "test_mvnprodcorrprb - Win32 Debug"
|
||||
|
||||
# PROP BASE Use_MFC 0
|
||||
# PROP BASE Use_Debug_Libraries 1
|
||||
# PROP BASE Output_Dir "Debug"
|
||||
# PROP BASE Intermediate_Dir "Debug"
|
||||
# PROP BASE Target_Dir ""
|
||||
# PROP Use_MFC 0
|
||||
# PROP Use_Debug_Libraries 1
|
||||
# PROP Output_Dir "Debug"
|
||||
# PROP Intermediate_Dir "Debug"
|
||||
# PROP Target_Dir ""
|
||||
# ADD BASE F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
|
||||
# ADD F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
|
||||
# ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
|
||||
# ADD CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
|
||||
# ADD BASE RSC /l 0x414 /d "_DEBUG"
|
||||
# ADD RSC /l 0x414 /d "_DEBUG"
|
||||
BSC32=bscmake.exe
|
||||
# ADD BASE BSC32 /nologo
|
||||
# ADD BSC32 /nologo
|
||||
LINK32=link.exe
|
||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
|
||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
|
||||
|
||||
!ENDIF
|
||||
|
||||
# Begin Target
|
||||
|
||||
# Name "test_mvnprodcorrprb - Win32 Release"
|
||||
# Name "test_mvnprodcorrprb - Win32 Debug"
|
||||
# Begin Source File
|
||||
|
||||
SOURCE=.\mvnprodcorrprb.f
|
||||
# End Source File
|
||||
# Begin Source File
|
||||
|
||||
SOURCE=.\test_mvnprodcorrprb.f
|
||||
# End Source File
|
||||
# End Target
|
||||
# End Project
|
||||
@ -1,29 +0,0 @@
|
||||
Microsoft Developer Studio Workspace File, Format Version 6.00
|
||||
# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
|
||||
|
||||
###############################################################################
|
||||
|
||||
Project: "test_mvnprodcorrprb"=.\test_mvnprodcorrprb.dsp - Package Owner=<4>
|
||||
|
||||
Package=<5>
|
||||
{{{
|
||||
}}}
|
||||
|
||||
Package=<4>
|
||||
{{{
|
||||
}}}
|
||||
|
||||
###############################################################################
|
||||
|
||||
Global:
|
||||
|
||||
Package=<5>
|
||||
{{{
|
||||
}}}
|
||||
|
||||
Package=<3>
|
||||
{{{
|
||||
}}}
|
||||
|
||||
###############################################################################
|
||||
|
||||
@ -1,39 +0,0 @@
|
||||
program mvn
|
||||
C gfortran -fPIC -c mvnprodcorrprb.f
|
||||
C f2py -m mvnprdmod -c mvnprodcorrprb.o mvnprodcorrprb_interface.f --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71
|
||||
|
||||
C module mvnprdmod
|
||||
C contains
|
||||
|
||||
use mvnProdCorrPrbMod, ONLY : mvnprodcorrprb
|
||||
integer, parameter :: N = 2
|
||||
double precision,dimension(N) :: rho,a,b
|
||||
double precision :: abseps,releps
|
||||
logical :: useBreakPoints,useSimpson
|
||||
double precision :: abserr,prb
|
||||
integer :: IFT
|
||||
|
||||
Cf2py depend(rho) N
|
||||
Cf2py intent(hide) :: N = len(rho)
|
||||
Cf2py depend(N) a
|
||||
Cf2py depend(N) b
|
||||
abseps = 1.0e-3
|
||||
releps = 1.0e-3
|
||||
useBreakPoints = 1
|
||||
useSimpson = 1
|
||||
rho(:)=1.0/100000000
|
||||
a(:) = 0.0
|
||||
b(:) = 5.0
|
||||
|
||||
CALL mvnprodcorrprb(rho,a,b,abseps,releps,useBreakPoints,
|
||||
& useSimpson,abserr,IFT,prb)
|
||||
|
||||
print *, 'prb =', prb
|
||||
print *, 'rho =', rho
|
||||
print *, 'a =', a
|
||||
print *, 'b =', b
|
||||
|
||||
print *, 'abseps =', abseps
|
||||
print *, 'releps =', releps
|
||||
print *, 'abserr =', abserr
|
||||
end program
|
||||
@ -1,32 +0,0 @@
|
||||
'''
|
||||
python setup.py build_src build_ext --inplace
|
||||
|
||||
See also http://www.scipy.org/Cookbook/CompilingExtensionsOnWindowsWithMinGW
|
||||
'''
|
||||
|
||||
# File setup.py
|
||||
|
||||
|
||||
def compile_all():
|
||||
import os
|
||||
files = ['mvnprd', 'mvnprodcorrprb']
|
||||
compile1_format = 'gfortran -fPIC -c %s.f'
|
||||
for file_ in files:
|
||||
os.system(compile1_format % file_)
|
||||
file_objects = ['%s.o' % file_ for file_ in files]
|
||||
return file_objects
|
||||
|
||||
|
||||
def configuration(parent_package='', top_path=None):
|
||||
from numpy.distutils.misc_util import Configuration
|
||||
libs = compile_all()
|
||||
config = Configuration('', parent_package, top_path)
|
||||
|
||||
config.add_extension('mvnprdmod',
|
||||
libraries=libs,
|
||||
sources=['mvnprd_interface.f'])
|
||||
return config
|
||||
if __name__ == "__main__":
|
||||
|
||||
from numpy.distutils.core import setup
|
||||
setup(**configuration(top_path='').todict())
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,524 +0,0 @@
|
||||
C $ f2py -m erfcore -h erfcore.pyf erfcore.f
|
||||
C f2py erfcore.pyf erfcore.f -c --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71
|
||||
C $ f2py --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71 -m erfcore -c erfcore.f
|
||||
C
|
||||
C--------------------------------------------------------------------
|
||||
C
|
||||
C DERF subprogram computes approximate values for erf(x).
|
||||
C (see comments heading CALERF).
|
||||
C
|
||||
C Author/date: W. J. Cody, January 8, 1985
|
||||
C
|
||||
C--------------------------------------------------------------------
|
||||
FUNCTION DERF( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 0
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERF
|
||||
C--------------------------------------------------------------------
|
||||
C
|
||||
C DERFC subprogram computes approximate values for erfc(x).
|
||||
C (see comments heading CALERF).
|
||||
C
|
||||
C Author/date: W. J. Cody, January 8, 1985
|
||||
C
|
||||
C--------------------------------------------------------------------
|
||||
FUNCTION DERFC( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 1
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERFC
|
||||
C------------------------------------------------------------------
|
||||
C
|
||||
C DERFCX subprogram computes approximate values for exp(x*x) * erfc(x).
|
||||
C (see comments heading CALERF).
|
||||
C
|
||||
C Author/date: W. J. Cody, March 30, 1987
|
||||
C
|
||||
C------------------------------------------------------------------
|
||||
FUNCTION DERFCX( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 2
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERFCX
|
||||
|
||||
SUBROUTINE CALERF(ARG,RESULT,JINT)
|
||||
IMPLICIT NONE
|
||||
C------------------------------------------------------------------
|
||||
C
|
||||
C CALERF packet evaluates erf(x), erfc(x), and exp(x*x)*erfc(x)
|
||||
C for a real argument x. It contains three FUNCTION type
|
||||
C subprograms: ERF, ERFC, and ERFCX (or DERF, DERFC, and DERFCX),
|
||||
C and one SUBROUTINE type subprogram, CALERF. The calling
|
||||
C statements for the primary entries are:
|
||||
C
|
||||
C Y=ERF(X) (or Y=DERF(X)),
|
||||
C
|
||||
C Y=ERFC(X) (or Y=DERFC(X)),
|
||||
C and
|
||||
C Y=ERFCX(X) (or Y=DERFCX(X)).
|
||||
C
|
||||
C The routine CALERF is intended for internal packet use only,
|
||||
C all computations within the packet being concentrated in this
|
||||
C routine. The function subprograms invoke CALERF with the
|
||||
C statement
|
||||
C
|
||||
C CALL CALERF(ARG,RESULT,JINT)
|
||||
C
|
||||
C where the parameter usage is as follows
|
||||
C
|
||||
C Function Parameters for CALERF
|
||||
C call ARG Result JINT
|
||||
C
|
||||
C ERF(ARG) ANY REAL ARGUMENT ERF(ARG) 0
|
||||
C ERFC(ARG) ABS(ARG) .LT. XBIG ERFC(ARG) 1
|
||||
C ERFCX(ARG) XNEG .LT. ARG .LT. XMAX ERFCX(ARG) 2
|
||||
C
|
||||
C The main computation evaluates near-minimax approximations
|
||||
C from "Rational Chebyshev approximations for the error function"
|
||||
C by W. J. Cody, Math. Comp., 1969, PP. 631-638. This
|
||||
C transportable program uses rational functions that theoretically
|
||||
C approximate erf(x) and erfc(x) to at least 18 significant
|
||||
C decimal digits. The accuracy achieved depends on the arithmetic
|
||||
C system, the compiler, the intrinsic functions, and proper
|
||||
C selection of the machine-dependent constants.
|
||||
C
|
||||
C*******************************************************************
|
||||
C*******************************************************************
|
||||
C
|
||||
C Explanation of machine-dependent constants
|
||||
C
|
||||
C XMIN = the smallest positive floating-point number.
|
||||
C XINF = the largest positive finite floating-point number.
|
||||
C XNEG = the largest negative argument acceptable to ERFCX;
|
||||
C the negative of the solution to the equation
|
||||
C 2*exp(x*x) = XINF.
|
||||
C XSMALL = argument below which erf(x) may be represented by
|
||||
C 2*x/sqrt(pi) and above which x*x will not underflow.
|
||||
C A conservative value is the largest machine number X
|
||||
C such that 1.0 + X = 1.0 to machine precision.
|
||||
C XBIG = largest argument acceptable to ERFC; solution to
|
||||
C the equation: W(x) * (1-0.5/x**2) = XMIN, where
|
||||
C W(x) = exp(-x*x)/[x*sqrt(pi)].
|
||||
C XHUGE = argument above which 1.0 - 1/(2*x*x) = 1.0 to
|
||||
C machine precision. A conservative value is
|
||||
C 1/[2*sqrt(XSMALL)]
|
||||
C XMAX = largest acceptable argument to ERFCX; the minimum
|
||||
C of XINF and 1/[sqrt(pi)*XMIN].
|
||||
C
|
||||
C Approximate values for some important machines are:
|
||||
C
|
||||
C XMIN XINF XNEG XSMALL
|
||||
C
|
||||
C C 7600 (S.P.) 3.13E-294 1.26E+322 -27.220 7.11E-15
|
||||
C CRAY-1 (S.P.) 4.58E-2467 5.45E+2465 -75.345 7.11E-15
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (S.P.) 1.18E-38 3.40E+38 -9.382 5.96E-8
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (D.P.) 2.23D-308 1.79D+308 -26.628 1.11D-16
|
||||
C IBM 195 (D.P.) 5.40D-79 7.23E+75 -13.190 1.39D-17
|
||||
C UNIVAC 1108 (D.P.) 2.78D-309 8.98D+307 -26.615 1.73D-18
|
||||
C VAX D-Format (D.P.) 2.94D-39 1.70D+38 -9.345 1.39D-17
|
||||
C VAX G-Format (D.P.) 5.56D-309 8.98D+307 -26.615 1.11D-16
|
||||
C
|
||||
C
|
||||
C XBIG XHUGE XMAX
|
||||
C
|
||||
C C 7600 (S.P.) 25.922 8.39E+6 1.80X+293
|
||||
C CRAY-1 (S.P.) 75.326 8.39E+6 5.45E+2465
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (S.P.) 9.194 2.90E+3 4.79E+37
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (D.P.) 26.543 6.71D+7 2.53D+307
|
||||
C IBM 195 (D.P.) 13.306 1.90D+8 7.23E+75
|
||||
C UNIVAC 1108 (D.P.) 26.582 5.37D+8 8.98D+307
|
||||
C VAX D-Format (D.P.) 9.269 1.90D+8 1.70D+38
|
||||
C VAX G-Format (D.P.) 26.569 6.71D+7 8.98D+307
|
||||
C
|
||||
C*******************************************************************
|
||||
C*******************************************************************
|
||||
C
|
||||
C Error returns
|
||||
C
|
||||
C The program returns ERFC = 0 for ARG .GE. XBIG;
|
||||
C
|
||||
C ERFCX = XINF for ARG .LT. XNEG;
|
||||
C and
|
||||
C ERFCX = 0 for ARG .GE. XMAX.
|
||||
C
|
||||
C
|
||||
C Intrinsic functions required are:
|
||||
C
|
||||
C ABS, AINT, EXP
|
||||
C
|
||||
C
|
||||
C Author: W. J. Cody
|
||||
C Mathematics and Computer Science Division
|
||||
C Argonne National Laboratory
|
||||
C Argonne, IL 60439
|
||||
C
|
||||
C Latest modification: March 19, 1990
|
||||
C Updated to F90 by pab 23.03.2003
|
||||
C
|
||||
C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, INTENT(IN) :: ARG
|
||||
INTEGER, INTENT(IN) :: JINT
|
||||
DOUBLE PRECISION, INTENT(INOUT):: RESULT
|
||||
! Local variables
|
||||
INTEGER :: I
|
||||
DOUBLE PRECISION :: DEL,X,XDEN,XNUM,Y,YSQ
|
||||
C------------------------------------------------------------------
|
||||
C Mathematical constants
|
||||
C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, PARAMETER :: ZERO = 0.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: HALF = 0.05D0
|
||||
DOUBLE PRECISION, PARAMETER :: ONE = 1.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: TWO = 2.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: FOUR = 4.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: SIXTEN = 16.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: SQRPI = 5.6418958354775628695D-1
|
||||
DOUBLE PRECISION, PARAMETER :: THRESH = 0.46875D0
|
||||
C------------------------------------------------------------------
|
||||
C Machine-dependent constants
|
||||
C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, PARAMETER :: XNEG = -26.628D0
|
||||
DOUBLE PRECISION, PARAMETER :: XSMALL = 1.11D-16
|
||||
DOUBLE PRECISION, PARAMETER :: XBIG = 26.543D0
|
||||
DOUBLE PRECISION, PARAMETER :: XHUGE = 6.71D7
|
||||
DOUBLE PRECISION, PARAMETER :: XMAX = 2.53D307
|
||||
DOUBLE PRECISION, PARAMETER :: XINF = 1.79D308
|
||||
!---------------------------------------------------------------
|
||||
! Coefficents to the rational polynomials
|
||||
!--------------------------------------------------------------
|
||||
DOUBLE PRECISION, DIMENSION(5) :: A, Q
|
||||
DOUBLE PRECISION, DIMENSION(4) :: B
|
||||
DOUBLE PRECISION, DIMENSION(9) :: C
|
||||
DOUBLE PRECISION, DIMENSION(8) :: D
|
||||
DOUBLE PRECISION, DIMENSION(6) :: P
|
||||
C------------------------------------------------------------------
|
||||
C Coefficients for approximation to erf in first interval
|
||||
C------------------------------------------------------------------
|
||||
PARAMETER (A = (/ 3.16112374387056560D00,
|
||||
& 1.13864154151050156D02,3.77485237685302021D02,
|
||||
& 3.20937758913846947D03, 1.85777706184603153D-1/))
|
||||
PARAMETER ( B = (/2.36012909523441209D01,2.44024637934444173D02,
|
||||
& 1.28261652607737228D03,2.84423683343917062D03/))
|
||||
C------------------------------------------------------------------
|
||||
C Coefficients for approximation to erfc in second interval
|
||||
C------------------------------------------------------------------
|
||||
PARAMETER ( C=(/5.64188496988670089D-1,8.88314979438837594D0,
|
||||
1 6.61191906371416295D01,2.98635138197400131D02,
|
||||
2 8.81952221241769090D02,1.71204761263407058D03,
|
||||
3 2.05107837782607147D03,1.23033935479799725D03,
|
||||
4 2.15311535474403846D-8/))
|
||||
PARAMETER ( D =(/1.57449261107098347D01,1.17693950891312499D02,
|
||||
1 5.37181101862009858D02,1.62138957456669019D03,
|
||||
2 3.29079923573345963D03,4.36261909014324716D03,
|
||||
3 3.43936767414372164D03,1.23033935480374942D03/))
|
||||
C------------------------------------------------------------------
|
||||
C Coefficients for approximation to erfc in third interval
|
||||
C------------------------------------------------------------------
|
||||
PARAMETER ( P =(/3.05326634961232344D-1,3.60344899949804439D-1,
|
||||
1 1.25781726111229246D-1,1.60837851487422766D-2,
|
||||
2 6.58749161529837803D-4,1.63153871373020978D-2/))
|
||||
PARAMETER (Q =(/2.56852019228982242D00,1.87295284992346047D00,
|
||||
1 5.27905102951428412D-1,6.05183413124413191D-2,
|
||||
2 2.33520497626869185D-3/))
|
||||
C------------------------------------------------------------------
|
||||
X = ARG
|
||||
Y = ABS(X)
|
||||
IF (Y .LE. THRESH) THEN
|
||||
C------------------------------------------------------------------
|
||||
C Evaluate erf for |X| <= 0.46875
|
||||
C------------------------------------------------------------------
|
||||
!YSQ = ZERO
|
||||
IF (Y .GT. XSMALL) THEN
|
||||
YSQ = Y * Y
|
||||
XNUM = A(5)*YSQ
|
||||
XDEN = YSQ
|
||||
DO I = 1, 3
|
||||
XNUM = (XNUM + A(I)) * YSQ
|
||||
XDEN = (XDEN + B(I)) * YSQ
|
||||
END DO
|
||||
RESULT = X * (XNUM + A(4)) / (XDEN + B(4))
|
||||
ELSE
|
||||
RESULT = X * A(4) / B(4)
|
||||
ENDIF
|
||||
IF (JINT .NE. 0) RESULT = ONE - RESULT
|
||||
IF (JINT .EQ. 2) RESULT = EXP(YSQ) * RESULT
|
||||
GO TO 800
|
||||
C------------------------------------------------------------------
|
||||
C Evaluate erfc for 0.46875 <= |X| <= 4.0
|
||||
C------------------------------------------------------------------
|
||||
ELSE IF (Y .LE. FOUR) THEN
|
||||
XNUM = C(9)*Y
|
||||
XDEN = Y
|
||||
DO I = 1, 7
|
||||
XNUM = (XNUM + C(I)) * Y
|
||||
XDEN = (XDEN + D(I)) * Y
|
||||
END DO
|
||||
RESULT = (XNUM + C(8)) / (XDEN + D(8))
|
||||
IF (JINT .NE. 2) THEN
|
||||
YSQ = AINT(Y*SIXTEN)/SIXTEN
|
||||
DEL = (Y-YSQ)*(Y+YSQ)
|
||||
RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT
|
||||
END IF
|
||||
C------------------------------------------------------------------
|
||||
C Evaluate erfc for |X| > 4.0
|
||||
C------------------------------------------------------------------
|
||||
ELSE
|
||||
RESULT = ZERO
|
||||
IF (Y .GE. XBIG) THEN
|
||||
IF ((JINT .NE. 2) .OR. (Y .GE. XMAX)) GO TO 300
|
||||
IF (Y .GE. XHUGE) THEN
|
||||
RESULT = SQRPI / Y
|
||||
GO TO 300
|
||||
END IF
|
||||
END IF
|
||||
YSQ = ONE / (Y * Y)
|
||||
XNUM = P(6)*YSQ
|
||||
XDEN = YSQ
|
||||
DO I = 1, 4
|
||||
XNUM = (XNUM + P(I)) * YSQ
|
||||
XDEN = (XDEN + Q(I)) * YSQ
|
||||
ENDDO
|
||||
RESULT = YSQ *(XNUM + P(5)) / (XDEN + Q(5))
|
||||
RESULT = (SQRPI - RESULT) / Y
|
||||
IF (JINT .NE. 2) THEN
|
||||
YSQ = AINT(Y*SIXTEN)/SIXTEN
|
||||
DEL = (Y-YSQ)*(Y+YSQ)
|
||||
RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT
|
||||
END IF
|
||||
END IF
|
||||
C------------------------------------------------------------------
|
||||
C Fix up for negative argument, erf, etc.
|
||||
C------------------------------------------------------------------
|
||||
300 IF (JINT .EQ. 0) THEN
|
||||
RESULT = (HALF - RESULT) + HALF
|
||||
IF (X .LT. ZERO) RESULT = -RESULT
|
||||
ELSE IF (JINT .EQ. 1) THEN
|
||||
IF (X .LT. ZERO) RESULT = TWO - RESULT
|
||||
ELSE
|
||||
IF (X .LT. ZERO) THEN
|
||||
IF (X .LT. XNEG) THEN
|
||||
RESULT = XINF
|
||||
ELSE
|
||||
YSQ = AINT(X*SIXTEN)/SIXTEN
|
||||
DEL = (X-YSQ)*(X+YSQ)
|
||||
Y = EXP(YSQ*YSQ) * EXP(DEL)
|
||||
RESULT = (Y+Y) - RESULT
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
800 RETURN
|
||||
END SUBROUTINE CALERF
|
||||
FUNCTION FIINV(P) RESULT (VAL)
|
||||
IMPLICIT NONE
|
||||
*
|
||||
* ALGORITHM AS241 APPL. STATIST. (1988) VOL. 37, NO. 3
|
||||
*
|
||||
* Produces the normal deviate Z corresponding to a given lower
|
||||
* tail area of P.
|
||||
* Absolute error less than 1e-13
|
||||
* Relative error less than 1e-15 for abs(VAL)>0.1
|
||||
*
|
||||
* The hash sums below are the sums of the mantissas of the
|
||||
* coefficients. They are included for use in checking
|
||||
* transcription.
|
||||
*
|
||||
DOUBLE PRECISION, INTENT(in) :: P
|
||||
DOUBLE PRECISION :: VAL
|
||||
!local variables
|
||||
DOUBLE PRECISION SPLIT1, SPLIT2, CONST1, CONST2, ONE, ZERO, HALF,
|
||||
& A0, A1, A2, A3, A4, A5, A6, A7, B1, B2, B3, B4, B5, B6, B7,
|
||||
& C0, C1, C2, C3, C4, C5, C6, C7, D1, D2, D3, D4, D5, D6, D7,
|
||||
& E0, E1, E2, E3, E4, E5, E6, E7, F1, F2, F3, F4, F5, F6, F7,
|
||||
& Q, R
|
||||
PARAMETER ( SPLIT1 = 0.425D0, SPLIT2 = 5.D0,
|
||||
& CONST1 = 0.180625D0, CONST2 = 1.6D0,
|
||||
& ONE = 1.D0, ZERO = 0.D0, HALF = 0.5D0 )
|
||||
*
|
||||
* Coefficients for P close to 0.5
|
||||
*
|
||||
PARAMETER (
|
||||
* A0 = 3.38713 28727 96366 6080D0,
|
||||
* A1 = 1.33141 66789 17843 7745D+2,
|
||||
* A2 = 1.97159 09503 06551 4427D+3,
|
||||
* A3 = 1.37316 93765 50946 1125D+4,
|
||||
* A4 = 4.59219 53931 54987 1457D+4,
|
||||
* A5 = 6.72657 70927 00870 0853D+4,
|
||||
* A6 = 3.34305 75583 58812 8105D+4,
|
||||
* A7 = 2.50908 09287 30122 6727D+3,
|
||||
* B1 = 4.23133 30701 60091 1252D+1,
|
||||
* B2 = 6.87187 00749 20579 0830D+2,
|
||||
* B3 = 5.39419 60214 24751 1077D+3,
|
||||
* B4 = 2.12137 94301 58659 5867D+4,
|
||||
* B5 = 3.93078 95800 09271 0610D+4,
|
||||
* B6 = 2.87290 85735 72194 2674D+4,
|
||||
* B7 = 5.22649 52788 52854 5610D+3 )
|
||||
* HASH SUM AB 55.88319 28806 14901 4439
|
||||
*
|
||||
* Coefficients for P not close to 0, 0.5 or 1.
|
||||
*
|
||||
PARAMETER (
|
||||
* C0 = 1.42343 71107 49683 57734D0,
|
||||
* C1 = 4.63033 78461 56545 29590D0,
|
||||
* C2 = 5.76949 72214 60691 40550D0,
|
||||
* C3 = 3.64784 83247 63204 60504D0,
|
||||
* C4 = 1.27045 82524 52368 38258D0,
|
||||
* C5 = 2.41780 72517 74506 11770D-1,
|
||||
* C6 = 2.27238 44989 26918 45833D-2,
|
||||
* C7 = 7.74545 01427 83414 07640D-4,
|
||||
* D1 = 2.05319 16266 37758 82187D0,
|
||||
* D2 = 1.67638 48301 83803 84940D0,
|
||||
* D3 = 6.89767 33498 51000 04550D-1,
|
||||
* D4 = 1.48103 97642 74800 74590D-1,
|
||||
* D5 = 1.51986 66563 61645 71966D-2,
|
||||
* D6 = 5.47593 80849 95344 94600D-4,
|
||||
* D7 = 1.05075 00716 44416 84324D-9 )
|
||||
* HASH SUM CD 49.33206 50330 16102 89036
|
||||
*
|
||||
* Coefficients for P near 0 or 1.
|
||||
*
|
||||
PARAMETER (
|
||||
* E0 = 6.65790 46435 01103 77720D0,
|
||||
* E1 = 5.46378 49111 64114 36990D0,
|
||||
* E2 = 1.78482 65399 17291 33580D0,
|
||||
* E3 = 2.96560 57182 85048 91230D-1,
|
||||
* E4 = 2.65321 89526 57612 30930D-2,
|
||||
* E5 = 1.24266 09473 88078 43860D-3,
|
||||
* E6 = 2.71155 55687 43487 57815D-5,
|
||||
* E7 = 2.01033 43992 92288 13265D-7,
|
||||
* F1 = 5.99832 20655 58879 37690D-1,
|
||||
* F2 = 1.36929 88092 27358 05310D-1,
|
||||
* F3 = 1.48753 61290 85061 48525D-2,
|
||||
* F4 = 7.86869 13114 56132 59100D-4,
|
||||
* F5 = 1.84631 83175 10054 68180D-5,
|
||||
* F6 = 1.42151 17583 16445 88870D-7,
|
||||
* F7 = 2.04426 31033 89939 78564D-15 )
|
||||
* HASH SUM EF 47.52583 31754 92896 71629
|
||||
*
|
||||
Q = ( P - HALF)
|
||||
IF ( ABS(Q) .LE. SPLIT1 ) THEN ! Central range.
|
||||
R = CONST1 - Q*Q
|
||||
VAL = Q*( ( ( ((((A7*R + A6)*R + A5)*R + A4)*R + A3)
|
||||
* *R + A2 )*R + A1 )*R + A0 )
|
||||
* /( ( ( ((((B7*R + B6)*R + B5)*R + B4)*R + B3)
|
||||
* *R + B2 )*R + B1 )*R + ONE)
|
||||
ELSE ! near the endpoints
|
||||
R = MIN( P, ONE - P )
|
||||
IF (R .GT.ZERO) THEN ! ( 2.d0*R .GT. CFxCutOff) THEN ! R .GT.0.d0
|
||||
R = SQRT( -LOG(R) )
|
||||
IF ( R .LE. SPLIT2 ) THEN
|
||||
R = R - CONST2
|
||||
VAL = ( ( ( ((((C7*R + C6)*R + C5)*R + C4)*R + C3)
|
||||
* *R + C2 )*R + C1 )*R + C0 )
|
||||
* /( ( ( ((((D7*R + D6)*R + D5)*R + D4)*R + D3)
|
||||
* *R + D2 )*R + D1 )*R + ONE )
|
||||
ELSE
|
||||
R = R - SPLIT2
|
||||
VAL = ( ( ( ((((E7*R + E6)*R + E5)*R + E4)*R + E3)
|
||||
* *R + E2 )*R + E1 )*R + E0 )
|
||||
* /( ( ( ((((F7*R + F6)*R + F5)*R + F4)*R + F3)
|
||||
* *R + F2 )*R + F1 )*R + ONE )
|
||||
END IF
|
||||
ELSE
|
||||
VAL = 37.D0 !XMAX 9.d0
|
||||
END IF
|
||||
IF ( Q < ZERO ) VAL = - VAL
|
||||
END IF
|
||||
RETURN
|
||||
END FUNCTION FIINV
|
||||
FUNCTION FI2( Z ) RESULT (VALUE)
|
||||
! USE GLOBALDATA, ONLY : XMAX
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(in) :: Z
|
||||
DOUBLE PRECISION :: VALUE
|
||||
*
|
||||
* Normal distribution probabilities accurate to 1.e-15.
|
||||
* relative error less than 1e-8;
|
||||
* Z = no. of standard deviations from the mean.
|
||||
*
|
||||
* Based upon algorithm 5666 for the error function, from:
|
||||
* Hart, J.F. et al, 'Computer Approximations', Wiley 1968
|
||||
*
|
||||
* Programmer: Alan Miller
|
||||
*
|
||||
* Latest revision - 30 March 1986
|
||||
*
|
||||
DOUBLE PRECISION :: P0, P1, P2, P3, P4, P5, P6,
|
||||
* Q0, Q1, Q2, Q3, Q4, Q5, Q6, Q7,XMAX,
|
||||
* P, EXPNTL, CUTOFF, ROOTPI, ZABS, Z2
|
||||
PARAMETER(
|
||||
* P0 = 220.20 68679 12376 1D0,
|
||||
* P1 = 221.21 35961 69931 1D0,
|
||||
* P2 = 112.07 92914 97870 9D0,
|
||||
* P3 = 33.912 86607 83830 0D0,
|
||||
* P4 = 6.3739 62203 53165 0D0,
|
||||
* P5 = 0.70038 30644 43688 1D0,
|
||||
* P6 = 0.035262 49659 98910 9D0 )
|
||||
PARAMETER(
|
||||
* Q0 = 440.41 37358 24752 2D0,
|
||||
* Q1 = 793.82 65125 19948 4D0,
|
||||
* Q2 = 637.33 36333 78831 1D0,
|
||||
* Q3 = 296.56 42487 79673 7D0,
|
||||
* Q4 = 86.780 73220 29460 8D0,
|
||||
* Q5 = 16.064 17757 92069 5D0,
|
||||
* Q6 = 1.7556 67163 18264 2D0,
|
||||
* Q7 = 0.088388 34764 83184 4D0 )
|
||||
PARAMETER( ROOTPI = 2.5066 28274 63100 1D0 )
|
||||
PARAMETER( CUTOFF = 7.0710 67811 86547 5D0 )
|
||||
PARAMETER( XMAX = 8.25D0 )
|
||||
*
|
||||
ZABS = ABS(Z)
|
||||
*
|
||||
* |Z| > 37 (or XMAX)
|
||||
*
|
||||
IF ( ZABS .GT. XMAX ) THEN
|
||||
P = 0.d0
|
||||
ELSE
|
||||
*
|
||||
* |Z| <= 37
|
||||
*
|
||||
Z2 = ZABS * ZABS
|
||||
EXPNTL = EXP( -Z2 * 0.5D0 )
|
||||
*
|
||||
* |Z| < CUTOFF = 10/SQRT(2)
|
||||
*
|
||||
IF ( ZABS < CUTOFF ) THEN
|
||||
P = EXPNTL*( (((((P6*ZABS + P5)*ZABS + P4)*ZABS + P3)*ZABS
|
||||
* + P2)*ZABS + P1)*ZABS + P0)/(((((((Q7*ZABS + Q6)*ZABS
|
||||
* + Q5)*ZABS + Q4)*ZABS + Q3)*ZABS + Q2)*ZABS + Q1)*ZABS
|
||||
* + Q0 )
|
||||
*
|
||||
* |Z| >= CUTOFF.
|
||||
*
|
||||
ELSE
|
||||
P = EXPNTL/( ZABS + 1.d0/( ZABS + 2.d0/( ZABS + 3.d0/( ZABS
|
||||
* + 4.d0/( ZABS + 0.65D0 ) ) ) ) )/ROOTPI
|
||||
END IF
|
||||
END IF
|
||||
IF ( Z .GT. 0.d0 ) P = 1.d0 - P
|
||||
VALUE = P
|
||||
RETURN
|
||||
END FUNCTION FI2
|
||||
|
||||
FUNCTION FI( Z ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(in) :: Z
|
||||
DOUBLE PRECISION :: VALUE
|
||||
! Local variables
|
||||
DOUBLE PRECISION, PARAMETER:: SQ2M1 = 0.70710678118655D0 ! 1/SQRT(2)
|
||||
DOUBLE PRECISION, PARAMETER:: HALF = 0.5D0
|
||||
VALUE = DERFC(-Z*SQ2M1)*HALF
|
||||
RETURN
|
||||
END FUNCTION FI
|
||||
@ -1,39 +0,0 @@
|
||||
! -*- f90 -*-
|
||||
! Note: the context of this file is case sensitive.
|
||||
|
||||
python module erfcore ! in
|
||||
interface ! in :erfcore
|
||||
function derf(x) result (value) ! in :erfcore:erfcore.f
|
||||
double precision intent(in) :: x
|
||||
double precision :: value
|
||||
end function derf
|
||||
function derfc(x) result (value) ! in :erfcore:erfcore.f
|
||||
double precision intent(in) :: x
|
||||
double precision :: value
|
||||
end function derfc
|
||||
function derfcx(x) result (value) ! in :erfcore:erfcore.f
|
||||
double precision intent(in) :: x
|
||||
double precision :: value
|
||||
end function derfcx
|
||||
subroutine calerf(arg,result,jint) ! in :erfcore:erfcore.f
|
||||
double precision intent(in) :: arg
|
||||
double precision intent(inout) :: result
|
||||
integer intent(in) :: jint
|
||||
end subroutine calerf
|
||||
function fiinv(p) result (val) ! in :erfcore:erfcore.f
|
||||
double precision intent(in) :: p
|
||||
double precision :: val
|
||||
end function fiinv
|
||||
function fi2(z) result (value) ! in :erfcore:erfcore.f
|
||||
double precision intent(in) :: z
|
||||
double precision :: value
|
||||
end function fi2
|
||||
function fi(z) result (value) ! in :erfcore:erfcore.f
|
||||
double precision intent(in) :: z
|
||||
double precision :: value
|
||||
end function fi
|
||||
end interface
|
||||
end python module erfcore
|
||||
|
||||
! This file was auto-generated with f2py (version:2_5972).
|
||||
! See http://cens.ioc.ee/projects/f2py2e/
|
||||
@ -1,346 +0,0 @@
|
||||
C $ f2py -m erfcoremod -h erfcoremod.pyf erfcoremod.f
|
||||
C f2py erfcoremod.pyf erfcoremod.f -c --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71
|
||||
C $ f2py --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71 -m erfcoremod -c erfcoremod.f
|
||||
|
||||
C gfortran -fPIC -c erfcoremod.f
|
||||
C f2py -m erfcoremod -c erfcoremod.o erfcoremod_interface.f
|
||||
|
||||
MODULE ERFCOREMOD
|
||||
C IMPLICIT NONE
|
||||
|
||||
C INTERFACE CALERF
|
||||
C MODULE PROCEDURE CALERF
|
||||
C END INTERFACE
|
||||
|
||||
C INTERFACE DERF
|
||||
C MODULE PROCEDURE DERF
|
||||
C END INTERFACE
|
||||
|
||||
C INTERFACE DERFC
|
||||
C MODULE PROCEDURE DERFC
|
||||
C END INTERFACE
|
||||
|
||||
C INTERFACE DERFCX
|
||||
C MODULE PROCEDURE DERFCX
|
||||
c END INTERFACE
|
||||
CONTAINS
|
||||
C--------------------------------------------------------------------
|
||||
C
|
||||
C DERF subprogram computes approximate values for erf(x).
|
||||
C (see comments heading CALERF).
|
||||
C
|
||||
C Author/date: W. J. Cody, January 8, 1985
|
||||
C
|
||||
C--------------------------------------------------------------------
|
||||
FUNCTION DERF( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 0
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERF
|
||||
C--------------------------------------------------------------------
|
||||
C
|
||||
C DERFC subprogram computes approximate values for erfc(x).
|
||||
C (see comments heading CALERF).
|
||||
C
|
||||
C Author/date: W. J. Cody, January 8, 1985
|
||||
C
|
||||
C--------------------------------------------------------------------
|
||||
FUNCTION DERFC( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 1
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERFC
|
||||
C------------------------------------------------------------------
|
||||
C
|
||||
C DERFCX subprogram computes approximate values for exp(x*x) * erfc(x).
|
||||
C (see comments heading CALERF).
|
||||
C
|
||||
C Author/date: W. J. Cody, March 30, 1987
|
||||
C
|
||||
C------------------------------------------------------------------
|
||||
FUNCTION DERFCX( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 2
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERFCX
|
||||
|
||||
SUBROUTINE CALERF(ARG,RESULT,JINT)
|
||||
IMPLICIT NONE
|
||||
C------------------------------------------------------------------
|
||||
C
|
||||
C CALERF packet evaluates erf(x), erfc(x), and exp(x*x)*erfc(x)
|
||||
C for a real argument x. It contains three FUNCTION type
|
||||
C subprograms: ERF, ERFC, and ERFCX (or DERF, DERFC, and DERFCX),
|
||||
C and one SUBROUTINE type subprogram, CALERF. The calling
|
||||
C statements for the primary entries are:
|
||||
C
|
||||
C Y=ERF(X) (or Y=DERF(X)),
|
||||
C
|
||||
C Y=ERFC(X) (or Y=DERFC(X)),
|
||||
C and
|
||||
C Y=ERFCX(X) (or Y=DERFCX(X)).
|
||||
C
|
||||
C The routine CALERF is intended for internal packet use only,
|
||||
C all computations within the packet being concentrated in this
|
||||
C routine. The function subprograms invoke CALERF with the
|
||||
C statement
|
||||
C
|
||||
C CALL CALERF(ARG,RESULT,JINT)
|
||||
C
|
||||
C where the parameter usage is as follows
|
||||
C
|
||||
C Function Parameters for CALERF
|
||||
C call ARG Result JINT
|
||||
C
|
||||
C ERF(ARG) ANY REAL ARGUMENT ERF(ARG) 0
|
||||
C ERFC(ARG) ABS(ARG) .LT. XBIG ERFC(ARG) 1
|
||||
C ERFCX(ARG) XNEG .LT. ARG .LT. XMAX ERFCX(ARG) 2
|
||||
C
|
||||
C The main computation evaluates near-minimax approximations
|
||||
C from "Rational Chebyshev approximations for the error function"
|
||||
C by W. J. Cody, Math. Comp., 1969, PP. 631-638. This
|
||||
C transportable program uses rational functions that theoretically
|
||||
C approximate erf(x) and erfc(x) to at least 18 significant
|
||||
C decimal digits. The accuracy achieved depends on the arithmetic
|
||||
C system, the compiler, the intrinsic functions, and proper
|
||||
C selection of the machine-dependent constants.
|
||||
C
|
||||
C*******************************************************************
|
||||
C*******************************************************************
|
||||
C
|
||||
C Explanation of machine-dependent constants
|
||||
C
|
||||
C XMIN = the smallest positive floating-point number.
|
||||
C XINF = the largest positive finite floating-point number.
|
||||
C XNEG = the largest negative argument acceptable to ERFCX;
|
||||
C the negative of the solution to the equation
|
||||
C 2*exp(x*x) = XINF.
|
||||
C XSMALL = argument below which erf(x) may be represented by
|
||||
C 2*x/sqrt(pi) and above which x*x will not underflow.
|
||||
C A conservative value is the largest machine number X
|
||||
C such that 1.0 + X = 1.0 to machine precision.
|
||||
C XBIG = largest argument acceptable to ERFC; solution to
|
||||
C the equation: W(x) * (1-0.5/x**2) = XMIN, where
|
||||
C W(x) = exp(-x*x)/[x*sqrt(pi)].
|
||||
C XHUGE = argument above which 1.0 - 1/(2*x*x) = 1.0 to
|
||||
C machine precision. A conservative value is
|
||||
C 1/[2*sqrt(XSMALL)]
|
||||
C XMAX = largest acceptable argument to ERFCX; the minimum
|
||||
C of XINF and 1/[sqrt(pi)*XMIN].
|
||||
C
|
||||
C Approximate values for some important machines are:
|
||||
C
|
||||
C XMIN XINF XNEG XSMALL
|
||||
C
|
||||
C C 7600 (S.P.) 3.13E-294 1.26E+322 -27.220 7.11E-15
|
||||
C CRAY-1 (S.P.) 4.58E-2467 5.45E+2465 -75.345 7.11E-15
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (S.P.) 1.18E-38 3.40E+38 -9.382 5.96E-8
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (D.P.) 2.23D-308 1.79D+308 -26.628 1.11D-16
|
||||
C IBM 195 (D.P.) 5.40D-79 7.23E+75 -13.190 1.39D-17
|
||||
C UNIVAC 1108 (D.P.) 2.78D-309 8.98D+307 -26.615 1.73D-18
|
||||
C VAX D-Format (D.P.) 2.94D-39 1.70D+38 -9.345 1.39D-17
|
||||
C VAX G-Format (D.P.) 5.56D-309 8.98D+307 -26.615 1.11D-16
|
||||
C
|
||||
C
|
||||
C XBIG XHUGE XMAX
|
||||
C
|
||||
C C 7600 (S.P.) 25.922 8.39E+6 1.80X+293
|
||||
C CRAY-1 (S.P.) 75.326 8.39E+6 5.45E+2465
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (S.P.) 9.194 2.90E+3 4.79E+37
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (D.P.) 26.543 6.71D+7 2.53D+307
|
||||
C IBM 195 (D.P.) 13.306 1.90D+8 7.23E+75
|
||||
C UNIVAC 1108 (D.P.) 26.582 5.37D+8 8.98D+307
|
||||
C VAX D-Format (D.P.) 9.269 1.90D+8 1.70D+38
|
||||
C VAX G-Format (D.P.) 26.569 6.71D+7 8.98D+307
|
||||
C
|
||||
C*******************************************************************
|
||||
C*******************************************************************
|
||||
C
|
||||
C Error returns
|
||||
C
|
||||
C The program returns ERFC = 0 for ARG .GE. XBIG;
|
||||
C
|
||||
C ERFCX = XINF for ARG .LT. XNEG;
|
||||
C and
|
||||
C ERFCX = 0 for ARG .GE. XMAX.
|
||||
C
|
||||
C
|
||||
C Intrinsic functions required are:
|
||||
C
|
||||
C ABS, AINT, EXP
|
||||
C
|
||||
C
|
||||
C Author: W. J. Cody
|
||||
C Mathematics and Computer Science Division
|
||||
C Argonne National Laboratory
|
||||
C Argonne, IL 60439
|
||||
C
|
||||
C Latest modification: March 19, 1990
|
||||
C Updated to F90 by pab 23.03.2003
|
||||
C
|
||||
C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, INTENT(IN) :: ARG
|
||||
INTEGER, INTENT(IN) :: JINT
|
||||
DOUBLE PRECISION, INTENT(INOUT):: RESULT
|
||||
! Local variables
|
||||
INTEGER :: I
|
||||
DOUBLE PRECISION :: DEL,X,XDEN,XNUM,Y,YSQ
|
||||
C------------------------------------------------------------------
|
||||
C Mathematical constants
|
||||
C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, PARAMETER :: ZERO = 0.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: HALF = 0.05D0
|
||||
DOUBLE PRECISION, PARAMETER :: ONE = 1.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: TWO = 2.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: FOUR = 4.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: SIXTEN = 16.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: SQRPI = 5.6418958354775628695D-1
|
||||
DOUBLE PRECISION, PARAMETER :: THRESH = 0.46875D0
|
||||
C------------------------------------------------------------------
|
||||
C Machine-dependent constants
|
||||
C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, PARAMETER :: XNEG = -26.628D0
|
||||
DOUBLE PRECISION, PARAMETER :: XSMALL = 1.11D-16
|
||||
DOUBLE PRECISION, PARAMETER :: XBIG = 26.543D0
|
||||
DOUBLE PRECISION, PARAMETER :: XHUGE = 6.71D7
|
||||
DOUBLE PRECISION, PARAMETER :: XMAX = 2.53D307
|
||||
DOUBLE PRECISION, PARAMETER :: XINF = 1.79D308
|
||||
!---------------------------------------------------------------
|
||||
! Coefficents to the rational polynomials
|
||||
!--------------------------------------------------------------
|
||||
DOUBLE PRECISION, DIMENSION(5) :: A, Q
|
||||
DOUBLE PRECISION, DIMENSION(4) :: B
|
||||
DOUBLE PRECISION, DIMENSION(9) :: C
|
||||
DOUBLE PRECISION, DIMENSION(8) :: D
|
||||
DOUBLE PRECISION, DIMENSION(6) :: P
|
||||
C------------------------------------------------------------------
|
||||
C Coefficients for approximation to erf in first interval
|
||||
C------------------------------------------------------------------
|
||||
PARAMETER (A = (/ 3.16112374387056560D00,
|
||||
& 1.13864154151050156D02,3.77485237685302021D02,
|
||||
& 3.20937758913846947D03, 1.85777706184603153D-1/))
|
||||
PARAMETER ( B = (/2.36012909523441209D01,2.44024637934444173D02,
|
||||
& 1.28261652607737228D03,2.84423683343917062D03/))
|
||||
C------------------------------------------------------------------
|
||||
C Coefficients for approximation to erfc in second interval
|
||||
C------------------------------------------------------------------
|
||||
PARAMETER ( C=(/5.64188496988670089D-1,8.88314979438837594D0,
|
||||
1 6.61191906371416295D01,2.98635138197400131D02,
|
||||
2 8.81952221241769090D02,1.71204761263407058D03,
|
||||
3 2.05107837782607147D03,1.23033935479799725D03,
|
||||
4 2.15311535474403846D-8/))
|
||||
PARAMETER ( D =(/1.57449261107098347D01,1.17693950891312499D02,
|
||||
1 5.37181101862009858D02,1.62138957456669019D03,
|
||||
2 3.29079923573345963D03,4.36261909014324716D03,
|
||||
3 3.43936767414372164D03,1.23033935480374942D03/))
|
||||
C------------------------------------------------------------------
|
||||
C Coefficients for approximation to erfc in third interval
|
||||
C------------------------------------------------------------------
|
||||
PARAMETER ( P =(/3.05326634961232344D-1,3.60344899949804439D-1,
|
||||
1 1.25781726111229246D-1,1.60837851487422766D-2,
|
||||
2 6.58749161529837803D-4,1.63153871373020978D-2/))
|
||||
PARAMETER (Q =(/2.56852019228982242D00,1.87295284992346047D00,
|
||||
1 5.27905102951428412D-1,6.05183413124413191D-2,
|
||||
2 2.33520497626869185D-3/))
|
||||
C------------------------------------------------------------------
|
||||
X = ARG
|
||||
Y = ABS(X)
|
||||
IF (Y .LE. THRESH) THEN
|
||||
C------------------------------------------------------------------
|
||||
C Evaluate erf for |X| <= 0.46875
|
||||
C------------------------------------------------------------------
|
||||
!YSQ = ZERO
|
||||
IF (Y .GT. XSMALL) THEN
|
||||
YSQ = Y * Y
|
||||
XNUM = A(5)*YSQ
|
||||
XDEN = YSQ
|
||||
DO I = 1, 3
|
||||
XNUM = (XNUM + A(I)) * YSQ
|
||||
XDEN = (XDEN + B(I)) * YSQ
|
||||
END DO
|
||||
RESULT = X * (XNUM + A(4)) / (XDEN + B(4))
|
||||
ELSE
|
||||
RESULT = X * A(4) / B(4)
|
||||
ENDIF
|
||||
IF (JINT .NE. 0) RESULT = ONE - RESULT
|
||||
IF (JINT .EQ. 2) RESULT = EXP(YSQ) * RESULT
|
||||
GO TO 800
|
||||
C------------------------------------------------------------------
|
||||
C Evaluate erfc for 0.46875 <= |X| <= 4.0
|
||||
C------------------------------------------------------------------
|
||||
ELSE IF (Y .LE. FOUR) THEN
|
||||
XNUM = C(9)*Y
|
||||
XDEN = Y
|
||||
DO I = 1, 7
|
||||
XNUM = (XNUM + C(I)) * Y
|
||||
XDEN = (XDEN + D(I)) * Y
|
||||
END DO
|
||||
RESULT = (XNUM + C(8)) / (XDEN + D(8))
|
||||
IF (JINT .NE. 2) THEN
|
||||
YSQ = AINT(Y*SIXTEN)/SIXTEN
|
||||
DEL = (Y-YSQ)*(Y+YSQ)
|
||||
RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT
|
||||
END IF
|
||||
C------------------------------------------------------------------
|
||||
C Evaluate erfc for |X| > 4.0
|
||||
C------------------------------------------------------------------
|
||||
ELSE
|
||||
RESULT = ZERO
|
||||
IF (Y .GE. XBIG) THEN
|
||||
IF ((JINT .NE. 2) .OR. (Y .GE. XMAX)) GO TO 300
|
||||
IF (Y .GE. XHUGE) THEN
|
||||
RESULT = SQRPI / Y
|
||||
GO TO 300
|
||||
END IF
|
||||
END IF
|
||||
YSQ = ONE / (Y * Y)
|
||||
XNUM = P(6)*YSQ
|
||||
XDEN = YSQ
|
||||
DO I = 1, 4
|
||||
XNUM = (XNUM + P(I)) * YSQ
|
||||
XDEN = (XDEN + Q(I)) * YSQ
|
||||
ENDDO
|
||||
RESULT = YSQ *(XNUM + P(5)) / (XDEN + Q(5))
|
||||
RESULT = (SQRPI - RESULT) / Y
|
||||
IF (JINT .NE. 2) THEN
|
||||
YSQ = AINT(Y*SIXTEN)/SIXTEN
|
||||
DEL = (Y-YSQ)*(Y+YSQ)
|
||||
RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT
|
||||
END IF
|
||||
END IF
|
||||
C------------------------------------------------------------------
|
||||
C Fix up for negative argument, erf, etc.
|
||||
C------------------------------------------------------------------
|
||||
300 IF (JINT .EQ. 0) THEN
|
||||
RESULT = (HALF - RESULT) + HALF
|
||||
IF (X .LT. ZERO) RESULT = -RESULT
|
||||
ELSE IF (JINT .EQ. 1) THEN
|
||||
IF (X .LT. ZERO) RESULT = TWO - RESULT
|
||||
ELSE
|
||||
IF (X .LT. ZERO) THEN
|
||||
IF (X .LT. XNEG) THEN
|
||||
RESULT = XINF
|
||||
ELSE
|
||||
YSQ = AINT(X*SIXTEN)/SIXTEN
|
||||
DEL = (X-YSQ)*(X+YSQ)
|
||||
Y = EXP(YSQ*YSQ) * EXP(DEL)
|
||||
RESULT = (Y+Y) - RESULT
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
800 RETURN
|
||||
END SUBROUTINE CALERF
|
||||
END MODULE ERFCOREMOD
|
||||
@ -1,346 +0,0 @@
|
||||
!C $ f2py -m erf!Coremod -h erf!Coremod.pyf erf!Coremod.f
|
||||
!C f2py erf!Coremod.pyf erf!Coremod.f -!C --f!Compiler=gnu95 --!Compiler=mingw32 -lmsv!Cr71
|
||||
!C $ f2py --f!Compiler=gnu95 --!Compiler=mingw32 -lmsv!Cr71 -m erf!Coremod -!C erf!Coremod.f
|
||||
|
||||
!C gfortran -fPI!C -!C erf!Coremod.f
|
||||
!C f2py -m erf!Coremod -DUPPER!CASE_FORTRAN -!C erf!Coremod.o erf!Coremod_interfa!Ce.f
|
||||
|
||||
MODULE ERFCOREMOD
|
||||
!C IMPLI!CIT NONE
|
||||
|
||||
!C INTERFA!CE !CALERF
|
||||
!C MODULE PRO!CEDURE !CALERF
|
||||
!C END INTERFA!CE
|
||||
|
||||
!C INTERFA!CE DERF
|
||||
!C MODULE PRO!CEDURE DERF
|
||||
!C END INTERFA!CE
|
||||
|
||||
!C INTERFA!CE DERF!C
|
||||
!C MODULE PRO!CEDURE DERF!C
|
||||
!C END INTERFA!CE
|
||||
|
||||
!C INTERFA!CE DERF!CX
|
||||
!C MODULE PRO!CEDURE DERF!CX
|
||||
!C END INTERFA!CE
|
||||
CONTAINS
|
||||
!C--------------------------------------------------------------------
|
||||
!C
|
||||
!C DERF subprogram !Computes approximate values for erf(x).
|
||||
!C (see !Comments heading !CALERF).
|
||||
!C
|
||||
!C Author/date: W. J. !Cody, January 8, 1985
|
||||
!C
|
||||
!C--------------------------------------------------------------------
|
||||
FUNCTION DERF( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 0
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERF
|
||||
!C--------------------------------------------------------------------
|
||||
!C
|
||||
!C DERF!C subprogram !Computes approximate values for erf!C(x).
|
||||
!C (see !Comments heading !CALERF).
|
||||
!C
|
||||
!C Author/date: W. J. !Cody, January 8, 1985
|
||||
!C
|
||||
!C--------------------------------------------------------------------
|
||||
FUNCTION DERFC( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 1
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERFC
|
||||
!C------------------------------------------------------------------
|
||||
!C
|
||||
!C DERFCX subprogram Computes approximate values for exp(x*x) * erfC(x).
|
||||
!C (see !Comments heading !CALERF).
|
||||
!C
|
||||
!C Author/date: W. J. !Cody, Mar!Ch 30, 1987
|
||||
!C
|
||||
!C------------------------------------------------------------------
|
||||
FUNCTION DERFCX( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 2
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERFCX
|
||||
|
||||
SUBROUTINE CALERF(ARG,RESULT,JINT)
|
||||
IMPLICIT NONE
|
||||
!C------------------------------------------------------------------
|
||||
!C
|
||||
!C !CALERF pa!Cket evaluates erf(x), erf!C(x), and exp(x*x)*erf!C(x)
|
||||
!C for a real argument x. It !Contains three FUN!CTION type
|
||||
!C subprograms: ERF, ERF!C, and ERF!CX (or DERF, DERF!C, and DERF!CX),
|
||||
!C and one SUBROUTINE type subprogram, !CALERF. The !Calling
|
||||
!C statements for the primary entries are:
|
||||
!C
|
||||
!C Y=ERF(X) (or Y=DERF(X)),
|
||||
!C
|
||||
!C Y=ERF!C(X) (or Y=DERF!C(X)),
|
||||
!C and
|
||||
!C Y=ERF!CX(X) (or Y=DERF!CX(X)).
|
||||
!C
|
||||
!C The routine !CALERF is intended for internal pa!Cket use only,
|
||||
!C all !Computations within the pa!Cket being !Con!Centrated in this
|
||||
!C routine. The fun!Ction subprograms invoke !CALERF with the
|
||||
!C statement
|
||||
!C
|
||||
!C !CALL !CALERF(ARG,RESULT,JINT)
|
||||
!C
|
||||
!C where the parameter usage is as follows
|
||||
!C
|
||||
!C Fun!Ction Parameters for !CALERF
|
||||
!C !Call ARG Result JINT
|
||||
!C
|
||||
!C ERF(ARG) ANY REAL ARGUMENT ERF(ARG) 0
|
||||
!C ERF!C(ARG) ABS(ARG) .LT. XBIG ERF!C(ARG) 1
|
||||
!C ERF!CX(ARG) XNEG .LT. ARG .LT. XMAX ERF!CX(ARG) 2
|
||||
!C
|
||||
!C The main !Computation evaluates near-minimax approximations
|
||||
!C from "Rational !Chebyshev approximations for the error fun!Ction"
|
||||
!C by W. J. !Cody, Math. !Comp., 1969, PP. 631-638. This
|
||||
!C transportable program uses rational fun!Ctions that theoreti!Cally
|
||||
!C approximate erf(x) and erf!C(x) to at least 18 signifi!Cant
|
||||
!C de!Cimal digits. The a!C!Cura!Cy a!Chieved depends on the arithmeti!C
|
||||
!C system, the !Compiler, the intrinsi!C fun!Ctions, and proper
|
||||
!C sele!Ction of the ma!Chine-dependent !Constants.
|
||||
!C
|
||||
!C*******************************************************************
|
||||
!C*******************************************************************
|
||||
!C
|
||||
!C Explanation of ma!Chine-dependent !Constants
|
||||
!C
|
||||
!C XMIN = the smallest positive floating-point number.
|
||||
!C XINF = the largest positive finite floating-point number.
|
||||
!C XNEG = the largest negative argument a!C!Ceptable to ERF!CX;
|
||||
!C the negative of the solution to the equation
|
||||
!C 2*exp(x*x) = XINF.
|
||||
!C XSMALL = argument below whi!Ch erf(x) may be represented by
|
||||
!C 2*x/sqrt(pi) and above whi!Ch x*x will not underflow.
|
||||
!C A !Conservative value is the largest ma!Chine number X
|
||||
!C su!Ch that 1.0 + X = 1.0 to ma!Chine pre!Cision.
|
||||
!C XBIG = largest argument a!C!Ceptable to ERF!C; solution to
|
||||
!C the equation: W(x) * (1-0.5/x**2) = XMIN, where
|
||||
!C W(x) = exp(-x*x)/[x*sqrt(pi)].
|
||||
!C XHUGE = argument above whi!Ch 1.0 - 1/(2*x*x) = 1.0 to
|
||||
!C ma!Chine pre!Cision. A !Conservative value is
|
||||
!C 1/[2*sqrt(XSMALL)]
|
||||
!C XMAX = largest a!C!Ceptable argument to ERF!CX; the minimum
|
||||
!C of XINF and 1/[sqrt(pi)*XMIN].
|
||||
!C
|
||||
!C Approximate values for some important ma!Chines are:
|
||||
!C
|
||||
!C XMIN XINF XNEG XSMALL
|
||||
!C
|
||||
!C !C 7600 (S.P.) 3.13E-294 1.26E+322 -27.220 7.11E-15
|
||||
!C !CRAY-1 (S.P.) 4.58E-2467 5.45E+2465 -75.345 7.11E-15
|
||||
!C IEEE (IBM/XT,
|
||||
!C SUN, et!C.) (S.P.) 1.18E-38 3.40E+38 -9.382 5.96E-8
|
||||
!C IEEE (IBM/XT,
|
||||
!C SUN, et!C.) (D.P.) 2.23D-308 1.79D+308 -26.628 1.11D-16
|
||||
!C IBM 195 (D.P.) 5.40D-79 7.23E+75 -13.190 1.39D-17
|
||||
!C UNIVA!C 1108 (D.P.) 2.78D-309 8.98D+307 -26.615 1.73D-18
|
||||
!C VAX D-Format (D.P.) 2.94D-39 1.70D+38 -9.345 1.39D-17
|
||||
!C VAX G-Format (D.P.) 5.56D-309 8.98D+307 -26.615 1.11D-16
|
||||
!C
|
||||
!C
|
||||
!C XBIG XHUGE XMAX
|
||||
!C
|
||||
!C !C 7600 (S.P.) 25.922 8.39E+6 1.80X+293
|
||||
!C !CRAY-1 (S.P.) 75.326 8.39E+6 5.45E+2465
|
||||
!C IEEE (IBM/XT,
|
||||
!C SUN, et!C.) (S.P.) 9.194 2.90E+3 4.79E+37
|
||||
!C IEEE (IBM/XT,
|
||||
!C SUN, et!C.) (D.P.) 26.543 6.71D+7 2.53D+307
|
||||
!C IBM 195 (D.P.) 13.306 1.90D+8 7.23E+75
|
||||
!C UNIVA!C 1108 (D.P.) 26.582 5.37D+8 8.98D+307
|
||||
!C VAX D-Format (D.P.) 9.269 1.90D+8 1.70D+38
|
||||
!C VAX G-Format (D.P.) 26.569 6.71D+7 8.98D+307
|
||||
!C
|
||||
!C*******************************************************************
|
||||
!C*******************************************************************
|
||||
!C
|
||||
!C Error returns
|
||||
!C
|
||||
!C The program returns ERF!C = 0 for ARG .GE. XBIG;
|
||||
!C
|
||||
!C ERF!CX = XINF for ARG .LT. XNEG;
|
||||
!C and
|
||||
!C ERF!CX = 0 for ARG .GE. XMAX.
|
||||
!C
|
||||
!C
|
||||
!C Intrinsi!C funCtions required are:
|
||||
!C
|
||||
!C ABS, AINT, EXP
|
||||
!C
|
||||
!C
|
||||
!C Author: W. J. Cody
|
||||
!C MathematiCs and Computer SCienCe Division
|
||||
!C Argonne National Laboratory
|
||||
!C Argonne, IL 60439
|
||||
!C
|
||||
!C Latest modifiCation: MarCh 19, 1990
|
||||
!C Updated to F90 by pab 23.03.2003
|
||||
!C
|
||||
!C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, INTENT(IN) :: ARG
|
||||
INTEGER, INTENT(IN) :: JINT
|
||||
DOUBLE PRECISION, INTENT(INOUT):: RESULT
|
||||
! Lo!Cal variables
|
||||
INTEGER :: I
|
||||
DOUBLE PRECISION :: DEL,X,XDEN,XNUM,Y,YSQ
|
||||
!C------------------------------------------------------------------
|
||||
!C MathematiCal Constants
|
||||
!C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, PARAMETER :: ZERO = 0.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: HALF = 0.05D0
|
||||
DOUBLE PRECISION, PARAMETER :: ONE = 1.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: TWO = 2.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: FOUR = 4.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: SIXTEN = 16.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: SQRPI = 5.6418958354775628695D-1
|
||||
DOUBLE PRECISION, PARAMETER :: THRESH = 0.46875D0
|
||||
!C------------------------------------------------------------------
|
||||
!C MaChine-dependent Constants
|
||||
!C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, PARAMETER :: XNEG = -26.628D0
|
||||
DOUBLE PRECISION, PARAMETER :: XSMALL = 1.11D-16
|
||||
DOUBLE PRECISION, PARAMETER :: XBIG = 26.543D0
|
||||
DOUBLE PRECISION, PARAMETER :: XHUGE = 6.71D7
|
||||
DOUBLE PRECISION, PARAMETER :: XMAX = 2.53D307
|
||||
DOUBLE PRECISION, PARAMETER :: XINF = 1.79D308
|
||||
!---------------------------------------------------------------
|
||||
! !Coeffi!Cents to the rational polynomials
|
||||
!--------------------------------------------------------------
|
||||
DOUBLE PRECISION, DIMENSION(5) :: A, Q
|
||||
DOUBLE PRECISION, DIMENSION(4) :: B
|
||||
DOUBLE PRECISION, DIMENSION(9) :: C
|
||||
DOUBLE PRECISION, DIMENSION(8) :: D
|
||||
DOUBLE PRECISION, DIMENSION(6) :: P
|
||||
!C------------------------------------------------------------------
|
||||
!C !Coeffi!Cients for approximation to erf in first interval
|
||||
!C------------------------------------------------------------------
|
||||
PARAMETER (A = (/ 3.16112374387056560D00,
|
||||
& 1.13864154151050156D02,3.77485237685302021D02,
|
||||
& 3.20937758913846947D03, 1.85777706184603153D-1/))
|
||||
PARAMETER ( B = (/2.36012909523441209D01,2.44024637934444173D02,
|
||||
& 1.28261652607737228D03,2.84423683343917062D03/))
|
||||
!C------------------------------------------------------------------
|
||||
!C CoeffiCients for approximation to erfC in seCond interval
|
||||
!C------------------------------------------------------------------
|
||||
PARAMETER ( C=(/5.64188496988670089D-1,8.88314979438837594D0,
|
||||
1 6.61191906371416295D01,2.98635138197400131D02,
|
||||
2 8.81952221241769090D02,1.71204761263407058D03,
|
||||
3 2.05107837782607147D03,1.23033935479799725D03,
|
||||
4 2.15311535474403846D-8/))
|
||||
PARAMETER ( D =(/1.57449261107098347D01,1.17693950891312499D02,
|
||||
1 5.37181101862009858D02,1.62138957456669019D03,
|
||||
2 3.29079923573345963D03,4.36261909014324716D03,
|
||||
3 3.43936767414372164D03,1.23033935480374942D03/))
|
||||
!C------------------------------------------------------------------
|
||||
!C !Coeffi!Cients for approximation to erf!C in third interval
|
||||
!C------------------------------------------------------------------
|
||||
PARAMETER ( P =(/3.05326634961232344D-1,3.60344899949804439D-1,
|
||||
1 1.25781726111229246D-1,1.60837851487422766D-2,
|
||||
2 6.58749161529837803D-4,1.63153871373020978D-2/))
|
||||
PARAMETER (Q =(/2.56852019228982242D00,1.87295284992346047D00,
|
||||
1 5.27905102951428412D-1,6.05183413124413191D-2,
|
||||
2 2.33520497626869185D-3/))
|
||||
!C------------------------------------------------------------------
|
||||
X = ARG
|
||||
Y = ABS(X)
|
||||
IF (Y .LE. THRESH) THEN
|
||||
!C------------------------------------------------------------------
|
||||
!C Evaluate erf for |X| <= 0.46875
|
||||
!C------------------------------------------------------------------
|
||||
!YSQ = ZERO
|
||||
IF (Y .GT. XSMALL) THEN
|
||||
YSQ = Y * Y
|
||||
XNUM = A(5)*YSQ
|
||||
XDEN = YSQ
|
||||
DO I = 1, 3
|
||||
XNUM = (XNUM + A(I)) * YSQ
|
||||
XDEN = (XDEN + B(I)) * YSQ
|
||||
END DO
|
||||
RESULT = X * (XNUM + A(4)) / (XDEN + B(4))
|
||||
ELSE
|
||||
RESULT = X * A(4) / B(4)
|
||||
ENDIF
|
||||
IF (JINT .NE. 0) RESULT = ONE - RESULT
|
||||
IF (JINT .EQ. 2) RESULT = EXP(YSQ) * RESULT
|
||||
GO TO 800
|
||||
!C------------------------------------------------------------------
|
||||
!C Evaluate erf!C for 0.46875 <= |X| <= 4.0
|
||||
!C------------------------------------------------------------------
|
||||
ELSE IF (Y .LE. FOUR) THEN
|
||||
XNUM = C(9)*Y
|
||||
XDEN = Y
|
||||
DO I = 1, 7
|
||||
XNUM = (XNUM + C(I)) * Y
|
||||
XDEN = (XDEN + D(I)) * Y
|
||||
END DO
|
||||
RESULT = (XNUM + C(8)) / (XDEN + D(8))
|
||||
IF (JINT .NE. 2) THEN
|
||||
YSQ = AINT(Y*SIXTEN)/SIXTEN
|
||||
DEL = (Y-YSQ)*(Y+YSQ)
|
||||
RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT
|
||||
END IF
|
||||
!C------------------------------------------------------------------
|
||||
!C Evaluate erfC for |X| > 4.0
|
||||
!C------------------------------------------------------------------
|
||||
ELSE
|
||||
RESULT = ZERO
|
||||
IF (Y .GE. XBIG) THEN
|
||||
IF ((JINT .NE. 2) .OR. (Y .GE. XMAX)) GO TO 300
|
||||
IF (Y .GE. XHUGE) THEN
|
||||
RESULT = SQRPI / Y
|
||||
GO TO 300
|
||||
END IF
|
||||
END IF
|
||||
YSQ = ONE / (Y * Y)
|
||||
XNUM = P(6)*YSQ
|
||||
XDEN = YSQ
|
||||
DO I = 1, 4
|
||||
XNUM = (XNUM + P(I)) * YSQ
|
||||
XDEN = (XDEN + Q(I)) * YSQ
|
||||
ENDDO
|
||||
RESULT = YSQ *(XNUM + P(5)) / (XDEN + Q(5))
|
||||
RESULT = (SQRPI - RESULT) / Y
|
||||
IF (JINT .NE. 2) THEN
|
||||
YSQ = AINT(Y*SIXTEN)/SIXTEN
|
||||
DEL = (Y-YSQ)*(Y+YSQ)
|
||||
RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT
|
||||
END IF
|
||||
END IF
|
||||
!C------------------------------------------------------------------
|
||||
!C Fix up for negative argument, erf, etC.
|
||||
!C------------------------------------------------------------------
|
||||
300 IF (JINT .EQ. 0) THEN
|
||||
RESULT = (HALF - RESULT) + HALF
|
||||
IF (X .LT. ZERO) RESULT = -RESULT
|
||||
ELSE IF (JINT .EQ. 1) THEN
|
||||
IF (X .LT. ZERO) RESULT = TWO - RESULT
|
||||
ELSE
|
||||
IF (X .LT. ZERO) THEN
|
||||
IF (X .LT. XNEG) THEN
|
||||
RESULT = XINF
|
||||
ELSE
|
||||
YSQ = AINT(X*SIXTEN)/SIXTEN
|
||||
DEL = (X-YSQ)*(X+YSQ)
|
||||
Y = EXP(YSQ*YSQ) * EXP(DEL)
|
||||
RESULT = (Y+Y) - RESULT
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
800 RETURN
|
||||
END SUBROUTINE CALERF
|
||||
END MODULE ERFCOREMOD
|
||||
@ -1,29 +0,0 @@
|
||||
! -*- f90 -*-
|
||||
! Note: the context of this file is case sensitive.
|
||||
|
||||
python module erfcoremod ! in
|
||||
interface ! in :erfcoremod
|
||||
module erfcoremod ! in :erfcoremod:erfcoremod.f90
|
||||
function derf(x) result (value) ! in :erfcoremod:erfcoremod.f90:erfcoremod
|
||||
double precision intent(in) :: x
|
||||
double precision :: value
|
||||
end function derf
|
||||
function derfc(x) result (value) ! in :erfcoremod:erfcoremod.f90:erfcoremod
|
||||
double precision intent(in) :: x
|
||||
double precision :: value
|
||||
end function derfc
|
||||
function derfcx(x) result (value) ! in :erfcoremod:erfcoremod.f90:erfcoremod
|
||||
double precision intent(in) :: x
|
||||
double precision :: value
|
||||
end function derfcx
|
||||
subroutine calerf(arg,result,jint) ! in :erfcoremod:erfcoremod.f90:erfcoremod
|
||||
double precision intent(in) :: arg
|
||||
double precision intent(inout) :: result
|
||||
integer intent(in) :: jint
|
||||
end subroutine calerf
|
||||
end module erfcoremod
|
||||
end interface
|
||||
end python module erfcoremod
|
||||
|
||||
! This file was auto-generated with f2py (version:2_5972).
|
||||
! See http://cens.ioc.ee/projects/f2py2e/
|
||||
@ -1,346 +0,0 @@
|
||||
C $ f2py -m erfcoremod -h erfcoremod.pyf erfcoremod.f
|
||||
C f2py erfcoremod.pyf erfcoremod.f -c --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71
|
||||
C $ f2py --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71 -m erfcoremod -c erfcoremod.f
|
||||
|
||||
C gfortran -fPIC -c erfcoremod.f
|
||||
C f2py -m erfcoremod -c erfcoremod.o erfcoremod_interface.f
|
||||
|
||||
MODULE ERFCOREMOD
|
||||
C IMPLICIT NONE
|
||||
|
||||
C INTERFACE CALERF
|
||||
C MODULE PROCEDURE CALERF
|
||||
C END INTERFACE
|
||||
|
||||
C INTERFACE DERF
|
||||
C MODULE PROCEDURE DERF
|
||||
C END INTERFACE
|
||||
|
||||
C INTERFACE DERFC
|
||||
C MODULE PROCEDURE DERFC
|
||||
C END INTERFACE
|
||||
|
||||
C INTERFACE DERFCX
|
||||
C MODULE PROCEDURE DERFCX
|
||||
c END INTERFACE
|
||||
CONTAINS
|
||||
C--------------------------------------------------------------------
|
||||
C
|
||||
C DERF subprogram computes approximate values for erf(x).
|
||||
C (see comments heading CALERF).
|
||||
C
|
||||
C Author/date: W. J. Cody, January 8, 1985
|
||||
C
|
||||
C--------------------------------------------------------------------
|
||||
FUNCTION DERF( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 0
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERF
|
||||
C--------------------------------------------------------------------
|
||||
C
|
||||
C DERFC subprogram computes approximate values for erfc(x).
|
||||
C (see comments heading CALERF).
|
||||
C
|
||||
C Author/date: W. J. Cody, January 8, 1985
|
||||
C
|
||||
C--------------------------------------------------------------------
|
||||
FUNCTION DERFC( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 1
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERFC
|
||||
C------------------------------------------------------------------
|
||||
C
|
||||
C DERFCX subprogram computes approximate values for exp(x*x) * erfc(x).
|
||||
C (see comments heading CALERF).
|
||||
C
|
||||
C Author/date: W. J. Cody, March 30, 1987
|
||||
C
|
||||
C------------------------------------------------------------------
|
||||
FUNCTION DERFCX( X ) RESULT (VALUE)
|
||||
IMPLICIT NONE
|
||||
DOUBLE PRECISION, INTENT(IN) :: X
|
||||
DOUBLE PRECISION :: VALUE
|
||||
INTEGER, PARAMETER :: JINT = 2
|
||||
CALL CALERF(X,VALUE,JINT)
|
||||
RETURN
|
||||
END FUNCTION DERFCX
|
||||
|
||||
SUBROUTINE CALERF(ARG,RESULT,JINT)
|
||||
IMPLICIT NONE
|
||||
C------------------------------------------------------------------
|
||||
C
|
||||
C CALERF packet evaluates erf(x), erfc(x), and exp(x*x)*erfc(x)
|
||||
C for a real argument x. It contains three FUNCTION type
|
||||
C subprograms: ERF, ERFC, and ERFCX (or DERF, DERFC, and DERFCX),
|
||||
C and one SUBROUTINE type subprogram, CALERF. The calling
|
||||
C statements for the primary entries are:
|
||||
C
|
||||
C Y=ERF(X) (or Y=DERF(X)),
|
||||
C
|
||||
C Y=ERFC(X) (or Y=DERFC(X)),
|
||||
C and
|
||||
C Y=ERFCX(X) (or Y=DERFCX(X)).
|
||||
C
|
||||
C The routine CALERF is intended for internal packet use only,
|
||||
C all computations within the packet being concentrated in this
|
||||
C routine. The function subprograms invoke CALERF with the
|
||||
C statement
|
||||
C
|
||||
C CALL CALERF(ARG,RESULT,JINT)
|
||||
C
|
||||
C where the parameter usage is as follows
|
||||
C
|
||||
C Function Parameters for CALERF
|
||||
C call ARG Result JINT
|
||||
C
|
||||
C ERF(ARG) ANY REAL ARGUMENT ERF(ARG) 0
|
||||
C ERFC(ARG) ABS(ARG) .LT. XBIG ERFC(ARG) 1
|
||||
C ERFCX(ARG) XNEG .LT. ARG .LT. XMAX ERFCX(ARG) 2
|
||||
C
|
||||
C The main computation evaluates near-minimax approximations
|
||||
C from "Rational Chebyshev approximations for the error function"
|
||||
C by W. J. Cody, Math. Comp., 1969, PP. 631-638. This
|
||||
C transportable program uses rational functions that theoretically
|
||||
C approximate erf(x) and erfc(x) to at least 18 significant
|
||||
C decimal digits. The accuracy achieved depends on the arithmetic
|
||||
C system, the compiler, the intrinsic functions, and proper
|
||||
C selection of the machine-dependent constants.
|
||||
C
|
||||
C*******************************************************************
|
||||
C*******************************************************************
|
||||
C
|
||||
C Explanation of machine-dependent constants
|
||||
C
|
||||
C XMIN = the smallest positive floating-point number.
|
||||
C XINF = the largest positive finite floating-point number.
|
||||
C XNEG = the largest negative argument acceptable to ERFCX;
|
||||
C the negative of the solution to the equation
|
||||
C 2*exp(x*x) = XINF.
|
||||
C XSMALL = argument below which erf(x) may be represented by
|
||||
C 2*x/sqrt(pi) and above which x*x will not underflow.
|
||||
C A conservative value is the largest machine number X
|
||||
C such that 1.0 + X = 1.0 to machine precision.
|
||||
C XBIG = largest argument acceptable to ERFC; solution to
|
||||
C the equation: W(x) * (1-0.5/x**2) = XMIN, where
|
||||
C W(x) = exp(-x*x)/[x*sqrt(pi)].
|
||||
C XHUGE = argument above which 1.0 - 1/(2*x*x) = 1.0 to
|
||||
C machine precision. A conservative value is
|
||||
C 1/[2*sqrt(XSMALL)]
|
||||
C XMAX = largest acceptable argument to ERFCX; the minimum
|
||||
C of XINF and 1/[sqrt(pi)*XMIN].
|
||||
C
|
||||
C Approximate values for some important machines are:
|
||||
C
|
||||
C XMIN XINF XNEG XSMALL
|
||||
C
|
||||
C C 7600 (S.P.) 3.13E-294 1.26E+322 -27.220 7.11E-15
|
||||
C CRAY-1 (S.P.) 4.58E-2467 5.45E+2465 -75.345 7.11E-15
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (S.P.) 1.18E-38 3.40E+38 -9.382 5.96E-8
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (D.P.) 2.23D-308 1.79D+308 -26.628 1.11D-16
|
||||
C IBM 195 (D.P.) 5.40D-79 7.23E+75 -13.190 1.39D-17
|
||||
C UNIVAC 1108 (D.P.) 2.78D-309 8.98D+307 -26.615 1.73D-18
|
||||
C VAX D-Format (D.P.) 2.94D-39 1.70D+38 -9.345 1.39D-17
|
||||
C VAX G-Format (D.P.) 5.56D-309 8.98D+307 -26.615 1.11D-16
|
||||
C
|
||||
C
|
||||
C XBIG XHUGE XMAX
|
||||
C
|
||||
C C 7600 (S.P.) 25.922 8.39E+6 1.80X+293
|
||||
C CRAY-1 (S.P.) 75.326 8.39E+6 5.45E+2465
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (S.P.) 9.194 2.90E+3 4.79E+37
|
||||
C IEEE (IBM/XT,
|
||||
C SUN, etc.) (D.P.) 26.543 6.71D+7 2.53D+307
|
||||
C IBM 195 (D.P.) 13.306 1.90D+8 7.23E+75
|
||||
C UNIVAC 1108 (D.P.) 26.582 5.37D+8 8.98D+307
|
||||
C VAX D-Format (D.P.) 9.269 1.90D+8 1.70D+38
|
||||
C VAX G-Format (D.P.) 26.569 6.71D+7 8.98D+307
|
||||
C
|
||||
C*******************************************************************
|
||||
C*******************************************************************
|
||||
C
|
||||
C Error returns
|
||||
C
|
||||
C The program returns ERFC = 0 for ARG .GE. XBIG;
|
||||
C
|
||||
C ERFCX = XINF for ARG .LT. XNEG;
|
||||
C and
|
||||
C ERFCX = 0 for ARG .GE. XMAX.
|
||||
C
|
||||
C
|
||||
C Intrinsic functions required are:
|
||||
C
|
||||
C ABS, AINT, EXP
|
||||
C
|
||||
C
|
||||
C Author: W. J. Cody
|
||||
C Mathematics and Computer Science Division
|
||||
C Argonne National Laboratory
|
||||
C Argonne, IL 60439
|
||||
C
|
||||
C Latest modification: March 19, 1990
|
||||
C Updated to F90 by pab 23.03.2003
|
||||
C
|
||||
C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, INTENT(IN) :: ARG
|
||||
INTEGER, INTENT(IN) :: JINT
|
||||
DOUBLE PRECISION, INTENT(INOUT):: RESULT
|
||||
! Local variables
|
||||
INTEGER :: I
|
||||
DOUBLE PRECISION :: DEL,X,XDEN,XNUM,Y,YSQ
|
||||
C------------------------------------------------------------------
|
||||
C Mathematical constants
|
||||
C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, PARAMETER :: ZERO = 0.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: HALF = 0.05D0
|
||||
DOUBLE PRECISION, PARAMETER :: ONE = 1.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: TWO = 2.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: FOUR = 4.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: SIXTEN = 16.0D0
|
||||
DOUBLE PRECISION, PARAMETER :: SQRPI = 5.6418958354775628695D-1
|
||||
DOUBLE PRECISION, PARAMETER :: THRESH = 0.46875D0
|
||||
C------------------------------------------------------------------
|
||||
C Machine-dependent constants
|
||||
C------------------------------------------------------------------
|
||||
DOUBLE PRECISION, PARAMETER :: XNEG = -26.628D0
|
||||
DOUBLE PRECISION, PARAMETER :: XSMALL = 1.11D-16
|
||||
DOUBLE PRECISION, PARAMETER :: XBIG = 26.543D0
|
||||
DOUBLE PRECISION, PARAMETER :: XHUGE = 6.71D7
|
||||
DOUBLE PRECISION, PARAMETER :: XMAX = 2.53D307
|
||||
DOUBLE PRECISION, PARAMETER :: XINF = 1.79D308
|
||||
!---------------------------------------------------------------
|
||||
! Coefficents to the rational polynomials
|
||||
!--------------------------------------------------------------
|
||||
DOUBLE PRECISION, DIMENSION(5) :: A, Q
|
||||
DOUBLE PRECISION, DIMENSION(4) :: B
|
||||
DOUBLE PRECISION, DIMENSION(9) :: C
|
||||
DOUBLE PRECISION, DIMENSION(8) :: D
|
||||
DOUBLE PRECISION, DIMENSION(6) :: P
|
||||
C------------------------------------------------------------------
|
||||
C Coefficients for approximation to erf in first interval
|
||||
C------------------------------------------------------------------
|
||||
PARAMETER (A = (/ 3.16112374387056560D00,
|
||||
& 1.13864154151050156D02,3.77485237685302021D02,
|
||||
& 3.20937758913846947D03, 1.85777706184603153D-1/))
|
||||
PARAMETER ( B = (/2.36012909523441209D01,2.44024637934444173D02,
|
||||
& 1.28261652607737228D03,2.84423683343917062D03/))
|
||||
C------------------------------------------------------------------
|
||||
C Coefficients for approximation to erfc in second interval
|
||||
C------------------------------------------------------------------
|
||||
PARAMETER ( C=(/5.64188496988670089D-1,8.88314979438837594D0,
|
||||
1 6.61191906371416295D01,2.98635138197400131D02,
|
||||
2 8.81952221241769090D02,1.71204761263407058D03,
|
||||
3 2.05107837782607147D03,1.23033935479799725D03,
|
||||
4 2.15311535474403846D-8/))
|
||||
PARAMETER ( D =(/1.57449261107098347D01,1.17693950891312499D02,
|
||||
1 5.37181101862009858D02,1.62138957456669019D03,
|
||||
2 3.29079923573345963D03,4.36261909014324716D03,
|
||||
3 3.43936767414372164D03,1.23033935480374942D03/))
|
||||
C------------------------------------------------------------------
|
||||
C Coefficients for approximation to erfc in third interval
|
||||
C------------------------------------------------------------------
|
||||
PARAMETER ( P =(/3.05326634961232344D-1,3.60344899949804439D-1,
|
||||
1 1.25781726111229246D-1,1.60837851487422766D-2,
|
||||
2 6.58749161529837803D-4,1.63153871373020978D-2/))
|
||||
PARAMETER (Q =(/2.56852019228982242D00,1.87295284992346047D00,
|
||||
1 5.27905102951428412D-1,6.05183413124413191D-2,
|
||||
2 2.33520497626869185D-3/))
|
||||
C------------------------------------------------------------------
|
||||
X = ARG
|
||||
Y = ABS(X)
|
||||
IF (Y .LE. THRESH) THEN
|
||||
C------------------------------------------------------------------
|
||||
C Evaluate erf for |X| <= 0.46875
|
||||
C------------------------------------------------------------------
|
||||
!YSQ = ZERO
|
||||
IF (Y .GT. XSMALL) THEN
|
||||
YSQ = Y * Y
|
||||
XNUM = A(5)*YSQ
|
||||
XDEN = YSQ
|
||||
DO I = 1, 3
|
||||
XNUM = (XNUM + A(I)) * YSQ
|
||||
XDEN = (XDEN + B(I)) * YSQ
|
||||
END DO
|
||||
RESULT = X * (XNUM + A(4)) / (XDEN + B(4))
|
||||
ELSE
|
||||
RESULT = X * A(4) / B(4)
|
||||
ENDIF
|
||||
IF (JINT .NE. 0) RESULT = ONE - RESULT
|
||||
IF (JINT .EQ. 2) RESULT = EXP(YSQ) * RESULT
|
||||
GO TO 800
|
||||
C------------------------------------------------------------------
|
||||
C Evaluate erfc for 0.46875 <= |X| <= 4.0
|
||||
C------------------------------------------------------------------
|
||||
ELSE IF (Y .LE. FOUR) THEN
|
||||
XNUM = C(9)*Y
|
||||
XDEN = Y
|
||||
DO I = 1, 7
|
||||
XNUM = (XNUM + C(I)) * Y
|
||||
XDEN = (XDEN + D(I)) * Y
|
||||
END DO
|
||||
RESULT = (XNUM + C(8)) / (XDEN + D(8))
|
||||
IF (JINT .NE. 2) THEN
|
||||
YSQ = AINT(Y*SIXTEN)/SIXTEN
|
||||
DEL = (Y-YSQ)*(Y+YSQ)
|
||||
RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT
|
||||
END IF
|
||||
C------------------------------------------------------------------
|
||||
C Evaluate erfc for |X| > 4.0
|
||||
C------------------------------------------------------------------
|
||||
ELSE
|
||||
RESULT = ZERO
|
||||
IF (Y .GE. XBIG) THEN
|
||||
IF ((JINT .NE. 2) .OR. (Y .GE. XMAX)) GO TO 300
|
||||
IF (Y .GE. XHUGE) THEN
|
||||
RESULT = SQRPI / Y
|
||||
GO TO 300
|
||||
END IF
|
||||
END IF
|
||||
YSQ = ONE / (Y * Y)
|
||||
XNUM = P(6)*YSQ
|
||||
XDEN = YSQ
|
||||
DO I = 1, 4
|
||||
XNUM = (XNUM + P(I)) * YSQ
|
||||
XDEN = (XDEN + Q(I)) * YSQ
|
||||
ENDDO
|
||||
RESULT = YSQ *(XNUM + P(5)) / (XDEN + Q(5))
|
||||
RESULT = (SQRPI - RESULT) / Y
|
||||
IF (JINT .NE. 2) THEN
|
||||
YSQ = AINT(Y*SIXTEN)/SIXTEN
|
||||
DEL = (Y-YSQ)*(Y+YSQ)
|
||||
RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT
|
||||
END IF
|
||||
END IF
|
||||
C------------------------------------------------------------------
|
||||
C Fix up for negative argument, erf, etc.
|
||||
C------------------------------------------------------------------
|
||||
300 IF (JINT .EQ. 0) THEN
|
||||
RESULT = (HALF - RESULT) + HALF
|
||||
IF (X .LT. ZERO) RESULT = -RESULT
|
||||
ELSE IF (JINT .EQ. 1) THEN
|
||||
IF (X .LT. ZERO) RESULT = TWO - RESULT
|
||||
ELSE
|
||||
IF (X .LT. ZERO) THEN
|
||||
IF (X .LT. XNEG) THEN
|
||||
RESULT = XINF
|
||||
ELSE
|
||||
YSQ = AINT(X*SIXTEN)/SIXTEN
|
||||
DEL = (X-YSQ)*(X+YSQ)
|
||||
Y = EXP(YSQ*YSQ) * EXP(DEL)
|
||||
RESULT = (Y+Y) - RESULT
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
800 RETURN
|
||||
END SUBROUTINE CALERF
|
||||
END MODULE ERFCOREMOD
|
||||
@ -1,27 +0,0 @@
|
||||
! -*- f90 -*-
|
||||
! Note: the context of this file is case sensitive.
|
||||
|
||||
python module erfcoremod ! in
|
||||
interface ! in :erfcoremod
|
||||
function derf(x) result (value) ! in :erfcoremod:erfcoremod.f
|
||||
double precision intent(in) :: x
|
||||
double precision :: value
|
||||
end function derf
|
||||
function derfc(x) result (value) ! in :erfcoremod:erfcoremod.f
|
||||
double precision intent(in) :: x
|
||||
double precision :: value
|
||||
end function derfc
|
||||
function derfcx(x) result (value) ! in :erfcoremod:erfcoremod.f
|
||||
double precision intent(in) :: x
|
||||
double precision :: value
|
||||
end function derfcx
|
||||
subroutine calerf(arg,result,jint) ! in :erfcoremod:erfcoremod.f
|
||||
double precision intent(in) :: arg
|
||||
double precision intent(inout) :: result
|
||||
integer intent(in) :: jint
|
||||
end subroutine calerf
|
||||
end interface
|
||||
end python module erfcoremod
|
||||
|
||||
! This file was auto-generated with f2py (version:2_5972).
|
||||
! See http://cens.ioc.ee/projects/f2py2e/
|
||||
@ -1,11 +0,0 @@
|
||||
|
||||
module bindings
|
||||
use erfcoremod
|
||||
contains
|
||||
function pyderf(x) result (value) ! in :erfcore:erfcore.f
|
||||
double precision intent(in) :: x
|
||||
double precision :: value
|
||||
value = derf(x)
|
||||
return
|
||||
end function pyderf
|
||||
end module bindings
|
||||
@ -1,608 +0,0 @@
|
||||
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
|
||||
<?fileVersion 4.0.0?>
|
||||
|
||||
<cproject>
|
||||
<storageModule moduleId="org.eclipse.cdt.core.settings">
|
||||
<cconfiguration id="photran.managedbuild.config.gnu.fortran.exe.debug.693559895">
|
||||
<storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="photran.managedbuild.config.gnu.fortran.exe.debug.693559895" moduleId="org.eclipse.cdt.core.settings" name="Debug">
|
||||
<externalSettings/>
|
||||
<extensions>
|
||||
<extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
|
||||
<extension id="org.eclipse.photran.core.GFortranErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
|
||||
<extension id="org.eclipse.cdt.core.MakeErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
|
||||
<extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
|
||||
<extension id="org.eclipse.cdt.core.GASErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
|
||||
<extension id="org.eclipse.cdt.core.GLDErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
|
||||
</extensions>
|
||||
</storageModule>
|
||||
<storageModule moduleId="cdtBuildSystem" version="4.0.0">
|
||||
<configuration artifactName="test_rind" buildProperties="" cleanCommand="rm -rf" description="" errorParsers="org.eclipse.cdt.core.MakeErrorParser;org.eclipse.photran.core.GFortranErrorParser;org.eclipse.cdt.core.GCCErrorParser;org.eclipse.cdt.core.GLDErrorParser;org.eclipse.cdt.core.GASErrorParser" id="photran.managedbuild.config.gnu.fortran.exe.debug.693559895" name="Debug" parent="photran.managedbuild.config.gnu.fortran.exe.debug">
|
||||
<folderInfo id="photran.managedbuild.config.gnu.fortran.exe.debug.693559895." name="/" resourcePath="">
|
||||
<toolChain id="photran.managedbuild.toolchain.gnu.fortran.exe.debug.98955136" name="GCC Tool Chain" superClass="photran.managedbuild.toolchain.gnu.fortran.exe.debug">
|
||||
<targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="photran.managedbuild.target.gnu.platform.exe.debug.448464265" name="Debug Platform" osList="solaris,linux,hpux,aix,qnx" superClass="photran.managedbuild.target.gnu.platform.exe.debug"/>
|
||||
<builder buildPath="${workspace_loc:/test_rind/Debug}" id="photran.managedbuild.target.gnu.builder.exe.debug.228087524" keepEnvironmentInBuildfile="false" managedBuildOn="true" name="Gnu Make" superClass="photran.managedbuild.target.gnu.builder.exe.debug"/>
|
||||
<tool id="photran.managedbuild.tool.gnu.c.compiler.exe.debug.519131482" name="GCC C Compiler" superClass="photran.managedbuild.tool.gnu.c.compiler.exe.debug">
|
||||
<inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.1684844008" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
|
||||
</tool>
|
||||
<tool id="photran.managedbuild.tool.gnu.fortran.compiler.exe.debug.1751010073" name="GNU Fortran Compiler" superClass="photran.managedbuild.tool.gnu.fortran.compiler.exe.debug">
|
||||
<inputType id="photran.managedbuild.tool.gnu.fortran.compiler.input.371213356" superClass="photran.managedbuild.tool.gnu.fortran.compiler.input"/>
|
||||
</tool>
|
||||
<tool id="photran.managedbuild.tool.gnu.fortran.linker.exe.debug.1367043514" name="GNU Fortran Linker" superClass="photran.managedbuild.tool.gnu.fortran.linker.exe.debug"/>
|
||||
<tool id="photran.managedbuild.tool.gnu.assembler.exe.debug.1200302616" name="GCC Assembler" superClass="photran.managedbuild.tool.gnu.assembler.exe.debug">
|
||||
<inputType id="cdt.managedbuild.tool.gnu.assembler.input.1874676568" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
|
||||
</tool>
|
||||
</toolChain>
|
||||
</folderInfo>
|
||||
<sourceEntries>
|
||||
<entry excluding="test_rindmod2007.dsw|test_rindmod2007.dsp|test_fimod.dsw|test_fimod.dsp|rind2007_interface.f|erfcoremod.f" flags="VALUE_WORKSPACE_PATH|RESOLVED" kind="sourcePath" name=""/>
|
||||
</sourceEntries>
|
||||
</configuration>
|
||||
</storageModule>
|
||||
<storageModule moduleId="scannerConfiguration">
|
||||
<autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId="org.eclipse.cdt.make.core.GCCStandardMakePerProjectProfile"/>
|
||||
<profile id="org.eclipse.cdt.make.core.GCCStandardMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.make.core.GCCStandardMakePerFileProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="makefileGenerator">
|
||||
<runAction arguments="-f ${project_name}_scd.mk" command="make" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfileCPP">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.cpp" command="g++" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfileC">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.c" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfileCPP">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.cpp" command="g++" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfileC">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.c" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<scannerConfigBuildInfo instanceId="photran.managedbuild.config.gnu.fortran.exe.debug.693559895;photran.managedbuild.config.gnu.fortran.exe.debug.693559895.">
|
||||
<autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfile"/>
|
||||
<profile id="org.eclipse.cdt.make.core.GCCStandardMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.make.core.GCCStandardMakePerFileProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="makefileGenerator">
|
||||
<runAction arguments="-f ${project_name}_scd.mk" command="make" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfileCPP">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.cpp" command="g++" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfileC">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.c" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfileCPP">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.cpp" command="g++" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfileC">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.c" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
</scannerConfigBuildInfo>
|
||||
<scannerConfigBuildInfo instanceId="photran.managedbuild.config.gnu.fortran.exe.debug.693559895;photran.managedbuild.config.gnu.fortran.exe.debug.693559895.;photran.managedbuild.tool.gnu.c.compiler.exe.debug.519131482;cdt.managedbuild.tool.gnu.c.compiler.input.1684844008">
|
||||
<autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfileC"/>
|
||||
<profile id="org.eclipse.cdt.make.core.GCCStandardMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.make.core.GCCStandardMakePerFileProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="makefileGenerator">
|
||||
<runAction arguments="-f ${project_name}_scd.mk" command="make" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfileCPP">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.cpp" command="g++" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfileC">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.c" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfileCPP">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.cpp" command="g++" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfileC">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.c" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
</scannerConfigBuildInfo>
|
||||
</storageModule>
|
||||
<storageModule moduleId="org.eclipse.cdt.core.externalSettings"/>
|
||||
<storageModule moduleId="org.eclipse.cdt.core.language.mapping"/>
|
||||
<storageModule moduleId="org.eclipse.cdt.make.core.buildtargets">
|
||||
<buildTargets>
|
||||
<target name="test_fimod.exe" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
|
||||
<buildCommand>make</buildCommand>
|
||||
<buildArguments/>
|
||||
<buildTarget/>
|
||||
<stopOnError>true</stopOnError>
|
||||
<useDefaultCommand>true</useDefaultCommand>
|
||||
<runAllBuilders>true</runAllBuilders>
|
||||
</target>
|
||||
</buildTargets>
|
||||
</storageModule>
|
||||
</cconfiguration>
|
||||
<cconfiguration id="photran.managedbuild.config.gnu.fortran.exe.release.422835654">
|
||||
<storageModule buildSystemId="org.eclipse.cdt.managedbuilder.core.configurationDataProvider" id="photran.managedbuild.config.gnu.fortran.exe.release.422835654" moduleId="org.eclipse.cdt.core.settings" name="Release">
|
||||
<externalSettings/>
|
||||
<extensions>
|
||||
<extension id="org.eclipse.cdt.core.PE" point="org.eclipse.cdt.core.BinaryParser"/>
|
||||
<extension id="org.eclipse.photran.core.GFortranErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
|
||||
<extension id="org.eclipse.cdt.core.MakeErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
|
||||
<extension id="org.eclipse.cdt.core.GCCErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
|
||||
<extension id="org.eclipse.cdt.core.GASErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
|
||||
<extension id="org.eclipse.cdt.core.GLDErrorParser" point="org.eclipse.cdt.core.ErrorParser"/>
|
||||
</extensions>
|
||||
</storageModule>
|
||||
<storageModule moduleId="cdtBuildSystem" version="4.0.0">
|
||||
<configuration artifactName="test_rind" buildProperties="" cleanCommand="rm -rf" description="" errorParsers="org.eclipse.cdt.core.MakeErrorParser;org.eclipse.photran.core.GFortranErrorParser;org.eclipse.cdt.core.GCCErrorParser;org.eclipse.cdt.core.GLDErrorParser;org.eclipse.cdt.core.GASErrorParser" id="photran.managedbuild.config.gnu.fortran.exe.release.422835654" name="Release" parent="photran.managedbuild.config.gnu.fortran.exe.release">
|
||||
<folderInfo id="photran.managedbuild.config.gnu.fortran.exe.release.422835654." name="/" resourcePath="">
|
||||
<toolChain id="photran.managedbuild.toolchain.gnu.fortran.exe.release.463973013" name="GCC Tool Chain" superClass="photran.managedbuild.toolchain.gnu.fortran.exe.release">
|
||||
<targetPlatform archList="all" binaryParser="org.eclipse.cdt.core.PE" id="photran.managedbuild.target.gnu.platform.fortran.exe.release.1125455818" name="Release Platform" osList="solaris,linux,hpux,aix,qnx" superClass="photran.managedbuild.target.gnu.platform.fortran.exe.release"/>
|
||||
<builder buildPath="${workspace_loc:/test_rind/Release}" id="photran.managedbuild.target.gnu.builder.exe.release.1060682441" keepEnvironmentInBuildfile="false" managedBuildOn="true" name="Gnu Make" superClass="photran.managedbuild.target.gnu.builder.exe.release"/>
|
||||
<tool id="photran.managedbuild.tool.gnu.c.compiler.exe.release.1267163105" name="GCC C Compiler" superClass="photran.managedbuild.tool.gnu.c.compiler.exe.release">
|
||||
<inputType id="cdt.managedbuild.tool.gnu.c.compiler.input.357491907" superClass="cdt.managedbuild.tool.gnu.c.compiler.input"/>
|
||||
</tool>
|
||||
<tool id="photran.managedbuild.tool.gnu.fortran.compiler.exe.release.117952537" name="GNU Fortran Compiler" superClass="photran.managedbuild.tool.gnu.fortran.compiler.exe.release">
|
||||
<inputType id="photran.managedbuild.tool.gnu.fortran.compiler.input.487274176" superClass="photran.managedbuild.tool.gnu.fortran.compiler.input"/>
|
||||
</tool>
|
||||
<tool id="photran.managedbuild.tool.gnu.fortran.linker.exe.release.419305482" name="GNU Fortran Linker" superClass="photran.managedbuild.tool.gnu.fortran.linker.exe.release"/>
|
||||
<tool id="photran.managedbuild.tool.gnu.assembler.exe.release.1163040062" name="GCC Assembler" superClass="photran.managedbuild.tool.gnu.assembler.exe.release">
|
||||
<inputType id="cdt.managedbuild.tool.gnu.assembler.input.825452571" superClass="cdt.managedbuild.tool.gnu.assembler.input"/>
|
||||
</tool>
|
||||
</toolChain>
|
||||
</folderInfo>
|
||||
<sourceEntries>
|
||||
<entry excluding="test_rindmod2007.dsw|test_rindmod2007.dsp|test_fimod.dsw|test_fimod.dsp" flags="VALUE_WORKSPACE_PATH|RESOLVED" kind="sourcePath" name=""/>
|
||||
</sourceEntries>
|
||||
</configuration>
|
||||
</storageModule>
|
||||
<storageModule moduleId="scannerConfiguration">
|
||||
<autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId="org.eclipse.cdt.make.core.GCCStandardMakePerProjectProfile"/>
|
||||
<profile id="org.eclipse.cdt.make.core.GCCStandardMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.make.core.GCCStandardMakePerFileProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="makefileGenerator">
|
||||
<runAction arguments="-f ${project_name}_scd.mk" command="make" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfileCPP">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.cpp" command="g++" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfileC">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.c" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfileCPP">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.cpp" command="g++" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfileC">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.c" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<scannerConfigBuildInfo instanceId="photran.managedbuild.config.gnu.fortran.exe.debug.693559895;photran.managedbuild.config.gnu.fortran.exe.debug.693559895.">
|
||||
<autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfile"/>
|
||||
<profile id="org.eclipse.cdt.make.core.GCCStandardMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.make.core.GCCStandardMakePerFileProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="makefileGenerator">
|
||||
<runAction arguments="-f ${project_name}_scd.mk" command="make" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfileCPP">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.cpp" command="g++" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfileC">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.c" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfileCPP">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.cpp" command="g++" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfileC">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.c" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
</scannerConfigBuildInfo>
|
||||
<scannerConfigBuildInfo instanceId="photran.managedbuild.config.gnu.fortran.exe.debug.693559895;photran.managedbuild.config.gnu.fortran.exe.debug.693559895.;photran.managedbuild.tool.gnu.c.compiler.exe.debug.519131482;cdt.managedbuild.tool.gnu.c.compiler.input.1684844008">
|
||||
<autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfileC"/>
|
||||
<profile id="org.eclipse.cdt.make.core.GCCStandardMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.make.core.GCCStandardMakePerFileProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="makefileGenerator">
|
||||
<runAction arguments="-f ${project_name}_scd.mk" command="make" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfileCPP">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.cpp" command="g++" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfileC">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.c" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfile">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfileCPP">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.cpp" command="g++" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
<profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfileC">
|
||||
<buildOutputProvider>
|
||||
<openAction enabled="true" filePath=""/>
|
||||
<parser enabled="true"/>
|
||||
</buildOutputProvider>
|
||||
<scannerInfoProvider id="specsFile">
|
||||
<runAction arguments="-E -P -v -dD ${plugin_state_location}/specs.c" command="gcc" useDefault="true"/>
|
||||
<parser enabled="true"/>
|
||||
</scannerInfoProvider>
|
||||
</profile>
|
||||
</scannerConfigBuildInfo>
|
||||
</storageModule>
|
||||
<storageModule moduleId="org.eclipse.cdt.core.language.mapping"/>
|
||||
<storageModule moduleId="org.eclipse.cdt.core.externalSettings"/>
|
||||
<storageModule moduleId="org.eclipse.cdt.make.core.buildtargets">
|
||||
<buildTargets>
|
||||
<target name="test_fimod.exe" path="" targetID="org.eclipse.cdt.build.MakeTargetBuilder">
|
||||
<buildCommand>make</buildCommand>
|
||||
<buildArguments/>
|
||||
<buildTarget/>
|
||||
<stopOnError>true</stopOnError>
|
||||
<useDefaultCommand>true</useDefaultCommand>
|
||||
<runAllBuilders>true</runAllBuilders>
|
||||
</target>
|
||||
</buildTargets>
|
||||
</storageModule>
|
||||
</cconfiguration>
|
||||
</storageModule>
|
||||
<storageModule moduleId="cdtBuildSystem" version="4.0.0">
|
||||
<project id="test_rind.photran.managedbuild.target.gnu.fortran.exe.1781229594" name="Executable (Gnu Fortran)" projectType="photran.managedbuild.target.gnu.fortran.exe"/>
|
||||
</storageModule>
|
||||
</cproject>
|
||||
@ -1,81 +0,0 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<projectDescription>
|
||||
<name>test_rind</name>
|
||||
<comment></comment>
|
||||
<projects>
|
||||
</projects>
|
||||
<buildSpec>
|
||||
<buildCommand>
|
||||
<name>org.eclipse.cdt.managedbuilder.core.genmakebuilder</name>
|
||||
<triggers>clean,full,incremental,</triggers>
|
||||
<arguments>
|
||||
<dictionary>
|
||||
<key>?name?</key>
|
||||
<value></value>
|
||||
</dictionary>
|
||||
<dictionary>
|
||||
<key>org.eclipse.cdt.make.core.append_environment</key>
|
||||
<value>true</value>
|
||||
</dictionary>
|
||||
<dictionary>
|
||||
<key>org.eclipse.cdt.make.core.autoBuildTarget</key>
|
||||
<value>all</value>
|
||||
</dictionary>
|
||||
<dictionary>
|
||||
<key>org.eclipse.cdt.make.core.buildArguments</key>
|
||||
<value></value>
|
||||
</dictionary>
|
||||
<dictionary>
|
||||
<key>org.eclipse.cdt.make.core.buildCommand</key>
|
||||
<value>make</value>
|
||||
</dictionary>
|
||||
<dictionary>
|
||||
<key>org.eclipse.cdt.make.core.buildLocation</key>
|
||||
<value>${workspace_loc:/test_rind/Debug}</value>
|
||||
</dictionary>
|
||||
<dictionary>
|
||||
<key>org.eclipse.cdt.make.core.cleanBuildTarget</key>
|
||||
<value>clean</value>
|
||||
</dictionary>
|
||||
<dictionary>
|
||||
<key>org.eclipse.cdt.make.core.contents</key>
|
||||
<value>org.eclipse.cdt.make.core.activeConfigSettings</value>
|
||||
</dictionary>
|
||||
<dictionary>
|
||||
<key>org.eclipse.cdt.make.core.enableAutoBuild</key>
|
||||
<value>false</value>
|
||||
</dictionary>
|
||||
<dictionary>
|
||||
<key>org.eclipse.cdt.make.core.enableCleanBuild</key>
|
||||
<value>true</value>
|
||||
</dictionary>
|
||||
<dictionary>
|
||||
<key>org.eclipse.cdt.make.core.enableFullBuild</key>
|
||||
<value>true</value>
|
||||
</dictionary>
|
||||
<dictionary>
|
||||
<key>org.eclipse.cdt.make.core.fullBuildTarget</key>
|
||||
<value>all</value>
|
||||
</dictionary>
|
||||
<dictionary>
|
||||
<key>org.eclipse.cdt.make.core.stopOnError</key>
|
||||
<value>true</value>
|
||||
</dictionary>
|
||||
<dictionary>
|
||||
<key>org.eclipse.cdt.make.core.useDefaultBuildCmd</key>
|
||||
<value>true</value>
|
||||
</dictionary>
|
||||
</arguments>
|
||||
</buildCommand>
|
||||
<buildCommand>
|
||||
<name>org.eclipse.cdt.managedbuilder.core.ScannerConfigBuilder</name>
|
||||
<arguments>
|
||||
</arguments>
|
||||
</buildCommand>
|
||||
</buildSpec>
|
||||
<natures>
|
||||
<nature>org.eclipse.cdt.managedbuilder.core.ScannerConfigNature</nature>
|
||||
<nature>org.eclipse.cdt.managedbuilder.core.managedBuildNature</nature>
|
||||
<nature>org.eclipse.cdt.core.cnature</nature>
|
||||
</natures>
|
||||
</projectDescription>
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue