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