How to replace weird common blocks with derived types

I’m refactoring some old code with common blocks. The common block has many variables, but the old code treats it as one big block of memory, and will use different sets of variables to deal with this memory. For example,

program main
  call sub1()
  call sub2()
end program

subroutine sub1()
  integer :: a,b,c
  common a,b,c
  a = 1
  b = 2
  c = 3
end subroutine

subroutine sub2()
  integer :: a,d
  common a,d(2)
  print*,a
  print*,d
end subroutine

This program prints

           1
           2           3

I want to replace these common blocks by passing in/out a derived type. I want to do this so the code is thread-safe. Below is my current solution

module common_stuff
  type, bind(c) :: common_data
    integer :: a, b, c
  end type
end module

program main
  use common_stuff
  implicit none
  type(common_data) :: dat
  interface
    subroutine sub1(dat1)
      import :: common_data
      type(common_data), target, intent(inout) :: dat1
    end subroutine
    subroutine sub2(dat1)
      import :: common_data
      type(common_data), target, intent(inout) :: dat1
    end subroutine
  end interface

  call sub1(dat)
  call sub2(dat)
end program

subroutine sub1(dat)
  use common_stuff
  type(common_data), target, intent(inout) :: dat
  integer, pointer :: a,b,c
  a => dat%a
  b => dat%b
  c => dat%c
  a = 1
  b = 2
  c = 3
end subroutine

subroutine sub2(dat)
  use common_stuff
  use iso_c_binding
  type(common_data), target, intent(inout) :: dat
  type(c_ptr) :: dat_ptr
  integer, pointer :: a, d(:)
  a => dat%a
  dat_ptr = c_loc(dat%b)
  call c_f_pointer(dat_ptr, d, [2])
  print*,a
  print*,d
end subroutine

I worry about the mischief I had to do in sub2. Here I use iso_c_binding to make a c pointer to a variable in the derived type, then I deference the pointer as if it were an array.

Is what i’m doing here OK? Will it be thread-safe? Is there a better way? Do I have to use bind(c) in the derived type, to guarantee the order of the memory?

Note, the good thing about this approach is that I don’t have to understand the old code at all. I can add some code at the beginning of each subroutine which emulates a common block.

I feel your pain. This was always the absolute WORST way to use common blocks in fortran. It prevents you from using include files with a single common block definition, it prevents you from replacing the common block with a module in a straightforward way, and it prevents you from replacing the common block with a derived type in a straightforward way.

If it is at all possible, I would recommend first trying to make the common block usage consistent throughout your code. Then the replacement is relatively straightforward, either as a single module or as one or more derived types.

If that is not possible, then here is one more possibility. This uses ASSOCIATE rather than pointers.

module common_stuff
   type, bind(c) :: common_data
      integer :: i(3)
   endtype
end module

program main
   use common_stuff
   implicit none
   type(common_data) :: dat
   interface
      subroutine sub1(dat1)
         import :: common_data
         type(common_data), intent(inout) :: dat1
      end subroutine sub1
      subroutine sub2(dat1)
         import :: common_data
         type(common_data), intent(inout) :: dat1
      end subroutine sub2
   end interface

   call sub1(dat)
   call sub2(dat)
end program main

subroutine sub1(dat)
   use common_stuff
   type(common_data), intent(inout) :: dat
   associate(a => dat%i(1), b => dat%i(2), c => dat%i(3))
      a = 1
      b = 2
      c = 3
   end associate
end subroutine sub1

subroutine sub2(dat)
   use common_stuff
   type(common_data), intent(inout) :: dat
   associate(a => dat%i(1), d => dat%i(2:3))
      print*, a
      print*, d
   end associate
end subroutine sub2

If you just put the subroutines in a module, then you could eliminate the interface blocks in the main program. Then it all looks pretty simple.

It’s a pretty complicated code. So Its a massive amount of work to make the common block consistent. I think the way to go might be to just make a contiguous arrays in the derived type, then point to different indexes in those arrays. I worry that derived type variables might have padding sometimes, which I think would be an issue for my first approach

module common_stuff
  type :: common_data
    integer :: ints(3)
  end type
end module

program main
  use common_stuff
  implicit none
  type(common_data) :: dat
  interface
    subroutine sub1(dat1)
      import :: common_data
      type(common_data), target, intent(inout) :: dat1
    end subroutine
    subroutine sub2(dat1)
      import :: common_data
      type(common_data), target, intent(inout) :: dat1
    end subroutine
  end interface

  call sub1(dat)
  call sub2(dat)
end program


subroutine sub1(dat)
  use common_stuff
  use iso_c_binding
  type(common_data), target, intent(inout) :: dat
  type(c_ptr) :: tmp_ptr
  integer, pointer :: a, b, c
  
  tmp_ptr = c_loc(dat%ints(1))
  call c_f_pointer(tmp_ptr, a)
  tmp_ptr = c_loc(dat%ints(2))
  call c_f_pointer(tmp_ptr, b)
  tmp_ptr = c_loc(dat%ints(3))
  call c_f_pointer(tmp_ptr, c)

  a = 1
  b = 2
  c = 3
end subroutine

subroutine sub2(dat)
  use common_stuff
  use iso_c_binding
  type(common_data), target, intent(inout) :: dat
  type(c_ptr) :: tmp_ptr
  integer, pointer :: a, d(:)

  tmp_ptr = c_loc(dat%ints(1))
  call c_f_pointer(tmp_ptr, a)
  tmp_ptr = c_loc(dat%ints(2))
  call c_f_pointer(tmp_ptr, d, [2])

  print*,a
  print*,d
end subroutine

Yes, that is what I did in my suggested alternative before. But I used ASSOCIATE to eliminate all of the pointer stuff.

Regarding my other comment about eliminating the interface blocks, if all of the subroutines that reference the common block were placed in the same module, then you would only need that one module, with no interface blocks. Here is that version:

module common_stuff
   type, bind(c) :: common_data
      integer :: i(3)
   endtype
contains
   subroutine sub1(dat)
      type(common_data), intent(inout) :: dat
      associate(a => dat%i(1), b => dat%i(2), c => dat%i(3))
         a = 1
         b = 2
         c = 3
      end associate
   end subroutine sub1

   subroutine sub2(dat)
      type(common_data), intent(inout) :: dat
      associate(a => dat%i(1), d => dat%i(2:3))
         print*, a
         print*, d
      end associate
   end subroutine sub2
end module

program main
   use common_stuff
   implicit none
   type(common_data) :: dat

   call sub1(dat)
   call sub2(dat)
end program main
1 Like

As someone who’s gone through that more than once (KIVA family of combustion codes) I can say there is no free lunch here, it’s going to be a massive amount of work.

The good news is that most of the time, when variables of a common block were renamed/resized, that was just an old-school way to reuse some pre-allocated memory for completely different purposes that do not overlap. Which means, most times you’re safe defining both the former and the latter variables separately in your derived type. But you’ll have to find these collisions and decide case by case what to do.

2 Likes

One possibility that comes to my mind is to use pointers to create “view” types of the data for the different variations use by the common blocks:

module common_stuff
    implicit none
    
    private
    public data_t
    public alternate_data_view_t

    type :: alternate_data_view_t
        integer, pointer :: a => null()
        integer, pointer :: b => null()
        integer, pointer :: c => null()
    end type
    
    
    type :: data_t
        integer :: a
        integer :: d(2)
        type(alternate_data_view_t) :: alternate_view
    contains
        generic :: assignment(=) => assign
        procedure, private :: assign
    end type
    
    interface data_t
        module procedure init
    end interface
    
contains


    type(data_t) function init() result(this)
        call init_pointers(this)
    end function

    
    subroutine assign(lhs, rhs)
        class(data_t), intent(inout) :: lhs
        type(data_t), intent(in) :: rhs
        
        lhs%a = rhs%a
        lhs%d = rhs%d
        ! Make sure pointers are valid after an assignment. This also includes
        ! assigning a variable to the return value of a funciton.
        call init_pointers(lhs)
    end subroutine
    
    
    subroutine init_pointers(data)
        type(data_t), target, intent(inout) :: data
        
        data%alternate_view%a => data%a
        data%alternate_view%b => data%d(1)
        data%alternate_view%c => data%d(2)
    end subroutine
end module

module subs_mod
    use common_stuff, only: data_t, alternate_data_view_t
    implicit none
contains

    subroutine sub1(data)
        type(alternate_data_view_t), intent(inout) :: data
      
        data%a = 1
        data%b = 2
        data%c = 3
    end subroutine
    
    subroutine sub2(data)
        type(data_t), intent(in) :: data
        print*,data%a
        print*,data%d
    end subroutine
end module


program main
    use subs_mod, only: sub1, sub2
    use common_stuff, only: data_t
    
    type(data_t) :: data
    ! Initialize type. This is important to set up pointers correctly!
    data = data_t()
    call sub1(data%alternate_view)
    call sub2(data)
end program

It might be possible that the data in the common block are defined in a way that you cannot represent the different variations using pointers though. You should also think about what’s you desirable representation of the data and put that in your “main” type (data_t in my example). You could use pointers here and store it in another type if that is necessary. I think something like this could be a good alternative to introduce more flexibility:


! The actual data
type storage_t
    integer :: arr(3)
end type

! One way of interacting with the data, but not the desirable one
type :: alternate_data_view_t
    integer, pointer :: a => null()
    integer, pointer :: d(:) => null()
end type
    
    
! The desirable way of interacting with the data as well as alternate views and the storage itself
type :: data_t
    integer, pointer :: a => null()
    integer, pointer :: b => null()
    integer, pointer :: c => null()
    type(alternate_data_view_t) :: alternate_view
    type(storage_t), private :: storage
contains
    generic :: assignment(=) => assign
    procedure, private :: assign
end type

and then setup pointers like this:

subroutine init_pointers(data)
    type(data_t), target, intent(inout) :: data
        
    data%a => data%storage%arr(1)
    data%b => data%storage%arr(2)
    data%c => data%storage%arr(3)
    data%alternate_view%a => data%storage%arr(1)
    data%alternate_view%d => data%storage%arr(2:3)
end subroutine

I’ve used similar types with pointer attributes to transition from legacy data structures to a Fortran types with success before, but I haven’t tried it on data that have been used as inconsistently as you show here.

1 Like

This is an interesting approach. And may have been one of the better ways to do it.

I went ahead and used iso_c_binding like I showed in my previous post.

Here is the result so far: GitHub - Nicholaswogan/odepack

I’ve managed to make part of odepack thread safe by removing the common blocks. It all seems to work!

2 Likes