i12vit3.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	i12vit3 (nsn, nmn, a, irect, crst, msr, nsv, irtl, v, ms, weight, mmass, tagkine, skew, wa, tets, tetm, ilev, iref)

Function/Subroutine Documentation

i12vit3()

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

Definition at line 28 of file i12vit3.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(*),
     .   ILEV,IREF
      my_real
     .   a(*), crst(2,*), v(*),ms(*), mmass(*),wa(6,*),
     .   skew(lskew,*),tets(*),tetm(*)
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, ISK, ICOD, II, L, JJ,
     .   NN,JL
      my_real
     .   h(4), ss, tt, amx, amy, amz, vmx, vmy, vmz,sp,sm,tp,tm,mas,
     .   p(9),axr,ayr,azr,cst,sst
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
          j=msr(ii)
          j3=3*j
          j2=j3-1
          j1=j2-1
          cst=cos(tetm(ii))
          sst=sin(tetm(ii))
 
          amx=a(j1)
          amy=a(j2)
          amz=a(j3)
          axr=amx*p(1)+amy*p(2)+amz*p(3)
          ayr=amx*p(4)+amy*p(5)+amz*p(6)
          azr=amx*p(7)+amy*p(8)+amz*p(9)
          wa(1,ii)=axr
          wa(2,ii)=    ayr*cst+azr*sst
          wa(3,ii)=   -ayr*sst+azr*cst
 
          amx=v(j1)
          amy=v(j2)
          amz=v(j3)
          axr=amx*p(1)+amy*p(2)+amz*p(3)
          ayr=amx*p(4)+amy*p(5)+amz*p(6)
          azr=amx*p(7)+amy*p(8)+amz*p(9)
          wa(4,ii)=axr
          wa(5,ii)=    ayr*cst+azr*sst
          wa(6,ii)=   -ayr*sst+azr*cst
        ENDDO
      ENDIF
 
      DO ii=1,nsn
        IF(tagkine(ii)<0)cycle
        i=nsv(ii)
        l=irtl(ii)
        ss=crst(1,ii)
        tt=crst(2,ii)
        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
        i3=3*i
        i2=i3-1
        i1=i2-1
        amx=zero
        amy=zero
        amz=zero
        vmx=zero
        vmy=zero
        vmz=zero
        IF(ilev==1)THEN
          IF(tets(ii)<10000.)THEN
            DO jj=1,nir
              j=irect(jj,l)
              amx=amx+wa(1,j)*h(jj)
              amy=amy+wa(2,j)*h(jj)
              amz=amz+wa(3,j)*h(jj)
              vmx=vmx+wa(4,j)*h(jj)
              vmy=vmy+wa(5,j)*h(jj)
              vmz=vmz+wa(6,j)*h(jj)
            ENDDO
            cst=cos(tets(ii))
            sst=sin(tets(ii))
            axr=amx
            ayr=    amy*cst-amz*sst
            azr=    amy*sst+amz*cst
            amx=axr*p(1)+ayr*p(4)+azr*p(7)
            amy=axr*p(2)+ayr*p(5)+azr*p(8)
            amz=axr*p(3)+ayr*p(6)+azr*p(9)
            axr=vmx
            ayr=    vmy*cst-vmz*sst
            azr=    vmy*sst+vmz*cst
            vmx=axr*p(1)+ayr*p(4)+azr*p(7)
            vmy=axr*p(2)+ayr*p(5)+azr*p(8)
            vmz=axr*p(3)+ayr*p(6)+azr*p(9)
          ELSE
            DO jj=1,nir
              j=msr(irect(jj,l))
              j3=3*j
              j2=j3-1
              j1=j2-1
              amx=amx+a(j1)*h(jj)
              amy=amy+a(j2)*h(jj)
              amz=amz+a(j3)*h(jj)
              vmx=vmx+v(j1)*h(jj)
              vmy=vmy+v(j2)*h(jj)
              vmz=vmz+v(j3)*h(jj)
            ENDDO
          ENDIF !(TETS(II)<10000.)
        ELSE
          DO jj=1,nir
            j=msr(irect(jj,l))
            j3=3*j
            j2=j3-1
            j1=j2-1
            amx=amx+a(j1)*h(jj)
            amy=amy+a(j2)*h(jj)
            amz=amz+a(j3)*h(jj)
            vmx=vmx+v(j1)*h(jj)
            vmy=vmy+v(j2)*h(jj)
            vmz=vmz+v(j3)*h(jj)
          ENDDO
        ENDIF
        a(i1)=amx
        a(i2)=amy
        a(i3)=amz
        v(i1)=vmx
        v(i2)=vmy
        v(i3)=vmz
      END DO !II=1,NSN
 
      DO ii=1,nmn
        j=msr(ii)
        ms(j)=mmass(ii)
      ENDDO
 
      RETURN