F95 says K:\peob.F90(24) : error 283 - AREA_CIRCLE must appear in a type declaration because IMPLICIT NONE has been used
Gfortran doesn’t mind the error
Runing has a problem
My question: I don’t understand the error
Once the code is running okay - does the module go somewhere else in the file, and under what name?
MODULE Circle
REAL, PARAMETER :: Pi = 3.1415927
REAL :: radius
END MODULE Circle
PROGRAM Area
USE Circle, ONLY : radius
IMPLICIT NONE
INTERFACE
FUNCTION Area_Circle (r)
REAL, INTENT(IN) :: r
END FUNCTION Area_Circle
END INTERFACE
! Prompt user for radius of circle
write(, ‘(A)’, ADVANCE = “NO”) "Enter the radius of the circle: "
read(,*) radius
! Write out area of circle using function call
write(*,100) “Area of circle with radius”, radius, " is", Area_Circle(radius)
100 format (A, 2x, F6.2, A, 2x, F11.2)
END PROGRAM Area
FUNCTION Area_Circle(r)
USE Circle, ONLY : Pi
IMPLICIT NONE
REAL :: Area_Circle
REAL, INTENT(IN) :: r
Area_Circle = Pi * r * r
END FUNCTION Area_Circle
You could add the type of function Area_Circle to the interface, giving
INTERFACE
FUNCTION Area_Circle (r)
REAL, INTENT(IN) :: r
REAL :: Area_Circle
END FUNCTION Area_Circle
END INTERFACE
I put procedures in modules to avoid having to write interfaces. The code would be
MODULE Circle
implicit none
REAL, PARAMETER :: Pi = 3.1415927
contains
FUNCTION Area_Circle(r)
REAL, INTENT(IN) :: r
REAL :: Area_Circle
Area_Circle = Pi * r * r
END FUNCTION Area_Circle
END MODULE Circle
PROGRAM Area
USE Circle, ONLY : Area_Circle
IMPLICIT NONE
REAL :: radius
! Prompt user for radius of circle
write(*,"(A)", ADVANCE = "NO") "Enter the radius of the circle: "
read(*,*) radius
! Write out area of circle using function call
write(*,100) "Area of circle with radius", radius, " is", Area_Circle(radius)
100 format (A, 2x, F6.2, A, 2x, F11.2)
END PROGRAM Area
Sorry for all these questions, and thank you for having responded!
We now have old version / your (better) version. Old version uses interface. Does interface only allow compiler to check consistency of terms used? So irresponsibly accepting a risky situation, interface could be left out?
I understood from a text that modules are for code you share with several other code users. So you stipulate use only to keep usages apart. Then why does your code specify “use only Area_Circle" because there is only one user.
Is “contains” only necessary when routines are drawn into the main program? So “contains” is superfluous when procedures follow after end program?
Could two programs share a module? If so, how would the module be referenced?
The Intel compiler documentation is one place that explains which Procedures Require Explicit Interfaces. It is recommended that arrays be passed to procedures as assumed-shape arrays, and such procedures require explicit interfaces.
This program compiles with either
USE Circle, ONLY : Area_Circle
or
USE Circle
I typically use the ONLY specifier in order to document what is being imported from a module. If more than one module defines entities with the same name, the ONLY specifier becomes necessary to avoid name clashes.
Each module should be written in a separate .f90 source file. Modules need to be compiled prior to any program units that use them.
So for example if you have a file constants.f90 that defines constants such as pi you could have main programs main1.f90 and main2.f90 that USE it and create separate executables with
Beliavsky, thank you for all your information. Looking up your reference, “when an interface is required”: the list is long, so always use an interface to a procedure outside the program body?
Is the word “contains” only required when a procedure is encapsulated in another procedure or module?
Your notes are very clear by the way. Thank you again.