Я пытаюсь создать программу, которая использует квадратную формулу.Тем не менее, я хочу сделать это полностью с внешними функциями на 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