pkg/compon_communic/compsend_r4.F

bf4be02920 Jean*0001 !=======================================================================
                0002       subroutine compsend_r4( dataname, Ni,Oi,Nj,Oj, arr )
                0003       implicit none
                0004 ! Arguments
                0005       character*(*) dataname
                0006       integer Ni,Oi,Nj,Oj
                0007       real*4 arr(1-Oi:Ni+Oi,1-Oj:Nj+Oj)
                0008 ! Predefined constants/arrays
                0009 #include "CPLR_SIG.h"
                0010 ! MPI variables
                0011 #include "mpif.h"
                0012       integer count,datatype,dest,tag,comm,ierr
                0013 ! Functions
                0014       integer generate_tag
                0015 ! Local
                0016       integer i,j,ij,Io,Jo
                0017 !     ------------------------------------------------------------------
                0018
                0019       if (HEADER_SIZE+Ni*Nj.gt.MAX_R4_BUFLEN)
                0020      &    stop 'compsend_r4: Nx*Ny too big'
                0021
                0022 ! Set up buffer
                0023       Io=my_tile_i0(1)
                0024       Jo=my_tile_j0(1)
                0025       r4buf(1)=float(Io)
                0026       r4buf(2)=float(Ni)
                0027       r4buf(3)=float(Jo)
                0028       r4buf(4)=float(Nj)
                0029       call mitcplr_char2real( dataname, r4buf(9) )
                0030
                0031 ! Copy interior of tile to buffer
                0032       do j=1,Nj
                0033        do i=1,Ni
                0034         ij=HEADER_SIZE+i+Ni*(j-1)
                0035         r4buf(ij)=arr(i,j)
                0036        enddo
                0037       enddo
                0038
                0039 ! Send message
                0040       count=HEADER_SIZE+Ni*Nj
                0041       datatype=MPI_REAL
                0042       dest=my_coupler_rank
                0043       tag=generate_tag(102,my_rank_in_global,dataname)
                0044       comm=MPI_COMM_myglobal
                0045
                0046       if (VERB) then
                0047        write(LogUnit,*) 'compsend_r4: calling MPI_Send dest=',dest
                0048        write(LogUnit,*) 'compsend_r4: dataname=',dataname
                0049        call flush(LogUnit)
                0050       endif
                0051       call MPI_Send( r4buf, count, datatype, dest, tag, comm, ierr )
                0052       if (VERB) then
                0053        write(LogUnit,*) 'compsend_r4: returned ierr=',ierr
                0054        call flush(LogUnit)
                0055       endif
                0056
                0057       if (ierr.ne.0) then
                0058        write(LogUnit,*) 'compsend_r4: rank(W,G,L)=',
                0059      &            my_rank_in_world,my_rank_in_global,my_rank_in_local,
                0060      &            ' ierr=',ierr
                0061        stop 'compsend_r4: MPI_Send failed'
                0062       endif
                0063
                0064 !     ------------------------------------------------------------------
                0065       return
                0066       end
                0067 !=======================================================================