spinih.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "sphcom.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	spinih (kxsp, ipart, ipartsp, spbuf, pm, ixsp, nod2sp, x, lprtsph, lonfsph, snod2sp, slonfsph, numnod, npart, itab)

Function/Subroutine Documentation

spinih()

subroutine spinih	(	integer, dimension(nisp,*)	kxsp,
		integer, dimension(lipart1,*)	ipart,
		integer, dimension(*)	ipartsp,
			spbuf,
			pm,
		integer, dimension(kvoisph,numsph), intent(inout)	ixsp,
		integer, dimension(snod2sp), intent(inout)	nod2sp,
		dimension(3,numnod), intent(in)	x,
		integer, dimension(2,0:npart), intent(inout)	lprtsph,
		integer, dimension(slonfsph), intent(inout)	lonfsph,
		integer, intent(in)	snod2sp,
		integer, intent(in)	slonfsph,
		integer, intent(in)	numnod,
		integer, intent(in)	npart,
		integer, dimension(*)	itab )

Definition at line 33 of file spinih.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE my_alloc_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "param_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,*), IPART(LIPART1,*), IPARTSP(*),ITAB(*)
      INTEGER ,INTENT(IN) :: SNOD2SP,SLONFSPH,NUMNOD,NPART
      INTEGER ,INTENT(INOUT) :: IXSP(KVOISPH,NUMSPH),NOD2SP(SNOD2SP),LPRTSPH(2,0:NPART),
     .                          LONFSPH(SLONFSPH)
      my_real
     .        spbuf(nspbuf,*),pm(npropm,*)
      my_real ,INTENT(IN) :: x(3,numnod)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N,IPRT,I0,IMAT,PRE_SEARCH,FLG_H,J,NS,NBNOD(NPART),SZ_INTP_DIST
      my_real, DIMENSION(:), ALLOCATABLE :: max_intp_dist_part   ! Max of interparticle distance per part
      my_real
     .        dist, mp, rho, vol, sq2
C-----------------------------------------------
      my_real
     .        get_u_geo,h_scal,vol_tot,reset_u_geo
      my_real
     .        xmin(npart),xmax(npart),ymin(npart),ymax(npart),zmin(npart),
     .        zmax(npart),volp_prt(npart)  
C-----------------------------------------------
      pre_search = 0
      sq2 = sqrt(two)
C
      volp_prt(1:npart)=zero
      nbnod(1:npart)=0
      xmin(1:npart)=ep30
      xmax(1:npart)=-ep30
      ymin(1:npart)=ep30
      ymax(1:npart)=-ep30
      zmin(1:npart)=ep30
      zmax(1:npart)=-ep30 
C      
      DO n = 1, numsph
        iprt=ipartsp(n)
        imat=ipart(1,iprt)
        i0  =ipart(2,iprt)
        dist=get_u_geo(6,i0)           
        IF (nint(spbuf(13,n))==1) THEN
C--       type = 1 - particle with mass input   
          mp  = spbuf(12,n)
          rho=pm(1,imat)
          vol=mp/rho
          dist=(sq2*vol)**third    
        ELSEIF (nint(spbuf(13,n))==2) THEN
C--       type = 2 - particle with volume input          
          vol=spbuf(12,n)
          dist=(sq2*vol)**third             
        ELSE           
C--       type = 0 - particle without mass/vol input            
          IF(dist==zero) THEN
            mp  =get_u_geo(1,i0)
            rho=pm(1,imat)
            vol=mp/rho
            dist=(sq2*vol)**third     
          END IF
        ENDIF  
        spbuf(1,n)=dist
C        
        flg_h=nint(get_u_geo(9,i0))           
        IF (flg_h==3) THEN           
C--       FLG_H=3 - computation of H from interparticle distance - presearch of neigbours needed        
          pre_search = 1  
C--       Approximation of H         
          j=kxsp(3,n) 
          nbnod(iprt)=nbnod(iprt)+1
          xmin(iprt)= min(xmin(iprt),x(1,j))
          ymin(iprt)= min(ymin(iprt),x(2,j))
          zmin(iprt)= min(zmin(iprt),x(3,j))
          xmax(iprt)= max(xmax(iprt),x(1,j))
          ymax(iprt)= max(ymax(iprt),x(2,j))
          zmax(iprt)= max(zmax(iprt),x(3,j))          
        ENDIF  
C        
      END DO
C      
      IF (pre_search == 1) THEN
C       Rough approxiamtion of H per part - only used for presearch (important for SOL2SPH because MP not defined)
        DO iprt = 1, npart
          IF (nbnod(iprt) > 0) THEN  
            vol_tot = abs(xmin(iprt)-xmax(iprt))*abs(ymin(iprt)-ymax(iprt))*abs(zmin(iprt)-zmax(iprt))
            volp_prt(iprt) = vol_tot/nbnod(iprt)
          ENDIF
        END DO 
        DO n=1,numsph
          iprt=ipartsp(n)
          i0  =ipart(2,iprt)
          flg_h=nint(get_u_geo(9,i0))
          IF (flg_h==3) THEN
            dist = volp_prt(iprt)**third
            spbuf(1,n) = min(dist,spbuf(1,n)) 
          ENDIF  
        END DO
C             
        CALL my_alloc(max_intp_dist_part,npart)
        max_intp_dist_part(1:npart) = zero
        sz_intp_dist = npart
c
C       Pre-search of neigbours to define interparticular distance  
        CALL sptri(kxsp    ,ixsp    ,nod2sp  ,x      ,spbuf  ,
     .             lprtsph ,lonfsph ,ipartsp ,sz_intp_dist,max_intp_dist_part,
     .             pre_search)                   
C     
        DO n = 1, numsph
          iprt=ipartsp(n)
          i0  =ipart(2,iprt)    
          flg_h=nint(get_u_geo(9,i0))
C          KXSP(9,N) = FLG_H
          IF (flg_h==3) THEN
            h_scal=get_u_geo(12,i0)
            spbuf(1,n)=h_scal*max_intp_dist_part(iprt)    ! DIamter of the particle 
            spbuf(14,n)=h_scal*max_intp_dist_part(iprt)   ! Diameter of the particle at time zero
          ENDIF  
        END DO     
C
        DEALLOCATE(max_intp_dist_part)
C
      ENDIF
C
      RETURN