Converting COMMON; am I correct?

Again, sorry but I would like to confirm my understanding, if that is okay.

My one include file has the following line…

IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER(I-N)

The other included file has this COMMON block…

COMMON/ GIC / X(MJ,MH), VX(MJ,MH), GRV(MJ),                       &
     &     zM(MJ),dM(MJ),Zmass,Zflux,dflux,xTimod,xCorm,                &
     &     TIME,DTIME,FACTIM,DTMIN,DTMAX,CHGMIN,CHGMAX,CHANGE,          &
     &     dLmx,dLmn,dPmx,dPmn,dXmn,dXmx,dZmax,dZmin,dZdt,              &
     &     dMat,Atmn,TAUx,dPat,RLH,Crad,Cwrk,xH2,ener,Arad3,taujk,      &
     &     dTmn,dMix,zMmn,zMmx,RHmn,Enorm,zMold,zRold,zLold,            &
     &     JRIT,NRIT,MODEL,N,NG,METHD,NPROB,NMOD,kUNIT,jUNIT,NREC,NATM, &
     &     Nadd,Nsub,IPRT,Jatm,Katm,Latm,MREC,iGRV,massloss

I have converted this to…

real, save		:: 	arad3, atmn, change, chgmax, chgmin, crad, cwrk, dflux, dlmn, dlmx, dm(mj), dmat, dmix, dpat, dpmx
real, save		::	dpmn, dtime, dtmax, dtmin, dtmn, dxmn, dxmx, dzdt, dzmax, dzmin, ener, enorm, factim, grv(mj), rhmn
real, save		::	rlh, taujk, taux, time, vx(mj, mh), x(mj, mh), xcorm, xh2, xtimod, zflux, zlold, zm(mj), zmass, zmmn
real, save		::	zmmx, zmold, zrold

integer, save	:: 	igrv, iprt, jatm, jrit, junit, katm, kunit, latm, massLoss, methd, model, mrec, n, nadd, natm, ng
integer, save	::	nmod, nprob, nrec, nrit, nsub

I have not done anything with the collective name (GIC).

Is this correct?

No.

You should create a module, called GIC, and declare all these in the module. You do not need the SAVE attribute in the module, it is implied.

You should declare the reals as DOUBLE PRECISION, not REAL.

There may be complications if GIC has different definitions in different program units or there are EQUIVALENCE statements.

This paper can be useful: https://www.cl.cam.ac.uk/~acr31/pubs/orchard-camfort.pdf

Example “Figure 1

Common block

program foo                       
  integer :: x, y
  common x, y
  call bar()
end program foo

...

Using module

module common
  integer :: x
  integer :: y
end module common
program foo
  use common
 call bar()
end program foo

...

Using common as the name for the module in the above example may be misleading, as the program might (and usually did) contain more than one block, named. I would rather follow @themos’ advice and show a slightly modified conversion pattern. Note also, that the bar subroutine must use abc as well, just as it would have to declare common /abc/ ... in the old style. The big advantage of the new style is that the module, defined just once, guarantees the consistency of its variables when used in other places of the program. The old common approach makes the programmer responsible for all common /name/ declarations in any program unit that uses it to be consistent. In old days people used include files to achieve that but AFAIR, the F77 standard did not officially provide such a ‘INCLUDE directive’, it was rather a popular extension.

! using common
program foo                       
  integer :: x, y
  common /abc/ x, y
  call bar()
end program foo
...

! using module
module abc
  integer :: x
  integer :: y
end module abc

program foo
  use abc
  call bar()
end program foo
...
1 Like

I should explain that I changed double precision to real, under the advice I got elsewhere (that makes sense). Not sure we need the precision currently achieved, whilst any reduction in execution time would be incredibly beneficial. Until I run the model I won’t know if this decision is a good one or not (but I can always revert back if needs be).

Equally, though save is implicit, I took from another post of mine that I should not rely upon that implicit nature and declare the save explicitly; hence my addition there.

Thank you so much for the information on the module (and naming). I will be sharing shortly my understanding of that and believe I have understood it correctly, but would appreciate any further advice.

I originally had two files (parm.h and xvar.h) that were then included throughout two programs I have…

parm.h

      IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER(I-N)
      PARAMETER (MJ=4000,MH=4,ME=9,MTAU=20000)
      parameter(SIG=5.67051d-5 , PI=3.14159265359d0)
      parameter(GRAV=6.6704d-8 , CC=2.99792458d10)
      parameter(HMASS=1.6732d-24)
      parameter ( xm_sun = 1.989d33 )       ! Solar Mass (g)
      parameter ( r_sun  = 6.9599d10 )      ! Solar Radius (cm)
      parameter ( xl_sun = 3.83d33 )        ! Solar Luminosity (erg/s)
      parameter ( yr = 3.1556736d+7 )       ! yr in sec
      parameter ( xmdot_sunyr = 6.30268d25 )! acc. Rate in M_sun/yr

xvar.h

      COMMON/ GIC / X(MJ,MH), VX(MJ,MH), GRV(MJ),                       &
     &     zM(MJ),dM(MJ),Zmass,Zflux,dflux,xTimod,xCorm,                &
     &     TIME,DTIME,FACTIM,DTMIN,DTMAX,CHGMIN,CHGMAX,CHANGE,          &
     &     dLmx,dLmn,dPmx,dPmn,dXmn,dXmx,dZmax,dZmin,dZdt,              &
     &     dMat,Atmn,TAUx,dPat,RLH,Crad,Cwrk,xH2,ener,Arad3,taujk,      &
     &     dTmn,dMix,zMmn,zMmx,RHmn,Enorm,zMold,zRold,zLold,            &
     &     JRIT,NRIT,MODEL,N,NG,METHD,NPROB,NMOD,kUNIT,jUNIT,NREC,NATM, &
     &     Nadd,Nsub,IPRT,Jatm,Katm,Latm,MREC,iGRV,massloss
      COMMON/  HY  /HA(MH,2*MH+1),HW(MH,MH+1,MJ),HX(MH,MH+1),           &
     &              E(MH),G(MH),HC(MH,MH),HD(MH,MH),HE(MH,MH)
      COMMON/ CORR /DG(MH),SMIN(MH),SMAX(MH),EPS(MH),                   &
     &              JG(MH),JC(MH),ITMIN,ITMAX,ITER
      real*8 element(MJ,ME),velement(MJ,ME)
      real*8 nitrogen,lithium
      COMMON/helium/hydrogen(MJ),deuterium(MJ),helium3(MJ),             &
     &              helium4(MJ),carbon(MJ),nitrogen(MJ),oxygen(MJ),     &
     &              lithium(MJ),erest(MJ),                              &
     &              vhydrogen(MJ),vdeuterium(MJ),vhelium3(MJ),          &
     &              vhelium4(MJ),vcarbon(MJ),vnitrogen(MJ),voxygen(MJ), &
     &              vlithium(MJ),verest(MJ)
      equivalence (element,hydrogen) , (velement,vhydrogen)
      common/ahycopacity/rhyr(23),thyr(28),auxchyop(23,28)
      common/ahecopacity/rhel(25),thel(32),auxcheop(25,32)
      COMMON/MIX/ICONVECT(MJ),ienergy(MJ)
        character*48  SFILE,OFILE,PFILE,LFILE,FILEZ
        integer       unitz,start_zones,increment_zones,iunit,lunit
        real*8        radM(10),radR(10)
      COMMON/ZONES/ SFILE,OFILE,PFILE,LFILE,FILEZ,radM,radR,Nrad,       &
     &              unitz,start_zones,increment_zones,iunit,lunit

I’m not too sure where the lines between the COMMON blocks should go (with the preceeding common, subsequent common or independently - where they could exist within the parm.h)

However, given the above advice and following some reading around, I have arrived at this…

modules.h

module stellar_values
	implicit none
	
	integer, parameter	::	mj    		= 4000
	integer, parameter	::	mh    		= 4
	integer, parameter	::	me    		= 9
	integer, parameter	::  MTau  		= 20000
	real, parameter		::	sig   		= 5.67051d-5
	real, parameter		::	pi    		= 3.14159265359d0	! Pi
	real, parameter		::	grav  		= 6.6704d-8
	real, parameter		::	cc    		= 2.99792458d10
	real, parameter		::	hmass 		= 1.6732d-24
	real, parameter		::	xm_sun      = 1.989d33      	! Solar mass (g)
	real, parameter 	::	r_sun       = 6.9599d10   		! Solar radius (cm)
	real, parameter 	::	xl_sun      = 3.83d33     		! Solar luminosity (erg/s)
	real, parameter 	::	yr          = 3.1556736d7		! yr in sec
	real, parameter 	::	xmdot_sunyr = 6.30268d25		! acc. rate in M_sun/yr	
end module

module ahecopacity
	real, save			::	auxcheop(25,32), rhel(25), thel(32)
end module

module ahycopacity
	real save			::	auxchyop(23,28), rhyr(23), thyr(28)
end module

module gic
	real, save			:: 	arad3, atmn, change, chgmax, chgmin, crad, cwrk, dflux, dlmn, dlmx, dm(mj), dmat, dmix, dpat, dpmx
	real, save			::	dpmn, dtime, dtmax, dtmin, dtmn, dxmn, dxmx, dzdt, dzmax, dzmin, ener, enorm, factim, grv(mj), rhmn
	real, save			::	rlh, taujk, taux, time, vx(mj, mh), x(mj, mh), xcorm, xh2, xtimod, zflux, zlold, zm(mj), zmass, zmmn
	real, save			::	zmmx, zmold, zrold
	integer, save		:: 	igrv, iprt, jatm, jrit, junit, katm, kunit, latm, massLoss, methd, model, mrec, n, nadd, natm, ng
	integer, save		::	nmod, nprob, nrec, nrit, nsub
end module

module corr
	real, save			::	dg(mh), lithium, nitrogen, radM(10), radR(10), eps(mh), smax(mh), smin(mh)
	real, save 			::	element(mj, me), velement(mj, me)
	integer, save		::	itmin, itmax, iter, jc(mh), jg(mh)
end module

module helium
	real, save			::	carbon(mj), deuterium(mj), erest(mj), helium3(mj), helium4(mj), hydrogen(mj), oxygen(mj)
	real, save			::	vcarbon(mj), vdeuterium(mj), verest(mj), vhelium3(mj), vhelium4(mj), vhydrogen(mj), vlithium(mj)
	real, save			::	vnitrogen(mj), voxygen(mj)
	integer, save		::	lithium(mj), nitrogen(mj)
	real, pointer, save	::	element, velement
	real, target, save	::	hydrogen, vhydrogen
	element  => hydrogen
	velement => vhydrogen     
end module

module hy
	real, save			::	e(mh), g(mh), ha(mh, 2 * mh + 1), hc(mh, mh), hd(mh, mh), he(mh, mh), hw(mh, mh + 1, mj), hx(mh, mh + 1)
end module

module mix
	character(48), save	::	filez, lfile, ofile, pfile, sfile
	integer, save		::	iconvect(mj), ienergy(mj)
    real, save			::	radM(10), radR(10)
end module

module zones
	real, save			::	nrad, radm, radr
	integer, save		::	increment_zones, iunit, lunit, start_zones, unitz
end module

I intend to include this as per the way parm.h and xvar.h were included (though I believe someone has stated this is not actually an accepted methodology?), or I can simply place this at the top of each program file and then include the modules as needed.

How close am I? :slight_smile:

The beauty of MODULE is you don’t INCLUDE them as source, you USE them instead. Start with the stellar_values MODULE, incorporate it into your build system so that it gets built first. Then you can write USE stellar_values wherever you had INCLUDE “parm.h”. You may have to adjust the placing of the USE source line nearer the top of the subroutine.

Your other modules are also going to need a USE stellar_values, to pick up the constants MJ etc.

The “element => hydrogen” is not going to work outside COMMON BLOCKs. You may have to go the opposite way: declare a TARGET element array element(MJ,ME) and declare POINTER variables for each element and associate hydrogen=>element(:,1), deuterium=>element(:,2) and so on.

1 Like

Actually, for now, keep the EQUIVALENCE statements because pointer initialization does not work well in compilers. In a hurry, so this may not be correct, check carefully:

    Module stellar_values
      Implicit None

      Integer, Parameter :: mj = 4000
      Integer, Parameter :: mh = 4
      Integer, Parameter :: me = 9
      Integer, Parameter :: mtau = 20000
      Real, Parameter :: sig = 5.67051D-5
      Real, Parameter :: pi = 3.14159265359D0 ! Pi
      Real, Parameter :: grav = 6.6704D-8
      Real, Parameter :: cc = 2.99792458D10
      Real, Parameter :: hmass = 1.6732D-24
      Real, Parameter :: xm_sun = 1.989D33 ! Solar mass (g)
      Real, Parameter :: r_sun = 6.9599D10 ! Solar radius (cm)
      Real, Parameter :: xl_sun = 3.83D33 ! Solar luminosity (erg/s)
      Real, Parameter :: yr = 3.1556736D7 ! yr in sec
      Real, Parameter :: xmdot_sunyr = 6.30268D25 ! acc. rate in M_sun/yr
    End Module

    Module ahecopacity
      Real :: auxcheop(25, 32), rhel(25), thel(32)
    End Module

    Module ahycopacity
      Real :: auxchyop(23, 28), rhyr(23), thyr(28)
    End Module

    Module gic
      Use stellar_values, Only: mh, mj
      Real :: arad3, atmn, change, chgmax, chgmin, crad, cwrk, dflux, dlmn, &
        dlmx, dm(mj), dmat, dmix, dpat, dpmx
      Real :: dpmn, dtime, dtmax, dtmin, dtmn, dxmn, dxmx, dzdt, dzmax, dzmin, &
        ener, enorm, factim, grv(mj), rhmn
      Real :: rlh, taujk, taux, time, vx(mj, mh), x(mj, mh), xcorm, xh2, &
        xtimod, zflux, zlold, zm(mj), zmass, zmmn
      Real :: zmmx, zmold, zrold
      Integer :: igrv, iprt, jatm, jrit, junit, katm, kunit, latm, massloss, &
        methd, model, mrec, n, nadd, natm, ng
      Integer :: nmod, nprob, nrec, nrit, nsub
    End Module

    Module corr
      Use stellar_values, Only: mh, mj, me
      Real :: dg(mh), radm(10), radr(10), eps(mh), smax(mh), smin(mh)
      Integer :: itmin, itmax, iter, jc(mh), jg(mh)
    End Module

    Module helium
      Use stellar_values, Only: mj, me
      Real :: element(mj, me), velement(mj, me)
      Real :: carbon(mj), deuterium(mj), erest(mj), helium3(mj), helium4(mj), &
        oxygen(mj), hydrogen(mj)
      Real :: vcarbon(mj), vdeuterium(mj), verest(mj), vhelium3(mj), &
        vhelium4(mj), vhydrogen(mj), vlithium(mj)
      Real :: vnitrogen(mj), voxygen(mj)
      Equivalence (hydrogen, element(1,1))
      Equivalence (deuterium, element(1,2))
      Equivalence (helium3, element(1,3))
      Equivalence (helium4, element(1,4))
      Equivalence (carbon, element(1,5))
      Equivalence (nitrogen, element(1,6))
      Equivalence (oxygen, element(1,7))
      Equivalence (lithium, element(1,8))
      Equivalence (erest, element(1,9))
      Equivalence (vhydrogen, velement(1,1))
      Equivalence (vdeuterium, velement(1,2))
      Equivalence (vhelium3, velement(1,3))
      Equivalence (vhelium4, velement(1,4))
      Equivalence (vcarbon, velement(1,5))
      Equivalence (vnitrogen, velement(1,6))
      Equivalence (voxygen, velement(1,7))
      Equivalence (vlithium, velement(1,8))
      Equivalence (verest, velement(1,9))

    End Module

    Module alt_helium
      Use stellar_values, Only: mj, me
      Real, Target :: element(mj, me), velement(mj, me)
      Real, Pointer :: carbon(:) => element(:, 5), deuterium(:) => element(:, &
        2), erest(:) => element(:, 9), helium3(:) => element(:, 3), &
        helium4(:) => element(:, 4), oxygen(:) => element(:, 7), &
        hydrogen(:) => element(1:mj, 1), nitrogen(:) => element(:, 6), &
        lithium(:) => element(:, 8)
      Real, Pointer :: vcarbon(:) => velement(:, 5), &
        vdeuterium(:) => velement(:, 2), verest(:) => velement(:, 9), &
        vhelium3(:) => velement(:, 3), vhelium4(:) => velement(:, 4), &
        voxygen(:) => velement(:, 7), vhydrogen(:) => velement(:, 1), &
        vnitrogen(:) => velement(:, 6), vlithium(:) => velement(:, 8)

    End Module

    Module hy
      Use stellar_values, Only: mh, mj
      Real :: e(mh), g(mh), ha(mh, 2*mh+1), hc(mh, mh), hd(mh, mh), &
        he(mh, mh), hw(mh, mh+1, mj), hx(mh, mh+1)
    End Module

    Module mix
      Use stellar_values, Only: mj

      Character (48) :: filez, lfile, ofile, pfile, sfile
      Integer :: iconvect(mj), ienergy(mj)
      Real :: radm(10), radr(10)
    End Module

    Module zones
      Real :: nrad, radm, radr
      Integer :: increment_zones, iunit, lunit, start_zones, unitz
    End Module

    Program test
      Use helium
      Use iso_c_binding


      hydrogen(1) = 42.0
      Print *, size(hydrogen), size (element), hydrogen(1), element(1,1)

    End Program

that meaning also that you can’t have it defined in a module.h file but module.f90 It should be built (compiled) either together with other code or before. If together, place module.f90 before other source files in the compilator invocation. Normally it would be put into a Makefile.

BTW, greetings from an astronomer. Nice to see Fortran used in our discipline

Besides the professional suggestions given.
Perhaps another sloppy way is that, you perhaps could rename those variable like GIC_xxxx, such as

real, save :: GIC_ X(MJ,MH)

so that you know what common block those variables are coming from, with the GIC_
But then you may need to be careful and change the variable names in your function/subroutine correspondingly.

I can’t do that at present, because I am trying to minimise the changes I make to the original code; altering it step by step.

However, this is certainly a good idea for later.

Ah, so I save the modules into a modules.f90 (for example) and then compile this, along with the others, but compiling it first?

I assume that the compiler then recognises that this module exists; I don’t need to reference it within the file of the other program (let’s say, stelcor.f90)?

And hello! :slight_smile:

I first encountered Fortran when working on my MSc on the restricted three body problem. I had an example code of the two body, using Runge-Kutta, in Fortran and used this as an aid to create a C++ model of the RTBP. This is a little more complex! :laughing:

Well, you do need. To use a module in other program segment, be it in the same or a different source file, one has to put

use modulename

line in every such segment. From the compiler point of view, it produces modulename.mod for every compiled module, plus a typical object file (*.o or *.obj). The mod files are used when compiler encounters use modulename line. The object files (with module subprograms etc.) are linked into the executable.

I’m beginning to think that this is a major change of the original code. I did these changes (and others), then hit a complaint about a declaration of corr (ambigious).

Equally, if I am declaring each as equivalent, as you declare, will I not need to ensure that this is reflected in the code somewhere?

Anyway, I might slow down on this change and check the old code first. See how it works fully, before reassembling it into .f90

Thank you so much for the help.