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 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/LBC/lib_mpp.F90 – NEMO

Ignore:
Timestamp:
2021-05-05T13:18:04+02:00 (3 years ago)
Author:
mcastril
Message:

[2021/HPC-11_mcastril_HPDAonline_DiagGPU] Update externals

Location:
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
         5^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8^/vendors/PPR@HEAD            ext/PPR 
        89 
        910# SETTE 
        10 ^/utils/CI/sette@13559        sette 
         11^/utils/CI/sette@14244        sette 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/LBC/lib_mpp.F90

    r13636 r14789  
    2020   !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager 
    2121   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add mpp_lnk_bdy_3d/2d routines to optimize the BDY comm. 
    22    !!            3.5  !  2013  (C. Ethe, G. Madec)  message passing arrays as local variables  
     22   !!            3.5  !  2013  (C. Ethe, G. Madec)  message passing arrays as local variables 
    2323   !!            3.5  !  2013  (S.Mocavero, I.Epicoco - CMCC) north fold optimizations 
    2424   !!            3.6  !  2015  (O. Tintó and M. Castrillo - BSC) Added '_multiple' case for 2D lbc and max 
    … …  
    5555   USE dom_oce        ! ocean space and time domain 
    5656   USE in_out_manager ! I/O manager 
     57#if ! defined key_mpi_off 
     58   USE MPI 
     59#endif 
    5760 
    5861   IMPLICIT NONE 
    … …  
    6669   PUBLIC   mppscatter, mppgather 
    6770   PUBLIC   mpp_ini_znl 
     71   PUBLIC   mpp_ini_nc 
    6872   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines 
    6973   PUBLIC   mppsend_sp, mpprecv_sp                          ! needed by TAM and ICB routines 
    … …  
    7276   PUBLIC   mpp_bcast_nml 
    7377   PUBLIC   tic_tac 
    74 #if ! defined key_mpp_mpi 
     78#if defined key_mpp_off 
    7579   PUBLIC MPI_wait 
    7680   PUBLIC MPI_Wtime 
    7781#endif 
    78     
     82 
    7983   !! * Interfaces 
    8084   !! define generic interface for these routine as they are called sometimes 
    … …  
    106110   END INTERFACE 
    107111 
     112   TYPE, PUBLIC ::   PTR_4D_sp   !: array of 4D pointers (used in lbclnk and lbcnfd) 
     113      REAL(sp), DIMENSION (:,:,:,:), POINTER ::   pt4d 
     114   END TYPE PTR_4D_sp 
     115 
     116   TYPE, PUBLIC ::   PTR_4D_dp   !: array of 4D pointers (used in lbclnk and lbcnfd) 
     117      REAL(dp), DIMENSION (:,:,:,:), POINTER ::   pt4d 
     118   END TYPE PTR_4D_dp 
     119 
    108120   !! ========================= !! 
    109121   !!  MPI  variable definition !! 
    110122   !! ========================= !! 
    111 #if   defined key_mpp_mpi 
    112 !$AGRIF_DO_NOT_TREAT 
    113    INCLUDE 'mpif.h' 
    114 !$AGRIF_END_DO_NOT_TREAT 
     123#if ! defined key_mpi_off 
    115124   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag 
    116 #else    
     125#else 
    117126   INTEGER, PUBLIC, PARAMETER ::   MPI_STATUS_SIZE = 1 
    118127   INTEGER, PUBLIC, PARAMETER ::   MPI_REAL = 4 
    … …  
    120129   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.    !: mpp flag 
    121130#endif 
    122  
    123    INTEGER, PARAMETER         ::   nprocmax = 2**10   ! maximun dimension (required to be a power of 2) 
    124131 
    125132   INTEGER, PUBLIC ::   mppsize        ! number of process 
    … …  
    131138   INTEGER :: MPI_SUMDD 
    132139 
     140   ! Neighbourgs informations 
     141   INTEGER,    PARAMETER, PUBLIC ::   n_hlsmax = 3 
     142   INTEGER, DIMENSION(         8), PUBLIC ::   mpinei      !: 8-neighbourg MPI indexes (starting at 0, -1 if no neighbourg) 
     143   INTEGER, DIMENSION(n_hlsmax,8), PUBLIC ::   mpiSnei     !: 8-neighbourg Send MPI indexes (starting at 0, -1 if no neighbourg) 
     144   INTEGER, DIMENSION(n_hlsmax,8), PUBLIC ::   mpiRnei     !: 8-neighbourg Recv MPI indexes (starting at 0, -1 if no neighbourg) 
     145   INTEGER,    PARAMETER, PUBLIC ::   jpwe = 1   !: WEst 
     146   INTEGER,    PARAMETER, PUBLIC ::   jpea = 2   !: EAst 
     147   INTEGER,    PARAMETER, PUBLIC ::   jpso = 3   !: SOuth 
     148   INTEGER,    PARAMETER, PUBLIC ::   jpno = 4   !: NOrth 
     149   INTEGER,    PARAMETER, PUBLIC ::   jpsw = 5   !: South-West 
     150   INTEGER,    PARAMETER, PUBLIC ::   jpse = 6   !: South-East 
     151   INTEGER,    PARAMETER, PUBLIC ::   jpnw = 7   !: North-West 
     152   INTEGER,    PARAMETER, PUBLIC ::   jpne = 8   !: North-East 
     153 
     154   LOGICAL, DIMENSION(8), PUBLIC ::   l_SelfPerio  !   should we explicitely take care of I/J periodicity 
     155   LOGICAL,               PUBLIC ::   l_IdoNFold 
     156 
    133157   ! variables used for zonal integration 
    134    INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average 
    135    LOGICAL, PUBLIC ::   l_znl_root      !: True on the 'left'most processor on the same row 
    136    INTEGER         ::   ngrp_znl        ! group ID for the znl processors 
    137    INTEGER         ::   ndim_rank_znl   ! number of processors on the same zonal average 
     158   INTEGER, PUBLIC ::   ncomm_znl         !: communicator made by the processors on the same zonal average 
     159   LOGICAL, PUBLIC ::   l_znl_root        !: True on the 'left'most processor on the same row 
     160   INTEGER         ::   ngrp_znl          !: group ID for the znl processors 
     161   INTEGER         ::   ndim_rank_znl     !: number of processors on the same zonal average 
    138162   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain 
     163 
     164   ! variables used for MPI3 neighbourhood collectives 
     165   INTEGER, DIMENSION(n_hlsmax), PUBLIC ::   mpi_nc_com4       ! MPI3 neighbourhood collectives communicator 
     166   INTEGER, DIMENSION(n_hlsmax), PUBLIC ::   mpi_nc_com8       ! MPI3 neighbourhood collectives communicator (with diagionals) 
    139167 
    140168   ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM) 
    … …  
    178206   REAL(dp), DIMENSION(2), PUBLIC ::  waiting_time = 0._dp 
    179207   REAL(dp)              , PUBLIC ::  compute_time = 0._dp, elapsed_time = 0._dp 
    180     
     208 
    181209   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   tampon   ! buffer in case of bsend 
    182210 
    183211   LOGICAL, PUBLIC ::   ln_nnogather                !: namelist control of northfold comms 
    184    LOGICAL, PUBLIC ::   l_north_nogather = .FALSE.  !: internal control of northfold comms 
    185     
     212   INTEGER, PUBLIC ::   nn_comm                     !: namelist control of comms 
     213 
     214   INTEGER, PUBLIC, PARAMETER ::   jpfillnothing = 1 
     215   INTEGER, PUBLIC, PARAMETER ::   jpfillcst     = 2 
     216   INTEGER, PUBLIC, PARAMETER ::   jpfillcopy    = 3 
     217   INTEGER, PUBLIC, PARAMETER ::   jpfillperio   = 4 
     218   INTEGER, PUBLIC, PARAMETER ::   jpfillmpi     = 5 
     219 
    186220   !! * Substitutions 
    187221#  include "do_loop_substitute.h90" 
    … …  
    204238      LOGICAL ::   llmpi_init 
    205239      !!---------------------------------------------------------------------- 
    206 #if defined key_mpp_mpi 
     240#if ! defined key_mpi_off 
    207241      ! 
    208242      CALL mpi_initialized ( llmpi_init, ierr ) 
    … …  
    218252         IF( ierr /= MPI_SUCCESS ) CALL ctl_stop( 'STOP', ' lib_mpp: Error in routine mpi_init' ) 
    219253      ENDIF 
    220         
     254 
    221255      IF( PRESENT(localComm) ) THEN 
    222256         IF( Agrif_Root() ) THEN 
    … …  
    260294      INTEGER , INTENT(in   ) ::   kdest      ! receive process number 
    261295      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message 
    262       INTEGER , INTENT(in   ) ::   md_req     ! argument for isend 
     296      INTEGER , INTENT(inout) ::   md_req     ! argument for isend 
    263297      !! 
    264298      INTEGER ::   iflag 
    … …  
    266300      !!---------------------------------------------------------------------- 
    267301      ! 
    268 #if defined key_mpp_mpi 
     302#if ! defined key_mpi_off 
    269303      IF (wp == dp) THEN 
    270304         mpi_working_type = mpi_double_precision 
    … …  
    289323      INTEGER , INTENT(in   ) ::   kdest      ! receive process number 
    290324      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message 
    291       INTEGER , INTENT(in   ) ::   md_req     ! argument for isend 
     325      INTEGER , INTENT(inout) ::   md_req     ! argument for isend 
    292326      !! 
    293327      INTEGER ::   iflag 
    294328      !!---------------------------------------------------------------------- 
    295329      ! 
    296 #if defined key_mpp_mpi 
     330#if ! defined key_mpi_off 
    297331      CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce, md_req, iflag ) 
    298332#endif 
    … …  
    312346      INTEGER , INTENT(in   ) ::   kdest      ! receive process number 
    313347      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message 
    314       INTEGER , INTENT(in   ) ::   md_req     ! argument for isend 
     348      INTEGER , INTENT(inout) ::   md_req     ! argument for isend 
    315349      !! 
    316350      INTEGER ::   iflag 
    317351      !!---------------------------------------------------------------------- 
    318352      ! 
    319 #if defined key_mpp_mpi 
     353#if ! defined key_mpi_off 
    320354      CALL mpi_isend( pmess, kbytes, mpi_real, kdest , ktyp, mpi_comm_oce, md_req, iflag ) 
    321355#endif 
    … …  
    342376      !!---------------------------------------------------------------------- 
    343377      ! 
    344 #if defined key_mpp_mpi 
     378#if ! defined key_mpi_off 
    345379      ! If a specific process number has been passed to the receive call, 
    346380      ! use that one. Default is to use mpi_any_source 
    … …  
    375409      !!---------------------------------------------------------------------- 
    376410      ! 
    377 #if defined key_mpp_mpi 
     411#if ! defined key_mpi_off 
    378412      ! If a specific process number has been passed to the receive call, 
    379413      ! use that one. Default is to use mpi_any_source 
    … …  
    404438      !!---------------------------------------------------------------------- 
    405439      ! 
    406 #if defined key_mpp_mpi 
     440#if ! defined key_mpi_off 
    407441      ! If a specific process number has been passed to the receive call, 
    408442      ! use that one. Default is to use mpi_any_source 
    … …  
    432466      ! 
    433467      itaille = jpi * jpj 
    434 #if defined key_mpp_mpi 
     468#if ! defined key_mpi_off 
    435469      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille     ,   & 
    436470         &                            mpi_double_precision, kp , mpi_comm_oce, ierror ) 
    … …  
    459493      itaille = jpi * jpj 
    460494      ! 
    461 #if defined key_mpp_mpi 
     495#if ! defined key_mpi_off 
    462496      CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille     ,   & 
    463497         &                            mpi_double_precision, kp  , mpi_comm_oce, ierror ) 
    … …  
    468502   END SUBROUTINE mppscatter 
    469503 
    470     
     504 
    471505   SUBROUTINE mpp_delay_sum( cdname, cdelay, y_in, pout, ldlast, kcom ) 
    472506     !!---------------------------------------------------------------------- 
    … …  
    488522      COMPLEX(dp), ALLOCATABLE, DIMENSION(:) ::   ytmp 
    489523      !!---------------------------------------------------------------------- 
    490 #if defined key_mpp_mpi 
     524#if ! defined key_mpi_off 
    491525      ilocalcomm = mpi_comm_oce 
    492526      IF( PRESENT(kcom) )   ilocalcomm = kcom 
    493527 
    494528      isz = SIZE(y_in) 
    495        
     529 
    496530      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_dlg = .TRUE. ) 
    497531 
    … …  
    514548         END IF 
    515549      ENDIF 
    516        
     550 
    517551      IF( ndelayid(idvar) == -1 ) THEN         ! first call without restart: define %y1d and %z1d from y_in with blocking allreduce 
    518552         !                                       -------------------------- 
    … …  
    542576   END SUBROUTINE mpp_delay_sum 
    543577 
    544     
     578 
    545579   SUBROUTINE mpp_delay_max( cdname, cdelay, p_in, pout, ldlast, kcom ) 
    546580      !!---------------------------------------------------------------------- 
    … …  
    552586      CHARACTER(len=*), INTENT(in   )                 ::   cdname  ! name of the calling subroutine 
    553587      CHARACTER(len=*), INTENT(in   )                 ::   cdelay  ! name (used as id) of the delayed operation 
    554       REAL(wp),         INTENT(in   ), DIMENSION(:)   ::   p_in    !  
    555       REAL(wp),         INTENT(  out), DIMENSION(:)   ::   pout    !  
     588      REAL(wp),         INTENT(in   ), DIMENSION(:)   ::   p_in    ! 
     589      REAL(wp),         INTENT(  out), DIMENSION(:)   ::   pout    ! 
    556590      LOGICAL,          INTENT(in   )                 ::   ldlast  ! true if this is the last time we call this routine 
    557591      INTEGER,          INTENT(in   ), OPTIONAL       ::   kcom 
    … …  
    562596      INTEGER ::   MPI_TYPE 
    563597      !!---------------------------------------------------------------------- 
    564        
    565 #if defined key_mpp_mpi 
     598 
     599#if ! defined key_mpi_off 
    566600      if( wp == dp ) then 
    567601         MPI_TYPE = MPI_DOUBLE_PRECISION 
    … …  
    570604      else 
    571605        CALL ctl_stop( "Error defining type, wp is neither dp nor sp" ) 
    572     
     606 
    573607      end if 
    574608 
    … …  
    624658   END SUBROUTINE mpp_delay_max 
    625659 
    626     
     660 
    627661   SUBROUTINE mpp_delay_rcv( kid ) 
    628662      !!---------------------------------------------------------------------- 
    629663      !!                   ***  routine mpp_delay_rcv  *** 
    630664      !! 
    631       !! ** Purpose :  force barrier for delayed mpp (needed for restart)  
    632       !! 
    633       !!---------------------------------------------------------------------- 
    634       INTEGER,INTENT(in   )      ::  kid  
     665      !! ** Purpose :  force barrier for delayed mpp (needed for restart) 
     666      !! 
     667      !!---------------------------------------------------------------------- 
     668      INTEGER,INTENT(in   )      ::  kid 
    635669      INTEGER ::   ierr 
    636670      !!---------------------------------------------------------------------- 
    637 #if defined key_mpp_mpi 
     671#if ! defined key_mpi_off 
    638672      IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 
    639673      ! test on ndelayid(kid) useless as mpi_wait return immediatly if the request handle is MPI_REQUEST_NULL 
    … …  
    657691      !!---------------------------------------------------------------------- 
    658692      ! 
    659 #if defined key_mpp_mpi 
     693#if ! defined key_mpi_off 
    660694      call MPI_BCAST(kleng, 1, MPI_INT, 0, mpi_comm_oce, iflag) 
    661695      call MPI_BARRIER(mpi_comm_oce, iflag) 
    … …  
    669703   END SUBROUTINE mpp_bcast_nml 
    670704 
    671     
     705 
    672706   !!---------------------------------------------------------------------- 
    673707   !!    ***  mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real  *** 
    674    !!    
     708   !! 
    675709   !!---------------------------------------------------------------------- 
    676710   !! 
    … …  
    724758   !!---------------------------------------------------------------------- 
    725759   !!    ***  mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real  *** 
    726    !!    
     760   !! 
    727761   !!---------------------------------------------------------------------- 
    728762   !! 
    … …  
    776810   !!---------------------------------------------------------------------- 
    777811   !!    ***  mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real  *** 
    778    !!    
     812   !! 
    779813   !!   Global sum of 1D array or a variable (integer, real or complex) 
    780814   !!---------------------------------------------------------------------- 
    … …  
    850884   !!---------------------------------------------------------------------- 
    851885   !!    ***  mpp_minloc2d, mpp_minloc3d, mpp_maxloc2d, mpp_maxloc3d 
    852    !!    
     886   !! 
    853887   !!---------------------------------------------------------------------- 
    854888   !! 
    … …  
    923957      !!----------------------------------------------------------------------- 
    924958      ! 
    925 #if defined key_mpp_mpi 
     959#if ! defined key_mpi_off 
    926960      CALL mpi_barrier( mpi_comm_oce, ierror ) 
    927961#endif 
    … …  
    930964 
    931965 
    932    SUBROUTINE mppstop( ld_abort )  
     966   SUBROUTINE mppstop( ld_abort ) 
    933967      !!---------------------------------------------------------------------- 
    934968      !!                  ***  routine mppstop  *** 
    … …  
    939973      LOGICAL, OPTIONAL, INTENT(in) :: ld_abort    ! source process number 
    940974      LOGICAL ::   ll_abort 
    941       INTEGER ::   info 
     975      INTEGER ::   info, ierr 
    942976      !!---------------------------------------------------------------------- 
    943977      ll_abort = .FALSE. 
    944978      IF( PRESENT(ld_abort) ) ll_abort = ld_abort 
    945979      ! 
    946 #if defined key_mpp_mpi 
     980#if ! defined key_mpi_off 
    947981      IF(ll_abort) THEN 
    948          CALL mpi_abort( MPI_COMM_WORLD ) 
     982         CALL mpi_abort( MPI_COMM_WORLD, 123, info ) 
    949983      ELSE 
    950984         CALL mppsync 
    … …  
    959993   SUBROUTINE mpp_comm_free( kcom ) 
    960994      !!---------------------------------------------------------------------- 
    961       INTEGER, INTENT(in) ::   kcom 
     995      INTEGER, INTENT(inout) ::   kcom 
    962996      !! 
    963997      INTEGER :: ierr 
    964998      !!---------------------------------------------------------------------- 
    965999      ! 
    966 #if defined key_mpp_mpi 
     1000#if ! defined key_mpi_off 
    9671001      CALL MPI_COMM_FREE(kcom, ierr) 
    9681002#endif 
    … …  
    9961030      INTEGER, ALLOCATABLE, DIMENSION(:) ::   kwork 
    9971031      !!---------------------------------------------------------------------- 
    998 #if defined key_mpp_mpi 
    999       !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world 
    1000       !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world 
    1001       !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_oce   : ', mpi_comm_oce 
     1032#if ! defined key_mpi_off 
     1033      !-$$     WRITE (numout,*) 'mpp_ini_znl ', mpprank, ' - ngrp_world     : ', ngrp_world 
     1034      !-$$     WRITE (numout,*) 'mpp_ini_znl ', mpprank, ' - mpi_comm_world : ', mpi_comm_world 
     1035      !-$$     WRITE (numout,*) 'mpp_ini_znl ', mpprank, ' - mpi_comm_oce   : ', mpi_comm_oce 
    10021036      ! 
    10031037      ALLOCATE( kwork(jpnij), STAT=ierr ) 
    … …  
    10101044         ! 
    10111045         CALL MPI_ALLGATHER ( njmpp, 1, mpi_integer, kwork, 1, mpi_integer, mpi_comm_oce, ierr ) 
    1012          !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - kwork pour njmpp : ', kwork 
     1046         !-$$        WRITE (numout,*) 'mpp_ini_znl ', mpprank, ' - kwork pour njmpp : ', kwork 
    10131047         !-$$        CALL flush(numout) 
    10141048         ! 
    … …  
    10201054            ENDIF 
    10211055         END DO 
    1022          !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ndim_rank_znl : ', ndim_rank_znl 
     1056         !-$$        WRITE (numout,*) 'mpp_ini_znl ', mpprank, ' - ndim_rank_znl : ', ndim_rank_znl 
    10231057         !-$$        CALL flush(numout) 
    10241058         ! Allocate the right size to nrank_znl 
    … …  
    10331067            ENDIF 
    10341068         END DO 
    1035          !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - nrank_znl : ', nrank_znl 
     1069         !-$$        WRITE (numout,*) 'mpp_ini_znl ', mpprank, ' - nrank_znl : ', nrank_znl 
    10361070         !-$$        CALL flush(numout) 
    10371071 
    10381072         ! Create the opa group 
    10391073         CALL MPI_COMM_GROUP(mpi_comm_oce,ngrp_opa,ierr) 
    1040          !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_opa : ', ngrp_opa 
     1074         !-$$        WRITE (numout,*) 'mpp_ini_znl ', mpprank, ' - ngrp_opa : ', ngrp_opa 
    10411075         !-$$        CALL flush(numout) 
    10421076 
    10431077         ! Create the znl group from the opa group 
    10441078         CALL MPI_GROUP_INCL  ( ngrp_opa, ndim_rank_znl, nrank_znl, ngrp_znl, ierr ) 
    1045          !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_znl ', ngrp_znl 
     1079         !-$$        WRITE (numout,*) 'mpp_ini_znl ', mpprank, ' - ngrp_znl ', ngrp_znl 
    10461080         !-$$        CALL flush(numout) 
    10471081 
    10481082         ! Create the znl communicator from the opa communicator, ie the pool of procs in the same row 
    10491083         CALL MPI_COMM_CREATE ( mpi_comm_oce, ngrp_znl, ncomm_znl, ierr ) 
    1050          !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ncomm_znl ', ncomm_znl 
     1084         !-$$        WRITE (numout,*) 'mpp_ini_znl ', mpprank, ' - ncomm_znl ', ncomm_znl 
    10511085         !-$$        CALL flush(numout) 
    10521086         ! 
    … …  
    10681102   END SUBROUTINE mpp_ini_znl 
    10691103 
     1104    
     1105   SUBROUTINE mpp_ini_nc( khls ) 
     1106      !!---------------------------------------------------------------------- 
     1107      !!               ***  routine mpp_ini_nc  *** 
     1108      !! 
     1109      !! ** Purpose :   Initialize special communicators for MPI3 neighbourhood 
     1110      !!                collectives 
     1111      !! 
     1112      !! ** Method  : - Create graph communicators starting from the processes 
     1113      !!                distribution along i and j directions 
     1114      ! 
     1115      !! ** output 
     1116      !!         mpi_nc_com4 = MPI3 neighbourhood collectives communicator 
     1117      !!         mpi_nc_com8 = MPI3 neighbourhood collectives communicator (with diagonals) 
     1118      !!---------------------------------------------------------------------- 
     1119      INTEGER,             INTENT(in   ) ::   khls        ! halo size, default = nn_hls 
     1120      ! 
     1121      INTEGER, DIMENSION(:), ALLOCATABLE :: iSnei4, iRnei4, iSnei8, iRnei8 
     1122      INTEGER                            :: iScnt4, iRcnt4, iScnt8, iRcnt8 
     1123      INTEGER                            :: ierr 
     1124      LOGICAL, PARAMETER                 :: ireord = .FALSE. 
     1125      !!---------------------------------------------------------------------- 
     1126#if ! defined key_mpi_off && ! defined key_mpi2 
     1127       
     1128      iScnt4 = COUNT( mpiSnei(khls,1:4) >= 0 ) 
     1129      iRcnt4 = COUNT( mpiRnei(khls,1:4) >= 0 ) 
     1130      iScnt8 = COUNT( mpiSnei(khls,1:8) >= 0 ) 
     1131      iRcnt8 = COUNT( mpiRnei(khls,1:8) >= 0 ) 
     1132 
     1133      ALLOCATE( iSnei4(iScnt4), iRnei4(iRcnt4), iSnei8(iScnt8), iRnei8(iRcnt8) )   ! ok if icnt4 or icnt8 = 0 
     1134 
     1135      iSnei4 = PACK( mpiSnei(khls,1:4), mask = mpiSnei(khls,1:4) >= 0 ) 
     1136      iRnei4 = PACK( mpiRnei(khls,1:4), mask = mpiRnei(khls,1:4) >= 0 ) 
     1137      iSnei8 = PACK( mpiSnei(khls,1:8), mask = mpiSnei(khls,1:8) >= 0 ) 
     1138      iRnei8 = PACK( mpiRnei(khls,1:8), mask = mpiRnei(khls,1:8) >= 0 ) 
     1139 
     1140      CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt4, iSnei4, MPI_UNWEIGHTED, iRcnt4, iRnei4, MPI_UNWEIGHTED,   & 
     1141         &                                 MPI_INFO_NULL, ireord, mpi_nc_com4(khls), ierr ) 
     1142      CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt8, iSnei8, MPI_UNWEIGHTED, iRcnt8, iRnei8, MPI_UNWEIGHTED,   & 
     1143         &                                 MPI_INFO_NULL, ireord, mpi_nc_com8(khls), ierr) 
     1144 
     1145      DEALLOCATE( iSnei4, iRnei4, iSnei8, iRnei8 ) 
     1146#endif 
     1147   END SUBROUTINE mpp_ini_nc 
     1148 
    10701149 
    10711150   SUBROUTINE mpp_ini_north 
    … …  
    10821161      !! 
    10831162      !! ** output 
    1084       !!      njmppmax = njmpp for northern procs 
    10851163      !!      ndim_rank_north = number of processors in the northern line 
    10861164      !!      nrank_north (ndim_rank_north) = number  of the northern procs. 
    … …  
    10961174      !!---------------------------------------------------------------------- 
    10971175      ! 
    1098 #if defined key_mpp_mpi 
    1099       njmppmax = MAXVAL( njmppt ) 
     1176#if ! defined key_mpi_off 
    11001177      ! 
    11011178      ! Look for how many procs on the northern boundary 
    … …  
    11781255      INTEGER ::    ji,  jj,  jk,  jh, jf, jcount   ! dummy loop indices 
    11791256      !!---------------------------------------------------------------------- 
    1180 #if defined key_mpp_mpi 
     1257#if ! defined key_mpi_off 
    11811258      ! 
    11821259      ll_lbc = .FALSE. 
    … …  
    12481325         END DO 
    12491326         IF ( crname_lbc(n_sequence_lbc) /= 'already counted' ) THEN 
    1250             WRITE(numcom,'(A, I4, A, A)') ' - ', 1,' times by subroutine ', TRIM(crname_lbc(ncom_rec_max)) 
     1327            WRITE(numcom,'(A, I4, A, A)') ' - ', 1,' times by subroutine ', TRIM(crname_lbc(n_sequence_lbc)) 
    12511328         END IF 
    12521329         WRITE(numcom,*) ' ' 
    … …  
    12591336                  jj = 0 
    12601337               END IF 
    1261                jj = jj + 1  
     1338               jj = jj + 1 
    12621339            END DO 
    12631340            WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_glb(n_sequence_glb)) 
    … …  
    12751352                  jj = 0 
    12761353               END IF 
    1277                jj = jj + 1  
     1354               jj = jj + 1 
    12781355            END DO 
    12791356            WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_dlg(n_sequence_dlg)) 
    … …  
    12911368   END SUBROUTINE mpp_report 
    12921369 
    1293     
     1370 
    12941371   SUBROUTINE tic_tac (ld_tic, ld_global) 
    12951372 
    … …  
    12991376    REAL(dp),               SAVE :: tic_ct = 0._dp 
    13001377    INTEGER :: ii 
    1301 #if defined key_mpp_mpi 
     1378#if ! defined key_mpi_off 
    13021379 
    13031380    IF( ncom_stp <= nit000 ) RETURN 
    … …  
    13071384       IF( ld_global ) ii = 2 
    13081385    END IF 
    1309      
     1386 
    13101387    IF ( ld_tic ) THEN 
    13111388       tic_wt(ii) = MPI_Wtime()                                                    ! start count tic->tac (waiting time) 
    … …  
    13161393    ENDIF 
    13171394#endif 
    1318      
     1395 
    13191396   END SUBROUTINE tic_tac 
    13201397 
    1321 #if ! defined key_mpp_mpi 
     1398#if defined key_mpi_off 
    13221399   SUBROUTINE mpi_wait(request, status, ierror) 
    13231400      INTEGER                            , INTENT(in   ) ::   request 
    … …  
    13261403   END SUBROUTINE mpi_wait 
    13271404 
    1328     
     1405 
    13291406   FUNCTION MPI_Wtime() 
    13301407      REAL(wp) ::  MPI_Wtime 
    … …  
    13881465      ! 
    13891466      IF( cd1 == 'STOP' ) THEN 
    1390          WRITE(numout,*)   
     1467         WRITE(numout,*) 
    13911468         WRITE(numout,*)  'huge E-R-R-O-R : immediate stop' 
    1392          WRITE(numout,*)   
     1469         WRITE(numout,*) 
    13931470         CALL FLUSH(numout) 
    13941471         CALL SLEEP(60)   ! make sure that all output and abort files are written by all cores. 60s should be enough... 
    … …  
    14871564      ENDIF 
    14881565      IF( iost /= 0 .AND. TRIM(clfile) == '/dev/null' ) &   ! for windows 
    1489          &  OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost )    
     1566         &  OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost ) 
    14901567      IF( iost == 0 ) THEN 
    14911568         IF(ldwp .AND. kout > 0) THEN 
    … …  
    15291606      ! 
    15301607      WRITE (clios, '(I5.0)')   kios 
    1531       IF( kios < 0 ) THEN          
     1608      IF( kios < 0 ) THEN 
    15321609         CALL ctl_warn( 'end of record or file while reading namelist '   & 
    15331610            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) ) 
    … …  
    15751652      !csp = NEW_LINE('A') 
    15761653      ! a new line character is the best seperator but some systems (e.g.Cray) 
    1577       ! seem to terminate namelist reads from internal files early if they  
     1654      ! seem to terminate namelist reads from internal files early if they 
    15781655      ! encounter new-lines. Use a single space for safety. 
    15791656      csp = ' ' 
    … …  
    15941671         iltc = LEN_TRIM(chline) 
    15951672         IF ( iltc.GT.0 ) THEN 
    1596           inl = INDEX(chline, '!')  
     1673          inl = INDEX(chline, '!') 
    15971674          IF( inl.eq.0 ) THEN 
    15981675           itot = itot + iltc + 1                                ! +1 for the newline character 
    … …  
    16401717         !write(*,'(32A)') cdnambuff 
    16411718      ENDIF 
    1642 #if defined key_mpp_mpi 
     1719#if ! defined key_mpi_off 
    16431720      CALL mpp_bcast_nml( cdnambuff, itot ) 
    16441721#endif 
Note: See TracChangeset for help on using the changeset viewer.