Use not working?

I have the remnants of an include file still sitting in my code. In various functions and subroutines I have the include declaration to this file:

include 'xvar.h'

Inside the xvar.h file is this (this is only a segment of the file, for brevity):

      double precision :: nitrogen(mj), oxygen(mj)
      common/helium/nitrogen, oxygen

To help remove this I created a module in my modules.f90 file:

module elements

	use stellar_values, only: DP, mj
	implicit none
    real(DP) :: nitrogen(mj), oxygen(mj)
    save
   
end module

I then simply use this module in the same functions/subroutines as had the include statement:

    use elements, only: nitrogen, oxygen

I remove references to nitrogen and oxygen from the xvar.h file, and the common block helium is not referenced in the remaining code anywhere.

When I run the code I should get the following results for each element:

.4177792D-04, .2703794D-03

Yet, I now get this…

.0000000D+00, .0000000D+00

This approach has worked elsewhere but not here?
Any ideas?

I should add that the program later crashes on a memory segmentation error.

were you initializing the arrays in a BLOCKDATA that you did not convert to be in the new module; or is “mj” the correct size? If you have not, turn on all debug flags, particularly array bound checks and traceback. If the size is not correct you could easily be going out of bounds;
if the values are not being initialized that would explain the zeros.

+1

Say the INCLUDE file is as follows:

      INTEGER MJ
      PARAMETER (MJ=2)
      DOUBLE PRECISION :: NITROGEN(MJ), OXYGEN(MJ)
      COMMON/HELIUM/NITROGEN, OXYGEN

And the legacy code may be as follows:

      SUBROUTINE SUB()
      INCLUDE 'xvar.h'
      PRINT "(A,2(G11.6,1X))", "IN SUB: NITROGEN = ", NITROGEN
      END SUBROUTINE 
      BLOCK DATA
      INCLUDE 'xvar.h'
      DATA NITROGEN / .4177792D-04, .2703794D-03 /
      DATA OXYGEN / .4177792D-04, .2703794D-03 /
      END BLOCK DATA
      CALL SUB()
      END 

Now running a program based on this, a processor can generate this:

C:\temp>gfortran p.f -o p.exe

C:\temp>p.exe
IN SUB: NITROGEN = .417779E-04 .270379E-03

Refactoring the above using a MODULE can possibly like this:

module xxx
   .
   integer, parameter :: MJ = 2
   real(DP) :: NITROGEN(MJ) = [ .4177792E-04_dp, .2703794E-03_dp ]
   real(DP) :: OXYGEN(MJ) = [ .4177792E-04_dp, .2703794E-03_dp ]
   .
end module 

But now if the values for each element are not to be modified, add the PARAMETER attribute to each of them:

   .
   real(DP), parameter :: NITROGEN(MJ) = [ .4177792E-04_dp, .2703794E-03_dp ]
   .
1 Like

No, this was not in a BLOCKDATA. The full xvar.h file is this:

      double precision :: element(mj, me), deuterium(mj), helium3(mj), helium4(mj), carbon(mj)
      double precision :: lithium(mj), erest(mj), hydrogen(mj), nitrogen(mj), oxygen(mj)
      
      common/helium/hydrogen, deuterium, helium3, helium4, carbon, lithium, erest, nitrogen, oxygen

	  equivalence (hydrogen, element(1,1))

Whilst this is being included the program works fine. If I remove nitrogen and oxygen from the above, then use the module instead (keeping the xvar.h include for the other variables), then the result is wrong.

No, nitrogen and oxygen values change in a number of suboutined and functions and are not in a BLOCKDATA.

The zeroes are the constant output for those two variables, whilst all the other, relevant, variables (element, helium, etc) have varying values (as expected).

If I re-add nitrogen and oxygen to the xvar.h file then these, too, give me changing values.

Sorry, I should have been clearer on the fact that the values should be non-zero AND changing.

Well, what is missing from the module is the “equivalence” statement. This causes, together with the COMMON statement, the initialisation of the variables, if you initialise “element” somewhere. You will either have to use another “equivalence” statement (but then the “element” array must be seen as well) or set the initial values expressly. The latter is probably the easiest solution.

But the equivalence has no relevance to nitrogen or oxygen? Equally, though hydrogen is defined, it is never used anywhere in the program. Any reference to hydrogenhas been replaced with the equivalentelement``` reference - which has worked fine.

The equivalence IS an issue, and one I am unpicking slowly. However, it should not affect the values of nitrogen or oxygen; should it?

Yes, it does: due to the COMMON statement the variables mentioned in there are “storage-related”. So, they occupy memory locations that are related. In other words:

element(1…mj,1) == hydrogen
element(1…mj,2) == deuterium
etc.

And that makes perfect sense!

I had missed that about the COMMON statement and equivalence. I assume, therefore, that the order is directly related to their position in the COMMON block?

I had assumed, wrongly, that it only connected hydrogen with element(1...mj, 1) only.

Thank you. :slight_smile:

Re order: yes, nothing magical there :slight_smile:

This is now under test but it is looking good so far.

Thank you. If this does work (and it makes total sense, so it should) then I can resolve an issue that has been annoying me on and off for almost 2 years! Hahahahaha!

It is also the last remaining hurdle before I finalise the code and can focus entirely on the Python interface, alongside the actual science behind the whole thing.

Honestly, thank you so much for your help.

Just to state, this all worked!

Again, thank you. You have no idea how pleased I am. Project almost finished now.

That has been a stubborn remnant for almost 2 years!

Good to hear that!

If the values are not set in a block data, then how were they set? By assignment? By reading from an external data file?

As explained by @Arjen and confirmed by OP, the values are set by the storage association semantics c.f. section 19 of the Fortran standard.

Readers needing to support code which makes use of such semantics or looking to refactor them can use the following snippet to see a silly example of how the storage association comes into play via the COMMON block and the EQUIVALENCE statement:

      SUBROUTINE SUB()
      REAL X(2), Y(2)
C X, Y objects follow consecutive storage sequence due to COMMON block DAT
      COMMON / DAT / X, Y
      REAL A(2,2)
C Equivalence of object X with a consecutive storage sequence of object A
C associates object Y as well
      EQUIVALENCE( X, A(1,1) )
      A(1,1) = -1.0
      A(2,1) = -2.0
      A(1,2) = 1.0
      A(2,2) = 2.0
      END SUBROUTINE
C
      PROGRAM P
      REAL X(2), Y(2)
      COMMON / DAT / X, Y
      CALL SUB()
C Y values get defined via storage association 
      PRINT *, "Y = ", Y
      END PROGRAM P
C:\temp>gfortran p.f -o p.exe

C:\temp>p.exe
 Y =    1.00000000       2.00000000