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_init ../starter/source/ams/sms_init.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!|| nodnx_sms_ini ../starter/source/ams/sms_init.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../starter/share/message_module/message_mod.f
33!||====================================================================
34 SUBROUTINE sms_init(
35 1 IXS ,IXQ ,IXC ,IXT ,IXP ,
36 2 IXR ,IXTG ,IXTG1 ,IXS10 ,IXS16 ,
37 3 IXS20 ,IPARG ,NODNX_SMS ,
38 4 ICODT ,ICODR ,KINET ,
39 5 IPARTS ,IPARTQ ,IPARTC ,
40 6 IPARTT ,IPARTP ,IPARTR ,IPARTTG ,
41 7 IPARTX ,TAGPRT_SMS,ITAB ,IRBE2 ,
42 8 IRBE3 ,LRBE2 ,LRBE3 ,NPRW ,LPRW ,
43 9 IPART ,IGEO ,IPM ,NATIV_SMS,NPBY ,
44 A LPBY ,TAGMSR_RBY_SMS,TAGSLV_RBY_SMS,NOM_OPT )
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE message_mod
49 USE names_and_titles_mod , ONLY : nchartitle
50 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com04_c.inc"
59#include "kincod_c.inc"
60#include "param_c.inc"
61#include "units_c.inc"
62#include "scr17_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER
67 . IXS(NIXS,*),IXS10(6,*) ,IXS16(6,*) ,IXS20(12,*),
68 . IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
69 . IXR(NIXR,*), IXTG(NIXTG,*), IXTG1(4,*),
70 . IPARG(NPARG,*),
71 . NODNX_SMS(*), ICODT(*), ICODR(*), KINET(*),
72 . IPARTS(*),IPARTQ(*),IPARTC(*),IPARTT(*),
73 . IPARTP(*),IPARTR(*),IPARTTG(*),IPARTX(*),
74 . TAGPRT_SMS(*),
75 . ITAB(*),
76 . irbe2(nrbe2l,*), irbe3(nrbe3l,*), lrbe2(*), lrbe3(*),
77 . nprw(*), lprw(*),
78 . ipart(lipart1,*), igeo(npropgi,*), ipm(npropmi,*), nativ_sms(*),
79 . npby(nnpby,*), lpby(*), tagmsr_rby_sms(*), tagslv_rby_sms(*)
80 INTEGER NOM_OPT(LNOPT1,*)
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 INTEGER I, J, K, NG, N, JJ, KK, ITY, NEL, NFT, ISOLNOD,
85 . IAD, IP, NAD_SMS(NUMNOD),ILOC4(4),IWORK(NUMNOD),
86 . TAG8(8), IG, IGTYP, ILW, IRIGID
87 INTEGER SIZE, LENR, KSMS1, NM, NS, IMOV, NSN, ILAGM,
88 . N2, N3, N4, N5, N6
89 INTEGER M, MSR, KI, NSMS(2), IWSMS, NSNW, NHI
90 INTEGER J1, IPERM1(6), IPERM2(6),IPENTA6(6)
91 CHARACTER(len=nchartitle) :: TITR
92 DATA ILOC4/1,3,6,5/
93 DATA IPERM1/1,2,3,1,2,3/
94 DATA iperm2/2,3,1,4,4,4/
95 DATA ipenta6/1,2,3,5,6,7/
96C-----------------------------------------------
97 irigid=0
98 DO i=1,nummat
99 ilw=ipm(2,i)
100 IF(ilw==13)THEN
101 irigid=1
102 EXIT
103 END IF
104 END DO
105 IF(irigid/=0)THEN
106 CALL ancmsg(msgid=1067,msgtype=msgerror,anmode=aninfo_blind_1)
107 END IF
108
109 DO i=1,numnod
110 nodnx_sms(i)=0
111 ENDDO
112C
113C Construction
114 CALL nodnx_sms_ini(numnod ,numelt ,nixt ,1 ,2 ,
115 1ixt ,ipartt,tagprt_sms,nativ_sms)
116 CALL nodnx_sms_ini(numnod ,numelp ,nixp ,1 ,2 ,
117 1ixp ,ipartp,tagprt_sms,nativ_sms)
118 CALL nodnx_sms_ini(numnod ,numelr ,nixr ,1 ,2 ,
119 1ixr ,ipartr,tagprt_sms,nativ_sms)
120C
121C pulleys
122 DO j=1,numelr
123 IF(tagprt_sms(ipartr(j))==0) cycle
124 ig = ipart(2,ipartr(j))
125 igtyp = igeo(11,ig)
126
127 IF(igtyp==12)THEN
128 k=2
129 i = ixr(1+k,j)
130 nativ_sms(i)=nativ_sms(i)+1
131 k=3
132 i = ixr(1+k,j)
133 nativ_sms(i)=nativ_sms(i)+1
134 END IF
135 ENDDO
136 CALL nodnx_sms_ini(numnod ,numeltg,nixtg,1 ,3 ,
137 1ixtg,iparttg,tagprt_sms,nativ_sms)
138 CALL nodnx_sms_ini(numnod ,numelc ,nixc ,1 ,4 ,
139 1ixc ,ipartc,tagprt_sms,nativ_sms)
140 CALL nodnx_sms_ini(numnod ,numels ,nixs ,1 ,8 ,
141 1ixs ,iparts,tagprt_sms,nativ_sms)
142 CALL nodnx_sms_ini(numnod ,numels10,6 ,0 ,6 ,
143 1ixs10 ,iparts(numels8+1),tagprt_sms,nativ_sms)
144 CALL nodnx_sms_ini(numnod ,numels16,8 ,0 ,8 ,
145 1ixs16 ,iparts(numels8+numels10+numels20+1),tagprt_sms,nativ_sms)
146 CALL nodnx_sms_ini(numnod ,numels20,12,0 ,12,
147 1ixs20 ,iparts(numels8+numels10+1),tagprt_sms,nativ_sms)
148C-----------------------------------------------
149C Warnings KINEMATIC CONDITIONS
150C-----------------------------------------------
151C
152 ksms1=0
153 DO i=1,numnod
154 IF(nativ_sms(i)/=0)THEN
155 IF(irv(kinet(i))/=0.OR.
156 . ilmult(kinet(i))/=0)THEN
157 ksms1=1
158 nativ_sms(i)=0
159 END IF
160 END IF
161 END DO
162C
163 IF(ksms1/=0)THEN
164 ng=0
165 DO i=1,numnod
166 IF (nativ_sms(i)/=0.AND.
167 . irv(kinet(i))/=0) THEN
168 ng = ng + 1
169 iwork(ng) = itab(i)
170 ENDIF
171 ENDDO
172 IF(ng/=0)THEN
173 WRITE(istdo,'(A)')
174 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION'
175 WRITE(iout,'(A)')
176 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION :'
177 WRITE(iout,'(A,/,A)')
178 .' AMS WILL NOT APPLY ON NODES WHERE A RIVET APPLIES',
179 .' NODE IDS='
180 WRITE(iout,'(10I10)')(iwork(i),i=1,ng)
181 END IF
182
183 ng=0
184 DO i=1,numnod
185 IF (nativ_sms(i)/=0.AND.
186 . ilmult(kinet(i))/=0) THEN
187 ng = ng + 1
188 iwork(ng) = itab(i)
189 ENDIF
190 ENDDO
191 IF(ng/=0)THEN
192 WRITE(istdo,'(A)')
193 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION'
194 WRITE(iout,'(A)')
195 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION :'
196 WRITE(iout,'(A,/,A)')
197 .' AMS WILL NOT APPLY ON NODES WHERE A LAGRANGE OPTION APPLIES',
198 .' NODE IDS='
199 WRITE(iout,'(10I10)')(iwork(i),i=1,ng)
200 END IF
201
202 END IF
203C-----
204 ksms1=0
205 IF(nrwall/=0)THEN
206 k = 1
207 DO n=1,nrwall
208 n2=n +nrwall
209 n3=n2+nrwall
210 n4=n3+nrwall
211 n5=n4+nrwall
212 n6=n5+nrwall
213 nsn =nprw(n)
214 imov =nprw(n3)
215 ity =nprw(n4)
216 ilagm=nprw(n6)
217 IF(ilagm/=0)THEN
218 DO j=1,nsn
219 i=lprw(k+j-1)
220 IF(nativ_sms(i)/=0)THEN
221 nativ_sms(i)=0
222 ksms1=1
223 END IF
224 END DO
225 END IF
226 k =k+nsn
227 END DO
228 END IF
229 IF(ksms1/=0)THEN
230 WRITE(istdo,'(A)')
231 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION'
232 WRITE(iout,'(A)')
233 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION :'
234 WRITE(iout,'(A)')
235 .' AMS IS NOT COMPATIBLE WITH LAGRANGE MULTIPLIERS.'
236 END IF
237
238C-----------------------------------------------
239C rbodies : numbering
240C------------
241 tagslv_rby_sms(1:numnod)=0
242 tagmsr_rby_sms(1:numnod) =0
243C
244 iad=0
245 iwsms=0
246 DO m=1,nrbody
247C
248 msr=npby(1,m)
249 nsn=npby(2,m)
250 IF(msr >= 0) THEN
251C if msr secnd of moving or lagrange wall => no ams
252 iwsms=0
253 k = 1
254 DO n=1,nrwall
255 n2=n +nrwall
256 n3=n2+nrwall
257 n4=n3+nrwall
258 n5=n4+nrwall
259 n6=n5+nrwall
260 nsnw =nprw(n)
261 imov =nprw(n3)
262 ity =nprw(n4)
263 ilagm=nprw(n6)
264 IF(ilagm/=0)THEN
265 DO j=1,nsnw
266 i=lprw(k+j-1)
267 IF(i==msr)THEN
268 iwsms=1
269 GOTO 100
270 END IF
271 END DO
272 END IF
273 k =k+nsn
274 END DO
275 100 CONTINUE
276 IF(iwsms==0.AND.npby(7,m)>0 .AND.
277 . (kinet(msr) <=1
278 . .OR. ivf(kinet(msr)) ==1
279 . .OR. irlk(kinet(msr))==1
280 . .OR. ijo(kinet(msr)) ==1
281 . .OR. iwl(kinet(msr)) ==1 )) THEN
282C
283 tagmsr_rby_sms(msr)=m
284 DO ki=1,nsn
285 i=lpby(iad+ki)
286 tagslv_rby_sms(i)=m
287 END DO
288C
289 END IF
290 END IF
291 iad = iad + nsn
292 END DO
293
294 IF(iwsms/=0)THEN
295 WRITE(istdo,'(A)')
296 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION'
297 WRITE(iout,'(a)')
298 . ' ** warning in advanced mass scaling definition :'
299 WRITE(IOUT,'(a)')
300 . ' ams is not compatible with lagrange multipliers.'
301 END IF
302
303C-----
304C RBODY is it fully SMS (yes <=> its time step will be /dt/ams one)
305C-----
306C
307 iad=0
308 DO m=1,nrbody
309C
310 msr=npby(1,m)
311 nsn=npby(2,m)
312 nsms(1)=0
313 nsms(2)=nsn
314C
315 IF(msr >= 0) THEN
316 IF(tagmsr_rby_sms(msr) /= 0) THEN
317 DO ki=1,nsn
318 i=lpby(iad+ki)
319 IF(nativ_sms(i)/=0)nsms(1)=nsms(1)+1
320 END DO
321 END IF
322C
323 IF(nsms(1)==nsms(2))THEN
324 nativ_sms(msr)=1
325 ELSEIF(nsms(1)/=0)THEN
326 CALL fretitl2(titr,
327 . nom_opt(lnopt1-ltitr+1,m),ltitr)
328 IF(npby(10,m)==0)THEN
329 CALL ancmsg(msgid=1190,msgtype=msgwarning,anmode=aninfo_blind_1,
330 . i1=npby(6,m),c1=titr)
331 END IF
332 END IF
333 END IF
334C
335 IF(npby(10,m)/=0.AND.nsms(1)/=0)THEN
336 IF(msr > 0) nativ_sms(msr)=1
337 DO ki=1,nsn
338 i=lpby(iad+ki)
339 nativ_sms(i)=1
340 END DO
341 END IF
342C
343 iad = iad + nsn
344 END DO
345
346C-----
347C-----
348 DO nhi=0,nhrbe2
349 DO n=1,nrbe2
350 IF (irbe2(9,n)/=nhi) cycle
351 iad = irbe2(1,n)
352 nsn = irbe2(5,n)
353 m = irbe2(3,n)
354
355 nsms(1)=0
356 nsms(2)=nsn
357 DO i=1,nsn
358 ns = lrbe2(iad+i)
359 IF(nativ_sms(ns)/=0) nsms(1)=nsms(1)+1
360 ENDDO
361C
362 IF(nsms(1)/=0)THEN
363 nativ_sms(m)=1
364 DO i=1,nsn
365 ns = lrbe2(iad+i)
366 nativ_sms(ns)=1
367 ENDDO
368 END IF
369C
370 END DO
371 END DO
372
373C-----------------------------------------------
374 RETURN
375 END
376
377!||====================================================================
378!|| sms_ini_kad ../starter/source/ams/sms_init.F
379!||--- called by ------------------------------------------------------
380!|| lectur ../starter/source/starter/lectur.F
381!||--- uses -----------------------------------------------------
382!||====================================================================
383 SUBROUTINE sms_ini_kad(
384 1 IXS ,IXQ ,IXC ,IXT ,IXP ,
385 2 IXR ,IXTG ,IXTG1 ,IXS10 ,IXS16 ,
386 3 IXS20 ,IPARG ,MS ,MS0 ,NODNX_SMS ,
387 4 ICODT ,ICODR ,KINET ,
388 5 KAD_SMS ,IPARTS ,IPARTQ ,
389 6 IPARTC ,IPARTT ,IPARTP ,IPARTR ,
390 7 IPARTTG ,IPARTX ,TAGPRT_SMS,TAGREL_SMS,ITAB ,
391 8 IRBE2 ,IRBE3 ,LRBE2 ,LRBE3 ,
392 9 NPRW ,LPRW ,IPART ,IGEO ,NATIV_SMS)
393 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
394C-----------------------------------------------
395C I m p l i c i t T y p e s
396C-----------------------------------------------
397#include "implicit_f.inc"
398C-----------------------------------------------
399C C o m m o n B l o c k s
400C-----------------------------------------------
401#include "com01_c.inc"
402#include "com04_c.inc"
403#include "param_c.inc"
404#include "sms_c.inc"
405#include "scr17_c.inc"
406C-----------------------------------------------
407C D u m m y A r g u m e n t s
408C-----------------------------------------------
409 INTEGER
410 . IXS(NIXS,*),IXS10(6,*) ,IXS16(6,*) ,IXS20(12,*),
411 . IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
412 . ixr(nixr,*), ixtg(nixtg,*), ixtg1(4,*),
413 . iparg(nparg,*),
414 . nodnx_sms(*), icodt(*), icodr(*), kinet(*),
415 . kad_sms(*),
416 . iparts(*),ipartq(*),ipartc(*),ipartt(*),
417 . ipartp(*),ipartr(*),iparttg(*),ipartx(*),
418 . tagprt_sms(*), tagrel_sms(*),
419 . itab(*),
420 . irbe2(nrbe2l,*), irbe3(nrbe3l,*), lrbe2(*), lrbe3(*),
421 . nprw(*), lprw(*),
422 . ipart(lipart1,*), igeo(npropgi,*), nativ_sms(*)
423C REAL
424 my_real
425 . ms(*), ms0(*)
426C-----------------------------------------------
427C L o c a l V a r i a b l e s
428C-----------------------------------------------
429 INTEGER I, J, K, NG, N, JJ, KK, ITY, NEL, NFT, ISOLNOD,
430 . IAD, IP, NAD_SMS(NUMNOD),ILOC4(4),IWORK(NUMNOD),
431 . TAG8(8), IG, IGTYP
432 INTEGER J1, IPERM1(6), IPERM2(6),IPENTA6(6)
433 DATA ILOC4/1,3,6,5/
434 DATA IPERM1/1,2,3,1,2,3/
435 DATA IPERM2/2,3,1,4,4,4/
436 DATA IPENTA6/1,2,3,5,6,7/
437C
438C-----------------------------------------------
439 TAGREL_SMS(1:NGROUP)=0
440c
441 DO i=1,numnod
442 nad_sms(i)=0
443 END DO
444
445 knz_sms = 0
446
447 DO ng=1,ngroup
448 ity =iparg(5,ng)
449
450 nel = iparg(2,ng)
451 nft = iparg(3,ng)
452 isolnod = iparg(28,ng)
453 IF(ity==1.AND.isolnod==4)THEN
454 DO j=nft+1,nft+nel
455 DO k=1,4
456
457 i=ixs(1+iloc4(k),j)
458
459 DO kk=1,4
460 jj = ixs(1+iloc4(kk),j)
461 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
462 tagrel_sms(ng)=1
463 nad_sms(i)=nad_sms(i)+1
464 knz_sms =knz_sms+1
465 END IF
466 END DO
467
468 END DO
469 END DO
470 ELSEIF(ity==1.AND.isolnod==6)THEN
471 DO j=nft+1,nft+nel
472 DO k=1,6
473
474 i=ixs(1+ipenta6(k),j)
475 DO kk=1,6
476 jj = ixs(1+ipenta6(kk),j)
477 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
478 tagrel_sms(ng)=1
479 nad_sms(i)=nad_sms(i)+1
480 knz_sms =knz_sms+1
481 END IF
482 END DO
483
484 END DO
485 END DO
486 ELSEIF(ity==1.AND.isolnod==8)THEN
487 DO j=nft+1,nft+nel
488
489 DO k=1,8
490 i=ixs(1+k,j)
491 iwork(i)=0
492 tag8(k)=0
493 END DO
494
495 DO k=1,8
496 i=ixs(1+k,j)
497 IF(iwork(i)/=0)THEN
498 tag8(k)=1
499 ELSE
500 iwork(i)=1
501 END IF
502 END DO
503
504 DO k=1,8
505
506 i=ixs(1+k,j)
507 IF(tag8(k)/=0)cycle
508
509 DO kk=1,8
510 jj = ixs(1+kk,j)
511 IF(tag8(kk)/=0) cycle
512
513 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
514 tagrel_sms(ng)=1
515 nad_sms(i)=nad_sms(i)+1
516 knz_sms =knz_sms+1
517 END IF
518 END DO
519
520 END DO
521 END DO
522 ELSEIF(ity==1.AND.isolnod==10)THEN
523 DO j=nft+1,nft+nel
524 j1=j-numels8
525
526 DO k=1,4
527
528 i=ixs(1+iloc4(k),j)
529 DO kk=1,4
530 jj = ixs(1+iloc4(kk),j)
531 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
532 tagrel_sms(ng)=1
533 nad_sms(i)=nad_sms(i)+1
534 knz_sms =knz_sms+1
535 END IF
536 END DO
537
538 DO kk=1,6
539 jj=ixs10(kk,j1)
540 IF(jj==0) cycle
541
542 IF(.NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
543 tagrel_sms(ng)=1
544 nad_sms(i)=nad_sms(i)+1
545 knz_sms =knz_sms+1
546 END IF
547 END DO
548
549 END DO
550
551 DO k=1,6
552
553 i=ixs10(k,j1)
554 IF(i==0) cycle
555
556 DO kk=1,4
557 jj = ixs(1+iloc4(kk),j)
558 IF(.NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
559 tagrel_sms(ng)=1
560 nad_sms(i)=nad_sms(i)+1
561 knz_sms =knz_sms+1
562 END IF
563 END DO
564
565 DO kk=1,6
566 jj=ixs10(kk,j1)
567 IF(jj==0) cycle
568
569 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
570 tagrel_sms(ng)=1
571 nad_sms(i)=nad_sms(i)+1
572 knz_sms =knz_sms+1
573 END IF
574 END DO
575
576 END DO
577
578 END DO
579 ELSEIF(ity==3)THEN
580 DO j=nft+1,nft+nel
581 DO k=1,4
582
583 i=ixc(1+k,j)
584 DO kk=1,4
585 jj = ixc(1+kk,j)
586 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
587 tagrel_sms(ng)=1
588 nad_sms(i)=nad_sms(i)+1
589 knz_sms =knz_sms+1
590 END IF
591 END DO
592
593 END DO
594 END DO
595 ELSEIF(ity==4)THEN
596 DO j=nft+1,nft+nel
597 DO k=1,2
598
599 i=ixt(1+k,j)
600 DO kk=1,2
601 jj = ixt(1+kk,j)
602 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
603 tagrel_sms(ng)=1
604 nad_sms(i)=nad_sms(i)+1
605 knz_sms =knz_sms+1
606 END IF
607 END DO
608
609 END DO
610 END DO
611 ELSEIF(ity==5)THEN
612 DO j=nft+1,nft+nel
613 DO k=1,2
614 i=ixp(1+k,j)
615 DO kk=1,2
616 jj = ixp(1+kk,j)
617 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
618 tagrel_sms(ng)=1
619 nad_sms(i)=nad_sms(i)+1
620 knz_sms =knz_sms+1
621 END IF
622 END DO
623 END DO
624 END DO
625 ELSEIF(ity==6)THEN
626 ig = ipart(2,ipartr(nft+1))
627 igtyp = igeo(11,ig)
628 IF(igtyp/=12)THEN
629 DO j=nft+1,nft+nel
630 DO k=1,2
631 i=ixr(1+k,j)
632 DO kk=1,2
633 jj = ixr(1+kk,j)
634 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
635 tagrel_sms(ng)=1
636 nad_sms(i)=nad_sms(i)+1
637 knz_sms =knz_sms+1
638 END IF
639 END DO
640 END DO
641 END DO
642 ELSE
643 DO j=nft+1,nft+nel
644 k=1
645
646 i=ixr(1+k,j)
647
648 kk=2
649 jj = ixr(1+kk,j)
650 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
651 tagrel_sms(ng)=1
652 nad_sms(i)=nad_sms(i)+1
653 knz_sms =knz_sms+1
654 END IF
655
656 k=2
657
658 i=ixr(1+k,j)
659
660 kk=1
661 jj = ixr(1+kk,j)
662 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
663 tagrel_sms(ng)=1
664 nad_sms(i)=nad_sms(i)+1
665 knz_sms =knz_sms+1
666 END IF
667
668 kk=3
669 jj = ixr(1+kk,j)
670 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
671 tagrel_sms(ng)=1
672 nad_sms(i)=nad_sms(i)+1
673 knz_sms =knz_sms+1
674 END IF
675
676 k=3
677
678 i=ixr(1+k,j)
679
680 kk=2
681 jj = ixr(1+kk,j)
682 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
683 tagrel_sms(ng)=1
684 nad_sms(i)=nad_sms(i)+1
685 knz_sms =knz_sms+1
686 END IF
687
688 END DO
689 END IF
690 ELSEIF(ity==7)THEN
691 DO j=nft+1,nft+nel
692 DO k=1,3
693
694 i=ixtg(1+k,j)
695 DO kk=1,3
696 jj = ixtg(1+kk,j)
697 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
698 tagrel_sms(ng)=1
699 nad_sms(i)=nad_sms(i)+1
700 knz_sms =knz_sms+1
701 END IF
702 END DO
703
704 END DO
705 END DO
706 END IF
707 END DO
708C
709 kad_sms(1)=1
710 DO i=1,numnod
711 kad_sms(i+1)=kad_sms(i)+nad_sms(i)
712 END DO
713C-----------------------------------------------
714 RETURN
715 END
716!||====================================================================
717!|| nodnx_sms_ini ../starter/source/ams/sms_init.F
718!||--- called by ------------------------------------------------------
719!|| sms_init ../starter/source/ams/sms_init.F
720!||====================================================================
721 SUBROUTINE nodnx_sms_ini(
722 1 NUMNOD ,NUMEL ,NIX ,MIX ,LIX ,
723 2 IX ,IPARTX,TAGPRT_SMS,NODNX_SMS)
724C-----------------------------------------------
725C I m p l i c i t T y p e s
726C-----------------------------------------------
727#include "implicit_f.inc"
728C-----------------------------------------------
729C D u m m y A r g u m e n t s
730C-----------------------------------------------
731 INTEGER NUMNOD , NUMEL ,NIX ,MIX, LIX,
732 . ix(nix,*), ipartx(*), tagprt_sms(*), nodnx_sms(*)
733C-----------------------------------------------
734C L o c a l V a r i a b l e s
735C-----------------------------------------------
736 INTEGER I, J, K, TAG(NUMNOD)
737C-----------------------------------------------
738C S o u r c e L i n e s
739C-----------------------------------------------
740C
741 DO J=1,numel
742 IF(tagprt_sms(ipartx(j))==0) cycle
743
744 DO k=1,lix
745 i = ix(mix+k,j)
746 IF(i/=0) tag(i)=0
747 ENDDO
748 DO k=1,lix
749 i = ix(mix+k,j)
750 IF(i/=0)THEN
751 IF(tag(i)==0)THEN
752 nodnx_sms(i)=nodnx_sms(i)+1
753 tag(i)=1
754 END IF
755 END IF
756 ENDDO
757 ENDDO
758
759 RETURN
760 END
761!||====================================================================
762!|| sms_ini_kdi ../starter/source/ams/sms_init.F
763!||--- called by ------------------------------------------------------
764!|| lectur ../starter/source/starter/lectur.F
765!||--- uses -----------------------------------------------------
766!||====================================================================
767 SUBROUTINE sms_ini_kdi(
768 2 IXC ,IPARG ,IXS ,IXT ,IXP ,
769 3 IXR ,IXTG ,IXS10 ,NODNX_SMS,KAD_SMS ,
770 4 KDI_SMS ,JADC_SMS,JADS_SMS ,JADS10_SMS,
771 5 JADT_SMS ,JADP_SMS,
772 6 JADR_SMS,JADTG_SMS,TAGPRT_SMS,IAD_SMS ,
773 7 TAGREL_SMS,IPARTS ,IPARTQ ,IPARTC ,IPARTT ,
774 8 IPARTP ,IPARTR ,IPARTTG ,IPARTX ,
775 9 NPBY ,LPBY ,KINET ,TAGSLV_RBY_SMS,IPARI,
776 A INTBUF_TAB,LAD_SMS,IPART ,IGEO ,NATIV_SMS )
777C-----------------------------------------------
778C M o d u l e s
779C-----------------------------------------------
780 USE intbufdef_mod
781 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
782C-----------------------------------------------
783C I m p l i c i t T y p e s
784C-----------------------------------------------
785#include "implicit_f.inc"
786C-----------------------------------------------
787C C o m m o n B l o c k s
788C-----------------------------------------------
789#include "com01_c.inc"
790#include "com04_c.inc"
791#include "param_c.inc"
792#include "sms_c.inc"
793#include "scr17_c.inc"
794C-----------------------------------------------------------------
795C D u m m y A r g u m e n t s
796C-----------------------------------------------
797 INTEGER
798 . IPARG(NPARG,*), IXC(NIXC,*), IXS(NIXS,*), IXT(NIXT,*),
799 . IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*), IXS10(6,*),
800 . NODNX_SMS(*), KAD_SMS(*), IAD_SMS(*),
801 . JADC_SMS(4,*),
802 . JADS_SMS(8,*), JADS10_SMS(6,*),
803 . JADT_SMS(2,*),
804 . JADP_SMS(2,*),
805 . JADR_SMS(3,*),
806 . JADTG_SMS(3,*), NATIV_SMS(*),
807 . TAGPRT_SMS(*), TAGREL_SMS(*),
808 . IPARTS(*), IPARTQ(*), IPARTC(*), IPARTT(*),
809 . IPARTP(*), IPARTR(*), IPARTTG(*), IPARTX(*),
810 . npby(nnpby,*), lpby(*), kinet(*), tagslv_rby_sms(*),
811 . ipari(npari,*),
812 . lad_sms(*), kdi_sms(*),
813 . ipart(lipart1,*), igeo(npropgi,*)
814 TYPE(intbuf_struct_) INTBUF_TAB(*)
815C-----------------------------------------------
816C L o c a l V a r i a b l e s
817C-----------------------------------------------
818 INTEGER I, J, K, JJ, KK, II, IJ, M, N, IERROR, KL
819 INTEGER NG, ITY, NEL, NFT, ISOLNOD,ILOC4(4),TAGA(NUMNOD),
820 . TAG8(8), IG, IGTYP
821 INTEGER MSR, NSN, KI, KJ, NAD_SMS(NUMNOD),
822 . NSR
823 INTEGER SIZE, LENR, IAD, L, LLT
824 INTEGER NTY, ILAGM,JI, N1, N2, N3, N4, LNEW, ILEV
825 INTEGER J1, IPERM1(6), IPERM2(6),IPENTA6(6)
826 INTEGER TAGK(NUMNOD), IK, NK
827 DATA iloc4/1,3,6,5/
828 DATA iperm1/1,2,3,1,2,3/
829 DATA iperm2/2,3,1,4,4,4/
830 DATA ipenta6/1,2,3,5,6,7/
831C-----------------------------------------------
832C
833C Built jdi_sms, jads_sms, etc.
834C -----------------
835 DO i=1,numnod
836 nad_sms(i)=kad_sms(i)
837 END DO
838C
839 DO ng=1,ngroup
840C
841 IF(tagrel_sms(ng)==0)cycle
842 ity =iparg(5,ng)
843
844 nel = iparg(2,ng)
845 nft = iparg(3,ng)
846 isolnod = iparg(28,ng)
847 IF(ity==1.AND.isolnod==4)THEN
848 DO j=nft+1,nft+nel
849
850 DO k=1,4
851 i=ixs(1+iloc4(k),j)
852 jads_sms(k,j)=nad_sms(i)
853
854 ij=jads_sms(k,j)
855 DO kk=1,4
856 jj = ixs(1+iloc4(kk),j)
857 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
858 nad_sms(i)=nad_sms(i)+1
859 kdi_sms(ij)=jj
860 ij=ij+1
861 END IF
862 END DO
863 END DO
864 END DO
865 ELSEIF(ity==1.AND.isolnod==6)THEN
866 DO j=nft+1,nft+nel
867
868 DO k=1,6
869 i=ixs(1+ipenta6(k),j)
870 jads_sms(k,j)=nad_sms(i)
871
872 ij=jads_sms(k,j)
873 DO kk=1,6
874 jj = ixs(1+ipenta6(kk),j)
875 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
876 nad_sms(i)=nad_sms(i)+1
877 kdi_sms(ij)=jj
878 ij=ij+1
879 END IF
880 END DO
881 END DO
882 END DO
883 ELSEIF(ity==1.AND.isolnod==8)THEN
884 DO j=nft+1,nft+nel
885
886 DO k=1,8
887 i=ixs(1+k,j)
888 taga(i)=0
889 tag8(k)=0
890 END DO
891
892 DO k=1,8
893 i=ixs(1+k,j)
894 IF(taga(i)/=0)THEN
895 tag8(k)=1
896 ELSE
897 taga(i)=1
898 END IF
899 END DO
900
901 DO k=1,8
902 i=ixs(1+k,j)
903 jads_sms(k,j)=nad_sms(i)
904 END DO
905
906 DO k=1,8
907
908 i=ixs(1+k,j)
909 IF(tag8(k)/=0)cycle
910
911 ij=jads_sms(k,j)
912 DO kk=1,8
913 jj = ixs(1+kk,j)
914 IF(tag8(kk)/=0) cycle
915
916 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
917 nad_sms(i)=nad_sms(i)+1
918 kdi_sms(ij)=jj
919 ij=ij+1
920 END IF
921 END DO
922
923 END DO
924
925 END DO
926 ELSEIF(ity==1.AND.isolnod==10)THEN
927 DO j=nft+1,nft+nel
928 j1=j-numels8
929
930 DO k=1,4
931
932 i=ixs(1+iloc4(k),j)
933 jads_sms(k,j)=nad_sms(i)
934
935 ij=jads_sms(k,j)
936 DO kk=1,4
937 jj = ixs(1+iloc4(kk),j)
938 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
939 nad_sms(i)=nad_sms(i)+1
940 kdi_sms(ij)=jj
941 ij=ij+1
942 END IF
943 END DO
944
945 DO kk=1,6
946 jj=ixs10(kk,j1)
947 IF(jj==0) cycle
948
949 IF(.NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
950 nad_sms(i)=nad_sms(i)+1
951 kdi_sms(ij)=jj
952 ij=ij+1
953 END IF
954 END DO
955
956 END DO
957
958
959 DO k=1,6
960
961 i=ixs10(k,j1)
962 IF(i==0) cycle
963
964 jads10_sms(k,j1)=nad_sms(i)
965
966 ij=jads10_sms(k,j1)
967 DO kk=1,4
968 jj = ixs(1+iloc4(kk),j)
969 IF(.NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
970 nad_sms(i)=nad_sms(i)+1
971 kdi_sms(ij)=jj
972 ij=ij+1
973 END IF
974 END DO
975
976 DO kk=1,6
977 jj=ixs10(kk,j1)
978 IF(jj==0) cycle
979
980 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
981 nad_sms(i)=nad_sms(i)+1
982 kdi_sms(ij)=jj
983 ij=ij+1
984 END IF
985 END DO
986
987 END DO
988
989 END DO
990 ELSEIF(ity==3)THEN
991 DO j=nft+1,nft+nel
992
993 DO k=1,4
994 i=ixc(1+k,j)
995 jadc_sms(k,j)=nad_sms(i)
996
997 ij=jadc_sms(k,j)
998 DO kk=1,4
999 jj = ixc(1+kk,j)
1000 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1001 nad_sms(i)=nad_sms(i)+1
1002 kdi_sms(ij)=jj
1003 ij=ij+1
1004 END IF
1005 END DO
1006 END DO
1007 END DO
1008 ELSEIF(ity==4)THEN
1009 DO j=nft+1,nft+nel
1010
1011 DO k=1,2
1012 i=ixt(1+k,j)
1013 jadt_sms(k,j)=nad_sms(i)
1014
1015 ij=jadt_sms(k,j)
1016 DO kk=1,2
1017 jj = ixt(1+kk,j)
1018 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1019 nad_sms(i)=nad_sms(i)+1
1020 kdi_sms(ij)=jj
1021 ij=ij+1
1022 END IF
1023 END DO
1024 END DO
1025 END DO
1026 ELSEIF(ity==5)THEN
1027 DO j=nft+1,nft+nel
1028
1029 DO k=1,2
1030 i=ixp(1+k,j)
1031 jadp_sms(k,j)=nad_sms(i)
1032
1033 ij=jadp_sms(k,j)
1034 DO kk=1,2
1035 jj = ixp(1+kk,j)
1036 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1037 nad_sms(i)=nad_sms(i)+1
1038 kdi_sms(ij)=jj
1039 ij=ij+1
1040 END IF
1041 END DO
1042 END DO
1043 END DO
1044 ELSEIF(ity==6)THEN
1045 ig = ipart(2,ipartr(nft+1))
1046 igtyp = igeo(11,ig)
1047 IF(igtyp/=12)THEN
1048 DO j=nft+1,nft+nel
1049
1050 DO k=1,2
1051 i=ixr(1+k,j)
1052 jadr_sms(k,j)=nad_sms(i)
1053
1054 ij=jadr_sms(k,j)
1055 DO kk=1,2
1056 jj = ixr(1+kk,j)
1057 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1058 nad_sms(i)=nad_sms(i)+1
1059 kdi_sms(ij)=jj
1060 ij=ij+1
1061 END IF
1062 END DO
1063 END DO
1064 END DO
1065 ELSE
1066 DO j=nft+1,nft+nel
1067 k=1
1068 i=ixr(1+k,j)
1069 jadr_sms(k,j)=nad_sms(i)
1070
1071 ij=jadr_sms(k,j)
1072 kk=2
1073 jj = ixr(1+kk,j)
1074 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1075 nad_sms(i)=nad_sms(i)+1
1076 kdi_sms(ij)=jj
1077 ij=ij+1
1078 END IF
1079
1080 k=2
1081 i=ixr(1+k,j)
1082 jadr_sms(k,j)=nad_sms(i)
1083
1084 ij=jadr_sms(k,j)
1085 kk=1
1086 jj = ixr(1+kk,j)
1087 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1088 nad_sms(i)=nad_sms(i)+1
1089 kdi_sms(ij)=jj
1090 ij=ij+1
1091 END IF
1092
1093 kk=3
1094 jj = ixr(1+kk,j)
1095 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1096 nad_sms(i)=nad_sms(i)+1
1097 kdi_sms(ij)=jj
1098 ij=ij+1
1099 END IF
1100
1101 k=3
1102 i=ixr(1+k,j)
1103 jadr_sms(k,j)=nad_sms(i)
1104
1105 ij=jadr_sms(k,j)
1106 kk=2
1107 jj = ixr(1+kk,j)
1108 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1109 nad_sms(i)=nad_sms(i)+1
1110 kdi_sms(ij)=jj
1111 ij=ij+1
1112 END IF
1113 END DO
1114 END IF
1115 ELSEIF(ity==7)THEN
1116 DO j=nft+1,nft+nel
1117
1118 DO k=1,3
1119 i=ixtg(1+k,j)
1120 jadtg_sms(k,j)=nad_sms(i)
1121
1122 ij=jadtg_sms(k,j)
1123 DO kk=1,3
1124 jj = ixtg(1+kk,j)
1125 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1126 nad_sms(i)=nad_sms(i)+1
1127 kdi_sms(ij)=jj
1128 ij=ij+1
1129 END IF
1130 END DO
1131 END DO
1132 END DO
1133 END IF
1134 END DO
1135C-------------------------------------------------------------------------
1136C PREPARE KOMPACTION OF ELEMENTARY MATRIX
1137C Nodnx_sms (i) becomes the nb of NDS connects a i
1138C-------------------------------------------------------------------------
1139 tagk(1:numnod)=0
1140 DO i=1,numnod
1141 nodnx_sms(i)=0
1142 DO kj=kad_sms(i),kad_sms(i+1)-1
1143 ik =kdi_sms(kj)
1144 IF(tagk(ik)==0)THEN
1145 nodnx_sms(i)=nodnx_sms(i)+1
1146 tagk(ik)=1
1147 END IF
1148 END DO
1149 DO kj=kad_sms(i),kad_sms(i+1)-1
1150 ik =kdi_sms(kj)
1151 tagk(ik)=0
1152 END DO
1153 END DO
1154C
1155 iad_sms(1)=1
1156 DO i=1,numnod
1157 iad_sms(i+1)=iad_sms(i)+nodnx_sms(i)
1158 lad_sms(i) =nodnx_sms(i)
1159 END DO
1160C
1161 nnz_sms = iad_sms(numnod+1)
1162C
1163 RETURN
1164 END
1165!||====================================================================
1166!|| sms_ini_jad_1 ../starter/source/ams/sms_init.F
1167!||--- called by ------------------------------------------------------
1168!|| lectur ../starter/source/starter/lectur.F
1169!||--- calls -----------------------------------------------------
1170!||--- uses -----------------------------------------------------
1171!||====================================================================
1172 SUBROUTINE sms_ini_jad_1(
1173 2 IXC ,IPARG ,IXS ,IXT ,IXP ,
1174 3 IXR ,IXTG ,IXS10 ,NODNX_SMS,JADC_SMS ,
1175 4 JADS_SMS ,JADS10_SMS,JADT_SMS,JADP_SMS,JADR_SMS ,
1176 5 JADTG_SMS,TAGPRT_SMS,KAD_SMS,KDI_SMS ,PK_SMS ,
1177 6 TAGREL_SMS,IPARTS ,IPARTQ ,IPARTC ,IPARTT ,
1178 7 IPARTP ,IPARTR ,IPARTTG ,IPARTX ,
1179 8 NPBY ,LPBY ,KINET ,TAGSLV_RBY_SMS,IPARI,
1180 9 INTBUF_TAB,LAD_SMS,IPART ,IGEO ,NATIV_SMS ,
1181 A IAD_SMS ,IDI_SMS,JAD_SMS ,JDI_SMS ,T2MAIN_SMS)
1182C-----------------------------------------------
1183C M o d u l e s
1184C-----------------------------------------------
1185 USE intbufdef_mod
1186 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
1187C-----------------------------------------------
1188C I m p l i c i t T y p e s
1189C-----------------------------------------------
1190#include "implicit_f.inc"
1191C-----------------------------------------------
1192C C o m m o n B l o c k s
1193C-----------------------------------------------
1194#include "com04_c.inc"
1195#include "param_c.inc"
1196#include "sms_c.inc"
1197#include "scr17_c.inc"
1198C-----------------------------------------------------------------
1199C D u m m y A r g u m e n t s
1200C-----------------------------------------------
1201 INTEGER
1202 . iparg(nparg,*), ixc(nixc,*), ixs(nixs,*), ixt(nixt,*),
1203 . ixp(nixp,*), ixr(nixr,*), ixtg(nixtg,*), ixs10(6,*),
1204 . nodnx_sms(*), kad_sms(*), kdi_sms(*), pk_sms(*),
1205 . iad_sms(*), idi_sms(*), jad_sms(*), jdi_sms(*),
1206 . jadc_sms(4,*),
1207 . jads_sms(8,*), jads10_sms(6,*),
1208 . jadt_sms(2,*),
1209 . jadp_sms(2,*),
1210 . jadr_sms(3,*),
1211 . jadtg_sms(3,*),nativ_sms(*),
1212 . tagprt_sms(*), tagrel_sms(*),
1213 . iparts(*), ipartq(*), ipartc(*), ipartt(*),
1214 . ipartp(*), ipartr(*), iparttg(*), ipartx(*),
1215 . npby(nnpby,*), lpby(*), kinet(*), tagslv_rby_sms(*),
1216 . ipari(npari,*),
1217 . lad_sms(*),
1218 . ipart(lipart1,*), igeo(npropgi,*),t2main_sms(4,*)
1219 TYPE(intbuf_struct_) INTBUF_TAB(*)
1220C-----------------------------------------------
1221C L o c a l V a r i a b l e s
1222C-----------------------------------------------
1223 INTEGER I, J, K, JJ, KK, II, IJ, M, N, IERROR, KL
1224 INTEGER NMN, IUN
1225 INTEGER MSR, NSN, KI, KJ, NAD_SMS(NUMNOD),
1226 . NSR
1227 INTEGER SIZE, LENR, IAD, L, LLT
1228 INTEGER NTY, ILAGM, K10, K11, K12, K13, K14, JI,
1229 . N1, N2, N3, N4, LNEW, ILEV
1230 INTEGER TAGK(NUMNOD), IK, NK, IKK,PERM,
1231 . ITRI(NUMNOD),INDEX(2*NUMNOD),INDEX2(NUMNOD),WORK(70000)
1232 LOGICAL ITERATE
1233 DATA IUN/1/
1234C-------------------------------------------------------------------------
1235C PREPARE KOMPACTION OF ELEMENTARY MATRIX
1236C Built Idi_sms and Pointers Kad_sms to Jad_sms
1237C 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
1238C-------------------------------------------------------------------------
1239 TAGK(1:NUMNOD)=0
1240C
1241 DO i=1,numnod
1242 nk=0
1243 DO kj=kad_sms(i),kad_sms(i+1)-1
1244 ik =kdi_sms(kj)
1245 IF(tagk(ik)==0)THEN
1246 idi_sms(iad_sms(i)+nk)=ik
1247 nk=nk+1
1248 tagk(ik)=nk
1249 END IF
1250 END DO
1251C
1252C reordonne IDI_SMS(KJ), KJ=IAD_SMS(I),IAD_SMS(I)+LAD_SMS(I)-1
1253 DO ik=1,nk
1254 kj=iad_sms(i)+ik-1
1255 itri(ik) =idi_sms(kj)
1256 index(ik)=ik
1257 END DO
1258
1259 IF(nk/=0)THEN
1260
1261 IF(nk<16)THEN
1262C When #of connectivities are small
1263C Bubble sort is more efficient
1264
1265 iterate=.true.
1266 DO WHILE (iterate .EQV. .true.)
1267 iterate=.false.
1268 DO j=1,nk-1
1269 IF(itri(j)> itri(j+1) )THEN
1270 perm = itri(j)
1271 itri(j) = itri(j+1)
1272 itri(j+1)=perm
1273
1274 perm = index(j)
1275 index(j) = index(j+1)
1276 index(j+1) = perm
1277
1278 iterate = .true.
1279 ENDIF
1280 ENDDO
1281 ENDDO
1282 DO ik=1,nk
1283 kj=iad_sms(i)+ik-1
1284 idi_sms(kj)=itri(ik)
1285 END DO
1286
1287
1288 ELSE
1289 CALL my_orders(0,work,itri,index,nk,1)
1290
1291 DO ik=1,nk
1292 kj=iad_sms(i)+ik-1
1293 idi_sms(kj)=itri(index(ik))
1294 END DO
1295
1296 ENDIF
1297 ENDIF
1298
1299
1300
1301 DO ik=1,nk
1302 ikk =index(ik)
1303 index2(ikk)=ik
1304 END DO
1305
1306 DO kj=kad_sms(i),kad_sms(i+1)-1
1307 ik = kdi_sms(kj)
1308 pk_sms(kj)= index2(tagk(ik))
1309 END DO
1310
1311 DO kj=kad_sms(i),kad_sms(i+1)-1
1312 ik =kdi_sms(kj)
1313 tagk(ik)=0
1314 END DO
1315
1316 END DO
1317C-------------------------------------------------------------------------
1318 DO i=1,numnod+1
1319 jad_sms(i)=iad_sms(i)
1320 END DO
1321 DO i=1,numnod
1322 DO kj=iad_sms(i),iad_sms(i+1)-1
1323 jdi_sms(kj)=idi_sms(kj)
1324 END DO
1325 END DO
1326C-------------------------------------------------------------------------
1327C inter/type2 : numbering
1328C------------
1329 kinet(1:numnod) = 0
1330C
1331C main tag for symmetrical type 2
1332C
1333 DO n=1,ninter
1334 nty = ipari(7,n)
1335 IF (nty == 2) THEN
1336 nmn = ipari(6,n)
1337 ilev = ipari(20,n)
1338c
1339 DO i=1,nmn
1340 j = intbuf_tab(n)%MSR(i)
1341 IF (ilev == 0 .OR. ilev == 1 .OR. ilev == 27 .OR. ilev == 28) THEN
1342 kinet(j) = kinet(j)+1
1343 ENDIF
1344 ENDDO
1345 ENDIF
1346 ENDDO
1347C
1348 DO n=1,ninter
1349 nty = ipari(7,n)
1350 IF (nty == 2) THEN
1351 nmn = ipari(6,n)
1352 ilev = ipari(20,n)
1353c
1354 DO i=1,nmn
1355 j = intbuf_tab(n)%MSR(i)
1356 IF (ilev == 0 .OR. ilev == 1 .OR. ilev == 27 .OR. ilev == 28) THEN
1357 kinet(j) = kinet(j)+1
1358 ENDIF
1359 ENDDO
1360 ENDIF
1361 ENDDO
1362C
1363 DO n=1,numnod
1364 IF(kinet(n)/=0) kinet(n)=min(iun,kinet(n)-1) ! Kinet == 1 <=> Incompatible conditions
1365 END DO
1366C------------
1367C
1368C---- First pass - detection of main nodes for crossed type 2 connection
1369C
1370 DO n=1,ninter
1371 nty = ipari(7,n)
1372 ilagm = ipari(33,n)
1373 ilev = ipari(20,n)
1374 nsn = ipari(5,n)
1375 IF(nty==2 .AND. ilagm==0 .AND.ilev/=25 .and. ilev/=26.AND. ilev/=27 .and. ilev/=28)THEN
1376 DO ii=1,nsn
1377 i=abs(intbuf_tab(n)%NSV(ii))
1378 l=intbuf_tab(n)%IRTLM(ii)
1379 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1380 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1381 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1382 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1383C
1384 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1385 . .AND.nativ_sms(n2)==0
1386 . .AND.nativ_sms(n3)==0
1387 . .AND.nativ_sms(n4)==0) cycle
1388 t2main_sms(1,i) = n1
1389 t2main_sms(2,i) = n2
1390 t2main_sms(3,i) = n3
1391 t2main_sms(4,i) = n4
1392
1393 ENDDO
1394 ELSEIF(nty==2 .AND. ilagm==0 .AND.(ilev==27.or.ilev==28))THEN
1395 DO ii=1,nsn
1396 i=abs(intbuf_tab(n)%NSV(ii))
1397 IF (intbuf_tab(n)%IRUPT(ii)==0) THEN
1398C Kinematic node
1399 l=intbuf_tab(n)%IRTLM(ii)
1400 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1401 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1402 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1403 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1404C
1405 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1406 . .AND.nativ_sms(n2)==0
1407 . .AND.nativ_sms(n3)==0
1408 . .AND.nativ_sms(n4)==0) cycle
1409 t2main_sms(1,i) = n1
1410 t2main_sms(2,i) = n2
1411 t2main_sms(3,i) = n3
1412 t2main_sms(4,i) = n4
1413
1414 ENDIF
1415 ENDDO
1416 ENDIF
1417 ENDDO
1418C
1419 DO n=1,ninter
1420 nty = ipari(7,n)
1421 ilagm = ipari(33,n)
1422 ilev = ipari(20,n)
1423 IF(nty==2 .AND. ilagm==0 .AND.ilev/=25 .and. ilev/=26.AND. ilev/=27 .and. ilev/=28)THEN
1424 nsn=ipari(5,n)
1425 DO ii=1,nsn
1426 i=abs(intbuf_tab(n)%NSV(ii))
1427 l=intbuf_tab(n)%IRTLM(ii)
1428 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1429 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1430 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1431 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1432
1433 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1434 . .AND.nativ_sms(n2)==0
1435 . .AND.nativ_sms(n3)==0
1436 . .AND.nativ_sms(n4)==0) cycle
1437
1438 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1439 j =jdi_sms(kj)
1440 nodnx_sms(j) =nodnx_sms(j) +4
1441 nodnx_sms(n1)=nodnx_sms(n1)+1
1442 nodnx_sms(n2)=nodnx_sms(n2)+1
1443 nodnx_sms(n3)=nodnx_sms(n3)+1
1444 nodnx_sms(n4)=nodnx_sms(n4)+1
1445 nnz_sms = nnz_sms + 8
1446C-- Type2 crossed connection between main nodes
1447 IF ((t2main_sms(1,j)>0).AND.(i>j)) THEN
1448 DO k =1,4
1449 DO kk =1,4
1450 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
1451 nodnx_sms(t2main_sms(k,i))=nodnx_sms(t2main_sms(k,i))+1
1452 nodnx_sms(t2main_sms(kk,j))=nodnx_sms(t2main_sms(kk,j))+1
1453 nnz_sms = nnz_sms + 2
1454 ENDIF
1455 ENDDO
1456 ENDDO
1457 ENDIF
1458 END DO
1459 END DO
1460 ELSEIF(nty==2 .AND. ilagm==0 .AND.(ilev==25.or.ilev==26))THEN
1461 nsn=ipari(5,n)
1462 DO ii=1,nsn
1463 i=abs(intbuf_tab(n)%NSV(ii))
1464 l=intbuf_tab(n)%IRTLM(ii)
1465 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1466 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1467 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1468 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1469
1470 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1471 . .AND.nativ_sms(n2)==0
1472 . .AND.nativ_sms(n3)==0
1473 . .AND.nativ_sms(n4)==0) cycle
1474
1475 nodnx_sms(i) =nodnx_sms(i) +4
1476 nodnx_sms(n1)=nodnx_sms(n1)+1
1477 nodnx_sms(n2)=nodnx_sms(n2)+1
1478 nodnx_sms(n3)=nodnx_sms(n3)+1
1479 nodnx_sms(n4)=nodnx_sms(n4)+1
1480 nnz_sms = nnz_sms + 8
1481 END DO
1482 ELSEIF(nty==2 .AND. ilagm==0 .AND.(ilev==27.or.ilev==28))THEN
1483 nsn=ipari(5,n)
1484 DO ii=1,nsn
1485 i=abs(intbuf_tab(n)%NSV(ii))
1486 IF (kinet(i)==0) THEN
1487C Kinematic node
1488 l=intbuf_tab(n)%IRTLM(ii)
1489 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1490 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1491 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1492 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1493
1494 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1495 . .AND.nativ_sms(n2)==0
1496 . .AND.nativ_sms(n3)==0
1497 . .AND.nativ_sms(n4)==0) cycle
1498
1499 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1500 j =jdi_sms(kj)
1501 nodnx_sms(j) =nodnx_sms(j) +4
1502 nodnx_sms(n1)=nodnx_sms(n1)+1
1503 nodnx_sms(n2)=nodnx_sms(n2)+1
1504 nodnx_sms(n3)=nodnx_sms(n3)+1
1505 nodnx_sms(n4)=nodnx_sms(n4)+1
1506 nnz_sms = nnz_sms + 8
1507C-- Type2 crossed connection between main nodes
1508 IF ((t2main_sms(1,j)>0).AND.(i>j)) THEN
1509 DO k =1,4
1510 DO kk =1,4
1511 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
1512 nodnx_sms(t2main_sms(k,i))=nodnx_sms(t2main_sms(k,i))+1
1513 nodnx_sms(t2main_sms(kk,j))=nodnx_sms(t2main_sms(kk,j))+1
1514 nnz_sms = nnz_sms + 2
1515 ENDIF
1516 ENDDO
1517 ENDDO
1518 ENDIF
1519 END DO
1520 ELSE
1521C Penalty node
1522 l=intbuf_tab(n)%IRTLM(ii)
1523 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1524 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1525 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1526 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1527
1528 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1529 . .AND.nativ_sms(n2)==0
1530 . .AND.nativ_sms(n3)==0
1531 . .AND.nativ_sms(n4)==0) cycle
1532
1533 nodnx_sms(i) =nodnx_sms(i) +4
1534 nodnx_sms(n1)=nodnx_sms(n1)+1
1535 nodnx_sms(n2)=nodnx_sms(n2)+1
1536 nodnx_sms(n3)=nodnx_sms(n3)+1
1537 nodnx_sms(n4)=nodnx_sms(n4)+1
1538 nnz_sms = nnz_sms + 8
1539 ENDIF
1540 END DO
1541 END IF
1542 END DO
1543C
1544C reconstruit JAD_SMS
1545 jad_sms(1)=1
1546 DO i=1,numnod
1547 jad_sms(i+1)=jad_sms(i)+nodnx_sms(i)
1548 END DO
1549C-----------------------------------------------
1550 RETURN
1551 END
1552!||====================================================================
1553!|| sms_ini_jad_2 ../starter/source/ams/sms_init.F
1554!||--- called by ------------------------------------------------------
1555!|| lectur ../starter/source/starter/lectur.F
1556!||--- uses -----------------------------------------------------
1557!|| intstamp_mod ../starter/share/modules1/intstamp_mod.F
1558!|| message_mod ../starter/share/message_module/message_mod.F
1559!||====================================================================
1560 SUBROUTINE sms_ini_jad_2(
1561 2 IXC ,IPARG ,IXS ,IXT ,IXP ,
1562 3 IXR ,IXTG ,IXS10 ,NODNX_SMS,JADC_SMS,
1563 4 JADS_SMS ,JADS10_SMS,JADT_SMS ,JADP_SMS,JADR_SMS ,
1564 5 JADTG_SMS,TAGPRT_SMS,KAD_SMS,KDI_SMS ,
1565 6 TAGREL_SMS,IPARTS ,IPARTQ ,IPARTC ,IPARTT ,
1566 7 IPARTP ,IPARTR ,IPARTTG ,IPARTX ,
1567 8 NPBY ,LPBY ,KINET ,TAGSLV_RBY_SMS,IPARI,
1568 9 INTBUF_TAB,LAD_SMS ,NPRW ,LPRW ,TAGMSR_RBY_SMS,
1569 A INTSTAMP ,IPART ,IGEO ,NATIV_SMS,IRBE2 ,
1570 B LRBE2 ,IAD_SMS ,IDI_SMS ,JAD_SMS ,JDI_SMS ,
1571 C T2MAIN_SMS)
1572C-----------------------------------------------
1573C M o d u l e s
1574C-----------------------------------------------
1575 USE intstamp_mod
1576 USE intbufdef_mod
1577 USE message_mod
1578 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
1579C-----------------------------------------------
1580C I m p l i c i t T y p e s
1581C-----------------------------------------------
1582#include "implicit_f.inc"
1583C-----------------------------------------------
1584C C o m m o n B l o c k s
1585C-----------------------------------------------
1586#include "com04_c.inc"
1587#include "param_c.inc"
1588#include "sms_c.inc"
1589#include "scr17_c.inc"
1590C-----------------------------------------------------------------
1591C D u m m y A r g u m e n t s
1592C-----------------------------------------------
1593 INTEGER
1594 . IPARG(NPARG,*), IXC(NIXC,*), IXS(NIXS,*), IXT(NIXT,*),
1595 . ixp(nixp,*), ixr(nixr,*), ixtg(nixtg,*), ixs10(6,*),
1596 . nodnx_sms(*), kad_sms(*), kdi_sms(*),
1597 . iad_sms(*), idi_sms(*), jad_sms(*), jdi_sms(*),
1598 . jadc_sms(4,*),
1599 . jads_sms(8,*), jads10_sms(6,*),
1600 . jadt_sms(2,*),
1601 . jadp_sms(2,*),
1602 . jadr_sms(3,*),
1603 . jadtg_sms(3,*),
1604 . tagprt_sms(*), tagrel_sms(*),
1605 . iparts(*), ipartq(*), ipartc(*), ipartt(*),
1606 . ipartp(*), ipartr(*), iparttg(*), ipartx(*),
1607 . npby(nnpby,*), lpby(*), kinet(*), tagslv_rby_sms(*),
1608 . ipari(npari,*),
1609 . lad_sms(*),
1610 . nprw(*), lprw(*), tagmsr_rby_sms(*),
1611 . ipart(lipart1,*), igeo(npropgi,*), nativ_sms(*),
1612 . irbe2(nrbe2l,*), lrbe2(*), t2main_sms(4,*)
1613
1614 TYPE(intstamp_data) INTSTAMP(*)
1615 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1616C-----------------------------------------------
1617C L o c a l V a r i a b l e s
1618C-----------------------------------------------
1619 INTEGER I, J, K, JJ, KK, II, IJ, M, N, IERROR, KL,
1620 . NHI, NS
1621 INTEGER MSR, NSN, KI, KJ, NAD_SMS(NUMNOD), NAD_SMS_0(NUMNOD),
1622 . NSR, NSMS(2)
1623 INTEGER NSNW, IMOV
1624 INTEGER SIZE, LENR, IAD, L, LLT
1625 INTEGER NTY, ILAGM, JI,
1626 . n1, n2, n3, n4, n5, n6,
1627 . nmn, ilev
1628 INTEGER IK
1629C-------------------------------------------------------------------------
1630C PREPARE KOMPACTION OF ELEMENTARY MATRIX
1631C 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
1632C
1633C Rebuilt jdi_sms :: copy idi_sms (compact and sorting elementary connectivity)
1634C-------------------------------------------------------------------------
1635 DO I=1,numnod
1636 DO kj=iad_sms(i),iad_sms(i+1)-1
1637 ik=kj-iad_sms(i)
1638 jdi_sms(jad_sms(i)+ik)=idi_sms(kj)
1639 END DO
1640 END DO
1641C-------------------------------------------------------------------------
1642C inter/type2 : construction de JDI_SMS
1643C-------------------------------------------------------------------------
1644 DO i=1,numnod
1645 nad_sms(i)=jad_sms(i)+lad_sms(i)
1646 END DO
1647
1648C
1649 DO n=1,ninter
1650 nty = ipari(7,n)
1651 ilagm = ipari(33,n)
1652 ilev = ipari(20,n)
1653 IF(nty==2 .AND. ilagm==0 .AND.ilev/=25 .and. ilev/=26 .AND.ilev/=27 .and. ilev/=28)THEN
1654C
1655 nsn=ipari(5,n)
1656 DO ii=1,nsn
1657 i=abs(intbuf_tab(n)%NSV(ii))
1658 l=intbuf_tab(n)%IRTLM(ii)
1659 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1660 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1661 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1662 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1663
1664 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1665 . .AND.nativ_sms(n2)==0
1666 . .AND.nativ_sms(n3)==0
1667 . .AND.nativ_sms(n4)==0) cycle
1668
1669 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1670 j =jdi_sms(kj)
1671C
1672 jdi_sms(nad_sms(n1))=j
1673 nad_sms(n1)=nad_sms(n1)+1
1674 jdi_sms(nad_sms(j))=n1
1675 nad_sms(j)=nad_sms(j)+1
1676C
1677 jdi_sms(nad_sms(n2))=j
1678 nad_sms(n2)=nad_sms(n2)+1
1679 jdi_sms(nad_sms(j))=n2
1680 nad_sms(j)=nad_sms(j)+1
1681C
1682 jdi_sms(nad_sms(n3))=j
1683 nad_sms(n3)=nad_sms(n3)+1
1684 jdi_sms(nad_sms(j))=n3
1685 nad_sms(j)=nad_sms(j)+1
1686C
1687 jdi_sms(nad_sms(n4))=j
1688 nad_sms(n4)=nad_sms(n4)+1
1689 jdi_sms(nad_sms(j))=n4
1690 nad_sms(j)=nad_sms(j)+1
1691C
1692C-- Type2 crossed connection between main nodes
1693 IF ((t2main_sms(1,j)>0).AND.(i>j)) THEN
1694 DO k =1,4
1695 DO kk =1,4
1696 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
1697 jdi_sms(nad_sms(t2main_sms(k,i)))=t2main_sms(kk,j)
1698 nad_sms(t2main_sms(k,i))=nad_sms(t2main_sms(k,i))+1
1699 jdi_sms(nad_sms(t2main_sms(kk,j)))=t2main_sms(k,i)
1700 nad_sms(t2main_sms(kk,j))=nad_sms(t2main_sms(kk,j))+1
1701 ENDIF
1702 ENDDO
1703 ENDDO
1704 ENDIF
1705C
1706 END DO
1707 END DO
1708 ELSEIF(nty==2.AND.ilagm==0.AND.(ilev==25.or.ilev==26))THEN
1709 nsn=ipari(5,n)
1710 DO ii=1,nsn
1711 i=abs(intbuf_tab(n)%NSV(ii))
1712 l=intbuf_tab(n)%IRTLM(ii)
1713 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1714 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1715 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1716 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1717
1718 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1719 . .AND.nativ_sms(n2)==0
1720 . .AND.nativ_sms(n3)==0
1721 . .AND.nativ_sms(n4)==0) cycle
1722
1723 jdi_sms(nad_sms(n1))=i
1724 nad_sms(n1)=nad_sms(n1)+1
1725 jdi_sms(nad_sms(i))=n1
1726 nad_sms(i)=nad_sms(i)+1
1727
1728 jdi_sms(nad_sms(n2))=i
1729 nad_sms(n2)=nad_sms(n2)+1
1730 jdi_sms(nad_sms(i))=n2
1731 nad_sms(i)=nad_sms(i)+1
1732
1733 jdi_sms(nad_sms(n3))=i
1734 nad_sms(n3)=nad_sms(n3)+1
1735 jdi_sms(nad_sms(i))=n3
1736 nad_sms(i)=nad_sms(i)+1
1737
1738 jdi_sms(nad_sms(n4))=i
1739 nad_sms(n4)=nad_sms(n4)+1
1740 jdi_sms(nad_sms(i))=n4
1741 nad_sms(i)=nad_sms(i)+1
1742 END DO
1743C
1744 ELSEIF(nty==2.AND.ilagm==0.AND.(ilev==27.or.ilev==28))THEN
1745C
1746 nsn=ipari(5,n)
1747 DO ii=1,nsn
1748 i=abs(intbuf_tab(n)%NSV(ii))
1749 IF (kinet(i)==0) THEN
1750C Kinematic node
1751 l=intbuf_tab(n)%IRTLM(ii)
1752 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1753 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1754 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1755 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1756
1757 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1758 . .AND.nativ_sms(n2)==0
1759 . .AND.nativ_sms(n3)==0
1760 . .AND.nativ_sms(n4)==0) cycle
1761
1762 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1763 j =jdi_sms(kj)
1764C
1765 jdi_sms(nad_sms(n1))=j
1766 nad_sms(n1)=nad_sms(n1)+1
1767 jdi_sms(nad_sms(j))=n1
1768 nad_sms(j)=nad_sms(j)+1
1769C
1770 jdi_sms(nad_sms(n2))=j
1771 nad_sms(n2)=nad_sms(n2)+1
1772 jdi_sms(nad_sms(j))=n2
1773 nad_sms(j)=nad_sms(j)+1
1774C
1775 jdi_sms(nad_sms(n3))=j
1776 nad_sms(n3)=nad_sms(n3)+1
1777 jdi_sms(nad_sms(j))=n3
1778 nad_sms(j)=nad_sms(j)+1
1779C
1780 jdi_sms(nad_sms(n4))=j
1781 nad_sms(n4)=nad_sms(n4)+1
1782 jdi_sms(nad_sms(j))=n4
1783 nad_sms(j)=nad_sms(j)+1
1784C
1785C-- Type2 crossed connection between main nodes
1786 IF ((t2main_sms(1,j)>0).AND.(i>j)) THEN
1787 DO k =1,4
1788 DO kk =1,4
1789 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
1790 jdi_sms(nad_sms(t2main_sms(k,i)))=t2main_sms(kk,j)
1791 nad_sms(t2main_sms(k,i))=nad_sms(t2main_sms(k,i))+1
1792 jdi_sms(nad_sms(t2main_sms(kk,j)))=t2main_sms(k,i)
1793 nad_sms(t2main_sms(kk,j))=nad_sms(t2main_sms(kk,j))+1
1794 ENDIF
1795 ENDDO
1796 ENDDO
1797C
1798 ENDIF
1799 END DO
1800C
1801 ELSE
1802C Penalty node
1803 l=intbuf_tab(n)%IRTLM(ii)
1804 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1805 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1806 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1807 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1808
1809 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1810 . .AND.nativ_sms(n2)==0
1811 . .AND.nativ_sms(n3)==0
1812 . .AND.nativ_sms(n4)==0) cycle
1813
1814 jdi_sms(nad_sms(n1))=i
1815 nad_sms(n1)=nad_sms(n1)+1
1816 jdi_sms(nad_sms(i))=n1
1817 nad_sms(i)=nad_sms(i)+1
1818
1819 jdi_sms(nad_sms(n2))=i
1820 nad_sms(n2)=nad_sms(n2)+1
1821 jdi_sms(nad_sms(i))=n2
1822 nad_sms(i)=nad_sms(i)+1
1823
1824 jdi_sms(nad_sms(n3))=i
1825 nad_sms(n3)=nad_sms(n3)+1
1826 jdi_sms(nad_sms(i))=n3
1827 nad_sms(i)=nad_sms(i)+1
1828
1829 jdi_sms(nad_sms(n4))=i
1830 nad_sms(n4)=nad_sms(n4)+1
1831 jdi_sms(nad_sms(i))=n4
1832 nad_sms(i)=nad_sms(i)+1
1833 ENDIF
1834 END DO
1835 END IF
1836 END DO
1837C------------
1838C Recalcule NNZ_SMS de la matrice compactee
1839C------------
1840 nnz_sms=0
1841 DO i=1,numnod
1842 nodnx_sms(i)=nad_sms(i)-jad_sms(i)
1843 nnz_sms=nnz_sms+nodnx_sms(i)
1844 END DO
1845C------------
1846C reconstruit JAD_SMS
1847 jad_sms(1)=1
1848 DO i=1,numnod
1849 jad_sms(i+1)=jad_sms(i)+nodnx_sms(i)
1850 END DO
1851C-----------------------------------------------
1852 RETURN
1853 END
1854!||====================================================================
1855!|| sms_ini_jad_3 ../starter/source/ams/sms_init.F
1856!||--- called by ------------------------------------------------------
1857!|| lectur ../starter/source/starter/lectur.F
1858!||--- calls -----------------------------------------------------
1859!|| ancmsg ../starter/source/output/message/message.F
1860!|| arret ../starter/source/system/arret.F
1861!||--- uses -----------------------------------------------------
1862!|| intstamp_mod ../starter/share/modules1/intstamp_mod.F
1863!|| message_mod ../starter/share/message_module/message_mod.F
1864!||====================================================================
1865 SUBROUTINE sms_ini_jad_3(
1866 2 IXC ,IPARG ,IXS ,IXT ,IXP ,
1867 3 IXR ,IXTG ,IXS10 ,NODNX_SMS,JADC_SMS,
1868 4 JADS_SMS ,JADS10_SMS,JADT_SMS ,JADP_SMS,JADR_SMS ,
1869 5 JADTG_SMS,TAGPRT_SMS,KAD_SMS ,KDI_SMS ,
1870 6 TAGREL_SMS,IPARTS ,IPARTQ ,IPARTC ,IPARTT ,
1871 7 IPARTP ,IPARTR ,IPARTTG ,IPARTX ,
1872 8 NPBY ,LPBY ,KINET ,
1873 9 TAGSLV_RBY_SMS,IPARI,INTBUF_TAB,
1874 A LAD_SMS ,JSM_SMS ,INTSTAMP ,IPART ,
1875 B IGEO ,TAGMSR_RBY_SMS,NATIV_SMS,
1876 C IAD_SMS ,IDI_SMS,JAD_SMS ,JDI_SMS ,T2MAIN_SMS)
1877C-----------------------------------------------
1878C M o d u l e s
1879C-----------------------------------------------
1880 USE intstamp_mod
1881 USE intbufdef_mod
1882 USE message_mod
1883 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
1884C-----------------------------------------------
1885C I m p l i c i t T y p e s
1886C-----------------------------------------------
1887#include "implicit_f.inc"
1888C-----------------------------------------------
1889C C o m m o n B l o c k s
1890C-----------------------------------------------
1891#include "com04_c.inc"
1892#include "param_c.inc"
1893#include "scr17_c.inc"
1894C-----------------------------------------------
1895C D u m m y A r g u m e n t s
1896C-----------------------------------------------
1897 INTEGER
1898 . IPARG(NPARG,*), IXC(NIXC,*), IXS(NIXS,*), IXT(NIXT,*),
1899 . IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*), IXS10(6,*),
1900 . NODNX_SMS(*), KAD_SMS(*), KDI_SMS(*),
1901 . iad_sms(*), idi_sms(*), jad_sms(*), jdi_sms(*),
1902 . jadc_sms(4,*),
1903 . jads_sms(8,*), jads10_sms(6,*),
1904 . jadt_sms(2,*),
1905 . jadp_sms(2,*),
1906 . jadr_sms(3,*),
1907 . jadtg_sms(3,*),nativ_sms(*),
1908 . tagprt_sms(*), tagrel_sms(*),
1909 . iparts(*), ipartq(*), ipartc(*), ipartt(*),
1910 . ipartp(*), ipartr(*), iparttg(*), ipartx(*),
1911 . npby(nnpby,*), lpby(*), kinet(*), tagslv_rby_sms(*),
1912 . ipari(npari,*),
1913 . lad_sms(*), jsm_sms(*),
1914 . ipart(lipart1,*), igeo(npropgi,*), tagmsr_rby_sms(*), t2main_sms(4,*)
1915 TYPE(INTSTAMP_DATA) INTSTAMP(*)
1916 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1917C-----------------------------------------------
1918C L o c a l V a r i a b l e s
1919C-----------------------------------------------
1920 INTEGER I, J, K, JJ, KK, II, IJ, M, N, IERROR, KL
1921 INTEGER MSR, NSN, KI, KJ, NAD_SMS(NUMNOD), NAD_SMS_0(NUMNOD),
1922 . NSR
1923 INTEGER SIZE, LENR, IAD, L, LLT
1924 INTEGER NTY, ILAGM, K10, K11, K12, K13, K14, JI,
1925 . N1, N2, N3, N4,
1926 . nmn, ilev, error
1927 INTEGER IK, NK, K1, K2, KM
1928C-------------------------------------------------------------------------
1929C PREPARE KOMPACTION OF ELEMENTARY MATRIX
1930C 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
1931C
1932C Rebuilt jdi_sms :: copy idi_sms (compact and sorting elementary connectivity)
1933C-------------------------------------------------------------------------
1934 DO I=1,numnod
1935 DO kj=iad_sms(i),iad_sms(i+1)-1
1936 ik=kj-iad_sms(i)
1937 jdi_sms(jad_sms(i)+ik)=idi_sms(kj)
1938 END DO
1939 END DO
1940C-------------------------------------------------------------------------
1941C PREPARE JSM_SMS (Elementary connectivitis)
1942C-------------------------------------------------------------------------
1943 DO i=1,numnod
1944 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1945 j =jdi_sms(kj)
1946cc IF(I < J)THEN
1947C
1948C Dichotomy (research among the neighbors of J)
1949 k1=jad_sms(j)
1950 k2=jad_sms(j)+lad_sms(j)-1
1951 100 CONTINUE
1952 km=(k1+k2)/2
1953 IF(jdi_sms(k1) == i)THEN
1954 jsm_sms(kj)=k1
1955cc JSM_SMS(K1)=KJ
1956 GOTO 200
1957 ELSEIF(jdi_sms(k2) == i)THEN
1958 jsm_sms(kj)=k2
1959cc JSM_SMS(K2)=KJ
1960 GOTO 200
1961 ELSEIF(jdi_sms(km) == i)THEN
1962 jsm_sms(kj)=km
1963cc JSM_SMS(KM)=KJ
1964 GOTO 200
1965 ELSEIF(jdi_sms(km) < i)THEN
1966 k1=km
1967 GOTO 100
1968 ELSE ! JDI_SMS(KM) > I
1969 k2=km
1970 GOTO 100
1971 END IF
1972 WRITE(6,*) ' ** internal error in AMS initialization'
1973 200 CONTINUE
1974cc END IF
1975 END DO
1976 END DO
1977C
1978 DO i=1,numnod
1979 nad_sms(i)=jad_sms(i)+lad_sms(i)
1980 END DO
1981C
1982C Inter/Type2: Reconstruction (JDI and JSM)
1983C------------
1984 DO n=1,ninter
1985 nty = ipari(7,n)
1986 ilagm = ipari(33,n)
1987 ilev = ipari(20,n)
1988 IF(nty==2 .AND. ilagm==0 .AND.ilev/=25 .and. ilev/=26.AND.ilev/=27 .and. ilev/=28)THEN
1989C
1990 nsn=ipari(5,n)
1991 DO ii=1,nsn
1992 i=abs(intbuf_tab(n)%NSV(ii))
1993
1994 l=intbuf_tab(n)%IRTLM(ii)
1995 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1996 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1997 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1998 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1999
2000 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
2001 . .AND.nativ_sms(n2)==0
2002 . .AND.nativ_sms(n3)==0
2003 . .AND.nativ_sms(n4)==0) cycle
2004
2005 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
2006 j =jdi_sms(kj)
2007
2008 jsm_sms(nad_sms(n1))=nad_sms(j)
2009 jsm_sms(nad_sms(j)) =nad_sms(n1)
2010 jdi_sms(nad_sms(n1))=j
2011 nad_sms(n1)=nad_sms(n1)+1
2012 jdi_sms(nad_sms(j))=n1
2013 nad_sms(j)=nad_sms(j)+1
2014
2015 jsm_sms(nad_sms(n2))=nad_sms(j)
2016 jsm_sms(nad_sms(j)) =nad_sms(n2)
2017 jdi_sms(nad_sms(n2))=j
2018 nad_sms(n2)=nad_sms(n2)+1
2019 jdi_sms(nad_sms(j))=n2
2020 nad_sms(j)=nad_sms(j)+1
2021
2022 jsm_sms(nad_sms(n3))=nad_sms(j)
2023 jsm_sms(nad_sms(j)) =nad_sms(n3)
2024 jdi_sms(nad_sms(n3))=j
2025 nad_sms(n3)=nad_sms(n3)+1
2026 jdi_sms(nad_sms(j))=n3
2027 nad_sms(j)=nad_sms(j)+1
2028
2029 jsm_sms(nad_sms(n4))=nad_sms(j)
2030 jsm_sms(nad_sms(j)) =nad_sms(n4)
2031 jdi_sms(nad_sms(n4))=j
2032 nad_sms(n4)=nad_sms(n4)+1
2033 jdi_sms(nad_sms(j))=n4
2034 nad_sms(j)=nad_sms(j)+1
2035C
2036C-- Type2 crossed connection between main nodes
2037 IF ((t2main_sms(1,j)>0).AND.(i>j)) THEN
2038 DO k =1,4
2039 DO kk =1,4
2040 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
2041 jsm_sms(nad_sms(t2main_sms(k,i)))=nad_sms(t2main_sms(kk,j))
2042 jsm_sms(nad_sms(t2main_sms(kk,j)))=nad_sms(t2main_sms(k,i))
2043 jdi_sms(nad_sms(t2main_sms(k,i)))=t2main_sms(kk,j)
2044 nad_sms(t2main_sms(k,i))=nad_sms(t2main_sms(k,i))+1
2045 jdi_sms(nad_sms(t2main_sms(kk,j)))=t2main_sms(k,i)
2046 nad_sms(t2main_sms(kk,j))=nad_sms(t2main_sms(kk,j))+1
2047 ENDIF
2048 ENDDO
2049 ENDDO
2050 ENDIF
2051C
2052 END DO
2053 END DO
2054 ELSEIF(nty==2.AND.ilagm==0.AND.(ilev==25.or.ilev==26))THEN
2055 k10=ipari(1,n)
2056 k11=k10+4*ipari(3,n)
2057 k12=k11+4*ipari(4,n)
2058 k13=k12+ipari(5,n)
2059 k14=k13+ipari(6,n)
2060 nsn=ipari(5,n)
2061 DO ii=1,nsn
2062 i=abs(intbuf_tab(n)%NSV(ii))
2063 l=intbuf_tab(n)%IRTLM(ii)
2064 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
2065 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
2066 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
2067 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
2068
2069 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
2070 . .AND.nativ_sms(n2)==0
2071 . .AND.nativ_sms(n3)==0
2072 . .AND.nativ_sms(n4)==0) cycle
2073
2074 jsm_sms(nad_sms(n1))=nad_sms(i)
2075 jsm_sms(nad_sms(i)) =nad_sms(n1)
2076 jdi_sms(nad_sms(n1))=i
2077 nad_sms(n1)=nad_sms(n1)+1
2078 jdi_sms(nad_sms(i))=n1
2079 nad_sms(i)=nad_sms(i)+1
2080
2081 jsm_sms(nad_sms(n2))=nad_sms(i)
2082 jsm_sms(nad_sms(i)) =nad_sms(n2)
2083 jdi_sms(nad_sms(n2))=i
2084 nad_sms(n2)=nad_sms(n2)+1
2085 jdi_sms(nad_sms(i))=n2
2086 nad_sms(i)=nad_sms(i)+1
2087
2088 jsm_sms(nad_sms(n3))=nad_sms(i)
2089 jsm_sms(nad_sms(i)) =nad_sms(n3)
2090 jdi_sms(nad_sms(n3))=i
2091 nad_sms(n3)=nad_sms(n3)+1
2092 jdi_sms(nad_sms(i))=n3
2093 nad_sms(i)=nad_sms(i)+1
2094
2095 jsm_sms(nad_sms(n4))=nad_sms(i)
2096 jsm_sms(nad_sms(i)) =nad_sms(n4)
2097 jdi_sms(nad_sms(n4))=i
2098 nad_sms(n4)=nad_sms(n4)+1
2099 jdi_sms(nad_sms(i))=n4
2100 nad_sms(i)=nad_sms(i)+1
2101 END DO
2102 ELSEIF(nty==2.AND.ilagm==0.AND.(ilev==27.or.ilev==28))THEN
2103C
2104 nsn=ipari(5,n)
2105 DO ii=1,nsn
2106 i=abs(intbuf_tab(n)%NSV(ii))
2107 IF (kinet(i)==0) THEN
2108C Kinematic node
2109
2110 l=intbuf_tab(n)%IRTLM(ii)
2111 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
2112 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
2113 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
2114 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
2115
2116 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
2117 . .AND.nativ_sms(n2)==0
2118 . .AND.nativ_sms(n3)==0
2119 . .AND.nativ_sms(n4)==0) cycle
2120
2121 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
2122 j =jdi_sms(kj)
2123
2124 jsm_sms(nad_sms(n1))=nad_sms(j)
2125 jsm_sms(nad_sms(j)) =nad_sms(n1)
2126 jdi_sms(nad_sms(n1))=j
2127 nad_sms(n1)=nad_sms(n1)+1
2128 jdi_sms(nad_sms(j))=n1
2129 nad_sms(j)=nad_sms(j)+1
2130
2131 jsm_sms(nad_sms(n2))=nad_sms(j)
2132 jsm_sms(nad_sms(j)) =nad_sms(n2)
2133 jdi_sms(nad_sms(n2))=j
2134 nad_sms(n2)=nad_sms(n2)+1
2135 jdi_sms(nad_sms(j))=n2
2136 nad_sms(j)=nad_sms(j)+1
2137
2138 jsm_sms(nad_sms(n3))=nad_sms(j)
2139 jsm_sms(nad_sms(j)) =nad_sms(n3)
2140 jdi_sms(nad_sms(n3))=j
2141 nad_sms(n3)=nad_sms(n3)+1
2142 jdi_sms(nad_sms(j))=n3
2143 nad_sms(j)=nad_sms(j)+1
2144
2145 jsm_sms(nad_sms(n4))=nad_sms(j)
2146 jsm_sms(nad_sms(j)) =nad_sms(n4)
2147 jdi_sms(nad_sms(n4))=j
2148 nad_sms(n4)=nad_sms(n4)+1
2149 jdi_sms(nad_sms(j))=n4
2150 nad_sms(j)=nad_sms(j)+1
2151C
2152C-- Type2 crossed connection between main nodes
2153 IF ((t2main_sms(1,j)>0).AND.(i>j)) THEN
2154 DO k =1,4
2155 DO kk =1,4
2156 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
2157 jsm_sms(nad_sms(t2main_sms(k,i)))=nad_sms(t2main_sms(kk,j))
2158 jsm_sms(nad_sms(t2main_sms(kk,j)))=nad_sms(t2main_sms(k,i))
2159 jdi_sms(nad_sms(t2main_sms(k,i)))=t2main_sms(kk,j)
2160 nad_sms(t2main_sms(k,i))=nad_sms(t2main_sms(k,i))+1
2161 jdi_sms(nad_sms(t2main_sms(kk,j)))=t2main_sms(k,i)
2162 nad_sms(t2main_sms(kk,j))=nad_sms(t2main_sms(kk,j))+1
2163 ENDIF
2164 ENDDO
2165 ENDDO
2166 ENDIF
2167C
2168 END DO
2169 ELSE
2170C Penalty node
2171 l=intbuf_tab(n)%IRTLM(ii)
2172 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
2173 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
2174 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
2175 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
2176
2177 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
2178 . .AND.nativ_sms(n2)==0
2179 . .AND.nativ_sms(n3)==0
2180 . .AND.nativ_sms(n4)==0) cycle
2181
2182 jsm_sms(nad_sms(n1))=nad_sms(i)
2183 jsm_sms(nad_sms(i)) =nad_sms(n1)
2184 jdi_sms(nad_sms(n1))=i
2185 nad_sms(n1)=nad_sms(n1)+1
2186 jdi_sms(nad_sms(i))=n1
2187 nad_sms(i)=nad_sms(i)+1
2188
2189 jsm_sms(nad_sms(n2))=nad_sms(i)
2190 jsm_sms(nad_sms(i)) =nad_sms(n2)
2191 jdi_sms(nad_sms(n2))=i
2192 nad_sms(n2)=nad_sms(n2)+1
2193 jdi_sms(nad_sms(i))=n2
2194 nad_sms(i)=nad_sms(i)+1
2195
2196 jsm_sms(nad_sms(n3))=nad_sms(i)
2197 jsm_sms(nad_sms(i)) =nad_sms(n3)
2198 jdi_sms(nad_sms(n3))=i
2199 nad_sms(n3)=nad_sms(n3)+1
2200 jdi_sms(nad_sms(i))=n3
2201 nad_sms(i)=nad_sms(i)+1
2202
2203 jsm_sms(nad_sms(n4))=nad_sms(i)
2204 jsm_sms(nad_sms(i)) =nad_sms(n4)
2205 jdi_sms(nad_sms(n4))=i
2206 nad_sms(n4)=nad_sms(n4)+1
2207 jdi_sms(nad_sms(i))=n4
2208 nad_sms(i)=nad_sms(i)+1
2209 ENDIF
2210 END DO
2211 END IF
2212 END DO
2213C------------
2214 DO i=1,numnod
2215 nad_sms_0(i)=nad_sms(i)
2216 END DO
2217C------------
2218 DO i=1,numnod
2219 lad_sms(i)=jad_sms(i) + lad_sms(i) - 1
2220 END DO
2221c DO I=1,NUMNOD
2222c do kj=JAD_SMS(I),JAD_SMS(I+1)-1
2223c print *,i,jdi_sms(kj),jdi_sms(jsm_sms(kj))
2224c end do
2225c END DO
2226C-----------------------------------------------
2227C Check of the symmetrization operator JSM_SMS
2228C-----------------------------------------------
2229 error = 0
2230 DO i=1,numnod
2231 DO ij=jad_sms(i),jad_sms(i+1)-1
2232 j=jdi_sms(ij)
2233 IF(j > i)THEN
2234 ji=jsm_sms(ij)
2235 IF (ij/=jsm_sms(ji)) error = 1
2236 END IF
2237 END DO
2238 END DO
2239C
2240 IF (error==1) THEN
2241 CALL ancmsg(msgid=1242,anmode=aninfo,msgtype=msgerror)
2242 CALL arret(2)
2243 ENDIF
2244C-----------------------------------------------
2245 RETURN
2246 END
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
intstamp_mod
Definition intstamp_mod.F:38
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
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, tagprt_sms, kad_sms, kdi_sms, pk_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, lad_sms, ipart, igeo, nativ_sms, iad_sms, idi_sms, jad_sms, jdi_sms, t2main_sms)
Definition sms_init.F:1182
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, tagprt_sms, kad_sms, kdi_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, lad_sms, nprw, lprw, tagmsr_rby_sms, intstamp, ipart, igeo, nativ_sms, irbe2, lrbe2, iad_sms, idi_sms, jad_sms, jdi_sms, t2main_sms)
Definition sms_init.F:1572
nodnx_sms_ini
subroutine nodnx_sms_ini(numnod, numel, nix, mix, lix, ix, ipartx, tagprt_sms, nodnx_sms)
Definition sms_init.F:724
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, tagprt_sms, iad_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, lad_sms, ipart, igeo, nativ_sms)
Definition sms_init.F:777
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, kad_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, tagprt_sms, tagrel_sms, itab, irbe2, irbe3, lrbe2, lrbe3, nprw, lprw, ipart, igeo, nativ_sms)
Definition sms_init.F:393
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, tagprt_sms, kad_sms, kdi_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, lad_sms, jsm_sms, intstamp, ipart, igeo, tagmsr_rby_sms, nativ_sms, iad_sms, idi_sms, jad_sms, jdi_sms, t2main_sms)
Definition sms_init.F:1877
sms_init
subroutine sms_init(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs16, ixs20, iparg, nodnx_sms, icodt, icodr, kinet, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, tagprt_sms, itab, irbe2, irbe3, lrbe2, lrbe3, nprw, lprw, ipart, igeo, ipm, nativ_sms, npby, lpby, tagmsr_rby_sms, tagslv_rby_sms, nom_opt)
Definition sms_init.F:45
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
arret
subroutine arret(nn)
Definition arret.F:86
starter
program starter
Definition starter.F:39
intstamp_mod::intstamp_data
Definition intstamp_mod.F:46