I have a module and another module that uses it but that second module doesn’t build with either gfortran or ifx. Any help would be greatly appreciated!
[simon@localhost hp]$ ifx -c dummy_mod.f90
[simon@localhost hp]$ ifx -c numerical.f90
numerical.f90(15): error #6457: This derived type name has not been declared. [T1]
type(T1) :: value_fun
-----------------^
numerical.f90(16): error #6457: This derived type name has not been declared. [T1]
type(T1), intent(in) :: v
-----------------^
numerical.f90(63): error #6460: This is not a component name that is defined in the encompassing structure. [D1]
associate (fx => r%v, dfx => r%d1)
---------------------------------------^
numerical.f90(65): error #6593: There are more component specifications in a structure constructor than components in the derived type. [1]
r = f(T1(x,1))
---------------------------^
numerical.f90(65): error #6633: The type of the actual argument differs from the type of the dummy argument.
r = f(T1(x,1))
----------------------^
numerical.f90(65): error #6303: The assignment operation or the binary expression operation is invalid for the data types of the two operands. [F]
r = f(T1(x,1))
--------------------^
numerical.f90(69): error #6404: This name does not have a type, and must have an explicit type. [DFX]
x = x - fx/dfx
---------------------------^
compilation aborted for numerical.f90 (code 1)
or
[simon@localhost hp]$ gfortran -c dummy_mod.f90
[simon@localhost hp]$ gfortran -c numerical.f90
numerical.f90:15:21:
15 | type(T1) :: value_fun
| 1
Error: Derived type 't1' at (1) is being used before it is defined
numerical.f90:16:21:
16 | type(T1), intent(in) :: v
| 1
Error: Derived type 't1' at (1) is being used before it is defined
numerical.f90:63:37:
63 | associate (fx => r%v, dfx => r%d1)
| 1
Error: Invalid association target at (1)
numerical.f90:71:11:
71 | end associate
| 1
Error: Expecting END SUBROUTINE statement at (1)
numerical.f90:43:42:
43 | module subroutine newton_raphson_ncl(f, soln, ilimit, err)
| 1
Error: Type mismatch in argument 'f' (REAL(4)/UNKNOWN) at (1)
numerical.f90:69:30:
69 | x = x - fx/dfx
| 1
Error: Symbol 'dfx' at (1) has no IMPLICIT type
numerical.f90:66:26:
66 | if (abs(fx) < eps) then
| 1
Error: Symbol 'fx' at (1) has no IMPLICIT type; did you mean 'f'?
numerical.f90:65:27:
65 | r = f(T1(x,1))
| 1
Error: Too many components in structure constructor at (1)
numerical.f90:66:26:
66 | if (abs(fx) < eps) then
| 1
Error: Symbol 'fx' at (1) has no IMPLICIT type; did you mean 'f'?
There are several issues, so perhaps you meant to include a USE statement
abstract interface
function value_fun(v, err)
use dummy_AVD, only: T1=>avd_d1
type(T1) :: value_fun
type(T1), intent(in) :: v
integer, optional, intent(out) :: err ! 0 if no error
end function value_fun
end interface
If that is the case, the other issues should then fall in line and be resolvable.
As it was already pointed out by @urbanjost, your abstract interface for value_fun lacks access to the definition of type T1.
This is because in Fortran abstract interfaces are separate scoping units, which by default do not have access to the definitions and declarations that their hosting module contains, or can access itself. This, in fact, includes even any implicit none declarations.
These (pointless) defaults in Fortran (that run counter to how interfaces work in all other languages) can be changed, with some verbosity, as follows:
abstract interface
function value_fun(v, err)
import; implicit none
type(T1) :: value_fun
type(T1), intent(in) :: v
integer, optional, intent(out) :: err ! 0 if no error
end function value_fun
end interface
A second issue with the code that you posted is that in the code line associate (fx => r%v, dfx => r%d1)
you are trying to access the component d1 of object r, which was declared as follows: type(T1) :: r
However, with T1 being just an alias for your base type, avd_b, the compiler cannot be expected to find a component with name d1. Because a declaration for this component is only available in the extended type, avd_d1, but not the base type itself.
As @urbanjost correctly remarked, there are a few more compilation errors, but once you’ve fixed the above two you should be able to figure out also the rest.
Thank you for your help, I didn’t realize that you could put a use statement inside an abstract interface. It fixed the issue but I’ve decided to use the import statement instead.
This is most likely another gfortran compiler bug on object-oriented (OO) code. Your new version builds with both ifx and flang-20 for me. I personally avoid the use of gfortran on OO code.
If you need to compile such code with an open source compiler, it’s presently better to use (LLVM’s) flang, instead. It has a much more reliable implementation of modern Fortran features, even when compared to ifx.
I think there are cases where the programmer might want to do either one or the other. A feature of the USE statement approach, especially with ONLY clauses, is that the programmer knows where a symbol is coming from just by looking at the interface block. With IMPORT, it might be from one place in one source file and another place in another source file, even with the same interface, so this can lead to errors that are difficult to locate.
The following modified version of numerical.f90 compiles without error using gfortran 13.
The issues are you are defining the explicit interface twice for newton_raphson_ncl. It only needs to be specified in a module procedure statement in the interface statement, not the complete subroutine signature.
module numerical
use iso_fortran_env
! Only need first derivatives from the autodiff library
use dummy_AVD, only: T1=>avd_d1, avd_init=>init
implicit none
abstract interface
function value_fun(v, err)
import; implicit none
type(T1) :: value_fun
type(T1), intent(in) :: v
integer, optional, intent(out) :: err ! 0 if no error
end function value_fun
end interface
! Information about the result
type res_info_t
integer :: n_iterations = 0
real(8) :: residue = 0.0d0
logical :: solved = .false.
end type res_info_t
interface newton_raphson
module procedure newton_raphson_ncl
end interface
contains
subroutine newton_raphson_ncl(f, x0, soln, ilimit, err)
procedure(value_fun) :: f
real(8), intent(in) :: x0
real(8), intent(out) :: soln
integer, optional, intent(in) :: ilimit
type(res_info_t), intent(out) :: err
real(8), parameter :: eps = 1.0d-9
integer :: max_iterations
integer :: counter
real(8) :: x
type(T1) :: r
if (present(ilimit)) then
max_iterations = ilimit
else
max_iterations = 32
end if
call avd_init
x = x0
associate (fx => r%v, dfx => r%d1)
nr: do counter=1,max_iterations
r = f(T1(x,1))
!!write(*,'(i3,3x,2(a,f0.8))') counter,'f(',x,') = ',r%v
if (abs(fx) < eps) then
exit nr
end if
x = x - fx/dfx
write(*,'(i3,3x,f0.8,3x,g0.6)') counter,x,eps
end do nr
end associate
err = res_info_t(counter,r%v,counter < max_iterations)
soln = x
end subroutine newton_raphson_ncl
end module numerical