OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cr_spline_length.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| cr_spline_length ../common_source/tools/interpolation/cr_spline_length.F
25!||--- called by ------------------------------------------------------
26!|| detcord ../starter/source/initial_conditions/detonation/detcord.F
27!||--- calls -----------------------------------------------------
28!|| cr_spline_interpol ../common_source/tools/interpolation/cr_spline_interpol.F
29!|| cr_spline_knots ../common_source/tools/interpolation/cr_spline_knots.F
30!||====================================================================
31 SUBROUTINE cr_spline_length(LOCAL_PT,ALPHA,T,LEN)
32C-----------------------------------------------
33C D e s c r i p t i o n
34C-----------------------------------------------
35 !compute SPLINE length with third order method (SIMPSON)
36 ! INPUT - LOCAL_PT : 4 control points P0,P1,P2,P3
37 ! INPUT - ALPHA : CCR SPLINE PARAMETER
38 ! INPUT - T : position [0,1] on SPLINE [T1,T2]. 1.0 means full spline length
39 ! OUTPUT - LEN : length of the curve parametrised with t in [0,T] T<=1.0
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 my_real,INTENT(IN) :: local_pt(4,3),alpha ,t
48 my_real,INTENT(INOUT) :: len
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 my_real :: knots(4),c(3),c_d(3),c_dd(3),t_
53 my_real :: val(6),k(2)
54 INTEGER :: ITER,NITER
55C-----------------------------------------------
56C S o u r c e L i n e s
57C-----------------------------------------------
58 CALL cr_spline_knots(local_pt, knots, alpha)
59 len = 0.
60 niter=20
61 DO iter=1,niter-1
62 !first point
63 t_=t*(1.*iter-1.)/(niter-1.)
64 CALL cr_spline_interpol(local_pt,knots,t_,c,c_d,c_dd)
65 val(1)=sqrt(dot_product(c_d(1:3),c_d(1:3)))
66 k(1)=knots(2)+t_*(knots(3)-knots(2))
67 !middle point
68 t_=(1.*iter-1.)/(1.*niter-1.) + 0.5*1./(niter-1.)
69 t_=t_*t
70 CALL cr_spline_interpol(local_pt,knots,t_,c,c_d,c_dd)
71 val(2)=sqrt(dot_product(c_d(1:3),c_d(1:3)))
72 !last point
73 t_=t*(1.*iter)/(niter-1.)
74 CALL cr_spline_interpol(local_pt,knots,t_,c,c_d,c_dd)
75 val(3)=sqrt(dot_product(c_d(1:3),c_d(1:3)))
76 k(2)=knots(2)+t_*(knots(3)-knots(2))
77 !length
78 len = len+(k(2)-k(1))/6. * (val(1)+4.*val(2)+val(3))
79 ENDDO
80 END SUBROUTINE cr_spline_length
#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)
subroutine cr_spline_length(local_pt, alpha, t, len)
#define alpha
Definition eval.h:35