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

Annotation of /MITgcm/pkg/compon_communic/coupsend_r4tiles.F

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

Revision 1.2 - (hide annotations) (download)
Mon Oct 8 23:58:20 2007 UTC (18 years, 1 month 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, checkpoint65p, 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
Changes since 1.1: +3 -0 lines 
add missing cvs $Header:$ or $Name:$
1 jmc 1.2 C $Header: $
2     C $Name: $
3    
4 jmc 1.1 !=======================================================================
5     subroutine coupsend_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,dest,tag,comm,ierr
17     ! Functions
18     integer mitcplr_match_comp
19     integer generate_tag
20     ! Local
21     integer compind,numprocs
22     integer i,j,ij,n,bibj
23     integer Ni,Io,Nj,Jo
24     ! ------------------------------------------------------------------
25    
26     ! Establish who I am communicating with
27     compind=mitcplr_match_comp( component )
28     if (compind.le.0) stop 'coupsend_r4tiles: Bad component id'
29     comm=MPI_COMM_compcplr( compind )
30     numprocs=num_component_procs(compind)
31     if (numprocs.lt.1) then
32     write(LogUnit,*) 'coupsend_r4tiles: compind = ',compind
33     stop 'coupsend_r4tiles: numprocs < 1'
34     endif
35     if (VERB)
36     & write(LogUnit,*) 'coupsend_r4tiles: ',component_Name(compind)
37     if (VERB)
38     & write(LogUnit,*) 'coupsend_r4tiles: dataname=',dataname
39    
40     ! Foreach component process
41     do n=1,numprocs
42    
43     ! Foreach tile on that process
44     do bibj=1,component_num_tiles(n,compind)
45    
46     ! Create header
47     Io=component_tile_i0(bibj,n,compind)
48     Jo=component_tile_j0(bibj,n,compind)
49     Ni=component_tile_nx(bibj,n,compind)
50     Nj=component_tile_ny(bibj,n,compind)
51     r4buf(1)=float( Io )
52     r4buf(2)=float( Jo )
53     r4buf(3)=float( Ni )
54     r4buf(4)=float( Nj )
55     call mitcplr_char2real( dataname, r4buf(9) )
56    
57     ! Pack data
58     do j=1,Nj
59     do i=1,Ni
60     ij=HEADER_SIZE+i+Ni*(j-1)
61     r4buf(ij)=arr(Io+i-1,Jo+j-1)
62     enddo
63     enddo
64    
65     ! Send message
66     count=HEADER_SIZE+Ni*Nj
67     dtype=MPI_REAL
68     tag=generate_tag(123,bibj,dataname)
69     dest=rank_component_procs(n,compind)
70    
71     if (VERB) then
72     write(LogUnit,*) 'coupsend_r4tiles: calling MPI_Send dest=',
73     & dest,' proc=',n,'/',numprocs,' tile=',bibj
74     call flush(LogUnit)
75     endif
76     call MPI_Send( r4buf, count, dtype, dest, tag, comm, ierr )
77     if (VERB) then
78     write(LogUnit,*) 'coupsend_r4tiles: returned ierr=',ierr
79     call flush(LogUnit)
80     endif
81    
82     if (ierr.ne.0) then
83     write(LogUnit,*) 'coupsend_r4tiles: rank(W,G)=',
84     & my_rank_in_world,my_rank_in_global,
85     & ' ierr=',ierr
86     stop 'coupsend_r4tiles: MPI_Recv failed'
87     endif
88    
89     enddo ! bibj
90    
91     enddo ! n
92    
93     ! ------------------------------------------------------------------
94     return
95     end
96     !=======================================================================
  ViewVC Help
Powered by ViewVC 1.1.22