sphtri0.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "sphcom.inc"
#include "task_c.inc"
#include "timeri_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	sphtri0 (timers, x, spbuf, kxsp, wsp2sort, bminma, dmax, nsp2sortf, nsp2sortl, nmn, itask, dbuc)

Function/Subroutine Documentation

sphtri0()

subroutine sphtri0	(	type(timer_), intent(inout)	timers,
			x,
			spbuf,
		integer, dimension(nisp,*)	kxsp,
		integer, dimension(*)	wsp2sort,
			bminma,
			dmax,
		integer	nsp2sortf,
		integer	nsp2sortl,
		integer	nmn,
		integer	itask,
			dbuc )

Definition at line 40 of file sphtri0.F.

C============================================================================
C   M o d u l e s
C-----------------------------------------------
      USE spmd_mod, ONLY : spmd_barrier
      USE timer_mod
      USE tri7box
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "sphcom.inc"
#include      "task_c.inc"
#include      "timeri_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(TIMER_), INTENT(INOUT) :: TIMERS
      INTEGER KXSP(NISP,*), WSP2SORT(*),NSP2SORTF,NSP2SORTL,ITASK,NMN
      my_real x(3,*),spbuf(nspbuf,*), bminma(12),  dmax, dbuc
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N, J, NS,LOC_PROC
      my_real xmax,ymax,zmax,xmin,ymin,zmin,dbucl,mx,my,mz,dx,dy,dz,sx,sy,sz,sx2,sy2,sz2
     
C-----------------------------------------------
      xmin=ep30
      xmax=-ep30
      ymin=ep30
      ymax=-ep30
      zmin=ep30
      zmax=-ep30     
      sx=zero
      sy=zero
      sz=zero
      sx2=zero
      sy2=zero
      sz2=zero
C        
C
C        Bucket sort. DBUC + MIN / MAX
 
      dbucl=zero
      DO ns=nsp2sortf,nsp2sortl
        n=wsp2sort(ns)
        dbucl=max(dbucl,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))
        sx=sx+x(1,j)
        sy=sy+x(2,j)
        sz=sz+x(3,j)
        sx2=sx2+x(1,j)**2
        sy2=sy2+x(2,j)**2
        sz2=sz2+x(3,j)**2
      END DO
 
      IF(itask == 0)THEN
         bminma(7:12)=0
         bminma(1)=-ep30
         bminma(2)=-ep30
         bminma(3)=-ep30
         bminma(4)=ep30
         bminma(5)=ep30
         bminma(6)=ep30
         dbuc = zero
      ENDIF
 
      CALL my_barrier
 
#include "lockon.inc"
      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)
      dbuc = max(dbuc,dbucl) 
      dmax = dbuc
      bminma(7) = bminma(7)+sx
      bminma(8) = bminma(8)+sy
      bminma(9) = bminma(9)+sz
      bminma(10)= bminma(10)+sx2
      bminma(11)= bminma(11)+sy2
      bminma(12)= bminma(12)+sz2
#include "lockoff.inc"
C
      CALL my_barrier
 
!$OMP SINGLE
        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   Computation of standard deviation of X main
C   use the formula dev = sum(xi  )-n.m  
C   mean value m by direction
        mx=bminma(7)/max(nmn,1)
        my=bminma(8)/max(nmn,1)
        mz=bminma(9)/max(nmn,1)
c          print*,noint,'m=',mx,my,mz,NMN,NRTM
C   standard deviation by direction
        dx=sqrt(bminma(10)/max(nmn,1)-mx**2)
        dy=sqrt(bminma(11)/max(nmn,1)-my**2)
        dz=sqrt(bminma(12)/max(nmn,1)-mz**2)
c          print*,noint,'var=',dx,dy,dz
C   Computation of new boundary of the domain mean values +/- 2 sigma
C   => 95% of the population for normal distribution
        bminma(7) =min(mx+2*dx,bminma(1))
        bminma(8) =min(my+2*dy,bminma(2))
        bminma(9) =min(mz+2*dz,bminma(3))
        bminma(10)=max(mx-2*dx,bminma(4))
        bminma(11)=max(my-2*dy,bminma(5))
        bminma(12)=max(mz-2*dz,bminma(6))
   
C   Test cas particulier 2D
        IF(bminma(10)==bminma(7))THEN
          bminma(10)=bminma(4)
          bminma(7)=bminma(1)
        END IF
        IF(bminma(11)==bminma(8))THEN
          bminma(11)=bminma(5)
          bminma(8)=bminma(2)
        END IF
        IF(bminma(12)==bminma(9))THEN
          bminma(12)=bminma(6)
          bminma(9)=bminma(3)
        END IF
!$OMP END SINGLE
                
 
      IF(nspmd>1) THEN
C
C     Boite   MIN / MAX en SPMD
C
        IF(itask==0) THEN
          loc_proc = ispmd+1
          crvoxel(0:lrvoxel,0:lrvoxel,loc_proc)=0
        ENDIF
 
        CALL my_barrier
 
        CALL spmd_sphvox0(kxsp ,spbuf,wsp2sort,bminma,x,
     2                    nsp2sortf,nsp2sortl)
 
        CALL my_barrier
 
        IF(itask==0)THEN
C
         IF(imonm == 2)THEN
           CALL startime(timers,95)
           CALL spmd_barrier()
           CALL stoptime(timers,95)
         END IF
         CALL startime(timers,91)
C Recuperation des cellules SPH remotes NSPHR stockees dans XSPHR
C 
         CALL spmd_sphvox(kxsp ,spbuf,wsp2sort,bminma,x)
         CALL spmd_all_dmax(dmax,1)
C
         CALL stoptime(timers,91)
        ENDIF
 
      END IF 
  
      CALL my_barrier
C
      RETURN