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

Annotation of /MITgcm/pkg/compon_communic/mitcplr_init1.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:21 2007 UTC (16 years, 8 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64q, checkpoint64p, 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, checkpoint60, checkpoint61, checkpoint62, checkpoint63, 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: +8 -5 lines 
add missing cvs $Header:$ or $Name:$
1 jmc 1.2 C $Header: $
2     C $Name: $
3    
4 jmc 1.1 !=======================================================================
5     subroutine MITCPLR_init1( myTypeStr, couplerFlag )
6     implicit none
7    
8     ! Arguments
9     character*(*) myTypeStr
10     logical couplerFlag
11    
12     ! MPI variables
13     #include "mpif.h"
14     integer myid, numprocs, ierr, rc
15    
16    
17     ! Predefined constants/arrays
18     #include "CPLR_SIG.h"
19    
20     ! Functions
21     integer mitcplr_match_comp
22    
23     ! Local
24     integer n,j
25     integer MPI_GROUP_World
26     integer MPI_GROUP_Tmp
27     integer lenbuf
28     integer compind
29     character*(MAXLEN_COMP_NAME) cbuf
30    
31     ! ------------------------------------------------------------------
32    
33     ! Find-out my position (rank) in the "world" communicator
34     call MPI_COMM_RANK( MPI_COMM_WORLD, myid, ierr )
35     if (ierr.ne.0) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
36     & ' Rank = ',myid,' MPI_COMM_RANK ierr=',ierr
37     ! How big is the "world"?
38     call MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, ierr )
39     if (ierr.ne.0) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
40     & ' Size = ',numprocs,' MPI_COMM_RANK ierr=',ierr
41     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
42     & ' Rank/Size = ',myid,' /',numprocs
43    
44 jmc 1.2 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
45 jmc 1.1
46     ! Registration: collect/bcast lists of who is who
47    
48     ! Assume nothing
49     num_components = 0
50     num_coupler_procs = 0
51    
52     ! Receive a message from each of the other processes
53     do n=0,numprocs-1
54     ibuf(1)=myid
55     ibuf(2)=0
56     if ( couplerFlag ) ibuf(2)=MITCPLR_COUPLER
57     ibuf(3)=0
58     ibuf(4)=0
59     ibuf(5)=0
60     ibuf(6)=0
61     ibuf(7)=0
62     call mitcplr_char2int( myTypeStr, ibuf(8) )
63     lenbuf=8+MAXLEN_COMP_NAME
64     call MPI_Bcast(
65     & ibuf, lenbuf, MPI_INTEGER,
66 jmc 1.2 & n,
67 jmc 1.1 & MPI_COMM_WORLD, ierr )
68     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
69     & ' MPI_Bcast from ',ibuf(1),ibuf(2),' ierr=',ierr
70     call mitcplr_int2char( ibuf(8), cbuf )
71     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
72     & ' Bcast cbuf=',cbuf,'x'
73    
74     if ( ibuf(2).eq.MITCPLR_COUPLER ) then
75     ! If the broadcaster is the "coupler"
76     num_coupler_procs=num_coupler_procs + 1
77     rank_coupler_procs(num_coupler_procs) = ibuf(1)
78     coupler_Name=cbuf
79     else
80     ! If the broadcaster is a "component"
81     compind=mitcplr_match_comp( cbuf )
82     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
83     & ' compind=',compind
84     num_component_procs(compind)=num_component_procs(compind) + 1
85     j=num_component_procs(compind)
86     rank_component_procs(j,compind)=ibuf(1)
87     endif
88    
89     enddo
90    
91     if ( num_coupler_procs .ne. 1 ) then
92     stop 'MITCPLR_init1: I can only handle one coupler process'
93     endif
94    
95     do compind=1,num_components
96     num_compcplr_procs(compind)=num_component_procs(compind) + 1
97     do j=1,num_compcplr_procs(compind)
98     rank_compcplr_procs(j,compind)=rank_component_procs(j,compind)
99     enddo
100     j=num_compcplr_procs(compind)
101     rank_compcplr_procs(j,compind)=rank_coupler_procs(1)
102     call mitcplr_sortranks( j, rank_compcplr_procs(1,compind) )
103     enddo
104    
105    
106     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
107     & ' coupler=',coupler_Name,
108     & ( rank_coupler_procs(j),j=1,num_coupler_procs )
109     do n=1,num_components
110     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
111     & ' component=',component_Name(n),
112     & ( rank_component_procs(j,n),j=1,num_component_procs(n) )
113     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
114     & ' comp+cplr=',component_Name(n),
115     & ( rank_compcplr_procs(j,n),j=1,num_compcplr_procs(n) )
116     enddo
117    
118 jmc 1.2 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
119 jmc 1.1
120     ! Create new groups and communicators
121    
122     ! Establish MPI_GROUP_World associated with MPI_COMM_WORLD
123     call MPI_Comm_group( MPI_COMM_WORLD, MPI_GROUP_World, ierr )
124     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
125     & ' MPI_Comm_group MPI_GROUP_World=',MPI_GROUP_World,
126     & ' ierr=',ierr
127    
128     do n=1,num_components
129    
130     ! Create group MPI_GROUP_Tmp
131     call MPI_Group_incl(
132     & MPI_GROUP_World,
133     & num_component_procs(n),
134     & rank_component_procs(1,n),
135     & MPI_GROUP_Tmp,
136     & ierr )
137     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
138     & ' MPI_Group_incl MPI_GROUP_Tmp=',
139     & MPI_GROUP_Tmp,' ierr=',ierr
140    
141     ! Create communicator MPI_COMM_component
142     call MPI_Comm_create(
143     & MPI_COMM_WORLD,
144     & MPI_GROUP_Tmp,
145     & MPI_COMM_component(n),
146     & ierr )
147     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
148     & ' MPI_Comm_create MPI_COMM_component=',MPI_COMM_component(n),
149     & ' ierr=',ierr
150    
151     ! Create group MPI_GROUP_Tmp
152     call MPI_Group_incl(
153     & MPI_GROUP_World,
154     & num_compcplr_procs(n),
155     & rank_compcplr_procs(1,n),
156     & MPI_GROUP_Tmp,
157     & ierr )
158     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
159     & ' MPI_Group_incl MPI_GROUP_Tmp=',
160     & MPI_GROUP_Tmp,' ierr=',ierr
161    
162     ! Create communicator MPI_COMM_compcplr
163     call MPI_Comm_create(
164     & MPI_COMM_WORLD,
165     & MPI_GROUP_Tmp,
166     & MPI_COMM_compcplr(n),
167     & ierr )
168     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
169     & ' MPI_Comm_create MPI_COMM_compcplr=',MPI_COMM_compcplr(n),
170     & ' ierr=',ierr
171    
172     enddo
173    
174 jmc 1.2 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
175 jmc 1.1
176     if ( couplerFlag ) then
177     my_component_ind=-1
178     MPI_COMM_mylocal=MPI_COMM_World
179     MPI_COMM_myglobal=MPI_COMM_World
180     my_component_name=coupler_Name
181     else
182     compind=mitcplr_match_comp( myTypeStr )
183     my_component_ind=compind
184     MPI_COMM_mylocal=MPI_COMM_component( compind )
185     MPI_COMM_myglobal=MPI_COMM_compcplr( compind )
186     my_component_name=component_Name( compind )
187     endif
188    
189     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
190     & ' component num=',compind,
191     & ' MPI_COMM=',MPI_COMM_mylocal,MPI_COMM_myglobal
192    
193     if ( couplerFlag ) then
194     do n=1,num_components
195     ! Find-out my position (rank) in the "global" communicator
196     call MPI_COMM_RANK( MPI_COMM_compcplr(n), j, ierr )
197     if (ierr.ne.0) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
198     & ' Rank = ',j,' MPI_COMM_RANK ierr=',ierr
199     ! How big is the "global" communicator?
200     call MPI_COMM_SIZE( MPI_COMM_compcplr(n), numprocs, ierr )
201     if (ierr.ne.0) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
202     & ' Size = ',numprocs,' MPI_COMM_SIZE ierr=',ierr
203     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
204     & ' Rank/Size = ',j,' /',numprocs,
205     & ' in Component =',n
206     enddo
207     else
208     ! Find-out my position (rank) in the "global" communicator
209     call MPI_COMM_RANK( MPI_COMM_myglobal, j, ierr )
210     if (ierr.ne.0) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
211     & ' Rank = ',j,' MPI_COMM_RANK ierr=',ierr
212     ! How big is the "global" communicator?
213     call MPI_COMM_SIZE( MPI_COMM_myglobal, numprocs, ierr )
214     if (ierr.ne.0) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
215     & ' Size = ',numprocs,' MPI_COMM_SIZE ierr=',ierr
216     if (DEBUG) write(0,*) 'MITCPLR_init1: ',myid,' ',myTypeStr,
217     & ' Rank/Size = ',j,' /',numprocs
218     endif
219    
220     ! Open log file
221     if ( couplerFlag ) j=myid
222     write(cbuf(1:MAXLEN_COMP_NAME),'(2a,i4.4,a)')
223     & myTypeStr,'.',j,'.clog'
224     open(LogUnit,file=cbuf,status='unknown',form='formatted')
225     write(LogUnit,'(2a)') '========================================',
226     & '========================================'
227     write(LogUnit,*) 'This is "',myTypeStr,'"'
228     write(LogUnit,*) 'myid in MPI_COMM_World = ',myid
229 jmc 1.2 if (.not.couplerFlag)
230 jmc 1.1 & write(LogUnit,*) 'myid in MPI_COMM_Global = ',j
231    
232     ! ------------------------------------------------------------------
233     return
234     end
235     !=======================================================================
  ViewVC Help
Powered by ViewVC 1.1.22