Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
28447 Discussions

Passing 1-D array of derived type variable to subroutine

Kevin_McGrattan
988 Views

This question probably has a yes or no answer. I want to know if it is possible in Fortran to write a short subroutine that will reallocate a 1-D array of a derived type variable. I can do this for a particular TYPE, but I want to create a general routine that reallocates any derived type array. But I do not know if it is possible to pass in the name of the derived type, like MY_TYPE in this example: 

TYPE MY_TYPE

   REAL :: A, B, C

   INTEGER :: I,J,K

END TYPE MY_TYPE

Labels (1)
0 Kudos
1 Solution
jimdempseyatthecove
Honored Contributor III
959 Views

Yes, but Fortran does not have templates. Additional coding needs to be done. This will mostly be cut and paste.

!  Console6.f90 
module type_defs
    TYPE MY_TYPE
       REAL :: A=0.0, B=0.0, C=0.0  ! default initialize
       INTEGER :: I=0,J=0,K=0       ! default initialize
    END TYPE MY_TYPE
    TYPE OTHER_TYPE
       REAL :: A=0.0, B=0.0, C=0.0  ! default initialize
       INTEGER :: I=0,J=0,K=0       ! default initialize
    END TYPE OTHER_TYPE
    interface realloc
        procedure :: realloc_MY_TYPE, realloc_OTHER_TYPE
    end interface
    
    contains
    ! each type procedure gets duplicated
    subroutine realloc_MY_TYPE(t,n)
        implicit none
        type(MY_TYPE), allocatable, intent(inout) :: t(:)
        integer :: n
        type(MY_TYPE), allocatable :: temp(:)
        allocate(temp(n))
        if(n >= size(t)) then
            temp(1:size(t)) = t
        else
            temp = t(1:n)
        endif
        call move_alloc(temp, t)
    end subroutine realloc_MY_TYPE
    subroutine realloc_OTHER_TYPE(t,n)
        implicit none
        type(OTHER_TYPE), allocatable, intent(inout) :: t(:)
        integer :: n
        type(OTHER_TYPE), allocatable :: temp(:)
        allocate(temp(n))
        if(n >= size(t)) then
            temp(1:size(t)) = t
        else
            temp = t(1:n)
        endif
        call move_alloc(temp, t)
    end subroutine realloc_OTHER_TYPE
    
end module type_defs
    
program Console6
    use type_defs
    implicit none
    type(MY_TYPE), allocatable :: array(:), arrayB(:)
    type(OTHER_TYPE), allocatable :: arrayOther(:), arrayOtherB(:)
    allocate(array(5), arrayB(10))
    allocate(arrayOther(6), arrayOtherB(11))
    print *,size(array),size(arrayOther)
    array = arrayB
    arrayOther = arrayOtherB
    print *, size(array),size(arrayOther)
    call realloc(array,30)      ! note using generic interface in main code
    call realloc(arrayOther,31)
    print *, size(array),size(arrayOther)
end program Console6

Note, you could use fpp to implement a quazi-template to generate the realloc_... functions.

 

Jim Dempsey

 

View solution in original post

0 Kudos
9 Replies
jimdempseyatthecove
Honored Contributor III
981 Views

Sure:

!  Console6.f90 
module type_defs
    TYPE MY_TYPE
       REAL :: A=0.0, B=0.0, C=0.0  ! default initialize
       INTEGER :: I=0,J=0,K=0       ! default initialize
    END TYPE MY_TYPE
    contains
    subroutine realloc_test(t)
        implicit none
        type(MY_TYPE), allocatable, intent(inout) :: t(:)
        type(MY_TYPE), allocatable :: temp(:)
        allocate(temp(size(t)*2))
        temp(1:size(t)) = t
        call move_alloc(temp, t)
    end subroutine realloc_test
    
    end module type_defs
    
program Console6
    use type_defs
    implicit none
    type(MY_TYPE), allocatable :: array(:), arrayB(:)
    allocate(array(5), arrayB(10))
    print *,size(array)
    array = arrayB ! using realloc left hand side
    print *, size(array)
    call realloc_test(array) ! using user defined procedure
    print *, size(array)
end program Console6

I omitted a user defined operator  for +,-,=,>,<,etc...

 

Jim Dempsey

0 Kudos
Kevin_McGrattan
977 Views

Yes, this is know I can do. But what if I had many derived type arrays throughout the code, and these derived types all have different definitions. That is, MY_TYPE is only one of many different derived types. Is is possible to write a single subroutine like realloc_test that will accept an array of any derived type variable?

0 Kudos
Steve_Lionel
Honored Contributor III
966 Views

What you're asking for is something that is likely to be addressed by the generics/templates feature being designed for "Fortran 202Y" (the revision after Fortran 2023). In today's Fortran, the type must be known. You can write a subroutine that accepts a CLASS(*) argument (unlimited polymorphic), but in the routine you would need to use SELECT TYPE to be able to allocate of a specific type. 

There may be other approaches one could take, such as:

mt_array = [mt_array,my_type(1.0,2.0,3.0,4.5.6)]

Assuming mt_array is an allocatable array of type(my_type), this would add an element at the end of the array, increasing the size by 1.

Perhaps if you explained the problem you're trying to solve, rather than asking about a particular feature, we could help better.

0 Kudos
Kevin_McGrattan
962 Views

Thanks. This is really just for code clean up. I have a routine like this

subroutine realloc_test(t)
        implicit none
        type(MY_TYPE), allocatable, intent(inout) :: t(:)
        type(MY_TYPE), allocatable :: temp(:)
        allocate(temp(size(t)*2))
        temp(1:size(t)) = t
        call move_alloc(temp, t)
end subroutine realloc_test

for each of many derived type arrays that I need to reallocate from time to time. I was looking for a way to write a single subroutine that could handle any array of derived type, much like I have one routine for real arrays, one for integer, etc. Maybe I am answering my own question because we already need to have separate routines for reals and integers, at least I think. 

 

 

 

 

 

0 Kudos
jimdempseyatthecove
Honored Contributor III
960 Views

Yes, but Fortran does not have templates. Additional coding needs to be done. This will mostly be cut and paste.

!  Console6.f90 
module type_defs
    TYPE MY_TYPE
       REAL :: A=0.0, B=0.0, C=0.0  ! default initialize
       INTEGER :: I=0,J=0,K=0       ! default initialize
    END TYPE MY_TYPE
    TYPE OTHER_TYPE
       REAL :: A=0.0, B=0.0, C=0.0  ! default initialize
       INTEGER :: I=0,J=0,K=0       ! default initialize
    END TYPE OTHER_TYPE
    interface realloc
        procedure :: realloc_MY_TYPE, realloc_OTHER_TYPE
    end interface
    
    contains
    ! each type procedure gets duplicated
    subroutine realloc_MY_TYPE(t,n)
        implicit none
        type(MY_TYPE), allocatable, intent(inout) :: t(:)
        integer :: n
        type(MY_TYPE), allocatable :: temp(:)
        allocate(temp(n))
        if(n >= size(t)) then
            temp(1:size(t)) = t
        else
            temp = t(1:n)
        endif
        call move_alloc(temp, t)
    end subroutine realloc_MY_TYPE
    subroutine realloc_OTHER_TYPE(t,n)
        implicit none
        type(OTHER_TYPE), allocatable, intent(inout) :: t(:)
        integer :: n
        type(OTHER_TYPE), allocatable :: temp(:)
        allocate(temp(n))
        if(n >= size(t)) then
            temp(1:size(t)) = t
        else
            temp = t(1:n)
        endif
        call move_alloc(temp, t)
    end subroutine realloc_OTHER_TYPE
    
end module type_defs
    
program Console6
    use type_defs
    implicit none
    type(MY_TYPE), allocatable :: array(:), arrayB(:)
    type(OTHER_TYPE), allocatable :: arrayOther(:), arrayOtherB(:)
    allocate(array(5), arrayB(10))
    allocate(arrayOther(6), arrayOtherB(11))
    print *,size(array),size(arrayOther)
    array = arrayB
    arrayOther = arrayOtherB
    print *, size(array),size(arrayOther)
    call realloc(array,30)      ! note using generic interface in main code
    call realloc(arrayOther,31)
    print *, size(array),size(arrayOther)
end program Console6

Note, you could use fpp to implement a quazi-template to generate the realloc_... functions.

 

Jim Dempsey

 

0 Kudos
Kevin_McGrattan
956 Views

Thanks guys, good to know that this is something in the works. It would be handy. Thanks for the advice.

0 Kudos
Kevin_McGrattan
904 Views

Thanks for the tip, but we try to avoid preprocessor directives because we often encounter problems using other compilers.. 

0 Kudos
Steve_Lionel
Honored Contributor III
959 Views

Note that you could define a generic interface, say, "realloc", with specific routines for integer and real types. Then you could just call "realloc" and the compiler would choose the correct specific.

I don't recommend my suggestion above of using CLASS(*), as that will have a LOT of overhead. I did just want to mention it.

0 Kudos
jimdempseyatthecove
Honored Contributor III
941 Views

Example using fpp

!  Console6.f90 
! compile wit -fpp enabled
! note this macro expands to single line
! use ; as statement terminator (in place of CRLF)
    
#define def_realloc(__TYPE__) \
    subroutine realloc_##__TYPE__(t,n); \
        implicit none; \
        type(__TYPE__), allocatable, intent(inout) :: t(:); \
        integer :: n; \
        type(__TYPE__), allocatable :: temp(:); \
        allocate(temp(n)); \
        if(n >= size(t)) then; \
            temp(1:size(t)) = t; \
        else; \
            temp = t(1:n); \
        endif; \
        call move_alloc(temp, t); \
    end subroutine realloc_##__TYPE__


    
module type_defs
    TYPE MY_TYPE
       REAL :: A=0.0, B=0.0, C=0.0  ! default initialize
       INTEGER :: I=0,J=0,K=0       ! default initialize
    END TYPE MY_TYPE
    TYPE OTHER_TYPE
       REAL :: A=0.0, B=0.0, C=0.0  ! default initialize
       INTEGER :: I=0,J=0,K=0       ! default initialize
    END TYPE OTHER_TYPE
    interface realloc
        procedure :: realloc_MY_TYPE, realloc_OTHER_TYPE
    end interface
    
    contains
    def_realloc(MY_TYPE)
    def_realloc(OTHER_TYPE)
    
end module type_defs
    
program Console6
    use type_defs
    implicit none
    type(MY_TYPE), allocatable :: array(:), arrayB(:)
    type(OTHER_TYPE), allocatable :: arrayOther(:), arrayOtherB(:)
    allocate(array(5), arrayB(10))
    allocate(arrayOther(6), arrayOtherB(11))
    print *,size(array),size(arrayOther)
    array = arrayB
    arrayOther = arrayOtherB
    print *, size(array),size(arrayOther)
    call realloc(array,30)
    call realloc(arrayOther,31)
    print *, size(array),size(arrayOther)
end program Console6

Jim Dempsey

0 Kudos
Reply