OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2_imp1.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i2_imp1 (ipari, intbuf_tab, itab, nsc2, isij2, nss2, iss2, x, ms, in, weight, ikc, ndof, nddl, iddl, iadk, jdik, diag_k, lt_k, b)
subroutine i2_impm (ipari, intbuf_tab, nmc2, imij2, x, ms, in, weight, ndof, nddl, iddl, iadk, jdik, lt_k, diag_k)
subroutine i2updk0 (nsn, nmn, irect, crst, msr, nsv, irtl, ms, x, weight, itab, nsc, isi, ns, nods, ikc, ndof, nddl, iddl, iadk, jdik, diag_k, lt_k, b)
subroutine i2updkm0 (ns1, irect, crst, nsv, irtl, ns2, irect1, crst1, nsv1, irtl1, x, kdd, ndof, iddl, iadk, jdik, lt_k, diag_k)
subroutine i2updk1 (nsn, nmn, irect, dpara, msr, nsv, irtl, ms, x, weight, itab, nsc, isi, ns, nods, ikc, ndof, nddl, iddl, iadk, jdik, diag_k, lt_k, b)
subroutine updk1_ii (ndl, rj, rjt, kdd, k, bd, b)
subroutine upfr1_ii (rj, rjt, kii, k)
subroutine updk1_ij (ndi, ndj, r1j, r1jt, r2j, r2jt, kdd, kii, isym)
subroutine updk1_jj (ndi, ndj, rj, rjt, kdd, kii)
subroutine updkdd (ndl, kdd, kii, h2, isym)
subroutine updkdd1 (ndi, ndj, kdd, kii, h, isym)
subroutine updkdd2 (ndl, kdd, kii, h1, h2)
subroutine i2matc (nsn, irect, dpara, nsv, irtl, x, niri, rj, rjt)
subroutine i2updkm1 (ns1, irect, dpara, nsv, irtl, ns2, irect1, dpara1, nsv1, irtl1, x, kdd, ndof, iddl, iadk, jdik, lt_k, diag_k)
subroutine i2matcm (ii, irect, dpara, nsv, irtl, x, niri, rj, rjt)
subroutine i2_frfm1 (x, irect, dpara, nsv, irtl, a, ii)
subroutine i2_frfm0 (x, irect, crst, nsv, irtl, a, ar, ii, ndof)
subroutine i2_frup0 (x, irect, crst, nsv, irtl, ii, ndof, kss, k)
subroutine i2_frup1 (x, irect, dpara, nsv, irtl, ii, kii, kjj)
subroutine i2_impr1 (ipari, intbuf_tab, x, ndof, iddl, b)
subroutine i2updb0 (nsn, irect, crst, nsv, irtl, x, ndof, iddl, b)
subroutine i2updb1 (nsn, irect, dpara, nsv, irtl, x, ndof, iddl, b)
subroutine updb1_ii (ndl, rj, rjt, bd, b)
subroutine i2_impr2 (ipari, intbuf_tab, a, ar, x, ndof, iddl, b)
subroutine i2updb02 (nsn, irect, crst, nsv, irtl, x, ndof, iddl, b, a, ar)
subroutine i2updb12 (nsn, irect, dpara, nsv, irtl, x, ndof, iddl, b, a, ar)
subroutine i2_frk0 (irect, crst, x, itab, nsv, irtl, ikc, ndof, iddl, iddlm, iadk, jdik, diag_k, lt_k, b, a, kss, ksm, knm, krm, ii, idlm, iss, ism)
subroutine i2_frk1 (irect, dpara, x, itab, nsv, irtl, ikc, ndof, iddl, iddlm, iadk, jdik, diag_k, lt_k, b, a, kss, ksm, knm, krm, ii, idlm, iss, ism)

Function/Subroutine Documentation

◆ i2_frfm0()

subroutine i2_frfm0 ( x,
integer, dimension(4,*) irect,
crst,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
a,
ar,
integer ii,
integer, dimension(*) ndof )

Definition at line 1598 of file i2_imp1.F.

1600C-----------------------------------------------
1601C I m p l i c i t T y p e s
1602C-----------------------------------------------
1603#include "implicit_f.inc"
1604C-----------------------------------------------
1605C D u m m y A r g u m e n t s
1606C-----------------------------------------------
1607 INTEGER
1608 . IRECT(4,*), NSV(*), IRTL(*), II,NDOF(*)
1609C REAL
1610 my_real
1611 . x(3,*),a(3,*), ar(3,*), crst(2,*)
1612C-----------------------------------------------
1613C L o c a l V a r i a b l e s
1614C-----------------------------------------------
1615 INTEGER NIR, I, J, I1, J1, L, NJ,NDM
1616C REAL
1617 my_real
1618 . h(4), ss, tt, fxi, fyi, fzi,sp,sm,tp,tm,nun,
1619 . mxi, myi, mzi,xs,ys,zs,xs0,ys0,zs0
1620C-----------------------------------------------
1621 nun=-one
1622C
1623C
1624 i=nsv(ii)
1625 l=irtl(ii)
1626C
1627 ss=crst(1,ii)
1628 tt=crst(2,ii)
1629 ss = min(one,ss)
1630 tt = min(one,tt)
1631 ss = max(nun,ss)
1632 tt = max(nun,tt)
1633C
1634 fxi=a(1,i)
1635 fyi=a(2,i)
1636 fzi=a(3,i)
1637C
1638 sp=one + ss
1639 sm=one - ss
1640 tp=fourth*(one + tt)
1641 tm=fourth*(one - tt)
1642 IF (irect(3,l)==irect(4,l)) THEN
1643 nir=3
1644 tp=fourth*(one + tt)
1645 tm=fourth*(one - tt)
1646 h(1)=tm*sm
1647 h(2)=tm*sp
1648 h(3)=one-h(1)-h(2)
1649 ELSE
1650 nir=4
1651 tp=fourth*(one + tt)
1652 tm=fourth*(one - tt)
1653 h(1)=tm*sm
1654 h(2)=tm*sp
1655 h(3)=tp*sp
1656 h(4)=tp*sm
1657 ENDIF
1658 ndm = 0
1659 DO j=1,nir
1660 nj=irect(j,l)
1661 a(1,nj)=a(1,nj)+fxi*h(j)
1662 a(2,nj)=a(2,nj)+fyi*h(j)
1663 a(3,nj)=a(3,nj)+fzi*h(j)
1664 ndm = max(ndm,ndof(j))
1665 ENDDO
1666 IF(ndm==6)THEN
1667 xs0=zero
1668 ys0=zero
1669 zs0=zero
1670 DO j=1,nir
1671 nj=irect(j,l)
1672 xs0=xs0+x(1,nj)*h(j)
1673 ys0=ys0+x(2,nj)*h(j)
1674 zs0=zs0+x(3,nj)*h(j)
1675 ENDDO
1676 xs=x(1,i)-xs0
1677 ys=x(2,i)-ys0
1678 zs=x(3,i)-zs0
1679 mxi = ys * fzi - zs * fyi
1680 myi = zs * fxi - xs * fzi
1681 mzi = xs * fyi - ys * fxi
1682 DO j=1,nir
1683 nj=irect(j,l)
1684 ar(1,nj)=ar(1,nj)-mxi*h(j)
1685 ar(2,nj)=ar(2,nj)-myi*h(j)
1686 ar(3,nj)=ar(3,nj)-mzi*h(j)
1687 ENDDO
1688 ENDIF
1689C
1690 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21

◆ i2_frfm1()

subroutine i2_frfm1 ( x,
integer, dimension(4,*) irect,
dpara,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
a,
integer ii )

Definition at line 1506 of file i2_imp1.F.

1508C-----------------------------------------------
1509C I m p l i c i t T y p e s
1510C-----------------------------------------------
1511#include "implicit_f.inc"
1512C-----------------------------------------------
1513C D u m m y A r g u m e n t s
1514C-----------------------------------------------
1515 INTEGER
1516 . IRECT(4,*), NSV(*), IRTL(*),II
1517C REAL
1518 my_real
1519 . a(3,*),x(3,*),dpara(7,*)
1520C-----------------------------------------------
1521C L o c a l V a r i a b l e s
1522C-----------------------------------------------
1523 INTEGER I, J, J1,J2,J3,J4, L, JJ,NIR
1524C REAL
1525 my_real
1526 . fxs, fys, fzs,mx,my,mz,det,fx0,fy0,fz0,
1527 . x0,x1,x2,x3,x4,xs,y0,y1,y2,y3,y4,ys,z0,z1,z2,z3,z4,zs,
1528 . a1,a2,a3,b1,b2,b3,c1,c2,c3,facm,xm(4),ym(4),zm(4)
1529C-----------------------------------------------
1530 i=nsv(ii)
1531 l=irtl(ii)
1532 nir=4
1533 DO jj=1,nir
1534 j=irect(jj,l)
1535 xm(jj)=x(1,j)
1536 ym(jj)=x(2,j)
1537 zm(jj)=x(3,j)
1538 ENDDO
1539 IF(irect(3,l)==irect(4,l)) THEN
1540 nir=3
1541 xm(4)=zero
1542 ym(4)=zero
1543 zm(4)=zero
1544 ENDIF
1545 facm = one / nir
1546 x0=facm*(xm(1)+xm(2)+xm(3)+xm(4))
1547 y0=facm*(ym(1)+ym(2)+ym(3)+ym(4))
1548 z0=facm*(zm(1)+zm(2)+zm(3)+zm(4))
1549 DO j=1,nir
1550 xm(j)=xm(j)-x0
1551 ym(j)=ym(j)-y0
1552 zm(j)=zm(j)-z0
1553 ENDDO
1554 xs=x(1,i)-x0
1555 ys=x(2,i)-y0
1556 zs=x(3,i)-z0
1557C
1558 det=dpara(1,ii)
1559 b1=dpara(2,ii)
1560 b2=dpara(3,ii)
1561 b3=dpara(4,ii)
1562 c1=dpara(5,ii)
1563 c2=dpara(6,ii)
1564 c3=dpara(7,ii)
1565C
1566 fxs=a(1,i)
1567 fys=a(2,i)
1568 fzs=a(3,i)
1569 mx= ys*fzs - zs*fys
1570 my= zs*fxs - xs*fzs
1571 mz= xs*fys - ys*fxs
1572C
1573 a1=det*(mx*b1+my*c3+mz*c2)
1574 a2=det*(my*b2+mz*c1+mx*c3)
1575 a3=det*(mz*b3+mx*c2+my*c1)
1576C
1577 fx0=fxs*facm
1578 fy0=fys*facm
1579 fz0=fzs*facm
1580C------------------------------------------------------
1581C FORCES TRANSMISES AUX NOEUDS MAINS
1582C------------------------------------------------------
1583 DO jj=1,nir
1584 j=irect(jj,l)
1585 a(1,j)=a(1,j) + fx0 + a2*zm(jj) - a3*ym(jj)
1586 a(2,j)=a(2,j) + fy0 + a3*xm(jj) - a1*zm(jj)
1587 a(3,j)=a(3,j) + fz0 + a1*ym(jj) - a2*xm(jj)
1588 ENDDO
1589C
1590 RETURN

◆ i2_frk0()

subroutine i2_frk0 ( integer, dimension(4,*) irect,
crst,
x,
integer, dimension(*) itab,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
integer, dimension(*) ikc,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) iddlm,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
b,
a,
kss,
ksm,
knm,
krm,
integer ii,
integer, dimension(*) idlm,
integer iss,
integer ism )

Definition at line 2465 of file i2_imp1.F.

2470C-----------------------------------------------
2471C I m p l i c i t T y p e s
2472C-----------------------------------------------
2473#include "implicit_f.inc"
2474C-----------------------------------------------
2475C D u m m y A r g u m e n t s
2476C-----------------------------------------------
2477 INTEGER IADK(*),JDIK(*),NDOF(*),IDDL(*),IDDLM(*),IKC(*),
2478 . IRECT(4,*), NSV(*),IRTL(*),ITAB(*),II,
2479 . IDLM(*) ,ISS ,ISM
2480C REAL
2481 my_real
2482 . crst(2,*),x(3,*),diag_k(*),lt_k(*),b(*),a(3,*),
2483 . kss(6),ksm(3,3),knm(3,3,*),krm(3,3,*)
2484C-----------------------------------------------
2485C L o c a l V a r i a b l e s
2486C-----------------------------------------------
2487 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, L, JJ,
2488 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM,L1,NM1,
2489 . IR,IDM,NDOFI
2490C REAL
2491 my_real
2492 . h(4),h2(4), ss, tt, sp,sm,tp,tm,kdd(6,6),bd(6),
2493 . kii(6,6),bi(6),xs0,ys0,zs0,xs,ys,zs,xs1,ys1,zs1,nun
2494C------------------------------------
2495C VITESSES DES NOEUDS SECONDS
2496C------------------------------------
2497 nun=-one
2498 i=nsv(ii)
2499 l=irtl(ii)
2500 ndofi = 3
2501C
2502 ss=crst(1,ii)
2503 tt=crst(2,ii)
2504 ss = min(one,ss)
2505 tt = min(one,tt)
2506 ss = max(nun,ss)
2507 tt = max(nun,tt)
2508 sp=one + ss
2509 sm=one - ss
2510 IF (irect(3,l)==irect(4,l)) THEN
2511 nir=3
2512 tp=third*(one + tt)
2513 tm=third*(one - tt)
2514 h(1)=tm*sm
2515 h(2)=tm*sp
2516 h(3)=one-h(1)-h(2)
2517 ELSE
2518 nir=4
2519 tp=fourth*(one + tt)
2520 tm=fourth*(one - tt)
2521 h(1)=tm*sm
2522 h(2)=tm*sp
2523 h(3)=tp*sp
2524 h(4)=tp*sm
2525 ENDIF
2526 ndm = 0
2527 DO j=1,nir
2528 nj=irect(j,l)
2529 ndm = max(ndm,ndof(nj))
2530 ENDDO
2531C-------NDOF(M)> 3 comme rigid body---
2532 IF (ndm==6) THEN
2533 xs0=zero
2534 ys0=zero
2535 zs0=zero
2536 DO j=1,nir
2537 nj=irect(j,l)
2538 xs0=xs0+x(1,nj)*h(j)
2539 ys0=ys0+x(2,nj)*h(j)
2540 zs0=zs0+x(3,nj)*h(j)
2541 ENDDO
2542 xs=x(1,i)-xs0
2543 ys=x(2,i)-ys0
2544 zs=x(3,i)-zs0
2545 ENDIF
2546 IF (iss>0) THEN
2547C-------Update KSS(main node),B---
2548 IF (irect(3,l)==irect(4,l)) THEN
2549 h2(1)=h(1)*h(1)
2550 h2(2)=h(2)*h(2)
2551 h2(3)=h(3)*h(3)
2552 ELSE
2553 h2(1)=h(1)*h(1)
2554 h2(2)=h(2)*h(2)
2555 h2(3)=h(3)*h(3)
2556 h2(4)=h(4)*h(4)
2557 ENDIF
2558 DO k=1,ndofi
2559 bd(k)=a(k,i)
2560 kdd(k,k) = kss(k)
2561 ENDDO
2562 DO k=ndofi+1,6
2563 bd(k)=zero
2564 ENDDO
2565 kdd(1,2) = kss(4)
2566 kdd(1,3) = kss(5)
2567 kdd(2,3) = kss(6)
2568 IF (ndm==6) CALL updkb_rb(ndofi,xs,ys,zs,kdd,bd)
2569 DO j=1,nir
2570 nj=irect(j,l)
2571 nd = min(ndm,ndof(nj))
2572 CALL updkdd(nd,kdd,kii,h2(j),1)
2573 CALL put_kmii(idlm(j),iadk,diag_k,lt_k ,kii,nd)
2574 DO i1=j+1,nir
2575 nm=irect(i1,l)
2576 tm=h(j)*h(i1)
2577 nd = min(nd,ndof(nm))
2578 CALL updkdd(nd,kdd,kii,tm,0)
2579 CALL put_kmij(idlm(j) ,idlm(i1) ,iadk,jdik,lt_k,
2580 . kii,nd ,nd ,ir )
2581 IF (ir==1) CALL print_wkij(itab(nj) ,itab(nm) ,2 )
2582 ENDDO
2583 ENDDO
2584 ENDIF
2585C
2586 IF (ism>0) THEN
2587C--------no diag--Kjm=sum(KjsCsm)--
2588 DO k=1,ndofi
2589 DO j=1,ndofi
2590 kdd(k,j) = ksm(k,j)
2591 ENDDO
2592 ENDDO
2593C------- Update ---
2594 IF (ndm==6) CALL updkb_rb1(ndofi,ndofi,xs,ys,zs,kdd)
2595 DO j=1,nir
2596 nj=irect(j,l)
2597 ndi = min(ndm,ndofi)
2598 ndj = min(ndm,ndof(nj))
2599 IF (ndj>0)CALL updkdd1(ndi,ndj,kdd,kii,h(j),0)
2600 DO k=1,ndofi
2601 DO j1=1,ndofi
2602 knm(k,j1,j)=kii(j1,k)
2603 krm(k,j1,j)=kii(j1,k+ndofi)
2604 ENDDO
2605 ENDDO
2606 ENDDO
2607 ENDIF
2608C
2609 RETURN
updkdd
subroutine updkdd(ndl, kdd, kii, h2, isym)
Definition i2_imp1.F:1071
updkdd1
subroutine updkdd1(ndi, ndj, kdd, kii, h, isym)
Definition i2_imp1.F:1118
print_wkij
subroutine print_wkij(ni, nj, iflag)
Definition imp_glob_k.F:890
put_kmii
subroutine put_kmii(id, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:1186
put_kmij
subroutine put_kmij(ini, inj, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:1238
updkb_rb
subroutine updkb_rb(ndl, xs, ys, zs, kdd, bd)
Definition rby_imp0.F:324
updkb_rb1
subroutine updkb_rb1(ni, nj, xs, ys, zs, kdd)
Definition rby_imp0.F:425

◆ i2_frk1()

subroutine i2_frk1 ( integer, dimension(4,*) irect,
dpara,
x,
integer, dimension(*) itab,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
integer, dimension(*) ikc,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) iddlm,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
b,
a,
kss,
ksm,
knm,
krm,
integer ii,
integer, dimension(*) idlm,
integer iss,
integer ism )

Definition at line 2624 of file i2_imp1.F.

2629C-----------------------------------------------
2630C I m p l i c i t T y p e s
2631C-----------------------------------------------
2632#include "implicit_f.inc"
2633C-----------------------------------------------
2634C D u m m y A r g u m e n t s
2635C-----------------------------------------------
2636 INTEGER IADK(*),JDIK(*),NDOF(*),IDDL(*),IDDLM(*),IKC(*),
2637 . IRECT(4,*), NSV(*),IRTL(*),ITAB(*),II,
2638 . IDLM(*) ,ISS ,ISM
2639C REAL
2640 my_real
2641 . dpara(7,*),x(3,*),diag_k(*),lt_k(*),b(*),a(3,*),
2642 . kss(6),ksm(3,3),knm(3,3,*),krm(3,3,*)
2643C-----------------------------------------------
2644C L o c a l V a r i a b l e s
2645C-----------------------------------------------
2646 INTEGER NIR, I, J, J1, J2, J3, J4, K,L,JD, JJ,
2647 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM,L1,NM1,
2648 . NIR1,IR,IDM,ND1,NDOFI
2649C REAL
2650 my_real
2651 . xx,yy,zz,xxx,yyy,zzz,xy,yz,zx,xy2,yz2,zx2,
2652 . b1,b2,b3,c1,c2,c3,facm,
2653 . x22,y22,z22,det,xm(4),ym(4),zm(4),kdd(6,6),bd(6),
2654 . kii(6,6),bi(6),x0,y0,z0,xs,ys,zs,xs1,ys1,zs1,nun,
2655 . rj(3,3,4),rjt(3,3,4)
2656C------------------------------------
2657C VITESSES DES NOEUDS SECONDS
2658C------------------------------------
2659 i=nsv(ii)
2660 l=irtl(ii)
2661 ndofi = 3
2662C
2663 nir=4
2664 DO j=1,nir
2665 nj=irect(j,l)
2666 xm(j)=x(1,nj)
2667 ym(j)=x(2,nj)
2668 zm(j)=x(3,nj)
2669 ENDDO
2670 IF (irect(3,l)==irect(4,l)) THEN
2671 nir=3
2672 xm(4)=zero
2673 ym(4)=zero
2674 zm(4)=zero
2675 ENDIF
2676 facm = one / nir
2677 x0=facm*(xm(1)+xm(2)+xm(3)+xm(4))
2678 y0=facm*(ym(1)+ym(2)+ym(3)+ym(4))
2679 z0=facm*(zm(1)+zm(2)+zm(3)+zm(4))
2680 DO j=1,nir
2681 xm(j)=xm(j)-x0
2682 ym(j)=ym(j)-y0
2683 zm(j)=zm(j)-z0
2684 ENDDO
2685 xs=x(1,i)-x0
2686 ys=x(2,i)-y0
2687 zs=x(3,i)-z0
2688C--------cette partie est une double travail que INTTI1
2689 xx=0
2690 yy=0
2691 zz=0
2692 xy=0
2693 yz=0
2694 zx=0
2695 DO j=1,nir
2696 xx=xx+ xm(j)*xm(j)
2697 yy=yy+ ym(j)*ym(j)
2698 zz=zz+ zm(j)*zm(j)
2699 xy=xy+ xm(j)*ym(j)
2700 yz=yz+ ym(j)*zm(j)
2701 zx=zx+ zm(j)*xm(j)
2702 ENDDO
2703 zzz=xx+yy
2704 xxx=yy+zz
2705 yyy=zz+xx
2706 xy2=xy*xy
2707 yz2=yz*yz
2708 zx2=zx*zx
2709 det= xxx*yyy*zzz -xxx*yz2 -yyy*zx2 -zzz*xy2 -two*xy*yz*zx
2710 det=one/det
2711 b1=(zzz*yyy-yz2)*det
2712 b2=(xxx*zzz-zx2)*det
2713 b3=(yyy*xxx-xy2)*det
2714 c3=(zzz*xy+yz*zx)*det
2715 c1=(xxx*yz+zx*xy)*det
2716 c2=(yyy*zx+xy*yz)*det
2717 DO j=1,nir
2718 x22 = c1*xm(j)
2719 y22 = c2*ym(j)
2720 z22 = c3*zm(j)
2721C-------RJ=(R^tR)^-1Rj^t-(j=1,ndir)---
2722 rj(1,1,j)=z22-y22
2723 rj(2,1,j)=b2*zm(j)-c1*ym(j)
2724 rj(3,1,j)=c1*zm(j)-b3*ym(j)
2725 rj(1,2,j)=-b1*zm(j)+c2*xm(j)
2726 rj(2,2,j)=-z22+x22
2727 rj(3,2,j)=-c2*zm(j)+b3*xm(j)
2728 rj(1,3,j)=b1*ym(j)-c3*xm(j)
2729 rj(2,3,j)=c3*ym(j)-b2*xm(j)
2730 rj(3,3,j)=y22-x22
2731C-------RJT=1/4[I]+(Rs)RJ---
2732 DO k=1,3
2733 rjt(1,k,j)=rj(2,k,j)*zs-rj(3,k,j)*ys
2734 rjt(2,k,j)=-rj(1,k,j)*zs+rj(3,k,j)*xs
2735 rjt(3,k,j)=rj(1,k,j)*ys-rj(2,k,j)*xs
2736 ENDDO
2737 DO k=1,3
2738 rjt(k,k,j)=rjt(k,k,j)+facm
2739 ENDDO
2740 ENDDO
2741C
2742 ndm = 3
2743 IF (iss>0) THEN
2744CC-------Update KSS(main node),B---
2745 DO k=1,ndofi
2746 bd(k)=a(k,i)
2747 kdd(k,k) = kss(k)
2748 ENDDO
2749 DO k=ndofi+1,6
2750 bd(k)=zero
2751 ENDDO
2752 kdd(1,2) = kss(4)
2753 kdd(1,3) = kss(5)
2754 kdd(2,3) = kss(6)
2755 DO j=1,nir
2756 nj=irect(j,l)
2757 nd = min(ndm,ndof(nj))
2758 CALL updk1_ii(ndofi,rj(1,1,j),rjt(1,1,j),kdd,kii,bd,bi)
2759 CALL put_kmii(idlm(j),iadk,diag_k,lt_k ,kii,nd)
2760 DO i1=j+1,nir
2761 nm=irect(i1,l)
2762 nd1 = min(nd,ndof(nm))
2763 CALL updk1_ij(ndofi,ndofi,rj(1,1,j),rjt(1,1,j),
2764 1 rj(1,1,i1),rjt(1,1,i1),kdd,kii,0)
2765 CALL put_kmij(idlm(j) ,idlm(i1) ,iadk,jdik,lt_k,
2766 . kii,nd ,nd1 ,ir )
2767 IF (ir==1) CALL print_wkij(itab(nj) ,itab(nm) ,2 )
2768 ENDDO
2769 ENDDO
2770 ENDIF
2771C
2772 IF (ism>0) THEN
2773C--------no diag--Kjm=sum(KjsCsm)--
2774 DO k=1,ndofi
2775 DO j=1,ndofi
2776 kdd(k,j) = ksm(k,j)
2777 ENDDO
2778 ENDDO
2779C------- Update ---
2780 DO j=1,nir
2781 nj=irect(j,l)
2782 ndj = min(ndm,ndof(nj))
2783 IF (ndj>0)THEN
2784 CALL updk1_jj(ndofi,ndofi,rj(1,1,j),rjt(1,1,j),kdd,kii)
2785 DO k=1,ndofi
2786 DO j1=1,ndofi
2787 knm(k,j1,j)=kii(j1,k)
2788 krm(k,j1,j)=kii(j1,k+ndofi)
2789 ENDDO
2790 ENDDO
2791 ENDIF
2792 ENDDO
2793 ENDIF
2794C
2795 RETURN
updk1_ii
subroutine updk1_ii(ndl, rj, rjt, kdd, k, bd, b)
Definition i2_imp1.F:789
updk1_ij
subroutine updk1_ij(ndi, ndj, r1j, r1jt, r2j, r2jt, kdd, kii, isym)
Definition i2_imp1.F:908
updk1_jj
subroutine updk1_jj(ndi, ndj, rj, rjt, kdd, kii)
Definition i2_imp1.F:1001

◆ i2_frup0()

subroutine i2_frup0 ( x,
integer, dimension(4,*) irect,
crst,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
integer ii,
integer, dimension(*) ndof,
kss,
k )

Definition at line 1700 of file i2_imp1.F.

1702C-----------------------------------------------
1703C I m p l i c i t T y p e s
1704C-----------------------------------------------
1705#include "implicit_f.inc"
1706C-----------------------------------------------
1707C D u m m y A r g u m e n t s
1708C-----------------------------------------------
1709 INTEGER
1710 . IRECT(4,*), NSV(*), IRTL(*), II,NDOF(*)
1711C REAL
1712 my_real
1713 . x(3,*),kss(6),k(6,4), crst(2,*)
1714C-----------------------------------------------
1715C L o c a l V a r i a b l e s
1716C-----------------------------------------------
1717 INTEGER NIR, I, J, JD, L, JJ,NJ,ND
1718C REAL
1719 my_real
1720 . h(4), ss, tt, sp,sm,tp,tm,k0(6),xs,ys,zs,
1721 . xs0,ys0,zs0,h2
1722C-----------------------------------------------
1723 nir=4
1724 i=nsv(ii)
1725 l=irtl(ii)
1726C
1727 ss=crst(1,ii)
1728 tt=crst(2,ii)
1729 sp=one + ss
1730 sm=one - ss
1731 IF(irect(3,l)==irect(4,l)) THEN
1732 nir = 3
1733 tp=fourth*(one + tt)
1734 tm=fourth*(one - tt)
1735 h(1)=tm*sm
1736 h(2)=tm*sp
1737 h(3)=one-h(1)-h(2)
1738 ELSE
1739 tp=fourth*(one + tt)
1740 tm=fourth*(one - tt)
1741 h(1)=tm*sm
1742 h(2)=tm*sp
1743 h(3)=tp*sp
1744 h(4)=tp*sm
1745 ENDIF
1746 nd = 0
1747 DO j=1,nir
1748 nj=irect(j,l)
1749 nd = max(nd,ndof(nj))
1750 ENDDO
1751C-------NDOF(M)> 3 comme rigid body---
1752 IF (nd==6) THEN
1753 xs0=zero
1754 ys0=zero
1755 zs0=zero
1756 DO j=1,nir
1757 nj=irect(j,l)
1758 xs0=xs0+x(1,nj)*h(j)
1759 ys0=ys0+x(2,nj)*h(j)
1760 zs0=zs0+x(3,nj)*h(j)
1761 ENDDO
1762 xs=x(1,i)-xs0
1763 ys=x(2,i)-ys0
1764 zs=x(3,i)-zs0
1765 CALL updfr_rb(xs,ys,zs,kss,k0)
1766 ELSE
1767 DO jj =1,3
1768 k0(jj)=kss(jj)
1769 ENDDO
1770 ENDIF
1771C-------Update K(main node),B---
1772 DO j=1,nir
1773 nj=irect(j,l)
1774 h2=h(j)*h(j)
1775 DO jj =1,ndof(nj)
1776 k(jj,j)=k(jj,j)+h2*k0(jj)
1777 ENDDO
1778 ENDDO
1779C
1780 RETURN
updfr_rb
subroutine updfr_rb(xs, ys, zs, kii, k)
Definition rby_imp0.F:652

◆ i2_frup1()

subroutine i2_frup1 ( x,
integer, dimension(4,*) irect,
dpara,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
integer ii,
kii,
kjj )

Definition at line 1790 of file i2_imp1.F.

1792C-----------------------------------------------
1793C I m p l i c i t T y p e s
1794C-----------------------------------------------
1795#include "implicit_f.inc"
1796C-----------------------------------------------
1797C D u m m y A r g u m e n t s
1798C-----------------------------------------------
1799 INTEGER
1800 . IRECT(4,*), NSV(*), IRTL(*),II
1801C REAL
1802 my_real
1803 . x(3,*),kii(6),kjj(6,4),dpara(7,*)
1804C-----------------------------------------------
1805C L o c a l V a r i a b l e s
1806C-----------------------------------------------
1807 INTEGER I, J, L, JJ,NJ,K,NIR
1808C REAL
1809 my_real
1810 . rj(3,3,4),rjt(3,3,4),
1811 . b1,b2,b3,c1,c2,c3,facm,
1812 . x22,y22,z22,det,xm(4),ym(4),zm(4),x0,y0,z0
1813 my_real
1814 . xs,ys,zs
1815C-----------------------------------------------
1816C
1817 i=nsv(ii)
1818 l=irtl(ii)
1819 nir=4
1820 DO j=1,nir
1821 nj=irect(j,l)
1822 xm(j)=x(1,nj)
1823 ym(j)=x(2,nj)
1824 zm(j)=x(3,nj)
1825 ENDDO
1826 IF(irect(3,l)==irect(4,l)) THEN
1827 nir=3
1828 xm(4)=zero
1829 ym(4)=zero
1830 zm(4)=zero
1831 ENDIF
1832 facm = one / nir
1833C----------------------------------------------------
1834C VITESSE DE ROTATION MOYENNE DU SEGMENT MAIN
1835C----------------------------------------------------
1836 x0=facm*(xm(1)+xm(2)+xm(3)+xm(4))
1837 y0=facm*(ym(1)+ym(2)+ym(3)+ym(4))
1838 z0=facm*(zm(1)+zm(2)+zm(3)+zm(4))
1839 DO j=1,nir
1840 xm(j)=xm(j)-x0
1841 ym(j)=ym(j)-y0
1842 zm(j)=zm(j)-z0
1843 ENDDO
1844 xs=x(1,i)-x0
1845 ys=x(2,i)-y0
1846 zs=x(3,i)-z0
1847 det= dpara(1,ii)
1848 b1=dpara(2,ii)
1849 b2=dpara(3,ii)
1850 b3=dpara(4,ii)
1851 c1=dpara(5,ii)
1852 c2=dpara(6,ii)
1853 c3=dpara(7,ii)
1854 DO j=1,nir
1855 x22 = c1*xm(j)
1856 y22 = c2*ym(j)
1857 z22 = c3*zm(j)
1858C-------RJ=(R^tR)^-1Rj^t-(j=1,ndir)---
1859 rj(1,1,j)=z22-y22
1860 rj(2,1,j)=b2*zm(j)-c1*ym(j)
1861 rj(3,1,j)=c1*zm(j)-b3*ym(j)
1862 rj(1,2,j)=-b1*zm(j)+c2*xm(j)
1863 rj(2,2,j)=-z22+x22
1864 rj(3,2,j)=-c2*zm(j)+b3*xm(j)
1865 rj(1,3,j)=b1*ym(j)-c3*xm(j)
1866 rj(2,3,j)=c3*ym(j)-b2*xm(j)
1867 rj(3,3,j)=y22-x22
1868C-------RJT=1/4[I]+(Rs)RJ---
1869 DO k=1,3
1870 rjt(1,k,j)=rj(2,k,j)*zs-rj(3,k,j)*ys
1871 rjt(2,k,j)=-rj(1,k,j)*zs+rj(3,k,j)*xs
1872 rjt(3,k,j)=rj(1,k,j)*ys-rj(2,k,j)*xs
1873 ENDDO
1874 DO k=1,3
1875 rjt(k,k,j)=rjt(k,k,j)+facm
1876 ENDDO
1877 ENDDO
1878C
1879 DO j=1,nir
1880 nj=irect(j,l)
1881 CALL upfr1_ii(rj(1,1,j),rjt(1,1,j),kii,kjj(1,j))
1882 ENDDO
1883C
1884 RETURN
upfr1_ii
subroutine upfr1_ii(rj, rjt, kii, k)
Definition i2_imp1.F:858

◆ i2_imp1()

subroutine i2_imp1 ( integer, dimension(*) ipari,
type(intbuf_struct_) intbuf_tab,
integer, dimension(*) itab,
integer nsc2,
integer, dimension(*) isij2,
integer, dimension(*) nss2,
integer, dimension(*) iss2,
x,
ms,
in,
integer, dimension(*) weight,
integer, dimension(*) ikc,
integer, dimension(*) ndof,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
b )

Definition at line 34 of file i2_imp1.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE intbufdef_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER IPARI(*), WEIGHT(*),
51 . NSC2,ISIJ2(*),NSS2(*),ISS2(*),ITAB(*)
52 INTEGER NDDL,IADK(*),JDIK(*),NDOF(*),IDDL(*),IKC(*)
53C REAL
54 my_real
55 . x(*),ms(*),in(*),diag_k(*),lt_k(*),b(*)
56
57 TYPE(INTBUF_STRUCT_) INTBUF_TAB
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "param_c.inc"
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 integer
66 . k10, k11, k12, k13, k14, kfi, j10, j11, j12, j21, j22,
67 . jfi,nsn,nmn,nrts,nrtm,ilev
68C-----------------------------------------------
69 nrts =ipari(3)
70 nrtm =ipari(4)
71 nsn =ipari(5)
72 nmn =ipari(6)
73 ilev =ipari(20)
74C
75 k10=1
76 k11=k10+4*nrts
77 k12=k11+4*nrtm
78 k13=k12+nsn
79 k14=k13+nmn
80 kfi=k14+nsn
81 j10=1
82 j11=j10+1
83 j12=j11+nparir
84 j21=j12+2*nsn
85 j22=j21+7*nsn
86 jfi=j22+nmn
87C version spmd avec plus d'un proc nsn = nsn_loc & nmn = nmn_loc
88 IF(ilev==1)THEN
89 CALL i2updk1(nsn ,nmn ,intbuf_tab%IRECTM,
90 1 intbuf_tab%DPARA,intbuf_tab%MSR,intbuf_tab%NSV,intbuf_tab%IRTLM,
91 2 ms ,x ,weight ,itab ,
92 3 nsc2 ,isij2 ,nss2 ,iss2 ,
93 4 ikc ,ndof ,nddl,iddl ,iadk ,
94 5 jdik ,diag_k ,lt_k ,b)
95 ELSE
96 CALL i2updk0(nsn ,nmn ,intbuf_tab%IRECTM,
97 1 intbuf_tab%CSTS,intbuf_tab%MSR,intbuf_tab%NSV,intbuf_tab%IRTLM,
98 2 ms ,x ,weight ,itab ,
99 3 nsc2 ,isij2 ,nss2 ,iss2 ,
100 4 ikc ,ndof ,nddl,iddl ,iadk ,
101 5 jdik ,diag_k ,lt_k ,b)
102 ENDIF
103C
104 RETURN
i2updk0
subroutine i2updk0(nsn, nmn, irect, crst, msr, nsv, irtl, ms, x, weight, itab, nsc, isi, ns, nods, ikc, ndof, nddl, iddl, iadk, jdik, diag_k, lt_k, b)
Definition i2_imp1.F:225
i2updk1
subroutine i2updk1(nsn, nmn, irect, dpara, msr, nsv, irtl, ms, x, weight, itab, nsc, isi, ns, nods, ikc, ndof, nddl, iddl, iadk, jdik, diag_k, lt_k, b)
Definition i2_imp1.F:625

◆ i2_impm()

subroutine i2_impm ( integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer nmc2,
integer, dimension(4,*) imij2,
x,
ms,
in,
integer, dimension(*) weight,
integer, dimension(*) ndof,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
lt_k,
diag_k )

Definition at line 117 of file i2_imp1.F.

121C-----------------------------------------------
122C M o d u l e s
123C-----------------------------------------------
124 USE intbufdef_mod
125C-----------------------------------------------
126C I m p l i c i t T y p e s
127C-----------------------------------------------
128#include "implicit_f.inc"
129C-----------------------------------------------
130C C o m m o n B l o c k s
131C-----------------------------------------------
132#include "param_c.inc"
133C-----------------------------------------------
134C D u m m y A r g u m e n t s
135C-----------------------------------------------
136 INTEGER IPARI(NPARI,*), WEIGHT(*),
137 . NMC2,IMIJ2(4,*)
138 INTEGER NDDL,IADK(*),JDIK(*),NDOF(*),IDDL(*)
139C REAL
140 my_real
141 . x(*),ms(*),in(*),lt_k(*),diag_k(*)
142
143 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
144C-----------------------------------------------
145C L o c a l V a r i a b l e s
146C-----------------------------------------------
147 integer
148 . k10, k11, k12, k13, k14, kfi, j10, j11, j12, j21, j22,
149 . l10, l11, l12, l13, l14, lfi, m10, m11, m12, m21, m22,
150 . ji,jfi,ji1,nsn,nsn1,ilev,n1,n2,ns1,ns2,ni,nj,i,ir
151 my_real
152 . kdd(6,6)
153C-----------------------------------------------
154 DO i=1,nmc2
155 n1=imij2(1,i)
156 n2=imij2(2,i)
157 ns1=imij2(3,i)
158 ns2=imij2(4,i)
159 nsn = ipari(5,n1)
160 ji=ipari(1,n1)
161 k10=ji
162 k11=k10+4*ipari(3,n1)
163 k12=k11+4*ipari(4,n1)
164 k13=k12+nsn
165 k14=k13+ipari(6,n1)
166 ni=intbuf_tab(n1)%NSV(ns1)
167 j10=ipari(2,n1)
168 j11=j10+1
169 j12=j11+nparir
170 j21=j12+2*nsn
171 nsn1 = ipari(5,n2)
172 ji1=ipari(1,n2)
173 l10=ji1
174 l11=l10+4*ipari(3,n2)
175 l12=l11+4*ipari(4,n2)
176 l13=l12+nsn1
177 l14=l13+ipari(6,n2)
178 nj=intbuf_tab(n2)%IRECTM(ns2)
179 m10=ipari(2,n2)
180 m11=m10+1
181 m12=m11+nparir
182 m21=m12+2*nsn1
183C------supposant ILEV est le meme pour NI,NJ---
184 ilev =ipari(20,n1)
185 IF (ndof(ni)>0.AND.ndof(nj)>0) THEN
186 CALL get_kij(ni,nj,iddl,iadk,jdik,lt_k,kdd,ndof(ni),ndof(nj),ir)
187 IF(ilev==1)THEN
188 CALL i2updkm1(ns1,intbuf_tab(n1)%IRECTM,intbuf_tab(n1)%DPARA,intbuf_tab(n1)%NSV,intbuf_tab(n1)%IRTLM,
189 . ns2,intbuf_tab(n2)%IRECTM,intbuf_tab(n2)%DPARA,intbuf_tab(n2)%NSV,intbuf_tab(n2)%IRTLM,
190 . x ,kdd ,ndof ,iddl ,iadk ,
191 . jdik,lt_k ,diag_k )
192 ELSE
193 CALL i2updkm0(ns1,intbuf_tab(n1)%IRECTM,intbuf_tab(n1)%CSTS,intbuf_tab(n1)%NSV,intbuf_tab(n1)%IRTLM,
194 . ns2,intbuf_tab(n2)%IRECTM,intbuf_tab(n2)%CSTS,intbuf_tab(n2)%NSV,intbuf_tab(n2)%IRTLM,
195 . x ,kdd ,ndof ,iddl ,iadk ,
196 . jdik,lt_k ,diag_k )
197 ENDIF
198 ENDIF
199 ENDDO
200C
201 RETURN
i2updkm0
subroutine i2updkm0(ns1, irect, crst, nsv, irtl, ns2, irect1, crst1, nsv1, irtl1, x, kdd, ndof, iddl, iadk, jdik, lt_k, diag_k)
Definition i2_imp1.F:476
i2updkm1
subroutine i2updkm1(ns1, irect, dpara, nsv, irtl, ns2, irect1, dpara1, nsv1, irtl1, x, kdd, ndof, iddl, iadk, jdik, lt_k, diag_k)
Definition i2_imp1.F:1334
get_kij
subroutine get_kij(ni, nj, iddl, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:713

◆ i2_impr1()

subroutine i2_impr1 ( integer, dimension(*) ipari,
type(intbuf_struct_) intbuf_tab,
x,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
b )

Definition at line 1899 of file i2_imp1.F.

1901C-----------------------------------------------
1902C M o d u l e s
1903C-----------------------------------------------
1904 USE intbufdef_mod
1905C-----------------------------------------------
1906C I m p l i c i t T y p e s
1907C-----------------------------------------------
1908#include "implicit_f.inc"
1909C-----------------------------------------------
1910C D u m m y A r g u m e n t s
1911C-----------------------------------------------
1912 INTEGER IPARI(*)
1913 INTEGER NDOF(*),IDDL(*)
1914C REAL
1915 my_real
1916 . x(*),b(*)
1917 TYPE(INTBUF_STRUCT_) INTBUF_TAB
1918C-----------------------------------------------
1919C C o m m o n B l o c k s
1920C-----------------------------------------------
1921#include "param_c.inc"
1922C-----------------------------------------------
1923C L o c a l V a r i a b l e s
1924C-----------------------------------------------
1925 integer
1926 . k10, k11, k12, k13, k14, kfi, j10, j11, j12, j21, j22,
1927 . jfi,nsn,nmn,nrts,nrtm,ilev
1928C-----------------------------------------------
1929 nrts =ipari(3)
1930 nrtm =ipari(4)
1931 nsn =ipari(5)
1932 nmn =ipari(6)
1933 ilev =ipari(20)
1934C
1935 k10=1
1936 k11=k10+4*nrts
1937 k12=k11+4*nrtm
1938 k13=k12+nsn
1939 k14=k13+nmn
1940 kfi=k14+nsn
1941 j10=1
1942 j11=j10+1
1943 j12=j11+nparir
1944 j21=j12+2*nsn
1945 j22=j21+7*nsn
1946 jfi=j22+nmn
1947C
1948 IF(ilev==1)THEN
1949 CALL i2updb1(nsn ,intbuf_tab%IRECTM,intbuf_tab%DPARA,
1950 1 intbuf_tab%NSV,intbuf_tab%IRTLM,x ,ndof ,iddl ,
1951 2 b )
1952 ELSE
1953 CALL i2updb0(nsn ,intbuf_tab%IRECTM,intbuf_tab%CSTS,
1954 1 intbuf_tab%NSV,intbuf_tab%IRTLM,x ,ndof ,iddl ,
1955 2 b )
1956 ENDIF
1957C
1958 RETURN
i2updb0
subroutine i2updb0(nsn, irect, crst, nsv, irtl, x, ndof, iddl, b)
Definition i2_imp1.F:1969
i2updb1
subroutine i2updb1(nsn, irect, dpara, nsv, irtl, x, ndof, iddl, b)
Definition i2_imp1.F:2078

◆ i2_impr2()

subroutine i2_impr2 ( integer, dimension(*) ipari,
type(intbuf_struct_) intbuf_tab,
a,
ar,
x,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
b )

Definition at line 2181 of file i2_imp1.F.

2183C-----------------------------------------------
2184C M o d u l e s
2185C-----------------------------------------------
2186 USE intbufdef_mod
2187C-----------------------------------------------
2188C I m p l i c i t T y p e s
2189C-----------------------------------------------
2190#include "implicit_f.inc"
2191C-----------------------------------------------
2192C D u m m y A r g u m e n t s
2193C-----------------------------------------------
2194 INTEGER IPARI(*)
2195 INTEGER NDOF(*),IDDL(*)
2196C REAL
2197 my_real
2198 . x(*),b(*),a(*),ar(*)
2199 TYPE(INTBUF_STRUCT_) INTBUF_TAB
2200C-----------------------------------------------
2201C C o m m o n B l o c k s
2202C-----------------------------------------------
2203#include "param_c.inc"
2204C-----------------------------------------------
2205C L o c a l V a r i a b l e s
2206C-----------------------------------------------
2207 integer
2208 . k10, k11, k12, k13, k14, kfi, j10, j11, j12, j21, j22,
2209 . jfi,nsn,nmn,nrts,nrtm,ilev
2210C-----------------------------------------------
2211 nrts =ipari(3)
2212 nrtm =ipari(4)
2213 nsn =ipari(5)
2214 nmn =ipari(6)
2215 ilev =ipari(20)
2216C
2217 k10=1
2218 k11=k10+4*nrts
2219 k12=k11+4*nrtm
2220 k13=k12+nsn
2221 k14=k13+nmn
2222 kfi=k14+nsn
2223 j10=1
2224 j11=j10+1
2225 j12=j11+nparir
2226 j21=j12+2*nsn
2227 j22=j21+7*nsn
2228 jfi=j22+nmn
2229C
2230 IF(ilev==1)THEN
2231 CALL i2updb12(nsn ,intbuf_tab%IRECTM,intbuf_tab%DPARA,
2232 1 intbuf_tab%NSV,intbuf_tab%IRTLM,x ,ndof ,iddl ,
2233 2 b ,a ,ar )
2234 ELSE
2235 CALL i2updb02(nsn ,intbuf_tab%IRECTM,intbuf_tab%CSTS,
2236 1 intbuf_tab%NSV,intbuf_tab%IRTLM,x ,ndof ,iddl ,
2237 2 b ,a ,ar )
2238 ENDIF
2239C
2240 RETURN
i2updb02
subroutine i2updb02(nsn, irect, crst, nsv, irtl, x, ndof, iddl, b, a, ar)
Definition i2_imp1.F:2251
i2updb12
subroutine i2updb12(nsn, irect, dpara, nsv, irtl, x, ndof, iddl, b, a, ar)
Definition i2_imp1.F:2379

◆ i2matc()

subroutine i2matc ( integer nsn,
integer, dimension(4,*) irect,
dpara,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
x,
integer, dimension(*) niri,
rj,
rjt )

Definition at line 1197 of file i2_imp1.F.

1199C-----------------------------------------------
1200C I m p l i c i t T y p e s
1201C-----------------------------------------------
1202#include "implicit_f.inc"
1203C-----------------------------------------------
1204C D u m m y A r g u m e n t s
1205C-----------------------------------------------
1206 INTEGER NSN, IRECT(4,*), NSV(*), IRTL(*),NIRI(*)
1207C REAL
1208 my_real
1209 . dpara(7,*),x(3,*),rj(3,3,4,nsn),rjt(3,3,4,nsn)
1210C-----------------------------------------------
1211C L o c a l V a r i a b l e s
1212C-----------------------------------------------
1213 INTEGER I, J, II, L, JJ,NJ,K,NIR
1214C REAL
1215 my_real
1216 . xx,yy,zz,xxx,yyy,zzz,xy,yz,zx,xy2,yz2,zx2,
1217 . b1,b2,b3,c1,c2,c3,facm,
1218 . x22,y22,z22,det,xm(4),ym(4),zm(4),x0,y0,z0
1219 my_real
1220 . xs,ys,zs
1221C------------------------------------
1222C MATRICE DE JACOBIEN [C]
1223C------------------------------------
1224 DO ii=1,nsn
1225 i=nsv(ii)
1226 l=irtl(ii)
1227 nir=4
1228 DO j=1,nir
1229 nj=irect(j,l)
1230 xm(j)=x(1,nj)
1231 ym(j)=x(2,nj)
1232 zm(j)=x(3,nj)
1233 ENDDO
1234 IF(irect(3,l)==irect(4,l)) THEN
1235 nir=3
1236 xm(4)=zero
1237 ym(4)=zero
1238 zm(4)=zero
1239 ENDIF
1240 facm = one / nir
1241C----------------------------------------------------
1242C VITESSE DE ROTATION MOYENNE DU SEGMENT MAIN
1243C----------------------------------------------------
1244 x0=facm*(xm(1)+xm(2)+xm(3)+xm(4))
1245 y0=facm*(ym(1)+ym(2)+ym(3)+ym(4))
1246 z0=facm*(zm(1)+zm(2)+zm(3)+zm(4))
1247 DO j=1,nir
1248 xm(j)=xm(j)-x0
1249 ym(j)=ym(j)-y0
1250 zm(j)=zm(j)-z0
1251 ENDDO
1252 xs=x(1,i)-x0
1253 ys=x(2,i)-y0
1254 zs=x(3,i)-z0
1255C--------cette partie est une double travail que INTTI1
1256 xx=0
1257 yy=0
1258 zz=0
1259 xy=0
1260 yz=0
1261 zx=0
1262 DO j=1,nir
1263 xx=xx+ xm(j)*xm(j)
1264 yy=yy+ ym(j)*ym(j)
1265 zz=zz+ zm(j)*zm(j)
1266 xy=xy+ xm(j)*ym(j)
1267 yz=yz+ ym(j)*zm(j)
1268 zx=zx+ zm(j)*xm(j)
1269 ENDDO
1270 zzz=xx+yy
1271 xxx=yy+zz
1272 yyy=zz+xx
1273 xy2=xy*xy
1274 yz2=yz*yz
1275 zx2=zx*zx
1276 det= xxx*yyy*zzz -xxx*yz2 -yyy*zx2 -zzz*xy2 -two*xy*yz*zx
1277 det=one/det
1278 b1=(zzz*yyy-yz2)*det
1279 b2=(xxx*zzz-zx2)*det
1280 b3=(yyy*xxx-xy2)*det
1281 c3=(zzz*xy+yz*zx)*det
1282 c1=(xxx*yz+zx*xy)*det
1283 c2=(yyy*zx+xy*yz)*det
1284c DET= DPARA(1,II)
1285c B1=DPARA(2,II)
1286c B2=DPARA(3,II)
1287c B3=DPARA(4,II)
1288c C1=DPARA(5,II)
1289c C2=DPARA(6,II)
1290c C3=DPARA(7,II)
1291 DO j=1,nir
1292 x22 = c1*xm(j)
1293 y22 = c2*ym(j)
1294 z22 = c3*zm(j)
1295C-------RJ=(R^tR)^-1Rj^t-(j=1,ndir)---
1296 rj(1,1,j,ii)=z22-y22
1297 rj(2,1,j,ii)=b2*zm(j)-c1*ym(j)
1298 rj(3,1,j,ii)=c1*zm(j)-b3*ym(j)
1299 rj(1,2,j,ii)=-b1*zm(j)+c2*xm(j)
1300 rj(2,2,j,ii)=-z22+x22
1301 rj(3,2,j,ii)=-c2*zm(j)+b3*xm(j)
1302 rj(1,3,j,ii)=b1*ym(j)-c3*xm(j)
1303 rj(2,3,j,ii)=c3*ym(j)-b2*xm(j)
1304 rj(3,3,j,ii)=y22-x22
1305C-------RJT=1/4[I]+(Rs)RJ---
1306 DO k=1,3
1307 rjt(1,k,j,ii)=rj(2,k,j,ii)*zs-rj(3,k,j,ii)*ys
1308 rjt(2,k,j,ii)=-rj(1,k,j,ii)*zs+rj(3,k,j,ii)*xs
1309 rjt(3,k,j,ii)=rj(1,k,j,ii)*ys-rj(2,k,j,ii)*xs
1310 ENDDO
1311 DO k=1,3
1312 rjt(k,k,j,ii)=rjt(k,k,j,ii)+facm
1313 ENDDO
1314 ENDDO
1315 niri(ii)=nir
1316 ENDDO
1317C
1318 RETURN

◆ i2matcm()

subroutine i2matcm ( integer ii,
integer, dimension(4,*) irect,
dpara,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
x,
integer niri,
rj,
rjt )

Definition at line 1386 of file i2_imp1.F.

1388C-----------------------------------------------
1389C I m p l i c i t T y p e s
1390C-----------------------------------------------
1391#include "implicit_f.inc"
1392C-----------------------------------------------
1393C D u m m y A r g u m e n t s
1394C-----------------------------------------------
1395 INTEGER IRECT(4,*), NSV(*), IRTL(*),NIRI
1396C REAL
1397 my_real
1398 . dpara(7,*),x(3,*),rj(3,3,4),rjt(3,3,4)
1399C-----------------------------------------------
1400C L o c a l V a r i a b l e s
1401C-----------------------------------------------
1402 INTEGER I, J, II, L, JJ,NJ,K,NIR
1403C REAL
1404 my_real
1405 . xx,yy,zz,xxx,yyy,zzz,xy,yz,zx,xy2,yz2,zx2,
1406 . b1,b2,b3,c1,c2,c3,facm,
1407 . x22,y22,z22,det,xm(4),ym(4),zm(4),x0,y0,z0
1408 my_real
1409 . xs,ys,zs
1410C------------------------------------
1411C MATRICE DE JACOBIEN [C]
1412C------------------------------------
1413 i=nsv(ii)
1414 l=irtl(ii)
1415 nir=4
1416 DO j=1,nir
1417 nj=irect(j,l)
1418 xm(j)=x(1,nj)
1419 ym(j)=x(2,nj)
1420 zm(j)=x(3,nj)
1421 ENDDO
1422 IF(irect(3,l)==irect(4,l)) THEN
1423 nir=3
1424 xm(4)=zero
1425 ym(4)=zero
1426 zm(4)=zero
1427 ENDIF
1428 facm = one / nir
1429C----------------------------------------------------
1430C VITESSE DE ROTATION MOYENNE DU SEGMENT MAIN
1431C----------------------------------------------------
1432 x0=facm*(xm(1)+xm(2)+xm(3)+xm(4))
1433 y0=facm*(ym(1)+ym(2)+ym(3)+ym(4))
1434 z0=facm*(zm(1)+zm(2)+zm(3)+zm(4))
1435 DO j=1,nir
1436 xm(j)=xm(j)-x0
1437 ym(j)=ym(j)-y0
1438 zm(j)=zm(j)-z0
1439 ENDDO
1440 xs=x(1,i)-x0
1441 ys=x(2,i)-y0
1442 zs=x(3,i)-z0
1443C--------cette partie est une double travail que INTTI1
1444 xx=0
1445 yy=0
1446 zz=0
1447 xy=0
1448 yz=0
1449 zx=0
1450 DO j=1,nir
1451 xx=xx+ xm(j)*xm(j)
1452 yy=yy+ ym(j)*ym(j)
1453 zz=zz+ zm(j)*zm(j)
1454 xy=xy+ xm(j)*ym(j)
1455 yz=yz+ ym(j)*zm(j)
1456 zx=zx+ zm(j)*xm(j)
1457 ENDDO
1458 zzz=xx+yy
1459 xxx=yy+zz
1460 yyy=zz+xx
1461 xy2=xy*xy
1462 yz2=yz*yz
1463 zx2=zx*zx
1464 det= xxx*yyy*zzz -xxx*yz2 -yyy*zx2 -zzz*xy2 -two*xy*yz*zx
1465 det=one/det
1466 b1=(zzz*yyy-yz2)*det
1467 b2=(xxx*zzz-zx2)*det
1468 b3=(yyy*xxx-xy2)*det
1469 c3=(zzz*xy+yz*zx)*det
1470 c1=(xxx*yz+zx*xy)*det
1471 c2=(yyy*zx+xy*yz)*det
1472 DO j=1,nir
1473 x22 = c1*xm(j)
1474 y22 = c2*ym(j)
1475 z22 = c3*zm(j)
1476C-------RJ=(R^tR)^-1Rj^t-(j=1,ndir)---
1477 rj(1,1,j)=z22-y22
1478 rj(2,1,j)=b2*zm(j)-c1*ym(j)
1479 rj(3,1,j)=c1*zm(j)-b3*ym(j)
1480 rj(1,2,j)=-b1*zm(j)+c2*xm(j)
1481 rj(2,2,j)=-z22+x22
1482 rj(3,2,j)=-c2*zm(j)+b3*xm(j)
1483 rj(1,3,j)=b1*ym(j)-c3*xm(j)
1484 rj(2,3,j)=c3*ym(j)-b2*xm(j)
1485 rj(3,3,j)=y22-x22
1486C-------RJT=1/4[I]+(Rs)RJ---
1487 DO k=1,3
1488 rjt(1,k,j)=rj(2,k,j)*zs-rj(3,k,j)*ys
1489 rjt(2,k,j)=-rj(1,k,j)*zs+rj(3,k,j)*xs
1490 rjt(3,k,j)=rj(1,k,j)*ys-rj(2,k,j)*xs
1491 ENDDO
1492 DO k=1,3
1493 rjt(k,k,j)=rjt(k,k,j)+facm
1494 ENDDO
1495 ENDDO
1496 niri=nir
1497C
1498 RETURN

◆ i2updb0()

subroutine i2updb0 ( integer nsn,
integer, dimension(4,*) irect,
crst,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
x,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
b )

Definition at line 1967 of file i2_imp1.F.

1969C-----------------------------------------------
1970C I m p l i c i t T y p e s
1971C-----------------------------------------------
1972#include "implicit_f.inc"
1973C-----------------------------------------------
1974C D u m m y A r g u m e n t s
1975C-----------------------------------------------
1976 INTEGER NSN, IRECT(4,*), NSV(*), IRTL(*)
1977 INTEGER NDOF(*),IDDL(*)
1978C REAL
1979 my_real
1980 . crst(2,*),x(3,*),b(*)
1981C-----------------------------------------------
1982C L o c a l V a r i a b l e s
1983C-----------------------------------------------
1984 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
1985 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM
1986C REAL
1987 my_real
1988 . h(4),ss, tt, sp,sm,tp,tm,bd(6),
1989 . bi(6),xs0,ys0,zs0,xs,ys,zs,nun
1990C------------------------------------
1991C VITESSES DES NOEUDS SECONDS
1992C------------------------------------
1993C-------pour simplement etre coherent avec INTTI2, on ne distinque pas 3n,4n
1994C-------on est oblige de distinque quand meme, sinon la matrice n'est plus positive
1995 nun=-one
1996 j1=0
1997 DO ii=1,nsn
1998 i=nsv(ii)
1999 l=irtl(ii)
2000 IF (ndof(i)>0) THEN
2001 DO k=1,ndof(i)
2002 id = iddl(i)+k
2003 bd(k)=b(id)
2004 ENDDO
2005 DO k=ndof(i)+1,6
2006 bd(k)=zero
2007 ENDDO
2008C
2009 ss=crst(1,ii)
2010 tt=crst(2,ii)
2011 ss = min(one,ss)
2012 tt = min(one,tt)
2013 ss = max(nun,ss)
2014 tt = max(nun,tt)
2015 sp=one + ss
2016 sm=one - ss
2017 IF (irect(3,l)==irect(4,l)) THEN
2018 nir=3
2019 tp=fourth*(one + tt)
2020 tm=fourth*(one - tt)
2021 h(1)=tm*sm
2022 h(2)=tm*sp
2023 h(3)=one-h(1)-h(2)
2024 ELSE
2025 nir=4
2026 tp=fourth*(one + tt)
2027 tm=fourth*(one - tt)
2028 h(1)=tm*sm
2029 h(2)=tm*sp
2030 h(3)=tp*sp
2031 h(4)=tp*sm
2032 ENDIF
2033 ndm = 0
2034 DO j=1,nir
2035 nj=irect(j,l)
2036 ndm = max(ndm,ndof(nj))
2037 ENDDO
2038C-------NDOF(M)> 3 comme rigid body---
2039 IF (ndm==6) THEN
2040 xs0=zero
2041 ys0=zero
2042 zs0=zero
2043 DO j=1,nir
2044 nj=irect(j,l)
2045 xs0=xs0+x(1,nj)*h(j)
2046 ys0=ys0+x(2,nj)*h(j)
2047 zs0=zs0+x(3,nj)*h(j)
2048 ENDDO
2049 xs=x(1,i)-xs0
2050 ys=x(2,i)-ys0
2051 zs=x(3,i)-zs0
2052 CALL updb_rb(ndof(i),xs,ys,zs,bd)
2053 ENDIF
2054CC-------Update B---
2055 DO j=1,nir
2056 nj=irect(j,l)
2057 nd = min(ndm,ndof(nj))
2058 DO k=1,nd
2059 id = iddl(nj)+k
2060 b(id) = b(id) + h(j)*bd(k)
2061 ENDDO
2062 ENDDO
2063 ENDIF
2064 ENDDO
2065C
2066 RETURN
id
initmumps id
Definition multiplerhs_example.m:4
updb_rb
subroutine updb_rb(ndl, xs, ys, zs, bd)
Definition rby_imp0.F:773

◆ i2updb02()

subroutine i2updb02 ( integer nsn,
integer, dimension(4,*) irect,
crst,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
x,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
b,
a,
ar )

Definition at line 2249 of file i2_imp1.F.

2251C-----------------------------------------------
2252C I m p l i c i t T y p e s
2253C-----------------------------------------------
2254#include "implicit_f.inc"
2255C-----------------------------------------------
2256C D u m m y A r g u m e n t s
2257C-----------------------------------------------
2258 INTEGER NSN, IRECT(4,*), NSV(*), IRTL(*)
2259 INTEGER NDOF(*),IDDL(*)
2260C REAL
2261 my_real
2262 . crst(2,*),x(3,*),b(*),a(3,*),ar(3,*)
2263C-----------------------------------------------
2264C C o m m o n B l o c k s
2265C-----------------------------------------------
2266#include "com01_c.inc"
2267C-----------------------------------------------
2268C L o c a l V a r i a b l e s
2269C-----------------------------------------------
2270 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
2271 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM
2272C REAL
2273 my_real
2274 . h(4),ss, tt, sp,sm,tp,tm,bd(6),
2275 . bi(6),xs0,ys0,zs0,xs,ys,zs,nun
2276C------------------------------------
2277C VITESSES DES NOEUDS SECONDS
2278C------------------------------------
2279C-------pour simplement etre coherent avec INTTI2, on ne distinque pas 3n,4n
2280C-------on est oblige de distinque quand meme, sinon la matrice n'est plus positive
2281 nun=-one
2282 j1=0
2283 IF (iroddl/=0) THEN
2284 nd = 6
2285 ELSE
2286 nd = 3
2287 ENDIF
2288 DO ii=1,nsn
2289 i=nsv(ii)
2290 l=irtl(ii)
2291 IF (ndof(i)==0) THEN
2292 DO k=1,3
2293 bd(k)=a(k,i)
2294 ENDDO
2295 IF (nd==3) THEN
2296 DO k=nd+1,6
2297 bd(k)=zero
2298 ENDDO
2299 ELSE
2300 DO k=1,3
2301 bd(k+3)=ar(k,i)
2302 ENDDO
2303 ENDIF
2304C
2305 ss=crst(1,ii)
2306 tt=crst(2,ii)
2307 ss = min(one,ss)
2308 tt = min(one,tt)
2309 ss = max(nun,ss)
2310 tt = max(nun,tt)
2311 sp=one + ss
2312 sm=one - ss
2313 IF (irect(3,l)==irect(4,l)) THEN
2314 nir=3
2315 tp=fourth*(one + tt)
2316 tm=fourth*(one - tt)
2317 h(1)=tm*sm
2318 h(2)=tm*sp
2319 h(3)=one-h(1)-h(2)
2320 ELSE
2321 nir=4
2322 tp=fourth*(one + tt)
2323 tm=fourth*(one - tt)
2324 h(1)=tm*sm
2325 h(2)=tm*sp
2326 h(3)=tp*sp
2327 h(4)=tp*sm
2328 ENDIF
2329C-------comme rigid body---
2330 IF (nd==6) THEN
2331 xs0=zero
2332 ys0=zero
2333 zs0=zero
2334 DO j=1,nir
2335 nj=irect(j,l)
2336 xs0=xs0+x(1,nj)*h(j)
2337 ys0=ys0+x(2,nj)*h(j)
2338 zs0=zs0+x(3,nj)*h(j)
2339 ENDDO
2340 xs=x(1,i)-xs0
2341 ys=x(2,i)-ys0
2342 zs=x(3,i)-zs0
2343 CALL updb_rb(nd,xs,ys,zs,bd)
2344 ENDIF
2345CC-------Update B---
2346 DO j=1,nir
2347 nj=irect(j,l)
2348 IF (ndof(nj)==0) THEN
2349 DO k=1,3
2350 a(k,nj)=a(k,nj)+bd(k)
2351 ENDDO
2352 IF (nd==6) THEN
2353 DO k=1,3
2354 ar(k,nj)=ar(k,nj)+bd(k+3)
2355 ENDDO
2356 ENDIF
2357 ELSE
2358 DO k=1,nd
2359 id = iddl(nj)+k
2360 b(id) = b(id) + h(j)*bd(k)
2361 ENDDO
2362 ENDIF
2363 ENDDO
2364 ENDIF
2365 ENDDO
2366C
2367 RETURN

◆ i2updb1()

subroutine i2updb1 ( integer nsn,
integer, dimension(4,*) irect,
dpara,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
x,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
b )

Definition at line 2076 of file i2_imp1.F.

2078C-----------------------------------------------
2079C I m p l i c i t T y p e s
2080C-----------------------------------------------
2081#include "implicit_f.inc"
2082C-----------------------------------------------
2083C D u m m y A r g u m e n t s
2084C-----------------------------------------------
2085 INTEGER NSN, IRECT(4,*), NSV(*), IRTL(*)
2086 INTEGER NDOF(*),IDDL(*)
2087C REAL
2088 my_real
2089 . dpara(7,*),x(*),b(*)
2090C-----------------------------------------------
2091C L o c a l V a r i a b l e s
2092C-----------------------------------------------
2093 INTEGER NIR(NSN),I, J, K, JD, II, L, JJ,I1,ID,NL,
2094 . NI,NJ,J1,NIDOF,ND,NM,IDOF,L1,NM1
2095C REAL
2096 my_real
2097 . rj(9,4,nsn),rjt(9,4,nsn)
2098 my_real
2099 . bd(6),bi(6),xs,ys,zs
2100C------------------------------------
2101C VITESSES DES NOEUDS SECONDS
2102C------------------------------------
2103 CALL i2matc(nsn,irect,dpara,nsv,irtl,x,nir,rj ,rjt )
2104 nd = 3
2105 DO ii=1,nsn
2106 i=nsv(ii)
2107 idof=ndof(i)
2108 IF (idof>0) THEN
2109 l=irtl(ii)
2110 DO k=1,idof
2111 id = iddl(i)+k
2112 bd(k)=b(id)
2113 ENDDO
2114 DO k=idof+1,6
2115 bd(k)=zero
2116 ENDDO
2117C-------Update B---
2118 DO j=1,nir(ii)
2119 nj=irect(j,l)
2120 CALL updb1_ii(idof,rj(1,j,ii),rjt(1,j,ii),bd,bi)
2121 DO k=1,nd
2122 id = iddl(nj)+k
2123 b(id) = b(id) + bi(k)
2124 ENDDO
2125 ENDDO
2126 ENDIF
2127 ENDDO
2128C
2129 RETURN
updb1_ii
subroutine updb1_ii(ndl, rj, rjt, bd, b)
Definition i2_imp1.F:2139
i2matc
subroutine i2matc(nsn, irect, dpara, nsv, irtl, x, niri, rj, rjt)
Definition i2_imp1.F:1199

◆ i2updb12()

subroutine i2updb12 ( integer nsn,
integer, dimension(4,*) irect,
dpara,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
x,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
b,
a,
ar )

Definition at line 2377 of file i2_imp1.F.

2379C-----------------------------------------------
2380C I m p l i c i t T y p e s
2381C-----------------------------------------------
2382#include "implicit_f.inc"
2383C-----------------------------------------------
2384C D u m m y A r g u m e n t s
2385C-----------------------------------------------
2386 INTEGER NSN, IRECT(4,*), NSV(*), IRTL(*)
2387 INTEGER NDOF(*),IDDL(*)
2388C REAL
2389 my_real
2390 . dpara(7,*),x(*),b(*),a(3,*),ar(3,*)
2391C-----------------------------------------------
2392C C o m m o n B l o c k s
2393C-----------------------------------------------
2394#include "com01_c.inc"
2395C-----------------------------------------------
2396C L o c a l V a r i a b l e s
2397C-----------------------------------------------
2398 INTEGER NIR(NSN),I, J, K, JD, II, L, JJ,I1,ID,NL,
2399 . NI,NJ,J1,NIDOF,ND,NM,IDOF,L1,NM1
2400C REAL
2401 my_real
2402 . rj(9,4,nsn),rjt(9,4,nsn)
2403 my_real
2404 . bd(6),bi(6),xs,ys,zs
2405C------------------------------------
2406C VITESSES DES NOEUDS SECONDS
2407C------------------------------------
2408 CALL i2matc(nsn,irect,dpara,nsv,irtl,x,nir,rj ,rjt )
2409 IF (iroddl/=0) THEN
2410 nd = 6
2411 ELSE
2412 nd = 3
2413 ENDIF
2414 DO ii=1,nsn
2415 i=nsv(ii)
2416 idof=ndof(i)
2417 IF (idof==0) THEN
2418 l=irtl(ii)
2419 DO k=1,3
2420 bd(k)=a(k,i)
2421 ENDDO
2422 IF (nd==3) THEN
2423 DO k=nd+1,6
2424 bd(k)=zero
2425 ENDDO
2426 ELSE
2427 DO k=1,3
2428 bd(k+3)=ar(k,i)
2429 ENDDO
2430 ENDIF
2431C-------Update B---
2432 DO j=1,nir(ii)
2433 nj=irect(j,l)
2434 CALL updb1_ii(nd,rj(1,j,ii),rjt(1,j,ii),bd,bi)
2435 IF (ndof(nj)==0) THEN
2436 DO k=1,3
2437 a(k,nj)=a(k,nj)+bi(k)
2438 ENDDO
2439 ELSE
2440 DO k=1,3
2441 id = iddl(nj)+k
2442 b(id) = b(id) + bi(k)
2443 ENDDO
2444 ENDIF
2445 ENDDO
2446 ENDIF
2447 ENDDO
2448C
2449 RETURN

◆ i2updk0()

subroutine i2updk0 ( integer nsn,
integer nmn,
integer, dimension(4,*) irect,
crst,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
ms,
x,
integer, dimension(*) weight,
integer, dimension(*) itab,
integer nsc,
integer, dimension(2,nsc) isi,
integer, dimension(*) ns,
integer, dimension(*) nods,
integer, dimension(*) ikc,
integer, dimension(*) ndof,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
b )

Definition at line 220 of file i2_imp1.F.

225C-----------------------------------------------
226C I m p l i c i t T y p e s
227C-----------------------------------------------
228#include "implicit_f.inc"
229C-----------------------------------------------
230C D u m m y A r g u m e n t s
231C-----------------------------------------------
232 INTEGER NSN, NMN,
233 . IRECT(4,*), MSR(*), NSV(*), IRTL(*),WEIGHT(*),
234 . NSC,ISI(2,NSC) ,NS(*),NODS(*),ITAB(*)
235 INTEGER NDDL,IADK(*),JDIK(*),NDOF(*),IDDL(*),IKC(*)
236C REAL
237 my_real
238 . crst(2,*),x(3,*),ms(*),diag_k(*),lt_k(*),b(*)
239C-----------------------------------------------
240C L o c a l V a r i a b l e s
241C-----------------------------------------------
242 INTEGER NIR, I, J, J1, J2, J3, J4, K, JD, II, L, JJ,
243 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM,L1,NM1,
244 . NIR1,IR
245C REAL
246 my_real
247 . h(4,nsn),h2(4), ss, tt, sp,sm,tp,tm,kdd(6,6),bd(6),
248 . kii(6,6),bi(6),xs0(nsn),ys0(nsn),zs0(nsn),
249 . xs,ys,zs,xs1,ys1,zs1,facm,nun
250C------------------------------------
251C VITESSES DES NOEUDS SECONDS
252C------------------------------------
253C-------pour simplement etre coherent avec INTTI2, on ne distinque pas 3n,4n
254C-------on est oblige de distinque quand meme, sinon la matrice n'est plus positive
255C FACM = ONE / NIR
256 nun=-one
257 j1=0
258 DO ii=1,nsn
259 i=nsv(ii)
260 l=irtl(ii)
261 IF (ndof(i)>0) THEN
262 DO k=1,ndof(i)
263 id = iddl(i)+k
264 ikc(id)=5
265 bd(k)=b(id)
266 ENDDO
267 DO k=ndof(i)+1,6
268 bd(k)=zero
269 ENDDO
270 CALL get_kii(i ,iddl ,iadk,diag_k,lt_k ,kdd,ndof(i))
271C
272 ss=crst(1,ii)
273 tt=crst(2,ii)
274 ss = min(one,ss)
275 tt = min(one,tt)
276 ss = max(nun,ss)
277 tt = max(nun,tt)
278 sp=one + ss
279 sm=one - ss
280 IF (irect(3,l)==irect(4,l)) THEN
281 nir=3
282 tp=fourth*(one + tt)
283 tm=fourth*(one - tt)
284 h(1,ii)=tm*sm
285 h(2,ii)=tm*sp
286 h(3,ii)=one-h(1,ii)-h(2,ii)
287 h2(1)=h(1,ii)*h(1,ii)
288 h2(2)=h(2,ii)*h(2,ii)
289 h2(3)=h(3,ii)*h(3,ii)
290 ELSE
291 nir=4
292 tp=fourth*(one + tt)
293 tm=fourth*(one - tt)
294 h(1,ii)=tm*sm
295 h(2,ii)=tm*sp
296 h(3,ii)=tp*sp
297 h(4,ii)=tp*sm
298 h2(1)=h(1,ii)*h(1,ii)
299 h2(2)=h(2,ii)*h(2,ii)
300 h2(3)=h(3,ii)*h(3,ii)
301 h2(4)=h(4,ii)*h(4,ii)
302 ENDIF
303 ndm = 0
304 DO j=1,nir
305 nj=irect(j,l)
306 ndm = max(ndm,ndof(nj))
307 ENDDO
308C-------NDOF(M)> 3 comme rigid body---
309 IF (ndm==6) THEN
310 xs0(ii)=zero
311 ys0(ii)=zero
312 zs0(ii)=zero
313 DO j=1,nir
314 nj=irect(j,l)
315 xs0(ii)=xs0(ii)+x(1,nj)*h(j,ii)
316 ys0(ii)=ys0(ii)+x(2,nj)*h(j,ii)
317 zs0(ii)=zs0(ii)+x(3,nj)*h(j,ii)
318 ENDDO
319 xs=x(1,i)-xs0(ii)
320 ys=x(2,i)-ys0(ii)
321 zs=x(3,i)-zs0(ii)
322 CALL updkb_rb(ndof(i),xs,ys,zs,kdd,bd)
323 ENDIF
324CC-------Update K(main node),B---
325 DO j=1,nir
326 nj=irect(j,l)
327 nd = min(ndm,ndof(nj))
328 CALL updkdd(nd,kdd,kii,h2(j),1)
329 CALL put_kii(nj,iddl ,iadk,diag_k,lt_k ,kii,nd)
330 DO k=1,nd
331 id = iddl(nj)+k
332 b(id) = b(id) + h(j,ii)*bd(k)
333 ENDDO
334 DO i1=j+1,nir
335 nm=irect(i1,l)
336 tm=h(j,ii)*h(i1,ii)
337 nd = min(nd,ndof(nm))
338 CALL updkdd(nd,kdd,kii,tm,0)
339 CALL put_kij(nj,nm,iddl,iadk,jdik,lt_k,kii,nd,nd,ir)
340 IF (ir==1) CALL print_wkij(itab(nj) ,itab(nm) ,2 )
341 ENDDO
342 ENDDO
343C--------no diag--Kjm=sum(KjsCsm)--
344 DO i1 = 1,ns(ii)
345 ni=nods(j1+i1)
346 nidof=ndof(ni)
347 CALL get_kij(ni,i,iddl,iadk,jdik,lt_k,kdd,nidof,ndof(i),ir)
348 IF (ir==1) CALL print_wkij(itab(ni) ,itab(i) ,2 )
349C------- Update ---
350 IF (ndm==6) CALL updkb_rb1(nidof,ndof(i),xs,ys,zs,kdd)
351 DO j=1,nir
352 nj=irect(j,l)
353 ndi = min(ndm,nidof)
354 ndj = min(ndm,ndof(nj))
355 IF (ni==nj.AND.ndj>0) THEN
356 CALL updkdd1(ndi,ndof(i),kdd,kii,h(j,ii),1)
357 CALL put_kii(nj,iddl ,iadk,diag_k,lt_k ,kii,ndj)
358 ELSEIF (ndj>0) THEN
359 CALL updkdd1(ndi,ndof(i),kdd,kii,h(j,ii),0)
360 CALL put_kij(ni,nj,iddl,iadk,jdik,lt_k,kii,ndi,ndj,ir)
361 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,2 )
362 ENDIF
363 ENDDO
364 ENDDO
365 j1=j1+ns(ii)
366 ENDIF
367 ENDDO
368C--------due au coupled block KIJ--
369 DO i=1,nsc
370 ii =isi(1,i)
371 jj =isi(2,i)
372 ni =nsv(ii)
373 nj =nsv(jj)
374 l=irtl(ii)
375 l1=irtl(jj)
376 CALL get_kij(ni,nj,iddl,iadk,jdik,lt_k,kdd,ndof(ni),ndof(nj),ir)
377 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,2 )
378 IF (irect(3,l)==irect(4,l)) THEN
379 nir=3
380 ELSE
381 nir=4
382 ENDIF
383 IF (l==l1) THEN
384 ndm = 0
385 DO j=1,nir
386 nm=irect(j,l)
387 ndm = max(ndm,ndof(nm))
388 ENDDO
389 IF (ndm==6) THEN
390 xs=x(1,ni)-xs0(ii)
391 ys=x(2,ni)-ys0(ii)
392 zs=x(3,ni)-zs0(ii)
393 xs1=x(1,nj)-xs0(jj)
394 ys1=x(2,nj)-ys0(jj)
395 zs1=x(3,nj)-zs0(jj)
396 CALL updkb_rb2(ndof(ni),ndof(nj),xs,ys,zs,xs1,ys1,zs1,kdd,0)
397 ENDIF
398 DO j=1,nir
399 nm=irect(j,l)
400 tm=h(j,ii)*h(j,jj)
401 CALL updkdd2(ndm,kdd,kii,tm,tm)
402 CALL put_kii(nm ,iddl ,iadk,diag_k,lt_k,kii,ndof(nm))
403 DO j1=j+1,nir
404 nm1=irect(j1,l)
405 ndm = min(ndof(nm),ndof(nm1))
406 IF (ndm>0) THEN
407 tm=h(j,ii)*h(j1,jj)
408 tp=h(j,jj)*h(j1,ii)
409 CALL updkdd2(ndm,kdd,kii,tm,tp)
410C--------update --
411 CALL put_kij(nm,nm1,iddl,iadk,jdik,lt_k,kii,
412 . ndof(nm),ndof(nm1),ir)
413 IF (ir==1) CALL print_wkij(itab(nm) ,itab(nm1) ,2 )
414 ENDIF
415 ENDDO
416 ENDDO
417C----- (L/=L1)-----
418 ELSE
419 ndm = 0
420 IF (irect(3,l1)==irect(4,l1)) THEN
421 nir1=3
422 ELSE
423 nir1=4
424 ENDIF
425 DO j=1,max(nir,nir1)
426 nm=irect(j,l)
427 nm1=irect(j,l1)
428 ndm = max(ndm,ndof(nm),ndof(nm1))
429 ENDDO
430 IF (ndm==6) THEN
431 xs=x(1,ni)-xs0(ii)
432 ys=x(2,ni)-ys0(ii)
433 zs=x(3,ni)-zs0(ii)
434 xs1=x(1,nj)-xs0(jj)
435 ys1=x(2,nj)-ys0(jj)
436 zs1=x(3,nj)-zs0(jj)
437 CALL updkb_rb2(ndof(ni),ndof(nj),xs,ys,zs,xs1,ys1,zs1,kdd,0)
438 ENDIF
439 DO j=1,nir
440 nm=irect(j,l)
441 DO j1=1,nir1
442 nm1=irect(j1,l1)
443 tm=h(j,ii)*h(j1,jj)
444C--------update --
445 ndm = min(ndof(nm),ndof(nm1))
446 IF (nm==nm1.AND.ndm>0) THEN
447 CALL updkdd1(ndof(ni),ndof(nj),kdd,kii,tm,1)
448 CALL put_kii(nm ,iddl ,iadk,diag_k,lt_k,kii,ndof(nm))
449 ELSEIF (ndm>0) THEN
450 CALL updkdd1(ndof(ni),ndof(nj),kdd,kii,tm,0)
451 CALL put_kij(nm,nm1,iddl,iadk,jdik,lt_k,kii,
452 . ndof(nm),ndof(nm1),ir)
453 IF (ir==1) CALL print_wkij(itab(nm) ,itab(nm1) ,2 )
454 ENDIF
455 ENDDO
456 ENDDO
457 ENDIF
458 ENDDO
459C
460 RETURN
updkdd2
subroutine updkdd2(ndl, kdd, kii, h1, h2)
Definition i2_imp1.F:1163
put_kii
subroutine put_kii(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:653
put_kij
subroutine put_kij(ni, nj, iddl, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:810
get_kii
subroutine get_kii(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:591
updkb_rb2
subroutine updkb_rb2(ni, nj, xs, ys, zs, xs1, ys1, zs1, kdd, isym)
Definition rby_imp0.F:489

◆ i2updk1()

subroutine i2updk1 ( integer nsn,
integer nmn,
integer, dimension(4,*) irect,
dpara,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
ms,
x,
integer, dimension(*) weight,
integer, dimension(*) itab,
integer nsc,
integer, dimension(2,nsc) isi,
integer, dimension(*) ns,
integer, dimension(*) nods,
integer, dimension(*) ikc,
integer, dimension(*) ndof,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
b )

Definition at line 620 of file i2_imp1.F.

625C-----------------------------------------------
626C I m p l i c i t T y p e s
627C-----------------------------------------------
628#include "implicit_f.inc"
629C-----------------------------------------------
630C D u m m y A r g u m e n t s
631C-----------------------------------------------
632 INTEGER NSN, NMN,
633 . IRECT(4,*), MSR(*), NSV(*), IRTL(*),WEIGHT(*),
634 . NSC,ISI(2,NSC) ,NS(*),NODS(*),ITAB(*)
635 INTEGER NDDL,IADK(*),JDIK(*),NDOF(*),IDDL(*),IKC(*)
636C REAL
637 my_real
638 . dpara(7,*),x(*),ms(*),diag_k(*),lt_k(*),b(*)
639C-----------------------------------------------
640C L o c a l V a r i a b l e s
641C-----------------------------------------------
642 INTEGER NIR(NSN),I, J, K, JD, II, L, JJ,I1,ID,NL,
643 . NI,NJ,J1,NIDOF,ND,NM,IDOF,L1,NM1,NDM,ND1,IR
644C REAL
645 my_real
646 . rj(9,4,nsn),rjt(9,4,nsn)
647 my_real
648 . kdd(6,6),bd(6),kii(6,6),bi(6),xs,ys,zs,xs1,ys1,zs1
649C------------------------------------
650C VITESSES DES NOEUDS SECONDS
651C------------------------------------
652 CALL i2matc(nsn,irect,dpara,nsv,irtl,x,nir,rj ,rjt )
653 j1=0
654 nd = 3
655 ndm = 3
656 DO ii=1,nsn
657 i=nsv(ii)
658 idof=ndof(i)
659 IF (idof>0) THEN
660 l=irtl(ii)
661 DO k=1,idof
662 id = iddl(i)+k
663 ikc(id)=5
664 bd(k)=b(id)
665 ENDDO
666 DO k=idof+1,6
667 bd(k)=zero
668 ENDDO
669 CALL get_kii(i ,iddl ,iadk,diag_k,lt_k ,kdd,idof)
670 DO j=1,idof
671 DO k=j+1,idof
672 kdd(k,j)=kdd(j,k)
673 ENDDO
674 ENDDO
675C-------Update K(main node),B---
676 DO j=1,nir(ii)
677 nj=irect(j,l)
678 nd=min(ndm,ndof(nj))
679 CALL updk1_ii(idof,rj(1,j,ii),rjt(1,j,ii),kdd,kii,bd,bi)
680 CALL put_kii(nj ,iddl ,iadk,diag_k,lt_k ,kii,nd)
681 DO k=1,nd
682 id = iddl(nj)+k
683 b(id) = b(id) + bi(k)
684 ENDDO
685 DO i1=j+1,nir(ii)
686 nm=irect(i1,l)
687 nd1=min(ndm,ndof(nj))
688 CALL updk1_ij(idof,idof,rj(1,j,ii),rjt(1,j,ii),
689 1 rj(1,i1,ii),rjt(1,i1,ii),kdd,kii,0)
690 CALL put_kij(nj,nm,iddl,iadk,jdik,lt_k,kii,nd,nd1,ir)
691 IF (ir==1) CALL print_wkij(itab(nj) ,itab(nm) ,2 )
692 ENDDO
693 ENDDO
694C--------no diag--Kmj=sum(KjsCsm)--
695 DO i1 = 1,ns(ii)
696 ni=nods(j1+i1)
697 nidof=ndof(ni)
698 CALL get_kij(ni,i,iddl,iadk,jdik,lt_k,kdd,nidof,idof,ir)
699 IF (ir==1) CALL print_wkij(itab(ni) ,itab(i) ,2 )
700C------- Update ---
701 DO j=1,nir(ii)
702 nj=irect(j,l)
703 nd=min(ndm,ndof(nj))
704 IF (ni==nj.AND.nd>0) THEN
705 CALL updk1_jj(nidof,idof,rj(1,j,ii),rjt(1,j,ii),kdd,kii)
706 DO k=1,3
707 DO l1=1,3
708 kii(k,l1)=kii(k,l1)+kii(l1,k)
709 ENDDO
710 ENDDO
711 CALL put_kii(nj ,iddl ,iadk,diag_k,lt_k ,kii,nd)
712 ELSEIF (nd>0) THEN
713 CALL updk1_jj(nidof,idof,rj(1,j,ii),rjt(1,j,ii),kdd,kii)
714 CALL put_kij(ni,nj,iddl,iadk,jdik,lt_k,kii,nidof,nd,ir)
715 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,2 )
716 ENDIF
717 ENDDO
718 ENDDO
719 j1=j1+ns(ii)
720 ENDIF
721 ENDDO
722C--------due au coupled block KIJ-attension ISI different que rigid body-
723 DO i=1,nsc
724 ii =isi(1,i)
725 jj =isi(2,i)
726 ni =nsv(ii)
727 nj =nsv(jj)
728 l=irtl(ii)
729 l1=irtl(jj)
730 nidof=ndof(ni)
731 idof=ndof(nj)
732 CALL get_kij(ni,nj,iddl,iadk,jdik,lt_k,kdd,nidof,idof,ir)
733 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,2 )
734 IF (l==l1) THEN
735 DO j=1,nir(ii)
736 nm=irect(j,l)
737C--------update --
738 nd=min(ndm,ndof(nm))
739 CALL updk1_ij(nidof,idof,rj(1,j,ii),rjt(1,j,ii),
740 1 rj(1,j,jj),rjt(1,j,jj),kdd,kii,1)
741 CALL put_kii(nm ,iddl ,iadk,diag_k,lt_k ,kii,nd)
742 DO j1=j+1,nir(jj)
743 nm1=irect(j1,l)
744 nd1=min(ndm,ndof(nm1))
745 IF (nd1>0) THEN
746 CALL updk1_ij(nidof,idof,rj(1,j,ii),rjt(1,j,ii),
747 1 rj(1,j1,jj),rjt(1,j1,jj),kdd,kii,0)
748 CALL put_kij(nm,nm1,iddl,iadk,jdik,lt_k,kii,nd,nd1,ir)
749 IF (ir==1) CALL print_wkij(itab(nm) ,itab(nm1) ,2 )
750 CALL updk1_ij(nidof,idof,rj(1,j1,ii),rjt(1,j1,ii),
751 1 rj(1,j,jj),rjt(1,j,jj),kdd,kii,0)
752 CALL put_kij(nm1,nm,iddl,iadk,jdik,lt_k,kii,nd1,nd,ir)
753 IF (ir==1) CALL print_wkij(itab(nm1) ,itab(nm) ,2 )
754 ENDIF
755 ENDDO
756 ENDDO
757 ELSE
758 DO j=1,nir(ii)
759 nm=irect(j,l)
760 nd=min(ndm,ndof(nm))
761 DO j1=1,nir(jj)
762 nm1=irect(j1,l1)
763 nd1=min(ndm,ndof(nm1))
764 IF (nm==nm1.AND.nd1>0) THEN
765 CALL updk1_ij(nidof,idof,rj(1,j,ii),rjt(1,j,ii),
766 1 rj(1,j1,jj),rjt(1,j1,jj),kdd,kii,1)
767 CALL put_kii(nm ,iddl ,iadk,diag_k,lt_k ,kii,nd)
768 ELSEIF (nd1>0) THEN
769 CALL updk1_ij(nidof,idof,rj(1,j,ii),rjt(1,j,ii),
770 1 rj(1,j1,jj),rjt(1,j1,jj),kdd,kii,0)
771 CALL put_kij(nm,nm1,iddl,iadk,jdik,lt_k,kii,nd,nd1,ir)
772 IF (ir==1) CALL print_wkij(itab(nm) ,itab(nm1) ,2 )
773 ENDIF
774 ENDDO
775 ENDDO
776 ENDIF
777 ENDDO
778C
779 RETURN

◆ i2updkm0()

subroutine i2updkm0 ( integer ns1,
integer, dimension(4,*) irect,
crst,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
integer ns2,
integer, dimension(4,*) irect1,
crst1,
integer, dimension(*) nsv1,
integer, dimension(*) irtl1,
x,
kdd,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
lt_k,
diag_k )

Definition at line 472 of file i2_imp1.F.

476C-----------------------------------------------
477C I m p l i c i t T y p e s
478C-----------------------------------------------
479#include "implicit_f.inc"
480C-----------------------------------------------
481C D u m m y A r g u m e n t s
482C-----------------------------------------------
483 INTEGER NS1,IRECT(4,*), NSV(*), IRTL(*),
484 . NS2,IRECT1(4,*), NSV1(*), IRTL1(*),
485 . NDOF(*) ,IDDL(*) ,IADK(*),JDIK(*)
486C REAL
487 my_real
488 . crst(2,*),crst1(2,*),x(3,*),kdd(6,6),lt_k(*),diag_k(*)
489C-----------------------------------------------
490C L o c a l V a r i a b l e s
491C-----------------------------------------------
492 INTEGER J, L, J1,L1,NI,NJ,K,NIR,NIR1,NM,NM1,NDM,IR
493C REAL
494 my_real
495 . h(4),h1(4),ss, tt, sp,sm,tp,tm,nun,
496 . kii(6,6),xs,ys,zs,xs1,ys1,zs1,xm0,ym0,zm0,xm1,ym1,zm1
497C------------------------------------
498 nun=-one
499 l=irtl(ns1)
500 l1=irtl1(ns2)
501 ss=crst(1,ns1)
502 tt=crst(2,ns1)
503 ss = min(one,ss)
504 tt = min(one,tt)
505 ss = max(nun,ss)
506 tt = max(nun,tt)
507 sp=one + ss
508 sm=one - ss
509 IF (irect(3,l)==irect(4,l)) THEN
510 nir=3
511 tp=fourth*(one + tt)
512 tm=fourth*(one - tt)
513 h(1)=tm*sm
514 h(2)=tm*sp
515 h(3)=one-h(1)-h(2)
516 ELSE
517 nir=4
518 tp=fourth*(one + tt)
519 tm=fourth*(one - tt)
520 h(1)=tm*sm
521 h(2)=tm*sp
522 h(3)=tp*sp
523 h(4)=tp*sm
524 ENDIF
525 xm0=zero
526 ym0=zero
527 zm0=zero
528 DO j=1,nir
529 nj=irect(j,l)
530 xm0=xm0+x(1,nj)*h(j)
531 ym0=ym0+x(2,nj)*h(j)
532 zm0=zm0+x(3,nj)*h(j)
533 ENDDO
534C---------NJ------
535 ss=crst1(1,ns2)
536 tt=crst1(2,ns2)
537 ss = min(one,ss)
538 tt = min(one,tt)
539 ss = max(nun,ss)
540 tt = max(nun,tt)
541 sp=one + ss
542 sm=one - ss
543 IF (irect1(3,l1)==irect1(4,l1)) THEN
544 nir1=3
545 tp=fourth*(one + tt)
546 tm=fourth*(one - tt)
547 h1(1)=tm*sm
548 h1(2)=tm*sp
549 h1(3)=one-h1(1)-h1(2)
550 ELSE
551 nir1=4
552 tp=fourth*(one + tt)
553 tm=fourth*(one - tt)
554 h1(1)=tm*sm
555 h1(2)=tm*sp
556 h1(3)=tp*sp
557 h1(4)=tp*sm
558 ENDIF
559 xm1=zero
560 ym1=zero
561 zm1=zero
562 DO j=1,nir1
563 nj=irect1(j,l1)
564 xm1=xm1+x(1,nj)*h1(j)
565 ym1=ym1+x(2,nj)*h1(j)
566 zm1=zm1+x(3,nj)*h1(j)
567 ENDDO
568 ni = nsv(ns1)
569 nj = nsv1(ns2)
570 ndm = max(ndof(ni),ndof(nj))
571 DO j=1,max(nir,nir1)
572 nm=irect(j,l)
573 nm1=irect1(j,l1)
574 ndm = max(ndm,ndof(nm),ndof(nm1))
575 ENDDO
576C-------NDOF(M)> 3 comme rigid body---
577 IF (ndm==6) THEN
578 xs=x(1,ni)-xm0
579 ys=x(2,ni)-ym0
580 zs=x(3,ni)-zm0
581 xs1=x(1,nj)-xm1
582 ys1=x(2,nj)-ym1
583 zs1=x(3,nj)-zm1
584 CALL updkb_rb2(ndof(ni),ndof(nj),xs,ys,zs,xs1,ys1,zs1,kdd,0)
585 ENDIF
586 DO j=1,nir
587 nm=irect(j,l)
588 DO j1=1,nir1
589 nm1=irect1(j1,l1)
590 tm=h(j)*h1(j1)
591C--------update --
592 IF (nm==nm1) THEN
593 CALL updkdd1(ndof(ni),ndof(nj),kdd,kii,tm,1)
594 CALL put_kii(nm ,iddl ,iadk,diag_k,lt_k,kii,ndof(nm))
595 ELSE
596 CALL updkdd1(ndof(ni),ndof(nj),kdd,kii,tm,0)
597 CALL put_kij(nm,nm1,iddl,iadk,jdik,lt_k,kii,
598 . ndof(nm),ndof(nm1),ir)
599 ENDIF
600 ENDDO
601 ENDDO
602C
603 RETURN

◆ i2updkm1()

subroutine i2updkm1 ( integer ns1,
integer, dimension(4,*) irect,
dpara,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
integer ns2,
integer, dimension(4,*) irect1,
dpara1,
integer, dimension(*) nsv1,
integer, dimension(*) irtl1,
x,
kdd,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
lt_k,
diag_k )

Definition at line 1330 of file i2_imp1.F.

1334C-----------------------------------------------
1335C I m p l i c i t T y p e s
1336C-----------------------------------------------
1337#include "implicit_f.inc"
1338C-----------------------------------------------
1339C D u m m y A r g u m e n t s
1340C-----------------------------------------------
1341 INTEGER NS1,IRECT(4,*), NSV(*), IRTL(*),
1342 . NS2,IRECT1(4,*), NSV1(*), IRTL1(*),
1343 . NDOF(*) ,IDDL(*) ,IADK(*),JDIK(*)
1344C REAL
1345 my_real
1346 . dpara(7,*),dpara1(7,*),x(3,*),kdd(6,6),lt_k(*),diag_k(*)
1347C-----------------------------------------------
1348C L o c a l V a r i a b l e s
1349C-----------------------------------------------
1350 INTEGER J, L, J1,L1,NI,NJ,K,NIR,NIR1,NM,NM1,IR
1351C REAL
1352 my_real
1353 . kii(6,6),rj(3,3,4),rjt(3,3,4),rj1(3,3,4),rjt1(3,3,4)
1354C------------------------------------
1355 CALL i2matcm(ns1,irect,dpara,nsv,irtl,
1356 . x ,nir ,rj ,rjt )
1357 CALL i2matcm(ns2,irect1,dpara1,nsv1,irtl1,
1358 . x ,nir1 ,rj1 ,rjt1 )
1359 ni=nsv(ns1)
1360 nj=nsv1(ns2)
1361 l=irtl(ns1)
1362 l1=irtl1(ns2)
1363 DO j=1,nir
1364 nm=irect(j,l)
1365 DO j1=1,nir1
1366 nm1=irect1(j1,l1)
1367 IF (nm==nm1) THEN
1368 CALL updk1_ij(ndof(ni),ndof(nj),rj(1,1,j),rjt(1,1,j),
1369 1 rj1(1,1,j1),rjt1(1,1,j1),kdd,kii,1)
1370 CALL put_kii(nm,iddl,iadk,diag_k,lt_k,kii,3)
1371 ELSE
1372 CALL updk1_ij(ndof(ni),ndof(nj),rj(1,1,j),rjt(1,1,j),
1373 1 rj1(1,1,j1),rjt1(1,1,j1),kdd,kii,0)
1374 CALL put_kij(nm1,nm,iddl,iadk,jdik,lt_k,kii,3,3,ir)
1375 ENDIF
1376 ENDDO
1377 ENDDO
1378C
1379 RETURN
i2matcm
subroutine i2matcm(ii, irect, dpara, nsv, irtl, x, niri, rj, rjt)
Definition i2_imp1.F:1388

◆ updb1_ii()

subroutine updb1_ii ( integer ndl,
rj,
rjt,
bd,
b )

Definition at line 2138 of file i2_imp1.F.

2139C-----------------------------------------------
2140C I m p l i c i t T y p e s
2141C-----------------------------------------------
2142#include "implicit_f.inc"
2143C-----------------------------------------------
2144C D u m m y A r g u m e n t s
2145C-----------------------------------------------
2146 INTEGER NDL
2147C REAL
2148 my_real
2149 . b(3),rj(3,3), rjt(3,3), bd(6)
2150C-----------------------------------------------
2151C L o c a l V a r i a b l e s
2152C-----------------------------------------------
2153 INTEGER I, J
2154C REAL
2155C------------------------------------
2156 DO i=1,3
2157 b(i)=rjt(1,i)*bd(1)+rjt(2,i)*bd(2)+rjt(3,i)*bd(3)
2158 ENDDO
2159C
2160 IF (ndl==6) THEN
2161 DO i=1,3
2162 b(i)=b(i)+rj(1,i)*bd(4)+rj(2,i)*bd(5)+rj(3,i)*bd(6)
2163 ENDDO
2164 ENDIF
2165C
2166 RETURN

◆ updk1_ii()

subroutine updk1_ii ( integer ndl,
rj,
rjt,
kdd,
k,
bd,
b )

Definition at line 788 of file i2_imp1.F.

789C-----------------------------------------------
790C I m p l i c i t T y p e s
791C-----------------------------------------------
792#include "implicit_f.inc"
793C-----------------------------------------------
794C D u m m y A r g u m e n t s
795C-----------------------------------------------
796 INTEGER NDL
797C REAL
798 my_real
799 . b(3),k(6,6),rj(3,3), rjt(3,3), bd(6),kdd(6,6)
800C-----------------------------------------------
801C L o c a l V a r i a b l e s
802C-----------------------------------------------
803 INTEGER I, J
804C REAL
805 my_real
806 . k1(3,3)
807C------------------------------------
808 DO i=1,3
809 DO j=i,3
810 k(i,j)=rjt(1,i)*(kdd(1,1)*rjt(1,j)+
811 1 kdd(1,2)*rjt(2,j)+kdd(1,3)*rjt(3,j))+
812 2 rjt(2,i)*(kdd(1,2)*rjt(1,j)+
813 3 kdd(2,2)*rjt(2,j)+kdd(2,3)*rjt(3,j))+
814 4 rjt(3,i)*(kdd(1,3)*rjt(1,j)+
815 5 kdd(2,3)*rjt(2,j)+kdd(3,3)*rjt(3,j))
816 ENDDO
817 ENDDO
818 DO i=1,3
819 b(i)=rjt(1,i)*bd(1)+rjt(2,i)*bd(2)+rjt(3,i)*bd(3)
820 ENDDO
821C
822 IF (ndl==6) THEN
823 DO i=1,3
824 DO j=1,3
825 k1(i,j)= rjt(1,i)*(kdd(1,4)*rj(1,j)+
826 1 kdd(1,5)*rj(2,j)+kdd(1,6)*rj(3,j))+
827 2 rjt(2,i)*(kdd(2,4)*rj(1,j)+
828 3 kdd(2,5)*rj(2,j)+kdd(2,6)*rj(3,j))+
829 4 rjt(3,i)*(kdd(3,4)*rj(1,j)+
830 5 kdd(3,5)*rj(2,j)+kdd(3,6)*rj(3,j))
831 ENDDO
832 ENDDO
833 DO i=1,3
834 DO j=i,3
835 k(i,j)= k(i,j)+k1(i,j)+k1(j,i)+
836 1 rj(1,i)*(kdd(4,4)*rj(1,j)+kdd(4,5)*rj(2,j)+
837 2 kdd(4,6)*rj(3,j) ) +
838 3 rj(2,i)*(kdd(4,5)*rj(1,j)+kdd(5,5)*rj(2,j)+
839 4 kdd(5,6)*rj(3,j) ) +
840 5 rj(3,i)*(kdd(4,6)*rj(1,j)+kdd(5,6)*rj(2,j)+
841 6 kdd(6,6)*rj(3,j) )
842 ENDDO
843 ENDDO
844 DO i=1,3
845 b(i)=b(i)+rj(1,i)*bd(4)+rj(2,i)*bd(5)+rj(3,i)*bd(6)
846 ENDDO
847 ENDIF
848C
849 RETURN

◆ updk1_ij()

subroutine updk1_ij ( integer ndi,
integer ndj,
r1j,
r1jt,
r2j,
r2jt,
kdd,
kii,
integer isym )

Definition at line 907 of file i2_imp1.F.

908C-----------------------------------------------
909C I m p l i c i t T y p e s
910C-----------------------------------------------
911#include "implicit_f.inc"
912C-----------------------------------------------
913C D u m m y A r g u m e n t s
914C-----------------------------------------------
915 INTEGER NDI,NDJ,ISYM
916C REAL
917 my_real
918 . r1j(3,3), r1jt(3,3),r2j(3,3), r2jt(3,3), kdd(6,6),
919 . kii(6,6)
920C-----------------------------------------------
921C L o c a l V a r i a b l e s
922C-----------------------------------------------
923 INTEGER I, J
924C REAL
925 my_real
926 . k(3,3)
927C------------------------------------
928 DO i=1,3
929 DO j=1,3
930 k(i,j)=r1jt(1,i)*(kdd(1,1)*r2jt(1,j)+
931 1 kdd(1,2)*r2jt(2,j)+kdd(1,3)*r2jt(3,j))+
932 2 r1jt(2,i)*(kdd(2,1)*r2jt(1,j)+
933 3 kdd(2,2)*r2jt(2,j)+kdd(2,3)*r2jt(3,j))+
934 4 r1jt(3,i)*(kdd(3,1)*r2jt(1,j)+
935 5 kdd(3,2)*r2jt(2,j)+kdd(3,3)*r2jt(3,j))
936 ENDDO
937 ENDDO
938C
939 IF (ndi==6) THEN
940 DO i=1,3
941 DO j=1,3
942 k(i,j)=k(i,j)+ r1j(1,i)*(kdd(4,1)*r2jt(1,j)+
943 1 kdd(4,2)*r2jt(2,j)+kdd(4,3)*r2jt(3,j))+
944 2 r1j(2,i)*(kdd(5,1)*r2jt(1,j)+
945 3 kdd(5,2)*r2jt(2,j)+kdd(5,3)*r2jt(3,j))+
946 4 r1j(3,i)*(kdd(6,1)*r2jt(1,j)+
947 5 kdd(6,2)*r2jt(2,j)+kdd(6,3)*r2jt(3,j))
948 ENDDO
949 ENDDO
950 ENDIF
951 IF (ndj==6) THEN
952 DO i=1,3
953 DO j=1,3
954 k(i,j)=k(i,j)+ r1jt(1,i)*(kdd(1,4)*r2j(1,j)+
955 1 kdd(1,5)*r2j(2,j)+kdd(1,6)*r2j(3,j))+
956 2 r1jt(2,i)*(kdd(2,4)*r2j(1,j)+
957 3 kdd(2,5)*r2j(2,j)+kdd(2,6)*r2j(3,j))+
958 4 r1jt(3,i)*(kdd(3,4)*r2j(1,j)+
959 5 kdd(3,5)*r2j(2,j)+kdd(3,6)*r2j(3,j))
960 ENDDO
961 ENDDO
962 ENDIF
963 IF (ndi==6.AND.ndj==6) THEN
964 DO i=1,3
965 DO j=1,3
966 k(i,j)= k(i,j)+
967 1 r1j(1,i)*(kdd(4,4)*r2j(1,j)+kdd(4,5)*r2j(2,j)+
968 2 kdd(4,6)*r2j(3,j) ) +
969 3 r1j(2,i)*(kdd(5,4)*r2j(1,j)+kdd(5,5)*r2j(2,j)+
970 4 kdd(5,6)*r2j(3,j) ) +
971 5 r1j(3,i)*(kdd(6,4)*r2j(1,j)+kdd(6,5)*r2j(2,j)+
972 6 kdd(6,6)*r2j(3,j) )
973 ENDDO
974 ENDDO
975 ENDIF
976C
977 IF (isym==1) THEN
978 DO i=1,3
979 DO j=1,3
980 kii(i,j)=k(i,j)+k(j,i)
981 ENDDO
982 ENDDO
983 ELSE
984 DO i=1,3
985 DO j=1,3
986 kii(i,j)=k(i,j)
987 ENDDO
988 ENDDO
989 ENDIF
990C
991 RETURN

◆ updk1_jj()

subroutine updk1_jj ( integer ndi,
integer ndj,
rj,
rjt,
kdd,
kii )

Definition at line 1000 of file i2_imp1.F.

1001C-----------------------------------------------
1002C I m p l i c i t T y p e s
1003C-----------------------------------------------
1004#include "implicit_f.inc"
1005C-----------------------------------------------
1006C D u m m y A r g u m e n t s
1007C-----------------------------------------------
1008 INTEGER NDI,NDJ
1009C REAL
1010 my_real
1011 . rj(3,3), rjt(3,3), kdd(6,6), kii(6,6)
1012C-----------------------------------------------
1013C L o c a l V a r i a b l e s
1014C-----------------------------------------------
1015 INTEGER I, J,MI
1016C REAL
1017 my_real
1018 . k(6,3)
1019C----------K RJT--------------------------
1020 DO i=1,3
1021 DO j=1,3
1022 k(i,j)=kdd(i,1)*rjt(1,j)+
1023 1 kdd(i,2)*rjt(2,j)+kdd(i,3)*rjt(3,j)
1024 ENDDO
1025 ENDDO
1026C
1027 IF (ndj==6) THEN
1028 DO i=1,3
1029 DO j=1,3
1030 k(i,j)=k(i,j)+kdd(i,4)*rj(1,j)+
1031 1 kdd(i,5)*rj(2,j)+kdd(i,6)*rj(3,j)
1032 ENDDO
1033 ENDDO
1034 ENDIF
1035 IF (ndi==6) THEN
1036 DO i=1,3
1037 mi=i+3
1038 DO j=1,3
1039 k(mi,j)= kdd(mi,1)*rjt(1,j)+
1040 1 kdd(mi,2)*rjt(2,j)+kdd(mi,3)*rjt(3,j)
1041 ENDDO
1042 ENDDO
1043 ENDIF
1044 IF (ndi==6.AND.ndj==6) THEN
1045 DO i=1,3
1046 mi=i+3
1047 DO j=1,3
1048 k(mi,j)= k(mi,j)+ kdd(mi,4)*rj(1,j)+
1049 1 kdd(mi,5)*rj(2,j)+kdd(mi,6)*rj(3,j)
1050 ENDDO
1051 ENDDO
1052 ENDIF
1053C
1054 DO i=1,ndi
1055 DO j=1,3
1056 kii(i,j)=k(i,j)
1057 ENDDO
1058 ENDDO
1059C
1060 RETURN

◆ updkdd()

subroutine updkdd ( integer ndl,
kdd,
kii,
h2,
integer isym )

Definition at line 1070 of file i2_imp1.F.

1071C-----------------------------------------------
1072C I m p l i c i t T y p e s
1073C-----------------------------------------------
1074#include "implicit_f.inc"
1075C-----------------------------------------------
1076C D u m m y A r g u m e n t s
1077C-----------------------------------------------
1078 INTEGER NDL,ISYM
1079C REAL
1080 my_real
1081 . kdd(6,6),kii(6,6),h2
1082C-----------------------------------------------
1083C L o c a l V a r i a b l e s
1084C-----------------------------------------------
1085 INTEGER I, J
1086C REAL
1087C------------------------------------
1088 DO i=1,6
1089 DO j=1,6
1090 kii(i,j) = zero
1091 ENDDO
1092 ENDDO
1093 DO i=1,ndl
1094 DO j=i,ndl
1095 kii(i,j)=h2*kdd(i,j)
1096 ENDDO
1097 ENDDO
1098 IF(isym/=1) THEN
1099 DO i=1,ndl
1100 DO j=i,ndl
1101 kii(j,i)=kii(i,j)
1102 ENDDO
1103 ENDDO
1104 ENDIF
1105C
1106 RETURN

◆ updkdd1()

subroutine updkdd1 ( integer ndi,
integer ndj,
kdd,
kii,
h,
integer isym )

Definition at line 1117 of file i2_imp1.F.

1118C-----------------------------------------------
1119C I m p l i c i t T y p e s
1120C-----------------------------------------------
1121#include "implicit_f.inc"
1122C-----------------------------------------------
1123C D u m m y A r g u m e n t s
1124C-----------------------------------------------
1125 INTEGER NDI,NDJ,ISYM
1126C REAL
1127 my_real
1128 . kdd(6,6),kii(6,6),h
1129C-----------------------------------------------
1130C L o c a l V a r i a b l e s
1131C-----------------------------------------------
1132 INTEGER I, J
1133C REAL
1134C------------------------------------
1135 DO i=1,6
1136 DO j=1,6
1137 kii(i,j) = zero
1138 ENDDO
1139 ENDDO
1140 IF(isym==1) THEN
1141 DO i=1,ndi
1142 DO j=1,ndj
1143 kii(i,j)=h*(kdd(i,j)+kdd(j,i))
1144 ENDDO
1145 ENDDO
1146 ELSE
1147 DO i=1,ndi
1148 DO j=1,ndj
1149 kii(i,j)=h*kdd(i,j)
1150 ENDDO
1151 ENDDO
1152 ENDIF
1153C
1154 RETURN

◆ updkdd2()

subroutine updkdd2 ( integer ndl,
kdd,
kii,
h1,
h2 )

Definition at line 1162 of file i2_imp1.F.

1163C-----------------------------------------------
1164C I m p l i c i t T y p e s
1165C-----------------------------------------------
1166#include "implicit_f.inc"
1167C-----------------------------------------------
1168C D u m m y A r g u m e n t s
1169C-----------------------------------------------
1170 INTEGER NDL,ISYM
1171C REAL
1172 my_real
1173 . kdd(6,6),kii(6,6),h1,h2
1174C-----------------------------------------------
1175C L o c a l V a r i a b l e s
1176C-----------------------------------------------
1177 INTEGER I, J
1178C REAL
1179C------------------------------------
1180 DO i=1,ndl
1181 DO j=1,ndl
1182 kii(i,j)=h1*kdd(i,j)+h2*kdd(j,i)
1183 ENDDO
1184 ENDDO
1185C
1186 RETURN

◆ upfr1_ii()

subroutine upfr1_ii ( rj,
rjt,
kii,
k )

Definition at line 857 of file i2_imp1.F.

858C-----------------------------------------------
859C I m p l i c i t T y p e s
860C-----------------------------------------------
861#include "implicit_f.inc"
862C-----------------------------------------------
863C D u m m y A r g u m e n t s
864C-----------------------------------------------
865 INTEGER NDL
866C REAL
867 my_real
868 . k(6),rj(3,3), rjt(3,3), kii(6)
869C-----------------------------------------------
870C L o c a l V a r i a b l e s
871C-----------------------------------------------
872 INTEGER I, J
873C REAL
874 my_real
875 . kdd(3,3)
876C------------------------------------
877 DO i=1,3
878 kdd(i,i)=kii(i)
879 ENDDO
880 kdd(1,2)=kii(4)
881 kdd(1,3)=kii(5)
882 kdd(2,3)=kii(6)
883 kdd(2,1)=kdd(1,2)
884 kdd(3,1)=kdd(1,3)
885 kdd(3,2)=kdd(2,3)
886C
887 DO i=1,3
888 j = i
889 k(i)=k(i)+rjt(1,i)*(kdd(1,1)*rjt(1,j)+
890 1 kdd(1,2)*rjt(2,j)+kdd(1,3)*rjt(3,j))+
891 2 rjt(2,i)*(kdd(1,2)*rjt(1,j)+
892 3 kdd(2,2)*rjt(2,j)+kdd(2,3)*rjt(3,j))+
893 4 rjt(3,i)*(kdd(1,3)*rjt(1,j)+
894 5 kdd(2,3)*rjt(2,j)+kdd(3,3)*rjt(3,j))
895 ENDDO
896C
897 RETURN