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 13458 for NEMO/trunk/src/OCE – NEMO

Changeset 13458 for NEMO/trunk/src/OCE


Ignore:
Timestamp:
2020-09-11T11:22:24+02:00 (4 years ago)
Author:
smasson
Message:

trunk: mpp_min(max)loc testing only inner domain, see #2521

Location:
NEMO/trunk/src/OCE
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/DIA/diacfl.F90

    r13295 r13458  
    5656      INTEGER , DIMENSION(3)           ::   iloc_u , iloc_v , iloc_w , iloc  ! workspace 
    5757      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zCu_cfl, zCv_cfl, zCw_cfl        ! workspace 
     58      LOGICAL , DIMENSION(jpi,jpj,jpk) ::   llmsk 
    5859      !!---------------------------------------------------------------------- 
    5960      ! 
    6061      IF( ln_timing )   CALL timing_start('dia_cfl') 
    6162      ! 
    62       DO_3D( 1, 1, 1, 1, 1, jpk ) 
     63      llmsk(   1:Nis1,:,:) = .FALSE.                                              ! exclude halos from the checked region 
     64      llmsk(Nie1: jpi,:,:) = .FALSE. 
     65      llmsk(:,   1:Njs1,:) = .FALSE. 
     66      llmsk(:,Nje1: jpj,:) = .FALSE. 
     67      ! 
     68      DO_3D( 0, 0, 0, 0, 1, jpk ) 
    6369         zCu_cfl(ji,jj,jk) = ABS( uu(ji,jj,jk,Kmm) ) * rDt / e1u  (ji,jj)      ! for i-direction 
    6470         zCv_cfl(ji,jj,jk) = ABS( vv(ji,jj,jk,Kmm) ) * rDt / e2v  (ji,jj)      ! for j-direction 
    65          zCw_cfl(ji,jj,jk) = ABS( ww(ji,jj,jk) ) * rDt / e3w(ji,jj,jk,Kmm)   ! for k-direction 
     71         zCw_cfl(ji,jj,jk) = ABS( ww(ji,jj,jk) ) * rDt / e3w(ji,jj,jk,Kmm)     ! for k-direction 
    6672      END_3D 
    6773      ! 
    6874      ! write outputs 
    69       IF( iom_use('cfl_cu') )   CALL iom_put( 'cfl_cu', MAXVAL( zCu_cfl, dim=3 ) ) 
    70       IF( iom_use('cfl_cv') )   CALL iom_put( 'cfl_cv', MAXVAL( zCv_cfl, dim=3 ) ) 
    71       IF( iom_use('cfl_cw') )   CALL iom_put( 'cfl_cw', MAXVAL( zCw_cfl, dim=3 ) ) 
     75      IF( iom_use('cfl_cu') ) THEN 
     76         llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     77         CALL iom_put( 'cfl_cu', MAXVAL( zCu_cfl, mask = llmsk, dim=3 ) ) 
     78      ENDIF 
     79      IF( iom_use('cfl_cv') ) THEN 
     80         llmsk(Nis0:Nie0,Njs0:Nje0,:) = vmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     81         CALL iom_put( 'cfl_cv', MAXVAL( zCv_cfl, mask = llmsk, dim=3 ) ) 
     82      ENDIF 
     83      IF( iom_use('cfl_cw') ) THEN 
     84         llmsk(Nis0:Nie0,Njs0:Nje0,:) = wmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     85         CALL iom_put( 'cfl_cw', MAXVAL( zCw_cfl, mask = llmsk, dim=3 ) ) 
     86      ENDIF 
    7287 
    7388      !                    ! calculate maximum values and locations 
    74       IF( lk_mpp ) THEN 
    75          CALL mpp_maxloc( 'diacfl', zCu_cfl, umask, zCu_max, iloc_u ) 
    76          CALL mpp_maxloc( 'diacfl', zCv_cfl, vmask, zCv_max, iloc_v ) 
    77          CALL mpp_maxloc( 'diacfl', zCw_cfl, wmask, zCw_max, iloc_w ) 
    78       ELSE 
    79          iloc = MAXLOC( ABS( zcu_cfl(:,:,:) ) ) 
    80          iloc_u(1) = iloc(1) + nimpp - 1 
    81          iloc_u(2) = iloc(2) + njmpp - 1 
    82          iloc_u(3) = iloc(3) 
    83          zCu_max = zCu_cfl(iloc(1),iloc(2),iloc(3)) 
    84          ! 
    85          iloc = MAXLOC( ABS( zcv_cfl(:,:,:) ) ) 
    86          iloc_v(1) = iloc(1) + nimpp - 1 
    87          iloc_v(2) = iloc(2) + njmpp - 1 
    88          iloc_v(3) = iloc(3) 
    89          zCv_max = zCv_cfl(iloc(1),iloc(2),iloc(3)) 
    90          ! 
    91          iloc = MAXLOC( ABS( zcw_cfl(:,:,:) ) ) 
    92          iloc_w(1) = iloc(1) + nimpp - 1 
    93          iloc_w(2) = iloc(2) + njmpp - 1 
    94          iloc_w(3) = iloc(3) 
    95          zCw_max = zCw_cfl(iloc(1),iloc(2),iloc(3)) 
    96       ENDIF 
     89      llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     90      CALL mpp_maxloc( 'diacfl', zCu_cfl, llmsk, zCu_max, iloc_u ) 
     91      llmsk(Nis0:Nie0,Njs0:Nje0,:) = vmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     92      CALL mpp_maxloc( 'diacfl', zCv_cfl, llmsk, zCv_max, iloc_v ) 
     93      llmsk(Nis0:Nie0,Njs0:Nje0,:) = wmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     94      CALL mpp_maxloc( 'diacfl', zCw_cfl, llmsk, zCw_max, iloc_w ) 
    9795      ! 
    98       !                    ! write out to file 
    99       IF( lwp ) THEN 
     96      IF( lwp ) THEN       ! write out to file 
    10097         WRITE(numcfl,FMT='(2x,i6,3x,a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zCu_max, iloc_u(1), iloc_u(2), iloc_u(3) 
    10198         WRITE(numcfl,FMT='(11x,     a6,4x,f7.4,1x,i4,1x,i4,1x,i4)')     'Max Cv', zCv_max, iloc_v(1), iloc_v(2), iloc_v(3) 
  • NEMO/trunk/src/OCE/DOM/domain.F90

    r13435 r13458  
    177177      ! 
    178178      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all 
    179       ! 
     179         ! 
    180180         DO jt = 1, jpt                         ! depth of t- and w-grid-points 
    181181            gdept(:,:,:,jt) = gdept_0(:,:,:) 
     
    204204      ELSE                       != time varying : initialize before/now/after variables 
    205205         ! 
    206          IF( .NOT.l_offline )  CALL dom_vvl_init( Kbb, Kmm, Kaa ) 
     206         IF( .NOT.l_offline )   CALL dom_vvl_init( Kbb, Kmm, Kaa ) 
    207207         ! 
    208208      ENDIF 
     
    248248      !!---------------------------------------------------------------------- 
    249249      ! 
    250       DO ji = 1, jpi                 ! local domain indices ==> global domain, including halos, indices 
     250      DO ji = 1, jpi                 ! local domain indices ==> global domain indices, including halos 
    251251        mig(ji) = ji + nimpp - 1 
    252252      END DO 
     
    254254        mjg(jj) = jj + njmpp - 1 
    255255      END DO 
    256       !                              ! local domain indices ==> global domain, excluding halos, indices 
     256      !                              ! local domain indices ==> global domain indices, excluding halos 
    257257      ! 
    258258      mig0(:) = mig(:) - nn_hls 
     
    493493      !!---------------------------------------------------------------------- 
    494494      ! 
    495       IF(lk_mpp) THEN 
    496          CALL mpp_minloc( 'domain', glamt(:,:), tmask_i(:,:), zglmin, imil ) 
    497          CALL mpp_minloc( 'domain', gphit(:,:), tmask_i(:,:), zgpmin, imip ) 
    498          CALL mpp_minloc( 'domain',   e1t(:,:), tmask_i(:,:), ze1min, imi1 ) 
    499          CALL mpp_minloc( 'domain',   e2t(:,:), tmask_i(:,:), ze2min, imi2 ) 
    500          CALL mpp_maxloc( 'domain', glamt(:,:), tmask_i(:,:), zglmax, imal ) 
    501          CALL mpp_maxloc( 'domain', gphit(:,:), tmask_i(:,:), zgpmax, imap ) 
    502          CALL mpp_maxloc( 'domain',   e1t(:,:), tmask_i(:,:), ze1max, ima1 ) 
    503          CALL mpp_maxloc( 'domain',   e2t(:,:), tmask_i(:,:), ze2max, ima2 ) 
    504       ELSE 
    505          llmsk = tmask_i(:,:) == 1._wp 
    506          zglmin = MINVAL( glamt(:,:), mask = llmsk )     
    507          zgpmin = MINVAL( gphit(:,:), mask = llmsk )     
    508          ze1min = MINVAL(   e1t(:,:), mask = llmsk )     
    509          ze2min = MINVAL(   e2t(:,:), mask = llmsk )     
    510          zglmin = MAXVAL( glamt(:,:), mask = llmsk )     
    511          zgpmin = MAXVAL( gphit(:,:), mask = llmsk )     
    512          ze1max = MAXVAL(   e1t(:,:), mask = llmsk )     
    513          ze2max = MAXVAL(   e2t(:,:), mask = llmsk )     
    514          ! 
    515          imil   = MINLOC( glamt(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    516          imip   = MINLOC( gphit(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    517          imi1   = MINLOC(   e1t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    518          imi2   = MINLOC(   e2t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    519          imal   = MAXLOC( glamt(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    520          imap   = MAXLOC( gphit(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    521          ima1   = MAXLOC(   e1t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    522          ima2   = MAXLOC(   e2t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
    523       ENDIF 
     495      llmsk = tmask_h(:,:) == 1._wp 
     496      ! 
     497      CALL mpp_minloc( 'domain', glamt(:,:), llmsk, zglmin, imil ) 
     498      CALL mpp_minloc( 'domain', gphit(:,:), llmsk, zgpmin, imip ) 
     499      CALL mpp_minloc( 'domain',   e1t(:,:), llmsk, ze1min, imi1 ) 
     500      CALL mpp_minloc( 'domain',   e2t(:,:), llmsk, ze2min, imi2 ) 
     501      CALL mpp_maxloc( 'domain', glamt(:,:), llmsk, zglmax, imal ) 
     502      CALL mpp_maxloc( 'domain', gphit(:,:), llmsk, zgpmax, imap ) 
     503      CALL mpp_maxloc( 'domain',   e1t(:,:), llmsk, ze1max, ima1 ) 
     504      CALL mpp_maxloc( 'domain',   e2t(:,:), llmsk, ze2max, ima2 ) 
    524505      ! 
    525506      IF(lwp) THEN 
  • NEMO/trunk/src/OCE/DOM/domutl.F90

    r13286 r13458  
    4848      INTEGER , DIMENSION(2) ::   iloc 
    4949      REAL(wp)               ::   zlon, zmini 
    50       REAL(wp), DIMENSION(jpi,jpj) ::   zglam, zgphi, zmask, zdist 
     50      REAL(wp), DIMENSION(jpi,jpj) ::   zglam, zgphi, zdist 
     51      LOGICAL , DIMENSION(jpi,jpj) ::   llmsk 
    5152      !!-------------------------------------------------------------------- 
    5253      ! 
     
    5455      IF ( PRESENT(kkk) ) ik=kkk 
    5556      ! 
    56       CALL dom_uniq(zmask,cdgrid) 
    57       ! 
    5857      SELECT CASE( cdgrid ) 
    59       CASE( 'U' )    ;   zglam(:,:) = glamu(:,:)   ;   zgphi(:,:) = gphiu(:,:)   ;   zmask(:,:) = zmask(:,:) * umask(:,:,ik) 
    60       CASE( 'V' )    ;   zglam(:,:) = glamv(:,:)   ;   zgphi(:,:) = gphiv(:,:)   ;   zmask(:,:) = zmask(:,:) * vmask(:,:,ik) 
    61       CASE( 'F' )    ;   zglam(:,:) = glamf(:,:)   ;   zgphi(:,:) = gphif(:,:)   ;   zmask(:,:) = zmask(:,:) * fmask(:,:,ik) 
    62       CASE DEFAULT   ;   zglam(:,:) = glamt(:,:)   ;   zgphi(:,:) = gphit(:,:)   ;   zmask(:,:) = zmask(:,:) * tmask(:,:,ik) 
     58      CASE( 'U' ) ;   zglam(:,:) = glamu(:,:)   ;   zgphi(:,:) = gphiu(:,:)   ;   llmsk(:,:) = tmask_h(:,:) * umask(:,:,ik) == 1._wp 
     59      CASE( 'V' ) ;   zglam(:,:) = glamv(:,:)   ;   zgphi(:,:) = gphiv(:,:)   ;   llmsk(:,:) = tmask_h(:,:) * vmask(:,:,ik) == 1._wp 
     60      CASE( 'F' ) ;   zglam(:,:) = glamf(:,:)   ;   zgphi(:,:) = gphif(:,:)   ;   llmsk(:,:) = tmask_h(:,:) * fmask(:,:,ik) == 1._wp 
     61      CASE DEFAULT;   zglam(:,:) = glamt(:,:)   ;   zgphi(:,:) = gphit(:,:)   ;   llmsk(:,:) = tmask_h(:,:) * tmask(:,:,ik) == 1._wp 
    6362      END SELECT 
    6463      ! 
     
    6867      IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180 
    6968      zglam(:,:) = zglam(:,:) - zlon 
    70  
     69      ! 
    7170      zgphi(:,:) = zgphi(:,:) - plat 
    7271      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:) 
    73        
    74       IF( lk_mpp ) THEN   
    75          CALL mpp_minloc( 'domngb', zdist(:,:), zmask, zmini, iloc) 
    76          kii = iloc(1) ; kjj = iloc(2) 
    77       ELSE 
    78          iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 ) 
    79          kii = iloc(1) + nimpp - 1 
    80          kjj = iloc(2) + njmpp - 1 
    81       ENDIF 
     72      ! 
     73      CALL mpp_minloc( 'domngb', zdist(:,:), llmsk, zmini, iloc, ldhalo = .TRUE. ) 
     74      kii = iloc(1) 
     75      kjj = iloc(2) 
    8276      ! 
    8377   END SUBROUTINE dom_ngb 
  • NEMO/trunk/src/OCE/DOM/domvvl.F90

    r13295 r13458  
    334334      LOGICAL                ::   ll_do_bclinic         ! local logical 
    335335      REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
    336       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t 
     336      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ze3t 
     337      LOGICAL , DIMENSION(:,:,:), ALLOCATABLE ::   llmsk 
    337338      !!---------------------------------------------------------------------- 
    338339      ! 
     
    447448         ! Maximum deformation control 
    448449         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    449          ze3t(:,:,jpk) = 0._wp 
    450          DO jk = 1, jpkm1 
    451             ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    452          END DO 
    453          z_tmax = MAXVAL( ze3t(:,:,:) ) 
    454          CALL mpp_max( 'domvvl', z_tmax )                 ! max over the global domain 
    455          z_tmin = MINVAL( ze3t(:,:,:) ) 
    456          CALL mpp_min( 'domvvl', z_tmin )                 ! min over the global domain 
     450         ALLOCATE( ze3t(jpi,jpj,jpk), llmsk(jpi,jpj,jpk) ) 
     451         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     452            ze3t(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) / e3t_0(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     453         END_3D 
     454         ! 
     455         llmsk(   1:Nis1,:,:) = .FALSE.   ! exclude halos from the checked region 
     456         llmsk(Nie1: jpi,:,:) = .FALSE. 
     457         llmsk(:,   1:Njs1,:) = .FALSE. 
     458         llmsk(:,Nje1: jpj,:) = .FALSE. 
     459         ! 
     460         llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp                  ! define only the inner domain 
     461         z_tmax = MAXVAL( ze3t(:,:,:), mask = llmsk )   ;   CALL mpp_max( 'domvvl', z_tmax )   ! max over the global domain 
     462         z_tmin = MINVAL( ze3t(:,:,:), mask = llmsk )   ;   CALL mpp_min( 'domvvl', z_tmin )   ! min over the global domain 
    457463         ! - ML - test: for the moment, stop simulation for too large e3_t variations 
    458464         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 
    459             IF( lk_mpp ) THEN 
    460                CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 
    461                CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 
    462             ELSE 
    463                ijk_max = MAXLOC( ze3t(:,:,:) ) 
    464                ijk_max(1) = ijk_max(1) + nimpp - 1 
    465                ijk_max(2) = ijk_max(2) + njmpp - 1 
    466                ijk_min = MINLOC( ze3t(:,:,:) ) 
    467                ijk_min(1) = ijk_min(1) + nimpp - 1 
    468                ijk_min(2) = ijk_min(2) + njmpp - 1 
    469             ENDIF 
     465            CALL mpp_maxloc( 'domvvl', ze3t, llmsk, z_tmax, ijk_max ) 
     466            CALL mpp_minloc( 'domvvl', ze3t, llmsk, z_tmin, ijk_min ) 
    470467            IF (lwp) THEN 
    471468               WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax 
     
    476473            ENDIF 
    477474         ENDIF 
     475         DEALLOCATE( ze3t, llmsk ) 
    478476         ! - ML - end test 
    479477         ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 
  • NEMO/trunk/src/OCE/LBC/mpp_loc_generic.h90

    r13286 r13458  
    22#   if defined SINGLE_PRECISION 
    33#      define ARRAY_TYPE(i,j,k)    REAL(sp)        , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
    4 #      define MASK_TYPE(i,j,k)     REAL(sp)        , INTENT(in   ) ::   MASK_IN(i,j,k) 
     4#if defined key_mpp_mpi 
     5#      define MPI_TYPE MPI_2REAL 
     6#endif 
    57#      define PRECISION sp 
    68#   else 
    79#      define ARRAY_TYPE(i,j,k)    REAL(dp)        , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
    8 #      define MASK_TYPE(i,j,k)     REAL(dp)        , INTENT(in   ) ::   MASK_IN(i,j,k) 
     10#if defined key_mpp_mpi 
     11#      define MPI_TYPE MPI_2DOUBLE_PRECISION 
     12#endif 
    913#      define PRECISION dp 
    1014#   endif 
     
    1216#   if defined DIM_2d 
    1317#      define ARRAY_IN(i,j,k)   ptab(i,j) 
    14 #      define MASK_IN(i,j,k)    pmask(i,j) 
     18#      define MASK_IN(i,j,k)    ldmsk(i,j) 
    1519#      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(2) 
    1620#      define K_SIZE(ptab)      1 
     
    1822#   if defined DIM_3d 
    1923#      define ARRAY_IN(i,j,k)   ptab(i,j,k) 
    20 #      define MASK_IN(i,j,k)    pmask(i,j,k) 
     24#      define MASK_IN(i,j,k)    ldmsk(i,j,k) 
    2125#      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(3) 
    2226#      define K_SIZE(ptab)      SIZE(ptab,3) 
    2327#   endif 
    2428#   if defined OPERATION_MAXLOC 
    25 #      define MPI_OPERATION mpi_maxloc 
     29#      define MPI_OPERATION MPI_MAXLOC 
    2630#      define LOC_OPERATION MAXLOC 
    2731#      define ERRVAL -HUGE 
    2832#   endif 
    2933#   if defined OPERATION_MINLOC 
    30 #      define MPI_OPERATION mpi_minloc 
     34#      define MPI_OPERATION MPI_MINLOC 
    3135#      define LOC_OPERATION MINLOC 
    3236#      define ERRVAL HUGE 
    3337#   endif 
    3438 
    35    SUBROUTINE ROUTINE_LOC( cdname, ptab, pmask, pmin, kindex ) 
     39   SUBROUTINE ROUTINE_LOC( cdname, ptab, ldmsk, pmin, kindex, ldhalo ) 
    3640      !!---------------------------------------------------------------------- 
    37       CHARACTER(len=*), INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     41      CHARACTER(len=*), INTENT(in    ) ::   cdname  ! name of the calling subroutine 
    3842      ARRAY_TYPE(:,:,:)                            ! array on which loctrans operation is applied 
    39       MASK_TYPE(:,:,:)                             ! local mask 
    40       REAL(PRECISION)        , INTENT(  out) ::   pmin    ! Global minimum of ptab 
     43      LOGICAL          , INTENT(in   ) ::   MASK_IN(:,:,:)                     ! local mask 
     44      REAL(PRECISION)  , INTENT(  out) ::   pmin    ! Global minimum of ptab 
    4145      INDEX_TYPE(:)                                ! index of minimum in global frame 
     46      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldhalo  ! If .false. (default) excludes halos in kindex  
    4247      ! 
    4348      INTEGER  ::   ierror, ii, idim 
    4449      INTEGER  ::   index0 
     50      INTEGER , DIMENSION(:), ALLOCATABLE  ::   ilocs 
    4551      REAL(PRECISION) ::   zmin     ! local minimum 
    46       INTEGER , DIMENSION(:), ALLOCATABLE  ::   ilocs 
    47       REAL(dp), DIMENSION(2,1) ::   zain, zaout 
     52      REAL(PRECISION), DIMENSION(2,1) ::   zain, zaout 
     53      LOGICAL  ::   llhalo 
    4854      !!----------------------------------------------------------------------- 
    4955      ! 
    5056      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. ) 
    5157      ! 
     58      IF( PRESENT(ldhalo) ) THEN   ;   llhalo = ldhalo 
     59      ELSE                         ;   llhalo = .FALSE. 
     60      ENDIF 
     61      ! 
    5262      idim = SIZE(kindex) 
    5363      ! 
    54       IF ( ALL(MASK_IN(:,:,:) /= 1._wp) ) THEN 
    55          ! special case for land processors 
    56          zmin = ERRVAL(zmin) 
    57          index0 = 0 
    58       ELSE 
     64      IF ( ANY( MASK_IN(:,:,:) ) ) THEN   ! there is at least 1 valid point... 
     65         ! 
    5966         ALLOCATE ( ilocs(idim) ) 
    6067         ! 
    61          ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) == 1._wp ) 
     68         ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) ) 
    6269         zmin  = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3)) 
    6370         ! 
     
    7986         index0 = index0 + jpiglo * jpjglo * (kindex(3)-1) 
    8087#endif 
     88      ELSE 
     89         ! special case for land processors 
     90         zmin = ERRVAL(zmin) 
     91         index0 = 0 
    8192      END IF 
     93      ! 
    8294      zain(1,:) = zmin 
    83       zain(2,:) = REAL(index0, wp) 
     95      zain(2,:) = REAL(index0, PRECISION) 
    8496      ! 
     97#if defined key_mpp_mpi 
    8598      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.) 
    86 #if defined key_mpp_mpi 
    87       CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror) 
     99      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_TYPE, MPI_OPERATION ,MPI_COMM_OCE, ierror) 
     100      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    88101#else 
    89102      zaout(:,:) = zain(:,:) 
    90103#endif 
    91       IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    92104      ! 
    93105      pmin      = zaout(1,1) 
     
    104116      kindex(:) = kindex(:) + 1   ! start indices at 1 
    105117 
     118      IF( .NOT. llhalo ) THEN 
     119         kindex(1)  = kindex(1) - nn_hls 
     120#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
     121         kindex(2)  = kindex(2) - nn_hls 
     122#endif 
     123      ENDIF 
     124       
    106125   END SUBROUTINE ROUTINE_LOC 
    107126 
     
    109128#undef PRECISION 
    110129#undef ARRAY_TYPE 
    111 #undef MASK_TYPE 
    112130#undef ARRAY_IN 
    113131#undef MASK_IN 
    114132#undef K_SIZE 
     133#if defined key_mpp_mpi 
     134#   undef MPI_TYPE 
     135#endif 
    115136#undef MPI_OPERATION 
    116137#undef LOC_OPERATION 
  • NEMO/trunk/src/OCE/stpctl.F90

    r13216 r13458  
    4949      !! 
    5050      !! ** Method  : - Save the time step in numstp 
    51       !!              - Print it each 50 time steps 
    5251      !!              - Stop the run IF problem encountered by setting nstop > 0 
    5352      !!                Problems checked: |ssh| maximum larger than 10 m 
     
    119118      !                                   !==            test of local extrema           ==! 
    120119      !                                   !==  done by all processes at every time step  ==! 
    121       llmsk(:,:,1) = ssmask(:,:) == 1._wp 
     120      ! 
     121      llmsk(   1:Nis1,:,:) = .FALSE.                                              ! exclude halos from the checked region 
     122      llmsk(Nie1: jpi,:,:) = .FALSE. 
     123      llmsk(:,   1:Njs1,:) = .FALSE. 
     124      llmsk(:,Nje1: jpj,:) = .FALSE. 
     125      ! 
     126      llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0) == 1._wp         ! define only the inner domain 
    122127      IF( ll_wd ) THEN 
    123128         zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) )   ! ssh max 
     
    125130         zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm)           ), mask = llmsk(:,:,1) )   ! ssh max 
    126131      ENDIF 
    127       llmsk(:,:,:) = umask(:,:,:) == 1._wp 
     132      llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
    128133      zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) ), mask = llmsk )                     ! velocity max (zonal only) 
    129       llmsk(:,:,:) = tmask(:,:,:) == 1._wp 
     134      llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
    130135      zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     ! minus salinity max 
    131136      zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     !       salinity max 
     
    143148         zmax(5:8) = 0._wp 
    144149      ENDIF 
    145       zmax(9) = REAL( nstop, wp )                                              ! stop indicator 
     150      zmax(9) = REAL( nstop, wp )                                                 ! stop indicator 
    146151      !                                   !==               get global extrema             ==! 
    147152      !                                   !==  done by all processes if writting run.stat  ==! 
     
    183188            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
    184189            ! get global loc on the min/max 
    185             CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,         Kmm)), ssmask(:,:  ), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
    186             CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:,       Kmm)),  umask(:,:,:), zzz, iloc(1:3,2) ) 
    187             CALL mpp_minloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) ,  tmask(:,:,:), zzz, iloc(1:3,3) ) 
    188             CALL mpp_maxloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) ,  tmask(:,:,:), zzz, iloc(1:3,4) ) 
     190            llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0 ) == 1._wp         ! define only the inner domain 
     191            CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,         Kmm)), llmsk(:,:,1), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     192            llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     193            CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:,       Kmm)), llmsk(:,:,:), zzz, iloc(1:3,2) ) 
     194            llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     195            CALL mpp_minloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) , llmsk(:,:,:), zzz, iloc(1:3,3) ) 
     196            CALL mpp_maxloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) , llmsk(:,:,:), zzz, iloc(1:3,4) ) 
    189197            ! find which subdomain has the max. 
    190198            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
     
    199207         ELSE                    ! find local min and max locations: 
    200208            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
    201             iloc(1:2,1) = MAXLOC( ABS( ssh(:,:,         Kmm)), mask = ssmask(:,:  ) == 1._wp ) + (/ nimpp - 1, njmpp - 1    /) 
    202             iloc(1:3,2) = MAXLOC( ABS(  uu(:,:,:,       Kmm)), mask =  umask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    203             iloc(1:3,3) = MINLOC(       ts(:,:,:,jp_sal,Kmm) , mask =  tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    204             iloc(1:3,4) = MAXLOC(       ts(:,:,:,jp_sal,Kmm) , mask =  tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     209            llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0 ) == 1._wp        ! define only the inner domain 
     210            iloc(1:2,1) = MAXLOC( ABS( ssh(:,:,         Kmm)), mask = llmsk(:,:,1) ) 
     211            llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     212            iloc(1:3,2) = MAXLOC( ABS(  uu(:,:,:,       Kmm)), mask = llmsk(:,:,:) ) 
     213            llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     214            iloc(1:3,3) = MINLOC(       ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) ) 
     215            iloc(1:3,4) = MAXLOC(       ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) ) 
     216            DO ji = 1, 4   ! local domain indices ==> global domain indices, excluding halos 
     217               iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 
     218            END DO 
    205219            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
    206220         ENDIF 
Note: See TracChangeset for help on using the changeset viewer.