[Fortran] 纯文本查看 复制代码
!主程序:
PROGRAM MAIN
REAL IX(4)
REAL X(3)
DATA IX /1,-6,11,-6/
CALL CUBIC_ROOTS(IX)
END
!子程序:
SUBROUTINE CUBIC_ROOTS(IX,X)
INTEGER,PARAMETER :: N=4
REAL,INTENT(IN) :: IX(N)
REAL,INTENT(OUT) :: X(N-1)
REAL,PARAMETER :: PI=3.1415926
INTEGER I
REAL IXX(N-1)
REAL Q,R,M,S,T
REAL THETA
!C BEGIN HERE
DO I=1,N-1,1
IXX(I) = IX(I+1)/IX(1)
END DO
Q=(IXX(1)**2-3*IXX(2))/9
R=(2*IXX(1)**3-9*IXX(1)*IXX(2)+27*IXX(3))/54
M=R**2-Q**3
IF(M<0.0) THEN
THETA=ACOS(R/Q**(1/3))
X(1)=-2*SQRT(Q)*COS(THETA/3)-IXX(1)/3
X(2)=-2*SQRT(Q)*COS((THETA+2*PI)/3)-IXX(1)/3
X(3)=-2*SQRT(Q)*COS((THETA-2*PI)/3)-IXX(1)/3
WRITE(*,*) X
ELSE
S=(SQRT(Q)-R)**(1/3)
T=(-SQRT(Q)-R)**(1/3)
X(1)=S+T-IXX(1)/3
X(2)=X(1)
X(3)=X(1)
WRITE(*,*) X
END IF
END