*-- Author : S.Burke / J.V. Morris
      SUBROUTINE FKQG(CPRO,Q,QGAIN,IERR)
**********************************************************************                                        
*                                                                    *                                        
* Calculate QGAIN for smoother                                       *                                        
*                                                                    *                                        
* ERROR CONDITIONS;                                                  *                                        
*       IERR =   0 ; normal termination                              *                                        
*   ->  IERR = 111 ; failure to invert projected covariance          *                                        
*                                                                    *                                        
*   ->  Fatal error                                                  *                                        
*                                                                    *                                        
**********************************************************************                                        
                                                                        
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)                               
                                                                        
      PARAMETER (IUTIL=1,IROUT=6)                                       
*KEEP,FKECODE.                                                                                                
      PARAMETER (IWARN=0,IFATAL=1,IFPRO=2,IFFLT=3,IFSMO=4,IFPRS=5,      
     &           IFPAS=6,IFPAF=7)                                       
      PARAMETER (IINF1=1,IINF2=2,IINF3=3,IINV=4,IDONE=5)                
      PARAMETER (IICV=6,IMCV=7,IOCV=11,IRCV=12,IOVCV=13,                
     &           ITHGP2=16,ITHG1=17)                                    
      PARAMETER (IFREE=20,IFREE1=30,IFREE2=40,IFREE3=50)                
*KEND.                                                                                                        
                                                                        
      DIMENSION CPRO(5,5),Q(5,5),QGAIN(5,5),CINV(5,5)                   
                                                                        
**********************************************************************                                        
                                                                        
      IERR = 0                                                          
                                                                        
      CALL FKCOPY(CPRO,CINV)
      CALL DSINV(5,CINV,5,IFAIL)                                                                       
      IF (IFAIL.NE.0) THEN                                              
         CALL FKERR(IUTIL,IROUT,IFATAL,IOCV,IERR)
         RETURN                                                         
      ENDIF                                                             
                                                                        
      DO 100 J=1,5                                                      
         QGAIN(1,J) = Q(1,1)*CINV(1,J) + Q(2,1)*CINV(2,J)               
     &              + Q(4,1)*CINV(4,J) + Q(5,1)*CINV(5,J)               
         QGAIN(2,J) = Q(2,1)*CINV(1,J) + Q(2,2)*CINV(2,J)               
     &              + Q(4,2)*CINV(4,J) + Q(5,2)*CINV(5,J)               
         QGAIN(4,J) = Q(4,1)*CINV(1,J) + Q(4,2)*CINV(2,J)               
     &              + Q(4,4)*CINV(4,J) + Q(5,4)*CINV(5,J)               
         QGAIN(5,J) = Q(5,1)*CINV(1,J) + Q(5,2)*CINV(2,J)               
     &              + Q(5,4)*CINV(4,J) + Q(5,5)*CINV(5,J)               
 100  CONTINUE                                                          
                                                                        
      RETURN                                                            
      END                                                               
*