OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_i7fcom_pon.F File Reference
#include "implicit_f.inc"
#include "macro.inc"
#include "assert.inc"
#include "spmd.inc"
#include "scr05_c.inc"
#include "scr18_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "parit_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_i7fcom_pon (ipari, intlist, nbintc, niskyfi, icodt, secfcum, nstrf, icontact, fcont, igrbric, ixs, ixs16, niskyfie, nbint20, iflag, intbuf_tab, sfskyi, sisky, h3d_data, multi_fvm, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, fsav, interfaces, glob_therm)

Function/Subroutine Documentation

◆ spmd_i7fcom_pon()

subroutine spmd_i7fcom_pon ( integer, dimension(npari,*) ipari,
integer, dimension(*) intlist,
integer nbintc,
integer, dimension(*) niskyfi,
integer, dimension(*) icodt,
secfcum,
integer, dimension(*) nstrf,
integer, dimension(*) icontact,
fcont,
type (group_), dimension(ngrbric) igrbric,
integer, dimension(*) ixs,
integer, dimension(*) ixs16,
integer, dimension(*) niskyfie,
integer nbint20,
integer iflag,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer sfskyi,
integer sisky,
type(h3d_database) h3d_data,
type(multi_fvm_struct) multi_fvm,
integer, dimension(nloadp_hyd_inter,*) tagncont,
integer, dimension(*) kloadpinter,
integer, dimension(*) loadpinter,
integer, dimension(*) loadp_hyd_inter,
dimension(nthvki,*), intent(inout) fsav,
type (interfaces_), intent(in) interfaces,
type (glob_therm_), intent(in) glob_therm )

Definition at line 65 of file spmd_i7fcom_pon.F.

72C-----------------------------------------------
73C M o d u l e s
74C-----------------------------------------------
75 USE tri25ebox
76 USE tri7box
77 USE message_mod
78 USE intbufdef_mod
79 USE heat_mod
80 USE h3d_mod
81 USE groupdef_mod
82 USE multi_fvm_mod
83 USE interfaces_mod
84 USE glob_therm_mod
85C-----------------------------------------------
86C I m p l i c i t T y p e s
87C-----------------------------------------------
88 USE spmd_comm_world_mod, ONLY : spmd_comm_world
89#include "implicit_f.inc"
90#include "macro.inc"
91#include "assert.inc"
92C-----------------------------------------------
93C M e s s a g e P a s s i n g
94C-----------------------------------------------
95#include "spmd.inc"
96C-----------------------------------------------
97C C o m m o n B l o c k s
98C-----------------------------------------------
99#include "scr05_c.inc"
100#include "scr18_c.inc"
101#include "com01_c.inc"
102#include "com04_c.inc"
103#include "param_c.inc"
104#include "task_c.inc"
105#include "parit_c.inc"
106C-----------------------------------------------
107C D u m m y A r g u m e n t s
108C-----------------------------------------------
109 INTEGER IFLAG, NBINTC, NBINT20,
110 . IPARI(NPARI,*), INTLIST(*), NISKYFI(*),
111 . ICODT(*), ICONTACT(*), NSTRF(*),
112 . IXS(*), IXS16(*), NISKYFIE(*),
113 . TAGNCONT(NLOADP_HYD_INTER,*),KLOADPINTER(*),
114 . LOADPINTER(*),LOADP_HYD_INTER(*),
115 . SFSKYI , SISKY
116 my_real
117 . secfcum(7,numnod,nsect), fcont(3,*)
118 my_real, INTENT(INOUT) :: fsav(nthvki,*)
119
120 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
121 TYPE(H3D_DATABASE) :: H3D_DATA
122 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
123 TYPE (INTERFACES_) ,INTENT(IN) :: INTERFACES
124 TYPE (GLOB_THERM_) ,INTENT(IN) :: GLOB_THERM
125C-----------------------------------------------
126 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
127C-----------------------------------------------
128C L o c a l V a r i a b l e s
129C-----------------------------------------------
130#ifdef MPI
131 INTEGER P, L, ADD, LL, NB, LEN, SIZ, KFI, LOC_PROC, MULTIMP, II,
132 . NIN, IDEB, N, MSGTYP, IERROR, IDEBI, NI, NOD, NIE,
133 . IBC, ISECIN, IBAG, NOINT, NTY, LEN11, N1, N2,LENI,INACTI,
134 . IALLOCS, IALLOCR, LEN17, JJ, NAD, IGN, IGE, NMES, NME,
135 . IADM, IES,INTTH,LEN7T,LEN20, LEN20E, INC,LEN11T,
136 . MSGOFF, MSGOFF2,J,K,INTCAREA,
137 . JD(50), KD(50), STATUS(MPI_STATUS_SIZE),
138 . DEBUT(NINTER), DEBUTI(NINTER),
139 . DEBUTE(NINTER), DEBUTIE(NINTER),
140C parasiz car variable en save
141 . REQ_SI(PARASIZ),REQ_S(PARASIZ),REQ_R(PARASIZ),
142 . ISIZRCV(2,PARASIZ),ISIZENV(2,PARASIZ),
143 . NSNFITOT(PARASIZ),NSNSITOT(PARASIZ)
144 INTEGER :: LEN25E ! edge2edge additional length
145 INTEGER SISKY_OLD,LSKYI_OLD,LSKYI_CT
146 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX
147 my_real, DIMENSION(:,:), ALLOCATABLE :: tempo
148 INTEGER, DIMENSION(:,:), ALLOCATABLE :: FTEMP
149 INTEGER INDEXSIZ,MAX_ARRAYS,NUM_ARRAYS,TEMP_SIZ
150 INTEGER :: THOFFSET
151 INTEGER :: NB_TOT_EDGES
152 LOGICAL :: CONDITION
153 DATA msgoff/144/
154 DATA msgoff2/145/
155
156 LOGICAL ITEST
157 my_real ,DIMENSION(:), ALLOCATABLE :: bbufs, bbufr
158 my_real
159 . bid,rbid(1)
160 double precision
161 . zerodp
162 SAVE req_si,req_s,req_r,isizrcv,isizenv,
163 . nsnfitot,nsnsitot,bbufs,iallocs
164C-----------------------------------------------
165C S o u r c e L i n e s
166C-----------------------------------------------
167 zerodp = 0.0
168 bid = zero
169 rbid = zero
170 loc_proc = ispmd + 1
171
172C
173 len = 5
174 IF(kdtint/=0) len = len+1
175 IF(glob_therm%NODADT_THERM == 1) len = len+1
176 len7t = len + 1
177C type11 => 2 impacts pour une factte
178 len11 = 2*(len-1)+1
179 len11t = 2*len+1
180C type17 => 8 impacts
181 len17 = 41
182C type20 => place additionnelle DAANC6
183 len20 = 18*(1+iresp) + 1
184C type20 => place additionnelle DAANC6E (edge)
185 len20e = 36*(1+iresp) + 2
186 len25e = 10 !+ 2
187C
188 IF(iflag==1)THEN
189C
190C Init + ireceive sur taille communication
191C
192 DO p = 1, nspmd
193 isizrcv(1,p)=0
194 isizrcv(2,p)=0
195 isizenv(1,p) = 0
196 isizenv(2,p) = 0
197 nsnfitot(p) = 0
198 nsnsitot(p) = 0
199 IF(p/=loc_proc)THEN
200 siz = 0
201 DO ii = 1, nbintc
202 nin = intlist(ii)
203 IF(multi_fvm%INT18_GLOBAL_LIST(nin)) cycle
204 siz = siz + nsnsi(nin)%P(p)
205C ajout partie egde pour type 20
206 IF(ipari(7,nin)==20)THEN
207 siz = siz + nsnsie(nin)%P(p)
208 END IF
209 IF(ipari(7,nin)==25)THEN
210 siz = siz + 2*nsnsie(nin)%P(p)
211 END IF
212 ENDDO
213 IF(siz>0)THEN
214 nsnsitot(p) = siz
215 msgtyp = msgoff
216 CALL mpi_irecv(
217 . isizrcv(1,p),2,mpi_integer,it_spmd(p),msgtyp,
218 . spmd_comm_world,req_r(p),ierror )
219 ENDIF
220 ENDIF
221 ENDDO
222C
223C Partie 1 envoi et preparation buffer reception
224C
225 DO ii = 1, nbintc
226 nin = intlist(ii)
227 ni = niskyfi(nin)
228 nty = ipari(7,nin)
229 IF(multi_fvm%INT18_GLOBAL_LIST(nin)) cycle
230 IF(ni>0) THEN
231 intth = ipari(47,nin)
232 IF(nty==7.OR.nty==10.OR.nty==22.OR.nty==23.OR.
233 . nty==24.OR.nty==25) THEN
234
235 ALLOCATE(index(ni),stat=ierror)
236 IF(ierror/=0) THEN
237 CALL ancmsg(msgid=20,anmode=aninfo)
238 CALL arret(2)
239 END IF
240
241 IF(intth > 0)THEN
242 ALLOCATE( tempo(len7t,ni),stat=ierror)
243 ELSE
244 ALLOCATE( tempo(len,ni),stat=ierror)
245 ENDIF
246
247 IF(ierror/=0) THEN
248 CALL ancmsg(msgid=20,anmode=aninfo)
249 CALL arret(2)
250 END IF
251
252 DO j=1,ni
253 index(j)=j
254 tempo(1,j)=fskyfi(nin)%P(1,j)
255 tempo(2,j)=fskyfi(nin)%P(2,j)
256 tempo(3,j)=fskyfi(nin)%P(3,j)
257 tempo(4,j)=fskyfi(nin)%P(4,j)
258 ENDDO
259
260 temp_siz=5
261C KDTINT > 0 option
262 IF(nfskyi==5)THEN
263 DO j=1,ni
264 tempo(temp_siz,j)=fskyfi(nin)%P(temp_siz,j)
265 ENDDO
266 temp_siz=temp_siz+1
267 ENDIF
268C Thermique Option
269 IF(intth >0)THEN
270 DO j=1,ni
271 tempo(temp_siz,j)=ftheskyfi(nin)%P(j)
272 ENDDO
273 temp_siz=temp_siz+1
274
275 IF (glob_therm%NODADT_THERM == 1)THEN
276 DO j=1,ni
277 tempo(temp_siz,j)=condnskyfi(nin)%P(j)
278 ENDDO
279 temp_siz=temp_siz+1
280 ENDIF
281 ENDIF
282 CALL sortint(ni,iskyfi(nin)%P(1),index)
283
284 DO j=1,ni
285 k=index(j)
286 fskyfi(nin)%P(1,j)=tempo(1,k)
287 fskyfi(nin)%P(2,j)=tempo(2,k)
288 fskyfi(nin)%P(3,j)=tempo(3,k)
289 fskyfi(nin)%P(4,j)=tempo(4,k)
290 ENDDO
291 temp_siz=5
292
293C KDTINT > 0 option
294 IF(nfskyi==5)THEN
295 DO j=1,ni
296 k=index(j)
297 fskyfi(nin)%P(temp_siz,j)=tempo(temp_siz,k)
298 ENDDO
299 temp_siz=temp_siz+1
300 ENDIF
301C Thermique Option
302 IF(intth >0)THEN
303 DO j=1,ni
304 k=index(j)
305 ftheskyfi(nin)%P(j)=tempo(temp_siz,k)
306 ENDDO
307 temp_siz=temp_siz+1
308
309 IF (glob_therm%NODADT_THERM == 1)THEN
310 DO j=1,ni
311 k=index(j)
312 condnskyfi(nin)%P(j)=tempo(temp_siz,k)
313 ENDDO
314 temp_siz=temp_siz+1
315 ENDIF
316 ENDIF
317 leni = len
318 IF((nty == 7 .AND. intth > 0 ).OR.(nty == 25 .AND. intth > 0 ).OR.
319 + (nty == 22 .AND. intth > 0 )) leni = len7t
320 ELSEIF(nty==11) THEN
321 IF(intth > 0) THEN
322 IF(glob_therm%NODADT_THERM == 1)THEN
323 CALL sorti11tt(ni,iskyfi(nin)%P(1),fskyfi(nin)%P(1,1),
324 + ftheskyfi(nin)%P(1),condnskyfi(nin)%P(1),nfskyi)
325 ELSE
326 CALL sorti11t(ni,iskyfi(nin)%P(1),fskyfi(nin)%P(1,1),
327 + ftheskyfi(nin)%P(1),nfskyi)
328 ENDIF
329 ELSE
330 CALL sorti11(ni,iskyfi(nin)%P(1),fskyfi(nin)%P(1,1),
331 + nfskyi)
332 ENDIF
333c LENI = LEN
334 leni = len11
335 IF(intth >0 ) leni = len11t
336 ELSEIF(nty==17) THEN
337 CALL sorti17(ni,iskyfi(nin)%P(1),fskyfi(nin)%P(1,1))
338 leni = len17
339 ELSEIF(nty==20) THEN
340 CALL sorti20(ni,iskyfi(nin)%P(1),fskyfi(nin)%P(1,1),
341 + nfskyi)
342 leni = len
343 IF(intth > 0 ) leni=len7t
344C routine calcul place supplementaire int20
345 CALL addcomi20(
346 + nsnfi(nin)%P(1),nsvfi(nin)%P(1),isizenv,len20)
347 END IF
348 ELSEIF(ipari(7,nin)==20)THEN ! pour le moment on envoie tjrs
349 CALL addcomi20(
350 + nsnfi(nin)%P(1),nsvfi(nin)%P(1),isizenv,len20)
351 END IF
352C precomptage du nombre de contacts par processeur+calcul nsnfi total
353 IF(ni > 0) THEN
354 CALL intcontp(ni,iskyfi(nin)%P,nsnfi(nin)%P,isizenv,nsnfitot,leni)
355 ELSE
356 DO j = 1, nspmd
357 nsnfitot(j) = nsnfitot(j) + nsnfi(nin)%P(j)
358 END DO
359 ENDIF
360C ajout partie edge
361 IF(nty==20)THEN
362 ni = niskyfie(nin)
363 CALL sorti11(ni,iskyfie(nin)%P(1),fskyfie(nin)%P(1,1),
364 + nfskyi)
365 leni = len11
366C routine calcul place supplementaire int20
367 CALL addcomi20(
368 + nsnfie(nin)%P(1),nsvfie(nin)%P(1),isizenv,len20e)
369C precomptage du nombre de contacts par processeur+calcul nsnfi total
370 CALL intcontp(
371 + ni ,iskyfie(nin)%P(1),nsnfie(nin)%P(1),isizenv,nsnfitot,
372 2 leni)
373 ELSEIF (nty == 25) THEN
374 IF(ipari(macro_nedge,nin) > 0) THEN
375 nie = niskyfie(nin)
376 CALL sorti25(nie,iskyfie(nin)%P(1),fskyfie(nin)%P(1,1),
377 + 4) ! 4 => 4+1 si thermique
378C precomptage du nombre de contacts par processeur+calcul nsnfi total
379 leni = len25e
380 CALL intcontp25e(
381 + nie ,iskyfie(nin)%P(1),nsnfie(nin)%P(1),isizenv,nsnfitot,
382 2 leni)
383 ENDIF
384 END IF
385C
386 IF(nty==7.OR.nty==10.OR.nty==22.OR.nty==23.OR.
387 . nty==24.OR.nty==25) THEN
388 IF (ni > 0 ) THEN
389 DEALLOCATE(tempo,index)
390 ENDIF
391 ENDIF
392
393 ENDDO
394C
395 iallocs = 0
396 DO p = 1, nspmd
397 IF(p/=loc_proc.AND.nsnfitot(p)>0) THEN
398 msgtyp = msgoff
399 CALL mpi_isend(
400 . isizenv(1,p),2,mpi_integer,it_spmd(p),msgtyp,
401 . spmd_comm_world,req_s(p),ierror )
402 iallocs = iallocs + isizenv(1,p)
403 ENDIF
404 END DO
405 ierror=0
406 IF(iallocs>0)
407 + ALLOCATE(bbufs(iallocs+nbintc*nspmd*2),stat=ierror) ! nbintc*NSPMD*2 majorant place supplementaire bufs
408 IF(ierror/=0) THEN
409 CALL ancmsg(msgid=20,anmode=aninfo)
410 CALL arret(2)
411 END IF
412C
413 DO ii = 1, nbintc
414 nin = intlist(ii)
415 debut(nin) = 0
416 debuti(nin) = 1
417 debute(nin) = 0
418 debutie(nin)= 1
419 END DO
420C
421C Send
422C
423 l = 0
424 DO p = 1, nspmd
425 IF(p/=loc_proc.AND.isizenv(1,p)>0)THEN
426 add = l+1
427 DO ii = 1, nbintc
428 nin = intlist(ii)
429 ideb = debut(nin)
430 idebi= debuti(nin)
431 nb = nsnfi(nin)%P(p)
432 nty = ipari(7,nin)
433 intth = ipari(47,nin)
434 IF(multi_fvm%INT18_GLOBAL_LIST(nin)) cycle
435 IF(nty==7.OR.nty==10.OR.nty==20.OR.
436 * nty==22.OR.nty==23.OR.nty==24.OR.
437 * nty==25) THEN
438 leni = len
439 IF(nb>0) THEN
440C
441C rajout comm supplementaire int20
442C
443 IF(nty == 20) THEN
444 DO n = 1, nb
445 bbufs(l+1) = alphakfi(nin)%P(ideb+n)
446 IF(nsvfi(nin)%P(ideb+n)<0)THEN
447C noeud generant une force
448 CALL putdpdaanc(
449 . daanc6fi(nin)%P(1,1,ideb+n),bbufs(l+2),iresp,inc)
450C L = L + INC
451 ELSE ! A optimiser
452 CALL putdpzero(zerodp,bbufs(l+2),iresp,inc)
453 ENDIF
454 l = l + len20
455 ENDDO
456 END IF
457C
458 ll = l+1
459 l = l + 1
460C
461 IF(intth == 0 ) THEN
462 IF(kdtint==0)THEN
463 DO n = 1, nb
464 IF(nsvfi(nin)%P(ideb+n)<0)THEN
465C noeud generant une force
466 nod = -nsvfi(nin)%P(ideb+n)
467 nsvfi(nin)%P(ideb+n)=nod
468 IF(idebi<=niskyfi(nin)) THEN
469 itest = iskyfi(nin)%P(idebi)==ideb+n
470 ELSE
471 itest = .false.
472 ENDIF
473 DO WHILE(itest)
474 bbufs(l+1) = nod
475 bbufs(l+2) = fskyfi(nin)%P(1,idebi)
476 bbufs(l+3) = fskyfi(nin)%P(2,idebi)
477 bbufs(l+4) = fskyfi(nin)%P(3,idebi)
478 bbufs(l+5) = fskyfi(nin)%P(4,idebi)
479 idebi = idebi + 1
480 l = l + len
481 IF(idebi<=niskyfi(nin)) THEN
482 itest = iskyfi(nin)%P(idebi)==ideb+n
483 ELSE
484 itest = .false.
485 ENDIF
486 ENDDO
487 ENDIF
488 ENDDO
489 ELSE
490 DO n = 1, nb
491 IF(nsvfi(nin)%P(ideb+n)<0)THEN
492C noeud generant une force
493 nod = -nsvfi(nin)%P(ideb+n)
494 nsvfi(nin)%P(ideb+n)=nod
495 IF(idebi<=niskyfi(nin)) THEN
496 itest = iskyfi(nin)%P(idebi)==ideb+n
497 ELSE
498 itest = .false.
499 ENDIF
500 DO WHILE(itest)
501 bbufs(l+1) = nod
502 bbufs(l+2) = fskyfi(nin)%P(1,idebi)
503 bbufs(l+3) = fskyfi(nin)%P(2,idebi)
504 bbufs(l+4) = fskyfi(nin)%P(3,idebi)
505 bbufs(l+5) = fskyfi(nin)%P(4,idebi)
506 bbufs(l+6) = fskyfi(nin)%P(5,idebi)
507 idebi = idebi + 1
508 l = l + len
509 IF(idebi<=niskyfi(nin)) THEN
510 itest = iskyfi(nin)%P(idebi)==ideb+n
511 ELSE
512 itest = .false.
513 ENDIF
514 ENDDO
515 ENDIF
516 ENDDO
517 ENDIF
518C
519C --- interface type 7 + la thermique
520C
521 ELSE
522 IF(glob_therm%NODADT_THERM ==1) THEN
523 leni = len7t
524 IF(kdtint==0)THEN
525 DO n = 1, nb
526 IF(nsvfi(nin)%P(ideb+n)<0)THEN
527C noeud generant une force
528 nod = -nsvfi(nin)%P(ideb+n)
529 nsvfi(nin)%P(ideb+n)=nod
530 IF(idebi<=niskyfi(nin)) THEN
531 itest = iskyfi(nin)%P(idebi)==ideb+n
532 ELSE
533 itest = .false.
534 ENDIF
535 DO WHILE(itest)
536 bbufs(l+1) = nod
537 bbufs(l+2) = fskyfi(nin)%P(1,idebi)
538 bbufs(l+3) = fskyfi(nin)%P(2,idebi)
539 bbufs(l+4) = fskyfi(nin)%P(3,idebi)
540 bbufs(l+5) = fskyfi(nin)%P(4,idebi)
541 bbufs(l+6) = ftheskyfi(nin)%P(idebi)
542 bbufs(l+7) = condnskyfi(nin)%P(idebi)
543 idebi = idebi + 1
544 l = l + len7t
545 IF(idebi<=niskyfi(nin)) THEN
546 itest = iskyfi(nin)%P(idebi)==ideb+n
547 ELSE
548 itest = .false.
549 ENDIF
550 ENDDO
551 ENDIF
552 ENDDO
553 ELSE
554 DO n = 1, nb
555 IF(nsvfi(nin)%P(ideb+n)<0)THEN
556C noeud generant une force
557 nod = -nsvfi(nin)%P(ideb+n)
558 nsvfi(nin)%P(ideb+n)=nod
559 IF(idebi<=niskyfi(nin)) THEN
560 itest = iskyfi(nin)%P(idebi)==ideb+n
561 ELSE
562 itest = .false.
563 ENDIF
564 DO WHILE(itest)
565 bbufs(l+1) = nod
566 bbufs(l+2) = fskyfi(nin)%P(1,idebi)
567 bbufs(l+3) = fskyfi(nin)%P(2,idebi)
568 bbufs(l+4) = fskyfi(nin)%P(3,idebi)
569 bbufs(l+5) = fskyfi(nin)%P(4,idebi)
570 bbufs(l+6) = fskyfi(nin)%P(5,idebi)
571 bbufs(l+7) = ftheskyfi(nin)%P(idebi)
572 bbufs(l+8) = condnskyfi(nin)%P(idebi)
573 idebi = idebi + 1
574 l = l + len7t
575 IF(idebi<=niskyfi(nin)) THEN
576 itest = iskyfi(nin)%P(idebi)==ideb+n
577 ELSE
578 itest = .false.
579 ENDIF
580 ENDDO
581 ENDIF
582 ENDDO
583 ENDIF
584
585 ELSE ! NODADT_THERM
586
587 leni = len7t
588 IF(kdtint==0)THEN
589 DO n = 1, nb
590 IF(nsvfi(nin)%P(ideb+n)<0)THEN
591C noeud generant une force
592 nod = -nsvfi(nin)%P(ideb+n)
593 nsvfi(nin)%P(ideb+n)=nod
594 IF(idebi<=niskyfi(nin)) THEN
595 itest = iskyfi(nin)%P(idebi)==ideb+n
596 ELSE
597 itest = .false.
598 ENDIF
599 DO WHILE(itest)
600 bbufs(l+1) = nod
601 bbufs(l+2) = fskyfi(nin)%P(1,idebi)
602 bbufs(l+3) = fskyfi(nin)%P(2,idebi)
603 bbufs(l+4) = fskyfi(nin)%P(3,idebi)
604 bbufs(l+5) = fskyfi(nin)%P(4,idebi)
605 bbufs(l+6) = ftheskyfi(nin)%P(idebi)
606 idebi = idebi + 1
607 l = l + len7t
608 IF(idebi<=niskyfi(nin)) THEN
609 itest = iskyfi(nin)%P(idebi)==ideb+n
610 ELSE
611 itest = .false.
612 ENDIF
613 ENDDO
614 ENDIF
615 ENDDO
616 ELSE
617 DO n = 1, nb
618 IF(nsvfi(nin)%P(ideb+n)<0)THEN
619C noeud generant une force
620 nod = -nsvfi(nin)%P(ideb+n)
621 nsvfi(nin)%P(ideb+n)=nod
622 IF(idebi<=niskyfi(nin)) THEN
623 itest = iskyfi(nin)%P(idebi)==ideb+n
624 ELSE
625 itest = .false.
626 ENDIF
627 DO WHILE(itest)
628 bbufs(l+1) = nod
629 bbufs(l+2) = fskyfi(nin)%P(1,idebi)
630 bbufs(l+3) = fskyfi(nin)%P(2,idebi)
631 bbufs(l+4) = fskyfi(nin)%P(3,idebi)
632 bbufs(l+5) = fskyfi(nin)%P(4,idebi)
633 bbufs(l+6) = fskyfi(nin)%P(5,idebi)
634 bbufs(l+7) = ftheskyfi(nin)%P(idebi)
635 idebi = idebi + 1
636 l = l + len7t
637 IF(idebi<=niskyfi(nin)) THEN
638 itest = iskyfi(nin)%P(idebi)==ideb+n
639 ELSE
640 itest = .false.
641 ENDIF
642 ENDDO
643 ENDIF
644 ENDDO
645 ENDIF
646 ENDIF
647 ENDIF
648C
649 bbufs(ll) = (l-ll)/leni
650 debut(nin) = debut(nin) + nb
651 debuti(nin)= idebi
652 END IF
653 ELSEIF(nty==11) THEN
654C type 11
655 IF(intth == 0 ) THEN
656 leni=len11
657 IF(nb>0) THEN
658 ll = l+1
659 l = l + 1
660 IF(kdtint==0)THEN
661 DO n = 1, nb
662 IF(nsvfi(nin)%P(ideb+n)<0)THEN
663C noeud generant une force
664 nod = -nsvfi(nin)%P(ideb+n)
665 nsvfi(nin)%P(ideb+n)=nod
666 IF(idebi<=niskyfi(nin)) THEN
667 itest = iskyfi(nin)%P(idebi)==ideb+n
668 ELSE
669 itest = .false.
670 ENDIF
671 DO WHILE(itest)
672 bbufs(l+1) = nod
673 bbufs(l+2) = fskyfi(nin)%P(1,idebi)
674 bbufs(l+3) = fskyfi(nin)%P(2,idebi)
675 bbufs(l+4) = fskyfi(nin)%P(3,idebi)
676 bbufs(l+5) = fskyfi(nin)%P(4,idebi)
677 bbufs(l+6) = fskyfi(nin)%P(5,idebi)
678 bbufs(l+7) = fskyfi(nin)%P(6,idebi)
679 bbufs(l+8) = fskyfi(nin)%P(7,idebi)
680 bbufs(l+9) = fskyfi(nin)%P(8,idebi)
681 idebi = idebi + 1
682 l = l + len11
683 IF(idebi<=niskyfi(nin)) THEN
684 itest = iskyfi(nin)%P(idebi)==ideb+n
685 ELSE
686 itest = .false.
687 ENDIF
688 ENDDO
689 ENDIF
690 ENDDO
691 ELSE
692 DO n = 1, nb
693 IF(nsvfi(nin)%P(ideb+n)<0)THEN
694C noeud generant une force
695 nod = -nsvfi(nin)%P(ideb+n)
696 nsvfi(nin)%P(ideb+n)=nod
697 IF(idebi<=niskyfi(nin)) THEN
698 itest = iskyfi(nin)%P(idebi)==ideb+n
699 ELSE
700 itest = .false.
701 ENDIF
702 DO WHILE(itest)
703 bbufs(l+1) = nod
704 bbufs(l+2) = fskyfi(nin)%P(1,idebi)
705 bbufs(l+3) = fskyfi(nin)%P(2,idebi)
706 bbufs(l+4) = fskyfi(nin)%P(3,idebi)
707 bbufs(l+5) = fskyfi(nin)%P(4,idebi)
708 bbufs(l+6) = fskyfi(nin)%P(5,idebi)
709 bbufs(l+7) = fskyfi(nin)%P(6,idebi)
710 bbufs(l+8) = fskyfi(nin)%P(7,idebi)
711 bbufs(l+9) = fskyfi(nin)%P(8,idebi)
712 bbufs(l+10)= fskyfi(nin)%P(9,idebi)
713 bbufs(l+11)= fskyfi(nin)%P(10,idebi)
714 idebi = idebi + 1
715 l = l + len11
716 IF(idebi<=niskyfi(nin)) THEN
717 itest = iskyfi(nin)%P(idebi)==ideb+n
718 ELSE
719 itest = .false.
720 ENDIF
721 ENDDO
722 ENDIF
723 ENDDO
724 ENDIF
725 bbufs(ll) = (l-ll)/len11
726 debut(nin) = debut(nin) + nb
727 debuti(nin)= idebi
728 END IF
729C Type 11 + thermal modelling
730 ELSE ! INTTH
731 leni=len11t
732 IF(glob_therm%NODADT_THERM == 1)THEN ! Thermal time step
733 IF(nb>0) THEN
734 ll = l+1
735 l = l + 1
736 IF(kdtint==0)THEN
737 DO n = 1, nb
738 IF(nsvfi(nin)%P(ideb+n)<0)THEN
739C noeud generant une force
740 nod = -nsvfi(nin)%P(ideb+n)
741 nsvfi(nin)%P(ideb+n)=nod
742 IF(idebi<=niskyfi(nin)) THEN
743 itest = iskyfi(nin)%P(idebi)==ideb+n
744 ELSE
745 itest = .false.
746 ENDIF
747 DO WHILE(itest)
748 bbufs(l+1) = nod
749 bbufs(l+2) = fskyfi(nin)%P(1,idebi)
750 bbufs(l+3) = fskyfi(nin)%P(2,idebi)
751 bbufs(l+4) = fskyfi(nin)%P(3,idebi)
752 bbufs(l+5) = fskyfi(nin)%P(4,idebi)
753 bbufs(l+6) = fskyfi(nin)%P(5,idebi)
754 bbufs(l+7) = fskyfi(nin)%P(6,idebi)
755 bbufs(l+8) = fskyfi(nin)%P(7,idebi)
756 bbufs(l+9) = fskyfi(nin)%P(8,idebi)
757 bbufs(l+10)= ftheskyfi(nin)%P(2*(idebi-1)+1)
758 bbufs(l+11)= ftheskyfi(nin)%P(2*(idebi-1)+2)
759 bbufs(l+12)= condnskyfi(nin)%P(2*(idebi-1)+1)
760 bbufs(l+13)= condnskyfi(nin)%P(2*(idebi-1)+2)
761 idebi = idebi + 1
762 l = l + len11t
763 IF(idebi<=niskyfi(nin)) THEN
764 itest = iskyfi(nin)%P(idebi)==ideb+n
765 ELSE
766 itest = .false.
767 ENDIF
768 ENDDO
769 ENDIF
770 ENDDO
771 ELSE
772 DO n = 1, nb
773 IF(nsvfi(nin)%P(ideb+n)<0)THEN
774C noeud generant une force
775 nod = -nsvfi(nin)%P(ideb+n)
776 nsvfi(nin)%P(ideb+n)=nod
777 IF(idebi<=niskyfi(nin)) THEN
778 itest = iskyfi(nin)%P(idebi)==ideb+n
779 ELSE
780 itest = .false.
781 ENDIF
782 DO WHILE(itest)
783 bbufs(l+1) = nod
784 bbufs(l+2) = fskyfi(nin)%P(1,idebi)
785 bbufs(l+3) = fskyfi(nin)%P(2,idebi)
786 bbufs(l+4) = fskyfi(nin)%P(3,idebi)
787 bbufs(l+5) = fskyfi(nin)%P(4,idebi)
788 bbufs(l+6) = fskyfi(nin)%P(5,idebi)
789 bbufs(l+7) = fskyfi(nin)%P(6,idebi)
790 bbufs(l+8) = fskyfi(nin)%P(7,idebi)
791 bbufs(l+9) = fskyfi(nin)%P(8,idebi)
792 bbufs(l+10)= fskyfi(nin)%P(9,idebi)
793 bbufs(l+11)= fskyfi(nin)%P(10,idebi)
794 bbufs(l+12)= ftheskyfi(nin)%P(2*(idebi-1)+1)
795 bbufs(l+13)= ftheskyfi(nin)%P(2*(idebi-1)+2)
796 bbufs(l+14)= condnskyfi(nin)%P(2*(idebi-1)+1)
797 bbufs(l+15)= condnskyfi(nin)%P(2*(idebi-1)+2)
798 idebi = idebi + 1
799 l = l + len11t
800 IF(idebi<=niskyfi(nin)) THEN
801 itest = iskyfi(nin)%P(idebi)==ideb+n
802 ELSE
803 itest = .false.
804 ENDIF
805 ENDDO
806 ENDIF
807 ENDDO
808 ENDIF
809 bbufs(ll) = (l-ll)/len11t
810 debut(nin) = debut(nin) + nb
811 debuti(nin)= idebi
812 END IF
813 ELSE !NODADTHERM
814 IF(nb>0) THEN
815 ll = l+1
816 l = l + 1
817 IF(kdtint==0)THEN
818 DO n = 1, nb
819 IF(nsvfi(nin)%P(ideb+n)<0)THEN
820C noeud generant une force
821 nod = -nsvfi(nin)%P(ideb+n)
822 nsvfi(nin)%P(ideb+n)=nod
823 IF(idebi<=niskyfi(nin)) THEN
824 itest = iskyfi(nin)%P(idebi)==ideb+n
825 ELSE
826 itest = .false.
827 ENDIF
828 DO WHILE(itest)
829 bbufs(l+1) = nod
830 bbufs(l+2) = fskyfi(nin)%P(1,idebi)
831 bbufs(l+3) = fskyfi(nin)%P(2,idebi)
832 bbufs(l+4) = fskyfi(nin)%P(3,idebi)
833 bbufs(l+5) = fskyfi(nin)%P(4,idebi)
834 bbufs(l+6) = fskyfi(nin)%P(5,idebi)
835 bbufs(l+7) = fskyfi(nin)%P(6,idebi)
836 bbufs(l+8) = fskyfi(nin)%P(7,idebi)
837 bbufs(l+9) = fskyfi(nin)%P(8,idebi)
838 bbufs(l+10)= ftheskyfi(nin)%P(2*(idebi-1)+1)
839 bbufs(l+11)= ftheskyfi(nin)%P(2*(idebi-1)+2)
840 idebi = idebi + 1
841 l = l + len11t
842 IF(idebi<=niskyfi(nin)) THEN
843 itest = iskyfi(nin)%P(idebi)==ideb+n
844 ELSE
845 itest = .false.
846 ENDIF
847 ENDDO
848 ENDIF
849 ENDDO
850 ELSE
851 DO n = 1, nb
852 IF(nsvfi(nin)%P(ideb+n)<0)THEN
853C noeud generant une force
854 nod = -nsvfi(nin)%P(ideb+n)
855 nsvfi(nin)%P(ideb+n)=nod
856 IF(idebi<=niskyfi(nin)) THEN
857 itest = iskyfi(nin)%P(idebi)==ideb+n
858 ELSE
859 itest = .false.
860 ENDIF
861 DO WHILE(itest)
862 bbufs(l+1) = nod
863 bbufs(l+2) = fskyfi(nin)%P(1,idebi)
864 bbufs(l+3) = fskyfi(nin)%P(2,idebi)
865 bbufs(l+4) = fskyfi(nin)%P(3,idebi)
866 bbufs(l+5) = fskyfi(nin)%P(4,idebi)
867 bbufs(l+6) = fskyfi(nin)%P(5,idebi)
868 bbufs(l+7) = fskyfi(nin)%P(6,idebi)
869 bbufs(l+8) = fskyfi(nin)%P(7,idebi)
870 bbufs(l+9) = fskyfi(nin)%P(8,idebi)
871 bbufs(l+10)= fskyfi(nin)%P(9,idebi)
872 bbufs(l+11)= fskyfi(nin)%P(10,idebi)
873 bbufs(l+12)= ftheskyfi(nin)%P(2*(idebi-1)+1)
874 bbufs(l+13)= ftheskyfi(nin)%P(2*(idebi-1)+2)
875 idebi = idebi + 1
876 l = l + len11t
877 IF(idebi<=niskyfi(nin)) THEN
878 itest = iskyfi(nin)%P(idebi)==ideb+n
879 ELSE
880 itest = .false.
881 ENDIF
882 ENDDO
883 ENDIF
884 ENDDO
885 ENDIF
886 bbufs(ll) = (l-ll)/len11t
887 debut(nin) = debut(nin) + nb
888 debuti(nin)= idebi
889 END IF
890 ENDIF
891 ENDIF
892
893 ELSEIF(nty==17) THEN
894C type 17
895 leni=len17
896 IF(nb>0) THEN
897 ll = l+1
898 l = l + 1
899 DO n = 1, nb
900 IF(nsvfi(nin)%P(ideb+n)<0)THEN
901C facette element generant une force
902 ies = -nsvfi(nin)%P(ideb+n)
903 nsvfi(nin)%P(ideb+n)=ies
904 IF(idebi<=niskyfi(nin)) THEN
905 itest = iskyfi(nin)%P(idebi)==ideb+n
906 ELSE
907 itest = .false.
908 ENDIF
909 DO WHILE(itest)
910 bbufs(l+1) = ies
911 DO jj=1,40
912 bbufs(l+jj+1)=fskyfi(nin)%P(jj,idebi)
913 END DO
914 idebi = idebi + 1
915 l = l + len17
916 IF(idebi<=niskyfi(nin)) THEN
917 itest = iskyfi(nin)%P(idebi)==ideb+n
918 ELSE
919 itest = .false.
920 ENDIF
921 ENDDO
922 ENDIF
923 ENDDO
924 bbufs(ll) = (l-ll)/len17
925 debut(nin) = debut(nin) + nb
926 debuti(nin)= idebi
927 END IF
928 END IF
929C
930C Partie supplementaire type 20 edge
931C
932 IF(nty==20) THEN
933 nb = nsnfie(nin)%P(p)
934 ideb = debute(nin)
935 idebi= debutie(nin)
936 IF(nb>0) THEN
937 DO n = 1, nb
938 n1 = 2*(n+ideb-1)+1
939 n2 = 2*(n+ideb)
940 bbufs(l+1) = alphakfie(nin)%P(n1)
941 bbufs(l+2) = alphakfie(nin)%P(n2)
942 IF(nsvfie(nin)%P(ideb+n)<0)THEN
943C noeud generant une force
944 CALL putdpdaanc(
945 . daanc6fie(nin)%P(1,1,n1),bbufs(l+3),iresp,inc)
946C L = L + INC
947 CALL putdpdaanc(
948 . daanc6fie(nin)%P(1,1,n2),bbufs(l+3+inc),iresp,
949 . inc)
950C L = L + INC
951 ELSE ! A optimiser
952 CALL putdpzero(zerodp,bbufs(l+3),iresp,inc)
953 CALL putdpzero(zerodp,bbufs(l+3+inc),iresp,inc)
954 END IF
955 l = l + len20e
956 END DO
957C
958 ll = l+1
959 l = l + 1
960 IF(kdtint==0)THEN
961 DO n = 1, nb
962 IF(nsvfie(nin)%P(ideb+n)<0)THEN
963C noeud generant une force
964 nod = -nsvfie(nin)%P(ideb+n)
965 nsvfie(nin)%P(ideb+n)=nod
966 IF(idebi<=niskyfie(nin)) THEN
967 itest = iskyfie(nin)%P(idebi)==ideb+n
968 ELSE
969 itest = .false.
970 END IF
971 DO WHILE(itest)
972 bbufs(l+1) = nod
973 bbufs(l+2) = fskyfie(nin)%P(1,idebi)
974 bbufs(l+3) = fskyfie(nin)%P(2,idebi)
975 bbufs(l+4) = fskyfie(nin)%P(3,idebi)
976 bbufs(l+5) = fskyfie(nin)%P(4,idebi)
977 bbufs(l+6) = fskyfie(nin)%P(5,idebi)
978 bbufs(l+7) = fskyfie(nin)%P(6,idebi)
979 bbufs(l+8) = fskyfie(nin)%P(7,idebi)
980 bbufs(l+9) = fskyfie(nin)%P(8,idebi)
981 idebi = idebi + 1
982 l = l + len11
983 IF(idebi<=niskyfie(nin)) THEN
984 itest = iskyfie(nin)%P(idebi)==ideb+n
985 ELSE
986 itest = .false.
987 END IF
988 END DO
989 END IF
990 END DO
991 ELSE
992 DO n = 1, nb
993 IF(nsvfie(nin)%P(ideb+n)<0)THEN
994C noeud generant une force
995 nod = -nsvfie(nin)%P(ideb+n)
996 nsvfie(nin)%P(ideb+n)=nod
997 IF(idebi<=niskyfie(nin)) THEN
998 itest = iskyfie(nin)%P(idebi)==ideb+n
999 ELSE
1000 itest = .false.
1001 END IF
1002 DO WHILE(itest)
1003 bbufs(l+1) = nod
1004 bbufs(l+2) = fskyfie(nin)%P(1,idebi)
1005 bbufs(l+3) = fskyfie(nin)%P(2,idebi)
1006 bbufs(l+4) = fskyfie(nin)%P(3,idebi)
1007 bbufs(l+5) = fskyfie(nin)%P(4,idebi)
1008 bbufs(l+6) = fskyfie(nin)%P(5,idebi)
1009 bbufs(l+7) = fskyfie(nin)%P(6,idebi)
1010 bbufs(l+8) = fskyfie(nin)%P(7,idebi)
1011 bbufs(l+9) = fskyfie(nin)%P(8,idebi)
1012 bbufs(l+10)= fskyfie(nin)%P(9,idebi)
1013 bbufs(l+11)= fskyfie(nin)%P(10,idebi)
1014 idebi = idebi + 1
1015 l = l + len11
1016 IF(idebi<=niskyfie(nin)) THEN
1017 itest = iskyfie(nin)%P(idebi)==ideb+n
1018 ELSE
1019 itest = .false.
1020 END IF
1021 END DO
1022 END IF
1023 END DO
1024 END IF
1025 bbufs(ll) = (l-ll)/len11
1026 debute(nin) = debute(nin) + nb
1027 debutie(nin)= idebi
1028 END IF
1029 END IF
1030C Fin type 20 edge
1031C
1032C TYPE25 edge
1033C
1034 IF(nty == 25) THEN
1035 IF( nsnfie(nin)%P(p) > 0) THEN
1036 nb = nsnfie(nin)%P(p)
1037 ideb = debute(nin)
1038 idebi= debutie(nin)
1039C L0 = L
1040 ll = l + 1
1041 l = l + 1
1042 nb_tot_edges = 0
1043 IF(nb>0) THEN
1044 DO n = 1, nb
1045 debug_e2e(ledge_fie(nin)%P(e_global_id,ideb+n) == d_es,ideb)
1046 IF(nsvfie(nin)%P(ideb+n)<0)THEN
1047C Node generating the force
1048 nod = -nsvfie(nin)%P(ideb+n)
1049 nsvfie(nin)%P(ideb+n)=nod
1050 IF(idebi<=niskyfie(nin)) THEN
1051 itest = iskyfie(nin)%P(idebi)==ideb+n
1052 ELSE
1053 itest = .false.
1054 END IF
1055 thoffset = 0
1056 IF(intth > 0) THEN
1057 thoffset = 1
1058 ! Not available yet
1059 assert(.false.)
1060 ENDIF
1061 DO WHILE(itest)
1062 bbufs(l+1) = nod
1063 bbufs(l+2) = fskyfie(nin)%P(1,idebi)
1064 bbufs(l+3) = fskyfie(nin)%P(2,idebi)
1065 bbufs(l+4) = fskyfie(nin)%P(3,idebi)
1066 bbufs(l+5) = fskyfie(nin)%P(4,idebi)
1067 bbufs(l+6+thoffset) = nod
1068 bbufs(l+7+thoffset) = fskyfie(nin)%P(5+thoffset,idebi)
1069 bbufs(l+8+thoffset) = fskyfie(nin)%P(6+thoffset,idebi)
1070 bbufs(l+9+thoffset) = fskyfie(nin)%P(7+thoffset,idebi)
1071 bbufs(l+10+thoffset) = fskyfie(nin)%P(8+thoffset,idebi)
1072 idebi = idebi + 1
1073 nb_tot_edges = nb_tot_edges + 1
1074 l = l + len25e ! + 2*THOFFSET
1075 IF(idebi<=niskyfie(nin)) THEN
1076 itest = iskyfie(nin)%P(idebi)==ideb+n
1077 ELSE
1078 itest = .false.
1079 END IF
1080 END DO
1081 END IF
1082 END DO
1083 END IF
1084 ! LL = L0 +1
1085 ! L = L0 +1 + LEN25 * (NBEDGES_WITH_FORCES)
1086 ! L - LL = LEN25 * NB_TOT_EDGES / LEN25 = NB_TOT_EDGES
1087 ! BBUFS(L0 + 1 ) = NB_TOT_EDGES
1088 bbufs(ll) = nb_tot_edges
1089 assert( (l-ll)/len25e == nb_tot_edges)
1090 debute(nin) = debute(nin) + nb
1091 debutie(nin)= idebi
1092 END IF !TYPE 25 E2E
1093 ENDIF
1094 END DO
1095 siz = l+1-add
1096 msgtyp = msgoff2
1097 CALL mpi_isend(
1098 . bbufs(add),siz,real ,it_spmd(p),msgtyp,
1099 . spmd_comm_world,req_si(p),ierror )
1100 ELSEIF(p/=loc_proc)THEN
1101 DO ii = 1, nbintc
1102 nin = intlist(ii)
1103 debut(nin) = debut(nin) + nsnfi(nin)%P(p)
1104 IF(ipari(7,nin)==20)
1105 . debute(nin) = debute(nin) + nsnfie(nin)%P(p)
1106 IF(ipari(7,nin)==25)
1107 . debute(nin) = debute(nin) + nsnfie(nin)%P(p)
1108 ENDDO
1109 ENDIF
1110 ENDDO
1111C
1112C mise a 0 de niskyfi une fois utilisee
1113C
1114 DO ii = 1, nbintc
1115 nin = intlist(ii)
1116 niskyfi(nin) = 0
1117 niskyfie(nin) = 0
1118 ENDDO
1119C
1120 ELSEIF(iflag==2)THEN
1121C
1122C Utile int20
1123C
1124 IF(nbint20>0)THEN
1125 DO ii = 1, nbintc
1126 nin = intlist(ii)
1127 debut(nin) = 0
1128 debute(nin) = 0
1129 END DO
1130 END IF
1131C
1132C Receive 1er message : taille communication
1133C
1134 iallocr = 0
1135 DO p = 1, nspmd
1136 IF(nsnsitot(p)>0)THEN
1137 CALL mpi_wait(req_r(p),status,ierror)
1138 iallocr = max(iallocr,isizrcv(1,p)) ! pour comm bloquantes
1139C IALLOCR = IALLOCR + ISIZRCV(P) ! pour comm non bloquantes
1140 END IF
1141 END DO
1142C
1143 ierror=0
1144 IF(iallocr>0)
1145 . ALLOCATE(bbufr(iallocr+nbintc*2),stat=ierror)
1146C . ALLOCATE(BBUFR(IALLOCR+NBINTC*NSPMD*2),STAT=IERROR) ! si comm non bloquantes reactivees
1147
1148 IF(ierror/=0) THEN
1149 CALL ancmsg(msgid=20,anmode=aninfo)
1150 CALL arret(2)
1151 ENDIF
1152
1153C ------------------------------------------------------------
1154C ISKY / FSKYI Space Verification. If not enough increase it.
1155C ------------------------------------------------------------
1156 lskyi_ct=0
1157 DO p=1,nspmd
1158 lskyi_ct=lskyi_ct+isizrcv(2,p)
1159 ENDDO
1160C
1161 IF ( nisky+lskyi_ct > sisky) THEN
1162 CALL reallocate_i_skyline(lskyi_ct,3,glob_therm%INTHEAT,glob_therm%NODADT_THERM, interfaces%PON)
1163 ENDIF
1164C
1165C Reception buffer et decompactage
1166C
1167C L = 1 ! a reactiver si envoi non bloquant
1168 DO p = 1, nspmd
1169 IF(isizrcv(1,p)>0) THEN
1170 msgtyp = msgoff2
1171 l = 1 ! envoi bloquant + opti alloc memoire sur max des comm
1172 CALL mpi_recv(
1173 . bbufr(l),isizrcv(1,p)+nbintc*2,real ,it_spmd(p),msgtyp,
1174 . spmd_comm_world ,status,ierror )
1175
1176C
1177 DO ii = 1, nbintc
1178 nin = intlist(ii)
1179 nty =ipari(7,nin)
1180
1181 IF(multi_fvm%INT18_GLOBAL_LIST(nin)) cycle
1182 condition = (nsnsi(nin)%P(p) > 0)
1183 IF((nty == 25) .AND. (.NOT. condition) ) THEN
1184 IF(ipari(58,nin) /= 0) THEN
1185 condition = (nsnsie(nin)%P(p) > 0)
1186 ENDIF
1187 ENDIF
1188
1189 IF(condition) THEN
1190 ibc =ipari(11,nin)
1191 noint =ipari(15,nin)
1192 inacti=ipari(22,nin)
1193 isecin=ipari(28,nin)
1194 ibag =ipari(32,nin)
1195 iadm =ipari(44,nin)
1196 intth = ipari(47,nin)
1197 intcarea=ipari(99,nin)
1198C type int20 (non edge)
1199 IF(nty == 20) THEN
1200 nb = nsnsi(nin)%P(p)
1201 ideb = debut(nin)
1202 CALL spmd_fiadd20_pon(
1203 1 nb,len20,nsvsi(nin)%P(ideb+1),bbufr(l),
1204 2 intbuf_tab(nin)%DAANC6,intbuf_tab(nin)%NSV,intbuf_tab(nin)%ALPHAK)
1205 l = l + nb*len20
1206 debut(nin) = debut(nin) + nb
1207
1208 nb = nint(bbufr(l))
1209 l = l + 1
1210 IF(intth == 0) THEN
1211 CALL spmd_fiadd20f_pon(
1212 1 nb ,len ,bbufr(l),intbuf_tab(nin)%NSV,interfaces%PON%FSKYI ,
1213 2 interfaces%PON%ISKY ,ibc ,isecin ,noint ,ibag ,
1214 3 icodt ,secfcum,nstrf ,icontact ,fcont ,
1215 4 inacti ,iadm ,intth ,ftheskyi,intbuf_tab(nin)%NLG,
1216 5 h3d_data)
1217 l = l + nb*len
1218 ELSE
1219 CALL spmd_fiadd20f_pon(
1220 1 nb ,len7t ,bbufr(l),intbuf_tab(nin)%NSV,interfaces%PON%FSKYI ,
1221 2 interfaces%PON%ISKY ,ibc ,isecin ,noint ,ibag ,
1222 3 icodt ,secfcum,nstrf ,icontact ,fcont ,
1223 4 inacti ,iadm ,intth ,ftheskyi ,intbuf_tab(nin)%NLG,
1224 5 h3d_data)
1225 l = l + nb*len7t
1226 ENDIF
1227 ELSE IF(nty==7.OR.nty==10.OR.nty==22.OR.
1228 * nty==23.OR.nty==24.OR.nty==25)THEN
1229
1230
1231 IF(nsnsi(nin)%P(p) > 0) THEN
1232 nb = nint(bbufr(l))
1233
1234
1235 l = l + 1
1236 IF(intth == 0) THEN
1237 CALL spmd_fiadd_pon(
1238 1 nb ,len ,bbufr(l),intbuf_tab(nin)%NSV, interfaces%PON%FSKYI,
1239 2 interfaces%PON%ISKY ,ibc ,isecin ,noint ,ibag ,
1240 3 icodt ,secfcum,nstrf ,icontact ,fcont ,
1241 4 inacti ,iadm ,intth , ftheskyi ,condnskyi,
1242 5 h3d_data,nin ,tagncont,kloadpinter ,loadpinter,
1243 6 loadp_hyd_inter ,intcarea,fsav(1,nin) ,interfaces%PARAMETERS,
1244 7 glob_therm%NODADT_THERM)
1245 l = l + nb*len
1246 ELSE
1247 CALL spmd_fiadd_pon(
1248 1 nb ,len7t ,bbufr(l),intbuf_tab(nin)%NSV, interfaces%PON%FSKYI,
1249 2 interfaces%PON%ISKY ,ibc ,isecin ,noint ,ibag ,
1250 3 icodt ,secfcum,nstrf ,icontact ,fcont ,
1251 4 inacti ,iadm ,intth , ftheskyi ,condnskyi,
1252 5 h3d_data,nin ,tagncont, kloadpinter ,loadpinter,
1253 6 loadp_hyd_inter ,intcarea,fsav(1,nin) ,interfaces%PARAMETERS,
1254 7 glob_therm%NODADT_THERM)
1255 l = l + nb*len7t
1256 ENDIF
1257 ENDIF ! NSNSI
1258
1259 IF(nty == 25 ) THEN
1260 IF( nsnsie(nin)%P(p) > 0 ) THEN
1261 nb = nint(bbufr(l)) ! number of EDGES
1262 l = l + 1
1263 leni = len25e
1264 IF(nb > 0) THEN
1265 CALL spmd_fiadd25e_pon(
1266 1 nb ,leni ,bbufr(l),nsvsie(nin)%P, interfaces%PON%FSKYI,
1267 2 interfaces%PON%ISKY ,ibc ,isecin ,noint ,ibag ,
1268 3 icodt ,secfcum,nstrf ,icontact ,fcont ,
1269 4 inacti ,iadm ,intth , ftheskyi ,condnskyi,
1270 5 h3d_data,intbuf_tab(nin)%LEDGE,nledge,ipari(68,nin),
1271 6 nin ,tagncont,kloadpinter,loadpinter,loadp_hyd_inter)
1272 l = l + nb*leni
1273 ENDIF
1274 ENDIF
1275 ENDIF
1276
1277
1278 ELSEIF(nty==11)THEN
1279 nb = nint(bbufr(l))
1280 l = l + 1
1281 IF(intth == 0) THEN
1282 CALL spmd_fiadd11_pon(
1283 1 nb ,len11 ,bbufr(l),intbuf_tab(nin)%IRECTS,interfaces%PON%FSKYI ,
1284 2 interfaces%PON%ISKY ,ibc ,isecin ,noint ,ibag ,
1285 3 icodt ,secfcum ,nstrf ,icontact ,fcont ,
1286 4 intth ,ftheskyi,condnskyi,h3d_data ,nin ,tagncont ,
1287 5 kloadpinter,loadpinter,loadp_hyd_inter,glob_therm%NODADT_THERM)
1288 l = l + nb*len11
1289 ELSE
1290 CALL spmd_fiadd11_pon(
1291 1 nb ,len11t ,bbufr(l),intbuf_tab(nin)%IRECTS,interfaces%PON%FSKYI ,
1292 2 interfaces%PON%ISKY ,ibc ,isecin ,noint ,ibag ,
1293 3 icodt ,secfcum ,nstrf ,icontact ,fcont ,
1294 4 intth ,ftheskyi,condnskyi,h3d_data ,nin ,tagncont,
1295 5 kloadpinter,loadpinter,loadp_hyd_inter,glob_therm%NODADT_THERM)
1296 l = l + nb*len11t
1297 ENDIF
1298 ELSEIF(nty==17)THEN
1299 nb = nint(bbufr(l))
1300 l = l + 1
1301 ige = ipari(34,nin)
1302 ign = ipari(36,nin)
1303 nme = igrbric(ige)%NENTITY
1304 nmes= igrbric(ign)%NENTITY
1305C
1306 CALL spmd_fiadd17_pon(
1307 1 nb ,len17 ,bbufr(l),igrbric(ign)%ENTITY,interfaces%PON%FSKYI ,
1308 2 interfaces%PON%ISKY ,fcont ,ixs ,ixs16 ,h3d_data)
1309 l = l + nb*len17
1310 END IF
1311 ENDIF
1312C
1313C Partie supplementaire type 20 edge
1314C
1315 IF(nty == 20) THEN
1316 nb = nsnsie(nin)%P(p)
1317 IF(nb>0)THEN
1318 ibc =ipari(11,nin)
1319 noint =ipari(15,nin)
1320 isecin=ipari(28,nin)
1321C IBAG =IPARI(32,NIN)
1322C IBAG force a 0 pour la partie edge
1323 ibag=0
1324 ideb = debute(nin)
1325 CALL spmd_fiadd20e_pon(
1326 1 nb,len20e,nsvsie(nin)%P(ideb+1),bbufr(l),
1327 2 intbuf_tab(nin)%DAANC6,intbuf_tab(nin)%IXLINS,intbuf_tab(nin)%ALPHAK)
1328 l = l + nb*len20e
1329 debute(nin) = debute(nin) + nb
1330C
1331 nb = nint(bbufr(l))
1332 l = l + 1
1333 IF(nb > 0) THEN
1334 CALL spmd_fiadd20fe_pon(
1335 1 nb ,len11 ,bbufr(l),intbuf_tab(nin)%IXLINS,interfaces%PON%FSKYI ,
1336 2 interfaces%PON%ISKY ,ibc ,isecin ,noint ,ibag ,
1337 3 icodt ,secfcum ,nstrf ,icontact ,fcont ,
1338 4 intbuf_tab(nin)%NLG,h3d_data)
1339 ENDIF
1340 l = l + nb*len11
1341 END IF
1342C Fin type 20 edge
1343 END IF
1344 ENDDO
1345 ENDIF
1346 ENDDO
1347 IF(iallocr>0) DEALLOCATE(bbufr)
1348C
1349C Attente ISEND
1350C
1351 DO p = 1, nspmd
1352 IF(p/=loc_proc)THEN
1353 IF(nsnfitot(p)>0) THEN
1354 CALL mpi_wait(req_s(p),status,ierror)
1355 END IF
1356 IF(isizenv(1,p)>0)THEN
1357 CALL mpi_wait(req_si(p),status,ierror)
1358 END IF
1359 END IF
1360 END DO
1361 IF(iallocs>0) DEALLOCATE(bbufs)
1362 ENDIF
1363C
1364#endif
1365 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
intcontp25e
subroutine intcontp25e(n, isky, nsnfi, isizenv, nsnfitot, len)
Definition intcontp25e.F:29
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_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
groupdef_mod
Definition groupdef_mod.F:662
h3d_mod
Definition h3d_mod.F:308
heat_mod
Definition heat_mod.F:31
message_mod
Definition message_mod.F:1249
tri25ebox::ledge_fie
type(int_pointer2), dimension(:), allocatable ledge_fie
Definition tri25ebox.F:88
tri7box::ftheskyfi
type(real_pointer), dimension(:), allocatable ftheskyfi
Definition tri7box.F:449
tri7box::fskyfie
type(real_pointer2), dimension(:), allocatable fskyfie
Definition tri7box.F:459
tri7box::nsvsi
type(int_pointer), dimension(:), allocatable nsvsi
Definition tri7box.F:485
tri7box::iskyfie
type(int_pointer), dimension(:), allocatable iskyfie
Definition tri7box.F:480
tri7box::nsnfie
type(int_pointer), dimension(:), allocatable nsnfie
Definition tri7box.F:440
tri7box::daanc6fi
type(r8_pointer3), dimension(:), allocatable daanc6fi
Definition tri7box.F:476
tri7box::condnskyfi
type(real_pointer), dimension(:), allocatable condnskyfi
Definition tri7box.F:449
tri7box::nsnsie
type(int_pointer), dimension(:), allocatable nsnsie
Definition tri7box.F:491
tri7box::alphakfi
type(real_pointer), dimension(:), allocatable alphakfi
Definition tri7box.F:449
tri7box::nsvsie
type(int_pointer), dimension(:), allocatable nsvsie
Definition tri7box.F:485
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::fskyfi
type(real_pointer2), dimension(:), allocatable fskyfi
Definition tri7box.F:459
tri7box::nsvfi
type(int_pointer), dimension(:), allocatable nsvfi
Definition tri7box.F:431
tri7box::iskyfi
type(int_pointer), dimension(:), allocatable iskyfi
Definition tri7box.F:480
tri7box::nsvfie
type(int_pointer), dimension(:), allocatable nsvfie
Definition tri7box.F:440
tri7box::daanc6fie
type(r8_pointer3), dimension(:), allocatable daanc6fie
Definition tri7box.F:476
tri7box::alphakfie
type(real_pointer), dimension(:), allocatable alphakfie
Definition tri7box.F:449
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
reallocate_i_skyline
subroutine reallocate_i_skyline(new_count, call_id, intheat, nodadt_therm, pon)
Definition reallocate_skyline.F:39
sorti25
subroutine sorti25(n, isky, fskyi, nfskyi)
Definition sorti25.F:29
spmd_fiadd25e_pon
subroutine spmd_fiadd25e_pon(nb, len, bufr, nsv, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, ftheskyi, condnskyi, h3d_data, ledge, sedge, nedge, nin, tagncont, kloadpinter, loadpinter, loadp_hyd_inter)
Definition spmd_fiadd25e_pon.F:44
spmd_fiadd20_pon
subroutine spmd_fiadd20_pon(nb, len, nsvsi, bufr, daanc6, nsv, alphak)
Definition spmd_i20tool.F:32
spmd_fiadd20e_pon
subroutine spmd_fiadd20e_pon(nb, len, nsvsi, bufr, daanc6, ixlins, alphak)
Definition spmd_i20tool.F:94
putdpdaanc
subroutine putdpdaanc(daanc6, buf, iresp, inc)
Definition spmd_i7tool.F:7399
intcontp
subroutine intcontp(n, isky, nsnfi, isizenv, nsnfitot, len)
Definition spmd_i7tool.F:6233
addcomi20
subroutine addcomi20(nsnfi, nsvfi, isizenv, leni20)
Definition spmd_i7tool.F:6285
sorti11t
subroutine sorti11t(n, isky, fskyi, ftheskyi, nfskyi)
Definition spmd_i7tool.F:6537
sorti11
subroutine sorti11(n, isky, fskyi, nfskyi)
Definition spmd_i7tool.F:6329
spmd_fiadd17_pon
subroutine spmd_fiadd17_pon(nb, len, bufr, nelems, fskyi, isky, fcont, ixs, ixs16, h3d_data)
Definition spmd_i7tool.F:2754
spmd_fiadd_pon
subroutine spmd_fiadd_pon(nb, len, bufr, nsv, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, ftheskyi, condnskyi, h3d_data, nin, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, intcarea, fsav, parameters, nodadt_therm)
Definition spmd_i7tool.F:1793
sorti20
subroutine sorti20(n, isky, fskyi, nfskyi)
Definition spmd_i7tool.F:6078
spmd_fiadd20f_pon
subroutine spmd_fiadd20f_pon(nb, len, bufr, nsv, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, ftheskyi, nlg, h3d_data)
Definition spmd_i7tool.F:2004
sorti17
subroutine sorti17(n, isky, fskyi)
Definition spmd_i7tool.F:6991
sortint
subroutine sortint(n, isky, index)
Definition spmd_i7tool.F:5671
spmd_fiadd11_pon
subroutine spmd_fiadd11_pon(nb, len, bufr, irects, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, intth, ftheskyi, condnskyi, h3d_data, nin, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, nodadt_therm)
Definition spmd_i7tool.F:2198
putdpzero
subroutine putdpzero(zz, buf, iresp, inc)
Definition spmd_i7tool.F:7074
spmd_fiadd20fe_pon
subroutine spmd_fiadd20fe_pon(nb, len, bufr, irects, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, nlg, h3d_data)
Definition spmd_i7tool.F:2536
sorti11tt
subroutine sorti11tt(n, isky, fskyi, ftheskyi, condnskyi, nfskyi)
Definition spmd_i7tool.F:6758
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