MINICERN/mathlib/gen/d/sgz.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:22  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE SGZ (M,S)
  11 C-----SUBROUTINE SGZ SETS UP S(OBJECTIVE FUNCTION),G(GRADIENT OF S) AND
  12 C-----Z(APPROXIMATE COVARIANCE MATRIX)
  13 #include "d510si.inc"
  14 #include "d510ui.inc"
  15       K=NED(1)
  16       K2=1
  17       DO 12 L1=1,K
  18       K1=K2
  19       NX=NED(2)-2
  20       IF (INDFLG(3)) 1,2,1
  21  1    NX=NED(2)
  22       K1=K1-2
  23  2    CONTINUE
  24       DO 3 I=1,NX
  25       KI=K1+1+I
  26       X(I)=EXDA(KI)
  27  3    CONTINUE
  28       CALL ARITHM (Y)
  29       IF (INDFLG(3)) 4,6,4
  30  4    IF (Y) 13,13,5
  31 C-----MAXIMUM LIKLEHOOD
  32  5    S=S-LOG(Y)
  33       Y=-Y
  34       SIG=Y
  35       GO TO 7
  36 C-----CHI SQUARED
  37  6    SIG=EXDA(K2+1)
  38       Y=Y-EXDA(K1)
  39       S=S+((Y/SIG)**2)/2.
  40  7    CONTINUE
  41       N=0
  42       DO 9 J=1,M
  43       IF (PL0(J)) 9,9,8
  44  8    N=N+1
  45       DF(N)=DF(J)/SIG
  46       G(J)=G(J)+DF(N)*(Y/SIG)
  47  9    CONTINUE
  48       L=1
  49       IF (N.LT.1) GO TO 11
  50       DO 10 I=1,N
  51       DO 10 J=1,I
  52       Z(L)=Z(L)+DF(I)*DF(J)
  53       L=L+1
  54  10   CONTINUE
  55  11   K2=K2+NED(2)
  56  12   CONTINUE
  57       RETURN
  58 C-----  -VE OR ZERO Y IN MAXIMUM LIKLEHOOD
  59  13   INDFLG(1)=1
  60       S=1.E10
  61       RETURN
  62       END