1 : C RSEQ3D SOURCE CHAT 05/01/13 03:07:21 5004 2 : SUBROUTINE RSEQ3D (AAA,BBB,CCC,DDD,YUNG,X1,X2,X3,KERRE) 3 : C 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : -INC CCOPTIO 7 : C 8 : C*********************************************************************** 9 : C************** RESOLUTION D UNE EQUATION DE 3EME DEGRE *************** 10 : C**************** AAA X**3 + BBB X**2 + CCC X + DDD =0 ***************** 11 : C********************* RACINES REELLES UNIQUEMENT ********************** 12 : C*********************************************************************** 13 : C 14 : RF=YUNG*YUNG*1.D-16 15 : C 16 : IF(IIMPI.EQ.9) THEN 17 : WRITE(6,*) 'AAA',AAA 18 : WRITE(6,*) 'BBB',BBB 19 : WRITE(6,*) 'CCC',CCC 20 : WRITE(6,*) 'DDD',DDD 21 : ENDIF 22 : C 23 : IF(AAA.EQ.0.D0) GO TO 100 24 : A1=BBB/AAA 25 : A2=CCC/AAA 26 : A3=DDD/AAA 26 : CALL DEGRE3(A3,A2,A1,X1,XI1,X2,XI2,X3,XI3) 27 : RETURN 28 : C 29 : 100 IF(BBB.EQ.0.D0) GO TO 200 30 : DELT=CCC*CCC-4.D0*BBB*DDD 31 : IF(IIMPI.EQ.9) WRITE(6,*) 'CAS D UNE EQ DU 2EME DEGRE' 32 : IF(IIMPI.EQ.9) WRITE(6,*) 'DELT',DELT 33 : IF(ABS(DELT).LT.RF.AND.DELT.LT.0.D0) DELT=0.D0 34 : IF(DELT.LT.0.D0) GO TO 500 35 : RADE=SQRT(DELT) 36 : X1=0.5D0*(-CCC+RADE)/BBB 37 : X2=0.5D0*(-CCC+RADE)/BBB 38 : X3=X1 39 : RETURN 40 : C 41 : 200 IF(CCC.EQ.0.D0) GO TO 300 42 : X1=-DDD/CCC 43 : X2=X1 44 : X3=X1 45 : RETURN 46 : C 47 : 300 IF(DDD.EQ.0.D0) GO TO 400 48 : X1=1.D0 49 : X2=X1 50 : X3=X1 51 : RETURN 52 : C 53 : 400 X1=0.D0 54 : X2=X1 55 : X3=X1 56 : RETURN 57 : C 58 : 500 KERRE=470 59 : REAERR(1)=AAA 60 : REAERR(2)=BBB 61 : REAERR(3)=CCC 62 : REAERR(4)=DDD 63 : REAERR(5)=DELT 64 : RETURN 65 : C 66 : END 67 :
© Cast3M 2003 - All rights reserved.
Disclaimer