Initial import of original WAFO code.
daviddrazen
15 years ago
commit
6f5bcd9eed
@ -0,0 +1,4 @@
|
||||
|
||||
import os
|
||||
|
||||
os.system('epydoc --html -o html --name wafo --graph all src/wafo')
|
||||
@ -0,0 +1,22 @@
|
||||
setup.py
|
||||
src\wafo\__init__.py
|
||||
src\wafo\dctpack.py
|
||||
src\wafo\definitions.py
|
||||
src\wafo\demo_sg.py
|
||||
src\wafo\info.py
|
||||
src\wafo\interpolate.py
|
||||
src\wafo\kdetools.py
|
||||
src\wafo\misc.py
|
||||
src\wafo\namedtuple.py
|
||||
src\wafo\objects.py
|
||||
src\wafo\plotbackend.py
|
||||
src\wafo\polynomial.py
|
||||
src\wafo\polynomial_old.py
|
||||
src\wafo\sg_filter.py
|
||||
src\wafo\data\__init__.py
|
||||
src\wafo\data\info.py
|
||||
src\wafo\spectrum\__init__.py
|
||||
src\wafo\spectrum\dispersion_relation.py
|
||||
src\wafo\spectrum\models.py
|
||||
src\wafo\transform\__init__.py
|
||||
src\wafo\transform\models.py
|
||||
@ -0,0 +1,56 @@
|
||||
"""
|
||||
Install wafo
|
||||
|
||||
Usage:
|
||||
|
||||
python setup.py install [, --prefix=$PREFIX]
|
||||
|
||||
python setup.py develop
|
||||
python setup.py bdist_wininst
|
||||
"""
|
||||
#!/usr/bin/env python
|
||||
import os, sys
|
||||
|
||||
# make sure we import from WAFO in this package, not an installed one:
|
||||
sys.path.insert(0, os.path.join('src'))
|
||||
import wafo
|
||||
|
||||
if __file__ == 'setupegg.py':
|
||||
# http://peak.telecommunity.com/DevCenter/setuptools
|
||||
from setuptools import setup, Extension
|
||||
else:
|
||||
from distutils.core import setup
|
||||
|
||||
package_name = "wafo"
|
||||
subpackages = ('spectrum','data','transform','covariance')
|
||||
subpackagesfull = [os.path.join(package_name,f) for f in subpackages]
|
||||
subtests = [os.path.join(subpkg,'test') for subpkg in subpackages]
|
||||
|
||||
testscripts = [os.path.join(subtst, f) for subtst in subtests
|
||||
for f in os.listdir(os.path.join('src',package_name,subtst))
|
||||
if not (f.startswith('.') or f.endswith('~') or
|
||||
f.endswith('.old') or f.endswith('.bak'))]
|
||||
datadir = 'data'
|
||||
datafiles = [os.path.join(datadir, f) for f in os.listdir(os.path.join('src',package_name,datadir))
|
||||
if not (f.endswith('.py') or f.endswith('test') )]
|
||||
#docs = [os.path.join('doc', f) for f in os.listdir('doc')]
|
||||
packagedata = testscripts + datafiles + ['c_library.pyd'] #,'disufq1.c','diffsumfunq.pyd','diffsumfunq.pyf','findrfc.c','rfc.pyd','rfc.pyf']
|
||||
|
||||
|
||||
setup(
|
||||
version = '0.11',
|
||||
author='WAFO-group',
|
||||
author_email='wafo@maths.lth.se',
|
||||
description = wafo.__doc__,
|
||||
license = "GPL",
|
||||
url='http://www.maths.lth.se/matstat/wafo/',
|
||||
name = package_name.upper(),
|
||||
package_dir = {'': 'src'},
|
||||
packages = [package_name,] + list(subpackagesfull),
|
||||
package_data = {package_name: packagedata},
|
||||
#package_data = {'': ['wafo.cfg']},
|
||||
#scripts = [os.path.join('bin', f)
|
||||
# for f in os.listdir('bin')
|
||||
# if not (f.startswith('.') or f.endswith('~') or
|
||||
# f.endswith('.old') or f.endswith('.bak'))],
|
||||
)
|
||||
@ -0,0 +1,9 @@
|
||||
|
||||
from info import __doc__
|
||||
import wafo.misc
|
||||
import wafo.data
|
||||
import wafo.objects
|
||||
import wafo.spectrum
|
||||
import wafo.transform
|
||||
import wafo.definitions
|
||||
import wafo.polynomial
|
||||
Binary file not shown.
@ -0,0 +1,7 @@
|
||||
"""
|
||||
Covariance package in WAFO Toolbox.
|
||||
"""
|
||||
|
||||
from core import CovData1D
|
||||
#import models
|
||||
#import dispersion_relation
|
||||
@ -0,0 +1,826 @@
|
||||
'''
|
||||
CovData1D
|
||||
---------
|
||||
data : Covariance function values. Size [ny nx nt], all singleton dim. removed.
|
||||
args : Lag of first space dimension, length nx.
|
||||
h : Water depth.
|
||||
tr : Transformation function.
|
||||
type : 'enc', 'rot' or 'none'.
|
||||
v : Ship speed, if .type='enc'
|
||||
phi : Rotation of coordinate system, e.g. direction of ship
|
||||
norm : Normalization flag, Logical 1 if autocorrelation, 0 if covariance.
|
||||
Rx, ... ,Rtttt : Obvious derivatives of .R.
|
||||
note : Memorandum string.
|
||||
date : Date and time of creation or change.
|
||||
'''
|
||||
|
||||
from __future__ import division
|
||||
import warnings
|
||||
#import numpy as np
|
||||
from numpy import (zeros, sqrt, dot, newaxis, inf, where, pi, nan, #@UnresolvedImport
|
||||
atleast_1d, hstack, vstack, r_, linspace, flatnonzero, size, #@UnresolvedImport
|
||||
isnan, finfo, diag, ceil, floor, random) #@UnresolvedImport
|
||||
from numpy.fft import fft
|
||||
from numpy.random import randn
|
||||
import scipy.interpolate as interpolate
|
||||
from scipy.linalg import toeplitz, sqrtm, svd, cholesky, diagsvd, pinv
|
||||
from scipy import sparse
|
||||
from pylab import stineman_interp
|
||||
|
||||
from wafo.wafodata import WafoData
|
||||
from wafo.misc import sub_dict_select, nextpow2 #, JITImport
|
||||
import wafo.spectrum as _wafospec
|
||||
#_wafospec = JITImport('wafo.spectrum')
|
||||
|
||||
|
||||
__all__ = ['CovData1D']
|
||||
|
||||
def _set_seed(iseed):
|
||||
if iseed != None:
|
||||
try:
|
||||
random.set_state(iseed)
|
||||
except:
|
||||
random.seed(iseed)
|
||||
|
||||
|
||||
#def rndnormnd(cov, mean=0.0, cases=1, method='svd'):
|
||||
# '''
|
||||
# Random vectors from a multivariate Normal distribution
|
||||
#
|
||||
# Parameters
|
||||
# ----------
|
||||
# mean, cov : array-like
|
||||
# mean and covariance, respectively.
|
||||
# cases : scalar integer
|
||||
# number of sample vectors
|
||||
# method : string
|
||||
# defining squareroot method for covariance
|
||||
# 'svd' : Singular value decomp. (stable, quite fast) (default)
|
||||
# 'chol' : Cholesky decomposition (fast, but unstable)
|
||||
# 'sqrtm' : sqrtm (stable and slow)
|
||||
#
|
||||
# Returns
|
||||
# -------
|
||||
# r : matrix of random numbers from the multivariate normal
|
||||
# distribution with the given mean and covariance matrix.
|
||||
#
|
||||
# The covariance must be a symmetric, semi-positive definite matrix with shape
|
||||
# equal to the size of the mean. METHOD used for calculating the square root
|
||||
# of COV is either svd, cholesky or sqrtm. (cholesky is fastest but least accurate.)
|
||||
# When cholesky is chosen and S is not positive definite, the svd-method
|
||||
# is used instead.
|
||||
#
|
||||
# Example
|
||||
# -------
|
||||
# mu = [0, 5]
|
||||
# S = [[1 0.45], [0.45 0.25]]
|
||||
# r = rndnormnd(S, mu, 1)
|
||||
# plot(r(:,1),r(:,2),'.')
|
||||
#
|
||||
# d = 40; rho = 2*rand(1,d)-1;
|
||||
# mu = zeros(0,d);
|
||||
# S = (rho.'*rho-diag(rho.^2))+eye(d);
|
||||
# r = rndnormnd(S,mu,100,'genchol')';
|
||||
#
|
||||
# See also
|
||||
# --------
|
||||
# chol, svd, sqrtm, genchol
|
||||
# '''
|
||||
# sa = np.atleast_2d(cov)
|
||||
# mu = np.atleast_1d(mean).ravel()
|
||||
# m, n = sa.shape
|
||||
# if m != n:
|
||||
# raise ValueError('Covariance must be square')
|
||||
# def svdfun(sa):
|
||||
# u, s, vh = svd(sa, full_matrices=False)
|
||||
# sqt = diagsvd(sqrt(s))
|
||||
# return dot(u, dot(sqt, vh))
|
||||
#
|
||||
# sqrtfuns = dict(sqrtm=sqrtm, svd=svdfun, cholesky=cholesky)
|
||||
# sqrtfun = sqrtfuns[method]
|
||||
# std = sqrtfun(sa)
|
||||
# return dot(std,random.randn(n, cases)) + mu[:,newaxis]
|
||||
|
||||
|
||||
class CovData1D(WafoData):
|
||||
""" Container class for 1D covariance data objects in WAFO
|
||||
|
||||
Member variables
|
||||
----------------
|
||||
data : array_like
|
||||
args : vector for 1D, list of vectors for 2D, 3D, ...
|
||||
|
||||
type : string
|
||||
spectrum type, one of 'freq', 'k1d', 'enc' (default 'freq')
|
||||
lagtype : letter
|
||||
lag type, one of: 'x', 'y' or 't' (default 't')
|
||||
|
||||
|
||||
Examples
|
||||
--------
|
||||
>>> import numpy as np
|
||||
>>> import wafo.spectrum as sp
|
||||
>>> Sj = sp.models.Jonswap(Hm0=3)
|
||||
>>> w = np.linspace(0,4,256)
|
||||
>>> S = sp.SpecData1D(Sj(w),w) #Make spectrum object from numerical values
|
||||
|
||||
See also
|
||||
--------
|
||||
WafoData
|
||||
CovData
|
||||
"""
|
||||
|
||||
def __init__(self,*args,**kwds):
|
||||
super(CovData1D, self).__init__(*args,**kwds)
|
||||
|
||||
self.name = 'WAFO Covariance Object'
|
||||
self.type = 'time'
|
||||
self.lagtype = 't'
|
||||
self.h = inf
|
||||
self.tr = None
|
||||
self.phi = 0.
|
||||
self.v = 0.
|
||||
self.norm = 0
|
||||
somekeys = ['phi', 'name', 'h', 'tr', 'lagtype', 'v', 'type', 'norm']
|
||||
|
||||
self.__dict__.update(sub_dict_select(kwds,somekeys))
|
||||
|
||||
self.setlabels()
|
||||
def setlabels(self):
|
||||
''' Set automatic title, x-,y- and z- labels
|
||||
|
||||
based on type,
|
||||
'''
|
||||
|
||||
N = len(self.type)
|
||||
if N==0:
|
||||
raise ValueError('Object does not appear to be initialized, it is empty!')
|
||||
|
||||
labels = ['','ACF','']
|
||||
|
||||
if self.lagtype.startswith('t'):
|
||||
labels[0] = 'Lag [s]'
|
||||
else:
|
||||
labels[0] = 'Lag [m]'
|
||||
|
||||
if self.norm:
|
||||
title = 'Auto Correlation Function '
|
||||
labels[0] = labels[0].split('[')[0]
|
||||
else:
|
||||
title = 'Auto Covariance Function '
|
||||
|
||||
self.labels.title = title
|
||||
self.labels.xlab = labels[0]
|
||||
self.labels.ylab = labels[1]
|
||||
self.labels.zlab = labels[2]
|
||||
|
||||
|
||||
|
||||
## def copy(self):
|
||||
## kwds = self.__dict__.copy()
|
||||
## wdata = CovData1D(**kwds)
|
||||
## return wdata
|
||||
|
||||
def tospecdata(self, rate=None, method='linear', nugget=0.0, trunc=1e-5, fast=True):
|
||||
'''
|
||||
Computes spectral density from the auto covariance function
|
||||
|
||||
Parameters
|
||||
----------
|
||||
rate = scalar, int
|
||||
1,2,4,8...2^r, interpolation rate for f (default 1)
|
||||
|
||||
method: string
|
||||
interpolation method 'stineman', 'linear', 'cubic'
|
||||
|
||||
nugget = scalar, real
|
||||
nugget effect to ensure that round off errors do not result in
|
||||
negative spectral estimates. Good choice might be 10^-12.
|
||||
|
||||
trunc : scalar, real
|
||||
truncates all spectral values where S/max(S) < trunc
|
||||
0 <= trunc <1 This is to ensure that high frequency
|
||||
noise is not added to the spectrum. (default 1e-5)
|
||||
fast : bool
|
||||
if True : zero-pad to obtain power of 2 length ACF (default)
|
||||
otherwise no zero-padding of ACF, slower but more accurate.
|
||||
|
||||
Returns
|
||||
--------
|
||||
S = SpecData1D object
|
||||
spectral density
|
||||
|
||||
NB! This routine requires that the covariance is evenly spaced
|
||||
starting from zero lag. Currently only capable of 1D matrices.
|
||||
|
||||
Example:
|
||||
>>> import wafo.spectrum.models as sm
|
||||
>>> import numpy as np
|
||||
>>> import scipy.signal.signaltools as st
|
||||
>>> L = 129
|
||||
>>> t = np.linspace(0,75,L)
|
||||
>>> R = np.zeros(L)
|
||||
>>> win = st.parzen(41)
|
||||
>>> R[0:21] = win[20:41]
|
||||
>>> R0 = CovData1D(R,t)
|
||||
>>> S0 = R0.tospecdata()
|
||||
|
||||
>>> Sj = sm.Jonswap()
|
||||
>>> S = Sj.tospecdata()
|
||||
>>> R2 = S.tocovdata()
|
||||
>>> S1 = R2.tospecdata()
|
||||
>>> assert(all(abs(S1.data-S.data)<1e-4) ,'COV2SPEC')
|
||||
|
||||
See also
|
||||
--------
|
||||
spec2cov
|
||||
datastructures
|
||||
'''
|
||||
|
||||
dT = self.sampling_period()
|
||||
# dT = time-step between data points.
|
||||
|
||||
ACF, unused_ti = atleast_1d(self.data, self.args)
|
||||
|
||||
if self.lagtype in 't':
|
||||
spectype = 'freq'
|
||||
ftype = 'w'
|
||||
else:
|
||||
spectype = 'k1d'
|
||||
ftype = 'k'
|
||||
|
||||
if rate is None:
|
||||
rate = 1 ##interpolation rate
|
||||
else:
|
||||
rate = 2**nextpow2(rate) ##make sure rate is a power of 2
|
||||
|
||||
|
||||
## add a nugget effect to ensure that round off errors
|
||||
## do not result in negative spectral estimates
|
||||
ACF[0] = ACF[0] +nugget
|
||||
n = ACF.size
|
||||
# embedding a circulant vector and Fourier transform
|
||||
if fast:
|
||||
nfft = 2**nextpow2(2*n-2)
|
||||
else:
|
||||
nfft = 2*n-2
|
||||
|
||||
nf = nfft/2 ## number of frequencies
|
||||
ACF = r_[ACF,zeros(nfft-2*n+2),ACF[n-1:0:-1]]
|
||||
|
||||
Rper = (fft(ACF,nfft).real).clip(0) ## periodogram
|
||||
RperMax = Rper.max()
|
||||
Rper = where(Rper<trunc*RperMax,0,Rper)
|
||||
pi = pi
|
||||
S = abs(Rper[0:(nf+1)])*dT/pi
|
||||
w = linspace(0,pi/dT,nf+1)
|
||||
So = _wafospec.SpecData1D(S, w, type=spectype, freqtype=ftype)
|
||||
So.tr = self.tr
|
||||
So.h = self.h
|
||||
So.norm = self.norm
|
||||
|
||||
if rate > 1:
|
||||
So.args = linspace(0, pi/dT, nf*rate)
|
||||
if method=='stineman':
|
||||
So.data = stineman_interp(So.args, w, S)
|
||||
else:
|
||||
intfun = interpolate.interp1d(w, S, kind=method)
|
||||
So.data = intfun(So.args)
|
||||
So.data = So.data.clip(0) # clip negative values to 0
|
||||
return So
|
||||
|
||||
def sampling_period(self):
|
||||
'''
|
||||
Returns sampling interval
|
||||
|
||||
Returns
|
||||
---------
|
||||
dt : scalar
|
||||
sampling interval, unit:
|
||||
[s] if lagtype=='t'
|
||||
[m] otherwise
|
||||
'''
|
||||
dt1 = self.args[1]-self.args[0]
|
||||
n = size(self.args)-1
|
||||
t = self.args[-1]-self.args[0]
|
||||
dt = t/n
|
||||
if abs(dt-dt1) > 1e-10:
|
||||
warnings.warn('Data is not uniformly sampled!')
|
||||
return dt
|
||||
|
||||
def sim(self, ns=None, cases=1, dt=None, iseed=None, derivative=False):
|
||||
'''
|
||||
Simulates a Gaussian process and its derivative from ACF
|
||||
|
||||
Parameters
|
||||
----------
|
||||
ns : scalar
|
||||
number of simulated points. (default length(S)-1=n-1).
|
||||
If ns>n-1 it is assummed that R(k)=0 for all k>n-1
|
||||
cases : scalar
|
||||
number of replicates (default=1)
|
||||
dt : scalar
|
||||
step in grid (default dt is defined by the Nyquist freq)
|
||||
iseed : int or state
|
||||
starting state/seed number for the random number generator
|
||||
(default none is set)
|
||||
derivative : bool
|
||||
if true : return derivative of simulated signal as well
|
||||
otherwise
|
||||
|
||||
Returns
|
||||
-------
|
||||
xs = a cases+1 column matrix ( t,X1(t) X2(t) ...).
|
||||
xsder = a cases+1 column matrix ( t,X1'(t) X2'(t) ...).
|
||||
|
||||
Details
|
||||
-------
|
||||
Performs a fast and exact simulation of stationary zero mean
|
||||
Gaussian process through circulant embedding of the covariance matrix.
|
||||
|
||||
If the ACF has a non-empty field .tr, then the transformation is
|
||||
applied to the simulated data, the result is a simulation of a transformed
|
||||
Gaussian process.
|
||||
|
||||
Note: The simulation may give high frequency ripple when used with a
|
||||
small dt.
|
||||
|
||||
Example:
|
||||
>>> import wafo.spectrum.models as sm
|
||||
>>> Sj = sm.Jonswap()
|
||||
>>> S = Sj.tospecdata() #Make spec
|
||||
>>> R = S.tocovdata()
|
||||
>>> x = R.sim(ns=1000,dt=0.2)
|
||||
|
||||
See also
|
||||
--------
|
||||
spec2sdat, gaus2dat
|
||||
|
||||
Reference
|
||||
-----------
|
||||
C.R Dietrich and G. N. Newsam (1997)
|
||||
"Fast and exact simulation of stationary
|
||||
Gaussian process through circulant embedding
|
||||
of the Covariance matrix"
|
||||
SIAM J. SCI. COMPT. Vol 18, No 4, pp. 1088-1107
|
||||
'''
|
||||
|
||||
# TODO fix it, it does not work
|
||||
|
||||
# Add a nugget effect to ensure that round off errors
|
||||
# do not result in negative spectral estimates
|
||||
nugget = 0 # 10**-12
|
||||
|
||||
_set_seed(iseed)
|
||||
|
||||
ACF = self.data.ravel()
|
||||
n = ACF.size
|
||||
|
||||
|
||||
I = ACF.argmax()
|
||||
if I != 0:
|
||||
raise ValueError('ACF does not have a maximum at zero lag')
|
||||
|
||||
ACF.shape = (n, 1)
|
||||
|
||||
dT = self.sampling_period()
|
||||
|
||||
x = zeros((ns, cases+1))
|
||||
|
||||
if derivative:
|
||||
xder = x.copy()
|
||||
|
||||
## add a nugget effect to ensure that round off errors
|
||||
## do not result in negative spectral estimates
|
||||
ACF[0] = ACF[0] + nugget
|
||||
|
||||
## Fast and exact simulation of simulation of stationary
|
||||
## Gaussian process throug circulant embedding of the
|
||||
## Covariance matrix
|
||||
floatinfo = finfo(float)
|
||||
if (abs(ACF[-1]) > floatinfo.eps): ## assuming ACF(n+1)==0
|
||||
m2 = 2*n-1
|
||||
nfft = 2**nextpow2(max(m2, 2*ns))
|
||||
ACF = r_[ACF, zeros((nfft-m2,1)), ACF[-1:0:-1,:]]
|
||||
#disp('Warning: I am now assuming that ACF(k)=0 ')
|
||||
#disp('for k>MAXLAG.')
|
||||
else: # # ACF(n)==0
|
||||
m2 = 2*n-2
|
||||
nfft = 2**nextpow2(max(m2, 2*ns))
|
||||
ACF = r_[ACF, zeros((nfft-m2, 1)), ACF[n-1:1:-1, :]]
|
||||
|
||||
##m2=2*n-2
|
||||
S = fft(ACF,nfft,axis=0).real ## periodogram
|
||||
|
||||
I = S.argmax()
|
||||
k = flatnonzero(S<0)
|
||||
if k.size>0:
|
||||
#disp('Warning: Not able to construct a nonnegative circulant ')
|
||||
#disp('vector from the ACF. Apply the parzen windowfunction ')
|
||||
#disp('to the ACF in order to avoid this.')
|
||||
#disp('The returned result is now only an approximation.')
|
||||
|
||||
# truncating negative values to zero to ensure that
|
||||
# that this noise is not added to the simulated timeseries
|
||||
|
||||
S[k] = 0.
|
||||
|
||||
ix = flatnonzero(k>2*I)
|
||||
if ix.size>0:
|
||||
## # truncating all oscillating values above 2 times the peak
|
||||
## # frequency to zero to ensure that
|
||||
## # that high frequency noise is not added to
|
||||
## # the simulated timeseries.
|
||||
ix0 = k[ix[0]]
|
||||
S[ix0:-ix0] =0.0
|
||||
|
||||
|
||||
|
||||
trunc = 1e-5
|
||||
maxS = S[I]
|
||||
k = flatnonzero(S[I:-I]<maxS*trunc)
|
||||
if k.size>0:
|
||||
S[k+I]=0.
|
||||
## truncating small values to zero to ensure that
|
||||
## that high frequency noise is not added to
|
||||
## the simulated timeseries
|
||||
|
||||
cases1 = floor(cases/2)
|
||||
cases2 = ceil(cases/2)
|
||||
# Generate standard normal random numbers for the simulations
|
||||
|
||||
#randn = np.random.randn
|
||||
epsi = randn(nfft,cases2)+1j*randn(nfft,cases2)
|
||||
Ssqr = sqrt(S/(nfft)) # #sqrt(S(wn)*dw )
|
||||
ephat = epsi*Ssqr #[:,np.newaxis]
|
||||
y = fft(ephat,nfft,axis=0)
|
||||
x[:, 1:cases+1] = hstack((y[2:ns+2, 0:cases2].real, y[2:ns+2, 0:cases1].imag))
|
||||
|
||||
x[:, 0] = linspace(0,(ns-1)*dT,ns) ##(0:dT:(dT*(np-1)))'
|
||||
|
||||
if derivative:
|
||||
Ssqr = Ssqr*r_[0:(nfft/2+1), -(nfft/2-1):0]*2*pi/nfft/dT
|
||||
ephat = epsi*Ssqr #[:,newaxis]
|
||||
y = fft(ephat,nfft,axis=0)
|
||||
xder[:, 1:(cases+1)] = hstack((y[2:ns+2, 0:cases2].imag -y[2:ns+2, 0:cases1].real))
|
||||
xder[:, 0] = x[:,0]
|
||||
|
||||
if self.tr is not None:
|
||||
print(' Transforming data.')
|
||||
g = self.tr
|
||||
if derivative:
|
||||
for ix in range(cases):
|
||||
tmp = g.gauss2dat(x[:,ix+1], xder[:,ix+1])
|
||||
x[:,ix+1] = tmp[0]
|
||||
xder[:,ix+1] = tmp[1]
|
||||
else:
|
||||
for ix in range(cases):
|
||||
x[:, ix+1] = g.gauss2dat(x[:, ix+1])
|
||||
|
||||
if derivative:
|
||||
return x, xder
|
||||
else:
|
||||
return x
|
||||
|
||||
def simcond(self, xo, cases=1, method='approx', inds=None):
|
||||
"""
|
||||
Simulate values conditionally on observed known values
|
||||
|
||||
Parameters
|
||||
----------
|
||||
x : array-like
|
||||
datavector including missing data.
|
||||
(missing data must be NaN if inds is not given)
|
||||
Assumption: The covariance of x is equal to self and have the
|
||||
same sample period.
|
||||
cases : scalar integer
|
||||
number of cases, i.e., number of columns of sample (default=1)
|
||||
method : string
|
||||
defining method used in the conditional simulation. Options are:
|
||||
'approximate': Condition only on the closest points. Pros: quite fast
|
||||
'pseudo': Use pseudo inverse to calculate conditional covariance matrix
|
||||
'exact' : Exact simulation. Cons: Slow for large data sets, may not
|
||||
return any result due to near singularity of the covariance matrix.
|
||||
inds : integers
|
||||
indices to spurious or missing data in x
|
||||
|
||||
Returns
|
||||
-------
|
||||
sample : ndarray
|
||||
a random sample of the missing values conditioned on the observed data.
|
||||
mu, sigma : ndarray
|
||||
mean and standard deviation, respectively, of the missing values
|
||||
conditioned on the observed data.
|
||||
|
||||
|
||||
Notes
|
||||
-----
|
||||
SIMCOND generates the missing values from x conditioned on the observed
|
||||
values assuming x comes from a multivariate Gaussian distribution
|
||||
with zero expectation and Auto Covariance function R.
|
||||
|
||||
See also
|
||||
--------
|
||||
CovData1D.sim
|
||||
TimeSeries.reconstruct,
|
||||
rndnormnd
|
||||
|
||||
Reference
|
||||
---------
|
||||
Brodtkorb, P, Myrhaug, D, and Rue, H (2001)
|
||||
"Joint distribution of wave height and wave crest velocity from
|
||||
reconstructed data with application to ringing"
|
||||
Int. Journal of Offshore and Polar Engineering, Vol 11, No. 1, pp 23--32
|
||||
|
||||
Brodtkorb, P, Myrhaug, D, and Rue, H (1999)
|
||||
"Joint distribution of wave height and wave crest velocity from
|
||||
reconstructed data"
|
||||
in Proceedings of 9th ISOPE Conference, Vol III, pp 66-73
|
||||
"""
|
||||
# TODO does not work yet.
|
||||
|
||||
# secret methods:
|
||||
# 'dec1-3': different decomposing algorithm's
|
||||
# which is only correct for a variables
|
||||
# having the Markov property
|
||||
# Cons: 3 is not correct at all, but seems to give
|
||||
# a reasonable result
|
||||
# Pros: 1 is slow, 2 is quite fast and 3 is very fast
|
||||
# Note: (mu1oStd is not given for method ='dec3')
|
||||
compute_sigma = True
|
||||
x = atleast_1d(xo).ravel()
|
||||
acf = atleast_1d(self.data).ravel()
|
||||
|
||||
N = len(x)
|
||||
n = len(acf)
|
||||
|
||||
i = acf.argmax()
|
||||
if i != 0:
|
||||
raise ValueError('This is not a valid ACF!!')
|
||||
|
||||
|
||||
if not inds is None:
|
||||
x[inds] = nan
|
||||
inds = where(isnan(x))[0] #indices to the unknown observations
|
||||
|
||||
Ns = len(inds) # # missing values
|
||||
if Ns == 0:
|
||||
warnings.warn('No missing data, unable to continue.')
|
||||
return xo, zeros(Ns), zeros(Ns)
|
||||
#end
|
||||
if Ns == N:# simulated surface from the apriori distribution
|
||||
txt = '''All data missing,
|
||||
returning sample from the unconditional distribution.'''
|
||||
warnings.warn(txt)
|
||||
return self.sim(ns=N, cases=cases), zeros(Ns), zeros(Ns)
|
||||
|
||||
indg = where(1-isnan(x))[0] #indices to the known observations
|
||||
|
||||
#initializing variables
|
||||
mu1o = zeros(Ns, 1)
|
||||
mu1o_std = mu1o
|
||||
sample = zeros((Ns, cases))
|
||||
if method[0] == 'd':
|
||||
# simulated surface from the apriori distribution
|
||||
xs = self.sim(ns=N, cases=cases)
|
||||
mu1os = zeros((Ns, cases))
|
||||
|
||||
if method.startswith('dec1'):
|
||||
# only correct for variables having the Markov property
|
||||
# but still seems to give a reasonable answer. Slow procedure.
|
||||
Sigma = sptoeplitz(hstack((acf, zeros(N-n))))
|
||||
|
||||
#Soo=Sigma(~inds,~inds); # covariance between known observations
|
||||
#S11=Sigma(inds,inds); # covariance between unknown observations
|
||||
#S1o=Sigma(inds,~inds);# covariance between known and unknown observations
|
||||
#tmp=S1o*pinv(full(Soo));
|
||||
#tmp=S1o/Soo; # this is time consuming if Soo large
|
||||
tmp = 2*Sigma[inds, indg]/(Sigma[indg, indg] + Sigma[indg, indg].T )
|
||||
|
||||
if compute_sigma:
|
||||
#standard deviation of the expected surface
|
||||
#mu1o_std=sqrt(diag(S11-tmp*S1o'));
|
||||
mu1o_std = sqrt(diag(Sigma[inds, inds]-tmp*Sigma[indg, inds]))
|
||||
|
||||
|
||||
#expected surface conditioned on the known observations from x
|
||||
mu1o = tmp*x[indg]
|
||||
#expected surface conditioned on the known observations from xs
|
||||
mu1os = tmp*(xs[indg,:])
|
||||
# sampled surface conditioned on the known observations
|
||||
sample = mu1o + xs[inds,:] - mu1os
|
||||
|
||||
elif method.startswith('dec2'):
|
||||
# only correct for variables having the Markov property
|
||||
# but still seems to give a reasonable answer
|
||||
# approximating the expected surfaces conditioned on
|
||||
# the known observations from x and xs by only using the closest points
|
||||
Sigma = sptoeplitz(hstack((acf,zeros(n))))
|
||||
n2 = int(floor(n/2))
|
||||
idx = r_[0:2*n] + max(0,inds[0]-n2) # indices to the points used
|
||||
tmpinds = zeros(N,dtype=bool)
|
||||
tmpinds[inds] = True # temporary storage of indices to missing points
|
||||
tinds = where(tmpinds[idx])[0] # indices to the points used
|
||||
tindg = where(1-tmpinds[idx])[0]
|
||||
ns = len(tinds); # number of missing data in the interval
|
||||
nprev = 0; # number of previously simulated points
|
||||
xsinds = xs[inds,:]
|
||||
while ns>0:
|
||||
tmp=2*Sigma[tinds, tindg]/(Sigma[tindg, tindg]+Sigma[tindg, tindg].T)
|
||||
if compute_sigma:
|
||||
#standard deviation of the expected surface
|
||||
#mu1o_std=sqrt(diag(S11-tmp*S1o'));
|
||||
ix = slice(nprev+1,nprev+ns+1)
|
||||
mu1o_std[ix] = max(mu1o_std[ix],
|
||||
sqrt(diag(Sigma[tinds, tinds]-tmp*Sigma[tindg,tinds])))
|
||||
#end
|
||||
|
||||
#expected surface conditioned on the closest known observations
|
||||
# from x and xs2
|
||||
mu1o[(nprev+1):(nprev+ns+1)] = tmp*x[idx[tindg]]
|
||||
mu1os[(nprev+1):(nprev+ns+1),:] = tmp*xs[idx[tindg],:]
|
||||
|
||||
if idx[-1]==N-1:#
|
||||
ns =0 # no more points to simulate
|
||||
else:
|
||||
# updating by putting expected surface into x
|
||||
x[idx[tinds]] = mu1o[(nprev+1):(nprev+ns+1)]
|
||||
xs[idx[tinds]] = mu1os[(nprev+1):(nprev+ns+1)]
|
||||
|
||||
nw = sum(tmpinds[idx[-n2:]])# # data which we want to simulate once
|
||||
tmpinds[idx[:-n2]] = False # removing indices to data ..
|
||||
# which has been simulated
|
||||
nprev = nprev+ns-nw # update # points simulated so far
|
||||
|
||||
if (nw==0) and (nprev<Ns):
|
||||
idx= r_[0:2*n]+(inds[nprev+1]-n2) # move to the next missing data
|
||||
else:
|
||||
idx = idx+n
|
||||
#end
|
||||
tmp = N-idx[-1]
|
||||
if tmp<0: # checking if tmp exceeds the limits
|
||||
idx = idx+tmp
|
||||
#end
|
||||
# find new interval with missing data
|
||||
tinds = where(tmpinds[idx])[0]
|
||||
tindg = where(1-tmpinds[idx])[0]
|
||||
ns = len(tinds);# # missing data
|
||||
#end
|
||||
#end
|
||||
# sampled surface conditioned on the known observations
|
||||
sample = mu1o+(xsinds-mu1os)
|
||||
elif method.startswith('dec3'):
|
||||
# this is not correct for even for variables having the
|
||||
# Markov property but still seems to give a reasonable answer
|
||||
# a quasi approach approximating the expected surfaces conditioned on
|
||||
# the known observations from x and xs with a spline
|
||||
|
||||
mu1o = interp1(indg, x[indg],inds,'spline')
|
||||
mu1os = interp1(indg, xs[indg,:],inds,'spline')
|
||||
# sampled surface conditioned on the known observations
|
||||
sample = mu1o + (xs[inds,:]-mu1os)
|
||||
|
||||
elif method.startswith('exac') or method.startswith('pseu'):
|
||||
# exact but slow. It also may not return any result
|
||||
Sigma = sptoeplitz(hstack((acf,zeros(N-n))))
|
||||
#Soo=Sigma(~inds,~inds); # covariance between known observations
|
||||
#S11=Sigma(inds,inds); # covariance between unknown observations
|
||||
#S1o=Sigma(inds,~inds);# covariance between known and unknown observations
|
||||
#tmp=S1o/Soo; # this is time consuming if Soo large
|
||||
if method[0]=='e': #exact
|
||||
tmp = 2*Sigma[inds,indg]/(Sigma[indg,indg]+Sigma[indg,indg].T);
|
||||
else: # approximate the inverse with pseudo inverse
|
||||
tmp = dot(Sigma[inds, indg],pinv(Sigma[indg,indg]))
|
||||
#end
|
||||
#expected surface conditioned on the known observations from x
|
||||
mu1o = dot(tmp,x[indg])
|
||||
# Covariance conditioned on the known observations
|
||||
Sigma1o = Sigma[inds,inds] - tmp*Sigma[indg,inds]
|
||||
#sample conditioned on the known observations from x
|
||||
sample = random.multivariate_normal(mu1o, Sigma1o, cases)
|
||||
#rndnormnd(mu1o,Sigma1o,cases )
|
||||
|
||||
if compute_sigma:
|
||||
#standard deviation of the expected surface
|
||||
mu1o_std=sqrt(diag(Sigma1o));
|
||||
#end
|
||||
|
||||
elif method.startswith('appr'):
|
||||
# approximating by only condition on
|
||||
# the closest points
|
||||
# checking approximately how many lags we need in order to
|
||||
# ensure conditional independence
|
||||
# using that the inverse of the circulant covariance matrix has
|
||||
# approximately the same bandstructure as the inverse of the
|
||||
# covariance matrix
|
||||
|
||||
Nsig = 2*n;
|
||||
|
||||
Sigma = sptoeplitz(hstack((ACF,zeros(Nsig-n))))
|
||||
n2 = floor(Nsig/4)
|
||||
idx = r_[0:Nsig]+max(0,inds[0]-n2) # indices to the points used
|
||||
tmpinds = zeros(N,dtype=bool)
|
||||
tmpinds[inds] = True # temporary storage of indices to missing points
|
||||
tinds = where(tmpinds[idx])[0] # indices to the points used
|
||||
tindg = where(1-tmpinds[idx])[0]
|
||||
ns = len(tinds) # number of missing data in the interval
|
||||
|
||||
nprev = 0 # number of previously simulated points
|
||||
x2 = x
|
||||
|
||||
while ns>0:
|
||||
#make sure MATLAB uses a symmetric matrix solver
|
||||
tmp = 2*Sigma[tinds,tindg]/(Sigma[tindg,tindg]+Sigma[tindg,tindg].T)
|
||||
Sigma1o = Sigma[tinds,tinds] - tmp*Sigma[tindg,tinds]
|
||||
if compute_sigma:
|
||||
#standard deviation of the expected surface
|
||||
#mu1o_std=sqrt(diag(S11-tmp*S1o'));
|
||||
mu1o_std[(nprev+1):(nprev+ns+1)] = max( mu1o_std[(nprev+1):(nprev+ns)] ,
|
||||
sqrt(diag(Sigma1o)))
|
||||
#end
|
||||
|
||||
#expected surface conditioned on the closest known observations from x
|
||||
mu1o[(nprev+1):(nprev+ns+1)] = tmp*x2[idx[tindg]]
|
||||
#sample conditioned on the known observations from x
|
||||
sample[(nprev+1):(nprev+ns+1),:] = rndnormnd(tmp*x[idx[tindg]],Sigma1o, cases)
|
||||
if idx[-1] == N-1:
|
||||
ns = 0 # no more points to simulate
|
||||
else:
|
||||
# updating
|
||||
x2[idx[tinds]] = mu1o[(nprev+1):(nprev+ns+1)] #expected surface
|
||||
x[idx[tinds]] = sample[(nprev+1):(nprev+ns+1)]#sampled surface
|
||||
nw = sum(tmpinds[idx[-n2::]]==True)# # data we want to simulate once more
|
||||
tmpinds[idx[:-n2]] = False # removing indices to data ..
|
||||
# which has been simulated
|
||||
nprev = nprev+ns-nw # update # points simulated so far
|
||||
|
||||
if (nw==0) and (nprev<Ns):
|
||||
idx = r_[0:Nsig]+(inds[nprev+1]-n2) # move to the next missing data
|
||||
else:
|
||||
idx = idx+n
|
||||
#end
|
||||
tmp = N-idx[-1]
|
||||
if tmp<0: # checking if tmp exceeds the limits
|
||||
idx = idx + tmp
|
||||
#end
|
||||
# find new interval with missing data
|
||||
tinds = where(tmpinds[idx])[0]
|
||||
tindg = where(1-tmpinds[idx])[0]
|
||||
ns = len(tinds);# # missing data in the interval
|
||||
#end
|
||||
#end
|
||||
#end
|
||||
return sample
|
||||
# plot(find(~inds),x(~inds),'.')
|
||||
# hold on,
|
||||
# ind=find(inds);
|
||||
# plot(ind,mu1o ,'*')
|
||||
# plot(ind,sample,'r+')
|
||||
# #mu1o_std
|
||||
# plot(ind,[mu1o-2*mu1o_std mu1o+2*mu1o_std ] ,'d')
|
||||
# #plot(xs),plot(ind,mu1os,'r*')
|
||||
# hold off
|
||||
# legend('observed values','mu1o','sampled values','2 stdev')
|
||||
# #axis([770 850 -1 1])
|
||||
# #axis([1300 1325 -1 1])
|
||||
|
||||
def sptoeplitz(x):
|
||||
k = where(x.ravel())[0]
|
||||
n = len(x)
|
||||
if len(k)>0.3*n:
|
||||
return toeplitz(x)
|
||||
else:
|
||||
spdiags = sparse.dia_matrix
|
||||
data = x[k].reshape(-1,1).repeat(n,axis=-1)
|
||||
offsets = k
|
||||
y = spdiags((data, offsets), shape=(n,n))
|
||||
if k[0]==0:
|
||||
offsets = k[1::]
|
||||
data = data[1::,:]
|
||||
return y + spdiags((data, -offsets), shape=(n,n))
|
||||
|
||||
def test_covdata():
|
||||
import wafo.data
|
||||
x = wafo.data.sea()
|
||||
ts = wafo.objects.mat2timeseries(x)
|
||||
rf = ts.tocovdata(lag=150)
|
||||
rf.plot()
|
||||
|
||||
def main():
|
||||
import wafo.spectrum.models as sm
|
||||
import matplotlib
|
||||
matplotlib.interactive(True)
|
||||
Sj = sm.Jonswap()
|
||||
S = Sj.tospecdata() #Make spec
|
||||
S.plot()
|
||||
R = S.tocovdata()
|
||||
R.plot()
|
||||
#x = R.sim(ns=1000,dt=0.2)
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
if True: #False : #
|
||||
import doctest
|
||||
doctest.testmod()
|
||||
else:
|
||||
main()
|
||||
@ -0,0 +1,3 @@
|
||||
|
||||
from wafo.data.info import __doc__
|
||||
from wafo.data.info import *
|
||||
@ -0,0 +1,582 @@
|
||||
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
@ -0,0 +1,442 @@
|
||||
"""
|
||||
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
|
||||
|
||||
"""
|
||||
#from pylab import load
|
||||
#from scipy.io import read_array
|
||||
from numpy import (loadtxt,nan)
|
||||
import os
|
||||
__path2data = os.path.dirname( os.path.realpath(__file__))
|
||||
|
||||
__all__ =['atlantic','gfaks89','gfaksr89','japansea','northsea','sea','sfa89',
|
||||
'sn','yura87']
|
||||
|
||||
def _load(file):
|
||||
""" local load function
|
||||
"""
|
||||
return loadtxt(os.path.join(__path2data,file))
|
||||
|
||||
def _tofloat(x):
|
||||
if x=='nan' or x=='NaN':
|
||||
y = nan
|
||||
else:
|
||||
y = float(x or 0)
|
||||
return y
|
||||
def _loadnan(file):
|
||||
""" local load function accepting nan's
|
||||
"""
|
||||
myconverter = {0: _tofloat, 1: _tofloat}
|
||||
return 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()
|
||||
>>> 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()
|
||||
>>> 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()
|
||||
>>> 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()
|
||||
>>> 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()
|
||||
>>> 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()
|
||||
@ -0,0 +1,692 @@
|
||||
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
@ -0,0 +1,16 @@
|
||||
%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
|
||||
@ -0,0 +1,144 @@
|
||||
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
|
||||
@ -0,0 +1,40 @@
|
||||
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.
|
After Width: | Height: | Size: 23 KiB |
@ -0,0 +1,211 @@
|
||||
<?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>
|
||||
|
After Width: | Height: | Size: 16 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 13 KiB |
@ -0,0 +1,243 @@
|
||||
<?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>
|
||||
|
After Width: | Height: | Size: 15 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 24 KiB |
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,107 @@
|
||||
import numpy as np
|
||||
__all__ = ['dct', 'idct']
|
||||
def dct(x, n=None):
|
||||
"""
|
||||
Discrete Cosine Transform
|
||||
|
||||
N-1
|
||||
y[k] = 2* sum x[n]*cos(pi*k*(2n+1)/(2*N)), 0 <= k < N.
|
||||
n=0
|
||||
|
||||
Examples
|
||||
--------
|
||||
>>> import numpy as np
|
||||
>>> x = np.arange(5)
|
||||
>>> np.abs(x-idct(dct(x)))<1e-14
|
||||
array([ True, True, True, True, True], dtype=bool)
|
||||
>>> np.abs(x-dct(idct(x)))<1e-14
|
||||
array([ True, True, True, True, True], dtype=bool)
|
||||
|
||||
Reference
|
||||
---------
|
||||
http://en.wikipedia.org/wiki/Discrete_cosine_transform
|
||||
http://users.ece.utexas.edu/~bevans/courses/ee381k/lectures/
|
||||
"""
|
||||
fft = np.fft.fft
|
||||
x = np.atleast_1d(x)
|
||||
|
||||
if n is None:
|
||||
n = x.shape[-1]
|
||||
|
||||
if x.shape[-1] < n:
|
||||
n_shape = x.shape[:-1] + (n - x.shape[-1],)
|
||||
xx = np.hstack((x, np.zeros(n_shape)))
|
||||
else:
|
||||
xx = x[..., :n]
|
||||
|
||||
real_x = np.all(np.isreal(xx))
|
||||
if (real_x and (np.remainder(n, 2) == 0)):
|
||||
xp = 2 * fft(np.hstack((xx[..., ::2], xx[..., ::-2])))
|
||||
else:
|
||||
xp = fft(np.hstack((xx, xx[..., ::-1])))
|
||||
xp = xp[..., :n]
|
||||
|
||||
w = np.exp(-1j * np.arange(n) * np.pi / (2 * n))
|
||||
|
||||
y = xp * w
|
||||
|
||||
if real_x:
|
||||
return y.real
|
||||
else:
|
||||
return y
|
||||
|
||||
def idct(x, n=None):
|
||||
"""
|
||||
Inverse Discrete Cosine Transform
|
||||
|
||||
N-1
|
||||
x[k] = 1/N sum w[n]*y[n]*cos(pi*k*(2n+1)/(2*N)), 0 <= k < N.
|
||||
n=0
|
||||
|
||||
w(0) = 1/2
|
||||
w(n) = 1 for n>0
|
||||
|
||||
Examples
|
||||
--------
|
||||
>>> import numpy as np
|
||||
>>> x = np.arange(5)
|
||||
>>> np.abs(x-idct(dct(x)))<1e-14
|
||||
array([ True, True, True, True, True], dtype=bool)
|
||||
>>> np.abs(x-dct(idct(x)))<1e-14
|
||||
array([ True, True, True, True, True], dtype=bool)
|
||||
|
||||
Reference
|
||||
---------
|
||||
http://en.wikipedia.org/wiki/Discrete_cosine_transform
|
||||
http://users.ece.utexas.edu/~bevans/courses/ee381k/lectures/
|
||||
"""
|
||||
|
||||
ifft = np.fft.ifft
|
||||
x = np.atleast_1d(x)
|
||||
|
||||
if n is None:
|
||||
n = x.shape[-1]
|
||||
|
||||
w = np.exp(1j * np.arange(n) * np.pi / (2 * n))
|
||||
|
||||
if x.shape[-1] < n:
|
||||
n_shape = x.shape[:-1] + (n - x.shape[-1],)
|
||||
xx = np.hstack((x, np.zeros(n_shape))) * w
|
||||
else:
|
||||
xx = x[..., :n] * w
|
||||
|
||||
real_x = np.all(np.isreal(x))
|
||||
if (real_x and (np.remainder(n, 2) == 0)):
|
||||
xx[..., 0] = xx[..., 0] * 0.5
|
||||
yp = ifft(xx)
|
||||
y = np.zeros(xx.shape, dtype=complex)
|
||||
y[..., ::2] = yp[..., :n / 2]
|
||||
y[..., ::-2] = yp[..., n / 2::]
|
||||
else:
|
||||
yp = ifft(np.hstack((xx, np.zeros_like(xx[..., 0]), np.conj(xx[..., :0:-1]))))
|
||||
y = yp[..., :n]
|
||||
|
||||
if real_x:
|
||||
return y.real
|
||||
else:
|
||||
return y
|
||||
@ -0,0 +1,284 @@
|
||||
"""
|
||||
WAFO defintions and numenclature
|
||||
|
||||
crossings :
|
||||
cycle_pairs :
|
||||
turning_points :
|
||||
wave_amplitudes :
|
||||
wave_periods :
|
||||
waves :
|
||||
"""
|
||||
def wave_amplitudes():
|
||||
r"""
|
||||
Wave amplitudes and heights definitions and nomenclature
|
||||
|
||||
Definition of wave amplitudes and wave heights
|
||||
---------------------------------------------
|
||||
|
||||
<----- Direction of wave propagation
|
||||
|
||||
|
||||
|..............c_..........|
|
||||
| /| \ |
|
||||
Hd | _/ | \ | Hu
|
||||
M | / | \ |
|
||||
/ \ | M / Ac | \_ | c_
|
||||
F \ | / \m/ | \ | / \
|
||||
------d----|---u------------------d---|---u----d------ level v
|
||||
\ | /| \ | / \L
|
||||
\_ | / | At \_|_/
|
||||
\|/..| t
|
||||
t
|
||||
|
||||
Parameters
|
||||
----------
|
||||
Ac : crest amplitude
|
||||
At : trough amplitude
|
||||
Hd : wave height as defined for down crossing waves
|
||||
Hu : wave height as defined for up crossing waves
|
||||
|
||||
See also
|
||||
--------
|
||||
waves, crossings, turning_points
|
||||
"""
|
||||
print(wave_amplitudes.__doc__)
|
||||
|
||||
def crossings():
|
||||
r"""
|
||||
Level v crossing definitions and nomenclature
|
||||
|
||||
Definition of level v crossings
|
||||
-------------------------------
|
||||
M
|
||||
. . M M
|
||||
. . . . . .
|
||||
F d . . L
|
||||
-----------------------u-------d-------o----------------- level v
|
||||
. . . . u
|
||||
. m
|
||||
m
|
||||
|
||||
Let the letters 'm', 'M', 'F', 'L','d' and 'u' in the
|
||||
figure above denote local minimum, maximum, first value, last
|
||||
value, down- and up-crossing, respectively. The remaining
|
||||
sampled values are indicated with a '.'. Values that are identical
|
||||
with v, but do not cross the level is indicated with the letter 'o'.
|
||||
We have a level up-crossing at index, k, if
|
||||
|
||||
x(k) < v and v < x(k+1)
|
||||
or if
|
||||
x(k) == v and v < x(k+1) and x(r) < v for some di < r <= k-1
|
||||
|
||||
where di is the index to the previous downcrossing.
|
||||
Similarly there is a level down-crossing at index, k, if
|
||||
|
||||
x(k) > v and v > x(k+1)
|
||||
or if
|
||||
x(k) == v and v > x(k+1) and x(r) > v for some ui < r <= k-1
|
||||
|
||||
where ui is the index to the previous upcrossing.
|
||||
|
||||
The first (F) value is a up crossing if x(1) = v and x(2) > v.
|
||||
Similarly, it is a down crossing if x(1) = v and x(2) < v.
|
||||
|
||||
See also
|
||||
--------
|
||||
wave_periods, waves, turning_points, findcross, findtp
|
||||
"""
|
||||
print(crossings.__doc__)
|
||||
|
||||
def cycle_pairs():
|
||||
r"""
|
||||
Cycle pairs definitions and numenclature
|
||||
|
||||
Definition of Max2min and min2Max cycle pair
|
||||
--------------------------------------------
|
||||
A min2Max cycle pair (mM) is defined as the pair of a minimum
|
||||
and the following Maximum. Similarly a Max2min cycle pair (Mm)
|
||||
is defined as the pair of a Maximum and the following minimum.
|
||||
(all turning points possibly rainflowfiltered before pairing into cycles.)
|
||||
|
||||
See also
|
||||
--------
|
||||
turning_points
|
||||
"""
|
||||
print(cycle_pairs.__doc__)
|
||||
|
||||
def wave_periods():
|
||||
r"""
|
||||
Wave periods (lengths) definitions and nomenclature
|
||||
|
||||
Definition of wave periods (lengths)
|
||||
------------------------------------
|
||||
|
||||
|
||||
<----- Direction of wave propagation
|
||||
|
||||
<-------Tu--------->
|
||||
: :
|
||||
<---Tc-----> :
|
||||
: : : <------Tcc---->
|
||||
M : c : : : :
|
||||
/ \ : M / \_ : : c_ c
|
||||
F \ :/ \m/ \: :/ \ / \
|
||||
------d--------u----------d-------u----d--------u---d-------- level v
|
||||
\ / \ / :\_ _/: :\_ L
|
||||
\_ / \_t_/ : \t_/ : : \m/
|
||||
\t/ : : : :
|
||||
: : <---Tt---> :
|
||||
<--------Ttt-------> : :
|
||||
<-----Td----->
|
||||
Tu = Up crossing period
|
||||
Td = Down crossing period
|
||||
Tc = Crest period, i.e., period between up crossing and
|
||||
the next down crossing
|
||||
Tt = Trough period, i.e., period between down crossing and
|
||||
the next up crossing
|
||||
Ttt = Trough2trough period
|
||||
Tcc = Crest2crest period
|
||||
|
||||
|
||||
<----- Direction of wave propagation
|
||||
|
||||
<--Tcf-> Tuc
|
||||
: : <-Tcb-> <->
|
||||
M : c : : : :
|
||||
/ \ : M / \_ c_ : : c
|
||||
F \ :/ \m/ \ / \___: :/ \
|
||||
------d---------u----------d---------u-------d--------u---d------ level v
|
||||
:\_ / \ __/: \_ _/ \_ L
|
||||
: \_ / \_t_/ : \t_/ \m/
|
||||
: \t/ : :
|
||||
: : : :
|
||||
<-Ttf-> <-Ttb->
|
||||
|
||||
|
||||
Tcf = Crest front period, i.e., period between up crossing and crest
|
||||
Tcb = Crest back period, i.e., period between crest and down crossing
|
||||
Ttf = Trough front period, i.e., period between down crossing and trough
|
||||
Ttb = Trough back period, i.e., period between trough and up crossing
|
||||
Also note that Tcf and Ttf can also be abbreviated by their crossing
|
||||
marker, e.g. Tuc (u2c) and Tdt (d2t), respectively. Similar applies
|
||||
to all the other wave periods and wave lengths.
|
||||
|
||||
(The nomenclature for wave length is similar, just substitute T and
|
||||
period with L and length, respectively)
|
||||
|
||||
<----- Direction of wave propagation
|
||||
|
||||
<--TMm-->
|
||||
<-TmM-> : :
|
||||
M : : M :
|
||||
/ \ : M /:\_ : M_ M
|
||||
F \ : / \m/ : \ : /: \ / \
|
||||
\ : / : \ : / : \ / \
|
||||
\ : / : \ : / : \_ _/ \_ L
|
||||
\_ : / : \_m_/ : \m_/ \m/
|
||||
\m/ : : : :
|
||||
<-----TMM-----> <----Tmm----->
|
||||
|
||||
|
||||
TmM = Period between minimum and the following Maximum
|
||||
TMm = Period between Maximum and the following minimum
|
||||
TMM = Period between Maximum and the following Maximum
|
||||
Tmm = Period between minimum and the following minimum
|
||||
|
||||
See also
|
||||
--------
|
||||
waves,
|
||||
wave_amplitudes,
|
||||
crossings,
|
||||
turning_points
|
||||
"""
|
||||
print(wave_periods.__doc__)
|
||||
def turning_points():
|
||||
r"""
|
||||
Turning points definitions and numenclature
|
||||
|
||||
Definition of turningpoints
|
||||
---------------------------
|
||||
<----- Direction of wave propagation
|
||||
|
||||
M M
|
||||
/ \ .... M /:\_ M_ M
|
||||
F \ | / \m/ : \ /: \ / \
|
||||
\ h | / : \ / : \ / \
|
||||
\ | / : \ / : \_ _/ \_ L
|
||||
\_ | / : \_m_/ : \m_/ \m/
|
||||
\m/ : : : :
|
||||
<------Mw-----> <-----mw----->
|
||||
|
||||
Local minimum or maximum are indicated with the
|
||||
letters 'm' or 'M'. Turning points in this connection are all
|
||||
local max (M) and min (m) and the last (L) value and the
|
||||
first (F) value if the first local extremum is a max.
|
||||
|
||||
(This choice is made in order to get the exact up-crossing intensity
|
||||
from rfc by mm2lc(tp2mm(rfc)) )
|
||||
|
||||
|
||||
See also
|
||||
--------
|
||||
waves,
|
||||
crossings,
|
||||
cycle_pairs
|
||||
findtp
|
||||
|
||||
"""
|
||||
print(turning_points.__doc__)
|
||||
def waves():
|
||||
r"""
|
||||
Wave definitions and nomenclature
|
||||
|
||||
Definition of trough and crest
|
||||
------------------------------
|
||||
A trough (t) is defined as the global minimum between a
|
||||
level v down-crossing (d) and the next up-crossing (u)
|
||||
and a crest (c) is defined as the global maximum between a
|
||||
level v up-crossing and the following down-crossing.
|
||||
|
||||
Definition of down- and up -crossing waves
|
||||
------------------------------------------
|
||||
A level v-down-crossing wave (dw) is a wave from a
|
||||
down-crossing to the following down-crossing.
|
||||
Similarly, a level v-up-crossing wave (uw) is a wave from an up-crossing
|
||||
to the next up-crossing.
|
||||
|
||||
Definition of trough and crest waves
|
||||
------------------------------------
|
||||
A trough-to-trough wave (tw) is a wave from a trough (t) to the
|
||||
following trough. The crest-to-crest wave (cw) is defined similarly.
|
||||
|
||||
|
||||
Definition of min2min and Max2Max wave
|
||||
--------------------------------------
|
||||
A min2min wave (mw) is defined starting from a minimum (m) and
|
||||
ending in the following minimum.
|
||||
Similarly a Max2Max wave (Mw) is thus a wave from a maximum (M)
|
||||
to the next maximum (all waves optionally rainflow filtered).
|
||||
|
||||
<----- Direction of wave propagation
|
||||
|
||||
|
||||
<------Mw-----> <----mw---->
|
||||
M : : c :
|
||||
/ \ M : / \_ : c_ c
|
||||
F \ / \m/ \ : /: \ /:\
|
||||
------d--------u----------d-------u----d--------u---d------ level v
|
||||
\ /: \ : /: : :\_ _/ : :\_ L
|
||||
\_ / : \_t_/ : : : \t_/ : : \m/
|
||||
\t/ <-------uw---------> : <-----dw----->
|
||||
: : : :
|
||||
<--------tw--------> <------cw----->
|
||||
|
||||
(F=first value and L=last value).
|
||||
|
||||
See also
|
||||
--------
|
||||
turning_points,
|
||||
crossings,
|
||||
wave_periods
|
||||
findtc,
|
||||
findcross
|
||||
"""
|
||||
print(waves.__doc__)
|
||||
@ -0,0 +1,281 @@
|
||||
"""
|
||||
WAFO defintions and numenclature
|
||||
|
||||
crossings :
|
||||
cycle_pairs :
|
||||
turning_points :
|
||||
wave_amplitudes :
|
||||
wave_periods :
|
||||
waves :
|
||||
"""
|
||||
def wave_amplitudes():
|
||||
"""
|
||||
Wave amplitudes and heights definitions and nomenclature
|
||||
|
||||
Definition of wave amplitudes and wave heights
|
||||
---------------------------------------------
|
||||
|
||||
<----- Direction of wave propagation
|
||||
|
||||
|
||||
...............c_..........
|
||||
| /| \ |
|
||||
Hd | _/ | \ | Hu
|
||||
M | / | \ |
|
||||
/ \ | M / Ac | \_ | c_
|
||||
F \ | / \m/ | \ | / \
|
||||
------d----|---u------------------d---|---u----d------ level v
|
||||
\ | /| \ | / \L
|
||||
\_ | / | At \_|_/
|
||||
\|/..| t
|
||||
t
|
||||
|
||||
Parameters
|
||||
----------
|
||||
Ac : crest amplitude
|
||||
At : trough amplitude
|
||||
Hd : wave height as defined for down crossing waves
|
||||
Hu : wave height as defined for up crossing waves
|
||||
|
||||
See also
|
||||
--------
|
||||
waves, crossings, turning_points
|
||||
"""
|
||||
pass
|
||||
def crossings():
|
||||
"""
|
||||
Level v crossing definitions and nomenclature
|
||||
|
||||
Definition of level v crossings
|
||||
-------------------------------
|
||||
M
|
||||
. . M M
|
||||
. . . . . .
|
||||
F d . . L
|
||||
-----------------------u-------d-------o----------------- level v
|
||||
. . . . u
|
||||
. m
|
||||
m
|
||||
|
||||
Let the letters 'm', 'M', 'F', 'L','d' and 'u' in the
|
||||
figure above denote local minimum, maximum, first value, last
|
||||
value, down- and up-crossing, respectively. The remaining
|
||||
sampled values are indicated with a '.'. Values that are identical
|
||||
with v, but do not cross the level is indicated with the letter 'o'.
|
||||
We have a level up-crossing at index, k, if
|
||||
|
||||
x(k) < v and v < x(k+1)
|
||||
or if
|
||||
x(k) == v and v < x(k+1) and x(r) < v for some di < r <= k-1
|
||||
|
||||
where di is the index to the previous downcrossing.
|
||||
Similarly there is a level down-crossing at index, k, if
|
||||
|
||||
x(k) > v and v > x(k+1)
|
||||
or if
|
||||
x(k) == v and v > x(k+1) and x(r) > v for some ui < r <= k-1
|
||||
|
||||
where ui is the index to the previous upcrossing.
|
||||
|
||||
The first (F) value is a up crossing if x(1) = v and x(2) > v.
|
||||
Similarly, it is a down crossing if x(1) = v and x(2) < v.
|
||||
|
||||
See also
|
||||
--------
|
||||
wave_periods, waves, turning_points, findcross, findtp
|
||||
"""
|
||||
pass
|
||||
def cycle_pairs():
|
||||
"""
|
||||
Cycle pairs definitions and numenclature
|
||||
|
||||
Definition of Max2min and min2Max cycle pair
|
||||
--------------------------------------------
|
||||
A min2Max cycle pair (mM) is defined as the pair of a minimum
|
||||
and the following Maximum. Similarly a Max2min cycle pair (Mm)
|
||||
is defined as the pair of a Maximum and the following minimum.
|
||||
(all turning points possibly rainflowfiltered before pairing into cycles.)
|
||||
|
||||
See also
|
||||
--------
|
||||
turning_points
|
||||
"""
|
||||
pass
|
||||
def wave_periods():
|
||||
"""
|
||||
Wave periods (lengths) definitions and nomenclature
|
||||
|
||||
Definition of wave periods (lengths)
|
||||
------------------------------------
|
||||
|
||||
|
||||
<----- Direction of wave propagation
|
||||
|
||||
<-------Tu--------->
|
||||
: :
|
||||
<---Tc-----> :
|
||||
: : : <------Tcc---->
|
||||
M : c : : : :
|
||||
/ \ : M / \_ : : c_ c
|
||||
F \ :/ \m/ \: :/ \ / \
|
||||
------d--------u----------d-------u----d--------u---d-------- level v
|
||||
\ / \ / :\_ _/: :\_ L
|
||||
\_ / \_t_/ : \t_/ : : \m/
|
||||
\t/ : : : :
|
||||
: : <---Tt---> :
|
||||
<--------Ttt-------> : :
|
||||
<-----Td----->
|
||||
Tu = Up crossing period
|
||||
Td = Down crossing period
|
||||
Tc = Crest period, i.e., period between up crossing and
|
||||
the next down crossing
|
||||
Tt = Trough period, i.e., period between down crossing and
|
||||
the next up crossing
|
||||
Ttt = Trough2trough period
|
||||
Tcc = Crest2crest period
|
||||
|
||||
|
||||
<----- Direction of wave propagation
|
||||
|
||||
<--Tcf-> Tuc
|
||||
: : <-Tcb-> <->
|
||||
M : c : : : :
|
||||
/ \ : M / \_ c_ : : c
|
||||
F \ :/ \m/ \ / \___: :/ \
|
||||
------d---------u----------d---------u-------d--------u---d------ level v
|
||||
:\_ / \ __/: \_ _/ \_ L
|
||||
: \_ / \_t_/ : \t_/ \m/
|
||||
: \t/ : :
|
||||
: : : :
|
||||
<-Ttf-> <-Ttb->
|
||||
|
||||
|
||||
Tcf = Crest front period, i.e., period between up crossing and crest
|
||||
Tcb = Crest back period, i.e., period between crest and down crossing
|
||||
Ttf = Trough front period, i.e., period between down crossing and trough
|
||||
Ttb = Trough back period, i.e., period between trough and up crossing
|
||||
Also note that Tcf and Ttf can also be abbreviated by their crossing
|
||||
marker, e.g. Tuc (u2c) and Tdt (d2t), respectively. Similar applies
|
||||
to all the other wave periods and wave lengths.
|
||||
|
||||
(The nomenclature for wave length is similar, just substitute T and
|
||||
period with L and length, respectively)
|
||||
|
||||
<----- Direction of wave propagation
|
||||
|
||||
<--TMm-->
|
||||
<-TmM-> : :
|
||||
M : : M :
|
||||
/ \ : M /:\_ : M_ M
|
||||
F \ : / \m/ : \ : /: \ / \
|
||||
\ : / : \ : / : \ / \
|
||||
\ : / : \ : / : \_ _/ \_ L
|
||||
\_ : / : \_m_/ : \m_/ \m/
|
||||
\m/ : : : :
|
||||
<-----TMM-----> <----Tmm----->
|
||||
|
||||
|
||||
TmM = Period between minimum and the following Maximum
|
||||
TMm = Period between Maximum and the following minimum
|
||||
TMM = Period between Maximum and the following Maximum
|
||||
Tmm = Period between minimum and the following minimum
|
||||
|
||||
See also
|
||||
--------
|
||||
waves,
|
||||
wave_amplitudes,
|
||||
crossings,
|
||||
turning_points
|
||||
"""
|
||||
pass
|
||||
def turning_points():
|
||||
"""
|
||||
Turning points definitions and numenclature
|
||||
|
||||
Definition of turningpoints
|
||||
---------------------------
|
||||
<----- Direction of wave propagation
|
||||
|
||||
M M
|
||||
/ \ .... M /:\_ M_ M
|
||||
F \ | / \m/ : \ /: \ / \
|
||||
\ h | / : \ / : \ / \
|
||||
\ | / : \ / : \_ _/ \_ L
|
||||
\_ | / : \_m_/ : \m_/ \m/
|
||||
\m/ : : : :
|
||||
<------Mw-----> <-----mw----->
|
||||
|
||||
Local minimum or maximum are indicated with the
|
||||
letters 'm' or 'M'. Turning points in this connection are all
|
||||
local max (M) and min (m) and the last (L) value and the
|
||||
first (F) value if the first local extremum is a max.
|
||||
|
||||
(This choice is made in order to get the exact up-crossing intensity
|
||||
from rfc by mm2lc(tp2mm(rfc)) )
|
||||
|
||||
|
||||
See also
|
||||
--------
|
||||
waves,
|
||||
crossings,
|
||||
cycle_pairs
|
||||
findtp
|
||||
|
||||
"""
|
||||
pass
|
||||
def waves():
|
||||
"""
|
||||
Wave definitions and nomenclature
|
||||
|
||||
Definition of trough and crest
|
||||
------------------------------
|
||||
A trough (t) is defined as the global minimum between a
|
||||
level v down-crossing (d) and the next up-crossing (u)
|
||||
and a crest (c) is defined as the global maximum between a
|
||||
level v up-crossing and the following down-crossing.
|
||||
|
||||
Definition of down- and up -crossing waves
|
||||
------------------------------------------
|
||||
A level v-down-crossing wave (dw) is a wave from a
|
||||
down-crossing to the following down-crossing.
|
||||
Similarly, a level v-up-crossing wave (uw) is a wave from an up-crossing
|
||||
to the next up-crossing.
|
||||
|
||||
Definition of trough and crest waves
|
||||
------------------------------------
|
||||
A trough-to-trough wave (tw) is a wave from a trough (t) to the
|
||||
following trough. The crest-to-crest wave (cw) is defined similarly.
|
||||
|
||||
|
||||
Definition of min2min and Max2Max wave
|
||||
--------------------------------------
|
||||
A min2min wave (mw) is defined starting from a minimum (m) and
|
||||
ending in the following minimum.
|
||||
Similarly a Max2Max wave (Mw) is thus a wave from a maximum (M)
|
||||
to the next maximum (all waves optionally rainflow filtered).
|
||||
|
||||
<----- Direction of wave propagation
|
||||
|
||||
|
||||
<------Mw-----> <----mw---->
|
||||
M : : c :
|
||||
/ \ M : / \_ : c_ c
|
||||
F \ / \m/ \ : /: \ /:\
|
||||
------d--------u----------d-------u----d--------u---d------ level v
|
||||
\ /: \ : /: : :\_ _/ : :\_ L
|
||||
\_ / : \_t_/ : : : \t_/ : : \m/
|
||||
\t/ <-------uw---------> : <-----dw----->
|
||||
: : : :
|
||||
<--------tw--------> <------cw----->
|
||||
|
||||
(F= first value and L=last value).
|
||||
|
||||
See also
|
||||
--------
|
||||
turning_points,
|
||||
crossings,
|
||||
wave_periods
|
||||
findtc,
|
||||
findcross
|
||||
"""
|
||||
pass
|
||||
@ -0,0 +1,43 @@
|
||||
from pylab import subplot, plot, title, savefig, figure, arange, sin, random #@UnresolvedImport
|
||||
from sg_filter import calc_coeff, smooth
|
||||
|
||||
|
||||
figure(figsize=(7,12))
|
||||
|
||||
|
||||
# generate chirp signal
|
||||
tvec = arange(0, 6.28, .02)
|
||||
signal = sin(tvec*(2.0+tvec))
|
||||
|
||||
# add noise to signal
|
||||
noise = random.normal(size=signal.shape)
|
||||
signal += (2000.+.15 * noise)
|
||||
|
||||
# plot signal
|
||||
subplot(311)
|
||||
plot(signal)
|
||||
title('signal')
|
||||
|
||||
# smooth and plot signal
|
||||
subplot(312)
|
||||
coeff = calc_coeff(8, 4)
|
||||
s_signal = smooth(signal, coeff)
|
||||
|
||||
plot(s_signal)
|
||||
title('smoothed signal')
|
||||
|
||||
# smooth derivative of signal and plot it
|
||||
subplot(313)
|
||||
coeff = calc_coeff(8, 1, 1)
|
||||
d_signal = smooth(signal, coeff)
|
||||
|
||||
plot(d_signal)
|
||||
title('smoothed derivative of signal')
|
||||
|
||||
# show plot
|
||||
savefig("savitzky.png")
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Binary file not shown.
@ -0,0 +1,30 @@
|
||||
! File diffsumfunq.pyf
|
||||
python module diffsumfunq
|
||||
interface
|
||||
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==shape(iA,0)) :: n=shape(rA,0)
|
||||
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), 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==shape(iA,0)) :: n=shape(rA,0)
|
||||
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), 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 disufq
|
||||
|
||||
end interface
|
||||
end python module diffsumfunq
|
||||
@ -0,0 +1,30 @@
|
||||
! File diffsumfunq.pyf
|
||||
python module diffsumfunq
|
||||
interface
|
||||
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==shape(iA,0)) :: n=shape(rA,0)
|
||||
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), 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==shape(iA,0)) :: n=shape(rA,0)
|
||||
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), 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 disufq
|
||||
|
||||
end interface
|
||||
end python module diffsumfunq
|
||||
@ -0,0 +1,446 @@
|
||||
#include "math.h"
|
||||
/*
|
||||
* 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;
|
||||
}
|
||||
@ -0,0 +1,117 @@
|
||||
#include "math.h"
|
||||
/*
|
||||
* findrfc.c -
|
||||
*
|
||||
* Returns indices to RFC turningpoints of a vector
|
||||
* of turningpoints
|
||||
*
|
||||
* Install gfortran and run the following to build the module:
|
||||
* f2py rfc.pyf findrfc.c -c --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71
|
||||
*
|
||||
* 1998 by Per Andreas Brodtkorb.
|
||||
*/
|
||||
|
||||
void findrfc(double *y1,double hmin, double *ind, int n,int info) {
|
||||
double xminus,xplus,Tpl,Tmi,*y,Tstart;
|
||||
int i,j,ix=0,NC,iy;
|
||||
|
||||
if (*(y1+0)> *(y1+1)){ /* if first is a max*/
|
||||
y=&(*(y1+1)); /* ignore the first max*/
|
||||
NC=floor((n-1)/2);
|
||||
Tstart=2;
|
||||
}
|
||||
else {
|
||||
y=y1;
|
||||
NC=floor(n/2);
|
||||
Tstart=1;
|
||||
}
|
||||
|
||||
if (NC<1){
|
||||
info = 0;
|
||||
return; /* No RFC cycles*/
|
||||
}
|
||||
|
||||
|
||||
if (( *(y+0) > *(y+1)) && ( *(y+1) > *(y+2)) ){
|
||||
info = -1;
|
||||
return; /*This is not a sequence of turningpoints, exit */
|
||||
}
|
||||
if ((*(y+0) < *(y+1)) && (*(y+1)< *(y+2))){
|
||||
info=-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 = ix;
|
||||
return ;
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,367 @@
|
||||
import numpy as np
|
||||
from numpy import (r_, minimum, maximum, atleast_1d, atleast_2d, mod, zeros, #@UnresolvedImport
|
||||
ones, floor, random, eye, nonzero, repeat, sqrt, inf, diag, triu) #@UnresolvedImport
|
||||
from scipy.special import ndtri as invnorm
|
||||
import rindmod
|
||||
|
||||
|
||||
class Rind(object):
|
||||
'''
|
||||
RIND Computes multivariate normal expectations
|
||||
|
||||
Parameters
|
||||
----------
|
||||
S : array-like, shape Ntdc x Ntdc
|
||||
Covariance matrix of X=[Xt,Xd,Xc] (Ntdc = Nt+Nd+Nc)
|
||||
m : array-like, size Ntdc
|
||||
expectation of X=[Xt,Xd,Xc]
|
||||
Blo, Bup : array-like, shape Mb x Nb
|
||||
Lower and upper barriers used to compute the integration limits, Hlo and Hup, respectively.
|
||||
indI : array-like, length Ni
|
||||
vector of indices to the different barriers in the indicator function.
|
||||
(NB! restriction indI(1)=0, indI(NI)=Nt+Nd, Ni = Nb+1)
|
||||
(default indI = 0:Nt+Nd)
|
||||
xc : values to condition on (default xc = zeros(0,1)), size Nc x Nx
|
||||
Nt : size of Xt (default Nt = Ntdc - Nc)
|
||||
|
||||
Returns
|
||||
-------
|
||||
val: ndarray, size Nx
|
||||
expectation/density as explained below
|
||||
err, terr : ndarray, size Nx
|
||||
estimated sampling error and estimated truncation error, respectively.
|
||||
(err is with 99 confidence level)
|
||||
|
||||
Notes
|
||||
-----
|
||||
RIND computes multivariate normal expectations, i.e.,
|
||||
E[Jacobian*Indicator|Condition ]*f_{Xc}(xc(:,ix))
|
||||
where
|
||||
"Indicator" = I{ Hlo(i) < X(i) < Hup(i), i = 1:N_t+N_d }
|
||||
"Jacobian" = J(X(Nt+1),...,X(Nt+Nd+Nc)), special case is
|
||||
"Jacobian" = |X(Nt+1)*...*X(Nt+Nd)|=|Xd(1)*Xd(2)..Xd(Nd)|
|
||||
"condition" = Xc=xc(:,ix), ix=1,...,Nx.
|
||||
X = [Xt, Xd, Xc], a stochastic vector of Multivariate Gaussian
|
||||
variables where Xt,Xd and Xc have the length Nt,Nd and Nc, respectively.
|
||||
(Recommended limitations Nx,Nt<=100, Nd<=6 and Nc<=10)
|
||||
|
||||
Multivariate probability is computed if Nd = 0.
|
||||
|
||||
If Mb<Nc+1 then Blo[Mb:Nc+1,:] is assumed to be zero.
|
||||
The relation to the integration limits Hlo and Hup are as follows
|
||||
|
||||
Hlo(i) = Blo(1,j)+Blo(2:Mb,j).T*xc(1:Mb-1,ix),
|
||||
Hup(i) = Bup(1,j)+Bup(2:Mb,j).T*xc(1:Mb-1,ix),
|
||||
|
||||
where i=indI(j-1)+1:indI(j), j=2:NI, ix=1:Nx
|
||||
|
||||
NOTE : RIND is only using upper triangular part of covariance matrix, S
|
||||
(except for method=0).
|
||||
|
||||
Examples
|
||||
--------
|
||||
Compute Prob{Xi<-1.2} for i=1:5 where Xi are zero mean Gaussian with
|
||||
Cov(Xi,Xj) = 0.3 for i~=j and
|
||||
Cov(Xi,Xi) = 1 otherwise
|
||||
>>> n = 5
|
||||
>>> Blo =-np.inf; Bup=-1.2; indI=[-1, n-1] # Barriers
|
||||
>>> m = np.zeros(n); rho = 0.3;
|
||||
>>> Sc =(np.ones((n,n))-np.eye(n))*rho+np.eye(n)
|
||||
>>> rind = Rind()
|
||||
>>> E0 = rind(Sc,m,Blo,Bup,indI) # exact prob. 0.001946
|
||||
|
||||
>>> A = np.repeat(Blo,n); B = np.repeat(Bup,n) # Integration limits
|
||||
>>> E1 = rind(np.triu(Sc),m,A,B) #same as E0
|
||||
|
||||
Compute expectation E( abs(X1*X2*...*X5) )
|
||||
>>> xc = np.zeros((0,1))
|
||||
>>> infinity = 37
|
||||
>>> dev = np.sqrt(np.diag(Sc)) # std
|
||||
>>> ind = np.nonzero(indI[1:])[0]
|
||||
>>> Bup, Blo = np.atleast_2d(Bup,Blo)
|
||||
>>> Bup[0,ind] = np.minimum(Bup[0,ind] , infinity*dev[indI[ind+1]])
|
||||
>>> Blo[0,ind] = np.maximum(Blo[0,ind] ,-infinity*dev[indI[ind+1]])
|
||||
>>> rind(Sc,m,Blo,Bup,indI, xc, nt=0)
|
||||
(array([ 0.05494076]), array([ 0.00083066]), array([ 1.00000000e-10]))
|
||||
|
||||
Compute expectation E( X1^{+}*X2^{+} ) with random
|
||||
correlation coefficient,Cov(X1,X2) = rho2.
|
||||
>>> m2 = [0, 0]; rho2 = np.random.rand(1)
|
||||
>>> Sc2 = [[1, rho2], [rho2 ,1]]
|
||||
>>> Blo2 = 0; Bup2 = np.inf; indI2 = [-1, 1]
|
||||
>>> rind2 = Rind(method=1)
|
||||
>>> g2 = lambda x : (x*(np.pi/2+np.arcsin(x))+np.sqrt(1-x**2))/(2*np.pi)
|
||||
>>> E2 = g2(rho2) # exact value
|
||||
>>> E3 = rind(Sc2,m2,Blo2,Bup2,indI2,nt=0)
|
||||
>>> E4 = rind2(Sc2,m2,Blo2,Bup2,indI2,nt=0)
|
||||
>>> E5 = rind2(Sc2,m2,Blo2,Bup2,indI2,nt=0,abseps=1e-4)
|
||||
|
||||
See also
|
||||
--------
|
||||
prbnormnd, prbnormndpc
|
||||
|
||||
References
|
||||
----------
|
||||
Podgorski et al. (2000)
|
||||
"Exact distributions for apparent waves in irregular seas"
|
||||
Ocean Engineering, Vol 27, no 1, pp979-1016.
|
||||
|
||||
P. A. Brodtkorb (2004),
|
||||
Numerical evaluation of multinormal expectations
|
||||
In Lund university report series
|
||||
and in the Dr.Ing thesis:
|
||||
The probability of Occurrence of dangerous Wave Situations at Sea.
|
||||
Dr.Ing thesis, Norwegian University of Science and Technolgy, NTNU,
|
||||
Trondheim, Norway.
|
||||
|
||||
Per A. Brodtkorb (2006)
|
||||
"Evaluating Nearly Singular Multinormal Expectations with Application to
|
||||
Wave Distributions",
|
||||
Methodology And Computing In Applied Probability, Volume 8, Number 1, pp. 65-91(27)
|
||||
'''
|
||||
|
||||
|
||||
def __init__(self, **kwds):
|
||||
'''
|
||||
Parameters
|
||||
----------
|
||||
method : integer, optional
|
||||
defining the integration method
|
||||
0 Integrate by Gauss-Legendre quadrature (Podgorski et al. 1999)
|
||||
1 Integrate by SADAPT for Ndim<9 and by KRBVRC otherwise
|
||||
2 Integrate by SADAPT for Ndim<20 and by KRBVRC otherwise
|
||||
3 Integrate by KRBVRC by Genz (1993) (Fast Ndim<101) (default)
|
||||
4 Integrate by KROBOV by Genz (1992) (Fast Ndim<101)
|
||||
5 Integrate by RCRUDE by Genz (1992) (Slow Ndim<1001)
|
||||
6 Integrate by SOBNIED (Fast Ndim<1041)
|
||||
7 Integrate by DKBVRC by Genz (2003) (Fast Ndim<1001)
|
||||
|
||||
xcscale : real scalar, optional
|
||||
scales the conditinal probability density, i.e.,
|
||||
f_{Xc} = exp(-0.5*Xc*inv(Sxc)*Xc + XcScale) (default XcScale=0)
|
||||
abseps, releps : real scalars, optional
|
||||
absolute and relative error tolerance. (default abseps=0, releps=1e-3)
|
||||
coveps : real scalar, optional
|
||||
error tolerance in Cholesky factorization (default 1e-13)
|
||||
maxpts, minpts : scalar integers, optional
|
||||
maximum and minimum number of function values allowed. The parameter,
|
||||
maxpts, can be used to limit the time. A sensible strategy is to start
|
||||
with MAXPTS = 1000*N, and then increase MAXPTS if ERROR is too large.
|
||||
(Only for METHOD~=0) (default maxpts=40000, minpts=0)
|
||||
seed : scalar integer, optional
|
||||
seed to the random generator used in the integrations
|
||||
(Only for METHOD~=0)(default floor(rand*1e9))
|
||||
nit : scalar integer, optional
|
||||
maximum number of Xt variables to integrate. This parameter can be used
|
||||
to limit the time. If NIT is less than the rank of the covariance matrix,
|
||||
the returned result is a upper bound for the true value of the integral.
|
||||
(default 1000)
|
||||
xcutoff : real scalar, optional
|
||||
cut off value where the marginal normal distribution is truncated.
|
||||
(Depends on requested accuracy. A value between 4 and 5 is reasonable.)
|
||||
xsplit : real scalar
|
||||
parameter controlling performance of quadrature integration:
|
||||
if Hup>=xCutOff AND Hlo<-XSPLIT OR
|
||||
Hup>=XSPLIT AND Hlo<=-xCutOff then
|
||||
do a different integration to increase speed
|
||||
in rind2 and rindnit. This give slightly different results
|
||||
if XSPILT>=xCutOff => do the same integration always
|
||||
(Only for METHOD==0)(default XSPLIT = 1.5)
|
||||
quadno : scalar integer
|
||||
Quadrature formulae number used in integration of Xd variables.
|
||||
This number implicitly determines number of nodes
|
||||
used. (Only for METHOD==0)
|
||||
speed : scalar integer
|
||||
defines accuracy of calculations by choosing different parameters,
|
||||
possible values: 1,2...,9 (9 fastest, default []).
|
||||
If not speed is None the parameters, ABSEPS, RELEPS, COVEPS,
|
||||
XCUTOFF, MAXPTS and QUADNO will be set according to
|
||||
INITOPTIONS.
|
||||
nc1c2 : scalar integer, optional
|
||||
number of times to use the regression equation to restrict integration
|
||||
area. Nc1c2 = 1,2 is recommended. (default 2)
|
||||
(note: works only for method >0)
|
||||
'''
|
||||
self.method = 3
|
||||
self.xcscale = 0
|
||||
self.abseps = 0
|
||||
self.releps = 1e-3,
|
||||
self.coveps = 1e-10
|
||||
self.maxpts = 40000
|
||||
self.minpts = 0
|
||||
self.seed = None
|
||||
self.nit = 1000,
|
||||
self.xcutoff = None
|
||||
self.xsplit = 1.5
|
||||
self.quadno = 2
|
||||
self.speed = None
|
||||
self.nc1c2 = 2
|
||||
|
||||
self.__dict__.update(**kwds)
|
||||
self.initialize(self.speed)
|
||||
self.set_constants()
|
||||
|
||||
def initialize(self, speed=None):
|
||||
'''
|
||||
Initializes member variables according to speed.
|
||||
|
||||
Parameter
|
||||
---------
|
||||
speed : scalar integer
|
||||
defining accuracy of calculations.
|
||||
Valid numbers: 1,2,...,10
|
||||
(1=slowest and most accurate,10=fastest, but less accuracy)
|
||||
|
||||
|
||||
Member variables initialized according to speed:
|
||||
-----------------------------------------------
|
||||
speed : Integer defining accuracy of calculations.
|
||||
abseps : Absolute error tolerance.
|
||||
releps : Relative error tolerance.
|
||||
covep : Error tolerance in Cholesky factorization.
|
||||
xcutoff : Truncation limit of the normal CDF
|
||||
maxpts : Maximum number of function values allowed.
|
||||
quadno : Quadrature formulae used in integration of Xd(i)
|
||||
implicitly determining # nodes
|
||||
'''
|
||||
if speed is None:
|
||||
return
|
||||
self.speed = min(max(speed, 1), 13)
|
||||
|
||||
self.maxpts = 10000
|
||||
self.quadno = r_[1:4] + (10 - min(speed, 9)) + (speed == 1)
|
||||
if speed in (11, 12, 13):
|
||||
self.abseps = 1e-1
|
||||
elif speed == 10:
|
||||
self.abseps = 1e-2
|
||||
elif speed in (7, 8, 9):
|
||||
self.abseps = 1e-2
|
||||
elif speed in (4, 5, 6):
|
||||
self.maxpts = 20000
|
||||
self.abseps = 1e-3
|
||||
elif speed in (1, 2, 3):
|
||||
self.maxpts = 30000
|
||||
self.abseps = 1e-4
|
||||
|
||||
if speed < 12:
|
||||
tmp = max(abs(11 - abs(speed)), 1)
|
||||
expon = mod(tmp + 1, 3) + 1
|
||||
self.coveps = self.abseps * ((1.0e-1) ** expon)
|
||||
elif speed < 13:
|
||||
self.coveps = 0.1
|
||||
else:
|
||||
self.coveps = 0.5
|
||||
|
||||
self.releps = min(self.abseps, 1.0e-2)
|
||||
|
||||
if self.method == 0 :
|
||||
# This gives approximately the same accuracy as when using
|
||||
# RINDDND and RINDNIT
|
||||
# xCutOff= MIN(MAX(xCutOff+0.5d0,4.d0),5.d0)
|
||||
self.abseps = self.abseps * 1.0e-1
|
||||
trunc_error = 0.05 * max(0, self.abseps)
|
||||
self.xcutoff = max(min(abs(invnorm(trunc_error)), 7), 1.2)
|
||||
self.abseps = max(self.abseps - trunc_error, 0)
|
||||
|
||||
def set_constants(self):
|
||||
if self.xcutoff is None:
|
||||
trunc_error = 0.1 * self.abseps
|
||||
self.nc1c2 = max(1, self.nc1c2)
|
||||
xcut = abs(invnorm(trunc_error / (self.nc1c2 * 2)))
|
||||
self.xcutoff = max(min(xcut, 8.5), 1.2)
|
||||
#self.abseps = max(self.abseps- truncError,0);
|
||||
#self.releps = max(self.releps- truncError,0);
|
||||
|
||||
if self.method > 0:
|
||||
names = ['method', 'xcscale', 'abseps', 'releps', 'coveps',
|
||||
'maxpts', 'minpts', 'nit', 'xcutoff', 'nc1c2', 'quadno',
|
||||
'xsplit']
|
||||
|
||||
constants = [getattr(self, name) for name in names]
|
||||
constants[0] = mod(constants[0], 10)
|
||||
rindmod.set_constants(*constants) #@UndefinedVariable
|
||||
|
||||
def __call__(self, cov, m, ab, bb, indI=None, xc=None, nt=None, **kwds):
|
||||
if any(kwds):
|
||||
self.__dict__.update(**kwds)
|
||||
self.set_constants()
|
||||
if xc is None:
|
||||
xc = zeros((0, 1))
|
||||
|
||||
BIG, Blo, Bup, xc = atleast_2d(cov, ab, bb, xc)
|
||||
Blo = Blo.copy()
|
||||
Bup = Bup.copy()
|
||||
|
||||
Ntdc = BIG.shape[0]
|
||||
Nc = xc.shape[0]
|
||||
if nt is None:
|
||||
nt = Ntdc - Nc
|
||||
|
||||
unused_Mb, Nb = Blo.shape
|
||||
Nd = Ntdc - nt - Nc
|
||||
Ntd = nt + Nd
|
||||
|
||||
if indI is None:
|
||||
if Nb != Ntd:
|
||||
raise ValueError('Inconsistent size of Blo and Bup')
|
||||
indI = r_[-1:Ntd]
|
||||
|
||||
Ex, indI = atleast_1d(m, indI)
|
||||
if self.seed is None:
|
||||
seed = int(floor(random.rand(1) * 1e10)) #@UndefinedVariable
|
||||
else:
|
||||
seed = int(self.seed)
|
||||
|
||||
# INFIN = INTEGER, array of integration limits flags: size 1 x Nb
|
||||
# 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)].
|
||||
infinity = 37
|
||||
dev = sqrt(diag(BIG)) # std
|
||||
ind = nonzero(indI[1:] > -1)[0]
|
||||
infin = repeat(2, len(indI) - 1)
|
||||
infin[ind] = (2 - (Bup[0, ind] > infinity * dev[indI[ind + 1]])
|
||||
- 2 * (Blo[0, ind] < -infinity * dev[indI[ind + 1]]))
|
||||
|
||||
Bup[0, ind] = minimum(Bup[0, ind], infinity * dev[indI[ind + 1]])
|
||||
Blo[0, ind] = maximum(Blo[0, ind], -infinity * dev[indI[ind + 1]])
|
||||
ind2 = indI + 1
|
||||
return rindmod.rind(BIG, Ex, xc, nt, ind2, Blo, Bup, infin, seed) #@UndefinedVariable
|
||||
|
||||
def test_rind():
|
||||
''' Small test function
|
||||
'''
|
||||
n = 5
|
||||
Blo = -inf
|
||||
Bup = -1.2
|
||||
indI = [-1, n - 1] # Barriers
|
||||
# A = np.repeat(Blo, n)
|
||||
# B = np.repeat(Bup, n) # Integration limits
|
||||
m = zeros(n)
|
||||
rho = 0.3
|
||||
Sc = (ones((n, n)) - eye(n)) * rho + eye(n)
|
||||
rind = Rind()
|
||||
E0 = rind(Sc, m, Blo, Bup, indI) # exact prob. 0.001946 A)
|
||||
print(E0)
|
||||
|
||||
A = repeat(Blo, n)
|
||||
B = repeat(Bup, n) # Integration limits
|
||||
E1 = rind(triu(Sc), m, A, B) #same as E0
|
||||
|
||||
xc = zeros((0, 1))
|
||||
infinity = 37
|
||||
dev = sqrt(diag(Sc)) # std
|
||||
ind = nonzero(indI[1:])[0]
|
||||
Bup, Blo = atleast_2d(Bup, Blo)
|
||||
Bup[0, ind] = minimum(Bup[0, ind], infinity * dev[indI[ind + 1]])
|
||||
Blo[0, ind] = maximum(Blo[0, ind], -infinity * dev[indI[ind + 1]])
|
||||
E3 = rind(Sc, m, Blo, Bup, indI, xc, nt=1)
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
if False: #True: #
|
||||
test_rind()
|
||||
else:
|
||||
import doctest
|
||||
doctest.testmod()
|
||||
@ -0,0 +1,83 @@
|
||||
"""
|
||||
WAFO
|
||||
=====
|
||||
WAFO is a toolbox Python routines for statistical analysis and simulation of random waves and random loads.
|
||||
WAFO is freely redistributable software, see WAFO licence, cf. the GNU General Public License (GPL) and
|
||||
contain tools for:
|
||||
|
||||
Fatigue Analysis
|
||||
----------------
|
||||
-Fatigue life prediction for random loads
|
||||
-Theoretical density of rainflow cycles
|
||||
|
||||
Sea modelling
|
||||
-------------
|
||||
-Simulation of linear and non-linear Gaussian waves
|
||||
-Estimation of seamodels (spectrums)
|
||||
-Joint wave height, wave steepness, wave period distributions
|
||||
|
||||
Statistics
|
||||
------------
|
||||
-Extreme value analysis
|
||||
-Kernel density estimation
|
||||
-Hidden markov models
|
||||
|
||||
WAFO consists of several modules with short descriptions below.
|
||||
The modules SPECTRUM, COVARIANCE, TRANSFORM, WAVEMODELS, and MULTIDIM are
|
||||
mainly for oceanographic applications.
|
||||
The modules CYCLES, MARKOV, and DAMAGE are mainly for fatigue problems.
|
||||
The contents file for each module is shown by typing 'help module-name'
|
||||
Type 'help fatigue' for a presentation of all routines related to fatigue.
|
||||
|
||||
The paths to the modules are initiated by the function 'initwafo'.
|
||||
|
||||
ONEDIM - Data analysis of time series. Example: extraction of
|
||||
turning points, estimation of spectrum and covariance function.
|
||||
Estimation transformation used in transformed Gaussian model.
|
||||
COVARIANCE - Computation of spectral functions, linear
|
||||
and non-linear time series simulation.
|
||||
SPECTRUM - Computation of spectral moments and covariance functions, linear
|
||||
and non-linear time series simulation.
|
||||
Ex: common spectra implemented, directional spectra,
|
||||
bandwidth measures, exact distributions for wave characteristics.
|
||||
TRANSFORM - Modelling with linear or transformed Gaussian waves. Ex:
|
||||
|
||||
WAVEMODELS - Models for distributions of wave characteristics found in
|
||||
the literature. Ex: parametric models for breaking
|
||||
limited wave heights.
|
||||
MULTIDIM - Multi-dimensional time series analysis. (Under construction)
|
||||
CYCLES - Cycle counting, discretization, and crossings, calculation of
|
||||
damage. Simulation of discrete Markov chains, switching Markov
|
||||
chains, harmonic oscillator. Ex: Rainflow cycles and matrix,
|
||||
discretization of loads. Damage of a rainflow count or
|
||||
matrix, damage matrix, S-N plot.
|
||||
MARKOV - Routines for Markov loads, switching Markov loads, and
|
||||
their connection to rainflow cycles.
|
||||
DAMAGE - Calculation of damage. Ex: Damage of a rainflow count or
|
||||
matrix, damage matrix, S-N plot.
|
||||
SIMTOOLS - Simulation of random processes. Ex: spectral simulation,
|
||||
simulation of discrete Markov chains, switching Markov
|
||||
chains, harmonic oscillator
|
||||
STATISTICS - Statistical tools and extreme-value distributions.
|
||||
Ex: generation of random numbers, estimation of parameters,
|
||||
evaluation of pdf and cdf
|
||||
KDETOOLS - Kernel-density estimation.
|
||||
MISC - Miscellaneous routines. Ex: numerical integration, smoothing
|
||||
spline, binomial coefficient, water density.
|
||||
WDEMOS - WAFO demos.
|
||||
DOCS - Documentation of toolbox, definitions. An overview is given
|
||||
in the routine wafomenu.
|
||||
DATA - Measurements from marine applications.
|
||||
PAPERS - Commands that generate figures in selected scientific
|
||||
publications.
|
||||
SOURCE - Fortran and C files. Information on compilation.
|
||||
EXEC - Executable files (cf. SOURCE), pre-compiled for Solaris,
|
||||
Alpha-Dec or Windows.
|
||||
|
||||
WAFO homepage: <http://www.maths.lth.se/matstat/wafo/>
|
||||
On the WAFO home page you will find:
|
||||
- The WAFO Tutorial
|
||||
- New versions of WAFO to download.
|
||||
- Reported bugs.
|
||||
- List of publications related to WAFO.
|
||||
"""
|
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,418 @@
|
||||
#-------------------------------------------------------------------------------
|
||||
# Name: module1
|
||||
# Purpose:
|
||||
#
|
||||
# Author: pab
|
||||
#
|
||||
# Created: 30.12.2008
|
||||
# Copyright: (c) pab 2008
|
||||
# Licence: <your licence>
|
||||
#-------------------------------------------------------------------------------
|
||||
#!/usr/bin/env python
|
||||
from __future__ import division
|
||||
import numpy as np
|
||||
import scipy.sparse as sp
|
||||
import scipy.sparse.linalg #@UnusedImport
|
||||
from numpy.ma.core import ones, zeros, prod, sin
|
||||
from numpy import diff, pi, inf #@UnresolvedImport
|
||||
from numpy.lib.shape_base import vstack
|
||||
from numpy.lib.function_base import linspace
|
||||
import polynomial as pl
|
||||
|
||||
class PPform1(object):
|
||||
"""The ppform of the piecewise polynomials is given in terms of coefficients
|
||||
and breaks. The polynomial in the ith interval is
|
||||
x_{i} <= x < x_{i+1}
|
||||
|
||||
S_i = sum(coefs[m,i]*(x-breaks[i])^(k-m), m=0..k)
|
||||
where k is the degree of the polynomial.
|
||||
|
||||
Example
|
||||
-------
|
||||
>>> coef = np.array([[1,1]]) # unit step function
|
||||
>>> coef = np.array([[1,1],[0,1]]) # linear from 0 to 2
|
||||
>>> coef = np.array([[1,1],[1,1],[0,2]]) # linear from 0 to 2
|
||||
>>> breaks = [0,1,2]
|
||||
>>> self = PPform(coef, breaks)
|
||||
>>> x = linspace(-1,3)
|
||||
>>> plot(x,self(x))
|
||||
"""
|
||||
def __init__(self, coeffs, breaks, fill=0.0, sort=False, a=None, b=None):
|
||||
if sort:
|
||||
self.breaks = np.sort(breaks)
|
||||
else:
|
||||
self.breaks = np.asarray(breaks)
|
||||
if a is None:
|
||||
a = self.breaks[0]
|
||||
if b is None:
|
||||
b = self.breaks[-1]
|
||||
self.coeffs = np.asarray(coeffs)
|
||||
self.order = self.coeffs.shape[0]
|
||||
self.fill = fill
|
||||
self.a = a
|
||||
self.b = b
|
||||
|
||||
def __call__(self, xnew):
|
||||
saveshape = np.shape(xnew)
|
||||
xnew = np.ravel(xnew)
|
||||
res = np.empty_like(xnew)
|
||||
mask = (self.a <= xnew) & (xnew <= self.b)
|
||||
res[~mask] = self.fill
|
||||
xx = xnew.compress(mask)
|
||||
indxs = np.searchsorted(self.breaks[:-1], xx) - 1
|
||||
indxs = indxs.clip(0, len(self.breaks))
|
||||
pp = self.coeffs
|
||||
dx = xx - self.breaks.take(indxs)
|
||||
if True:
|
||||
v = pp[0, indxs]
|
||||
for i in xrange(1, self.order):
|
||||
v = dx * v + pp[i, indxs]
|
||||
values = v
|
||||
else:
|
||||
V = np.vander(dx, N=self.order)
|
||||
# values = np.diag(dot(V,pp[:,indxs]))
|
||||
dot = np.dot
|
||||
values = np.array([dot(V[k, :], pp[:, indxs[k]]) for k in xrange(len(xx))])
|
||||
|
||||
res[mask] = values
|
||||
res.shape = saveshape
|
||||
return res
|
||||
|
||||
def linear_extrapolate(self, output=True):
|
||||
'''
|
||||
Return a 1D PPform which extrapolate linearly outside its basic interval
|
||||
'''
|
||||
|
||||
max_order = 2
|
||||
|
||||
if self.order <= max_order:
|
||||
if output:
|
||||
return self
|
||||
else:
|
||||
return
|
||||
breaks = self.breaks.copy()
|
||||
coefs = self.coeffs.copy()
|
||||
#pieces = len(breaks) - 1
|
||||
|
||||
# Add new breaks beyond each end
|
||||
breaks2add = breaks[[0, -1]] + np.array([-1, 1])
|
||||
newbreaks = np.hstack([breaks2add[0], breaks, breaks2add[1]])
|
||||
|
||||
dx = newbreaks[[0, -2]] - breaks[[0, -2]]
|
||||
|
||||
dx = dx.ravel()
|
||||
|
||||
# Get coefficients for the new last polynomial piece (a_n)
|
||||
# by just relocate the previous last polynomial and
|
||||
# then set all terms of order > maxOrder to zero
|
||||
|
||||
a_nn = coefs[:, -1]
|
||||
dxN = dx[-1]
|
||||
|
||||
a_n = pl.polyreloc(a_nn, -dxN) # Relocate last polynomial
|
||||
#set to zero all terms of order > maxOrder
|
||||
a_n[0:self.order - max_order] = 0
|
||||
|
||||
#Get the coefficients for the new first piece (a_1)
|
||||
# by first setting all terms of order > maxOrder to zero and then
|
||||
# relocate the polynomial.
|
||||
|
||||
|
||||
#Set to zero all terms of order > maxOrder, i.e., not using them
|
||||
a_11 = coefs[self.order - max_order::, 0]
|
||||
dx1 = dx[0]
|
||||
|
||||
a_1 = pl.polyreloc(a_11, -dx1) # Relocate first polynomial
|
||||
a_1 = np.hstack([zeros(self.order - max_order), a_1])
|
||||
|
||||
newcoefs = np.hstack([ a_1.reshape(-1, 1), coefs, a_n.reshape(-1, 1)])
|
||||
if output:
|
||||
return PPform(newcoefs, newbreaks, a= -inf, b=inf)
|
||||
else:
|
||||
self.coeffs = newcoefs
|
||||
self.breaks = newbreaks
|
||||
self.a = -inf
|
||||
self.b = inf
|
||||
|
||||
def derivative(self):
|
||||
"""
|
||||
Return first derivative of the piecewise polynomial
|
||||
"""
|
||||
|
||||
cof = pl.polyder(self.coeffs)
|
||||
brks = self.breaks.copy()
|
||||
return PPform(cof, brks, fill=self.fill)
|
||||
|
||||
|
||||
def integrate(self):
|
||||
"""
|
||||
Return the indefinite integral of the piecewise polynomial
|
||||
"""
|
||||
cof = pl.polyint(self.coeffs)
|
||||
|
||||
pieces = len(self.breaks) - 1
|
||||
if 1 < pieces :
|
||||
# evaluate each integrated polynomial at the right endpoint of its interval
|
||||
xs = diff(self.breaks[:-1, ...], axis=0)
|
||||
index = np.arange(pieces - 1)
|
||||
|
||||
vv = xs * cof[0, index]
|
||||
k = self.order
|
||||
for i in xrange(1, k):
|
||||
vv = xs * (vv + cof[i, index])
|
||||
|
||||
cof[-1] = np.hstack((0, vv)).cumsum()
|
||||
|
||||
return PPform(cof, self.breaks, fill=self.fill)
|
||||
|
||||
|
||||
|
||||
## def fromspline(cls, xk, cvals, order, fill=0.0):
|
||||
## N = len(xk)-1
|
||||
## sivals = np.empty((order+1,N), dtype=float)
|
||||
## for m in xrange(order,-1,-1):
|
||||
## fact = spec.gamma(m+1)
|
||||
## res = _fitpack._bspleval(xk[:-1], xk, cvals, order, m)
|
||||
## res /= fact
|
||||
## sivals[order-m,:] = res
|
||||
## return cls(sivals, xk, fill=fill)
|
||||
|
||||
class SmoothSpline(PPform):
|
||||
"""
|
||||
Cubic Smoothing Spline.
|
||||
|
||||
Parameters
|
||||
----------
|
||||
x : array-like
|
||||
x-coordinates of data. (vector)
|
||||
y : array-like
|
||||
y-coordinates of data. (vector or matrix)
|
||||
p : real scalar
|
||||
smoothing parameter between 0 and 1:
|
||||
0 -> LS-straight line
|
||||
1 -> cubic spline interpolant
|
||||
lin_extrap : bool
|
||||
if False regular smoothing spline
|
||||
if True a smoothing spline with a constraint on the ends to
|
||||
ensure linear extrapolation outside the range of the data (default)
|
||||
var : array-like
|
||||
variance of each y(i) (default 1)
|
||||
|
||||
Returns
|
||||
-------
|
||||
pp : ppform
|
||||
If xx is not given, return self-form of the spline.
|
||||
|
||||
Given the approximate values
|
||||
|
||||
y(i) = g(x(i))+e(i)
|
||||
|
||||
of some smooth function, g, where e(i) is the error. SMOOTH tries to
|
||||
recover g from y by constructing a function, f, which minimizes
|
||||
|
||||
p * sum (Y(i) - f(X(i)))^2/d2(i) + (1-p) * int (f'')^2
|
||||
|
||||
|
||||
Example
|
||||
-------
|
||||
>>> import numpy as np
|
||||
>>> x = np.linspace(0,1)
|
||||
>>> y = exp(x)+1e-1*np.random.randn(x.shape)
|
||||
>>> pp9 = SmoothSpline(x, y, p=.9)
|
||||
>>> pp99 = SmoothSpline(x, y, p=.99, var=0.01)
|
||||
>>> plot(x,y, x,pp99(x),'g', x,pp9(x),'k', x,exp(x),'r')
|
||||
|
||||
See also
|
||||
--------
|
||||
lc2tr, dat2tr
|
||||
|
||||
|
||||
References
|
||||
----------
|
||||
Carl de Boor (1978)
|
||||
'Practical Guide to Splines'
|
||||
Springer Verlag
|
||||
Uses EqXIV.6--9, self 239
|
||||
"""
|
||||
def __init__(self, xx, yy, p=None, lin_extrap=True, var=1):
|
||||
coefs, brks = self._compute_coefs(xx, yy, p, var)
|
||||
super(SmoothSpline, self).__init__(coefs, brks)
|
||||
if lin_extrap:
|
||||
self.linear_extrapolate(output=False)
|
||||
|
||||
def _compute_coefs(self, xx, yy, p=None, var=1):
|
||||
x, y = np.atleast_1d(xx, yy)
|
||||
x = x.ravel()
|
||||
dx = np.diff(x)
|
||||
must_sort = (dx < 0).any()
|
||||
if must_sort:
|
||||
ind = x.argsort()
|
||||
x = x[ind]
|
||||
y = y[..., ind]
|
||||
dx = np.diff(x)
|
||||
|
||||
n = len(x)
|
||||
|
||||
#ndy = y.ndim
|
||||
szy = y.shape
|
||||
|
||||
nd = prod(szy[:-1])
|
||||
ny = szy[-1]
|
||||
|
||||
if n < 2:
|
||||
raise ValueError('There must be >=2 data points.')
|
||||
elif (dx <= 0).any():
|
||||
raise ValueError('Two consecutive values in x can not be equal.')
|
||||
elif n != ny:
|
||||
raise ValueError('x and y must have the same length.')
|
||||
|
||||
dydx = np.diff(y) / dx
|
||||
|
||||
if (n == 2) : #% straight line
|
||||
coefs = np.vstack([dydx.ravel(), y[0, :]])
|
||||
else:
|
||||
|
||||
dx1 = 1. / dx
|
||||
D = sp.spdiags(var * ones(n), 0, n, n) # The variance
|
||||
|
||||
u, p = self._compute_u(p, D, dydx, dx, dx1, n)
|
||||
dx1.shape = (n - 1, -1)
|
||||
dx.shape = (n - 1, -1)
|
||||
zrs = zeros(nd)
|
||||
if p < 1:
|
||||
ai = (y - (6 * (1 - p) * D * diff(vstack([zrs,
|
||||
diff(vstack([zrs, u, zrs]), axis=0) * dx1,
|
||||
zrs]), axis=0)).T).T #faster than yi-6*(1-p)*Q*u
|
||||
else:
|
||||
ai = y.reshape(n, -1)
|
||||
|
||||
# The piecewise polynominals are written as
|
||||
# fi=ai+bi*(x-xi)+ci*(x-xi)^2+di*(x-xi)^3
|
||||
# where the derivatives in the knots according to Carl de Boor are:
|
||||
# ddfi = 6*p*[0;u] = 2*ci;
|
||||
# dddfi = 2*diff([ci;0])./dx = 6*di;
|
||||
# dfi = diff(ai)./dx-(ci+di.*dx).*dx = bi;
|
||||
|
||||
ci = np.vstack([zrs, 3 * p * u])
|
||||
di = (diff(vstack([ci, zrs]), axis=0) * dx1 / 3);
|
||||
bi = (diff(ai, axis=0) * dx1 - (ci + di * dx) * dx)
|
||||
ai = ai[:n - 1, ...]
|
||||
if nd > 1:
|
||||
di = di.T
|
||||
ci = ci.T
|
||||
ai = ai.T
|
||||
#end
|
||||
if not any(di):
|
||||
if not any(ci):
|
||||
coefs = vstack([bi.ravel(), ai.ravel()])
|
||||
else:
|
||||
coefs = vstack([ci.ravel(), bi.ravel(), ai.ravel()])
|
||||
#end
|
||||
else:
|
||||
coefs = vstack([di.ravel(), ci.ravel(), bi.ravel(), ai.ravel()])
|
||||
|
||||
return coefs, x
|
||||
|
||||
def _compute_u(self, p, D, dydx, dx, dx1, n):
|
||||
if p is None or p != 0:
|
||||
data = [dx[1:n - 1], 2 * (dx[:n - 2] + dx[1:n - 1]), dx[:n - 2]]
|
||||
R = sp.spdiags(data, [-1, 0, 1], n - 2, n - 2)
|
||||
|
||||
if p is None or p < 1:
|
||||
Q = sp.spdiags([dx1[:n - 2], -(dx1[:n - 2] + dx1[1:n - 1]), dx1[1:n - 1]], [0, -1, -2], n, n - 2)
|
||||
QDQ = (Q.T * D * Q)
|
||||
if p is None or p < 0:
|
||||
# Estimate p
|
||||
p = 1. / (1. + QDQ.diagonal().sum() / (100. * R.diagonal().sum()** 2));
|
||||
|
||||
if p == 0:
|
||||
QQ = 6 * QDQ
|
||||
else:
|
||||
QQ = (6 * (1 - p)) * (QDQ) + p * R
|
||||
else:
|
||||
QQ = R
|
||||
|
||||
# Make sure it uses symmetric matrix solver
|
||||
ddydx = diff(dydx, axis=0)
|
||||
sp.linalg.use_solver(useUmfpack=True)
|
||||
u = 2 * sp.linalg.spsolve((QQ + QQ.T), ddydx)
|
||||
#faster than u=QQ\(Q' * yi);
|
||||
return u.reshape(n - 2, -1), p
|
||||
|
||||
|
||||
def test_smoothing_spline():
|
||||
x = linspace(0, 2 * pi + pi / 4, 20)
|
||||
y = sin(x) #+ np.random.randn(x.size)
|
||||
pp = SmoothSpline(x, y, p=1)
|
||||
x1 = linspace(-1, 2 * pi + pi / 4 + 1, 20)
|
||||
y1 = pp(x1)
|
||||
pp1 = pp.derivative()
|
||||
pp0 = pp1.integrate()
|
||||
dy1 = pp1(x1)
|
||||
y01 = pp0(x1)
|
||||
#dy = y-y1
|
||||
import pylab as plb
|
||||
|
||||
plb.plot(x, y, x1, y1, '.', x1, dy1, 'ro', x1, y01, 'r-')
|
||||
plb.show()
|
||||
pass
|
||||
#tck = interpolate.splrep(x, y, s=len(x))
|
||||
|
||||
def main():
|
||||
from scipy import interpolate
|
||||
import matplotlib.pyplot as plt
|
||||
import matplotlib
|
||||
matplotlib.interactive(True)
|
||||
|
||||
coef = np.array([[1, 1], [0, 1]]) # linear from 0 to 2
|
||||
#coef = np.array([[1,1],[1,1],[0,2]]) # linear from 0 to 2
|
||||
breaks = [0, 1, 2]
|
||||
pp = PPform(coef, breaks, a= -100, b=100)
|
||||
x = linspace(-1, 3, 20)
|
||||
y = pp(x)
|
||||
|
||||
x = linspace(0, 2 * pi + pi / 4, 20)
|
||||
y = x + np.random.randn(x.size)
|
||||
tck = interpolate.splrep(x, y, s=len(x))
|
||||
xnew = linspace(0, 2 * pi, 100)
|
||||
ynew = interpolate.splev(xnew, tck, der=0)
|
||||
tck0 = interpolate.splmake(xnew, ynew, order=3, kind='smoothest', conds=None)
|
||||
pp = interpolate.ppform.fromspline(*tck0)
|
||||
|
||||
plt.plot(x, y, "x", xnew, ynew, xnew, sin(xnew), x, y, "b")
|
||||
plt.legend(['Linear', 'Cubic Spline', 'True'])
|
||||
plt.title('Cubic-spline interpolation')
|
||||
|
||||
|
||||
t = np.arange(0, 1.1, .1)
|
||||
x = np.sin(2 * np.pi * t)
|
||||
y = np.cos(2 * np.pi * t)
|
||||
tck1, u = interpolate.splprep([t, y], s=0)
|
||||
tck2 = interpolate.splrep(t, y, s=len(t), task=0)
|
||||
#interpolate.spl
|
||||
tck = interpolate.splmake(t, y, order=3, kind='smoothest', conds=None)
|
||||
self = interpolate.ppform.fromspline(*tck2)
|
||||
plt.plot(t, self(t))
|
||||
pass
|
||||
|
||||
def test_pp():
|
||||
import polynomial as pl
|
||||
coef = np.array([[1, 1], [0, 0]]) # linear from 0 to 2
|
||||
|
||||
coef = np.array([[1, 1], [1, 1], [0, 2]]) # quadratic from 0 to 1 and 1 to 2.
|
||||
dc = pl.polyder(coef, 1)
|
||||
c2 = pl.polyint(dc, 1)
|
||||
breaks = [0, 1, 2]
|
||||
pp = PPform(coef, breaks)
|
||||
pp(0.5)
|
||||
pp(1)
|
||||
pp(1.5)
|
||||
dpp = pp.derivative()
|
||||
import pylab as plb
|
||||
x = plb.linspace(-1, 3)
|
||||
plb.plot(x, pp(x), x, dpp(x), '.')
|
||||
plb.show()
|
||||
|
||||
if __name__ == '__main__':
|
||||
#main()
|
||||
test_smoothing_spline()
|
||||
@ -0,0 +1,609 @@
|
||||
#-------------------------------------------------------------------------------
|
||||
# Name: kdetools
|
||||
# Purpose:
|
||||
#
|
||||
# Author: pab
|
||||
#
|
||||
# Created: 01.11.2008
|
||||
# Copyright: (c) pab2 2008
|
||||
# Licence: LGPL
|
||||
#-------------------------------------------------------------------------------
|
||||
#!/usr/bin/env python
|
||||
#import numpy as np
|
||||
from scipy.special import gamma
|
||||
from numpy import pi, atleast_2d #@UnresolvedImport
|
||||
from misc import tranproc, trangood
|
||||
def sphere_volume(d, r=1.0):
|
||||
"""
|
||||
Returns volume of d-dimensional sphere with radius r
|
||||
|
||||
Parameters
|
||||
----------
|
||||
d : scalar or array_like
|
||||
dimension of sphere
|
||||
r : scalar or array_like
|
||||
radius of sphere (default 1)
|
||||
|
||||
Reference
|
||||
---------
|
||||
Wand,M.P. and Jones, M.C. (1995)
|
||||
'Kernel smoothing'
|
||||
Chapman and Hall, pp 105
|
||||
"""
|
||||
return (r**d)* 2.*pi**(d/2.)/(d*gamma(d/2.))
|
||||
|
||||
|
||||
class kde(object):
|
||||
""" Representation of a kernel-density estimate using Gaussian kernels.
|
||||
|
||||
Parameters
|
||||
----------
|
||||
dataset : (# of dims, # of data)-array
|
||||
datapoints to estimate from
|
||||
|
||||
Members
|
||||
-------
|
||||
d : int
|
||||
number of dimensions
|
||||
n : int
|
||||
number of datapoints
|
||||
|
||||
Methods
|
||||
-------
|
||||
kde.evaluate(points) : array
|
||||
evaluate the estimated pdf on a provided set of points
|
||||
kde(points) : array
|
||||
same as kde.evaluate(points)
|
||||
kde.integrate_gaussian(mean, cov) : float
|
||||
multiply pdf with a specified Gaussian and integrate over the whole domain
|
||||
kde.integrate_box_1d(low, high) : float
|
||||
integrate pdf (1D only) between two bounds
|
||||
kde.integrate_box(low_bounds, high_bounds) : float
|
||||
integrate pdf over a rectangular space between low_bounds and high_bounds
|
||||
kde.integrate_kde(other_kde) : float
|
||||
integrate two kernel density estimates multiplied together
|
||||
|
||||
Internal Methods
|
||||
----------------
|
||||
kde.covariance_factor() : float
|
||||
computes the coefficient that multiplies the data covariance matrix to
|
||||
obtain the kernel covariance matrix. Set this method to
|
||||
kde.scotts_factor or kde.silverman_factor (or subclass to provide your
|
||||
own). The default is scotts_factor.
|
||||
"""
|
||||
|
||||
def __init__(self, dataset,**kwds):
|
||||
self.kernel='gauss'
|
||||
self.hs = None
|
||||
self.hsmethod=None
|
||||
self.L2 = None
|
||||
self.__dict__.update(kwds)
|
||||
|
||||
self.dataset = atleast_2d(dataset)
|
||||
self.d, self.n = self.dataset.shape
|
||||
|
||||
|
||||
self._compute_covariance()
|
||||
|
||||
|
||||
def evaluate(self, points):
|
||||
"""Evaluate the estimated pdf on a set of points.
|
||||
|
||||
Parameters
|
||||
----------
|
||||
points : (# of dimensions, # of points)-array
|
||||
Alternatively, a (# of dimensions,) vector can be passed in and
|
||||
treated as a single point.
|
||||
|
||||
Returns
|
||||
-------
|
||||
values : (# of points,)-array
|
||||
The values at each point.
|
||||
|
||||
Raises
|
||||
------
|
||||
ValueError if the dimensionality of the input points is different than
|
||||
the dimensionality of the KDE.
|
||||
"""
|
||||
|
||||
points = atleast_2d(points).astype(self.dataset.dtype)
|
||||
|
||||
d, m = points.shape
|
||||
if d != self.d:
|
||||
if d == 1 and m == self.d:
|
||||
# points was passed in as a row vector
|
||||
points = reshape(points, (self.d, 1))
|
||||
m = 1
|
||||
else:
|
||||
msg = "points have dimension %s, dataset has dimension %s" % (d,
|
||||
self.d)
|
||||
raise ValueError(msg)
|
||||
|
||||
result = zeros((m,), points.dtype)
|
||||
|
||||
if m >= self.n:
|
||||
# there are more points than data, so loop over data
|
||||
for i in range(self.n):
|
||||
diff = self.dataset[:,i,newaxis] - points
|
||||
tdiff = dot(self.inv_cov, diff)
|
||||
energy = sum(diff*tdiff,axis=0)/2.0
|
||||
result += exp(-energy)
|
||||
else:
|
||||
# loop over points
|
||||
for i in range(m):
|
||||
diff = self.dataset - points[:,i,newaxis]
|
||||
tdiff = dot(self.inv_cov, diff)
|
||||
energy = sum(diff*tdiff,axis=0)/2.0
|
||||
result[i] = sum(exp(-energy),axis=0)
|
||||
|
||||
result /= self._norm_factor
|
||||
|
||||
return result
|
||||
|
||||
__call__ = evaluate
|
||||
|
||||
##function [f, hs,lambda]= kdefun(A,options,varargin)
|
||||
##%KDEFUN Kernel Density Estimator.
|
||||
##%
|
||||
##% CALL: [f, hs] = kdefun(data,options,x1,x2,...,xd)
|
||||
##%
|
||||
##% f = kernel density estimate evaluated at x1,x2,...,xd.
|
||||
##% data = data matrix, size N x D (D = # dimensions)
|
||||
##% options = kdeoptions-structure or cellvector of named parameters with
|
||||
##% corresponding values, see kdeoptset for details.
|
||||
##% x1,x2..= vectors/matrices defining the points to evaluate the density
|
||||
##%
|
||||
##% KDEFUN gives a slow, but exact kernel density estimate evaluated at x1,x2,...,xd.
|
||||
##% Notice that densities close to normality appear to be the easiest for the kernel
|
||||
##% estimator to estimate and that the degree of estimation difficulty increases with
|
||||
##% skewness, kurtosis and multimodality.
|
||||
##%
|
||||
##% If D > 1 KDE calculates quantile levels by integration. An
|
||||
##% alternative is to calculate them by ranking the kernel density
|
||||
##% estimate obtained at the points DATA i.e. use the commands
|
||||
##%
|
||||
##% f = kde(data);
|
||||
##% r = kdefun(data,[],num2cell(data,1));
|
||||
##% f.cl = qlevels2(r,f.PL);
|
||||
##%
|
||||
##% The first is probably best when estimating the pdf and the latter is the
|
||||
##% easiest and most robust for multidimensional data when only a visualization
|
||||
##% of the data is needed.
|
||||
##%
|
||||
##% For faster estimates try kdebin.
|
||||
##%
|
||||
##% Examples:
|
||||
##% data = rndray(1,500,1);
|
||||
##% x = linspace(sqrt(eps),5,55);
|
||||
##% plotnorm((data).^(.5)) % gives a straight line => L2 = 0.5 reasonable
|
||||
##% f = kdefun(data,{'L2',.5},x);
|
||||
##% plot(x,f,x,pdfray(x,1),'r')
|
||||
##%
|
||||
##% See also kde, mkernel, kdebin
|
||||
##
|
||||
##% Reference:
|
||||
##% B. W. Silverman (1986)
|
||||
##% 'Density estimation for statistics and data analysis'
|
||||
##% Chapman and Hall , pp 100-110
|
||||
##%
|
||||
##% Wand, M.P. and Jones, M.C. (1995)
|
||||
##% 'Kernel smoothing'
|
||||
##% Chapman and Hall, pp 43--45
|
||||
##
|
||||
##
|
||||
##
|
||||
##
|
||||
##%Tested on: matlab 5.2
|
||||
##% History:
|
||||
##% revised pab Feb2004
|
||||
##% -options moved into a structure
|
||||
##% revised pab Dec2003
|
||||
##% -removed some code
|
||||
##% revised pab 27.04.2001
|
||||
##% - changed call from mkernel to mkernel2 (increased speed by 10%)
|
||||
##% revised pab 01.01.2001
|
||||
##% - added the possibility that L2 is a cellarray of parametric
|
||||
##% or non-parametric transformations (secret option)
|
||||
##% revised pab 14.12.1999
|
||||
##% - fixed a small error in example in help header
|
||||
##% revised pab 28.10.1999
|
||||
##% - added L2
|
||||
##% revised pab 21.10.99
|
||||
##% - added alpha to input arguments
|
||||
##% - made it fully general for d dimensions
|
||||
##% - HS may be a smoothing matrix
|
||||
##% revised pab 21.09.99
|
||||
##% - adapted from kdetools by Christian Beardah
|
||||
##
|
||||
## defaultoptions = kdeoptset;
|
||||
##% If just 'defaults' passed in, return the default options in g
|
||||
##if ((nargin==1) && (nargout <= 1) && isequal(A,'defaults')),
|
||||
## f = defaultoptions;
|
||||
## return
|
||||
##end
|
||||
##error(nargchk(1,inf, nargin))
|
||||
##
|
||||
##[n, d]=size(A); % Find dimensions of A,
|
||||
## % n=number of data points,
|
||||
## % d=dimension of the data.
|
||||
##if (nargin<2 || isempty(options))
|
||||
## options = defaultoptions;
|
||||
##else
|
||||
## switch lower(class(options))
|
||||
## case {'char','struct'},
|
||||
## options = kdeoptset(defaultoptions,options);
|
||||
## case {'cell'}
|
||||
##
|
||||
## options = kdeoptset(defaultoptions,options{:});
|
||||
## otherwise
|
||||
## error('Invalid options')
|
||||
## end
|
||||
##end
|
||||
##kernel = options.kernel;
|
||||
##h = options.hs;
|
||||
##alpha = options.alpha;
|
||||
##L2 = options.L2;
|
||||
##hsMethod = options.hsMethod;
|
||||
##
|
||||
##if isempty(h)
|
||||
## h=zeros(1,d);
|
||||
##end
|
||||
##
|
||||
##L22 = cell(1,d);
|
||||
##k3=[];
|
||||
##if isempty(L2)
|
||||
## L2=ones(1,d); % default no transformation
|
||||
##elseif iscell(L2) % cellarray of non-parametric and parametric transformations
|
||||
## Nl2 = length(L2);
|
||||
## if ~(Nl2==1||Nl2==d), error('Wrong size of L2'), end
|
||||
## [L22{1:d}] = deal(L2{1:min(Nl2,d)});
|
||||
## L2 = ones(1,d); % default no transformation
|
||||
## for ix=1:d,
|
||||
## if length(L22{ix})>1,
|
||||
## k3=[k3 ix]; % Non-parametric transformation
|
||||
## else
|
||||
## L2(ix) = L22{ix}; % Parameter to the Box-Cox transformation
|
||||
## end
|
||||
## end
|
||||
##elseif length(L2)==1
|
||||
## L2=L2(:,ones(1,d));
|
||||
##end
|
||||
##
|
||||
##amin=min(A);
|
||||
##if any((amin(L2~=1)<=0)) ,
|
||||
## error('DATA cannot be negative or zero when L2~=1')
|
||||
##end
|
||||
##
|
||||
##
|
||||
##nv=length(varargin);
|
||||
##if nv<d,
|
||||
## error('some or all of the evaluation points x1,x2,...,xd is missing')
|
||||
##end
|
||||
##
|
||||
##xsiz = size(varargin{1}); % remember size of input
|
||||
##Nx = prod(xsiz);
|
||||
##X = zeros(Nx,d);
|
||||
##for ix=1:min(nv,d),
|
||||
## if (any(varargin{ix}(:)<=0) && (L2(ix)~=1)),
|
||||
## error('xi cannot be negative or zero when L2~=1')
|
||||
## end
|
||||
## X(:,ix)=varargin{ix}(:); % make sure it is a column vector
|
||||
##end
|
||||
##
|
||||
##
|
||||
##%new call
|
||||
##lX = X; %zeros(Nx,d);
|
||||
##lA = A; %zeros(size(A));
|
||||
##
|
||||
##k1 = find(L2==0); % logaritmic transformation
|
||||
##if any(k1)
|
||||
## lA(:,k1)=log(A(:,k1));
|
||||
## lX(:,k1)=log(X(:,k1));
|
||||
##end
|
||||
##k2=find(L2~=0 & L2~=1); % power transformation
|
||||
##if any(k2)
|
||||
## lA(:,k2)=sign(L2(ones(n,1),k2)).*A(:,k2).^L2(ones(n,1),k2);
|
||||
## lX(:,k2)=sign(L2(ones(Nx,1),k2)).*X(:,k2).^L2(ones(Nx,1),k2);
|
||||
##end
|
||||
##% Non-parametric transformation
|
||||
##for ix = k3,
|
||||
## lA(:,ix) = tranproc(A(:,ix),L22{ix});
|
||||
## lX(:,ix) = tranproc(X(:,ix),L22{ix});
|
||||
##end
|
||||
##
|
||||
##
|
||||
##hsiz=size(h);
|
||||
##if (min(hsiz)==1)||(d==1)
|
||||
## if max(hsiz)==1,
|
||||
## h=h*ones(1,d);
|
||||
## else
|
||||
## h=reshape(h,[1,d]); % make sure it has the correct dimension
|
||||
## end;
|
||||
## ind=find(h<=0);
|
||||
## if any(ind) % If no value of h has been specified by the user then
|
||||
## h(ind)=feval(hsMethod,lA(:,ind),kernel); % calculate automatic values.
|
||||
## end
|
||||
## deth = prod(h);
|
||||
##else % fully general smoothing matrix
|
||||
## deth = det(h);
|
||||
## if deth<=0
|
||||
## error('bandwidth matrix h must be positive definit')
|
||||
## end
|
||||
##end
|
||||
##
|
||||
##if alpha>0
|
||||
## Xn = num2cell(lA,1);
|
||||
## opt1 = kdeoptset('kernel',kernel,'hs',h,'alpha',0,'L2',1);
|
||||
## f2 = kdefun(lA,opt1,Xn{:}); % get a pilot estimate by regular KDE (alpha=0)
|
||||
## g = exp(sum(log(f2))/n);
|
||||
##
|
||||
## lambda=(f2(:)/g).^(-alpha);
|
||||
##else
|
||||
## lambda=ones(n,1);
|
||||
##end
|
||||
##
|
||||
##
|
||||
##
|
||||
##
|
||||
##
|
||||
##f=zeros(Nx,1);
|
||||
##if (min(hsiz)==1)||(d==1)
|
||||
## for ix=1:n, % Sum over all data points
|
||||
## Avec=lA(ix,:);
|
||||
## Xnn=(lX-Avec(ones(Nx,1),:))./(h(ones(Nx,1),:) *lambda(ix));
|
||||
## f = f + mkernel2(Xnn,kernel)/lambda(ix)^d;
|
||||
## end
|
||||
##else % fully general
|
||||
## h1=inv(h);
|
||||
## for ix=1:n, % Sum over all data points
|
||||
## Avec=lA(ix,:);
|
||||
## Xnn=(lX-Avec(ones(Nx,1),:))*(h1/lambda(ix));
|
||||
## f = f + mkernel2(Xnn,kernel)/lambda(ix)^d;
|
||||
## end
|
||||
##end
|
||||
##f=f/(n*deth);
|
||||
##
|
||||
##% transforming back
|
||||
##if any(k1), % L2=0 i.e. logaritmic transformation
|
||||
## for ix=k1
|
||||
## f=f./X(:,ix);
|
||||
## end
|
||||
## if any(max(abs(diff(f)))>10)
|
||||
## disp('Warning: Numerical problems may have occured due to the logaritmic')
|
||||
## disp('transformation. Check the KDE for spurious spikes')
|
||||
## end
|
||||
##end
|
||||
##if any(k2) % L2~=0 i.e. power transformation
|
||||
## for ix=k2
|
||||
## f=f.*(X(:,ix).^(L2(ix)-1))*L2(ix)*sign(L2(ix));
|
||||
## end
|
||||
## if any(max(abs(diff(f)))>10)
|
||||
## disp('Warning: Numerical problems may have occured due to the power')
|
||||
## disp('transformation. Check the KDE for spurious spikes')
|
||||
## end
|
||||
##end
|
||||
##if any(k3), % non-parametric transformation
|
||||
## oneC = ones(Nx,1);
|
||||
## for ix=k3
|
||||
## gn = L22{ix};
|
||||
## %Gn = fliplr(L22{ix});
|
||||
## %x0 = tranproc(lX(:,ix),Gn);
|
||||
## if any(isnan(X(:,ix))),
|
||||
## error('The transformation does not have a strictly positive derivative.')
|
||||
## end
|
||||
## hg1 = tranproc([X(:,ix) oneC],gn);
|
||||
## der1 = abs(hg1(:,2)); % dg(X)/dX = 1/(dG(Y)/dY)
|
||||
## % alternative 2
|
||||
## %pp = smooth(Gn(:,1),Gn(:,2),1,[],1);
|
||||
## %dpp = diffpp(pp);
|
||||
## %der1 = 1./abs(ppval(dpp,f.x{ix}));
|
||||
## % Alternative 3
|
||||
## %pp = smooth(gn(:,1),gn(:,2),1,[],1);
|
||||
## %dpp = diffpp(pp);
|
||||
## %%plot(hg1(:,1),der1-abs(ppval(dpp,x0)))
|
||||
## %der1 = abs(ppval(dpp,x0));
|
||||
## if any(der1<=0),
|
||||
## error('The transformation must have a strictly positive derivative')
|
||||
## end
|
||||
## f = f.*der1;
|
||||
## end
|
||||
## if any(max(abs(diff(f)))>10)
|
||||
## disp('Warning: Numerical problems may have occured due to the power')
|
||||
## disp('transformation. Check the KDE for spurious spikes')
|
||||
## end
|
||||
##end
|
||||
##
|
||||
##f=reshape(f,xsiz); % restore original shape
|
||||
##if nargout>1
|
||||
## hs=h;
|
||||
##end
|
||||
##
|
||||
##
|
||||
##
|
||||
##
|
||||
##
|
||||
##
|
||||
##
|
||||
##
|
||||
##
|
||||
##
|
||||
##function [z,c]=mkernel(varargin)
|
||||
##%MKERNEL Multivariate Kernel Function.
|
||||
##%
|
||||
##% CALL: z = mkernel(x1,x2,...,xd,kernel);
|
||||
##% z = mkernel(X,kernel);
|
||||
##%
|
||||
##%
|
||||
##% z = kernel function values evaluated at x1,x2,...,xd
|
||||
##% x1,x2..= input arguments, vectors or matrices with common size
|
||||
##% or
|
||||
##% X = cellarray of vector/matrices with common size
|
||||
##% (i.e. X{1}=x1, X{2}=x2....)
|
||||
##%
|
||||
##% kernel = 'epanechnikov' - Epanechnikov kernel.
|
||||
##% 'epa1' - product of 1D Epanechnikov kernel.
|
||||
##% 'biweight' - Bi-weight kernel.
|
||||
##% 'biw1' - product of 1D Bi-weight kernel.
|
||||
##% 'triweight' - Tri-weight kernel.
|
||||
##% 'triangular' - Triangular kernel.
|
||||
##% 'gaussian' - Gaussian kernel
|
||||
##% 'rectangular' - Rectangular kernel.
|
||||
##% 'laplace' - Laplace kernel.
|
||||
##% 'logistic' - Logistic kernel.
|
||||
##%
|
||||
##% Note that only the first 4 letters of the kernel name is needed.
|
||||
##%
|
||||
##% See also kde, kdefun, kdebin
|
||||
##
|
||||
##% Reference:
|
||||
##% B. W. Silverman (1986)
|
||||
##% 'Density estimation for statistics and data analysis'
|
||||
##% Chapman and Hall, pp. 43, 76
|
||||
##%
|
||||
##% Wand, M. P. and Jones, M. C. (1995)
|
||||
##% 'Density estimation for statistics and data analysis'
|
||||
##% Chapman and Hall, pp 31, 103, 175
|
||||
##
|
||||
##%Tested on: matlab 5.3
|
||||
##% History:
|
||||
##% Revised pab sep2005
|
||||
##% -replaced reference to kdefft with kdebin
|
||||
##% revised pab aug2005
|
||||
##% -Fixed some bugs
|
||||
##% revised pab Dec2003
|
||||
##% removed some old code
|
||||
##% revised pab 27.04.2001
|
||||
##% - removed some old calls
|
||||
##% revised pab 01.01.2001
|
||||
##% - speeded up tri3
|
||||
##% revised pab 01.12.1999
|
||||
##% - added four weight, sphere
|
||||
##% - made comparison smarter => faster execution for d>1
|
||||
##% revised pab 26.10.1999
|
||||
##% fixed normalization fault in epan
|
||||
##% by pab 21.09.99
|
||||
##% added multivariate epan, biweight and triweight
|
||||
##%
|
||||
##% collected all knorm,kepan ... into this file
|
||||
##% adapted from kdetools CB
|
||||
##
|
||||
##d=length(varargin)-1;
|
||||
##kstr=varargin{d+1}; % kernel string
|
||||
##if iscell(varargin{1})
|
||||
## X=varargin{1};
|
||||
## d=numel(X);
|
||||
##else
|
||||
## X=varargin;
|
||||
##end
|
||||
##
|
||||
##switch lower(kstr(1:4))
|
||||
## case {'sphe','epan','biwe','triw','four'}
|
||||
## switch lower(kstr(1:4))
|
||||
## case 'sphe', r=0; %Sphere = rect for 1D
|
||||
## case 'epan', r=1; %Multivariate Epanechnikov kernel.
|
||||
## case 'biwe', r=2; %Multivariate Bi-weight Kernel
|
||||
## case 'triw', r=3; %Multi variate Tri-weight Kernel
|
||||
## case 'four', r=4; %Multi variate Four-weight Kernel
|
||||
## % as r -> infty, b -> infty => kernel -> Gaussian distribution
|
||||
## end
|
||||
## b=1;% radius of the kernel
|
||||
## b2=b^2;
|
||||
## s=X{1}.^2;
|
||||
## k=find(s<=b2);
|
||||
## z=zeros(size(s));
|
||||
## ix=2;
|
||||
## while (any(k) && (ix<=d)),
|
||||
## s(k)=s(k)+X{ix}(k).^2;
|
||||
## k1=(s(k)<=b2);
|
||||
## k=k(k1);
|
||||
## ix=ix+1;
|
||||
## end;
|
||||
## if any(k)
|
||||
## c=2^r*prod(1:r)*vsph(d,b)/prod((d+2):2:(d+2*r)); % normalizing constant
|
||||
## %c=beta(r+1,r+1)*vsph(d,b)*(2^(2*r)); % Wand and Jones pp 31
|
||||
## % the commented c above does note yield the right scaling
|
||||
## % for d>1
|
||||
## z(k)=((1-s(k)/b2).^r)/c;
|
||||
## end
|
||||
##
|
||||
## case 'rect', % 1D product Rectangular Kernel
|
||||
## z=zeros(size(X{1}));
|
||||
## k=find(abs(X{1})<=1);
|
||||
## ix=2;
|
||||
## while (any(k) && (ix<=d)),
|
||||
## k1 =(abs(X{ix}(k))<=1);
|
||||
## k=k(k1);
|
||||
## ix=ix+1;
|
||||
## end
|
||||
## if any(k)
|
||||
## z(k)=(0.5^d);
|
||||
## end
|
||||
## case {'epa1','biw1','triw1','fou1'}
|
||||
## switch lower(kstr(1:4))
|
||||
## %case 'rect', r=0; %rectangular
|
||||
## case 'epa1', r=1; %1D product Epanechnikov kernel.
|
||||
## case 'biw1', r=2; %1D product Bi-weight Kernel
|
||||
## case 'tri1', r=3; %1D product Tri-weight Kernel
|
||||
## case 'fou1', r=4; %1D product Four-weight Kernel
|
||||
## end
|
||||
## b=1;
|
||||
## b2=b^2;
|
||||
## b21=1/b2;
|
||||
## z=zeros(size(X{1}));
|
||||
## k=find(abs(X{1})<=b);
|
||||
## ix=2;
|
||||
## while (any(k) && (ix<=d)),
|
||||
## %for ix=2:d
|
||||
## k1 =(abs(X{ix}(k))<=b);
|
||||
## k = k(k1);
|
||||
## ix=ix+1;
|
||||
## end
|
||||
## if any(k)
|
||||
## c=2^r*prod(1:r)*vsph(1,b)/prod((1+2):2:(1+2*r)); % normalizing constant
|
||||
## z(k) = (1-X{1}(k).^2*b21).^r;
|
||||
## for ix=2:d
|
||||
## z(k)=z(k).*(1-X{ix}(k).^2*b21).^r;
|
||||
## end;
|
||||
## z(k)=z(k)/c^d;
|
||||
## end
|
||||
## case 'tria',% 1D product Triangular Kernel
|
||||
## z=zeros(size(X{1}));
|
||||
## k=find(abs(X{1})<1);
|
||||
## ix=2;
|
||||
## while (any(k) && (ix<=d)),
|
||||
## %for ix=2:d
|
||||
## k1 =(abs(X{ix}(k))<1);
|
||||
## k = k(k1);
|
||||
## ix=ix+1;
|
||||
## end
|
||||
## if any(k)
|
||||
## z(k) = (1-abs(X{1}(k)));
|
||||
## for ix=2:d
|
||||
## z(k)=z(k).*(1-abs(X{ix}(k)));
|
||||
## end
|
||||
## end
|
||||
## case {'norm','gaus'},% multivariate gaussian Density Function.
|
||||
## s=X{1}.^2;
|
||||
## for ix=2:d
|
||||
## s=s+X{ix}.^2;
|
||||
## end;
|
||||
## z=(2*pi)^(-d/2)*exp(-0.5*s);
|
||||
## case 'lapl' % Laplace Kernel
|
||||
## z=0.5*exp(-abs(X{1}));
|
||||
## for ix=2:d
|
||||
## z=z.*0.5*exp(-abs(X{ix}));
|
||||
## end
|
||||
## case 'logi', % Logistic Kernel
|
||||
## z1=exp(X{1});
|
||||
## z=z1./(z1+1).^2;
|
||||
## for ix=2:d
|
||||
## z1=exp(X{ix});
|
||||
## z=z.*z1./(z1+1).^2;
|
||||
## end
|
||||
##
|
||||
## otherwise, error('unknown kernel')
|
||||
## end
|
||||
##
|
||||
##
|
||||
|
||||
|
||||
@ -0,0 +1,132 @@
|
||||
import numpy as np
|
||||
def meshgrid(*xi,**kwargs):
|
||||
"""
|
||||
Return coordinate matrices from one or more coordinate vectors.
|
||||
|
||||
Make N-D coordinate arrays for vectorized evaluations of
|
||||
N-D scalar/vector fields over N-D grids, given
|
||||
one-dimensional coordinate arrays x1, x2,..., xn.
|
||||
|
||||
Parameters
|
||||
----------
|
||||
x1, x2,..., xn : array_like
|
||||
1-D arrays representing the coordinates of a grid.
|
||||
indexing : 'xy' or 'ij' (optional)
|
||||
cartesian ('xy', default) or matrix ('ij') indexing of output
|
||||
sparse : True or False (default) (optional)
|
||||
If True a sparse grid is returned in order to conserve memory.
|
||||
copy : True (default) or False (optional)
|
||||
If False a view into the original arrays are returned in order to
|
||||
conserve memory
|
||||
|
||||
Returns
|
||||
-------
|
||||
X1, X2,..., XN : ndarray
|
||||
For vectors `x1`, `x2`,..., 'xn' with lengths ``Ni=len(xi)`` ,
|
||||
return ``(N1, N2, N3,...Nn)`` shaped arrays if indexing='ij'
|
||||
or ``(N2, N1, N3,...Nn)`` shaped arrays if indexing='xy'
|
||||
with the elements of `xi` repeated to fill the matrix along
|
||||
the first dimension for `x1`, the second for `x2` and so on.
|
||||
|
||||
See Also
|
||||
--------
|
||||
index_tricks.mgrid : Construct a multi-dimensional "meshgrid"
|
||||
using indexing notation.
|
||||
index_tricks.ogrid : Construct an open multi-dimensional "meshgrid"
|
||||
using indexing notation.
|
||||
|
||||
Examples
|
||||
--------
|
||||
>>> x = np.linspace(0,1,3) # coordinates along x axis
|
||||
>>> y = np.linspace(0,1,2) # coordinates along y axis
|
||||
>>> xv, yv = meshgrid(x,y) # extend x and y for a 2D xy grid
|
||||
>>> xv
|
||||
array([[ 0. , 0.5, 1. ],
|
||||
[ 0. , 0.5, 1. ]])
|
||||
>>> yv
|
||||
array([[ 0., 0., 0.],
|
||||
[ 1., 1., 1.]])
|
||||
>>> xv, yv = meshgrid(x,y, sparse=True) # make sparse output arrays
|
||||
>>> xv
|
||||
array([[ 0. , 0.5, 1. ]])
|
||||
>>> yv
|
||||
array([[ 0.],
|
||||
[ 1.]])
|
||||
|
||||
>>> meshgrid(x,y,sparse=True,indexing='ij') # change to matrix indexing
|
||||
[array([[ 0. ],
|
||||
[ 0.5],
|
||||
[ 1. ]]), array([[ 0., 1.]])]
|
||||
>>> meshgrid(x,y,indexing='ij')
|
||||
[array([[ 0. , 0. ],
|
||||
[ 0.5, 0.5],
|
||||
[ 1. , 1. ]]),
|
||||
array([[ 0., 1.],
|
||||
[ 0., 1.],
|
||||
[ 0., 1.]])]
|
||||
|
||||
>>> meshgrid(0,1,5) # just a 3D point
|
||||
[array([[[0]]]), array([[[1]]]), array([[[5]]])]
|
||||
>>> map(np.squeeze,meshgrid(0,1,5)) # just a 3D point
|
||||
[array(0), array(1), array(5)]
|
||||
>>> meshgrid(3)
|
||||
array([3])
|
||||
>>> meshgrid(y) # 1D grid; y is just returned
|
||||
array([ 0., 1.])
|
||||
|
||||
`meshgrid` is very useful to evaluate functions on a grid.
|
||||
|
||||
>>> x = np.arange(-5, 5, 0.1)
|
||||
>>> y = np.arange(-5, 5, 0.1)
|
||||
>>> xx, yy = meshgrid(x, y, sparse=True)
|
||||
>>> z = np.sin(xx**2+yy**2)/(xx**2+yy**2)
|
||||
"""
|
||||
copy = kwargs.get('copy',True)
|
||||
args = np.atleast_1d(*xi)
|
||||
if not isinstance(args, list):
|
||||
if args.size>0:
|
||||
return args.copy() if copy else args
|
||||
else:
|
||||
raise TypeError('meshgrid() take 1 or more arguments (0 given)')
|
||||
|
||||
sparse = kwargs.get('sparse',False)
|
||||
indexing = kwargs.get('indexing','xy') # 'ij'
|
||||
|
||||
|
||||
ndim = len(args)
|
||||
s0 = (1,)*ndim
|
||||
output = [x.reshape(s0[:i]+(-1,)+s0[i+1::]) for i, x in enumerate(args)]
|
||||
|
||||
shape = [x.size for x in output]
|
||||
|
||||
if indexing == 'xy':
|
||||
# switch first and second axis
|
||||
output[0].shape = (1,-1) + (1,)*(ndim-2)
|
||||
output[1].shape = (-1, 1) + (1,)*(ndim-2)
|
||||
shape[0],shape[1] = shape[1],shape[0]
|
||||
|
||||
if sparse:
|
||||
if copy:
|
||||
return [x.copy() for x in output]
|
||||
else:
|
||||
return output
|
||||
else:
|
||||
# Return the full N-D matrix (not only the 1-D vector)
|
||||
if copy:
|
||||
mult_fact = np.ones(shape,dtype=int)
|
||||
return [x*mult_fact for x in output]
|
||||
else:
|
||||
return np.broadcast_arrays(*output)
|
||||
|
||||
|
||||
def ndgrid(*args,**kwargs):
|
||||
"""
|
||||
Same as calling meshgrid with indexing='ij' (see meshgrid for
|
||||
documentation).
|
||||
"""
|
||||
kwargs['indexing'] = 'ij'
|
||||
return meshgrid(*args,**kwargs)
|
||||
|
||||
if __name__=='__main__':
|
||||
import doctest
|
||||
doctest.testmod()
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@ -0,0 +1,39 @@
|
||||
! -*- 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/
|
||||
@ -0,0 +1,129 @@
|
||||
! -*- f90 -*-
|
||||
! Note: the context of this file is case sensitive.
|
||||
|
||||
python module mvn2 ! in
|
||||
interface ! in :mvn2
|
||||
subroutine mvnun(d,n,lower,upper,means,covar,maxpts,abseps,releps,value,inform) ! in :mvn2:mvndst.f
|
||||
integer optional,check(len(lower)>=d),depend(lower) :: d=len(lower)
|
||||
integer optional,check(shape(means,1)==n),depend(means) :: n=shape(means,1)
|
||||
double precision dimension(d) :: lower
|
||||
double precision dimension(d),depend(d) :: upper
|
||||
double precision dimension(d,n),depend(d) :: means
|
||||
double precision dimension(d,d),depend(d,d) :: covar
|
||||
integer :: maxpts
|
||||
double precision :: abseps
|
||||
double precision :: releps
|
||||
double precision :: value
|
||||
integer :: inform
|
||||
end subroutine mvnun
|
||||
subroutine mvndst(n,lower,upper,infin,correl,maxpts,abseps,releps,error,value,inform) ! in :mvn2:mvndst.f
|
||||
integer :: n
|
||||
double precision dimension(*) :: lower
|
||||
double precision dimension(*) :: upper
|
||||
integer dimension(*) :: infin
|
||||
double precision dimension(*) :: correl
|
||||
integer :: maxpts
|
||||
double precision :: abseps
|
||||
double precision :: releps
|
||||
double precision :: error
|
||||
double precision :: value
|
||||
integer :: inform
|
||||
integer :: ivls
|
||||
common /dkblck/ ivls
|
||||
end subroutine mvndst
|
||||
function mvndfn(n,w) ! in :mvn2:mvndst.f
|
||||
integer :: n
|
||||
double precision dimension(*) :: w
|
||||
double precision dimension(*) :: upper
|
||||
integer dimension(*) :: infin
|
||||
integer :: infis
|
||||
double precision :: e
|
||||
double precision dimension(*) :: lower
|
||||
double precision :: d
|
||||
double precision dimension(*) :: correl
|
||||
double precision :: mvndfn
|
||||
double precision :: mvndnt
|
||||
entry mvndnt(n,correl,lower,upper,infin,infis,d,e)
|
||||
end function mvndfn
|
||||
subroutine mvnlms(a,b,infin,lower,upper) ! in :mvn2:mvndst.f
|
||||
double precision :: a
|
||||
double precision :: b
|
||||
integer :: infin
|
||||
double precision :: lower
|
||||
double precision :: upper
|
||||
end subroutine mvnlms
|
||||
subroutine covsrt(n,lower,upper,correl,infin,y,infis,a,b,cov,infi) ! in :mvn2:mvndst.f
|
||||
integer :: n
|
||||
double precision dimension(*) :: lower
|
||||
double precision dimension(*) :: upper
|
||||
double precision dimension(*) :: correl
|
||||
integer dimension(*) :: infin
|
||||
double precision dimension(*) :: y
|
||||
integer :: infis
|
||||
double precision dimension(*) :: a
|
||||
double precision dimension(*) :: b
|
||||
double precision dimension(*) :: cov
|
||||
integer dimension(*) :: infi
|
||||
end subroutine covsrt
|
||||
subroutine dkswap(x,y) ! in :mvn2:mvndst.f
|
||||
double precision :: x
|
||||
double precision :: y
|
||||
end subroutine dkswap
|
||||
subroutine rcswp(p,q,a,b,infin,n,c) ! in :mvn2:mvndst.f
|
||||
integer :: p
|
||||
integer :: q
|
||||
double precision dimension(*) :: a
|
||||
double precision dimension(*) :: b
|
||||
integer dimension(*) :: infin
|
||||
integer :: n
|
||||
double precision dimension(*) :: c
|
||||
end subroutine rcswp
|
||||
subroutine dkbvrc(ndim,minvls,maxvls,functn,abseps,releps,abserr,finest,inform) ! in :mvn2:mvndst.f
|
||||
integer :: ndim
|
||||
integer :: minvls
|
||||
integer :: maxvls
|
||||
external functn
|
||||
double precision :: abseps
|
||||
double precision :: releps
|
||||
double precision :: abserr
|
||||
double precision :: finest
|
||||
integer :: inform
|
||||
end subroutine dkbvrc
|
||||
subroutine dksmrc(ndim,klim,sumkro,prime,vk,functn,x) ! in :mvn2:mvndst.f
|
||||
integer :: ndim
|
||||
integer :: klim
|
||||
double precision :: sumkro
|
||||
integer :: prime
|
||||
double precision dimension(*) :: vk
|
||||
external functn
|
||||
double precision dimension(*) :: x
|
||||
end subroutine dksmrc
|
||||
function mvnphi(z) ! in :mvn2:mvndst.f
|
||||
double precision :: z
|
||||
double precision :: mvnphi
|
||||
end function mvnphi
|
||||
function phinvs(p) ! in :mvn2:mvndst.f
|
||||
double precision :: p
|
||||
double precision :: phinvs
|
||||
end function phinvs
|
||||
function bvnmvn(lower,upper,infin,correl) ! in :mvn2:mvndst.f
|
||||
double precision dimension(*) :: lower
|
||||
double precision dimension(*) :: upper
|
||||
integer dimension(*) :: infin
|
||||
double precision :: correl
|
||||
double precision :: bvnmvn
|
||||
end function bvnmvn
|
||||
function bvu(sh,sk,r) ! in :mvn2:mvndst.f
|
||||
double precision :: sh
|
||||
double precision :: sk
|
||||
double precision :: r
|
||||
double precision :: bvu
|
||||
end function bvu
|
||||
function mvnuni() ! in :mvn2:mvndst.f
|
||||
double precision :: mvnuni
|
||||
end function mvnuni
|
||||
end interface
|
||||
end python module mvn2
|
||||
|
||||
! This file was auto-generated with f2py (version:2_5972).
|
||||
! See http://cens.ioc.ee/projects/f2py2e/
|
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,132 @@
|
||||
from operator import itemgetter as _itemgetter
|
||||
from keyword import iskeyword as _iskeyword
|
||||
import sys as _sys
|
||||
|
||||
def namedtuple(typename, field_names, verbose=False):
|
||||
"""Returns a new subclass of tuple with named fields.
|
||||
|
||||
>>> Point = namedtuple('Point', 'x y')
|
||||
>>> Point.__doc__ # docstring for the new class
|
||||
'Point(x, y)'
|
||||
>>> p = Point(11, y=22) # instantiate with positional args or keywords
|
||||
>>> p[0] + p[1] # indexable like a plain tuple
|
||||
33
|
||||
>>> x, y = p # unpack like a regular tuple
|
||||
>>> x, y
|
||||
(11, 22)
|
||||
>>> p.x + p.y # fields also accessable by name
|
||||
33
|
||||
>>> d = p._asdict() # convert to a dictionary
|
||||
>>> d['x']
|
||||
11
|
||||
>>> Point(**d) # convert from a dictionary
|
||||
Point(x=11, y=22)
|
||||
>>> p._replace(x=100) # _replace() is like str.replace() but targets named fields
|
||||
Point(x=100, y=22)
|
||||
|
||||
"""
|
||||
|
||||
# Parse and validate the field names. Validation serves two purposes,
|
||||
# generating informative error messages and preventing template injection attacks.
|
||||
if isinstance(field_names, basestring):
|
||||
field_names = field_names.replace(',', ' ').split() # names separated by whitespace and/or commas
|
||||
field_names = tuple(field_names)
|
||||
for name in (typename,) + field_names:
|
||||
if not min(c.isalnum() or c=='_' for c in name):
|
||||
raise ValueError('Type names and field names can only contain alphanumeric characters and underscores: %r' % name)
|
||||
if _iskeyword(name):
|
||||
raise ValueError('Type names and field names cannot be a keyword: %r' % name)
|
||||
if name[0].isdigit():
|
||||
raise ValueError('Type names and field names cannot start with a number: %r' % name)
|
||||
seen_names = set()
|
||||
for name in field_names:
|
||||
if name.startswith('_'):
|
||||
raise ValueError('Field names cannot start with an underscore: %r' % name)
|
||||
if name in seen_names:
|
||||
raise ValueError('Encountered duplicate field name: %r' % name)
|
||||
seen_names.add(name)
|
||||
|
||||
# Create and fill-in the class template
|
||||
numfields = len(field_names)
|
||||
argtxt = repr(field_names).replace("'", "")[1:-1] # tuple repr without parens or quotes
|
||||
reprtxt = ', '.join('%s=%%r' % name for name in field_names)
|
||||
dicttxt = ', '.join('%r: t[%d]' % (name, pos) for pos, name in enumerate(field_names))
|
||||
template = '''class %(typename)s(tuple):
|
||||
'%(typename)s(%(argtxt)s)' \n
|
||||
__slots__ = () \n
|
||||
_fields = %(field_names)r \n
|
||||
def __new__(cls, %(argtxt)s):
|
||||
return tuple.__new__(cls, (%(argtxt)s)) \n
|
||||
@classmethod
|
||||
def _make(cls, iterable, new=tuple.__new__, len=len):
|
||||
'Make a new %(typename)s object from a sequence or iterable'
|
||||
result = new(cls, iterable)
|
||||
if len(result) != %(numfields)d:
|
||||
raise TypeError('Expected %(numfields)d arguments, got %%d' %% len(result))
|
||||
return result \n
|
||||
def __repr__(self):
|
||||
return '%(typename)s(%(reprtxt)s)' %% self \n
|
||||
def _asdict(t):
|
||||
'Return a new dict which maps field names to their values'
|
||||
return {%(dicttxt)s} \n
|
||||
def _replace(self, **kwds):
|
||||
'Return a new %(typename)s object replacing specified fields with new values'
|
||||
result = self._make(map(kwds.pop, %(field_names)r, self))
|
||||
if kwds:
|
||||
raise ValueError('Got unexpected field names: %%r' %% kwds.keys())
|
||||
return result \n\n''' % locals()
|
||||
for i, name in enumerate(field_names):
|
||||
template += ' %s = property(itemgetter(%d))\n' % (name, i)
|
||||
if verbose:
|
||||
print template
|
||||
|
||||
# Execute the template string in a temporary namespace
|
||||
namespace = dict(itemgetter=_itemgetter)
|
||||
try:
|
||||
exec template in namespace
|
||||
except SyntaxError, e:
|
||||
raise SyntaxError(e.message + ':\n' + template)
|
||||
result = namespace[typename]
|
||||
|
||||
# For pickling to work, the __module__ variable needs to be set to the frame
|
||||
# where the named tuple is created. Bypass this step in enviroments where
|
||||
# sys._getframe is not defined (Jython for example).
|
||||
if hasattr(_sys, '_getframe'):
|
||||
result.__module__ = _sys._getframe(1).f_globals['__name__']
|
||||
|
||||
return result
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
# verify that instances can be pickled
|
||||
from cPickle import loads, dumps
|
||||
Point = namedtuple('Point', 'x, y', True)
|
||||
p = Point(x=10, y=20)
|
||||
assert p == loads(dumps(p))
|
||||
|
||||
# test and demonstrate ability to override methods
|
||||
class Point(namedtuple('Point', 'x y')):
|
||||
@property
|
||||
def hypot(self):
|
||||
return (self.x ** 2 + self.y ** 2) ** 0.5
|
||||
def __str__(self):
|
||||
return 'Point: x=%6.3f y=%6.3f hypot=%6.3f' % (self.x, self.y, self.hypot)
|
||||
|
||||
for p in Point(3,4), Point(14,5), Point(9./7,6):
|
||||
print p
|
||||
|
||||
class Point(namedtuple('Point', 'x y')):
|
||||
'Point class with optimized _make() and _replace() without error-checking'
|
||||
_make = classmethod(tuple.__new__)
|
||||
def _replace(self, _map=map, **kwds):
|
||||
return self._make(_map(kwds.get, ('x', 'y'), self))
|
||||
|
||||
print Point(11, 22)._replace(x=100)
|
||||
|
||||
import doctest
|
||||
TestResults = namedtuple('TestResults', 'failed attempted')
|
||||
print TestResults(*doctest.testmod())
|
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,18 @@
|
||||
"""
|
||||
Modify this file if another plotbackend is wanted.
|
||||
"""
|
||||
|
||||
if False:
|
||||
try:
|
||||
from scitools import easyviz as plotbackend
|
||||
print('wafo.wafodata: plotbackend is set to scitools.easyviz')
|
||||
except:
|
||||
print('wafo: Unable to load scitools.easyviz as plotbackend')
|
||||
plotbackend = None
|
||||
else:
|
||||
try:
|
||||
from matplotlib import pyplot as plotbackend
|
||||
print('wafo.wafodata: plotbackend is set to matplotlib.pyplot')
|
||||
except:
|
||||
print('wafo: Unable to load matplotlib.pyplot as plotbackend')
|
||||
plotbackend = None
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,14 @@
|
||||
! File rfcmodule.pyf
|
||||
python module rfcmodule
|
||||
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(y) :: n=len(y)
|
||||
double precision dimension(n), intent(in) :: y1 ! input array
|
||||
double precision intent(in) :: hmin
|
||||
integer dimension(n), intent(out) :: ind ! output array,
|
||||
integer intent(out) :: info
|
||||
end subroutine findrfc
|
||||
end interface
|
||||
end python module rfcmodule
|
||||
Binary file not shown.
@ -0,0 +1,84 @@
|
||||
#from math import *
|
||||
from numpy import zeros, convolve, dot, linalg, size #@UnresolvedImport
|
||||
|
||||
all = ['calc_coeff','smooth']
|
||||
|
||||
def _resub(D, rhs):
|
||||
""" solves D D^T = rhs by resubstituion.
|
||||
D is lower triangle-matrix from cholesky-decomposition """
|
||||
|
||||
M = D.shape[0]
|
||||
x1= zeros((M,),float)
|
||||
x2= zeros((M,),float)
|
||||
|
||||
# resub step 1
|
||||
for l in range(M):
|
||||
sum = rhs[l]
|
||||
for n in range(l):
|
||||
sum -= D[l,n]*x1[n]
|
||||
x1[l] = sum/D[l,l]
|
||||
|
||||
# resub step 2
|
||||
for l in range(M-1,-1,-1):
|
||||
sum = x1[l]
|
||||
for n in range(l+1,M):
|
||||
sum -= D[n,l]*x2[n]
|
||||
x2[l] = sum/D[l,l]
|
||||
|
||||
return x2
|
||||
|
||||
|
||||
def calc_coeff(num_points, pol_degree, diff_order=0):
|
||||
|
||||
"""
|
||||
Calculates filter coefficients for symmetric savitzky-golay filter.
|
||||
see: http://www.nrbook.com/a/bookcpdf/c14-8.pdf
|
||||
|
||||
Parameters
|
||||
----------
|
||||
num_points : scalar, integer
|
||||
means that 2*num_points+1 values contribute to the smoother.
|
||||
pol_degree : scalar, integer
|
||||
is degree of fitting polynomial
|
||||
diff_order : scalar, integer
|
||||
is degree of implicit differentiation.
|
||||
0 means that filter results in smoothing of function
|
||||
1 means that filter results in smoothing the first
|
||||
derivative of function.
|
||||
and so on ...
|
||||
|
||||
"""
|
||||
|
||||
# setup normal matrix
|
||||
A = zeros((2*num_points+1, pol_degree+1), float)
|
||||
for i in range(2*num_points+1):
|
||||
for j in range(pol_degree+1):
|
||||
A[i,j] = pow(i-num_points, j)
|
||||
|
||||
# calculate diff_order-th row of inv(A^T A)
|
||||
ATA = dot(A.transpose(), A)
|
||||
rhs = zeros((pol_degree+1,), float)
|
||||
rhs[diff_order] = 1
|
||||
D = linalg.cholesky(ATA)
|
||||
wvec = _resub(D, rhs)
|
||||
|
||||
# calculate filter-coefficients
|
||||
coeff = zeros((2*num_points+1,), float)
|
||||
for n in range(-num_points, num_points+1):
|
||||
x = 0.0
|
||||
for m in range(pol_degree+1):
|
||||
x += wvec[m]*pow(n, m)
|
||||
coeff[n+num_points] = x
|
||||
return coeff
|
||||
|
||||
def smooth(signal, coeff):
|
||||
"""
|
||||
applies coefficients calculated by calc_coeff()
|
||||
to signal
|
||||
"""
|
||||
|
||||
N = size(coeff-1)/2
|
||||
res = convolve(signal, coeff)
|
||||
return res[N:-N]
|
||||
|
||||
|
||||
@ -0,0 +1,19 @@
|
||||
"""
|
||||
f2py c_library.pyf c_functions.c -c
|
||||
"""
|
||||
import os
|
||||
|
||||
def compile_all():
|
||||
# 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()
|
||||
@ -0,0 +1,615 @@
|
||||
#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; /* 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; /* 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;
|
||||
}
|
||||
|
||||
Binary file not shown.
@ -0,0 +1,45 @@
|
||||
! 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
|
||||
end interface
|
||||
end python module c_library
|
||||
@ -0,0 +1,16 @@
|
||||
import os
|
||||
|
||||
def compile_all():
|
||||
# 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 = ('rfc.pyf','diffsumfunq.pyf')
|
||||
files =('findrfc.c','disufq1.c')
|
||||
|
||||
for pyf,file in zip(pyfs,files):
|
||||
os.system(compile_format % (pyf,file))
|
||||
|
||||
if __name__=='__main__':
|
||||
compile_all()
|
||||
Binary file not shown.
@ -0,0 +1,30 @@
|
||||
! File diffsumfunq.pyf
|
||||
python module diffsumfunq
|
||||
interface
|
||||
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 disufq
|
||||
|
||||
end interface
|
||||
end python module diffsumfunq
|
||||
@ -0,0 +1,30 @@
|
||||
! File diffsumfunq.pyf
|
||||
python module diffsumfunq
|
||||
interface
|
||||
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==shape(iA,0)) :: n=shape(rA,0)
|
||||
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), 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==shape(iA,0)) :: n=shape(rA,0)
|
||||
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), 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 disufq
|
||||
|
||||
end interface
|
||||
end python module diffsumfunq
|
||||
@ -0,0 +1,446 @@
|
||||
#include "math.h"
|
||||
/*
|
||||
* 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;
|
||||
}
|
||||
@ -0,0 +1,53 @@
|
||||
|
||||
|
||||
/*
|
||||
* 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, double *ind, int n, int info)
|
||||
{ int i,start, ix=0,dcross=0;
|
||||
|
||||
if ( *(y +0)< v){
|
||||
dcross=-1; /* first is a up-crossing*/
|
||||
}
|
||||
if ( *(y +0)> v){
|
||||
dcross=1; /* first is a down-crossing*/
|
||||
}
|
||||
start=0;
|
||||
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; /* first crossing is a down crossing*/
|
||||
ix++;
|
||||
dcross=-1; /* The next crossing is a up-crossing*/
|
||||
break;
|
||||
}
|
||||
if ( *(y +i)> v){
|
||||
*(ind + ix) = i; /* first crossing is a up-crossing*/
|
||||
ix++;
|
||||
dcross=1; /*The next crossing is a down-crossing*/
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
for (i=start; i<n-1; i++) {
|
||||
if (( (dcross==-1) && (*(y +i)<=h) && (*(y+i+1) > h) ) || ((dcross==1 ) && (*(y +i)>=h) && (*(y+i+1) < h) ) ) {
|
||||
|
||||
*(ind + ix) = i+1 ;
|
||||
ix++;
|
||||
dcross=-dcross;
|
||||
}
|
||||
}
|
||||
info = ix
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
@ -0,0 +1,118 @@
|
||||
#include "math.h"
|
||||
/*
|
||||
* findrfc.c -
|
||||
*
|
||||
* Returns indices to RFC turningpoints of a vector
|
||||
* of turningpoints
|
||||
*
|
||||
* Install gfortran and run the following to build the module:
|
||||
* f2py rfc.pyf findrfc.c -c --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71
|
||||
*
|
||||
* 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;
|
||||
|
||||
if (*(y1+0)> *(y1+1)){
|
||||
/* if first is a max , ignore the first max*/
|
||||
y=&(*(y1+1));
|
||||
NC=floor((n-1)/2);
|
||||
Tstart=2;
|
||||
}
|
||||
else {
|
||||
y=y1;
|
||||
NC=floor(n/2);
|
||||
Tstart=1;
|
||||
}
|
||||
|
||||
if (NC<1){
|
||||
info = 0;
|
||||
return; /* No RFC cycles*/
|
||||
}
|
||||
|
||||
|
||||
if (( *(y+0) > *(y+1)) && ( *(y+1) > *(y+2)) ){
|
||||
info = -1;
|
||||
return; /*This is not a sequence of turningpoints, exit */
|
||||
}
|
||||
if ((*(y+0) < *(y+1)) && (*(y+1)< *(y+2))){
|
||||
info=-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 = ix;
|
||||
return ;
|
||||
}
|
||||
|
||||
|
||||
|
||||
Binary file not shown.
@ -0,0 +1,14 @@
|
||||
! File rfc.pyf
|
||||
python module rfc
|
||||
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 intent(out) :: info
|
||||
end subroutine findrfc
|
||||
end interface
|
||||
end python module rfc
|
||||
@ -0,0 +1,450 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,356 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,504 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,497 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,445 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,357 @@
|
||||
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
|
||||
|
||||
@ -0,0 +1,769 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,498 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,440 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,569 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,632 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,505 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,35 @@
|
||||
"""
|
||||
f2py c_library.pyf c_functions.c -c
|
||||
|
||||
gfortran -W -Wall -pedantic-errors -fbounds-check -Werror -c dsvdc.f mregmodule.f
|
||||
|
||||
"""
|
||||
import os
|
||||
|
||||
def compile_all():
|
||||
files = ['mregmodule', 'dsvdc']
|
||||
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)
|
||||
#f2py --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71 -m mymod -c mymod.f90
|
||||
|
||||
os.system('f2py -m cov2mod -c %s cov2mmpdfreg_intfc.f --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71' % file_objects)
|
||||
#compile1_txt = 'gfortran -fPIC -c mvnprd.f'
|
||||
#compile2_txt = 'f2py -m mvnprdmod -c mvnprd.o mvnprd_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()
|
||||
@ -0,0 +1,46 @@
|
||||
GFORTRAN module version '0' created from mregmodule.f on Wed Aug 05 19:15:05 2009
|
||||
MD5:9338abc0e14d4bf13175cb874e9f7ea5 -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(() () () () () () () () () () () () () () () () () () () () () () () ()
|
||||
() () ())
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(2 'checkmod' 'checkmod' 'checkmod' 1 ((MODULE UNKNOWN-INTENT
|
||||
UNKNOWN-PROC UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 ()
|
||||
() () 0 0)
|
||||
3 'iii0' 'checkmod' 'iii0' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
4 'iii01' 'checkmod' 'iii01' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
5 'iii101' 'checkmod' 'iii101' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
6 'iii11' 'checkmod' 'iii11' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
7 'iii21' 'checkmod' 'iii21' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
8 'iii31' 'checkmod' 'iii31' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
9 'iii41' 'checkmod' 'iii41' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
10 'iii51' 'checkmod' 'iii51' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
11 'iii61' 'checkmod' 'iii61' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
12 'iii71' 'checkmod' 'iii71' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
13 'iii81' 'checkmod' 'iii81' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
14 'iii91' 'checkmod' 'iii91' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('checkmod' 0 2 'iii0' 0 3 'iii01' 0 4 'iii101' 0 5 'iii11' 0 6 'iii21'
|
||||
0 7 'iii31' 0 8 'iii41' 0 9 'iii51' 0 10 'iii61' 0 11 'iii71' 0 12 'iii81'
|
||||
0 13 'iii91' 0 14)
|
||||
@ -0,0 +1,151 @@
|
||||
GFORTRAN module version '0' created from cov2mmpdfreg_intfc.f on Thu Aug 06 03:39:39 2009
|
||||
MD5:983e75e1f187678a4601b92db2a3f449 -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(() () () () () () () () () () () ()
|
||||
() () () () () () () () () () () () () () ())
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(2 'c_' 'cov2mmpdfmod' 'c_' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN IMPLICIT-SAVE) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
3 'cov2mmpdfmod' 'cov2mmpdfmod' 'cov2mmpdfmod' 1 ((MODULE UNKNOWN-INTENT
|
||||
UNKNOWN-PROC UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 ()
|
||||
() () 0 0)
|
||||
4 'cov2mmpdfreg' 'cov2mmpdfmod' 'cov2mmpdfreg' 1 ((PROCEDURE
|
||||
UNKNOWN-INTENT MODULE-PROC DECL UNKNOWN SUBROUTINE) (UNKNOWN 0 0 0
|
||||
UNKNOWN ()) 5 0 (6 7 8 9 10 11 12 13 14 15 16 17) () 0 () () () 0 0)
|
||||
18 'covg' 'cov2mmpdfmod' 'covg' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC
|
||||
DECL UNKNOWN SUBROUTINE) (UNKNOWN 0 0 0 UNKNOWN ()) 19 0 (20 21 22 23 24
|
||||
25) () 0 () () () 0 0)
|
||||
26 'eps0_' 'cov2mmpdfmod' 'eps0_' 1 ((VARIABLE UNKNOWN-INTENT
|
||||
UNKNOWN-PROC UNKNOWN IMPLICIT-SAVE) (REAL 8 0 0 REAL ()) 0 0 () () 0 ()
|
||||
() () 0 0)
|
||||
27 'eps_' 'cov2mmpdfmod' 'eps_' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN IMPLICIT-SAVE) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
28 'epss_' 'cov2mmpdfmod' 'epss_' 1 ((VARIABLE UNKNOWN-INTENT
|
||||
UNKNOWN-PROC UNKNOWN IMPLICIT-SAVE) (REAL 8 0 0 REAL ()) 0 0 () () 0 ()
|
||||
() () 0 0)
|
||||
29 'iac_' 'cov2mmpdfmod' 'iac_' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN IMPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0
|
||||
0)
|
||||
30 'initinteg' 'cov2mmpdfmod' 'initinteg' 1 ((PROCEDURE UNKNOWN-INTENT
|
||||
MODULE-PROC DECL UNKNOWN SUBROUTINE) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () ()
|
||||
0 () () () 0 0)
|
||||
31 'initlevels' 'cov2mmpdfmod' 'initlevels' 1 ((PROCEDURE UNKNOWN-INTENT
|
||||
MODULE-PROC DECL UNKNOWN SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0
|
||||
UNKNOWN ()) 32 0 (33 34 35 36 37 38) () 0 () () () 0 0)
|
||||
39 'isq_' 'cov2mmpdfmod' 'isq_' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN IMPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0
|
||||
0)
|
||||
40 'sple' 'cov2mmpdfmod' 'sple' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC
|
||||
DECL UNKNOWN FUNCTION ALWAYS_EXPLICIT) (REAL 8 0 0 REAL ()) 41 0 (42 43
|
||||
44 45) () 40 () () () 0 0)
|
||||
46 'transf' 'cov2mmpdfmod' 'transf' 1 ((PROCEDURE UNKNOWN-INTENT
|
||||
MODULE-PROC DECL UNKNOWN SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0
|
||||
UNKNOWN ()) 47 0 (48 49 50 51 52 53) () 0 () () () 0 0)
|
||||
9 'ulev' '' 'ulev' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0
|
||||
14 ())) 0 () () () 0 0)
|
||||
10 'vlev' '' 'vlev' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0
|
||||
15 ())) 0 () () () 0 0)
|
||||
11 'tg' '' 'tg' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0 16 ())) 0 () ()
|
||||
() 0 0)
|
||||
12 'xg' '' 'xg' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0 16 ())) 0 () ()
|
||||
() 0 0)
|
||||
13 'nt' '' 'nt' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
14 'nu' '' 'nu' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
15 'nv' '' 'nv' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
16 'ng' '' 'ng' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
17 'nit' '' 'nit' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
6 'uvdens' '' 'uvdens' 5 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (2 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0
|
||||
14 ()) (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (VARIABLE (INTEGER 4
|
||||
0 0 INTEGER ()) 0 15 ())) 0 () () () 0 0)
|
||||
7 't' '' 't' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0 13 ())) 0 () ()
|
||||
() 0 0)
|
||||
8 'cov' '' 'cov' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (2 EXPLICIT (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0 13 ()) (
|
||||
CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '5')) 0 () () () 0 0)
|
||||
33 't' '' 't' 32 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT (INTEGER 4
|
||||
0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
34 'ht' '' 'ht' 32 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT (INTEGER 4
|
||||
0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
35 'n' '' 'n' 32 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
36 'ng' '' 'ng' 32 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
37 'nu' '' 'nu' 32 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
38 'nv' '' 'nv' 32 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
48 'n' '' 'n' 47 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
49 't' '' 't' 47 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
50 'a' '' 'a' 47 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT (INTEGER 4
|
||||
0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
51 'timev' '' 'timev' 47 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
52 'value' '' 'value' 47 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
53 'der' '' 'der' 47 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
42 'n' '' 'n' 41 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
43 't' '' 't' 41 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
44 'a' '' 'a' 41 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT (INTEGER 4
|
||||
0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
45 'timev' '' 'timev' 41 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
20 'xl0' '' 'xl0' 19 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
21 'xl2' '' 'xl2' 19 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
22 'xl4' '' 'xl4' 19 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
23 'cov' '' 'cov' 19 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (2 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0
|
||||
25 ()) (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4
|
||||
0 0 INTEGER ()) 0 '5')) 0 () () () 0 0)
|
||||
24 't' '' 't' 19 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0 25 ())) 0 () ()
|
||||
() 0 0)
|
||||
25 'n' '' 'n' 19 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('c_' 0 2 'cov2mmpdfmod' 0 3 'cov2mmpdfreg' 0 4 'covg' 0 18 'eps0_' 0 26
|
||||
'eps_' 0 27 'epss_' 0 28 'iac_' 0 29 'initinteg' 0 30 'initlevels' 0 31
|
||||
'isq_' 0 39 'sple' 0 40 'transf' 0 46)
|
||||
@ -0,0 +1,651 @@
|
||||
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
|
||||
|
||||
@ -0,0 +1,559 @@
|
||||
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
|
||||
|
||||
module cov2mmpdfmod
|
||||
IMPLICIT NONE
|
||||
PRIVATE
|
||||
PUBLIC cov2mmpdfreg, EPS_, EPSS_, EPS0_, C_, IAC_, ISQ_
|
||||
DOUBLE PRECISION :: EPS_ = 1.d-2
|
||||
DOUBLE PRECISION :: EPSS_ = 5.d-5
|
||||
! used in GAUSSLE1 to implicitly ! determ. # nodes
|
||||
DOUBLE PRECISION :: EPS0_ = 5.d-5
|
||||
DOUBLE PRECISION :: C_ = 4.5d0
|
||||
INTEGER :: IAC_=1
|
||||
INTEGER :: ISQ_=0
|
||||
|
||||
contains
|
||||
|
||||
subroutine cov2mmpdfreg(UVdens,t,COV,ULev,VLev,Tg,Xg,Nt,Nu,Nv,Ng,
|
||||
! NIT)
|
||||
USE SIZEMOD
|
||||
USE EPSMOD
|
||||
USE CHECKMOD
|
||||
USE MREGMOD
|
||||
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,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,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
|
||||
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.
|
||||
|
||||
c
|
||||
CALL INITLEVELS(T,HHT,Nt,NG,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'
|
||||
stop
|
||||
end if
|
||||
DO IV=1,Nv
|
||||
V=Vlev(IV)
|
||||
CALL TRANSF(NG,V,Xg,Tg,VALUE,DER)
|
||||
VT(IV)=VALUE
|
||||
Vdd(IV)=DER
|
||||
14 continue
|
||||
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
|
||||
16 CONTINUE
|
||||
enddo
|
||||
enddo
|
||||
|
||||
CALL COVG(XL0,XL2,XL4,COV,T,Nt)
|
||||
|
||||
|
||||
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 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
|
||||
|
||||
10 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)
|
||||
15 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))
|
||||
|
||||
30 CONTINUE
|
||||
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))
|
||||
50 CONTINUE
|
||||
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)
|
||||
51 CONTINUE
|
||||
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))
|
||||
|
||||
40 CONTINUE
|
||||
enddo
|
||||
enddo
|
||||
41 CONTINUE
|
||||
END IF
|
||||
|
||||
C Here the covariance of the problem would be innitiated
|
||||
|
||||
INF=0
|
||||
Print *,' Laps to go:',N-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 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
|
||||
|
||||
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
|
||||
|
||||
SUBROUTINE INITLEVELS(T,HT,N,NG,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
|
||||
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
|
||||
|
||||
IF (NG.GT.501) THEN
|
||||
PRINT *,'Vector defining transformation of data > 501, stop'
|
||||
STOP
|
||||
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
|
||||
10 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 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 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 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 FUNCTION SPLE
|
||||
|
||||
|
||||
|
||||
SUBROUTINE COVG(XL0,XL2,XL4,COV,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(N,5), intent(in) :: COV
|
||||
REAL*8, DIMENSION(N), intent(in) :: T
|
||||
INTEGER, intent(in) :: N
|
||||
|
||||
|
||||
C
|
||||
C COV(Y(T),Y(0)) = COV(:,1)
|
||||
C
|
||||
XL0 = COV(1,1)
|
||||
! XL0 = SPLE(NT,ZERO,COV(:,1),T)
|
||||
C
|
||||
C DERIVATIVE COV(Y(T),Y(0)) = COV(:,2)
|
||||
C
|
||||
C 2-DERIVATIVE COV(Y(T),Y(0)) = COV(:,3)
|
||||
XL2 = -COV(1,3)
|
||||
! XL2 = -SPLE(NT,ZERO,COV(:,3),T)
|
||||
C 3-DERIVATIVE COV(Y(T),Y(0)) = COV(:,4)
|
||||
|
||||
C 4-DERIVATIVE COV(Y(T),Y(0)) = COV(:,5)
|
||||
|
||||
XL4 = COV(1,5)
|
||||
! XL4 = SPLE(NT,ZERO,COV(:,5),T)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE COVG
|
||||
|
||||
SUBROUTINE INITINTEG()
|
||||
USE RINTMOD
|
||||
USE EPSMOD
|
||||
USE INFCMOD
|
||||
USE MREGMOD
|
||||
! 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
|
||||
|
||||
END module cov2mmpdfmod
|
||||
@ -0,0 +1,613 @@
|
||||
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
|
||||
@ -0,0 +1,25 @@
|
||||
GFORTRAN module version '0' created from mregmodule.f on Wed Aug 05 19:15:05 2009
|
||||
MD5:67523ef735281684c8fb9aae15cdc0a3 -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(() () () () () () () () () () () () () () () () () () () () () () () ()
|
||||
() () ())
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(2 'eps' 'epsmod' 'eps' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
IMPLICIT-SAVE) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
3 'eps0' 'epsmod' 'eps0' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN IMPLICIT-SAVE) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
4 'epsmod' 'epsmod' 'epsmod' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () () () 0 0)
|
||||
5 'epss' 'epsmod' 'epss' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN IMPLICIT-SAVE) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('eps' 0 2 'eps0' 0 3 'epsmod' 0 4 'epss' 0 5)
|
||||
@ -0,0 +1,23 @@
|
||||
GFORTRAN module version '0' created from mregmodule.f on Wed Aug 05 19:15:05 2009
|
||||
MD5:2d868304b34a40918a05109c83ff1871 -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(() () () () () () () () () () () () () () () () () () () () () () () ()
|
||||
() () ())
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(2 'expaccmod' 'expaccmod' 'expaccmod' 1 ((MODULE UNKNOWN-INTENT
|
||||
UNKNOWN-PROC UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 ()
|
||||
() () 0 0)
|
||||
3 'pmax' 'expaccmod' 'pmax' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN IMPLICIT-SAVE) (REAL 8 0 0 REAL ()) 0 0 () (CONSTANT (REAL 8 0 0
|
||||
REAL ()) 0 '0.28000000000000@2') () 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('expaccmod' 0 2 'pmax' 0 3)
|
||||
@ -0,0 +1,32 @@
|
||||
GFORTRAN module version '0' created from mregmodule.f on Wed Aug 05 19:15:05 2009
|
||||
MD5:806a8e6bde038d8bc47688d3b6e5277f -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(() () () () () () () () () () () () () () () () () () () () () () () ()
|
||||
() () ())
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(2 'iac' 'infcmod' 'iac' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN EXPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0
|
||||
0)
|
||||
3 'inf' 'infcmod' 'inf' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN DIMENSION) (INTEGER 4 0 0 INTEGER ()) 0 0 () (1 EXPLICIT (
|
||||
CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '10')) 0 () () () 0 0)
|
||||
4 'infcmod' 'infcmod' 'infcmod' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () () () 0 0)
|
||||
5 'info' 'infcmod' 'info' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN DIMENSION) (INTEGER 4 0 0 INTEGER ()) 0 0 () (1 EXPLICIT
|
||||
(CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '10')) 0 () () () 0 0)
|
||||
6 'isq' 'infcmod' 'isq' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
EXPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('iac' 0 2 'inf' 0 3 'infcmod' 0 4 'info' 0 5 'isq' 0 6)
|
||||
@ -0,0 +1,97 @@
|
||||
GFORTRAN module version '0' created from mregmodule.f on Wed Aug 05 19:21:17 2009
|
||||
MD5:35f9c2506fae455bf63c0bcfadd75d2e -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(()
|
||||
() () () () () () () () () () () () () () () () () () () () () () () ()
|
||||
() ())
|
||||
|
||||
()
|
||||
|
||||
(('fi' 'mregmod' 2) ('rind' 'mregmod' 3) ('mreg' 'mregmod' 4))
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(2 'fi' 'mregmod' 'fi' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL
|
||||
UNKNOWN FUNCTION GENERIC) (REAL 8 0 0 REAL ()) 5 0 (6) () 2 () () () 0 0)
|
||||
4 'mreg' 'mregmod' 'mreg' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL
|
||||
UNKNOWN SUBROUTINE GENERIC) (UNKNOWN 0 0 0 UNKNOWN ()) 7 0 (8 9 10 11 12
|
||||
13 14 15 16 17 18 19 20) () 0 () () () 0 0)
|
||||
3 'rind' 'mregmod' 'rind' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL
|
||||
UNKNOWN SUBROUTINE GENERIC) (UNKNOWN 0 0 0 UNKNOWN ()) 21 0 (22 23 24 25
|
||||
26 27 28 29 30 31) () 0 () () () 0 0)
|
||||
22 'xind' '' 'xind' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
23 'r' '' 'r' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '40401')) 0 ()
|
||||
() () 0 0)
|
||||
24 'bu' '' 'bu' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
|
||||
'201')) 0 () () () 0 0)
|
||||
25 'dbun' '' 'dbun' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
26 'db' '' 'db' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
|
||||
'201')) 0 () () () 0 0)
|
||||
27 'sq' '' 'sq' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
|
||||
'201')) 0 () () () 0 0)
|
||||
28 'vder' '' 'vder' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
29 'nit' '' 'nit' 21 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
30 'n' '' 'n' 21 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
31 'infr' '' 'infr' 21 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
6 'xx' '' 'xx' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
8 'f' '' 'f' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
9 'r' '' 'r' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '40401')) 0 ()
|
||||
() () 0 0)
|
||||
10 'b' '' 'b' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '201')) 0 () ()
|
||||
() 0 0)
|
||||
18 'n' '' 'n' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
11 'db' '' 'db' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
|
||||
'201')) 0 () () () 0 0)
|
||||
12 'aa' '' 'aa' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (2 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
|
||||
'4') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0
|
||||
0 INTEGER ()) 0 '4')) 0 () () () 0 0)
|
||||
13 'bb' '' 'bb' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
|
||||
'7')) 0 () () () 0 0)
|
||||
19 'nit' '' 'nit' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
14 'a' '' 'a' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1407')) 0 ()
|
||||
() () 0 0)
|
||||
20 'infr' '' 'infr' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
15 'da' '' 'da' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
|
||||
'7')) 0 () () () 0 0)
|
||||
16 'vder' '' 'vder' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
17 'm' '' 'm' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('fi' 0 2 'mreg' 0 4 'rind' 0 3)
|
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,37 @@
|
||||
GFORTRAN module version '0' created from mregmodule.f on Wed Aug 05 19:15:05 2009
|
||||
MD5:447301769c212f228b6cfa086ba1d48a -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(() () () () () () () () () () () () () () () () () () () () () () () ()
|
||||
() () ())
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(2 'h' 'quadrmod' 'h' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN DIMENSION DATA) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (
|
||||
CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '126')) 0 () () () 0 0)
|
||||
3 'i' 'quadrmod' 'i' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
4 'nn' 'quadrmod' 'nn' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN DIMENSION DATA) (INTEGER 4 0 0 INTEGER ()) 0 0 () (1 EXPLICIT (
|
||||
CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '25')) 0 () () () 0 0)
|
||||
5 'nnw' 'quadrmod' 'nnw' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN IMPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '13') () 0 () () () 0 0)
|
||||
6 'quadrmod' 'quadrmod' 'quadrmod' 1 ((MODULE UNKNOWN-INTENT
|
||||
UNKNOWN-PROC UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 ()
|
||||
() () 0 0)
|
||||
7 'z' 'quadrmod' 'z' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN DIMENSION DATA) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (
|
||||
CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '126')) 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('h' 0 2 'i' 0 3 'nn' 0 4 'nnw' 0 5 'quadrmod' 0 6 'z' 0 7)
|
||||
@ -0,0 +1,23 @@
|
||||
GFORTRAN module version '0' created from mregmodule.f on Wed Aug 05 19:15:05 2009
|
||||
MD5:ea81a0bf9bc67a6cbf4024dcd57f4ee3 -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(() () () () () () () () () () () () () () () () () () () () () () () ()
|
||||
() () ())
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(2 'c' 'rintmod' 'c' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
EXPLICIT-SAVE) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
3 'fc' 'rintmod' 'fc' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
EXPLICIT-SAVE) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
4 'rintmod' 'rintmod' 'rintmod' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('c' 0 2 'fc' 0 3 'rintmod' 0 4)
|
||||
@ -0,0 +1,28 @@
|
||||
GFORTRAN module version '0' created from mregmodule.f on Wed Aug 05 19:15:05 2009
|
||||
MD5:b8c9fdc908b66b228beb64d8a241e2e6 -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(() () () () () () () () () () () () () () () () () () () () () () () ()
|
||||
() () ())
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(2 'mmax' 'sizemod' 'mmax' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN IMPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '6') () 0 () () () 0 0)
|
||||
3 'nmax' 'sizemod' 'nmax' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN IMPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '201') () 0 () () () 0 0)
|
||||
4 'rdim' 'sizemod' 'rdim' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN IMPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '40401') () 0 () () () 0 0)
|
||||
5 'sizemod' 'sizemod' 'sizemod' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('mmax' 0 2 'nmax' 0 3 'rdim' 0 4 'sizemod' 0 5)
|
||||
@ -0,0 +1,92 @@
|
||||
GFORTRAN module version '0' created from dsvdc.f on Wed Aug 05 19:15:05 2009
|
||||
MD5:06f4ab5dbb3a45df847b6d37183b2196 -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(() () () () () () () () () () () () () () () () () () () () () () () ()
|
||||
() () ())
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(2 'dp' 'svd' 'dp' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
IMPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () (CONSTANT (INTEGER 4 0
|
||||
0 INTEGER ()) 0 '8') () 0 () () () 0 0)
|
||||
3 'drot1' 'svd' 'drot1' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL
|
||||
UNKNOWN SUBROUTINE) (UNKNOWN 0 0 0 UNKNOWN ()) 4 0 (5 6 7 8 9) () 0 () ()
|
||||
() 0 0)
|
||||
10 'drotg' 'svd' 'drotg' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL
|
||||
UNKNOWN SUBROUTINE) (UNKNOWN 0 0 0 UNKNOWN ()) 11 0 (12 13 14 15) () 0 ()
|
||||
() () 0 0)
|
||||
16 'dsvdc' 'svd' 'dsvdc' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL
|
||||
UNKNOWN SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 UNKNOWN ()) 17 0 (18
|
||||
19 20 21 22 23 24 25 26) () 0 () () () 0 0)
|
||||
27 'dswap1' 'svd' 'dswap1' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL
|
||||
UNKNOWN SUBROUTINE) (UNKNOWN 0 0 0 UNKNOWN ()) 28 0 (29 30 31) () 0 () ()
|
||||
() 0 0)
|
||||
32 'selected_real_kind' '(intrinsic)' 'selected_real_kind' 1 ((
|
||||
PROCEDURE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN UNKNOWN FUNCTION) (
|
||||
UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 32 () () () 0 0)
|
||||
33 'svd' 'svd' 'svd' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () () () 0 0)
|
||||
15 'ds' '' 'ds' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
12 'da' '' 'da' 11 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
13 'db' '' 'db' 11 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
14 'dc' '' 'dc' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
29 'n' '' 'n' 28 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
30 'dx' '' 'dx' 28 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
5 'n' '' 'n' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
6 'dx' '' 'dx' 4 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (INTEGER 4
|
||||
0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
7 'dy' '' 'dy' 4 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (INTEGER 4
|
||||
0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
21 's' '' 's' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT (INTEGER 4
|
||||
0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
22 'e' '' 'e' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT (INTEGER 4
|
||||
0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
23 'u' '' 'u' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (2 ASSUMED_SHAPE (CONSTANT (INTEGER 4
|
||||
0 0 INTEGER ()) 0 '1') () (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') ())
|
||||
0 () () () 0 0)
|
||||
25 'job' '' 'job' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
24 'v' '' 'v' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (2 ASSUMED_SHAPE (CONSTANT (INTEGER 4
|
||||
0 0 INTEGER ()) 0 '1') () (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') ())
|
||||
0 () () () 0 0)
|
||||
18 'x' '' 'x' 17 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (2 ASSUMED_SHAPE (CONSTANT (INTEGER 4
|
||||
0 0 INTEGER ()) 0 '1') () (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') ())
|
||||
0 () () () 0 0)
|
||||
19 'n' '' 'n' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
20 'p' '' 'p' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
26 'info' '' 'info' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
31 'dy' '' 'dy' 28 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
8 'c' '' 'c' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (REAL 8
|
||||
0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
9 's' '' 's' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (REAL 8
|
||||
0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('dp' 0 2 'drot1' 0 3 'drotg' 0 10 'dsvdc' 0 16 'dswap1' 0 27
|
||||
'selected_real_kind' 0 32 'svd' 0 33)
|
||||
@ -0,0 +1,34 @@
|
||||
GFORTRAN module version '0' created from mregmodule.f on Wed Aug 05 19:15:05 2009
|
||||
MD5:43d81dd7165fa3666db9131e212144f1 -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(() () () () () () ()
|
||||
() () () () () () () () () () () () () () () () () () () ())
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(2 'hh' 'tbrmod' 'hh' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN DIMENSION) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
|
||||
'201')) 0 () () () 0 0)
|
||||
3 'mmax' 'sizemod' 'mmax' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN IMPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '6') () 0 () () () 0 0)
|
||||
4 'nmax' 'sizemod' 'nmax' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN IMPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '201') () 0 () () () 0 0)
|
||||
5 'rdim' 'sizemod' 'rdim' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN IMPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '40401') () 0 () () () 0 0)
|
||||
6 'sizemod' 'sizemod' 'sizemod' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () () () 0 0)
|
||||
7 'tbrmod' 'tbrmod' 'tbrmod' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC
|
||||
UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('hh' 0 2 'mmax' 0 3 'nmax' 0 4 'rdim' 0 5 'sizemod' 0 6 'tbrmod' 0 7)
|
||||
@ -0,0 +1,112 @@
|
||||
GFORTRAN module version '0' created from mvnprodcorrprb.f on Fri Jul 31 00:49:14 2009
|
||||
MD5:a1f0425fa1a5ac7941ae2e0de107c489 -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(() () () () () () () () () () () () () () () () () () () () () () () ()
|
||||
() () ())
|
||||
|
||||
()
|
||||
|
||||
(('dqagpe' 'adaptivegausskronrod' 2) ('dqagp' 'adaptivegausskronrod' 3))
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(3 'dqagp' 'adaptivegausskronrod' 'dqagp' 1 ((PROCEDURE UNKNOWN-INTENT
|
||||
MODULE-PROC DECL UNKNOWN SUBROUTINE GENERIC) (UNKNOWN 0 0 0 UNKNOWN ())
|
||||
4 0 (5 6 7 8 9 10 11 12 13 14 15 16) () 0 () () () 0 0)
|
||||
2 'dqagpe' 'adaptivegausskronrod' 'dqagpe' 1 ((PROCEDURE UNKNOWN-INTENT
|
||||
MODULE-PROC DECL UNKNOWN SUBROUTINE GENERIC) (UNKNOWN 0 0 0 UNKNOWN ())
|
||||
17 0 (18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38) ()
|
||||
0 () () () 0 0)
|
||||
5 'f' '' 'f' 4 ((PROCEDURE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
EXTERNAL DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
6 'a' '' 'a' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (REAL 8
|
||||
0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
7 'b' '' 'b' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (REAL 8
|
||||
0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
8 'npts' '' 'npts' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
9 'points' '' 'points' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0
|
||||
8 ())) 0 () () () 0 0)
|
||||
10 'epsabs' '' 'epsabs' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
11 'epsrel' '' 'epsrel' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
12 'limit' '' 'limit' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
13 'result1' '' 'result1' 4 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
14 'abserr' '' 'abserr' 4 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
15 'neval' '' 'neval' 4 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
16 'ier' '' 'ier' 4 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
18 'f' '' 'f' 17 ((PROCEDURE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
EXTERNAL DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
19 'a' '' 'a' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
20 'b' '' 'b' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
21 'npts' '' 'npts' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
22 'points' '' 'points' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0
|
||||
21 ())) 0 () () () 0 0)
|
||||
23 'epsabs' '' 'epsabs' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
24 'epsrel' '' 'epsrel' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
25 'limit' '' 'limit' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
26 'result' '' 'result' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
27 'abserr' '' 'abserr' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
28 'neval' '' 'neval' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
29 'ier' '' 'ier' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
30 'alist' '' 'alist' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0
|
||||
25 ())) 0 () () () 0 0)
|
||||
31 'blist' '' 'blist' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0
|
||||
25 ())) 0 () () () 0 0)
|
||||
32 'rlist' '' 'rlist' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0
|
||||
25 ())) 0 () () () 0 0)
|
||||
33 'elist' '' 'elist' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0
|
||||
25 ())) 0 () () () 0 0)
|
||||
34 'pts' '' 'pts' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') (OP (INTEGER 4 0 0 INTEGER ()) 0 PLUS (
|
||||
VARIABLE (INTEGER 4 0 0 INTEGER ()) 0 21 ()) (CONSTANT (INTEGER 4 0 0
|
||||
INTEGER ()) 0 '2'))) 0 () () () 0 0)
|
||||
35 'iord' '' 'iord' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () (1 EXPLICIT (
|
||||
CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0
|
||||
INTEGER ()) 0 25 ())) 0 () () () 0 0)
|
||||
36 'level' '' 'level' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () (1 EXPLICIT (
|
||||
CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (VARIABLE (INTEGER 4 0 0
|
||||
INTEGER ()) 0 25 ())) 0 () () () 0 0)
|
||||
37 'ndin' '' 'ndin' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () (1 EXPLICIT (
|
||||
CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (OP (INTEGER 4 0 0 INTEGER ())
|
||||
0 PLUS (VARIABLE (INTEGER 4 0 0 INTEGER ()) 0 21 ()) (CONSTANT (INTEGER
|
||||
4 0 0 INTEGER ()) 0 '2'))) 0 () () () 0 0)
|
||||
38 'last' '' 'last' 17 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('dqagp' 0 3 'dqagpe' 0 2)
|
||||
@ -0,0 +1,30 @@
|
||||
"""
|
||||
f2py c_library.pyf c_functions.c -c
|
||||
"""
|
||||
import os
|
||||
|
||||
def compile_all():
|
||||
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 -m mvnprdmod -c %s mvnprd_interface.f --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71' % file_objects)
|
||||
#compile1_txt = 'gfortran -fPIC -c mvnprd.f'
|
||||
#compile2_txt = 'f2py -m mvnprdmod -c mvnprd.o mvnprd_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()
|
||||
@ -0,0 +1,51 @@
|
||||
GFORTRAN module version '0' created from mvnprodcorrprb.f on Fri Jul 31 00:49:14 2009
|
||||
MD5:fd8b502899ea930770b400347fe62952 -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(() () () () () () () () () () () () () () () () () () () () () () () ()
|
||||
() () ())
|
||||
|
||||
()
|
||||
|
||||
(('derf' 'erfcoremod' 2) ('calerf' 'erfcoremod' 3) ('derfcx' 'erfcoremod'
|
||||
4) ('derfc' 'erfcoremod' 5))
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(3 'calerf' 'erfcoremod' 'calerf' 1 ((PROCEDURE UNKNOWN-INTENT
|
||||
MODULE-PROC DECL UNKNOWN SUBROUTINE GENERIC) (UNKNOWN 0 0 0 UNKNOWN ())
|
||||
6 0 (7 8 9) () 0 () () () 0 0)
|
||||
2 'derf' 'erfcoremod' 'derf' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC
|
||||
DECL UNKNOWN FUNCTION GENERIC) (REAL 8 0 0 REAL ()) 10 0 (11) () 12 () ()
|
||||
() 0 0)
|
||||
5 'derfc' 'erfcoremod' 'derfc' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC
|
||||
DECL UNKNOWN FUNCTION GENERIC) (REAL 8 0 0 REAL ()) 13 0 (14) () 15 () ()
|
||||
() 0 0)
|
||||
4 'derfcx' 'erfcoremod' 'derfcx' 1 ((PROCEDURE UNKNOWN-INTENT
|
||||
MODULE-PROC DECL UNKNOWN FUNCTION GENERIC) (REAL 8 0 0 REAL ()) 16 0 (
|
||||
17) () 18 () () () 0 0)
|
||||
19 'erfcoremod' 'erfcoremod' 'erfcoremod' 1 ((MODULE UNKNOWN-INTENT
|
||||
UNKNOWN-PROC UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 ()
|
||||
() () 0 0)
|
||||
11 'x' '' 'x' 10 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
12 'value' '' 'value' 10 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN RESULT) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
14 'x' '' 'x' 13 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
15 'value' '' 'value' 13 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN RESULT) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
17 'x' '' 'x' 16 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
18 'value' '' 'value' 16 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN RESULT) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
7 'arg' '' 'arg' 6 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
8 'result' '' 'result' 6 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
9 'jint' '' 'jint' 6 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('calerf' 0 3 'derf' 0 2 'derfc' 0 5 'derfcx' 0 4 'erfcoremod' 0 19)
|
||||
@ -0,0 +1,27 @@
|
||||
GFORTRAN module version '0' created from mvnprodcorrprb.f on Fri Jul 31 00:49:14 2009
|
||||
MD5:68ed62f6aa743d64a34217a1e7fa0463 -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(() () () () () () () () () () () () () () () () () () () () () () () ()
|
||||
() () ())
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(2 'f' 'functioninterface' 'f' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC
|
||||
BODY UNKNOWN EXTERNAL FUNCTION) (REAL 8 0 0 REAL ()) 3 0 (4) () 5 () ()
|
||||
() 0 0)
|
||||
6 'functioninterface' 'functioninterface' 'functioninterface' 1 ((
|
||||
MODULE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN UNKNOWN) (UNKNOWN 0 0 0
|
||||
UNKNOWN ()) 0 0 () () 0 () () () 0 0)
|
||||
4 'z' '' 'z' 3 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (REAL 8
|
||||
0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
5 'val' '' 'val' 3 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN RESULT) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('f' 0 2 'functioninterface' 0 6)
|
||||
@ -0,0 +1,241 @@
|
||||
GFORTRAN module version '0' created from mvnprodcorrprb.f on Fri Jul 31 00:49:14 2009
|
||||
MD5:0f4f78aeb56df870cb724a93e6facf93 -- If you edit this, you'll get what you deserve.
|
||||
|
||||
(() () ()
|
||||
() () () () () () () () () () () () () () () () () () () () () () () ())
|
||||
|
||||
()
|
||||
|
||||
(('adaptivesimpson' 'integration1dmodule' 2 3) ('d1mach'
|
||||
'integration1dmodule' 4) ('adaptivetrapz' 'integration1dmodule' 5 6) (
|
||||
'romberg' 'integration1dmodule' 7 8) ('dea' 'integration1dmodule' 9))
|
||||
|
||||
()
|
||||
|
||||
()
|
||||
|
||||
(10 'adaptiveintwithbreaks' 'integration1dmodule' 'adaptiveintwithbreaks'
|
||||
1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL UNKNOWN SUBROUTINE
|
||||
ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 UNKNOWN ()) 11 0 (12 13 14 15 16 17 18
|
||||
19 20) () 0 () () () 0 0)
|
||||
21 'adaptivesimpson1' 'integration1dmodule' 'adaptivesimpson1' 1 ((
|
||||
PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL UNKNOWN SUBROUTINE) (UNKNOWN 0
|
||||
0 0 UNKNOWN ()) 22 0 (23 24 25 26 27 28 29) () 0 () () () 0 0)
|
||||
3 'adaptivesimpson2' 'integration1dmodule' 'adaptivesimpson2' 1 ((
|
||||
PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL UNKNOWN SUBROUTINE) (UNKNOWN 0
|
||||
0 0 UNKNOWN ()) 30 0 (31 32 33 34 35 36 37) () 0 () () () 0 0)
|
||||
38 'adaptivesimpson3' 'integration1dmodule' 'adaptivesimpson3' 1 ((
|
||||
PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL UNKNOWN SUBROUTINE) (UNKNOWN 0
|
||||
0 0 UNKNOWN ()) 39 0 (40 41 42 43 44 45 46) () 0 () () () 0 0)
|
||||
2 'adaptivesimpsonwithbreaks' 'integration1dmodule'
|
||||
'adaptivesimpsonwithbreaks' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC
|
||||
DECL UNKNOWN SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 UNKNOWN ()) 47 0
|
||||
(48 49 50 51 52 53 54 55 56) () 0 () () () 0 0)
|
||||
6 'adaptivetrapz1' 'integration1dmodule' 'adaptivetrapz1' 1 ((PROCEDURE
|
||||
UNKNOWN-INTENT MODULE-PROC DECL UNKNOWN SUBROUTINE) (UNKNOWN 0 0 0
|
||||
UNKNOWN ()) 57 0 (58 59 60 61 62 63 64) () 0 () () () 0 0)
|
||||
5 'adaptivetrapzwithbreaks' 'integration1dmodule'
|
||||
'adaptivetrapzwithbreaks' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL
|
||||
UNKNOWN SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 UNKNOWN ()) 65 0 (66
|
||||
67 68 69 70 71 72 73 74) () 0 () () () 0 0)
|
||||
4 'd1mach' 'integration1dmodule' 'd1mach' 1 ((PROCEDURE UNKNOWN-INTENT
|
||||
MODULE-PROC DECL UNKNOWN FUNCTION GENERIC) (REAL 8 0 0 REAL ()) 75 0 (
|
||||
76) () 4 () () () 0 0)
|
||||
9 'dea' 'integration1dmodule' 'dea' 1 ((PROCEDURE UNKNOWN-INTENT
|
||||
MODULE-PROC DECL UNKNOWN SUBROUTINE GENERIC) (UNKNOWN 0 0 0 UNKNOWN ())
|
||||
77 0 (78 79 80 81 82 83 84) () 0 () () () 0 0)
|
||||
85 'dea3' 'integration1dmodule' 'dea3' 1 ((PROCEDURE UNKNOWN-INTENT
|
||||
MODULE-PROC DECL UNKNOWN SUBROUTINE) (UNKNOWN 0 0 0 UNKNOWN ()) 86 0 (
|
||||
87 88 89 90 91) () 0 () () () 0 0)
|
||||
92 'integration1dmodule' 'integration1dmodule' 'integration1dmodule' 1 (
|
||||
(MODULE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN UNKNOWN) (UNKNOWN 0 0 0
|
||||
UNKNOWN ()) 0 0 () () 0 () () () 0 0)
|
||||
8 'romberg1' 'integration1dmodule' 'romberg1' 1 ((PROCEDURE
|
||||
UNKNOWN-INTENT MODULE-PROC DECL UNKNOWN SUBROUTINE) (UNKNOWN 0 0 0
|
||||
UNKNOWN ()) 93 0 (94 95 96 97 98 99 100 101) () 0 () () () 0 0)
|
||||
7 'rombergwithbreaks' 'integration1dmodule' 'rombergwithbreaks' 1 ((
|
||||
PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL UNKNOWN SUBROUTINE
|
||||
ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 UNKNOWN ()) 102 0 (103 104 105 106 107
|
||||
108 109 110 111) () 0 () () () 0 0)
|
||||
76 'i' '' 'i' 75 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
87 'e0' '' 'e0' 86 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
88 'e1' '' 'e1' 86 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
89 'e2' '' 'e2' 86 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
90 'abserr' '' 'abserr' 86 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
91 'result' '' 'result' 86 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
78 'newflg' '' 'newflg' 77 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (LOGICAL 4 0 0 LOGICAL ()) 0 0 () () 0 () () () 0 0)
|
||||
79 'svalue' '' 'svalue' 77 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
80 'limexp' '' 'limexp' 77 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
81 'result' '' 'result' 77 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
82 'abserr' '' 'abserr' 77 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
83 'epstab' '' 'epstab' 77 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
84 'ierr' '' 'ierr' 77 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
12 'f' '' 'f' 11 ((PROCEDURE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
EXTERNAL DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
13 'a' '' 'a' 11 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
14 'b' '' 'b' 11 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
15 'n' '' 'n' 11 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
16 'brks' '' 'brks' 11 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
17 'epsi' '' 'epsi' 11 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
18 'iflg' '' 'iflg' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
19 'abserr' '' 'abserr' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
20 'val' '' 'val' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
48 'f' '' 'f' 47 ((PROCEDURE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
EXTERNAL DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
49 'a' '' 'a' 47 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
50 'b' '' 'b' 47 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
51 'n' '' 'n' 47 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
52 'brks' '' 'brks' 47 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
53 'epsi' '' 'epsi' 47 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
54 'iflg' '' 'iflg' 47 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
55 'abserr' '' 'abserr' 47 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
56 'val' '' 'val' 47 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
23 'f' '' 'f' 22 ((PROCEDURE UNKNOWN-INTENT DUMMY-PROC UNKNOWN UNKNOWN
|
||||
EXTERNAL DUMMY FUNCTION) (REAL 8 0 0 REAL ()) 0 0 () () 23 () () () 0 0)
|
||||
24 'a' '' 'a' 22 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
25 'b' '' 'b' 22 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
26 'epsi' '' 'epsi' 22 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
27 'iflg' '' 'iflg' 22 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
28 'abserr' '' 'abserr' 22 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
29 'val' '' 'val' 22 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
31 'f' '' 'f' 30 ((PROCEDURE UNKNOWN-INTENT DUMMY-PROC UNKNOWN UNKNOWN
|
||||
EXTERNAL DUMMY FUNCTION) (REAL 8 0 0 REAL ()) 0 0 () () 31 () () () 0 0)
|
||||
32 'a' '' 'a' 30 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
33 'b' '' 'b' 30 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
34 'epsi' '' 'epsi' 30 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
35 'iflg' '' 'iflg' 30 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
36 'abserr' '' 'abserr' 30 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
37 'val' '' 'val' 30 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
40 'f' '' 'f' 39 ((PROCEDURE UNKNOWN-INTENT DUMMY-PROC UNKNOWN UNKNOWN
|
||||
EXTERNAL DUMMY FUNCTION) (REAL 8 0 0 REAL ()) 0 0 () () 40 () () () 0 0)
|
||||
41 'a' '' 'a' 39 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
42 'b' '' 'b' 39 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
43 'epsi' '' 'epsi' 39 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
44 'iflg' '' 'iflg' 39 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
45 'abserr' '' 'abserr' 39 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
46 'val' '' 'val' 39 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
66 'f' '' 'f' 65 ((PROCEDURE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
EXTERNAL DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
67 'a' '' 'a' 65 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
68 'b' '' 'b' 65 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
69 'n' '' 'n' 65 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
70 'brks' '' 'brks' 65 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
71 'epsi' '' 'epsi' 65 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
72 'iflg' '' 'iflg' 65 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
73 'abserr' '' 'abserr' 65 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
74 'val' '' 'val' 65 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
58 'f' '' 'f' 57 ((PROCEDURE UNKNOWN-INTENT DUMMY-PROC UNKNOWN UNKNOWN
|
||||
EXTERNAL DUMMY FUNCTION) (REAL 8 0 0 REAL ()) 0 0 () () 58 () () () 0 0)
|
||||
59 'a' '' 'a' 57 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
60 'b' '' 'b' 57 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
61 'epsi' '' 'epsi' 57 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
62 'iflg' '' 'iflg' 57 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
63 'abserr' '' 'abserr' 57 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
64 'val' '' 'val' 57 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
103 'f' '' 'f' 102 ((PROCEDURE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
|
||||
UNKNOWN EXTERNAL DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
104 'a' '' 'a' 102 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
105 'b' '' 'b' 102 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
106 'n' '' 'n' 102 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
107 'brks' '' 'brks' 102 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT
|
||||
(INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
|
||||
108 'epsi' '' 'epsi' 102 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
109 'iflg' '' 'iflg' 102 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
110 'abserr' '' 'abserr' 102 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
111 'val' '' 'val' 102 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
94 'f' '' 'f' 93 ((PROCEDURE UNKNOWN-INTENT DUMMY-PROC UNKNOWN UNKNOWN
|
||||
EXTERNAL DUMMY FUNCTION) (REAL 8 0 0 REAL ()) 0 0 () () 94 () () () 0 0)
|
||||
95 'a' '' 'a' 93 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
96 'b' '' 'b' 93 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
|
||||
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
97 'decdigs' '' 'decdigs' 93 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
98 'abseps' '' 'abseps' 93 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
99 'errflg' '' 'errflg' 93 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
|
||||
100 'abserr' '' 'abserr' 93 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN
|
||||
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
101 'val' '' 'val' 93 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY)
|
||||
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
|
||||
)
|
||||
|
||||
('adaptiveintwithbreaks' 0 10 'adaptivesimpson1' 0 21 'adaptivesimpson2'
|
||||
0 3 'adaptivesimpson3' 0 38 'adaptivesimpsonwithbreaks' 0 2
|
||||
'adaptivetrapz1' 0 6 'adaptivetrapzwithbreaks' 0 5 'd1mach' 0 4 'dea' 0
|
||||
9 'dea3' 0 85 'integration1dmodule' 0 92 'romberg1' 0 8
|
||||
'rombergwithbreaks' 0 7)
|
||||
@ -0,0 +1,93 @@
|
||||
# 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
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue