New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 9436 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90 – NEMO

Ignore:
Timestamp:
2018-03-27T15:30:51+02:00 (6 years ago)
Author:
acc
Message:

Branch 2017/dev_merge_2017. Reorganisation of nemogcm.F90 and mppini.F90 to better separate domain decomposition functions from the rest of the initialisation. Stage 1: Main reorganisation; see ticket #2070

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r9190 r9436  
    88   !!            8.0  !  1998-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions 
    99   !!  NEMO      1.0  !  2004-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1 
     10   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add mpp_init_nfdcom 
     11   !!            3.   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) mpp_init_nfdcom: setup avoiding MPI communication  
    1012   !!            4.0  !  2016-06  (G. Madec)  use domain configuration file instead of bathymetry file 
    1113   !!            4.0  !  2017-06  (J.M. Molines, T. Lovato) merge of mppini and mppini_2 
     
    1315 
    1416   !!---------------------------------------------------------------------- 
    15    !!  mpp_init       : Lay out the global domain over processors with/without land processor elimination 
    16    !!  mpp_init_mask  :  
    17    !!  mpp_init_ioipsl: IOIPSL initialization in mpp  
     17   !!  mpp_init          : Lay out the global domain over processors with/without land processor elimination 
     18   !!  mpp_init_mask     : Read global bathymetric information to facilitate land suppression 
     19   !!  mpp_init_ioipsl   : IOIPSL initialization in mpp  
     20   !!  mpp_init_partition: Calculate MPP domain decomposition 
     21   !!  factorise         : Calculate the factors of the no. of MPI processes 
     22   !!  mpp_init_nfdcom   : Setup for north fold exchanges with explicit point-to-point messaging 
    1823   !!---------------------------------------------------------------------- 
    1924   USE dom_oce        ! ocean space and time domain 
    2025   USE bdy_oce        ! open BounDarY   
    2126   ! 
     27   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges  
    2228   USE lib_mpp        ! distribued memory computing library 
    2329   USE iom            ! nemo I/O library  
     
    5258      !!---------------------------------------------------------------------- 
    5359      ! 
     60      jpimax = jpiglo 
     61      jpjmax = jpjglo 
     62      jpi    = jpiglo 
     63      jpj    = jpjglo 
     64      jpk    = jpjglo 
     65      jpim1  = jpi-1                                            ! inner domain indices 
     66      jpjm1  = jpj-1                                            !   "           " 
     67      jpkm1  = MAX( 1, jpk-1 )                                  !   "           " 
     68      jpij   = jpi*jpj 
     69      jpni   = 1 
     70      jpnj   = 1 
     71      jpnij  = jpni*jpnj 
    5472      nimpp  = 1           !  
    5573      njmpp  = 1 
     
    128146      INTEGER ::   iiea, ijea, iiwe, ijwe     !   -       - 
    129147      INTEGER ::   iresti, irestj, iproc      !   -       - 
     148      INTEGER ::   ierr                       ! local logical unit 
    130149      REAL(wp)::   zidom, zjdom               ! local scalars 
    131       INTEGER, DIMENSION(jpnij)     ::   iin, ii_nono, ii_noea   ! 1D workspace 
    132       INTEGER, DIMENSION(jpnij)     ::   ijn, ii_noso, ii_nowe   !  -     - 
     150      INTEGER, DIMENSION(jpnij)     ::   iin, ii_nono, ii_noea          ! 1D workspace 
     151      INTEGER, DIMENSION(jpnij)     ::   ijn, ii_noso, ii_nowe          !  -     - 
    133152      INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ilci, ibondi, ipproc   ! 2D workspace 
    134153      INTEGER, DIMENSION(jpni,jpnj) ::   ijmppt, ilcj, ibondj, ipolj    !  -     - 
    135154      INTEGER, DIMENSION(jpni,jpnj) ::   ilei, ildi, iono, ioea         !  -     - 
    136155      INTEGER, DIMENSION(jpni,jpnj) ::   ilej, ildj, ioso, iowe         !  -     - 
    137       INTEGER, DIMENSION(jpiglo,jpjglo) ::   imask   ! 2D golbal domain workspace 
    138       !!---------------------------------------------------------------------- 
     156      INTEGER, DIMENSION(jpiglo,jpjglo) ::   imask   ! 2D global domain workspace 
     157      !!---------------------------------------------------------------------- 
     158 
     159      ! If dimensions of processor grid weren't specified in the namelist file 
     160      ! then we calculate them here now that we have our communicator size 
     161      IF( jpni < 1 .OR. jpnj < 1 ) THEN 
     162         IF( Agrif_Root() )   CALL mpp_init_partition( mppsize ) 
     163      ENDIF 
     164      ! 
     165#if defined key_agrif 
     166      IF( jpnij /= jpni*jpnj ) CALL ctl_stop( 'STOP', 'Cannot remove land proc with AGRIF' ) 
     167#endif 
     168 
     169      ! 
     170      ALLOCATE(  nfiimpp(jpni,jpnj), nfipproc(jpni,jpnj), nfilcit(jpni,jpnj) ,    & 
     171         &       nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,    & 
     172         &       njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,    & 
     173         &                                       nleit(jpnij) , nlejt(jpnij) , STAT=ierr ) 
     174      CALL mpp_sum( ierr ) 
     175      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'mpp_init: unable to allocate standard ocean arrays' ) 
     176       
     177      ! 
     178#if defined key_agrif 
     179      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90) 
     180         jpiglo  = nbcellsx + 2 + 2*nbghostcells 
     181         jpjglo  = nbcellsy + 2 + 2*nbghostcells 
     182         jpimax  = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls 
     183         jpjmax  = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls 
     184         nperio  = 0 
     185         jperio  = 0 
     186         ln_use_jattr = .false. 
     187      ENDIF 
     188#endif 
     189 
     190      IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj 
     191#if defined key_nemocice_decomp 
     192         jpimax = ( nx_global+2-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim. 
     193         jpjmax = ( ny_global+2-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim.  
     194#else 
     195         jpimax = ( jpiglo - 2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim. 
     196         jpjmax = ( jpjglo - 2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim. 
     197#endif 
     198      ENDIF 
     199 
    139200      ! 
    140201      IF ( jpni * jpnj == jpnij ) THEN    ! regular domain lay out over processors 
     
    158219      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj ) 
    159220      ! 
    160       !  Need to use jpimax and jpjmax here since jpi and jpj have already been 
    161       !  shrunk to local sizes in nemogcm 
     221      !  Need to use jpimax and jpjmax here since jpi and jpj not yet defined 
    162222#if defined key_nemocice_decomp 
    163223      ! Change padding to be consistent with CICE 
     
    174234      ilcj(:, irestj+1:jpnj) = jpjmax-1 
    175235#endif 
    176       ! 
    177       nfilcit(:,:) = ilci(:,:) 
    178236      ! 
    179237      zidom = nreci + sum(ilci(:,1) - nreci ) 
     
    233291         IF( jpni            ==  1  )   ibondi(ii,ij) =  2 
    234292 
    235          ! Subdomain neighbors 
     293         ! Subdomain neighbors (get their zone number): default definition 
    236294         iproc = jarea - 1 
    237295         ioso(ii,ij) = iproc - jpni 
     
    241299         ildi(ii,ij) =  1  + nn_hls 
    242300         ilei(ii,ij) = ili - nn_hls 
    243  
    244          IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 )   ildi(ii,ij) =  1 
    245          IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 )   ilei(ii,ij) = ili 
    246301         ildj(ii,ij) =  1  + nn_hls 
    247302         ilej(ii,ij) = ilj - nn_hls 
    248          IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 )   ildj(ii,ij) =  1 
    249          IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 )   ilej(ii,ij) = ilj 
    250  
    251          ! warning ii*ij (zone) /= nproc (processors)! 
    252  
     303 
     304         ! East-West periodicity: change ibondi, ioea, iowe 
    253305         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN 
    254306            IF( jpni == 1 )THEN 
     
    265317            ENDIF 
    266318         ENDIF 
     319 
     320         ! North fold: define ipolj, change iono. Warning: we do not change ibondj... 
    267321         ipolj(ii,ij) = 0 
    268322         IF( jperio == 3 .OR. jperio == 4 ) THEN 
     
    304358         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj'  
    305359         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1 
    306          CALL ctl_stop( 'mpp_init: Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 ) 
     360         CALL ctl_stop( 'STOP', 'mpp_init: Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 ) 
    307361      ENDIF 
    308362 
     
    333387      ENDIF 
    334388 
    335       ! 5. neighbour treatment 
     389      ! 5. neighbour treatment: change ibondi, ibondj if next to a land zone 
    336390      ! ---------------------- 
    337391      DO jarea = 1, jpni*jpnj 
     
    371425      END DO 
    372426 
     427      ! Update il[de][ij] according to modified ibond[ij] 
     428      ! ---------------------- 
     429      DO jarea = 1, jpni*jpnj 
     430         ii = iin(narea) 
     431         ij = ijn(narea) 
     432         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) =  1 
     433         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ilci(ii,ij) 
     434         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) =  1 
     435         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilcj(ii,ij) 
     436      END DO 
     437          
    373438      ! just to save nono etc for all proc 
     439      ! warning ii*ij (zone) /= nproc (processors)! 
     440      ! ioso = zone number, ii_noso = proc number 
    374441      ii_noso(:) = -1 
    375442      ii_nono(:) = -1 
    376443      ii_noea(:) = -1 
    377444      ii_nowe(:) = -1  
    378       nproc = narea-1 
    379445      DO jarea = 1, jpnij 
    380446         ii = iin(jarea) 
     
    383449            iiso = 1 + MOD( ioso(ii,ij) , jpni ) 
    384450            ijso = 1 +      ioso(ii,ij) / jpni 
    385             noso = ipproc(iiso,ijso) 
    386             ii_noso(jarea)= noso 
     451            ii_noso(jarea) = ipproc(iiso,ijso) 
    387452         ENDIF 
    388453         IF( 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 
    389454          iiwe = 1 + MOD( iowe(ii,ij) , jpni ) 
    390455          ijwe = 1 +      iowe(ii,ij) / jpni 
    391           nowe = ipproc(iiwe,ijwe) 
    392           ii_nowe(jarea)= nowe 
     456          ii_nowe(jarea) = ipproc(iiwe,ijwe) 
    393457         ENDIF 
    394458         IF( 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 
    395459            iiea = 1 + MOD( ioea(ii,ij) , jpni ) 
    396460            ijea = 1 +      ioea(ii,ij) / jpni 
    397             noea = ipproc(iiea,ijea) 
    398             ii_noea(jarea)= noea 
     461            ii_noea(jarea)= ipproc(iiea,ijea) 
    399462         ENDIF 
    400463         IF( 0 <= iono(ii,ij) .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 
    401464            iino = 1 + MOD( iono(ii,ij) , jpni ) 
    402465            ijno = 1 +      iono(ii,ij) / jpni 
    403             nono = ipproc(iino,ijno) 
    404             ii_nono(jarea)= nono 
     466            ii_nono(jarea)= ipproc(iino,ijno) 
    405467         ENDIF 
    406468      END DO 
     
    408470      ! 6. Change processor name 
    409471      ! ------------------------ 
    410       nproc = narea-1 
    411472      ii = iin(narea) 
    412473      ij = ijn(narea) 
     
    417478      noea = ii_noea(narea) 
    418479      nono = ii_nono(narea) 
    419       nlcj = ilcj(ii,ij)   
    420480      nlci = ilci(ii,ij)   
    421481      nldi = ildi(ii,ij) 
    422482      nlei = ilei(ii,ij) 
     483      nlcj = ilcj(ii,ij)   
    423484      nldj = ildj(ii,ij) 
    424485      nlej = ilej(ii,ij) 
     
    426487      nbondj = ibondj(ii,ij) 
    427488      nimpp = iimppt(ii,ij)   
    428       njmpp = ijmppt(ii,ij)   
     489      njmpp = ijmppt(ii,ij) 
     490      jpi = nlci 
     491      jpj = nlcj 
     492      jpk = jpkglo                                             ! third dim 
     493#if defined key_agrif 
     494      ! simple trick to use same vertical grid as parent but different number of levels:  
     495      ! Save maximum number of levels in jpkglo, then define all vertical grids with this number. 
     496      ! Suppress once vertical online interpolation is ok 
     497      IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo ) 
     498#endif 
     499      jpim1 = jpi-1                                            ! inner domain indices 
     500      jpjm1 = jpj-1                                            !   "           " 
     501      jpkm1 = MAX( 1, jpk-1 )                                  !   "           " 
     502      jpij  = jpi*jpj                                          !  jpi x j 
    429503      DO jproc = 1, jpnij 
    430504         ii = iin(jproc) 
    431505         ij = ijn(jproc) 
    432          nimppt(jproc) = iimppt(ii,ij)   
    433          njmppt(jproc) = ijmppt(ii,ij)  
    434          nlcjt(jproc) = ilcj(ii,ij) 
    435506         nlcit(jproc) = ilci(ii,ij) 
    436507         nldit(jproc) = ildi(ii,ij) 
    437508         nleit(jproc) = ilei(ii,ij) 
     509         nlcjt(jproc) = ilcj(ii,ij) 
    438510         nldjt(jproc) = ildj(ii,ij) 
    439511         nlejt(jproc) = ilej(ii,ij) 
     512         ibonit(jproc) = ibondi(ii,ij) 
     513         ibonjt(jproc) = ibondj(ii,ij) 
     514         nimppt(jproc) = iimppt(ii,ij)   
     515         njmppt(jproc) = ijmppt(ii,ij)  
     516         nfilcit(ii,ij) = ilci(ii,ij) 
    440517      END DO 
    441518 
     
    444521         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 
    445522         WRITE(inum,'(a)') '   jpnij   jpimax  jpjmax    jpk  jpiglo  jpjglo'//& 
    446    &           ' ( local:    narea     jpi     jpj)' 
     523   &           ' ( local:    narea     jpi     jpj )' 
    447524         WRITE(inum,'(6i8,a,3i8,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,& 
    448525   &           ' ( local: ',narea,jpi,jpj,' )' 
    449          WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj ' 
     526         WRITE(inum,'(a)') 'nproc nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj ' 
    450527 
    451528         DO jproc = 1, jpnij 
    452529            ii = iin(jproc) 
    453530            ij = ijn(jproc) 
    454             WRITE(inum,'(15i5)') jproc-1, nlcit  (jproc), nlcjt  (jproc),   & 
    455                &                          nldit  (jproc), nldjt  (jproc),   & 
    456                &                          nleit  (jproc), nlejt  (jproc),   & 
    457                &                          nimppt (jproc), njmppt (jproc),   &  
    458                &                          ii_nono(jproc), ii_noso(jproc),   & 
    459                &                          ii_nowe(jproc), ii_noea(jproc),   & 
    460                &                          ibondi (ii,ij), ibondj (ii,ij)  
     531            WRITE(inum,'(13i5,2i7)')  jproc-1, nlcit  (jproc), nlcjt  (jproc),   & 
     532               &                                nldit  (jproc), nldjt  (jproc),   & 
     533               &                                nleit  (jproc), nlejt  (jproc),   & 
     534               &                                nimppt (jproc), njmppt (jproc),   &  
     535               &                                ii_nono(jproc), ii_noso(jproc),   & 
     536               &                                ii_nowe(jproc), ii_noea(jproc),   & 
     537               &                                ibondi (ii,ij), ibondj (ii,ij)  
    461538         END DO 
    462539         CLOSE(inum)    
     
    477554      ENDIF 
    478555      ! 
     556      nproc = narea-1 
    479557      IF(lwp) THEN 
    480558         WRITE(numout,*) 
     
    510588      CALL mpp_init_ioipsl       ! Prepare NetCDF output file (if necessary) 
    511589      ! 
     590      IF( ln_nnogather )   CALL mpp_init_nfdcom     ! northfold neighbour lists 
     591      ! 
    512592    END SUBROUTINE mpp_init 
    513593 
     
    619699   END SUBROUTINE mpp_init_ioipsl   
    620700 
     701 
     702   SUBROUTINE mpp_init_partition( num_pes ) 
     703      !!---------------------------------------------------------------------- 
     704      !!                 ***  ROUTINE mpp_init_partition  *** 
     705      !! 
     706      !! ** Purpose : 
     707      !! 
     708      !! ** Method  : 
     709      !!---------------------------------------------------------------------- 
     710      INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have 
     711      ! 
     712      INTEGER, PARAMETER :: nfactmax = 20 
     713      INTEGER :: nfact ! The no. of factors returned 
     714      INTEGER :: ierr  ! Error flag 
     715      INTEGER :: ji 
     716      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value 
     717      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 
     718      !!---------------------------------------------------------------------- 
     719      ! 
     720      ierr = 0 
     721      ! 
     722      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 
     723      ! 
     724      IF( nfact <= 1 ) THEN 
     725         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 
     726         WRITE (numout, *) '       : using grid of ',num_pes,' x 1' 
     727         jpnj = 1 
     728         jpni = num_pes 
     729      ELSE 
     730         ! Search through factors for the pair that are closest in value 
     731         mindiff = 1000000 
     732         imin    = 1 
     733         DO ji = 1, nfact-1, 2 
     734            idiff = ABS( ifact(ji) - ifact(ji+1) ) 
     735            IF( idiff < mindiff ) THEN 
     736               mindiff = idiff 
     737               imin = ji 
     738            ENDIF 
     739         END DO 
     740         jpnj = ifact(imin) 
     741         jpni = ifact(imin + 1) 
     742      ENDIF 
     743      ! 
     744      jpnij = jpni*jpnj 
     745      ! 
     746   END SUBROUTINE mpp_init_partition 
     747 
     748 
     749   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr ) 
     750      !!---------------------------------------------------------------------- 
     751      !!                     ***  ROUTINE factorise  *** 
     752      !! 
     753      !! ** Purpose :   return the prime factors of n. 
     754      !!                knfax factors are returned in array kfax which is of 
     755      !!                maximum dimension kmaxfax. 
     756      !! ** Method  : 
     757      !!---------------------------------------------------------------------- 
     758      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax 
     759      INTEGER                    , INTENT(  out) ::   kerr, knfax 
     760      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax 
     761      ! 
     762      INTEGER :: ifac, jl, inu 
     763      INTEGER, PARAMETER :: ntest = 14 
     764      INTEGER, DIMENSION(ntest) ::   ilfax 
     765      !!---------------------------------------------------------------------- 
     766      ! 
     767      ! lfax contains the set of allowed factors. 
     768      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
     769      ! 
     770      ! Clear the error flag and initialise output vars 
     771      kerr  = 0 
     772      kfax  = 1 
     773      knfax = 0 
     774      ! 
     775      IF( kn /= 1 ) THEN      ! Find the factors of n 
     776         ! 
     777         ! nu holds the unfactorised part of the number. 
     778         ! knfax holds the number of factors found. 
     779         ! l points to the allowed factor list. 
     780         ! ifac holds the current factor. 
     781         ! 
     782         inu   = kn 
     783         knfax = 0 
     784         ! 
     785         DO jl = ntest, 1, -1 
     786            ! 
     787            ifac = ilfax(jl) 
     788            IF( ifac > inu )   CYCLE 
     789            ! 
     790            ! Test whether the factor will divide. 
     791            ! 
     792            IF( MOD(inu,ifac) == 0 ) THEN 
     793               ! 
     794               knfax = knfax + 1            ! Add the factor to the list 
     795               IF( knfax > kmaxfax ) THEN 
     796                  kerr = 6 
     797                  write (*,*) 'FACTOR: insufficient space in factor array ', knfax 
     798                  return 
     799               ENDIF 
     800               kfax(knfax) = ifac 
     801               ! Store the other factor that goes with this one 
     802               knfax = knfax + 1 
     803               kfax(knfax) = inu / ifac 
     804               !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 
     805            ENDIF 
     806            ! 
     807         END DO 
     808         ! 
     809      ENDIF 
     810      ! 
     811   END SUBROUTINE factorise 
     812 
     813 
     814   SUBROUTINE mpp_init_nfdcom 
     815      !!---------------------------------------------------------------------- 
     816      !!                     ***  ROUTINE  mpp_init_nfdcom  *** 
     817      !! ** Purpose :   Setup for north fold exchanges with explicit  
     818      !!                point-to-point messaging 
     819      !! 
     820      !! ** Method :   Initialization of the northern neighbours lists. 
     821      !!---------------------------------------------------------------------- 
     822      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
     823      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
     824      !!---------------------------------------------------------------------- 
     825      INTEGER  ::   sxM, dxM, sxT, dxT, jn 
     826      INTEGER  ::   njmppmax 
     827      !!---------------------------------------------------------------------- 
     828      ! 
     829      njmppmax = MAXVAL( njmppt ) 
     830      ! 
     831      !initializes the north-fold communication variables 
     832      isendto(:) = 0 
     833      nsndto     = 0 
     834      ! 
     835      IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north 
     836         ! 
     837         !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 
     838         sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 
     839         !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 
     840         dxM = jpiglo - nimppt(narea) + 2 
     841         ! 
     842         ! loop over the other north-fold processes to find the processes 
     843         ! managing the points belonging to the sxT-dxT range 
     844         ! 
     845         DO jn = 1, jpni 
     846            ! 
     847            sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process 
     848            dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process 
     849            ! 
     850            IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN 
     851               nsndto          = nsndto + 1 
     852               isendto(nsndto) = jn 
     853            ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN 
     854               nsndto          = nsndto + 1 
     855               isendto(nsndto) = jn 
     856            ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN 
     857               nsndto          = nsndto + 1 
     858               isendto(nsndto) = jn 
     859            ENDIF 
     860            ! 
     861         END DO 
     862         nfsloop = 1 
     863         nfeloop = nlci 
     864         DO jn = 2,jpni-1 
     865            IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN 
     866               IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi 
     867               IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei 
     868            ENDIF 
     869         END DO 
     870         ! 
     871      ENDIF 
     872      l_north_nogather = .TRUE. 
     873      ! 
     874   END SUBROUTINE mpp_init_nfdcom 
     875 
     876    
    621877#endif 
    622878 
Note: See TracChangeset for help on using the changeset viewer.