memorytypemodule Module Reference

Data Types
type	memorytype

Functions/Subroutines
subroutine	table_entry (this, memtab)
logical function	mt_associated (this)
subroutine	mt_deallocate (this)

Function/Subroutine Documentation

mt_associated()

logical function memorytypemodule::mt_associated ( class(memorytype)  this )

private

Definition at line 85 of file Memory.F90.

    class(MemoryType) :: this
    logical :: al
    al = .false.
    if (associated(this%strsclr)) al = .true.
    if (associated(this%logicalsclr)) al = .true.
    if (associated(this%intsclr)) al = .true.
    if (associated(this%dblsclr)) al = .true.
    if (associated(this%astr1d)) al = .true.
    if (associated(this%aint1d)) al = .true.
    if (associated(this%aint2d)) al = .true.
    if (associated(this%aint3d)) al = .true.
    if (associated(this%adbl1d)) al = .true.
    if (associated(this%adbl2d)) al = .true.
    if (associated(this%adbl3d)) al = .true.
    if (associated(this%acharstr1d)) al = .true.

mt_deallocate()

subroutine memorytypemodule::mt_deallocate ( class(memorytype)  this )

private

Definition at line 103 of file Memory.F90.

    use iso_c_binding, only: c_loc, c_ptr, c_null_ptr, c_f_pointer
    class(MemoryType) :: this
    integer(I4B) :: n
    type(c_ptr) :: cptr
 
    character(len=1), dimension(:), pointer :: astr1d
 
    if (associated(this%strsclr)) then
      if (this%master) deallocate (this%strsclr)
      nullify (this%strsclr)
    end if
 
    if (associated(this%logicalsclr)) then
      if (this%master) deallocate (this%logicalsclr)
      nullify (this%logicalsclr)
    end if
 
    if (associated(this%intsclr)) then
      if (this%master) deallocate (this%intsclr)
      nullify (this%intsclr)
    end if
 
    if (associated(this%dblsclr)) then
      if (this%master) deallocate (this%dblsclr)
      nullify (this%dblsclr)
    end if
 
    ! Handle the dealloction of the 1d character string array differently due to a bug in gfortran 11.3, 12.1, 13.1 and 13.2.
    ! Due to a bug in the gfortran compiler we can't use a deferred length character variable
    ! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=106317
    !
    ! We use a c_ptr to cast the pointer to a string array with a length of 1. The actual length of the array is
    ! computed by the actual length of the string multiplied by the array size.
    ! So we go from the actual character(len=element_size), dimension(isize) to a character(len=1), dimension(isize*element_size).
 
    if (associated(this%astr1d)) then
      select type (item => this%astr1d)
      type is (character(*))
        cptr = c_loc(item)
      class default
        cptr = c_null_ptr
      end select
 
      call c_f_pointer(cptr, astr1d, [this%isize * this%element_size])
 
#if __GFORTRAN__  && ((__GNUC__ < 13) || (__GNUC__ == 13 && __GNUC_MINOR__ < 3))
      if (this%master) deallocate (astr1d)
#else
      if (this%master) deallocate (this%astr1d)
#endif
 
      nullify (this%astr1d)
    end if
 
    if (associated(this%aint1d)) then
      if (this%master) deallocate (this%aint1d)
      nullify (this%aint1d)
    end if
 
    if (associated(this%aint2d)) then
      if (this%master) deallocate (this%aint2d)
      nullify (this%aint2d)
    end if
 
    if (associated(this%aint3d)) then
      if (this%master) deallocate (this%aint3d)
      nullify (this%aint3d)
    end if
 
    if (associated(this%adbl1d)) then
      if (this%master) deallocate (this%adbl1d)
      nullify (this%adbl1d)
    end if
 
    if (associated(this%adbl2d)) then
      if (this%master) deallocate (this%adbl2d)
      nullify (this%adbl2d)
    end if
 
    if (associated(this%adbl3d)) then
      if (this%master) deallocate (this%adbl3d)
      nullify (this%adbl3d)
    end if
 
    if (associated(this%acharstr1d)) then
      if (this%master) then
        do n = 1, size(this%acharstr1d)
          call this%acharstr1d(n)%destroy()
        end do
        deallocate (this%acharstr1d)
      end if
      nullify (this%acharstr1d)
    end if

table_entry()

subroutine memorytypemodule::table_entry ( class(memorytype)  this, type(tabletype), intent(inout)  memtab  )

private

Definition at line 52 of file Memory.F90.

    ! -- dummy
    class(MemoryType) :: this
    type(TableType), intent(inout) :: memtab
    ! -- local
    character(len=16) :: cmem
    character(len=LENMEMADDRESS) :: cptr
    integer(I4B) :: ipos
    ! -- formats
    !
    ! -- determine memory type
    ipos = index(this%memtype, ' (')
    if (ipos < 1) then
      ipos = 16
    else
      ipos = min(16, ipos - 1)
    end if
    cmem = this%memtype(1:ipos)
    !
    ! -- Set pointer string
    cptr = '--'
    if (.not. this%master) then
      cptr = create_mem_address(this%masterPath, this%mastername)
    end if
    !
    ! -- write data to the table
    call memtab%add_term(this%path)
    call memtab%add_term(this%name)
    call memtab%add_term(cmem)
    call memtab%add_term(this%isize)
    call memtab%add_term(cptr)

Here is the call graph for this function: