pkg/compon_communic/mitcplr_init2a.F

bf4be02920 Jean*0001 !=======================================================================
                0002       subroutine mitcplr_init2a( 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
bf4be02920 Jean*0012 ! Local
191b8c84d5 Jean*0013       integer myid, numprocs, ierr
bf4be02920 Jean*0014       integer n,j,lenbuf
191b8c84d5 Jean*0015       integer ibuf(MAX_IBUF)
bf4be02920 Jean*0016 !     ------------------------------------------------------------------
                0017
                0018 ! Find-out my position (rank) in the "global" communicator
                0019       call MPI_COMM_RANK( MPI_COMM_myglobal, myid, ierr )
                0020       if (ierr.ne.0) write(LogUnit,*) 'MITCPLR_init2a: ',
                0021      &     ' Rank = ',myid,' MPI_COMM_RANK ierr=',ierr
                0022 ! How big is the "global" comminicator?
                0023       call MPI_COMM_SIZE( MPI_COMM_myglobal, numprocs, ierr )
                0024       if (ierr.ne.0) write(LogUnit,*) 'MITCPLR_init2a: ',
                0025      &     ' Size = ',numprocs,' MPI_COMM_RANK ierr=',ierr
                0026       if (VERB) write(LogUnit,*) 'MITCPLR_init2a: ',
                0027      &     ' Rank/Size = ',myid,' /',numprocs
                0028
951926fb9b Jean*0029 !     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
bf4be02920 Jean*0030
                0031 ! Assume nothing again
                0032       num_coupler_procs=0
                0033
                0034 ! Receive a message from each of the other processes in "myglobal"
                0035       do n=0,numprocs-1
                0036        ibuf( 1)=myid
                0037        ibuf( 2)=0
                0038        ibuf( 3)=0
                0039        ibuf( 4)=0
                0040        ibuf( 5)=0
                0041        ibuf( 6)=0
                0042        ibuf( 7)=0
                0043        ibuf( 8)=0
                0044        ibuf( 9)=0
                0045        ibuf(10)=0
                0046        ibuf(11)=0
                0047        ibuf(12)=0
                0048        lenbuf=12
                0049        call MPI_Bcast(
                0050      &               ibuf, lenbuf, MPI_INTEGER,
951926fb9b Jean*0051      &               n,
bf4be02920 Jean*0052      &               MPI_COMM_myglobal, ierr )
                0053        if (ierr.ne.0) write(LogUnit,*) 'MITCPLR_init2a: ',
                0054      &    ' MPI_Bcast from ',ibuf(1),ibuf(2),' ierr=',ierr
                0055
                0056        if ( ibuf(2).eq.MITCPLR_COUPLER ) then
                0057 ! If the broadcaster is the "coupler"
                0058         num_coupler_procs=num_coupler_procs + 1
                0059         num_procs_in_global=num_procs_in_global+1
                0060         rank_coupler_procs(num_coupler_procs) = ibuf(1)
                0061        else
                0062 ! If the broadcaster is a "component"
                0063         num_procs_in_local=num_procs_in_local+1
                0064         num_procs_in_global=num_procs_in_global+1
                0065        endif
                0066
                0067       enddo
                0068
                0069       if (num_coupler_procs .ne. 1) then
191b8c84d5 Jean*0070        STOP 'MITCPLR_init2a: I can only handle one coupling process'
bf4be02920 Jean*0071       endif
                0072
951926fb9b Jean*0073 !     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
bf4be02920 Jean*0074
                0075 ! Find-out my position (rank) in the "world" communicator
                0076       call MPI_COMM_RANK( MPI_COMM_World, n, ierr )
                0077       if (ierr.ne.0) write(LogUnit,*) 'MITCPLR_init2a: ',
                0078      &     ' Rank = ',myid,' MPI_COMM_RANK ierr=',ierr
                0079 ! Find-out my position (rank) in the "local" communicator
                0080       call MPI_COMM_RANK( MPI_COMM_myglobal, j, ierr )
                0081       if (ierr.ne.0) write(LogUnit,*) 'MITCPLR_init2a: ',
                0082      &     ' Rank = ',myid,' MPI_COMM_RANK ierr=',ierr
                0083
                0084 ! Store the information
                0085       my_coupler_rank=rank_coupler_procs(1)
                0086       my_rank_in_world=n
                0087       my_rank_in_global=myid
                0088       my_rank_in_local=j
                0089
                0090       if (VERB) write(LogUnit,*) 'MITCPLR_init2a: ',
                0091      &     ' rank (W,G,L) =',
                0092      &     my_rank_in_world,my_rank_in_global,my_rank_in_local,
                0093      &     ' my_coupler_rank =',my_coupler_rank,' /',numprocs
                0094
                0095 !     ------------------------------------------------------------------
                0096       call flush(LogUnit)
                0097       return
                0098       end
                0099 !=======================================================================