spmd_anim_ply_xyznor.F File Reference

#include "implicit_f.inc"
#include "spmd.inc"
#include "com01_c.inc"
#include "scr14_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	spmd_anim_ply_xyznor (nodglob, iply, xnorm, empsizpl)

Function/Subroutine Documentation

spmd_anim_ply_xyznor()

subroutine spmd_anim_ply_xyznor	(	integer, dimension(*)	nodglob,
		integer	iply,
			xnorm,
		integer	empsizpl )

Definition at line 33 of file spmd_anim_ply_xyznor.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE plyxfem_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
        USE spmd_comm_world_mod, ONLY : spmd_comm_world
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   M e s s a g e   P a s s i n g
C-----------------------------------------------
#include "spmd.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "scr14_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NODGLOB(*)
      INTEGER IPLY,IDPLY,EMPSIZPL
      my_real
     .   xnorm(3,*)
      REAL R4
C-----------------------------------------------
C   L O C A L   V A R I A B L E S
C-----------------------------------------------
#ifdef MPI
      INTEGER MSGOFF,MSGOFF2,STAT(MPI_STATUS_SIZE,NSPMD-1), IERR
      INTEGER I,N,ND,EMPL,P,ITAG,INORM(3),K,IXNN
 
      INTEGER PLYSIZ
      my_real
     .   s3000,s
C
      INTEGER, DIMENSION(:,:), ALLOCATABLE :: WRTBUF
      INTEGER, DIMENSION(:,:), ALLOCATABLE :: FSENDBUF,FRECBUF
      INTEGER, DIMENSION(:), ALLOCATABLE :: ISENDBUF,IRECBUF
C-----------------------------------------------
      DATA msgoff/7058/
      DATA msgoff2/7059/
C-----------------------------------------------
      s3000 = three1000
      ixnn = s3000
      IF(fmt_ani==4)ixnn=0
C
      IF (ispmd ==0) THEN
        plysiz  = plynod(iply)%PLYNUMNODS
        ALLOCATE(wrtbuf(3,plysizg(iply)))
 
C Les plynods du proc 0
        DO nd=1,plysiz
             i = plynod(iply)%NODES(nd)
             empl =  plynod(iply)%PLYNODID(nd)-empsizpl
 
             s = sqrt(xnorm(1,i)**2 + xnorm(2,i)**2 + xnorm(3,i)**2)
             IF(s/=zero)THEN
                s = s3000 / s
                inorm(1) = xnorm(1,i) * s
                inorm(2) = xnorm(2,i) * s
                inorm(3) = xnorm(3,i) * s
             ELSE
                inorm(1) = 0
                inorm(2) = 0
                inorm(3) = ixnn
             END IF
 
             wrtbuf(1,empl)= inorm(1)
             wrtbuf(2,empl)= inorm(2)
             wrtbuf(3,empl)= inorm(3)
        END DO
C Les plynods des autres procs
           DO p=2,nspmd
              ALLOCATE(irecbuf(plyiadnod(iply,p)))
              ALLOCATE(frecbuf(3,plyiadnod(iply,p)))
 
              itag=msgoff
 
              CALL mpi_recv(irecbuf,plyiadnod(iply,p), mpi_integer,
     .                      it_spmd(p),itag, spmd_comm_world, stat, ierr)
 
              itag=msgoff2
              CALL mpi_recv(frecbuf,plyiadnod(iply,p)*3, mpi_integer,
     .                      it_spmd(p),itag, spmd_comm_world, stat, ierr)
 
              DO i=1,plyiadnod(iply,p)
                 empl = irecbuf(i)-empsizpl
                 wrtbuf(1,empl)=frecbuf(1,i)
                 wrtbuf(2,empl)=frecbuf(2,i)
                 wrtbuf(3,empl)=frecbuf(3,i)
              ENDDO
              DEALLOCATE(irecbuf,frecbuf)
           ENDDO
 
           CALL write_s_c(wrtbuf,3*plysizg(iply))
           DEALLOCATE(wrtbuf)
           empsizpl=empsizpl+plysizg(iply)
 
      ELSE
        plysiz = plynod(iply)%PLYNUMNODS
        ALLOCATE (fsendbuf(3,plysiz))
        ALLOCATE (isendbuf(plysiz))
 
        DO nd=1,plysiz
             i = plynod(iply)%NODES(nd)
 
             s = sqrt(xnorm(1,i)**2 + xnorm(2,i)**2 + xnorm(3,i)**2)
             IF(s/=zero)THEN
                s = s3000 / s
                inorm(1) = xnorm(1,i) * s
                inorm(2) = xnorm(2,i) * s
                inorm(3) = xnorm(3,i) * s
             ELSE
                inorm(1) = 0
                inorm(2) = 0
                inorm(3) = ixnn
             END IF
 
           fsendbuf(1,nd) = inorm(1)
           fsendbuf(2,nd) = inorm(2)
           fsendbuf(3,nd) = inorm(3)
 
           isendbuf(nd) =  plynod(iply)%PLYNODID(nd)
        END DO
 
        itag=msgoff
        CALL mpi_send(isendbuf,plysiz,mpi_integer,it_spmd(1),
     .                   itag,spmd_comm_world,ierr)
 
        itag=msgoff2
        CALL mpi_send(fsendbuf,plysiz*3,mpi_integer,it_spmd(1),
     .                   itag,spmd_comm_world,ierr)
C
        DEALLOCATE(isendbuf,fsendbuf)
      ENDIF
 
#endif
      RETURN