Successfully made an interface to mregmodule. It still remains to check that it is correct.

master
Per.Andreas.Brodtkorb 14 years ago
parent 578470f36a
commit 7812a265f6

Binary file not shown.

@ -7,7 +7,7 @@ gfortran -W -Wall -pedantic-errors -fbounds-check -Werror -c dsvdc.f mregmodule.
import os
def compile_all():
files = ['dsvdc','mregmodule']
files = ['dsvdc','mregmodule', 'intfcmod']
compile1_format = 'gfortran -fPIC -c %s.f'
format1 = '%s.o ' * len(files)
for file in files:

@ -1,5 +1,5 @@
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.
GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:fe57607d30a725f711d7629678581d81 -- If you edit this, you'll get what you deserve.
(() () () () () () () () () () () () () () () () () () () () () () () ()
() () ())
@ -12,33 +12,35 @@ MD5:9338abc0e14d4bf13175cb874e9f7ea5 -- If you edit this, you'll get what you de
()
()
(2 'checkmod' 'checkmod' 'checkmod' 1 ((MODULE UNKNOWN-INTENT
UNKNOWN-PROC UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 ()
() () 0 0)
UNKNOWN-PROC UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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'

@ -10,18 +10,18 @@ C revised pab July 2007
! -renamed from sp2mmpdfreg to cov2mmpdfreg
PROGRAM cov2mmpdfreg
USE SIZEMOD
USE EPSMOD
USE CHECKMOD
USE MREGMOD
IMPLICIT NONE
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
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
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)
@ -40,14 +40,14 @@ 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
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
INTEGER :: fffff
C REAL*8 EPS0
C INTEGER III01,III11,III21,III31,III41,III51
C *,III61,III71,III81,III91,III101 , III0
@ -316,16 +316,16 @@ C 105 continue
END
SUBROUTINE INITLEVELS(ULEVELS,NU,Vlevels,Nv,T,HT,N,TG,XG,NG)
USE TBRMOD
USE SIZEMOD
IMPLICIT NONE
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
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')
@ -424,14 +424,14 @@ 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
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
integer, intent(in) :: N
REAL*8:: T1
integer :: I
IF (T.LT.TIMEV(1)) then
der=(A(2)-A(1))/(TIMEV(2)-TIMEV(1))
@ -455,7 +455,7 @@ C INTEGER, PARAMETER :: RDIM = 10201
RETURN
END
REAL*8 FUNCTION SPLE(N,T,A,TIMEV)
REAL*8 FUNCTION SPLE(N,T,A,TIMEV)
C
C N number of data points
C TIME vector of time points
@ -464,13 +464,13 @@ 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
IMPLICIT NONE
INTEGER, INTENT(IN):: N
REAL*8, INTENT(IN) :: T
REAL*8, INTENT(IN) :: T
REAL*8, DIMENSION(5*NMAX), INTENT(IN) :: A,TIMEV
REAL*8 :: T1
INTEGER :: I
REAL*8 :: T1
INTEGER :: I
SPLE=-9.9d0
IF (T.LT.TIMEV(1) .OR. T.GT.TIMEV(N)) RETURN
DO 5 I=2,N
@ -500,15 +500,15 @@ 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, 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
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')
@ -620,12 +620,12 @@ C 4-DERIVATIVE COV(Y(T),Y(0))
END
SUBROUTINE INITINTEG(NIT)
USE RINTMOD
USE EPSMOD
USE INFCMOD
USE MREGMOD
USE RINTMOD
USE EPSMOD
USE INFCMOD
USE MREGMOD
! IMPLICIT NONE
INTEGER, intent(inout) :: NIT
INTEGER, intent(inout) :: NIT
! INTEGER ISQ1
C dimension INF(10),INFO(10)

@ -9,27 +9,45 @@ 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 INITINTEG(EPS_,EPSS_,EPS0_,C_,IAC_,ISQ_)
! Initiation of all constants and integration nodes 'INITINTEG'
USE RINTMOD
USE EPSMOD
USE INFCMOD
USE MREGMOD
REAL*8 :: EPS_,EPSS_,EPS0_,C_
INTEGER :: IAC_,ISQ_
Cf2py real*8, optional :: EPS_ = 0.01
Cf2py real*8, optional :: EPSS_ = 0.00005
Cf2py real*8, optional :: EPS0_ = 0.00005
Cf2py real*8, optional :: C_ = 4.5
Cf2py integer, optional :: IAC_ = 1
Cf2py integer, optional :: ISQ_ = 0
! IMPLICIT NONE
C COMMON /RINT/ C,FC
C COMMON /EPS/ EPS,EPSS,CEPSS
C COMMON /INFC/ ISQ,INF,INFO
IAC = IAC_
ISQ = ISQ_
EPS = EPS_
EPSS = EPSS_
EPS0 = EPS0_
C = C_
FC = FI(C)-FI(-C)
! CEPSS = 1.0d0-EPSS
RETURN
END SUBROUTINE INITINTEG
subroutine cov2mmpdfreg(UVdens,t,COV,ULev,VLev,Tg,Xg,Nt,Nu,Nv,Ng,
! NIT)
& NIT)
USE SIZEMOD
USE EPSMOD
USE CHECKMOD
USE MREGMOD
USE MREGMOD
USE INTFCMOD
IMPLICIT NONE
INTEGER, INTENT(IN) :: Nt, Nu, Nv, Ng, NIT
REAL*8, DIMENSION(Nt,5), intent(in):: COV
@ -45,13 +63,9 @@ 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
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
REAL*8 VDERI, CDER,SDER, DER, CONST1, 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
@ -94,7 +108,7 @@ C COMMON /EPS/ EPS,EPSS,CEPSS
C
C Initiation of all constants and integration nodes 'INITINTEG'
C
CALL INITINTEG()
! CALL INITINTEG()
! OPEN(UNIT=8,FILE='min.out')
! OPEN(UNIT=9,FILE='Max.out')
@ -119,8 +133,7 @@ C CALL INITLEVELS(Ulev,NU,Vlev,NV,T,HHT,Nt,R1,R2,NG)
V=Vlev(IV)
CALL TRANSF(NG,V,Xg,Tg,VALUE,DER)
VT(IV)=VALUE
Vdd(IV)=DER
14 continue
Vdd(IV)=DER
enddo
DO IU=1,Nu
U = Ulev(IU)
@ -129,7 +142,6 @@ C CALL INITLEVELS(Ulev,NU,Vlev,NV,T,HHT,Nt,R1,R2,NG)
Udd(IU) = DER
do IV=1,Nv
UVdens(IU,IV)=0.0d0
16 CONTINUE
enddo
enddo
@ -183,7 +195,7 @@ C
VDER(I)=VDER(I) - (DDB2(I)*DDB2(I))/Q(I)
end if
10 CONTINUE
c10 CONTINUE
enddo
DO I=1,Nt
DO J=1,Nt
@ -203,7 +215,7 @@ 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
c15 CONTINUE
enddo
enddo
@ -220,21 +232,18 @@ C on T=T(I), U=Ulevels(IU), V=Ulevels(IV), U>V.
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
BI(I3) = R2(I3+(I-1)*N) - (DB2(I)*DB2(I3)/Q(I))
enddo
DO I3=1,I-1
AI(I3)=0.0d0
AI(I3+I-1)=DB0(I3)/SQ0
AI(I3+2*(I-1))=DB1(I3)/SQ1
AI(I3+3*(I-1))=DB2(I3)/SQ(I)
51 CONTINUE
AI(I3+3*(I-1))=DB2(I3)/SQ(I)
enddo
VDERI=VDER(I)
DAI(1)=0.0d0
@ -255,12 +264,9 @@ C DDB2(I) contains Cov(X''(T(i)),X(T(i))|X'(0),X''(0),X(0))
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
@ -327,16 +333,16 @@ C Here the covariance of the problem would be innitiated
C sder=sqrt(XL4-XL2*XL2/XL0)
C cder=-XL2/sqrt(XL0)
C const=1/sqrt(XL0*XL4)
C const1=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 FM=Udd(IU)*const1*exp(-0.5*U*U/XL0)*PMEAN(-cder*U,sder)
C WRITE(9,300) Ulev(IU),FM
C 95 continue
C DO 105 IV=1,NV
C V=VT(IV)
C VV=cder*V
C Fm=Vdd(IV)*const*exp(-0.5*V*V/XL0)*PMEAN(VV,sder)
C Fm=Vdd(IV)*const1*exp(-0.5*V*V/XL0)*PMEAN(VV,sder)
C WRITE(8,300) Vlev(IV),Fm
C 105 continue
if (III0.eq.0) III0=1
@ -353,207 +359,5 @@ C 105 continue
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

@ -1,5 +1,5 @@
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.
GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:deb744d8baea0ddd5fc5faf9be58df7e -- If you edit this, you'll get what you deserve.
(() () () () () () () () () () () () () () () () () () () () () () () ()
() () ())
@ -12,14 +12,16 @@ MD5:67523ef735281684c8fb9aae15cdc0a3 -- If you edit this, you'll get what you de
()
()
(2 'eps' 'epsmod' 'eps' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
IMPLICIT-SAVE) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
IMPLICIT-SAVE 0 0) (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)
UNKNOWN IMPLICIT-SAVE 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN IMPLICIT-SAVE 0 0) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
)
('eps' 0 2 'eps0' 0 3 'epsmod' 0 4 'epss' 0 5)

@ -1,5 +1,5 @@
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.
GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:d82385a3a446da945f345d09302f933e -- If you edit this, you'll get what you deserve.
(() () () () () () () () () () () () () () () () () () () () () () () ()
() () ())
@ -12,12 +12,14 @@ MD5:2d868304b34a40918a05109c83ff1871 -- If you edit this, you'll get what you de
()
()
(2 'expaccmod' 'expaccmod' 'expaccmod' 1 ((MODULE UNKNOWN-INTENT
UNKNOWN-PROC UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 ()
() () 0 0)
UNKNOWN-PROC UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN IMPLICIT-SAVE 0 0) (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)

@ -1,5 +1,5 @@
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.
GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:5dadee8498f04fe7df773933dace020d -- If you edit this, you'll get what you deserve.
(() () () () () () () () () () () () () () () () () () () () () () () ()
() () ())
@ -12,21 +12,23 @@ MD5:806a8e6bde038d8bc47688d3b6e5277f -- If you edit this, you'll get what you de
()
()
(2 'iac' 'infcmod' 'iac' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
UNKNOWN EXPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0
0)
UNKNOWN EXPLICIT-SAVE 0 0) (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 (
UNKNOWN 0 0 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)
UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN UNKNOWN 0 0 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)
EXPLICIT-SAVE 0 0) (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,180 @@
MODULE INTFCMOD
IMPLICIT NONE
PUBLIC :: INITLEVELS, TRANSF, COVG
CONTAINS
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
c10 CONTINUE
enddo
IF(NU.gt.NMAX) then
print *,'The number of maxima >',NMAX,' stop'
stop
end if
IF(NV.gt.NMAX) then
print *,'The number of minima >',NMAX,' stop'
stop
end if
IF(NU.LT.1) Then
print *,'The number of maxima < 1, stop'
stop
end if
IF(NV.LT.1) Then
print *,'The number of minima < 1, stop'
stop
end if
RETURN
END SUBROUTINE INITLEVELS
SUBROUTINE TRANSF(N,T,A,TIMEV,VALUE,DER)
C
C N number of data points
C TIMEV vector of time points
C A a vector of values of a function G(TIME)
C T independent time point
C VALUE is a value of a function at T, i.e. VALUE=G(T).
c DER=G'(t)
C
USE SIZEMOD
IMPLICIT NONE
REAL*8, intent(inout):: VALUE, DER,T
C INTEGER, PARAMETER :: RDIM = 10201
REAL*8, DIMENSION(:), intent(in) :: A,TIMEV
integer, intent(in) :: N
REAL*8:: T1
integer :: I
IF (T.LT.TIMEV(1)) then
der=(A(2)-A(1))/(TIMEV(2)-TIMEV(1))
T1=T-TIMEV(1)
VALUE=A(1)+T1*DER
return
end if
IF (T.GT.TIMEV(N)) then
der = (A(N)-A(N-1))/(TIMEV(N)-TIMEV(N-1))
T1 = T-TIMEV(N)
VALUE=A(N)+T1*DER
return
end if
DO I=2,N
IF (T.LT.TIMEV(I)) GO TO 10
ENDDO
10 I=I-1
T1=T-TIMEV(I)
DER=(A(I+1)-A(I))/(TIMEV(i+1)-TIMEV(I))
VALUE=A(I)+T1*DER
RETURN
END SUBROUTINE TRANSF
REAL*8 FUNCTION SPLE(N,T,A,TIMEV)
C
C N number of data points
C TIME vector of time points
C A a vector of values of a function G(TIME)
C T independent time point
C SPLE is a value of a function at T, i.e. SPLE=G(T).
C
USE SIZEMOD
IMPLICIT NONE
INTEGER, INTENT(IN):: N
REAL*8, INTENT(IN) :: T
REAL*8, DIMENSION(:), INTENT(IN) :: A,TIMEV
REAL*8 :: T1
INTEGER :: I
SPLE=-9.9d0
IF (T.LT.TIMEV(1) .OR. T.GT.TIMEV(N)) RETURN
DO I=2,N
IF (T.LT.TIMEV(I)) GO TO 10
ENDDO
10 I=I-1
T1=T-TIMEV(I)
SPLE=A(I)+T1*(A(I+1)-A(I))/(TIMEV(i+1)-TIMEV(I))
RETURN
END FUNCTION SPLE
SUBROUTINE COVG(XL0,XL2,XL4,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
END module intfcmod

@ -1,9 +1,8 @@
GFORTRAN module version '0' created from mregmodule.f on Tue Jan 25 20:12:17 2011
MD5:a058cc3e6c0e8bedef8f214da2f5fbdc -- If you edit this, you'll get what you deserve.
GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:73d0040f77005ab6be34b297552c2c19 -- If you edit this, you'll get what you deserve.
(()
() () () () () () () () () () () () () () () () () () () () () () () ()
() ())
(() () () () () () () () () () () () () () () () () () () () () () ()
() () () ())
()
@ -13,85 +12,88 @@ MD5:a058cc3e6c0e8bedef8f214da2f5fbdc -- If you edit this, you'll get what you de
()
()
(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)
UNKNOWN 0 0 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)
UNKNOWN 0 0 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
UNKNOWN 0 0 SUBROUTINE GENERIC) (UNKNOWN 0 0 0 UNKNOWN ()) 21 0 (22 23
24 25 26 27 28 29 30 31) () 0 () () () 0 0)
26 'db' '' 'db' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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
27 'sq' '' 'sq' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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
24 'bu' '' 'bu' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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
28 'vder' '' 'vder' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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) (
29 'nit' '' 'nit' 21 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
22 'xind' '' 'xind' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
23 'r' '' 'r' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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)
25 'dbun' '' 'dbun' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
30 'n' '' 'n' 21 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 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) (
31 'infr' '' 'infr' 21 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
6 'xx' '' 'xx' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 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)
11 'db' '' 'db' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
8 'f' '' 'f' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY)
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
9 'r' '' 'r' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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 0 0
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
18 'n' '' 'n' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) (
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
11 'db' '' 'db' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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 0 0
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
13 'bb' '' 'bb' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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)
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)
15 'da' '' 'da' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
19 'nit' '' 'nit' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY)
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
14 'a' '' 'a' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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 0 0
DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
15 'da' '' 'da' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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)
18 'n' '' 'n' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
19 'nit' '' 'nit' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
16 'vder' '' 'vder' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
17 'm' '' 'm' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) (
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
20 'infr' '' 'infr' 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)

@ -392,7 +392,7 @@ C
MODULE MREGMOD
IMPLICIT NONE
PRIVATE
PUBLIC :: RIND,MREG, FI
PUBLIC :: RIND, MREG, FI
INTERFACE RIND
MODULE PROCEDURE RIND

@ -1,5 +1,5 @@
GFORTRAN module version '0' created from mregmodule.f on Tue Jan 25 23:52:18 2011
MD5:447301769c212f228b6cfa086ba1d48a -- If you edit this, you'll get what you deserve.
GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:60519873a9b0b44a975f51ae49005353 -- If you edit this, you'll get what you deserve.
(() () () () () () () () () () () () () () () () () () () () () () () ()
() () ())
@ -12,24 +12,26 @@ MD5:447301769c212f228b6cfa086ba1d48a -- If you edit this, you'll get what you de
()
()
(2 'h' 'quadrmod' 'h' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
UNKNOWN DIMENSION DATA) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (
UNKNOWN 0 0 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)
UNKNOWN 0 0) (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)
UNKNOWN 0 0 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 (
UNKNOWN IMPLICIT-SAVE 0 0) (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)
UNKNOWN-PROC UNKNOWN UNKNOWN 0 0) (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 (
UNKNOWN 0 0 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)
)

@ -1,5 +1,5 @@
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.
GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:c272ea8a24ebb29c49c7755fa1ba58fd -- If you edit this, you'll get what you deserve.
(() () () () () () () () () () () () () () () () () () () () () () () ()
() () ())
@ -12,12 +12,14 @@ MD5:ea81a0bf9bc67a6cbf4024dcd57f4ee3 -- If you edit this, you'll get what you de
()
()
(2 'c' 'rintmod' 'c' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
EXPLICIT-SAVE) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
EXPLICIT-SAVE 0 0) (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)
EXPLICIT-SAVE 0 0) (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)
UNKNOWN UNKNOWN 0 0) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () () () 0 0)
)
('c' 0 2 'fc' 0 3 'rintmod' 0 4)

@ -1,5 +1,5 @@
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.
GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:9fbc3ee9bf9bf359ed3c3cd78067ab58 -- If you edit this, you'll get what you deserve.
(() () () () () () () () () () () () () () () () () () () () () () () ()
() () ())
@ -12,17 +12,19 @@ MD5:b8c9fdc908b66b228beb64d8a241e2e6 -- If you edit this, you'll get what you de
()
()
(2 'mmax' 'sizemod' 'mmax' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC
UNKNOWN IMPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () (CONSTANT (
UNKNOWN IMPLICIT-SAVE 0 0) (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 (
UNKNOWN IMPLICIT-SAVE 0 0) (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 (
UNKNOWN IMPLICIT-SAVE 0 0) (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)
UNKNOWN UNKNOWN 0 0) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () () () 0 0)
)
('mmax' 0 2 'nmax' 0 3 'rdim' 0 4 'sizemod' 0 5)

@ -1,5 +1,5 @@
GFORTRAN module version '0' created from dsvdc.f on Tue Jan 25 20:12:18 2011
MD5:504db75f3667c360354623f37288fa05 -- If you edit this, you'll get what you deserve.
GFORTRAN module version '4' created from dsvdc.f on Tue May 24 14:34:21 2011
MD5:324936151a800ce072449221cf8c2383 -- If you edit this, you'll get what you deserve.
(() () () () () () () () () () () () () () () () () () () () () () () ()
() () ())
@ -12,80 +12,82 @@ MD5:504db75f3667c360354623f37288fa05 -- If you edit this, you'll get what you de
()
()
(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)
IMPLICIT-SAVE 0 0) (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)
UNKNOWN 0 0 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)
UNKNOWN 0 0 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)
UNKNOWN 0 0 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)
UNKNOWN 0 0 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) (
PROCEDURE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 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)
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) (
UNKNOWN 0 0) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () () () 0 0)
30 'dx' '' 'dx' 28 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (
INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
31 'dy' '' 'dy' 28 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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 0 0 DUMMY) (
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
15 'ds' '' 'ds' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
9 's' '' 's' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) (
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
29 'n' '' 'n' 28 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
5 'n' '' 'n' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) (
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
30 'dx' '' 'dx' 28 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
6 'dx' '' 'dx' 4 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (
INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
31 'dy' '' 'dy' 28 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN
7 'dy' '' 'dy' 4 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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)
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)
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) (
21 's' '' 's' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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 0 0
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 0 0
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)
24 'v' '' 'v' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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 0 0
DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
26 'info' '' 'info' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
18 'x' '' 'x' 17 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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 0 0 DUMMY) (
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
20 'p' '' 'p' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
20 'p' '' 'p' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) (
INTEGER 4 0 0 INTEGER ()) 0 0 () () 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)
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)
25 'job' '' 'job' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (
15 'ds' '' 'ds' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY)
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
12 'da' '' 'da' 11 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
13 'db' '' 'db' 11 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
14 'dc' '' 'dc' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY)
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
29 'n' '' 'n' 28 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 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)
)
('dp' 0 2 'drot1' 0 3 'drotg' 0 10 'dsvdc' 0 16 'dswap1' 0 27

@ -1,8 +1,10 @@
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.
GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:1ca9424273ef49cacfd88e3bffcc7949 -- If you edit this, you'll get what you deserve.
(() () () () () () ()
() () () () () () () () () () () () () () () () () () () ())
(() () () () () () () () () () () () () () () () () () () () () () ()
() () () ())
()
()
@ -13,22 +15,22 @@ MD5:43d81dd7165fa3666db9131e212144f1 -- If you edit this, you'll get what you de
()
(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)
UNKNOWN 0 0 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 (
UNKNOWN IMPLICIT-SAVE 0 0) (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 (
UNKNOWN IMPLICIT-SAVE 0 0) (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 (
UNKNOWN IMPLICIT-SAVE 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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)
UNKNOWN UNKNOWN 0 0) (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)

@ -30,6 +30,12 @@ try:
except ImportError:
warnings.warn('Compile the c_library.pyd again!')
c_library = None
try:
from wafo import cov2mod
except ImportError:
warnings.warn('Compile the cov2mod.pyd again!')
cov2mod = None
#from wafo.transform import TrData
from wafo.transform.models import TrLinear
@ -255,8 +261,8 @@ def plotspec(specdata, linetype='b-', flag=1):
spectype = specdata.type.lower()
stype = spectype[-3::]
if stype in ('enc','req','k1d') : #1D plot
Fn = freq[-1] # Nyquist frequency
if stype in ('enc', 'req', 'k1d') : #1D plot
Fn = freq[-1] # Nyquist frequency
indm = findpeaks(data, n=4)
maxS = data.max()
# if isfield(S,'CI') && ~isempty(S.CI),
@ -266,19 +272,19 @@ def plotspec(specdata, linetype='b-', flag=1):
Fp = freq[indm]# %peak frequency/wave number
if len(indm)==1:
if len(indm) == 1:
txt = [('fp = %0.2g' % Fp) + funit]
else:
txt = []
for i,fp in enumerate(Fp.tolist()):
txt.append(('fp%d = %0.2g' % (i,fp)) + funit)
for i, fp in enumerate(Fp.tolist()):
txt.append(('fp%d = %0.2g' % (i, fp)) + funit)
if (flag == 3):
plotbackend.subplot(2,1,1)
if (flag == 1) or (flag ==3):#% Plot in normal scale
plotbackend.plot(np.vstack([Fp, Fp]),np.vstack([zeros(len(indm)), data.take(indm)]),':',
freq,data,linetype)
plotbackend.subplot(2, 1, 1)
if (flag == 1) or (flag == 3):#% Plot in normal scale
plotbackend.plot(np.vstack([Fp, Fp]), np.vstack([zeros(len(indm)), data.take(indm)]), ':',
freq, data, linetype)
# if isfield(S,'CI'),
# plot(freq,S.S*S.CI(1), 'r:' )
@ -287,29 +293,29 @@ def plotspec(specdata, linetype='b-', flag=1):
a = plotbackend.axis()
a1 = Fn
if (Fp>0):
a1 = max(min(Fn,10*max(Fp)),a[1]);
if (Fp > 0):
a1 = max(min(Fn, 10 * max(Fp)), a[1]);
plotbackend.axis([0, a1 ,0, max(1.01*maxS,a[3])])
plotbackend.axis([0, a1 , 0, max(1.01 * maxS, a[3])])
plotbackend.title('Spectral density')
plotbackend.xlabel(xlbl_txt)
plotbackend.ylabel(ylbl1_txt )
plotbackend.ylabel(ylbl1_txt)
if (flag==3):
plotbackend.subplot(2,1,2)
if (flag == 3):
plotbackend.subplot(2, 1, 2)
if (flag == 2) or (flag ==3) : # Plot in logaritmic scale
ind = np.flatnonzero(data>0)
if (flag == 2) or (flag == 3) : # Plot in logaritmic scale
ind = np.flatnonzero(data > 0)
plotbackend.plot(np.vstack([Fp,Fp]),np.vstack((min(10*log10(data.take(ind)/maxS)).repeat(len(Fp)),
10*log10(data.take(indm)/maxS))),':')
plotbackend.plot(np.vstack([Fp, Fp]), np.vstack((min(10 * log10(data.take(ind) / maxS)).repeat(len(Fp)),
10 * log10(data.take(indm) / maxS))), ':')
# hold on
# if isfield(S,'CI'),
# plot(freq(ind),10*log10(S.S(ind)*S.CI(1)/maxS), 'r:' )
# plot(freq(ind),10*log10(S.S(ind)*S.CI(2)/maxS), 'r:' )
# end
plotbackend.plot(freq[ind],10*log10(data[ind]/maxS),linetype)
plotbackend.plot(freq[ind], 10 * log10(data[ind] / maxS), linetype)
# if ih, a=axis; else a=[0 0 0 0]; end
# axis([0 max(min(Fn,max(10*Fp)),a(2)) -20 max(1.01*10*log10(1),a(4))]) % log10(maxS)
@ -650,14 +656,14 @@ class SpecData1D(WafoData):
def __init__(self, *args, **kwds):
self.name_ = kwds.pop('name', 'WAFO Spectrum Object')
self.type = kwds.pop('type','freq')
self.freqtype = kwds.pop('freqtype','w')
self.type = kwds.pop('type', 'freq')
self.freqtype = kwds.pop('freqtype', 'w')
self.angletype = ''
self.h = kwds.pop('h',inf)
self.tr = kwds.pop('tr',None) #TrLinear()
self.phi = kwds.pop('phi',0.0)
self.v = kwds.pop('v',0.0)
self.norm = kwds.pop('norm',False)
self.h = kwds.pop('h', inf)
self.tr = kwds.pop('tr', None) #TrLinear()
self.phi = kwds.pop('phi', 0.0)
self.v = kwds.pop('v', 0.0)
self.norm = kwds.pop('norm', False)
super(SpecData1D, self).__init__(*args, **kwds)
self.setlabels()
@ -1113,7 +1119,114 @@ class SpecData1D(WafoData):
return SL, SN
def to_mm_pdf(self, paramt=None, paramu=None, utc=None, nit=2, EPS=5e-5,
EPSS=1e-6, C=4.5, EPS0=1e-5, IAC=1, ISQ=0, verbose=False):
'''
nit = order of numerical integration: 0,1,2,3,4,5.
paramu = parameter vector defining discretization of min/max values.
t = grid of time points between maximum and minimum (to
integrate out). interval between maximum and the following
minimum,
The variable ISQ marks which type of conditioning will be used ISQ=0
means random time where the probability is minimum, ISQ=1 is the time
where the variance of the residual process is minimal(ISQ=1 is faster).
NIT, IAC are described in CROSSPACK paper, EPS0 is the accuracy constant
used in choosing the number of nodes in numerical integrations
(XX1, H1 vectors). The nodes and weights and other parameters are
read in the subroutine INITINTEG from files Z.DAT, H.DAT and ACCUR.DAT.
NIT=0, IAC=1 then one uses RIND0 - subroutine, all other cases
goes through RIND1, ...,RIND5. NIT=0, here means explicite formula
approximation for XIND=E[Y^+1{ HH<BU(I)<0 for all I, I=1,...,N}], where
BU(I) is deterministic function.
NIT=1, leads tp call RIND1, IAC=0 is also explicit form approximation,
while IAC=1 leads to maximum one dimensional integral.
.......
NIT=5, leads tp call RIND5, IAC is maximally 4-dimensional integral,
while IAC=1 leads to maximum 5 dimensional integral.
'''
S = self.copy()
S.normalize()
m, unused_mtxt = self.moment(nr=4, even=True)
A = sqrt(m[0] / m[1])
if paramt is None:
distanceBetweenExtremes = 5*pi*sqrt(m[1]/m[2]) #(2.5 * mean distance between extremes)
paramt = [0, distanceBetweenExtremes, 43]
if paramu is None:
paramu = [-4*sqrt(m[0]), 4*sqrt(m[0]), 41]
if self.tr is None:
g = TrLinear(var=m[0])
else:
g = self.tr
if utc is None:
utc = g.gauss2dat(0) # most frequent crossed level
# transform reference level into Gaussian level
u = g.dat2gauss(utc)
if verbose:
print('The level u for Gaussian process = %g' % u)
unused_t0, tn, Nt = paramt
t = linspace(0, tn/A, Nt) # normalized times
#Transform amplitudes to Gaussian levels:
h = linspace(*paramu);
dt = t[1] - t[0]
nr = 4
R = S.tocov_matrix(nr, Nt-1, dt)
#ulev = linspace(*paramu)
#vlev = linspace(*paramu)
trdata = g.trdata()
Tg = trdata.args
Xg = trdata.data
cov2mod.initinteg(EPS, EPSS, EPS0, C, IAC, ISQ)
uvdens = cov2mod.cov2mmpdfreg(t, R, h, h, Tg, Xg, nit)
dh = h[1]-h[0]
uvdens *= dh*dh
# if (defnr==0)
# f.f =fliplr(mctp2rfc(fliplr(ftmp)));%* sqrt(-R(1,6)/R(1,4))/2/pi;
# f.title ='Joint density of maximum and rainflow minimum';
# f.labx{1}='max [m]';
# f.labx{2}='rainflow min [m]';
# elseif (defnr==-1)
# %CC= normalizing constant= 1/ expected number of u-up-crossings of X
# %CC = 2*pi*sqrt(L0/L2)*exp(0.5D0*u*u/L0);
# % CC = normalizing constant = 1/ expected number of zero-up-crossings of X'
# %CC = 2*pi*sqrt(L2/L4);
# fact = sqrt(L0/L4);
#
# f.f = fliplr(mctp2tc(fliplr(ftmp*fact),utc,paramu));
# index1 = find(f.x{1}>0);
# index2 = find(f.x{2}<0);
# f.f = flipud(f.f(index2,index1));
# f.x{1} = f.x{1}(index1);
# f.x{2} = abs(flipud(f.x{2}(index2)));
# f.title ='Joint density of crest and trough';
# f.labx{1}='Crest [m]';
# f.labx{2}='Trough [m]';
# else %(defnr==1)
mmpdf = WafoData(uvdens,args=(h,h), title='Joint density of maximum and minimum',
xlab='max [m]',ylab='min [m]')
return mmpdf
#[f.cl,f.pl] = qlevels(f.f,[10, 30, 50, 70, 90, 95, 99, 99.9],f.x{1},f.x{2})
def to_t_pdf(self, u=None, pdef='Tc', paramt=None, **options):
'''
Density of crest/trough- period or length, version 2.
@ -1254,7 +1367,7 @@ class SpecData1D(WafoData):
indI[3] = Ntd - 1
#% positive wave period
BIG = self._covinput(pt, R)
BIG = self._covinput_t_pdf(pt, R)
tmp = rind(BIG, ex[:Ntdc], B_lo, B_up, indI, xc, Nt)
f[pt], err[pt] = tmp[:2]
@ -1279,7 +1392,7 @@ class SpecData1D(WafoData):
return pdf
def _covinput(self, pt, R):
def _covinput_t_pdf(self, pt, R):
"""
Return covariance matrix for Tc or Tt period problems
@ -1813,7 +1926,7 @@ class SpecData1D(WafoData):
svec = rvec + 1J * ivec
else:
amp = amp.T
svec=[]
svec = []
for i in range(cases):
rvec, ivec = c_library.disufq(amp[i].real, amp[i].imag, w, kw, water_depth,
g, nmin, nmax, 1, ns)
@ -2329,7 +2442,7 @@ class SpecData1D(WafoData):
#%wnc = min(wnNew,wnOld-1e-5)
wnc = wnNew
#specfun = lambda xi : stineman_interp(xi, w, S1)
specfun = interpolate.interp1d(w,S1, kind='cubic')
specfun = interpolate.interp1d(w, S1, kind='cubic')
x, unused_y = discretize(specfun, 0, wnc)
dwMin = minimum(min(diff(x)), dwMin)
@ -2437,9 +2550,9 @@ class SpecData1D(WafoData):
'''
m, unused_mtxt = self.moment(nr=4, even=False)
fact_dict=dict(alpha=0,eps2=1,eps4=3,qp=3,Qp=3)
fun = lambda fact: fact_dict.get(fact,fact)
fact = atleast_1d(map(fun,list(factors)))
fact_dict = dict(alpha=0, eps2=1, eps4=3, qp=3, Qp=3)
fun = lambda fact: fact_dict.get(fact, fact)
fact = atleast_1d(map(fun, list(factors)))
#fact = atleast_1d(fact)
alpha = m[2] / sqrt(m[0] * m[4])
@ -2793,13 +2906,13 @@ class SpecData2D(WafoData):
def toacf(self):
pass
def tospecdata(self,type=None):
def tospecdata(self, type=None):
pass
def sim(self):
pass
def sim_nl(self):
pass
def rotate(self, phi=0,rotateGrid=False,method='linear'):
def rotate(self, phi=0, rotateGrid=False, method='linear'):
'''
Rotate spectrum clockwise around the origin.
@ -2837,58 +2950,58 @@ class SpecData2D(WafoData):
#Snew=S;
self.phi = mod(self.phi+phi+pi,2*pi)-pi
self.phi = mod(self.phi + phi + pi, 2 * pi) - pi
stype = self.type.lower()[-3::]
if stype=='dir':
if stype == 'dir':
#% any of the directinal types
#% Make sure theta is from -pi to pi
theta = self.args[0]
phi0 = theta[0]+pi;
self.args[0] = theta-phi0
phi0 = theta[0] + pi;
self.args[0] = theta - phi0
# make sure -pi<phi<pi
self.phi = mod(self.phi+phi0+pi,2*pi)-pi
if (rotateGrid and (self.phi!=0)):
self.phi = mod(self.phi + phi0 + pi, 2 * pi) - pi
if (rotateGrid and (self.phi != 0)):
# Do a physical rotation of spectrum
#theta = Snew.args[0]
ntOld = len(theta);
if (mod(theta[0]-theta[-1],2*pi)==0):
nt = ntOld-1
if (mod(theta[0] - theta[-1], 2 * pi) == 0):
nt = ntOld - 1
else:
nt = ntOld
theta[0:nt] = mod(theta[0:nt]-self.phi+pi,2*pi)-pi
theta[0:nt] = mod(theta[0:nt] - self.phi + pi, 2 * pi) - pi
self.phi = 0
ind = theta.argsort()
self.data = self.data[ind,:]
self.data = self.data[ind, :]
self.args[0] = theta[ind]
if (nt<ntOld):
if (self.args[0][0]==-pi):
self.data[ntOld,:] = self.data[0,:]
if (nt < ntOld):
if (self.args[0][0] == -pi):
self.data[ntOld, :] = self.data[0, :]
else:
#ftype = self.freqtype
freq = self.args[1]
theta = linspace(-pi,pi,ntOld)
[F,T] = meshgrid(freq,theta)
freq = self.args[1]
theta = linspace(-pi, pi, ntOld)
[F, T] = meshgrid(freq, theta)
dtheta = self.theta[1]-self.theta[0]
self.theta[nt] = self.theta[nt-1]+dtheta;
self.data[nt,:] = self.data[0,:]
self.data = interp2(freq,np.vstack([self.theta[0]-dtheta,self.theta]),
np.vstack([self.data[nt,:],self.data]),F,T,method)
dtheta = self.theta[1] - self.theta[0]
self.theta[nt] = self.theta[nt - 1] + dtheta;
self.data[nt, :] = self.data[0, :]
self.data = interp2(freq, np.vstack([self.theta[0] - dtheta, self.theta]),
np.vstack([self.data[nt, :], self.data]), F, T, method)
self.args[0] = theta
elif stype=='k2d':
elif stype == 'k2d':
#any of the 2D wave number types
#Snew.phi = mod(Snew.phi+phi+pi,2*pi)-pi;
if (rotateGrid and (self.phi!=0)):
if (rotateGrid and (self.phi != 0)):
# Do a physical rotation of spectrum
[k,k2] = meshgrid(*self.args)
[th,r] = cart2pol(k,k2)
[k,k2] = pol2cart(th+self.phi,r)
[k, k2] = meshgrid(*self.args)
[th, r] = cart2pol(k, k2)
[k, k2] = pol2cart(th + self.phi, r)
ki1, ki2 = self.args
Sn = interp2(ki1,ki2,self.data,k,k2,method)
Sn = interp2(ki1, ki2, self.data, k, k2, method)
self.data = np.where(np.isnan(Sn), 0, Sn)
self.phi = 0;
@ -2958,107 +3071,107 @@ class SpecData2D(WafoData):
if self.type not in two_dim_spectra:
raise ValueError('Unknown 2D spectrum type!')
if vari==None and nr<=1:
vari='x'
elif vari==None:
vari='xt'
if vari == None and nr <= 1:
vari = 'x'
elif vari == None:
vari = 'xt'
else: #% secure the mutual order ('xyt')
vari=''.join(sorted(vari.lower()))
Nv=len(vari)
vari = ''.join(sorted(vari.lower()))
Nv = len(vari)
if vari[0]=='t' and Nv>1:
vari = vari[1::]+ vari[0]
if vari[0] == 't' and Nv > 1:
vari = vari[1::] + vari[0]
Nv = len(vari)
if not self.type.endswith('dir'):
S1 = self.tospecdata(self.type[:-2]+'dir')
S1 = self.tospecdata(self.type[:-2] + 'dir')
else:
S1 = self
w = ravel(S1.args[0])
theta = S1.args[1]-S1.phi
theta = S1.args[1] - S1.phi
S = S1.data
Sw = simps(S,x=theta,axis=0)
m = [simps(Sw,x=w)]
mtext=['m0']
Sw = simps(S, x=theta, axis=0)
m = [simps(Sw, x=w)]
mtext = ['m0']
if nr>0:
if nr > 0:
vec = []
g = np.atleast_1d(S1.__dict__.get('g', gravity()))
kx=w**2/g[0] # maybe different normalization in x and y => diff. g
ky=w**2/g[-1]
kx = w ** 2 / g[0] # maybe different normalization in x and y => diff. g
ky = w ** 2 / g[-1]
nw=w.size
nw = w.size
if 'x' in vari:
ct = np.cos(theta[:,None])
Sc = simps(S*ct,x=theta, axis=0)
vec.append(kx*Sc)
ct = np.cos(theta[:, None])
Sc = simps(S * ct, x=theta, axis=0)
vec.append(kx * Sc)
mtext.append('mx')
if 'y' in vari:
st = np.sin(theta[:,None])
Ss = simps(S*st,x=theta, axis=0)
vec.append(ky*Ss)
st = np.sin(theta[:, None])
Ss = simps(S * st, x=theta, axis=0)
vec.append(ky * Ss)
mtext.append('my')
if 't' in vari:
vec.append(w*Sw)
vec.append(w * Sw)
mtext.append('mt')
if nr>1:
if nr > 1:
if 'x' in vari:
Sc2 = simps(S*ct**2,x=theta, axis=0)
vec.append(kx**2*Sc2)
Sc2 = simps(S * ct ** 2, x=theta, axis=0)
vec.append(kx ** 2 * Sc2)
mtext.append('mxx')
if 'y' in vari:
Ss2 = simps(S*st**2,x=theta, axis=0)
vec.append(ky**2*Ss2)
Ss2 = simps(S * st ** 2, x=theta, axis=0)
vec.append(ky ** 2 * Ss2)
mtext.append('myy')
if 't' in vari:
vec.append(w**2*Sw)
vec.append(w ** 2 * Sw)
mtext.append('mtt')
if 'x' in vari and 'y' in vari:
Scs = simps(S*ct*st,x=theta, axis=0)
vec.append(kx*ky*Scs)
Scs = simps(S * ct * st, x=theta, axis=0)
vec.append(kx * ky * Scs)
mtext.append('mxy')
if 'x' in vari and 't' in vari:
vec.append(kx*w*Sc)
vec.append(kx * w * Sc)
mtext.append('mxt')
if 'y' in vari and 't' in vari:
vec.append(ky*w*Sc)
vec.append(ky * w * Sc)
mtext.append('myt')
if nr>3:
if nr > 3:
if 'x' in vari:
Sc3 = simps(S*ct**3,x=theta, axis=0)
Sc4 = simps(S*ct**4,x=theta, axis=0)
vec.append(kx**4*Sc4)
Sc3 = simps(S * ct ** 3, x=theta, axis=0)
Sc4 = simps(S * ct ** 4, x=theta, axis=0)
vec.append(kx ** 4 * Sc4)
mtext.append('mxxxx')
if 'y' in vari:
Ss3 = simps(S*st**3,x=theta, axis=0)
Ss4 = simps(S*st**4,x=theta, axis=0)
vec.append(ky**4*Ss4)
Ss3 = simps(S * st ** 3, x=theta, axis=0)
Ss4 = simps(S * st ** 4, x=theta, axis=0)
vec.append(ky ** 4 * Ss4)
mtext.append('myyyy')
if 't' in vari:
vec.append(w**4*Sw)
vec.append(w ** 4 * Sw)
mtext.append('mtttt')
if 'x' in vari and 'y' in vari:
Sc2s = simps(S*ct**2*st,x=theta, axis=0)
Sc3s = simps(S*ct**3*st,x=theta, axis=0)
Scs2 = simps(S*ct*st**2,x=theta, axis=0)
Scs3 = simps(S*ct*st**3,x=theta, axis=0)
Sc2s2 = simps(S*ct**2*st**2,x=theta, axis=0)
vec.extend((kx**3*ky*Sc3s,kx**2*ky**2*Sc2s2, kx*ky**3*Scs3))
mtext.extend(('mxxxy','mxxyy','mxyyy'))
Sc2s = simps(S * ct ** 2 * st, x=theta, axis=0)
Sc3s = simps(S * ct ** 3 * st, x=theta, axis=0)
Scs2 = simps(S * ct * st ** 2, x=theta, axis=0)
Scs3 = simps(S * ct * st ** 3, x=theta, axis=0)
Sc2s2 = simps(S * ct ** 2 * st ** 2, x=theta, axis=0)
vec.extend((kx ** 3 * ky * Sc3s, kx ** 2 * ky ** 2 * Sc2s2, kx * ky ** 3 * Scs3))
mtext.extend(('mxxxy', 'mxxyy', 'mxyyy'))
if 'x' in vari and 't' in vari:
vec.extend((kx**3*w*Sc3, kx**2*w**2*Sc2, kx*w**3*Sc))
mtext.extend(('mxxxt','mxxtt','mxttt'))
vec.extend((kx ** 3 * w * Sc3, kx ** 2 * w ** 2 * Sc2, kx * w ** 3 * Sc))
mtext.extend(('mxxxt', 'mxxtt', 'mxttt'))
if 'y' in vari and 't' in vari:
vec.extend((ky**3*w*Ss3, ky**2*w**2*Ss2, ky*w**3*Ss))
mtext.extend(('myyyt','myytt','myttt'))
vec.extend((ky ** 3 * w * Ss3, ky ** 2 * w ** 2 * Ss2, ky * w ** 3 * Ss))
mtext.extend(('myyyt', 'myytt', 'myttt'))
if 'x' in vari and 'y' in vari and 't' in vari:
vec.extend((kx**2*ky*w*Sc2s, kx*ky**2*w*Scs2, kx*ky*w**2*Scs))
mtext.extend(('mxxyt','mxyyt','mxytt'))
vec.extend((kx ** 2 * ky * w * Sc2s, kx * ky ** 2 * w * Scs2, kx * ky * w ** 2 * Scs))
mtext.extend(('mxxyt', 'mxyyt', 'mxytt'))
#end % if nr>1
m.extend([simps(vals, x=w) for vals in vec])
return np.asarray(m), mtext

Loading…
Cancel
Save