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

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

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

Revision 1.3 - (show annotations) (download)
Mon Sep 14 16:22:01 2009 UTC (14 years, 7 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, 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, 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, checkpoint61v, checkpoint61w, checkpoint61z, checkpoint61x, checkpoint61y, HEAD
Changes since 1.2: +2 -2 lines 
change conversion S/R calls to use the right type (real*8).
1 C $Header: /u/gcmpack/MITgcm/pkg/compon_communic/comprecv_r8.F,v 1.2 2007/10/08 23:58:20 jmc Exp $
2 C $Name: $
3
4 !=======================================================================
5 subroutine comprecv_r8( dataname, Ni,Oi,Nj,Oj, arr )
6 implicit none
7 ! Arguments
8 character*(*) dataname
9 integer Ni,Oi,Nj,Oj,Io,Jo
10 real*8 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_R8_BUFLEN)
25 & stop 'comprecv_r8: Nx*Ny too big'
26
27 ! Receive message
28 count=HEADER_SIZE+MAX_R8_BUFLEN
29 dtype=MPI_DOUBLE_PRECISION
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_r8: calling MPI_Recv rank=',rank
36 write(LogUnit,*) 'comprecv_r8: dataname=',dataname
37 call flush(LogUnit)
38 endif
39 call MPI_Recv(r8buf, count, dtype, rank, tag, comm, stat, ierr)
40 if (VERB) then
41 write(LogUnit,*) 'comprecv_r8: returned ierr=',ierr
42 call flush(LogUnit)
43 endif
44
45 if (ierr.ne.0) then
46 write(LogUnit,*) 'comprecv_r8tiles: rank(W,G)=',
47 & my_rank_in_world,my_rank_in_global,
48 & ' ierr=',ierr
49 stop 'comprecv_r8: MPI_Recv failed'
50 endif
51
52 ! Extract buffer
53 Io=int(0.5+r8buf(1))
54 Jo=int(0.5+r8buf(2))
55 nx=int(0.5+r8buf(3))
56 ny=int(0.5+r8buf(4))
57 call mitcplr_dbl2char( r8buf(9), recvdname )
58
59 if (Io.ne.my_tile_i0(1)) stop 'comprecv_r8: bad Io'
60 if (Jo.ne.my_tile_j0(1)) stop 'comprecv_r8: bad Jo'
61 if (nx.ne.my_tile_nx(1)) stop 'comprecv_r8: bad nx'
62 if (ny.ne.my_tile_ny(1)) stop 'comprecv_r8: bad ny'
63 if (recvdname .ne. dataname) then
64 write(LogUnit,*) 'comprecv_r8: recvdname = ',recvdname
65 write(LogUnit,*) 'comprecv_r8: dataname = ',dataname
66 stop 'comprecv_r8: 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)=r8buf(ij)
74 enddo
75 enddo
76
77 ! ------------------------------------------------------------------
78 return
79 end
80 !=======================================================================
  ViewVC Help
Powered by ViewVC 1.1.22