Function 在fortran 95上用函数规划二次方程

Function 在fortran 95上用函数规划二次方程,function,fortran,external,formula,quadratic,Function,Fortran,External,Formula,Quadratic,我正在尝试创建一个使用二次公式的程序。但是,我想完全使用fortran 95上的外部函数来实现。我的程序不断给我关于“不一致类型”等奇怪的错误 这就是我目前所拥有的。如果有人对我的错误提出建议,我将不胜感激 非常感谢 PROGRAM Quad IMPLICIT NONE !Function & variable Declaration CHARACTER(1):: response='X' INTEGER:: a=0, b=0, c=0, iost=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
程序四元组
隐式无
!函数和变量声明
字符(1)::response='X'
整数::a=0,b=0,c=0,iost=0,disc=0
整数::EnterA、EnterB、EnterC、FindDiscriminate
REAL::FindUnique解决方案,FindReal解决方案1,FindReal解决方案2
实数::x=0,x1=0,x2=0
!公开声明
打开(UNIT=23,FILE=“solutions.txt”,ACTION=“WRITE”,STATUS=“NEW”,IOSTAT=iost)
如果(iost>0)停止“打开文件时出现问题!”
a=输入()
b=输入b()
c=EnterC()
圆盘=FindDiscriminate(a、b、c)
做
打印*,“查找类型为Ax^2+Bx+C=0的方程的解”
打印*,“A、B和C都应该是-999到999范围内的整数!”
打印*,“你的方程式:”,a,“x^2+”,b,“x+”,c,“=0”
打印*,“辨别:”,光盘
写下(23),(1X,A,I3,A,I3,A),IOSTAT=iost),“你的方程:”,A,“x^2+”,b,“x+”,c,“=0”
如果(iost>0)停止“打开文件时出现问题!”
如果(disc==0),则
x=最终液体溶液(a、b、c、圆盘)
打印*,“一个真正的解决方案:”,x
写下(23),(1X,A,T35,F4.1),IOSTAT=iost),“一个真正的解决方案:”,x
如果(iost>0)停止“写入文件时出现问题!”
否则,如果(光盘>0),则
打印*,“两个实际解决方案:”
x1=最终解决方案1(a、b、c、圆盘)
打印*,“实际解决方案1:”,x1
x2=最终解决方案2(a、b、c、圆盘)
打印*,“实际解决方案2:”,x2
写(23),(1X,A)’,IOSTAT=iost),“两个实际解决方案”
写(23),(1X,A,T35,F4.1),IOSTAT=iost),“实际解决方案1:”,x1
写(23),(1X,A,T35,F4.1),IOSTAT=iost),“实际解决方案2:”,x2
如果(iost>0)停止“写入文件时出现问题!”
其他的
PRINT*,“您的方程无法求解(判别式小于0)。”
如果结束
写(*,”(1X,A)”,ADVANCE=“否”),“是否再做一次?”
读取*,响应
如果(响应/=“y”)退出
结束
结束(23)
结束程序
!开始外部功能----------------------------------------------------------
整数函数EnterA()
隐式无
整数::a=0
做
写入(*,”(1X,A)”,ADVANCE=“NO”),“输入A:”
读*,a
如果(a=999)退出
打印*,“必须是介于-999和999之间的整数。请重试!”
结束
EnterA=a
端功能入口
! 新的外部功能------------------------------------------------------------------------------
整数函数EnterB()
隐式无
整数::b=0
做
写入(*,”(1X,A)”,ADVANCE=“NO”),“输入B:
读*,b
如果(b=999)退出
打印*,“必须是介于-999和999之间的整数。请重试!”
结束
EnterB=b
端功能输入
!-----------------------------------------------------------------------------------
整数函数enter()
隐式无
整数::c=0
做
写(*,”(1X,A)”,ADVANCE=“NO”),“输入C:
读*,c
如果(c=999)退出
打印*,“必须是介于-999和999之间的整数。请重试!”
结束
EnterC=c
端功能肠
!---------------------------------------------------------------------------------
整数函数FindDiscriminate(a、b、c)
隐式无
整数::disc=0
整数,意图(IN)::a、b、c
disc=INT(b**2)-(4*a*c)
FindDiscriminate=圆盘
结束函数FindDiscriminate
!----------------------------------------------------------------------------------
实函数FindUniqueSolution(a、b、c、disc)
隐式无
实数::x
真实,意图(IN)::a,b,c,disc
x=实(-b)/(2.0*a)
FindUniqueSolution=x
端函数FindUniqueSolution
!---------------------------------------------------------------------------------
实函数FindRealSolution1(a、b、c、disc)
隐式无
实数::x1
真实,意图(IN)::a,b,c,disc
x1=实(-b+盘)/(2.0*a)
FindRelation1=x1
结束函数FindRealSolution1
!---------------------------------------------------------------------------------
实函数FindRealSolution2(a、b、c、disc)
隐式无
实数:x2
真实,意图(IN)::a,b,c,disc
x2=真实(-b盘)/(2.0*a)
FindRelation2=x2
结束函数FindRealSolution2

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

我不知道你的类型不一致,但我注意到你忘了取判别式的平方根。“如果有人对我可能错在哪里提出建议,我将不胜感激。”-好吧,首先;停止使用这么多功能。(除非有很好的理由!是吗?)奇怪的是,你把这么多变量声明为一个二次方程的整数。编译器可能在某个地方突出显示了实际参数和伪参数之间的类型差异。如果您给出具体的错误消息,包括显示编译器调用了哪些行,这会有所帮助。尽管如此,发布的代码使用gfortran和ifort为我正确编译(尽管它运行不正确;enterA/b/c中的if测试是向后的,实际上不需要为每个变量设置单独的函数,等等)。您希望函数是外部函数,但在同一个文件中,而不是在程序或模块中的CONTAINS语句中,这是有原因的吗?您的逻辑中还有一个大写错误:
a=999
如果a在-999:999范围内,那么它将为false,如果a小于-999,则为false,如果a大于999,也是假的。所以它的计算结果总是错误的。。。(编辑:前面的评论似乎已经提到了t