Ignore:
Timestamp:
2017-04-13T05:46:23+02:00 (3 years ago)
Author:
gm
Message:

#1880: (HPC-08) minor corrections

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r7832_HPC08_lbclnk_3rd_dim/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r7897 r7901  
    147147   ! variables used for zonal integration 
    148148   INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average 
    149    LOGICAL, PUBLIC ::   l_znl_root      !  True on the 'left'most processor on the same row 
     149   LOGICAL, PUBLIC ::   l_znl_root      !: True on the 'left'most processor on the same row 
    150150   INTEGER         ::   ngrp_znl        !  group ID for the znl processors 
    151151   INTEGER         ::   ndim_rank_znl   !  number of processors on the same zonal average 
     
    163163 
    164164   ! Type of send : standard, buffered, immediate 
    165    CHARACTER(len=1), PUBLIC ::   cn_mpi_send         !: type od mpi send/recieve (S=standard, B=bsend, I=isend) 
    166    LOGICAL         , PUBLIC ::   l_isend = .FALSE.   !: isend use indicator (T if cn_mpi_send='I') 
    167    INTEGER         , PUBLIC ::   nn_buffer           !: size of the buffer in case of mpi_bsend 
     165   CHARACTER(len=1), PUBLIC ::   cn_mpi_send        !: type od mpi send/recieve (S=standard, B=bsend, I=isend) 
     166   LOGICAL         , PUBLIC ::   l_isend = .FALSE.  !: isend use indicator (T if cn_mpi_send='I') 
     167   INTEGER         , PUBLIC ::   nn_buffer          !: size of the buffer in case of mpi_bsend 
    168168 
    169169   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   tampon   ! buffer in case of bsend 
     
    266266         END SELECT 
    267267         ! 
    268       ELSE IF ( PRESENT(localComm) .AND. .NOT. mpi_was_called ) THEN 
     268      ELSEIF ( PRESENT(localComm) .AND. .NOT. mpi_was_called ) THEN 
    269269         WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '          ;   ii = ii + 1 
    270270         WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                ;   ii = ii + 1 
     
    336336      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    337337      !!              between processors following neighboring subdomains. 
    338       !!            domain parameters 
     338      !!                domain parameters 
    339339      !!                    nlci   : first dimension of the local subdomain 
    340340      !!                    nlcj   : second dimension of the local subdomain 
     
    446446         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
    447447         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 
    448          IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     448         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err ) 
    449449      END SELECT 
    450450      ! 
     
    487487         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 
    488488         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 
    489          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     489         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err ) 
    490490      CASE ( 0 ) 
    491491         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
     
    493493         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 
    494494         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
    495          IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    496          IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err) 
     495         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err ) 
     496         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err ) 
    497497      CASE ( 1 ) 
    498498         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
     
    759759      !!--------------------------------------------------------------------- 
    760760      REAL(wp)        , DIMENSION(:,:), TARGET, INTENT(inout) ::   pt2d         ! 2D array on which the boundary condition is applied 
    761       CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type      ! nature of ptab array grid-points 
     761      CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type      ! nature of pt2d array grid-points 
    762762      REAL(wp)                                , INTENT(in   ) ::   psgn         ! sign used across the north fold boundary 
    763763      TYPE(arrayptr)  , DIMENSION(:)          , INTENT(inout) ::   pt2d_array   !  
     
    793793      INTEGER :: kfld 
    794794      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array  
    795       CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points 
     795      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of pt2d array grid-points 
    796796      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! sign used across the north fold boundary 
    797797      !!--------------------------------------------------------------------- 
     
    837837      !!---------------------------------------------------------------------- 
    838838      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied 
    839       CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points 
     839      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! nature of pt2d array grid-points 
    840840      REAL(wp)                    , INTENT(in   ) ::   psgn     ! sign used across the north fold boundary 
    841841      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
     
    19891989      !! 
    19901990      !!---------------------------------------------------------------------- 
    1991       INTEGER , INTENT(in   )                  ::   kdim 
    1992       REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab 
    1993       INTEGER , INTENT(in   ), OPTIONAL        ::   kcom 
     1991      REAL(wp), DIMENSION(kdim), INTENT(inout) ::   ptab 
     1992      INTEGER                  , INTENT(in   ) ::   kdim 
     1993      INTEGER , OPTIONAL       , INTENT(in   ) ::   kcom 
    19941994      ! 
    19951995      INTEGER :: ierror, localcomm 
     
    20412041      !! 
    20422042      INTEGER  ::   ierror, localcomm 
     2043      REAL(wp), DIMENSION(kdim) ::  zwork 
    20432044      !!---------------------------------------------------------------------- 
    20442045      ! 
     
    20462047      IF( PRESENT(kcom) )   localcomm = kcom 
    20472048      ! 
    2048       CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_max, localcomm, ierror ) 
    2049       ptab(:) = zwork(:) 
     2049      CALL mpi_allreduce( pt1d, zwork, kdim, mpi_double_precision, mpi_max, localcomm, ierror ) 
     2050      pt1d(:) = zwork(:) 
    20502051      ! 
    20512052   END SUBROUTINE mppmax_real_multiple 
     
    22122213      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask   ! Local mask 
    22132214      REAL(wp)                     , INTENT(  out) ::   pmin    ! Global minimum of ptab 
    2214       INTEGER                      , INTENT(  out) ::   ki, kj   ! index of minimum in global frame 
     2215      INTEGER                      , INTENT(  out) ::   ki, kj  ! index of minimum in global frame 
    22152216      ! 
    22162217      INTEGER :: ierror 
     
    27162717 
    27172718         DO jr = 1,nsndto 
    2718             IF ((nfipproc(isendto(jr),jpnj) /= (narea-1)) .and. (nfipproc(isendto(jr),jpnj) /= -1)) THEN 
     2719            IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN 
    27192720              CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 
    27202721            ENDIF 
     
    27272728               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
    27282729            ENDIF 
    2729             IF((iproc /= (narea-1)) .and. (iproc /= -1)) THEN 
     2730            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN 
    27302731              CALL mpprecv(5, zfoldwk, itaille, iproc) 
    27312732              DO jk = 1, ipk 
     
    27482749         IF (l_isend) THEN 
    27492750            DO jr = 1,nsndto 
    2750                IF ((nfipproc(isendto(jr),jpnj) /= (narea-1)) .and. (nfipproc(isendto(jr),jpnj) /= -1)) THEN 
    2751                   CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2751               IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN 
     2752                  CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err ) 
    27522753               ENDIF     
    27532754            END DO 
     
    28702871 
    28712872         DO jr = 1,nsndto 
    2872             IF ((nfipproc(isendto(jr),jpnj) /= (narea-1)) .and. (nfipproc(isendto(jr),jpnj) /= -1)) THEN 
    2873                CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) 
     2873            IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN 
     2874               CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 
    28742875            ENDIF 
    28752876         END DO 
    28762877         DO jr = 1,nsndto 
    28772878            iproc = nfipproc(isendto(jr),jpnj) 
    2878             IF(iproc /= -1) THEN 
     2879            IF( iproc /= -1 ) THEN 
    28792880               ilei = nleit (iproc+1) 
    28802881               ildi = nldit (iproc+1) 
     
    28882889                 END DO 
    28892890              END DO 
    2890             ELSE IF( iproc == narea-1 ) THEN 
     2891            ELSEIF( iproc == narea-1 ) THEN 
    28912892              DO jj = 1, ijpj 
    28922893                 DO ji = ildi, ilei 
     
    28962897            ENDIF 
    28972898         END DO 
    2898          IF (l_isend) THEN 
     2899         IF(l_isend) THEN 
    28992900            DO jr = 1,nsndto 
    2900                IF ((nfipproc(isendto(jr),jpnj) /= (narea-1)) .and. (nfipproc(isendto(jr),jpnj) /= -1)) THEN 
     2901               IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN 
    29012902                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
    29022903               ENDIF 
     
    30193020         DO jr = 1, nsndto 
    30203021            iproc = nfipproc(isendto(jr),jpnj) 
    3021             IF(iproc /= -1) THEN 
     3022            IF( iproc /= -1 ) THEN 
    30223023               ilei = nleit (iproc+1) 
    30233024               ildi = nldit (iproc+1) 
     
    35623563      SELECT CASE ( nbondj_bdy(ib_bdy) ) 
    35633564      CASE ( -1 ) 
    3564          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    3565       CASE ( 0 ) 
    3566          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    3567          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    3568       CASE ( 1 ) 
    3569          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     3565         IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
     3566      CASE ( 0 ) 
     3567         IF(l_isend) CALL mpi_wait (ml_req1, ml_stat, ml_err ) 
     3568         IF(l_isend) CALL mpi_wait( ml_req2, ml_stat, ml_err ) 
     3569      CASE ( 1 ) 
     3570         IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    35703571      END SELECT 
    35713572      ! 
Note: See TracChangeset for help on using the changeset viewer.