spadah.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	spadah (x, v, ms, spbuf, itab, kxsp, ixsp, nod2sp, wa, waspact, itask, ipartsp, ipart)

Function/Subroutine Documentation

spadah()

subroutine spadah	(		x,
			v,
			ms,
			spbuf,
		integer, dimension(*)	itab,
		integer, dimension(nisp,*)	kxsp,
		integer, dimension(kvoisph,*)	ixsp,
		integer, dimension(*)	nod2sp,
			wa,
		integer, dimension(*)	waspact,
		integer	itask,
		integer, dimension(*)	ipartsp,
		integer, dimension(lipart1,*)	ipart )

Definition at line 33 of file spadah.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
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      "com08_c.inc"
#include      "sphcom.inc"
#include      "task_c.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(*),
     .        WASPACT(*),ITASK,IPARTSP(*),IPART(LIPART1,*)      
C     REAL
      my_real
     .   x(3,*) ,v(3,*) ,ms(*) ,spbuf(nspbuf,*) ,wa(kwasph,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N,INOD,NVOIS,NS,IPRT,IPROP,H_FLAG
      my_real
     .       xi,yi,zi,di,divv,coeff,get_u_geo,
     .       hmin,hmax,h_new,di0
C-----------------------------------------------
      EXTERNAL get_u_geo      
C-----------------------------------------------
      DO ns=itask+1,nsphact,nthread
        n=waspact(ns)
        inod =kxsp(3,n)
        nvois=kxsp(4,n)
        xi=x(1,inod)
        yi=x(2,inod)
        zi=x(3,inod)
        di   =spbuf(1,n)
        di0 = spbuf(14,n)
        divv =wa(13,n)
        iprt =ipartsp(n)
        iprop=ipart(2,iprt)
        coeff = get_u_geo(8,iprop)
        h_flag=nint(get_u_geo(9,iprop))
        hmin = get_u_geo(10,iprop)
        hmax = get_u_geo(11,iprop)
C--     H_FLAG = 0 -> 3D dilatation of H : GET_U_GEO(8,IPROP) = 1/3 - HMIN=0 HMAX=EP20
C--     H_FLAG = 1 -> 1D dilatation of H : GET_U_GEO(8,IPROP) = 1   - HMIN=0 HMAX=EP20
C--     H_FLAG = 2 -> Constant H : GET_U_GEO(8,IPROP) = 0           - HMIN=0 HMAX=EP20      
C--     H_FLAG = 3 -> 3D dilatation of H with bounds hmin*h0 < H < hmax*h0     
        h_new=di*(one+divv*dt1*coeff)
        IF (h_flag==3) THEN
          h_new=max(hmin*di0,h_new)
          h_new=min(hmax*di0,h_new)
        ENDIF
        spbuf(1,n)= h_new
        IF(spbuf(1,n)<em20)THEN
          CALL ancmsg(msgid=174,anmode=aninfo,
     .            i1=kxsp(nisp,n))
          CALL arret(2)
        ENDIF
      ENDDO
C-----------------------------------------------
      RETURN