tranpvq33.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	tranpvq33 (jft, jlt, kd, pvq, vq, is, it)

Function/Subroutine Documentation

tranpvq33()

subroutine tranpvq33	(	integer	jft,
		integer	jlt,
			kd,
			pvq,
			vq,
		integer	is,
		integer	it )

Definition at line 28 of file tranpvq33.F.

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
#include      "implicit_f.inc"
C-----------------------------------------------
C   D U M M Y   A R G U M E N T S
C-----------------------------------------------
      INTEGER JFT,JLT,IS,IT
      my_real
     .   kd(3,3,*),pvq(3,3,*),vq(3,3,*)
C-----------------------------------------------
C   LOCAL  A R G U M E N T S
C-----------------------------------------------
      INTEGER I,J,EP,L,I1,J1
      my_real
     .    k(3,3)
C--------------PVQIJ=[VQ]gij-[KD][VQ]--;PVQJI=[VQ]gij-[KD]^t[VQ]-----------------------------
       IF (it==1) THEN
        DO i=1,3
        DO j=1,3
         DO ep=jft,jlt
          k(i,j)=zero
          DO l=1,3
           k(i,j)=k(i,j)+kd(i,l,ep)*vq(l,j,ep)
          ENDDO
          pvq(i,j,ep)=-k(i,j)
         ENDDO
        ENDDO
        ENDDO
       ELSE
        DO i=1,3
        DO j=1,3
         DO ep=jft,jlt
          k(i,j)=zero
          DO l=1,3
           k(i,j)=k(i,j)+kd(l,i,ep)*vq(l,j,ep)
          ENDDO
          pvq(i,j,ep)=-k(i,j)
         ENDDO
        ENDDO
        ENDDO
       END IF !(IT==1) THEN
C       
       IF (is==1) THEN
        DO i=1,3
        DO j=1,3
         DO ep=jft,jlt
          pvq(i,j,ep)=pvq(i,j,ep)+vq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
       END IF
C       
      RETURN