Skip to content

Commit

Permalink
Add new function that accounts for auxiliary multiplier > 0 in respon…
Browse files Browse the repository at this point in the history
  • Loading branch information
emorway-usgs committed Nov 2, 2023
1 parent c1320ed commit 2babaa8
Showing 1 changed file with 36 additions and 13 deletions.
49 changes: 36 additions & 13 deletions src/Model/GroundWaterTransport/gwt1cnc1.f90
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,7 @@ module GwtCncModule
procedure :: allocate_arrays => cnc_allocate_arrays
procedure :: define_listlabel
procedure :: bound_value => cnc_bound_value
procedure :: conc_mult
! -- methods for observations
procedure, public :: bnd_obs_supported => cnc_obs_supported
procedure, public :: bnd_df_obs => cnc_df_obs
Expand Down Expand Up @@ -92,7 +93,7 @@ subroutine cnc_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
! -- Store the appropriate label based on the dependent variable
cncobj%depvartype = depvartype
!
! -- return
! -- Return
return
end subroutine cnc_create

Expand Down Expand Up @@ -128,7 +129,7 @@ subroutine cnc_allocate_arrays(this, nodelist, auxvar)
'TSPVAR', this%input_mempath)
!
!
! -- return
! -- Return
return
end subroutine cnc_allocate_arrays

Expand Down Expand Up @@ -179,7 +180,7 @@ subroutine cnc_rp(this)
call this%write_list()
end if
!
! -- return
! -- Return
return
end subroutine cnc_rp

Expand Down Expand Up @@ -216,7 +217,7 @@ subroutine cnc_ad(this)
! "current" value.
call this%obs%obs_ad()
!
! -- return
! -- Return
return
end subroutine cnc_ad

Expand Down Expand Up @@ -251,14 +252,14 @@ subroutine cnc_ck(this)
call store_error_filename(this%input_fname)
end if
!
! -- return
! -- Return
return
end subroutine cnc_ck

!> @brief Override bnd_fc and do nothing
!!
!! For constant concentration/temperature boundary type, the call to bnd_fc
!! needs to be overwritten to prevent logic found therein from being applied
!! needs to be overwritten to prevent logic found in bnd from being executed
!<
subroutine cnc_fc(this, rhs, ia, idxglo, matrix_sln)
! -- dummy
Expand All @@ -269,7 +270,7 @@ subroutine cnc_fc(this, rhs, ia, idxglo, matrix_sln)
class(MatrixBaseType), pointer :: matrix_sln
! -- local
!
! -- return
! -- Return
return
end subroutine cnc_fc

Expand Down Expand Up @@ -338,7 +339,7 @@ subroutine cnc_cq(this, x, flowja, iadv)
!
end if
!
! -- return
! -- Return
return
end subroutine cnc_cq

Expand Down Expand Up @@ -385,7 +386,7 @@ subroutine cnc_da(this)
call mem_deallocate(this%ratecncout)
call mem_deallocate(this%tspvar, 'TSPVAR', this%memoryPath)
!
! -- return
! -- Return
return
end subroutine cnc_da

Expand Down Expand Up @@ -416,7 +417,7 @@ subroutine define_listlabel(this)
write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME'
end if
!
! -- return
! -- Return
return
end subroutine define_listlabel

Expand Down Expand Up @@ -452,7 +453,7 @@ subroutine cnc_df_obs(this)
call this%obs%StoreObsType(this%filtyp, .true., indx)
this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor
!
! -- return
! -- Return
return
end subroutine cnc_df_obs

Expand Down Expand Up @@ -483,9 +484,31 @@ subroutine cnc_rp_ts(this)
end if
end do
!
! -- return
! -- Return
return
end subroutine cnc_rp_ts

!> @brief Apply auxiliary multiplier to specified concentration if
!< appropriate
function conc_mult(this, row) result(conc)
! -- modules
use ConstantsModule, only: DZERO
! -- dummy variables
class(GwtCncType), intent(inout) :: this !< BndExtType object
integer(I4B), intent(in) :: row
! -- result
real(DP) :: conc
!
if (this%iauxmultcol > 0) then
conc = this%tspvar(row) * this%auxvar(this%iauxmultcol, row)
else
conc = this%tspvar(row)
end if
!
! -- Return
return
end function conc_mult


!> @ brief Return a bound value
!!
Expand All @@ -503,7 +526,7 @@ function cnc_bound_value(this, col, row) result(bndval)
!
select case (col)
case (1)
bndval = this%tspvar(row)
bndval = this%conc_mult(row)
case default
write (errmsg, '(3a)') 'Programming error. ', &
& adjustl(trim(this%filtyp)), ' bound value requested column '&
Expand Down

0 comments on commit 2babaa8

Please sign in to comment.