cubeequation.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\cubeequation.f
00002 !
00064                      SUBROUTINE CUBEEQUATION
00065 !                    ***********************
00066 !
00067      & (ACOF, BCOF, CCOF, DCOF, REALS, X)
00068 !
00069 !***********************************************************************
00070 ! TELEMAC2D   V6P2                                   21/08/2010
00071 !***********************************************************************
00072 !
00073 !
00074 !
00075 !
00076 !
00077 !
00078 !
00079 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00080 !| ACOF           |-->| CONSTANT FOR X**3
00081 !| BCOF           |-->| CONSTANT FOR X**2
00082 !| CCOF           |-->| CONSTANT FOR X
00083 !| DCOF           |-->| CONSTANT OF THE EQUATION
00084 !| REALS          |<--| NUMBER OF REAL SOLUTIONS
00085 !| X              |<--| THE SOLUTIONS (1 OR 3)
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !
00088       IMPLICIT NONE
00089 !
00090 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00091 !
00092       DOUBLE PRECISION, INTENT(IN)  :: ACOF, BCOF, CCOF, DCOF
00093       INTEGER,          INTENT(OUT) :: REALS
00094       DOUBLE PRECISION, INTENT(OUT) :: X(3)
00095 !
00096 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00097 !
00098       DOUBLE PRECISION, PARAMETER :: PI = 3.14159265358979323846D0
00099       DOUBLE PRECISION            :: BA, CA, P, Q, Q2P3, U, V
00100       DOUBLE PRECISION            :: EXPO, SIGNUM, TMP, PHI
00101 !
00102 !=======================================================================
00103 !=======================================================================
00104 !
00105       BA = BCOF / ACOF / 3.D0
00106       CA = CCOF / ACOF
00107 !
00108       P  = CA/3.D0 - BA**2
00109       Q  = BA**3 - BA*CA/2.D0 + DCOF/ACOF/2.D0
00110 !
00111       Q2P3 = Q**2 + P**3
00112 !
00113       IF (Q2P3 > 0.D0) THEN
00114 !
00115         REALS = 1
00116         EXPO  = 1.D0/3.D0
00117         TMP   = -Q + SQRT(Q2P3)
00118         SIGNUM  = TMP / ABS(TMP)
00119         U     = SIGNUM * ABS(TMP)**(EXPO)
00120         TMP   = -Q - SQRT(Q2P3)
00121         SIGNUM  = TMP / ABS(TMP)
00122         V     = SIGNUM * ABS(TMP)**EXPO
00123         X(1)  = (U + V) - BA
00124 !
00125       ELSE
00126 !
00127         REALS = 3
00128         TMP = -Q / (-P)**(1.5D0)
00129 !
00130         IF (TMP >= 1.D0) THEN
00131           PHI = 0.D0
00132         ELSE IF (TMP <= -1.D0) THEN
00133           PHI = PI
00134         ELSE
00135           PHI = ACOS (TMP)
00136         ENDIF
00137 !
00138         X(1) = 2.D0* SQRT(-P)* COS(PHI/3.D0)           -  BA
00139         X(2) = 2.D0* SQRT(-P)* COS((PHI+2.D0*PI)/3.D0) -  BA
00140         X(3) = 2.D0* SQRT(-P)* COS((PHI+4.D0*PI)/3.D0) -  BA
00141 !
00142       ENDIF
00143 !
00144 !=======================================================================
00145 !=======================================================================
00146 !
00147       RETURN
00148       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0