h3d_dxyz_rwall_update.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	h3d_dxyz_rwall_update (nstrf, rwbuf, nprw, disp, xmin, ymin, zmin, xmax, ymax, zmax, fr_sec, fr_wall, weight, itab, xwl, ywl, zwl, rwall_v1, rwall_v2, rwall_v3, rwall_v4, rwall_v5, rwall_v6)

Function/Subroutine Documentation

h3d_dxyz_rwall_update()

subroutine h3d_dxyz_rwall_update	(	integer, dimension(*)	nstrf,
			rwbuf,
		integer, dimension(*)	nprw,
			disp,
			xmin,
			ymin,
			zmin,
			xmax,
			ymax,
			zmax,
		integer, dimension(nspmd+1,*)	fr_sec,
		integer, dimension(nspmd+2,*)	fr_wall,
		integer, dimension(*)	weight,
		integer, dimension(*)	itab,
			xwl,
			ywl,
			zwl,
			rwall_v1,
			rwall_v2,
			rwall_v3,
			rwall_v4,
			rwall_v5,
			rwall_v6 )

Definition at line 30 of file h3d_dxyz_rwall_update.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      "param_c.inc"
#include      "com04_c.inc"
#include      "task_c.inc"
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSTRF(*),NPRW(*),ITAB(*)
      my_real
     .  rwbuf(nrwlp,*),disp(3,*),xmin ,ymin ,zmin  ,xmax ,ymax, zmax
      my_real
     .  xwl(*), ywl(*), zwl(*), rwall_v1(*), rwall_v2(*), rwall_v3(*),
     .  rwall_v4(*), rwall_v5(*), rwall_v6(*)
      integer
     .   fr_sec(nspmd+1,*),fr_wall(nspmd+2,*),weight(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER J, I, K, K0, K1, N, NSEG, N1, N2, N3, N4,MSR, ITYP
      my_real
     .   xx1, yy1, zz1, xx2, yy2, zz2, xx3, yy3, zz3,
     .   xx4, yy4, zz4, d13, xxc, yyc, zzc, al4,
     .   pmain,loc_proc, v1, v2, v3, vv1, vv2,
     .   vv3, r, xn,yn,zn,d,dx,dy,dz, vv
 
      my_real
     .   xsec(3,3,nsect)
      REAL R4,SBUF(3*NSECT)
CC-----------------------------------------------
      loc_proc=ispmd+1
C
C
      k=1
      DO n=1,nrwall
        n2=n +nrwall
        n3=n2+nrwall
        n4=n3+nrwall
        msr = nprw(n3)
        IF (nspmd == 1) THEN
          IF(msr==0)THEN
            xwl(n)= zero
            ywl(n)= zero
            zwl(n)= zero
          ELSE
C verifier que ce noeud est sur proc0 !
            xwl(n)=disp(1,msr)
            ywl(n)=disp(2,msr)
            zwl(n)=disp(3,msr)
          ENDIF
        ELSE
          CALL spmd_h3d_getmsr_update(fr_wall(1,n),disp,msr,xwl(n),ywl(n),zwl(n),rwbuf(1,n))
        END IF
        IF (ispmd==0) THEN
          ityp= nprw(n4)
          IF(ityp==4)THEN
           xwl(n) = xwl(n)
           ywl(n) = ywl(n)
           zwl(n) = zwl(n)
          ENDIF
          k=k+nprw(n)
          IF(nprw(n4)==-1)k=k+nint(rwbuf(8,n))
        END IF
      ENDDO
C
      k=1
      DO n=1,nrwall
        n2=n +nrwall
        n3=n2+nrwall
        n4=n3+nrwall
        ityp= nprw(n4)
 
        IF(iabs(ityp)==1)THEN
C
          IF (ispmd==0) THEN
c
            rwall_v1(n) = zero
            rwall_v2(n) = zero
            rwall_v3(n) = zero
            rwall_v4(n) = zero
            rwall_v5(n) = zero
            rwall_v6(n) = zero
          ENDIF
c
        ELSEIF(ityp==2)THEN
C
          IF (ispmd==0) THEN
c
            rwall_v1(n) = zero
            rwall_v2(n) = zero
            rwall_v3(n) = zero
            rwall_v4(n) = zero
            rwall_v5(n) = zero
            rwall_v6(n) = zero
          ENDIF
        ELSEIF(ityp==3)THEN
c
          IF (ispmd==0) THEN
            rwall_v1(n) = zero
            rwall_v2(n) = zero
            rwall_v3(n) = zero
            rwall_v4(n) = zero
            rwall_v5(n) = zero
            rwall_v6(n) = zero
          ENDIF
        ELSEIF(ityp==4)THEN
          IF (ispmd==0) THEN
C
            rwall_v1(n) = zero
            rwall_v2(n) = zero
            rwall_v3(n) = zero
            rwall_v4(n) = zero
            rwall_v5(n) = zero
            rwall_v6(n) = zero
          ENDIF
 
        ENDIF
        k=k+nprw(n)
        IF(nprw(n4)==-1)k=k+nint(rwbuf(8,n))
      ENDDO
C
      RETURN