OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25buce_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!|| i25buce_crit ../engine/source/interfaces/intsort/i25buce_crit.f
25!||--- called by ------------------------------------------------------
26!|| i25main_crit_tri ../engine/source/interfaces/intsort/i25main_crit_tri.F
27!||====================================================================
28 SUBROUTINE i25buce_crit(
29 1 X ,NSV ,MSR ,NSN ,NMN ,
30 2 ITASK ,XSAV ,NIN ,STFN ,V ,
31 3 XSLV_G ,XMSR_G ,VSLV_G ,VMSR_G )
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36#include "comlock.inc"
37C-----------------------------------------------
38C C o m m o n B l o c k s
39C-----------------------------------------------
40#include "com01_c.inc"
41#include "com04_c.inc"
42#include "task_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER NSN,NMN,ITASK,NIN,NSV(*),MSR(*)
47 my_real
48 . X(3,*), V(3,*), XSAV(3,*), STFN(*),
49 . xslv_g(*),xmsr_g(*), vslv_g(*), vmsr_g(*)
50C-----------------------------------------------
51C L o c a l V a r i a b l e s
52C-----------------------------------------------
53 INTEGER NSNF,NMNF,NSNL,NMNL,I, J, K, II, N,IAD,NES,JG,
54 . IE, I1, I2, N1, N2
55 my_real
56 . xslv(18),xmsr(12), vslv(6), vmsr(6)
57C-----------------------------------------------
58C
59C 0- CALCUL DU CRITERE POUR SAVOIR SI ON DOIT TRIER OU NON
60C
61C
62 xslv(1) = -ep30
63 xslv(2) = -ep30
64 xslv(3) = -ep30
65 xslv(4) = ep30
66 xslv(5) = ep30
67 xslv(6) = ep30
68
69 xmsr(1) = -ep30
70 xmsr(2) = -ep30
71 xmsr(3) = -ep30
72 xmsr(4) = ep30
73 xmsr(5) = ep30
74 xmsr(6) = ep30
75
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
83 vmsr(1) = -ep30
84 vmsr(2) = -ep30
85 vmsr(3) = -ep30
86 vmsr(4) = ep30
87 vmsr(5) = ep30
88 vmsr(6) = ep30
89
90 nsnf = 1 + itask*nsn / nthread
91 nsnl = (itask+1)*nsn / nthread
92 nmnf = 1 + itask*nmn / nthread
93 nmnl = (itask+1)*nmn / nthread
94
95C=======================================================================
96 IF(nsn+nmn < numnod)THEN
97C
98#include "vectorize.inc"
99 DO i=nsnf,nsnl
100 j=nsv(i)
101 IF(stfn(i)/=zero .AND. j<=numnod) THEN
102
103 xslv(1) =max(xslv(1),x(1,j)-xsav(1,i))
104 xslv(2) =max(xslv(2),x(2,j)-xsav(2,i))
105 xslv(3) =max(xslv(3),x(3,j)-xsav(3,i))
106 xslv(4) =min(xslv(4),x(1,j)-xsav(1,i))
107 xslv(5) =min(xslv(5),x(2,j)-xsav(2,i))
108 xslv(6) =min(xslv(6),x(3,j)-xsav(3,i))
109
110 vslv(1)=max(vslv(1),v(1,j))
111 vslv(2)=max(vslv(2),v(2,j))
112 vslv(3)=max(vslv(3),v(3,j))
113 vslv(4)=min(vslv(4),v(1,j))
114 vslv(5)=min(vslv(5),v(2,j))
115 vslv(6)=min(vslv(6),v(3,j))
116 ENDIF
117 END DO
118#include "vectorize.inc"
119 DO i=nmnf,nmnl
120 ii = i+nsn
121 j=msr(i)
122 IF(j>0) THEN
123
124 xmsr(1) =max(xmsr(1),x(1,j)-xsav(1,ii))
125 xmsr(2) =max(xmsr(2),x(2,j)-xsav(2,ii))
126 xmsr(3) =max(xmsr(3),x(3,j)-xsav(3,ii))
127 xmsr(4) =min(xmsr(4),x(1,j)-xsav(1,ii))
128 xmsr(5) =min(xmsr(5),x(2,j)-xsav(2,ii))
129 xmsr(6) =min(xmsr(6),x(3,j)-xsav(3,ii))
130
131 vmsr(1)=max(vmsr(1),v(1,j))
132 vmsr(2)=max(vmsr(2),v(2,j))
133 vmsr(3)=max(vmsr(3),v(3,j))
134 vmsr(4)=min(vmsr(4),v(1,j))
135 vmsr(5)=min(vmsr(5),v(2,j))
136 vmsr(6)=min(vmsr(6),v(3,j))
137 ENDIF
138 END DO
139 ELSE
140C
141#include "vectorize.inc"
142 DO i=nsnf,nsnl
143 j=nsv(i)
144 IF(stfn(i)/=zero .AND. j<=numnod) THEN
145
146 xslv(1)=max(xslv(1),x(1,j)-xsav(1,j))
147 xslv(2)=max(xslv(2),x(2,j)-xsav(2,j))
148 xslv(3)=max(xslv(3),x(3,j)-xsav(3,j))
149 xslv(4)=min(xslv(4),x(1,j)-xsav(1,j))
150 xslv(5)=min(xslv(5),x(2,j)-xsav(2,j))
151 xslv(6)=min(xslv(6),x(3,j)-xsav(3,j))
152
153 vslv(1)=max(vslv(1),v(1,j))
154 vslv(2)=max(vslv(2),v(2,j))
155 vslv(3)=max(vslv(3),v(3,j))
156 vslv(4)=min(vslv(4),v(1,j))
157 vslv(5)=min(vslv(5),v(2,j))
158 vslv(6)=min(vslv(6),v(3,j))
159C
160
161 ENDIF
162 END DO
163#include "vectorize.inc"
164 DO i=nmnf,nmnl
165 j=msr(i)
166 IF(j>0) THEN
167
168 xmsr(1)=max(xmsr(1),x(1,j)-xsav(1,j))
169 xmsr(2)=max(xmsr(2),x(2,j)-xsav(2,j))
170 xmsr(3)=max(xmsr(3),x(3,j)-xsav(3,j))
171 xmsr(4)=min(xmsr(4),x(1,j)-xsav(1,j))
172 xmsr(5)=min(xmsr(5),x(2,j)-xsav(2,j))
173 xmsr(6)=min(xmsr(6),x(3,j)-xsav(3,j))
174
175 vmsr(1)=max(vmsr(1),v(1,j))
176 vmsr(2)=max(vmsr(2),v(2,j))
177 vmsr(3)=max(vmsr(3),v(3,j))
178 vmsr(4)=min(vmsr(4),v(1,j))
179 vmsr(5)=min(vmsr(5),v(2,j))
180 vmsr(6)=min(vmsr(6),v(3,j))
181 ENDIF
182 ENDDO
183 ENDIF
184C dist calcule une fois pour toutes les interfaces dans COMCRIT (ci-dessous)
185C
186 IF(nspmd==1) THEN
187C traitement deplace dans SPMD_GET_STIF en SPMD
188 DO i=nsnf,nsnl
189 stfn(i)=max(stfn(i),zero)
190 ENDDO
191 ENDIF
192C
193#include "lockon.inc"
194C
195 xslv_g(1)=max(xslv_g(1),xslv(1))
196 xslv_g(2)=max(xslv_g(2),xslv(2))
197 xslv_g(3)=max(xslv_g(3),xslv(3))
198 xslv_g(4)=min(xslv_g(4),xslv(4))
199 xslv_g(5)=min(xslv_g(5),xslv(5))
200 xslv_g(6)=min(xslv_g(6),xslv(6))
201
202 xmsr_g(1)=max(xmsr_g(1),xmsr(1))
203 xmsr_g(2)=max(xmsr_g(2),xmsr(2))
204 xmsr_g(3)=max(xmsr_g(3),xmsr(3))
205 xmsr_g(4)=min(xmsr_g(4),xmsr(4))
206 xmsr_g(5)=min(xmsr_g(5),xmsr(5))
207 xmsr_g(6)=min(xmsr_g(6),xmsr(6))
208
209 vslv_g(1)=max(vslv_g(1),vslv(1))
210 vslv_g(2)=max(vslv_g(2),vslv(2))
211 vslv_g(3)=max(vslv_g(3),vslv(3))
212 vslv_g(4)=min(vslv_g(4),vslv(4))
213 vslv_g(5)=min(vslv_g(5),vslv(5))
214 vslv_g(6)=min(vslv_g(6),vslv(6))
215 vmsr_g(1)=max(vmsr_g(1),vmsr(1))
216 vmsr_g(2)=max(vmsr_g(2),vmsr(2))
217 vmsr_g(3)=max(vmsr_g(3),vmsr(3))
218 vmsr_g(4)=min(vmsr_g(4),vmsr(4))
219 vmsr_g(5)=min(vmsr_g(5),vmsr(5))
220 vmsr_g(6)=min(vmsr_g(6),vmsr(6))
221C
222#include "lockoff.inc"
223C
224 RETURN
225 END
226C
i25buce_crit
subroutine i25buce_crit(x, nsv, msr, nsn, nmn, itask, xsav, nin, stfn, v, xslv_g, xmsr_g, vslv_g, vmsr_g)
Definition i25buce_crit.F:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21