Question

我正在尝试创建一个使用二次公式的程序。但是，我想完全使用fortran 95上的外部函数。我的程序不断给出关于“不一致类型”等的奇怪错误。

这是我到目前为止所拥有的。如果有人对我可能出错的地方有任何建议，我将不胜感激。

非常感谢！

   PROGRAM Quad
IMPLICIT NONE

    !Function & variable Declaration
    CHARACTER(1):: response='X'
    INTEGER:: a=0, b=0, c=0, iost=0, disc=0
    INTEGER:: EnterA, EnterB, EnterC, FindDiscriminate
    REAL:: FindUniqueSolution, FindRealSolution1, FindRealSolution2
    REAL:: x=0, x1=0, x2=0

    !Open statement
    OPEN(UNIT=23,FILE = "solutions.txt", ACTION = "WRITE", STATUS="NEW",IOSTAT=iost)
    IF (iost>0) STOP "Problem opening the file!"


    a=EnterA ()
    b=EnterB ()
    c=EnterC ()
    disc=FindDiscriminate (a,b,c)




DO
    PRINT*, "Find the solution(s) for equation of type: Ax^2 + Bx + C = 0"
    PRINT*, "A, B, and C should each be integers in the range -999 to 999!"

    PRINT*, "YOUR EQUATION: ",a,"x^2 +",b,"x +",c,"=0"
    PRINT*, "DISCRIMINATE: ",disc
    WRITE(23,'(1X,A,I3,A,I3,A,I3,A)',IOSTAT=iost),"YOUR EQUATION: ",a,"x^2 +",b,"x +",c,"=0"
    IF (iost>0) STOP "Problem opening the file!"

    IF (disc==0) THEN
        x=FindUniqueSolution (a,b,c,disc)
        PRINT*, "ONE REAL SOLUTION: ",x
        WRITE(23,'(1X,A,T35,F4.1)',IOSTAT=iost),"ONE REAL SOLUTION: ",x
        IF (iost>0) STOP "Problem writing to the file!"
    ELSE IF(disc>0) THEN
        PRINT*, "TWO REAL SOLUTIONS: "
        x1=FindRealSolution1 (a,b,c,disc)
        PRINT*, "REAL SOLUTION 1: ",x1
        x2=FindRealSolution2 (a,b,c,disc)
        PRINT*, "REAL SOLUTION 2: ",x2
        WRITE(23,'(1X,A)',IOSTAT=iost),"TWO REAL SOLUTIONS"
        WRITE(23,'(1X,A,T35,F4.1)',IOSTAT=iost),"REAL SOLUTION 1: ",x1
        WRITE(23,'(1X,A,T35,F4.1)',IOSTAT=iost),"REAL SOLUTION 2: ",x2
        IF (iost>0) STOP "Problem writing to the file!"
    ELSE
        PRINT*, "Your equation is unsolvable (the discriminant is less than 0)."
    END IF

    WRITE (*,'(1X,A)',ADVANCE="NO"),"Do another(y/n)?"
    READ*, response
    IF (response /= "y") EXIT

END DO

    CLOSE(23)



END PROGRAM

!Begin External Functions ----------------------------------------------------------

INTEGER FUNCTION EnterA ()
IMPLICIT NONE
INTEGER:: a=0

DO
    WRITE (*,'(1X,A)',ADVANCE="NO"),"Enter A: "
    READ*, a
    IF (a <= -999 .AND. a >= 999) EXIT
    PRINT*, "Must be an integer between -999 and 999. TRY AGAIN!"
END DO

EnterA=a

END FUNCTION EnterA

! New External Function ------------------------------------------------------------------------------

INTEGER FUNCTION EnterB ()
IMPLICIT NONE
INTEGER:: b=0

DO
    WRITE (*,'(1X,A)',ADVANCE="NO"),"Enter B: "
    READ*, b
    IF (b <= -999 .AND. b >= 999) EXIT
    PRINT*, "Must be an integer between -999 and 999. TRY AGAIN!"
END DO

EnterB=b

END FUNCTION EnterB
!-----------------------------------------------------------------------------------
INTEGER FUNCTION EnterC ()
IMPLICIT NONE
INTEGER:: c=0

DO
    WRITE (*,'(1X,A)',ADVANCE="NO"),"Enter C: "
    READ*, c
    IF (c <= -999 .AND. c >= 999) EXIT
    PRINT*, "Must be an integer between -999 and 999. TRY AGAIN!"
END DO

EnterC=c

END FUNCTION EnterC
!---------------------------------------------------------------------------------

INTEGER FUNCTION FindDiscriminate(a,b,c)
IMPLICIT NONE
INTEGER:: disc=0

INTEGER, INTENT(IN):: a,b,c

disc=INT(b**2)-(4*a*c)

FindDiscriminate=disc
END FUNCTION FindDiscriminate
!----------------------------------------------------------------------------------

REAL FUNCTION FindUniqueSolution (a,b,c,disc)
IMPLICIT NONE
REAL:: x

REAL, INTENT(IN):: a,b,c,disc

x=REAL(-b)/(2.0*a)

FindUniqueSolution=x
END FUNCTION FindUniqueSolution
!---------------------------------------------------------------------------------

REAL FUNCTION FindRealSolution1 (a,b,c,disc)
IMPLICIT NONE
REAL:: x1

REAL, INTENT (IN):: a,b,c,disc

x1=REAL(-b+disc)/(2.0*a)

FindRealSolution1=x1
END FUNCTION FindRealSolution1
!---------------------------------------------------------------------------------

REAL FUNCTION FindRealSolution2 (a,b,c,disc)
IMPLICIT NONE
REAL:: x2

REAL, INTENT (IN):: a,b,c,disc

x2=REAL(-b-disc)/(2.0*a)

FindRealSolution2=x2
END FUNCTION FindRealSolution2

Answer 1

在主程序中，您可以参考函数FindUniqueSolution, FindRealSolution1, and FindRealSolution2。您传递a,b,c, and disc作为参数。这些被声明为整数，但在这些函数中，相应的伪参数被声明为实数。所以，你的类型不匹配。

使用fortran 95上的函数编程二次方程

1 个答案: