sponfro.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com08_c.inc"
#include "sphcom.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	sponfro (x, v, a, ms, spbuf, itab, kxsp, ixsp, nod2sp, isphio, ipart, ipartsp, waspact, wa_epsd, vnormal, war2)

Function/Subroutine Documentation

sponfro()

subroutine sponfro	(		x,
			v,
			a,
			ms,
			spbuf,
		integer, dimension(*)	itab,
		integer, dimension(nisp,*)	kxsp,
		integer, dimension(kvoisph,*)	ixsp,
		integer, dimension(*)	nod2sp,
		integer, dimension(nisphio,*)	isphio,
		integer, dimension(lipart1,*)	ipart,
		integer, dimension(*)	ipartsp,
		integer, dimension(*)	waspact,
			wa_epsd,
			vnormal,
			war2 )

Definition at line 30 of file sponfro.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE sphbox
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      "com08_c.inc"
#include      "sphcom.inc"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER KXSP(NISP,*),IXSP(KVOISPH,*),NOD2SP(*),ITAB(*),
     .        ISPHIO(NISPHIO,*),IPART(LIPART1,*),IPARTSP(*),WASPACT(*)
      my_real
     .   x(3,*) ,v(3,*) ,a(3,*) ,ms(*) ,spbuf(nspbuf,*) ,
     .   wa_epsd(kwasph,*),vnormal(3,*),war2(9,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NS ,N ,IMPOSE ,INOD ,M ,JNOD ,JMPOSE ,
     .        IPPV ,NP, K, NN, JMPOSE2
      my_real
     .       xi,yi,zi,xj,yj,zj,dmin,dd,
     .       dxx,dxy,dxz,dyx,dyy,dyz,dzx,dzy,dzz,
     .       divv
      LOGICAL lBOOL
C-----------------------------------------------
C     general outlets & silent boundary.
C-------------------------------------------
      DO ns=1,nsphact
       n=waspact(ns)
       impose=kxsp(2,n)/(ngroup+1)
       lbool=.false.
       IF(impose /= 0)THEN
         IF(isphio(1,impose)==2.OR.isphio(1,impose)==3)lbool=.true.
       ENDIF
       IF(lbool)THEN
          inod=kxsp(3,n)
          xi=x(1,inod)
          yi=x(2,inod)
          zi=x(3,inod)
C-------
C         plus proche voisin en amont de l'outlet.
          ippv=0
          dmin=1.e+20
 
          DO  k=1,kxsp(4,n)
 
           jnod=ixsp(k,n)
           IF(jnod>0)THEN          ! particule locale
             m=nod2sp(jnod)
             jmpose=kxsp(2,m)/(ngroup+1)
             lbool=.false.
             IF(jmpose == 0)THEN
               lbool=.true.
             ELSE
               IF(isphio(1,jmpose) == 1)lbool=.true.
             ENDIF
             IF(lbool)THEN
               xj  =x(1,jnod)
               yj  =x(2,jnod)
               zj  =x(3,jnod)
               dd  =(xi-xj)*(xi-xj)+(yi-yj)*(yi-yj)+(zi-zj)*(zi-zj)
               IF(dd<dmin)THEN
                ippv=jnod
                dmin=dd
               ENDIF
             ENDIF
           ELSE
             nn = -jnod
             jmpose = nint(xsphr(12,nn))
             IF(jmpose>0)THEN
               jmpose2=isphio(1,jmpose)
             ELSE
               jmpose2=0
             ENDIF
             IF(jmpose2==0.OR.jmpose2==1)THEN
               xj  =xsphr(3,nn)
               yj  =xsphr(4,nn)
               zj  =xsphr(5,nn)
               dd  =(xi-xj)*(xi-xj)+(yi-yj)*(yi-yj)+(zi-zj)*(zi-zj)
               IF(dd<dmin)THEN
                ippv=jnod
                dmin=dd
               ENDIF
             ENDIF  
           ENDIF
          ENDDO
C-------
C         d(rho)/dt=- rho * div(V) utilise div(V) calcule en IPPV.
          IF(ippv>0)THEN
            np=nod2sp(ippv)
            dxx =wa_epsd(1,np)
            dyy =wa_epsd(2,np)
            dzz =wa_epsd(3,np)
            dxy =wa_epsd(4,np)
            dyz =wa_epsd(5,np)
            dxz =wa_epsd(6,np)
            dyx =wa_epsd(7,np)
            dzy =wa_epsd(8,np)
            dzx =wa_epsd(9,np)
          ELSE
c remote neigbourg, get values from SPMD_SPHGETWA
            dxx =war2(1,-ippv)
            dyy =war2(2,-ippv)
            dzz =war2(3,-ippv)
            dxy =war2(4,-ippv)
            dyz =war2(5,-ippv)
            dxz =war2(6,-ippv)
            dyx =war2(7,-ippv)
            dzy =war2(8,-ippv)
            dzx =war2(9,-ippv)
          ENDIF
 
          divv=dxx+dyy+dzz
          spbuf(2,n)=wa_epsd(10,n)*(one - divv*dt1)
          wa_epsd(1,n) =dxx
          wa_epsd(2,n) =dyy
          wa_epsd(3,n) =dzz
          wa_epsd(4,n) =dxy
          wa_epsd(5,n) =dyz
          wa_epsd(6,n) =dxz
          wa_epsd(7,n) =dyx
          wa_epsd(8,n) =dzy
          wa_epsd(9,n) =dzx
          wa_epsd(13,n)=divv
       ENDIF
      ENDDO
C-------------------------------------------
      RETURN