使用 Fortran 95 上的函数编程二次方程
我正在尝试创建一个使用二次公式的程序。但是,我想完全使用 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 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(1)
在主程序中,您引用函数
FindUniqueSolution、FindRealSolution1 和FindRealSolution2
。您将a、b、c 和disc
作为参数传递。它们被声明为整数,但在这些函数内部,相应的虚拟参数被声明为实数。所以,你的类型不匹配。In your main program you reference the functions
FindUniqueSolution, FindRealSolution1, and FindRealSolution2
. You passa,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.