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

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

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

Revision 1.1 - (hide annotations) (download)
Mon Dec 15 02:35:29 2003 UTC (20 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint57t_post, checkpoint57o_post, checkpoint52l_pre, checkpoint52e_pre, hrcube4, checkpoint58e_post, checkpoint57v_post, checkpoint52n_post, checkpoint52j_post, checkpoint53d_post, checkpoint58u_post, checkpoint58w_post, checkpoint54a_pre, checkpoint57m_post, checkpoint55c_post, checkpoint54e_post, checkpoint52e_post, checkpoint57s_post, checkpoint54a_post, checkpoint53c_post, checkpoint57k_post, checkpoint55d_pre, checkpoint57d_post, checkpoint57g_post, checkpoint57b_post, checkpoint57c_pre, checkpoint58r_post, checkpoint55j_post, checkpoint56b_post, checkpoint57i_post, checkpoint57y_post, checkpoint57e_post, checkpoint52l_post, checkpoint55h_post, checkpoint58n_post, checkpoint58x_post, checkpoint52k_post, checkpoint57g_pre, checkpoint54b_post, checkpoint53b_pre, checkpoint55b_post, checkpoint58t_post, checkpoint58h_post, checkpoint54d_post, checkpoint56c_post, checkpoint52m_post, checkpoint57y_pre, checkpoint55, checkpoint53a_post, checkpoint57f_pre, checkpoint57a_post, checkpoint54, checkpoint58q_post, checkpoint54f_post, checkpoint53b_post, checkpoint55g_post, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint55f_post, checkpoint59c, checkpoint59b, checkpoint59h, checkpoint57r_post, checkpoint59, checkpoint58, checkpoint57a_pre, checkpoint55i_post, checkpoint57, checkpoint56, checkpoint53, checkpoint52d_post, eckpoint57e_pre, checkpoint57h_done, checkpoint58f_post, checkpoint53g_post, checkpoint52f_post, checkpoint57x_post, checkpoint57n_post, checkpoint58d_post, checkpoint58c_post, checkpoint57w_post, checkpoint57p_post, checkpint57u_post, checkpoint57f_post, checkpoint58a_post, checkpoint58i_post, checkpoint57q_post, checkpoint58g_post, hrcube5, checkpoint58o_post, checkpoint57z_post, checkpoint57c_post, checkpoint58y_post, checkpoint55e_post, checkpoint58k_post, checkpoint52i_post, checkpoint52j_pre, checkpoint58v_post, checkpoint53f_post, checkpoint55a_post, checkpoint53d_pre, checkpoint54c_post, checkpoint58s_post, checkpoint58p_post, checkpoint57j_post, checkpoint58b_post, checkpoint57h_pre, checkpoint58m_post, checkpoint57l_post, checkpoint52i_pre, checkpoint52h_pre, checkpoint52f_pre, checkpoint57h_post, hrcube_2, hrcube_3, checkpoint56a_post, checkpoint55d_post 
coupler - multi-components interface: low-level communication S/R package.
1 jmc 1.1 !=======================================================================
2     subroutine mitcplr_init2b( myTypeStr )
3     implicit none
4     ! Arguments
5     character*(*) myTypeStr
6     ! Predefined constants/arrays
7     #include "CPLR_SIG.h"
8     ! MPI variables
9     #include "mpif.h"
10     integer myid, numprocs, ierr
11     integer MPI_COMM_temp
12     ! Local
13     integer n,j,lenbuf,compind
14     ! ------------------------------------------------------------------
15    
16     ! Foreach component type
17     do compind = 1,num_components
18    
19     MPI_COMM_temp=MPI_COMM_compcplr(compind)
20    
21     ! Find-out my position (rank) in the "global" communicator
22     call MPI_COMM_RANK( MPI_COMM_temp, myid, ierr )
23     if (ierr.ne.0) write(LogUnit,*) 'MITCPLR_init2b: ',
24     & ' Rank = ',myid,' MPI_COMM_RANK ierr=',ierr
25     ! How big is the "global" comminicator?
26     call MPI_COMM_SIZE( MPI_COMM_temp, numprocs, ierr )
27     if (ierr.ne.0) write(LogUnit,*) 'MITCPLR_init2b: ',
28     & ' Size = ',numprocs,' MPI_COMM_RANK ierr=',ierr
29     if (DEBUG) write(LogUnit,*) 'MITCPLR_init2b: ',
30     & ' Rank/Size = ',myid,' /',numprocs
31    
32     ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
33    
34     ! Assume nothing again
35     num_coupler_procs=0
36     num_component_procs(compind)=0
37     num_compcplr_procs(compind)=0
38    
39     ! Receive a message from each of the other processes in "myglobal"
40     do n=0,numprocs-1
41     ibuf( 1)=myid
42     ibuf( 2)=MITCPLR_COUPLER
43     ibuf( 3)=0
44     ibuf( 4)=0
45     ibuf( 5)=0
46     ibuf( 6)=0
47     ibuf( 7)=0
48     ibuf( 8)=0
49     ibuf( 9)=0
50     ibuf(10)=0
51     ibuf(11)=0
52     ibuf(12)=0
53     lenbuf=12
54     call MPI_Bcast(
55     & ibuf, lenbuf, MPI_INTEGER,
56     & n,
57     & MPI_COMM_temp, ierr )
58     if (ierr.ne.0) write(LogUnit,*) 'MITCPLR_init2b: ',
59     & ' MPI_Bcast from ',ibuf(1),ibuf(2),' ierr=',ierr
60    
61     if ( ibuf(2).eq.MITCPLR_COUPLER ) then
62     ! If the broadcaster is the "coupler"
63     num_coupler_procs=num_coupler_procs + 1
64     rank_coupler_procs(num_coupler_procs) = ibuf(1)
65     num_compcplr_procs(compind)=num_compcplr_procs(compind) + 1
66     j=num_compcplr_procs(compind)
67     rank_compcplr_procs(j,compind)=ibuf(1)
68     else
69     ! If the broadcaster is a "component"
70     num_component_procs(compind)=num_component_procs(compind) + 1
71     j=num_component_procs(compind)
72     rank_component_procs(j,compind)=ibuf(1)
73     num_compcplr_procs(compind)=num_compcplr_procs(compind) + 1
74     j=num_compcplr_procs(compind)
75     rank_compcplr_procs(j,compind)=ibuf(1)
76     endif
77    
78     enddo
79    
80     if (num_coupler_procs .ne. 1) then
81     stop 'MITCPLR_init2b: I can only handle one coupling process'
82     endif
83    
84     enddo
85    
86     ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
87    
88     do compind = 1,num_components
89     write(LogUnit,*) 'MITCPLR_init2b: ',
90     & MPI_COMM_compcplr(compind),
91     & ' comp. ranks = ',(rank_component_procs(j,compind),
92     & j=1,num_component_procs(compind) )
93     write(LogUnit,*) 'MITCPLR_init2b: ',
94     & MPI_COMM_compcplr(compind),
95     & ' c+c ranks = ',(rank_compcplr_procs(j,compind),
96     & j=1,num_compcplr_procs(compind) )
97     enddo
98    
99     ! ------------------------------------------------------------------
100     call flush(LogUnit)
101     return
102     end
103     !=======================================================================
  ViewVC Help
Powered by ViewVC 1.1.22