i12for3.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i12for3 (nsn, nmn, a, irect, crst, msr, nsv, irtl, ms, weight, stifn, mmass, tagkine, skew, wa, tets, tetm, ilev, iref)

Function/Subroutine Documentation

i12for3()

subroutine i12for3	(	integer	nsn,
		integer	nmn,
			a,
		integer, dimension(4,*)	irect,
			crst,
		integer, dimension(*)	msr,
		integer, dimension(*)	nsv,
		integer, dimension(*)	irtl,
			ms,
		integer, dimension(*)	weight,
			stifn,
			mmass,
		integer, dimension(*)	tagkine,
			skew,
			wa,
			tets,
			tetm,
		integer	ilev,
		integer	iref )

Definition at line 29 of file i12for3.F.

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 NSN, NMN,
     .   IRECT(4,*), MSR(*), NSV(*), IRTL(*), WEIGHT(*),TAGKINE(*)
      INTEGER ILEV,IREF
      my_real
     .   a(*), crst(2,*), ms(*), stifn(*), mmass(*),wa(3,*),
     .   skew(lskew,*),tetm(*),tets(*)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NIR, I, J, I3, J3, I2, J2, I1, J1, II, L, JJ,JL
      my_real
     .   h(4), xmsj, ss, tt, xmsi, fxi, fyi, fzi,sp,sm,tp,tm,
     .   p(9),cst,sst,fxr, fyr, fzr
C-----------------------------------------------
      nir=2
      IF(n2d==0)nir=4
      IF(ilev==1)THEN
        DO i=1,9
          p(i)=skew(i,iref+1)
        ENDDO
        DO ii=1,nmn
          wa(1,ii)=zero
          wa(2,ii)=zero
          wa(3,ii)=zero
        ENDDO
      ENDIF
 
       !Cel sauvegarde de la masse initiale
        DO ii=1,nmn
          j=msr(ii)
          mmass(ii)=ms(j)
        ENDDO
 
      DO ii=1,nsn
        IF(tagkine(ii)>0)THEN
          i=nsv(ii)
          l=irtl(ii)
          ss=crst(1,ii)
          tt=crst(2,ii)
          i3=3*i
          i2=i3-1
          i1=i2-1
          xmsi=ms(i)
          fxi=a(i1)
          fyi=a(i2)
          fzi=a(i3)
          sp=one+ss
          sm=one-ss
          tp=fourth*(one+tt)
          tm=fourth*(one-tt)
          h(1)=tm*sm
          h(2)=tm*sp
          h(3)=tp*sp
          h(4)=tp*sm
          IF(ilev==1)THEN
           IF(tets(ii)<10000. )THEN
            cst=cos(tets(ii))
            sst=sin(tets(ii))
            fxr=fxi*p(1)+fyi*p(2)+fzi*p(3)
            fyr=fxi*p(4)+fyi*p(5)+fzi*p(6)
            fzr=fxi*p(7)+fyi*p(8)+fzi*p(9)
            fxi=fxr
            fyi=    fyr*cst+fzr*sst
            fzi=   -fyr*sst+fzr*cst
            DO jj=1,nir
              jl=irect(jj,l)
              j=msr(jl)
              wa(1,jl)=wa(1,jl)+fxi*h(jj)
              wa(2,jl)=wa(2,jl)+fyi*h(jj)
              wa(3,jl)=wa(3,jl)+fzi*h(jj)
              ms(j)=ms(j)+xmsi*h(jj)
              stifn(j)=stifn(j)+stifn(i)*h(jj)
            ENDDO
           ELSE
            DO jj=1,nir
              j=msr(irect(jj,l))
              j3=3*j
              j2=j3-1
              j1=j2-1
              a(j1)=a(j1)+fxi*h(jj)
              a(j2)=a(j2)+fyi*h(jj)
              a(j3)=a(j3)+fzi*h(jj)
              ms(j)=ms(j)+xmsi*h(jj)
              stifn(j)=stifn(j)+stifn(i)*h(jj)
            ENDDO
           ENDIF
          ELSE
            DO jj=1,nir
              j=msr(irect(jj,l))
              j3=3*j
              j2=j3-1
              j1=j2-1
              a(j1)=a(j1)+fxi*h(jj)
              a(j2)=a(j2)+fyi*h(jj)
              a(j3)=a(j3)+fzi*h(jj)
              ms(j)=ms(j)+xmsi*h(jj)
              stifn(j)=stifn(j)+stifn(i)*h(jj)
 
            ENDDO
          ENDIF !(ILEV==1)
        stifn(i)=em20
        a(i1)=zero
        a(i2)=zero
        a(i3)=zero
        ENDIF
      ENDDO
      
      IF(ilev==1 )THEN
        DO ii=1,nmn
          cst=cos(tetm(ii))
          sst=sin(tetm(ii))
          fxr=wa(1,ii)
          fyr=wa(2,ii)*cst-wa(3,ii)*sst
          fzr=wa(2,ii)*sst+wa(3,ii)*cst
          wa(1,ii)=fxr*p(1)+fyr*p(4)+fzr*p(7)
          wa(2,ii)=fxr*p(2)+fyr*p(5)+fzr*p(8)
          wa(3,ii)=fxr*p(3)+fyr*p(6)+fzr*p(9)
          j=msr(ii)
          j3=3*j
          j2=j3-1
          j1=j2-1
          a(j1)=a(j1)+wa(1,ii)
          a(j2)=a(j2)+wa(2,ii)
          a(j3)=a(j3)+wa(3,ii)
        ENDDO
      ENDIF
 
      RETURN