Clarity on Equivalence

I have mentioned this before but still need to shake this ‘remnant’, which requires that I fully understand what is going on.

I have the following definitions:

	integer, parameter :: me = 9
	integer, parameter :: mj  = 4000

Later, I have this:

       double precision :: element(mj, me), hydrogen(mj)
       equivalence (hydrogen, element(1,1))

So, the variable element has a sum total size of 4000 x 9 or 36000, whilst the variable hydrogen is simply 4000; these two array variables are of differing size.

Not an issue, but if I am reading the equivalence correctly, the entirety of the array hydrogen is matched to the single reference of element(1, 1)?

If I reduce this down, significantly, let me assume the following:

	integer, parameter :: me = 1
	integer, parameter :: mj  = 2

       double precision :: element(mj, me), hydrogen(mj)
       equivalence (hydrogen, element(1,1))

Am I correct in the following:

      hydrogen(2, 1) = 3

So, element(1, 1) now equates to 3, which means all the elements of hydrogen equate to 3?

My conclusions bring me to the following points:

  • alter any other part of element then no consequence on hydrogen at all
  • alter element(1, 1) affects the entire array hydrogen
  • alter any part of hydrogen, alters element(1, 1), which, in turn, affects the whole of hydrogen

This seems mad, circular, etc

I want to remove this equivalence so much, but I must understand how it is working.

Thank you. :slight_smile:

@garynewport ,

What has changed since the discussion in your threads around EQUIVALENCE over a year ago? For example, see this.

As to your original post here, note you have declared hydrogen as a rank-1 object, thus the reference to it as hydrogen(2,1) is invalid. The rest of your note looks mostly ok.

It appears you’re still struggling with legacy code in your PhD work and unable to quickly and fully refactor it to modern Fortran or to another language (Python/Julia) or even platform (MATLAB) and get to focus entirely on the science and computing in your research which is bothersome.

You may perhaps want to give a textbook another try, say the one by Nyhoff and Leestma, to get to the basics of this legacy code, especially the EQUIVALENCE semantics, in a way that you can finally have it in your rearview mirror.

Immediately on your questions, to make a long story short, you can see your hydrogen object as an alias to a particular column (the first one) in your rank-2 “data” array named element and thus any variable definition to the corresponding hydrogen array index value affects element array and vice versa. You can see this in the following snippet, give it a try and “play around with it”:

   integer, parameter :: me = 9
   integer, parameter :: mj = 4000
   double precision :: element(mj, me), hydrogen(mj)
   equivalence (hydrogen, element(1,1))
   element = 0D0
   element(:,1) = 99.0D0
   print *, "hydrogen(1) = ", hydrogen(1), "; expected is 99D0"
   print *, "hydrogen(1000) = ", hydrogen(1000), "; expected is 99D0"
   print *, "hydrogen(4000) = ", hydrogen(4000), "; expected is 99D0"
   hydrogen(999) = 42D0
   print *, "element(999,1) = ", element(999,1), "; expected is 42D0"
end 
C:\temp>gfortran p.f90 -o p.exe

C:\temp>p.exe
 hydrogen(1) =    99.000000000000000      ; expected is 99D0
 hydrogen(1000) =    99.000000000000000      ; expected is 99D0
 hydrogen(4000) =    99.000000000000000      ; expected is 99D0
 element(999,1) =    42.000000000000000      ; expected is 42D0

And note a modern Fortran code equivalent (bad pun intended) to above can be the following:

   integer, parameter :: me = 9
   integer, parameter :: mj = 4000
   double precision, target :: element(mj, me)
   double precision, pointer :: hydrogen(:)
   hydrogen => element(:,1)
   element = 0D0
   element(:,1) = 99.0D0
   print *, "hydrogen(1) = ", hydrogen(1), "; expected is 99D0"
   print *, "hydrogen(1000) = ", hydrogen(1000), "; expected is 99D0"
   print *, "hydrogen(4000) = ", hydrogen(4000), "; expected is 99D0"
   hydrogen(999) = 42D0
   print *, "element(999,1) = ", element(999,1), "; expected is 42D0"
end 
C:\temp>gfortran p.f90 -o p.exe

C:\temp>p.exe
 hydrogen(1) =    99.000000000000000      ; expected is 99D0
 hydrogen(1000) =    99.000000000000000      ; expected is 99D0
 hydrogen(4000) =    99.000000000000000      ; expected is 99D0
 element(999,1) =    42.000000000000000      ; expected is 42D0
1 Like

You are mistaken about the meaning of element(1,1) in the equivalence statement. It merely indicates the address that is to be matched with the array hydrogen. In fact, the plain name of the array is equivalent (sorry) to hydrogen(1), so that you make hydrogen(1) and element(1,1) refer to the same memory address. Given the organisation of the memory, hydrogen(2) and element(2,1) then also - implicitly - refer to the same address, but one array element from the start. To make it more concrete:

hydrogen(1) <--> element(1,1)
hydrogen(2) <--> element(2,1)
...
hydrogen(mj) <--> element(mj,1)

But element(1,2) is one step beyond the last element of hydrogen, so is not equivalence’d. (Unless you accidentally or expressly access the hydrogen array beyond its bounds. Something which you should not do of course :slight_smile:)

2 Likes

No, it would be impossible, as equivalence introduces storage association between the objects, here arrays. Your declaration is equivalent to
equivalence (hydrogen(1), element(1,1)). Then, successive elements of two arrays are storage associated according to the Fortran way of placing arrays in memory.
namely

hydrogen(1)  <-> element(1,1)
hydrogen(2)  <-> element(2,1)

Also, you cannot write hydrogen(2,1) because it is a rank-1 array. You’d immediately get compiler error if you actually put that into your code.

In the following short snippet I show how the equivalence works in your example. I have only slightly increased me and mj to make element “truly” two-dimensional array and bigger than hydrogen, as in your original code.

program equiv
  implicit none
  integer, parameter :: me = 2
  integer, parameter :: mj  = 3
  integer :: i
  double precision :: element(mj, me), hydrogen(mj)
  equivalence (hydrogen, element(1,1))

  element = 0d0
  hydrogen(1) = 1d0
  hydrogen(2) = 2d0
  do i=1,mj
    print *, element(i,:)
  enddo
end program equiv

!  output:
!   1.0000000000000000        0.0000000000000000
!   2.0000000000000000        0.0000000000000000
!   0.0000000000000000        0.0000000000000000
1 Like

Thanks for the 3 replies. Allow me, firstly, to apologise for my error relating to hydrogen(2, 1). Despite wanting to avoid such an obvious error, I still made it! Doh!

Also, I had also considered the association of hydrogen(1) to element(1, 1), hydrogen(2) to element(2, 1) but forgot to put it forward. So pleased that this has been explained - helps enormously.

Also, to the point raised about my question from a year ago. The issue is that my PhD has pulled me in a variety of areas and I have not explored my model for some time now. I have returned to it, encountered a series of errors, was able to improve the code somewhat but still have this equivalence issue, that I hate. I reread the old comments but simply found myself in circles and confused. Thus, raising this again I hoped for clarity by defining my own thinking (poorly). Indeed, the new replies have helped considerably and I am most grateful for the help.