*     G02JBF Example Program Text
*     Mark 21 Release. NAG Copyright 2004.
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          LDDAT, VMAX, FMAX, RMAX, LMAX, SMAX, TEMAX
      PARAMETER        (LDDAT=24,VMAX=5,FMAX=3,RMAX=1,LMAX=3,SMAX=4,
     +                 TEMAX=2)
      INTEGER          NZZ
      PARAMETER        (NZZ=RMAX*LMAX*SMAX+SMAX)
      INTEGER          MLB
      PARAMETER        (MLB=FMAX*LMAX+NZZ)
*     .. Local Scalars ..
      DOUBLE PRECISION ML, TOL
      INTEGER          CWID, DF, FINT, I, IFAIL, J, K, L, LB, MAXIT, N,
     +                 NCOL, NFF, NFV, NRF, NRV, NV, NVPR, RINT, SVID,
     +                 WARN, YVID
*     .. Local Arrays ..
      DOUBLE PRECISION B(MLB), DAT(LDDAT,VMAX), GAMMA(TEMAX+2), SE(MLB)
      INTEGER          FVID(FMAX), LEVELS(VMAX), RVID(RMAX), VPR(RMAX)
*     .. External Subroutines ..
      EXTERNAL         G02JBF
*     .. Executable Statements ..
      CONTINUE
*
      WRITE (NOUT,*) 'G02JBF Example Program Results'
*
      LB = MLB
*
*     Skip heading in data file
      READ (NIN,*)
*
*     Read in the problem size information
      READ (NIN,*) N, NCOL, NFV, NRV, NVPR
      NV = NFV + NRV
*
*     Check array sizes
      IF (NCOL.GT.VMAX .OR. NV.GT.(FMAX+RMAX)) THEN
         WRITE (NOUT,*) 'Problem too large, increase size of arrays'
         GO TO 200
      END IF
*
*     Read in number of levels for each variable
      READ (NIN,*) (LEVELS(I),I=1,NCOL)
*
*     Read in model information
      READ (NIN,*) YVID, (FVID(I),I=1,NFV), (RVID(I),I=1,NRV), SVID,
     +  CWID, FINT, RINT
*
*     If no subject specified, then ignore RINT
      IF (SVID.EQ.0) RINT = 0
*
*     Check remaining array sizes
      IF (N.GT.LDDAT .OR. (NVPR+RINT).GT.TEMAX) THEN
         WRITE (NOUT,*) 'Problem too large, increase size of arrays'
         GO TO 200
      END IF
*
*     Read in the variance component flag
      READ (NIN,*) (VPR(I),I=1,NRV)
*
*     Read in the Data matrix
      DO 20 I = 1, N
         READ (NIN,*) (DAT(I,J),J=1,NCOL)
   20 CONTINUE
*
*     Read in the initial values for GAMMA
      READ (NIN,*) (GAMMA(I),I=1,NVPR+RINT)
*
*     Read in the maximum number of iterations
      READ (NIN,*) MAXIT
*
*     Run the analysis
      IFAIL = 1
      TOL = 0.0D0
      WARN = 0
      CALL G02JBF(N,NCOL,LDDAT,DAT,LEVELS,YVID,CWID,NFV,FVID,FINT,NRV,
     +            RVID,NVPR,VPR,RINT,SVID,GAMMA,NFF,NRF,DF,ML,LB,B,SE,
     +            MAXIT,TOL,WARN,IFAIL)
*
      IF (IFAIL.EQ.0) THEN
*        Output results
         IF (WARN.NE.0) THEN
            WRITE (NOUT,*)
     +        'Warning: At least one variance component was ',
     +        'estimated to be negative and then reset to zero'
         END IF
         WRITE (NOUT,*)
     +     'Fixed effects (Estimate and Standard Deviation)'
         WRITE (NOUT,*)
         K = 1
         IF (FINT.EQ.1) THEN
            WRITE (NOUT,99999) 'Intercept             ', B(K), SE(K)
            K = K + 1
         END IF
         DO 60 I = 1, NFV
            DO 40 J = 1, LEVELS(FVID(I))
               IF (LEVELS(FVID(I)).NE.1 .AND. J.EQ.1) GO TO 40
               WRITE (NOUT,99995) 'Variable', I, ' Level', J, B(K),
     +           SE(K)
               K = K + 1
   40       CONTINUE
   60    CONTINUE
*
         WRITE (NOUT,*)
         WRITE (NOUT,*) 'Random Effects (Estimate and Standard',
     +     ' Deviation)'
         IF (SVID.EQ.0) THEN
            DO 100 I = 1, NRV
               DO 80 J = 1, LEVELS(RVID(I))
                  WRITE (NOUT,99995) 'Variable', I, ' Level', J, B(K),
     +              SE(K)
                  K = K + 1
   80          CONTINUE
  100       CONTINUE
         ELSE
            DO 160 L = 1, LEVELS(SVID)
               IF (RINT.EQ.1) THEN
                  WRITE (NOUT,99998) 'Intercept for Subject Level', L,
     +              '         ', B(K), SE(K)
                  K = K + 1
               END IF
               DO 140 I = 1, NRV
                  DO 120 J = 1, LEVELS(RVID(I))
                     WRITE (NOUT,99997) 'Subject Level', L, ' Variable',
     +                 I, ' Level', J, B(K), SE(K)
                     K = K + 1
  120             CONTINUE
  140          CONTINUE
  160       CONTINUE
         END IF
*
         WRITE (NOUT,*)
         WRITE (NOUT,*) ' Variance Components'
         DO 180 I = 1, (NVPR+RINT)
            WRITE (NOUT,99996) I, GAMMA(I)
  180    CONTINUE
*
         WRITE (NOUT,99994) 'SIGMA^2     = ', GAMMA(NVPR+RINT+1)
         WRITE (NOUT,99994) '-2LOG LIKE  = ', ML
         WRITE (NOUT,*) 'DF          = ', DF
      ELSE
         WRITE (NOUT,*)
         WRITE (NOUT,99993) ' ** G02JBF returned with IFAIL = ', IFAIL
      END IF
  200 CONTINUE
*
99999 FORMAT (1X,A,2F10.4)
99998 FORMAT (1X,A,I4,A,2F10.4)
99997 FORMAT (1X,3(A,I4),2F10.4)
99996 FORMAT (1X,I4,F10.4)
99995 FORMAT (1X,2(A,I4),2F10.4)
99994 FORMAT (1X,A,F10.4)
99993 FORMAT (1X,A,I5)
      END