Skip to content
Snippets Groups Projects
mppini.F90 73.2 KiB
Newer Older
Guillaume Samson's avatar
Guillaume Samson committed
            IF( iarea == inbj ) THEN                                   ! the last line was not read
               IF( l_Jperio ) THEN                                     !   north-south periodocity
                  CALL read_mask( 1, 1, Ni0glo, 1, lloce(2:inx-1,iny) )   !      read the first line -> last line of lloce
               ELSEIF( c_NFtype == 'T' ) THEN                          !   north-pole folding T-pivot, T-point
                  lloce(2,iny) = lloce(2,iny-2)                        !      here we have 1 halo (even if nn_hls>1)
                  DO ji = 3,inx-1
                     lloce(ji,iny  ) = lloce(inx-ji+2,iny-2)           !      ok, we have at least 3 lines
                  END DO
                  DO ji = inx/2+2,inx-1
                     lloce(ji,iny-1) = lloce(inx-ji+2,iny-1)
                  END DO
               ELSEIF( c_NFtype == 'F' ) THEN                          !   north-pole folding F-pivot, T-point, 1 halo
                  lloce(inx/2+1,iny-1) = lloce(inx/2,iny-1)            !      here we have 1 halo (even if nn_hls>1)
                  lloce(inx  -1,iny-1) = lloce(2    ,iny-1)
                  DO ji = 2,inx-1
                     lloce(ji,iny) = lloce(inx-ji+1,iny-1)
                  END DO
               ELSE                                                    !   closed boundary
                  lloce(2:inx-1,iny) = .FALSE.
               ENDIF
            ENDIF
            !                                                          ! first and last column were not read
            IF( l_Iperio ) THEN
               lloce(1,:) = lloce(inx-1,:)   ;   lloce(inx,:) = lloce(2,:)   ! east-west periodocity
            ELSE
               lloce(1,:) = .FALSE.          ;   lloce(inx,:) = .FALSE.      ! closed boundary
            ENDIF
            !
            DO  ji = 1, inbi
               inboce(ji,iarea) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ijpi(ji,1)+1,:) )   ! lloce as 2 points more than Ni0glo
            END DO
            !
            DEALLOCATE(lloce)
            DEALLOCATE(iimppt, ijmppt, ijpi, ijpj)
            !
         ENDIF
      END DO

      inboce_1d = RESHAPE(inboce, (/ inbi*inbj /))
      CALL mpp_sum( 'mppini', inboce_1d )
      inboce = RESHAPE(inboce_1d, (/inbi, inbj/))
      ldIsOce(:,:) = inboce(:,:) /= 0
      DEALLOCATE(inboce, inboce_1d)
      !
#if defined key_xios
      ! Only when using XIOS: XIOS does a domain decomposition only in bands (for IO performances).
      !                       XIOS is crashing if one of these bands contains only land-domains which have been suppressed.
      ! -> solution (before a fix of xios): force to keep at least one land-domain by band of mpi domains
      DO jj = 1, inbj
         IF( COUNT( ldIsOce(:,jj) ) == 0 )   ldIsOce(1,jj) = .TRUE.   ! for to keep 1st MPI domain in the row of domains
      END DO
#endif      
      !
Guillaume Samson's avatar
Guillaume Samson committed
   END SUBROUTINE mpp_is_ocean


   SUBROUTINE read_mask( kistr, kjstr, kicnt, kjcnt, ldoce )
      !!----------------------------------------------------------------------
      !!                  ***  ROUTINE read_mask  ***
      !!
      !! ** Purpose : Read relevant bathymetric information in order to
      !!              provide a land/sea mask used for the elimination
      !!              of land domains, in an mpp computation.
      !!
      !! ** Method  : read stipe of size (Ni0glo,...)
      !!----------------------------------------------------------------------
      INTEGER                        , INTENT(in   ) ::   kistr, kjstr   ! starting i and j position of the reading
      INTEGER                        , INTENT(in   ) ::   kicnt, kjcnt   ! number of points to read in i and j directions
      LOGICAL, DIMENSION(kicnt,kjcnt), INTENT(  out) ::   ldoce          ! ldoce(i,j) = .true. if the point (i,j) is ocean
      !
      INTEGER                          ::   inumsave                     ! local logical unit
      REAL(wp), DIMENSION(kicnt,kjcnt) ::   zbot, zbdy
      !!----------------------------------------------------------------------
      !
      inumsave = numout   ;   numout = numnul   !   redirect all print to /dev/null
      !
      IF( numbot /= -1 ) THEN
         CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/kistr,kjstr/), kcount = (/kicnt, kjcnt/) )
      ELSE
         zbot(:,:) = 1._wp                      ! put a non-null value
      ENDIF
      !
      IF( numbdy /= -1 ) THEN                   ! Adjust with bdy_msk if it exists
         CALL iom_get ( numbdy, jpdom_unknown,     'bdy_msk', zbdy, kstart = (/kistr,kjstr/), kcount = (/kicnt, kjcnt/) )
         zbot(:,:) = zbot(:,:) * zbdy(:,:)
      ENDIF
      !
      ldoce(:,:) = NINT(zbot(:,:)) > 0
      numout = inumsave
      !
   END SUBROUTINE read_mask


   SUBROUTINE mpp_getnum( ldIsOce, kproc, kipos, kjpos )
      !!----------------------------------------------------------------------
      !!                  ***  ROUTINE mpp_getnum  ***
      !!
      !! ** Purpose : give a number to each MPI subdomains (starting at 0)
      !!
      !! ** Method  : start from bottom left. First skip land subdomain, and finally use them if needed
      !!----------------------------------------------------------------------
      LOGICAL, DIMENSION(:,:), INTENT(in   ) ::   ldIsOce     ! F if land process
      INTEGER, DIMENSION(:,:), INTENT(  out) ::   kproc       ! subdomain number (-1 if not existing, starting at 0)
      INTEGER, DIMENSION(  :), INTENT(  out) ::   kipos       ! i-position of the subdomain (from 1 to jpni)
      INTEGER, DIMENSION(  :), INTENT(  out) ::   kjpos       ! j-position of the subdomain (from 1 to jpnj)
      !
      INTEGER :: ii, ij, jarea, iarea0
      INTEGER :: icont, i2add , ini, inj, inij
      !!----------------------------------------------------------------------
      !
      ini = SIZE(ldIsOce, dim = 1)
      inj = SIZE(ldIsOce, dim = 2)
      inij = SIZE(kipos)
      !
      ! specify which subdomains are oce subdomains; other are land subdomains
      kproc(:,:) = -1
      icont = -1
      DO jarea = 1, ini*inj
         iarea0 = jarea - 1
         ii = 1 + MOD(iarea0,ini)
         ij = 1 +     iarea0/ini
         IF( ldIsOce(ii,ij) ) THEN
            icont = icont + 1
            kproc(ii,ij) = icont
            kipos(icont+1) = ii
            kjpos(icont+1) = ij
         ENDIF
      END DO
      ! if needed add some land subdomains to reach inij active subdomains
      i2add = inij - COUNT( ldIsOce )
      DO jarea = 1, ini*inj
         iarea0 = jarea - 1
         ii = 1 + MOD(iarea0,ini)
         ij = 1 +     iarea0/ini
         IF( .NOT. ldIsOce(ii,ij) .AND. i2add > 0 ) THEN
            icont = icont + 1
            kproc(ii,ij) = icont
            kipos(icont+1) = ii
            kjpos(icont+1) = ij
            i2add = i2add - 1
         ENDIF
      END DO
      !
   END SUBROUTINE mpp_getnum


   SUBROUTINE init_excl_landpt
      !!----------------------------------------------------------------------
      !!                  ***  ROUTINE   ***
      !!
      !! ** Purpose : exclude exchanges which contain only land points
      !!
      !! ** Method  : if a send or receive buffer constains only land point we
      !!              flag off the corresponding communication
      !!              Warning: this selection depend on the halo size -> loop on halo size
      !!
      !!----------------------------------------------------------------------
      INTEGER ::   inumsave
Guillaume Samson's avatar
Guillaume Samson committed
      INTEGER ::   ipi, ipj
      INTEGER ::   iiwe, iiea, iist, iisz 
      INTEGER ::   ijso, ijno, ijst, ijsz 
      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zmsk0, zmsk
Guillaume Samson's avatar
Guillaume Samson committed
      LOGICAL , DIMENSION(Ni_0,Nj_0,1)      ::   lloce
      !!----------------------------------------------------------------------
      !
      ! read the land-sea mask on the inner domain
      CALL read_mask( nimpp, njmpp, Ni_0, Nj_0, lloce(:,:,1) )
      !
      ! Here we look only at communications excluding the NP folding.
      !   --> we switch off lbcnfd at this stage (init_nfdcom called after init_excl_landpt)...
      l_IdoNFold = .FALSE.
      !
      ! WARNING, see also bestpartition: minimum subdomain size defined in bestpartition according to nn_hls.
      ! If, one day, we want to use local halos largers than nn_hls, we must replace nn_hls by n_hlsmax in bestpartition
      !
      DO jh = 1, MIN(nn_hls, n_hlsmax)   ! different halo size
         !
         ipi = Ni_0 + 2*jh   ! local domain size
         ipj = Nj_0 + 2*jh
         !
         ALLOCATE( zmsk0(ipi,ipj), zmsk(ipi,ipj) )
         zmsk0(jh+1:jh+Ni_0,jh+1:jh+Nj_0) = REAL(COUNT(lloce, dim = 3), wp)   ! define inner domain -> need REAL to use lbclnk
         CALL lbc_lnk('mppini', zmsk0, 'T', 1._wp, khls = jh)                 ! fill halos
         ! Beware about the mask we must use here :
         DO jj = jh+1, jh+Nj_0
            DO ji = jh+1, jh+Ni_0
               zmsk(ji,jj) = zmsk0(ji,jj)   &
                  !  1) dynvor may use scale factors on i+1 (e2v for di_e2v_2e1e2f) and j+1 (e1u for dj_e1u_2e1e2f) even if land
                  ! -> the mask must be > 1 if south/west neighbours is oce as we may need to send these arrays to these neighbours
                  &        + zmsk0(ji-1,jj) + zmsk0(ji,jj-1)   &
                  !  2) coastal F points can be used, so we may need communications for these points F points even IF tmask = 0
                  ! -> the mask must be > 1 as soon as one of the 3 neighbours is oce: (i,j+1) (i+1,j) (i+1,j+1)
                  &        + zmsk0(ji+1,jj) + zmsk0(ji,jj+1) + zmsk0(ji+1,jj+1)
            END DO
         END DO
Guillaume Samson's avatar
Guillaume Samson committed
         CALL lbc_lnk('mppini', zmsk, 'T', 1._wp, khls = jh)                 ! fill halos again!
         !        
         iiwe = jh   ;   iiea = Ni_0   ! bottom-left corner - 1 of the sent data
         ijso = jh   ;   ijno = Nj_0
         IF( nn_comm == 1 ) THEN 
            iist =  0   ;   iisz = ipi
            ijst = jh   ;   ijsz = Nj_0
         ELSE
            iist = jh   ;   iisz = Ni_0
            ijst = jh   ;   ijsz = Nj_0
         ENDIF
IF( nn_comm == 1 ) THEN       ! SM: NOT WORKING FOR NEIGHBOURHOOD COLLECTIVE COMMUNICATIONS, I DON'T KNOW WHY... 
         ! do not send if we send only land points
         IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh  ,ijst+1:ijst+ijsz) )) == 0 )   mpiSnei(jh,jpwe) = -1
         IF( NINT(SUM( zmsk(iiea+1:iiea+jh  ,ijst+1:ijst+ijsz) )) == 0 )   mpiSnei(jh,jpea) = -1
         IF( NINT(SUM( zmsk(iist+1:iist+iisz,ijso+1:ijso+jh  ) )) == 0 )   mpiSnei(jh,jpso) = -1
         IF( NINT(SUM( zmsk(iist+1:iist+iisz,ijno+1:ijno+jh  ) )) == 0 )   mpiSnei(jh,jpno) = -1
         IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh  ,ijso+1:ijso+jh  ) )) == 0 )   mpiSnei(jh,jpsw) = -1
         IF( NINT(SUM( zmsk(iiea+1:iiea+jh  ,ijso+1:ijso+jh  ) )) == 0 )   mpiSnei(jh,jpse) = -1
         IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh  ,ijno+1:ijno+jh  ) )) == 0 )   mpiSnei(jh,jpnw) = -1
         IF( NINT(SUM( zmsk(iiea+1:iiea+jh  ,ijno+1:ijno+jh  ) )) == 0 )   mpiSnei(jh,jpne) = -1
         !
         iiwe = iiwe-jh   ;   iiea = iiea+jh   ! bottom-left corner - 1 of the received data
         ijso = ijso-jh   ;   ijno = ijno+jh
Guillaume Samson's avatar
Guillaume Samson committed
         IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh  ,ijst+1:ijst+ijsz) )) == 0 )   mpiRnei(jh,jpwe) = -1
         IF( NINT(SUM( zmsk(iiea+1:iiea+jh  ,ijst+1:ijst+ijsz) )) == 0 )   mpiRnei(jh,jpea) = -1
         IF( NINT(SUM( zmsk(iist+1:iist+iisz,ijso+1:ijso+jh  ) )) == 0 )   mpiRnei(jh,jpso) = -1
         IF( NINT(SUM( zmsk(iist+1:iist+iisz,ijno+1:ijno+jh  ) )) == 0 )   mpiRnei(jh,jpno) = -1
         IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh  ,ijso+1:ijso+jh  ) )) == 0 )   mpiRnei(jh,jpsw) = -1
         IF( NINT(SUM( zmsk(iiea+1:iiea+jh  ,ijso+1:ijso+jh  ) )) == 0 )   mpiRnei(jh,jpse) = -1
         IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh  ,ijno+1:ijno+jh  ) )) == 0 )   mpiRnei(jh,jpnw) = -1
         IF( NINT(SUM( zmsk(iiea+1:iiea+jh  ,ijno+1:ijno+jh  ) )) == 0 )   mpiRnei(jh,jpne) = -1
ENDIF
         !
         ! Specific (and rare) problem in corner treatment because we do 1st West-East comm, next South-North comm
         IF( nn_comm == 1 ) THEN
            IF( mpiSnei(jh,jpwe) > -1 )   mpiSnei(jh, (/jpsw,jpnw/) ) = -1   ! SW and NW corners already sent through West nei
            IF( mpiSnei(jh,jpea) > -1 )   mpiSnei(jh, (/jpse,jpne/) ) = -1   ! SE and NE corners already sent through East nei
            IF( mpiRnei(jh,jpso) > -1 )   mpiRnei(jh, (/jpsw,jpse/) ) = -1   ! SW and SE corners will be received through South nei
            IF( mpiRnei(jh,jpno) > -1 )   mpiRnei(jh, (/jpnw,jpne/) ) = -1   ! NW and NE corners will be received through North nei
        ENDIF
         !
Guillaume Samson's avatar
Guillaume Samson committed
         !
         CALL mpp_ini_nc(jh)    ! Initialize/Update communicator for neighbourhood collective communications
         !
      END DO

   END SUBROUTINE init_excl_landpt


   SUBROUTINE init_ioipsl
      !!----------------------------------------------------------------------
      !!                  ***  ROUTINE init_ioipsl  ***
      !!
      !! ** Purpose :
      !!
      !! ** Method  :
      !!
      !! History :
      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL
      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
      !!----------------------------------------------------------------------
      INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid
      !!----------------------------------------------------------------------

      ! The domain is split only horizontally along i- or/and j- direction
      ! So we need at the most only 1D arrays with 2 elements.
      ! Set idompar values equivalent to the jpdom_local_noextra definition
      ! used in IOM. This works even if jpnij .ne. jpni*jpnj.
      iglo( :) = (/ Ni0glo, Nj0glo /)
      iloc( :) = (/ Ni_0  , Nj_0   /)
      iabsf(:) = (/ Nis0  , Njs0   /) + (/ nimpp, njmpp /) - 1 - nn_hls   ! corresponds to mig0(Nis0) but mig0 is not yet defined!
      iabsl(:) = iabsf(:) + iloc(:) - 1
      ihals(:) = (/ 0     , 0      /)
      ihale(:) = (/ 0     , 0      /)
      idid( :) = (/ 1     , 2      /)

      IF(lwp) THEN
          WRITE(numout,*)
          WRITE(numout,*) 'mpp init_ioipsl :   iloc  = ', iloc
          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf
          WRITE(numout,*) '                    ihals = ', ihals
          WRITE(numout,*) '                    ihale = ', ihale
      ENDIF
      !
      CALL flio_dom_set ( jpnij, narea-1, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
      !
   END SUBROUTINE init_ioipsl


   SUBROUTINE init_nfdcom( ldwrtlay, knum )
      !!----------------------------------------------------------------------
      !!                     ***  ROUTINE  init_nfdcom  ***
      !! ** Purpose :   Setup for north fold exchanges with explicit
      !!                point-to-point messaging
      !!
      !! ** Method :   Initialization of the northern neighbours lists.
      !!----------------------------------------------------------------------
      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)
      !!    3.0  ! 2021-09 complete rewrite using informations from gather north fold
      !!----------------------------------------------------------------------
      LOGICAL, INTENT(in   ) ::   ldwrtlay   ! true if additional prints in layout.dat
      INTEGER, INTENT(in   ) ::   knum       ! layout.dat unit
      !
      REAL(wp), DIMENSION(jpi,jpj,2,4) ::   zinfo
      INTEGER , DIMENSION(10) ::   irknei ! too many elements but safe...
      INTEGER                 ::   ji, jj, jg, jn   ! dummy loop indices
Guillaume Samson's avatar
Guillaume Samson committed
      LOGICAL                 ::   lnew
      !!----------------------------------------------------------------------
      !
      IF (lwp) THEN
         WRITE(numout,*)
         WRITE(numout,*) '   ==>>>   North fold boundary prepared for jpni >1'
      ENDIF
      !
      CALL mpp_ini_northgather   ! we need to init the nfd with gathering in all cases as it is used to define the no-gather case
      !
      IF(ldwrtlay) THEN      ! additional prints in layout.dat
         WRITE(knum,*)
         WRITE(knum,*)
         WRITE(knum,*) 'Number of subdomains located along the north fold : ', ndim_rank_north
         WRITE(knum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north
         DO jn = 1, ndim_rank_north, 5
            WRITE(knum,*) nrank_north( jn:MINVAL( (/jn+4,ndim_rank_north/) ) )
         END DO
      ENDIF
      
      nfd_nbnei = 0   ! defaul def (useless?)
      IF( ln_nnogather ) THEN
         !
         ! Use the "gather nfd" to know how to do the nfd: for ji point, which process send data from which of its ji-index?
         ! Note that nfd is perfectly symetric: I receive data from X <=> I send data to X  (-> no deadlock)
         !
         zinfo(:,:,:,:) = HUGE(0._wp)   ! default def to make sure we don't use the halos
         DO jg = 1, 4   ! grid type: T, U, V, F
            DO jj = nn_hls+1, jpj-nn_hls                ! inner domain (warning do_loop_substitute not yet defined)
               DO ji = nn_hls+1, jpi-nn_hls             ! inner domain (warning do_loop_substitute not yet defined)
                  zinfo(ji,jj,1,jg) = REAL(narea, wp)   ! mpi_rank + 1 (as default lbc_lnk fill is 0
                  zinfo(ji,jj,2,jg) = REAL(ji, wp)      ! ji of this proc
               END DO
            END DO
         END DO
         !
         ln_nnogather = .FALSE.   ! force "classical" North pole folding to fill all halos -> should be no more HUGE values...
         CALL lbc_lnk( 'mppini', zinfo(:,:,:,1), 'T', 1._wp )   ! Do 4 calls instead of 1 to save memory as the nogather version
         CALL lbc_lnk( 'mppini', zinfo(:,:,:,2), 'U', 1._wp )   ! creates buffer arrays with jpiglo as the first dimension
         CALL lbc_lnk( 'mppini', zinfo(:,:,:,3), 'V', 1._wp )   ! 
         CALL lbc_lnk( 'mppini', zinfo(:,:,:,4), 'F', 1._wp )   ! 
         ln_nnogather = .TRUE.
         
         IF( l_IdoNFold ) THEN   ! only the procs involed in the NFD must take care of this
            
            ALLOCATE( nfd_rksnd(jpi,4), nfd_jisnd(jpi,4) )          ! neighbour rand and remote ji-index for each grid (T, U, V, F)
            nfd_rksnd(:,:) = NINT( zinfo(:, jpj, 1, :) ) - 1        ! neighbour MPI rank
            nfd_jisnd(:,:) = NINT( zinfo(:, jpj, 2, :) ) - nn_hls   ! neighbour ji index (shifted as we don't send the halos)
            WHERE( nfd_rksnd == -1 )   nfd_jisnd = 1                ! use ji=1 if no neighbour, see mpp_nfd_generic.h90
            
            nfd_nbnei = 1                ! Number of neighbour sending data for the nfd. We have at least 1 neighbour!
            irknei(1) = nfd_rksnd(1,1)   ! which is the 1st one (I can be neighbour of myself, exclude land-proc are also ok)
            DO jg = 1, 4
               DO ji = 1, jpi     ! we must be able to fill the full line including halos
                  lnew = .TRUE.   ! new neighbour?
                  DO jn = 1, nfd_nbnei
                     IF( irknei(jn) == nfd_rksnd(ji,jg) )   lnew = .FALSE.   ! already found
                  END DO
                  IF( lnew ) THEN
                     jn = nfd_nbnei + 1
                     nfd_nbnei = jn
                     irknei(jn) = nfd_rksnd(ji,jg)
                  ENDIF
               END DO
            END DO
            
            ALLOCATE( nfd_rknei(nfd_nbnei) )
            nfd_rknei(:) = irknei(1:nfd_nbnei)
            ! re-number nfd_rksnd according to the indexes of nfd_rknei
            DO jg = 1, 4
               DO ji = 1, jpi
                  iitmp = nfd_rksnd(ji,jg)   ! must store a copy of nfd_rksnd(ji,jg) to make sure we don't change it twice
                  DO jn = 1, nfd_nbnei
                     IF( iitmp == nfd_rknei(jn) )   nfd_rksnd(ji,jg) = jn
                  END DO
               END DO
Guillaume Samson's avatar
Guillaume Samson committed
            END DO
            
            IF( ldwrtlay ) THEN
               WRITE(knum,*)
               WRITE(knum,*) 'north fold exchanges with explicit point-to-point messaging :'
               WRITE(knum,*) '   number of neighbours for the NF: nfd_nbnei : ', nfd_nbnei
               IF( nfd_nbnei > 0 )   WRITE(knum,*) '   neighbours MPI ranks                       : ', nfd_rknei
            ENDIF
            
         ENDIF   ! l_IdoNFold
         !
      ENDIF   ! ln_nnogather
      !
   END SUBROUTINE init_nfdcom


   SUBROUTINE init_doloop
      !!----------------------------------------------------------------------
      !!                  ***  ROUTINE init_doloop  ***
      !!
      !! ** Purpose :   set the starting/ending indices of DO-loop
      !!              These indices are used in do_loop_substitute.h90
      !!----------------------------------------------------------------------
      !
      Nis0 =   1+nn_hls
      Njs0 =   1+nn_hls
      Nie0 = jpi-nn_hls
      Nje0 = jpj-nn_hls
      !
      Ni_0 = Nie0 - Nis0 + 1
      Nj_0 = Nje0 - Njs0 + 1
      !
      jpkm1 = jpk-1                             !   "           "
      !
   END SUBROUTINE init_doloop

   
   SUBROUTINE init_locglo
      !!----------------------------------------------------------------------
      !!                     ***  ROUTINE init_locglo  ***
      !!
      !! ** Purpose :   initialization of global domain <--> local domain indices
      !!
      !! ** Method  :
      !!
      !! ** Action  : - mig , mjg : local  domain indices ==> global domain, including halos, indices
      !!              - mig0, mjg0: local  domain indices ==> global domain, excluding halos, indices
      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
      !!              - mj0 , mj1   (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
      !!----------------------------------------------------------------------
      INTEGER ::   ji, jj   ! dummy loop argument
      !!----------------------------------------------------------------------
      !
      ALLOCATE( mig(jpi), mjg(jpj), mig0(jpi), mjg0(jpj) )
      ALLOCATE( mi0(jpiglo), mi1(jpiglo), mj0(jpjglo), mj1(jpjglo) )
      !
      DO ji = 1, jpi                 ! local domain indices ==> global domain indices, including halos
        mig(ji) = ji + nimpp - 1
      END DO
      DO jj = 1, jpj
        mjg(jj) = jj + njmpp - 1
      END DO
      !                              ! local domain indices ==> global domain indices, excluding halos
      !
      mig0(:) = mig(:) - nn_hls
      mjg0(:) = mjg(:) - nn_hls
      !                              ! global domain, including halos, indices ==> local domain indices
      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
      DO ji = 1, jpiglo
        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
      END DO
      DO jj = 1, jpjglo
        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
      END DO
      !
   END SUBROUTINE init_locglo
   
   !!======================================================================
END MODULE mppini