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 14644 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/LBC/lib_mpp.F90 – NEMO

Ignore:
Timestamp:
2021-03-26T15:33:49+01:00 (3 years ago)
Author:
sparonuz
Message:

Merge trunk -r14642:HEAD

Location:
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final

    • Property svn:externals

      •  

        old new  
        99 
        1010# SETTE 
        11 ^/utils/CI/sette_wave@13990         sette 
         11^/utils/CI/sette@14244        sette 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/LBC/lib_mpp.F90

    r14072 r14644  
    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 
    … …  
    7376   PUBLIC   mpp_bcast_nml 
    7477   PUBLIC   tic_tac 
    75 #if ! defined key_mpp_mpi 
     78#if defined key_mpp_off 
    7679   PUBLIC MPI_wait 
    7780   PUBLIC MPI_Wtime 
    … …  
    107110   END INTERFACE 
    108111 
     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 
    109120   !! ========================= !! 
    110121   !!  MPI  variable definition !! 
    111122   !! ========================= !! 
    112 #if   defined key_mpp_mpi 
    113 !$AGRIF_DO_NOT_TREAT 
    114    INCLUDE 'mpif.h' 
    115 !$AGRIF_END_DO_NOT_TREAT 
     123#if ! defined key_mpi_off 
    116124   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag 
    117125#else 
    … …  
    122130#endif 
    123131 
    124    INTEGER, PARAMETER         ::   nprocmax = 2**10   ! maximun dimension (required to be a power of 2) 
    125  
    126132   INTEGER, PUBLIC ::   mppsize        ! number of process 
    127133   INTEGER, PUBLIC ::   mpprank        ! process number  [ 0 - size-1 ] 
    … …  
    132138   INTEGER :: MPI_SUMDD 
    133139 
     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 
    134157   ! variables used for zonal integration 
    135    INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average 
    136    LOGICAL, PUBLIC ::   l_znl_root      !: True on the 'left'most processor on the same row 
    137    INTEGER         ::   ngrp_znl        ! group ID for the znl processors 
    138    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 
    139162   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain 
    140163 
    141164   ! variables used for MPI3 neighbourhood collectives 
    142    INTEGER, PUBLIC :: mpi_nc_com                   ! MPI3 neighbourhood collectives communicator 
    143    INTEGER, PUBLIC :: mpi_nc_all_com               ! MPI3 neighbourhood collectives communicator (with diagionals) 
     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) 
    144167 
    145168   ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM) 
    … …  
    187210 
    188211   LOGICAL, PUBLIC ::   ln_nnogather                !: namelist control of northfold comms 
    189    LOGICAL, PUBLIC ::   l_north_nogather = .FALSE.  !: internal control of northfold comms 
     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 
    190219 
    191220   !! * Substitutions 
    … …  
    209238      LOGICAL ::   llmpi_init 
    210239      !!---------------------------------------------------------------------- 
    211 #if defined key_mpp_mpi 
     240#if ! defined key_mpi_off 
    212241      ! 
    213242      CALL mpi_initialized ( llmpi_init, ierr ) 
    … …  
    265294      INTEGER , INTENT(in   ) ::   kdest      ! receive process number 
    266295      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message 
    267       INTEGER , INTENT(in   ) ::   md_req     ! argument for isend 
     296      INTEGER , INTENT(inout) ::   md_req     ! argument for isend 
    268297      !! 
    269298      INTEGER ::   iflag 
    … …  
    271300      !!---------------------------------------------------------------------- 
    272301      ! 
    273 #if defined key_mpp_mpi 
     302#if ! defined key_mpi_off 
    274303      IF (wp == dp) THEN 
    275304         mpi_working_type = mpi_double_precision 
    … …  
    294323      INTEGER , INTENT(in   ) ::   kdest      ! receive process number 
    295324      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message 
    296       INTEGER , INTENT(in   ) ::   md_req     ! argument for isend 
     325      INTEGER , INTENT(inout) ::   md_req     ! argument for isend 
    297326      !! 
    298327      INTEGER ::   iflag 
    299328      !!---------------------------------------------------------------------- 
    300329      ! 
    301 #if defined key_mpp_mpi 
     330#if ! defined key_mpi_off 
    302331      CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce, md_req, iflag ) 
    303332#endif 
    … …  
    317346      INTEGER , INTENT(in   ) ::   kdest      ! receive process number 
    318347      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message 
    319       INTEGER , INTENT(in   ) ::   md_req     ! argument for isend 
     348      INTEGER , INTENT(inout) ::   md_req     ! argument for isend 
    320349      !! 
    321350      INTEGER ::   iflag 
    322351      !!---------------------------------------------------------------------- 
    323352      ! 
    324 #if defined key_mpp_mpi 
     353#if ! defined key_mpi_off 
    325354      CALL mpi_isend( pmess, kbytes, mpi_real, kdest , ktyp, mpi_comm_oce, md_req, iflag ) 
    326355#endif 
    … …  
    347376      !!---------------------------------------------------------------------- 
    348377      ! 
    349 #if defined key_mpp_mpi 
     378#if ! defined key_mpi_off 
    350379      ! If a specific process number has been passed to the receive call, 
    351380      ! use that one. Default is to use mpi_any_source 
    … …  
    380409      !!---------------------------------------------------------------------- 
    381410      ! 
    382 #if defined key_mpp_mpi 
     411#if ! defined key_mpi_off 
    383412      ! If a specific process number has been passed to the receive call, 
    384413      ! use that one. Default is to use mpi_any_source 
    … …  
    409438      !!---------------------------------------------------------------------- 
    410439      ! 
    411 #if defined key_mpp_mpi 
     440#if ! defined key_mpi_off 
    412441      ! If a specific process number has been passed to the receive call, 
    413442      ! use that one. Default is to use mpi_any_source 
    … …  
    437466      ! 
    438467      itaille = jpi * jpj 
    439 #if defined key_mpp_mpi 
     468#if ! defined key_mpi_off 
    440469      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille     ,   & 
    441470         &                            mpi_double_precision, kp , mpi_comm_oce, ierror ) 
    … …  
    464493      itaille = jpi * jpj 
    465494      ! 
    466 #if defined key_mpp_mpi 
     495#if ! defined key_mpi_off 
    467496      CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille     ,   & 
    468497         &                            mpi_double_precision, kp  , mpi_comm_oce, ierror ) 
    … …  
    493522      COMPLEX(dp), ALLOCATABLE, DIMENSION(:) ::   ytmp 
    494523      !!---------------------------------------------------------------------- 
    495 #if defined key_mpp_mpi 
     524#if ! defined key_mpi_off 
    496525      ilocalcomm = mpi_comm_oce 
    497526      IF( PRESENT(kcom) )   ilocalcomm = kcom 
    … …  
    568597      !!---------------------------------------------------------------------- 
    569598 
    570 #if defined key_mpp_mpi 
     599#if ! defined key_mpi_off 
    571600      if( wp == dp ) then 
    572601         MPI_TYPE = MPI_DOUBLE_PRECISION 
    … …  
    640669      INTEGER ::   ierr 
    641670      !!---------------------------------------------------------------------- 
    642 #if defined key_mpp_mpi 
     671#if ! defined key_mpi_off 
    643672      IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 
    644673      ! test on ndelayid(kid) useless as mpi_wait return immediatly if the request handle is MPI_REQUEST_NULL 
    … …  
    662691      !!---------------------------------------------------------------------- 
    663692      ! 
    664 #if defined key_mpp_mpi 
     693#if ! defined key_mpi_off 
    665694      call MPI_BCAST(kleng, 1, MPI_INT, 0, mpi_comm_oce, iflag) 
    666695      call MPI_BARRIER(mpi_comm_oce, iflag) 
    … …  
    928957      !!----------------------------------------------------------------------- 
    929958      ! 
    930 #if defined key_mpp_mpi 
     959#if ! defined key_mpi_off 
    931960      CALL mpi_barrier( mpi_comm_oce, ierror ) 
    932961#endif 
    … …  
    944973      LOGICAL, OPTIONAL, INTENT(in) :: ld_abort    ! source process number 
    945974      LOGICAL ::   ll_abort 
    946       INTEGER ::   info 
     975      INTEGER ::   info, ierr 
    947976      !!---------------------------------------------------------------------- 
    948977      ll_abort = .FALSE. 
    949978      IF( PRESENT(ld_abort) ) ll_abort = ld_abort 
    950979      ! 
    951 #if defined key_mpp_mpi 
     980#if ! defined key_mpi_off 
    952981      IF(ll_abort) THEN 
    953          CALL mpi_abort( MPI_COMM_WORLD ) 
     982         CALL mpi_abort( MPI_COMM_WORLD, 123, info ) 
    954983      ELSE 
    955984         CALL mppsync 
    … …  
    964993   SUBROUTINE mpp_comm_free( kcom ) 
    965994      !!---------------------------------------------------------------------- 
    966       INTEGER, INTENT(in) ::   kcom 
     995      INTEGER, INTENT(inout) ::   kcom 
    967996      !! 
    968997      INTEGER :: ierr 
    969998      !!---------------------------------------------------------------------- 
    970999      ! 
    971 #if defined key_mpp_mpi 
     1000#if ! defined key_mpi_off 
    9721001      CALL MPI_COMM_FREE(kcom, ierr) 
    9731002#endif 
    … …  
    10011030      INTEGER, ALLOCATABLE, DIMENSION(:) ::   kwork 
    10021031      !!---------------------------------------------------------------------- 
    1003 #if defined key_mpp_mpi 
    1004       !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world 
    1005       !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world 
    1006       !-$$     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 
    10071036      ! 
    10081037      ALLOCATE( kwork(jpnij), STAT=ierr ) 
    … …  
    10151044         ! 
    10161045         CALL MPI_ALLGATHER ( njmpp, 1, mpi_integer, kwork, 1, mpi_integer, mpi_comm_oce, ierr ) 
    1017          !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - kwork pour njmpp : ', kwork 
     1046         !-$$        WRITE (numout,*) 'mpp_ini_znl ', mpprank, ' - kwork pour njmpp : ', kwork 
    10181047         !-$$        CALL flush(numout) 
    10191048         ! 
    … …  
    10251054            ENDIF 
    10261055         END DO 
    1027          !-$$        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 
    10281057         !-$$        CALL flush(numout) 
    10291058         ! Allocate the right size to nrank_znl 
    … …  
    10381067            ENDIF 
    10391068         END DO 
    1040          !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - nrank_znl : ', nrank_znl 
     1069         !-$$        WRITE (numout,*) 'mpp_ini_znl ', mpprank, ' - nrank_znl : ', nrank_znl 
    10411070         !-$$        CALL flush(numout) 
    10421071 
    10431072         ! Create the opa group 
    10441073         CALL MPI_COMM_GROUP(mpi_comm_oce,ngrp_opa,ierr) 
    1045          !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_opa : ', ngrp_opa 
     1074         !-$$        WRITE (numout,*) 'mpp_ini_znl ', mpprank, ' - ngrp_opa : ', ngrp_opa 
    10461075         !-$$        CALL flush(numout) 
    10471076 
    10481077         ! Create the znl group from the opa group 
    10491078         CALL MPI_GROUP_INCL  ( ngrp_opa, ndim_rank_znl, nrank_znl, ngrp_znl, ierr ) 
    1050          !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_znl ', ngrp_znl 
     1079         !-$$        WRITE (numout,*) 'mpp_ini_znl ', mpprank, ' - ngrp_znl ', ngrp_znl 
    10511080         !-$$        CALL flush(numout) 
    10521081 
    10531082         ! Create the znl communicator from the opa communicator, ie the pool of procs in the same row 
    10541083         CALL MPI_COMM_CREATE ( mpi_comm_oce, ngrp_znl, ncomm_znl, ierr ) 
    1055          !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ncomm_znl ', ncomm_znl 
     1084         !-$$        WRITE (numout,*) 'mpp_ini_znl ', mpprank, ' - ncomm_znl ', ncomm_znl 
    10561085         !-$$        CALL flush(numout) 
    10571086         ! 
    … …  
    10731102   END SUBROUTINE mpp_ini_znl 
    10741103 
    1075    SUBROUTINE mpp_ini_nc 
     1104    
     1105   SUBROUTINE mpp_ini_nc( khls ) 
    10761106      !!---------------------------------------------------------------------- 
    10771107      !!               ***  routine mpp_ini_nc  *** 
    … …  
    10841114      ! 
    10851115      !! ** output 
    1086       !!         mpi_nc_com = MPI3 neighbourhood collectives communicator 
    1087       !!         mpi_nc_all_com = MPI3 neighbourhood collectives communicator 
    1088       !!                          (with diagonals) 
    1089       !! 
    1090       !!---------------------------------------------------------------------- 
    1091       INTEGER, DIMENSION(:), ALLOCATABLE :: ineigh, ineighalls, ineighallr 
    1092       INTEGER :: ideg, idegalls, idegallr, icont, icont1 
    1093       INTEGER :: ierr 
    1094       LOGICAL, PARAMETER :: ireord = .FALSE. 
    1095  
    1096 #if defined key_mpp_mpi 
    1097  
    1098       ideg = 0 
    1099       idegalls = 0 
    1100       idegallr = 0 
    1101       icont = 0 
    1102       icont1 = 0 
    1103  
    1104       IF (nbondi .eq. 1) THEN 
    1105          ideg = ideg + 1 
    1106       ELSEIF (nbondi .eq. -1) THEN 
    1107          ideg = ideg + 1 
    1108       ELSEIF (nbondi .eq. 0) THEN 
    1109          ideg = ideg + 2 
    1110       ENDIF 
    1111  
    1112       IF (nbondj .eq. 1) THEN 
    1113          ideg = ideg + 1 
    1114       ELSEIF (nbondj .eq. -1) THEN 
    1115          ideg = ideg + 1 
    1116       ELSEIF (nbondj .eq. 0) THEN 
    1117          ideg = ideg + 2 
    1118       ENDIF 
    1119  
    1120       idegalls = ideg 
    1121       idegallr = ideg 
    1122  
    1123       IF (nones .ne. -1) idegalls = idegalls + 1 
    1124       IF (nonws .ne. -1) idegalls = idegalls + 1 
    1125       IF (noses .ne. -1) idegalls = idegalls + 1 
    1126       IF (nosws .ne. -1) idegalls = idegalls + 1 
    1127       IF (noner .ne. -1) idegallr = idegallr + 1 
    1128       IF (nonwr .ne. -1) idegallr = idegallr + 1 
    1129       IF (noser .ne. -1) idegallr = idegallr + 1 
    1130       IF (noswr .ne. -1) idegallr = idegallr + 1 
    1131  
    1132       ALLOCATE(ineigh(ideg)) 
    1133       ALLOCATE(ineighalls(idegalls)) 
    1134       ALLOCATE(ineighallr(idegallr)) 
    1135  
    1136       IF (nbondi .eq. 1) THEN 
    1137          icont = icont + 1 
    1138          ineigh(icont) = nowe 
    1139          ineighalls(icont) = nowe 
    1140          ineighallr(icont) = nowe 
    1141       ELSEIF (nbondi .eq. -1) THEN 
    1142          icont = icont + 1 
    1143          ineigh(icont) = noea 
    1144          ineighalls(icont) = noea 
    1145          ineighallr(icont) = noea 
    1146       ELSEIF (nbondi .eq. 0) THEN 
    1147          icont = icont + 1 
    1148          ineigh(icont) = nowe 
    1149          ineighalls(icont) = nowe 
    1150          ineighallr(icont) = nowe 
    1151          icont = icont + 1 
    1152          ineigh(icont) = noea 
    1153          ineighalls(icont) = noea 
    1154          ineighallr(icont) = noea 
    1155       ENDIF 
    1156  
    1157       IF (nbondj .eq. 1) THEN 
    1158          icont = icont + 1 
    1159          ineigh(icont) = noso 
    1160          ineighalls(icont) = noso 
    1161          ineighallr(icont) = noso 
    1162       ELSEIF (nbondj .eq. -1) THEN 
    1163          icont = icont + 1 
    1164          ineigh(icont) = nono 
    1165          ineighalls(icont) = nono 
    1166          ineighallr(icont) = nono 
    1167       ELSEIF (nbondj .eq. 0) THEN 
    1168          icont = icont + 1 
    1169          ineigh(icont) = noso 
    1170          ineighalls(icont) = noso 
    1171          ineighallr(icont) = noso 
    1172          icont = icont + 1 
    1173          ineigh(icont) = nono 
    1174          ineighalls(icont) = nono 
    1175          ineighallr(icont) = nono 
    1176       ENDIF 
    1177  
    1178       icont1 = icont 
    1179       IF (nosws .ne. -1) THEN 
    1180          icont = icont + 1 
    1181          ineighalls(icont) = nosws 
    1182       ENDIF 
    1183       IF (noses .ne. -1) THEN 
    1184          icont = icont + 1 
    1185          ineighalls(icont) = noses 
    1186       ENDIF 
    1187       IF (nonws .ne. -1) THEN 
    1188          icont = icont + 1 
    1189          ineighalls(icont) = nonws 
    1190       ENDIF 
    1191       IF (nones .ne. -1) THEN 
    1192          icont = icont + 1 
    1193          ineighalls(icont) = nones 
    1194       ENDIF 
    1195       IF (noswr .ne. -1) THEN 
    1196          icont1 = icont1 + 1 
    1197          ineighallr(icont1) = noswr 
    1198       ENDIF 
    1199       IF (noser .ne. -1) THEN 
    1200          icont1 = icont1 + 1 
    1201          ineighallr(icont1) = noser 
    1202       ENDIF 
    1203       IF (nonwr .ne. -1) THEN 
    1204          icont1 = icont1 + 1 
    1205          ineighallr(icont1) = nonwr 
    1206       ENDIF 
    1207       IF (noner .ne. -1) THEN 
    1208          icont1 = icont1 + 1 
    1209          ineighallr(icont1) = noner 
    1210       ENDIF 
    1211  
    1212       CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, ideg, ineigh, MPI_UNWEIGHTED, ideg, ineigh, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_com, ierr) 
    1213       CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, idegallr, ineighallr, MPI_UNWEIGHTED, idegalls, ineighalls, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_all_com, ierr) 
    1214  
    1215       DEALLOCATE (ineigh) 
    1216       DEALLOCATE (ineighalls) 
    1217       DEALLOCATE (ineighallr) 
     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 ) 
    12181146#endif 
    12191147   END SUBROUTINE mpp_ini_nc 
    1220  
    12211148 
    12221149 
    … …  
    12341161      !! 
    12351162      !! ** output 
    1236       !!      njmppmax = njmpp for northern procs 
    12371163      !!      ndim_rank_north = number of processors in the northern line 
    12381164      !!      nrank_north (ndim_rank_north) = number  of the northern procs. 
    … …  
    12481174      !!---------------------------------------------------------------------- 
    12491175      ! 
    1250 #if defined key_mpp_mpi 
    1251       njmppmax = MAXVAL( njmppt ) 
     1176#if ! defined key_mpi_off 
    12521177      ! 
    12531178      ! Look for how many procs on the northern boundary 
    … …  
    13301255      INTEGER ::    ji,  jj,  jk,  jh, jf, jcount   ! dummy loop indices 
    13311256      !!---------------------------------------------------------------------- 
    1332 #if defined key_mpp_mpi 
     1257#if ! defined key_mpi_off 
    13331258      ! 
    13341259      ll_lbc = .FALSE. 
    … …  
    14001325         END DO 
    14011326         IF ( crname_lbc(n_sequence_lbc) /= 'already counted' ) THEN 
    1402             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)) 
    14031328         END IF 
    14041329         WRITE(numcom,*) ' ' 
    … …  
    14511376    REAL(dp),               SAVE :: tic_ct = 0._dp 
    14521377    INTEGER :: ii 
    1453 #if defined key_mpp_mpi 
     1378#if ! defined key_mpi_off 
    14541379 
    14551380    IF( ncom_stp <= nit000 ) RETURN 
    … …  
    14711396   END SUBROUTINE tic_tac 
    14721397 
    1473 #if ! defined key_mpp_mpi 
     1398#if defined key_mpi_off 
    14741399   SUBROUTINE mpi_wait(request, status, ierror) 
    14751400      INTEGER                            , INTENT(in   ) ::   request 
    … …  
    17921717         !write(*,'(32A)') cdnambuff 
    17931718      ENDIF 
    1794 #if defined key_mpp_mpi 
     1719#if ! defined key_mpi_off 
    17951720      CALL mpp_bcast_nml( cdnambuff, itot ) 
    17961721#endif 
Note: See TracChangeset for help on using the changeset viewer.