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

Contents of /MITgcm/pkg/compon_communic/couprecv_r4tiles.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 couprecv_r4tiles( component, dataname, Nx, Ny, arr )
6 implicit none
7 ! Arguments
8 character*(*) component
9 character*(*) dataname
10 integer Nx,Ny
11 real*4 arr(Nx,Ny)
12 ! Predefined constants/arrays
13 #include "CPLR_SIG.h"
14 ! MPI variables
15 #include "mpif.h"
16 integer count,dtype,rank,tag,comm,ierr
17 integer stat(MPI_STATUS_SIZE)
18 ! Functions
19 integer mitcplr_match_comp
20 integer generate_tag
21 ! Local
22 integer compind,numprocs
23 integer i,j,ij,n,bibj
24 integer Ni,Io,Nj,Jo
25 character*(MAXLEN_COMP_NAME) recvdname
26 ! ------------------------------------------------------------------
27
28 ! Establish who I am communicating with
29 compind=mitcplr_match_comp( component )
30 if (compind.le.0) stop 'couprecv_r4tiles: Bad component id'
31 comm=MPI_COMM_compcplr( compind )
32 numprocs=num_component_procs(compind)
33 if (numprocs.lt.1) then
34 write(LogUnit,*) 'couprecv_r4tiles: compind = ',compind
35 stop 'couprecv_r4tiles: numprocs < 1'
36 endif
37 if (VERB)
38 & write(LogUnit,*) 'couprecv_r4tiles: ',component_Name(compind)
39 if (VERB)
40 & write(LogUnit,*) 'couprecv_r4tiles: dataname=',dataname
41
42 ! Foreach component process
43 do n=1,numprocs
44
45 ! Foreach tile within process
46 do bibj=1,component_num_tiles(n,compind)
47
48 ! Receive message
49 count=HEADER_SIZE+MAX_R4_BUFLEN
50 dtype=MPI_REAL
51 tag=generate_tag(103,bibj,dataname)
52 rank=rank_component_procs(n,compind)
53
54 if (VERB) then
55 write(LogUnit,*)
56 & 'couprecv_r4tiles: calling MPI_Recv rank=',rank,
57 & ' proc=',n,'/',numprocs,' tile=',bibj
58 call flush(LogUnit)
59 endif
60 call MPI_Recv(r4buf, count, dtype, rank, tag, comm, stat, ierr)
61 if (VERB) then
62 write(LogUnit,*) 'couprecv_r4tiles: returned ierr=',ierr
63 call flush(LogUnit)
64 endif
65
66 if (ierr.ne.0) then
67 write(LogUnit,*) 'couprecv_r4tiles: rank(W,G)=',
68 & my_rank_in_world,my_rank_in_global,
69 & ' ierr=',ierr
70 stop 'couprecv_r4tiles: MPI_Recv failed'
71 endif
72
73 ! Extract header
74 Io=int(0.5+r4buf(1))
75 Ni=int(0.5+r4buf(2))
76 Jo=int(0.5+r4buf(3))
77 Nj=int(0.5+r4buf(4))
78
79 if (Io+Ni-1.gt.Nx .or. Io.lt.1) then
80 write(LogUnit,*) 'couprecv_r4tiles: Io,Ni=',Io,Ni
81 stop 'couprecv_r4tiles: Incompatible header/target array'
82 endif
83 if (Jo+Nj-1.gt.Ny .or. Jo.lt.1) then
84 write(LogUnit,*) 'couprecv_r4tiles: Jo,Nj=',Jo,Nj
85 stop 'couprecv_r4tiles: Incompatible header/target array'
86 endif
87 if (Io.ne.component_tile_i0(bibj,n,compind))
88 & stop 'couprecv_r4tiles: Io != component_tile_i0'
89 if (Jo.ne.component_tile_j0(bibj,n,compind))
90 & stop 'couprecv_r4tiles: Jo != component_tile_j0'
91 if (Ni.ne.component_tile_nx(bibj,n,compind))
92 & stop 'couprecv_r4tiles: Ni != component_tile_nx'
93 if (Nj.ne.component_tile_ny(bibj,n,compind))
94 & stop 'couprecv_r4tiles: Nj != component_tile_ny'
95
96 call mitcplr_real2char( r4buf(9), recvdname )
97 if (recvdname .ne. dataname) then
98 write(LogUnit,*) 'couprecv_r4tiles: recvdname = ',recvdname
99 write(LogUnit,*) 'couprecv_r4tiles: dataname = ',dataname
100 stop 'couprecv_r4tiles: recvdname != dataname'
101 endif
102
103 ! Extract data
104 do j=1,Nj
105 do i=1,Ni
106 ij=HEADER_SIZE+i+Ni*(j-1)
107 arr(Io+i-1,Jo+j-1)=r4buf(ij)
108 enddo
109 enddo
110
111 enddo ! bibj
112
113 enddo ! n
114
115 ! ------------------------------------------------------------------
116 return
117 end
118 !=======================================================================
  ViewVC Help
Powered by ViewVC 1.1.22