pkg/compon_communic/mitcplr_init2b.F

bf4be02920 Jean*0001 !=======================================================================
                0002       subroutine mitcplr_init2b( myTypeStr )
191b8c84d5 Jean*0003
bf4be02920 Jean*0004       implicit none
                0005 ! Predefined constants/arrays
                0006 #include "CPLR_SIG.h"
                0007 ! MPI variables
                0008 #include "mpif.h"
191b8c84d5 Jean*0009
                0010 ! Arguments
                0011       character*(*) myTypeStr
                0012 ! Local
bf4be02920 Jean*0013       integer myid, numprocs, ierr
                0014       integer MPI_COMM_temp
                0015       integer n,j,lenbuf,compind
191b8c84d5 Jean*0016       integer ibuf(MAX_IBUF)
bf4be02920 Jean*0017 !     ------------------------------------------------------------------
                0018
                0019 ! Foreach component type
                0020       do compind = 1,num_components
                0021
                0022        MPI_COMM_temp=MPI_COMM_compcplr(compind)
                0023
                0024 ! Find-out my position (rank) in the "global" communicator
                0025        call MPI_COMM_RANK( MPI_COMM_temp, myid, ierr )
                0026        if (ierr.ne.0) write(LogUnit,*) 'MITCPLR_init2b: ',
                0027      &     ' Rank = ',myid,' MPI_COMM_RANK ierr=',ierr
                0028 ! How big is the "global" comminicator?
                0029        call MPI_COMM_SIZE( MPI_COMM_temp, numprocs, ierr )
                0030        if (ierr.ne.0) write(LogUnit,*) 'MITCPLR_init2b: ',
                0031      &     ' Size = ',numprocs,' MPI_COMM_RANK ierr=',ierr
                0032        if (DEBUG) write(LogUnit,*) 'MITCPLR_init2b: ',
                0033      &     ' Rank/Size = ',myid,' /',numprocs
                0034
951926fb9b Jean*0035 !     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
bf4be02920 Jean*0036
                0037 ! Assume nothing again
                0038        num_coupler_procs=0
                0039        num_component_procs(compind)=0
                0040        num_compcplr_procs(compind)=0
                0041
                0042 ! Receive a message from each of the other processes in "myglobal"
                0043        do n=0,numprocs-1
                0044         ibuf( 1)=myid
                0045         ibuf( 2)=MITCPLR_COUPLER
                0046         ibuf( 3)=0
                0047         ibuf( 4)=0
                0048         ibuf( 5)=0
                0049         ibuf( 6)=0
                0050         ibuf( 7)=0
                0051         ibuf( 8)=0
                0052         ibuf( 9)=0
                0053         ibuf(10)=0
                0054         ibuf(11)=0
                0055         ibuf(12)=0
                0056         lenbuf=12
                0057         call MPI_Bcast(
                0058      &               ibuf, lenbuf, MPI_INTEGER,
951926fb9b Jean*0059      &               n,
bf4be02920 Jean*0060      &               MPI_COMM_temp, ierr )
                0061         if (ierr.ne.0) write(LogUnit,*) 'MITCPLR_init2b: ',
                0062      &    ' MPI_Bcast from ',ibuf(1),ibuf(2),' ierr=',ierr
                0063
                0064         if ( ibuf(2).eq.MITCPLR_COUPLER ) then
                0065 ! If the broadcaster is the "coupler"
                0066          num_coupler_procs=num_coupler_procs + 1
                0067          rank_coupler_procs(num_coupler_procs) = ibuf(1)
                0068          num_compcplr_procs(compind)=num_compcplr_procs(compind) + 1
                0069          j=num_compcplr_procs(compind)
                0070          rank_compcplr_procs(j,compind)=ibuf(1)
                0071         else
                0072 ! If the broadcaster is a "component"
                0073          num_component_procs(compind)=num_component_procs(compind) + 1
                0074          j=num_component_procs(compind)
                0075          rank_component_procs(j,compind)=ibuf(1)
                0076          num_compcplr_procs(compind)=num_compcplr_procs(compind) + 1
                0077          j=num_compcplr_procs(compind)
                0078          rank_compcplr_procs(j,compind)=ibuf(1)
                0079         endif
                0080
                0081        enddo
                0082
                0083        if (num_coupler_procs .ne. 1) then
191b8c84d5 Jean*0084         STOP 'MITCPLR_init2b: I can only handle one coupling process'
bf4be02920 Jean*0085        endif
                0086
                0087       enddo
                0088
951926fb9b Jean*0089 !     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
bf4be02920 Jean*0090
                0091       do compind = 1,num_components
                0092        write(LogUnit,*) 'MITCPLR_init2b: ',
                0093      &      MPI_COMM_compcplr(compind),
                0094      &     ' comp. ranks = ',(rank_component_procs(j,compind),
                0095      &                        j=1,num_component_procs(compind) )
                0096        write(LogUnit,*) 'MITCPLR_init2b: ',
                0097      &      MPI_COMM_compcplr(compind),
                0098      &     ' c+c ranks = ',(rank_compcplr_procs(j,compind),
                0099      &                        j=1,num_compcplr_procs(compind) )
                0100       enddo
                0101
                0102 !     ------------------------------------------------------------------
                0103       call flush(LogUnit)
                0104       return
                0105       end
                0106 !=======================================================================