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

Equivalent of equivalence

Simon_Geard
New Contributor I
3,900 Views

Having moved from fixed arrays that were equivalenced to dynamic arrays I'd like to reinstate an equivalent to the old equivalence.

[fortran]

program main
    use iso_c_binding
    implicit none
    real(4)    :: ra(0:11,3)
    integer(4) :: ia(0:11,3)
    common /x/ ra
    equivalence(ra(0,1),ia(0,1))
    
    real(4), allocatable :: wra(:,:)
    integer(4), pointer  :: wia_ptr(:,:)
    
    ra = 0.0
    ra(0,1) = transfer(1,0.0)
    write(*,'(a,i0)') 'ia(0,1) = ',ia(0,1)
    
    allocate(wra(0:11,3), source=0.0)
    call c_f_pointer(c_loc(wra), wia_ptr, [12,3])
    
    wra(0,1) = transfer(1,0.0)
    write(*,'(a,i0)') 'wia_ptr(1,1) = ',wia_ptr(1,1)
    
end program main

 

[/fortran]

In order for my application to work I need wia_ptr(0,1) to be valid and == wra(0,1) but I can't work out the syntax. Is it possible using this method or is there another method that I should be using?

Thanks.

 

 

0 Kudos
22 Replies
JVanB
Valued Contributor II
3,435 Views

The pointer assignment statement now allows a bounds-spec-list or bounds-remapping-list.  That should fix your problem.  There is also the issue of nonconformance, but that problem was already there for EQUIVALENCE.

 

0 Kudos
Simon_Geard
New Contributor I
3,435 Views

Thanks for that. I've now added another pointer with bounds mapping:

[fortran]

wia_mptr(0:,1:) => wia_ptr

[/fortran]

and it now behaves as I need.

0 Kudos
Simon_Geard
New Contributor I
3,435 Views

As a matter of interest what is the non-conformance issue?

0 Kudos
JVanB
Valued Contributor II
3,435 Views

For nonconformance, see section 15.2.3.3 of f2008 about the C_F_POINTER subroutine. Line 33 sort of flies in the face of the restrictions stated there. In general the compiler can't catch aliasing violations like this but it has to assume that targets of different types can be aliased if it is not to make an unrecognizable jumble of your code. I'm a bit surprised that ifort didn't reject your code at line 33 because wra doesn't have the TARGET attribute. Try /stand to see if that catches it. I thought there was supposed to be some sort of restriction about writing an equivalence set through one type and reading it through another but I'm not familiar enough with EQUIVALENCE to find an answer in the standard.

0 Kudos
Simon_Geard
New Contributor I
3,435 Views

I tried with /stand /warn:all but the compiler (versions 15.0.2.179 and 14.0.1.139) did not detect the lack of the target attribute:

C:\ShipRight\simon>ifort eqq.f90  /stand /warn:all
Intel(R) Visual Fortran Intel(R) 64 Compiler XE for applications running on Intel(R) 64, Version 15.0.2.179 Build 20150121
Copyright (C) 1985-2015 Intel Corporation.  All rights reserved.

eqq.f90(2): warning #5112: Extension to FORTRAN-90: tab formatting
        use iso_c_binding
^
Microsoft (R) Incremental Linker Version 10.00.40219.01
Copyright (C) Microsoft Corporation.  All rights reserved.

-out:eqq.exe
-subsystem:console
eqq.obj

C:\ShipRight\simon>eqq
ia(0,1) = 1
wia_mptr(0,1) = 1
wia_mptr(0,1) = 2

The use of equivalence to have arrays of mixed type was standard practice in all the CAD systems I've worked on (since 1985) so the ability to update the code to use dynamic arrays and still maintain the equivalence functionality is a good thing. That code also mixes sizes so that an integer(4) array is equivalenced to a real(8) array of half the size and is used in a paging subsystem. All that is needed now is for the standard to be adjusted so that the above code (or some variant) is conforming. gfortran also compiles and runs this program as expected.

0 Kudos
Steven_L_Intel1
Employee
3,435 Views

We don't do any sort of standards checking on uses of procedures in intrinsic modules. This may come in the future. The restriction in this case is not a constraint so we aren't required to check it. (I'll also note that many of the restrictions F2008 has for procedures in ISO_C_BINDING go away in F2015, though not this one.)

0 Kudos
FortranFan
Honored Contributor III
3,435 Views

sgeard@cad-schroer.co.uk wrote:

... All that is needed now is for the standard to be adjusted so that the above code (or some variant) is conforming. ,,

Why does the standard need to be adjusted?

By the way, what's the real purpose of the existing EQUIVALENCE statement in the code?  Other than perhaps due to legacy code developed during the time when storage space was premium but which is no longer the case.  And why try to do pointer operations that mimic EQUIVALENCE?  As both can result in confusion with one storage area being used with variables of two or more types and especially as code gets handed over from one generation to next.

So is it storage mapping to save space of interest or is it mapping of one data type to another for whatever reason.  If the former, shouldn't the direct use of pointers suffice (i.e., no need for C_F_POINTER)?  Assuming it is the latter, as you show in line 37 of your code, one can do a TRANSFER function to "map" an integer type to a real.  Your example code suggests the "source" data is of type integer, per line 37.  So why can't all the "data" be stored in integer arrays and when variables of real type based on those "data" are needed, invoke the TRANSFER function?

program p

   use, intrinsic :: iso_fortran_env, only : i4 => int32, r4 => real32

   implicit none

   integer(i4), allocatable :: i(:,:)
   real(r4), allocatable :: r(:,:)
   integer(i4) :: j
   integer(i4) :: istat

   allocate(i(0:11,3), stat=istat)
   if (istat /= 0) then
      print *, " allocation of i failed."
      stop
   end if
   do j= lbound(i,dim=1), ubound(i,dim=1)
      i(j,:) = j
   end do

   allocate(r, mold=real(i, kind=r4), stat=istat)
   if (istat /= 0) then
      print *, " allocation of r failed."
      stop
   end if

   do j= lbound(r,dim=1), ubound(r,dim=1)
      r(j,:) = transfer(i(j,:), mold=r(j,:))
   end do

   write(*,'(a,i0)') 'r(0,1) =     ', r(0,1)
   write(*,'(a,i0)') 'i(0,1) =     ', i(0,1)

   write(*,'(a,i0)') 'r(11,3) =     ', r(11,3)
   write(*,'(a,i0)') 'i(11,3) =     ', i(11,3)

   stop

end program p

 

r(0,1) =     0
i(0,1) =     0
r(11,3) =     11
i(11,3) =     11
Press any key to continue . . .

 

0 Kudos
Simon_Geard
New Contributor I
3,435 Views

When the code was written available memory was limited and so this type of overlay was common. As time moved on the amount of memory available grew so that it was no longer necessary to use that paradigm but the code had already been written and could not easily be changed.  Time has moved on again and now we can use dynamically allocated arrays which allow us to handle much larger models than were possible with static arrays. The existing code has the overlayed arrays built in and still cannot easily be changed so the safest thing to do is emulate the equivalence mechanism.

I don't see what is wrong with doing this, sure you could make mistakes but the functionality is very useful. For example a row in a database could easily be a mixture of integer and real so writing a single array to a file (unformatted) is very clear and simple. I've constructed a simple example below which I hope illustrates my point:

[fortran]

program db
    use iso_c_binding
    implicit none
    integer(4), allocatable, target :: ia(:), ia2(:)
    real(4), pointer                :: ra(:), ra2(:)
    integer                         :: i, u
    
    allocate(ia(5), source=0)
    call c_f_pointer(c_loc(ia), ra, [5])
    do i=1,5
        if (mod(i,2) == 0) then
            ia(i) = 2*i
        else
            ra(i) = 7.0*i-10
        end if
    end do
    open(file='example.db',newunit=u,access='direct',form='unformatted',recl=20)
    
    call write_row(1,ia)

    allocate(ia2,mold=ia)
    call c_f_pointer(c_loc(ia2), ra2, [5])    
    call read_row(1,ia2)
    do i=1,5
        if (mod(i,2) == 0) then
            write(*,'(i0)') ia2(i)
        else
            write(*,'(f0.3)') ra2(i)
        end if
    end do
    
    close(u)
    
    contains
        subroutine write_row(row, data)
            integer, intent(in) :: row
            integer, intent(in) :: data(:)
            write(u,rec=row) data
        end subroutine write_row
        
        subroutine read_row(row, data)
            integer, intent(in)  :: row
            integer, intent(out) :: data(:)
            read(u,rec=row) data
        end subroutine read_row

    end program db

[/fortran]

When I started looking (in 2013) at the changes necessary to the code my first thought was to use the transfer intrinsic. However experience has shown that the performance hit is far too large to make it usable in production code. It also creates a copy of the array so that the amount of memory used is 2*n rather than n. Perhaps that is just Intel's implementation but I think it is a limitation of the function itself. If you look around the net you'll see others who advocate the type of approach I've used, http://www.fortran90.org/src/best-practices.html for example.

From my point of view the standard should be adjusted so that the above code is conforming or a different method (transfer_ptr ?) should be provided so that the equivalent functionality can be achieved.

At the risk of generalizing I would say that the standards committee do not have much experience of CAD code. If they did then this type of functionality would have been included when equivalence was deprecated and the alternate return mechanism would have been maintained or superceeded with a different error handling mechanism.

0 Kudos
FortranFan
Honored Contributor III
3,435 Views

From what I understand, the standard bearers have deprecated the use of EQUIVALENCE, but EQUIVALENCE is not yet obsolescent, correct?  Plus compiler vendors, especially Intel, do a super job of continuing to support older features in the language.  So there is no practical risk and CAD community can continue to use existing code without any reasonable worries.  The questions, which are totally under the CAD community's control which is a great thing, are about if there is ever a need to modernize the code and if yes, when.

Should the CAD community ever decide to do update their code base, as you know very well, there are so many high-performance code design patterns possible with "modern Fortran" for the kind of scenarios described in Quote #9 which make use of automatic arrays, allocatable arrays, and allocatable character variables, bit-wise and string processing, pointers, transfer, derived types with DTIO, stream IO, etc. that can even improve further the performance of existing code.

I still fail to see why and how the standard needs to be adjusted for the aspects presented in this thread.

0 Kudos
Steven_L_Intel1
Employee
3,435 Views

The current standard uses "obsolescent", not "deprecated". EQUIVALENCE is called obsolescent in F2015. The only practical effect of this is that compilers are required to have the ability to notify you of use of obsolescent and deleted features.  The rationale for EQUIVALENCE was that it is error-prone.

0 Kudos
dboggs
New Contributor I
3,435 Views

I agree with sgeard. As one who developed and now must maintain, or upgrade, much old code I frequently used memory overlays using both EQUIVALENCE and COMMON techniques. Sometimes to conserve memory, but often as a handy way of organizing data Although there are ways around those now, from what I can tell they offer absolutely now benefits in performance, and in fact are generally a hit, all in the name of "modern techniques" and alleged "error prones." But to me, if you are used to this, the techniques are actually very convenient, concise, and intuitive. I lament the obsolescence or deprecation or whatever of EQUIVALENCE. Thankfully Intel will continue support, but there is always the issue of portability so I feel unduly pressured to move away from some old trustworthy ways and adapt the new ones, all in the name of being modern. 

0 Kudos
FortranFan
Honored Contributor III
3,435 Views

dboggs wrote:

I agree with sgeard.  .., from what I can tell they offer absolutely now benefits in performance, and in fact are generally a hit, all in the name of "modern techniques" and alleged "error prones."  .. I feel unduly pressured to move away from some old trustworthy ways and adapt the new ones, all in the name of being modern. 

Firstly, "they offer absolutely no benefits in performance, and in fact are generally a hit, all in the name of "modern techniques" and alleged "error prones." is a complete myth.  This topic (https://software.intel.com/en-us/forums/topic/539969) is one, small illustration of this but there are many other cases.

On the contrary, the use of EQUIVALENCE has been presented to  the standard-bearers as being error-prone and that's why it has become marked as obsolescent.

Thirdly, the future of computing is largely parallel execution and techniques and practices that work well for sequential programming hinder parallelization (including threading) and many of the so-called modern techniques facilitate parallel programming and whereas COMMONs and EQUIVALENCE s cause more problems than offer benefits.

Most important aspect in my mind though is "passing the baton" to the next generation.   As do most forum readers, we have many important computational libraries (some huge, others not so) in Fortran that provide immense benefits in our work and as everyone would want with their libraries, we want these libraries to live long and prosper.  This essentially requires the younger generation to come on board enthusiastically and bring their energy and talent and imagination to the task.  We've noticed the so-called "modern techniques" i.e., the use of "modern Fortran" with robust , internal communication and education sessions that go somewhat along the likes of the paper mentioned in this forum topic (https://software.intel.com/en-us/forums/topic/509099) are beginning to make our colts appreciate the value of fundamentals (numerical methods, algorithms, good coding practices, design patterns, etc.) and helping them see Fortran as an efficient, "safe" vehicle to achieving these in code with some advantages over other approaches involving C++, Python, MATLAB, .NET, etc.  If we had stayed with legacy code, our resource base of people who can work on the code libraries will be utterly poor.  Now that most of the code is modernized, the dynamics has changed completely; our managers have never seen more young people in their teams and never had so many applications for open positions.

0 Kudos
LRaim
New Contributor I
3,435 Views

I am new for this forum but using Fortran since decades.

The 'EQUIVALENCE' is available also in C/C++ (union) and it is, in my opinion a feature of advanced and efficient programming.

E.g. Excel data types are defined using "union"    

0 Kudos
Steven_L_Intel1
Employee
3,435 Views

The standards committee chose not to add the concept of unions to the language - I wasn't on the committee when that happened. Of course, Intel supports unions as part of the DEC STRUCTURE/RECORD extension. I don't agree that unions are the same as EQUIVALENCE, though there is some overlap. EQUIVALENCE and unions are error-prone features. They may be efficient but they're not what I would call "advanced". Something more like Pascal's variant records are a somewhat better choice in that regard.

0 Kudos
jimdempseyatthecove
Honored Contributor III
3,435 Views

I strongly disagree with the standards committee's aversion to use of EQUIVALANCE and UNION. The introduction of TRANSFER is a poor attempt to provide some means to accomplish a similar thing. However, TRANSFER cannot be used on the left hand side of =.

 I am glad that Intel has chosen to continue to support these valuable legacy language features.

"The EQUIVALANCE is dead, long live the EQUIVALANCE!"

Jim Dempsey

0 Kudos
Steven_L_Intel1
Employee
3,435 Views

I don't know of any current compilers planning on actually removing these features. All the vendors I have spoken with say that they will leave the features in. Some might issue warnings by default.

0 Kudos
IanH
Honored Contributor III
3,435 Views

Luigi R. wrote:
...advanced and efficient programming.  E.g. Excel data types...   

I'm not sure those two sentence fragments should go together.

jimdempseyatthecove wrote:
I strongly disagree with the standards committee's aversion to use of EQUIVALANCE and UNION. The introduction of TRANSFER is a poor attempt to provide some means to accomplish a similar thing.

For many use cases of equivalence, TRANSFER is not the option - and I think the assumption that's why it was introduced to the language is a false premise.  Equivalence (and union) is often used to put values of objects of different types behind the same designator.  The actual storage association feature that equivalence is fundamentally about is really incidental implementation detail to the programmer, but it has material implications for what the compiler can do.

The type that Excel uses to store data for a cell is a good example of this.  Client programmers for that data type rarely care that the `cell%value` object for an integer value is the exact same storage for a real value.  For many other types the storage isn't the same, so it clearly isn't critical.

Fortran 2003 has ways of achieving the same outcome (putting values of objects of different types behind the same designator) that are generally superior, from the point of view of the language feature being a better fit to what the programmer actually wants to specify.

0 Kudos
jimdempseyatthecove
Honored Contributor III
3,435 Views

>>Fortran 2003 has ways of achieving the same outcome (putting values of objects of different types behind the same designator) that are generally superior, from the point of view of the language feature being a better fit to what the programmer actually wants to specify.

Then it should be relatively easy for you to convert the post #1 into  (putting values of objects of different types behind the same designator) This isn't overtly clear when reading the F2003 spec.

Jim Dempsey

0 Kudos
IanH
Honored Contributor III
3,435 Views

(If Dr Fortran is reading, there's a compiler bug described in the comments in the following.)

Details depends on the requirements of the application, but for some simple operations on scalars, something along the lines of:

module variants
  implicit none
  private
  type, public :: variant
    class(*), allocatable :: item
  contains
    procedure :: assign_int
    procedure :: assign_real
    !                                  <--------------------------------+
    generic :: assignment(=) => assign_int, assign_real  !              |
    ! Dr Fortran - if the following statement is moved up above the     |
    ! generic binding for the assignment, then the compiler's           |
    ! parser gets confused.                                             |
    procedure :: write_formatted    !  >--------------------------------+
    generic :: write(formatted) => write_formatted
  end type variant
contains
  elemental subroutine assign_int(lhs, rhs)
    class(variant), intent(out) :: lhs
    integer, intent(in) :: rhs
    
    allocate(lhs%item, source=rhs)
  end subroutine assign_int
  
  elemental subroutine assign_real(lhs, rhs)
    class(variant), intent(out) :: lhs
    real, intent(in) :: rhs
    
    allocate(lhs%item, source=rhs)
  end subroutine assign_real
  
  subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
    class(variant), intent(in) :: dtv
    integer, intent(in) :: unit
    character(*), intent(in) :: iotype
    integer, intent(in) :: v_list(:)
    integer, intent(out) :: iostat
    character(*), intent(inout) :: iomsg
    
    select type (val => dtv%item)
    type is (integer)
      write (unit, "(i0)", iostat=iostat, iomsg=iomsg) val
    type is (real)
      write (unit, *, iostat=iostat, iomsg=iomsg) val
    end select
  end subroutine write_formatted
end module variants

program p
  use variants
  implicit none
  type(variant) :: a(0:11,2)
  integer :: i
  
  a(:,1) = [(i,i=lbound(a,1),ubound(a,1))]
  a(:,2) = [(real(i),i=lbound(a,1),ubound(a,1))]
  
  write (*,'(a,dt)') 'a(0,1) = ', a(0,1)
  write (*,'(a,dt)') 'a(1,2) = ', a(1,2)
end program p

 

0 Kudos
Steven_L_Intel1
Employee
3,222 Views

Interesting - we'll check it out. Thanks.

0 Kudos
Reply