OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_tri20box.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_tri20box ../engine/source/mpi/interfaces/spmd_tri20box.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!|| conversion7 ../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_tri20box(NSV ,NSN ,XA ,VA ,MS ,
38 2 BMINMAL ,WEIGHT ,STFA ,NIN ,ISENDTO ,
39 3 IRCVFROM,IAD_ELEM,FR_ELEM,NSNR ,IGAP ,
40 4 GAP_S ,ITAB ,KINET ,IFQ ,INACTI ,
41 5 NSNFIOLD,INTTH ,IELEC ,AREAS,TEMP ,
42 6 NUM_IMP ,NLG ,PENIS ,PENIA,DIAG_SMS,
43 7 NODNX_SMS,NBINFLG,DXANC ,DVANC)
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE tri7box
48 USE message_mod
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52 USE spmd_comm_world_mod, ONLY : spmd_comm_world
53#include "implicit_f.inc"
54#include "r4r8_p.inc"
55C-----------------------------------------------
56C M e s s a g e P a s s i n g
57C-----------------------------------------------
58#include "spmd.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "com01_c.inc"
63#include "com04_c.inc"
64#include "task_c.inc"
65#include "timeri_c.inc"
66#include "sms_c.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 INTEGER NIN, NSN, IFQ, INACTI, IGAP,INTTH,
71 . NSNFIOLD(*), NSV(*), WEIGHT(*),NSNR,
72 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*),
73 . IAD_ELEM(2,*), FR_ELEM(*), ITAB(*), KINET(*),
74 . IELEC(*),NUM_IMP,NLG(*), NODNX_SMS(*), NBINFLG(*)
75 my_real
76 . xa(3,*), va(3,*), ms(*), bminmal(*), stfa(*), gap_s(*),
77 . areas(*),temp(*), penis(2,*), penia(5,*), diag_sms(*),
78 . dxanc(3,*),dvanc(3,*)
79C-----------------------------------------------
80C L o c a l V a r i a b l e s
81C-----------------------------------------------
82#ifdef MPI
83 INTEGER MSGTYP,INFO,I,NOD, DT_CST, LOC_PROC,P,IDEB,IL,
84 . SIZ,J, L, BUFSIZ, LEN, NB, IERROR1, IAD,
85 . STATUS(MPI_STATUS_SIZE),IERROR,REQ_SB(NSPMD),
86 . REQ_RB(NSPMD),KK,NBIRECV,IRINDEXI(NSPMD),
87 . REQ_RD(NSPMD),REQ_SD(NSPMD),REQ_SD2(NSPMD),
88 . INDEXI,ISINDEXI(NSPMD),INDEX(NUMNOD),NBOX(NSPMD),
89 . msgoff, msgoff2, msgoff3
90 DATA msgoff/132/
91 DATA msgoff2/133/
92 DATA msgoff3/134/
93
94 my_real
95 . bminma(6,nspmd), ratio
96 TYPE(r8_pointer), DIMENSION(NSPMD) :: BUF
97C-----------------------------------------------
98C S o u r c e L i n e s
99C-----------------------------------------------
100C
101C Sauvegarde valeur ancienne des nsn frontieres
102C
103 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0
104 . .OR.num_imp>0) THEN
105 DO p = 1, nspmd
106 nsnfiold(p) = nsnfi(nin)%P(p)
107 END DO
108 END IF
109 loc_proc = ispmd + 1
110C
111C boite minmax pour le tri provenant de i20buce BMINMA
112C
113 IF(ircvfrom(nin,loc_proc)==0.AND.
114 . isendto(nin,loc_proc)==0) RETURN
115 bminma(1,loc_proc) = bminmal(1)
116 bminma(2,loc_proc) = bminmal(2)
117 bminma(3,loc_proc) = bminmal(3)
118 bminma(4,loc_proc) = bminmal(4)
119 bminma(5,loc_proc) = bminmal(5)
120 bminma(6,loc_proc) = bminmal(6)
121C
122C envoi boite
123C
124 IF(ircvfrom(nin,loc_proc)/=0) THEN
125 DO p = 1, nspmd
126 IF(isendto(nin,p)/=0) THEN
127 IF(p/=loc_proc) THEN
128 msgtyp = msgoff
129 CALL mpi_isend(
130 . bminma(1,loc_proc),6 ,real ,it_spmd(p),msgtyp,
131 . spmd_comm_world ,req_sb(p),ierror)
132 ENDIF
133 ENDIF
134 ENDDO
135 ENDIF
136C
137C reception des boites min-max
138C
139 IF(isendto(nin,loc_proc)/=0) THEN
140 nbirecv=0
141 DO p = 1, nspmd
142 IF(ircvfrom(nin,p)/=0) THEN
143 IF(loc_proc/=p) THEN
144 msgtyp = msgoff
145 nbirecv=nbirecv+1
146 irindexi(nbirecv)=p
147 CALL mpi_irecv(
148 . bminma(1,p) ,6 ,real ,it_spmd(p),msgtyp,
149 . spmd_comm_world,req_rb(nbirecv),ierror)
150 ENDIF
151 ENDIF
152 ENDDO
153 ENDIF
154C
155C envoi de XREM
156C
157 IF(igap==0) THEN
158 siz = 18
159 ELSE
160 siz = 19
161 ENDIF
162 IF(intth > 0 ) siz = siz + 3
163 IF(inacti==5.OR.inacti==6) siz = siz + 7
164 IF(idtmins > 0 ) siz = siz + 1
165 IF(idtmins == 2)THEN
166 siz = siz + 2
167 ELSEIF(idtmins_int/=0)THEN
168 siz = siz + 1
169 END IF
170 ideb = 1
171 IF(isendto(nin,loc_proc)/=0) THEN
172 DO kk = 1, nbirecv
173 CALL mpi_waitany(nbirecv,req_rb,indexi,status,ierror)
174 p=irindexi(indexi)
175C Traitement special sur d.d. ne consever que les noeuds internes
176 DO j = iad_elem(1,p), iad_elem(1,p+1)-1
177 nod = fr_elem(j)
178C weight < 0 temporairement pour ne conserver que les noeuds non frontiere
179 weight(nod) = weight(nod)*(-1)
180 ENDDO
181C
182 l = ideb
183 nbox(p) = 0
184 nb = 0
185 DO i=1,nsn
186 il = nsv(i)
187 nod = nlg(il)
188 IF(weight(nod)==1)THEN
189 IF(stfa(il)>zero)THEN
190 IF(xa(1,il)<=bminma(1,p)) THEN
191 IF(xa(1,il)>=bminma(4,p)) THEN
192 IF(xa(2,il)<=bminma(2,p)) THEN
193 IF(xa(2,il)>=bminma(5,p)) THEN
194 IF(xa(3,il)<=bminma(3,p)) THEN
195 IF(xa(3,il)>=bminma(6,p)) THEN
196 nb = nb + 1
197 index(nb) = i
198 ENDIF
199 ENDIF
200 ENDIF
201 ENDIF
202 ENDIF
203 ENDIF
204 ENDIF
205 ENDIF
206 ENDDO
207 nbox(p) = nb
208C
209 DO j = iad_elem(1,p), iad_elem(1,p+1)-1
210 nod = fr_elem(j)
211C remise de weight > 0
212 weight(nod) = weight(nod)*(-1)
213 ENDDO
214C
215C Envoi taille msg
216C
217 msgtyp = msgoff2
218 CALL mpi_isend(nbox(p),1,mpi_integer,it_spmd(p),msgtyp,
219 . spmd_comm_world,req_sd(p),ierror)
220C
221C Alloc buffer
222C
223 IF (nb>0) THEN
224 ALLOCATE(buf(p)%P(siz*nb),stat=ierror)
225 IF(ierror/=0) THEN
226 CALL ancmsg(msgid=20,anmode=aninfo)
227 CALL arret(2)
228 ENDIF
229 l = 0
230C
231 IF(idtmins/=2 .AND. idtmins_int == 0)THEN
232 IF(inacti/=5.AND.inacti/=6) THEN
233 IF(intth == 0 ) THEN
234 IF(igap==0) THEN
235 IF(idtmins==0)THEN
236 DO j = 1, nb
237 i = index(j)
238 il = nsv(i)
239 nod = nlg(il)
240 buf(p)%p(l+1) = xa(1,il)
241 buf(p)%p(l+2) = xa(2,il)
242 buf(p)%p(l+3) = xa(3,il)
243 buf(p)%p(l+4) = i
244 buf(p)%p(l+5) = va(1,il)
245 buf(p)%p(l+6) = va(2,il)
246 buf(p)%p(l+7) = va(3,il)
247 buf(p)%p(l+8) = ms(nod)
248 buf(p)%p(l+9) = stfa(il)
249 buf(p)%p(l+10)= itab(nod)
250 buf(p)%p(l+11)= kinet(nod)
251 buf(p)%p(l+12)= nbinflg(il)
252 buf(p)%p(l+13)= dxanc(1,il)
253 buf(p)%p(l+14)= dxanc(2,il)
254 buf(p)%p(l+15)= dxanc(3,il)
255 buf(p)%p(l+16)= dvanc(1,il)
256 buf(p)%p(l+17)= dvanc(2,il)
257 buf(p)%p(l+18)= dvanc(3,il)
258 l = l + siz
259 END DO
260C /DT/NODA/AMS
261 ELSE
262 DO j = 1, nb
263 i = index(j)
264 il = nsv(i)
265 nod = nlg(il)
266 buf(p)%p(l+1) = xa(1,il)
267 buf(p)%p(l+2) = xa(2,il)
268 buf(p)%p(l+3) = xa(3,il)
269 buf(p)%p(l+4) = i
270 buf(p)%p(l+5) = va(1,il)
271 buf(p)%p(l+6) = va(2,il)
272 buf(p)%p(l+7) = va(3,il)
273 buf(p)%p(l+8) = ms(nod)
274 buf(p)%p(l+9) = stfa(il)
275 buf(p)%p(l+10)= itab(nod)
276 buf(p)%p(l+11)= kinet(nod)
277 buf(p)%p(l+12)= nbinflg(il)
278 buf(p)%p(l+13)= diag_sms(nod)
279 buf(p)%p(l+14)= dxanc(1,il)
280 buf(p)%p(l+15)= dxanc(2,il)
281 buf(p)%p(l+16)= dxanc(3,il)
282 buf(p)%p(l+17)= dvanc(1,il)
283 buf(p)%p(l+18)= dvanc(2,il)
284 buf(p)%p(l+19)= dvanc(3,il)
285 l = l + siz
286 END DO
287 END IF
288C fin /DT/NODA/AMS
289 ELSE
290 IF(idtmins==0)THEN
291 DO j = 1, nb
292 i = index(j)
293 il = nsv(i)
294 nod = nlg(il)
295 buf(p)%p(l+1) = xa(1,il)
296 buf(p)%p(l+2) = xa(2,il)
297 buf(p)%p(l+3) = xa(3,il)
298 buf(p)%p(l+4) = i
299 buf(p)%p(l+5) = va(1,il)
300 buf(p)%p(l+6) = va(2,il)
301 buf(p)%p(l+7) = va(3,il)
302 buf(p)%p(l+8) = ms(nod)
303 buf(p)%p(l+9) = stfa(il)
304 buf(p)%p(l+10)= itab(nod)
305 buf(p)%p(l+11)= kinet(nod)
306 buf(p)%p(l+12)= nbinflg(il)
307 buf(p)%p(l+13)= gap_s(i)
308 buf(p)%p(l+14)= dxanc(1,il)
309 buf(p)%p(l+15)= dxanc(2,il)
310 buf(p)%p(l+16)= dxanc(3,il)
311 buf(p)%p(l+17)= dvanc(1,il)
312 buf(p)%p(l+18)= dvanc(2,il)
313 buf(p)%p(l+19)= dvanc(3,il)
314 l = l + siz
315 END DO
316C /DT/NODA/AMS
317 ELSE
318 DO j = 1, nb
319 i = index(j)
320 il = nsv(i)
321 nod = nlg(il)
322 buf(p)%p(l+1) = xa(1,il)
323 buf(p)%p(l+2) = xa(2,il)
324 buf(p)%p(l+3) = xa(3,il)
325 buf(p)%p(l+4) = i
326 buf(p)%p(l+5) = va(1,il)
327 buf(p)%p(l+6) = va(2,il)
328 buf(p)%p(l+7) = va(3,il)
329 buf(p)%p(l+8) = ms(nod)
330 buf(p)%p(l+9) = stfa(il)
331 buf(p)%p(l+10)= itab(nod)
332 buf(p)%p(l+11)= kinet(nod)
333 buf(p)%p(l+12)= nbinflg(il)
334 buf(p)%p(l+13)= gap_s(i)
335 buf(p)%p(l+14)= diag_sms(nod)
336 buf(p)%p(l+15)= dxanc(1,il)
337 buf(p)%p(l+16)= dxanc(2,il)
338 buf(p)%p(l+17)= dxanc(3,il)
339 buf(p)%p(l+18)= dvanc(1,il)
340 buf(p)%p(l+19)= dvanc(2,il)
341 buf(p)%p(l+20)= dvanc(3,il)
342 l = l + siz
343 END DO
344 END IF
345C fin /DT/NODA/AMS
346 ENDIF
347C + la thermique
348 ELSE
349 IF(igap==0) THEN
350 IF(idtmins==0)THEN
351 DO j = 1, nb
352 i = index(j)
353 il = nsv(i)
354 nod = nlg(il)
355 buf(p)%p(l+1) = xa(1,il)
356 buf(p)%p(l+2) = xa(2,il)
357 buf(p)%p(l+3) = xa(3,il)
358 buf(p)%p(l+4) = i
359 buf(p)%p(l+5) = va(1,il)
360 buf(p)%p(l+6) = va(2,il)
361 buf(p)%p(l+7) = va(3,il)
362 buf(p)%p(l+8) = ms(nod)
363 buf(p)%p(l+9) = stfa(il)
364 buf(p)%p(l+10)= itab(nod)
365 buf(p)%p(l+11)= kinet(nod)
366 buf(p)%p(l+12)= nbinflg(il)
367 buf(p)%p(l+13)= temp(nod)
368 buf(p)%p(l+14)= ielec(i)
369 buf(p)%p(l+15)= areas(i)
370 buf(p)%p(l+16)= dxanc(1,il)
371 buf(p)%p(l+17)= dxanc(2,il)
372 buf(p)%p(l+18)= dxanc(3,il)
373 buf(p)%p(l+19)= dvanc(1,il)
374 buf(p)%p(l+20)= dvanc(2,il)
375 buf(p)%p(l+21)= dvanc(3,il)
376 l = l + siz
377 END DO
378C /DT/NODA/AMS
379 ELSE
380 DO j = 1, nb
381 i = index(j)
382 il = nsv(i)
383 nod = nlg(il)
384 buf(p)%p(l+1) = xa(1,il)
385 buf(p)%p(l+2) = xa(2,il)
386 buf(p)%p(l+3) = xa(3,il)
387 buf(p)%p(l+4) = i
388 buf(p)%p(l+5) = va(1,il)
389 buf(p)%p(l+6) = va(2,il)
390 buf(p)%p(l+7) = va(3,il)
391 buf(p)%p(l+8) = ms(nod)
392 buf(p)%p(l+9) = stfa(il)
393 buf(p)%p(l+10)= itab(nod)
394 buf(p)%p(l+11)= kinet(nod)
395 buf(p)%p(l+12)= nbinflg(il)
396 buf(p)%p(l+13)= temp(nod)
397 buf(p)%p(l+14)= ielec(i)
398 buf(p)%p(l+15)= areas(i)
399 buf(p)%p(l+16)= diag_sms(nod)
400 buf(p)%p(l+17)= dxanc(1,il)
401 buf(p)%p(l+18)= dxanc(2,il)
402 buf(p)%p(l+19)= dxanc(3,il)
403 buf(p)%p(l+20)= dvanc(1,il)
404 buf(p)%p(l+21)= dvanc(2,il)
405 buf(p)%p(l+22)= dvanc(3,il)
406 l = l + siz
407 END DO
408 END IF
409C fin /DT/NODA/AMS
410 ELSE
411 IF(idtmins==0)THEN
412 DO j = 1, nb
413 i = index(j)
414 il = nsv(i)
415 nod = nlg(il)
416 buf(p)%p(l+1) = xa(1,il)
417 buf(p)%p(l+2) = xa(2,il)
418 buf(p)%p(l+3) = xa(3,il)
419 buf(p)%p(l+4) = i
420 buf(p)%p(l+5) = va(1,il)
421 buf(p)%p(l+6) = va(2,il)
422 buf(p)%p(l+7) = va(3,il)
423 buf(p)%p(l+8) = ms(nod)
424 buf(p)%p(l+9) = stfa(il)
425 buf(p)%p(l+10)= itab(nod)
426 buf(p)%p(l+11)= kinet(nod)
427 buf(p)%p(l+12)= nbinflg(il)
428 buf(p)%p(l+13)= gap_s(i)
429 buf(p)%p(l+14)= temp(nod)
430 buf(p)%p(l+15)= ielec(i)
431 buf(p)%p(l+16)= areas(i)
432 buf(p)%p(l+17)= dxanc(1,il)
433 buf(p)%p(l+18)= dxanc(2,il)
434 buf(p)%p(l+19)= dxanc(3,il)
435 buf(p)%p(l+20)= dvanc(1,il)
436 buf(p)%p(l+21)= dvanc(2,il)
437 buf(p)%p(l+22)= dvanc(3,il)
438 l = l + siz
439 END DO
440C /DT/NODA/AMS
441 ELSE
442 DO j = 1, nb
443 i = index(j)
444 il = nsv(i)
445 nod = nlg(il)
446 buf(p)%p(l+1) = xa(1,il)
447 buf(p)%p(l+2) = xa(2,il)
448 buf(p)%p(l+3) = xa(3,il)
449 buf(p)%p(l+4) = i
450 buf(p)%p(l+5) = va(1,il)
451 buf(p)%p(l+6) = va(2,il)
452 buf(p)%p(l+7) = va(3,il)
453 buf(p)%p(l+8) = ms(nod)
454 buf(p)%p(l+9) = stfa(il)
455 buf(p)%p(l+10)= itab(nod)
456 buf(p)%p(l+11)= kinet(nod)
457 buf(p)%p(l+12)= nbinflg(il)
458 buf(p)%p(l+13)= gap_s(i)
459 buf(p)%p(l+14)= temp(nod)
460 buf(p)%p(l+15)= ielec(i)
461 buf(p)%p(l+16)= areas(i)
462 buf(p)%p(l+17)= diag_sms(nod)
463 buf(p)%p(l+18)= dxanc(1,il)
464 buf(p)%p(l+19)= dxanc(2,il)
465 buf(p)%p(l+20)= dxanc(3,il)
466 buf(p)%p(l+21)= dvanc(1,il)
467 buf(p)%p(l+22)= dvanc(2,il)
468 buf(p)%p(l+23)= dvanc(3,il)
469 l = l + siz
470 END DO
471 END IF
472C fin /DT/NODA/AMS
473 ENDIF
474 ENDIF
475 ELSE ! INACTI = 5 or 6
476 IF(intth == 0 ) THEN
477 IF(igap==0) THEN
478 IF(idtmins==0)THEN
479 DO j = 1, nb
480 i = index(j)
481 il = nsv(i)
482 nod = nlg(il)
483 buf(p)%p(l+1) = xa(1,il)
484 buf(p)%p(l+2) = xa(2,il)
485 buf(p)%p(l+3) = xa(3,il)
486 buf(p)%p(l+4) = i
487 buf(p)%p(l+5) = va(1,il)
488 buf(p)%p(l+6) = va(2,il)
489 buf(p)%p(l+7) = va(3,il)
490 buf(p)%p(l+8) = ms(nod)
491 buf(p)%p(l+9) = stfa(il)
492 buf(p)%p(l+10)= itab(nod)
493 buf(p)%p(l+11)= kinet(nod)
494 buf(p)%p(l+12)= nbinflg(il)
495 buf(p)%p(l+13)= penis(1,i)
496 buf(p)%p(l+14)= penis(2,i)
497 buf(p)%p(l+15)= penia(1,il)
498 buf(p)%p(l+16)= penia(2,il)
499 buf(p)%p(l+17)= penia(3,il)
500 buf(p)%p(l+18)= penia(4,il)
501 buf(p)%p(l+19)= penia(5,il)
502 buf(p)%p(l+20)= dxanc(1,il)
503 buf(p)%p(l+21)= dxanc(2,il)
504 buf(p)%p(l+22)= dxanc(3,il)
505 buf(p)%p(l+23)= dvanc(1,il)
506 buf(p)%p(l+24)= dvanc(2,il)
507 buf(p)%p(l+25)= dvanc(3,il)
508 l = l + siz
509 END DO
510C /DT/NODA/AMS
511 ELSE
512 DO j = 1, nb
513 i = index(j)
514 il = nsv(i)
515 nod = nlg(il)
516 buf(p)%p(l+1) = xa(1,il)
517 buf(p)%p(l+2) = xa(2,il)
518 buf(p)%p(l+3) = xa(3,il)
519 buf(p)%p(l+4) = i
520 buf(p)%p(l+5) = va(1,il)
521 buf(p)%p(l+6) = va(2,il)
522 buf(p)%p(l+7) = va(3,il)
523 buf(p)%p(l+8) = ms(nod)
524 buf(p)%p(l+9) = stfa(il)
525 buf(p)%p(l+10)= itab(nod)
526 buf(p)%p(l+11)= kinet(nod)
527 buf(p)%p(l+12)= nbinflg(il)
528 buf(p)%p(l+13)= penis(1,i)
529 buf(p)%p(l+14)= penis(2,i)
530 buf(p)%p(l+15)= penia(1,il)
531 buf(p)%p(l+16)= penia(2,il)
532 buf(p)%p(l+17)= penia(3,il)
533 buf(p)%p(l+18)= penia(4,il)
534 buf(p)%p(l+19)= penia(5,il)
535 buf(p)%p(l+20)= diag_sms(nod)
536 buf(p)%p(l+21)= dxanc(1,il)
537 buf(p)%p(l+22)= dxanc(2,il)
538 buf(p)%p(l+23)= dxanc(3,il)
539 buf(p)%p(l+24)= dvanc(1,il)
540 buf(p)%p(l+25)= dvanc(2,il)
541 buf(p)%p(l+26)= dvanc(3,il)
542 l = l + siz
543 END DO
544 END IF
545C fin /DT/NODA/AMS
546 ELSE
547 IF(idtmins==0)THEN
548 DO j = 1, nb
549 i = index(j)
550 il = nsv(i)
551 nod = nlg(il)
552 buf(p)%p(l+1) = xa(1,il)
553 buf(p)%p(l+2) = xa(2,il)
554 buf(p)%p(l+3) = xa(3,il)
555 buf(p)%p(l+4) = i
556 buf(p)%p(l+5) = va(1,il)
557 buf(p)%p(l+6) = va(2,il)
558 buf(p)%p(l+7) = va(3,il)
559 buf(p)%p(l+8) = ms(nod)
560 buf(p)%p(l+9) = stfa(il)
561 buf(p)%p(l+10)= itab(nod)
562 buf(p)%p(l+11)= kinet(nod)
563 buf(p)%p(l+12)= nbinflg(il)
564 buf(p)%p(l+13)= gap_s(i)
565 buf(p)%p(l+14)= penis(1,i)
566 buf(p)%p(l+15)= penis(2,i)
567 buf(p)%p(l+16)= penia(1,il)
568 buf(p)%p(l+17)= penia(2,il)
569 buf(p)%p(l+18)= penia(3,il)
570 buf(p)%p(l+19)= penia(4,il)
571 buf(p)%p(l+20)= penia(5,il)
572 buf(p)%p(l+21)= dxanc(1,il)
573 buf(p)%p(l+22)= dxanc(2,il)
574 buf(p)%p(l+23)= dxanc(3,il)
575 buf(p)%p(l+24)= dvanc(1,il)
576 buf(p)%p(l+25)= dvanc(2,il)
577 buf(p)%p(l+26)= dvanc(3,il)
578 l = l + siz
579 END DO
580C /DT/NODA/AMS
581 ELSE
582 DO j = 1, nb
583 i = index(j)
584 il = nsv(i)
585 nod = nlg(il)
586 buf(p)%p(l+1) = xa(1,il)
587 buf(p)%p(l+2) = xa(2,il)
588 buf(p)%p(l+3) = xa(3,il)
589 buf(p)%p(l+4) = i
590 buf(p)%p(l+5) = va(1,il)
591 buf(p)%p(l+6) = va(2,il)
592 buf(p)%p(l+7) = va(3,il)
593 buf(p)%p(l+8) = ms(nod)
594 buf(p)%p(l+9) = stfa(il)
595 buf(p)%p(l+10)= itab(nod)
596 buf(p)%p(l+11)= kinet(nod)
597 buf(p)%p(l+12)= nbinflg(il)
598 buf(p)%p(l+13)= gap_s(i)
599 buf(p)%p(l+14)= penis(1,i)
600 buf(p)%p(l+15)= penis(2,i)
601 buf(p)%p(l+16)= penia(1,il)
602 buf(p)%p(l+17)= penia(2,il)
603 buf(p)%p(l+18)= penia(3,il)
604 buf(p)%p(l+19)= penia(4,il)
605 buf(p)%p(l+20)= penia(5,il)
606 buf(p)%p(l+21)= diag_sms(nod)
607 buf(p)%p(l+22)= dxanc(1,il)
608 buf(p)%p(l+23)= dxanc(2,il)
609 buf(p)%p(l+24)= dxanc(3,il)
610 buf(p)%p(l+25)= dvanc(1,il)
611 buf(p)%p(l+26)= dvanc(2,il)
612 buf(p)%p(l+27)= dvanc(3,il)
613 l = l + siz
614 END DO
615 END IF
616C fin /DT/NODA/AMS
617 ENDIF
618C + la thermique
619 ELSE
620 IF(igap==0) THEN
621 IF(idtmins==0)THEN
622 DO j = 1, nb
623 i = index(j)
624 il = nsv(i)
625 nod = nlg(il)
626 buf(p)%p(l+1) = xa(1,il)
627 buf(p)%p(l+2) = xa(2,il)
628 buf(p)%p(l+3) = xa(3,il)
629 buf(p)%p(l+4) = i
630 buf(p)%p(l+5) = va(1,il)
631 buf(p)%p(l+6) = va(2,il)
632 buf(p)%p(l+7) = va(3,il)
633 buf(p)%p(l+8) = ms(nod)
634 buf(p)%p(l+9) = stfa(il)
635 buf(p)%p(l+10)= itab(nod)
636 buf(p)%p(l+11)= kinet(nod)
637 buf(p)%p(l+12)= nbinflg(il)
638 buf(p)%p(l+13)= temp(nod)
639 buf(p)%p(l+14)= ielec(i)
640 buf(p)%p(l+15)= areas(i)
641 buf(p)%p(l+16)= penis(1,i)
642 buf(p)%p(l+17)= penis(2,i)
643 buf(p)%p(l+18)= penia(1,il)
644 buf(p)%p(l+19)= penia(2,il)
645 buf(p)%p(l+20)= penia(3,il)
646 buf(p)%p(l+21)= penia(4,il)
647 buf(p)%p(l+22)= penia(5,il)
648 buf(p)%p(l+23)= dxanc(1,il)
649 buf(p)%p(l+24)= dxanc(2,il)
650 buf(p)%p(l+25)= dxanc(3,il)
651 buf(p)%p(l+26)= dvanc(1,il)
652 buf(p)%p(l+27)= dvanc(2,il)
653 buf(p)%p(l+28)= dvanc(3,il)
654 l = l + siz
655 END DO
656C /DT/NODA/AMS
657 ELSE
658 DO j = 1, nb
659 i = index(j)
660 il = nsv(i)
661 nod = nlg(il)
662 buf(p)%p(l+1) = xa(1,il)
663 buf(p)%p(l+2) = xa(2,il)
664 buf(p)%p(l+3) = xa(3,il)
665 buf(p)%p(l+4) = i
666 buf(p)%p(l+5) = va(1,il)
667 buf(p)%p(l+6) = va(2,il)
668 buf(p)%p(l+7) = va(3,il)
669 buf(p)%p(l+8) = ms(nod)
670 buf(p)%p(l+9) = stfa(il)
671 buf(p)%p(l+10)= itab(nod)
672 buf(p)%p(l+11)= kinet(nod)
673 buf(p)%p(l+12)= nbinflg(il)
674 buf(p)%p(l+13)= temp(nod)
675 buf(p)%p(l+14)= ielec(i)
676 buf(p)%p(l+15)= areas(i)
677 buf(p)%p(l+16)= penis(1,i)
678 buf(p)%p(l+17)= penis(2,i)
679 buf(p)%p(l+18)= penia(1,il)
680 buf(p)%p(l+19)= penia(2,il)
681 buf(p)%p(l+20)= penia(3,il)
682 buf(p)%p(l+21)= penia(4,il)
683 buf(p)%p(l+22)= penia(5,il)
684 buf(p)%p(l+23)= diag_sms(nod)
685 buf(p)%p(l+24)= dxanc(1,il)
686 buf(p)%p(l+25)= dxanc(2,il)
687 buf(p)%p(l+26)= dxanc(3,il)
688 buf(p)%p(l+27)= dvanc(1,il)
689 buf(p)%p(l+28)= dvanc(2,il)
690 buf(p)%p(l+29)= dvanc(3,il)
691 l = l + siz
692 END DO
693 END IF
694C fin /DT/NODA/AMS
695 ELSE
696 IF(idtmins==0)THEN
697 DO j = 1, nb
698 i = index(j)
699 il = nsv(i)
700 nod = nlg(il)
701 buf(p)%p(l+1) = xa(1,il)
702 buf(p)%p(l+2) = xa(2,il)
703 buf(p)%p(l+3) = xa(3,il)
704 buf(p)%p(l+4) = i
705 buf(p)%p(l+5) = va(1,il)
706 buf(p)%p(l+6) = va(2,il)
707 buf(p)%p(l+7) = va(3,il)
708 buf(p)%p(l+8) = ms(nod)
709 buf(p)%p(l+9) = stfa(il)
710 buf(p)%p(l+10)= itab(nod)
711 buf(p)%p(l+11)= kinet(nod)
712 buf(p)%p(l+12)= nbinflg(il)
713 buf(p)%p(l+13)= gap_s(i)
714 buf(p)%p(l+14)= temp(nod)
715 buf(p)%p(l+15)= ielec(i)
716 buf(p)%p(l+16)= areas(i)
717 buf(p)%p(l+17)= penis(1,i)
718 buf(p)%p(l+18)= penis(2,i)
719 buf(p)%p(l+19)= penia(1,il)
720 buf(p)%p(l+20)= penia(2,il)
721 buf(p)%p(l+21)= penia(3,il)
722 buf(p)%p(l+22)= penia(4,il)
723 buf(p)%p(l+23)= penia(5,il)
724 buf(p)%p(l+24)= dxanc(1,il)
725 buf(p)%p(l+25)= dxanc(2,il)
726 buf(p)%p(l+26)= dxanc(3,il)
727 buf(p)%p(l+27)= dvanc(1,il)
728 buf(p)%p(l+28)= dvanc(2,il)
729 buf(p)%p(l+29)= dvanc(3,il)
730 l = l + siz
731 END DO
732C /DT/NODA/AMS
733 ELSE
734 DO j = 1, nb
735 i = index(j)
736 il = nsv(i)
737 nod = nlg(il)
738 buf(p)%p(l+1) = xa(1,il)
739 buf(p)%p(l+2) = xa(2,il)
740 buf(p)%p(l+3) = xa(3,il)
741 buf(p)%p(l+4) = i
742 buf(p)%p(l+5) = va(1,il)
743 buf(p)%p(l+6) = va(2,il)
744 buf(p)%p(l+7) = va(3,il)
745 buf(p)%p(l+8) = ms(nod)
746 buf(p)%p(l+9) = stfa(il)
747 buf(p)%p(l+10)= itab(nod)
748 buf(p)%p(l+11)= kinet(nod)
749 buf(p)%p(l+12)= nbinflg(il)
750 buf(p)%p(l+13)= gap_s(i)
751 buf(p)%p(l+14)= temp(nod)
752 buf(p)%p(l+15)= ielec(i)
753 buf(p)%p(l+16)= areas(i)
754 buf(p)%p(l+17)= penis(1,i)
755 buf(p)%p(l+18)= penis(2,i)
756 buf(p)%p(l+19)= penia(1,il)
757 buf(p)%p(l+20)= penia(2,il)
758 buf(p)%p(l+21)= penia(3,il)
759 buf(p)%p(l+22)= penia(4,il)
760 buf(p)%p(l+23)= penia(5,il)
761 buf(p)%p(l+24)= diag_sms(nod)
762 buf(p)%p(l+25)= dxanc(1,il)
763 buf(p)%p(l+26)= dxanc(2,il)
764 buf(p)%p(l+27)= dxanc(3,il)
765 buf(p)%p(l+28)= dvanc(1,il)
766 buf(p)%p(l+29)= dvanc(2,il)
767 buf(p)%p(l+30)= dvanc(3,il)
768 l = l + siz
769 END DO
770 END IF
771C fin /DT/NODA/AMS
772 ENDIF
773 ENDIF
774 END IF
775 ELSEIF(idtmins==2)THEN
776C /DT/AMS
777 IF(inacti/=5.AND.inacti/=6) THEN
778 IF(intth == 0 ) THEN
779 IF(igap==0) THEN
780 DO j = 1, nb
781 i = index(j)
782 il = nsv(i)
783 nod = nlg(il)
784 buf(p)%p(l+1) = xa(1,il)
785 buf(p)%p(l+2) = xa(2,il)
786 buf(p)%p(l+3) = xa(3,il)
787 buf(p)%p(l+4) = i
788 buf(p)%p(l+5) = va(1,il)
789 buf(p)%p(l+6) = va(2,il)
790 buf(p)%p(l+7) = va(3,il)
791 buf(p)%p(l+8) = ms(nod)
792 buf(p)%p(l+9) = stfa(il)
793 buf(p)%p(l+10)= itab(nod)
794 buf(p)%p(l+11)= kinet(nod)
795 buf(p)%p(l+12)= nbinflg(il)
796 buf(p)%p(l+13)= diag_sms(nod)
797 buf(p)%p(l+14)= nodnx_sms(nod)
798 buf(p)%p(l+15)= nod
799 buf(p)%p(l+16)= dxanc(1,il)
800 buf(p)%p(l+17)= dxanc(2,il)
801 buf(p)%p(l+18)= dxanc(3,il)
802 buf(p)%p(l+19)= dvanc(1,il)
803 buf(p)%p(l+20)= dvanc(2,il)
804 buf(p)%p(l+21)= dvanc(3,il)
805 l = l + siz
806 END DO
807 ELSE
808 DO j = 1, nb
809 i = index(j)
810 il = nsv(i)
811 nod = nlg(il)
812 buf(p)%p(l+1) = xa(1,il)
813 buf(p)%p(l+2) = xa(2,il)
814 buf(p)%p(l+3) = xa(3,il)
815 buf(p)%p(l+4) = i
816 buf(p)%p(l+5) = va(1,il)
817 buf(p)%p(l+6) = va(2,il)
818 buf(p)%p(l+7) = va(3,il)
819 buf(p)%p(l+8) = ms(nod)
820 buf(p)%p(l+9) = stfa(il)
821 buf(p)%p(l+10)= itab(nod)
822 buf(p)%p(l+11)= kinet(nod)
823 buf(p)%p(l+12)= nbinflg(il)
824 buf(p)%p(l+13)= gap_s(i)
825 buf(p)%p(l+14)= diag_sms(nod)
826 buf(p)%p(l+15)= nodnx_sms(nod)
827 buf(p)%p(l+16)= nod
828 buf(p)%p(l+17)= dxanc(1,il)
829 buf(p)%p(l+18)= dxanc(2,il)
830 buf(p)%p(l+19)= dxanc(3,il)
831 buf(p)%p(l+20)= dvanc(1,il)
832 buf(p)%p(l+21)= dvanc(2,il)
833 buf(p)%p(l+22)= dvanc(3,il)
834 l = l + siz
835 END DO
836 ENDIF
837C + la thermique
838 ELSE
839 IF(igap==0) THEN
840 DO j = 1, nb
841 i = index(j)
842 il = nsv(i)
843 nod = nlg(il)
844 buf(p)%p(l+1) = xa(1,il)
845 buf(p)%p(l+2) = xa(2,il)
846 buf(p)%p(l+3) = xa(3,il)
847 buf(p)%p(l+4) = i
848 buf(p)%p(l+5) = va(1,il)
849 buf(p)%p(l+6) = va(2,il)
850 buf(p)%p(l+7) = va(3,il)
851 buf(p)%p(l+8) = ms(nod)
852 buf(p)%p(l+9) = stfa(il)
853 buf(p)%p(l+10)= itab(nod)
854 buf(p)%p(l+11)= kinet(nod)
855 buf(p)%p(l+12)= nbinflg(il)
856 buf(p)%p(l+13)= temp(nod)
857 buf(p)%p(l+14)= ielec(i)
858 buf(p)%p(l+15)= areas(i)
859 buf(p)%p(l+16)= diag_sms(nod)
860 buf(p)%p(l+17)= nodnx_sms(nod)
861 buf(p)%p(l+18)= nod
862 buf(p)%p(l+19)= dxanc(1,il)
863 buf(p)%p(l+20)= dxanc(2,il)
864 buf(p)%p(l+21)= dxanc(3,il)
865 buf(p)%p(l+22)= dvanc(1,il)
866 buf(p)%p(l+23)= dvanc(2,il)
867 buf(p)%p(l+24)= dvanc(3,il)
868 l = l + siz
869 END DO
870 ELSE
871 DO j = 1, nb
872 i = index(j)
873 il = nsv(i)
874 nod = nlg(il)
875 buf(p)%p(l+1) = xa(1,il)
876 buf(p)%p(l+2) = xa(2,il)
877 buf(p)%p(l+3) = xa(3,il)
878 buf(p)%p(l+4) = i
879 buf(p)%p(l+5) = va(1,il)
880 buf(p)%p(l+6) = va(2,il)
881 buf(p)%p(l+7) = va(3,il)
882 buf(p)%p(l+8) = ms(nod)
883 buf(p)%p(l+9) = stfa(il)
884 buf(p)%p(l+10)= itab(nod)
885 buf(p)%p(l+11)= kinet(nod)
886 buf(p)%p(l+12)= nbinflg(il)
887 buf(p)%p(l+13)= gap_s(i)
888 buf(p)%p(l+14)= temp(nod)
889 buf(p)%p(l+15)= ielec(i)
890 buf(p)%p(l+16)= areas(i)
891 buf(p)%p(l+17)= diag_sms(nod)
892 buf(p)%p(l+18)= nodnx_sms(nod)
893 buf(p)%p(l+19)= nod
894 buf(p)%p(l+20)= dxanc(1,il)
895 buf(p)%p(l+21)= dxanc(2,il)
896 buf(p)%p(l+22)= dxanc(3,il)
897 buf(p)%p(l+23)= dvanc(1,il)
898 buf(p)%p(l+24)= dvanc(2,il)
899 buf(p)%p(l+25)= dvanc(3,il)
900 l = l + siz
901 END DO
902 ENDIF
903 ENDIF
904 ELSE ! INACTI = 5 or 6
905 IF(intth == 0 ) THEN
906 IF(igap==0) THEN
907 DO j = 1, nb
908 i = index(j)
909 il = nsv(i)
910 nod = nlg(il)
911 buf(p)%p(l+1) = xa(1,il)
912 buf(p)%p(l+2) = xa(2,il)
913 buf(p)%p(l+3) = xa(3,il)
914 buf(p)%p(l+4) = i
915 buf(p)%p(l+5) = va(1,il)
916 buf(p)%p(l+6) = va(2,il)
917 buf(p)%p(l+7) = va(3,il)
918 buf(p)%p(l+8) = ms(nod)
919 buf(p)%p(l+9) = stfa(il)
920 buf(p)%p(l+10)= itab(nod)
921 buf(p)%p(l+11)= kinet(nod)
922 buf(p)%p(l+12)= nbinflg(il)
923 buf(p)%p(l+13)= penis(1,i)
924 buf(p)%p(l+14)= penis(2,i)
925 buf(p)%p(l+15)= penia(1,il)
926 buf(p)%p(l+16)= penia(2,il)
927 buf(p)%p(l+17)= penia(3,il)
928 buf(p)%p(l+18)= penia(4,il)
929 buf(p)%p(l+19)= penia(5,il)
930 buf(p)%p(l+20)= diag_sms(nod)
931 buf(p)%p(l+21)= nodnx_sms(nod)
932 buf(p)%p(l+22)= nod
933 buf(p)%p(l+23)= dxanc(1,il)
934 buf(p)%p(l+24)= dxanc(2,il)
935 buf(p)%p(l+25)= dxanc(3,il)
936 buf(p)%p(l+26)= dvanc(1,il)
937 buf(p)%p(l+27)= dvanc(2,il)
938 buf(p)%p(l+28)= dvanc(3,il)
939 l = l + siz
940 END DO
941 ELSE
942 DO j = 1, nb
943 i = index(j)
944 il = nsv(i)
945 nod = nlg(il)
946 buf(p)%p(l+1) = xa(1,il)
947 buf(p)%p(l+2) = xa(2,il)
948 buf(p)%p(l+3) = xa(3,il)
949 buf(p)%p(l+4) = i
950 buf(p)%p(l+5) = va(1,il)
951 buf(p)%p(l+6) = va(2,il)
952 buf(p)%p(l+7) = va(3,il)
953 buf(p)%p(l+8) = ms(nod)
954 buf(p)%p(l+9) = stfa(il)
955 buf(p)%p(l+10)= itab(nod)
956 buf(p)%p(l+11)= kinet(nod)
957 buf(p)%p(l+12)= nbinflg(il)
958 buf(p)%p(l+13)= gap_s(i)
959 buf(p)%p(l+14)= penis(1,i)
960 buf(p)%p(l+15)= penis(2,i)
961 buf(p)%p(l+16)= penia(1,il)
962 buf(p)%p(l+17)= penia(2,il)
963 buf(p)%p(l+18)= penia(3,il)
964 buf(p)%p(l+19)= penia(4,il)
965 buf(p)%p(l+20)= penia(5,il)
966 buf(p)%p(l+21)= diag_sms(nod)
967 buf(p)%p(l+22)= nodnx_sms(nod)
968 buf(p)%p(l+23)= nod
969 buf(p)%p(l+24)= dxanc(1,il)
970 buf(p)%p(l+25)= dxanc(2,il)
971 buf(p)%p(l+26)= dxanc(3,il)
972 buf(p)%p(l+27)= dvanc(1,il)
973 buf(p)%p(l+28)= dvanc(2,il)
974 buf(p)%p(l+29)= dvanc(3,il)
975 l = l + siz
976 END DO
977 ENDIF
978C + la thermique
979 ELSE
980 IF(igap==0) THEN
981 DO j = 1, nb
982 i = index(j)
983 il = nsv(i)
984 nod = nlg(il)
985 buf(p)%p(l+1) = xa(1,il)
986 buf(p)%p(l+2) = xa(2,il)
987 buf(p)%p(l+3) = xa(3,il)
988 buf(p)%p(l+4) = i
989 buf(p)%p(l+5) = va(1,il)
990 buf(p)%p(l+6) = va(2,il)
991 buf(p)%p(l+7) = va(3,il)
992 buf(p)%p(l+8) = ms(nod)
993 buf(p)%p(l+9) = stfa(il)
994 buf(p)%p(l+10)= itab(nod)
995 buf(p)%p(l+11)= kinet(nod)
996 buf(p)%p(l+12)= nbinflg(il)
997 buf(p)%p(l+13)= temp(nod)
998 buf(p)%p(l+14)= ielec(i)
999 buf(p)%p(l+15)= areas(i)
1000 buf(p)%p(l+16)= penis(1,i)
1001 buf(p)%p(l+17)= penis(2,i)
1002 buf(p)%p(l+18)= penia(1,il)
1003 buf(p)%p(l+19)= penia(2,il)
1004 buf(p)%p(l+20)= penia(3,il)
1005 buf(p)%p(l+21)= penia(4,il)
1006 buf(p)%p(l+22)= penia(5,il)
1007 buf(p)%p(l+23)= diag_sms(nod)
1008 buf(p)%p(l+24)= nodnx_sms(nod)
1009 buf(p)%p(l+25)= nod
1010 buf(p)%p(l+26)= dxanc(1,il)
1011 buf(p)%p(l+27)= dxanc(2,il)
1012 buf(p)%p(l+28)= dxanc(3,il)
1013 buf(p)%p(l+29)= dvanc(1,il)
1014 buf(p)%p(l+30)= dvanc(2,il)
1015 buf(p)%p(l+31)= dvanc(3,il)
1016 l = l + siz
1017 END DO
1018 ELSE
1019 DO j = 1, nb
1020 i = index(j)
1021 il = nsv(i)
1022 nod = nlg(il)
1023 buf(p)%p(l+1) = xa(1,il)
1024 buf(p)%p(l+2) = xa(2,il)
1025 buf(p)%p(l+3) = xa(3,il)
1026 buf(p)%p(l+4) = i
1027 buf(p)%p(l+5) = va(1,il)
1028 buf(p)%p(l+6) = va(2,il)
1029 buf(p)%p(l+7) = va(3,il)
1030 buf(p)%p(l+8) = ms(nod)
1031 buf(p)%p(l+9) = stfa(il)
1032 buf(p)%p(l+10)= itab(nod)
1033 buf(p)%p(l+11)= kinet(nod)
1034 buf(p)%p(l+12)= nbinflg(il)
1035 buf(p)%p(l+13)= gap_s(i)
1036 buf(p)%p(l+14)= temp(nod)
1037 buf(p)%p(l+15)= ielec(i)
1038 buf(p)%p(l+16)= areas(i)
1039 buf(p)%p(l+17)= penis(1,i)
1040 buf(p)%p(l+18)= penis(2,i)
1041 buf(p)%p(l+19)= penia(1,il)
1042 buf(p)%p(l+20)= penia(2,il)
1043 buf(p)%p(l+21)= penia(3,il)
1044 buf(p)%p(l+22)= penia(4,il)
1045 buf(p)%p(l+23)= penia(5,il)
1046 buf(p)%p(l+24)= diag_sms(nod)
1047 buf(p)%p(l+25)= nodnx_sms(nod)
1048 buf(p)%p(l+26)= nod
1049 buf(p)%p(l+27)= dxanc(1,il)
1050 buf(p)%p(l+28)= dxanc(2,il)
1051 buf(p)%p(l+29)= dxanc(3,il)
1052 buf(p)%p(l+30)= dvanc(1,il)
1053 buf(p)%p(l+31)= dvanc(2,il)
1054 buf(p)%p(l+32)= dvanc(3,il)
1055 l = l + siz
1056 END DO
1057 ENDIF
1058 ENDIF
1059 END IF
1060 ELSE
1061C /DT/INTER/AMS
1062 IF(inacti/=5.AND.inacti/=6) THEN
1063 IF(intth == 0 ) THEN
1064 IF(igap==0) THEN
1065 DO j = 1, nb
1066 i = index(j)
1067 il = nsv(i)
1068 nod = nlg(il)
1069 buf(p)%p(l+1) = xa(1,il)
1070 buf(p)%p(l+2) = xa(2,il)
1071 buf(p)%p(l+3) = xa(3,il)
1072 buf(p)%p(l+4) = i
1073 buf(p)%p(l+5) = va(1,il)
1074 buf(p)%p(l+6) = va(2,il)
1075 buf(p)%p(l+7) = va(3,il)
1076 buf(p)%p(l+8) = ms(nod)
1077 buf(p)%p(l+9) = stfa(il)
1078 buf(p)%p(l+10)= itab(nod)
1079 buf(p)%p(l+11)= kinet(nod)
1080 buf(p)%p(l+12)= nbinflg(il)
1081 buf(p)%p(l+13)= diag_sms(nod)
1082 buf(p)%p(l+14)= nod
1083 buf(p)%p(l+15)= dxanc(1,il)
1084 buf(p)%p(l+16)= dxanc(2,il)
1085 buf(p)%p(l+17)= dxanc(3,il)
1086 buf(p)%p(l+18)= dvanc(1,il)
1087 buf(p)%p(l+19)= dvanc(2,il)
1088 buf(p)%p(l+20)= dvanc(3,il)
1089 l = l + siz
1090 END DO
1091 ELSE
1092 DO j = 1, nb
1093 i = index(j)
1094 il = nsv(i)
1095 nod = nlg(il)
1096 buf(p)%p(l+1) = xa(1,il)
1097 buf(p)%p(l+2) = xa(2,il)
1098 buf(p)%p(l+3) = xa(3,il)
1099 buf(p)%p(l+4) = i
1100 buf(p)%p(l+5) = va(1,il)
1101 buf(p)%p(l+6) = va(2,il)
1102 buf(p)%p(l+7) = va(3,il)
1103 buf(p)%p(l+8) = ms(nod)
1104 buf(p)%p(l+9) = stfa(il)
1105 buf(p)%p(l+10)= itab(nod)
1106 buf(p)%p(l+11)= kinet(nod)
1107 buf(p)%p(l+12)= nbinflg(il)
1108 buf(p)%p(l+13)= gap_s(i)
1109 buf(p)%p(l+14)= diag_sms(nod)
1110 buf(p)%p(l+15)= nod
1111 buf(p)%p(l+16)= dxanc(1,il)
1112 buf(p)%p(l+17)= dxanc(2,il)
1113 buf(p)%p(l+18)= dxanc(3,il)
1114 buf(p)%p(l+19)= dvanc(1,il)
1115 buf(p)%p(l+20)= dvanc(2,il)
1116 buf(p)%p(l+21)= dvanc(3,il)
1117 l = l + siz
1118 END DO
1119 ENDIF
1120C + la thermique
1121 ELSE
1122 IF(igap==0) THEN
1123 DO j = 1, nb
1124 i = index(j)
1125 il = nsv(i)
1126 nod = nlg(il)
1127 buf(p)%p(l+1) = xa(1,il)
1128 buf(p)%p(l+2) = xa(2,il)
1129 buf(p)%p(l+3) = xa(3,il)
1130 buf(p)%p(l+4) = i
1131 buf(p)%p(l+5) = va(1,il)
1132 buf(p)%p(l+6) = va(2,il)
1133 buf(p)%p(l+7) = va(3,il)
1134 buf(p)%p(l+8) = ms(nod)
1135 buf(p)%p(l+9) = stfa(il)
1136 buf(p)%p(l+10)= itab(nod)
1137 buf(p)%p(l+11)= kinet(nod)
1138 buf(p)%p(l+12)= nbinflg(il)
1139 buf(p)%p(l+13)= temp(nod)
1140 buf(p)%p(l+14)= ielec(i)
1141 buf(p)%p(l+15)= areas(i)
1142 buf(p)%p(l+16)= diag_sms(nod)
1143 buf(p)%p(l+17)= nod
1144 buf(p)%p(l+18)= dxanc(1,il)
1145 buf(p)%p(l+19)= dxanc(2,il)
1146 buf(p)%p(l+20)= dxanc(3,il)
1147 buf(p)%p(l+21)= dvanc(1,il)
1148 buf(p)%p(l+22)= dvanc(2,il)
1149 buf(p)%p(l+23)= dvanc(3,il)
1150 l = l + siz
1151 END DO
1152 ELSE
1153 DO j = 1, nb
1154 i = index(j)
1155 il = nsv(i)
1156 nod = nlg(il)
1157 buf(p)%p(l+1) = xa(1,il)
1158 buf(p)%p(l+2) = xa(2,il)
1159 buf(p)%p(l+3) = xa(3,il)
1160 buf(p)%p(l+4) = i
1161 buf(p)%p(l+5) = va(1,il)
1162 buf(p)%p(l+6) = va(2,il)
1163 buf(p)%p(l+7) = va(3,il)
1164 buf(p)%p(l+8) = ms(nod)
1165 buf(p)%p(l+9) = stfa(il)
1166 buf(p)%p(l+10)= itab(nod)
1167 buf(p)%p(l+11)= kinet(nod)
1168 buf(p)%p(l+12)= nbinflg(il)
1169 buf(p)%p(l+13)= gap_s(i)
1170 buf(p)%p(l+14)= temp(nod)
1171 buf(p)%p(l+15)= ielec(i)
1172 buf(p)%p(l+16)= areas(i)
1173 buf(p)%p(l+17)= diag_sms(nod)
1174 buf(p)%p(l+18)= nod
1175 buf(p)%p(l+19)= dxanc(1,il)
1176 buf(p)%p(l+20)= dxanc(2,il)
1177 buf(p)%p(l+21)= dxanc(3,il)
1178 buf(p)%p(l+22)= dvanc(1,il)
1179 buf(p)%p(l+23)= dvanc(2,il)
1180 buf(p)%p(l+24)= dvanc(3,il)
1181 l = l + siz
1182 END DO
1183 ENDIF
1184 ENDIF
1185 ELSE ! INACTI = 5 or 6
1186 IF(intth == 0 ) THEN
1187 IF(igap==0) THEN
1188 DO j = 1, nb
1189 i = index(j)
1190 il = nsv(i)
1191 nod = nlg(il)
1192 buf(p)%p(l+1) = xa(1,il)
1193 buf(p)%p(l+2) = xa(2,il)
1194 buf(p)%p(l+3) = xa(3,il)
1195 buf(p)%p(l+4) = i
1196 buf(p)%p(l+5) = va(1,il)
1197 buf(p)%p(l+6) = va(2,il)
1198 buf(p)%p(l+7) = va(3,il)
1199 buf(p)%p(l+8) = ms(nod)
1200 buf(p)%p(l+9) = stfa(il)
1201 buf(p)%p(l+10)= itab(nod)
1202 buf(p)%p(l+11)= kinet(nod)
1203 buf(p)%p(l+12)= nbinflg(il)
1204 buf(p)%p(l+13)= penis(1,i)
1205 buf(p)%p(l+14)= penis(2,i)
1206 buf(p)%p(l+15)= penia(1,il)
1207 buf(p)%p(l+16)= penia(2,il)
1208 buf(p)%p(l+17)= penia(3,il)
1209 buf(p)%p(l+18)= penia(4,il)
1210 buf(p)%p(l+19)= penia(5,il)
1211 buf(p)%p(l+20)= diag_sms(nod)
1212 buf(p)%p(l+21)= nod
1213 buf(p)%p(l+22)= dxanc(1,il)
1214 buf(p)%p(l+23)= dxanc(2,il)
1215 buf(p)%p(l+24)= dxanc(3,il)
1216 buf(p)%p(l+25)= dvanc(1,il)
1217 buf(p)%p(l+26)= dvanc(2,il)
1218 buf(p)%p(l+27)= dvanc(3,il)
1219 l = l + siz
1220 END DO
1221 ELSE
1222 DO j = 1, nb
1223 i = index(j)
1224 il = nsv(i)
1225 nod = nlg(il)
1226 buf(p)%p(l+1) = xa(1,il)
1227 buf(p)%p(l+2) = xa(2,il)
1228 buf(p)%p(l+3) = xa(3,il)
1229 buf(p)%p(l+4) = i
1230 buf(p)%p(l+5) = va(1,il)
1231 buf(p)%p(l+6) = va(2,il)
1232 buf(p)%p(l+7) = va(3,il)
1233 buf(p)%p(l+8) = ms(nod)
1234 buf(p)%p(l+9) = stfa(il)
1235 buf(p)%p(l+10)= itab(nod)
1236 buf(p)%p(l+11)= kinet(nod)
1237 buf(p)%p(l+12)= nbinflg(il)
1238 buf(p)%p(l+13)= gap_s(i)
1239 buf(p)%p(l+14)= penis(1,i)
1240 buf(p)%p(l+15)= penis(2,i)
1241 buf(p)%p(l+16)= penia(1,il)
1242 buf(p)%p(l+17)= penia(2,il)
1243 buf(p)%p(l+18)= penia(3,il)
1244 buf(p)%p(l+19)= penia(4,il)
1245 buf(p)%p(l+20)= penia(5,il)
1246 buf(p)%p(l+21)= diag_sms(nod)
1247 buf(p)%p(l+22)= nod
1248 buf(p)%p(l+23)= dxanc(1,il)
1249 buf(p)%p(l+24)= dxanc(2,il)
1250 buf(p)%p(l+25)= dxanc(3,il)
1251 buf(p)%p(l+26)= dvanc(1,il)
1252 buf(p)%p(l+27)= dvanc(2,il)
1253 buf(p)%p(l+28)= dvanc(3,il)
1254 l = l + siz
1255 END DO
1256 ENDIF
1257C + la thermique
1258 ELSE
1259 IF(igap==0) THEN
1260 DO j = 1, nb
1261 i = index(j)
1262 il = nsv(i)
1263 nod = nlg(il)
1264 buf(p)%p(l+1) = xa(1,il)
1265 buf(p)%p(l+2) = xa(2,il)
1266 buf(p)%p(l+3) = xa(3,il)
1267 buf(p)%p(l+4) = i
1268 buf(p)%p(l+5) = va(1,il)
1269 buf(p)%p(l+6) = va(2,il)
1270 buf(p)%p(l+7) = va(3,il)
1271 buf(p)%p(l+8) = ms(nod)
1272 buf(p)%p(l+9) = stfa(il)
1273 buf(p)%p(l+10)= itab(nod)
1274 buf(p)%p(l+11)= kinet(nod)
1275 buf(p)%p(l+12)= nbinflg(il)
1276 buf(p)%p(l+13)= temp(nod)
1277 buf(p)%p(l+14)= ielec(i)
1278 buf(p)%p(l+15)= areas(i)
1279 buf(p)%p(l+16)= penis(1,i)
1280 buf(p)%p(l+17)= penis(2,i)
1281 buf(p)%p(l+18)= penia(1,il)
1282 buf(p)%p(l+19)= penia(2,il)
1283 buf(p)%p(l+20)= penia(3,il)
1284 buf(p)%p(l+21)= penia(4,il)
1285 buf(p)%p(l+22)= penia(5,il)
1286 buf(p)%p(l+23)= diag_sms(nod)
1287 buf(p)%p(l+24)= nod
1288 buf(p)%p(l+25)= dxanc(1,il)
1289 buf(p)%p(l+26)= dxanc(2,il)
1290 buf(p)%p(l+27)= dxanc(3,il)
1291 buf(p)%p(l+28)= dvanc(1,il)
1292 buf(p)%p(l+29)= dvanc(2,il)
1293 buf(p)%p(l+30)= dvanc(3,il)
1294 l = l + siz
1295 END DO
1296 ELSE
1297 DO j = 1, nb
1298 i = index(j)
1299 il = nsv(i)
1300 nod = nlg(il)
1301 buf(p)%p(l+1) = xa(1,il)
1302 buf(p)%p(l+2) = xa(2,il)
1303 buf(p)%p(l+3) = xa(3,il)
1304 buf(p)%p(l+4) = i
1305 buf(p)%p(l+5) = va(1,il)
1306 buf(p)%p(l+6) = va(2,il)
1307 buf(p)%p(l+7) = va(3,il)
1308 buf(p)%p(l+8) = ms(nod)
1309 buf(p)%p(l+9) = stfa(il)
1310 buf(p)%p(l+10)= itab(nod)
1311 buf(p)%p(l+11)= kinet(nod)
1312 buf(p)%p(l+12)= nbinflg(il)
1313 buf(p)%p(l+13)= gap_s(i)
1314 buf(p)%p(l+14)= temp(nod)
1315 buf(p)%p(l+15)= ielec(i)
1316 buf(p)%p(l+16)= areas(i)
1317 buf(p)%p(l+17)= penis(1,i)
1318 buf(p)%p(l+18)= penis(2,i)
1319 buf(p)%p(l+19)= penia(1,il)
1320 buf(p)%p(l+20)= penia(2,il)
1321 buf(p)%p(l+21)= penia(3,il)
1322 buf(p)%p(l+22)= penia(4,il)
1323 buf(p)%p(l+23)= penia(5,il)
1324 buf(p)%p(l+24)= diag_sms(nod)
1325 buf(p)%p(l+25)= nod
1326 buf(p)%p(l+26)= dxanc(1,il)
1327 buf(p)%p(l+27)= dxanc(2,il)
1328 buf(p)%p(l+28)= dxanc(3,il)
1329 buf(p)%p(l+29)= dvanc(1,il)
1330 buf(p)%p(l+30)= dvanc(2,il)
1331 buf(p)%p(l+31)= dvanc(3,il)
1332 l = l + siz
1333 END DO
1334 ENDIF
1335 ENDIF
1336 END IF
1337 END IF
1338C
1339 msgtyp = msgoff3
1340 CALL mpi_isend(
1341 1 buf(p)%P(1),l,mpi_double_precision,it_spmd(p),msgtyp,
1342 2 spmd_comm_world,req_sd2(p),ierror)
1343 ENDIF
1344 ENDDO
1345 ENDIF
1346C
1347C reception des donnees XREM
1348C
1349 IF(ircvfrom(nin,loc_proc)/=0) THEN
1350 nsnr = 0
1351 l=0
1352 DO p = 1, nspmd
1353 nsnfi(nin)%P(p) = 0
1354 IF(isendto(nin,p)/=0) THEN
1355 IF(loc_proc/=p) THEN
1356 msgtyp = msgoff2
1357 CALL mpi_recv(nsnfi(nin)%P(p),1,mpi_integer,it_spmd(p),
1358 . msgtyp,spmd_comm_world,status,ierror)
1359 IF(nsnfi(nin)%P(p)>0) THEN
1360 l=l+1
1361 isindexi(l)=p
1362 nsnr = nsnr + nsnfi(nin)%P(p)
1363 ENDIF
1364 ENDIF
1365 ENDIF
1366 ENDDO
1367 nbirecv=l
1368C
1369C Allocate total size
1370C
1371 IF(nsnr>0) THEN
1372 IF (ir4r8 == 2) THEN
1373 ALLOCATE(xrem(siz,nsnr),stat=ierror)
1374 ELSE
1375 ALLOCATE(xrem(siz,2*nsnr),stat=ierror)
1376 ALLOCATE(irem(1,nsnr),stat=ierror1)
1377 ierror=ierror+ierror1
1378 END IF
1379 IF(ierror/=0) THEN
1380 CALL ancmsg(msgid=20,anmode=aninfo)
1381 CALL arret(2)
1382 ENDIF
1383 ideb = 1
1384 DO l = 1, nbirecv
1385 p = isindexi(l)
1386 len = nsnfi(nin)%P(p)*siz
1387 msgtyp = msgoff3
1388 iad = ideb
1389C correction adresse pour passage tableau XREM SP utilise en DP ds la routine de comm
1390 IF(ir4r8 == 1) iad = 2*ideb-1
1391 CALL mpi_irecv(
1392 1 xrem(1,iad),len,mpi_double_precision,it_spmd(p),
1393 2 msgtyp,spmd_comm_world,req_rd(l),ierror)
1394 ideb = ideb + nsnfi(nin)%P(p)
1395 ENDDO
1396 DO l = 1, nbirecv
1397 CALL mpi_waitany(nbirecv,req_rd,indexi,status,ierror)
1398C P=ISINDEXI(INDEXI)
1399 ENDDO
1400 IF(ir4r8 == 1)THEN
1401 CALL conversion7(xrem,xrem,irem,siz,ideb-1)
1402 END IF
1403 ENDIF
1404 ENDIF
1405C
1406 IF(ircvfrom(nin,loc_proc)/=0) THEN
1407 DO p = 1, nspmd
1408 IF(isendto(nin,p)/=0) THEN
1409 IF(p/=loc_proc) THEN
1410 CALL mpi_wait(req_sb(p),status,ierror)
1411 ENDIF
1412 ENDIF
1413 ENDDO
1414 ENDIF
1415C
1416 IF(isendto(nin,loc_proc)/=0) THEN
1417 DO p = 1, nspmd
1418 IF(ircvfrom(nin,p)/=0) THEN
1419 IF(p/=loc_proc) THEN
1420 CALL mpi_wait(req_sd(p),status,ierror)
1421 IF(nbox(p)/=0) THEN
1422 CALL mpi_wait(req_sd2(p),status,ierror)
1423 DEALLOCATE(buf(p)%p)
1424 END IF
1425 ENDIF
1426 ENDIF
1427 ENDDO
1428 ENDIF
1429C
1430#endif
1431 RETURN
1432 END
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::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
tri7box::irem
integer, dimension(:,:), allocatable irem
Definition tri7box.F:339
conversion7
subroutine conversion7(xrem, xrem_dp, irem, siz, len)
Definition spmd_i7tool.F:7153
spmd_tri20box
subroutine spmd_tri20box(nsv, nsn, xa, va, ms, bminmal, weight, stfa, nin, isendto, ircvfrom, iad_elem, fr_elem, nsnr, igap, gap_s, itab, kinet, ifq, inacti, nsnfiold, intth, ielec, areas, temp, num_imp, nlg, penis, penia, diag_sms, nodnx_sms, nbinflg, dxanc, dvanc)
Definition spmd_tri20box.F:44
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