public
Created

transfer() example

  • Download Gist
a.f90
FORTRAN
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
program a
use types, only: dp
use compute, only: init, register_func, run, eq, destroy, get_context
use my_data_type, only: my_data, type2data, data2type
 
type(eq), pointer :: d
type(my_data), target :: data1, data2
 
data1%a11 = 0
data1%a12 = -1
data1%a21 = 1
data1%a22 = 0
 
data2%a11 = 0
data2%a12 = 1
data2%a21 = 1
data2%a22 = 0
 
call init(d)
call register_func(d, derivs, type2data(data1))
call run(d, [0.0_dp, 1.0_dp], 0.1_dp, 10)
call print_material_parameters(d)
print *
call register_func(d, derivs, type2data(data2))
call run(d, [0.0_dp, 1.0_dp], 0.1_dp, 10)
call print_material_parameters(d)
call destroy(d)
 
contains
 
subroutine print_material_parameters(d)
type(eq), intent(in) :: d
type(my_data), pointer :: ctx
ctx => data2type(get_context(d))
print "('Material parameters: ', f0.6, ' ', f0.6, ' ', f0.6, ' ', f0.6)", &
ctx%a11, ctx%a12, ctx%a21, ctx%a22
end subroutine
 
function derivs(x, data) result(y)
use types, only: dp
real(dp), intent(in) :: x(2)
integer, intent(in) :: data(:)
real(dp) :: y(2)
type(my_data), pointer :: d
d => data2type(data)
y(1) = d%a11 * x(1) + d%a12 * x(2)
y(2) = d%a21 * x(1) + d%a22 * x(2)
end function
 
end program
compile
Shell
1 2 3 4 5 6 7 8 9
#! /bin/bash
 
set -e
FFLAGS="-Wall -Wextra -Wimplicit-interface -fPIC -Werror -fmax-errors=1 -g -fbounds-check -fcheck-array-temporaries -fbacktrace"
gfortran $FFLAGS -c types.f90 -o types.o
gfortran $FFLAGS -c compute.f90 -o compute.o
gfortran $FFLAGS -c my_data_type.f90 -o my_data_type.o
gfortran $FFLAGS -c a.f90 -o a.o
gfortran $FFLAGS -o a a.o compute.o my_data_type.o types.o
compute.f90
FORTRAN
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
module compute
use types, only: dp
implicit none
private
public init, destroy, register_func, run, eq, get_context
 
abstract interface
function derivs(x, data) result(y)
use types, only: dp
implicit none
real(dp), intent(in) :: x(2)
integer, intent(in) :: data(:)
real(dp) :: y(2)
end function
end interface
 
type eq
integer, allocatable :: data(:)
procedure(derivs), nopass, pointer :: func
end type
 
contains
 
subroutine init(d)
type(eq), pointer, intent(inout) :: d
allocate(d)
d%func => NULL()
end subroutine
 
subroutine destroy(d)
type(eq), pointer, intent(inout) :: d
deallocate(d)
end subroutine
 
subroutine register_func(d, func, data)
type(eq), intent(inout) :: d
procedure(derivs) :: func
integer, intent(in) :: data(:)
d%func => func
if (allocated(d%data)) deallocate(d%data)
allocate(d%data(size(data)))
d%data = data
end subroutine
 
function get_context(d) result(data)
type(eq), intent(in) :: d
integer :: data(size(d%data))
data = d%data
end function
 
subroutine run(d, x0, dt, n_steps)
type(eq), intent(in) :: d
real(dp), intent(in) :: x0(2), dt
integer, intent(in) :: n_steps
 
real(dp) :: x(2), dx(2), t
integer :: i
if (.not. associated(d%func)) then
print *, "d%func is not associated"
end if
x = x0
t = 0
do i = 1, n_steps
dx = d%func(x, d%data)
print "(f10.6, f10.6)", x
x = x + dx * dt
t = t + dt
end do
end subroutine
 
end module
my_data_type.f90
FORTRAN
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
module my_data_type
! This module exports the data type and conversion routines
! to convert a pointer to untyped data(:)
! It is only used from the main program a.f90
use types, only: dp
implicit none
private
! Only these symbols are available from the main program:
public my_data, type2data, data2type
 
type my_data
! Material coefficients:
real(dp) :: a11, a12, a21, a22
! There can be a lot of variables and big arrays here, this needs
! to be passed around by reference.
end type
 
type my_data_ptr
type(my_data), pointer :: ptr
end type
 
contains
 
function data2type(data) result(d)
integer, intent(in) :: data(:)
type(my_data), pointer :: d
type(my_data_ptr) :: tmp
tmp = transfer(data, tmp)
d => tmp%ptr
end function
 
pure integer function pointer_length() result(l)
type(my_data_ptr) :: p
integer, allocatable :: data(:)
l = size(transfer(p, data))
end function
 
function type2data(d) result(data)
type(my_data), intent(in), target :: d
integer :: data(pointer_length())
type(my_data_ptr) :: tmp
tmp%ptr => d
data = transfer(tmp, data)
end function
 
end module
types.f90
FORTRAN
1 2 3 4 5 6 7 8 9
module types
 
implicit none
private
public dp
 
integer, parameter :: dp=kind(0.d0)
 
end module

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.