!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer, 
!                     version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms 
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer 
!version 3 or (at your option) any later version that should be found at: 
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html 
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; 
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software; 
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec), 
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
***s/r domain_decomp
*
#include "model_macros_f.h"
*

      subroutine domain_decomp 1,5
      implicit none
*
*author
*     Michel Desgagne     Summer 2006
*
*revision
* v3_30 - Desgagne M.       - Initial version
* v3_31 - Chardon L.        - Remove offline topo restriction
*
*object
*
*implicits
#include "glb_ld.cdk"
#include "glb_pil.cdk"
#include "lun.cdk"
#include "ptopo.cdk"
#include "hblen.cdk"
#include "lam.cdk"
#include "schm.cdk"
*
      logical  check_parti
**
      integer ierr,mindimx,mindimy,maxblenx,maxbleny
*
*-------------------------------------------------------------------
*
      if (Lun_out.gt.0) then
         write(Lun_out,*) 'BLOC TOPO: Ptopo_nblocx=',
     $                Ptopo_nblocx, 'Ptopo_nblocy=',Ptopo_nblocy
         call write_status_file2 ('communications_established=YES' )
      endif
*
*     Establishing data topology
*
      l_west  = (0            .eq. Ptopo_mycol)
      l_east  = (Ptopo_npex-1 .eq. Ptopo_mycol)
      l_south = (0            .eq. Ptopo_myrow)
      l_north = (Ptopo_npey-1 .eq. Ptopo_myrow)
      north   = 0
      south   = 0
      east    = 0
      west    = 0
      if (l_north) north = 1
      if (l_south) south = 1
      if (l_east ) east  = 1
      if (l_west ) west  = 1
      pil_w     = 0
      pil_n     = 0
      pil_e     = 0
      pil_s     = 0
      Lam_pil_w = 0
      Lam_pil_n = 0
      Lam_pil_e = 0
      Lam_pil_s = 0
      G_periodx = .true.
      G_periody = .false.
*     
      if (G_lam) then
         if (l_west ) pil_w = Glb_pil_w
         if (l_north) pil_n = Glb_pil_n
         if (l_east ) pil_e = Glb_pil_e
         if (l_south) pil_s = Glb_pil_s
         G_periodx = .false.
         Lam_pil_w = Glb_pil_w
         Lam_pil_n = Glb_pil_n
         Lam_pil_e = Glb_pil_e
         Lam_pil_s = Glb_pil_s
         mindimx = G_ni/2 - (1-mod(G_ni,2))
         mindimy = G_nj/2 - (1-mod(G_nj,2))
         maxblenx= Hblen_x
         maxbleny= Hblen_y

         if ( (max(Glb_pil_w,Glb_pil_e)+maxblenx).gt.mindimx .or.
     $        (max(Glb_pil_s,Glb_pil_n)+maxbleny).gt.mindimy )
     $        call gem_stop
     $        ('LAM grid too small -- ABORT in set_world_view --',-1)
*
      endif
*
      call rpn_comm_topo ( G_ni,l_minx,l_maxx,l_ni,G_lnimax,
     $                            G_halox,l_i0,.true.,.true.) 
      call rpn_comm_topo ( G_nj,l_miny,l_maxy,l_nj,G_lnjmax,
     $                           G_haloy,l_j0,.false.,.true.)
*
      ierr=0
      if ( (.not.check_parti (l_i0,G_ni,Ptopo_npex)) .or.
     $     (.not.check_parti (l_j0,G_nj,Ptopo_npey)) ) ierr=-1
      call gem_stop('check_parti',ierr)
*
      l_nk = G_nk
      l_njv= l_nj
      l_niu= l_ni
      if (l_north) l_njv= l_nj - 1
      if ((l_east).and.(G_lam)) l_niu = l_ni - 1
      if (schm_offline_L) then
         l_niu = l_ni
         l_njv = l_nj
      endif
*
*     Check grid dimensions for LAM
      if (G_lam.and.Hblen_wfct_S .ne."CONST") then
         mindimx  = max ( pil_w,pil_e ) + maxblenx
         mindimy  = max ( pil_s,pil_n ) + maxbleny
         ierr=0
         if (l_niu.le.mindimx .or. l_njv.le.mindimy) ierr=-1
         call gem_stop
     $         ('LAM grid too small for chosen processor topology',ierr)
      endif
*
      call glbpos  
*
*-------------------------------------------------------------------
*
      return
      end