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

发布于 2024-10-27 23:55:51 字数 4207 浏览 0 评论 0原文

我正在尝试创建一个使用二次公式的程序。但是,我想完全使用 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

I am trying to create a program that uses the quadratic formula. However, I want to do it entirely with external functions on fortran 95. My program keeps giving me weird errors regarding "inconsistent types" and etc.

This is what I have so far. If anyone has suggestions on where I could be wrong, I would greatly appreciate it.

Thanks a lot!

   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

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

静谧 2024-11-03 23:55:51

在主程序中,您引用函数FindUniqueSolution、FindRealSolution1 和FindRealSolution2。您将a、b、c 和disc 作为参数传递。它们被声明为整数,但在这些函数内部,相应的虚拟参数被声明为实数。所以,你的类型不匹配。

In your main program you reference the functions FindUniqueSolution, FindRealSolution1, and FindRealSolution2. You pass a,b,c, and disc as arguments. These are declared as integers, but inside those functions the corresponding dummy arguments are declared as reals. So, there's your type mismatch.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文