- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The following program triggers a compilation error with the latest OneAPI ifort compiler (2021.5.0).
PROGRAM P
IMPLICIT NONE
INTEGER, ALLOCATABLE :: X(:)
REAL, ALLOCATABLE :: Y(:)
ALLOCATE(X, MOLD = Y)
END PROGRAM P
The compiler error is:
error #8155: In an ALLOCATE statement the source expression in SOURCE= or MOLD= specifiers must be of the same type and kind type parameters as the object being allocated. [Y]
I understand the restriction when SOURCE= is used, but I am not sure this restriction is necessary for MOLD=. What am I missing here?
There is a somewhat similar issue with this other example:
PROGRAM P
IMPLICIT NONE
TYPE :: T
END TYPE T
CLASS(T), ALLOCATABLE :: X(:)
REAL, ALLOCATABLE :: Y(:)
ALLOCATE(T :: X, MOLD = Y)
END PROGRAM P
The compiler error is:
error #8157: If source expression in SOURCE= or MOLD= specifiers in an ALLOCATE statement, a TYPE specification must not appear for the object being allocated.
Again, this restriction sounds superfluous.
In both examples the type of X is known in advance. In order to allocate X the only knowledge required is the shape of the MOLD argument Y.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I did some more careful reading of the 202X draft. In 202X you will be able to do this:
PROGRAM P
IMPLICIT NONE
INTEGER, ALLOCATABLE :: X(:)
REAL, ALLOCATABLE :: Y(:)
...
ALLOCATE(X(lbound(y):ubound(y)))
END PROGRAM P
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The standard sez:
R927 allocate-stmt is ALLOCATE ( [ type-spec :: ] allocation-list [ , alloc-opt-list ] )
R928 alloc-opt is ERRMSG = errmsg-variable
or MOLD = source-expr
or SOURCE = source-expr
or STAT = stat-variable
C945 (R927) Each allocate-object shall be type compatible (7.3.2.3) with source-expr.
The MOLD source-expr must be type-compatible with the allocate-object. INTEGER is not type-compatible with REAL.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thanks Steve. I wish the ALLOCATE intrinsic were capable to handle those two cases:
1. If the allocate-object and MOLD source-expr are type compatible, then the allocate-object is allocated to the type and bounds (if it is an array) of source-expr (the current behavior).
2. If the allocate-object has a type known at compile time; or if it has a dynamic type and type-spec:: is present, then the allocate-object is allocated to the bounds of source expr.
Case 2. would help 'apply' the bounds of an allocatable array to another, no matter what the type-compatibility between the two is.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
PROGRAM P
IMPLICIT NONE
INTEGER, ALLOCATABLE :: X(:)
REAL, ALLOCATABLE :: Y(:)
...
ALLOCATE(Y(-12:34))
ALLOCATE(X(LBOUND(Y):UBOUND(Y)) ! requires Y be allocated
END PROGRAM P
In place of MOULD use bounds.
Jim Dempsey
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thanks Jim - yes, that is a solution obviously (with one small correction: you need the DIM argument in LBOUND and UBOUND). For arrays of rank greater than 1 this would look like:
ALLOCATE(X(LBOUND(Y, DIM=1):UBOUND(Y, DIM=1), LBOUND(Y, DIM=2):UBOUND(Y, DIM=2), etc.))
But this is not as clean as something that would look like this:
ALLOCATE(X, MOLD = Y)
I tried to create a procedure to get around this with the following interface:
SUBROUTINE MOLD(X, Y)
IMPLICIT NONE
INTEGER, ALLOCATABLE, INTENT(INOUT) :: X(..)
CLASS(*), ALLOCATABLE, INTENT(IN) :: Y(..)
! retrieve the bounds of Y, then use SELECT RANK to allocate X
! for each rank scenario.
END SUBROUTINE MOLD
But then it fails due to the restriction that the actual argument Y needs to be unlimited polymorphic, which really defeats the flexibility and purpose of the whole thing. Again, I suspect that this restriction is not necessary when INTENT(IN) is used for Y (I understand why it is necessary in other cases), but I could be wrong.
So, the whole thing is not a big deal - it's just a bit frustrating some convenient syntax/features are 'almost within reach' but not available.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Fortran 202X introduces a BOUNDS attribute where you can say something like BOUNDS(SHAPE(X)) in a type declaration statement, but at present it can't be used in ALLOCATE. It seems to me that the better solution is to not require MOLD= to be type-compatible. This would require defining a new term, such as mold-expr, and saying that if mold-expr appears, the bounds are taken from it and not source-expr. (The standard prohibits specifying both SOURCE= and MOLD=, so that should be relaxed. I will suggest this for a future revision "202Y" - it is too late for 202X.
But I think you COULD do something like the following in 202X, albeit clunkily:
integer, allocatable :: x(:)
real, allocatable :: y(:)
allocate (y(3))
block
real, bounds(shape(y)) :: z
allocate (x, mold=z)
end block
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I did some more careful reading of the 202X draft. In 202X you will be able to do this:
PROGRAM P
IMPLICIT NONE
INTEGER, ALLOCATABLE :: X(:)
REAL, ALLOCATABLE :: Y(:)
...
ALLOCATE(X(lbound(y):ubound(y)))
END PROGRAM P
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thanks Steve for your answers - always appreciated.
For this last example you provided ... will it work when X (and Y) have a rank greater than 1?
I think your suggestion to relax the constraint on MOLD= was excellent by the way.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Yes, it will work for any rank. I had not remembered this being added and noticed it when studying the Committee Draft (22-007). With this, the change in MOLD is not needed. In fact, it works better than my suggested change as this allows you to have lower bounds other than 1. See https://j3-fortran.org/doc/year/20/20-120r1.txt
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I am not sure I understand your comment regarding the bounds being other than 1. I can use MOLD to 'transfer' non-unit bounds from Y to X. See below:
PROGRAM P
IMPLICIT NONE
INTEGER, ALLOCATABLE :: X(:, :), Y(:, :)
ALLOCATE(Y(0: 3, -1: 5))
ALLOCATE(X, MOLD = Y)
WRITE(*, *) LBOUND(X)
DEALLOCATE(X)
ALLOCATE(X, MOLD = Y(:, :))
WRITE(*, *) LBOUND(X)
END PROGRAM P
Output:
0 -1
1 1
Press any key to continue . . .
Which is what I expect (and rely on extensively in my codes).
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I suppose that would work, but the F202X feature is more flexible, and at this point revising MOLD does not add any capabilities.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thanks Steve - I read the proposal and the F202X enhancement proposed is very useful and would be applicable here. I suppose that this is also what @jimdempseyatthecove had in mind with his post!

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page