MODFLOW 6  version 6.5.0.dev2
MODFLOW 6 Code Documentation
Mover.f90
Go to the documentation of this file.
1 !> @brief This module contains the MvrModule Module
2 !!
3 !! This module contains the code for the low-level MvrType
4 !! object.
5 !!
6 !<
7 module mvrmodule
8 
9  use kindmodule, only: dp, i4b, lgp
13  use simvariablesmodule, only: errmsg
15 
16  implicit none
17  private
18  public :: mvrtype
19 
20  character(len=12), dimension(4) :: mvrtypes = &
21  &[character(len=12) :: 'FACTOR', 'EXCESS', 'THRESHOLD', 'UPTO']
22 
23  !> @brief Derived type for MvrType
24  !!
25  !! This derived type contains information and methods for
26  !! moving water between packages.
27  !!
28  !<
29  type mvrtype
30  character(len=LENMEMPATH) :: mem_path_src = '' !< provider package name
31  character(len=LENMEMPATH) :: mem_path_tgt = '' !< receiver package name
32  integer(I4B), pointer :: irchnrsrc => null() !< provider reach number
33  integer(I4B) :: irchnrsrcmapped !< mapped provider reach number (currently for lake outlet)
34  integer(I4B), pointer :: irchnrtgt => null() !< receiver reach number
35  integer(I4B), pointer :: imvrtype => null() !< mover type (1, 2, 3, 4) corresponds to mvrtypes
36  real(dp), pointer :: value => null() !< factor or rate depending on mvrtype
37  logical(LGP) :: is_provider_active = .true.
38  logical(LGP) :: is_receiver_active = .true.
39  real(dp) :: qpactual = dzero !< rate provided to the receiver
40  real(dp) :: qavailable = dzero !< rate available at time of providing
41  real(dp), pointer :: qtformvr_ptr => null() !< pointer to total available flow (qtformvr)
42  real(dp), pointer :: qformvr_ptr => null() !< pointer to available flow after consumed (qformvr)
43  real(dp), pointer :: qtomvr_ptr => null() !< pointer to provider flow rate (qtomvr)
44  real(dp), pointer :: qfrommvr_ptr => null() !< pointer to receiver flow rate (qfrommvr)
45  contains
46  procedure :: set_values
47  procedure :: prepare
48  procedure :: echo
49  procedure :: advance
50  procedure :: update_provider
51  procedure :: update_receiver
52  procedure :: qrcalc
53  procedure :: writeflow
54  end type mvrtype
55 
56 contains
57 
58  !> @ brief Set values from input data
59  !!
60  !! Set values and pointers for mover object.
61  !!
62  !<
63  subroutine set_values(this, mname1, pname1, id1, mname2, pname2, &
64  id2, imvrtype, value)
66  class(mvrtype) :: this
67  character(len=*), intent(in) :: mname1
68  character(len=*), intent(in) :: pname1
69  integer(I4B), intent(in), target :: id1
70  character(len=*), intent(in) :: mname2
71  character(len=*), intent(in) :: pname2
72  integer(I4B), intent(in), target :: id2
73  integer(I4B), intent(in), target :: imvrtype
74  real(DP), intent(in), target :: value
75 
76  this%mem_path_src = create_mem_path(mname1, pname1)
77  this%iRchNrSrc => id1
78  this%mem_path_tgt = create_mem_path(mname2, pname2)
79  this%iRchNrTgt => id2
80  this%imvrtype => imvrtype
81  this%value => value
82 
83  ! to be set later
84  this%iRchNrSrcMapped = -1
85 
86  return
87  end subroutine set_values
88 
89  !> @ brief Prepare object
90  !!
91  !! Set values and pointers for mover object.
92  !! pckMemPaths is an array of strings which are the memory paths for those
93  !! packages. They are composed of model names and package names. The mover
94  !! entries must be in pckMemPaths, or this routine will terminate with an error.
95  !<
96  subroutine prepare(this, inunit, pckMemPaths, pakmovers)
97  ! -- modules
99  ! -- dummy
100  class(mvrtype) :: this !< MvrType object
101  integer(I4B), intent(in) :: inunit !< input file unit number
102  character(len=LENMEMPATH), &
103  dimension(:), pointer, contiguous :: pckMemPaths !< array of strings
104  type(packagemovertype), dimension(:), pointer, contiguous :: pakmovers !< Array of package mover objects
105  ! -- local
106  real(DP), dimension(:), pointer, contiguous :: temp_ptr => null()
107  logical :: found
108  integer(I4B) :: i
109  integer(I4B) :: ipakloc1, ipakloc2
110  !
111  ! -- Check to make sure provider and receiver are not the same
112  if (this%mem_path_src == this%mem_path_tgt .and. &
113  this%iRchNrSrc == this%iRchNrTgt) then
114  call store_error('Provider and receiver are the same: '// &
115  trim(this%mem_path_src)//' : '//trim(this%mem_path_tgt))
116  call store_error_unit(inunit)
117  end if
118  !
119  ! -- Check to make sure pname1 and pname2 are both listed in pckMemPaths
120  ! pname1 is the provider package; pname2 is the receiver package
121  found = .false.
122  ipakloc1 = 0
123  do i = 1, size(pckmempaths)
124  if (this%mem_path_src == pckmempaths(i)) then
125  found = .true.
126  ipakloc1 = i
127  exit
128  end if
129  end do
130  if (.not. found) then
131  call store_error('Mover capability not activated in '//this%mem_path_src)
132  call store_error('Add "MOVER" keyword to package options block.')
133  end if
134  found = .false.
135  ipakloc2 = 0
136  do i = 1, size(pckmempaths)
137  if (this%mem_path_tgt == pckmempaths(i)) then
138  found = .true.
139  ipakloc2 = i
140  exit
141  end if
142  end do
143  if (.not. found) then
144  call store_error('Mover capability not activated in '//this%mem_path_tgt)
145  call store_error('Add "MOVER" keyword to package options block.')
146  end if
147  if (count_errors() > 0) then
148  call store_error_unit(inunit)
149  end if
150 
151  if (this%is_provider_active) then
152  !
153  ! -- Set pointer to QTOMVR array in the provider boundary package
154  temp_ptr => pakmovers(ipakloc1)%qtomvr
155  if (this%iRchNrSrc < 1 .or. this%iRchNrSrc > size(temp_ptr)) then
156  call store_error('Provider ID < 1 or greater than package size ')
157  write (errmsg, '(a,i0,a,i0)') 'Provider ID = ', this%iRchNrSrc, &
158  '; Package size = ', size(temp_ptr)
159  call store_error(trim(errmsg))
160  call store_error_unit(inunit)
161  end if
162  this%qtomvr_ptr => temp_ptr(this%iRchNrSrc)
163  !
164  ! -- Set pointer to QFORMVR array in the provider boundary package
165  temp_ptr => pakmovers(ipakloc1)%qformvr
166  this%qformvr_ptr => temp_ptr(this%iRchNrSrc)
167  !
168  ! -- Set pointer to QTFORMVR array in the provider boundary package
169  temp_ptr => pakmovers(ipakloc1)%qtformvr
170  this%qtformvr_ptr => temp_ptr(this%iRchNrSrc)
171  end if
172 
173  if (this%is_receiver_active) then
174  !
175  ! -- Set pointer to QFROMMVR array in the receiver boundary package
176  temp_ptr => pakmovers(ipakloc2)%qfrommvr
177  if (this%iRchNrTgt < 1 .or. this%iRchNrTgt > size(temp_ptr)) then
178  call store_error('Receiver ID < 1 or greater than package size ')
179  write (errmsg, '(a,i0,a,i0)') 'Receiver ID = ', this%iRchNrTgt, &
180  '; package size = ', size(temp_ptr)
181  call store_error(trim(errmsg))
182  call store_error_unit(inunit)
183  end if
184  this%qfrommvr_ptr => temp_ptr(this%iRchNrTgt)
185  end if
186  !
187  ! -- return
188  return
189  end subroutine prepare
190 
191  !> @ brief Echo data to list file
192  !!
193  !! Write mover values to output file.
194  !!
195  !<
196  subroutine echo(this, iout)
197  ! -- modules
198  ! -- dummy
199  class(mvrtype) :: this !< MvrType
200  integer(I4B), intent(in) :: iout !< unit number for output file
201  ! -- local
202  !
203  write (iout, '(4x, a, a, a, i0)') 'FROM PACKAGE: ', trim(this%mem_path_src), &
204  ' FROM ID: ', this%iRchNrSrc
205  write (iout, '(4x, a, a, a, i0)') 'TO PACKAGE: ', trim(this%mem_path_tgt), &
206  ' TO ID: ', this%iRchNrTgt
207  write (iout, '(4x, a, a, a, 1pg15.6,/)') 'MOVER TYPE: ', &
208  trim(mvrtypes(this%imvrtype)), ' ', this%value
209  !
210  ! -- return
211  return
212  end subroutine echo
213 
214  !> @ brief Advance
215  !!
216  !! Advance mover object. Does nothing now.
217  !!
218  !<
219  subroutine advance(this)
220  ! -- modules
221  ! -- dummy
222  class(mvrtype) :: this
223  ! -- local
224  !
225  ! -- return
226  return
227  end subroutine advance
228 
229  !> @ brief Formulate coefficients
230  !!
231  !! Make mover calculations for provider.
232  !!
233  !<
234  subroutine update_provider(this)
235  ! -- modules
236  ! -- dummy
237  class(mvrtype) :: this !< MvrType
238  ! -- local
239  real(DP) :: qavailable, qtanew, qpactual
240  !
241  ! -- Set qa and this%qavailable equal to available water in package (qtomvr)
242  qavailable = this%qformvr_ptr
243  qtanew = this%qtformvr_ptr
244  this%qavailable = qavailable
245  !
246  ! -- Using the mover rules, calculate how much of the available water will
247  ! be provided from the mover to the receiver.
248  qpactual = this%qrcalc(qavailable, qtanew)
249  !
250  ! -- Store qpactual
251  this%qpactual = qpactual
252  !
253  ! -- Add the calculated qpactual term directly into the provider package
254  ! qtomvr array.
255  this%qtomvr_ptr = this%qtomvr_ptr + qpactual
256  !
257  ! -- Reduce the amount of water that is available in the provider package
258  ! qformvr array.
259  this%qformvr_ptr = this%qformvr_ptr - qpactual
260  !
261  ! -- return
262  return
263  end subroutine update_provider
264 
265  !> @ brief Formulate coefficients
266  !!
267  !! Make mover calculations for receiver.
268  !!
269  !<
270  subroutine update_receiver(this)
271  class(mvrtype) :: this !< MvrType
272  ! -- Add the calculated qpactual term directly into the receiver package
273  ! qfrommvr array.
274  this%qfrommvr_ptr = this%qfrommvr_ptr + this%qpactual
275  !
276  ! -- return
277  return
278  end subroutine update_receiver
279 
280  !> @ brief Flow to receiver
281  !!
282  !! Calculate the rate of water provided to receiver.
283  !!
284  !<
285  function qrcalc(this, qa, qta) result(qr)
286  ! -- modules
287  ! -- return
288  real(dp) :: qr
289  ! -- dummy
290  class(mvrtype) :: this !< MvrType
291  real(dp), intent(in) :: qa !< actual flow
292  real(dp), intent(in) :: qta !< total available flow
293  ! -- local
294  ! -- Using the mover rules, calculate how much of the available water will
295  ! go to the receiver.
296  qr = dzero
297  ! -- Calculate qr
298  select case (this%imvrtype)
299  case (1)
300  ! -- FACTOR uses total available to make calculation, and then
301  ! limits qr by consumed available
302  if (qta > dzero) qr = qta * this%value
303  qr = min(qr, qa)
304  case (2)
305  ! -- EXCESS
306  if (qa > this%value) then
307  qr = qa - this%value
308  else
309  qr = dzero
310  end if
311  case (3)
312  ! -- THRESHOLD
313  if (this%value > qa) then
314  qr = dzero
315  else
316  qr = this%value
317  end if
318  case (4)
319  ! -- UPTO
320  if (qa > this%value) then
321  qr = this%value
322  else
323  qr = qa
324  end if
325  end select
326  !
327  ! -- return
328  return
329  end function qrcalc
330 
331  !> @ brief Write flow
332  !!
333  !! Write a line of output for this mover object.
334  !!
335  !<
336  subroutine writeflow(this, iout)
337  ! -- modules
338  ! -- dummy
339  class(mvrtype) :: this !< MvrType
340  integer(I4B), intent(in) :: iout !< output file unit number
341  ! -- local
342  character(len=*), parameter :: fmt = &
343  "(1x, a, ' ID ', i0, ' AVAILABLE ', 1(1pg15.6), &
344  &' PROVIDED ', 1(1pg15.6), ' TO ', a, ' ID ', i0)"
345  !
346  write (iout, fmt) trim(this%mem_path_src), this%iRchNrSrc, this%qavailable, &
347  this%qpactual, trim(this%mem_path_tgt), this%iRchNrTgt
348  !
349  ! -- return
350  return
351  end subroutine writeflow
352 
353 end module mvrmodule
354 
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:44
integer(i4b), parameter lenmodelname
maximum length of the model name
Definition: Constants.f90:21
integer(i4b), parameter lenauxname
maximum length of a aux variable
Definition: Constants.f90:34
integer(i4b), parameter lenboundname
maximum length of a bound name
Definition: Constants.f90:35
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:64
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
Definition: Constants.f90:36
integer(i4b), parameter lenmempath
maximum length of the memory path
Definition: Constants.f90:26
real(dp), parameter done
real constant 1
Definition: Constants.f90:75
This module defines variable data types.
Definition: kind.f90:8
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
This module contains the MvrModule Module.
Definition: Mover.f90:7
subroutine prepare(this, inunit, pckMemPaths, pakmovers)
@ brief Prepare object
Definition: Mover.f90:97
subroutine echo(this, iout)
@ brief Echo data to list file
Definition: Mover.f90:197
character(len=12), dimension(4) mvrtypes
Definition: Mover.f90:20
subroutine update_receiver(this)
@ brief Formulate coefficients
Definition: Mover.f90:271
real(dp) function qrcalc(this, qa, qta)
@ brief Flow to receiver
Definition: Mover.f90:286
subroutine set_values(this, mname1, pname1, id1, mname2, pname2, id2, imvrtype, value)
@ brief Set values from input data
Definition: Mover.f90:65
subroutine writeflow(this, iout)
@ brief Write flow
Definition: Mover.f90:337
subroutine update_provider(this)
@ brief Formulate coefficients
Definition: Mover.f90:235
subroutine advance(this)
@ brief Advance
Definition: Mover.f90:220
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
integer(i4b) function, public count_errors()
Return number of errors.
Definition: Sim.f90:59
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
Definition: Sim.f90:168
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=maxcharlen) errmsg
error message string
Derived type for MvrType.
Definition: Mover.f90:29