danh
/
pywafo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Replaced tabs with spaces....

Browse Source
master
pbrod 9 years ago
parent c2a9247d00
commit 858f513111
3 changed files with 82 additions and 82 deletions
Show Stats Download Patch File Download Diff File

4
wafo/source/mreg/intfcmod.f
Unescape Escape View File

@ -145,8 +145,8 @@ C Covariance matrices COV1=r'(T-T), COV2=r''(T-T) and COV3=r'''(T-T)
C Dimension of COV1, COV2 should be atleast N*N. C Dimension of COV1, COV2 should be atleast N*N.
C 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(N,5), intent(in) :: COV REAL*8, DIMENSION(N,5), intent(in) :: COV

20
wafo/source/mvnprd/mvnprd.f
Unescape Escape View File

@ -1,12 +1,12 @@
C C
C f2py -m mvnprd -h mvnprd.pyf mvnprd.f only: mvnprd C f2py -m mvnprd -h mvnprd.pyf mvnprd.f only: mvnprd
C edit mvnprd.pyf with input and output and then C edit mvnprd.pyf with input and output and then
C f2py mvnprd.pyf mvnprd.f -c --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71 C f2py mvnprd.pyf mvnprd.f -c --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71
C C
C f2py --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71 -m mvnprd -c mvnprd.f C f2py --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71 -m mvnprd -c mvnprd.f
C Altarnative: compile mvnprd and link to it through mvnprd_interface.f C Altarnative: compile mvnprd and link to it through mvnprd_interface.f
C C
C gfortran -fPIC -c mvnprd.f C gfortran -fPIC -c mvnprd.f
C f2py -m mvnprdmod -c mvnprd.o mvnprd_interface.f --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71 C f2py -m mvnprdmod -c mvnprd.o mvnprd_interface.f --fcompiler=gnu95 --compiler=mingw32 -lmsvcr71
C C
@ -18,7 +18,7 @@ C f2py -m mvnprdmod -c mvnprd.obj mvnprd_interface.f --fcompiler=compaqv --comp
! ,MVNPRD and MVSTUD subroutines for computing multivariate normal ! ,MVNPRD and MVSTUD subroutines for computing multivariate normal
! or student T probabilities with product correlation structure. The ! or student T probabilities with product correlation structure. The
! file should compile without errors on (Fortran77) standard Fortran ! file should compile without errors on (Fortran77) standard Fortran
! compilers. ! compilers.
* *
* The mex-interface was written by * The mex-interface was written by
* Per Andreas Brodtkorb * Per Andreas Brodtkorb
@ -45,7 +45,7 @@ C Tel.: (905) 525-9140 (Ext. 27104)
* RHO REAL, array of coefficients defining the correlation * RHO REAL, array of coefficients defining the correlation
* coefficient by: * coefficient by:
* correlation(I,J) = RHO(I)*RHO(J) for J/=I * correlation(I,J) = RHO(I)*RHO(J) for J/=I
* where * where
* 1 < RHO(I) < 1 * 1 < RHO(I) < 1
* A REAL, array of lower integration limits. * A REAL, array of lower integration limits.
* B REAL, array of upper integration limits. * B REAL, array of upper integration limits.
@ -66,13 +66,13 @@ C Tel.: (905) 525-9140 (Ext. 27104)
* INFORM INTEGER, termination status parameter: * INFORM INTEGER, termination status parameter:
* 0, if normal completion with ERROR < EPS; * 0, if normal completion with ERROR < EPS;
* 1, if N > 100 or N < 1. * 1, if N > 100 or N < 1.
* 2, IF any abs(rho)>=1 * 2, IF any abs(rho)>=1
* 4, if ANY(B(I)<=A(i)) * 4, if ANY(B(I)<=A(i))
* 5, if number of terms computed exceeds maximum number of * 5, if number of terms computed exceeds maximum number of
* evaluation points * evaluation points
* 6, if fault accurs in normal subroutines * 6, if fault accurs in normal subroutines
* 7, if subintervals are too narrow or too many * 7, if subintervals are too narrow or too many
* 8, if bounds exceeds abseps * 8, if bounds exceeds abseps
* *
* *
* MVNPRDMEX calculates multivariate normal or student T probability * MVNPRDMEX calculates multivariate normal or student T probability
@ -836,7 +836,7 @@ C
DOUBLE PRECISION :: HNC,PROB,BND DOUBLE PRECISION :: HNC,PROB,BND
INTEGER :: NN, MAXDF,I,IERC,NDF,N,IFLT INTEGER :: NN, MAXDF,I,IERC,NDF,N,IFLT
PARAMETER (NN=100, MAXDF = 150) PARAMETER (NN=100, MAXDF = 150)
integer :: INF(*) integer :: INF(*)
DOUBLE PRECISION :: A(*),B(*),BPD(*),D(*),F(3), DOUBLE PRECISION :: A(*),B(*),BPD(*),D(*),F(3),
& AA(NN),BB(NN) & AA(NN),BB(NN)
DOUBLE PRECISION :: ERB2, ERRB, AX,BX,XX DOUBLE PRECISION :: ERB2, ERRB, AX,BX,XX
@ -855,7 +855,7 @@ C
ENDIF ENDIF
BND = ZERO BND = ZERO
IFLT = 0 IFLT = 0
ERB2 = ERRB ERB2 = ERRB
C C
C CHECK IF D.F. EXCEED MAXDF; IF YES, THEN PROB C CHECK IF D.F. EXCEED MAXDF; IF YES, THEN PROB
@ -1086,7 +1086,7 @@ C
RETURN RETURN
END END
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * C * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C Charles Dunnett C Charles Dunnett
C Dept. of Mathematics and Statistics C Dept. of Mathematics and Statistics
C McMaster University C McMaster University

140
wafo/source/mvnprd/mvnprodcorrprb.f
Unescape Escape View File

@ -304,11 +304,11 @@ C DOUBLE PRECISION, DIMENSION(6) :: P
C------------------------------------------------------------------ C------------------------------------------------------------------
C Coefficients for approximation to erf in first interval C Coefficients for approximation to erf in first interval
C------------------------------------------------------------------ C------------------------------------------------------------------
DOUBLE PRECISION, PARAMETER, DIMENSION(5) :: DOUBLE PRECISION, PARAMETER, DIMENSION(5) ::
& A = (/ 3.16112374387056560D00, & A = (/ 3.16112374387056560D00,
& 1.13864154151050156D02,3.77485237685302021D02, & 1.13864154151050156D02,3.77485237685302021D02,
& 3.20937758913846947D03, 1.85777706184603153D-1/) & 3.20937758913846947D03, 1.85777706184603153D-1/)
DOUBLE PRECISION, PARAMETER, DIMENSION(4) :: DOUBLE PRECISION, PARAMETER, DIMENSION(4) ::
& B = (/2.36012909523441209D01,2.44024637934444173D02, & B = (/2.36012909523441209D01,2.44024637934444173D02,
& 1.28261652607737228D03,2.84423683343917062D03/) & 1.28261652607737228D03,2.84423683343917062D03/)
C------------------------------------------------------------------ C------------------------------------------------------------------
@ -320,7 +320,7 @@ C------------------------------------------------------------------
2 8.81952221241769090D02,1.71204761263407058D03, 2 8.81952221241769090D02,1.71204761263407058D03,
3 2.05107837782607147D03,1.23033935479799725D03, 3 2.05107837782607147D03,1.23033935479799725D03,
4 2.15311535474403846D-8/) 4 2.15311535474403846D-8/)
DOUBLE PRECISION, DIMENSION(8) :: DOUBLE PRECISION, DIMENSION(8) ::
& D =(/1.57449261107098347D01,1.17693950891312499D02, & D =(/1.57449261107098347D01,1.17693950891312499D02,
1 5.37181101862009858D02,1.62138957456669019D03, 1 5.37181101862009858D02,1.62138957456669019D03,
2 3.29079923573345963D03,4.36261909014324716D03, 2 3.29079923573345963D03,4.36261909014324716D03,
@ -328,14 +328,14 @@ C------------------------------------------------------------------
C------------------------------------------------------------------ C------------------------------------------------------------------
C Coefficients for approximation to erfc in third interval C Coefficients for approximation to erfc in third interval
C------------------------------------------------------------------ C------------------------------------------------------------------
DOUBLE PRECISION, parameter, DOUBLE PRECISION, parameter,
& DIMENSION(6) :: P =(/3.05326634961232344D-1, & DIMENSION(6) :: P =(/3.05326634961232344D-1,
& 3.60344899949804439D-1, & 3.60344899949804439D-1,
1 1.25781726111229246D-1,1.60837851487422766D-2, 1 1.25781726111229246D-1,1.60837851487422766D-2,
2 6.58749161529837803D-4,1.63153871373020978D-2/) 2 6.58749161529837803D-4,1.63153871373020978D-2/)
DOUBLE PRECISION, parameter, DOUBLE PRECISION, parameter,
& DIMENSION(5) :: Q =(/2.56852019228982242D00, & DIMENSION(5) :: Q =(/2.56852019228982242D00,
& 1.87295284992346047D00, & 1.87295284992346047D00,
1 5.27905102951428412D-1,6.05183413124413191D-2, 1 5.27905102951428412D-1,6.05183413124413191D-2,
2 2.33520497626869185D-3/) 2 2.33520497626869185D-3/)
C------------------------------------------------------------------ C------------------------------------------------------------------
@ -3090,29 +3090,29 @@ c
! Subdivide the interval and create two new vectors in the stack, ! Subdivide the interval and create two new vectors in the stack,
! one of which overwrites the vector just processed. ! one of which overwrites the vector just processed.
! !
! v(:,k) = [fx1,fx2,fx3,fx4,fx5,x1,h,S,SL,SR] ! v(:,k) = [fx1,fx2,fx3,fx4,fx5,x1,h,S,SL,SR]
kp1 = k + 1; kp1 = k + 1;
! Process right interval ! Process right interval
v(1,kp1) = v(3,k); !fx1R v(1,kp1) = v(3,k); !fx1R
v(2,kp1) = fx(3); !fx2R v(2,kp1) = fx(3); !fx2R
v(3,kp1) = v(4,k); !fx3R v(3,kp1) = v(4,k); !fx3R
v(4,kp1) = fx(4); !fx4R v(4,kp1) = fx(4); !fx4R
v(5,kp1) = v(5,k); !fx5R v(5,kp1) = v(5,k); !fx5R
v(6,kp1) = v(6,k) + four * h; ! x1R v(6,kp1) = v(6,k) + four * h; ! x1R
v(7,kp1) = h; v(7,kp1) = h;
v(8,kp1) = v(10,k); ! S v(8,kp1) = v(10,k); ! S
v(9:10,kp1) = Sn(3:4); ! SL, SR v(9:10,kp1) = Sn(3:4); ! SL, SR
! Process left interval ! Process left interval
v(5,k) = v(3,k); ! fx5L v(5,k) = v(3,k); ! fx5L
v(4,k) = fx(2); ! fx4L v(4,k) = fx(2); ! fx4L
v(3,k) = v(2,k); ! fx3L v(3,k) = v(2,k); ! fx3L
v(2,k) = fx(1); ! fx2L v(2,k) = fx(1); ! fx2L
! v(1,k) unchanged fx1L ! v(1,k) unchanged fx1L
! v(6,k) unchanged x1L ! v(6,k) unchanged x1L
v(7,k) = h; v(7,k) = h;
v(8,k) = v(9,k); ! S v(8,k) = v(9,k); ! S
v(9:10,k) = Sn(1:2); ! SL, SR v(9:10,k) = Sn(1:2); ! SL, SR
k = kp1; k = kp1;
endif endif
enddo ! while enddo ! while
if (epsi<abserr) iflg = IOR(iflg,4) if (epsi<abserr) iflg = IOR(iflg,4)
@ -3317,42 +3317,42 @@ c
! one of which overwrites the vector just processed. ! one of which overwrites the vector just processed.
! !
! v(:,k) = [fx1,fx2,..,fx8,fx9,x1,h,S,SL,SR,SL1,SL2 SR1,SR2] ! v(:,k) = [fx1,fx2,..,fx8,fx9,x1,h,S,SL,SR,SL1,SL2 SR1,SR2]
kp1 = k + 1; kp1 = k + 1;
! Process right interval ! Process right interval
v(1,kp1) = v(5,k); !fx1R v(1,kp1) = v(5,k); !fx1R
v(2,kp1) = fx(5); !fx2R v(2,kp1) = fx(5); !fx2R
v(3,kp1) = v(6,k); !fx3R v(3,kp1) = v(6,k); !fx3R
v(4,kp1) = fx(6); !fx4R v(4,kp1) = fx(6); !fx4R
v(5,kp1) = v(7,k); !fx5R v(5,kp1) = v(7,k); !fx5R
v(6,kp1) = fx(7); !fx6R v(6,kp1) = fx(7); !fx6R
v(7,kp1) = v(8,k); !fx7R v(7,kp1) = v(8,k); !fx7R
v(8,kp1) = fx(8); !fx8R v(8,kp1) = fx(8); !fx8R
v(9,kp1) = v(9,k); !fx9R v(9,kp1) = v(9,k); !fx9R
v(Nrule+1,kp1) = v(Nrule+1,k) + eight * h ! x1R v(Nrule+1,kp1) = v(Nrule+1,k) + eight * h ! x1R
v(Nrule+2,kp1) = h; v(Nrule+2,kp1) = h;
v(Nrule+3,kp1) = v(Nrule+5,k); ! S v(Nrule+3,kp1) = v(Nrule+5,k); ! S
v(Nrule+4,kp1) = v(Nrule+8,k); ! SL v(Nrule+4,kp1) = v(Nrule+8,k); ! SL
v(Nrule+5,kp1) = v(Nrule+9,k); ! SR v(Nrule+5,kp1) = v(Nrule+9,k); ! SR
v(Nrule+6:Nrule+9,kp1) = Sn(5:8); ! SL1,SL2,SR1, SR2 v(Nrule+6:Nrule+9,kp1) = Sn(5:8); ! SL1,SL2,SR1, SR2
! Process left interval ! Process left interval
v(9,k) = v(5,k); ! fx9L v(9,k) = v(5,k); ! fx9L
v(8,k) = fx(4); ! fx8L v(8,k) = fx(4); ! fx8L
v(7,k) = v(4,k); ! fx7L v(7,k) = v(4,k); ! fx7L
v(6,k) = fx(3); ! fx6L v(6,k) = fx(3); ! fx6L
v(5,k) = v(3,k); ! fx5L v(5,k) = v(3,k); ! fx5L
v(4,k) = fx(2); ! fx4L v(4,k) = fx(2); ! fx4L
v(3,k) = v(2,k); ! fx3L v(3,k) = v(2,k); ! fx3L
v(2,k) = fx(1); ! fx2L v(2,k) = fx(1); ! fx2L
! v(1,k) = v(1,k); ! fx1L ! v(1,k) = v(1,k); ! fx1L
! v(Nrule+1,k) unchanged x1L ! v(Nrule+1,k) unchanged x1L
v(Nrule+2,k) = h; v(Nrule+2,k) = h;
v(Nrule+3,k) = v(Nrule + 4,k); ! S v(Nrule+3,k) = v(Nrule + 4,k); ! S
v(Nrule+4,k) = v(Nrule+6,k); ! SL v(Nrule+4,k) = v(Nrule+6,k); ! SL
v(Nrule+5,k) = v(Nrule+7,k); ! SR v(Nrule+5,k) = v(Nrule+7,k); ! SR
v(Nrule+6:Nrule+9,k) = Sn(1:4); ! SL1,SL2,SR1, SR2 v(Nrule+6:Nrule+9,k) = Sn(1:4); ! SL1,SL2,SR1, SR2
k = kp1; k = kp1;
endif endif
enddo ! while enddo ! while
if (epsi<abserr) iflg = IOR(iflg,4) if (epsi<abserr) iflg = IOR(iflg,4)
@ -3390,7 +3390,7 @@ c
tol = max(0.1D0*LTol,2.0D-16) tol = max(0.1D0*LTol,2.0D-16)
! elseif ( LTol < excess / 10.0D0 ) then ! elseif ( LTol < excess / 10.0D0 ) then
! tol = LTol + excess*0.5D0 ! tol = LTol + excess*0.5D0
else else
tol = LTol tol = LTol
endif endif
val = val + valk val = val + valk
@ -3532,24 +3532,24 @@ c
! one of which overwrites the vector just processed. ! one of which overwrites the vector just processed.
! !
! v(:,k) = [fx1,fx2,fx3,x1,h,S,SL,SR] ! v(:,k) = [fx1,fx2,fx3,x1,h,S,SL,SR]
kp1 = k + 1; kp1 = k + 1;
! Process right interval ! Process right interval
v(1,kp1) = v(2,k); !fx1R v(1,kp1) = v(2,k); !fx1R
v(2,kp1) = fx(2); !fx2R v(2,kp1) = fx(2); !fx2R
v(3,kp1) = v(3,k); !fx3R v(3,kp1) = v(3,k); !fx3R
v(4,kp1) = v(4,k) + two * h; ! x1R v(4,kp1) = v(4,k) + two * h; ! x1R
v(5,kp1) = h; v(5,kp1) = h;
v(6,kp1) = v(8,k); ! S v(6,kp1) = v(8,k); ! S
v(7:8,kp1) = Sn(3:4); ! SL, SR v(7:8,kp1) = Sn(3:4); ! SL, SR
! Process left interval ! Process left interval
v(3,k) = v(2,k); ! fx5L v(3,k) = v(2,k); ! fx5L
v(2,k) = fx(1); ! fx4L v(2,k) = fx(1); ! fx4L
! v(1,k) unchanged fx1L ! v(1,k) unchanged fx1L
! v(4,k) unchanged x1L ! v(4,k) unchanged x1L
v(5,k) = h; v(5,k) = h;
v(6,k) = v(7,k); ! S v(6,k) = v(7,k); ! S
v(7:8,k) = Sn(1:2); ! SL, SR v(7:8,k) = Sn(1:2); ! SL, SR
k = kp1; k = kp1;
endif endif
enddo ! while enddo ! while
end subroutine AdaptiveTrapz1 end subroutine AdaptiveTrapz1
@ -3595,7 +3595,7 @@ c
val = val + valk val = val + valk
if (kflg>0) iflg = ior(iflg,kflg) if (kflg>0) iflg = ior(iflg,kflg)
end do end do
if (epsi<abserr) iflg = IOR(iflg, 3) if (epsi<abserr) iflg = IOR(iflg, 3)
end subroutine RombergWithBreaks end subroutine RombergWithBreaks
subroutine Romberg1(f,a,b,decdigs,abseps,errFlg,abserr,VAL) subroutine Romberg1(f,a,b,decdigs,abseps,errFlg,abserr,VAL)
implicit none implicit none
@ -4116,8 +4116,8 @@ c
double precision :: xUp,xLo,zRho double precision :: xUp,xLo,zRho
double precision, parameter :: one = 1.0D0, zero = 0.0D0 double precision, parameter :: one = 1.0D0, zero = 0.0D0
integer :: I integer :: I
val = one val = one
do I = 1, mNdim do I = 1, mNdim
zRho = z * mRho(I) zRho = z * mRho(I)
! Uncomment / mDen below if mRho, mA, mB is not scaled ! Uncomment / mDen below if mRho, mA, mB is not scaled
xUp = ( mB(I) - zRho ) !/ mDen(I) xUp = ( mB(I) - zRho ) !/ mDen(I)
@ -4153,7 +4153,7 @@ c
& Q, R & Q, R
PARAMETER ( SPLIT1 = 0.425D0, SPLIT2 = 5.D0, PARAMETER ( SPLIT1 = 0.425D0, SPLIT2 = 5.D0,
& CONST1 = 0.180625D0, CONST2 = 1.6D0, & CONST1 = 0.180625D0, CONST2 = 1.6D0,
& ONE = 1.D0, ZERO = 0.D0, HALF = 0.5D0 ) & ONE = 1.D0, ZERO = 0.D0, HALF = 0.5D0 )
* *
* Coefficients for P close to 0.5 * Coefficients for P close to 0.5
* *

Write Preview
Loading…
Cancel
Save