OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11buce_crit.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "task_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i11buce_crit (x, nsv, msr, nsn, nmn, itask, xsav, penis, penim, inacti, nrts, nrtm, stfs, cand_s, v, xslv_g, xmsr_g, vslv_g, vmsr_g, nin)

Function/Subroutine Documentation

◆ i11buce_crit()

subroutine i11buce_crit ( x,
integer, dimension(*) nsv,
integer, dimension(*) msr,
integer nsn,
integer nmn,
integer itask,
xsav,
penis,
penim,
integer inacti,
integer nrts,
integer nrtm,
stfs,
integer, dimension(*) cand_s,
v,
xslv_g,
xmsr_g,
vslv_g,
vmsr_g,
integer nin )

Definition at line 30 of file i11buce_crit.F.

35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39#include "comlock.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "com01_c.inc"
44#include "com04_c.inc"
45#include "com08_c.inc"
46#include "task_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER NSN,NMN,ITASK,NSV(*),MSR(*),INACTI,CAND_S(*),
51 . NRTM,NRTS,NIN
52 my_real
53 . x(3,*),xsav(3,*),penis(2,*),penim(2,*),
54 . xslv_g(*),xmsr_g(*),stfs(*), v(3,*),
55 . vslv_g(*), vmsr_g(*)
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER NSNF,NMNF,NSNL,NMNL,I,J,II,
60 . NRTSF, NRTSL, NRTMF, NRTML
61 my_real
62 . xslv(6),xmsr(6), vslv(6), vmsr(6)
63C-----------------------------------------------
64C S o u r c e L i n e s
65C-----------------------------------------------
66C
67C maj pene
68C
69 nrtsf = 1 + itask * nrts / nthread
70 nrtsl = (itask+1) * nrts / nthread
71 IF(inacti==5.OR.inacti==6)THEN
72 nrtmf = 1 + itask * nrtm / nthread
73 nrtml = (itask+1) * nrtm / nthread
74
75C-----------------------------------------------
76C maj PENIS sur partie non locale
77C-----------------------------------------------
78 IF(nspmd>1 .AND. tt > zero) THEN ! frontieres partiellement baties a tt=0
79C
80C Partie non parallele smt
81C
82!$OMP SINGLE
83
84 CALL spmd_get_penis(penis,nin)
85
86C Fin Partie non parallele smt
87!$OMP END SINGLE
88
89 END IF
90C-----------------------------------------------
91!$OMP DO SCHEDULE(guided)
92 DO i=1,nrts
93 penis(1,i)=min(penis(1,i),penis(2,i))
94 penis(2,i)=zero
95 ENDDO
96!$OMP END DO NOWAIT
97!$OMP DO SCHEDULE(guided)
98 DO i=1,nrtm
99 penim(1,i)=min(penim(1,i),penim(2,i))
100 penim(2,i)=zero
101 ENDDO
102!$OMP END DO NOWAIT
103 ENDIF
104C
105C si NSPMD > 1 traitement effectue dans SPMD_GET_STIF11
106C car reperage comm sur stfs < ZERO
107C
108 IF (nspmd==1) THEN
109!$OMP DO SCHEDULE(guided)
110 DO i=1,nrts
111 stfs(i)=max(stfs(i),zero)
112 ENDDO
113!$OMP END DO NOWAIT
114 END IF
115C
116C 0- CALCUL DU CRITERE POUR SAVOIR SI ON DOIT TRIER OU NON
117C
118 xslv(1) = -ep30
119 xslv(2) = -ep30
120 xslv(3) = -ep30
121 xslv(4) = ep30
122 xslv(5) = ep30
123 xslv(6) = ep30
124 xmsr(1) = -ep30
125 xmsr(2) = -ep30
126 xmsr(3) = -ep30
127 xmsr(4) = ep30
128 xmsr(5) = ep30
129 xmsr(6) = ep30
130C
131 vslv(1) = -ep30
132 vslv(2) = -ep30
133 vslv(3) = -ep30
134 vslv(4) = ep30
135 vslv(5) = ep30
136 vslv(6) = ep30
137 vmsr(1) = -ep30
138 vmsr(2) = -ep30
139 vmsr(3) = -ep30
140 vmsr(4) = ep30
141 vmsr(5) = ep30
142 vmsr(6) = ep30
143C
144 nsnf = 1 + itask*nsn / nthread
145 nsnl = (itask+1)*nsn / nthread
146 nmnf = 1 + itask*nmn / nthread
147 nmnl = (itask+1)*nmn / nthread
148C
149 IF(nsn+nmn<numnod)THEN
150C
151!$OMP DO SCHEDULE(guided)
152 DO i=1,nsn
153 j=nsv(i)
154C shooting nodes
155 IF(j>0) THEN
156 xslv(1)=max(xslv(1),x(1,j)-xsav(1,i))
157 xslv(2)=max(xslv(2),x(2,j)-xsav(2,i))
158 xslv(3)=max(xslv(3),x(3,j)-xsav(3,i))
159 xslv(4)=min(xslv(4),x(1,j)-xsav(1,i))
160 xslv(5)=min(xslv(5),x(2,j)-xsav(2,i))
161 xslv(6)=min(xslv(6),x(3,j)-xsav(3,i))
162C
163 vslv(1)=max(vslv(1),v(1,j))
164 vslv(2)=max(vslv(2),v(2,j))
165 vslv(3)=max(vslv(3),v(3,j))
166 vslv(4)=min(vslv(4),v(1,j))
167 vslv(5)=min(vslv(5),v(2,j))
168 vslv(6)=min(vslv(6),v(3,j))
169 ENDIF
170 END DO
171!$OMP END DO NOWAIT
172
173!$OMP DO SCHEDULE(guided)
174 DO i=1,nmn
175 ii = i+nsn
176 j=msr(i)
177C shooting nodes
178 IF(j>0) THEN
179 xmsr(1)=max(xmsr(1),x(1,j)-xsav(1,ii))
180 xmsr(2)=max(xmsr(2),x(2,j)-xsav(2,ii))
181 xmsr(3)=max(xmsr(3),x(3,j)-xsav(3,ii))
182 xmsr(4)=min(xmsr(4),x(1,j)-xsav(1,ii))
183 xmsr(5)=min(xmsr(5),x(2,j)-xsav(2,ii))
184 xmsr(6)=min(xmsr(6),x(3,j)-xsav(3,ii))
185C
186 vmsr(1)=max(vmsr(1),v(1,j))
187 vmsr(2)=max(vmsr(2),v(2,j))
188 vmsr(3)=max(vmsr(3),v(3,j))
189 vmsr(4)=min(vmsr(4),v(1,j))
190 vmsr(5)=min(vmsr(5),v(2,j))
191 vmsr(6)=min(vmsr(6),v(3,j))
192C
193 ENDIF
194 END DO
195!$OMP END DO NOWAIT
196 ELSE
197C
198!$OMP DO SCHEDULE(guided)
199 DO i=1,nsn
200 j=nsv(i)
201C shooting nodes
202 IF(j>0) THEN
203 xslv(1)=max(xslv(1),x(1,j)-xsav(1,j))
204 xslv(2)=max(xslv(2),x(2,j)-xsav(2,j))
205 xslv(3)=max(xslv(3),x(3,j)-xsav(3,j))
206 xslv(4)=min(xslv(4),x(1,j)-xsav(1,j))
207 xslv(5)=min(xslv(5),x(2,j)-xsav(2,j))
208 xslv(6)=min(xslv(6),x(3,j)-xsav(3,j))
209C
210 vslv(1)=max(vslv(1),v(1,j))
211 vslv(2)=max(vslv(2),v(2,j))
212 vslv(3)=max(vslv(3),v(3,j))
213 vslv(4)=min(vslv(4),v(1,j))
214 vslv(5)=min(vslv(5),v(2,j))
215 vslv(6)=min(vslv(6),v(3,j))
216 ENDIF
217 END DO
218!$OMP END DO NOWAIT
219C
220!$OMP DO SCHEDULE(guided)
221 DO i=1,nmn
222 j=msr(i)
223C shooting nodes
224 IF(j>0) THEN
225 xmsr(1)=max(xmsr(1),x(1,j)-xsav(1,j))
226 xmsr(2)=max(xmsr(2),x(2,j)-xsav(2,j))
227 xmsr(3)=max(xmsr(3),x(3,j)-xsav(3,j))
228 xmsr(4)=min(xmsr(4),x(1,j)-xsav(1,j))
229 xmsr(5)=min(xmsr(5),x(2,j)-xsav(2,j))
230 xmsr(6)=min(xmsr(6),x(3,j)-xsav(3,j))
231C
232 vmsr(1)=max(vmsr(1),v(1,j))
233 vmsr(2)=max(vmsr(2),v(2,j))
234 vmsr(3)=max(vmsr(3),v(3,j))
235 vmsr(4)=min(vmsr(4),v(1,j))
236 vmsr(5)=min(vmsr(5),v(2,j))
237 vmsr(6)=min(vmsr(6),v(3,j))
238C
239 ENDIF
240 END DO
241!$OMP END DO NOWAIT
242 ENDIF
243C
244#include "lockon.inc"
245 xslv_g(1)=max(xslv_g(1),xslv(1))
246 xslv_g(2)=max(xslv_g(2),xslv(2))
247 xslv_g(3)=max(xslv_g(3),xslv(3))
248 xslv_g(4)=min(xslv_g(4),xslv(4))
249 xslv_g(5)=min(xslv_g(5),xslv(5))
250 xslv_g(6)=min(xslv_g(6),xslv(6))
251 xmsr_g(1)=max(xmsr_g(1),xmsr(1))
252 xmsr_g(2)=max(xmsr_g(2),xmsr(2))
253 xmsr_g(3)=max(xmsr_g(3),xmsr(3))
254 xmsr_g(4)=min(xmsr_g(4),xmsr(4))
255 xmsr_g(5)=min(xmsr_g(5),xmsr(5))
256 xmsr_g(6)=min(xmsr_g(6),xmsr(6))
257C
258 vslv_g(1)=max(vslv_g(1),vslv(1))
259 vslv_g(2)=max(vslv_g(2),vslv(2))
260 vslv_g(3)=max(vslv_g(3),vslv(3))
261 vslv_g(4)=min(vslv_g(4),vslv(4))
262 vslv_g(5)=min(vslv_g(5),vslv(5))
263 vslv_g(6)=min(vslv_g(6),vslv(6))
264 vmsr_g(1)=max(vmsr_g(1),vmsr(1))
265 vmsr_g(2)=max(vmsr_g(2),vmsr(2))
266 vmsr_g(3)=max(vmsr_g(3),vmsr(3))
267 vmsr_g(4)=min(vmsr_g(4),vmsr(4))
268 vmsr_g(5)=min(vmsr_g(5),vmsr(5))
269 vmsr_g(6)=min(vmsr_g(6),vmsr(6))
270#include "lockoff.inc"
271C
272 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
spmd_get_penis
subroutine spmd_get_penis(penis, nin)
Definition send_cand.F:2657