feat(memory): fully implement storing of strings and 1d string arrays (…

…MODFLOW-USGS#966)

src/Exchange/DisConnExchange.f90

@@ -3,7 +3,7 @@ module DisConnExchangeModule
   use SimVariablesModule, only: errmsg
   use ConstantsModule, only: LENAUXNAME, LENBOUNDNAME, LINELENGTH
   use ListModule, only: ListType
-  use MemoryManagerModule, only: mem_allocate
+  use MemoryManagerModule, only: mem_allocate, mem_reallocate
   use BlockParserModule, only: BlockParserType
   use NumericalModelModule, only: NumericalModelType
   use NumericalExchangeModule, only: NumericalExchangeType
@@ -90,7 +90,7 @@ function parse_option(this, keyword, iout) result(parsed)
       lloc = 1
       call urdaux(this%naux, this%parser%iuactive, iout, lloc, istart, &
                   istop, caux, line, 'GWF_GWF_Exchange')
-      call mem_allocate(this%auxname, LENAUXNAME, this%naux, &
+      call mem_reallocate(this%auxname, LENAUXNAME, this%naux, &
                         'AUXNAME', trim(this%memoryPath))
       do n = 1, this%naux
         this%auxname(n) = caux(n)
@@ -316,6 +316,9 @@ subroutine allocate_scalars(this)
     call mem_allocate(this%ixt3d, 'IXT3D', this%memoryPath)
     call mem_allocate(this%iprpak, 'IPRPAK', this%memoryPath)
     call mem_allocate(this%inamedbound, 'INAMEDBOUND', this%memoryPath)
+
+    call mem_allocate(this%auxname, LENAUXNAME, 0, &
+                      'AUXNAME', trim(this%memoryPath))
 
     this%nexg = 0
     this%naux = 0
@@ -332,7 +335,6 @@ end subroutine allocate_scalars
   !! connected nodes @param nexg
   !<
   subroutine allocate_arrays(this)
-    use MemoryManagerModule, only: mem_allocate
     class(DisConnExchangeType) :: this !< instance of exchange object
 
     call mem_allocate(this%nodem1, this%nexg, 'NODEM1', this%memoryPath)

src/Model/GroundWaterFlow/gwf3csub8.f90

@@ -597,7 +597,7 @@ end subroutine csub_ar
   subroutine read_options(this)
     ! -- modules
     use ConstantsModule, only: MAXCHARLEN, DZERO, MNORMAL
-    use MemoryManagerModule, only: mem_allocate
+    use MemoryManagerModule, only: mem_reallocate
     use OpenSpecModule, only: access, form
     use InputOutputModule, only: getunit, urdaux, openfile
     ! -- dummy variables
@@ -664,8 +664,8 @@ subroutine read_options(this)
           lloc = 1
           call urdaux(this%naux, this%parser%iuactive, this%iout, lloc, &
                       istart, istop, caux, line, this%packName)
-          call mem_allocate(this%auxname, LENAUXNAME, this%naux, &
-                            'AUXNAME', this%memoryPath)
+          call mem_reallocate(this%auxname, LENAUXNAME, this%naux, &
+                              'AUXNAME', this%memoryPath)
           do n = 1, this%naux
             this%auxname(n) = caux(n)
           end do
@@ -1165,6 +1165,9 @@ subroutine csub_allocate_scalars(this)
     ! -- allocate TS object
     allocate (this%TsManager)
     !
+    ! -- allocate text strings
+    call mem_allocate(this%auxname, LENAUXNAME, 0, 'AUXNAME', this%memoryPath)
+    !
     ! -- initialize values
     this%istounit = 0
     this%inobspkg = 0
@@ -1350,6 +1353,10 @@ subroutine csub_allocate_arrays(this)
     if (this%inamedbound /= 0) then
       call mem_allocate(this%boundname, LENBOUNDNAME, this%ninterbeds, &
                         'BOUNDNAME', trim(this%memoryPath))
+    else
+      call mem_allocate(this%boundname, LENBOUNDNAME, 1, &
+                  'BOUNDNAME', trim(this%memoryPath))
+
     end if
     !
     ! -- allocate the nodelist and bound arrays

src/Utilities/Memory/Memory.f90

@@ -23,9 +23,11 @@ module MemoryTypeModule
     integer(I4B)                                           :: isize                  !< size of the array
     integer(I4B)                                           :: set_handler_idx = 0    !< index of side effect handler for external access
     logical(LGP)                                           :: master = .true.        !< master copy, others point to this one
+    character(len=:), pointer                              :: strsclr     => null()  !< pointer to the character string
     logical(LGP), pointer                                  :: logicalsclr => null()  !< pointer to the logical
     integer(I4B), pointer                                  :: intsclr     => null()  !< pointer to the integer
     real(DP), pointer                                      :: dblsclr     => null()  !< pointer to the double
+    character(len=:), dimension(:), pointer, contiguous    :: astr1d      => null()  !< pointer to the 1d character string array
     integer(I4B), dimension(:), pointer, contiguous        :: aint1d      => null()  !< pointer to 1d integer array
     integer(I4B), dimension(:, :), pointer, contiguous     :: aint2d      => null()  !< pointer to 2d integer array
     integer(I4B), dimension(:, :, :), pointer, contiguous  :: aint3d      => null()  !< pointer to 3d integer array
@@ -79,9 +81,11 @@ function mt_associated(this) result(al)
     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.

src/Utilities/Memory/MemoryManager.f90

@@ -405,6 +405,7 @@ subroutine allocate_str(sclr, ilen, name, mem_path)
     allocate(mt)
     !
     ! -- set memory type
+    mt%strsclr => sclr
     mt%isize = ilen
     mt%name = name
     mt%path = mem_path
@@ -419,9 +420,9 @@ end subroutine allocate_str
 
   !> @brief Allocate a 1-dimensional defined length string array 
   !<
-  subroutine allocate_str1d(astr, ilen, nrow, name, mem_path)
+  subroutine allocate_str1d(astr1d, ilen, nrow, name, mem_path)
     integer(I4B), intent(in) :: ilen                                                !< string length
-    character(len=ilen), dimension(:), pointer, contiguous, intent(inout) :: astr   !< variable for allocation
+    character(len=ilen), dimension(:), pointer, contiguous, intent(inout) :: astr1d !< variable for allocation
     integer(I4B), intent(in) :: nrow                                                !< number of strings in array
     character(len=*), intent(in) :: name                                            !< variable name
     character(len=*), intent(in) :: mem_path                                        !< path where the variable is stored
@@ -450,7 +451,7 @@ subroutine allocate_str1d(astr, ilen, nrow, name, mem_path)
     isize = ilen * nrow
     !
     ! -- allocate defined length string array
-    allocate(character(len=ilen) :: astr(nrow), stat=istat, errmsg=errmsg)
+    allocate(character(len=ilen) :: astr1d(nrow), stat=istat, errmsg=errmsg)
     !
     ! -- check for error condition
     if (istat /= 0) then
@@ -459,7 +460,7 @@ subroutine allocate_str1d(astr, ilen, nrow, name, mem_path)
     !
     ! -- fill deferred length string with empty string
     do n = 1, nrow
-      astr(n) = string
+      astr1d(n) = string
     end do
     !
     ! -- update counter
@@ -469,6 +470,7 @@ subroutine allocate_str1d(astr, ilen, nrow, name, mem_path)
     allocate(mt)
     !
     ! -- set memory type
+    mt%astr1d => astr1d
     mt%isize = isize
     mt%name = name
     mt%path = mem_path
@@ -1678,18 +1680,34 @@ end subroutine reassignptr_dbl2d
   !<
   subroutine deallocate_str(sclr, name, mem_path)
     character(len=*), pointer, intent(inout) :: sclr  !< pointer to string
-    character(len=*), intent(in) :: name              !< variable name
-    character(len=*), intent(in) :: mem_path          !< path where variable is stored
+    character(len=*), intent(in), optional :: name              !< variable name
+    character(len=*), intent(in), optional :: mem_path          !< path where variable is stored
     ! -- local
     type(MemoryType), pointer :: mt
     logical(LGP) :: found
+    integer(I4B) :: ipos
     ! -- code
-    if (associated(sclr)) then
-      call get_from_memorylist(name, mem_path, mt, found, check=.FALSE.)
-      if (.not. found) then
-        call store_error('Programming error in deallocate_str.', terminate=.TRUE.)
-      else
+    if (present(name) .and. present(mem_path)) then
+      call get_from_memorylist(name, mem_path, mt, found)
+      nullify(mt%strsclr)
+    else
+      found = .false.
+      do ipos = 1, memorylist%count()
+        mt => memorylist%Get(ipos)
+        if (associated(mt%strsclr, sclr)) then
+          nullify(mt%strsclr)
+          found = .true.
+          exit
+        end if
+      end do
+    end if
+    if (.not. found) then
+      call store_error('Programming error in deallocate_str.', terminate=.TRUE.)
+    else
+      if (mt%master) then
         deallocate(sclr)
+      else
+        nullify(sclr)
       end if
     end if
     !
@@ -1701,23 +1719,38 @@ end subroutine deallocate_str
   !!
   !! @todo confirm this description versus the previous doc
   !<
-  subroutine deallocate_str1d(astr, name, mem_path)
-    character(len=*), dimension(:), pointer, contiguous, intent(inout) :: astr  !< array of strings
-    character(len=*), intent(in) :: name                                        !< variable name
-    character(len=*), intent(in) :: mem_path                                    !< path where variable is stored
+  subroutine deallocate_str1d(astr1d, name, mem_path)
+    character(len=*), dimension(:), pointer, contiguous, intent(inout) :: astr1d !< array of strings
+    character(len=*), optional, intent(in) :: name                               !< variable name
+    character(len=*), optional, intent(in) :: mem_path                           !< path where variable is stored
     ! -- local
     type(MemoryType), pointer :: mt
     logical(LGP) :: found
+    integer(I4B) :: ipos
     ! -- code
-    if (associated(astr)) then
-      call get_from_memorylist(name, mem_path, mt, found, check=.FALSE.)
-      if (.not. found) then
-        errmsg = "Programming error in deallocate_str1d. Variable '" //          &
-          trim(name) // "' in '" // trim(mem_path) // "' is not "    //          &
-          "present in the memory manager but is associated."
-        call store_error(errmsg, terminate=.TRUE.)
+    !
+    ! -- process optional variables
+    if (present(name) .and. present(mem_path)) then
+      call get_from_memorylist(name, mem_path, mt, found)
+      nullify(mt%astr1d)
+    else
+      found = .false.
+      do ipos = 1, memorylist%count()
+        mt => memorylist%Get(ipos)
+        if (associated(mt%astr1d, astr1d)) then
+          nullify(mt%astr1d)
+          found = .true.
+          exit
+        end if
+      end do
+    end if
+    if (.not. found .and. size(astr1d) > 0 ) then
+      call store_error('programming error in deallocate_str1d', terminate=.TRUE.)
+    else
+      if (mt%master) then
+        deallocate(astr1d)
       else
-        deallocate(astr)
+        nullify(astr1d)
       end if
     end if
     !