OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7buce_crit.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "ige3d_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i7buce_crit (x, nsv, msr, nsn, nmn, itask, xsav, nin, stfn, v, xslv_g, xmsr_g, vslv_g, vmsr_g)

Function/Subroutine Documentation

◆ i7buce_crit()

subroutine i7buce_crit ( x,
integer, dimension(*) nsv,
integer, dimension(*) msr,
integer nsn,
integer nmn,
integer itask,
xsav,
integer nin,
stfn,
v,
xslv_g,
xmsr_g,
vslv_g,
vmsr_g )

Definition at line 28 of file i7buce_crit.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21