imp_fri.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "impl1_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "tabsiz_c.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	imp_fri (num_imp, ns_imp, ne_imp, ipari, intbuf_tab, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, iddl, ikc, ndof, inloc, nsrem, nsl, nbintc, intlist, x, ibfv, lj, skew, xframe, iskew, icodt, a, ud, lb, ifdis, nddl, urd, iddli, irbe3, lrbe3, frbe3, irbe2, lrbe2)
subroutine	imp_frfv (num_imp, ns_imp, ne_imp, ipari, intbuf_tab, iddl, ikc, ndof, nsrem, nsl, d_imp, dd, dr_imp, ddr, a, ar, ms, v, x, lb, nddl, ibfv, skew, xframe, irbe3, lrbe3, irbe2, lrbe2, de, nddl0, w_ddl)
subroutine	imp_frki (ipari, intbuf_tab, num_imp, ns_imp, ne_imp, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, iddl, ikc, ndof, inloc, nsrem, nsl, nbintc, intlist, x, ibfv, lj, skew, xframe, iskew, icodt, irbe3, lrbe3, frbe3, irbe2, lrbe2)
subroutine	imp_frsn (ipari, intbuf_tab, nbintc, intlist)
subroutine	imp_frii (ninter)
subroutine	imp_fr7i (ipari, intbuf_tab, num_imp, ns_imp, nsrem, nbintc, intlist)
subroutine	imp_frsl (nbintc, nsrem, nsl)
subroutine	tag_intm (jlt, ns_imp, ne_imp, irect, nsv, iloc, n_impn, nsn)
subroutine	tag_ints (nsl, iloc, n_impn)
subroutine	ini_ddfv (iddl, ikc, ndof, ipari, intbuf_tab, d, dr, dd, ddr, nsl, irbe3, lrbe3, irbe2, lrbe2)
subroutine	ini_dd0 (iddl, ikc, ndof, ipari, intbuf_tab, dd, ddr, nsl, irbe3, lrbe3, irbe2, lrbe2)
subroutine	ini_intm (iloc, n_imps, n_impn)
subroutine	dim_kinefr (npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, lns, lns2, lnss, lnss2, nk_m, irbe3, lns3, lnss3, irbe2, lrbe2, lnr2, lnrs2)
subroutine	ind_kinefr (npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, nss, nss2, nss_s, nss2_s, kn_m, ibfv, lj, iskew, icodt, irbe3, nss3, nss3_s, irbe2, lrbe2, nsr2, nrs2_s)
subroutine	iddl_int (nsl, iddl, ikc, ndof, iddlm, ipari, intbuf_tab, irbe3, lrbe3, frbe3, x, skew, irbe2, lrbe2)
subroutine	diag_int (nsl, ndof, ipari, intbuf_tab, kss, x, ibfv, skew, xframe, irbe3, lrbe3, irbe2, lrbe2)
subroutine	intabfr (nic, ic, n, intab)
subroutine	imp_diags (diag_k, ndof, nsl, ipari, intbuf_tab, irbe3, lrbe3, irbe2)
subroutine	imp_diagsn (diag_k, ndof, nsl, ipari, intbuf_tab, irbe3, lrbe3, irbe2)
subroutine	fr_matv (a, v, d, ms, x, dr, ar, ipari, intbuf_tab, ndof, num_imp, ns_imp, ne_imp, lx, nsrem, nsl, ibfv, skew, xframe, f, irbe3, lrbe3, irbe2, lrbe2)
subroutine	fr_matv_gpu (nsrem, nsl, lx, f, nindex)
subroutine	fr_u2d (ndof, lx, d, a, nsrem, nsl)
subroutine	fr_u2dd (d, dr, x, ipari, intbuf_tab, ndof, a, ar, lx, ibfv, skew, xframe, irbe3, lrbe3, irbe2, lrbe2)
subroutine	upd_fr (a, ar, x, ipari, intbuf_tab, ndof, ibfv, skew, xframe, irbe3, lrbe3, irbe2, lrbe2)
subroutine	fr_a2b (ndof, lb, a, nsl)
subroutine	fr_a2bd (ndof, ipari, intbuf_tab, lb, a, ar, irbe3, lrbe3, irbe2, lrbe2)
subroutine	dim_nrmax (nrow, fr_elem, iad_elem, nnmax)
subroutine	kin_nrmax0 (nnmax, nkmax, nrowk, icok, icokm, iloc, ink, fr_elem, iad_elem)
subroutine	kin_nrmax (nnmax, nkmax, nrowk, icok, icokm, iloc, ink, fr_elem, iad_elem)
subroutine	ind_nrmax (nft, nel, npn, npps, nnmax, nrow, icol, iad_rl, fr_icol, n_frnn)
subroutine	dim_fr_k (elbuf, iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, ndof, nnmax, inloc, fr_elem, iad_elem, n_fr, igeo, fr_i2m, iad_i2m, elbuf_tab)
subroutine	ind_fr_k (elbuf, iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, ndof, nnmax, inloc, fr_elem, iad_elem, n_fr, igeo, elbuf_tab)
subroutine	ind_nrfr (nft, nel, npn, npp, nnmax, nrow, icol, fr_elem, iad_elem, n_fr, icok)
subroutine	ind_fr_k0 (ndof, nrow, nnmax, icol, fr_elem, iad_elem, n_fr)
subroutine	ini_fr_k (elbuf, iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, ndof, nnmax, inloc, fr_elem, iad_elem, n_fr, igeo, fr_i2m, iad_i2m, elbuf_tab, nnrmax)
subroutine	upd_fr_k (iadk, jdik, ndof, ikc, iddl, inloc, fr_elem, iad_elem, nddl)
subroutine	fr_dlft (nddl, idlft0, idlft1)
subroutine	set_ikin2g (nkine, inloc)
subroutine	get_ikin2g (nkine, ink, iloc)
subroutine	zero_ikin2g (nkine, iloc)
subroutine	ind_kine_kp (nrowk, icok, icokm, nnmax, nkmax, nkine, ink, ikpat, iddl)
subroutine	tag_intm11 (jlt, ns_imp, ne_imp, irects, irectm, iloc, n_impn, nsn)
subroutine	mav_ltfr (v, w)
subroutine	mav_ltfr_gpu (v, w, nindex)
subroutine	ind_frkd (ipari, intbuf_tab, num_imp, ns_imp, ne_imp, iddl, ikc, ndof, nsrem, ind_imp)
subroutine	rowfr_dim (jlt, ns_imp, ne_imp, irect, nrow, nsn, nin)
subroutine	rowfr_dim11 (jlt, ns_imp, ne_imp, irectm, nrow, nsn, nin)
subroutine	rowfr_ind (jlt, ns_imp, ne_imp, irect, nrow, icol, nnmax, nsn, nin)
subroutine	rowfr_ind11 (jlt, ns_imp, ne_imp, irectm, nrow, icol, nnmax, nsn, nin)
subroutine	rowfr_dim24 (jlt, ns_imp, ne_imp, irect, nrow, nsn, nin, subtria, nvoisin)
subroutine	rowfr_ind24 (jlt, ns_imp, ne_imp, irect, nrow, icol, nnmax, nsn, nin, subtria, nvoisin)
subroutine	set_ind_fr (nsrem, iddl, ndof, nrow, icol, nnmax)
subroutine	reorder_fr (n, ic, iddl)
subroutine	jdifrtok (itok)
subroutine	imp_frkd (npby, lpby, itab, nrbyac, irbyac, ipari, intbuf_tab, nint2, iint2, iddl, ikc, ndof, inloc, nsrem, nsl, nbintc, intlist, x, ibfv, lj, skew, xframe, iskew, icodt, a, ud, lb, ifdis, urd, iddli, irbe3, lrbe3, frbe3, irbe2, lrbe2)
subroutine	ini_frkc (nsrem, nsl, ikc, ndof, iddl)
subroutine	dim_frkm (nsrem, nsl, ssize, rsize)
subroutine	ini_ksi (nsrem, ksi, iddl)
subroutine	upd_ksl (ipari, intbuf_tab, nint2, iint2, npby, lpby, itab, nrbyac, irbyac, x, ibfv, lj, skew, xframe, iskew, icodt, inloc, nsl, iad_m, iddl, ikc, ndof, iddlm, ud, a, b, kss, ksl_fr, ksi_fr, irbe3, lrbe3, frbe3, irbe2, lrbe2)
subroutine	assem_ksl (iddl, k_diag, k_lt, iadk, jdik, kss, nsl)
subroutine	assfr_kij (id, jd, iadk, jdik, k_lt, kij, nd)
subroutine	getfr_kij (id, jd, iadk, jdik, k_lt, kij, nk, nl)
subroutine	putfr_kij (id, jd, iadk, jdik, k_lt, kij, nk, nl)
subroutine	kin_ksl (ipari, intbuf_tab, nint2, iint2, npby, lpby, itab, nrbyac, irbyac, x, ibfv, lj, skew, xframe, iskew, icodt, ndof, ilocp, nsl, iad_m, irbe3, lrbe3, irbe2, lrbe2)
subroutine	doub_nrs (nsl, nnmax, nrs, icol, ilocp)
subroutine	ini_slnr (nsl, nnmax, nrs, icol, nz, ndof, iad_m)
subroutine	dim_kinfrk (npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, ia, ia2, nrs, lns, lns2, n_kine, irbe3, lrbe3, lns3, irbe2, lrbe2, lns4)
subroutine	ind_kinfrk (npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, ia, ia2, nss, nss2, n_kine, ibfv, lj, iskew, icodt, nrs, icol, nnmax, irbe3, lrbe3, lns3, irbe2, lrbe2, lns4)
subroutine	get_iad (iad_m, iad_s, jdi_s, nm, is, j, nrj, ndof, iad)
logical function	ikincf (i)
subroutine	dim_frkm1 (nsrem, nsl, iddl, ikc, ndof, nf_si, nf_sl, lsi, lsl, msi, msl)
subroutine	tra_frkm (nsl, iddl, ikc, ndof, iad_m, ksi, ksl, ikcsl)
subroutine	kin_kml (ipari, intbuf_tab, nint2, iint2, npby, lpby, itab, nrbyac, irbyac, x, ibfv, lj, skew, xframe, iskew, icodt, ndof, ilocp, nsrem, iddl, ikc, iad_m, nml, irbe3, lrbe3, irbe2, lrbe2)
subroutine	tag_intml (nsrem, iloc, n_impn, iddl, ikc, ndof, lsi)
subroutine	scom_frk (ks11, kr11, ssize, rsize)
subroutine	scom_frk1 (ks11, kr11, nfacs, nfacr, ikcs, ikcr)
subroutine	upd_kml (ipari, intbuf_tab, nint2, iint2, npby, lpby, itab, nrbyac, irbyac, x, ibfv, lj, skew, xframe, iskew, icodt, inloc, nsl, iad_m, iddl, ikc, ndof, iddlm, ud, a, ksl, ksi, nsrem, nf_si, iddli, irbe3, lrbe3, frbe3, irbe2, lrbe2)
subroutine	imp_frkm (nsrem, ikinm, ikcsi, ikc, ndof, iddl, iddlm, inloc, iad_m, frk_si, frk_sl, nf_si, iad_mld, iddli)
subroutine	dim_fvn (ndof, iddl, ikc, inloc, nfv)
subroutine	ind_fvn (ndof, iddl, ikc, inloc, nfv)
subroutine	imp_fvkss (kss, iddl, iddlm, ikc, nsl, d_imp, lb, nfv, udsl, inloc, ndof)
subroutine	ini_frud (nsrem, nsl, nfv, ifvsi, ifvsl, nf_si, nf_sl, lvsi)
subroutine	scom_frud (uds, udr, nf_s, nf_r, ikcs, ikcr)
subroutine	imp_fvksl (iddl, iddlm, ikc, ifvsi, nf_si, ksi, lb, nsrem, udsi)
subroutine	imp_fvksm (nj, iddl, iddlm, ikc, uds, ksm, lb)
subroutine	imp_fvkm (kfr_si, kfr_sl, iddl, ndof, ikc, inloc, iad_m, nsrem, nsl, ud0, fdsi, nf_si, nfv, nfd, iddli)
subroutine	ini_frfd (nsrem, nfv, ikcsi, nf_si, fdsi)
subroutine	cp_slnr (iad_cp, jdi_cp, nsl, nz)
subroutine	ind_sld (nsl, ndof, kss)
subroutine	imp_frks (nsl, iddl, ikc, ndof, iddlm, kss, iad_sld)
subroutine	cp_iadd (nsl, nsrem, iad_sld, iad_mld)
subroutine	nddli_frb (ndof, ikc, iddl, ndofi, nddlifb, fr_elem, iad_elem)
subroutine	ndofi_nsl (nsl, nddli, ndofi)
subroutine	getnddli_g (npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, ndofi, ndof, ikc, iddl, fr_elem, iad_elem, nddli, nsl, nddlig, irbe3, lrbe3, irbe2, lrbe2)
subroutine	nddli_ns (npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, ndofi, ndof, ikc, iddl, nsl, nddli, nddlins, irbe3, lrbe3, irbe2, lrbe2)
subroutine	spc_fr_k (iadk, jdik, ndof, iddl, fr_elem, iad_elem)

Function/Subroutine Documentation

assem_ksl()

subroutine assem_ksl	(	integer, dimension(*)	iddl,
			k_diag,
			k_lt,
		integer, dimension(*)	iadk,
		integer, dimension(*)	jdik,
			kss,
		integer	nsl )

Definition at line 6354 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer
     .        iddl(*)   ,iadk(*)  ,jdik(*),nsl
      my_real
     .   k_diag(*) ,k_lt(*)   ,kss(6,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, JLT , NFT ,ND ,J,N0,JLT_NEW,IS
      my_real
     .     k11(3,3,mvsiz),off(mvsiz)
C------------------------------------
       nd = 3
       DO nft = 0 , nsl - 1 , nvsiz
         jlt = min( nvsiz, nsl - nft )
         jlt_new = 0
        DO i = 1 , jlt
         is = nft+i
         IF (ikc_si(is)==0) THEN
          jlt_new = jlt_new + 1
          DO j = 1 , 3
           k11(j,j,jlt_new) = kss(j,is)
          ENDDO
          k11(1,2,jlt_new) = kss(4,is)
          k11(1,3,jlt_new) = kss(5,is)
          k11(2,3,jlt_new) = kss(6,is)
          off(jlt_new) = one
         ENDIF
        ENDDO
        jlt = jlt_new
        CALL assem_kii(isl(nft+1),jlt,iddl,iadk,k_diag,k_lt,k11,nd,off)
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

assfr_kij()

subroutine assfr_kij	(	integer	id,
		integer	jd,
		integer, dimension(*)	iadk,
		integer, dimension(*)	jdik,
			k_lt,
			kij,
		integer	nd )

Definition at line 6412 of file imp_fri.F.

C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ND
      INTEGER ID,JD,IADK(*),JDIK(*)
C     REAL
      my_real
     .   k_lt(*)   ,kij(nd,nd)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,JDL,L,JJ
C----6---------------------------------------------------------------7---------8
         DO k=1,nd
          jdl= -1
          DO jj = iadk(id+k),iadk(id+1+k)-1
C-------- Find l'Address in LT -----
           IF (jdik(jj)==(jd+1)) THEN
            jdl = jj-1
            GOTO 300
           ENDIF
          ENDDO
 300      CONTINUE
         IF (jdl>=0) THEN
          DO l=1,nd
           k_lt(jdl+l) = k_lt(jdl+l) + kij(k,l)
          ENDDO
         ELSE
         ENDIF
         ENDDO
C
C----6---------------------------------------------------------------7---------8
      RETURN

cp_iadd()

subroutine cp_iadd	(	integer	nsl,
		integer	nsrem,
		integer, dimension(*)	iad_sld,
		integer, dimension(*)	iad_mld )

Definition at line 9809 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSL ,NSREM,IAD_SLD(*),IAD_MLD(*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER L
C----------------------------
       l = nspmd + 1
       IF (nsl >0) CALL cp_int(l,iad_sld,iad_sl)
       IF (nsrem >0) CALL cp_int(l,iad_mld,iad_srem)
C----6---------------------------------------------------------------7---------8
      RETURN

cp_slnr()

subroutine cp_slnr	(	integer, dimension(*)	iad_cp,
		integer, dimension(*)	jdi_cp,
		integer	nsl,
		integer	nz )

Definition at line 9368 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSL,NZ ,IAD_CP(*),JDI_CP(*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
C----------------------------
       CALL cp_int((nsl+1),iad_slnr,iad_cp)
       CALL cp_int(nz,jdi_slnr,jdi_cp)
C
       IF(ALLOCATED(iml)) DEALLOCATE(iml)
       ALLOCATE(iml(nsl))
       CALL cp_int(nsl,isl,iml)
C----6---------------------------------------------------------------7---------8
      RETURN

diag_int()

subroutine diag_int	(	integer	nsl,
		integer, dimension(*)	ndof,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
			kss,
			x,
		integer, dimension(nifv,*)	ibfv,
			skew,
			xframe,
		integer, dimension(nrbe3l,*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer, dimension(nrbe2l,*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 1836 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
      USE imp_rwl
      USE imp_aspc
      USE intbufdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER   NSL  , NDOF(*) ,IBFV(NIFV,*)
      INTEGER  IPARI(NPARI,*),IRBE3(NRBE3L,*),LRBE3(*),
     .         IRBE2(NRBE2L,*),LRBE2(*)
      my_real
     .  kss(6,*),x(3,*),skew(lskew,*),xframe(nxframe,*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I,ID,N,J,NDD,I1,IS,NS,ILEV,JT(3),JR(3)
      INTEGER M,NSN,JI,L,NNOD,NJ,NL,NI,IROT,IRAD
      INTEGER IERROR1,IERROR2,J1,ISK,IFM,K1,K2,K3,ICT,NN,IAD,IADS,K
      my_real
     .  xs,ys,zs,kii(3,3),kjj(6),ej(3),s,kdd(6,6),kmm(6)
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
      IF (nrb_frs>0) THEN
       IF(ALLOCATED(diag_mr)) DEALLOCATE(diag_mr)
       ALLOCATE(diag_mr(6,nrb_frs),stat=ierror1)
       DO i1 = 1, nrb_frs
        DO j = 1, 6
          diag_mr(j,i1)=zero
        ENDDO
       ENDDO
      ENDIF
      IF (ni2_frs>0) THEN
       IF(ALLOCATED(diag_m2)) DEALLOCATE(diag_m2)
       ALLOCATE(diag_m2(6,4,ni2_frs),stat=ierror2)
       DO i1=1,ni2_frs
        DO j = 1, 6
        DO m = 1, 4
         diag_m2(j,m,i1)=zero
        ENDDO
        ENDDO
       ENDDO
      ENDIF
      IF (nrbe3_frs>0) THEN
C------RBE3---
        iads=0
       DO i1=1,nrbe3_frs
         i = ifrs3_s(i1)
         n=ifrs3(i)
         iads=max(iads,irbe3(5,n))
        ENDDO
       IF(ALLOCATED(diag_m3)) DEALLOCATE(diag_m3)
       ALLOCATE(diag_m3(6,iads,nrbe3_frs),stat=ierror1)
         diag_m3=zero
      ENDIF
C-------------RBE2----------------------
      IF (nrbe2_frs>0) THEN
       IF(ALLOCATED(diag_mr2)) DEALLOCATE(diag_mr2)
       ALLOCATE(diag_mr2(6,nrbe2_frs),stat=ierror1)
       diag_mr2=zero
      ENDIF
C--------local secondary node-, first independent----
       DO i = 1, nsl
        n = isl(i)
        DO j = 1, min(3,ndof(n))
         id = iddsl(j,i)
         IF (id>0) diag_s(j,i)=kss(j,i)
        ENDDO
       ENDDO
C
        DO i1=1,ni2_frs
         i = ifrs2_s(i1)
         n=ifrs2(1,i)
         ni=ifrs2(2,i)
         ji=ipari(1,n)
         nsn=ipari(5,n)
         ns=intbuf_tab(n)%NSV(ni)
         DO is = 1, nsl
         IF (isl(is)==ns) THEN
          ilev  =ipari(20,n)
          IF (ilev==1) THEN
           CALL i2_frup1(x   ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA ,intbuf_tab(n)%NSV ,
     1               intbuf_tab(n)%IRTLM ,ns  ,kss(1,is),diag_m2(1,1,i1))
          ELSE
           CALL i2_frup0(x   ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS ,intbuf_tab(n)%NSV ,
     1              intbuf_tab(n)%IRTLM,ns,ndof,kss(1,is),diag_m2(1,1,i1))
          ENDIF
         ENDIF
         ENDDO
        ENDDO
C------------RBE2--------------
        DO i1 = 1, nrbe2_frs
         i = ifrs4_s(i1)
         n = ifrs4(1,i)
         m = irbe2(3,n)
         ns = ifrs4(2,i)
         ict = irbe2(4,n)
         isk = irbe2(7,n)
             irad =irbe2(11,n)
C--------remove ICR---
         ict =(ict/512)*512
         CALL prerbe2fr(ict    ,jt  ,jr   )
         DO k=1,6
          DO j=1,6
           kdd(k,j) = zero
          ENDDO
              kmm(k)=  zero
         ENDDO
         DO is = 1, nsl
         IF (isl(is)==ns) THEN
          DO j=1,3
           kdd(j,j) = kss(j,is)
          ENDDO
          kdd(1,2)=kss(4,is)
          kdd(1,3)=kss(5,is)
          kdd(2,3)=kss(6,is)
          kdd(2,1)=kdd(1,2)
          kdd(3,1)=kdd(1,3)
          kdd(3,2)=kdd(2,3)
          CALL rbe2_impkd(m     ,ns    ,x     ,isk     ,jt     ,
     2                  jr     ,ndof  ,skew(1,isk),kdd    ,kmm ,
     3                  diag_s(1,is),irad  )
          DO j = 1 , ndof(m)
           diag_mr2(j,i1) = diag_mr2(j,i1) + kmm(j)
          END DO
         END IF
         END DO
        END DO
C------RBE3---
        iads=1
        DO i1=1,nrbe3_frs
         i = ifrs3_s(i1)
         n=ifrs3(i)
         ni=irbe3(3,n)
         nnod=irbe3(5,n)
         irot=irbe3(6,n)
         iad=irbe3(1,n)
         DO is = 1, nsl
         IF (isl(is)==ni) THEN
C-------
           CALL prerbe3fr(irbe3 ,n    ,jt  ,jr   )
           CALL rbe3_frupd(nnod   ,lrbe3(iad+1) ,frcdi(iads),
     1                     mrcdi(iads),ndof  ,jt   ,irot  ,
     2                     kss(1,is),diag_m3(1,1,i1))
         ENDIF
         ENDDO
         iads=iads+nnod
        ENDDO
C------RBODY---
        DO i1 = 1, nrb_frs
         i = ifrsr_s(i1)
         m = ifrsr(1,i)
         n = ifrsr(2,i)
         DO is = 1, nsl
         IF (isl(is)==n) THEN
          xs=x(1,n)-x(1,m)
          ys=x(2,n)-x(2,m)
          zs=x(3,n)-x(3,m)
          CALL updfr_rb(xs,ys,zs,kss(1,is),diag_mr(1,i1))
         ENDIF
         ENDDO
        ENDDO
      DO i1 = 1,nbc_fr
        n = ibc_fr(1,i1)
        isk= ibc_fr(2,i1)
        ict= ibc_fr(3,i1)
         DO is = 1, nsl
         IF (isl(is)==n) THEN
          kii(1,1)=kss(1,is)
          kii(2,2)=kss(2,is)
          kii(3,3)=kss(3,is)
          kii(1,2)=kss(4,is)
          kii(1,3)=kss(5,is)
          kii(2,3)=kss(6,is)
          kii(2,1)=kii(1,2)
          kii(3,1)=kii(1,3)
          kii(3,2)=kii(2,3)
          CALL bcl_impkd(ict  ,isk   ,skew  ,kii   ,diag_s(1,is))
         ENDIF
         ENDDO
      ENDDO
C-------AUTOSPC
      DO i1=1,nspc_fr
        n = ispc_fr(i1)
        i = in_spc(n)
            iad = 6*(n-1)+1
            nn = ic_spc(n)
         DO is = 1, nsl
         IF (isl(is)==i) THEN
          kii(1,1)=kss(1,is)
          kii(2,2)=kss(2,is)
          kii(3,3)=kss(3,is)
          kii(1,2)=kss(4,is)
          kii(1,3)=kss(5,is)
          kii(2,3)=kss(6,is)
          kii(2,1)=kii(1,2)
          kii(3,1)=kii(1,3)
          kii(3,2)=kii(2,3)
          IF (nn==1) THEN
           ej(1)=skew_spc(iad)
           ej(2)=skew_spc(iad+1)
           ej(3)=skew_spc(iad+2)
           CALL l_dir(ej,j)
           CALL fv_updkd(ej    ,j    ,kii   ,diag_s(1,is))
          ELSEIF (nn==2) THEN
           CALL fv_updkd2(skew_spc(iad),skew_spc(iad+3),kii,
     .                    diag_s(1,is))
          END IF
         ENDIF
         ENDDO
      ENDDO
      DO i1 = 1,nfx_fr
        n = ifx_fr(1,i1)
        j1= ifx_fr(2,i1)
          i=iabs(ibfv(1,n))
          isk=ibfv(2,n)/10
          ifm = ibfv(9,n)
          j=ibfv(2,n)
          IF (ifm<=1) j=j-10*isk
          k1=3*j-2
          k2=3*j-1
          k3=3*j
            IF (isk>1) THEN
              ej(1)=skew(k1,isk)
              ej(2)=skew(k2,isk)
              ej(3)=skew(k3,isk)
            ELSE
              ej(1)=xframe(k1,ifm)
              ej(2)=xframe(k2,ifm)
              ej(3)=xframe(k3,ifm)
            ENDIF
         DO is = 1, nsl
         IF (isl(is)==i) THEN
          kii(1,1)=kss(1,is)
          kii(2,2)=kss(2,is)
          kii(3,3)=kss(3,is)
          kii(1,2)=kss(4,is)
          kii(1,3)=kss(5,is)
          kii(2,3)=kss(6,is)
          kii(2,1)=kii(1,2)
          kii(3,1)=kii(1,3)
          kii(3,2)=kii(2,3)
          s = one/ej(j1)
          DO nn =1,3
           ej(nn) = ej(nn)*s
          ENDDO
          CALL fv_updkd(ej    ,j1    ,kii   ,diag_s(1,is))
         ENDIF
         ENDDO
      ENDDO
      DO i1 = 1,nrw_fr
        i = irw_fr(i1)
        n = in_rwl(i)
         DO is = 1, nsl
         IF (isl(is)==n) THEN
          kii(1,1)=kss(1,is)
          kii(2,2)=kss(2,is)
          kii(3,3)=kss(3,is)
          kii(1,2)=kss(4,is)
          kii(1,3)=kss(5,is)
          kii(2,3)=kss(6,is)
          kii(2,1)=kii(1,2)
          kii(3,1)=kii(1,3)
          kii(3,2)=kii(2,3)
          ej(1)=nor_rwl(1,i)
          ej(2)=nor_rwl(2,i)
          ej(3)=nor_rwl(3,i)
          CALL l_dir(ej,j1)
          CALL fv_updkd(ej    ,j1    ,kii   ,diag_s(1,is))
         ENDIF
         ENDDO
      ENDDO
C
      RETURN

dim_fr_k()

subroutine dim_fr_k	(		elbuf,
		integer, dimension(nparg,*)	iparg,
		integer, dimension(nixs,*)	ixs,
		integer, dimension(nixq,*)	ixq,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(nixt,*)	ixt,
		integer, dimension(nixp,*)	ixp,
		integer, dimension(nixr,*)	ixr,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(4,*)	ixtg1,
		integer, dimension(6,*)	ixs10,
		integer, dimension(12,*)	ixs20,
		integer, dimension(8,*)	ixs16,
		integer, dimension(*)	ndof,
		integer	nnmax,
		integer, dimension(*)	inloc,
		integer, dimension(*)	fr_elem,
		integer, dimension(2,*)	iad_elem,
		integer	n_fr,
		integer, dimension(*)	igeo,
		integer, dimension(*)	fr_i2m,
		integer, dimension(*)	iad_i2m,
		type (elbuf_struct_), dimension(ngroup)	elbuf_tab )

Definition at line 3334 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
      USE elbufdef_mod            
      use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARG(NPARG,*),NNMAX,N_FR ,NDOF(*),IGEO(*),
     .        FR_I2M(*),IAD_I2M(*)
      integer
     .   ixs(nixs,*),ixq(nixq,*),ixc(nixc,*), ixt(nixt,*),ixp(nixp,*),
     .   ixr(nixr,*), ixtg(nixtg,*),ixs10(6,*),ixs20(12,*),
     .   ixs16(8,*),ixtg1(4,*),inloc(*),fr_elem(*),iad_elem(2,*)
C     REAL
      my_real
     .   elbuf(*)
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
C-----------------------------------------------
C   External function
C-----------------------------------------------
      LOGICAL INTAB
      EXTERNAL intab
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NK,ICOL(NNMAX,N_FR),NROW(N_FR),IP,JLT,NFT,
     .        FR_NROW(N_FR),L,IAD_S(NSPMD+1),IAD_R(NSPMD+1),NF1,
     .        IERROR1,IERROR2,IERROR3,LS,LR,SSIZE,RSIZE,J0,NN,NR,NL,NRN
C   ----  creer NROW,ICOL aux front.---------
      IF (n_fr <=0 .OR. nnmax <=0 ) THEN
       nddlfr=0
       nddlfrb=0
       ndfrmax=0
       n_frnn=0
c      RETURN
      ENDIF
      DO n =1,numnod
       inloc(n)=0
      ENDDO
      DO n =1,n_fr
       nrow(n)=0
      ENDDO
      DO ip =1,nspmd
       jlt=iad_elem(1,ip+1)-iad_elem(1,ip)
       nft=iad_elem(1,ip)-1
       nf1=min(n_fr,nft+1)
       DO j=1,jlt
        nk=j+nft
        n=fr_elem(nk)
        inloc(n) = j
       ENDDO
       CALL dim_elemsp(
     1    elbuf     ,iparg     ,ixs       ,ixq       ,ixc       ,
     2    ixt       ,ixp       ,ixr       ,ixtg      ,ixtg1     ,
     3    ixs10     ,ixs20     ,ixs16     ,nrow(nf1),
     4    inloc     ,nnmax     ,icol(1,nf1),igeo   ,elbuf_tab )
       DO j=1,jlt
        nk=j+nft
        n=fr_elem(nk)
        inloc(n) = 0
       ENDDO
      ENDDO
       CALL spmd_nrow(nrow,fr_nrow,iad_elem,n_fr)
C------ prepare comm .-----
       ls=1
       lr=1
       iad_s(1)=ls
       iad_r(1)=lr
       DO ip =1,nspmd
        DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
         ls=ls+nrow(nk)
         lr=lr+fr_nrow(nk)
        ENDDO
        iad_s(ip+1)=ls
        iad_r(ip+1)=lr
       ENDDO
       IF ((ls+lr)>2) THEN
        ssize=iad_s(nspmd+1)-1
        rsize=iad_r(nspmd+1)-1
C
        CALL spmd_icol(
     1   iad_s    ,iad_r    ,nnmax    ,icol     ,nrow     ,
     2   fr_nrow  ,iad_elem ,fr_elem  ,ssize    ,rsize    )
       ENDIF
C
       DO ip =1,nspmd
        nr=iad_i2m(ip+1)-iad_i2m(ip)
        IF (nr>0) THEN
         jlt=iad_elem(1,ip+1)-iad_elem(1,ip)
         nft=iad_elem(1,ip)-1
         DO j=1,jlt
          nk=j+nft
          n=fr_elem(nk)
          inloc(n) = j
         ENDDO
         DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
          n=fr_elem(nk)
          IF (intab(nr,fr_i2m(iad_i2m(ip)),n)) THEN
           DO l=iad_i2m(ip),iad_i2m(ip+1)-1
            nn=fr_i2m(l)
            nl=inloc(nn)
            IF (nl>0.AND.nn/=n) THEN
                 nrn = max(nrow(nk),fr_nrow(nk))
                 CALL reorder_a(nrn,icol(1,nk),nl)
                  IF (nrn>max(nrow(nk),fr_nrow(nk))) fr_nrow(nk)=nrn
            ENDIF
           ENDDO
          ENDIF
         ENDDO
C
         DO j=1,jlt
          nk=j+nft
          n=fr_elem(nk)
          inloc(n) = 0
         ENDDO
        ENDIF !IF (NR>0)
       ENDDO !IP =1,NSPMD
       nrmax = 0
       IF(ALLOCATED(iad_rl)) DEALLOCATE(iad_rl)
       ALLOCATE(iad_rl(n_fr+1),stat=ierror3)
       lr=1
       iad_rl(1)=lr
       DO ip =1,nspmd
        DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
         IF (nrow(nk)<fr_nrow(nk)) THEN
          nr=fr_nrow(nk)-nrow(nk)
          lr=lr+nr
          nrmax = max(nrmax,nr)
         ENDIF
         iad_rl(nk+1)=lr
        ENDDO
       ENDDO
       n_frnn=lr-1
C------- First it is local ------------
       IF (n_frnn>0) THEN
        IF(ALLOCATED(fr_icol)) DEALLOCATE(fr_icol)
        ALLOCATE(fr_icol(lr),stat=ierror2)
        DO ip =1,nspmd
         DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
           j0=nrow(nk)-iad_rl(nk)+1
           DO l=iad_rl(nk),iad_rl(nk+1)-1
            j=l+j0
            fr_icol(l)=icol(j,nk)
           ENDDO
         ENDDO
        ENDDO
       ENDIF
C------definit IFRLOC (global)for ind_glob_k---
       IF(ALLOCATED(ifrloc)) DEALLOCATE(ifrloc)
       ALLOCATE(ifrloc(n_fr),stat=ierror1)
       nn=0
       DO n =1,numnod
        inloc(n)=0
       ENDDO
       DO ip =1,nspmd
        DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
         n=fr_elem(nk)
         IF (inloc(n)==0) THEN
          nn = nn +1
          inloc(n)=nn
          ifrloc(nk)=nn
          icol(1,nn)=nk
         ELSE
          ifrloc(nk)=-icol(1,inloc(n))
          IF (nrow(nk)<fr_nrow(nk))nrmax=nrmax+fr_nrow(nk)-nrow(nk)
         ENDIF
        ENDDO
       ENDDO
C
      RETURN

dim_frkm()

subroutine dim_frkm	(	integer	nsrem,
		integer	nsl,
		integer	ssize,
		integer	rsize )

Definition at line 5636 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSREM  ,NSL ,SSIZE,RSIZE
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,ID
C--------------------------------------------
C   ----- Returns KSL, KSM and receives KSS, KSLM A CONDENSER
        ssize = 0
        DO i = 1, nsrem
         IF (ikc_si(i)>0) THEN
C   -----number of [K}3x3--------
          ikc_si(i) = iad_sinr(i+1)-iad_sinr(i)
          ssize = ssize + ikc_si(i)
         ENDIF
        ENDDO
        CALL spmd_isr(iad_srem,iad_sl,ikc_si,ikc_sl,nsrem,nsl  )
C
        rsize = 0
        DO i = 1, nsl
         IF (ikc_sl(i)>0) rsize = rsize + ikc_sl(i)
        ENDDO
C
      RETURN

dim_frkm1()

subroutine dim_frkm1	(	integer	nsrem,
		integer	nsl,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer, dimension(*)	nf_si,
		integer, dimension(*)	nf_sl,
		integer	lsi,
		integer	lsl,
		integer	msi,
		integer	msl )

Definition at line 7216 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSREM  ,NSL ,LSI,LSL ,NF_SL(*),NF_SI(*),
     .        IDDL(*) ,IKC(*) ,NDOF(*)  ,MSI,MSL
C     REAL
C-----------------------------------------------
C   External function
C-----------------------------------------------
      LOGICAL IKINCF
      EXTERNAL ikincf
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,ID,NFAC,NJ
C----------NF_SL : new nm times of [K]3x3- of dependant---------------------------
        DO i = 1, nsl
        IF (ikc_sl(i)>0) THEN
         n = isl(i)
         id = iddl(n)
         IF (ndof(n)==0.OR.(ikc(id+1)/=0.AND.ikc(id+2)/=0
     .       .AND.ikc(id+3)/=0)) THEN
          nfac=0
          DO j=iad_slnr(i),iad_slnr(i+1)-1
           nj = jdi_slnr(j)
           id = iddl(nj)
           IF (ikincf(ikc(id+1)).OR.ikincf(ikc(id+2)).OR.
     .         ikincf(ikc(id+3)))
     .      nfac = nfac +1
           IF (ndof(nj)==6) THEN
           IF (ikincf(ikc(id+4)).OR.ikincf(ikc(id+5)).OR.
     .         ikincf(ikc(id+6)))
     .      nfac = nfac +1
           ENDIF
          ENDDO
Ctmp special case of d_imp in all directions
          IF (ndof(n)>0.AND.iad_slnr(i)==iad_slnr(i+1))nfac = 1
         ELSE
          nfac = 1
         ENDIF
         nf_sl(i) = nfac
        ELSE
         nf_sl(i) = 0
        ENDIF
        ENDDO
C
        CALL spmd_isr(iad_sl,iad_srem,nf_sl,nf_si,nsl ,nsrem )
C   -----new nb. [k] modifie SL,SI---for com---ISL for IKC(3,M)
        msl = 0
        lsl = 0
        DO i = 1, nsl
         IF (ikc_sl(i)>0) THEN
           msl = msl + nf_sl(i)
           lsl = lsl + ikc_sl(i)*nf_sl(i)
         ENDIF
        ENDDO
c
        msi = 0
        lsi = 0
        DO i = 1, nsrem
         IF (ikc_si(i)>0) THEN
           msi = msi +  nf_si(i)
           lsi = lsi + ikc_si(i)*nf_si(i)
         ENDIF
        ENDDO
C
      RETURN

dim_fvn()

subroutine dim_fvn	(	integer, dimension(*)	ndof,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	inloc,
		integer	nfv )

Definition at line 8694 of file imp_fri.F.

C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NFV, INLOC(*),NDOF(*),IKC(*),IDDL(*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer
     .        i,j,k,n,nd,ns
C----------------------------
      nfv=0
C--------imposed velocity---------------
       DO n = 1, numnod
C--------local second node-----
        IF (inloc(n)>0) THEN
         ns = 0
         DO j = 1, min(3,ndof(n))
          nd = iddl(n)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) ns=1
         ENDDO
         IF (ns==1) nfv = nfv +1
        ENDIF
       ENDDO
C
C----6---------------------------------------------------------------7---------8
      RETURN

dim_kinefr()

subroutine dim_kinefr	(	integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	lpby,
		integer, dimension(*)	itab,
		integer	nrbyac,
		integer, dimension(*)	irbyac,
		integer	nint2,
		integer, dimension(*)	iint2,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(*)	inloc,
		integer	lns,
		integer	lns2,
		integer	lnss,
		integer	lnss2,
		integer	nk_m,
		integer, dimension(nrbe3l,*)	irbe3,
		integer	lns3,
		integer	lnss3,
		integer, dimension(nrbe2l,*)	irbe2,
		integer, dimension(*)	lrbe2,
		integer	lnr2,
		integer	lnrs2 )

Definition at line 1247 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s 
C-----------------------------------------------
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C      INTEGER NNMAX,NKMAX
      INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
     .        NINT2,IINT2(*),IPARI(NPARI,*)
      integer
     .   inloc(*),lns  ,lns2,lnss ,lnss2,nk_m,
     .   irbe3(nrbe3l,*),lns3 ,lnss3 ,irbe2(nrbe2l,*),lrbe2(*),
     .   lnr2      ,lnrs2
C     REAL
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer
     .        i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,
     .        ji,kfi,ns,iad
C----------------------------
      lns2=0
      lnss2=0
      DO j=1,nint2
       n=iint2(j)
       nsn = ipari(5,n)
       ji=ipari(1,n)
       DO i=1,nsn
        ni=intbuf_tab(n)%NSV(i)
        IF (inloc(ni)>0) THEN
         lns2=lns2+1
         IF (inloc(ni)<=nk_m) lnss2=lnss2+1
        ENDIF
       ENDDO
      ENDDO
C--------RBE3--------------------
      lns3=0
      lnss3=0
      DO n=1,nrbe3
       ni = irbe3(3,n)
       IF (ni==0) cycle
       IF (inloc(ni)>0) THEN
         lns3=lns3+1
         IF (inloc(ni)<=nk_m) lnss3=lnss3+1
       ENDIF
      ENDDO
CC-----active rigid body main nodes------
      lns=0
      lnss=0
      DO j=1,nrbyac
       n=irbyac(j)
       k=irbyac(j+nrbykin)
       m  =npby(1,n)
       nsn  =npby(2,n)
        DO i=1,nsn
         id = i+k
         ni=lpby(id)
         IF (inloc(ni)>0) THEN
          lns=lns+1
          IF (inloc(ni)<=nk_m) lnss=lnss+1
          IF (inloc(m)==0) inloc(m) = 1
         ENDIF
       ENDDO
      ENDDO
C--------RBE2--------------------
      lnr2=0
      lnrs2=0
      DO n=1,nrbe2
       iad = irbe2(1,n)
       m  = irbe2(3,n)
       nsn  =irbe2(5,n)
        DO i=1,nsn
         id = iad+i
         ni=lrbe2(id)
         IF (inloc(ni)>0) THEN
          lnr2=lnr2+1
          IF (inloc(ni)<=nk_m) lnrs2=lnrs2+1
          IF (inloc(m)==0) inloc(m) = 2
         ENDIF
       ENDDO
      ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

dim_kinfrk()

subroutine dim_kinfrk	(	integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	lpby,
		integer, dimension(*)	itab,
		integer	nrbyac,
		integer, dimension(*)	irbyac,
		integer	nint2,
		integer, dimension(*)	iint2,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(*)	inloc,
		integer, dimension(*)	ia,
		integer, dimension(*)	ia2,
		integer, dimension(*)	nrs,
		integer	lns,
		integer	lns2,
		integer	n_kine,
		integer, dimension(nrbe3l,*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer	lns3,
		integer, dimension(nrbe2l,*)	irbe2,
		integer, dimension(*)	lrbe2,
		integer	lns4 )

Definition at line 6748 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s 
C-----------------------------------------------
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C      INTEGER NNMAX,NKMAX
      INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
     .        NINT2,IINT2(*),IPARI(NPARI,*),
     .        IRBE3(NRBE3L,*),LRBE3(*)     ,LNS3   ,
     .        IRBE2(NRBE2L,*),LRBE2(*)     ,LNS4
      integer
     .   inloc(*),nrs(*),lns  ,lns2,n_kine,ia(*),ia2(*)
C     REAL
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer
     .        i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,
     .        ji,ns,nnod,iad
C----------------------------
      lns2=0
C--------int2---------
      DO j=1,nint2
       n=iint2(j)
       ia2(j)=0
       nsn = ipari(5,n)
       ji=ipari(1,n)
       DO i=1,nsn
         ni=intbuf_tab(n)%NSV(i)
        IF (inloc(ni)>0) THEN
         l=intbuf_tab(n)%IRTLM(ni)
         nl=4*(l-1)
         IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
          nnod=3
         ELSE
          nnod=4
         ENDIF
         nk = inloc(ni)
         IF (nk>n_kine ) nk = nk - n_kine
         nrs(nk) = nrs(nk)+nnod
         ia2(j) = n
         lns2 = lns2+1
C------- if Mi is also dependent ------
          DO k =1,nnod
           nj=intbuf_tab(n)%IRECTM(nl+k)
           IF (inloc(nj)==0) inloc(nj) = n_kine + inloc(ni)
          ENDDO
        ENDIF
       ENDDO
      ENDDO
C
      lns3=0
C--------RBE3---------
      DO i=1,nrbe3
        iad=irbe3(1,i)
        ni=irbe3(3,i)
        nnod=irbe3(5,i)
        IF (ni==0) cycle
        IF (inloc(ni)>0) THEN
         nk = inloc(ni)
         IF (nk>n_kine ) nk = nk - n_kine
         nrs(nk) = nrs(nk)+nnod
         lns3 = lns3+1
C------- if Mi is also dependent ------
          DO k =1,nnod
           nj = lrbe3(iad+k)
           IF (inloc(nj)==0) inloc(nj) = n_kine + inloc(ni)
          ENDDO
        ENDIF
      ENDDO
C
      lns=0
C-----active rigid body main nodes------
      DO j=1,nrbyac
       ia(j)=0
       n=irbyac(j)
       k=irbyac(j+nrbykin)
       m  =npby(1,n)
       nsn  =npby(2,n)
        DO i=1,nsn
         id = i+k
         ni=lpby(id)
         nk = inloc(ni)
         IF (nk>n_kine) nk = inloc(ni)-n_kine
         IF (nk>0) THEN
          nrs(nk) = nrs(nk)+1
          ia(j)=n
          lns = lns+1
          IF (inloc(m)==0) inloc(m) = n_kine + inloc(ni)
         ENDIF
       ENDDO
      ENDDO
C-----RBE2------
      lns4=0
      DO j=1,nrbe2
       iad=irbe2(1,j)
       m  =irbe2(3,j)
       nsn =irbe2(5,j)
        DO i=1,nsn
         id = i+iad
         ni=lrbe2(id)
         nk = inloc(ni)
         IF (nk>n_kine) nk = inloc(ni)-n_kine
         IF (nk>0) THEN
          nrs(nk) = nrs(nk)+1
          lns4 = lns4+1
          IF (inloc(m)==0) inloc(m) = n_kine + inloc(ni)
         ENDIF
       ENDDO
      ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

dim_nrmax()

subroutine dim_nrmax	(	integer, dimension(*)	nrow,
		integer, dimension(*)	fr_elem,
		integer, dimension(2,*)	iad_elem,
		integer	nnmax )

Definition at line 3113 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NROW(*),IAD_ELEM(2,*),FR_ELEM(*),NNMAX
C----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NR
C------------------------------------
      IF (n_frnn==0) RETURN
C
       DO i =1,nspmd
        DO j=iad_elem(1,i),iad_elem(1,i+1)-1
          nr=iad_rl(j+1)-iad_rl(j)
          IF (nr>0)THEN
           n = fr_elem(j)
           nrow(n)=nrow(n)+nr
           nnmax = max(nnmax,nrow(n))
          ENDIF
        ENDDO
       ENDDO
C
      RETURN

doub_nrs()

subroutine doub_nrs	(	integer	nsl,
		integer	nnmax,
		integer, dimension(*)	nrs,
		integer, dimension(nnmax,*)	icol,
		integer, dimension(*)	ilocp )

Definition at line 6644 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSL,NNMAX ,NRS(*),ILOCP(*)
      INTEGER ICOL(NNMAX,*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer
     .        i,j,k,n,nj
C----------------------------
C--- Double part-Diff.srem since [K] Rem is Dja Built
      DO i=1,nsl
       n = isl(i)
       k = ilocp(n)
       IF (nrs(i)<nrs(k)) THEN
        CALL cp_int(nrs(k),icol(1,k),icol(1,i))
        nrs(i) = nrs(k)
       ENDIF
      ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

fr_a2b()

subroutine fr_a2b	(	integer, dimension(*)	ndof,
			lb,
			a,
		integer	nsl )

Definition at line 2951 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NDOF(*),NSL
      my_real
     .  a(3,*),lb(*)
C----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,ID,ND,M,N
C---------
      DO i = 1,nsl
       n=islm(i)
       IF (n>0) THEN
        DO j=1,min(3,ndof(n))
         nd = iddsl(j,i)
         IF (nd>0) lb(nd)=lb(nd)+a(j,n)
        ENDDO
       ENDIF
      ENDDO
      DO i = 1,nml
       n=iml(i)
        DO j=1,min(3,ndof(n))
         nd = iddml(j,i)
         IF (nd>0) lb(nd)=lb(nd)+a(j,n)
        ENDDO
      ENDDO
C
      RETURN

fr_a2bd()

subroutine fr_a2bd	(	integer, dimension(*)	ndof,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
			lb,
			a,
			ar,
		integer, dimension(nrbe3l,*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer, dimension(nrbe2l,*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 2998 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
      USE intbufdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NDOF(*),IPARI(NPARI,*),
     .        IRBE3(NRBE3L,*),LRBE3(*) ,IRBE2(NRBE2L,*),LRBE2(*)
      my_real
     .  a(3,*),ar(3,*),lb(*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,M,NS,NI,NSN,
     .        L,NNOD,NJ,ND,NL,IAD,JI
C------------------------------------
C------Rigid bodies-------
       DO i=1,nrb_fr
        m=ifrsr(1,i)
         DO j=1,ndof(m)
          nd = iddmr(j,i)
          IF (j<=3.AND.nd>0) THEN
           lb(nd)=lb(nd)+a(j,m)
           a(j,m)=zero
          ELSEIF(nd>0) THEN
           lb(nd)=lb(nd)+ar(j-3,m)
           ar(j-3,m)=zero
          ENDIF
         ENDDO
       ENDDO
C------int2-------
       DO i=1,ni2_fr
        n=ifrs2(1,i)
        ni=ifrs2(2,i)
        ji=ipari(1,n)
        nsn=ipari(5,n)
         l=intbuf_tab(n)%IRTLM(ni)
         nl=4*(l-1)
         IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
          nnod=3
         ELSE
          nnod=4
         ENDIF
C-------if main node is also dependent-----
         DO m=1,nnod
          nj=intbuf_tab(n)%IRECTM(nl+m)
           DO j=1,ndof(nj)
            nd = iddmi2(j,m,i)
            IF (j<=3.AND.nd>0) THEN
             lb(nd)=lb(nd)+a(j,nj)
             a(j,nj)=zero
            ELSEIF(nd>0) THEN
             lb(nd)=lb(nd)+ar(j-3,nj)
             ar(j-3,nj)=zero
            ENDIF
           ENDDO
         ENDDO
       ENDDO
C--------RBE3-----
       DO i=1,nrbe3_fr
         n=ifrs3(i)
         iad=irbe3(1,n)
         nnod=irbe3(5,n)
         DO m=1,nnod
          nj=lrbe3(iad+m)
           DO j=1,ndof(nj)
            nd = iddmi3(j,m,i)
            IF (j<=3.AND.nd>0) THEN
             lb(nd)=lb(nd)+a(j,nj)
             a(j,nj)=zero
            ELSEIF(nd>0) THEN
             lb(nd)=lb(nd)+ar(j-3,nj)
             ar(j-3,nj)=zero
            ENDIF
           ENDDO
         ENDDO
       ENDDO
C------RBE2-------
       DO i=1,nrbe2_fr
        n=ifrs4(1,i)
        m=irbe2(3,n)
         DO j=1,ndof(m)
          nd = iddmr2(j,i)
          IF (j<=3.AND.nd>0) THEN
           lb(nd)=lb(nd)+a(j,m)
           a(j,m)=zero
          ELSEIF(nd>0) THEN
           lb(nd)=lb(nd)+ar(j-3,m)
           ar(j-3,m)=zero
          ENDIF
         ENDDO
       ENDDO
C
      RETURN

fr_dlft()

subroutine fr_dlft	(	integer	nddl,
		integer	idlft0,
		integer	idlft1 )

Definition at line 4354 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IDLFT0,IDLFT1,NDDL
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER L,IP,J
C
C
       idlft0 = ddlp0
       idlft1 = ddlp1
C
      RETURN

fr_matv()

subroutine fr_matv	(		a,
			v,
			d,
			ms,
			x,
			dr,
			ar,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(*)	ndof,
		integer, dimension(*)	num_imp,
		integer, dimension(*)	ns_imp,
		integer, dimension(*)	ne_imp,
			lx,
		integer	nsrem,
		integer	nsl,
		integer, dimension(*)	ibfv,
			skew,
			xframe,
			f,
		integer, dimension(*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer, dimension(*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 2413 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s 
C-----------------------------------------------
      USE intbufdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "impl1_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,*), NDOF(*),IBFV(*) ,
     .         NUM_IMP(*),NS_IMP(*),NE_IMP(*),NSREM,NSL,
     .         IRBE3(*) ,LRBE3(*),IRBE2(*),LRBE2(*)
      my_real
     .  a(3,*),ar(3,*),v(3,*),d(3,*),dr(3,*),x(3,*) ,
     .  ms(*),skew(*) ,xframe(*)
      my_real
     .  lx(*),f(*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,IDF
C-----------------------------------------------
      IF ((nsrem+nsl)==0) RETURN
C
      IF (intp_c>0) THEN
C-----send U(NDDL_SL) and receive U(NDDL_SI)-----
       CALL spmd_ifru(lx )
       CALL mav_ltfr(lx  ,f   )
C-----send F (NDDL_SI) and receive F (NDDL_SL)-----
       CALL spmd_ifrf(f )
      ELSE
C
C-----initialize D,A independent nodes first-----
      CALL fr_u2d(ndof  ,lx    ,d     ,a     ,nsrem, nsl )
C-----kinematic nodes -----
      CALL fr_u2dd(d    ,dr    ,x     ,ipari  ,intbuf_tab,
     1             ndof  ,a     ,ar     ,lx     ,
     2             ibfv ,skew  ,xframe,irbe3,lrbe3    ,
     3             irbe2,lrbe2 )
C-----send D (NSL) and receive DFI (NSREM)-----
      CALL spmd_ifcd(d  ,nsl, nsrem)
C-----compute contact force ->A ,FFI-----
      IF (nsrem>0)
     . CALL i7mainfr(a     ,v     ,d      ,x      ,ms    ,
     1               ipari ,intbuf_tab  ,num_imp,ns_imp,
     2               ne_imp)
C-----send FFI (NSREM) and receive A (NSL)-----
      CALL spmd_ifcf(a, nsrem  ,nsl)
C-----Compute A with dependent nodes---------
      CALL upd_fr(a     ,ar     ,x     ,ipari  ,intbuf_tab,
     1            ndof   ,ibfv  ,skew   ,xframe ,
     2            irbe3 ,lrbe3  ,irbe2 ,lrbe2  )
C
       CALL fr_a2b(ndof   ,f     ,a      ,nsl  )
       CALL fr_a2bd(ndof  ,ipari ,intbuf_tab,f     ,a     ,
     .              ar    ,irbe3 ,lrbe3  ,irbe2 ,lrbe2 )
      END IF !(INTP_C>0) THEN
C
      RETURN

fr_matv_gpu()

subroutine fr_matv_gpu	(	integer	nsrem,
		integer	nsl,
			lx,
			f,
		integer, dimension(*)	nindex )

Definition at line 2493 of file imp_fri.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "impl1_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSREM, NSL, NINDEX(*) 
      my_real
     .        lx(*), f(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C-----------------------------------------------
      IF ((nsrem+nsl)==0) RETURN
C
      IF (intp_c>0) THEN
C-----send U(NDDL_SL) and receive U(NDDL_SI)-----
       CALL spmd_ifru_gpu(lx,nindex)
       CALL mav_ltfr_gpu(lx  ,f, nindex)
C-----send F (NDDL_SI) and receive F (NDDL_SL)-----
       CALL spmd_ifrf_gpu(f,nindex)
      ELSE
        print*,'**ERROR OPTION NOT COMPATIBLE WITH GPU'
        stop 1234
      END IF
C
      RETURN

fr_u2d()

subroutine fr_u2d	(	integer, dimension(*)	ndof,
			lx,
			d,
			a,
		integer	nsrem,
		integer	nsl )

Definition at line 2535 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NDOF(*),NSL,NSREM
      my_real
     .  d(3,*),a(3,*),lx(*)
C----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,ID,ND,M,N
C----independent nodes first-----
      DO i = 1,nsrem
       ffi(1,i)=zero
       ffi(2,i)=zero
       ffi(3,i)=zero
      ENDDO
      DO i = 1,nsl
       n=isl(i)
        DO j=1,min(3,ndof(n))
         nd = iddsl(j,i)
         IF (nd>0) d(j,n)=lx(nd)
C--------for communication with FFI----
         a(j,n)=zero
        ENDDO
      ENDDO
      DO i = 1,nml
       n=iml(i)
        DO j=1,min(3,ndof(n))
         nd = iddml(j,i)
         IF (nd>0) d(j,n)=lx(nd)
         a(j,n)=zero
        ENDDO
      ENDDO
C
      RETURN

fr_u2dd()

subroutine fr_u2dd	(		d,
			dr,
			x,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(*)	ndof,
			a,
			ar,
			lx,
		integer, dimension(nifv,*)	ibfv,
			skew,
			xframe,
		integer, dimension(nrbe3l,*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer, dimension(nrbe2l,*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 2603 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
      USE imp_rwl
      USE imp_aspc
      USE intbufdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IRBE3(NRBE3L,*),LRBE3(*),IRBE2(NRBE2L,*),LRBE2(*),
     .        IPARI(NPARI,*), NDOF(*),IBFV(NIFV,*)
      my_real
     .  d(3,*),dr(3,*),a(3,*),ar(3,*),x(3,*) ,lx(*),
     .  skew(lskew,*)  ,xframe(*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,M,NS,NI,NSN,ILEV,IADS,IROT,IAD,JI,
     .        L,NNOD,NJ,ND,NL,ISK,IFM,LJFR(NFXVEL),
     .        JT(3),JR(3),IRAD,NN,IC
      my_real
     .  ej(3)
       DO l=nbc_fr,1,-1
          i = ibc_fr(1,l)
          isk =ibc_fr(2,l)
          ifm =ibc_fr(3,l)
          CALL bcl_impd(ifm  ,isk   ,skew  ,i     ,d     )
          a(1,i)=zero
          a(2,i)=zero
          a(3,i)=zero
       ENDDO
       DO l=nspc_fr,1,-1
          n = ispc_fr(l)
          i = in_spc(n)
              iad = 6*(n-1)+1
              nn = ic_spc(n)
            IF (nn==1) THEN
             ej(1)=skew_spc(iad)
             ej(2)=skew_spc(iad+1)
             ej(3)=skew_spc(iad+2)
          CALL l_dir(ej,j)
          d(j,i) = zero
          CALL bc_updd(i     ,ej   ,j     ,d     )
            ELSEIF (nn==2) THEN
          CALL bc_upd2d(i     ,skew_spc(iad),skew_spc(iad+3),d     )
            END IF
          a(1,i)=zero
          a(2,i)=zero
          a(3,i)=zero
       ENDDO
C
       IF (nfx_fr>0) THEN
        DO n=1,nfxvel
         ljfr(n)=0
        ENDDO
        DO l=1,nfx_fr
         i = ifx_fr(1,l)
         ljfr(i) = ifx_fr(2,l)
        ENDDO
        CALL fv_impd(ibfv  ,ljfr  ,skew  ,xframe,d     ,
     1               dr    )
        DO l=nfx_fr,1,-1
          j = ifx_fr(2,l)
          a(j,n)=zero
        ENDDO
       ENDIF
C
      DO l = 1,nrw_fr
        i = irw_fr(l)
        n=in_rwl(i)
        ej(1)=nor_rwl(1,i)
        ej(2)=nor_rwl(2,i)
        ej(3)=nor_rwl(3,i)
        CALL l_dir(ej,j)
        CALL bc_updd(n     ,ej   ,j     ,d     )
        a(j,n)=zero
      ENDDO
C
C------Rigid bodies-------
       DO i=nrb_fr,1,-1
        m=ifrsr(1,i)
         DO j = 1 , ndof(m)
              nd = iddmr(j,i)
          IF (j<=3.AND.nd>0) THEN
            d(j,m)=lx(nd)
          ELSEIF (nd>0) THEN
            dr(j-3,m)=lx(nd)
          ENDIF
         ENDDO
        ns=ifrsr(2,i)
        CALL rby_imp3(x    ,m      ,ns     ,d     ,dr     ,
     .                a    ,ar   )
       ENDDO
C--------RBE3-----
       iads=1
       DO i=1,nrbe3_fr
         n=ifrs3(i)
         iad=irbe3(1,n)
         ns=irbe3(3,n)
         nnod=irbe3(5,n)
         irot=irbe3(6,n)
         DO m=1,nnod
          nj=lrbe3(iad+m)
           DO j=1,ndof(nj)
            nd = iddmi3(j,m,i)
            IF (j<=3.AND.nd>0) THEN
             d(j,nj)=lx(nd)
             a(j,nj)=zero
            ELSEIF(nd>0) THEN
             dr(j-3,nj)=lx(nd)
             ar(j-3,nj)=zero
            ENDIF
           ENDDO
         ENDDO
         CALL prerbe3fr(irbe3 ,n    ,jt  ,jr   )
         CALL rbe3_frd(nnod  ,lrbe3(iad+1),ns    ,d     ,dr    ,
     1                frcdi(iads),mrcdi(iads),jt  ,jr   ,irot  )
        iads=iads+nnod
       ENDDO
C------Rbe2------
       DO i=nrbe2_fr,1,-1
        n=ifrs4(1,i)
        m=irbe2(3,n)
         DO j = 1 , ndof(m)
              nd = iddmr2(j,i)
          IF (j<=3.AND.nd>0) THEN
            d(j,m)=lx(nd)
            a(j,m)=zero
          ELSEIF (nd>0) THEN
            dr(j-3,m)=lx(nd)
            ar(j-3,m)=zero
          ENDIF
         ENDDO
        ns=ifrs4(2,i)
        isk = irbe2(7,n)
            irad =irbe2(11,n)
         ic = irbe2(4,n)
C--------remove ICR---
         ic =(ic/512)*512
         CALL prerbe2fr(ic    ,jt  ,jr   )
         CALL rbe2_frd(ns    ,m     ,x     ,d     ,dr    ,
     1                jt    ,jr     ,skew(1,isk),isk   ,irad  )
         a(1,ns)=zero
         a(2,ns)=zero
         a(3,ns)=zero
       ENDDO
C------int2-------
       DO i=ni2_fr,1,-1
        n=ifrs2(1,i)
        ni=ifrs2(2,i)
        ji=ipari(1,n)
        nsn=ipari(5,n)
         l=intbuf_tab(n)%IRTLM(ni)
         nl=4*(l-1)
         IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
          nnod=3
         ELSE
          nnod=4
         ENDIF
C-------if main node is also dependent-----
         DO m=1,nnod
          nj=intbuf_tab(n)%IRECTM(nl+m)
           DO j=1,ndof(nj)
            nd = iddmi2(j,m,i)
            IF (j<=3.AND.nd>0) THEN
             d(j,nj)=lx(nd)
             a(j,nj)=zero
            ELSEIF(nd>0) THEN
             dr(j-3,nj)=lx(nd)
             ar(j-3,nj)=zero
            ENDIF
           ENDDO
         ENDDO
        ilev  =ipari(20,n)
        IF (ilev==1) THEN
         CALL i2_frrd1(x   ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA ,intbuf_tab(n)%NSV ,
     1                intbuf_tab(n)%IRTLM ,d   ,ni    )
        ELSE
         CALL i2_frrd0(x   ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS ,intbuf_tab(n)%NSV ,
     1                intbuf_tab(n)%IRTLM ,d    ,dr    ,ni  ,ndof      )
        ENDIF
       ENDDO
C
      RETURN

get_iad()

subroutine get_iad	(	integer, dimension(*)	iad_m,
		integer, dimension(*)	iad_s,
		integer, dimension(*)	jdi_s,
		integer	nm,
		integer	is,
		integer	j,
		integer	nrj,
		integer, dimension(*)	ndof,
		integer	iad )

Definition at line 7137 of file imp_fri.F.

C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IAD_M(*),IAD_S(*),JDI_S(*),NM ,NS,J,IAD,NRJ ,NDOF(*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,K,NR,L,IS,NK,NZ,NJ,I0,ID
C----6---------------------------------------------------------------7---------8
        nr =iad_s(is+1)-iad_s(is)
        l = iad_m(is)
        nk =(iad_m(is+1)-iad_m(is))/nrj
        iad = l+(j-1)*nk
        IF (nm>0.AND.nr>0) THEN
         i0=iad_s(is)
         CALL intabfr(nr,jdi_s(i0),nm,id)
         IF (id>0) THEN
          nz = 0
          DO i = 1,id-1
           nj = jdi_s(i0+i-1)
           IF (ndof(nj)==6) THEN
            nz = nz + 2
           ELSE
            nz = nz +1
           ENDIF
          ENDDO
          iad = iad + nz
         ELSE
          iad = 0
         ENDIF
        ENDIF
C
C----6---------------------------------------------------------------7---------8
      RETURN

get_ikin2g()

subroutine get_ikin2g	(	integer	nkine,
		integer	ink,
		integer, dimension(*)	iloc )

Definition at line 4428 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NKINE,ILOC(*),INK
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,N,NRB
C
      nrb=nkine-ink
      DO n =1,nrb
       i=ikin2g(n)
       iloc(i)=n+ink
      ENDDO
      DO n =nrb+1,nkine
       i=ikin2g(n)
       iloc(i)=n-nrb
      ENDDO
C
      RETURN

getfr_kij()

subroutine getfr_kij	(	integer	id,
		integer	jd,
		integer, dimension(*)	iadk,
		integer, dimension(*)	jdik,
			k_lt,
			kij,
		integer	nk,
		integer	nl )

Definition at line 6460 of file imp_fri.F.

C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NK   ,NL
      INTEGER ID,JD,IADK(*),JDIK(*)
C     REAL
      my_real
     .   k_lt(*)   ,kij(nk,nl)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,JDL,L,JJ
C----6---------------------------------------------------------------7---------8
         DO k=1,nk
          jdl=-1
          DO jj = iadk(id+k),iadk(id+1+k)-1
C-------- Find l'Address in LT -----
           IF (jdik(jj)==(jd+1)) THEN
            jdl = jj-1
            GOTO 300
           ENDIF
          ENDDO
 300      CONTINUE
         IF (jdl>=0) THEN
          DO l=1,nl
           kij(k,l) = k_lt(jdl+l)
          ENDDO
         ELSE
         ENDIF
         ENDDO
C
C----6---------------------------------------------------------------7---------8
      RETURN

getnddli_g()

subroutine getnddli_g	(	integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	lpby,
		integer, dimension(*)	itab,
		integer	nrbyac,
		integer, dimension(*)	irbyac,
		integer	nint2,
		integer, dimension(*)	iint2,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(*)	ndofi,
		integer, dimension(*)	ndof,
		integer, dimension(*)	ikc,
		integer, dimension(*)	iddl,
		integer, dimension(*)	fr_elem,
		integer, dimension(2,*)	iad_elem,
		integer	nddli,
		integer	nsl,
		integer	nddlig,
		integer, dimension(*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer, dimension(*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 9977 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
      USE intbufdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NDOFI(*) ,IDDL(*),IKC(*),NDOF(*),NDDLI,NDDLIG,NSL
      INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
     .        NINT2,IINT2(*),IPARI(NPARI,*),
     .        IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*)
      integer
     .   fr_elem(*),iad_elem(2,*)
C     REAL
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  NDDLIFB,NDDLINS
C
       CALL nddli_frb(
     1    ndof      ,ikc       ,iddl      ,ndofi     ,nddlifb   ,
     2    fr_elem   ,iad_elem  )
       CALL nddli_ns(
     1    npby      ,lpby      ,itab      ,nrbyac    ,irbyac    ,
     2    nint2     ,iint2     ,ipari     ,intbuf_tab,ndofi     ,
     3    ndof      ,ikc       ,iddl      ,nsl       ,nddli     ,
     4    nddlins   ,irbe3     ,lrbe3     ,irbe2     ,lrbe2     )
       CALL spmd_nddlig(nddlins  ,nddlifb   ,nddlig    )
C
      RETURN

iddl_int()

subroutine iddl_int	(	integer	nsl,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer, dimension(*)	iddlm,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(nrbe3l,*)	irbe3,
		integer, dimension(*)	lrbe3,
			frbe3,
			x,
			skew,
		integer, dimension(nrbe2l,*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 1613 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
      USE intbufdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "tabsiz_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  NSL,IDDL(*) ,IKC(*) ,NDOF(*) ,IDDLM(*)
      INTEGER  IPARI(NPARI,*),IRBE3(NRBE3L,*),LRBE3(*),
     .         IRBE2(NRBE2L,*),LRBE2(*)
      my_real
     .  frbe3(*),x(*),skew(*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I,ID,N,J,NDD,I1,IAD,NMT,IROTG,IADS
      INTEGER M,NSN,L,NNOD,NJ,NL,NI,JI
      INTEGER IERROR1,IERROR2,IERROR3,IERROR4,IERROR5
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
       IF (nml>0) THEN
        IF(ALLOCATED(iddml)) DEALLOCATE(iddml)
        ALLOCATE(iddml(3,nml),stat=ierror1)
C--------initialization for ndof=0---
        iddml = -7
        DO i = 1, nml
         n = iml(i)
         ndd = 0
         DO j = 1 , min(3,ndof(n))
              id = iddl(n) + j
          IF (ikc(id)<1) THEN
           ndd = ndd + 1
           iddml(j,i) = iddlm(n) + ndd
          ELSE
           iddml(j,i) = -ikc(id)
          ENDIF
         ENDDO
        ENDDO
       ENDIF
C
       IF (nsl>0) THEN
        IF(ALLOCATED(iddsl)) DEALLOCATE(iddsl)
        ALLOCATE(iddsl(3,nsl),stat=ierror2)
        iddsl = -7
        DO i = 1, nsl
         n = isl(i)
         ndd = 0
         DO j = 1 , min(3,ndof(n))
              id = iddl(n) + j
          IF (ikc(id)<1) THEN
           ndd = ndd + 1
           iddsl(j,i) = iddlm(n) + ndd
          ELSE
           iddsl(j,i) = -ikc(id)
          ENDIF
         ENDDO
        ENDDO
       ENDIF
C
       IF (nrb_fr>0) THEN
        IF(ALLOCATED(iddmr)) DEALLOCATE(iddmr)
        ALLOCATE(iddmr(6,nrb_fr),stat=ierror3)
        DO i = 1, nrb_fr
         n = ifrsr(1,i)
         ndd = 0
         DO j = 1 , ndof(n)
              id = iddl(n) + j
          IF (ikc(id)<1) THEN
           ndd = ndd + 1
           iddmr(j,i) = iddlm(n) + ndd
          ELSE
           iddmr(j,i) = -ikc(id)
          ENDIF
         ENDDO
        ENDDO
       ENDIF
C
       IF (ni2_fr>0) THEN
        IF(ALLOCATED(iddmi2)) DEALLOCATE(iddmi2)
        ALLOCATE(iddmi2(6,4,ni2_fr),stat=ierror4)
        DO i=1,ni2_fr
         n=ifrs2(1,i)
         ni=ifrs2(2,i)
         ji=ipari(1,n)
         nsn=ipari(5,n)
         l=intbuf_tab(n)%IRTLM(ni)
         nl=4*(l-1)
         IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
          nnod=3
         ELSE
          nnod=4
         ENDIF
C-------if main node is also dependent-----
         DO m=1,nnod
          nj=intbuf_tab(n)%IRECTM(nl+m)
          ndd = 0
          DO j = 1 , ndof(nj)
               id = iddl(nj) + j
           IF (ikc(id)<1) THEN
            ndd = ndd + 1
            iddmi2(j,m,i) = iddlm(nj) + ndd
           ELSE
            iddmi2(j,m,i) = -ikc(id)
           ENDIF
          ENDDO
         ENDDO
        ENDDO
       ENDIF
C-------RBE3-----------
       IF (nrbe3_fr>0) THEN
        IF(ALLOCATED(iddmi3)) DEALLOCATE(iddmi3)
        ndd = 0
        DO i=1,nrbe3_fr
         n=ifrs3(i)
         ndd = max(ndd ,irbe3(5,n))
        ENDDO
        ALLOCATE(iddmi3(6,ndd,nrbe3_fr),stat=ierror5)
        irotg=0
        nmt = 0
        DO i=1,nrbe3_fr
         n=ifrs3(i)
         ni=irbe3(3,n)
         nnod=irbe3(5,n)
         iad=irbe3(1,n)
             irotg =max(irotg,irbe3(6,n))
C-------
         DO m=1,nnod
          nj=lrbe3(iad+m)
          ndd = 0
          DO j = 1 , ndof(nj)
               id = iddl(nj) + j
           IF (ikc(id)<1) THEN
            ndd = ndd + 1
            iddmi3(j,m,i) = iddlm(nj) + ndd
           ELSE
            iddmi3(j,m,i) = -ikc(id)
           ENDIF
          ENDDO
         ENDDO
         nmt = nmt + nnod
        ENDDO
        IF(ALLOCATED(frcdi)) DEALLOCATE(frcdi)
        ALLOCATE(frcdi(18*nmt))
        IF (irotg>0) THEN
         IF(ALLOCATED(mrcdi)) DEALLOCATE(mrcdi)
         ALLOCATE(mrcdi(18*nmt))
        ENDIF
C------- init FRCDI,MRCDI
        nmt = slrbe3/2
        iads =1
        DO i=1,nrbe3_fr
         n=ifrs3(i)
         ni=irbe3(3,n)
         nnod=irbe3(5,n)
         iad=irbe3(1,n)
             irotg =irbe3(6,n)
         CALL rbe3cl(lrbe3(iad+1),lrbe3(nmt+iad+1),ni     ,x    ,
     .              frbe3(6*iad+1),skew   ,nnod    ,irotg  ,frcdi(iads),
     .              mrcdi(iads) ,irbe3(2,n))
C-------
         iads = iads + nnod
        ENDDO
       ENDIF
C-----------Rbe2-------------------
       IF (nrbe2_fr>0) THEN
        IF(ALLOCATED(iddmr2)) DEALLOCATE(iddmr2)
        ALLOCATE(iddmr2(6,nrbe2_fr),stat=ierror3)
        DO i = 1, nrbe2_fr
         n = ifrs4(1,i)
         m = irbe2(3,n)
         ndd = 0
         DO j = 1 , ndof(m)
              id = iddl(m) + j
          IF (ikc(id)<1) THEN
           ndd = ndd + 1
           iddmr2(j,i) = iddlm(m) + ndd
          ELSE
           iddmr2(j,i) = -ikc(id)
          ENDIF
         ENDDO
        ENDDO
       ENDIF
C
      RETURN

ikincf()

logical function ikincf

(

integer

i

)

Definition at line 7185 of file imp_fri.F.

C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER I
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
C----6---------------------------------------------------------------7---------8
       IF (i==0.OR.(i>=2.AND.i<=4).OR.i==9) THEN
         ikincf =.true.
       ELSE
         ikincf =.false.
       ENDIF
C
      RETURN

imp_diags()

subroutine imp_diags	(		diag_k,
		integer, dimension(*)	ndof,
		integer	nsl,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(nrbe3l,*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer, dimension(nrbe2l,*)	irbe2 )

Definition at line 2173 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NDOF(*),NSL
      INTEGER IPARI(NPARI,*),IRBE3(NRBE3L,*),LRBE3(*),
     .         IRBE2(NRBE2L,*)
C     REAL
      my_real
     .  diag_k(*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,ID,I1,IAD
      INTEGER M,NSN,L,NNOD,NJ,NL,NI,JI
C-----------------------------------------------
      IF (intp_d>0) THEN
       DO i = 1, nddl_sl
        id = iddl_sl(i)
        diag_k(id)=diag_k(id)+diag_sl(i)
       ENDDO
      ELSE
       DO i = 1, nsl
C--------local secondary node-----
        n = isl(i)
         DO j = 1, min(3,ndof(n))
          id = iddsl(j,i)
          IF (id>0) diag_k(id)=diag_k(id)+diag_s(j,i)
         ENDDO
       ENDDO
C--------if there are independent nodes-----
       DO i1=1,ni2_frs
         i=ifrs2_s(i1)
         n=ifrs2(1,i)
         ni=ifrs2(2,i)
         ji=ipari(1,n)
         nsn=ipari(5,n)
         l=intbuf_tab(n)%IRTLM(ni)
         nl=4*(l-1)
         IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
          nnod=3
         ELSE
          nnod=4
         ENDIF
         DO m=1,nnod
          nj=intbuf_tab(n)%IRECTM(nl+m)
          DO j = 1 , ndof(nj)
               id = iddmi2(j,m,i)
           IF (id>0) diag_k(id)=diag_k(id)+diag_m2(j,m,i1)
          ENDDO
         ENDDO
       ENDDO
C--------RBE3-----
       DO i1=1,nrbe3_frs
         i=ifrs3_s(i1)
         n=ifrs3(i)
         iad=irbe3(1,n)
         nnod=irbe3(5,n)
         DO m=1,nnod
          nj=lrbe3(iad+m)
          DO j = 1 , ndof(nj)
               id = iddmi3(j,m,i)
           IF (id>0) diag_k(id)=diag_k(id)+diag_m3(j,m,i1)
          ENDDO
         ENDDO
       ENDDO
       DO i1 = 1, nrb_frs
         i=ifrsr_s(i1)
         n = ifrsr(1,i)
         DO j = 1 , ndof(n)
              id = iddmr(j,i)
          IF (id>0) diag_k(id)=diag_k(id)+diag_mr(j,i1)
         ENDDO
       ENDDO
C--------RBE2-----
       DO i1 = 1, nrbe2_frs
         i=ifrs4_s(i1)
         n = ifrs4(1,i)
         m = irbe2(3,n)
         DO j = 1 , ndof(m)
              id = iddmr2(j,i)
          IF (id>0) diag_k(id)=diag_k(id)+diag_mr2(j,i1)
         ENDDO
       ENDDO
C
      ENDIF
C----6---------------------------------------------------------------7---------8
      RETURN

imp_diagsn()

subroutine imp_diagsn	(		diag_k,
		integer, dimension(*)	ndof,
		integer	nsl,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(nrbe3l,*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer, dimension(nrbe2l,*)	irbe2 )

Definition at line 2287 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NDOF(*),NSL
      INTEGER IPARI(NPARI,*),IRBE3(NRBE3L,*),LRBE3(*),
     .         IRBE2(NRBE2L,*)
C     REAL
      my_real
     .  diag_k(*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,ID,I1,IAD
      INTEGER M,NSN,L,NNOD,NJ,NL,NI,JI
C-----------------------------------------------
      IF (intp_d>0) THEN
       DO i = 1, nddl_sl
        id = iddl_sl(i)
        diag_k(id)=diag_k(id)-diag_sl(i)
       ENDDO
      ELSE
       DO i = 1, nsl
C--------local secondary node-----
        n = isl(i)
         DO j = 1, min(3,ndof(n))
          id = iddsl(j,i)
          IF (id>0) diag_k(id)=diag_k(id)-diag_s(j,i)
         ENDDO
       ENDDO
C--------if there are independent nodes-----
       DO i1=1,ni2_frs
         i=ifrs2_s(i1)
         n=ifrs2(1,i)
         ni=ifrs2(2,i)
         ji=ipari(1,n)
         nsn=ipari(5,n)
         l=intbuf_tab(n)%IRTLM(ni)
         nl=4*(l-1)
         IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
          nnod=3
         ELSE
          nnod=4
         ENDIF
         DO m=1,nnod
          nj=intbuf_tab(n)%IRECTM(nl+m)
          DO j = 1 , ndof(nj)
           id = iddmi2(j,m,i)
           IF (id>0) diag_k(id)=diag_k(id)-diag_m2(j,m,i1)
          ENDDO
         ENDDO
       ENDDO
C--------RBE3-----
       DO i1=1,nrbe3_frs
         i=ifrs3_s(i1)
         n=ifrs3(i)
         iad=irbe3(1,n)
         nnod=irbe3(5,n)
         DO m=1,nnod
          nj=lrbe3(iad+m)
          DO j = 1 , ndof(nj)
               id = iddmi3(j,m,i)
           IF (id>0) diag_k(id)=diag_k(id)-diag_m3(j,m,i1)
          ENDDO
         ENDDO
       ENDDO
       DO i1 = 1, nrb_frs
         i=ifrsr_s(i1)
         n = ifrsr(1,i)
         DO j = 1 , ndof(n)
              id = iddmr(j,i)
          IF (id>0) diag_k(id)=diag_k(id)-diag_mr(j,i1)
         ENDDO
       ENDDO
C--------RBE2-----
       DO i1 = 1, nrbe2_frs
         i=ifrs4_s(i1)
         n = ifrs4(1,i)
         m = irbe2(3,n)
         DO j = 1 , ndof(m)
              id = iddmr2(j,i)
          IF (id>0) diag_k(id)=diag_k(id)-diag_mr2(j,i1)
         ENDDO
       ENDDO
C
      ENDIF
C----6---------------------------------------------------------------7---------8
      RETURN

imp_fr7i()

subroutine imp_fr7i	(	integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(*)	num_imp,
		integer, dimension(*)	ns_imp,
		integer	nsrem,
		integer	nbintc,
		integer, dimension(*)	intlist )

Definition at line 504 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
      USE imp_intm
      USE intbufdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  NUM_IMP(*),NS_IMP(*),IPARI(NPARI,*),
     .         NSREM,NBINTC,INTLIST(*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,L,N,NN,IAD,NSN,NIN,NUM,NTY,II,NB
      INTEGER IERROR1,IERROR2,NRTS,NSREM11,NCONT,
     .        IERROR3,IERROR4,IERROR5,IERROR6,IERROR7
      INTEGER DEBUT(NINTER),DEBUTI(NINTER),L1,
     .        IERROR8,IERROR9,IDEB,IDEBI,LOC_PROC
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      loc_proc = ispmd + 1
C----init
        DO ii = 1, nbintc
          nin = intlist(ii)
          debuti(nin) = 0
        ENDDO
        DO i = 1, nspmd
          IF(i/=loc_proc)THEN
            DO ii = 1, nbintc
              nin = intlist(ii)
              nb = nsnfi(nin)%P(i)
              nty  = ipari(7,nin)
              IF(nty==7.OR.nty==10.OR.nty==11.OR.nty==24) THEN
               IF(nb>0) THEN
                   debuti(nin) = debuti(nin) + nb
               END IF
              END IF
            ENDDO
          ENDIF
        ENDDO
C
C
       nsrem11 = 0
       iad=0
       l = 0
       DO nin=1,ninter
        nty   =ipari(7,nin)
        IF(nty==5) iad=iad+num_imp(nin)
       ENDDO
       DO nin=1,ninter
        num=0
        nty   =ipari(7,nin)
        nsn   =ipari(5,nin)
        shf_int(nin) = l
        IF(nty==7.OR.nty==10.OR.nty==24) THEN
          DO i=1,num_imp(nin)
           IF (ns_imp(i+iad)>nsn) THEN
            nn=ns_imp(i+iad)-nsn
C -------tag impact nodes-------
            nsvfi(nin)%P(nn)=-abs(nsvfi(nin)%P(nn))
            num=num+1
           ENDIF
          ENDDO
          iad=iad+num_imp(nin)
        ELSEIF(nty==11)THEN
C
         nrts   =ipari(3,nin)
          DO i=1,num_imp(nin)
           IF (ns_imp(i+iad)>nrts) THEN
            nn=ns_imp(i+iad)-nrts
C -------tag impact nodes-------
            nsvfi(nin)%P(nn)=-abs(nsvfi(nin)%P(nn))
            num=num+1
            nsrem11 = nsrem11 + 1
           ENDIF
          ENDDO
          iad=iad+num_imp(nin)
C
        ELSE
        ENDIF
        l = l + num
        IF(ASSOCIATED(ind_int(nin)%P)) DEALLOCATE(ind_int(nin)%P)
        l1=debuti(nin)
        IF (l1>0) ALLOCATE(ind_int(nin)%P(l1),stat=ierror1)
       ENDDO
C---------
C
C Allocation of boundary interface arrays for implicit
C
C
        ncont = nsrem-nsrem11
      IF (intp_d==0) THEN
        IF(ALLOCATED(stifs)) DEALLOCATE(stifs)
        ALLOCATE(stifs(ncont),stat=ierror3)
        IF(ALLOCATED(h_e)) DEALLOCATE(h_e)
        ALLOCATE(h_e(4,ncont),stat=ierror4)
        IF(ALLOCATED(n_e)) DEALLOCATE(n_e)
        ALLOCATE(n_e(3,ncont),stat=ierror5)
C
      ENDIF
C
        IF(ALLOCATED(fr_srem)) DEALLOCATE(fr_srem)
        ALLOCATE(fr_srem(nsrem),stat=ierror2)
        IF(ALLOCATED(dfi)) DEALLOCATE(dfi)
        ALLOCATE(dfi(3,nsrem),stat=ierror6)
        IF(ALLOCATED(ffi)) DEALLOCATE(ffi)
        ALLOCATE(ffi(3,nsrem),stat=ierror7)
C
      IF(ALLOCATED(iad_srem)) DEALLOCATE(iad_srem)
      ALLOCATE(iad_srem(nspmd+1),stat=ierror8)
      IF(ALLOCATED(inbsl)) DEALLOCATE(inbsl)
      ALLOCATE(inbsl(nbintc,nspmd),stat=ierror9)
C -----sort by proc---independent interface structure------
        DO ii = 1, nbintc
          nin = intlist(ii)
          debut(nin) = 0
          debuti(nin) = 0
        ENDDO
       l = 1
C
       iad_srem(1) = l
        DO i = 1, nspmd
          IF(i/=loc_proc)THEN
            DO ii = 1, nbintc
              nin = intlist(ii)
              ideb = debut(nin)
              idebi = debuti(nin)
              nb = nsnfi(nin)%P(i)
              nty  = ipari(7,nin)
              nsn  = ipari(5,nin)
              l1 = l
              IF(nty==7.OR.nty==10.OR.nty==11.OR.nty==24) THEN
               IF(nb>0) THEN
                IF(nty==7.OR.nty==10.OR.nty==24) THEN
                  DO n = 1, nb
                    IF(nsvfi(nin)%P(ideb+n)<0)THEN
                      nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
                      fr_srem(l) = nsvfi(nin)%P(ideb+n)
                      ind_int(nin)%P(idebi+n)=l
                      l = l + 1
                    ENDIF
                  ENDDO
                  debuti(nin) = debuti(nin) + nb
C
                ELSEIF(nty==11) THEN
                  DO n = 1, nb
                    IF(nsvfi(nin)%P(ideb+n)<0)THEN
                      nsvfi(nin)%P(ideb+n)=-nsvfi(nin)%P(ideb+n)
                      fr_srem(l) = nsvfi(nin)%P(ideb+n)
                      ind_int(nin)%P(idebi+n)=l
                      l = l + 1
                      fr_srem(l) = 0
                      l = l + 1
                    ENDIF
                  ENDDO
                  debuti(nin) = debuti(nin) + nb
C
                ENDIF
                debut(nin) = debut(nin) + nb
               END IF
              END IF
              inbsl(ii,i)= l - l1
            ENDDO
          ENDIF
          iad_srem(i+1)=l
        ENDDO
        IF(iad_srem(nspmd+1)>1)nsrem=iad_srem(nspmd+1)-1
C
      RETURN

imp_frfv()

subroutine imp_frfv	(	integer, dimension(*)	num_imp,
		integer, dimension(*)	ns_imp,
		integer, dimension(*)	ne_imp,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer	nsrem,
		integer	nsl,
			d_imp,
			dd,
			dr_imp,
			ddr,
			a,
			ar,
			ms,
			v,
			x,
			lb,
		integer	nddl,
		integer, dimension(*)	ibfv,
			skew,
			xframe,
		integer, dimension(*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer, dimension(*)	irbe2,
		integer, dimension(*)	lrbe2,
			de,
		integer	nddl0,
		integer, dimension(*)	w_ddl )

Definition at line 135 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s 
C-----------------------------------------------
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "impl1_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,*),NUM_IMP(*),NS_IMP(*),
     .        NE_IMP(*),NSREM  ,NSL,NDDL,IRBE3(*),LRBE3(*)
      INTEGER IDDL(*),IKC(*),NDOF(*),IBFV(*),IRBE2(*),LRBE2(*),
     .        NDDL0 ,W_DDL(*)
C     REAL
      my_real
     .       d_imp(3,*) ,dd(3,*),dr_imp(3,*) ,ddr(3,*),lb(*),
     .       a(3,*) ,ar(3,*),ms(*) ,v(3,*),x(3,*),
     .       skew(*),xframe(*),de
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,L
      my_real
     .       lx(nddl)
      my_real,
     .         DIMENSION(:),ALLOCATABLE :: dd_tmp,ddr_tmp
C-----------------------------------------------
       IF (iline>0) THEN
          DO i =1,nddl
           lx(i)=zero
          ENDDO
          CALL fr_matv(    a     ,v     ,d_imp ,ms     ,x       ,
     1                     dr_imp,ar    ,ipari ,intbuf_tab      ,
     2                     ndof  ,num_imp,ns_imp,ne_imp,lx      ,
     3                     nsrem ,nsl    ,ibfv ,skew   ,xframe  ,
     4                     lx    ,irbe3  ,lrbe3,irbe2  ,lrbe2   )
          CALL spmd_sumf_v(lx)
          DO i =1,nddl
           lb(i) = lb(i)-lx(i)
          ENDDO
         IF ((nsrem+nsl)>0)
     .   CALL ini_dd0(iddl ,ikc   ,ndof  ,ipari ,intbuf_tab,
     .                d_imp,dr_imp,nsl   ,irbe3,lrbe3 ,
     .                irbe2,lrbe2 )
       ELSE
        l=3*numnod
        ALLOCATE(dd_tmp(l))
        dd_tmp=zero
        IF (iroddl/=0) THEN
         ALLOCATE(ddr_tmp(l))
         ddr_tmp=zero
        END IF
        IF ((nsrem+nsl)>0)
     .   CALL ini_ddfv(iddl ,ikc   ,ndof  ,ipari ,intbuf_tab,
     .                 d_imp,dr_imp,dd_tmp,ddr_tmp,nsl   ,
     .                 irbe3,lrbe3 ,irbe2 ,lrbe2 )
          DO i =1,nddl
           lx(i)=zero
          ENDDO
          CALL fr_matv(    a     ,v     ,dd_tmp    ,ms     ,x       ,
     1                     ddr_tmp   ,ar    ,ipari ,intbuf_tab      ,
     2                     ndof  ,num_imp,ns_imp,ne_imp,lx      ,
     3                     nsrem ,nsl    ,ibfv ,skew   ,xframe  ,
     4                     lx    ,irbe3  ,lrbe3 ,irbe2 ,lrbe2   )
          DEALLOCATE(dd_tmp)
          IF (iroddl/=0) DEALLOCATE(ddr_tmp)
          CALL spmd_sumf_v(lx)
          DO i =1,nddl
           lb(i) = lb(i)-lx(i)
          ENDDO
C------calculate DE for L_search as DD,DDR will be updated           
          CALL produt_vmhp(nddl0 ,nddl  ,iddl  ,ndof  ,ikc   ,
     .                     dd    ,ddr   ,lb    ,de    ,w_ddl )
        IF ((nsrem+nsl)>0)
     .   CALL ini_dd0(iddl ,ikc   ,ndof  ,ipari ,intbuf_tab ,
     .                dd    ,ddr  ,nsl   ,irbe3,lrbe3  ,
     .                irbe2 ,lrbe2)
       ENDIF !(ILINE>0) THEN
C----6---------------------------------------------------------------7---------8
      RETURN

imp_fri()

subroutine imp_fri	(	integer, dimension(*)	num_imp,
		integer, dimension(*)	ns_imp,
		integer, dimension(*)	ne_imp,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	lpby,
		integer, dimension(*)	itab,
		integer	nrbyac,
		integer, dimension(*)	irbyac,
		integer	nint2,
		integer, dimension(*)	iint2,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer, dimension(*)	inloc,
		integer	nsrem,
		integer	nsl,
		integer	nbintc,
		integer, dimension(*)	intlist,
			x,
		integer, dimension(*)	ibfv,
		integer, dimension(*)	lj,
			skew,
			xframe,
		integer, dimension(*)	iskew,
		integer, dimension(*)	icodt,
			a,
			ud,
			lb,
		integer	ifdis,
		integer	nddl,
			urd,
		integer, dimension(*)	iddli,
		integer, dimension(*)	irbe3,
		integer, dimension(*)	lrbe3,
			frbe3,
		integer, dimension(*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 36 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "impl1_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,*),NUM_IMP(*),NS_IMP(*),
     .        NE_IMP(*),NSREM  ,NSL,NBINTC,INTLIST(*),
     .        IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*)
      INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
     .        NINT2,IINT2(*),IDDL(*),IKC(*),NDOF(*),INLOC(*),
     .        IBFV(*),LJ(*),ISKEW(*),ICODT(*),IFDIS,NDDL,IDDLI(*)
C     REAL
      my_real
     .       x(3,*),skew(*) ,xframe(*),
     .       a(3,*),ud(3,*),lb(*),urd(3,*),frbe3(*)
 
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,IKPAT0
      my_real,
     .         DIMENSION(:),ALLOCATABLE :: lb0
C-----------------------------------------------
        CALL imp_frsl(nbintc,nsrem ,nsl   )
C-----------------------------------------------
       IF (intp_c>0) THEN
        ALLOCATE(lb0(nddl))
            lb0=zero
       ENDIF
       IF ((nsrem+nsl)>0) THEN
        IF (intp_c<=0) THEN
         CALL imp_frki(
     1      ipari     ,intbuf_tab,num_imp   ,ns_imp    ,ne_imp    ,
     2      npby      ,lpby      ,itab      ,nrbyac    ,irbyac    ,
     3      nint2     ,iint2     ,iddl      ,ikc       ,ndof      ,
     4      inloc     ,nsrem     ,nsl       ,nbintc    ,intlist   ,
     5      x         ,ibfv      ,lj        ,skew      ,
     6      xframe    ,iskew     ,icodt     ,irbe3     ,lrbe3     ,
     7      frbe3     ,irbe2     ,lrbe2     )
        ELSE
         ikpat0 = ikpat
         ikpat = 1
         CALL imp_frkd(
     1      npby      ,lpby      ,itab      ,nrbyac    ,irbyac    ,
     2      ipari     ,intbuf_tab,nint2     ,iint2     ,iddl      ,
     3      ikc       ,ndof      ,inloc     ,nsrem     ,nsl       ,
     4      nbintc    ,intlist   ,x         ,ibfv      ,
     5      lj        ,skew      ,xframe    ,iskew     ,icodt     ,
     6      a         ,ud        ,lb0       ,ifdis     ,urd       ,
     7      iddli     ,irbe3     ,lrbe3     ,frbe3     ,irbe2     ,
     8      lrbe2     )
         ikpat = ikpat0
        ENDIF
       ENDIF
       IF (intp_c>0) THEN
        CALL spmd_sumf_v(lb0)
        DO i=1,nddl
         lb(i) = lb(i)+lb0(i)
        ENDDO
        DEALLOCATE(lb0)
       ENDIF
C----6---------------------------------------------------------------7---------8
      RETURN

imp_frii()

subroutine imp_frii

(

integer

ninter

)

Definition at line 455 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "impl1_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  NINTER
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER  I
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
      ALLOCATE(ind_int(ninter))
      DO i=1,ninter
         NULLIFY(ind_int(i)%p)
      ENDDO
      ALLOCATE(shf_int(ninter))
C
      intp_d = max(0,intp_c)
      nddl_si = 0
      nddl_sl = 0
      nz_si = 0
      nz_sl = 0
C
      RETURN

imp_frkd()

subroutine imp_frkd	(	integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	lpby,
		integer, dimension(*)	itab,
		integer	nrbyac,
		integer, dimension(*)	irbyac,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer	nint2,
		integer, dimension(*)	iint2,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer, dimension(*)	inloc,
		integer	nsrem,
		integer	nsl,
		integer	nbintc,
		integer, dimension(*)	intlist,
			x,
		integer, dimension(*)	ibfv,
		integer, dimension(*)	lj,
			skew,
			xframe,
		integer, dimension(*)	iskew,
		integer, dimension(*)	icodt,
			a,
			ud,
			lb,
		integer	ifdis,
			urd,
		integer, dimension(*)	iddli,
		integer, dimension(*)	irbe3,
		integer, dimension(*)	lrbe3,
			frbe3,
		integer, dimension(*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 5335 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s 
C-----------------------------------------------
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,*),NSREM  ,NSL,NBINTC,INTLIST(*)
      INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
     .        NINT2,IINT2(*),IDDL(*),IKC(*),NDOF(*),INLOC(*),
     .        IBFV(*),LJ(*),ISKEW(*),ICODT(*),IFDIS,IDDLI(*),
     .        IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*)
C     REAL
      my_real
     .       x(3,*),ud(3,*),a(3,*),skew(*),xframe(*),
     .       lb(*),urd(3,*),frbe3(*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER LSI,LSL,IDDLM(NUMNOD),ILOCP(NUMNOD)
      INTEGER I,J,K,L,N,NKC,J1,ND,LSG,
     .        NF_SL(NSL),NF_SI(NSREM),N_KINE,
     .        IAD_SLD(NSPMD+1),IAD_MLD(NSPMD+1),
     .        ISI ,ISL,NFV,LVSI,LVSL,LFSI,LFSL,NZ,
     .        IER1,IER2,IER3,IER4,IER5,IER6,IER7,LSI0
      my_real
     .       kss(6,nsl)
      INTEGER, DIMENSION(:),ALLOCATABLE :: IAD_M,IKCSI,IKCSL,
     .                                      IFVSI,IFVSL
      my_real, DIMENSION(:),ALLOCATABLE :: ksi_fr,ksl_fr,
     .                                     udsi,udsl,fdsi
C------------------------------------------------------------
C---IKCSI(NSREM),IKCSL(NSL): initialised by NDD=sum(IKC(id+1,3)) or 21 for NDOF=0
C---they are updated just after by DIM_FRKM :nb of [K}3x3-> is sent in SL
      CALL spmd_ifc1(nsrem  ,nsl ,kss)
C-------iddlm-----------------
      nkc=0
      isi =0
      lfsi = 0
      DO n =1,numnod
       i=inloc(n)
       iddlm(i)=iddl(i)-nkc
       DO j=1,ndof(i)
        nd = iddl(i)+j
        IF (ikc(nd)/=0) nkc = nkc + 1
       ENDDO
      ENDDO
      IF (nsl>0) THEN
       CALL imp_frsn(ipari ,intbuf_tab  ,nbintc,intlist)
       ALLOCATE(iad_m(nsl+1))
      ENDIF
      DO i=1,nsrem
        nf_si(i) = 0
      ENDDO
C------if there is des neouds kin---IKC_SL(NSL)>0->IKC_SI----
      CALL ini_frkc(nsrem  ,nsl ,ikc ,ndof ,iddl)
C------com. [Ksm] seconds remotes dependant--s.KSI;r.KSL-IKC_SI,SL->nb [Ksm]--
      CALL dim_frkm(nsrem  ,nsl  ,lsi   ,lsl  )
      lsi0 = lsi
      lsg = lsi+lsl
C      due to if (NSREM+NSL>0) outside CALL SPMD_MAX_I(LSG)
      IF (lsg >= 0) THEN
       IF (ifdis>0) nfv = 0
       IF (lsi>0) THEN
        ALLOCATE(ksi_fr(9*lsi),stat=ier1)
        CALL ini_ksi(nsrem  ,ksi_fr ,iddli )
       ENDIF
       IF (lsl>0) ALLOCATE(ksl_fr(9*lsl),stat=ier2)
       CALL scom_frk(ksi_fr,ksl_fr,lsi   ,lsl)
C--------condense KSL_FR------
       IF (lsl>0) THEN
        CALL kin_ksl(
     1    ipari     ,intbuf_tab,nint2     ,iint2     ,
     2    npby      ,lpby      ,itab      ,nrbyac    ,irbyac    ,
     3    x         ,ibfv      ,lj        ,skew      ,xframe    ,
     4    iskew     ,icodt     ,ndof      ,ilocp     ,nsl       ,
     5    iad_m     ,irbe3     ,lrbe3     ,irbe2     ,lrbe2     )
        lsi = iad_m(nsl+1) -iad_m(1)
        CALL ind_sld(nsl  ,ndof  ,kss  )
C------- Use tempo ksi_fr for k_sl modifies- (handshakes) -----------------------------------------------------------
        IF(ALLOCATED(ksi_fr)) DEALLOCATE(ksi_fr)
        ALLOCATE(ksi_fr(9*lsi),stat=ier3)
        CALL upd_ksl(
     1    ipari     ,intbuf_tab,nint2     ,iint2     ,
     2    npby      ,lpby      ,itab      ,nrbyac    ,irbyac    ,
     3    x         ,ibfv      ,lj        ,skew      ,xframe    ,
     4    iskew     ,icodt     ,ilocp     ,nsl       ,iad_m     ,
     5    iddl      ,ikc       ,ndof      ,iddlm     ,ud        ,
     6    a         ,lb        ,kss       ,ksl_fr    ,ksi_fr    ,
     7    irbe3     ,lrbe3     ,frbe3     ,irbe2     ,lrbe2     )
C-------if there is imposed Ud(local second), must return UDSL->UDSI---------
C-------NFV: nb of /IMPVEL node in SL, use ISLM(NFV) to save node num.
        IF (ifdis>0) THEN
         CALL dim_fvn(
     1    ndof      ,iddl      ,ikc       ,ilocp     ,nfv      )
         IF (nfv > 0) THEN
          CALL ind_fvn(
     1    ndof      ,iddl      ,ikc       ,ilocp     ,nfv     )
          ALLOCATE(udsl(3*nfv))
C------ Change the due to the kSS and ini USLD --- Put kSS in K_SL --------------------
          CALL imp_fvkss(
     1    kss      ,iddl      ,iddlm     ,ikc       ,nsl      ,
     2    ud       ,lb        ,nfv       ,udsl      ,ilocp    ,
     3    ndof     )
         ENDIF
        ENDIF     ! IF (IFDIS>0)
       ENDIF      ! IF (LSL>0)
C------- Dim for re-copy ksi_fr (k_sl modifies) a k_sl (only remains ikc = 0 -----------------------
       CALL dim_frkm1(nsrem,nsl  ,iddl ,ikc ,ndof  ,
     .                nf_si,nf_sl,lsi  ,lsl ,isi ,isl )
C
       IF (lsl>0) THEN
        IF(ALLOCATED(ksl_fr)) DEALLOCATE(ksl_fr)
        ALLOCATE(ksl_fr(9*lsl),ikcsl(3*isl),stat=ier5)
        IF (isl>0) ikcsl=1
        CALL tra_frkm(nsl  ,iddl ,ikc ,ndof  ,iad_m ,
     .               ksi_fr,ksl_fr,ikcsl)
        IF(ALLOCATED(ksi_fr)) DEALLOCATE(ksi_fr)
        IF (ifdis>0) ALLOCATE(ifvsl(isl))
       ENDIF
       IF (lsi>0) THEN
        IF(ALLOCATED(ksi_fr)) DEALLOCATE(ksi_fr)
        ALLOCATE(ksi_fr(9*lsi),ikcsi(3*isi),stat=ier6)
        IF (ifdis>0) ALLOCATE(ifvsi(isi))
       ENDIF
C-------s: KSL_FR, r:KSI_FR :[Ksm] condense-----
       lsg = lsi+lsl
C       CALL SPMD_MAX_I(LSG)
       IF (lsg >= 0)
     .  CALL scom_frk1(ksl_fr,ksi_fr,nf_sl,nf_si,ikcsl,ikcsi)
       IF(ALLOCATED(ksl_fr)) DEALLOCATE(ksl_fr)
       IF (ifdis>0) THEN
C------- Ini lvsi for receiving UD (LVSI) ------
        CALL ini_frud(nsrem ,nsl   ,nfv   ,ifvsi ,ifvsl ,
     .                nf_si ,nf_sl ,lvsi  )
        IF (lvsi>0) ALLOCATE(udsi(3*lvsi))
        CALL scom_frud(udsl,udsi,nf_sl,nf_si,ifvsl,ifvsi)
C------ Modifies lb (Mi) from to [ksm]^t ', ud (si) ------
        IF (lvsi>0) CALL imp_fvksl(
     1    iddl      ,iddlm     ,ikc       ,ifvsi      ,nf_si     ,
     2    ksi_fr    ,lb        ,nsrem     ,udsi       )
        IF(ALLOCATED(udsi).AND.lvsi>0) DEALLOCATE(udsi)
       ENDIF
        IF(ALLOCATED(udsl).AND.nfv>0) DEALLOCATE(udsl)
        IF(ALLOCATED(ifvsi).AND.isi>0) DEALLOCATE(ifvsi)
        IF(ALLOCATED(ifvsl).AND.isl>0) DEALLOCATE(ifvsl)
        IF(ALLOCATED(ikcsl).AND.isl>0) DEALLOCATE(ikcsl)
C
      ENDIF ! (LSG>0)
      IF (nsl>0) THEN
       DEALLOCATE(iad_m)
       CALL imp_frks(nsl  ,iddl ,ikc ,ndof  ,iddlm,kss  ,iad_sld )
      ENDIF
C
      IF (ifdis>0) nfv = 0
      IF (nsrem>0) THEN
       DO n =1,numnod
        ilocp(n)=0
       ENDDO
C--------N_KINE: NML---LSI number of kinematic nodes-
       n_kine=0
       CALL tag_intml(nsrem  ,ilocp  ,n_kine ,iddl ,ikc ,ndof ,lsi)
       IF (lsi>0) THEN
        ALLOCATE(iad_m(n_kine+1))
        CALL kin_kml(
     1    ipari     ,intbuf_tab,nint2     ,iint2     ,
     2    npby      ,lpby      ,itab      ,nrbyac    ,irbyac    ,
     3    x         ,ibfv      ,lj        ,skew      ,xframe    ,
     4    iskew     ,icodt     ,ndof      ,ilocp     ,nsrem     ,
     5    iddl      ,ikc       ,iad_m     ,n_kine    ,irbe3     ,
     6    lrbe3     ,irbe2     ,lrbe2     )
C------- Use tempo ksl_fr for kml_fr modifies -------------------------------------------------
        lsl = iad_m(n_kine+1) -iad_m(1)
        ALLOCATE(ksl_fr(9*lsl),stat=ier7)
        CALL upd_kml(
     1    ipari     ,intbuf_tab,nint2     ,iint2     ,
     2    npby      ,lpby      ,itab      ,nrbyac    ,irbyac    ,
     3    x         ,ibfv      ,lj        ,skew      ,xframe    ,
     4    iskew     ,icodt     ,ilocp     ,n_kine    ,iad_m     ,
     5    iddl      ,ikc       ,ndof      ,iddlm     ,ud        ,
     6    a         ,ksl_fr    ,ksi_fr    ,nsrem     ,nf_si     ,
     7    iddli     ,irbe3     ,lrbe3     ,frbe3     ,irbe2     ,
     8    lrbe2     )
        IF (ifdis>0) THEN
         CALL dim_fvn(
     1    ndof      ,iddl      ,ikc       ,ilocp     ,nfv     )
         IF (nfv > 0) THEN
          CALL ind_fvn(
     1    ndof      ,iddl      ,ikc       ,ilocp     ,nfv     )
          DO i=1,nsrem
           DO j =1, max(1,nf_si(i))
            lfsi = lfsi + 1
           ENDDO
          ENDDO
          ALLOCATE(fdsi(3*lfsi))
C------- Modifies FDSI from AU [KSM], UD (Mi) -----
          CALL imp_fvkm(
     1    ksi_fr   ,ksl_fr   ,iddl      ,ndof      ,ikc       ,
     2    ilocp    ,iad_m    ,nsrem     ,n_kine    ,ud        ,
     3    fdsi     ,nf_si    ,nfv       ,lfsi      ,iddli     )
         ENDIF
        ENDIF
       ENDIF
       lsi = lsi + isi + lsi0
C-------updates [Ksm] and stores in LT_SI----
       CALL imp_frkm(
     1    nsrem     ,lsi       ,ikcsi   ,ikc     ,ndof    ,
     2    iddl      ,iddlm     ,ilocp   ,iad_m   ,ksi_fr  ,
     3    ksl_fr    ,nf_si     ,iad_mld ,iddli   )
      ENDIF
        IF(ALLOCATED(iad_m)) DEALLOCATE(iad_m)
        IF(ALLOCATED(ksi_fr)) DEALLOCATE(ksi_fr)
        IF(ALLOCATED(ksl_fr)) DEALLOCATE(ksl_fr)
       IF (ifdis>0) CALL ini_frfd(nsrem ,nfv ,ikcsi,nf_si ,fdsi )
       CALL cp_iadd(nsl ,nsrem,iad_sld  ,iad_mld)
       IF (ifdis>0) CALL spmd_ifrf(lb )
C ----- IAD_SL, IAD_SREM in DDL -----
        IF(ALLOCATED(ikcsi).AND.isi>0) DEALLOCATE(ikcsi)
        IF(ALLOCATED(fdsi).AND.lfsi>0) DEALLOCATE(fdsi)
C----6---------------------------------------------------------------7---------8
      RETURN

imp_frki()

subroutine imp_frki	(	integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(*)	num_imp,
		integer, dimension(*)	ns_imp,
		integer, dimension(*)	ne_imp,
		integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	lpby,
		integer, dimension(*)	itab,
		integer	nrbyac,
		integer, dimension(*)	irbyac,
		integer	nint2,
		integer, dimension(*)	iint2,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer, dimension(*)	inloc,
		integer	nsrem,
		integer	nsl,
		integer	nbintc,
		integer, dimension(*)	intlist,
			x,
		integer, dimension(*)	ibfv,
		integer, dimension(*)	lj,
			skew,
			xframe,
		integer, dimension(*)	iskew,
		integer, dimension(*)	icodt,
		integer, dimension(*)	irbe3,
		integer, dimension(*)	lrbe3,
			frbe3,
		integer, dimension(*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 252 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s 
C-----------------------------------------------
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,*),NUM_IMP(*),NS_IMP(*),
     .        NE_IMP(*),NSREM  ,NSL,NBINTC,INTLIST(*)
      INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
     .        NINT2,IINT2(*),IDDL(*),IKC(*),NDOF(*),INLOC(*),
     .        IBFV(*),LJ(*),ISKEW(*),ICODT(*),IRBE3(*),LRBE3(*),
     .        IRBE2(*),LRBE2(*)
C     REAL
      my_real
     .       x(3,*),skew(*),xframe(*),frbe3(*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NIN,NTY,ILOCP(NUMNOD),IDDLM(NUMNOD),LNS,LNS2,N_KINE
      INTEGER I,J,K,L,NDOFI,N,IAD,NRTS,
     .        NSN,NKC,J1,ND,N_KINE_M,LNSS ,LNSS2,LNS3,LNSS3,
     .        LRS2,LRSS2
      my_real
     .       kss(6,nsl)
C------comm. table of remote secondary nodes (to origin proc) and diag_ss
      CALL spmd_ifc1(nsrem  ,nsl ,kss )
      IF (nsl>0) CALL imp_frsn(ipari ,intbuf_tab  ,nbintc,intlist)
C      IF ((NSREM+NSL)==0) RETURN
      DO n =1,numnod
       ilocp(n)=0
      ENDDO
C--------tag additional nodes possibly dependent----
      n_kine=0
C
      CALL tag_ints(nsl    ,ilocp     ,n_kine)
      n_kine_m=n_kine
      IF (nsrem>0) THEN
       iad=1
       DO nin=1,ninter
        nty   =ipari(7,nin)
        IF(nty==5) iad=iad+num_imp(nin)
       ENDDO
       DO nin=1,ninter
        nsn   =ipari(5,nin)
        nty   =ipari(7,nin)
        IF(nty==3)THEN
        ELSEIF(nty==4)THEN
        ELSEIF(nty==5)THEN
        ELSEIF(nty==6)THEN
        ELSEIF(nty==7.OR.nty==10.OR.nty==24)THEN
C
         CALL tag_intm(num_imp(nin),ns_imp(iad),ne_imp(iad),
     .                 intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV , ilocp    ,
     .                 n_kine  ,nsn   )
         iad=iad+num_imp(nin)
C
        ELSEIF(nty==11)THEN
         nrts   =ipari(3,nin)
         CALL tag_intm11(num_imp(nin),ns_imp(iad),ne_imp(iad),
     .                 intbuf_tab(nin)%IRECTS,intbuf_tab(nin)%IRECTM, ilocp   ,
     .                 n_kine  ,nrts  )
         iad=iad+num_imp(nin)
C
        ENDIF
       ENDDO
      ENDIF
C-------init iml--isl ----
      CALL ini_intm(ilocp  ,n_kine_m, n_kine    )
C-------iddlm-----------------
      nkc=0
      DO n =1,numnod
       i=inloc(n)
       iddlm(i)=iddl(i)-nkc
       DO j=1,ndof(i)
        nd = iddl(i)+j
        IF (ikc(nd)/=0) nkc = nkc + 1
       ENDDO
      ENDDO
C-----coupling with kinematic constraints ------
      CALL dim_kinefr(
     1    npby      ,lpby      ,itab      ,nrbyac    ,irbyac    ,
     2    nint2     ,iint2     ,ipari     ,intbuf_tab,ilocp,
     3    lns       ,lns2      ,lnss      ,lnss2     ,n_kine_m  ,
     4    irbe3     ,lns3      ,lnss3     ,irbe2     ,lrbe2     ,
     5    lrs2      ,lrss2     )
      CALL ind_kinefr(
     1    npby      ,lpby      ,itab      ,nrbyac    ,irbyac    ,
     2    nint2     ,iint2     ,ipari     ,intbuf_tab,ilocp,
     3    lns       ,lns2      ,lnss      ,lnss2     ,n_kine_m  ,
     4    ibfv      ,lj        ,iskew     ,icodt     ,irbe3     ,
     5    lns3      ,lnss3     ,irbe2     ,lrbe2     ,lrs2      ,
     6    lrss2     )
      CALL iddl_int(nsl    ,iddl    ,ikc    ,ndof     ,iddlm   ,
     .              ipari  ,intbuf_tab ,irbe3  ,lrbe3    ,frbe3   ,
     .              x      ,skew    ,irbe2  ,lrbe2    )
      IF (nsl>0)
     . CALL diag_int(nsl    ,ndof    ,ipari  ,intbuf_tab,
     .               kss    ,x       ,ibfv   ,skew    ,xframe  ,
     .               irbe3  ,lrbe3   ,irbe2  ,lrbe2   )
C----6---------------------------------------------------------------7---------8
      RETURN

imp_frkm()

subroutine imp_frkm	(	integer	nsrem,
		integer	ikinm,
		integer, dimension(3,*)	ikcsi,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer, dimension(*)	iddl,
		integer, dimension(*)	iddlm,
		integer, dimension(*)	inloc,
		integer, dimension(*)	iad_m,
			frk_si,
			frk_sl,
		integer, dimension(*)	nf_si,
		integer, dimension(*)	iad_mld,
		integer, dimension(*)	iddli )

Definition at line 8381 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer
     .   nsrem,iddl(*),iddlm(*),inloc(*),ikc(*),ndof(*),iad_m(*),
     .   ikcsi(3,*),ikinm ,nf_si(*) ,iad_mld(*) ,iddli(*)
      my_real
     .   frk_si(3,3,*) ,frk_sl(3,3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,K,P,L,NL,NJ,NDOFI,NZ,NDS,NKC,IAD,J1,K1,ID,NS,NM
      INTEGER IDDL_CP(NDDL_SI),IAD_CP(NDDL_SI+1),JDI_CP(NZ_SI),
     .        IAD_M1(NSREM+1),NR,IDM,JD,IADI,
     .        IER1,IER2,IER3,IER4,IER5,IER6
      my_real
     .  kij(3,3),lt_cp(nz_si)
c----------IDDL_SL->condense--For the case of no Kine nodes should change also local id->globle --
C-------------(debug) 257564: 
       CALL cp_int((nddl_si+1),iad_si,iad_cp)
       CALL cp_int(nz_si,jdi_si,jdi_cp)
       CALL cp_real(nz_si,lt_si,lt_cp)
c---------ini IAD_MLD----
       ndofi = 3
       nl = 0
       nz = 0
      iad_mld(1) = nl +1
      IF (ikinm==0 ) THEN
       DO p=1,nspmd
        DO i=iad_srem(p),iad_srem(p+1)-1
         nl = nl + ndofi
         DO k = 1,ndofi
          DO j1 =iad_sinr(i), iad_sinr(i+1)-1
           nj = jdi_sinr(j1)
           id = iddl(nj)
           idm = iddlm(nj)
C-----------INPEND. LT_CP-------
            IF (ndof(nj)>0) THEN
             id = iddl_si(i)
             jd = iddli(nj)
             CALL getfr_kij( id    ,jd   ,iad_cp ,jdi_cp,lt_cp  ,
     1                       kij   ,ndofi,ndofi )
             DO k1 = 1,ndofi
               nz = nz + 1
               jdi_si(nz) = idm + k1
               lt_si(nz) = kij(k,k1)
             ENDDO
            END IF !(NDOF(NJ)>0) THEN
           END DO !J1 =IAD_SINR(I), IAD_SINR(I+1)-1
         END DO !DO K = 1,NDOFI
        END DO
        iad_mld(p+1) = nl +1
       END DO !DO P=1,NSPMD
      ELSE
C
       iad_m1(1) = 0
       DO n=1,nsrem
        iad_m1(n+1) = iad_m1(n)+ikc_si(n)*nf_si(n)
       ENDDO
c----------DIMENSION----
       nl = 0
       nz = 0
       iad = 1
       DO i=1,nsrem
C-----------SECOND DEPEND.: FRK_SI---------
        IF (ikc_si(i)>0) THEN
         DO j =1, nf_si(i)
          DO k = 1,ndofi
           IF (ikcsi(k,iad)==0) THEN
            nl = nl + 1
            DO j1 =iad_sinr(i), iad_sinr(i+1)-1
             nj = jdi_sinr(j1)
             id = iddl(nj)
             DO k1 = 1,ndofi
              IF (ikc(k1+id)==0) nz = nz + 1
             ENDDO
C-----------DEPEND. SUP-:FRK_SL--------
             ns = inloc(nj)
            IF (ikc_sl(ns)>0) THEN
             DO l =iad_slnr(ns), iad_slnr(ns+1)-1
              nm = jdi_slnr(l)
              id = iddl(nm)
              DO k1 = 1,ndofi
               IF (ikc(k1+id)==0) nz = nz + 1
              ENDDO
             ENDDO
            ENDIF
            ENDDO
           ENDIF
          ENDDO
          iad = iad + 1
         ENDDO
C-----------SECOND INDEPEND.:LT,FRK_SL---------
        ELSE
         DO k = 1,ndofi
          nl = nl + 1
          DO j1 =iad_sinr(i), iad_sinr(i+1)-1
           nj = jdi_sinr(j1)
           id = iddl(nj)
           ns = inloc(nj)
           IF (ikc_sl(ns)>0) THEN
C-----------DEPEND. SUP-:FRK_SL--------
C-------------debug 257564: forget /BCS
            nr = iad_slnr(ns+1)-iad_slnr(ns)
                IF (nr==0) THEN
              DO k1 = 1,ndofi
               IF (ikc(k1+id)==0) nz = nz + 1
              ENDDO
                ELSE
            DO l =iad_slnr(ns), iad_slnr(ns+1)-1
             nm = jdi_slnr(l)
             id = iddl(nm)
              DO k1 = 1,ndofi
               IF (ikc(k1+id)==0) nz = nz + 1
              ENDDO
             IF (ndof(nm)==6) THEN
              DO k1 = 1,ndofi
               IF (ikc(k1+id+3)==0) nz = nz + 1
              ENDDO
             END IF
            ENDDO
                END IF !(NR==0) THEN
           ELSE
C-----------INPEND. LT_CP-------
            nz = nz + ndofi
           ENDIF
          ENDDO
         ENDDO
        ENDIF
       ENDDO
C
       nddl_si = nl
C
       IF(ALLOCATED(iad_si)) DEALLOCATE(iad_si)
       ALLOCATE(iad_si(nl+1),stat=ier1)
      IF (nz>nz_si) THEN
       IF(ALLOCATED(jdi_si)) DEALLOCATE(jdi_si)
       ALLOCATE(jdi_si(nz),stat=ier2)
       IF(ALLOCATED(lt_si)) DEALLOCATE(lt_si)
       ALLOCATE(lt_si(nz),stat=ier3)
      ENDIF
      nz_si =nz
C
       nl = 0
       nz = 0
       iad = 1
       iad_si(nl+1) = nz+1
       DO p=1,nspmd
        DO i=iad_srem(p),iad_srem(p+1)-1
C-----------SECOND DEPEND.: FRK_SI---------
        IF (ikc_si(i)>0) THEN
         nr = iad_sinr(i+1)-iad_sinr(i)
         DO j =1, nf_si(i)
          DO k = 1,ndofi
           IF (ikcsi(k,iad)==0) THEN
            nl = nl + 1
            DO j1 =iad_sinr(i), iad_sinr(i+1)-1
             nj = jdi_sinr(j1)
             id = iddl(nj)
             idm = iddlm(nj)
             IF (ndof(nj)>0) THEN
             nkc = 0
             iadi = iad_m1(i) +nf_si(i)*(j1-iad_sinr(i))+ j
             DO k1 = 1,ndofi
              IF (ikc(k1+id)==0) THEN
               nz = nz + 1
               jdi_si(nz) = idm + k1-nkc
               lt_si(nz) = frk_si(k,k1,iadi)
              ELSE
               nkc = nkc + 1
              ENDIF
             ENDDO
             END IF !(NDOF(NJ)>0) THEN
C-----------DEPEND. SUP-:FRK_SL--------
             ns = inloc(nj)
            IF (ikc_sl(ns)>0) THEN
             DO l =iad_slnr(ns), iad_slnr(ns+1)-1
              nm = jdi_slnr(l)
              id = iddl(nm)
              idm = iddlm(nm)
              IF (ndof(nm)>0) THEN
              nkc = 0
              iadi = iad_m(ns) + l-iad_slnr(ns) + i
              DO k1 = 1,ndofi
               IF (ikc(k1+id)==0) THEN
                nz = nz + 1
                jdi_si(nz) = idm + k1-nkc
                lt_si(nz) = frk_sl(k,k1,iadi)
               ELSE
                nkc = nkc + 1
               ENDIF
              ENDDO
              END IF !(NDOF(NM)>0) THEN
             ENDDO
            ENDIF
            ENDDO
            iad_si(nl+1) = nz+1
           ENDIF
          ENDDO
          iad = iad + 1
         ENDDO
C-----------SECOND INDEPEND.:LT,FRK_SL---------
        ELSE
         DO k = 1,ndofi
          nl = nl + 1
          DO j1 =iad_sinr(i), iad_sinr(i+1)-1
           nj = jdi_sinr(j1)
           id = iddl(nj)
           idm = iddlm(nj)
c           IF (NDOF(NJ)>0) THEN
C
           nkc = 0
           ns = inloc(nj)
           IF (ikc_sl(ns)>0) THEN
C-----------DEPEND. SUP-:FRK_SL--------
            nr = iad_slnr(ns+1)-iad_slnr(ns)
C-----------/BCS--------
                IF (nr==0) THEN
             jd = iddli(nj)
             CALL getfr_kij(iddl_si(i),jd   ,iad_cp ,jdi_cp,lt_cp  ,
     1                       kij   ,ndofi,ndofi )
             nkc = 0
             DO k1 = 1,ndofi
               IF (ikc(k1+id)==0) THEN
                nz = nz + 1
                jdi_si(nz) = idm + k1 -nkc
                lt_si(nz) = kij(k,k1)
               ELSE
                nkc = nkc + 1
               END IF !(IKC(K1+ID)==0) THEN
             ENDDO
                ELSE
            DO l =iad_slnr(ns), iad_slnr(ns+1)-1
             nm = jdi_slnr(l)
             id = iddl(nm)
             idm = iddlm(nm)
             nkc = 0
             iadi = iad_m(ns) + l-iad_slnr(ns) +i-1
              DO k1 = 1,ndofi
               IF (ikc(k1+id)==0) THEN
                nz = nz + 1
                jdi_si(nz) = idm + k1-nkc
                lt_si(nz) = frk_sl(k1,k,iadi)
               ELSE
                nkc = nkc + 1
               ENDIF
              ENDDO
              IF (ndof(nm)==6) THEN
               DO k1 = 4,ndofi+3
                IF (ikc(k1+id)==0) THEN
                 nz = nz + 1
                 jdi_si(nz) = idm + k1-nkc
                 lt_si(nz) = frk_sl(k1-3,k,iadi+nsrem)
                ELSE
                 nkc = nkc + 1
                ENDIF
               ENDDO
              END IF
             ENDDO
                 END IF !(NR==0) THEN
           ELSEIF (ndof(nj)>0) THEN
C-----------INPEND. LT_CP-------
             id = iddl_si(i)
             jd = iddli(nj)
             CALL getfr_kij( id    ,jd   ,iad_cp ,jdi_cp,lt_cp  ,
     1                       kij   ,ndofi,ndofi )
              DO k1 = 1,ndofi
               nz = nz + 1
               jdi_si(nz) = idm + k1
               lt_si(nz) = kij(k,k1)
              ENDDO
           ENDIF !IF IKC_SL
C           END IF !(NDOF(NJ)>0) THEN
          ENDDO !DO J1
          iad_si(nl+1) = nz+1
         ENDDO !DO K
        ENDIF !IF IKC_SI
        ENDDO !DO I=
        iad_mld(p+1) = nl+1
       ENDDO ! DO P=
      END IF !IF (IKINM==0 )
C
       IF(ALLOCATED(iddl_si)) DEALLOCATE(iddl_si)
c       IF(ALLOCATED(IKC_SI)) DEALLOCATE(IKC_SI)
       IF(ALLOCATED(ikc_sl)) DEALLOCATE(ikc_sl)
       IF(ALLOCATED(usi)) DEALLOCATE(usi)
       ALLOCATE(usi(nddl_si),stat=ier4)
       IF(ALLOCATED(fsi)) DEALLOCATE(fsi)
       ALLOCATE(fsi(nddl_si),stat=ier5)
C
      RETURN

imp_frks()

subroutine imp_frks	(	integer	nsl,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer, dimension(*)	iddlm,
			kss,
		integer, dimension(*)	iad_sld )

Definition at line 9575 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSL ,IDDL(*),IKC(*),NDOF(*),IDDLM(*),IAD_SLD(*)
C     REAL
      my_real
     .  kss(6,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER IDDL_CP(NDDL_SL),IAD_CP(NDDL_SL+1),JDI_CP(NZ_SL),
     .        NR,NK,NN,IDM,JD,IADI,IDJ,IDJM,IAD,NDOFI
      INTEGER I,J,K,N,P,ID,NJ,NB,NKC,NL,NZ,K1,NKC1,J1,NM,
     .        IER1,IER2,IER3,IER4,IER5,IER6
      my_real
     .  kii(6,6),kij(6,6),lt_cp(nz_sl),diag_cp(nddl_sl)
C-------------------------------------
C----------if there is kin modif copy----
      IF (nddl_sl>0) THEN
       nn = 0
       DO i = 1,nsl
        IF (ikc_sl(i)>0) THEN
C----------int2,rb------------
         nb = iad_slnr(i+1)-iad_slnr(i)
         nn = nn + max(1,nb)
        ENDIF
       ENDDO
       CALL cp_int((nddl_sl+1),iad_ss,iad_cp)
       CALL cp_int(nn,iddl_sl,iddl_cp)
       CALL cp_int(nz_sl,jdi_sl,jdi_cp)
       CALL cp_real(nddl_sl,diag_sl,diag_cp)
       CALL cp_real(nz_sl,lt_sl,lt_cp)
      ENDIF
C------dim--[K_SL]-
       nl = 0
       nz = 0
       DO i = 1,nsl
         IF (ikc_sl(i)>0) THEN
          DO j=iad_slnr(i),iad_slnr(i+1)-1
           nj = jdi_slnr(j)
           id = iddl(nj)
           DO k =1,ndof(nj)
            IF (ikc(id+k)==0) THEN
             nl = nl + 1
C----------mij----------
             DO j1=iad_slnr(i),j-1
              nk = jdi_slnr(j1)
              idj = iddl(nk)
              DO k1 =1,ndof(nk)
               IF (ikc(idj+k1)==0) nz = nz + 1
              ENDDO
             ENDDO
             DO k1 = 1, k-1
              IF (ikc(id+k1)==0) nz = nz + 1
             ENDDO
            ENDIF
           ENDDO
          ENDDO
          IF (iad_slnr(i)==iad_slnr(i+1)) THEN
           n = isl(i)
           id = iddl(n)
           DO k =1,min(3,ndof(n))
            IF (ikc(id+k)==0) THEN
             nl = nl + 1
             DO k1 = 1, k-1
              IF (ikc(id+k1)==0) nz = nz + 1
             ENDDO
            ENDIF
           ENDDO
          ENDIF
C------independent nodes---------
         ELSE
          n = isl(i)
          DO k =1,min(3,ndof(n))
            nl = nl + 1
            DO k1 = 1, k-1
             nz = nz + 1
            ENDDO
          ENDDO
         ENDIF
       ENDDO
C-----allocation------
       IF(ALLOCATED(iddl_sl)) DEALLOCATE(iddl_sl)
       ALLOCATE(iddl_sl(nl),stat=ier4)
       IF (nl>nddl_sl) THEN
        IF(ALLOCATED(iad_ss)) DEALLOCATE(iad_ss)
        ALLOCATE(iad_ss(nl+1),stat=ier1)
C---------iddl devient idtok---
        IF(ALLOCATED(diag_sl)) DEALLOCATE(diag_sl)
        ALLOCATE(diag_sl(nl),stat=ier5)
       ENDIF
       IF (nz>nz_sl) THEN
        IF(ALLOCATED(jdi_sl)) DEALLOCATE(jdi_sl)
        ALLOCATE(jdi_sl(nz),stat=ier2)
        IF(ALLOCATED(lt_sl)) DEALLOCATE(lt_sl)
        ALLOCATE(lt_sl(nz),stat=ier3)
       ENDIF
       nddl_sl = nl
       nz_sl = nz
C
       nl = 0
       nz = 0
       nn = 0
       iad_ss(nl+1) = nz + 1
       iad_sld(1) = nl + 1
       DO p = 1,nspmd
        DO i = iad_sl(p), iad_sl(p+1)-1
         IF (ikc_sl(i)>0) THEN
          iad = nn
          DO j=iad_slnr(i),iad_slnr(i+1)-1
           nn = nn + 1
           nj = jdi_slnr(j)
           id = iddl(nj)
           idm = iddlm(nj)
           CALL get_kii(nn ,iddl_cp,iad_cp,diag_cp,lt_cp ,kii,ndof(nj))
           nkc =0
           DO k =1,ndof(nj)
            IF (ikc(id+k)==0) THEN
             nl = nl + 1
             iddl_sl(nl) =idm+k-nkc
             diag_sl(nl) = kii(k,k)
C----------mij----------
             DO j1=iad_slnr(i),j-1
              nk = jdi_slnr(j1)
              idj = iddl(nk)
              idjm = iddlm(nk)
              nm = iad + j1 - iad_slnr(i) + 1
              CALL get_kij(nm ,nn ,iddl_cp,iad_cp,jdi_cp,lt_cp ,kij ,
     .                     ndof(nk),ndof(nj) ,ier1 )
              nkc1 = 0
              DO k1 =1,ndof(nk)
               IF (ikc(idj+k1)==0) THEN
                nz = nz + 1
                jdi_sl(nz) = idjm +  k1- nkc1
                lt_sl(nz) = kij(k1,k)
C                LT_SL(NZ) = KIJ(K,K1)
               ELSE
                nkc1 = nkc1 + 1
               ENDIF
              ENDDO
             ENDDO
C----------mii----------
             nkc1 =0
             DO k1 = 1, k-1
              IF (ikc(id+k1)==0) THEN
               nz = nz + 1
               jdi_sl(nz) = idm +  k1- nkc1
               lt_sl(nz) = kii(k1,k)
              ELSE
               nkc1 =nkc1+1
              ENDIF
             ENDDO
             iad_ss(nl+1) = nz+1
            ELSE
             nkc =nkc+1
            ENDIF
           ENDDO
          ENDDO
          IF (iad_slnr(i)==iad_slnr(i+1)) THEN
           n = isl(i)
           id = iddl(n)
           idm = iddlm(n)
           nn = nn + 1
C
           ndofi = min(3,ndof(n))
           CALL get_kii(nn ,iddl_cp,iad_cp,diag_cp,lt_cp ,kii,ndofi)
           nkc =0
           DO k =1,ndofi
            IF (ikc(id+k)==0) THEN
             nl = nl + 1
             iddl_sl(nl) =idm+k-nkc
             diag_sl(nl) = kii(k,k)
             nkc1 =0
             DO k1 = 1, k-1
              IF (ikc(id+k1)==0) THEN
               nz = nz + 1
               jdi_sl(nz) = idm +  k1- nkc1
               lt_sl(nz) = kii(k1,k)
              ELSE
               nkc1 =nkc1+1
              ENDIF
             ENDDO
             iad_ss(nl+1) = nz+1
            ELSE
             nkc =nkc+1
            ENDIF
           ENDDO
          ENDIF
C------independent nodes---------
         ELSE
          n = isl(i)
          idm = iddlm(n)
          DO k =1,min(3,ndof(n))
           nl = nl + 1
           iddl_sl(nl) =idm+k
           diag_sl(nl) =kss(k,i)
           DO k1 = 1, k-1
            nz = nz + 1
            jdi_sl(nz) = idm +  k1
            id = k1 + k + 1
            lt_sl(nz) = kss(id,i)
           ENDDO
           iad_ss(nl+1) = nz+1
          ENDDO
         ENDIF
        ENDDO
        iad_sld(p+1) = nl + 1
       ENDDO
C
      RETURN

imp_frsl()

subroutine imp_frsl	(	integer	nbintc,
		integer	nsrem,
		integer	nsl )

Definition at line 700 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  NBINTC,NSL,NSREM
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I,IERROR1,IERROR2,IERROR3,IERROR4,IERROR5,
     .        II,IAD
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
      IF(ALLOCATED(iad_sl)) DEALLOCATE(iad_sl)
      ALLOCATE(iad_sl(nspmd+1),stat=ierror1)
      IF (nsrem==0) THEN
        IF(ALLOCATED(iad_srem)) DEALLOCATE(iad_srem)
        ALLOCATE(iad_srem(nspmd+1),stat=ierror2)
        DO i = 1, nspmd+1
         iad_srem(i)=1
        ENDDO
      ENDIF
C
       CALL spmd_inis(iad_srem,iad_sl)
       nsl=iad_sl(nspmd+1)-1
       IF (nsrem==0) THEN
         IF(ALLOCATED(inbsl)) DEALLOCATE(inbsl)
         ALLOCATE(inbsl(nbintc,nspmd),stat=ierror5)
         DO i = 1, nspmd
          DO ii = 1, nbintc
           inbsl(ii,i)=0
          ENDDO
         ENDDO
       ENDIF
       CALL spmd_inisl(nbintc,inbsl)
       IF (nsl>0) THEN
        IF(ALLOCATED(isl)) DEALLOCATE(isl)
        ALLOCATE(isl(nsl),stat=ierror3)
C
        IF (intp_d==0) THEN
        IF(ALLOCATED(diag_s)) DEALLOCATE(diag_s)
        ALLOCATE(diag_s(3,nsl),stat=ierror4)
        IF(ALLOCATED(islm)) DEALLOCATE(islm)
        ALLOCATE(islm(nsl),stat=ierror5)
C
        ENDIF
       ENDIF
 
C
      RETURN

imp_frsn()

subroutine imp_frsn	(	integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer	nbintc,
		integer, dimension(*)	intlist )

Definition at line 383 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
      USE intbufdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  IPARI(NPARI,*), NBINTC,INTLIST(*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,L,N,NN,IAD,NSN,NIN,NUM,NTY,II,NB
      INTEGER N0,N1,N2
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
        l = 0
C -----sort by proc---independent interface structure------
        DO i = 1, nspmd
          IF(iad_sl(i+1)>iad_sl(i))THEN
            DO ii = 1, nbintc
              nin = intlist(ii)
              nb = inbsl(ii,i)
              IF(nb>0)THEN
               nty  = ipari(7,nin)
               IF(nty==7.OR.nty==10.OR.nty==24) THEN
                  DO j = 1, nb
                   l = l + 1
                   n0 = isl(l)
                   n = intbuf_tab(nin)%NSV(n0)
                   isl(l) = n
                  ENDDO
C
               ELSEIF(nty==11) THEN
                  DO j = 1, nb/2
                   l = l + 1
                   n0 = isl(l)
                   n1 = intbuf_tab(nin)%IRECTS(2*(n0-1)+1)
                   n2 = intbuf_tab(nin)%IRECTS(2*(n0-1)+2)
                   isl(l) = n1
                   l = l + 1
                   isl(l) = n2
                  ENDDO
C
               END IF
              END IF
            ENDDO
          ENDIF
        ENDDO
C
      RETURN

imp_fvkm()

subroutine imp_fvkm	(		kfr_si,
			kfr_sl,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ndof,
		integer, dimension(*)	ikc,
		integer, dimension(*)	inloc,
		integer, dimension(*)	iad_m,
		integer	nsrem,
		integer	nsl,
			ud0,
			fdsi,
		integer, dimension(*)	nf_si,
		integer	nfv,
		integer	nfd,
		integer, dimension(*)	iddli )

Definition at line 9203 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSREM,IAD_M(*),NSL,IDDL(*),NDOF(*),INLOC(*),
     .        IKC(*),NF_SI(*),NFV,NFD,IDDLI(*)
C     REAL
      my_real
     .     ud0(3,*),kfr_si(3,3,*),kfr_sl(3,3,*),fdsi(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,K,M,NS,IAD_M1(NSREM+1),IS,JD,
     .        NJ,ND,NL,J1,NSS,NM,ID,IAD,NF,NR,IADI
      my_real
     .     ksm(3,3),ud(3,nfv)
C----------------------------
       nd = 3
       DO i = 1, nfd
        DO k =1,nd
         fdsi(k,i) = zero
        ENDDO
       ENDDO
       iad_m1(1) = 1
       DO n=1,nsrem
        iad_m1(n+1) = iad_m1(n)+ikc_si(n)*nf_si(n)
       ENDDO
       DO i = 1, nfv
        ns = islm(i)
        DO k =1,nd
         id = iddl(ns)+k
         IF ((ikc(id)>=2.AND.ikc(id)<=4).OR.ikc(id)==9) THEN
          ud(k,i)=ud0(k,ns)
         ELSE
          ud(k,i)=zero
         ENDIF
        ENDDO
        iad = 0
        DO is = 1,nsrem
         nr =iad_sinr(is+1)- iad_sinr(is)
         CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
          DO nf = 1,max(1,nf_si(is))
           iad = iad + 1
C----------------in KFR_SL------
           IF (inloc(ns)>nsl) THEN
C
               DO j = iad_sinr(is), iad_sinr(is+1)-1
            nj = jdi_sinr(j)
            nss = inloc(nj)
            nr=iad_slnr(nss+1)- iad_slnr(nss)
            CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j1)
            IF (j1>0) THEN
            iadi = iad_m(nss) + j1 + is -2
            DO k =1,nd
             fdsi(k,iad) = fdsi(k,iad)+kfr_sl(1,k,iadi)*ud(1,i)+
     .              kfr_sl(2,k,iadi)*ud(2,i)+kfr_sl(3,k,iadi)*ud(3,i)
            ENDDO
            ENDIF !(J1>0)
               ENDDO
C----------------in KFR_SI------
           ELSEIF (ikc_si(is)>0.AND.j>0) THEN
            n = 0
            CALL get_iad(iad_m1,iad_slnr,jdi_slnr,n    ,is  ,
     1                   j    ,ikc_si(is),ndof  ,iadi  )
            iadi = iadi + nf-1
            DO k =1,nd
             fdsi(k,iad) = fdsi(k,iad)+kfr_si(1,k,iadi)*ud(1,i)+
     .              kfr_si(2,k,iadi)*ud(2,i)+kfr_si(3,k,iadi)*ud(3,i)
            ENDDO
           ELSEIF (j>0) THEN
            id = iddl_si(is)
            nm = jdi_sinr(iad_sinr(is)+j-1)
            jd = iddli(nm)
            CALL getfr_kij( id    ,jd   ,iad_si ,jdi_si,lt_si  ,
     1                      ksm   ,nd   ,nd    )
            DO k =1,nd
              fdsi(k,iad) = fdsi(k,iad)+ksm(1,k)*ud(1,i)+
     .                    ksm(2,k)*ud(2,i)+ksm(3,k)*ud(3,i)
            ENDDO
           ENDIF
          ENDDO
        ENDDO
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

imp_fvksl()

subroutine imp_fvksl	(	integer, dimension(*)	iddl,
		integer, dimension(*)	iddlm,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ifvsi,
		integer, dimension(*)	nf_si,
			ksi,
			lb,
		integer	nsrem,
			udsi )

Definition at line 9098 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSREM,IDDLM(*),IKC(*),IDDL(*),IFVSI(*),NF_SI(*)
C     REAL
      my_real
     .     ksi(9,*),lb(*) ,udsi(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer
     .      i,j,j1,nj,iad,iadu,iadi,id,nd,jd,iad_m1(nsrem+1)
C----------------------------
       iad_m1(1) = 0
       DO i=1,nsrem
        iad_m1(i+1) = iad_m1(i)+ikc_si(i)*nf_si(i)
       ENDDO
       iad = 0
       iadu = 0
       DO i=1,nsrem
        IF (ikc_si(i)>0) THEN
          DO j =1, nf_si(i)
           iad = iad + 1
           IF (ifvsi(iad)>0) THEN
            iadu = iadu + 1
            DO j1 = iad_sinr(i),iad_sinr(i+1)-1
             nj = jdi_sinr(j1)
             iadi = iad_m1(i) +nf_si(i)*(j1-iad_sinr(i))+ j
             CALL imp_fvksm(
     1            nj       ,iddl      ,iddlm     ,ikc       ,
     2            udsi(1,iadu),ksi(1,iadi),lb        )
            ENDDO
           ENDIF
          ENDDO
        ENDIF
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

imp_fvksm()

subroutine imp_fvksm	(	integer	nj,
		integer, dimension(*)	iddl,
		integer, dimension(*)	iddlm,
		integer, dimension(*)	ikc,
			uds,
			ksm,
			lb )

Definition at line 9153 of file imp_fri.F.

C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NJ,IDDLM(*),IKC(*),IDDL(*)
C     REAL
      my_real
     .     ksm(3,3),  lb(*) ,uds(3)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer
     .        k,n,nd,ns,nkc,nm
      my_real
     .       lbd(3)
C----------------------------
         DO k=1,3
          lbd(k) = ksm(1,k)*uds(1)+ ksm(2,k)*uds(2)+
     .             ksm(3,k)*uds(3)
         ENDDO
C
         nkc = 1
         DO k = 1, 3
          nd = iddl(nj)+k
          nm = iddlm(nj) + nkc
          IF (ikc(nd)==0) THEN
           lb(nm) = lb(nm) -lbd(k)
           nkc = nkc + 1
          ENDIF
         ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

imp_fvkss()

subroutine imp_fvkss	(		kss,
		integer, dimension(*)	iddl,
		integer, dimension(*)	iddlm,
		integer, dimension(*)	ikc,
		integer	nsl,
			d_imp,
			lb,
		integer	nfv,
			udsl,
		integer, dimension(*)	inloc,
		integer, dimension(*)	ndof )

Definition at line 8796 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NFV,NSL,IDDLM(*),IKC(*),IDDL(*),
     .        INLOC(*),NDOF(*)
C     REAL
      my_real
     .     kss(6,*),  d_imp(3,*) ,lb(*) ,udsl(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer
     .       i,j,k,n,id,nd,ns,nkc,nm,is,nr,nj,nn,nl,im,
     .       iad_m1(nsl+1),iadn(nsl),jj
      my_real
     .       f_imp(6) ,kii(6,6)
C----------------------------
       iad_m1(1) = 1
         nn = 0
       DO i=1,nsl
        nl =0
        IF (ikc_sl(i)>0) THEN
         nr = iad_slnr(i+1)-iad_slnr(i)
         nl = max(1,nr)
         nn = nn + nl
         iadn(i) = nn
        ENDIF
        iad_m1(i+1) = iad_m1(i)+nl
       ENDDO
       DO i = 1, nfv
        n = islm(i)
        id = iddl(n)
        im = iddlm(n)
        DO k = 1, 3
         nd = id + k
         IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           udsl(k,i) = d_imp(k,n)
         ELSE
           udsl(k,i) = zero
         ENDIF
        ENDDO
        DO is = 1, nsl
        IF (inloc(n)>nsl) THEN
         nr = iad_slnr(is+1)-iad_slnr(is)
         CALL intabfr(nr,jdi_slnr(is),n,j)
         IF (j>0) THEN
          nn = iad_m1(is) + j -1
          nd = ndof(n)
          CALL get_kii(nn ,iddl_sl,iad_ss,diag_sl,lt_sl,kii,nd)
          DO j = 1, nd
          DO k = j+1, nd
           kii(k,j) = kii(j,k)
          ENDDO
          ENDDO
          DO k = 1, nd
           f_imp(k) = kii(k,1)*udsl(1,i)+ kii(k,2)*udsl(2,i)+
     .                kii(k,3)*udsl(3,i)
          ENDDO
          nkc = 1
          DO k = 1, nd
           IF (ikc(id+k)==0) THEN
            nm = im + nkc
            lb(nm) = lb(nm) -f_imp(k)
            nkc = nkc + 1
           ENDIF
          ENDDO
         ENDIF
        ELSE
         IF (n==isl(is)) THEN
              j = is
          f_imp(1) = kss(1,j)*udsl(1,i)+ kss(4,j)*udsl(2,i)+
     .              kss(5,j)*udsl(3,i)
          f_imp(2) = kss(4,j)*udsl(1,i)+ kss(2,j)*udsl(2,i)+
     .              kss(6,j)*udsl(3,i)
          f_imp(3) = kss(5,j)*udsl(1,i)+ kss(6,j)*udsl(2,i)+
     .              kss(3,j)*udsl(3,i)
          nd = 3
          nkc = 1
          DO k = 1, nd
           IF (ikc(id+k)==0) THEN
            nm = im + nkc
            lb(nm) = lb(nm) -f_imp(k)
            nkc = nkc + 1
           ENDIF
          ENDDO
          DO k = 1, nd
           kii(k,k) = kss(k,j)
          ENDDO
          kii(1,2)=kss(4,j)
          kii(1,3)=kss(5,j)
          kii(2,3)=kss(6,j)
          kii(2,1)=kii(1,2)
          kii(3,1)=kii(1,3)
          kii(3,2)=kii(2,3)
          CALL put_kii(iadn(j),iddl_sl,iad_ss,diag_sl,lt_sl,kii,nd)
         ENDIF
        ENDIF
        ENDDO  ! IS = 1, NSL
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

ind_fr_k()

subroutine ind_fr_k	(		elbuf,
		integer, dimension(nparg,*)	iparg,
		integer, dimension(nixs,*)	ixs,
		integer, dimension(nixq,*)	ixq,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(nixt,*)	ixt,
		integer, dimension(nixp,*)	ixp,
		integer, dimension(nixr,*)	ixr,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(4,*)	ixtg1,
		integer, dimension(6,*)	ixs10,
		integer, dimension(12,*)	ixs20,
		integer, dimension(8,*)	ixs16,
		integer, dimension(*)	ndof,
		integer	nnmax,
		integer, dimension(*)	inloc,
		integer, dimension(*)	fr_elem,
		integer, dimension(2,*)	iad_elem,
		integer	n_fr,
		integer, dimension(*)	igeo,
		type (elbuf_struct_), dimension(ngroup)	elbuf_tab )

Definition at line 3536 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
      USE elbufdef_mod            
      use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARG(NPARG,*),NNMAX,N_FR ,NDOF(*),IGEO(*)
      integer
     .   ixs(nixs,*),ixq(nixq,*),ixc(nixc,*), ixt(nixt,*),ixp(nixp,*),
     .   ixr(nixr,*), ixtg(nixtg,*),ixs10(6,*),ixs20(12,*),
     .   ixs16(8,*),ixtg1(4,*),inloc(*),fr_elem(*),iad_elem(2,*)
C     REAL
      my_real
     .   elbuf(*)
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NK,ICOL(NNMAX,N_FR),NROW(N_FR),IP,JLT,NFT,
     .        IERROR1,IERROR2,IERROR3,LS,LR,SSIZE,RSIZE,J0,L,NF1
C   ----  creer NROW,ICOL aux front.---------
      IF (n_fr>0) THEN
      DO n =1,numnod
       inloc(n)=0
      ENDDO
      DO n =1,n_fr
       nrow(n)=0
      ENDDO
      DO ip =1,nspmd
       jlt=iad_elem(1,ip+1)-iad_elem(1,ip)
       nft=iad_elem(1,ip)-1
       nf1=min(n_fr,nft+1)
       DO j=1,jlt
        nk=j+nft
        n=fr_elem(nk)
        inloc(n) = j
       ENDDO
       CALL dim_elemsp(
     1    elbuf     ,iparg     ,ixs       ,ixq       ,ixc       ,
     2    ixt       ,ixp       ,ixr       ,ixtg      ,ixtg1     ,
     3    ixs10     ,ixs20     ,ixs16     ,nrow(nf1),
     4    inloc     ,nnmax     ,icol(1,nf1),igeo   ,elbuf_tab )
       DO j=1,jlt
        nk=j+nft
        n=fr_elem(nk)
        inloc(n) = 0
       ENDDO
      ENDDO
C--------recupere fr_nrow --
       IF (n_frnn>0) THEN
        DO ip =1,nspmd
         DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
           DO l=iad_rl(nk),iad_rl(nk+1)-1
            CALL reorder_a(nrow(nk),icol(1,nk),fr_icol(l))
           ENDDO
         ENDDO
        ENDDO
       ENDIF
      ENDIF  ! (N_FR>0)
C------ind_ [k] of FR.------
       CALL ind_fr_k0(
     1    ndof      ,nrow      ,nnmax     ,icol      ,fr_elem   ,
     2    iad_elem  ,n_fr      )
C
      RETURN

ind_fr_k0()

subroutine ind_fr_k0	(	integer, dimension(*)	ndof,
		integer, dimension(*)	nrow,
		integer	nnmax,
		integer, dimension(nnmax,*)	icol,
		integer, dimension(*)	fr_elem,
		integer, dimension(2,*)	iad_elem,
		integer	n_fr )

Definition at line 3728 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "impl1_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NNMAX,N_FR ,NDOF(*),NROW(*)
      integer
     .   fr_elem(*),iad_elem(2,*),icol(nnmax,*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NK,IP,L,NDDL0,NZZK0,NN,IAD,NB,
     .        NNZ(NSPMD),NDOFJ,K,NDDL,NZZK,NJ,NK0,NJN,NL,NZZ,
     .        IERROR0,IERROR1,IERROR2,IERROR3,IERROR4,IERROR5
      INTEGER, DIMENSION(:),ALLOCATABLE :: ITAG
      my_real
     .        s1,stmp
C------ Sun [K] for each fr .-----
      IF (iroddl==0) THEN
       ndofj=3
      ELSE
       ndofj=6
      ENDIF
      nddlfr=0
      nddlfrb=0
      ndfrmax=0
      nzzk=0
      IF(ALLOCATED(nd_fr)) DEALLOCATE(nd_fr)
      ALLOCATE(nd_fr(nspmd),stat=ierror0)
      DO ip =1,nspmd
       nd_fr(ip)=0
       nnz(ip)=0
       DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
        n=fr_elem(nk)
        nd_fr(ip)=nd_fr(ip)+ndof(n)
        DO k=1,ndof(n)
C-------termes knn-------
         DO j=1,ndof(n)
          IF (j/=k) nnz(ip) = nnz(ip)+1
         ENDDO
C-------termes kn,nj-------
         DO j=1,nrow(nk)
          DO l=1,ndofj
           nnz(ip) = nnz(ip)+1
          ENDDO
         ENDDO
        ENDDO
       ENDDO
       nddlfr = nddlfr + nd_fr(ip)
       ndfrmax=max(ndfrmax,nd_fr(ip))
       nzzk = nzzk + nnz(ip)
      ENDDO
      nzzk = nzzk/2+1
      stmp = zero
      IF (nddlfr>0) THEN
       ALLOCATE(itag(n_fr))
       itag = 2
       DO nk=1,n_fr
        nb=-ifrloc(nk)
        IF (nb>0) itag(nb) = itag(nb) + 1
       ENDDO
       DO nk=1,n_fr
        nb=-ifrloc(nk)
        IF (nb<0) nb = nk
        s1 = one/itag(nb)
        stmp = stmp + s1*ndof(fr_elem(nb))
       ENDDO
       DEALLOCATE(itag)
      ENDIF
      CALL spmd_sum_s(stmp)
      nddlfrb = int(stmp)
      IF (nddlfr==0) RETURN
C
      nddl = nddlfr + nspmd
      IF(ALLOCATED(iadfr)) DEALLOCATE(iadfr)
      ALLOCATE(iadfr(nddl),stat=ierror1)
      IF(ALLOCATED(jdifr)) DEALLOCATE(jdifr)
      ALLOCATE(jdifr(nzzk),stat=ierror2)
      IF(ALLOCATED(iddlfr)) DEALLOCATE(iddlfr)
      ALLOCATE(iddlfr(n_fr),stat=ierror3)
      IF(ALLOCATED(ifr2k)) DEALLOCATE(ifr2k)
      ALLOCATE(ifr2k(nddlfr),stat=ierror4)
      IF (iprec>2.OR.iautspc>0) THEN
       IF(ALLOCATED(jfr2k)) DEALLOCATE(jfr2k)
       ALLOCATE(jfr2k(nzzk),stat=ierror5)
      ENDIF
      DO ip =1,nspmd
       nddl0=0
       DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
        n=fr_elem(nk)
        iddlfr(nk) = nddl0
        nddl0=nddl0+ndof(n)
       ENDDO
      ENDDO
C------ Ind_ [K] for each fr .-----
      nddl0 = nddl
      nzzk0 = nzzk
      nzzk=0
      iad=0
      DO ip =1,nspmd
       nk0=iad_elem(1,ip)-1
       nzz = 0
       nddl=1
       iadfr(nddl+iad)=1
       DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
        n=fr_elem(nk)
        CALL reorder_l(nrow(nk),icol(1,nk),nk-nk0,
     .                 iddlfr(iad_elem(1,ip)))
        IF (ndof(n)>0) THEN
          DO k=1,ndof(n)
C-------termes knj,n-------
            DO j=1,nrow(nk)
             nj = icol(j,nk)+nk0
             nn=fr_elem(nj)
             DO l=1,ndof(nn)
              nzz = nzz+1
              jdifr(nzz+nzzk) = iddlfr(nj)+l
             ENDDO
            ENDDO
            DO j=1,k-1
             nzz = nzz+1
             jdifr(nzz+nzzk) = iddlfr(nk)+j
            ENDDO
           nddl = nddl +1
           iadfr(nddl+iad) = nzz+1
          ENDDO
        ENDIF
       ENDDO
       nzzk = nzzk +nzz
       iad = iad + nddl
      ENDDO
      IF (nzzk>nzzk0.OR.iad/=nddl0)
     .    WRITE(*,*)'--MEMERY PROBLEM 3--:',nzzk,nzzk0,iad,nddl0
      nzkfr = nzzk
C
      RETURN

ind_frkd()

subroutine ind_frkd	(	integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(*)	num_imp,
		integer, dimension(*)	ns_imp,
		integer, dimension(*)	ne_imp,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer	nsrem,
		integer, dimension(*)	ind_imp )

Definition at line 4724 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,*),NUM_IMP(*),NS_IMP(*),
     .        NE_IMP(*),NSREM,IND_IMP(*)
      INTEGER IDDL(*),IKC(*),NDOF(*)
C     REAL
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NIN,NTY,NROW(NSREM)
      INTEGER I,J,K,L,NDOFI,N,IAD,INSV11,NRTS,
     .        INSV,NSN,NKC,J1,ND,IER1,NNMAX
      INTEGER, DIMENSION(:,:), ALLOCATABLE :: ICOL
C------------------------------------------------------------
C--------dim Nrow----
       DO n =1,nsrem
        nrow(n)=0
       ENDDO
C
       iad=1
       DO nin=1,ninter
        nty   =ipari(7,nin)
        IF(nty==5) iad=iad+num_imp(nin)
       ENDDO
       DO nin=1,ninter
        nsn   =ipari(5,nin)
        nty   =ipari(7,nin)
        IF(nty==3)THEN
        ELSEIF(nty==4)THEN
        ELSEIF(nty==5)THEN
        ELSEIF(nty==6)THEN
        ELSEIF(nty==7.OR.nty==10)THEN
C
         CALL rowfr_dim(num_imp(nin),ns_imp(iad),ne_imp(iad),
     .                  intbuf_tab(nin)%IRECTM,nrow   ,nsn   ,nin     )
         iad=iad+num_imp(nin)
        ELSEIF(nty==24)THEN
C
         CALL rowfr_dim24(num_imp(nin),ns_imp(iad),ne_imp(iad),
     .                  intbuf_tab(nin)%IRECTM,nrow   ,nsn   ,nin     ,
     .                   ind_imp  ,intbuf_tab(nin)%NVOISIN)
         iad=iad+num_imp(nin)
        ELSEIF(nty==11)THEN
         nrts   =ipari(3,nin)
         CALL rowfr_dim11(num_imp(nin),ns_imp(iad),ne_imp(iad),
     .                    intbuf_tab(nin)%IRECTM, nrow ,nrts ,nin      )
         iad=iad+num_imp(nin)
        ENDIF
       ENDDO
C
       nnmax=0
       DO n =1,nsrem
        nnmax=max(nnmax,nrow(n))
        nrow(n)=0
       ENDDO
       ALLOCATE(icol(nnmax,nsrem),stat=ier1)
C--------ind Nrow----
       iad=1
       DO nin=1,ninter
        nty   =ipari(7,nin)
        IF(nty==5) iad=iad+num_imp(nin)
       ENDDO
       DO nin=1,ninter
        nsn   =ipari(5,nin)
        nty   =ipari(7,nin)
        IF(nty==3)THEN
        ELSEIF(nty==4)THEN
        ELSEIF(nty==5)THEN
        ELSEIF(nty==6)THEN
        ELSEIF(nty==7.OR.nty==10)THEN
C
         CALL rowfr_ind(num_imp(nin),ns_imp(iad),ne_imp(iad),
     .                  intbuf_tab(nin)%IRECTM,nrow   ,icol  ,nnmax   ,
     .                  nsn     ,nin       )
         iad=iad+num_imp(nin)
        ELSEIF(nty==24)THEN
C
         CALL rowfr_ind24(num_imp(nin),ns_imp(iad),ne_imp(iad),
     .                  intbuf_tab(nin)%IRECTM,nrow   ,icol  ,nnmax   ,
     .                  nsn     ,nin  ,ind_imp ,intbuf_tab(nin)%NVOISIN)
         iad=iad+num_imp(nin)
        ELSEIF(nty==11)THEN
         nrts   =ipari(3,nin)
         CALL rowfr_ind11(num_imp(nin),ns_imp(iad),ne_imp(iad),
     .                    intbuf_tab(nin)%IRECTM, nrow ,icol  ,nnmax   ,
     .                    nrts   ,nin      )
         iad=iad+num_imp(nin)
        ENDIF
       ENDDO
C
        DO n =1,nsrem
         CALL reorder_fr(nrow(n),icol(1,n),iddl)
        ENDDO
        CALL set_ind_fr(
     1    nsrem     ,iddl      ,ndof      ,nrow      ,icol      ,
     2    nnmax     )
C
        DEALLOCATE(icol)
C----6---------------------------------------------------------------7---------8
      RETURN

ind_fvn()

subroutine ind_fvn	(	integer, dimension(*)	ndof,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	inloc,
		integer	nfv )

Definition at line 8739 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NFV,INLOC(*),NDOF(*),IKC(*),IDDL(*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer
     .        i,j,k,n,nd,ns,nf
C-----------use islm-----------------
      IF(ALLOCATED(islm)) DEALLOCATE(islm)
      ALLOCATE(islm(nfv))
      nf=0
C--------imposed velocity---------------
       DO n = 1, numnod
C--------local second node-----
        IF (inloc(n)>0) THEN
         ns=0
         DO j = 1, min(3,ndof(n))
          nd = iddl(n)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) ns = 1
         ENDDO
         IF (ns==1) THEN
          nf = nf + 1
          islm(nf) = n
         ENDIF
        ENDIF
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

ind_kine_kp()

subroutine ind_kine_kp	(	integer, dimension(*)	nrowk,
		integer, dimension(nnmax,*)	icok,
		integer, dimension(nkmax,*)	icokm,
		integer	nnmax,
		integer	nkmax,
		integer	nkine,
		integer	ink,
		integer	ikpat,
		integer, dimension(*)	iddl )

Definition at line 4503 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NNMAX,NKMAX,NROWK(*),NKINE,INK,IKPAT
      INTEGER ICOK(NNMAX,*),ICOKM(NKMAX,*),IDDL(*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,K,NL,NK,NJ,NRB
c----------------------
      nrb=nkine-ink
      IF (ikpat==0) THEN
       DO nk =1,nrb
        j=ikin2g(nk)
        CALL reorder_j(nrowk(nk+ink),icokm(1,nk),j,iddl)
       ENDDO
       DO nk =nrb+1,nkine
        j=ikin2g(nk)
        nj=nk-nrb
        CALL reorder_j(nrowk(nj),icok(1,nj),j,iddl)
       ENDDO
      ELSE
       DO nk =1,nrb
        j=ikin2g(nk)
        CALL reorder_l(nrowk(nk+ink),icokm(1,nk),j,iddl)
       ENDDO
       DO nk =nrb+1,nkine
        j=ikin2g(nk)
        nj=nk-nrb
        CALL reorder_l(nrowk(nj),icok(1,nj),j,iddl)
       ENDDO
      ENDIF
C----6---------------------------------------------------------------7---------8
      RETURN

ind_kinefr()

subroutine ind_kinefr	(	integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	lpby,
		integer, dimension(*)	itab,
		integer	nrbyac,
		integer, dimension(*)	irbyac,
		integer	nint2,
		integer, dimension(*)	iint2,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(*)	inloc,
		integer	nss,
		integer	nss2,
		integer	nss_s,
		integer	nss2_s,
		integer	kn_m,
		integer, dimension(nifv,*)	ibfv,
		integer, dimension(*)	lj,
		integer, dimension(*)	iskew,
		integer, dimension(*)	icodt,
		integer, dimension(nrbe3l,*)	irbe3,
		integer	nss3,
		integer	nss3_s,
		integer, dimension(nrbe2l,*)	irbe2,
		integer, dimension(*)	lrbe2,
		integer	nsr2,
		integer	nrs2_s )

Definition at line 1358 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
      USE imp_rwl
      USE imp_aspc
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C      INTEGER NNMAX,NKMAX
      INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
     .        NINT2,IINT2(*),IPARI(NPARI,*),ISKEW(*),ICODT(*)
      integer
     .   inloc(*),nss,nss2,nss_s ,nss2_s,kn_m,ibfv(nifv,*),lj(*),
     .   irbe3(nrbe3l,*),nss3 ,nss3_s  ,irbe2(nrbe2l,*),lrbe2(*),
     .   nsr2      ,nrs2_s
C     REAL
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer
     .        i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,iad,ji,
     .        ierror1,ierror2,ierror3,ierror4,ierror5,ierror6,ierror7
c----------------------
      ni2_fr=0
      ni2_frs=0
      IF (nss2>0) THEN
       IF(ALLOCATED(ifrs2)) DEALLOCATE(ifrs2)
       ALLOCATE(ifrs2(2,nss2),stat=ierror1)
       IF (nss2_s>0) THEN
        IF(ALLOCATED(ifrs2_s)) DEALLOCATE(ifrs2_s)
        ALLOCATE(ifrs2_s(nss2_s),stat=ierror3)
       ENDIF
       DO j=1,nint2
        n=iint2(j)
        nsn = ipari(5,n)
        ji=ipari(1,n)
        DO i=1,nsn
         ni=intbuf_tab(n)%NSV(i)
         IF (inloc(ni)>0) THEN
          ni2_fr=ni2_fr+1
          ifrs2(1,ni2_fr)=n
          ifrs2(2,ni2_fr)=i
          IF (inloc(ni)<=kn_m)THEN
           ni2_frs=ni2_frs+1
           ifrs2_s(ni2_frs)=ni2_fr
          ENDIF
         ENDIF
        ENDDO
       ENDDO
       IF (ni2_fr/=nss2.OR.ni2_frs/=nss2_s)
     .        WRITE(*,*)'pb cal NI2_FR'
      ENDIF
c-------RBE3---------------
      nrbe3_fr=0
      nrbe3_frs=0
      IF (nss3>0) THEN
       IF(ALLOCATED(ifrs3)) DEALLOCATE(ifrs3)
       ALLOCATE(ifrs3(nss3),stat=ierror1)
       IF (nss3_s>0) THEN
        IF(ALLOCATED(ifrs3_s)) DEALLOCATE(ifrs3_s)
        ALLOCATE(ifrs3_s(nss3_s),stat=ierror3)
       ENDIF
       DO n=1,nrbe3
         ni=irbe3(3,n)
         IF (ni==0) cycle
         IF (inloc(ni)>0) THEN
          nrbe3_fr=nrbe3_fr+1
          ifrs3(nrbe3_fr)=n
          IF (inloc(ni)<=kn_m)THEN
           nrbe3_frs=nrbe3_frs+1
           ifrs3_s(nrbe3_frs)=nrbe3_fr
          ENDIF
         ENDIF
       ENDDO
       IF (nrbe3_fr/=nss3.OR.nrbe3_frs/=nss3_s)
     .        WRITE(*,*)'pb cal NRBE3_FR'
      ENDIF
C-----active rigid body main nodes------
      nrb_fr=0
      nrb_frs=0
      IF (nss>0) THEN
       IF(ALLOCATED(ifrsr)) DEALLOCATE(ifrsr)
       ALLOCATE(ifrsr(2,nss),stat=ierror2)
       IF (nss_s>0) THEN
        IF(ALLOCATED(ifrsr_s)) DEALLOCATE(ifrsr_s)
        ALLOCATE(ifrsr_s(nss_s),stat=ierror4)
       ENDIF
       DO j=1,nrbyac
        n=irbyac(j)
        k=irbyac(j+nrbykin)
        m  =npby(1,n)
        IF (inloc(m)>0) THEN
         nsn  =npby(2,n)
         DO i=1,nsn
          id = i+k
          ni=lpby(id)
          IF (inloc(ni)>0) THEN
           nrb_fr=nrb_fr+1
           ifrsr(1,nrb_fr)=m
           ifrsr(2,nrb_fr)=ni
           IF (inloc(ni)<=kn_m) THEN
            nrb_frs=nrb_frs+1
            ifrsr_s(nrb_frs)=nrb_fr
           ENDIF
          ENDIF
         ENDDO
        ENDIF
       ENDDO
      ENDIF
C
      nbc_fr = 0
      DO n=1,numnod
        IF (iskew(n)>1.AND.icodt(n)/=7) THEN
         IF (inloc(n)>0.AND.inloc(n)<=kn_m)nbc_fr = nbc_fr + 1
        ENDIF
      ENDDO
      IF (nbc_fr>0) THEN
       IF(ALLOCATED(ibc_fr)) DEALLOCATE(ibc_fr)
       ALLOCATE(ibc_fr(3,nbc_fr),stat=ierror5)
       nbc_fr = 0
       DO n=1,numnod
        IF (iskew(n)>1.AND.icodt(n)/=7) THEN
         IF (inloc(n)>0.AND.inloc(n)<=kn_m) THEN
           nbc_fr = nbc_fr + 1
           ibc_fr(1,nbc_fr) = n
           ibc_fr(2,nbc_fr) = iskew(n)
           ibc_fr(3,nbc_fr) = icodt(n)
         ENDIF
        ENDIF
       ENDDO
      ENDIF
C-------AUTOSPC
      nspc_fr = 0
      DO i=1,nspcl
        n = in_spc(i)
        IF (inloc(n)>0.AND.inloc(n)<=kn_m.AND.ic_spc(i)<=3)
     .    nspc_fr = nspc_fr + 1
      ENDDO
      IF (nspc_fr>0) THEN
       IF(ALLOCATED(ispc_fr)) DEALLOCATE(ispc_fr)
       ALLOCATE(ispc_fr(nspc_fr),stat=ierror5)
       nspc_fr = 0
       DO i=1,nspcl
        n = in_spc(i)
        IF (inloc(n)>0.AND.inloc(n)<=kn_m.AND.ic_spc(i)<=3) THEN
             nspc_fr = nspc_fr + 1
             ispc_fr(nspc_fr)=i
            ENDIF
       ENDDO
      ENDIF
C---
      nfx_fr = 0
      DO j=1,nfxvel
        IF (lj(j)>0.AND.lj(j)<=3) THEN
         n=iabs(ibfv(1,j))
         IF (inloc(n)>0.AND.inloc(n)<=kn_m)nfx_fr = nfx_fr + 1
        ENDIF
      ENDDO
      IF (nfx_fr>0) THEN
       IF(ALLOCATED(ifx_fr)) DEALLOCATE(ifx_fr)
       ALLOCATE(ifx_fr(2,nfx_fr),stat=ierror6)
       nfx_fr = 0
       DO j=1,nfxvel
        IF (lj(j)>0.AND.lj(j)<=3) THEN
         n=iabs(ibfv(1,j))
         IF (inloc(n)>0.AND.inloc(n)<=kn_m) THEN
           nfx_fr = nfx_fr + 1
           ifx_fr(1,nfx_fr) = j
           ifx_fr(2,nfx_fr) = lj(j)
         ENDIF
        ENDIF
       ENDDO
      ENDIF
C
      nrw_fr = 0
      DO j=1,n_rwl
       n=in_rwl(j)
       IF (inloc(n)>0) nrw_fr = nrw_fr + 1
      ENDDO
      IF (nrw_fr>0) THEN
       IF(ALLOCATED(irw_fr)) DEALLOCATE(irw_fr)
       ALLOCATE(irw_fr(nrw_fr),stat=ierror7)
       nrw_fr = 0
       DO j=1,n_rwl
         n=in_rwl(j)
         IF (inloc(n)>0) THEN
           nrw_fr = nrw_fr + 1
           irw_fr(nrw_fr) = j
         ENDIF
       ENDDO
      ENDIF
C
C-----RBE2------
      nrbe2_fr=0
      nrbe2_frs=0
      IF (nsr2>0) THEN
       IF(ALLOCATED(ifrs4)) DEALLOCATE(ifrs4)
       ALLOCATE(ifrs4(2,nsr2),stat=ierror2)
       IF (nrs2_s>0) THEN
        IF(ALLOCATED(ifrs4_s)) DEALLOCATE(ifrs4_s)
        ALLOCATE(ifrs4_s(nrs2_s),stat=ierror4)
       ENDIF
       DO n=1,nrbe2
        m  =irbe2(3,n)
        IF (inloc(m)>0) THEN
         iad = irbe2(1,n)
         nsn  =irbe2(5,n)
         DO i=1,nsn
          id = iad+i
          ni=lrbe2(id)
          IF (inloc(ni)>0) THEN
           nrbe2_fr=nrbe2_fr+1
           ifrs4(1,nrbe2_fr)=n
           ifrs4(2,nrbe2_fr)=ni
           IF (inloc(ni)<=kn_m) THEN
            nrbe2_frs=nrbe2_frs+1
            ifrs4_s(nrbe2_frs)=nrbe2_fr
           ENDIF
          ENDIF
         ENDDO
        ENDIF
       ENDDO
      ENDIF
C----6---------------------------------------------------------------7---------8
      RETURN

ind_kinfrk()

subroutine ind_kinfrk	(	integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	lpby,
		integer, dimension(*)	itab,
		integer	nrbyac,
		integer, dimension(*)	irbyac,
		integer	nint2,
		integer, dimension(*)	iint2,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(*)	inloc,
		integer, dimension(*)	ia,
		integer, dimension(*)	ia2,
		integer	nss,
		integer	nss2,
		integer	n_kine,
		integer, dimension(nifv,*)	ibfv,
		integer, dimension(*)	lj,
		integer, dimension(*)	iskew,
		integer, dimension(*)	icodt,
		integer, dimension(*)	nrs,
		integer, dimension(nnmax,*)	icol,
		integer	nnmax,
		integer, dimension(nrbe3l,*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer	lns3,
		integer, dimension(nrbe2l,*)	irbe2,
		integer, dimension(*)	lrbe2,
		integer	lns4 )

Definition at line 6892 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
      USE imp_rwl
      USE imp_aspc
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NNMAX
      INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
     .        NINT2,IINT2(*),IPARI(NPARI,*),ISKEW(*),ICODT(*)
      integer
     .   inloc(*),nss,nss2,n_kine,ibfv(nifv,*),lj(*),icol(nnmax,*),
     .   ia(*),ia2(*),nrs(*),irbe3(nrbe3l,*),lrbe3(*),lns3 ,
     .   irbe2(nrbe2l,*),lrbe2(*),lns4
C     REAL
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer
     .        i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,
     .        ji,iad,nnod,
     .        ierror1,ierror2,ierror3,ierror4,ierror5,ierror6,ierror7
c----------------------
      ni2_fr=0
      ni2_frs=0
      IF (nss2>0) THEN
       IF(ALLOCATED(ifrs2)) DEALLOCATE(ifrs2)
       ALLOCATE(ifrs2(2,nss2),stat=ierror1)
       DO j=1,nint2
        n=ia2(j)
        IF (n>0) THEN
         nsn = ipari(5,n)
         ji=ipari(1,n)
         DO i=1,nsn
          ni=intbuf_tab(n)%NSV(i)
          nk = inloc(ni)
          IF (nk>n_kine) nk =nk-n_kine
          IF (nk>0) THEN
           l=intbuf_tab(n)%IRTLM(ni)
           nl=4*(l-1)
           DO k =1,4
            nj=intbuf_tab(n)%IRECTM(nl+k)
            CALL reorder_a(nrs(nk),icol(1,nk),nj)
           ENDDO
           ni2_fr=ni2_fr+1
           ifrs2(1,ni2_fr)=n
           ifrs2(2,ni2_fr)=i
          ENDIF
         ENDDO
        ENDIF
       ENDDO
      ENDIF
C-----RBE2------
      nrbe2_fr=0
      nrbe2_frs=0
      IF (lns4>0) THEN
       IF(ALLOCATED(ifrs4)) DEALLOCATE(ifrsr)
       ALLOCATE(ifrs4(2,lns4),stat=ierror2)
       DO n=1,nrbe2
        iad=irbe2(1,n)
        m  =irbe2(3,n)
         IF (inloc(m)>0) THEN
          nsn  =irbe2(5,n)
          DO i=1,nsn
           id = i+iad
           ni=lrbe2(id)
           nk = inloc(ni)
           IF (nk>n_kine) nk = inloc(ni)-n_kine
           IF (nk>0) THEN
            CALL reorder_a(nrs(nk),icol(1,nk),m)
            nrbe2_fr=nrbe2_fr+1
            ifrs4(1,nrbe2_fr)=n
            ifrs4(2,nrbe2_fr)=ni
           ENDIF
          ENDDO
         ENDIF
       ENDDO
      ENDIF
c--------RBE3--------------
      nrbe3_fr=0
      nrbe3_frs=0
      IF (lns3>0) THEN
       IF(ALLOCATED(ifrs3)) DEALLOCATE(ifrs3)
       ALLOCATE(ifrs3(lns3),stat=ierror1)
       DO n=1,nrbe3
        iad=irbe3(1,n)
        ni=irbe3(3,n)
        nnod=irbe3(5,n)
        IF (ni==0) cycle
        IF (inloc(ni)>0) THEN
          nk = inloc(ni)
          IF (nk>n_kine) nk =nk-n_kine
           DO k =1,nnod
            nj = lrbe3(iad+k)
            CALL reorder_a(nrs(nk),icol(1,nk),nj)
           ENDDO
           nrbe3_fr=nrbe3_fr+1
           ifrs3(nrbe3_fr)=n
        ENDIF
       ENDDO
      ENDIF
C-----active rigid body main nodes------
      nrb_fr=0
      nrb_frs=0
      IF (nss>0) THEN
       IF(ALLOCATED(ifrsr)) DEALLOCATE(ifrsr)
       ALLOCATE(ifrsr(2,nss),stat=ierror2)
       DO j=1,nrbyac
        n=ia(j)
        IF (n>0) THEN
         k=irbyac(j+nrbykin)
         m  =npby(1,n)
         IF (inloc(m)>0) THEN
          nsn  =npby(2,n)
          DO i=1,nsn
           id = i+k
           ni=lpby(id)
           nk = inloc(ni)
           IF (nk>n_kine) nk = inloc(ni)-n_kine
           IF (nk>0) THEN
            CALL reorder_a(nrs(nk),icol(1,nk),m)
            nrb_fr=nrb_fr+1
            ifrsr(1,nrb_fr)=m
            ifrsr(2,nrb_fr)=ni
           ENDIF
          ENDDO
         ENDIF
        ENDIF
       ENDDO
      ENDIF
C+++ BC. LOCAL
      nbc_fr = 0
      DO n=1,numnod
        IF (iskew(n)>1.AND.icodt(n)/=7) THEN
         IF (inloc(n)>0)nbc_fr = nbc_fr + 1
        ENDIF
      ENDDO
      IF (nbc_fr>0) THEN
       IF(ALLOCATED(ibc_fr)) DEALLOCATE(ibc_fr)
       ALLOCATE(ibc_fr(3,nbc_fr),stat=ierror5)
       nbc_fr = 0
       DO n=1,numnod
        IF (iskew(n)>1.AND.icodt(n)/=7) THEN
         IF (inloc(n)>0) THEN
           nbc_fr = nbc_fr + 1
           ibc_fr(1,nbc_fr) = n
           ibc_fr(2,nbc_fr) = iskew(n)
           ibc_fr(3,nbc_fr) = icodt(n)
         ENDIF
        ENDIF
       ENDDO
      ENDIF
C+++ AUTOSPC
      nspc_fr = 0
      DO n=1,nspcl
       i = in_spc(n)
       IF (inloc(n)>0.AND.ic_spc(n)<=3)nspc_fr = nspc_fr + 1
      ENDDO
      IF (nspc_fr>0) THEN
       IF(ALLOCATED(ispc_fr)) DEALLOCATE(ispc_fr)
       ALLOCATE(ispc_fr(nspc_fr),stat=ierror5)
       nspc_fr = 0
       DO n=1,nspcl
        i = in_spc(n)
        IF (inloc(n)>0.AND.ic_spc(n)<=3) THEN
             nspc_fr = nspc_fr + 1
             ispc_fr(nspc_fr)= n
        ENDIF
       ENDDO
      ENDIF
C +++ FV---local
      nfx_fr = 0
      DO j=1,nfxvel
        IF (lj(j)>0.AND.lj(j)<=3) THEN
         n=iabs(ibfv(1,j))
         IF (inloc(n)>0)nfx_fr = nfx_fr + 1
        ENDIF
      ENDDO
      IF (nfx_fr>0) THEN
       IF(ALLOCATED(ifx_fr)) DEALLOCATE(ifx_fr)
       ALLOCATE(ifx_fr(2,nfx_fr),stat=ierror6)
       nfx_fr = 0
       DO j=1,nfxvel
        IF (lj(j)>0.AND.lj(j)<=3) THEN
         n=iabs(ibfv(1,j))
         IF (inloc(n)>0) THEN
           nfx_fr = nfx_fr + 1
           ifx_fr(1,nfx_fr) = j
           ifx_fr(2,nfx_fr) = lj(j)
         ENDIF
        ENDIF
       ENDDO
      ENDIF
C ---
C +++  sliding rigid wall---
      nrw_fr = 0
      DO j=1,n_rwl
       n=in_rwl(j)
       IF (inloc(n)>0) nrw_fr = nrw_fr + 1
      ENDDO
      IF (nrw_fr>0) THEN
       IF(ALLOCATED(irw_fr)) DEALLOCATE(irw_fr)
       ALLOCATE(irw_fr(nrw_fr),stat=ierror7)
       nrw_fr = 0
       DO j=1,n_rwl
         n=in_rwl(j)
         IF (inloc(n)>0) THEN
           nrw_fr = nrw_fr + 1
           irw_fr(nrw_fr) = j
         ENDIF
       ENDDO
      ENDIF
C ---
C----6---------------------------------------------------------------7---------8
      RETURN

ind_nrfr()

subroutine ind_nrfr	(	integer	nft,
		integer	nel,
		integer	npn,
		integer	npp,
		integer	nnmax,
		integer, dimension(*)	nrow,
		integer, dimension(nnmax,*)	icol,
		integer, dimension(*)	fr_elem,
		integer, dimension(2,*)	iad_elem,
		integer	n_fr,
		integer, dimension(nrmax,n_fr)	icok )

Definition at line 3631 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NNMAX,NFT,NEL,NPN,NPP,NROW(*),ICOL(NNMAX,*)
      integer
     .   fr_elem(*),iad_elem(2,*),n_fr,icok(nrmax,n_fr)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NK,NROWK(N_FR),IP,
     .        L,IAD_R(N_FR+1),FR_ICOL1(N_FRNN+1),LR,J0,NN,N_FRN
C------- Recipation fr_nrow and goes through global (by rap)-
      IF (nnmax <=0 ) RETURN
       DO ip =1,nspmd
        DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
         nrowk(nk)=iad_rl(nk+1)-iad_rl(nk)
         j0 = iad_elem(1,ip)-1
         DO l=iad_rl(nk),iad_rl(nk+1)-1
          j=l-iad_rl(nk)+1
              n= fr_icol(l)+j0
              icok(j,nk)=fr_elem(n)
         ENDDO
        ENDDO
       ENDDO
C----accumulate in case nodes belong to multiple interfaces--
       DO ip =1,nspmd
        DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
         n = -ifrloc(nk)
             IF (n>0) THEN
           DO j=1,nrowk(nk)
            CALL reorder_a(nrowk(n),icok(1,n),icok(j,nk))
           ENDDO
         ENDIF
        ENDDO
       ENDDO
C------dim de IAD_R->NN+1--
       lr=1
       iad_r(1)=lr
       DO ip =1,nspmd
        DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
         n = ifrloc(nk)
         IF (n>0) THEN
          lr=lr+nrowk(nk)
          iad_r(n+1)=lr
         ENDIF
        ENDDO
       ENDDO
       n_frn=lr-1
       if (n_frn>n_frnn) print *,'PROBLEM IN IND_NRFR'
       IF (n_frn>0) THEN
        DO ip =1,nspmd
         DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
          n = ifrloc(nk)
          IF (n>0) THEN
           DO j=1,nrowk(nk)
            l=iad_r(n)+j-1
            fr_icol1(l)=icok(j,nk)
           ENDDO
          ENDIF
         ENDDO
        ENDDO
       ENDIF
C
       CALL ind_nrmax(
     1    nft       ,nel       ,npn       ,npp       ,nnmax     ,
     2    nrow      ,icol      ,iad_r     ,fr_icol1  ,n_frnn    )
 
C
      RETURN

ind_nrmax()

subroutine ind_nrmax	(	integer	nft,
		integer	nel,
		integer	npn,
		integer	npps,
		integer	nnmax,
		integer, dimension(*)	nrow,
		integer, dimension(nnmax,*)	icol,
		integer, dimension(*)	iad_rl,
		integer, dimension(*)	fr_icol,
		integer	n_frnn )

Definition at line 3271 of file imp_fri.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NNMAX,IAD_RL(*),FR_ICOL(*),N_FRNN
      INTEGER NFT,NEL,NPN,NPPS,NROW(*),ICOL(NNMAX,*)
C----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,M,JLT,JLT1,NK,NFT1,ISH,L,NPP
C------------------------------------
       IF (n_frnn==0) RETURN
       jlt=nel+nft
       npp=numnod-npps
       IF (npn>nft) THEN
        jlt1 = min( nel, npn - nft )
        DO nk=1,jlt1
         j=nk+nft
         DO i=iad_rl(j),iad_rl(j+1)-1
          CALL reorder_a(nrow(nk),icol(1,nk),fr_icol(i))
         ENDDO
        ENDDO
       ENDIF
       IF (npp<jlt) THEN
        nft1 = max(nft,npp)+1
        ish= npp-npn
        DO n=nft1,jlt
         nk=n-nft
         j=n-ish
         DO i=iad_rl(j),iad_rl(j+1)-1
          CALL reorder_a(nrow(nk),icol(1,nk),fr_icol(i))
         ENDDO
        ENDDO
       ENDIF
C
      RETURN

ind_sld()

subroutine ind_sld	(	integer	nsl,
		integer, dimension(*)	ndof,
			kss )

Definition at line 9405 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSL ,NDOF(*)
      my_real
     .     kss(6,*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,N,P,ID,NJ,NB,NL,NZ,J1,K1,NK,NN,IAD,
     .        IER1,IER2,IER3,IER4,IER5,IER6,ND
      my_real
     .     kii(6,6)
C-------------------------------------
C------IDDL as function of kinematic nodes first-----
       nn = 0
       DO i = 1,nsl
        IF (ikc_sl(i)>0) THEN
C----------int2,rb-,others-----------
         nb = iad_slnr(i+1)-iad_slnr(i)
         nn = nn + max(1,nb)
        ENDIF
       ENDDO
       IF(ALLOCATED(iddl_sl)) DEALLOCATE(iddl_sl)
       ALLOCATE(iddl_sl(nn),stat=ier1)
C------dim--[K_SL]-partie depedant only----LT---
       nn = 0
       nl = 0
       nz = 0
       DO i = 1,nsl
         IF (ikc_sl(i)>0) THEN
C----------int2,rb------------
          DO j=iad_slnr(i),iad_slnr(i+1)-1
           nn = nn +1
           iddl_sl(nn) = nl
           nj = jdi_slnr(j)
           DO k =1,ndof(nj)
             nl = nl + 1
             DO k1 = 1, k-1
              nz = nz + 1
             ENDDO
           ENDDO
C------   mimj  -------
           DO j1=iad_slnr(i),j-1
            nk = jdi_slnr(j1)
            DO k =1,ndof(nk)
              nz = nz + ndof(nk)
            ENDDO
           ENDDO
          ENDDO
C----------other kin------------
          IF (iad_slnr(i)==iad_slnr(i+1)) THEN
           nn = nn +1
           iddl_sl(nn) = nl
           n = isl(i)
           DO k =1,min(3,ndof(n))
             nl = nl + 1
             DO k1 = 1, k-1
              nz = nz + 1
             ENDDO
           ENDDO
          ENDIF
         ENDIF
       ENDDO
C-----allocation------
       nddl_sl = nl
       nz_sl = nz
       IF(ALLOCATED(iad_ss)) DEALLOCATE(iad_ss)
       ALLOCATE(iad_ss(nl+1),stat=ier2)
       IF(ALLOCATED(jdi_sl)) DEALLOCATE(jdi_sl)
       ALLOCATE(jdi_sl(nz),stat=ier3)
C
       nl = 0
       nz = 0
       nn = 0
       iad_ss(nl+1) = nz + 1
        DO i = 1, nsl
         IF (ikc_sl(i)>0) THEN
          iad = nn
          DO j=iad_slnr(i),iad_slnr(i+1)-1
           nn = nn +1
           nj = jdi_slnr(j)
           DO k =1,ndof(nj)
            nl = nl + 1
C------   mij  d'abord-------
            DO j1=iad_slnr(i),j-1
             nk = jdi_slnr(j1)
             id = iad + j1-iad_slnr(i)+1
             DO k1 =1,ndof(nk)
              nz = nz + 1
              jdi_sl(nz) = iddl_sl(id)+ k1
             ENDDO
            ENDDO
C------   mii  ------
            DO k1 = 1, k-1
             nz = nz + 1
             jdi_sl(nz) = iddl_sl(nn) + k1
            ENDDO
            iad_ss(nl+1) = nz + 1
           ENDDO
          ENDDO
C----------other kin------------
          IF (iad_slnr(i)==iad_slnr(i+1)) THEN
           nn = nn +1
           n = isl(i)
           DO k =1,min(3,ndof(n))
             nl = nl + 1
             DO k1 = 1, k-1
              nz = nz + 1
              jdi_sl(nz) = iddl_sl(nn) + k1
             ENDDO
             iad_ss(nl+1) = nz + 1
           ENDDO
          ENDIF
         ENDIF
        ENDDO
C
       IF(ALLOCATED(diag_sl)) DEALLOCATE(diag_sl)
       IF(ALLOCATED(lt_sl)) DEALLOCATE(lt_sl)
       ALLOCATE(diag_sl(nl),stat=ier4)
       ALLOCATE(lt_sl(nz),stat=ier5)
       CALL zero1(diag_sl,nl)
       CALL zero1(lt_sl,nz)
C----------initiation for the case /BCS       
       nn = 0
        DO i = 1, nsl
         IF (ikc_sl(i)>0) THEN
C----------other kin------------
          IF (iad_slnr(i)==iad_slnr(i+1)) THEN
           nn = nn +1
           n = isl(i)
           nd = min(3,ndof(n))
           DO k = 1, nd
            kii(k,k) = kss(k,i)
           ENDDO
           kii(1,2)=kss(4,i)
           kii(1,3)=kss(5,i)
           kii(2,3)=kss(6,i)
           kii(2,1)=kii(1,2)
           kii(3,1)=kii(1,3)
           kii(3,2)=kii(2,3)
           CALL put_kii(nn,iddl_sl,iad_ss,diag_sl,lt_sl,kii,nd)
          ENDIF
         ENDIF
        ENDDO
C
      RETURN

ini_dd0()

subroutine ini_dd0	(	integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
			dd,
			ddr,
		integer	nsl,
		integer, dimension(nrbe3l,*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer, dimension(nrbe2l,*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 1041 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IDDL(*),IKC(*),NDOF(*),NSL
      INTEGER  IPARI(NPARI,*),IRBE3(NRBE3L,*),LRBE3(*),
     .         IRBE2(NRBE2L,*),LRBE2(*)
C     REAL
      my_real
     .    dd(3,*),ddr(3,*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I,ND,N,J,IAD,JI
      INTEGER M,NSN,L,NNOD,NJ,NL,NI
C-----------------------------------------------
       DO i = 1, nsl
C--------local second node-----
        n = isl(i)
         DO j = 1, min(3,ndof(n))
          nd = iddl(n)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           dd(j,n)=zero
          ENDIF
         ENDDO
         DO j = 3, ndof(n)
          nd = iddl(n)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           ddr(j-3,n)=zero
          ENDIF
         ENDDO
       ENDDO
C
       DO i = 1, nml
C--------local main node-----
        n = iml(i)
         DO j = 1, min(3,ndof(n))
          nd = iddl(n)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           dd(j,n)=zero
          ENDIF
         ENDDO
         DO j = 3, ndof(n)
          nd = iddl(n)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           ddr(j-3,n)=zero
          ENDIF
         ENDDO
       ENDDO
C------Rigid bodies-------
       DO i=1,nrb_fr
        m=ifrsr(1,i)
        DO j=1,min(3,ndof(m))
         nd = iddl(m)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           dd(j,m)=zero
          ENDIF
        ENDDO
         DO j = 3, ndof(m)
          nd = iddl(m)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           ddr(j-3,m)=zero
          ENDIF
         ENDDO
       ENDDO
C------int2-------
       DO i=1,ni2_fr
         n=ifrs2(1,i)
         ni=ifrs2(2,i)
         ji=ipari(1,n)
         nsn=ipari(5,n)
         l=intbuf_tab(n)%IRTLM(ni)
         nl=4*(l-1)
         IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
          nnod=3
         ELSE
          nnod=4
         ENDIF
C-------if main node is also dependent-----
         DO m=1,nnod
          nj=intbuf_tab(n)%IRECTM(nl+m)
          DO j = 1 , min(3,ndof(nj))
               nd = iddl(nj) + j
           IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
            dd(j,nj)=zero
           ENDIF
          ENDDO
          DO j = 3 , ndof(nj)
               nd = iddl(nj) + j
           IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
            ddr(j-3,nj)=zero
           ENDIF
          ENDDO
         ENDDO
       ENDDO
C------RBE3-------
       DO i=1,nrbe3_fr
         n=ifrs3(i)
         nnod=irbe3(5,n)
         iad=irbe3(1,n)
C-------if main node is also dependent-----
         DO m=1,nnod
          nj=lrbe3(iad+m)
          DO j = 1 , min(3,ndof(nj))
               nd = iddl(nj) + j
           IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
            dd(j,nj)=zero
           ENDIF
          ENDDO
          DO j = 3 , ndof(nj)
               nd = iddl(nj) + j
           IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
            ddr(j-3,nj)=zero
           ENDIF
          ENDDO
         ENDDO
       ENDDO
C------RBE2-------
       DO i=1,nrbe2_fr
        n=ifrs4(1,i)
        m=irbe2(3,n)
        DO j=1,min(3,ndof(m))
         nd = iddl(m)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           dd(j,m)=zero
          ENDIF
        ENDDO
         DO j = 3, ndof(m)
          nd = iddl(m)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           ddr(j-3,m)=zero
          ENDIF
         ENDDO
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

ini_ddfv()

subroutine ini_ddfv	(	integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
			d,
			dr,
			dd,
			ddr,
		integer	nsl,
		integer, dimension(nrbe3l,*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer, dimension(nrbe2l,*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 877 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s 
C-----------------------------------------------
      USE intbufdef_mod
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IDDL(*),IKC(*),NDOF(*),NSL
      INTEGER  IPARI(NPARI,*),IRBE3(NRBE3L,*),LRBE3(*) ,
     .         IRBE2(NRBE2L,*),LRBE2(*)
C     REAL
      my_real
     .    d(3,*),dr(3,*),dd(3,*),ddr(3,*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I,ND,N,J,IAD
      INTEGER M,NSN,JI,L,NNOD,NJ,NL,NI
C-----------------------------------------------
       DO i = 1, nsl
C--------local second node-----
        n = isl(i)
         DO j = 1, min(3,ndof(n))
          nd = iddl(n)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           dd(j,n)=d(j,n)
          ENDIF
         ENDDO
         DO j = 3, ndof(n)
          nd = iddl(n)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           ddr(j-3,n)=dr(j-3,n)
          ENDIF
         ENDDO
       ENDDO
C
       DO i = 1, nml
C--------local main node-----
        n = iml(i)
         DO j = 1, min(3,ndof(n))
          nd = iddl(n)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           dd(j,n)=d(j,n)
          ENDIF
         ENDDO
         DO j = 3, ndof(n)
          nd = iddl(n)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           ddr(j-3,n)=dr(j-3,n)
          ENDIF
         ENDDO
       ENDDO
C------Rigid bodies-----
       DO i=1,nrb_fr
        m=ifrsr(1,i)
        DO j=1,min(3,ndof(m))
         nd = iddl(m)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           dd(j,m)=d(j,m)
          ENDIF
        ENDDO
        DO j=3,ndof(m)
         nd = iddl(m)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           ddr(j-3,m)=dr(j-3,m)
          ENDIF
        ENDDO
       ENDDO
C------int2-------
       DO i=1,ni2_fr
         n=ifrs2(1,i)
         ni=ifrs2(2,i)
         ji=ipari(1,n)
         nsn=ipari(5,n)
         l=intbuf_tab(n)%IRTLM(ni)
         nl=4*(l-1)
         IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
          nnod=3
         ELSE
          nnod=4
         ENDIF
C-------if main node is also dependent-----
         DO m=1,nnod
          nj=intbuf_tab(n)%IRECTM(nl+m)
          DO j = 1 , min(3,ndof(nj))
               nd = iddl(nj) + j
           IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
            dd(j,nj)=d(j,nj)
           ENDIF
          ENDDO
          DO j = 3 , ndof(nj)
               nd = iddl(nj) + j
           IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
            ddr(j-3,nj)=dr(j-3,nj)
           ENDIF
          ENDDO
         ENDDO
       ENDDO
C------RBE3-------
       DO i=1,nrbe3_fr
         n=ifrs3(i)
         nnod=irbe3(5,n)
         iad=irbe3(1,n)
C-------if main node is also dependent-----
         DO m=1,nnod
          nj=lrbe3(iad+m)
          DO j = 1 , min(3,ndof(nj))
               nd = iddl(nj) + j
           IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
            dd(j,nj)=d(j,nj)
           ENDIF
          ENDDO
          DO j = 3 , ndof(nj)
               nd = iddl(nj) + j
           IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
            ddr(j-3,nj)=dr(j-3,nj)
           ENDIF
          ENDDO
         ENDDO
       ENDDO
C------RBE2-------
       DO i=1,nrbe2_fr
         n=ifrs4(1,i)
         m=irbe2(3,n)
        DO j=1,min(3,ndof(m))
         nd = iddl(m)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           dd(j,m)=d(j,m)
          ENDIF
        ENDDO
        DO j=3,ndof(m)
         nd = iddl(m)+j
          IF ((ikc(nd)>=2.AND.ikc(nd)<=4).OR.ikc(nd)==9) THEN
           ddr(j-3,m)=dr(j-3,m)
          ENDIF
        ENDDO
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

ini_fr_k()

subroutine ini_fr_k	(		elbuf,
		integer, dimension(nparg,*)	iparg,
		integer, dimension(nixs,*)	ixs,
		integer, dimension(nixq,*)	ixq,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(nixt,*)	ixt,
		integer, dimension(nixp,*)	ixp,
		integer, dimension(nixr,*)	ixr,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(4,*)	ixtg1,
		integer, dimension(6,*)	ixs10,
		integer, dimension(12,*)	ixs20,
		integer, dimension(8,*)	ixs16,
		integer, dimension(*)	ndof,
		integer	nnmax,
		integer, dimension(*)	inloc,
		integer, dimension(*)	fr_elem,
		integer, dimension(2,*)	iad_elem,
		integer	n_fr,
		integer, dimension(*)	igeo,
		integer, dimension(*)	fr_i2m,
		integer, dimension(*)	iad_i2m,
		type (elbuf_struct_), dimension(ngroup)	elbuf_tab,
		integer	nnrmax )

Definition at line 3895 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
      USE elbufdef_mod
      use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg         
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARG(NPARG,*),NNMAX,N_FR ,NDOF(*),IGEO(*),
     .        FR_I2M(*),IAD_I2M(*),NNRMAX
      integer
     .   ixs(nixs,*),ixq(nixq,*),ixc(nixc,*), ixt(nixt,*),ixp(nixp,*),
     .   ixr(nixr,*), ixtg(nixtg,*),ixs10(6,*),ixs20(12,*),
     .   ixs16(8,*),ixtg1(4,*),inloc(*),fr_elem(*),iad_elem(2,*)
C     REAL
      my_real
     .   elbuf(*)
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
C-----------------------------------------------
C   External function
C-----------------------------------------------
      LOGICAL INTAB
      EXTERNAL intab
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NK,ICOL(NNMAX,N_FR),NROW(N_FR),IP,JLT,NFT,
     .        FR_NROW(N_FR),L,IAD_S(NSPMD+1),IAD_R(NSPMD+1),
     .        IERROR1,IERROR2,IERROR3,LS,LR,SSIZE,RSIZE,J0,NN,NR,NL,NRN,
     .        NR2,NF1
C   ---- PB suite with Elem Delete .--------
C     IF (N_FR <=0 .OR. NNMAX <=0) RETURN
      DO n =1,numnod
       inloc(n)=0
      ENDDO
      DO n =1,n_fr
       nrow(n)=0
      ENDDO
      DO ip =1,nspmd
       jlt=iad_elem(1,ip+1)-iad_elem(1,ip)
       nft=iad_elem(1,ip)-1
       nf1=min(n_fr,nft+1)
       DO j=1,jlt
        nk=j+nft
        n=fr_elem(nk)
        inloc(n) = j
       ENDDO
       CALL dim_elemsp(
     1    elbuf     ,iparg     ,ixs       ,ixq       ,ixc       ,
     2    ixt       ,ixp       ,ixr       ,ixtg      ,ixtg1     ,
     3    ixs10     ,ixs20     ,ixs16     ,nrow(nf1),
     4    inloc     ,nnmax     ,icol(1,nf1),igeo   ,elbuf_tab )
       DO j=1,jlt
        nk=j+nft
        n=fr_elem(nk)
        inloc(n) = 0
       ENDDO
      ENDDO
       CALL spmd_nrow(nrow,fr_nrow,iad_elem,n_fr)
C------ prepare comm .-----
       ls=1
       lr=1
       iad_s(1)=ls
       iad_r(1)=lr
       DO ip =1,nspmd
        DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
         ls=ls+nrow(nk)
         lr=lr+fr_nrow(nk)
        ENDDO
        iad_s(ip+1)=ls
        iad_r(ip+1)=lr
       ENDDO
       IF ((ls+lr)>2) THEN
        ssize=iad_s(nspmd+1)-1
        rsize=iad_r(nspmd+1)-1
C
        CALL spmd_icol(
     1   iad_s    ,iad_r    ,nnmax    ,icol     ,nrow     ,
     2   fr_nrow  ,iad_elem ,fr_elem  ,ssize    ,rsize    )
       ENDIF
C
       nr2=iad_i2m(nspmd+1)-iad_i2m(1)
      IF (nr2>0) THEN
       DO ip =1,nspmd
        nr=iad_i2m(ip+1)-iad_i2m(ip)
        IF (nr>0) THEN
         jlt=iad_elem(1,ip+1)-iad_elem(1,ip)
         nft=iad_elem(1,ip)-1
         DO j=1,jlt
          nk=j+nft
          n=fr_elem(nk)
          inloc(n) = j
         ENDDO
         DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
          n=fr_elem(nk)
          IF (intab(nr,fr_i2m(iad_i2m(ip)),n)) THEN
           DO l=iad_i2m(ip),iad_i2m(ip+1)-1
            nn=fr_i2m(l)
            nl=inloc(nn)
            IF (nl>0.AND.nn/=n) THEN
             nrn = max(nrow(nk),fr_nrow(nk))
             CALL reorder_a(nrn,icol(1,nk),nl)
             IF (nrn>max(nrow(nk),fr_nrow(nk))) fr_nrow(nk)=nrn
            ENDIF
           ENDDO
          ENDIF
         ENDDO
C
         DO j=1,jlt
          nk=j+nft
          n=fr_elem(nk)
          inloc(n) = 0
         ENDDO
        ENDIF
       ENDDO
      END IF !(NR2>0) THEN
C
       IF(ALLOCATED(iad_rl)) DEALLOCATE(iad_rl)
       ALLOCATE(iad_rl(n_fr+1),stat=ierror3)
       lr=1
       iad_rl(1)=lr
       nrmax = 0
       DO ip =1,nspmd
        DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
         IF (nrow(nk)<fr_nrow(nk)) THEN
          nr=fr_nrow(nk)-nrow(nk)
          lr=lr+nr
          nrmax = max(nrmax,nr)
          n=fr_elem(nk)
          IF (inloc(n)==0) THEN
           inloc(n)=1
          ELSE
           nrmax=nrmax+nr
          ENDIF
         ENDIF
         iad_rl(nk+1)=lr
        ENDDO
       ENDDO
       nnrmax = nrmax
C
       DO ip =1,nspmd
        DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
         IF (nrow(nk)<fr_nrow(nk)) THEN
          n=fr_elem(nk)
          inloc(n) = 0
         ENDIF
        ENDDO
       ENDDO
C
       n_frnn=lr-1
C------- First it is local ------------
       IF (n_frnn>0) THEN
        IF(ALLOCATED(fr_icol)) DEALLOCATE(fr_icol)
        ALLOCATE(fr_icol(lr),stat=ierror2)
        DO ip =1,nspmd
         DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
           j0=nrow(nk)-iad_rl(nk)+1
           DO l=iad_rl(nk),iad_rl(nk+1)-1
            j=l+j0
            fr_icol(l)=icol(j,nk)
           ENDDO
         ENDDO
        ENDDO
       ENDIF
C
      RETURN

ini_frfd()

subroutine ini_frfd	(	integer	nsrem,
		integer	nfv,
		integer, dimension(3,*)	ikcsi,
		integer, dimension(*)	nf_si,
			fdsi )

Definition at line 9307 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer
     .   nsrem,ikcsi(3,*),nf_si(*)  ,nfv
      my_real
     .     fdsi(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,K,NL,NDOFI,IAD,IADI
C
       DO i=1,nddl_si
        fsi(i) = zero
       ENDDO
C
       IF (nfv==0) RETURN
       ndofi = 3
       nl = 0
       iad = 1
       iadi = 1
       DO i=1,nsrem
C-----------SECOND DEPEND.: FRK_SI---------
        IF (ikc_si(i)>0) THEN
         DO j =1, nf_si(i)
          DO k = 1,ndofi
           IF (ikcsi(k,iad)==0) THEN
            nl = nl + 1
            fsi(nl)=-fdsi(k,iadi+j-1)
           ENDIF
          ENDDO
          iad = iad + 1
         ENDDO
C-----------SECOND INDEPEND.:LT,FRK_SL---------
        ELSE
         DO k = 1,ndofi
          nl = nl + 1
          fsi(nl)=-fdsi(k,iadi)
         ENDDO
        ENDIF
        iadi = iadi + max(1,nf_si(i))
       ENDDO
C
      RETURN

ini_frkc()

subroutine ini_frkc	(	integer	nsrem,
		integer	nsl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer, dimension(*)	iddl )

Definition at line 5586 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSREM  ,NSL    ,IKC(*)    ,NDOF(*)   ,IDDL(*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,ID,NDD,IERROR1,IERROR2
C--------------------------------------------
        IF(ALLOCATED(ikc_sl)) DEALLOCATE(ikc_sl)
        ALLOCATE(ikc_sl(nsl),stat=ierror1)
        IF(ALLOCATED(ikc_si)) DEALLOCATE(ikc_si)
        ALLOCATE(ikc_si(nsrem),stat=ierror2)
        DO i = 1, nsl
         n = isl(i)
             id = iddl(n)
         ndd = 0
         DO j = 1 , min(3,ndof(n))
           ndd = ndd + ikc(id+j)
         ENDDO
         IF (ndof(n)==0) ndd = 21
         ikc_sl(i) = ndd
        ENDDO
C
        CALL spmd_isr(iad_sl,iad_srem,ikc_sl,ikc_si,nsl  ,nsrem  )
C
        IF (nsrem==0) nddl_si=0
        nddl_sl=0
C
      RETURN

ini_frud()

subroutine ini_frud	(	integer	nsrem,
		integer	nsl,
		integer	nfv,
		integer, dimension(*)	ifvsi,
		integer, dimension(*)	ifvsl,
		integer, dimension(*)	nf_si,
		integer, dimension(*)	nf_sl,
		integer	lvsi )

Definition at line 8920 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSREM ,NSL,NFV ,IFVSI(*) ,IFVSL(*)  ,
     .        NF_SL(*),NF_SI(*),LVSI
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,K,IAD,NJ,L
      INTEGER SSIZE ,RSIZE,SIZE,IAD_S(NSPMD+1),IAD_R(NSPMD+1)
C--------------------------------------------
        iad = 1
        DO i = 1, nsl
         IF (ikc_sl(i)>0) THEN
           DO k=1,nf_sl(i)
            ifvsl(iad) = 0
            iad = iad + 1
           ENDDO
         ENDIF
        ENDDO
C
        iad = 1
        DO i = 1, nsl
         IF (ikc_sl(i)>0.AND.nf_sl(i)>0) THEN
          n = isl(i)
          CALL intabfr(nfv,islm,n,j)
          IF (j>0) THEN
           ifvsl(iad) = j
          ELSE
           DO k=iad_slnr(i),iad_slnr(i+1)-1
            nj = jdi_slnr(k)
            CALL intabfr(nfv,islm,nj,l)
            IF (l>0) ifvsl(iad+k-iad_slnr(i)) = l
           ENDDO
          ENDIF
          iad = iad + nf_sl(i)
         ENDIF
        ENDDO
C
      iad_s(1) = 1
      iad_r(1) = 1
       DO i=1,nspmd
        iad_s(i+1) = iad_s(i)
        iad_r(i+1) = iad_r(i)
        DO j=iad_sl(i),iad_sl(i+1)-1
         iad_s(i+1) = iad_s(i+1) + nf_sl(j)
        END DO
        DO j=iad_srem(i),iad_srem(i+1)-1
         iad_r(i+1) = iad_r(i+1) + nf_si(j)
        END DO
       END DO
C
      SIZE = 1
      ssize = iad_s(nspmd+1) - 1
      rsize = iad_r(nspmd+1) - 1
      CALL spmd_exci(ifvsl,ifvsi,iad_s,iad_r,SIZE ,ssize,rsize)
C
      lvsi = 0
        iad = 1
        DO i = 1, nsrem
         IF (ikc_si(i)>0) THEN
           DO k=1,nf_si(i)
            IF (ifvsi(iad) > 0) lvsi = lvsi +1
            iad = iad + 1
           ENDDO
         ENDIF
        ENDDO
C
      RETURN

ini_intm()

subroutine ini_intm	(	integer, dimension(*)	iloc,
		integer	n_imps,
		integer	n_impn )

Definition at line 1202 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ILOC(*),N_IMPN,N_IMPS
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,IERROR1
C-----------------------------------------------
C
      nml=n_impn-n_imps
      IF (nml>0) THEN
       IF(ALLOCATED(iml)) DEALLOCATE(iml)
       ALLOCATE(iml(nml),stat=ierror1)
       DO n = 1, numnod
        IF (iloc(n)>n_imps) THEN
         i=iloc(n)-n_imps
         iml(i)=n
        ENDIF
       ENDDO
      ENDIF
C----6---------------------------------------------------------------7---------8
      RETURN

ini_ksi()

subroutine ini_ksi	(	integer	nsrem,
			ksi,
		integer, dimension(*)	iddl )

Definition at line 5682 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSREM  ,IDDL(*)
C     REAL
      my_real
     .  ksi(9,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,ID,JD,NM,ND,IAD
C--------------------------------------------
        nd = 3
        iad = 0
        DO i = 1, nsrem
         IF (ikc_si(i)>0) THEN
          id = iddl_si(i)
          DO j = iad_sinr(i), iad_sinr(i+1)-1
           nm = jdi_sinr(j)
           jd = iddl(nm)
           iad = iad + 1
           CALL getfr_kij( id    ,jd   ,iad_si ,jdi_si,lt_si  ,
     1                     ksi(1,iad),nd   ,nd    )
          ENDDO
         ENDIF
        ENDDO
C
      RETURN

ini_slnr()

subroutine ini_slnr	(	integer	nsl,
		integer	nnmax,
		integer, dimension(*)	nrs,
		integer, dimension(nnmax,*)	icol,
		integer	nz,
		integer, dimension(*)	ndof,
		integer, dimension(*)	iad_m )

Definition at line 6685 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSL,NZ,NNMAX ,NRS(*),NDOF(*),IAD_M(*)
      INTEGER ICOL(NNMAX,*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer
     .        i,j,k,n,nj
C----------------------------
       IF(ALLOCATED(iad_slnr)) DEALLOCATE(iad_slnr)
       ALLOCATE(iad_slnr(nsl+1))
       IF(ALLOCATED(jdi_slnr)) DEALLOCATE(jdi_slnr)
       ALLOCATE(jdi_slnr(nz))
       nz = 0
       iad_slnr(1) = nz+1
       DO n=1,nsl
         DO j=1,nrs(n)
           nj = icol(j,n)
           nz = nz+1
           jdi_slnr(nz) = nj
         ENDDO
         iad_slnr(n+1) = nz+1
       ENDDO
       nz = 0
       iad_m(1) = nz+1
       DO n=1,nsl
        IF (ikc_sl(n)>0) THEN
C         I = ISL(N)
         DO j=1,max(1,nrs(n))
           nz = nz+ikc_sl(n)
          IF (nrs(n)>0) THEN
               nj = icol(j,n)
C----------IKC_SL=NREMS when it's called by KIN_KML          
           IF (ndof(nj)==6) nz = nz+ikc_sl(n)
          ENDIF
         ENDDO
        ENDIF
        iad_m(n+1) = nz+1
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

intabfr()

subroutine intabfr	(	integer	nic,
		integer, dimension(*)	ic,
		integer	n,
		integer	intab )

Definition at line 2139 of file imp_fri.F.

C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER N ,NIC,IC(*),INTAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C---- 6 ----- IC is already in an increasing order ----------------------------------- 7 -------- 8
      intab=0
       DO i =1,nic
        IF (n==ic(i)) THEN
         intab=i
         RETURN
        ENDIF
       ENDDO
C
      RETURN

jdifrtok()

subroutine jdifrtok

(

integer, dimension(*)

itok

)

Definition at line 5272 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ITOK(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,NJ
C
C-----pass IDDLI to IDDLJ  croisante-----
      DO i =1,nddl_si
       DO j =iad_si(i),iad_si(i+1)-1
        nj = jdi_si(j)
        jdi_si(j) = itok(nj)
       ENDDO
      ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

kin_kml()

subroutine kin_kml	(	integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer	nint2,
		integer, dimension(*)	iint2,
		integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	lpby,
		integer, dimension(*)	itab,
		integer	nrbyac,
		integer, dimension(*)	irbyac,
			x,
		integer, dimension(nifv,*)	ibfv,
		integer, dimension(*)	lj,
			skew,
			xframe,
		integer, dimension(*)	iskew,
		integer, dimension(*)	icodt,
		integer, dimension(*)	ndof,
		integer, dimension(*)	ilocp,
		integer	nsrem,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	iad_m,
		integer	nml,
		integer, dimension(*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer, dimension(*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 7436 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s 
C-----------------------------------------------
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IBFV(NIFV,*),IPARI(NPARI,*),NSREM,NML
      INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
     .        NINT2,IINT2(*),ILOCP(*),NDOF(*) ,IDDL(*) ,IKC(*),
     .        LJ(*),ISKEW(*),ICODT(*),IAD_M(*),IRBE3(*),LRBE3(*),
     .        IRBE2(*),LRBE2(*)
C     REAL
      my_real
     .       x(3,*),skew(*),xframe(*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER LNS,LNS2,NNMAX,NZ,LNS3,LNS4
      INTEGER I,J,K,L,N_KINE,IA2(NINT2),IA(NRBYAC)
      INTEGER, DIMENSION(:), ALLOCATABLE :: ICOL,NRS
C------------------------------------------------------------
      ALLOCATE(nrs(nml))
C
      DO i=1,nml
       nrs(i) = 0
      ENDDO
      CALL dim_kinfrk(
     1    npby      ,lpby      ,itab      ,nrbyac    ,irbyac    ,
     2    nint2     ,iint2     ,ipari     ,intbuf_tab,ilocp     ,
     3    ia        ,ia2       ,nrs       ,lns       ,lns2      ,
     4    nml       ,irbe3     ,lrbe3     ,lns3      ,irbe2     ,
     5    lrbe2     ,lns4      )
C
      nnmax=0
      DO i=1,nml
       nnmax=max(nnmax,nrs(i))
       nrs(i)=0
      ENDDO
      ALLOCATE(icol(nnmax*nml))
C--------ICOL(NNMAX,NML) for independent nodes----
      CALL ind_kinfrk(
     1    npby      ,lpby      ,itab      ,nrbyac    ,irbyac    ,
     2    nint2     ,iint2     ,ipari     ,intbuf_tab,ilocp     ,
     3    ia        ,ia2       ,lns       ,lns2      ,nml       ,
     4    ibfv      ,lj        ,iskew     ,icodt     ,nrs       ,
     5    icol      ,nnmax     ,irbe3     ,lrbe3     ,lns3      ,
     6    irbe2     ,lrbe2     ,lns4      )
C
       nz = 0
       DO i=1,nml
        DO j=1,nrs(i)
         nz = nz+1
        ENDDO
       ENDDO
      CALL ini_slnr(nml  ,nnmax ,nrs  ,icol   ,nz     ,
     .              ndof ,iad_m )
      DEALLOCATE(nrs)
      DEALLOCATE(icol)
C----6---------------------------------------------------------------7---------8
      RETURN

kin_ksl()

subroutine kin_ksl	(	integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer	nint2,
		integer, dimension(*)	iint2,
		integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	lpby,
		integer, dimension(*)	itab,
		integer	nrbyac,
		integer, dimension(*)	irbyac,
			x,
		integer, dimension(*)	ibfv,
		integer, dimension(*)	lj,
			skew,
			xframe,
		integer, dimension(*)	iskew,
		integer, dimension(*)	icodt,
		integer, dimension(*)	ndof,
		integer, dimension(*)	ilocp,
		integer	nsl,
		integer, dimension(*)	iad_m,
		integer, dimension(*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer, dimension(*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 6553 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s 
C-----------------------------------------------
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,*),NSL
      INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
     .        NINT2,IINT2(*),ILOCP(*),NDOF(*) ,
     .        IBFV(*),LJ(*),ISKEW(*),ICODT(*),IAD_M(*),
     .        IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*)
C     REAL
      my_real
     .       x(3,*),skew(*),xframe(*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER LNS,LNS2,NNMAX,NZ,LNS3,LNS4
      INTEGER I,J,K,L,N_KINE,IA2(NINT2),IA(NRBYAC),NRS(NSL)
      INTEGER, DIMENSION(:,:), ALLOCATABLE :: ICOL
C------------------------------------------------------------
      DO i =1,numnod
       ilocp(i)=0
      ENDDO
C--------N_KINE: nm, sl (no double)----
      n_kine=0
      CALL tag_ints(nsl    ,ilocp     ,n_kine)
C
      DO i=1,nsl
       nrs(i) = 0
      ENDDO
      CALL dim_kinfrk(
     1    npby      ,lpby      ,itab      ,nrbyac    ,irbyac    ,
     2    nint2     ,iint2     ,ipari     ,intbuf_tab,ilocp     ,
     3    ia        ,ia2       ,nrs       ,lns       ,lns2      ,
     4    nsl       ,irbe3     ,lrbe3     ,lns3      ,irbe2     ,
     5    lrbe2     ,lns4      )
C
      nnmax=0
      DO i=1,nsl
       nnmax=max(nnmax,nrs(i))
       nrs(i)=0
      ENDDO
      ALLOCATE(icol(nnmax,nsl))
      CALL ind_kinfrk(
     1    npby      ,lpby      ,itab      ,nrbyac    ,irbyac    ,
     2    nint2     ,iint2     ,ipari     ,intbuf_tab,ilocp     ,
     3    ia        ,ia2       ,lns       ,lns2      ,nsl       ,
     4    ibfv      ,lj        ,iskew     ,icodt     ,nrs       ,
     5    icol      ,nnmax     ,irbe3     ,lrbe3     ,lns3      ,
     6    irbe2     ,lrbe2     ,lns4      )
C
       CALL doub_nrs(nsl  ,nnmax ,nrs  ,icol   ,ilocp     )
       nz = 0
       DO i=1,nsl
        DO j=1,nrs(i)
         nz = nz+1
        ENDDO
       ENDDO
      CALL ini_slnr(nsl  ,nnmax ,nrs  ,icol   ,nz     ,
     .              ndof ,iad_m )
      DEALLOCATE(icol)
C----6---------------------------------------------------------------7---------8
      RETURN

kin_nrmax()

subroutine kin_nrmax	(	integer	nnmax,
		integer	nkmax,
		integer, dimension(*)	nrowk,
		integer, dimension(nnmax,*)	icok,
		integer, dimension(nkmax,*)	icokm,
		integer, dimension(*)	iloc,
		integer	ink,
		integer, dimension(*)	fr_elem,
		integer, dimension(2,*)	iad_elem )

Definition at line 3216 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NNMAX,NKMAX,NROWK(*),ILOC(*),INK
      INTEGER ICOK(NNMAX,*),ICOKM(NKMAX,*),IAD_ELEM(2,*),FR_ELEM(*)
C----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NL,NR,K,NK,NN
C------------------------------------
      IF (n_frnn==0) RETURN
C
       DO i =1,nspmd
        DO j=iad_elem(1,i),iad_elem(1,i+1)-1
         n = fr_elem(j)
         nn = iloc(n)
         IF (nn>ink)THEN
          nk=nn-ink
          DO k=iad_rl(j),iad_rl(j+1)-1
           nl = fr_icol(k)+iad_elem(1,i)-1
           CALL reorder_a(nrowk(nn),icokm(1,nk),fr_elem(nl))
          ENDDO
         ELSEIF (nn>0)THEN
          DO k=iad_rl(j),iad_rl(j+1)-1
           nl = fr_icol(k)+iad_elem(1,i)-1
           CALL reorder_a(nrowk(nn),icok(1,nn),fr_elem(nl))
          ENDDO
         ENDIF
        ENDDO
       ENDDO
C
      RETURN

kin_nrmax0()

subroutine kin_nrmax0	(	integer	nnmax,
		integer	nkmax,
		integer, dimension(*)	nrowk,
		integer, dimension(nnmax,*)	icok,
		integer, dimension(nkmax,*)	icokm,
		integer, dimension(*)	iloc,
		integer	ink,
		integer, dimension(*)	fr_elem,
		integer, dimension(2,*)	iad_elem )

Definition at line 3159 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NNMAX,NKMAX,NROWK(*),ILOC(*),INK
      INTEGER ICOK(NNMAX,*),ICOKM(NKMAX,*),IAD_ELEM(2,*),FR_ELEM(*)
C----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NL,NR,K,NN
C------------------------------------
      IF (n_frnn==0) RETURN
C
       DO i =1,nspmd
        DO j=iad_elem(1,i),iad_elem(1,i+1)-1
         n = fr_elem(j)
         nn = iloc(n)
         IF (nn>ink)THEN
          DO k=iad_rl(j),iad_rl(j+1)-1
           nl = fr_icol(k)+iad_elem(1,i)-1
           CALL reorder_a(nrowk(nn),icok(1,nn),fr_elem(nl))
          ENDDO
         ELSEIF (nn>0)THEN
          DO k=iad_rl(j),iad_rl(j+1)-1
           nl = fr_icol(k)+iad_elem(1,i)-1
           CALL reorder_a(nrowk(nn),icokm(1,nn),fr_elem(nl))
          ENDDO
         ENDIF
        ENDDO
       ENDDO
C
      RETURN

mav_ltfr()

subroutine mav_ltfr	(		v,
			w )

Definition at line 4603 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C     REAL
      my_real
     .  w(*), v(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,ID
      my_real
     .   l_k
C-----------------------------
      DO i=1,nddl_si
       fsi(i) = zero
      ENDDO
      DO i=1,nddl_si
       DO j =iad_si(i),iad_si(i+1)-1
        k =jdi_si(j)
        l_k = lt_si(j)
        fsi(i) = fsi(i) + l_k*v(k)
        w(k) = w(k) + l_k*usi(i)
      ENDDO
      ENDDO
C
      DO i=1,nddl_sl
       id = iddl_sl(i)
       w(id) = w(id) + diag_sl(i)*v(id)
       DO j =iad_ss(i),iad_ss(i+1)-1
        k =jdi_sl(j)
        l_k = lt_sl(j)
        w(id) = w(id) + l_k*v(k)
        w(k) = w(k) + l_k*v(id)
       ENDDO
      ENDDO
C--------------------------------------------
      RETURN

mav_ltfr_gpu()

subroutine mav_ltfr_gpu	(		v,
			w,
		integer, dimension(*)	nindex )

Definition at line 4657 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NINDEX(*)
C     REAL
      my_real
     .  w(*), v(*) 
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,ID,KK,II
      my_real
     .   l_k
C-----------------------------
      DO i=1,nddl_si
       fsi(i) = zero
      ENDDO
      DO i=1,nddl_si
       DO j =iad_si(i),iad_si(i+1)-1
        k =jdi_si(j)
        kk=nindex(k)
        l_k = lt_si(j)
        fsi(i) = fsi(i) + l_k*v(kk)
        w(kk) = w(kk) + l_k*usi(i)
       ENDDO
      ENDDO
C
      DO i=1,nddl_sl
       id = iddl_sl(i)
       ii = nindex(id)
       w(ii) = w(ii) + diag_sl(i)*v(ii)
       DO j =iad_ss(i),iad_ss(i+1)-1
        k =jdi_sl(j)
        kk=nindex(k)
        l_k = lt_sl(j)
        w(ii) = w(ii) + l_k*v(kk)
        w(kk) = w(kk) + l_k*v(ii)
       ENDDO
      ENDDO
C--------------------------------------------
      RETURN

nddli_frb()

subroutine nddli_frb	(	integer, dimension(*)	ndof,
		integer, dimension(*)	ikc,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ndofi,
		integer	nddlifb,
		integer, dimension(*)	fr_elem,
		integer, dimension(2,*)	iad_elem )

Definition at line 9848 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NDOFI(*) ,IDDL(*),IKC(*),NDOF(*),NDDLIFB
      integer
     .   fr_elem(*),iad_elem(2,*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NK,IP,L,IFRE,II,IAD2,IJ,IND,N_FR,NB,
     .        K,ND,NZZK,NJ,NZZ,IAD,JAD,ID,JD,IDK,NC
      INTEGER, DIMENSION(:),ALLOCATABLE :: ITAG,ICONT
      my_real
     .        s1,stmp
C
      stmp = zero
      n_fr = iad_elem(1,nspmd+1)-iad_elem(1,1)
      IF (n_fr>0) THEN
       ALLOCATE(itag(n_fr),icont(n_fr))
       itag = 0
       DO ip =1,nspmd
        DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
         n=fr_elem(nk)
         idk=iddl(n)
         ifre = 0
         DO j=1,min(ndof(n),ndofi(n))
          IF (ikc(idk+j)==0) ifre=ifre+1
         ENDDO
         itag(nk) = ifre
        ENDDO
       ENDDO
       CALL spmd_nrow(itag,icont,iad_elem,n_fr)
       DO nk=1,n_fr
        icont(nk)=min(itag(nk),icont(nk))
        IF (icont(nk)>0) THEN
         icont(nk) = itag(nk)
             itag(nk) = 2
        ENDIF
       ENDDO
       DO nk=1,n_fr
        nb=-ifrloc(nk)
        IF (nb>0.AND.icont(nk)>0) itag(nb) = itag(nb) + 1
       ENDDO
       DO nk=1,n_fr
         IF (icont(nk)>0) THEN
          nb=-ifrloc(nk)
          IF (nb<0) nb = nk
              s1 = one/itag(nb)
          stmp = stmp + s1*icont(nk)
         ENDIF
       ENDDO
       DEALLOCATE(itag,icont)
      END IF !(N_FR>0) THEN
      CALL spmd_sum_s(stmp)
      nddlifb = int(stmp)
C
      RETURN

nddli_ns()

subroutine nddli_ns	(	integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	lpby,
		integer, dimension(*)	itab,
		integer	nrbyac,
		integer, dimension(*)	irbyac,
		integer	nint2,
		integer, dimension(*)	iint2,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(*)	ndofi,
		integer, dimension(*)	ndof,
		integer, dimension(*)	ikc,
		integer, dimension(*)	iddl,
		integer	nsl,
		integer	nddli,
		integer	nddlins,
		integer, dimension(nrbe3l,*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer, dimension(nrbe2l,*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 10033 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s 
C-----------------------------------------------
      USE intbufdef_mod
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C      INTEGER NNMAX,NKMAX
      INTEGER NDOFI(*) ,IDDL(*),IKC(*),NDOF(*),NDDLINS,NSL
      INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
     .        NINT2,IINT2(*),IPARI(NPARI,*),NDDLI,
     .        IRBE3(NRBE3L,*),LRBE3(*),IRBE2(NRBE2L,*),LRBE2(*)
C     REAL
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer
     .        i,j,k,n,l,nl,nj,ni,j1,m,nsn,n1,n2,nk,id,nm,
     .        ji,ns,nnod,ndofii,iad
C------------
      CALL ndofi_nsl(nsl   ,nddli     ,ndofi     )
      DO j=1,nint2
       n=iint2(j)
       nsn = ipari(5,n)
       ji=ipari(1,n)
       DO i=1,nsn
        ni=intbuf_tab(n)%NSV(i)
        IF (ndofi(ni)<0) THEN
           l=intbuf_tab(n)%IRTLM(i)
           nl=4*(l-1)
           IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
            nnod=3
           ELSE
            nnod=4
           ENDIF
           DO m=1,nnod
            nm=intbuf_tab(n)%IRECTM(nl+m)
            IF (ndofi(nm)==0) ndofi(nm) = -6
           ENDDO
        ENDIF
       ENDDO
      ENDDO
C----RBE2-----
      DO n=1,nrbe2
       iad=irbe2(1,n)
       m  =irbe2(3,n)
       nsn  =irbe2(5,n)
        DO i=1,nsn
         id = i+iad
         ni=lrbe2(id)
         IF (ndofi(ni)<0) THEN
          IF (ndofi(m)==0) ndofi(m) = -6
         ENDIF
       ENDDO
      ENDDO
C--------RBE3----
      DO n=1,nrbe3
       iad=irbe3(1,n)
       ni=irbe3(3,n)
       IF (ni==0) cycle
       nnod=irbe3(5,n)
        IF (ndofi(ni)<0) THEN
           DO m=1,nnod
            nm=lrbe3(iad+m)
            IF (ndofi(nm)==0) ndofi(nm) = -6
           ENDDO
        ENDIF
      ENDDO
C-----active rigid body main nodes------
      DO j=1,nrbyac
       n=irbyac(j)
       k=irbyac(j+nrbykin)
       m  =npby(1,n)
       nsn  =npby(2,n)
        DO i=1,nsn
         id = i+k
         ni=lpby(id)
         IF (ndofi(ni)<0) THEN
          IF (ndofi(m)==0) ndofi(m) = -6
         ENDIF
       ENDDO
      ENDDO
C---- Odded Ndofi for NSL+Kin -------
       nddlins = nddli
       DO n =1,numnod
         IF(ndofi(n)<0) THEN
          ndofii = min(-ndofi(n),ndof(n))
              id=iddl(n)
          DO j=1,ndofii
           IF (ikc(id+j)==0) nddlins = nddlins+1
          ENDDO
         END IF
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

ndofi_nsl()

subroutine ndofi_nsl	(	integer	nsl,
		integer	nddli,
		integer, dimension(*)	ndofi )

Definition at line 9929 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSL,NDOFI(*) ,NDDLI
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
C------- Updated ndofi for nsl ----
      INTEGER I,J,N,IDK,NC,NDOFII
       ndofii = 3
      IF (nddli==0) THEN
       DO n =1,numnod
         ndofi(n)= 0
       ENDDO
      ENDIF
       DO i =1,nsl
         n=isl(i)
         IF(ndofi(n)==0) ndofi(n)= -ndofii
       ENDDO
C
      RETURN

putfr_kij()

subroutine putfr_kij	(	integer	id,
		integer	jd,
		integer, dimension(*)	iadk,
		integer, dimension(*)	jdik,
			k_lt,
			kij,
		integer	nk,
		integer	nl )

Definition at line 6503 of file imp_fri.F.

C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NK   ,NL
      INTEGER ID,JD,IADK(*),JDIK(*)
C     REAL
      my_real
     .   k_lt(*)   ,kij(nk,nl)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,JDL,L,JJ
C----6---------------------------------------------------------------7---------8
         DO k=1,nk
          jdl=0
          DO jj = iadk(id+k),iadk(id+1+k)-1
C-------- Find l'Address in LT -----
           IF (jdik(jj)==(jd+1)) THEN
            jdl = jj-1
            GOTO 300
           ENDIF
          ENDDO
 300      CONTINUE
          DO l=1,nl
           k_lt(jdl+l) = kij(k,l)
          ENDDO
         ENDDO
C
C----6---------------------------------------------------------------7---------8
      RETURN

reorder_fr()

subroutine reorder_fr	(	integer	n,
		integer, dimension(*)	ic,
		integer, dimension(*)	iddl )

Definition at line 5233 of file imp_fri.F.

C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER N ,IC(*),IDDL(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,II,IT,IIC,IMIN
C
C---- In an increasing iddl order -----
      DO i =1,n
       imin=iddl(ic(i))
       ii=i
       DO j =i+1,n
        iic = iddl(ic(j))
        IF (iic<imin) THEN
         imin=iic
         ii=j
        ENDIF
       ENDDO
       IF (ii/=i) THEN
        it=ic(i)
        ic(i)=ic(ii)
        ic(ii)=it
       ENDIF
      ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

rowfr_dim()

subroutine rowfr_dim	(	integer	jlt,
		integer, dimension(*)	ns_imp,
		integer, dimension(*)	ne_imp,
		integer, dimension(4,*)	irect,
		integer, dimension(*)	nrow,
		integer	nsn,
		integer	nin )

Definition at line 4850 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NROW(*),NSN,NIN
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,NE,IG,NS
C-----------------------------------------------
       DO i = 1, jlt
        ig = ns_imp(i)-nsn
        IF (ig>0) THEN
             ns=ind_int(nin)%P(ig)
         ne=ne_imp(i)
         IF (irect(3,ne)==irect(4,ne)) THEN
          nrow(ns)=nrow(ns)+3
         ELSE
          nrow(ns)=nrow(ns)+4
         ENDIF
        ENDIF
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

rowfr_dim11()

subroutine rowfr_dim11	(	integer	jlt,
		integer, dimension(*)	ns_imp,
		integer, dimension(*)	ne_imp,
		integer, dimension(2,*)	irectm,
		integer, dimension(*)	nrow,
		integer	nsn,
		integer	nin )

Definition at line 4893 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECTM(2,*),NROW(*),NSN,NIN
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,NE,IG,NS1,NS2
C-----------------------------------------------
       DO i = 1, jlt
        ig = ns_imp(i)-nsn
        IF (ig>0) THEN
             ns1=ind_int(nin)%P(ig)
             ns2=ns1+1
         ne=ne_imp(i)
         nrow(ns1)=nrow(ns1)+2
         nrow(ns2)=nrow(ns2)+2
        ENDIF
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

rowfr_dim24()

subroutine rowfr_dim24	(	integer	jlt,
		integer, dimension(*)	ns_imp,
		integer, dimension(*)	ne_imp,
		integer, dimension(4,*)	irect,
		integer, dimension(*)	nrow,
		integer	nsn,
		integer	nin,
		integer, dimension(*)	subtria,
		integer, dimension(8,*)	nvoisin )

Definition at line 5031 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NROW(*),NSN,NIN,
     +        SUBTRIA(*),NVOISIN(8,*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,NE,IG,NS,IRTLM(4),NEI
C-----------------------------------------------
       DO i = 1, jlt
        ig = ns_imp(i)-nsn
        IF (ig>0) THEN
             ns=ind_int(nin)%P(ig)
         ne=ne_imp(i)
        IF (ne<0) THEN
         nei=-ne
         CALL i24msegv(ne,irtlm ,subtria(i),irect(1,nei),nvoisin(1,nei))
        ELSE
         irtlm(1:4) = irect(1:4,ne)
        END IF
         IF (irtlm(3)==irtlm(4)) THEN
          nrow(ns)=nrow(ns)+3
         ELSE
          nrow(ns)=nrow(ns)+4
         ENDIF
        ENDIF
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

rowfr_ind()

subroutine rowfr_ind	(	integer	jlt,
		integer, dimension(*)	ns_imp,
		integer, dimension(*)	ne_imp,
		integer, dimension(4,*)	irect,
		integer, dimension(*)	nrow,
		integer, dimension(nnmax,*)	icol,
		integer	nnmax,
		integer	nsn,
		integer	nin )

Definition at line 4936 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NNMAX
      INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NROW(*),
     .        ICOL(NNMAX,*),NSN,NIN
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,NE,IG,NS,NM
C-----------------------------------------------
       DO i = 1, jlt
        ig = ns_imp(i)-nsn
        IF (ig>0) THEN
             ns=ind_int(nin)%P(ig)
         ne=ne_imp(i)
         DO j = 1,4
          nm = irect(j,ne)
          CALL reorder_a(nrow(ns),icol(1,ns),nm)
         ENDDO
        ENDIF
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

rowfr_ind11()

subroutine rowfr_ind11	(	integer	jlt,
		integer, dimension(*)	ns_imp,
		integer, dimension(*)	ne_imp,
		integer, dimension(2,*)	irectm,
		integer, dimension(*)	nrow,
		integer, dimension(nnmax,*)	icol,
		integer	nnmax,
		integer	nsn,
		integer	nin )

Definition at line 4982 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NNMAX
      INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECTM(2,*),NROW(*),
     .        ICOL(NNMAX,*),NSN,NIN
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,NE,IG,NS1,NS2,NM1,NM2
C-----------------------------------------------
       DO i = 1, jlt
        ig = ns_imp(i)-nsn
        IF (ig>0) THEN
             ns1=ind_int(nin)%P(ig)
             ns2=ns1+1
         ne=ne_imp(i)
         nm1=irectm(1,ne)
         nm2=irectm(2,ne)
         CALL reorder_a(nrow(ns1),icol(1,ns1),nm1)
         CALL reorder_a(nrow(ns1),icol(1,ns1),nm2)
         CALL reorder_a(nrow(ns2),icol(1,ns2),nm1)
         CALL reorder_a(nrow(ns2),icol(1,ns2),nm2)
        ENDIF
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

rowfr_ind24()

subroutine rowfr_ind24	(	integer	jlt,
		integer, dimension(*)	ns_imp,
		integer, dimension(*)	ne_imp,
		integer, dimension(4,*)	irect,
		integer, dimension(*)	nrow,
		integer, dimension(nnmax,*)	icol,
		integer	nnmax,
		integer	nsn,
		integer	nin,
		integer, dimension(*)	subtria,
		integer, dimension(8,*)	nvoisin )

Definition at line 5084 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NNMAX
      INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NROW(*),
     .        ICOL(NNMAX,*),NSN,NIN,SUBTRIA(*),NVOISIN(8,*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,NE,IG,NS,NM,IRTLM(4),NEI
C-----------------------------------------------
       DO i = 1, jlt
        ig = ns_imp(i)-nsn
        IF (ig>0) THEN
             ns=ind_int(nin)%P(ig)
         ne=ne_imp(i)
         IF (ne<0) THEN
          nei=-ne
         CALL i24msegv(ne,irtlm ,subtria(i),irect(1,nei),nvoisin(1,nei))
         ELSE
          irtlm(1:4) = irect(1:4,ne)
         END IF
         DO j = 1,4
          nm = irtlm(j)
          CALL reorder_a(nrow(ns),icol(1,ns),nm)
         ENDDO
        ENDIF
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

scom_frk()

subroutine scom_frk	(		ks11,
			kr11,
		integer	ssize,
		integer	rsize )

Definition at line 7588 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER SSIZE  ,RSIZE
      my_real
     .     ks11(9,*),kr11(9,*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,SIZE,IAD_S(NSPMD+1),IAD_R(NSPMD+1)
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      SIZE = 9
      iad_s(1) = 1
      iad_r(1) = 1
       DO i=1,nspmd
        iad_s(i+1) = iad_s(i)
        iad_r(i+1) = iad_r(i)
        DO j=iad_srem(i),iad_srem(i+1)-1
         iad_s(i+1) = iad_s(i+1) + ikc_si(j)
        END DO
        DO j=iad_sl(i),iad_sl(i+1)-1
         iad_r(i+1) = iad_r(i+1) + ikc_sl(j)
        END DO
       END DO
C
      CALL spmd_exck(ks11,kr11,iad_s,iad_r,SIZE ,ssize,rsize)
C
      RETURN

scom_frk1()

subroutine scom_frk1	(		ks11,
			kr11,
		integer, dimension(*)	nfacs,
		integer, dimension(*)	nfacr,
		integer, dimension(3,*)	ikcs,
		integer, dimension(3,*)	ikcr )

Definition at line 7642 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NFACS(*),NFACR(*),IKCS(3,*),IKCR(3,*)
      my_real
     .     ks11(9,*),kr11(9,*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,SSIZE,RSIZE,SIZE,IAD_S(NSPMD+1),IAD_R(NSPMD+1)
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      iad_s(1) = 1
      iad_r(1) = 1
       DO i=1,nspmd
        iad_s(i+1) = iad_s(i)
        iad_r(i+1) = iad_r(i)
        DO j=iad_sl(i),iad_sl(i+1)-1
         iad_s(i+1) = iad_s(i+1) + nfacs(j)
        END DO
        DO j=iad_srem(i),iad_srem(i+1)-1
         iad_r(i+1) = iad_r(i+1) + nfacr(j)
        END DO
       END DO
C
      SIZE = 3
      ssize = iad_s(nspmd+1) - 1
      rsize = iad_r(nspmd+1) - 1
      CALL spmd_exci(ikcs,ikcr,iad_s,iad_r,SIZE ,ssize,rsize)
      SIZE = 9
      iad_s(1) = 1
      iad_r(1) = 1
       DO i=1,nspmd
        iad_s(i+1) = iad_s(i)
        iad_r(i+1) = iad_r(i)
        DO j=iad_sl(i),iad_sl(i+1)-1
         iad_s(i+1) = iad_s(i+1) + nfacs(j)*ikc_sl(j)
        END DO
        DO j=iad_srem(i),iad_srem(i+1)-1
         iad_r(i+1) = iad_r(i+1) + nfacr(j)*ikc_si(j)
        END DO
       END DO
      ssize = iad_s(nspmd+1) - 1
      rsize = iad_r(nspmd+1) - 1
      CALL spmd_exck(ks11,kr11,iad_s,iad_r,SIZE ,ssize,rsize)
C
      RETURN

scom_frud()

subroutine scom_frud	(		uds,
			udr,
		integer, dimension(*)	nf_s,
		integer, dimension(*)	nf_r,
		integer, dimension(*)	ikcs,
		integer, dimension(*)	ikcr )

Definition at line 9014 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IKCS(*),IKCR(*),NF_S(*),NF_R(*)
      my_real
     .     uds(3,*),udr(3,*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I ,J ,K ,L,IADS,IADR,IER1,ID,ID0
      INTEGER SSIZE ,RSIZE,SIZE,IAD_S(NSPMD+1),IAD_R(NSPMD+1)
      my_real, DIMENSION(:,:),ALLOCATABLE :: uds1
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      SIZE = 3
      iads = 1
      iadr = 1
      iad_s(1) = 1
      iad_r(1) = 1
       DO i=1,nspmd
        iad_s(i+1) = iad_s(i)
        iad_r(i+1) = iad_r(i)
        DO j=iad_sl(i),iad_sl(i+1)-1
         DO k = 1,nf_s(j)
          iad_s(i+1) = iad_s(i+1) + min(1,ikcs(iads))
          iads = iads + 1
         END DO
        END DO
        DO j=iad_srem(i),iad_srem(i+1)-1
         DO k = 1,nf_r(j)
          iad_r(i+1) = iad_r(i+1) + min(1,ikcr(iadr))
          iadr = iadr + 1
         END DO
        END DO
       END DO
      ssize = iad_s(nspmd+1) - 1
      rsize = iad_r(nspmd+1) - 1
      IF (ssize>0) THEN
       ALLOCATE(uds1(3,ssize),stat=ier1)
       iads = 1
       DO i=1,nspmd
        id = iad_s(i)
        DO j=iad_sl(i),iad_sl(i+1)-1
         DO k = 1,nf_s(j)
          id0 = ikcs(iads)
              IF (id0>0) THEN
           DO l = 1,3
            uds1(l,id) = uds(l,id0)
           END DO
           id = id + 1
          ENDIF
          iads = iads + 1
         END DO
        END DO
       END DO
      ENDIF
      CALL spmd_exck(uds1,udr ,iad_s,iad_r,SIZE ,ssize,rsize)
      IF (ssize>0) DEALLOCATE(uds1)
C
      RETURN

set_ikin2g()

subroutine set_ikin2g	(	integer	nkine,
		integer, dimension(*)	inloc )

Definition at line 4387 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NKINE,INLOC(*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,N,IERROR1
C
      IF (nkine<=0) RETURN
      IF(ALLOCATED(ikin2g)) DEALLOCATE(ikin2g)
      ALLOCATE(ikin2g(nkine),stat=ierror1)
      DO i =1,numnod
       n=inloc(i)
       IF (n>0) ikin2g(n)=i
      ENDDO
C
      RETURN

set_ind_fr()

subroutine set_ind_fr	(	integer	nsrem,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ndof,
		integer, dimension(*)	nrow,
		integer, dimension(nnmax,*)	icol,
		integer	nnmax )

Definition at line 5137 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NNMAX
      integer
     .   nsrem,iddl(*),ndof(*),nrow(*) ,icol(nnmax,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,L,N,NL,NJ,NDOFI,NZ
      INTEGER IER1,IER2,IER3,IER4,IER5,IER6
c----------
       ndofi = 3
       IF(ALLOCATED(iddl_si)) DEALLOCATE(iddl_si)
       ALLOCATE(iddl_si(nsrem),stat=ier1)
       nddl_si =0
       DO n=1,nsrem
        iddl_si(n)=nddl_si
        nddl_si = nddl_si + ndofi
       ENDDO
       nz = 0
       DO n=1,nsrem
        DO k=1,ndofi
C-------termes kn,nj-------
         DO j=1,nrow(n)
          DO l=1,ndofi
           nz = nz+1
          ENDDO
         ENDDO
        ENDDO
       ENDDO
C
       IF(ALLOCATED(iad_si)) DEALLOCATE(iad_si)
       ALLOCATE(iad_si(nddl_si+1),stat=ier2)
       IF(ALLOCATED(jdi_si)) DEALLOCATE(jdi_si)
       ALLOCATE(jdi_si(nz),stat=ier3)
       IF(ALLOCATED(lt_si)) DEALLOCATE(lt_si)
       ALLOCATE(lt_si(nz),stat=ier4)
       CALL zero1(lt_si,nz)
C
       nl = 1
       nz = 0
       iad_si(nl) = nz+1
       DO n=1,nsrem
        DO k=1,ndofi
C-------termes knj,n-------
          DO j=1,nrow(n)
           nj = icol(j,n)
           DO l=1,ndofi
            nz = nz+1
            jdi_si(nz) = iddl(nj)+l
           ENDDO
          ENDDO
          nl = nl +1
          iad_si(nl) = nz+1
        ENDDO
       ENDDO
       nz_si = nz
C------- Save Icol in compress -------
       nz = 0
       DO n=1,nsrem
        nz = nz+nrow(n)
       ENDDO
       IF(ALLOCATED(iad_sinr)) DEALLOCATE(iad_sinr)
       ALLOCATE(iad_sinr(nsrem+1),stat=ier5)
       IF(ALLOCATED(jdi_sinr)) DEALLOCATE(jdi_sinr)
       ALLOCATE(jdi_sinr(nz),stat=ier6)
       nz = 0
       iad_sinr(1) = nz+1
       DO n=1,nsrem
          DO j=1,nrow(n)
           nj = icol(j,n)
           nz = nz+1
           jdi_sinr(nz) = nj
          ENDDO
          iad_sinr(n+1) = nz+1
       ENDDO
C
      RETURN

spc_fr_k()

subroutine spc_fr_k	(	integer, dimension(*)	iadk,
		integer, dimension(*)	jdik,
		integer, dimension(*)	ndof,
		integer, dimension(*)	iddl,
		integer, dimension(*)	fr_elem,
		integer, dimension(2,*)	iad_elem )

Definition at line 10153 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "impl1_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IADK(*) ,JDIK(*),IDDL(*),NDOF(*)
      integer
     .   fr_elem(*),iad_elem(2,*)
C     REAL
C-----------------------------------------------
C   External function
C-----------------------------------------------
      INTEGER INTAB0
      EXTERNAL intab0
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NK,IP,L,IFIX,II,IAD2,IJ,IND,N_FR,NB,
     .        K,ND,NZZK,NJ,NZZ,IAD,JAD,ID,JD,IDK,NC
C
      IF (nddlfr<=0) RETURN
C-------FR2K-------
      iad2 = 0
      DO ip =1,nspmd
       DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
        n=fr_elem(nk)
        id=iddlfr(nk)+iad2
        idk=iddl(n)
        DO j=1,ndof(n)
          ifr2k(id+j)=idk+j
        ENDDO
       ENDDO
       iad2 = iad2 + nd_fr(ip)
      ENDDO
      len_v = iad2
C
      len_k = 0
       iad = 0
       iad2 = 0
       jad = 0
      IF (ikpat==0) THEN
       DO ip =1,nspmd
        DO i=1,nd_fr(ip)
         id = i+iad
         ii = ifr2k(i+iad2)
         DO j=iadfr(id),iadfr(id+1)-1
          jd = j + jad
          k=jdifr(jd)
          ij = ifr2k(k+iad2)
          IF (ii<ij) THEN
           nc = iadk(ii+1)-iadk(ii)
           n=intab0(nc,jdik(iadk(ii)),ij)
           IF (n>0) THEN
            jfr2k(jd)=n+iadk(ii)-1
           ELSE
            write(*,*)'index error in SPC_FR_K I<J',ij,ip,nc
           ENDIF
          ELSE
           nc = iadk(ij+1)-iadk(ij)
           n=intab0(nc,jdik(iadk(ij)),ii)
           IF (n>0) THEN
            jfr2k(jd)=n+iadk(ij)-1
           ELSE
            write(*,*)'index error in SPC_FR_K J<I',ii,ip,nc
           ENDIF
          ENDIF
         ENDDO
        ENDDO
        nzzk=iadfr(iad+nd_fr(ip)+1)-iadfr(iad+1)
        iad = iad + nd_fr(ip) +1
        iad2 = iad2 + nd_fr(ip)
        jad = jad + nzzk
       ENDDO
      ELSE
       DO ip =1,nspmd
        DO i=1,nd_fr(ip)
         id = i+iad
         ii = ifr2k(i+iad2)
         DO j=iadfr(id),iadfr(id+1)-1
          jd = j + jad
          k=jdifr(jd)
          ij = ifr2k(k+iad2)
          IF (ii>ij) THEN
           nc = iadk(ii+1)-iadk(ii)
           n=intab0(nc,jdik(iadk(ii)),ij)
           IF (n>0) THEN
            jfr2k(jd)=n+iadk(ii)-1
           ELSE
            write(*,*)'index error in SPC_FR_K I>J',ij,ip,nc
           ENDIF
          ELSE
           nc = iadk(ij+1)-iadk(ij)
           n=intab0(nc,jdik(iadk(ij)),ii)
           IF (n>0) THEN
            jfr2k(jd)=n+iadk(ij)-1
           ELSE
            write(*,*)'index error in SPC_FR_K J>I',ii,ip,nc
           ENDIF
          ENDIF
         ENDDO
        ENDDO
        nzzk=iadfr(iad+nd_fr(ip)+1)-iadfr(iad+1)
        iad = iad + nd_fr(ip) +1
        iad2 = iad2 + nd_fr(ip)
        jad = jad + nzzk
       ENDDO
      END IF  !(IKPAT>0)
       len_k = iad2+jad
C
      RETURN

tag_intm()

subroutine tag_intm	(	integer	jlt,
		integer, dimension(*)	ns_imp,
		integer, dimension(*)	ne_imp,
		integer, dimension(4,*)	irect,
		integer, dimension(*)	nsv,
		integer, dimension(*)	iloc,
		integer	n_impn,
		integer	nsn )

Definition at line 770 of file imp_fri.F.

C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECT(4,*),NSV(*),
     .        ILOC(*),N_IMPN,NSN
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,N1,N2,NE,IG
C-----------------------------------------------
       DO i = 1, jlt
C--------second node-----
        ig = ns_imp(i)
       IF (ig>nsn) THEN
        ne=ne_imp(i)
        DO j=1,3
         n=irect(j,ne)
         IF (iloc(n)==0) THEN
          n_impn=n_impn+1
          iloc(n)=n_impn
         ENDIF
        ENDDO
        IF (irect(3,ne)/=irect(4,ne)) THEN
         n=irect(4,ne)
         IF (iloc(n)==0) THEN
          n_impn=n_impn+1
          iloc(n)=n_impn
         ENDIF
        ENDIF
       ENDIF
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

tag_intm11()

subroutine tag_intm11	(	integer	jlt,
		integer, dimension(*)	ns_imp,
		integer, dimension(*)	ne_imp,
		integer, dimension(2,*)	irects,
		integer, dimension(2,*)	irectm,
		integer, dimension(*)	iloc,
		integer	n_impn,
		integer	nsn )

Definition at line 4558 of file imp_fri.F.

C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER JLT,NS_IMP(*),NE_IMP(*),IRECTS(2,*),IRECTM(2,*),
     .        ILOC(*),N_IMPN,NSN
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,N1,N2,NE,IG,M1,M2
C-----------------------------------------------
       DO i = 1, jlt
C--------second node-----
        ig = ns_imp(i)
       IF (ig>nsn) THEN
        ne=ne_imp(i)
         m1=irectm(1,ne)
         m2=irectm(2,ne)
         IF (iloc(m1)==0) THEN
          n_impn=n_impn+1
          iloc(m1)=n_impn
         ENDIF
         IF (iloc(m2)==0) THEN
          n_impn=n_impn+1
          iloc(m2)=n_impn
         ENDIF
       ENDIF
       ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

tag_intml()

subroutine tag_intml	(	integer	nsrem,
		integer, dimension(*)	iloc,
		integer	n_impn,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer	lsi )

Definition at line 7521 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSREM,ILOC(*),N_IMPN,IDDL(*) ,IKC(*) ,NDOF(*) ,LSI
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,IG,NM,NDD,ID,IER1,IER2
C-----------------------------------------------
       DO i = 1, nsrem
        DO j =iad_sinr(i),iad_sinr(i+1)-1
         ig = jdi_sinr(j)
         IF (iloc(ig)==0) THEN
          n_impn = n_impn + 1
          iloc(ig) = n_impn
         ENDIF
        ENDDO
       ENDDO
C---------------
       nml = n_impn
       IF(ALLOCATED(iml)) DEALLOCATE(iml)
       ALLOCATE(iml(nml),stat=ier1)
       DO i = 1, nsrem
        DO j =iad_sinr(i),iad_sinr(i+1)-1
         ig = jdi_sinr(j)
         nm = iloc(ig)
         iml(nm) = ig
        ENDDO
       ENDDO
C--------use also IKC_SL for ml IFLAG_KC ONLY----
        IF(ALLOCATED(ikc_sl)) DEALLOCATE(ikc_sl)
        ALLOCATE(ikc_sl(nml),stat=ier2)
        lsi = 0
        DO i = 1, nml
         n = iml(i)
             id = iddl(n)
         ndd = 0
         DO j = 1 , min(3,ndof(n))
           ndd = ndd + ikc(id+j)
         ENDDO
         IF (ndof(n)==0.OR.ndd>0) ndd = nsrem
         ikc_sl(i) = ndd
         lsi = lsi + ndd
        ENDDO
C----6---------------------------------------------------------------7---------8
      RETURN

tag_ints()

subroutine tag_ints	(	integer	nsl,
		integer, dimension(*)	iloc,
		integer	n_impn )

Definition at line 824 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSL,ILOC(*),N_IMPN
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,N1,N2,NE,IG
C-----------------------------------------------
      IF (intp_d>0) THEN
       DO i = 1, nsl
C--------second node--------------
        n = isl(i)
        IF (iloc(n)==0) iloc(n)=i
       ENDDO
      ELSE
 
       DO i = 1, nsl
C--------second node-----
        n = isl(i)
        IF (iloc(n)==0) THEN
         n_impn=n_impn+1
         iloc(n)=n_impn
C
         islm(i) = n
        ELSE
         islm(i) = 0
C
        ENDIF
       ENDDO
C
      ENDIF
C----6---------------------------------------------------------------7---------8
      RETURN

tra_frkm()

subroutine tra_frkm	(	integer	nsl,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer, dimension(*)	iad_m,
			ksi,
			ksl,
		integer, dimension(3,*)	ikcsl )

Definition at line 7304 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSL,IDDL(*),IKC(*),NDOF(*),IAD_M(*),IKCSL(3,*)
C     REAL
      my_real
     .   ksi(9,*),ksl(9,*)
C-----------------------------------------------
C   External function
C-----------------------------------------------
      LOGICAL IKINCF
      EXTERNAL ikincf
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,N,ID,IADI,IADL,SIZE,NJ,NB,IDM,NKC
      LOGICAL NODOF
C-------------------------------------
        SIZE = 9
        iadl=1
        DO i = 1, nsl
        IF (ikc_sl(i)>0) THEN
         iadi=iad_m(i)
         n = isl(i)
         id = iddl(n)
         IF (ndof(n)==0.OR.(ikc(id+1)/=0.AND.ikc(id+2)/=0
     .       .AND.ikc(id+3)/=0)) THEN
          nodof = .true.
         ELSE
          nodof = .false.
         END IF
C
         DO j = 1, ikc_sl(i)
          DO k=iad_slnr(i),iad_slnr(i+1)-1
           nj = jdi_slnr(k)
           id = iddl(nj)
           IF (nodof.AND.(ikincf(ikc(id+1)).OR.ikincf(ikc(id+2)).OR.
     .         ikincf(ikc(id+3)))) THEN
            CALL cp_real(SIZE,ksi(1,iadi),ksl(1,iadl))
            iadl=iadl+1
           ENDIF
           iadi=iadi+1
           IF (ndof(nj)==6) THEN
            IF (nodof.AND.(ikincf(ikc(id+4)).OR.ikincf(ikc(id+5)).OR.
     .          ikincf(ikc(id+6)))) THEN
             CALL cp_real(SIZE,ksi(1,iadi),ksl(1,iadl))
             iadl=iadl+1
            ENDIF
            iadi=iadi+1
           ENDIF
          ENDDO
Ctmp special case of d_imp in all directions
         IF (nodof) THEN
           IF (ndof(n)>0.AND.iad_slnr(i)==iad_slnr(i+1))THEN
            nb = SIZE
            CALL cp_real(nb,ksi(1,iadi),ksl(1,iadl))
            iadl=iadl+1
           ENDIF
         ELSE
          nb = SIZE
          CALL cp_real(nb,ksi(1,iadi),ksl(1,iadl))
          iadl=iadl+1
C------case /BCS          
          IF (iad_slnr(i)==iad_slnr(i+1)) iadi = iadi + 1
          ENDIF
C         
         END DO !J = 1, IKC_SL(I)
C
        ENDIF
        ENDDO
C------init IKCSL-------
        iadi = 1
        DO i = 1, nsl
         n = isl(i)
         IF (ikc_sl(i)>0) THEN
          DO j=iad_slnr(i),iad_slnr(i+1)-1
           nj = jdi_slnr(j)
           id = iddl(nj)
           IF (ikincf(ikc(id+1)).OR.ikincf(ikc(id+2)).OR.
     .         ikincf(ikc(id+3))) THEN
            DO k =1,3
             ikcsl(k,iadi) = ikc(id+k)
            ENDDO
            iadi = iadi + 1
           ENDIF
           IF (ndof(nj)==6) THEN
            IF (ikincf(ikc(id+4)).OR.ikincf(ikc(id+5)).OR.
     .          ikincf(ikc(id+6))) THEN
             DO k =1,3
              ikcsl(k,iadi) = ikc(id+k+3)
             ENDDO
             iadi = iadi + 1
            ENDIF
           ENDIF
          ENDDO
C----------other kin------------
          IF (iad_slnr(i)==iad_slnr(i+1).AND.ndof(n)>0) THEN
           id = iddl(n)
           IF (ikincf(ikc(id+1)).OR.ikincf(ikc(id+2)).OR.
     .         ikincf(ikc(id+3))) THEN
            DO k =1,3
             ikcsl(k,iadi) = ikc(id+k)
            ENDDO
            iadi = iadi + 1
           ENDIF
          ENDIF
         ENDIF
        ENDDO
C
      RETURN

upd_fr()

subroutine upd_fr	(		a,
			ar,
			x,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(*)	ndof,
		integer, dimension(nifv,*)	ibfv,
			skew,
			xframe,
		integer, dimension(nrbe3l,*)	irbe3,
		integer, dimension(*)	lrbe3,
		integer, dimension(nrbe2l,*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 2827 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
      USE imp_rwl
      USE imp_aspc
      USE intbufdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IRBE3(NRBE3L,*),LRBE3(*),IRBE2(NRBE2L,*),LRBE2(*),
     .        IPARI(NPARI,*), NDOF(*),IBFV(NIFV,*)
      my_real
     .  a(3,*),ar(3,*),x(3,*) ,skew(lskew,*),xframe(nxframe,*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,M,NS,NI,NSN,ILEV,I1,IADS,IROT,IAD,NNOD,ISK,IRAD,
     .        JI,JT(3),JR(3),NN,IC
      my_real
     .  ej(3)
C------int2-------
       DO i=1,ni2_fr
        n=ifrs2(1,i)
        ji=ipari(1,n)
        nsn=ipari(5,n)
        ni=ifrs2(2,i)
        ilev  =ipari(20,n)
        IF (ilev==1) THEN
         CALL i2_frfm1(x   ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA ,intbuf_tab(n)%NSV ,
     1                intbuf_tab(n)%IRTLM ,a   ,ni   )
        ELSE
         CALL i2_frfm0(x   ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS ,intbuf_tab(n)%NSV ,
     1                intbuf_tab(n)%IRTLM ,a   ,ar    ,ni  ,ndof    )
        ENDIF
       ENDDO
C------RBE2-------
       DO i=1,nrbe2_fr
        n=ifrs4(1,i)
        m=irbe2(3,n)
        ns=ifrs4(2,i)
        isk = irbe2(7,n)
            irad =irbe2(11,n)
         ic = irbe2(4,n)
C--------remove ICR---
         ic =(ic/512)*512
         CALL prerbe2fr(ic    ,jt  ,jr   )
         CALL rbe2frf(ns    ,m     ,a     ,ar    ,jt    ,
     1                jr    ,x     ,isk   ,skew(1,isk),irad  )
       ENDDO
C--------RBE3-----
       iads=1
       DO i=1,nrbe3_fr
         n=ifrs3(i)
         iad=irbe3(1,n)
         ns=irbe3(3,n)
         nnod=irbe3(5,n)
         irot=irbe3(6,n)
         CALL prerbe3fr(irbe3 ,n    ,jt  ,jr   )
         CALL rbe3frf(nnod  ,lrbe3(iad+1),ns    ,a     ,ar    ,
     1                frcdi(iads),mrcdi(iads),jt    ,jr    ,irot  )
        iads=iads+nnod
       ENDDO
C------Rigid bodies-------
       DO i=1,nrb_fr
        m=ifrsr(1,i)
        ns=ifrsr(2,i)
        CALL rby_impf(x    ,m      ,ns     ,ndof   ,a     ,
     .               ar    )
       ENDDO
       IF (nbc_fr>0) THEN
        CALL bc_updf(nbc_fr ,ibc_fr ,skew  ,a      )
       ENDIF
       DO i1=1,nspc_fr
          n = ispc_fr(i1)
          i = in_spc(n)
              iad = 6*(n-1)+1
              nn = ic_spc(n)
            IF (nn==1) THEN
             ej(1)=skew_spc(iad)
             ej(2)=skew_spc(iad+1)
             ej(3)=skew_spc(iad+2)
          CALL l_dir(ej,j)
          CALL bc_fi(i    ,skew_spc(iad),j    ,a     )
            ELSEIF (nn==2) THEN
          CALL bc_fi2(i   ,skew_spc(iad),skew_spc(iad+3),a    )
            END IF
       ENDDO
C
       IF (nfx_fr>0) THEN
        CALL fv_updf(nfx_fr ,ifx_fr ,ibfv  ,skew  ,xframe,
     1               a      )
       ENDIF
       DO i1 = 1,nrw_fr
        i = irw_fr(i1)
        n = in_rwl(i)
        ej(1)=nor_rwl(1,i)
        ej(2)=nor_rwl(2,i)
        ej(3)=nor_rwl(3,i)
        CALL l_dir(ej,j)
        CALL kin_updf(n    ,ej    ,j    ,a     )
       ENDDO
C
      RETURN

upd_fr_k()

subroutine upd_fr_k	(	integer, dimension(*)	iadk,
		integer, dimension(*)	jdik,
		integer, dimension(*)	ndof,
		integer, dimension(*)	ikc,
		integer, dimension(*)	iddl,
		integer, dimension(*)	inloc,
		integer, dimension(*)	fr_elem,
		integer, dimension(2,*)	iad_elem,
		integer	nddl )

Definition at line 4094 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "impl1_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IADK(*) ,JDIK(*),IDDL(*),INLOC(*),NDOF(*)
      integer
     .   ikc(*), fr_elem(*),iad_elem(2,*),nddl
C     REAL
C-----------------------------------------------
C   External function
C-----------------------------------------------
      INTEGER INTAB0
      EXTERNAL intab0
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NK,IP,L,IFIX,II,IAD2,IJ,IND,N_FR,NB,
     .        K,ND,NZZK,NJ,NZZ,IAD,JAD,ID,JD,IDK,NC,IDF,IKCFR(NDDLFR)
      INTEGER IIC(NDFRMAX),IDDLM(NUMNOD),NDN(NSPMD),NZN(NSPMD)
      INTEGER, DIMENSION(:),ALLOCATABLE :: ITAG
      my_real
     .        s1,stmp
C
      ddlp0=0
      ddlp1=nddl
C
      stmp = zero
      IF (nddlfr>0) THEN
       n_fr = iad_elem(1,nspmd+1)-iad_elem(1,1)
       ALLOCATE(itag(n_fr))
       itag = 2
       DO nk=1,n_fr
        nb=-ifrloc(nk)
        IF (nb>0) itag(nb) = itag(nb) + 1
       ENDDO
      ENDIF
C
      IF (nddlfr>0) THEN
C-------if not the same IKC (e.g. RBE3 Ns)      
c       IKCFR (before condensation) for comm IKC
       iad2 = 0
       DO ip =1,nspmd
        DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
         n=fr_elem(nk)
         id=iddlfr(nk)+iad2
         idk=iddl(n)
         DO j=1,ndof(n)
          ikcfr(id+j)=ikc(idk+j)
         ENDDO
        ENDDO
        iad2 = iad2 + nd_fr(ip)
       ENDDO
       CALL spmd_max_iv(ikcfr)
       iad2 = 0
      iad = 0
      jad = 0
      ii = 0
      ij = 0
      DO ip =1,nspmd
       ifix = 0
       DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
        n=fr_elem(nk)
        id=iddlfr(nk)
        idk=iddl(n)
        ind = ifix
        DO j=1,ndof(n)
         iic(id+j)=ikcfr(id+iad2+j)
         IF (iic(id+j)/=0) ifix=ifix+1
        ENDDO
C
        nb=-ifrloc(nk)
        IF (nb<0) nb = nk
        s1 = one/itag(nb)
        stmp = stmp + s1*(ifix-ind)
C
       ENDDO
C -----update---condense-IKC>=1------------------------------------
       nd = nd_fr(ip)
       nzz=iadfr(iad+nd_fr(ip)+1)-iadfr(iad+1)
       iad2 = iad2 + nd_fr(ip)
       IF (ifix>0) THEN
        nzzk=nzz
        CALL condens_ind(nd_fr(ip),nzzk,iadfr(iad+1),jdifr(jad+1),iic)
        ii = ii + ifix
        ij = ij + nzz-nzzk
       ENDIF
       iad = iad + nd + 1
       jad = jad + nzz
       ndn(ip)=ii
       nzn(ip)=ij
      ENDDO
      DEALLOCATE(itag)
      ENDIF  ! (NDDLFR>0)
      CALL spmd_sum_s(stmp)
      nddlfrb1 = nddlfrb-int(stmp)
      IF (nddlfr<=0) RETURN
C-------if there is condensation-------
      IF (ndn(nspmd)>0) THEN
       iad = nd_fr(1) + 1
       DO ip =2,nspmd
        ii = ndn(ip-1)
        IF (ii>0) THEN
         ii = ii+iad
         DO i=1,nd_fr(ip)+1
          iadfr(iad+i)=iadfr(ii+i)
         ENDDO
        ENDIF
        iad = iad + nd_fr(ip) + 1
       ENDDO
       iad = nd_fr(1) + 1
       jad = iadfr(iad)-iadfr(1)
       DO ip =2,nspmd
        ij = nzn(ip-1)
        IF (ij>0) THEN
         ij = ij+jad
         DO j=iadfr(iad+1),iadfr(iad+1+nd_fr(ip))-1
          jdifr(j+jad)= jdifr(j+ij)
         ENDDO
        ENDIF
        nzzk=iadfr(iad+nd_fr(ip)+1)-iadfr(iad+1)
        iad = iad + nd_fr(ip) + 1
        jad = jad + nzzk
       ENDDO
      ENDIF
C
        ifix=0
       DO n = 1,numnod
         i=inloc(n)
         iddlm(i)=iddl(i)-ifix
         DO j=1,ndof(i)
          nd = iddl(i)+j
          IF (ikc(nd)/=0) ifix=ifix+1
         ENDDO
       ENDDO
C
C-------FR2K-------
      iad2 = 0
      DO ip =1,nspmd
       ifix=0
       DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
        n=fr_elem(nk)
        id=iddlfr(nk)+iad2-ifix
        idk=iddl(n)
        ind=0
        DO j=1,ndof(n)
         IF (ikc(idk+j)<1) THEN
          ind=ind+1
          ifr2k(id+ind)=iddlm(n)+ind
         ELSE
          ifix=ifix+1
         ENDIF
        ENDDO
       ENDDO
       iad2 = iad2 + nd_fr(ip)
      ENDDO
      len_v = iad2
C
       len_k = 0
      IF (iprec>2) THEN
       iad = 0
       iad2 = 0
       jad = 0
       DO ip =1,nspmd
        DO i=1,nd_fr(ip)
         id = i+iad
         ii = ifr2k(i+iad2)
         DO j=iadfr(id),iadfr(id+1)-1
          jd = j + jad
          k=jdifr(jd)
          ij = ifr2k(k+iad2)
          IF (ii>ij) THEN
           nc = iadk(ii+1)-iadk(ii)
           n=intab0(nc,jdik(iadk(ii)),ij)
           IF (n>0) THEN
            jfr2k(jd)=n+iadk(ii)-1
           ELSE
            write(*,*)'index error in UPD_FR_K I>J',ij,ip,nc
c           write(*,*)'i,j,ik,iad=',i,k,ii,iad
           ENDIF
          ELSE
           nc = iadk(ij+1)-iadk(ij)
           n=intab0(nc,jdik(iadk(ij)),ii)
           IF (n>0) THEN
            jfr2k(jd)=n+iadk(ij)-1
           ELSE
            write(*,*)'index error in UPD_FR_K J>I',ii,ip,nc
c           write(*,*)'i,j,ik,iad=',i,k,ij,iad
           ENDIF
          ENDIF
         ENDDO
        ENDDO
        nzzk=iadfr(iad+nd_fr(ip)+1)-iadfr(iad+1)
        iad = iad + nd_fr(ip) +1
        iad2 = iad2 + nd_fr(ip)
        jad = jad + nzzk
       ENDDO
       len_k = iad2+jad
       iad2 = 0
       DO ip =1,ispmd
        DO j =1,nd_fr(ip)
         ddlp0 = max(ddlp0,ifr2k(iad2+j))
        ENDDO
        iad2=iad2+nd_fr(ip)
       ENDDO
C
       DO ip =ispmd+2,nspmd
        ifix=0
        DO nk=iad_elem(1,ip),iad_elem(1,ip+1)-1
         n=fr_elem(nk)
         id=iddlfr(nk)+iad2-ifix
         idk=iddl(n)
         DO j=1,ndof(n)
          IF (ikc(idk+j)>0) ifix=ifix+1
         ENDDO
         IF(ifrloc(nk)>0) THEN
          ind=0
          DO j=1,ndof(n)
           IF (ikc(idk+j)<1) THEN
            ind=ind+1
            ddlp1=ifr2k(id+ind)-1
            GOTO 100
           ENDIF
          ENDDO
         ENDIF
        ENDDO
        iad2 = iad2 + nd_fr(ip)
       ENDDO
      ENDIF
c      write(*,*)'LEN_V,LEN_K,ISPMD=',LEN_V,LEN_K,ISPMD
c      write(*,*)'ND_FR=',(ND_FR(J),J=1,NSPMD),ISPMD
 100  CONTINUE
C
      RETURN

upd_kml()

subroutine upd_kml	(	integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer	nint2,
		integer, dimension(*)	iint2,
		integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	lpby,
		integer, dimension(*)	itab,
		integer	nrbyac,
		integer, dimension(*)	irbyac,
			x,
		integer, dimension(nifv,*)	ibfv,
		integer, dimension(*)	lj,
			skew,
			xframe,
		integer, dimension(*)	iskew,
		integer, dimension(*)	icodt,
		integer, dimension(*)	inloc,
		integer	nsl,
		integer, dimension(*)	iad_m,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer, dimension(*)	iddlm,
			ud,
			a,
			ksl,
			ksi,
		integer	nsrem,
		integer, dimension(*)	nf_si,
		integer, dimension(*)	iddli,
		integer, dimension(nrbe3l,*)	irbe3,
		integer, dimension(*)	lrbe3,
			frbe3,
		integer, dimension(nrbe2l,*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 7732 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
      USE imp_rwl
      USE imp_aspc
      USE intbufdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "tabsiz_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,*),NSL,IAD_M(*),NSREM
      INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
     .        NINT2,IINT2(*),IDDL(*),IKC(*),NDOF(*),INLOC(*),
     .        IBFV(NIFV,*),LJ(*),ISKEW(*),ICODT(*),IDDLM(*),
     .        NF_SI(*) ,IDDLI(*),IRBE3(NRBE3L,*),LRBE3(*),
     .        IRBE2(NRBE2L,*),LRBE2(*)
C     REAL
      my_real
     .  x(3,*),skew(lskew,*),xframe(*),
     .  ud(3,*),a(3,*),ksl(9,*) ,ksi(9,*),frbe3(*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,K,M,NS,NI,NSN,ILEV,IAD_M1(NSREM+1),
     .        JI,L,NNOD,
     .        NJ,ND,NL,ISK,IFM,J1,IFLAG,NSS,NM,ID,IAD0,IAD,
     .        I1,ICT,NF,NR,IS,JD,IFSS,IFSM,IBID,JT(3),JR(3),IADS,
     .        IROT,IADR,NN,IRAD,IC,EID
      my_real
     .  ej(3),ksm(9),knm(9,4),krm(9,4),rbid
      my_real,
     .         DIMENSION(:),ALLOCATABLE :: knm3,krm3
C-----only [ksm] to update : second dependant :FRK_SI, second inde. LT_SI,
C     ----       --added inde,:FRK_SL-----------
       ifss = 0
       ifsm = 1
       nd = 3
C------partie kin, vis a vis de SL--------
       iad_m1(1) = 1
       DO n=1,nsrem
        iad_m1(n+1) = iad_m1(n)+ikc_si(n)*nf_si(n)
       ENDDO
       DO i=1,iad_m(nsl+1)-1
        DO j=1,9
         ksl(j,i) = zero
        ENDDO
       ENDDO
C------int2----------------------------------
       DO i=ni2_fr,1,-1
        n=ifrs2(1,i)
        ni=ifrs2(2,i)
         ji=ipari(1,n)
         nsn=ipari(5,n)
         ns=intbuf_tab(n)%NSV(ni)
         l=intbuf_tab(n)%IRTLM(ni)
         nl=4*(l-1)
         IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
          nnod=3
         ELSE
          nnod=4
         ENDIF
         ilev  =ipari(20,n)
C
         IF (inloc(ns)>nsl) THEN
          nss = inloc(ns)-nsl
          nr=iad_slnr(nss+1)- iad_slnr(nss)
          CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
          IF (j>0) THEN
          DO is = 1,nsrem
           iad = iad_m(nss) + j + is -2
           CALL cp_real(9,ksl(1,iad),ksm)
          IF (ilev==1) THEN
           CALL i2_frk1(intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA,x    ,itab ,
     .                  intbuf_tab(n)%NSV,
     1                  intbuf_tab(n)%IRTLM,ikc  ,ndof  ,iddl ,iddlm,
     2                  ibid ,ibid ,rbid,rbid ,rbid  ,a      ,
     3                  rbid ,ksm  ,knm   ,krm  ,ni  ,
     4                  ibid ,ifss ,ifsm)
          ELSE
           CALL i2_frk0(intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS,x    ,itab ,
     .                  intbuf_tab(n)%NSV,
     1                  intbuf_tab(n)%IRTLM,ikc  ,ndof  ,iddl ,iddlm,
     2                  ibid ,ibid ,rbid,rbid ,rbid  ,a      ,
     3                  rbid ,ksm  ,knm   ,krm  ,ni  ,
     4                  ibid ,ifss ,ifsm)
          ENDIF
          DO k =1,nnod
           nj=intbuf_tab(n)%IRECTM(nl+k)
           CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),nj,j)
           iad = iad_m(nss) + j +is -2
           CALL cp_real(9,knm(1,k),ksl(1,iad))
           IF (ndof(nj)>3)CALL cp_real(9,krm(1,k),ksl(1,iad+nsrem))
          ENDDO
          END DO ! IS = 1,NSREM
          END IF !(J>0) THEN
         ELSE
          nss = inloc(ns)
          DO is = 1,nsrem
           nr =iad_sinr(is+1)- iad_sinr(is)
           CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
           IF (j>0) THEN
           DO nf = 1,max(1,nf_si(is))
C-------------------in KFR_SI----
            IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
             n = 0
             CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n    ,is  ,
     1                   j    ,ikc_si(is),ndof  ,iad  )
             iad = iad + nf-1
             CALL cp_real(9,ksi(1,iad),ksm)
            ELSE
             id = iddl_si(is)
             nm = jdi_sinr(iad_sinr(is)+j-1)
             jd = iddli(nm)
             CALL getfr_kij( id    ,jd   ,iad_si ,jdi_si,lt_si  ,
     1                     ksm   ,nd   ,nd    )
            ENDIF
            IF (ilev==1) THEN
             CALL i2_frk1(intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA,x    ,itab ,
     .                  intbuf_tab(n)%NSV,
     1                  intbuf_tab(n)%IRTLM,ikc  ,ndof  ,iddl ,iddlm,
     2                  ibid ,ibid ,rbid,rbid ,rbid  ,a      ,
     3                  rbid ,ksm  ,knm   ,krm  ,ni  ,
     4                  ibid ,ifss ,ifsm)
            ELSE
             CALL i2_frk0(intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS,x    ,itab ,
     .                  intbuf_tab(n)%NSV,
     1                  intbuf_tab(n)%IRTLM,ikc  ,ndof  ,iddl ,iddlm,
     2                  ibid ,ibid ,rbid,rbid ,rbid  ,a      ,
     3                  rbid ,ksm  ,knm   ,krm  ,ni  ,
     4                  ibid ,ifss ,ifsm)
            ENDIF
            DO k =1,nnod
             nj=intbuf_tab(n)%IRECTM(nl+k)
             nr =iad_slnr(nss+1)- iad_slnr(nss)
             CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),nj,j)
             iad = iad_m(nss) + j + is -2
             CALL cp_real(9,knm(1,k),ksl(1,iad))
             IF (ndof(nj)>3)CALL cp_real(9,krm(1,k),ksl(1,iad+nsrem))
            ENDDO
           ENDDO
           ENDIF
          ENDDO
         ENDIF
C
       ENDDO
C------RBE2-------
       DO i=nrbe2_fr,1,-1
        n=ifrs4(1,i)
        m=irbe2(3,n)
        ns=ifrs4(2,i)
        isk = irbe2(7,n)
            irad =irbe2(11,n)
            ic = irbe2(4,n)
C--------remove ICR---
        ic =(ic/512)*512
        IF (inloc(ns)>nsl) THEN
          nss = inloc(ns)-nsl
          nr=iad_slnr(nss+1)- iad_slnr(nss)
          CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
             IF (j>0) THEN
         DO is = 1,nsrem
          iad = iad_m(nss) + j + is -2
          CALL cp_real(9,ksl(1,iad),ksm)
          CALL prerbe2fr(ic    ,jt  ,jr   )
          CALL rbe2_frk(ns    ,m    ,x     ,isk  ,skew(1,isk) ,
     1                  irad  ,ndof  ,iddl ,jt   ,jr     ,
     2                  ibid  ,ibid ,rbid  ,rbid ,rbid   ,
     3                  a     ,rbid ,ksm   ,knm  ,krm    ,
     4                  ibid  ,ifss ,ifsm  )
          CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),m,j)
          iad = iad_m(nss) + j + is -2
          CALL cp_real(9,knm,ksl(1,iad))
          CALL cp_real(9,krm,ksl(1,iad+nsrem))
         END DO ! IS = 1,NSREM
             END IF !(J>0) THEN
        ELSE
         nss = inloc(ns)
         DO is = 1,nsrem
          nr =iad_sinr(is+1)- iad_sinr(is)
          CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
          IF (j>0) THEN
          DO nf = 1,max(1,nf_si(is))
C----------------in KFR_SI------
           IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
            n = 0
            CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n    ,is  ,
     1                   j    ,ikc_si(is),ndof  ,iad  )
            iad = iad + nf-1
            CALL cp_real(9,ksi(1,iad),ksm)
           ELSE
            id = iddl_si(is)
            nm = jdi_sinr(j+iad_sinr(is)-1)
            jd = iddli(nm)
            CALL getfr_kij(id    ,jd   ,iad_si ,jdi_si,lt_si  ,
     1                     ksm   ,nd   ,nd    )
           ENDIF
          CALL prerbe2fr(ic    ,jt  ,jr   )
          CALL rbe2_frk(ns    ,m    ,x     ,isk  ,skew(1,isk) ,
     1                  irad  ,ndof  ,iddl ,jt   ,jr    ,
     2                  ibid  ,ibid  ,rbid  ,rbid ,rbid  ,
     3                  a     ,rbid  ,ksm   ,knm  ,krm   ,
     4                  ibid  ,ifss  ,ifsm  )
           nr=iad_slnr(nss+1)- iad_slnr(nss)
           CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),m,j)
           iad = iad_m(nss) + j + is -2
           CALL cp_real(9,knm,ksl(1,iad))
           CALL cp_real(9,krm,ksl(1,iad+nsrem))
          ENDDO
          ENDIF
         ENDDO
        ENDIF
       ENDDO
C------RBE3----------------------------------
       DO i=1,nrbe3_fr
        n=ifrs3(i)
        ns=irbe3(3,n)
        iadr=irbe3(1,n)
        nnod=irbe3(5,n)
        irot =irbe3(6,n)
        eid =irbe3(2,n)
        iads = slrbe3/2+iadr
        CALL prerbe3fr(irbe3 ,n    ,jt  ,jr   )
        ALLOCATE(knm3(9*nnod))
        IF (irot>0) ALLOCATE(krm3(9*nnod))
        IF (inloc(ns)>nsl) THEN
          nss = inloc(ns)-nsl
          nr=iad_slnr(nss+1)- iad_slnr(nss)
          CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
           IF (j>0) THEN
          DO is = 1,nsrem
           iad = iad_m(nss) + j + is -2
           CALL cp_real(9,ksl(1,iad),ksm)
          CALL rbe3_fr0(ns    ,nnod  ,lrbe3(iadr+1)  ,x     ,irot   ,
     2                  jt    ,jr    ,frbe3(6*iadr+1)  ,skew  ,ikc   ,
     3                  ndof  ,ibid  ,ibid   ,rbid  ,rbid   ,
     2                  rbid  ,ksm   ,knm3  ,krm3  ,ibid   ,
     3                  ifss  ,ifsm  ,itab  ,lrbe3(iads+1),eid)
          DO k =1,nnod
           nj = lrbe3(iadr+k)
           CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),nj,j)
           iad = iad_m(nss) + j +is -2
           id = 9*(k-1) + 1 
           CALL cp_real(9,knm3(id),ksl(1,iad))
           IF (irot>0.AND.ndof(nj)==6)
     +           CALL cp_real(9,krm3(id),ksl(1,iad+nsrem))
          ENDDO
          END DO ! IS = 1,NSREM
           END IF !(J>0) THEN
         ELSE
          nss = inloc(ns)
          DO is = 1,nsrem
           nr =iad_sinr(is+1)- iad_sinr(is)
           CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
           IF (j>0) THEN
           DO nf = 1,max(1,nf_si(is))
C-------------------in KFR_SI----
            IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
             n = 0
             CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n    ,is  ,
     1                   j    ,ikc_si(is),ndof  ,iad  )
             iad = iad + nf-1
             CALL cp_real(9,ksi(1,iad),ksm)
            ELSE
             id = iddl_si(is)
             nm = jdi_sinr(iad_sinr(is)+j-1)
             jd = iddli(nm)
             CALL getfr_kij( id    ,jd   ,iad_si ,jdi_si,lt_si  ,
     1                     ksm   ,nd   ,nd    )
            ENDIF
            CALL rbe3_fr0(ns    ,nnod  ,lrbe3(iadr+1)  ,x     ,irot   ,
     2                    jt    ,jr    ,frbe3(6*iadr+1)  ,skew  ,ikc   ,
     3                    ndof  ,ibid  ,ibid   ,rbid  ,rbid   ,
     2                    rbid  ,ksm   ,knm3  ,krm3  ,ibid   ,
     3                    ifss  ,ifsm  ,itab  ,lrbe3(iads+1),eid)
            DO k =1,nnod
             nj = lrbe3(iadr+k)
             nr =iad_slnr(nss+1)- iad_slnr(nss)
             CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),nj,j)
             iad = iad_m(nss) + j + is -2
             id = 9*(k-1) + 1 
             CALL cp_real(9,knm3(id),ksl(1,iad))
             IF (irot>0.AND.ndof(nj)==6)
     +           CALL cp_real(9,krm3(id),ksl(1,iad+nsrem))
            ENDDO
           ENDDO
           ENDIF !(J>0)
          ENDDO
         ENDIF
         DEALLOCATE(knm3)
         IF (irot>0) DEALLOCATE(krm3)
C
       ENDDO
C------Rigid bodies-------
       DO i=nrb_fr,1,-1
        m=ifrsr(1,i)
        ns=ifrsr(2,i)
        IF (inloc(ns)>nsl) THEN
          nss = inloc(ns)-nsl
          nr=iad_slnr(nss+1)- iad_slnr(nss)
          CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
             IF (j>0) THEN
         DO is = 1,nsrem
          iad = iad_m(nss) + j + is -2
          CALL cp_real(9,ksl(1,iad),ksm)
          CALL rby_frk(ns   ,m    ,x     ,itab ,ikc  ,
     1                ndof  ,iddl ,iddlm,ibid ,ibid ,
     2                rbid  ,rbid ,rbid ,a    ,rbid ,
     3                ksm   ,knm  ,krm  ,ibid,ifss,ifsm)
          CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),m,j)
          iad = iad_m(nss) + j + is -2
          CALL cp_real(9,knm,ksl(1,iad))
          CALL cp_real(9,krm,ksl(1,iad+nsrem))
         END DO ! IS = 1,NSREM
             END IF !(J>0) THEN
        ELSE
         nss = inloc(ns)
         DO is = 1,nsrem
          nr =iad_sinr(is+1)- iad_sinr(is)
          CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
          IF (j>0) THEN
          DO nf = 1,max(1,nf_si(is))
C----------------in KFR_SI------
           IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
            n = 0
            CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n    ,is  ,
     1                   j    ,ikc_si(is),ndof  ,iad  )
            iad = iad + nf-1
            CALL cp_real(9,ksi(1,iad),ksm)
           ELSE
            id = iddl_si(is)
            nm = jdi_sinr(j+iad_sinr(is)-1)
            jd = iddli(nm)
            CALL getfr_kij(id    ,jd   ,iad_si ,jdi_si,lt_si  ,
     1                     ksm   ,nd   ,nd    )
           ENDIF
           CALL rby_frk(ns   ,m    ,x     ,itab ,ikc  ,
     1                ndof  ,iddl ,iddlm,ibid ,ibid ,
     2                rbid  ,rbid ,rbid ,a    ,rbid ,
     3                ksm   ,knm  ,krm  ,ibid,ifss,ifsm)
           nr=iad_slnr(nss+1)- iad_slnr(nss)
           CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),m,j)
           iad = iad_m(nss) + j + is - 2
           CALL cp_real(9,knm,ksl(1,iad))
           CALL cp_real(9,krm,ksl(1,iad+nsrem))
          ENDDO
          ENDIF
         ENDDO
        ENDIF
       ENDDO
C
      DO i1 = 1,nbc_fr
        ns = ibc_fr(1,i1)
        isk= ibc_fr(2,i1)
        ict= ibc_fr(3,i1)
        IF (inloc(ns)>nsl) THEN
          nss = inloc(ns)-nsl
          nr=iad_slnr(nss+1)- iad_slnr(nss)
          CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
             IF (j>0) THEN
         DO is = 1,nsrem
          iad = iad_m(nss) + j + is -2
          CALL cp_real(9,ksl(1,iad),ksm)
          CALL bcl_frk(ns     ,iddl  ,iddlm  ,ict  ,isk   ,
     1                 skew   ,ikc   ,ibid  ,ibid  ,rbid  ,
     2                 rbid   ,rbid  ,a     ,rbid  ,ksm   ,
     3                 ibid   ,ifss  ,ifsm  )
          CALL cp_real(9,knm,ksl(1,iad))
         END DO ! IS = 1,NSREM
             END IF !(J>0) THEN
        ELSE
         nss = inloc(ns)
         DO is = 1,nsrem
          nr =iad_sinr(is+1)- iad_sinr(is)
          CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
          IF (j>0) THEN
          DO nf = 1,max(1,nf_si(is))
C----------------in KFR_SI------
           IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
            n = 0
            CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n    ,is  ,
     1                   j    ,ikc_si(is),ndof  ,iad  )
            iad = iad + nf-1
            CALL cp_real(9,ksi(1,iad),ksm)
           ELSE
            id = iddl_si(is)
            nm = jdi_sinr(iad_sinr(is)+j-1)
            jd = iddli(nm)
            CALL getfr_kij( id    ,jd   ,iad_si ,jdi_si,lt_si  ,
     1                     ksm   ,nd   ,nd    )
           ENDIF
           CALL bcl_frk(ns    ,iddl  ,iddlm ,ict   ,isk   ,
     1                 skew   ,ikc   ,ibid  ,ibid  ,rbid  ,
     2                 rbid   ,rbid  ,a     ,rbid  ,ksm   ,
     3                 ibid   ,ifss  ,ifsm  )
C--------------!!!!!!!!! still--in KFR_SI--!!!!!!----
           IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
            CALL cp_real(9,knm,ksi(1,iad))
           ELSE
            iad = iad_m(nss) + is -1
            CALL cp_real(9,knm,ksl(1,iad))
           ENDIF
          ENDDO
          ENDIF
         ENDDO
        ENDIF
      ENDDO
C
      DO i1 = 1,nspc_fr
        n = ispc_fr(i1)
        ns = in_spc(n)
            iadr = 6*(n-1)+1
            nn = ic_spc(n)
        IF (inloc(ns)>nsl) THEN
          nss = inloc(ns)-nsl
          nr=iad_slnr(nss+1)- iad_slnr(nss)
          CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
             IF (j>0) THEN
         DO is = 1,nsrem
          iad = iad_m(nss) + j + is -2
          CALL cp_real(9,ksl(1,iad),ksm)
          CALL bc_updfr(ns    ,iddl  ,skew_spc(iadr),ji    ,iddlm  ,
     1                  ikc   ,ibid  ,ibid  ,rbid  ,rbid   ,
     2                  rbid  ,a     ,rbid  ,ksm   ,ibid   ,
     3                  ifss  ,ifsm  )
              IF (nn==1) THEN
               ej(1)=skew_spc(iadr)
               ej(2)=skew_spc(iadr+1)
               ej(3)=skew_spc(iadr+2)
           CALL l_dir(ej,ji)
           CALL bc_updfr(i     ,iddl  ,ej     ,ji    ,iddlm  ,
     1                   ikc   ,ibid  ,ibid  ,rbid  ,rbid   ,
     2                   rbid  ,a     ,rbid  ,ksm   ,ibid   ,
     3                   ifss  ,ifsm  )
          ELSE
           CALL bc_updfr2(i     ,iddl  ,skew_spc(iadr),skew_spc(iadr+3),
     1                   iddlm  ,ibid  ,ibid  ,ibid  ,rbid   ,rbid   ,
     2                   rbid  ,a     ,rbid  ,ksm   ,ibid   ,
     3                   ifss  ,ifsm  )
              END IF
          CALL cp_real(9,knm,ksl(1,iad))
         END DO ! IS = 1,NSREM
             END IF !(J>0) THEN
        ELSE
         nss = inloc(ns)
         DO is = 1,nsrem
          nr =iad_sinr(is+1)- iad_sinr(is)
          CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
          IF (j>0) THEN
          DO nf = 1,max(1,nf_si(is))
C----------------in KFR_SI------
           IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
            n = 0
            CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n    ,is  ,
     1                   j    ,ikc_si(is),ndof  ,iad  )
            iad = iad + nf-1
            CALL cp_real(9,ksi(1,iad),ksm)
           ELSE
            id = iddl_si(is)
            nm = jdi_sinr(iad_sinr(is)+j-1)
            jd = iddli(nm)
            CALL getfr_kij( id    ,jd   ,iad_si ,jdi_si,lt_si  ,
     1                     ksm   ,nd   ,nd    )
           ENDIF
               IF (nn==1) THEN
                ej(1)=skew_spc(iadr)
                ej(2)=skew_spc(iadr+1)
                ej(3)=skew_spc(iadr+2)
           CALL l_dir(ej,ji)
           CALL bc_updfr(i     ,iddl  ,ej     ,ji    ,iddlm  ,
     1                   ikc   ,ibid  ,ibid  ,rbid  ,rbid   ,
     2                   rbid  ,a     ,rbid  ,ksm   ,ibid   ,
     3                   ifss  ,ifsm  )
           ELSE
           CALL bc_updfr2(i     ,iddl  ,skew_spc(iadr),skew_spc(iadr+3),
     1                   iddlm  ,ibid  ,ibid  ,ibid  ,rbid   ,rbid   ,
     2                   rbid  ,a     ,rbid  ,ksm   ,ibid   ,
     3                   ifss  ,ifsm  )
               END IF
C--------------!!!!!!!!! still--in KFR_SI--!!!!!!----
           IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
            CALL cp_real(9,knm,ksi(1,iad))
           ELSE
            iad = iad_m(nss) + is -1
            CALL cp_real(9,knm,ksl(1,iad))
           ENDIF
          ENDDO
          ENDIF
         ENDDO
        ENDIF
      ENDDO
C
      IF (nfx_fr>0) THEN
       DO l=1,nfx_fr
        i = ifx_fr(1,l)
        j1 = ifx_fr(2,l)
        ns=iabs(ibfv(1,i))
        IF (inloc(ns)>nsl) THEN
          nss = inloc(ns)-nsl
          nr=iad_slnr(nss+1)- iad_slnr(nss)
          CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
             IF (j>0) THEN
         DO is = 1,nsrem
          iad = iad_m(nss) + j + is -2
          CALL cp_real(9,ksl(1,iad),ksm)
          CALL fvl_frk(j1      ,i      ,ibfv  ,skew    ,xframe,
     1                 iddl    ,iddlm  ,ikc   ,ibid    ,ibid  ,
     2                 rbid    ,rbid   ,ud    ,rbid    ,a     ,
     3                 rbid    ,ksm    ,ibid  ,ifss    ,ifsm  )
          CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
          iad = iad_m(nss) + j + is -2
          CALL cp_real(9,knm,ksl(1,iad))
          CALL cp_real(9,krm,ksl(1,iad+nsrem))
         END DO ! IS = 1,NSREM
             END IF !(J>0) THEN
        ELSE
         nss = inloc(ns)
         DO is = 1,nsrem
          nr =iad_sinr(is+1)- iad_sinr(is)
          CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
          IF (j>0) THEN
          DO nf = 1,max(1,nf_si(is))
C----------------in KFR_SI------
           IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
            n = 0
            CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n    ,is  ,
     1                   j    ,ikc_si(is),ndof  ,iad  )
            iad = iad + nf-1
            CALL cp_real(9,ksi(1,iad),ksm)
           ELSE
            id = iddl_si(is)
            nm = jdi_sinr(iad_sinr(is)+j-1)
            jd = iddli(nm)
            CALL getfr_kij( id    ,jd   ,iad_si ,jdi_si,lt_si  ,
     1                     ksm   ,nd   ,nd    )
           ENDIF
           CALL fvl_frk(j1     ,i      ,ibfv  ,skew    ,xframe,
     1                 iddl    ,iddlm  ,ikc   ,ibid    ,ibid  ,
     2                 rbid    ,rbid   ,ud    ,rbid    ,a     ,
     3                 rbid    ,ksm    ,ibid  ,ifss    ,ifsm  )
C--------------!!!!!!!!! still--in KFR_SI--!!!!!!----
           IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
            CALL cp_real(9,knm,ksi(1,iad))
           ELSE
            iad = iad_m(nss) + is -1
            CALL cp_real(9,knm,ksl(1,iad))
           ENDIF
          ENDDO
          ENDIF
         ENDDO
        ENDIF
       ENDDO
      ENDIF
C
      DO l = 1,nrw_fr
        i = irw_fr(l)
        ns=in_rwl(i)
        ej(1)=nor_rwl(1,i)
        ej(2)=nor_rwl(2,i)
        ej(3)=nor_rwl(3,i)
        CALL l_dir(ej,j1)
        IF (inloc(ns)>nsl) THEN
          nss = inloc(ns)-nsl
          nr=iad_slnr(nss+1)- iad_slnr(nss)
          CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
             IF (j>0) THEN
         DO is = 1,nsrem
          iad = iad_m(nss) + j + is -2
          CALL cp_real(9,ksl(1,iad),ksm)
          CALL fv_updfr(ns   ,ej    ,j1    ,iddl  ,iddlm  ,
     1                 ikc   ,ibid  ,ibid  ,rbid  ,rbid    ,
     2                 ud    ,rbid  ,a     ,rbid  ,ksm     ,
     3                 ibid  ,ifss  ,ifsm  )
          CALL intabfr(nr,jdi_slnr(iad_slnr(nss)),ns,j)
          iad = iad_m(nss) + j + is -2
          CALL cp_real(9,knm,ksl(1,iad))
          CALL cp_real(9,krm,ksl(1,iad+nsrem))
         END DO ! IS = 1,NSREM
             END IF !(J>0) THEN
        ELSE
         nss = inloc(ns)
         DO is = 1,nsrem
          nr =iad_sinr(is+1)- iad_sinr(is)
          CALL intabfr(nr,jdi_sinr(iad_sinr(is)),ns,j)
          IF (j>0) THEN
          DO nf = 1,max(1,nf_si(is))
C----------------in KFR_SI------
           IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
            n = 0
            CALL get_iad(iad_m1,iad_sinr,jdi_sinr,n    ,is  ,
     1                   j    ,ikc_si(is),ndof  ,iad  )
            iad = iad + nf-1
            CALL cp_real(9,ksi(1,iad),ksm)
           ELSE
            id = iddl_si(is)
            nm = jdi_sinr(iad_sinr(is)+j-1)
            jd = iddli(nm)
            CALL getfr_kij( id    ,jd   ,iad_si ,jdi_si,lt_si  ,
     1                     ksm   ,nd   ,nd    )
           ENDIF
           CALL fv_updfr(ns   ,ej    ,j1    ,iddl  ,iddlm  ,
     1                 ikc   ,ibid  ,ibid  ,rbid  ,rbid    ,
     2                 ud    ,rbid  ,a     ,rbid  ,ksm     ,
     3                 ibid  ,ifss  ,ifsm  )
C--------------!!!!!!!!! still--in KFR_SI--!!!!!!----
           IF (ikc_si(is)>0.AND.nf_si(is)>0) THEN
            CALL cp_real(9,knm,ksi(1,iad))
           ELSE
            iad = iad_m(nss) +  is -1
            CALL cp_real(9,knm,ksl(1,iad))
           ENDIF
          ENDDO
          ENDIF
         ENDDO
        ENDIF
      ENDDO
C--------------------------------------------
C
      RETURN

upd_ksl()

subroutine upd_ksl	(	integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer	nint2,
		integer, dimension(*)	iint2,
		integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	lpby,
		integer, dimension(*)	itab,
		integer	nrbyac,
		integer, dimension(*)	irbyac,
			x,
		integer, dimension(nifv,*)	ibfv,
		integer, dimension(*)	lj,
			skew,
			xframe,
		integer, dimension(*)	iskew,
		integer, dimension(*)	icodt,
		integer, dimension(*)	inloc,
		integer	nsl,
		integer, dimension(*)	iad_m,
		integer, dimension(*)	iddl,
		integer, dimension(*)	ikc,
		integer, dimension(*)	ndof,
		integer, dimension(*)	iddlm,
			ud,
			a,
			b,
			kss,
			ksl_fr,
			ksi_fr,
		integer, dimension(nrbe3l,*)	irbe3,
		integer, dimension(*)	lrbe3,
			frbe3,
		integer, dimension(nrbe2l,*)	irbe2,
		integer, dimension(*)	lrbe2 )

Definition at line 5747 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_intm
      USE imp_rwl
      USE imp_aspc
      USE intbufdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "tabsiz_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IBFV(NIFV,*),IPARI(NPARI,*),NSL,IAD_M(*)
      INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
     .        NINT2,IINT2(*),IDDL(*),IKC(*),NDOF(*),INLOC(*),
     .        LJ(*),ISKEW(*),ICODT(*),IDDLM(*),IRBE3(NRBE3L,*),
     .        LRBE3(*),IRBE2(NRBE2L,*),LRBE2(*)
C     REAL
      my_real
     .       x(3,*),skew(lskew,*),xframe(*),frbe3(*)
      my_real
     .   ud(3,*),a(3,*),b(*) ,kss(6,*),ksl_fr(9,*) ,ksi_fr(9,*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,K,M,NS,NI,NSN,ILEV,IAD_M1(NSL+1),IS,
     .        JI,L,NNOD,NJ,ND,NL,ISK,IFM,J1,NM,ID,IAD0,IAD,IADS,
     .        I1,ICT,IFSS,IFSM,IDM(4),NR,JT(3),JR(3),IROT,
     .        IDLM(SLRBE3/2),IADR,NN,IRAD,IC,EID
      my_real
     .  ej(3),ksm(9),knm(9,4),krm(9,4)
C----4 no more sufficient for RBE3: alloc dynamic only for IFSM=1
      my_real,
     .         DIMENSION(:),ALLOCATABLE :: knm3,krm3
C----------Kss d'abord------------------------------
       ifss =1
       ifsm=0
       iad_m1(1) = 1
       DO n=1,nsl
        nl =0
        IF (ikc_sl(n)>0) THEN
         nr = iad_slnr(n+1)-iad_slnr(n)
         nl = max(1,nr)
        ENDIF
        iad_m1(n+1) = iad_m1(n)+nl
       ENDDO
C------int2----------------------------------
       DO i=ni2_fr,1,-1
        n=ifrs2(1,i)
        ni=ifrs2(2,i)
         ji=ipari(1,n)
         nsn=ipari(5,n)
         l=intbuf_tab(n)%IRTLM(ni)
         nl=4*(l-1)
         IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
          nnod=3
         ELSE
          nnod=4
         ENDIF
         ilev  =ipari(20,n)
C
        DO is = 1,nsl
         IF (isl(is)==ns) THEN
          nr = iad_slnr(is+1)-iad_slnr(is)
          DO k =1,nnod
           nj=intbuf_tab(n)%IRECTM(nl+k)
           CALL intabfr(nr,jdi_slnr(iad_slnr(is)),nj,j)
           IF (j>0) THEN
            idm(k) = iddl_sl(iad_m1(is)+j-1)
           ELSE
           ENDIF
          ENDDO
          IF (ilev==1) THEN
           CALL i2_frk1(intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA,x  ,itab ,
     .                  intbuf_tab(n)%NSV,
     1                  intbuf_tab(n)%IRTLM,ikc  ,ndof  ,iddl ,iddlm,
     2                  iad_ss ,jdi_sl ,diag_sl,lt_sl ,b    ,a      ,
     3                  kss(1,is),ksm  ,knm   ,krm  ,ni    ,
     4                  idm    ,ifss   ,ifsm   )
          ELSE
           CALL i2_frk0(intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS,x    ,itab ,
     .                  intbuf_tab(n)%NSV,
     1                  intbuf_tab(n)%IRTLM,ikc  ,ndof  ,iddl ,iddlm,
     2                  iad_ss ,jdi_sl ,diag_sl,lt_sl ,b    ,a      ,
     3                  kss(1,is),ksm  ,knm   ,krm  ,ni    ,
     4                  idm    ,ifss   ,ifsm   )
          ENDIF
         ENDIF
        ENDDO
       ENDDO
C------RBE2-------
       DO i=nrbe2_fr,1,-1
        n=ifrs4(1,i)
        m=irbe2(3,n)
        ns=ifrs4(2,i)
        isk = irbe2(7,n)
            irad =irbe2(11,n)
        ic = irbe2(4,n)
C--------remove ICR---
        ic =(ic/512)*512
        DO is = 1,nsl
         IF (isl(is)==ns) THEN
          nr = iad_slnr(is+1)-iad_slnr(is)
          CALL intabfr(nr,jdi_slnr(iad_slnr(is)),m ,j)
           IF (j>0) THEN
            idm(1) = iddl_sl(iad_m1(is)+j-1)
           ELSE
           ENDIF
          CALL prerbe2fr(ic    ,jt  ,jr   )
          CALL rbe2_frk(ns    ,m    ,x     ,isk  ,skew(1,isk) ,
     1                  irad  ,ndof  ,iddl ,jt   ,jr      ,
     2                  iad_ss,jdi_sl,diag_sl,lt_sl ,b    ,
     3                  a    ,kss(1,is),ksm   ,knm   ,krm  ,
     4                  idm(1),ifss,ifsm )
         ENDIF
        ENDDO
       ENDDO
C------RBE3----------------------------------
       DO i=1,nrbe3_fr
        n=ifrs3(i)
        iad=irbe3(1,n)
        ns=irbe3(3,n)
        nnod=irbe3(5,n)
        irot =irbe3(6,n)
        eid=irbe3(2,n)
        iads = slrbe3/2+iad
C
        CALL prerbe3fr(irbe3 ,n    ,jt  ,jr   )
        DO is = 1,nsl
         IF (isl(is)==ns) THEN
          nr = iad_slnr(is+1)-iad_slnr(is)
          DO k =1,nnod
           nj = lrbe3(iad+k)
           CALL intabfr(nr,jdi_slnr(iad_slnr(is)),nj,j)
           IF (j>0) THEN
            idlm(k) = iddl_sl(iad_m1(is)+j-1)
           ELSE
           ENDIF
          ENDDO
          CALL rbe3_fr0(ns    ,nnod  ,lrbe3(iad+1)  ,x     ,irot   ,
     2                  jt    ,jr    ,frbe3(6*iad+1)  ,skew  ,ikc   ,
     3                  ndof  ,iad_ss ,jdi_sl ,diag_sl,lt_sl ,
     2                  kss(1,is),ksm    ,knm  ,krm    ,idlm  ,
     3                  ifss   ,ifsm    ,itab  ,lrbe3(iads+1),eid)
         ENDIF
        ENDDO
       ENDDO
C------Rigid bodies-------
       DO i=nrb_fr,1,-1
        m=ifrsr(1,i)
        ns=ifrsr(2,i)
        DO is = 1,nsl
         IF (isl(is)==ns) THEN
          nr = iad_slnr(is+1)-iad_slnr(is)
          CALL intabfr(nr,jdi_slnr(iad_slnr(is)),m ,j)
           IF (j>0) THEN
            idm(1) = iddl_sl(iad_m1(is)+j-1)
           ELSE
           ENDIF
          CALL rby_frk(ns   ,m    ,x     ,itab ,ikc  ,
     1                ndof  ,iddl ,iddlm,iad_ss,jdi_sl,
     2                diag_sl,lt_sl ,b    ,a    ,kss(1,is),
     3                ksm   ,knm   ,krm  ,idm(1),ifss,ifsm )
         ENDIF
        ENDDO
       ENDDO
C
      DO i1 = 1,nbc_fr
        n = ibc_fr(1,i1)
        isk= ibc_fr(2,i1)
        ict= ibc_fr(3,i1)
        DO is = 1,nsl
         IF (isl(is)==n) THEN
          nr = iad_slnr(is+1)-iad_slnr(is)
          IF (nr>0) THEN
           CALL intabfr(nr,jdi_slnr(iad_slnr(is)),n ,j)
            idm(1) = iddl_sl(iad_m1(is)+j-1)
          ELSE
            idm(1) = iddl_sl(iad_m1(is))
          ENDIF
          CALL bcl_frk(n      ,iddl  ,iddlm  ,ict  ,isk   ,
     1                 skew   ,ikc   ,iad_ss,jdi_sl,diag_sl,
     2                 lt_sl  ,b     ,a     ,kss(1,is),ksm   ,
     3                 idm(1) ,ifss  ,ifsm )
        ENDIF
       ENDDO
      ENDDO
C
      DO i1 = 1,nspc_fr
        n = ispc_fr(i1)
        i = in_spc(n)
            iad = 6*(n-1)+1
            nn = ic_spc(n)
        DO is = 1,nsl
         IF (isl(is)==i) THEN
          nr = iad_slnr(is+1)-iad_slnr(is)
          IF (nr>0) THEN
           CALL intabfr(nr,jdi_slnr(iad_slnr(is)),i ,j)
            idm(1) = iddl_sl(iad_m1(is)+j-1)
          ELSE
            idm(1) = iddl_sl(iad_m1(is))
          ENDIF
              IF (nn==1) THEN
               ej(1)=skew_spc(iad)
               ej(2)=skew_spc(iad+1)
               ej(3)=skew_spc(iad+2)
           CALL l_dir(ej,j)
           CALL bc_updfr(i     ,iddl  ,ej     ,j     ,iddlm  ,
     1                   ikc   ,iad_ss,jdi_sl,diag_sl,lt_sl ,
     2                   b     ,a     ,kss(1,is),ksm   ,idm(1),
     3                   ifss  ,ifsm  )
          ELSE
           CALL bc_updfr2(i     ,iddl  ,skew_spc(iad),skew_spc(iad+3),
     1                   iddlm  ,ikc   ,iad_ss,jdi_sl,diag_sl,lt_sl ,
     2                   b     ,a     ,kss(1,is),ksm   ,idm(1),
     3                   ifss  ,ifsm  )
              END IF
        ENDIF
       ENDDO
      ENDDO
C
      IF (nfx_fr>0) THEN
       DO l=1,nfx_fr
        i = ifx_fr(1,l)
        j1 = ifx_fr(2,l)
        n=iabs(ibfv(1,i))
        DO is = 1,nsl
         IF (isl(is)==n) THEN
          nr = iad_slnr(is+1)-iad_slnr(is)
          IF (nr>0) THEN
           CALL intabfr(nr,jdi_slnr(iad_slnr(is)),n ,j)
            idm(1) = iddl_sl(iad_m1(is)+j-1)
          ELSE
            idm(1) = iddl_sl(iad_m1(is))
          ENDIF
          CALL fvl_frk(j1     ,i      ,ibfv  ,skew    ,xframe,
     1                 iddl    ,iddlm  ,ikc   ,iad_ss  ,jdi_sl,
     2                 diag_sl ,lt_sl ,ud    ,b      ,a     ,
     3                 kss(1,is),ksm   ,idm(1) ,ifss  ,ifsm  )
         ENDIF
        ENDDO
       ENDDO
      ENDIF
C
      DO l = 1,nrw_fr
        i = irw_fr(l)
        n=in_rwl(i)
        ej(1)=nor_rwl(1,i)
        ej(2)=nor_rwl(2,i)
        ej(3)=nor_rwl(3,i)
        CALL l_dir(ej,j1)
        DO is = 1,nsl
         IF (isl(is)==n) THEN
          nr = iad_slnr(is+1)-iad_slnr(is)
          IF (nr>0) THEN
           CALL intabfr(nr,jdi_slnr(iad_slnr(is)),n ,j)
            idm(1) = iddl_sl(iad_m1(is)+j-1)
          ELSE
            idm(1) = iddl_sl(iad_m1(is))
          ENDIF
          CALL fv_updfr(n     ,ej    ,j1    ,iddl  ,iddlm    ,
     1                 ikc    ,iad_ss,jdi_sl,diag_sl,lt_sl   ,
     2                 ud     ,b     ,a     ,kss(1,is),ksm   ,
     3                 idm(1) ,ifss  ,ifsm)
        ENDIF
        ENDDO
      ENDDO
C----------Ksm ------------------------------
       ifss = 0
       ifsm = 1
       iad_m1(1) = 0
       DO n=1,nsl
        iad_m1(n+1) = iad_m1(n)+ikc_sl(n)
       ENDDO
C------copy KSL_FR to KSI_FR-(for kin without modification-----
       DO i = 1,nsl
         ns = isl(i)
         DO j = 1,ikc_sl(i)
           iad = iad_m1(i)+j
           CALL cp_real(9,ksl_fr(1,iad),ksm)
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,ns   ,i  ,
     1                  j     ,ikc_sl(i),ndof ,iad   )
           IF (iad>0) CALL cp_real(9,ksm,ksi_fr(1,iad))
         ENDDO
       ENDDO
C
       DO i=ni2_fr,1,-1
        n=ifrs2(1,i)
        ni=ifrs2(2,i)
         ji=ipari(1,n)
         nsn=ipari(5,n)
         l=intbuf_tab(n)%IRTLM(ni)
         nl=4*(l-1)
         IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
          nnod=3
         ELSE
          nnod=4
         ENDIF
         ilev  =ipari(20,n)
C
        DO is = 1,nsl
         IF (isl(is)==ns) THEN
         DO j = 1,ikc_sl(is)
C----------------int2 herarch-------
          IF (inloc(ns)>nsl) THEN
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,ns   ,is  ,
     1                   j     ,ikc_sl(is),ndof ,iad   )
           CALL cp_real(9,ksi_fr(1,iad),ksm)
          ELSE
           iad = iad_m1(is)+j
           CALL cp_real(9,ksl_fr(1,iad),ksm)
          ENDIF
          IF (ilev==1) THEN
           CALL i2_frk1(intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA,x  ,itab ,
     .                  intbuf_tab(n)%NSV,
     1                  intbuf_tab(n)%IRTLM,ikc  ,ndof  ,iddl ,iddlm,
     2                  iad_ss ,jdi_sl ,diag_sl,lt_sl ,b    ,a      ,
     3                  kss(1,is),ksm  ,knm   ,krm  ,ni    ,
     4                  idm    ,ifss   ,ifsm   )
          ELSE
           CALL i2_frk0(intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS,x    ,itab ,
     .                  intbuf_tab(n)%NSV,
     1                  intbuf_tab(n)%IRTLM,ikc  ,ndof  ,iddl ,iddlm,
     2                  iad_ss ,jdi_sl ,diag_sl,lt_sl ,b    ,a      ,
     3                  kss(1,is),ksm  ,knm   ,krm  ,ni    ,
     4                  idm    ,ifss   ,ifsm   )
          ENDIF
          DO k =1,nnod
           nj=intbuf_tab(n)%IRECTM(nl+k)
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,nj   ,is  ,
     1                   j     ,ikc_sl(is),ndof ,iad   )
           CALL cp_real(9,knm(1,k),ksi_fr(1,iad))
           IF (ndof(nj)==6)CALL cp_real(9,krm(1,k),ksi_fr(1,iad+1))
          ENDDO
         ENDDO
         ENDIF
        ENDDO
       ENDDO
C------RBE2-------
       DO i=nrbe2_fr,1,-1
        n=ifrs4(1,i)
        m=irbe2(3,n)
        ns=ifrs4(2,i)
        isk = irbe2(7,n)
            irad =irbe2(11,n)
            ic =irbe2(4,n)
C--------remove ICR---
         ic =(ic/512)*512
        DO is = 1,nsl
         IF (isl(is)==ns) THEN
         DO j = 1,ikc_sl(is)
C----------------ns main int2 -------
          IF (inloc(ns)>nsl) THEN
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,ns   ,is  ,
     1                  j     ,ikc_sl(is),ndof ,iad   )
           CALL cp_real(9,ksi_fr(1,iad),ksm)
          ELSE
           iad = iad_m1(is)+j
           CALL cp_real(9,ksl_fr(1,iad),ksm)
          ENDIF
          CALL prerbe2fr(ic    ,jt  ,jr   )
          CALL rbe2_frk(ns    ,m    ,x     ,isk  ,skew(1,isk) ,
     1                  irad  ,ndof  ,iddl ,jt   ,jr      ,
     2                  iad_ss,jdi_sl,diag_sl,lt_sl ,b    ,
     3                  a    ,kss(1,is),ksm   ,knm   ,krm  ,
     4                  idm(1),ifss,ifsm )
          CALL get_iad(iad_m ,iad_slnr,jdi_slnr,m    ,is  ,
     1                 j     ,ikc_sl(is),ndof ,iad   )
           CALL cp_real(9,knm,ksi_fr(1,iad))
           CALL cp_real(9,krm,ksi_fr(1,iad+1))
         ENDDO
         ENDIF
        ENDDO
       ENDDO
C ------RBE3
       DO i=1,nrbe3_fr
        n=ifrs3(i)
        iadr=irbe3(1,n)
        ns=irbe3(3,n)
        nnod=irbe3(5,n)
        irot =irbe3(6,n)
        eid=irbe3(2,n)
        iads = slrbe3/2+iadr
        CALL prerbe3fr(irbe3 ,n    ,jt  ,jr   )
        ALLOCATE(knm3(9*nnod))
        IF (irot>0) ALLOCATE(krm3(9*nnod))
C
        DO is = 1,nsl
         IF (isl(is)==ns) THEN
         DO j = 1,ikc_sl(is)
C----------------int2 herarch-------
          IF (inloc(ns)>nsl) THEN
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,ns   ,is  ,
     1                   j     ,ikc_sl(is),ndof ,iad   )
           CALL cp_real(9,ksi_fr(1,iad),ksm)
          ELSE
           iad = iad_m1(is)+j
           CALL cp_real(9,ksl_fr(1,iad),ksm)
          ENDIF
          CALL rbe3_fr0(ns    ,nnod  ,lrbe3(iadr+1)  ,x     ,irot   ,
     2                  jt    ,jr    ,frbe3(6*iadr+1)  ,skew  ,ikc   ,
     3                  ndof  ,iad_ss ,jdi_sl ,diag_sl,lt_sl ,
     2                  kss(1,is),ksm    ,knm3 ,krm3   ,idlm  ,
     3                  ifss   ,ifsm    ,itab  ,lrbe3(iads+1),eid)
          DO k =1,nnod
           nj = lrbe3(iadr+k)
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,nj   ,is  ,
     1                   j     ,ikc_sl(is),ndof ,iad   )
           id = 9*(k-1) +1
           CALL cp_real(9,knm3(id),ksi_fr(1,iad))
           IF (irot>0.AND.ndof(nj)==6)
     +           CALL cp_real(9,krm3(id),ksi_fr(1,iad+1))
          ENDDO
         ENDDO
         ENDIF
        ENDDO
         DEALLOCATE(knm3)
         IF (irot>0) DEALLOCATE(krm3)
       ENDDO
C------Rigid bodies-------
       DO i=nrb_fr,1,-1
        m=ifrsr(1,i)
        ns=ifrsr(2,i)
        DO is = 1,nsl
         IF (isl(is)==ns) THEN
         DO j = 1,ikc_sl(is)
C----------------ns main int2 -------
          IF (inloc(ns)>nsl) THEN
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,ns   ,is  ,
     1                  j     ,ikc_sl(is),ndof ,iad   )
           CALL cp_real(9,ksi_fr(1,iad),ksm)
          ELSE
           iad = iad_m1(is)+j
           CALL cp_real(9,ksl_fr(1,iad),ksm)
          ENDIF
          CALL rby_frk(ns   ,m    ,x     ,itab ,ikc  ,
     1                ndof  ,iddl ,iddlm,iad_ss,jdi_sl,
     2                diag_sl,lt_sl ,b    ,a    ,kss(1,is),
     3                ksm   ,knm   ,krm  ,idm(1),ifss,ifsm )
          CALL get_iad(iad_m ,iad_slnr,jdi_slnr,m    ,is  ,
     1                 j     ,ikc_sl(is),ndof ,iad   )
           CALL cp_real(9,knm,ksi_fr(1,iad))
           CALL cp_real(9,krm,ksi_fr(1,iad+1))
         ENDDO
         ENDIF
        ENDDO
       ENDDO
C
      DO i1 = 1,nbc_fr
        n = ibc_fr(1,i1)
        isk= ibc_fr(2,i1)
        ict= ibc_fr(3,i1)
        DO is = 1,nsl
         IF (isl(is)==n) THEN
         DO j = 1,ikc_sl(is)
          IF (inloc(n)>nsl) THEN
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,n    ,is  ,
     1                  j     ,ikc_sl(is),ndof ,iad   )
           CALL cp_real(9,ksi_fr(1,iad),ksm)
          ELSE
           iad = iad_m1(is)+j
           CALL cp_real(9,ksl_fr(1,iad),ksm)
          ENDIF
          CALL bcl_frk(n      ,iddl  ,iddlm  ,ict  ,isk   ,
     1                 skew   ,ikc   ,iad_ss,jdi_sl,diag_sl,
     2                 lt_sl  ,b     ,a     ,kss(1,is),ksm   ,
     3                 idm(1) ,ifss  ,ifsm )
          IF (inloc(n)<=nsl) THEN
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,n    ,is  ,
     1                  j     ,ikc_sl(is),ndof ,iad   )
          ENDIF
          CALL cp_real(9,ksm,ksi_fr(1,iad))
        ENDDO
        ENDIF
       ENDDO
      ENDDO
C
      DO i1 = 1,nspc_fr
        n = ispc_fr(i1)
        i = in_spc(n)
            iadr = 6*(n-1)+1
            nn = ic_spc(n)
        DO is = 1,nsl
         IF (isl(is)==i) THEN
         DO j = 1,ikc_sl(is)
          IF (inloc(i)>nsl) THEN
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,i    ,is  ,
     1                  j     ,ikc_sl(is),ndof ,iad   )
           CALL cp_real(9,ksi_fr(1,iad),ksm)
          ELSE
           iad = iad_m1(is)+j
           CALL cp_real(9,ksl_fr(1,iad),ksm)
          ENDIF
              IF (nn==1) THEN
               ej(1)=skew_spc(iadr)
               ej(2)=skew_spc(iadr+1)
               ej(3)=skew_spc(iadr+2)
           CALL l_dir(ej,ji)
           CALL bc_updfr(i     ,iddl  ,ej     ,ji    ,iddlm  ,
     1                   ikc   ,iad_ss,jdi_sl,diag_sl,lt_sl ,
     2                   b     ,a     ,kss(1,is),ksm   ,idm(1),
     3                   ifss  ,ifsm  )
          ELSE
           CALL bc_updfr2(i     ,iddl  ,skew_spc(iadr),skew_spc(iadr+3),
     1                   iddlm  ,ikc   ,iad_ss,jdi_sl,diag_sl,lt_sl ,
     2                   b     ,a     ,kss(1,is),ksm   ,idm(1),
     3                   ifss  ,ifsm  )
              END IF
          IF (inloc(i)<=nsl) THEN
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,i    ,is  ,
     1                  j     ,ikc_sl(is),ndof ,iad   )
          ENDIF
          CALL cp_real(9,ksm,ksi_fr(1,iad))
        ENDDO
        ENDIF
       ENDDO
      ENDDO
C
      IF (nfx_fr>0) THEN
       DO l=1,nfx_fr
        i = ifx_fr(1,l)
        j1 = ifx_fr(2,l)
        n=iabs(ibfv(1,i))
        DO is = 1,nsl
         IF (isl(is)==n) THEN
         DO j = 1,ikc_sl(is)
          IF (inloc(n)>nsl) THEN
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,n    ,is  ,
     1                  j     ,ikc_sl(is),ndof ,iad   )
           CALL cp_real(9,ksi_fr(1,iad),ksm)
          ELSE
           iad = iad_m1(is)+j
           CALL cp_real(9,ksl_fr(1,iad),ksm)
          ENDIF
          CALL fvl_frk(j1     ,i      ,ibfv  ,skew    ,xframe,
     1                 iddl    ,iddlm  ,ikc   ,iad_ss  ,jdi_sl,
     2                 diag_sl ,lt_sl ,ud    ,b      ,a     ,
     3                 kss(1,is),ksm   ,idm  ,ifss  ,ifsm  )
          IF (inloc(n)<=nsl) THEN
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,n    ,is  ,
     1                  j     ,ikc_sl(is),ndof ,iad   )
          ENDIF
          CALL cp_real(9,ksm,ksi_fr(1,iad))
         ENDDO
         ENDIF
        ENDDO
       ENDDO
      ENDIF
C
      DO l = 1,nrw_fr
        i = irw_fr(l)
        n=in_rwl(i)
        ej(1)=nor_rwl(1,i)
        ej(2)=nor_rwl(2,i)
        ej(3)=nor_rwl(3,i)
        CALL l_dir(ej,j1)
        DO is = 1,nsl
         IF (isl(is)==n) THEN
         DO j = 1,ikc_sl(is)
          IF (inloc(n)>nsl) THEN
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,n    ,is  ,
     1                  j     ,ikc_sl(is),ndof ,iad   )
           CALL cp_real(9,ksi_fr(1,iad),ksm)
          ELSE
           iad = iad_m1(is)+j
           CALL cp_real(9,ksl_fr(1,iad),ksm)
          ENDIF
          CALL fv_updfr(n     ,ej    ,j1    ,iddl  ,iddlm    ,
     1                 ikc    ,iad_ss,jdi_sl,diag_sl,lt_sl   ,
     2                 ud     ,b     ,a     ,kss(1,is),ksm   ,
     3                 idm(1) ,ifss  ,ifsm)
          IF (inloc(n)<=nsl) THEN
           CALL get_iad(iad_m ,iad_slnr,jdi_slnr,n    ,is  ,
     1                  j     ,ikc_sl(is),ndof ,iad   )
          ENDIF
          CALL cp_real(9,ksm,ksi_fr(1,iad))
         ENDDO
         ENDIF
        ENDDO
      ENDDO
C--------------------------------------------
C
      RETURN

zero_ikin2g()

subroutine zero_ikin2g	(	integer	nkine,
		integer, dimension(*)	iloc )

Definition at line 4467 of file imp_fri.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_frk
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NKINE,ILOC(*),INK
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,N
C
      DO N =1,NKINE
       I=IKIN2G(N)
       ILOC(I)=0
      ENDDO
C
      RETURN