Type-bound procedure that uses an external procedure with an explicit interface: Sometimes it compiles, sometimes not - interface

I screwed up on my previous question and had to delete it. Here's a new one:
I got most of this code from this quite helpful site:
module shape_mod
type shape
integer :: color
logical :: filled
integer :: x
integer :: y
contains
procedure :: initialize
end type shape
type, extends(shape) :: rectangle
integer :: length
integer :: width
end type rectangle
type, extends(rectangle) :: square
end type square
interface
subroutine initialize(sh, color, filled, x, y, length, width)
import shape
class(shape) :: sh
integer :: color
logical :: filled
integer :: x
integer :: y
integer, optional :: length
integer, optional :: width
end subroutine
end interface
end module
subroutine initialize(sh, color, filled, x, y, length, width)
! initialize shape objects
class(shape) :: sh
integer :: color
logical :: filled
integer :: x
integer :: y
integer, optional :: length
integer, optional :: width
! do stuff with shape
end subroutine initialize
program drv
use shape_mod
type(shape) :: sh
call sh%initialize(1, .true., 0, 0, 5, 10)
end program
This fails to compile (as it should, as pointed out by respondents to my previous question) with the error:
gfortran shape2.f90
shape2.f90:38:16:
class(shape) :: sh
1
Error: Derived type ‘shape’ at (1) is being used before it is defined
shape2.f90:46:7: Error: Symbol ‘sh’ at (1) has no IMPLICIT type
shape2.f90:47:7: Error: Symbol ‘sh’ at (1) has no IMPLICIT type
shape2.f90:48:7: Error: Symbol ‘sh’ at (1) has no IMPLICIT type
shape2.f90:49:7: Error: Symbol ‘sh’ at (1) has no IMPLICIT type
So, my question is, what can I do to get subroutine initialize() to know about type shape? The only thing I can think of is to put a use statement in:
subroutine initialize(sh, color, filled, x, y, length, width)
use shape_mod
! initialize shape objects
class(shape) :: sh
integer :: color
logical :: filled
...
end subroutine initialize
But that gives me a new error:
gfortran shape2.f90
shape2.f90:37:8:
use shape_mod
1
Error: ‘initialize’ of module ‘shape_mod’, imported at (1), is also the name of the current program unit
How to write the subroutine is the one thing the link I referenced above does not tell. Is there a way to do this? Or does initialiaze() have to be part of shape_mod for this to work?

In the module you have defined an interface for the external procedure initialize. When you use this module in the subroutine definition you have access to the interface of the subroutine itself.
You cannot do this.
Fortunately, you can avoid having the interface accessible by
use shape_mod, only shape
Now, the above is necessary because of the design made to use an external procedure in the type binding. In general, one would expect not to use an external procedure in this way. As we've seen, there's the additional complexity in using an external procedure, both with having to use the module where the type is defined, but also in having to manually specify the procedure's interface.
There are times where an external interface would be useful, but here the purpose of the example leading to the question was perhaps pedagogical rather than simple. There's no obvious reason here why initialize shouldn't be a module procedure.
Instead, consider the example
interface
subroutine ext()
end subroutine
end interface
type mytype
contains
procedure(iface), nopass :: ext
end type
The external subroutine ext doesn't have a passed-object dummy (the binding has nopass) so doesn't need the module in which mytype is defined. This is a simplification.
Finally, as High Performance Mark comments, perhaps initialize needn't even be a binding name. Instead a "constructor" could be used:
type mytype
end mytype
interface mytype
procedure intialize_mytype
end interface
Details are left for the interested reader to find from other sources.

Related

Portable declaration of REAL variables in mex gateway for Fortran

I am writing a mex gateway for a piece of Fortran code.
In the Fortran code, for portability, the floating-point variables are declared as
REAL(kind(0.0D0)) :: x, y, etc
(BTW, I am aware that there are better ways to do it, as discussed at
Fortran: integer*4 vs integer(4) vs integer(kind=4),
What does "real*8" mean?, and
https://software.intel.com/en-us/blogs/2017/03/27/doctor-fortran-in-it-takes-all-kinds )
However, it seems to me that mex supports only REAL*8 and REAL*4, the former being Double, the latter being Single. I got this impression from the following functions/subroutines:
mxIsDouble, mxIsSingle, mxCopyPtrToReal8, mxCopyReal8ToPtr, mxCopyPtrToReal4, mxCopyReal4ToPtr
My questions are as follows.
Is it true that mex supports only REAL*8 and REAL*4?
Does it improve the portability of the mex gateway if I declare double-precision floating-point variables as
REAL(kind(0.0D0)) :: x, y, etc
or even
integer, parameter :: dp = selected_real_kind(15, 307)
real(kind=dp) :: x, y, etc
Or should I simply declare
REAL*8 :: x, y, etc
Are REAL*8 and/or REAL*4 supported on all platforms? If no, does this mean that MATLAB mex is intrinsically unportable?
What is the best way to specify the kind of floating-point variables in mex gateways for Fortran code?
The following code is an example. See the declaration of x, y, and xs.
#include "fintrf.h"
subroutine mexFunction(nlhs, plhs, nrhs, prhs)
C y = square (x)
C x: a floating point scalar
C y: x^2
implicit none
C mexFunction arguments
integer, intent(in) :: nlhs, nrhs
mwPointer, intent(in) :: prhs(nrhs)
mwPointer, intent(inout) :: plhs(nlhs)
C function declarations:
mwPointer, external :: mxCreateDoubleScalar, mxGetPr
mwSize, external :: mxGetM, mxGetN
integer*4, external :: mxIsDouble, mxIsSingle
C variables
mwSize, parameter :: mwOne = 1
integer, parameter :: dKind = kind(0.0D0)
integer, parameter :: sKind = kind(0.0)
real(kind=dKind) :: x, y ! Does this improve the portablity?
real(kind=sKind) :: xs ! Does this improve the portablity?
C validate number of arguments
if (nrhs .ne. 1) then
call mexErrMsgIdAndTxt ('mex:nInput', '1 input required.')
endif
if (nlhs .gt. 1) then
call mexErrMsgIdAndTxt ('mex:nOutput', 'At most 1 output.')
endif
C validate input
if (mxIsDouble(prhs(1)) .ne. 1 .and. mxIsSingle(prhs(1)) .ne. 1)
! What if the input is a floating point number but neither Double nor Single?
+ then
call mexErrMsgIdAndTxt ('mex:Input', 'Input a real number.')
endif
if (mxGetM(prhs(1)) .ne. 1 .or. mxGetN(prhs(1)) .ne. 1) then
call mexErrMsgIdAndTxt ('mex:Input', 'Input a scalar.')
endif
C read input
if (mxIsDouble(prhs(1)) .eq. 1) then
call mxCopyPtrToReal8(mxGetPr(prhs(1)), x, mwOne)
else
call mxCopyPtrToReal4(mxGetPr(prhs(1)), xs, mwOne)
x = real(xs, dKind)
! What if the input is a floating point number but neither REAL*8 nor REAL*4
endif
C do the calculation
y = x**2
C write output
plhs(1) = mxCreateDoubleScalar(y)
return
end subroutine mexFunction
The code runs correctly. Yet I am not sure whether it is portable.
REAL*4 and REAL*8 are non-standard and non-portable. REAL(KIND(0.0D0) gets you DOUBLE PRECISION on every platform, as this is required by the Fortran standard.
I can't speak to MEX gateways, but you should avoid obvious non-standard features.
A popular choice is to define a module that declares named (PARAMETER) constants for the kinds in use. For example:
module kinds
integer, parameter :: SP = KIND(0.0)
integer, parameter :: DP = KIND(0.0D0)
end module kinds
Then you can use SP and DP as kind values. If you ever need to change these, just edit the module.
Currently, it makes no difference whether you define variables as REAL*8/REAL*4 or REAL(REAL64)/REAL(REAL32). In the future MathWorks may come around and rewrite their functions to use portable variable declarations, but in my opinion this is unlikely for many reasons.
If you look in the fintrf.h file (included in every Fortran MEX gateway source file), you'll see that all of the MEX-specific procedures are defined with "asterisk notation," e.g. # define MWPOINTER INTEGER*8. So even if you define all of your variables with kinds from iso_fortran_env or selected_real_kind, any time you use a MathWorks variable type you're still using "asterisk notation" types, unless you go through that header file and redefine every symbol using your chosen kind specification.

Calculating a checksum of a real array in Fortran

I have a large array in Fortran:
real, dimension(N) :: arr
And I need to check if the array is exactly the same in different runtimes of the program. To do this, I wanted to create a checksum of the array to compare. However, I don't know which algorithm to implement. I have looked at Flether's and Adler's algorithm, but have trouble reading the C syntax provided in the examples I found. And also, I don't know how to implement them with Reals instead of chars/integers.
In the C implementations I have found they return:
return (b << 16) | a;
But I don't know how to implement the b << 16 part in Fortran, or if this translates well to reals.
I finally solved the issue by implementing Adler-32 in Fortran:
subroutine test_hash(var)
implicit none
real, dimension(N), intent(in) :: var
integer, dimension(N) :: int_var
integer :: a=1, b=0, i=1, mod_adler=65521, hash = 0
int_var = TRANSFER(var, a, nijk)
do i= 1, NIJK
a = MOD(a + int_var(i), mod_adler)
b = MOD(b+a, mod_adler)
end do
hash = ior(b * 65536, a)
print*, hash
end subroutine test_hash
I ended up using the Fortran intrinsic Transfer function to convert the 32bit reals to 32bit integers, since that's what the algorithm relies on. After this I perform the standard loop. Use the IOR function as suggested by #VladimirF and represented the b<<16 as b * 65536 described by #ja72.
Finally I'll be able to print the hash to the console.
The reason for implementing it this way was because it's faster in use than opening a file, computing the checksum per file. The main reason for this is because there are many variables I need to check which switch often since I'm only using this for debugging purposes.
A modified version of Lars accomplishes the same without a large temporary array. Also, in Fortran, initializing the variable at declaration time implies the "save" attribute, which is not desirable in this case.
function hash_real_asz(var,size_var) result(hash)
implicit none
integer(8) :: hash
real(8), dimension(*), intent(in) :: var
integer, intent(in) :: size_var
integer(4) :: a,b,i,j
integer(4), parameter :: mod_adler = 65521
integer(4), allocatable :: tmp(:)
a = 1
b = 0
do i= 1, size_var
tmp = transfer(var(i), [0]) ! tmp will be an integer array sufficient to hold var(i)
do j = 1,size(tmp)
a = MOD(a+tmp(j), mod_adler)
b = MOD(b+a, mod_adler)
end do
end do
hash = ior(b * 65536, a)
end function

Fortran convert string to number

I want to have a subroutine that converts a contents of a numeric
string to a numeric type (int, real, double precision, real(real128)).
However I am getting an error when trying to use Class(*). The error
is shown below:
gfortran -o build/lib/larsa.o -c -ffree-form -g -J./build/lib lib/larsa.f
lib/larsa.f:1933.35:
Read (s, frmt, iostat=ios) num
1
Error: Data transfer element at (1) cannot be polymorphic unless
it is processed by a defined input/output procedure
lib/larsa.f:1935.32:
Read (s, *, iostat=ios) num
1
Error: Data transfer element at (1) cannot be polymorphic unless
it is processed by a defined input/output procedure
This is the subroutine I have written.
Subroutine converts_str_to_num &
( &
s, num, &
fmt, wrn &
)
Character (len=*), Intent (in) :: s
Character (len=*), Intent (in), Optional :: fmt
Class (*) :: num
Character (len=*), Intent (inout), Optional :: wrn
Integer :: ios
Character (len=65) :: frmt
!!$ Reads contents of s and puts value in i.
If (Present (fmt)) Then
frmt = "(" // Trim (fmt) // ")"
Read (s, frmt, iostat=ios) num
Else
Read (s, *, iostat=ios) num
End If
End Subroutine converts_str_to_num
To tidy up the comments, I'll provide an answer.
The error message is clear: you cannot have a polymorphic variable in an input/output list unless the list is processed by defined input/output. This is 9.6.3.5 in Fortran 2008. class(*) num is (unlimited) polymorphic.
Now, for polymorphic derived types you could define such a defined input/output procedure, but that counts as a lot of work and gfortran certainly doesn't (yet) support that notion. Also, you can't do this for intrinsic types. These factors mean you have to deal with non-polymorphic variables in the input list you have.
Of course, it's possible to use generics to avoid polymorphism, but the alternative (as it is for about everything polymorphic) is to use a select type construct. For simplicity, ignore the list-directed and explicit format cases:
select type (assoc => num)
type is (int)
Read (s, *, iostat=ios) assoc
type is (real)
...
type is (...)
class default
error stop "Oh noes!"
end select
I've used an associate name in the select type to address one part of your confusion. If you've just done
select type(num)
type is (int)
Read (s, *, iostat=ios) num
end select
to think that "now using num is fine: why?" that's because the num inside the construct is not the same as the num outside. Crucially, it isn't polymorphic but is the exact type matching the type is.

How to return a value from a Python callback in Fortran using F2Py

Consider the following Fortran subroutine, defined in test.f:
subroutine test(py_func)
use iso_fortran_env, only stdout => output_unit
external py_func
integer :: a
integer :: b
a = 12
write(stdout, *) a
b = py_func(a)
write(stdout, *) b
end subroutine
Also the following Python code, defined in call_test.py:
import test
def func(x):
return x * 2
test.test(func)
Compiled with the following (Intel compiler):
python f2py.py -c test.f --fcompiler=intelvem -m test
I expect this as output when I run test:
12
24
But I actually get this:
12
0
It seems as if b is being initialised with a default value instead of the result of test. I have tried using the following in the Fortran:
!f2py intent(callback) py_func
external py_func
!f2py integer y,x
!f2py y = py_func(x)
But my program crashes after the printout of 12 to the console.
Any ideas what could be going on here? The reason for the crash would be a bonus, but I'm really just interested in getting a simple callback working at this point.
I don't claim to understand it, I found the answer on an F2Py forum thread. Adding integer py_func (not prefixed by !f2py) does the trick for me:
subroutine test(py_func)
use iso_fortran_env, only stdout => output_unit
!f2py intent(callback) py_func
external py_func
integer py_func
!f2py integer y,x
!f2py y = py_func(x)
integer :: a
integer :: b
a = 12
write(stdout, *) a
b = py_func(a)
write(stdout, *) b
end subroutine
Perhaps this is to do with space being needed for a temporary value used to store the result before being assigned to b? In any case, it is apparently compiler-dependent, which explains why it is not in various F2Py callback examples you can find elsewhere online.

printing the function name in fortran 90

I wrote a code that finds the root of a function whose name is provided among the arguments, I think I took it from Numerical Recipes. Something like
double precision function rtsafe(x_init, x1, x2, xacc, func, dfunc)
where func and dfunc are two functions' names.
Of course I use rtsafe with different function func and dfunc.
I would like to print the name of the called functions func and dfunc when I am inside rtsafe, because when there is an error in rtsafe I would like to know which function I was using. Something like
write(,)"my func = ", func
(?)
Does anybody know how to do that?
You could add an optional argument in your functions that returns the name of the function:
FUNCTION f(x, fname) RESULT (fx)
IMPLICIT NONE
REAL :: x, fx
CHARACTER(LEN=*), OPTIONAL :: fname
CHARACTER(LEN=*), PARAMETER :: myfname='somename'
IF (present(fname)) fname=myfname
fx = x ! or whatever else
END FUNCTION f
In the first call to your function in rtsafe you get the name of the function for later printing in case of an error.
Did not test this but it should work more or less like this, and it the only way I can think of to do this in Fortran.
Maybe you can work up some manual solution (pass the name of the function, then print it with "OK" ... or something like that), but printing the names of the functions/subroutines (reflecting) is not possible.