def _write_sc_array_wrapper(self, t, el, dims, sizeof_fortran_t):
"""
Write wrapper for arrays of intrinsic types
Parameters
----------
t : `fortran.Type` node
Derived-type node of the parse tree.
el : `fortran.Element` node
An element of a module which is derived-type array
dims : `tuple` of `int`s
The dimensions of the element
sizeof_fortan_t : `int`
The size, in bytes, of a pointer to a fortran derived type ??
"""
if isinstance(t, ft.Type):
this = 'this, '
else:
this = 'dummy_this, '
self.write('subroutine %s%s__array__%s(%snd, dtype, dshape, dloc)' %
(self.prefix, t.name, el.name, this))
self.indent()
if isinstance(t, ft.Module):
self.write_uses_lines(
t, {t.name: ['%s_%s => %s' % (t.name, el.name, el.name)]})
else:
self.write_uses_lines(t)
self.write('implicit none')
if isinstance(t, ft.Type):
self.write_type_lines(t.name)
self.write('integer, intent(in) :: this(%d)' % sizeof_fortran_t)
self.write('type(%s_ptr_type) :: this_ptr' % t.name)
else:
self.write('integer, intent(in) :: dummy_this(%d)' %
sizeof_fortran_t)
self.write('integer, intent(out) :: nd')
self.write('integer, intent(out) :: dtype')
try:
rank = dims[0].count(',') + 1
if el.type.startswith('character'): rank += 1
except ValueError:
rank = 1
self.write('integer, dimension(10), intent(out) :: dshape')
self.write('integer*%d, intent(out) :: dloc' % np.dtype('O').itemsize)
self.write()
self.write('nd = %d' % rank)
self.write('dtype = %s' %
ft.fortran_array_type(el.type, self.kind_map))
if isinstance(t, ft.Type):
self.write('this_ptr = transfer(this, this_ptr)')
array_name = 'this_ptr%%p%%%s' % el.name
else:
array_name = '%s_%s' % (t.name, el.name)
if 'allocatable' in el.attributes:
self.write('if (allocated(%s)) then' % array_name)
self.indent()
if el.type.startswith('character'):
first = ','.join(['1' for i in range(rank - 1)])
self.write('dshape(1:%d) = (/len(%s(%s)), shape(%s)/)' %
(rank, array_name, first, array_name))
else:
self.write('dshape(1:%d) = shape(%s)' % (rank, array_name))
self.write('dloc = loc(%s)' % array_name)
if 'allocatable' in el.attributes:
self.dedent()
self.write('else')
self.indent()
self.write('dloc = 0')
self.dedent()
self.write('end if')
self.dedent()
self.write('end subroutine %s%s__array__%s' %
(self.prefix, t.name, el.name))
self.write()
def _write_sc_array_wrapper(self, t, el, dims, sizeof_fortran_t):
"""
Write wrapper for arrays of intrinsic types
Parameters
----------
t : `fortran.Type` node
Derived-type node of the parse tree.
el : `fortran.Element` node
An element of a module which is derived-type array
dims : `tuple` of `int`s
The dimensions of the element
sizeof_fortan_t : `int`
The size, in bytes, of a pointer to a fortran derived type ??
"""
if isinstance(t, ft.Type):
this = 'this, '
else:
this = 'dummy_this, '
self.write('subroutine %s%s__array__%s(%snd, dtype, dshape, dloc)' % (self.prefix, t.name, el.name, this))
self.indent()
if isinstance(t, ft.Module):
self.write_uses_lines(t, {t.name: ['%s_%s => %s' % (t.name, el.name, el.name)]})
else:
self.write_uses_lines(t)
self.write('implicit none')
if isinstance(t, ft.Type):
self.write_type_lines(t.name)
self.write('integer, intent(in) :: this(%d)' % sizeof_fortran_t)
self.write('type(%s_ptr_type) :: this_ptr' % t.name)
else:
self.write('integer, intent(in) :: dummy_this(%d)' % sizeof_fortran_t)
self.write('integer, intent(out) :: nd')
self.write('integer, intent(out) :: dtype')
try:
rank = dims[0].count(',') + 1
if el.type.startswith('character'): rank += 1
except ValueError:
rank = 1
self.write('integer, dimension(10), intent(out) :: dshape')
self.write('integer*%d, intent(out) :: dloc' % np.dtype('O').itemsize)
self.write()
self.write('nd = %d' % rank)
self.write('dtype = %s' % ft.fortran_array_type(el.type, self.kind_map))
if isinstance(t, ft.Type):
self.write('this_ptr = transfer(this, this_ptr)')
array_name = 'this_ptr%%p%%%s' % el.name
else:
array_name = '%s_%s' % (t.name, el.name)
if 'allocatable' in el.attributes:
self.write('if (allocated(%s)) then' % array_name)
self.indent()
if el.type.startswith('character'):
first = ','.join(['1' for i in range(rank - 1)])
self.write('dshape(1:%d) = (/len(%s(%s)), shape(%s)/)' % (rank, array_name, first, array_name))
else:
self.write('dshape(1:%d) = shape(%s)' % (rank, array_name))
self.write('dloc = loc(%s)' % array_name)
if 'allocatable' in el.attributes:
self.dedent()
self.write('else')
self.indent()
self.write('dloc = 0')
self.dedent()
self.write('end if')
self.dedent()
self.write('end subroutine %s%s__array__%s' % (self.prefix, t.name, el.name))
self.write()