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.
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:
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.
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.
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.
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