PROGRAM g02ldfe

!      G02LDF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : g02ldf, nag_wp, x04caf
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: nin = 5, nout = 6
!      .. Local Scalars ..
       INTEGER                         :: i, ifail, ip, iscale, ldb, ldyhat,   &
                                          ldz, my, mz, n, orig
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: b(:,:), xbar(:), xstd(:), ybar(:),   &
                                          yhat(:,:), ystd(:), z(:,:)
       INTEGER, ALLOCATABLE            :: isz(:)
!      .. Intrinsic Functions ..
       INTRINSIC                          sum
!      .. Executable Statements ..
       WRITE (nout,*) 'G02LDF Example Program Results'
       WRITE (nout,*)
       FLUSH (nout)

!      Skip heading in data file
       READ (nin,*)

!      Read in problem size
       READ (nin,*) my, orig, iscale, n, mz

       ldyhat = n
       ldz = n
       ALLOCATE (ybar(my),ystd(my),isz(mz),z(ldz,mz),yhat(ldyhat,my))

!      Read prediction x-data
       READ (nin,*) (z(i,1:mz),i=1,n)

!      Read in elements of ISZ
       READ (nin,*) isz(1:mz)

!      Calculate IP
       ip = sum(isz(1:mz))

       ldb = ip
       IF (orig==1) THEN
          ldb = ldb + 1
       END IF
       ALLOCATE (xbar(ip),xstd(ip),b(ldb,my))

!      Read parameter estimates
       READ (nin,*) (b(i,1:my),i=1,ldb)

!      Read means
       IF (orig==-1) THEN
          READ (nin,*) xbar(1:ip)
          READ (nin,*) ybar(1:my)

          IF (iscale/=-1) THEN
!            Read scalings
             READ (nin,*) xstd(1:ip)
             READ (nin,*) ystd(1:my)
          END IF
       END IF

!      Calculate predictions
       ifail = 0
       CALL g02ldf(ip,my,orig,xbar,ybar,iscale,xstd,ystd,b,ldb,n,mz,isz,z,ldz, &
          yhat,ldyhat,ifail)

!      Display results
       ifail = 0
       CALL x04caf('General',' ',n,my,yhat,ldyhat,'YHAT',ifail)

    END PROGRAM g02ldfe