mvt.f

Go to the documentation of this file.
00001 *
00002 *    $Id: mvt.f 3864 2008-02-10 16:43:04Z hothorn $
00003 *
00004       SUBROUTINE MVTDST( N, NU, LOWER, UPPER, INFIN, CORREL, DELTA, 
00005      &                   MAXPTS, ABSEPS, RELEPS, ERROR, VALUE, INFORM )       
00006 *
00007 *     A subroutine for computing non-central multivariate t probabilities.
00008 *     This subroutine uses an algorithm (QRSVN) described in the paper
00009 *     
00010 "Comparison of Methods for the Computation of Multivariate *         t-Probabilities", by Alan Genz and Frank Bretz
00011 *         J. Comp. Graph. Stat. 11 (2002), pp. 950-971.
00012 *
00013 *          Alan Genz 
00014 *          Department of Mathematics
00015 *          Washington State University 
00016 *          Pullman, WA 99164-3113
00017 *          Email : AlanGenz@wsu.edu
00018 *
00019 *       Original source available from
00020 *       http://www.math.wsu.edu/faculty/genz/software/fort77/mvtdstpack.f
00021 *
00022 *       This is version 7/7 with better support for 100 < dimension < 1000
00023 *
00024 *  Parameters
00025 *
00026 *     N      INTEGER, the number of variables.    
00027 *     NU     INTEGER, the number of degrees of freedom.
00028 *            If NU < 1, then an MVN probability is computed.
00029 *     LOWER  DOUBLE PRECISION, array of lower integration limits.
00030 *     UPPER  DOUBLE PRECISION, array of upper integration limits.
00031 *     INFIN  INTEGER, array of integration limits flags:
00032 *             if INFIN(I) < 0, Ith limits are (-infinity, infinity);
00033 *             if INFIN(I) = 0, Ith limits are (-infinity, UPPER(I)];
00034 *             if INFIN(I) = 1, Ith limits are [LOWER(I), infinity);
00035 *             if INFIN(I) = 2, Ith limits are [LOWER(I), UPPER(I)].
00036 *     CORREL DOUBLE PRECISION, array of correlation coefficients; 
00037 *            the correlation coefficient in row I column J of the 
00038 *            correlation matrixshould be stored in 
00039 *               CORREL( J + ((I-2)*(I-1))/2 ), for J < I.
00040 *            The correlation matrix must be positive semi-definite.
00041 *     DELTA  DOUBLE PRECISION, array of non-centrality parameters.
00042 *     MAXPTS INTEGER, maximum number of function values allowed. This 
00043 *            parameter can be used to limit the time. A sensible 
00044 *            strategy is to start with MAXPTS = 1000*N, and then
00045 *            increase MAXPTS if ERROR is too large.
00046 *     ABSEPS DOUBLE PRECISION absolute error tolerance.
00047 *     RELEPS DOUBLE PRECISION relative error tolerance.
00048 *     ERROR  DOUBLE PRECISION estimated absolute error, 
00049 *            with 99% confidence level.
00050 *     VALUE  DOUBLE PRECISION estimated value for the integral
00051 *     INFORM INTEGER, termination status parameter:
00052 *            if INFORM = 0, normal completion with ERROR < EPS;
00053 *            if INFORM = 1, completion with ERROR > EPS and MAXPTS 
00054 *                           function vaules used; increase MAXPTS to 
00055 *                           decrease ERROR;
00056 *            if INFORM = 2, N > 1000 or N < 1.
00057 *            if INFORM = 3, correlation matrix not positive semi-definite.
00058 *
00059       EXTERNAL MVSUBR
00060       INTEGER N, ND, NU, INFIN(*), MAXPTS, INFORM, IVLS
00061       DOUBLE PRECISION CORREL(*), LOWER(*), UPPER(*), DELTA(*), RELEPS, 
00062      &                 ABSEPS, ERROR, VALUE, E(1), V(1)
00063       COMMON /PTBLCK/IVLS
00064       IVLS = 0
00065       IF ( N .GT. 1000 .OR. N .LT. 1 ) THEN
00066          VALUE = 0
00067          ERROR = 1
00068          INFORM = 2
00069       ELSE
00070          CALL MVINTS( N, NU, CORREL, LOWER, UPPER, DELTA, INFIN,
00071      &                   ND, VALUE, ERROR, INFORM )
00072          IF ( INFORM .EQ. 0 .AND. ND .GT. 0 ) THEN
00073 *
00074 *           Call the lattice rule integration subroutine
00075 *
00076             CALL MVKBRV( ND, IVLS, MAXPTS, 1, MVSUBR, ABSEPS, RELEPS, 
00077      &                    E, V, INFORM )
00078             ERROR = E(1)
00079             VALUE = V(1)
00080          ENDIF
00081       ENDIF
00082       END
00083 *
00084       SUBROUTINE MVSUBR( N, W, NF, F )
00085 *     
00086 *     Integrand subroutine
00087 *
00088       INTEGER N, NF, NUIN, INFIN(*), NL
00089       DOUBLE PRECISION W(*),F(*), LOWER(*),UPPER(*), CORREL(*), DELTA(*)
00090       PARAMETER ( NL = 1000 )
00091       INTEGER INFI(NL), NU, ND, INFORM, NY 
00092       DOUBLE PRECISION COV(NL*(NL+1)/2), A(NL), B(NL), DL(NL), Y(NL)
00093       DOUBLE PRECISION MVCHNV, SNU, R, VL, ER, DI, EI
00094       SAVE NU, SNU, INFI, A, B, DL, COV
00095       IF ( NU .LE. 0 ) THEN
00096          R = 1
00097          CALL MVVLSB( N+1, W, R, DL,INFI,A,B,COV, Y, DI,EI, NY, F(1) )
00098       ELSE
00099          R = MVCHNV( NU, W(N) )/SNU
00100          CALL MVVLSB( N  , W, R, DL,INFI,A,B,COV, Y, DI,EI, NY, F(1) )
00101       END IF
00102       RETURN
00103 *
00104 *     Entry point for intialization.
00105 *
00106       ENTRY MVINTS( N, NUIN, CORREL, LOWER, UPPER, DELTA, INFIN, 
00107      &     ND, VL, ER, INFORM )
00108 *
00109 *     Initialization and computation of covariance Cholesky factor.
00110 *
00111       CALL MVSORT( N, LOWER, UPPER, DELTA, CORREL, INFIN, Y, .TRUE.,
00112      &            ND,     A,     B,    DL,    COV,  INFI, INFORM )
00113       NU = NUIN
00114       CALL MVSPCL( ND, NU, A, B, DL, COV, INFI, SNU, VL, ER, INFORM )
00115       END
00116 *
00117       SUBROUTINE MVSPCL( ND, NU, A,B,DL, COV, INFI, SNU, VL,ER, INFORM )
00118 *
00119 *     Special cases subroutine
00120 *
00121       DOUBLE PRECISION COV(*), A(*), B(*), DL(*), SNU, R, VL, ER
00122       INTEGER ND, NU, INFI(*), INFORM
00123       DOUBLE PRECISION MVBVT, MVSTDT
00124       IF ( INFORM .GT. 0 ) THEN
00125          VL = 0
00126          ER = 1
00127       ELSE
00128 *     
00129 *        Special cases
00130 *
00131          IF ( ND .EQ. 0 ) THEN
00132             ER = 0
00133          ELSE IF ( ND.EQ.1 .AND. ( NU.LT.1 .OR. ABS(DL(1)).EQ.0 ) ) THEN
00134 *     
00135 *           1-d case for normal or central t
00136 *
00137             VL = 1
00138             IF ( INFI(1) .NE. 1 ) VL = MVSTDT( NU, B(1) - DL(1) ) 
00139             IF ( INFI(1) .NE. 0 ) VL = VL - MVSTDT( NU, A(1) - DL(1) ) 
00140             IF ( VL .LT. 0 ) VL = 0
00141             ER = 2D-16
00142             ND = 0
00143          ELSE IF ( ND .EQ. 2 .AND. 
00144      &            ( NU .LT. 1 .OR. ABS(DL(1))+ABS(DL(2)) .EQ. 0 ) ) THEN
00145 *     
00146 *           2-d case for normal or central t
00147 *
00148             IF ( INFI(1) .NE. 0 ) A(1) = A(1) - DL(1)
00149             IF ( INFI(1) .NE. 1 ) B(1) = B(1) - DL(1)
00150             IF ( INFI(2) .NE. 0 ) A(2) = A(2) - DL(2)
00151             IF ( INFI(2) .NE. 1 ) B(2) = B(2) - DL(2)
00152             IF ( ABS( COV(3) ) .GT. 0 ) THEN
00153 *     
00154 *              2-d nonsingular case
00155 *
00156                R = SQRT( 1 + COV(2)**2 )
00157                IF ( INFI(2) .NE. 0 ) A(2) = A(2)/R
00158                IF ( INFI(2) .NE. 1 ) B(2) = B(2)/R
00159                COV(2) = COV(2)/R
00160                VL = MVBVT( NU, A, B, INFI, COV(2) )
00161                ER = 1D-15
00162             ELSE
00163 *     
00164 *              2-d singular case
00165 *
00166                IF ( INFI(1) .NE. 0 ) THEN
00167                   IF ( INFI(2) .NE. 0 ) A(1) = MAX( A(1), A(2) )
00168                ELSE
00169                   IF ( INFI(2) .NE. 0 ) A(1) = A(2)
00170                END IF
00171                IF ( INFI(1) .NE. 1 ) THEN
00172                   IF ( INFI(2) .NE. 1 ) B(1) = MIN( B(1), B(2) ) 
00173                ELSE
00174                   IF ( INFI(2) .NE. 1 ) B(1) = B(2)
00175                END IF
00176                IF ( INFI(1) .NE. INFI(2) ) INFI(1) = 2
00177                VL = 1
00178                IF ( INFI(1) .NE. 1 ) VL = MVSTDT( NU, B(1)-DL(1) ) 
00179                IF ( INFI(1) .NE. 0 ) VL = VL - MVSTDT( NU, A(1)-DL(1) )      
00180                IF ( VL .LT. 0 ) VL = 0
00181                ER = 2D-16
00182             END IF
00183             ND = 0
00184          ELSE
00185             IF ( NU .GT. 0 ) THEN
00186                SNU = SQRT( DBLE(NU) ) 
00187             ELSE 
00188                ND = ND - 1
00189             END IF
00190          END IF
00191       END IF
00192       END
00193 *
00194       SUBROUTINE MVVLSB( N,W,R,DL,INFI, A,B,COV, Y, DI,EI, ND, VALUE )      
00195 *     
00196 *     Integrand subroutine
00197 *
00198       INTEGER N, INFI(*), ND
00199       DOUBLE PRECISION W(*), R, DL(*), A(*), B(*), COV(*), Y(*)
00200       INTEGER I, J, IJ, INFA, INFB
00201       DOUBLE PRECISION SUM, AI, BI, DI, EI, MVPHNV, VALUE
00202       VALUE = 1
00203       INFA = 0
00204       INFB = 0
00205       ND = 0
00206       IJ = 0
00207       DO I = 1, N
00208          SUM = DL(I)
00209          DO J = 1, I-1
00210             IJ = IJ + 1
00211             IF ( J .LE. ND ) SUM = SUM + COV(IJ)*Y(J)
00212          END DO
00213          IF ( INFI(I) .NE. 0 ) THEN
00214             IF ( INFA .EQ. 1 ) THEN
00215                AI = MAX( AI, R*A(I) - SUM )
00216             ELSE
00217                AI = R*A(I) - SUM 
00218                INFA = 1
00219             END IF
00220          END IF
00221          IF ( INFI(I) .NE. 1 ) THEN
00222             IF ( INFB .EQ. 1 ) THEN
00223                BI = MIN( BI, R*B(I) - SUM )
00224             ELSE
00225                BI = R*B(I) - SUM 
00226                INFB = 1
00227             END IF
00228          END IF
00229          IJ = IJ + 1
00230          IF ( I .EQ. N .OR. COV(IJ+ND+2) .GT. 0 ) THEN 
00231             CALL MVLIMS( AI, BI, INFA + INFA + INFB - 1, DI, EI )
00232             IF ( DI .GE. EI ) THEN
00233                VALUE = 0
00234                RETURN
00235             ELSE
00236                VALUE = VALUE*( EI - DI )
00237                ND = ND + 1
00238                IF ( I .LT. N ) Y(ND) = MVPHNV( DI + W(ND)*( EI - DI ) )
00239                INFA = 0
00240                INFB = 0
00241             END IF
00242          END IF
00243       END DO
00244       END
00245 *
00246       SUBROUTINE MVSORT( N, LOWER, UPPER, DELTA, CORREL, INFIN, Y,PIVOT,
00247      &                  ND,     A,     B,    DL,    COV,  INFI, INFORM )
00248 *
00249 *     Subroutine to sort integration limits and determine Cholesky factor.
00250 *
00251       INTEGER N, ND, INFIN(*), INFI(*), INFORM
00252       LOGICAL PIVOT
00253       DOUBLE PRECISION     A(*),     B(*),    DL(*),    COV(*), 
00254      &                 LOWER(*), UPPER(*), DELTA(*), CORREL(*), Y(*)
00255       INTEGER I, J, K, L, M, II, IJ, IL, JL, JMIN
00256       DOUBLE PRECISION SUMSQ, AJ, BJ, SUM, EPS, EPSI, D, E
00257       DOUBLE PRECISION CVDIAG, AMIN, BMIN, DEMIN, MVTDNS
00258       PARAMETER ( EPS = 1D-6 )
00259       INFORM = 0
00260       IJ = 0
00261       II = 0
00262       ND = N
00263       DO I = 1, N
00264          A(I) = 0
00265          B(I) = 0
00266          DL(I) = 0
00267          INFI(I) = INFIN(I) 
00268          IF ( INFI(I) .LT. 0 ) THEN
00269             ND = ND - 1
00270          ELSE 
00271             IF ( INFI(I) .NE. 0 ) A(I) = LOWER(I)
00272             IF ( INFI(I) .NE. 1 ) B(I) = UPPER(I)
00273             DL(I) = DELTA(I)
00274          ENDIF
00275          DO J = 1, I-1
00276             IJ = IJ + 1
00277             II = II + 1
00278             COV(IJ) = CORREL(II)
00279          END DO
00280          IJ = IJ + 1
00281          COV(IJ) = 1
00282       END DO
00283 *
00284 *     First move any doubly infinite limits to innermost positions.
00285 *
00286       IF ( ND .GT. 0 ) THEN
00287          DO I = N, ND + 1, -1
00288             IF ( INFI(I) .GE. 0 ) THEN 
00289                DO J = 1, I-1
00290                   IF ( INFI(J) .LT. 0 ) THEN
00291                      CALL MVSWAP( J, I, A, B, DL, INFI, N, COV )
00292                      GO TO 10
00293                   ENDIF
00294                END DO
00295             ENDIF
00296          END DO
00297  10   CONTINUE
00298 *
00299 *     Sort remaining limits and determine Cholesky factor.
00300 *
00301          II = 0
00302          JL = ND
00303          DO I = 1, ND
00304 *
00305 *        Determine the integration limits for variable with minimum
00306 *        expected probability and interchange that variable with Ith.
00307 *
00308             DEMIN = 1
00309             JMIN = I
00310             CVDIAG = 0
00311             IJ = II
00312             EPSI = EPS*I*I
00313             IF ( .NOT. PIVOT ) JL = I
00314             DO J = I, JL
00315                IF ( COV(IJ+J) .GT. EPSI ) THEN
00316                   SUMSQ = SQRT( COV(IJ+J) )
00317                   SUM = DL(J) 
00318                   DO K = 1, I-1
00319                      SUM = SUM + COV(IJ+K)*Y(K)
00320                   END DO
00321                   AJ = ( A(J) - SUM )/SUMSQ
00322                   BJ = ( B(J) - SUM )/SUMSQ
00323                   CALL MVLIMS( AJ, BJ, INFI(J), D, E )
00324                   IF ( DEMIN .GE. E - D ) THEN
00325                      JMIN = J
00326                      AMIN = AJ
00327                      BMIN = BJ
00328                      DEMIN = E - D
00329                      CVDIAG = SUMSQ
00330                   ENDIF
00331                ENDIF
00332                IJ = IJ + J 
00333             END DO
00334             IF ( JMIN .GT. I ) THEN
00335                CALL MVSWAP( I, JMIN, A, B, DL, INFI, N, COV )
00336             END IF
00337             IF ( COV(II+I) .LT. -EPSI ) THEN
00338                INFORM = 3
00339             END IF
00340             COV(II+I) = CVDIAG
00341 *
00342 *        Compute Ith column of Cholesky factor.
00343 *        Compute expected value for Ith integration variable and
00344 *         scale Ith covariance matrix row and limits.
00345 *
00346             IF ( CVDIAG .GT. 0 ) THEN
00347                IL = II + I
00348                DO L = I+1, ND
00349                   COV(IL+I) = COV(IL+I)/CVDIAG
00350                   IJ = II + I
00351                   DO J = I+1, L
00352                      COV(IL+J) = COV(IL+J) - COV(IL+I)*COV(IJ+I)
00353                      IJ = IJ + J
00354                   END DO
00355                   IL = IL + L
00356                END DO
00357 * 
00358 *              Expected Y = -( density(b) - density(a) )/( b - a )
00359 * 
00360                IF ( DEMIN .GT. EPSI ) THEN
00361                   Y(I) = 0
00362                   IF ( INFI(I) .NE. 0 ) Y(I) =        MVTDNS( 0, AMIN )        
00363                   IF ( INFI(I) .NE. 1 ) Y(I) = Y(I) - MVTDNS( 0, BMIN )        
00364                   Y(I) = Y(I)/DEMIN
00365                ELSE
00366                   IF ( INFI(I) .EQ. 0 ) Y(I) = BMIN
00367                   IF ( INFI(I) .EQ. 1 ) Y(I) = AMIN
00368                   IF ( INFI(I) .EQ. 2 ) Y(I) = ( AMIN + BMIN )/2
00369                END IF
00370                DO J = 1, I
00371                   II = II + 1
00372                   COV(II) = COV(II)/CVDIAG
00373                END DO
00374                 A(I) =  A(I)/CVDIAG
00375                 B(I) =  B(I)/CVDIAG
00376                DL(I) = DL(I)/CVDIAG
00377             ELSE
00378                IL = II + I
00379                DO L = I+1, ND
00380                   COV(IL+I) = 0
00381                   IL = IL + L
00382                END DO
00383 *
00384 *        If the covariance matrix diagonal entry is zero, 
00385 *         permute limits and rows, if necessary.
00386 *
00387 *
00388                DO J = I-1, 1, -1
00389                   IF ( ABS( COV(II+J) ) .GT. EPSI ) THEN
00390                       A(I) =  A(I)/COV(II+J)
00391                       B(I) =  B(I)/COV(II+J)
00392                      DL(I) = DL(I)/COV(II+J)
00393                      IF ( COV(II+J) .LT. 0 ) THEN
00394                         CALL MVSSWP( A(I), B(I) ) 
00395                         IF ( INFI(I) .NE. 2 ) INFI(I) = 1 - INFI(I)
00396                      END IF
00397                      DO L = 1, J
00398                         COV(II+L) = COV(II+L)/COV(II+J)
00399                      END DO
00400                      DO L = J+1, I-1 
00401                         IF( COV((L-1)*L/2+J+1) .GT. 0 ) THEN
00402                            IJ = II
00403                            DO K = I-1, L, -1 
00404                               DO M = 1, K
00405                                  CALL MVSSWP( COV(IJ-K+M), COV(IJ+M) )
00406                               END DO
00407                               CALL MVSSWP(  A(K),  A(K+1) ) 
00408                               CALL MVSSWP(  B(K),  B(K+1) ) 
00409                               CALL MVSSWP( DL(K), DL(K+1) ) 
00410                               M = INFI(K)
00411                               INFI(K) = INFI(K+1)
00412                               INFI(K+1) = M
00413                               IJ = IJ - K 
00414                            END DO
00415                            GO TO 20
00416                         END IF
00417                      END DO
00418                      GO TO 20
00419                   END IF
00420                   COV(II+J) = 0
00421                END DO
00422  20            II = II + I
00423                Y(I) = 0
00424             END IF
00425          END DO
00426       ENDIF
00427       END
00428 *
00429       DOUBLE PRECISION FUNCTION MVTDNS( NU, X )
00430       INTEGER NU, I
00431       DOUBLE PRECISION X, PROD, PI, SQTWPI
00432       PARAMETER (     PI = 3.141592653589793D0 )
00433       PARAMETER ( SQTWPI = 2.506628274631001D0 )
00434       MVTDNS = 0
00435       IF ( NU .GT. 0 ) THEN
00436          PROD = 1/SQRT( DBLE(NU) )
00437          DO I = NU - 2, 1, -2
00438             PROD = PROD*( I + 1 )/I
00439          END DO
00440          IF ( MOD( NU, 2 ) .EQ. 0 ) THEN
00441             PROD = PROD/2
00442          ELSE
00443             PROD = PROD/PI
00444          END IF
00445          MVTDNS = PROD/SQRT( 1 + X*X/NU )**( NU + 1 )
00446       ELSE
00447         IF ( ABS(X) .LT. 10 ) MVTDNS = EXP( -X*X/2 )/SQTWPI
00448       END IF
00449       END
00450 *
00451       SUBROUTINE MVLIMS( A, B, INFIN, LOWER, UPPER )
00452       DOUBLE PRECISION A, B, LOWER, UPPER, MVPHI
00453       INTEGER INFIN
00454       LOWER = 0
00455       UPPER = 1
00456       IF ( INFIN .GE. 0 ) THEN
00457          IF ( INFIN .NE. 0 ) LOWER = MVPHI(A)
00458          IF ( INFIN .NE. 1 ) UPPER = MVPHI(B)
00459       ENDIF
00460       UPPER = MAX( UPPER, LOWER )
00461       END      
00462 *
00463       SUBROUTINE MVSSWP( X, Y )
00464       DOUBLE PRECISION X, Y, T
00465       T = X
00466       X = Y
00467       Y = T
00468       END
00469 *
00470       SUBROUTINE MVSWAP( P, Q, A, B, D, INFIN, N, C )
00471 *
00472 *     Swaps rows and columns P and Q in situ, with P <= Q.
00473 *
00474       DOUBLE PRECISION A(*), B(*), C(*), D(*)
00475       INTEGER INFIN(*), P, Q, N, I, J, II, JJ
00476       CALL MVSSWP( A(P), A(Q) )
00477       CALL MVSSWP( B(P), B(Q) )
00478       CALL MVSSWP( D(P), D(Q) )
00479       J = INFIN(P)
00480       INFIN(P) = INFIN(Q)
00481       INFIN(Q) = J
00482       JJ = ( P*( P - 1 ) )/2
00483       II = ( Q*( Q - 1 ) )/2
00484       CALL MVSSWP( C(JJ+P), C(II+Q) )
00485       DO J = 1, P-1
00486          CALL MVSSWP( C(JJ+J), C(II+J) )
00487       END DO
00488       JJ = JJ + P
00489       DO I = P+1, Q-1
00490          CALL MVSSWP( C(JJ+P), C(II+I) )
00491          JJ = JJ + I
00492       END DO
00493       II = II + Q
00494       DO I = Q+1, N
00495          CALL MVSSWP( C(II+P), C(II+Q) )
00496          II = II + I
00497       END DO
00498       END
00499 *
00500       DOUBLE PRECISION FUNCTION MVPHI(Z)
00501 *     
00502 *     Normal distribution probabilities accurate to 1d-15.
00503 *     Reference: J.L. Schonfelder, Math Comp 32(1978), pp 1232-1240. 
00504 *     
00505       INTEGER I, IM
00506       DOUBLE PRECISION A(0:43), BM, B, BP, P, RTWO, T, XA, Z
00507       PARAMETER( RTWO = 1.414213562373095048801688724209D0, IM = 24 )
00508       SAVE A
00509       DATA ( A(I), I = 0, 43 )/
00510      &    6.10143081923200417926465815756D-1,
00511      &   -4.34841272712577471828182820888D-1,
00512      &    1.76351193643605501125840298123D-1,
00513      &   -6.0710795609249414860051215825D-2,
00514      &    1.7712068995694114486147141191D-2,
00515      &   -4.321119385567293818599864968D-3, 
00516      &    8.54216676887098678819832055D-4, 
00517      &   -1.27155090609162742628893940D-4,
00518      &    1.1248167243671189468847072D-5, 3.13063885421820972630152D-7,      
00519      &   -2.70988068537762022009086D-7, 3.0737622701407688440959D-8,
00520      &    2.515620384817622937314D-9, -1.028929921320319127590D-9,
00521      &    2.9944052119949939363D-11, 2.6051789687266936290D-11,
00522      &   -2.634839924171969386D-12, -6.43404509890636443D-13,
00523      &    1.12457401801663447D-13, 1.7281533389986098D-14, 
00524      &   -4.264101694942375D-15, -5.45371977880191D-16,
00525      &    1.58697607761671D-16, 2.0899837844334D-17, 
00526      &   -5.900526869409D-18, -9.41893387554D-19, 2.14977356470D-19, 
00527      &    4.6660985008D-20, -7.243011862D-21, -2.387966824D-21, 
00528      &    1.91177535D-22, 1.20482568D-22, -6.72377D-25, -5.747997D-24,
00529      &   -4.28493D-25, 2.44856D-25, 4.3793D-26, -8.151D-27, -3.089D-27, 
00530      &    9.3D-29, 1.74D-28, 1.6D-29, -8.0D-30, -2.0D-30 /       
00531 *     
00532       XA = ABS(Z)/RTWO
00533       IF ( XA .GT. 100 ) THEN
00534          P = 0
00535       ELSE
00536          T = ( 8*XA - 30 ) / ( 4*XA + 15 )
00537          BM = 0
00538          B  = 0
00539          DO I = IM, 0, -1 
00540             BP = B
00541             B  = BM
00542             BM = T*B - BP  + A(I)
00543          END DO
00544          P = EXP( -XA*XA )*( BM - BP )/4
00545       END IF
00546       IF ( Z .GT. 0 ) P = 1 - P
00547       MVPHI = P
00548       END
00549 *
00550       DOUBLE PRECISION FUNCTION MVPHNV(P)
00551 *
00552 *       ALGORITHM AS241  APPL. STATIST. (1988) VOL. 37, NO. 3
00553 *
00554 *       Produces the normal deviate Z corresponding to a given lower
00555 *       tail area of P.
00556 *
00557 *       The hash sums below are the sums of the mantissas of the
00558 *       coefficients.   They are included for use in checking
00559 *       transcription.
00560 *
00561       DOUBLE PRECISION SPLIT1, SPLIT2, CONST1, CONST2, 
00562      *     A0, A1, A2, A3, A4, A5, A6, A7, B1, B2, B3, B4, B5, B6, B7, 
00563      *     C0, C1, C2, C3, C4, C5, C6, C7, D1, D2, D3, D4, D5, D6, D7, 
00564      *     E0, E1, E2, E3, E4, E5, E6, E7, F1, F2, F3, F4, F5, F6, F7, 
00565      *     P, Q, R
00566       PARAMETER ( SPLIT1 = 0.425, SPLIT2 = 5,
00567      *            CONST1 = 0.180625D0, CONST2 = 1.6D0 )
00568 *     
00569 *     Coefficients for P close to 0.5
00570 *     
00571       PARAMETER (
00572      *     A0 = 3.38713 28727 96366 6080D0,
00573      *     A1 = 1.33141 66789 17843 7745D+2,
00574      *     A2 = 1.97159 09503 06551 4427D+3,
00575      *     A3 = 1.37316 93765 50946 1125D+4,
00576      *     A4 = 4.59219 53931 54987 1457D+4,
00577      *     A5 = 6.72657 70927 00870 0853D+4,
00578      *     A6 = 3.34305 75583 58812 8105D+4,
00579      *     A7 = 2.50908 09287 30122 6727D+3,
00580      *     B1 = 4.23133 30701 60091 1252D+1,
00581      *     B2 = 6.87187 00749 20579 0830D+2,
00582      *     B3 = 5.39419 60214 24751 1077D+3,
00583      *     B4 = 2.12137 94301 58659 5867D+4,
00584      *     B5 = 3.93078 95800 09271 0610D+4,
00585      *     B6 = 2.87290 85735 72194 2674D+4,
00586      *     B7 = 5.22649 52788 52854 5610D+3 )
00587 *     HASH SUM AB    55.88319 28806 14901 4439
00588 *     
00589 *     Coefficients for P not close to 0, 0.5 or 1.
00590 *     
00591       PARAMETER (
00592      *     C0 = 1.42343 71107 49683 57734D0,
00593      *     C1 = 4.63033 78461 56545 29590D0,
00594      *     C2 = 5.76949 72214 60691 40550D0,
00595      *     C3 = 3.64784 83247 63204 60504D0,
00596      *     C4 = 1.27045 82524 52368 38258D0,
00597      *     C5 = 2.41780 72517 74506 11770D-1,
00598      *     C6 = 2.27238 44989 26918 45833D-2,
00599      *     C7 = 7.74545 01427 83414 07640D-4,
00600      *     D1 = 2.05319 16266 37758 82187D0,
00601      *     D2 = 1.67638 48301 83803 84940D0,
00602      *     D3 = 6.89767 33498 51000 04550D-1,
00603      *     D4 = 1.48103 97642 74800 74590D-1,
00604      *     D5 = 1.51986 66563 61645 71966D-2,
00605      *     D6 = 5.47593 80849 95344 94600D-4,
00606      *     D7 = 1.05075 00716 44416 84324D-9 )
00607 *     HASH SUM CD    49.33206 50330 16102 89036
00608 *
00609 *       Coefficients for P near 0 or 1.
00610 *
00611       PARAMETER (
00612      *     E0 = 6.65790 46435 01103 77720D0,
00613      *     E1 = 5.46378 49111 64114 36990D0,
00614      *     E2 = 1.78482 65399 17291 33580D0,
00615      *     E3 = 2.96560 57182 85048 91230D-1,
00616      *     E4 = 2.65321 89526 57612 30930D-2,
00617      *     E5 = 1.24266 09473 88078 43860D-3,
00618      *     E6 = 2.71155 55687 43487 57815D-5,
00619      *     E7 = 2.01033 43992 92288 13265D-7,
00620      *     F1 = 5.99832 20655 58879 37690D-1,
00621      *     F2 = 1.36929 88092 27358 05310D-1,
00622      *     F3 = 1.48753 61290 85061 48525D-2,
00623      *     F4 = 7.86869 13114 56132 59100D-4,
00624      *     F5 = 1.84631 83175 10054 68180D-5,
00625      *     F6 = 1.42151 17583 16445 88870D-7,
00626      *     F7 = 2.04426 31033 89939 78564D-15 )
00627 *     HASH SUM EF    47.52583 31754 92896 71629
00628 *     
00629       Q = ( 2*P - 1 )/2
00630       IF ( ABS(Q) .LE. SPLIT1 ) THEN
00631          R = CONST1 - Q*Q
00632          MVPHNV = Q*( ( ( ((((A7*R + A6)*R + A5)*R + A4)*R + A3)
00633      *                  *R + A2 )*R + A1 )*R + A0 )
00634      *            /( ( ( ((((B7*R + B6)*R + B5)*R + B4)*R + B3)
00635      *                  *R + B2 )*R + B1 )*R + 1 )
00636       ELSE
00637          R = MIN( P, 1 - P )
00638          IF ( R .GT. 0 ) THEN
00639             R = SQRT( -LOG(R) )
00640             IF ( R .LE. SPLIT2 ) THEN
00641                R = R - CONST2
00642                MVPHNV = ( ( ( ((((C7*R + C6)*R + C5)*R + C4)*R + C3)
00643      *                      *R + C2 )*R + C1 )*R + C0 ) 
00644      *                /( ( ( ((((D7*R + D6)*R + D5)*R + D4)*R + D3)
00645      *                      *R + D2 )*R + D1 )*R + 1 )
00646             ELSE
00647                R = R - SPLIT2
00648                MVPHNV = ( ( ( ((((E7*R + E6)*R + E5)*R + E4)*R + E3)
00649      *                      *R + E2 )*R + E1 )*R + E0 )
00650      *                /( ( ( ((((F7*R + F6)*R + F5)*R + F4)*R + F3)
00651      *                      *R + F2 )*R + F1 )*R + 1 )
00652             END IF
00653          ELSE
00654             MVPHNV = 9
00655          END IF
00656          IF ( Q .LT. 0 ) MVPHNV = - MVPHNV
00657       END IF
00658       END
00659       DOUBLE PRECISION FUNCTION MVBVN( LOWER, UPPER, INFIN, CORREL )
00660 *
00661 *     A function for computing bivariate normal probabilities.
00662 *
00663 *  Parameters
00664 *
00665 *     LOWER  REAL, array of lower integration limits.
00666 *     UPPER  REAL, array of upper integration limits.
00667 *     INFIN  INTEGER, array of integration limits flags:
00668 *            if INFIN(I) = 0, Ith limits are (-infinity, UPPER(I)];
00669 *            if INFIN(I) = 1, Ith limits are [LOWER(I), infinity);
00670 *            if INFIN(I) = 2, Ith limits are [LOWER(I), UPPER(I)].
00671 *     CORREL REAL, correlation coefficient.
00672 *
00673       DOUBLE PRECISION LOWER(*), UPPER(*), CORREL, MVBVU
00674       INTEGER INFIN(*)
00675       IF ( INFIN(1) .EQ. 2  .AND. INFIN(2) .EQ. 2 ) THEN
00676          MVBVN =  MVBVU ( LOWER(1), LOWER(2), CORREL )
00677      +           - MVBVU ( UPPER(1), LOWER(2), CORREL )
00678      +           - MVBVU ( LOWER(1), UPPER(2), CORREL )
00679      +           + MVBVU ( UPPER(1), UPPER(2), CORREL )
00680       ELSE IF ( INFIN(1) .EQ. 2  .AND. INFIN(2) .EQ. 1 ) THEN
00681          MVBVN =  MVBVU ( LOWER(1), LOWER(2), CORREL )
00682      +           - MVBVU ( UPPER(1), LOWER(2), CORREL )
00683       ELSE IF ( INFIN(1) .EQ. 1  .AND. INFIN(2) .EQ. 2 ) THEN
00684          MVBVN =  MVBVU ( LOWER(1), LOWER(2), CORREL )
00685      +           - MVBVU ( LOWER(1), UPPER(2), CORREL )
00686       ELSE IF ( INFIN(1) .EQ. 2  .AND. INFIN(2) .EQ. 0 ) THEN
00687          MVBVN =  MVBVU ( -UPPER(1), -UPPER(2), CORREL )
00688      +           - MVBVU ( -LOWER(1), -UPPER(2), CORREL )
00689       ELSE IF ( INFIN(1) .EQ. 0  .AND. INFIN(2) .EQ. 2 ) THEN
00690          MVBVN =  MVBVU ( -UPPER(1), -UPPER(2), CORREL )
00691      +           - MVBVU ( -UPPER(1), -LOWER(2), CORREL )
00692       ELSE IF ( INFIN(1) .EQ. 1  .AND. INFIN(2) .EQ. 0 ) THEN
00693          MVBVN =  MVBVU ( LOWER(1), -UPPER(2), -CORREL )
00694       ELSE IF ( INFIN(1) .EQ. 0  .AND. INFIN(2) .EQ. 1 ) THEN
00695          MVBVN =  MVBVU ( -UPPER(1), LOWER(2), -CORREL )
00696       ELSE IF ( INFIN(1) .EQ. 1  .AND. INFIN(2) .EQ. 1 ) THEN
00697          MVBVN =  MVBVU ( LOWER(1), LOWER(2), CORREL )
00698       ELSE IF ( INFIN(1) .EQ. 0  .AND. INFIN(2) .EQ. 0 ) THEN
00699          MVBVN =  MVBVU ( -UPPER(1), -UPPER(2), CORREL )
00700       ELSE
00701          MVBVN = 1
00702       END IF
00703       END 
00704       DOUBLE PRECISION FUNCTION MVBVU( SH, SK, R )
00705 *
00706 *     A function for computing bivariate normal probabilities;
00707 *       developed using 
00708 *         Drezner, Z. and Wesolowsky, G. O. (1989),
00709 *         On the Computation of the Bivariate Normal Integral,
00710 *         J. Stat. Comput. Simul.. 35 pp. 101-107.
00711 *       with extensive modications for double precisions by    
00712 *         Alan Genz and Yihong Ge
00713 *         Department of Mathematics
00714 *         Washington State University
00715 *         Pullman, WA 99164-3113
00716 *         Email : alangenz@wsu.edu
00717 *
00718 * BVN - calculate the probability that X is larger than SH and Y is
00719 *       larger than SK.
00720 *
00721 * Parameters
00722 *
00723 *   SH  REAL, integration limit
00724 *   SK  REAL, integration limit
00725 *   R   REAL, correlation coefficient
00726 *   LG  INTEGER, number of Gauss Rule Points and Weights
00727 *
00728       DOUBLE PRECISION BVN, SH, SK, R, ZERO, TWOPI 
00729       INTEGER I, LG, NG
00730       PARAMETER ( ZERO = 0, TWOPI = 6.283185307179586D0 ) 
00731       DOUBLE PRECISION X(10,3), W(10,3), AS, A, B, C, D, RS, XS
00732       DOUBLE PRECISION MVPHI, SN, ASR, H, K, BS, HS, HK
00733       SAVE X, W
00734 *     Gauss Legendre Points and Weights, N =  6
00735       DATA ( W(I,1), X(I,1), I = 1, 3 ) /
00736      *  0.1713244923791705D+00,-0.9324695142031522D+00,
00737      *  0.3607615730481384D+00,-0.6612093864662647D+00,
00738      *  0.4679139345726904D+00,-0.2386191860831970D+00/
00739 *     Gauss Legendre Points and Weights, N = 12
00740       DATA ( W(I,2), X(I,2), I = 1, 6 ) /
00741      *  0.4717533638651177D-01,-0.9815606342467191D+00,
00742      *  0.1069393259953183D+00,-0.9041172563704750D+00,
00743      *  0.1600783285433464D+00,-0.7699026741943050D+00,
00744      *  0.2031674267230659D+00,-0.5873179542866171D+00,
00745      *  0.2334925365383547D+00,-0.3678314989981802D+00,
00746      *  0.2491470458134029D+00,-0.1252334085114692D+00/
00747 *     Gauss Legendre Points and Weights, N = 20
00748       DATA ( W(I,3), X(I,3), I = 1, 10 ) /
00749      *  0.1761400713915212D-01,-0.9931285991850949D+00,
00750      *  0.4060142980038694D-01,-0.9639719272779138D+00,
00751      *  0.6267204833410906D-01,-0.9122344282513259D+00,
00752      *  0.8327674157670475D-01,-0.8391169718222188D+00,
00753      *  0.1019301198172404D+00,-0.7463319064601508D+00,
00754      *  0.1181945319615184D+00,-0.6360536807265150D+00,
00755      *  0.1316886384491766D+00,-0.5108670019508271D+00,
00756      *  0.1420961093183821D+00,-0.3737060887154196D+00,
00757      *  0.1491729864726037D+00,-0.2277858511416451D+00,
00758      *  0.1527533871307259D+00,-0.7652652113349733D-01/
00759       IF ( ABS(R) .LT. 0.3 ) THEN
00760          NG = 1
00761          LG = 3
00762       ELSE IF ( ABS(R) .LT. 0.75 ) THEN
00763          NG = 2
00764          LG = 6
00765       ELSE 
00766          NG = 3
00767          LG = 10
00768       ENDIF
00769       H = SH
00770       K = SK 
00771       HK = H*K
00772       BVN = 0
00773       IF ( ABS(R) .LT. 0.925 ) THEN
00774          HS = ( H*H + K*K )/2
00775          ASR = ASIN(R)
00776          DO I = 1, LG
00777             SN = SIN(ASR*( X(I,NG)+1 )/2)
00778             BVN = BVN + W(I,NG)*EXP( ( SN*HK - HS )/( 1 - SN*SN ) )
00779             SN = SIN(ASR*(-X(I,NG)+1 )/2)
00780             BVN = BVN + W(I,NG)*EXP( ( SN*HK - HS )/( 1 - SN*SN ) )
00781          END DO
00782          BVN = BVN*ASR/(2*TWOPI) + MVPHI(-H)*MVPHI(-K) 
00783       ELSE
00784          IF ( R .LT. 0 ) THEN
00785             K = -K
00786             HK = -HK
00787          ENDIF
00788          IF ( ABS(R) .LT. 1 ) THEN
00789             AS = ( 1 - R )*( 1 + R )
00790             A = SQRT(AS)
00791             BS = ( H - K )**2
00792             C = ( 4 - HK )/8 
00793             D = ( 12 - HK )/16
00794             BVN = A*EXP( -(BS/AS + HK)/2 )
00795      +             *( 1 - C*(BS - AS)*(1 - D*BS/5)/3 + C*D*AS*AS/5 )
00796             IF ( HK .GT. -160 ) THEN
00797                B = SQRT(BS)
00798                BVN = BVN - EXP(-HK/2)*SQRT(TWOPI)*MVPHI(-B/A)*B
00799      +                    *( 1 - C*BS*( 1 - D*BS/5 )/3 ) 
00800             ENDIF
00801             A = A/2
00802             DO I = 1, LG
00803                XS = ( A*(X(I,NG)+1) )**2
00804                RS = SQRT( 1 - XS )
00805                BVN = BVN + A*W(I,NG)*
00806      +              ( EXP( -BS/(2*XS) - HK/(1+RS) )/RS 
00807      +              - EXP( -(BS/XS+HK)/2 )*( 1 + C*XS*( 1 + D*XS ) ) )
00808                XS = AS*(-X(I,NG)+1)**2/4
00809                RS = SQRT( 1 - XS )
00810                BVN = BVN + A*W(I,NG)*EXP( -(BS/XS + HK)/2 )
00811      +                    *( EXP( -HK*(1-RS)/(2*(1+RS)) )/RS 
00812      +                       - ( 1 + C*XS*( 1 + D*XS ) ) )
00813             END DO
00814             BVN = -BVN/TWOPI
00815          ENDIF
00816          IF ( R .GT. 0 ) BVN =  BVN + MVPHI( -MAX( H, K ) )
00817          IF ( R .LT. 0 ) BVN = -BVN + MAX( ZERO, MVPHI(-H) - MVPHI(-K) )     
00818       ENDIF
00819       MVBVU = BVN
00820       END
00821 *
00822       DOUBLE PRECISION FUNCTION MVSTDT( NU, T )
00823 *
00824 *     Student t Distribution Function
00825 *
00826 *                       T
00827 *         TSTDNT = C   I  ( 1 + y*y/NU )**( -(NU+1)/2 ) dy
00828 *                   NU -INF
00829 *
00830       INTEGER NU, J
00831       DOUBLE PRECISION MVPHI, T, CSTHE, SNTHE, POLYN, TT, TS, RN, PI
00832       PARAMETER ( PI = 3.141592653589793D0 )
00833       IF ( NU .LT. 1 ) THEN
00834          MVSTDT = MVPHI( T )
00835       ELSE IF ( NU .EQ. 1 ) THEN
00836          MVSTDT = ( 1 + 2*ATAN( T )/PI )/2
00837       ELSE IF ( NU .EQ. 2) THEN
00838          MVSTDT = ( 1 + T/SQRT( 2 + T*T ))/2
00839       ELSE 
00840          TT = T*T
00841          CSTHE = NU/( NU + TT )
00842          POLYN = 1
00843          DO J = NU - 2, 2, -2
00844             POLYN = 1 + ( J - 1 )*CSTHE*POLYN/J
00845          END DO
00846          IF ( MOD( NU, 2 ) .EQ. 1 ) THEN
00847             RN = NU
00848             TS = T/SQRT(RN)
00849             MVSTDT = ( 1 + 2*( ATAN( TS ) + TS*CSTHE*POLYN )/PI )/2
00850          ELSE
00851             SNTHE = T/SQRT( NU + TT )
00852             MVSTDT = ( 1 + SNTHE*POLYN )/2
00853          END IF
00854          IF ( MVSTDT .LT. 0 ) MVSTDT = 0
00855       ENDIF
00856       END
00857 *
00858       DOUBLE PRECISION FUNCTION MVBVT( NU, LOWER, UPPER, INFIN, CORREL )      
00859 *
00860 *     A function for computing bivariate normal and t probabilities.
00861 *
00862 *  Parameters
00863 *
00864 *     NU     INTEGER degrees of freedom parameter; NU < 1 gives normal case.
00865 *     LOWER  REAL, array of lower integration limits.
00866 *     UPPER  REAL, array of upper integration limits.
00867 *     INFIN  INTEGER, array of integration limits flags:
00868 *            if INFIN(I) = 0, Ith limits are (-infinity, UPPER(I)];
00869 *            if INFIN(I) = 1, Ith limits are [LOWER(I), infinity);
00870 *            if INFIN(I) = 2, Ith limits are [LOWER(I), UPPER(I)].
00871 *     CORREL REAL, correlation coefficient.
00872 *
00873       DOUBLE PRECISION LOWER(*), UPPER(*), CORREL, MVBVN, MVBVTL
00874       INTEGER NU, INFIN(*)
00875       IF ( NU .LT. 1 ) THEN
00876             MVBVT =  MVBVN ( LOWER, UPPER, INFIN, CORREL )
00877       ELSE
00878          IF ( INFIN(1) .EQ. 2  .AND. INFIN(2) .EQ. 2 ) THEN
00879             MVBVT =  MVBVTL ( NU, UPPER(1), UPPER(2), CORREL )
00880      +           - MVBVTL ( NU, UPPER(1), LOWER(2), CORREL )
00881      +           - MVBVTL ( NU, LOWER(1), UPPER(2), CORREL )
00882      +           + MVBVTL ( NU, LOWER(1), LOWER(2), CORREL )
00883          ELSE IF ( INFIN(1) .EQ. 2  .AND. INFIN(2) .EQ. 1 ) THEN
00884             MVBVT =  MVBVTL ( NU, -LOWER(1), -LOWER(2), CORREL )
00885      +           - MVBVTL ( NU, -UPPER(1), -LOWER(2), CORREL )
00886          ELSE IF ( INFIN(1) .EQ. 1  .AND. INFIN(2) .EQ. 2 ) THEN
00887             MVBVT =  MVBVTL ( NU, -LOWER(1), -LOWER(2), CORREL )
00888      +           - MVBVTL ( NU, -LOWER(1), -UPPER(2), CORREL )
00889          ELSE IF ( INFIN(1) .EQ. 2  .AND. INFIN(2) .EQ. 0 ) THEN
00890             MVBVT =  MVBVTL ( NU, UPPER(1), UPPER(2), CORREL )
00891      +           - MVBVTL ( NU, LOWER(1), UPPER(2), CORREL )
00892          ELSE IF ( INFIN(1) .EQ. 0  .AND. INFIN(2) .EQ. 2 ) THEN
00893             MVBVT =  MVBVTL ( NU, UPPER(1), UPPER(2), CORREL )
00894      +           - MVBVTL ( NU, UPPER(1), LOWER(2), CORREL )
00895          ELSE IF ( INFIN(1) .EQ. 1  .AND. INFIN(2) .EQ. 0 ) THEN
00896             MVBVT =  MVBVTL ( NU, -LOWER(1), UPPER(2), -CORREL )
00897          ELSE IF ( INFIN(1) .EQ. 0  .AND. INFIN(2) .EQ. 1 ) THEN
00898             MVBVT =  MVBVTL ( NU, UPPER(1), -LOWER(2), -CORREL )
00899          ELSE IF ( INFIN(1) .EQ. 1  .AND. INFIN(2) .EQ. 1 ) THEN
00900             MVBVT =  MVBVTL ( NU, -LOWER(1), -LOWER(2), CORREL )
00901          ELSE IF ( INFIN(1) .EQ. 0  .AND. INFIN(2) .EQ. 0 ) THEN
00902             MVBVT =  MVBVTL ( NU, UPPER(1), UPPER(2), CORREL )
00903          ELSE
00904             MVBVT = 1
00905          END IF
00906       END IF
00907       END
00908 *
00909       DOUBLE PRECISION FUNCTION MVBVTC( NU, L, U, INFIN, RHO )      
00910 *
00911 *     A function for computing complementary bivariate normal and t 
00912 *       probabilities.
00913 *
00914 *  Parameters
00915 *
00916 *     NU     INTEGER degrees of freedom parameter.
00917 *     L      REAL, array of lower integration limits.
00918 *     U      REAL, array of upper integration limits.
00919 *     INFIN  INTEGER, array of integration limits flags:
00920 *            if INFIN(1) INFIN(2),        then MVBVTC computes
00921 *                 0         0              P( X>U(1), Y>U(2) )
00922 *                 1         0              P( X<L(1), Y>U(2) )
00923 *                 0         1              P( X>U(1), Y<L(2) )
00924 *                 1         1              P( X<L(1), Y<L(2) )
00925 *                 2         0      P( X>U(1), Y>U(2) ) + P( X<L(1), Y>U(2) )
00926 *                 2         1      P( X>U(1), Y<L(2) ) + P( X<L(1), Y<L(2) )
00927 *                 0         2      P( X>U(1), Y>U(2) ) + P( X>U(1), Y<L(2) )
00928 *                 1         2      P( X<L(1), Y>U(2) ) + P( X<L(1), Y<L(2) )
00929 *                 2         2      P( X>U(1), Y<L(2) ) + P( X<L(1), Y<L(2) )
00930 *                               +  P( X>U(1), Y>U(2) ) + P( X<L(1), Y>U(2) )
00931 *
00932 *     RHO    REAL, correlation coefficient.
00933 *
00934       DOUBLE PRECISION L(*), U(*), LW(2), UP(2), B, RHO, MVBVT
00935       INTEGER I, NU, INFIN(*), INF(2)
00936 *
00937       DO I = 1, 2
00938          IF ( MOD( INFIN(I), 2 ) .EQ. 0 ) THEN
00939             INF(I) = 1
00940             LW(I) = U(I) 
00941          ELSE
00942             INF(I) = 0
00943             UP(I) = L(I) 
00944          END IF
00945       END DO
00946       B = MVBVT( NU, LW, UP, INF, RHO )
00947       DO I = 1, 2
00948          IF ( INFIN(I) .EQ. 2 ) THEN
00949             INF(I) = 0
00950             UP(I) = L(I) 
00951             B = B + MVBVT( NU, LW, UP, INF, RHO )
00952          END IF
00953       END DO
00954       IF ( INFIN(1) .EQ. 2 .AND. INFIN(2) .EQ. 2 ) THEN
00955          INF(1) = 1
00956          LW(1) = U(1) 
00957          B = B + MVBVT( NU, LW, UP, INF, RHO )
00958       END IF
00959       MVBVTC = B
00960       END
00961 *
00962       double precision function mvbvtl( nu, dh, dk, r )
00963 *
00964 *     a function for computing bivariate t probabilities.
00965 *
00966 *       Alan Genz
00967 *       Department of Mathematics
00968 *       Washington State University
00969 *       Pullman, Wa 99164-3113
00970 *       Email : alangenz@wsu.edu
00971 *
00972 *    this function is based on the method described by 
00973 *        Dunnett, C.W. and M. Sobel, (1954),
00974 *        A bivariate generalization of Student
00975 
00976 
00977 
00978 
00979 
00980 
00981 
00982 
00983 
00984 
00985 
00986 
00987 
00988 
00989 
00990 
00991 
00992 
00993 
00994 
00995 
00996 
00997 
00998 
00999 
01000 
01001 
01002 
01003 
01004 
01005 
01006 
01007 
01008 
01009 
01010 
01011 
01012 
01013 
01014 
01015 
01016 
01017 
01018 
01019 
01020 
01021 
01022 
01023 
01024 
01025 
01026 
01027 
01028 
01029 
01030 
01031 
01032 
01033 
01034 
01035 
01036 
01037 
01038 
01039 
01040 
01041 
01042 
01043 
01044 
01045 
01046 
01047 
01048 
01049 
01050 
01051 
01052 
01053 
01054 
01055 
01056 
01057 
01058 
01059 
01060 
01061 
01062 
01063 
01064 
01065 
01066 
01067 
01068 
01069 
01070 
01071 
01072 
01073 
01074 
01075 
01076 
01077 
01078 
01079 
01080 
01081 
01082 
01083 
01084 
01085 
01086 
01087 
01088 
01089 
01090 
01091 
01092 
01093 
01094 
01095 
01096 
01097 
01098 
01099 
01100 
01101 
01102 
01103 
01104 
01105 
01106 
01107 
01108 
01109 
01110 
01111 
01112 
01113 
01114 
01115 
01116 
01117 
01118 
01119 
01120 
01121 
01122 
01123 
01124 
01125 
01126 
01127 
01128 
01129 
01130 
01131 
01132 
01133 
01134 
01135 
01136 
01137 
01138 
01139 
01140 
01141 
01142 
01143 
01144 
01145 
01146 
01147 
01148 
01149 
01150 
01151 
01152 
01153 
01154 
01155 
01156 
01157 
01158 
01159 
01160 
01161 
01162 
01163 
01164 
01165 
01166 
01167 
01168 
01169 
01170 
01171 
01172 
01173 
01174 
01175 
01176 
01177 
01178 
01179 
01180 
01181 
01182 
01183 
01184 
01185 
01186 
01187 
01188 
01189 
01190 
01191 
01192 "Randomization of Number Theoretic Methods for Multiple Integration"
01193 
01194 
01195 "Randomization of Number Theoretic Methods for Multiple Integration"*    R. Cranley and T.N.L. Patterson, SIAM J Numer Anal, 13, pp. 904-14,*  and *   "Optimal Parameters for Multidimensional Integration
01196 
01197 
01198 
01199 ", *    P. Keast, SIAM J Numer Anal, 10, pp.831-838.*  If there are more than 100 variables, the remaining variables are*  integrated using the rules described in the reference*   "On a Number-Theoretical Integration Method
01200 
01201 
01202 
01203 
01204 
01205 
01206 
01207 
01208 
01209 
01210 
01211 
01212 
01213 
01214 
01215 
01216 
01217 
01218 
01219 
01220 
01221 
01222 
01223 
01224 
01225 
01226 
01227 
01228 
01229 
01230 
01231 
01232 
01233 
01234 
01235 
01236 
01237 
01238 
01239 
01240 
01241 
01242 
01243 
01244 
01245 
01246 
01247 
01248 
01249 
01250 
01251 
01252 
01253 
01254 
01255 
01256 
01257 
01258 
01259 
01260 
01261 
01262 
01263 
01264 
01265 
01266 
01267 
01268 
01269 
01270 
01271 
01272 
01273 
01274 
01275 
01276 
01277 
01278 
01279 
01280 
01281 
01282 
01283 
01284 
01285 
01286 
01287 
01288 
01289 
01290 
01291 
01292 
01293 
01294 
01295 
01296 
01297 
01298 
01299 
01300 
01301 
01302 
01303 
01304 
01305 
01306 
01307 
01308 
01309 
01310 
01311 
01312 
01313 
01314 
01315 
01316 
01317 
01318 
01319 
01320 
01321 
01322 
01323 
01324 
01325 
01326 
01327 
01328 
01329 
01330 
01331 
01332 
01333 
01334 
01335 
01336 
01337 
01338 
01339 
01340 
01341 
01342 
01343 
01344 
01345 
01346 
01347 
01348 
01349 
01350 
01351 
01352 
01353 
01354 
01355 
01356 
01357 
01358 
01359 
01360 
01361 
01362 
01363 
01364 
01365 
01366 
01367 
01368 
01369 
01370 
01371 
01372 
01373 
01374 
01375 
01376 
01377 
01378 
01379 
01380 
01381 
01382 
01383 
01384 
01385 
01386 
01387 
01388 
01389 
01390 
01391 
01392 
01393 
01394 
01395 
01396 
01397 
01398 
01399 
01400 
01401 
01402 
01403 
01404 
01405 
01406 
01407 
01408 
01409 
01410 
01411 
01412 
01413 
01414 
01415 
01416 
01417 
01418 
01419 
01420 
01421 
01422 
01423 
01424 
01425 
01426 
01427 
01428 
01429 
01430 
01431 
01432 
01433 
01434 
01435 
01436 
01437 
01438 
01439 
01440 
01441 
01442 
01443 
01444 
01445 
01446 
01447 
01448 
01449 
01450 
01451 
01452 
01453 
01454 
01455 
01456 
01457 
01458 
01459 
01460 
01461 
01462 
01463 
01464 
01465 
01466 
01467 
01468 
01469 
01470 
01471 
01472 
01473 
01474 
01475 
01476 
01477 
01478 
01479 
01480 
01481 
01482 
01483 
01484 
01485 
01486 
01487 
01488 
01489 
01490 
01491 
01492 
01493 
01494 's random number generator directly*     the way `Writing R extentions'
01495 
01496 
01497 
01498 
01499 
01500 

Generated on Thu Jun 26 11:36:23 2008 for party by  doxygen 1.5.5