I defined a derived type as follows:
TYPE CLST_MEAN
REAL(8), ALLOCATABLE :: OMX(:,:), OMZ(:,:)
REAL(8), ALLOCATABLE :: U(:,:), W(:,:)
REAL(8), ALLOCATABLE :: YO(:,:), ZO(:,:)
REAL(8), ALLOCATABLE :: XU(:,:), ZU(:,:)
INTEGER :: NUM
END TYPE Clst_Mean
In the main code, I defined an array and input it in a subroutine as
TYPE(CLST_MEAN), ALLOCATABLE :: MEAN(:)
ALLOCATE(MEAN(NCL))
DO I = 1, NCL
ALLOCATE(MEAN(I)%OMX(NY,NZ))
ALLOCATE(MEAN(I)%OMZ(NY,NZ))
ALLOCATE(MEAN(I)%YO(NY,NZ))
ALLOCATE(MEAN(I)%ZO(NY,NZ))
ALLOCATE(MEAN(I)%U(NX,NZ))
ALLOCATE(MEAN(I)%W(NX,NZ))
ALLOCATE(MEAN(I)%XU(NX,NZ))
ALLOCATE(MEAN(I)%ZU(NX,NZ))
END DO
CALL K_MEAN(MEAN,SMP)
In the subroutine,
SUBROUTINE K_MEAN(CL_MEAN,SMP)
USE DATATYPE, ONLY : CLST_MEAN, SAMPLE
IMPLICIT NONE
TYPE(CLST_MEAN), DIMENSION(:), INTENT(OUT) :: CL_MEAN
....
write(*,*) size(cl_mean), SIZE(CL_MEAN(1)%OMX)
The output for size(cl_mean) is correct. But the output of size(cl_mean(1)%omx) is 1. That means that the compiler considers cl_mean(1)%omx is a variable not an array.
How can I access the array? Thank you.
I think using intent(out) causes the allocatable array in the derived datatype to be deallocated. Using intent(inout) fixed the problem for me using gfortran 4.7.
Related
I have an abstract type and several types which inherit from him. Now I need to make an array of instances of those inherited types, but I'm not sure, if it's even possible in Fortran.
I've tried to make some wrapper type, like in Creating heterogeneous arrays in Fortran.
module m
implicit none
type, abstract :: a
integer, public :: num
end type a
type, extends(a) :: b
end type b
type, extends(a) :: c
end type c
type :: container
class(*), allocatable :: ptr
end type
end module m
program mwe
use m
type(b) :: b_obj
class(*), allocatable :: a_arr(:)
b_obj = b(1)
allocate(container :: a_arr(3))
a_arr(1) = container(b_obj)
end program mwe
But I'm getting this error:
test3.f90:28:25:
a_arr(1) = container(b_obj)
1
Error: Can't convert TYPE(b) to CLASS(*) at (1)
What am I doing wrong? Or is there any other, correct way to do it?
Attempt 2
I edited the code accordingly to francescalus's answer:
program mwe
use m
type(b) :: b_obj
type(c) :: c_obj
type(container), allocatable :: a_arr(:)
integer :: i
b_obj = b(1)
c_obj = c(2)
allocate(container :: a_arr(3))
a_arr(1)%ptr = b(1)
a_arr(2)%ptr = c(3)
a_arr(3)%ptr = c(1000)
do i=1,3
write(*,*) a_arr(i)%ptr%num
end do
end program mwe
And I'm getting another error:
test3.f90:36:35:
write(*,*) a_arr(i)%ptr%num
1
Error: ‘num’ at (1) is not a member of the ‘__class__STAR_a’ structure
As IanH commented when outlining the approach you take, the then current version of gfortran
does not appear to support definition of an unlimited polymorphic component via a structure constructor
container(b_obj) is such a thing. So, leaving aside whether you are still coming up against this problem, one may be interested in still allowing older versions/other compilers to use the code.
An alternative approach is not to use a constructor for the element of your container. Instead the single component can feature directly in an assignment:
use m
type(container) a_arr(3) ! Not polymorphic...
a_arr%ptr = b(1) ! ... so it has component ptr in its declared type
end mwe
Naturally, we still have the component of the container type polymorphic so any attempts to reference/define/etc., that component will be subject to those various restrictions. In your question you have the component unlimited polymorphic, but I see that you first talk about restricting the container's consideration to elements which extend the first type. Rather than declaring the container component as unlimited polymorphic it could be much more helpfully of declared type a:
type :: container
class(a), allocatable :: ptr
end type
This would be sufficient to solve the problem with
do i=1,3
write(*,*) a_arr(i)%ptr%num
end do
because num is a component of the declared type of a_arr(i)%ptr (that is., a). In general, it isn't the complete solution because
do i=1,3
write(*,*) a_arr(i)%ptr%num_of_type_b
end do
wouldn't work (with num_of_type_b a component in the extending type). Here you have to use the usual tricks (defined input/output, dynamic resolution, select type and so on). Those are beyond the scope of this answer and many other questions may be found covering them.
I add the correction to resolve the following error,
test3.f90:36:35:
write(*,*) a_arr(i)%ptr%num
1
Error: ‘num’ at (1) is not a member of the ‘__class__STAR_a’ structure
The unlimited polymorphic variable cannot directly access any component of the dynamic data type. In this case, a simple solution is to avoid class(*). The definition of container is changed to
type :: container
class(a), allocatable :: ptr
end type
So the working code in summary is as follows,
module m
implicit none
type, abstract :: a
integer, public :: num
end type a
type, extends(a) :: b
end type b
type, extends(a) :: c
end type c
type :: container
class(a), allocatable :: ptr
end type
end module m
program mwe
use m
type(container), allocatable :: a_arr(:)
integer :: i
allocate(container :: a_arr(3))
a_arr(1)%ptr = b(1)
a_arr(2)%ptr = c(3)
a_arr(3)%ptr = c(1000)
do i=1,3
write(*,*) a_arr(i)%ptr%num
end do
end program mwe
I have an abstract class with my read/write methods for unformatted binary streams. I also have some classes inherited from the abstract one and some of them have additional components I'd also like to serialize.
So, I want the first set of methods to serve as a "default" behavior and the methods overriding it inside the inherited classes to be used just by those specific classes.
I've tried to implement it like this:
module m
implicit none
type, abstract :: a
integer, public :: num
contains
procedure :: write_a
procedure :: read_a
generic :: write(unformatted) => write_a
generic :: read(unformatted) => read_a
end type a
type, extends(a) :: b
integer, public :: num2
contains
procedure :: write_b
procedure :: read_b
generic :: write(unformatted) => write_b
generic :: read(unformatted) => read_b
end type b
type, extends(a) :: c
end type c
contains
subroutine write_a(this, unit, iostat, iomsg)
class(a), intent(in) :: this
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
write(unit, iostat=iostat, iomsg=iomsg) this%num
end subroutine write_a
subroutine read_a(this, unit, iostat, iomsg)
class(a), intent(inout) :: this
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
read(unit, iostat=iostat, iomsg=iomsg) this%num
end subroutine read_a
subroutine write_b(this, unit, iostat, iomsg)
class(b), intent(in) :: this
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
write(unit, iostat=iostat, iomsg=iomsg) this%num, this%num2
end subroutine write_b
subroutine read_b(this, unit, iostat, iomsg)
class(b), intent(inout) :: this
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
read(unit, iostat=iostat, iomsg=iomsg) this%num, this%num2
end subroutine read_b
end module m
program mwe
use m
implicit none
class(a), allocatable :: o1, o2, o3
o1 = b(1,2)
o2 = c(3)
open(123, file='test5.dat', form='unformatted')
write(123) o1
close(123)
allocate(b :: o3)
open(123, file='test5.dat', form='unformatted')
read(123) o3
close(123)
write(*,*) o3%num, o3%num2
end program mwe
But I'm getting following error:
test5.f90(29): error #8638: The type/rank signature for arguments of this specific subroutine is identical to another specific subroutine that shares the same defined I/O. [WRITE_A]
subroutine write_a(this, unit, iostat, iomsg)
---------------^
test5.f90(86): error #6460: This is not a field name that is defined in the encompassing structure. [NUM2]
write(*,*) o3%num, o3%num2
--------------------------^
To me it seems, like the write method in the class a can't be overriden. How can I implement it properly?
This isn't a problem entirely to do with defined input/output procedures, but generic bindings and type-bound procedures more widely.
Your type b has the type-bound procedures as though (through the extension) it were defined like
type b
integer, public :: num, num2
contains
procedure :: write_a, write_b
procedure :: read_a, read_b
generic :: write(unformatted) => write_a, write_b
generic :: read(unformatted) => read_a, read_n
end type
The bindings write_a and write_b are indeed ambiguous (as are read_a and read_b). [More detail on that elsewhere.]
You don't really need those write_a and read_a bindings, so they should instead be overridden:
type, abstract :: a
integer, public :: num
contains
procedure :: write => write_a
procedure :: read => read_a
generic :: write(unformatted) => write
generic :: read(unformatted) => read
end type a
type, extends(a) :: b
integer, public :: num2
contains
procedure :: write => write_b
procedure :: read => read_b
end type b
Here the write and read bindings of type b override those of type a. The generic binding of write(unformatted) and read(unformatted) retain the mapping to the (now overridden) bindings in b.
I need to implement a function, which will serialize (i.e. save to an unformatted binary file) a class containing an array of objects, which belong to the same abstract class, but which belong to several different inherited classes.
The point is, that this array is passed to my function and it's created by user's actions. So, I have no way of knowing about the specific types being stored in the array.
Is there any way to implement write and read I/O methods in a way, which would automatically write the array without having to specify types of its single elements?
I have written this code to illustrate my situation:
module m
implicit none
type :: container
class(a), allocatable :: item
end type container
type, abstract :: a
integer, public :: num
contains
procedure :: write_impl => write_a
procedure :: read_impl => read_a
generic :: write(unformatted) => write_impl
generic :: read(unformatted) => read_impl
end type a
type, extends(a) :: b
integer, public :: num2
contains
procedure :: write_impl => write_b
procedure :: read_impl => read_b
end type b
type, extends(a) :: c
end type c
contains
subroutine write_a(this, unit, iostat, iomsg)
class(a), intent(in) :: this
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
write(unit, iostat=iostat, iomsg=iomsg) this%num
end subroutine write_a
subroutine read_a(this, unit, iostat, iomsg)
class(a), intent(inout) :: this
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
read(unit, iostat=iostat, iomsg=iomsg) this%num
end subroutine read_a
subroutine write_b(this, unit, iostat, iomsg)
class(b), intent(in) :: this
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
write(unit, iostat=iostat, iomsg=iomsg) this%num, this%num2
end subroutine write_b
subroutine read_b(this, unit, iostat, iomsg)
class(b), intent(inout) :: this
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
read(unit, iostat=iostat, iomsg=iomsg) this%num, this%num2
end subroutine read_b
end module m
program mwe
use m
implicit none
class(a), allocatable :: o1, o2, o3
class(container), allocatable :: arr(:)
integer :: i
o1 = b(1,2)
o2 = c(3)
allocate(arr(2))
arr(1) = container(o1)
arr(2) = container(o2)
! How to serialize 'arr' without specifying its elements' types?
end program mwe
So, is there any way, how to serialize such an array without having to manually specify, that o1 is of type b and o2 is of type c?
I need to be able to serialize an array of the abstract type a in general and also read it from the binary file without previous knowledge about its elements.
I have a following class
type :: net_t
private
character(:), allocatable :: net_type !< Type of the net
integer(kind=integer_4neuro) :: num_of_neurons !< Number of neurons in the net
character(:), allocatable :: training_method !< Used training method
class(neuron_t), allocatable :: neuron_arr(:) !< Array containing all neurons
integer(kind=integer_4neuro), allocatable :: input_neuron_arr(:) !< Array of input neuron indices
integer(kind=integer_4neuro), allocatable :: output_neuron_arr(:) !< Array of output neuron indices
class(connection_t), allocatable :: connection_arr(:) !< Array of all connections
contains
!> Prints information about the network to the standard output.
procedure :: print_info => print_info_impl
!> Saves the network instance to the Fortran binary file
procedure :: save_net_bin => save_net_bin_impl
!> Implementation of write function enabling the storage of
!! allocatable arrays.
procedure :: write_sample => write_sample_impl
!> Implementation of read function enabling to read
!! the whole instance of net_t stored as binary file.
procedure :: read_sample => read_sample_impl
generic :: write(unformatted) => write_sample
generic :: read(unformatted) => read_sample
end type net_t
I need to implement my own write and read functions to be able to serialize instances of net_t because it contains allocatable arrays.
I tried to implement the write function like this:
subroutine write_sample_impl(this, unit, iostat, iomsg)
class(net_t), intent(in) :: this
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: i !< Counter
! Write a record giving sizes for the allocation
write(unit, iostat=iostat, iomsg=iomsg) SIZE(this%neuron_arr), &
SIZE(this%input_neuron_arr), &
SIZE(this%output_neuron_arr), &
SIZE(this%connection_arr)
write(unit, iostat=iostat, iomsg=iomsg) (this%neuron_arr(i)%get_id(), &
this%neuron_arr(i)%get_potential(), &
this%neuron_arr(i)%get_state(), &
i=1,SIZE(this%neuron_arr)), &
this%input_neuron_arr, &
this%output_neuron_arr, &
(this%connection_arr(i)%get_input_neuron(), &
this%connection_arr(i)%get_output_neuron(), &
this%connection_arr(i)%get_weight(), &
i=1,SIZE(this%connection_arr))
end subroutine write_sample_impl
But now, another problem arose - I'm getting following error:
(this%connection_arr(i)%get_input_neuron(), &
1
Error: Data transfer element at (1) cannot be polymorphic unless it is processed by a defined input/output procedure
this%connection_arr(i)%get_output_neuron(), &
1
Error: Data transfer element at (1) cannot be polymorphic unless it is processed by a defined input/output procedure
I see the problem is, that the class connection_t contains pointers to neurons, as we can see here:
!> Represents a connection between two neurons.
type, extends(abstract_base_t) :: connection_t
private
class(neuron_t), pointer :: input_neuron !< Pointer to an input neuron
class(neuron_t), pointer :: output_neuron !< Pointer to an output neuron
real(kind=real_4neuro) :: weight !< Weight of the connection
contains
! Implementation of methods
end type connection_t
Is it possible to serialize pointers in this way? I wanted to use neurons to prevent copying of neuron_t instances themselves.
I'm trying to do a matrix inversion in a FORTRAN code which is called in MATLAB. But when I run the code in debug mode it can call and compute "dgetrf" without any problem but then I get a segfault in "dgetri". Can anyone give me an insight about any possible reason for such an error?
Here is the gateway function for the test function I use:
#include "fintrf.h"
!
SUBROUTINE MEXFUNCTION(NLHS, PLHS, NRHS, PRHS)
use mexf90
implicit none
integer*8, intent(in) :: PRHS(*) ! Pointers carrying the input data
integer*8, intent(out) :: PLHS(*) ! Pointers carrying the output data
integer*4, intent(in) :: NLHS,NRHS ! REMAINS THE SAME FOR 64BIT system
!-----------------------------------------------------------------------
integer*8 :: err, nA, mA
integer*8, pointer :: matAR, AInvR
character(200) :: errMsg
integer*4 :: txt, classId
integer*4, external :: mexprintf
! THE PART BELOW SEPARATED WITH "!$$" IS FOR WINDOWS ONLY
! THIS RESETS THE FLOATING POINT EXCEPTION
! TO ALLOW DIVIDE BY ZERO,
! OVERFLOW AND INVALID
!$$
!#if defined MSWIND
! INTEGER(2) CONTROL
! CALL GETCONTROLFPQQ(CONTROL)
! CONTROL = CONTROL .OR. FPCW$ZERODIVIDE
! CONTROL = CONTROL .OR. FPCW$INVALID
! CONTROL = CONTROL .OR. FPCW$OVERFLOW
! CALL SETCONTROLFPQQ(CONTROL)
!#endif
!$$
! ERROR CHECKING FOR INPUT
IF (NRHS .NE. 1) THEN
CALL MEXERRMSGTXT('MultMexError: 1 INPUT ARGUMENT IS REQUIRED')
ENDIF
IF (NLHS .NE. 1) THEN
CALL MEXERRMSGTXT('MultMexError: 1 OUTPUT ARGUMENT IS REQUIRED')
ENDIF
! ASSIGN POINTERS TO THE VARIOUS PARAMETERS
! Input matrix
matAR =>MXGETPR(PRHS(1))
mA = MXGETM(PRHS(1))
nA = MXGETN(PRHS(1))
! Do something meaningful...
classId = mxClassIDFromClassName('double')
plhs(1) = mxCreateDoubleMatrix(mA,nA,0)
AInvR =>mxGetPr(plhs(1))
call invTest(matAR,mA,nA,AInvR)
! Send the result to the return argument
!(For an alternative way of sending the results to the return arguments - see referenceF90.f90)
END SUBROUTINE MEXFUNCTION
The test function where I do the matrix inversion is as follows:
subroutine invTest(matAR,mA,nA,AInvR)
use mexf90
implicit none
interface
function dinv(A) result(Ainv)
use mexf90
real*8, dimension(:,:), intent(in) :: A
real*8, dimension(size(A,1),size(A,2)) :: Ainv
end function dinv
end interface
integer*4, intent(in) :: mA, nA
real*8, intent(in) :: matAR(mA,nA)
real*8, intent(out) :: AInvR(mA,nA)
AInvR = dinv(matAR)
end subroutine invTest
and the subroutine which I found on the internet to do the matrix inversion is:
function dinv(A) result(Ainv)
use mexf90
real*8, dimension(:,:), intent(in) :: A
real*8, dimension(size(A,1),size(A,2)) :: Ainv
real*8, dimension(size(A,1)) :: work ! work array for LAPACK
integer, dimension(size(A,1)) :: ipiv ! pivot indices
integer :: n, info, ddd
! External procedures defined in LAPACK
external DGETRF
external DGETRI
! Store A in Ainv to prevent it from being overwritten by LAPACK
Ainv = A
n = size(A,1)
! DGETRF computes an LU factorization of a general M-by-N matrix A
! using partial pivoting with row interchanges.
call DGETRF(n, n, Ainv, n, ipiv, info)
if (info /= 0) then
CALL MEXERRMSGTXT('Matrix is numerically singular!')
end if
! DGETRI computes the inverse of a matrix using the LU factorization
! computed by DGETRF.
call DGETRI(n, Ainv, n, ipiv, work, n, info)
if (info /= 0) then
CALL MEXERRMSGTXT('Matrix inversion failed!')
end if
end function dinv
You've got a mismatch of types for nA and mA in your call to invTest. They should be integer*4 but you have them declared as integer*8 in MEXFUNCTION.
If they need to be integer*8 for the call to mxCreateDoubleMatrix then just make integer*4 copies or possibly try
call invTest(matAR,int(mA),int(nA),AInvR)