pkg/compon_communic/couprecv_i4vec.F

bb5d043025 Jean*0001 !=======================================================================
                0002       subroutine couprecv_i4vec( component, 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*(*) component
                0010       character*(*) dataname
                0011       integer length
                0012       integer vecFld(length)
                0013 ! Functions
                0014       integer mitcplr_match_comp
                0015       integer generate_tag
                0016       external mitcplr_match_comp
                0017       external generate_tag
                0018 ! Local
                0019       integer count,dtype,rank,tag,comm,ierr
                0020       integer stat(MPI_STATUS_SIZE)
                0021       integer compind, numprocs
                0022       integer i, j, n, ndiff
                0023       integer ibuf(MAX_IBUF)
                0024 !     ------------------------------------------------------------------
                0025
                0026       if ( 1+length .gt. MAX_IBUF )
                0027      &    STOP 'couprecv_i4vec: length exceeds MAX_IBUF'
                0028
                0029 ! Establish who I am communicating with
                0030       compind = mitcplr_match_comp( component )
                0031       if (compind.le.0) STOP 'couprecv_i4vec: Bad component id'
                0032       comm = MPI_COMM_compcplr( compind )
                0033       numprocs = num_component_procs(compind)
                0034       if (numprocs.lt.1) then
                0035         write(LogUnit,*) 'couprecv_i4vec: compind = ',compind
                0036         STOP 'couprecv_i4vec: numprocs < 1'
                0037       endif
                0038       if (VERB)
                0039      &  write(LogUnit,*) 'couprecv_i4vec: ',component_Name(compind)
                0040       if (VERB)
                0041      &  write(LogUnit,*) 'couprecv_i4vec: dataname=',dataname
                0042
                0043 ! Foreach component process
                0044       do n=1,numprocs
                0045
                0046 ! Receive message
                0047        count = MAX_IBUF
                0048        dtype = MPI_INTEGER
                0049        tag = generate_tag( 115, n, dataname)
                0050        rank = rank_component_procs(n,compind)
                0051
                0052        if (VERB) then
                0053         write(LogUnit,*)
                0054      &    'couprecv_i4vec: calling MPI_Recv rank=',rank,
                0055      &    ' proc=',n,'/',numprocs
                0056         call flush(LogUnit)
                0057        endif
                0058        call MPI_Recv(ibuf, count, dtype, rank, tag, comm, stat, ierr)
                0059        if (VERB) then
                0060         write(LogUnit,*) 'couprecv_i4vec: returned ierr=',ierr
                0061         call flush(LogUnit)
                0062        endif
                0063
                0064        if (ierr.ne.0) then
                0065         write(LogUnit,*) 'couprecv_i4vec: rank(W,G)=',
                0066      &            my_rank_in_world,my_rank_in_global,
                0067      &            ' ierr=',ierr
                0068         STOP 'couprecv_i4vec: MPI_Recv failed'
                0069        endif
                0070
                0071 ! Check header
                0072        j = ibuf(1)
                0073
                0074        if ( j.ne.length ) then
                0075         write(LogUnit,*) 'couprecv_i4vec: length,header=', length, j
                0076         STOP 'couprecv_i4vec: Incompatible header'
                0077        endif
                0078
                0079 ! Extract data
                0080        if ( n.eq.1 ) then
                0081          do i=1,length
                0082            vecFld(i) = ibuf(i+1)
                0083          enddo
                0084        else
                0085          ndiff = 0
                0086          do i=1,length
                0087            if  ( vecFld(i) .ne. ibuf(i+1) ) ndiff = ndiff + 1
                0088          enddo
                0089          if ( ndiff.gt.0 ) then
                0090            write(LogUnit,'(A,I8,2A)')
                0091      &      ' couprecv_i4vec: length=', length, ' name=', dataname
                0092            write(LogUnit,'(A,I6,A,I8,A)')
                0093      &      ' from proc=', n ,' : found', ndiff, ' differences (vs 1)'
                0094          endif
                0095        endif
                0096
                0097       enddo ! n
                0098
                0099 !     ------------------------------------------------------------------
                0100       return
                0101       end
                0102 !=======================================================================