OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s10cndf.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/.
23!||====================================================================
24!|| s10cndf1 ../engine/source/elements/solid/solide10/s10cndf.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| my_barrier ../engine/source/system/machine.F
29!|| spmd_exch_a_scnd ../engine/source/mpi/elements/spmd_exch_a_scnd.F
30!|| spmd_exch_a_scnd_pon ../engine/source/mpi/elements/spmd_exch_a_scnd_pon.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../engine/share/message_module/message_mod.F
33!||====================================================================
34 SUBROUTINE s10cndf1(ICNDS10,WEIGHT ,IAD_CNDM,FR_CNDM,FR_NBCCCND,
35 1 ADDCNCND,PROCNCND,A ,IADCND,FSKYCND,
36 2 ITAGND , NODFTSK,NODLTSK,EFTSK ,ELTSK ,
37 3 ITSK ,ITAB ,STIFN ,STIFND)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE message_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com01_c.inc"
50#include "com04_c.inc"
51#include "task_c.inc"
52#include "parit_c.inc"
53#include "spmd_c.inc"
54#include "comlock.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER ICNDS10(3,*),WEIGHT(*),IAD_CNDM(*),FR_CNDM(*),FR_NBCCCND(2,*),
59 . ADDCNCND(*),PROCNCND(*),IADCND(2,*),ITAGND(*),ITAB(*)
60 INTEGER NODFTSK,NODLTSK,EFTSK,ELTSK,ITSK
61 my_real
62 . a(3,*),fskycnd(4,*),stifn(*),stifnd(*)
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I, J, N, K,ISIZE,LCOMM,LENS,LENR,NCT,NC,N1,N2,ND,IAD1,IAD2,IK
67 my_real
68 . FX,FY,FZ ,FAC,STIF
69C======================================================================|
70C----pass1 : only N1,N2 are secnd nodes of Int2
71 isize =4
72 IF (iparit==0.AND.nspmd>1) THEN
73!$OMP SINGLE
74#include "vectorize.inc"
75 DO i=1,iad_cndm(nspmd+1)-1
76 j = fr_cndm(i)
77 a(1,j) = a(1,j) * weight(j)
78 a(2,j) = a(2,j) * weight(j)
79 a(3,j) = a(3,j) * weight(j)
80 stifn(j)=stifn(j)* weight(j)
81 END DO
82!$OMP END SINGLE
83 ENDIF
84 IF (iparit/=0.AND.itsk==0) fskycnd(1:4,1:lcncnd)=zero
85C------- change STIFND(I) :int to ele
86C IF (.FALSE.) THEN
87C#include "vectorize.inc"
88C DO I=EFTSK,ELTSK
89C ND = IABS(ICNDS10(1,I))
90C !ELM = Total (inc. STIFI) - ( Contact without FI
91C STIFND(I) = STIFN(ND) - STIFND(I)
92C END DO
93C END IF
94C------------------------
95 CALL my_barrier()
96C------------------------
97 IF (iparit == 0 ) THEN
98 ik = itsk*numnod
99#include "vectorize.inc"
100 DO i=eftsk,eltsk
101 nd = iabs(icnds10(1,i))
102 n1 = icnds10(2,i)
103 n2 = icnds10(3,i)
104 IF (itagnd(n1)==0.AND.itagnd(n2)==0) cycle
105 fac = half*weight(nd)
106 fx = fac*a(1,nd)
107 fy = fac*a(2,nd)
108 fz = fac*a(3,nd)
109 stif = max(zero,fac*(stifn(nd)-stifnd(i)))
110 IF (itagnd(n1)>0) THEN
111 n1 = n1 + ik
112 a(1,n1) = a(1,n1) + fx
113 a(2,n1) = a(2,n1) + fy
114 a(3,n1) = a(3,n1) + fz
115 stifn(n1) = stifn(n1) + stif
116 END IF
117 IF (itagnd(n2)>0) THEN
118 n2 = n2 + ik
119 a(1,n2) = a(1,n2) + fx
120 a(2,n2) = a(2,n2) + fy
121 a(3,n2) = a(3,n2) + fz
122 stifn(n2) = stifn(n2) + stif
123 END IF
124 END DO
125C------------------------
126 CALL my_barrier()
127C------------------------
128 DO k = 1,nthread-1
129 ik = k*numnod
130 DO i=nodftsk,nodltsk
131 IF (itagnd(i)>0) THEN
132 a(1,i) = a(1,i) + a(1,i+ik)
133 a(2,i) = a(2,i) + a(2,i+ik)
134 a(3,i) = a(3,i) + a(3,i+ik)
135 stifn(i) = stifn(i) + stifn(i+ik)
136 a(1,i+ik) = zero
137 a(2,i+ik) = zero
138 a(3,i+ik) = zero
139 stifn(i+ik) = zero
140 END IF
141 END DO
142 END DO
143C------------------------
144 CALL my_barrier()
145C------------------------
146 IF (nspmd>1.AND.itsk==0) THEN
147 lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
148 CALL spmd_exch_a_scnd(
149 . a ,stifn ,fr_cndm,iad_cndm,lcomm,isize)
150 END IF
151 ELSE ! P/ON
152#include "vectorize.inc"
153 DO i=eftsk,eltsk
154 nd = iabs(icnds10(1,i))
155 n1 = icnds10(2,i)
156 n2 = icnds10(3,i)
157 IF (itagnd(n1)==0.AND.itagnd(n2)==0) cycle
158 fac = half*weight(nd)
159 fx = fac*a(1,nd)
160 fy = fac*a(2,nd)
161 fz = fac*a(3,nd)
162C TOTAL - ELEMENT = contact inc. remote
163 stif = max(zero,fac*(stifn(nd)-stifnd(i)))
164 iad1 = iadcnd(1,i)
165 IF (iad1>0.AND.itagnd(n1)>0) THEN
166 fskycnd(1,iad1) = fx
167 fskycnd(2,iad1) = fy
168 fskycnd(3,iad1) = fz
169 fskycnd(4,iad1) = stif
170 END IF
171 iad2 = iadcnd(2,i)
172 IF (iad2>0.AND.itagnd(n2)>0) THEN
173 fskycnd(1,iad2) = fx
174 fskycnd(2,iad2) = fy
175 fskycnd(3,iad2) = fz
176 fskycnd(4,iad2) = stif
177 END IF
178 END DO
179C------------------------
180 CALL my_barrier()
181C------------------------
182 IF (nspmd>1.AND.itsk==0) THEN
183 lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
184 lens = fr_nbcccnd(1,nspmd+1)
185 lenr = fr_nbcccnd(2,nspmd+1)
186 CALL spmd_exch_a_scnd_pon(
187 1 fr_cndm,iad_cndm,addcncnd,procncnd,fr_nbcccnd,
188 2 isize,lenr ,lens ,fskycnd)
189 END IF
190C------------------------
191 CALL my_barrier()
192C------------------------
193C
194C Routine assemblage parith/ON
195C----------to be optimized after
196 DO n = nodftsk,nodltsk
197 IF (itagnd(n)==0) cycle
198 nct = addcncnd(n)-1
199 nc = addcncnd(n+1)-addcncnd(n)
200 DO k = nct+1, nct+nc
201 a(1,n) = a(1,n) + fskycnd(1,k)
202 a(2,n) = a(2,n) + fskycnd(2,k)
203 a(3,n) = a(3,n) + fskycnd(3,k)
204 stifn(n) = stifn(n) + fskycnd(4,k)
205 ENDDO
206 ENDDO
207 END IF
208C
209C----6---------------------------------------------------------------7---------8
210 RETURN
211 END
212!||====================================================================
213!|| s10cndf2 ../engine/source/elements/solid/solide10/s10cndf.F
214!||--- called by ------------------------------------------------------
215!|| resol ../engine/source/engine/resol.F
216!||--- calls -----------------------------------------------------
217!|| my_barrier ../engine/source/system/machine.F
218!|| spmd_exch_a_scnd ../engine/source/mpi/elements/spmd_exch_a_scnd.F
219!|| spmd_exch_a_scnd_pon ../engine/source/mpi/elements/spmd_exch_a_scnd_pon.F
220!||--- uses -----------------------------------------------------
221!|| message_mod ../engine/share/message_module/message_mod.F
222!||====================================================================
223 SUBROUTINE s10cndf2(ICNDS10,WEIGHT ,IAD_CNDM,FR_CNDM,FR_NBCCCND,
224 1 ADDCNCND,PROCNCND,A ,IADCND,FSKYCND,
225 2 ITAGND , NODFTSK,NODLTSK,EFTSK ,ELTSK ,
226 3 ITSK ,ITAB ,STIFN ,STIFND)
227C-----------------------------------------------
228C M o d u l e s
229C-----------------------------------------------
230 USE message_mod
231C-----------------------------------------------
232C I m p l i c i t T y p e s
233C-----------------------------------------------
234#include "implicit_f.inc"
235C-----------------------------------------------
236C C o m m o n B l o c k s
237C-----------------------------------------------
238#include "com01_c.inc"
239#include "com04_c.inc"
240#include "task_c.inc"
241#include "parit_c.inc"
242#include "spmd_c.inc"
243#include "comlock.inc"
244C-----------------------------------------------
245C D u m m y A r g u m e n t s
246C-----------------------------------------------
247 INTEGER ICNDS10(3,*),WEIGHT(*),IAD_CNDM(*),FR_CNDM(*),FR_NBCCCND(2,*),
248 . ADDCNCND(*),PROCNCND(*),IADCND(2,*),ITAGND(*),ITAB(*)
249 INTEGER NODFTSK,NODLTSK,EFTSK,ELTSK,ITSK
250C REAL
251 my_real
252 . A(3,*),FSKYCND(4,*), STIFN(*),STIFND(*)
253C-----------------------------------------------
254C L o c a l V a r i a b l e s
255C-----------------------------------------------
256 INTEGER I, J, N, K,ISIZE,LCOMM,LENS,LENR,NCT,NC,N1,N2,ND,IAD1,IAD2,IK
257C REAL
258 my_real
259 . fx,fy,fz ,fac,stif
260C======================================================================|
261C----pass2 : all excepting N1,N2 are secnd nodes of Int2
262 isize =4
263 IF (iparit==0.AND.nspmd>1) THEN
264!$OMP SINGLE
265#include "vectorize.inc"
266 DO i=1,iad_cndm(nspmd+1)-1
267 j = fr_cndm(i) ! noeud sommet sur la frontiere SPMD (CoNDensation Main node)
268 a(1,j) = a(1,j) * weight(j)
269 a(2,j) = a(2,j) * weight(j)
270 a(3,j) = a(3,j) * weight(j)
271 stifn(j)=stifn(j)* weight(j)
272 END DO
273!$OMP END SINGLE
274 ENDIF
275 IF (iparit/=0.AND.itsk==0) fskycnd(1:4,1:lcncnd)=zero
276C------------------------
277 CALL my_barrier()
278C------------------------
279 IF (iparit == 0 ) THEN
280 ik = itsk*numnod
281#include "vectorize.inc"
282 DO i=eftsk,eltsk ! Middle node
283 nd = iabs(icnds10(1,i))
284 n1 = icnds10(2,i)
285 n2 = icnds10(3,i)
286 fac = half*weight(nd)
287 fx = fac*a(1,nd)
288 fy = fac*a(2,nd)
289 fz = fac*a(3,nd)
290 stif = max(zero,fac*(stifn(nd)-stifnd(i)))
291 IF (itagnd(n1)==0) THEN
292 n1 = n1 + ik
293 a(1,n1) = a(1,n1) + fx
294 a(2,n1) = a(2,n1) + fy
295 a(3,n1) = a(3,n1) + fz
296 stifn(n1) = stifn(n1) + stif
297 END IF
298 IF (itagnd(n2)==0) THEN
299 n2 = n2 + ik
300 a(1,n2) = a(1,n2) + fx
301 a(2,n2) = a(2,n2) + fy
302 a(3,n2) = a(3,n2) + fz
303 stifn(n2) = stifn(n2) + stif
304 END IF
305 END DO
306C------------------------
307 CALL my_barrier()
308C------------------------
309 DO k = 1,nthread-1
310 ik = k*numnod
311 DO i=nodftsk,nodltsk
312 IF (itagnd(i)==0) THEN
313 a(1,i) = a(1,i) + a(1,i+ik)
314 a(2,i) = a(2,i) + a(2,i+ik)
315 a(3,i) = a(3,i) + a(3,i+ik)
316 stifn(i) = stifn(i) + stifn(i+ik)
317 a(1,i+ik) = zero
318 a(2,i+ik) = zero
319 a(3,i+ik) = zero
320 stifn(i+ik) = zero
321 END IF
322 END DO
323 END DO
324C------------------------
325 CALL my_barrier()
326C------------------------
327 IF (nspmd>1.AND.itsk==0) THEN
328 lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
329 CALL spmd_exch_a_scnd(
330 . a ,stifn ,fr_cndm,iad_cndm,lcomm,isize)
331 END IF
332 stifnd(eftsk:eltsk) = zero
333 ELSE
334#include "vectorize.inc"
335 DO i=eftsk,eltsk
336 nd = iabs(icnds10(1,i))
337 n1 = icnds10(2,i)
338 n2 = icnds10(3,i)
339 fac = half*weight(nd)
340 fx = fac*a(1,nd)
341 fy = fac*a(2,nd)
342 fz = fac*a(3,nd)
343 stif = max(zero,fac*(stifn(nd)-stifnd(i)))
344 iad1 = iadcnd(1,i)
345 IF (iad1>0.AND.itagnd(n1)==0) THEN
346 fskycnd(1,iad1) = fx
347 fskycnd(2,iad1) = fy
348 fskycnd(3,iad1) = fz
349 fskycnd(4,iad1) = stif
350 END IF
351 iad2 = iadcnd(2,i)
352 IF (iad2>0.AND.itagnd(n2)==0) THEN
353 fskycnd(1,iad2) = fx
354 fskycnd(2,iad2) = fy
355 fskycnd(3,iad2) = fz
356 fskycnd(4,iad2) = stif
357 END IF
358 END DO
359C------------------------
360 CALL my_barrier()
361C------------------------
362 IF (nspmd>1.AND.itsk==0) THEN
363 lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
364 lens = fr_nbcccnd(1,nspmd+1)
365 lenr = fr_nbcccnd(2,nspmd+1)
366 CALL spmd_exch_a_scnd_pon(
367 1 fr_cndm,iad_cndm,addcncnd,procncnd,fr_nbcccnd,
368 2 isize,lenr ,lens ,fskycnd)
369 END IF
370C------------------------
371 CALL my_barrier()
372C------------------------
373C Routine assemblage parith/ON
374C----------to be optimized after
375 DO n = nodftsk,nodltsk
376 IF (itagnd(n)/=0) cycle
377 nct = addcncnd(n)-1
378 nc = addcncnd(n+1)-addcncnd(n)
379 DO k = nct+1, nct+nc
380 a(1,n) = a(1,n) + fskycnd(1,k)
381 a(2,n) = a(2,n) + fskycnd(2,k)
382 a(3,n) = a(3,n) + fskycnd(3,k)
383 stifn(n) = stifn(n) + fskycnd(4,k)
384 ENDDO
385 ENDDO
386 END IF
387C
388C----6---------------------------------------------------------------7---------8
389 RETURN
390 END
391!||====================================================================
392!|| s10cnd_ini ../engine/source/elements/solid/solide10/s10cndf.F
393!||--- called by ------------------------------------------------------
394!|| resol_init ../engine/source/engine/resol_init.F
395!||====================================================================
396 SUBROUTINE s10cnd_ini(ICNDS10,ITAGND,IAD_CNDM,FR_CNDM,FR_NBCCCND,
397 1 ADDCNCND,PROCNCND,VND ,V ,ITAB ,
398 2 IAD_CNDM1,FR_CNDM1,FR_NBCCCND1)
399C-----------------------------------------------
400C I m p l i c i t T y p e s
401C-----------------------------------------------
402#include "implicit_f.inc"
403C-----------------------------------------------
404C C o m m o n B l o c k s
405C-----------------------------------------------
406#include "com01_c.inc"
407#include "com04_c.inc"
408#include "parit_c.inc"
409#include "task_c.inc"
410C-----------------------------------------------------------------
411C D u m m y A r g u m e n t s
412C-----------------------------------------------
413 INTEGER ICNDS10(3,*),IAD_CNDM(*),FR_CNDM(*),FR_NBCCCND(2,*),
414 . ADDCNCND(*),PROCNCND(*),ITAGND(*),ITAB(*),
415 . IAD_CNDM1(*),FR_CNDM1(*),FR_NBCCCND1(2,*)
416C REAL
417 my_real
418 . V(3,*),VND(3,*)
419C-----------------------------------------------
420C L o c a l V a r i a b l e s
421C-----------------------------------------------
422 INTEGER I, J, N, K, L, NOD,LOC_PROC,CC,N1,N2
423C-----------------------------------------------
424C Initialization of ITAGND,FR_NBCCI2
425C-----------------------------------------------
426 DO i = 1, ns10e
427 n1 = icnds10(2,i)
428 n2 = icnds10(3,i)
429 vnd(1,i) = half*(v(1,n1) + v(1,n2))
430 vnd(2,i) = half*(v(2,n1) + v(2,n2))
431 vnd(3,i) = half*(v(3,n1) + v(3,n2))
432 END DO
433C
434 IF (iparit/=0) THEN
435 DO i = 1, nspmd+1
436 fr_nbcccnd(1,i) = 0
437 fr_nbcccnd(2,i) = 0
438 ENDDO
439C
440 loc_proc = ispmd+1
441 DO i = 1, nspmd
442 IF(i/=loc_proc) THEN
443 DO j=iad_cndm(i),iad_cndm(i+1)-1
444 nod = fr_cndm(j)
445 DO cc = addcncnd(nod),addcncnd(nod+1)-1
446 IF(procncnd(cc)==loc_proc) THEN
447 fr_nbcccnd(1,i) = fr_nbcccnd(1,i)+1
448 ELSEIF(procncnd(cc)==i) THEN
449 fr_nbcccnd(2,i) = fr_nbcccnd(2,i)+1
450 ENDIF
451 ENDDO
452 ENDDO
453 ENDIF
454 ENDDO
455C
456 DO i = 1, nspmd
457 fr_nbcccnd(1,nspmd+1) = fr_nbcccnd(1,nspmd+1)+fr_nbcccnd(1,i)
458 fr_nbcccnd(2,nspmd+1) = fr_nbcccnd(2,nspmd+1)+fr_nbcccnd(2,i)
459 ENDDO
460 END IF !(IPARIT/=0.AND.IPARIT/=3) THEN
461C------for pass1
462 iad_cndm1(1) = 1
463 DO i = 1, nspmd
464 k = 0
465 DO j=iad_cndm(i),iad_cndm(i+1)-1
466 nod = fr_cndm(j)
467 IF (itagnd(nod)>0) THEN
468 k = k + 1
469 fr_cndm1(k+iad_cndm1(i)-1) = nod
470 END IF
471 ENDDO
472 iad_cndm1(i+1) = iad_cndm1(i) + k
473 ENDDO
474 IF (iparit/=0) THEN
475 DO i = 1, nspmd+1
476 fr_nbcccnd1(1,i) = 0
477 fr_nbcccnd1(2,i) = 0
478 ENDDO
479C
480 DO i = 1, nspmd
481 IF(i/=loc_proc) THEN
482 DO j=iad_cndm1(i),iad_cndm1(i+1)-1
483 nod = fr_cndm1(j)
484 DO cc = addcncnd(nod),addcncnd(nod+1)-1
485 IF(procncnd(cc)==loc_proc) THEN
486 fr_nbcccnd1(1,i) = fr_nbcccnd1(1,i)+1
487 ELSEIF(procncnd(cc)==i) THEN
488 fr_nbcccnd1(2,i) = fr_nbcccnd1(2,i)+1
489 ENDIF
490 ENDDO
491 ENDDO
492 ENDIF
493 ENDDO
494 DO i = 1, nspmd
495 fr_nbcccnd1(1,nspmd+1) = fr_nbcccnd1(1,nspmd+1)+fr_nbcccnd1(1,i)
496 fr_nbcccnd1(2,nspmd+1) = fr_nbcccnd1(2,nspmd+1)+fr_nbcccnd1(2,i)
497 ENDDO
498 END IF !(IPARIT/=0.AND.IPARIT/=3) THEN
499C
500 RETURN
501 END
502!||====================================================================
503!|| s10cndi2_ini ../engine/source/elements/solid/solide10/s10cndf.F
504!||--- called by ------------------------------------------------------
505!|| resol_init ../engine/source/engine/resol_init.F
506!||--- calls -----------------------------------------------------
507!|| spmd_exch_tag_scnd ../engine/source/mpi/elements/spmd_exch_tag_scnd.F
508!||--- uses -----------------------------------------------------
509!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
510!||====================================================================
511 SUBROUTINE s10cndi2_ini(IPARI,INTBUF_TAB,ICNDS10,ITAGND,WEIGHT,
512 1 FR_CNDS,IAD_CNDS,itab )
513C-----------------------------------------------
514C M o d u l e s
515C-----------------------------------------------
516 USE intbufdef_mod
517C-----------------------------------------------
518C I m p l i c i t T y p e s
519C-----------------------------------------------
520#include "implicit_f.inc"
521C-----------------------------------------------
522C C o m m o n B l o c k s
523C-----------------------------------------------
524#include "param_c.inc"
525#include "com01_c.inc"
526#include "com04_c.inc"
527C-----------------------------------------------
528C D u m m y A r g u m e n t s
529C-----------------------------------------------
530 INTEGER IPARI(NPARI,NINTER),ITAGND(*),ICNDS10(3,*),WEIGHT(*),
531 1 FR_CNDS(*),IAD_CNDS(*),itab(*)
532 TYPE(INTBUF_STRUCT_), DIMENSION(NINTER) :: INTBUF_TAB
533C-----------------------------------------------
534C L o c a l V a r i a b l e s
535C-----------------------------------------------
536 INTEGER I,J,N,NTY,NSN,NMN,IM,II,N1,N2,ND,NS,ILEV,IPEN,L,NUS,SIZ
537 INTEGER ITAGS(NUMNOD)
538C=======================================================================
539 DO i = 1, ns10e
540 n = icnds10(1,i)
541 IF (n > 0) THEN
542 itagnd(n) = i
543 ELSEIF(n < 0) THEN
544 itagnd(-n) = -i
545 END IF
546 END DO
547C -------add RBE3 after
548 itags(1:numnod) = 0
549 DO n=1,ninter
550 nty = ipari(7,n)
551 IF (nty == 2 ) THEN
552 nmn =ipari(6,n)
553 nsn = ipari(5,n)
554 ilev = ipari(20,n)
555 nus = ipari(15,n)
556 IF (ilev == 27 .or. ilev == 28) THEN
557 DO i=1,nsn
558 IF (intbuf_tab(n)%IRUPT(i) /= 1) THEN
559 ns = intbuf_tab(n)%NSV(i)
560 IF (itags(ns)==0) itags(ns)=nus
561 l = intbuf_tab(n)%IRTLM(i)
562 DO j = 1, 4
563 ii = 4*(l-1)+j
564 im = intbuf_tab(n)%IRECTM(ii)
565 IF (itagnd(im)>0) THEN
566 itagnd(im) = itagnd(im) + ns10e
567 ELSEIF(itagnd(im)<0) THEN
568 itagnd(im) = itagnd(im) - ns10e
569 END IF
570 END DO
571 END IF !(INTBUF_TAB(N)%IRUPT(I) /= 1) THEN
572 END DO
573 ELSEIF (ilev <= 5 .or. ilev == 30) THEN
574 DO i=1,nsn
575 ns = intbuf_tab(n)%NSV(i)
576 IF (itags(ns)==0) itags(ns)=nus
577 l = intbuf_tab(n)%IRTLM(i)
578 DO j = 1, 4
579 ii = 4*(l-1)+j
580 im = intbuf_tab(n)%IRECTM(ii)
581 IF (itagnd(im)>0) THEN
582 itagnd(im) = itagnd(im) + ns10e
583 ELSEIF(itagnd(im)<0) THEN
584 itagnd(im) = itagnd(im) - ns10e
585 END IF
586 END DO
587 END DO
588 END IF
589 END IF
590 END DO
591C--------comm to synchro the case iabs(ITAGND(Nd))>NS10E main of int2
592 IF (nspmd>1) THEN
593 siz = iad_cnds(nspmd+1)-iad_cnds(1)
594 CALL spmd_exch_tag_scnd(itagnd,fr_cnds,iad_cnds,siz)
595 END IF
596C--------add edge nodes at the end :Secnd of int2 ->used in pass1
597 DO i = 1, ns10e
598 n1 = icnds10(2,i)
599 n2 = icnds10(3,i)
600 itagnd(n1) = itags(n1)
601 itagnd(n2) = itags(n2)
602 END DO
603C------Change FR_CNDS(J) from Nd to id of ICNDS10 for STIFND
604 IF (nspmd>1) THEN
605 DO i = 1, ns10e
606 n = iabs(icnds10(1,i))
607 itags(n) = i
608 END DO
609 DO i=1,nspmd
610 DO j=iad_cnds(i),iad_cnds(i+1)-1
611 n = fr_cnds(j)
612 fr_cnds(j) = itags(n)
613 ENDDO
614 ENDDO
615 END IF
616C
617 RETURN
618 END
619!||====================================================================
620!|| s10cndamp ../engine/source/elements/solid/solide10/s10cndf.F
621!||--- calls -----------------------------------------------------
622!|| spmd_exch_a_scnd ../engine/source/mpi/elements/spmd_exch_a_scnd.f
623!|| spmd_exch_a_scnd_pon ../engine/source/mpi/elements/spmd_exch_a_scnd_pon.F
624!||====================================================================
625 SUBROUTINE s10cndamp(ICNDS10,MS ,A ,V ,VD ,
626 1 IADCND ,ADDCNCND,FSKYCND,WEIGHT ,IAD_CNDM,
627 2 FR_CNDM,FR_NBCCCND,PROCNCND)
628C-----------------------------------------------
629C I m p l i c i t T y p e s
630C-----------------------------------------------
631#include "implicit_f.inc"
632C-----------------------------------------------
633C C o m m o n B l o c k s
634C-----------------------------------------------
635#include "com01_c.inc"
636#include "com04_c.inc"
637#include "com06_c.inc"
638#include "comlock.inc"
639#include "parit_c.inc"
640#include "spmd_c.inc"
641C-----------------------------------------------
642C D u m m y A r g u m e n t s
643C-----------------------------------------------
644 INTEGER ICNDS10(3,*),WEIGHT(*),IAD_CNDM(*),FR_CNDM(*),
645 . FR_NBCCCND(2,*),ADDCNCND(*),PROCNCND(*),IADCND(2,*)
646C REAL
647 my_real
648 . A(3,*),V(3,*),VD(3,*),MS(*),FSKYCND(4,*)
649C-----------------------------------------------
650C L o c a l V a r i a b l e s
651C-----------------------------------------------
652 INTEGER I, J,NFTSK,NLTSK,N, K,ID1,ID2,NC,N1,N2,ND,CC,NCT,
653 . ISIZE,LCOMM,LENS,LENR
654CC REAL
655 my_real
656 . fx1,fy1,fz1 ,fx2,fy2,fz2,fac,fac1,fac2,dt05,vx,vy,vz
657 my_real
658 . tmp(numnod)
659C======================================================================|
660 IF (iparit/=0) fskycnd(1:3,1:lcncnd)=zero
661 isize = 4
662C
663 IF (iparit == 0 ) THEN
664 IF (nspmd>1) THEN
665#include "vectorize.inc"
666 DO i=1,iad_cndm(nspmd+1)-1
667 j = fr_cndm(i)
668 a(1,j) = a(1,j) * weight(j)
669 a(2,j) = a(2,j) * weight(j)
670 a(3,j) = a(3,j) * weight(j)
671 END DO
672 END IF
673 DO i=1,ns10e
674 nd = iabs(icnds10(1,i))
675 n1 = icnds10(2,i)
676 n2 = icnds10(3,i)
677 fac= dampa*ms(nd)*weight(nd)
678 fac1 = fac/ms(n1)
679 fac2 = fac/ms(n2)
680 vx = v(1,nd)-vd(1,i)
681 vy = v(2,nd)-vd(2,i)
682 vz = v(3,nd)-vd(3,i)
683 fx1 = fac1*vx
684 fy1 = fac1*vy
685 fz1 = fac1*vz
686 fx2 = fac2*vx
687 fy2 = fac2*vy
688 fz2 = fac2*vz
689 a(1,n1) = a(1,n1) - fx1
690 a(2,n1) = a(2,n1) - fy1
691 a(3,n1) = a(3,n1) - fz1
692 a(1,n2) = a(1,n2) - fx2
693 a(2,n2) = a(2,n2) - fy2
694 a(3,n2) = a(3,n2) - fz2
695 END DO
696 IF (nspmd>1) THEN
697 lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
698 tmp(1:numnod)=zero
699 CALL spmd_exch_a_scnd(
700 . a ,tmp ,fr_cndm,iad_cndm,lcomm,isize)
701 END IF
702 ELSE
703 DO i=1,ns10e
704 nd = iabs(icnds10(1,i))
705 n1 = icnds10(2,i)
706 n2 = icnds10(3,i)
707 fac= dampa*ms(nd)
708 fac1 = fac/ms(n1)
709 fac2 = fac/ms(n2)
710 vx = v(1,nd)-vd(1,i)
711 vy = v(2,nd)-vd(2,i)
712 vz = v(3,nd)-vd(3,i)
713 fx1 = fac1*vx
714 fy1 = fac1*vy
715 fz1 = fac1*vz
716 fx2 = fac2*vx
717 fy2 = fac2*vy
718 fz2 = fac2*vz
719 id1 = iadcnd(1,i)
720 IF (id1>0) THEN
721 fskycnd(1,id1) = fx1
722 fskycnd(2,id1) = fy1
723 fskycnd(3,id1) = fz1
724 fskycnd(4,id1) = zero
725 END IF
726 id2 = iadcnd(2,i)
727 IF (id2>0) THEN
728 fskycnd(1,id2) = fx2
729 fskycnd(2,id2) = fy2
730 fskycnd(3,id2) = fz2
731 fskycnd(4,id2) = zero
732 END IF
733 END DO
734 IF (nspmd>1) THEN
735 lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
736 lens = fr_nbcccnd(1,nspmd+1)
737 lenr = fr_nbcccnd(2,nspmd+1)
738 CALL spmd_exch_a_scnd_pon(
739 1 fr_cndm,iad_cndm,addcncnd,procncnd,fr_nbcccnd,
740 2 isize,lenr ,lens ,fskycnd)
741 END IF
742C
743C Routine assemblage parith/ON
744C
745 DO n = 1, numnod
746 nct = addcncnd(n)-1
747 nc = addcncnd(n+1)-addcncnd(n)
748 DO k = nct+1, nct+nc
749 a(1,n) = a(1,n) - fskycnd(1,k)
750 a(2,n) = a(2,n) - fskycnd(2,k)
751 a(3,n) = a(3,n) - fskycnd(3,k)
752 ENDDO
753 ENDDO
754 END IF
755C----6---------------------------------------------------------------7---------8
756 RETURN
757 END
758!||====================================================================
759!|| s10cndfnd ../engine/source/elements/solid/solide10/s10cndf.F
760!||--- called by ------------------------------------------------------
761!|| resol ../engine/source/engine/resol.F
762!||--- calls -----------------------------------------------------
763!|| my_barrier ../engine/source/system/machine.F
764!||====================================================================
765 SUBROUTINE s10cndfnd(ICNDS10,WEIGHT ,IAD_CNDS,FR_CNDS,ITAB ,
766 2 NODFTSK,NODLTSK,EFTSK ,ELTSK ,ITSK ,
767 3 STIFN ,STIFND)
768C-----------------------------------------------
769C I m p l i c i t T y p e s
770C-----------------------------------------------
771#include "implicit_f.inc"
772C-----------------------------------------------
773C C o m m o n B l o c k s
774C-----------------------------------------------
775#include "com04_c.inc"
776#include "task_c.inc"
777#include "comlock.inc"
778C-----------------------------------------------
779C D u m m y A r g u m e n t s
780C-----------------------------------------------
781 INTEGER ICNDS10(3,*),WEIGHT(*),IAD_CNDS(*),FR_CNDS(*),ITAB(*)
782 INTEGER NODFTSK,NODLTSK,EFTSK,ELTSK,ITSK
783C REAL
784 my_real
785 . STIFN(*),STIFND(*)
786C-----------------------------------------------
787C L o c a l V a r i a b l e s
788C-----------------------------------------------
789 INTEGER I, J, N, K,LCOMM,IK,ND
790C REAL
791C======================================================================|
792C-----get STIFND from interface part
793C STIFN of contact (element not done yet)
794 ik = 0
795 DO k = 1,nthread
796 DO i = eftsk,eltsk
797 nd = iabs(icnds10(1,i))
798 stifnd(i) = stifnd(i)+ stifn(nd+ik)
799 END DO
800 ik = ik + numnod
801 END DO
802C------------------------
803 CALL my_barrier()
804C------------------------
805c IF (NSPMD>1.AND.ITSK==0) THEN
806c LCOMM =IAD_CNDS(NSPMD+1)-IAD_CNDS(1)
807c CALL SPMD_EXCH_STIF_SCND(
808c . STIFND ,FR_CNDS,IAD_CNDS,LCOMM)
809c END IF
810C----6---------------------------------------------------------------7---------8
811 RETURN
812 END
813!||====================================================================
814!|| s10cnds_dim ../engine/source/elements/solid/solide10/s10cndf.F
815!||--- called by ------------------------------------------------------
816!|| resol_init ../engine/source/engine/resol_init.F
817!||====================================================================
818 SUBROUTINE s10cnds_dim(ICNDS10,ITAGS,FR_ELEM,IAD_ELEM,NBDDS )
819C-----------------------------------------------
820C M o d u l e s
821C-----------------------------------------------
822C-----------------------------------------------
823C I m p l i c i t T y p e s
824C-----------------------------------------------
825#include "implicit_f.inc"
826C-----------------------------------------------
827C C o m m o n B l o c k s
828C-----------------------------------------------
829#include "com01_c.inc"
830#include "com04_c.inc"
831C-----------------------------------------------
832C D u m m y A r g u m e n t s
833C-----------------------------------------------
834 INTEGER ICNDS10(3,*),FR_ELEM(*),IAD_ELEM(2,*),NBDDS,ITAGS(*)
835C-----------------------------------------------
836C L o c a l V a r i a b l e s
837C-----------------------------------------------
838 INTEGER I,J,N,IP
839C=======================================================================
840 DO I = 1, ns10e
841 n = iabs(icnds10(1,i))
842 itags(n) = i
843 END DO
844C--------
845 nbdds = 0
846 DO ip = 1,nspmd
847 DO j= iad_elem(1,ip),iad_elem(1,ip+1)-1
848 n = fr_elem(j)
849 IF (itags(n)>0) nbdds = nbdds + 1
850 END DO
851 END DO
852C
853 RETURN
854 END
855!||====================================================================
856!|| s10cnds_ini ../engine/source/elements/solid/solide10/s10cndf.F
857!||--- called by ------------------------------------------------------
858!|| resol_init ../engine/source/engine/resol_init.F
859!||====================================================================
860 SUBROUTINE s10cnds_ini(ICNDS10,ITAGS,FR_ELEM,IAD_ELEM,IAD_CDNS,FR_CDNS)
861C-----------------------------------------------
862C M o d u l e s
863C-----------------------------------------------
864C-----------------------------------------------
865C I m p l i c i t T y p e s
866C-----------------------------------------------
867#include "implicit_f.inc"
868C-----------------------------------------------
869C C o m m o n B l o c k s
870C-----------------------------------------------
871#include "com01_c.inc"
872#include "com04_c.inc"
873C-----------------------------------------------
874C D u m m y A r g u m e n t s
875C-----------------------------------------------
876 INTEGER ICNDS10(3,*),FR_ELEM(*),IAD_ELEM(2,*),IAD_CDNS(*),FR_CDNS(*),
877 . ITAGS(*)
878C-----------------------------------------------
879C L o c a l V a r i a b l e s
880C-----------------------------------------------
881 INTEGER I,J,N,IP,NB,nd
882C=======================================================================
883 NB = 1
884 do ip = 1,nspmd
885 iad_cdns(ip) =nb
886 DO j= iad_elem(1,ip),iad_elem(1,ip+1)-1
887 n = fr_elem(j)
888 IF (itags(n)>0) THEN
889C------ will be changed to ITAGS(N) in S10CNDI2_INI
890 fr_cdns(nb) = n
891c FR_CDNS(NB) = ITAGS(N)
892 nb = nb + 1
893 END IF
894 END DO
895 iad_cdns(ip+1) = nb
896 END DO
897 itags(1:numnod) = 0
898C
899 RETURN
900 END
901!||====================================================================
902!|| s10print ../engine/source/elements/solid/solide10/s10cndf.F
903!||====================================================================
904 SUBROUTINE s10print(ICNDS10,A ,V, ITAB )
905C-----------------------------------------------
906C I m p l i c i t T y p e s
907C-----------------------------------------------
908#include "implicit_f.inc"
909C-----------------------------------------------
910C C o m m o n B l o c k s
911C-----------------------------------------------
912#include "com04_c.inc"
913#include "units_c.inc"
914C-----------------------------------------------
915C D u m m y A r g u m e n t s
916C-----------------------------------------------
917 INTEGER ICNDS10(3,*),itab(*)
918C REAL
919 my_real
920 . A(3,*),V(3,*)
921C-----------------------------------------------
922C L o c a l V a r i a b l e s
923C-----------------------------------------------
924 INTEGER I, J,NFTSK,NLTSK,N, K,ID1,ID2,NC,N1,N2,ND,CC,NCT
925C REAL
926 DO I=1,ns10e
927 n1 = icnds10(2,i)
928 n2 = icnds10(3,i)
929 if (itab(n1)==1294333.and.itab(n2)==1338494) then
930 nd = iabs(icnds10(1,i))
931 write(iout,*)'ND,N1,N2, A,V=',itab(nd),itab(n1),itab(n2)
932 write(iout,*)a(1,nd),a(2,nd),a(3,nd)
933 write(iout,*)v(1,nd),v(2,nd),v(3,nd)
934 end if
935 END DO
936C----6---------------------------------------------------------------7---------8
937 RETURN
938 END
939!||====================================================================
940!|| cndmasi2_dim ../engine/source/elements/solid/solide10/s10cndf.F
941!||--- called by ------------------------------------------------------
942!|| resol_init ../engine/source/engine/resol_init.F
943!||--- calls -----------------------------------------------------
944!|| spmd_exch_tag_scnd ../engine/source/mpi/elements/spmd_exch_tag_scnd.F
945!||--- uses -----------------------------------------------------
946!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
947!||====================================================================
948 SUBROUTINE cndmasi2_dim(IPARI,INTBUF_TAB,ICNDS10,ITAGND,WEIGHT,NKEND,
949 1 IAD_CNDS,FR_CNDS,S_FR ,NSPMD)
950C-----------------------------------------------
951C M o d u l e s
952C-----------------------------------------------
953 USE intbufdef_mod
954C-----------------------------------------------
955C I m p l i c i t T y p e s
956C-----------------------------------------------
957#include "implicit_f.inc"
958C-----------------------------------------------
959C C o m m o n B l o c k s
960C-----------------------------------------------
961#include "param_c.inc"
962#include "com04_c.inc"
963C-----------------------------------------------
964C D u m m y A r g u m e n t s
965C-----------------------------------------------
966 INTEGER NSPMD,S_FR
967 INTEGER, INTENT(IN),DIMENSION(NSPMD+1) :: IAD_CNDS
968 INTEGER, INTENT(IN),DIMENSION(S_FR) :: FR_CNDS
969 INTEGER IPARI(NPARI,NINTER),ITAGND(*),ICNDS10(3,*),WEIGHT(*),
970 1 NKEND
971 TYPE(INTBUF_STRUCT_), DIMENSION(NINTER) :: INTBUF_TAB
972C-----------------------------------------------
973C L o c a l V a r i a b l e s
974C-----------------------------------------------
975 INTEGER I,J,N,NTY,NSN,NMN,IM,II,N1,N2,ND,NS,ILEV,IPEN,L,NUS,SIZ
976C=======================================================================
977 DO I = 1, ns10e
978 n = icnds10(1,i)
979 IF (n > 0) THEN
980 itagnd(n) = i
981 ELSEIF(n < 0) THEN
982 itagnd(-n) = -i
983 END IF
984 END DO
985! ----tag first the middle nodes which are on the main side of int2 (added mass compute)
986 DO n=1,ninter
987 nty = ipari(7,n)
988 IF (nty == 2 ) THEN
989 nmn =ipari(6,n)
990 nsn = ipari(5,n)
991 ilev = ipari(20,n)
992 IF (ilev == 27 .or. ilev == 28) THEN
993 DO i=1,nsn
994 IF (intbuf_tab(n)%IRUPT(i) /= 1) THEN
995 ns = intbuf_tab(n)%NSV(i)
996 l = intbuf_tab(n)%IRTLM(i)
997 DO j = 1, 4
998 ii = 4*(l-1)+j
999 im = intbuf_tab(n)%IRECTM(ii)
1000 IF (itagnd(im)>0.AND.itagnd(im)<= ns10e) THEN
1001 itagnd(im) = itagnd(im) + ns10e
1002 ELSEIF(itagnd(im)<0.AND.itagnd(im)>= -ns10e) THEN
1003 itagnd(im) = itagnd(im) - ns10e
1004 END IF
1005 END DO
1006 END IF !(INTBUF_TAB(N)%IRUPT(I) /= 1) THEN
1007 END DO
1008 ELSEIF (ilev <= 5 .or. ilev == 30) THEN
1009 DO i=1,nsn
1010 ns = intbuf_tab(n)%NSV(i)
1011 l = intbuf_tab(n)%IRTLM(i)
1012 DO j = 1, 4
1013 ii = 4*(l-1)+j
1014 im = intbuf_tab(n)%IRECTM(ii)
1015 IF (itagnd(im)>0.AND.itagnd(im)<= ns10e) THEN
1016 itagnd(im) = itagnd(im) + ns10e
1017 ELSEIF(itagnd(im)<0.AND.itagnd(im)>= -ns10e) THEN
1018 itagnd(im) = itagnd(im) - ns10e
1019 END IF
1020 END DO
1021 END DO
1022 END IF
1023 END IF
1024 END DO
1025!--------comm to synchro the case iabs(ITAGND(Nd))>NS10E main of int2
1026 IF (nspmd>1) THEN
1027 siz = iad_cnds(nspmd+1)-iad_cnds(1)
1028 CALL spmd_exch_tag_scnd(itagnd,fr_cnds,iad_cnds,siz)
1029 END IF
1030! ----change setting of IMAP2ND by adding a comm to avoid missing the case due to weight=0
1031 nkend = 0
1032 DO i = 1, ns10e
1033 n = iabs(icnds10(1,i))
1034 ii = iabs(itagnd(n))
1035 IF (ii >ns10e .AND. weight(n)/=0) nkend = nkend + 1
1036 END DO
1037C
1038 RETURN
1039 END
1040!||====================================================================
1041!|| cndmasi2_ini ../engine/source/elements/solid/solide10/s10cndf.f
1042!||--- called by ------------------------------------------------------
1043!|| resol_init ../engine/source/engine/resol_init.F
1044!||--- uses -----------------------------------------------------
1045!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1046!||====================================================================
1047 SUBROUTINE cndmasi2_ini(IPARI,INTBUF_TAB,ICNDS10,ITAGND,
1048 . NKEND,IMAP2ND,MASI2ND0,MS ,WEIGHT,itab )
1049C-----------------------------------------------
1050C M o d u l e s
1051C-----------------------------------------------
1052 USE intbufdef_mod
1053C-----------------------------------------------
1054C I m p l i c i t T y p e s
1055C-----------------------------------------------
1056#include "implicit_f.inc"
1057C-----------------------------------------------
1058C C o m m o n B l o c k s
1059C-----------------------------------------------
1060#include "param_c.inc"
1061#include "com04_c.inc"
1062C-----------------------------------------------
1063C D u m m y A r g u m e n t s
1064C-----------------------------------------------
1065 INTEGER IPARI(NPARI,NINTER),ITAGND(*),ICNDS10(3,*),
1066 1 NKEND,IMAP2ND(*),WEIGHT(*),itab(*)
1067 TYPE(intbuf_struct_), DIMENSION(NINTER) :: INTBUF_TAB
1068 my_real
1069 . MASI2ND0(*),MS(*)
1070C-----------------------------------------------
1071C L o c a l V a r i a b l e s
1072C-----------------------------------------------
1073 INTEGER I,J,N,NTY,NSN,NMN,IM,II,N1,N2,ND,NS,ILEV,IPEN,L,NK,SIZ
1074C=======================================================================
1075C -------only cinematic--> mass condensation
1076C-----MASI2ND0 will be modified (as added mass) after DTNODA
1077 NK = 0
1078 do i = 1, ns10e
1079 n = iabs(icnds10(1,i))
1080 ii = iabs(itagnd(n))
1081 IF (ii >ns10e .AND. weight(n)/=0) THEN
1082 nk = nk + 1
1083 imap2nd(nk) = i
1084 masi2nd0(nk) = ms(n)
1085 END IF
1086 END DO
1087!
1088 RETURN
1089 END
1090!||====================================================================
1091!|| cnd_dmasi2 ../engine/source/elements/solid/solide10/s10cndf.F
1092!||--- called by ------------------------------------------------------
1093!|| resol ../engine/source/engine/resol.f
1094!||====================================================================
1095 SUBROUTINE cnd_dmasi2(ICNDS10,NKEND,IMAP2ND,MASI2ND0,MS ,WEIGHT)
1096C-----------------------------------------------
1097C I m p l i c i t T y p e s
1098C-----------------------------------------------
1099#include "implicit_f.inc"
1100C-----------------------------------------------
1101C C o m m o n B l o c k s
1102C-----------------------------------------------
1103#include "com04_c.inc"
1104#include "com08_c.inc"
1105#include "itet2_c.inc"
1106#include "scr07_c.inc"
1107#include "com01_c.inc"
1108C-----------------------------------------------
1109C D u m m y A r g u m e n t s
1110C-----------------------------------------------
1111 INTEGER ICNDS10(3,*),NKEND,IMAP2ND(*),WEIGHT(*)
1112 my_real
1113 . MASI2ND0(*),MS(*)
1114C-----------------------------------------------
1115C L o c a l V a r i a b l e s
1116C-----------------------------------------------
1117 INTEGER I,J,N,NS
1118 my_real
1119 . DMAS,DMAS2,MASND
1120C=======================================================================
1121C---- for /CHKPT and restart : just affect output in ecrit
1122 IF (MCHECK>0.OR.IRUN>1) THEN
1123C---- can't do it precisely unless to store MASI2ND0
1124 IF (NKEND<0.OR.IRUN>1) THEN
1125 DMAS2 = msi20
1126 nkend =iabs(nkend)
1127 masi2nd0(1:nkend)=dmas2/nkend
1128 END IF
1129 IF (imassi /= 0) THEN
1130 ms_nd =zero
1131 DO i = 1, ns10e
1132 ns = iabs(icnds10(1,i))
1133 IF (weight(ns)/=0) ms_nd = ms_nd + ms(ns)
1134 ENDDO
1135 END IF
1136 ELSE
1137 dmas2 = zero
1138 DO i = 1, nkend
1139 n = imap2nd(i)
1140 ns = iabs(icnds10(1,n))
1141 dmas=ms(ns)-masi2nd0(i)
1142 masi2nd0(i) = max(zero,dmas)
1143 dmas2 = dmas2 + masi2nd0(i)
1144 ENDDO
1145C
1146 masnd = zero
1147 DO i = 1, ns10e
1148 ns = iabs(icnds10(1,i))
1149 IF (weight(ns)/=0) masnd = masnd + ms(ns)
1150 ENDDO
1151C---due to the part w/ weight(ns)=0; DMSI2 in itet2_c.inc for restart
1152 IF (tt==zero) THEN
1153 dmsi2 = masnd-ms_nd-dmas2
1154 dmsi2 = max(zero,dmsi2)
1155 msi20 = dmas2
1156 END IF
1157 END IF !(MCHECK>0.AND.NKEND>0) THEN
1158C
1159 RETURN
1160 END
1161!||====================================================================
1162!|| cndmasi2 ../engine/source/elements/solid/solide10/s10cndf.F
1163!||--- called by ------------------------------------------------------
1164!|| sortie_main ../engine/source/output/sortie_main.F
1165!||====================================================================
1166 SUBROUTINE cndmasi2(ICNDS10,NKEND,IMAP2ND,MASI2ND0,MS ,V ,A ,
1167 . WEIGHT ,MAS_ND ,KEND)
1168C-----------------------------------------------
1169C I m p l i c i t T y p e s
1170C-----------------------------------------------
1171#include "implicit_f.inc"
1172C-----------------------------------------------
1173C C o m m o n B l o c k s
1174C-----------------------------------------------
1175#include "com04_c.inc"
1176#include "com08_c.inc"
1177#include "itet2_c.inc"
1178C-----------------------------------------------
1179C D u m m y A r g u m e n t s
1180C-----------------------------------------------
1181 INTEGER ICNDS10(3,*),NKEND,IMAP2ND(*),WEIGHT(*)
1182 my_real
1183 . masi2nd0(*),ms(*),v(3,*),a(3,*),kend,mas_nd
1184C-----------------------------------------------
1185C L o c a l V a r i a b l e s
1186C-----------------------------------------------
1187 INTEGER I,J,N,NS
1188 my_real
1189 . DMAS,VX,VY,VZ,DT05
1190C=======================================================================
1191 KEND = zero
1192 dt05 = half*dt1
1193 dmas = zero
1194 DO i = 1, nkend
1195 n = imap2nd(i)
1196 ns = iabs(icnds10(1,n))
1197c DMAS=MS(NS)-MASI2ND0(I)
1198 vx = v(1,ns) + dt05*a(1,ns)
1199 vy = v(2,ns) + dt05*a(2,ns)
1200 vz = v(3,ns) + dt05*a(3,ns)
1201 kend = kend + ( vx*vx + vy*vy + vz*vz)*half*masi2nd0(i)
1202 dmas = dmas + masi2nd0(i)
1203 ENDDO
1204 dmas = dmas + dmsi2
1205C
1206 mas_nd = zero
1207 DO i = 1, ns10e
1208 ns = iabs(icnds10(1,i))
1209 IF (weight(ns)/=0) mas_nd = mas_nd + ms(ns)
1210 ENDDO
1211 mas_nd = mas_nd - dmas
1212C
1213 RETURN
1214 END
1215!||====================================================================
1216!|| s10cnidamp ../engine/source/elements/solid/solide10/s10cndf.F
1217!||--- calls -----------------------------------------------------
1218!|| spmd_exch_a_scnd ../engine/source/mpi/elements/spmd_exch_a_scnd.F
1219!|| spmd_exch_a_scnd_pon ../engine/source/mpi/elements/spmd_exch_a_scnd_pon.F
1220!||--- uses -----------------------------------------------------
1221!|| groupdef_mod ../common_source/modules/groupdef_mod.F
1222!||====================================================================
1223 SUBROUTINE s10cnidamp(ICNDS10,MS ,A ,V ,VD ,
1224 1 IADCND ,ADDCNCND,FSKYCND,SKEW ,DAMPR ,
1225 3 DAMP ,IGRNOD ,DIM ,WEIGHT ,IAD_CNDM,
1226 4 FR_CNDM,FR_NBCCCND,PROCNCND)
1227C-----------------------------------------------
1228C M o d u l e s
1229C-----------------------------------------------
1230 USE groupdef_mod
1231C-----------------------------------------------
1232C I m p l i c i t T y p e s
1233C-----------------------------------------------
1234#include "implicit_f.inc"
1235C-----------------------------------------------
1236C C o m m o n B l o c k s
1237C-----------------------------------------------
1238#include "com01_c.inc"
1239#include "com04_c.inc"
1240#include "com08_c.inc"
1241#include "comlock.inc"
1242#include "parit_c.inc"
1243#include "spmd_c.inc"
1244#include "param_c.inc"
1245C-----------------------------------------------
1246C D u m m y A r g u m e n t s
1247C-----------------------------------------------
1248 INTEGER ICNDS10(3,*),WEIGHT(*),IAD_CNDM(*),FR_CNDM(*),DIM,
1249 . fr_nbcccnd(2,*),addcncnd(*),procncnd(*),iadcnd(2,*)
1250C REAL
1251 my_real
1252 . a(3,*),v(3,*),vd(3,*),ms(*),fskycnd(4,*),
1253 . dampr(nrdamp,*), damp(dim,*), skew(lskew,*)
1254C-----------------------------------------------
1255 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
1256C-----------------------------------------------
1257C L o c a l V a r i a b l e s
1258C-----------------------------------------------
1259 INTEGER I, J,NMD,NLTSK,N, K,ID1,ID2,NC,N1,N2,ND,CC,NCT,ISK,IGR
1260 INTEGER ITAGS(NUMNOD),ISIZE,LCOMM,LENS,LENR
1261C REAL
1262 my_real
1263 . FACTB,DAMPT,D_TSTART,D_TSTOP,DAMP_A(3),VSKW(3),DA_G(3),
1264 . FX1,FY1,FZ1 ,FX2,FY2,FZ2,FAC,FAC1,FAC2,VX,VY,VZ
1265 my_real
1266 . TMP(NUMNOD)
1267C======================================================================|
1268C=======================================================================
1269 itags(1:numnod) = 0
1270 DO i = 1, ns10e
1271 n = icnds10(1,i)
1272 IF (n > 0) THEN
1273 itags(n) = i
1274 END IF
1275 END DO
1276 isize = 4
1277 IF (iparit == 0 ) THEN
1278 IF (nspmd>1) THEN
1279#include "vectorize.inc"
1280 DO i=1,iad_cndm(nspmd+1)-1
1281 j = fr_cndm(i)
1282 a(1,j) = a(1,j) * weight(j)
1283 a(2,j) = a(2,j) * weight(j)
1284 a(3,j) = a(3,j) * weight(j)
1285 END DO
1286 END IF
1287 DO nd=1,ndamp
1288 igr = nint(dampr(2,nd))
1289 isk = nint(dampr(15,nd))
1290 factb = dampr(16,nd)
1291 dampt = min(dt1,dt2)*factb
1292 d_tstart = dampr(17,nd)
1293 d_tstop = dampr(18,nd)
1294 IF (tt>=d_tstart .AND. tt<=d_tstop) THEN
1295C----- Damping sur dof rotation et seulement -----
1296 IF (dampr(19,nd)>0) cycle
1297C-------------------------------------------------
1298 damp_a(1) = dampr(3,nd)
1299 damp_a(2) = dampr(5,nd)
1300 damp_a(3) = dampr(7,nd)
1301 IF(isk<=1)THEN
1302#include "vectorize.inc"
1303 DO n=1,igrnod(igr)%NENTITY
1304 i=igrnod(igr)%ENTITY(n)
1305 IF (itags(i)==0) cycle
1306 j = itags(i)
1307 nmd = iabs(icnds10(1,j))
1308 n1 = icnds10(2,j)
1309 n2 = icnds10(3,j)
1310 fac= ms(nmd)*weight(nmd)
1311 IF (ms(n1)<=em20) THEN
1312 fac1 = zero
1313 ELSE
1314 fac1 = fac/ms(n1)
1315 END IF
1316 IF (ms(n2)<=em20) THEN
1317 fac2 = zero
1318 ELSE
1319 fac2 = fac/ms(n2)
1320 END IF
1321 vx = v(1,nmd)-vd(1,j)
1322 vy = v(2,nmd)-vd(2,j)
1323 vz = v(3,nmd)-vd(3,j)
1324 fx1 = fac1*damp_a(1)*vx
1325 fy1 = fac1*damp_a(2)*vy
1326 fz1 = fac1*damp_a(3)*vz
1327 fx2 = fac2*damp_a(1)*vx
1328 fy2 = fac2*damp_a(2)*vy
1329 fz2 = fac2*damp_a(3)*vz
1330 a(1,n1) = a(1,n1) - fx1
1331 a(2,n1) = a(2,n1) - fy1
1332 a(3,n1) = a(3,n1) - fz1
1333 a(1,n2) = a(1,n2) - fx2
1334 a(2,n2) = a(2,n2) - fy2
1335 a(3,n2) = a(3,n2) - fz2
1336 ENDDO
1337 ELSE
1338C-------------------------------------------------
1339#include "vectorize.inc"
1340 DO n=1,igrnod(igr)%NENTITY
1341 i=igrnod(igr)%ENTITY(n)
1342 IF (itags(i)==0) cycle
1343 j = itags(i)
1344 nmd = iabs(icnds10(1,j))
1345 n1 = icnds10(2,j)
1346 n2 = icnds10(3,j)
1347 fac= ms(nmd)
1348 IF (ms(n1)<=em20) THEN
1349 fac1 = zero
1350 ELSE
1351 fac1 = fac/ms(n1)
1352 END IF
1353 IF (ms(n2)<=em20) THEN
1354 fac2 = zero
1355 ELSE
1356 fac2 = fac/ms(n2)
1357 END IF
1358 vx = v(1,nmd)-vd(1,j)
1359 vy = v(2,nmd)-vd(2,j)
1360 vz = v(3,nmd)-vd(3,j)
1361 vskw(1)=damp_a(1)*(skew(1,isk)*vx
1362 . +skew(2,isk)*vy
1363 . +skew(3,isk)*vz)
1364 vskw(2)=damp_a(2)*(skew(4,isk)*vx
1365 . +skew(5,isk)*vy
1366 . +skew(6,isk)*vz)
1367 vskw(3)=damp_a(3)*(skew(7,isk)*vx
1368 . +skew(8,isk)*vy
1369 . +skew(9,isk)*vz)
1370 da_g(1)= skew(1,isk)*vskw(1)
1371 . +skew(4,isk)*vskw(2)
1372 . +skew(7,isk)*vskw(3)
1373 da_g(2)= skew(2,isk)*vskw(1)
1374 . +skew(5,isk)*vskw(2)
1375 . +skew(8,isk)*vskw(3)
1376 da_g(3)= skew(3,isk)*vskw(1)
1377 . +skew(6,isk)*vskw(2)
1378 . +skew(9,isk)*vskw(3)
1379 fx1 = fac1*da_g(1)
1380 fy1 = fac1*da_g(2)
1381 fz1 = fac1*da_g(3)
1382 fx2 = fac2*da_g(1)
1383 fy2 = fac2*da_g(2)
1384 fz2 = fac2*da_g(3)
1385 a(1,n1) = a(1,n1) - fx1
1386 a(2,n1) = a(2,n1) - fy1
1387 a(3,n1) = a(3,n1) - fz1
1388 a(1,n2) = a(1,n2) - fx2
1389 a(2,n2) = a(2,n2) - fy2
1390 a(3,n2) = a(3,n2) - fz2
1391 END DO
1392 END IF
1393 ENDIF
1394 ENDDO ! ND=1,NDAMP
1395C
1396 IF (nspmd>1) THEN
1397 lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
1398 tmp(1:numnod)=zero
1399 CALL spmd_exch_a_scnd(
1400 . a ,tmp ,fr_cndm,iad_cndm,lcomm,isize)
1401 END IF
1402 ELSE
1403C-------P/ON
1404 fskycnd(1:3,1:lcncnd)=zero
1405 DO nd=1,ndamp
1406 igr = nint(dampr(2,nd))
1407 isk = nint(dampr(15,nd))
1408 factb = dampr(16,nd)
1409 dampt = min(dt1,dt2)*factb
1410 d_tstart = dampr(17,nd)
1411 d_tstop = dampr(18,nd)
1412 IF (tt>=d_tstart .AND. tt<=d_tstop) THEN
1413C----- Damping sur dof rotation et seulement -----
1414 IF (dampr(19,nd)>0) cycle
1415C-------------------------------------------------
1416 damp_a(1) = dampr(3,nd)
1417 damp_a(2) = dampr(5,nd)
1418 damp_a(3) = dampr(7,nd)
1419 IF(isk<=1)THEN
1420#include "vectorize.inc"
1421 DO n=1,igrnod(igr)%NENTITY
1422 i=igrnod(igr)%ENTITY(n)
1423 IF (itags(i)==0) cycle
1424 j = itags(i)
1425 nmd = iabs(icnds10(1,j))
1426 n1 = icnds10(2,j)
1427 n2 = icnds10(3,j)
1428 fac= ms(nmd)
1429 IF (ms(n1)<=em20) THEN
1430 fac1 = zero
1431 ELSE
1432 fac1 = fac/ms(n1)
1433 END IF
1434 IF (ms(n2)<=em20) THEN
1435 fac2 = zero
1436 ELSE
1437 fac2 = fac/ms(n2)
1438 END IF
1439 vx = v(1,nmd)-vd(1,j)
1440 vy = v(2,nmd)-vd(2,j)
1441 vz = v(3,nmd)-vd(3,j)
1442 fx1 = fac1*damp_a(1)*vx
1443 fy1 = fac1*damp_a(2)*vy
1444 fz1 = fac1*damp_a(3)*vz
1445 fx2 = fac2*damp_a(1)*vx
1446 fy2 = fac2*damp_a(2)*vy
1447 fz2 = fac2*damp_a(3)*vz
1448 id1 = iadcnd(1,j)
1449 IF (id1>0) THEN
1450 fskycnd(1,id1) = fx1
1451 fskycnd(2,id1) = fy1
1452 fskycnd(3,id1) = fz1
1453 END IF
1454 id2 = iadcnd(2,j)
1455 IF (id2>0) THEN
1456 fskycnd(1,id2) = fx2
1457 fskycnd(2,id2) = fy2
1458 fskycnd(3,id2) = fz2
1459 END IF
1460 ENDDO
1461 ELSE
1462C-------------------------------------------------
1463#include "vectorize.inc"
1464 DO n=1,igrnod(igr)%NENTITY
1465 i=igrnod(igr)%ENTITY(n)
1466 IF (itags(i)==0) cycle
1467 j = itags(i)
1468 nmd = iabs(icnds10(1,j))
1469 n1 = icnds10(2,j)
1470 n2 = icnds10(3,j)
1471 fac= ms(nmd)
1472 IF (ms(n1)<=em20) THEN
1473 fac1 = zero
1474 ELSE
1475 fac1 = fac/ms(n1)
1476 END IF
1477 IF (ms(n2)<=em20) THEN
1478 fac2 = zero
1479 ELSE
1480 fac2 = fac/ms(n2)
1481 END IF
1482 vx = v(1,nmd)-vd(1,j)
1483 vy = v(2,nmd)-vd(2,j)
1484 vz = v(3,nmd)-vd(3,j)
1485 vskw(1)=damp_a(1)*(skew(1,isk)*vx
1486 . +skew(2,isk)*vy
1487 . +skew(3,isk)*vz)
1488 vskw(2)=damp_a(2)*(skew(4,isk)*vx
1489 . +skew(5,isk)*vy
1490 . +skew(6,isk)*vz)
1491 vskw(3)=damp_a(3)*(skew(7,isk)*vx
1492 . +skew(8,isk)*vy
1493 . +skew(9,isk)*vz)
1494 da_g(1)= skew(1,isk)*vskw(1)
1495 . +skew(4,isk)*vskw(2)
1496 . +skew(7,isk)*vskw(3)
1497 da_g(2)= skew(2,isk)*vskw(1)
1498 . +skew(5,isk)*vskw(2)
1499 . +skew(8,isk)*vskw(3)
1500 da_g(3)= skew(3,isk)*vskw(1)
1501 . +skew(6,isk)*vskw(2)
1502 . +skew(9,isk)*vskw(3)
1503 fx1 = fac1*da_g(1)
1504 fy1 = fac1*da_g(2)
1505 fz1 = fac1*da_g(3)
1506 fx2 = fac2*da_g(1)
1507 fy2 = fac2*da_g(2)
1508 fz2 = fac2*da_g(3)
1509 id1 = iadcnd(1,j)
1510 IF (id1>0) THEN
1511 fskycnd(1,id1) = fx1
1512 fskycnd(2,id1) = fy1
1513 fskycnd(3,id1) = fz1
1514 fskycnd(4,id1) = zero
1515 END IF
1516 id2 = iadcnd(2,j)
1517 IF (id2>0) THEN
1518 fskycnd(1,id2) = fx2
1519 fskycnd(2,id2) = fy2
1520 fskycnd(3,id2) = fz2
1521 fskycnd(4,id2) = zero
1522 END IF
1523 END DO
1524 END IF
1525 ENDIF
1526 ENDDO
1527C
1528 IF (nspmd>1) THEN
1529 lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
1530 lens = fr_nbcccnd(1,nspmd+1)
1531 lenr = fr_nbcccnd(2,nspmd+1)
1532 CALL spmd_exch_a_scnd_pon(
1533 1 fr_cndm,iad_cndm,addcncnd,procncnd,fr_nbcccnd,
1534 2 isize,lenr ,lens ,fskycnd)
1535 END IF
1536C
1537C Routine assemblage parith/ON
1538C
1539 DO n = 1, numnod
1540 nct = addcncnd(n)-1
1541 nc = addcncnd(n+1)-addcncnd(n)
1542 DO k = nct+1, nct+nc
1543 a(1,n) = a(1,n) - fskycnd(1,k)
1544 a(2,n) = a(2,n) - fskycnd(2,k)
1545 a(3,n) = a(3,n) - fskycnd(3,k)
1546 ENDDO
1547 ENDDO
1548 END IF !(IPARIT == 0 ) THEN
1549C
1550C----6---------------------------------------------------------------7---------8
1551 RETURN
1552 END
1553!||====================================================================
1554!|| s10cnistat ../engine/source/elements/solid/solide10/s10cndf.F
1555!||--- calls -----------------------------------------------------
1556!|| ngr2usr ../engine/source/input/freform.F
1557!|| spmd_exch_a_scnd ../engine/source/mpi/elements/spmd_exch_a_scnd.F
1558!|| spmd_exch_a_scnd_pon ../engine/source/mpi/elements/spmd_exch_a_scnd_pon.f
1559!||--- uses -----------------------------------------------------
1560!|| groupdef_mod ../common_source/modules/groupdef_mod.F
1561!||====================================================================
1562 SUBROUTINE s10cnistat(ICNDS10,MS ,A ,V ,VD ,
1563 1 IADCND ,ADDCNCND,FSKYCND,IGRNOD ,WEIGHT ,
1564 2 IAD_CNDM,FR_CNDM,FR_NBCCCND,PROCNCND)
1565C-----------------------------------------------
1566C M o d u l e s
1567C-----------------------------------------------
1568 USE groupdef_mod
1569C-----------------------------------------------
1570C I m p l i c i t T y p e s
1571C-----------------------------------------------
1572#include "implicit_f.inc"
1573C-----------------------------------------------
1574C C o m m o n B l o c k s
1575C-----------------------------------------------
1576#include "com01_c.inc"
1577#include "com04_c.inc"
1578#include "com08_c.inc"
1579#include "comlock.inc"
1580#include "parit_c.inc"
1581#include "spmd_c.inc"
1582#include "stati_c.inc"
1583#include "statr_c.inc"
1584C-----------------------------------------------
1585C D u m m y A r g u m e n t s
1586C-----------------------------------------------
1587 INTEGER ICNDS10(3,*),WEIGHT(*),IAD_CNDM(*),FR_CNDM(*),
1588 . FR_NBCCCND(2,*),ADDCNCND(*),PROCNCND(*),IADCND(2,*)
1589C REAL
1590 my_real
1591 . a(3,*),v(3,*),vd(3,*),ms(*),fskycnd(4,*)
1592C-----------------------------------------------
1593C L o c a l V a r i a b l e s
1594C-----------------------------------------------
1595 INTEGER I, J,NFTSK,NLTSK,N, K,ID1,ID2,NC,N1,N2,ND,CC,NCT,NGR2USR,
1596 . ISIZE,LCOMM,LENS,LENR
1597C REAL
1598 my_real
1599 . FX1,FY1,FZ1 ,FX2,FY2,FZ2,FAC,FAC1,FAC2,DT05,VX,VY,VZ,DAMPC,DOMEGA
1600 my_real
1601 . TMP(NUMNOD)
1602 INTEGER ITAG(NUMNOD)
1603C-----------------------------------------------
1604 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
1605 EXTERNAL NGR2USR
1606C======================================================================|
1607 IF (ISTAT/=1.AND.istat/=3) RETURN
1608C-------0.5*alpha
1609 dampc=betate/(one + betate * dt12)
1610c DT05 = HALF*DT1
1611 IF (iparit/=0) fskycnd(1:3,1:lcncnd)=zero
1612 IF (istatg/=0) THEN
1613 IF(istatg<0) istatg=ngr2usr(-istatg,igrnod,ngrnod)
1614 itag(1:numnod)=0
1615 DO n=1,igrnod(istatg)%NENTITY
1616 i=igrnod(istatg)%ENTITY(n)
1617 itag(i)=1
1618 ENDDO
1619 ELSE
1620 itag(1:numnod)=1
1621 ENDIF
1622 isize = 4
1623C------correction for nd due to V_nd=V_nd-0.5*(V1+V2)
1624 domega = two*betate
1625 IF(istatg==0)THEN
1626#include "vectorize.inc"
1627 DO i=1,ns10e
1628 nd = iabs(icnds10(1,i))
1629 a(1,nd) = a(1,nd)+domega*vd(1,i)
1630 a(2,nd) = a(2,nd)+domega*vd(2,i)
1631 a(3,nd) = a(3,nd)+domega*vd(3,i)
1632 END DO
1633 ELSE
1634#include "vectorize.inc"
1635 DO i=1,ns10e
1636 nd = iabs(icnds10(1,i))
1637 IF(itag(nd)==0) cycle
1638 a(1,nd) = a(1,nd)+domega*vd(1,i)
1639 a(2,nd) = a(2,nd)+domega*vd(2,i)
1640 a(3,nd) = a(3,nd)+domega*vd(3,i)
1641 END DO
1642 END IF
1643C
1644 IF (iparit == 0 ) THEN
1645 IF (nspmd>1) THEN
1646#include "vectorize.inc"
1647 DO i=1,iad_cndm(nspmd+1)-1
1648 j = fr_cndm(i)
1649 a(1,j) = a(1,j) * weight(j)
1650 a(2,j) = a(2,j) * weight(j)
1651 a(3,j) = a(3,j) * weight(j)
1652 END DO
1653 END IF
1654#include "vectorize.inc"
1655 DO i=1,ns10e
1656 nd = iabs(icnds10(1,i))
1657 IF(itag(nd)==0) cycle
1658 n1 = icnds10(2,i)
1659 n2 = icnds10(3,i)
1660 fac= dampc*ms(nd)* weight(nd)
1661 IF (ms(n1)<=em20) THEN
1662 fac1 = zero
1663 ELSE
1664 fac1 = fac/ms(n1)
1665 END IF
1666 IF (ms(n2)<=em20) THEN
1667 fac2 = zero
1668 ELSE
1669 fac2 = fac/ms(n2)
1670 END IF
1671 vx = v(1,nd)-vd(1,i)
1672 vy = v(2,nd)-vd(2,i)
1673 vz = v(3,nd)-vd(3,i)
1674 fx1 = fac1*vx
1675 fy1 = fac1*vy
1676 fz1 = fac1*vz
1677 fx2 = fac2*vx
1678 fy2 = fac2*vy
1679 fz2 = fac2*vz
1680 a(1,n1) = a(1,n1) - fx1
1681 a(2,n1) = a(2,n1) - fy1
1682 a(3,n1) = a(3,n1) - fz1
1683 a(1,n2) = a(1,n2) - fx2
1684 a(2,n2) = a(2,n2) - fy2
1685 a(3,n2) = a(3,n2) - fz2
1686 END DO
1687 IF (nspmd>1) THEN
1688 lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
1689 tmp(1:numnod)=zero
1690 CALL spmd_exch_a_scnd(
1691 . a ,tmp ,fr_cndm,iad_cndm,lcomm,isize)
1692 END IF
1693 ELSE
1694#include "vectorize.inc"
1695 DO i=1,ns10e
1696 nd = iabs(icnds10(1,i))
1697 IF(itag(nd)==0) cycle
1698 n1 = icnds10(2,i)
1699 n2 = icnds10(3,i)
1700 fac= dampc*ms(nd)
1701 IF (ms(n1)<=em20) THEN
1702 fac1 = zero
1703 ELSE
1704 fac1 = fac/ms(n1)
1705 END IF
1706 IF (ms(n2)<=em20) THEN
1707 fac2 = zero
1708 ELSE
1709 fac2 = fac/ms(n2)
1710 END IF
1711 vx = v(1,nd)-vd(1,i)
1712 vy = v(2,nd)-vd(2,i)
1713 vz = v(3,nd)-vd(3,i)
1714 fx1 = fac1*vx
1715 fy1 = fac1*vy
1716 fz1 = fac1*vz
1717 fx2 = fac2*vx
1718 fy2 = fac2*vy
1719 fz2 = fac2*vz
1720 id1 = iadcnd(1,i)
1721 IF (id1>0) THEN
1722 fskycnd(1,id1) = fx1
1723 fskycnd(2,id1) = fy1
1724 fskycnd(3,id1) = fz1
1725 fskycnd(4,id1) = zero
1726 END IF
1727 id2 = iadcnd(2,i)
1728 IF (id2>0) THEN
1729 fskycnd(1,id2) = fx2
1730 fskycnd(2,id2) = fy2
1731 fskycnd(3,id2) = fz2
1732 fskycnd(4,id2) = zero
1733 END IF
1734 END DO
1735 IF (nspmd>1) THEN
1736 lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
1737 lens = fr_nbcccnd(1,nspmd+1)
1738 lenr = fr_nbcccnd(2,nspmd+1)
1739 CALL spmd_exch_a_scnd_pon(
1740 1 fr_cndm,iad_cndm,addcncnd,procncnd,fr_nbcccnd,
1741 2 isize,lenr ,lens ,fskycnd)
1742 END IF
1743C
1744C Routine assemblage parith/ON
1745C
1746 DO n = 1, numnod
1747 nct = addcncnd(n)-1
1748 nc = addcncnd(n+1)-addcncnd(n)
1749 DO k = nct+1, nct+nc
1750 a(1,n) = a(1,n) - fskycnd(1,k)
1751 a(2,n) = a(2,n) - fskycnd(2,k)
1752 a(3,n) = a(3,n) - fskycnd(3,k)
1753 ENDDO
1754 ENDDO
1755 END IF
1756C----6---------------------------------------------------------------7---------8
1757 RETURN
1758 END
1759!||====================================================================
1760!|| s10stfe_poff ../engine/source/elements/solid/solide10/s10cndf.F
1761!||--- called by ------------------------------------------------------
1762!|| resol ../engine/source/engine/resol.F
1763!||--- calls -----------------------------------------------------
1764!|| my_barrier ../engine/source/system/machine.F
1765!|| spmd_exch_stif_scnd ../engine/source/mpi/elements/spmd_exch_stif_scnd.f
1766!||====================================================================
1767 SUBROUTINE s10stfe_poff(ICNDS10,WEIGHT ,IAD_CNDS,FR_CNDS,ITAB ,
1768 2 NODFTSK,NODLTSK,EFTSK ,ELTSK ,ITSK ,
1769 3 STIFN ,STIFND)
1770C-----------------------------------------------
1771C I m p l i c i t T y p e s
1772C-----------------------------------------------
1773#include "implicit_f.inc"
1774C-----------------------------------------------
1775C C o m m o n B l o c k s
1776C-----------------------------------------------
1777#include "com01_c.inc"
1778#include "com04_c.inc"
1779#include "task_c.inc"
1780#include "comlock.inc"
1781C-----------------------------------------------
1782C D u m m y A r g u m e n t s
1783C-----------------------------------------------
1784 INTEGER ICNDS10(3,*),WEIGHT(*),IAD_CNDS(*),FR_CNDS(*),ITAB(*)
1785 INTEGER NODFTSK,NODLTSK,EFTSK,ELTSK,ITSK
1786 my_real STIFN(*),STIFND(*)
1787C-----------------------------------------------
1788C L o c a l V a r i a b l e s
1789C-----------------------------------------------
1790 INTEGER I, J, N, K,LCOMM,IK,ND
1791 my_real
1792 . STIFEL(NS10E)
1793C======================================================================|
1794C-----get STIFND from elem part, called after Forint
1795 STIFEL(EFTSK:ELTSK) = zero
1796 ik = 0
1797 DO k = 1,nthread
1798 DO i = eftsk,eltsk
1799 nd = iabs(icnds10(1,i))
1800 stifel(i) = stifel(i)+ stifn(nd+ik)
1801 END DO
1802 ik = ik + numnod
1803 END DO
1804 DO i = eftsk,eltsk
1805 stifnd(i) = stifel(i)- stifnd(i)
1806 END DO
1807C------------------------
1808 CALL my_barrier()
1809C------------------------
1810 IF (nspmd>1) THEN
1811!$OMP SINGLE
1812 lcomm =iad_cnds(nspmd+1)-iad_cnds(1)
1813 CALL spmd_exch_stif_scnd(
1814 . stifnd ,fr_cnds,iad_cnds,lcomm)
1815!$OMP END SINGLE
1816 END IF
1817C----6---------------------------------------------------------------7---------8
1818 RETURN
1819 END
1820
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
resol
subroutine resol(timers, element, nodes, coupling, af, iaf, iskwn, neth, ipart, nom_opt, kxx, ixx, ixtg, ixs, ixq, ixt, ixp, ixr, ifill, mat_elem, ims, npc, ibcl, ibfv, idum, las, laccelm, nnlink, lnlink, iparg, dd_iad, igrv, iexlnk, kinet, ipari, nprw, iconx, npby, lpby, lrivet, nstrf, ljoint, nodpor, monvol, ilink, llink, linale, neflsw, nnflsw, icut, cluster, itask, inoise, thke, damp, pm, skews, geo, eani, bufmat, bufgeo, bufsf, w, veul, fill, dfill, alph, wb, dsave, asave, msnf, tf, forc, vel, fsav, fzero, xlas, accelm, agrv, fr_wave, failwave, parts0, elbuf, rwbuf, sensors, rwsav, rby, rivet, secbuf, volmon, lambda, wa, fv, partsav, uwa, val2, phi, segvar, r, crflsw, flsw, fani, xcut, anin, tani, secfcum, bufnois, idata, rdata, iframe, kxsp, ixsp, nod2sp, ispsym, ispcond, xframe, spbuf, xspsym, vspsym, pv, fsavd, ibvel, lbvel, wasph, w16, isphio, lprtsph, lonfsph, vsphio, fbvel, lagbuf, ibcslag, iactiv, dampr, gjbufi, gjbufr, rbmpc, ibmpc, sphveln, nbrcvois, nbsdvois, lnrcvois, lnsdvois, nercvois, nesdvois, lercvois, lesdvois, npsegcom, lsegcom, nporgeo, ixtg1, npbyl, lpbyl, rbyl, igeo, ipm, madprt, madsh4, madsh3, madsol, madnod, madfail, iad_rby, fr_rby, fr_wall, iad_rby2, fr_rby2, iad_i2m, fr_i2m, addcni2, procni2, iadi2, fr_mv, iadmv2, fr_ll, fr_rl, iadcj, fr_cj, fr_sec, iad_sec, iad_cut, fr_cut, rg_cut, newfront, fr_mad, fxbipm, fxbrpm, fxbnod, fxbmod, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxbdep, fxbvit, fxbacc, fxbelm, fxbsig, fxbgrvi, fxbgrvr, eigipm, eigibuf, eigrpm, lnodpor, fr_i18, graphe, iflow, rflow, lgrav, dd_r2r, fasolfr, fr_lagf, llagf, lprw, icontact, rcontact, sh4tree, sh3tree, ipadmesh, padmesh, msc, mstg, inc, intg, ptg, iskwp, nskwp, isensp, nsensp, iaccp, naccp, ipart_state, acontact, pcontact, factiv, sh4trim, sh3trim, mscnd, incnd, ibfflux, fbfflux, rbym, irbym, lnrbym, icodrbym, ibcv, fconv, ibftemp, fbftemp, iad_rbym, fr_rbym, weight_rm, ms_ply, zi_ply, inod_pxfem, iel_pxfem, iadc_pxfem, adsky_pxfem, icode_ply, icodt_ply, iskew_ply, admsms, madclnod, nom_sect, mcpc, mcptg, dmelc, dmeltg, mssa, dmels, mstr, dmeltr, msp, dmelp, msrt, dmelrt, ibcr, fradia, res_sms, table, irbe2, lrbe2, iad_rbe2, fr_rbe2, phie, msf, procne_pxfem, iadsdp_pxfem, iadrcp_pxfem, icfield, lcfield, cfield, msz2, diag_sms, iloadp, lloadp, loadp, inod_crk, iel_crk, iadc_crk, adsky_crk, cne_crk, procne_crk, iadsdp_crk, iadrcp_crk, ibufssg_io, ibc_ply, dmint2, ibordnode, elbuf_tab, por, nodedge, iad_edge, fr_edge, fr_nbedge, crknodiad, lgauge, gauge, igaup, ngaup, nodlevxf, dd_r2r_elem, nodglobxfe, sph2sol, sol2sph, irst, dmsph, wagap, xfem_tab, elcutc, nodenr, kxfenod2elc, enrtag, rthbu f, kxig3d, ixig3d, knot, wige, wsmcomp, stack, cputime_mp_glob, cputime_mp, tab_ump, poin_ump, sol2sph_typ, irunn_bis, addcsrect, iad_frnor, fr_nor, procnor, iad_fredg, fr_edg, drape_sh4n, drape_sh3n, tab_mat, nativ0_sms, multi_fvm, segquadfr, ms_2d, h3d_data, subsets, igrnod, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrpart, igrsurf, forneqs, nloc_dmg, iskwp_l, knotlocpc, knotlocel, pinch_data, tag_skins6, ale_connectivity, xcell, xface, ne_nercvois, ne_nesdvois, ne_lercvois, ne_lesdvois, ibcscyc, lbcscyc, t_monvol, id_global_vois, face_vois, dynain_data, fcont_max, ebcs_tab, diffusion, kloadpinter, loadpinter, dgaploadint, drapeg, user_windows, output, interfaces, dt, loads, python, dpl0cld, vel0cld, ndamp_vrel, id_damp_vrel, fr_damp_vrel, ndamp_vrel_rbyg, names_and_titles, unitab, liflow, lrflow, glob_therm, pblast, rbe3)
Definition resol.F:633
s10cndf2
subroutine s10cndf2(icnds10, weight, iad_cndm, fr_cndm, fr_nbcccnd, addcncnd, procncnd, a, iadcnd, fskycnd, itagnd, nodftsk, nodltsk, eftsk, eltsk, itsk, itab, stifn, stifnd)
Definition s10cndf.F:227
s10cnidamp
subroutine s10cnidamp(icnds10, ms, a, v, vd, iadcnd, addcncnd, fskycnd, skew, dampr, damp, igrnod, dim, weight, iad_cndm, fr_cndm, fr_nbcccnd, procncnd)
Definition s10cndf.F:1227
s10cnistat
subroutine s10cnistat(icnds10, ms, a, v, vd, iadcnd, addcncnd, fskycnd, igrnod, weight, iad_cndm, fr_cndm, fr_nbcccnd, procncnd)
Definition s10cndf.F:1565
s10cnds_ini
subroutine s10cnds_ini(icnds10, itags, fr_elem, iad_elem, iad_cdns, fr_cdns)
Definition s10cndf.F:861
s10cndf1
subroutine s10cndf1(icnds10, weight, iad_cndm, fr_cndm, fr_nbcccnd, addcncnd, procncnd, a, iadcnd, fskycnd, itagnd, nodftsk, nodltsk, eftsk, eltsk, itsk, itab, stifn, stifnd)
Definition s10cndf.F:38
s10cndfnd
subroutine s10cndfnd(icnds10, weight, iad_cnds, fr_cnds, itab, nodftsk, nodltsk, eftsk, eltsk, itsk, stifn, stifnd)
Definition s10cndf.F:768
s10cnd_ini
subroutine s10cnd_ini(icnds10, itagnd, iad_cndm, fr_cndm, fr_nbcccnd, addcncnd, procncnd, vnd, v, itab, iad_cndm1, fr_cndm1, fr_nbcccnd1)
Definition s10cndf.F:399
s10cndi2_ini
subroutine s10cndi2_ini(ipari, intbuf_tab, icnds10, itagnd, weight, fr_cnds, iad_cnds, itab)
Definition s10cndf.F:513
cndmasi2_dim
subroutine cndmasi2_dim(ipari, intbuf_tab, icnds10, itagnd, weight, nkend, iad_cnds, fr_cnds, s_fr, nspmd)
Definition s10cndf.F:950
s10stfe_poff
subroutine s10stfe_poff(icnds10, weight, iad_cnds, fr_cnds, itab, nodftsk, nodltsk, eftsk, eltsk, itsk, stifn, stifnd)
Definition s10cndf.F:1770
s10cnds_dim
subroutine s10cnds_dim(icnds10, itags, fr_elem, iad_elem, nbdds)
Definition s10cndf.F:819
cnd_dmasi2
subroutine cnd_dmasi2(icnds10, nkend, imap2nd, masi2nd0, ms, weight)
Definition s10cndf.F:1096
cndmasi2_ini
subroutine cndmasi2_ini(ipari, intbuf_tab, icnds10, itagnd, nkend, imap2nd, masi2nd0, ms, weight, itab)
Definition s10cndf.F:1049
cndmasi2
subroutine cndmasi2(icnds10, nkend, imap2nd, masi2nd0, ms, v, a, weight, mas_nd, kend)
Definition s10cndf.F:1168
s10cndamp
subroutine s10cndamp(icnds10, ms, a, v, vd, iadcnd, addcncnd, fskycnd, weight, iad_cndm, fr_cndm, fr_nbcccnd, procncnd)
Definition s10cndf.F:628
s10print
subroutine s10print(icnds10, a, v, itab)
Definition s10cndf.F:905
spmd_exch_a_scnd
subroutine spmd_exch_a_scnd(a, stifn, fr_cdnm, iad_cdnm, lcomm, isize)
Definition spmd_exch_a_scnd.F:37
spmd_exch_a_scnd_pon
subroutine spmd_exch_a_scnd_pon(fr_cdnm, iad_cdnm, addcncdn, procncdn, fr_nbcccdn, isize, lenr, lens, fskycdn)
Definition spmd_exch_a_scnd_pon.F:38
spmd_exch_stif_scnd
subroutine spmd_exch_stif_scnd(stifnd, fr_cdns, iad_cdns, lcomm)
Definition spmd_exch_stif_scnd.F:33
spmd_exch_tag_scnd
subroutine spmd_exch_tag_scnd(itagnd, fr_cnds, iad_cnds, lcomm)
Definition spmd_exch_tag_scnd.F:34
my_barrier
subroutine my_barrier
Definition machine.F:31