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)
 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 374 of file GeomUtil.f90.

375  ! dummy
376  real(DP), dimension(:), intent(in) :: xv
377  real(DP), dimension(:), intent(in) :: yv
378  logical(LGP), intent(in), optional :: cw
379  ! result
380  real(DP) :: a
381  integer(I4B) :: s
382 
383  if (present(cw)) then
384  if (cw) then
385  s = 1
386  else
387  s = -1
388  end if
389  else
390  s = 1
391  end if
392 
393  a = -dhalf * sum(xv(:) * cshift(yv(:), s) - cshift(xv(:), s) * yv(:))
394 

◆ 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 470 of file GeomUtil.f90.

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

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

325  ! -- dummy
326  real(DP) :: xorigin, yorigin, zorigin
327  real(DP) :: sinrot, cosrot
328  logical(LGP) :: invert, translate, rotate
329  real(DP), optional :: xorigin_opt, yorigin_opt, zorigin_opt
330  real(DP), optional :: sinrot_opt, cosrot_opt
331  logical(LGP), optional :: invert_opt
332 
333  translate = .false.
334  xorigin = dzero
335  if (present(xorigin_opt)) then
336  xorigin = xorigin_opt
337  translate = .true.
338  end if
339  yorigin = dzero
340  if (present(yorigin_opt)) then
341  yorigin = yorigin_opt
342  translate = .true.
343  end if
344  zorigin = dzero
345  if (present(zorigin_opt)) then
346  zorigin = zorigin_opt
347  translate = .true.
348  end if
349  rotate = .false.
350  sinrot = dzero
351  cosrot = done
352  if (present(sinrot_opt)) then
353  sinrot = sinrot_opt
354  if (present(cosrot_opt)) then
355  cosrot = cosrot_opt
356  else
357  ! -- If sinrot_opt is specified but cosrot_opt is not,
358  ! -- default to corresponding non-negative cosrot_add
359  cosrot = dsqrt(done - sinrot * sinrot)
360  end if
361  rotate = .true.
362  else if (present(cosrot_opt)) then
363  cosrot = cosrot_opt
364  ! -- cosrot_opt is specified but sinrot_opt is not, so
365  ! -- default to corresponding non-negative sinrot_add
366  sinrot = dsqrt(done - cosrot * cosrot)
367  rotate = .true.
368  end if
369  invert = .false.
370  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 99 of file GeomUtil.f90.

100  ! -- dummy variables
101  integer(I4B), intent(in) :: nodenumber
102  integer(I4B), intent(in) :: nrow
103  integer(I4B), intent(in) :: ncol
104  integer(I4B), intent(in) :: nlay
105  integer(I4B), intent(out) :: irow
106  integer(I4B), intent(out) :: icol
107  integer(I4B), intent(out) :: ilay
108  ! -- local variables
109  integer(I4B) :: nodes
110  integer(I4B) :: ij
111 
112  nodes = nlay * nrow * ncol
113  if (nodenumber < 1 .or. nodenumber > nodes) then
114  irow = -1
115  icol = -1
116  ilay = -1
117  else
118  ilay = (nodenumber - 1) / (ncol * nrow) + 1
119  ij = nodenumber - (ilay - 1) * ncol * nrow
120  irow = (ij - 1) / ncol + 1
121  icol = ij - (irow - 1) * ncol
122  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 127 of file GeomUtil.f90.

128  ! -- dummy variables
129  integer(I4B), intent(in) :: nodenumber
130  integer(I4B), intent(in) :: ncpl
131  integer(I4B), intent(in) :: nlay
132  integer(I4B), intent(out) :: icpl
133  integer(I4B), intent(out) :: ilay
134  ! -- local variables
135  integer(I4B) :: nodes
136 
137  nodes = ncpl * nlay
138  if (nodenumber < 1 .or. nodenumber > nodes) then
139  icpl = -1
140  ilay = -1
141  else
142  ilay = (nodenumber - 1) / ncpl + 1
143  icpl = nodenumber - (ilay - 1) * ncpl
144  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 82 of file GeomUtil.f90.

83  integer(I4B), intent(in) :: ilay, irow, icol, nlay, nrow, ncol
84  integer(I4B) :: get_node
85 
86  if (nlay > 0 .and. nrow > 0 .and. ncol > 0 .and. &
87  ilay > 0 .and. ilay <= nlay .and. &
88  irow > 0 .and. irow <= nrow .and. &
89  icol > 0 .and. icol <= ncol) then
90  get_node = &
91  icol + ncol * (irow - 1) + (ilay - 1) * nrow * ncol
92  else
93  get_node = -1
94  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 
)

Vertices and edge points are considered in the polygon. Adapted from https://stackoverflow.com/a/63436180/6514033,

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

Definition at line 26 of file GeomUtil.f90.

27  ! dummy
28  real(DP), intent(in) :: x !< x point coordinate
29  real(DP), intent(in) :: y !< y point coordinate
30  real(DP), allocatable, intent(in) :: poly(:, :) !< polygon vertices (column-major indexing)
31  ! local
32  integer(I4B) :: i, ii, num_verts
33  real(DP) :: xa, xb, ya, yb, c = 0.0_dp
34 
35  point_in_polygon = .false.
36  num_verts = size(poly, 2)
37  xa = poly(1, num_verts)
38  ya = poly(2, num_verts)
39 
40  do i = 0, num_verts - 1
41  ii = mod(i, num_verts) + 1
42  xb = poly(1, ii)
43  yb = poly(2, ii)
44 
45  if ((x == xa .and. y == ya) .or. &
46  (x == xb .and. y == yb)) then
47  ! on vertex
48  point_in_polygon = .true.
49  exit
50  else if (ya == yb .and. &
51  y == ya .and. &
52  between(x, xa, xb)) then
53  ! on horizontal edge
54  point_in_polygon = .true.
55  exit
56  else if (between(y, ya, yb)) then
57  if ((y == ya .and. yb >= ya) .or. &
58  (y == yb .and. ya >= yb)) then
59  xa = xb
60  ya = yb
61  cycle
62  end if
63  ! cross product
64  c = (xa - x) * (yb - y) - (xb - x) * (ya - y)
65  if (c == 0.0_dp) then
66  ! on edge
67  point_in_polygon = .true.
68  exit
69  else if ((ya < yb) .eqv. (c > 0)) then
70  ! ray intersection
71  point_in_polygon = .not. point_in_polygon
72  end if
73  end if
74 
75  xa = xb
76  ya = yb
77  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 407 of file GeomUtil.f90.

408  integer(I4B), dimension(:) :: iverts1
409  integer(I4B), dimension(:) :: iverts2
410  integer(I4B), intent(out) :: iface
411  integer(I4B) :: nv1
412  integer(I4B) :: nv2
413  integer(I4B) :: il1, iil1
414  integer(I4B) :: il2, iil2
415  logical(LGP) :: found
416  logical(LGP) :: wrapped
417 
418  iface = 0
419  found = .false.
420  nv1 = size(iverts1)
421  nv2 = size(iverts2)
422  wrapped = iverts1(1) == iverts1(nv1)
423 
424  ! Find a vertex shared by the cells, then check the adjacent faces.
425  ! If the cells share a face, it must be one of these. When looking
426  ! forward in the 1st cell's vertices, look backwards in the 2nd's,
427  ! and vice versa, since a clockwise face in cell 1 must correspond
428  ! to a counter-clockwise face in cell 2.
429  outerloop: do il1 = 1, nv1 - 1
430  do il2 = 1, nv2 - 1
431  if (iverts1(il1) == iverts2(il2)) then
432 
433  iil1 = il1 + 1
434  if (il2 == 1) then
435  iil2 = nv2
436  if (wrapped) iil2 = iil2 - 1
437  else
438  iil2 = il2 - 1
439  end if
440  if (iverts1(iil1) == iverts2(iil2)) then
441  found = .true.
442  iface = il1
443  exit outerloop
444  end if
445 
446  iil2 = il2 + 1
447  if (il1 == 1) then
448  iil1 = nv1
449  if (wrapped) iil1 = iil1 - 1
450  else
451  iil1 = il1 - 1
452  end if
453  if (iverts1(iil1) == iverts2(iil2)) then
454  found = .true.
455  iface = iil1
456  exit outerloop
457  end if
458 
459  end if
460  end do
461  if (found) exit
462  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 148 of file GeomUtil.f90.

149  ! -- dummy
150  real(DP), intent(in) :: v(2) !< vector
151  real(DP), intent(in) :: s(3) !< skew matrix entries (top left, top right, bottom right)
152  logical(LGP), intent(in), optional :: invert
153  real(DP) :: res(2)
154  ! -- local
155  logical(LGP) :: linvert
156  real(DP) :: sxx, sxy, syy
157 
158  ! -- process optional arguments
159  if (present(invert)) then
160  linvert = invert
161  else
162  linvert = .false.
163  end if
164 
165  sxx = s(1)
166  sxy = s(2)
167  syy = s(3)
168  if (.not. linvert) then
169  res(1) = sxx * v(1) + sxy * v(2)
170  res(2) = syy * v(2)
171  else
172  res(2) = v(2) / syy
173  res(1) = (v(1) - sxy * res(2)) / sxx
174  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 178 of file GeomUtil.f90.

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