17 character(len=LENFTYPE) ::
ftype =
'SRC'
18 character(len=16) ::
text =
' SRC'
22 character(len=LENVARNAME) :: depvartype =
''
45 subroutine src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
48 class(
bndtype),
pointer :: packobj
49 integer(I4B),
intent(in) :: id
50 integer(I4B),
intent(in) :: ibcnum
51 integer(I4B),
intent(in) :: inunit
52 integer(I4B),
intent(in) :: iout
53 character(len=*),
intent(in) :: namemodel
54 character(len=*),
intent(in) :: pakname
55 character(len=LENVARNAME),
intent(in) :: depvartype
64 call packobj%set_names(ibcnum, namemodel, pakname,
ftype)
68 call srcobj%allocate_scalars()
71 call packobj%pack_initialize()
73 packobj%inunit = inunit
76 packobj%ibcnum = ibcnum
81 srcobj%depvartype = depvartype
96 call this%BndType%bnd_da()
114 call this%BndType%allocate_scalars()
134 integer(I4B) :: i, node
138 if (this%nbound == 0)
return
141 do i = 1, this%nbound
142 node = this%nodelist(i)
144 if (this%ibound(node) <= 0)
then
160 subroutine src_fc(this, rhs, ia, idxglo, matrix_sln)
163 real(DP),
dimension(:),
intent(inout) :: rhs
164 integer(I4B),
dimension(:),
intent(in) :: ia
165 integer(I4B),
dimension(:),
intent(in) :: idxglo
168 integer(I4B) :: i, n, ipos
171 if (this%imover == 1)
then
172 call this%pakmvrobj%fc()
176 do i = 1, this%nbound
178 rhs(n) = rhs(n) + this%rhs(i)
180 call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i))
184 if (this%imover == 1 .and. this%rhs(i) >
dzero)
then
185 call this%pakmvrobj%accumulate_qformvr(i, this%rhs(i))
204 this%listlabel = trim(this%filtyp)//
' NO.'
205 if (this%dis%ndim == 3)
then
206 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
207 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'ROW'
208 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'COL'
209 elseif (this%dis%ndim == 2)
then
210 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
211 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'CELL2D'
213 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'NODE'
215 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'STRESS RATE'
216 if (this%inamedbound == 1)
then
217 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'BOUNDARY NAME'
255 call this%obs%StoreObsType(
'src', .true., indx)
260 call this%obs%StoreObsType(
'to-mvr', .true., indx)
277 integer(I4B) :: i, nlinks
280 nlinks = this%TsManager%boundtslinks%Count()
283 if (
associated(tslink))
then
284 if (tslink%JCol == 1)
then
285 tslink%Text =
'SMASSRATE'
This module contains block parser methods.
This module contains the base boundary package.
This module contains simulation constants.
real(dp), parameter dem1
real constant 1e-1
integer(i4b), parameter lenvarname
maximum length of a variable name
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
real(dp), parameter dzero
real constant zero
real(dp), parameter done
real constant 1
character(len=lenftype) ftype
subroutine src_fc(this, rhs, ia, idxglo, matrix_sln)
Add matrix terms related to specified mass source loading.
subroutine src_cf(this)
Formulate the HCOF and RHS terms.
subroutine src_allocate_scalars(this)
Allocate scalars.
subroutine src_da(this)
Deallocate memory.
subroutine, public src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, depvartype)
Create a source loading package.
subroutine define_listlabel(this)
Define list labels.
subroutine src_rp_ts(this)
Procedure related to time series.
subroutine src_df_obs(this)
Define observations.
logical function src_obs_supported(this)
Support function for specified mass source loading observations.
This module defines variable data types.
This module contains the derived type ObsType.
subroutine, public defaultobsidprocessor(obsrv, dis, inunitobs, iout)
@ brief Process IDstring provided for each observation
type(timeserieslinktype) function, pointer, public gettimeserieslinkfromlist(list, indx)
Get time series link from a list.