Changeset 7901


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

#1880: (HPC-08) minor corrections

Location:
branches/2017/dev_r7832_HPC08_lbclnk_3rd_dim/NEMOGCM/NEMO/OPA_SRC
Files:
3 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      ! 
  • branches/2017/dev_r7832_HPC08_lbclnk_3rd_dim/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r7646 r7901  
    132132               zda_v = EXP( -2.0_wp*zkh_v ) / ( 1.0_wp + 8.0_wp*zkh_v ) 
    133133               ! 
    134                usd(ji,jj,jk) = zda_u * zk_u(ji,jj) * umask(ji,jj,jk) 
    135                vsd(ji,jj,jk) = zda_v * zk_v(ji,jj) * vmask(ji,jj,jk) 
     134               usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk) 
     135               vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk) 
    136136            END DO 
    137137         END DO 
  • branches/2017/dev_r7832_HPC08_lbclnk_3rd_dim/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

    r7897 r7901  
    1010   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting 
    1111   !!            3.7  ! 2016-09  (G. Madec)  Remove solver 
    12    !!            4.0  ! 2017-04  (G. Madec)  regroup  
     12   !!            4.0  ! 2017-04  (G. Madec)  regroup global communications 
    1313   !!---------------------------------------------------------------------- 
    1414 
     
    4444      !!              - Print it each 50 time steps 
    4545      !!              - Stop the run IF problem encountered by setting indic=-3 
    46       !!                Problems checked: U max>10 m/s and SSS min < 0 
     46      !!                Problems checked: |U| and |ssh| maximum larger than 10 m/s  
     47      !!                                  sea surface salinity (SSS) minimum < 0 
    4748      !! 
    4849      !! ** Actions :   'time.step' file containing the last ocean time-step 
     
    5455      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
    5556      INTEGER  ::   ii, ij, ik             ! local integers 
     57      REAL(wp) ::   zzt                    ! local real  
    5658      INTEGER , DIMENSION(3) ::   ilocu    !  
    5759      INTEGER , DIMENSION(2) ::   ilocs    !  
     
    6971      ENDIF 
    7072      ! 
    71       IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt    !==  current time step  ==!   ("time.step" file) 
    72       IF(lwp) REWIND( numstp ) 
     73      IF(lwp) THEN                        !==  current time step  ==!   ("time.step" file) 
     74         WRITE ( numstp, '(1x, i8)' )   kt 
     75         REWIND( numstp ) 
     76      ENDIF 
    7377      ! 
    7478      !                                            !==  test of extrema  ==! 
     
    8084      ! 
    8185      IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN 
    82          WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zmax(1), ' SSS min:', - zmax(2) 
     86         WRITE(numout,*) ' ==>> time-step= ',kt,' |U| max: ', zmax(1), ' SSS min:', - zmax(2) 
    8387      ENDIF 
    8488      ! 
     
    106110      IF( -zmax(2) < 0._wp ) THEN                     !* negative salinity 
    107111         IF( lk_mpp ) THEN 
    108             CALL mpp_minloc( tsn(:,:,1,jp_sal),tmask(:,:,1), - zmax(2), ii, ij ) 
     112            CALL mpp_minloc( tsn(:,:,1,jp_sal),tmask(:,:,1), zzt, ii, ij ) 
    109113         ELSE 
    110114            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1._wp ) 
Note: See TracChangeset for help on using the changeset viewer.