daaacc.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	daaacc (ndim, nno, nel, iflow, ibuf, elem, ibufl, cnp, a, normal, accf)

Function/Subroutine Documentation

daaacc()

subroutine daaacc	(	integer	ndim,
		integer	nno,
		integer	nel,
		integer, dimension(*)	iflow,
		integer, dimension(*)	ibuf,
		integer, dimension(ndim,*)	elem,
		integer, dimension(*)	ibufl,
		integer, dimension(*)	cnp,
			a,
			normal,
			accf )

Definition at line 30 of file daaacc.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NDIM, NNO, NEL, IFLOW(*), IBUF(*), ELEM(NDIM,*), IBUFL(*), CNP(*)
      my_real a(3,*), normal(3,*), accf(nel)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  I, K, N, N1, N2, N3, N4
      INTEGER  II, JJ, KK, JFORM, NNO_L, LENBUF
      my_real  ax, ay, az, wi(4,2), pm1
      my_real  al(3,nno)
      my_real, ALLOCATABLE :: sbuf(:), rbuf(:)
C
      jform = iflow(4)
C Accelerations locales SPMD
      IF (nspmd == 1) THEN
         DO i=1,nno
            ii=ibuf(i)
            al(1,i)=a(1,ii)
            al(2,i)=a(2,ii)
            al(3,i)=a(3,ii)
         ENDDO
      ELSE
         nno_l = iflow(16)
         lenbuf=3*nno
         ALLOCATE(sbuf(lenbuf), rbuf(lenbuf))
         sbuf(1:lenbuf)=zero
         rbuf(1:lenbuf)=zero
         DO i=1,nno_l
            ii=ibufl(i)
            jj=ibuf(ii)
            kk=3*(ii-1)
            sbuf(kk+1)=a(1,jj)/cnp(ii)
            sbuf(kk+2)=a(2,jj)/cnp(ii)
            sbuf(kk+3)=a(3,jj)/cnp(ii)
         ENDDO
 
         CALL spmd_fl_sum(sbuf, lenbuf, rbuf)
 
         DO i=1,nno
            k=3*(i-1)
            al(1,i)=rbuf(k+1)
            al(2,i)=rbuf(k+2)
            al(3,i)=rbuf(k+3)
         ENDDO
         DEALLOCATE(sbuf, rbuf)
      ENDIF
 
      IF(jform == 1) THEN
        DO i = 1,nel
          n1 = elem(1,i)
          n2 = elem(2,i)
          n3 = elem(3,i)
          ax = third * (al(1,n1) + al(1,n2) + al(1,n3))
          ay = third * (al(2,n1) + al(2,n2) + al(2,n3))
          az = third * (al(3,n1) + al(3,n2) + al(3,n3))
          accf(i) = ax*normal(1,i)+ay*normal(2,i)+az*normal(3,i)
        ENDDO
      ELSEIF(jform == 2) THEN
        wi(1,1)=fourth
        wi(2,1)=fourth
        wi(3,1)=fourth
        wi(4,1)=fourth
        wi(1,2)=third
        wi(2,2)=third
        wi(3,2)=one_over_6
        wi(4,2)=one_over_6    
        DO i = 1,nel
          n1 = elem(1,i)
          n2 = elem(2,i)
          n3 = elem(3,i)
          n4 = elem(4,i)
          k  = elem(5,i)
          ax = wi(1,k)*al(1,n1)+wi(2,k)*al(1,n2)+wi(3,k)*al(1,n3)+wi(4,k)*al(1,n4)
          ay = wi(1,k)*al(2,n1)+wi(2,k)*al(2,n2)+wi(3,k)*al(2,n3)+wi(4,k)*al(2,n4)
          az = wi(1,k)*al(3,n1)+wi(2,k)*al(3,n2)+wi(3,k)*al(3,n3)+wi(4,k)*al(3,n4)
          accf(i) = ax*normal(1,i)+ay*normal(2,i)+az*normal(3,i)
        ENDDO
      ENDIF
C    
      RETURN