C---------------------------------------------------------------C
C  FUNCTION GHB1 GAUSS-HERMITES                                 C
C    FOR CONSTRAINED MCB INFERENCE WITH 1 FACTOR                C
C  INPUT VARIABLES:                                             C
C    K   = NUMBER OF TREATMENTS                                 C
C    D   = CRITICAL VALUE                                       C
C    S   = CHI/SQRT(NU) VARIABLE                                C
C    IMC = NOT USED AT PRESENT                                  C
C  INTERNAL VARIABLE:                                           C
C    M   = NUMBER OF GAUSS-HERMITE QUADRATURE POINTS            C
C  LAST REVISION: 02-04-91 BY JCH                               C
C---------------------------------------------------------------C
      DOUBLEPRECISION FUNCTION GHB1(IMC,K,D,S)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
C6    IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION A(100),B(100),C(100)
      DIMENSION PH(48),WH(48),WHLN(48),ZH(48)
      DIMENSION XN(96),VCDFN(96)
      DIMENSION VFMC(48)
      COMMON/LIST2/A,B,C
      COMMON/LIST6/PH,WH,ZH,WHLN
      COMMON/LIST8/ZERO,ZSR,ZLOG,ZLN
      COMMON/LIST9/SR2,PI,SRPI,PIB2
C
      KM1=K-1
      F=0.0D0
      DTS=D*S
      M=48
C
      DO 100 I=1,M
        VFMC(I)=1.0D0
 100  CONTINUE
C
      DO 400 J=1,KM1
        DO 230 I=1,M
          AZH=A(J)*ZH(I)
          XN(I)=-(AZH+DTS)*C(J)
 230    CONTINUE
C       ---------------------------------------------------
C       NCDFV RETURNS A VECTOR VCDFN OF TAIL AREAS OF A
C         NORMAL (0,1) CURVE TO THE RIGHT OF THE M VALUES XN
C       ----------------------------------------------------
        CALL NCDFV(M,XN,VCDFN)
C       ------------------------------------
C       COMPUTE PRODUCT INTEGRAND AT EACH
C         OF M QUADRATURE POINTS
C       ------------------------------------ 
        DO 350 I=1,M
          VFMC(I)=VFMC(I)*VCDFN(I)
 350    CONTINUE
 400  CONTINUE
C
C     --------------------------------------
C     ACCUMULATE (PRODUCT INTEGRAND)*WEIGHTS
C     --------------------------------------
 450  DO 500 I=1,M
        F=F+VFMC(I)*WH(I)
 500  CONTINUE     
C     -------------------------------------------------
C     EFFECT INTEGRATION W.R.T. STANDARD NORMAL DENSITY
C     INSTEAD OF W.R.T. WEIGHT FUNCTION EXP(-Z^2)
C     -------------------------------------------------
      GHB1=F/SRPI
C
      RETURN
      END

