MINICERN/mathlib/gen/divon/delbnd.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 DELBND (N,NACTV,IACTV,NFREE,IFREE,IBDEL,IBTRUE,GACTV,NA
  11      1DIM,AHESS,GFREE,GNORM)
  12       INTEGER N, NACTV, NFREE, IBDEL, IBTRUE, NADIM
  13       INTEGER IACTV(N), IFREE(N)
  14       DOUBLE PRECISION GNORM
  15       DOUBLE PRECISION AHESS(NADIM, N), GFREE(N), GACTV(N)
  16       INTEGER IPOS, J
  17       DOUBLE PRECISION RVAL
  18       CALL DELETE(NACTV,IACTV,IBTRUE,IPOS)
  19       NACTV=NACTV-1
  20       IBTRUE=ABS(IBTRUE)
  21       IFREE(NFREE+1)=IBTRUE
  22       IF(NFREE.EQ.0) GOTO 20
  23       DO 10 J=1,NFREE
  24       AHESS(NFREE+1,J)=0.0D+0
  25  10   CONTINUE
  26  20   NFREE=NFREE+1
  27       AHESS(NFREE,NFREE)=1.0D+0
  28       GFREE(NFREE)=GACTV(IBDEL)
  29       RVAL=GNORM*GNORM+GFREE(NFREE)**2
  30       GNORM=SQRT(RVAL)
  31       RETURN
  32       END