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

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

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

Revision 1.3 - (show annotations) (download)
Wed Nov 27 21:51:15 2013 UTC (10 years, 6 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint65, 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, HEAD
Changes since 1.2: +57 -22 lines 
- move declaration of local array "ibuf" out of header file "CPLR_SIG.h"
  to each S/R that needs it; remove un-used variables.
- improve report of tile registration results to log file.
- check for valid mapping from comp. tile to coupler global array
1 C $Header: /u/gcmpack/MITgcm/pkg/compon_communic/mitcoupler_tile_register.F,v 1.2 2007/10/08 23:58:20 jmc Exp $
2 C $Name: $
3
4 !=======================================================================
5 subroutine MITCOUPLER_tile_register( compName, nnx, nny )
6 implicit none
7
8 ! Arguments
9 character*(*) compName
10 integer nnx, nny
11
12 ! MPI variables
13 #include "mpif.h"
14
15 ! Predefined constants/arrays
16 #include "CPLR_SIG.h"
17
18 ! Functions
19 integer mitcplr_match_comp
20 integer generate_tag
21 external mitcplr_match_comp
22 external generate_tag
23
24 ! Local
25 integer n,numprocs
26 integer comm
27 integer compind,count,dtype,tag,rank
28 integer ierr
29 integer stat(MPI_STATUS_SIZE)
30 integer j, numtiles
31 integer nx, ny, i0, j0
32 integer ibuf(MAX_IBUF)
33
34 ! ------------------------------------------------------------------
35
36 write(LogUnit,'(3A)')
37 & 'MITCOUPLER_tile_register: do "', compName, '" :'
38
39 ! Establish who I am communicating with
40 compind=mitcplr_match_comp( compName )
41 if (compind.le.0) STOP 'MITCOUPLER_tile_register: Bad component'
42 comm=MPI_COMM_compcplr( compind )
43 numprocs=num_component_procs(compind)
44
45 write(LogUnit,'(2(A,I6))')
46 & ' compind=', compind, ' ; numprocs=', numprocs
47 if (numprocs.lt.1) then
48 STOP 'MITCOUPLER_tile_register: numprocs < 1'
49 endif
50
51 ! Foreach component process
52 do n=1,numprocs
53
54 ! Receive message
55 count=MAX_IBUF
56 dtype=MPI_INTEGER
57 tag=generate_tag(112,n,'Register Tiles')
58 rank=rank_component_procs(n,compind)
59
60 call MPI_Recv(ibuf, count, dtype, rank, tag, comm, stat, ierr)
61
62 if (ierr.ne.0) then
63 write(LogUnit,*) 'MITCOUPLER_tile_register: rank(W,G)=',
64 & my_rank_in_world,my_rank_in_global,
65 & ' ierr=',ierr
66 STOP 'MITCOUPLER_tile_register: MPI_Recv failed'
67 endif
68
69 numtiles=ibuf(1)
70 if (numtiles.lt.1 .or. numtiles.gt.MAX_TILES) then
71 write(LogUnit,*) 'MITCOUPLER_tile_register: #tiles = ',numtiles
72 STOP 'MITCOUPLER_tile_register: invalid value for numtiles'
73 endif
74 component_num_tiles(n,compind)=numtiles
75
76 write(LogUnit,'(3(A,I6),A)') '- proc # =', n,
77 & ' ; rank=', rank, ' ; numtiles=', numtiles, ' -------'
78 do j=1,numtiles
79
80 ! Receive message
81 count=MAX_IBUF
82 dtype=MPI_INTEGER
83 tag=generate_tag(113,j,'Register each tile')
84 rank=rank_component_procs(n,compind)
85
86 call MPI_Recv(ibuf, count, dtype, rank, tag, comm, stat, ierr)
87
88 if (ierr.ne.0) then
89 write(LogUnit,*) 'MITCOUPLER_tile_register: rank(W,G)=',
90 & my_rank_in_world,my_rank_in_global,
91 & ' ierr=',ierr
92 STOP 'MITCOUPLER_tile_register: MPI_Recv failed'
93 endif
94
95 ! Extract data and store
96 nx = ibuf(1)
97 ny = ibuf(2)
98 i0 = ibuf(3)
99 j0 = ibuf(4)
100 component_tile_nx(j,n,compind) = nx
101 component_tile_ny(j,n,compind) = ny
102 component_tile_i0(j,n,compind) = i0
103 component_tile_j0(j,n,compind) = j0
104
105 ! Print and check
106 write(LogUnit,'(A,I5,A,2I5,A,2I8)') ' tile #:', j,
107 & ' ; Ni,Nj=', nx, ny, ' ; Io,Jo=', i0, j0
108
109 if (nx.lt.1) then
110 STOP 'MITCOUPLER_tile_register: invalid value for nx'
111 endif
112 if (ny.lt.1) then
113 STOP 'MITCOUPLER_tile_register: invalid value for ny'
114 endif
115 if (i0.lt.1) then
116 STOP 'MITCOUPLER_tile_register: invalid value for i0'
117 endif
118 if (j0.lt.1) then
119 STOP 'MITCOUPLER_tile_register: invalid value for j0'
120 endif
121 if (i0+nx-1.gt.nnx) then
122 STOP 'MITCOUPLER_tile_register: i0 + nx -1 > nnx'
123 endif
124 if (j0+ny-1.gt.nny) then
125 STOP 'MITCOUPLER_tile_register: j0 + ny -1 > nny'
126 endif
127
128 enddo ! j
129 write(LogUnit,'(A,2I8,2(A,I8))')
130 & ' rank(W,G)=', my_rank_in_world, my_rank_in_global,
131 & ' , rank = ',rank, ' , num_tiles = ', numtiles
132
133 enddo ! n
134
135 write(LogUnit,'(3A)') 'MITCOUPLER_tile_register: comp. "',
136 & compName, '" done'
137
138 ! ------------------------------------------------------------------
139 call flush(LogUnit)
140 return
141 end
142 !=======================================================================
  ViewVC Help
Powered by ViewVC 1.1.22