pkg/compon_communic/mitcoupler_register.F

bf4be02920 Jean*0001 !=======================================================================
                0002       subroutine MITCOUPLER_register( compName, nnx, nny )
                0003       implicit none
                0004
                0005 ! MPI variables
                0006 #include "mpif.h"
                0007
                0008 ! Predefined constants/arrays
                0009 #include "CPLR_SIG.h"
                0010
191b8c84d5 Jean*0011 ! Arguments
                0012       character*(*) compName
                0013       integer nnx, nny
                0014
bf4be02920 Jean*0015 ! Functions
                0016       integer mitcplr_match_comp
                0017       integer generate_tag
191b8c84d5 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
191b8c84d5 Jean*0025       integer ierr
bf4be02920 Jean*0026       integer stat(MPI_STATUS_SIZE)
191b8c84d5 Jean*0027       integer numtiles,nx,ny,i0,j0
                0028       integer ibuf(MAX_IBUF)
bf4be02920 Jean*0029
                0030 !     ------------------------------------------------------------------
                0031
                0032 ! Establish who I am communicating with
                0033       compind=mitcplr_match_comp( compName )
191b8c84d5 Jean*0034       if (compind.le.0) STOP 'MITCOUPLER_register: Bad component'
bf4be02920 Jean*0035       comm=MPI_COMM_compcplr( compind )
                0036       numprocs=num_component_procs(compind)
                0037       if (numprocs.lt.1) then
                0038        write(LogUnit,*) 'MITCOUPLER_register: compind = ',compind
191b8c84d5 Jean*0039        STOP 'MITCOUPLER_register: numprocs < 1'
bf4be02920 Jean*0040       endif
                0041
                0042 ! Foreach component process
                0043       do n=1,numprocs
                0044
                0045 ! Receive message
                0046        count=MAX_IBUF
                0047        dtype=MPI_INTEGER
                0048        tag=generate_tag(115,n,'Register')
                0049        rank=rank_component_procs(n,compind)
                0050
                0051        call MPI_Recv(ibuf, count, dtype, rank, tag, comm, stat, ierr)
                0052
                0053        if (ierr.ne.0) then
                0054         write(LogUnit,*) 'MITCOUPLER_register: rank(W,G)=',
                0055      &            my_rank_in_world,my_rank_in_global,
                0056      &            ' ierr=',ierr
191b8c84d5 Jean*0057         STOP 'MITCOUPLER_register: MPI_Recv failed'
bf4be02920 Jean*0058        endif
                0059
                0060 ! Extract data
                0061        numtiles=ibuf(1)
                0062        nx=ibuf(2)
                0063        ny=ibuf(3)
                0064        i0=ibuf(4)
                0065        j0=ibuf(5)
                0066
                0067        if (numtiles.ne.1) then
                0068         write(LogUnit,*) 'MITCOUPLER_tile_register: #tiles = ',numtiles
191b8c84d5 Jean*0069         STOP 'MITCOUPLER_tile_register: invalid value for numtiles'
bf4be02920 Jean*0070        endif
                0071        if (nx.lt.1) then
                0072         write(LogUnit,*) 'MITCOUPLER_register: nx = ',nx
191b8c84d5 Jean*0073         STOP 'MITCOUPLER_register: invalid value for nx'
bf4be02920 Jean*0074        endif
                0075        if (ny.lt.1) then
                0076         write(LogUnit,*) 'MITCOUPLER_register: ny = ',ny
191b8c84d5 Jean*0077         STOP 'MITCOUPLER_register: invalid value for ny'
bf4be02920 Jean*0078        endif
                0079        if (i0.lt.1) then
                0080         write(LogUnit,*) 'MITCOUPLER_register: i0 = ',i0
191b8c84d5 Jean*0081         STOP 'MITCOUPLER_register: invalid value for i0'
bf4be02920 Jean*0082        endif
                0083        if (j0.lt.1) then
                0084         write(LogUnit,*) 'MITCOUPLER_register: j0 = ',j0
191b8c84d5 Jean*0085         STOP 'MITCOUPLER_register: invalid value for j0'
bf4be02920 Jean*0086        endif
                0087        if (i0+nx-1.gt.nnx) then
                0088         write(LogUnit,*) 'MITCOUPLER_register: i0 = ',i0
191b8c84d5 Jean*0089         STOP 'MITCOUPLER_register: i0 + nx -1 > nnx'
bf4be02920 Jean*0090        endif
                0091        if (j0+ny-1.gt.nny) then
                0092         write(LogUnit,*) 'MITCOUPLER_register: j0 = ',j0
191b8c84d5 Jean*0093         STOP 'MITCOUPLER_register: j0 + ny -1 > nny'
bf4be02920 Jean*0094        endif
                0095
                0096        component_num_tiles(n,compind)=1
                0097        component_tile_nx(1,n,compind)=nx
                0098        component_tile_ny(1,n,compind)=ny
                0099        component_tile_i0(1,n,compind)=i0
                0100        component_tile_j0(1,n,compind)=j0
                0101
                0102       enddo ! n
                0103
                0104       do n=1,numprocs
                0105        write(LogUnit,*) 'MITCOUPLER_register: proc,nx,ny = ',n,
                0106      &    component_tile_nx(1,n,compind),component_tile_ny(1,n,compind)
                0107       enddo ! n
                0108
                0109 !     ------------------------------------------------------------------
                0110       call flush(LogUnit)
                0111       return
                0112       end
                0113 !=======================================================================