programmation équation Quadratique en utilisant des fonctions sur Fortran 95

Question

Je suis en train de créer un programme qui utilise la formule quadratique. Cependant, je veux le faire entièrement avec des fonctions externes sur Fortran 95. Mon programme continue à me donner des erreurs étranges concernant les « types incompatibles » et etc.

C'est ce que j'ai jusqu'à présent. Si quelqu'un a des suggestions sur ce que je pourrais me tromper, je l'apprécierais grandement.

Merci beaucoup!

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 

Answer 1

Dans votre programme principal, vous faites référence aux fonctions FindUniqueSolution, FindRealSolution1, and FindRealSolution2. Vous transmettez a,b,c, and disc en tant qu'arguments. Ceux-ci sont déclarés comme entiers, mais à l'intérieur de ces fonctions, les arguments fictifs correspondants sont déclarés comme réels. Donc, il y a votre incompatibilité de type.