Working with parameterised derived type containing array of parameterised derived type

Could someone help get this working. It makes sense logically but I do not understand why it crashes.

I am also trying to avoid allocating each component individually and so I have used parameterised derived types - this is an abridged version.

Program foo
    implicit none
    
    type part(dim)
        integer, len :: dim
        real :: arr(dim)
    end type part
    
    type Prob
        integer :: dim
    end type Prob
    
    type Collection(n_parts, dim)
        integer, len        :: n_parts, dim
        type(part(dim))     :: parts
    end type Collection
    
    type(Prob) :: p
    type(Collection(2,2)) :: s

    p = Prob(2)
    s = create_collection(2,p)
    
    !print *, "s = ", s
contains

    function create_collection( n_parts, p ) result(pcoll)
        integer, intent(in)                      :: n_parts
        type(Prob), intent(in)  :: p
        type(Collection(n_parts, p%dim))          :: pcoll
    
        ! print *, pcoll
    end function create_collection
  
end Program foo

You should use intel fortran compiler ifort/ifx,gfortran is not good for parameterized derived type.

I suggest avoiding the use of len type parameter with PDTs for two reasons: The existing implementations are incomplete (but work is underway for complete ground-up development of PDTs in gfortran, 2) where complete (e.g., intel ifort/ifx), they are not the most efficient solution compared to allocatable. This used to be the case several years ago. It may have changed now. The brilliance of PDTs is in its kind-type-parameter, which is a compile-time constant, allowing the declation of generic types. The len type parameter would be extremely useful if it translated to static memory allocation.

Thanks @shamorandi.

This is such a shame as now I have to go the overly verbose route of having to allocate memory for each component of the types involved. I cannot use Intel ifort/ifx as I have an AMD system.

This is such a sad state of affairs for Fortran compilers in particular and Fortran in general given that this has existed since the 2003 standard (~20 years). Compare to C++ where compilers are already falling over themselves to implement C++23 and C++26.

@certik: More power to your LFortran project!!!

1 Like

@general_rishkin, Iā€™m not sure why think you canā€™t use ifort/ifx on an AMD system. Iā€™ve been doing it for years. Yes, Intel has some restrictions on the types of optimizations their compilers will do on non-Intel CPUs but in general those donā€™t restrict you from using their compilers. Just be careful about trying to use things like -mavx2 etc. Iā€™ve found you can get some weird results (sometimes). Basically if you stick with -O2 or -O3 and -xHost you will get code that runs as fast on AMD CPUs as they will on Intels chips. Re. PDTs, ifort and ifx are the only compilers that Iā€™ve used that actually work most of the time with PDTs. NVIDIAs compiler usually refuses to compile and generates an internal compiler error. However, ifort/ifx still arenā€™t perfect. I was trying to implement an automatic differentiation package using PDTs. A test problem I was using returned a PDT as a function result. At first I was using this interface where nd is a len parameter used to set an array size

function gfun(x)

 implicit none

 type(ad_t(*)),    dimension(3), intent(in) :: x
 type(ad_t(x%nd),   dimension(3)              :: gfun

gfun(1) = x*x + ....
gfun(2) = x*sin(x) + ... 
etc

This would not work with any compiler until I used a local instance of ad_t (gt) to recieve the assignment results and then loaded gfun with the components of gt

After playing around some more, I found that specifying gfun as a deferred len and allocating it prior to the assignments works with ifort/ifx ie

function gfun(x)

 implicit none

 type(ad_t(*)),    dimension(3), intent(in) :: x
 type(ad_t(:)),    allocatable                      :: gfun(:)

 allocate(ad_t(x%nd) :: gfun(3))
gfun(1) = ....
gfun(2) = ....
etc

I agree that PDTs are a feature that on the surface could be extremely useful for a lot of programming problems. Unfortunately, its going down the road of FORALL as being either to hard to implement or the compiler developers just donā€™t want to spend the time and resources required to make it work.

Maybe you could consider advocating for PDTs further development here Application to the Sovereign Tech Fund - #5 by hkvzjal. With enough traction it could be included in that roadmap and something more than a ā€˜thank youā€™ could be there for whomever takes on the task :slight_smile: ā€¦ just a wild idea

@kargl: If you read carefully, you will note that nowhere did @rwmsu or I refer to gfortran. The sentiments are made with regards to Fortran compilers in general and how slow it takes to implement features from the standard.

It is because I would like to use the compiler for production that I do not use ifort/ifx. However, based on your experience, I will give it a try. Thanks for the PDT tips.

At this point, I think it is better to just wait for LFortran. No pressure, @certik.

@certik, at this stage, would you have a (rough) estimate of when LFortran can support all of Fortran 2023 standard revision which of course includes PDTs? Thank you,

I will be able to answer this reasonably accurately once we compile and run fpm. Right now we can compile all of fpm to ASR (our intermediate representation) and all ASR->ASR passes run. We are now working hard on ASR->LLVM lowering, implementing all the missing features. You can follow our progress at Pull requests Ā· lfortran/lfortran Ā· GitHub, as you can see, we have a steady stream of PRs. I am hoping we get fpm working in about a month or two, itā€™s hard to tell until we do it. Generally with these things to give an accurate time estimate is as much work as just doing the work itself. Both modern and legacy Minpack fully compile and all examples run.

My goal is to start compiling most codes like fpm, stdlib, etc., this year. Full 100% compliance with F23 might take a bit longer.

As always, if there is anybody here who wants to help, please get in touch! We have some funding and a team. The more people help, the faster we can get there.

3 Likes

Only someone whose entire sense of self-worth apparently revolves around their contributions to an open source compiler that I personally rarely use because it seldom compiles my codes without some compiler induced error would interpolate a general statement about ALL Fortran compilers as directed at gfortran and I guess for some reason known only to your ego as a personal assault on you. Maybe its time you put your ego in check and realise that not everything posted on this site that complains about the current state of Fortran is about you and/or gfortran.

Another potential advantage of PDTs is that you can use them in i/o statements, where you cannot do the same thing with allocatable components. Here is a short example of what I mean.

program pdt
   implicit none
   integer, parameter :: lenap = 2
   type data_static_t
      real :: a(lenap)
   end type data_static_t
   type data_alloc_t
      real, allocatable :: a(:)
   end type data_alloc_t
   type data_pdt_t(lena)
      integer, len :: lena
      real :: a(lena)
   end type data_pdt_t
   integer :: lena, lenx, i
   type(data_static_t), allocatable :: x(:)
   type(data_alloc_t), allocatable  :: y(:)
   type(data_pdt_t(:)), allocatable :: z(:)
   character(*), parameter :: fmta = '(*(f6.3))'

   lena = lenap
   lenx = 3

   write(*,*) 'lena=', lena, ' lenx=', lenx
   allocate( x(lenx) )
   allocate( y(lenx) )
   allocate( data_pdt_t(lena) :: z(lenx) )

   do i = 1, lenx
      call random_number( x(i)%a )
      y(i)%a = x(i)%a   ! allocate and assign.
      z(i)%a = x(i)%a
   enddo

   write(*,fmta) x
   write(*,fmta) (y(i)%a, i=1,lenx)
   write(*,fmta) z
end program pdt

$ nagfor pdt.F90 && a.out
NAG Fortran Compiler Release 7.1(Hanzomon) Build 7114
[NAG Fortran Compiler normal termination]
 lena= 2  lenx= 3
 0.138 0.807 0.928 0.384 0.540 0.950
 0.138 0.807 0.928 0.384 0.540 0.950
 0.138 0.807 0.928 0.384 0.540 0.950

There are three derived types, one with static component size, one with allocatable size, and one with parameterized size. With the static and parameterized sizes, you can just put the array in an i/o statement. I used formatted i/o in this example, but the most useful case is when you write and read unformatted i/o, for example to write out checkpoint data, or to transfer data from one run to the next.

However, the straightforward write(*,fmta) y does not work, the programmer must specify the components explicitly. I have long wondered why that limitation was placed on allocatable components in the language, but for whatever reasons, it is there. Imagine the complicated write statements that are required when you have several levels of nesting in the derived type, each with allocatable components.

The write(*,fmta) z is nice because it allows the simple write statement, while also allowing runtime specification of the length of the components. There is no need to bash gfortran any more over this (Iā€™m grateful gfortran does what it can do), but I used nagfor in the example because gfortran does not run this code. Of course, the allocatable version allows each array member to have different lengths, something that Iā€™m not doing here, so in that sense the three versions have some common overlaps in applicability, but they are not all exactly equivalent.

Both ifort and NAG have working implementations of PDT. A couple of weeks ago I dug up an old F90 PDE solver code from the late 90ā€™s that used an ā€œarray-of-structā€ type of data structure, similar to the OPā€™s example, pervasively throughout the code. Out of curiosity I modified it to be a PDT with length type parameter like the OP wants to do. (My experience has been that a ā€œstruct-of-arraysā€ data organization generally performs better than an ā€œarray-of-structā€ organization, so this was just for fun.)

It worked just fine with the ifort compiler. However it was much, much slower ā€“ something like 8x slower. I have no clue why. But I recalled an email exchange I had with a NAG compiler developer many years ago, who strongly discouraged me from using length type parameters because of something intrinsic to them would necessarily make them relatively slow. I donā€™t recall the details now. If a compiler developer reading this could shed some light on this, that would be great.

I suppose kind type parameters can be somewhat useful if you donā€™t have type bound procedures (I almost always do). But if you do, you still have to write versions of the procedures for every kind you foresee using. Youā€™d think that this could work like templating (only the kind is being varied, not the type), but no dice.

All in all, I find PDT to be a mostly unhelpful addition to the standard. This is a case where having an actual prototype implementation in some compiler would have been very helpful sanity check before adding it to the standard.

4 Likes

@nncarlson, once we get to implementing PDT, Iā€™ll let you know. I am hoping they can be implemented just like ā€œtemplate instantiationā€, so there shouldnā€™t be any overhead. Maybe there is some catch that I donā€™t see currently.

I have also been wondering the same thing, because it is too tedious to define custom I/O routines even for very simple derived types (with allocatable components). I also cannot use them in namelist input, so I need to prepare separate derived types that do not have any allocatables.

As for the slow speed of PDT, I wonder if it might be implemented with heap allocation (in the compiler)ā€¦?

Exactly this! I view PDTs as a half-baked generics feature that isnt good for much and is best forgotten (it should be removed from the standard). Better to concentrate on the real generics feature that is hopefully coming (and that hopefully we can use before 2040).

1 Like

If the arrays are allocated, then it is alright to use them in both read and write. The problem is when a component is unallocated on write, or unallocated when it is specified in the namelist read.

I think the standard could be extended in a consistent way to allow something like allocate-on-read for both namelist and list-directed i/o. I think this could be done in a backwards compatible way so that old code behaves the same as before. This has the potential to be both more efficient and easier to use than the current conventions.

If it is allocated at run time, then it is probably heap. However, there isnā€™t any reason why that would make things slow. Maybe there are too many levels of indirection of addresses to access the components?

I disagree entirely with, ā€œPDTs ā€¦ should be removed from the standard.ā€

I really worry about the direction the work on 202Y Generics is taking, itā€™s too complicated already.

In the context of actual use of Generics in applications where computations generally and where floating-point computations are paramount as is usually the case with Fortran applications, the use cases can really be simplified to two:

  1. Generic algorithms,
  2. Generic containers

The work thus far on ā€œtemplatesā€ is focused on the first for which the language already offers certain capabilities but the new effort inadequately builds on it but with complications while deferring a lot of aspects of the latter use case with containers for ā€œlaterā€ development.

Whereas I truly believe PDTs already include a decent starting point for containers that the Fortran 202Y work on Generics must use, but itā€™s being overlooked. I tried a bit to influence the subgroup but failed entirely including with attempts to sound PDTs a la A FL A C, and eventually benched myself as there was only room for one or two cooks in the kitchen and there were already several.

However, maybe someday, someone will ā€œget itā€ that enhanced PDTs are the route to the needed generic containers in Fortran but until then it will be useful to keep an open mind on the 2003 feature.