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