Numérotation des lignes :

C QUARTI    SOURCE    CHAT      05/01/13    02:41:18     5004      SUBROUTINE QUARTI (CA4, CA3, CA2, CA1, CA0, Q1, Q2, Q3,Q4,NRoot)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8(A-H,O-Z)      DIMENSION QQ(4)      D1 = CA3 / CA4      D2 = CA2 / CA4      D3 = CA1 / CA4      D4 = CA0 / CA4      D5 = -.25d0* D1      A = D5 * D5      B = A * D5      C = B * D5      P = 6.d0 * A + 3.d0 * D1 * D5 + D2      Q = 4.d0 * B + 3.d0 * D1 * A + 2.d0 * D2 * D5 + D3      R = C + D1 * B + D2 * A + D3 * D5 + D4      IF( ABS(Q) . LE. 1.e-40) THEN          NROOT=0          A =  P * P - 4.d0 * R          IF( A . GE . 0.D0) THEN             Y1= (-P + SQRT( A))/2.d0             Y2= (-P - SQRT( A))/2.D0             IF( Y1. GE. 0.D0) THEN                 NROOT = 2                 QQ(1)= SQRT(Y1)                 QQ(2) = -QQ(1)             ENDIF             IF( Y2.GE.0.D0) THEN                 QQ(NROOT+1)= SQRT(Y2)                 QQ(NROOT+2)=-QQ(NROOT+1)                 NROOT=NROOT+2             ENDIF          ENDIF      ELSEIF( ABS( R) . LE. 1.e-40) THEN            CALL CUBIC( 1.d0,0.d0, P,Q,QQ(1),QQ(2),QQ(3),NROOT)            NROOT=NROOT+1            QQ(NROOT) = 0.D0      ELSE            GO TO 12      ENDIF      Q1 = QQ(1) + D5      Q2 = QQ(2) + D5      Q3 = QQ(3) + D5      Q4 = QQ(4) + D5      RETURN**   cas general*  12  CONTINUE      CB3 = 1.d0      CB2 = 2.d0 * P      CB1 = P * P - 4.d0 * R      CB0 = -1.d0 * Q * Q      CALL CUBIC(CB3, CB2, CB1, CB0, X1, X2, X3, NCUBIC)      IF(NCUBIC.EQ.0) THEN        RETURN      ELSEIF(NCUBIC.EQ.1) THEN         X4 = X1      ELSEIF(NCUBIC.EQ.2) THEN         X4 = X1         IF( X2.GT. X4 ) X4 = X2      ELSEIF(NCUBIC.EQ.3) THEN         X4 = X1         IF( X2.GT. X4) X4 = X2         IF( X3.GT. X4)  X4 = X3      ENDIF      X5 = SQRT(ABS(X4))      CC2 = 1.d0      CC1 = X5      IF( X5 . NE . 0.d0) THEN            CC0 = .5d0 * (P + X4 - Q / X5)       ELSE          CC0 = -1.d0       ENDIF      CALL QUADRA(CC2, CC1, CC0, R1, R2, NQUAD1)      CC2 = 1.      CC1 = -X5      IF( X5 . NE . 0.d0) THEN      CC0 = .5d0 * (P + X4 + Q / X5)      ELSE            CC0 = 1.d0      ENDIF      CALL QUADRA(CC2, CC1, CC0, R3, R4, NQUAD2)      IF (NQUAD1 + NQUAD2 .EQ. 0) RETURN      IF (NQUAD1 + NQUAD2.EQ. 4) THEN       Q1 = R1 + D5       Q2 = R2 + D5       Q3 = R3 + D5       Q4 = R4 + D5       NRoot = 4       RETURN      ELSEIF( NQUAD1 .EQ. 0 )THEN       Q1 = R3 + D5       Q2 = R4 + D5       NRoot = 2       RETURN      ELSE       Q1 = R1 + D5       Q2 = R2 + D5       NRoot = 2      ENDIF      RETURN      END

© Cast3M 2003 - Tous droits réservés.
Mentions légales