s10pij12.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	s10pij12 (npt, xx, yy, zz, px, py, pz, nel)

Function/Subroutine Documentation

s10pij12()

subroutine s10pij12	(	integer	npt,
		double precision, dimension(mvsiz,10)	xx,
		double precision, dimension(mvsiz,10)	yy,
		double precision, dimension(mvsiz,10)	zz,
			px,
			py,
			pz,
		integer	nel )

Definition at line 30 of file s10pij12.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   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NEL,NPT
      DOUBLE PRECISION XX(MVSIZ,10), YY(MVSIZ,10), ZZ(MVSIZ,10)
      my_real px(mvsiz,10,5),py(mvsiz,10,5),pz(mvsiz,10,5)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,IP,N,K1,K2,K3,K4,K5,K6,K7,K8,K9,K10,
     .        M,IPERM(10,4)
      double precision
     .   xa(mvsiz,10),ya(mvsiz,10),za(mvsiz,10),
     .   xb(mvsiz,10),yb(mvsiz,10),zb(mvsiz,10),
     .   a4,b4,a4m1,b4m1,aa,voldp(mvsiz)
      my_real
     .   alph,beta,w,vol(mvsiz)
      DATA iperm/
     .            2, 4, 3, 1, 9,10, 6, 5, 8, 7,
     .            4, 1, 3, 2, 8, 7,10, 9, 5, 6,
     .            1, 4, 2, 3, 8, 9, 5, 7,10, 6,
     .            1, 2, 3, 4, 5, 6, 7, 8, 9,10/
C-----------------------------------------------
      alph = -huge(alph)
      beta = -huge(beta)
      IF(npt==4)THEN
        alph = zep5854102
        beta  = zep1381966
        w = fourth
      ELSEIF(npt==5)THEN
        alph = half
        beta  = one_over_6
        w = nine_over_20
      ENDIF
      a4 = four * alph
      b4 = four * beta
      a4m1  = a4- one
      b4m1  = b4- one
C
      DO n=1,4
        DO i=1,nel
          xa(i,n) = a4m1*xx(i,n)
          ya(i,n) = a4m1*yy(i,n)
          za(i,n) = a4m1*zz(i,n)
C
          xb(i,n) = b4m1*xx(i,n)
          yb(i,n) = b4m1*yy(i,n)
          zb(i,n) = b4m1*zz(i,n)
        ENDDO
      ENDDO
C
      DO n=5,10
        DO i=1,nel
          xa(i,n) = a4*xx(i,n)
          ya(i,n) = a4*yy(i,n)
          za(i,n) = a4*zz(i,n)
C
          xb(i,n) = b4*xx(i,n)
          yb(i,n) = b4*yy(i,n)
          zb(i,n) = b4*zz(i,n)
        ENDDO
      ENDDO
C
      DO ip=1,4
        k1 = iperm(1,ip)
        k2 = iperm(2,ip)
        k3 = iperm(3,ip)
        k4 = iperm(4,ip)
        k5 = iperm(5,ip)
        k6 = iperm(6,ip)
        k7 = iperm(7,ip)
        k8 = iperm(8,ip)
        k9 = iperm(9,ip)
        k10= iperm(10,ip)
        CALL s10jacobnel(alph,beta,w,
     .   xb(1,k1),xb(1,k2),xb(1,k3),xa(1,k4),xb(1,k5),
     .   xb(1,k6),xb(1,k7),xb(1,k8),xb(1,k9),xb(1,k10),
     .   xa(1,k8),xa(1,k9),xa(1,k10),
     .   yb(1,k1),yb(1,k2),yb(1,k3),ya(1,k4),yb(1,k5),
     .   yb(1,k6),yb(1,k7),yb(1,k8),yb(1,k9),yb(1,k10),
     .   ya(1,k8),ya(1,k9),ya(1,k10),
     .   zb(1,k1),zb(1,k2),zb(1,k3),za(1,k4),zb(1,k5),
     .   zb(1,k6),zb(1,k7),zb(1,k8),zb(1,k9),zb(1,k10),
     .   za(1,k8),za(1,k9),za(1,k10),
     .   px(1,k1,ip) ,px(1,k2,ip),px(1,k3,ip),px(1,k4,ip),px(1,k5,ip),
     .   px(1,k6,ip) ,px(1,k7,ip),px(1,k8,ip),px(1,k9,ip),px(1,k10,ip),
     .   py(1,k1,ip) ,py(1,k2,ip),py(1,k3,ip),py(1,k4,ip),py(1,k5,ip),
     .   py(1,k6,ip) ,py(1,k7,ip),py(1,k8,ip),py(1,k9,ip),py(1,k10,ip),
     .   pz(1,k1,ip) ,pz(1,k2,ip),pz(1,k3,ip),pz(1,k4,ip),pz(1,k5,ip),
     .   pz(1,k6,ip) ,pz(1,k7,ip),pz(1,k8,ip),pz(1,k9,ip),pz(1,k10,ip),
     .   vol ,voldp,nel)
c
      ENDDO
C
C
      IF(npt==5)THEN
        alph = fourth
        beta  = fourth
        a4 = one
        b4 = one
        a4m1  = zero
        b4m1  = zero
        w = - four_over_5
        ip = 5
C
        DO n=1,4
         DO i=1,nel
          xa(i,n) = zero
          ya(i,n) = zero
          za(i,n) = zero
         ENDDO
        ENDDO
CC
        CALL s10jacobnel(alph,beta,w,
     .   xa(1,k1),xa(1,k2),xa(1,k3),xa(1,k4),xx(1,k5),
     .   xx(1,k6),xx(1,k7),xx(1,k8),xx(1,k9),xx(1,k10),
     .   xx(1,k8),xx(1,k9),xx(1,k10),
     .   ya(1,k1),ya(1,k2),ya(1,k3),ya(1,k4),yy(1,k5),
     .   yy(1,k6),yy(1,k7),yy(1,k8),yy(1,k9),yy(1,k10),
     .   yy(1,k8),yy(1,k9),yy(1,k10),
     .   za(1,k1),za(1,k2),za(1,k3),za(1,k4),zz(1,k5),
     .   zz(1,k6),zz(1,k7),zz(1,k8),zz(1,k9),zz(1,k10),
     .   zz(1,k8),zz(1,k9),zz(1,k10),
     .   px(1,k1,ip) ,px(1,k2,ip),px(1,k3,ip),px(1,k4,ip),px(1,k5,ip),
     .   px(1,k6,ip) ,px(1,k7,ip),px(1,k8,ip),px(1,k9,ip),px(1,k10,ip),
     .   py(1,k1,ip) ,py(1,k2,ip),py(1,k3,ip),py(1,k4,ip),py(1,k5,ip),
     .   py(1,k6,ip) ,py(1,k7,ip),py(1,k8,ip),py(1,k9,ip),py(1,k10,ip),
     .   pz(1,k1,ip) ,pz(1,k2,ip),pz(1,k3,ip),pz(1,k4,ip),pz(1,k5,ip),
     .   pz(1,k6,ip) ,pz(1,k7,ip),pz(1,k8,ip),pz(1,k9,ip),pz(1,k10,ip),
     .   vol ,voldp,nel)
      ENDIF
C
      RETURN