OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
resol_init.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "com10_c.inc"
#include "com_xfem1.inc"
#include "param_c.inc"
#include "scr02_c.inc"
#include "scr03_c.inc"
#include "scr07_c.inc"
#include "scr12_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "scr17_c.inc"
#include "scr23_c.inc"
#include "units_c.inc"
#include "cong2_c.inc"
#include "task_c.inc"
#include "parit_c.inc"
#include "timerc_c.inc"
#include "rad2r_c.inc"
#include "scr18_c.inc"
#include "spmd_c.inc"
#include "fxbcom.inc"
#include "flowcom.inc"
#include "remesh_c.inc"
#include "sms_c.inc"
#include "lagmult.inc"
#include "sphcom.inc"
#include "intstamp_c.inc"
#include "comlock.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine resol_init (itask, fr_nbcc, isendto, ircvfrom, iad_elem, fr_elem, itabm1, ipari, iparg, itab, ixs10, ixs20, i13a, i13b, i13c, i13d, i13e, i13f, i13g, i13h, i13i, i15a, i15b, i15c, i15d, i15e, i15f, i15g, i15h, i15i, i87a, i87b, i87c, i87d, i87e, i87f, i87g, nfia, nfea, nfoa, ndma, ndma2, nodft, nodlt, ndtask, numnthread, ixs16, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, pon, ikine, a, ar, v, vr, x, d, ms, in, stifn, stifr, dmas, diner, wa, uwa, pm, geo, partsav, parts0, monvol, i87h, i87i, i87j, i87k, i15j, kxx, secbuf, secfcum, nstrf, igrnod, iexlnk, xframe, ixtg1, ib, viscn, dd_r2r, elbuf, ipart, madprt, madsh4, madsh3, madsol, madnod, madfail, igeo, intlist, nbintc, procne, niskyfi, weight, isizxv, ilenxv, addcni2, procni2, iad_i2m, fr_i2m, fr_nbcci2, i2size, fr_mad, lwibem, lwrbem, fxbfp, fxbefw, fxbedp, fxbgrp, fxbgrw, ndin, islen7, irlen7, islen11, irlen11, lwiflow, lwrflow, iflow, addcnel, cnel, addtmpl, ipartl, npartl, nfnca, nftca, i15ath, i35ath, ipm, sh4tree, ipadmesh, msc, inc, sh3tree, mstg, intg, ptg, fthe, fthesky, ftheskyi, nme17, islen17, irlen17, irlen7t, islen7t, lindidel, lbufidel, sh4trim, sh3trim, mscnd, incnd, irlen20, islen20, irlen20t, islen20t, nbint20, irlen20e, islen20e, niskyfie, mcp, ms0, inod_pxfem, iel_pxfem, iadc_pxfem, adsky_pxfem, icodt, icodr, ibfv, admsms, nodreac, igrouc, ngrouc, igrounc, ngrounc, fr_rby, fr_rby6, npby, nom_sect, mcpc, mcptg, grth, igrth, nelem, lag_sec, nprw, diag_sms, dmelc, dmeltg, ngrth, nft2, dmels, dmeltr, dmelp, dmelrt, res_sms, i87l, irbe2, lrbe2, nmrbe2, iad_rbe2, fr_rbe2, fr_rbe2m, r2size, lpby, procne_pxfem, isendp_pxfem, irecvp_pxfem, iadsdp_pxfem, iadrcp_pxfem, fr_nbcc1, rby, int18kine, xdp, i87m, inod_crkxfem, iel_crkxfem, iadc_crkxfem, adsky_crkxfem, procne_crkxfem, isendp_crkxfem, irecvp_crkxfem, iadsdp_crkxfem, iadrcp_crkxfem, int24use, ndama2, igroupc, igrouptg, igroups, igroupflg, dmint2, irbkin_l, nrbykin_l, kindrby, elbuf_tab, sensors, dd_r2r_elem, sdd_r2r_elem, kinet, weight_md, dmsph, ioldsect, lbufidel24, intbuf_tab, numsph_glo_r2r, flg_sphinout_r2r, i15k, condn, condnsky, kxfenod2elc, elcutc, nodedge, iad_edge, crknodiad, fr_edge, fr_nbedge, nodlevxf, crkedge, xfem_tab, isensint, nisubmax, intlist25, int24e2euse, tabmp_l, i87n, tab_mat, h3d_data, tagtrimc, tagtrimtg, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrpart, forneqs, int7itied, fxvel_fgeo, failwave, nloc_dmg, pinch_data, slloadp, tagslv_rby, nfnca2, nftca2, in0, sort_comm, stack, output, thke, sfr_elem, sh_offset_tab, need_comm_int25_solid_erosion, comm_int25_solid_erosion, iskwn, iframe, loads, glob_therm, pblast, rbe3, nhier_rby)
subroutine grpsplit (iparg, igrouc, ngrouc, igrounc, ngrounc, ixc, ixs, ixtg, ipm, igeo, pm, geo, tabmp_l, tab_mat)
subroutine fillipartl (ipartl, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, ipartx, ipartsp, ipartig3d, npartl)
subroutine smp_init (itsk, nodftsk, nodltsk, numntsk, ndtsk, ipmtsk, partftsk, partltsk, nwaftsk, igmtsk, greftsk, greltsk)
subroutine init_kyne (ikine, npby, lpby, tagslv_rby, nhier_rby)

Function/Subroutine Documentation

◆ fillipartl()

subroutine fillipartl ( integer, dimension(*) ipartl,
integer, dimension(*) iparts,
integer, dimension(*) ipartq,
integer, dimension(*) ipartc,
integer, dimension(*) ipartt,
integer, dimension(*) ipartp,
integer, dimension(*) ipartr,
integer, dimension(*) ipartur,
integer, dimension(*) iparttg,
integer, dimension(*) ipartx,
integer, dimension(*) ipartsp,
integer, dimension(*) ipartig3d,
integer npartl )

Definition at line 1482 of file resol_init.F.

1486C----6---------------------------------------------------------------7---------8
1487C I m p l i c i t T y p e s
1488C-----------------------------------------------
1489#include "implicit_f.inc"
1490C-----------------------------------------------
1491C C o m m o n B l o c k s
1492C-----------------------------------------------
1493#include "com04_c.inc"
1494#include "sphcom.inc"
1495C-----------------------------------------------------------------
1496C D u m m y A r g u m e n t s
1497C-----------------------------------------------!$OMP+PRIVATE(
1498 INTEGER IPARTS(*),IPARTQ(*),IPARTC(*),IPARTT(*),IPARTSP(*),
1499 . IPARTP(*),IPARTR(*),IPARTUR(*),IPARTTG(*),IPARTX(*),
1500 . IPARTL(*),IPARTIG3D(*),
1501 . NPARTL
1502C-----------------------------------------------
1503C L o c a l V a r i a b l e s
1504C-----------------------------------------------
1505 INTEGER I
1506C-----------------------------------------------
1507C //
1508C-----------------------------------------------
1509C
1510 DO i = 1, npart
1511 ipartl(i) = 0
1512 END DO
1513C
1514 DO i = 1, numels
1515 ipartl(iparts(i))=1
1516 END DO
1517C
1518 DO i = 1, numelq
1519 ipartl(ipartq(i))=1
1520 END DO
1521C
1522 DO i = 1, numelc
1523 ipartl(ipartc(i))=1
1524 END DO
1525C
1526 DO i = 1, numelt
1527 ipartl(ipartt(i))=1
1528 END DO
1529C
1530 DO i = 1, numelp
1531 ipartl(ipartp(i))=1
1532 END DO
1533C
1534 DO i = 1, numelr
1535 ipartl(ipartr(i))=1
1536 END DO
1537C
1538 DO i = 1, numeltg
1539 ipartl(iparttg(i))=1
1540 END DO
1541C
1542 DO i = 1, numelx
1543 ipartl(ipartx(i))=1
1544 END DO
1545C
1546 DO i = 1, numels
1547 ipartl(iparts(i))=1
1548 END DO
1549C
1550 DO i = 1, numsph
1551 ipartl(ipartsp(i))=1
1552 END DO
1553C
1554 DO i = 1, numelig3d
1555 ipartl(ipartig3d(i))=1
1556 END DO
1557C
1558 npartl = 0
1559 DO i = 1, npart
1560 IF(ipartl(i)>0)THEN
1561 npartl = npartl + 1
1562 ipartl(npartl) = i
1563 END IF
1564 END DO
1565C
1566 RETURN

◆ grpsplit()

subroutine grpsplit ( integer, dimension(nparg,*) iparg,
integer, dimension(*) igrouc,
integer ngrouc,
integer, dimension(*) igrounc,
integer ngrounc,
integer, dimension(nixc,*) ixc,
integer, dimension(nixs,*) ixs,
integer, dimension(nixtg,*) ixtg,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
pm,
geo,
integer tabmp_l,
tab_mat )

Definition at line 1231 of file resol_init.F.

1234 use element_mod , only : nixc,nixtg,nixs
1235C----6------------------------------------------------------------------
1236C I m p l i c i t T y p e s
1237C-----------------------------------------------
1238#include "implicit_f.inc"
1239C-----------------------------------------------
1240C C o m m o n B l o c k s
1241C-----------------------------------------------
1242#include "com01_c.inc"
1243#include "param_c.inc"
1244#include "com04_c.inc"
1245C-----------------------------------------------------------------
1246C D u m m y A r g u m e n t s
1247C-----------------------------------------------
1248 INTEGER IPARG(NPARG,*),IGROUC(*),IGROUNC(*),
1249 . NGROUC, NGROUNC,TABMP_L
1250
1251 INTEGER IXC(NIXC,*),IXS(NIXS,*),IXTG(NIXTG,*),
1252 . IPM(NPROPMI,*),IGEO(NPROPGI,*)
1253 my_real pm(npropm,*),geo(npropg,*)
1254 my_real tab_mat(ngroup)
1255! tab_mat_prop
1256! 1 : shell
1257! 2 : tri
1258! 3 --> 9 : solid
1259! 3 : ISOL=8
1260! 4 : ISOL=10
1261! 5 : ISOL=16
1262! 6 : ISOL=20
1263! 7 : ISOL=6
1264! 8 : ISOL=4
1265! 9 : ISOL=others
1266C-----------------------------------------------
1267C L o c a l V a r i a b l e s
1268C-----------------------------------------------
1269 INTEGER NG, ITY, N_SHELL, N_SOL(7),N_TRI,MARQUEUR,MARQUEUR_2,MARQUEUR_3
1270 INTEGER I,J,II,JJ,K,INDI
1271 INTEGER COMPTEUR_MAT_PROP_SHELL,COMPTEUR_MAT_PROP_SOL,COMPTEUR_MAT_PROP_TRI,
1272 . MID,PID,MTN,NEL,NFT,FIRST,LAST,SHIFT,ISOL,GR_ID,GR_ID2
1273 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAB_SHELL_LOC,TAB_TRI_LOC
1274 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: TAB_SOL_LOC
1275 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAB_LOC
1276 INTEGER, DIMENSION(:), ALLOCATABLE :: IGROUC_SHELL,IGROUC_TRI,MID_SHELL,MID_TRI
1277 INTEGER, DIMENSION(:), ALLOCATABLE :: POIN_GROUP_MID_SHELL,POIN_GROUP_MID_TRI
1278 INTEGER, DIMENSION(:), ALLOCATABLE :: POIN_GROUP_PID_SHELL,POIN_GROUP_PID_TRI
1279 INTEGER, DIMENSION(:,:), ALLOCATABLE :: POIN_GROUP_MID_SOL
1280 INTEGER, DIMENSION(:,:), ALLOCATABLE :: POIN_GROUP_PID_SOL
1281 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IGROUC_SOL,MID_SOL
1282 my_real poids_j,poids_j1
1283C-----------------------------------------------
1284C
1285 n_shell = 0
1286 n_sol(1:7) = 0
1287 n_tri = 0
1288 ngrouc = 0
1289 ngrounc = 0
1290
1291 ALLOCATE(tab_shell_loc(ngroup,5))
1292 ALLOCATE(tab_tri_loc(ngroup,5))
1293 ALLOCATE(tab_sol_loc(ngroup,5,7))
1294 ALLOCATE( igrouc_shell(ngroup),igrouc_tri(ngroup) )
1295 ALLOCATE( igrouc_sol(ngroup,7) )
1296
1297 ALLOCATE( poin_group_mid_shell(ngroup),poin_group_mid_tri(ngroup) )
1298 ALLOCATE( poin_group_pid_shell(ngroup),poin_group_pid_tri(ngroup) )
1299 ALLOCATE( poin_group_mid_sol(ngroup,7),poin_group_pid_sol(ngroup,7) )
1300
1301 ALLOCATE(mid_shell(nummat))
1302 ALLOCATE(mid_tri(nummat))
1303 ALLOCATE(mid_sol(nummat,7))
1304
1305 compteur_mat_prop_shell = 0
1306 mid_shell(1:nummat) = 0
1307 mid_tri(1:nummat) = 0
1308 mid_sol(1:nummat,1:7) = 0
1309
1310 DO ng = 1, ngroup
1311 ity =iparg(5,ng)
1312 IF(ity==3.OR.ity==7)THEN
1313 ngrouc = ngrouc + 1
1314 igrouc(ngrouc)=ng
1315 IF(ity==3) THEN
1316 n_shell = n_shell + 1
1317 nft = iparg(3,ng)+1
1318 mid = ixc(1,nft)
1319 pid = ixc(6,nft)
1320 mtn = iparg(1,ng)
1321 mid_shell(mid) = mid_shell(mid) + 1
1322 poin_group_mid_shell(n_shell) = mid
1323 poin_group_pid_shell(n_shell) = pid
1324 igrouc_shell(n_shell) = ng
1325
1326 tab_shell_loc(n_shell,1) = iparg(2,ng)
1327 tab_shell_loc(n_shell,2) = ng
1328 tab_shell_loc(n_shell,3) = mid
1329 tab_shell_loc(n_shell,4) = pid
1330 tab_shell_loc(n_shell,5) = ngrouc
1331
1332 ELSEIF(ity==7) THEN
1333 n_tri = n_tri + 1
1334 nft = iparg(3,ng)+1
1335 mid = ixtg(1,nft)
1336 pid = ixtg(5,nft)
1337 mtn = iparg(1,ng)
1338 mid_tri(mid) = mid_tri(mid) + 1
1339 poin_group_mid_tri(n_tri) = mid
1340 poin_group_pid_tri(n_tri) = pid
1341 igrouc_tri(n_tri) = ng
1342
1343 tab_tri_loc(n_tri,1) = iparg(2,ng)
1344 tab_tri_loc(n_tri,2) = ng
1345 tab_tri_loc(n_tri,3) = mid
1346 tab_tri_loc(n_tri,4) = pid
1347 tab_tri_loc(n_tri,5) = ngrouc
1348
1349 ENDIF
1350 ELSE
1351 ngrounc = ngrounc + 1
1352 igrounc(ngrounc)=ng
1353 IF(ity==1) THEN
1354 nft = iparg(3,ng)+1
1355 mid = ixs(1,nft)
1356 pid = ixs(10,nft)
1357 mtn = iparg(1,ng)
1358 isol = iparg(28,ng)
1359 IF(isol==4) THEN
1360 indi = 6
1361 ELSEIF(isol==6) THEN
1362 indi = 5
1363 ELSEIF(isol==8) THEN
1364 indi = 1
1365 ELSEIF(isol==10) THEN
1366 indi = 2
1367 ELSEIF(isol==16) THEN
1368 indi = 3
1369 ELSEIF(isol==20) THEN
1370 indi = 4
1371 ELSE
1372 indi = 7
1373 ENDIF
1374
1375 n_sol(indi) = n_sol(indi) + 1
1376 igrouc_sol(n_sol(indi),indi) = ng
1377
1378 tab_sol_loc(n_sol(indi),1,indi) = iparg(2,ng)
1379 tab_sol_loc(n_sol(indi),2,indi) = ng
1380 tab_sol_loc(n_sol(indi),3,indi) = mid
1381 tab_sol_loc(n_sol(indi),4,indi) = pid
1382 tab_sol_loc(n_sol(indi),5,indi) = ngrounc
1383
1384 mid_sol(mid,indi) = mid_sol(mid,indi) + 1
1385 poin_group_mid_sol(n_sol(indi),indi) = mid
1386 poin_group_pid_sol(n_sol(indi),indi) = pid
1387
1388 ENDIF
1389 END IF
1390 END DO
1391! -------------------------
1392 IF(n_shell>0) THEN
1393
1394 ALLOCATE( tab_loc(n_shell,3) )
1395 tab_loc(1:n_shell,1:3) = -1
1396
1397
1398 CALL sort_mid_pid(n_shell,igrouc_shell,
1399 1 poin_group_mid_shell,poin_group_pid_shell,
1400 2 mid_shell,tab_loc,tab_shell_loc,tab_mat)
1401
1402
1403 DO i = 1,n_shell
1404 j = tab_loc(i,1)
1405 ii = tab_shell_loc(i,5)
1406 jj = tab_shell_loc(j,2)
1407 igrouc(ii) = jj
1408 ENDDO
1409
1410 DEALLOCATE( tab_loc )
1411 ENDIF ! N_SHELL>0
1412! -------------------------
1413 IF(n_tri>0) THEN
1414
1415 ALLOCATE( tab_loc(n_tri,3) )
1416 tab_loc(1:n_tri,1:3) = -1
1417
1418
1419 CALL sort_mid_pid(n_tri,igrouc_tri,
1420 1 poin_group_mid_tri,poin_group_pid_tri,
1421 2 mid_tri,tab_loc,tab_tri_loc,tab_mat)
1422
1423
1424 DO i = 1,n_tri
1425 j = tab_loc(i,1)
1426 ii = tab_tri_loc(i,5)
1427 jj = tab_tri_loc(j,2)
1428 igrouc(ii) = jj
1429 ENDDO
1430
1431 DEALLOCATE( tab_loc )
1432 ENDIF ! N_TRI>0
1433! -------------------------
1434 DO indi=1,7
1435 IF(n_sol(indi)>0) THEN
1436
1437 ALLOCATE( tab_loc(n_sol(indi),3) )
1438 tab_loc(1:n_sol(indi),1:3) = -1
1439
1440
1441 CALL sort_mid_pid(n_sol(indi),igrouc_sol(1,indi),
1442 1 poin_group_mid_sol(1,indi),poin_group_pid_sol(1,indi),
1443 2 mid_sol(1,indi),tab_loc,tab_sol_loc(1,1,indi),tab_mat)
1444
1445
1446 DO i = 1,n_sol(indi)
1447 j = tab_loc(i,1)
1448 ii = tab_sol_loc(i,5,indi)
1449 jj = tab_sol_loc(j,2,indi)
1450 igrounc(ii) = jj
1451 ENDDO
1452
1453 DEALLOCATE( tab_loc )
1454 ENDIF ! N_SOL>0
1455 ENDDO
1456! -------------------------
1457
1458 DEALLOCATE(mid_shell)
1459 DEALLOCATE(mid_tri)
1460 DEALLOCATE(mid_sol)
1461
1462 DEALLOCATE( poin_group_mid_shell,poin_group_mid_tri )
1463 DEALLOCATE( poin_group_pid_shell,poin_group_pid_tri )
1464 DEALLOCATE( poin_group_mid_sol,poin_group_pid_sol )
1465
1466
1467 DEALLOCATE(tab_shell_loc)
1468 DEALLOCATE(tab_tri_loc)
1469 DEALLOCATE(tab_sol_loc)
1470 DEALLOCATE( igrouc_shell,igrouc_tri )
1471 DEALLOCATE( igrouc_sol )
1472
1473 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
sort_mid_pid
subroutine sort_mid_pid(n_shell, igrouc_shell, poin_group_mid_shell, poin_group_pid_shell, mid_shell, tab_loc, tab_shell_loc, tab_mat)
Definition sort_mid_pid.F:35

◆ init_kyne()

subroutine init_kyne ( integer, dimension(numnod) ikine,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(*) tagslv_rby,
integer, intent(inout) nhier_rby )

Definition at line 1631 of file resol_init.F.

1632C----6---------------------------------------------------------------7---------8
1633C I m p l i c i t T y p e s
1634C-----------------------------------------------
1635#include "implicit_f.inc"
1636#include "comlock.inc"
1637C-----------------------------------------------
1638C C o m m o n B l o c k s
1639C-----------------------------------------------
1640#include "com04_c.inc"
1641#include "lagmult.inc"
1642#include "param_c.inc"
1643C-----------------------------------------------------------------
1644C D u m m y A r g u m e n t s
1645C-----------------------------------------------
1646 INTEGER IKINE(NUMNOD),NPBY(NNPBY,*),LPBY(*),TAGSLV_RBY(*)
1647 INTEGER, INTENT(INOUT) :: NHIER_RBY
1648C-----------------------------------------------
1649C L o c a l V a r i a b l e s
1650C-----------------------------------------------
1651 INTEGER N,I,J,K,NSN
1652
1653 DO j=1,numnod
1654 ikine(j)=0
1655 ENDDO
1656C-------------------------------------
1657C Processing Rigid Bodies
1658C-------------------------------------
1659 k = 0
1660 nhier_rby = 0
1661 DO n=1,nrbykin
1662 nsn = npby(2,n)
1663 nhier_rby = max(nhier_rby,npby(20,n))
1664 DO i=1,nsn
1665 j=lpby(k+i)
1666 ikine(j) = (ikine(j)/2)*2 + 1
1667 ENDDO
1668 k = k + nsn
1669 ENDDO
1670C-------------------------------------------
1671 tagslv_rby(1:numnod)=0
1672 k=0
1673 DO n=1,nrbykin
1674 nsn=npby(2,n)
1675 IF(npby(7,n)>=1)THEN
1676 DO i=1,nsn
1677 tagslv_rby(lpby(i+k))=n
1678 ENDDO
1679 ENDIF
1680 k=k+nsn
1681 ENDDO
1682C-------------------------------------------
1683 DO n=1,nrbylag
1684 nsn = npby(2,n)
1685 DO i=1,nsn
1686 j=lpby(k+i)
1687 ikine(j) = (ikine(j)/2)*2 + 1
1688 ENDDO
1689 k = k + 3*nsn
1690 ENDDO
1691 RETURN
max
#define max(a, b)
Definition macros.h:21

◆ resol_init()

subroutine resol_init ( integer itask,
integer, dimension(2,nspmd+1) fr_nbcc,
integer, dimension(ninter+1,nspmd+1) isendto,
integer, dimension(ninter+1,nspmd+1) ircvfrom,
integer, dimension(2,nspmd+1) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) itabm1,
integer, dimension(npari,*) ipari,
integer, dimension(nparg,*) iparg,
integer, dimension(*) itab,
integer, dimension(6,*) ixs10,
integer, dimension(12,*) ixs20,
integer i13a,
integer i13b,
integer i13c,
integer i13d,
integer i13e,
integer i13f,
integer i13g,
integer i13h,
integer i13i,
integer i15a,
integer i15b,
integer i15c,
integer i15d,
integer i15e,
integer i15f,
integer i15g,
integer i15h,
integer i15i,
integer i87a,
integer i87b,
integer i87c,
integer i87d,
integer i87e,
integer i87f,
integer i87g,
integer nfia,
integer nfea,
integer nfoa,
integer ndma,
integer ndma2,
integer nodft,
integer nodlt,
integer ndtask,
integer numnthread,
integer, dimension(6,*) ixs16,
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,
type(element_pon_) pon,
integer, dimension(numnod) ikine,
a,
ar,
v,
vr,
x,
d,
ms,
in,
stifn,
stifr,
dmas,
diner,
wa,
uwa,
pm,
geo,
partsav,
parts0,
integer, dimension(*) monvol,
integer i87h,
integer i87i,
integer i87j,
integer i87k,
integer i15j,
integer, dimension(nixx,*) kxx,
secbuf,
secfcum,
integer, dimension(*) nstrf,
type (group_), dimension(ngrnod) igrnod,
integer, dimension(nr2r,*) iexlnk,
xframe,
integer, dimension(4,*) ixtg1,
integer, dimension(nibcld,*) ib,
viscn,
integer, dimension(nspmd+1,*) dd_r2r,
elbuf,
integer, dimension(*) ipart,
integer, dimension(*) madprt,
integer, dimension(*) madsh4,
integer, dimension(*) madsh3,
integer, dimension(*) madsol,
integer, dimension(*) madnod,
integer, dimension(*) madfail,
integer, dimension(npropgi,*) igeo,
integer, dimension(ninter) intlist,
integer nbintc,
integer, dimension(*) procne,
integer, dimension(*) niskyfi,
integer, dimension(*) weight,
integer isizxv,
integer ilenxv,
integer, dimension(*) addcni2,
integer, dimension(*) procni2,
integer, dimension(*) iad_i2m,
integer, dimension(*) fr_i2m,
integer, dimension(*) fr_nbcci2,
integer i2size,
integer, dimension(5,*) fr_mad,
integer lwibem,
integer lwrbem,
fxbfp,
fxbefw,
fxbedp,
fxbgrp,
fxbgrw,
integer ndin,
integer islen7,
integer irlen7,
integer islen11,
integer irlen11,
integer lwiflow,
integer lwrflow,
integer, dimension(*) iflow,
integer, dimension(0:*) addcnel,
integer, dimension(0:*) cnel,
integer, dimension(0:*) addtmpl,
integer, dimension(*) ipartl,
integer npartl,
integer nfnca,
integer nftca,
integer i15ath,
integer i35ath,
integer, dimension(npropmi,*) ipm,
integer, dimension(*) sh4tree,
integer, dimension(*) ipadmesh,
msc,
inc,
integer, dimension(*) sh3tree,
mstg,
intg,
ptg,
fthe,
fthesky,
ftheskyi,
integer nme17,
integer islen17,
integer irlen17,
integer irlen7t,
integer islen7t,
integer lindidel,
integer lbufidel,
integer, dimension(*) sh4trim,
integer, dimension(*) sh3trim,
mscnd,
incnd,
integer irlen20,
integer islen20,
integer irlen20t,
integer islen20t,
integer nbint20,
integer irlen20e,
integer islen20e,
integer, dimension(*) niskyfie,
mcp,
ms0,
integer, dimension(*) inod_pxfem,
integer, dimension(*) iel_pxfem,
integer, dimension(4,*) iadc_pxfem,
integer, dimension(*) adsky_pxfem,
integer, dimension(*) icodt,
integer, dimension(*) icodr,
integer, dimension(nifv,*) ibfv,
admsms,
integer, dimension(*) nodreac,
integer, dimension(*) igrouc,
integer ngrouc,
integer, dimension(*) igrounc,
integer ngrounc,
integer, dimension(*) fr_rby,
integer, dimension(*) fr_rby6,
integer, dimension(*) npby,
integer, dimension(*) nom_sect,
mcpc,
mcptg,
integer, dimension(*) grth,
integer, dimension(*) igrth,
integer nelem,
integer lag_sec,
integer, dimension(*) nprw,
diag_sms,
dmelc,
dmeltg,
integer ngrth,
integer nft2,
dmels,
dmeltr,
dmelp,
dmelrt,
res_sms,
integer i87l,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2,
integer nmrbe2,
integer, dimension(*) iad_rbe2,
integer, dimension(*) fr_rbe2,
integer, dimension(*) fr_rbe2m,
integer r2size,
integer, dimension(*) lpby,
integer, dimension(*) procne_pxfem,
integer, dimension(*) isendp_pxfem,
integer, dimension(*) irecvp_pxfem,
integer, dimension(*) iadsdp_pxfem,
integer, dimension(*) iadrcp_pxfem,
integer, dimension(2,*) fr_nbcc1,
rby,
integer int18kine,
double precision, dimension(3,*) xdp,
integer i87m,
integer, dimension(*) inod_crkxfem,
integer, dimension(*) iel_crkxfem,
integer, dimension(*) iadc_crkxfem,
integer, dimension(0:*) adsky_crkxfem,
integer, dimension(*) procne_crkxfem,
integer, dimension(*) isendp_crkxfem,
integer, dimension(*) irecvp_crkxfem,
integer, dimension(*) iadsdp_crkxfem,
integer, dimension(*) iadrcp_crkxfem,
integer int24use,
integer ndama2,
integer, dimension(*) igroupc,
integer, dimension(*) igrouptg,
integer, dimension(*) igroups,
integer, dimension(2) igroupflg,
dmint2,
integer, dimension(*) irbkin_l,
integer nrbykin_l,
integer, dimension(*) kindrby,
type (elbuf_struct_), dimension(ngroup) elbuf_tab,
type (sensors_) sensors,
integer, dimension(*) dd_r2r_elem,
integer sdd_r2r_elem,
integer, dimension(*) kinet,
integer, dimension(*) weight_md,
dmsph,
integer ioldsect,
integer lbufidel24,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer numsph_glo_r2r,
integer flg_sphinout_r2r,
integer i15k,
condn,
condnsky,
integer, dimension(*) kxfenod2elc,
integer, dimension(2,*) elcutc,
integer, dimension(*) nodedge,
integer, dimension(*) iad_edge,
integer, dimension(*) crknodiad,
integer, dimension(*) fr_edge,
integer, dimension(*) fr_nbedge,
integer, dimension(*) nodlevxf,
type (xfem_edge_), dimension(*) crkedge,
type (elbuf_struct_), dimension(ngroup,nxel) xfem_tab,
integer, dimension(nisubmax+1,ninter) isensint,
integer nisubmax,
integer, dimension(ninter25) intlist25,
integer int24e2euse,
integer tabmp_l,
integer i87n,
tab_mat,
type(h3d_database) h3d_data,
integer, dimension(*) tagtrimc,
integer, dimension(*) tagtrimtg,
type (group_), dimension(ngrbric) igrbric,
type (group_), dimension(ngrquad) igrquad,
type (group_), dimension(ngrshel) igrsh4n,
type (group_), dimension(ngrsh3n) igrsh3n,
type (group_), dimension(ngrtrus) igrtruss,
type (group_), dimension(ngrbeam) igrbeam,
type (group_), dimension(ngrspri) igrspring,
type (group_), dimension(ngrpart) igrpart,
forneqs,
integer, intent(inout) int7itied,
integer fxvel_fgeo,
type (failwave_str_), target failwave,
type (nlocal_str_), target nloc_dmg,
type (pinch) pinch_data,
integer slloadp,
integer, dimension(numnod) tagslv_rby,
integer nfnca2,
integer nftca2,
in0,
type(sorting_comm_type), dimension(ninter), intent(inout) sort_comm,
type (stack_ply) stack,
type(output_), intent(inout) output,
thke,
integer sfr_elem,
type(sh_offset_) sh_offset_tab,
logical, dimension(nspmd), intent(inout) need_comm_int25_solid_erosion,
integer, intent(inout) comm_int25_solid_erosion,
integer, dimension(liskn,numskw+1), intent(in) iskwn,
integer, dimension(liskn,numfram+1), intent(in) iframe,
type (loads_), intent(inout) loads,
type (glob_therm_), intent(inout) glob_therm,
type (pblast_), intent(inout) pblast,
type (rbe3_), intent(inout) rbe3,
integer, intent(inout) nhier_rby )
Parameters
[in,out]need_comm_int25_solid_erosionboolean, true if the proc needs to comm some values related to interface type 25 with solid erosion
[in,out]comm_int25_solid_erosioninteger, sub-communicator related to interface type 25 with solid erosion

Definition at line 101 of file resol_init.F.

171C-----------------------------------------------
172C M o d u l e s
173C-----------------------------------------------
174 USE plyxfem_mod
175 USE elbufdef_mod
176 USE intbufdef_mod
177 USE crackxfem_mod
178 USE ecnd_mod
179 USE h3d_mod
180 USE groupdef_mod
181 USE failwave_mod
182 USE nlocal_reg_mod
183 USE pinchtype_mod
184 USE pblast_mod
185 USE dtdc_mod
186 USE inter_sorting_mod
187 USE stack_mod
188 USE outmax_mod
189 USE sensor_mod
190 USE h3d_inc_mod
191 USE alemuscl_mod , only:alemuscl_param
192 USE output_mod
193 USE inter_sh_offset_ini_mod , only : inter_sh_offset_ini
194 USE inter_sh_offset_mod , only:sh_offset_
195 USE loads_mod
196 USE inivel_init_mod , only: inivel_init
197 use glob_therm_mod
198 use spmd_xv_inter_type1_mod , only : is_present_inter1
199 USE parith_on_mod, only: element_pon_
200 use rbe3_mod
201 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
202C-----------------------------------------------
203C I m p l i c i t T y p e s
204C-----------------------------------------------
205#include "implicit_f.inc"
206C-----------------------------------------------
207C C o m m o n B l o c k s
208C-----------------------------------------------
209#include "com01_c.inc"
210#include "com04_c.inc"
211#include "com08_c.inc"
212#include "com10_c.inc"
213#include "com_xfem1.inc"
214#include "param_c.inc"
215#include "scr02_c.inc"
216#include "scr03_c.inc"
217#include "scr07_c.inc"
218#include "scr12_c.inc"
219#include "scr14_c.inc"
220#include "scr16_c.inc"
221#include "scr17_c.inc"
222#include "scr23_c.inc"
223#include "units_c.inc"
224#include "cong2_c.inc"
225#include "task_c.inc"
226#include "parit_c.inc"
227#include "timerc_c.inc"
228#include "rad2r_c.inc"
229#include "scr18_c.inc"
230#include "spmd_c.inc"
231#include "fxbcom.inc"
232#include "flowcom.inc"
233#include "remesh_c.inc"
234#include "sms_c.inc"
235#include "lagmult.inc"
236#include "sphcom.inc"
237#include "intstamp_c.inc"
238C-----------------------------------------------------------------
239C D u m m y A r g u m e n t s
240C-----------------------------------------------
241 TYPE(element_pon_) :: PON
242 INTEGER ITASK, NBINTC, NODFT, NODLT, LINDIDEL, LBUFIDEL,
243 . NUMNTHREAD, NDTASK, NFIA, NFEA, NFOA ,NDMA, NFNCA, NFTCA,
244 . NDMA2,NDIN,N1,N2,N3,IGTYP,NPARTL,NGROUC,NGROUNC,
245 . I13A,I13B,I13C,I13D,I13E,I13F,I13G,I13H,I13I,
246 . I15A,I15B,I15C,I15D,I15E,I15F,I15G,I15H,I15I,I15J,I15K,
247 . I87A,I87B,I87C,I87D,I87E,I87F,I87G,I87H,I87I,I87J,
248 . I87K,I87L,I87M,I87N,NFNCA2,NFTCA2,
249 . ISIZXV , ILENXV, I2SIZE, ISLEN7,IRLEN7 ,ISLEN11 ,IRLEN11,
250 . I15ATH, I35ATH, NME17,ISLEN17,IRLEN17,IRLEN7T,ISLEN7T,
251 . IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,NBINT20,IRLEN20E,
252 . ISLEN20E,NELEM,LAG_SEC, NGRTH, NFT2,NMRBE2,
253 . INT18KINE,INT24USE,NDAMA2, NRBYKIN_L,IOLDSECT,LBUFIDEL24,
254 . TABMP_L,TAGTRIMC(*),TAGTRIMTG(*), SLLOADP,SFR_ELEM
255 INTEGER
256 . IXS(NIXS,*),IXS10(6,*) ,IXS20(12,*),
257 . IXS16(6,*) , IGEO(NPROPGI,*),
258 . IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
259 . IXR(NIXR,*), IXTG(NIXTG,*), IXTG1(4,*),
260 . ITAB(*), IPARG(NPARG,*), IPARI(NPARI,*),
261 . IEXLNK(NR2R,*),
262 . WEIGHT(*), NSTRF(*), IB(NIBCLD,*), ITABM1(*),
263 . MONVOL(*),KXX(NIXX,*),ISENDTO(NINTER+1,NSPMD+1),
264 . FR_NBCC(2,NSPMD+1), IAD_ELEM(2,NSPMD+1) ,FR_ELEM(*),
265 . IRCVFROM(NINTER+1,NSPMD+1), INTLIST(NINTER), PROCNE(*),
266 . NISKYFI(*),ADDCNI2(*),PROCNI2(*),IAD_I2M(*),FR_I2M(*),
267 . FR_NBCCI2(*), IPART(*),
268 . DD_R2R(NSPMD+1,*),IPARTL(*),
269 . MADPRT(*), MADSH4(*), MADSH3(*), MADSOL(*), MADNOD(*),
270 . MADFAIL(*), FR_MAD(5,*), LWIBEM, LWRBEM, LWIFLOW, LWRFLOW,
271 . IFLOW(*), ADDCNEL(0:*), CNEL(0:*), ADDTMPL(0:*),
272 . IPM(NPROPMI,*), SH4TREE(*), IPADMESH(*), SH3TREE(*),
273 . SH4TRIM(*), SH3TRIM(*), NISKYFIE(*),
274 . ICODT(*), ICODR(*),IBFV(NIFV,*),
275 . INOD_PXFEM(*),IEL_PXFEM(*) ,IADC_PXFEM(4,*),ELCUTC(2,*),
276 . ADSKY_PXFEM(*), KXFENOD2ELC(*),NODLEVXF(*),CRKNODIAD(*),
277 . NODEDGE(*),IAD_EDGE(*),FR_EDGE(*),FR_NBEDGE(*), NODREAC(*),
278 . IGROUC(*),IGROUNC(*),FR_RBY(*),FR_RBY6(*),NPBY(*),
279 . NOM_SECT(*), GRTH(*),IGRTH(*), NPRW(*),IAD_RBE2(*),
280 . FR_RBE2(*),FR_RBE2M(*),R2SIZE, IRBE2(NRBE2L,*),LRBE2(*),
281 . IKINE(NUMNOD),LPBY(*), PROCNE_PXFEM(*),
282 . ISENDP_PXFEM(*),IRECVP_PXFEM(*),IADSDP_PXFEM(*),
283 . IADRCP_PXFEM(*),FR_NBCC1(2,*),INOD_CRKXFEM(*),
284 . IEL_CRKXFEM(*),IADC_CRKXFEM(*),ADSKY_CRKXFEM(0:*),
285 . PROCNE_CRKXFEM(*),ISENDP_CRKXFEM(*),IRECVP_CRKXFEM(*),
286 . IADSDP_CRKXFEM(*),IADRCP_CRKXFEM(*),
287 . IGROUPC(*),IGROUPTG(*),IGROUPS(*),IGROUPFLG(2),
288 . IRBKIN_L(*), KINDRBY(*), DD_R2R_ELEM(*),SDD_R2R_ELEM,
289 . KINET(*),WEIGHT_MD(*),NUMSPH_GLO_R2R,FLG_SPHINOUT_R2R,
290 . ISENSINT(NISUBMAX+1,NINTER),NISUBMAX,
291 . INTLIST25(NINTER25) ,INT24E2EUSE ,FXVEL_FGEO,
292 . TAGSLV_RBY(NUMNOD)
293 INTEGER, INTENT(IN ),DIMENSION(LISKN,NUMFRAM+1) :: IFRAME
294 INTEGER, INTENT(IN ),DIMENSION(LISKN,NUMSKW+1) :: ISKWN
295! INT7ITIED : check if an interface type 7 with ITIED /= 0 is used
296! in order to force the communication of a list of candidate nodes
297! INT7ITIED = 0 type 7 + ITIED/=0 not used
298! INT7ITIED = 1 type 7 + ITIED/=0 used
299 INTEGER, INTENT(INOUT) :: INT7ITIED
300 INTEGER, INTENT(INOUT) :: NHIER_RBY
301 my_real
302 . x(3,*), d(3,*), v(3,*), vr(3,*),
303 . ms(*), in(*), wa(*), a(3,*), ar(3,*),
304 . uwa(*), stifn(*), stifr(*),
305 . partsav(npsav,*),parts0(*),
306 . dmas, diner ,
307 . pm(npropm,*) , geo(npropg,*),
308 . viscn(*),
309 . secbuf(*),secfcum(7,numnod,nsect),xframe(nxframe,*),
310 . elbuf(*), msc(*), inc(*), mstg(*), intg(*), ptg(*),
311 . mscnd(*), incnd(*), fthe(*), fthesky(*),ftheskyi(*), mcp(*),
312 . ms0(*), admsms(*), mcpc(*), mcptg(*), diag_sms(*),
313 . dmelc(*), dmeltg(*), dmels(*), dmeltr(*), dmelp(*), dmelrt(*),
314 . res_sms(3,*),rby(nrby,*), dmint2(4,i2nsn25),
315 . dmsph(*),condn(*),condnsky ,tab_mat(ngroup),forneqs(3,*)
316 my_real
317 . fxbfp(*), fxbefw(*), fxbedp(*), fxbgrp(*), fxbgrw(*),in0(*)
318 my_real
319 . thke(numelc+numeltg)
320c INTEGER*8
321c . I8A(3,3,*),I8AR(3,3,*),I8STIFN(3,*),I8STIFR(3,*),
322c . I8VISCN(3,*)
323C
324
325 LOGICAL, DIMENSION(NSPMD), INTENT(inout) :: NEED_COMM_INT25_SOLID_EROSION !< boolean, true if the proc needs to comm some values related to interface type 25 with solid erosion
326 INTEGER, INTENT(inout) :: COMM_INT25_SOLID_EROSION !< integer, sub-communicator related to interface type 25 with solid erosion
327C
328 DOUBLE PRECISION XDP(3,*)
329 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
330 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
331 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP,NXEL) :: XFEM_TAB
332 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
333 TYPE(H3D_DATABASE) :: H3D_DATA
334 TYPE (PINCH) :: PINCH_DATA
335 TYPE (SENSORS_) :: SENSORS
336C-----------------------------------------------
337 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
338 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
339 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
340 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
341 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
342 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM
343 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
344 TYPE (GROUP_) , DIMENSION(NGRPART) :: IGRPART
345 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
346C-----------------------------------------------
347 TYPE (FAILWAVE_STR_) ,TARGET :: FAILWAVE
348 TYPE (NLOCAL_STR_) ,TARGET :: NLOC_DMG
349 TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM ! structure for interface sorting comm
350 TYPE (STACK_PLY) :: STACK
351C-----------------------------------------------
352 TYPE(OUTPUT_),INTENT(INOUT) :: OUTPUT
353 TYPE(sh_offset_) :: SH_OFFSET_TAB
354 TYPE (LOADS_) ,INTENT(INOUT) :: LOADS
355 type (glob_therm_) ,intent(inout) :: glob_therm
356 type (pblast_) ,intent(inout) :: pblast
357 type (rbe3_) ,intent(inout) :: rbe3
358C-----------------------------------------------
359C L o c a l V a r i a b l e s
360C-----------------------------------------------
361 INTEGER IMUEL, I, J, K, NG, NINT7,NNOD,K2S,K0,IAD1,IDUM,LLL,
362 . LRBUF, LIBUF, ITY, IAD, NNBEM, ITYP,IROTG,NS,LF,LT,LL,L,
363 . L1,L2,ISECTR,NFR,IC,ICR,NISUB, NI25,NBR,NSENSOR,INLOC
364 INTEGER JD(50),KD(50),JFI,KFI,NMN,II,NINOUT,NNO,NEL,IFLGADM,
365 . N,JJ,KK, NFT, ISOLNOD,NBS
366 INTEGER, DIMENSION(SENSORS%NSENSOR) :: INDEX_SENSOR
367 INTEGER, DIMENSION(:), ALLOCATABLE :: ISEND,IRECV
368 INTEGER :: ITIED,NINIVELTG
369 my_real :: rdum
370 CHARACTER ZONE*5
371 INTEGER VALUES(8)
372C=======================================================================
373 idum = 0
374 rdum = zero
375 isectr = 0
376 nsensor = sensors%NSENSOR
377C-----------------------------------------------
378C //
379C-----------------------------------------------
380C
381C Sequential part
382C
383 IF (itask == 0)THEN
384C zeroing ITYPTS for DTIX
385C
386 itypts=0
387C
388C kinematic conditions : arrays init. (RBY & INT20)
389C
390 CALL init_kyne(ikine,npby,lpby,tagslv_rby,nhier_rby)
391 CALL spmd_max_i(nhier_rby)
392C
393C reaction force (node array)
394C
395 cptreac = 0
396 IF (ireac == 1 ) CALL init_reac_nod(cptreac,nodreac,nthgrp,output%TH%ITHGRP,output%TH%ITHBUF)
397C
398C TH init for group of elems
399C
400 ngrth = 0
401 IF (igrelem == 1 ) THEN
402 CALL init_th_group(grth ,igrth ,nelem ,ngrth ,iparg ,
403 . ipart ,igrbric ,igrquad ,igrsh4n ,igrsh3n,
404 . igrtruss ,igrbeam ,igrspring)
405 ENDIF
406C----- reset initial mass
407 IF (imassi /= 0) THEN
408 ms(1:numnod)=ms0(1:numnod)
409 IF (iroddl /=0) in(1:numnod)=in0(1:numnod)
410 END IF
411C
412C Parallel Structures Init.
413C
414 irotg=0
415 DO i=1,nrbe3
416 irotg=max(irotg,rbe3%IRBE3(6,i))
417 ENDDO
418 CALL spmd_max_i(irotg)
419 rbe3%irotg = irotg
420 IF(irotg==0) THEN
421 rbe3%irotg_sz = 5
422 ELSE
423 rbe3%irotg_sz = 10
424 ENDIF
425
426C---------RBE2----
427 irotg=0
428 DO i=1,nrbe2
429 ic = irbe2(4,i)
430 icr=(ic-512*(ic/512))/64
431 irotg=max(irotg,icr)
432 IF (irbe2(11,i)==0) irotg =1
433 ENDDO
434 CALL spmd_max_i(irotg)
435 IF(irotg==0) THEN
436 r2size = 4
437 ELSE
438 r2size = 8
439 ENDIF
440 ns = nrbe2
441 CALL spmd_max_i(ns)
442 IF (ns==0) r2size = 0
443 nfr = iad_rbe2(nspmd+1)-iad_rbe2(1)
444 IF (nspmd==1) THEN
445 rbe3%irotg_sz = 0
446 r2size = 0
447 ENDIF
448
449c
450C IRBE2 init.
451 CALL rbe2_init(irbe2 ,lrbe2 ,nmrbe2 ,fr_rbe2 ,fr_rbe2m,nfr)
452C
453 CALL mpp_init(
454 1 ipari ,isendto ,ircvfrom,intlist ,nbintc ,
455 2 isizxv ,ilenxv ,iad_elem,i2size ,itask ,
456 3 islen7 ,irlen7 ,islen11 ,irlen11 ,igrbric ,
457 4 nme17 ,islen17 ,irlen17 ,irlen7t ,islen7t ,
458 5 lindidel,lbufidel,irlen20 ,islen20 ,irlen20t,
459 6 islen20t,nbint20 ,irlen20e,islen20e,fr_rby ,
460 7 fr_rby6 ,npby ,irbkin_l,nrbykin_l,kindrby,
461 8 nsensor ,sensors%SENSOR_TAB,lbufidel24, intbuf_tab,
462 9 sort_comm,need_comm_int25_solid_erosion,comm_int25_solid_erosion )
463C
464 IF(idel7ng>0.OR.irad2r>0.OR.alemuscl_param%IALEMUSCL>0.OR.pdel>0) THEN
465 CALL chkinit(
466 2 ixs ,ixq ,ixc ,ixt ,ixp ,
467 3 ixr ,ixtg ,ixs10 ,ixs20 ,
468 4 ixs16 ,ixtg1 ,geo ,addcnel ,cnel ,
469 5 addtmpl ,iparg )
470 ENDIF
471
472C
473 IF (irad2r /= 0) THEN
474 CALL r2r_init(iexlnk ,itab,igrnod,x ,
475 2 ms ,in ,dd_r2r,weight ,iad_elem,
476 3 fr_elem,addcnel,cnel,ixc,iparg,icodt,icodr,
477 4 ibfv,d,rby,npby,xdp,stifn,stifr,dd_r2r_elem,
478 5 sdd_r2r_elem,weight_md,ilenxv,numsph_glo_r2r,
479 6 flg_sphinout_r2r,ipari,nloc_dmg)
480 END IF
481 ! FANI(1,1) = VECT_CONT !cont
482
483 ! FANI(1,NFIA+1) = VECT_FINT ! FINT
484 nfia = numnod*min(1,anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT)
485 ! FANI(1,NFEA+1) = VECT_FEXT ! FEXT
486 nfea = nfia + numnod*min(1,anim_v(5)+outp_v(5)+h3d_data%N_VECT_FINT)
487 ! FANI(1,NFNCA+1) = VECT_PCONT ! FNCONT
488 nfnca= nfea + numnod*min(1,anim_v(6)+outp_v(6)+h3d_data%N_VECT_FEXT)
489 ! FANI(1,NFTCA+1) = VECT_PCONT_2 !FTCONT
490 nftca= nfnca+ numnod*min(1,anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT)
491 ! FANI(1,NFOA+1) = SECT + RBODY + RWALL = FOPT
492 nfoa = nftca+ numnod*min(1,anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT)
493 ! FANI(1,NFT2+1) = VECT_CONT2 = FNCONT2
494 nft2 = nfoa+ 2*(nsect+nrbody+nrwall)
495 ! FANI(1,NFNCA2+1) = VECT_PCONT2 = FNCONTP2
496 nfnca2= nft2 + numnod*min(1,anim_v(13)+h3d_data%N_VECT_CONT2)
497 ! FANI(1,NFTCA2+1) = VECT_PCONT2_2 = FTCONTP2
498 nftca2= nfnca2+ numnod*min(1,anim_v(27)+h3d_data%N_VECT_PCONT2)
499
500 ! ANIN(1,1) = SCAL_DT
501 ! ANIN(1,NDMA+1) = SCAL_DMAS
502 ndma = numnod*min(1,anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT)
503 ! ANIN(1,NDIN+1) = SCAL_DINER
504 ndin = ndma +numnod*min(1,anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS)
505 ! ANIN(1,NDMA2+1) = SCAL_SPRING
506 ndma2 = ndin+numnod*min(1,anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER)
507 ! ANIN(1,NDAMA2+1) = SCAL_DAMA2 ! PDAMA2
508 ndama2 = ndma2+numelr*(anim_fe(11)+anim_fe(12)+anim_fe(13))
509
510
511 IF(iroddl/=0)THEN
512 DO ng=1,ninter
513 ity = ipari(7,ng)
514 IF(ity==2) THEN
515 nmn=ipari(6,ng)
516 DO ii = 1, nmn
517 i = intbuf_tab(ng)%MSR(ii)
518 intbuf_tab(ng)%NMAS(nmn+ii) = in(i)
519C For multidomains inertia of main nodes on multidomains interface msut be non zero
520 IF (irad2r==1) in(i)=max(em20,in(i))
521 END DO
522 END IF
523 END DO
524 END IF
525 dmas = zero
526 diner = zero
527C
528 IF(mcheck==0)ncycle=0
529 i7kglo = 0
530 nabfwr = 0
531C
532 i13a=1+2*nsnod
533 i13b=i13a+nsels
534 i13c=i13b+nselq
535 i13d=i13c+nselc
536 i13e=i13d+nselt
537 i13f=i13e+nselp
538 i13g=i13f+nselr
539 i13h=i13g+nselu
540 i13i=i13h+nseltg
541 i15ath=1+lipart1*(npart+nthpart)
542 i15a=i15ath+2*9*(npart+nthpart)
543 i15b=i15a+numels
544 i15c=i15b+numelq
545 i15d=i15c+numelc
546 i15e=i15d+numelt
547 i15f=i15e+numelp
548 i15g=i15f+numelr
549 i15h=i15g
550 i15i=i15h+numeltg
551 i15j=i15i+numelx
552 i15k=i15j+numsph
553 i35ath=1+lisub1*nsubs
554C
555 i87a = 1
556 i87b = i87a + 8 * numels + 6 * numels10 + 12 * numels20 + 8 * numels16
557 i87c = i87b + 4 * numelq
558 i87d = i87c + 4 * numelc
559 i87e = i87d + 2 * numelt
560 i87f = i87e + 2 * numelp
561 i87g = i87f + 3 * numelr
562 i87h = i87g + 3 * numeltg
563 i87h = i87h + 3 * numeltg6
564 i87i = i87h
565 i87j = i87i + 4 * nskymv0
566 i87k = i87j + 4 * nconld
567 i87l = i87k + 4 * glob_therm%NUMCONV
568 i87m = i87l + 4 * glob_therm%NUMRADIA
569 i87n = i87m + slloadp
570C I87O = I87N + 4 * GLOB_THERM%NFXFLUX
571C
572C----------------------------
573 maxnx=0
574 DO i=1,numelx
575 IF (kxx(3,i)>maxnx) maxnx=kxx(3,i)
576 ENDDO
577C----------------------------
578 DO i=1,npart
579 partsav(8,i)=parts0(i)
580 ENDDO
581C----------------------------
582 IF (ispmd==0)THEN
583 CALL date_and_time(startdate, starttime, zone, values)
584 WRITE(istdo,'(A,I2.2,A,I2.2,A,I4.4)') ' ',values(3),'/',VALUES(2),'/',VALUES(1)
585 WRITE(IOUT,'(a,i2.2,a,i2.2,a,i4.4)') ' ',VALUES(3),'/',VALUES(2),'/',VALUES(1)
586 END IF
587C
588 MANIM = 0
589 MREST = 0
590 MSTOP = 0
591 ICTLSTOP = 0
592 H3D_DATA%MH3D = 0
593.AND. IF(DTIN/=0. MCHECK==0)THEN !go on with previous time step in case of checkpoint restart (/CHKPT)
594 IF(DT2OLD==ZERO)THEN
595 DT2OLD=DTIN/ONEP1
596 ELSE
597 DT2OLD= MIN(DT2OLD,DTIN/ONEP1)
598 ENDIF
599 ENDIF
600 IF(ANIM_V(26)+H3D_DATA%N_VECT_CONT_MAX >0) IFCONTMAX=1
601 IF(H3D_DATA%N_VECT_PCONT_MAX >0) IFCONTPMAX=1
602 IF(H3D_DATA%N_VECT_CONT2_MAX >0) IFCONT2MAX=1
603 IF(H3D_DATA%N_VECT_PCONT2_MAX >0) IFCONTP2MAX=1
604 IF(H3D_DATA%N_VECT_CONT2_MIN >0) IFCONT2MIN=1
605 IF(H3D_DATA%N_VECT_PCONT2_MIN >0) IFCONTP2MIN=1
606 IF(H3D_DATA%N_SCAL_CSE_FRIC >0) THEN
607 OUTPUT%DATA%S_EFRIC = NUMNOD
608 IF(NINTSTAMP/=0) OUTPUT%DATA%S_EFRICG = NUMNODG
609 ENDIF
610 IF(OUTPUT%DATA%NINEFRIC >0) OUTPUT%DATA%S_EFRICINT = NUMNOD
611 IF(OUTPUT%DATA%NINEFRIC_STAMP >0) OUTPUT%DATA%S_EFRICINTG = NUMNODG
612C------------------------
613C PARAL. ARITH.
614C------------------------
615 IF(IPARIT==3) THEN
616 write(6,*) 'non supported /parith option'
617 ELSEIF(IPARIT/=0) THEN
618C
619C parith/on
620C
621 IF(IVECTOR==1)THEN
622 IAD1 = NUMNOD+2
623 ELSE
624 IAD1 = 1
625 ENDIF
626 CALL ASSADD2(
627 1 PON%ADSKY ,PON%ADSKY(IAD1),PON%FSKY ,PON%FSKYM ,IAD_ELEM ,
628 2 FR_ELEM ,FR_NBCC ,PROCNE,NISKYFI ,ADDCNI2 ,
629 3 PROCNI2 ,IAD_I2M ,FR_I2M,FR_NBCCI2,ADDCNI2(IAD1),
630 4 PON%IADSDP ,PON%IADRCP ,PON%ISENDP,PON%IRECVP ,FTHESKY ,
631 5 NISKYFIE,INOD_PXFEM ,ADSKY_PXFEM,PROCNE_PXFEM,
632 6 ISENDP_PXFEM,IRECVP_PXFEM ,IADSDP_PXFEM,IADRCP_PXFEM,
633 7 FR_NBCC1,INOD_CRKXFEM,ADSKY_CRKXFEM,PROCNE_CRKXFEM,
634 8 ISENDP_CRKXFEM,IRECVP_CRKXFEM,IADSDP_CRKXFEM,IADRCP_CRKXFEM,
635 9 CONDNSKY,GLOB_THERM)
636 ENDIF
637C
638 CALL FILLIPARTL(
639 1 IPARTL ,IPART(I15A),IPART(I15B),IPART(I15C),IPART(I15D),
640 2 IPART(I15E),IPART(I15F),IPART(I15G),IPART(I15H),IPART(I15I),
641 3 IPART(I15J),IPART(I15K),NPARTL )
642C------------------------
643C SPLIT GROUP FOR OPTIMIZATION
644C------------------------
645 CALL GRPSPLIT(
646 1 IPARG, IGROUC, NGROUC, IGROUNC, NGROUNC,
647 2 IXC,IXS,IXTG,IPM,IGEO,PM,GEO,TABMP_L,TAB_MAT)
648C--------------------------
649C FIND GROUP FOR SHELLS
650C--------------------------
651 IF(IGROUPFLG(1) == 1 ) CALL FINDGROUPC(IPARG, IGROUC, NGROUC, IGROUPC, IGROUPTG)
652C--------------------------
653C FIND GROUP FOR BRICKS
654C--------------------------
655 IF(IGROUPFLG(2) == 1 ) CALL FINDGROUPS(IPARG, IGROUPS)
656C----------------------------------------------------------
657C TAG : NODES FROM ALL SECTIONS
658C----------------------------------------------------------
659 IF(ISECUT/=0)THEN
660 K0=NSTRF(25)
661 DO I=1,NSECT
662 NNOD=NSTRF(K0+6)
663 K2S=K0+30+NSTRF(K0+14)
664 DO J=1,NNOD
665 SECFCUM(4,NSTRF(K2S),I)=1.
666 K2S=K2S+1
667 ENDDO
668 IF (NSTRF(K0) >= 100 ) ISECTR = I
669 K0=NSTRF(K0+24)
670 ENDDO
671 CALL SECTION_INIT(NSTRF,SECBUF,NOM_SECT,ISECTR,NSECT,IOLDSECT)
672 ENDIF
673C-----------------------------------------------------
674C SQRT H1, H2, H3 for shell elements
675C-----------------------------------------------------
676 DO I = 1, NUMGEO
677 IGTYP = IGEO(11,I)
678.OR..AND..OR. IF(IGTYP==1(IGTYP>=9 IGTYP<=11)IGTYP==16) THEN
679 GEO(18,I) = SQRT(GEO(13,I))
680 GEO(19,I) = SQRT(GEO(14,I))
681 GEO(20,I) = SQRT(GEO(15,I))
682 ENDIF
683 ENDDO
684C-----------------------------------------------------
685C optional SQRT(G), SQRT(A11) SQRT(A12), SQRT(NU), SQRT(SHF) for former restart file
686C-----------------------------------------------------
687 IF(PMINVER<6)THEN
688 DO I = 1, NUMGEO
689 GEO(100,I) = SQRT(GEO(38,I)) ! SHFSR
690 END DO
691 DO I = 1, NUMMAT
692 IF(IPM(2,I)==999)CYCLE !possible negative square root otherwise PM(25)=CPE(gas)
693 PM(12,I) = SQRT(ABS(PM(22,I))) ! GSR
694 PM(13,I) = SQRT(ABS(PM(24,I))) ! A11SR
695 PM(14,I) = SQRT(ABS(PM(25,I))) ! A12SR
696 PM(190,I)= SQRT(ABS(PM(21,I))) ! NUSR
697 END DO
698 END IF
699C----------------------------------------------------------
700C INIT FLEX BODY
701C----------------------------------------------------------
702 IF (NFXBODY>0) THEN
703 DO I=1,LENVAR
704 FXBFP(I)=ZERO
705 FXBGRP(I)=ZERO
706 ENDDO
707 DO I=1,NFXBODY
708 FXBEFW(I)=ZERO
709 FXBGRW(I)=ZERO
710 FXBEDP(I)=ZERO
711 ENDDO
712 ENDIF
713C----------------------------------------------------------
714C LWORKING ARRAY SIZES - AIRBAG BEM
715C----------------------------------------------------------
716 IAD=0
717 LWIBEM=0
718 LWRBEM=0
719 DO I=1,NVOLU
720 ITYP=MONVOL(IAD+2)
721 IF (ITYP==7) THEN
722 NNBEM=MONVOL(IAD+32)
723 LWIBEM=LWIBEM+1+NNBEM
724 LWRBEM=LWRBEM+NNBEM**2
725 ENDIF
726 IAD=IAD+NIMV
727 ENDDO
728C----------------------------------------------------------
729C WORKING ARRAY SIZES - FLOW BEM
730C----------------------------------------------------------
731 IAD=0
732 LWIFLOW=0
733 LWRFLOW=0
734 DO I=1,NFLOW
735 ITYP=IFLOW(IAD+2)
736.OR. IF (ITYP == 1 ITYP == 3) THEN
737 LWIFLOW=LWIFLOW+IFLOW(IAD+8)
738 LWRFLOW=LWRFLOW+IFLOW(IAD+9)
739 ENDIF
740 IAD=IAD+LIFLOW
741 ENDDO
742C----------------------------------------------------------
743C Domain Decomposition Weight computation
744C----------------------------------------------------------
745 IF(IDDW>0) CALL INITIMEG(NGROUP)
746C----------------------------------------------------------
747C Init Adaptive Meshing (Sequential)
748C----------------------------------------------------------
749 IF(NADMESH/=0)THEN
750 CALL ADMINI(IXC ,IPART(I15C),IXTG ,IPART(I15H),IPART,
751 . IGEO,IPM ,IPARG ,X ,MS ,
752 . IN ,ELBUF_TAB ,SH4TREE,IPADMESH,MSC ,
753 . INC ,SH3TREE ,MSTG ,INTG ,PTG ,
754 . SH4TRIM ,SH3TRIM,MSCND ,INCND ,PM ,
755 . MCP ,MCPC ,MCPTG ,TAGTRIMC ,TAGTRIMTG,
756 . GLOB_THERM%ITHERM_FE)
757!
758 CALL ADMORDR(SH4TREE,SH3TREE,IXC,IXTG)
759 IADMESH=0
760 NGDONE=1
761 END IF
762 IF(ISTATCND/=0)THEN
763C ADAPTIVE MESHING + STATIC CONDENSATION
764 CALL CNDORDR(IPART,IPART(I15C),IPART(I15H),SH4TREE,SH3TREE)
765 END IF
766C----------------------------------------------------------
767C Lagrangian multipliers (sequential)
768C----------------------------------------------------------
769 IF(LAG_NCF+LAG_NCL > 0)THEN
770 LAG_SEC=0
771C numbering incompatible options if NSPMD > 1
772 DO I = 1, NINTER
773 IF(IPARI(33,I)/=0)LAG_SEC=1
774 END DO
775 DO I = 1, NRWALL
776 IF(NPRW(I+5*NRWALL)==1)LAG_SEC=1
777 END DO
778 IF(NBCSLAG+NGJOINT+NRBYLAG > 0)LAG_SEC=1
779C NUMMPC + NFVLAG : ok (parallele SPMD)
780 END IF
781
782C-----------------------
783C INTERFACE TYPE 1
784C-----------------------
785 IS_PRESENT_INTER1 = -1
786C-----------------------
787C INTERFACE TYPE 18 KINE
788C-----------------------
789 INT18KINE=0
790 DO I=1, NINTER
791.AND..AND. IF(IPARI(7,I) == 7 IPARI(34,I) == -2 IPARI(22,I) == 7)THEN
792 INT18KINE=1
793 ENDIF
794 ENDDO
795C-----------------------
796C INTERFACE TYPE 7 FLAG + ITIED /= 0
797C-----------------------
798 INT7ITIED = 0
799 DO I=1, NINTER
800 ITYP = IPARI(7,I)
801 ITIED = IPARI(85,I)
802.AND. IF(ITYP==7ITIED/=0)THEN
803 INT7ITIED = 1
804 ENDIF
805 IF(ITYP==10) INT7ITIED = 1
806 ENDDO
807C-----------------------
808C INTERFACE TYPE 24 FLAG
809C-----------------------
810 INT24USE = 0
811 DO I=1, NINTER
812 IF(IPARI(7,I)==24)THEN
813 INT24USE = 1
814C Check if type 24 has E2E , set INT24E2EUSE
815 IF(IPARI(59,I) >0) INT24E2EUSE=1
816 ENDIF
817 ENDDO
818C-----------------------
819C INTERFACE TYPE 25 LIST
820C-----------------------
821 NI25 = 0
822 DO I=1, NINTER
823 IF(IPARI(7,I)==25)THEN
824 NI25 = NI25 + 1
825 INTLIST25(NI25)=I
826 ENDIF
827 ENDDO
828C-----------------------
829C SENSOR INTERFACE
830C-----------------------
831 IF (SENSORS%STABSEN > 0) THEN
832 DO N=1,NINTER
833 NISUB =IPARI(36,N)
834 ISENSINT(1,N) = SENSORS%TABSENSOR(N+1 + NSECT) - SENSORS%TABSENSOR(N + NSECT)
835C
836 IF (IPARI(71,N)>0) THEN
837C-- sensor associated to all interfaces of type19
838 ISENSINT(1,N) = ISENSINT(1,IPARI(71,N))
839 ENDIF
840C
841 DO I=1,NISUB
842 ISENSINT(I+1,N) = SENSORS%TABSENSOR(I +1 + NSECT + NINTER) -
843 . SENSORS%TABSENSOR(I + NSECT + NINTER)
844 ENDDO
845 ENDDO
846 ENDIF
847C-----------------------
848C INTERFACE TYPE 2 penalty
849C-----------------------
850 INT2PEN=0
851 DO I=1, NINTER
852.AND. IF (IPARI(7,I) == 2 IPARI(20,I) == 25) THEN
853 INT2PEN=1
854 EXIT
855 ENDIF
856 ENDDO
857
858C-----------------------
859C /IMPDISP/FGEO
860C-----------------------
861 FXVEL_FGEO=0
862 DO N=1,NFXVEL
863 IF (IBFV(13,N) > 0 ) THEN
864 FXVEL_FGEO = 1
865 EXIT
866 ENDIF
867 ENDDO
868
869
870 ENDIF ! ITASK==0
871C-----------------------------------------------------
872C END OF SEQUENTIAL PART
873C-----------------------------------------------------
874C
875 CALL MY_BARRIER()
876C--- // --------------------------------------
877C FORCE & MOMENTUM INIT
878C---------------------------------------------
879.AND. IF(NINTER/=0ANIM_V(4)+OUTP_V(4)+H3D_DATA%N_VECT_CONT >0) OUTPUT%DATA%VECT_CONT = 0
880 IF(ANIM_V(12)+OUTP_V(12)+H3D_DATA%N_VECT_PCONT>0) THEN
881 OUTPUT%DATA%VECT_PCONT = 0
882 OUTPUT%DATA%VECT_PCONT_2 = 0
883 END IF
884 IF(ANIM_N(2)+OUTP_N(2)+H3D_DATA%N_SCAL_DMAS >0)THEN
885 OUTPUT%DATA%SCAL_DMAS = 0
886!!#include "vectorize.inc"
887!! DO I=NODFT,NODLT
888!! ANIN(I+NDMA) = ZERO
889!! ENDDO
890 ENDIF
891 IF(ANIM_N(12)+OUTP_N(3)+H3D_DATA%N_SCAL_DINER >0)THEN
892 OUTPUT%DATA%SCAL_DINER = 0
893!!#include "vectorize.inc"
894!! DO I=NODFT,NODLT
895!! ANIN(I+NDIN) = ZERO
896!! ENDDO
897 END IF
898.OR..OR. IF(ANIM_N(15) == 1 ANIM_N(16) == 1 H3D_DATA%N_SCAL_DAMA2 == 1)THEN
899 OUTPUT%DATA%SCAL_DAMA2 = 0
900!!#include "vectorize.inc"
901!! DO I=NODFT,NODLT
902!! ANIN(NDAMA2+2*(I-1)+1) = ZERO
903!! ANIN(NDAMA2+2*(I-1)+2) = ZERO
904!! ENDDO
905 ENDIF
906!C-----------------------------------------------
907C RESTARTING RADIOSS ENGINE.
908 IF (IPARIT==0) THEN
909 CALL ZEROR(A(1,NDTASK),NUMNOD)
910 IF(IRODDL/=0)CALL ZEROR(AR(1,NDTASK),NUMNOD)
911 DO I=NDTASK,NDTASK+NUMNOD-1
912 STIFN(I)=EM20
913 ENDDO
914 IF(IRODDL/=0)THEN
915 DO I=NDTASK,NDTASK+NUMNOD-1
916 STIFR(I)=EM20
917 ENDDO
918 ENDIF
919C
920 IF(KDTINT/=0)THEN
921 CALL ZERO1(VISCN(NDTASK),NUMNOD)
922 ENDIF
923C
924 IF (GLOB_THERM%ITHERM_FE > 0) THEN
925 CALL ZERO1(FTHE(NDTASK),NUMNOD)
926 ENDIF
927C
928 IF(SOL2SPH_FLAG/=0)THEN
929 CALL ZERO1(DMSPH(NDTASK),NUMNOD)
930 ENDIF
931
932 IF (GLOB_THERM%NODADT_THERM > 0) THEN
933 CALL ZERO1(CONDN(NDTASK),NUMNOD)
934 ENDIF
935C
936 IF(NPINCH > 0) THEN
937 CALL ZEROR(PINCH_DATA%APINCH(1,NDTASK),NPINCH)
938 DO I=NDTASK,NDTASK+NUMNOD-1
939 PINCH_DATA%STIFPINCH(I)=EM20
940 ENDDO
941 ENDIF
942 ELSE ! IPARIT>0
943 CALL ZEROR(A(1,NODFT),NUMNTHREAD)
944 IF(IRODDL/=0)CALL ZEROR(AR(1,NODFT),NUMNTHREAD)
945 DO I=NODFT,NODLT
946 STIFN(I)=EM20
947 ENDDO
948 IF(IRODDL/=0)THEN
949 DO I=NODFT,NODLT
950 STIFR(I)=EM20
951 ENDDO
952 ENDIF
953 IF(KDTINT/=0)THEN
954 CALL ZERO1(VISCN(NODFT),NUMNTHREAD)
955 ENDIF
956C
957 IF (GLOB_THERM%ITHERM_FE > 0 ) THEN
958 CALL ZERO1(FTHE(NODFT),NUMNTHREAD)
959 ENDIF
960C
961 IF(SOL2SPH_FLAG/=0)THEN
962 CALL ZERO1(DMSPH(NODFT),NUMNTHREAD)
963 ENDIF
964
965 IF (GLOB_THERM%NODADT_THERM > 0) THEN
966 CALL ZERO1(CONDN(NODFT),NUMNTHREAD)
967 ENDIF
968C
969 IF(NPINCH > 0) THEN
970 CALL ZEROR(PINCH_DATA%APINCH(1,NODFT),NUMNTHREAD)
971 DO I=NODFT,NODLT
972 PINCH_DATA%STIFPINCH(I)=EM20
973 ENDDO
974 ENDIF
975 ENDIF
976
977C
978 IF(IPARIT==0) THEN
979 IF(IRODDL==0) THEN
980 DO I = NODFT, NODLT
981 STIFN(I) = STIFN(I)*WEIGHT(I)
982 ENDDO
983 ELSE
984 DO I = NODFT, NODLT
985 STIFN(I) = STIFN(I)*WEIGHT(I)
986 STIFR(I) = STIFR(I)*WEIGHT(I)
987 ENDDO
988 ENDIF
989 ENDIF
990C-----------------------------------------------------
991C INIT IMPLICIT
992C----------------------------------------------------------
993C --default values----
994 IF (ITASK==0) CALL IMP_INIT(V,VR,IPARG,IPM,IGEO,ELBUF_TAB)
995C----------------------------------------------------------
996C INIT ADAPTIVE MESHING //
997C----------------------------------------------------------
998 IF(NADMESH/=0)THEN
999 IFLGADM=0
1000 CALL ADMGVID(
1001 1 IPARG ,ELBUF_TAB ,PON%FSKY ,PON%FSKY ,FTHESKY,
1002 2 PON%IADC,PON%IAD_TG,IFLGADM,IGROUC,NGROUC,
1003 3 CONDNSKY ,GLOB_THERM%NODADT_THERM)
1004 END IF
1005C
1006C----------------------------------------------------------
1007 IF( ITASK == 0) CALL KININI()
1008C----------------------------------------------------------
1009C INIT SELECTIVE MASS SCALING
1010C----------------------------------------------------------
1011.AND. IF(IDTMINS == 1 IDTMINS_OLD == 1)THEN
1012.OR. IF(DTFACS /= DTFACS_OLD DTMINS /= DTMINS_OLD)THEN
1013C Forget about previous mass scaling (reversibility)
1014 ADMSMS(NODFT:NODLT)=ZERO
1015 RES_SMS(1:3,NODFT:NODLT)=ZERO
1016 ELSEIF(IDTGRS_OLD/=0)THEN
1017.AND. IF( IDTGRS < 0
1018 . -IDTGRS /= IGRPART(IDTGRS_OLD)%ID) THEN
1019C
1020C Forget about previous mass scaling (reversibility)
1021 ADMSMS(NODFT:NODLT)=ZERO
1022 RES_SMS(1:3,NODFT:NODLT)=ZERO
1023 ELSE
1024C ..as if single run
1025 END IF
1026.AND. ELSEIF(IDTGRS_OLD==0IDTGRS/=0)THEN
1027C
1028C Forget about previous mass scaling (reversibility)
1029 ADMSMS(NODFT:NODLT)=ZERO
1030 RES_SMS(1:3,NODFT:NODLT)=ZERO
1031 ELSE
1032C ..as if single run
1033 END IF
1034C
1035.AND. ELSEIF(IDTMINS == 2 IDTMINS_OLD == 2)THEN
1036.OR. IF(DTFACS /= DTFACS_OLD DTMINS /= DTMINS_OLD)THEN
1037C ..keep non diagonal mass from previous run
1038 ELSEIF(IDTGRS_OLD/=0)THEN
1039.AND. IF( IDTGRS < 0
1040 . -IDTGRS/= IGRPART(IDTGRS_OLD)%ID) THEN
1041C
1042C Forget about previous mass scaling (reversibility)
1043 IF(ITASK==0)THEN
1044 DMELC (1:NUMELC )=ZERO
1045 DMELTG(1:NUMELTG)=ZERO
1046 DMELS (1:NUMELS )=ZERO
1047 DMELTR(1:NUMELT )=ZERO
1048 DMELP (1:NUMELP )=ZERO
1049 DMELRT(1:NUMELR )=ZERO
1050 DMINT2(1:4,1:I2NSN25)=ZERO
1051 END IF
1052 RES_SMS(1:3,NODFT:NODLT)=ZERO
1053 ELSE
1054C ..as if single run
1055 END IF
1056.AND. ELSEIF(IDTGRS_OLD==0IDTGRS/=0)THEN
1057C
1058C Forget about previous mass scaling (reversibility)
1059 IF(ITASK==0)THEN
1060 DMELC (1:NUMELC )=ZERO
1061 DMELTG(1:NUMELTG)=ZERO
1062 DMELS (1:NUMELS )=ZERO
1063 DMELTR(1:NUMELT )=ZERO
1064 DMELP (1:NUMELP )=ZERO
1065 DMELRT(1:NUMELR )=ZERO
1066 DMINT2(1:4,1:I2NSN25)=ZERO
1067 END IF
1068 RES_SMS(1:3,NODFT:NODLT)=ZERO
1069 ELSE
1070C ..as if single run
1071 END IF
1072C
1073.AND. ELSEIF(IDTMINS == 1 IDTMINS_OLD /= IDTMINS)THEN
1074C
1075 ADMSMS(NODFT:NODLT)=ZERO
1076 RES_SMS(1:3,NODFT:NODLT)=ZERO
1077C
1078.AND. ELSEIF(IDTMINS == 2 IDTMINS_OLD /= IDTMINS)THEN
1079C
1080 IF(ITASK==0)THEN
1081 DMELC (1:NUMELC )=ZERO
1082 DMELTG(1:NUMELTG)=ZERO
1083 DMELS (1:NUMELS )=ZERO
1084 DMELTR(1:NUMELT )=ZERO
1085 DMELP (1:NUMELP )=ZERO
1086 DMELRT(1:NUMELR )=ZERO
1087 DMINT2(1:4,1:I2NSN25)=ZERO
1088 END IF
1089 RES_SMS(1:3,NODFT:NODLT)=ZERO
1090C
1091.AND. ELSEIF(IDTMINS_INT /= 0 IDTMINS_INT_OLD /= IDTMINS_INT)THEN
1092C
1093 RES_SMS(1:3,NODFT:NODLT)=ZERO
1094C
1095 END IF
1096C
1097 IF(ITASK == 0) THEN
1098 NISKY_SMS=0
1099C enforce sorting contacts
1100 KFORSMS=0
1101.AND..OR. IF((IDTMINS==2IDTMINS_OLD/=IDTMINS)
1102.AND. . (IDTMINS_INT/=0IDTMINS_INT_OLD/=IDTMINS_INT))THEN
1103 KFORSMS=1
1104 END IF
1105 ENDIF
1106C
1107.AND. IF(ANIM_PLY > 0 ITASK == 0) THEN
1108 CALL SPMD_ANIM_PLY_INIT ()
1109 ENDIF
1110C
1111.AND. IF (ICRACK3D > 0 ITASK == 0)THEN
1112 CALL ANIM_XFE_INIT(IXC,IXTG,INOD_CRKXFEM,IEL_CRKXFEM,
1113 . IADC_CRKXFEM,IADC_CRKXFEM(1+4*ECRKXFEC))
1114 ENDIF
1115C-----------------------
1116C ITET=2 OF S10
1117C-----------------------
1118 IF(NS10E > 0) THEN
1119 IF (ITASK == 0) THEN
1120 IF(NSPMD>1) THEN
1121 CALL S10CNDS_DIM(ICNDS10,ITAGND,FR_ELEM,IAD_ELEM,NBS )
1122 ALLOCATE (IAD_CNDS(NSPMD+1),FR_CNDS(NBS))
1123 CALL S10CNDS_INI(ICNDS10,ITAGND,FR_ELEM,IAD_ELEM,IAD_CNDS,FR_CNDS )
1124 ELSE
1125 ALLOCATE (IAD_CNDS(0),FR_CNDS(0))
1126 END IF
1127
1128 CALL CNDMASI2_DIM(IPARI,INTBUF_TAB,ICNDS10,ITAGND,WEIGHT,NKEND,
1129 1 IAD_CNDS,FR_CNDS,NBS,NSPMD)
1130 IF(NKEND>0) THEN
1131 ALLOCATE (IMAP2ND(NKEND),MASI2ND0(NKEND))
1132 CALL CNDMASI2_INI(IPARI,INTBUF_TAB,ICNDS10,ITAGND,
1133 . NKEND,IMAP2ND,MASI2ND0,MS0,WEIGHT, itab )
1134 IF(MCHECK>0) NKEND = -NKEND
1135 END IF
1136 CALL S10CNDI2_INI(IPARI,INTBUF_TAB,ICNDS10,ITAGND,WEIGHT,
1137 . FR_CNDS,IAD_CNDS,itab )
1138 CALL S10CND_INI(ICNDS10,ITAGND,IAD_CNDM,FR_CNDM,FR_NBCCCND,
1139 1 ADDCNCND,PROCNCND,VND ,V ,ITAB ,
1140 2 IAD_CNDM1,FR_CNDM1,FR_NBCCCND1)
1141 END IF
1142 CALL MY_BARRIER()
1143 ENDIF
1144C-----------------------
1145C TMAX OF H3D
1146C-----------------------
1147 IF (ITASK == 0)
1148 . CALL TMAX_IPART(IPARG ,IPART ,IPART(I15A),IPART(I15C),
1149 . IPART(I15I),H3D_DATA)
1150 CALL INI_TMAX(ELBUF_TAB ,IPARG ,GEO ,PM ,
1151 . IXS ,IXS10 ,IXS16 ,IXS20 ,IXQ ,
1152 . IXC ,IXTG ,IXT ,IXP ,IXR ,
1153 . X ,D ,V ,IAD_ELEM ,FR_ELEM ,
1154 . WEIGHT ,IPM ,IGEO ,STACK ,ITASK )
1155!$OMP SINGLE
1156 IF (FAILWAVE%WAVE_MOD > 0) THEN
1157 CALL SPMD_FAILWAVE_BOUNDARIES(FAILWAVE,IAD_ELEM,FR_ELEM)
1158 ENDIF
1159 ! Non-local regularization is activated
1160 IF (NLOC_DMG%IMOD > 0) THEN
1161 CALL SPMD_SUB_BOUNDARIES(NLOC_DMG,IAD_ELEM,FR_ELEM)
1162 ENDIF
1163C-----------------------
1164C DT_DC OF TSH
1165C-----------------------
1166 NTSHEG =0
1167 NTSHEGG =0
1168 IF (IDTTSH>0) CALL DIM_TSHEDG(ELBUF_TAB ,NTSHEG, IXS ,IPARG )
1169 IF(NSPMD>1) THEN
1170 NTSHEGG = NTSHEG
1171 CALL SPMD_MAX_I(NTSHEGG)
1172 END IF
1173 IF (NTSHEG > 0) THEN
1174 ALLOCATE (IENUNL(2*NTSHEG),ALPHA_DC(NUMNOD))
1175 IENUNL=0
1176 ALPHA_DC=ONE
1177 CALL IND_TSHEDG(ELBUF_TAB ,IENUNL, IXS ,IPARG )
1178 IF(NSPMD>1) THEN
1179 NBS = IAD_ELEM(1,NSPMD+1)-IAD_ELEM(1,1)
1180 ALLOCATE (ISEND(NBS),IRECV(NBS))
1181 ISEND=0
1182 CALL TSHCDCOM_DIM(IENUNL,FR_ELEM,IAD_ELEM,NBS,NBR ,
1183 . ISEND ,IRECV )
1184 ALLOCATE (IAD_STSH(NSPMD+1),FR_STSH(NBS))
1185 CALL TSHCDCOM_INI(ISEND,IAD_ELEM,FR_ELEM,IAD_STSH,FR_STSH)
1186 ALLOCATE (IAD_RTSH(NSPMD+1),FR_RTSH(NBR))
1187 CALL TSHCDCOM_INI(IRECV,IAD_ELEM,FR_ELEM,IAD_RTSH,FR_RTSH)
1188 DEALLOCATE(ISEND,IRECV)
1189 END IF
1190 END IF
1191C-----------------------
1192C offset for contact
1193C-----------------------
1194 CALL INTER_SH_OFFSET_INI(
1195 . NGROUP, NPARG, IPARG, NPROPG,
1196 . NUMGEO, GEO, NUMELC, NIXC,
1197 . IXC, NUMELTG, NIXTG, IXTG,
1198 . NUMNOD, NSPMD, IAD_ELEM, FR_ELEM,
1199 . SFR_ELEM, THKE, ELBUF_TAB, SH_OFFSET_TAB,
1200 . IPARIT )
1201! inivel w/ Tstart
1202 NINIVELTG = LOADS%NINIVELT
1203 IF (NSPMD>1) CALL SPMD_MAX_I(NINIVELTG)
1204 LOADS%NINIVELT_G = NINIVELTG
1205.AND. IF (TT == ZERO LOADS%NINIVELT > 0) THEN
1206 CALL INIVEL_INIT(
1207 . NGRNOD, NGRBRIC, NGRQUAD, NGRSH3N,
1208 . IGRNOD, IGRBRIC, IGRQUAD, IGRSH3N,
1209 . NUMSKW, LISKN, ISKWN, NUMFRAM,
1210 . IFRAME, LOADS%NINIVELT,LOADS%INIVELT,SENSORS)
1211 END IF
1212
1213 DO N = 1, NINTER
1214 CALL INT_FLUSHTIME(INTBUF_TAB(N)%METRIC)
1215 ENDDO
1216!$OMP END SINGLE
1217C-------------------------------------------
1218 RETURN
chkinit
subroutine chkinit(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixs10, ixs20, ixs16, ixtg1, geo, addcnel, cnel, adsky, iparg)
Definition chkstfn3.F:265
spmd_max_i
subroutine spmd_max_i(n)
Definition imp_spmd.F:1362
init_reac_nod
subroutine init_reac_nod(cptreac, nodreac, nthgrp, ithgrp, ithbuf)
Definition init_reac_nod.F:29
init_th_group
subroutine init_th_group(gr, igr, nelem, ngrth, iparg, ipart, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring)
Definition init_th_group.F:33
min
#define min(a, b)
Definition macros.h:20
alemuscl_mod
Definition alemuscl_mod.F:55
alemuscl_mod::alemuscl_param
type(alemuscl_param_) alemuscl_param
Definition alemuscl_mod.F:76
crackxfem_mod
Definition crackxfem_mod.F:121
dtdc_mod
Definition dtdc_mod.F:31
ecnd_mod
Definition ecdn_mod.F:34
failwave_mod
Definition failwave_mod.F:61
groupdef_mod
Definition groupdef_mod.F:668
h3d_inc_mod
Definition h3d_inc_mod.F:42
h3d_mod
Definition h3d_mod.F:311
inter_sorting_mod
Definition inter_sorting_mod.F:57
nlocal_reg_mod
Definition nlocal_reg_mod.F:119
outmax_mod
Definition outmax_mod.F:52
pinchtype_mod
Definition pinchtype_mod.F:69
plyxfem_mod
Definition plyxfem_mod.F:31
stack_mod
Definition stack_mod.F:75
r2r_init
subroutine r2r_init(iexlnk, itab, igrnod, x, ms, in, dd_r2r, weight, iad_elem, fr_elem, addcnel, cnel, ixc, iparg, icodt, icodr, ibfv, dx, rby, npby, xdp, stifn, stifr, dd_r2r_elem, sdd_r2r_elem, weight_md, ilenxv, numsph_glo_r2r, flg_sphinout_r2r, ipari, nloc_dmg)
Definition r2r_init.F:70
rbe2_init
subroutine rbe2_init(irbe2, lrbe2, nmrbe2, fr_rbe2, fr_rbe2m, nfr)
Definition rbe2f.F:623
init_kyne
subroutine init_kyne(ikine, npby, lpby, tagslv_rby, nhier_rby)
Definition resol_init.F:1632
mpp_init
subroutine mpp_init(ipari, isendto, ircvfrom, intlist, nbintc, isizxv, ilenxv, iad_elem, i2size, itask, islen7, irlen7, islen11, irlen11, igrbric, nme17, islen17, irlen17, irlen7t, islen7t, lindidel, lbufidel, irlen20, islen20, irlen20t, islen20t, nbint20, irlen20e, islen20e, fr_rby, fr_rby6, npby, irbkin_l, nrbykin_l, kindrby, nsensor, sensor_tab, lbufidel24, intbuf_tab, sort_comm, need_comm_int25_solid_erosion, comm_int25_solid_erosion)
Definition spmd_i7tool.F:2881

◆ smp_init()

subroutine smp_init ( integer itsk,
integer nodftsk,
integer nodltsk,
integer numntsk,
integer ndtsk,
integer ipmtsk,
integer partftsk,
integer partltsk,
integer nwaftsk,
integer igmtsk,
integer greftsk,
integer greltsk )

Definition at line 1576 of file resol_init.F.

1580C-----------------------------------------------
1581C I m p l i c i t T y p e s
1582C-----------------------------------------------
1583#include "implicit_f.inc"
1584C-----------------------------------------------
1585C C o m m o n B l o c k s
1586C-----------------------------------------------
1587#include "com01_c.inc"
1588#include "com04_c.inc"
1589#include "param_c.inc"
1590#include "task_c.inc"
1591C-----------------------------------------------
1592C D u m m y A r g u m e n t s
1593C-----------------------------------------------
1594 INTEGER ITSK, NODFTSK, NODLTSK, NUMNTSK, NDTSK,
1595 1 IPMTSK, PARTFTSK, PARTLTSK, NWAFTSK, IGMTSK,
1596 2 GREFTSK,GRELTSK
1597C-----------------------------------------------
1598C L o c a l V a r i a b l e s
1599C-----------------------------------------------
1600 INTEGER LENWA_T, OMP_GET_THREAD_NUM
1601 EXTERNAL omp_get_thread_num
1602C-----------------------------------------------
1603C S o u r c e L i n e s
1604C-----------------------------------------------
1605C
1606C Initialisation // SMP
1607C
1608 itsk = omp_get_thread_num()
1609 nodftsk = 1+itsk*numnod/ nthread
1610 nodltsk = (itsk+1)*numnod/nthread
1611 numntsk = nodltsk - nodftsk + 1
1612 ndtsk = 1 + itsk*numnod
1613 ipmtsk = 1 + itsk*npsav*npart
1614 partftsk = 1+itsk*npsav*npart/ nthread
1615 partltsk = (itsk+1)*npsav*npart/nthread
1616 lenwa_t = lenwa / nthread
1617 nwaftsk = 1+itsk*lenwa_t
1618 igmtsk = 1 + itsk*npsav*ngpe
1619 greftsk = 1+itsk*npsav*ngpe/ nthread
1620 greltsk = (itsk+1)*npsav*ngpe/nthread
1621c NWALTSK = (ITSK+1)*LENWA_T
1622c LOUT = ISPMD==0.AND.ITSK==0
1623C
1624 RETURN