From 636aa5daa2285e82860b09c294c0326e6377a979 Mon Sep 17 00:00:00 2001 From: wpbonelli Date: Mon, 20 Nov 2023 14:05:43 -0500 Subject: [PATCH] update idm integration and cleanup in mip & prp pkgs --- src/Model/ParticleTracking/prt1mip.f90 | 51 ++++-------- src/Model/ParticleTracking/prt1prp1.f90 | 103 ++++++------------------ 2 files changed, 37 insertions(+), 117 deletions(-) diff --git a/src/Model/ParticleTracking/prt1mip.f90 b/src/Model/ParticleTracking/prt1mip.f90 index e573f35ea10..583c779c19a 100644 --- a/src/Model/ParticleTracking/prt1mip.f90 +++ b/src/Model/ParticleTracking/prt1mip.f90 @@ -5,6 +5,11 @@ module PrtMipModule use NumericalPackageModule, only: NumericalPackageType use BlockParserModule, only: BlockParserType use BaseDisModule, only: DisBaseType + use MemoryManagerModule, only: mem_allocate, mem_deallocate + use MemoryManagerExtModule, only: mem_set_value, memorylist_remove + use SimVariablesModule, only: idm_context + use SimModule, only: store_error + use PrtMipInputModule, only: PrtMipParamFoundType ! implicit none private @@ -25,8 +30,6 @@ module PrtMipModule !> @brief Create a model input object subroutine mip_cr(mip, name_model, input_mempath, inunit, iout, dis) - ! -- modules - use MemoryManagerExtModule, only: mem_set_value ! -- dummy type(PrtMipType), pointer :: mip character(len=*), intent(in) :: name_model @@ -34,18 +37,16 @@ subroutine mip_cr(mip, name_model, input_mempath, inunit, iout, dis) integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout class(DisBaseType), pointer, intent(in) :: dis - ! -- locals - logical(LGP) :: found_fname ! -- formats character(len=*), parameter :: fmtheader = & - "(1x, /1x, 'NPF -- MODEL INPUT PACKAGE, VERSION 1, 08/08/2023', & + "(1x, /1x, 'MIP -- MODEL INPUT PACKAGE', & &' INPUT READ FROM MEMPATH: ', A, /)" ! ! -- Create the object allocate (mip) ! ! -- create name and memory path - call mip%set_names(1, name_model, 'MIP', 'MIP') + call mip%set_names(1, name_model, 'MIP', 'MIP', input_mempath) ! ! -- Allocate scalars call mip%allocate_scalars() @@ -58,27 +59,17 @@ subroutine mip_cr(mip, name_model, input_mempath, inunit, iout, dis) ! -- Set pointers mip%dis => dis ! - ! -- set name of input file - call mem_set_value(mip%input_fname, 'INPUT_FNAME', mip%input_mempath, & - found_fname) - ! ! -- check if mip is enabled if (inunit > 0) then ! ! -- Print a message identifying the model input package. write (iout, fmtheader) input_mempath end if - ! - ! -- Return - return + end subroutine mip_cr - !> @brief deallocate + !> @brief Deallocate memory subroutine mip_da(this) - ! -- modules - use MemoryManagerExtModule, only: memorylist_remove - use SimVariablesModule, only: idm_context - use MemoryManagerModule, only: mem_deallocate ! -- dummy class(PrtMipType) :: this ! @@ -88,21 +79,15 @@ subroutine mip_da(this) ! -- Deallocate parent package call this%NumericalPackageType%da() ! - ! -- scalars - ! - ! -- arrays + ! -- Deallocate arrays call mem_deallocate(this%porosity) call mem_deallocate(this%retfactor) call mem_deallocate(this%izone) - ! - ! -- return - return + end subroutine mip_da !> @brief Allocate arrays subroutine allocate_arrays(this, nodes) - ! -- modules - use MemoryManagerModule, only: mem_allocate ! -- dummy class(PrtMipType) :: this integer(I4B), intent(in) :: nodes @@ -119,17 +104,11 @@ subroutine allocate_arrays(this, nodes) this%retfactor(i) = DONE this%izone(i) = 0 end do - ! - ! -- Return - return + end subroutine allocate_arrays - !> @ brief Allocate and read model input + !> @ brief Initialize package inputs subroutine mip_ar(this) - ! -- modules - use SimModule, only: store_error - use MemoryManagerExtModule, only: mem_set_value - use PrtMipInputModule, only: PrtMipParamFoundType ! -- dummy variables class(PrtMipType), intent(inout) :: this !< PrtMipType object ! -- local variables @@ -156,9 +135,7 @@ subroutine mip_ar(this) write (errmsg, '(a)') 'Error in GRIDDATA block: POROSITY not found' call store_error(errmsg) end if - ! - ! -- return - return + end subroutine mip_ar end module PrtMipModule diff --git a/src/Model/ParticleTracking/prt1prp1.f90 b/src/Model/ParticleTracking/prt1prp1.f90 index 949ee5755e4..8731966e311 100644 --- a/src/Model/ParticleTracking/prt1prp1.f90 +++ b/src/Model/ParticleTracking/prt1prp1.f90 @@ -20,6 +20,7 @@ module PrtPrpModule use GlobalDataModule use TrackModule, only: TrackControlType use GeomUtilModule, only: point_in_polygon + use MemoryManagerModule, only: mem_allocate, mem_deallocate implicit none @@ -103,7 +104,7 @@ subroutine prp_create(packobj, id, ibcnum, inunit, iout, namemodel, & type(PrtPrpType), pointer :: prpobj ! -- formats character(len=*), parameter :: fmtheader = & - "(1x, /1x, 'PRP -- Particle Release Point package,', & + "(1x, /1x, 'PRP -- PARTICLE RELEASE POINT PACKAGE', & &' INPUT READ FROM MEMPATH: ', A, /)" ! ! -- allocate the object and assign values to object variables @@ -136,16 +137,11 @@ subroutine prp_create(packobj, id, ibcnum, inunit, iout, namemodel, & ! -- Print a message identifying the node property flow package. write (iout, fmtheader) mempath end if - ! - ! -- return - return + end subroutine prp_create !> @brief Deallocate memory - !< subroutine prp_da(this) - ! -- modules - use MemoryManagerModule, only: mem_deallocate ! -- dummy class(PrtPrpType) :: this ! @@ -188,13 +184,10 @@ subroutine prp_da(this) ! -- deallocate step, fraction, and reference time arrays if (allocated(this%kstp_list_rls)) deallocate (this%kstp_list_rls) if (allocated(this%frac_list_rls)) deallocate (this%frac_list_rls) - ! - ! -- return - return + end subroutine prp_da !> @ brief Set pointers to model variables - !< subroutine prp_set_pointers(this, ibound, izone, trackctl) ! -- dummy variables class(PrtPrpType) :: this @@ -205,15 +198,11 @@ subroutine prp_set_pointers(this, ibound, izone, trackctl) this%ibound => ibound this%izone => izone this%trackctl => trackctl - ! - return + end subroutine prp_set_pointers !> @brief Allocate arrays - !< subroutine prp_allocate_arrays(this, nodelist, auxvar) - ! -- modules - use MemoryManagerModule, only: mem_allocate ! -- dummy class(PrtPrpType) :: this integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist @@ -254,15 +243,11 @@ subroutine prp_allocate_arrays(this, nodelist, auxvar) ! -- The following array is allocatable (not a pointer) so it can be resized using if (allocated(this%frac_list_rls)) deallocate (this%frac_list_rls) allocate (this%frac_list_rls(1)) - ! - ! -- Return - return + end subroutine prp_allocate_arrays - !> @brief Allocate scalar members - !< + !> @brief Allocate scalars subroutine prp_allocate_scalars(this) - use MemoryManagerModule, only: mem_allocate ! -- dummy class(PrtPrpType) :: this ! @@ -308,13 +293,10 @@ subroutine prp_allocate_scalars(this) this%itrkout = 0 this%itrkhdr = 0 this%itrkcsv = 0 - ! - ! -- return - return + end subroutine prp_allocate_scalars !> @ brief Allocate and read period data - !< subroutine prp_ar(this) ! -- dummy variables class(PrtPrpType), intent(inout) :: this @@ -345,9 +327,7 @@ subroutine prp_ar(this) ! allocate(this%pakmvrobj) ! call this%pakmvrobj%ar(this%maxbound, this%maxbound, this%memoryPath) ! endif - ! ! - ! -- return - return + end subroutine prp_ar !> @brief Advance a time step & release new particles if appropriate @@ -360,6 +340,7 @@ end subroutine prp_ar !! first stress period. If finer-grained period-level scheduling is !! used, this routine will release particles in the period and time !! step specified by the period block configuration. + !< subroutine prp_ad(this) ! -- modules use TdisModule, only: kper, kstp, totimc, delt @@ -528,9 +509,7 @@ subroutine prp_ad(this) this%massrls(nps) = this%massrls(nps) + DONE end do end if - ! - ! -- return - return + end subroutine prp_ad !> @ brief Read and prepare period data for particle input @@ -755,17 +734,10 @@ subroutine prp_rp(this) if (n > 0) write (this%iout, fmt_fracs) this%frac_list_rls write (this%iout, '(A)') end if - ! - ! -- return - return + end subroutine prp_rp - !> @ brief Calculate simrate. - !! - !! Calculate the flow between package and the model and store in the - !! simvals variable. - !! - !< + !> @ brief Calculate flow between package and model. subroutine prp_cq_simrate(this, hnew, flowja, imover) ! -- modules use TdisModule, only: delt @@ -808,13 +780,10 @@ subroutine prp_cq_simrate(this, hnew, flowja, imover) ! end do end if - ! - ! -- return - return + end subroutine prp_cq_simrate - !> @ brief Define list heading written to iout when PRINT_INPUT option is used - !< + !> @ brief Define list heading written with PRINT_INPUT option subroutine define_listlabel(this) ! kluge note: update for PRT? class(PrtPrpType), intent(inout) :: this ! @@ -834,30 +803,17 @@ subroutine define_listlabel(this) ! kluge note: update for PRT? if (this%inamedbound == 1) then write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' end if - ! - ! -- return - return + end subroutine define_listlabel !> @brief Indicates whether observations are supported. - !! - !! Return true because PRP package supports observations. - !! Overrides BndType%bnd_obs_supported(). - !< logical function prp_obs_supported(this) - implicit none class(PrtPrpType) :: this prp_obs_supported = .true. - return end function prp_obs_supported - !> @brief Store observation type supported by PRP package. - !! - !! Overrides BndType%bnd_df_obs(). - !! - !< - subroutine prp_df_obs(this) ! kluge note: need this??? - implicit none + !> @brief Store supported observations + subroutine prp_df_obs(this) ! -- dummy class(PrtPrpType) :: this ! -- local @@ -869,13 +825,10 @@ subroutine prp_df_obs(this) ! kluge note: need this??? ! for to-mvr observation type. call this%obs%StoreObsType('to-mvr', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor - ! - ! -- return - return + end subroutine prp_df_obs - !> @brief Set options specific to PrtPrpType (overrides BndType%bnd_options) - !< + !> @brief Set options specific to PrtPrpType subroutine prp_options(this, option, found) use OpenSpecModule, only: access, form use ConstantsModule, only: MAXCHARLEN, DZERO @@ -956,15 +909,11 @@ subroutine prp_options(this, option, found) case default found = .false. end select - ! - ! -- Return - return + end subroutine prp_options !> @brief Read the packagedata for this package - !< subroutine prp_read_packagedata(this) - ! use TimeSeriesManagerModule, only: read_value_or_time_series_adv ! -- dummy class(PrtPrpType), intent(inout) :: this ! -- local @@ -1098,15 +1047,11 @@ subroutine prp_read_packagedata(this) deallocate (tstop) deallocate (nametxt) deallocate (nboundchk) - ! - ! -- return - return + end subroutine prp_read_packagedata !> @brief Read package dimensions subroutine prp_read_dimensions(this) - ! -- modules - use SimModule, only: store_error ! -- dummy class(PrtPrpType), intent(inout) :: this ! -- local @@ -1154,9 +1099,7 @@ subroutine prp_read_dimensions(this) ! ! -- read packagedata call this%prp_read_packagedata() - ! - ! -- return - return + end subroutine prp_read_dimensions end module PrtPrpModule