#include "implicit_f.inc"
#include "param_c.inc"

Functions/Subroutines
subroutine	checkpara (xp1, yp1, zp1, xp2, yp2, zp2, isk, nodin, skew, ok)
subroutine	projskew (po, sk, isk)
subroutine	inside_parallelepiped (p1, p2, p3, p4, p, ok)
subroutine	checkcyl (xp1, yp1, zp1, xp2, yp2, zp2, nodin, d, ok)
subroutine	inside_cylinder (p1, p2, p, d, ok)
function	vec_length (dimens, x)
subroutine	checksphere (xp, yp, zp, nodin, d, ok)
subroutine	inside_sphere (pc, p, d, ok)

Function/Subroutine Documentation

◆ checkcyl()

subroutine checkcyl	(		xp1,
			yp1,
			zp1,
			xp2,
			yp2,
			zp2,
			nodin,
			d,
		integer	ok )

Definition at line 227 of file rdbox.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER OK
      my_real
     .    xp1,yp1,zp1,xp2,yp2,zp2,nodin(3),d
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      my_real
     .    p1(3),p2(3)
C-----------------------------------------------
 
C-----------------------------------------------
      p1(1) = xp1
      p1(2) = yp1
      p1(3) = zp1
C
      p2(1) = xp2
      p2(2) = yp2
      p2(3) = zp2
C
      CALL inside_cylinder(p1, p2, nodin, d, ok)
C
      RETURN

◆ checkpara()

subroutine checkpara	(		xp1,
			yp1,
			zp1,
			xp2,
			yp2,
			zp2,
		integer	isk,
			nodin,
			skew,
		integer	ok )

Definition at line 37 of file rdbox.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ISK,OK
      my_real
     .    xp1,yp1,zp1,xp2,yp2,zp2,skew(lskew,*),nodin(3)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
      my_real
     .    p1(3),p2(3),p3(3),p4(3),pp2(3)
C-----------------------------------------------
      p1(1) = xp1
      p1(2) = yp1
      p1(3) = zp1
      CALL projskew(p1,skew,isk)
C
      pp2(1) = xp2
      pp2(2) = yp2
      pp2(3) = zp2
      CALL projskew(pp2,skew,isk)
C
      p2(1) = pp2(1)
      p2(2) = p1(2)
      p2(3) = p1(3)
C
      p3(1) = p1(1)
      p3(2) = pp2(2)
      p3(3) = p1(3)
C
      p4(1) = p1(1)
      p4(2) = p1(2)
      p4(3) = pp2(3)
C
      CALL projskew(nodin,skew,isk)
C
      CALL inside_parallelepiped(p1, p2, p3, p4, nodin, ok)
C
      RETURN

◆ checksphere()

subroutine checksphere	(		xp,
			yp,
			zp,
			nodin,
			d,
		integer	ok )

Definition at line 346 of file rdbox.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER OK
      my_real
     .    xp,yp,zp,nodin(3),d
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      my_real
     .    p(3)
C-----------------------------------------------
      p(1) = xp
      p(2) = yp
      p(3) = zp
C
      CALL inside_sphere(p, nodin, d, ok)
C
      RETURN

◆ inside_cylinder()

subroutine inside_cylinder	(		p1,
			p2,
			p,
			d,
		integer	ok )

Definition at line 266 of file rdbox.F.

C-----------------------------------------------
C    The surface and interior of a (finite) cylinder in 3D is defined
C    by an axis, which is the line segment from point P1 to P2, and a
C    diameter D.  The points contained in the volume include:
C    * points at a distance less than or equal to D/2 from the line through P1
C      and P2, whose nearest point on the line through P1 and P2 is, in fact,
C      P1, P2, or any point between them.
C---
C    Input, D, the diameter of the cylinder.
C    Input, P(3), the checked point.
C    Input, P1(3), P2(3), the points defining the cylinder axis.
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER OK
      my_real
     .    p1(3),p2(3),p(3),d
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      my_real
     .  axis(3),axis_length,vec_length,off_axix_component,
     .  p_dot_axis,p_length
C-----------------------------------------------
      axis(1:3) = p2(1:3) - p1(1:3)
      axis_length = vec_length(3,axis)
      IF(axis_length == zero)RETURN
C
      axis(1:3) = axis(1:3) / axis_length
      p_dot_axis = dot_product(p(1:3) - p1(1:3),axis)
C
C  If the point lies below or above the "caps" of the cylinder, we're done.
C
      IF(p_dot_axis < zero .or. axis_length < p_dot_axis)RETURN
C
C  Otherwise, determine the distance from P to the axis.
C
      p_length = vec_length(3, p1(1:3) - (p(1:3) - p_dot_axis * axis(1:3)))
      IF(p_length <= half*d)ok = 1
C
      RETURN

◆ inside_parallelepiped()

subroutine inside_parallelepiped	(		p1,
			p2,
			p3,
			p4,
			p,
		integer	ok )

Definition at line 143 of file rdbox.F.

C  nodes inside parallelepiped in 3D.
C
C
C         *------------------*
C        / .                / \
C       /   .              /   \
C      /     .            /     \
C    P4------------------*       \
C      \        .         \       \
C       \        .         \       \
C        \        .         \       \
C         \       P2.........\.......\
C          \     .            \     /
C           \   .              \   /
C            \ .                \ /
C            P1-----------------P3
C
C
C  Parameters:
C
C    Input, reals: P1(3), P2(3), P3(3), P4(3), four corners
C    of the parallelepiped.  It is assumed that P2, P3 and P4 are
C    immediate neighbors of P1.
C
C    Input, real: P(3), the node to be checked.
C
C    IF integer "OK == 1", the node P
C    is inside the parallelepiped, or on its boundary.
C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER OK
      my_real
     .    p1(3),p2(3),p3(3),p4(3),p(3)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      my_real
     .    dot,suma
C-----------------------------------------------
      dot = dot_product( p(1:3) - p1(1:3),
     .                  p2(1:3) - p1(1:3))
      IF(dot < zero)RETURN
      suma = sum((p2(1:3) - p1(1:3) )**2)
      IF((suma == zero . and. p(1) /= p1(1)) .OR.
     .    suma < dot)RETURN
C---
      dot = dot_product( p(1:3) - p1(1:3),
     .                  p3(1:3) - p1(1:3))
      IF(dot < zero)RETURN
      suma = sum((p3(1:3) - p1(1:3) )**2)
      IF((suma == zero . and. p(2) /= p1(2)) .OR.
     .    suma < dot)RETURN
C---
      dot = dot_product( p(1:3) - p1(1:3),
     .                  p4(1:3) - p1(1:3))
      IF(dot < zero)RETURN
      suma = sum((p4(1:3) - p1(1:3) )**2)
      IF((suma == zero . and. p(3) /= p1(3)) .OR.
     .    suma < dot)RETURN
C---
      ok = 1
C---
      RETURN

◆ inside_sphere()

subroutine inside_sphere	(		pc,
			p,
			d,
		integer	ok )

Definition at line 376 of file rdbox.F.

C-----------------------------------------------
C    Implicit sphere equation:
C
C      SUM ( ( P(1:3) - PC(1:3) )**2 ) = D**2/4
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER OK
      my_real
     .    pc(3),p(3),d
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      my_real
     .    p1(3),p2(3),suma
C-----------------------------------------------
      suma = sum((p(1:3) - pc(1:3))**2)
      suma = four*suma
      IF(suma <= d**2) ok = 1
C
      RETURN

◆ projskew()

subroutine projskew	(		po,
			sk,
		integer	isk )

Definition at line 93 of file rdbox.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ISK
      my_real
     .      po(3),sk(lskew,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,JSK
      my_real
     .    sum,pn(3)
C-----------------------------------------------
      jsk = isk + 1
C
      pn(1) = po(1)*sk(1,jsk) + po(2)*sk(2,jsk) + po(3)*sk(3,jsk)
      sum   = sk(1,jsk)**2 + sk(2,jsk)**2 + sk(3,jsk)**2
      sum   = sqrt(sum)
      pn(1) = pn(1) / sum
C
      pn(2) = po(1)*sk(4,jsk) + po(2)*sk(5,jsk) + po(3)*sk(6,jsk)
      sum   = sk(4,jsk)**2 + sk(5,jsk)**2 + sk(6,jsk)**2
      sum   = sqrt(sum)
      pn(2) = pn(2) / sum
C
      pn(3) = po(1)*sk(7,jsk) + po(2)*sk(8,jsk) + po(3)*sk(9,jsk)
      sum   = sk(7,jsk)**2 + sk(8,jsk)**2 + sk(9,jsk)**2
      sum   = sqrt(sum)
      pn(3) = pn(3) / sum
C
      po(1) = pn(1)
      po(2) = pn(2)
      po(3) = pn(3)
C
      RETURN

◆ vec_length()

function vec_length	(	integer	dimens,
			x )

Definition at line 319 of file rdbox.F.

C-----------------
C  VEC_LENGTH returns the Euclidean length of a vector.
C
      IMPLICIT NONE
C
      INTEGER DIMENS
      my_real
     .  vec_length,x(dimens)
C-------------------------------
      vec_length = sqrt(sum((x(1:dimens))**2))
C
      RETURN

OpenRadioss 2025.1.11 OpenRadioss project

Functions/Subroutines