OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cr_spline_point_proj.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cr_spline_point_proj (local_pt, z, alpha, zh, h, t)

Function/Subroutine Documentation

◆ cr_spline_point_proj()

subroutine cr_spline_point_proj ( dimension(4,3), intent(in) local_pt,
dimension(3), intent(in) z,
intent(in) alpha,
dimension(3), intent(inout) zh,
intent(inout) h,
t )

Definition at line 31 of file cr_spline_point_proj.F.

32C-----------------------------------------------
33C D e s c r i p t i o n
34C-----------------------------------------------
35 !COMPUTE PROJECTION ZH ON A GIVEN POINT Z ALONG THE SPLINE INTERPOLATION
36 ! INPUT - LOCAL_PT : 4 control points P0,P1,P2,P3
37 ! INPUT - Z : TEST POINt to project
38 ! INPUT - ALPHA : CCR SPLINE PARAMETER
39 ! OUTPUT - Zh : projected point
40 ! OUTPUT - H : distance from spline
41 ! OUTPUT - T : position [0,1] on SPLINE [T1,T2]
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 my_real,INTENT(IN) :: local_pt(4,3),z(3),alpha
50 my_real,INTENT(INOUT) :: zh(3),h
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54 my_real :: knots(4),c(3),c_d(3),c_dd(3),t
55 my_real :: f,f_d
56 INTEGER :: ITER
57C-----------------------------------------------
58C S o u r c e L i n e s
59C-----------------------------------------------
60 t = 0.5
61 CALL cr_spline_knots(local_pt, knots, alpha)
62 DO iter=1,20
63 CALL cr_spline_interpol(local_pt,knots,t,c,c_d,c_dd)
64 f = dot_product(c(1:3)-z(1:3), c_d(1:3))
65 f_d = dot_product(c_d(1:3), c_d(1:3)) + dot_product(c(1:3)-z(1:3), c_dd(1:3))
66 IF(f_d /= 0.)THEN
67 t=t-f/f_d
68 ELSE
69 IF(f == 0.)EXIT
70 print *, "/DFS/DETCORD : error, convergence issue"
71 stop 220022
72 ENDIF
73 IF(t<0.)t=1e-10
74 IF(t>1.)t=1.-1e-10
75 ENDDO
76 CALL cr_spline_interpol(local_pt,knots,t,c,c_d,c_dd)
77 zh(1:3) = c(1:3)
78 h=sqrt(dot_product(c(1:3)-z(1:3),c(1:3)-z(1:3)))
#define my_real
Definition cppsort.cpp:32
subroutine cr_spline_interpol(pts, knots, t, c, c_d, c_dd)
subroutine cr_spline_knots(pts, knots, alpha)
#define alpha
Definition eval.h:35