OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_tri20boxe.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/.
23C
24!||====================================================================
25!|| spmd_tri20boxe ../engine/source/mpi/interfaces/spmd_tri20boxe.F
26!||--- called by ------------------------------------------------------
27!|| i20main_tri ../engine/source/interfaces/intsort/i20main_tri.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../engine/source/output/message/message.F
30!|| arret ../engine/source/system/arret.F
31!|| conversion11 ../engine/source/mpi/interfaces/spmd_i7tool.F
32!||--- uses -----------------------------------------------------
33!|| message_mod ../engine/share/message_module/message_mod.F
34!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
35!|| tri7box ../engine/share/modules/tri7box.F
36!||====================================================================
37 SUBROUTINE spmd_tri20boxe(IXLINS ,NRTS ,XA ,VA ,MS ,
38 2 BMINMAL ,WEIGHT ,STIFS ,NIN ,ISENDTO,
39 3 IRCVFROM,IAD_ELEM,FR_ELEM,NRTSR,INACTI,
40 4 GAP_S ,PENIS ,ITAB ,IGAP ,TZINF ,
41 5 NLG ,PENIA ,DIAG_SMS,NODNX_SMS )
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE tri7box
46 USE message_mod
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50 USE spmd_comm_world_mod, ONLY : spmd_comm_world
51#include "implicit_f.inc"
52#include "r4r8_p.inc"
53C-----------------------------------------------
54C M e s s a g e P a s s i n g
55C-----------------------------------------------
56#include "spmd.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "com01_c.inc"
61#include "com04_c.inc"
62#include "task_c.inc"
63#include "sms_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER NIN, NRTS, IGAP, INACTI,
68 . IXLINS(2,*), WEIGHT(*),NRTSR,
69 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*),
70 . IAD_ELEM(2,*), FR_ELEM(*), ITAB(*), NLG(*), NODNX_SMS(*)
71 my_real
72 . tzinf,
73 . xa(3,*), va(3,*), ms(*), bminmal(*), stifs(*),gap_s(*),
74 . penis(2,*), penia(5,*), diag_sms(*)
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78#ifdef MPI
79 INTEGER MSGTYP,INFO,I,NOD, LOC_PROC,P,IDEB, IERROR1, IAD,
80 . SIZ,J, L, BUFSIZ, LEN, NB, N1, N2, N1L, N2L,
81 . STATUS(MPI_STATUS_SIZE),IERROR,REQ_SB(NSPMD),
82 . REQ_RB(NSPMD),KK,NBIRECV,IRINDEXI(NSPMD),
83 . req_rd(nspmd),req_sd(nspmd),req_sd2(nspmd),
84 . indexi,isindexi(nspmd),index(nrts),nbox(nspmd),
85 . msgoff, msgoff2, msgoff3
86 DATA msgoff/135/
87 DATA msgoff2/136/
88 DATA msgoff3/137/
89
90 my_real
91 . bminma(6,nspmd), ratio,
92 . xmins, ymins, zmins, xmaxs, ymaxs, zmaxs
93 TYPE(r8_pointer), DIMENSION(NSPMD) :: BUF
94C-----------------------------------------------
95C S o u r c e L i n e s
96C-----------------------------------------------
97 loc_proc = ispmd + 1
98C
99C boite minmax pour le tri provenant de i7buce BMINMA
100C
101 IF(ircvfrom(nin,loc_proc)==0.AND.
102 . isendto(nin,loc_proc)==0) RETURN
103 bminma(1,loc_proc) = bminmal(1)
104 bminma(2,loc_proc) = bminmal(2)
105 bminma(3,loc_proc) = bminmal(3)
106 bminma(4,loc_proc) = bminmal(4)
107 bminma(5,loc_proc) = bminmal(5)
108 bminma(6,loc_proc) = bminmal(6)
109C
110C envoi boite
111C
112 IF(ircvfrom(nin,loc_proc)/=0) THEN
113 DO p = 1, nspmd
114 IF(isendto(nin,p)/=0) THEN
115 IF(p/=loc_proc) THEN
116 msgtyp = msgoff
117 CALL mpi_isend(
118 . bminma(1,loc_proc),6 ,real ,it_spmd(p),msgtyp,
119 . spmd_comm_world ,req_sb(p),ierror)
120 ENDIF
121 ENDIF
122 ENDDO
123 ENDIF
124C
125C reception des boites min-max
126C
127 IF(isendto(nin,loc_proc)/=0) THEN
128 nbirecv=0
129 DO p = 1, nspmd
130 IF(ircvfrom(nin,p)/=0) THEN
131 IF(loc_proc/=p) THEN
132 msgtyp = msgoff
133 nbirecv=nbirecv+1
134 irindexi(nbirecv)=p
135 CALL mpi_irecv(
136 . bminma(1,p) ,6 ,real ,it_spmd(p),msgtyp,
137 . spmd_comm_world,req_rb(nbirecv),ierror)
138 ENDIF
139 ENDIF
140 ENDDO
141 ENDIF
142C
143C envoi de XREM
144C
145 siz = 18
146 IF(inacti==5.OR.inacti==6) siz = siz + 12
147 IF(igap==1) siz = siz + 1
148 IF(idtmins > 0) siz = siz + 2
149 IF(idtmins == 2)THEN
150 siz = siz + 4
151 ELSEIF(idtmins_int/=0)THEN
152 siz = siz + 2
153 END IF
154 ideb = 1
155 IF(isendto(nin,loc_proc)/=0) THEN
156 DO kk = 1, nbirecv
157 CALL mpi_waitany(nbirecv,req_rb,indexi,status,ierror)
158 p=irindexi(indexi)
159C
160 l = ideb
161 nb = 0
162 DO i=1,nrts
163 n1l=ixlins(1,i)
164 n2l=ixlins(2,i)
165 IF(stifs(i)>zero) THEN
166 xmins = min(xa(1,n1l),xa(1,n2l))-tzinf
167 ymins = min(xa(2,n1l),xa(2,n2l))-tzinf
168 zmins = min(xa(3,n1l),xa(3,n2l))-tzinf
169 xmaxs = max(xa(1,n1l),xa(1,n2l))+tzinf
170 ymaxs = max(xa(2,n1l),xa(2,n2l))+tzinf
171 zmaxs = max(xa(3,n1l),xa(3,n2l))+tzinf
172 IF(xmaxs>=bminma(4,p).AND.xmins<=bminma(1,p).AND.
173 . ymaxs>=bminma(5,p).AND.ymins<=bminma(2,p).AND.
174 . zmaxs>=bminma(6,p).AND.zmins<=bminma(3,p))THEN
175 nb = nb + 1
176 index(nb) = i
177 ENDIF
178 END IF
179 ENDDO
180 nbox(p) = nb
181C
182C Envoi taille msg
183C
184 msgtyp = msgoff2
185 CALL mpi_isend(nbox(p),1,mpi_integer,it_spmd(p),msgtyp,
186 . spmd_comm_world,req_sd(p),ierror)
187C
188C Alloc buffer
189C
190 IF (nb>0) THEN
191 ALLOCATE(buf(p)%P(siz*nb),stat=ierror)
192 IF(ierror/=0) THEN
193 CALL ancmsg(msgid=20,anmode=aninfo)
194 CALL arret(2)
195 ENDIF
196 l = 0
197 IF(idtmins/=2.AND.idtmins_int==0)THEN
198 IF(inacti/=5.AND.inacti/=6) THEN
199 IF(igap/=0) THEN
200 IF(idtmins==0)THEN
201 DO j = 1, nb
202 i = index(j)
203 n1l=ixlins(1,i)
204 n2l=ixlins(2,i)
205 n1=nlg(n1l)
206 n2=nlg(n2l)
207 buf(p)%p(l+1) = i
208 buf(p)%p(l+2) = xa(1,n1l)
209 buf(p)%p(l+3) = xa(2,n1l)
210 buf(p)%p(l+4) = xa(3,n1l)
211 buf(p)%p(l+5) = va(1,n1l)
212 buf(p)%p(l+6) = va(2,n1l)
213 buf(p)%p(l+7) = va(3,n1l)
214 buf(p)%p(l+8) = ms(n1)
215 buf(p)%p(l+9) = itab(n1)
216 buf(p)%p(l+10)= xa(1,n2l)
217 buf(p)%p(l+11)= xa(2,n2l)
218 buf(p)%p(l+12)= xa(3,n2l)
219 buf(p)%p(l+13)= va(1,n2l)
220 buf(p)%p(l+14)= va(2,n2l)
221 buf(p)%p(l+15)= va(3,n2l)
222 buf(p)%p(l+16)= ms(n2)
223 buf(p)%p(l+17)= itab(n2)
224 buf(p)%p(l+18)= stifs(i)
225 buf(p)%p(l+19)= gap_s(i)
226 l = l + siz
227 END DO
228C /DT/NODA/AMS
229 ELSE
230 DO j = 1, nb
231 i = index(j)
232 n1l=ixlins(1,i)
233 n2l=ixlins(2,i)
234 n1=nlg(n1l)
235 n2=nlg(n2l)
236 buf(p)%p(l+1) = i
237 buf(p)%p(l+2) = xa(1,n1l)
238 buf(p)%p(l+3) = xa(2,n1l)
239 buf(p)%p(l+4) = xa(3,n1l)
240 buf(p)%p(l+5) = va(1,n1l)
241 buf(p)%p(l+6) = va(2,n1l)
242 buf(p)%p(l+7) = va(3,n1l)
243 buf(p)%p(l+8) = ms(n1)
244 buf(p)%p(l+9) = itab(n1)
245 buf(p)%p(l+10)= xa(1,n2l)
246 buf(p)%p(l+11)= xa(2,n2l)
247 buf(p)%p(l+12)= xa(3,n2l)
248 buf(p)%p(l+13)= va(1,n2l)
249 buf(p)%p(l+14)= va(2,n2l)
250 buf(p)%p(l+15)= va(3,n2l)
251 buf(p)%p(l+16)= ms(n2)
252 buf(p)%p(l+17)= itab(n2)
253 buf(p)%p(l+18)= stifs(i)
254 buf(p)%p(l+19)= gap_s(i)
255 buf(p)%p(l+20)= diag_sms(n1)
256 buf(p)%p(l+21)= diag_sms(n2)
257 l = l + siz
258 END DO
259 END IF
260C fin /DT/NODA/AMS
261 ELSE
262 IF(idtmins==0)THEN
263 DO j = 1, nb
264 i = index(j)
265 n1l=ixlins(1,i)
266 n2l=ixlins(2,i)
267 n1=nlg(n1l)
268 n2=nlg(n2l)
269 buf(p)%p(l+1) = i
270 buf(p)%p(l+2) = xa(1,n1l)
271 buf(p)%p(l+3) = xa(2,n1l)
272 buf(p)%p(l+4) = xa(3,n1l)
273 buf(p)%p(l+5) = va(1,n1l)
274 buf(p)%p(l+6) = va(2,n1l)
275 buf(p)%p(l+7) = va(3,n1l)
276 buf(p)%p(l+8) = ms(n1)
277 buf(p)%p(l+9) = itab(n1)
278 buf(p)%p(l+10)= xa(1,n2l)
279 buf(p)%p(l+11)= xa(2,n2l)
280 buf(p)%p(l+12)= xa(3,n2l)
281 buf(p)%p(l+13)= va(1,n2l)
282 buf(p)%p(l+14)= va(2,n2l)
283 buf(p)%p(l+15)= va(3,n2l)
284 buf(p)%p(l+16)= ms(n2)
285 buf(p)%p(l+17)= itab(n2)
286 buf(p)%p(l+18)= stifs(i)
287 l = l + siz
288 END DO
289C /DT/NODA/AMS
290 ELSE
291 DO j = 1, nb
292 i = index(j)
293 n1l=ixlins(1,i)
294 n2l=ixlins(2,i)
295 n1=nlg(n1l)
296 n2=nlg(n2l)
297 buf(p)%p(l+1) = i
298 buf(p)%p(l+2) = xa(1,n1l)
299 buf(p)%p(l+3) = xa(2,n1l)
300 buf(p)%p(l+4) = xa(3,n1l)
301 buf(p)%p(l+5) = va(1,n1l)
302 buf(p)%p(l+6) = va(2,n1l)
303 buf(p)%p(l+7) = va(3,n1l)
304 buf(p)%p(l+8) = ms(n1)
305 buf(p)%p(l+9) = itab(n1)
306 buf(p)%p(l+10)= xa(1,n2l)
307 buf(p)%p(l+11)= xa(2,n2l)
308 buf(p)%p(l+12)= xa(3,n2l)
309 buf(p)%p(l+13)= va(1,n2l)
310 buf(p)%p(l+14)= va(2,n2l)
311 buf(p)%p(l+15)= va(3,n2l)
312 buf(p)%p(l+16)= ms(n2)
313 buf(p)%p(l+17)= itab(n2)
314 buf(p)%p(l+18)= stifs(i)
315 buf(p)%p(l+19)= diag_sms(n1)
316 buf(p)%p(l+20)= diag_sms(n2)
317 l = l + siz
318 END DO
319 END IF
320C fin /DT/NODA/AMS
321 END IF
322 ELSE
323 IF(igap/=0) THEN
324 IF(idtmins==0)THEN
325 DO j = 1, nb
326 i = index(j)
327 n1l=ixlins(1,i)
328 n2l=ixlins(2,i)
329 n1=nlg(n1l)
330 n2=nlg(n2l)
331 buf(p)%p(l+1) = i
332 buf(p)%p(l+2) = xa(1,n1l)
333 buf(p)%p(l+3) = xa(2,n1l)
334 buf(p)%p(l+4) = xa(3,n1l)
335 buf(p)%p(l+5) = va(1,n1l)
336 buf(p)%p(l+6) = va(2,n1l)
337 buf(p)%p(l+7) = va(3,n1l)
338 buf(p)%p(l+8) = ms(n1)
339 buf(p)%p(l+9) = itab(n1)
340 buf(p)%p(l+10)= xa(1,n2l)
341 buf(p)%p(l+11)= xa(2,n2l)
342 buf(p)%p(l+12)= xa(3,n2l)
343 buf(p)%p(l+13)= va(1,n2l)
344 buf(p)%p(l+14)= va(2,n2l)
345 buf(p)%p(l+15)= va(3,n2l)
346 buf(p)%p(l+16)= ms(n2)
347 buf(p)%p(l+17)= itab(n2)
348 buf(p)%p(l+18)= stifs(i)
349 buf(p)%p(l+19)= gap_s(i)
350 buf(p)%p(l+20)= penis(1,i)
351 buf(p)%p(l+21)= penis(2,i)
352 buf(p)%p(l+22)= penia(1,n1l)
353 buf(p)%p(l+23)= penia(2,n1l)
354 buf(p)%p(l+24)= penia(3,n1l)
355 buf(p)%p(l+25)= penia(4,n1l)
356 buf(p)%p(l+26)= penia(5,n1l)
357 buf(p)%p(l+27)= penia(1,n2l)
358 buf(p)%p(l+28)= penia(2,n2l)
359 buf(p)%p(l+29)= penia(3,n2l)
360 buf(p)%p(l+30)= penia(4,n2l)
361 buf(p)%p(l+31)= penia(5,n2l)
362 l = l + siz
363 END DO
364C /DT/NODA/AMS
365 ELSE
366 DO j = 1, nb
367 i = index(j)
368 n1l=ixlins(1,i)
369 n2l=ixlins(2,i)
370 n1=nlg(n1l)
371 n2=nlg(n2l)
372 buf(p)%p(l+1) = i
373 buf(p)%p(l+2) = xa(1,n1l)
374 buf(p)%p(l+3) = xa(2,n1l)
375 buf(p)%p(l+4) = xa(3,n1l)
376 buf(p)%p(l+5) = va(1,n1l)
377 buf(p)%p(l+6) = va(2,n1l)
378 buf(p)%p(l+7) = va(3,n1l)
379 buf(p)%p(l+8) = ms(n1)
380 buf(p)%p(l+9) = itab(n1)
381 buf(p)%p(l+10)= xa(1,n2l)
382 buf(p)%p(l+11)= xa(2,n2l)
383 buf(p)%p(l+12)= xa(3,n2l)
384 buf(p)%p(l+13)= va(1,n2l)
385 buf(p)%p(l+14)= va(2,n2l)
386 buf(p)%p(l+15)= va(3,n2l)
387 buf(p)%p(l+16)= ms(n2)
388 buf(p)%p(l+17)= itab(n2)
389 buf(p)%p(l+18)= stifs(i)
390 buf(p)%p(l+19)= gap_s(i)
391 buf(p)%p(l+20)= penis(1,i)
392 buf(p)%p(l+21)= penis(2,i)
393 buf(p)%p(l+22)= penia(1,n1l)
394 buf(p)%p(l+23)= penia(2,n1l)
395 buf(p)%p(l+24)= penia(3,n1l)
396 buf(p)%p(l+25)= penia(4,n1l)
397 buf(p)%p(l+26)= penia(5,n1l)
398 buf(p)%p(l+27)= penia(1,n2l)
399 buf(p)%p(l+28)= penia(2,n2l)
400 buf(p)%p(l+29)= penia(3,n2l)
401 buf(p)%p(l+30)= penia(4,n2l)
402 buf(p)%p(l+31)= penia(5,n2l)
403 buf(p)%p(l+32)= diag_sms(n1)
404 buf(p)%p(l+33)= diag_sms(n2)
405 l = l + siz
406 END DO
407 END IF
408C fin /DT/NODA/AMS
409 ELSE
410 IF(idtmins==0)THEN
411 DO j = 1, nb
412 i = index(j)
413 n1l=ixlins(1,i)
414 n2l=ixlins(2,i)
415 n1=nlg(n1l)
416 n2=nlg(n2l)
417 buf(p)%p(l+1) = i
418 buf(p)%p(l+2) = xa(1,n1l)
419 buf(p)%p(l+3) = xa(2,n1l)
420 buf(p)%p(l+4) = xa(3,n1l)
421 buf(p)%p(l+5) = va(1,n1l)
422 buf(p)%p(l+6) = va(2,n1l)
423 buf(p)%p(l+7) = va(3,n1l)
424 buf(p)%p(l+8) = ms(n1)
425 buf(p)%p(l+9) = itab(n1)
426 buf(p)%p(l+10)= xa(1,n2l)
427 buf(p)%p(l+11)= xa(2,n2l)
428 buf(p)%p(l+12)= xa(3,n2l)
429 buf(p)%p(l+13)= va(1,n2l)
430 buf(p)%p(l+14)= va(2,n2l)
431 buf(p)%p(l+15)= va(3,n2l)
432 buf(p)%p(l+16)= ms(n2)
433 buf(p)%p(l+17)= itab(n2)
434 buf(p)%p(l+18)= stifs(i)
435 buf(p)%p(l+19)= penis(1,i)
436 buf(p)%p(l+20)= penis(2,i)
437 buf(p)%p(l+21)= penia(1,n1l)
438 buf(p)%p(l+22)= penia(2,n1l)
439 buf(p)%p(l+23)= penia(3,n1l)
440 buf(p)%p(l+24)= penia(4,n1l)
441 buf(p)%p(l+25)= penia(5,n1l)
442 buf(p)%p(l+26)= penia(1,n2l)
443 buf(p)%p(l+27)= penia(2,n2l)
444 buf(p)%p(l+28)= penia(3,n2l)
445 buf(p)%p(l+29)= penia(4,n2l)
446 buf(p)%p(l+30)= penia(5,n2l)
447 l = l + siz
448 END DO
449C /DT/NODA/AMS
450 ELSE
451 DO j = 1, nb
452 i = index(j)
453 n1l=ixlins(1,i)
454 n2l=ixlins(2,i)
455 n1=nlg(n1l)
456 n2=nlg(n2l)
457 buf(p)%p(l+1) = i
458 buf(p)%p(l+2) = xa(1,n1l)
459 buf(p)%p(l+3) = xa(2,n1l)
460 buf(p)%p(l+4) = xa(3,n1l)
461 buf(p)%p(l+5) = va(1,n1l)
462 buf(p)%p(l+6) = va(2,n1l)
463 buf(p)%p(l+7) = va(3,n1l)
464 buf(p)%p(l+8) = ms(n1)
465 buf(p)%p(l+9) = itab(n1)
466 buf(p)%p(l+10)= xa(1,n2l)
467 buf(p)%p(l+11)= xa(2,n2l)
468 buf(p)%p(l+12)= xa(3,n2l)
469 buf(p)%p(l+13)= va(1,n2l)
470 buf(p)%p(l+14)= va(2,n2l)
471 buf(p)%p(l+15)= va(3,n2l)
472 buf(p)%p(l+16)= ms(n2)
473 buf(p)%p(l+17)= itab(n2)
474 buf(p)%p(l+18)= stifs(i)
475 buf(p)%p(l+19)= penis(1,i)
476 buf(p)%p(l+20)= penis(2,i)
477 buf(p)%p(l+21)= penia(1,n1l)
478 buf(p)%p(l+22)= penia(2,n1l)
479 buf(p)%p(l+23)= penia(3,n1l)
480 buf(p)%p(l+24)= penia(4,n1l)
481 buf(p)%p(l+25)= penia(5,n1l)
482 buf(p)%p(l+26)= penia(1,n2l)
483 buf(p)%p(l+27)= penia(2,n2l)
484 buf(p)%p(l+28)= penia(3,n2l)
485 buf(p)%p(l+29)= penia(4,n2l)
486 buf(p)%p(l+30)= penia(5,n2l)
487 buf(p)%p(l+31)= diag_sms(n1)
488 buf(p)%p(l+32)= diag_sms(n2)
489 l = l + siz
490 END DO
491 END IF
492C fin /DT/NODA/AMS
493 END IF
494 END IF
495 ELSEIF(idtmins==2)THEN
496C /DT/AMS
497 IF(inacti/=5.AND.inacti/=6) THEN
498 IF(igap/=0) THEN
499 DO j = 1, nb
500 i = index(j)
501 n1l=ixlins(1,i)
502 n2l=ixlins(2,i)
503 n1=nlg(n1l)
504 n2=nlg(n2l)
505 buf(p)%p(l+1) = i
506 buf(p)%p(l+2) = xa(1,n1l)
507 buf(p)%p(l+3) = xa(2,n1l)
508 buf(p)%p(l+4) = xa(3,n1l)
509 buf(p)%p(l+5) = va(1,n1l)
510 buf(p)%p(l+6) = va(2,n1l)
511 buf(p)%p(l+7) = va(3,n1l)
512 buf(p)%p(l+8) = ms(n1)
513 buf(p)%p(l+9) = itab(n1)
514 buf(p)%p(l+10)= xa(1,n2l)
515 buf(p)%p(l+11)= xa(2,n2l)
516 buf(p)%p(l+12)= xa(3,n2l)
517 buf(p)%p(l+13)= va(1,n2l)
518 buf(p)%p(l+14)= va(2,n2l)
519 buf(p)%p(l+15)= va(3,n2l)
520 buf(p)%p(l+16)= ms(n2)
521 buf(p)%p(l+17)= itab(n2)
522 buf(p)%p(l+18)= stifs(i)
523 buf(p)%p(l+19)= gap_s(i)
524 buf(p)%p(l+20)= diag_sms(n1)
525 buf(p)%p(l+21)= diag_sms(n2)
526 buf(p)%p(l+22)= nodnx_sms(n1)
527 buf(p)%p(l+23)= n1
528 buf(p)%p(l+24)= nodnx_sms(n2)
529 buf(p)%p(l+25)= n2
530 l = l + siz
531 END DO
532 ELSE
533 DO j = 1, nb
534 i = index(j)
535 n1l=ixlins(1,i)
536 n2l=ixlins(2,i)
537 n1=nlg(n1l)
538 n2=nlg(n2l)
539 buf(p)%p(l+1) = i
540 buf(p)%p(l+2) = xa(1,n1l)
541 buf(p)%p(l+3) = xa(2,n1l)
542 buf(p)%p(l+4) = xa(3,n1l)
543 buf(p)%p(l+5) = va(1,n1l)
544 buf(p)%p(l+6) = va(2,n1l)
545 buf(p)%p(l+7) = va(3,n1l)
546 buf(p)%p(l+8) = ms(n1)
547 buf(p)%p(l+9) = itab(n1)
548 buf(p)%p(l+10)= xa(1,n2l)
549 buf(p)%p(l+11)= xa(2,n2l)
550 buf(p)%p(l+12)= xa(3,n2l)
551 buf(p)%p(l+13)= va(1,n2l)
552 buf(p)%p(l+14)= va(2,n2l)
553 buf(p)%p(l+15)= va(3,n2l)
554 buf(p)%p(l+16)= ms(n2)
555 buf(p)%p(l+17)= itab(n2)
556 buf(p)%p(l+18)= stifs(i)
557 buf(p)%p(l+19)= diag_sms(n1)
558 buf(p)%p(l+20)= diag_sms(n2)
559 buf(p)%p(l+21)= nodnx_sms(n1)
560 buf(p)%p(l+22)= n1
561 buf(p)%p(l+23)= nodnx_sms(n2)
562 buf(p)%p(l+24)= n2
563 l = l + siz
564 END DO
565 END IF
566 ELSE
567 IF(igap/=0) THEN
568 DO j = 1, nb
569 i = index(j)
570 n1l=ixlins(1,i)
571 n2l=ixlins(2,i)
572 n1=nlg(n1l)
573 n2=nlg(n2l)
574 buf(p)%p(l+1) = i
575 buf(p)%p(l+2) = xa(1,n1l)
576 buf(p)%p(l+3) = xa(2,n1l)
577 buf(p)%p(l+4) = xa(3,n1l)
578 buf(p)%p(l+5) = va(1,n1l)
579 buf(p)%p(l+6) = va(2,n1l)
580 buf(p)%p(l+7) = va(3,n1l)
581 buf(p)%p(l+8) = ms(n1)
582 buf(p)%p(l+9) = itab(n1)
583 buf(p)%p(l+10)= xa(1,n2l)
584 buf(p)%p(l+11)= xa(2,n2l)
585 buf(p)%p(l+12)= xa(3,n2l)
586 buf(p)%p(l+13)= va(1,n2l)
587 buf(p)%p(l+14)= va(2,n2l)
588 buf(p)%p(l+15)= va(3,n2l)
589 buf(p)%p(l+16)= ms(n2)
590 buf(p)%p(l+17)= itab(n2)
591 buf(p)%p(l+18)= stifs(i)
592 buf(p)%p(l+19)= gap_s(i)
593 buf(p)%p(l+20)= penis(1,i)
594 buf(p)%p(l+21)= penis(2,i)
595 buf(p)%p(l+22)= penia(1,n1l)
596 buf(p)%p(l+23)= penia(2,n1l)
597 buf(p)%p(l+24)= penia(3,n1l)
598 buf(p)%p(l+25)= penia(4,n1l)
599 buf(p)%p(l+26)= penia(5,n1l)
600 buf(p)%p(l+27)= penia(1,n2l)
601 buf(p)%p(l+28)= penia(2,n2l)
602 buf(p)%p(l+29)= penia(3,n2l)
603 buf(p)%p(l+30)= penia(4,n2l)
604 buf(p)%p(l+31)= penia(5,n2l)
605 buf(p)%p(l+32)= diag_sms(n1)
606 buf(p)%p(l+33)= diag_sms(n2)
607 buf(p)%p(l+34)= nodnx_sms(n1)
608 buf(p)%p(l+35)= n1
609 buf(p)%p(l+36)= nodnx_sms(n2)
610 buf(p)%p(l+37)= n2
611 l = l + siz
612 END DO
613 ELSE
614 DO j = 1, nb
615 i = index(j)
616 n1l=ixlins(1,i)
617 n2l=ixlins(2,i)
618 n1=nlg(n1l)
619 n2=nlg(n2l)
620 buf(p)%p(l+1) = i
621 buf(p)%p(l+2) = xa(1,n1l)
622 buf(p)%p(l+3) = xa(2,n1l)
623 buf(p)%p(l+4) = xa(3,n1l)
624 buf(p)%p(l+5) = va(1,n1l)
625 buf(p)%p(l+6) = va(2,n1l)
626 buf(p)%p(l+7) = va(3,n1l)
627 buf(p)%p(l+8) = ms(n1)
628 buf(p)%p(l+9) = itab(n1)
629 buf(p)%p(l+10)= xa(1,n2l)
630 buf(p)%p(l+11)= xa(2,n2l)
631 buf(p)%p(l+12)= xa(3,n2l)
632 buf(p)%p(l+13)= va(1,n2l)
633 buf(p)%p(l+14)= va(2,n2l)
634 buf(p)%p(l+15)= va(3,n2l)
635 buf(p)%p(l+16)= ms(n2)
636 buf(p)%p(l+17)= itab(n2)
637 buf(p)%p(l+18)= stifs(i)
638 buf(p)%p(l+19)= penis(1,i)
639 buf(p)%p(l+20)= penis(2,i)
640 buf(p)%p(l+21)= penia(1,n1l)
641 buf(p)%p(l+22)= penia(2,n1l)
642 buf(p)%p(l+23)= penia(3,n1l)
643 buf(p)%p(l+24)= penia(4,n1l)
644 buf(p)%p(l+25)= penia(5,n1l)
645 buf(p)%p(l+26)= penia(1,n2l)
646 buf(p)%p(l+27)= penia(2,n2l)
647 buf(p)%p(l+28)= penia(3,n2l)
648 buf(p)%p(l+29)= penia(4,n2l)
649 buf(p)%p(l+30)= penia(5,n2l)
650 buf(p)%p(l+31)= diag_sms(n1)
651 buf(p)%p(l+32)= diag_sms(n2)
652 buf(p)%p(l+33)= nodnx_sms(n1)
653 buf(p)%p(l+34)= n1
654 buf(p)%p(l+35)= nodnx_sms(n2)
655 buf(p)%p(l+36)= n2
656 l = l + siz
657 END DO
658 END IF
659 END IF
660 ELSE
661C /DT/INTER/AMS
662 IF(inacti/=5.AND.inacti/=6) THEN
663 IF(igap/=0) THEN
664 DO j = 1, nb
665 i = index(j)
666 n1l=ixlins(1,i)
667 n2l=ixlins(2,i)
668 n1=nlg(n1l)
669 n2=nlg(n2l)
670 buf(p)%p(l+1) = i
671 buf(p)%p(l+2) = xa(1,n1l)
672 buf(p)%p(l+3) = xa(2,n1l)
673 buf(p)%p(l+4) = xa(3,n1l)
674 buf(p)%p(l+5) = va(1,n1l)
675 buf(p)%p(l+6) = va(2,n1l)
676 buf(p)%p(l+7) = va(3,n1l)
677 buf(p)%p(l+8) = ms(n1)
678 buf(p)%p(l+9) = itab(n1)
679 buf(p)%p(l+10)= xa(1,n2l)
680 buf(p)%p(l+11)= xa(2,n2l)
681 buf(p)%p(l+12)= xa(3,n2l)
682 buf(p)%p(l+13)= va(1,n2l)
683 buf(p)%p(l+14)= va(2,n2l)
684 buf(p)%p(l+15)= va(3,n2l)
685 buf(p)%p(l+16)= ms(n2)
686 buf(p)%p(l+17)= itab(n2)
687 buf(p)%p(l+18)= stifs(i)
688 buf(p)%p(l+19)= gap_s(i)
689 buf(p)%p(l+20)= diag_sms(n1)
690 buf(p)%p(l+21)= diag_sms(n2)
691 buf(p)%p(l+22)= n1
692 buf(p)%p(l+23)= n2
693 l = l + siz
694 END DO
695 ELSE
696 DO j = 1, nb
697 i = index(j)
698 n1l=ixlins(1,i)
699 n2l=ixlins(2,i)
700 n1=nlg(n1l)
701 n2=nlg(n2l)
702 buf(p)%p(l+1) = i
703 buf(p)%p(l+2) = xa(1,n1l)
704 buf(p)%p(l+3) = xa(2,n1l)
705 buf(p)%p(l+4) = xa(3,n1l)
706 buf(p)%p(l+5) = va(1,n1l)
707 buf(p)%p(l+6) = va(2,n1l)
708 buf(p)%p(l+7) = va(3,n1l)
709 buf(p)%p(l+8) = ms(n1)
710 buf(p)%p(l+9) = itab(n1)
711 buf(p)%p(l+10)= xa(1,n2l)
712 buf(p)%p(l+11)= xa(2,n2l)
713 buf(p)%p(l+12)= xa(3,n2l)
714 buf(p)%p(l+13)= va(1,n2l)
715 buf(p)%p(l+14)= va(2,n2l)
716 buf(p)%p(l+15)= va(3,n2l)
717 buf(p)%p(l+16)= ms(n2)
718 buf(p)%p(l+17)= itab(n2)
719 buf(p)%p(l+18)= stifs(i)
720 buf(p)%p(l+19)= diag_sms(n1)
721 buf(p)%p(l+20)= diag_sms(n2)
722 buf(p)%p(l+21)= n1
723 buf(p)%p(l+22)= n2
724 l = l + siz
725 END DO
726 END IF
727 ELSE
728 IF(igap/=0) THEN
729 DO j = 1, nb
730 i = index(j)
731 n1l=ixlins(1,i)
732 n2l=ixlins(2,i)
733 n1=nlg(n1l)
734 n2=nlg(n2l)
735 buf(p)%p(l+1) = i
736 buf(p)%p(l+2) = xa(1,n1l)
737 buf(p)%p(l+3) = xa(2,n1l)
738 buf(p)%p(l+4) = xa(3,n1l)
739 buf(p)%p(l+5) = va(1,n1l)
740 buf(p)%p(l+6) = va(2,n1l)
741 buf(p)%p(l+7) = va(3,n1l)
742 buf(p)%p(l+8) = ms(n1)
743 buf(p)%p(l+9) = itab(n1)
744 buf(p)%p(l+10)= xa(1,n2l)
745 buf(p)%p(l+11)= xa(2,n2l)
746 buf(p)%p(l+12)= xa(3,n2l)
747 buf(p)%p(l+13)= va(1,n2l)
748 buf(p)%p(l+14)= va(2,n2l)
749 buf(p)%p(l+15)= va(3,n2l)
750 buf(p)%p(l+16)= ms(n2)
751 buf(p)%p(l+17)= itab(n2)
752 buf(p)%p(l+18)= stifs(i)
753 buf(p)%p(l+19)= gap_s(i)
754 buf(p)%p(l+20)= penis(1,i)
755 buf(p)%p(l+21)= penis(2,i)
756 buf(p)%p(l+22)= penia(1,n1l)
757 buf(p)%p(l+23)= penia(2,n1l)
758 buf(p)%p(l+24)= penia(3,n1l)
759 buf(p)%p(l+25)= penia(4,n1l)
760 buf(p)%p(l+26)= penia(5,n1l)
761 buf(p)%p(l+27)= penia(1,n2l)
762 buf(p)%p(l+28)= penia(2,n2l)
763 buf(p)%p(l+29)= penia(3,n2l)
764 buf(p)%p(l+30)= penia(4,n2l)
765 buf(p)%p(l+31)= penia(5,n2l)
766 buf(p)%p(l+32)= diag_sms(n1)
767 buf(p)%p(l+33)= diag_sms(n2)
768 buf(p)%p(l+34)= n1
769 buf(p)%p(l+35)= n2
770 l = l + siz
771 END DO
772 ELSE
773 DO j = 1, nb
774 i = index(j)
775 n1l=ixlins(1,i)
776 n2l=ixlins(2,i)
777 n1=nlg(n1l)
778 n2=nlg(n2l)
779 buf(p)%p(l+1) = i
780 buf(p)%p(l+2) = xa(1,n1l)
781 buf(p)%p(l+3) = xa(2,n1l)
782 buf(p)%p(l+4) = xa(3,n1l)
783 buf(p)%p(l+5) = va(1,n1l)
784 buf(p)%p(l+6) = va(2,n1l)
785 buf(p)%p(l+7) = va(3,n1l)
786 buf(p)%p(l+8) = ms(n1)
787 buf(p)%p(l+9) = itab(n1)
788 buf(p)%p(l+10)= xa(1,n2l)
789 buf(p)%p(l+11)= xa(2,n2l)
790 buf(p)%p(l+12)= xa(3,n2l)
791 buf(p)%p(l+13)= va(1,n2l)
792 buf(p)%p(l+14)= va(2,n2l)
793 buf(p)%p(l+15)= va(3,n2l)
794 buf(p)%p(l+16)= ms(n2)
795 buf(p)%p(l+17)= itab(n2)
796 buf(p)%p(l+18)= stifs(i)
797 buf(p)%p(l+19)= penis(1,i)
798 buf(p)%p(l+20)= penis(2,i)
799 buf(p)%p(l+21)= penia(1,n1l)
800 buf(p)%p(l+22)= penia(2,n1l)
801 buf(p)%p(l+23)= penia(3,n1l)
802 buf(p)%p(l+24)= penia(4,n1l)
803 buf(p)%p(l+25)= penia(5,n1l)
804 buf(p)%p(l+26)= penia(1,n2l)
805 buf(p)%p(l+27)= penia(2,n2l)
806 buf(p)%p(l+28)= penia(3,n2l)
807 buf(p)%p(l+29)= penia(4,n2l)
808 buf(p)%p(l+30)= penia(5,n2l)
809 buf(p)%p(l+31)= diag_sms(n1)
810 buf(p)%p(l+32)= diag_sms(n2)
811 buf(p)%p(l+33)= n1
812 buf(p)%p(l+34)= n2
813 l = l + siz
814 END DO
815 END IF
816 END IF
817 END IF
818 msgtyp = msgoff3
819 CALL mpi_isend(
820 1 buf(p)%P(1),l,mpi_double_precision,it_spmd(p),msgtyp,
821 2 spmd_comm_world,req_sd2(p),ierror)
822 ENDIF
823 ENDDO
824 ENDIF
825C
826C reception des donnees XREM
827C
828 IF(ircvfrom(nin,loc_proc)/=0) THEN
829 nrtsr = 0
830 l=0
831 DO p = 1, nspmd
832 nsnfie(nin)%P(p) = 0
833 IF(isendto(nin,p)/=0) THEN
834 IF(loc_proc/=p) THEN
835 msgtyp = msgoff2
836 CALL mpi_recv(nsnfie(nin)%P(p),1,mpi_integer,it_spmd(p),
837 . msgtyp,spmd_comm_world,status,ierror)
838 IF(nsnfie(nin)%P(p)>0) THEN
839 l=l+1
840 isindexi(l)=p
841 nrtsr = nrtsr + nsnfie(nin)%P(p)
842 ENDIF
843 ENDIF
844 ENDIF
845 ENDDO
846 nbirecv=l
847C
848C Allocate total size
849C
850 IF(nrtsr>0) THEN
851 IF (ir4r8 == 2) THEN
852 ALLOCATE(xrem(siz,nrtsr),stat=ierror)
853 ELSE
854 ALLOCATE(xrem(siz,2*nrtsr),stat=ierror)
855 ALLOCATE(irem(2,nrtsr),stat=ierror1)
856 ierror=ierror+ierror1
857 END IF
858 IF(ierror/=0) THEN
859 CALL ancmsg(msgid=20,anmode=aninfo)
860 CALL arret(2)
861 ENDIF
862 ideb = 1
863 DO l = 1, nbirecv
864 p = isindexi(l)
865 len = nsnfie(nin)%P(p)*siz
866 msgtyp = msgoff3
867 iad = ideb
868C correction adresse pour passage tableau XREM SP utilise en DP ds la routine de comm
869 IF(ir4r8 == 1) iad = 2*ideb-1
870 CALL mpi_irecv(
871 1 xrem(1,iad),len,mpi_double_precision,it_spmd(p),
872 2 msgtyp,spmd_comm_world,req_rd(l),ierror)
873 ideb = ideb + nsnfie(nin)%P(p)
874 ENDDO
875 DO l = 1, nbirecv
876 CALL mpi_waitany(nbirecv,req_rd,indexi,status,ierror)
877C P=ISINDEXI(INDEXI)
878 ENDDO
879 IF(ir4r8 == 1)THEN
880 CALL conversion11(xrem,xrem,irem,siz,ideb-1)
881 END IF
882 ENDIF
883 ENDIF
884C
885 IF(ircvfrom(nin,loc_proc)/=0) THEN
886 DO p = 1, nspmd
887 IF(isendto(nin,p)/=0) THEN
888 IF(p/=loc_proc) THEN
889 CALL mpi_wait(req_sb(p),status,ierror)
890 ENDIF
891 ENDIF
892 ENDDO
893 ENDIF
894C
895 IF(isendto(nin,loc_proc)/=0) THEN
896 DO p = 1, nspmd
897 IF(ircvfrom(nin,p)/=0) THEN
898 IF(p/=loc_proc) THEN
899 CALL mpi_wait(req_sd(p),status,ierror)
900 IF(nbox(p)/=0) THEN
901 CALL mpi_wait(req_sd2(p),status,ierror)
902 DEALLOCATE(buf(p)%p)
903 END IF
904 ENDIF
905 ENDIF
906 ENDDO
907 ENDIF
908C
909#endif
910 RETURN
911 END
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
mpi_recv
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
mpi_isend
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
Definition mpi.f:382
mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525
mpi_waitany
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)
Definition mpi.f:549
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
message_mod
Definition message_mod.F:1249
tri7box::nsnfie
type(int_pointer), dimension(:), allocatable nsnfie
Definition tri7box.F:440
tri7box::irem
integer, dimension(:,:), allocatable irem
Definition tri7box.F:339
conversion11
subroutine conversion11(xrem, xrem_dp, irem, siz, len)
Definition spmd_i7tool.F:7191
spmd_tri20boxe
subroutine spmd_tri20boxe(ixlins, nrts, xa, va, ms, bminmal, weight, stifs, nin, isendto, ircvfrom, iad_elem, fr_elem, nrtsr, inacti, gap_s, penis, itab, igap, tzinf, nlg, penia, diag_sms, nodnx_sms)
Definition spmd_tri20boxe.F:42
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87