sharpphoton
sharpphoton

Reputation: 1

programming Quadratic equation using functions on fortran 95

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

Upvotes: 0

Views: 4969

Answers (1)

eriktous
eriktous

Reputation: 6649

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.

Upvotes: 2

Related Questions