OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i21buce_crit.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!|| i21buce_crit ../engine/source/interfaces/intsort/i21buce_crit.F
25!||--- called by ------------------------------------------------------
26!|| i21main_crit_tri ../engine/source/interfaces/intsort/i21main_crit_tri.F
27!||--- uses -----------------------------------------------------
28!|| intstamp_mod ../engine/share/modules/intstamp_mod.F
29!||====================================================================
30 SUBROUTINE i21buce_crit(
31 1 X ,NSV ,NSN ,INTSTAMP,ITASK ,
32 2 XSAV ,NIN ,STFN ,V ,XSLV_G ,
33 3 XMSR_G,VSLV_G,VMSR_G ,X21MSR ,V21MSR ,
34 4 XLOC )
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE intstamp_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43#include "comlock.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com01_c.inc"
48#include "task_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER NSN, ITASK, NSV(*), NIN
53 my_real
54 . X(3,*), V(3,*), XSAV(3,*), STFN(*),
55 . XSLV_G(*), XMSR_G(*), VSLV_G(*), VMSR_G(*),
56 . x21msr(*), v21msr(*), xloc(3,*)
57 TYPE(intstamp_data) INTSTAMP
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER NSNF,NSNL, I, J, II, N, IROT
62 my_real
63 . XSLV(6), VSLV(6), XX, YY, ZZ
64C-----------------------------------------------
65C S o u r c e L i n e s
66C-----------------------------------------------
67C
68C 0- CALCUL DU CRITERE POUR SAVOIR SI ON DOIT TRIER OU NON
69C
70 xslv(1) = -ep30
71 xslv(2) = -ep30
72 xslv(3) = -ep30
73 xslv(4) = ep30
74 xslv(5) = ep30
75 xslv(6) = ep30
76 vslv(1) = -ep30
77 vslv(2) = -ep30
78 vslv(3) = -ep30
79 vslv(4) = ep30
80 vslv(5) = ep30
81 vslv(6) = ep30
82 nsnf = 1 + itask*nsn / nthread
83 nsnl = (itask+1)*nsn / nthread
84C
85 irot=intstamp%IROT
86C
87 IF(irot==0)THEN
88#include "vectorize.inc"
89 DO i=nsnf,nsnl
90 j=nsv(i)
91C stfn = 0 <=> shooting nodes
92 IF(stfn(i)/=zero) THEN
93c xloc in main local frame
94 xloc(1,i)=x(1,j)-intstamp%XG(1)
95 xloc(2,i)=x(2,j)-intstamp%XG(2)
96 xloc(3,i)=x(3,j)-intstamp%XG(3)
97 ENDIF
98 ENDDO
99 ELSE
100#include "vectorize.inc"
101 DO i=nsnf,nsnl
102 j=nsv(i)
103C stfn = 0 <=> shooting nodes
104 IF(stfn(i)/=zero) THEN
105c xloc in main local frame
106 xx=x(1,j)-intstamp%XG(1)
107 yy=x(2,j)-intstamp%XG(2)
108 zz=x(3,j)-intstamp%XG(3)
109 xloc(1,i)=
110 . intstamp%ROT(1)*xx
111 . +intstamp%ROT(2)*yy
112 . +intstamp%ROT(3)*zz
113 xloc(2,i)=
114 . intstamp%ROT(4)*xx
115 . +intstamp%ROT(5)*yy
116 . +intstamp%ROT(6)*zz
117 xloc(3,i)=
118 . intstamp%ROT(7)*xx
119 . +intstamp%ROT(8)*yy
120 . +intstamp%ROT(9)*zz
121 ENDIF
122 ENDDO
123 END IF
124C
125#include "vectorize.inc"
126 DO i=nsnf,nsnl
127 j=nsv(i)
128 IF(stfn(i)/=zero) THEN
129 xslv(1)=max(xslv(1),x(1,j)-xsav(1,i))
130 xslv(2)=max(xslv(2),x(2,j)-xsav(2,i))
131 xslv(3)=max(xslv(3),x(3,j)-xsav(3,i))
132 xslv(4)=min(xslv(4),x(1,j)-xsav(1,i))
133 xslv(5)=min(xslv(5),x(2,j)-xsav(2,i))
134 xslv(6)=min(xslv(6),x(3,j)-xsav(3,i))
135C
136 vslv(1)=max(vslv(1),v(1,j))
137 vslv(2)=max(vslv(2),v(2,j))
138 vslv(3)=max(vslv(3),v(3,j))
139 vslv(4)=min(vslv(4),v(1,j))
140 vslv(5)=min(vslv(5),v(2,j))
141 vslv(6)=min(vslv(6),v(3,j))
142 ENDIF
143C STFN(I)=MAX(STFN(I),ZERO)
144 END DO
145C
146#include "lockon.inc"
147 xslv_g(1)=max(xslv_g(1),xslv(1))
148 xslv_g(2)=max(xslv_g(2),xslv(2))
149 xslv_g(3)=max(xslv_g(3),xslv(3))
150 xslv_g(4)=min(xslv_g(4),xslv(4))
151 xslv_g(5)=min(xslv_g(5),xslv(5))
152 xslv_g(6)=min(xslv_g(6),xslv(6))
153C
154 vslv_g(1)=max(vslv_g(1),vslv(1))
155 vslv_g(2)=max(vslv_g(2),vslv(2))
156 vslv_g(3)=max(vslv_g(3),vslv(3))
157 vslv_g(4)=min(vslv_g(4),vslv(4))
158 vslv_g(5)=min(vslv_g(5),vslv(5))
159 vslv_g(6)=min(vslv_g(6),vslv(6))
160#include "lockoff.inc"
161C
162 xmsr_g(1)=intstamp%D(1)-xsav(1,nsn+1)
163 xmsr_g(2)=intstamp%D(2)-xsav(2,nsn+1)
164 xmsr_g(3)=intstamp%D(3)-xsav(3,nsn+1)
165 xmsr_g(4)=intstamp%D(1)-xsav(1,nsn+1)
166 xmsr_g(5)=intstamp%D(2)-xsav(2,nsn+1)
167 xmsr_g(6)=intstamp%D(3)-xsav(3,nsn+1)
168C
169 vmsr_g(1)=intstamp%V(1)
170 vmsr_g(2)=intstamp%V(2)
171 vmsr_g(3)=intstamp%V(3)
172 vmsr_g(4)=intstamp%V(1)
173 vmsr_g(5)=intstamp%V(2)
174 vmsr_g(6)=intstamp%V(3)
175C
176 IF(irot/=0)THEN
177 xx=
178 . intstamp%ROT(1)*intstamp%BRACKET(1)
179 . +intstamp%ROT(4)*intstamp%BRACKET(2)
180 . +intstamp%ROT(7)*intstamp%BRACKET(3)
181 yy=
182 . intstamp%ROT(2)*intstamp%BRACKET(1)
183 . +intstamp%ROT(5)*intstamp%BRACKET(2)
184 . +intstamp%ROT(8)*intstamp%BRACKET(3)
185 zz=
186 . intstamp%ROT(3)*intstamp%BRACKET(1)
187 . +intstamp%ROT(6)*intstamp%BRACKET(2)
188 . +intstamp%ROT(9)*intstamp%BRACKET(3)
189 xx=xx-xsav(1,nsn+2)
190 yy=yy-xsav(2,nsn+2)
191 zz=zz-xsav(3,nsn+2)
192 x21msr(1)=xx
193 x21msr(2)=yy
194 x21msr(3)=zz
195 v21msr(1)= intstamp%VR(2)*intstamp%BRACKET(3)
196 . -intstamp%VR(3)*intstamp%BRACKET(2)
197 v21msr(2)= intstamp%VR(3)*intstamp%BRACKET(1)
198 . -intstamp%VR(1)*intstamp%BRACKET(3)
199 v21msr(3)= intstamp%VR(1)*intstamp%BRACKET(2)
200 . -intstamp%VR(2)*intstamp%BRACKET(1)
201 ELSE
202 x21msr(1)=zero
203 x21msr(2)=zero
204 x21msr(3)=zero
205 v21msr(1)=zero
206 v21msr(2)=zero
207 v21msr(3)=zero
208 END IF
209C
210
211C dist calcule une fois pour toutes les interfaces dans I21_ICRIT
212C
213 IF(nspmd==1) THEN
214C traitement deplace dans SPMD_GET_STIF en SPMD
215 DO i=nsnf,nsnl
216 stfn(i)=max(stfn(i),zero)
217 ENDDO
218 ENDIF
219C
220 RETURN
221 END
i21buce_crit
subroutine i21buce_crit(x, nsv, nsn, intstamp, itask, xsav, nin, stfn, v, xslv_g, xmsr_g, vslv_g, vmsr_g, x21msr, v21msr, xloc)
Definition i21buce_crit.F:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
intstamp_mod
Definition intstamp_mod.F:38
intstamp_mod::intstamp_data
Definition intstamp_mod.F:46