二次方程式を使ったプログラムを作ろうとしています。ただし、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