/[MITgcm]/MITgcm/pkg/compon_communic/comprecv_r4.F
ViewVC logotype

Contents of /MITgcm/pkg/compon_communic/comprecv_r4.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.2 - (show annotations) (download)
Mon Oct 8 23:58:20 2007 UTC (16 years, 6 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint65, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59k, checkpoint59j, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y, HEAD
Changes since 1.1: +3 -0 lines
add missing cvs $Header:$ or $Name:$

1 C $Header: $
2 C $Name: $
3
4 !=======================================================================
5 subroutine comprecv_r4( dataname, Ni,Oi,Nj,Oj, arr )
6 implicit none
7 ! Arguments
8 character*(*) dataname
9 integer Ni,Oi,Nj,Oj,Io,Jo
10 real*4 arr(1-Oi:Ni+Oi,1-Oj:Nj+Oj)
11 ! Predefined constants/arrays
12 #include "CPLR_SIG.h"
13 ! MPI variables
14 #include "mpif.h"
15 integer count,dtype,rank,tag,comm,ierr
16 integer stat(MPI_STATUS_SIZE)
17 ! Functions
18 integer generate_tag
19 ! Local
20 integer i,j,ij,nx,ny
21 character*(MAXLEN_COMP_NAME) recvdname
22 ! ------------------------------------------------------------------
23
24 if (HEADER_SIZE+Ni*Nj.gt.MAX_R4_BUFLEN)
25 & stop 'comprecv_r4: Nx*Ny too big'
26
27 ! Receive message
28 count=HEADER_SIZE+MAX_R4_BUFLEN
29 dtype=MPI_REAL
30 tag=generate_tag(121,my_rank_in_global,dataname)
31 rank=my_coupler_rank
32 comm=MPI_COMM_myglobal
33
34 if (VERB) then
35 write(LogUnit,*) 'comprecv_r4: calling MPI_Recv rank=',rank
36 write(LogUnit,*) 'comprecv_r4: dataname=',dataname
37 call flush(LogUnit)
38 endif
39 call MPI_Recv(r4buf, count, dtype, rank, tag, comm, stat, ierr)
40 if (VERB) then
41 write(LogUnit,*) 'comprecv_r4: returned ierr=',ierr
42 call flush(LogUnit)
43 endif
44
45 if (ierr.ne.0) then
46 write(LogUnit,*) 'comprecv_r4tiles: rank(W,G)=',
47 & my_rank_in_world,my_rank_in_global,
48 & ' ierr=',ierr
49 stop 'comprecv_r4: MPI_Recv failed'
50 endif
51
52 ! Extract buffer
53 Io=int(0.5+r4buf(1))
54 Jo=int(0.5+r4buf(2))
55 nx=int(0.5+r4buf(3))
56 ny=int(0.5+r4buf(4))
57 call mitcplr_real2char( r4buf(9), recvdname )
58
59 if (Io.ne.my_tile_i0(1)) stop 'comprecv_r4: bad Io'
60 if (Jo.ne.my_tile_j0(1)) stop 'comprecv_r4: bad Jo'
61 if (nx.ne.my_tile_nx(1)) stop 'comprecv_r4: bad nx'
62 if (ny.ne.my_tile_ny(1)) stop 'comprecv_r4: bad ny'
63 if (recvdname .ne. dataname) then
64 write(LogUnit,*) 'comprecv_r4: recvdname = ',recvdname
65 write(LogUnit,*) 'comprecv_r4: dataname = ',dataname
66 stop 'comprecv_r4: recvdname != dataname'
67 endif
68
69 ! Copy buffer to interior of tile
70 do j=1,Nj
71 do i=1,Ni
72 ij=HEADER_SIZE+i+Ni*(j-1)
73 arr(i,j)=r4buf(ij)
74 enddo
75 enddo
76
77 ! ------------------------------------------------------------------
78 return
79 end
80 !=======================================================================

  ViewVC Help
Powered by ViewVC 1.1.22