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()