daaacc.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    daaacc        ../engine/source/fluid/daaacc.F
!||--- called by ------------------------------------------------------
!||    flow1         ../engine/source/fluid/flow1.F
!||--- calls      -----------------------------------------------------
!||    spmd_fl_sum   ../engine/source/mpi/generic/spmd_fl_sum.F
!||====================================================================
      SUBROUTINE daaacc(NDIM, NNO, NEL, IFLOW, IBUF, ELEM, IBUFL, CNP, A, NORMAL, ACCF)
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
      END