r13mat3.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "impl1_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	r13mat3 (jft, jlt, geo, kx, ky, kz, mx, my, mz, mgn, al0, fx, fy, fz, dx, dy, dz, xmom, ymom, zmom, rx, ry, rz, tf, npf, posx, posy, posz, posxx, posyy, poszz, igeo)

Function/Subroutine Documentation

r13mat3()

subroutine r13mat3	(	integer	jft,
		integer	jlt,
			geo,
			kx,
			ky,
			kz,
			mx,
			my,
			mz,
		integer, dimension(*)	mgn,
			al0,
			fx,
			fy,
			fz,
			dx,
			dy,
			dz,
			xmom,
			ymom,
			zmom,
			rx,
			ry,
			rz,
			tf,
		integer, dimension(*)	npf,
			posx,
			posy,
			posz,
			posxx,
			posyy,
			poszz,
		integer, dimension(npropgi,*)	igeo )

Definition at line 31 of file r13mat3.F.

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      "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 JFT    ,JLT, MGN(*),NPF(*),IGEO(NPROPGI,*)
C     REAL
      my_real
     .   geo(npropg,*), kx(*), ky(*), kz(*), mx(*), my(*), mz(*),
     .   fx(*),fy(*),fz(*),dx(*),dy(*),dz(*),xmom(*),ymom(*),zmom(*),
     .   rx(*),ry(*),rz(*),tf(*),posx(*),posy(*),posz(*),
     .   posxx(*),posyy(*),poszz(*),al0(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,ILEN,ILENG
      INTEGER IECROU(MVSIZ), IFUNC(MVSIZ),IFUNC2(MVSIZ)
C     REAL
      my_real
     .   ali,a(mvsiz)
C-----------------------------------------------
C
      DO i=jft,jlt
       kx(i)=geo(3,mgn(i))
       ky(i)=geo(10,mgn(i))
       kz(i)=geo(15,mgn(i))
      ENDDO
C---------------------
C     ROTATIONS
C---------------------
      DO i=jft,jlt
       mx(i)=geo(19,mgn(i))
       my(i)=geo(23,mgn(i))
       mz(i)=geo(27,mgn(i))
      ENDDO
      ilen = 0
      DO i=jft,jlt
C       KX(I)=GEO(41,MGN(I))*KX(I)
C       KY(I)=GEO(45,MGN(I))*KY(I)
C       KZ(I)=GEO(49,MGN(I))*KZ(I)
C       MX(I)=GEO(53,MGN(I))*MX(I)
C       MY(I)=GEO(57,MGN(I))*MY(I)
C       MZ(I)=GEO(61,MGN(I))*MZ(I)
       ileng=nint(geo(93,mgn(i)))
       IF(ileng/=0) ilen = 1
      ENDDO
      IF(ilen/=0) THEN
       DO i=jft,jlt
        ileng=nint(geo(93,mgn(i)))
        IF(ileng/=0)THEN
         ali = one/al0(i)
         kx(i)=kx(i)*ali
         ky(i)=ky(i)*ali
         kz(i)=kz(i)*ali
         mx(i)=mx(i)*ali
         my(i)=my(i)*ali
         mz(i)=mz(i)*ali
        ENDIF
       ENDDO
      ENDIF
      IF (ismdisp>0.OR.isprn==1) THEN
C-----------KX------------
       DO i=jft,jlt
        iecrou(i)=nint(geo(7,mgn(i)))
        ifunc(i) = igeo(101,mgn(i))
        ifunc2(i)= igeo(103,mgn(i))
        a(i)     = geo(41,mgn(i))
       ENDDO
       CALL rkenonl(jft    ,jlt    ,kx     ,fx     ,dx     ,
     .              iecrou ,ifunc  ,ifunc2 ,a      ,tf     ,
     .              npf    ,posx   )
C-----------KY----------
       DO i=jft,jlt
        iecrou(i)=nint(geo(14,mgn(i)))
        ifunc(i) = igeo(104,mgn(i))
        ifunc2(i)= igeo(106,mgn(i))
        a(i)     = geo(45,mgn(i))
       ENDDO
       CALL rkenonl(jft    ,jlt    ,ky     ,fy     ,dy     ,
     .              iecrou ,ifunc  ,ifunc2 ,a      ,tf     ,
     .              npf    ,posy   )
C-----------KZ-----------
       DO i=jft,jlt
        iecrou(i)=nint(geo(18,mgn(i)))
        ifunc(i) = igeo(107,mgn(i))
        ifunc2(i)= igeo(109,mgn(i))
        a(i)     = geo(49,mgn(i))
       ENDDO
       CALL rkenonl(jft    ,jlt    ,kz     ,fz     ,dz     ,
     .              iecrou ,ifunc  ,ifunc2 ,a      ,tf     ,
     .              npf    ,posz   )
C-----------MX------------
       DO i=jft,jlt
        iecrou(i)=nint(geo(22,mgn(i)))
        ifunc(i) = igeo(110,mgn(i))
        ifunc2(i)= igeo(112,mgn(i))
        a(i)     = geo(53,mgn(i))
       ENDDO
       CALL rkenonl(jft    ,jlt    ,mx     ,xmom   ,rx     ,
     .              iecrou ,ifunc  ,ifunc2 ,a      ,tf     ,
     .              npf    ,posxx  )
C-----------MY------------
       DO i=jft,jlt
        iecrou(i)=nint(geo(26,mgn(i)))
        ifunc(i) = igeo(113,mgn(i))
        ifunc2(i)= igeo(115,mgn(i))
        a(i)     = geo(57,mgn(i))
       ENDDO
       CALL rkenonl(jft    ,jlt    ,my     ,ymom   ,ry     ,
     .              iecrou ,ifunc  ,ifunc2 ,a      ,tf     ,
     .              npf    ,posyy  )
C-----------MZ------------
       DO i=jft,jlt
        iecrou(i)=nint(geo(30,mgn(i)))
        ifunc(i) = igeo(116,mgn(i))
        ifunc2(i)= igeo(118,mgn(i))
        a(i)     = geo(61,mgn(i))
       ENDDO
       CALL rkenonl(jft    ,jlt    ,mz     ,zmom   ,rz     ,
     .              iecrou ,ifunc  ,ifunc2 ,a      ,tf     ,
     .              npf    ,poszz  )
      ENDIF
C
      RETURN