Fix for gfortran on windows using the msvcrt runtime

src/Model/ModelUtilities/Xt3dInterface.f90

@@ -1150,7 +1150,10 @@ end subroutine allocate_arrays
   !> @brief Allocate and populate iallpc array. Set lamatsaved.
   subroutine xt3d_iallpc(this)
     ! -- modules
-    use MemoryManagerModule, only: mem_allocate, mem_deallocate
+    use MemoryManagerModule, only: mem_allocate, &
+                                   mem_deallocate, &
+                                   mem_contains, &
+                                   mem_setptr
     ! -- dummy
     class(Xt3dType) :: this
     ! -- local
@@ -1160,11 +1163,20 @@ subroutine xt3d_iallpc(this)
     !
     if (this%ixt3d == 2) then
       this%lamatsaved = .false.
-      call mem_allocate(this%iallpc, 0, 'IALLPC', this%memoryPath)
+      if (mem_contains('IALLPC', this%memoryPath)) then
+        call mem_setptr(this%iallpc, 'IALLPC', this%memoryPath)
+      else
+        call mem_allocate(this%iallpc, 0, 'IALLPC', this%memoryPath)
+      end if
     else
       !
       ! -- allocate memory for iallpc and initialize to 1
-      call mem_allocate(this%iallpc, this%dis%nodes, 'IALLPC', this%memoryPath)
+      if (mem_contains('IALLPC', this%memoryPath)) then
+        call mem_setptr(this%iallpc, 'IALLPC', this%memoryPath)
+      else
+        call mem_allocate(this%iallpc, this%dis%nodes, 'IALLPC', this%memoryPath)
+      end if
+
       do n = 1, this%dis%nodes
         this%iallpc(n) = 1
       end do

src/Utilities/Idm/InputLoadType.f90

@@ -166,7 +166,7 @@ end subroutine static_destroy
   subroutine dynamic_init(this, mf6_input, component_name, component_input_name, &
                           input_name, iperblock, iout)
     use SimVariablesModule, only: errmsg
-    use MemoryManagerModule, only: mem_allocate
+    use MemoryManagerModule, only: mem_allocate, mem_setptr, mem_contains
     use InputDefinitionModule, only: InputParamDefinitionType
     ! -- dummy
     class(DynamicPkgLoadType), intent(inout) :: this
@@ -188,8 +188,21 @@ subroutine dynamic_init(this, mf6_input, component_name, component_input_name, &
     nullify (idt)
     !
     ! -- allocate scalars
-    call mem_allocate(this%iper, 'IPER', mf6_input%mempath)
-    call mem_allocate(this%ionper, 'IONPER', mf6_input%mempath)
+    this%iper => null()
+    this%ionper => null()
+
+    if (mem_contains('IPER', mf6_input%mempath)) then
+      call mem_setptr(this%iper, 'IPER', mf6_input%mempath)
+    else
+      call mem_allocate(this%iper, 'IPER', mf6_input%mempath)
+    end if
+
+    if (mem_contains('IONPER', mf6_input%mempath)) then
+      call mem_setptr(this%ionper, 'IONPER', mf6_input%mempath)
+    else
+      call mem_allocate(this%ionper, 'IONPER', mf6_input%mempath)
+    end if
+
     !
     ! -- initialize
     this%iper = 0

src/Utilities/KeyValueList.f90

@@ -10,7 +10,7 @@ module KeyValueListModule
   !!
   !<
   type KeyValueNodeType
-    type(KeyValueNodeType), allocatable :: next !< the next node
+    type(KeyValueNodeType), pointer :: next !< the next node
     character(len=:), allocatable :: key !< the key
     class(*), pointer :: value !< the value
   end type KeyValueNodeType
@@ -20,7 +20,7 @@ module KeyValueListModule
   !! Items in this list can be retrieved by using a key.
   !<
   type KeyValueListType
-    type(KeyValueNodeType), allocatable :: first !< first item in the list
+    type(KeyValueNodeType), pointer :: first => null() !< first item in the list
     integer(I4B) :: size = 0 !< number of items in the list
   contains
     procedure :: add
@@ -47,27 +47,28 @@ function predicate(node, index, arg) result(res)
 
   !> @brief Add a key-value pair to the list
   !!
+  !! The list uses an 'insert before' approach for adding items
   !<
-  subroutine add(this, key, value)
+  subroutine add(this, key, val)
     ! -- dummy
     class(KeyValueListType), intent(inout), target :: this
-    character(len=*) :: key
-    class(*), pointer, intent(inout) :: value
+    character(len=:), allocatable :: key
+    class(*), pointer, intent(inout) :: val
     ! -- local
-    type(KeyValueNodeType), pointer :: last_node
     type(KeyValueNodeType), pointer :: new_node
 
-    if (.not. allocated(this%first)) then
+    if (.not. associated(this%first)) then
       allocate (this%first)
       new_node => this%first
+      new_node%next => null()
     else
-      last_node => this%find_node(last_node_predicate)
-      allocate (last_node%next)
-      new_node => last_node%next
+      allocate (new_node)
+      new_node%next => this%first
+      this%first => new_node
     end if
 
     new_node%key = key
-    new_node%value => value
+    new_node%value => val
 
     this%size = this%size + 1
 
@@ -142,6 +143,7 @@ subroutine clear(this)
     class(KeyValueListType), target, intent(inout) :: this
 
     call clear_node(this%first)
+    this%first => null()
     this%size = 0
 
   end subroutine
@@ -152,28 +154,18 @@ subroutine clear(this)
   !<
   recursive subroutine clear_node(node)
     ! -- dummy
-    type(KeyValueNodeType), allocatable :: node
+    type(KeyValueNodeType), pointer :: node
 
-    if (allocated(node)) then
+    if (associated(node)) then
       call clear_node(node%next)
+      nullify (node%value)
+      nullify (node%next)
+      deallocate (node%key)
       deallocate (node)
     end if
 
   end subroutine clear_node
 
-  !> @brief Predicate that checks if the current node is the last node of the list
-  !!
-  !<
-  function last_node_predicate(node, index, arg) result(res)
-    ! -- dummy
-    type(KeyValueNodeType), intent(in), pointer :: node
-    integer(I4B) :: index
-    class(*), optional, pointer :: arg
-    logical res
-
-    res = .not. allocated(node%next)
-  end function
-
   !> @brief Predicate that checks if the key of the current node equals the provided key
   !!
   !<

src/Utilities/KeyValueListIterator.f90

@@ -42,9 +42,9 @@ function has_next(this) result(res)
     type(logical) :: res
 
     if (associated(this%current_node)) then
-      res = allocated(this%current_node%next)
+      res = associated(this%current_node%next)
     else
-      res = allocated(this%container%first)
+      res = associated(this%container%first)
     end if
 
   end function

src/Utilities/Memory/Memory.f90

@@ -121,13 +121,13 @@ function mt_ptr_sclr_associated(this, ptr) result(al)
 
     al = .false.
     mem => this%strsclr
-    if (associated(mem, ptr)) al = .true.
+    if (loc(mem) == loc(ptr)) al = .true.
     mem => this%logicalsclr
-    if (associated(mem, ptr)) al = .true.
+    if (loc(mem) == loc(ptr)) al = .true.
     mem => this%intsclr
-    if (associated(mem, ptr)) al = .true.
+    if (loc(mem) == loc(ptr)) al = .true.
     mem => this%dblsclr
-    if (associated(mem, ptr)) al = .true.
+    if (loc(mem) == loc(ptr)) al = .true.
   end function mt_ptr_sclr_associated
 
   !> @brief Check if the MemoryType is associated to pointer
@@ -143,13 +143,13 @@ function mt_ptr_1d_associated(this, ptr) result(al)
 
     al = .false.
     mem => this%astr1d
-    if (associated(mem, ptr)) al = .true.
+    if (loc(mem) == loc(ptr)) al = .true.
     mem => this%aint1d
-    if (associated(mem, ptr)) al = .true.
+    if (loc(mem) == loc(ptr)) al = .true.
     mem => this%adbl1d
-    if (associated(mem, ptr)) al = .true.
+    if (loc(mem) == loc(ptr)) al = .true.
     mem => this%acharstr1d
-    if (associated(mem, ptr)) al = .true.
+    if (loc(mem) == loc(ptr)) al = .true.
   end function mt_ptr_1d_associated
 
   !> @brief Check if the MemoryType is associated to pointer
@@ -166,9 +166,9 @@ function mt_ptr_2d_associated(this, ptr) result(al)
     al = .false.
 
     mem => this%aint2d
-    if (associated(mem, ptr)) al = .true.
+    if (loc(mem) == loc(ptr)) al = .true.
     mem => this%adbl2d
-    if (associated(mem, ptr)) al = .true.
+    if (loc(mem) == loc(ptr)) al = .true.
   end function mt_ptr_2d_associated
 
   !> @brief Check if the MemoryType is associated to pointer
@@ -185,9 +185,9 @@ function mt_ptr_3d_associated(this, ptr) result(al)
     al = .false.
 
     mem => this%aint3d
-    if (associated(mem, ptr)) al = .true.
+    if (loc(mem) == loc(ptr)) al = .true.
     mem => this%adbl3d
-    if (associated(mem, ptr)) al = .true.
+    if (loc(mem) == loc(ptr)) al = .true.
   end function mt_ptr_3d_associated
 
   subroutine mt_deallocate(this)

src/Utilities/Memory/MemoryHashTable.f90

@@ -2,6 +2,7 @@ module MemoryHashTableModule
   use MemoryTypeModule, only: MemoryType
   use PtrHashTableModule, only: PtrHashTableType
   use KindModule, only: DP, I4B
+  use SimModule, only: store_warning
 
   implicit none
   private
@@ -33,10 +34,17 @@ subroutine add(this, mt)
     ! -- local
     class(*), pointer :: obj => null() !< void pointer to MemoryType
     character(len=:), allocatable :: full_path !< concatenated path of the memory path and name
+    type(MemoryType), pointer :: existing_mt
 
-    obj => mt
-    full_path = trim(mt%path)//trim(mt%name)
+    full_path = trim(mt%path)//"/"//trim(mt%name)
+
+    existing_mt => this%get(mt%name, mt%path)
+    if (associated(existing_mt)) then
+      call store_warning( &
+        "Already existing variable being added to the MemoryMananger-"//full_path)
+    end if
 
+    obj => mt
     call this%hash_table%add(full_path, obj)
 
   end subroutine add
@@ -55,9 +63,9 @@ function get(this, name, mem_path) result(res)
     type(MemoryType), pointer :: res !< found MemoryType
     ! -- local
     class(*), pointer :: obj !< void pointer to MemoryType
-    character(len=len_trim(name) + len_trim(mem_path)) :: full_path !< concatenated path of the memory path and name
+    character(len=len_trim(name) + len_trim(mem_path) + 1) :: full_path !< concatenated path of the memory path and name
 
-    full_path = trim(mem_path)//trim(name)
+    full_path = trim(mem_path)//"/"//trim(name)
     obj => this%hash_table%get(full_path)
 
     res => null()