alew.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	alew (x, d, v, w, wa, ale_nn_connect, nale, nodft, nodlt, nbrcvois, nbsdvois, lnrcvois, lnsdvois)

Function/Subroutine Documentation

alew()

subroutine alew	(		x,
			d,
			v,
			w,
			wa,
		type(t_connectivity), intent(in)	ale_nn_connect,
		integer, dimension(*)	nale,
		integer	nodft,
		integer	nodlt,
		integer, dimension(*)	nbrcvois,
		integer, dimension(*)	nbsdvois,
		integer, dimension(*)	lnrcvois,
		integer, dimension(*)	lnsdvois )

Definition at line 34 of file alew.F.

C-----------------------------------------------
C     M o d u l e s 
C-----------------------------------------------
      USE ale_connectivity_mod
      USE ale_mod
C-----------------------------------------------
C     D e s c r i p t i o n
C-----------------------------------------------
C     Compute Grid for /ALE/GRID/DONEA
C
C     X,D,V are allocated to SX,SD,DV=3*(NUMNOD_L+NUMVVOIS_L)
C      in grid subroutine it may needed to access nodes which
C      are connected to a remote elem. They are sored in X(1:3,NUMNOD+1:)
C      Consequently X is defined here X(3,SX/3) instead of X(3,NUMNOD) as usually
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"
#include      "com04_c.inc"
#include      "com08_c.inc"
#include      "tabsiz_c.inc"
C-----------------------------------------------
C     D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NALE(*), NODFT, NODLT,
     .     NBRCVOIS(*),NBSDVOIS(*),
     .     LNRCVOIS(*),LNSDVOIS(*)
      my_real x(3,sx/3), d(3,sd/3), v(3,sv/3), w(3,sw/3), wa(3,*)
      TYPE(t_connectivity), INTENT(IN) :: ALE_NN_CONNECT
C-----------------------------------------------
C     L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N, I, NCI, K, J, LENCOM, IAD1, IAD2
      my_real lij, xlagr, fix, fiy, fiz, sli, wix, wiy, wiz, fac,lij2,lijsqr
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
 
      DO n = nodft,nodlt
         wa(1,n)=w(1,n)
         wa(2,n)=w(2,n)
         wa(3,n)=w(3,n)
      ENDDO
 
      CALL my_barrier() !adjacent WA()
C     
C     SPMD EXCHANGE : X, D, WA (X is already OK if INCOMP=0)
C     
      IF(nspmd > 1)THEN
!$OMP SINGLE
         lencom=nbrcvois(nspmd+1)+nbsdvois(nspmd+1)
         CALL spmd_wvois(x,d,wa,nbrcvois,nbsdvois,lnrcvois,lnsdvois,lencom)
!$OMP END SINGLE
 
      END IF
C     
      DO n = nodft,nodlt
         xlagr=min(1,iabs(iabs(nale(n))-2))
         w(1,n)=v(1,n)*xlagr
         w(2,n)=v(2,n)*xlagr
         w(3,n)=v(3,n)*xlagr
      ENDDO
C     
      IF(ale%GRID%ALPHA == zero) THEN
         DO i = nodft,nodlt
            IF(nale(i)  /=  0) THEN
               nci=0
               wix=zero
               wiy=zero
               wiz=zero
               iad1 = ale_nn_connect%IAD_CONNECT(i)
               iad2 = ale_nn_connect%IAD_CONNECT(i + 1) - 1
               DO k = iad1, iad2
                  j = ale_nn_connect%CONNECTED(k)
                  IF (j > 0) THEN
                     nci = nci + 1
                     wix = wix + wa(1,j)
                     wiy = wiy + wa(2,j)
                     wiz = wiz + wa(3,j)
                  ENDIF
               ENDDO
C     
               w(1,i) = wix / nci
               w(2,i) = wiy / nci
               w(3,i) = wiz / nci
            ENDIF
         ENDDO
C     
      ELSE
         DO i = nodft,nodlt
            IF(nale(i)  /=  0) THEN
               nci=0
               fix=zero
               fiy=zero
               fiz=zero
               sli=zero
               wix=zero
               wiy=zero
               wiz=zero
               iad1 = ale_nn_connect%IAD_CONNECT(i)
               iad2 = ale_nn_connect%IAD_CONNECT(i + 1) - 1
               DO k = iad1, iad2
                  j = ale_nn_connect%CONNECTED(k)
                  IF (j > 0) THEN
                     nci = nci + 1
                     lij2= (x(1,j)-x(1,i))*(x(1,j)-x(1,i))+ (x(2,j)-x(2,i))*(x(2,j)-x(2,i))+ (x(3,j)-x(3,i))*(x(3,j)-x(3,i))
                     lijsqr = sqrt(lij2)
                     lij=max(em20,lijsqr)
                     IF(lij < ep20) THEN
                        sli=sli+lij
                        fix=fix+(d(1,j)-d(1,i))/lij
                        fiy=fiy+(d(2,j)-d(2,i))/lij
                        fiz=fiz+(d(3,j)-d(3,i))/lij
                     ENDIF
                     wix=wix+wa(1,j)
                     wiy=wiy+wa(2,j)
                     wiz=wiz+wa(3,j)
                  ENDIF
               ENDDO
C     
               fac=ale%GRID%ALPHA*sli/(nci*nci*dt2)
               w(1,i) = wix/nci + fac*fix
               w(2,i) = wiy/nci + fac*fiy
               w(3,i) = wiz/nci + fac*fiz
C     
            ENDIF
         ENDDO
      ENDIF
C     
      IF(ale%GRID%GAMMA < eighty19)THEN
         DO i = nodft,nodlt
            IF(nale(i)  /=  0) THEN
               IF(v(1,i) /= zero) w(1,i)=ale%GRID%VGX*v(1,i)*max((one-ale%GRID%GAMMA), min((one+ale%GRID%GAMMA),w(1,i)/v(1,i)))
               IF(v(2,i) /= zero) w(2,i)=ale%GRID%VGY*v(2,i)*max((one-ale%GRID%GAMMA), min((one+ale%GRID%GAMMA),w(2,i)/v(2,i)))
               IF(v(3,i) /= zero) w(3,i)=ale%GRID%VGZ*v(3,i)*max((one-ale%GRID%GAMMA), min((one+ale%GRID%GAMMA),w(3,i)/v(3,i)))
            ENDIF
         ENDDO
      ENDIF
C     
      RETURN