Back to home page

MITgcm

 
 

    


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 ! 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,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 ! Establish who I am communicating with
                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 ! Copy vector to buffer
                0043       ibuf(1) = length
                0044       do i=1,length
                0045         ibuf(i+1) = vecFld(i)
                0046       enddo
                0047 
                0048 ! Foreach component process
                0049       do n=1,numprocs
                0050 
                0051 ! Send message
                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 ! n
                0077 
                0078 !     ------------------------------------------------------------------
                0079       return
                0080       end
                0081 !=======================================================================