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_r8tiles( dataname, Ni,Oi,Nj,Oj,Nk,Tx,Ty, arr )
0003 implicit none
0004
0005 character*(*) dataname
0006 integer Ni,Oi,Nj,Oj,Io,Jo,Nk,Tx,Ty
0007 real*8 arr(1-Oi:Ni+Oi,1-Oj:Nj+Oj,Nk,Tx,Ty)
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,k,bibj,bi,bj
0018 character*(MAXLEN_COMP_NAME) recvdname
0019
0020
0021 if (HEADER_SIZE+Ni*Nj.gt.MAX_R8_BUFLEN)
0022 & stop 'comprecv_r8tiles: Nx*Ny too big'
0023
0024
0025 do bibj=1,my_num_tiles
0026
0027 bi=my_tile_bi(bibj)
0028 bj=my_tile_bj(bibj)
0029
0030
0031 count=MAX_R8_BUFLEN
0032 dtype=MPI_DOUBLE_PRECISION
0033 tag=generate_tag(123,bibj,dataname)
0034 rank=my_coupler_rank
0035 comm=MPI_COMM_myglobal
0036
0037 if (VERB) then
0038 write(LogUnit,*) 'comprecv_r8tiles: calling MPI_Recv rank=',rank
0039 write(LogUnit,*) 'comprecv_r8tiles: dataname=',dataname
0040 call flush(LogUnit)
0041 endif
0042 call MPI_Recv(r8buf, count, dtype, rank, tag, comm, stat, ierr)
0043 if (VERB) then
0044 write(LogUnit,*) 'comprecv_r8tiles: returned ierr=',ierr
0045 call flush(LogUnit)
0046 endif
0047
0048 if (ierr.ne.0) then
0049 write(LogUnit,*) 'comprecv_r8tiles: rank(W,G)=',
0050 & my_rank_in_world,my_rank_in_global,
0051 & ' ierr=',ierr
0052 stop 'comprecv_r8tiles: MPI_Recv failed'
0053 endif
0054
0055
0056 Io=int(0.5+r8buf(1))
0057 Jo=int(0.5+r8buf(2))
0058 nx=int(0.5+r8buf(3))
0059 ny=int(0.5+r8buf(4))
e5266ce10c Jean*0060 call mitcplr_dbl2char( r8buf(9), recvdname )
bf4be02920 Jean*0061
0062 if (Io.ne.my_tile_i0(bibj)) stop 'comprecv_r8tiles: bad Io'
0063 if (Jo.ne.my_tile_j0(bibj)) stop 'comprecv_r8tiles: bad Jo'
0064 if (nx.ne.my_tile_nx(bibj)) stop 'comprecv_r8tiles: bad nx'
0065 if (ny.ne.my_tile_ny(bibj)) stop 'comprecv_r8tiles: bad ny'
0066 if (recvdname .ne. dataname) then
0067 write(LogUnit,*) 'comprecv_r8tiles: recvdname = ',recvdname
0068 write(LogUnit,*) 'comprecv_r8tiles: dataname = ',dataname
0069 stop 'comprecv_r8tiles: recvdname != dataname'
0070 endif
0071
0072
0073 k=1
0074 do j=1,Nj
0075 do i=1,Ni
0076 ij=HEADER_SIZE+i+Ni*(j-1)
0077 arr(i,j,k,bi,bj)=r8buf(ij)
0078 enddo
0079 enddo
0080
0081 enddo
0082
0083
0084 return
0085 end
0086