amass3p.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "inter22.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	amass3p (fskym, rho, volgp, tag22, volu, iads, off, ixs, nel, nft, jeul)

Function/Subroutine Documentation

amass3p()

subroutine amass3p	(		fskym,
			rho,
			volgp,
			tag22,
			volu,
		integer, dimension(8,*)	iads,
			off,
		integer, dimension(nixs,*)	ixs,
		integer, intent(in)	nel,
		integer, intent(in)	nft,
		integer, intent(in)	jeul )

Definition at line 34 of file amass3p.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE i22bufbric_mod 
      use element_mod , only : nixs
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      "inter22.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER, INTENT(IN) :: NFT
      INTEGER, INTENT(IN) :: JEUL
      my_real
     .   fskym(*), rho(*),volu(*),volgp(lveul,*), off(*),tag22(*)
      INTEGER IADS(8,*),IXS(NIXS,*)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,IFLAG,II, K, NIN, NCELL, ICELL, IB, J,MCELL
      my_real tnod(mvsiz,8)      
      my_real dmass(mvsiz),fac
C-----------------------------------------------
      iflag=integ8*jeul
      nin = 1
      fac = zero
 
      !--------------------------------------------------------------------------!
      ! COMPUTE ELEMENTARY MASS AND ITS DISTRIBUTION ON NODES.                   !
      ! FOR CUT CELL TNOD(1:8,I) ENABLE TO DISTRIBUTE MASS TO RELATED NODES ONLY !
      !--------------------------------------------------------------------------!
      IF(iflag/=1)THEN
        IF(int22==0)THEN  
        !DEFAULT FORMULATION    
         tnod(1:nel,1:8) = one
         DO  i=1,nel
          dmass(i)=one_over_8*rho(i)*volu(i)*off(i)
         ENDDO
         !INTERFACE 22 : CUT CELLS
        ELSE
         DO i=1,nel
          ib = nint(tag22(i))
          IF(ib>0)THEN
            ncell = brick_list(nin,ib)%NBCUT
            IF(ncell==0)THEN
              tnod(i,1:8) = one
              dmass(i)=one_over_8*rho(i)*volu(i)*off(i)
              cycle
            ENDIF
            tnod(i,1:8) = zero
            mcell = brick_list(nin,ib)%mainID
            IF(mcell==0)cycle ! next Main Cell            
            fac = brick_list(nin,ib)%POLY(mcell)%NumNOD
            IF(fac>0)THEN
              fac=one/fac
              DO j=1,8                                                                                        
                icell=brick_list(nin,ib)%NODE(j)%WhichCell                                                    
                IF(icell/=mcell)cycle                                                                         
                tnod(i,j) = one                                              !this node is used by polyhedron  
              ENDDO               
            ELSE
              fac = zero
            ENDIF                                                                                          
          ELSE
            fac = one_over_8 
            tnod(i,1:8) = one                                                !uncut cell distributes centroid mass to all 8 nodes
          ENDIF
          dmass(i)=fac*rho(i)*volu(i)*off(i)
         ENDDO
        ENDIF      
      endif!IFLAG=1
 
 
      
      !---------------------------------------------!
      ! NODAL MASS : ELEMENTARY MASS IS DISTRIBUTED !
      !---------------------------------------------!      
      IF(iflag==1)THEN
       tnod(1:nel,1:8) = one       
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(1,i)*off(i)
       ENDDO
      ENDIF      
      DO i=1,nel
        ii = i +nft
        k = iads(1,ii)
        fskym(k)= tnod(i,1)*dmass(i)                                        !by default all nodes are tagged. For cut cells only nodes defining the polyhedron is tagged
      ENDDO
C
      IF(iflag==1)THEN
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(2,i)*off(i)
       ENDDO
      ENDIF
      DO i=1,nel 
        ii = i +nft
        k = iads(2,ii)
        fskym(k)= tnod(i,2)*dmass(i)
      ENDDO
C
      IF(iflag==1)THEN
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(3,i)*off(i)
       ENDDO
      ENDIF
      DO i=1,nel
        ii = i +nft
        k = iads(3,ii)
        fskym(k)= tnod(i,3)*dmass(i)
      ENDDO
C
      IF(iflag==1)THEN
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(4,i)*off(i)
       ENDDO
      ENDIF
      DO i=1,nel
        ii = i +nft
        k = iads(4,ii)
        fskym(k)= tnod(i,4)*dmass(i)
      ENDDO
C
      IF(iflag==1)THEN
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(5,i)*off(i)
       ENDDO
      ENDIF
      DO i=1,nel
        ii = i +nft
        k = iads(5,ii)
        fskym(k)= tnod(i,5)*dmass(i)
      ENDDO
C
      IF(iflag==1)THEN
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(6,i)*off(i)
       ENDDO
      ENDIF
      DO i=1,nel
        ii = i +nft
        k = iads(6,ii)
        fskym(k)= tnod(i,6)*dmass(i)
      ENDDO
C
      IF(iflag==1)THEN
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(7,i)*off(i)
       ENDDO
      ENDIF
      DO i=1,nel
        ii = i +nft
        k = iads(7,ii)
        fskym(k)= tnod(i,7)*dmass(i)
      ENDDO
C
      IF(iflag==1)THEN
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(8,i)*off(i)
       ENDDO
      ENDIF
      DO i=1,nel
        ii = i +nft
        k = iads(8,ii)
        fskym(k)= tnod(i,8)*dmass(i)
      ENDDO
C
      RETURN