*     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 LIKE, TOL
      INTEGER          CWID, DF, FINT, I, IFAIL, J, K, L, LB, MAXIT, N,
     +                 NCOL, NFF, NFV, NRF, NRV, NV, NVPR, RINT, SVID,
     +                 WARNP, 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'
         STOP
      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'
         STOP
      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 = 0
      TOL = 0.0D0
      WARNP = 0
      CALL G02JBF(N,NCOL,LDDAT,DAT,LEVELS,YVID,CWID,NFV,FVID,FINT,NRV,
     +            RVID,NVPR,VPR,RINT,SVID,GAMMA,NFF,NRF,DF,LIKE,LB,B,SE,
     +            MAXIT,TOL,WARNP,IFAIL)

*     Output results
      IF (WARNP.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  = ', LIKE
      WRITE (NOUT,*) 'DF          = ', DF
      STOP

99999 FORMAT (A,2F10.4)
99998 FORMAT (A,I4,A,2F10.4)
99997 FORMAT (3(A,I4),2F10.4)
99996 FORMAT (I4,F10.4)
99995 FORMAT (2(A,I4),2F10.4)
99994 FORMAT (A,F10.4)
      END