OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7buce_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!|| i7buce_crit ../engine/source/interfaces/intsort/i7buce_crit.F
25!||--- called by ------------------------------------------------------
26!|| i7main_crit_tri ../engine/source/interfaces/intsort/i7main_crit_tri.F
27!||====================================================================
28 SUBROUTINE i7buce_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"
43#include "ige3d_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER NSN,NMN,ITASK,NSV(*),MSR(*), NIN
48 my_real
49 . X(3,*), V(3,*), XSAV(3,*), STFN(*),
50 . xslv_g(*),xmsr_g(*), vslv_g(*), vmsr_g(*)
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54 INTEGER NSNF,NMNF,NSNL,NMNL,I, J, II, N
55 my_real
56 . XSLV(6),XMSR(6), VSLV(6), VMSR(6)
57C-----------------------------------------------
58C S o u r c e L i n e s
59C-----------------------------------------------
60C
61C 0- CALCUL DU CRITERE POUR SAVOIR SI ON DOIT TRIER OU NON
62C
63C
64 DO i = 1, 3
65 xslv(i) = -ep30
66 xslv(3+i) = ep30
67 xmsr(i) = -ep30
68 xmsr(3+i) = ep30
69 vslv(i) = -ep30
70 vslv(3+i) = ep30
71 vmsr(i) = -ep30
72 vmsr(3+i) = ep30
73 END DO
74 nsnf = 1 + itask*nsn / nthread
75 nsnl = (itask+1)*nsn / nthread
76 nmnf = 1 + itask*nmn / nthread
77 nmnl = (itask+1)*nmn / nthread
78
79C=======================================================================
80
81 IF(nsn+nmn < numnod+numfakenodigeo)THEN
82C
83!#include "simd.inc" --> this loop can't be vectorized because there are some dependencies
84!$OMP DO SCHEDULE(guided)
85 DO i=1,nsn
86 j=nsv(i)
87 IF(stfn(i)/=zero) THEN
88
89 xslv(1)=max(xslv(1),x(1,j)-xsav(1,i))
90 xslv(2)=max(xslv(2),x(2,j)-xsav(2,i))
91 xslv(3)=max(xslv(3),x(3,j)-xsav(3,i))
92 xslv(4)=min(xslv(4),x(1,j)-xsav(1,i))
93 xslv(5)=min(xslv(5),x(2,j)-xsav(2,i))
94 xslv(6)=min(xslv(6),x(3,j)-xsav(3,i))
95
96 vslv(1)=max(vslv(1),v(1,j))
97 vslv(2)=max(vslv(2),v(2,j))
98 vslv(3)=max(vslv(3),v(3,j))
99 vslv(4)=min(vslv(4),v(1,j))
100 vslv(5)=min(vslv(5),v(2,j))
101 vslv(6)=min(vslv(6),v(3,j))
102
103 ENDIF
104 END DO
105!$OMP END DO NOWAIT
106
107!$OMP DO SCHEDULE(guided)
108 DO i=1,nmn
109 ii = i+nsn
110 j=msr(i)
111 IF(j>0) THEN
112 xmsr(1)=max(xmsr(1),x(1,j)-xsav(1,ii))
113 xmsr(2)=max(xmsr(2),x(2,j)-xsav(2,ii))
114 xmsr(3)=max(xmsr(3),x(3,j)-xsav(3,ii))
115 xmsr(4)=min(xmsr(4),x(1,j)-xsav(1,ii))
116 xmsr(5)=min(xmsr(5),x(2,j)-xsav(2,ii))
117 xmsr(6)=min(xmsr(6),x(3,j)-xsav(3,ii))
118C
119 vmsr(1)=max(vmsr(1),v(1,j))
120 vmsr(2)=max(vmsr(2),v(2,j))
121 vmsr(3)=max(vmsr(3),v(3,j))
122 vmsr(4)=min(vmsr(4),v(1,j))
123 vmsr(5)=min(vmsr(5),v(2,j))
124 vmsr(6)=min(vmsr(6),v(3,j))
125 ENDIF
126 END DO
127!$OMP END DO NOWAIT
128 ELSE
129C
130!$OMP DO SCHEDULE(guided)
131 DO i=1,nsn
132 j=nsv(i)
133 IF(stfn(i)/=zero) THEN
134
135 xslv(1)=max(xslv(1),x(1,j)-xsav(1,j))
136 xslv(2)=max(xslv(2),x(2,j)-xsav(2,j))
137 xslv(3)=max(xslv(3),x(3,j)-xsav(3,j))
138 xslv(4)=min(xslv(4),x(1,j)-xsav(1,j))
139 xslv(5)=min(xslv(5),x(2,j)-xsav(2,j))
140 xslv(6)=min(xslv(6),x(3,j)-xsav(3,j))
141
142 vslv(1)=max(vslv(1),v(1,j))
143 vslv(2)=max(vslv(2),v(2,j))
144 vslv(3)=max(vslv(3),v(3,j))
145 vslv(4)=min(vslv(4),v(1,j))
146 vslv(5)=min(vslv(5),v(2,j))
147 vslv(6)=min(vslv(6),v(3,j))
148
149 ENDIF
150 END DO
151!$OMP END DO NOWAIT
152
153!$OMP DO SCHEDULE(guided)
154 DO i=1,nmn
155 j=msr(i)
156 IF(j>0) THEN
157 xmsr(1)=max(xmsr(1),x(1,j)-xsav(1,j))
158 xmsr(2)=max(xmsr(2),x(2,j)-xsav(2,j))
159 xmsr(3)=max(xmsr(3),x(3,j)-xsav(3,j))
160 xmsr(4)=min(xmsr(4),x(1,j)-xsav(1,j))
161 xmsr(5)=min(xmsr(5),x(2,j)-xsav(2,j))
162 xmsr(6)=min(xmsr(6),x(3,j)-xsav(3,j))
163C
164 vmsr(1)=max(vmsr(1),v(1,j))
165 vmsr(2)=max(vmsr(2),v(2,j))
166 vmsr(3)=max(vmsr(3),v(3,j))
167 vmsr(4)=min(vmsr(4),v(1,j))
168 vmsr(5)=min(vmsr(5),v(2,j))
169 vmsr(6)=min(vmsr(6),v(3,j))
170 ENDIF
171 ENDDO
172!$OMP END DO NOWAIT
173 ENDIF
174C dist calcule une fois pour toutes les interfaces dans COMCRIT (ci-dessous)
175C
176 IF(nspmd==1) THEN
177!$OMP DO SCHEDULE(guided)
178 DO i=1,nsn
179 stfn(i)=max(stfn(i),zero)
180 ENDDO
181!$OMP END DO NOWAIT
182 ENDIF
183C
184!$OMP CRITICAL (I7BUCE_CRIT_REDUCTION)
185C
186 xslv_g(1)=max(xslv_g(1),xslv(1))
187 xslv_g(2)=max(xslv_g(2),xslv(2))
188 xslv_g(3)=max(xslv_g(3),xslv(3))
189 xslv_g(4)=min(xslv_g(4),xslv(4))
190 xslv_g(5)=min(xslv_g(5),xslv(5))
191 xslv_g(6)=min(xslv_g(6),xslv(6))
192 xmsr_g(1)=max(xmsr_g(1),xmsr(1))
193 xmsr_g(2)=max(xmsr_g(2),xmsr(2))
194 xmsr_g(3)=max(xmsr_g(3),xmsr(3))
195 xmsr_g(4)=min(xmsr_g(4),xmsr(4))
196 xmsr_g(5)=min(xmsr_g(5),xmsr(5))
197 xmsr_g(6)=min(xmsr_g(6),xmsr(6))
198C
199 vslv_g(1)=max(vslv_g(1),vslv(1))
200 vslv_g(2)=max(vslv_g(2),vslv(2))
201 vslv_g(3)=max(vslv_g(3),vslv(3))
202 vslv_g(4)=min(vslv_g(4),vslv(4))
203 vslv_g(5)=min(vslv_g(5),vslv(5))
204 vslv_g(6)=min(vslv_g(6),vslv(6))
205 vmsr_g(1)=max(vmsr_g(1),vmsr(1))
206 vmsr_g(2)=max(vmsr_g(2),vmsr(2))
207 vmsr_g(3)=max(vmsr_g(3),vmsr(3))
208 vmsr_g(4)=min(vmsr_g(4),vmsr(4))
209 vmsr_g(5)=min(vmsr_g(5),vmsr(5))
210 vmsr_g(6)=min(vmsr_g(6),vmsr(6))
211!$OMP END CRITICAL (I7BUCE_CRIT_REDUCTION)
212! A barrier must be called before the first use of *_G
213C
214 RETURN
215 END
216C
i7buce_crit
subroutine i7buce_crit(x, nsv, msr, nsn, nmn, itask, xsav, nin, stfn, v, xslv_g, xmsr_g, vslv_g, vmsr_g)
Definition i7buce_crit.F:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21