pkg/compon_communic/comprecv_i4vec.F

0cd7d49b2e Jean*0001 !=======================================================================
                0002       subroutine comprecv_i4vec( dataname, length, vecFld )
                0003       implicit none
                0004 ! Predefined constants/arrays
                0005 #include "CPLR_SIG.h"
                0006 ! MPI variables
                0007 #include "mpif.h"
                0008 ! Arguments
                0009       character*(*) dataname
                0010       integer length
                0011       integer vecFld(length)
                0012 ! Functions
                0013       integer generate_tag
                0014       external generate_tag
                0015 ! Local
                0016       integer count,dtype,rank,tag,comm,ierr
                0017       integer stat(MPI_STATUS_SIZE)
                0018       integer i, j
                0019       integer ibuf(MAX_IBUF)
                0020 !     ------------------------------------------------------------------
                0021
                0022       if ( 1+length .gt. MAX_IBUF )
                0023      &    STOP 'comprecv_i4vec: length exceeds MAX_IBUF'
                0024
                0025 ! Receive message
                0026       count = MAX_IBUF
                0027       dtype = MPI_INTEGER
                0028       rank = my_coupler_rank
                0029       tag = generate_tag( 125, my_rank_in_global, dataname )
                0030       comm = MPI_COMM_myglobal
                0031
                0032       if (VERB) then
                0033         write(LogUnit,*)
                0034      &   'comprecv_i4vec: calling MPI_Recv rank=',rank
                0035         write(LogUnit,*) 'comprecv_i4vec: dataname=',dataname
                0036         call flush(LogUnit)
                0037       endif
                0038       call MPI_Recv( ibuf, count, dtype, rank, tag, comm, stat, ierr )
                0039       if (VERB) then
                0040         write(LogUnit,*) 'comprecv_i4vec: returned ierr=',ierr
                0041         call flush(LogUnit)
                0042       endif
                0043
                0044       if (ierr.ne.0) then
                0045         write(LogUnit,*) 'comprecv_i4vec: rank(W,G,L)=',
                0046      &            my_rank_in_world,my_rank_in_global,my_rank_in_local,
                0047      &            ' ierr=',ierr
                0048         STOP 'comprecv_i4vec: MPI_Recv failed'
                0049       endif
                0050
                0051 ! Check header
                0052       j = ibuf(1)
                0053       if ( j.ne.length ) then
                0054         write(LogUnit,*) 'comprecv_i4vec: length,header=', length, j
                0055         STOP 'comprecv_i4vec: Incompatible header'
                0056       endif
                0057
                0058 ! Extract data
                0059       do i=1,length
                0060         vecFld(i) = ibuf(i+1)
                0061       enddo
                0062
                0063 !     ------------------------------------------------------------------
                0064       return
                0065       end
                0066 !=======================================================================