pkg/compon_communic/mitcoupler_tile_register.F

bf4be02920 Jean*0001 !=======================================================================
                0002       subroutine MITCOUPLER_tile_register( compName, nnx, nny )
                0003       implicit none
                0004
                0005 ! Arguments
                0006       character*(*) compName
                0007       integer nnx, nny
                0008
                0009 ! MPI variables
                0010 #include "mpif.h"
                0011
                0012 ! Predefined constants/arrays
                0013 #include "CPLR_SIG.h"
                0014
                0015 ! Functions
                0016       integer mitcplr_match_comp
                0017       integer generate_tag
606b85c866 Jean*0018       external mitcplr_match_comp
                0019       external generate_tag
bf4be02920 Jean*0020
                0021 ! Local
                0022       integer n,numprocs
                0023       integer comm
                0024       integer compind,count,dtype,tag,rank
606b85c866 Jean*0025       integer ierr
bf4be02920 Jean*0026       integer stat(MPI_STATUS_SIZE)
606b85c866 Jean*0027       integer j, numtiles
                0028       integer nx, ny, i0, j0
                0029       integer ibuf(MAX_IBUF)
bf4be02920 Jean*0030
                0031 !     ------------------------------------------------------------------
                0032
606b85c866 Jean*0033       write(LogUnit,'(3A)')
                0034      &    'MITCOUPLER_tile_register: do "', compName, '" :'
                0035
bf4be02920 Jean*0036 ! Establish who I am communicating with
                0037       compind=mitcplr_match_comp( compName )
606b85c866 Jean*0038       if (compind.le.0) STOP 'MITCOUPLER_tile_register: Bad component'
bf4be02920 Jean*0039       comm=MPI_COMM_compcplr( compind )
                0040       numprocs=num_component_procs(compind)
606b85c866 Jean*0041
                0042       write(LogUnit,'(2(A,I6))')
                0043      &        ' compind=', compind, ' ; numprocs=', numprocs
bf4be02920 Jean*0044       if (numprocs.lt.1) then
606b85c866 Jean*0045        STOP 'MITCOUPLER_tile_register: numprocs < 1'
bf4be02920 Jean*0046       endif
                0047
                0048 ! Foreach component process
                0049       do n=1,numprocs
                0050
                0051 ! Receive message
                0052        count=MAX_IBUF
                0053        dtype=MPI_INTEGER
                0054        tag=generate_tag(112,n,'Register Tiles')
                0055        rank=rank_component_procs(n,compind)
                0056
                0057        call MPI_Recv(ibuf, count, dtype, rank, tag, comm, stat, ierr)
951926fb9b Jean*0058
bf4be02920 Jean*0059        if (ierr.ne.0) then
                0060         write(LogUnit,*) 'MITCOUPLER_tile_register: rank(W,G)=',
                0061      &            my_rank_in_world,my_rank_in_global,
                0062      &            ' ierr=',ierr
606b85c866 Jean*0063         STOP 'MITCOUPLER_tile_register: MPI_Recv failed'
bf4be02920 Jean*0064        endif
                0065
                0066        numtiles=ibuf(1)
                0067        if (numtiles.lt.1 .or. numtiles.gt.MAX_TILES) then
                0068         write(LogUnit,*) 'MITCOUPLER_tile_register: #tiles = ',numtiles
606b85c866 Jean*0069         STOP 'MITCOUPLER_tile_register: invalid value for numtiles'
bf4be02920 Jean*0070        endif
                0071        component_num_tiles(n,compind)=numtiles
                0072
606b85c866 Jean*0073        write(LogUnit,'(3(A,I6),A)')   '- proc # =', n,
                0074      &     ' ; rank=', rank, ' ; numtiles=', numtiles, '  -------'
bf4be02920 Jean*0075        do j=1,numtiles
                0076
                0077 ! Receive message
                0078         count=MAX_IBUF
                0079         dtype=MPI_INTEGER
                0080         tag=generate_tag(113,j,'Register each tile')
                0081         rank=rank_component_procs(n,compind)
                0082
                0083         call MPI_Recv(ibuf, count, dtype, rank, tag, comm, stat, ierr)
                0084
                0085         if (ierr.ne.0) then
                0086          write(LogUnit,*) 'MITCOUPLER_tile_register: rank(W,G)=',
                0087      &            my_rank_in_world,my_rank_in_global,
                0088      &            ' ierr=',ierr
606b85c866 Jean*0089          STOP 'MITCOUPLER_tile_register: MPI_Recv failed'
bf4be02920 Jean*0090         endif
                0091
606b85c866 Jean*0092 ! Extract data and store
                0093         nx = ibuf(1)
                0094         ny = ibuf(2)
                0095         i0 = ibuf(3)
                0096         j0 = ibuf(4)
                0097         component_tile_nx(j,n,compind) = nx
                0098         component_tile_ny(j,n,compind) = ny
                0099         component_tile_i0(j,n,compind) = i0
                0100         component_tile_j0(j,n,compind) = j0
                0101
                0102 ! Print and check
                0103         write(LogUnit,'(A,I5,A,2I5,A,2I8)') ' tile #:', j,
                0104      &     ' ; Ni,Nj=', nx, ny, ' ; Io,Jo=', i0, j0
                0105
                0106         if (nx.lt.1) then
                0107          STOP 'MITCOUPLER_tile_register: invalid value for nx'
                0108         endif
                0109         if (ny.lt.1) then
                0110          STOP 'MITCOUPLER_tile_register: invalid value for ny'
                0111         endif
                0112         if (i0.lt.1) then
                0113          STOP 'MITCOUPLER_tile_register: invalid value for i0'
                0114         endif
                0115         if (j0.lt.1) then
                0116          STOP 'MITCOUPLER_tile_register: invalid value for j0'
                0117         endif
                0118         if (i0+nx-1.gt.nnx) then
                0119          STOP 'MITCOUPLER_tile_register: i0 + nx -1 > nnx'
                0120         endif
                0121         if (j0+ny-1.gt.nny) then
                0122          STOP 'MITCOUPLER_tile_register: j0 + ny -1 > nny'
bf4be02920 Jean*0123         endif
                0124
                0125        enddo ! j
606b85c866 Jean*0126        write(LogUnit,'(A,2I8,2(A,I8))')
                0127      &     ' rank(W,G)=', my_rank_in_world, my_rank_in_global,
                0128      &     ' , rank = ',rank, ' , num_tiles = ', numtiles
bf4be02920 Jean*0129
                0130       enddo ! n
                0131
606b85c866 Jean*0132       write(LogUnit,'(3A)') 'MITCOUPLER_tile_register: comp. "',
                0133      &                         compName, '" done'
                0134
bf4be02920 Jean*0135 !     ------------------------------------------------------------------
                0136       call flush(LogUnit)
                0137       return
                0138       end
                0139 !=======================================================================