OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_init.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "kincod_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "scr17_c.inc"
#include "com01_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)
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)
subroutine nodnx_sms_ini (numnod, numel, nix, mix, lix, ix, ipartx, tagprt_sms, nodnx_sms)
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)
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)
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)
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)

Function/Subroutine Documentation

◆ nodnx_sms_ini()

subroutine nodnx_sms_ini ( integer numnod,
integer numel,
integer nix,
integer mix,
integer lix,
integer, dimension(nix,*) ix,
integer, dimension(*) ipartx,
integer, dimension(*) tagprt_sms,
integer, dimension(*) nodnx_sms )

Definition at line 718 of file sms_init.F.

721C-----------------------------------------------
722C I m p l i c i t T y p e s
723C-----------------------------------------------
724#include "implicit_f.inc"
725C-----------------------------------------------
726C D u m m y A r g u m e n t s
727C-----------------------------------------------
728 INTEGER NUMNOD , NUMEL ,NIX ,MIX, LIX,
729 . IX(NIX,*), IPARTX(*), TAGPRT_SMS(*), NODNX_SMS(*)
730C-----------------------------------------------
731C L o c a l V a r i a b l e s
732C-----------------------------------------------
733 INTEGER I, J, K, TAG(NUMNOD)
734C-----------------------------------------------
735C S o u r c e L i n e s
736C-----------------------------------------------
737C
738 DO j=1,numel
739 IF(tagprt_sms(ipartx(j))==0) cycle
740
741 DO k=1,lix
742 i = ix(mix+k,j)
743 IF(i/=0) tag(i)=0
744 ENDDO
745 DO k=1,lix
746 i = ix(mix+k,j)
747 IF(i/=0)THEN
748 IF(tag(i)==0)THEN
749 nodnx_sms(i)=nodnx_sms(i)+1
750 tag(i)=1
751 END IF
752 END IF
753 ENDDO
754 ENDDO
755
756 RETURN

◆ sms_ini_jad_1()

subroutine sms_ini_jad_1 ( integer, dimension(nixc,*) ixc,
integer, dimension(nparg,*) iparg,
integer, dimension(nixs,*) ixs,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(6,*) ixs10,
integer, dimension(*) nodnx_sms,
integer, dimension(4,*) jadc_sms,
integer, dimension(8,*) jads_sms,
integer, dimension(6,*) jads10_sms,
integer, dimension(2,*) jadt_sms,
integer, dimension(2,*) jadp_sms,
integer, dimension(3,*) jadr_sms,
integer, dimension(3,*) jadtg_sms,
integer, dimension(*) tagprt_sms,
integer, dimension(*) kad_sms,
integer, dimension(*) kdi_sms,
integer, dimension(*) pk_sms,
integer, dimension(*) tagrel_sms,
integer, dimension(*) iparts,
integer, dimension(*) ipartq,
integer, dimension(*) ipartc,
integer, dimension(*) ipartt,
integer, dimension(*) ipartp,
integer, dimension(*) ipartr,
integer, dimension(*) iparttg,
integer, dimension(*) ipartx,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(*) kinet,
integer, dimension(*) tagslv_rby_sms,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) lad_sms,
integer, dimension(lipart1,*) ipart,
integer, dimension(npropgi,*) igeo,
integer, dimension(*) nativ_sms,
integer, dimension(*) iad_sms,
integer, dimension(*) idi_sms,
integer, dimension(*) jad_sms,
integer, dimension(*) jdi_sms,
integer, dimension(4,*) t2main_sms )

Definition at line 1168 of file sms_init.F.

1178C-----------------------------------------------
1179C M o d u l e s
1180C-----------------------------------------------
1181 USE intbufdef_mod
1182C-----------------------------------------------
1183C I m p l i c i t T y p e s
1184C-----------------------------------------------
1185#include "implicit_f.inc"
1186C-----------------------------------------------
1187C C o m m o n B l o c k s
1188C-----------------------------------------------
1189#include "com04_c.inc"
1190#include "param_c.inc"
1191#include "sms_c.inc"
1192#include "scr17_c.inc"
1193C-----------------------------------------------------------------
1194C D u m m y A r g u m e n t s
1195C-----------------------------------------------
1196 INTEGER
1197 . IPARG(NPARG,*), IXC(NIXC,*), IXS(NIXS,*), IXT(NIXT,*),
1198 . IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*), IXS10(6,*),
1199 . NODNX_SMS(*), KAD_SMS(*), KDI_SMS(*), PK_SMS(*),
1200 . IAD_SMS(*), IDI_SMS(*), JAD_SMS(*), JDI_SMS(*),
1201 . JADC_SMS(4,*),
1202 . JADS_SMS(8,*), JADS10_SMS(6,*),
1203 . JADT_SMS(2,*),
1204 . JADP_SMS(2,*),
1205 . JADR_SMS(3,*),
1206 . JADTG_SMS(3,*),NATIV_SMS(*),
1207 . TAGPRT_SMS(*), TAGREL_SMS(*),
1208 . IPARTS(*), IPARTQ(*), IPARTC(*), IPARTT(*),
1209 . IPARTP(*), IPARTR(*), IPARTTG(*), IPARTX(*),
1210 . NPBY(NNPBY,*), LPBY(*), KINET(*), TAGSLV_RBY_SMS(*),
1211 . IPARI(NPARI,*),
1212 . LAD_SMS(*),
1213 . IPART(LIPART1,*), IGEO(NPROPGI,*),T2MAIN_SMS(4,*)
1214 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1215C-----------------------------------------------
1216C L o c a l V a r i a b l e s
1217C-----------------------------------------------
1218 INTEGER I, J, K, JJ, KK, II, IJ, M, N, IERROR, KL
1219 INTEGER NMN, IUN
1220 INTEGER MSR, NSN, KI, KJ, NAD_SMS(NUMNOD),
1221 . NSR
1222 INTEGER SIZE, LENR, IAD, L, LLT
1223 INTEGER NTY, ILAGM, K10, K11, K12, K13, K14, JI,
1224 . N1, N2, N3, N4, LNEW, ILEV
1225 INTEGER TAGK(NUMNOD), IK, NK, IKK,PERM,
1226 . ITRI(NUMNOD),INDEX(2*NUMNOD),INDEX2(NUMNOD),WORK(70000)
1227 LOGICAL ITERATE
1228 DATA iun/1/
1229C-------------------------------------------------------------------------
1230C PREPARE KOMPACTION OF ELEMENTARY MATRIX
1231C construit IDI_SMS et pointeurs KAD_SMS vers JAD_SMS
1232C 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
1233C-------------------------------------------------------------------------
1234 tagk(1:numnod)=0
1235C
1236 DO i=1,numnod
1237 nk=0
1238 DO kj=kad_sms(i),kad_sms(i+1)-1
1239 ik =kdi_sms(kj)
1240 IF(tagk(ik)==0)THEN
1241 idi_sms(iad_sms(i)+nk)=ik
1242 nk=nk+1
1243 tagk(ik)=nk
1244 END IF
1245 END DO
1246C
1247C reordonne IDI_SMS(KJ), KJ=IAD_SMS(I),IAD_SMS(I)+LAD_SMS(I)-1
1248 DO ik=1,nk
1249 kj=iad_sms(i)+ik-1
1250 itri(ik) =idi_sms(kj)
1251 index(ik)=ik
1252 END DO
1253
1254 IF(nk/=0)THEN
1255
1256 IF(nk<16)THEN
1257C When #of connectivities are small
1258C Bubble sort is more efficient
1259
1260 iterate=.true.
1261 DO WHILE (iterate .EQV. .true.)
1262 iterate=.false.
1263 DO j=1,nk-1
1264 IF(itri(j)> itri(j+1) )THEN
1265 perm = itri(j)
1266 itri(j) = itri(j+1)
1267 itri(j+1)=perm
1268
1269 perm = index(j)
1270 index(j) = index(j+1)
1271 index(j+1) = perm
1272
1273 iterate = .true.
1274 ENDIF
1275 ENDDO
1276 ENDDO
1277 DO ik=1,nk
1278 kj=iad_sms(i)+ik-1
1279 idi_sms(kj)=itri(ik)
1280 END DO
1281
1282
1283 ELSE
1284 CALL my_orders(0,work,itri,index,nk,1)
1285
1286 DO ik=1,nk
1287 kj=iad_sms(i)+ik-1
1288 idi_sms(kj)=itri(index(ik))
1289 END DO
1290
1291 ENDIF
1292 ENDIF
1293
1294
1295
1296 DO ik=1,nk
1297 ikk =index(ik)
1298 index2(ikk)=ik
1299 END DO
1300
1301 DO kj=kad_sms(i),kad_sms(i+1)-1
1302 ik = kdi_sms(kj)
1303 pk_sms(kj)= index2(tagk(ik))
1304 END DO
1305
1306 DO kj=kad_sms(i),kad_sms(i+1)-1
1307 ik =kdi_sms(kj)
1308 tagk(ik)=0
1309 END DO
1310
1311 END DO
1312C-------------------------------------------------------------------------
1313 DO i=1,numnod+1
1314 jad_sms(i)=iad_sms(i)
1315 END DO
1316 DO i=1,numnod
1317 DO kj=iad_sms(i),iad_sms(i+1)-1
1318 jdi_sms(kj)=idi_sms(kj)
1319 END DO
1320 END DO
1321C-------------------------------------------------------------------------
1322C inter/type2 : numbering
1323C------------
1324 kinet(1:numnod) = 0
1325C
1326C Tag des mains pour TYPE2 symetrisees
1327C
1328 DO n=1,ninter
1329 nty = ipari(7,n)
1330 IF (nty == 2) THEN
1331 nmn = ipari(6,n)
1332 ilev = ipari(20,n)
1333c
1334 DO i=1,nmn
1335 j = intbuf_tab(n)%MSR(i)
1336 IF (ilev == 0 .OR. ilev == 1 .OR. ilev == 27 .OR. ilev == 28) THEN
1337 kinet(j) = kinet(j)+1
1338 ENDIF
1339 ENDDO
1340 ENDIF
1341 ENDDO
1342C
1343 DO n=1,ninter
1344 nty = ipari(7,n)
1345 IF (nty == 2) THEN
1346 nmn = ipari(6,n)
1347 ilev = ipari(20,n)
1348c
1349 DO i=1,nmn
1350 j = intbuf_tab(n)%MSR(i)
1351 IF (ilev == 0 .OR. ilev == 1 .OR. ilev == 27 .OR. ilev == 28) THEN
1352 kinet(j) = kinet(j)+1
1353 ENDIF
1354 ENDDO
1355 ENDIF
1356 ENDDO
1357C
1358 DO n=1,numnod
1359 IF(kinet(n)/=0) kinet(n)=min(iun,kinet(n)-1) ! KINET == 1 <=> Incompatible conditions
1360 END DO
1361C------------
1362C
1363C---- First pass - detection of main nodes for crossed type 2 connection
1364C
1365 DO n=1,ninter
1366 nty = ipari(7,n)
1367 ilagm = ipari(33,n)
1368 ilev = ipari(20,n)
1369 nsn = ipari(5,n)
1370 IF(nty==2 .AND. ilagm==0 .AND.ilev/=25 .and. ilev/=26.AND. ilev/=27 .and. ilev/=28)THEN
1371 DO ii=1,nsn
1372 i=abs(intbuf_tab(n)%NSV(ii))
1373 l=intbuf_tab(n)%IRTLM(ii)
1374 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1375 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1376 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1377 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1378C
1379 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1380 . .AND.nativ_sms(n2)==0
1381 . .AND.nativ_sms(n3)==0
1382 . .AND.nativ_sms(n4)==0) cycle
1383 t2main_sms(1,i) = n1
1384 t2main_sms(2,i) = n2
1385 t2main_sms(3,i) = n3
1386 t2main_sms(4,i) = n4
1387
1388 ENDDO
1389 ELSEIF(nty==2 .AND. ilagm==0 .AND.(ilev==27.or.ilev==28))THEN
1390 DO ii=1,nsn
1391 i=abs(intbuf_tab(n)%NSV(ii))
1392 IF (intbuf_tab(n)%IRUPT(ii)==0) THEN
1393C Kinematic node
1394 l=intbuf_tab(n)%IRTLM(ii)
1395 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1396 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1397 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1398 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1399C
1400 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1401 . .AND.nativ_sms(n2)==0
1402 . .AND.nativ_sms(n3)==0
1403 . .AND.nativ_sms(n4)==0) cycle
1404 t2main_sms(1,i) = n1
1405 t2main_sms(2,i) = n2
1406 t2main_sms(3,i) = n3
1407 t2main_sms(4,i) = n4
1408
1409 ENDIF
1410 ENDDO
1411 ENDIF
1412 ENDDO
1413C
1414 DO n=1,ninter
1415 nty = ipari(7,n)
1416 ilagm = ipari(33,n)
1417 ilev = ipari(20,n)
1418 IF(nty==2 .AND. ilagm==0 .AND.ilev/=25 .and. ilev/=26.AND. ilev/=27 .and. ilev/=28)THEN
1419 nsn=ipari(5,n)
1420 DO ii=1,nsn
1421 i=abs(intbuf_tab(n)%NSV(ii))
1422 l=intbuf_tab(n)%IRTLM(ii)
1423 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1424 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1425 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1426 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1427
1428 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1429 . .AND.nativ_sms(n2)==0
1430 . .AND.nativ_sms(n3)==0
1431 . .AND.nativ_sms(n4)==0) cycle
1432
1433 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1434 j =jdi_sms(kj)
1435 nodnx_sms(j) =nodnx_sms(j) +4
1436 nodnx_sms(n1)=nodnx_sms(n1)+1
1437 nodnx_sms(n2)=nodnx_sms(n2)+1
1438 nodnx_sms(n3)=nodnx_sms(n3)+1
1439 nodnx_sms(n4)=nodnx_sms(n4)+1
1440 nnz_sms = nnz_sms + 8
1441C-- Type2 crossed connection between main nodes
1442 IF ((t2main_sms(1,j)>0).AND.(i>j)) THEN
1443 DO k =1,4
1444 DO kk =1,4
1445 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
1446 nodnx_sms(t2main_sms(k,i))=nodnx_sms(t2main_sms(k,i))+1
1447 nodnx_sms(t2main_sms(kk,j))=nodnx_sms(t2main_sms(kk,j))+1
1448 nnz_sms = nnz_sms + 2
1449 ENDIF
1450 ENDDO
1451 ENDDO
1452 ENDIF
1453 END DO
1454 END DO
1455 ELSEIF(nty==2 .AND. ilagm==0 .AND.(ilev==25.or.ilev==26))THEN
1456 nsn=ipari(5,n)
1457 DO ii=1,nsn
1458 i=abs(intbuf_tab(n)%NSV(ii))
1459 l=intbuf_tab(n)%IRTLM(ii)
1460 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1461 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1462 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1463 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1464
1465 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1466 . .AND.nativ_sms(n2)==0
1467 . .AND.nativ_sms(n3)==0
1468 . .AND.nativ_sms(n4)==0) cycle
1469
1470 nodnx_sms(i) =nodnx_sms(i) +4
1471 nodnx_sms(n1)=nodnx_sms(n1)+1
1472 nodnx_sms(n2)=nodnx_sms(n2)+1
1473 nodnx_sms(n3)=nodnx_sms(n3)+1
1474 nodnx_sms(n4)=nodnx_sms(n4)+1
1475 nnz_sms = nnz_sms + 8
1476 END DO
1477 ELSEIF(nty==2 .AND. ilagm==0 .AND.(ilev==27.or.ilev==28))THEN
1478 nsn=ipari(5,n)
1479 DO ii=1,nsn
1480 i=abs(intbuf_tab(n)%NSV(ii))
1481 IF (kinet(i)==0) THEN
1482C Kinematic node
1483 l=intbuf_tab(n)%IRTLM(ii)
1484 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1485 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1486 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1487 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1488
1489 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1490 . .AND.nativ_sms(n2)==0
1491 . .AND.nativ_sms(n3)==0
1492 . .AND.nativ_sms(n4)==0) cycle
1493
1494 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1495 j =jdi_sms(kj)
1496 nodnx_sms(j) =nodnx_sms(j) +4
1497 nodnx_sms(n1)=nodnx_sms(n1)+1
1498 nodnx_sms(n2)=nodnx_sms(n2)+1
1499 nodnx_sms(n3)=nodnx_sms(n3)+1
1500 nodnx_sms(n4)=nodnx_sms(n4)+1
1501 nnz_sms = nnz_sms + 8
1502C-- Type2 crossed connection between main nodes
1503 IF ((t2main_sms(1,j)>0).AND.(i>j)) THEN
1504 DO k =1,4
1505 DO kk =1,4
1506 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
1507 nodnx_sms(t2main_sms(k,i))=nodnx_sms(t2main_sms(k,i))+1
1508 nodnx_sms(t2main_sms(kk,j))=nodnx_sms(t2main_sms(kk,j))+1
1509 nnz_sms = nnz_sms + 2
1510 ENDIF
1511 ENDDO
1512 ENDDO
1513 ENDIF
1514 END DO
1515 ELSE
1516C Penalty node
1517 l=intbuf_tab(n)%IRTLM(ii)
1518 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1519 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1520 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1521 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1522
1523 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1524 . .AND.nativ_sms(n2)==0
1525 . .AND.nativ_sms(n3)==0
1526 . .AND.nativ_sms(n4)==0) cycle
1527
1528 nodnx_sms(i) =nodnx_sms(i) +4
1529 nodnx_sms(n1)=nodnx_sms(n1)+1
1530 nodnx_sms(n2)=nodnx_sms(n2)+1
1531 nodnx_sms(n3)=nodnx_sms(n3)+1
1532 nodnx_sms(n4)=nodnx_sms(n4)+1
1533 nnz_sms = nnz_sms + 8
1534 ENDIF
1535 END DO
1536 END IF
1537 END DO
1538C
1539C reconstruit JAD_SMS
1540 jad_sms(1)=1
1541 DO i=1,numnod
1542 jad_sms(i+1)=jad_sms(i)+nodnx_sms(i)
1543 END DO
1544C-----------------------------------------------
1545 RETURN
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

◆ sms_ini_jad_2()

subroutine sms_ini_jad_2 ( integer, dimension(nixc,*) ixc,
integer, dimension(nparg,*) iparg,
integer, dimension(nixs,*) ixs,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(6,*) ixs10,
integer, dimension(*) nodnx_sms,
integer, dimension(4,*) jadc_sms,
integer, dimension(8,*) jads_sms,
integer, dimension(6,*) jads10_sms,
integer, dimension(2,*) jadt_sms,
integer, dimension(2,*) jadp_sms,
integer, dimension(3,*) jadr_sms,
integer, dimension(3,*) jadtg_sms,
integer, dimension(*) tagprt_sms,
integer, dimension(*) kad_sms,
integer, dimension(*) kdi_sms,
integer, dimension(*) tagrel_sms,
integer, dimension(*) iparts,
integer, dimension(*) ipartq,
integer, dimension(*) ipartc,
integer, dimension(*) ipartt,
integer, dimension(*) ipartp,
integer, dimension(*) ipartr,
integer, dimension(*) iparttg,
integer, dimension(*) ipartx,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(*) kinet,
integer, dimension(*) tagslv_rby_sms,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) lad_sms,
integer, dimension(*) nprw,
integer, dimension(*) lprw,
integer, dimension(*) tagmsr_rby_sms,
type(intstamp_data), dimension(*) intstamp,
integer, dimension(lipart1,*) ipart,
integer, dimension(npropgi,*) igeo,
integer, dimension(*) nativ_sms,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2,
integer, dimension(*) iad_sms,
integer, dimension(*) idi_sms,
integer, dimension(*) jad_sms,
integer, dimension(*) jdi_sms,
integer, dimension(4,*) t2main_sms )

Definition at line 1555 of file sms_init.F.

1567C-----------------------------------------------
1568C M o d u l e s
1569C-----------------------------------------------
1570 USE intstamp_mod
1571 USE intbufdef_mod
1572 USE message_mod
1573C-----------------------------------------------
1574C I m p l i c i t T y p e s
1575C-----------------------------------------------
1576#include "implicit_f.inc"
1577C-----------------------------------------------
1578C C o m m o n B l o c k s
1579C-----------------------------------------------
1580#include "com04_c.inc"
1581#include "param_c.inc"
1582#include "sms_c.inc"
1583#include "scr17_c.inc"
1584C-----------------------------------------------------------------
1585C D u m m y A r g u m e n t s
1586C-----------------------------------------------
1587 INTEGER
1588 . IPARG(NPARG,*), IXC(NIXC,*), IXS(NIXS,*), IXT(NIXT,*),
1589 . IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*), IXS10(6,*),
1590 . NODNX_SMS(*), KAD_SMS(*), KDI_SMS(*),
1591 . IAD_SMS(*), IDI_SMS(*), JAD_SMS(*), JDI_SMS(*),
1592 . JADC_SMS(4,*),
1593 . JADS_SMS(8,*), JADS10_SMS(6,*),
1594 . JADT_SMS(2,*),
1595 . JADP_SMS(2,*),
1596 . JADR_SMS(3,*),
1597 . JADTG_SMS(3,*),
1598 . TAGPRT_SMS(*), TAGREL_SMS(*),
1599 . IPARTS(*), IPARTQ(*), IPARTC(*), IPARTT(*),
1600 . IPARTP(*), IPARTR(*), IPARTTG(*), IPARTX(*),
1601 . NPBY(NNPBY,*), LPBY(*), KINET(*), TAGSLV_RBY_SMS(*),
1602 . IPARI(NPARI,*),
1603 . LAD_SMS(*),
1604 . NPRW(*), LPRW(*), TAGMSR_RBY_SMS(*),
1605 . IPART(LIPART1,*), IGEO(NPROPGI,*), NATIV_SMS(*),
1606 . IRBE2(NRBE2L,*), LRBE2(*), T2MAIN_SMS(4,*)
1607
1608 TYPE(INTSTAMP_DATA) INTSTAMP(*)
1609 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1610C-----------------------------------------------
1611C L o c a l V a r i a b l e s
1612C-----------------------------------------------
1613 INTEGER I, J, K, JJ, KK, II, IJ, M, N, IERROR, KL,
1614 . NHI, NS
1615 INTEGER MSR, NSN, KI, KJ, NAD_SMS(NUMNOD), NAD_SMS_0(NUMNOD),
1616 . NSR, NSMS(2)
1617 INTEGER NSNW, IMOV
1618 INTEGER SIZE, LENR, IAD, L, LLT
1619 INTEGER NTY, ILAGM, JI,
1620 . N1, N2, N3, N4, N5, N6,
1621 . NMN, ILEV
1622 INTEGER IK
1623C-------------------------------------------------------------------------
1624C PREPARE KOMPACTION OF ELEMENTARY MATRIX
1625C 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
1626C
1627C Reconstruit JDI_SMS :: Recopie IDI_SMS (connectivite elementaire compactee et triee)
1628C-------------------------------------------------------------------------
1629 DO i=1,numnod
1630 DO kj=iad_sms(i),iad_sms(i+1)-1
1631 ik=kj-iad_sms(i)
1632 jdi_sms(jad_sms(i)+ik)=idi_sms(kj)
1633 END DO
1634 END DO
1635C-------------------------------------------------------------------------
1636C inter/type2 : construction de JDI_SMS
1637C-------------------------------------------------------------------------
1638 DO i=1,numnod
1639 nad_sms(i)=jad_sms(i)+lad_sms(i)
1640 END DO
1641
1642C
1643 DO n=1,ninter
1644 nty = ipari(7,n)
1645 ilagm = ipari(33,n)
1646 ilev = ipari(20,n)
1647 IF(nty==2 .AND. ilagm==0 .AND.ilev/=25 .and. ilev/=26 .AND.ilev/=27 .and. ilev/=28)THEN
1648C
1649 nsn=ipari(5,n)
1650 DO ii=1,nsn
1651 i=abs(intbuf_tab(n)%NSV(ii))
1652 l=intbuf_tab(n)%IRTLM(ii)
1653 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1654 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1655 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1656 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1657
1658 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1659 . .AND.nativ_sms(n2)==0
1660 . .AND.nativ_sms(n3)==0
1661 . .AND.nativ_sms(n4)==0) cycle
1662
1663 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1664 j =jdi_sms(kj)
1665C
1666 jdi_sms(nad_sms(n1))=j
1667 nad_sms(n1)=nad_sms(n1)+1
1668 jdi_sms(nad_sms(j))=n1
1669 nad_sms(j)=nad_sms(j)+1
1670C
1671 jdi_sms(nad_sms(n2))=j
1672 nad_sms(n2)=nad_sms(n2)+1
1673 jdi_sms(nad_sms(j))=n2
1674 nad_sms(j)=nad_sms(j)+1
1675C
1676 jdi_sms(nad_sms(n3))=j
1677 nad_sms(n3)=nad_sms(n3)+1
1678 jdi_sms(nad_sms(j))=n3
1679 nad_sms(j)=nad_sms(j)+1
1680C
1681 jdi_sms(nad_sms(n4))=j
1682 nad_sms(n4)=nad_sms(n4)+1
1683 jdi_sms(nad_sms(j))=n4
1684 nad_sms(j)=nad_sms(j)+1
1685C
1686C-- Type2 crossed connection between main nodes
1687 IF ((t2main_sms(1,j)>0).AND.(i>j)) THEN
1688 DO k =1,4
1689 DO kk =1,4
1690 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
1691 jdi_sms(nad_sms(t2main_sms(k,i)))=t2main_sms(kk,j)
1692 nad_sms(t2main_sms(k,i))=nad_sms(t2main_sms(k,i))+1
1693 jdi_sms(nad_sms(t2main_sms(kk,j)))=t2main_sms(k,i)
1694 nad_sms(t2main_sms(kk,j))=nad_sms(t2main_sms(kk,j))+1
1695 ENDIF
1696 ENDDO
1697 ENDDO
1698 ENDIF
1699C
1700 END DO
1701 END DO
1702 ELSEIF(nty==2.AND.ilagm==0.AND.(ilev==25.or.ilev==26))THEN
1703 nsn=ipari(5,n)
1704 DO ii=1,nsn
1705 i=abs(intbuf_tab(n)%NSV(ii))
1706 l=intbuf_tab(n)%IRTLM(ii)
1707 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1708 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1709 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1710 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1711
1712 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1713 . .AND.nativ_sms(n2)==0
1714 . .AND.nativ_sms(n3)==0
1715 . .AND.nativ_sms(n4)==0) cycle
1716
1717 jdi_sms(nad_sms(n1))=i
1718 nad_sms(n1)=nad_sms(n1)+1
1719 jdi_sms(nad_sms(i))=n1
1720 nad_sms(i)=nad_sms(i)+1
1721
1722 jdi_sms(nad_sms(n2))=i
1723 nad_sms(n2)=nad_sms(n2)+1
1724 jdi_sms(nad_sms(i))=n2
1725 nad_sms(i)=nad_sms(i)+1
1726
1727 jdi_sms(nad_sms(n3))=i
1728 nad_sms(n3)=nad_sms(n3)+1
1729 jdi_sms(nad_sms(i))=n3
1730 nad_sms(i)=nad_sms(i)+1
1731
1732 jdi_sms(nad_sms(n4))=i
1733 nad_sms(n4)=nad_sms(n4)+1
1734 jdi_sms(nad_sms(i))=n4
1735 nad_sms(i)=nad_sms(i)+1
1736 END DO
1737C
1738 ELSEIF(nty==2.AND.ilagm==0.AND.(ilev==27.or.ilev==28))THEN
1739C
1740 nsn=ipari(5,n)
1741 DO ii=1,nsn
1742 i=abs(intbuf_tab(n)%NSV(ii))
1743 IF (kinet(i)==0) THEN
1744C Kinematic node
1745 l=intbuf_tab(n)%IRTLM(ii)
1746 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1747 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1748 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1749 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1750
1751 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1752 . .AND.nativ_sms(n2)==0
1753 . .AND.nativ_sms(n3)==0
1754 . .AND.nativ_sms(n4)==0) cycle
1755
1756 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1757 j =jdi_sms(kj)
1758C
1759 jdi_sms(nad_sms(n1))=j
1760 nad_sms(n1)=nad_sms(n1)+1
1761 jdi_sms(nad_sms(j))=n1
1762 nad_sms(j)=nad_sms(j)+1
1763C
1764 jdi_sms(nad_sms(n2))=j
1765 nad_sms(n2)=nad_sms(n2)+1
1766 jdi_sms(nad_sms(j))=n2
1767 nad_sms(j)=nad_sms(j)+1
1768C
1769 jdi_sms(nad_sms(n3))=j
1770 nad_sms(n3)=nad_sms(n3)+1
1771 jdi_sms(nad_sms(j))=n3
1772 nad_sms(j)=nad_sms(j)+1
1773C
1774 jdi_sms(nad_sms(n4))=j
1775 nad_sms(n4)=nad_sms(n4)+1
1776 jdi_sms(nad_sms(j))=n4
1777 nad_sms(j)=nad_sms(j)+1
1778C
1779C-- Type2 crossed connection between main nodes
1780 IF ((t2main_sms(1,j)>0).AND.(i>j)) THEN
1781 DO k =1,4
1782 DO kk =1,4
1783 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
1784 jdi_sms(nad_sms(t2main_sms(k,i)))=t2main_sms(kk,j)
1785 nad_sms(t2main_sms(k,i))=nad_sms(t2main_sms(k,i))+1
1786 jdi_sms(nad_sms(t2main_sms(kk,j)))=t2main_sms(k,i)
1787 nad_sms(t2main_sms(kk,j))=nad_sms(t2main_sms(kk,j))+1
1788 ENDIF
1789 ENDDO
1790 ENDDO
1791C
1792 ENDIF
1793 END DO
1794C
1795 ELSE
1796C Penalty node
1797 l=intbuf_tab(n)%IRTLM(ii)
1798 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1799 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1800 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1801 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1802
1803 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1804 . .AND.nativ_sms(n2)==0
1805 . .AND.nativ_sms(n3)==0
1806 . .AND.nativ_sms(n4)==0) cycle
1807
1808 jdi_sms(nad_sms(n1))=i
1809 nad_sms(n1)=nad_sms(n1)+1
1810 jdi_sms(nad_sms(i))=n1
1811 nad_sms(i)=nad_sms(i)+1
1812
1813 jdi_sms(nad_sms(n2))=i
1814 nad_sms(n2)=nad_sms(n2)+1
1815 jdi_sms(nad_sms(i))=n2
1816 nad_sms(i)=nad_sms(i)+1
1817
1818 jdi_sms(nad_sms(n3))=i
1819 nad_sms(n3)=nad_sms(n3)+1
1820 jdi_sms(nad_sms(i))=n3
1821 nad_sms(i)=nad_sms(i)+1
1822
1823 jdi_sms(nad_sms(n4))=i
1824 nad_sms(n4)=nad_sms(n4)+1
1825 jdi_sms(nad_sms(i))=n4
1826 nad_sms(i)=nad_sms(i)+1
1827 ENDIF
1828 END DO
1829 END IF
1830 END DO
1831C------------
1832C Recalcule NNZ_SMS de la matrice compactee
1833C------------
1834 nnz_sms=0
1835 DO i=1,numnod
1836 nodnx_sms(i)=nad_sms(i)-jad_sms(i)
1837 nnz_sms=nnz_sms+nodnx_sms(i)
1838 END DO
1839C------------
1840C reconstruit JAD_SMS
1841 jad_sms(1)=1
1842 DO i=1,numnod
1843 jad_sms(i+1)=jad_sms(i)+nodnx_sms(i)
1844 END DO
1845C-----------------------------------------------
1846 RETURN
intstamp_mod
Definition intstamp_mod.F:38
message_mod
Definition message_mod.F:1249

◆ sms_ini_jad_3()

subroutine sms_ini_jad_3 ( integer, dimension(nixc,*) ixc,
integer, dimension(nparg,*) iparg,
integer, dimension(nixs,*) ixs,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(6,*) ixs10,
integer, dimension(*) nodnx_sms,
integer, dimension(4,*) jadc_sms,
integer, dimension(8,*) jads_sms,
integer, dimension(6,*) jads10_sms,
integer, dimension(2,*) jadt_sms,
integer, dimension(2,*) jadp_sms,
integer, dimension(3,*) jadr_sms,
integer, dimension(3,*) jadtg_sms,
integer, dimension(*) tagprt_sms,
integer, dimension(*) kad_sms,
integer, dimension(*) kdi_sms,
integer, dimension(*) tagrel_sms,
integer, dimension(*) iparts,
integer, dimension(*) ipartq,
integer, dimension(*) ipartc,
integer, dimension(*) ipartt,
integer, dimension(*) ipartp,
integer, dimension(*) ipartr,
integer, dimension(*) iparttg,
integer, dimension(*) ipartx,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(*) kinet,
integer, dimension(*) tagslv_rby_sms,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) lad_sms,
integer, dimension(*) jsm_sms,
type(intstamp_data), dimension(*) intstamp,
integer, dimension(lipart1,*) ipart,
integer, dimension(npropgi,*) igeo,
integer, dimension(*) tagmsr_rby_sms,
integer, dimension(*) nativ_sms,
integer, dimension(*) iad_sms,
integer, dimension(*) idi_sms,
integer, dimension(*) jad_sms,
integer, dimension(*) jdi_sms,
integer, dimension(4,*) t2main_sms )

Definition at line 1859 of file sms_init.F.

1871C-----------------------------------------------
1872C M o d u l e s
1873C-----------------------------------------------
1874 USE intstamp_mod
1875 USE intbufdef_mod
1876 USE message_mod
1877C-----------------------------------------------
1878C I m p l i c i t T y p e s
1879C-----------------------------------------------
1880#include "implicit_f.inc"
1881C-----------------------------------------------
1882C C o m m o n B l o c k s
1883C-----------------------------------------------
1884#include "com04_c.inc"
1885#include "param_c.inc"
1886#include "scr17_c.inc"
1887C-----------------------------------------------
1888C D u m m y A r g u m e n t s
1889C-----------------------------------------------
1890 INTEGER
1891 . IPARG(NPARG,*), IXC(NIXC,*), IXS(NIXS,*), IXT(NIXT,*),
1892 . IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*), IXS10(6,*),
1893 . NODNX_SMS(*), KAD_SMS(*), KDI_SMS(*),
1894 . IAD_SMS(*), IDI_SMS(*), JAD_SMS(*), JDI_SMS(*),
1895 . JADC_SMS(4,*),
1896 . JADS_SMS(8,*), JADS10_SMS(6,*),
1897 . JADT_SMS(2,*),
1898 . JADP_SMS(2,*),
1899 . JADR_SMS(3,*),
1900 . JADTG_SMS(3,*),NATIV_SMS(*),
1901 . TAGPRT_SMS(*), TAGREL_SMS(*),
1902 . IPARTS(*), IPARTQ(*), IPARTC(*), IPARTT(*),
1903 . IPARTP(*), IPARTR(*), IPARTTG(*), IPARTX(*),
1904 . NPBY(NNPBY,*), LPBY(*), KINET(*), TAGSLV_RBY_SMS(*),
1905 . IPARI(NPARI,*),
1906 . LAD_SMS(*), JSM_SMS(*),
1907 . IPART(LIPART1,*), IGEO(NPROPGI,*), TAGMSR_RBY_SMS(*), T2MAIN_SMS(4,*)
1908 TYPE(INTSTAMP_DATA) INTSTAMP(*)
1909 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1910C-----------------------------------------------
1911C L o c a l V a r i a b l e s
1912C-----------------------------------------------
1913 INTEGER I, J, K, JJ, KK, II, IJ, M, N, IERROR, KL
1914 INTEGER MSR, NSN, KI, KJ, NAD_SMS(NUMNOD), NAD_SMS_0(NUMNOD),
1915 . NSR
1916 INTEGER SIZE, LENR, IAD, L, LLT
1917 INTEGER NTY, ILAGM, K10, K11, K12, K13, K14, JI,
1918 . N1, N2, N3, N4,
1919 . NMN, ILEV, ERROR
1920 INTEGER IK, NK, K1, K2, KM
1921C-------------------------------------------------------------------------
1922C PREPARE KOMPACTION OF ELEMENTARY MATRIX
1923C 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
1924C
1925C Reconstruit JDI_SMS :: Recopie IDI_SMS (connectivite elementaire compactee et triee)
1926C-------------------------------------------------------------------------
1927 DO i=1,numnod
1928 DO kj=iad_sms(i),iad_sms(i+1)-1
1929 ik=kj-iad_sms(i)
1930 jdi_sms(jad_sms(i)+ik)=idi_sms(kj)
1931 END DO
1932 END DO
1933C-------------------------------------------------------------------------
1934C PREPARE JSM_SMS (connectivite elementaire)
1935C-------------------------------------------------------------------------
1936 DO i=1,numnod
1937 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1938 j =jdi_sms(kj)
1939cc IF(I < J)THEN
1940C
1941C dichotomie (recherche parmi les voisins ordonnes de J)
1942 k1=jad_sms(j)
1943 k2=jad_sms(j)+lad_sms(j)-1
1944 100 CONTINUE
1945 km=(k1+k2)/2
1946 IF(jdi_sms(k1) == i)THEN
1947 jsm_sms(kj)=k1
1948cc JSM_SMS(K1)=KJ
1949 GOTO 200
1950 ELSEIF(jdi_sms(k2) == i)THEN
1951 jsm_sms(kj)=k2
1952cc JSM_SMS(K2)=KJ
1953 GOTO 200
1954 ELSEIF(jdi_sms(km) == i)THEN
1955 jsm_sms(kj)=km
1956cc JSM_SMS(KM)=KJ
1957 GOTO 200
1958 ELSEIF(jdi_sms(km) < i)THEN
1959 k1=km
1960 GOTO 100
1961 ELSE ! JDI_SMS(KM) > I
1962 k2=km
1963 GOTO 100
1964 END IF
1965 WRITE(6,*) ' ** internal error in AMS initialization'
1966 200 CONTINUE
1967cc END IF
1968 END DO
1969 END DO
1970C
1971 DO i=1,numnod
1972 nad_sms(i)=jad_sms(i)+lad_sms(i)
1973 END DO
1974C
1975C inter/type2 : reconstruction (jdi et jsm)
1976C------------
1977 DO n=1,ninter
1978 nty = ipari(7,n)
1979 ilagm = ipari(33,n)
1980 ilev = ipari(20,n)
1981 IF(nty==2 .AND. ilagm==0 .AND.ilev/=25 .and. ilev/=26.AND.ilev/=27 .and. ilev/=28)THEN
1982C
1983 nsn=ipari(5,n)
1984 DO ii=1,nsn
1985 i=abs(intbuf_tab(n)%NSV(ii))
1986
1987 l=intbuf_tab(n)%IRTLM(ii)
1988 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
1989 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
1990 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
1991 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
1992
1993 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
1994 . .AND.nativ_sms(n2)==0
1995 . .AND.nativ_sms(n3)==0
1996 . .AND.nativ_sms(n4)==0) cycle
1997
1998 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
1999 j =jdi_sms(kj)
2000
2001 jsm_sms(nad_sms(n1))=nad_sms(j)
2002 jsm_sms(nad_sms(j)) =nad_sms(n1)
2003 jdi_sms(nad_sms(n1))=j
2004 nad_sms(n1)=nad_sms(n1)+1
2005 jdi_sms(nad_sms(j))=n1
2006 nad_sms(j)=nad_sms(j)+1
2007
2008 jsm_sms(nad_sms(n2))=nad_sms(j)
2009 jsm_sms(nad_sms(j)) =nad_sms(n2)
2010 jdi_sms(nad_sms(n2))=j
2011 nad_sms(n2)=nad_sms(n2)+1
2012 jdi_sms(nad_sms(j))=n2
2013 nad_sms(j)=nad_sms(j)+1
2014
2015 jsm_sms(nad_sms(n3))=nad_sms(j)
2016 jsm_sms(nad_sms(j)) =nad_sms(n3)
2017 jdi_sms(nad_sms(n3))=j
2018 nad_sms(n3)=nad_sms(n3)+1
2019 jdi_sms(nad_sms(j))=n3
2020 nad_sms(j)=nad_sms(j)+1
2021
2022 jsm_sms(nad_sms(n4))=nad_sms(j)
2023 jsm_sms(nad_sms(j)) =nad_sms(n4)
2024 jdi_sms(nad_sms(n4))=j
2025 nad_sms(n4)=nad_sms(n4)+1
2026 jdi_sms(nad_sms(j))=n4
2027 nad_sms(j)=nad_sms(j)+1
2028C
2029C-- Type2 crossed connection between main nodes
2030 IF ((t2main_sms(1,j)>0).AND.(i>j)) THEN
2031 DO k =1,4
2032 DO kk =1,4
2033 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
2034 jsm_sms(nad_sms(t2main_sms(k,i)))=nad_sms(t2main_sms(kk,j))
2035 jsm_sms(nad_sms(t2main_sms(kk,j)))=nad_sms(t2main_sms(k,i))
2036 jdi_sms(nad_sms(t2main_sms(k,i)))=t2main_sms(kk,j)
2037 nad_sms(t2main_sms(k,i))=nad_sms(t2main_sms(k,i))+1
2038 jdi_sms(nad_sms(t2main_sms(kk,j)))=t2main_sms(k,i)
2039 nad_sms(t2main_sms(kk,j))=nad_sms(t2main_sms(kk,j))+1
2040 ENDIF
2041 ENDDO
2042 ENDDO
2043 ENDIF
2044C
2045 END DO
2046 END DO
2047 ELSEIF(nty==2.AND.ilagm==0.AND.(ilev==25.or.ilev==26))THEN
2048 k10=ipari(1,n)
2049 k11=k10+4*ipari(3,n)
2050 k12=k11+4*ipari(4,n)
2051 k13=k12+ipari(5,n)
2052 k14=k13+ipari(6,n)
2053 nsn=ipari(5,n)
2054 DO ii=1,nsn
2055 i=abs(intbuf_tab(n)%NSV(ii))
2056 l=intbuf_tab(n)%IRTLM(ii)
2057 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
2058 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
2059 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
2060 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
2061
2062 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
2063 . .AND.nativ_sms(n2)==0
2064 . .AND.nativ_sms(n3)==0
2065 . .AND.nativ_sms(n4)==0) cycle
2066
2067 jsm_sms(nad_sms(n1))=nad_sms(i)
2068 jsm_sms(nad_sms(i)) =nad_sms(n1)
2069 jdi_sms(nad_sms(n1))=i
2070 nad_sms(n1)=nad_sms(n1)+1
2071 jdi_sms(nad_sms(i))=n1
2072 nad_sms(i)=nad_sms(i)+1
2073
2074 jsm_sms(nad_sms(n2))=nad_sms(i)
2075 jsm_sms(nad_sms(i)) =nad_sms(n2)
2076 jdi_sms(nad_sms(n2))=i
2077 nad_sms(n2)=nad_sms(n2)+1
2078 jdi_sms(nad_sms(i))=n2
2079 nad_sms(i)=nad_sms(i)+1
2080
2081 jsm_sms(nad_sms(n3))=nad_sms(i)
2082 jsm_sms(nad_sms(i)) =nad_sms(n3)
2083 jdi_sms(nad_sms(n3))=i
2084 nad_sms(n3)=nad_sms(n3)+1
2085 jdi_sms(nad_sms(i))=n3
2086 nad_sms(i)=nad_sms(i)+1
2087
2088 jsm_sms(nad_sms(n4))=nad_sms(i)
2089 jsm_sms(nad_sms(i)) =nad_sms(n4)
2090 jdi_sms(nad_sms(n4))=i
2091 nad_sms(n4)=nad_sms(n4)+1
2092 jdi_sms(nad_sms(i))=n4
2093 nad_sms(i)=nad_sms(i)+1
2094 END DO
2095 ELSEIF(nty==2.AND.ilagm==0.AND.(ilev==27.or.ilev==28))THEN
2096C
2097 nsn=ipari(5,n)
2098 DO ii=1,nsn
2099 i=abs(intbuf_tab(n)%NSV(ii))
2100 IF (kinet(i)==0) THEN
2101C Kinematic node
2102
2103 l=intbuf_tab(n)%IRTLM(ii)
2104 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
2105 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
2106 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
2107 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
2108
2109 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
2110 . .AND.nativ_sms(n2)==0
2111 . .AND.nativ_sms(n3)==0
2112 . .AND.nativ_sms(n4)==0) cycle
2113
2114 DO kj=jad_sms(i),jad_sms(i)+lad_sms(i)-1
2115 j =jdi_sms(kj)
2116
2117 jsm_sms(nad_sms(n1))=nad_sms(j)
2118 jsm_sms(nad_sms(j)) =nad_sms(n1)
2119 jdi_sms(nad_sms(n1))=j
2120 nad_sms(n1)=nad_sms(n1)+1
2121 jdi_sms(nad_sms(j))=n1
2122 nad_sms(j)=nad_sms(j)+1
2123
2124 jsm_sms(nad_sms(n2))=nad_sms(j)
2125 jsm_sms(nad_sms(j)) =nad_sms(n2)
2126 jdi_sms(nad_sms(n2))=j
2127 nad_sms(n2)=nad_sms(n2)+1
2128 jdi_sms(nad_sms(j))=n2
2129 nad_sms(j)=nad_sms(j)+1
2130
2131 jsm_sms(nad_sms(n3))=nad_sms(j)
2132 jsm_sms(nad_sms(j)) =nad_sms(n3)
2133 jdi_sms(nad_sms(n3))=j
2134 nad_sms(n3)=nad_sms(n3)+1
2135 jdi_sms(nad_sms(j))=n3
2136 nad_sms(j)=nad_sms(j)+1
2137
2138 jsm_sms(nad_sms(n4))=nad_sms(j)
2139 jsm_sms(nad_sms(j)) =nad_sms(n4)
2140 jdi_sms(nad_sms(n4))=j
2141 nad_sms(n4)=nad_sms(n4)+1
2142 jdi_sms(nad_sms(j))=n4
2143 nad_sms(j)=nad_sms(j)+1
2144C
2145C-- Type2 crossed connection between main nodes
2146 IF ((t2main_sms(1,j)>0).AND.(i>j)) THEN
2147 DO k =1,4
2148 DO kk =1,4
2149 IF (t2main_sms(k,i)/=t2main_sms(kk,j)) THEN
2150 jsm_sms(nad_sms(t2main_sms(k,i)))=nad_sms(t2main_sms(kk,j))
2151 jsm_sms(nad_sms(t2main_sms(kk,j)))=nad_sms(t2main_sms(k,i))
2152 jdi_sms(nad_sms(t2main_sms(k,i)))=t2main_sms(kk,j)
2153 nad_sms(t2main_sms(k,i))=nad_sms(t2main_sms(k,i))+1
2154 jdi_sms(nad_sms(t2main_sms(kk,j)))=t2main_sms(k,i)
2155 nad_sms(t2main_sms(kk,j))=nad_sms(t2main_sms(kk,j))+1
2156 ENDIF
2157 ENDDO
2158 ENDDO
2159 ENDIF
2160C
2161 END DO
2162 ELSE
2163C Penalty node
2164 l=intbuf_tab(n)%IRTLM(ii)
2165 n1 = intbuf_tab(n)%IRECTM(4*(l-1)+1)
2166 n2 = intbuf_tab(n)%IRECTM(4*(l-1)+2)
2167 n3 = intbuf_tab(n)%IRECTM(4*(l-1)+3)
2168 n4 = intbuf_tab(n)%IRECTM(4*(l-1)+4)
2169
2170 IF(nativ_sms(i)==0.AND.nativ_sms(n1)==0
2171 . .AND.nativ_sms(n2)==0
2172 . .AND.nativ_sms(n3)==0
2173 . .AND.nativ_sms(n4)==0) cycle
2174
2175 jsm_sms(nad_sms(n1))=nad_sms(i)
2176 jsm_sms(nad_sms(i)) =nad_sms(n1)
2177 jdi_sms(nad_sms(n1))=i
2178 nad_sms(n1)=nad_sms(n1)+1
2179 jdi_sms(nad_sms(i))=n1
2180 nad_sms(i)=nad_sms(i)+1
2181
2182 jsm_sms(nad_sms(n2))=nad_sms(i)
2183 jsm_sms(nad_sms(i)) =nad_sms(n2)
2184 jdi_sms(nad_sms(n2))=i
2185 nad_sms(n2)=nad_sms(n2)+1
2186 jdi_sms(nad_sms(i))=n2
2187 nad_sms(i)=nad_sms(i)+1
2188
2189 jsm_sms(nad_sms(n3))=nad_sms(i)
2190 jsm_sms(nad_sms(i)) =nad_sms(n3)
2191 jdi_sms(nad_sms(n3))=i
2192 nad_sms(n3)=nad_sms(n3)+1
2193 jdi_sms(nad_sms(i))=n3
2194 nad_sms(i)=nad_sms(i)+1
2195
2196 jsm_sms(nad_sms(n4))=nad_sms(i)
2197 jsm_sms(nad_sms(i)) =nad_sms(n4)
2198 jdi_sms(nad_sms(n4))=i
2199 nad_sms(n4)=nad_sms(n4)+1
2200 jdi_sms(nad_sms(i))=n4
2201 nad_sms(i)=nad_sms(i)+1
2202 ENDIF
2203 END DO
2204 END IF
2205 END DO
2206C------------
2207 DO i=1,numnod
2208 nad_sms_0(i)=nad_sms(i)
2209 END DO
2210C------------
2211 DO i=1,numnod
2212 lad_sms(i)=jad_sms(i) + lad_sms(i) - 1
2213 END DO
2214c DO I=1,NUMNOD
2215c do kj=JAD_SMS(I),JAD_SMS(I+1)-1
2216c print *,i,jdi_sms(kj),jdi_sms(jsm_sms(kj))
2217c end do
2218c END DO
2219C-----------------------------------------------
2220C Check of the symmetrization operator JSM_SMS
2221C-----------------------------------------------
2222 error = 0
2223 DO i=1,numnod
2224 DO ij=jad_sms(i),jad_sms(i+1)-1
2225 j=jdi_sms(ij)
2226 IF(j > i)THEN
2227 ji=jsm_sms(ij)
2228 IF (ij/=jsm_sms(ji)) error = 1
2229 END IF
2230 END DO
2231 END DO
2232C
2233 IF (error==1) THEN
2234 CALL ancmsg(msgid=1242,anmode=aninfo,msgtype=msgerror)
2235 CALL arret(2)
2236 ENDIF
2237C-----------------------------------------------
2238 RETURN
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87

◆ sms_ini_kad()

subroutine sms_ini_kad ( integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(4,*) ixtg1,
integer, dimension(6,*) ixs10,
integer, dimension(6,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(nparg,*) iparg,
ms,
ms0,
integer, dimension(*) nodnx_sms,
integer, dimension(*) icodt,
integer, dimension(*) icodr,
integer, dimension(*) kinet,
integer, dimension(*) kad_sms,
integer, dimension(*) iparts,
integer, dimension(*) ipartq,
integer, dimension(*) ipartc,
integer, dimension(*) ipartt,
integer, dimension(*) ipartp,
integer, dimension(*) ipartr,
integer, dimension(*) iparttg,
integer, dimension(*) ipartx,
integer, dimension(*) tagprt_sms,
integer, dimension(*) tagrel_sms,
integer, dimension(*) itab,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe2,
integer, dimension(*) lrbe3,
integer, dimension(*) nprw,
integer, dimension(*) lprw,
integer, dimension(lipart1,*) ipart,
integer, dimension(npropgi,*) igeo,
integer, dimension(*) nativ_sms )

Definition at line 381 of file sms_init.F.

391C-----------------------------------------------
392C I m p l i c i t T y p e s
393C-----------------------------------------------
394#include "implicit_f.inc"
395C-----------------------------------------------
396C C o m m o n B l o c k s
397C-----------------------------------------------
398#include "com01_c.inc"
399#include "com04_c.inc"
400#include "param_c.inc"
401#include "sms_c.inc"
402#include "scr17_c.inc"
403C-----------------------------------------------
404C D u m m y A r g u m e n t s
405C-----------------------------------------------
406 INTEGER
407 . IXS(NIXS,*),IXS10(6,*) ,IXS16(6,*) ,IXS20(12,*),
408 . IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
409 . IXR(NIXR,*), IXTG(NIXTG,*), IXTG1(4,*),
410 . IPARG(NPARG,*),
411 . NODNX_SMS(*), ICODT(*), ICODR(*), KINET(*),
412 . KAD_SMS(*),
413 . IPARTS(*),IPARTQ(*),IPARTC(*),IPARTT(*),
414 . IPARTP(*),IPARTR(*),IPARTTG(*),IPARTX(*),
415 . TAGPRT_SMS(*), TAGREL_SMS(*),
416 . ITAB(*),
417 . IRBE2(NRBE2L,*), IRBE3(NRBE3L,*), LRBE2(*), LRBE3(*),
418 . NPRW(*), LPRW(*),
419 . IPART(LIPART1,*), IGEO(NPROPGI,*), NATIV_SMS(*)
420C REAL
421 my_real
422 . ms(*), ms0(*)
423C-----------------------------------------------
424C L o c a l V a r i a b l e s
425C-----------------------------------------------
426 INTEGER I, J, K, NG, N, JJ, KK, ITY, NEL, NFT, ISOLNOD,
427 . IAD, IP, NAD_SMS(NUMNOD),ILOC4(4),IWORK(NUMNOD),
428 . TAG8(8), IG, IGTYP
429 INTEGER J1, IPERM1(6), IPERM2(6),IPENTA6(6)
430 DATA iloc4/1,3,6,5/
431 DATA iperm1/1,2,3,1,2,3/
432 DATA iperm2/2,3,1,4,4,4/
433 DATA ipenta6/1,2,3,5,6,7/
434C
435C-----------------------------------------------
436 tagrel_sms(1:ngroup)=0
437C
438 DO i=1,numnod
439 nad_sms(i)=0
440 END DO
441
442 knz_sms = 0
443
444 DO ng=1,ngroup
445 ity =iparg(5,ng)
446
447 nel = iparg(2,ng)
448 nft = iparg(3,ng)
449 isolnod = iparg(28,ng)
450 IF(ity==1.AND.isolnod==4)THEN
451 DO j=nft+1,nft+nel
452 DO k=1,4
453
454 i=ixs(1+iloc4(k),j)
455
456 DO kk=1,4
457 jj = ixs(1+iloc4(kk),j)
458 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
459 tagrel_sms(ng)=1
460 nad_sms(i)=nad_sms(i)+1
461 knz_sms =knz_sms+1
462 END IF
463 END DO
464
465 END DO
466 END DO
467 ELSEIF(ity==1.AND.isolnod==6)THEN
468 DO j=nft+1,nft+nel
469 DO k=1,6
470
471 i=ixs(1+ipenta6(k),j)
472 DO kk=1,6
473 jj = ixs(1+ipenta6(kk),j)
474 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
475 tagrel_sms(ng)=1
476 nad_sms(i)=nad_sms(i)+1
477 knz_sms =knz_sms+1
478 END IF
479 END DO
480
481 END DO
482 END DO
483 ELSEIF(ity==1.AND.isolnod==8)THEN
484 DO j=nft+1,nft+nel
485
486 DO k=1,8
487 i=ixs(1+k,j)
488 iwork(i)=0
489 tag8(k)=0
490 END DO
491
492 DO k=1,8
493 i=ixs(1+k,j)
494 IF(iwork(i)/=0)THEN
495 tag8(k)=1
496 ELSE
497 iwork(i)=1
498 END IF
499 END DO
500
501 DO k=1,8
502
503 i=ixs(1+k,j)
504 IF(tag8(k)/=0)cycle
505
506 DO kk=1,8
507 jj = ixs(1+kk,j)
508 IF(tag8(kk)/=0) cycle
509
510 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
511 tagrel_sms(ng)=1
512 nad_sms(i)=nad_sms(i)+1
513 knz_sms =knz_sms+1
514 END IF
515 END DO
516
517 END DO
518 END DO
519 ELSEIF(ity==1.AND.isolnod==10)THEN
520 DO j=nft+1,nft+nel
521 j1=j-numels8
522
523 DO k=1,4
524
525 i=ixs(1+iloc4(k),j)
526 DO kk=1,4
527 jj = ixs(1+iloc4(kk),j)
528 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
529 tagrel_sms(ng)=1
530 nad_sms(i)=nad_sms(i)+1
531 knz_sms =knz_sms+1
532 END IF
533 END DO
534
535 DO kk=1,6
536 jj=ixs10(kk,j1)
537 IF(jj==0) cycle
538
539 IF(.NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
540 tagrel_sms(ng)=1
541 nad_sms(i)=nad_sms(i)+1
542 knz_sms =knz_sms+1
543 END IF
544 END DO
545
546 END DO
547
548 DO k=1,6
549
550 i=ixs10(k,j1)
551 IF(i==0) cycle
552
553 DO kk=1,4
554 jj = ixs(1+iloc4(kk),j)
555 IF(.NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
556 tagrel_sms(ng)=1
557 nad_sms(i)=nad_sms(i)+1
558 knz_sms =knz_sms+1
559 END IF
560 END DO
561
562 DO kk=1,6
563 jj=ixs10(kk,j1)
564 IF(jj==0) cycle
565
566 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
567 tagrel_sms(ng)=1
568 nad_sms(i)=nad_sms(i)+1
569 knz_sms =knz_sms+1
570 END IF
571 END DO
572
573 END DO
574
575 END DO
576 ELSEIF(ity==3)THEN
577 DO j=nft+1,nft+nel
578 DO k=1,4
579
580 i=ixc(1+k,j)
581 DO kk=1,4
582 jj = ixc(1+kk,j)
583 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
584 tagrel_sms(ng)=1
585 nad_sms(i)=nad_sms(i)+1
586 knz_sms =knz_sms+1
587 END IF
588 END DO
589
590 END DO
591 END DO
592 ELSEIF(ity==4)THEN
593 DO j=nft+1,nft+nel
594 DO k=1,2
595
596 i=ixt(1+k,j)
597 DO kk=1,2
598 jj = ixt(1+kk,j)
599 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
600 tagrel_sms(ng)=1
601 nad_sms(i)=nad_sms(i)+1
602 knz_sms =knz_sms+1
603 END IF
604 END DO
605
606 END DO
607 END DO
608 ELSEIF(ity==5)THEN
609 DO j=nft+1,nft+nel
610 DO k=1,2
611 i=ixp(1+k,j)
612 DO kk=1,2
613 jj = ixp(1+kk,j)
614 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
615 tagrel_sms(ng)=1
616 nad_sms(i)=nad_sms(i)+1
617 knz_sms =knz_sms+1
618 END IF
619 END DO
620 END DO
621 END DO
622 ELSEIF(ity==6)THEN
623 ig = ipart(2,ipartr(nft+1))
624 igtyp = igeo(11,ig)
625 IF(igtyp/=12)THEN
626 DO j=nft+1,nft+nel
627 DO k=1,2
628 i=ixr(1+k,j)
629 DO kk=1,2
630 jj = ixr(1+kk,j)
631 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
632 tagrel_sms(ng)=1
633 nad_sms(i)=nad_sms(i)+1
634 knz_sms =knz_sms+1
635 END IF
636 END DO
637 END DO
638 END DO
639 ELSE
640 DO j=nft+1,nft+nel
641 k=1
642
643 i=ixr(1+k,j)
644
645 kk=2
646 jj = ixr(1+kk,j)
647 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
648 tagrel_sms(ng)=1
649 nad_sms(i)=nad_sms(i)+1
650 knz_sms =knz_sms+1
651 END IF
652
653 k=2
654
655 i=ixr(1+k,j)
656
657 kk=1
658 jj = ixr(1+kk,j)
659 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
660 tagrel_sms(ng)=1
661 nad_sms(i)=nad_sms(i)+1
662 knz_sms =knz_sms+1
663 END IF
664
665 kk=3
666 jj = ixr(1+kk,j)
667 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
668 tagrel_sms(ng)=1
669 nad_sms(i)=nad_sms(i)+1
670 knz_sms =knz_sms+1
671 END IF
672
673 k=3
674
675 i=ixr(1+k,j)
676
677 kk=2
678 jj = ixr(1+kk,j)
679 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
680 tagrel_sms(ng)=1
681 nad_sms(i)=nad_sms(i)+1
682 knz_sms =knz_sms+1
683 END IF
684
685 END DO
686 END IF
687 ELSEIF(ity==7)THEN
688 DO j=nft+1,nft+nel
689 DO k=1,3
690
691 i=ixtg(1+k,j)
692 DO kk=1,3
693 jj = ixtg(1+kk,j)
694 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
695 tagrel_sms(ng)=1
696 nad_sms(i)=nad_sms(i)+1
697 knz_sms =knz_sms+1
698 END IF
699 END DO
700
701 END DO
702 END DO
703 END IF
704 END DO
705C
706 kad_sms(1)=1
707 DO i=1,numnod
708 kad_sms(i+1)=kad_sms(i)+nad_sms(i)
709 END DO
710C-----------------------------------------------
711 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ sms_ini_kdi()

subroutine sms_ini_kdi ( integer, dimension(nixc,*) ixc,
integer, dimension(nparg,*) iparg,
integer, dimension(nixs,*) ixs,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(6,*) ixs10,
integer, dimension(*) nodnx_sms,
integer, dimension(*) kad_sms,
integer, dimension(*) kdi_sms,
integer, dimension(4,*) jadc_sms,
integer, dimension(8,*) jads_sms,
integer, dimension(6,*) jads10_sms,
integer, dimension(2,*) jadt_sms,
integer, dimension(2,*) jadp_sms,
integer, dimension(3,*) jadr_sms,
integer, dimension(3,*) jadtg_sms,
integer, dimension(*) tagprt_sms,
integer, dimension(*) iad_sms,
integer, dimension(*) tagrel_sms,
integer, dimension(*) iparts,
integer, dimension(*) ipartq,
integer, dimension(*) ipartc,
integer, dimension(*) ipartt,
integer, dimension(*) ipartp,
integer, dimension(*) ipartr,
integer, dimension(*) iparttg,
integer, dimension(*) ipartx,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(*) kinet,
integer, dimension(*) tagslv_rby_sms,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) lad_sms,
integer, dimension(lipart1,*) ipart,
integer, dimension(npropgi,*) igeo,
integer, dimension(*) nativ_sms )

Definition at line 764 of file sms_init.F.

774C-----------------------------------------------
775C M o d u l e s
776C-----------------------------------------------
777 USE intbufdef_mod
778C-----------------------------------------------
779C I m p l i c i t T y p e s
780C-----------------------------------------------
781#include "implicit_f.inc"
782C-----------------------------------------------
783C C o m m o n B l o c k s
784C-----------------------------------------------
785#include "com01_c.inc"
786#include "com04_c.inc"
787#include "param_c.inc"
788#include "sms_c.inc"
789#include "scr17_c.inc"
790C-----------------------------------------------------------------
791C D u m m y A r g u m e n t s
792C-----------------------------------------------
793 INTEGER
794 . IPARG(NPARG,*), IXC(NIXC,*), IXS(NIXS,*), IXT(NIXT,*),
795 . IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*), IXS10(6,*),
796 . NODNX_SMS(*), KAD_SMS(*), IAD_SMS(*),
797 . JADC_SMS(4,*),
798 . JADS_SMS(8,*), JADS10_SMS(6,*),
799 . JADT_SMS(2,*),
800 . JADP_SMS(2,*),
801 . JADR_SMS(3,*),
802 . JADTG_SMS(3,*), NATIV_SMS(*),
803 . TAGPRT_SMS(*), TAGREL_SMS(*),
804 . IPARTS(*), IPARTQ(*), IPARTC(*), IPARTT(*),
805 . IPARTP(*), IPARTR(*), IPARTTG(*), IPARTX(*),
806 . NPBY(NNPBY,*), LPBY(*), KINET(*), TAGSLV_RBY_SMS(*),
807 . IPARI(NPARI,*),
808 . LAD_SMS(*), KDI_SMS(*),
809 . IPART(LIPART1,*), IGEO(NPROPGI,*)
810 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
811C-----------------------------------------------
812C L o c a l V a r i a b l e s
813C-----------------------------------------------
814 INTEGER I, J, K, JJ, KK, II, IJ, M, N, IERROR, KL
815 INTEGER NG, ITY, NEL, NFT, ISOLNOD,ILOC4(4),TAGA(NUMNOD),
816 . TAG8(8), IG, IGTYP
817 INTEGER MSR, NSN, KI, KJ, NAD_SMS(NUMNOD),
818 . NSR
819 INTEGER SIZE, LENR, IAD, L, LLT
820 INTEGER NTY, ILAGM,JI, N1, N2, N3, N4, LNEW, ILEV
821 INTEGER J1, IPERM1(6), IPERM2(6),IPENTA6(6)
822 INTEGER TAGK(NUMNOD), IK, NK
823 DATA iloc4/1,3,6,5/
824 DATA iperm1/1,2,3,1,2,3/
825 DATA iperm2/2,3,1,4,4,4/
826 DATA ipenta6/1,2,3,5,6,7/
827C-----------------------------------------------
828C
829C Construit JDI_SMS, JADS_SMS, etc
830C -----------------
831 DO i=1,numnod
832 nad_sms(i)=kad_sms(i)
833 END DO
834C
835 DO ng=1,ngroup
836C
837 IF(tagrel_sms(ng)==0)cycle
838 ity =iparg(5,ng)
839
840 nel = iparg(2,ng)
841 nft = iparg(3,ng)
842 isolnod = iparg(28,ng)
843 IF(ity==1.AND.isolnod==4)THEN
844 DO j=nft+1,nft+nel
845
846 DO k=1,4
847 i=ixs(1+iloc4(k),j)
848 jads_sms(k,j)=nad_sms(i)
849
850 ij=jads_sms(k,j)
851 DO kk=1,4
852 jj = ixs(1+iloc4(kk),j)
853 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
854 nad_sms(i)=nad_sms(i)+1
855 kdi_sms(ij)=jj
856 ij=ij+1
857 END IF
858 END DO
859 END DO
860 END DO
861 ELSEIF(ity==1.AND.isolnod==6)THEN
862 DO j=nft+1,nft+nel
863
864 DO k=1,6
865 i=ixs(1+ipenta6(k),j)
866 jads_sms(k,j)=nad_sms(i)
867
868 ij=jads_sms(k,j)
869 DO kk=1,6
870 jj = ixs(1+ipenta6(kk),j)
871 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
872 nad_sms(i)=nad_sms(i)+1
873 kdi_sms(ij)=jj
874 ij=ij+1
875 END IF
876 END DO
877 END DO
878 END DO
879 ELSEIF(ity==1.AND.isolnod==8)THEN
880 DO j=nft+1,nft+nel
881
882 DO k=1,8
883 i=ixs(1+k,j)
884 taga(i)=0
885 tag8(k)=0
886 END DO
887
888 DO k=1,8
889 i=ixs(1+k,j)
890 IF(taga(i)/=0)THEN
891 tag8(k)=1
892 ELSE
893 taga(i)=1
894 END IF
895 END DO
896
897 DO k=1,8
898 i=ixs(1+k,j)
899 jads_sms(k,j)=nad_sms(i)
900 END DO
901
902 DO k=1,8
903
904 i=ixs(1+k,j)
905 IF(tag8(k)/=0)cycle
906
907 ij=jads_sms(k,j)
908 DO kk=1,8
909 jj = ixs(1+kk,j)
910 IF(tag8(kk)/=0) cycle
911
912 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
913 nad_sms(i)=nad_sms(i)+1
914 kdi_sms(ij)=jj
915 ij=ij+1
916 END IF
917 END DO
918
919 END DO
920
921 END DO
922 ELSEIF(ity==1.AND.isolnod==10)THEN
923 DO j=nft+1,nft+nel
924 j1=j-numels8
925
926 DO k=1,4
927
928 i=ixs(1+iloc4(k),j)
929 jads_sms(k,j)=nad_sms(i)
930
931 ij=jads_sms(k,j)
932 DO kk=1,4
933 jj = ixs(1+iloc4(kk),j)
934 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
935 nad_sms(i)=nad_sms(i)+1
936 kdi_sms(ij)=jj
937 ij=ij+1
938 END IF
939 END DO
940
941 DO kk=1,6
942 jj=ixs10(kk,j1)
943 IF(jj==0) cycle
944
945 IF(.NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
946 nad_sms(i)=nad_sms(i)+1
947 kdi_sms(ij)=jj
948 ij=ij+1
949 END IF
950 END DO
951
952 END DO
953
954
955 DO k=1,6
956
957 i=ixs10(k,j1)
958 IF(i==0) cycle
959
960 jads10_sms(k,j1)=nad_sms(i)
961
962 ij=jads10_sms(k,j1)
963 DO kk=1,4
964 jj = ixs(1+iloc4(kk),j)
965 IF(.NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
966 nad_sms(i)=nad_sms(i)+1
967 kdi_sms(ij)=jj
968 ij=ij+1
969 END IF
970 END DO
971
972 DO kk=1,6
973 jj=ixs10(kk,j1)
974 IF(jj==0) cycle
975
976 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
977 nad_sms(i)=nad_sms(i)+1
978 kdi_sms(ij)=jj
979 ij=ij+1
980 END IF
981 END DO
982
983 END DO
984
985 END DO
986 ELSEIF(ity==3)THEN
987 DO j=nft+1,nft+nel
988
989 DO k=1,4
990 i=ixc(1+k,j)
991 jadc_sms(k,j)=nad_sms(i)
992
993 ij=jadc_sms(k,j)
994 DO kk=1,4
995 jj = ixc(1+kk,j)
996 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
997 nad_sms(i)=nad_sms(i)+1
998 kdi_sms(ij)=jj
999 ij=ij+1
1000 END IF
1001 END DO
1002 END DO
1003 END DO
1004 ELSEIF(ity==4)THEN
1005 DO j=nft+1,nft+nel
1006
1007 DO k=1,2
1008 i=ixt(1+k,j)
1009 jadt_sms(k,j)=nad_sms(i)
1010
1011 ij=jadt_sms(k,j)
1012 DO kk=1,2
1013 jj = ixt(1+kk,j)
1014 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1015 nad_sms(i)=nad_sms(i)+1
1016 kdi_sms(ij)=jj
1017 ij=ij+1
1018 END IF
1019 END DO
1020 END DO
1021 END DO
1022 ELSEIF(ity==5)THEN
1023 DO j=nft+1,nft+nel
1024
1025 DO k=1,2
1026 i=ixp(1+k,j)
1027 jadp_sms(k,j)=nad_sms(i)
1028
1029 ij=jadp_sms(k,j)
1030 DO kk=1,2
1031 jj = ixp(1+kk,j)
1032 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1033 nad_sms(i)=nad_sms(i)+1
1034 kdi_sms(ij)=jj
1035 ij=ij+1
1036 END IF
1037 END DO
1038 END DO
1039 END DO
1040 ELSEIF(ity==6)THEN
1041 ig = ipart(2,ipartr(nft+1))
1042 igtyp = igeo(11,ig)
1043 IF(igtyp/=12)THEN
1044 DO j=nft+1,nft+nel
1045
1046 DO k=1,2
1047 i=ixr(1+k,j)
1048 jadr_sms(k,j)=nad_sms(i)
1049
1050 ij=jadr_sms(k,j)
1051 DO kk=1,2
1052 jj = ixr(1+kk,j)
1053 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1054 nad_sms(i)=nad_sms(i)+1
1055 kdi_sms(ij)=jj
1056 ij=ij+1
1057 END IF
1058 END DO
1059 END DO
1060 END DO
1061 ELSE
1062 DO j=nft+1,nft+nel
1063 k=1
1064 i=ixr(1+k,j)
1065 jadr_sms(k,j)=nad_sms(i)
1066
1067 ij=jadr_sms(k,j)
1068 kk=2
1069 jj = ixr(1+kk,j)
1070 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1071 nad_sms(i)=nad_sms(i)+1
1072 kdi_sms(ij)=jj
1073 ij=ij+1
1074 END IF
1075
1076 k=2
1077 i=ixr(1+k,j)
1078 jadr_sms(k,j)=nad_sms(i)
1079
1080 ij=jadr_sms(k,j)
1081 kk=1
1082 jj = ixr(1+kk,j)
1083 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1084 nad_sms(i)=nad_sms(i)+1
1085 kdi_sms(ij)=jj
1086 ij=ij+1
1087 END IF
1088
1089 kk=3
1090 jj = ixr(1+kk,j)
1091 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1092 nad_sms(i)=nad_sms(i)+1
1093 kdi_sms(ij)=jj
1094 ij=ij+1
1095 END IF
1096
1097 k=3
1098 i=ixr(1+k,j)
1099 jadr_sms(k,j)=nad_sms(i)
1100
1101 ij=jadr_sms(k,j)
1102 kk=2
1103 jj = ixr(1+kk,j)
1104 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1105 nad_sms(i)=nad_sms(i)+1
1106 kdi_sms(ij)=jj
1107 ij=ij+1
1108 END IF
1109 END DO
1110 END IF
1111 ELSEIF(ity==7)THEN
1112 DO j=nft+1,nft+nel
1113
1114 DO k=1,3
1115 i=ixtg(1+k,j)
1116 jadtg_sms(k,j)=nad_sms(i)
1117
1118 ij=jadtg_sms(k,j)
1119 DO kk=1,3
1120 jj = ixtg(1+kk,j)
1121 IF(jj/=i.AND..NOT.(nativ_sms(i)==0.AND.nativ_sms(jj)==0))THEN
1122 nad_sms(i)=nad_sms(i)+1
1123 kdi_sms(ij)=jj
1124 ij=ij+1
1125 END IF
1126 END DO
1127 END DO
1128 END DO
1129 END IF
1130 END DO
1131C-------------------------------------------------------------------------
1132C PREPARE KOMPACTION OF ELEMENTARY MATRIX
1133C NODNX_SMS(I) devient le nb de nds connectes a I
1134C-------------------------------------------------------------------------
1135 tagk(1:numnod)=0
1136 DO i=1,numnod
1137 nodnx_sms(i)=0
1138 DO kj=kad_sms(i),kad_sms(i+1)-1
1139 ik =kdi_sms(kj)
1140 IF(tagk(ik)==0)THEN
1141 nodnx_sms(i)=nodnx_sms(i)+1
1142 tagk(ik)=1
1143 END IF
1144 END DO
1145 DO kj=kad_sms(i),kad_sms(i+1)-1
1146 ik =kdi_sms(kj)
1147 tagk(ik)=0
1148 END DO
1149 END DO
1150C
1151 iad_sms(1)=1
1152 DO i=1,numnod
1153 iad_sms(i+1)=iad_sms(i)+nodnx_sms(i)
1154 lad_sms(i) =nodnx_sms(i)
1155 END DO
1156C
1157 nnz_sms = iad_sms(numnod+1)
1158C
1159 RETURN

◆ sms_init()

subroutine sms_init ( integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(4,*) ixtg1,
integer, dimension(6,*) ixs10,
integer, dimension(6,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(nparg,*) iparg,
integer, dimension(*) nodnx_sms,
integer, dimension(*) icodt,
integer, dimension(*) icodr,
integer, dimension(*) kinet,
integer, dimension(*) iparts,
integer, dimension(*) ipartq,
integer, dimension(*) ipartc,
integer, dimension(*) ipartt,
integer, dimension(*) ipartp,
integer, dimension(*) ipartr,
integer, dimension(*) iparttg,
integer, dimension(*) ipartx,
integer, dimension(*) tagprt_sms,
integer, dimension(*) itab,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe2,
integer, dimension(*) lrbe3,
integer, dimension(*) nprw,
integer, dimension(*) lprw,
integer, dimension(lipart1,*) ipart,
integer, dimension(npropgi,*) igeo,
integer, dimension(npropmi,*) ipm,
integer, dimension(*) nativ_sms,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(*) tagmsr_rby_sms,
integer, dimension(*) tagslv_rby_sms,
integer, dimension(lnopt1,*) nom_opt )

Definition at line 34 of file sms_init.F.

45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE message_mod
49 USE names_and_titles_mod , ONLY : nchartitle
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com04_c.inc"
58#include "kincod_c.inc"
59#include "param_c.inc"
60#include "units_c.inc"
61#include "scr17_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER
66 . IXS(NIXS,*),IXS10(6,*) ,IXS16(6,*) ,IXS20(12,*),
67 . IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
68 . IXR(NIXR,*), IXTG(NIXTG,*), IXTG1(4,*),
69 . IPARG(NPARG,*),
70 . NODNX_SMS(*), ICODT(*), ICODR(*), KINET(*),
71 . IPARTS(*),IPARTQ(*),IPARTC(*),IPARTT(*),
72 . IPARTP(*),IPARTR(*),IPARTTG(*),IPARTX(*),
73 . TAGPRT_SMS(*),
74 . ITAB(*),
75 . IRBE2(NRBE2L,*), IRBE3(NRBE3L,*), LRBE2(*), LRBE3(*),
76 . NPRW(*), LPRW(*),
77 . IPART(LIPART1,*), IGEO(NPROPGI,*), IPM(NPROPMI,*), NATIV_SMS(*),
78 . NPBY(NNPBY,*), LPBY(*), TAGMSR_RBY_SMS(*), TAGSLV_RBY_SMS(*)
79 INTEGER NOM_OPT(LNOPT1,*)
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER I, J, K, NG, N, JJ, KK, ITY, NEL, NFT, ISOLNOD,
84 . IAD, IP, NAD_SMS(NUMNOD),ILOC4(4),IWORK(NUMNOD),
85 . TAG8(8), IG, IGTYP, ILW, IRIGID
86 INTEGER SIZE, LENR, KSMS1, NM, NS, IMOV, NSN, ILAGM,
87 . N2, N3, N4, N5, N6
88 INTEGER M, MSR, KI, NSMS(2), IWSMS, NSNW, NHI
89 INTEGER J1, IPERM1(6), IPERM2(6),IPENTA6(6)
90 CHARACTER(len=nchartitle) :: TITR
91 DATA iloc4/1,3,6,5/
92 DATA iperm1/1,2,3,1,2,3/
93 DATA iperm2/2,3,1,4,4,4/
94 DATA ipenta6/1,2,3,5,6,7/
95C-----------------------------------------------
96 irigid=0
97 DO i=1,nummat
98 ilw=ipm(2,i)
99 IF(ilw==13)THEN
100 irigid=1
101 EXIT
102 END IF
103 END DO
104 IF(irigid/=0)THEN
105 CALL ancmsg(msgid=1067,msgtype=msgerror,anmode=aninfo_blind_1)
106 END IF
107
108 DO i=1,numnod
109 nodnx_sms(i)=0
110 ENDDO
111C
112C Construction
113 CALL nodnx_sms_ini(numnod ,numelt ,nixt ,1 ,2 ,
114 1ixt ,ipartt,tagprt_sms,nativ_sms)
115 CALL nodnx_sms_ini(numnod ,numelp ,nixp ,1 ,2 ,
116 1ixp ,ipartp,tagprt_sms,nativ_sms)
117 CALL nodnx_sms_ini(numnod ,numelr ,nixr ,1 ,2 ,
118 1ixr ,ipartr,tagprt_sms,nativ_sms)
119C
120C pulleys
121 DO j=1,numelr
122 IF(tagprt_sms(ipartr(j))==0) cycle
123 ig = ipart(2,ipartr(j))
124 igtyp = igeo(11,ig)
125
126 IF(igtyp==12)THEN
127 k=2
128 i = ixr(1+k,j)
129 nativ_sms(i)=nativ_sms(i)+1
130 k=3
131 i = ixr(1+k,j)
132 nativ_sms(i)=nativ_sms(i)+1
133 END IF
134 ENDDO
135 CALL nodnx_sms_ini(numnod ,numeltg,nixtg,1 ,3 ,
136 1ixtg,iparttg,tagprt_sms,nativ_sms)
137 CALL nodnx_sms_ini(numnod ,numelc ,nixc ,1 ,4 ,
138 1ixc ,ipartc,tagprt_sms,nativ_sms)
139 CALL nodnx_sms_ini(numnod ,numels ,nixs ,1 ,8 ,
140 1ixs ,iparts,tagprt_sms,nativ_sms)
141 CALL nodnx_sms_ini(numnod ,numels10,6 ,0 ,6 ,
142 1ixs10 ,iparts(numels8+1),tagprt_sms,nativ_sms)
143 CALL nodnx_sms_ini(numnod ,numels16,8 ,0 ,8 ,
144 1ixs16 ,iparts(numels8+numels10+numels20+1),tagprt_sms,nativ_sms)
145 CALL nodnx_sms_ini(numnod ,numels20,12,0 ,12,
146 1ixs20 ,iparts(numels8+numels10+1),tagprt_sms,nativ_sms)
147C-----------------------------------------------
148C Warnings KINEMATIC CONDITIONS
149C-----------------------------------------------
150C
151 ksms1=0
152 DO i=1,numnod
153 IF(nativ_sms(i)/=0)THEN
154 IF(irv(kinet(i))/=0.OR.
155 . ilmult(kinet(i))/=0)THEN
156 ksms1=1
157 nativ_sms(i)=0
158 END IF
159 END IF
160 END DO
161C
162 IF(ksms1/=0)THEN
163 ng=0
164 DO i=1,numnod
165 IF (nativ_sms(i)/=0.AND.
166 . irv(kinet(i))/=0) THEN
167 ng = ng + 1
168 iwork(ng) = itab(i)
169 ENDIF
170 ENDDO
171 IF(ng/=0)THEN
172 WRITE(istdo,'(A)')
173 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION'
174 WRITE(iout,'(A)')
175 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION :'
176 WRITE(iout,'(A,/,A)')
177 .' AMS WILL NOT APPLY ON NODES WHERE A RIVET APPLIES',
178 .' NODE IDS='
179 WRITE(iout,'(10I10)')(iwork(i),i=1,ng)
180 END IF
181
182 ng=0
183 DO i=1,numnod
184 IF (nativ_sms(i)/=0.AND.
185 . ilmult(kinet(i))/=0) THEN
186 ng = ng + 1
187 iwork(ng) = itab(i)
188 ENDIF
189 ENDDO
190 IF(ng/=0)THEN
191 WRITE(istdo,'(A)')
192 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION'
193 WRITE(iout,'(A)')
194 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION :'
195 WRITE(iout,'(A,/,A)')
196 .' AMS WILL NOT APPLY ON NODES WHERE A LAGRANGE OPTION APPLIES',
197 .' NODE IDS='
198 WRITE(iout,'(10I10)')(iwork(i),i=1,ng)
199 END IF
200
201 END IF
202C-----
203 ksms1=0
204 IF(nrwall/=0)THEN
205 k = 1
206 DO n=1,nrwall
207 n2=n +nrwall
208 n3=n2+nrwall
209 n4=n3+nrwall
210 n5=n4+nrwall
211 n6=n5+nrwall
212 nsn =nprw(n)
213 imov =nprw(n3)
214 ity =nprw(n4)
215 ilagm=nprw(n6)
216 IF(ilagm/=0)THEN
217 DO j=1,nsn
218 i=lprw(k+j-1)
219 IF(nativ_sms(i)/=0)THEN
220 nativ_sms(i)=0
221 ksms1=1
222 END IF
223 END DO
224 END IF
225 k =k+nsn
226 END DO
227 END IF
228 IF(ksms1/=0)THEN
229 WRITE(istdo,'(A)')
230 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION'
231 WRITE(iout,'(A)')
232 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION :'
233 WRITE(iout,'(A)')
234 .' AMS IS NOT COMPATIBLE WITH LAGRANGE MULTIPLIERS.'
235 END IF
236
237C-----------------------------------------------
238C rbodies : numbering
239C------------
240 tagslv_rby_sms(1:numnod)=0
241 tagmsr_rby_sms(1:numnod) =0
242C
243 iad=0
244 iwsms=0
245 DO m=1,nrbody
246C
247 msr=npby(1,m)
248 nsn=npby(2,m)
249 IF(msr >= 0) THEN
250C if msr secnd of moving or lagrange wall => no ams
251 iwsms=0
252 k = 1
253 DO n=1,nrwall
254 n2=n +nrwall
255 n3=n2+nrwall
256 n4=n3+nrwall
257 n5=n4+nrwall
258 n6=n5+nrwall
259 nsnw =nprw(n)
260 imov =nprw(n3)
261 ity =nprw(n4)
262 ilagm=nprw(n6)
263 IF(ilagm/=0)THEN
264 DO j=1,nsnw
265 i=lprw(k+j-1)
266 IF(i==msr)THEN
267 iwsms=1
268 GOTO 100
269 END IF
270 END DO
271 END IF
272 k =k+nsn
273 END DO
274 100 CONTINUE
275 IF(iwsms==0.AND.npby(7,m)>0 .AND.
276 . (kinet(msr) <=1
277 . .OR. ivf(kinet(msr)) ==1
278 . .OR. irlk(kinet(msr))==1
279 . .OR. ijo(kinet(msr)) ==1
280 . .OR. iwl(kinet(msr)) ==1 )) THEN
281C
282 tagmsr_rby_sms(msr)=m
283 DO ki=1,nsn
284 i=lpby(iad+ki)
285 tagslv_rby_sms(i)=m
286 END DO
287C
288 END IF
289 END IF
290 iad = iad + nsn
291 END DO
292
293 IF(iwsms/=0)THEN
294 WRITE(istdo,'(A)')
295 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION'
296 WRITE(iout,'(A)')
297 . ' ** WARNING IN ADVANCED MASS SCALING DEFINITION :'
298 WRITE(iout,'(A)')
299 . ' AMS IS NOT COMPATIBLE WITH LAGRANGE MULTIPLIERS.'
300 END IF
301
302C-----
303C RBODY is it fully SMS (yes <=> its time step will be /dt/ams one)
304C-----
305C
306 iad=0
307 DO m=1,nrbody
308C
309 msr=npby(1,m)
310 nsn=npby(2,m)
311 nsms(1)=0
312 nsms(2)=nsn
313C
314 IF(msr >= 0) THEN
315 IF(tagmsr_rby_sms(msr) /= 0) THEN
316 DO ki=1,nsn
317 i=lpby(iad+ki)
318 IF(nativ_sms(i)/=0)nsms(1)=nsms(1)+1
319 END DO
320 END IF
321C
322 IF(nsms(1)==nsms(2))THEN
323 nativ_sms(msr)=1
324 ELSEIF(nsms(1)/=0)THEN
325 CALL fretitl2(titr,
326 . nom_opt(lnopt1-ltitr+1,m),ltitr)
327 IF(npby(10,m)==0)THEN
328 CALL ancmsg(msgid=1190,msgtype=msgwarning,anmode=aninfo_blind_1,
329 . i1=npby(6,m),c1=titr)
330 END IF
331 END IF
332 END IF
333C
334 IF(npby(10,m)/=0.AND.nsms(1)/=0)THEN
335 IF(msr > 0) nativ_sms(msr)=1
336 DO ki=1,nsn
337 i=lpby(iad+ki)
338 nativ_sms(i)=1
339 END DO
340 END IF
341C
342 iad = iad + nsn
343 END DO
344
345C-----
346C-----
347 DO nhi=0,nhrbe2
348 DO n=1,nrbe2
349 IF (irbe2(9,n)/=nhi) cycle
350 iad = irbe2(1,n)
351 nsn = irbe2(5,n)
352 m = irbe2(3,n)
353
354 nsms(1)=0
355 nsms(2)=nsn
356 DO i=1,nsn
357 ns = lrbe2(iad+i)
358 IF(nativ_sms(ns)/=0) nsms(1)=nsms(1)+1
359 ENDDO
360C
361 IF(nsms(1)/=0)THEN
362 nativ_sms(m)=1
363 DO i=1,nsn
364 ns = lrbe2(iad+i)
365 nativ_sms(ns)=1
366 ENDDO
367 END IF
368C
369 END DO
370 END DO
371
372C-----------------------------------------------
373 RETURN
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
nodnx_sms_ini
subroutine nodnx_sms_ini(numnod, numel, nix, mix, lix, ix, ipartx, tagprt_sms, nodnx_sms)
Definition sms_init.F:721
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804