MODFLOW 6  version 6.7.0.dev3
USGS Modular Hydrologic Model
gwfcsubmodule Module Reference

This module contains the CSUB package methods. More...

Data Types

type  gwfcsubtype
 

Functions/Subroutines

subroutine, public csub_cr (csubobj, name_model, mempath, istounit, stoPckName, inunit, iout)
 @ brief Create a new package object More...
 
subroutine csub_ar (this, dis, ibound)
 @ brief Allocate and read method for package More...
 
subroutine source_options (this)
 @ brief Source options for package More...
 
subroutine log_options (this, warn_estress_lag)
 @ brief log options for package More...
 
subroutine csub_source_dimensions (this)
 @ brief Source dimensions for package More...
 
subroutine csub_allocate_scalars (this)
 @ brief Allocate scalars More...
 
subroutine csub_allocate_arrays (this)
 @ brief Allocate package arrays More...
 
subroutine csub_source_griddata (this)
 @ brief Source griddata for package More...
 
subroutine csub_source_packagedata (this)
 @ brief source packagedata for package More...
 
subroutine csub_print_packagedata (this)
 @ brief Print packagedata More...
 
subroutine csub_fp (this)
 @ brief Final processing for package More...
 
subroutine csub_da (this)
 @ brief Deallocate package memory More...
 
subroutine csub_rp (this)
 @ brief Read and prepare stress period data for package More...
 
subroutine csub_ad (this, nodes, hnew)
 @ brief Advance the package More...
 
subroutine csub_fc (this, kiter, hold, hnew, matrix_sln, idxglo, rhs)
 @ brief Fill A and r for the package More...
 
subroutine csub_fn (this, kiter, hold, hnew, matrix_sln, idxglo, rhs)
 @ brief Fill Newton-Raphson terms in A and r for the package More...
 
subroutine csub_initialize_tables (this)
 @ brief Initialize optional tables More...
 
subroutine csub_cc (this, innertot, kiter, iend, icnvgmod, nodes, hnew, hold, cpak, ipak, dpak)
 @ brief Final convergence check More...
 
subroutine csub_cq (this, nodes, hnew, hold, isuppress_output, flowja)
 @ brief Calculate flows for package More...
 
subroutine csub_bd (this, isuppress_output, model_budget)
 @ brief Model budget calculation for package More...
 
subroutine csub_save_model_flows (this, icbcfl, icbcun)
 @ brief Save model flows for package More...
 
subroutine csub_ot_dv (this, idvfl, idvprint)
 @ brief Save and print dependent values for package More...
 
subroutine csub_cg_calc_stress (this, nodes, hnew)
 @ brief Calculate the stress for model cells More...
 
subroutine csub_cg_chk_stress (this)
 @ brief Check effective stress values More...
 
subroutine csub_nodelay_update (this, i)
 @ brief Update no-delay material properties More...
 
subroutine csub_nodelay_fc (this, ib, hcell, hcellold, rho1, rho2, rhs, argtled)
 @ brief Calculate no-delay interbed storage coefficients More...
 
subroutine csub_nodelay_calc_comp (this, ib, hcell, hcellold, comp, rho1, rho2)
 @ brief Calculate no-delay interbed compaction More...
 
subroutine csub_set_initial_state (this, nodes, hnew)
 @ brief Set initial states for the package More...
 
subroutine csub_cg_fc (this, node, tled, area, hcell, hcellold, hcof, rhs)
 @ brief Formulate the coefficients for coarse-grained materials More...
 
subroutine csub_cg_fn (this, node, tled, area, hcell, hcof, rhs)
 @ brief Formulate coarse-grained Newton-Raphson terms More...
 
subroutine csub_interbed_fc (this, ib, node, area, hcell, hcellold, hcof, rhs)
 @ brief Formulate the coefficients for a interbed More...
 
subroutine csub_interbed_fn (this, ib, node, hcell, hcellold, hcof, rhs)
 @ brief Formulate the coefficients for a interbed More...
 
subroutine csub_cg_calc_sske (this, n, sske, hcell)
 @ brief Calculate Sske for a cell More...
 
subroutine csub_cg_calc_comp (this, node, hcell, hcellold, comp)
 @ brief Calculate coarse-grained compaction in a cell More...
 
subroutine csub_cg_update (this, node)
 @ brief Update coarse-grained material properties More...
 
subroutine csub_cg_wcomp_fc (this, node, tled, area, hcell, hcellold, hcof, rhs)
 @ brief Formulate coarse-grained water compressibility coefficients More...
 
subroutine csub_cg_wcomp_fn (this, node, tled, area, hcell, hcellold, hcof, rhs)
 @ brief Formulate coarse-grained water compressibility coefficients More...
 
subroutine csub_nodelay_wcomp_fc (this, ib, node, tled, area, hcell, hcellold, hcof, rhs)
 @ brief Formulate no-delay interbed water compressibility coefficients More...
 
subroutine csub_nodelay_wcomp_fn (this, ib, node, tled, area, hcell, hcellold, hcof, rhs)
 @ brief Formulate no-delay interbed water compressibility coefficients More...
 
real(dp) function csub_calc_void_ratio (this, theta)
 Calculate the void ratio. More...
 
real(dp) function csub_calc_theta (this, void_ratio)
 Calculate the porosity. More...
 
real(dp) function csub_calc_interbed_thickness (this, ib)
 Calculate the interbed thickness. More...
 
real(dp) function csub_calc_znode (this, top, bottom, zbar)
 Calculate the cell node. More...
 
real(dp) function csub_calc_adjes (this, node, es0, z0, z)
 Calculate the effective stress at elevation z. More...
 
subroutine csub_delay_head_check (this, ib)
 Check delay interbed head. More...
 
subroutine csub_calc_sat (this, node, hcell, hcellold, snnew, snold)
 Calculate cell saturation. More...
 
real(dp) function csub_calc_sat_derivative (this, node, hcell)
 Calculate the saturation derivative. More...
 
subroutine csub_calc_sfacts (this, node, bot, znode, theta, es, es0, fact)
 Calculate specific storage coefficient factor. More...
 
subroutine csub_adj_matprop (this, comp, thick, theta)
 Calculate new material properties. More...
 
subroutine csub_delay_sln (this, ib, hcell, update)
 Solve delay interbed continuity equation. More...
 
subroutine csub_delay_init_zcell (this, ib)
 Calculate delay interbed znode and z relative to interbed center. More...
 
subroutine csub_delay_calc_stress (this, ib, hcell)
 Calculate delay interbed stress values. More...
 
subroutine csub_delay_calc_ssksske (this, ib, n, hcell, ssk, sske)
 Calculate delay interbed cell storage coefficients. More...
 
subroutine csub_delay_assemble (this, ib, hcell)
 Assemble delay interbed coefficients. More...
 
subroutine csub_delay_assemble_fc (this, ib, n, hcell, aii, au, al, r)
 Assemble delay interbed standard formulation coefficients. More...
 
subroutine csub_delay_assemble_fn (this, ib, n, hcell, aii, au, al, r)
 Assemble delay interbed Newton-Raphson formulation coefficients. More...
 
subroutine csub_delay_calc_sat (this, node, idelay, n, hcell, hcellold, snnew, snold)
 Calculate delay interbed saturation. More...
 
real(dp) function csub_delay_calc_sat_derivative (this, node, idelay, n, hcell)
 Calculate the delay interbed cell saturation derivative. More...
 
subroutine csub_delay_calc_dstor (this, ib, hcell, stoe, stoi)
 Calculate delay interbed storage change. More...
 
subroutine csub_delay_calc_wcomp (this, ib, dwc)
 Calculate delay interbed water compressibility. More...
 
subroutine csub_delay_calc_comp (this, ib, hcell, hcellold, comp, compi, compe)
 Calculate delay interbed compaction. More...
 
subroutine csub_delay_update (this, ib)
 Update delay interbed material properties. More...
 
subroutine csub_delay_fc (this, ib, hcof, rhs)
 Calculate delay interbed contribution to the cell. More...
 
real(dp) function csub_calc_delay_flow (this, ib, n, hcell)
 Calculate the flow from delay interbed top or bottom. More...
 
logical function csub_obs_supported (this)
 Determine if observations are supported. More...
 
subroutine csub_df_obs (this)
 Define the observation types available in the package. More...
 
subroutine csub_bd_obs (this)
 Set the observations for this time step. More...
 
subroutine csub_rp_obs (this)
 Read and prepare the observations. More...
 
subroutine csub_process_obsid (obsrv, dis, inunitobs, iout)
 Process the observation IDs for the package. More...
 
subroutine define_listlabel (this)
 @ brief Define the list label for the package More...
 

Variables

character(len=lenbudtxt), dimension(4) budtxt = [' CSUB-CGELASTIC', ' CSUB-ELASTIC', ' CSUB-INELASTIC', ' CSUB-WATERCOMP']
 
character(len=lenbudtxt), dimension(6) comptxt = ['CSUB-COMPACTION', ' CSUB-INELASTIC', ' CSUB-ELASTIC', ' CSUB-INTERBED', ' CSUB-COARSE', ' CSUB-ZDISPLACE']
 
real(dp), parameter dlog10es = 0.4342942_DP
 derivative of the log of effective stress More...
 

Detailed Description

This module contains the methods used to add the effects of elastic skeletal storage, compaction, and subsidence on the groundwater flow equation. The contribution of elastic skelatal, inelastic and elastic interbed storage and water compressibility can be represented.

Function/Subroutine Documentation

◆ csub_ad()

subroutine gwfcsubmodule::csub_ad ( class(gwfcsubtype this,
integer(i4b), intent(in)  nodes,
real(dp), dimension(nodes), intent(in)  hnew 
)

Advance data in the CSUB package. The method sets data for the previous time step to the current value for the data (e.g., HOLD = HNEW). The method also calls the method to initialize the initial stress conditions if this is the first transient stress period.

Parameters
[in]nodesnumber of active model nodes
[in]hnewcurrent head

Definition at line 2375 of file gwf-csub.f90.

2376  ! -- modules
2377  use tdismodule, only: nper, kper
2378  ! -- dummy variables
2379  class(GwfCsubType) :: this
2380  integer(I4B), intent(in) :: nodes !< number of active model nodes
2381  real(DP), dimension(nodes), intent(in) :: hnew !< current head
2382  ! -- local variables
2383  integer(I4B) :: ib
2384  integer(I4B) :: n
2385  integer(I4B) :: idelay
2386  integer(I4B) :: node
2387  real(DP) :: h
2388  real(DP) :: es
2389  real(DP) :: pcs
2390  !
2391  ! -- evaluate if steady-state stress periods are specified for more
2392  ! than the first and last stress period if interbeds are simulated
2393  if (this%ninterbeds > 0) then
2394  if (kper > 1 .and. kper < nper) then
2395  if (this%gwfiss /= 0) then
2396  write (errmsg, '(a,i0,a,1x,a,1x,a,1x,i0,1x,a)') &
2397  'Only the first and last (', nper, ')', &
2398  'stress period can be steady if interbeds are simulated.', &
2399  'Stress period', kper, 'has been defined to be steady state.'
2400  call store_error(errmsg, terminate=.true.)
2401  end if
2402  end if
2403  end if
2404  !
2405  ! -- set initial states
2406  if (this%initialized == 0) then
2407  if (this%gwfiss == 0) then
2408  call this%csub_set_initial_state(nodes, hnew)
2409  end if
2410  end if
2411  !
2412  ! -- update state variables
2413  !
2414  ! -- coarse-grained materials
2415  do node = 1, nodes
2416  this%cg_comp(node) = dzero
2417  this%cg_es0(node) = this%cg_es(node)
2418  if (this%iupdatematprop /= 0) then
2419  this%cg_thick0(node) = this%cg_thick(node)
2420  this%cg_theta0(node) = this%cg_theta(node)
2421  end if
2422  end do
2423  !
2424  ! -- interbeds
2425  do ib = 1, this%ninterbeds
2426  idelay = this%idelay(ib)
2427  !
2428  ! -- update common terms for no-delay and delay interbeds
2429  this%comp(ib) = dzero
2430  node = this%nodelist(ib)
2431  if (this%initialized /= 0) then
2432  es = this%cg_es(node)
2433  pcs = this%pcs(ib)
2434  if (es > pcs) then
2435  this%pcs(ib) = es
2436  end if
2437  end if
2438  if (this%iupdatematprop /= 0) then
2439  this%thick0(ib) = this%thick(ib)
2440  this%theta0(ib) = this%theta(ib)
2441  end if
2442  !
2443  ! -- update delay interbed terms
2444  if (idelay /= 0) then
2445  !
2446  ! -- update state if previous period was steady state
2447  if (kper > 1) then
2448  if (this%gwfiss0 /= 0) then
2449  node = this%nodelist(ib)
2450  h = hnew(node)
2451  do n = 1, this%ndelaycells
2452  this%dbh(n, idelay) = h
2453  end do
2454  end if
2455  end if
2456  !
2457  ! -- update preconsolidation stress, stresses, head, dbdz0, and theta0
2458  do n = 1, this%ndelaycells
2459  ! update preconsolidation stress
2460  if (this%initialized /= 0) then
2461  if (this%dbes(n, idelay) > this%dbpcs(n, idelay)) then
2462  this%dbpcs(n, idelay) = this%dbes(n, idelay)
2463  end if
2464  end if
2465  this%dbh0(n, idelay) = this%dbh(n, idelay)
2466  this%dbes0(n, idelay) = this%dbes(n, idelay)
2467  if (this%iupdatematprop /= 0) then
2468  this%dbdz0(n, idelay) = this%dbdz(n, idelay)
2469  this%dbtheta0(n, idelay) = this%dbtheta(n, idelay)
2470  end if
2471  end do
2472  end if
2473  end do
2474  !
2475  ! -- set gwfiss0
2476  this%gwfiss0 = this%gwfiss
2477  !
2478  ! -- For each observation, push simulated value and corresponding
2479  ! simulation time from "current" to "preceding" and reset
2480  ! "current" value.
2481  call this%obs%obs_ad()
integer(i4b), pointer, public kper
current stress period number
Definition: tdis.f90:23
integer(i4b), pointer, public nper
number of stress period
Definition: tdis.f90:21
Here is the call graph for this function:

◆ csub_adj_matprop()

subroutine gwfcsubmodule::csub_adj_matprop ( class(gwfcsubtype), intent(inout)  this,
real(dp), intent(in)  comp,
real(dp), intent(inout)  thick,
real(dp), intent(inout)  theta 
)
private

Method to calculate the current thickness and porosity.

Parameters
[in,out]thickinitial and current thickness
[in,out]thetainitial and current porosity
[in]compcompaction
[in,out]thickthickness
[in,out]thetaporosity

Definition at line 5347 of file gwf-csub.f90.

5348  ! -- dummy variables
5349  class(GwfCsubType), intent(inout) :: this
5350  real(DP), intent(in) :: comp !< compaction
5351  real(DP), intent(inout) :: thick !< thickness
5352  real(DP), intent(inout) :: theta !< porosity
5353  ! -- local variables
5354  real(DP) :: strain
5355  real(DP) :: void_ratio
5356  !
5357  ! -- initialize variables
5358  strain = dzero
5359  void_ratio = this%csub_calc_void_ratio(theta)
5360  !
5361  ! -- calculate strain
5362  if (thick > dzero) strain = -comp / thick
5363  !
5364  ! -- update void ratio, theta, and thickness
5365  void_ratio = void_ratio + strain * (done + void_ratio)
5366  theta = this%csub_calc_theta(void_ratio)
5367  thick = thick - comp

◆ csub_allocate_arrays()

subroutine gwfcsubmodule::csub_allocate_arrays ( class(gwfcsubtype), intent(inout)  this)

Allocate and initialize CSUB package arrays.

Definition at line 972 of file gwf-csub.f90.

973  ! -- modules
975  ! -- dummy variables
976  class(GwfCsubType), intent(inout) :: this
977  ! -- local variables
978  integer(I4B) :: j
979  integer(I4B) :: n
980  integer(I4B) :: iblen
981  integer(I4B) :: naux
982  !
983  ! -- grid based data
984  if (this%ioutcomp == 0 .and. this%ioutcompi == 0 .and. &
985  this%ioutcompe == 0 .and. this%ioutcompib == 0 .and. &
986  this%ioutcomps == 0 .and. this%ioutzdisp == 0) then
987  call mem_allocate(this%buff, 1, 'BUFF', trim(this%memoryPath))
988  else
989  call mem_allocate(this%buff, this%dis%nodes, 'BUFF', trim(this%memoryPath))
990  end if
991  if (this%ioutcomp == 0 .and. this%ioutzdisp == 0) then
992  call mem_allocate(this%buffusr, 1, 'BUFFUSR', trim(this%memoryPath))
993  else
994  call mem_allocate(this%buffusr, this%dis%nodesuser, 'BUFFUSR', &
995  trim(this%memoryPath))
996  end if
997  call mem_allocate(this%sgm, this%dis%nodes, 'SGM', trim(this%memoryPath))
998  call mem_allocate(this%sgs, this%dis%nodes, 'SGS', trim(this%memoryPath))
999  call mem_allocate(this%cg_ske_cr, this%dis%nodes, 'CG_SKE_CR', &
1000  trim(this%memoryPath))
1001  call mem_allocate(this%cg_es, this%dis%nodes, 'CG_ES', &
1002  trim(this%memoryPath))
1003  call mem_allocate(this%cg_es0, this%dis%nodes, 'CG_ES0', &
1004  trim(this%memoryPath))
1005  call mem_allocate(this%cg_pcs, this%dis%nodes, 'CG_PCS', &
1006  trim(this%memoryPath))
1007  call mem_allocate(this%cg_comp, this%dis%nodes, 'CG_COMP', &
1008  trim(this%memoryPath))
1009  call mem_allocate(this%cg_tcomp, this%dis%nodes, 'CG_TCOMP', &
1010  trim(this%memoryPath))
1011  call mem_allocate(this%cg_stor, this%dis%nodes, 'CG_STOR', &
1012  trim(this%memoryPath))
1013  call mem_allocate(this%cg_ske, this%dis%nodes, 'CG_SKE', &
1014  trim(this%memoryPath))
1015  call mem_allocate(this%cg_sk, this%dis%nodes, 'CG_SK', &
1016  trim(this%memoryPath))
1017  call mem_allocate(this%cg_thickini, this%dis%nodes, 'CG_THICKINI', &
1018  trim(this%memoryPath))
1019  call mem_allocate(this%cg_thetaini, this%dis%nodes, 'CG_THETAINI', &
1020  trim(this%memoryPath))
1021  if (this%iupdatematprop == 0) then
1022  call mem_setptr(this%cg_thick, 'CG_THICKINI', trim(this%memoryPath))
1023  call mem_setptr(this%cg_thick0, 'CG_THICKINI', trim(this%memoryPath))
1024  call mem_setptr(this%cg_theta, 'CG_THETAINI', trim(this%memoryPath))
1025  call mem_setptr(this%cg_theta0, 'CG_THETAINI', trim(this%memoryPath))
1026  else
1027  call mem_allocate(this%cg_thick, this%dis%nodes, 'CG_THICK', &
1028  trim(this%memoryPath))
1029  call mem_allocate(this%cg_thick0, this%dis%nodes, 'CG_THICK0', &
1030  trim(this%memoryPath))
1031  call mem_allocate(this%cg_theta, this%dis%nodes, 'CG_THETA', &
1032  trim(this%memoryPath))
1033  call mem_allocate(this%cg_theta0, this%dis%nodes, 'CG_THETA0', &
1034  trim(this%memoryPath))
1035  end if
1036  !
1037  ! -- cell storage data
1038  call mem_allocate(this%cell_wcstor, this%dis%nodes, 'CELL_WCSTOR', &
1039  trim(this%memoryPath))
1040  call mem_allocate(this%cell_thick, this%dis%nodes, 'CELL_THICK', &
1041  trim(this%memoryPath))
1042  !
1043  ! -- interbed data
1044  iblen = 1
1045  if (this%ninterbeds > 0) then
1046  iblen = this%ninterbeds
1047  end if
1048  naux = 1
1049  if (this%naux > 0) then
1050  naux = this%naux
1051  end if
1052  call mem_allocate(this%auxvar, naux, iblen, 'AUXVAR', this%memoryPath)
1053  do n = 1, iblen
1054  do j = 1, naux
1055  this%auxvar(j, n) = dzero
1056  end do
1057  end do
1058  call mem_allocate(this%unodelist, iblen, 'UNODELIST', trim(this%memoryPath))
1059  call mem_allocate(this%nodelist, iblen, 'NODELIST', trim(this%memoryPath))
1060  call mem_allocate(this%cg_gs, this%dis%nodes, 'CG_GS', trim(this%memoryPath))
1061  call mem_allocate(this%pcs, iblen, 'PCS', trim(this%memoryPath))
1062  call mem_allocate(this%rnb, iblen, 'RNB', trim(this%memoryPath))
1063  call mem_allocate(this%kv, iblen, 'KV', trim(this%memoryPath))
1064  call mem_allocate(this%h0, iblen, 'H0', trim(this%memoryPath))
1065  call mem_allocate(this%ci, iblen, 'CI', trim(this%memoryPath))
1066  call mem_allocate(this%rci, iblen, 'RCI', trim(this%memoryPath))
1067  call mem_allocate(this%idelay, iblen, 'IDELAY', trim(this%memoryPath))
1068  call mem_allocate(this%ielastic, iblen, 'IELASTIC', trim(this%memoryPath))
1069  call mem_allocate(this%iconvert, iblen, 'ICONVERT', trim(this%memoryPath))
1070  call mem_allocate(this%comp, iblen, 'COMP', trim(this%memoryPath))
1071  call mem_allocate(this%tcomp, iblen, 'TCOMP', trim(this%memoryPath))
1072  call mem_allocate(this%tcompi, iblen, 'TCOMPI', trim(this%memoryPath))
1073  call mem_allocate(this%tcompe, iblen, 'TCOMPE', trim(this%memoryPath))
1074  call mem_allocate(this%storagee, iblen, 'STORAGEE', trim(this%memoryPath))
1075  call mem_allocate(this%storagei, iblen, 'STORAGEI', trim(this%memoryPath))
1076  call mem_allocate(this%ske, iblen, 'SKE', trim(this%memoryPath))
1077  call mem_allocate(this%sk, iblen, 'SK', trim(this%memoryPath))
1078  call mem_allocate(this%thickini, iblen, 'THICKINI', trim(this%memoryPath))
1079  call mem_allocate(this%thetaini, iblen, 'THETAINI', trim(this%memoryPath))
1080  if (this%iupdatematprop == 0) then
1081  call mem_setptr(this%thick, 'THICKINI', trim(this%memoryPath))
1082  call mem_setptr(this%thick0, 'THICKINI', trim(this%memoryPath))
1083  call mem_setptr(this%theta, 'THETAINI', trim(this%memoryPath))
1084  call mem_setptr(this%theta0, 'THETAINI', trim(this%memoryPath))
1085  else
1086  call mem_allocate(this%thick, iblen, 'THICK', trim(this%memoryPath))
1087  call mem_allocate(this%thick0, iblen, 'THICK0', trim(this%memoryPath))
1088  call mem_allocate(this%theta, iblen, 'THETA', trim(this%memoryPath))
1089  call mem_allocate(this%theta0, iblen, 'THETA0', trim(this%memoryPath))
1090  end if
1091  !
1092  ! -- delay bed storage - allocated in csub_source_packagedata
1093  ! after number of delay beds is defined
1094  !
1095  ! -- allocate boundname
1096  if (this%inamedbound /= 0) then
1097  call mem_allocate(this%boundname, lenboundname, this%ninterbeds, &
1098  'BOUNDNAME', trim(this%memoryPath))
1099  else
1100  call mem_allocate(this%boundname, lenboundname, 1, &
1101  'BOUNDNAME', trim(this%memoryPath))
1102 
1103  end if
1104  !
1105  ! -- allocate the nodelist and bound arrays
1106  call mem_allocate(this%nodelistsig0, this%maxsig0, 'NODELISTSIG0', &
1107  this%memoryPath)
1108 
1109  ! -- set sig0 input context pointer
1110  call mem_setptr(this%sig0, 'SIG0', this%input_mempath)
1111  call mem_checkin(this%sig0, 'SIG0', this%memoryPath, &
1112  'SIG0', this%input_mempath)
1113  !
1114  ! -- set pointers to gwf variables
1115  call mem_setptr(this%gwfiss, 'ISS', trim(this%name_model))
1116  !
1117  ! -- set pointers to variables in the storage package
1118  call mem_setptr(this%stoiconv, 'ICONVERT', this%stoMemPath)
1119  call mem_setptr(this%stoss, 'SS', this%stoMemPath)
1120  !
1121  ! -- initialize variables that are not specified by user
1122  do n = 1, this%dis%nodes
1123  this%cg_gs(n) = dzero
1124  this%cg_es(n) = dzero
1125  this%cg_comp(n) = dzero
1126  this%cg_tcomp(n) = dzero
1127  this%cell_wcstor(n) = dzero
1128  end do
1129  do n = 1, this%ninterbeds
1130  this%theta(n) = dzero
1131  this%tcomp(n) = dzero
1132  this%tcompi(n) = dzero
1133  this%tcompe(n) = dzero
1134  end do
1135  do n = 1, this%maxsig0
1136  this%nodelistsig0(n) = 0
1137  end do

◆ csub_allocate_scalars()

subroutine gwfcsubmodule::csub_allocate_scalars ( class(gwfcsubtype), intent(inout)  this)

Allocate and initialize scalars for the CSUB package. The base model allocate scalars method is also called.

Definition at line 862 of file gwf-csub.f90.

863  ! -- modules
865  ! -- dummy variables
866  class(GwfCsubType), intent(inout) :: this
867  !
868  ! -- call standard NumericalPackageType allocate scalars
869  call this%NumericalPackageType%allocate_scalars()
870  !
871  ! -- allocate character variables
872  call mem_allocate(this%listlabel, lenlistlabel, 'LISTLABEL', this%memoryPath)
873  call mem_allocate(this%stoMemPath, lenmempath, 'STONAME', this%memoryPath)
874  !
875  ! -- allocate the object and assign values to object variables
876  call mem_allocate(this%istounit, 'ISTOUNIT', this%memoryPath)
877  call mem_allocate(this%inobspkg, 'INOBSPKG', this%memoryPath)
878  call mem_allocate(this%ninterbeds, 'NINTERBEDS', this%memoryPath)
879  call mem_allocate(this%maxsig0, 'MAXSIG0', this%memoryPath)
880  call mem_allocate(this%nbound, 'NBOUND', this%memoryPath)
881  call mem_allocate(this%iscloc, 'ISCLOC', this%memoryPath)
882  call mem_allocate(this%iauxmultcol, 'IAUXMULTCOL', this%memoryPath)
883  call mem_allocate(this%ndelaycells, 'NDELAYCELLS', this%memoryPath)
884  call mem_allocate(this%ndelaybeds, 'NDELAYBEDS', this%memoryPath)
885  call mem_allocate(this%initialized, 'INITIALIZED', this%memoryPath)
886  call mem_allocate(this%ieslag, 'IESLAG', this%memoryPath)
887  call mem_allocate(this%ipch, 'IPCH', this%memoryPath)
888  call mem_allocate(this%lhead_based, 'LHEAD_BASED', this%memoryPath)
889  call mem_allocate(this%iupdatestress, 'IUPDATESTRESS', this%memoryPath)
890  call mem_allocate(this%ispecified_pcs, 'ISPECIFIED_PCS', this%memoryPath)
891  call mem_allocate(this%ispecified_dbh, 'ISPECIFIED_DBH', this%memoryPath)
892  call mem_allocate(this%inamedbound, 'INAMEDBOUND', this%memoryPath)
893  call mem_allocate(this%iconvchk, 'ICONVCHK', this%memoryPath)
894  call mem_allocate(this%naux, 'NAUX', this%memoryPath)
895  call mem_allocate(this%istoragec, 'ISTORAGEC', this%memoryPath)
896  call mem_allocate(this%istrainib, 'ISTRAINIB', this%memoryPath)
897  call mem_allocate(this%istrainsk, 'ISTRAINSK', this%memoryPath)
898  call mem_allocate(this%ioutcomp, 'IOUTCOMP', this%memoryPath)
899  call mem_allocate(this%ioutcompi, 'IOUTCOMPI', this%memoryPath)
900  call mem_allocate(this%ioutcompe, 'IOUTCOMPE', this%memoryPath)
901  call mem_allocate(this%ioutcompib, 'IOUTCOMPIB', this%memoryPath)
902  call mem_allocate(this%ioutcomps, 'IOUTCOMPS', this%memoryPath)
903  call mem_allocate(this%ioutzdisp, 'IOUTZDISP', this%memoryPath)
904  call mem_allocate(this%ipakcsv, 'IPAKCSV', this%memoryPath)
905  call mem_allocate(this%iupdatematprop, 'IUPDATEMATPROP', this%memoryPath)
906  call mem_allocate(this%epsilon, 'EPSILON', this%memoryPath)
907  call mem_allocate(this%cc_crit, 'CC_CRIT', this%memoryPath)
908  call mem_allocate(this%gammaw, 'GAMMAW', this%memoryPath)
909  call mem_allocate(this%beta, 'BETA', this%memoryPath)
910  call mem_allocate(this%brg, 'BRG', this%memoryPath)
911  call mem_allocate(this%satomega, 'SATOMEGA', this%memoryPath)
912  call mem_allocate(this%icellf, 'ICELLF', this%memoryPath)
913  call mem_allocate(this%gwfiss0, 'GWFISS0', this%memoryPath)
914  !
915  ! -- allocate text strings
916  call mem_allocate(this%auxname, lenauxname, 0, 'AUXNAME', this%memoryPath)
917  !
918  ! -- initialize values
919  this%istounit = 0
920  this%inobspkg = 0
921  this%ninterbeds = 0
922  this%maxsig0 = 0
923  this%nbound = 0
924  this%iscloc = 0
925  this%iauxmultcol = 0
926  this%ndelaycells = 19
927  this%ndelaybeds = 0
928  this%initialized = 0
929  this%ieslag = 0
930  this%ipch = 0
931  this%lhead_based = .false.
932  this%iupdatestress = 1
933  this%ispecified_pcs = 0
934  this%ispecified_dbh = 0
935  this%inamedbound = 0
936  this%iconvchk = 1
937  this%naux = 0
938  this%istoragec = 1
939  this%istrainib = 0
940  this%istrainsk = 0
941  this%ioutcomp = 0
942  this%ioutcompi = 0
943  this%ioutcompe = 0
944  this%ioutcompib = 0
945  this%ioutcomps = 0
946  this%ioutzdisp = 0
947  this%ipakcsv = 0
948  this%iupdatematprop = 0
949  this%epsilon = dzero
950  this%cc_crit = dem7
951  this%gammaw = dgravity * 1000._dp
952  this%beta = 4.6512e-10_dp
953  this%brg = this%gammaw * this%beta
954  !
955  ! -- set omega value used for saturation calculations
956  if (this%inewton /= 0) then
957  this%satomega = dem6
958  this%epsilon = dhalf * dem6
959  else
960  this%satomega = dzero
961  end if
962  this%icellf = 0
963  this%ninterbeds = 0
964  this%gwfiss0 = 0

◆ csub_ar()

subroutine gwfcsubmodule::csub_ar ( class(gwfcsubtype), intent(inout)  this,
class(disbasetype), intent(in), pointer  dis,
integer(i4b), dimension(:), pointer, contiguous  ibound 
)
private

Method to allocate and read static data for the CSUB package.

Parameters
[in]dismodel discretization
iboundmodel ibound array

Definition at line 353 of file gwf-csub.f90.

354  ! -- modules
356  use constantsmodule, only: linelength
357  use kindmodule, only: i4b
358  ! -- dummy variables
359  class(GwfCsubType), intent(inout) :: this
360  class(DisBaseType), pointer, intent(in) :: dis !< model discretization
361  integer(I4B), dimension(:), pointer, contiguous :: ibound !< model ibound array
362  ! -- local variables
363  character(len=20) :: cellid
364  integer(I4B) :: idelay
365  integer(I4B) :: ib
366  integer(I4B) :: node
367  integer(I4B) :: istoerr
368  real(DP) :: top
369  real(DP) :: bot
370  real(DP) :: thick
371  real(DP) :: cg_ske_cr
372  real(DP) :: theta
373  real(DP) :: v
374  real(DP) :: vtot
375  ! -- format
376  character(len=*), parameter :: fmtcsub = &
377  "(1x,/1x,'CSUB -- COMPACTION PACKAGE, VERSION 1, 12/15/2019', &
378  &' INPUT READ FROM MEMPATH: ', A, /)"
379  !
380  ! --print a message identifying the csub package.
381  write (this%iout, fmtcsub) this%input_mempath
382  !
383  ! -- store pointers to arguments that were passed in
384  this%dis => dis
385  this%ibound => ibound
386  !
387  ! -- create obs package
388  call obs_cr(this%obs, this%inobspkg)
389  !
390  ! -- source csub options
391  call this%source_options()
392  !
393  ! -- source the csub dimensions
394  call this%source_dimensions()
395  !
396  ! - observation data
397  call this%obs%obs_ar()
398  !
399  ! -- terminate if errors dimensions block data
400  if (count_errors() > 0) then
401  call store_error_filename(this%input_fname)
402  end if
403 
404  ! -- Allocate arrays in
405  call this%csub_allocate_arrays()
406  !
407  ! -- source griddata
408  call this%csub_source_griddata()
409  !
410  ! -- evaluate the coarse-grained material properties and if
411  ! non-zero specific storage values are specified in the
412  ! STO package
413  istoerr = 0
414  do node = 1, this%dis%nodes
415  call this%dis%noder_to_string(node, cellid)
416  cg_ske_cr = this%cg_ske_cr(node)
417  theta = this%cg_thetaini(node)
418  !
419  ! -- coarse-grained storage error condition
420  if (cg_ske_cr < dzero) then
421  write (errmsg, '(a,g0,a,1x,a,1x,a,a)') &
422  'Coarse-grained material CG_SKE_CR (', cg_ske_cr, ') is less', &
423  'than zero in cell', trim(adjustl(cellid)), '.'
424  end if
425  !
426  ! -- storage (STO) package error condition
427  if (this%stoss(node) /= dzero) then
428  istoerr = 1
429  end if
430  !
431  ! -- porosity error condition
432  if (theta > done .or. theta < dzero) then
433  write (errmsg, '(a,g0,a,1x,a,1x,a,a)') &
434  'Coarse-grained material THETA (', theta, ') is less', &
435  'than zero or greater than 1 in cell', trim(adjustl(cellid)), '.'
436  end if
437  end do
438  !
439  ! -- write single message if storage (STO) package has non-zero specific
440  ! storage values
441  if (istoerr /= 0) then
442  write (errmsg, '(a,3(1x,a))') &
443  'Specific storage values in the storage (STO) package must', &
444  'be zero in all active cells when using the', &
445  trim(adjustl(this%packName)), &
446  'package.'
447  call store_error(errmsg)
448  end if
449  !
450  ! -- source interbed data
451  if (this%ninterbeds > 0) then
452  call this%csub_source_packagedata()
453  end if
454  !
455  ! setup package convergence tables
456  call this%csub_initialize_tables()
457  !
458  ! -- calculate the coarse-grained material thickness without the interbeds
459  do node = 1, this%dis%nodes
460  top = this%dis%top(node)
461  bot = this%dis%bot(node)
462  this%cg_thickini(node) = top - bot
463  this%cell_thick(node) = top - bot
464  end do
465  !
466  ! -- subtract the interbed thickness from aquifer thickness
467  do ib = 1, this%ninterbeds
468  node = this%nodelist(ib)
469  idelay = this%idelay(ib)
470  if (idelay == 0) then
471  v = this%thickini(ib)
472  else
473  v = this%rnb(ib) * this%thickini(ib)
474  end if
475  this%cg_thickini(node) = this%cg_thickini(node) - v
476  end do
477  !
478  ! -- evaluate if any cg_thick values are less than 0
479  do node = 1, this%dis%nodes
480  thick = this%cg_thickini(node)
481  if (thick < dzero) then
482  call this%dis%noder_to_string(node, cellid)
483  write (errmsg, '(a,g0,a,1x,a,a)') &
484  'Coarse grained material thickness is less than zero (', &
485  thick, ') in cell', trim(adjustl(cellid)), '. Interbed thicknesses:'
486 
487  vtot = dzero
488  do ib = 1, this%ninterbeds
489  if (node /= this%nodelist(ib)) then
490  cycle
491  end if
492  idelay = this%idelay(ib)
493  v = this%thickini(ib)
494  if (idelay /= 0) then
495  v = v * this%rnb(ib)
496  end if
497  vtot = vtot + v
498  write (errmsg, '(a,1x,a,i0,a,g0)') &
499  trim(adjustl(errmsg)), &
500  'icbno(', ib, ')=', v
501  end do
502  write (errmsg, '(a,a,g0,a)') &
503  trim(adjustl(errmsg)), &
504  '. Total interbed thickness=', vtot, '.'
505  call store_error(errmsg)
506  end if
507  end do
508  !
509  ! -- terminate if errors griddata, packagedata blocks, TDIS, or STO data
510  if (count_errors() > 0) then
511  call store_error_filename(this%input_fname)
512  end if
513  !
514  ! -- set current coarse-grained thickness (cg_thick) and
515  ! current coarse-grained porosity (cg_theta). Only needed
516  ! if updating material properties
517  if (this%iupdatematprop /= 0) then
518  do node = 1, this%dis%nodes
519  this%cg_thick(node) = this%cg_thickini(node)
520  this%cg_theta(node) = this%cg_thetaini(node)
521  end do
522  end if
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
This module defines variable data types.
Definition: kind.f90:8
Here is the call graph for this function:

◆ csub_bd()

subroutine gwfcsubmodule::csub_bd ( class(gwfcsubtype this,
integer(i4b), intent(in)  isuppress_output,
type(budgettype), intent(inout)  model_budget 
)

Budget calculation for the CSUB package components. Components include coarse-grained storage, delay and no-delay interbeds, and water compressibility.

Parameters
[in,out]model_budgetmodel budget object
[in,out]model_budgetmodel budget object

Definition at line 3250 of file gwf-csub.f90.

3251  ! -- modules
3252  use tdismodule, only: delt
3253  use constantsmodule, only: lenboundname, dzero, done
3255  ! -- dummy variables
3256  class(GwfCsubType) :: this
3257  integer(I4B), intent(in) :: isuppress_output
3258  type(BudgetType), intent(inout) :: model_budget !< model budget object
3259  ! -- local
3260  real(DP) :: rin
3261  real(DP) :: rout
3262  !
3263  ! -- interbed elastic storage (this%cg_stor)
3264  call rate_accumulator(this%cg_stor, rin, rout)
3265  call model_budget%addentry(rin, rout, delt, budtxt(1), &
3266  isuppress_output, ' CSUB')
3267  if (this%ninterbeds > 0) then
3268  !
3269  ! -- interbed elastic storage (this%storagee)
3270  call rate_accumulator(this%storagee, rin, rout)
3271  call model_budget%addentry(rin, rout, delt, budtxt(2), &
3272  isuppress_output, ' CSUB')
3273  !
3274  ! -- interbed elastic storage (this%storagei)
3275  call rate_accumulator(this%storagei, rin, rout)
3276  call model_budget%addentry(rin, rout, delt, budtxt(3), &
3277  isuppress_output, ' CSUB')
3278  end if
3279  call rate_accumulator(this%cell_wcstor, rin, rout)
3280  call model_budget%addentry(rin, rout, delt, budtxt(4), &
3281  isuppress_output, ' CSUB')
3282  return
This module contains the BudgetModule.
Definition: Budget.f90:20
subroutine, public rate_accumulator(flow, rin, rout)
@ brief Rate accumulator subroutine
Definition: Budget.f90:632
integer(i4b), parameter lenboundname
maximum length of a bound name
Definition: Constants.f90:36
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
real(dp), parameter done
real constant 1
Definition: Constants.f90:76
real(dp), pointer, public delt
length of the current time step
Definition: tdis.f90:29
Derived type for the Budget object.
Definition: Budget.f90:39
Here is the call graph for this function:

◆ csub_bd_obs()

subroutine gwfcsubmodule::csub_bd_obs ( class(gwfcsubtype), intent(inout)  this)
private

Method to set the CSUB package observations for this time step.

Definition at line 6675 of file gwf-csub.f90.

6676  ! -- dummy variables
6677  class(GwfCsubType), intent(inout) :: this
6678  ! -- local variables
6679  type(ObserveType), pointer :: obsrv => null()
6680  integer(I4B) :: i
6681  integer(I4B) :: j
6682  integer(I4B) :: n
6683  integer(I4B) :: idelay
6684  integer(I4B) :: ncol
6685  integer(I4B) :: node
6686  real(DP) :: v
6687  real(DP) :: r
6688  real(DP) :: f
6689  real(DP) :: b0
6690  !
6691  ! -- Fill simulated values for all csub observations
6692  if (this%obs%npakobs > 0) then
6693  call this%obs%obs_bd_clear()
6694  do i = 1, this%obs%npakobs
6695  obsrv => this%obs%pakobs(i)%obsrv
6696  if (obsrv%BndFound) then
6697  if (obsrv%ObsTypeId == 'SKE' .or. &
6698  obsrv%ObsTypeId == 'SK' .or. &
6699  obsrv%ObsTypeId == 'SKE-CELL' .or. &
6700  obsrv%ObsTypeId == 'SK-CELL' .or. &
6701  obsrv%ObsTypeId == 'DELAY-HEAD' .or. &
6702  obsrv%ObsTypeId == 'DELAY-PRECONSTRESS' .or. &
6703  obsrv%ObsTypeId == 'DELAY-GSTRESS' .or. &
6704  obsrv%ObsTypeId == 'DELAY-ESTRESS' .or. &
6705  obsrv%ObsTypeId == 'PRECONSTRESS-CELL') then
6706  if (this%gwfiss /= 0) then
6707  call this%obs%SaveOneSimval(obsrv, dnodata)
6708  else
6709  v = dzero
6710  do j = 1, obsrv%indxbnds_count
6711  n = obsrv%indxbnds(j)
6712  select case (obsrv%ObsTypeId)
6713  case ('SKE')
6714  v = this%ske(n)
6715  case ('SK')
6716  v = this%sk(n)
6717  case ('SKE-CELL')
6718  !
6719  ! -- add the coarse component
6720  if (j == 1) then
6721  v = this%cg_ske(n)
6722  else
6723  v = this%ske(n)
6724  end if
6725  case ('SK-CELL')
6726  !
6727  ! -- add the coarse component
6728  if (j == 1) then
6729  v = this%cg_sk(n)
6730  else
6731  v = this%sk(n)
6732  end if
6733  case ('DELAY-HEAD', 'DELAY-PRECONSTRESS', &
6734  'DELAY-GSTRESS', 'DELAY-ESTRESS')
6735  if (n > this%ndelaycells) then
6736  r = real(n - 1, dp) / real(this%ndelaycells, dp)
6737  idelay = int(floor(r)) + 1
6738  ncol = n - int(floor(r)) * this%ndelaycells
6739  else
6740  idelay = 1
6741  ncol = n
6742  end if
6743  select case (obsrv%ObsTypeId)
6744  case ('DELAY-HEAD')
6745  v = this%dbh(ncol, idelay)
6746  case ('DELAY-PRECONSTRESS')
6747  v = this%dbpcs(ncol, idelay)
6748  case ('DELAY-GSTRESS')
6749  v = this%dbgeo(ncol, idelay)
6750  case ('DELAY-ESTRESS')
6751  v = this%dbes(ncol, idelay)
6752  end select
6753  case ('PRECONSTRESS-CELL')
6754  v = this%pcs(n)
6755  case default
6756  errmsg = "Unrecognized observation type '"// &
6757  trim(obsrv%ObsTypeId)//"'."
6758  call store_error(errmsg)
6759  end select
6760  call this%obs%SaveOneSimval(obsrv, v)
6761  end do
6762  end if
6763  else
6764  v = dzero
6765  do j = 1, obsrv%indxbnds_count
6766  n = obsrv%indxbnds(j)
6767  select case (obsrv%ObsTypeId)
6768  case ('CSUB')
6769  v = this%storagee(n) + this%storagei(n)
6770  case ('INELASTIC-CSUB')
6771  v = this%storagei(n)
6772  case ('ELASTIC-CSUB')
6773  v = this%storagee(n)
6774  case ('COARSE-CSUB')
6775  v = this%cg_stor(n)
6776  case ('WCOMP-CSUB-CELL')
6777  v = this%cell_wcstor(n)
6778  case ('CSUB-CELL')
6779  !
6780  ! -- add the coarse component
6781  if (j == 1) then
6782  v = this%cg_stor(n)
6783  else
6784  v = this%storagee(n) + this%storagei(n)
6785  end if
6786  case ('THETA')
6787  v = this%theta(n)
6788  case ('COARSE-THETA')
6789  v = this%cg_theta(n)
6790  case ('THETA-CELL')
6791  !
6792  ! -- add the coarse component
6793  if (j == 1) then
6794  f = this%cg_thick(n) / this%cell_thick(n)
6795  v = f * this%cg_theta(n)
6796  else
6797  node = this%nodelist(n)
6798  f = this%csub_calc_interbed_thickness(n) / this%cell_thick(node)
6799  v = f * this%theta(n)
6800  end if
6801  case ('GSTRESS-CELL')
6802  v = this%cg_gs(n)
6803  case ('ESTRESS-CELL')
6804  v = this%cg_es(n)
6805  case ('INTERBED-COMPACTION')
6806  v = this%tcomp(n)
6807  case ('INTERBED-COMPACTION-PCT')
6808  b0 = this%thickini(n)
6809  if (this%idelay(n) /= 0) then
6810  b0 = b0 * this%rnb(n)
6811  end if
6812  v = dhundred * this%tcomp(n) / b0
6813  case ('INELASTIC-COMPACTION')
6814  v = this%tcompi(n)
6815  case ('ELASTIC-COMPACTION')
6816  v = this%tcompe(n)
6817  case ('COARSE-COMPACTION')
6818  v = this%cg_tcomp(n)
6819  case ('INELASTIC-COMPACTION-CELL')
6820  !
6821  ! -- no coarse inelastic component
6822  if (j > 1) then
6823  v = this%tcompi(n)
6824  end if
6825  case ('ELASTIC-COMPACTION-CELL')
6826  !
6827  ! -- add the coarse component
6828  if (j == 1) then
6829  v = this%cg_tcomp(n)
6830  else
6831  v = this%tcompe(n)
6832  end if
6833  case ('COMPACTION-CELL')
6834  !
6835  ! -- add the coarse component
6836  if (j == 1) then
6837  v = this%cg_tcomp(n)
6838  else
6839  v = this%tcomp(n)
6840  end if
6841  case ('THICKNESS')
6842  idelay = this%idelay(n)
6843  v = this%thick(n)
6844  if (idelay /= 0) then
6845  v = v * this%rnb(n)
6846  end if
6847  case ('COARSE-THICKNESS')
6848  v = this%cg_thick(n)
6849  case ('THICKNESS-CELL')
6850  v = this%cell_thick(n)
6851  case ('DELAY-COMPACTION', 'DELAY-THICKNESS', &
6852  'DELAY-THETA')
6853  if (n > this%ndelaycells) then
6854  r = real(n, dp) / real(this%ndelaycells, dp)
6855  idelay = int(floor(r)) + 1
6856  ncol = mod(n, this%ndelaycells)
6857  else
6858  idelay = 1
6859  ncol = n
6860  end if
6861  select case (obsrv%ObsTypeId)
6862  case ('DELAY-COMPACTION')
6863  v = this%dbtcomp(ncol, idelay)
6864  case ('DELAY-THICKNESS')
6865  v = this%dbdz(ncol, idelay)
6866  case ('DELAY-THETA')
6867  v = this%dbtheta(ncol, idelay)
6868  end select
6869  case ('DELAY-FLOWTOP')
6870  idelay = this%idelay(n)
6871  v = this%dbflowtop(idelay)
6872  case ('DELAY-FLOWBOT')
6873  idelay = this%idelay(n)
6874  v = this%dbflowbot(idelay)
6875  case default
6876  errmsg = "Unrecognized observation type: '"// &
6877  trim(obsrv%ObsTypeId)//"'."
6878  call store_error(errmsg)
6879  end select
6880  call this%obs%SaveOneSimval(obsrv, v)
6881  end do
6882  end if
6883  else
6884  call this%obs%SaveOneSimval(obsrv, dnodata)
6885  end if
6886  end do
6887  !
6888  ! -- write summary of package error messages
6889  if (count_errors() > 0) then
6890  call store_error_filename(this%input_fname)
6891  end if
6892  end if
Here is the call graph for this function:

◆ csub_calc_adjes()

real(dp) function gwfcsubmodule::csub_calc_adjes ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  node,
real(dp), intent(in)  es0,
real(dp), intent(in)  z0,
real(dp), intent(in)  z 
)
private

Function to calculate the effective stress at specified elevation z using the provided effective stress (es0) calculated at elevation z0 (which is <= z)

Returns
es node elevation
Parameters
[in]nodecell node number
[in]es0effective stress at elevation z0
[in]z0elevation effective stress is calculate at
[in]zelevation to calculate effective stress at

Definition at line 5174 of file gwf-csub.f90.

5175  ! -- dummy variables
5176  class(GwfCsubType), intent(inout) :: this
5177  integer(I4B), intent(in) :: node !< cell node number
5178  real(DP), intent(in) :: es0 !< effective stress at elevation z0
5179  real(DP), intent(in) :: z0 !< elevation effective stress is calculate at
5180  real(DP), intent(in) :: z !< elevation to calculate effective stress at
5181  ! -- local variables
5182  real(DP) :: es
5183  !
5184  ! -- adjust effective stress to vertical node position
5185  es = es0 - (z - z0) * (this%sgs(node) - done)

◆ csub_calc_delay_flow()

real(dp) function gwfcsubmodule::csub_calc_delay_flow ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib,
integer(i4b), intent(in)  n,
real(dp), intent(in)  hcell 
)
private

Function to calculate the flow from across the top or bottom of a delay interbed.

Returns
q flow across the top or bottom of a delay interbed
Parameters
[in]ibinterbed number
[in]ndelay interbed cell
[in]hcellcurrent head in cell

Definition at line 6444 of file gwf-csub.f90.

6445  ! -- dummy variables
6446  class(GwfCsubType), intent(inout) :: this
6447  integer(I4B), intent(in) :: ib !< interbed number
6448  integer(I4B), intent(in) :: n !< delay interbed cell
6449  real(DP), intent(in) :: hcell !< current head in cell
6450  ! -- local variables
6451  integer(I4B) :: idelay
6452  real(DP) :: q
6453  real(DP) :: c
6454  !
6455  ! -- calculate flow between delay interbed and GWF
6456  idelay = this%idelay(ib)
6457  c = dtwo * this%kv(ib) / this%dbdzini(n, idelay)
6458  q = c * (hcell - this%dbh(n, idelay))

◆ csub_calc_interbed_thickness()

real(dp) function gwfcsubmodule::csub_calc_interbed_thickness ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib 
)
private

Function to calculate the interbed thickness.

Returns
thick interbed thickness
Parameters
[in]ibinterbed number

Definition at line 5121 of file gwf-csub.f90.

5122  ! -- dummy variables
5123  class(GwfCsubType), intent(inout) :: this
5124  integer(I4B), intent(in) :: ib !< interbed number
5125  ! -- local variables
5126  integer(I4B) :: idelay
5127  real(DP) :: thick
5128  !
5129  ! -- calculate interbed thickness
5130  idelay = this%idelay(ib)
5131  thick = this%thick(ib)
5132  if (idelay /= 0) then
5133  thick = thick * this%rnb(ib)
5134  end if

◆ csub_calc_sat()

subroutine gwfcsubmodule::csub_calc_sat ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  node,
real(dp), intent(in)  hcell,
real(dp), intent(in)  hcellold,
real(dp), intent(inout)  snnew,
real(dp), intent(inout)  snold 
)
private

Method to calculate the cell saturation for the current and previous time step.

Parameters
[in,out]snnewcurrent saturation
[in,out]snoldprevious saturation
[in]nodecell node number
[in]hcellcurrent head
[in]hcelloldprevious head
[in,out]snnewcurrent saturation
[in,out]snoldprevious saturation

Definition at line 5245 of file gwf-csub.f90.

5246  ! -- dummy variables
5247  class(GwfCsubType), intent(inout) :: this
5248  integer(I4B), intent(in) :: node !< cell node number
5249  real(DP), intent(in) :: hcell !< current head
5250  real(DP), intent(in) :: hcellold !< previous head
5251  real(DP), intent(inout) :: snnew !< current saturation
5252  real(DP), intent(inout) :: snold !< previous saturation
5253  ! -- local variables
5254  real(DP) :: top
5255  real(DP) :: bot
5256  !
5257  ! -- calculate cell saturation
5258  if (this%stoiconv(node) /= 0) then
5259  top = this%dis%top(node)
5260  bot = this%dis%bot(node)
5261  snnew = squadraticsaturation(top, bot, hcell, this%satomega)
5262  snold = squadraticsaturation(top, bot, hcellold, this%satomega)
5263  else
5264  snnew = done
5265  snold = done
5266  end if
5267  if (this%ieslag /= 0) then
5268  snold = snnew
5269  end if
Here is the call graph for this function:

◆ csub_calc_sat_derivative()

real(dp) function gwfcsubmodule::csub_calc_sat_derivative ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  node,
real(dp), intent(in)  hcell 
)
private

Function to calculate the derivative of the saturation with respect to the current head.

Returns
satderv derivative of saturation
Parameters
[in]nodecell node number
[in]hcellcurrent head

Definition at line 5279 of file gwf-csub.f90.

5280  ! -- dummy variables
5281  class(GwfCsubType), intent(inout) :: this
5282  integer(I4B), intent(in) :: node !< cell node number
5283  real(DP), intent(in) :: hcell !< current head
5284  ! -- local variables
5285  real(DP) :: satderv
5286  real(DP) :: top
5287  real(DP) :: bot
5288 
5289  if (this%stoiconv(node) /= 0) then
5290  top = this%dis%top(node)
5291  bot = this%dis%bot(node)
5292  satderv = squadraticsaturationderivative(top, bot, hcell, this%satomega)
5293  else
5294  satderv = dzero
5295  end if
Here is the call graph for this function:

◆ csub_calc_sfacts()

subroutine gwfcsubmodule::csub_calc_sfacts ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  node,
real(dp), intent(in)  bot,
real(dp), intent(in)  znode,
real(dp), intent(in)  theta,
real(dp), intent(in)  es,
real(dp), intent(in)  es0,
real(dp), intent(inout)  fact 
)
private

Method to calculate the factor that is used to calculate skeletal specific storage coefficients. Can be used for coarse-grained materials and interbeds.

Parameters
[in,out]factskeletal storage coefficient factor
[in]nodecell node number
[in]thetaporosity
[in]escurrent effective stress
[in]es0previous effective stress
[in,out]factskeletal storage coefficient factor (1/((1+void_ratio)*bar(es)))

Definition at line 5307 of file gwf-csub.f90.

5308  ! -- dummy variables
5309  class(GwfCsubType), intent(inout) :: this
5310  integer(I4B), intent(in) :: node !< cell node number
5311  real(DP), intent(in) :: bot !
5312  real(DP), intent(in) :: znode
5313  real(DP), intent(in) :: theta !< porosity
5314  real(DP), intent(in) :: es !< current effective stress
5315  real(DP), intent(in) :: es0 !< previous effective stress
5316  real(DP), intent(inout) :: fact !< skeletal storage coefficient factor (1/((1+void_ratio)*bar(es)))
5317  ! -- local variables
5318  real(DP) :: esv
5319  real(DP) :: void_ratio
5320  real(DP) :: denom
5321  !
5322  ! -- initialize variables
5323  fact = dzero
5324  if (this%ieslag /= 0) then
5325  esv = es0
5326  else
5327  esv = es
5328  end if
5329  !
5330  ! -- calculate storage factors for the effective stress case
5331  void_ratio = this%csub_calc_void_ratio(theta)
5332  denom = this%csub_calc_adjes(node, esv, bot, znode)
5333  denom = denom * (done + void_ratio)
5334  if (denom /= dzero) then
5335  fact = done / denom
5336  end if

◆ csub_calc_theta()

real(dp) function gwfcsubmodule::csub_calc_theta ( class(gwfcsubtype), intent(inout)  this,
real(dp), intent(in)  void_ratio 
)
private

Function to calculate the porosity from the void ratio.

Returns
theta porosity

Definition at line 5104 of file gwf-csub.f90.

5105  ! -- dummy variables
5106  class(GwfCsubType), intent(inout) :: this
5107  real(DP), intent(in) :: void_ratio
5108  ! -- local variables
5109  real(DP) :: theta
5110  !
5111  ! -- calculate theta
5112  theta = void_ratio / (done + void_ratio)

◆ csub_calc_void_ratio()

real(dp) function gwfcsubmodule::csub_calc_void_ratio ( class(gwfcsubtype), intent(inout)  this,
real(dp), intent(in)  theta 
)
private

Function to calculate the void ratio from the porosity.

Returns
void void ratio
Parameters
[in]thetaporosity

Definition at line 5088 of file gwf-csub.f90.

5089  ! -- dummy variables
5090  class(GwfCsubType), intent(inout) :: this
5091  real(DP), intent(in) :: theta !< porosity
5092  ! -- local variables
5093  real(DP) :: void_ratio
5094  ! -- calculate void ratio
5095  void_ratio = theta / (done - theta)

◆ csub_calc_znode()

real(dp) function gwfcsubmodule::csub_calc_znode ( class(gwfcsubtype), intent(inout)  this,
real(dp), intent(in)  top,
real(dp), intent(in)  bottom,
real(dp), intent(in)  zbar 
)
private

Function to calculate elevation of the node between the specified corrected elevation zbar and the bottom elevation. If zbar is greater than the top elevation, the node elevation is halfway between the top and bottom elevations. The corrected elevation (zbar) is always greater than or equal to bottom.

Returns
znode node elevation
Parameters
[in]toptop of cell
[in]bottombottom of cell
[in]zbarcorrected elevation

Definition at line 5147 of file gwf-csub.f90.

5148  ! -- dummy variables
5149  class(GwfCsubType), intent(inout) :: this
5150  real(DP), intent(in) :: top !< top of cell
5151  real(DP), intent(in) :: bottom !< bottom of cell
5152  real(DP), intent(in) :: zbar !< corrected elevation
5153  ! -- local variables
5154  real(DP) :: znode
5155  real(DP) :: v
5156  !
5157  ! -- calculate the node elevation
5158  if (zbar > top) then
5159  v = top
5160  else
5161  v = zbar
5162  end if
5163  znode = dhalf * (v + bottom)

◆ csub_cc()

subroutine gwfcsubmodule::csub_cc ( class(gwfcsubtype this,
integer(i4b), intent(in)  innertot,
integer(i4b), intent(in)  kiter,
integer(i4b), intent(in)  iend,
integer(i4b), intent(in)  icnvgmod,
integer(i4b), intent(in)  nodes,
real(dp), dimension(nodes), intent(in)  hnew,
real(dp), dimension(nodes), intent(in)  hold,
character(len=lenpakloc), intent(inout)  cpak,
integer(i4b), intent(inout)  ipak,
real(dp), intent(inout)  dpak 
)
private

Final convergence check for the CSUB package. The final convergence check is only required when the simulation includes delay interbeds. The final convergence check compares the sum of water contributed by storage and water compressibility in the delay bed to the fluid exchange between the delay interbed and the gwf cell.

Parameters
[in,out]cpakstring location of the maximum change in csub package
[in,out]ipaknode with the maximum change in csub package
[in,out]dpakmaximum change in csub package
[in]innertottotal number of inner iterations
[in]kiterouter iteration number
[in]iendflag indicating if it is the last iteration
[in]icnvgmodflag indicating if the solution is considered converged
[in]nodesnumber of active nodes
[in]hnewcurrent gwf head
[in]holdgwf for previous time step
[in,out]cpakstring location of the maximum change in csub package
[in,out]ipaknode with the maximum change in csub package
[in,out]dpakmaximum change in csub package

Definition at line 2765 of file gwf-csub.f90.

2767  ! -- modules
2768  use tdismodule, only: totim, kstp, kper, delt
2769  ! -- dummy variables
2770  class(GwfCsubType) :: this
2771  integer(I4B), intent(in) :: innertot !< total number of inner iterations
2772  integer(I4B), intent(in) :: kiter !< outer iteration number
2773  integer(I4B), intent(in) :: iend !< flag indicating if it is the last iteration
2774  integer(I4B), intent(in) :: icnvgmod !< flag indicating if the solution is considered converged
2775  integer(I4B), intent(in) :: nodes !< number of active nodes
2776  real(DP), dimension(nodes), intent(in) :: hnew !< current gwf head
2777  real(DP), dimension(nodes), intent(in) :: hold !< gwf for previous time step
2778  character(len=LENPAKLOC), intent(inout) :: cpak !< string location of the maximum change in csub package
2779  integer(I4B), intent(inout) :: ipak !< node with the maximum change in csub package
2780  real(DP), intent(inout) :: dpak !< maximum change in csub package
2781  ! local variables
2782  character(len=LENPAKLOC) :: cloc
2783  integer(I4B) :: icheck
2784  integer(I4B) :: ipakfail
2785  integer(I4B) :: ib
2786  integer(I4B) :: node
2787  integer(I4B) :: idelay
2788  integer(I4B) :: locdhmax
2789  integer(I4B) :: locrmax
2790  integer(I4B) :: ifirst
2791  real(DP) :: dhmax
2792  real(DP) :: rmax
2793  real(DP) :: dh
2794  real(DP) :: area
2795  real(DP) :: hcell
2796  real(DP) :: hcellold
2797  real(DP) :: snnew
2798  real(DP) :: snold
2799  real(DP) :: stoe
2800  real(DP) :: stoi
2801  real(DP) :: dwc
2802  real(DP) :: tled
2803  real(DP) :: hcof
2804  real(DP) :: rhs
2805  real(DP) :: v1
2806  real(DP) :: v2
2807  real(DP) :: df
2808  !
2809  ! -- initialize local variables
2810  icheck = this%iconvchk
2811  ipakfail = 0
2812  locdhmax = 0
2813  locrmax = 0
2814  ifirst = 1
2815  dhmax = dzero
2816  rmax = dzero
2817  !
2818  ! -- additional checks to see if convergence needs to be checked
2819  ! -- no convergence check for steady-state stress periods
2820  if (this%gwfiss /= 0) then
2821  icheck = 0
2822  else
2823  if (icnvgmod == 0) then
2824  icheck = 0
2825  end if
2826  end if
2827  !
2828  ! -- perform package convergence check
2829  if (icheck /= 0) then
2830  if (delt > dzero) then
2831  tled = done / delt
2832  else
2833  tled = dzero
2834  end if
2835  final_check: do ib = 1, this%ninterbeds
2836  idelay = this%idelay(ib)
2837  node = this%nodelist(ib)
2838  !
2839  ! -- skip nodelay interbeds
2840  if (idelay == 0) cycle
2841  !
2842  ! -- skip inactive cells
2843  if (this%ibound(node) < 1) cycle
2844  !
2845  ! -- evaluate the maximum head change in the interbed
2846  dh = this%dbdhmax(idelay)
2847  !
2848  ! -- evaluate difference between storage changes
2849  ! in the interbed and exchange between the interbed
2850  ! and the gwf cell
2851  area = this%dis%get_area(node)
2852  hcell = hnew(node)
2853  hcellold = hold(node)
2854  !
2855  ! -- calculate cell saturation
2856  call this%csub_calc_sat(node, hcell, hcellold, snnew, snold)
2857  !
2858  ! -- calculate the change in storage
2859  call this%csub_delay_calc_dstor(ib, hcell, stoe, stoi)
2860  v1 = (stoe + stoi) * area * this%rnb(ib) * tled
2861  !
2862  ! -- add water compressibility to storage term
2863  call this%csub_delay_calc_wcomp(ib, dwc)
2864  v1 = v1 + dwc * area * this%rnb(ib)
2865  !
2866  ! -- calculate the flow between the interbed and the cell
2867  call this%csub_delay_fc(ib, hcof, rhs)
2868  v2 = (-hcof * hcell - rhs) * area * this%rnb(ib)
2869  !
2870  ! -- calculate the difference between the interbed change in
2871  ! storage and the flow between the interbed and the cell
2872  df = v2 - v1
2873  !
2874  ! -- normalize by cell area and convert to a depth
2875  df = df * delt / area
2876  !
2877  ! -- evaluate magnitude of differences
2878  if (ifirst == 1) then
2879  ifirst = 0
2880  locdhmax = ib
2881  dhmax = dh
2882  locrmax = ib
2883  rmax = df
2884  else
2885  if (abs(dh) > abs(dhmax)) then
2886  locdhmax = ib
2887  dhmax = dh
2888  end if
2889  if (abs(df) > abs(rmax)) then
2890  locrmax = ib
2891  rmax = df
2892  end if
2893  end if
2894  end do final_check
2895  !
2896  ! -- set dpak and cpak
2897  ! -- update head error
2898  if (abs(dhmax) > abs(dpak)) then
2899  ipak = locdhmax
2900  dpak = dhmax
2901  write (cloc, "(a,'-',a)") trim(this%packName), 'head'
2902  cpak = cloc
2903  end if
2904  !
2905  ! -- update storage error
2906  if (abs(rmax) > abs(dpak)) then
2907  ipak = locrmax
2908  dpak = rmax
2909  write (cloc, "(a,'-',a)") trim(this%packName), 'storage'
2910  cpak = cloc
2911  end if
2912  !
2913  ! -- write convergence data to package csv
2914  if (this%ipakcsv /= 0) then
2915  !
2916  ! -- write the data
2917  call this%pakcsvtab%add_term(innertot)
2918  call this%pakcsvtab%add_term(totim)
2919  call this%pakcsvtab%add_term(kper)
2920  call this%pakcsvtab%add_term(kstp)
2921  call this%pakcsvtab%add_term(kiter)
2922  if (this%ndelaybeds > 0) then
2923  call this%pakcsvtab%add_term(dhmax)
2924  call this%pakcsvtab%add_term(locdhmax)
2925  call this%pakcsvtab%add_term(rmax)
2926  call this%pakcsvtab%add_term(locrmax)
2927  else
2928  call this%pakcsvtab%add_term('--')
2929  call this%pakcsvtab%add_term('--')
2930  call this%pakcsvtab%add_term('--')
2931  call this%pakcsvtab%add_term('--')
2932  end if
2933  !
2934  ! -- finalize the package csv
2935  if (iend == 1) then
2936  call this%pakcsvtab%finalize_table()
2937  end if
2938  end if
2939  end if
real(dp), pointer, public totim
time relative to start of simulation
Definition: tdis.f90:32
integer(i4b), pointer, public kstp
current time step number
Definition: tdis.f90:24

◆ csub_cg_calc_comp()

subroutine gwfcsubmodule::csub_cg_calc_comp ( class(gwfcsubtype this,
integer(i4b), intent(in)  node,
real(dp), intent(in)  hcell,
real(dp), intent(in)  hcellold,
real(dp), intent(inout)  comp 
)
private

Method calculates coarse-grained compaction in a cell.

Parameters
[in,out]compcoarse-grained compaction
[in]nodecell node number
[in]hcellcurrent head in cell
[in]hcelloldprevious head in cell
[in,out]compcoarse-grained compaction

Definition at line 4792 of file gwf-csub.f90.

4793  ! -- dummy variables
4794  class(GwfCsubType) :: this
4795  integer(I4B), intent(in) :: node !< cell node number
4796  real(DP), intent(in) :: hcell !< current head in cell
4797  real(DP), intent(in) :: hcellold !< previous head in cell
4798  real(DP), intent(inout) :: comp !< coarse-grained compaction
4799  ! -- local variables
4800  real(DP) :: area
4801  real(DP) :: tled
4802  real(DP) :: hcof
4803  real(DP) :: rhs
4804  !
4805  ! -- initialize variables
4806  area = done
4807  tled = done
4808  !
4809  ! -- calculate terms
4810  call this%csub_cg_fc(node, tled, area, hcell, hcellold, hcof, rhs)
4811  !
4812  ! - calculate compaction
4813  comp = hcof * hcell - rhs

◆ csub_cg_calc_sske()

subroutine gwfcsubmodule::csub_cg_calc_sske ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  n,
real(dp), intent(inout)  sske,
real(dp), intent(in)  hcell 
)

Method calculates Sske for coarse-grained materials in a cell.

Parameters
[in,out]sskecoarse-grained Sske
[in]ncell node number
[in,out]sskecoarse grained Sske
[in]hcellcurrent head in cell

Definition at line 4736 of file gwf-csub.f90.

4737  ! -- dummy variables
4738  class(GwfCsubType), intent(inout) :: this
4739  integer(I4B), intent(in) :: n !< cell node number
4740  real(DP), intent(inout) :: sske !< coarse grained Sske
4741  real(DP), intent(in) :: hcell !< current head in cell
4742  ! -- local variables
4743  real(DP) :: top
4744  real(DP) :: bot
4745  real(DP) :: hbar
4746  real(DP) :: znode
4747  real(DP) :: es
4748  real(DP) :: es0
4749  real(DP) :: theta
4750  real(DP) :: f
4751  real(DP) :: f0
4752  !
4753  ! -- initialize variables
4754  sske = dzero
4755  !
4756  ! -- calculate factor for the head-based case
4757  if (this%lhead_based .EQV. .true.) then
4758  f = done
4759  f0 = done
4760  !
4761  ! -- calculate factor for the effective stress case
4762  else
4763  top = this%dis%top(n)
4764  bot = this%dis%bot(n)
4765  !
4766  ! -- calculate corrected head (hbar)
4767  hbar = squadratic0sp(hcell, bot, this%satomega)
4768  !
4769  ! -- calculate znode
4770  znode = this%csub_calc_znode(top, bot, hbar)
4771  !
4772  ! -- calculate effective stress and theta
4773  es = this%cg_es(n)
4774  es0 = this%cg_es0(n)
4775  theta = this%cg_thetaini(n)
4776  !
4777  ! -- calculate the compression index factors for the delay
4778  ! node relative to the center of the cell based on the
4779  ! current and previous head
4780  call this%csub_calc_sfacts(n, bot, znode, theta, es, es0, f)
4781  end if
4782  sske = f * this%cg_ske_cr(n)
Here is the call graph for this function:

◆ csub_cg_calc_stress()

subroutine gwfcsubmodule::csub_cg_calc_stress ( class(gwfcsubtype this,
integer(i4b), intent(in)  nodes,
real(dp), dimension(nodes), intent(in)  hnew 
)
private

Method calculates the geostatic stress, pressure head, and effective stress at the bottom of each cell. The method also applies the overlying geostatic stress (sig0) not represented in the model.

Parameters
[in]nodesnumber of active model nodes
[in]hnewcurrent head

Definition at line 3646 of file gwf-csub.f90.

3647  ! -- dummy variables
3648  class(GwfCsubType) :: this
3649  integer(I4B), intent(in) :: nodes !< number of active model nodes
3650  real(DP), dimension(nodes), intent(in) :: hnew !< current head
3651  ! -- local variables
3652  integer(I4B) :: node
3653  integer(I4B) :: ii
3654  integer(I4B) :: nn
3655  integer(I4B) :: m
3656  integer(I4B) :: idx_conn
3657  real(DP) :: gs
3658  real(DP) :: top
3659  real(DP) :: bot
3660  real(DP) :: thick
3661  real(DP) :: va_scale
3662  real(DP) :: hcell
3663  real(DP) :: hbar
3664  real(DP) :: gs_conn
3665  real(DP) :: es
3666  real(DP) :: phead
3667  real(DP) :: sadd
3668  !
3669  ! -- calculate geostatic stress if necessary
3670  if (this%iupdatestress /= 0) then
3671  do node = 1, this%dis%nodes
3672  !
3673  ! -- calculate geostatic stress for this node
3674  ! this represents the geostatic stress component
3675  ! for the cell
3676  top = this%dis%top(node)
3677  bot = this%dis%bot(node)
3678  thick = top - bot
3679  !
3680  ! -- calculate cell contribution to geostatic stress
3681  if (this%ibound(node) /= 0) then
3682  hcell = hnew(node)
3683  else
3684  hcell = bot
3685  end if
3686  !
3687  ! -- calculate corrected head (hbar)
3688  hbar = squadratic0sp(hcell, bot, this%satomega)
3689  !
3690  ! -- geostatic stress calculation
3691  if (hcell < top) then
3692  gs = (top - hbar) * this%sgm(node) + (hbar - bot) * this%sgs(node)
3693  else
3694  gs = thick * this%sgs(node)
3695  end if
3696  !
3697  ! -- cell contribution to geostatic stress
3698  this%cg_gs(node) = gs
3699  end do
3700  !
3701  ! -- add user specified overlying geostatic stress
3702  do nn = 1, this%nbound
3703  node = this%nodelistsig0(nn)
3704  sadd = this%sig0(nn)
3705  this%cg_gs(node) = this%cg_gs(node) + sadd
3706  end do
3707  !
3708  ! -- calculate geostatic stress above cell
3709  do node = 1, this%dis%nodes
3710  !
3711  ! -- geostatic stress of cell
3712  gs = this%cg_gs(node)
3713  !
3714  ! -- Add geostatic stress of overlying cells (ihc=0)
3715  ! m < node = m is vertically above node
3716  do ii = this%dis%con%ia(node) + 1, this%dis%con%ia(node + 1) - 1
3717  !
3718  ! -- Set the m cell number
3719  m = this%dis%con%ja(ii)
3720  idx_conn = this%dis%con%jas(ii)
3721  !
3722  ! -- vertical connection
3723  if (this%dis%con%ihc(idx_conn) == 0) then
3724  !
3725  ! -- node has an overlying cell
3726  if (m < node) then
3727  !
3728  ! -- dis and disv discretization
3729  if (this%dis%ndim /= 1) then
3730  gs = gs + this%cg_gs(m)
3731  !
3732  ! -- disu discretization
3733  else
3734  va_scale = this%dis%get_area_factor(node, idx_conn)
3735  gs_conn = this%cg_gs(m)
3736  gs = gs + (gs_conn * va_scale)
3737  end if
3738  end if
3739  end if
3740  end do
3741  !
3742  ! -- geostatic stress for cell with geostatic stress
3743  ! of overlying cells
3744  this%cg_gs(node) = gs
3745  end do
3746  end if
3747  !
3748  ! -- save effective stress from the last iteration and
3749  ! calculate the new effective stress for a cell
3750  do node = 1, this%dis%nodes
3751  top = this%dis%top(node)
3752  bot = this%dis%bot(node)
3753  if (this%ibound(node) /= 0) then
3754  hcell = hnew(node)
3755  else
3756  hcell = bot
3757  end if
3758  !
3759  ! -- calculate corrected head (hbar)
3760  hbar = squadratic0sp(hcell, bot, this%satomega)
3761  !
3762  ! -- calculate pressure head
3763  phead = hbar - bot
3764  !
3765  ! -- calculate effective stress
3766  es = this%cg_gs(node) - phead
3767  this%cg_es(node) = es
3768  end do
Here is the call graph for this function:

◆ csub_cg_chk_stress()

subroutine gwfcsubmodule::csub_cg_chk_stress ( class(gwfcsubtype this)
private

Method checks calculated effective stress values to ensure that effective stress values are positive. An error condition and message are issued if calculated effective stress values are less than a small positive value (DEM6).

Definition at line 3779 of file gwf-csub.f90.

3780  ! -- dummy variables
3781  class(GwfCsubType) :: this
3782  ! -- local variables
3783  character(len=20) :: cellid
3784  integer(I4B) :: ierr
3785  integer(I4B) :: node
3786  real(DP) :: gs
3787  real(DP) :: bot
3788  real(DP) :: hcell
3789  real(DP) :: es
3790  real(DP) :: phead
3791  !
3792  ! -- initialize variables
3793  ierr = 0
3794  !
3795  ! -- check geostatic stress if necessary
3796  !
3797  ! -- save effective stress from the last iteration and
3798  ! calculate the new effective stress for a cell
3799  do node = 1, this%dis%nodes
3800  if (this%ibound(node) < 1) cycle
3801  bot = this%dis%bot(node)
3802  gs = this%cg_gs(node)
3803  es = this%cg_es(node)
3804  phead = dzero
3805  if (this%ibound(node) /= 0) then
3806  phead = gs - es
3807  end if
3808  hcell = phead + bot
3809  if (this%lhead_based .EQV. .false.) then
3810  if (es < dem6) then
3811  ierr = ierr + 1
3812  call this%dis%noder_to_string(node, cellid)
3813  write (errmsg, '(a,g0,a,1x,a,1x,a,4(g0,a))') &
3814  'Small to negative effective stress (', es, ') in cell', &
3815  trim(adjustl(cellid)), '. (', es, ' = ', this%cg_gs(node), &
3816  ' - (', hcell, ' - ', bot, ').'
3817  call store_error(errmsg)
3818  end if
3819  end if
3820  end do
3821  !
3822  ! -- write a summary error message
3823  if (ierr > 0) then
3824  write (errmsg, '(a,1x,i0,3(1x,a))') &
3825  'Solution: small to negative effective stress values in', ierr, &
3826  'cells can be eliminated by increasing storage values and/or ', &
3827  'adding/modifying stress boundaries to prevent water-levels from', &
3828  'exceeding the top of the model.'
3829  call store_error(errmsg)
3830  call store_error_filename(this%input_fname)
3831  end if
Here is the call graph for this function:

◆ csub_cg_fc()

subroutine gwfcsubmodule::csub_cg_fc ( class(gwfcsubtype this,
integer(i4b), intent(in)  node,
real(dp), intent(in)  tled,
real(dp), intent(in)  area,
real(dp), intent(in)  hcell,
real(dp), intent(in)  hcellold,
real(dp), intent(inout)  hcof,
real(dp), intent(inout)  rhs 
)
private

Method formulates the coefficient matrix and right-hand side terms for coarse grained materials in a cell.

Parameters
[in,out]hcofcoarse-grained A matrix entry
[in,out]rhscoarse-grained right-hand side entry
[in]nodecell node number
[in]tledrecripicol of the time step length
[in]areahorizontal cell area
[in]hcellcurrent head
[in]hcelloldprevious head
[in,out]hcofcoarse-grained A matrix entry
[in,out]rhscoarse-grained right-hand side entry

Definition at line 4422 of file gwf-csub.f90.

4423  ! -- dummy variables
4424  class(GwfCsubType) :: this
4425  integer(I4B), intent(in) :: node !< cell node number
4426  real(DP), intent(in) :: tled !< recripicol of the time step length
4427  real(DP), intent(in) :: area !< horizontal cell area
4428  real(DP), intent(in) :: hcell !< current head
4429  real(DP), intent(in) :: hcellold !< previous head
4430  real(DP), intent(inout) :: hcof !< coarse-grained A matrix entry
4431  real(DP), intent(inout) :: rhs !< coarse-grained right-hand side entry
4432  ! -- local variables
4433  real(DP) :: top
4434  real(DP) :: bot
4435  real(DP) :: tthk
4436  real(DP) :: snold
4437  real(DP) :: snnew
4438  real(DP) :: hbar
4439  real(DP) :: sske
4440  real(DP) :: rho1
4441  !
4442  ! -- initialize variables
4443  rhs = dzero
4444  hcof = dzero
4445  !
4446  ! -- aquifer elevations and thickness
4447  top = this%dis%top(node)
4448  bot = this%dis%bot(node)
4449  tthk = this%cg_thickini(node)
4450  !
4451  ! -- calculate hcof and rhs terms if coarse-grained materials present
4452  if (tthk > dzero) then
4453  !
4454  ! -- calculate aquifer saturation
4455  call this%csub_calc_sat(node, hcell, hcellold, snnew, snold)
4456  !
4457  ! -- calculate corrected head (hbar)
4458  hbar = squadratic0sp(hcell, bot, this%satomega)
4459  !
4460  ! -- storage coefficients
4461  call this%csub_cg_calc_sske(node, sske, hcell)
4462  rho1 = sske * area * tthk * tled
4463  !
4464  ! -- update sk and ske
4465  this%cg_ske(node) = sske * tthk * snold
4466  this%cg_sk(node) = sske * tthk * snnew
4467  !
4468  ! -- calculate hcof and rhs term
4469  hcof = -rho1 * snnew
4470  rhs = rho1 * snold * this%cg_es0(node) - &
4471  rho1 * snnew * (this%cg_gs(node) + bot)
4472  !
4473  ! -- calculate and apply the flow correction term
4474  rhs = rhs - rho1 * snnew * (hcell - hbar)
4475  end if
Here is the call graph for this function:

◆ csub_cg_fn()

subroutine gwfcsubmodule::csub_cg_fn ( class(gwfcsubtype this,
integer(i4b), intent(in)  node,
real(dp), intent(in)  tled,
real(dp), intent(in)  area,
real(dp), intent(in)  hcell,
real(dp), intent(inout)  hcof,
real(dp), intent(inout)  rhs 
)
private

Method formulates the coefficient matrix and right-hand side terms for coarse grained materials in a cell when using the Newton-Raphson formulation.

Parameters
[in,out]hcofcoarse-grained A matrix entry
[in,out]rhscoarse-grained right-hand side entry
[in]nodenode number
[in]tledreciprocal of the time step length
[in]areahorizontal cell area
[in]hcellcurrent head in cell
[in,out]hcofcoarse-grained A matrix entry
[in,out]rhscoarse-grained right-hand side entry

Definition at line 4488 of file gwf-csub.f90.

4489  ! -- dummy variables
4490  class(GwfCsubType) :: this
4491  integer(I4B), intent(in) :: node !< node number
4492  real(DP), intent(in) :: tled !< reciprocal of the time step length
4493  real(DP), intent(in) :: area !< horizontal cell area
4494  real(DP), intent(in) :: hcell !< current head in cell
4495  real(DP), intent(inout) :: hcof !< coarse-grained A matrix entry
4496  real(DP), intent(inout) :: rhs !< coarse-grained right-hand side entry
4497  ! -- local variables
4498  real(DP) :: top
4499  real(DP) :: bot
4500  real(DP) :: tthk
4501  real(DP) :: snnew
4502  real(DP) :: snold
4503  real(DP) :: satderv
4504  real(DP) :: hbar
4505  real(DP) :: hbarderv
4506  real(DP) :: sske
4507  real(DP) :: rho1
4508  !
4509  ! -- initialize variables
4510  rhs = dzero
4511  hcof = dzero
4512  !
4513  ! -- aquifer elevations and thickness
4514  top = this%dis%top(node)
4515  bot = this%dis%bot(node)
4516  tthk = this%cg_thickini(node)
4517  !
4518  ! -- calculate newton terms if coarse-grained materials present
4519  if (tthk > dzero) then
4520  !
4521  ! -- calculate aquifer saturation - only need snnew
4522  call this%csub_calc_sat(node, hcell, top, snnew, snold)
4523  !
4524  ! -- calculate saturation derivative
4525  satderv = this%csub_calc_sat_derivative(node, hcell)
4526  !
4527  ! -- calculate corrected head (hbar)
4528  hbar = squadratic0sp(hcell, bot, this%satomega)
4529  !
4530  ! -- calculate the derivative of the hbar functions
4531  hbarderv = squadratic0spderivative(hcell, bot, this%satomega)
4532  !
4533  ! -- storage coefficients
4534  call this%csub_cg_calc_sske(node, sske, hcell)
4535  rho1 = sske * area * tthk * tled
4536  !
4537  ! -- calculate hcof term
4538  hcof = rho1 * snnew * (done - hbarderv) + &
4539  rho1 * (this%cg_gs(node) - hbar + bot) * satderv
4540  !
4541  ! -- Add additional term if using lagged effective stress
4542  if (this%ieslag /= 0) then
4543  hcof = hcof - rho1 * this%cg_es0(node) * satderv
4544  end if
4545  !
4546  ! -- calculate rhs term
4547  rhs = hcof * hcell
4548  end if
Here is the call graph for this function:

◆ csub_cg_update()

subroutine gwfcsubmodule::csub_cg_update ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  node 
)
private

Method updates coarse-grained material properties in a cell.

Parameters
[in]nodecell node number

Definition at line 4821 of file gwf-csub.f90.

4822  ! -- dummy variables
4823  class(GwfCsubType), intent(inout) :: this
4824  integer(I4B), intent(in) :: node !< cell node number
4825  ! -- local variables
4826  character(len=20) :: cellid
4827  real(DP) :: comp
4828  real(DP) :: thick
4829  real(DP) :: theta
4830  !
4831  ! -- update thickness and theta
4832  comp = this%cg_tcomp(node) + this%cg_comp(node)
4833  call this%dis%noder_to_string(node, cellid)
4834  if (abs(comp) > dzero) then
4835  thick = this%cg_thickini(node)
4836  theta = this%cg_thetaini(node)
4837  call this%csub_adj_matprop(comp, thick, theta)
4838  if (thick <= dzero) then
4839  write (errmsg, '(a,1x,a,1x,a,g0,a)') &
4840  'Adjusted thickness for cell', trim(adjustl(cellid)), &
4841  'is less than or equal to 0 (', thick, ').'
4842  call store_error(errmsg)
4843  end if
4844  if (theta <= dzero) then
4845  write (errmsg, '(a,1x,a,1x,a,g0,a)') &
4846  'Adjusted theta for cell', trim(adjustl(cellid)), &
4847  'is less than or equal to 0 (', theta, ').'
4848  call store_error(errmsg)
4849  end if
4850  this%cg_thick(node) = thick
4851  this%cg_theta(node) = theta
4852  end if
Here is the call graph for this function:

◆ csub_cg_wcomp_fc()

subroutine gwfcsubmodule::csub_cg_wcomp_fc ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  node,
real(dp), intent(in)  tled,
real(dp), intent(in)  area,
real(dp), intent(in)  hcell,
real(dp), intent(in)  hcellold,
real(dp), intent(inout)  hcof,
real(dp), intent(inout)  rhs 
)
private

Method formulates the standard formulation coefficient matrix and right-hand side terms for water compressibility in coarse-grained sediments.

Parameters
[in,out]hcofcoarse-grained A matrix entry
[in,out]rhscoarse-grained right-hand side entry
[in]nodecell node number
[in]tledreciprocal of the time step length
[in]areahorizontal cell area
[in]hcellcurrent head in cell
[in]hcelloldprevious head in cell
[in,out]hcofcoarse-grained A matrix entry
[in,out]rhscoarse-grained right-hand side entry

Definition at line 4865 of file gwf-csub.f90.

4867  ! -- dummy variables
4868  class(GwfCsubType), intent(inout) :: this
4869  integer(I4B), intent(in) :: node !< cell node number
4870  real(DP), intent(in) :: tled !< reciprocal of the time step length
4871  real(DP), intent(in) :: area !< horizontal cell area
4872  real(DP), intent(in) :: hcell !< current head in cell
4873  real(DP), intent(in) :: hcellold !< previous head in cell
4874  real(DP), intent(inout) :: hcof !< coarse-grained A matrix entry
4875  real(DP), intent(inout) :: rhs !< coarse-grained right-hand side entry
4876  ! -- local variables
4877  real(DP) :: top
4878  real(DP) :: bot
4879  real(DP) :: tthk
4880  real(DP) :: tthk0
4881  real(DP) :: snold
4882  real(DP) :: snnew
4883  real(DP) :: wc
4884  real(DP) :: wc0
4885  !
4886  ! -- initialize variables
4887  rhs = dzero
4888  hcof = dzero
4889  !
4890  ! -- aquifer elevations and thickness
4891  top = this%dis%top(node)
4892  bot = this%dis%bot(node)
4893  tthk = this%cg_thick(node)
4894  tthk0 = this%cg_thick0(node)
4895  !
4896  ! -- aquifer saturation
4897  call this%csub_calc_sat(node, hcell, hcellold, snnew, snold)
4898  !
4899  ! -- storage coefficients
4900  wc0 = this%brg * area * tthk0 * this%cg_theta0(node) * tled
4901  wc = this%brg * area * tthk * this%cg_theta(node) * tled
4902  !
4903  ! -- calculate hcof term
4904  hcof = -wc * snnew
4905  !
4906  ! -- calculate rhs term
4907  rhs = -wc0 * snold * hcellold

◆ csub_cg_wcomp_fn()

subroutine gwfcsubmodule::csub_cg_wcomp_fn ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  node,
real(dp), intent(in)  tled,
real(dp), intent(in)  area,
real(dp), intent(in)  hcell,
real(dp), intent(in)  hcellold,
real(dp), intent(inout)  hcof,
real(dp), intent(inout)  rhs 
)
private

Method formulates the Newton-Raphson formulation coefficient matrix and right-hand side terms for water compressibility in coarse-grained sediments.

Parameters
[in,out]hcofcoarse-grained A matrix entry
[in,out]rhscoarse-grained right-hand side entry
[in]nodecell node number
[in]tledreciprocal of the time step length
[in]areahorizontal cell area
[in]hcellcurrent head in cell
[in]hcelloldprevious head in cell
[in,out]hcofcoarse-grained A matrix entry
[in,out]rhscoarse-grained right-hand side entry

Definition at line 4920 of file gwf-csub.f90.

4921  ! -- dummy variables
4922  class(GwfCsubType), intent(inout) :: this
4923  integer(I4B), intent(in) :: node !< cell node number
4924  real(DP), intent(in) :: tled !< reciprocal of the time step length
4925  real(DP), intent(in) :: area !< horizontal cell area
4926  real(DP), intent(in) :: hcell !< current head in cell
4927  real(DP), intent(in) :: hcellold !< previous head in cell
4928  real(DP), intent(inout) :: hcof !< coarse-grained A matrix entry
4929  real(DP), intent(inout) :: rhs !< coarse-grained right-hand side entry
4930  ! -- local variables
4931  real(DP) :: top
4932  real(DP) :: bot
4933  real(DP) :: tthk
4934  real(DP) :: tthk0
4935  real(DP) :: satderv
4936  real(DP) :: f
4937  real(DP) :: wc
4938  real(DP) :: wc0
4939  !
4940  ! -- initialize variables
4941  rhs = dzero
4942  hcof = dzero
4943  !
4944  ! -- aquifer elevations and thickness
4945  top = this%dis%top(node)
4946  bot = this%dis%bot(node)
4947  tthk = this%cg_thick(node)
4948  !
4949  ! -- calculate saturation derivative
4950  satderv = this%csub_calc_sat_derivative(node, hcell)
4951  !
4952  ! -- calculate water compressibility factor
4953  f = this%brg * area * tled
4954  !
4955  ! -- water compressibility coefficient
4956  wc = f * tthk * this%cg_theta(node)
4957  !
4958  ! -- calculate hcof term
4959  hcof = -wc * hcell * satderv
4960  !
4961  ! -- Add additional term if using lagged effective stress
4962  if (this%ieslag /= 0) then
4963  tthk0 = this%cg_thick0(node)
4964  wc0 = f * tthk0 * this%cg_theta0(node)
4965  hcof = hcof + wc * hcellold * satderv
4966  end if
4967  !
4968  ! -- calculate rhs term
4969  rhs = hcof * hcell

◆ csub_cq()

subroutine gwfcsubmodule::csub_cq ( class(gwfcsubtype this,
integer(i4b), intent(in)  nodes,
real(dp), dimension(nodes), intent(in)  hnew,
real(dp), dimension(nodes), intent(in)  hold,
integer(i4b), intent(in)  isuppress_output,
real(dp), dimension(:), intent(inout), contiguous  flowja 
)

Flow calculation for the CSUB package components. Components include coarse-grained storage, delay and no-delay interbeds, and water compressibility.

Parameters
[in,out]model_budgetmodel budget object
[in]nodesnumber of active model nodes
[in]hnewcurrent head
[in]holdhead for the previous time step
[in]isuppress_outputflag indicating if budget output should be suppressed

Definition at line 2951 of file gwf-csub.f90.

2952  ! -- modules
2953  use tdismodule, only: delt
2954  use constantsmodule, only: lenboundname, dzero, done
2955  ! -- dummy variables
2956  class(GwfCsubType) :: this
2957  integer(I4B), intent(in) :: nodes !< number of active model nodes
2958  real(DP), intent(in), dimension(nodes) :: hnew !< current head
2959  real(DP), intent(in), dimension(nodes) :: hold !< head for the previous time step
2960  integer(I4B), intent(in) :: isuppress_output !< flag indicating if budget output should be suppressed
2961  real(DP), dimension(:), contiguous, intent(inout) :: flowja
2962  ! -- local variables
2963  integer(I4B) :: ib
2964  integer(I4B) :: idelay
2965  integer(I4B) :: ielastic
2966  integer(I4B) :: iconvert
2967  integer(I4B) :: node
2968  integer(I4B) :: nn
2969  integer(I4B) :: n
2970  integer(I4B) :: idiag
2971  real(DP) :: es
2972  real(DP) :: pcs
2973  real(DP) :: rho1
2974  real(DP) :: rho2
2975  real(DP) :: tled
2976  real(DP) :: tledm
2977  real(DP) :: es0
2978  real(DP) :: rrate
2979  real(DP) :: ratein
2980  real(DP) :: rateout
2981  real(DP) :: comp
2982  real(DP) :: compi
2983  real(DP) :: compe
2984  real(DP) :: area
2985  real(DP) :: h
2986  real(DP) :: h0
2987  real(DP) :: snnew
2988  real(DP) :: snold
2989  real(DP) :: hcof
2990  real(DP) :: rhs
2991  real(DP) :: stoe
2992  real(DP) :: stoi
2993  real(DP) :: b
2994  real(DP) :: q
2995  real(DP) :: rratewc
2996  ! -- for observations
2997  integer(I4B) :: iprobslocal
2998  ! -- formats
2999  !
3000  ! -- Suppress saving of simulated values; they
3001  ! will be saved at end of this procedure.
3002  iprobslocal = 0
3003  ratein = dzero
3004  rateout = dzero
3005  !
3006  ! -- coarse-grained coarse-grained storage
3007  do node = 1, this%dis%nodes
3008  idiag = this%dis%con%ia(node)
3009  area = this%dis%get_area(node)
3010  comp = dzero
3011  rrate = dzero
3012  rratewc = dzero
3013  if (this%gwfiss == 0) then
3014  if (delt > dzero) then
3015  tled = done / delt
3016  else
3017  tled = dzero
3018  end if
3019  if (this%ibound(node) > 0 .and. this%cg_thickini(node) > dzero) then
3020  !
3021  ! -- calculate coarse-grained storage terms
3022  call this%csub_cg_fc(node, tled, area, hnew(node), hold(node), &
3023  hcof, rhs)
3024  rrate = hcof * hnew(node) - rhs
3025  !
3026  ! -- calculate compaction
3027  call this%csub_cg_calc_comp(node, hnew(node), hold(node), comp)
3028  !
3029  ! -- calculate coarse-grained water compressibility storage terms
3030  call this%csub_cg_wcomp_fc(node, tled, area, hnew(node), hold(node), &
3031  hcof, rhs)
3032  rratewc = hcof * hnew(node) - rhs
3033  end if
3034  end if
3035  !
3036  ! -- update coarse-grained storage and water
3037  ! compression variables
3038  this%cg_stor(node) = rrate
3039  this%cell_wcstor(node) = rratewc
3040  this%cell_thick(node) = this%cg_thick(node)
3041  !
3042  ! -- update incremental coarse-grained compaction
3043  this%cg_comp(node) = comp
3044  !
3045  !
3046  ! -- update states if required
3047  if (isuppress_output == 0) then
3048  !
3049  ! -- calculate strain and change in coarse-grained void ratio and thickness
3050  ! todo: consider moving error check in csub_cg_update to ot()
3051  if (this%iupdatematprop /= 0) then
3052  call this%csub_cg_update(node)
3053  end if
3054  !
3055  ! -- update total compaction
3056  this%cg_tcomp(node) = this%cg_tcomp(node) + comp
3057  end if
3058  !
3059  ! -- update flowja
3060  flowja(idiag) = flowja(idiag) + rrate
3061  flowja(idiag) = flowja(idiag) + rratewc
3062  end do
3063  !
3064  ! -- interbed storage
3065  !
3066  ! -- reset delay bed counters for the current time step
3067  if (this%ndelaybeds > 0) then
3068  this%idb_nconv_count(1) = 0
3069  end if
3070  !
3071  ! -- initialize tled
3072  tled = done
3073  !
3074  ! -- calculate budget terms for each interbed
3075  do ib = 1, this%ninterbeds
3076  rratewc = dzero
3077  idelay = this%idelay(ib)
3078  ielastic = this%ielastic(ib)
3079  !
3080  ! -- calculate interbed thickness
3081  ! -- no delay interbeds
3082  if (idelay == 0) then
3083  b = this%thick(ib)
3084  ! -- delay interbeds
3085  else
3086  b = this%thick(ib) * this%rnb(ib)
3087  end if
3088  !
3089  ! -- set variables required for no-delay and delay interbeds
3090  node = this%nodelist(ib)
3091  idiag = this%dis%con%ia(node)
3092  area = this%dis%get_area(node)
3093  !
3094  ! -- add interbed thickness to cell thickness
3095  this%cell_thick(node) = this%cell_thick(node) + b
3096  !
3097  ! -- update budget terms if transient stress period
3098  if (this%gwfiss == 0) then
3099  if (delt > dzero) then
3100  tledm = done / delt
3101  else
3102  tledm = dzero
3103  end if
3104  !
3105  ! -- skip inactive and constant head cells
3106  if (this%ibound(node) < 1) cycle
3107  !
3108  ! -- no delay interbeds
3109  if (idelay == 0) then
3110  iconvert = this%iconvert(ib)
3111  stoi = dzero
3112  !
3113  ! -- calculate compaction
3114  call this%csub_nodelay_calc_comp(ib, hnew(node), hold(node), comp, &
3115  rho1, rho2)
3116  !
3117  ! -- interbed stresses
3118  es = this%cg_es(node)
3119  pcs = this%pcs(ib)
3120  es0 = this%cg_es0(node)
3121  !
3122  ! -- calculate inelastic and elastic compaction
3123  if (ielastic > 0 .or. iconvert == 0) then
3124  stoe = comp
3125  else
3126  stoi = -pcs * rho2 + (rho2 * es)
3127  stoe = pcs * rho1 - (rho1 * es0)
3128  end if
3129  compe = stoe
3130  compi = stoi
3131  stoe = stoe * area
3132  stoi = stoi * area
3133  this%storagee(ib) = stoe * tledm
3134  this%storagei(ib) = stoi * tledm
3135  !
3136  ! -- update compaction
3137  this%comp(ib) = comp
3138  !
3139  ! -- update states if required
3140  if (isuppress_output == 0) then
3141  !
3142  ! -- calculate strain and change in interbed void ratio and thickness
3143  if (this%iupdatematprop /= 0) then
3144  call this%csub_nodelay_update(ib)
3145  end if
3146  !
3147  ! -- update total compaction
3148  this%tcomp(ib) = this%tcomp(ib) + comp
3149  this%tcompe(ib) = this%tcompe(ib) + compe
3150  this%tcompi(ib) = this%tcompi(ib) + compi
3151  end if
3152  !
3153  ! -- delay interbeds
3154  else
3155  h = hnew(node)
3156  h0 = hold(node)
3157  !
3158  ! -- calculate cell saturation
3159  call this%csub_calc_sat(node, h, h0, snnew, snold)
3160  !
3161  ! -- calculate inelastic and elastic storage contributions
3162  call this%csub_delay_calc_dstor(ib, h, stoe, stoi)
3163  this%storagee(ib) = stoe * area * this%rnb(ib) * tledm
3164  this%storagei(ib) = stoi * area * this%rnb(ib) * tledm
3165  !
3166  ! -- calculate flow across the top and bottom of the delay interbed
3167  q = this%csub_calc_delay_flow(ib, 1, h) * area * this%rnb(ib)
3168  this%dbflowtop(idelay) = q
3169  nn = this%ndelaycells
3170  q = this%csub_calc_delay_flow(ib, nn, h) * area * this%rnb(ib)
3171  this%dbflowbot(idelay) = q
3172  !
3173  ! -- update states if required
3174  if (isuppress_output == 0) then
3175  !
3176  ! -- calculate sum of compaction in delay interbed
3177  call this%csub_delay_calc_comp(ib, h, h0, comp, compi, compe)
3178  !
3179  ! - calculate strain and change in interbed void ratio and thickness
3180  ! todo: consider moving error check in csub_delay_update to ot()
3181  if (this%iupdatematprop /= 0) then
3182  call this%csub_delay_update(ib)
3183  end if
3184  !
3185  ! -- update total compaction for interbed
3186  this%tcomp(ib) = this%tcomp(ib) + comp
3187  this%tcompi(ib) = this%tcompi(ib) + compi
3188  this%tcompe(ib) = this%tcompe(ib) + compe
3189  !
3190  ! -- update total compaction for each delay bed cell
3191  do n = 1, this%ndelaycells
3192  this%dbtcomp(n, idelay) = this%dbtcomp(n, idelay) + &
3193  this%dbcomp(n, idelay)
3194  end do
3195  !
3196  ! -- check delay bed heads relative to the top and bottom of each
3197  ! delay bed cell for convertible and non-convertible gwf cells
3198  call this%csub_delay_head_check(ib)
3199  end if
3200  end if
3201  !
3202  ! -- interbed water compressibility
3203  !
3204  ! -- no-delay interbed
3205  if (idelay == 0) then
3206  call this%csub_nodelay_wcomp_fc(ib, node, tledm, area, &
3207  hnew(node), hold(node), hcof, rhs)
3208  rratewc = hcof * hnew(node) - rhs
3209  !
3210  ! -- delay interbed
3211  else
3212  call this%csub_delay_calc_wcomp(ib, q)
3213  rratewc = q * area * this%rnb(ib)
3214  end if
3215  this%cell_wcstor(node) = this%cell_wcstor(node) + rratewc
3216  !
3217  ! -- flowja
3218  flowja(idiag) = flowja(idiag) + rratewc
3219  else
3220  this%storagee(ib) = dzero
3221  this%storagei(ib) = dzero
3222  if (idelay /= 0) then
3223  this%dbflowtop(idelay) = dzero
3224  this%dbflowbot(idelay) = dzero
3225  end if
3226  end if
3227  !
3228  ! -- flowja
3229  flowja(idiag) = flowja(idiag) + this%storagee(ib)
3230  flowja(idiag) = flowja(idiag) + this%storagei(ib)
3231  end do
3232  !
3233  ! -- terminate if errors encountered when updating material properties
3234  if (this%iupdatematprop /= 0) then
3235  if (count_errors() > 0) then
3236  call store_error_filename(this%input_fname)
3237  end if
3238  end if
Here is the call graph for this function:

◆ csub_cr()

subroutine, public gwfcsubmodule::csub_cr ( type(gwfcsubtype), pointer  csubobj,
character(len=*), intent(in)  name_model,
character(len=*), intent(in)  mempath,
integer(i4b), intent(in)  istounit,
character(len=*), intent(in)  stoPckName,
integer(i4b), intent(in)  inunit,
integer(i4b), intent(in)  iout 
)

Create a new CSUB object

Parameters
csubobjpointer to default package type
[in]name_modelmodel name
[in]mempathinput context mem path
[in]inunitunit number of csub input file
[in]istounitunit number of storage package
[in]stopcknamename of the storage package
[in]ioutunit number of lst output file

Definition at line 318 of file gwf-csub.f90.

320  ! -- dummy variables
321  type(GwfCsubType), pointer :: csubobj !< pointer to default package type
322  character(len=*), intent(in) :: name_model !< model name
323  character(len=*), intent(in) :: mempath !< input context mem path
324  integer(I4B), intent(in) :: inunit !< unit number of csub input file
325  integer(I4B), intent(in) :: istounit !< unit number of storage package
326  character(len=*), intent(in) :: stoPckName !< name of the storage package
327  integer(I4B), intent(in) :: iout !< unit number of lst output file
328  ! -- local variables
329  !
330  ! -- allocate the object and assign values to object variables
331  allocate (csubobj)
332 
333  ! -- create name and memory path
334  call csubobj%set_names(1, name_model, 'CSUB', 'CSUB', mempath)
335  !
336  ! -- Allocate scalars
337  call csubobj%csub_allocate_scalars()
338  !
339  ! -- Create memory path to variables from STO package
340  csubobj%stoMemPath = create_mem_path(name_model, stopckname)
341  !
342  ! -- Set variables
343  csubobj%istounit = istounit
344  csubobj%inunit = inunit
345  csubobj%iout = iout
Here is the call graph for this function:
Here is the caller graph for this function:

◆ csub_da()

subroutine gwfcsubmodule::csub_da ( class(gwfcsubtype this)
private

Deallocate CSUB package scalars and arrays.

Definition at line 2055 of file gwf-csub.f90.

2056  ! -- modules
2058  ! -- dummy variables
2059  class(GwfCsubType) :: this
2060  !
2061  ! -- Deallocate arrays if package is active
2062  if (this%inunit > 0) then
2063  call mem_deallocate(this%unodelist)
2064  call mem_deallocate(this%nodelist)
2065  call mem_deallocate(this%idelay)
2066  call mem_deallocate(this%ielastic)
2067  call mem_deallocate(this%iconvert)
2068  !
2069  ! -- grid-based storage data
2070  call mem_deallocate(this%buff)
2071  call mem_deallocate(this%buffusr)
2072  call mem_deallocate(this%sgm)
2073  call mem_deallocate(this%sgs)
2074  call mem_deallocate(this%cg_ske_cr)
2075  call mem_deallocate(this%cg_gs)
2076  call mem_deallocate(this%cg_es)
2077  call mem_deallocate(this%cg_es0)
2078  call mem_deallocate(this%cg_pcs)
2079  call mem_deallocate(this%cg_comp)
2080  call mem_deallocate(this%cg_tcomp)
2081  call mem_deallocate(this%cg_stor)
2082  call mem_deallocate(this%cg_ske)
2083  call mem_deallocate(this%cg_sk)
2084  if (this%iupdatematprop == 0) then
2085  nullify (this%cg_thick)
2086  nullify (this%cg_thick0)
2087  nullify (this%cg_theta)
2088  nullify (this%cg_theta0)
2089  else
2090  call mem_deallocate(this%cg_thick)
2091  call mem_deallocate(this%cg_thick0)
2092  call mem_deallocate(this%cg_theta)
2093  call mem_deallocate(this%cg_theta0)
2094  end if
2095  call mem_deallocate(this%cg_thickini)
2096  call mem_deallocate(this%cg_thetaini)
2097  !
2098  ! -- cell storage
2099  call mem_deallocate(this%cell_wcstor)
2100  call mem_deallocate(this%cell_thick)
2101  !
2102  ! -- interbed storage
2103  call mem_deallocate(this%boundname, 'BOUNDNAME', this%memoryPath)
2104  call mem_deallocate(this%auxname, 'AUXNAME', this%memoryPath)
2105  call mem_deallocate(this%auxvar)
2106  call mem_deallocate(this%ci)
2107  call mem_deallocate(this%rci)
2108  call mem_deallocate(this%pcs)
2109  call mem_deallocate(this%rnb)
2110  call mem_deallocate(this%kv)
2111  call mem_deallocate(this%h0)
2112  call mem_deallocate(this%comp)
2113  call mem_deallocate(this%tcomp)
2114  call mem_deallocate(this%tcompi)
2115  call mem_deallocate(this%tcompe)
2116  call mem_deallocate(this%storagee)
2117  call mem_deallocate(this%storagei)
2118  call mem_deallocate(this%ske)
2119  call mem_deallocate(this%sk)
2120  if (this%iupdatematprop == 0) then
2121  nullify (this%thick)
2122  nullify (this%thick0)
2123  nullify (this%theta)
2124  nullify (this%theta0)
2125  else
2126  call mem_deallocate(this%thick)
2127  call mem_deallocate(this%thick0)
2128  call mem_deallocate(this%theta)
2129  call mem_deallocate(this%theta0)
2130  end if
2131  call mem_deallocate(this%thickini)
2132  call mem_deallocate(this%thetaini)
2133  !
2134  ! -- delay bed storage
2135  if (this%ndelaybeds > 0) then
2136  if (this%iupdatematprop == 0) then
2137  nullify (this%dbdz)
2138  nullify (this%dbdz0)
2139  nullify (this%dbtheta)
2140  nullify (this%dbtheta0)
2141  else
2142  call mem_deallocate(this%dbdz)
2143  call mem_deallocate(this%dbdz0)
2144  call mem_deallocate(this%dbtheta)
2145  call mem_deallocate(this%dbtheta0)
2146  end if
2147  call mem_deallocate(this%idb_nconv_count)
2148  call mem_deallocate(this%idbconvert)
2149  call mem_deallocate(this%dbdhmax)
2150  call mem_deallocate(this%dbz)
2151  call mem_deallocate(this%dbrelz)
2152  call mem_deallocate(this%dbh)
2153  call mem_deallocate(this%dbh0)
2154  call mem_deallocate(this%dbgeo)
2155  call mem_deallocate(this%dbes)
2156  call mem_deallocate(this%dbes0)
2157  call mem_deallocate(this%dbpcs)
2158  call mem_deallocate(this%dbflowtop)
2159  call mem_deallocate(this%dbflowbot)
2160  call mem_deallocate(this%dbdzini)
2161  call mem_deallocate(this%dbthetaini)
2162  call mem_deallocate(this%dbcomp)
2163  call mem_deallocate(this%dbtcomp)
2164  !
2165  ! -- delay interbed solution arrays
2166  call mem_deallocate(this%dbal)
2167  call mem_deallocate(this%dbad)
2168  call mem_deallocate(this%dbau)
2169  call mem_deallocate(this%dbrhs)
2170  call mem_deallocate(this%dbdh)
2171  call mem_deallocate(this%dbaw)
2172  end if
2173  !
2174  ! -- period data
2175  call mem_deallocate(this%nodelistsig0)
2176  call mem_deallocate(this%sig0, 'SIG0', this%memoryPath)
2177  !
2178  ! -- pointers to gwf variables
2179  nullify (this%gwfiss)
2180  !
2181  ! -- pointers to storage variables
2182  nullify (this%stoiconv)
2183  nullify (this%stoss)
2184  !
2185  ! -- input table
2186  if (this%iprpak > 0) then
2187  call this%inputtab%table_da()
2188  deallocate (this%inputtab)
2189  nullify (this%inputtab)
2190  end if
2191  !
2192  ! -- output table
2193  if (associated(this%outputtab)) then
2194  call this%outputtab%table_da()
2195  deallocate (this%outputtab)
2196  nullify (this%outputtab)
2197  end if
2198  end if
2199  !
2200  ! -- package csv table
2201  if (this%ipakcsv > 0) then
2202  call this%pakcsvtab%table_da()
2203  deallocate (this%pakcsvtab)
2204  nullify (this%pakcsvtab)
2205  end if
2206  !
2207  ! -- deallocate character variables
2208  call mem_deallocate(this%listlabel, 'LISTLABEL', this%memoryPath)
2209  call mem_deallocate(this%stoMemPath, 'STONAME', this%memoryPath)
2210  !
2211  ! -- deallocate scalars
2212  call mem_deallocate(this%istounit)
2213  call mem_deallocate(this%inobspkg)
2214  call mem_deallocate(this%ninterbeds)
2215  call mem_deallocate(this%maxsig0)
2216  call mem_deallocate(this%nbound)
2217  call mem_deallocate(this%iscloc)
2218  call mem_deallocate(this%iauxmultcol)
2219  call mem_deallocate(this%ndelaycells)
2220  call mem_deallocate(this%ndelaybeds)
2221  call mem_deallocate(this%initialized)
2222  call mem_deallocate(this%ieslag)
2223  call mem_deallocate(this%ipch)
2224  call mem_deallocate(this%lhead_based)
2225  call mem_deallocate(this%iupdatestress)
2226  call mem_deallocate(this%ispecified_pcs)
2227  call mem_deallocate(this%ispecified_dbh)
2228  call mem_deallocate(this%inamedbound)
2229  call mem_deallocate(this%iconvchk)
2230  call mem_deallocate(this%naux)
2231  call mem_deallocate(this%istoragec)
2232  call mem_deallocate(this%istrainib)
2233  call mem_deallocate(this%istrainsk)
2234  call mem_deallocate(this%ioutcomp)
2235  call mem_deallocate(this%ioutcompi)
2236  call mem_deallocate(this%ioutcompe)
2237  call mem_deallocate(this%ioutcompib)
2238  call mem_deallocate(this%ioutcomps)
2239  call mem_deallocate(this%ioutzdisp)
2240  call mem_deallocate(this%ipakcsv)
2241  call mem_deallocate(this%iupdatematprop)
2242  call mem_deallocate(this%epsilon)
2243  call mem_deallocate(this%cc_crit)
2244  call mem_deallocate(this%gammaw)
2245  call mem_deallocate(this%beta)
2246  call mem_deallocate(this%brg)
2247  call mem_deallocate(this%satomega)
2248  call mem_deallocate(this%icellf)
2249  call mem_deallocate(this%gwfiss0)
2250  !
2251  ! -- deallocate methods on objects
2252  if (this%inunit > 0) then
2253  call this%obs%obs_da()
2254  !
2255  ! -- deallocate and nullify observations
2256  deallocate (this%obs)
2257  nullify (this%obs)
2258  end if
2259 
2260  !
2261  ! -- deallocate parent
2262  call this%NumericalPackageType%da()

◆ csub_delay_assemble()

subroutine gwfcsubmodule::csub_delay_assemble ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib,
real(dp), intent(in)  hcell 
)
private

Method to assemble matrix and right-hand side coefficients for a delay interbed. The method calls the appropriate standard or Newton-Raphson assembly routines and fills all of the entries for a delay interbed.

Parameters
[in]ibinterbed number
[in]hcellcurrent head in a cell

Definition at line 5709 of file gwf-csub.f90.

5710  ! -- dummy variables
5711  class(GwfCsubType), intent(inout) :: this
5712  integer(I4B), intent(in) :: ib !< interbed number
5713  real(DP), intent(in) :: hcell !< current head in a cell
5714  ! -- local variables
5715  integer(I4B) :: n
5716  real(DP) :: aii
5717  real(DP) :: au
5718  real(DP) :: al
5719  real(DP) :: r
5720  !
5721  ! -- calculate matrix terms for each delay bed cell
5722  do n = 1, this%ndelaycells
5723  !
5724  ! -- assemble terms
5725  if (this%inewton == 0) then
5726  call this%csub_delay_assemble_fc(ib, n, hcell, aii, au, al, r)
5727  else
5728  call this%csub_delay_assemble_fn(ib, n, hcell, aii, au, al, r)
5729  end if
5730  !
5731  ! -- add terms
5732  this%dbal(n) = al
5733  this%dbau(n) = au
5734  this%dbad(n) = aii
5735  this%dbrhs(n) = r
5736  end do

◆ csub_delay_assemble_fc()

subroutine gwfcsubmodule::csub_delay_assemble_fc ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib,
integer(i4b), intent(in)  n,
real(dp), intent(in)  hcell,
real(dp), intent(inout)  aii,
real(dp), intent(inout)  au,
real(dp), intent(inout)  al,
real(dp), intent(inout)  r 
)
private

Method to assemble standard formulation matrix and right-hand side coefficients for a delay interbed.

Parameters
[in]ibinterbed number
[in]ndelay interbed cell number
[in]hcellcurrent head in a cell
[in,out]aiidiagonal in the A matrix
[in,out]auupper term in the A matrix
[in,out]allower term in the A matrix
[in,out]rright-hand side term

Definition at line 5745 of file gwf-csub.f90.

5746  ! -- modules
5747  use tdismodule, only: delt
5748  ! -- dummy variables
5749  class(GwfCsubType), intent(inout) :: this
5750  integer(I4B), intent(in) :: ib !< interbed number
5751  integer(I4B), intent(in) :: n !< delay interbed cell number
5752  real(DP), intent(in) :: hcell !< current head in a cell
5753  real(DP), intent(inout) :: aii !< diagonal in the A matrix
5754  real(DP), intent(inout) :: au !< upper term in the A matrix
5755  real(DP), intent(inout) :: al !< lower term in the A matrix
5756  real(DP), intent(inout) :: r !< right-hand side term
5757  ! -- local variables
5758  integer(I4B) :: node
5759  integer(I4B) :: idelay
5760  integer(I4B) :: ielastic
5761  real(DP) :: dzini
5762  real(DP) :: dzhalf
5763  real(DP) :: c
5764  real(DP) :: c2
5765  real(DP) :: c3
5766  real(DP) :: tled
5767  real(DP) :: wcf
5768  real(DP) :: smult
5769  real(DP) :: sske
5770  real(DP) :: ssk
5771  real(DP) :: z
5772  real(DP) :: ztop
5773  real(DP) :: zbot
5774  real(DP) :: dz
5775  real(DP) :: dz0
5776  real(DP) :: theta
5777  real(DP) :: theta0
5778  real(DP) :: dsn
5779  real(DP) :: dsn0
5780  real(DP) :: gs
5781  real(DP) :: es0
5782  real(DP) :: pcs
5783  real(DP) :: wc
5784  real(DP) :: wc0
5785  real(DP) :: h
5786  real(DP) :: h0
5787  real(DP) :: hbar
5788  !
5789  ! -- initialize accumulators
5790  aii = dzero
5791  au = dzero
5792  al = dzero
5793  r = dzero
5794  !
5795  ! -- initialize local variables
5796  idelay = this%idelay(ib)
5797  ielastic = this%ielastic(ib)
5798  node = this%nodelist(ib)
5799  dzini = this%dbdzini(1, idelay)
5800  dzhalf = dhalf * dzini
5801  tled = done / delt
5802  c = this%kv(ib) / dzini
5803  c2 = dtwo * c
5804  c3 = dthree * c
5805  !
5806  ! -- add qdb terms
5807  aii = aii - c2
5808  !
5809  ! -- top or bottom cell
5810  if (n == 1 .or. n == this%ndelaycells) then
5811  aii = aii - c
5812  r = r - c2 * hcell
5813  end if
5814  !
5815  ! -- lower qdb term
5816  if (n > 1) then
5817  al = c
5818  end if
5819  !
5820  ! -- upper qdb term
5821  if (n < this%ndelaycells) then
5822  au = c
5823  end if
5824  !
5825  ! -- current and previous delay cell states
5826  z = this%dbz(n, idelay)
5827  ztop = z + dzhalf
5828  zbot = z - dzhalf
5829  h = this%dbh(n, idelay)
5830  h0 = this%dbh0(n, idelay)
5831  dz = this%dbdz(n, idelay)
5832  dz0 = this%dbdz0(n, idelay)
5833  theta = this%dbtheta(n, idelay)
5834  theta0 = this%dbtheta0(n, idelay)
5835  !
5836  ! -- calculate corrected head (hbar)
5837  hbar = squadratic0sp(h, zbot, this%satomega)
5838  !
5839  ! -- calculate saturation
5840  call this%csub_delay_calc_sat(node, idelay, n, h, h0, dsn, dsn0)
5841  !
5842  ! -- calculate ssk and sske
5843  call this%csub_delay_calc_ssksske(ib, n, hcell, ssk, sske)
5844  !
5845  ! -- calculate and add storage terms
5846  smult = dzini * tled
5847  gs = this%dbgeo(n, idelay)
5848  es0 = this%dbes0(n, idelay)
5849  pcs = this%dbpcs(n, idelay)
5850  aii = aii - smult * dsn * ssk
5851  if (ielastic /= 0) then
5852  r = r - smult * &
5853  (dsn * ssk * (gs + zbot) - dsn0 * sske * es0)
5854  else
5855  r = r - smult * &
5856  (dsn * ssk * (gs + zbot - pcs) + dsn0 * sske * (pcs - es0))
5857  end if
5858  !
5859  ! -- add storage correction term
5860  r = r + smult * dsn * ssk * (h - hbar)
5861  !
5862  ! -- add water compressibility terms
5863  wcf = this%brg * tled
5864  wc = dz * wcf * theta
5865  wc0 = dz0 * wcf * theta0
5866  aii = aii - dsn * wc
5867  r = r - dsn0 * wc0 * h0
Here is the call graph for this function:

◆ csub_delay_assemble_fn()

subroutine gwfcsubmodule::csub_delay_assemble_fn ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib,
integer(i4b), intent(in)  n,
real(dp), intent(in)  hcell,
real(dp), intent(inout)  aii,
real(dp), intent(inout)  au,
real(dp), intent(inout)  al,
real(dp), intent(inout)  r 
)

Method to assemble Newton-Raphson formulation matrix and right-hand side coefficients for a delay interbed.

Parameters
[in]ibinterbed number
[in]ndelay interbed cell number
[in]hcellcurrent head in a cell
[in,out]aiidiagonal in the A matrix
[in,out]auupper term in the A matrix
[in,out]allower term in the A matrix
[in,out]rright-hand side term

Definition at line 5876 of file gwf-csub.f90.

5877  ! -- modules
5878  use tdismodule, only: delt
5879  ! -- dummy variables
5880  class(GwfCsubType), intent(inout) :: this
5881  integer(I4B), intent(in) :: ib !< interbed number
5882  integer(I4B), intent(in) :: n !< delay interbed cell number
5883  real(DP), intent(in) :: hcell !< current head in a cell
5884  real(DP), intent(inout) :: aii !< diagonal in the A matrix
5885  real(DP), intent(inout) :: au !< upper term in the A matrix
5886  real(DP), intent(inout) :: al !< lower term in the A matrix
5887  real(DP), intent(inout) :: r !< right-hand side term
5888  ! -- local variables
5889  integer(I4B) :: node
5890  integer(I4B) :: idelay
5891  integer(I4B) :: ielastic
5892  real(DP) :: dzini
5893  real(DP) :: dzhalf
5894  real(DP) :: c
5895  real(DP) :: c2
5896  real(DP) :: c3
5897  real(DP) :: tled
5898  real(DP) :: wcf
5899  real(DP) :: smult
5900  real(DP) :: sske
5901  real(DP) :: ssk
5902  real(DP) :: z
5903  real(DP) :: ztop
5904  real(DP) :: zbot
5905  real(DP) :: dz
5906  real(DP) :: dz0
5907  real(DP) :: theta
5908  real(DP) :: theta0
5909  real(DP) :: dsn
5910  real(DP) :: dsn0
5911  real(DP) :: dsnderv
5912  real(DP) :: wc
5913  real(DP) :: wc0
5914  real(DP) :: h
5915  real(DP) :: h0
5916  real(DP) :: hbar
5917  real(DP) :: hbarderv
5918  real(DP) :: gs
5919  real(DP) :: es0
5920  real(DP) :: pcs
5921  real(DP) :: qsto
5922  real(DP) :: stoderv
5923  real(DP) :: qwc
5924  real(DP) :: wcderv
5925  !
5926  ! -- initialize accumulators
5927  aii = dzero
5928  au = dzero
5929  al = dzero
5930  r = dzero
5931  !
5932  ! -- initialize local variables
5933  idelay = this%idelay(ib)
5934  ielastic = this%ielastic(ib)
5935  node = this%nodelist(ib)
5936  dzini = this%dbdzini(1, idelay)
5937  dzhalf = dhalf * dzini
5938  tled = done / delt
5939  c = this%kv(ib) / dzini
5940  c2 = dtwo * c
5941  c3 = dthree * c
5942  !
5943  ! -- add qdb terms
5944  aii = aii - c2
5945  !
5946  ! -- top or bottom cell
5947  if (n == 1 .or. n == this%ndelaycells) then
5948  aii = aii - c
5949  r = r - c2 * hcell
5950  end if
5951  !
5952  ! -- lower qdb term
5953  if (n > 1) then
5954  al = c
5955  end if
5956  !
5957  ! -- upper qdb term
5958  if (n < this%ndelaycells) then
5959  au = c
5960  end if
5961  !
5962  ! -- current and previous delay cell states
5963  z = this%dbz(n, idelay)
5964  ztop = z + dzhalf
5965  zbot = z - dzhalf
5966  h = this%dbh(n, idelay)
5967  h0 = this%dbh0(n, idelay)
5968  dz = this%dbdz(n, idelay)
5969  dz0 = this%dbdz0(n, idelay)
5970  theta = this%dbtheta(n, idelay)
5971  theta0 = this%dbtheta0(n, idelay)
5972  !
5973  ! -- calculate corrected head (hbar)
5974  hbar = squadratic0sp(h, zbot, this%satomega)
5975  !
5976  ! -- calculate the derivative of the hbar functions
5977  hbarderv = squadratic0spderivative(h, zbot, this%satomega)
5978  !
5979  ! -- calculate saturation
5980  call this%csub_delay_calc_sat(node, idelay, n, h, h0, dsn, dsn0)
5981  !
5982  ! -- calculate the derivative of the saturation
5983  dsnderv = this%csub_delay_calc_sat_derivative(node, idelay, n, hcell)
5984  !
5985  ! -- calculate ssk and sske
5986  call this%csub_delay_calc_ssksske(ib, n, hcell, ssk, sske)
5987  !
5988  ! -- calculate storage terms
5989  smult = dzini * tled
5990  gs = this%dbgeo(n, idelay)
5991  es0 = this%dbes0(n, idelay)
5992  pcs = this%dbpcs(n, idelay)
5993  if (ielastic /= 0) then
5994  qsto = smult * (dsn * ssk * (gs - hbar + zbot) - dsn0 * sske * es0)
5995  stoderv = -smult * dsn * ssk * hbarderv + &
5996  smult * ssk * (gs - hbar + zbot) * dsnderv
5997  else
5998  qsto = smult * (dsn * ssk * (gs - hbar + zbot - pcs) + &
5999  dsn0 * sske * (pcs - es0))
6000  stoderv = -smult * dsn * ssk * hbarderv + &
6001  smult * ssk * (gs - hbar + zbot - pcs) * dsnderv
6002  end if
6003  !
6004  ! -- Add additional term if using lagged effective stress
6005  if (this%ieslag /= 0) then
6006  if (ielastic /= 0) then
6007  stoderv = stoderv - smult * sske * es0 * dsnderv
6008  else
6009  stoderv = stoderv + smult * sske * (pcs - es0) * dsnderv
6010  end if
6011  end if
6012  !
6013  ! -- add newton-raphson storage terms
6014  aii = aii + stoderv
6015  r = r - qsto + stoderv * h
6016  !
6017  ! -- add water compressibility terms
6018  wcf = this%brg * tled
6019  wc = dz * wcf * theta
6020  wc0 = dz0 * wcf * theta0
6021  qwc = dsn0 * wc0 * h0 - dsn * wc * h
6022  wcderv = -dsn * wc - wc * h * dsnderv
6023  !
6024  ! -- Add additional term if using lagged effective stress
6025  if (this%ieslag /= 0) then
6026  wcderv = wcderv + wc0 * h0 * dsnderv
6027  end if
6028  !
6029  ! -- add newton-raphson water compressibility terms
6030  aii = aii + wcderv
6031  r = r - qwc + wcderv * h
Here is the call graph for this function:

◆ csub_delay_calc_comp()

subroutine gwfcsubmodule::csub_delay_calc_comp ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib,
real(dp), intent(in)  hcell,
real(dp), intent(in)  hcellold,
real(dp), intent(inout)  comp,
real(dp), intent(inout)  compi,
real(dp), intent(inout)  compe 
)

Method to calculate the compaction in a delay interbed.

Parameters
[in,out]compcompaction in delay interbed
[in,out]compiinelastic compaction in delay interbed
[in,out]compeelastic compaction in delay interbed
[in]ibinterbed number
[in]hcellcurrent head in cell
[in]hcelloldprevious head in cell
[in,out]compcompaction in delay interbed
[in,out]compiinelastic compaction in delay interbed
[in,out]compeelastic compaction in delay interbed

Definition at line 6251 of file gwf-csub.f90.

6252  ! -- dummy variables
6253  class(GwfCsubType), intent(inout) :: this
6254  integer(I4B), intent(in) :: ib !< interbed number
6255  real(DP), intent(in) :: hcell !< current head in cell
6256  real(DP), intent(in) :: hcellold !< previous head in cell
6257  real(DP), intent(inout) :: comp !< compaction in delay interbed
6258  real(DP), intent(inout) :: compi !< inelastic compaction in delay interbed
6259  real(DP), intent(inout) :: compe !< elastic compaction in delay interbed
6260  ! -- local variables
6261  integer(I4B) :: idelay
6262  integer(I4B) :: ielastic
6263  integer(I4B) :: node
6264  integer(I4B) :: n
6265  real(DP) :: snnew
6266  real(DP) :: snold
6267  real(DP) :: sske
6268  real(DP) :: ssk
6269  real(DP) :: fmult
6270  real(DP) :: h
6271  real(DP) :: h0
6272  real(DP) :: dsn
6273  real(DP) :: dsn0
6274  real(DP) :: v
6275  real(DP) :: v1
6276  real(DP) :: v2
6277  !
6278  ! -- initialize variables
6279  idelay = this%idelay(ib)
6280  ielastic = this%ielastic(ib)
6281  node = this%nodelist(ib)
6282  comp = dzero
6283  compi = dzero
6284  compe = dzero
6285  !
6286  ! -- calculate cell saturation
6287  call this%csub_calc_sat(node, hcell, hcellold, snnew, snold)
6288  !
6289  ! -- calculate compaction
6290  if (this%thickini(ib) > dzero) then
6291  fmult = this%dbdzini(1, idelay)
6292  do n = 1, this%ndelaycells
6293  h = this%dbh(n, idelay)
6294  h0 = this%dbh0(n, idelay)
6295  call this%csub_delay_calc_sat(node, idelay, n, h, h0, dsn, dsn0)
6296  call this%csub_delay_calc_ssksske(ib, n, hcell, ssk, sske)
6297  if (ielastic /= 0) then
6298  v1 = dsn * ssk * this%dbes(n, idelay) - sske * this%dbes0(n, idelay)
6299  v2 = dzero
6300  else
6301  v1 = dsn * ssk * (this%dbes(n, idelay) - this%dbpcs(n, idelay))
6302  v2 = dsn0 * sske * (this%dbpcs(n, idelay) - this%dbes0(n, idelay))
6303  end if
6304  v = (v1 + v2) * fmult
6305  comp = comp + v
6306  !
6307  ! -- save compaction data
6308  this%dbcomp(n, idelay) = v * snnew
6309  !
6310  ! -- calculate inelastic and elastic storage components
6311  if (this%idbconvert(n, idelay) /= 0) then
6312  compi = compi + v1 * fmult
6313  compe = compe + v2 * fmult
6314  else
6315  compe = compe + (v1 + v2) * fmult
6316  end if
6317  end do
6318  end if
6319  !
6320  ! -- fill compaction
6321  comp = comp * this%rnb(ib)
6322  compi = compi * this%rnb(ib)
6323  compe = compe * this%rnb(ib)

◆ csub_delay_calc_dstor()

subroutine gwfcsubmodule::csub_delay_calc_dstor ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib,
real(dp), intent(in)  hcell,
real(dp), intent(inout)  stoe,
real(dp), intent(inout)  stoi 
)
private

Method to calculate the storage change in a delay interbed.

Parameters
[in,out]stoecurrent elastic storage change in delay interbed
[in,out]stoicurrent inelastic storage changes in delay interbed
[in]ibinterbed number
[in]hcellcurrent head in cell
[in,out]stoeelastic storage change
[in,out]stoiinelastic storage change

Definition at line 6113 of file gwf-csub.f90.

6114  ! -- dummy variables
6115  class(GwfCsubType), intent(inout) :: this
6116  integer(I4B), intent(in) :: ib !< interbed number
6117  real(DP), intent(in) :: hcell !< current head in cell
6118  real(DP), intent(inout) :: stoe !< elastic storage change
6119  real(DP), intent(inout) :: stoi !< inelastic storage change
6120  ! -- local variables
6121  integer(I4B) :: idelay
6122  integer(I4B) :: ielastic
6123  integer(I4B) :: node
6124  integer(I4B) :: n
6125  real(DP) :: sske
6126  real(DP) :: ssk
6127  real(DP) :: fmult
6128  real(DP) :: v1
6129  real(DP) :: v2
6130  real(DP) :: ske
6131  real(DP) :: sk
6132  real(DP) :: z
6133  real(DP) :: zbot
6134  real(DP) :: h
6135  real(DP) :: h0
6136  real(DP) :: dsn
6137  real(DP) :: dsn0
6138  real(DP) :: hbar
6139  real(DP) :: dzhalf
6140  !
6141  ! -- initialize variables
6142  idelay = this%idelay(ib)
6143  ielastic = this%ielastic(ib)
6144  node = this%nodelist(ib)
6145  stoe = dzero
6146  stoi = dzero
6147  ske = dzero
6148  sk = dzero
6149  !
6150  !
6151  if (this%thickini(ib) > dzero) then
6152  fmult = this%dbdzini(1, idelay)
6153  dzhalf = dhalf * this%dbdzini(1, idelay)
6154  do n = 1, this%ndelaycells
6155  call this%csub_delay_calc_ssksske(ib, n, hcell, ssk, sske)
6156  z = this%dbz(n, idelay)
6157  zbot = z - dzhalf
6158  h = this%dbh(n, idelay)
6159  h0 = this%dbh0(n, idelay)
6160  call this%csub_delay_calc_sat(node, idelay, n, h, h0, dsn, dsn0)
6161  hbar = squadratic0sp(h, zbot, this%satomega)
6162  if (ielastic /= 0) then
6163  v1 = dsn * ssk * (this%dbgeo(n, idelay) - hbar + zbot) - &
6164  dsn0 * sske * this%dbes0(n, idelay)
6165  v2 = dzero
6166  else
6167  v1 = dsn * ssk * (this%dbgeo(n, idelay) - hbar + zbot - &
6168  this%dbpcs(n, idelay))
6169  v2 = dsn0 * sske * (this%dbpcs(n, idelay) - this%dbes0(n, idelay))
6170  end if
6171  !
6172  ! -- calculate inelastic and elastic storage components
6173  if (this%idbconvert(n, idelay) /= 0) then
6174  stoi = stoi + v1 * fmult
6175  stoe = stoe + v2 * fmult
6176  else
6177  stoe = stoe + (v1 + v2) * fmult
6178  end if
6179  !
6180  ! calculate inelastic and elastic storativity
6181  ske = ske + sske * fmult
6182  sk = sk + ssk * fmult
6183  end do
6184  end if
6185  !
6186  ! -- save ske and sk
6187  this%ske(ib) = ske
6188  this%sk(ib) = sk
Here is the call graph for this function:

◆ csub_delay_calc_sat()

subroutine gwfcsubmodule::csub_delay_calc_sat ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  node,
integer(i4b), intent(in)  idelay,
integer(i4b), intent(in)  n,
real(dp), intent(in)  hcell,
real(dp), intent(in)  hcellold,
real(dp), intent(inout)  snnew,
real(dp), intent(inout)  snold 
)

Method to calculate the saturation in a delay interbed cell.

Parameters
[in,out]snnewcurrent saturation in delay interbed cell n
[in,out]snoldprevious saturation in delay interbed cell n
[in]nodecell node number
[in]idelaydelay interbed number
[in]ndelay interbed cell number
[in]hcellcurrent head in delay interbed cell n
[in]hcelloldprevious head in delay interbed cell n
[in,out]snnewcurrent saturation in delay interbed cell n
[in,out]snoldprevious saturation in delay interbed cell n

Definition at line 6042 of file gwf-csub.f90.

6044  ! -- dummy variables
6045  class(GwfCsubType), intent(inout) :: this
6046  integer(I4B), intent(in) :: node !< cell node number
6047  integer(I4B), intent(in) :: idelay !< delay interbed number
6048  integer(I4B), intent(in) :: n !< delay interbed cell number
6049  real(DP), intent(in) :: hcell !< current head in delay interbed cell n
6050  real(DP), intent(in) :: hcellold !< previous head in delay interbed cell n
6051  real(DP), intent(inout) :: snnew !< current saturation in delay interbed cell n
6052  real(DP), intent(inout) :: snold !< previous saturation in delay interbed cell n
6053  ! -- local variables
6054  real(DP) :: dzhalf
6055  real(DP) :: top
6056  real(DP) :: bot
6057  !
6058  ! -- calculate delay interbed cell saturation
6059  if (this%stoiconv(node) /= 0) then
6060  dzhalf = dhalf * this%dbdzini(n, idelay)
6061  top = this%dbz(n, idelay) + dzhalf
6062  bot = this%dbz(n, idelay) - dzhalf
6063  snnew = squadraticsaturation(top, bot, hcell, this%satomega)
6064  snold = squadraticsaturation(top, bot, hcellold, this%satomega)
6065  else
6066  snnew = done
6067  snold = done
6068  end if
6069  if (this%ieslag /= 0) then
6070  snold = snnew
6071  end if
Here is the call graph for this function:

◆ csub_delay_calc_sat_derivative()

real(dp) function gwfcsubmodule::csub_delay_calc_sat_derivative ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  node,
integer(i4b), intent(in)  idelay,
integer(i4b), intent(in)  n,
real(dp), intent(in)  hcell 
)
private

Function to calculate the derivative of the saturation with respect to the current head in delay interbed cell n.

Returns
satderv derivative of saturation
Parameters
[in]nodecell node number
[in]idelaydelay interbed number
[in]ndelay interbed cell number
[in]hcellcurrent head in delay interbed cell n

Definition at line 6081 of file gwf-csub.f90.

6083  ! -- dummy variables
6084  class(GwfCsubType), intent(inout) :: this
6085  integer(I4B), intent(in) :: node !< cell node number
6086  integer(I4B), intent(in) :: idelay !< delay interbed number
6087  integer(I4B), intent(in) :: n !< delay interbed cell number
6088  real(DP), intent(in) :: hcell !< current head in delay interbed cell n
6089  ! -- local variables
6090  real(DP) :: satderv
6091  real(DP) :: dzhalf
6092  real(DP) :: top
6093  real(DP) :: bot
6094 
6095  if (this%stoiconv(node) /= 0) then
6096  dzhalf = dhalf * this%dbdzini(n, idelay)
6097  top = this%dbz(n, idelay) + dzhalf
6098  bot = this%dbz(n, idelay) - dzhalf
6099  satderv = squadraticsaturationderivative(top, bot, hcell, this%satomega)
6100  else
6101  satderv = dzero
6102  end if
Here is the call graph for this function:

◆ csub_delay_calc_ssksske()

subroutine gwfcsubmodule::csub_delay_calc_ssksske ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib,
integer(i4b), intent(in)  n,
real(dp), intent(in)  hcell,
real(dp), intent(inout)  ssk,
real(dp), intent(inout)  sske 
)
private

Method to calculate the ssk and sske value for a node in a delay interbed cell.

Parameters
[in,out]sskskeletal specific storage value dependent on the preconsolidation stress
[in,out]sskeelastic skeletal specific storage value
[in]ibinterbed number
[in]ndelay interbed cell number
[in]hcellcurrent head in a cell
[in,out]sskdelay interbed skeletal specific storage
[in,out]sskedelay interbed elastic skeletal specific storage

Definition at line 5607 of file gwf-csub.f90.

5608  ! -- dummy variables
5609  class(GwfCsubType), intent(inout) :: this
5610  integer(I4B), intent(in) :: ib !< interbed number
5611  integer(I4B), intent(in) :: n !< delay interbed cell number
5612  real(DP), intent(in) :: hcell !< current head in a cell
5613  real(DP), intent(inout) :: ssk !< delay interbed skeletal specific storage
5614  real(DP), intent(inout) :: sske !< delay interbed elastic skeletal specific storage
5615  ! -- local variables
5616  integer(I4B) :: idelay
5617  integer(I4B) :: ielastic
5618  integer(I4B) :: node
5619  real(DP) :: topcell
5620  real(DP) :: botcell
5621  real(DP) :: hbarcell
5622  real(DP) :: zcell
5623  real(DP) :: zcenter
5624  real(DP) :: dzhalf
5625  real(DP) :: top
5626  real(DP) :: bot
5627  real(DP) :: h
5628  real(DP) :: hbar
5629  real(DP) :: znode
5630  real(DP) :: zbot
5631  real(DP) :: es
5632  real(DP) :: es0
5633  real(DP) :: theta
5634  real(DP) :: f
5635  real(DP) :: f0
5636  !
5637  ! -- initialize variables
5638  sske = dzero
5639  ssk = dzero
5640  idelay = this%idelay(ib)
5641  ielastic = this%ielastic(ib)
5642  !
5643  ! -- calculate factor for the head-based case
5644  if (this%lhead_based .EQV. .true.) then
5645  f = done
5646  f0 = f
5647  !
5648  ! -- calculate factor for the effective stress case
5649  else
5650  node = this%nodelist(ib)
5651  theta = this%dbthetaini(n, idelay)
5652  !
5653  ! -- set top and bottom of layer
5654  topcell = this%dis%top(node)
5655  botcell = this%dis%bot(node)
5656  !
5657  ! -- calculate corrected head for the cell (hbarcell)
5658  hbarcell = squadratic0sp(hcell, botcell, this%satomega)
5659  !
5660  ! -- set location of delay node relative to the center
5661  ! of the cell based on current head
5662  zcell = this%csub_calc_znode(topcell, botcell, hbarcell)
5663  !
5664  ! -- set variables for delay interbed zcell calculations
5665  zcenter = zcell + this%dbrelz(n, idelay)
5666  dzhalf = dhalf * this%dbdzini(1, idelay)
5667  top = zcenter + dzhalf
5668  bot = zcenter - dzhalf
5669  h = this%dbh(n, idelay)
5670  !
5671  ! -- calculate corrected head for the delay interbed cell (hbar)
5672  hbar = squadratic0sp(h, bot, this%satomega)
5673  !
5674  ! -- calculate the center of the saturated portion of the
5675  ! delay interbed cell
5676  znode = this%csub_calc_znode(top, bot, hbar)
5677  !
5678  ! -- set reference point for bottom of delay interbed cell that is used to
5679  ! scale the effective stress at the bottom of the delay interbed cell
5680  zbot = this%dbz(n, idelay) - dzhalf
5681  !
5682  ! -- set the effective stress
5683  es = this%dbes(n, idelay)
5684  es0 = this%dbes0(n, idelay)
5685  !
5686  ! -- calculate the compression index factors for the delay
5687  ! node relative to the center of the cell based on the
5688  ! current and previous head
5689  call this%csub_calc_sfacts(node, zbot, znode, theta, es, es0, f)
5690  end if
5691  this%idbconvert(n, idelay) = 0
5692  sske = f * this%rci(ib)
5693  ssk = f * this%rci(ib)
5694  if (ielastic == 0) then
5695  if (this%dbes(n, idelay) > this%dbpcs(n, idelay)) then
5696  this%idbconvert(n, idelay) = 1
5697  ssk = f * this%ci(ib)
5698  end if
5699  end if
Here is the call graph for this function:

◆ csub_delay_calc_stress()

subroutine gwfcsubmodule::csub_delay_calc_stress ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib,
real(dp), intent(in)  hcell 
)
private

Method to calculate the geostatic and effective stress in delay interbed cells using the passed the current head value in a cell.

Parameters
[in]ibinterbed number
[in]hcellcurrent head in a cell

Definition at line 5527 of file gwf-csub.f90.

5528  ! -- dummy variables
5529  class(GwfCsubType), intent(inout) :: this
5530  integer(I4B), intent(in) :: ib !< interbed number
5531  real(DP), intent(in) :: hcell !< current head in a cell
5532  ! -- local variables
5533  integer(I4B) :: n
5534  integer(I4B) :: idelay
5535  integer(I4B) :: node
5536  real(DP) :: sigma
5537  real(DP) :: topaq
5538  real(DP) :: botaq
5539  real(DP) :: dzhalf
5540  real(DP) :: sadd
5541  real(DP) :: sgm
5542  real(DP) :: sgs
5543  real(DP) :: h
5544  real(DP) :: hbar
5545  real(DP) :: z
5546  real(DP) :: top
5547  real(DP) :: bot
5548  real(DP) :: phead
5549  !
5550  ! -- initialize variables
5551  idelay = this%idelay(ib)
5552  node = this%nodelist(ib)
5553  sigma = this%cg_gs(node)
5554  topaq = this%dis%top(node)
5555  botaq = this%dis%bot(node)
5556  dzhalf = dhalf * this%dbdzini(1, idelay)
5557  top = this%dbz(1, idelay) + dzhalf
5558  !
5559  ! -- calculate corrected head (hbar)
5560  hbar = squadratic0sp(hcell, botaq, this%satomega)
5561  !
5562  ! -- calculate the geostatic load in the cell at the top of the interbed.
5563  sgm = this%sgm(node)
5564  sgs = this%sgs(node)
5565  if (hcell < top) then
5566  sadd = ((top - hbar) * sgm) + ((hbar - botaq) * sgs)
5567  else
5568  sadd = (top - botaq) * sgs
5569  end if
5570  sigma = sigma - sadd
5571  !
5572  ! -- calculate geostatic and effective stress for each interbed node.
5573  do n = 1, this%ndelaycells
5574  h = this%dbh(n, idelay)
5575  !
5576  ! -- geostatic calculated at the bottom of the delay cell
5577  z = this%dbz(n, idelay)
5578  top = z + dzhalf
5579  bot = z - dzhalf
5580  !
5581  ! -- calculate corrected head (hbar)
5582  hbar = squadratic0sp(h, bot, this%satomega)
5583  !
5584  ! -- geostatic stress calculation
5585  if (h < top) then
5586  sadd = ((top - hbar) * sgm) + ((hbar - bot) * sgs)
5587  else
5588  sadd = (top - bot) * sgs
5589  end if
5590  sigma = sigma + sadd
5591  phead = hbar - bot
5592  this%dbgeo(n, idelay) = sigma
5593  this%dbes(n, idelay) = sigma - phead
5594  end do
Here is the call graph for this function:

◆ csub_delay_calc_wcomp()

subroutine gwfcsubmodule::csub_delay_calc_wcomp ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib,
real(dp), intent(inout)  dwc 
)
private

Method to calculate the change in water compressibility in a delay interbed.

Parameters
[in,out]dwccurrent water compressibility change in delay interbed
[in]ibinterbed number
[in,out]dwcwater compressibility change

Definition at line 6198 of file gwf-csub.f90.

6199  ! -- modules
6200  use tdismodule, only: delt
6201  ! -- dummy variables
6202  class(GwfCsubType), intent(inout) :: this
6203  integer(I4B), intent(in) :: ib !< interbed number
6204  real(DP), intent(inout) :: dwc !< water compressibility change
6205  ! -- local variables
6206  integer(I4B) :: idelay
6207  integer(I4B) :: node
6208  integer(I4B) :: n
6209  real(DP) :: tled
6210  real(DP) :: h
6211  real(DP) :: h0
6212  real(DP) :: dz
6213  real(DP) :: dz0
6214  real(DP) :: dsn
6215  real(DP) :: dsn0
6216  real(DP) :: wc
6217  real(DP) :: wc0
6218  real(DP) :: v
6219  !
6220  ! -- initialize variables
6221  dwc = dzero
6222  !
6223  !
6224  if (this%thickini(ib) > dzero) then
6225  idelay = this%idelay(ib)
6226  node = this%nodelist(ib)
6227  tled = done / delt
6228  do n = 1, this%ndelaycells
6229  h = this%dbh(n, idelay)
6230  h0 = this%dbh0(n, idelay)
6231  dz = this%dbdz(n, idelay)
6232  dz0 = this%dbdz0(n, idelay)
6233  call this%csub_delay_calc_sat(node, idelay, n, h, h0, dsn, dsn0)
6234  wc = dz * this%brg * this%dbtheta(n, idelay)
6235  wc0 = dz0 * this%brg * this%dbtheta0(n, idelay)
6236  v = dsn0 * wc0 * h0 - dsn * wc * h
6237  dwc = dwc + v * tled
6238  end do
6239  end if

◆ csub_delay_fc()

subroutine gwfcsubmodule::csub_delay_fc ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib,
real(dp), intent(inout)  hcof,
real(dp), intent(inout)  rhs 
)
private

Method to calculate the coefficients to calculate the delay interbed contribution to a cell. The product of hcof* h - rhs equals the delay contribution to the cell

Parameters
[in,out]hcofcoefficient dependent on current head
[in,out]rhsright-hand side contributions
[in]ibinterbed number
[in,out]hcofhead dependent coefficient
[in,out]rhsright-hand side

Definition at line 6411 of file gwf-csub.f90.

6412  ! -- dummy variables
6413  class(GwfCsubType), intent(inout) :: this
6414  integer(I4B), intent(in) :: ib !< interbed number
6415  real(DP), intent(inout) :: hcof !< head dependent coefficient
6416  real(DP), intent(inout) :: rhs !< right-hand side
6417  ! -- local variables
6418  integer(I4B) :: idelay
6419  real(DP) :: c1
6420  real(DP) :: c2
6421  !
6422  ! -- initialize variables
6423  idelay = this%idelay(ib)
6424  hcof = dzero
6425  rhs = dzero
6426  if (this%thickini(ib) > dzero) then
6427  ! -- calculate terms for gwf matrix
6428  c1 = dtwo * this%kv(ib) / this%dbdzini(1, idelay)
6429  rhs = -c1 * this%dbh(1, idelay)
6430  c2 = dtwo * &
6431  this%kv(ib) / this%dbdzini(this%ndelaycells, idelay)
6432  rhs = rhs - c2 * this%dbh(this%ndelaycells, idelay)
6433  hcof = c1 + c2
6434  end if

◆ csub_delay_head_check()

subroutine gwfcsubmodule::csub_delay_head_check ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib 
)
private

Method to determine if the delay interbed head in any delay cell in a non-convertible gwf cell is less than the top of each delay interbed cell.

Parameters
[in]ibinterbed number

Definition at line 5195 of file gwf-csub.f90.

5196  ! -- dummy variables
5197  class(GwfCsubType), intent(inout) :: this
5198  integer(I4B), intent(in) :: ib !< interbed number
5199  ! -- local variables
5200  integer(I4B) :: iviolate
5201  integer(I4B) :: idelay
5202  integer(I4B) :: node
5203  integer(I4B) :: n
5204  real(DP) :: z
5205  real(DP) :: h
5206  real(DP) :: dzhalf
5207  real(DP) :: ztop
5208  !
5209  ! -- initialize variables
5210  iviolate = 0
5211  idelay = this%idelay(ib)
5212  node = this%nodelist(ib)
5213  !
5214  ! -- evaluate every delay cell
5215  idelaycells: do n = 1, this%ndelaycells
5216  z = this%dbz(n, idelay)
5217  h = this%dbh(n, idelay)
5218  dzhalf = dhalf * this%dbdzini(1, idelay)
5219  !
5220  ! -- non-convertible cell
5221  if (this%stoiconv(node) == 0) then
5222  ztop = z + dzhalf
5223  if (h < ztop) then
5224  this%idb_nconv_count(1) = this%idb_nconv_count(1) + 1
5225  iviolate = 1
5226  end if
5227  end if
5228  !
5229  ! -- terminate the loop
5230  if (iviolate > 0) then
5231  exit idelaycells
5232  end if
5233  end do idelaycells

◆ csub_delay_init_zcell()

subroutine gwfcsubmodule::csub_delay_init_zcell ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib 
)
private

Method to calculate the initial center of each delay interbed cell, assuming the delay bed head is equal to the top of the delay interbed. The method also calculates the distance of the center of each delay bed cell from the center of the delay interbed (z_offset) that is used to calculate average skeletal specific storage values for a delay interbed centered on the center of the saturated thickness for a cell.

Parameters
[in]ibinterbed number

Definition at line 5470 of file gwf-csub.f90.

5471  ! -- dummy variables
5472  class(GwfCsubType), intent(inout) :: this
5473  integer(I4B), intent(in) :: ib !< interbed number
5474  ! -- local variables
5475  integer(I4B) :: n
5476  integer(I4B) :: node
5477  integer(I4B) :: idelay
5478  real(DP) :: bot
5479  real(DP) :: top
5480  real(DP) :: hbar
5481  real(DP) :: znode
5482  real(DP) :: dzz
5483  real(DP) :: z
5484  real(DP) :: zr
5485  real(DP) :: b
5486  real(DP) :: dz
5487  !
5488  ! -- initialize variables
5489  idelay = this%idelay(ib)
5490  node = this%nodelist(ib)
5491  b = this%thickini(ib)
5492  bot = this%dis%bot(node)
5493  top = bot + b
5494  hbar = top
5495  !
5496  ! -- calculate znode based on assumption that the delay bed bottom
5497  ! is equal to the cell bottom
5498  znode = this%csub_calc_znode(top, bot, hbar)
5499  dz = dhalf * this%dbdzini(1, idelay)
5500  dzz = dhalf * b
5501  z = znode + dzz
5502  zr = dzz
5503  !
5504  ! -- calculate z and z relative to znode for each delay
5505  ! interbed node
5506  do n = 1, this%ndelaycells
5507  ! z of node relative to bottom of cell
5508  z = z - dz
5509  this%dbz(n, idelay) = z
5510  z = z - dz
5511  ! z relative to znode
5512  zr = zr - dz
5513  if (abs(zr) < dz) then
5514  zr = dzero
5515  end if
5516  this%dbrelz(n, idelay) = zr
5517  zr = zr - dz
5518  end do

◆ csub_delay_sln()

subroutine gwfcsubmodule::csub_delay_sln ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib,
real(dp), intent(in)  hcell,
logical(lgp), intent(in), optional  update 
)
private

Method to calculate solve the delay interbed continuity equation for a delay interbed. The method encapsulates the non-linear loop and calls the linear solution.

Parameters
[in]ibinterbed number
[in]hcellcurrent head in a cell
[in]updateoptional logical variable indicating if the maximum head change variable in a delay bed should be updated

Definition at line 5377 of file gwf-csub.f90.

5378  ! -- dummy variables
5379  class(GwfCsubType), intent(inout) :: this
5380  integer(I4B), intent(in) :: ib !< interbed number
5381  real(DP), intent(in) :: hcell !< current head in a cell
5382  logical(LGP), intent(in), optional :: update !< optional logical variable indicating
5383  !! if the maximum head change variable
5384  !! in a delay bed should be updated
5385  ! -- local variables
5386  logical(LGP) :: lupdate
5387  integer(I4B) :: n
5388  integer(I4B) :: icnvg
5389  integer(I4B) :: iter
5390  integer(I4B) :: idelay
5391  real(DP) :: dh
5392  real(DP) :: dhmax
5393  real(DP) :: dhmax0
5394  real(DP), parameter :: dclose = dhundred * dprec
5395  !
5396  ! -- initialize variables
5397  if (present(update)) then
5398  lupdate = update
5399  else
5400  lupdate = .true.
5401  end if
5402  !
5403  ! -- calculate geostatic and effective stress for each delay bed cell
5404  call this%csub_delay_calc_stress(ib, hcell)
5405  !
5406  ! -- terminate if the aquifer head is below the top of delay interbeds
5407  if (count_errors() > 0) then
5408  call store_error_filename(this%input_fname)
5409  end if
5410  !
5411  ! -- solve for delay bed heads
5412  if (this%thickini(ib) > dzero) then
5413  icnvg = 0
5414  iter = 0
5415  idelay = this%idelay(ib)
5416  do
5417  iter = iter + 1
5418  !
5419  ! -- assemble coefficients
5420  call this%csub_delay_assemble(ib, hcell)
5421  !
5422  ! -- solve for head change in delay interbed cells
5423  call ims_misc_thomas(this%ndelaycells, &
5424  this%dbal, this%dbad, this%dbau, &
5425  this%dbrhs, this%dbdh, this%dbaw)
5426  !
5427  ! -- calculate maximum head change and update delay bed heads
5428  dhmax = dzero
5429  do n = 1, this%ndelaycells
5430  dh = this%dbdh(n) - this%dbh(n, idelay)
5431  if (abs(dh) > abs(dhmax)) then
5432  dhmax = dh
5433  if (lupdate) then
5434  this%dbdhmax(idelay) = dhmax
5435  end if
5436  end if
5437  ! -- update delay bed heads
5438  this%dbh(n, idelay) = this%dbdh(n)
5439  end do
5440  !
5441  ! -- update delay bed stresses
5442  call this%csub_delay_calc_stress(ib, hcell)
5443  !
5444  ! -- check delay bed convergence
5445  if (abs(dhmax) < dclose) then
5446  icnvg = 1
5447  else if (iter /= 1) then
5448  if (abs(dhmax) - abs(dhmax0) < dprec) then
5449  icnvg = 1
5450  end if
5451  end if
5452  if (icnvg == 1) then
5453  exit
5454  end if
5455  dhmax0 = dhmax
5456  end do
5457  end if
Here is the call graph for this function:

◆ csub_delay_update()

subroutine gwfcsubmodule::csub_delay_update ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib 
)
private

Method to update the thickness and porosity of each delay interbed cell.

Parameters
[in]ibinterbed number

Definition at line 6331 of file gwf-csub.f90.

6332  ! -- dummy variables
6333  class(GwfCsubType), intent(inout) :: this
6334  integer(I4B), intent(in) :: ib !< interbed number
6335  ! -- local variables
6336  integer(I4B) :: idelay
6337  integer(I4B) :: n
6338  real(DP) :: comp
6339  real(DP) :: thick
6340  real(DP) :: theta
6341  real(DP) :: tthick
6342  real(DP) :: wtheta
6343  !
6344  ! -- initialize variables
6345  idelay = this%idelay(ib)
6346  comp = dzero
6347  tthick = dzero
6348  wtheta = dzero
6349  !
6350  !
6351  do n = 1, this%ndelaycells
6352  !
6353  ! -- initialize compaction for delay cell
6354  comp = this%dbtcomp(n, idelay) + this%dbcomp(n, idelay)
6355  !
6356  ! -- scale compaction by rnb to get the compaction for
6357  ! the interbed system (as opposed to the full system)
6358  comp = comp / this%rnb(ib)
6359  !
6360  ! -- update thickness and theta
6361  if (abs(comp) > dzero) then
6362  thick = this%dbdzini(n, idelay)
6363  theta = this%dbthetaini(n, idelay)
6364  call this%csub_adj_matprop(comp, thick, theta)
6365  if (thick <= dzero) then
6366  write (errmsg, '(2(a,i0),a,g0,a)') &
6367  'Adjusted thickness for delay interbed (', ib, &
6368  ') cell (', n, ') is less than or equal to 0 (', thick, ').'
6369  call store_error(errmsg)
6370  end if
6371  if (theta <= dzero) then
6372  write (errmsg, '(2(a,i0),a,g0,a)') &
6373  'Adjusted theta for delay interbed (', ib, &
6374  ') cell (', n, 'is less than or equal to 0 (', theta, ').'
6375  call store_error(errmsg)
6376  end if
6377  this%dbdz(n, idelay) = thick
6378  this%dbtheta(n, idelay) = theta
6379  tthick = tthick + thick
6380  wtheta = wtheta + thick * theta
6381  else
6382  thick = this%dbdz(n, idelay)
6383  theta = this%dbtheta(n, idelay)
6384  tthick = tthick + thick
6385  wtheta = wtheta + thick * theta
6386  end if
6387  end do
6388  !
6389  ! -- calculate thickness weighted theta and save thickness and weighted
6390  ! theta values for delay interbed
6391  if (tthick > dzero) then
6392  wtheta = wtheta / tthick
6393  else
6394  tthick = dzero
6395  wtheta = dzero
6396  end if
6397  this%thick(ib) = tthick
6398  this%theta(ib) = wtheta
Here is the call graph for this function:

◆ csub_df_obs()

subroutine gwfcsubmodule::csub_df_obs ( class(gwfcsubtype this)
private

Method to define the observation types available in the CSUB package.

Definition at line 6483 of file gwf-csub.f90.

6484  ! -- dummy variables
6485  class(GwfCsubType) :: this
6486  ! -- local variables
6487  integer(I4B) :: indx
6488  !
6489  ! -- Store obs type and assign procedure pointer
6490  ! for csub observation type.
6491  call this%obs%StoreObsType('csub', .true., indx)
6492  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6493  !
6494  ! -- Store obs type and assign procedure pointer
6495  ! for inelastic-csub observation type.
6496  call this%obs%StoreObsType('inelastic-csub', .true., indx)
6497  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6498  !
6499  ! -- Store obs type and assign procedure pointer
6500  ! for elastic-csub observation type.
6501  call this%obs%StoreObsType('elastic-csub', .true., indx)
6502  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6503  !
6504  ! -- Store obs type and assign procedure pointer
6505  ! for coarse-csub observation type.
6506  call this%obs%StoreObsType('coarse-csub', .false., indx)
6507  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6508  !
6509  ! -- Store obs type and assign procedure pointer
6510  ! for csub-cell observation type.
6511  call this%obs%StoreObsType('csub-cell', .true., indx)
6512  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6513  !
6514  ! -- Store obs type and assign procedure pointer
6515  ! for watercomp-csub observation type.
6516  call this%obs%StoreObsType('wcomp-csub-cell', .false., indx)
6517  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6518  !
6519  ! -- Store obs type and assign procedure pointer
6520  ! for interbed ske observation type.
6521  call this%obs%StoreObsType('ske', .true., indx)
6522  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6523  !
6524  ! -- Store obs type and assign procedure pointer
6525  ! for interbed sk observation type.
6526  call this%obs%StoreObsType('sk', .true., indx)
6527  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6528  !
6529  ! -- Store obs type and assign procedure pointer
6530  ! for ske-cell observation type.
6531  call this%obs%StoreObsType('ske-cell', .true., indx)
6532  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6533  !
6534  ! -- Store obs type and assign procedure pointer
6535  ! for sk-cell observation type.
6536  call this%obs%StoreObsType('sk-cell', .true., indx)
6537  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6538  !
6539  ! -- Store obs type and assign procedure pointer
6540  ! for geostatic-stress-cell observation type.
6541  call this%obs%StoreObsType('gstress-cell', .false., indx)
6542  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6543  !
6544  ! -- Store obs type and assign procedure pointer
6545  ! for effective-stress-cell observation type.
6546  call this%obs%StoreObsType('estress-cell', .false., indx)
6547  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6548  !
6549  ! -- Store obs type and assign procedure pointer
6550  ! for total-compaction observation type.
6551  call this%obs%StoreObsType('interbed-compaction', .true., indx)
6552  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6553  !
6554  ! -- Store obs type and assign procedure pointer
6555  ! for inelastic-compaction observation type.
6556  call this%obs%StoreObsType('inelastic-compaction', .true., indx)
6557  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6558  !
6559  ! -- Store obs type and assign procedure pointer
6560  ! for inelastic-compaction observation type.
6561  call this%obs%StoreObsType('elastic-compaction', .true., indx)
6562  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6563  !
6564  ! -- Store obs type and assign procedure pointer
6565  ! for coarse-compaction observation type.
6566  call this%obs%StoreObsType('coarse-compaction', .false., indx)
6567  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6568  !
6569  ! -- Store obs type and assign procedure pointer
6570  ! for inelastic-compaction-cell observation type.
6571  call this%obs%StoreObsType('inelastic-compaction-cell', .true., indx)
6572  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6573  !
6574  ! -- Store obs type and assign procedure pointer
6575  ! for elastic-compaction-cell observation type.
6576  call this%obs%StoreObsType('elastic-compaction-cell', .true., indx)
6577  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6578  !
6579  ! -- Store obs type and assign procedure pointer
6580  ! for compaction-cell observation type.
6581  call this%obs%StoreObsType('compaction-cell', .true., indx)
6582  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6583  !
6584  ! -- Store obs type and assign procedure pointer
6585  ! for interbed thickness observation type.
6586  call this%obs%StoreObsType('thickness', .true., indx)
6587  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6588  !
6589  ! -- Store obs type and assign procedure pointer
6590  ! for coarse-thickness observation type.
6591  call this%obs%StoreObsType('coarse-thickness', .false., indx)
6592  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6593  !
6594  ! -- Store obs type and assign procedure pointer
6595  ! for thickness-cell observation type.
6596  call this%obs%StoreObsType('thickness-cell', .false., indx)
6597  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6598  !
6599  ! -- Store obs type and assign procedure pointer
6600  ! for interbed theta observation type.
6601  call this%obs%StoreObsType('theta', .true., indx)
6602  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6603  !
6604  ! -- Store obs type and assign procedure pointer
6605  ! for coarse-theta observation type.
6606  call this%obs%StoreObsType('coarse-theta', .false., indx)
6607  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6608  !
6609  ! -- Store obs type and assign procedure pointer
6610  ! for theta-cell observation type.
6611  call this%obs%StoreObsType('theta-cell', .true., indx)
6612  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6613  !
6614  ! -- Store obs type and assign procedure pointer
6615  ! for preconstress-cell observation type.
6616  call this%obs%StoreObsType('preconstress-cell', .false., indx)
6617  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6618  !
6619  ! -- Store obs type and assign procedure pointer
6620  ! for interbed-compaction-pct observation type.
6621  call this%obs%StoreObsType('interbed-compaction-pct', .false., indx)
6622  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6623  !
6624  ! -- Store obs type and assign procedure pointer
6625  ! for delay-preconstress observation type.
6626  call this%obs%StoreObsType('delay-preconstress', .false., indx)
6627  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6628  !
6629  ! -- Store obs type and assign procedure pointer
6630  ! for delay-head observation type.
6631  call this%obs%StoreObsType('delay-head', .false., indx)
6632  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6633  !
6634  ! -- Store obs type and assign procedure pointer
6635  ! for delay-gstress observation type.
6636  call this%obs%StoreObsType('delay-gstress', .false., indx)
6637  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6638  !
6639  ! -- Store obs type and assign procedure pointer
6640  ! for delay-estress observation type.
6641  call this%obs%StoreObsType('delay-estress', .false., indx)
6642  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6643  !
6644  ! -- Store obs type and assign procedure pointer
6645  ! for delay-compaction observation type.
6646  call this%obs%StoreObsType('delay-compaction', .false., indx)
6647  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6648  !
6649  ! -- Store obs type and assign procedure pointer
6650  ! for delay-thickness observation type.
6651  call this%obs%StoreObsType('delay-thickness', .false., indx)
6652  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6653  !
6654  ! -- Store obs type and assign procedure pointer
6655  ! for delay-theta observation type.
6656  call this%obs%StoreObsType('delay-theta', .false., indx)
6657  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6658  !
6659  ! -- Store obs type and assign procedure pointer
6660  ! for delay-flowtop observation type.
6661  call this%obs%StoreObsType('delay-flowtop', .true., indx)
6662  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
6663  !
6664  ! -- Store obs type and assign procedure pointer
6665  ! for delay-flowbot observation type.
6666  call this%obs%StoreObsType('delay-flowbot', .true., indx)
6667  this%obs%obsData(indx)%ProcessIdPtr => csub_process_obsid
Here is the call graph for this function:

◆ csub_fc()

subroutine gwfcsubmodule::csub_fc ( class(gwfcsubtype this,
integer(i4b), intent(in)  kiter,
real(dp), dimension(:), intent(in)  hold,
real(dp), dimension(:), intent(in)  hnew,
class(matrixbasetype), pointer  matrix_sln,
integer(i4b), dimension(:), intent(in)  idxglo,
real(dp), dimension(:), intent(inout)  rhs 
)

Fill the coefficient matrix and right-hand side with the CSUB package terms.

Parameters
[in]kiterouter iteration numbed
[in]holdprevious heads
[in]hnewcurrent heads
matrix_slnA matrix
[in]idxgloglobal index model to solution
[in,out]rhsright-hand side

Definition at line 2489 of file gwf-csub.f90.

2490  ! -- modules
2491  use tdismodule, only: delt
2492  ! -- dummy variables
2493  class(GwfCsubType) :: this
2494  integer(I4B), intent(in) :: kiter !< outer iteration numbed
2495  real(DP), intent(in), dimension(:) :: hold !< previous heads
2496  real(DP), intent(in), dimension(:) :: hnew !< current heads
2497  class(MatrixBaseType), pointer :: matrix_sln !< A matrix
2498  integer(I4B), intent(in), dimension(:) :: idxglo !< global index model to solution
2499  real(DP), intent(inout), dimension(:) :: rhs !< right-hand side
2500  ! -- local variables
2501  integer(I4B) :: ib
2502  integer(I4B) :: node
2503  integer(I4B) :: idiag
2504  integer(I4B) :: idelay
2505  real(DP) :: tled
2506  real(DP) :: area
2507  real(DP) :: hcof
2508  real(DP) :: rhsterm
2509  real(DP) :: comp
2510  !
2511  ! -- update geostatic load calculation
2512  call this%csub_cg_calc_stress(this%dis%nodes, hnew)
2513  !
2514  ! -- formulate csub terms
2515  if (this%gwfiss == 0) then
2516  !
2517  ! -- initialize tled
2518  tled = done / delt
2519  !
2520  ! -- coarse-grained storage
2521  do node = 1, this%dis%nodes
2522  idiag = this%dis%con%ia(node)
2523  area = this%dis%get_area(node)
2524  !
2525  ! -- skip inactive cells
2526  if (this%ibound(node) < 1) cycle
2527  !
2528  ! -- update coarse-grained material properties
2529  if (this%iupdatematprop /= 0) then
2530  if (this%ieslag == 0) then
2531  !
2532  ! -- calculate compaction
2533  call this%csub_cg_calc_comp(node, hnew(node), hold(node), comp)
2534  this%cg_comp(node) = comp
2535  !
2536  ! -- update coarse-grained thickness and void ratio
2537  call this%csub_cg_update(node)
2538  end if
2539  end if
2540  !
2541  ! -- calculate coarse-grained storage terms
2542  call this%csub_cg_fc(node, tled, area, hnew(node), hold(node), &
2543  hcof, rhsterm)
2544  !
2545  ! -- add coarse-grained storage terms to amat and rhs for coarse-grained storage
2546  call matrix_sln%add_value_pos(idxglo(idiag), hcof)
2547  rhs(node) = rhs(node) + rhsterm
2548  !
2549  ! -- calculate coarse-grained water compressibility
2550  ! storage terms
2551  if (this%brg /= dzero) then
2552  call this%csub_cg_wcomp_fc(node, tled, area, hnew(node), hold(node), &
2553  hcof, rhsterm)
2554  !
2555  ! -- add water compression storage terms to amat and rhs for
2556  ! coarse-grained storage
2557  call matrix_sln%add_value_pos(idxglo(idiag), hcof)
2558  rhs(node) = rhs(node) + rhsterm
2559  end if
2560  end do
2561  !
2562  ! -- interbed storage
2563  if (this%ninterbeds /= 0) then
2564  !
2565  ! -- calculate the contribution of interbeds to the
2566  ! groundwater flow equation
2567  do ib = 1, this%ninterbeds
2568  node = this%nodelist(ib)
2569  idelay = this%idelay(ib)
2570  idiag = this%dis%con%ia(node)
2571  area = this%dis%get_area(node)
2572  call this%csub_interbed_fc(ib, node, area, hnew(node), hold(node), &
2573  hcof, rhsterm)
2574  call matrix_sln%add_value_pos(idxglo(idiag), hcof)
2575  rhs(node) = rhs(node) + rhsterm
2576  !
2577  ! -- calculate interbed water compressibility terms
2578  if (.not. is_close(this%brg, dzero) .and. idelay == 0) then
2579  call this%csub_nodelay_wcomp_fc(ib, node, tled, area, &
2580  hnew(node), hold(node), &
2581  hcof, rhsterm)
2582  !
2583  ! -- add water compression storage terms to amat and rhs for interbed
2584  call matrix_sln%add_value_pos(idxglo(idiag), hcof)
2585  rhs(node) = rhs(node) + rhsterm
2586  end if
2587  end do
2588  end if
2589  end if
2590  !
2591  ! -- terminate if errors encountered when updating material properties
2592  if (count_errors() > 0) then
2593  call store_error_filename(this%input_fname)
2594  end if
Here is the call graph for this function:

◆ csub_fn()

subroutine gwfcsubmodule::csub_fn ( class(gwfcsubtype this,
integer(i4b), intent(in)  kiter,
real(dp), dimension(:), intent(in)  hold,
real(dp), dimension(:), intent(in)  hnew,
class(matrixbasetype), pointer  matrix_sln,
integer(i4b), dimension(:), intent(in)  idxglo,
real(dp), dimension(:), intent(inout)  rhs 
)

Fill the coefficient matrix and right-hand side with CSUB package with Newton-Raphson terms.

Parameters
[in,out]amatA matrix
[in,out]rhsright-hand side
[in]kiterouter iteration number
[in]holdprevious heads
[in]hnewcurrent heads
matrix_slnA matrix
[in]idxgloglobal index model to solution
[in,out]rhsright-hand side

Definition at line 2606 of file gwf-csub.f90.

2607  ! -- modules
2608  use tdismodule, only: delt
2609  ! -- dummy variables
2610  class(GwfCsubType) :: this
2611  integer(I4B), intent(in) :: kiter !< outer iteration number
2612  real(DP), intent(in), dimension(:) :: hold !< previous heads
2613  real(DP), intent(in), dimension(:) :: hnew !< current heads
2614  class(MatrixBaseType), pointer :: matrix_sln !< A matrix
2615  integer(I4B), intent(in), dimension(:) :: idxglo !< global index model to solution
2616  real(DP), intent(inout), dimension(:) :: rhs !< right-hand side
2617  ! -- local variables
2618  integer(I4B) :: idelay
2619  integer(I4B) :: node
2620  integer(I4B) :: idiag
2621  integer(I4B) :: ib
2622  real(DP) :: tled
2623  real(DP) :: area
2624  real(DP) :: hcof
2625  real(DP) :: rhsterm
2626  !
2627  ! -- formulate csub terms
2628  if (this%gwfiss == 0) then
2629  tled = done / delt
2630  !
2631  ! -- coarse-grained storage
2632  do node = 1, this%dis%nodes
2633  idiag = this%dis%con%ia(node)
2634  area = this%dis%get_area(node)
2635  !
2636  ! -- skip inactive cells
2637  if (this%ibound(node) < 1) cycle
2638  !
2639  ! -- calculate coarse-grained storage newton terms
2640  call this%csub_cg_fn(node, tled, area, &
2641  hnew(node), hcof, rhsterm)
2642  !
2643  ! -- add coarse-grained storage newton terms to amat and rhs for
2644  ! coarse-grained storage
2645  call matrix_sln%add_value_pos(idxglo(idiag), hcof)
2646  rhs(node) = rhs(node) + rhsterm
2647  !
2648  ! -- calculate coarse-grained water compressibility storage
2649  ! newton terms
2650  if (this%brg /= dzero) then
2651  call this%csub_cg_wcomp_fn(node, tled, area, hnew(node), hold(node), &
2652  hcof, rhsterm)
2653  !
2654  ! -- add water compression storage newton terms to amat and rhs for
2655  ! coarse-grained storage
2656  call matrix_sln%add_value_pos(idxglo(idiag), hcof)
2657  rhs(node) = rhs(node) + rhsterm
2658  end if
2659  end do
2660  !
2661  ! -- interbed storage
2662  if (this%ninterbeds /= 0) then
2663  !
2664  ! -- calculate the interbed newton terms for the
2665  ! groundwater flow equation
2666  do ib = 1, this%ninterbeds
2667  idelay = this%idelay(ib)
2668  node = this%nodelist(ib)
2669  !
2670  ! -- skip inactive cells
2671  if (this%ibound(node) < 1) cycle
2672  !
2673  ! -- calculate interbed newton terms
2674  idiag = this%dis%con%ia(node)
2675  area = this%dis%get_area(node)
2676  call this%csub_interbed_fn(ib, node, hnew(node), hold(node), &
2677  hcof, rhsterm)
2678  !
2679  ! -- add interbed newton terms to amat and rhs
2680  call matrix_sln%add_value_pos(idxglo(idiag), hcof)
2681  rhs(node) = rhs(node) + rhsterm
2682  !
2683  ! -- calculate interbed water compressibility terms
2684  if (this%brg /= dzero .and. idelay == 0) then
2685  call this%csub_nodelay_wcomp_fn(ib, node, tled, area, &
2686  hnew(node), hold(node), &
2687  hcof, rhsterm)
2688  !
2689  ! -- add interbed water compression newton terms to amat and rhs
2690  call matrix_sln%add_value_pos(idxglo(idiag), hcof)
2691  rhs(node) = rhs(node) + rhsterm
2692  end if
2693  end do
2694  end if
2695  end if

◆ csub_fp()

subroutine gwfcsubmodule::csub_fp ( class(gwfcsubtype this)
private

Final processing for the CSUB package. This method generates the final strain tables that are output so that the user can evaluate if calculated strain rates in coarse-grained sediments and interbeds exceed 1 percent.

Definition at line 1646 of file gwf-csub.f90.

1647  ! -- dummy variables
1648  class(GwfCsubType) :: this
1649  ! -- local variables
1650  character(len=LINELENGTH) :: title
1651  character(len=LINELENGTH) :: tag
1652  character(len=LINELENGTH) :: msg
1653  character(len=10) :: ctype
1654  character(len=20) :: cellid
1655  character(len=10) :: cflag
1656  integer(I4B) :: i
1657  integer(I4B) :: ib
1658  integer(I4B) :: i0
1659  integer(I4B) :: i1
1660  integer(I4B) :: node
1661  integer(I4B) :: nn
1662  integer(I4B) :: idelay
1663  integer(I4B) :: iexceed
1664  integer(I4B), parameter :: ncells = 20
1665  integer(I4B) :: nlen
1666  integer(I4B) :: ntabrows
1667  integer(I4B) :: ntabcols
1668  integer(I4B) :: ipos
1669  real(DP) :: b0
1670  real(DP) :: b1
1671  real(DP) :: strain
1672  real(DP) :: pctcomp
1673  integer(I4B), dimension(:), allocatable :: imap_sel
1674  integer(I4B), dimension(:), allocatable :: locs
1675  real(DP), dimension(:), allocatable :: pctcomp_arr
1676  !
1677  ! -- initialize locs
1678  allocate (locs(this%dis%ndim))
1679  !
1680  ! -- calculate and report strain for interbeds
1681  if (this%ninterbeds > 0) then
1682  nlen = min(ncells, this%ninterbeds)
1683  allocate (imap_sel(nlen))
1684  allocate (pctcomp_arr(this%ninterbeds))
1685  iexceed = 0
1686  do ib = 1, this%ninterbeds
1687  idelay = this%idelay(ib)
1688  b0 = this%thickini(ib)
1689  strain = this%tcomp(ib) / b0
1690  pctcomp = dhundred * strain
1691  pctcomp_arr(ib) = pctcomp
1692  if (pctcomp >= done) then
1693  iexceed = iexceed + 1
1694  end if
1695  end do
1696  call selectn(imap_sel, pctcomp_arr, reverse=.true.)
1697  !
1698  ! -- summary interbed strain table
1699  i0 = max(1, this%ninterbeds - ncells + 1)
1700  i1 = this%ninterbeds
1701  msg = ''
1702  if (iexceed /= 0) then
1703  write (msg, '(1x,a,1x,i0,1x,a,1x,i0,1x,a)') &
1704  'LARGEST', (i1 - i0 + 1), 'OF', this%ninterbeds, &
1705  'INTERBED STRAIN VALUES SHOWN'
1706  call write_message(msg, this%iout, skipbefore=1)
1707  !
1708  ! -- interbed strain data
1709  ! -- set title
1710  title = trim(adjustl(this%packName))//' PACKAGE INTERBED STRAIN SUMMARY'
1711  !
1712  ! -- determine the number of columns and rows
1713  ntabrows = nlen
1714  ntabcols = 9
1715  !
1716  ! -- setup table
1717  call table_cr(this%outputtab, this%packName, title)
1718  call this%outputtab%table_df(ntabrows, ntabcols, this%iout)
1719  !
1720  ! add columns
1721  tag = 'INTERBED NUMBER'
1722  call this%outputtab%initialize_column(tag, 10, alignment=tabcenter)
1723  tag = 'INTERBED TYPE'
1724  call this%outputtab%initialize_column(tag, 10, alignment=tabcenter)
1725  tag = 'CELLID'
1726  call this%outputtab%initialize_column(tag, 20, alignment=tableft)
1727  tag = 'INITIAL THICKNESS'
1728  call this%outputtab%initialize_column(tag, 12, alignment=tabcenter)
1729  tag = 'FINAL THICKNESS'
1730  call this%outputtab%initialize_column(tag, 12, alignment=tabcenter)
1731  tag = 'TOTAL COMPACTION'
1732  call this%outputtab%initialize_column(tag, 12, alignment=tabcenter)
1733  tag = 'FINAL STRAIN'
1734  call this%outputtab%initialize_column(tag, 12, alignment=tabcenter)
1735  tag = 'PERCENT COMPACTION'
1736  call this%outputtab%initialize_column(tag, 12, alignment=tabcenter)
1737  tag = 'FLAG'
1738  call this%outputtab%initialize_column(tag, 10, alignment=tabcenter)
1739  !
1740  ! -- write data
1741  do i = 1, nlen
1742  ib = imap_sel(i)
1743  idelay = this%idelay(ib)
1744  b0 = this%thickini(ib)
1745  b1 = this%csub_calc_interbed_thickness(ib)
1746  if (idelay == 0) then
1747  ctype = 'no-delay'
1748  else
1749  ctype = 'delay'
1750  b0 = b0 * this%rnb(ib)
1751  end if
1752  strain = this%tcomp(ib) / b0
1753  pctcomp = dhundred * strain
1754  if (pctcomp >= 5.0_dp) then
1755  cflag = '**>=5%'
1756  else if (pctcomp >= done) then
1757  cflag = '*>=1%'
1758  else
1759  cflag = ''
1760  end if
1761  node = this%nodelist(ib)
1762  call this%dis%noder_to_string(node, cellid)
1763  !
1764  ! -- fill table line
1765  call this%outputtab%add_term(ib)
1766  call this%outputtab%add_term(ctype)
1767  call this%outputtab%add_term(cellid)
1768  call this%outputtab%add_term(b0)
1769  call this%outputtab%add_term(b1)
1770  call this%outputtab%add_term(this%tcomp(ib))
1771  call this%outputtab%add_term(strain)
1772  call this%outputtab%add_term(pctcomp)
1773  call this%outputtab%add_term(cflag)
1774  end do
1775  write (this%iout, '(/1X,A,1X,I0,1X,A,1X,I0,1X,A,/1X,A,/1X,A)') &
1776  'PERCENT COMPACTION IS GREATER THAN OR EQUAL TO 1 PERCENT IN', &
1777  iexceed, 'OF', this%ninterbeds, 'INTERBED(S).', &
1778  'USE THE STRAIN_CSV_INTERBED OPTION TO OUTPUT A CSV '// &
1779  'FILE WITH PERCENT COMPACTION ', 'VALUES FOR ALL INTERBEDS.'
1780  else
1781  msg = 'PERCENT COMPACTION WAS LESS THAN 1 PERCENT IN ALL INTERBEDS'
1782  write (this%iout, '(/1X,A)') trim(adjustl(msg))
1783  end if
1784  !
1785  ! -- write csv file
1786  if (this%istrainib /= 0) then
1787  !
1788  ! -- determine the number of columns and rows
1789  ntabrows = this%ninterbeds
1790  ntabcols = 7
1791  if (this%dis%ndim > 1) then
1792  ntabcols = ntabcols + 1
1793  end if
1794  ntabcols = ntabcols + this%dis%ndim
1795  !
1796  ! -- setup table
1797  call table_cr(this%outputtab, this%packName, '')
1798  call this%outputtab%table_df(ntabrows, ntabcols, this%istrainib, &
1799  lineseparator=.false., separator=',')
1800  !
1801  ! add columns
1802  tag = 'INTERBED_NUMBER'
1803  call this%outputtab%initialize_column(tag, 20, alignment=tabright)
1804  tag = 'INTERBED_TYPE'
1805  call this%outputtab%initialize_column(tag, 20, alignment=tabright)
1806  tag = 'NODE'
1807  call this%outputtab%initialize_column(tag, 10, alignment=tabright)
1808  if (this%dis%ndim == 2) then
1809  tag = 'LAYER'
1810  call this%outputtab%initialize_column(tag, 10, alignment=tabright)
1811  tag = 'ICELL2D'
1812  call this%outputtab%initialize_column(tag, 10, alignment=tabright)
1813  else
1814  tag = 'LAYER'
1815  call this%outputtab%initialize_column(tag, 10, alignment=tabright)
1816  tag = 'ROW'
1817  call this%outputtab%initialize_column(tag, 10, alignment=tabright)
1818  tag = 'COLUMN'
1819  call this%outputtab%initialize_column(tag, 10, alignment=tabright)
1820  end if
1821  tag = 'INITIAL_THICKNESS'
1822  call this%outputtab%initialize_column(tag, 20, alignment=tabright)
1823  tag = 'FINAL_THICKNESS'
1824  call this%outputtab%initialize_column(tag, 20, alignment=tabright)
1825  tag = 'TOTAL_COMPACTION'
1826  call this%outputtab%initialize_column(tag, 20, alignment=tabright)
1827  tag = 'TOTAL_STRAIN'
1828  call this%outputtab%initialize_column(tag, 20, alignment=tabright)
1829  tag = 'PERCENT_COMPACTION'
1830  call this%outputtab%initialize_column(tag, 20, alignment=tabright)
1831  !
1832  ! -- write data
1833  do ib = 1, this%ninterbeds
1834  idelay = this%idelay(ib)
1835  b0 = this%thickini(ib)
1836  b1 = this%csub_calc_interbed_thickness(ib)
1837  if (idelay == 0) then
1838  ctype = 'no-delay'
1839  else
1840  ctype = 'delay'
1841  b0 = b0 * this%rnb(ib)
1842  end if
1843  strain = this%tcomp(ib) / b0
1844  pctcomp = dhundred * strain
1845  node = this%nodelist(ib)
1846  call this%dis%noder_to_array(node, locs)
1847  !
1848  ! -- fill table line
1849  call this%outputtab%add_term(ib)
1850  call this%outputtab%add_term(ctype)
1851  if (this%dis%ndim > 1) then
1852  call this%outputtab%add_term(this%dis%get_nodeuser(node))
1853  end if
1854  do ipos = 1, this%dis%ndim
1855  call this%outputtab%add_term(locs(ipos))
1856  end do
1857  call this%outputtab%add_term(b0)
1858  call this%outputtab%add_term(b1)
1859  call this%outputtab%add_term(this%tcomp(ib))
1860  call this%outputtab%add_term(strain)
1861  call this%outputtab%add_term(pctcomp)
1862  end do
1863  end if
1864  !
1865  ! -- deallocate temporary storage
1866  deallocate (imap_sel)
1867  deallocate (pctcomp_arr)
1868  end if
1869  !
1870  ! -- calculate and report strain for coarse-grained materials
1871  nlen = min(ncells, this%dis%nodes)
1872  allocate (imap_sel(nlen))
1873  allocate (pctcomp_arr(this%dis%nodes))
1874  iexceed = 0
1875  do node = 1, this%dis%nodes
1876  strain = dzero
1877  if (this%cg_thickini(node) > dzero) then
1878  strain = this%cg_tcomp(node) / this%cg_thickini(node)
1879  end if
1880  pctcomp = dhundred * strain
1881  pctcomp_arr(node) = pctcomp
1882  if (pctcomp >= done) then
1883  iexceed = iexceed + 1
1884  end if
1885  end do
1886  call selectn(imap_sel, pctcomp_arr, reverse=.true.)
1887  !
1888  ! -- summary coarse-grained strain table
1889  i0 = max(1, this%dis%nodes - ncells + 1)
1890  i1 = this%dis%nodes
1891  msg = ''
1892  if (iexceed /= 0) then
1893  write (msg, '(a,1x,i0,1x,a,1x,i0,1x,a)') &
1894  'LARGEST ', (i1 - i0 + 1), 'OF', this%dis%nodes, &
1895  'CELL COARSE-GRAINED VALUES SHOWN'
1896  call write_message(msg, this%iout, skipbefore=1)
1897  !
1898  ! -- set title
1899  title = trim(adjustl(this%packName))// &
1900  ' PACKAGE COARSE-GRAINED STRAIN SUMMARY'
1901  !
1902  ! -- determine the number of columns and rows
1903  ntabrows = nlen
1904  ntabcols = 7
1905  !
1906  ! -- setup table
1907  call table_cr(this%outputtab, this%packName, title)
1908  call this%outputtab%table_df(ntabrows, ntabcols, this%iout)
1909  !
1910  ! add columns
1911  tag = 'CELLID'
1912  call this%outputtab%initialize_column(tag, 20, alignment=tableft)
1913  tag = 'INITIAL THICKNESS'
1914  call this%outputtab%initialize_column(tag, 12, alignment=tabcenter)
1915  tag = 'FINAL THICKNESS'
1916  call this%outputtab%initialize_column(tag, 12, alignment=tabcenter)
1917  tag = 'TOTAL COMPACTION'
1918  call this%outputtab%initialize_column(tag, 12, alignment=tabcenter)
1919  tag = 'FINAL STRAIN'
1920  call this%outputtab%initialize_column(tag, 12, alignment=tabcenter)
1921  tag = 'PERCENT COMPACTION'
1922  call this%outputtab%initialize_column(tag, 12, alignment=tabcenter)
1923  tag = 'FLAG'
1924  call this%outputtab%initialize_column(tag, 10, alignment=tabcenter)
1925  ! -- write data
1926  do nn = 1, nlen
1927  node = imap_sel(nn)
1928  if (this%cg_thickini(node) > dzero) then
1929  strain = this%cg_tcomp(node) / this%cg_thickini(node)
1930  else
1931  strain = dzero
1932  end if
1933  pctcomp = dhundred * strain
1934  if (pctcomp >= 5.0_dp) then
1935  cflag = '**>=5%'
1936  else if (pctcomp >= done) then
1937  cflag = '*>=1%'
1938  else
1939  cflag = ''
1940  end if
1941  call this%dis%noder_to_string(node, cellid)
1942  !
1943  ! -- fill table line
1944  call this%outputtab%add_term(cellid)
1945  call this%outputtab%add_term(this%cg_thickini(node))
1946  call this%outputtab%add_term(this%cg_thick(node))
1947  call this%outputtab%add_term(this%cg_tcomp(node))
1948  call this%outputtab%add_term(strain)
1949  call this%outputtab%add_term(pctcomp)
1950  call this%outputtab%add_term(cflag)
1951  end do
1952  write (this%iout, '(/1X,A,1X,I0,1X,A,1X,I0,1X,A,/1X,A,/1X,A)') &
1953  'COARSE-GRAINED STORAGE PERCENT COMPACTION IS GREATER THAN OR '// &
1954  'EQUAL TO 1 PERCENT IN', iexceed, 'OF', this%dis%nodes, 'CELL(S).', &
1955  'USE THE STRAIN_CSV_COARSE OPTION TO OUTPUT A CSV '// &
1956  'FILE WITH PERCENT COMPACTION ', 'VALUES FOR ALL CELLS.'
1957  else
1958  msg = 'COARSE-GRAINED STORAGE PERCENT COMPACTION WAS LESS THAN '// &
1959  '1 PERCENT IN ALL CELLS '
1960  write (this%iout, '(/1X,A)') trim(adjustl(msg))
1961  end if
1962  !
1963  ! -- write csv file
1964  if (this%istrainsk /= 0) then
1965  !
1966  ! -- determine the number of columns and rows
1967  ntabrows = this%dis%nodes
1968  ntabcols = 5
1969  if (this%dis%ndim > 1) then
1970  ntabcols = ntabcols + 1
1971  end if
1972  ntabcols = ntabcols + this%dis%ndim
1973  !
1974  ! -- setup table
1975  call table_cr(this%outputtab, this%packName, '')
1976  call this%outputtab%table_df(ntabrows, ntabcols, this%istrainsk, &
1977  lineseparator=.false., separator=',')
1978  !
1979  ! add columns
1980  tag = 'NODE'
1981  call this%outputtab%initialize_column(tag, 10, alignment=tabright)
1982  if (this%dis%ndim == 2) then
1983  tag = 'LAYER'
1984  call this%outputtab%initialize_column(tag, 10, alignment=tabright)
1985  tag = 'ICELL2D'
1986  call this%outputtab%initialize_column(tag, 10, alignment=tabright)
1987  else
1988  tag = 'LAYER'
1989  call this%outputtab%initialize_column(tag, 10, alignment=tabright)
1990  tag = 'ROW'
1991  call this%outputtab%initialize_column(tag, 10, alignment=tabright)
1992  tag = 'COLUMN'
1993  call this%outputtab%initialize_column(tag, 10, alignment=tabright)
1994  end if
1995  tag = 'INITIAL_THICKNESS'
1996  call this%outputtab%initialize_column(tag, 20, alignment=tabright)
1997  tag = 'FINAL_THICKNESS'
1998  call this%outputtab%initialize_column(tag, 20, alignment=tabright)
1999  tag = 'TOTAL_COMPACTION'
2000  call this%outputtab%initialize_column(tag, 20, alignment=tabright)
2001  tag = 'TOTAL_STRAIN'
2002  call this%outputtab%initialize_column(tag, 20, alignment=tabright)
2003  tag = 'PERCENT_COMPACTION'
2004  call this%outputtab%initialize_column(tag, 20, alignment=tabright)
2005  !
2006  ! -- write data
2007  do node = 1, this%dis%nodes
2008  if (this%cg_thickini(node) > dzero) then
2009  strain = this%cg_tcomp(node) / this%cg_thickini(node)
2010  else
2011  strain = dzero
2012  end if
2013  pctcomp = dhundred * strain
2014  call this%dis%noder_to_array(node, locs)
2015  !
2016  ! -- fill table line
2017  if (this%dis%ndim > 1) then
2018  call this%outputtab%add_term(this%dis%get_nodeuser(node))
2019  end if
2020  do ipos = 1, this%dis%ndim
2021  call this%outputtab%add_term(locs(ipos))
2022  end do
2023  call this%outputtab%add_term(this%cg_thickini(node))
2024  call this%outputtab%add_term(this%cg_thick(node))
2025  call this%outputtab%add_term(this%cg_tcomp(node))
2026  call this%outputtab%add_term(strain)
2027  call this%outputtab%add_term(pctcomp)
2028  end do
2029  end if
2030  !
2031  ! -- write a warning message for delay interbeds in non-convertible gwf
2032  ! cells that violate minimum head assumptions
2033  if (this%ndelaybeds > 0) then
2034  if (this%idb_nconv_count(2) > 0) then
2035  write (warnmsg, '(a,1x,a,1x,i0,1x,a,1x,a)') &
2036  'Delay interbed cell heads were less than the top of the interbed', &
2037  'cell in', this%idb_nconv_count(2), 'interbed cells in ', &
2038  'non-convertible GWF cells for at least one time step during '// &
2039  'the simulation.'
2040  call store_warning(warnmsg)
2041  end if
2042  end if
2043  !
2044  ! -- deallocate temporary storage
2045  deallocate (imap_sel)
2046  deallocate (locs)
2047  deallocate (pctcomp_arr)
Here is the call graph for this function:

◆ csub_initialize_tables()

subroutine gwfcsubmodule::csub_initialize_tables ( class(gwfcsubtype this)

Subroutine to initialize optional tables. Tables include: o delay interbeds convergence tables

Definition at line 2704 of file gwf-csub.f90.

2705  class(GwfCsubType) :: this
2706 
2707  character(len=LINELENGTH) :: tag
2708  integer(I4B) :: ntabrows
2709  integer(I4B) :: ntabcols
2710 
2711  if (this%ipakcsv > 0) then
2712  if (this%ndelaybeds < 1) then
2713  write (warnmsg, '(a,1x,3a)') &
2714  'Package convergence data is requested but delay interbeds', &
2715  'are not included in package (', &
2716  trim(adjustl(this%packName)), ').'
2717  call store_warning(warnmsg)
2718  end if
2719 
2720  ntabrows = 1
2721  ntabcols = 9
2722 
2723  ! setup table
2724  call table_cr(this%pakcsvtab, this%packName, '')
2725  call this%pakcsvtab%table_df(ntabrows, ntabcols, this%ipakcsv, &
2726  lineseparator=.false., separator=',', &
2727  finalize=.false.)
2728 
2729  ! add columns to package csv
2730  tag = 'total_inner_iterations'
2731  call this%pakcsvtab%initialize_column(tag, 10, alignment=tableft)
2732  tag = 'totim'
2733  call this%pakcsvtab%initialize_column(tag, 10, alignment=tableft)
2734  tag = 'kper'
2735  call this%pakcsvtab%initialize_column(tag, 10, alignment=tableft)
2736  tag = 'kstp'
2737  call this%pakcsvtab%initialize_column(tag, 10, alignment=tableft)
2738  tag = 'nouter'
2739  call this%pakcsvtab%initialize_column(tag, 10, alignment=tableft)
2740  tag = 'dvmax'
2741  call this%pakcsvtab%initialize_column(tag, 15, alignment=tableft)
2742  tag = 'dvmax_loc'
2743  call this%pakcsvtab%initialize_column(tag, 15, alignment=tableft)
2744  tag = 'dstoragemax'
2745  call this%pakcsvtab%initialize_column(tag, 15, alignment=tableft)
2746  tag = 'dstoragemax_loc'
2747  call this%pakcsvtab%initialize_column(tag, 15, alignment=tableft)
2748  end if
2749 
Here is the call graph for this function:

◆ csub_interbed_fc()

subroutine gwfcsubmodule::csub_interbed_fc ( class(gwfcsubtype this,
integer(i4b), intent(in)  ib,
integer(i4b), intent(in)  node,
real(dp), intent(in)  area,
real(dp), intent(in)  hcell,
real(dp), intent(in)  hcellold,
real(dp), intent(inout)  hcof,
real(dp), intent(inout)  rhs 
)
private

Method formulates the coefficient matrix and right-hand side terms for a interbed in a cell.

Parameters
[in,out]hcofinterbed A matrix entry
[in,out]rhsinterbed right-hand side entry
[in]ibinterbed number
[in]nodecell node number
[in]areahorizontal cell area
[in]hcellcurrent head in cell
[in]hcelloldprevious head in cell
[in,out]hcofinterbed A matrix entry
[in,out]rhsinterbed right-hand side

Definition at line 4560 of file gwf-csub.f90.

4561  ! -- dummy variables
4562  class(GwfCsubType) :: this
4563  integer(I4B), intent(in) :: ib !< interbed number
4564  integer(I4B), intent(in) :: node !< cell node number
4565  real(DP), intent(in) :: area !< horizontal cell area
4566  real(DP), intent(in) :: hcell !< current head in cell
4567  real(DP), intent(in) :: hcellold !< previous head in cell
4568  real(DP), intent(inout) :: hcof !< interbed A matrix entry
4569  real(DP), intent(inout) :: rhs !< interbed right-hand side
4570  ! -- local variables
4571  real(DP) :: snnew
4572  real(DP) :: snold
4573  real(DP) :: comp
4574  real(DP) :: compi
4575  real(DP) :: compe
4576  real(DP) :: rho1
4577  real(DP) :: rho2
4578  real(DP) :: f
4579  !
4580  ! -- initialize variables
4581  rhs = dzero
4582  hcof = dzero
4583  comp = dzero
4584  compi = dzero
4585  compe = dzero
4586  !
4587  ! -- skip inactive and constant head cells
4588  if (this%ibound(node) > 0) then
4589  if (this%idelay(ib) == 0) then
4590  !
4591  ! -- update material properties
4592  if (this%iupdatematprop /= 0) then
4593  if (this%ieslag == 0) then
4594  !
4595  ! -- calculate compaction
4596  call this%csub_nodelay_calc_comp(ib, hcell, hcellold, comp, &
4597  rho1, rho2)
4598  this%comp(ib) = comp
4599  !
4600  ! -- update thickness and void ratio
4601  call this%csub_nodelay_update(ib)
4602  end if
4603  end if
4604  !
4605  ! -- calculate no-delay interbed rho1 and rho2
4606  call this%csub_nodelay_fc(ib, hcell, hcellold, rho1, hcof, rhs)
4607  f = area
4608  else
4609  !
4610  ! -- calculate cell saturation
4611  call this%csub_calc_sat(node, hcell, hcellold, snnew, snold)
4612  !
4613  ! -- update material properties
4614  if (this%iupdatematprop /= 0) then
4615  if (this%ieslag == 0) then
4616  !
4617  ! -- calculate compaction
4618  call this%csub_delay_calc_comp(ib, hcell, hcellold, &
4619  comp, compi, compe)
4620  this%comp(ib) = comp
4621  !
4622  ! -- update thickness and void ratio
4623  call this%csub_delay_update(ib)
4624  end if
4625  end if
4626  !
4627  ! -- calculate delay interbed hcof and rhs
4628  call this%csub_delay_sln(ib, hcell)
4629  call this%csub_delay_fc(ib, hcof, rhs)
4630  f = area * this%rnb(ib)
4631  end if
4632  rhs = rhs * f
4633  hcof = -hcof * f
4634  end if

◆ csub_interbed_fn()

subroutine gwfcsubmodule::csub_interbed_fn ( class(gwfcsubtype this,
integer(i4b), intent(in)  ib,
integer(i4b), intent(in)  node,
real(dp), intent(in)  hcell,
real(dp), intent(in)  hcellold,
real(dp), intent(inout)  hcof,
real(dp), intent(inout)  rhs 
)
private

Method formulates the Newton-Raphson formulation coefficient matrix and right-hand side terms for a interbed in a cell.

Parameters
[in,out]hcofinterbed A matrix entry
[in,out]rhsinterbed right-hand side entry
[in]ibinterbed number
[in]nodecell node number
[in]hcellcurrent head in a cell
[in]hcelloldprevious head in a cell
[in,out]hcofinterbed A matrix entry
[in,out]rhsinterbed right-hand side entry

Definition at line 4646 of file gwf-csub.f90.

4647  ! -- modules
4648  use tdismodule, only: delt
4649  ! -- dummy variables
4650  class(GwfCsubType) :: this
4651  integer(I4B), intent(in) :: ib !< interbed number
4652  integer(I4B), intent(in) :: node !< cell node number
4653  real(DP), intent(in) :: hcell !< current head in a cell
4654  real(DP), intent(in) :: hcellold !< previous head in a cell
4655  real(DP), intent(inout) :: hcof !< interbed A matrix entry
4656  real(DP), intent(inout) :: rhs !< interbed right-hand side entry
4657  ! -- local variables
4658  integer(I4B) :: idelay
4659  real(DP) :: hcofn
4660  real(DP) :: rhsn
4661  real(DP) :: top
4662  real(DP) :: bot
4663  real(DP) :: tled
4664  real(DP) :: tthk
4665  real(DP) :: snnew
4666  real(DP) :: snold
4667  real(DP) :: f
4668  real(DP) :: satderv
4669  real(DP) :: hbar
4670  real(DP) :: hbarderv
4671  real(DP) :: rho1
4672  real(DP) :: rho2
4673  !
4674  ! -- initialize variables
4675  rhs = dzero
4676  hcof = dzero
4677  rhsn = dzero
4678  hcofn = dzero
4679  satderv = dzero
4680  idelay = this%idelay(ib)
4681  top = this%dis%top(node)
4682  bot = this%dis%bot(node)
4683  !
4684  ! -- skip inactive and constant head cells
4685  if (this%ibound(node) > 0) then
4686  tled = done / delt
4687  tthk = this%thickini(ib)
4688  !
4689  ! -- calculate cell saturation
4690  call this%csub_calc_sat(node, hcell, hcellold, snnew, snold)
4691  !
4692  ! -- no-delay interbeds
4693  if (idelay == 0) then
4694  !
4695  ! -- initialize factor
4696  f = done
4697  !
4698  ! -- calculate the saturation derivative
4699  satderv = this%csub_calc_sat_derivative(node, hcell)
4700  !
4701  ! -- calculate corrected head (hbar)
4702  hbar = squadratic0sp(hcell, bot, this%satomega)
4703  !
4704  ! -- calculate the derivative of the hbar functions
4705  hbarderv = squadratic0spderivative(hcell, bot, this%satomega)
4706  !
4707  ! -- calculate storage coefficient
4708  call this%csub_nodelay_fc(ib, hcell, hcellold, rho1, rho2, rhsn)
4709  !
4710  ! -- calculate hcofn term
4711  hcofn = rho2 * (done - hbarderv) * snnew + &
4712  rho2 * (this%cg_gs(node) - hbar + bot) * satderv
4713  if (this%ielastic(ib) == 0) then
4714  hcofn = hcofn - rho2 * this%pcs(ib) * satderv
4715  end if
4716  !
4717  ! -- Add additional term if using lagged effective stress
4718  if (this%ieslag /= 0) then
4719  if (this%ielastic(ib) /= 0) then
4720  hcofn = hcofn - rho1 * this%cg_es0(node) * satderv
4721  else
4722  hcofn = hcofn - rho1 * (this%pcs(ib) - this%cg_es0(node)) * satderv
4723  end if
4724  end if
4725  end if
4726  end if
Here is the call graph for this function:

◆ csub_nodelay_calc_comp()

subroutine gwfcsubmodule::csub_nodelay_calc_comp ( class(gwfcsubtype this,
integer(i4b), intent(in)  ib,
real(dp), intent(in)  hcell,
real(dp), intent(in)  hcellold,
real(dp), intent(inout)  comp,
real(dp), intent(inout)  rho1,
real(dp), intent(inout)  rho2 
)

Method calculates the compaction for a no-delay interbed. The method also calculates the storage coefficients for the no-delay interbed.

Parameters
[in,out]compno-delay compaction
[in,out]rho1no-delay storage value using Sske
[in,out]rho2no-delay storage value using Ssk
[in]ibinterbed number
[in]hcellcurrent head for the cell
[in]hcelloldprevious head for the cell
[in,out]compno-delay interbed compaction
[in,out]rho1current storage coefficient based on Sske
[in,out]rho2current storage coefficient based on Ssk

Definition at line 3992 of file gwf-csub.f90.

3993  ! -- dummy variables
3994  class(GwfCsubType) :: this
3995  integer(I4B), intent(in) :: ib !< interbed number
3996  real(DP), intent(in) :: hcell !< current head for the cell
3997  real(DP), intent(in) :: hcellold !< previous head for the cell
3998  real(DP), intent(inout) :: comp !< no-delay interbed compaction
3999  real(DP), intent(inout) :: rho1 !< current storage coefficient based on Sske
4000  real(DP), intent(inout) :: rho2 !< current storage coefficient based on Ssk
4001  ! -- local variables
4002  integer(I4B) :: node
4003  real(DP) :: es
4004  real(DP) :: es0
4005  real(DP) :: pcs
4006  real(DP) :: tled
4007  real(DP) :: rhs
4008  !
4009  ! -- initialize variables
4010  node = this%nodelist(ib)
4011  tled = done
4012  es = this%cg_es(node)
4013  es0 = this%cg_es0(node)
4014  pcs = this%pcs(ib)
4015  !
4016  ! -- calculate no-delay interbed rho1 and rho2
4017  call this%csub_nodelay_fc(ib, hcell, hcellold, rho1, rho2, rhs, argtled=tled)
4018  !
4019  ! -- calculate no-delay interbed compaction
4020  if (this%ielastic(ib) /= 0) then
4021  comp = rho2 * es - rho1 * es0
4022  else
4023  comp = -pcs * (rho2 - rho1) - (rho1 * es0) + (rho2 * es)
4024  end if

◆ csub_nodelay_fc()

subroutine gwfcsubmodule::csub_nodelay_fc ( class(gwfcsubtype this,
integer(i4b), intent(in)  ib,
real(dp), intent(in)  hcell,
real(dp), intent(in)  hcellold,
real(dp), intent(inout)  rho1,
real(dp), intent(inout)  rho2,
real(dp), intent(inout)  rhs,
real(dp), intent(in), optional  argtled 
)
private

Method calculates the skeletal storage coefficients for a no-delay interbed. The method also calculates the contribution of the no-delay interbed to the right-hand side of the groundwater flow equation for the cell.

Parameters
[in,out]rho1no-delay storage value using Sske
[in,out]rho2no-delay storage value using Ssk
[in,out]rhsno-delay right-hand side contribution
[in]ibinterbed number
[in]hcellcurrent head in the cell
[in]hcelloldprevious head in the cell
[in,out]rho1current storage coefficient value using Sske
[in,out]rho2current storage coefficient value based on Ssk
[in,out]rhsno-delay interbed contribution to the right-hand side
[in]argtledoptional reciprocal of the time step length

Definition at line 3884 of file gwf-csub.f90.

3886  ! -- modules
3887  use tdismodule, only: delt
3888  ! -- dummy variables
3889  class(GwfCsubType) :: this
3890  integer(I4B), intent(in) :: ib !< interbed number
3891  real(DP), intent(in) :: hcell !< current head in the cell
3892  real(DP), intent(in) :: hcellold !< previous head in the cell
3893  real(DP), intent(inout) :: rho1 !< current storage coefficient value using Sske
3894  real(DP), intent(inout) :: rho2 !< current storage coefficient value based on Ssk
3895  real(DP), intent(inout) :: rhs !< no-delay interbed contribution to the right-hand side
3896  real(DP), intent(in), optional :: argtled !< optional reciprocal of the time step length
3897  ! -- local variables
3898  integer(I4B) :: node
3899  real(DP) :: tled
3900  real(DP) :: top
3901  real(DP) :: bot
3902  real(DP) :: thick
3903  real(DP) :: hbar
3904  real(DP) :: znode
3905  real(DP) :: snold
3906  real(DP) :: snnew
3907  real(DP) :: sto_fac
3908  real(DP) :: sto_fac0
3909  real(DP) :: area
3910  real(DP) :: theta
3911  real(DP) :: es
3912  real(DP) :: es0
3913  real(DP) :: f
3914  real(DP) :: f0
3915  real(DP) :: rcorr
3916  !
3917  ! -- process optional variables
3918  if (present(argtled)) then
3919  tled = argtled
3920  else
3921  tled = done / delt
3922  end if
3923  node = this%nodelist(ib)
3924  area = this%dis%get_area(node)
3925  bot = this%dis%bot(node)
3926  top = this%dis%top(node)
3927  thick = this%thickini(ib)
3928  !
3929  ! -- calculate corrected head (hbar)
3930  hbar = squadratic0sp(hcell, bot, this%satomega)
3931  !
3932  ! -- set iconvert
3933  this%iconvert(ib) = 0
3934  !
3935  ! -- aquifer saturation
3936  call this%csub_calc_sat(node, hcell, hcellold, snnew, snold)
3937  if (this%lhead_based .EQV. .true.) then
3938  f = done
3939  f0 = done
3940  else
3941  znode = this%csub_calc_znode(top, bot, hbar)
3942  es = this%cg_es(node)
3943  es0 = this%cg_es0(node)
3944  theta = this%thetaini(ib)
3945  !
3946  ! -- calculate the compression index factors for the delay
3947  ! node relative to the center of the cell based on the
3948  ! current and previous head
3949  call this%csub_calc_sfacts(node, bot, znode, theta, es, es0, f)
3950  end if
3951  sto_fac = tled * snnew * thick * f
3952  sto_fac0 = tled * snold * thick * f
3953  !
3954  ! -- calculate rho1 and rho2
3955  rho1 = this%rci(ib) * sto_fac0
3956  rho2 = this%rci(ib) * sto_fac
3957  if (this%cg_es(node) > this%pcs(ib)) then
3958  this%iconvert(ib) = 1
3959  rho2 = this%ci(ib) * sto_fac
3960  end if
3961  !
3962  ! -- calculate correction term
3963  rcorr = rho2 * (hcell - hbar)
3964  !
3965  ! -- fill right-hand side
3966  if (this%ielastic(ib) /= 0) then
3967  rhs = rho1 * this%cg_es0(node) - &
3968  rho2 * (this%cg_gs(node) + bot) - &
3969  rcorr
3970  else
3971  rhs = -rho2 * (this%cg_gs(node) + bot) + &
3972  (this%pcs(ib) * (rho2 - rho1)) + &
3973  (rho1 * this%cg_es0(node)) - &
3974  rcorr
3975  end if
3976  !
3977  ! -- save ske and sk
3978  this%ske(ib) = rho1
3979  this%sk(ib) = rho2
Here is the call graph for this function:

◆ csub_nodelay_update()

subroutine gwfcsubmodule::csub_nodelay_update ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  i 
)
private

Method updates no-delay material properties based on the current compaction value.

Definition at line 3840 of file gwf-csub.f90.

3841  ! -- dummy variables
3842  class(GwfCsubType), intent(inout) :: this
3843  integer(I4B), intent(in) :: i
3844  ! -- local variables
3845  real(DP) :: comp
3846  real(DP) :: thick
3847  real(DP) :: theta
3848  !
3849  ! -- update thickness and theta
3850  comp = this%tcomp(i) + this%comp(i)
3851  if (abs(comp) > dzero) then
3852  thick = this%thickini(i)
3853  theta = this%thetaini(i)
3854  call this%csub_adj_matprop(comp, thick, theta)
3855  if (thick <= dzero) then
3856  write (errmsg, '(a,1x,i0,1x,a,g0,a)') &
3857  'Adjusted thickness for no-delay interbed', i, &
3858  'is less than or equal to 0 (', thick, ').'
3859  call store_error(errmsg)
3860  end if
3861  if (theta <= dzero) then
3862  write (errmsg, '(a,1x,i0,1x,a,g0,a)') &
3863  'Adjusted theta for no-delay interbed', i, &
3864  'is less than or equal to 0 (', theta, ').'
3865  call store_error(errmsg)
3866  end if
3867  this%thick(i) = thick
3868  this%theta(i) = theta
3869  end if
Here is the call graph for this function:

◆ csub_nodelay_wcomp_fc()

subroutine gwfcsubmodule::csub_nodelay_wcomp_fc ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib,
integer(i4b), intent(in)  node,
real(dp), intent(in)  tled,
real(dp), intent(in)  area,
real(dp), intent(in)  hcell,
real(dp), intent(in)  hcellold,
real(dp), intent(inout)  hcof,
real(dp), intent(inout)  rhs 
)
private

Method formulates the standard formulation coefficient matrix and right-hand side terms for water compressibility in no-delay interbeds.

Parameters
[in,out]hcofno-delay A matrix entry
[in,out]rhsno-delay right-hand side entry
[in]ibinterbed number
[in]nodecell node number
[in]tledreciprocal of time step length
[in]areahorizontal cell area
[in]hcellcurrent head in cell
[in]hcelloldprevious head in cell
[in,out]hcofno-delay A matrix entry
[in,out]rhsno-delay right-hand side entry

Definition at line 4982 of file gwf-csub.f90.

4984  ! -- dummy variables
4985  class(GwfCsubType), intent(inout) :: this
4986  integer(I4B), intent(in) :: ib !< interbed number
4987  integer(I4B), intent(in) :: node !< cell node number
4988  real(DP), intent(in) :: tled !< reciprocal of time step length
4989  real(DP), intent(in) :: area !< horizontal cell area
4990  real(DP), intent(in) :: hcell !< current head in cell
4991  real(DP), intent(in) :: hcellold !< previous head in cell
4992  real(DP), intent(inout) :: hcof !< no-delay A matrix entry
4993  real(DP), intent(inout) :: rhs !< no-delay right-hand side entry
4994  ! -- local variables
4995  real(DP) :: top
4996  real(DP) :: bot
4997  real(DP) :: snold
4998  real(DP) :: snnew
4999  real(DP) :: f
5000  real(DP) :: wc
5001  real(DP) :: wc0
5002  !
5003  ! -- initialize variables
5004  rhs = dzero
5005  hcof = dzero
5006  !
5007  ! -- aquifer elevations and thickness
5008  top = this%dis%top(node)
5009  bot = this%dis%bot(node)
5010  !
5011  ! -- calculate cell saturation
5012  call this%csub_calc_sat(node, hcell, hcellold, snnew, snold)
5013  !
5014  !
5015  f = this%brg * area * tled
5016  wc0 = f * this%theta0(ib) * this%thick0(ib)
5017  wc = f * this%theta(ib) * this%thick(ib)
5018  hcof = -wc * snnew
5019  rhs = -wc0 * snold * hcellold

◆ csub_nodelay_wcomp_fn()

subroutine gwfcsubmodule::csub_nodelay_wcomp_fn ( class(gwfcsubtype), intent(inout)  this,
integer(i4b), intent(in)  ib,
integer(i4b), intent(in)  node,
real(dp), intent(in)  tled,
real(dp), intent(in)  area,
real(dp), intent(in)  hcell,
real(dp), intent(in)  hcellold,
real(dp), intent(inout)  hcof,
real(dp), intent(inout)  rhs 
)
private

Method formulates the Newton-Raphson formulation coefficient matrix and right-hand side terms for water compressibility in no-delay interbeds.

Parameters
[in,out]hcofno-delay A matrix entry
[in,out]rhsno-delay right-hand side entry
[in]ibinterbed number
[in]nodecell node number
[in]tledreciprocal of time step length
[in]areahorizontal cell area
[in]hcellcurrent head in cell
[in]hcelloldprevious head in cell
[in,out]hcofno-delay A matrix entry
[in,out]rhsno-delay right-hand side entry

Definition at line 5032 of file gwf-csub.f90.

5034  ! -- dummy variables
5035  class(GwfCsubType), intent(inout) :: this
5036  integer(I4B), intent(in) :: ib !< interbed number
5037  integer(I4B), intent(in) :: node !< cell node number
5038  real(DP), intent(in) :: tled !< reciprocal of time step length
5039  real(DP), intent(in) :: area !< horizontal cell area
5040  real(DP), intent(in) :: hcell !< current head in cell
5041  real(DP), intent(in) :: hcellold !< previous head in cell
5042  real(DP), intent(inout) :: hcof !< no-delay A matrix entry
5043  real(DP), intent(inout) :: rhs !< no-delay right-hand side entry
5044  ! -- local variables
5045  real(DP) :: top
5046  real(DP) :: bot
5047  real(DP) :: f
5048  real(DP) :: wc
5049  real(DP) :: wc0
5050  real(DP) :: satderv
5051  !
5052  ! -- initialize variables
5053  rhs = dzero
5054  hcof = dzero
5055  !
5056  ! -- aquifer elevations and thickness
5057  top = this%dis%top(node)
5058  bot = this%dis%bot(node)
5059  !
5060  !
5061  f = this%brg * area * tled
5062  !
5063  ! -- calculate saturation derivative
5064  satderv = this%csub_calc_sat_derivative(node, hcell)
5065  !
5066  ! -- calculate the current water compressibility factor
5067  wc = f * this%theta(ib) * this%thick(ib)
5068  !
5069  ! -- calculate derivative term
5070  hcof = -wc * hcell * satderv
5071  !
5072  ! -- Add additional term if using lagged effective stress
5073  if (this%ieslag /= 0) then
5074  wc0 = f * this%theta0(ib) * this%thick0(ib)
5075  hcof = hcof + wc0 * hcellold * satderv
5076  end if
5077  !
5078  ! -- set rhs
5079  rhs = hcof * hcell

◆ csub_obs_supported()

logical function gwfcsubmodule::csub_obs_supported ( class(gwfcsubtype this)
private

Function to determine if observations are supported by the CSUB package. Observations are supported by the CSUB package.

Definition at line 6470 of file gwf-csub.f90.

6471  ! -- dummy variables
6472  class(GwfCsubType) :: this
6473  !
6474  ! -- initialize variables
6475  csub_obs_supported = .true.

◆ csub_ot_dv()

subroutine gwfcsubmodule::csub_ot_dv ( class(gwfcsubtype this,
integer(i4b), intent(in)  idvfl,
integer(i4b), intent(in)  idvprint 
)
private

Method saves cell-by-cell compaction and z-displacement terms. The method also calls the method to process observation output.

Parameters
[in]idvflflag to save dependent variable data
[in]idvprintflag to print dependent variable data

Definition at line 3381 of file gwf-csub.f90.

3382  ! -- dummy variables
3383  class(GwfCsubType) :: this
3384  integer(I4B), intent(in) :: idvfl !< flag to save dependent variable data
3385  integer(I4B), intent(in) :: idvprint !< flag to print dependent variable data
3386  ! -- local variables
3387  character(len=1) :: cdatafmp = ' '
3388  character(len=1) :: editdesc = ' '
3389  integer(I4B) :: ibinun
3390  integer(I4B) :: iprint
3391  integer(I4B) :: nvaluesp
3392  integer(I4B) :: nwidthp
3393  integer(I4B) :: ib
3394  integer(I4B) :: node
3395  integer(I4B) :: nodem
3396  integer(I4B) :: nodeu
3397  integer(I4B) :: i
3398  integer(I4B) :: ii
3399  integer(I4B) :: idx_conn
3400  integer(I4B) :: k
3401  integer(I4B) :: ncpl
3402  integer(I4B) :: nlay
3403  integer(I4B) :: ihc
3404  real(DP) :: dinact
3405  real(DP) :: va_scale
3406  ! -- formats
3407  character(len=*), parameter :: fmtnconv = &
3408  "(/4x, 'DELAY INTERBED CELL HEADS IN ', i0, ' INTERBEDS IN', &
3409  &' NON-CONVERTIBLE GWF CELLS WERE LESS THAN THE TOP OF THE INTERBED CELL')"
3410  !
3411  ! -- Save compaction results
3412  !
3413  ! -- Set unit number for binary compaction and z-displacement output
3414  if (this%ioutcomp /= 0 .or. this%ioutzdisp /= 0) then
3415  ibinun = 1
3416  else
3417  ibinun = 0
3418  end if
3419  if (idvfl == 0) ibinun = 0
3420  !
3421  ! -- save compaction results
3422  if (ibinun /= 0) then
3423  iprint = 0
3424  dinact = dhnoflo
3425  !
3426  ! -- fill buff with total compaction
3427  do node = 1, this%dis%nodes
3428  this%buff(node) = this%cg_tcomp(node)
3429  end do
3430  do ib = 1, this%ninterbeds
3431  node = this%nodelist(ib)
3432  this%buff(node) = this%buff(node) + this%tcomp(ib)
3433  end do
3434  !
3435  ! -- write compaction data to binary file
3436  if (this%ioutcomp /= 0) then
3437  ibinun = this%ioutcomp
3438  call this%dis%record_array(this%buff, this%iout, iprint, ibinun, &
3439  comptxt(1), cdatafmp, nvaluesp, &
3440  nwidthp, editdesc, dinact)
3441  end if
3442  !
3443  ! -- calculate z-displacement (subsidence) and write data to binary file
3444  if (this%ioutzdisp /= 0) then
3445  ibinun = this%ioutzdisp
3446  !
3447  ! -- initialize buffusr
3448  do nodeu = 1, this%dis%nodesuser
3449  this%buffusr(nodeu) = dzero
3450  end do
3451  !
3452  ! -- fill buffusr with buff
3453  do node = 1, this%dis%nodes
3454  nodeu = this%dis%get_nodeuser(node)
3455  this%buffusr(nodeu) = this%buff(node)
3456  end do
3457  !
3458  ! -- calculate z-displacement
3459  ncpl = this%dis%get_ncpl()
3460  !
3461  ! -- disu
3462  if (this%dis%ndim == 1) then
3463  do node = this%dis%nodes, 1, -1
3464  do ii = this%dis%con%ia(node) + 1, this%dis%con%ia(node + 1) - 1
3465  !
3466  ! -- Set the m cell number
3467  nodem = this%dis%con%ja(ii)
3468  idx_conn = this%dis%con%jas(ii)
3469  !
3470  ! -- vertical connection
3471  ihc = this%dis%con%ihc(idx_conn)
3472  if (ihc == 0) then
3473  !
3474  ! -- node has an underlying cell
3475  if (node < nodem) then
3476  va_scale = this%dis%get_area_factor(node, idx_conn)
3477  this%buffusr(node) = this%buffusr(node) + &
3478  va_scale * this%buffusr(nodem)
3479  end if
3480  end if
3481  end do
3482  end do
3483  ! -- disv or dis
3484  else
3485  nlay = this%dis%nodesuser / ncpl
3486  do k = nlay - 1, 1, -1
3487  do i = 1, ncpl
3488  node = (k - 1) * ncpl + i
3489  nodem = k * ncpl + i
3490  this%buffusr(node) = this%buffusr(node) + this%buffusr(nodem)
3491  end do
3492  end do
3493  end if
3494  !
3495  ! -- fill buff with data from buffusr
3496  do nodeu = 1, this%dis%nodesuser
3497  node = this%dis%get_nodenumber_idx1(nodeu, 1)
3498  if (node > 0) then
3499  this%buff(node) = this%buffusr(nodeu)
3500  end if
3501  end do
3502  !
3503  ! -- write z-displacement
3504  call this%dis%record_array(this%buff, this%iout, iprint, ibinun, &
3505  comptxt(6), cdatafmp, nvaluesp, &
3506  nwidthp, editdesc, dinact)
3507 
3508  end if
3509  end if
3510  !
3511  ! -- Set unit number for binary inelastic interbed compaction
3512  if (this%ioutcompi /= 0) then
3513  ibinun = this%ioutcompi
3514  else
3515  ibinun = 0
3516  end if
3517  if (idvfl == 0) ibinun = 0
3518  !
3519  ! -- save inelastic interbed compaction results
3520  if (ibinun /= 0) then
3521  iprint = 0
3522  dinact = dhnoflo
3523  !
3524  ! -- fill buff with inelastic interbed compaction
3525  do node = 1, this%dis%nodes
3526  this%buff(node) = dzero
3527  end do
3528  do ib = 1, this%ninterbeds
3529  node = this%nodelist(ib)
3530  this%buff(node) = this%buff(node) + this%tcompi(ib)
3531  end do
3532  !
3533  ! -- write inelastic interbed compaction data to binary file
3534  call this%dis%record_array(this%buff, this%iout, iprint, ibinun, &
3535  comptxt(2), cdatafmp, nvaluesp, &
3536  nwidthp, editdesc, dinact)
3537  end if
3538  !
3539  ! -- Set unit number for binary elastic interbed compaction
3540  if (this%ioutcompe /= 0) then
3541  ibinun = this%ioutcompe
3542  else
3543  ibinun = 0
3544  end if
3545  if (idvfl == 0) ibinun = 0
3546  !
3547  ! -- save elastic interbed compaction results
3548  if (ibinun /= 0) then
3549  iprint = 0
3550  dinact = dhnoflo
3551  !
3552  ! -- fill buff with elastic interbed compaction
3553  do node = 1, this%dis%nodes
3554  this%buff(node) = dzero
3555  end do
3556  do ib = 1, this%ninterbeds
3557  node = this%nodelist(ib)
3558  this%buff(node) = this%buff(node) + this%tcompe(ib)
3559  end do
3560  !
3561  ! -- write elastic interbed compaction data to binary file
3562  call this%dis%record_array(this%buff, this%iout, iprint, ibinun, &
3563  comptxt(3), cdatafmp, nvaluesp, &
3564  nwidthp, editdesc, dinact)
3565  end if
3566  !
3567  ! -- Set unit number for binary interbed compaction
3568  if (this%ioutcompib /= 0) then
3569  ibinun = this%ioutcompib
3570  else
3571  ibinun = 0
3572  end if
3573  if (idvfl == 0) ibinun = 0
3574  !
3575  ! -- save interbed compaction results
3576  if (ibinun /= 0) then
3577  iprint = 0
3578  dinact = dhnoflo
3579  !
3580  ! -- fill buff with interbed compaction
3581  do node = 1, this%dis%nodes
3582  this%buff(node) = dzero
3583  end do
3584  do ib = 1, this%ninterbeds
3585  node = this%nodelist(ib)
3586  this%buff(node) = this%buff(node) + this%tcompe(ib) + this%tcompi(ib)
3587  end do
3588  !
3589  ! -- write interbed compaction data to binary file
3590  call this%dis%record_array(this%buff, this%iout, iprint, ibinun, &
3591  comptxt(4), cdatafmp, nvaluesp, &
3592  nwidthp, editdesc, dinact)
3593  end if
3594  !
3595  ! -- Set unit number for binary coarse-grained compaction
3596  if (this%ioutcomps /= 0) then
3597  ibinun = this%ioutcomps
3598  else
3599  ibinun = 0
3600  end if
3601  if (idvfl == 0) ibinun = 0
3602  !
3603  ! -- save coarse-grained compaction results
3604  if (ibinun /= 0) then
3605  iprint = 0
3606  dinact = dhnoflo
3607  !
3608  ! -- fill buff with coarse-grained compaction
3609  do node = 1, this%dis%nodes
3610  this%buff(node) = this%cg_tcomp(node)
3611  end do
3612  !
3613  ! -- write coarse-grained compaction data to binary file
3614  call this%dis%record_array(this%buff, this%iout, iprint, ibinun, &
3615  comptxt(5), cdatafmp, nvaluesp, &
3616  nwidthp, editdesc, dinact)
3617  end if
3618  !
3619  ! -- check that final effective stress values for the time step
3620  ! are greater than zero
3621  if (this%gwfiss == 0) then
3622  call this%csub_cg_chk_stress()
3623  end if
3624  !
3625  ! -- update maximum count of delay interbeds that violate
3626  ! basic head assumptions for delay beds and write a message
3627  ! for delay interbeds in non-convertible gwf cells that
3628  ! violate these head assumptions
3629  if (this%ndelaybeds > 0) then
3630  if (this%idb_nconv_count(1) > this%idb_nconv_count(2)) then
3631  this%idb_nconv_count(2) = this%idb_nconv_count(1)
3632  end if
3633  if (this%idb_nconv_count(1) > 0) then
3634  write (this%iout, fmtnconv) this%idb_nconv_count(1)
3635  end if
3636  end if

◆ csub_print_packagedata()

subroutine gwfcsubmodule::csub_print_packagedata ( class(gwfcsubtype this)

Definition at line 1541 of file gwf-csub.f90.

1542  class(GwfCsubType) :: this
1543  ! local
1544  character(len=LINELENGTH) :: title
1545  character(len=LINELENGTH) :: tag
1546  character(len=10) :: ctype
1547  character(len=20) :: cellid
1548  integer(I4B) :: ntabrows
1549  integer(I4B) :: ntabcols
1550  integer(I4B) :: ib
1551  integer(I4b) :: idelay
1552  integer(I4B) :: node
1553 
1554  ! set title
1555  title = 'CSUB'//' PACKAGE ('// &
1556  trim(adjustl(this%packName))//') INTERBED DATA'
1557  !
1558  ! determine the number of columns and rows
1559  ntabrows = this%ninterbeds
1560  ntabcols = 13
1561  if (this%inamedbound /= 0) then
1562  ntabcols = ntabcols + 1
1563  end if
1564 
1565  ! setup table
1566  call table_cr(this%inputtab, this%packName, title)
1567  call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
1568  !
1569  ! add columns
1570  !<icsubno> <cellid> <cdelay> <pcs0> <thick_frac> <rnb> <ssv_cc> <sse_cr> <theta> <kv> <h0> [<boundname>]
1571 
1572  tag = 'INTERBED NUMBER'
1573  call this%inputtab%initialize_column(tag, 10, alignment=tabcenter)
1574  tag = 'CELLID'
1575  call this%inputtab%initialize_column(tag, 20, alignment=tableft)
1576  tag = 'INTERBED TYPE'
1577  call this%inputtab%initialize_column(tag, 10, alignment=tabcenter)
1578  tag = 'PCS0'
1579  call this%inputtab%initialize_column(tag, 12, alignment=tabcenter)
1580  tag = 'THICK_FRAC'
1581  call this%inputtab%initialize_column(tag, 12, alignment=tabcenter)
1582  tag = 'RNB'
1583  call this%inputtab%initialize_column(tag, 12, alignment=tabcenter)
1584  tag = 'INTERBED THICKNESS'
1585  call this%inputtab%initialize_column(tag, 12, alignment=tabcenter)
1586  tag = 'CELL THICKNESS'
1587  call this%inputtab%initialize_column(tag, 12, alignment=tabcenter)
1588  tag = 'SSV_CV'
1589  call this%inputtab%initialize_column(tag, 12, alignment=tabcenter)
1590  tag = 'SSE_CR'
1591  call this%inputtab%initialize_column(tag, 12, alignment=tabcenter)
1592  tag = 'THETA'
1593  call this%inputtab%initialize_column(tag, 12, alignment=tabcenter)
1594  tag = 'KV'
1595  call this%inputtab%initialize_column(tag, 12, alignment=tabcenter)
1596  tag = 'H0'
1597  call this%inputtab%initialize_column(tag, 12, alignment=tabcenter)
1598  if (this%inamedbound /= 0) then
1599  tag = 'BOUNDNAME'
1600  call this%inputtab%initialize_column(tag, 40, alignment=tableft)
1601  end if
1602 
1603  do ib = 1, this%ninterbeds
1604  idelay = this%idelay(ib)
1605  node = this%nodelist(ib)
1606  call this%dis%noder_to_string(node, cellid)
1607  if (idelay == 0) then
1608  ctype = 'nodelay'
1609  else
1610  ctype = 'delay'
1611  end if
1612 
1613  ! fill table line
1614  call this%inputtab%add_term(ib)
1615  call this%inputtab%add_term(cellid)
1616  call this%inputtab%add_term(ctype)
1617  call this%inputtab%add_term(this%pcs(ib))
1618  call this%inputtab%add_term(this%thickini(ib))
1619  call this%inputtab%add_term(this%rnb(ib))
1620  call this%inputtab%add_term(this%thickini(ib) * this%rnb(ib))
1621  call this%inputtab%add_term(this%dis%top(node) - this%dis%bot(node))
1622  call this%inputtab%add_term(this%ci(ib))
1623  call this%inputtab%add_term(this%rci(ib))
1624  call this%inputtab%add_term(this%theta(ib))
1625  if (idelay == 0) then
1626  call this%inputtab%add_term("--")
1627  call this%inputtab%add_term("--")
1628  else
1629  call this%inputtab%add_term(this%kv(ib))
1630  call this%inputtab%add_term(this%h0(ib))
1631  end if
1632  if (this%inamedbound /= 0) then
1633  call this%inputtab%add_term(this%boundname(ib))
1634  end if
1635  end do
1636 
Here is the call graph for this function:

◆ csub_process_obsid()

subroutine gwfcsubmodule::csub_process_obsid ( type(observetype), intent(inout)  obsrv,
class(disbasetype), intent(in)  dis,
integer(i4b), intent(in)  inunitobs,
integer(i4b), intent(in)  iout 
)

Method to process the observation IDs for the CSUB package. This procedure is pointed to by ObsDataTypeProcesssIdPtr. It processes the ID string of an observation definition for csub-package observations.

Parameters
[in,out]obsrvobservation type
[in]dispointer to the model discretization
[in]inunitobsunit number of the observation file
[in]ioutunit number to the model listing file

Definition at line 7072 of file gwf-csub.f90.

7073  ! -- dummy variables
7074  type(ObserveType), intent(inout) :: obsrv !< observation type
7075  class(DisBaseType), intent(in) :: dis !< pointer to the model discretization
7076  integer(I4B), intent(in) :: inunitobs !< unit number of the observation file
7077  integer(I4B), intent(in) :: iout !< unit number to the model listing file
7078  ! -- local variables
7079  integer(I4B) :: nn1
7080  integer(I4B) :: nn2
7081  integer(I4B) :: icol, istart, istop
7082  character(len=LINELENGTH) :: string
7083  character(len=LENBOUNDNAME) :: bndname
7084  logical(LGP) :: flag_string
7085  logical(LGP) :: flag_idcellno
7086  logical(LGP) :: flag_error
7087  !
7088  ! -- initialize variables
7089  string = obsrv%IDstring
7090  flag_string = .true.
7091  flag_idcellno = .false.
7092  flag_error = .false.
7093  if (obsrv%ObsTypeId(1:5) == "DELAY" .AND. &
7094  obsrv%ObsTypeId(1:10) /= "DELAY-FLOW") then
7095  flag_idcellno = .true.
7096  end if
7097  !
7098  ! -- Extract reach number from string and store it.
7099  ! If 1st item is not an integer(I4B), it should be a
7100  ! boundary name--deal with it.
7101  icol = 1
7102  !
7103  ! -- get icsubno number or boundary name
7104  if (obsrv%ObsTypeId == 'CSUB' .or. &
7105  obsrv%ObsTypeId == 'INELASTIC-CSUB' .or. &
7106  obsrv%ObsTypeId == 'ELASTIC-CSUB' .or. &
7107  obsrv%ObsTypeId == 'SK' .or. &
7108  obsrv%ObsTypeId == 'SKE' .or. &
7109  obsrv%ObsTypeId == 'THETA' .or. &
7110  obsrv%ObsTypeId == 'THICKNESS' .or. &
7111  obsrv%ObsTypeId == 'INTERBED-COMPACTION' .or. &
7112  obsrv%ObsTypeId == 'INTERBED-COMPACTION-PCT' .or. &
7113  obsrv%ObsTypeId == 'INELASTIC-COMPACTION' .or. &
7114  obsrv%ObsTypeId == 'ELASTIC-COMPACTION' .or. &
7115  obsrv%ObsTypeId == 'DELAY-HEAD' .or. &
7116  obsrv%ObsTypeId == 'DELAY-GSTRESS' .or. &
7117  obsrv%ObsTypeId == 'DELAY-ESTRESS' .or. &
7118  obsrv%ObsTypeId == 'DELAY-PRECONSTRESS' .or. &
7119  obsrv%ObsTypeId == 'DELAY-COMPACTION' .or. &
7120  obsrv%ObsTypeId == 'DELAY-THICKNESS' .or. &
7121  obsrv%ObsTypeId == 'DELAY-THETA' .or. &
7122  obsrv%ObsTypeId == 'DELAY-FLOWTOP' .or. &
7123  obsrv%ObsTypeId == 'DELAY-FLOWBOT') then
7124  call extract_idnum_or_bndname(string, icol, istart, istop, nn1, bndname)
7125  ! read cellid
7126  else
7127  nn1 = dis%noder_from_string(icol, istart, istop, inunitobs, &
7128  iout, string, flag_string)
7129  end if
7130  ! boundnames are not allowed for these observation types
7131  if (obsrv%ObsTypeId == 'SK' .or. &
7132  obsrv%ObsTypeId == 'SKE' .or. &
7133  obsrv%ObsTypeId == 'THETA' .or. &
7134  obsrv%ObsTypeId == 'THICKNESS' .or. &
7135  obsrv%ObsTypeId == 'INTERBED-COMPACTION' .or. &
7136  obsrv%ObsTypeId == 'INELASTIC-COMPACTION' .or. &
7137  obsrv%ObsTypeId == 'ELASTIC-COMPACTION' .or. &
7138  obsrv%ObsTypeId == 'DELAY-HEAD' .or. &
7139  obsrv%ObsTypeId == 'DELAY-GSTRESS' .or. &
7140  obsrv%ObsTypeId == 'DELAY-ESTRESS' .or. &
7141  obsrv%ObsTypeId == 'DELAY-PRECONSTRESS' .or. &
7142  obsrv%ObsTypeId == 'DELAY-COMPACTION' .or. &
7143  obsrv%ObsTypeId == 'DELAY-THICKNESS' .or. &
7144  obsrv%ObsTypeId == 'DELAY-THETA') then
7145  if (nn1 == namedboundflag) then
7146  write (errmsg, '(5a)') &
7147  "BOUNDNAME ('", trim(adjustl(bndname)), &
7148  "') not allowed for CSUB observation type '", &
7149  trim(adjustl(obsrv%ObsTypeId)), "'."
7150  call store_error(errmsg)
7151  flag_error = .true.
7152  end if
7153  ! boundnames are allowed for these observation types
7154  else if (obsrv%ObsTypeId == 'CSUB' .or. &
7155  obsrv%ObsTypeId == 'INELASTIC-CSUB' .or. &
7156  obsrv%ObsTypeId == 'ELASTIC-CSUB' .or. &
7157  ! obsrv%ObsTypeId == 'INTERBED-COMPACTION' .or. &
7158  ! obsrv%ObsTypeId == 'INELASTIC-COMPACTION' .or. &
7159  ! obsrv%ObsTypeId == 'ELASTIC-COMPACTION' .or. &
7160  obsrv%ObsTypeId == 'DELAY-FLOWTOP' .or. &
7161  obsrv%ObsTypeId == 'DELAY-FLOWBOT') then
7162  if (nn1 == namedboundflag) then
7163  obsrv%FeatureName = bndname
7164  end if
7165  end if
7166  ! read idcellno for delay observations
7167  if (flag_idcellno .EQV. .true. .AND. flag_error .EQV. .false.) then
7168  if (nn1 /= namedboundflag) then
7169  call extract_idnum_or_bndname(string, icol, istart, istop, nn2, bndname)
7170  if (nn2 == namedboundflag) then
7171  write (errmsg, '(5a)') &
7172  "BOUNDNAME ('", trim(adjustl(bndname)), &
7173  "') not allowed for CSUB observation type '", &
7174  trim(adjustl(obsrv%ObsTypeId)), "' idcellno."
7175  call store_error(errmsg)
7176  else
7177  obsrv%NodeNumber2 = nn2
7178  end if
7179  end if
7180  end if
7181  !
7182  ! -- store reach number (NodeNumber)
7183  obsrv%NodeNumber = nn1
Here is the call graph for this function:
Here is the caller graph for this function:

◆ csub_rp()

subroutine gwfcsubmodule::csub_rp ( class(gwfcsubtype), intent(inout)  this)

Method reads and prepares stress period data for the CSUB package. The overlying geostatic stress (sig0) is the only stress period data read by the CSUB package.

Definition at line 2272 of file gwf-csub.f90.

2273  ! -- modules
2274  use tdismodule, only: kper
2275  use constantsmodule, only: linelength
2276  use memorymanagermodule, only: mem_setptr
2278  ! -- dummy variables
2279  class(GwfCsubType), intent(inout) :: this
2280  ! -- local variables
2281  integer(I4B), dimension(:, :), pointer, contiguous :: cellids
2282  integer(I4B), dimension(:), pointer, contiguous :: cellid
2283  integer(I4B), pointer :: iper
2284  integer(I4B) :: n, nodeu, noder
2285  character(len=LINELENGTH) :: title, text
2286  character(len=20) :: cellstr
2287  logical(LGP) :: found
2288  ! -- formats
2289  character(len=*), parameter :: fmtlsp = &
2290  &"(1X,/1X,'REUSING ',a,'S FROM LAST STRESS PERIOD')"
2291 
2292  call mem_setptr(iper, 'IPER', this%input_mempath)
2293  if (iper /= kper) then
2294  write (this%iout, fmtlsp) trim(this%filtyp)
2295  call this%csub_rp_obs()
2296  return
2297  end if
2298 
2299  call mem_setptr(cellids, 'CELLID', this%input_mempath)
2300  call mem_set_value(this%nbound, 'NBOUND', this%input_mempath, &
2301  found)
2302 
2303  ! -- setup table for period data
2304  if (this%iprpak /= 0) then
2305  ! -- reset the input table object
2306  title = 'CSUB'//' PACKAGE ('// &
2307  trim(adjustl(this%packName))//') DATA FOR PERIOD'
2308  write (title, '(a,1x,i6)') trim(adjustl(title)), kper
2309  call table_cr(this%inputtab, this%packName, title)
2310  call this%inputtab%table_df(1, 2, this%iout, finalize=.false.)
2311  text = 'CELLID'
2312  call this%inputtab%initialize_column(text, 20)
2313  text = 'SIG0'
2314  call this%inputtab%initialize_column(text, 15, alignment=tableft)
2315  end if
2316 
2317  ! -- update nodelist
2318  do n = 1, this%nbound
2319 
2320  ! -- set cellid
2321  cellid => cellids(:, n)
2322 
2323  ! -- set user node number
2324  if (this%dis%ndim == 1) then
2325  nodeu = cellid(1)
2326  elseif (this%dis%ndim == 2) then
2327  nodeu = get_node(cellid(1), 1, cellid(2), &
2328  this%dis%mshape(1), 1, &
2329  this%dis%mshape(2))
2330  else
2331  nodeu = get_node(cellid(1), cellid(2), cellid(3), &
2332  this%dis%mshape(1), &
2333  this%dis%mshape(2), &
2334  this%dis%mshape(3))
2335  end if
2336 
2337  ! -- set noder
2338  noder = this%dis%get_nodenumber(nodeu, 1)
2339  if (noder <= 0) then
2340  cycle
2341  end if
2342 
2343  this%nodelistsig0(n) = noder
2344 
2345  ! -- write line to table
2346  if (this%iprpak /= 0) then
2347  call this%dis%noder_to_string(noder, cellstr)
2348  call this%inputtab%add_term(cellstr)
2349  call this%inputtab%add_term(this%sig0(n))
2350  end if
2351  end do
2352  !
2353  ! -- terminate if errors encountered
2354  if (count_errors() > 0) then
2355  call store_error_filename(this%input_fname)
2356  end if
2357  !
2358  ! -- finalize the table
2359  if (this%iprpak /= 0) then
2360  call this%inputtab%finalize_table()
2361  end if
2362  !
2363  ! -- read observations
2364  call this%csub_rp_obs()
Here is the call graph for this function:

◆ csub_rp_obs()

subroutine gwfcsubmodule::csub_rp_obs ( class(gwfcsubtype), intent(inout)  this)
private

Method to read and prepare the observations for the CSUB package.

Definition at line 6900 of file gwf-csub.f90.

6901  ! -- modules
6902  use tdismodule, only: kper
6903  ! -- dummy variables
6904  class(GwfCsubType), intent(inout) :: this
6905  ! -- local variables
6906  class(ObserveType), pointer :: obsrv => null()
6907  character(len=LENBOUNDNAME) :: bname
6908  integer(I4B) :: i
6909  integer(I4B) :: j
6910  integer(I4B) :: n
6911  integer(I4B) :: n2
6912  integer(I4B) :: idelay
6913  !
6914  ! -- return if observations are not supported
6915  if (.not. this%csub_obs_supported()) then
6916  return
6917  end if
6918  !
6919  ! -- process each package observation
6920  ! only done the first stress period since boundaries are fixed
6921  ! for the simulation
6922  if (kper == 1) then
6923  do i = 1, this%obs%npakobs
6924  obsrv => this%obs%pakobs(i)%obsrv
6925  !
6926  ! -- initialize BndFound to .false.
6927  obsrv%BndFound = .false.
6928  !
6929  bname = obsrv%FeatureName
6930  if (bname /= '') then
6931  !
6932  ! -- Observation location(s) is(are) based on a boundary name.
6933  ! Iterate through all boundaries to identify and store
6934  ! corresponding index(indices) in bound array.
6935  do j = 1, this%ninterbeds
6936  if (this%boundname(j) == bname) then
6937  obsrv%BndFound = .true.
6938  obsrv%CurrentTimeStepEndValue = dzero
6939  call obsrv%AddObsIndex(j)
6940  end if
6941  end do
6942  !
6943  ! -- one value per cell
6944  else if (obsrv%ObsTypeId == 'GSTRESS-CELL' .or. &
6945  obsrv%ObsTypeId == 'ESTRESS-CELL' .or. &
6946  obsrv%ObsTypeId == 'THICKNESS-CELL' .or. &
6947  obsrv%ObsTypeId == 'COARSE-CSUB' .or. &
6948  obsrv%ObsTypeId == 'WCOMP-CSUB-CELL' .or. &
6949  obsrv%ObsTypeId == 'COARSE-COMPACTION' .or. &
6950  obsrv%ObsTypeId == 'COARSE-THETA' .or. &
6951  obsrv%ObsTypeId == 'COARSE-THICKNESS') then
6952  obsrv%BndFound = .true.
6953  obsrv%CurrentTimeStepEndValue = dzero
6954  call obsrv%AddObsIndex(obsrv%NodeNumber)
6955  else if (obsrv%ObsTypeId == 'DELAY-PRECONSTRESS' .or. &
6956  obsrv%ObsTypeId == 'DELAY-HEAD' .or. &
6957  obsrv%ObsTypeId == 'DELAY-GSTRESS' .or. &
6958  obsrv%ObsTypeId == 'DELAY-ESTRESS' .or. &
6959  obsrv%ObsTypeId == 'DELAY-COMPACTION' .or. &
6960  obsrv%ObsTypeId == 'DELAY-THICKNESS' .or. &
6961  obsrv%ObsTypeId == 'DELAY-THETA') then
6962  if (this%ninterbeds > 0) then
6963  n = obsrv%NodeNumber
6964  idelay = this%idelay(n)
6965  if (idelay /= 0) then
6966  j = (idelay - 1) * this%ndelaycells + 1
6967  n2 = obsrv%NodeNumber2
6968  if (n2 < 1 .or. n2 > this%ndelaycells) then
6969  write (errmsg, '(a,2(1x,a),1x,i0,1x,a,i0,a)') &
6970  trim(adjustl(obsrv%ObsTypeId)), 'interbed cell must be ', &
6971  'greater than 0 and less than or equal to', this%ndelaycells, &
6972  '(specified value is ', n2, ').'
6973  call store_error(errmsg)
6974  else
6975  j = (idelay - 1) * this%ndelaycells + n2
6976  end if
6977  obsrv%BndFound = .true.
6978  call obsrv%AddObsIndex(j)
6979  end if
6980  end if
6981  !
6982  ! -- interbed value
6983  else if (obsrv%ObsTypeId == 'CSUB' .or. &
6984  obsrv%ObsTypeId == 'INELASTIC-CSUB' .or. &
6985  obsrv%ObsTypeId == 'ELASTIC-CSUB' .or. &
6986  obsrv%ObsTypeId == 'SK' .or. &
6987  obsrv%ObsTypeId == 'SKE' .or. &
6988  obsrv%ObsTypeId == 'THICKNESS' .or. &
6989  obsrv%ObsTypeId == 'THETA' .or. &
6990  obsrv%ObsTypeId == 'INTERBED-COMPACTION' .or. &
6991  obsrv%ObsTypeId == 'INELASTIC-COMPACTION' .or. &
6992  obsrv%ObsTypeId == 'ELASTIC-COMPACTION' .or. &
6993  obsrv%ObsTypeId == 'INTERBED-COMPACTION-PCT') then
6994  if (this%ninterbeds > 0) then
6995  j = obsrv%NodeNumber
6996  if (j < 1 .or. j > this%ninterbeds) then
6997  write (errmsg, '(a,2(1x,a),1x,i0,1x,a,i0,a)') &
6998  trim(adjustl(obsrv%ObsTypeId)), 'interbed cell must be greater', &
6999  'than 0 and less than or equal to', this%ninterbeds, &
7000  '(specified value is ', j, ').'
7001  call store_error(errmsg)
7002  else
7003  obsrv%BndFound = .true.
7004  obsrv%CurrentTimeStepEndValue = dzero
7005  call obsrv%AddObsIndex(j)
7006  end if
7007  end if
7008  else if (obsrv%ObsTypeId == 'DELAY-FLOWTOP' .or. &
7009  obsrv%ObsTypeId == 'DELAY-FLOWBOT') then
7010  if (this%ninterbeds > 0) then
7011  j = obsrv%NodeNumber
7012  if (j < 1 .or. j > this%ninterbeds) then
7013  write (errmsg, '(a,2(1x,a),1x,i0,1x,a,i0,a)') &
7014  trim(adjustl(obsrv%ObsTypeId)), &
7015  'interbed cell must be greater ', &
7016  'than 0 and less than or equal to', this%ninterbeds, &
7017  '(specified value is ', j, ').'
7018  call store_error(errmsg)
7019  end if
7020  idelay = this%idelay(j)
7021  if (idelay /= 0) then
7022  obsrv%BndFound = .true.
7023  obsrv%CurrentTimeStepEndValue = dzero
7024  call obsrv%AddObsIndex(j)
7025  end if
7026  end if
7027  else
7028  !
7029  ! -- Accumulate values in a single cell
7030  ! -- Observation location is a single node number
7031  ! -- save node number in first position
7032  if (obsrv%ObsTypeId == 'CSUB-CELL' .or. &
7033  obsrv%ObsTypeId == 'SKE-CELL' .or. &
7034  obsrv%ObsTypeId == 'SK-CELL' .or. &
7035  obsrv%ObsTypeId == 'THETA-CELL' .or. &
7036  obsrv%ObsTypeId == 'INELASTIC-COMPACTION-CELL' .or. &
7037  obsrv%ObsTypeId == 'ELASTIC-COMPACTION-CELL' .or. &
7038  obsrv%ObsTypeId == 'COMPACTION-CELL') then
7039  if (.NOT. obsrv%BndFound) then
7040  obsrv%BndFound = .true.
7041  obsrv%CurrentTimeStepEndValue = dzero
7042  call obsrv%AddObsIndex(obsrv%NodeNumber)
7043  end if
7044  end if
7045  jloop: do j = 1, this%ninterbeds
7046  if (this%nodelist(j) == obsrv%NodeNumber) then
7047  obsrv%BndFound = .true.
7048  obsrv%CurrentTimeStepEndValue = dzero
7049  call obsrv%AddObsIndex(j)
7050  end if
7051  end do jloop
7052  end if
7053  end do
7054  !
7055  ! -- evaluate if there are any observation errors
7056  if (count_errors() > 0) then
7057  call store_error_filename(this%input_fname)
7058  end if
7059  end if
Here is the call graph for this function:

◆ csub_save_model_flows()

subroutine gwfcsubmodule::csub_save_model_flows ( class(gwfcsubtype this,
integer(i4b), intent(in)  icbcfl,
integer(i4b), intent(in)  icbcun 
)

Save cell-by-cell budget terms for the CSUB package.

Parameters
[in]icbcflflag to output budget data
[in]icbcununit number for cell-by-cell file

Definition at line 3290 of file gwf-csub.f90.

3291  ! -- dummy variables
3292  class(GwfCsubType) :: this
3293  integer(I4B), intent(in) :: icbcfl !< flag to output budget data
3294  integer(I4B), intent(in) :: icbcun !< unit number for cell-by-cell file
3295  ! -- local variables
3296  character(len=1) :: cdatafmp = ' '
3297  character(len=1) :: editdesc = ' '
3298  integer(I4B) :: ibinun
3299  integer(I4B) :: iprint
3300  integer(I4B) :: nvaluesp
3301  integer(I4B) :: nwidthp
3302  integer(I4B) :: ib
3303  integer(I4B) :: node
3304  integer(I4B) :: naux
3305  real(DP) :: dinact
3306  real(DP) :: Q
3307  ! -- formats
3308  !
3309  ! -- Set unit number for binary output
3310  if (this%ipakcb < 0) then
3311  ibinun = icbcun
3312  elseif (this%ipakcb == 0) then
3313  ibinun = 0
3314  else
3315  ibinun = this%ipakcb
3316  end if
3317  if (icbcfl == 0) ibinun = 0
3318  !
3319  ! -- Record the storage rates if requested
3320  if (ibinun /= 0) then
3321  iprint = 0
3322  dinact = dzero
3323  !
3324  ! -- coarse-grained storage (sske)
3325  call this%dis%record_array(this%cg_stor, this%iout, iprint, -ibinun, &
3326  budtxt(1), cdatafmp, nvaluesp, &
3327  nwidthp, editdesc, dinact)
3328  if (this%ninterbeds > 0) then
3329  naux = 0
3330  !
3331  ! -- interbed elastic storage
3332  call this%dis%record_srcdst_list_header(budtxt(2), &
3333  this%name_model, &
3334  this%name_model, &
3335  this%name_model, &
3336  this%packName, &
3337  naux, &
3338  this%auxname, &
3339  ibinun, &
3340  this%ninterbeds, &
3341  this%iout)
3342  do ib = 1, this%ninterbeds
3343  q = this%storagee(ib)
3344  node = this%nodelist(ib)
3345  call this%dis%record_mf6_list_entry(ibinun, node, node, q, naux, &
3346  this%auxvar(:, ib))
3347  end do
3348  !
3349  ! -- interbed inelastic storage
3350  call this%dis%record_srcdst_list_header(budtxt(3), &
3351  this%name_model, &
3352  this%name_model, &
3353  this%name_model, &
3354  this%packName, &
3355  naux, &
3356  this%auxname, &
3357  ibinun, &
3358  this%ninterbeds, &
3359  this%iout)
3360  do ib = 1, this%ninterbeds
3361  q = this%storagei(ib)
3362  node = this%nodelist(ib)
3363  call this%dis%record_mf6_list_entry(ibinun, node, node, q, naux, &
3364  this%auxvar(:, ib))
3365  end do
3366  end if
3367  !
3368  ! -- water compressibility
3369  call this%dis%record_array(this%cell_wcstor, this%iout, iprint, -ibinun, &
3370  budtxt(4), cdatafmp, nvaluesp, &
3371  nwidthp, editdesc, dinact)
3372  end if

◆ csub_set_initial_state()

subroutine gwfcsubmodule::csub_set_initial_state ( class(gwfcsubtype this,
integer(i4b), intent(in)  nodes,
real(dp), dimension(nodes), intent(in)  hnew 
)
private

Method sets the initial states for coarse-grained materials and fine- grained sediments in the interbeds.

Parameters
[in]nodesnumber of active model nodes
[in]hnewcurrent heads

Definition at line 4033 of file gwf-csub.f90.

4034  ! -- dummy variables
4035  class(GwfCsubType) :: this
4036  ! -- dummy variables
4037  integer(I4B), intent(in) :: nodes !< number of active model nodes
4038  real(DP), dimension(nodes), intent(in) :: hnew !< current heads
4039  ! -- local variables
4040  character(len=LINELENGTH) :: title
4041  character(len=LINELENGTH) :: tag
4042  character(len=20) :: cellid
4043  integer(I4B) :: ib
4044  integer(I4B) :: node
4045  integer(I4B) :: n
4046  integer(I4B) :: idelay
4047  integer(I4B) :: ntabrows
4048  integer(I4B) :: ntabcols
4049  real(DP) :: pcs0
4050  real(DP) :: pcs
4051  real(DP) :: fact
4052  real(DP) :: top
4053  real(DP) :: bot
4054  real(DP) :: void_ratio
4055  real(DP) :: es
4056  real(DP) :: znode
4057  real(DP) :: hcell
4058  real(DP) :: hbar
4059  real(DP) :: dzhalf
4060  real(DP) :: zbot
4061  real(DP) :: dbpcs
4062  !
4063  ! -- update geostatic load calculation
4064  call this%csub_cg_calc_stress(nodes, hnew)
4065  !
4066  ! -- initialize coarse-grained material effective stress
4067  ! for the previous time step and the previous iteration
4068  do node = 1, nodes
4069  this%cg_es0(node) = this%cg_es(node)
4070  end do
4071  !
4072  ! -- initialize interbed initial states
4073  do ib = 1, this%ninterbeds
4074  idelay = this%idelay(ib)
4075  node = this%nodelist(ib)
4076  top = this%dis%top(node)
4077  bot = this%dis%bot(node)
4078  hcell = hnew(node)
4079  pcs = this%pcs(ib)
4080  pcs0 = pcs
4081  if (this%ispecified_pcs == 0) then
4082  ! relative pcs...subtract head (u) from sigma'
4083  if (this%ipch /= 0) then
4084  pcs = this%cg_es(node) - pcs0
4085  else
4086  pcs = this%cg_es(node) + pcs0
4087  end if
4088  else
4089  ! specified pcs...subtract head (u) from sigma
4090  if (this%ipch /= 0) then
4091  pcs = this%cg_gs(node) - (pcs0 - bot)
4092  end if
4093  if (pcs < this%cg_es(node)) then
4094  pcs = this%cg_es(node)
4095  end if
4096  end if
4097  this%pcs(ib) = pcs
4098  !
4099  ! -- delay bed initial states
4100  if (idelay /= 0) then
4101  dzhalf = dhalf * this%dbdzini(1, idelay)
4102  !
4103  ! -- fill delay bed head with aquifer head or offset from aquifer head
4104  ! heads need to be filled first since used to calculate
4105  ! the effective stress for each delay bed
4106  do n = 1, this%ndelaycells
4107  if (this%ispecified_dbh == 0) then
4108  this%dbh(n, idelay) = hcell + this%dbh(n, idelay)
4109  else
4110  this%dbh(n, idelay) = hcell
4111  end if
4112  this%dbh0(n, idelay) = this%dbh(n, idelay)
4113  end do
4114  !
4115  ! -- fill delay bed effective stress
4116  call this%csub_delay_calc_stress(ib, hcell)
4117  !
4118  ! -- fill delay bed pcs
4119  pcs = this%pcs(ib)
4120  do n = 1, this%ndelaycells
4121  zbot = this%dbz(n, idelay) - dzhalf
4122  ! -- adjust pcs to bottom of each delay bed cell
4123  ! not using csub_calc_adjes() since smoothing not required
4124  dbpcs = pcs - (zbot - bot) * (this%sgs(node) - done)
4125  this%dbpcs(n, idelay) = dbpcs
4126  !
4127  ! -- initialize effective stress for previous time step
4128  this%dbes0(n, idelay) = this%dbes(n, idelay)
4129  end do
4130  end if
4131  end do
4132  !
4133  ! -- scale coarse-grained materials cr
4134  do node = 1, nodes
4135  top = this%dis%top(node)
4136  bot = this%dis%bot(node)
4137  !
4138  ! -- user-specified specific storage
4139  if (this%istoragec == 1) then
4140  !
4141  ! -- retain specific storage values since they are constant
4142  if (this%lhead_based .EQV. .true.) then
4143  fact = done
4144  !
4145  ! -- convert specific storage values since they are simulated to
4146  ! be a function of the average effective stress
4147  else
4148  void_ratio = this%csub_calc_void_ratio(this%cg_theta(node))
4149  es = this%cg_es(node)
4150  hcell = hnew(node)
4151  !
4152  ! -- calculate corrected head (hbar)
4153  hbar = squadratic0sp(hcell, bot, this%satomega)
4154  !
4155  ! -- calculate znode and factor
4156  znode = this%csub_calc_znode(top, bot, hbar)
4157  fact = this%csub_calc_adjes(node, es, bot, znode)
4158  fact = fact * (done + void_ratio)
4159  end if
4160  !
4161  ! -- user-specified compression indices - multiply by dlog10es
4162  else
4163  fact = dlog10es
4164  end if
4165  this%cg_ske_cr(node) = this%cg_ske_cr(node) * fact
4166  !
4167  ! -- write error message if negative compression indices
4168  if (fact <= dzero) then
4169  call this%dis%noder_to_string(node, cellid)
4170  write (errmsg, '(a,1x,a,a)') &
4171  'Negative recompression index calculated for cell', &
4172  trim(adjustl(cellid)), '.'
4173  call store_error(errmsg)
4174  end if
4175  end do
4176  !
4177  ! -- scale interbed cc and cr
4178  do ib = 1, this%ninterbeds
4179  idelay = this%idelay(ib)
4180  node = this%nodelist(ib)
4181  top = this%dis%top(node)
4182  bot = this%dis%bot(node)
4183  !
4184  ! -- user-specified specific storage
4185  if (this%istoragec == 1) then
4186  !
4187  ! -- retain specific storage values since they are constant
4188  if (this%lhead_based .EQV. .true.) then
4189  fact = done
4190  !
4191  ! -- convert specific storage values since they are simulated to
4192  ! be a function of the average effective stress
4193  else
4194  void_ratio = this%csub_calc_void_ratio(this%theta(ib))
4195  es = this%cg_es(node)
4196  hcell = hnew(node)
4197  !
4198  ! -- calculate corrected head (hbar)
4199  hbar = squadratic0sp(hcell, bot, this%satomega)
4200  !
4201  ! -- calculate zone and factor
4202  znode = this%csub_calc_znode(top, bot, hbar)
4203  fact = this%csub_calc_adjes(node, es, bot, znode)
4204  fact = fact * (done + void_ratio)
4205  end if
4206  !
4207  ! -- user-specified compression indices - multiply by dlog10es
4208  else
4209  fact = dlog10es
4210  end if
4211  this%ci(ib) = this%ci(ib) * fact
4212  this%rci(ib) = this%rci(ib) * fact
4213  !
4214  ! -- write error message if negative compression indices
4215  if (fact <= dzero) then
4216  call this%dis%noder_to_string(node, cellid)
4217  write (errmsg, '(a,1x,i0,2(1x,a),a)') &
4218  'Negative compression indices calculated for interbed', ib, &
4219  'in cell', trim(adjustl(cellid)), '.'
4220  call store_error(errmsg)
4221  end if
4222  end do
4223  !
4224  ! -- write current stress and initial preconsolidation stress
4225  if (this%iprpak == 1) then
4226  ! -- set title
4227  title = trim(adjustl(this%packName))// &
4228  ' PACKAGE CALCULATED INITIAL INTERBED STRESSES AT THE CELL BOTTOM'
4229  !
4230  ! -- determine the number of columns and rows
4231  ntabrows = this%ninterbeds
4232  ntabcols = 5
4233  if (this%inamedbound /= 0) then
4234  ntabcols = ntabcols + 1
4235  end if
4236  !
4237  ! -- setup table
4238  call table_cr(this%inputtab, this%packName, title)
4239  call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
4240  !
4241  ! add columns
4242  tag = 'INTERBED NUMBER'
4243  call this%inputtab%initialize_column(tag, 10, alignment=tableft)
4244  tag = 'CELLID'
4245  call this%inputtab%initialize_column(tag, 20)
4246  tag = 'GEOSTATIC STRESS'
4247  call this%inputtab%initialize_column(tag, 16)
4248  tag = 'EFFECTIVE STRESS'
4249  call this%inputtab%initialize_column(tag, 16)
4250  tag = 'PRECONSOLIDATION STRESS'
4251  call this%inputtab%initialize_column(tag, 16)
4252  if (this%inamedbound /= 0) then
4253  tag = 'BOUNDNAME'
4254  call this%inputtab%initialize_column(tag, lenboundname, &
4255  alignment=tableft)
4256  end if
4257  !
4258  ! -- write the data
4259  do ib = 1, this%ninterbeds
4260  node = this%nodelist(ib)
4261  call this%dis%noder_to_string(node, cellid)
4262  !
4263  ! -- write the columns
4264  call this%inputtab%add_term(ib)
4265  call this%inputtab%add_term(cellid)
4266  call this%inputtab%add_term(this%cg_gs(node))
4267  call this%inputtab%add_term(this%cg_es(node))
4268  call this%inputtab%add_term(this%pcs(ib))
4269  if (this%inamedbound /= 0) then
4270  call this%inputtab%add_term(this%boundname(ib))
4271  end if
4272  end do
4273  !
4274  ! -- write effective stress and preconsolidation stress
4275  ! for delay beds
4276  ! -- set title
4277  title = trim(adjustl(this%packName))// &
4278  ' PACKAGE CALCULATED INITIAL DELAY INTERBED STRESSES'
4279  !
4280  ! -- determine the number of columns and rows
4281  ntabrows = 0
4282  do ib = 1, this%ninterbeds
4283  idelay = this%idelay(ib)
4284  if (idelay /= 0) then
4285  ntabrows = ntabrows + this%ndelaycells
4286  end if
4287  end do
4288  ntabcols = 6
4289  if (this%inamedbound /= 0) then
4290  ntabcols = ntabcols + 1
4291  end if
4292  !
4293  ! -- setup table
4294  call table_cr(this%inputtab, this%packName, title)
4295  call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
4296  !
4297  ! add columns
4298  tag = 'INTERBED NUMBER'
4299  call this%inputtab%initialize_column(tag, 10, alignment=tableft)
4300  tag = 'CELLID'
4301  call this%inputtab%initialize_column(tag, 20)
4302  tag = 'DELAY CELL'
4303  call this%inputtab%initialize_column(tag, 10, alignment=tableft)
4304  tag = 'GEOSTATIC STRESS'
4305  call this%inputtab%initialize_column(tag, 16)
4306  tag = 'EFFECTIVE STRESS'
4307  call this%inputtab%initialize_column(tag, 16)
4308  tag = 'PRECONSOLIDATION STRESS'
4309  call this%inputtab%initialize_column(tag, 16)
4310  if (this%inamedbound /= 0) then
4311  tag = 'BOUNDNAME'
4312  call this%inputtab%initialize_column(tag, lenboundname, &
4313  alignment=tableft)
4314  end if
4315  !
4316  ! -- write the data
4317  do ib = 1, this%ninterbeds
4318  idelay = this%idelay(ib)
4319  if (idelay /= 0) then
4320  node = this%nodelist(ib)
4321  call this%dis%noder_to_string(node, cellid)
4322  !
4323  ! -- write the columns
4324  do n = 1, this%ndelaycells
4325  if (n == 1) then
4326  call this%inputtab%add_term(ib)
4327  call this%inputtab%add_term(cellid)
4328  else
4329  call this%inputtab%add_term(' ')
4330  call this%inputtab%add_term(' ')
4331  end if
4332  call this%inputtab%add_term(n)
4333  call this%inputtab%add_term(this%dbgeo(n, idelay))
4334  call this%inputtab%add_term(this%dbes(n, idelay))
4335  call this%inputtab%add_term(this%dbpcs(n, idelay))
4336  if (this%inamedbound /= 0) then
4337  if (n == 1) then
4338  call this%inputtab%add_term(this%boundname(ib))
4339  else
4340  call this%inputtab%add_term(' ')
4341  end if
4342  end if
4343  end do
4344  end if
4345  end do
4346  !
4347  ! -- write calculated compression indices
4348  if (this%istoragec == 1) then
4349  if (this%lhead_based .EQV. .false.) then
4350  ! -- set title
4351  title = trim(adjustl(this%packName))// &
4352  ' PACKAGE COMPRESSION INDICES'
4353  !
4354  ! -- determine the number of columns and rows
4355  ntabrows = this%ninterbeds
4356  ntabcols = 4
4357  if (this%inamedbound /= 0) then
4358  ntabcols = ntabcols + 1
4359  end if
4360  !
4361  ! -- setup table
4362  call table_cr(this%inputtab, this%packName, title)
4363  call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
4364  !
4365  ! add columns
4366  tag = 'INTERBED NUMBER'
4367  call this%inputtab%initialize_column(tag, 10, alignment=tableft)
4368  tag = 'CELLID'
4369  call this%inputtab%initialize_column(tag, 20)
4370  tag = 'CC'
4371  call this%inputtab%initialize_column(tag, 16)
4372  tag = 'CR'
4373  call this%inputtab%initialize_column(tag, 16)
4374  if (this%inamedbound /= 0) then
4375  tag = 'BOUNDNAME'
4376  call this%inputtab%initialize_column(tag, lenboundname, &
4377  alignment=tableft)
4378  end if
4379  !
4380  ! -- write the data
4381  do ib = 1, this%ninterbeds
4382  fact = done / dlog10es
4383  node = this%nodelist(ib)
4384  call this%dis%noder_to_string(node, cellid)
4385  !
4386  ! -- write the columns
4387  call this%inputtab%add_term(ib)
4388  call this%inputtab%add_term(cellid)
4389  call this%inputtab%add_term(this%ci(ib) * fact)
4390  call this%inputtab%add_term(this%rci(ib) * fact)
4391  if (this%inamedbound /= 0) then
4392  call this%inputtab%add_term(this%boundname(ib))
4393  end if
4394  end do
4395  end if
4396  end if
4397  end if
4398  !
4399  ! -- terminate if any initialization errors have been detected
4400  if (count_errors() > 0) then
4401  call store_error_filename(this%input_fname)
4402  end if
4403  !
4404  ! -- set initialized
4405  this%initialized = 1
4406  !
4407  ! -- set flag to retain initial stresses for entire simulation
4408  if (this%lhead_based .EQV. .true.) then
4409  this%iupdatestress = 0
4410  end if
Here is the call graph for this function:

◆ csub_source_dimensions()

subroutine gwfcsubmodule::csub_source_dimensions ( class(gwfcsubtype), intent(inout)  this)
private

Read the number of interbeds and maximum number of cells with a specified overlying geostatic stress.

Definition at line 817 of file gwf-csub.f90.

818  ! -- modules
821  ! -- dummy variables
822  class(GwfCsubType), intent(inout) :: this
823  ! -- local variables
824  type(GwfCsubParamFoundType) :: found
825 
826  ! -- initialize dimensions to -1
827  this%ninterbeds = -1
828 
829  ! -- update defaults from input context
830  call mem_set_value(this%ninterbeds, 'NINTERBEDS', this%input_mempath, &
831  found%ninterbeds)
832  call mem_set_value(this%maxsig0, 'MAXBOUND', this%input_mempath, &
833  found%maxbound)
834 
835  ! - log dimensions
836  write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%packName))// &
837  ' DIMENSIONS'
838  write (this%iout, '(4x,a,i0)') 'NINTERBEDS = ', this%ninterbeds
839  write (this%iout, '(4x,a,i0)') 'MAXSIG0 = ', this%maxsig0
840  write (this%iout, '(1x,a)') &
841  'END OF '//trim(adjustl(this%packName))//' DIMENSIONS'
842 
843  ! -- verify dimensions were set correctly
844  if (.not. found%ninterbeds) then
845  write (errmsg, '(a)') &
846  'NINTERBEDS is a required dimension.'
847  call store_error(errmsg)
848  call store_error_filename(this%input_mempath)
849  end if
850 
851  ! -- Call define_listlabel to construct the list label that is written
852  ! when PRINT_INPUT option is used.
853  call this%define_listlabel()
Here is the call graph for this function:

◆ csub_source_griddata()

subroutine gwfcsubmodule::csub_source_griddata ( class(gwfcsubtype), intent(inout)  this)

Definition at line 1142 of file gwf-csub.f90.

1143  ! -- modules
1146  ! -- dummy variables
1147  class(GwfCsubType), intent(inout) :: this
1148  ! -- locals
1149  integer(I4B) :: node
1150  type(GwfCsubParamFoundType) :: found
1151  integer(I4B), dimension(:), pointer, contiguous :: map
1152 
1153  ! -- set map to convert user input data into reduced data
1154  map => null()
1155  if (this%dis%nodes < this%dis%nodesuser) map => this%dis%nodeuser
1156 
1157  ! -- update defaults from input context
1158  call mem_set_value(this%cg_ske_cr, 'CG_SKE_CR', this%input_mempath, &
1159  map, found%cg_ske_cr)
1160  call mem_set_value(this%cg_thetaini, 'CG_THETA', this%input_mempath, &
1161  map, found%cg_theta)
1162  call mem_set_value(this%sgm, 'SGM', this%input_mempath, map, found%sgm)
1163  call mem_set_value(this%sgs, 'SGS', this%input_mempath, map, found%sgs)
1164 
1165  ! -- cg_ske and cg_theta are required input params
1166  if (.not. found%cg_ske_cr) then
1167  call store_error('CG_SKE GRIDDATA must be specified.')
1168  call store_error_filename(this%input_fname)
1169  end if
1170  if (.not. found%cg_theta) then
1171  call store_error('CG_THETA GRIDDATA must be specified.')
1172  call store_error_filename(this%input_fname)
1173  end if
1174 
1175  ! -- if sgm and sgs have not been specified assign default values
1176  if (.not. found%sgm) then
1177  do node = 1, this%dis%nodes
1178  this%sgm(node) = 1.7d0
1179  end do
1180  end if
1181  if (.not. found%sgs) then
1182  do node = 1, this%dis%nodes
1183  this%sgs(node) = 2.0d0
1184  end do
1185  end if
Here is the call graph for this function:

◆ csub_source_packagedata()

subroutine gwfcsubmodule::csub_source_packagedata ( class(gwfcsubtype), intent(inout)  this)

Read delay and no-delay interbed input data for the CSUB package. Method also validates interbed input data.

Definition at line 1194 of file gwf-csub.f90.

1195  ! -- modules
1199  ! -- dummy variables
1200  class(GwfCsubType), intent(inout) :: this
1201  integer(I4B), dimension(:), pointer, contiguous :: icsubno
1202  integer(I4B), dimension(:, :), pointer, contiguous :: cellid_pkgdata
1203  integer(I4B), dimension(:), pointer :: cellid
1204  type(CharacterStringType), dimension(:), pointer, &
1205  contiguous :: cdelay
1206  type(CharacterStringType), dimension(:), pointer, &
1207  contiguous :: boundname
1208  real(DP), dimension(:), pointer, contiguous :: pcs, thick_frac, rnb
1209  real(DP), dimension(:), pointer, contiguous :: ssv_cc, sse_cr, theta, kv, h0
1210  character(len=LINELENGTH) :: cdelaystr
1211  character(len=LENBOUNDNAME) :: bndname
1212  real(DP) :: top, botm, baq, q, thick, rval
1213  integer(I4B) :: idelay, ndelaybeds, csubno
1214  integer(I4B) :: ib, n, nodeu, noder
1215 
1216  ! -- set input context pointers
1217  call mem_setptr(icsubno, 'ICSUBNO', this%input_mempath)
1218  call mem_setptr(cellid_pkgdata, 'CELLID_PKGDATA', this%input_mempath)
1219  call mem_setptr(cdelay, 'CDELAY', this%input_mempath)
1220  call mem_setptr(pcs, 'PCS0', this%input_mempath)
1221  call mem_setptr(thick_frac, 'THICK_FRAC', this%input_mempath)
1222  call mem_setptr(rnb, 'RNB', this%input_mempath)
1223  call mem_setptr(ssv_cc, 'SSV_CC', this%input_mempath)
1224  call mem_setptr(sse_cr, 'SSE_CR', this%input_mempath)
1225  call mem_setptr(theta, 'THETA', this%input_mempath)
1226  call mem_setptr(kv, 'KV', this%input_mempath)
1227  call mem_setptr(h0, 'H0', this%input_mempath)
1228  call mem_setptr(boundname, 'BOUNDNAME', this%input_mempath)
1229 
1230  ! initialize ndelaybeds
1231  ndelaybeds = 0
1232 
1233  ! -- update state
1234  do n = 1, size(icsubno)
1235 
1236  ! -- set cubno
1237  csubno = icsubno(n)
1238 
1239  ! -- check csubno
1240  if (csubno < 1 .or. csubno > this%ninterbeds) then
1241  write (errmsg, '(a,1x,i0,2(1x,a),1x,i0,a)') &
1242  'Interbed number (', csubno, ') must be greater than 0 and ', &
1243  'less than or equal to', this%ninterbeds, '.'
1244  call store_error(errmsg)
1245  cycle
1246  end if
1247 
1248  ! -- set cellid
1249  cellid => cellid_pkgdata(:, n)
1250 
1251  ! -- set node user
1252  if (this%dis%ndim == 1) then
1253  nodeu = cellid(1)
1254  elseif (this%dis%ndim == 2) then
1255  nodeu = get_node(cellid(1), 1, cellid(2), &
1256  this%dis%mshape(1), 1, &
1257  this%dis%mshape(2))
1258  else
1259  nodeu = get_node(cellid(1), cellid(2), cellid(3), &
1260  this%dis%mshape(1), &
1261  this%dis%mshape(2), &
1262  this%dis%mshape(3))
1263  end if
1264 
1265  ! -- set node reduced
1266  noder = this%dis%get_nodenumber(nodeu, 1)
1267  if (noder <= 0) then
1268  cycle
1269  end if
1270 
1271  ! -- update nodelists
1272  this%nodelist(csubno) = noder
1273  this%unodelist(csubno) = nodeu
1274 
1275  ! -- set top, botm, baq
1276  top = this%dis%top(noder)
1277  botm = this%dis%bot(noder)
1278  baq = top - botm
1279 
1280  ! -- set cdelay
1281  cdelaystr = cdelay(n)
1282  select case (cdelaystr)
1283  case ('NODELAY')
1284  idelay = 0
1285  case ('DELAY')
1286  ndelaybeds = ndelaybeds + 1
1287  idelay = ndelaybeds
1288  case default
1289  write (errmsg, '(a,1x,a,1x,i0,1x,a)') &
1290  'Invalid CDELAY ', trim(adjustl(cdelaystr)), &
1291  'for packagedata entry', csubno, '.'
1292  call store_error(errmsg)
1293  cycle
1294  end select
1295  this%idelay(csubno) = idelay
1296 
1297  ! -- set initial preconsolidation stress
1298  this%pcs(csubno) = pcs(n)
1299 
1300  ! -- set thickness
1301  if (this%icellf == 0) then
1302  if (thick_frac(n) < dzero .or. thick_frac(n) > baq) then
1303  write (errmsg, '(a,g0,2(a,1x),g0,1x,a,1x,i0,a)') &
1304  'THICK (', thick_frac(n), ') MUST BE greater than or equal to 0 ', &
1305  'and less than or equal to than', baq, &
1306  'for packagedata entry', csubno, '.'
1307  call store_error(errmsg)
1308  end if
1309  thick = thick_frac(n)
1310  else
1311  if (thick_frac(n) < dzero .or. thick_frac(n) > done) then
1312  write (errmsg, '(a,1x,a,1x,i0,a)') &
1313  'FRAC MUST BE greater than 0 and less than or equal to 1', &
1314  'for packagedata entry', csubno, '.'
1315  call store_error(errmsg)
1316  end if
1317  thick = thick_frac(n) * baq
1318  end if
1319  this%thickini(csubno) = thick
1320  if (this%iupdatematprop /= 0) then
1321  this%thick(csubno) = thick
1322  end if
1323 
1324  ! -- set rnb
1325  if (idelay > 0) then
1326  if (rnb(n) < done) then
1327  write (errmsg, '(a,g0,a,1x,a,1x,i0,a)') &
1328  'RNB (', rnb(n), ') must be greater than or equal to 1', &
1329  'for packagedata entry', csubno, '.'
1330  call store_error(errmsg)
1331  end if
1332  this%rnb(csubno) = rnb(n)
1333  else
1334  this%rnb(csubno) = done
1335  end if
1336 
1337  ! -- set skv or ci
1338  if (ssv_cc(n) < dzero) then
1339  write (errmsg, '(2(a,1x),i0,a)') &
1340  '(SKV,CI) must be greater than or equal to 0', &
1341  'for packagedata entry', csubno, '.'
1342  call store_error(errmsg)
1343  end if
1344  this%ci(csubno) = ssv_cc(n)
1345 
1346  ! -- set ske or rci
1347  if (sse_cr(n) < dzero) then
1348  write (errmsg, '(2(a,1x),i0,a)') &
1349  '(SKE,RCI) must be greater than or equal to 0', &
1350  'for packagedata entry', csubno, '.'
1351  call store_error(errmsg)
1352  end if
1353  this%rci(csubno) = sse_cr(n)
1354 
1355  ! -- set ielastic
1356  if (this%ci(csubno) == this%rci(csubno)) then
1357  this%ielastic(csubno) = 1
1358  else
1359  this%ielastic(csubno) = 0
1360  end if
1361 
1362  ! -- set porosity
1363  if (theta(n) <= dzero .or. theta(n) > done) then
1364  write (errmsg, '(a,1x,a,1x,i0,a)') &
1365  'THETA must be greater than 0 and less than or equal to 1', &
1366  'for packagedata entry', csubno, '.'
1367  call store_error(errmsg)
1368  end if
1369  this%thetaini(csubno) = theta(n)
1370  if (this%iupdatematprop /= 0) then
1371  this%theta(csubno) = theta(n)
1372  end if
1373 
1374  ! -- set kv
1375  if (idelay > 0) then
1376  if (kv(n) <= 0.0) then
1377  write (errmsg, '(a,1x,i0,a)') &
1378  'KV must be greater than 0 for packagedata entry', csubno, '.'
1379  call store_error(errmsg)
1380  end if
1381  end if
1382  this%kv(csubno) = kv(n)
1383 
1384  ! -- set h0
1385  this%h0(csubno) = h0(n)
1386 
1387  ! -- set bound name
1388  if (this%inamedbound /= 0) then
1389  bndname = boundname(n)
1390  if (len_trim(bndname) < 1) then
1391  write (errmsg, '(a,1x,i0,a)') &
1392  'BOUNDNAME must be specified for packagedata entry', csubno, '.'
1393  call store_error(errmsg)
1394  end if
1395  this%boundname(csubno) = bndname
1396  end if
1397  end do
1398 
1399  !
1400  ! -- set the number of delay interbeds
1401  this%ndelaybeds = ndelaybeds
1402  !
1403  ! -- process delay interbeds
1404  if (ndelaybeds > 0) then
1405  !
1406  ! -- reallocate and initialize delay interbed arrays
1407  call mem_allocate(this%idb_nconv_count, 2, &
1408  'IDB_NCONV_COUNT', trim(this%memoryPath))
1409  call mem_allocate(this%idbconvert, this%ndelaycells, ndelaybeds, &
1410  'IDBCONVERT', trim(this%memoryPath))
1411  call mem_allocate(this%dbdhmax, ndelaybeds, &
1412  'DBDHMAX', trim(this%memoryPath))
1413  call mem_allocate(this%dbz, this%ndelaycells, ndelaybeds, &
1414  'DBZ', trim(this%memoryPath))
1415  call mem_allocate(this%dbrelz, this%ndelaycells, ndelaybeds, &
1416  'DBRELZ', trim(this%memoryPath))
1417  call mem_allocate(this%dbh, this%ndelaycells, ndelaybeds, &
1418  'DBH', trim(this%memoryPath))
1419  call mem_allocate(this%dbh0, this%ndelaycells, ndelaybeds, &
1420  'DBH0', trim(this%memoryPath))
1421  call mem_allocate(this%dbgeo, this%ndelaycells, ndelaybeds, &
1422  'DBGEO', trim(this%memoryPath))
1423  call mem_allocate(this%dbes, this%ndelaycells, ndelaybeds, &
1424  'DBES', trim(this%memoryPath))
1425  call mem_allocate(this%dbes0, this%ndelaycells, ndelaybeds, &
1426  'DBES0', trim(this%memoryPath))
1427  call mem_allocate(this%dbpcs, this%ndelaycells, ndelaybeds, &
1428  'DBPCS', trim(this%memoryPath))
1429  call mem_allocate(this%dbflowtop, ndelaybeds, &
1430  'DBFLOWTOP', trim(this%memoryPath))
1431  call mem_allocate(this%dbflowbot, ndelaybeds, &
1432  'DBFLOWBOT', trim(this%memoryPath))
1433  call mem_allocate(this%dbdzini, this%ndelaycells, ndelaybeds, &
1434  'DBDZINI', trim(this%memoryPath))
1435  call mem_allocate(this%dbthetaini, this%ndelaycells, ndelaybeds, &
1436  'DBTHETAINI', trim(this%memoryPath))
1437  call mem_allocate(this%dbcomp, this%ndelaycells, ndelaybeds, &
1438  'DBCOMP', trim(this%memoryPath))
1439  call mem_allocate(this%dbtcomp, this%ndelaycells, ndelaybeds, &
1440  'DBTCOMP', trim(this%memoryPath))
1441  !
1442  ! -- allocate delay bed arrays
1443  if (this%iupdatematprop == 0) then
1444  call mem_setptr(this%dbdz, 'DBDZINI', trim(this%memoryPath))
1445  call mem_setptr(this%dbdz0, 'DBDZINI', trim(this%memoryPath))
1446  call mem_setptr(this%dbtheta, 'DBTHETAINI', trim(this%memoryPath))
1447  call mem_setptr(this%dbtheta0, 'DBTHETAINI', trim(this%memoryPath))
1448  else
1449  call mem_allocate(this%dbdz, this%ndelaycells, ndelaybeds, &
1450  'DBDZ', trim(this%memoryPath))
1451  call mem_allocate(this%dbdz0, this%ndelaycells, ndelaybeds, &
1452  'DBDZ0', trim(this%memoryPath))
1453  call mem_allocate(this%dbtheta, this%ndelaycells, ndelaybeds, &
1454  'DBTHETA', trim(this%memoryPath))
1455  call mem_allocate(this%dbtheta0, this%ndelaycells, ndelaybeds, &
1456  'DBTHETA0', trim(this%memoryPath))
1457  end if
1458  !
1459  ! -- allocate delay interbed solution arrays
1460  call mem_allocate(this%dbal, this%ndelaycells, &
1461  'DBAL', trim(this%memoryPath))
1462  call mem_allocate(this%dbad, this%ndelaycells, &
1463  'DBAD', trim(this%memoryPath))
1464  call mem_allocate(this%dbau, this%ndelaycells, &
1465  'DBAU', trim(this%memoryPath))
1466  call mem_allocate(this%dbrhs, this%ndelaycells, &
1467  'DBRHS', trim(this%memoryPath))
1468  call mem_allocate(this%dbdh, this%ndelaycells, &
1469  'DBDH', trim(this%memoryPath))
1470  call mem_allocate(this%dbaw, this%ndelaycells, &
1471  'DBAW', trim(this%memoryPath))
1472  !
1473  ! -- initialize delay bed counters
1474  do n = 1, 2
1475  this%idb_nconv_count(n) = 0
1476  end do
1477  !
1478  ! -- initialize delay bed storage
1479  do ib = 1, this%ninterbeds
1480  idelay = this%idelay(ib)
1481  if (idelay == 0) then
1482  cycle
1483  end if
1484  !
1485  ! -- initialize delay interbed variables
1486  do n = 1, this%ndelaycells
1487  rval = this%thickini(ib) / real(this%ndelaycells, dp)
1488  this%dbdzini(n, idelay) = rval
1489  this%dbh(n, idelay) = this%h0(ib)
1490  this%dbh0(n, idelay) = this%h0(ib)
1491  this%dbthetaini(n, idelay) = this%thetaini(ib)
1492  this%dbgeo(n, idelay) = dzero
1493  this%dbes(n, idelay) = dzero
1494  this%dbes0(n, idelay) = dzero
1495  this%dbpcs(n, idelay) = this%pcs(ib)
1496  this%dbcomp(n, idelay) = dzero
1497  this%dbtcomp(n, idelay) = dzero
1498  if (this%iupdatematprop /= 0) then
1499  this%dbdz(n, idelay) = this%dbdzini(n, idelay)
1500  this%dbdz0(n, idelay) = this%dbdzini(n, idelay)
1501  this%dbtheta(n, idelay) = this%theta(ib)
1502  this%dbtheta0(n, idelay) = this%theta(ib)
1503  end if
1504  end do
1505  !
1506  ! -- initialize elevation of delay bed cells
1507  call this%csub_delay_init_zcell(ib)
1508  end do
1509  !
1510  ! -- initialize delay bed solution arrays
1511  do n = 1, this%ndelaycells
1512  this%dbal(n) = dzero
1513  this%dbad(n) = dzero
1514  this%dbau(n) = dzero
1515  this%dbrhs(n) = dzero
1516  this%dbdh(n) = dzero
1517  this%dbaw(n) = dzero
1518  end do
1519  end if
1520  !
1521  ! -- check that ndelaycells is odd when using
1522  ! the effective stress formulation
1523  if (ndelaybeds > 0) then
1524  q = mod(real(this%ndelaycells, dp), dtwo)
1525  if (q == dzero) then
1526  write (errmsg, '(a,i0,a,1x,a)') &
1527  'NDELAYCELLS (', this%ndelaycells, ') must be an', &
1528  'odd number when using the effective stress formulation.'
1529  call store_error(errmsg)
1530  end if
1531  end if
1532 
1533  if (this%iprpak /= 0) then
1534  call this%csub_print_packagedata()
1535  end if
1536 
This class is used to store a single deferred-length character string. It was designed to work in an ...
Definition: CharString.f90:23
Here is the call graph for this function:

◆ define_listlabel()

subroutine gwfcsubmodule::define_listlabel ( class(gwfcsubtype), intent(inout)  this)
private

Method defined the list label for the CSUB package. The list label is the heading that is written to iout when PRINT_INPUT option is used.

Definition at line 7192 of file gwf-csub.f90.

7193  ! -- dummy variables
7194  class(GwfCsubType), intent(inout) :: this
7195  !
7196  ! -- create the header list label
7197  this%listlabel = trim(this%filtyp)//' NO.'
7198  if (this%dis%ndim == 3) then
7199  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER'
7200  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'ROW'
7201  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'COL'
7202  elseif (this%dis%ndim == 2) then
7203  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER'
7204  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'CELL2D'
7205  else
7206  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'NODE'
7207  end if
7208  write (this%listlabel, '(a, a16)') trim(this%listlabel), 'SIG0'
7209  if (this%inamedbound == 1) then
7210  write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME'
7211  end if

◆ log_options()

subroutine gwfcsubmodule::log_options ( class(gwfcsubtype), intent(inout)  this,
logical(lgp), intent(in)  warn_estress_lag 
)

log options block for CSUB package.

Definition at line 694 of file gwf-csub.f90.

695  ! -- modules
696  ! -- dummy variables
697  class(GwfCsubType), intent(inout) :: this
698  logical(LGP), intent(in) :: warn_estress_lag
699  ! -- local variables
700  ! -- formats
701  character(len=*), parameter :: fmtts = &
702  &"(4x,'TIME-SERIES DATA WILL BE READ FROM FILE: ',a)"
703  character(len=*), parameter :: fmtflow = &
704  &"(4x,'FLOWS WILL BE SAVED TO FILE: ',a,/4x,'OPENED ON UNIT: ',I7)"
705  character(len=*), parameter :: fmtflow2 = &
706  &"(4x,'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL')"
707  character(len=*), parameter :: fmtssessv = &
708  &"(4x,'USING SSE AND SSV INSTEAD OF CR AND CC.')"
709  character(len=*), parameter :: fmtoffset = &
710  &"(4x,'INITIAL_STRESS TREATED AS AN OFFSET.')"
711  character(len=*), parameter :: fmtopt = &
712  &"(4x,A)"
713  character(len=*), parameter :: fmtopti = &
714  &"(4x,A,1X,I0)"
715  character(len=*), parameter :: fmtoptr = &
716  &"(4x,A,1X,G0)"
717  character(len=*), parameter :: fmtfileout = &
718  "(4x,'CSUB ',1x,a,1x,' WILL BE SAVED TO FILE: ',a,/4x,&
719  &'OPENED ON UNIT: ',I7)"
720  !
721  ! -- write messages for options
722  write (this%iout, '(//2(1X,A))') trim(adjustl(this%packName)), &
723  'PACKAGE SETTINGS'
724  write (this%iout, fmtopti) 'NUMBER OF DELAY CELLS =', &
725  this%ndelaycells
726  if (this%lhead_based .EQV. .true.) then
727  write (this%iout, '(4x,a)') &
728  'HEAD-BASED FORMULATION'
729  else
730  write (this%iout, '(4x,a)') &
731  'EFFECTIVE-STRESS FORMULATION'
732  end if
733  if (this%istoragec == 0) then
734  write (this%iout, '(4x,a,1(/,6x,a))') &
735  'COMPRESSION INDICES WILL BE SPECIFIED INSTEAD OF ELASTIC AND', &
736  'INELASTIC SPECIFIC STORAGE COEFFICIENTS'
737  else
738  write (this%iout, '(4x,a,1(/,6x,a))') &
739  'ELASTIC AND INELASTIC SPECIFIC STORAGE COEFFICIENTS WILL BE ', &
740  'SPECIFIED'
741  end if
742  if (this%iupdatematprop /= 1) then
743  write (this%iout, '(4x,a,1(/,6x,a))') &
744  'THICKNESS AND VOID RATIO WILL NOT BE ADJUSTED DURING THE', &
745  'SIMULATION'
746  else
747  write (this%iout, '(4x,a)') &
748  'THICKNESS AND VOID RATIO WILL BE ADJUSTED DURING THE SIMULATION'
749  end if
750  if (this%icellf /= 1) then
751  write (this%iout, '(4x,a)') &
752  'INTERBED THICKNESS WILL BE SPECIFIED AS A THICKNESS'
753  else
754  write (this%iout, '(4x,a,1(/,6x,a))') &
755  'INTERBED THICKNESS WILL BE SPECIFIED AS A AS A CELL FRACTION'
756  end if
757  if (this%ispecified_pcs /= 1) then
758  if (this%ipch /= 0) then
759  write (this%iout, '(4x,a,1(/,6x,a))') &
760  'PRECONSOLIDATION HEAD WILL BE SPECIFIED RELATIVE TO INITIAL', &
761  'STRESS CONDITIONS'
762  else
763  write (this%iout, '(4x,a,1(/,6x,a))') &
764  'PRECONSOLIDATION STRESS WILL BE SPECIFIED RELATIVE TO INITIAL', &
765  'STRESS CONDITIONS'
766  end if
767  else
768  if (this%ipch /= 0) then
769  write (this%iout, '(4x,a,1(/,6x,a))') &
770  'PRECONSOLIDATION HEAD WILL BE SPECIFIED AS ABSOLUTE VALUES', &
771  'INSTEAD OF RELATIVE TO INITIAL HEAD CONDITIONS'
772  else
773  write (this%iout, '(4x,a,1(/,6x,a))') &
774  'PRECONSOLIDATION STRESS WILL BE SPECIFIED AS ABSOLUTE VALUES', &
775  'INSTEAD OF RELATIVE TO INITIAL STRESS CONDITIONS'
776  end if
777  end if
778  if (this%ispecified_dbh /= 1) then
779  write (this%iout, '(4x,a,1(/,6x,a))') &
780  'DELAY INTERBED HEADS WILL BE SPECIFIED RELATIVE TO INITIAL ', &
781  'GWF HEADS'
782  else
783  write (this%iout, '(4x,a,1(/,6x,a))') &
784  'DELAY INTERBED HEADS WILL BE SPECIFIED AS ABSOLUTE VALUES INSTEAD', &
785  'OF RELATIVE TO INITIAL GWF HEADS'
786  end if
787  !
788  if (this%lhead_based .EQV. .false.) then
789  if (this%ieslag /= 0) then
790  write (this%iout, '(4x,a,1(/,6x,a))') &
791  'SPECIFIC STORAGE VALUES WILL BE CALCULATED USING THE EFFECTIVE', &
792  'STRESS FROM THE PREVIOUS TIME STEP'
793  else
794  write (this%iout, '(4x,a,1(/,6x,a))') &
795  'SPECIFIC STORAGE VALUES WILL BE CALCULATED USING THE CURRENT', &
796  'EFFECTIVE STRESS'
797  end if
798  else if (warn_estress_lag) then
799  write (this%iout, '(4x,a,2(/,6x,a))') &
800  'EFFECTIVE_STRESS_LAG HAS BEEN SPECIFIED BUT HAS NO EFFECT WHEN', &
801  'USING THE HEAD-BASED FORMULATION (HEAD_BASED HAS BEEN SPECIFIED', &
802  'IN THE OPTIONS BLOCK)'
803  end if
804  !
805  write (this%iout, fmtoptr) 'GAMMAW =', this%gammaw
806  write (this%iout, fmtoptr) 'BETA =', this%beta
807  write (this%iout, fmtoptr) 'GAMMAW * BETA =', this%brg
808  write (this%iout, '((1X,A))') 'END PACKAGE SETTINGS'

◆ source_options()

subroutine gwfcsubmodule::source_options ( class(gwfcsubtype), intent(inout)  this)

Source options for CSUB package.

Definition at line 530 of file gwf-csub.f90.

531  ! -- modules
535  use openspecmodule, only: access, form
539  ! -- dummy variables
540  class(GwfCsubType), intent(inout) :: this
541  ! -- local variables
542  integer(I4B), pointer :: ibs
543  integer(I4B) :: inobs
544  character(len=LINELENGTH) :: csv_interbed, csv_coarse
545  character(len=LINELENGTH) :: cmp_fn, ecmp_fn, iecmp_fn, ibcmp_fn, cmpcoarse_fn
546  character(len=LINELENGTH) :: zdisp_fn, pkg_converge_fn
547  type(GwfCsubParamFoundType) :: found
548  logical(LGP) :: warn_estress_lag = .false.
549 
550  ! -- allocate and initialize variables
551  allocate (ibs)
552  ibs = 0
553 
554  ! -- update defaults from input context
555  call mem_set_value(this%inamedbound, 'BOUNDNAMES', this%input_mempath, &
556  found%boundnames)
557  call mem_set_value(this%iprpak, 'PRINT_INPUT', this%input_mempath, &
558  found%print_input)
559  call mem_set_value(this%ipakcb, 'SAVE_FLOWS', this%input_mempath, &
560  found%save_flows)
561  call mem_set_value(this%gammaw, 'GAMMAW', this%input_mempath, found%gammaw)
562  call mem_set_value(this%beta, 'BETA', this%input_mempath, found%beta)
563  call mem_set_value(this%ipch, 'HEAD_BASED', this%input_mempath, &
564  found%head_based)
565  call mem_set_value(this%ipch, 'PRECON_HEAD', this%input_mempath, &
566  found%precon_head)
567  call mem_set_value(this%ndelaycells, 'NDELAYCELLS', this%input_mempath, &
568  found%ndelaycells)
569  call mem_set_value(this%istoragec, 'ICOMPRESS', this%input_mempath, &
570  found%icompress)
571  call mem_set_value(this%iupdatematprop, 'MATPROP', this%input_mempath, &
572  found%matprop)
573  call mem_set_value(this%icellf, 'CELL_FRACTION', this%input_mempath, &
574  found%cell_fraction)
575  call mem_set_value(ibs, 'INTERBED_STATE', this%input_mempath, &
576  found%interbed_state)
577  call mem_set_value(this%ispecified_pcs, 'PRECON_STRESS', this%input_mempath, &
578  found%precon_stress)
579  call mem_set_value(this%ispecified_dbh, 'DELAY_HEAD', this%input_mempath, &
580  found%delay_head)
581  call mem_set_value(this%ieslag, 'STRESS_LAG', this%input_mempath, &
582  found%stress_lag)
583  call mem_set_value(csv_interbed, 'INTERBEDSTRAINFN', this%input_mempath, &
584  found%interbedstrainfn)
585  call mem_set_value(csv_coarse, 'COARSESTRAINFN', this%input_mempath, &
586  found%coarsestrainfn)
587  call mem_set_value(cmp_fn, 'CMPFN', this%input_mempath, found%cmpfn)
588  call mem_set_value(ecmp_fn, 'ELASTICCMPFN', this%input_mempath, &
589  found%elasticcmpfn)
590  call mem_set_value(iecmp_fn, 'INELASTICCMPFN', this%input_mempath, &
591  found%inelasticcmpfn)
592  call mem_set_value(ibcmp_fn, 'INTERBEDCMPFN', this%input_mempath, &
593  found%interbedcmpfn)
594  call mem_set_value(cmpcoarse_fn, 'CMPCOARSEFN', this%input_mempath, &
595  found%cmpcoarsefn)
596  call mem_set_value(zdisp_fn, 'ZDISPFN', this%input_mempath, found%zdispfn)
597  call mem_set_value(pkg_converge_fn, 'PKGCONVERGEFN', this%input_mempath, &
598  found%pkgconvergefn)
599 
600  ! -- enforce 0 or 1 OBS6_FILENAME entries in option block
601  if (filein_fname(this%obs%inputFilename, 'OBS6_FILENAME', &
602  this%input_mempath, this%input_fname)) then
603  this%obs%active = .true.
604  inobs = getunit()
605  call openfile(inobs, this%iout, this%obs%inputFilename, 'OBS')
606  this%obs%inUnitObs = inobs
607  this%inobspkg = inobs
608  call this%obs%obs_df(this%iout, this%packName, this%filtyp, this%dis)
609  call this%csub_df_obs()
610  end if
611 
612  ! -- update input dependent internal state
613  if (found%save_flows) this%ipakcb = -1
614  if (found%head_based) then
615  this%lhead_based = .true.
616  if (this%ieslag /= 0) then
617  this%ieslag = 0
618  warn_estress_lag = .true.
619  end if
620  end if
621  if (found%icompress) this%istoragec = 0
622  if (found%interbed_state) then
623  this%ispecified_pcs = 1
624  this%ispecified_dbh = 1
625  end if
626  if (found%gammaw .or. found%beta) then
627  this%brg = this%gammaw * this%beta
628  end if
629 
630  ! fileout options
631  if (found%interbedstrainfn) then
632  this%istrainib = getunit()
633  call openfile(this%istrainib, this%iout, csv_interbed, 'CSV_OUTPUT', &
634  filstat_opt='REPLACE', mode_opt=mnormal)
635  end if
636  if (found%coarsestrainfn) then
637  this%istrainsk = getunit()
638  call openfile(this%istrainsk, this%iout, csv_coarse, 'CSV_OUTPUT', &
639  filstat_opt='REPLACE', mode_opt=mnormal)
640  end if
641  if (found%cmpfn) then
642  this%ioutcomp = getunit()
643  call openfile(this%ioutcomp, this%iout, cmp_fn, 'DATA(BINARY)', &
644  form, access, 'REPLACE', mode_opt=mnormal)
645  end if
646  if (found%elasticcmpfn) then
647  this%ioutcompe = getunit()
648  call openfile(this%ioutcompe, this%iout, ecmp_fn, &
649  'DATA(BINARY)', form, access, 'REPLACE', &
650  mode_opt=mnormal)
651  end if
652  if (found%inelasticcmpfn) then
653  this%ioutcompi = getunit()
654  call openfile(this%ioutcompi, this%iout, iecmp_fn, &
655  'DATA(BINARY)', form, access, 'REPLACE', &
656  mode_opt=mnormal)
657  end if
658  if (found%interbedcmpfn) then
659  this%ioutcompib = getunit()
660  call openfile(this%ioutcompib, this%iout, ibcmp_fn, &
661  'DATA(BINARY)', form, access, 'REPLACE', &
662  mode_opt=mnormal)
663  end if
664  if (found%cmpcoarsefn) then
665  this%ioutcomps = getunit()
666  call openfile(this%ioutcomps, this%iout, cmpcoarse_fn, &
667  'DATA(BINARY)', form, access, 'REPLACE', &
668  mode_opt=mnormal)
669  end if
670  if (found%zdispfn) then
671  this%ioutzdisp = getunit()
672  call openfile(this%ioutzdisp, this%iout, zdisp_fn, &
673  'DATA(BINARY)', form, access, 'REPLACE', &
674  mode_opt=mnormal)
675  end if
676  if (found%pkgconvergefn) then
677  this%ipakcsv = getunit()
678  call openfile(this%ipakcsv, this%iout, pkg_converge_fn, 'CSV', &
679  filstat_opt='REPLACE', mode_opt=mnormal)
680  end if
681 
682  ! -- log user options
683  call this%log_options(warn_estress_lag)
684 
685  ! -- cleanup
686  deallocate (ibs)
@ mnormal
normal output mode
Definition: Constants.f90:206
integer(i4b), parameter maxcharlen
maximum length of char string
Definition: Constants.f90:47
subroutine, public urdaux(naux, inunit, iout, lloc, istart, istop, auxname, line, text)
Read auxiliary variables from an input line.
integer(i4b) function, public getunit()
Get a free unit number.
subroutine, public openfile(iu, iout, fname, ftype, fmtarg_opt, accarg_opt, filstat_opt, mode_opt)
Open a file.
Definition: InputOutput.f90:30
character(len=20) access
Definition: OpenSpec.f90:7
character(len=20) form
Definition: OpenSpec.f90:7
This module contains the SourceCommonModule.
Definition: SourceCommon.f90:7
logical(lgp) function, public filein_fname(filename, tagname, input_mempath, input_fname)
enforce and set a single input filename provided via FILEIN keyword
Here is the call graph for this function:

Variable Documentation

◆ budtxt

character(len=lenbudtxt), dimension(4) gwfcsubmodule::budtxt = [' CSUB-CGELASTIC', ' CSUB-ELASTIC', ' CSUB-INELASTIC', ' CSUB-WATERCOMP']
private

Definition at line 49 of file gwf-csub.f90.

49  character(len=LENBUDTXT), dimension(4) :: budtxt = & !< text labels for budget terms
50  [' CSUB-CGELASTIC', &
51  ' CSUB-ELASTIC', &
52  ' CSUB-INELASTIC', &
53  ' CSUB-WATERCOMP']

◆ comptxt

character(len=lenbudtxt), dimension(6) gwfcsubmodule::comptxt = ['CSUB-COMPACTION', ' CSUB-INELASTIC', ' CSUB-ELASTIC', ' CSUB-INTERBED', ' CSUB-COARSE', ' CSUB-ZDISPLACE']
private

Definition at line 54 of file gwf-csub.f90.

54  character(len=LENBUDTXT), dimension(6) :: comptxt = & !< text labels for compaction terms
55  ['CSUB-COMPACTION', &
56  ' CSUB-INELASTIC', &
57  ' CSUB-ELASTIC', &
58  ' CSUB-INTERBED', &
59  ' CSUB-COARSE', &
60  ' CSUB-ZDISPLACE']

◆ dlog10es

real(dp), parameter gwfcsubmodule::dlog10es = 0.4342942_DP
private

Definition at line 64 of file gwf-csub.f90.

64  real(DP), parameter :: dlog10es = 0.4342942_dp !< derivative of the log of effective stress