sptri.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "sphcom.inc"
#include "buckr_c.inc"

Go to the source code of this file.

Modules
module	mod_sptri

Functions/Subroutines
subroutine	sptri (kxsp, ixsp, nod2sp, x, spbuf, lprtsph, lonfsph, ipartsp, sz_intp_dist, max_intp_dist_part, pre_search)

Variables
integer, dimension(:), allocatable	mod_sptri::wreduce

Function/Subroutine Documentation

sptri()

subroutine sptri	(	integer, dimension(nisp,*)	kxsp,
		integer, dimension(kvoisph,*)	ixsp,
		integer, dimension(*)	nod2sp,
			x,
			spbuf,
		integer, dimension(2,0:npart)	lprtsph,
		integer, dimension(*)	lonfsph,
		integer, dimension(numsph), intent(in)	ipartsp,
		integer, intent(in)	sz_intp_dist,
		dimension(sz_intp_dist), intent(inout)	max_intp_dist_part,
		integer, intent(in)	pre_search )

Definition at line 48 of file sptri.F.

C-----------------------------------------------
      USE message_mod
      USE mod_sptri
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      "com04_c.inc"
#include      "sphcom.inc"
#include      "buckr_c.inc"
C-----------------------------------------------
C     PRE_SEARCH = 0 -> full search of neigbours 
C     PRE_SEARCH = 1 -> pre-search of neigbours for computation of max interparticle dist 
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER KXSP(NISP,*), IXSP(KVOISPH,*), NOD2SP(*),
     .        LPRTSPH(2,0:NPART) ,LONFSPH(*)
      INTEGER ,INTENT(IN) :: IPARTSP(NUMSPH),PRE_SEARCH,SZ_INTP_DIST
      my_real
     .        spbuf(nspbuf,*), x(3,*)
      my_real ,INTENT(INOUT) :: max_intp_dist_part(sz_intp_dist)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N,J,K, IREDUCE, NVOIS, IERROR,JVOIS(NUMSPH), JSTOR(NUMSPH), JPERM(NUMSPH)
      INTEGER NS, WASPACT(NUMSPH), IPRT
      my_real dvois(numsph), bminma(6), myspatrue,xmax, ymax, zmax
C-----------------------------------------------
      nvois = 0
C-----------------------------------------------      
      ALLOCATE(wreduce(numsph),stat=ierror)
      IF(ierror/=0) THEN
        CALL ancmsg(msgid=19,msgtype=msgerror,anmode=aninfo,
     .              c1='(SPH)')
        CALL arret(2)
      END IF
      ireduce=0
      wreduce(1:numsph)=0
C-----------------------------------------------      
      IF(nsphio==0)THEN
        nsphact=0
        DO n=1,numsph
          IF(kxsp(2,n)/=0)THEN
            nsphact=nsphact+1
            waspact(nsphact)=n
          ENDIF
        ENDDO
      ELSE
        nsphact=0
        DO iprt=1,npart
          DO k=lprtsph(2,iprt-1)+1,lprtsph(1,iprt)
           nsphact=nsphact+1
           waspact(nsphact)=lonfsph(k)
          ENDDO
        ENDDO
      END IF
C
      DO ns=1,nsphact
        n=waspact(ns)
        kxsp(5,n)=0
      END DO
C-----------------------------------------------
      bminma(1) = -ep30
      bminma(2) = -ep30 
      bminma(3) = -ep30
      bminma(4) =  ep30
      bminma(5) =  ep30
      bminma(6) =  ep30
C
      xmin=ep30
      xmax=-ep30
      ymin=ep30
      ymax=-ep30
      zmin=ep30
      zmax=-ep30     
C
C        Bucket sort. DBUC + MIN / MAX
C
      dbuc=zero
      DO ns=1,nsphact
        n=waspact(ns)
        dbuc=max(dbuc,spbuf(1,n))
C
        j=kxsp(3,n)
        xmin= min(xmin,x(1,j))
        ymin= min(ymin,x(2,j))
        zmin= min(zmin,x(3,j))
        xmax= max(xmax,x(1,j))
        ymax= max(ymax,x(2,j))
        zmax= max(zmax,x(3,j))
      END DO
C
      bminma(1) = max(bminma(1),xmax) 
      bminma(2) = max(bminma(2),ymax) 
      bminma(3) = max(bminma(3),zmax) 
      bminma(4) = min(bminma(4),xmin) 
      bminma(5) = min(bminma(5),ymin) 
      bminma(6) = min(bminma(6),zmin)
C
      dbuc=dbuc*sqrt(one +spatrue)*onep0001
      bminma(1) = bminma(1)+dbuc
      bminma(2) = bminma(2)+dbuc
      bminma(3) = bminma(3)+dbuc
      bminma(4) = bminma(4)-dbuc
      bminma(5) = bminma(5)-dbuc
      bminma(6) = bminma(6)-dbuc
C-----------------------------------------------
      CALL spbuc31(x      ,kxsp  ,ixsp  ,nod2sp,
     .             spbuf  ,waspact,jvois,jstor ,jperm  ,
     .             dvois  ,ireduce,wreduce,bminma,ipartsp ,
     .             sz_intp_dist,max_intp_dist_part,pre_search)
C-----------------------------------------------
C     re-tri voisins (voisins vrais, voisins dans la zone de securite).
C
      IF (pre_search==0) THEN
      myspatrue=spatrue
C     /---------------/
C      CALL MY_BARRIER
C     /---------------/
      CALL spclasv(x     ,spbuf ,kxsp    ,ixsp   ,nod2sp   ,
     1             waspact,myspatrue,ireduce,wreduce)
C     /---------------/
C      CALL MY_BARRIER
C     /---------------/
      IF(myspatrue<spatrue)spatrue=myspatrue
      ELSE     
        DEALLOCATE(wreduce)       
      ENDIF
 
      RETURN