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 import os
def compile_all(): def compile_all():
files = ['dsvdc','mregmodule'] files = ['dsvdc','mregmodule', 'intfcmod']
compile1_format = 'gfortran -fPIC -c %s.f' compile1_format = 'gfortran -fPIC -c %s.f'
format1 = '%s.o ' * len(files) format1 = '%s.o ' * len(files)
for file in 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 GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:9338abc0e14d4bf13175cb874e9f7ea5 -- If you edit this, you'll get what you deserve. 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 (2 'checkmod' 'checkmod' 'checkmod' 1 ((MODULE UNKNOWN-INTENT
UNKNOWN-PROC UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () UNKNOWN-PROC UNKNOWN UNKNOWN 0 0) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0
() () 0 0) () () () 0 0)
3 'iii0' 'checkmod' 'iii0' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC 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 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 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 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 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 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 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 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 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 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 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 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' ('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 ! -renamed from sp2mmpdfreg to cov2mmpdfreg
PROGRAM cov2mmpdfreg PROGRAM cov2mmpdfreg
USE SIZEMOD USE SIZEMOD
USE EPSMOD USE EPSMOD
USE CHECKMOD USE CHECKMOD
USE MREGMOD USE MREGMOD
IMPLICIT NONE IMPLICIT NONE
real*8 Q0,SQ0,Q1,SQ1, AA, BB, DAI, AI , U,V,VV, XL0, XL2, XL4 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 C INTEGER, PARAMETER :: MMAX = 5, NMAX = 101, RDIM = 10201
REAL*8, DIMENSION(NMAX) :: HHT,T,Ulev,Vlev,VT,UT,Vdd,Udd REAL*8, DIMENSION(NMAX) :: HHT,T,Ulev,Vlev,VT,UT,Vdd,Udd
REAL*8, DIMENSION(RDIM) :: R,R1,R2,R3 REAL*8, DIMENSION(RDIM) :: R,R1,R2,R3
REAL*8, DIMENSION(5*NMAX) :: COV REAL*8, DIMENSION(5*NMAX) :: COV
REAL*8, DIMENSION(NMAX,NMAX) :: UVdens REAL*8, DIMENSION(NMAX,NMAX) :: UVdens
C DIMENSION UVdens(NMAX,NMAX),HHT(NMAX) C DIMENSION UVdens(NMAX,NMAX),HHT(NMAX)
C DIMENSION T(NMAX),Ulev(NMAX),Vlev(NMAX) C DIMENSION T(NMAX),Ulev(NMAX),Vlev(NMAX)
C DIMENSION VT(NMAX),UT(NMAX),Vdd(NMAX),Udd(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 input epsu. The principle is that the integral of the marginal density
C of f_Max is computed with sufficient accuracy. C of f_Max is computed with sufficient accuracy.
C C
REAL*8, DIMENSION(NMAX) :: B0,DB0,DDB0,B1,DB1,DDB1,DB2,DDB2 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) :: Q,SQ,VDER,DBI,BI
C DIMENSION B0(NMAX),DB0(NMAX),DDB0(NMAX) C DIMENSION B0(NMAX),DB0(NMAX),DDB0(NMAX)
C DIMENSION B1(NMAX),DB1(NMAX),DDB1(NMAX) C DIMENSION B1(NMAX),DB1(NMAX),DDB1(NMAX)
C DIMENSION DB2(NMAX),DDB2(NMAX) C DIMENSION DB2(NMAX),DDB2(NMAX)
C DIMENSION Q(NMAX),SQ(NMAX),VDER(NMAX),DBI(NMAX),BI(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 :: J,I,I1,I2,I3,IU, IV, NU,NV,NG,N,NIT, NNIT, INF
INTEGER :: fffff INTEGER :: fffff
C REAL*8 EPS0 C REAL*8 EPS0
C INTEGER III01,III11,III21,III31,III41,III51 C INTEGER III01,III11,III21,III31,III41,III51
C *,III61,III71,III81,III91,III101 , III0 C *,III61,III71,III81,III91,III101 , III0
@ -316,16 +316,16 @@ C 105 continue
END END
SUBROUTINE INITLEVELS(ULEVELS,NU,Vlevels,Nv,T,HT,N,TG,XG,NG) SUBROUTINE INITLEVELS(ULEVELS,NU,Vlevels,Nv,T,HT,N,TG,XG,NG)
USE TBRMOD USE TBRMOD
USE SIZEMOD USE SIZEMOD
IMPLICIT NONE IMPLICIT NONE
C INTEGER, PARAMETER:: NMAX = 101, RDIM = 10201 C INTEGER, PARAMETER:: NMAX = 101, RDIM = 10201
C DIMENSION ULEVELS(1),Vlevels(1),T(1),HT(1),TG(1),XG(1),HH(101) 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(NMAX), intent(inout) :: ULEVELS,Vlevels,T,HT
REAL*8, DIMENSION(RDIM), intent(inout) :: TG,XG REAL*8, DIMENSION(RDIM), intent(inout) :: TG,XG
INTEGER, intent(inout) :: NG INTEGER, intent(inout) :: NG
REAL*8 :: UMIN,UMAX,VMIN,VMAX, HU,HV REAL*8 :: UMIN,UMAX,VMIN,VMAX, HU,HV
integer :: N, I, NU, NV integer :: N, I, NU, NV
C REAL*8, DIMENSION(NMAX) :: HH C REAL*8, DIMENSION(NMAX) :: HH
C COMMON/TBR/HH C COMMON/TBR/HH
OPEN(UNIT=2,FILE='transf.in') 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 VALUE is a value of a function at T, i.e. VALUE=G(T).
c DER=G'(t) c DER=G'(t)
C C
USE SIZEMOD USE SIZEMOD
IMPLICIT NONE IMPLICIT NONE
REAL*8, intent(inout):: VALUE, DER,T REAL*8, intent(inout):: VALUE, DER,T
C INTEGER, PARAMETER :: RDIM = 10201 C INTEGER, PARAMETER :: RDIM = 10201
REAL*8, DIMENSION(RDIM), intent(in) :: A,TIMEV REAL*8, DIMENSION(RDIM), intent(in) :: A,TIMEV
integer, intent(in) :: N integer, intent(in) :: N
REAL*8:: T1 REAL*8:: T1
integer :: I integer :: I
IF (T.LT.TIMEV(1)) then IF (T.LT.TIMEV(1)) then
der=(A(2)-A(1))/(TIMEV(2)-TIMEV(1)) der=(A(2)-A(1))/(TIMEV(2)-TIMEV(1))
@ -455,7 +455,7 @@ C INTEGER, PARAMETER :: RDIM = 10201
RETURN RETURN
END END
REAL*8 FUNCTION SPLE(N,T,A,TIMEV) REAL*8 FUNCTION SPLE(N,T,A,TIMEV)
C C
C N number of data points C N number of data points
C TIME vector of time 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 SPLE is a value of a function at T, i.e. SPLE=G(T).
C C
USE SIZEMOD USE SIZEMOD
IMPLICIT NONE IMPLICIT NONE
INTEGER, INTENT(IN):: N 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, DIMENSION(5*NMAX), INTENT(IN) :: A,TIMEV
REAL*8 :: T1 REAL*8 :: T1
INTEGER :: I INTEGER :: I
SPLE=-9.9d0 SPLE=-9.9d0
IF (T.LT.TIMEV(1) .OR. T.GT.TIMEV(N)) RETURN IF (T.LT.TIMEV(1) .OR. T.GT.TIMEV(N)) RETURN
DO 5 I=2,N DO 5 I=2,N
@ -500,15 +500,15 @@ C
USE SIZEMOD USE SIZEMOD
! IMPLICIT NONE ! IMPLICIT NONE
C INTEGER, PARAMETER:: NMAX = 101, RDIM = 10201 C INTEGER, PARAMETER:: NMAX = 101, RDIM = 10201
REAL*8, PARAMETER:: ZERO = 0.0d0 REAL*8, PARAMETER:: ZERO = 0.0d0
REAL*8, intent(inout) :: XL0,XL2,XL4 REAL*8, intent(inout) :: XL0,XL2,XL4
REAL*8, DIMENSION(5*NMAX), intent(inout) :: COV REAL*8, DIMENSION(5*NMAX), intent(inout) :: COV
REAL*8, DIMENSION(5*NMAX) :: A, TIMEV REAL*8, DIMENSION(5*NMAX) :: A, TIMEV
REAL*8, DIMENSION(RDIM), intent(inout) :: COV1,COV2,COV3 REAL*8, DIMENSION(RDIM), intent(inout) :: COV1,COV2,COV3
REAL*8, DIMENSION(NMAX), intent(in) :: T REAL*8, DIMENSION(NMAX), intent(in) :: T
INTEGER, intent(in) :: N INTEGER, intent(in) :: N
integer :: NT, I, J, II integer :: NT, I, J, II
REAL*8 :: TT, T0 REAL*8 :: TT, T0
OPEN(UNIT=32,FILE='Cd0.in') OPEN(UNIT=32,FILE='Cd0.in')
OPEN(UNIT=33,FILE='Cd1.in') OPEN(UNIT=33,FILE='Cd1.in')
OPEN(UNIT=34,FILE='Cd2.in') OPEN(UNIT=34,FILE='Cd2.in')
@ -620,12 +620,12 @@ C 4-DERIVATIVE COV(Y(T),Y(0))
END END
SUBROUTINE INITINTEG(NIT) SUBROUTINE INITINTEG(NIT)
USE RINTMOD USE RINTMOD
USE EPSMOD USE EPSMOD
USE INFCMOD USE INFCMOD
USE MREGMOD USE MREGMOD
! IMPLICIT NONE ! IMPLICIT NONE
INTEGER, intent(inout) :: NIT INTEGER, intent(inout) :: NIT
! INTEGER ISQ1 ! INTEGER ISQ1
C dimension INF(10),INFO(10) C dimension INF(10),INFO(10)

@ -10,26 +10,44 @@ C revised pab July 2007
! -renamed from sp2mmpdfreg to cov2mmpdfreg ! -renamed from sp2mmpdfreg to cov2mmpdfreg
! gfortran -W -Wall -pedantic-errors -fbounds-check -Werror -c dsvdc.f mregmodule.f cov2mmpdfreg.f ! gfortran -W -Wall -pedantic-errors -fbounds-check -Werror -c dsvdc.f mregmodule.f cov2mmpdfreg.f
module cov2mmpdfmod SUBROUTINE INITINTEG(EPS_,EPSS_,EPS0_,C_,IAC_,ISQ_)
IMPLICIT NONE ! Initiation of all constants and integration nodes 'INITINTEG'
PRIVATE USE RINTMOD
PUBLIC cov2mmpdfreg, EPS_, EPSS_, EPS0_, C_, IAC_, ISQ_ USE EPSMOD
DOUBLE PRECISION :: EPS_ = 1.d-2 USE INFCMOD
DOUBLE PRECISION :: EPSS_ = 5.d-5 USE MREGMOD
! used in GAUSSLE1 to implicitly ! determ. # nodes REAL*8 :: EPS_,EPSS_,EPS0_,C_
DOUBLE PRECISION :: EPS0_ = 5.d-5 INTEGER :: IAC_,ISQ_
DOUBLE PRECISION :: C_ = 4.5d0 Cf2py real*8, optional :: EPS_ = 0.01
INTEGER :: IAC_=1 Cf2py real*8, optional :: EPSS_ = 0.00005
INTEGER :: ISQ_=0 Cf2py real*8, optional :: EPS0_ = 0.00005
Cf2py real*8, optional :: C_ = 4.5
contains 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, subroutine cov2mmpdfreg(UVdens,t,COV,ULev,VLev,Tg,Xg,Nt,Nu,Nv,Ng,
! NIT) & NIT)
USE SIZEMOD USE SIZEMOD
USE EPSMOD USE EPSMOD
USE CHECKMOD USE CHECKMOD
USE MREGMOD USE MREGMOD
USE INTFCMOD
IMPLICIT NONE IMPLICIT NONE
INTEGER, INTENT(IN) :: Nt, Nu, Nv, Ng, NIT INTEGER, INTENT(IN) :: Nt, Nu, Nv, Ng, NIT
REAL*8, DIMENSION(Nt,5), intent(in):: COV REAL*8, DIMENSION(Nt,5), intent(in):: COV
@ -46,12 +64,8 @@ Cf2py integer, optional :: NIT = 2
Cf2py real*8, intent(out), depend(Nu,Nv) :: UVdens Cf2py real*8, intent(out), depend(Nu,Nv) :: UVdens
Cf2py depend(Ng) Xg 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 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 C INTEGER, PARAMETER :: MMAX = 5, NMAX = 101, RDIM = 10201
REAL*8, DIMENSION(NMAX) :: HHT,VT,UT,Vdd,Udd REAL*8, DIMENSION(NMAX) :: HHT,VT,UT,Vdd,Udd
REAL*8, DIMENSION(RDIM) :: R,R1,R2,R3 REAL*8, DIMENSION(RDIM) :: R,R1,R2,R3
@ -94,7 +108,7 @@ C COMMON /EPS/ EPS,EPSS,CEPSS
C C
C Initiation of all constants and integration nodes 'INITINTEG' C Initiation of all constants and integration nodes 'INITINTEG'
C C
CALL INITINTEG() ! CALL INITINTEG()
! OPEN(UNIT=8,FILE='min.out') ! OPEN(UNIT=8,FILE='min.out')
! OPEN(UNIT=9,FILE='Max.out') ! OPEN(UNIT=9,FILE='Max.out')
@ -120,7 +134,6 @@ C CALL INITLEVELS(Ulev,NU,Vlev,NV,T,HHT,Nt,R1,R2,NG)
CALL TRANSF(NG,V,Xg,Tg,VALUE,DER) CALL TRANSF(NG,V,Xg,Tg,VALUE,DER)
VT(IV)=VALUE VT(IV)=VALUE
Vdd(IV)=DER Vdd(IV)=DER
14 continue
enddo enddo
DO IU=1,Nu DO IU=1,Nu
U = Ulev(IU) U = Ulev(IU)
@ -129,7 +142,6 @@ C CALL INITLEVELS(Ulev,NU,Vlev,NV,T,HHT,Nt,R1,R2,NG)
Udd(IU) = DER Udd(IU) = DER
do IV=1,Nv do IV=1,Nv
UVdens(IU,IV)=0.0d0 UVdens(IU,IV)=0.0d0
16 CONTINUE
enddo enddo
enddo enddo
@ -183,7 +195,7 @@ C
VDER(I)=VDER(I) - (DDB2(I)*DDB2(I))/Q(I) VDER(I)=VDER(I) - (DDB2(I)*DDB2(I))/Q(I)
end if end if
10 CONTINUE c10 CONTINUE
enddo enddo
DO I=1,Nt DO I=1,Nt
DO J=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 C
R3(J+(I-1)*N) = R3(J+(I-1)*N) - COV(I,4)*(COV(J,3)/XL2) 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) 1 - DB0(J)*(DDB0(I)/Q0) - DDB1(I)*(DB1(J)/Q1)
15 CONTINUE c15 CONTINUE
enddo enddo
enddo enddo
@ -221,20 +233,17 @@ 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 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)) C DDB2(I) contains Cov(X''(T(i)),X(T(i))|X'(0),X''(0),X(0))
30 CONTINUE
enddo enddo
DO I3=1,I DO I3=1,I
DBI(I3) = R3(I3+(I-1)*N) - (DDB2(I)*DB2(I3)/Q(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)) BI(I3) = R2(I3+(I-1)*N) - (DB2(I)*DB2(I3)/Q(I))
50 CONTINUE
enddo enddo
DO I3=1,I-1 DO I3=1,I-1
AI(I3)=0.0d0 AI(I3)=0.0d0
AI(I3+I-1)=DB0(I3)/SQ0 AI(I3+I-1)=DB0(I3)/SQ0
AI(I3+2*(I-1))=DB1(I3)/SQ1 AI(I3+2*(I-1))=DB1(I3)/SQ1
AI(I3+3*(I-1))=DB2(I3)/SQ(I) AI(I3+3*(I-1))=DB2(I3)/SQ(I)
51 CONTINUE
enddo enddo
VDERI=VDER(I) VDERI=VDER(I)
DAI(1)=0.0d0 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 IF(I.LT.1) GO TO 41
DO I1=1,I-1 DO I1=1,I-1
DO I2=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)) 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)) R(I2+(I1-1)*(I-1))=R2(I2+(I1-1)*N)-(DB2(I1)*DB2(I2)/Q(I))
40 CONTINUE
enddo enddo
enddo enddo
41 CONTINUE 41 CONTINUE
@ -327,16 +333,16 @@ C Here the covariance of the problem would be innitiated
C sder=sqrt(XL4-XL2*XL2/XL0) C sder=sqrt(XL4-XL2*XL2/XL0)
C cder=-XL2/sqrt(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 DO 95 IU=1,NU
C U=UT(IU) 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 WRITE(9,300) Ulev(IU),FM
C 95 continue C 95 continue
C DO 105 IV=1,NV C DO 105 IV=1,NV
C V=VT(IV) C V=VT(IV)
C VV=cder*V 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 WRITE(8,300) Vlev(IV),Fm
C 105 continue C 105 continue
if (III0.eq.0) III0=1 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 RINDT9:',float(iii91)/float(III0)
PRINT *, 'Rate of calls RINDT10:',float(iii101)/float(III0) PRINT *, 'Rate of calls RINDT10:',float(iii101)/float(III0)
PRINT *, 'Number of calls of RINDT*',III0 PRINT *, 'Number of calls of RINDT*',III0
return return
END subroutine cov2mmpdfreg 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 GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:67523ef735281684c8fb9aae15cdc0a3 -- If you edit this, you'll get what you deserve. 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 (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 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 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 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) ('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 GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:2d868304b34a40918a05109c83ff1871 -- If you edit this, you'll get what you deserve. 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 (2 'expaccmod' 'expaccmod' 'expaccmod' 1 ((MODULE UNKNOWN-INTENT
UNKNOWN-PROC UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () UNKNOWN-PROC UNKNOWN UNKNOWN 0 0) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0
() () 0 0) () () () 0 0)
3 'pmax' 'expaccmod' 'pmax' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC 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 UNKNOWN IMPLICIT-SAVE 0 0) (REAL 8 0 0 REAL ()) 0 0 () (CONSTANT (REAL 8
REAL ()) 0 '0.28000000000000@2') () 0 () () () 0 0) 0 0 REAL ()) 0 '0.28000000000000@2') () 0 () () () 0 0)
) )
('expaccmod' 0 2 'pmax' 0 3) ('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 GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:806a8e6bde038d8bc47688d3b6e5277f -- If you edit this, you'll get what you deserve. 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 (2 'iac' 'infcmod' 'iac' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
UNKNOWN EXPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 UNKNOWN EXPLICIT-SAVE 0 0) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () ()
0) () 0 0)
3 'inf' 'infcmod' 'inf' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN 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 CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0
INTEGER ()) 0 '10')) 0 () () () 0 0) INTEGER ()) 0 '10')) 0 () () () 0 0)
4 'infcmod' 'infcmod' 'infcmod' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC 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 5 'info' 'infcmod' 'info' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC
UNKNOWN UNKNOWN DIMENSION) (INTEGER 4 0 0 INTEGER ()) 0 0 () (1 EXPLICIT UNKNOWN UNKNOWN 0 0 DIMENSION) (INTEGER 4 0 0 INTEGER ()) 0 0 () (1
(CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 EXPLICIT (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER
INTEGER ()) 0 '10')) 0 () () () 0 0) 4 0 0 INTEGER ()) 0 '10')) 0 () () () 0 0)
6 'isq' 'infcmod' 'isq' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN 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) ('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 GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:a058cc3e6c0e8bedef8f214da2f5fbdc -- If you edit this, you'll get what you deserve. 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 (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 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 UNKNOWN 0 0 SUBROUTINE GENERIC) (UNKNOWN 0 0 0 UNKNOWN ()) 7 0 (8 9 10
13 14 15 16 17 18 19 20) () 0 () () () 0 0) 11 12 13 14 15 16 17 18 19 20) () 0 () () () 0 0)
3 'rind' 'mregmod' 'rind' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL 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 UNKNOWN 0 0 SUBROUTINE GENERIC) (UNKNOWN 0 0 0 UNKNOWN ()) 21 0 (22 23
26 27 28 29 30 31) () 0 () () () 0 0) 24 25 26 27 28 29 30 31) () 0 () () () 0 0)
22 'xind' '' 'xind' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 26 'db' '' 'db' 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 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 ( 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 INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
'201')) 0 () () () 0 0) '201')) 0 () () () 0 0)
25 'dbun' '' 'dbun' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 27 'sq' '' 'sq' 21 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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 ( 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 INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
'201')) 0 () () () 0 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 ( 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 INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
'201')) 0 () () () 0 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) DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
29 'nit' '' 'nit' 21 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) ( 29 'nit' '' 'nit' 21 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
30 'n' '' 'n' 21 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) ( 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) INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
31 'infr' '' 'infr' 21 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) 31 'infr' '' 'infr' 21 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
(INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
6 'xx' '' 'xx' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) ( 6 'xx' '' 'xx' 5 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) (
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0) REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
8 'f' '' 'f' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) ( 8 'f' '' 'f' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY)
REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
9 'r' '' 'r' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION 9 'r' '' 'r' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (INTEGER 4 0 0 DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '40401')) 0 () INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
() () 0 0) '40401')) 0 () () () 0 0)
10 'b' '' 'b' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION 10 'b' '' 'b' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
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
DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT ( 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 INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
'201')) 0 () () () 0 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 ( 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 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 '4') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0
0 INTEGER ()) 0 '4')) 0 () () () 0 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 ( 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 INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
'7')) 0 () () () 0 0) '7')) 0 () () () 0 0)
14 'a' '' 'a' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION 19 'nit' '' 'nit' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY)
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (INTEGER 4 0 0 (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1407')) 0 () 14 'a' '' 'a' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
() () 0 0) DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT (
15 'da' '' 'da' 7 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 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 ( 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 INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0
'7')) 0 () () () 0 0) '7')) 0 () () () 0 0)
16 'vder' '' 'vder' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) 16 'vder' '' 'vder' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0) DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
17 'm' '' 'm' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) ( 17 'm' '' 'm' 7 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 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) (
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) 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) ('fi' 0 2 'mreg' 0 4 'rind' 0 3)

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

@ -1,5 +1,5 @@
GFORTRAN module version '0' created from mregmodule.f on Tue Jan 25 23:52:18 2011 GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:447301769c212f228b6cfa086ba1d48a -- If you edit this, you'll get what you deserve. 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 (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 CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0
INTEGER ()) 0 '126')) 0 () () () 0 0) INTEGER ()) 0 '126')) 0 () () () 0 0)
3 'i' 'quadrmod' 'i' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN 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 4 'nn' 'quadrmod' 'nn' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
UNKNOWN DIMENSION DATA) (INTEGER 4 0 0 INTEGER ()) 0 0 () (1 EXPLICIT ( UNKNOWN 0 0 DIMENSION DATA) (INTEGER 4 0 0 INTEGER ()) 0 0 () (1
CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 EXPLICIT (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER
INTEGER ()) 0 '25')) 0 () () () 0 0) 4 0 0 INTEGER ()) 0 '25')) 0 () () () 0 0)
5 'nnw' 'quadrmod' 'nnw' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC 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) INTEGER 4 0 0 INTEGER ()) 0 '13') () 0 () () () 0 0)
6 'quadrmod' 'quadrmod' 'quadrmod' 1 ((MODULE UNKNOWN-INTENT 6 'quadrmod' 'quadrmod' 'quadrmod' 1 ((MODULE UNKNOWN-INTENT
UNKNOWN-PROC UNKNOWN UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () UNKNOWN-PROC UNKNOWN UNKNOWN 0 0) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0
() () 0 0) () () () 0 0)
7 'z' 'quadrmod' 'z' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN 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 CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0
INTEGER ()) 0 '126')) 0 () () () 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 GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:ea81a0bf9bc67a6cbf4024dcd57f4ee3 -- If you edit this, you'll get what you deserve. 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 (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 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 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) ('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 GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:b8c9fdc908b66b228beb64d8a241e2e6 -- If you edit this, you'll get what you deserve. 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 (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) INTEGER 4 0 0 INTEGER ()) 0 '6') () 0 () () () 0 0)
3 'nmax' 'sizemod' 'nmax' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC 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) INTEGER 4 0 0 INTEGER ()) 0 '201') () 0 () () () 0 0)
4 'rdim' 'sizemod' 'rdim' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC 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) INTEGER 4 0 0 INTEGER ()) 0 '40401') () 0 () () () 0 0)
5 'sizemod' 'sizemod' 'sizemod' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC 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) ('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 GFORTRAN module version '4' created from dsvdc.f on Tue May 24 14:34:21 2011
MD5:504db75f3667c360354623f37288fa05 -- If you edit this, you'll get what you deserve. 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 (2 'dp' 'svd' 'dp' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
IMPLICIT-SAVE) (INTEGER 4 0 0 INTEGER ()) 0 0 () (CONSTANT (INTEGER 4 0 IMPLICIT-SAVE 0 0) (INTEGER 4 0 0 INTEGER ()) 0 0 () (CONSTANT (INTEGER
0 INTEGER ()) 0 '8') () 0 () () () 0 0) 4 0 0 INTEGER ()) 0 '8') () 0 () () () 0 0)
3 'drot1' 'svd' 'drot1' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL 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 () () UNKNOWN 0 0 SUBROUTINE) (UNKNOWN 0 0 0 UNKNOWN ()) 4 0 (5 6 7 8 9) () 0
() 0 0) () () () 0 0)
10 'drotg' 'svd' 'drotg' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL 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 () UNKNOWN 0 0 SUBROUTINE) (UNKNOWN 0 0 0 UNKNOWN ()) 11 0 (12 13 14 15) ()
() () 0 0) 0 () () () 0 0)
16 'dsvdc' 'svd' 'dsvdc' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL 16 'dsvdc' 'svd' 'dsvdc' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL
UNKNOWN SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 UNKNOWN ()) 17 0 (18 UNKNOWN 0 0 SUBROUTINE ALWAYS_EXPLICIT) (UNKNOWN 0 0 0 UNKNOWN ()) 17 0
19 20 21 22 23 24 25 26) () 0 () () () 0 0) (18 19 20 21 22 23 24 25 26) () 0 () () () 0 0)
27 'dswap1' 'svd' 'dswap1' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL 27 'dswap1' 'svd' 'dswap1' 1 ((PROCEDURE UNKNOWN-INTENT MODULE-PROC DECL
UNKNOWN SUBROUTINE) (UNKNOWN 0 0 0 UNKNOWN ()) 28 0 (29 30 31) () 0 () () UNKNOWN 0 0 SUBROUTINE) (UNKNOWN 0 0 0 UNKNOWN ()) 28 0 (29 30 31) () 0
() 0 0) () () () 0 0)
32 'selected_real_kind' '(intrinsic)' 'selected_real_kind' 1 (( 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) UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 32 () () () 0 0)
33 'svd' 'svd' 'svd' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN 33 'svd' 'svd' 'svd' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
UNKNOWN) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () () () 0 0) UNKNOWN 0 0) (UNKNOWN 0 0 0 UNKNOWN ()) 0 0 () () 0 () () () 0 0)
12 'da' '' 'da' 11 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) 30 'dx' '' 'dx' 28 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0) DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (
13 'db' '' 'db' 11 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
(REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0) 31 'dy' '' 'dy' 28 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
14 'dc' '' 'dc' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) ( 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) 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) 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) 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 ( DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (
INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) 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 ( DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (
INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
5 'n' '' 'n' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) ( 21 's' '' 's' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT
6 'dx' '' 'dx' 4 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION (INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (INTEGER 4 22 'e' '' 'e' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT
7 'dy' '' 'dy' 4 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION (INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0)
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SIZE (CONSTANT (INTEGER 4 23 'u' '' 'u' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (2 ASSUMED_SHAPE (CONSTANT
8 'c' '' 'c' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (REAL 8 (INTEGER 4 0 0 INTEGER ()) 0 '1') () (CONSTANT (INTEGER 4 0 0 INTEGER ())
0 0 REAL ()) 0 0 () () 0 () () () 0 0) 0 '1') ()) 0 () () () 0 0)
9 's' '' 's' 4 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) (REAL 8 24 'v' '' 'v' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
0 0 REAL ()) 0 0 () () 0 () () () 0 0) DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (2 ASSUMED_SHAPE (CONSTANT
18 'x' '' 'x' 17 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION (INTEGER 4 0 0 INTEGER ()) 0 '1') () (CONSTANT (INTEGER 4 0 0 INTEGER ())
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (2 ASSUMED_SHAPE (CONSTANT (INTEGER 4 0 '1') ()) 0 () () () 0 0)
0 0 INTEGER ()) 0 '1') () (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 25 'job' '' 'job' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
0 () () () 0 0) DUMMY) (INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
19 'n' '' 'n' 17 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN DUMMY) ( 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) 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) INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0)
21 's' '' 's' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION 15 'ds' '' 'ds' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY)
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT (INTEGER 4 (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) 12 'da' '' 'da' 11 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
22 'e' '' 'e' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (1 ASSUMED_SHAPE (CONSTANT (INTEGER 4 13 'db' '' 'db' 11 ((VARIABLE INOUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0
0 0 INTEGER ()) 0 '1') ()) 0 () () () 0 0) DUMMY) (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
23 'u' '' 'u' 17 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN DIMENSION 14 'dc' '' 'dc' 11 ((VARIABLE OUT UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY)
DUMMY) (REAL 8 0 0 REAL ()) 0 0 () (2 ASSUMED_SHAPE (CONSTANT (INTEGER 4 (REAL 8 0 0 REAL ()) 0 0 () () 0 () () () 0 0)
0 0 INTEGER ()) 0 '1') () (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') ()) 29 'n' '' 'n' 28 ((VARIABLE IN UNKNOWN-PROC UNKNOWN UNKNOWN 0 0 DUMMY) (
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) (
INTEGER 4 0 0 INTEGER ()) 0 0 () () 0 () () () 0 0) 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 ('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 GFORTRAN module version '4' created from mregmodule.f on Tue May 24 14:34:23 2011
MD5:43d81dd7165fa3666db9131e212144f1 -- If you edit this, you'll get what you deserve. 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 (2 'hh' 'tbrmod' 'hh' 1 ((VARIABLE UNKNOWN-INTENT UNKNOWN-PROC UNKNOWN
UNKNOWN DIMENSION) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (CONSTANT ( UNKNOWN 0 0 DIMENSION) (REAL 8 0 0 REAL ()) 0 0 () (1 EXPLICIT (
INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 CONSTANT (INTEGER 4 0 0 INTEGER ()) 0 '1') (CONSTANT (INTEGER 4 0 0
'201')) 0 () () () 0 0) INTEGER ()) 0 '201')) 0 () () () 0 0)
3 'mmax' 'sizemod' 'mmax' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC 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) INTEGER 4 0 0 INTEGER ()) 0 '6') () 0 () () () 0 0)
4 'nmax' 'sizemod' 'nmax' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC 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) INTEGER 4 0 0 INTEGER ()) 0 '201') () 0 () () () 0 0)
5 'rdim' 'sizemod' 'rdim' 1 ((PARAMETER UNKNOWN-INTENT UNKNOWN-PROC 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) INTEGER 4 0 0 INTEGER ()) 0 '40401') () 0 () () () 0 0)
6 'sizemod' 'sizemod' 'sizemod' 1 ((MODULE UNKNOWN-INTENT UNKNOWN-PROC 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 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) ('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: except ImportError:
warnings.warn('Compile the c_library.pyd again!') warnings.warn('Compile the c_library.pyd again!')
c_library = None 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 import TrData
from wafo.transform.models import TrLinear from wafo.transform.models import TrLinear
@ -255,8 +261,8 @@ def plotspec(specdata, linetype='b-', flag=1):
spectype = specdata.type.lower() spectype = specdata.type.lower()
stype = spectype[-3::] stype = spectype[-3::]
if stype in ('enc','req','k1d') : #1D plot if stype in ('enc', 'req', 'k1d') : #1D plot
Fn = freq[-1] # Nyquist frequency Fn = freq[-1] # Nyquist frequency
indm = findpeaks(data, n=4) indm = findpeaks(data, n=4)
maxS = data.max() maxS = data.max()
# if isfield(S,'CI') && ~isempty(S.CI), # 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 Fp = freq[indm]# %peak frequency/wave number
if len(indm)==1: if len(indm) == 1:
txt = [('fp = %0.2g' % Fp) + funit] txt = [('fp = %0.2g' % Fp) + funit]
else: else:
txt = [] txt = []
for i,fp in enumerate(Fp.tolist()): for i, fp in enumerate(Fp.tolist()):
txt.append(('fp%d = %0.2g' % (i,fp)) + funit) txt.append(('fp%d = %0.2g' % (i, fp)) + funit)
if (flag == 3): if (flag == 3):
plotbackend.subplot(2,1,1) plotbackend.subplot(2, 1, 1)
if (flag == 1) or (flag ==3):#% Plot in normal scale if (flag == 1) or (flag == 3):#% Plot in normal scale
plotbackend.plot(np.vstack([Fp, Fp]),np.vstack([zeros(len(indm)), data.take(indm)]),':', plotbackend.plot(np.vstack([Fp, Fp]), np.vstack([zeros(len(indm)), data.take(indm)]), ':',
freq,data,linetype) freq, data, linetype)
# if isfield(S,'CI'), # if isfield(S,'CI'),
# plot(freq,S.S*S.CI(1), 'r:' ) # plot(freq,S.S*S.CI(1), 'r:' )
@ -287,29 +293,29 @@ def plotspec(specdata, linetype='b-', flag=1):
a = plotbackend.axis() a = plotbackend.axis()
a1 = Fn a1 = Fn
if (Fp>0): if (Fp > 0):
a1 = max(min(Fn,10*max(Fp)),a[1]); 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.title('Spectral density')
plotbackend.xlabel(xlbl_txt) plotbackend.xlabel(xlbl_txt)
plotbackend.ylabel(ylbl1_txt ) plotbackend.ylabel(ylbl1_txt)
if (flag==3): if (flag == 3):
plotbackend.subplot(2,1,2) plotbackend.subplot(2, 1, 2)
if (flag == 2) or (flag ==3) : # Plot in logaritmic scale if (flag == 2) or (flag == 3) : # Plot in logaritmic scale
ind = np.flatnonzero(data>0) ind = np.flatnonzero(data > 0)
plotbackend.plot(np.vstack([Fp,Fp]),np.vstack((min(10*log10(data.take(ind)/maxS)).repeat(len(Fp)), plotbackend.plot(np.vstack([Fp, Fp]), np.vstack((min(10 * log10(data.take(ind) / maxS)).repeat(len(Fp)),
10*log10(data.take(indm)/maxS))),':') 10 * log10(data.take(indm) / maxS))), ':')
# hold on # hold on
# if isfield(S,'CI'), # 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(1)/maxS), 'r:' )
# plot(freq(ind),10*log10(S.S(ind)*S.CI(2)/maxS), 'r:' ) # plot(freq(ind),10*log10(S.S(ind)*S.CI(2)/maxS), 'r:' )
# end # 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 # 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) # 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): def __init__(self, *args, **kwds):
self.name_ = kwds.pop('name', 'WAFO Spectrum Object') self.name_ = kwds.pop('name', 'WAFO Spectrum Object')
self.type = kwds.pop('type','freq') self.type = kwds.pop('type', 'freq')
self.freqtype = kwds.pop('freqtype','w') self.freqtype = kwds.pop('freqtype', 'w')
self.angletype = '' self.angletype = ''
self.h = kwds.pop('h',inf) self.h = kwds.pop('h', inf)
self.tr = kwds.pop('tr',None) #TrLinear() self.tr = kwds.pop('tr', None) #TrLinear()
self.phi = kwds.pop('phi',0.0) self.phi = kwds.pop('phi', 0.0)
self.v = kwds.pop('v',0.0) self.v = kwds.pop('v', 0.0)
self.norm = kwds.pop('norm',False) self.norm = kwds.pop('norm', False)
super(SpecData1D, self).__init__(*args, **kwds) super(SpecData1D, self).__init__(*args, **kwds)
self.setlabels() self.setlabels()
@ -1113,6 +1119,113 @@ class SpecData1D(WafoData):
return SL, SN 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): def to_t_pdf(self, u=None, pdef='Tc', paramt=None, **options):
''' '''
@ -1254,7 +1367,7 @@ class SpecData1D(WafoData):
indI[3] = Ntd - 1 indI[3] = Ntd - 1
#% positive wave period #% 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) tmp = rind(BIG, ex[:Ntdc], B_lo, B_up, indI, xc, Nt)
f[pt], err[pt] = tmp[:2] f[pt], err[pt] = tmp[:2]
@ -1279,7 +1392,7 @@ class SpecData1D(WafoData):
return pdf return pdf
def _covinput(self, pt, R): def _covinput_t_pdf(self, pt, R):
""" """
Return covariance matrix for Tc or Tt period problems Return covariance matrix for Tc or Tt period problems
@ -1813,7 +1926,7 @@ class SpecData1D(WafoData):
svec = rvec + 1J * ivec svec = rvec + 1J * ivec
else: else:
amp = amp.T amp = amp.T
svec=[] svec = []
for i in range(cases): for i in range(cases):
rvec, ivec = c_library.disufq(amp[i].real, amp[i].imag, w, kw, water_depth, rvec, ivec = c_library.disufq(amp[i].real, amp[i].imag, w, kw, water_depth,
g, nmin, nmax, 1, ns) g, nmin, nmax, 1, ns)
@ -2329,7 +2442,7 @@ class SpecData1D(WafoData):
#%wnc = min(wnNew,wnOld-1e-5) #%wnc = min(wnNew,wnOld-1e-5)
wnc = wnNew wnc = wnNew
#specfun = lambda xi : stineman_interp(xi, w, S1) #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) x, unused_y = discretize(specfun, 0, wnc)
dwMin = minimum(min(diff(x)), dwMin) dwMin = minimum(min(diff(x)), dwMin)
@ -2437,9 +2550,9 @@ class SpecData1D(WafoData):
''' '''
m, unused_mtxt = self.moment(nr=4, even=False) m, unused_mtxt = self.moment(nr=4, even=False)
fact_dict=dict(alpha=0,eps2=1,eps4=3,qp=3,Qp=3) fact_dict = dict(alpha=0, eps2=1, eps4=3, qp=3, Qp=3)
fun = lambda fact: fact_dict.get(fact,fact) fun = lambda fact: fact_dict.get(fact, fact)
fact = atleast_1d(map(fun,list(factors))) fact = atleast_1d(map(fun, list(factors)))
#fact = atleast_1d(fact) #fact = atleast_1d(fact)
alpha = m[2] / sqrt(m[0] * m[4]) alpha = m[2] / sqrt(m[0] * m[4])
@ -2793,13 +2906,13 @@ class SpecData2D(WafoData):
def toacf(self): def toacf(self):
pass pass
def tospecdata(self,type=None): def tospecdata(self, type=None):
pass pass
def sim(self): def sim(self):
pass pass
def sim_nl(self): def sim_nl(self):
pass 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. Rotate spectrum clockwise around the origin.
@ -2837,58 +2950,58 @@ class SpecData2D(WafoData):
#Snew=S; #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::] stype = self.type.lower()[-3::]
if stype=='dir': if stype == 'dir':
#% any of the directinal types #% any of the directinal types
#% Make sure theta is from -pi to pi #% Make sure theta is from -pi to pi
theta = self.args[0] theta = self.args[0]
phi0 = theta[0]+pi; phi0 = theta[0] + pi;
self.args[0] = theta-phi0 self.args[0] = theta - phi0
# make sure -pi<phi<pi # make sure -pi<phi<pi
self.phi = mod(self.phi+phi0+pi,2*pi)-pi self.phi = mod(self.phi + phi0 + pi, 2 * pi) - pi
if (rotateGrid and (self.phi!=0)): if (rotateGrid and (self.phi != 0)):
# Do a physical rotation of spectrum # Do a physical rotation of spectrum
#theta = Snew.args[0] #theta = Snew.args[0]
ntOld = len(theta); ntOld = len(theta);
if (mod(theta[0]-theta[-1],2*pi)==0): if (mod(theta[0] - theta[-1], 2 * pi) == 0):
nt = ntOld-1 nt = ntOld - 1
else: else:
nt = ntOld 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 self.phi = 0
ind = theta.argsort() ind = theta.argsort()
self.data = self.data[ind,:] self.data = self.data[ind, :]
self.args[0] = theta[ind] self.args[0] = theta[ind]
if (nt<ntOld): if (nt < ntOld):
if (self.args[0][0]==-pi): if (self.args[0][0] == -pi):
self.data[ntOld,:] = self.data[0,:] self.data[ntOld, :] = self.data[0, :]
else: else:
#ftype = self.freqtype #ftype = self.freqtype
freq = self.args[1] freq = self.args[1]
theta = linspace(-pi,pi,ntOld) theta = linspace(-pi, pi, ntOld)
[F,T] = meshgrid(freq,theta) [F, T] = meshgrid(freq, theta)
dtheta = self.theta[1]-self.theta[0] dtheta = self.theta[1] - self.theta[0]
self.theta[nt] = self.theta[nt-1]+dtheta; self.theta[nt] = self.theta[nt - 1] + dtheta;
self.data[nt,:] = self.data[0,:] self.data[nt, :] = self.data[0, :]
self.data = interp2(freq,np.vstack([self.theta[0]-dtheta,self.theta]), self.data = interp2(freq, np.vstack([self.theta[0] - dtheta, self.theta]),
np.vstack([self.data[nt,:],self.data]),F,T,method) np.vstack([self.data[nt, :], self.data]), F, T, method)
self.args[0] = theta self.args[0] = theta
elif stype=='k2d': elif stype == 'k2d':
#any of the 2D wave number types #any of the 2D wave number types
#Snew.phi = mod(Snew.phi+phi+pi,2*pi)-pi; #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 # Do a physical rotation of spectrum
[k,k2] = meshgrid(*self.args) [k, k2] = meshgrid(*self.args)
[th,r] = cart2pol(k,k2) [th, r] = cart2pol(k, k2)
[k,k2] = pol2cart(th+self.phi,r) [k, k2] = pol2cart(th + self.phi, r)
ki1, ki2 = self.args 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.data = np.where(np.isnan(Sn), 0, Sn)
self.phi = 0; self.phi = 0;
@ -2958,107 +3071,107 @@ class SpecData2D(WafoData):
if self.type not in two_dim_spectra: if self.type not in two_dim_spectra:
raise ValueError('Unknown 2D spectrum type!') raise ValueError('Unknown 2D spectrum type!')
if vari==None and nr<=1: if vari == None and nr <= 1:
vari='x' vari = 'x'
elif vari==None: elif vari == None:
vari='xt' vari = 'xt'
else: #% secure the mutual order ('xyt') else: #% secure the mutual order ('xyt')
vari=''.join(sorted(vari.lower())) vari = ''.join(sorted(vari.lower()))
Nv=len(vari) Nv = len(vari)
if vari[0]=='t' and Nv>1: if vari[0] == 't' and Nv > 1:
vari = vari[1::]+ vari[0] vari = vari[1::] + vari[0]
Nv = len(vari) Nv = len(vari)
if not self.type.endswith('dir'): if not self.type.endswith('dir'):
S1 = self.tospecdata(self.type[:-2]+'dir') S1 = self.tospecdata(self.type[:-2] + 'dir')
else: else:
S1 = self S1 = self
w = ravel(S1.args[0]) w = ravel(S1.args[0])
theta = S1.args[1]-S1.phi theta = S1.args[1] - S1.phi
S = S1.data S = S1.data
Sw = simps(S,x=theta,axis=0) Sw = simps(S, x=theta, axis=0)
m = [simps(Sw,x=w)] m = [simps(Sw, x=w)]
mtext=['m0'] mtext = ['m0']
if nr>0: if nr > 0:
vec = [] vec = []
g = np.atleast_1d(S1.__dict__.get('g', gravity())) g = np.atleast_1d(S1.__dict__.get('g', gravity()))
kx=w**2/g[0] # maybe different normalization in x and y => diff. g kx = w ** 2 / g[0] # maybe different normalization in x and y => diff. g
ky=w**2/g[-1] ky = w ** 2 / g[-1]
nw=w.size nw = w.size
if 'x' in vari: if 'x' in vari:
ct = np.cos(theta[:,None]) ct = np.cos(theta[:, None])
Sc = simps(S*ct,x=theta, axis=0) Sc = simps(S * ct, x=theta, axis=0)
vec.append(kx*Sc) vec.append(kx * Sc)
mtext.append('mx') mtext.append('mx')
if 'y' in vari: if 'y' in vari:
st = np.sin(theta[:,None]) st = np.sin(theta[:, None])
Ss = simps(S*st,x=theta, axis=0) Ss = simps(S * st, x=theta, axis=0)
vec.append(ky*Ss) vec.append(ky * Ss)
mtext.append('my') mtext.append('my')
if 't' in vari: if 't' in vari:
vec.append(w*Sw) vec.append(w * Sw)
mtext.append('mt') mtext.append('mt')
if nr>1: if nr > 1:
if 'x' in vari: if 'x' in vari:
Sc2 = simps(S*ct**2,x=theta, axis=0) Sc2 = simps(S * ct ** 2, x=theta, axis=0)
vec.append(kx**2*Sc2) vec.append(kx ** 2 * Sc2)
mtext.append('mxx') mtext.append('mxx')
if 'y' in vari: if 'y' in vari:
Ss2 = simps(S*st**2,x=theta, axis=0) Ss2 = simps(S * st ** 2, x=theta, axis=0)
vec.append(ky**2*Ss2) vec.append(ky ** 2 * Ss2)
mtext.append('myy') mtext.append('myy')
if 't' in vari: if 't' in vari:
vec.append(w**2*Sw) vec.append(w ** 2 * Sw)
mtext.append('mtt') mtext.append('mtt')
if 'x' in vari and 'y' in vari: if 'x' in vari and 'y' in vari:
Scs = simps(S*ct*st,x=theta, axis=0) Scs = simps(S * ct * st, x=theta, axis=0)
vec.append(kx*ky*Scs) vec.append(kx * ky * Scs)
mtext.append('mxy') mtext.append('mxy')
if 'x' in vari and 't' in vari: if 'x' in vari and 't' in vari:
vec.append(kx*w*Sc) vec.append(kx * w * Sc)
mtext.append('mxt') mtext.append('mxt')
if 'y' in vari and 't' in vari: if 'y' in vari and 't' in vari:
vec.append(ky*w*Sc) vec.append(ky * w * Sc)
mtext.append('myt') mtext.append('myt')
if nr>3: if nr > 3:
if 'x' in vari: if 'x' in vari:
Sc3 = simps(S*ct**3,x=theta, axis=0) Sc3 = simps(S * ct ** 3, x=theta, axis=0)
Sc4 = simps(S*ct**4,x=theta, axis=0) Sc4 = simps(S * ct ** 4, x=theta, axis=0)
vec.append(kx**4*Sc4) vec.append(kx ** 4 * Sc4)
mtext.append('mxxxx') mtext.append('mxxxx')
if 'y' in vari: if 'y' in vari:
Ss3 = simps(S*st**3,x=theta, axis=0) Ss3 = simps(S * st ** 3, x=theta, axis=0)
Ss4 = simps(S*st**4,x=theta, axis=0) Ss4 = simps(S * st ** 4, x=theta, axis=0)
vec.append(ky**4*Ss4) vec.append(ky ** 4 * Ss4)
mtext.append('myyyy') mtext.append('myyyy')
if 't' in vari: if 't' in vari:
vec.append(w**4*Sw) vec.append(w ** 4 * Sw)
mtext.append('mtttt') mtext.append('mtttt')
if 'x' in vari and 'y' in vari: if 'x' in vari and 'y' in vari:
Sc2s = simps(S*ct**2*st,x=theta, axis=0) Sc2s = simps(S * ct ** 2 * st, x=theta, axis=0)
Sc3s = simps(S*ct**3*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) Scs2 = simps(S * ct * st ** 2, x=theta, axis=0)
Scs3 = simps(S*ct*st**3,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) 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)) vec.extend((kx ** 3 * ky * Sc3s, kx ** 2 * ky ** 2 * Sc2s2, kx * ky ** 3 * Scs3))
mtext.extend(('mxxxy','mxxyy','mxyyy')) mtext.extend(('mxxxy', 'mxxyy', 'mxyyy'))
if 'x' in vari and 't' in vari: if 'x' in vari and 't' in vari:
vec.extend((kx**3*w*Sc3, kx**2*w**2*Sc2, kx*w**3*Sc)) vec.extend((kx ** 3 * w * Sc3, kx ** 2 * w ** 2 * Sc2, kx * w ** 3 * Sc))
mtext.extend(('mxxxt','mxxtt','mxttt')) mtext.extend(('mxxxt', 'mxxtt', 'mxttt'))
if 'y' in vari and 't' in vari: if 'y' in vari and 't' in vari:
vec.extend((ky**3*w*Ss3, ky**2*w**2*Ss2, ky*w**3*Ss)) vec.extend((ky ** 3 * w * Ss3, ky ** 2 * w ** 2 * Ss2, ky * w ** 3 * Ss))
mtext.extend(('myyyt','myytt','myttt')) mtext.extend(('myyyt', 'myytt', 'myttt'))
if 'x' in vari and 'y' in vari and 't' in vari: 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)) vec.extend((kx ** 2 * ky * w * Sc2s, kx * ky ** 2 * w * Scs2, kx * ky * w ** 2 * Scs))
mtext.extend(('mxxyt','mxyyt','mxytt')) mtext.extend(('mxxyt', 'mxyyt', 'mxytt'))
#end % if nr>1 #end % if nr>1
m.extend([simps(vals, x=w) for vals in vec]) m.extend([simps(vals, x=w) for vals in vec])
return np.asarray(m), mtext return np.asarray(m), mtext

Loading…
Cancel
Save