sphtri.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "sphcom.inc"
#include "param_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	sphtri (x, spbuf, kxsp, ixsp, nod2sp, ireduce, wsp2sort, bminma, nsp2sortf, nsp2sortl, itask, kreduce, lgauge, gauge)

Function/Subroutine Documentation

sphtri()

subroutine sphtri	(		x,
			spbuf,
		integer, dimension(nisp,*)	kxsp,
		integer, dimension(kvoisph,*)	ixsp,
		integer, dimension(*)	nod2sp,
		integer	ireduce,
		integer, dimension(*)	wsp2sort,
			bminma,
		integer	nsp2sortf,
		integer	nsp2sortl,
		integer	itask,
		integer, dimension(*)	kreduce,
		integer, dimension(3,*)	lgauge,
			gauge )

Definition at line 32 of file sphtri.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      "com04_c.inc"
#include      "sphcom.inc"
#include      "param_c.inc"
#include      "task_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(*), WSP2SORT(*),
     .        IREDUCE,NSP2SORTF,NSP2SORTL,ITASK, KREDUCE(*),
     .        LGAUGE(3,*)
      my_real x(3,*),spbuf(nspbuf,*), bminma(12), gauge(llgauge,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NSN,IG
      INTEGER N, INOD, NS
      INTEGER MWA(15*(NUMSPH+NSPHR)), JVOIS(NUMSPH+NSPHR), JSTOR(NUMSPH+NSPHR), JPERM(NUMSPH+NSPHR)
      my_real dvois(numsph+nsphr)
C-----------------------------------------------
         nsn=0
         DO ns=1,nsp2sort
           n=wsp2sort(ns)
           nsn=nsn+1
           mwa(nsn) =n
           kxsp(5,n)=0
         END DO
C
         DO ig=1,nbgauge
           kxsp(5,numsph+ig)=0
         END DO
C
         DO ns = 1, nsphr                ! candidats remote SPMD
           nsn=nsn+1
           mwa(nsn)=numsph+ns
         END DO
C--------
         IF (nsp2sort/=0) CALL spbuc3(
     1              x     ,kxsp   ,ixsp  ,nod2sp,nsp2sort,
     2              spbuf ,mwa    ,jvois ,jstor ,jperm  ,
     3              dvois ,ireduce,bminma,nsphr ,nsp2sortf,
     4              nsp2sortl,itask,kreduce,lgauge ,gauge ) 
C
         DO ns=nsp2sortf,nsp2sortl
          n=wsp2sort(ns)
          inod=kxsp(3,n)
          spbuf(5,n)=x(1,inod)
          spbuf(6,n)=x(2,inod)
          spbuf(7,n)=x(3,inod)
          spbuf(8,n)=spbuf(1,n)
         ENDDO
C
         
         DO n=itask+1,nbgauge,nthread
           IF(lgauge(1,n) <= -(numels+1))THEN
             gauge(6,n)=gauge(2,n)
             gauge(7,n)=gauge(3,n)
             gauge(8,n)=gauge(4,n)
           END IF
         END DO
C-----------------------------------------------
      RETURN