sinit3.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr03_c.inc"
#include "scr12_c.inc"
#include "scr17_c.inc"
#include "scry_c.inc"
#include "sphcom.inc"
#include "vect01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine

sinit3 (elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg_gr, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, sigsp, ng, iparg, nsigi, msnf, nvc, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, in, vr, ins, wma, ptsol, bufmat, mcp, mcps, temp, xrefs, npf, tf, mssa, strsglob, straglob, fail_ini, spbuf, kxsp, ipartsp, nod2sp, sol2sph, irst, iloadp, facload, rnoise, perturb, mat_param, glob_therm)

Function/Subroutine Documentation

sinit3()

subroutine sinit3	(	type(elbuf_struct_), target	elbuf_str,
			mas,
		integer, dimension(nixs,numels)	ixs,
			pm,
			x,
		type(detonators_struct_)	detonators,
			geo,
			veul,
		type(t_ale_connectivity), intent(inout)	ale_connectivity,
		integer, dimension(nparg)	iparg_gr,
			dtelem,
			sigi,
		integer	nel,
			skew,
		integer, dimension(npropgi,numgeo)	igeo,
			stifn,
			partsav,
			v,
		integer, dimension(*)	iparts,
			mss,
		integer, dimension(lipart1,*)	ipart,
			sigsp,
		integer	ng,
		integer, dimension(nparg,ngroup)	iparg,
		integer	nsigi,
			msnf,
		integer	nvc,
			mssf,
		integer, dimension(npropmi,nummat)	ipm,
		integer	iuser,
		integer	nsigs,
			volnod,
			bvolnod,
			vns,
			bns,
			in,
			vr,
			ins,
			wma,
		integer, dimension(*)	ptsol,
			bufmat,
			mcp,
			mcps,
			temp,
			xrefs,
		integer, dimension(*)	npf,
			tf,
			mssa,
		integer, dimension(*)	strsglob,
		integer, dimension(*)	straglob,
		integer, dimension(*)	fail_ini,
			spbuf,
		integer, dimension(nisp,*)	kxsp,
		integer, dimension(*)	ipartsp,
		integer, dimension(*)	nod2sp,
		integer, dimension(2,*)	sol2sph,
		integer, dimension(3,*)	irst,
		integer, dimension(sizloadp,*), intent(in)	iloadp,
		dimension(lfacload,*), intent(in)	facload,
			rnoise,
		integer, dimension(nperturb)	perturb,
		type (matparam_struct_), dimension(nummat), intent(inout)	mat_param,
		type (glob_therm_), intent(in)	glob_therm )

Definition at line 62 of file sinit3.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod            
      USE message_mod
      USE bpreload_mod
      USE detonators_mod
      USE ale_connectivity_mod
      USE alefvm_mod , only:alefvm_param
      USE matparam_def_mod
      USE names_and_titles_mod , ONLY : nchartitle
      use glob_therm_mod
      use element_mod , only : nixs
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"
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      "scr03_c.inc"
#include      "scr12_c.inc"
#include      "scr17_c.inc"
#include      "scry_c.inc"
#include      "sphcom.inc"
#include      "vect01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IXS(NIXS,NUMELS),IPARG(NPARG,NGROUP),
     .        IPARG_GR(NPARG),IPARTS(*),IGEO(NPROPGI,NUMGEO),
     .        IPM(NPROPMI,NUMMAT),IPART(LIPART1,*),PTSOL(*),
     .        NG,NSIGI ,NVC,NEL,IUSER, NSIGS, NPF(*),
     .        STRSGLOB(*),STRAGLOB(*),FAIL_INI(*), 
     .        KXSP(NISP,*), IPARTSP(*), NOD2SP(*), SOL2SPH(2,*), IRST(3,*),
     .        PERTURB(NPERTURB)
      my_real mas(*), pm(npropm,nummat), x(3,numnod),geo(npropg,numgeo),
     .        veul(lveul,*), dtelem(*),sigi(nsigs,*),skew(lskew,*),stifn(*),
     .        partsav(20,*), v(*), mss(8,*), 
     .        sigsp(nsigi,*),msnf(*), mssf(8,*), wma(*),
     .        volnod(*), bvolnod(*), vns(8,*), bns(8,*),
     .        in(*),vr(*), ins(8,*),bufmat(*),
     .        mcp(*), mcps(8,*), temp(*),
     .        xrefs(8,3,*), tf(*), mssa(*),
     .        spbuf(nspbuf,*),rnoise(nperturb,*)
      TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
      INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
      my_real,INTENT(IN) :: facload(lfacload,*)
      TYPE(DETONATORS_STRUCT_)::DETONATORS
      TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
      TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
      type (glob_therm_) ,intent(in)      :: glob_therm
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J, NF1, NCC, IBID, JHBE, IREP,IGTYP, NUVAR,NUVARR,IDEF,
     .        IR,IS,IT,IPT,LVLOC,IPID1,NPTR,NPTS,NPTT,NLAY,NDDIM, 
     .        NSPHDIR, NCELF, NCELL,L_PLA,L_SIGB,IBOLTP
      INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ),
     .   IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),
     .   IX5(MVSIZ),IX6(MVSIZ),IX7(MVSIZ),IX8(MVSIZ)
      my_real
     .   v8loc(51,mvsiz),volu(mvsiz),dtx(mvsiz),
     .   x1(mvsiz),x2(mvsiz),x3(mvsiz),x4(mvsiz),x5(mvsiz),x6(mvsiz),
     .   x7(mvsiz),x8(mvsiz),y1(mvsiz),y2(mvsiz),y3(mvsiz),y4(mvsiz),
     .   y5(mvsiz),y6(mvsiz),y7(mvsiz),y8(mvsiz),z1(mvsiz),z2(mvsiz),
     .   z3(mvsiz),z4(mvsiz),z5(mvsiz),z6(mvsiz),z7(mvsiz),z8(mvsiz),
     .   rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,sx(mvsiz) ,
     .   sy(mvsiz) ,sz(mvsiz) ,tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
     .   e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),
     .   e2x(mvsiz),e2y(mvsiz),e2z(mvsiz),
     .   e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
     .   f1x(mvsiz) ,f1y(mvsiz) ,f1z(mvsiz) ,
     .   f2x(mvsiz) ,f2y(mvsiz) ,f2z(mvsiz),rhocp(mvsiz),temp0(mvsiz),
     .   px1(mvsiz),px2(mvsiz),px3(mvsiz),px4(mvsiz),
     .   py1(mvsiz),py2(mvsiz),py3(mvsiz),py4(mvsiz),
     .   pz1(mvsiz),pz2(mvsiz),pz3(mvsiz),pz4(mvsiz),
     .   rhof(mvsiz),alpha(mvsiz), aire(mvsiz),rho0(mvsiz)
      my_real :: bid, fv, sti
      my_real :: deltax(mvsiz)
      DOUBLE PRECISION 
     .   XD1(MVSIZ), XD2(MVSIZ), XD3(MVSIZ), XD4(MVSIZ),
     .   XD5(MVSIZ), XD6(MVSIZ), XD7(MVSIZ), XD8(MVSIZ),
     .   YD1(MVSIZ), YD2(MVSIZ), YD3(MVSIZ), YD4(MVSIZ),
     .   YD5(MVSIZ), YD6(MVSIZ), YD7(MVSIZ), YD8(MVSIZ),
     .   ZD1(MVSIZ), ZD2(MVSIZ), ZD3(MVSIZ), ZD4(MVSIZ),
     .   ZD5(MVSIZ), ZD6(MVSIZ), ZD7(MVSIZ), ZD8(MVSIZ)     
      my_real :: tempel(nel)
C-----------------------------------------------
      CHARACTER(LEN=NCHARTITLE)::TITR1
C
      parameter(lvloc = 51)
C-----------------------------------------------
      TYPE(L_BUFEL_) ,POINTER :: LBUF     
      TYPE(G_BUFEL_) ,POINTER :: GBUF     
      TYPE(BUF_MAT_) ,POINTER :: MBUF
      TYPE(BUF_LAY_) ,POINTER :: BUFLY
      TYPE(BUF_FAIL_) ,POINTER:: FBUF
      my_real, DIMENSION(:), POINTER  :: uvarf    
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      gbuf  => elbuf_str%GBUF
      lbuf  => elbuf_str%BUFLY(1)%LBUF(1,1,1)
      mbuf  => elbuf_str%BUFLY(1)%MAT(1,1,1)
      fbuf  => elbuf_str%BUFLY(1)%FAIL(1,1,1)
      bufly => elbuf_str%BUFLY(1)
      nuvar =  elbuf_str%BUFLY(1)%NVAR_MAT
      nptr  =  elbuf_str%NPTR
      npts  =  elbuf_str%NPTS
      nptt  =  elbuf_str%NPTT
      nlay  =  elbuf_str%NLAY
      l_pla =  elbuf_str%BUFLY(1)%L_PLA
      l_sigb=  elbuf_str%BUFLY(1)%L_SIGB
c
      jhbe  = iparg_gr(23)
      irep  = iparg_gr(35)
      jcvt  = iparg_gr(37)
      igtyp = iparg_gr(38)
      IF (jcvt==1.AND.isorth/=0) jcvt=2
      idef  = 0   ! initialization flag for the total strain
      bid   = zero
      ibid = 0
      nddim = 0
      nf1=nft+1
      volu(1:nel)=zero
C
      iboltp = iparg_gr(72)  !Bolt preloading
C
      DO i=1,nel
        rhocp(i) =  pm(69,ixs(1,nft+i))
        temp0(i) =  pm(79,ixs(1,nft+i))
        rho0(i) =   pm(1,ixs(1,nft+i))
C For air + foam
         rhof(i) =  pm(192,ixs(1,nft+i))
         alpha(i) = pm(193,ixs(1,nft+i))
      ENDDO
      IF (ismstr==10.OR.ismstr==12) THEN
C Total Lagrange simulation
        CALL scoor3(x,xrefs(1,1,nf1),ixs(1,nf1),geo  ,mat  ,pid  ,ngl  ,
     .           ix1  ,ix2  ,ix3  ,ix4  ,ix5  ,ix6  ,ix7  ,ix8  ,
     .           x1   ,x2   ,x3   ,x4   ,x5   ,x6   ,x7   ,x8   ,
     .           y1   ,y2   ,y3   ,y4   ,y5   ,y6   ,y7   ,y8   ,
     .           z1   ,z2   ,z3   ,z4   ,z5   ,z6   ,z7   ,z8   ,
     .           rx   ,ry   ,rz   ,sx   ,sy   ,sz   ,tx   ,ty   ,tz   ,
     .           e1x  ,e1y  ,e1z  ,e2x  ,e2y  ,e2z  ,e3x  ,e3y  ,e3z  ,
     .           f1x  ,f1y  ,f1z  ,f2x  ,f2y  ,f2z  ,temp0,temp ,glob_therm%NINTEMP,
     .           xd1  ,xd2  ,xd3  ,xd4  ,xd5  ,xd6  ,xd7  ,xd8   ,
     .           yd1  ,yd2  ,yd3  ,yd4  ,yd5  ,yd6  ,yd7  ,yd8   ,
     .           zd1  ,zd2  ,zd3  ,zd4  ,zd5  ,zd6  ,zd7  ,zd8   )
       IF (nsigi > 0 ) THEN
          CALL s8erefcoor3(gbuf%SMSTR,8,nel,
     .           xd1  ,xd2  ,xd3  ,xd4  ,xd5  ,xd6  ,xd7  ,xd8   ,
     .           yd1  ,yd2  ,yd3  ,yd4  ,yd5  ,yd6  ,yd7  ,yd8   ,
     .           zd1  ,zd2  ,zd3  ,zd4  ,zd5  ,zd6  ,zd7  ,zd8   )
       END IF
C JAC_I : [J]^-1 is calculated in global system
        CALL sjacidp(
     .              xd1  ,xd2  ,xd3  ,xd4  ,xd5  ,xd6  ,xd7  ,xd8   ,
     .              yd1  ,yd2  ,yd3  ,yd4  ,yd5  ,yd6  ,yd7  ,yd8   ,
     .              zd1  ,zd2  ,zd3  ,zd4  ,zd5  ,zd6  ,zd7  ,zd8   ,
     .              gbuf%JAC_I ,nel)
      END IF
C Orthotropy wrt reference geometry
      IF (jcvt == 0) THEN
        CALL scoor3(x,xrefs(1,1,nf1),ixs(1,nf1),geo  ,mat  ,pid  ,ngl  ,
     .           ix1  ,ix2  ,ix3  ,ix4  ,ix5  ,ix6  ,ix7  ,ix8  ,
     .           x1   ,x2   ,x3   ,x4   ,x5   ,x6   ,x7   ,x8   ,
     .           y1   ,y2   ,y3   ,y4   ,y5   ,y6   ,y7   ,y8   ,
     .           z1   ,z2   ,z3   ,z4   ,z5   ,z6   ,z7   ,z8   ,
     .           rx   ,ry   ,rz   ,sx   ,sy   ,sz   ,tx   ,ty   ,tz   ,
     .           e1x  ,e1y  ,e1z  ,e2x  ,e2y  ,e2z  ,e3x  ,e3y  ,e3z  ,
     .           f1x  ,f1y  ,f1z  ,f2x  ,f2y  ,f2z  ,temp0,temp ,glob_therm%NINTEMP,
     .           xd1  ,xd2  ,xd3  ,xd4  ,xd5  ,xd6  ,xd7  ,xd8   ,
     .           yd1  ,yd2  ,yd3  ,yd4  ,yd5  ,yd6  ,yd7  ,yd8   ,
     .           zd1  ,zd2  ,zd3  ,zd4  ,zd5  ,zd6  ,zd7  ,zd8   )
      ELSE
        CALL srcoor3(x,xrefs(1,1,nf1),ixs(1,nf1),geo  ,mat  ,pid  ,ngl  ,jhbe ,
     .           ix1  ,ix2  ,ix3  ,ix4  ,ix5  ,ix6  ,ix7  ,ix8  ,
     .           x1   ,x2   ,x3   ,x4   ,x5   ,x6   ,x7   ,x8   ,
     .           y1   ,y2   ,y3   ,y4   ,y5   ,y6   ,y7   ,y8   ,
     .           z1   ,z2   ,z3   ,z4   ,z5   ,z6   ,z7   ,z8   ,
     .           rx   ,ry   ,rz   ,sx   ,sy   ,sz   ,tx   ,ty   ,tz   ,
     .           e1x  ,e1y  ,e1z  ,e2x  ,e2y  ,e2z  ,e3x  ,e3y  ,e3z  ,
     .           f1x  ,f1y  ,f1z  ,f2x  ,f2y  ,f2z  ,temp0,temp ,glob_therm%NINTEMP,
     .           xd1  ,xd2  ,xd3  ,xd4  ,xd5  ,xd6  ,xd7  ,xd8   ,
     .           yd1  ,yd2  ,yd3  ,yd4  ,yd5  ,yd6  ,yd7  ,yd8   ,
     .           zd1  ,zd2  ,zd3  ,zd4  ,zd5  ,zd6  ,zd7  ,zd8   )
 
      ENDIF
!
!     Initialize element temperature from /initemp
!      
      IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
        DO i=1,nel
          tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
     .                           + temp(ixs(4,i)) + temp(ixs(5,i))        
     .                           + temp(ixs(6,i)) + temp(ixs(7,i))        
     .                           + temp(ixs(8,i)) + temp(ixs(9,i))) 
        ENDDO
      ELSE
        tempel(1:nel) = temp0(1:nel)
      END IF
!
C Orthotropy
      IF (isorth == 1)
     .  CALL smorth3(pid  ,geo  ,igeo ,skew ,irep ,gbuf%GAMA  , 
     .         rx   ,ry   ,rz   ,sx   ,sy   ,sz   ,tx   ,ty   ,tz   ,
     .         e1x  ,e1y  ,e1z  ,e2x  ,e2y  ,e2z  ,e3x  ,e3y  ,e3z  ,
     .         f1x  ,f1y  ,f1z  ,f2x  ,f2y  ,f2z  ,nsigi,sigsp,nsigs,
     .         sigi ,ixs  ,x    ,jhbe ,ptsol,nel  ,iparg_gr(28))
C
      CALL sveok3(nvc,8, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
C
      IF(jeul /= 0.AND.integ8 /= 0) THEN
        CALL sderi3b(gbuf%VOL,veul(1,nf1),lveul,geo,igeo ,ngl  ,pid  ,
     .              x1   ,x2   ,x3   ,x4   ,x5   ,x6   ,x7   ,x8   ,
     .              y1   ,y2   ,y3   ,y4   ,y5   ,y6   ,y7   ,y8   ,
     .              z1   ,z2   ,z3   ,z4   ,z5   ,z6   ,z7   ,z8   ,
     .              volu, deltax,nel ,jeul )
      ELSEIF (npt == 8) THEN
        CALL sderi3b(gbuf%VOL,v8loc  ,lvloc,geo  ,igeo ,ngl  ,pid  ,
     .              x1   ,x2   ,x3   ,x4   ,x5   ,x6   ,x7   ,x8   ,
     .              y1   ,y2   ,y3   ,y4   ,y5   ,y6   ,y7   ,y8   ,
     .              z1   ,z2   ,z3   ,z4   ,z5   ,z6   ,z7   ,z8   ,
     .              volu, deltax,nel ,jeul )
      ELSE
C LBUF%VOL0DP is not done for Isolid=12
        IF (jhbe == 24) THEN
          IF(ASSOCIATED(lbuf%VOL0DP)) CALL szderi3(
     .           gbuf%VOL ,veul(1,nf1),geo  ,igeo  ,
     .               xd1  ,xd2  ,xd3  ,xd4  ,xd5   ,xd6  ,xd7   ,xd8   ,
     .               yd1  ,yd2  ,yd3  ,yd4  ,yd5   ,yd6  ,yd7   ,yd8   ,
     .               zd1  ,zd2  ,zd3  ,zd4  ,zd5   ,zd6  ,zd7   ,zd8   ,
     .               px1  ,px2  ,px3  ,px4  ,
     .               py1  ,py2  ,py3  ,py4  ,
     .               pz1  ,pz2  ,pz3  ,pz4  ,
     .               rx   ,ry   ,rz   ,sx   ,sy   ,sz   ,tz   ,
     .               ngl  ,pid  ,volu ,lbuf%VOL0DP,nel  ,jeul ,nxref)
        ELSE
          IF(ASSOCIATED(lbuf%VOL0DP)) CALL sderi3(
     .          gbuf%VOL ,veul(1,nf1),geo  ,igeo  ,
     .              xd1  ,xd2  ,xd3  ,xd4  ,xd5   ,xd6  ,xd7   ,xd8   ,
     .              yd1  ,yd2  ,yd3  ,yd4  ,yd5   ,yd6  ,yd7   ,yd8   ,
     .              zd1  ,zd2  ,zd3  ,zd4  ,zd5   ,zd6  ,zd7   ,zd8   ,
     .              rx   ,ry   ,rz   ,sx   ,sy   ,sz   ,ngl  ,pid  ,
     .              px1  ,px2  ,px3  ,px4  ,py1  ,py2  ,py3  ,py4  ,
     .              pz1  ,pz2  ,pz3  ,pz4, volu  ,lbuf%VOL0DP,nel  ,jeul,
     .              nxref,imulti_fvm)
        ENDIF
        CALL sdlen3(
     .            x1   ,x2   ,x3   ,x4   ,x5   ,x6   ,x7   ,x8   ,
     .            y1   ,y2   ,y3   ,y4   ,y5   ,y6   ,y7   ,y8   ,
     .            z1   ,z2   ,z3   ,z4   ,z5   ,z6   ,z7   ,z8,
     .            deltax, volu)
      ENDIF
      IF(jeul /= 0)THEN
        CALL edlen3(veul(1,nf1), deltax)
        CALL enorm3(veul(1,nf1),
     .              x1   ,x2   ,x3   ,x4   ,x5   ,x6   ,x7   ,x8   ,
     .              y1   ,y2   ,y3   ,y4   ,y5   ,y6   ,y7   ,y8   ,
     .              z1   ,z2   ,z3   ,z4   ,z5   ,z6   ,z7   ,z8   )
      ENDIF
c
      ipt=1
      DO ir =1,nptr
        DO is =1,npts
          DO it =1,nptt
            lbuf  => elbuf_str%BUFLY(1)%LBUF(ir,is,it)
            mbuf  => elbuf_str%BUFLY(1)%MAT(ir,is,it)
            fbuf  => elbuf_str%BUFLY(1)%FAIL(ir,is,it)
            CALL matini(pm       ,ixs    ,nixs       ,x         ,
     2            geo      ,ale_connectivity  ,detonators ,iparg_gr  ,
     3            sigi     ,nel    ,skew      ,igeo   ,
     4            ipart    ,iparts ,
     5            mat      ,ipm    ,nsigs      ,numsol    ,ptsol  ,
     6            ipt      ,ngl    ,npf        ,tf        ,bufmat ,
     7            gbuf     ,lbuf   ,mbuf       ,elbuf_str ,iloadp ,
     8            facload, deltax  ,tempel     ,mat_param )
          END DO
        END DO
      END DO
      lbuf  => elbuf_str%BUFLY(1)%LBUF(1,1,1)
      mbuf  => elbuf_str%BUFLY(1)%MAT(1,1,1)
      fbuf  => elbuf_str%BUFLY(1)%FAIL(1,1,1)
C 
C Density perturbation for /MAT/LAW115
      IF (mtn == 115) THEN 
        CALL m115_perturb(pm       ,mat      ,gbuf%RHO ,perturb  ,rnoise   ) 
      ENDIF
C
      IF (iboltp /=0) THEN
        CALL sboltini(e1x  ,e1y  ,e1z  ,e2x  ,e2y  ,e2z  ,e3x  ,e3y  ,e3z  ,
     1                gbuf%BPRELD,nel  ,ixs  ,nixs ,vpreload, iflag_bpreload)
      ENDIF
C----------------------------------------
C Thermal and Turbulence initialization
C----------------------------------------
      IF(jthe /=0) CALL atheri(mat,pm  ,gbuf%TEMP)
      IF(jtur /=0) CALL aturi3(iparg   ,gbuf%RHO,pm,ixs,x,
     .                         gbuf%RK ,gbuf%RE,volu)
C----------------------------------------
C Masses initialization
C----------------------------------------
      IF(jlag+jale+jeul /= 0) THEN
        IF(integ8 /= 0 .AND. jeul /= 0) THEN
          CALL smass3b(
     1          gbuf%RHO,mas,veul(44,nf1),lveul      ,mss(1,nf1),
     2          partsav,x  ,v           ,iparts(nf1),msnf      ,
     3          mssf(1,nf1),wma         , rhocp     ,mcp       ,
     4          mcps(1,nf1),mssa, volu, 
     5          ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
        ELSEIF (npt == 8) THEN
          IF (mtn >= 28) idef = 1
          CALL sigin3b(
     1     mat      ,pm      ,ipm      ,gbuf%SIG ,gbuf%VOL ,
     2     sigsp    ,sigi    ,gbuf%EINT,gbuf%RHO ,
     3     ixs      ,nixs    ,nsigi    ,nsigs    ,
     4     nel      ,idef    ,bufmat   ,npf      ,
     5     tf       ,strsglob,straglob ,jhbe     ,
     6     igtyp    ,x       ,gbuf%GAMA,bufly    ,l_pla    ,
     7     ptsol    )
          CALL smass3b(
     1         gbuf%RHO   ,mas      ,v8loc(44,1),lvloc      ,mss(1,nf1) ,
     2         partsav,x  ,v          ,iparts(nf1),msnf      ,
     3         mssf(1,nf1),wma        , rhocp     ,mcp       ,
     4         mcps(1,nf1),mssa, volu, 
     5         ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
        ELSE
C Case /INIBRIS/STRS_FGLO missed         
          IF (isigi /= 0 .AND. (jcvt /= 0 .OR. isorth /= 0) ) THEN
            IF(ASSOCIATED(lbuf%VOL0DP)) CALL ustrsin3( sigi    ,lbuf%SIG ,ixs     ,nixs    ,nsigs   ,
     .                                                 nel     ,strsglob ,jhbe    ,igtyp   ,x       ,
     .                                                 gbuf%GAMA,ptsol   ,lbuf%VOL0DP,rho0,gbuf%RHO )
          ENDIF
          IF (((mtn>=28 .AND. mtn/=49) .OR. mtn==14 .OR. mtn==12) .OR.
     .         (istrain == 1 .AND. 
     .         (mtn==1  .OR. mtn==2  .OR. mtn==3    .OR. mtn==4  .OR. 
     .          mtn==6  .OR. mtn==10 .OR. mtn==21   .OR. mtn==22 .OR.
     .          mtn==23 .OR. mtn==24))) THEN
              idef = 1
          ENDIF
c
          IF (isigi /= 0 .AND. ((mtn >= 28 .AND. iuser == 1).OR.
     .      (nvsolid2 /= 0 .and .idef /=0)))
     .    CALL userin3(
     .           sigsp    ,sigi    ,mbuf%VAR ,lbuf%STRA,
     .           ixs      ,nixs    ,nsigi    ,nuvar    ,nel     ,
     .           nsigs    ,iuser   ,idef     ,straglob ,jhbe    ,
     .           igtyp    ,x       ,gbuf%GAMA,ptsol    ,lbuf%SIGB,
     .           l_sigb   ,mat(1)  ,ipm      ,bufmat   ,lbuf%PLA,
     .           l_pla    )
          CALL smass3(
     .         gbuf%RHO   ,mas        ,partsav    ,x          ,v        ,
     .         iparts(nf1),mss(1,nf1) ,volu       ,
     .         msnf       ,mssf(1,nf1),in         ,
     .         vr         ,ins(1,nf1) ,wma        ,rhocp      ,mcp      ,
     .         mcps(1,nf1),mssa       ,rhof       ,alpha      ,gbuf%FILL,
     .         ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
        ENDIF
C
C------------------------------------------------------------------
c Initialization of stress tensor in case of Orthotropic properties
C------------------------------------------------------------------
        IF (isigi /= 0 .AND. isorth/=0) THEN 
          lbuf%SIGL = lbuf%SIG
        ENDIF
C----------------------------------------
c Failure model initialization
C----------------------------------------
        CALL failini(elbuf_str,nptr,npts,nptt,nlay,
     .               ipm,sigsp,nsigi,fail_ini ,
     .               sigi,nsigs,ixs,nixs,ptsol,rnoise,perturb,mat_param)
C--------------------------------------------------------------------
C Compute nodal volumes and moduli for contact stiffness
C Note : IX1, IX2 ... IX8 are in NC(MVSIZ,8)
C--------------------------------------------------------------------
        IF (i7stifs /= 0) THEN
          ncc=8
          CALL sbulk3(volu  ,ix1    ,ncc,mat,pm ,
     2                volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid,
     3                bid   ,gbuf%FILL)
        ENDIF
      ENDIF   ! End masses initialization      
C----------------------------------------
C Cell momentum for FVM
C----------------------------------------      
      IF(alefvm_param%IEnabled /= 0) THEN      
        CALL inimom_fvm(v   ,  gbuf%RHO,  gbuf%VOL,  gbuf%MOM,  ixs,
     .                  ipm ,  mat     ,  iparg_gr,  npf     ,  tf ,
     .                  pm  ,  lbuf%SSP,  gbuf%SIG,  nel
     .                 )
      ENDIF
C------------------------------------------
C Compute element time step
C------------------------------------------
      aire(:) = zero
      dtx(:) = zero
      CALL dtmain(geo      , pm       , ipm        , pid    , mat    , fv    ,
     .     gbuf%EINT, gbuf%TEMP, gbuf%DELTAX, gbuf%RK, gbuf%RE, bufmat, deltax, aire, 
     .     volu, dtx, igeo ,igtyp)
C
      DO i=1,nel
        IF(ixs(10,i+nft) /= 0) THEN
          IF(igtyp /= 0 .AND.igtyp /= 6 .AND. igtyp /= 14 .AND.igtyp /= 15.AND. igtyp /= 29) THEN
             ipid1=ixs(nixs-1,i+nft)
             CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
             CALL ancmsg(msgid=226,
     .                   msgtype=msgerror,
     .                   anmode=aninfo_blind_1,
     .                   i1=igeo(1,ipid1),
     .                   c1=titr1,
     .                   i2=igtyp)
          ENDIF
        ENDIF
        dtelem(nft+i)=dtx(i)
C
C       STI = 0.25 * RHO * VOL / (DT*DT)
        sti = fourth * gbuf%FILL(i) * gbuf%RHO(i) * volu(i) / max(em20,dtx(i)*dtx(i))
        stifn(ixs(2,i+nft))=stifn(ixs(2,i+nft))+sti
        stifn(ixs(3,i+nft))=stifn(ixs(3,i+nft))+sti
        stifn(ixs(4,i+nft))=stifn(ixs(4,i+nft))+sti
        stifn(ixs(5,i+nft))=stifn(ixs(5,i+nft))+sti
        stifn(ixs(6,i+nft))=stifn(ixs(6,i+nft))+sti
        stifn(ixs(7,i+nft))=stifn(ixs(7,i+nft))+sti
        stifn(ixs(8,i+nft))=stifn(ixs(8,i+nft))+sti
        stifn(ixs(9,i+nft))=stifn(ixs(9,i+nft))+sti
      ENDDO
C--------------------------------------------------------
C Solid to SPH : compute particles initial volume and mass
C--------------------------------------------------------
      IF(nsphsol/=0)THEN
       DO i=1,nel
         IF(sol2sph(1,nft+i) < sol2sph(2,nft+i))THEN
           nsphdir=igeo(37,ixs(10,nft+i))
           ncelf  =sol2sph(1,nft+i)+1
           ncell  =sol2sph(2,nft+i)-sol2sph(1,nft+i)
           CALL soltosphv8(
     .       nsphdir ,gbuf%RHO(i) ,ncell   ,x      ,spbuf(1,ncelf),
     .       ixs(1,i+nft),kxsp(1,ncelf),ipartsp(ncelf),
     .                                  irst(1,ncelf-first_sphsol+1))
         END IF
       ENDDO
      END IF
C-----------
      RETURN