Changeset 9436


Ignore:
Timestamp:
2018-03-27T15:30:51+02:00 (3 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

Location:
branches/2017/dev_merge_2017/NEMOGCM/NEMO
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r9367 r9436  
    1616   !!   nemo_closefile: close remaining open files 
    1717   !!   nemo_alloc    : dynamical allocation 
    18    !!   nemo_partition: calculate MPP domain decomposition 
    19    !!   factorise     : calculate the factors of the no. of MPI processes 
    20    !!   nemo_nfdcom   : Setup for north fold exchanges with explicit point-to-point messaging 
    2118   !!   istate_init   : simple initialization to zero of ocean fields 
    2219   !!   stp_ctl       : reduced step control (no dynamics in off-line) 
     
    157154      INTEGER  ::   ji                 ! dummy loop indices 
    158155      INTEGER  ::   ios, ilocal_comm   ! local integers 
    159       INTEGER  ::   iiarea, ijarea     !   -       - 
    160       INTEGER  ::   iirest, ijrest     !   -       - 
    161156      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam 
    162157      !! 
     
    232227      ENDIF 
    233228 
    234       ! If dimensions of processor grid weren't specified in the namelist file  
    235       ! then we calculate them here now that we have our communicator size 
    236       IF( jpni < 1  .OR.  jpnj < 1 ) THEN 
    237 #if   defined key_mpp_mpi 
    238          CALL nemo_partition( mppsize ) 
    239 #else 
    240          jpni  = 1 
    241          jpnj  = 1 
    242          jpnij = jpni*jpnj 
    243 #endif 
    244       ENDIF 
    245  
    246       iiarea = 1 + MOD( narea - 1 , jpni ) 
    247       ijarea = 1 + ( narea - 1 ) / jpni 
    248       iirest = 1 + MOD( jpiglo - 2*nn_hls - 1 , jpni ) 
    249       ijrest = 1 + MOD( jpjglo - 2*nn_hls - 1 , jpnj ) 
    250 #if defined key_nemocice_decomp 
    251       jpi = ( nx_global+2-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim. 
    252       jpj = ( ny_global+2-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim.  
    253       jpimax  = jpi 
    254       jpjmax  = jpj 
    255       IF( iiarea == jpni ) jpi = jpiglo - (jpni - 1) * (jpi - 2*nn_hls) 
    256       IF( ijarea == jpnj ) jpj = jpjglo - (jpnj - 1) * (jpj - 2*nn_hls) 
    257 #else 
    258       jpi = ( jpiglo     -2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim. 
    259       jpj = ( jpjglo     -2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim. 
    260       jpimax  = jpi 
    261       jpjmax  = jpj 
    262       IF( iiarea > iirest ) jpi = jpi - 1 
    263       IF( ijarea > ijrest ) jpj = jpj - 1 
    264 #endif 
    265  
    266       jpk   = jpkglo                                           ! third dim 
    267  
    268       jpim1 = jpi-1                                            ! inner domain indices 
    269       jpjm1 = jpj-1                                            !   "           " 
    270       jpkm1 = MAX( 1, jpk-1 )                                  !   "           " 
    271       jpij  = jpi*jpj                                          !  jpi x j 
    272  
    273  
    274229      IF(lwp) THEN                            ! open listing units 
    275230         ! 
     
    295250         ! 
    296251      ENDIF 
     252      !                                      ! Domain decomposition 
     253      CALL mpp_init                          ! MPP 
    297254 
    298255      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
     
    304261 
    305262      CALL nemo_ctl                          ! Control prints 
    306  
    307       !                                      ! Domain decomposition 
    308       CALL mpp_init                             ! MPP 
    309       IF( ln_nnogather )   CALL nemo_nfdcom     ! northfold neighbour lists 
    310263      ! 
    311264      !                                      ! General initialization 
     
    385338         WRITE(numout,*) '      read domain configuration file              ln_read_cfg      = ', ln_read_cfg 
    386339         WRITE(numout,*) '         filename to be read                         cn_domcfg     = ', TRIM(cn_domcfg) 
    387          WRITE(numout,*) '         keep closed seas in the domain (if exist)   ln_closea     = ', TRIM(cn_domcfg) 
     340         WRITE(numout,*) '         keep closed seas in the domain (if exist)   ln_closea     = ', ln_closea 
    388341         WRITE(numout,*) '      create a configuration definition file      ln_write_cfg     = ', ln_write_cfg 
    389342         WRITE(numout,*) '         filename to be written                      cn_domcfg_out = ', TRIM(cn_domcfg_out) 
     
    486439   END SUBROUTINE nemo_alloc 
    487440 
    488  
    489    SUBROUTINE nemo_partition( num_pes ) 
    490       !!---------------------------------------------------------------------- 
    491       !!                 ***  ROUTINE nemo_partition  *** 
    492       !! 
    493       !! ** Purpose :    
    494       !! 
    495       !! ** Method  : 
    496       !!---------------------------------------------------------------------- 
    497       INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have 
    498       ! 
    499       INTEGER, PARAMETER :: nfactmax = 20 
    500       INTEGER :: nfact ! The no. of factors returned 
    501       INTEGER :: ierr  ! Error flag 
    502       INTEGER :: ji 
    503       INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value 
    504       INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 
    505       !!---------------------------------------------------------------------- 
    506       ! 
    507       ierr = 0 
    508       ! 
    509       CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 
    510       ! 
    511       IF( nfact <= 1 ) THEN 
    512          WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 
    513          WRITE (numout, *) '       : using grid of ',num_pes,' x 1' 
    514          jpnj = 1 
    515          jpni = num_pes 
    516       ELSE 
    517          ! Search through factors for the pair that are closest in value 
    518          mindiff = 1000000 
    519          imin    = 1 
    520          DO ji = 1, nfact-1, 2 
    521             idiff = ABS( ifact(ji) - ifact(ji+1) ) 
    522             IF( idiff < mindiff ) THEN 
    523                mindiff = idiff 
    524                imin = ji 
    525             ENDIF 
    526          END DO 
    527          jpnj = ifact(imin) 
    528          jpni = ifact(imin + 1) 
    529       ENDIF 
    530       ! 
    531       jpnij = jpni*jpnj 
    532       ! 
    533    END SUBROUTINE nemo_partition 
    534  
    535  
    536    SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr ) 
    537       !!---------------------------------------------------------------------- 
    538       !!                     ***  ROUTINE factorise  *** 
    539       !! 
    540       !! ** Purpose :   return the prime factors of n. 
    541       !!                knfax factors are returned in array kfax which is of 
    542       !!                maximum dimension kmaxfax. 
    543       !! ** Method  : 
    544       !!---------------------------------------------------------------------- 
    545       INTEGER                    , INTENT(in   ) ::   kn, kmaxfax 
    546       INTEGER                    , INTENT(  out) ::   kerr, knfax 
    547       INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax 
    548       ! 
    549       INTEGER :: ifac, jl, inu 
    550       INTEGER, PARAMETER :: ntest = 14 
    551       INTEGER, DIMENSION(ntest) ::   ilfax 
    552       !!---------------------------------------------------------------------- 
    553       ! 
    554       ! lfax contains the set of allowed factors. 
    555       ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
    556       ! 
    557       ! Clear the error flag and initialise output vars 
    558       kerr  = 0 
    559       kfax  = 1 
    560       knfax = 0 
    561       ! 
    562       IF( kn /= 1 ) THEN      ! Find the factors of n 
    563          ! 
    564          ! nu holds the unfactorised part of the number. 
    565          ! knfax holds the number of factors found. 
    566          ! l points to the allowed factor list. 
    567          ! ifac holds the current factor. 
    568          ! 
    569          inu   = kn 
    570          knfax = 0 
    571          ! 
    572          DO jl = ntest, 1, -1 
    573             ! 
    574             ifac = ilfax(jl) 
    575             IF( ifac > inu )   CYCLE 
    576             ! 
    577             ! Test whether the factor will divide. 
    578             ! 
    579             IF( MOD(inu,ifac) == 0 ) THEN 
    580                ! 
    581                knfax = knfax + 1            ! Add the factor to the list 
    582                IF( knfax > kmaxfax ) THEN 
    583                   kerr = 6 
    584                   write (*,*) 'FACTOR: insufficient space in factor array ', knfax 
    585                   return 
    586                ENDIF 
    587                kfax(knfax) = ifac 
    588                ! Store the other factor that goes with this one 
    589                knfax = knfax + 1 
    590                kfax(knfax) = inu / ifac 
    591                !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 
    592             ENDIF 
    593             ! 
    594          END DO 
    595          ! 
    596       ENDIF 
    597       ! 
    598    END SUBROUTINE factorise 
    599  
    600 #if defined key_mpp_mpi 
    601  
    602    SUBROUTINE nemo_nfdcom 
    603       !!---------------------------------------------------------------------- 
    604       !!                     ***  ROUTINE  nemo_nfdcom  *** 
    605       !! ** Purpose :   Setup for north fold exchanges with explicit  
    606       !!                point-to-point messaging 
    607       !! 
    608       !! ** Method :   Initialization of the northern neighbours lists. 
    609       !!---------------------------------------------------------------------- 
    610       !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    611       !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
    612       !!---------------------------------------------------------------------- 
    613       INTEGER  ::   sxM, dxM, sxT, dxT, jn 
    614       INTEGER  ::   njmppmax 
    615       !!---------------------------------------------------------------------- 
    616       ! 
    617       njmppmax = MAXVAL( njmppt ) 
    618       ! 
    619       !initializes the north-fold communication variables 
    620       isendto(:) = 0 
    621       nsndto     = 0 
    622       ! 
    623       IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north 
    624          ! 
    625          !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 
    626          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 
    627          !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 
    628          dxM = jpiglo - nimppt(narea) + 2 
    629          ! 
    630          ! loop over the other north-fold processes to find the processes 
    631          ! managing the points belonging to the sxT-dxT range 
    632          ! 
    633          DO jn = 1, jpni 
    634             ! 
    635             sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process 
    636             dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process 
    637             ! 
    638             IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN 
    639                nsndto          = nsndto + 1 
    640                isendto(nsndto) = jn 
    641             ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN 
    642                nsndto          = nsndto + 1 
    643                isendto(nsndto) = jn 
    644             ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN 
    645                nsndto          = nsndto + 1 
    646                isendto(nsndto) = jn 
    647             ENDIF 
    648             ! 
    649          END DO 
    650          nfsloop = 1 
    651          nfeloop = nlci 
    652          DO jn = 2,jpni-1 
    653             IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN 
    654                IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi 
    655                IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei 
    656             ENDIF 
    657          END DO 
    658          ! 
    659       ENDIF 
    660       l_north_nogather = .TRUE. 
    661       ! 
    662    END SUBROUTINE nemo_nfdcom 
    663  
    664 #else 
    665    SUBROUTINE nemo_nfdcom      ! Dummy routine 
    666       WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?' 
    667    END SUBROUTINE nemo_nfdcom 
    668 #endif 
    669  
    670441   SUBROUTINE istate_init 
    671442      !!---------------------------------------------------------------------- 
     
    715486      ! 
    716487   END SUBROUTINE stp_ctl 
    717  
    718488   !!====================================================================== 
    719489END MODULE nemogcm 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r9169 r9436  
    239239      ierr(:) = 0 
    240240      ! 
    241       ALLOCATE( mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj),  & 
    242          &      nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), STAT=ierr(1) ) 
    243          ! 
    244       ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     & 
    245          &      njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,     & 
    246          &                                      nleit(jpnij) , nlejt(jpnij) ,     & 
    247          &      mi0(jpiglo)   , mi1 (jpiglo),  mj0(jpjglo)   , mj1 (jpjglo) ,     & 
     241      ALLOCATE( mig(jpi), mjg(jpj), STAT=ierr(1) ) 
     242         ! 
     243      ALLOCATE( mi0(jpiglo)   , mi1 (jpiglo),  mj0(jpjglo)   , mj1 (jpjglo) ,     & 
    248244         &      tpol(jpiglo)  , fpol(jpiglo)                                , STAT=ierr(2) ) 
    249245         ! 
  • 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 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r9367 r9436  
    2828   !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    2929   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    30    !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_nfdcom 
    3130   !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE 
    3231   !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening  
    33    !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_nfdcom: setup avoiding MPI communication  
    3432   !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla) 
    3533   !!            4.0  ! 2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
     
    4240   !!   nemo_closefile: close remaining open files 
    4341   !!   nemo_alloc    : dynamical allocation 
    44    !!   nemo_partition: calculate MPP domain decomposition 
    45    !!   factorise     : calculate the factors of the no. of MPI processes 
    46    !!   nemo_nfdcom   : Setup for north fold exchanges with explicit point-to-point messaging 
    4742   !!---------------------------------------------------------------------- 
    4843   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
     
    239234      INTEGER  ::   ji                 ! dummy loop indices 
    240235      INTEGER  ::   ios, ilocal_comm   ! local integers 
    241       INTEGER  ::   iiarea, ijarea     !   -       - 
    242       INTEGER  ::   iirest, ijrest     !   -       - 
    243236      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam 
    244237      !! 
     
    329322      ENDIF 
    330323 
    331       ! If dimensions of processor grid weren't specified in the namelist file 
    332       ! then we calculate them here now that we have our communicator size 
    333       IF( jpni < 1 .OR. jpnj < 1 ) THEN 
    334 #if   defined key_mpp_mpi 
    335          IF( Agrif_Root() )   CALL nemo_partition( mppsize ) 
    336 #else 
    337          jpni  = 1 
    338          jpnj  = 1 
    339          jpnij = jpni*jpnj 
    340 #endif 
    341       ENDIF 
    342       ! 
    343 #if defined key_agrif 
    344       IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90) 
    345          jpiglo  = nbcellsx + 2 + 2*nbghostcells 
    346          jpjglo  = nbcellsy + 2 + 2*nbghostcells 
    347          jpi     = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls 
    348          jpj     = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls 
    349          jpimax  = jpi 
    350          jpjmax  = jpj 
    351          nperio  = 0 
    352          jperio  = 0 
    353          ln_use_jattr = .false. 
    354       ENDIF 
    355 #endif 
    356  
    357       IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj 
    358          iiarea = 1 + MOD( narea - 1 , jpni ) 
    359          ijarea = 1 + ( narea - 1 ) / jpni 
    360          iirest = 1 + MOD( jpiglo - 2*nn_hls - 1 , jpni ) 
    361          ijrest = 1 + MOD( jpjglo - 2*nn_hls - 1 , jpnj ) 
    362 #if defined key_nemocice_decomp 
    363          jpi = ( nx_global+2-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim. 
    364          jpj = ( ny_global+2-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim.  
    365          jpimax  = jpi 
    366          jpjmax  = jpj 
    367          IF( iiarea == jpni ) jpi = jpiglo - (jpni - 1) * (jpi - 2*nn_hls) 
    368          IF( ijarea == jpnj ) jpj = jpjglo - (jpnj - 1) * (jpj - 2*nn_hls) 
    369 #else 
    370          jpi = ( jpiglo     -2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim. 
    371          jpj = ( jpjglo     -2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim. 
    372          jpimax  = jpi 
    373          jpjmax  = jpj 
    374          IF( iiarea > iirest ) jpi = jpi - 1 
    375          IF( ijarea > ijrest ) jpj = jpj - 1 
    376 #endif 
    377       ENDIF 
    378  
    379       jpk = jpkglo                                             ! third dim 
    380  
    381 #if defined key_agrif 
    382       ! simple trick to use same vertical grid as parent but different number of levels:  
    383       ! Save maximum number of levels in jpkglo, then define all vertical grids with this number. 
    384       ! Suppress once vertical online interpolation is ok 
    385       IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo ) 
    386 #endif 
    387       jpim1 = jpi-1                                            ! inner domain indices 
    388       jpjm1 = jpj-1                                            !   "           " 
    389       jpkm1 = MAX( 1, jpk-1 )                                  !   "           " 
    390       jpij  = jpi*jpj                                          !  jpi x j 
    391  
    392324      IF(lwp) THEN                            ! open listing units 
    393325         ! 
     
    413345         ! 
    414346      ENDIF 
     347      !                                      ! Domain decomposition 
     348      CALL mpp_init                          ! MPP 
    415349 
    416350      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
     
    422356 
    423357      CALL nemo_ctl                          ! Control prints 
    424  
    425       !                                      ! Domain decomposition 
    426       CALL mpp_init                             ! MPP 
    427       IF( ln_nnogather )   CALL nemo_nfdcom     ! northfold neighbour lists 
    428358      ! 
    429359      !                                      ! General initialization 
     
    681611   END SUBROUTINE nemo_alloc 
    682612 
    683  
    684    SUBROUTINE nemo_partition( num_pes ) 
    685       !!---------------------------------------------------------------------- 
    686       !!                 ***  ROUTINE nemo_partition  *** 
    687       !! 
    688       !! ** Purpose : 
    689       !! 
    690       !! ** Method  : 
    691       !!---------------------------------------------------------------------- 
    692       INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have 
    693       ! 
    694       INTEGER, PARAMETER :: nfactmax = 20 
    695       INTEGER :: nfact ! The no. of factors returned 
    696       INTEGER :: ierr  ! Error flag 
    697       INTEGER :: ji 
    698       INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value 
    699       INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 
    700       !!---------------------------------------------------------------------- 
    701       ! 
    702       ierr = 0 
    703       ! 
    704       CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 
    705       ! 
    706       IF( nfact <= 1 ) THEN 
    707          WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 
    708          WRITE (numout, *) '       : using grid of ',num_pes,' x 1' 
    709          jpnj = 1 
    710          jpni = num_pes 
    711       ELSE 
    712          ! Search through factors for the pair that are closest in value 
    713          mindiff = 1000000 
    714          imin    = 1 
    715          DO ji = 1, nfact-1, 2 
    716             idiff = ABS( ifact(ji) - ifact(ji+1) ) 
    717             IF( idiff < mindiff ) THEN 
    718                mindiff = idiff 
    719                imin = ji 
    720             ENDIF 
    721          END DO 
    722          jpnj = ifact(imin) 
    723          jpni = ifact(imin + 1) 
    724       ENDIF 
    725       ! 
    726       jpnij = jpni*jpnj 
    727       ! 
    728    END SUBROUTINE nemo_partition 
    729  
    730  
    731    SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr ) 
    732       !!---------------------------------------------------------------------- 
    733       !!                     ***  ROUTINE factorise  *** 
    734       !! 
    735       !! ** Purpose :   return the prime factors of n. 
    736       !!                knfax factors are returned in array kfax which is of 
    737       !!                maximum dimension kmaxfax. 
    738       !! ** Method  : 
    739       !!---------------------------------------------------------------------- 
    740       INTEGER                    , INTENT(in   ) ::   kn, kmaxfax 
    741       INTEGER                    , INTENT(  out) ::   kerr, knfax 
    742       INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax 
    743       ! 
    744       INTEGER :: ifac, jl, inu 
    745       INTEGER, PARAMETER :: ntest = 14 
    746       INTEGER, DIMENSION(ntest) ::   ilfax 
    747       !!---------------------------------------------------------------------- 
    748       ! 
    749       ! lfax contains the set of allowed factors. 
    750       ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
    751       ! 
    752       ! Clear the error flag and initialise output vars 
    753       kerr  = 0 
    754       kfax  = 1 
    755       knfax = 0 
    756       ! 
    757       IF( kn /= 1 ) THEN      ! Find the factors of n 
    758          ! 
    759          ! nu holds the unfactorised part of the number. 
    760          ! knfax holds the number of factors found. 
    761          ! l points to the allowed factor list. 
    762          ! ifac holds the current factor. 
    763          ! 
    764          inu   = kn 
    765          knfax = 0 
    766          ! 
    767          DO jl = ntest, 1, -1 
    768             ! 
    769             ifac = ilfax(jl) 
    770             IF( ifac > inu )   CYCLE 
    771             ! 
    772             ! Test whether the factor will divide. 
    773             ! 
    774             IF( MOD(inu,ifac) == 0 ) THEN 
    775                ! 
    776                knfax = knfax + 1            ! Add the factor to the list 
    777                IF( knfax > kmaxfax ) THEN 
    778                   kerr = 6 
    779                   write (*,*) 'FACTOR: insufficient space in factor array ', knfax 
    780                   return 
    781                ENDIF 
    782                kfax(knfax) = ifac 
    783                ! Store the other factor that goes with this one 
    784                knfax = knfax + 1 
    785                kfax(knfax) = inu / ifac 
    786                !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 
    787             ENDIF 
    788             ! 
    789          END DO 
    790          ! 
    791       ENDIF 
    792       ! 
    793    END SUBROUTINE factorise 
    794  
    795 #if defined key_mpp_mpi 
    796  
    797    SUBROUTINE nemo_nfdcom 
    798       !!---------------------------------------------------------------------- 
    799       !!                     ***  ROUTINE  nemo_nfdcom  *** 
    800       !! ** Purpose :   Setup for north fold exchanges with explicit  
    801       !!                point-to-point messaging 
    802       !! 
    803       !! ** Method :   Initialization of the northern neighbours lists. 
    804       !!---------------------------------------------------------------------- 
    805       !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    806       !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
    807       !!---------------------------------------------------------------------- 
    808       INTEGER  ::   sxM, dxM, sxT, dxT, jn 
    809       INTEGER  ::   njmppmax 
    810       !!---------------------------------------------------------------------- 
    811       ! 
    812       njmppmax = MAXVAL( njmppt ) 
    813       ! 
    814       !initializes the north-fold communication variables 
    815       isendto(:) = 0 
    816       nsndto     = 0 
    817       ! 
    818       IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north 
    819          ! 
    820          !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 
    821          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 
    822          !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 
    823          dxM = jpiglo - nimppt(narea) + 2 
    824          ! 
    825          ! loop over the other north-fold processes to find the processes 
    826          ! managing the points belonging to the sxT-dxT range 
    827          ! 
    828          DO jn = 1, jpni 
    829             ! 
    830             sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process 
    831             dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process 
    832             ! 
    833             IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN 
    834                nsndto          = nsndto + 1 
    835                isendto(nsndto) = jn 
    836             ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN 
    837                nsndto          = nsndto + 1 
    838                isendto(nsndto) = jn 
    839             ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN 
    840                nsndto          = nsndto + 1 
    841                isendto(nsndto) = jn 
    842             ENDIF 
    843             ! 
    844          END DO 
    845          nfsloop = 1 
    846          nfeloop = nlci 
    847          DO jn = 2,jpni-1 
    848             IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN 
    849                IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi 
    850                IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei 
    851             ENDIF 
    852          END DO 
    853          ! 
    854       ENDIF 
    855       l_north_nogather = .TRUE. 
    856       ! 
    857    END SUBROUTINE nemo_nfdcom 
    858  
    859 #else 
    860    SUBROUTINE nemo_nfdcom      ! Dummy routine 
    861       WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?' 
    862    END SUBROUTINE nemo_nfdcom 
    863 #endif 
    864  
    865613   !!====================================================================== 
    866614END MODULE nemogcm 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90

    r9367 r9436  
    1414   !!   nemo_closefile: close remaining open files 
    1515   !!   nemo_alloc    : dynamical allocation 
    16    !!   nemo_partition: calculate MPP domain decomposition 
    17    !!   factorise     : calculate the factors of the no. of MPI processes 
    1816   !!---------------------------------------------------------------------- 
    1917   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
     
    9391      INTEGER ::   ji                 ! dummy loop indices 
    9492      INTEGER ::   ios, ilocal_comm   ! local integer 
    95       INTEGER  ::   iiarea, ijarea     ! local integers 
    96       INTEGER  ::   iirest, ijrest     ! local integers 
    9793      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam 
    9894      ! 
     
    10096         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   & 
    10197         &             ln_timing, ln_diacfl 
    102       NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
     98      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    10399      !!---------------------------------------------------------------------- 
    104100      ! 
     
    136132      ENDIF 
    137133      ! 
    138       jpk = jpkglo 
    139       ! 
    140 #if defined key_agrif 
    141       IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90) 
    142          jpiglo  = nbcellsx + 2 + 2*nbghostcells 
    143          jpjglo  = nbcellsy + 2 + 2*nbghostcells 
    144          jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
    145          jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
    146          nperio  = 0 
    147          jperio  = 0 
    148          ln_use_jattr = .false. 
    149       ENDIF 
    150 #endif 
    151134      ! 
    152135      !                             !--------------------------------------------! 
     
    174157         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 
    175158      ELSE 
    176          ilocal_comm = 0 
    177          ! Nodes selection (control print return in cltxt) 
     159         ilocal_comm = 0                                    ! Nodes selection (control print return in cltxt) 
    178160         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) 
    179161      ENDIF 
     
    198180      ENDIF 
    199181 
    200       ! If dimensions of processor grid weren't specified in the namelist file 
    201       ! then we calculate them here now that we have our communicator size 
    202       IF( jpni < 1 .OR. jpnj < 1 ) THEN 
    203 #if   defined key_mpp_mpi 
    204          IF( Agrif_Root() )   CALL nemo_partition( mppsize ) 
    205 #else 
    206          jpni  = 1 
    207          jpnj  = 1 
    208          jpnij = jpni*jpnj 
    209 #endif 
    210       ENDIF 
    211       ! 
    212 #if defined key_agrif 
    213       IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90) 
    214          jpiglo  = nbcellsx + 2 + 2*nbghostcells 
    215          jpjglo  = nbcellsy + 2 + 2*nbghostcells 
    216          jpi     = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls 
    217          jpj     = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls 
    218          jpimax  = jpi 
    219          jpjmax  = jpj 
    220          nperio  = 0 
    221          jperio  = 0 
    222          ln_use_jattr = .false. 
    223       ENDIF 
    224 #endif 
    225  
    226       IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj 
    227          iiarea = 1 + MOD( narea - 1 , jpni ) 
    228          ijarea = 1 + ( narea - 1 ) / jpni 
    229          iirest = 1 + MOD( jpiglo - 2*nn_hls - 1 , jpni ) 
    230          ijrest = 1 + MOD( jpjglo - 2*nn_hls - 1 , jpnj ) 
    231 #if defined key_nemocice_decomp 
    232          jpi = ( nx_global+2-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim. 
    233          jpj = ( ny_global+2-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim.  
    234          jpimax  = jpi 
    235          jpjmax  = jpj 
    236          IF( iiarea == jpni ) jpi = jpiglo - (jpni - 1) * (jpi - 2*nn_hls) 
    237          IF( ijarea == jpnj ) jpj = jpjglo - (jpnj - 1) * (jpj - 2*nn_hls) 
    238 #else 
    239          jpi = ( jpiglo     -2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim. 
    240          jpj = ( jpjglo     -2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim. 
    241          jpimax  = jpi 
    242          jpjmax  = jpj 
    243          IF( iiarea > iirest ) jpi = jpi - 1 
    244          IF( ijarea > ijrest ) jpj = jpj - 1 
    245 #endif 
    246       ENDIF 
    247  
    248       jpk = jpkglo                                             ! third dim 
    249  
    250 #if defined key_agrif 
    251       ! simple trick to use same vertical grid as parent but different number of levels:  
    252       ! Save maximum number of levels in jpkglo, then define all vertical grids with this number. 
    253       ! Suppress once vertical online interpolation is ok 
    254       IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo ) 
    255 #endif 
    256       jpim1 = jpi-1                                            ! inner domain indices 
    257       jpjm1 = jpj-1                                            !   "           " 
    258       jpkm1 = MAX( 1, jpk-1 )                                  !   "           " 
    259       jpij  = jpi*jpj                                          !  jpi x j 
    260  
    261182      IF(lwp) THEN                            ! open listing units 
    262183         ! 
     
    267188         WRITE(numout,*) '                       NEMO team' 
    268189         WRITE(numout,*) '            Stand Alone Observation operator' 
    269          WRITE(numout,*) '                NEMO version 3.7  (2015) ' 
     190         WRITE(numout,*) '                NEMO version 4.0  (2017) ' 
    270191         WRITE(numout,*) 
    271192         WRITE(numout,*) 
     
    282203         ! 
    283204      ENDIF 
     205      !                                      ! Domain decomposition 
     206      CALL mpp_init                          ! MPP 
    284207 
    285208      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
     
    290213      !                             !-------------------------------! 
    291214 
    292       CALL nemo_ctl                             ! Control prints & Benchmark 
    293  
    294       !                                      ! Domain decomposition 
    295       CALL mpp_init 
    296       ! 
    297       IF( ln_timing    )   CALL timing_init     ! timing by routine 
     215      CALL nemo_ctl                          ! Control prints 
    298216      ! 
    299217      !                                         ! General initialization 
     218      IF( ln_timing    )   CALL timing_init     ! timing 
     219      IF( ln_timing    )   CALL timing_start( 'nemo_init') 
     220      ! 
    300221                           CALL phy_cst            ! Physical constants 
    301222                           CALL eos_init           ! Equation of state 
    302223                           CALL dom_init('SAO')    ! Domain 
    303224 
    304       IF( ln_nnogather )   CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 
    305225 
    306226      IF( ln_ctl       )   CALL prt_ctl_init    ! Print control 
     
    322242         WRITE(numout,*) 
    323243         WRITE(numout,*) 'nemo_ctl: Control prints' 
    324          WRITE(numout,*) '~~~~~~~ ' 
     244         WRITE(numout,*) '~~~~~~~~' 
    325245         WRITE(numout,*) '   Namelist namctl' 
    326246         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl 
     
    351271         WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg 
    352272         WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg) 
     273         WRITE(numout,*) '         keep closed seas in the domain (if exist)     ln_closea     = ', ln_closea 
    353274         WRITE(numout,*) '      write configuration definition file           ln_write_cfg     = ', ln_write_cfg 
    354275         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out) 
    355276         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    356277      ENDIF 
     278      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
     279      ! 
    357280      !                             ! Parameter control 
    358281      ! 
     
    454377   END SUBROUTINE nemo_alloc 
    455378 
    456  
    457    SUBROUTINE nemo_partition( num_pes ) 
    458       !!---------------------------------------------------------------------- 
    459       !!                 ***  ROUTINE nemo_partition  *** 
    460       !! 
    461       !! ** Purpose : 
    462       !! 
    463       !! ** Method  : 
    464       !!---------------------------------------------------------------------- 
    465       INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have 
    466       ! 
    467       INTEGER, PARAMETER :: nfactmax = 20 
    468       INTEGER :: nfact ! The no. of factors returned 
    469       INTEGER :: ierr  ! Error flag 
    470       INTEGER :: ji 
    471       INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value 
    472       INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 
    473       !!---------------------------------------------------------------------- 
    474       ! 
    475       ierr = 0 
    476       ! 
    477       CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 
    478       ! 
    479       IF( nfact <= 1 ) THEN 
    480          WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 
    481          WRITE (numout, *) '       : using grid of ',num_pes,' x 1' 
    482          jpnj = 1 
    483          jpni = num_pes 
    484       ELSE 
    485          ! Search through factors for the pair that are closest in value 
    486          mindiff = 1000000 
    487          imin    = 1 
    488          DO ji = 1, nfact-1, 2 
    489             idiff = ABS( ifact(ji) - ifact(ji+1) ) 
    490             IF( idiff < mindiff ) THEN 
    491                mindiff = idiff 
    492                imin = ji 
    493             ENDIF 
    494          END DO 
    495          jpnj = ifact(imin) 
    496          jpni = ifact(imin + 1) 
    497       ENDIF 
    498       ! 
    499       jpnij = jpni*jpnj 
    500       ! 
    501    END SUBROUTINE nemo_partition 
    502  
    503  
    504    SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr ) 
    505       !!---------------------------------------------------------------------- 
    506       !!                     ***  ROUTINE factorise  *** 
    507       !! 
    508       !! ** Purpose :   return the prime factors of n. 
    509       !!                knfax factors are returned in array kfax which is of 
    510       !!                maximum dimension kmaxfax. 
    511       !! ** Method  : 
    512       !!---------------------------------------------------------------------- 
    513       INTEGER                    , INTENT(in   ) ::   kn, kmaxfax 
    514       INTEGER                    , INTENT(  out) ::   kerr, knfax 
    515       INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax 
    516       ! 
    517       INTEGER :: ifac, jl, inu 
    518       INTEGER, PARAMETER :: ntest = 14 
    519       INTEGER, DIMENSION(ntest) ::   ilfax 
    520       !!---------------------------------------------------------------------- 
    521       ! 
    522       ! lfax contains the set of allowed factors. 
    523       ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
    524       ! 
    525       ! Clear the error flag and initialise output vars 
    526       kerr  = 0 
    527       kfax  = 1 
    528       knfax = 0 
    529       ! 
    530       ! Find the factors of n. 
    531       IF( kn .NE. 1 ) THEN 
    532  
    533          ! nu holds the unfactorised part of the number. 
    534          ! knfax holds the number of factors found. 
    535          ! l points to the allowed factor list. 
    536          ! ifac holds the current factor. 
    537          ! 
    538          inu   = kn 
    539          knfax = 0 
    540          ! 
    541          DO jl = ntest, 1, -1 
    542             ! 
    543             ifac = ilfax(jl) 
    544             IF( ifac > inu )   CYCLE 
    545     
    546             ! Test whether the factor will divide. 
    547     
    548             IF( MOD(inu,ifac) == 0 ) THEN 
    549                ! 
    550                knfax = knfax + 1            ! Add the factor to the list 
    551                IF( knfax > kmaxfax ) THEN 
    552                   kerr = 6 
    553                   write (*,*) 'FACTOR: insufficient space in factor array ', knfax 
    554                   return 
    555                ENDIF 
    556                kfax(knfax) = ifac 
    557                ! Store the other factor that goes with this one 
    558                knfax = knfax + 1 
    559                kfax(knfax) = inu / ifac 
    560                !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 
    561             ENDIF 
    562             ! 
    563          END DO 
    564          ! 
    565       ENDIF 
    566       ! 
    567    END SUBROUTINE factorise 
    568  
    569 #if defined key_mpp_mpi 
    570  
    571    SUBROUTINE nemo_northcomms 
    572       !!---------------------------------------------------------------------- 
    573       !!                     ***  ROUTINE  nemo_northcomms  *** 
    574       !! ** Purpose :   Setup for north fold exchanges with explicit  
    575       !!                point-to-point messaging 
    576       !! 
    577       !! ** Method :   Initialization of the northern neighbours lists. 
    578       !!---------------------------------------------------------------------- 
    579       !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    580       !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
    581       !!---------------------------------------------------------------------- 
    582       INTEGER  ::   sxM, dxM, sxT, dxT, jn 
    583       INTEGER  ::   njmppmax 
    584       !!---------------------------------------------------------------------- 
    585       ! 
    586       njmppmax = MAXVAL( njmppt ) 
    587       ! 
    588       !initializes the north-fold communication variables 
    589       isendto(:) = 0 
    590       nsndto     = 0 
    591       ! 
    592       !if I am a process in the north 
    593       IF ( njmpp == njmppmax ) THEN 
    594           !sxM is the first point (in the global domain) needed to compute the 
    595           !north-fold for the current process 
    596           sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 
    597           !dxM is the last point (in the global domain) needed to compute the 
    598           !north-fold for the current process 
    599           dxM = jpiglo - nimppt(narea) + 2 
    600  
    601           !loop over the other north-fold processes to find the processes 
    602           !managing the points belonging to the sxT-dxT range 
    603    
    604           DO jn = 1, jpni 
    605                 !sxT is the first point (in the global domain) of the jn 
    606                 !process 
    607                 sxT = nfiimpp(jn, jpnj) 
    608                 !dxT is the last point (in the global domain) of the jn 
    609                 !process 
    610                 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 
    611                 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    612                    nsndto = nsndto + 1 
    613                    isendto(nsndto) = jn 
    614                 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    615                    nsndto = nsndto + 1 
    616                    isendto(nsndto) = jn 
    617                 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 
    618                    nsndto = nsndto + 1 
    619                    isendto(nsndto) = jn 
    620                 ENDIF 
    621           END DO 
    622           nfsloop = 1 
    623           nfeloop = nlci 
    624           DO jn = 2,jpni-1 
    625            IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 
    626               IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 
    627                  nfsloop = nldi 
    628               ENDIF 
    629               IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 
    630                  nfeloop = nlei 
    631               ENDIF 
    632            ENDIF 
    633         END DO 
    634  
    635       ENDIF 
    636       l_north_nogather = .TRUE. 
    637    END SUBROUTINE nemo_northcomms 
    638  
    639 #else 
    640    SUBROUTINE nemo_northcomms      ! Dummy routine 
    641       WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?' 
    642    END SUBROUTINE nemo_northcomms 
    643 #endif 
    644  
    645379   !!====================================================================== 
    646380END MODULE nemogcm 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r9367 r9436  
    1616   !!   nemo_closefile: close remaining open files 
    1717   !!   nemo_alloc    : dynamical allocation 
    18    !!   nemo_partition: calculate MPP domain decomposition 
    19    !!   factorise     : calculate the factors of the no. of MPI processes 
    20    !!   nemo_nfdcom   : Setup for north fold exchanges with explicit point-to-point messaging 
    2118   !!---------------------------------------------------------------------- 
    2219   USE step_oce       ! module used in the ocean time stepping module 
     
    175172      INTEGER  ::   ji                 ! dummy loop indices 
    176173      INTEGER  ::   ios, ilocal_comm   ! local integers 
    177       INTEGER  ::   iiarea, ijarea     !   -       - 
    178       INTEGER  ::   iirest, ijrest     !   -       - 
    179174      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam 
    180175      CHARACTER(len=80)                 ::   clname 
     
    273268      ENDIF 
    274269 
    275       ! If dimensions of processor grid weren't specified in the namelist file 
    276       ! then we calculate them here now that we have our communicator size 
    277       IF( jpni < 1 .OR. jpnj < 1 ) THEN 
    278 #if   defined key_mpp_mpi 
    279          IF( Agrif_Root() )   CALL nemo_partition( mppsize ) 
    280 #else 
    281          jpni  = 1 
    282          jpnj  = 1 
    283          jpnij = jpni*jpnj 
    284 #endif 
    285       ENDIF 
    286       ! 
    287 #if defined key_agrif 
    288       IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90) 
    289          jpiglo  = nbcellsx + 2 + 2*nbghostcells 
    290          jpjglo  = nbcellsy + 2 + 2*nbghostcells 
    291          jpi     = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls 
    292          jpj     = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls 
    293          jpimax  = jpi 
    294          jpjmax  = jpj 
    295          nperio  = 0 
    296          jperio  = 0 
    297          ln_use_jattr = .false. 
    298       ENDIF 
    299 #endif 
    300  
    301       IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj 
    302          iiarea = 1 + MOD( narea - 1 , jpni ) 
    303          ijarea = 1 + ( narea - 1 ) / jpni 
    304          iirest = 1 + MOD( jpiglo - 2*nn_hls - 1 , jpni ) 
    305          ijrest = 1 + MOD( jpjglo - 2*nn_hls - 1 , jpnj ) 
    306 #if defined key_nemocice_decomp 
    307          jpi = ( nx_global+2-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim. 
    308          jpj = ( ny_global+2-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim.  
    309          jpimax  = jpi 
    310          jpjmax  = jpj 
    311          IF( iiarea == jpni ) jpi = jpiglo - (jpni - 1) * (jpi - 2*nn_hls) 
    312          IF( ijarea == jpnj ) jpj = jpjglo - (jpnj - 1) * (jpj - 2*nn_hls) 
    313 #else 
    314          jpi = ( jpiglo     -2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls    ! first  dim. 
    315          jpj = ( jpjglo     -2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls    ! second dim. 
    316          jpimax  = jpi 
    317          jpjmax  = jpj 
    318          IF( iiarea > iirest ) jpi = jpi - 1 
    319          IF( ijarea > ijrest ) jpj = jpj - 1 
    320 #endif 
    321       ENDIF 
    322  
    323       jpk = jpkglo                                             ! third dim 
    324  
    325 #if defined key_agrif 
    326       ! simple trick to use same vertical grid as parent but different number of levels:  
    327       ! Save maximum number of levels in jpkglo, then define all vertical grids with this number. 
    328       ! Suppress once vertical online interpolation is ok 
    329       IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo ) 
    330 #endif 
    331       jpim1 = jpi-1                                            ! inner domain indices 
    332       jpjm1 = jpj-1                                            !   "           " 
    333       jpkm1 = MAX( 1, jpk-1 )                                  !   "           " 
    334       jpij  = jpi*jpj                                          !  jpi x j 
    335  
    336270      IF(lwp) THEN                            ! open listing units 
    337271         ! 
     
    360294         ! 
    361295      ENDIF 
     296      !                                      ! Domain decomposition 
     297      CALL mpp_init                          ! MPP 
    362298 
    363299      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
     
    369305 
    370306      CALL nemo_ctl                          ! Control prints 
    371  
    372       !                                      ! Domain decomposition 
    373       CALL mpp_init                             ! MPP 
    374       IF( ln_nnogather )   CALL nemo_nfdcom     ! northfold neighbour lists 
    375       ! 
    376307      ! 
    377308      !                                      ! General initialization 
     
    552483   END SUBROUTINE nemo_alloc 
    553484 
    554  
    555    SUBROUTINE nemo_partition( num_pes ) 
    556       !!---------------------------------------------------------------------- 
    557       !!                 ***  ROUTINE nemo_partition  *** 
    558       !! 
    559       !! ** Purpose : 
    560       !! 
    561       !! ** Method  : 
    562       !!---------------------------------------------------------------------- 
    563       INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have 
    564       ! 
    565       INTEGER, PARAMETER :: nfactmax = 20 
    566       INTEGER :: nfact ! The no. of factors returned 
    567       INTEGER :: ierr  ! Error flag 
    568       INTEGER :: ji 
    569       INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value 
    570       INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 
    571       !!---------------------------------------------------------------------- 
    572       ! 
    573       ierr = 0 
    574       ! 
    575       CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 
    576       ! 
    577       IF( nfact <= 1 ) THEN 
    578          WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 
    579          WRITE (numout, *) '       : using grid of ',num_pes,' x 1' 
    580          jpnj = 1 
    581          jpni = num_pes 
    582       ELSE 
    583          ! Search through factors for the pair that are closest in value 
    584          mindiff = 1000000 
    585          imin    = 1 
    586          DO ji = 1, nfact-1, 2 
    587             idiff = ABS( ifact(ji) - ifact(ji+1) ) 
    588             IF( idiff < mindiff ) THEN 
    589                mindiff = idiff 
    590                imin = ji 
    591             ENDIF 
    592          END DO 
    593          jpnj = ifact(imin) 
    594          jpni = ifact(imin + 1) 
    595       ENDIF 
    596       ! 
    597       jpnij = jpni*jpnj 
    598       ! 
    599    END SUBROUTINE nemo_partition 
    600  
    601  
    602    SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr ) 
    603       !!---------------------------------------------------------------------- 
    604       !!                     ***  ROUTINE factorise  *** 
    605       !! 
    606       !! ** Purpose :   return the prime factors of n. 
    607       !!                knfax factors are returned in array kfax which is of 
    608       !!                maximum dimension kmaxfax. 
    609       !! ** Method  : 
    610       !!---------------------------------------------------------------------- 
    611       INTEGER                    , INTENT(in   ) ::   kn, kmaxfax 
    612       INTEGER                    , INTENT(  out) ::   kerr, knfax 
    613       INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax 
    614       ! 
    615       INTEGER :: ifac, jl, inu 
    616       INTEGER, PARAMETER :: ntest = 14 
    617       INTEGER, DIMENSION(ntest) ::   ilfax 
    618       !!---------------------------------------------------------------------- 
    619       ! 
    620       ! lfax contains the set of allowed factors. 
    621       ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
    622       ! 
    623       ! Clear the error flag and initialise output vars 
    624       kerr  = 0 
    625       kfax  = 1 
    626       knfax = 0 
    627       ! 
    628       IF( kn /= 1 ) THEN      ! Find the factors of n 
    629          ! 
    630          ! nu holds the unfactorised part of the number. 
    631          ! knfax holds the number of factors found. 
    632          ! l points to the allowed factor list. 
    633          ! ifac holds the current factor. 
    634          ! 
    635          inu   = kn 
    636          knfax = 0 
    637          ! 
    638          DO jl = ntest, 1, -1 
    639             ! 
    640             ifac = ilfax(jl) 
    641             IF( ifac > inu )   CYCLE 
    642             ! 
    643             ! Test whether the factor will divide. 
    644             ! 
    645             IF( MOD(inu,ifac) == 0 ) THEN 
    646                ! 
    647                knfax = knfax + 1            ! Add the factor to the list 
    648                IF( knfax > kmaxfax ) THEN 
    649                   kerr = 6 
    650                   write (*,*) 'FACTOR: insufficient space in factor array ', knfax 
    651                   return 
    652                ENDIF 
    653                kfax(knfax) = ifac 
    654                ! Store the other factor that goes with this one 
    655                knfax = knfax + 1 
    656                kfax(knfax) = inu / ifac 
    657                !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 
    658             ENDIF 
    659             ! 
    660          END DO 
    661          ! 
    662       ENDIF 
    663       ! 
    664    END SUBROUTINE factorise 
    665  
    666 #if defined key_mpp_mpi 
    667  
    668    SUBROUTINE nemo_nfdcom 
    669       !!---------------------------------------------------------------------- 
    670       !!                     ***  ROUTINE  nemo_nfdcom  *** 
    671       !! ** Purpose :   Setup for north fold exchanges with explicit  
    672       !!                point-to-point messaging 
    673       !! 
    674       !! ** Method :   Initialization of the northern neighbours lists. 
    675       !!---------------------------------------------------------------------- 
    676       !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    677       !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
    678       !!---------------------------------------------------------------------- 
    679       INTEGER  ::   sxM, dxM, sxT, dxT, jn 
    680       INTEGER  ::   njmppmax 
    681       !!---------------------------------------------------------------------- 
    682       ! 
    683       njmppmax = MAXVAL( njmppt ) 
    684       ! 
    685       !initializes the north-fold communication variables 
    686       isendto(:) = 0 
    687       nsndto     = 0 
    688       ! 
    689       IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north 
    690          ! 
    691          !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 
    692          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 
    693          !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 
    694          dxM = jpiglo - nimppt(narea) + 2 
    695          ! 
    696          ! loop over the other north-fold processes to find the processes 
    697          ! managing the points belonging to the sxT-dxT range 
    698          ! 
    699          DO jn = 1, jpni 
    700             ! 
    701             sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process 
    702             dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process 
    703             ! 
    704             IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN 
    705                nsndto          = nsndto + 1 
    706                isendto(nsndto) = jn 
    707             ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN 
    708                nsndto          = nsndto + 1 
    709                isendto(nsndto) = jn 
    710             ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN 
    711                nsndto          = nsndto + 1 
    712                isendto(nsndto) = jn 
    713             ENDIF 
    714             ! 
    715          END DO 
    716          nfsloop = 1 
    717          nfeloop = nlci 
    718          DO jn = 2,jpni-1 
    719             IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN 
    720                IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi 
    721                IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei 
    722             ENDIF 
    723          END DO 
    724          ! 
    725       ENDIF 
    726       l_north_nogather = .TRUE. 
    727       ! 
    728    END SUBROUTINE nemo_nfdcom 
    729  
    730 #else 
    731    SUBROUTINE nemo_nfdcom      ! Dummy routine 
    732       WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?' 
    733    END SUBROUTINE nemo_nfdcom 
    734 #endif 
    735  
    736485   !!====================================================================== 
    737486END MODULE nemogcm 
Note: See TracChangeset for help on using the changeset viewer.