Changeset 13458


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

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

Location:
NEMO/trunk
Files:
15 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 
  • NEMO/trunk/src/SAS/stpctl.F90

    r13136 r13458  
    2020   USE dom_oce         ! ocean space and time domain variables  
    2121   USE ice      , ONLY : vt_i, u_ice, tm_i 
     22   USE phycst   , ONLY : rt0 
    2223   ! 
    2324   USE diawri          ! Standard run outputs       (dia_wri_state routine) 
     
    4849      !! 
    4950      !! ** Method  : - Save the time step in numstp 
    50       !!              - Print it each 50 time steps 
    5151      !!              - Stop the run IF problem encountered by setting nstop > 0 
    5252      !!                Problems checked: ice thickness maximum > 100 m 
     
    111111      !                                   !==            test of local extrema           ==! 
    112112      !                                   !==  done by all processes at every time step  ==! 
    113       llmsk(:,:) = tmask(:,:,1) == 1._wp 
     113      ! 
     114      llmsk(   1:Nis1,:) = .FALSE.                                              ! exclude halos from the checked region 
     115      llmsk(Nie1: jpi,:) = .FALSE. 
     116      llmsk(:,   1:Njs1) = .FALSE. 
     117      llmsk(:,Nje1: jpj) = .FALSE. 
     118      ! 
     119      llmsk(Nis0:Nie0,Njs0:Nje0) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp   ! test only the inner domain 
    114120      IF( COUNT( llmsk(:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
    115          zmax(1) = MAXVAL(      vt_i (:,:)            , mask = llmsk )   ! max ice thickness 
    116          zmax(2) = MAXVAL( ABS( u_ice(:,:) )          , mask = llmsk )   ! max ice velocity (zonal only) 
    117          zmax(3) = MAXVAL(     -tm_i (:,:) + 273.15_wp, mask = llmsk )   ! min ice temperature 
     121         zmax(1) = MAXVAL(      vt_i (:,:)      , mask = llmsk )   ! max ice thickness 
     122         zmax(2) = MAXVAL( ABS( u_ice(:,:) )    , mask = llmsk )   ! max ice velocity (zonal only) 
     123         zmax(3) = MAXVAL(     -tm_i (:,:) + rt0, mask = llmsk )   ! min ice temperature (in degC) 
    118124      ELSE 
    119125         IF( ll_colruns ) THEN    ! default value: must not be kept when calling mpp_max -> must be as small as possible 
     
    154160            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
    155161            ! get global loc on the min/max 
    156             CALL mpp_maxloc( 'stpctl',      vt_i(:,:)            , tmask(:,:,1), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
    157             CALL mpp_maxloc( 'stpctl',ABS( u_ice(:,:) )          , tmask(:,:,1), zzz, iloc(1:2,2) ) 
    158             CALL mpp_minloc( 'stpctl',      tm_i(:,:) - 273.15_wp, tmask(:,:,1), zzz, iloc(1:2,3) ) 
     162            CALL mpp_maxloc( 'stpctl',      vt_i(:,:)      , llmsk, zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     163            CALL mpp_maxloc( 'stpctl',ABS( u_ice(:,:) )    , llmsk, zzz, iloc(1:2,2) ) 
     164            CALL mpp_minloc( 'stpctl',      tm_i(:,:) - rt0, llmsk, zzz, iloc(1:2,3) ) 
    159165            ! find which subdomain has the max. 
    160166            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
     
    169175         ELSE                    ! find local min and max locations: 
    170176            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
    171             iloc(1:2,1) = MAXLOC(       vt_i(:,:)            , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
    172             iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) )          , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
    173             iloc(1:2,3) = MINLOC(       tm_i(:,:) - 273.15_wp, mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
     177            iloc(1:2,1) = MAXLOC(       vt_i(:,:)      , mask = llmsk ) 
     178            iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) )    , mask = llmsk ) 
     179            iloc(1:2,3) = MINLOC(       tm_i(:,:) - rt0, mask = llmsk ) 
     180            DO ji = 1, 3   ! local domain indices ==> global domain indices, excluding halos 
     181               iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 
     182            END DO 
    174183            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
    175184         ENDIF 
  • NEMO/trunk/src/SWE/domain.F90

    r13435 r13458  
    245245      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point 
    246246      ! 
     247 
     248#if defined key_agrif 
     249      IF( .NOT. Agrif_Root() ) CALL Agrif_Init_Domain( Kbb, Kmm, Kaa ) 
     250#endif 
    247251      IF( ln_meshmask    )   CALL dom_wri       ! Create a domain file 
    248  
    249252      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control 
    250253      ! 
     
    269272      !! ** Method  :    
    270273      !! 
    271       !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices 
     274      !! ** Action  : - mig , mjg : local  domain indices ==> global domain, including halos, indices 
     275      !!              - mig0, mjg0: local  domain indices ==> global domain, excluding halos, indices 
    272276      !!              - mi0 , mi1 : global domain indices ==> local  domain indices 
    273       !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 
     277      !!              - mj0 , mj1   (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 
    274278      !!---------------------------------------------------------------------- 
    275279      INTEGER ::   ji, jj   ! dummy loop argument 
    276280      !!---------------------------------------------------------------------- 
    277281      ! 
    278       DO ji = 1, jpi                 ! local domain indices ==> global domain indices 
     282      DO ji = 1, jpi                 ! local domain indices ==> global domain indices, including halos 
    279283        mig(ji) = ji + nimpp - 1 
    280284      END DO 
     
    282286        mjg(jj) = jj + njmpp - 1 
    283287      END DO 
    284       !                              ! global domain indices ==> local domain indices 
     288      !                              ! local domain indices ==> global domain indices, excluding halos 
     289      ! 
     290      mig0(:) = mig(:) - nn_hls 
     291      mjg0(:) = mjg(:) - nn_hls   
     292      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,  
     293      ! we must define mig0 and mjg0 as bellow. 
     294      ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as: 
     295      mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 
     296      mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) 
     297      ! 
     298      !                              ! global domain, including halos, indices ==> local domain indices 
    285299      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the  
    286300      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.  
     
    300314         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk 
    301315         WRITE(numout,*) 
    302          WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done' 
    303          IF( nn_print >= 1 ) THEN 
    304             WRITE(numout,*) 
    305             WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)' 
    306             WRITE(numout,25)              (mig(ji),ji = 1,jpi) 
    307             WRITE(numout,*) 
    308             WRITE(numout,*) '          conversion global ==> local  i-index domain' 
    309             WRITE(numout,*) '             starting index (mi0)' 
    310             WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo) 
    311             WRITE(numout,*) '             ending index (mi1)' 
    312             WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo) 
    313             WRITE(numout,*) 
    314             WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)' 
    315             WRITE(numout,25)              (mjg(jj),jj = 1,jpj) 
    316             WRITE(numout,*) 
    317             WRITE(numout,*) '          conversion global ==> local  j-index domain' 
    318             WRITE(numout,*) '             starting index (mj0)' 
    319             WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo) 
    320             WRITE(numout,*) '             ending index (mj1)' 
    321             WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo) 
    322          ENDIF 
    323       ENDIF 
    324  25   FORMAT( 100(10x,19i4,/) ) 
     316      ENDIF 
    325317      ! 
    326318   END SUBROUTINE dom_glo 
     
    364356902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist' ) 
    365357      IF(lwm) WRITE ( numond, namrun ) 
     358 
     359#if defined key_agrif 
     360      IF( .NOT. Agrif_Root() ) THEN 
     361            nn_it000 = (Agrif_Parent(nn_it000)-1)*Agrif_IRhot() + 1 
     362            nn_itend =  Agrif_Parent(nn_itend)   *Agrif_IRhot() 
     363      ENDIF 
     364#endif 
    366365      ! 
    367366      IF(lwp) THEN                  ! control print 
     
    435434#endif 
    436435 
    437 #if defined key_agrif 
    438436      IF( Agrif_Root() ) THEN 
    439 #endif 
    440       IF(lwp) WRITE(numout,*) 
    441       SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    442       CASE (  1 )  
    443          CALL ioconf_calendar('gregorian') 
    444          IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year' 
    445       CASE (  0 ) 
    446          CALL ioconf_calendar('noleap') 
    447          IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year' 
    448       CASE ( 30 ) 
    449          CALL ioconf_calendar('360d') 
    450          IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
    451       END SELECT 
    452 #if defined key_agrif 
    453       ENDIF 
    454 #endif 
     437         IF(lwp) WRITE(numout,*) 
     438         SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
     439         CASE (  1 )  
     440            CALL ioconf_calendar('gregorian') 
     441            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year' 
     442         CASE (  0 ) 
     443            CALL ioconf_calendar('noleap') 
     444            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year' 
     445         CASE ( 30 ) 
     446            CALL ioconf_calendar('360d') 
     447            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
     448         END SELECT 
     449      ENDIF 
    455450 
    456451      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 
     
    459454904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist' ) 
    460455      IF(lwm) WRITE( numond, namdom ) 
     456      ! 
     457#if defined key_agrif 
     458      IF( .NOT. Agrif_Root() ) THEN 
     459            rn_Dt = Agrif_Parent(rn_Dt) / Agrif_Rhot() 
     460      ENDIF 
     461#endif 
    461462      ! 
    462463      IF(lwp) THEN 
     
    519520      !! ** Method  :   compute and print extrema of masked scale factors 
    520521      !!---------------------------------------------------------------------- 
    521       INTEGER, DIMENSION(2) ::   imi1, imi2, ima1, ima2 
    522       INTEGER, DIMENSION(2) ::   iloc   !  
    523       REAL(wp) ::   ze1min, ze1max, ze2min, ze2max 
    524       !!---------------------------------------------------------------------- 
    525       ! 
    526       IF(lk_mpp) THEN 
    527          CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 ) 
    528          CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 ) 
    529          CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 ) 
    530          CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 ) 
    531       ELSE 
    532          ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )     
    533          ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )     
    534          ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )     
    535          ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )     
    536          ! 
    537          iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    538          imi1(1) = iloc(1) + nimpp - 1 
    539          imi1(2) = iloc(2) + njmpp - 1 
    540          iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    541          imi2(1) = iloc(1) + nimpp - 1 
    542          imi2(2) = iloc(2) + njmpp - 1 
    543          iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    544          ima1(1) = iloc(1) + nimpp - 1 
    545          ima1(2) = iloc(2) + njmpp - 1 
    546          iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    547          ima2(1) = iloc(1) + nimpp - 1 
    548          ima2(2) = iloc(2) + njmpp - 1 
    549       ENDIF 
     522      LOGICAL, DIMENSION(jpi,jpj) ::   llmsk 
     523      INTEGER, DIMENSION(2)       ::   imil, imip, imi1, imi2, imal, imap, ima1, ima2 
     524      REAL(wp)                    ::   zglmin, zglmax, zgpmin, zgpmax, ze1min, ze1max, ze2min, ze2max 
     525      !!---------------------------------------------------------------------- 
     526      ! 
     527      llmsk = tmask_h(:,:) == 1._wp 
     528      ! 
     529      CALL mpp_minloc( 'domain', glamt(:,:), llmsk, zglmin, imil ) 
     530      CALL mpp_minloc( 'domain', gphit(:,:), llmsk, zgpmin, imip ) 
     531      CALL mpp_minloc( 'domain',   e1t(:,:), llmsk, ze1min, imi1 ) 
     532      CALL mpp_minloc( 'domain',   e2t(:,:), llmsk, ze2min, imi2 ) 
     533      CALL mpp_maxloc( 'domain', glamt(:,:), llmsk, zglmax, imal ) 
     534      CALL mpp_maxloc( 'domain', gphit(:,:), llmsk, zgpmax, imap ) 
     535      CALL mpp_maxloc( 'domain',   e1t(:,:), llmsk, ze1max, ima1 ) 
     536      CALL mpp_maxloc( 'domain',   e2t(:,:), llmsk, ze2max, ima2 ) 
     537      ! 
    550538      IF(lwp) THEN 
    551539         WRITE(numout,*) 
    552540         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 
    553541         WRITE(numout,*) '~~~~~~~' 
    554          WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 
    555          WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 
    556          WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 
    557          WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 
     542         WRITE(numout,"(14x,'glamt mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmin, imil(1), imil(2) 
     543         WRITE(numout,"(14x,'glamt maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmax, imal(1), imal(2) 
     544         WRITE(numout,"(14x,'gphit mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmin, imip(1), imip(2) 
     545         WRITE(numout,"(14x,'gphit maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmax, imap(1), imap(2) 
     546         WRITE(numout,"(14x,'  e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 
     547         WRITE(numout,"(14x,'  e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 
     548         WRITE(numout,"(14x,'  e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 
     549         WRITE(numout,"(14x,'  e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 
    558550      ENDIF 
    559551      ! 
     
    622614      IF(lwp) THEN 
    623615         WRITE(numout,*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg 
    624          WRITE(numout,*) '      jpiglo = ', kpi 
    625          WRITE(numout,*) '      jpjglo = ', kpj 
     616         WRITE(numout,*) '      Ni0glo = ', kpi 
     617         WRITE(numout,*) '      Nj0glo = ', kpj 
    626618         WRITE(numout,*) '      jpkglo = ', kpk 
    627619         WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio 
     
    662654      !          
    663655      clnam = cn_domcfg_out  ! filename (configuration information) 
    664       CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 
    665        
     656      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )      
    666657      ! 
    667658      !                             !==  ORCA family specificities  ==! 
     
    671662      ENDIF 
    672663      ! 
    673       !                             !==  global domain size  ==! 
    674       ! 
    675       CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 ) 
    676       CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 ) 
    677       CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 ) 
    678       ! 
    679664      !                             !==  domain characteristics  ==! 
    680665      ! 
     
    683668      ! 
    684669      !                                   ! type of vertical coordinate 
    685       IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF 
    686       IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF 
    687       IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF 
    688       CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 ) 
    689       CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 ) 
    690       CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 ) 
     670      CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4 ) 
     671      CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4 ) 
     672      CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4 ) 
    691673      ! 
    692674      !                                   ! ocean cavities under iceshelves 
    693       IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF 
    694       CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 ) 
     675      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4 ) 
    695676      ! 
    696677      !                             !==  horizontal mesh  ! 
  • NEMO/trunk/src/SWE/domvvl.F90

    r13295 r13458  
    276276            IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
    277277               IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    278                   ii0 = 103   ;   ii1 = 111        
    279                   ij0 = 128   ;   ij1 = 135   ;    
     278                  ii0 = 103 + nn_hls - 1   ;   ii1 = 111 + nn_hls - 1       
     279                  ij0 = 128 + nn_hls       ;   ij1 = 135 + nn_hls 
    280280                  frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    281281                  frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rn_Dt 
     
    415415      LOGICAL                ::   ll_do_bclinic         ! local logical 
    416416      REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
    417       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t 
     417      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ze3t 
     418      LOGICAL , DIMENSION(:,:,:), ALLOCATABLE ::   llmsk 
    418419      !!---------------------------------------------------------------------- 
    419420      ! 
     
    528529         ! Maximum deformation control 
    529530         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     531         ALLOCATE( ze3t(jpi,jpj,jpk), llmsk(jpi,jpj,jpk) ) 
    530532         ze3t(:,:,jpk) = 0._wp 
    531533         DO jk = 1, jpkm1 
    532534            ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    533535         END DO 
    534          z_tmax = MAXVAL( ze3t(:,:,:) ) 
    535          CALL mpp_max( 'domvvl', z_tmax )                 ! max over the global domain 
    536          z_tmin = MINVAL( ze3t(:,:,:) ) 
    537          CALL mpp_min( 'domvvl', z_tmin )                 ! min over the global domain 
     536         ! 
     537         llmsk(   1:Nis1,:,:) = .FALSE.   ! exclude halos from the checked region 
     538         llmsk(Nie1: jpi,:,:) = .FALSE. 
     539         llmsk(:,   1:Njs1,:) = .FALSE. 
     540         llmsk(:,Nje1: jpj,:) = .FALSE. 
     541         ! 
     542         llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp                  ! define only the inner domain 
     543         z_tmax = MAXVAL( ze3t(:,:,:), mask = llmsk )   ;   CALL mpp_max( 'domvvl', z_tmax )   ! max over the global domain 
     544         z_tmin = MINVAL( ze3t(:,:,:), mask = llmsk )   ;   CALL mpp_min( 'domvvl', z_tmin )   ! min over the global domain 
    538545         ! - ML - test: for the moment, stop simulation for too large e3_t variations 
    539546         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 
    540             IF( lk_mpp ) THEN 
    541                CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 
    542                CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 
    543             ELSE 
    544                ijk_max = MAXLOC( ze3t(:,:,:) ) 
    545                ijk_max(1) = ijk_max(1) + nimpp - 1 
    546                ijk_max(2) = ijk_max(2) + njmpp - 1 
    547                ijk_min = MINLOC( ze3t(:,:,:) ) 
    548                ijk_min(1) = ijk_min(1) + nimpp - 1 
    549                ijk_min(2) = ijk_min(2) + njmpp - 1 
    550             ENDIF 
     547            CALL mpp_maxloc( 'domvvl', ze3t, llmsk, z_tmax, ijk_max ) 
     548            CALL mpp_minloc( 'domvvl', ze3t, llmsk, z_tmin, ijk_min ) 
    551549            IF (lwp) THEN 
    552550               WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax 
     
    557555            ENDIF 
    558556         ENDIF 
     557         DEALLOCATE( ze3t, llmsk ) 
    559558         ! - ML - end test 
    560559         ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 
     
    697696      LOGICAL                ::   ll_do_bclinic         ! local logical 
    698697      REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
    699       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t 
    700698      !!---------------------------------------------------------------------- 
    701699      ! 
  • NEMO/trunk/src/SWE/step.F90

    r13295 r13458  
    291291      ! Control 
    292292      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    293                          CALL stp_ctl      ( kstp, Nbb, Nnn, indic ) 
     293                         CALL stp_ctl      ( kstp, Nnn ) 
    294294                
    295295                          
  • NEMO/trunk/src/SWE/stpctl.F90

    r12983 r13458  
    1919   USE dom_oce         ! ocean space and time domain variables  
    2020   USE c1d             ! 1D vertical configuration 
     21   USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables 
     22   USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy 
     23   !   
    2124   USE diawri          ! Standard run outputs       (dia_wri_state routine) 
    22    ! 
    2325   USE in_out_manager  ! I/O manager 
    2426   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2527   USE lib_mpp         ! distributed memory computing 
    26    USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables 
    27    USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy 
    28  
     28   ! 
    2929   USE netcdf          ! NetCDF library 
    3030   IMPLICIT NONE 
     
    3333   PUBLIC stp_ctl           ! routine called by step.F90 
    3434 
    35    INTEGER  ::   idrun, idtime, idssh, idu, ids1, ids2, idt1, idt2, idc1, idw1, istatus 
    36    LOGICAL  ::   lsomeoce 
    37 !!stoops 
    38 #  include "domzgr_substitute.h90" 
     35   INTEGER                ::   nrunid   ! netcdf file id 
     36   INTEGER, DIMENSION(2)  ::   nvarid   ! netcdf variable id 
    3937   !!---------------------------------------------------------------------- 
    4038   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    41    !! $Id: stpctl.F90 12614 2020-03-26 14:59:52Z gm $ 
     39   !! $Id: stpctl.F90 13216 2020-07-02 09:25:49Z rblod $ 
    4240   !! Software governed by the CeCILL license (see ./LICENSE) 
    4341   !!---------------------------------------------------------------------- 
    4442CONTAINS 
    4543 
    46    SUBROUTINE stp_ctl( kt, Kbb, Kmm, kindic ) 
     44   SUBROUTINE stp_ctl( kt, Kmm ) 
    4745      !!---------------------------------------------------------------------- 
    4846      !!                    ***  ROUTINE stp_ctl  *** 
     
    5149      !! 
    5250      !! ** Method  : - Save the time step in numstp 
    53       !!              - Print it each 50 time steps 
    54       !!              - Stop the run IF problem encountered by setting indic=-3 
    55       !!                Problems checked: |ssh| maximum larger than 10 m 
     51      !!              - Stop the run IF problem encountered by setting nstop > 0 
     52      !!                Problems checked: negative sea surface height  
    5653      !!                                  |U|   maximum larger than 10 m/s  
    57       !!                                  negative sea surface salinity 
    5854      !! 
    5955      !! ** Actions :   "time.step" file = last ocean time-step 
    6056      !!                "run.stat"  file = run statistics 
    61       !!                nstop indicator sheared among all local domain (lk_mpp=T) 
     57      !!                 nstop indicator sheared among all local domain 
    6258      !!---------------------------------------------------------------------- 
    6359      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    64       INTEGER, INTENT(in   ) ::   Kbb, Kmm      ! ocean time level index 
    65       INTEGER, INTENT(inout) ::   kindic   ! error indicator 
    66       !! 
    67       INTEGER                ::   ji, jj, jk          ! dummy loop indices 
    68       INTEGER, DIMENSION(2)  ::   ih                  ! min/max loc indices 
    69       INTEGER, DIMENSION(3)  ::   iu, is1, is2        ! min/max loc indices 
    70       REAL(wp)               ::   zzz                 ! local real  
    71       REAL(wp), DIMENSION(3) ::   zmax 
    72       LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns 
    73       CHARACTER(len=20) :: clname 
    74       !!---------------------------------------------------------------------- 
    75       ! 
    76       ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
    77       ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 
    78       ll_wrtruns = ll_colruns .AND. lwm 
    79       IF( kt == nit000 .AND. lwp ) THEN 
    80          WRITE(numout,*) 
    81          WRITE(numout,*) 'stp_ctl : time-stepping control' 
    82          WRITE(numout,*) '~~~~~~~' 
    83          !                                ! open time.step file 
    84          IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    85          !                                ! open run.stat file(s) at start whatever 
    86          !                                ! the value of sn_cfctl%ptimincr 
    87          IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 
     60      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index 
     61      !! 
     62      INTEGER                         ::   ji                                    ! dummy loop indices 
     63      INTEGER                         ::   idtime, istatus 
     64      INTEGER , DIMENSION(3)          ::   iareasum, iareamin, iareamax 
     65      INTEGER , DIMENSION(3,2)        ::   iloc                                  ! min/max loc indices 
     66      REAL(wp)                        ::   zzz                                   ! local real  
     67      REAL(wp), DIMENSION(3)          ::   zmax, zmaxlocal 
     68      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns 
     69      LOGICAL, DIMENSION(jpi,jpj,jpk) ::   llmsk 
     70      CHARACTER(len=20)               ::   clname 
     71      !!---------------------------------------------------------------------- 
     72      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
     73      ! 
     74      ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
     75      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1  
     76      ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 
     77      ! 
     78      IF( kt == nit000 ) THEN 
     79         ! 
     80         IF( lwp ) THEN 
     81            WRITE(numout,*) 
     82            WRITE(numout,*) 'stp_ctl : time-stepping control' 
     83            WRITE(numout,*) '~~~~~~~' 
     84         ENDIF 
     85         !                                ! open time.step    ascii file, done only by 1st subdomain 
     86         IF( lwm )   CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     87         ! 
     88         IF( ll_wrtruns ) THEN 
     89            !                             ! open run.stat     ascii file, done only by 1st subdomain 
    8890            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     91            !                             ! open run.stat.nc netcdf file, done only by 1st subdomain 
    8992            clname = 'run.stat.nc' 
    9093            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    91             istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 
    92             istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 
    93             istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh ) 
    94             istatus = NF90_DEF_VAR( idrun,   'abs_u_max', NF90_DOUBLE, (/ idtime /), idu   ) 
    95             istatus = NF90_ENDDEF(idrun) 
    96          ENDIF 
    97       ENDIF 
    98       IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    99       ! 
    100       IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file) 
     94            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 
     95            istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 
     96            istatus = NF90_DEF_VAR( nrunid, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), nvarid(1) ) 
     97            istatus = NF90_DEF_VAR( nrunid,   'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 
     98            istatus = NF90_ENDDEF(nrunid) 
     99         ENDIF 
     100         !     
     101      ENDIF 
     102      ! 
     103      !                                   !==              write current time step              ==! 
     104      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
     105      IF( lwm .AND. ll_wrtstp ) THEN 
    101106         WRITE ( numstp, '(1x, i8)' )   kt 
    102107         REWIND( numstp ) 
    103108      ENDIF 
    104       ! 
    105       !                                   !==  test of extrema  ==! 
    106       IF( ll_wd ) THEN 
    107          zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) + ssh_ref*tmask(:,:,1) )  )        ! ssh max  
    108       ELSE 
    109          zmax(1) = MINVAL( e3t(:,:,1,Kmm)  )                                         ! ssh min 
    110       ENDIF 
    111       zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) )  )                                  ! velocity max (zonal only) 
    112       zmax(3) = REAL( nstop , wp )                                            ! stop indicator 
    113       ! 
     109      !                                   !==            test of local extrema           ==! 
     110      !                                   !==  done by all processes at every time step  ==! 
     111      ! 
     112      llmsk(   1:Nis1,:,:) = .FALSE.                                              ! exclude halos from the checked region 
     113      llmsk(Nie1: jpi,:,:) = .FALSE. 
     114      llmsk(:,   1:Njs1,:) = .FALSE. 
     115      llmsk(:,Nje1: jpj,:) = .FALSE. 
     116      ! 
     117      llmsk(Nis0:Nie0,Njs0:Nje0,1) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp         ! define only the inner domain 
     118      zmax(1) = MAXVAL(     -e3t(:,:,1,Kmm) ), mask = llmsk(:,:,1) )      ! ssh max 
     119      llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     120      zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) ), mask = llmsk(:,:,:) )                     ! velocity max (zonal only) 
     121      zmax(3) = REAL( nstop, wp )                                                 ! stop indicator 
     122      !                                   !==               get global extrema             ==! 
     123      !                                   !==  done by all processes if writting run.stat  ==! 
    114124      IF( ll_colruns ) THEN 
     125         zmaxlocal(:) = zmax(:) 
    115126         CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
    116          nstop = NINT( zmax(3) )                 ! nstop indicator sheared among all local domains 
    117       ENDIF 
    118       !                                   !==  run statistics  ==!   ("run.stat" files) 
     127         nstop = NINT( zmax(3) )                 ! update nstop indicator (now sheared among all local domains) 
     128      ENDIF 
     129      !                                   !==              write "run.stat" files              ==! 
     130      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
    119131      IF( ll_wrtruns ) THEN 
    120132         WRITE(numrun,9500) kt, zmax(1), zmax(2) 
    121          istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 
    122          istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) ) 
    123          IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 
    124          IF( kt == nitend         ) istatus = NF90_CLOSE(idrun) 
     133         istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ -zmax(1)/), (/kt/), (/1/) ) 
     134         istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/  zmax(2)/), (/kt/), (/1/) ) 
     135         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid) 
    125136      END IF 
    126       !                                   !==  error handling  ==! 
    127       IF( ( sn_cfctl%l_glochk .OR. lsomeoce ) .AND. (   &  ! domain contains some ocean points, check for sensible ranges 
    128          &  zmax(1) <    0._wp .OR.   &                    ! negative sea surface height  
    129          &  zmax(2) >   10._wp .OR.   &                    ! too large velocity ( > 10 m/s) 
    130          &  ISNAN( zmax(1) + zmax(2) ) ) ) THEN            ! NaN encounter in the tests 
    131          IF( lk_mpp .AND. sn_cfctl%l_glochk ) THEN 
    132             ! have use mpp_max (because sn_cfctl%l_glochk=.T. and distributed) 
    133             CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,Kmm))        , ssmask(:,:)  , zzz, ih  ) 
    134             CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm))          , umask (:,:,:), zzz, iu  ) 
     137      !                                   !==               error handling               ==! 
     138      !                                   !==  done by all processes at every time step  ==! 
     139      ! 
     140      IF(   zmax(1) >  0._wp           .OR.   &               ! negative sea surface height  
     141         &  zmax(2) > 10._wp           .OR.   &               ! too large velocity ( > 10 m/s) 
     142         &  ISNAN( zmax(1) + zmax(2) ) .OR.   &               ! NaN encounter in the tests 
     143         &  ABS(   zmax(1) + zmax(2) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
     144         ! 
     145         iloc(:,:) = 0 
     146         IF( ll_colruns ) THEN   ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 
     147            ! first: close the netcdf file, so we can read it 
     148            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
     149            ! get global loc on the min/max 
     150            llmsk(Nis0:Nie0,Njs0:Nje0,1) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp         ! define only the inner domain 
     151            CALL mpp_maxloc( 'stpctl',   -e3t(:,:,1,Kmm) , llmsk(:,:,1), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     152            llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     153            CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm)), llmsk(:,:,:), zzz, iloc(1:3,2) ) 
     154            ! find which subdomain has the max. 
     155            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
     156            DO ji = 1, 3 
     157               IF( zmaxlocal(ji) == zmax(ji) ) THEN 
     158                  iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1 
     159               ENDIF 
     160            END DO 
     161            CALL mpp_min( "stpctl", iareamin )         ! min over the global domain 
     162            CALL mpp_max( "stpctl", iareamax )         ! max over the global domain 
     163            CALL mpp_sum( "stpctl", iareasum )         ! sum over the global domain 
     164         ELSE                    ! find local min and max locations: 
     165            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
     166            llmsk(Nis0:Nie0,Njs0:Nje0,1) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp         ! define only the inner domain 
     167            iloc(1:2,1) = MAXLOC(   -e3t(:,:,1,Kmm) , mask = llmsk(:,:,1) ) 
     168            llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
     169            iloc(1:3,2) = MAXLOC( ABS(uu(:,:,:,Kmm)), mask = llmsk(:,:,:) ) 
     170            DO ji = 1, 2   ! local domain indices ==> global domain indices, excluding halos 
     171               iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 
     172            END DO 
     173            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
     174         ENDIF 
     175         ! 
     176         WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests' 
     177         CALL wrt_line( ctmp2, kt, '|e3t| min', -zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
     178         CALL wrt_line( ctmp3, kt, '|U|   max',  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
     179         IF( Agrif_Root() ) THEN 
     180            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files' 
    135181         ELSE 
    136             ! find local min and max locations 
    137             ih(:)  = MAXLOC( ABS( ssh(:,:,Kmm)   )                              ) + (/ nimpp - 1, njmpp - 1    /) 
    138             iu(:)  = MAXLOC( ABS( uu  (:,:,:,Kmm) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    139          ENDIF 
    140           
    141          WRITE(ctmp1,*) ' stp_ctl: (e3t0) ssh < 0 m  or  |U| > 10 m/s  or  NaN encounter in the tests' 
    142          WRITE(ctmp2,9100) kt,   zmax(1), ih(1) , ih(2) 
    143          WRITE(ctmp3,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3) 
    144          WRITE(ctmp4,*) '      ===> output of last computed fields in output.abort.nc file' 
    145           
     182            WRITE(ctmp6,*) '      ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 
     183         ENDIF 
     184         ! 
    146185         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file 
    147           
    148          IF( .NOT. sn_cfctl%l_glochk ) THEN 
    149             WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea 
    150             CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4 ) 
    151          ELSE 
    152             CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4 ) 
    153          ENDIF 
    154  
    155          kindic = -3 
    156          ! 
    157       ENDIF 
    158       ! 
    159 9100  FORMAT (' kt=',i8,'   |ssh| min: ',1pg11.4,', at  i j  : ',2i5) 
    160 9200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5) 
    161 9500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16) 
     186         ! 
     187         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
     188            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ' ', ctmp6 ) 
     189            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     190            ENDIF 
     191         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
     192            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ' ', ctmp6 ) 
     193         ENDIF 
     194         ! 
     195      ENDIF 
     196      ! 
     197      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
     198         ngrdstop = Agrif_Fixed()                                           ! store which grid got this error 
     199         IF( .NOT. ll_colruns .AND. jpnij > 1 )   CALL ctl_stop( 'STOP' )   ! we must abort here to avoid MPI deadlock 
     200      ENDIF 
     201      ! 
     2029500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 
    162203      ! 
    163204   END SUBROUTINE stp_ctl 
     205 
     206 
     207   SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 
     208      !!---------------------------------------------------------------------- 
     209      !!                     ***  ROUTINE wrt_line  *** 
     210      !! 
     211      !! ** Purpose :   write information line 
     212      !! 
     213      !!---------------------------------------------------------------------- 
     214      CHARACTER(len=*),      INTENT(  out) ::   cdline 
     215      CHARACTER(len=*),      INTENT(in   ) ::   cdprefix 
     216      REAL(wp),              INTENT(in   ) ::   pval 
     217      INTEGER, DIMENSION(3), INTENT(in   ) ::   kloc 
     218      INTEGER,               INTENT(in   ) ::   kt, ksum, kmin, kmax 
     219      ! 
     220      CHARACTER(len=80) ::   clsuff 
     221      CHARACTER(len=9 ) ::   clkt, clsum, clmin, clmax 
     222      CHARACTER(len=9 ) ::   cli, clj, clk 
     223      CHARACTER(len=1 ) ::   clfmt 
     224      CHARACTER(len=4 ) ::   cl4   ! needed to be able to compile with Agrif, I don't know why 
     225      INTEGER           ::   ifmtk 
     226      !!---------------------------------------------------------------------- 
     227      WRITE(clkt , '(i9)') kt 
     228       
     229      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
     230      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
     231      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
     232      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9) 
     233      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
     234                                   WRITE(clmax, cl4) kmax-1 
     235      ! 
     236      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1      ! how many digits to we need to write jpiglo? (we decide max = 9) 
     237      cl4 = '(i'//clfmt//')'   ;   WRITE(cli, cl4) kloc(1)      ! this is ok with AGRIF 
     238      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1      ! how many digits to we need to write jpjglo? (we decide max = 9) 
     239      cl4 = '(i'//clfmt//')'   ;   WRITE(clj, cl4) kloc(2)      ! this is ok with AGRIF 
     240      ! 
     241      IF( ksum == 1 ) THEN   ;   WRITE(clsuff,9100) TRIM(clmin) 
     242      ELSE                   ;   WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 
     243      ENDIF 
     244      IF(kloc(3) == 0) THEN 
     245         ifmtk = INT(LOG10(REAL(jpk,wp))) + 1                   ! how many digits to we need to write jpk? (we decide max = 9) 
     246         clk = REPEAT(' ', ifmtk)                               ! create the equivalent in blank string 
     247         WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 
     248      ELSE 
     249         WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1      ! how many digits to we need to write jpk? (we decide max = 9) 
     250         !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
     251         cl4 = '(i'//clfmt//')'   ;   WRITE(clk, cl4) kloc(3)   ! this is ok with AGRIF 
     252         WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj),    TRIM(clk), TRIM(clsuff) 
     253      ENDIF 
     254      ! 
     2559100  FORMAT('MPI rank ', a) 
     2569200  FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 
     2579300  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j   ', a, ' ', a, ' ', a, ' ', a) 
     2589400  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 
     259      ! 
     260   END SUBROUTINE wrt_line 
     261 
    164262 
    165263   !!====================================================================== 
  • NEMO/trunk/tests/CANAL/MY_SRC/domvvl.F90

    r13295 r13458  
    99   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
    1010   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping 
     11   !!            4.x  ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
    1112   !!---------------------------------------------------------------------- 
    1213 
    13    !!---------------------------------------------------------------------- 
    14    !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
    15    !!   dom_vvl_sf_nxt   : Compute next vertical scale factors 
    16    !!   dom_vvl_sf_update   : Swap vertical scale factors and update the vertical grid 
    17    !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 
    18    !!   dom_vvl_rst      : read/write restart file 
    19    !!   dom_vvl_ctl      : Check the vvl options 
    20    !!---------------------------------------------------------------------- 
    2114   USE oce             ! ocean dynamics and tracers 
    2215   USE phycst          ! physical constant 
     
    3629   PRIVATE 
    3730 
    38    PUBLIC  dom_vvl_init       ! called by domain.F90 
    39    PUBLIC  dom_vvl_zgr        ! called by isfcpl.F90 
    40    PUBLIC  dom_vvl_sf_nxt     ! called by step.F90 
    41    PUBLIC  dom_vvl_sf_update  ! called by step.F90 
    42    PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
    43  
    4431   !                                                      !!* Namelist nam_vvl 
    4532   LOGICAL , PUBLIC :: ln_vvl_zstar           = .FALSE.    ! zstar  vertical coordinate 
     
    6350   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence 
    6451 
     52#if defined key_qco 
     53   !!---------------------------------------------------------------------- 
     54   !!   'key_qco'      EMPTY MODULE      Quasi-Eulerian vertical coordonate 
     55   !!---------------------------------------------------------------------- 
     56#else 
     57   !!---------------------------------------------------------------------- 
     58   !!   Default key      Old management of time varying vertical coordinate 
     59   !!---------------------------------------------------------------------- 
     60    
     61   !!---------------------------------------------------------------------- 
     62   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
     63   !!   dom_vvl_sf_nxt   : Compute next vertical scale factors 
     64   !!   dom_vvl_sf_update   : Swap vertical scale factors and update the vertical grid 
     65   !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 
     66   !!   dom_vvl_rst      : read/write restart file 
     67   !!   dom_vvl_ctl      : Check the vvl options 
     68   !!---------------------------------------------------------------------- 
     69 
     70   PUBLIC  dom_vvl_init       ! called by domain.F90 
     71   PUBLIC  dom_vvl_zgr        ! called by isfcpl.F90 
     72   PUBLIC  dom_vvl_sf_nxt     ! called by step.F90 
     73   PUBLIC  dom_vvl_sf_update  ! called by step.F90 
     74   PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
     75    
    6576   !! * Substitutions 
    6677#  include "do_loop_substitute.h90" 
     
    135146      ! 
    136147   END SUBROUTINE dom_vvl_init 
    137    ! 
     148 
     149 
    138150   SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa) 
    139151      !!---------------------------------------------------------------------- 
     
    261273            IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
    262274               IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    263                   ii0 = 103   ;   ii1 = 111        
    264                   ij0 = 128   ;   ij1 = 135   ;    
     275                  ii0 = 103 + nn_hls - 1   ;   ii1 = 111 + nn_hls - 1       
     276                  ij0 = 128 + nn_hls       ;   ij1 = 135 + nn_hls 
    265277                  frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    266278                  frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rn_Dt 
     
    322334      LOGICAL                ::   ll_do_bclinic         ! local logical 
    323335      REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
    324       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t 
     336      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ze3t 
     337      LOGICAL , DIMENSION(:,:,:), ALLOCATABLE ::   llmsk 
    325338      !!---------------------------------------------------------------------- 
    326339      ! 
     
    435448         ! Maximum deformation control 
    436449         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    437          ze3t(:,:,jpk) = 0._wp 
    438          DO jk = 1, jpkm1 
    439             ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    440          END DO 
    441          z_tmax = MAXVAL( ze3t(:,:,:) ) 
    442          CALL mpp_max( 'domvvl', z_tmax )                 ! max over the global domain 
    443          z_tmin = MINVAL( ze3t(:,:,:) ) 
    444          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 
    445463         ! - ML - test: for the moment, stop simulation for too large e3_t variations 
    446464         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 
    447             IF( lk_mpp ) THEN 
    448                CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 
    449                CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 
    450             ELSE 
    451                ijk_max = MAXLOC( ze3t(:,:,:) ) 
    452                ijk_max(1) = mig0_oldcmp(ijk_max(1)) 
    453                ijk_max(2) = mjg0_oldcmp(ijk_max(2)) 
    454                ijk_min = MINLOC( ze3t(:,:,:) ) 
    455                ijk_min(1) = mig0_oldcmp(ijk_min(1)) 
    456                ijk_min(2) = mjg0_oldcmp(ijk_min(2)) 
    457             ENDIF 
     465            CALL mpp_maxloc( 'domvvl', ze3t, llmsk, z_tmax, ijk_max ) 
     466            CALL mpp_minloc( 'domvvl', ze3t, llmsk, z_tmin, ijk_min ) 
    458467            IF (lwp) THEN 
    459468               WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax 
     
    464473            ENDIF 
    465474         ENDIF 
     475         DEALLOCATE( ze3t, llmsk ) 
    466476         ! - ML - end test 
    467477         ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 
     
    10301040   END SUBROUTINE dom_vvl_ctl 
    10311041 
     1042#endif 
     1043 
    10321044   !!====================================================================== 
    10331045END MODULE domvvl 
  • NEMO/trunk/tests/CANAL/MY_SRC/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 
  • NEMO/trunk/tests/STATION_ASF/MY_SRC/stpctl.F90

    r13136 r13458  
    4747      !! 
    4848      !! ** Method  : - Save the time step in numstp 
    49       !!              - Print it each 50 time steps 
    5049      !!              - Stop the run IF problem encountered by setting nstop > 0 
    5150      !!                Problems checked: wind stress module  max larger than 5 N/m^2 
     
    110109      !                                   !==            test of local extrema           ==! 
    111110      !                                   !==  done by all processes at every time step  ==! 
    112       llmsk(:,:) = tmask(:,:,1) == 1._wp 
     111      ! 
     112      llmsk(   1:Nis1,:) = .FALSE.                                              ! exclude halos from the checked region 
     113      llmsk(Nie1: jpi,:) = .FALSE. 
     114      llmsk(:,   1:Njs1) = .FALSE. 
     115      llmsk(:,Nje1: jpj) = .FALSE. 
     116      ! 
     117      llmsk(Nis0:Nie0,Njs0:Nje0) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp   ! test only the inner domain 
    113118      IF( COUNT( llmsk(:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
    114119         zmax(1) = MAXVAL(     taum(:,:)   , mask = llmsk )   ! max wind stress module 
     
    153158            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
    154159            ! get global loc on the min/max 
    155             CALL mpp_maxloc( 'stpctl',    taum(:,:)  , tmask(:,:,1), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
    156             CALL mpp_maxloc( 'stpctl',ABS( qns(:,:) ), tmask(:,:,1), zzz, iloc(1:2,2) ) 
    157             CALL mpp_minloc( 'stpctl',ABS( emp(:,:) ), tmask(:,:,1), zzz, iloc(1:2,3) ) 
     160            CALL mpp_maxloc( 'stpctl',    taum(:,:)  , llmsk, zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     161            CALL mpp_maxloc( 'stpctl',ABS( qns(:,:) ), llmsk, zzz, iloc(1:2,2) ) 
     162            CALL mpp_minloc( 'stpctl',ABS( emp(:,:) ), llmsk, zzz, iloc(1:2,3) ) 
    158163            ! find which subdomain has the max. 
    159164            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
     
    168173         ELSE                    ! find local min and max locations: 
    169174            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
    170             iloc(1:2,1) = MAXLOC(     taum(:,:)  , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
    171             iloc(1:2,2) = MAXLOC( ABS( qns(:,:) ), mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
    172             iloc(1:2,3) = MINLOC( ABS( emp(:,:) ), mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
     175            iloc(1:2,1) = MAXLOC(     taum(:,:)  , mask = llmsk ) 
     176            iloc(1:2,2) = MAXLOC( ABS( qns(:,:) ), mask = llmsk ) 
     177            iloc(1:2,3) = MINLOC( ABS( emp(:,:) ), mask = llmsk ) 
     178            DO ji = 1, 3   ! local domain indices ==> global domain indices, excluding halos 
     179               iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 
     180            END DO 
    173181            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
    174182         ENDIF 
  • NEMO/trunk/tests/VORTEX/MY_SRC/domvvl.F90

    r13295 r13458  
    99   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
    1010   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping 
     11   !!            4.x  ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
    1112   !!---------------------------------------------------------------------- 
    1213 
    13    !!---------------------------------------------------------------------- 
    14    !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
    15    !!   dom_vvl_sf_nxt   : Compute next vertical scale factors 
    16    !!   dom_vvl_sf_update   : Swap vertical scale factors and update the vertical grid 
    17    !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 
    18    !!   dom_vvl_rst      : read/write restart file 
    19    !!   dom_vvl_ctl      : Check the vvl options 
    20    !!---------------------------------------------------------------------- 
    2114   USE oce             ! ocean dynamics and tracers 
    2215   USE phycst          ! physical constant 
     
    3629   PRIVATE 
    3730 
    38    PUBLIC  dom_vvl_init       ! called by domain.F90 
    39    PUBLIC  dom_vvl_zgr        ! called by isfcpl.F90 
    40    PUBLIC  dom_vvl_sf_nxt     ! called by step.F90 
    41    PUBLIC  dom_vvl_sf_update  ! called by step.F90 
    42    PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
    43  
    4431   !                                                      !!* Namelist nam_vvl 
    4532   LOGICAL , PUBLIC :: ln_vvl_zstar           = .FALSE.    ! zstar  vertical coordinate 
     
    6350   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence 
    6451 
     52#if defined key_qco 
     53   !!---------------------------------------------------------------------- 
     54   !!   'key_qco'      EMPTY MODULE      Quasi-Eulerian vertical coordonate 
     55   !!---------------------------------------------------------------------- 
     56#else 
     57   !!---------------------------------------------------------------------- 
     58   !!   Default key      Old management of time varying vertical coordinate 
     59   !!---------------------------------------------------------------------- 
     60    
     61   !!---------------------------------------------------------------------- 
     62   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
     63   !!   dom_vvl_sf_nxt   : Compute next vertical scale factors 
     64   !!   dom_vvl_sf_update   : Swap vertical scale factors and update the vertical grid 
     65   !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 
     66   !!   dom_vvl_rst      : read/write restart file 
     67   !!   dom_vvl_ctl      : Check the vvl options 
     68   !!---------------------------------------------------------------------- 
     69 
     70   PUBLIC  dom_vvl_init       ! called by domain.F90 
     71   PUBLIC  dom_vvl_zgr        ! called by isfcpl.F90 
     72   PUBLIC  dom_vvl_sf_nxt     ! called by step.F90 
     73   PUBLIC  dom_vvl_sf_update  ! called by step.F90 
     74   PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
     75    
    6576   !! * Substitutions 
    6677#  include "do_loop_substitute.h90" 
     
    135146      ! 
    136147   END SUBROUTINE dom_vvl_init 
    137    ! 
     148 
     149 
    138150   SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa) 
    139151      !!---------------------------------------------------------------------- 
     
    261273            IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
    262274               IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    263                   ii0 = 103   ;   ii1 = 111        
    264                   ij0 = 128   ;   ij1 = 135   ;    
     275                  ii0 = 103 + nn_hls - 1   ;   ii1 = 111 + nn_hls - 1       
     276                  ij0 = 128 + nn_hls       ;   ij1 = 135 + nn_hls 
    265277                  frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    266278                  frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rn_Dt 
     
    322334      LOGICAL                ::   ll_do_bclinic         ! local logical 
    323335      REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
    324       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t 
     336      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ze3t 
     337      LOGICAL , DIMENSION(:,:,:), ALLOCATABLE ::   llmsk 
    325338      !!---------------------------------------------------------------------- 
    326339      ! 
     
    435448         ! Maximum deformation control 
    436449         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    437          ze3t(:,:,jpk) = 0._wp 
    438          DO jk = 1, jpkm1 
    439             ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    440          END DO 
    441          z_tmax = MAXVAL( ze3t(:,:,:) ) 
    442          CALL mpp_max( 'domvvl', z_tmax )                 ! max over the global domain 
    443          z_tmin = MINVAL( ze3t(:,:,:) ) 
    444          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 
    445463         ! - ML - test: for the moment, stop simulation for too large e3_t variations 
    446464         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 
    447             IF( lk_mpp ) THEN 
    448                CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 
    449                CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 
    450             ELSE 
    451                ijk_max = MAXLOC( ze3t(:,:,:) ) 
    452                ijk_max(1) = mig0_oldcmp(ijk_max(1)) 
    453                ijk_max(2) = mjg0_oldcmp(ijk_max(2)) 
    454                ijk_min = MINLOC( ze3t(:,:,:) ) 
    455                ijk_min(1) = mig0_oldcmp(ijk_min(1)) 
    456                ijk_min(2) = mjg0_oldcmp(ijk_min(2)) 
    457             ENDIF 
     465            CALL mpp_maxloc( 'domvvl', ze3t, llmsk, z_tmax, ijk_max ) 
     466            CALL mpp_minloc( 'domvvl', ze3t, llmsk, z_tmin, ijk_min ) 
    458467            IF (lwp) THEN 
    459468               WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax 
     
    464473            ENDIF 
    465474         ENDIF 
     475         DEALLOCATE( ze3t, llmsk ) 
    466476         ! - ML - end test 
    467477         ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 
     
    10301040   END SUBROUTINE dom_vvl_ctl 
    10311041 
     1042#endif 
     1043 
    10321044   !!====================================================================== 
    10331045END MODULE domvvl 
Note: See TracChangeset for help on using the changeset viewer.