spmd_exch_min_max.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	spmd_exch_min_max (iad_elem, fr_elem, min_array, max_array)

Function/Subroutine Documentation

spmd_exch_min_max()

subroutine spmd_exch_min_max	(	integer, dimension(2,*), intent(in)	iad_elem,
		integer, dimension(*), intent(in)	fr_elem,
		dimension(numnod), intent(inout)	min_array,
		dimension(numnod), intent(inout)	max_array )

Definition at line 35 of file spmd_exch_min_max.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_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      "com04_c.inc"     
#include      "task_c.inc"      
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: IAD_ELEM(2,*),FR_ELEM(*)
          my_real , INTENT(INOUT) :: min_array(numnod),max_array(numnod)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
#ifdef MPI
       INTEGER LENCOM,MSGOFF ,MSGTYP
       my_real, dimension(:), ALLOCATABLE :: send_buf,rec_buf
       INTEGER STATUS(MPI_STATUS_SIZE),REQ_R(NSPMD),REQ_S(NSPMD)
       INTEGER IERROR
       INTEGER P,J,NOD,SIZ,L,IAD
C-----------------------------------------------
       DATA msgoff/400/    
       msgtyp=msgoff
       
       lencom = ( iad_elem(1,nspmd+1) - iad_elem(1,1) )
 
C Allocation des Buffers           
       ALLOCATE(send_buf(2 * lencom),stat=ierror)
       IF(ierror/=0) THEN
          CALL ancmsg(msgid=20,anmode=aninfo)
          CALL arret(2)
       ENDIF
       
       ALLOCATE(rec_buf(2 * lencom),stat=ierror)
       IF(ierror/=0) THEN
          CALL ancmsg(msgid=20,anmode=aninfo)
          CALL arret(2)
       ENDIF   
C 
C ----------
C Set IRECV
C ----------
       l=1
       DO p=1,nspmd 
              siz = iad_elem(1,p+1)-iad_elem(1,p)
          IF(siz > 0) THEN 
           CALL mpi_irecv(
     s      rec_buf(l),2*siz,real,it_spmd(p),msgtyp,
     g      spmd_comm_world,req_r(p),ierror)
            l=l+2*siz
          ENDIF
       ENDDO
       
C -----------------
C PREPARE SEND_BUF       
C -----------------
       l=1
       DO p=1,nspmd 
         siz = iad_elem(1,p+1)-iad_elem(1,p)
         IF(siz > 0)THEN
           iad = l
           DO j=iad_elem(1,p),iad_elem(1,p+1)-1
              nod = fr_elem(j)
              send_buf(l)=min_array(nod)
              send_buf(l + 1)=max_array(nod)
              l=l+2
           ENDDO         
         
           CALL mpi_isend(
     s       send_buf(iad),2*siz,real,it_spmd(p),msgtyp,
     g       spmd_comm_world,req_s(p),ierror)
     
         ENDIF
       ENDDO
 
C ------------
C END RECEIVE
C ------------
       l=1
       DO p=1,nspmd 
         siz = iad_elem(1,p+1)-iad_elem(1,p)
         IF(siz > 0)THEN
           CALL mpi_wait(req_r(p),status,ierror)
            
           DO j=iad_elem(1,p),iad_elem(1,p+1)-1
             nod = fr_elem(j)
             min_array(nod) = min(min_array(nod), rec_buf(l))
             max_array(nod) = max(max_array(nod), rec_buf(l + 1))
             l = l+2
           ENDDO
         ENDIF
       ENDDO
 
C ------------
C END SEND
C ------------
      DO p = 1, nspmd
        IF(iad_elem(1,p+1)-iad_elem(1,p)>0)THEN
          CALL mpi_wait(req_s(p),status,ierror)
        ENDIF
      ENDDO
      IF (ALLOCATED(send_buf)) DEALLOCATE(send_buf)
      IF (ALLOCATED(rec_buf)) DEALLOCATE(rec_buf)
       
#endif