File indexing completed on 2018-03-02 18:38:29 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
0cd7d49b2e Jean*0001
0002 subroutine coupsend_i4vec( component, dataname, length, vecFld )
0003 implicit none
0004
0005 #include "CPLR_SIG.h"
0006
0007 #include "mpif.h"
0008
0009 character*(*) component
0010 character*(*) dataname
0011 integer length
0012 integer vecFld(length)
0013
0014 integer mitcplr_match_comp
0015 integer generate_tag
0016 external mitcplr_match_comp
0017 external generate_tag
0018
0019 integer count,dtype,dest,tag,comm,ierr
0020 integer compind, numprocs
0021 integer i, n
0022 integer ibuf(MAX_IBUF)
0023
0024
0025 if ( 1+length .gt. MAX_IBUF )
0026 & STOP 'coupsend_i4vec: length exceeds MAX_IBUF'
0027
0028
0029 compind = mitcplr_match_comp( component )
0030 if (compind.le.0) STOP 'coupsend_i4vec: Bad component id'
0031 comm = MPI_COMM_compcplr( compind )
0032 numprocs = num_component_procs(compind)
0033 if (numprocs.lt.1) then
0034 write(LogUnit,*) 'coupsend_i4vec: compind = ',compind
0035 STOP 'coupsend_i4vec: numprocs < 1'
0036 endif
0037 if (VERB)
0038 & write(LogUnit,*) 'coupsend_i4vec: ',component_Name(compind)
0039 if (VERB)
0040 & write(LogUnit,*) 'coupsend_i4vec: dataname=',dataname
0041
0042
0043 ibuf(1) = length
0044 do i=1,length
0045 ibuf(i+1) = vecFld(i)
0046 enddo
0047
0048
0049 do n=1,numprocs
0050
0051
0052 count = 1+length
0053 dtype = MPI_INTEGER
0054 tag = generate_tag( 125, n, dataname )
0055 dest = rank_component_procs(n,compind)
0056
0057 if (VERB) then
0058 write(LogUnit,*)
0059 & 'coupsend_i4vec: calling MPI_Send dest=',dest,
0060 & ' proc=',n,'/',numprocs
0061 call flush(LogUnit)
0062 endif
0063 call MPI_Send( ibuf, count, dtype, dest, tag, comm, ierr )
0064 if (VERB) then
0065 write(LogUnit,*) 'coupsend_i4vec: returned ierr=',ierr
0066 call flush(LogUnit)
0067 endif
0068
0069 if (ierr.ne.0) then
0070 write(LogUnit,*) 'coupsend_i4vec: rank(W,G)=',
0071 & my_rank_in_world,my_rank_in_global,
0072 & ' ierr=',ierr
0073 STOP 'coupsend_i4vec: MPI_Send failed'
0074 endif
0075
0076 enddo
0077
0078
0079 return
0080 end
0081