OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_i7fcom_poff.F File Reference
#include "implicit_f.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"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_i7fcom_poff (ipari, a, stifn, viscn, intlist, nbintc, icodt, secfcum, nstrf, icontact, fcont, islen7, irlen7, islen11, irlen11, islen17, irlen17, igrbric, ixs, ixs16, fthe, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, condn, iflag, intbuf_tab, h3d_data, multi_fvm, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, fsav, interfaces, nodadt_therm)

Function/Subroutine Documentation

◆ spmd_i7fcom_poff()

subroutine spmd_i7fcom_poff ( integer, dimension(npari,*) ipari,
a,
stifn,
viscn,
integer, dimension(*) intlist,
integer nbintc,
integer, dimension(*) icodt,
secfcum,
integer, dimension(*) nstrf,
integer, dimension(*) icontact,
fcont,
integer islen7,
integer irlen7,
integer islen11,
integer irlen11,
integer islen17,
integer irlen17,
type (group_), dimension(ngrbric) igrbric,
integer, dimension(*) ixs,
integer, dimension(*) ixs16,
fthe,
integer irlen7t,
integer islen7t,
integer irlen20,
integer islen20,
integer irlen20t,
integer islen20t,
integer irlen20e,
integer islen20e,
condn,
integer iflag,
type(intbuf_struct_), dimension(*) intbuf_tab,
type(h3d_database) h3d_data,
type(multi_fvm_struct), intent(inout) multi_fvm,
integer, dimension(nloadp_hyd_inter,numnod) tagncont,
integer, dimension(ninter+1) kloadpinter,
integer, dimension(ninter*nloadp_hyd) loadpinter,
integer, dimension(nloadp_hyd) loadp_hyd_inter,
dimension(nthvki,*), intent(inout) fsav,
type (interfaces_), intent(in) interfaces,
integer, intent(in) nodadt_therm )

Definition at line 49 of file spmd_i7fcom_poff.F.

59C-----------------------------------------------
60C M o d u l e s
61C-----------------------------------------------
62 USE tri7box
63 USE tri25ebox
64 USE message_mod
65 USE intbufdef_mod
66 USE h3d_mod
67 USE multi_fvm_mod
68 USE groupdef_mod
69 USE interfaces_mod
70C-----------------------------------------------
71C I m p l i c i t T y p e s
72C-----------------------------------------------
73 USE spmd_comm_world_mod, ONLY : spmd_comm_world
74#include "implicit_f.inc"
75C-----------------------------------------------
76C M e s s a g e P a s s i n g
77C-----------------------------------------------
78#include "spmd.inc"
79C-----------------------------------------------
80C C o m m o n B l o c k s
81C-----------------------------------------------
82#include "scr05_c.inc"
83#include "scr18_c.inc"
84#include "com01_c.inc"
85#include "com04_c.inc"
86#include "param_c.inc"
87#include "task_c.inc"
88C-----------------------------------------------
89C D u m m y A r g u m e n t s
90C-----------------------------------------------
91 INTEGER IFLAG, NBINTC,ISLEN7, IRLEN7, ISLEN11, IRLEN11,
92 . ISLEN17, IRLEN17,IRLEN7T,ISLEN7T,
93 . IRLEN20, ISLEN20, IRLEN20T, ISLEN20T, IRLEN20E, ISLEN20E,
94 . IPARI(NPARI,*), INTLIST(*), IXS(*), IXS16(*),
95 . ICODT(*), ICONTACT(*), NSTRF(*),TAGNCONT(NLOADP_HYD_INTER,NUMNOD),
96 . KLOADPINTER(NINTER+1),LOADPINTER(NINTER*NLOADP_HYD),
97 . LOADP_HYD_INTER(NLOADP_HYD)
98 INTEGER, INTENT(IN) :: NODADT_THERM
99 my_real
100 . a(*), stifn(*), viscn(*),
101 . secfcum(7,numnod,nsect), fcont(3,*), fthe(*),condn(*)
102 my_real, INTENT(INOUT) :: fsav(nthvki,*)
103
104 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
105 TYPE(H3D_DATABASE) :: H3D_DATA
106 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
107 TYPE (INTERFACES_) ,INTENT(IN) :: INTERFACES
108C-----------------------------------------------
109 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
110C-----------------------------------------------
111C L o c a l V a r i a b l e s
112C-----------------------------------------------
113#ifdef MPI
114 INTEGER P, L, ADD, LL, NB, LEN, SIZ, LOC_PROC, MULTIMP, II,
115 . NIN, IDEB, N, MSGTYP, IERROR, NI, NOD, INTTH,
116 . IBC, ISECIN, IBAG, NOINT, NTY, LEN11, N1, N2,LENI,INACTI,
117 . IADM,IALLOCS, IALLOCR, LEN17, IGN, IGE, NMES, NME, NAD,
118 . LEN7T,LEN20,LEN20T, LEN20E, INC, MSGOFF,LEN11T,
119 . JD(50), KD(50), STATUS(MPI_STATUS_SIZE),LEN7TH,
120 . DEBUT(NINTER), DEBUTE(NINTER),LL0,
121c parasiz car variable en save
122 . ADDS(PARASIZ+1), ADDR(PARASIZ+1),
123 . REQ_SI(PARASIZ),REQ_RI(PARASIZ)
124 INTEGER, PARAMETER :: LEN25E = 11
125 INTEGER :: NEDGE, INTCAREA
126 DATA msgoff/143/
127 LOGICAL ITEST
128 my_real ,DIMENSION(:), ALLOCATABLE :: bbufs, bbufr
129 my_real
130 . bid
131 SAVE adds,addr,req_si,req_ri,iallocs,iallocr,bbufs,bbufr
132
133C-----------------------------------------------
134C S o u r c e L i n e s
135C-----------------------------------------------
136 bid = zero
137 loc_proc = ispmd + 1
138C
139 len = 5
140 IF(kdtint/=0) len = len+1
141 IF(nodadt_therm == 1) len = len+1
142
143C type11 => 2 impacts pour une facette
144 len11 = 2*(len-1)+1
145 len11t = 2*len+1
146C type 7 + heat
147 len7t = len + 1
148C type17 => 16 impacts
149 len17 = 69
150C type 20
151 len20 = len + 18*(1+iresp) + 1
152C type 20 + heat
153 len20t = len20 + 1
154C type 20 edge
155 len20e = len11 + 18*2*(1+iresp) + 2
156
157c
158 IF(iflag==1)THEN
159C
160C Partie 1 envoi et preparation buffer reception
161C
162
163C Init
164 DO ii = 1, nbintc
165 nin = intlist(ii)
166 debut(nin) = 0
167 debute(nin)= 0
168 ENDDO
169 iallocs = len*(irlen7+irlen25) + len7t*(irlen7t+irlen25t)
170 . + len11t*irlen11 + len17*irlen17
171 . + len20*irlen20 + len20t*irlen20t + len20e*irlen20e
172 . + len25e*irlen25e
173 ierror=0
174 IF(iallocs>0)
175 + ALLOCATE(bbufs(iallocs+nbintc*nspmd*2),stat=ierror) ! nbintc*NSPMD*2 majorant place supplementaire bufs
176 IF(ierror/=0) THEN
177 CALL ancmsg(msgid=20,anmode=aninfo)
178 CALL arret(2)
179 END IF
180C
181 iallocr = len*(islen7+islen25) + len7t*(islen7t+islen25t)
182 . + len11t*islen11 + len17*islen17
183 . + len20*islen20 + len20t*islen20t + len20e*islen20e
184 . + len25e*islen25e
185
186
187 ierror=0
188 IF(iallocr>0)
189 + ALLOCATE(bbufr(iallocr+nbintc*nspmd*2),stat=ierror) ! nbintc*NSPMD*2 majorant place supplementaire bufs
190 IF(ierror/=0) THEN
191 CALL ancmsg(msgid=20,anmode=aninfo)
192 CALL arret(2)
193 END IF
194C
195C Receive
196C
197 l = 0
198 DO p = 1, nspmd
199 add = l+1
200 addr(p) = add
201 siz = 0
202 IF(p/=loc_proc)THEN
203C test en plus pour savoir si com globale necessaire entre les 2 procs
204 DO ii = 1, nbintc
205 nin = intlist(ii)
206 nb = nsnsi(nin)%P(p)
207 nty = ipari(7,nin)
208 intth = ipari(47,nin)
209C WRITE(6,*) NIN,"INTTH=",INTTH
210 leni = len
211 IF(nty==11)leni=len11
212 IF(nty==17)leni=len17
213 IF(nty==20)leni=len20
214 IF(nty == 7 .AND. intth > 0) leni = len7t
215 IF(nty == 22 .AND. intth > 0) leni = len7t
216 IF(nty == 23 .AND. intth > 0) leni = len7t
217 IF(nty == 20 .AND. intth > 0) leni = len20t
218 IF(nty == 11 .AND. intth > 0) leni = len11t
219 IF(nty == 25 .AND. intth > 0) leni = len7t
220
221 IF(nb>0) THEN
222 l = l + 1 + nb*leni
223 ENDIF
224C Partie Edge
225 IF(nty==20)THEN
226 nb = nsnsie(nin)%P(p)
227 IF(nb>0) THEN
228 l = l + 1 + nb*len20e
229 END IF
230 END IF
231 IF(nty==25 .AND. ipari(58,nin) > 0)THEN
232 nb = nsnsie(nin)%P(p)
233 IF(nb>0) THEN
234 l = l + 1 + nb*len25e
235 END IF
236 END IF
237 ENDDO
238 siz = l+1-add
239 IF(siz>0)THEN
240 msgtyp = msgoff
241 CALL mpi_irecv(
242 . bbufr(add),siz,real ,it_spmd(p),msgtyp,
243 . spmd_comm_world,req_ri(p),ierror )
244 ENDIF
245 ENDIF
246 ENDDO
247 addr(nspmd+1) = addr(nspmd)+siz
248C
249C Send
250C
251 l = 0
252 DO p = 1, nspmd
253 add = l+1
254 adds(p) = add
255 siz = 0
256 IF(p/=loc_proc)THEN
257C test en plus pour savoir si com globale necessaire entre les 2 procs
258 DO ii = 1, nbintc
259 nin = intlist(ii)
260 ideb = debut(nin)
261 nb = nsnfi(nin)%P(p)
262 nty = ipari(7,nin)
263 intth =ipari(47,nin)
264 IF(nty==7.OR.nty==10.OR.nty==22.OR.nty==23
265 * .OR.nty==24.OR.nty==25 ) THEN
266 leni = len
267 IF(nb>0) THEN
268 ll = l+1
269 l = l + 1
270 ll0 = ll
271 IF(intth == 0 ) THEN
272c
273 IF(kdtint==0)THEN
274 DO n = 1, nb
275 IF(nsvfi(nin)%P(ideb+n)<0)THEN
276C noeud generant une force
277 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
278 bbufs(l+1) = nsvfi(nin)%P(ideb+n)
279 bbufs(l+2) = afi(nin)%P(1,ideb+n)
280 bbufs(l+3) = afi(nin)%P(2,ideb+n)
281 bbufs(l+4) = afi(nin)%P(3,ideb+n)
282 bbufs(l+5) = stnfi(nin)%P(ideb+n)
283 afi(nin)%P(1,ideb+n) = zero
284 afi(nin)%P(2,ideb+n) = zero
285 afi(nin)%P(3,ideb+n) = zero
286 stnfi(nin)%P(ideb+n) = zero
287 l = l + len
288 ENDIF
289 ENDDO
290 ELSE
291 DO n = 1, nb
292 IF(nsvfi(nin)%P(ideb+n)<0)THEN
293C noeud generant une force
294 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
295 bbufs(l+1) = nsvfi(nin)%P(ideb+n)
296 bbufs(l+2) = afi(nin)%P(1,ideb+n)
297 bbufs(l+3) = afi(nin)%P(2,ideb+n)
298 bbufs(l+4) = afi(nin)%P(3,ideb+n)
299 bbufs(l+5) = stnfi(nin)%P(ideb+n)
300 bbufs(l+6) = vscfi(nin)%P(ideb+n)
301 afi(nin)%P(1,ideb+n) = zero
302 afi(nin)%P(2,ideb+n) = zero
303 afi(nin)%P(3,ideb+n) = zero
304 stnfi(nin)%P(ideb+n) = zero
305 vscfi(nin)%P(ideb+n) = zero
306 l = l + len
307 ENDIF
308 ENDDO
309 ENDIF
310C
311C--- interface 7 + la thermique
312C
313 ELSE
314c
315 IF(nodadt_therm == 1) THEN ! Thermal Time Step
316 leni = len7t
317 IF(kdtint==0)THEN
318 DO n = 1, nb
319 IF(nsvfi(nin)%P(ideb+n)<0)THEN
320C noeud generant une force
321 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
322 bbufs(l+1) = nsvfi(nin)%P(ideb+n)
323 bbufs(l+2) = afi(nin)%P(1,ideb+n)
324 bbufs(l+3) = afi(nin)%P(2,ideb+n)
325 bbufs(l+4) = afi(nin)%P(3,ideb+n)
326 bbufs(l+5) = stnfi(nin)%P(ideb+n)
327 bbufs(l+6) = fthefi(nin)%P(ideb+n)
328 bbufs(l+7) = condnfi(nin)%P(ideb+n)
329 afi(nin)%P(1,ideb+n) = zero
330 afi(nin)%P(2,ideb+n) = zero
331 afi(nin)%P(3,ideb+n) = zero
332 stnfi(nin)%P(ideb+n) = zero
333 fthefi(nin)%P(ideb+n)= zero
334 condnfi(nin)%P(ideb+n)= zero
335 l = l + len7t
336 ENDIF
337 ENDDO
338 ELSE
339 DO n = 1, nb
340 IF(nsvfi(nin)%P(ideb+n)<0)THEN
341C noeud generant une force
342 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
343 bbufs(l+1) = nsvfi(nin)%P(ideb+n)
344 bbufs(l+2) = afi(nin)%P(1,ideb+n)
345 bbufs(l+3) = afi(nin)%P(2,ideb+n)
346 bbufs(l+4) = afi(nin)%P(3,ideb+n)
347 bbufs(l+5) = stnfi(nin)%P(ideb+n)
348 bbufs(l+6) = vscfi(nin)%P(ideb+n)
349 bbufs(l+7) = fthefi(nin)%P(ideb+n)
350 bbufs(l+8) = condnfi(nin)%P(ideb+n)
351 afi(nin)%P(1,ideb+n) = zero
352 afi(nin)%P(2,ideb+n) = zero
353 afi(nin)%P(3,ideb+n) = zero
354 stnfi(nin)%P(ideb+n) = zero
355 vscfi(nin)%P(ideb+n) = zero
356 fthefi(nin)%P(ideb+n)= zero
357 condnfi(nin)%P(ideb+n)= zero
358 l = l + len7t
359 ENDIF
360 ENDDO
361 ENDIF
362c
363 ELSE ! NODADTTHERM
364c
365 leni = len7t
366 IF(kdtint==0)THEN
367 DO n = 1, nb
368 IF(nsvfi(nin)%P(ideb+n)<0)THEN
369C noeud generant une force
370 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
371 bbufs(l+1) = nsvfi(nin)%P(ideb+n)
372 bbufs(l+2) = afi(nin)%P(1,ideb+n)
373 bbufs(l+3) = afi(nin)%P(2,ideb+n)
374 bbufs(l+4) = afi(nin)%P(3,ideb+n)
375 bbufs(l+5) = stnfi(nin)%P(ideb+n)
376 bbufs(l+6) = fthefi(nin)%P(ideb+n)
377 afi(nin)%P(1,ideb+n) = zero
378 afi(nin)%P(2,ideb+n) = zero
379 afi(nin)%P(3,ideb+n) = zero
380 stnfi(nin)%P(ideb+n) = zero
381 fthefi(nin)%P(ideb+n)= zero
382 l = l + len7t
383 ENDIF
384 ENDDO
385 ELSE
386 DO n = 1, nb
387 IF(nsvfi(nin)%P(ideb+n)<0)THEN
388C noeud generant une force
389 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
390 bbufs(l+1) = nsvfi(nin)%P(ideb+n)
391 bbufs(l+2) = afi(nin)%P(1,ideb+n)
392 bbufs(l+3) = afi(nin)%P(2,ideb+n)
393 bbufs(l+4) = afi(nin)%P(3,ideb+n)
394 bbufs(l+5) = stnfi(nin)%P(ideb+n)
395 bbufs(l+6) = vscfi(nin)%P(ideb+n)
396 bbufs(l+7) = fthefi(nin)%P(ideb+n)
397 afi(nin)%P(1,ideb+n) = zero
398 afi(nin)%P(2,ideb+n) = zero
399 afi(nin)%P(3,ideb+n) = zero
400 stnfi(nin)%P(ideb+n) = zero
401 vscfi(nin)%P(ideb+n) = zero
402 fthefi(nin)%P(ideb+n)= zero
403 l = l + len7t
404 ENDIF
405 ENDDO
406 ENDIF
407c
408 ENDIF
409 ENDIF
410C
411 bbufs(ll) = (l-ll0)/leni
412 debut(nin) = debut(nin) + nb
413 END IF
414
415 ELSEIF(nty==11)THEN
416C type 11
417 IF(nb>0) THEN
418 ll = l+1
419 l = l + 1
420 IF(intth == 0) THEN
421 leni=len11
422c
423 IF(kdtint==0)THEN
424 DO n = 1, nb
425 IF(nsvfi(nin)%P(ideb+n)<0)THEN
426C noeud generant une force
427 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
428 bbufs(l+1) = nsvfi(nin)%P(ideb+n)
429 n1 = 2*(ideb+n-1)+1
430 n2 = 2*(ideb+n)
431 bbufs(l+2) = afi(nin)%P(1,n1)
432 bbufs(l+3) = afi(nin)%P(2,n1)
433 bbufs(l+4) = afi(nin)%P(3,n1)
434 bbufs(l+5) = stnfi(nin)%P(n1)
435 bbufs(l+6) = afi(nin)%P(1,n2)
436 bbufs(l+7) = afi(nin)%P(2,n2)
437 bbufs(l+8) = afi(nin)%P(3,n2)
438 bbufs(l+9) = stnfi(nin)%P(n2)
439 afi(nin)%P(1,n1) = zero
440 afi(nin)%P(2,n1) = zero
441 afi(nin)%P(3,n1) = zero
442 stnfi(nin)%P(n1) = zero
443 afi(nin)%P(1,n2) = zero
444 afi(nin)%P(2,n2) = zero
445 afi(nin)%P(3,n2) = zero
446 stnfi(nin)%P(n2) = zero
447 l = l + leni
448 ENDIF
449 ENDDO
450 ELSE
451 DO n = 1, nb
452 IF(nsvfi(nin)%P(ideb+n)<0)THEN
453C noeud generant une force
454 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
455 n1 = 2*(ideb+n-1)+1
456 n2 = 2*(ideb+n)
457 bbufs(l+1) = nsvfi(nin)%P(n1)
458 bbufs(l+2) = afi(nin)%P(1,n1)
459 bbufs(l+3) = afi(nin)%P(2,n1)
460 bbufs(l+4) = afi(nin)%P(3,n1)
461 bbufs(l+5) = stnfi(nin)%P(n1)
462 bbufs(l+6) = vscfi(nin)%P(n1)
463 bbufs(l+7) = nsvfi(nin)%P(n2)
464 bbufs(l+8) = afi(nin)%P(1,n2)
465 bbufs(l+9) = afi(nin)%P(2,n2)
466 bbufs(l+10) = afi(nin)%P(3,n2)
467 bbufs(l+11) = stnfi(nin)%P(n2)
468 bbufs(l+12) = vscfi(nin)%P(n2)
469 afi(nin)%P(1,n1) = zero
470 afi(nin)%P(2,n1) = zero
471 afi(nin)%P(3,n1) = zero
472 stnfi(nin)%P(n1) = zero
473 vscfi(nin)%P(n1) = zero
474 afi(nin)%P(1,n2) = zero
475 afi(nin)%P(2,n2) = zero
476 afi(nin)%P(3,n2) = zero
477 stnfi(nin)%P(n2) = zero
478 vscfi(nin)%P(n2) = zero
479 l = l + leni
480 ENDIF
481 ENDDO
482 ENDIF
483c
484 ELSE
485C
486C Type 11 + Thermal exchange
487C
488 IF(nodadt_therm == 1) THEN ! Thermal Time Step
489 leni=len11t
490c
491 IF(kdtint==0)THEN
492 DO n = 1, nb
493 IF(nsvfi(nin)%P(ideb+n)<0)THEN
494C noeud generant une force
495 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
496 bbufs(l+1) = nsvfi(nin)%P(ideb+n)
497 n1 = 2*(ideb+n-1)+1
498 n2 = 2*(ideb+n)
499 bbufs(l+2) = afi(nin)%P(1,n1)
500 bbufs(l+3) = afi(nin)%P(2,n1)
501 bbufs(l+4) = afi(nin)%P(3,n1)
502 bbufs(l+5) = stnfi(nin)%P(n1)
503 bbufs(l+6) = fthefi(nin)%P(n1)
504 bbufs(l+7) = condnfi(nin)%P(n1)
505 bbufs(l+8) = afi(nin)%P(1,n2)
506 bbufs(l+9) = afi(nin)%P(2,n2)
507 bbufs(l+10) = afi(nin)%P(3,n2)
508 bbufs(l+11) = stnfi(nin)%P(n2)
509 bbufs(l+12) = fthefi(nin)%P(n2)
510 bbufs(l+13) = condnfi(nin)%P(n2)
511 afi(nin)%P(1,n1) = zero
512 afi(nin)%P(2,n1) = zero
513 afi(nin)%P(3,n1) = zero
514 stnfi(nin)%P(n1) = zero
515 afi(nin)%P(1,n2) = zero
516 afi(nin)%P(2,n2) = zero
517 afi(nin)%P(3,n2) = zero
518 stnfi(nin)%P(n2) = zero
519 fthefi(nin)%P(n1)= zero
520 fthefi(nin)%P(n2)= zero
521 condnfi(nin)%P(n1)= zero
522 condnfi(nin)%P(n2)= zero
523 l = l + leni
524 ENDIF
525 ENDDO
526 ELSE
527C KINDT /= 0 Broken LENI should be 16
528 DO n = 1, nb
529 IF(nsvfi(nin)%P(ideb+n)<0)THEN
530C noeud generant une force
531 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
532 n1 = 2*(ideb+n-1)+1
533 n2 = 2*(ideb+n)
534 bbufs(l+1) = nsvfi(nin)%P(n1)
535 bbufs(l+2) = afi(nin)%P(1,n1)
536 bbufs(l+3) = afi(nin)%P(2,n1)
537 bbufs(l+4) = afi(nin)%P(3,n1)
538 bbufs(l+5) = stnfi(nin)%P(n1)
539 bbufs(l+6) = vscfi(nin)%P(n1)
540 bbufs(l+7) = fthefi(nin)%P(n1)
541 bbufs(l+8) = condnfi(nin)%P(n1)
542 bbufs(l+9) = nsvfi(nin)%P(n2)
543 bbufs(l+10) = afi(nin)%P(1,n2)
544 bbufs(l+11) = afi(nin)%P(2,n2)
545 bbufs(l+12) = afi(nin)%P(3,n2)
546 bbufs(l+13) = stnfi(nin)%P(n2)
547 bbufs(l+14) = vscfi(nin)%P(n2)
548 bbufs(l+15) = fthefi(nin)%P(n2)
549 bbufs(l+16) = condnfi(nin)%P(n2)
550 afi(nin)%P(1,n1) = zero
551 afi(nin)%P(2,n1) = zero
552 afi(nin)%P(3,n1) = zero
553 stnfi(nin)%P(n1) = zero
554 vscfi(nin)%P(n1) = zero
555 afi(nin)%P(1,n2) = zero
556 afi(nin)%P(2,n2) = zero
557 afi(nin)%P(3,n2) = zero
558 stnfi(nin)%P(n2) = zero
559 vscfi(nin)%P(n2) = zero
560 fthefi(nin)%P(n1)= zero
561 fthefi(nin)%P(n2)= zero
562 condnfi(nin)%P(n1)= zero
563 condnfi(nin)%P(n2)= zero
564 l = l + leni
565 ENDIF
566 ENDDO
567 ENDIF
568c
569 ELSE
570 leni=len11t
571c
572 IF(kdtint==0)THEN
573 DO n = 1, nb
574 IF(nsvfi(nin)%P(ideb+n)<0)THEN
575C noeud generant une force
576 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
577 bbufs(l+1) = nsvfi(nin)%P(ideb+n)
578 n1 = 2*(ideb+n-1)+1
579 n2 = 2*(ideb+n)
580 bbufs(l+2) = afi(nin)%P(1,n1)
581 bbufs(l+3) = afi(nin)%P(2,n1)
582 bbufs(l+4) = afi(nin)%P(3,n1)
583 bbufs(l+5) = stnfi(nin)%P(n1)
584 bbufs(l+6) = fthefi(nin)%P(n1)
585 bbufs(l+7) = afi(nin)%P(1,n2)
586 bbufs(l+8) = afi(nin)%P(2,n2)
587 bbufs(l+9) = afi(nin)%P(3,n2)
588 bbufs(l+10) = stnfi(nin)%P(n2)
589 bbufs(l+11) = fthefi(nin)%P(n2)
590 afi(nin)%P(1,n1) = zero
591 afi(nin)%P(2,n1) = zero
592 afi(nin)%P(3,n1) = zero
593 stnfi(nin)%P(n1) = zero
594 afi(nin)%P(1,n2) = zero
595 afi(nin)%P(2,n2) = zero
596 afi(nin)%P(3,n2) = zero
597 stnfi(nin)%P(n2) = zero
598 fthefi(nin)%P(n1)= zero
599 fthefi(nin)%P(n2)= zero
600 l = l + leni
601 ENDIF
602 ENDDO
603 ELSE
604C KINDT /= 0 Broken LENI should be 14
605 DO n = 1, nb
606 IF(nsvfi(nin)%P(ideb+n)<0)THEN
607C noeud generant une force
608 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
609 n1 = 2*(ideb+n-1)+1
610 n2 = 2*(ideb+n)
611 bbufs(l+1) = nsvfi(nin)%P(n1)
612 bbufs(l+2) = afi(nin)%P(1,n1)
613 bbufs(l+3) = afi(nin)%P(2,n1)
614 bbufs(l+4) = afi(nin)%P(3,n1)
615 bbufs(l+5) = stnfi(nin)%P(n1)
616 bbufs(l+6) = vscfi(nin)%P(n1)
617 bbufs(l+7) = fthefi(nin)%P(n1)
618 bbufs(l+8) = nsvfi(nin)%P(n2)
619 bbufs(l+9) = afi(nin)%P(1,n2)
620 bbufs(l+10) = afi(nin)%P(2,n2)
621 bbufs(l+11) = afi(nin)%P(3,n2)
622 bbufs(l+12) = stnfi(nin)%P(n2)
623 bbufs(l+13) = vscfi(nin)%P(n2)
624 bbufs(l+14) = fthefi(nin)%P(n2)
625 afi(nin)%P(1,n1) = zero
626 afi(nin)%P(2,n1) = zero
627 afi(nin)%P(3,n1) = zero
628 stnfi(nin)%P(n1) = zero
629 vscfi(nin)%P(n1) = zero
630 afi(nin)%P(1,n2) = zero
631 afi(nin)%P(2,n2) = zero
632 afi(nin)%P(3,n2) = zero
633 stnfi(nin)%P(n2) = zero
634 vscfi(nin)%P(n2) = zero
635 fthefi(nin)%P(n1)= zero
636 fthefi(nin)%P(n2)= zero
637 l = l + leni
638 ENDIF
639 ENDDO
640 ENDIF
641c
642 ENDIF
643 ENDIF
644 bbufs(ll) = (l-ll)/leni
645 debut(nin) = debut(nin) + nb
646 END IF
647C fin type11
648 ELSEIF(nty==17)THEN
649C type 17
650 leni=len17
651 IF(nb>0) THEN
652 ll = l+1
653 l = l + 1
654 DO n = 1, nb
655 IF(nsvfi(nin)%P(ideb+n)<0)THEN
656C noeud generant une force
657 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
658 bbufs(l+1) = nsvfi(nin)%P(ideb+n)
659 bbufs(l+2) = afi17(nin)%P(1,1,ideb+n)
660 bbufs(l+3) = afi17(nin)%P(2,1,ideb+n)
661 bbufs(l+4) = afi17(nin)%P(3,1,ideb+n)
662 bbufs(l+5) = stnfi17(nin)%P(1,ideb+n)
663 afi17(nin)%P(1,1,ideb+n) = zero
664 afi17(nin)%P(2,1,ideb+n) = zero
665 afi17(nin)%P(3,1,ideb+n) = zero
666 stnfi17(nin)%P(1,ideb+n) = zero
667C
668 bbufs(l+6) = afi17(nin)%P(1,2,ideb+n)
669 bbufs(l+7) = afi17(nin)%P(2,2,ideb+n)
670 bbufs(l+8) = afi17(nin)%P(3,2,ideb+n)
671 bbufs(l+9)= stnfi17(nin)%P(2,ideb+n)
672 afi17(nin)%P(1,2,ideb+n) = zero
673 afi17(nin)%P(2,2,ideb+n) = zero
674 afi17(nin)%P(3,2,ideb+n) = zero
675 stnfi17(nin)%P(2,ideb+n) = zero
676C
677 bbufs(l+10)= afi17(nin)%P(1,3,ideb+n)
678 bbufs(l+11)= afi17(nin)%P(2,3,ideb+n)
679 bbufs(l+12)= afi17(nin)%P(3,3,ideb+n)
680 bbufs(l+13)= stnfi17(nin)%P(3,ideb+n)
681 afi17(nin)%P(1,3,ideb+n) = zero
682 afi17(nin)%P(2,3,ideb+n) = zero
683 afi17(nin)%P(3,3,ideb+n) = zero
684 stnfi17(nin)%P(3,ideb+n) = zero
685C
686 bbufs(l+14)= afi17(nin)%P(1,4,ideb+n)
687 bbufs(l+15)= afi17(nin)%P(2,4,ideb+n)
688 bbufs(l+16)= afi17(nin)%P(3,4,ideb+n)
689 bbufs(l+17)= stnfi17(nin)%P(4,ideb+n)
690 afi17(nin)%P(1,4,ideb+n) = zero
691 afi17(nin)%P(2,4,ideb+n) = zero
692 afi17(nin)%P(3,4,ideb+n) = zero
693 stnfi17(nin)%P(4,ideb+n) = zero
694C
695 bbufs(l+18)= afi17(nin)%P(1,5,ideb+n)
696 bbufs(l+19)= afi17(nin)%P(2,5,ideb+n)
697 bbufs(l+20)= afi17(nin)%P(3,5,ideb+n)
698 bbufs(l+21)= stnfi17(nin)%P(5,ideb+n)
699 afi17(nin)%P(1,5,ideb+n) = zero
700 afi17(nin)%P(2,5,ideb+n) = zero
701 afi17(nin)%P(3,5,ideb+n) = zero
702 stnfi17(nin)%P(5,ideb+n) = zero
703C
704 bbufs(l+22)= afi17(nin)%P(1,6,ideb+n)
705 bbufs(l+23)= afi17(nin)%P(2,6,ideb+n)
706 bbufs(l+24)= afi17(nin)%P(3,6,ideb+n)
707 bbufs(l+25)= stnfi17(nin)%P(6,ideb+n)
708 afi17(nin)%P(1,6,ideb+n) = zero
709 afi17(nin)%P(2,6,ideb+n) = zero
710 afi17(nin)%P(3,6,ideb+n) = zero
711 stnfi17(nin)%P(6,ideb+n) = zero
712C
713 bbufs(l+26)= afi17(nin)%P(1,7,ideb+n)
714 bbufs(l+27)= afi17(nin)%P(2,7,ideb+n)
715 bbufs(l+28)= afi17(nin)%P(3,7,ideb+n)
716 bbufs(l+29)= stnfi17(nin)%P(7,ideb+n)
717 afi17(nin)%P(1,7,ideb+n) = zero
718 afi17(nin)%P(2,7,ideb+n) = zero
719 afi17(nin)%P(3,7,ideb+n) = zero
720 stnfi17(nin)%P(7,ideb+n) = zero
721C
722 bbufs(l+30)= afi17(nin)%P(1,8,ideb+n)
723 bbufs(l+31)= afi17(nin)%P(2,8,ideb+n)
724 bbufs(l+32)= afi17(nin)%P(3,8,ideb+n)
725 bbufs(l+33)= stnfi17(nin)%P(8,ideb+n)
726 afi17(nin)%P(1,8,ideb+n) = zero
727 afi17(nin)%P(2,8,ideb+n) = zero
728 afi17(nin)%P(3,8,ideb+n) = zero
729 stnfi17(nin)%P(8,ideb+n) = zero
730C
731 bbufs(l+34)= afi17(nin)%P(1,9,ideb+n)
732 bbufs(l+35)= afi17(nin)%P(2,9,ideb+n)
733 bbufs(l+36)= afi17(nin)%P(3,9,ideb+n)
734 bbufs(l+37)= stnfi17(nin)%P(9,ideb+n)
735 afi17(nin)%P(1,9,ideb+n) = zero
736 afi17(nin)%P(2,9,ideb+n) = zero
737 afi17(nin)%P(3,9,ideb+n) = zero
738 stnfi17(nin)%P(9,ideb+n) = zero
739C
740 bbufs(l+38)= afi17(nin)%P(1,10,ideb+n)
741 bbufs(l+39)= afi17(nin)%P(2,10,ideb+n)
742 bbufs(l+40)= afi17(nin)%P(3,10,ideb+n)
743 bbufs(l+41)= stnfi17(nin)%P(10,ideb+n)
744 afi17(nin)%P(1,10,ideb+n) = zero
745 afi17(nin)%P(2,10,ideb+n) = zero
746 afi17(nin)%P(3,10,ideb+n) = zero
747 stnfi17(nin)%P(10,ideb+n) = zero
748C
749 bbufs(l+42)= afi17(nin)%P(1,11,ideb+n)
750 bbufs(l+43)= afi17(nin)%P(2,11,ideb+n)
751 bbufs(l+44)= afi17(nin)%P(3,11,ideb+n)
752 bbufs(l+45)= stnfi17(nin)%P(11,ideb+n)
753 afi17(nin)%P(1,11,ideb+n) = zero
754 afi17(nin)%P(2,11,ideb+n) = zero
755 afi17(nin)%P(3,11,ideb+n) = zero
756 stnfi17(nin)%P(11,ideb+n) = zero
757C
758 bbufs(l+46)= afi17(nin)%P(1,12,ideb+n)
759 bbufs(l+47)= afi17(nin)%P(2,12,ideb+n)
760 bbufs(l+48)= afi17(nin)%P(3,12,ideb+n)
761 bbufs(l+49)= stnfi17(nin)%P(12,ideb+n)
762 afi17(nin)%P(1,12,ideb+n) = zero
763 afi17(nin)%P(2,12,ideb+n) = zero
764 afi17(nin)%P(3,12,ideb+n) = zero
765 stnfi17(nin)%P(12,ideb+n) = zero
766C
767 bbufs(l+50)= afi17(nin)%P(1,13,ideb+n)
768 bbufs(l+51)= afi17(nin)%P(2,13,ideb+n)
769 bbufs(l+52)= afi17(nin)%P(3,13,ideb+n)
770 bbufs(l+53)= stnfi17(nin)%P(13,ideb+n)
771 afi17(nin)%P(1,13,ideb+n) = zero
772 afi17(nin)%P(2,13,ideb+n) = zero
773 afi17(nin)%P(3,13,ideb+n) = zero
774 stnfi17(nin)%P(13,ideb+n) = zero
775C
776 bbufs(l+54)= afi17(nin)%P(1,14,ideb+n)
777 bbufs(l+55)= afi17(nin)%P(2,14,ideb+n)
778 bbufs(l+56)= afi17(nin)%P(3,14,ideb+n)
779 bbufs(l+57)= stnfi17(nin)%P(14,ideb+n)
780 afi17(nin)%P(1,14,ideb+n) = zero
781 afi17(nin)%P(2,14,ideb+n) = zero
782 afi17(nin)%P(3,14,ideb+n) = zero
783 stnfi17(nin)%P(14,ideb+n) = zero
784C
785 bbufs(l+58)= afi17(nin)%P(1,15,ideb+n)
786 bbufs(l+59)= afi17(nin)%P(2,15,ideb+n)
787 bbufs(l+60)= afi17(nin)%P(3,15,ideb+n)
788 bbufs(l+61)= stnfi17(nin)%P(15,ideb+n)
789 afi17(nin)%P(1,15,ideb+n) = zero
790 afi17(nin)%P(2,15,ideb+n) = zero
791 afi17(nin)%P(3,15,ideb+n) = zero
792 stnfi17(nin)%P(15,ideb+n) = zero
793C
794 bbufs(l+62)= afi17(nin)%P(1,16,ideb+n)
795 bbufs(l+63)= afi17(nin)%P(2,16,ideb+n)
796 bbufs(l+64)= afi17(nin)%P(3,16,ideb+n)
797 bbufs(l+65)= stnfi17(nin)%P(16,ideb+n)
798 afi17(nin)%P(1,16,ideb+n) = zero
799 afi17(nin)%P(2,16,ideb+n) = zero
800 afi17(nin)%P(3,16,ideb+n) = zero
801 stnfi17(nin)%P(16,ideb+n) = zero
802C
803 bbufs(l+66)= frotsfi(nin)%P(1,ideb+n)
804 bbufs(l+67)= frotsfi(nin)%P(2,ideb+n)
805 bbufs(l+68)= frotsfi(nin)%P(3,ideb+n)
806 bbufs(l+69)= frotsfi(nin)%P(4,ideb+n)
807 frotsfi(nin)%P(1,ideb+n) = zero
808 frotsfi(nin)%P(2,ideb+n) = zero
809 frotsfi(nin)%P(3,ideb+n) = zero
810 frotsfi(nin)%P(4,ideb+n) = zero
811C
812 l = l + len17
813 ENDIF
814 ENDDO
815 bbufs(ll) = (l-ll)/len17
816 debut(nin) = debut(nin) + nb
817 END IF
818C fin type17
819 ELSEIF(nty==20) THEN
820C type20
821 leni = len20
822 IF(nb>0) THEN
823 ll = l+1
824 l = l + 1
825 IF(intth == 0 ) THEN
826 IF(kdtint==0)THEN
827 DO n = 1, nb
828 IF(nsvfi(nin)%P(ideb+n)<0)THEN
829C noeud generant une force
830 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
831 bbufs(l+1) = nsvfi(nin)%P(ideb+n)
832 bbufs(l+2) = afi(nin)%P(1,ideb+n)
833 bbufs(l+3) = afi(nin)%P(2,ideb+n)
834 bbufs(l+4) = afi(nin)%P(3,ideb+n)
835 bbufs(l+5) = stnfi(nin)%P(ideb+n)
836 bbufs(l+6) = alphakfi(nin)%P(ideb+n)
837C
838 CALL putdpdaanc(
839 . daanc6fi(nin)%P(1,1,ideb+n),bbufs(l+7),iresp,inc)
840C L = L + INC
841C
842 afi(nin)%P(1,ideb+n) = zero
843 afi(nin)%P(2,ideb+n) = zero
844 afi(nin)%P(3,ideb+n) = zero
845 stnfi(nin)%P(ideb+n) = zero
846C
847C
848 l = l + len20
849 ENDIF
850 ENDDO
851 ELSE
852 DO n = 1, nb
853 IF(nsvfi(nin)%P(ideb+n)<0)THEN
854C noeud generant une force
855 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
856 bbufs(l+1) = nsvfi(nin)%P(ideb+n)
857 bbufs(l+2) = afi(nin)%P(1,ideb+n)
858 bbufs(l+3) = afi(nin)%P(2,ideb+n)
859 bbufs(l+4) = afi(nin)%P(3,ideb+n)
860 bbufs(l+5) = stnfi(nin)%P(ideb+n)
861 bbufs(l+6) = vscfi(nin)%P(ideb+n)
862 bbufs(l+7) = alphakfi(nin)%P(ideb+n)
863C
864 CALL putdpdaanc(
865 . daanc6fi(nin)%P(1,1,ideb+n),bbufs(l+8),iresp,inc)
866C L = L + INC
867C
868 afi(nin)%P(1,ideb+n) = zero
869 afi(nin)%P(2,ideb+n) = zero
870 afi(nin)%P(3,ideb+n) = zero
871 stnfi(nin)%P(ideb+n) = zero
872 vscfi(nin)%P(ideb+n) = zero
873C
874 l = l + len20
875 ENDIF
876 ENDDO
877 ENDIF
878C
879C--- interface 20 + la thermique
880C
881 ELSE
882 leni = len20t
883 IF(kdtint==0)THEN
884 DO n = 1, nb
885 IF(nsvfi(nin)%P(ideb+n)<0)THEN
886C noeud generant une force
887 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
888 bbufs(l+1) = nsvfi(nin)%P(ideb+n)
889 bbufs(l+2) = afi(nin)%P(1,ideb+n)
890 bbufs(l+3) = afi(nin)%P(2,ideb+n)
891 bbufs(l+4) = afi(nin)%P(3,ideb+n)
892 bbufs(l+5) = stnfi(nin)%P(ideb+n)
893 bbufs(l+6) = fthefi(nin)%P(ideb+n)
894 bbufs(l+7) = alphakfi(nin)%P(ideb+n)
895C
896 CALL putdpdaanc(
897 . daanc6fi(nin)%P(1,1,ideb+n),bbufs(l+8),iresp,inc)
898C L = L + INC
899C
900 afi(nin)%P(1,ideb+n) = zero
901 afi(nin)%P(2,ideb+n) = zero
902 afi(nin)%P(3,ideb+n) = zero
903 stnfi(nin)%P(ideb+n) = zero
904 fthefi(nin)%P(ideb+n)= zero
905C
906 l = l + len20t
907 ENDIF
908 ENDDO
909 ELSE
910 DO n = 1, nb
911 IF(nsvfi(nin)%P(ideb+n)<0)THEN
912C noeud generant une force
913 nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
914 bbufs(l+1) = nsvfi(nin)%P(ideb+n)
915 bbufs(l+2) = afi(nin)%P(1,ideb+n)
916 bbufs(l+3) = afi(nin)%P(2,ideb+n)
917 bbufs(l+4) = afi(nin)%P(3,ideb+n)
918 bbufs(l+5) = stnfi(nin)%P(ideb+n)
919 bbufs(l+6) = vscfi(nin)%P(ideb+n)
920 bbufs(l+7) = fthefi(nin)%P(ideb+n)
921 bbufs(l+8) = alphakfi(nin)%P(ideb+n)
922C
923 CALL putdpdaanc(
924 . daanc6fi(nin)%P(1,1,ideb+n),bbufs(l+9),iresp,inc)
925C L = L + INC
926C
927 afi(nin)%P(1,ideb+n) = zero
928 afi(nin)%P(2,ideb+n) = zero
929 afi(nin)%P(3,ideb+n) = zero
930 stnfi(nin)%P(ideb+n) = zero
931 vscfi(nin)%P(ideb+n) = zero
932 fthefi(nin)%P(ideb+n)= zero
933C
934 l = l + len20t
935 ENDIF
936 ENDDO
937 ENDIF
938 ENDIF
939C
940 bbufs(ll) = (l-ll)/leni
941 debut(nin) = debut(nin) + nb
942 END IF
943
944 END IF
945C
946C Partie supplementaire type 20 edge
947C
948 IF(nty==20) THEN
949 nb = nsnfie(nin)%P(p)
950 ideb = debute(nin)
951 leni = len20e
952 IF(nb>0) THEN
953 ll = l+1
954 l = l + 1
955 IF(kdtint==0)THEN
956 DO n = 1, nb
957 IF(nsvfie(nin)%P(ideb+n)<0)THEN
958C noeud generant une force
959 nsvfie(nin)%P(ideb+n)=-nsvfie(nin)%P(ideb+n)
960 n1 = 2*(n+ideb-1)+1
961 n2 = 2*(n+ideb)
962 bbufs(l+1) = nsvfie(nin)%P(ideb+n)
963C
964 bbufs(l+2) = afie(nin)%P(1,n1)
965 bbufs(l+3) = afie(nin)%P(2,n1)
966 bbufs(l+4) = afie(nin)%P(3,n1)
967 bbufs(l+5) = stnfie(nin)%P(n1)
968 bbufs(l+6) = afie(nin)%P(1,n2)
969 bbufs(l+7) = afie(nin)%P(2,n2)
970 bbufs(l+8) = afie(nin)%P(3,n2)
971 bbufs(l+9) = stnfie(nin)%P(n2)
972 bbufs(l+10) = alphakfie(nin)%P(n1)
973 bbufs(l+11) = alphakfie(nin)%P(n2)
974C
975 CALL putdpdaanc(
976 . daanc6fie(nin)%P(1,1,n1),bbufs(l+12),iresp,inc)
977C L = L + INC
978 CALL putdpdaanc(
979 . daanc6fie(nin)%P(1,1,n2),bbufs(l+12+inc),iresp,
980 . inc)
981C L = L + INC
982C
983 afie(nin)%P(1,n1) = zero
984 afie(nin)%P(2,n1) = zero
985 afie(nin)%P(3,n1) = zero
986 stnfie(nin)%P(n1) = zero
987 afie(nin)%P(1,n2) = zero
988 afie(nin)%P(2,n2) = zero
989 afie(nin)%P(3,n2) = zero
990 stnfie(nin)%P(n2) = zero
991C
992 l = l + len20e
993 END IF
994 END DO
995 ELSE ! KDTIN /= 0
996 DO n = 1, nb
997 IF(nsvfie(nin)%P(ideb+n)<0)THEN
998C noeud generant une force
999 nsvfie(nin)%P(ideb+n)=-nsvfie(nin)%P(ideb+n)
1000 n1 = 2*(n+ideb-1)+1
1001 n2 = 2*(n+ideb)
1002 bbufs(l+1) = nsvfie(nin)%P(ideb+n)
1003C
1004 bbufs(l+2) = afie(nin)%P(1,n1)
1005 bbufs(l+3) = afie(nin)%P(2,n1)
1006 bbufs(l+4) = afie(nin)%P(3,n1)
1007 bbufs(l+5) = stnfie(nin)%P(n1)
1008 bbufs(l+6) = vscfie(nin)%P(n1)
1009 bbufs(l+7) = afie(nin)%P(1,n2)
1010 bbufs(l+8) = afie(nin)%P(2,n2)
1011 bbufs(l+9) = afie(nin)%P(3,n2)
1012 bbufs(l+10)= stnfie(nin)%P(n2)
1013 bbufs(l+11)= vscfie(nin)%P(n2)
1014 bbufs(l+12) = alphakfie(nin)%P(n1)
1015 bbufs(l+13) = alphakfie(nin)%P(n2)
1016C
1017 CALL putdpdaanc(
1018 . daanc6fie(nin)%P(1,1,n1),bbufs(l+14),iresp,inc)
1019C L = L + INC
1020 CALL putdpdaanc(
1021 . daanc6fie(nin)%P(1,1,n2),bbufs(l+14+inc),iresp,
1022 . inc)
1023C L = L + INC
1024C
1025 afie(nin)%P(1,n1) = zero
1026 afie(nin)%P(2,n1) = zero
1027 afie(nin)%P(3,n1) = zero
1028 stnfie(nin)%P(n1) = zero
1029 vscfie(nin)%P(n1) = zero
1030 afie(nin)%P(1,n2) = zero
1031 afie(nin)%P(2,n2) = zero
1032 afie(nin)%P(3,n2) = zero
1033 stnfie(nin)%P(n2) = zero
1034 vscfie(nin)%P(n2) = zero
1035C
1036 l = l + len20e
1037 END IF
1038 END DO
1039 END IF ! KDTIN /= 0
1040 bbufs(ll) = (l-ll)/len20e
1041 debute(nin) = debute(nin) + nb
1042 END IF
1043 END IF
1044
1045C
1046C Partie supplementaire type 25 edge
1047C
1048 IF(nty==25 .AND. ipari(58,nin) > 0) THEN
1049 nb = nsnfie(nin)%P(p)
1050 ideb = debute(nin)
1051 leni = len25e
1052 IF(nb>0) THEN
1053 ll = l+1
1054 l = l + 1
1055 DO n = 1, nb
1056 IF(nsvfie(nin)%P(ideb+n)<0)THEN
1057C noeud generant u force
1058 nsvfie(nin)%P(ideb+n)=-nsvfie(nin)%P(ideb+n)
1059 n1 = 2*(n+ideb-1)+1
1060 n2 = 2*(n+ideb)
1061 bbufs(l+1) = nsvfie(nin)%P(ideb+n)
1062 bbufs(l+2) = afie(nin)%P(1,n1)
1063 bbufs(l+3) = afie(nin)%P(2,n1)
1064 bbufs(l+4) = afie(nin)%P(3,n1)
1065 bbufs(l+5) = stnfie(nin)%P(n1)
1066 bbufs(l+7 ) = afie(nin)%P(1,n2)
1067 bbufs(l+8 ) = afie(nin)%P(2,n2)
1068 bbufs(l+9 ) = afie(nin)%P(3,n2)
1069 bbufs(l+10) = stnfie(nin)%P(n2)
1070 IF(kdtint /= 0) THEN
1071 bbufs(l+6) = vscfie(nin)%P(n1)
1072 vscfie(nin)%P(n1) = zero
1073 bbufs(l+11)= vscfie(nin)%P(n2)
1074 vscfie(nin)%P(n2) = zero
1075 ELSE
1076 bbufs(l+6) = zero
1077 bbufs(l+11) = zero
1078 ENDIF
1079
1080 IF(intth /= 0) THEN
1081C FTHE(NOD1) = FTHE(NOD1) + BUFR(12,I)
1082C FTHE(NOD2) = FTHE(NOD2) + BUFR(13,I)
1083 IF(nodadt_therm == 1) THEN
1084C CONDN(NOD1) = CONDN(NOD1) + BUFR(14,I)
1085C CONDN(NOD2) = CONDN(NOD2) + BUFR(15,I)
1086 ENDIF
1087 ENDIF
1088
1089 afie(nin)%P(1,n1) = zero
1090 afie(nin)%P(2,n1) = zero
1091 afie(nin)%P(3,n1) = zero
1092 stnfie(nin)%P(n1) = zero
1093 afie(nin)%P(1,n2) = zero
1094 afie(nin)%P(2,n2) = zero
1095 afie(nin)%P(3,n2) = zero
1096 stnfie(nin)%P(n2) = zero
1097 l = l + len25e
1098 ENDIF
1099 ENDDO
1100 bbufs(ll) = (l-ll)/len25e
1101 debute(nin) = debute(nin) + nb
1102 END IF
1103 END IF
1104C fin edge
1105 ENDDO
1106 siz = l+1-add
1107 IF(siz>0)THEN
1108 msgtyp = msgoff
1109 CALL mpi_isend(
1110 . bbufs(add),siz,real ,it_spmd(p),msgtyp,
1111 . spmd_comm_world,req_si(p),ierror )
1112 ENDIF
1113 ENDIF
1114 ENDDO
1115 adds(nspmd+1)=adds(nspmd)+siz
1116C
1117C Attente reception buffer et decompactage
1118C
1119 ELSEIF(iflag==2)THEN
1120C
1121C Attente IRECV
1122C
1123 DO p = 1, nspmd
1124 IF(addr(p+1)-addr(p)>0) THEN
1125 CALL mpi_wait(req_ri(p),status,ierror)
1126 l = addr(p)
1127 DO ii = 1, nbintc
1128 nin = intlist(ii)
1129 nty =ipari(7,nin)
1130 IF(nsnsi(nin)%P(p)>0)THEN
1131 nb = nint(bbufr(l))
1132 l = l + 1
1133 ibc =ipari(11,nin)
1134 noint =ipari(15,nin)
1135 inacti=ipari(22,nin)
1136 isecin=ipari(28,nin)
1137 ibag =ipari(32,nin)
1138 iadm =ipari(44,nin)
1139 intcarea=ipari(99,nin)
1140C
1141 IF(nty==7.OR.nty==10.OR.nty==22.OR.nty==23
1142 * .OR.nty==24.OR.nty==25 )THEN
1143 intth = ipari(47,nin)
1144 IF(intth == 0 ) THEN
1145 CALL spmd_fiadd_poff(
1146 1 nb ,len ,bbufr(l),intbuf_tab(nin)%NSV,a ,
1147 2 stifn ,viscn ,ibc ,isecin ,noint ,
1148 3 ibag ,icodt ,secfcum , nstrf ,icontact,
1149 4 fcont ,inacti ,iadm ,intth , fthe ,condn ,
1150 5 h3d_data, multi_fvm,nin ,tagncont,kloadpinter ,
1151 6 loadpinter,loadp_hyd_inter,intcarea,fsav(1,nin) ,
1152 7 interfaces%PARAMETERS,nodadt_therm)
1153 l = l + nb*len
1154 ELSE
1155 CALL spmd_fiadd_poff(
1156 1 nb ,len7t ,bbufr(l),intbuf_tab(nin)%NSV,a ,
1157 2 stifn ,viscn ,ibc ,isecin ,noint ,
1158 3 ibag ,icodt ,secfcum , nstrf ,icontact,
1159 4 fcont ,inacti ,iadm ,intth , fthe ,condn ,
1160 5 h3d_data, multi_fvm,nin ,tagncont,kloadpinter ,
1161 6 loadpinter,loadp_hyd_inter,intcarea,fsav(1,nin) ,
1162 7 interfaces%PARAMETERS,nodadt_therm)
1163 l = l + nb*len7t
1164 ENDIF
1165 ELSEIF(nty==11)THEN
1166 intth = ipari(47,nin)
1167 IF(intth==0) THEN
1168 CALL spmd_fiadd11_poff(
1169 1 nb ,len11 ,bbufr(l),intbuf_tab(nin)%IRECTS,a,
1170 2 stifn ,viscn ,ibc ,isecin ,noint ,
1171 3 ibag ,icodt ,secfcum ,nstrf ,icontact,
1172 4 fcont ,intth ,fthe ,condn ,h3d_data,
1173 5 tagncont,kloadpinter,loadpinter,loadp_hyd_inter,nodadt_therm)
1174 l = l + nb*len11
1175 ELSE
1176 CALL spmd_fiadd11_poff(
1177 1 nb ,len11t ,bbufr(l),intbuf_tab(nin)%IRECTS,a,
1178 2 stifn ,viscn ,ibc ,isecin ,noint ,
1179 3 ibag ,icodt ,secfcum ,nstrf ,icontact,
1180 4 fcont ,intth ,fthe ,condn ,h3d_data,
1181 5 tagncont,kloadpinter,loadpinter,loadp_hyd_inter,nodadt_therm)
1182 l = l + nb*len11t
1183 ENDIF
1184 ELSEIF(nty==17)THEN
1185 ige = ipari(34,nin)
1186 ign = ipari(36,nin)
1187 nme =igrbric(ige)%NENTITY
1188 nmes=igrbric(ign)%NENTITY
1189C
1190 CALL spmd_fiadd17_poff(
1191 1 nb ,len17 ,bbufr(l),igrbric(ign)%ENTITY,a ,
1192 2 stifn ,fcont ,ixs ,ixs16 ,intbuf_tab(nin)%FROTS,
1193 3 h3d_data)
1194 l = l + nb*len17
1195 ELSEIF(nty==20)THEN
1196 intth = ipari(47,nin)
1197 IF(intth == 0 ) THEN
1198 CALL spmd_fiadd20_poff(
1199 1 nb ,len20 ,bbufr(l),intbuf_tab(nin)%NSV,a ,
1200 2 stifn ,viscn ,ibc ,isecin ,noint ,
1201 3 ibag ,icodt ,secfcum ,nstrf ,icontact ,
1202 4 fcont ,inacti,iadm ,intth ,intbuf_tab(nin)%DAANC6,
1203 5 bid ,intbuf_tab(nin)%NLG ,intbuf_tab(nin)%ALPHAK,h3d_data )
1204 l = l + nb*len20
1205 ELSE
1206 CALL spmd_fiadd20_poff(
1207 1 nb ,len20t,bbufr(l),intbuf_tab(nin)%NSV,a ,
1208 2 stifn ,viscn ,ibc ,isecin ,noint ,
1209 3 ibag ,icodt ,secfcum ,nstrf ,icontact ,
1210 4 fcont ,inacti,iadm ,intth ,intbuf_tab(nin)%DAANC6,
1211 5 fthe ,intbuf_tab(nin)%NLG ,intbuf_tab(nin)%ALPHAK,h3d_data)
1212 l = l + nb*len20t
1213 ENDIF
1214 END IF
1215 END IF
1216C
1217C Partie supplementaire type 20 edge
1218C
1219 IF(nty==20)THEN
1220 IF(nsnsie(nin)%P(p)>0)THEN
1221 nb = nint(bbufr(l))
1222 l = l + 1
1223 ibc =ipari(11,nin)
1224 noint =ipari(15,nin)
1225 inacti=ipari(22,nin)
1226 isecin=ipari(28,nin)
1227 ibag =ipari(32,nin)
1228 iadm =ipari(44,nin)
1229 CALL spmd_fiadd20e_poff(
1230 1 nb ,len20e ,bbufr(l),intbuf_tab(nin)%IXLINS,a ,
1231 2 stifn ,viscn ,ibc ,isecin ,noint ,
1232 3 ibag ,icodt ,secfcum ,nstrf ,icontact ,
1233 4 fcont ,intbuf_tab(nin)%DAANC6,intbuf_tab(nin)%NLG,intbuf_tab(nin)%ALPHAK,h3d_data)
1234 l = l + nb*len20e
1235 ENDIF
1236 ENDIF
1237C
1238C Partie supplementaire type 25 edge
1239C
1240 IF(nty==25 .AND. ipari(58,nin) > 0)THEN
1241 IF(nsnsie(nin)%P(p)>0)THEN
1242 nb = nint(bbufr(l))
1243 l = l + 1
1244 ibc =ipari(11,nin)
1245 noint =ipari(15,nin)
1246 inacti=ipari(22,nin)
1247 isecin=ipari(28,nin)
1248 ibag =ipari(32,nin)
1249 iadm =ipari(44,nin)
1250 intth = ipari(47,nin)
1251 nedge =ipari(68,nin)
1252
1253 CALL spmd_fiadd25e_poff(
1254 1 nb ,len25e ,bbufr(l),intbuf_tab(nin)%NSV,a ,
1255 2 stifn ,viscn ,ibc ,isecin ,noint ,
1256 3 ibag ,icodt ,secfcum , nstrf ,icontact,
1257 4 fcont ,inacti ,iadm ,intth , fthe ,condn ,
1258 5 h3d_data, multi_fvm,intbuf_tab(nin)%LEDGE,nedge ,
1259 6 nin ,tagncont,kloadpinter,loadpinter,loadp_hyd_inter,
1260 7 nodadt_therm)
1261 l = l + nb*len25e
1262 ENDIF ! NSNSIE
1263 ENDIF ! NTY + IEDGE
1264 ENDDO ! NBINTC
1265 ENDIF !FLAG
1266 ENDDO ! NSPMD
1267
1268C Deallocation R
1269 IF(iallocr>0) THEN
1270 DEALLOCATE(bbufr)
1271 iallocr=0
1272 END IF
1273C
1274C Attente ISEND
1275C
1276 DO p = 1, nspmd
1277 IF(adds(p+1)-adds(p)>0) THEN
1278 CALL mpi_wait(req_si(p),status,ierror)
1279 ENDIF
1280 ENDDO
1281C Deallocation S
1282 IF(iallocs>0) THEN
1283 DEALLOCATE(bbufs)
1284 iallocs=0
1285 END IF
1286 END IF
1287C
1288#endif
1289 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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
message_mod
Definition message_mod.F:1249
tri25ebox::islen25e
integer islen25e
Definition tri25ebox.F:77
tri25ebox::irlen25
integer irlen25
Definition tri25ebox.F:76
tri25ebox::irlen25t
integer irlen25t
Definition tri25ebox.F:78
tri25ebox::islen25t
integer islen25t
Definition tri25ebox.F:78
tri25ebox::islen25
integer islen25
Definition tri25ebox.F:76
tri25ebox::irlen25e
integer irlen25e
Definition tri25ebox.F:77
tri7box::stnfi17
type(real_pointer2), dimension(:), allocatable stnfi17
Definition tri7box.F:467
tri7box::condnfi
type(real_pointer), dimension(:), allocatable condnfi
Definition tri7box.F:449
tri7box::afi17
type(real_pointer3), dimension(:), allocatable afi17
Definition tri7box.F:470
tri7box::frotsfi
type(real_pointer2), dimension(:), allocatable frotsfi
Definition tri7box.F:467
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::nsnsie
type(int_pointer), dimension(:), allocatable nsnsie
Definition tri7box.F:491
tri7box::alphakfi
type(real_pointer), dimension(:), allocatable alphakfi
Definition tri7box.F:449
tri7box::stnfi
type(real_pointer), dimension(:), allocatable stnfi
Definition tri7box.F:449
tri7box::afi
type(real_pointer2), dimension(:), allocatable afi
Definition tri7box.F:459
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::stnfie
type(real_pointer), dimension(:), allocatable stnfie
Definition tri7box.F:449
tri7box::nsvfi
type(int_pointer), dimension(:), allocatable nsvfi
Definition tri7box.F:431
tri7box::afie
type(real_pointer2), dimension(:), allocatable afie
Definition tri7box.F:459
tri7box::vscfi
type(real_pointer), dimension(:), allocatable vscfi
Definition tri7box.F:449
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::vscfie
type(real_pointer), dimension(:), allocatable vscfie
Definition tri7box.F:449
tri7box::alphakfie
type(real_pointer), dimension(:), allocatable alphakfie
Definition tri7box.F:449
tri7box::fthefi
type(real_pointer), dimension(:), allocatable fthefi
Definition tri7box.F:449
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
spmd_fiadd25e_poff
subroutine spmd_fiadd25e_poff(nb, len, bufr, nsv, a, stifn, viscn, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, fthe, condn, h3d_data, multi_fvm, ledge, nedge, nin, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, nodadt_therm)
Definition spmd_fiadd25e_poff.F:43
putdpdaanc
subroutine putdpdaanc(daanc6, buf, iresp, inc)
Definition spmd_i7tool.F:7399
spmd_fiadd_poff
subroutine spmd_fiadd_poff(nb, len, bufr, nsv, a, stifn, viscn, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, fthe, condn, h3d_data, multi_fvm, nin, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, intcarea, fsav, parameters, nodadt_therm)
Definition spmd_i7tool.F:484
spmd_fiadd20_poff
subroutine spmd_fiadd20_poff(nb, len, bufr, nsv, a, stifn, viscn, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, daanc6, fthe, nlg, alphak, h3d_data)
Definition spmd_i7tool.F:1209
spmd_fiadd17_poff
subroutine spmd_fiadd17_poff(nb, len, bufr, nelems, a, stifn, fcont, ixs, ixs16, frots, h3d_data)
Definition spmd_i7tool.F:986
spmd_fiadd20e_poff
subroutine spmd_fiadd20e_poff(nb, len, bufr, ixlins, a, stifn, viscn, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, daanc6, nlg, alphak, h3d_data)
Definition spmd_i7tool.F:1478
spmd_fiadd11_poff
subroutine spmd_fiadd11_poff(nb, len, bufr, irects, a, stifn, viscn, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, intth, fthe, condn, h3d_data, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, nodadt_therm)
Definition spmd_i7tool.F:683
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