MODFLOW 6  version 6.8.0.dev0
USGS Modular Hydrologic Model
geomutilmodule Module Reference

Functions/Subroutines

logical function, public between (x, a, b)
 Check if a value is between two other values (inclusive). More...
 
logical function, public point_in_polygon (x, y, poly, tol)
 Check if a point is within a polygon. More...
 
integer(i4b) function, public get_node (ilay, irow, icol, nlay, nrow, ncol)
 Get node number, given layer, row, and column indices for a structured grid. If any argument is invalid return -1. More...
 
subroutine, public get_ijk (nodenumber, nrow, ncol, nlay, irow, icol, ilay)
 Get row, column and layer indices from node number and grid dimensions. If nodenumber is invalid, irow, icol, and ilay are -1. More...
 
subroutine, public get_jk (nodenumber, ncpl, nlay, icpl, ilay)
 Get layer index and within-layer node index from node number and grid dimensions. If nodenumber is invalid, icpl and ilay are -1. More...
 
pure real(dp) function, dimension(2), public skew (v, s, invert)
 Skew a 2D vector along the x-axis. More...
 
subroutine, public transform (xin, yin, zin, xout, yout, zout, xorigin, yorigin, zorigin, sinrot, cosrot, invert)
 Apply a 3D translation and optional 2D rotation to coordinates. More...
 
subroutine, public compose (xorigin, yorigin, zorigin, sinrot, cosrot, xorigin_new, yorigin_new, zorigin_new, sinrot_new, cosrot_new, invert)
 Apply a 3D translation and 2D rotation to an existing transformation. More...
 
subroutine defaults (xorigin, yorigin, zorigin, sinrot, cosrot, invert, translate, rotate, xorigin_opt, yorigin_opt, zorigin_opt, sinrot_opt, cosrot_opt, invert_opt)
 Process arguments and set defaults. Internal use only. More...
 
real(dp) function, public area (xv, yv, cw)
 Calculate polygon area, with vertices given in CW or CCW order. More...
 
subroutine, public shared_face (iverts1, iverts2, iface)
 Find the lateral face shared by two cells. More...
 
subroutine, public clamp_bary (alpha, beta, gamma, pad)
 Clamp barycentric coordinates to the interior of a triangle, with optional padding some minimum distance from any face. More...
 

Function/Subroutine Documentation

◆ area()

real(dp) function, public geomutilmodule::area ( real(dp), dimension(:), intent(in)  xv,
real(dp), dimension(:), intent(in)  yv,
logical(lgp), intent(in), optional  cw 
)

Definition at line 383 of file GeomUtil.f90.

384  ! dummy
385  real(DP), dimension(:), intent(in) :: xv
386  real(DP), dimension(:), intent(in) :: yv
387  logical(LGP), intent(in), optional :: cw
388  ! result
389  real(DP) :: a
390  integer(I4B) :: s
391 
392  if (present(cw)) then
393  if (cw) then
394  s = 1
395  else
396  s = -1
397  end if
398  else
399  s = 1
400  end if
401 
402  a = -dhalf * sum(xv(:) * cshift(yv(:), s) - cshift(xv(:), s) * yv(:))
403 

◆ between()

logical function, public geomutilmodule::between ( real(dp), intent(in)  x,
real(dp), intent(in)  a,
real(dp), intent(in)  b 
)

Definition at line 16 of file GeomUtil.f90.

17  real(DP), intent(in) :: x, a, b
18  between = ((x >= a .and. x <= b) .or. (x <= a .and. x >= b))
Here is the caller graph for this function:

◆ clamp_bary()

subroutine, public geomutilmodule::clamp_bary ( real(dp), intent(inout)  alpha,
real(dp), intent(inout)  beta,
real(dp), intent(out)  gamma,
real(dp), intent(in), optional  pad 
)

This routine requires 0 <= tol <= 1/3 and 1 = alpha + beta + gamma.

Definition at line 479 of file GeomUtil.f90.

480  ! dummy
481  real(DP), intent(inout) :: alpha
482  real(DP), intent(inout) :: beta
483  real(DP), intent(out) :: gamma
484  real(DP), intent(in), optional :: pad
485  ! local
486  real(DP) :: lolimit
487  real(DP) :: hilimit
488  real(DP) :: delta
489  real(DP) :: lpad
490 
491  if (present(pad)) then
492  lpad = pad
493  if (pad < dzero .or. pad > donethird) &
494  call pstop(1, "pad must be between 0 and 1/3, inclusive")
495  else
496  lpad = dzero
497  end if
498 
499  gamma = done - alpha - beta
500  lolimit = lpad
501  hilimit = done - dtwo * lpad
502  ! Check alpha coordinate against lower limit
503  if (alpha < lolimit) then
504  ! Alpha is too low, so nudge alpha to lower limit; this is a move
505  ! parallel to the "alpha axis," which also changes gamma
506  alpha = lolimit
507  gamma = done - alpha - beta
508  ! Check beta coordinate against lower limit (which in this
509  ! case is equivalent to checking gamma coordinate against
510  ! upper limit)
511  if (beta < lolimit) then
512  ! Beta is too low (gamma is too high), so nudge beta to lower limit;
513  ! this is a move parallel to the "beta axis," which also changes gamma
514  beta = lolimit
515  gamma = hilimit
516  ! Check beta coordinate against upper limit (which in this
517  ! case is equivalent to checking gamma coordinate against
518  ! lower limit)
519  else if (beta > hilimit) then
520  ! Beta is too high (gamma is too low), so nudge beta to lower limit;
521  ! this is a move parallel to the "beta axis," which also changes gamma
522  beta = hilimit
523  gamma = lolimit
524  end if
525  end if
526  ! Check beta coordinate against lower limit. (If alpha coordinate
527  ! was nudged to lower limit, beta and gamma coordinates have also
528  ! been adjusted as necessary to place particle within subcell, and
529  ! subsequent checks on beta and gamma will evaluate to false, and
530  ! no further adjustments will be made.)
531  if (beta < lolimit) then
532  ! Beta is too low, so nudge beta to lower limit; this is a move
533  ! parallel to the "beta axis," which also changes gamma
534  beta = lolimit
535  gamma = done - alpha - beta
536  ! Check alpha coordinate against lower limit (which in this
537  ! case is equivalent to checking gamma coordinate against
538  ! upper limit)
539  if (alpha < lolimit) then
540  ! Alpha is too low (gamma is too high), so nudge alpha to lower limit;
541  ! this is a move parallel to the "alpha axis," which also changes gamma
542  alpha = lolimit
543  gamma = hilimit
544  ! Check alpha coordinate against upper limit (which in this
545  ! case is equivalent to checking gamma coordinate against
546  ! lower limit)
547  else if (alpha > hilimit) then
548  ! Alpha is too high (gamma is too low), so nudge alpha to lower limit;
549  ! this is a move parallel to the "alpha axis," which also changes gamma
550  alpha = hilimit
551  gamma = lolimit
552  end if
553  end if
554  ! Check gamma coordinate against lower limit.(If alpha and/or beta
555  ! coordinate was nudged to lower limit, gamma coordinate has also
556  ! been adjusted as necessary to place particle within subcell, and
557  ! subsequent check on gamma will evaluate to false, and no further
558  ! adjustment will be made.)
559  if (gamma < lolimit) then
560  ! Gamma is too low, so nudge gamma to lower limit; this is a move
561  ! parallel to the "gamma axis," which also changes alpha and beta
562  delta = dhalf * (lolimit - gamma)
563  gamma = lpad
564  alpha = alpha - delta
565  beta = beta - delta
566  ! Check beta coordinate against lower limit (which in this
567  ! case is equivalent to checking alpha coordinate against
568  ! upper limit)
569  if (beta < lolimit) then
570  ! Beta is too low (alpha is too high), so nudge beta to lower limit;
571  ! this is a move parallel to the "gamma axis," which also changes alpha
572  beta = lolimit
573  alpha = done - beta - gamma
574  ! Check beta coordinate against upper limit (which in this
575  ! case is equivalent to checking gamma coordinate against
576  ! lower limit)
577  else if (beta > hilimit) then
578  ! Beta is too high (alpha is too low), so nudge beta to lower limit;
579  ! this is a move parallel to the "gamma axis," which also changes alpha
580  beta = hilimit
581  alpha = done - beta - gamma
582  end if
583  end if
Here is the call graph for this function:
Here is the caller graph for this function:

◆ compose()

subroutine, public geomutilmodule::compose ( real(dp)  xorigin,
real(dp)  yorigin,
real(dp)  zorigin,
real(dp)  sinrot,
real(dp)  cosrot,
real(dp), optional  xorigin_new,
real(dp), optional  yorigin_new,
real(dp), optional  zorigin_new,
real(dp), optional  sinrot_new,
real(dp), optional  cosrot_new,
logical(lgp), optional  invert 
)
Parameters
zoriginorigin coordinates (original)
cosrotsine and cosine of rotation (original)
zorigin_neworigin coordinates (new)
cosrot_newsine and cosine of rotation (new)
invertwhether to invert

Definition at line 247 of file GeomUtil.f90.

252  ! -- dummy
253  real(DP) :: xorigin, yorigin, zorigin !< origin coordinates (original)
254  real(DP) :: sinrot, cosrot !< sine and cosine of rotation (original)
255  real(DP), optional :: xorigin_new, yorigin_new, zorigin_new !< origin coordinates (new)
256  real(DP), optional :: sinrot_new, cosrot_new !< sine and cosine of rotation (new)
257  logical(LGP), optional :: invert !< whether to invert
258  ! -- local
259  logical(LGP) :: ltranslate, lrotate, linvert
260  real(DP) :: xorigin_add, yorigin_add, zorigin_add
261  real(DP) :: sinrot_add, cosrot_add
262  real(DP) :: x0, y0, z0, s0, c0
263 
264  ! -- Process option arguments and set defaults and flags
265  call defaults(xorigin_add, yorigin_add, zorigin_add, &
266  sinrot_add, cosrot_add, linvert, &
267  ltranslate, lrotate, &
268  xorigin_new, yorigin_new, zorigin_new, &
269  sinrot_new, cosrot_new, invert)
270 
271  ! -- Copy existing transformation into working copy
272  x0 = xorigin
273  y0 = yorigin
274  z0 = zorigin
275  s0 = sinrot
276  c0 = cosrot
277 
278  ! -- Modify transformation
279  if (.not. linvert) then
280  ! -- Apply additional transformation to existing transformation
281  if (ltranslate) then
282  ! -- Calculate modified origin, XOrigin + R^T XOrigin_add, where
283  ! -- XOrigin and XOrigin_add are the existing and additional origin
284  ! -- vectors, respectively, and R^T is the transpose of the existing
285  ! -- rotation matrix
286  call transform(xorigin_add, yorigin_add, zorigin_add, &
287  xorigin, yorigin, zorigin, &
288  x0, y0, z0, s0, c0, .true.)
289  end if
290  if (lrotate) then
291  ! -- Calculate modified rotation matrix (represented by sinrot
292  ! -- and cosrot) as R_add R, where R and R_add are the existing
293  ! -- and additional rotation matrices, respectively
294  sinrot = cosrot_add * s0 + sinrot_add * c0
295  cosrot = cosrot_add * c0 - sinrot_add * s0
296  end if
297  else
298  ! -- Apply inverse of additional transformation to existing transformation.
299  ! -- Calculate modified origin, R^T (XOrigin + R_add XOrigin_add), where
300  ! -- XOrigin and XOrigin_add are the existing and additional origin
301  ! -- vectors, respectively, R^T is the transpose of the existing rotation
302  ! -- matrix, and R_add is the additional rotation matrix.
303  if (lrotate) then
304  if (ltranslate) then
305  call transform(-xorigin_add, -yorigin_add, zorigin_add, &
306  x0, y0, z0, xorigin, yorigin, zorigin, &
307  -sinrot_add, cosrot_add, .true.)
308  end if
309  xorigin = c0 * x0 - s0 * y0
310  yorigin = s0 * x0 + c0 * y0
311  zorigin = z0
312  else if (ltranslate) then
313  xorigin = x0 - xorigin_add
314  yorigin = y0 - yorigin_add
315  zorigin = z0 - zorigin_add
316  end if
317  if (lrotate) then
318  ! -- Calculate modified rotation matrix (represented by sinrot
319  ! -- and cosrot) as R_add^T R, where R and R_add^T are the existing
320  ! -- rotation matrix and the transpose of the additional rotation
321  ! -- matrix, respectively
322  sinrot = cosrot_add * s0 - sinrot_add * c0
323  cosrot = cosrot_add * c0 + sinrot_add * s0
324  end if
325  end if
Here is the call graph for this function:
Here is the caller graph for this function:

◆ defaults()

subroutine geomutilmodule::defaults ( real(dp)  xorigin,
real(dp)  yorigin,
real(dp)  zorigin,
real(dp)  sinrot,
real(dp)  cosrot,
logical(lgp)  invert,
logical(lgp)  translate,
logical(lgp)  rotate,
real(dp), optional  xorigin_opt,
real(dp), optional  yorigin_opt,
real(dp), optional  zorigin_opt,
real(dp), optional  sinrot_opt,
real(dp), optional  cosrot_opt,
logical(lgp), optional  invert_opt 
)
private

Definition at line 329 of file GeomUtil.f90.

334  ! -- dummy
335  real(DP) :: xorigin, yorigin, zorigin
336  real(DP) :: sinrot, cosrot
337  logical(LGP) :: invert, translate, rotate
338  real(DP), optional :: xorigin_opt, yorigin_opt, zorigin_opt
339  real(DP), optional :: sinrot_opt, cosrot_opt
340  logical(LGP), optional :: invert_opt
341 
342  translate = .false.
343  xorigin = dzero
344  if (present(xorigin_opt)) then
345  xorigin = xorigin_opt
346  translate = .true.
347  end if
348  yorigin = dzero
349  if (present(yorigin_opt)) then
350  yorigin = yorigin_opt
351  translate = .true.
352  end if
353  zorigin = dzero
354  if (present(zorigin_opt)) then
355  zorigin = zorigin_opt
356  translate = .true.
357  end if
358  rotate = .false.
359  sinrot = dzero
360  cosrot = done
361  if (present(sinrot_opt)) then
362  sinrot = sinrot_opt
363  if (present(cosrot_opt)) then
364  cosrot = cosrot_opt
365  else
366  ! -- If sinrot_opt is specified but cosrot_opt is not,
367  ! -- default to corresponding non-negative cosrot_add
368  cosrot = dsqrt(done - sinrot * sinrot)
369  end if
370  rotate = .true.
371  else if (present(cosrot_opt)) then
372  cosrot = cosrot_opt
373  ! -- cosrot_opt is specified but sinrot_opt is not, so
374  ! -- default to corresponding non-negative sinrot_add
375  sinrot = dsqrt(done - cosrot * cosrot)
376  rotate = .true.
377  end if
378  invert = .false.
379  if (present(invert_opt)) invert = invert_opt
Here is the caller graph for this function:

◆ get_ijk()

subroutine, public geomutilmodule::get_ijk ( integer(i4b), intent(in)  nodenumber,
integer(i4b), intent(in)  nrow,
integer(i4b), intent(in)  ncol,
integer(i4b), intent(in)  nlay,
integer(i4b), intent(out)  irow,
integer(i4b), intent(out)  icol,
integer(i4b), intent(out)  ilay 
)

Definition at line 108 of file GeomUtil.f90.

109  ! -- dummy variables
110  integer(I4B), intent(in) :: nodenumber
111  integer(I4B), intent(in) :: nrow
112  integer(I4B), intent(in) :: ncol
113  integer(I4B), intent(in) :: nlay
114  integer(I4B), intent(out) :: irow
115  integer(I4B), intent(out) :: icol
116  integer(I4B), intent(out) :: ilay
117  ! -- local variables
118  integer(I4B) :: nodes
119  integer(I4B) :: ij
120 
121  nodes = nlay * nrow * ncol
122  if (nodenumber < 1 .or. nodenumber > nodes) then
123  irow = -1
124  icol = -1
125  ilay = -1
126  else
127  ilay = (nodenumber - 1) / (ncol * nrow) + 1
128  ij = nodenumber - (ilay - 1) * ncol * nrow
129  irow = (ij - 1) / ncol + 1
130  icol = ij - (irow - 1) * ncol
131  end if
Here is the caller graph for this function:

◆ get_jk()

subroutine, public geomutilmodule::get_jk ( integer(i4b), intent(in)  nodenumber,
integer(i4b), intent(in)  ncpl,
integer(i4b), intent(in)  nlay,
integer(i4b), intent(out)  icpl,
integer(i4b), intent(out)  ilay 
)

Definition at line 136 of file GeomUtil.f90.

137  ! -- dummy variables
138  integer(I4B), intent(in) :: nodenumber
139  integer(I4B), intent(in) :: ncpl
140  integer(I4B), intent(in) :: nlay
141  integer(I4B), intent(out) :: icpl
142  integer(I4B), intent(out) :: ilay
143  ! -- local variables
144  integer(I4B) :: nodes
145 
146  nodes = ncpl * nlay
147  if (nodenumber < 1 .or. nodenumber > nodes) then
148  icpl = -1
149  ilay = -1
150  else
151  ilay = (nodenumber - 1) / ncpl + 1
152  icpl = nodenumber - (ilay - 1) * ncpl
153  end if
Here is the caller graph for this function:

◆ get_node()

integer(i4b) function, public geomutilmodule::get_node ( integer(i4b), intent(in)  ilay,
integer(i4b), intent(in)  irow,
integer(i4b), intent(in)  icol,
integer(i4b), intent(in)  nlay,
integer(i4b), intent(in)  nrow,
integer(i4b), intent(in)  ncol 
)

Definition at line 91 of file GeomUtil.f90.

92  integer(I4B), intent(in) :: ilay, irow, icol, nlay, nrow, ncol
93  integer(I4B) :: get_node
94 
95  if (nlay > 0 .and. nrow > 0 .and. ncol > 0 .and. &
96  ilay > 0 .and. ilay <= nlay .and. &
97  irow > 0 .and. irow <= nrow .and. &
98  icol > 0 .and. icol <= ncol) then
99  get_node = &
100  icol + ncol * (irow - 1) + (ilay - 1) * nrow * ncol
101  else
102  get_node = -1
103  end if
Here is the caller graph for this function:

◆ point_in_polygon()

logical function, public geomutilmodule::point_in_polygon ( real(dp), intent(in)  x,
real(dp), intent(in)  y,
real(dp), dimension(:, :), intent(in), allocatable  poly,
real(dp), intent(in), optional  tol 
)

Vertices and edge points are considered in the polygon. By default, a point must lie exactly on an edge to be considered within the polygon. A tolerance may be specified to instead accept coordinates within tol of an edge.

Adapted from https://stackoverflow.com/a/63436180/6514033,

Parameters
[in]xx point coordinate
[in]yy point coordinate
[in]polypolygon vertices (column-major indexing)
[in]toltolerance (default 0)

Definition at line 30 of file GeomUtil.f90.

31  ! dummy
32  real(DP), intent(in) :: x !< x point coordinate
33  real(DP), intent(in) :: y !< y point coordinate
34  real(DP), allocatable, intent(in) :: poly(:, :) !< polygon vertices (column-major indexing)
35  real(DP), intent(in), optional :: tol !< tolerance (default 0)
36  ! local
37  integer(I4B) :: i, ii, num_verts
38  real(DP) :: xa, xb, ya, yb, c
39  real(DP) :: ltol
40 
41  ltol = dzero
42  if (present(tol)) ltol = tol
43 
44  point_in_polygon = .false.
45  num_verts = size(poly, 2)
46  xa = poly(1, num_verts)
47  ya = poly(2, num_verts)
48 
49  do i = 0, num_verts - 1
50  ii = mod(i, num_verts) + 1
51  xb = poly(1, ii)
52  yb = poly(2, ii)
53 
54  if ((x == xa .and. y == ya) .or. &
55  (x == xb .and. y == yb)) then
56  ! on vertex
57  point_in_polygon = .true.
58  exit
59  else if (ya == yb .and. &
60  abs(y - ya) * abs(xb - xa) <= ltol .and. &
61  between(x, xa, xb)) then
62  ! on (or within tol of) horizontal edge
63  point_in_polygon = .true.
64  exit
65  else if (between(y, ya, yb)) then
66  if ((y == ya .and. yb >= ya) .or. &
67  (y == yb .and. ya >= yb)) then
68  xa = xb
69  ya = yb
70  cycle
71  end if
72  ! cross product
73  c = (xa - x) * (yb - y) - (xb - x) * (ya - y)
74  if (abs(c) <= ltol) then
75  ! on (or within tol of) edge
76  point_in_polygon = .true.
77  exit
78  else if ((ya < yb) .eqv. (c > 0)) then
79  ! ray intersection
80  point_in_polygon = .not. point_in_polygon
81  end if
82  end if
83 
84  xa = xb
85  ya = yb
86  end do
Here is the call graph for this function:
Here is the caller graph for this function:

◆ shared_face()

subroutine, public geomutilmodule::shared_face ( integer(i4b), dimension(:)  iverts1,
integer(i4b), dimension(:)  iverts2,
integer(i4b), intent(out)  iface 
)

Find the lateral (x-y plane) face shared by the given cells. The iface return argument will be 0 if they share no such face, otherwise the index of the shared face in cell 1's vertex array, where face N connects vertex N to vertex N + 1 going clockwise.

Note: assumes the cells are convex and share at most 2 vertices and that both vertex arrays are oriented clockwise.

Definition at line 416 of file GeomUtil.f90.

417  integer(I4B), dimension(:) :: iverts1
418  integer(I4B), dimension(:) :: iverts2
419  integer(I4B), intent(out) :: iface
420  integer(I4B) :: nv1
421  integer(I4B) :: nv2
422  integer(I4B) :: il1, iil1
423  integer(I4B) :: il2, iil2
424  logical(LGP) :: found
425  logical(LGP) :: wrapped
426 
427  iface = 0
428  found = .false.
429  nv1 = size(iverts1)
430  nv2 = size(iverts2)
431  wrapped = iverts1(1) == iverts1(nv1)
432 
433  ! Find a vertex shared by the cells, then check the adjacent faces.
434  ! If the cells share a face, it must be one of these. When looking
435  ! forward in the 1st cell's vertices, look backwards in the 2nd's,
436  ! and vice versa, since a clockwise face in cell 1 must correspond
437  ! to a counter-clockwise face in cell 2.
438  outerloop: do il1 = 1, nv1 - 1
439  do il2 = 1, nv2 - 1
440  if (iverts1(il1) == iverts2(il2)) then
441 
442  iil1 = il1 + 1
443  if (il2 == 1) then
444  iil2 = nv2
445  if (wrapped) iil2 = iil2 - 1
446  else
447  iil2 = il2 - 1
448  end if
449  if (iverts1(iil1) == iverts2(iil2)) then
450  found = .true.
451  iface = il1
452  exit outerloop
453  end if
454 
455  iil2 = il2 + 1
456  if (il1 == 1) then
457  iil1 = nv1
458  if (wrapped) iil1 = iil1 - 1
459  else
460  iil1 = il1 - 1
461  end if
462  if (iverts1(iil1) == iverts2(iil2)) then
463  found = .true.
464  iface = iil1
465  exit outerloop
466  end if
467 
468  end if
469  end do
470  if (found) exit
471  end do outerloop
Here is the caller graph for this function:

◆ skew()

pure real(dp) function, dimension(2), public geomutilmodule::skew ( real(dp), dimension(2), intent(in)  v,
real(dp), dimension(3), intent(in)  s,
logical(lgp), intent(in), optional  invert 
)
Parameters
[in]vvector
[in]sskew matrix entries (top left, top right, bottom right)

Definition at line 157 of file GeomUtil.f90.

158  ! -- dummy
159  real(DP), intent(in) :: v(2) !< vector
160  real(DP), intent(in) :: s(3) !< skew matrix entries (top left, top right, bottom right)
161  logical(LGP), intent(in), optional :: invert
162  real(DP) :: res(2)
163  ! -- local
164  logical(LGP) :: linvert
165  real(DP) :: sxx, sxy, syy
166 
167  ! -- process optional arguments
168  if (present(invert)) then
169  linvert = invert
170  else
171  linvert = .false.
172  end if
173 
174  sxx = s(1)
175  sxy = s(2)
176  syy = s(3)
177  if (.not. linvert) then
178  res(1) = sxx * v(1) + sxy * v(2)
179  res(2) = syy * v(2)
180  else
181  res(2) = v(2) / syy
182  res(1) = (v(1) - sxy * res(2)) / sxx
183  end if
Here is the caller graph for this function:

◆ transform()

subroutine, public geomutilmodule::transform ( real(dp)  xin,
real(dp)  yin,
real(dp)  zin,
real(dp)  xout,
real(dp)  yout,
real(dp)  zout,
real(dp), optional  xorigin,
real(dp), optional  yorigin,
real(dp), optional  zorigin,
real(dp), optional  sinrot,
real(dp), optional  cosrot,
logical(lgp), optional  invert 
)
Parameters
zininput coordinates
zoutoutput coordinates
zoriginorigin coordinates
cosrotsine and cosine of rotation
invertwhether to invert

Definition at line 187 of file GeomUtil.f90.

192  ! -- dummy
193  real(DP) :: xin, yin, zin !< input coordinates
194  real(DP) :: xout, yout, zout !< output coordinates
195  real(DP), optional :: xorigin, yorigin, zorigin !< origin coordinates
196  real(DP), optional :: sinrot, cosrot !< sine and cosine of rotation
197  logical(LGP), optional :: invert !< whether to invert
198  ! -- local
199  logical(LGP) :: ltranslate, lrotate, linvert
200  real(DP) :: x, y
201  real(DP) :: lxorigin, lyorigin, lzorigin
202  real(DP) :: lsinrot, lcosrot
203 
204  ! -- Process option arguments and set defaults and flags
205  call defaults(lxorigin, lyorigin, lzorigin, &
206  lsinrot, lcosrot, linvert, &
207  ltranslate, lrotate, &
208  xorigin, yorigin, zorigin, &
209  sinrot, cosrot, invert)
210 
211  ! -- Apply transformation or its inverse
212  if (.not. linvert) then
213  ! -- Apply transformation to coordinates
214  if (ltranslate) then
215  xout = xin - lxorigin
216  yout = yin - lyorigin
217  zout = zin - lzorigin
218  else
219  xout = lxorigin
220  yout = lyorigin
221  zout = lzorigin
222  end if
223  if (lrotate) then
224  x = xout
225  y = yout
226  xout = x * lcosrot + y * lsinrot
227  yout = -x * lsinrot + y * lcosrot
228  end if
229  else
230  ! -- Apply inverse of transformation to coordinates
231  if (lrotate) then
232  x = xin * lcosrot - yin * lsinrot
233  y = xin * lsinrot + yin * lcosrot
234  else
235  x = xin
236  y = yin
237  end if
238  if (ltranslate) then
239  xout = x + lxorigin
240  yout = y + lyorigin
241  zout = zin + lzorigin
242  end if
243  end if
Here is the call graph for this function:
Here is the caller graph for this function: