s10volnod3.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "scr05_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	s10volnod3 (volnod6, x, nc, offg, volg, xdp, nel, npt, ismstr)

Function/Subroutine Documentation

s10volnod3()

subroutine s10volnod3	(	double precision, dimension(6,2*numnod)	volnod6,
			x,
		integer, dimension(mvsiz,10)	nc,
			offg,
			volg,
		double precision, dimension(3,sxdp/3), intent(in)	xdp,
		integer	nel,
		integer, intent(in)	npt,
		integer, intent(in)	ismstr )

Definition at line 31 of file s10volnod3.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"
#include      "param_c.inc"
#include      "com04_c.inc"
#include      "scr05_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NPT
      INTEGER, INTENT(IN) :: ISMSTR
      INTEGER NEL,NC(MVSIZ,10)
      double precision
     .   volnod6(6,2*numnod)
C     REAL
      my_real
     .   x(3,numnod),offg(nel)
      DOUBLE PRECISION , DIMENSION(3,SXDP/3), INTENT(IN) :: XDP     
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, K,N1,N2,NN,N
      INTEGER IP,K1,K2,K3,K4,K5,K6,K7,K8,K9,K10
      INTEGER IPERM1(10),IPERM2(10),IPERM(10,4)
      DATA iperm1/0,0,0,0,1,2,3,1,2,3/
      DATA iperm2/0,0,0,0,2,3,1,4,4,4/
      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/
 
      double precision
     .   xx(mvsiz,10), yy(mvsiz,10), zz(mvsiz,10), 
     .   xa(mvsiz,10),ya(mvsiz,10),za(mvsiz,10),
     .   xb(mvsiz,10),yb(mvsiz,10),zb(mvsiz,10),
     .   a4,b4,a4m1,b4m1,aa,det6(6,mvsiz),voldp(mvsiz)
      my_real
     .   volg(mvsiz),alph,beta,w
C----------------------------
C     NODAL COORDINATES     
C----------------------------
      IF (ismstr==1.OR.ismstr==11) RETURN
C----------------------------
      IF(iresp == 1) THEN
        DO n=1,10
          DO i=1,nel               
            nn = max(1,nc(i,n))    
            xx(i,n)=xdp(1,nn)          
            yy(i,n)=xdp(2,nn)          
            zz(i,n)=xdp(3,nn)          
          ENDDO                      
        ENDDO
      ELSE
        DO n=1,10
          DO i=1,nel               
            nn = max(1,nc(i,n))    
            xx(i,n)=x(1,nn)          
            yy(i,n)=x(2,nn)          
            zz(i,n)=x(3,nn)          
          ENDDO                      
        ENDDO
      END IF !(IRESP == 1) THEN
C
      DO n=5,10
        n1=iperm1(n)
        n2=iperm2(n)
        DO i=1,nel
          IF(nc(i,n)==0)THEN
            xx(i,n) = half*(xx(i,n1)+xx(i,n2))
            yy(i,n) = half*(yy(i,n1)+yy(i,n2))
            zz(i,n) = half*(zz(i,n1)+zz(i,n2))
          ENDIF
        ENDDO
      ENDDO
C      NPT =4      
      alph = zep5854102
      beta  = zep1381966
      w = fourth
      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
      volg(1:nel) =zero
      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 s10volj(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),
     .   voldp,nel)
c     
         volg(1:nel) =volg(1:nel) + voldp(1:nel)
      ENDDO
      DO i=1,nel
       IF (offg(i) == zero .OR. abs(offg(i))>one) THEN
         volg(i)= zero
       ENDIF
      ENDDO
 
      !Parith-On treatment
      CALL foat_to_6_float(1  ,nel  ,volg ,det6 )
 
      DO i=1,nel
C----------------------------------
C VOLUME <0 SERA TESTE DANS S4DERI3
C----------------------------------
        !Parith-On treatment
        DO k=1,6
          volnod6(k,nc(i,1)) = volnod6(k,nc(i,1)) + det6(k,i)
          volnod6(k,nc(i,2)) = volnod6(k,nc(i,2)) + det6(k,i)
          volnod6(k,nc(i,3)) = volnod6(k,nc(i,3)) + det6(k,i)
          volnod6(k,nc(i,4)) = volnod6(k,nc(i,4)) + det6(k,i)
        ENDDO
      ENDDO
C
      RETURN