I am having trouble writing an allocatable array nested in a derived type using namelists. A minimal example is shown below. How can I modify the program to have the allocatable array inside the derived type work as though it were not nested?
program test
implicit none
type struct_foo
integer, allocatable :: nested_bar(:)
end type struct_foo
integer, allocatable :: bar(:)
type(struct_foo) :: foo
! namelist / list / foo, bar
namelist / list / bar
allocate(bar(5))
bar = [1:5]
allocate(foo%nested_bar(5))
foo%nested_bar=[1:5]
write(*,list)
end program test
With the foo commented out of the namelist, it works just fine, producing the output:
&LIST
BAR = 1, 2, 3, 4, 5
/
With foo included, the program fails to compile:
>> ifort -traceback test_1.f90 -o test && ./test
test_1.f90(20): error #5498: Allocatable or pointer derived-type fields require a user-defined I/O procedure.
write(*,list)
--------^
compilation aborted for test_1.f90 (code 1)
As the error message states, you need to provide a user defined derived type I/O (UDDTIO) procedure. This is required for input/output of any object with an allocatable or pointer component.
How the object of derived type is formatted in the file is completely under the control of the UDDTIO procedure.
An example, using a very simple output format, is below. Typically a UDDTIO procedure implementing namelist output would use an output format that was consistent with the other aspects of namelist output and typically there would also be a corresponding UDDTIO procedure that was then able to read the formatted results back in.
module foo_mod
implicit none
type struct_foo
integer, allocatable :: nested_bar(:)
contains
procedure, private :: write_formatted
generic :: write(formatted) => write_formatted
end type struct_foo
contains
subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
class(struct_foo), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: i
if (allocated(dtv%nested_bar)) then
write (unit, "(l1,i10,i10)", iostat=iostat, iomsg=iomsg) &
.true., &
lbound(dtv%nested_bar, 1), &
ubound(dtv%nested_bar, 1)
if (iostat /= 0) return
do i = 1, size(dtv%nested_bar)
write (unit, "(i10)", iostat=iostat, iomsg=iomsg) &
dtv%nested_bar(i)
if (iostat /= 0) return
end do
write (unit, "(/)", iostat=iostat, iomsg=iomsg)
else
write (unit, "(l1,/)", iostat=iostat, iomsg=iomsg) .false.
end if
end subroutine write_formatted
end module foo_mod
program test
use foo_mod
implicit none
integer, allocatable :: bar(:)
type(struct_foo) :: foo
namelist / list / foo, bar
allocate(bar(5))
bar = [1:5]
allocate(foo%nested_bar(5))
foo%nested_bar=[1:5]
write (*,list)
end program test
Use of UDDTIO obviously requires a compiler that implements this Fortran 2003 language feature.
Related
I have a julia program, which opens a fortran shared object library, writes to a global type(struct) array and then calls a function, which accesses this variable.
The problem is that the values entered in the julia struct do not correspond to the values extracted in the fortran code:
test.jl:
using Base.Libc.Libdl
using Base.Libc
mutable struct jul_param
f1::Float64
f2::Float64
testbool::Bool
end
try
# create jul_param struct array of size 2 and store pointer in ptr_jul_struct_array
testparam = jul_param(1.0, 2.0, true)
ptr_jul_struct_array = convert(Ptr{jul_param}, calloc(2, sizeof(jul_param)))
unsafe_store!(ptr_jul_struct_array,testparam,1)
unsafe_store!(ptr_jul_struct_array,testparam,2)
# fetch the memory address of global allocatable test_param type array in fortran
testmodule_bin = Libdl.dlopen("testmodule.so")
test_param_sym = Libdl.dlsym(testmodule_bin, Symbol("__testmodule_MOD_test_param"))
ptr_fortran_type_array = convert(Ptr{Ptr{jul_param}}, test_param_sym)
unsafe_store!(ptr_fortran_type_array, ptr_jul_struct_array)
# call test_func in fortran program
function_sym = Libdl.dlsym(testmodule_bin, Symbol("__testmodule_MOD_test_func"))
ccall(function_sym,Cvoid,())
catch e
println("Error: ", e)
rethrow(e)
end
testmodule.f90:
module testmodule
type :: JulParam
real :: &
f1, &
f2
logical :: &
testbool
end type JulParam
type(JulParam), allocatable, dimension(:) :: test_param
contains
module subroutine test_func()
print *, "test size", size(test_param) !returns 1 instead of 2
print *, "test val1", test_param(1)%f1 !returns random floats that change on every call instead of 1.0
end subroutine test_func
end module testmodule
I am using this command to run this program:
gfortran -fpic -c testmodule.f90 && gfortran -shared -o testmodule.so testmodule.o && julia test.jl
Is there a way to convert the memory layout of the julia struct so it can be read properly from within the fortran program?
You are defining allocatable variables: test_param and teststring, which are not allocated. For example, allocate(test_param(2)), to assign 2 members for test_param, see the code below. Note that variable, teststring, is not a string but rather an allocatable array of string (len=256). So, you need also to allocate it.
module testmodule
implicit none
type :: JulParam
real :: &
f1, &
f2
logical :: &
testbool
character(len=256), allocatable, dimension(:) :: &
teststring
! character(len=256) :: &
! teststring
end type JulParam
type(JulParam), allocatable, dimension(:) :: test_param
! type(JulParam) :: test_param
! private
! public :: test_func
contains
module subroutine test_func()
! real :: mat(10, 10)
! print *, mat
type(JulParam), allocatable, dimension(:) :: test_param
allocate(test_param(2))
allocate(character(len=256) :: test_param(1)%teststring(2))
! type(JulParam) :: test_param
print *, "test size", size(test_param) !returns 1 instead of 2
print *, "test val1", test_param(1)%f1 !returns random floats that change on every call instead of 1.0
print *, "test val2", test_param(1)%teststring !generates segmentation fault
end subroutine test_func
end module testmodule
After much digging I've cooked up a home brew scheme for what amounts to a list of variable length strings in Fortran. Its really an array of a custom type that only has one member property which is a variable length string. The syntax is a little cumbersome and I'm wondering if there is a better way that I have not been able to find.
Here is what I have:
! scratch.f90
module string_list
type t_string
character(len=:), allocatable :: s
end type
end module
program main
use string_list
implicit none
integer i
type(t_string), allocatable :: list(:)
allocate(list(2))
list(1)%s = "hi my name is"
list(2)%s = "slim shady"
do i=1,2
print *, len(list(i)%s)
end do
end program
compile with gfortran scratch.f90 -o scratch
then:
> ./scratch
13
10
Like the comments suggest, your approach might be a good start. To make the syntax easier you could make some type-bound operators and procedures, for example like:
module string_list
implicit none
type str
character(:), allocatable :: s
contains
procedure :: assa, get, length
generic :: assignment(=) => assa
generic :: operator(-) => get
generic :: l => length
end type
contains
subroutine assa(st,str1)
class(str), intent(out) :: st
character(*), intent(in) :: str1
st%s = str1
end
function get(st1) result(str1)
class(str), intent(in) :: st1
character(:), allocatable :: str1
str1 = st1%s
end
function length(st1) result(nn)
class(str), intent(in) :: st1
integer :: nn
nn = len(st1%s)
end
end
program test
use string_list, only: str
implicit none
type(str), dimension(:), allocatable :: stra
allocate(stra(2))
stra(1) = "hello "
stra(2) = "fortran"
print*, -stra(1)
print*, -stra(1)//-stra(2)
print*, stra(1)%l(), stra(2)%l()
print*, len(-stra(1)), len(-stra(2))
end
The result is
hello
hello fortran
6 7
6 7
This might not be the smartest design, I just tried something out of interest. Here I overloaded the - unitary operator to extract the actual string, and =for assignment, to avoid the %s syntax, and added a more convenient length-function.
I've wrote my first program using allocatable. It works as expected. But, does it really? And more importantly, how can I set up a unit-test to catch memory leaks?
The idea behind the program is to allocate a chunck of storage room for my list of objects in the first place. And every time I add one more element more to the list than the allocated size, I double the allocation. I do this to reduce the number of allocations and subsequent copying of data from the old allocated memory, to the newly allocated memory.
I might over complicate this, but I'd like to spend some time now understanding the pitfalls, rather than falling head first into them a year or two down into the project.
The ode is compiled with gfortran 8.3.0 on linux. And using pFUnit 4.1. The code below is an extract to test only the allocation part.
Heres my test-program:
program test_realloc
use class_test_malloc
integer :: i
real :: x, y
type(tmalloc) :: myobject
call myobject%initialize()
do i=1, 100
x = i * i
y = sqrt(x)
call myobject%add_nbcell(i, x, y)
end do
call myobject%dump()
end program test_realloc
array_reallocation.f:
!
! Simple test to see if my understanding of dynamicly allocation
! of arrays is correct.
!
module class_test_malloc
use testinglistobj
implicit none
type tmalloc
integer :: numnbcells, maxnbcells
type(listobj), allocatable :: nbcells(:)
contains
procedure, public :: initialize => init
procedure, public :: add_nbcell ! Might be private?
procedure, private :: expand_nbcells
procedure, public :: dump
end type tmalloc
contains
subroutine init(this)
class(tmalloc), intent(inout) :: this
this%numnbcells = 0
this%maxnbcells = 4
allocate (this%nbcells(this%maxnbcells))
end subroutine init
subroutine add_nbcell(this, idx, x, y)
class(tmalloc), intent(inout) :: this
integer, intent(in) :: idx
real, intent(in) :: x, y
type(listobj) :: nbcell
if(this%numnbcells .eq. this%maxnbcells) then
call this%expand_nbcells()
print *,"Expanding"
endif
this%numnbcells = this%numnbcells + 1
nbcell%idx = idx
nbcell%x = x
nbcell%y = y
this%nbcells(this%numnbcells) = nbcell
print *,"Adding"
end subroutine add_nbcell
subroutine expand_nbcells(this)
class(tmalloc), intent(inout) :: this
type(listobj), allocatable :: tmpnbcells(:)
integer :: size
size = this%maxnbcells *2
allocate (tmpnbcells(size))
tmpnbcells(1:this%maxnbcells) = this%nbcells
call move_alloc( from=tmpnbcells, to=this%nbcells)
this%maxnbcells = size
end subroutine
subroutine dump(this)
class(tmalloc), intent(inout) :: this
integer :: i
do i=1, this%numnbcells
print*, this%nbcells(i)%x, this%nbcells(i)%y
end do
end subroutine
end module
listobj.f:
module testinglistobj
type listobj
integer :: idx
real :: x
real :: y
end type
end module testinglistobj
You will not get any memory leaks with this code. The reason is, and this is fundamental to the understanding of allocatable arrays, is that in Fortran 95 onwards it is required that allocatable arrays without the save attribute automatically get deallocated when they go out of scope. The nett result of this is that memory leaks for such arrays are impossible. This is one very good reason why you should prefer allocatable arrays to pointers. Related is the general software engineering principle of keeping the scope of variables as limited as possible, so that arrays are in memory for as short a period as possible.
Note this does not mean that you should never deallocate them as an array may remain in scope long after it is actually useful. Here "manual" deallocation may be of use. But it is not a memory leak.
I want to implement the user-defined I/O procedures for the derived types in my Fortran code. However, write statements within those procedures cannot produce new lines between two sequential write statements. The derived type and procedures are defined as below.
The module:
module station_module
implicit none
character(8), parameter :: FmtFloat = '(5E15.7)'
type :: station
integer, private :: ns = 0
real, public, allocatable :: xloc(:), yloc(:), zloc(:)
contains
procedure, public :: import_station
procedure, public :: export_station
procedure, private :: read_station
generic, public :: read (formatted) => read_station
procedure, private :: write_station
generic, public :: write (formatted) => write_station
final :: destruct_station
end type station
interface station
module procedure new_station
end interface station
contains
function new_station(n) result(t)
implicit none
integer, intent(in) :: n
type(station) :: t
if (n > 0) then
allocate (t%zloc(n))
allocate (t%yloc(n))
allocate (t%xloc(n))
t%ns = n
end if
end function new_station
subroutine read_station(dtv, unit, iotype, vlist, iostat, iomsg)
implicit none
class(station), intent(inout) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, intent(in) :: vlist(:)
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
call dtv%import_station(unit)
iostat = 0
end subroutine read_station
subroutine import_station(this, unit)
implicit none
class(station), intent(inout) :: this
integer, intent(in) :: unit
character(256) :: header, footer
integer ns
read (unit, '(A)') header !> Header
read (unit, *) ns
if (ns > 0) then
if (allocated(this%zloc)) then
deallocate (this%zloc)
end if
allocate (this%zloc(ns))
read (unit, *) this%zloc
if (allocated(this%yloc)) then
deallocate (this%yloc)
end if
allocate (this%yloc(ns))
read (unit, *) this%yloc
if (allocated(this%xloc)) then
deallocate (this%xloc)
end if
allocate (this%xloc(ns))
read (unit, *) this%xloc
this%ns = ns
end if
read (unit, '(A)') footer !> Footer
end subroutine import_station
subroutine export_station(this, unit)
implicit none
class(station), intent(in) :: this
integer, intent(in) :: unit
write (unit, '(A)') ">STATION INFO"
write (unit, '(I6)') this%ns
write (unit, *) "Z:"
write (unit, FmtFloat) this%zloc
write (unit, *) "Y:"
write (unit, FmtFloat) this%yloc
write (unit, *) "X:"
write (unit, FmtFloat) this%xloc
write (unit, '(A)') ">END STATION"
end subroutine export_station
subroutine write_station(dtv, unit, iotype, vlist, iostat, iomsg)
implicit none
class(station), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, intent(in) :: vlist(:)
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
call dtv%export_station(unit)
iostat = 0
end subroutine write_station
subroutine destruct_station(this)
implicit none
type(station), intent(inout) :: this
if (allocated(this%xloc)) then
deallocate (this%xloc)
end if
if (allocated(this%yloc)) then
deallocate (this%yloc)
end if
if (allocated(this%zloc)) then
deallocate (this%zloc)
end if
this%ns = 0
end subroutine destruct_station
end module station_module
We can see that the user-defined formatted write statement just call a regular subroutine named export_station, by which I expect the same result in both ways.
Here is my test program:
program Test
use station_module
implicit none
type(station) :: pt, pt1, pt2
pt = station(4)
write(*, *) pt
call pt%export_station(6)
end program Test
The output:
>STATION INFO 4Z: 0.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00
Y: 0.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00X: 0.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00>END STATION
>STATION INFO
4
Z:
0.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00
Y:
0.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00
X:
0.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00
>END STATION
The regular subroutine export_station produces what I expect. New lines are produced between two write statements, while write statement of the derived type does not.
This was also asked on the Intel forum. I replied there."User-defined derived-type I/O is all non-advancing (and you can't change this). If you want newlines you have to write them explicitly (using a / format, for example.)"
There are two classes of output statements here: a parent and a child. The parent output statement in the first case is the write (*,*) pt.
When this first is the parent, then the call to export_station through write_station leads to the write statements there being child output statements. When export_station is called directly by the user those write statements are themselves parent output statements.
One significant difference between a child data transfer statement and a parent data transfer statement is that a parent statement positions the file prior to and after data transfer. That is, when the write (unit,*) "Z:" completes the file is positioned after the record just written only when the transfer statement is a parent.
Thus, you see the new lines: this is simply placing after the written record.
A child data transfer statement, not positioning the file on completion, does not effect a new line.
I don't have access to a test machine at the moment, so this part is speculative. You can explicitly write a new line character returned from new_line('') as part of your output for the child transfer statement. As advance='no' will be ignored in a child statement you could use that for both cases, explicitly controlling where new lines are written, rather than relying on the split record approach as currently exists.
I kept getting the warning message:
forrtl: warning (402): fort: (1): In call to I/O Read routine, an array temporary was created for argument #1
when I run the following codes. I had rummaged through old posts about the same issue on the forum (see here) but I was not quite sure the answer is applicable to my problem at hand. Could anyone help me get rid of this warning message? Thanks.
program main
implicit none
integer :: ndim, nrow, ncol
real, dimension(:,:), allocatable :: mat
ndim = 13
ncol = 1
allocate( mat(ncol,ndim))
call read_mat( mat, 'matrix.txt' )
contains
subroutine read_mat( mat, parafile)
implicit none
real, dimension(:,:), intent(out) :: mat
character(len=*), intent(in) :: parafile
character(len=500) :: par
character(len=80) :: fname1
integer :: n, m, pcnt, iostat
m = size(mat,dim=2)
n = size(mat,dim=1)
mat = 0.
open( unit= 10, file=parafile, status='old', action='read', iostat=iostat )
if( iostat==0 )then
pcnt = 1
write(fname1,'(a,i3,a)'),'(',m,'(f10.5))'
do
read( unit=10, fmt=*, iostat=iostat ) mat(pcnt,:)
pcnt = pcnt + 1
if( pcnt > n ) exit
enddo
else
print*, 'The file does not exist.'
endif
close( 10 )
end subroutine read_mat
end
It is the same underlying cause as in the linked question. The reference mat(pcnt,:) refers to array element storage that is not contiguous in memory, so to satisfy the compiler's internal requirements for the runtime code that actually does the read, it sets aside some storage that is contiguous, reads into that, then copies the elements out of that temporary storage into the final array.
Usually, in the context of a relatively slow IO statement, the overhead associated with the temporary is not significant.
The easiest way to prevent the warning is to disable the relevant runtime diagnostic with -check:noarg_temp_created or similar. But that is a bit of a sledgehammer — argument temporaries may be created that you do want to know about.
An alternative work around is to explicitly designate the elements to be read using an io-implied-do. Something like:
read (unit=10, fmt=*, iostat=iostat) (mat(pcnt,i),i=1,m)
with an appropriate declaration of i.