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_r8( dataname, Ni,Oi,Nj,Oj, arr )
0003 implicit none
0004
0005 character*(*) dataname
0006 integer Ni,Oi,Nj,Oj,Io,Jo
0007 real*8 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_R8_BUFLEN)
0022 & stop 'comprecv_r8: Nx*Ny too big'
0023
0024
0025 count=HEADER_SIZE+MAX_R8_BUFLEN
0026 dtype=MPI_DOUBLE_PRECISION
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_r8: calling MPI_Recv rank=',rank
0033 write(LogUnit,*) 'comprecv_r8: dataname=',dataname
0034 call flush(LogUnit)
0035 endif
0036 call MPI_Recv(r8buf, count, dtype, rank, tag, comm, stat, ierr)
0037 if (VERB) then
0038 write(LogUnit,*) 'comprecv_r8: returned ierr=',ierr
0039 call flush(LogUnit)
0040 endif
0041
0042 if (ierr.ne.0) then
0043 write(LogUnit,*) 'comprecv_r8tiles: rank(W,G)=',
0044 & my_rank_in_world,my_rank_in_global,
0045 & ' ierr=',ierr
0046 stop 'comprecv_r8: MPI_Recv failed'
0047 endif
0048
0049
0050 Io=int(0.5+r8buf(1))
0051 Jo=int(0.5+r8buf(2))
0052 nx=int(0.5+r8buf(3))
0053 ny=int(0.5+r8buf(4))
e5266ce10c Jean*0054 call mitcplr_dbl2char( r8buf(9), recvdname )
bf4be02920 Jean*0055
0056 if (Io.ne.my_tile_i0(1)) stop 'comprecv_r8: bad Io'
0057 if (Jo.ne.my_tile_j0(1)) stop 'comprecv_r8: bad Jo'
0058 if (nx.ne.my_tile_nx(1)) stop 'comprecv_r8: bad nx'
0059 if (ny.ne.my_tile_ny(1)) stop 'comprecv_r8: bad ny'
0060 if (recvdname .ne. dataname) then
0061 write(LogUnit,*) 'comprecv_r8: recvdname = ',recvdname
0062 write(LogUnit,*) 'comprecv_r8: dataname = ',dataname
0063 stop 'comprecv_r8: 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)=r8buf(ij)
0071 enddo
0072 enddo
0073
0074
0075 return
0076 end
0077