subroutine aptrich (a, b, c, tol, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTRICH
c
c     call aptrich (a, b, c, tol, nerr)
c
c     Version:  aptrich  Updated    1999 September 13 13:30.
c               aptrich  Originated 1999 September 13 13:30.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  Test to see if a real triangle, with positive area, can be
c               constructed with edge lengths a, b and c.  Each edge length
c               must be greater than emin and less than emax, where
c               emin = tol * (abs (a) + abs (b) + abs (c)), and
c               emax = 0.5 * (a + b + c) * (1.0 - tol).
c               Flag nerr indicates any violation of these conditions.
c
c     Input:    a, b, c, tol.
c
c     Output:   nerr.
c
c     Calls: None 
c
c     Glossary:
c
c     a         Input    The length of edge a of the triangle.
c                          Must not be too short or too long.  See nerr.
c
c     b         Input    The length of edge b of the triangle.
c                          Must not be too short or too long.  See nerr.
c
c     c         Input    The length of edge c of the triangle.
c                          Must not be too short or too long.  See nerr.
c
c     nerr      Output   Indicates an input error, if not 0.
c                          1 if an edge length is not greater than
c                            emin = tol * (abs (a) + abs (b) + abs (c)).
c                            One or more edges are too short, or negative.
c                          2 if an edge length is not less than
c                            emax = 0.5 * (a + b + c) * (1.0 - tol).
c                            One edge is too long.
c
c     tol       Input    Numerical tolerance limit.
c                          On Cray computers, recommend 1.e-5 to 1.e-11.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

      implicit     none

c.... Arguments.

      real         a                  ! Length of edge a of the triangle.
      real         b                  ! Length of edge b of the triangle.
      real         c                  ! Length of edge c of the triangle.
      integer      nerr               ! Error indicator.
      real         tol                ! Numerical tolerence limit.

c.... Local variables.

      real         emax               ! Maximum allowed edge length.
      real         emin               ! Minimum allowed edge length.
      real         per                ! Perimeter of triangle, a + b + c.
      real         pera               ! Perimeter of triangle, |a| + |b| + |c|.

cbugc***DEBUG begins.
cbug 9901 format (/ 'aptrich testing triangle edge lengths.',
cbug     &  '  tol=',1pe22.14 /
cbug     &  ' a ,b ,c =    ',1p3e22.14 )
cbug      write ( 3, 9901) tol, a, b, c
cbugc***DEBUG ends.

c.... Initialize.

      nerr  = 0

c.... Test for input errors.

      pera = abs (a) + abs (b) + abs (c)
      emin = tol * pera

      if (( a .le. emin)  .or.
     &    ( b .le. emin)  .or.
     &    ( c .le. emin)) then
        nerr = 1
        go to 410
      endif

      per  = a + b + c
      emax = 0.5 * per * (1.0 - tol)

      if ((a .ge. emax)  .or.
     &    (b .ge. emax)  .or.
     &    (c .ge. emax)) then
        nerr = 2
        go to 410
      endif

  410 continue
cbugc***DEBUG begins.
cbug 9916 format (/ 'aptrich results. nerr = ',i2)
cbug      write ( 3, 9916) nerr
cbugc***DEBUG ends.

      return

c.... End of subroutine aptrich.      (+1 line.)
      end

UCRL-WEB-209832