SUBROUTINE FKCVPT
*-- Author : S.Burke / J.V. Morris
      SUBROUTINE FKCVPT(LUN,S,C,IERR)
**********************************************************************                                        
*                                                                    *                                        
* Print out a state vector and covariance matrix; off-diagonal       *                                        
* elements printed as correlations                                   *                                        
*                                                                    *                                        
* IERR = 1 if the matrix is not positive definite, and a message     *                                        
* is also printed, but this is NOT a full test for positive          *                                        
* definiteness.                                                      *                                        
*                                                                    *                                        
**********************************************************************                                        
                                                                        
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)                               
                                                                        
      DIMENSION S(5),C(5,5),CTEMP(5,5)                                  
                                                                        
**********************************************************************                                        
                                                                        
      IERR = 0                                                          
                                                                        
      CALL FKCOPY(C,CTEMP)
                                                                        
      DO 200 I=1,4                                                      
         DO 100 J=I+1,5                                                 
            VARIJ = CTEMP(I,I)*CTEMP(J,J)                               
            IF (VARIJ.LE.0) THEN                                        
               IERR = 1                                                 
               CTEMP(J,I) = 0.D0                                        
            ELSE                                                        
               CTEMP(J,I) = CTEMP(J,I)/DSQRT(VARIJ)                     
               IF (DABS(CTEMP(J,I)).GT.1.D0) IERR = 1                   
            ENDIF                                                       
 100     CONTINUE                                                       
 200  CONTINUE                                                          
                                                                        
      CALL FKFILL(CTEMP)
                                                                        
      WRITE(LUN,1000) S                                                 
 1000 FORMAT(/' ',5(D10.3,4X))                                          
                                                                        
      WRITE(LUN,2000) CTEMP                                             
 2000 FORMAT(/5(' ',5(D10.3,4X)/)/)                                     
                                                                        
      IF (IERR.EQ.1) THEN                                               
         WRITE(LUN,*)                                                   
         WRITE(LUN,*) '*** This matrix is not positive definite ***'    
         WRITE(LUN,*)                                                   
      ENDIF                                                             
                                                                        
      RETURN                                                            
      END                                                               
*