copyright (C) 2001  MSC-RPN COMM  %%%MC2%%%

      subroutine topoinit 1
      implicit none
*
#include "lcldim.cdk"
#include "bcsdim.cdk"
#include "nestpnt.cdk"
#include "partopo.cdk"
      include 'mpif.h'
*
      integer  iproc, glbpos(4,0:numproc-1), err, tag, status, bid,
     $         ijdeb(2), ijfin(2), ofn, ofw, ofe
      data tag / 44 /
*
*----------------------------------------------------------------------
*
      do iproc = 0, numproc-1
         glbpos(1,iproc) = 0
         glbpos(2,iproc) = 0
         glbpos(3,iproc) = 0
         glbpos(4,iproc) = 0
      end do
*
      call rpn_comm_topo (Gni,minx,maxx,ldni,err,
     $                    hx,glbpos(1,myproc),.true.,.true.) 
      call rpn_comm_topo (Gnj,miny,maxy,ldnj,err,
     $                    hy,glbpos(3,myproc),.false.,.true.)
*
      glbpos(2,myproc) = glbpos(1,myproc) + ldni - 1
      glbpos(4,myproc) = glbpos(3,myproc) + ldnj - 1
      call MPI_ALLREDUCE (glbpos,gc_ld,numproc*4,
     $                    MPI_INTEGER,MPI_BOR,MPI_COMM_WORLD,err)
*
      if (blocme.eq.(numpe_perb-1)) then
         ijfin(1) = gc_ld(2,myproc)
         ijfin(2) = gc_ld(4,myproc)
         do bid=0,numpe_perb-2
           call RPN_COMM_send ( ijfin, 2, 'MPI_INTEGER', bid,
     $                                      tag, 'BLOC', err )
         end do
      endif
      if (blocme.ne.(numpe_perb-1)) then
         call RPN_COMM_recv ( ijfin, 2, 'MPI_INTEGER', (numpe_perb-1), 
     $                                     tag, 'BLOC', status, err )
      endif
      glb_pos (2) = ijfin(1)
      glb_pos (4) = ijfin(2)
*
      if (blocme.eq.0) then
         ijdeb(1) = gc_ld(1,myproc)
         ijdeb(2) = gc_ld(3,myproc)
         do bid=1,numpe_perb-1
           call RPN_COMM_send ( ijdeb, 2, 'MPI_INTEGER', bid,
     $                                      tag, 'BLOC', err )
         end do
      endif
      if (blocme.ne.0) then
         call RPN_COMM_recv ( ijdeb, 2, 'MPI_INTEGER', 0, 
     $                          tag, 'BLOC', status, err )
      endif
      glb_pos (1) = ijdeb(1)
      glb_pos (3) = ijdeb(2)
      b_ni = glb_pos (2) - glb_pos (1) + 1
      b_nj = glb_pos (4) - glb_pos (3) + 1
*
      maxldni = 0
      maxldnj = 0
      do iproc = 0, numproc-1
         maxldni = max(maxldni,(gc_ld(2,iproc)-gc_ld(1,iproc)+1))
         maxldnj = max(maxldnj,(gc_ld(4,iproc)-gc_ld(3,iproc)+1))
      end do
*
      lani  = maxx - minx + 1
      lanj  = maxy - miny + 1
      dim3d = lani*lanj*gnk
      dim2d = lani*lanj
*
      west  = 0
      east  = 0
      south = 0
      north = 0
       west_L = .false.
       east_L = .false.
      south_L = .false.
      north_L = .false.
*
      if (myrow.eq.    0) then
         west_L = .true.
         if (.not.period_x) west  = 1
      endif         
      if (myrow.eq.npex-1) then
         east_L = .true.
         if (.not.period_x) east  = 1
      endif
      if (mycol.eq.0    )  then
         south_L = .true.
         if (.not.period_y) south = 1
      endif
      if (mycol.eq.npey-1) then
         north_L = .true.
         if (.not.period_y) north = 1
      endif
*
      b_west  = 0
      b_east  = 0
      b_south = 0
      b_north = 0
      b_west_L  = myblocx .eq. 0
      b_south_L = myblocy .eq. 0
      b_east_L  = myblocx .eq. nblocx-1
      b_north_L = myblocy .eq. nblocy-1
      if (b_west_L ) b_west  = 1
      if (b_east_L ) b_east  = 1
      if (b_south_L) b_south = 1
      if (b_north_L) b_north = 1
*
* Dimensions for boundary conditions storage
*
      dimxs = 0
      dimys = 0
      dimxn = 0
      dimyn = 0
      dimxw = 0
      dimyw = 0
      dimxe = 0
      dimye = 0
      minxs = 1    - west*hx
      maxxs = ldni + east*hx
      minys = 1 - hy
      maxys = Hblen_y + 1
      if (south_L) then
         dimxs = maxxs - minxs + 1
         dimys = maxys - minys + 1
      endif
      minxn = 1    - west*hx
      maxxn = ldni + east*hx
      minyn = ldnj - Hblen_y
      maxyn = ldnj + hy
      if (north_L) then
         dimxn = maxxn - minxn + 1
         dimyn = maxyn - minyn + 1
      endif
      minxw = 1 - hx
      maxxw = Hblen_x + 1
      minyw = 1    + south*(Hblen_y)
      maxyw = ldnj - north*(Hblen_y)
      if (west_L ) then
         dimxw = maxxw - minxw + 1
         dimyw = maxyw - minyw + 1
      endif
      minxe = ldni - Hblen_x
      maxxe = ldni + hx
      minye = 1    + south*(Hblen_y)
      maxye = ldnj - north*(Hblen_y)
      if (east_L ) then
         dimxe = maxxe - minxe + 1
         dimye = maxye - minye + 1
      endif
*
      bcs_is = 1
      bcs_in = bcs_is + dimxs*dimys*gnk
      bcs_iw = bcs_in + dimxn*dimyn*gnk
      bcs_ie = bcs_iw + dimxw*dimyw*gnk
      bcs_sz = bcs_ie + dimxe*dimye*gnk - 1
*
      ofn = (bcs_in-bcs_is)/gnk
      ofw = (bcs_iw-bcs_in)/gnk
      ofe = (bcs_ie-bcs_iw)/gnk
      bcs_inq = bcs_in + ofn
      bcs_iwq = bcs_iw + ofn + ofw
      bcs_ieq = bcs_ie + ofn + ofw + ofe
*
*----------------------------------------------------------------------
*
      return
      end