MINICERN/mathlib/gen/divon/addbnd.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:03:27  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE ADDBND (N,NFREE,IFREE,NACTV,IACTV,INEW,IDNEW,NADIM,AHES
  11      1S,XTEMP,GFREE,GNORM)
  12       INTEGER N, NFREE, NACTV, INEW, IDNEW, NADIM
  13       INTEGER IFREE(N), IACTV(N)
  14       DOUBLE PRECISION GNORM
  15       DOUBLE PRECISION AHESS(NADIM, N), XTEMP(N), GFREE(N)
  16       INTEGER I, INPOS, NFRM1
  17       DOUBLE PRECISION RNEW
  18       CALL DELETE(NFREE,IFREE,INEW,INPOS)
  19       IF(INPOS.EQ.0) RETURN
  20       NACTV=NACTV+1
  21       IACTV(NACTV)=IDNEW*INEW
  22       RNEW=GNORM*GNORM-GFREE(INPOS)**2
  23       IF(RNEW.LT.0.0D+0) RNEW=0.0D+0
  24       GNORM=SQRT(RNEW)
  25       CALL SHRNK(NFREE,NADIM,AHESS,INPOS,XTEMP)
  26       IF(INPOS.EQ.NFREE) GOTO 20
  27       NFRM1=NFREE-1
  28       DO 10 I=INPOS,NFRM1
  29       GFREE(I)=GFREE(I+1)
  30  10   CONTINUE
  31  20   NFREE=NFREE-1
  32       RETURN
  33       END