File indexing completed on 2018-03-02 18:38:27 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
bf4be02920 Jean*0001
0002 subroutine comprecv_r4( dataname, Ni,Oi,Nj,Oj, arr )
0003 implicit none
0004
0005 character*(*) dataname
0006 integer Ni,Oi,Nj,Oj,Io,Jo
0007 real*4 arr(1-Oi:Ni+Oi,1-Oj:Nj+Oj)
0008
0009 #include "CPLR_SIG.h"
0010
0011 #include "mpif.h"
0012 integer count,dtype,rank,tag,comm,ierr
0013 integer stat(MPI_STATUS_SIZE)
0014
0015 integer generate_tag
0016
0017 integer i,j,ij,nx,ny
0018 character*(MAXLEN_COMP_NAME) recvdname
0019
0020
0021 if (HEADER_SIZE+Ni*Nj.gt.MAX_R4_BUFLEN)
0022 & stop 'comprecv_r4: Nx*Ny too big'
0023
0024
0025 count=HEADER_SIZE+MAX_R4_BUFLEN
0026 dtype=MPI_REAL
0027 tag=generate_tag(121,my_rank_in_global,dataname)
0028 rank=my_coupler_rank
0029 comm=MPI_COMM_myglobal
0030
0031 if (VERB) then
0032 write(LogUnit,*) 'comprecv_r4: calling MPI_Recv rank=',rank
0033 write(LogUnit,*) 'comprecv_r4: dataname=',dataname
0034 call flush(LogUnit)
0035 endif
0036 call MPI_Recv(r4buf, count, dtype, rank, tag, comm, stat, ierr)
0037 if (VERB) then
0038 write(LogUnit,*) 'comprecv_r4: returned ierr=',ierr
0039 call flush(LogUnit)
0040 endif
0041
0042 if (ierr.ne.0) then
0043 write(LogUnit,*) 'comprecv_r4tiles: rank(W,G)=',
0044 & my_rank_in_world,my_rank_in_global,
0045 & ' ierr=',ierr
0046 stop 'comprecv_r4: MPI_Recv failed'
0047 endif
0048
0049
0050 Io=int(0.5+r4buf(1))
0051 Jo=int(0.5+r4buf(2))
0052 nx=int(0.5+r4buf(3))
0053 ny=int(0.5+r4buf(4))
0054 call mitcplr_real2char( r4buf(9), recvdname )
0055
0056 if (Io.ne.my_tile_i0(1)) stop 'comprecv_r4: bad Io'
0057 if (Jo.ne.my_tile_j0(1)) stop 'comprecv_r4: bad Jo'
0058 if (nx.ne.my_tile_nx(1)) stop 'comprecv_r4: bad nx'
0059 if (ny.ne.my_tile_ny(1)) stop 'comprecv_r4: bad ny'
0060 if (recvdname .ne. dataname) then
0061 write(LogUnit,*) 'comprecv_r4: recvdname = ',recvdname
0062 write(LogUnit,*) 'comprecv_r4: dataname = ',dataname
0063 stop 'comprecv_r4: recvdname != dataname'
0064 endif
0065
0066
0067 do j=1,Nj
0068 do i=1,Ni
0069 ij=HEADER_SIZE+i+Ni*(j-1)
0070 arr(i,j)=r4buf(ij)
0071 enddo
0072 enddo
0073
0074
0075 return
0076 end
0077