r12mat3.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	r12mat3 (jft, jlt, geo, kx, mgn, dkx, beta, al0, fx, dx, tf, npf, pos, igeo)

Function/Subroutine Documentation

r12mat3()

subroutine r12mat3	(	integer	jft,
		integer	jlt,
			geo,
			kx,
		integer, dimension(*)	mgn,
			dkx,
			beta,
			al0,
			fx,
			dx,
			tf,
		integer, dimension(*)	npf,
			pos,
		integer, dimension(npropgi,*)	igeo )

Definition at line 30 of file r12mat3.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(*),IGEO(NPROPGI,*),NPF(*)
C     REAL
      my_real
     .   geo(npropg,*), kx(*),beta(*),dkx(*),al0(*),
     .   fx(*),dx(*),tf(*),pos(*)
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
     .   a(mvsiz),fric,ff
C-----------------------------------------------
C
      DO i=jft,jlt
       kx(i)=geo(2,mgn(i))
      ENDDO
      ilen = 0
      DO i=jft,jlt
       a(i)   =geo(10,mgn(i))
C       KX(I)=A(I)*KX(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
          kx(i)=kx(i)/al0(i)
        ENDIF
       ENDDO
      ENDIF
C
      DO i=jft,jlt
       fric= geo(17,mgn(i))
       IF(fric/=zero)THEN
        dkx(i) = kx(i)*tanh(half*fric*beta(i))
       ELSE
        dkx(i)=zero
       ENDIF
      ENDDO
      IF (ismdisp>0.OR.isprn==1) THEN
       DO i=jft,jlt
        iecrou(i)=nint(geo(7,mgn(i)))
        ifunc(i) =igeo(101,mgn(i))
        ifunc2(i)=igeo(103,mgn(i))
       ENDDO
       CALL rkenonl(jft    ,jlt    ,kx     ,fx     ,dx     ,
     .              iecrou ,ifunc  ,ifunc2 ,a      ,tf     ,
     .              npf    ,pos    )
      ENDIF
C
      RETURN