*-- Author : S.Burke / J.V. Morris SUBROUTINE FKLWM(IFL,S1,C1,S2,C2,S3,C3,IERR) ********************************************************************** * * * Take the weighted mean of two state vectors * * * * ERROR CONDITIONS; * * IERR = 0 ; normal termination * * -> IERR = 111 ; failure to invert output covariance * * IERR = 16 ; output theta > pi/2 (reset to pi/4) * * IERR = 17 ; output theta > 1 (warning) * * * * -> Fatal error * * * ********************************************************************** IMPLICIT DOUBLE PRECISION (A-H,O-Z) PARAMETER (IUTIL=0,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 S1(5),C1(5,5),S2(5),C2(5,5),W(5,5),S3(5),C3(5,5),S4(5) ********************************************************************** IERR = 0 * * compute the inverse of the weighted average covariance ... * IF (IFL.GE.0) THEN CALL FKADD(C1,C2,C3) CALL FKDIFF(S2,S1,S4) ELSE CALL FKSUB(C2,C1,C3) CALL FKDIFF(S1,S2,S4) ENDIF CALL DSINV(5,C3,5,IFAIL) IF (IFAIL.NE.0) THEN CALL FKERR(IUTIL,IROUT,IFATAL,IOCV,IERR) RETURN ENDIF CALL FKMLT(C1,C3,W) CALL FKMLT2(W,C2,C3) * * compute the weighted average state vector ... * DO 400 J1=1,5 S3(J1) = S1(J1) DO 300 J2=1,5 S3(J1) = S3(J1) + W(J1,J2)*S4(J2) 300 CONTINUE 400 CONTINUE CALL FKNORM(S3,IFAIL) IF (IFAIL.NE.0) CALL FKERR(IUTIL,IROUT,IWARN,IFAIL,IERR) RETURN END *