[u/mrichter/AliRoot.git] / GEANT321 / ggeom / gvpsqr.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:57  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.31  by  S.Giani
*-- Author :
*
      SUBROUTINE GVPSQR (CBA, SOL, NSOL)
************************************************************************
*                                                                      *
*     SUBROUTINE GVPSQR (CBA,SOL,NSOL)             870924  VP          *
*                                                                      *
*       SOLVE  QUADRATIC  EQUATION                                     *
*                                                                      *
*   ARGUMENTS:                                                         *
*       CBA     Array of coeff's A0 + A1*x + A2*x**2                   *
*       SOL     Solutions                                              *
*       NSOL    Number of solutions :                                  *
*               if zero - SOL(1)= extremum                             *
*               if -ve  - No solution at all                           *
*                                                                      *
************************************************************************
 
      PARAMETER      (ZERO2=1.E-12)
      REAL           CBA(3), SOL(2), SWAP
*-----------------------------------------------------------------------
 
      A = CBA(3)
      B = CBA(2)*.5
      C = CBA(1)
      IF (B.LT.0.)              THEN
        A = -A
        B = -B
        C = -C
      ENDIF
 
      AMX = MAX (ABS(A),ABS(B),ABS(C))
      IF (AMX.LE.0.)            GO TO 100
      A   = A/AMX
      B   = B/AMX
      C   = C/AMX
 
      DIS = B**2 - A*C
      NSOL = 1
      IF (ABS(DIS) .LE. ZERO2)  DIS = 0.
      IF (DIS.LT.0.)            THEN
        NSOL = 0
        DIS  = 0.
      ENDIF
 
      IF (DIS.GT.0.)            DIS = SQRT(DIS)
      BDIS = B + DIS
      IF (ABS(C).GT.1.E+10*BDIS)        GO TO 100
      SOL(1) = 0.
      IF (ABS(BDIS).LE.0.)      GO TO 999
      SOL(1) = (-C/BDIS)
      IF (DIS.LE.0.)            GO TO 999
      IF (BDIS.GE.1.E+10*ABS(A))        GO TO 999
      NSOL   = 2
      SOL(2) = (-BDIS/A)
      IF (SOL(1).GT.SOL(2))     THEN
        SWAP = SOL(1)
        SOL(1) = SOL(2)
        SOL(2) = SWAP
      ENDIF
      GO TO 999
 
*
**      No solutions
  100 NSOL = -1
 
  999 RETURN
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1995/10/24 10:20:57 cernlib
	6	* Geant
	7	*
	8	*
	9	#include "geant321/pilot.h"
	10	*CMZ : 3.21/02 29/03/94 15.41.31 by S.Giani
	11	*-- Author :
	12	*
	13	SUBROUTINE GVPSQR (CBA, SOL, NSOL)
	14	************************************************************************
	15	* *
	16	* SUBROUTINE GVPSQR (CBA,SOL,NSOL) 870924 VP *
	17	* *
	18	* SOLVE QUADRATIC EQUATION *
	19	* *
	20	* ARGUMENTS: *
	21	* CBA Array of coeff's A0 + A1x + A2x*2
	22	* SOL Solutions *
	23	* NSOL Number of solutions : *
	24	* if zero - SOL(1)= extremum *
	25	* if -ve - No solution at all *
	26	* *
	27	************************************************************************
	28
	29	PARAMETER (ZERO2=1.E-12)
	30	REAL CBA(3), SOL(2), SWAP
	31	*-----------------------------------------------------------------------
	32
	33	A = CBA(3)
	34	B = CBA(2)*.5
	35	C = CBA(1)
	36	IF (B.LT.0.) THEN
	37	A = -A
	38	B = -B
	39	C = -C
	40	ENDIF
	41
	42	AMX = MAX (ABS(A),ABS(B),ABS(C))
	43	IF (AMX.LE.0.) GO TO 100
	44	A = A/AMX
	45	B = B/AMX
	46	C = C/AMX
	47
	48	DIS = B*2 - AC
	49	NSOL = 1
	50	IF (ABS(DIS) .LE. ZERO2) DIS = 0.
	51	IF (DIS.LT.0.) THEN
	52	NSOL = 0
	53	DIS = 0.
	54	ENDIF
	55
	56	IF (DIS.GT.0.) DIS = SQRT(DIS)
	57	BDIS = B + DIS
	58	IF (ABS(C).GT.1.E+10*BDIS) GO TO 100
	59	SOL(1) = 0.
	60	IF (ABS(BDIS).LE.0.) GO TO 999
	61	SOL(1) = (-C/BDIS)
	62	IF (DIS.LE.0.) GO TO 999
	63	IF (BDIS.GE.1.E+10*ABS(A)) GO TO 999
	64	NSOL = 2
65	SOL(2) = (-BDIS/A)
66	IF (SOL(1).GT.SOL(2)) THEN
67	SWAP = SOL(1)
68	SOL(1) = SOL(2)
69	SOL(2) = SWAP
70	ENDIF
71	GO TO 999
72
73	*
74	** No solutions
75	100 NSOL = -1
76
77	999 RETURN
78	END