MODFLOW 6  version 6.7.0.dev0
USGS Modular Hydrologic Model
All Classes Namespaces Files Functions Variables Enumerator Pages
prt-mip.f90
Go to the documentation of this file.
2 
3  use kindmodule, only: dp, i4b, lgp
7  use basedismodule, only: disbasetype
11  use simmodule, only: store_error
13 
14  implicit none
15  private
16  public :: prtmiptype
17  public :: mip_cr
18 
19  type, extends(numericalpackagetype) :: prtmiptype
20  real(dp), dimension(:), pointer, contiguous :: porosity => null() !< aquifer porosity
21  real(dp), dimension(:), pointer, contiguous :: retfactor => null() !< retardation factor
22  integer(I4B), dimension(:), pointer, contiguous :: izone => null() !< zone number
23  contains
24  procedure :: mip_ar
25  procedure :: mip_da
26  procedure :: allocate_scalars
27  procedure, private :: allocate_arrays
28  end type prtmiptype
29 
30 contains
31 
32  !> @brief Create a model input object
33  subroutine mip_cr(mip, name_model, input_mempath, inunit, iout, dis)
34  ! -- dummy
35  type(prtmiptype), pointer :: mip
36  character(len=*), intent(in) :: name_model
37  character(len=*), intent(in) :: input_mempath
38  integer(I4B), intent(in) :: inunit
39  integer(I4B), intent(in) :: iout
40  class(disbasetype), pointer, intent(in) :: dis
41  ! -- formats
42  character(len=*), parameter :: fmtheader = &
43  "(1x, /1x, 'MIP -- MODEL INPUT PACKAGE', &
44  &' INPUT READ FROM MEMPATH: ', A, /)"
45  !
46  ! -- Create the object
47  allocate (mip)
48  !
49  ! -- Create name and memory path
50  call mip%set_names(1, name_model, 'MIP', 'MIP', input_mempath)
51  !
52  ! -- Allocate scalars
53  call mip%allocate_scalars()
54  !
55  ! -- Set variables
56  mip%inunit = inunit
57  mip%iout = iout
58  !
59  ! -- Set pointers
60  mip%dis => dis
61  !
62  ! -- Print a message identifying the package if enabled
63  if (inunit > 0) &
64  write (iout, fmtheader) input_mempath
65 
66  end subroutine mip_cr
67 
68  !> @brief Deallocate memory
69  subroutine mip_da(this)
70  class(prtmiptype) :: this
71  !
72  ! -- Deallocate input memory
73  call memorystore_remove(this%name_model, 'MIP', idm_context)
74  !
75  ! -- Deallocate parent package
76  call this%NumericalPackageType%da()
77  !
78  ! -- Deallocate arrays
79  call mem_deallocate(this%porosity)
80  call mem_deallocate(this%retfactor)
81  call mem_deallocate(this%izone)
82 
83  end subroutine mip_da
84 
85  subroutine allocate_scalars(this)
86  class(prtmiptype) :: this
87  call this%NumericalPackageType%allocate_scalars()
88  end subroutine allocate_scalars
89 
90  !> @brief Allocate arrays
91  subroutine allocate_arrays(this, nodes)
92  class(prtmiptype) :: this
93  integer(I4B), intent(in) :: nodes
94  ! -- local
95  integer(I4B) :: i
96  !
97  ! -- Allocate
98  call mem_allocate(this%porosity, nodes, 'POROSITY', this%memoryPath)
99  call mem_allocate(this%retfactor, nodes, 'RETFACTOR', this%memoryPath)
100  call mem_allocate(this%izone, nodes, 'IZONE', this%memoryPath)
101  !
102  do i = 1, nodes
103  this%porosity(i) = dzero
104  this%retfactor(i) = done
105  this%izone(i) = 0
106  end do
107 
108  end subroutine allocate_arrays
109 
110  !> @ brief Initialize package inputs
111  subroutine mip_ar(this)
112  ! -- dummy variables
113  class(prtmiptype), intent(inout) :: this !< PrtMipType object
114  ! -- local variables
115  character(len=LINELENGTH) :: errmsg
116  type(prtmipparamfoundtype) :: found
117  integer(I4B), dimension(:), pointer, contiguous :: map => null()
118  !
119  ! -- set map to convert user input data into reduced data
120  if (this%dis%nodes < this%dis%nodesuser) map => this%dis%nodeuser
121  !
122  ! -- Allocate arrays
123  call this%allocate_arrays(this%dis%nodes)
124  !
125  ! -- Source array inputs from IDM
126  call mem_set_value(this%porosity, 'POROSITY', this%input_mempath, &
127  map, found%porosity)
128  call mem_set_value(this%retfactor, 'RETFACTOR', this%input_mempath, &
129  map, found%retfactor)
130  call mem_set_value(this%izone, 'IZONE', this%input_mempath, map, &
131  found%izone)
132  !
133  ! -- Ensure POROSITY was found
134  if (.not. found%porosity) then
135  write (errmsg, '(a)') 'Error in GRIDDATA block: POROSITY not found'
136  call store_error(errmsg)
137  end if
138 
139  end subroutine mip_ar
140 
141 end module prtmipmodule
This module contains block parser methods.
Definition: BlockParser.f90:7
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
real(dp), parameter done
real constant 1
Definition: Constants.f90:76
This module defines variable data types.
Definition: kind.f90:8
subroutine, public memorystore_remove(component, subcomponent, context)
This module contains the base numerical package type.
subroutine allocate_scalars(this)
Definition: prt-mip.f90:86
subroutine allocate_arrays(this, nodes)
Allocate arrays.
Definition: prt-mip.f90:92
subroutine mip_da(this)
Deallocate memory.
Definition: prt-mip.f90:70
subroutine, public mip_cr(mip, name_model, input_mempath, inunit, iout, dis)
Create a model input object.
Definition: prt-mip.f90:34
subroutine mip_ar(this)
@ brief Initialize package inputs
Definition: prt-mip.f90:112
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=linelength) idm_context