OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_init.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!|| sms_ini_part ../engine/source/ams/sms_init.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!||--- uses -----------------------------------------------------
31!|| groupdef_mod ../common_source/modules/groupdef_mod.F
32!|| message_mod ../engine/share/message_module/message_mod.F
33!||====================================================================
34 SUBROUTINE sms_ini_part(IGRPART ,TAGPRT_SMS)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE message_mod
39 USE groupdef_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com04_c.inc"
48#include "sms_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER
53 . TAGPRT_SMS(*)
54C-----------------------------------------------
55 TYPE (GROUP_) , DIMENSION(NGRPART) :: IGRPART
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I, IP, N
60C-----------------------------------------------
61C
62 IF(idtgrs==0)THEN
63 DO ip=1,npart
64 tagprt_sms(ip)=1
65 END DO
66 ELSE
67 DO ip=1,npart
68 tagprt_sms(ip)=0
69 END DO
70 IF(idtgrs < 0)THEN
71 DO n=1,ngrpart
72 IF (igrpart(n)%ID==-idtgrs) THEN
73 idtgrs=n
74 GO TO 120
75 END IF
76 END DO
77 CALL ancmsg(msgid=21,anmode=aninfo_blind,
78 . i1=-idtgrs)
79 CALL arret(2)
80 120 CONTINUE
81 END IF
82!
83 DO i=1,igrpart(idtgrs)%NENTITY
84 ip=igrpart(idtgrs)%ENTITY(i)
85 tagprt_sms(ip)=1
86 END DO
87 END IF
88C
89C-----------------------------------------------
90 RETURN
91 END
92!||====================================================================
93!|| sms_ini_rby ../engine/source/ams/sms_init.F
94!||--- called by ------------------------------------------------------
95!|| resol ../engine/source/engine/resol.F
96!||--- uses -----------------------------------------------------
97!|| message_mod ../engine/share/message_module/message_mod.F
98!||====================================================================
99 SUBROUTINE sms_ini_rby(
100 1 KINET ,NPRW ,LPRW ,NPBY , LPBY ,
101 2 TAGMSR_RBY_SMS,TAGSLV_RBY_SMS)
102C-----------------------------------------------
103C M o d u l e s
104C-----------------------------------------------
105 USE message_mod
106C-----------------------------------------------
107C I m p l i c i t T y p e s
108C-----------------------------------------------
109#include "implicit_f.inc"
110C-----------------------------------------------
111C C o m m o n B l o c k s
112C-----------------------------------------------
113#include "com04_c.inc"
114#include "kincod_c.inc"
115#include "param_c.inc"
116C-----------------------------------------------
117C D u m m y A r g u m e n t s
118C-----------------------------------------------
119 INTEGER
120 . KINET(*),NPRW(*), LPRW(*),NPBY(NNPBY,*), LPBY(*),
121 . tagmsr_rby_sms(*), tagslv_rby_sms(*)
122C-----------------------------------------------
123C L o c a l V a r i a b l e s
124C-----------------------------------------------
125 INTEGER I, J, K, N, ITY,
126 . IAD, IP, ILOC4(4)
127 INTEGER ISMS, IMOV, NSN, ILAGM,
128 . N2, N3, N4, N5, N6
129 INTEGER M, MSR, NSNW, KI
130 INTEGER IPERM1(6), IPERM2(6)
131 DATA iloc4/1,3,6,5/
132 DATA iperm1/1,2,3,1,2,3/
133 DATA iperm2/2,3,1,4,4,4/
134C
135C-----------------------------------------------
136C rbodies : numbering
137C------------
138 tagmsr_rby_sms(1:numnod) =0
139 tagslv_rby_sms(1:numnod) =0
140C
141 iad=0
142 isms=0
143 DO m=1,nrbody
144C
145 msr=npby(1,m)
146 nsn=npby(2,m)
147 IF(msr >= 0) THEN
148C if msr secnd of lagrange wall => no ams
149 isms=0
150 k = 1
151 DO n=1,nrwall
152 n2=n +nrwall
153 n3=n2+nrwall
154 n4=n3+nrwall
155 n5=n4+nrwall
156 n6=n5+nrwall
157 nsnw =nprw(n)
158 imov =nprw(n3)
159 ity =nprw(n4)
160 ilagm=nprw(n6)
161 IF(ilagm/=0)THEN
162 DO j=1,nsnw
163 i=lprw(k+j-1)
164 IF(i==msr)THEN
165 isms=1
166 GOTO 100
167 END IF
168 END DO
169 END IF
170 k =k+nsn
171 END DO
172 100 CONTINUE
173 IF(isms==0.AND.npby(7,m)>0 .AND.
174 . (kinet(msr) <=1
175 . .OR. ivf(kinet(msr)) ==1
176 . .OR. irlk(kinet(msr))==1
177 . .OR. ijo(kinet(msr)) ==1
178 . .OR. iwl(kinet(msr)) ==1 )) THEN
179C
180 tagmsr_rby_sms(msr)=m
181 DO ki=1,nsn
182 i=lpby(iad+ki)
183 tagslv_rby_sms(i)=m
184 END DO
185C
186 END IF
187 END IF
188 iad = iad + nsn
189 END DO
190
191C-----------------------------------------------
192 RETURN
193 END
194!||====================================================================
195!|| sms_ini_kad ../engine/source/ams/sms_init.F
196!||--- called by ------------------------------------------------------
197!|| resol ../engine/source/engine/resol.F
198!||--- calls -----------------------------------------------------
199!||--- uses -----------------------------------------------------
200!|| element_mod ../common_source/modules/elements/element_mod.F90
201!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
202!||====================================================================
203 SUBROUTINE sms_ini_kad(
204 1 IXS ,IXQ ,IXC ,IXT ,IXP ,
205 2 IXR ,IXTG ,IXTG1 ,IXS10 ,IXS16 ,
206 3 IXS20 ,IPARG ,MS ,MS0 ,NODNX_SMS ,
207 4 ICODT ,ICODR ,KINET ,INDX1_SMS,
208 5 KAD_SMS ,IPARTS ,IPARTQ ,
209 6 IPARTC ,IPARTT ,IPARTP ,IPARTR ,IPARTUR ,
210 7 IPARTTG ,IPARTX ,TAGPRT_SMS,TAGREL_SMS,ITAB ,
211 8 WEIGHT ,IRBE2 ,IRBE3 ,LRBE2 ,LRBE3 ,
212 9 IAD_ELEM,FR_ELEM ,NPRW ,LPRW ,IPART ,
213 A IGEO ,NATIV_SMS)
214C-----------------------------------------------
215 USE my_alloc_mod
216 use element_mod , only : nixs,nixq,nixc,nixt,nixr,nixp,nixtg
217C-----------------------------------------------
218C I m p l i c i t T y p e s
219C-----------------------------------------------
220#include "implicit_f.inc"
221C-----------------------------------------------
222C C o m m o n B l o c k s
223C-----------------------------------------------
224#include "com01_c.inc"
225#include "com04_c.inc"
226#include "param_c.inc"
227#include "scr17_c.inc"
228#include "sms_c.inc"
229C-----------------------------------------------
230C D u m m y A r g u m e n t s
231C-----------------------------------------------
232 INTEGER
233 . IXS(NIXS,*),IXS10(6,*) ,IXS16(6,*) ,IXS20(12,*),
234 . IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
235 . IXR(NIXR,*), IXTG(NIXTG,*), IXTG1(4,*),
236 . IPARG(NPARG,*),
237 . NODNX_SMS(*), ICODT(*), ICODR(*), KINET(*),
238 . INDX1_SMS(*),
239 . KAD_SMS(*),
240 . IPARTS(*),IPARTQ(*),IPARTC(*),IPARTT(*),
241 . IPARTP(*),IPARTR(*),IPARTUR(*),IPARTTG(*),IPARTX(*),
242 . TAGPRT_SMS(*), TAGREL_SMS(*),
243 . ITAB(*), WEIGHT(*),
244 . irbe2(nrbe2l,*), irbe3(nrbe3l,*), lrbe2(*), lrbe3(*),
245 . iad_elem(2,nspmd+1) ,fr_elem(*), nprw(*), lprw(*),
246 . ipart(lipart1,*), igeo(npropgi,*), nativ_sms(*)
247C REAL
248 my_real
249 . ms(*), ms0(*)
250C-----------------------------------------------
251C L o c a l V a r i a b l e s
252C-----------------------------------------------
253 INTEGER I, J, K, NG, JJ, KK, ITY, NEL, NFT, ISOLNOD,
254 . IAD, IP, ILOC4(4),
255 . TAG8(8), IG, IGTYP
256 INTEGER J1, IPERM1(6), IPERM2(6),IPENTA6(6)
257 INTEGER,DIMENSION(:),ALLOCATABLE :: NAD_SMS
258 INTEGER,DIMENSION(:),ALLOCATABLE :: IWORK
259 DATA ILOC4/1,3,6,5/
260 DATA iperm1/1,2,3,1,2,3/
261 DATA iperm2/2,3,1,4,4,4/
262 DATA ipenta6/1,2,3,5,6,7/
263C-----------------------------------------------
264 CALL my_alloc(nad_sms,numnod)
265 CALL my_alloc(iwork,numnod)
266C-----------------------------------------------
267 DO i=1,numnod
268 nad_sms(i)=0
269 END DO
270
271 knz_sms = 0
272
273 tagrel_sms(1:ngroup)=0
274 DO ng=1,ngroup
275 ity =iparg(5,ng)
276
277 nel = iparg(2,ng)
278 nft = iparg(3,ng)
279 isolnod = iparg(28,ng)
280 IF(ity==1.AND.isolnod==4)THEN
281 DO j=nft+1,nft+nel
282 DO k=1,4
283
284 i=ixs(1+iloc4(k),j)
285 DO kk=1,4
286 jj = ixs(1+iloc4(kk),j)
287 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
288 tagrel_sms(ng)=1
289 nad_sms(i)=nad_sms(i)+1
290 knz_sms =knz_sms+1
291 END IF
292 END DO
293
294 END DO
295 END DO
296 ELSEIF(ity==1.AND.isolnod==6)THEN
297 DO j=nft+1,nft+nel
298 DO k=1,6
299
300 i=ixs(1+ipenta6(k),j)
301 DO kk=1,6
302 jj = ixs(1+ipenta6(kk),j)
303 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
304 tagrel_sms(ng)=1
305 nad_sms(i)=nad_sms(i)+1
306 knz_sms =knz_sms+1
307 END IF
308 END DO
309
310 END DO
311 END DO
312 ELSEIF(ity==1.AND.isolnod==8)THEN
313 DO j=nft+1,nft+nel
314
315 DO k=1,8
316 i=ixs(1+k,j)
317 iwork(i)=0
318 tag8(k)=0
319 END DO
320
321 DO k=1,8
322 i=ixs(1+k,j)
323 IF(iwork(i)/=0)THEN
324 tag8(k)=1
325 ELSE
326 iwork(i)=1
327 END IF
328 END DO
329
330 DO k=1,8
331
332 i=ixs(1+k,j)
333 IF(tag8(k)/=0)cycle
334
335 DO kk=1,8
336 jj = ixs(1+kk,j)
337 IF(tag8(kk)/=0) cycle
338
339 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
340 tagrel_sms(ng)=1
341 nad_sms(i)=nad_sms(i)+1
342 knz_sms =knz_sms+1
343 END IF
344 END DO
345
346 END DO
347 END DO
348 ELSEIF(ity==1.AND.isolnod==10)THEN
349 DO j=nft+1,nft+nel
350 j1=j-numels8
351
352 DO k=1,4
353
354 i=ixs(1+iloc4(k),j)
355 DO kk=1,4
356 jj = ixs(1+iloc4(kk),j)
357 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
358 tagrel_sms(ng)=1
359 nad_sms(i)=nad_sms(i)+1
360 knz_sms =knz_sms+1
361 END IF
362 END DO
363
364 DO kk=1,6
365 jj=ixs10(kk,j1)
366 IF(jj==0) cycle
367
368 IF(.NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
369 tagrel_sms(ng)=1
370 nad_sms(i)=nad_sms(i)+1
371 knz_sms =knz_sms+1
372 END IF
373 END DO
374
375 END DO
376
377 DO k=1,6
378
379 i=ixs10(k,j1)
380 IF(i==0) cycle
381
382 DO kk=1,4
383 jj = ixs(1+iloc4(kk),j)
384 IF(.NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
385 tagrel_sms(ng)=1
386 nad_sms(i)=nad_sms(i)+1
387 knz_sms =knz_sms+1
388 END IF
389 END DO
390
391 DO kk=1,6
392 jj=ixs10(kk,j1)
393 IF(jj==0) cycle
394
395 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
396 tagrel_sms(ng)=1
397 nad_sms(i)=nad_sms(i)+1
398 knz_sms =knz_sms+1
399 END IF
400 END DO
401
402 END DO
403
404 END DO
405 ELSEIF(ity==3)THEN
406 DO j=nft+1,nft+nel
407 DO k=1,4
408
409 i=ixc(1+k,j)
410 DO kk=1,4
411 jj = ixc(1+kk,j)
412 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
413 tagrel_sms(ng)=1
414 nad_sms(i)=nad_sms(i)+1
415 knz_sms =knz_sms+1
416 END IF
417 END DO
418
419 END DO
420 END DO
421 ELSEIF(ity==4)THEN
422 DO j=nft+1,nft+nel
423 DO k=1,2
424
425 i=ixt(1+k,j)
426 DO kk=1,2
427 jj = ixt(1+kk,j)
428 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
429 tagrel_sms(ng)=1
430 nad_sms(i)=nad_sms(i)+1
431 knz_sms =knz_sms+1
432 END IF
433 END DO
434
435 END DO
436 END DO
437 ELSEIF(ity==5)THEN
438 DO j=nft+1,nft+nel
439 DO k=1,2
440 i=ixp(1+k,j)
441 DO kk=1,2
442 jj = ixp(1+kk,j)
443 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
444 tagrel_sms(ng)=1
445 nad_sms(i)=nad_sms(i)+1
446 knz_sms =knz_sms+1
447 END IF
448 END DO
449 END DO
450 END DO
451 ELSEIF(ity==6)THEN
452 ig = ipart(2,ipartr(nft+1))
453 igtyp = igeo(11,ig)
454 IF(igtyp/=12)THEN
455 DO j=nft+1,nft+nel
456 DO k=1,2
457 i=ixr(1+k,j)
458 DO kk=1,2
459 jj = ixr(1+kk,j)
460 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
461 tagrel_sms(ng)=1
462 nad_sms(i)=nad_sms(i)+1
463 knz_sms =knz_sms+1
464 END IF
465 END DO
466 END DO
467 END DO
468 ELSE
469 DO j=nft+1,nft+nel
470 k=1
471
472 i=ixr(1+k,j)
473
474 kk=2
475 jj = ixr(1+kk,j)
476 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
477 tagrel_sms(ng)=1
478 nad_sms(i)=nad_sms(i)+1
479 knz_sms =knz_sms+1
480 END IF
481
482 k=2
483
484 i=ixr(1+k,j)
485
486 kk=1
487 jj = ixr(1+kk,j)
488 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
489 tagrel_sms(ng)=1
490 nad_sms(i)=nad_sms(i)+1
491 knz_sms =knz_sms+1
492 END IF
493
494 kk=3
495 jj = ixr(1+kk,j)
496 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
497 tagrel_sms(ng)=1
498 nad_sms(i)=nad_sms(i)+1
499 knz_sms =knz_sms+1
500 END IF
501
502 k=3
503
504 i=ixr(1+k,j)
505
506 kk=2
507 jj = ixr(1+kk,j)
508 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
509 tagrel_sms(ng)=1
510 nad_sms(i)=nad_sms(i)+1
511 knz_sms =knz_sms+1
512 END IF
513
514 END DO
515 END IF
516 ELSEIF(ity==7)THEN
517 DO j=nft+1,nft+nel
518 DO k=1,3
519
520 i=ixtg(1+k,j)
521 DO kk=1,3
522 jj = ixtg(1+kk,j)
523 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
524 tagrel_sms(ng)=1
525 nad_sms(i)=nad_sms(i)+1
526 knz_sms =knz_sms+1
527 END IF
528 END DO
529
530 END DO
531 END DO
532 END IF
533 END DO
534C
535 kad_sms(1)=1
536 DO i=1,numnod
537 kad_sms(i+1)=kad_sms(i)+nad_sms(i)
538 END DO
539C-----------------------------------------------
540 DEALLOCATE(nad_sms)
541 DEALLOCATE(iwork)
542
543
544 RETURN
545 END
546!||====================================================================
547!|| nodnx_sms_ini ../engine/source/ams/sms_init.F
548!||--- calls -----------------------------------------------------
549!||--- uses -----------------------------------------------------
550!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
551!||====================================================================
552 SUBROUTINE nodnx_sms_ini(
553 1 NUMNOD ,NUMEL ,NIX ,MIX ,LIX ,
554 2 IX ,IPARTX,TAGPRT_SMS,NODNX_SMS)
555C-----------------------------------------------
556C M o d u l e s
557C-----------------------------------------------
558 USE my_alloc_mod
559C-----------------------------------------------
560C I m p l i c i t T y p e s
561C-----------------------------------------------
562#include "implicit_f.inc"
563C-----------------------------------------------
564C D u m m y A r g u m e n t s
565C-----------------------------------------------
566 INTEGER NUMNOD , NUMEL ,NIX ,MIX, LIX,
567 . IX(NIX,*), IPARTX(*), TAGPRT_SMS(*), NODNX_SMS(*)
568C-----------------------------------------------
569C L o c a l V a r i a b l e s
570C-----------------------------------------------
571 INTEGER I, J, K
572 INTEGER,DIMENSION(:), ALLOCATABLE :: TAG
573C-----------------------------------------------
574C S o u r c e L i n e s
575C-----------------------------------------------
576 CALL MY_ALLOC(TAG,NUMNOD)
577C-----------------------------------------------
578
579 DO J=1,numel
580 IF(tagprt_sms(ipartx(j))==0) cycle
581
582 DO k=1,lix
583 i = ix(mix+k,j)
584 IF(i/=0) tag(i)=0
585 ENDDO
586 DO k=1,lix
587 i = ix(mix+k,j)
588 IF(i/=0)THEN
589 IF(tag(i)==0)THEN
590 nodnx_sms(i)=nodnx_sms(i)+1
591 tag(i)=1
592 END IF
593 END IF
594 ENDDO
595 ENDDO
596
597 DEALLOCATE(tag)
598 RETURN
599 END
600!||====================================================================
601!|| sms_ini_kdi ../engine/source/ams/sms_init.F
602!||--- called by ------------------------------------------------------
603!|| resol ../engine/source/engine/resol.F
604!||--- calls -----------------------------------------------------
605!|| startimeg ../engine/source/system/timer.F
606!|| stoptimeg ../engine/source/system/timer.F
607!||--- uses -----------------------------------------------------
608!|| element_mod ../common_source/modules/elements/element_mod.F90
609!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
610!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
611!||====================================================================
612 SUBROUTINE sms_ini_kdi(
613 2 IXC ,IPARG ,IXS ,IXT ,IXP ,
614 3 IXR ,IXTG ,IXS10 ,NODNX_SMS,KAD_SMS ,
615 4 KDI_SMS ,JADC_SMS,JADS_SMS ,JADS10_SMS,
616 5 JADT_SMS ,JADP_SMS,
617 6 JADR_SMS,JADTG_SMS,INDX1_SMS,TAGPRT_SMS,IAD_SMS ,
618 7 TAGREL_SMS,IPARTS ,IPARTQ ,IPARTC ,IPARTT ,
619 8 IPARTP ,IPARTR ,IPARTUR ,IPARTTG ,IPARTX ,
620 9 IAD_ELEM ,FR_ELEM,NPBY ,LPBY ,KINET ,
621 A TAGSLV_RBY_SMS,IPARI,INTBUF_TAB,IRECT ,
622 B LAD_SMS ,IPART ,IGEO ,WEIGHT ,
623 C NATIV_SMS)
624C-----------------------------------------------
625C M o d u l e s
626C-----------------------------------------------
627 USE intbufdef_mod
628 USE my_alloc_mod
629 use element_mod , only : nixs,nixq,nixc,nixt,nixr,nixp,nixtg
630C-----------------------------------------------
631C I m p l i c i t T y p e s
632C-----------------------------------------------
633#include "implicit_f.inc"
634#include "comlock.inc"
635C-----------------------------------------------
636C C o m m o n B l o c k s
637C-----------------------------------------------
638#include "com01_c.inc"
639#include "com04_c.inc"
640#include "param_c.inc"
641#include "sms_c.inc"
642#include "task_c.inc"
643#include "scr17_c.inc"
644C-----------------------------------------------------------------
645C D u m m y A r g u m e n t s
646C-----------------------------------------------
647 INTEGER
648 . IPARG(NPARG,*), IXC(NIXC,*), IXS(NIXS,*), IXT(NIXT,*),
649 . IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*), IXS10(6,*),
650 . NODNX_SMS(*), KAD_SMS(*), IAD_SMS(*),
651 . JADC_SMS(4,*),
652 . jads_sms(8,*), jads10_sms(6,*),
653 . jadt_sms(2,*),
654 . jadp_sms(2,*),
655 . jadr_sms(3,*),
656 . jadtg_sms(3,*), nativ_sms(*),
657 . indx1_sms(*), tagprt_sms(*), tagrel_sms(*),
658 . iparts(*), ipartq(*), ipartc(*), ipartt(*),
659 . ipartp(*), ipartr(*), ipartur(*), iparttg(*), ipartx(*),
660 . iad_elem(2,nspmd+1) ,fr_elem(*),
661 . npby(nnpby,*), lpby(*), kinet(*), tagslv_rby_sms(*),
662 . ipari(npari,*), irect(4,*),
663 . lad_sms(*), kdi_sms(*),
664 . ipart(lipart1,*), igeo(npropgi,*), weight(*)
665 TYPE(intbuf_struct_) INTBUF_TAB(*)
666C-----------------------------------------------
667C L o c a l V a r i a b l e s
668C-----------------------------------------------
669 INTEGER I, J, K, JJ, KK, IJ
670 INTEGER NG, ITY, NEL, NFT, ISOLNOD,ILOC4(4),
671 . TAG8(8), IG, IGTYP
672 INTEGER KJ
673
674 INTEGER
675 . N1, N2, N3, N4, LNEW, ILEV
676 INTEGER J1, IPERM1(6), IPERM2(6),IPENTA6(6)
677
678 INTEGER IK
679 INTEGER,DIMENSION(:),ALLOCATABLE :: TAGA
680 INTEGER,DIMENSION(:),ALLOCATABLE :: NAD_SMS
681 INTEGER,DIMENSION(:),ALLOCATABLE :: TAGK
682
683 DATA ILOC4/1,3,6,5/
684 DATA IPERM1/1,2,3,1,2,3/
685 DATA IPERM2/2,3,1,4,4,4/
686 DATA IPENTA6/1,2,3,5,6,7/
687C-----------------------------------------------
688 CALL MY_ALLOC(TAGA,NUMNOD)
689 CALL MY_ALLOC(NAD_SMS,NUMNOD)
690 CALL my_alloc(tagk,numnod)
691C-----------------------------------------------
692C
693C Built jdi_sms, jads_sms, etc.
694C -----------------
695 DO i=1,numnod
696 nad_sms(i)=kad_sms(i)
697 END DO
698C
699 250 CONTINUE
700#include "lockon.inc"
701 IF(nsgdone>ngroup) THEN
702#include "lockoff.inc"
703 GOTO 252
704 ENDIF
705 ng=nsgdone
706 nsgdone = ng + 1
707#include "lockoff.inc"
708C
709 IF(tagrel_sms(ng)==0)GOTO 250
710 ity =iparg(5,ng)
711 IF (iddw>0) CALL startimeg(ng)
712
713 nel = iparg(2,ng)
714 nft = iparg(3,ng)
715 isolnod = iparg(28,ng)
716 IF(ity==1.AND.isolnod==4)THEN
717 DO j=nft+1,nft+nel
718
719 DO k=1,4
720 i=ixs(1+iloc4(k),j)
721 jads_sms(k,j)=nad_sms(i)
722
723 ij=jads_sms(k,j)
724 DO kk=1,4
725 jj = ixs(1+iloc4(kk),j)
726 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
727 nad_sms(i)=nad_sms(i)+1
728 kdi_sms(ij)=jj
729 ij=ij+1
730 END IF
731 END DO
732 END DO
733 END DO
734 ELSEIF(ity==1.AND.isolnod==6)THEN
735 DO j=nft+1,nft+nel
736
737 DO k=1,6
738 i=ixs(1+ipenta6(k),j)
739 jads_sms(k,j)=nad_sms(i)
740
741 ij=jads_sms(k,j)
742 DO kk=1,6
743 jj = ixs(1+ipenta6(kk),j)
744 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
745 nad_sms(i)=nad_sms(i)+1
746 kdi_sms(ij)=jj
747 ij=ij+1
748 END IF
749 END DO
750 END DO
751 END DO
752 ELSEIF(ity==1.AND.isolnod==8)THEN
753 DO j=nft+1,nft+nel
754
755 DO k=1,8
756 i=ixs(1+k,j)
757 taga(i)=0
758 tag8(k)=0
759 END DO
760
761 DO k=1,8
762 i=ixs(1+k,j)
763 IF(taga(i)/=0)THEN
764 tag8(k)=1
765 ELSE
766 taga(i)=1
767 END IF
768 END DO
769
770 DO k=1,8
771 i=ixs(1+k,j)
772 jads_sms(k,j)=nad_sms(i)
773 END DO
774
775 DO k=1,8
776
777 i=ixs(1+k,j)
778 IF(tag8(k)/=0)cycle
779
780 ij=jads_sms(k,j)
781 DO kk=1,8
782 jj = ixs(1+kk,j)
783 IF(tag8(kk)/=0) cycle
784
785 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
786 nad_sms(i)=nad_sms(i)+1
787 kdi_sms(ij)=jj
788 ij=ij+1
789 END IF
790 END DO
791
792 END DO
793
794 END DO
795 ELSEIF(ity==1.AND.isolnod==10)THEN
796 DO j=nft+1,nft+nel
797 j1=j-numels8
798
799 DO k=1,4
800
801 i=ixs(1+iloc4(k),j)
802 jads_sms(k,j)=nad_sms(i)
803
804 ij=jads_sms(k,j)
805 DO kk=1,4
806 jj = ixs(1+iloc4(kk),j)
807 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
808 nad_sms(i)=nad_sms(i)+1
809 kdi_sms(ij)=jj
810 ij=ij+1
811 END IF
812 END DO
813
814 DO kk=1,6
815 jj=ixs10(kk,j1)
816 IF(jj==0) cycle
817
818 IF(.NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
819 nad_sms(i)=nad_sms(i)+1
820 kdi_sms(ij)=jj
821 ij=ij+1
822 END IF
823 END DO
824
825 END DO
826
827
828 DO k=1,6
829
830 i=ixs10(k,j1)
831 IF(i==0) cycle
832
833 jads10_sms(k,j1)=nad_sms(i)
834
835 ij=jads10_sms(k,j1)
836 DO kk=1,4
837 jj = ixs(1+iloc4(kk),j)
838 IF(.NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
839 nad_sms(i)=nad_sms(i)+1
840 kdi_sms(ij)=jj
841 ij=ij+1
842 END IF
843 END DO
844
845 DO kk=1,6
846 jj=ixs10(kk,j1)
847 IF(jj==0) cycle
848
849 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
850 nad_sms(i)=nad_sms(i)+1
851 kdi_sms(ij)=jj
852 ij=ij+1
853 END IF
854 END DO
855
856 END DO
857
858 END DO
859 ELSEIF(ity==3)THEN
860 DO j=nft+1,nft+nel
861
862 DO k=1,4
863 i=ixc(1+k,j)
864 jadc_sms(k,j)=nad_sms(i)
865
866 ij=jadc_sms(k,j)
867 DO kk=1,4
868 jj = ixc(1+kk,j)
869 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
870 nad_sms(i)=nad_sms(i)+1
871 kdi_sms(ij)=jj
872 ij=ij+1
873 END IF
874 END DO
875 END DO
876 END DO
877 ELSEIF(ity==4)THEN
878 DO j=nft+1,nft+nel
879
880 DO k=1,2
881 i=ixt(1+k,j)
882 jadt_sms(k,j)=nad_sms(i)
883
884 ij=jadt_sms(k,j)
885 DO kk=1,2
886 jj = ixt(1+kk,j)
887 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
888 nad_sms(i)=nad_sms(i)+1
889 kdi_sms(ij)=jj
890 ij=ij+1
891 END IF
892 END DO
893 END DO
894 END DO
895 ELSEIF(ity==5)THEN
896 DO j=nft+1,nft+nel
897
898 DO k=1,2
899 i=ixp(1+k,j)
900 jadp_sms(k,j)=nad_sms(i)
901
902 ij=jadp_sms(k,j)
903 DO kk=1,2
904 jj = ixp(1+kk,j)
905 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
906 nad_sms(i)=nad_sms(i)+1
907 kdi_sms(ij)=jj
908 ij=ij+1
909 END IF
910 END DO
911 END DO
912 END DO
913 ELSEIF(ity==6)THEN
914 ig = ipart(2,ipartr(nft+1))
915 igtyp = igeo(11,ig)
916 IF(igtyp/=12)THEN
917 DO j=nft+1,nft+nel
918
919 DO k=1,2
920 i=ixr(1+k,j)
921 jadr_sms(k,j)=nad_sms(i)
922
923 ij=jadr_sms(k,j)
924 DO kk=1,2
925 jj = ixr(1+kk,j)
926 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
927 nad_sms(i)=nad_sms(i)+1
928 kdi_sms(ij)=jj
929 ij=ij+1
930 END IF
931 END DO
932 END DO
933 END DO
934 ELSE
935 DO j=nft+1,nft+nel
936 k=1
937 i=ixr(1+k,j)
938 jadr_sms(k,j)=nad_sms(i)
939
940 ij=jadr_sms(k,j)
941 kk=2
942 jj = ixr(1+kk,j)
943 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
944 nad_sms(i)=nad_sms(i)+1
945 kdi_sms(ij)=jj
946 ij=ij+1
947 END IF
948
949 k=2
950 i=ixr(1+k,j)
951 jadr_sms(k,j)=nad_sms(i)
952
953 ij=jadr_sms(k,j)
954 kk=1
955 jj = ixr(1+kk,j)
956 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
957 nad_sms(i)=nad_sms(i)+1
958 kdi_sms(ij)=jj
959 ij=ij+1
960 END IF
961
962 kk=3
963 jj = ixr(1+kk,j)
964 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
965 nad_sms(i)=nad_sms(i)+1
966 kdi_sms(ij)=jj
967 ij=ij+1
968 END IF
969
970 k=3
971 i=ixr(1+k,j)
972 jadr_sms(k,j)=nad_sms(i)
973
974 ij=jadr_sms(k,j)
975 kk=2
976 jj = ixr(1+kk,j)
977 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
978 nad_sms(i)=nad_sms(i)+1
979 kdi_sms(ij)=jj
980 ij=ij+1
981 END IF
982 END DO
983 END IF
984 ELSEIF(ity==7)THEN
985 DO j=nft+1,nft+nel
986
987 DO k=1,3
988 i=ixtg(1+k,j)
989 jadtg_sms(k,j)=nad_sms(i)
990
991 ij=jadtg_sms(k,j)
992 DO kk=1,3
993 jj = ixtg(1+kk,j)
994 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
995 nad_sms(i)=nad_sms(i)+1
996 kdi_sms(ij)=jj
997 ij=ij+1
998 END IF
999 END DO
1000 END DO
1001 END DO
1002 END IF
1003 IF (iddw>0) CALL stoptimeg(ng)
1004 GOTO 250
1005 252 CONTINUE
1006C-------------------------------------------------------------------------
1007C PREPARE KOMPACTION OF ELEMENTARY MATRIX
1008C Nodnx_sms (i) becomes the nb of NDS connects a i
1009C-------------------------------------------------------------------------
1010 tagk(1:numnod)=0
1011 DO i=1,numnod
1012 nodnx_sms(i)=0
1013 DO kj=kad_sms(i),kad_sms(i+1)-1
1014 ik =kdi_sms(kj)
1015 IF(tagk(ik)==0)THEN
1016 nodnx_sms(i)=nodnx_sms(i)+1
1017 tagk(ik)=1
1018 END IF
1019 END DO
1020 DO kj=kad_sms(i),kad_sms(i+1)-1
1021 ik =kdi_sms(kj)
1022 tagk(ik)=0
1023 END DO
1024 END DO
1025C
1026 iad_sms(1)=1
1027 DO i=1,numnod
1028 iad_sms(i+1)=iad_sms(i)+nodnx_sms(i)
1029 lad_sms(i) =nodnx_sms(i)
1030 END DO
1031C
1032 nnz_sms = iad_sms(numnod+1)
1033C
1034 DEALLOCATE(taga)
1035 DEALLOCATE(nad_sms)
1036 DEALLOCATE(tagk)
1037 RETURN
1038 END
1039!||====================================================================
1040!|| sms_ini_jad_1 ../engine/source/ams/sms_init.F
1041!||--- called by ------------------------------------------------------
1042!|| resol ../engine/source/engine/resol.F
1043!||--- calls -----------------------------------------------------
1044!|| my_orders ../common_source/tools/sort/my_orders.c
1045!||--- uses -----------------------------------------------------
1046!|| element_mod ../common_source/modules/elements/element_mod.F90
1047!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1048!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
1049!||====================================================================
1050 SUBROUTINE sms_ini_jad_1(
1051 2 IXC ,IPARG ,IXS ,IXT ,IXP ,
1052 3 IXR ,IXTG ,IXS10 ,NODNX_SMS,JADC_SMS,
1053 4 JADS_SMS ,JADS10_SMS,JADT_SMS ,JADP_SMS,JADR_SMS ,
1054 5 JADTG_SMS,INDX1_SMS,TAGPRT_SMS,
1055 6 KAD_SMS,KDI_SMS ,PK_SMS ,
1056 7 TAGREL_SMS,IPARTS ,IPARTQ ,IPARTC ,IPARTT ,
1057 8 IPARTP ,IPARTR ,IPARTUR ,IPARTTG ,IPARTX ,
1058 9 IAD_ELEM ,FR_ELEM,NPBY ,LPBY ,KINET ,
1059 A TAGSLV_RBY_SMS,IPARI,INTBUF_TAB,IRECT ,
1060 B LAD_SMS ,IPART ,IGEO ,WEIGHT ,NATIV_SMS,
1061 C IAD_SMS ,IDI_SMS,JAD_SMS ,JDI_SMS ,T2MAIN_SMS)
1062C-----------------------------------------------
1063C M o d u l e s
1064C-----------------------------------------------
1065 USE intbufdef_mod
1066 USE my_alloc_mod
1067 use element_mod , only : nixs,nixq,nixc,nixt,nixr,nixp,nixtg
1068C-----------------------------------------------
1069C I m p l i c i t T y p e s
1070C-----------------------------------------------
1071#include "implicit_f.inc"
1072#include "comlock.inc"
1073C-----------------------------------------------
1074C C o m m o n B l o c k s
1075C-----------------------------------------------
1076#include "com01_c.inc"
1077#include "com04_c.inc"
1078#include "param_c.inc"
1079#include "sms_c.inc"
1080#include "scr17_c.inc"
1081C-----------------------------------------------------------------
1082C D u m m y A r g u m e n t s
1083C-----------------------------------------------
1084 INTEGER
1085 . IPARG(NPARG,*), IXC(NIXC,*), IXS(NIXS,*), IXT(NIXT,*),
1086 . ixp(nixp,*), ixr(nixr,*), ixtg(nixtg,*), ixs10(6,*),
1087 . nodnx_sms(*), kad_sms(*), kdi_sms(*), pk_sms(*),
1088 . iad_sms(*), idi_sms(*), jad_sms(*), jdi_sms(*),
1089 . jadc_sms(4,*),
1090 . jads_sms(8,*), jads10_sms(6,*),
1091 . jadt_sms(2,*),
1092 . jadp_sms(2,*),
1093 . jadr_sms(3,*),
1094 . jadtg_sms(3,*),nativ_sms(*),
1095 . indx1_sms(*), tagprt_sms(*), tagrel_sms(*),
1096 . iparts(*), ipartq(*), ipartc(*), ipartt(*),
1097 . ipartp(*), ipartr(*), ipartur(*), iparttg(*), ipartx(*),
1098 . iad_elem(2,nspmd+1) ,fr_elem(*),
1099 . npby(nnpby,*), lpby(*), kinet(*), tagslv_rby_sms(*),
1100 . ipari(npari,*), irect(4,*),
1101 . lad_sms(*),
1102 . ipart(lipart1,*), igeo(npropgi,*), weight(*),t2main_sms(6,*)
1103 TYPE(intbuf_struct_) INTBUF_TAB(*)
1104C-----------------------------------------------
1105C L o c a l V a r i a b l e s
1106C-----------------------------------------------
1107 INTEGER I, J, K, KK, II, N
1108 INTEGER NSN, KJ
1109 INTEGER L
1110 INTEGER NTY, ILAGM,
1111 . N1, N2, N3, N4, ILEV
1112 INTEGER IK, NK, IKK,WORK(70000)
1113 INTEGER,DIMENSION(:),ALLOCATABLE :: NAD_SMS
1114 INTEGER,DIMENSION(:),ALLOCATABLE :: TAGK
1115 INTEGER,DIMENSION(:),ALLOCATABLE :: ITRI
1116 INTEGER,DIMENSION(:),ALLOCATABLE :: INDEX1
1117 INTEGER,DIMENSION(:),ALLOCATABLE :: INDEX2
1118C-------------------------------------------------------------------------
1119 CALL MY_ALLOC(NAD_SMS,NUMNOD)
1120 CALL my_alloc(tagk,numnod)
1121 CALL my_alloc(itri,numnod)
1122 CALL my_alloc(index1,2*numnod)
1123 CALL my_alloc(index2,numnod)
1124C-------------------------------------------------------------------------
1125C PREPARE KOMPACTION OF ELEMENTARY MATRIX
1126C Built Idi_sms and Pointers Kad_sms to Jad_sms
1127C KJ = KAD_SMS(I),KAD_SMS(I+1)-1 => PK_SMS(KJ) = rang de KDI_SMS(KJ) dans IDI_SMS(I),IDI_SMS(I+1)-1
1128C-------------------------------------------------------------------------
1129 tagk(1:numnod)=0
1130C
1131 DO i=1,numnod
1132 nk=0
1133 DO kj=kad_sms(i),kad_sms(i+1)-1
1134 ik =kdi_sms(kj)
1135 IF(tagk(ik)==0)THEN
1136 idi_sms(iad_sms(i)+nk)=ik
1137 nk=nk+1
1138 tagk(ik)=nk
1139 END IF
1140 END DO
1141C
1142C reordonne IDI_SMS(KJ), KJ=IAD_SMS(I),IAD_SMS(I)+LAD_SMS(I)-1
1143 DO ik=1,nk
1144 kj=iad_sms(i)+ik-1
1145 itri(ik) =idi_sms(kj)
1146 index1(ik)=ik
1147 END DO
1148 IF(nk/=0) CALL my_orders(0,work,itri,index1,nk,1)
1149 DO ik=1,nk
1150 kj=iad_sms(i)+ik-1
1151 idi_sms(kj)=itri(index1(ik))
1152 END DO
1153
1154 DO ik=1,nk
1155 ikk =index1(ik)
1156 index2(ikk)=ik
1157 END DO
1158
1159 DO kj=kad_sms(i),kad_sms(i+1)-1
1160 ik = kdi_sms(kj)
1161 pk_sms(kj)= index2(tagk(ik))
1162 END DO
1163
1164 DO kj=kad_sms(i),kad_sms(i+1)-1
1165 ik =kdi_sms(kj)
1166 tagk(ik)=0
1167 END DO
1168
1169 END DO
1170C-------------------------------------------------------------------------
1171 DO i=1,numnod+1
1172 jad_sms(i)=iad_sms(i)
1173 END DO
1174 DO i=1,numnod
1175 DO kj=iad_sms(i),iad_sms(i+1)-1
1176 jdi_sms(kj)=idi_sms(kj)
1177 END DO
1178 END DO
1179C-------------------------------------------------------------------------
1180C inter/type2 : numbering
1181C------------
1182C
1183C T2MAIN_SMS(1) : nb of type2 main nodes (4 or 1)
1184C T2MAIN_SMS(2-5) : id of type2 main nodes
1185C T2MAIN_SMS(6) : flag for deleted main element
1186C
1187 DO i=1,numnod
1188C--- If node is not secnd of type2 kinematic interface it is its own main --
1189 t2main_sms(1,i) = 1
1190 t2main_sms(2,i) = i
1191 ENDDO
1192C
1193C---- First pass - detection of main nodes for crossed type 2 connection
1194C
1195 DO n=1,ninter
1196 nty = ipari(7,n)
1197 ilagm = ipari(33,n)
1198 ilev = ipari(20,n)
1199 nsn = ipari(5,n)
1200 IF(nty==2 .AND. ilagm==0 .AND.ilev/=25 .and. ilev/=26.AND. ilev/=27 .and. ilev/=28)THEN
1201 DO ii=1,nsn
1202 i=abs(intbuf_tab(n)%NSV(ii))
1203 l=intbuf_tab(n)%IRTLM(ii)
1204 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1205 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1206 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1207 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1208C
1209 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1210 . .AND.nativ_sms(n2)==0
1211 . .AND.nativ_sms(n3)==0
1212 . .AND.nativ_sms(n4)==0) cycle
1213C
1214 t2main_sms(1,i) = 4
1215 t2main_sms(2,i) = n1
1216 t2main_sms(3,i) = n2
1217 t2main_sms(4,i) = n3
1218 t2main_sms(5,i) = n4
1219 ENDDO
1220 ELSEIF(nty==2 .AND. ilagm==0 .AND.(ilev==27.or.ilev==28))THEN
1221 DO ii=1,nsn
1222 i=abs(intbuf_tab(n)%NSV(ii))
1223 IF (intbuf_tab(n)%IRUPT(ii)==0) THEN
1224C Kinematic node
1225 l=intbuf_tab(n)%IRTLM(ii)
1226 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1227 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1228 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1229 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1230C
1231 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1232 . .AND.nativ_sms(n2)==0
1233 . .AND.nativ_sms(n3)==0
1234 . .AND.nativ_sms(n4)==0) cycle
1235C
1236 t2main_sms(1,i) = 4
1237 t2main_sms(2,i) = n1
1238 t2main_sms(3,i) = n2
1239 t2main_sms(4,i) = n3
1240 t2main_sms(5,i) = n4
1241 ENDIF
1242 ENDDO
1243 ENDIF
1244 ENDDO
1245C
1246 DO n=1,ninter
1247 nty = ipari(7,n)
1248 ilagm = ipari(33,n)
1249 ilev = ipari(20,n)
1250 IF(nty==2 .AND. ilagm==0 .AND.ilev/=25 .and. ilev/=26.AND. ilev/=27 .and. ilev/=28)THEN
1251 nsn=ipari(5,n)
1252 DO ii=1,nsn
1253 i=abs(intbuf_tab(n)%NSV(ii))
1254 l=intbuf_tab(n)%IRTLM(ii)
1255 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1256 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1257 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1258 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1259
1260 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1261 . .AND.nativ_sms(n2)==0
1262 . .AND.nativ_sms(n3)==0
1263 . .AND.nativ_sms(n4)==0) cycle
1264
1265 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1266 j =jdi_sms(kj)
1267 nodnx_sms(j) =nodnx_sms(j) +4
1268 nodnx_sms(n1)=nodnx_sms(n1)+1
1269 nodnx_sms(n2)=nodnx_sms(n2)+1
1270 nodnx_sms(n3)=nodnx_sms(n3)+1
1271 nodnx_sms(n4)=nodnx_sms(n4)+1
1272 nnz_sms = nnz_sms + 8
1273C-- Type2 crossed connection between main nodes
1274 IF ((t2main_sms(1,j) > 1).AND.(i > j)) THEN
1275 DO k =2,5
1276 DO kk =2,5
1277 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
1278 nodnx_sms(t2main_sms(k,i))=nodnx_sms(t2main_sms(k,i))+1
1279 nodnx_sms(t2main_sms(kk,j))=nodnx_sms(t2main_sms(kk,j))+1
1280 nnz_sms = nnz_sms + 2
1281 ENDIF
1282 ENDDO
1283 ENDDO
1284 ENDIF
1285 END DO
1286 END DO
1287 ELSEIF(nty==2 .AND. ilagm==0 .AND.(ilev==25.or.ilev==26))THEN
1288 nsn=ipari(5,n)
1289 DO ii=1,nsn
1290 i=abs(intbuf_tab(n)%NSV(ii))
1291
1292 IF(weight(i)/=1)cycle
1293
1294 l=intbuf_tab(n)%IRTLM(ii)
1295 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1296 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1297 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1298 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1299
1300 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1301 . .AND.nativ_sms(n2)==0
1302 . .AND.nativ_sms(n3)==0
1303 . .AND.nativ_sms(n4)==0) cycle
1304
1305 nodnx_sms(i) =nodnx_sms(i) +4
1306 nodnx_sms(n1)=nodnx_sms(n1)+1
1307 nodnx_sms(n2)=nodnx_sms(n2)+1
1308 nodnx_sms(n3)=nodnx_sms(n3)+1
1309 nodnx_sms(n4)=nodnx_sms(n4)+1
1310 nnz_sms = nnz_sms + 8
1311 END DO
1312 ELSEIF(nty==2 .AND. ilagm==0 .AND.(ilev==27.or.ilev==28))THEN
1313 nsn=ipari(5,n)
1314 DO ii=1,nsn
1315 i=abs(intbuf_tab(n)%NSV(ii))
1316 IF (intbuf_tab(n)%IRUPT(ii)==0) THEN
1317C Kinematic node
1318 l=intbuf_tab(n)%IRTLM(ii)
1319 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1320 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1321 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1322 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1323
1324 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1325 . .AND.nativ_sms(n2)==0
1326 . .AND.nativ_sms(n3)==0
1327 . .AND.nativ_sms(n4)==0) cycle
1328
1329 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1330 j =jdi_sms(kj)
1331 nodnx_sms(j) =nodnx_sms(j) +4
1332 nodnx_sms(n1)=nodnx_sms(n1)+1
1333 nodnx_sms(n2)=nodnx_sms(n2)+1
1334 nodnx_sms(n3)=nodnx_sms(n3)+1
1335 nodnx_sms(n4)=nodnx_sms(n4)+1
1336 nnz_sms = nnz_sms + 8
1337C-- Type2 crossed connection between main nodes
1338 IF ((t2main_sms(1,j) > 1).AND.(i > j)) THEN
1339 DO k =2,5
1340 DO kk =2,5
1341 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
1342 nodnx_sms(t2main_sms(k,i))=nodnx_sms(t2main_sms(k,i))+1
1343 nodnx_sms(t2main_sms(kk,j))=nodnx_sms(t2main_sms(kk,j))+1
1344 nnz_sms = nnz_sms + 2
1345 ENDIF
1346 ENDDO
1347 ENDDO
1348 ENDIF
1349 END DO
1350 ELSE
1351C Penalty node
1352 IF(weight(i)/=1)cycle
1353 l=intbuf_tab(n)%IRTLM(ii)
1354 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1355 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1356 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1357 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1358
1359 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1360 . .AND.nativ_sms(n2)==0
1361 . .AND.nativ_sms(n3)==0
1362 . .AND.nativ_sms(n4)==0) cycle
1363
1364 nodnx_sms(i) =nodnx_sms(i) +4
1365 nodnx_sms(n1)=nodnx_sms(n1)+1
1366 nodnx_sms(n2)=nodnx_sms(n2)+1
1367 nodnx_sms(n3)=nodnx_sms(n3)+1
1368 nodnx_sms(n4)=nodnx_sms(n4)+1
1369 nnz_sms = nnz_sms + 8
1370 ENDIF
1371 END DO
1372 END IF
1373 END DO
1374C
1375C reconstruit JAD_SMS
1376 jad_sms(1)=1
1377 DO i=1,numnod
1378 jad_sms(i+1)=jad_sms(i)+nodnx_sms(i)
1379 END DO
1380C-----------------------------------------------
1381 DEALLOCATE(nad_sms)
1382 DEALLOCATE(tagk)
1383 DEALLOCATE(itri)
1384 DEALLOCATE(index1)
1385 DEALLOCATE(index2)
1386 RETURN
1387 END
1388!||====================================================================
1389!|| sms_ini_jad_2 ../engine/source/ams/sms_init.F
1390!||--- called by ------------------------------------------------------
1391!|| resol ../engine/source/engine/resol.F
1392!||--- calls -----------------------------------------------------
1393!||--- uses -----------------------------------------------------
1394!|| element_mod ../common_source/modules/elements/element_mod.F90
1395!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1396!|| intstamp_mod ../engine/share/modules/intstamp_mod.F
1397!|| message_mod ../engine/share/message_module/message_mod.F
1398!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
1399!||====================================================================
1400 SUBROUTINE sms_ini_jad_2(
1401 2 IXC ,IPARG ,IXS ,IXT ,IXP ,
1402 3 IXR ,IXTG ,IXS10 ,NODNX_SMS,JADC_SMS,
1403 4 JADS_SMS ,JADS10_SMS,JADT_SMS ,JADP_SMS,JADR_SMS ,
1404 5 JADTG_SMS,INDX1_SMS,TAGPRT_SMS,KAD_SMS,KDI_SMS ,
1405 6 TAGREL_SMS,IPARTS ,IPARTQ ,IPARTC ,IPARTT ,
1406 7 IPARTP ,IPARTR ,IPARTUR ,IPARTTG ,IPARTX ,
1407 8 IAD_ELEM ,FR_ELEM,NPBY ,LPBY ,KINET ,
1408 9 TAGSLV_RBY_SMS,IPARI,INTBUF_TAB,IRECT ,
1409 A LAD_SMS ,NPRW ,LPRW,TAGMSR_RBY_SMS,
1410 B TAGSLV_I21_SMS ,TAGMSR_I21_SMS,JADI21_SMS,INTSTAMP ,
1411 . IPART ,
1412 C IGEO ,WEIGHT ,NATIV_SMS,IRBE2 ,LRBE2 ,
1413 B IAD_SMS ,IDI_SMS ,JAD_SMS ,JDI_SMS ,T2MAIN_SMS)
1414C-----------------------------------------------
1415C M o d u l e s
1416C-----------------------------------------------
1417 USE intstamp_mod
1418 USE intbufdef_mod
1419 USE message_mod
1420 USE my_alloc_mod
1421 use element_mod , only : nixs,nixq,nixc,nixt,nixr,nixp,nixtg
1422C-----------------------------------------------
1423C I m p l i c i t T y p e s
1424C-----------------------------------------------
1425#include "implicit_f.inc"
1426#include "comlock.inc"
1427C-----------------------------------------------
1428C C o m m o n B l o c k s
1429C-----------------------------------------------
1430#include "com01_c.inc"
1431#include "com04_c.inc"
1432#include "param_c.inc"
1433#include "sms_c.inc"
1434#include "scr17_c.inc"
1435C-----------------------------------------------------------------
1436C D u m m y A r g u m e n t s
1437C-----------------------------------------------
1438 INTEGER
1439 . IPARG(NPARG,*), IXC(NIXC,*), IXS(NIXS,*), IXT(NIXT,*),
1440 . IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*), IXS10(6,*),
1441 . NODNX_SMS(*), KAD_SMS(*), KDI_SMS(*),
1442 . IAD_SMS(*), IDI_SMS(*), JAD_SMS(*), JDI_SMS(*),
1443 . JADC_SMS(4,*),
1444 . JADS_SMS(8,*), JADS10_SMS(6,*),
1445 . JADT_SMS(2,*),
1446 . JADP_SMS(2,*),
1447 . JADR_SMS(3,*),
1448 . JADTG_SMS(3,*),
1449 . indx1_sms(*), tagprt_sms(*), tagrel_sms(*),
1450 . iparts(*), ipartq(*), ipartc(*), ipartt(*),
1451 . ipartp(*), ipartr(*), ipartur(*), iparttg(*), ipartx(*),
1452 . iad_elem(2,nspmd+1) ,fr_elem(*),
1453 . npby(nnpby,*), lpby(*), kinet(*), tagslv_rby_sms(*),
1454 . ipari(npari,*), irect(4,*),
1455 . lad_sms(*),
1456 . nprw(*), lprw(*), tagmsr_rby_sms(*),
1457 . tagslv_i21_sms(*), tagmsr_i21_sms(*), jadi21_sms(*),
1458 . ipart(lipart1,*), igeo(npropgi,*), weight(*), nativ_sms(*),
1459 . irbe2(nrbe2l,*), lrbe2(*), t2main_sms(6,*)
1460
1461 TYPE(intstamp_data) INTSTAMP(*)
1462 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1463C-----------------------------------------------
1464C L o c a l V a r i a b l e s
1465C-----------------------------------------------
1466 INTEGER I, J, K, KK, II, N,
1467 . nhi, ns
1468 INTEGER NSN, KJ
1469
1470 INTEGER L
1471 INTEGER NTY, ILAGM,
1472 . N1, N2, N3, N4, N5, N6, ISMS,
1473 . NMN, ILEV
1474 INTEGER IK
1475 INTEGER,DIMENSION(:),ALLOCATABLE :: NAD_SMS
1476C-------------------------------------------------------------------------
1477 CALL MY_ALLOC(NAD_SMS,NUMNOD)
1478C-------------------------------------------------------------------------
1479C PREPARE KOMPACTION OF ELEMENTARY MATRIX
1480C KJ = KAD_SMS(I),KAD_SMS(I+1)-1 => PK_SMS(KJ) = rang de KDI_SMS(KJ) dans JDI_SMS(I),JDI_SMS(I+1)-1
1481C
1482C Rebuilt jdi_sms :: copy idi_sms (compact and sorting elementary connectivity)
1483C-------------------------------------------------------------------------
1484 DO I=1,numnod
1485 DO kj=iad_sms(i),iad_sms(i+1)-1
1486 ik=kj-iad_sms(i)
1487 jdi_sms(jad_sms(i)+ik)=idi_sms(kj)
1488 END DO
1489 END DO
1490C-------------------------------------------------------------------------
1491C inter/type2 : construction de JDI_SMS
1492C-------------------------------------------------------------------------
1493 DO i=1,numnod
1494 nad_sms(i)=jad_sms(i)+lad_sms(i)
1495 END DO
1496
1497C
1498 DO n=1,ninter
1499 nty = ipari(7,n)
1500 ilagm = ipari(33,n)
1501 ilev = ipari(20,n)
1502 IF(nty==2 .AND. ilagm==0 .AND.ilev/=25 .and. ilev/=26 .AND.ilev/=27 .and. ilev/=28)THEN
1503C
1504 nsn=ipari(5,n)
1505 DO ii=1,nsn
1506 i=abs(intbuf_tab(n)%NSV(ii))
1507 l=intbuf_tab(n)%IRTLM(ii)
1508 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1509 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1510 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1511 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1512
1513 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1514 . .AND.nativ_sms(n2)==0
1515 . .AND.nativ_sms(n3)==0
1516 . .AND.nativ_sms(n4)==0) cycle
1517
1518 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1519 j =jdi_sms(kj)
1520C
1521 jdi_sms(nad_sms(n1))=j
1522 nad_sms(n1)=nad_sms(n1)+1
1523 jdi_sms(nad_sms(j))=n1
1524 nad_sms(j)=nad_sms(j)+1
1525C
1526 jdi_sms(nad_sms(n2))=j
1527 nad_sms(n2)=nad_sms(n2)+1
1528 jdi_sms(nad_sms(j))=n2
1529 nad_sms(j)=nad_sms(j)+1
1530C
1531 jdi_sms(nad_sms(n3))=j
1532 nad_sms(n3)=nad_sms(n3)+1
1533 jdi_sms(nad_sms(j))=n3
1534 nad_sms(j)=nad_sms(j)+1
1535C
1536 jdi_sms(nad_sms(n4))=j
1537 nad_sms(n4)=nad_sms(n4)+1
1538 jdi_sms(nad_sms(j))=n4
1539 nad_sms(j)=nad_sms(j)+1
1540C
1541C-- Type2 crossed connection between main nodes
1542 IF ((t2main_sms(1,j) > 1).AND.(i > j)) THEN
1543 DO k =2,5
1544 DO kk =2,5
1545 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
1546 jdi_sms(nad_sms(t2main_sms(k,i)))=t2main_sms(kk,j)
1547 nad_sms(t2main_sms(k,i))=nad_sms(t2main_sms(k,i))+1
1548 jdi_sms(nad_sms(t2main_sms(kk,j)))=t2main_sms(k,i)
1549 nad_sms(t2main_sms(kk,j))=nad_sms(t2main_sms(kk,j))+1
1550 ENDIF
1551 ENDDO
1552 ENDDO
1553 ENDIF
1554C
1555 END DO
1556 END DO
1557 ELSEIF(nty==2.AND.ilagm==0.AND.(ilev==25.or.ilev==26))THEN
1558 nsn=ipari(5,n)
1559 DO ii=1,nsn
1560 i=abs(intbuf_tab(n)%NSV(ii))
1561
1562 IF(weight(i)/=1)cycle
1563
1564 l=intbuf_tab(n)%IRTLM(ii)
1565 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1566 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1567 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1568 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1569
1570 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1571 . .AND.nativ_sms(n2)==0
1572 . .AND.nativ_sms(n3)==0
1573 . .AND.nativ_sms(n4)==0) cycle
1574
1575 jdi_sms(nad_sms(n1))=i
1576 nad_sms(n1)=nad_sms(n1)+1
1577 jdi_sms(nad_sms(i))=n1
1578 nad_sms(i)=nad_sms(i)+1
1579
1580 jdi_sms(nad_sms(n2))=i
1581 nad_sms(n2)=nad_sms(n2)+1
1582 jdi_sms(nad_sms(i))=n2
1583 nad_sms(i)=nad_sms(i)+1
1584
1585 jdi_sms(nad_sms(n3))=i
1586 nad_sms(n3)=nad_sms(n3)+1
1587 jdi_sms(nad_sms(i))=n3
1588 nad_sms(i)=nad_sms(i)+1
1589
1590 jdi_sms(nad_sms(n4))=i
1591 nad_sms(n4)=nad_sms(n4)+1
1592 jdi_sms(nad_sms(i))=n4
1593 nad_sms(i)=nad_sms(i)+1
1594 END DO
1595C
1596 ELSEIF(nty==2.AND.ilagm==0.AND.(ilev==27.or.ilev==28))THEN
1597C
1598 nsn=ipari(5,n)
1599 DO ii=1,nsn
1600 i=abs(intbuf_tab(n)%NSV(ii))
1601 IF (intbuf_tab(n)%IRUPT(ii)==0) THEN
1602C Kinematic node
1603 l=intbuf_tab(n)%IRTLM(ii)
1604 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1605 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1606 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1607 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1608
1609 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1610 . .AND.nativ_sms(n2)==0
1611 . .AND.nativ_sms(n3)==0
1612 . .AND.nativ_sms(n4)==0) cycle
1613
1614 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1615 j =jdi_sms(kj)
1616C
1617 jdi_sms(nad_sms(n1))=j
1618 nad_sms(n1)=nad_sms(n1)+1
1619 jdi_sms(nad_sms(j))=n1
1620 nad_sms(j)=nad_sms(j)+1
1621C
1622 jdi_sms(nad_sms(n2))=j
1623 nad_sms(n2)=nad_sms(n2)+1
1624 jdi_sms(nad_sms(j))=n2
1625 nad_sms(j)=nad_sms(j)+1
1626C
1627 jdi_sms(nad_sms(n3))=j
1628 nad_sms(n3)=nad_sms(n3)+1
1629 jdi_sms(nad_sms(j))=n3
1630 nad_sms(j)=nad_sms(j)+1
1631C
1632 jdi_sms(nad_sms(n4))=j
1633 nad_sms(n4)=nad_sms(n4)+1
1634 jdi_sms(nad_sms(j))=n4
1635 nad_sms(j)=nad_sms(j)+1
1636C
1637C-- Type2 crossed connection between main nodes
1638 IF ((t2main_sms(1,j) > 1).AND.(i > j)) THEN
1639 DO k =2,5
1640 DO kk =2,5
1641 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
1642 jdi_sms(nad_sms(t2main_sms(k,i)))=t2main_sms(kk,j)
1643 nad_sms(t2main_sms(k,i))=nad_sms(t2main_sms(k,i))+1
1644 jdi_sms(nad_sms(t2main_sms(kk,j)))=t2main_sms(k,i)
1645 nad_sms(t2main_sms(kk,j))=nad_sms(t2main_sms(kk,j))+1
1646 ENDIF
1647 ENDDO
1648 ENDDO
1649C
1650 ENDIF
1651 END DO
1652C
1653 ELSE
1654C Penalty node
1655 IF(weight(i)/=1)cycle
1656 l=intbuf_tab(n)%IRTLM(ii)
1657 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1658 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1659 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1660 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1661
1662 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1663 . .AND.nativ_sms(n2)==0
1664 . .AND.nativ_sms(n3)==0
1665 . .AND.nativ_sms(n4)==0) cycle
1666
1667 jdi_sms(nad_sms(n1))=i
1668 nad_sms(n1)=nad_sms(n1)+1
1669 jdi_sms(nad_sms(i))=n1
1670 nad_sms(i)=nad_sms(i)+1
1671
1672 jdi_sms(nad_sms(n2))=i
1673 nad_sms(n2)=nad_sms(n2)+1
1674 jdi_sms(nad_sms(i))=n2
1675 nad_sms(i)=nad_sms(i)+1
1676
1677 jdi_sms(nad_sms(n3))=i
1678 nad_sms(n3)=nad_sms(n3)+1
1679 jdi_sms(nad_sms(i))=n3
1680 nad_sms(i)=nad_sms(i)+1
1681
1682 jdi_sms(nad_sms(n4))=i
1683 nad_sms(n4)=nad_sms(n4)+1
1684 jdi_sms(nad_sms(i))=n4
1685 nad_sms(i)=nad_sms(i)+1
1686 ENDIF
1687 END DO
1688 END IF
1689 END DO
1690C------------
1691C Recalculate NNZ_SMS of the compressed matrix
1692C------------
1693 nnz_sms=0
1694 DO i=1,numnod
1695 nodnx_sms(i)=nad_sms(i)-jad_sms(i)
1696 nnz_sms=nnz_sms+nodnx_sms(i)
1697 END DO
1698C------------
1699C reconstruit JAD_SMS
1700 jad_sms(1)=1
1701 DO i=1,numnod
1702 jad_sms(i+1)=jad_sms(i)+nodnx_sms(i)
1703 END DO
1704C-----------------------------------------------
1705 DEALLOCATE(nad_sms)
1706 RETURN
1707 END
1708!||====================================================================
1709!|| sms_ini_jad_3 ../engine/source/ams/sms_init.F
1710!||--- called by ------------------------------------------------------
1711!|| resol ../engine/source/engine/resol.F
1712!||--- calls -----------------------------------------------------
1713!|| ancmsg ../engine/source/output/message/message.F
1714!|| arret ../engine/source/system/arret.F
1715!|| spmd_allglob_isum9 ../engine/source/mpi/generic/spmd_allglob_isum9.F
1716!|| spmd_exch_nodnx ../engine/source/mpi/ams/spmd_exch_nodnx.F
1717!||--- uses -----------------------------------------------------
1718!|| element_mod ../common_source/modules/elements/element_mod.F90
1719!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
1720!|| intstamp_mod ../engine/share/modules/intstamp_mod.F
1721!|| message_mod ../engine/share/message_module/message_mod.F
1722!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
1723!||====================================================================
1724 SUBROUTINE sms_ini_jad_3(
1725 2 IXC ,IPARG ,IXS ,IXT ,IXP ,
1726 3 IXR ,IXTG ,IXS10 ,NODNX_SMS,JADC_SMS,
1727 4 JADS_SMS ,JADS10_SMS,JADT_SMS ,JADP_SMS,JADR_SMS ,
1728 5 JADTG_SMS ,INDX1_SMS,TAGPRT_SMS,KAD_SMS,KDI_SMS ,
1729 6 TAGREL_SMS,IPARTS ,IPARTQ ,IPARTC ,IPARTT ,
1730 7 IPARTP ,IPARTR ,IPARTUR ,IPARTTG ,IPARTX ,
1731 8 IAD_ELEM ,FR_ELEM,NPBY ,LPBY ,KINET ,
1732 9 TAGSLV_RBY_SMS,IPARI,INTBUF_TAB,IRECT ,
1733 A LAD_SMS ,JSM_SMS ,TAGSLV_I21_SMS ,INTSTAMP ,
1734 . IPART ,
1735 B IGEO ,TAGMSR_RBY_SMS,WEIGHT,NATIV_SMS,
1736 C IAD_SMS ,IDI_SMS ,JAD_SMS ,JDI_SMS ,T2MAIN_SMS)
1737C-----------------------------------------------
1738C M o d u l e s
1739C-----------------------------------------------
1740 USE intstamp_mod
1741 USE intbufdef_mod
1742 USE message_mod
1743 USE my_alloc_mod
1744 use element_mod , only : nixs,nixq,nixc,nixt,nixr,nixp,nixtg
1745C-----------------------------------------------
1746C I m p l i c i t T y p e s
1747C-----------------------------------------------
1748#include "implicit_f.inc"
1749#include "comlock.inc"
1750C-----------------------------------------------
1751C C o m m o n B l o c k s
1752C-----------------------------------------------
1753#include "com01_c.inc"
1754#include "com04_c.inc"
1755#include "param_c.inc"
1756#include "sms_c.inc"
1757#include "scr17_c.inc"
1758C-----------------------------------------------------------------
1759C D u m m y A r g u m e n t s
1760C-----------------------------------------------
1761 INTEGER
1762 . iparg(nparg,*), ixc(nixc,*), ixs(nixs,*), ixt(nixt,*),
1763 . ixp(nixp,*), ixr(nixr,*), ixtg(nixtg,*), ixs10(6,*),
1764 . nodnx_sms(*), kad_sms(*), kdi_sms(*),
1765 . iad_sms(*), idi_sms(*), jad_sms(*), jdi_sms(*),
1766 . jadc_sms(4,*),
1767 . jads_sms(8,*), jads10_sms(6,*),
1768 . jadt_sms(2,*),
1769 . jadp_sms(2,*),
1770 . jadr_sms(3,*),
1771 . jadtg_sms(3,*),nativ_sms(*),
1772 . indx1_sms(*), tagprt_sms(*), tagrel_sms(*),
1773 . iparts(*), ipartq(*), ipartc(*), ipartt(*),
1774 . ipartp(*), ipartr(*), ipartur(*), iparttg(*), ipartx(*),
1775 . iad_elem(2,nspmd+1) ,fr_elem(*),
1776 . npby(nnpby,*), lpby(*), kinet(*), tagslv_rby_sms(*),
1777 . ipari(npari,*), irect(4,*),
1778 . lad_sms(*), jsm_sms(*),
1779 . tagslv_i21_sms(*),
1780 . ipart(lipart1,*), igeo(npropgi,*), tagmsr_rby_sms(*),
1781 . weight(*),t2main_sms(6,*)
1782 TYPE(INTSTAMP_DATA) INTSTAMP(*)
1783 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1784C-----------------------------------------------
1785C L o c a l V a r i a b l e s
1786C-----------------------------------------------
1787 INTEGER I, J, K, KK, II, IJ, N
1788 INTEGER NSN, KJ
1789 INTEGER SIZE, LENR, L
1790 INTEGER NTY, ILAGM, K10, K11, K12, K13, K14, JI,
1791 . N1, N2, N3, N4,
1792 . NMN, ILEV, ERROR
1793 INTEGER LSMSPCG
1794 INTEGER IK, K1, K2, KM
1795 INTEGER, DIMENSION(:), ALLOCATABLE :: NAD_SMS
1796 INTEGER, DIMENSION(:), ALLOCATABLE :: NAD_SMS_0
1797C-------------------------------------------------------------------------
1798 CALL MY_ALLOC(NAD_SMS,NUMNOD)
1799 CALL MY_ALLOC(NAD_SMS_0,NUMNOD)
1800C-------------------------------------------------------------------------
1801C PREPARE KOMPACTION OF ELEMENTARY MATRIX
1802C KJ = KAD_SMS(I),KAD_SMS(I+1)-1 => PK_SMS(KJ) = rang de KDI_SMS(KJ) dans JDI_SMS(I),JDI_SMS(I+1)-1
1803C
1804C Rebuilt jdi_sms :: copy idi_sms (compact and sorting elementary connectivity)
1805C-------------------------------------------------------------------------
1806 DO i=1,numnod
1807 DO kj=iad_sms(i),iad_sms(i+1)-1
1808 ik=kj-iad_sms(i)
1809 jdi_sms(jad_sms(i)+ik)=idi_sms(kj)
1810 END DO
1811 END DO
1812C-------------------------------------------------------------------------
1813C PREPARE JSM_SMS
1814C-------------------------------------------------------------------------
1815C
1816 DO i=1,numnod
1817 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1818 j =jdi_sms(kj)
1819cc IF(I < J)THEN
1820C
1821C dichotomy (search among the ordered neighbors of J)
1822 k1=jad_sms(j)
1823 k2=jad_sms(j)+lad_sms(j)-1
1824 100 CONTINUE
1825 km=(k1+k2)/2
1826 IF(jdi_sms(k1) == i)THEN
1827 jsm_sms(kj)=k1
1828cc JSM_SMS(K1)=KJ
1829 GOTO 200
1830 ELSEIF(jdi_sms(k2) == i)THEN
1831 jsm_sms(kj)=k2
1832cc JSM_SMS(K2)=KJ
1833 GOTO 200
1834 ELSEIF(jdi_sms(km) == i)THEN
1835 jsm_sms(kj)=km
1836cc JSM_SMS(KM)=KJ
1837 GOTO 200
1838 ELSEIF(jdi_sms(km) < i)THEN
1839 k1=km
1840 GOTO 100
1841 ELSE ! jdi_sms(km) > i
1842 k2=km
1843 GOTO 100
1844 END IF
1845 WRITE(6,*) ' ** internal error in AMS initialization'
1846 200 CONTINUE
1847cc END IF
1848 END DO
1849 END DO
1850C
1851 DO i=1,numnod
1852 nad_sms(i)=jad_sms(i)+lad_sms(i)
1853 END DO
1854C-------------------------------------------------------------------------
1855 lsmspcg=0
1856C------------
1857C inter/type2 : reconstruction (jsm)
1858C------------
1859 DO n=1,ninter
1860 nty = ipari(7,n)
1861 ilagm = ipari(33,n)
1862 ilev = ipari(20,n)
1863 IF(nty==2 .AND. ilagm==0 .AND.ilev/=25 .and. ilev/=26.AND.ilev/=27 .and. ilev/=28)THEN
1864C
1865 nsn=ipari(5,n)
1866 DO ii=1,nsn
1867 i=abs(intbuf_tab(n)%NSV(ii))
1868 IF(nodnx_sms(i)/=0) lsmspcg=lsmspcg-1
1869
1870 l=intbuf_tab(n)%IRTLM(ii)
1871 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1872 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1873 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1874 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1875
1876 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1877 . .AND.nativ_sms(n2)==0
1878 . .AND.nativ_sms(n3)==0
1879 . .AND.nativ_sms(n4)==0) cycle
1880
1881 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1882 j =jdi_sms(kj)
1883
1884 jsm_sms(nad_sms(n1))=nad_sms(j)
1885 jsm_sms(nad_sms(j)) =nad_sms(n1)
1886 jdi_sms(nad_sms(n1))=j
1887 nad_sms(n1)=nad_sms(n1)+1
1888 jdi_sms(nad_sms(j))=n1
1889 nad_sms(j)=nad_sms(j)+1
1890
1891 jsm_sms(nad_sms(n2))=nad_sms(j)
1892 jsm_sms(nad_sms(j)) =nad_sms(n2)
1893 jdi_sms(nad_sms(n2))=j
1894 nad_sms(n2)=nad_sms(n2)+1
1895 jdi_sms(nad_sms(j))=n2
1896 nad_sms(j)=nad_sms(j)+1
1897
1898 jsm_sms(nad_sms(n3))=nad_sms(j)
1899 jsm_sms(nad_sms(j)) =nad_sms(n3)
1900 jdi_sms(nad_sms(n3))=j
1901 nad_sms(n3)=nad_sms(n3)+1
1902 jdi_sms(nad_sms(j))=n3
1903 nad_sms(j)=nad_sms(j)+1
1904
1905 jsm_sms(nad_sms(n4))=nad_sms(j)
1906 jsm_sms(nad_sms(j)) =nad_sms(n4)
1907 jdi_sms(nad_sms(n4))=j
1908 nad_sms(n4)=nad_sms(n4)+1
1909 jdi_sms(nad_sms(j))=n4
1910 nad_sms(j)=nad_sms(j)+1
1911C
1912C-- Type2 crossed connection between main nodes
1913 IF ((t2main_sms(1,j) > 1).AND.(i > j)) THEN
1914 DO k =2,5
1915 DO kk =2,5
1916 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
1917 jsm_sms(nad_sms(t2main_sms(k,i)))=nad_sms(t2main_sms(kk,j))
1918 jsm_sms(nad_sms(t2main_sms(kk,j)))=nad_sms(t2main_sms(k,i))
1919 jdi_sms(nad_sms(t2main_sms(k,i)))=t2main_sms(kk,j)
1920 nad_sms(t2main_sms(k,i))=nad_sms(t2main_sms(k,i))+1
1921 jdi_sms(nad_sms(t2main_sms(kk,j)))=t2main_sms(k,i)
1922 nad_sms(t2main_sms(kk,j))=nad_sms(t2main_sms(kk,j))+1
1923 ENDIF
1924 ENDDO
1925 ENDDO
1926 ENDIF
1927C
1928 END DO
1929 END DO
1930 ELSEIF(nty==2.AND.ilagm==0.AND.(ilev==25.or.ilev==26))THEN
1931 k10=ipari(1,n)
1932 k11=k10+4*ipari(3,n)
1933 k12=k11+4*ipari(4,n)
1934 k13=k12+ipari(5,n)
1935 k14=k13+ipari(6,n)
1936 nsn=ipari(5,n)
1937 DO ii=1,nsn
1938 i=abs(intbuf_tab(n)%NSV(ii))
1939
1940 IF(weight(i)/=1)cycle
1941
1942 l=intbuf_tab(n)%IRTLM(ii)
1943 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1944 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1945 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1946 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1947
1948 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1949 . .AND.nativ_sms(n2)==0
1950 . .AND.nativ_sms(n3)==0
1951 . .AND.nativ_sms(n4)==0) cycle
1952
1953 jsm_sms(nad_sms(n1))=nad_sms(i)
1954 jsm_sms(nad_sms(i)) =nad_sms(n1)
1955 jdi_sms(nad_sms(n1))=i
1956 nad_sms(n1)=nad_sms(n1)+1
1957 jdi_sms(nad_sms(i))=n1
1958 nad_sms(i)=nad_sms(i)+1
1959
1960 jsm_sms(nad_sms(n2))=nad_sms(i)
1961 jsm_sms(nad_sms(i)) =nad_sms(n2)
1962 jdi_sms(nad_sms(n2))=i
1963 nad_sms(n2)=nad_sms(n2)+1
1964 jdi_sms(nad_sms(i))=n2
1965 nad_sms(i)=nad_sms(i)+1
1966
1967 jsm_sms(nad_sms(n3))=nad_sms(i)
1968 jsm_sms(nad_sms(i)) =nad_sms(n3)
1969 jdi_sms(nad_sms(n3))=i
1970 nad_sms(n3)=nad_sms(n3)+1
1971 jdi_sms(nad_sms(i))=n3
1972 nad_sms(i)=nad_sms(i)+1
1973
1974 jsm_sms(nad_sms(n4))=nad_sms(i)
1975 jsm_sms(nad_sms(i)) =nad_sms(n4)
1976 jdi_sms(nad_sms(n4))=i
1977 nad_sms(n4)=nad_sms(n4)+1
1978 jdi_sms(nad_sms(i))=n4
1979 nad_sms(i)=nad_sms(i)+1
1980 END DO
1981 ELSEIF(nty==2.AND.ilagm==0.AND.(ilev==27.or.ilev==28))THEN
1982C
1983 nsn=ipari(5,n)
1984 DO ii=1,nsn
1985 i=abs(intbuf_tab(n)%NSV(ii))
1986 IF (intbuf_tab(n)%IRUPT(ii)==0) THEN
1987C Kinematic node
1988 IF(nodnx_sms(i)/=0) lsmspcg=lsmspcg-1
1989
1990 l=intbuf_tab(n)%IRTLM(ii)
1991 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1992 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1993 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1994 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1995
1996 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1997 . .AND.nativ_sms(n2)==0
1998 . .AND.nativ_sms(n3)==0
1999 . .AND.nativ_sms(n4)==0) cycle
2000
2001 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
2002 j =jdi_sms(kj)
2003
2004 jsm_sms(nad_sms(n1))=nad_sms(j)
2005 jsm_sms(nad_sms(j)) =nad_sms(n1)
2006 jdi_sms(nad_sms(n1))=j
2007 nad_sms(n1)=nad_sms(n1)+1
2008 jdi_sms(nad_sms(j))=n1
2009 nad_sms(j)=nad_sms(j)+1
2010
2011 jsm_sms(nad_sms(n2))=nad_sms(j)
2012 jsm_sms(nad_sms(j)) =nad_sms(n2)
2013 jdi_sms(nad_sms(n2))=j
2014 nad_sms(n2)=nad_sms(n2)+1
2015 jdi_sms(nad_sms(j))=n2
2016 nad_sms(j)=nad_sms(j)+1
2017
2018 jsm_sms(nad_sms(n3))=nad_sms(j)
2019 jsm_sms(nad_sms(j)) =nad_sms(n3)
2020 jdi_sms(nad_sms(n3))=j
2021 nad_sms(n3)=nad_sms(n3)+1
2022 jdi_sms(nad_sms(j))=n3
2023 nad_sms(j)=nad_sms(j)+1
2024
2025 jsm_sms(nad_sms(n4))=nad_sms(j)
2026 jsm_sms(nad_sms(j)) =nad_sms(n4)
2027 jdi_sms(nad_sms(n4))=j
2028 nad_sms(n4)=nad_sms(n4)+1
2029 jdi_sms(nad_sms(j))=n4
2030 nad_sms(j)=nad_sms(j)+1
2031C
2032C-- Type2 crossed connection between main nodes
2033 IF ((t2main_sms(1,j) > 1).AND.(i > j)) THEN
2034 DO k =2,5
2035 DO kk =2,5
2036 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
2037 jsm_sms(nad_sms(t2main_sms(k,i)))=nad_sms(t2main_sms(kk,j))
2038 jsm_sms(nad_sms(t2main_sms(kk,j)))=nad_sms(t2main_sms(k,i))
2039 jdi_sms(nad_sms(t2main_sms(k,i)))=t2main_sms(kk,j)
2040 nad_sms(t2main_sms(k,i))=nad_sms(t2main_sms(k,i))+1
2041 jdi_sms(nad_sms(t2main_sms(kk,j)))=t2main_sms(k,i)
2042 nad_sms(t2main_sms(kk,j))=nad_sms(t2main_sms(kk,j))+1
2043 ENDIF
2044 ENDDO
2045 ENDDO
2046 ENDIF
2047C
2048 END DO
2049 ELSE
2050C Penalty node
2051 IF(weight(i)/=1)cycle
2052
2053 l=intbuf_tab(n)%IRTLM(ii)
2054 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
2055 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
2056 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
2057 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
2058
2059 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
2060 . .AND.nativ_sms(n2)==0
2061 . .AND.nativ_sms(n3)==0
2062 . .AND.nativ_sms(n4)==0) cycle
2063
2064 jsm_sms(nad_sms(n1))=nad_sms(i)
2065 jsm_sms(nad_sms(i)) =nad_sms(n1)
2066 jdi_sms(nad_sms(n1))=i
2067 nad_sms(n1)=nad_sms(n1)+1
2068 jdi_sms(nad_sms(i))=n1
2069 nad_sms(i)=nad_sms(i)+1
2070
2071 jsm_sms(nad_sms(n2))=nad_sms(i)
2072 jsm_sms(nad_sms(i)) =nad_sms(n2)
2073 jdi_sms(nad_sms(n2))=i
2074 nad_sms(n2)=nad_sms(n2)+1
2075 jdi_sms(nad_sms(i))=n2
2076 nad_sms(i)=nad_sms(i)+1
2077
2078 jsm_sms(nad_sms(n3))=nad_sms(i)
2079 jsm_sms(nad_sms(i)) =nad_sms(n3)
2080 jdi_sms(nad_sms(n3))=i
2081 nad_sms(n3)=nad_sms(n3)+1
2082 jdi_sms(nad_sms(i))=n3
2083 nad_sms(i)=nad_sms(i)+1
2084
2085 jsm_sms(nad_sms(n4))=nad_sms(i)
2086 jsm_sms(nad_sms(i)) =nad_sms(n4)
2087 jdi_sms(nad_sms(n4))=i
2088 nad_sms(n4)=nad_sms(n4)+1
2089 jdi_sms(nad_sms(i))=n4
2090 nad_sms(i)=nad_sms(i)+1
2091 ENDIF
2092 END DO
2093 END IF
2094 END DO
2095C------------
2096 DO i=1,numnod
2097 nad_sms_0(i)=nad_sms(i)
2098 END DO
2099C------------
2100 DO i=1,numnod
2101 lad_sms(i)=jad_sms(i) + lad_sms(i) - 1
2102 END DO
2103c DO I=1,NUMNOD
2104c do kj=JAD_SMS(I),JAD_SMS(I+1)-1
2105c print *,i,jdi_sms(kj),jdi_sms(jsm_sms(kj))
2106c end do
2107c END DO
2108C-----------------------------------------------
2109C Check of the symmetrization operator JSM_SMS
2110C-----------------------------------------------
2111 error = 0
2112 DO i=1,numnod
2113 DO ij=jad_sms(i),jad_sms(i+1)-1
2114 j=jdi_sms(ij)
2115 IF(j > i)THEN
2116 ji=jsm_sms(ij)
2117 IF (ij/=jsm_sms(ji)) error = 1
2118 END IF
2119 END DO
2120 END DO
2121C
2122 IF (error==1) THEN
2123 CALL ancmsg(msgid=273,anmode=aninfo)
2124 CALL arret(2)
2125 ENDIF
2126C-----------------------------------------------
2127C COMMUNICATION
2128C-----------------------------------------------
2129 IF(nspmd>1) THEN
2130 SIZE = 1
2131 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2132C
2133C Echange NODNX_SMS
2134C
2135 CALL spmd_exch_nodnx(nodnx_sms,iad_elem ,fr_elem,lenr)
2136 END IF
2137C-----------------------------------------------
2138 nindx1_sms=0
2139 DO i=1,numnod
2140 IF(nodnx_sms(i)/=0)THEN
2141 nindx1_sms=nindx1_sms+1
2142 indx1_sms(nindx1_sms)=i
2143 END IF
2144 END DO
2145 lsmspcg=lsmspcg+nindx1_sms
2146 IF(nspmd>1)
2147 . CALL spmd_allglob_isum9(lsmspcg,1)
2148 nsmspcg=min(nsmspcg,3*lsmspcg)
2149C
2150C------------
2151C CHeck of the symmetrization operator JSM_SMS
2152C------------
2153 error = 0
2154 DO i=1,numnod
2155 DO ij=jad_sms(i),jad_sms(i+1)-1
2156 j=jdi_sms(ij)
2157 IF(j > i)THEN
2158 ji=jsm_sms(ij)
2159 IF (ij/=jsm_sms(ji)) error = 1
2160 END IF
2161 END DO
2162 END DO
2163C
2164 IF (error==1) THEN
2165 CALL ancmsg(msgid=273,anmode=aninfo)
2166 CALL arret(2)
2167 ENDIF
2168C-----------------------------------------------
2169 DEALLOCATE(nad_sms)
2170 DEALLOCATE(nad_sms_0)
2171
2172 RETURN
2173 END
2174!||====================================================================
2175!|| sms_ini_kin_1 ../engine/source/ams/sms_init.F
2176!||--- calls -----------------------------------------------------
2177!|| spmd_allglob_isum9 ../engine/source/mpi/generic/spmd_allglob_isum9.F
2178!|| spmd_frwall_nn ../engine/source/mpi/kinematic_conditions/spmd_frwall_nn.F
2179!|| spmd_glob_imax9 ../engine/source/mpi/generic/spmd_glob_imax9.F
2180!|| spmd_ibcast ../engine/source/mpi/generic/spmd_ibcast.F
2181!|| spmd_sd_cj_2 ../engine/source/mpi/kinematic_conditions/spmd_sd_cj_2.F
2182!||--- uses -----------------------------------------------------
2183!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2184!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
2185!||====================================================================
2186 SUBROUTINE sms_ini_kin_1(
2187 1 NODNX_SMS ,INDX1_SMS ,ILINK ,RLINK ,NNLINK ,
2188 2 LNLINK ,TAG_LNK_SMS,FR_LL ,FR_RL ,WEIGHT ,
2189 3 ITAB ,LJOINT ,IADCJ ,FR_CJ ,NPRW ,
2190 4 LPRW ,FR_WALL ,NRWL_SMS ,IAD_ELEM ,FR_ELEM ,
2191 5 INTBUF_TAB )
2192C-----------------------------------------------
2193C M o d u l e s
2194C-----------------------------------------------
2195 USE intbufdef_mod
2196 USE my_alloc_mod
2197C-----------------------------------------------
2198C I m p l i c i t T y p e s
2199C-----------------------------------------------
2200#include "implicit_f.inc"
2201C-----------------------------------------------
2202C C o m m o n B l o c k s
2203C-----------------------------------------------
2204#include "com01_c.inc"
2205#include "com04_c.inc"
2206#include "scr03_c.inc"
2207#include "sms_c.inc"
2208#include "task_c.inc"
2209C-----------------------------------------------
2210C D u m m y A r g u m e n t s
2211C-----------------------------------------------
2212 INTEGER
2213 . NODNX_SMS(*), INDX1_SMS(*),
2214 . ilink(*), rlink(*), nnlink(10,*), lnlink(*),
2215 . tag_lnk_sms(*), fr_ll(nspmd+2,*), fr_rl(nspmd+2,*),
2216 . weight(*), itab(*), ljoint(*), fr_cj(*),iadcj(nspmd+1,*)
2217 INTEGER NPRW(*), LPRW(*), FR_WALL(NSPMD+2,*) ,NRWL_SMS(*),
2218 . IAD_ELEM(2,*), FR_ELEM(*)
2219 TYPE(intbuf_struct_) INTBUF_TAB(*)
2220C REAL
2221C-----------------------------------------------
2222C L o c a l V a r i a b l e s
2223C-----------------------------------------------
2224 INTEGER K1, K, I, N, J, IC, NSN, ISMS,
2225 . icsize, imov, ityp, ilagm, icount
2226 INTEGER
2227 . nlins, nlinm, ii, SIZE, lenr
2228 my_real
2229 . idmax,id
2230 INTEGER,DIMENSION(:),ALLOCATABLE :: NOD2ADD
2231 INTEGER,DIMENSION(:),ALLOCATABLE :: TAG
2232C-----------------------------------------------
2233 CALL my_alloc(nod2add,numnod)
2234 CALL my_alloc(tag,numnod)
2235C-----------------------------------------------
2236C
2237 nod2add(1:numnod)=0
2238C
2239 IF(nrlink/=0)THEN
2240 k = 1
2241 DO i=1,nrlink
2242
2243 k1=4*i-3
2244 ic=ilink(k1+1)
2245 IF(ic==0) cycle
2246 nsn = ilink(k1)
2247
2248
2249 idmax=0
2250 DO j=1,nsn
2251 n=rlink(k+j-1)
2252 IF(weight(n)==1)THEN
2253 id=itab(n)
2254 idmax=max(idmax,id)
2255 END IF
2256 END DO
2257
2258 IF(nspmd > 1) THEN
2259 CALL spmd_glob_imax9(idmax,1)
2260 CALL spmd_ibcast(idmax,idmax,1,1,0,2)
2261 END IF
2262
2263 tag_lnk_sms(i)=-idmax
2264
2265 isms=0
2266 DO j=1,nsn
2267 n=rlink(k+j-1)
2268 IF(nodnx_sms(n)/=0)THEN
2269 isms=1
2270 EXIT
2271 END IF
2272 END DO
2273
2274 IF(nspmd > 1) CALL spmd_allglob_isum9(isms,1)
2275
2276 IF(isms/=0) tag_lnk_sms(i) = abs(tag_lnk_sms(i))
2277
2278 IF(isms/=0)THEN
2279C
2280C propagate AMS to all nodes of the rlink
2281 DO j=1,nsn
2282 n=rlink(k+j-1)
2283 IF(nodnx_sms(n)==0.AND.nod2add(n)==0)THEN
2284 nindx1_sms=nindx1_sms+1
2285 indx1_sms(nindx1_sms)=n
2286 nod2add(n)=1
2287 END IF
2288 END DO
2289C
2290 END IF
2291 k = k + nsn
2292 END DO
2293 END IF
2294C-----------------------------------------------
2295 IF(nlink/=0)THEN
2296 k = 1
2297 DO i=1,nlink
2298 ic=nnlink(3,i)
2299 IF(ic==0) cycle
2300 nsn = nnlink(1,i)
2301
2302
2303 idmax=zero
2304 DO j=1,nsn
2305 n=lnlink(k+j-1)
2306 IF(weight(n)==1)THEN
2307 id=itab(n)
2308 idmax=max(idmax,id)
2309 END IF
2310 END DO
2311
2312 IF(nspmd > 1) THEN
2313 CALL spmd_glob_imax9(idmax,1)
2314 CALL spmd_ibcast(idmax,idmax,1,1,0,2)
2315 END IF
2316
2317 tag_lnk_sms(nrlink+i)=-idmax
2318
2319 isms=0
2320 DO j=1,nsn
2321 n=lnlink(k+j-1)
2322 IF(nodnx_sms(n)/=0)THEN
2323 isms=1
2324 EXIT
2325 END IF
2326 END DO
2327
2328 IF(nspmd > 1) CALL spmd_allglob_isum9(isms,1)
2329
2330 IF(isms/=0) tag_lnk_sms(nrlink+i) = abs(tag_lnk_sms(nrlink+i))
2331
2332 IF(isms/=0)THEN
2333C
2334C propagate AMS to all nodes of the rlink
2335 DO j=1,nsn
2336 n=lnlink(k+j-1)
2337 IF(nodnx_sms(n)==0.AND.nod2add(n)==0)THEN
2338 nindx1_sms=nindx1_sms+1
2339 indx1_sms(nindx1_sms)=n
2340 nod2add(n)=1
2341 END IF
2342 END DO
2343C
2344 END IF
2345 k = k + nsn
2346 END DO
2347 END IF
2348C-----------------------------------------------
2349 IF(njoint/=0)THEN
2350 IF(ispmd==0)THEN
2351 k=1
2352 DO j=1,njoint
2353 nsn=ljoint(k)
2354 isms=0
2355 DO i=1,nsn
2356 n=ljoint(k+i)
2357 IF(nodnx_sms(n)/=0)THEN
2358 isms=1
2359 EXIT
2360 END IF
2361 END DO
2362
2363 tag_lnk_sms(nrlink+nlink+j)=isms
2364
2365 k=k+nsn+1
2366 END DO
2367 END IF
2368
2369 IF(nspmd > 1)
2370 . CALL spmd_ibcast(tag_lnk_sms(nrlink+nlink+1),
2371 . tag_lnk_sms(nrlink+nlink+1),njoint,1,0,2)
2372
2373 IF(nspmd==1)THEN
2374 k=1
2375 DO j=1,njoint
2376 isms=tag_lnk_sms(nrlink+nlink+j)
2377 IF(isms/=0)THEN
2378 nsn=ljoint(k)
2379 DO i=1,nsn
2380 n=ljoint(k+i)
2381 IF(nodnx_sms(n)==0.AND.nod2add(n)==0)THEN
2382 nindx1_sms=nindx1_sms+1
2383 indx1_sms(nindx1_sms)=n
2384 nod2add(n)=1
2385 END IF
2386 END DO
2387 END IF
2388 k=k+nsn+1
2389 END DO
2390 ELSE
2391 IF(ispmd==0)THEN
2392 k=1
2393 DO j=1,njoint
2394 isms=tag_lnk_sms(nrlink+nlink+j)
2395 IF(isms/=0)THEN
2396 nsn=ljoint(k)
2397 DO i=1,nsn
2398 n=ljoint(k+i)
2399 IF(nodnx_sms(n)==0.AND.nod2add(n)==0)THEN
2400 nindx1_sms=nindx1_sms+1
2401 indx1_sms(nindx1_sms)=n
2402 nod2add(n)=1
2403 END IF
2404 END DO
2405 END IF
2406 k=k+nsn+1
2407 END DO
2408 END IF
2409 icsize=0
2410 DO n=1,njoint
2411 IF(tag_lnk_sms(nrlink+nlink+n)/=0)
2412 . icsize=icsize+iadcj(nspmd+1,n)-iadcj(1,n)
2413 END DO
2414 CALL spmd_sd_cj_2(nod2add,ljoint,fr_cj,iadcj,icsize,
2415 . tag_lnk_sms(nrlink+nlink+1),nodnx_sms,
2416 . indx1_sms)
2417 END IF
2418 END IF
2419C-----------------------------------------------
2420 DO n=1,numnod
2421 IF(nod2add(n)/=0)nodnx_sms(n)=1
2422 END DO
2423C-----------------------------------------------
2424C list of sms nodes of the wall in NRWL_SMS (non-optimized memory).
2425 IF(nrwall/=0)THEN
2426 k = 1
2427 DO n=1,nrwall
2428 nsn=nprw(n)
2429 icount =k
2430 imov =nprw(2*nrwall+n)
2431 ityp =nprw(3*nrwall+n)
2432 ilagm=nprw(5*nrwall+n)
2433 IF(ilagm==0)THEN
2434 DO j=1,nsn
2435 i=lprw(k+j-1)
2436 IF(nodnx_sms(i)/=0)THEN
2437 nrwl_sms(icount)=j
2438 icount=icount+1
2439 END IF
2440 END DO
2441 END IF
2442C number of sms nodes in the wall.
2443 nprw(6*nrwall+n)=icount-k
2444C for sms_fixvel, etc
2445 IF(imov /= 0)THEN
2446 nod2add(imov)=0
2447 IF(icount > k.AND.nodnx_sms(imov)==0)nod2add(imov)=1
2448 IF(nspmd > 1)
2449 . CALL spmd_frwall_nn(fr_wall(1,n),nod2add(imov))
2450 IF(nod2add(imov)/=0)THEN
2451 nindx1_sms=nindx1_sms+1
2452 indx1_sms(nindx1_sms)=imov
2453 END IF
2454 END IF
2455 k =k+nsn
2456 END DO
2457 END IF
2458C-----------------------------------------------
2459 DEALLOCATE(nod2add)
2460 DEALLOCATE(tag)
2461C-----------------------------------------------
2462 RETURN
2463 END
2464!||====================================================================
2465!|| sms_ini_kin_2 ../engine/source/ams/sms_init.F
2466!||--- called by ------------------------------------------------------
2467!|| resol ../engine/source/engine/resol.F
2468!||--- calls -----------------------------------------------------
2469!|| spmd_glob_imax9 ../engine/source/mpi/generic/spmd_glob_imax9.F
2470!|| spmd_ibcast ../engine/source/mpi/generic/spmd_ibcast.F
2471!||====================================================================
2472 SUBROUTINE sms_ini_kin_2(
2473 1 ILINK ,RLINK ,NNLINK ,LNLINK ,TAG_LNK_SMS,
2474 2 FR_LL ,FR_RL ,WEIGHT ,ITAB ,LJOINT ,
2475 3 IADCJ ,FR_CJ ,NPRW ,LPRW ,FR_WALL ,
2476 4 NRWL_SMS ,IAD_ELEM ,FR_ELEM )
2477C-----------------------------------------------
2478C I m p l i c i t T y p e s
2479C-----------------------------------------------
2480#include "implicit_f.inc"
2481C-----------------------------------------------
2482C C o m m o n B l o c k s
2483C-----------------------------------------------
2484#include "com01_c.inc"
2485#include "com04_c.inc"
2486#include "scr03_c.inc"
2487C-----------------------------------------------
2488C D u m m y A r g u m e n t s
2489C-----------------------------------------------
2490 INTEGER
2491 . ilink(*), rlink(*), nnlink(10,*), lnlink(*),
2492 . tag_lnk_sms(*), fr_ll(nspmd+2,*), fr_rl(nspmd+2,*),
2493 . weight(*), itab(*), ljoint(*), fr_cj(*),iadcj(nspmd+1,*)
2494 INTEGER NPRW(*), LPRW(*), FR_WALL(NSPMD+2,*) ,NRWL_SMS(*),
2495 . iad_elem(2,*), fr_elem(*)
2496C REAL
2497C-----------------------------------------------
2498C L o c a l V a r i a b l e s
2499C-----------------------------------------------
2500 INTEGER K1, K, I, N, J, IC, NSN
2501 my_real
2502 . idmax,id
2503C-----------------------------------------------
2504 IF(nrlink/=0)THEN
2505 k = 1
2506 DO i=1,nrlink
2507
2508 k1=4*i-3
2509 ic=ilink(k1+1)
2510 IF(ic==0) cycle
2511 nsn = ilink(k1)
2512
2513 idmax=0
2514 DO j=1,nsn
2515 n=rlink(k+j-1)
2516 IF(weight(n)==1)THEN
2517 id=itab(n)
2518 idmax=max(idmax,id)
2519 END IF
2520 END DO
2521
2522 IF(nspmd > 1) THEN
2523 CALL spmd_glob_imax9(idmax,1)
2524 CALL spmd_ibcast(idmax,idmax,1,1,0,2)
2525 END IF
2526
2527 tag_lnk_sms(i)=-idmax
2528
2529 k = k + nsn
2530 END DO
2531 END IF
2532C-----------------------------------------------
2533 IF(nlink/=0)THEN
2534 k = 1
2535 DO i=1,nlink
2536 ic=nnlink(3,i)
2537 IF(ic==0) cycle
2538 nsn = nnlink(1,i)
2539
2540 idmax=zero
2541 DO j=1,nsn
2542 n=lnlink(k+j-1)
2543 IF(weight(n)==1)THEN
2544 id=itab(n)
2545 idmax=max(idmax,id)
2546 END IF
2547 END DO
2548
2549 IF(nspmd > 1) THEN
2550 CALL spmd_glob_imax9(idmax,1)
2551 CALL spmd_ibcast(idmax,idmax,1,1,0,2)
2552 END IF
2553
2554 tag_lnk_sms(nrlink+i)=-idmax
2555
2556 k = k + nsn
2557 END DO
2558 END IF
2559C-----------------------------------------------
2560 RETURN
2561 END
2562!||====================================================================
2563!|| sms_ini_int ../engine/source/ams/sms_init.F
2564!||--- called by ------------------------------------------------------
2565!|| resol ../engine/source/engine/resol.F
2566!||--- calls -----------------------------------------------------
2567!|| spmd_exch_icont ../engine/source/mpi/nodes/spmd_exch_icont.F
2568!|| spmd_exch_smst2 ../engine/source/mpi/ams/spmd_exch_smst2.F
2569!||--- uses -----------------------------------------------------
2570!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2571!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
2572!||====================================================================
2573 SUBROUTINE sms_ini_int(
2574 1 IPARI ,INTBUF_TAB ,IAD_ELEM ,FR_ELEM ,INTLIST,
2575 2 NBINTC)
2576C-----------------------------------------------
2577C M o d u l e s
2578C-----------------------------------------------
2579 USE intbufdef_mod
2580 USE my_alloc_mod
2581C-----------------------------------------------
2582C I m p l i c i t T y p e s
2583C-----------------------------------------------
2584#include "implicit_f.inc"
2585C-----------------------------------------------
2586C C o m m o n B l o c k s
2587C-----------------------------------------------
2588#include "com01_c.inc"
2589#include "com04_c.inc"
2590#include "param_c.inc"
2591C-----------------------------------------------
2592C D u m m y A r g u m e n t s
2593C-----------------------------------------------
2594 INTEGER IPARI(NPARI,*), IAD_ELEM(2,*), FR_ELEM(*)
2595 INTEGER INTLIST(*),NBINTC
2596C REAL
2597 TYPE(intbuf_struct_) INTBUF_TAB(*)
2598C-----------------------------------------------
2599C L o c a l V a r i a b l e s
2600C-----------------------------------------------
2601 INTEGER N, J
2602 INTEGER NTY, ILEV, NSN, NMN, NRTS, NRTM,
2603 . nlins, nlinm, ii, SIZE, lenr
2604 INTEGER,DIMENSION(:), ALLOCATABLE :: TAG
2605C-----------------------------------------------
2606 CALL my_alloc(tag,numnod)
2607C-----------------------------------------------
2608C supprime nds d'interf type 2 des interfs a penalty
2609C /DT/AMS or /DT/INTER/AMS
2610C
2611 tag(1:numnod)=0
2612 DO n=1,ninter
2613 nty=ipari(7,n)
2614 ilev = ipari(20,n)
2615 IF(nty==2 .AND. ilev/=25 .and. ilev /= 26)THEN
2616 nrts =ipari(3,n)
2617 nrtm =ipari(4,n)
2618 nsn =ipari(5,n)
2619 nmn =ipari(6,n)
2620 ilev =ipari(20,n)
2621C
2622 DO ii=1,nsn
2623 j=intbuf_tab(n)%NSV(ii)
2624 IF ((ilev==27.OR.ilev==28).AND.intbuf_tab(n)%IRUPT(ii)==1) cycle
2625 tag(j)=1
2626 ENDDO
2627 ENDIF
2628 ENDDO
2629C
2630 IF(nspmd > 1) THEN
2631 SIZE = 1
2632 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2633 CALL spmd_exch_icont(tag,iad_elem ,fr_elem,SIZE,lenr)
2634 CALL spmd_exch_smst2(ipari,tag,intlist,nbintc,intbuf_tab)
2635 END IF
2636C
2637 DO n=1,ninter
2638 nty=ipari(7,n)
2639 nsn =ipari(5,n)
2640 nrts =ipari(3,n)
2641 nrtm =ipari(4,n)
2642 IF(nty==7.OR.nty==10.OR.nty==20.OR.nty==25)THEN
2643 DO ii=1,nsn
2644 j=intbuf_tab(n)%NSV(ii)
2645 IF(tag(j)/=0) THEN
2646 intbuf_tab(n)%STFNS(ii) = zero
2647 END IF
2648 END DO
2649 DO ii=1,nrtm
2650 j=intbuf_tab(n)%IRECTM(4*(ii-1)+1)
2651 IF(tag(j)/=0)THEN
2652 intbuf_tab(n)%STFM(ii)=zero
2653 END IF
2654 j=intbuf_tab(n)%IRECTM(4*(ii-1)+2)
2655 IF(tag(j)/=0)THEN
2656 intbuf_tab(n)%STFM(ii)=zero
2657 END IF
2658 j=intbuf_tab(n)%IRECTM(4*(ii-1)+3)
2659 IF(tag(j)/=0)THEN
2660 intbuf_tab(n)%STFM(ii)=zero
2661 END IF
2662 j=intbuf_tab(n)%IRECTM(4*(ii-1)+4)
2663 IF(tag(j)/=0)THEN
2664 intbuf_tab(n)%STFM(ii)=zero
2665 END IF
2666 END DO
2667 IF(nty==20)THEN
2668 nlins =ipari(51,n)
2669 nlinm =ipari(52,n)
2670 IF(nlins+nlinm /= 0)THEN
2671 DO ii=1,nlins
2672 j=intbuf_tab(n)%IXLINS(2*(ii-1)+1)
2673 IF(tag(j)/=0)THEN
2674 intbuf_tab(n)%STFS(ii) = zero
2675 END IF
2676 j=intbuf_tab(n)%IXLINS(2*(ii-1)+2)
2677 IF(tag(j)/=0)THEN
2678 intbuf_tab(n)%STFS(ii) = zero
2679 END IF
2680 END DO
2681 DO ii=1,nlinm
2682 j=intbuf_tab(n)%IXLINM(2*(ii-1)+1)
2683 IF(tag(j)/=0)THEN
2684 intbuf_tab(n)%STF(ii) = zero
2685 END IF
2686 j=intbuf_tab(n)%IXLINM(2*(ii-1)+2)
2687 IF(tag(j)/=0)THEN
2688 intbuf_tab(n)%STF(ii) = zero
2689 END IF
2690 END DO
2691 END IF
2692 END IF
2693 ELSEIF(nty==11)THEN
2694 DO ii=1,nrts
2695 j=intbuf_tab(n)%IRECTS(2*(ii-1)+1)
2696 IF(tag(j)/=0)THEN
2697 intbuf_tab(n)%STFS(ii) = zero
2698 END IF
2699 j=intbuf_tab(n)%IRECTS(2*(ii-1)+2)
2700 IF(tag(j)/=0)THEN
2701 intbuf_tab(n)%STFS(ii) = zero
2702 END IF
2703 END DO
2704 DO ii=1,nrtm
2705 j=intbuf_tab(n)%IRECTM(2*(ii-1)+1)
2706 IF(tag(j)/=0)THEN
2707 intbuf_tab(n)%STFM(ii) = zero
2708 END IF
2709 j=intbuf_tab(n)%IRECTM(2*(ii-1)+2)
2710 IF(tag(j)/=0)THEN
2711 intbuf_tab(n)%STFM(ii) = zero
2712 END IF
2713 END DO
2714 ELSEIF(nty==21)THEN
2715 DO ii=1,nsn
2716 j=intbuf_tab(n)%NSV(ii)
2717 IF(tag(j)/=0) THEN
2718 intbuf_tab(n)%STFNS(ii) = zero
2719 END IF
2720 END DO
2721 END IF
2722 END DO
2723C-----------------------------------------------
2724 DEALLOCATE(tag)
2725 RETURN
2726 END
2727!||====================================================================
2728!|| sms_ini_err ../engine/source/ams/sms_init.F
2729!||--- called by ------------------------------------------------------
2730!|| resol ../engine/source/engine/resol.F
2731!||--- calls -----------------------------------------------------
2732!|| ancmsg ../engine/source/output/message/message.f
2733!|| arret ../engine/source/system/arret.F
2734!|| spmd_allglob_isum9 ../engine/source/mpi/generic/spmd_allglob_isum9.F
2735!||--- uses -----------------------------------------------------
2736!|| message_mod ../engine/share/message_module/message_mod.F
2737!||====================================================================
2738 SUBROUTINE sms_ini_err(NPRW ,LPRW ,KINET )
2739C-----------------------------------------------
2740C M o d u l e s
2741C-----------------------------------------------
2742 USE message_mod
2743C-----------------------------------------------
2744C I m p l i c i t T y p e s
2745C-----------------------------------------------
2746#include "implicit_f.inc"
2747#include "comlock.inc"
2748C-----------------------------------------------
2749C C o m m o n B l o c k s
2750C-----------------------------------------------
2751#include "com04_c.inc"
2752#include "kincod_c.inc"
2753#include "task_c.inc"
2754C-----------------------------------------------
2755C D u m m y A r g u m e n t s
2756C-----------------------------------------------
2757 INTEGER
2758 . kinet(*), nprw(*), lprw(*)
2759C-----------------------------------------------
2760C L o c a l V a r i a b l e s
2761C-----------------------------------------------
2762 INTEGER I,
2763 . n1, n2, n3, n4, n5, n6
2764 INTEGER ISMS, IERR
2765C-----------------------------------------------
2766C
2767 ierr=0
2768C
2769C-----
2770 isms=0
2771 DO i=1,numnod
2772 IF(irv(kinet(i))/=0)THEN
2773 isms=1
2774 END IF
2775 END DO
2776 CALL spmd_allglob_isum9(isms,1)
2777 IF(isms/=0)THEN
2778 IF(ispmd==0)THEN
2779 CALL ancmsg(msgid=22,anmode=aninfo_blind,
2780 . c1='RIVETS')
2781 END IF
2782 ierr=1
2783 END IF
2784C
2785C-----
2786 isms=0
2787 DO i=1,numnod
2788 IF(ilmult(kinet(i))/=0)THEN
2789 isms=1
2790 END IF
2791 END DO
2792 CALL spmd_allglob_isum9(isms,1)
2793 IF(isms/=0)THEN
2794 IF(ispmd==0)THEN
2795 CALL ancmsg(msgid=22,anmode=aninfo_blind,
2796 . c1='LAGRANGE MULTIPLIERS')
2797 END IF
2798 ierr=1
2799 END IF
2800C
2801C-----------------------------------------------
2802 IF(ierr/=0) CALL arret(2)
2803 RETURN
2804 END
my_real
#define my_real
Definition cppsort.cpp:32
nodnx_sms_ini
subroutine nodnx_sms_ini(numnod, numel, nix, mix, lix, ix, ipartx, tagprt_sms, nodnx_sms)
Definition sms_init.F:555
sms_ini_err
subroutine sms_ini_err(nprw, lprw, kinet)
Definition sms_init.F:2739
sms_ini_kin_1
subroutine sms_ini_kin_1(nodnx_sms, indx1_sms, ilink, rlink, nnlink, lnlink, tag_lnk_sms, fr_ll, fr_rl, weight, itab, ljoint, iadcj, fr_cj, nprw, lprw, fr_wall, nrwl_sms, iad_elem, fr_elem, intbuf_tab)
Definition sms_init.F:2192
sms_ini_rby
subroutine sms_ini_rby(kinet, nprw, lprw, npby, lpby, tagmsr_rby_sms, tagslv_rby_sms)
Definition sms_init.F:102
sms_ini_jad_1
subroutine sms_ini_jad_1(ixc, iparg, ixs, ixt, ixp, ixr, ixtg, ixs10, nodnx_sms, jadc_sms, jads_sms, jads10_sms, jadt_sms, jadp_sms, jadr_sms, jadtg_sms, indx1_sms, tagprt_sms, kad_sms, kdi_sms, pk_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, ipartx, iad_elem, fr_elem, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, irect, lad_sms, ipart, igeo, weight, nativ_sms, iad_sms, idi_sms, jad_sms, jdi_sms, t2main_sms)
Definition sms_init.F:1062
sms_ini_jad_2
subroutine sms_ini_jad_2(ixc, iparg, ixs, ixt, ixp, ixr, ixtg, ixs10, nodnx_sms, jadc_sms, jads_sms, jads10_sms, jadt_sms, jadp_sms, jadr_sms, jadtg_sms, indx1_sms, tagprt_sms, kad_sms, kdi_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, ipartx, iad_elem, fr_elem, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, irect, lad_sms, nprw, lprw, tagmsr_rby_sms, tagslv_i21_sms, tagmsr_i21_sms, jadi21_sms, intstamp, ipart, igeo, weight, nativ_sms, irbe2, lrbe2, iad_sms, idi_sms, jad_sms, jdi_sms, t2main_sms)
Definition sms_init.F:1414
sms_ini_kdi
subroutine sms_ini_kdi(ixc, iparg, ixs, ixt, ixp, ixr, ixtg, ixs10, nodnx_sms, kad_sms, kdi_sms, jadc_sms, jads_sms, jads10_sms, jadt_sms, jadp_sms, jadr_sms, jadtg_sms, indx1_sms, tagprt_sms, iad_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, ipartx, iad_elem, fr_elem, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, irect, lad_sms, ipart, igeo, weight, nativ_sms)
Definition sms_init.F:624
sms_ini_kad
subroutine sms_ini_kad(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs16, ixs20, iparg, ms, ms0, nodnx_sms, icodt, icodr, kinet, indx1_sms, kad_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, ipartx, tagprt_sms, tagrel_sms, itab, weight, irbe2, irbe3, lrbe2, lrbe3, iad_elem, fr_elem, nprw, lprw, ipart, igeo, nativ_sms)
Definition sms_init.F:214
sms_ini_int
subroutine sms_ini_int(ipari, intbuf_tab, iad_elem, fr_elem, intlist, nbintc)
Definition sms_init.F:2576
sms_ini_kin_2
subroutine sms_ini_kin_2(ilink, rlink, nnlink, lnlink, tag_lnk_sms, fr_ll, fr_rl, weight, itab, ljoint, iadcj, fr_cj, nprw, lprw, fr_wall, nrwl_sms, iad_elem, fr_elem)
Definition sms_init.F:2477
sms_ini_jad_3
subroutine sms_ini_jad_3(ixc, iparg, ixs, ixt, ixp, ixr, ixtg, ixs10, nodnx_sms, jadc_sms, jads_sms, jads10_sms, jadt_sms, jadp_sms, jadr_sms, jadtg_sms, indx1_sms, tagprt_sms, kad_sms, kdi_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, ipartx, iad_elem, fr_elem, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, irect, lad_sms, jsm_sms, tagslv_i21_sms, intstamp, ipart, igeo, tagmsr_rby_sms, weight, nativ_sms, iad_sms, idi_sms, jad_sms, jdi_sms, t2main_sms)
Definition sms_init.F:1737
sms_ini_part
subroutine sms_ini_part(igrpart, tagprt_sms)
Definition sms_init.F:35
startimeg
subroutine startimeg(ng)
Definition timer.F:1371
stoptimeg
subroutine stoptimeg(ng)
Definition timer.F:1419
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
groupdef_mod
Definition groupdef_mod.F:668
intstamp_mod
Definition intstamp_mod.F:38
message_mod
Definition message_mod.F:1257
spmd_allglob_isum9
subroutine spmd_allglob_isum9(v, len)
Definition spmd_allglob_isum9.F:46
spmd_exch_icont
subroutine spmd_exch_icont(icontact, iad_elem, fr_elem, size, lenr)
Definition spmd_exch_icont.F:34
spmd_exch_nodnx
subroutine spmd_exch_nodnx(nodnx_sms, iad_elem, fr_elem, lenr)
Definition spmd_exch_nodnx.F:33
spmd_exch_smst2
subroutine spmd_exch_smst2(ipari, tag, intlist, nbintc, intbuf_tab)
Definition spmd_exch_smst2.F:40
spmd_frwall_nn
subroutine spmd_frwall_nn(fr_wall, iwadd)
Definition spmd_frwall_nn.F:34
spmd_glob_imax9
subroutine spmd_glob_imax9(v, len)
Definition spmd_glob_imax9.F:36
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57
spmd_sd_cj_2
subroutine spmd_sd_cj_2(nod2add, ljoint, fr_cj, iadcj, icsize, tag_lnk_sms, nodnx_sms, indx1_sms)
Definition spmd_sd_cj_2.F:35
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
intstamp_mod::intstamp_data
Definition intstamp_mod.F:46