s10jaci3.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	s10jaci3 (elbuf_str, sav, npt, nel)

Function/Subroutine Documentation

s10jaci3()

subroutine s10jaci3	(	type(elbuf_struct_), target	elbuf_str,
		double precision, dimension(nel,30), intent(in)	sav,
		integer, intent(in)	npt,
		integer, intent(in)	nel )

Definition at line 32 of file s10jaci3.F.

C-----------------------------------------------
      USE elbufdef_mod            
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 , INTENT(IN) :: NPT,NEL
      DOUBLE PRECISION , DIMENSION(NEL,30),INTENT(IN) :: SAV     
      TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
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
     .   xx(mvsiz,10), yy(mvsiz,10), zz(mvsiz,10)
      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
      my_real
     .   vol(mvsiz,5),nx(mvsiz,10,5),
     .   px(mvsiz,10,5),py(mvsiz,10,5),pz(mvsiz,10,5)
      my_real
     .   alph,beta,w
      TYPE(L_BUFEL_) ,POINTER :: LBUF     
      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-----------------------------------------------
      DO n=1,10
       DO i=1,nel
        xx(i,n) = sav(i,n)   
        yy(i,n) = sav(i,n+10)
        zz(i,n) = sav(i,n+20)
       ENDDO
      END DO 
      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)
        lbuf => elbuf_str%BUFLY(1)%LBUF(ip,1,1)
        CALL s10jacob(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),
     .   nx(1,k1,ip) ,nx(1,k2,ip),nx(1,k3,ip),nx(1,k4,ip),nx(1,k5,ip),
     .   nx(1,k6,ip) ,nx(1,k7,ip),nx(1,k8,ip),nx(1,k9,ip),nx(1,k10,ip),
     .   vol(1,ip)   ,lbuf%VOL0DP)
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
        lbuf => elbuf_str%BUFLY(1)%LBUF(npt,1,1)
        CALL s10jacob(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),
     .   nx(1,k1,ip) ,nx(1,k2,ip),nx(1,k3,ip),nx(1,k4,ip),nx(1,k5,ip),
     .   nx(1,k6,ip) ,nx(1,k7,ip),nx(1,k8,ip),nx(1,k9,ip),nx(1,k10,ip),
     .   vol(1,ip)   ,lbuf%VOL0DP)
      ENDIF
C
       DO ip=1,npt
        lbuf => elbuf_str%BUFLY(1)%LBUF(ip,1,1)
        CALL s10pijsav(px(1,1,ip),py(1,1,ip),pz(1,1,ip),lbuf%PIJ,nel)
        lbuf%VOL(1:nel)=vol(1:nel,ip)
       ENDDO
C
      RETURN
C