I'm trying to write a routine that is able to convert a string into different kinds of data type, based on unlimited polymorphism. The idea is the user call this routine, passing the variable where it wants to store the data, and the routine to define the conversion based on the variable/argument type.
An excerpt of this routine is here:
subroutine GetAsScalar (this, value, status)
!Arguments-------------------------------------------------------------
class(TKeyword) :: this
class(*) :: value
logical, optional :: status
!Local-----------------------------------------------------------------
integer :: stat
!----------------------------------------------------------------------
stat = 0
select type (value)
type is (REAL(real32)) !single precision
read (this%fValue, *, IOSTAT = stat) value
type is (REAL(real64)) !double precision
read (this%fValue, *, IOSTAT = stat) value
type is (LOGICAL)
read (this%fValue, *, IOSTAT = stat) value
type is (INTEGER(int32)) !integer
read (this%fValue, *, IOSTAT = stat) value
type is (INTEGER(int64)) !long integer
read (this%fValue, *, IOSTAT = stat) value
type is (CHARACTER(*))
value = this%fValue
class default
this%Message = "Invalid data type"
status = .false.
return
end select
if (present (status)) then
if (stat /= 0) then
status = .false.
else
status = .true.
endif
endif
end subroutine GetAsScalar
"this%fValue" is a "character(len=:), allocatable" string.
When I try to use this routine passing an allocatable string, it exit with success, no error/exceptions raise:
character(len=:), allocatable :: value
call keyword%GetAsScalar(value)
But the string "value" is always empty.
Even inside the routine, after the assign "value = this%fValue", value is empty (len(value) is 0).
It seems that the compiler is unable to detected that the argument is of type character(len=:), allocatable, and so, is unable to assign the value to it.
Of course I have some alternatives, but the idea of being able to use a single rountine and without optional arguments for different kind of data is really nice.
I can use a user defined type that I create to handle strings, for example.
But I would like to know if this is the default behaviour in Fortran 2008.
And also, if there is a way to accomplish this, using this routine, with a single "class(*)" dummy argumment, to convert different types including the referred allocatable character. There is a way to force the allocation inside the routine, for example?
I'll appreciate your comments.
Cheers,
Eduardo
In a select type (or associate) construct, the associate name never has the allocatable attribute (16.5.1.6p2), regardless of whether the select has that attribute.
In your case, the selector is also lacking that attribute - the value dummy argument is not declared to be allocatable. You are not permitted to associate an unallocated actual argument with a non-optional non-allocatable dummy argument. Beyond that, you are not permitted to use an unallocated selector in a select type or associate construct.
You need to allocate the value actual argument to some length before the call, the value associate name will then have that fixed length inside the select type construct. Alternatively, wrap the allocatable character variable as a component in a derived type.
Related
The following function is supposed to convert a C string into a Fortran string and works fine in Release builds, but not in Debug:
! Helper function to generate a Fortran string from a C char pointer
function get_string(c_pointer) result(f_string)
use, intrinsic :: iso_c_binding
implicit none
type(c_ptr), intent(in) :: c_pointer
character(len=:), allocatable :: f_string
integer(c_size_t) :: l_str
character(len=:), pointer :: f_ptr
interface
function c_strlen(str_ptr) bind ( C, name = "strlen" ) result(len)
use, intrinsic :: iso_c_binding
type(c_ptr), value :: str_ptr
integer(kind=c_size_t) :: len
end function c_strlen
end interface
l_str = c_strlen(c_pointer)
call c_f_pointer(c_pointer, f_ptr)
f_string = f_ptr(1:l_str)
end function get_string
However, it seems that c_f_pointer does not tell the Fortran pointer-to-string, f_ptr, the length of the string it is pointing to. In Debug builds, where bounds-checking is active, this results in
Fortran runtime error: Substring out of bounds: upper bound (35) of 'f_ptr' exceeds string length (0)
I'm using gcc (Ubuntu 9.3.0-17ubuntu1~20.04) 9.3.0 and set the standard to 2008.
My question: Is there any way to tell the f_ptr its length without changing the declaration or am I doing something fundamentally the wrong way here?
It seems to run correctly if I specify the shape, but for that f_ptr needs to be an array:
character(len=:), allocatable :: f_string
character(len=1), dimension(:), pointer :: f_ptr
...
call c_f_pointer(c_pointer, f_ptr, [l_str])
However, I cannot find a way to transform that string of rank 1 to the character(len=:), allocatable :: f_string, which apparently has rank 0.
My second question: Is there any way to transfer the f_ptr data into the f_string in this example?
You cannot use c_f_pointer to set the length of the Fortran character pointer (F2018, 18.2.3.3):
FPTR shall be a pointer, shall not have a deferred type parameter [...]
A deferred-length character scalar (or array) therefore cannot be used (the length is a type parameter).
You can indeed use a deferred-shape character array as fptr and then use any number of techniques to copy the elements of that array to the scalar (which is rank-0 as noted).
For example, with substring assignment (after explicitly allocating the deferred-length scalar):
allocate (character(l_str) :: f_string)
do i=1,l_str
f_string(i:i)=fptr(i)
end
Or consider whether you can simply use the character array instead of making a copy to a scalar.
I have a structure defined:
STRUCTURE /IOA/
INTEGER*2 ID
.....
END STRUCTURE
I need to create another structure, IOB. IOB contains all the same fields as IOA but with many more.
STRUCTURE /IOB/
INTEGER*2 ID
.....
END STRUCTURE
My program currently has:
RECORD /IOA/ A
RECORD /IOB/ B
The program will either use A or B depending on a user input.
Is there any way to have some sort of conditional in the code to use A or B depending on what's required? For example, is it possible to create a placeholder record (variable?) "IO" and define it based on the input?:
If user input = 1, IO = A
else IO = B
.....
IO.ID = 30
Thank you.
That's what polymorphism in modern Fortran (2003 and further) is for.
use iso_fortran_env, only: int16
implicit none
type IOA
integer(int16) :: ID
end type
type, extends(IOA) :: IOB
integer :: extendedID
end type
class(IOA), allocatable :: IO
integer :: user_input = 2
if (user_input == 1) then
allocate(IOA :: IO)
else
allocate(IOB :: IO)
end if
IO%ID = 30
select type (IO)
type is (IOB)
IO%extendedID = 42
class default !just an illustration
continue
end select
end
You can't do this with the obsolete DEC extensions STRUCTURE and RECORD. A advise against using these extensions. They are not part of standard Fortran.
My recommendation is to make the type IO_TYPE in a module, and have it contain a POINTER to a type with the extra stuff you may or may not need:
MODULE IO_TYPES
TYPE EXTRA_STUFF
INTEGER :: AGE
INTEGER :: HEIGHT
INTEGER :: WIEGHT
END type EXTRA_STUFF
TYPE IO_TYPE
INTEGER :: ID
TYPE(EXTRA_STUFF), POINTER :: EXT
END type IO_TYPE
END MODULE IO_TYPES
Then, in your program, which will have USE IO_TYPES, of course, you can decide whether to allocate that pointer:
TYPE (IO_TYPE) :: IO
INTEGER :: IERR_ALLOC
IF ( USER_INPUT .EQ. 1 ) ALLOCATE( IO%EXT, STAT=IERR_ALLOC )
IF ( IERR_ALLOC .NE. 0 ) STOP 1
(Always check the results of ALLOCATE statements.)
In fortran, we can define default arguments. However, if an optional argument is not present, it can also not be set. When using arguments as keyword arguments with default values, this leads to awkward constructs like
PROGRAM PDEFAULT
CALL SUB
CALL SUB(3)
CONTAINS
SUBROUTINE SUB(VAL)
INTEGER, OPTIONAL :: VAL
INTEGER :: AVAL ! short for "actual val"
IF(PRESENT(VAL)) THEN
AVAL = VAL
ELSE
AVAL = -1 ! default value
END IF
WRITE(*,'("AVAL is ", I0)') AVAL
END SUBROUTINE SUB
END PROGRAM PDEFAULT
Personally, I often ran into the problem of accidentially typing VAL instead of AVAL, i.e. the disconnect between the variable name in the interface, and the initialized value used in the code can introduce runtime bugs – let alone that this manner of initialization is rather verbose.
Is there some more elegant way of using optional arguments with a default value?
Example It would feel more natural to write something like
IF(NOT(PRESENT(VAL))) VAL = -1
because it avoids the VAL vs AVAL confusion. But it isn't valid, presumably because Fortran passes arguments by reference and thus if VAL is not present in the CALL statement, no memory is associated with VAL and VAL = -1 would cause a segfault.
You described the situation rather well. There is no other way I am aware off and that is standard conforming. The pattern with a local variable named similarly is what people often use. The other option is to just put if (present()) else everywhere, but that is awkward.
The point is that they are optional arguments, not default arguments. Fortran doesn't have default arguments. The may have been better, but that is not what the committee members have chosen in the 80s when preparing Fortran 90.
While also looking into this, I found out that you can in fact do something like the proposed example using the OPTIONAL and VALUE attributes (at least with gfortran, not sure how different compilers might handle it). E.g.:
PROGRAM PDEFAULT
CALL SUB
CALL SUB(3)
CONTAINS
SUBROUTINE SUB(VAL)
INTEGER, OPTIONAL,VALUE :: VAL
IF(.NOT. PRESENT(VAL)) VAL = -1 ! default value
WRITE(*,'("VAL is ", I0)') VAL
END SUBROUTINE SUB
END PROGRAM PDEFAULT
This was implemented in version 4.9 of gfortran. And here's the relevant explanation in the documentation for argument passing conventions:
For OPTIONAL dummy arguments, an absent argument is denoted by a NULL
pointer, except for scalar dummy arguments of type INTEGER, LOGICAL,
REAL and COMPLEX which have the VALUE attribute. For those, a hidden
Boolean argument (logical(kind=C_bool),value) is used to indicate
whether the argument is present.
I also found this discussion interesting as historical context.
Maybe somebody more knowledgeable might have comments on whether doing this is a bad idea (aside from being compiler dependent), but at least at face value it seems like a nice workaround.
Note that this behavior is not part of the Fortran standard, and depends on the implementation of a given compiler. For example, the example code segfaults when using ifort (version 16.0.2).
The Fortran standard lib (https://github.com/fortran-lang/stdlib) provides a function called optval that is used in stdlib_logger for example:
subroutine add_log_file( self, filename, unit, action, position, status, stat )
...
character(*), intent(in), optional :: action
...
character(16) :: aaction
...
aaction = optval(action, 'write')
...
end subroutine add_log_file
So their way of representing the "actual" value is a prepended a.
IMHO, I like the option with an appended _, since the optional values are visually marked as such in the call signature.
Whilst I certainly wouldn't advocate doing so in most situations (and indeed you can't in some situations), one may sometimes use an interface to provide a single entry point for multiple routines with different required arguments rather than using an optional argument. For example your code could be written like
MODULE subs
implicit none
public :: sub
interface sub
module procedure sub_default
module procedure sub_arg
end interface
contains
SUBROUTINE SUB_arg(VAL)
INTEGER :: VAL
WRITE(*,'("VAL is ", I0)') VAL
END SUBROUTINE SUB_arg
SUBROUTINE SUB_default
integer, parameter :: default = 3
CALL SUB_arg(default)
END SUBROUTINE SUB_default
END MODULE SUBS
PROGRAM test
use subs, only: sub
call sub
call sub(5)
END PROGRAM TEST
Again, I don't recommend this approach, but I thought I should include it anyway as an alternative way of providing something that looks like a default.
Another possibility is to use an associate block which associates the local variable name with a variable of the same name as the optional argument eg.
SUBROUTINE SUB(VAL)
INTEGER, OPTIONAL :: VAL
INTEGER :: AVAL ! short for "actual val"
IF (PRESENT(VAL)) THEN
AVAL = VAL
ELSE
AVAL = -1 ! default value
END IF
ASSOCIATE (VAL => AVAL)
WRITE(*,'("VAL is ", I0)') VAL
END ASSOCIATE
END SUBROUTINE SUB
Not ideal but allows you to use the same variable name for the argument and in the body of the routine. I shudder to think of the amount of untidy code I've written coping with the lack of default values for optional arguments - roll on F202X.
I hope Fortran to support a popular syntax like
subroutine mysub( x, val = -1 )
integer, optional :: val
or in a more Fortran style
subroutine mysub( x, val )
integer, optional :: val = -1 !! not SAVE attribute intended
but this seems not supported (as of 2016). So some workaround needs to be done by the users' side...
In my case, after trial-and-errors, I settled down to attaching one underscore to the optional dummy argument, so doing something like (*)
subroutine mysub( x, val_)
integer, optional :: val_
integer val
Other people seem to like the opposite pattern (i.e., dummy variable => sep, local variable => sep_, see split() in StringiFor, for example). As seen in this line, the shortest way to set the default value is
val = -1 ; if (present(val_)) val = val_
But because even this line is somewhat verbose, I usually define a macro like
#define optval(x,opt,val) x = val; if (present(opt)) x = opt
in a common header file and use it as
subroutine mysub( x, val_, eps_ )
integer :: x
integer, optional :: val_
real, optional :: eps_
integer val
real eps
optval( val, val_, -1 )
optval( eps, eps_, 1.0e-5 )
print *, "x=", x, "val=", val, "eps=", eps
endsubroutine
...
call mysub( 100 )
call mysub( 100, val_= 3 )
call mysub( 100, val_= 3, eps_= 1.0e-8 )
However, I believe this is still far from elegant and no more than an effort to make it slightly less error-prone (by using the desired variable name in the body of the subroutine).
Another workaround for a very "big" subroutine might be to pass a derived type that contains all the remaining keyword arguments. For example,
#define getkey(T) type(T), optional :: key_; type(T) key; if (present(key_)) key = key_
module mymod
implicit none
type mysub_k
integer :: val = -1
real :: eps = 1.0e-3
endtype
contains
subroutine mysub( x, seed_, key_ )
integer :: x
integer, optional :: seed_
integer :: seed
getkey(mysub_k) !! for all the remaining keyword arguments
optval( seed, seed_, 100 )
print *, x, seed, key% val, key% eps
endsubroutine
endmodule
program main
use mymod, key => mysub_k
call mysub( 10 )
call mysub( 20, key_= key( val = 3 ) )
call mysub( 30, seed_=200, key_= key( eps = 1.0e-8 ) ) ! ugly...
endprogram
This might be a bit close to what is done by some dynamic languages under the hood, but this is again far from elegant in the above form...
(*) I know it is often considered ugly to use CPP macros, but IMO it depends on how they are used; if they are restricted to limited extensions of Fortran syntax, I feel it is reasonable to use (because there is no metaprogramming facility in Fortran); on the other hand, defining program-dependent constants or branches should probably be avoided. Also, I guess it would be more powerful to use Python etc to make more flexible preprocessors (e.g., PreForM.py and fypp and so on), e.g., to allow a syntax like subroutine sub( val = -1 )
Here is an elegant (i.e., short, clear, standard-conforming) solution:
subroutine sub(val)
integer, optional :: val
write(*,'("aval is ", i0)') val_or_default(val, default=-1)
end subroutine
integer function val_or_default(val, default)
integer, optional, intent(in) :: val
integer, intent(in) :: default
if (present(val)) then ! False if `val` is is not present in `sub`.
val_or_default = val
else
val_or_default = default
endif
end function
This uses the fact that optional arguments can still be passed to a function, even when they are not present,
so long as the corresponding dummy argument is also optional.
There is at least one generic implementation of val_or_default on GitHub
for all intrinsic data types.
(They call it optval.)
I'm trying to write a routine that is able to convert a string into different kinds of data type, based on unlimited polymorphism. The idea is the user call this routine, passing the variable where it wants to store the data, and the routine to define the conversion based on the variable/argument type.
An excerpt of this routine is here:
subroutine GetAsScalar (this, value, status)
!Arguments-------------------------------------------------------------
class(TKeyword) :: this
class(*) :: value
logical, optional :: status
!Local-----------------------------------------------------------------
integer :: stat
!----------------------------------------------------------------------
stat = 0
select type (value)
type is (REAL(real32)) !single precision
read (this%fValue, *, IOSTAT = stat) value
type is (REAL(real64)) !double precision
read (this%fValue, *, IOSTAT = stat) value
type is (LOGICAL)
read (this%fValue, *, IOSTAT = stat) value
type is (INTEGER(int32)) !integer
read (this%fValue, *, IOSTAT = stat) value
type is (INTEGER(int64)) !long integer
read (this%fValue, *, IOSTAT = stat) value
type is (CHARACTER(*))
value = this%fValue
class default
this%Message = "Invalid data type"
status = .false.
return
end select
if (present (status)) then
if (stat /= 0) then
status = .false.
else
status = .true.
endif
endif
end subroutine GetAsScalar
"this%fValue" is a "character(len=:), allocatable" string.
When I try to use this routine passing an allocatable string, it exit with success, no error/exceptions raise:
character(len=:), allocatable :: value
call keyword%GetAsScalar(value)
But the string "value" is always empty.
Even inside the routine, after the assign "value = this%fValue", value is empty (len(value) is 0).
It seems that the compiler is unable to detected that the argument is of type character(len=:), allocatable, and so, is unable to assign the value to it.
Of course I have some alternatives, but the idea of being able to use a single rountine and without optional arguments for different kind of data is really nice.
I can use a user defined type that I create to handle strings, for example.
But I would like to know if this is the default behaviour in Fortran 2008.
And also, if there is a way to accomplish this, using this routine, with a single "class(*)" dummy argumment, to convert different types including the referred allocatable character. There is a way to force the allocation inside the routine, for example?
I'll appreciate your comments.
Cheers,
Eduardo
In a select type (or associate) construct, the associate name never has the allocatable attribute (16.5.1.6p2), regardless of whether the select has that attribute.
In your case, the selector is also lacking that attribute - the value dummy argument is not declared to be allocatable. You are not permitted to associate an unallocated actual argument with a non-optional non-allocatable dummy argument. Beyond that, you are not permitted to use an unallocated selector in a select type or associate construct.
You need to allocate the value actual argument to some length before the call, the value associate name will then have that fixed length inside the select type construct. Alternatively, wrap the allocatable character variable as a component in a derived type.
I can't tell what is wrong with this free form Fortran program. It does not correctly handle its command line arguments.
It works if I use a static array for the command line argument instead of an allocatable array.
Also, is this a good first Fortran program? Is this the type of problem for which Fortran would be useful? I already know C, C++, and a little bit of D.
module fibonacci
use ISO_FORTRAN_ENV
implicit none
contains
subroutine output_fibonacci(ordinal)
! Declare variables
integer, parameter :: LongInt = selected_int_kind (38)
integer, intent(in) :: ordinal
integer :: count
! integer (kind=LongInt) :: count, compare=2
integer (kind=LongInt), dimension(2,2) :: matrix, initial
matrix=reshape((/ 1, 1, 1, 0 /), shape(matrix))
initial=reshape((/ 1, 0, 0, 1 /), shape(initial))
count = ordinal
! Do actual computations
do while (count > 0)
! If the exponent is odd, then the output matrix
! should be multiplied by the current base
if (mod(count,2) == 1) then
initial = matmul(matrix, initial)
end if
! This is the squaring step
matrix = matmul(matrix, matrix)
count = count/2
end do
write (*,*) initial(1,2)
end subroutine output_fibonacci
end module fibonacci
program main
use, intrinsic :: ISO_FORTRAN_ENV
use fibonacci
implicit none
! The maximum allowed input to the program
integer :: max=200, i, size=20
character, allocatable :: argumen(:)
integer :: error, length, input
allocate(argumen(size))
! write(*,*) argcount
do i=1, command_argument_count()
call get_command_argument(i, argumen, length, error)
read(argumen,*,iostat=error) input
! write(*,*) argument
! write (*,*) input
if (error .ne. 0) then
write(ERROR_UNIT,'(I36.1,A)') input, "is not an integer"
stop (1)
else if (input > max) then
write(ERROR_UNIT,'(A,I36.1,A)') "Input ", input, " is too large"
stop (1)
end if
call output_fibonacci(input)
end do
end program
This line
character, allocatable :: argumen(:)
declares an allocatable array of characters. So the statement
allocate(argumen(size))
makes argumen an array of 20 single-character elements. That's not the usual way of dealing with strings in Fortran and argumen doesn't match (in type or rank) the requirements for the second argument in the call to get_command_argument.
Instead you should write
character(len=:), allocatable :: argumen
to declare argumen to be a character variable of allocatable length. In some contexts you can simply assign to such a variable, e.g.
argumen = 'this is the argument'
without having to previously allocate it explicitly.
With Intel Fortran v14 the call to get_command_argument compiles without warning but on execution the argument argumen isn't automatically allocated and it remains unassigned. I'm honestly not sure if this behaviour is standard-conforming or not. One approach would be to make two calls to get_command_argument, first to get the size of the argument, then to get the argument; like this
do i=1, command_argument_count()
call get_command_argument(i, length=length, status=error)
allocate(character(length)::argumen)
call get_command_argument(i, argumen, status=error)
! do stuff with argument
deallocate(argumen)
end do
Using the name length for the variable to be assigned the value returned by the optional argument called length is legal but a mite confusing. The deallocate statement ensures that argumen can be allocated again for the next argument.
I'll leave you the exercise of declaring, and using, an allocatable array of allocatable-length characters.
Disclaimer: the next two paragraphs contain material which some may find subjective. I will not be entering into any discussion about these parts of this answer.
Is this a good first Fortran program ? It's better than a lot of what I see here on SO. Personally I prefer the consistent use of the modern /= to .ne., < to .lt (etc), I don't use stop if I can avoid it (I usually can), and I'm sure I could find other nits to pick.
Is this the type of problem for which Fortran would be useful? Fortran is useful for all types of problem, though I admit it can be quite challenging using it to write a web server.