MODFLOW 6  version 6.6.0.dev0
USGS Modular Hydrologic Model
ternarysolvetrack Module Reference

Functions/Subroutines

subroutine, public traverse_triangle (isolv, tol, texit, alpexit, betexit, itrifaceenter, itrifaceexit, alp1, bet1, alp2, bet2, alpi, beti)
 Traverse triangular cell. More...
 
subroutine, public canonical (x0, y0, x1, y1, x2, y2, v0x, v0y, v1x, v1y, v2x, v2y, xi, yi, rxx, rxy, ryx, ryy, sxx, sxy, syy, alp0, bet0, alp1, bet1, alp2, bet2, alpi, beti)
 Set coordinates to "canonical" configuration. More...
 
subroutine, public get_w (alp1, bet1, alp2, bet2, waa, wab, wba, wbb)
 Compute elements of W matrix. More...
 
subroutine, public solve_coefs (alpi, beti)
 Compute analytical solution coefficients depending on case. More...
 
subroutine, public step_analytical (t, alp, bet)
 Step (evaluate) analytically depending on case. More...
 
subroutine, public find_exit_bary (isolv, itriface, itrifaceenter, alpi, beti, tol, texit, alpexit, betexit)
 Find the exit time and location in barycentric coordinates. More...
 
real(dp) function fbary1 (bet)
 Brent's method applied to canonical face 1 (gamma = 0) More...
 
real(dp) function fbary2 (bet)
 Brent's method applied to canonical face 2 (alpha = 0) More...
 
subroutine, public get_t_alpt (bet, t, alp)
 Given beta evaluate t and alpha depending on case. More...
 
subroutine, public get_bet_outflow_bary (vn1, vn2, betoutlo, betouthi)
 Find outflow interval. More...
 
subroutine, public get_bet_soln_limits (beti, betsollo, betsolhi, ibettrend)
 Find trend of and limits on beta from beta{t} solution. More...
 
subroutine, public soln_brent (itriface, betlo, bethi, tol, texit, alpexit, betexit)
 Use Brent's method with initial bounds on beta of betlo and bethi. More...
 
subroutine, public soln_chand (itriface, betlo, bethi, tol, texit, alpexit, betexit)
 Use Chandrupatla's method with initial bounds on beta of betlo and bethi. More...
 

Variables

real(dp) ca1
 
real(dp) ca2
 
real(dp) ca3
 
real(dp) cb1
 
real(dp) cb2
 Analytical solution coefficients. More...
 
real(dp) waa
 
real(dp) wab
 
real(dp) wba
 
real(dp) wbb
 Elements of the "velocity matrix," W. More...
 
real(dp), dimension(2) cv0
 
real(dp), dimension(2) cv1
 
real(dp), dimension(2) cv2
 "Canonical" velocity components at corners of triangular subcell More...
 
integer(i4b) icase
 Case index for analytical solution. More...
 

Function/Subroutine Documentation

◆ canonical()

subroutine, public ternarysolvetrack::canonical ( real(dp)  x0,
real(dp)  y0,
real(dp)  x1,
real(dp)  y1,
real(dp)  x2,
real(dp)  y2,
real(dp)  v0x,
real(dp)  v0y,
real(dp)  v1x,
real(dp)  v1y,
real(dp)  v2x,
real(dp)  v2y,
real(dp)  xi,
real(dp)  yi,
real(dp)  rxx,
real(dp)  rxy,
real(dp)  ryx,
real(dp)  ryy,
real(dp), intent(inout)  sxx,
real(dp), intent(inout)  sxy,
real(dp), intent(inout)  syy,
real(dp)  alp0,
real(dp)  bet0,
real(dp)  alp1,
real(dp)  bet1,
real(dp)  alp2,
real(dp)  bet2,
real(dp)  alpi,
real(dp)  beti 
)
Parameters
ryyrotation matrix
[in,out]syyskew matrix entries (top left, top right, bottom right)
betialpha and beta coefficients

Definition at line 99 of file TernarySolveTrack.f90.

105  ! -- dummy
106  real(DP) :: x0
107  real(DP) :: y0
108  real(DP) :: x1
109  real(DP) :: y1
110  real(DP) :: x2
111  real(DP) :: y2
112  real(DP) :: v0x
113  real(DP) :: v0y
114  real(DP) :: v1x
115  real(DP) :: v1y
116  real(DP) :: v2x
117  real(DP) :: v2y
118  real(DP) :: xi
119  real(DP) :: yi
120  real(DP) :: rxx
121  real(DP) :: rxy
122  real(DP) :: ryx
123  real(DP) :: ryy !< rotation matrix
124  real(DP), intent(inout) :: sxx, sxy, syy !< skew matrix entries (top left, top right, bottom right)
125  real(DP) :: alp0
126  real(DP) :: bet0
127  real(DP) :: alp1
128  real(DP) :: bet1
129  real(DP) :: alp2
130  real(DP) :: bet2
131  real(DP) :: alpi
132  real(DP) :: beti !< alpha and beta coefficients
133  ! -- local
134  real(DP) :: baselen
135  real(DP) :: oobaselen
136  real(DP) :: sinomega
137  real(DP) :: cosomega
138  real(DP) :: x1diff
139  real(DP) :: y1diff
140  real(DP) :: x2diff
141  real(DP) :: y2diff
142  real(DP) :: xidiff
143  real(DP) :: yidiff
144  real(DP) :: rot(2, 2), res(2)
145 
146  ! -- Translate and rotate coordinates to "canonical" configuration
147  x1diff = x1 - x0
148  y1diff = y1 - y0
149  x2diff = x2 - x0
150  y2diff = y2 - y0
151  baselen = dsqrt(x1diff * x1diff + y1diff * y1diff)
152  oobaselen = done / baselen
153  cosomega = x1diff * oobaselen
154  sinomega = y1diff * oobaselen
155  rxx = cosomega
156  rxy = sinomega
157  ryx = -sinomega
158  ryy = cosomega
159  alp0 = dzero
160  bet0 = dzero
161  alp1 = baselen
162  bet1 = dzero
163 
164  rot = reshape((/rxx, ryx, rxy, ryy/), shape(rot))
165  res = matmul(rot, (/x2diff, y2diff/))
166  alp2 = res(1)
167  bet2 = res(2)
168 
169  cv0 = matmul(rot, (/v0x, v0y/))
170  cv1 = matmul(rot, (/v1x, v1y/))
171  cv2 = matmul(rot, (/v2x, v2y/))
172 
173  xidiff = xi - x0
174  yidiff = yi - y0
175  res = matmul(rot, (/xidiff, yidiff/))
176  alpi = res(1)
177  beti = res(2)
178 
179  sxx = done / alp1
180  syy = done / bet2
181  sxy = -alp2 * sxx * syy
182  alp1 = done
183  alp2 = dzero
184  bet2 = done
185  cv0 = skew(cv0, (/sxx, sxy, syy/))
186  cv1 = skew(cv1, (/sxx, sxy, syy/))
187  cv2 = skew(cv2, (/sxx, sxy, syy/))
188  res = (/alpi, beti/)
189  res = skew(res, (/sxx, sxy, syy/))
190  alpi = res(1)
191  beti = res(2)
192 
Here is the call graph for this function:
Here is the caller graph for this function:

◆ fbary1()

real(dp) function ternarysolvetrack::fbary1 ( real(dp), intent(in)  bet)
private

Definition at line 505 of file TernarySolveTrack.f90.

506  ! -- dummy
507  real(DP), intent(in) :: bet
508  real(DP) :: fb
509  ! -- local
510  real(DP) :: t
511  real(DP) :: alpt
512 
513  ! -- Evaluate gamma{t{beta}} = 1. - alpha{t{beta}} - beta
514  call get_t_alpt(bet, t, alpt)
515  fb = done - alpt - bet
Here is the call graph for this function:
Here is the caller graph for this function:

◆ fbary2()

real(dp) function ternarysolvetrack::fbary2 ( real(dp), intent(in)  bet)
private

Definition at line 519 of file TernarySolveTrack.f90.

520  ! -- dummy
521  real(DP), intent(in) :: bet
522  real(DP) :: fb
523  ! -- local
524  real(DP) :: t
525  real(DP) :: alpt
526 
527  ! -- Evaluate alpha{t{beta}}
528  call get_t_alpt(bet, t, alpt)
529  fb = alpt
Here is the call graph for this function:
Here is the caller graph for this function:

◆ find_exit_bary()

subroutine, public ternarysolvetrack::find_exit_bary ( integer(i4b)  isolv,
integer(i4b)  itriface,
integer(i4b)  itrifaceenter,
real(dp)  alpi,
real(dp)  beti,
real(dp)  tol,
real(dp)  texit,
real(dp)  alpexit,
real(dp)  betexit 
)

Definition at line 325 of file TernarySolveTrack.f90.

328  ! -- dummy
329  integer(I4B) :: isolv
330  integer(I4B) :: itriface
331  integer(I4B) :: itrifaceenter
332  real(DP) :: alpi
333  real(DP) :: beti
334  real(DP) :: tol
335  real(DP) :: texit
336  real(DP) :: alpexit
337  real(DP) :: betexit
338  ! -- local
339  real(DP) :: alplo
340  real(DP) :: alphi
341  real(DP) :: alpt
342  real(DP) :: alplim
343  real(DP) :: fax
344  real(DP) :: fbx
345  real(DP) :: t
346  real(DP) :: tlo
347  real(DP) :: thi
348  real(DP) :: v0alpstar
349  real(DP) :: valpi
350  real(DP) :: v1n
351  real(DP) :: v2n
352  real(DP) :: vbeti
353  real(DP) :: betlo
354  real(DP) :: bethi
355  real(DP) :: betsollo
356  real(DP) :: betsolhi
357  real(DP) :: betoutlo
358  real(DP) :: betouthi
359  integer(I4B) :: ibettrend
360  real(DP) :: zerotol
361 
362  zerotol = 1d-10 ! todo AMP: consider tolerance
363 
364  ! -- Use iterative scheme or numerical integration indicated by isolv.
365  if (itriface .eq. 0) then
366  ! -- Checking for exit on canonical face 0 (beta = 0)
367  if (itrifaceenter .eq. 0) then
368  ! -- Entrance face, so no exit. (Normal velocity is uniform along face 0,
369  ! -- so it cannot be both an entrance and an exit.)
370  texit = huge(1d0)
371  else
372  ! -- Not the entrance face, so check for outflow
373  if (cv0(2) .ge. dzero) then ! check beta velocity along beta=0 face
374  ! -- Inflow or no flow, so no exit
375  texit = huge(done)
376  else
377  ! -- Outflow, so check beta-velocity at the initial location,
378  ! -- recognizing that it will never change sign along the
379  ! -- trajectory (and will not be blocked from zero by an asymptote)
380  vbeti = cv0(2) + wbb * beti
381  if (vbeti .ge. dzero) then
382  ! -- Can't exit along beta = 0
383  texit = huge(done)
384  else
385  ! -- get alpt and check it
386  call get_t_alpt(dzero, t, alpt)
387  if ((alpt .ge. dzero) .and. (alpt .le. done)) then
388  ! -- alpt within the edge, so exit found
389  texit = t
390  alpexit = alpt
391  betexit = dzero
392  else
393  ! -- alpt not within the edge, so not an exit
394  texit = huge(done)
395  end if
396  end if
397  end if
398  end if
399  ! -- End canonical face 0 (beta = 0)
400  else
401  ! -- Checking for exit on canonical face 1 (gamma = 0.) or 2 (alpha = 0.)
402  if (itriface .eq. 1) then
403  ! -- Normal velocities (gamma components) at ends of canonical face 1
404  v1n = -cv1(1) - cv1(2)
405  v2n = -cv2(1) - cv2(2)
406  else
407  ! -- Normal velocities (alpha components) at ends of canonical face 2
408  v1n = cv0(1)
409  v2n = cv2(1)
410  end if
411  if ((v1n .ge. dzero) .and. (v2n .ge. dzero)) then
412  ! -- No outflow at vn1 and vn2 corners; no outflow interval, so no exit.
413  texit = huge(done)
414  else
415  ! -- Find outflow interval
416  call get_bet_outflow_bary(v1n, v2n, betoutlo, betouthi)
417  ! -- Find trend of and limits on beta from beta{t} solution
418  call get_bet_soln_limits(beti, betsollo, betsolhi, ibettrend)
419  ! -- Look for exit
420  if (ibettrend .eq. 0) then
421  ! -- Beta is constant, so check if it's within the outflow interval;
422  ! -- if not, no exit; if so, solve for t and alpha
423  if ((beti .gt. betouthi) .or. (beti .lt. betoutlo)) then
424  texit = huge(1d0)
425  else
426  ! -- Check alpha-velocity at the initial location,
427  ! -- recognizing that it will never change sign along the
428  ! -- trajectory (and will not be blocked from zero by an asymptote)
429  ! -- in this special case
430  v0alpstar = cv0(1) + wab * beti
431  valpi = v0alpstar + waa * alpi
432  if ((itriface .eq. 1) .and. (valpi .le. dzero)) then
433  ! -- Can't exit along gamma = 0.
434  texit = huge(done)
435  else if ((itriface .eq. 2) .and. (valpi .ge. dzero)) then
436  ! -- Can't exit along alpha = 0.
437  texit = huge(done)
438  else
439  ! -- get exit
440  if (itriface .eq. 1) then
441  alpexit = done - beti
442  else
443  alpexit = dzero
444  end if
445  betexit = beti
446  if (dabs(waa) > zerotol) then
447  alplim = -v0alpstar / waa
448  texit = dlog(alpexit - alplim / (alpi - alplim)) / waa
449  else
450  texit = (alpexit - alpi) / v0alpstar
451  end if
452  end if
453  end if
454  ! -- End constant-beta case
455  else
456  ! -- Beta varies along trajectory; combine outflow and soln limits on beta
457  bethi = min(betouthi, betsolhi)
458  betlo = max(betoutlo, betsollo)
459  if (betlo .gt. bethi) then
460  ! -- If bounds on bet leave no feasible interval, no exit
461  texit = huge(done)
462  else
463  ! -- Check sign of function value at beta bounds
464  call get_t_alpt(bethi, thi, alphi)
465  call get_t_alpt(betlo, tlo, alplo)
466  if (itriface .eq. 1) then
467  fax = done - betlo - alplo
468  fbx = done - bethi - alphi
469  else
470  fax = alplo
471  fbx = alphi
472  end if
473  if (fax * fbx .gt. dzero) then
474  ! -- Root not bracketed; no exit
475  texit = huge(done)
476  else
477  if (isolv .eq. 1) then
478  ! -- Use Brent's method with initial bounds on beta of betlo and bethi,
479  ! -- assuming they bound the root
480  call soln_brent(itriface, betlo, bethi, tol, texit, &
481  alpexit, betexit)
482  else if (isolv .eq. 2) then
483  ! -- Use Chandrupatla's method with initial bounds on beta of betlo and bethi,
484  ! -- assuming they bound the root
485  call soln_chand(itriface, betlo, bethi, tol, texit, &
486  alpexit, betexit)
487  else
488  call pstop(1, "Invalid isolv, expected one of: 1, 2")
489  end if
490  end if
491  end if
492  ! -- End variable-beta case
493  end if
494  end if
495  ! -- End canonical face 1 (gamma = 0.) or 2 (alpha = 0.)
496  end if
497 
498  if (texit .ne. huge(done) .and. texit .lt. dzero) then
499  call pstop(1, "texit is negative (unexpected)") ! shouldn't get here
500  end if
501 
Here is the call graph for this function:
Here is the caller graph for this function:

◆ get_bet_outflow_bary()

subroutine, public ternarysolvetrack::get_bet_outflow_bary ( real(dp)  vn1,
real(dp)  vn2,
real(dp)  betoutlo,
real(dp)  betouthi 
)

Definition at line 591 of file TernarySolveTrack.f90.

592  ! -- dummy
593  real(DP) :: vn1
594  real(DP) :: vn2
595  real(DP) :: betoutlo
596  real(DP) :: betouthi
597  ! -- local
598  real(DP) :: vndiff
599 
600  vndiff = vn2 - vn1
601  if (vn1 .lt. dzero) then
602  ! -- Outflow at vn1 corner
603  betoutlo = dzero
604  if (vn2 .le. dzero) then
605  ! -- Outflow along entire edge (except possibly no-flow right at vn2 corner)
606  betouthi = done
607  else
608  ! -- Outflow along part of edge
609  betouthi = -vn1 / vndiff
610  end if
611  else
612  ! -- Outflow at vn2 corner
613  betouthi = done
614  if (vn1 .le. dzero) then
615  ! -- Outflow along entire edge (except possibly no-flow right at vn1 corner)
616  betoutlo = dzero
617  else
618  ! -- Outflow along part of edge
619  betoutlo = -vn1 / vndiff
620  end if
621  end if
622 
Here is the caller graph for this function:

◆ get_bet_soln_limits()

subroutine, public ternarysolvetrack::get_bet_soln_limits ( real(dp), intent(in)  beti,
real(dp)  betsollo,
real(dp)  betsolhi,
integer(i4b), intent(inout)  ibettrend 
)

Definition at line 626 of file TernarySolveTrack.f90.

627  ! -- dummy
628  real(DP), intent(in) :: beti
629  real(DP) :: betsollo
630  real(DP) :: betsolhi
631  integer(I4B), intent(inout) :: ibettrend
632  ! -- local
633  real(DP) :: betlim
634 
635  if (icase > 2) then
636  if (cv0(2) .gt. dzero) then
637  betsolhi = huge(done)
638  betsollo = beti
639  ibettrend = 1
640  else if (cv0(2) .lt. dzero) then
641  betsolhi = beti
642  betsollo = -huge(done)
643  ibettrend = -1
644  else
645  betsolhi = beti
646  betsollo = beti
647  ibettrend = 0
648  end if
649  else if (wbb .gt. dzero) then
650  betlim = -cv0(2) / wbb
651  if (beti .gt. betlim) then
652  betsolhi = huge(done)
653  betsollo = beti
654  ibettrend = 1
655  else if (beti .lt. betlim) then
656  betsolhi = beti
657  betsollo = -huge(done)
658  ibettrend = -1
659  else
660  betsolhi = beti
661  betsollo = beti
662  ibettrend = 0
663  end if
664  else if (wbb .lt. dzero) then
665  betlim = -cv0(2) / wbb
666  if (beti .gt. betlim) then
667  betsolhi = beti
668  betsollo = betlim
669  ibettrend = -1
670  else if (beti .lt. betlim) then
671  betsolhi = betlim
672  betsollo = beti
673  ibettrend = 1
674  else
675  betsolhi = beti
676  betsollo = beti
677  ibettrend = 0
678  end if
679  end if
680 
Here is the caller graph for this function:

◆ get_t_alpt()

subroutine, public ternarysolvetrack::get_t_alpt ( real(dp), intent(in)  bet,
real(dp)  t,
real(dp)  alp 
)

Definition at line 533 of file TernarySolveTrack.f90.

534  ! -- dummy
535  real(DP), intent(in) :: bet
536  real(DP) :: t
537  real(DP) :: alp
538  ! -- local
539  real(DP) :: term
540  real(DP) :: zerotol
541  real(DP) :: waat
542  real(DP) :: coef
543  real(DP) :: waatlim
544  real(DP) :: ewaatlim
545 
546  ! assumes cb2<>0, wbb<>0
547  zerotol = 1d-10 ! todo AMP: consider tolerance
548  term = (bet - cb1) / cb2
549  waatlim = 50.0_dp
550  ewaatlim = 5d+21 ! approx. e^waatlim
551 
552  if (icase .eq. 1) then
553  term = max(term, zerotol)
554  t = dlog(term) / wbb
555  waat = waa * t
556  if (waat > waatlim) then
557  alp = sign(ewaatlim, ca2)
558  else
559  alp = ca1 + ca2 * dexp(waat) + ca3 * term
560  end if
561  else if (icase .eq. -1) then
562  term = max(term, zerotol)
563  t = dlog(term) / wbb
564  waat = waa * t
565  coef = ca2 + ca3 * t
566  if (waat > waatlim) then
567  alp = sign(ewaatlim, coef)
568  else
569  alp = ca1 + coef * dexp(waat)
570  end if
571  else if (icase .eq. 2) then
572  term = max(term, zerotol)
573  t = dlog(term) / wbb
574  alp = ca1 + ca2 * t + ca3 * term
575  else if (icase .eq. 3) then
576  t = term
577  waat = waa * t
578  if (waat > waatlim) then
579  alp = sign(ewaatlim, ca3)
580  else
581  alp = ca1 + ca2 * t + ca3 * dexp(waat)
582  end if
583  else if (icase .eq. 4) then
584  t = term
585  alp = ca1 + (ca2 + ca3 * t) * t
586  end if
587 
Here is the caller graph for this function:

◆ get_w()

subroutine, public ternarysolvetrack::get_w ( real(dp)  alp1,
real(dp)  bet1,
real(dp)  alp2,
real(dp)  bet2,
real(dp)  waa,
real(dp)  wab,
real(dp)  wba,
real(dp)  wbb 
)
Parameters
bet2triangle face points
wbbw matrix

Definition at line 196 of file TernarySolveTrack.f90.

199  ! -- dummy
200  real(DP) :: alp1
201  real(DP) :: bet1
202  real(DP) :: alp2
203  real(DP) :: bet2 !< triangle face points
204  real(DP) :: waa
205  real(DP) :: wab
206  real(DP) :: wba
207  real(DP) :: wbb !< w matrix
208  ! -- local
209  real(DP) :: v1alpdiff
210  real(DP) :: v2alpdiff
211  real(DP) :: v2betdiff
212 
213  ! -- Note: wab is the "alpha,beta" entry in matrix W
214  ! and the alpha component of the w^(beta) vector
215  v1alpdiff = cv1(1) - cv0(1)
216  v2alpdiff = cv2(1) - cv0(1)
217  v2betdiff = cv2(2) - cv0(2)
218  waa = v1alpdiff
219  wab = v2alpdiff
220  wba = dzero
221  wbb = v2betdiff
222 
Here is the caller graph for this function:

◆ soln_brent()

subroutine, public ternarysolvetrack::soln_brent ( integer(i4b), intent(in)  itriface,
real(dp)  betlo,
real(dp)  bethi,
real(dp), intent(in)  tol,
real(dp)  texit,
real(dp)  alpexit,
real(dp)  betexit 
)

Definition at line 684 of file TernarySolveTrack.f90.

686  ! -- dummy
687  integer(I4B), intent(in) :: itriface
688  real(DP) :: betlo
689  real(DP) :: bethi
690  real(DP), intent(in) :: tol
691  real(DP) :: texit
692  real(DP) :: alpexit
693  real(DP) :: betexit
694  ! -- local
695  real(DP) :: blo
696  real(DP) :: bhi
697  procedure(f1d), pointer :: f
698 
699  ! -- assuming betlo and bethi bracket the root
700  blo = betlo
701  bhi = bethi
702  if (itriface .eq. 1) then
703  f => fbary1
704  betexit = zero_br(blo, bhi, f, tol)
705  else
706  f => fbary2
707  betexit = zero_br(blo, bhi, f, tol)
708  end if
709  call get_t_alpt(betexit, texit, alpexit)
710 
Here is the call graph for this function:
Here is the caller graph for this function:

◆ soln_chand()

subroutine, public ternarysolvetrack::soln_chand ( integer(i4b), intent(in)  itriface,
real(dp)  betlo,
real(dp)  bethi,
real(dp), intent(in)  tol,
real(dp)  texit,
real(dp)  alpexit,
real(dp)  betexit 
)

Definition at line 714 of file TernarySolveTrack.f90.

716  ! -- dummy
717  integer(I4B), intent(in) :: itriface
718  real(DP) :: betlo
719  real(DP) :: bethi
720  real(DP), intent(in) :: tol
721  real(DP) :: texit
722  real(DP) :: alpexit
723  real(DP) :: betexit
724  ! -- local
725  real(DP) :: blo
726  real(DP) :: bhi
727  procedure(f1d), pointer :: f
728 
729  ! -- note: assuming betlo and bethi bracket the root
730  blo = betlo
731  bhi = bethi
732  if (itriface .eq. 1) then
733  f => fbary1
734  betexit = zero_ch(blo, bhi, f, tol)
735  else
736  f => fbary2
737  betexit = zero_ch(blo, bhi, f, tol)
738  end if
739  call get_t_alpt(betexit, texit, alpexit)
740 
Here is the call graph for this function:
Here is the caller graph for this function:

◆ solve_coefs()

subroutine, public ternarysolvetrack::solve_coefs ( real(dp)  alpi,
real(dp)  beti 
)

Definition at line 226 of file TernarySolveTrack.f90.

227  ! -- dummy
228  real(DP) :: alpi
229  real(DP) :: beti
230  ! -- local
231  real(DP) :: zerotol
232  real(DP) :: wratv
233  real(DP) :: acoef
234  real(DP) :: bcoef
235  real(DP) :: afact
236  real(DP) :: bfact
237  real(DP) :: vfact
238  real(DP) :: oowaa
239 
240  zerotol = 1d-10 ! todo AMP: consider tolerance
241  if (dabs(wbb) .gt. zerotol) then
242  wratv = (wab / wbb) * cv0(2)
243  acoef = cv0(1) - wratv
244  bcoef = wratv + wab * beti
245  afact = acoef / waa
246  vfact = cv0(2) / wbb
247  ! -- Coefs for beta do not depend on whether waa = 0 or not
248  cb1 = -vfact ! const term in beta
249  cb2 = vfact + beti ! coef for e(wbb*t) term in beta
250  ! -- Coefs for alpha
251  if (dabs(waa) .gt. zerotol) then
252  ! -- Case waa <> 0, wbb <> 0
253  if (dabs(wbb - waa) .gt. zerotol) then
254  ! -- Subcase wbb <> waa
255  bfact = bcoef / (wbb - waa)
256  ca1 = -afact ! const term in alpha
257  ca2 = alpi + afact - bfact ! coef for exp(waa*t) term in alpha
258  ca3 = bfact ! coef for exp(wbb*t) term in alpha
259  icase = 1
260  else
261  ! -- Subcase wbb = waa
262  ca1 = -afact ! const term in alpha
263  ca2 = alpi + afact ! coef for exp(waa*t) term in alpha
264  ca3 = bcoef ! coef for t*exp(waa*t) term in alpha
265  icase = -1
266  end if
267  else
268  ! -- Case waa = 0, wbb <> 0
269  bfact = bcoef / wbb
270  ca1 = alpi - bfact ! const term in alpha
271  ca2 = acoef ! coef for t term in alpha
272  ca3 = bfact ! coef for exp(wbb*t) term in alpha
273  icase = 2
274  end if
275  else
276  ! -- Coefs for beta do not depend on whether waa = 0 or not
277  cb1 = beti ! const term in beta
278  cb2 = cv0(2) ! coef for t term in beta
279  if (dabs(waa) .gt. zerotol) then
280  ! -- Case waa <> 0, wbb = 0
281  oowaa = 1d0 / waa
282  vfact = (wab * oowaa) * cv0(2)
283  ca1 = -oowaa * (cv0(1) + wab * beti + vfact) ! const term in alpha
284  ca2 = -vfact ! coef for t term in alpha
285  ca3 = alpi - ca1 ! coef for exp(waa*t) term in alpha
286  icase = 3
287  else
288  ! -- Case waa = 0, wbb = 0
289  ca1 = alpi ! const term in alpha
290  ca2 = cv0(1) + wab * beti ! coef for t term in alpha
291  ca3 = 5d-1 * wab * cv0(2) ! coef for t^2 term in alpha
292  icase = 4
293  end if
294  end if
295 
Here is the caller graph for this function:

◆ step_analytical()

subroutine, public ternarysolvetrack::step_analytical ( real(dp), intent(in)  t,
real(dp)  alp,
real(dp)  bet 
)

Definition at line 299 of file TernarySolveTrack.f90.

300  ! -- dummy
301  real(DP), intent(in) :: t
302  real(DP) :: alp
303  real(DP) :: bet
304 
305  if (icase .eq. 1) then
306  alp = ca1 + ca2 * dexp(waa * t) + ca3 * dexp(wbb * t)
307  bet = cb1 + cb2 * dexp(wbb * t)
308  else if (icase .eq. -1) then
309  alp = ca1 + (ca2 + ca3 * t) * dexp(waa * t)
310  bet = cb1 + cb2 * dexp(wbb * t)
311  else if (icase .eq. 2) then
312  alp = ca1 + ca2 * t + ca3 * dexp(wbb * t)
313  bet = cb1 + cb2 * dexp(wbb * t)
314  else if (icase .eq. 3) then
315  alp = ca1 + ca2 * t + ca3 * dexp(waa * t)
316  bet = cb1 + cb2 * t
317  else if (icase .eq. 4) then
318  alp = ca1 + (ca2 + ca3 * t) * t
319  bet = cb1 + cb2 * t
320  end if
321 
Here is the caller graph for this function:

◆ traverse_triangle()

subroutine, public ternarysolvetrack::traverse_triangle ( integer(i4b), intent(in)  isolv,
real(dp), intent(in)  tol,
real(dp), intent(out)  texit,
real(dp)  alpexit,
real(dp)  betexit,
integer(i4b)  itrifaceenter,
integer(i4b)  itrifaceexit,
real(dp)  alp1,
real(dp)  bet1,
real(dp)  alp2,
real(dp)  bet2,
real(dp)  alpi,
real(dp)  beti 
)
Parameters
[in]isolvsolution method
[in]tolsolution tolerance
[out]texittime particle exits the cell
betexitalpha and beta coefficients
itrifaceexitentry and exit faces
betialpha and beta coefficients

Definition at line 32 of file TernarySolveTrack.f90.

36  ! -- dummy
37  integer(I4B), intent(in) :: isolv !< solution method
38  real(DP), intent(in) :: tol !< solution tolerance
39  real(DP), intent(out) :: texit !< time particle exits the cell
40  real(DP) :: alpexit
41  real(DP) :: betexit !< alpha and beta coefficients
42  integer(I4B) :: itrifaceenter
43  integer(I4B) :: itrifaceexit !< entry and exit faces
44  real(DP) :: alp1
45  real(DP) :: bet1
46  real(DP) :: alp2
47  real(DP) :: bet2
48  real(DP) :: alpi
49  real(DP) :: beti !< alpha and beta coefficients
50  ! -- local
51  real(DP) :: texit0
52  real(DP) :: alpexit0
53  real(DP) :: betexit0
54  real(DP) :: texit1
55  real(DP) :: alpexit1
56  real(DP) :: betexit1
57  real(DP) :: texit2
58  real(DP) :: alpexit2
59  real(DP) :: betexit2
60 
61  ! -- Compute elements of matrix W
62  call get_w(alp1, bet1, alp2, bet2, waa, wab, wba, wbb)
63 
64  ! -- Determine alpha and beta analytically as functions of time
65  call solve_coefs(alpi, beti)
66 
67  ! -- Compute exit time (travel time to exit) and exit location
68  call find_exit_bary(isolv, 0, itrifaceenter, &
69  alpi, beti, tol, &
70  texit0, alpexit0, betexit0)
71  call find_exit_bary(isolv, 1, itrifaceenter, &
72  alpi, beti, tol, &
73  texit1, alpexit1, betexit1)
74  call find_exit_bary(isolv, 2, itrifaceenter, &
75  alpi, beti, tol, &
76  texit2, alpexit2, betexit2)
77  texit = min(texit0, texit1, texit2)
78 
79  ! -- Note that while the numbering of triangle faces is generally zero-based
80  ! -- (0, 1, 2), itrifaceexit, which gets passed out, is one-based (1, 2, 3).
81  if (texit .eq. texit0) then
82  alpexit = alpexit0
83  betexit = betexit0
84  itrifaceexit = 1
85  else if (texit .eq. texit1) then
86  alpexit = alpexit1
87  betexit = betexit1
88  itrifaceexit = 2
89  else if (texit .eq. texit2) then
90  alpexit = alpexit2
91  betexit = betexit2
92  itrifaceexit = 3
93  end if
94  if (texit .eq. huge(1d0)) itrifaceexit = 0
95 
Here is the call graph for this function:
Here is the caller graph for this function:

Variable Documentation

◆ ca1

real(dp) ternarysolvetrack::ca1
private

Definition at line 24 of file TernarySolveTrack.f90.

24  real(DP) ca1, ca2, ca3, cb1, cb2 !< Analytical solution coefficients

◆ ca2

real(dp) ternarysolvetrack::ca2
private

Definition at line 24 of file TernarySolveTrack.f90.

◆ ca3

real(dp) ternarysolvetrack::ca3
private

Definition at line 24 of file TernarySolveTrack.f90.

◆ cb1

real(dp) ternarysolvetrack::cb1
private

Definition at line 24 of file TernarySolveTrack.f90.

◆ cb2

real(dp) ternarysolvetrack::cb2
private

Definition at line 24 of file TernarySolveTrack.f90.

◆ cv0

real(dp), dimension(2) ternarysolvetrack::cv0
private

Definition at line 26 of file TernarySolveTrack.f90.

26  real(DP) :: cv0(2), cv1(2), cv2(2) !< "Canonical" velocity components at corners of triangular subcell

◆ cv1

real(dp), dimension(2) ternarysolvetrack::cv1
private

Definition at line 26 of file TernarySolveTrack.f90.

◆ cv2

real(dp), dimension(2) ternarysolvetrack::cv2
private

Definition at line 26 of file TernarySolveTrack.f90.

◆ icase

integer(i4b) ternarysolvetrack::icase
private

Definition at line 27 of file TernarySolveTrack.f90.

27  integer(I4B) icase !< Case index for analytical solution

◆ waa

real(dp) ternarysolvetrack::waa
private

Definition at line 25 of file TernarySolveTrack.f90.

25  real(DP) waa, wab, wba, wbb !< Elements of the "velocity matrix," W

◆ wab

real(dp) ternarysolvetrack::wab
private

Definition at line 25 of file TernarySolveTrack.f90.

◆ wba

real(dp) ternarysolvetrack::wba
private

Definition at line 25 of file TernarySolveTrack.f90.

◆ wbb

real(dp) ternarysolvetrack::wbb
private

Definition at line 25 of file TernarySolveTrack.f90.