New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13710 for NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX – NEMO

Ignore:
Timestamp:
2020-11-02T10:56:42+01:00 (4 years ago)
Author:
emanuelaclementi
Message:

branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves: merge with trunk@13708, see #2155 and #2339

Location:
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@13559        sette 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/EXPREF/1_context_nemo.xml

    r12276 r13710  
    1111       <variable id="ref_month" type="int"> 01 </variable> 
    1212       <variable id="ref_day"   type="int"> 01 </variable> 
    13        <variable id="rau0"      type="float" > 1026.0 </variable> 
     13       <variable id="rho0"      type="float" > 1026.0 </variable> 
    1414       <variable id="cpocean"   type="float" > 3991.86795711963 </variable> 
    1515       <variable id="convSpsu"  type="float" > 0.99530670233846  </variable> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/EXPREF/1_namelist_cfg

    r12489 r13710  
    9898&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    9999!----------------------------------------------------------------------- 
    100    ln_spc_dyn    = .true.  !  use 0 as special value for dynamics 
    101    rn_sponge_tra =  800.   !  coefficient for tracer   sponge layer [m2/s] 
    102    rn_sponge_dyn =  800.   !  coefficient for dynamics sponge layer [m2/s] 
    103    ln_chk_bathy  = .FALSE. ! 
     100   rn_sponge_tra =  0.00768   !  coefficient for tracer   sponge layer [] 
     101   rn_sponge_dyn =  0.00768   !  coefficient for dynamics sponge layer [] 
    104102/ 
    105103!!====================================================================== 
    … …  
    107105!!                                                                    !! 
    108106!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    109 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    110 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     107!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     108!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    111109!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    112110!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    116114&namdrg        !   top/bottom drag coefficient                          (default: NO selection) 
    117115!----------------------------------------------------------------------- 
    118    ln_OFF     = .true.    !  free-slip       : Cd = 0 
     116   ln_drg_OFF = .true.     !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    119117/ 
    120118!!====================================================================== 
    … …  
    133131!----------------------------------------------------------------------- 
    134132   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    135       !                            !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     133      !                            !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    136134      rn_a0       =  0.28        !  thermal expension coefficient (for simplified equation of state) 
    137135      rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state) 
    … …  
    268266!!                                                                    !! 
    269267!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    270 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    271268!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    272269!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/EXPREF/context_nemo.xml

    r12276 r13710  
    1111       <variable id="ref_month" type="int"> 01 </variable> 
    1212       <variable id="ref_day"   type="int"> 01 </variable> 
    13        <variable id="rau0"      type="float" > 1026.0 </variable> 
     13       <variable id="rho0"      type="float" > 1026.0 </variable> 
    1414       <variable id="cpocean"   type="float" > 3991.86795711963 </variable> 
    1515       <variable id="convSpsu"  type="float" > 0.99530670233846  </variable> 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/EXPREF/namelist_cfg

    r12489 r13710  
    9999!!                                                                    !! 
    100100!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    101 !!   namdrg_top    top    friction                                      (ln_OFF=F & ln_isfcav=T) 
    102 !!   namdrg_bot    bottom friction                                      (ln_OFF=F) 
     101!!   namdrg_top    top    friction                                      (ln_drg_OFF=F & ln_isfcav=T) 
     102!!   namdrg_bot    bottom friction                                      (ln_drg_OFF=F) 
    103103!!   nambbc        bottom temperature boundary condition                (default: OFF) 
    104104!!   nambbl        bottom boundary layer scheme                         (default: OFF) 
    … …  
    108108&namdrg        !   top/bottom drag coefficient                          (default: NO selection) 
    109109!----------------------------------------------------------------------- 
    110    ln_OFF     = .true.    !  free-slip       : Cd = 0 
     110   ln_drg_OFF  = .true.   !  free-slip       : Cd = 0                  (F => fill namdrg_bot 
    111111/ 
    112112!!====================================================================== 
    … …  
    125125!----------------------------------------------------------------------- 
    126126   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS) 
    127    !                            !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     127   !                            !  rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
    128128   rn_a0       =  0.28        !  thermal expension coefficient (for simplified equation of state) 
    129129   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state) 
    … …  
    259259!!                                                                    !! 
    260260!!   namtrd       dynamics and/or tracer trends                         (default: OFF) 
    261 !!   namptr       Poleward Transport Diagnostics                        (default: OFF) 
    262261!!   namhsb       Heat and salt budgets                                 (default: OFF) 
    263262!!   namdiu       Cool skin and warm layer models                       (default: OFF) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/MY_SRC/domvvl.F90

    r12489 r13710  
    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    
     76   !! * Substitutions 
     77#  include "do_loop_substitute.h90" 
    6578   !!---------------------------------------------------------------------- 
    6679   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    133146      ! 
    134147   END SUBROUTINE dom_vvl_init 
    135    ! 
     148 
     149 
    136150   SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa) 
    137151      !!---------------------------------------------------------------------- 
    … …  
    188202      gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 
    189203      gdepw(:,:,1,Kbb) = 0.0_wp 
    190       DO jk = 2, jpk                               ! vertical sum 
    191          DO jj = 1,jpj 
    192             DO ji = 1,jpi 
    193                !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    194                !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
    195                !                             ! 0.5 where jk = mikt      
     204      DO_3D( 1, 1, 1, 1, 2, jpk ) 
     205         !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
     206         !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
     207         !                             ! 0.5 where jk = mikt      
    196208!!gm ???????   BUG ?  gdept(:,:,:,Kmm) as well as gde3w  does not include the thickness of ISF ?? 
    197                zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 
    198                gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    199                gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  & 
    200                   &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm))  
    201                gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
    202                gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 
    203                gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  & 
    204                   &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb))  
    205             END DO 
    206          END DO 
    207       END DO 
     209         zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 
     210         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
     211         gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  & 
     212            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm))  
     213         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
     214         gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 
     215         gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  & 
     216            &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb))  
     217      END_3D 
    208218      ! 
    209219      !                    !==  thickness of the water column  !!   (ocean portion only) 
    … …  
    240250         ENDIF 
    241251         IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator 
    242             DO jj = 1, jpj 
    243                DO ji = 1, jpi 
     252            DO_2D( 1, 1, 1, 1 ) 
    244253!!gm  case |gphi| >= 6 degrees is useless   initialized just above by default 
    245                   IF( ABS(gphit(ji,jj)) >= 6.) THEN 
    246                      ! values outside the equatorial band and transition zone (ztilde) 
    247                      frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp ) 
    248                      frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 
    249                   ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star 
    250                      ! values inside the equatorial band (ztilde as zstar) 
    251                      frq_rst_e3t(ji,jj) =  0.0_wp 
    252                      frq_rst_hdv(ji,jj) =  1.0_wp / rn_Dt 
    253                   ELSE                                      ! transition band (2.5 to 6 degrees N/S) 
    254                      !                                      ! (linearly transition from z-tilde to z-star) 
    255                      frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   & 
    256                         &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
    257                         &                                          * 180._wp / 3.5_wp ) ) 
    258                      frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt)                                & 
    259                         &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp   & 
    260                         &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
    261                         &                                          * 180._wp / 3.5_wp ) ) 
    262                   ENDIF 
    263                END DO 
    264             END DO 
     254               IF( ABS(gphit(ji,jj)) >= 6.) THEN 
     255                  ! values outside the equatorial band and transition zone (ztilde) 
     256                  frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp ) 
     257                  frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 
     258               ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star 
     259                  ! values inside the equatorial band (ztilde as zstar) 
     260                  frq_rst_e3t(ji,jj) =  0.0_wp 
     261                  frq_rst_hdv(ji,jj) =  1.0_wp / rn_Dt 
     262               ELSE                                      ! transition band (2.5 to 6 degrees N/S) 
     263                  !                                      ! (linearly transition from z-tilde to z-star) 
     264                  frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   & 
     265                     &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
     266                     &                                          * 180._wp / 3.5_wp ) ) 
     267                  frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt)                                & 
     268                     &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp   & 
     269                     &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
     270                     &                                          * 180._wp / 3.5_wp ) ) 
     271               ENDIF 
     272            END_2D 
    265273            IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
    266274               IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    267                   ii0 = 103   ;   ii1 = 111        
    268                   ij0 = 128   ;   ij1 = 135   ;    
     275                  ii0 = 103 + nn_hls - 1   ;   ii1 = 111 + nn_hls - 1       
     276                  ij0 = 128 + nn_hls       ;   ij1 = 135 + nn_hls 
    269277                  frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    270278                  frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rn_Dt 
    … …  
    326334      LOGICAL                ::   ll_do_bclinic         ! local logical 
    327335      REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
    328       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t 
     336      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ze3t 
     337      LOGICAL , DIMENSION(:,:,:), ALLOCATABLE ::   llmsk 
    329338      !!---------------------------------------------------------------------- 
    330339      ! 
    … …  
    357366      END DO 
    358367      ! 
    359       IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate ! 
    360          !                                                            ! ------baroclinic part------ ! 
     368      IF( (ln_vvl_ztilde .OR. ln_vvl_layer) .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate ! 
     369         !                                                               ! ------baroclinic part------ ! 
    361370         ! I - initialization 
    362371         ! ================== 
    … …  
    411420         zwu(:,:) = 0._wp 
    412421         zwv(:,:) = 0._wp 
    413          DO jk = 1, jpkm1        ! a - first derivative: diffusive fluxes 
    414             DO jj = 1, jpjm1 
    415                DO ji = 1, jpim1   ! vector opt. 
    416                   un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           & 
    417                      &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
    418                   vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           &  
    419                      &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
    420                   zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 
    421                   zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 
    422                END DO 
    423             END DO 
    424          END DO 
    425          DO jj = 1, jpj          ! b - correction for last oceanic u-v points 
    426             DO ji = 1, jpi 
    427                un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 
    428                vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 
    429             END DO 
    430          END DO 
    431          DO jk = 1, jpkm1        ! c - second derivative: divergence of diffusive fluxes 
    432             DO jj = 2, jpjm1 
    433                DO ji = 2, jpim1   ! vector opt. 
    434                   tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    & 
    435                      &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    & 
    436                      &                                            ) * r1_e1e2t(ji,jj) 
    437                END DO 
    438             END DO 
    439          END DO 
     422         DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     423            un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           & 
     424               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
     425            vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           &  
     426               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
     427            zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 
     428            zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 
     429         END_3D 
     430         DO_2D( 1, 1, 1, 1 ) 
     431            un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 
     432            vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 
     433         END_2D 
     434         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     435            tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    & 
     436               &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    & 
     437               &                                            ) * r1_e1e2t(ji,jj) 
     438         END_3D 
    440439         !                       ! d - thickness diffusion transport: boundary conditions 
    441440         !                             (stored for tracer advction and continuity equation) 
    … …  
    444443         ! 4 - Time stepping of baroclinic scale factors 
    445444         ! --------------------------------------------- 
    446          ! Leapfrog time stepping 
    447          ! ~~~~~~~~~~~~~~~~~~~~~~ 
    448445         CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 
    449446         tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + rDt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 
    … …  
    451448         ! Maximum deformation control 
    452449         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    453          ze3t(:,:,jpk) = 0._wp 
    454          DO jk = 1, jpkm1 
    455             ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    456          END DO 
    457          z_tmax = MAXVAL( ze3t(:,:,:) ) 
    458          CALL mpp_max( 'domvvl', z_tmax )                 ! max over the global domain 
    459          z_tmin = MINVAL( ze3t(:,:,:) ) 
    460          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 
    461463         ! - ML - test: for the moment, stop simulation for too large e3_t variations 
    462464         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 
    463             IF( lk_mpp ) THEN 
    464                CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 
    465                CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 
    466             ELSE 
    467                ijk_max = MAXLOC( ze3t(:,:,:) ) 
    468                ijk_max(1) = ijk_max(1) + nimpp - 1 
    469                ijk_max(2) = ijk_max(2) + njmpp - 1 
    470                ijk_min = MINLOC( ze3t(:,:,:) ) 
    471                ijk_min(1) = ijk_min(1) + nimpp - 1 
    472                ijk_min(2) = ijk_min(2) + njmpp - 1 
    473             ENDIF 
     465            CALL mpp_maxloc( 'domvvl', ze3t, llmsk, z_tmax, ijk_max ) 
     466            CALL mpp_minloc( 'domvvl', ze3t, llmsk, z_tmin, ijk_min ) 
    474467            IF (lwp) THEN 
    475468               WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax 
    … …  
    480473            ENDIF 
    481474         ENDIF 
     475         DEALLOCATE( ze3t, llmsk ) 
    482476         ! - ML - end test 
    483477         ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 
    … …  
    646640      ! Horizontal scale factor interpolations 
    647641      ! -------------------------------------- 
    648       ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are allready computed in dynnxt 
     642      ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 
    649643      ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 
    650644       
    … …  
    663657      gdepw(:,:,1,Kmm) = 0.0_wp 
    664658      gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
    665       DO jk = 2, jpk 
    666          DO jj = 1,jpj 
    667             DO ji = 1,jpi 
    668               !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    669                                                                  ! 1 for jk = mikt 
    670                zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
    671                gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    672                gdept(ji,jj,jk,Kmm) =    zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) )  & 
    673                    &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) )  
    674                gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
    675             END DO 
    676          END DO 
    677       END DO 
     659      DO_3D( 1, 1, 1, 1, 2, jpk ) 
     660        !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
     661                                                           ! 1 for jk = mikt 
     662         zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
     663         gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
     664         gdept(ji,jj,jk,Kmm) =    zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) )  & 
     665             &             + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm) )  
     666         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
     667      END_3D 
    678668 
    679669      ! Local depth and Inverse of the local depth of the water 
    … …  
    722712         ! 
    723713      CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean 
    724          DO jk = 1, jpk 
    725             DO jj = 1, jpjm1 
    726                DO ji = 1, jpim1   ! vector opt. 
    727                   pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   & 
    728                      &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     & 
    729                      &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 
    730                END DO 
    731             END DO 
    732          END DO 
     714         DO_3D( 1, 0, 1, 0, 1, jpk ) 
     715            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   & 
     716               &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     & 
     717               &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 
     718         END_3D 
    733719         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 
    734720         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 
    735721         ! 
    736722      CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean 
    737          DO jk = 1, jpk 
    738             DO jj = 1, jpjm1 
    739                DO ji = 1, jpim1   ! vector opt. 
    740                   pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   & 
    741                      &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     & 
    742                      &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 
    743                END DO 
    744             END DO 
    745          END DO 
     723         DO_3D( 1, 0, 1, 0, 1, jpk ) 
     724            pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   & 
     725               &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     & 
     726               &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 
     727         END_3D 
    746728         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 
    747729         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 
    748730         ! 
    749731      CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean 
    750          DO jk = 1, jpk 
    751             DO jj = 1, jpjm1 
    752                DO ji = 1, jpim1   ! vector opt. 
    753                   pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 
    754                      &                       *    r1_e1e2f(ji,jj)                                                  & 
    755                      &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     & 
    756                      &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 
    757                END DO 
    758             END DO 
    759          END DO 
     732         DO_3D( 1, 0, 1, 0, 1, jpk ) 
     733            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 
     734               &                       *    r1_e1e2f(ji,jj)                                                  & 
     735               &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     & 
     736               &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 
     737         END_3D 
    760738         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 
    761739         pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 
    … …  
    825803         IF( ln_rstart ) THEN                   !* Read the restart file 
    826804            CALL rst_read_open                  !  open the restart file if necessary 
    827             CALL iom_get( numror, jpdom_autoglo, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     805            CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
    828806            ! 
    829807            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    … …  
    832810            id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 
    833811            id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 
     812            ! 
    834813            !                             ! --------- ! 
    835814            !                             ! all cases ! 
    836815            !                             ! --------- ! 
     816            ! 
    837817            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    838                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    839                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     818               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     819               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    840820               ! needed to restart if land processor not computed  
    841821               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    … …  
    850830               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files' 
    851831               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    852                IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.' 
    853                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     832               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
     833               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    854834               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    855835               l_1st_euler = .true. 
    … …  
    857837               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files' 
    858838               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    859                IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.' 
    860                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     839               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
     840               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    861841               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    862842               l_1st_euler = .true. 
    … …  
    864844               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file' 
    865845               IF(lwp) write(numout,*) 'Compute scale factor from sshn' 
    866                IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.' 
     846               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    867847               DO jk = 1, jpk 
    868848                  e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 
    … …  
    883863               !                          ! ----------------------- ! 
    884864               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    885                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
    886                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
     865                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
     866                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
    887867               ELSE                            ! one at least array is missing 
    888868                  tilde_e3t_b(:,:,:) = 0.0_wp 
    … …  
    893873                  !                       ! ------------ ! 
    894874                  IF( id5 > 0 ) THEN  ! required array exists 
    895                      CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
     875                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
    896876                  ELSE                ! array is missing 
    897877                     hdiv_lf(:,:,:) = 0.0_wp 
    … …  
    917897                  ssh(:,:,Kbb) = -ssh_ref 
    918898 
    919                   DO jj = 1, jpj 
    920                      DO ji = 1, jpi 
    921                         IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth 
    922                            ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 
    923                            ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 
    924                         ENDIF 
    925                      ENDDO 
    926                   ENDDO 
     899                  DO_2D( 1, 1, 1, 1 ) 
     900                     IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth 
     901                        ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 
     902                        ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 
     903                     ENDIF 
     904                  END_2D 
    927905               ENDIF !If test case else 
    928906 
    … …  
    935913               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    936914 
    937                DO ji = 1, jpi 
    938                   DO jj = 1, jpj 
    939                      IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
    940                        CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
    941                      ENDIF 
    942                   END DO  
    943                END DO  
     915               DO_2D( 1, 1, 1, 1 ) 
     916                  IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
     917                     CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
     918                  ENDIF 
     919               END_2D 
    944920               ! 
    945921            ELSE 
    … …  
    10641040   END SUBROUTINE dom_vvl_ctl 
    10651041 
     1042#endif 
     1043 
    10661044   !!====================================================================== 
    10671045END MODULE domvvl 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/MY_SRC/usrdef_hgr.F90

    r10074 r13710  
    2626   PUBLIC   usr_def_hgr   ! called by domhgr.F90 
    2727 
     28   !! * Substitutions 
     29#  include "do_loop_substitute.h90" 
    2830   !!---------------------------------------------------------------------- 
    2931   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6163      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 
    6264      ! 
    63       INTEGER  ::   ji, jj   ! dummy loop indices 
     65      INTEGER  ::   ji, jj     ! dummy loop indices 
    6466      REAL(wp) ::   zphi0, zlam0, zbeta, zf0 
    65       REAL(wp) ::   zti, zui, ztj, zvj   ! local scalars 
     67      REAL(wp) ::   zti, ztj   ! local scalars 
    6668      !!------------------------------------------------------------------------------- 
    6769      ! 
    … …  
    7577      ! Position coordinates (in kilometers) 
    7678      !                          ========== 
    77       zlam0 = -(jpiglo-1)/2 * 1.e-3 * rn_dx 
    78       zphi0 = -(jpjglo-1)/2 * 1.e-3 * rn_dy  
    79  
     79#if defined key_agrif  
     80      IF( Agrif_Root() ) THEN 
     81#endif 
     82         ! Compatibility WITH old version:  
     83         ! jperio = 0 =>  Ni0glo = jpigo_old_version 
     84         !            =>  jpiglo-1 replaced by Ni0glo-1 
     85         zlam0 = -REAL( (Ni0glo-1)/2, wp) * 1.e-3 * rn_dx 
     86         zphi0 = -REAL( (Nj0glo-1)/2, wp) * 1.e-3 * rn_dy  
    8087#if defined key_agrif 
    81       ! ! let lower left longitude and latitude from parent 
    82       IF (.NOT.Agrif_root()) THEN 
    83           zlam0 = (0.5_wp-(Agrif_parent(jpiglo)-1)/2)*1.e-3*Agrif_irhox()*rn_dx & 
    84              &+(Agrif_Ix()+nbghostcells-1)*Agrif_irhox()*rn_dx*1.e-3-(0.5_wp+nbghostcells)*rn_dx*1.e-3 
    85           zphi0 = (0.5_wp-(Agrif_parent(jpjglo)-1)/2)*1.e-3*Agrif_irhoy()*rn_dy & 
    86              &+(Agrif_Iy()+nbghostcells-1)*Agrif_irhoy()*rn_dy*1.e-3-(0.5_wp+nbghostcells)*rn_dy*1.e-3 
     88      ELSE 
     89         ! ! let lower left longitude and latitude from parent 
     90         ! Compatibility WITH old version:  
     91         ! jperio = 0 =>  Ni0glo = jpigo_old_version 
     92         !            =>  Agrif_parent(jpiglo)-1 replaced by  Agrif_parent(Ni0glo)-1 
     93         zlam0 = ( 0.5_wp - REAL( ( Agrif_parent(Ni0glo)-1 ) / 2, wp) ) * 1.e-3 * Agrif_irhox() * rn_dx  & 
     94            &  + ( Agrif_Ix() + nbghostcells - 1 ) * Agrif_irhox() * rn_dx * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dx * 1.e-3 
     95         zphi0 = ( 0.5_wp - REAL( ( Agrif_parent(Nj0glo)-1 ) / 2, wp) ) * 1.e-3 * Agrif_irhoy() * rn_dy  & 
     96            &  + ( Agrif_Iy() + nbghostcells - 1 ) * Agrif_irhoy() * rn_dy * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dy * 1.e-3 
    8797      ENDIF  
    8898#endif 
    8999          
    90       DO jj = 1, jpj 
    91          DO ji = 1, jpi 
    92             zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) 
    93             zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 
    94  
    95             plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 
    96             plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 
    97             plamv(ji,jj) = plamt(ji,jj)  
    98             plamf(ji,jj) = plamu(ji,jj)  
    99     
    100             pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 
    101             pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 
    102             pphiu(ji,jj) = pphit(ji,jj)  
    103             pphif(ji,jj) = pphiv(ji,jj)  
    104          END DO 
    105       END DO 
     100      DO_2D( 1, 1, 1, 1 ) 
     101         zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
     102         ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
     103          
     104         plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 *   zti 
     105         plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 
     106         plamv(ji,jj) = plamt(ji,jj)  
     107         plamf(ji,jj) = plamu(ji,jj)  
     108          
     109         pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 *   ztj 
     110         pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 
     111         pphiu(ji,jj) = pphit(ji,jj)  
     112         pphif(ji,jj) = pphiv(ji,jj)  
     113      END_2D 
    106114      !      
    107115      ! Horizontal scale factors (in meters) 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/MY_SRC/usrdef_istate.F90

    r12489 r13710  
    2828   PUBLIC   usr_def_istate   ! called by istate.F90 
    2929 
     30   !! * Substitutions 
     31#  include "do_loop_substitute.h90" 
    3032   !!---------------------------------------------------------------------- 
    3133   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7375      ! Sea level: 
    7476      za = -zP0 * (1._wp-EXP(-zH)) / (grav*(zH-1._wp + EXP(-zH))) 
    75       DO ji=1, jpi 
    76          DO jj=1, jpj 
    77             zx = glamt(ji,jj) * 1.e3 
    78             zy = gphit(ji,jj) * 1.e3 
    79             zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2) 
    80             pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1) 
    81          END DO 
    82       END DO 
     77      DO_2D( 1, 1, 1, 1 ) 
     78         zx = glamt(ji,jj) * 1.e3 
     79         zy = gphit(ji,jj) * 1.e3 
     80         zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2) 
     81         pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1) 
     82      END_2D 
    8383      ! 
    8484      ! temperature:          
    85       DO ji=1, jpi 
    86          DO jj=1, jpj 
    87             zx = glamt(ji,jj) * 1.e3 
    88             zy = gphit(ji,jj) * 1.e3 
    89             DO jk=1,jpk 
    90                zdt =  pdept(ji,jj,jk)  
    91                zrho1 = rho0 * (1._wp + zn2*zdt/grav) 
    92                IF (zdt < zH) THEN 
    93                   zrho1 = zrho1 - zP0 * (1._wp-EXP(zdt-zH)) & 
    94                           & * EXP(-(zx**2+zy**2)/zlambda**2) / (grav*(zH -1._wp + exp(-zH))); 
    95                ENDIF 
    96                pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 
    97             END DO 
     85      DO_2D( 1, 1, 1, 1 ) 
     86         zx = glamt(ji,jj) * 1.e3 
     87         zy = gphit(ji,jj) * 1.e3 
     88         DO jk=1,jpk 
     89            zdt =  pdept(ji,jj,jk)  
     90            zrho1 = rho0 * (1._wp + zn2*zdt/grav) 
     91            IF (zdt < zH) THEN 
     92               zrho1 = zrho1 - zP0 * (1._wp-EXP(zdt-zH)) & 
     93                  & * EXP(-(zx**2+zy**2)/zlambda**2) / (grav*(zH -1._wp + EXP(-zH))); 
     94            ENDIF 
     95            pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 
    9896         END DO 
    99       END DO 
     97      END_2D 
    10098      ! 
    10199      ! salinity:   
    … …  
    104102      ! velocities: 
    105103      za = 2._wp * zP0 / (zf0 * rho0 * zlambda**2) 
    106       DO ji=1, jpim1 
    107          DO jj=1, jpj 
    108             zx = glamu(ji,jj) * 1.e3 
    109             zy = gphiu(ji,jj) * 1.e3 
    110             DO jk=1, jpk 
    111                zdu = 0.5_wp * (pdept(ji  ,jj,jk) + pdept(ji+1,jj,jk)) 
    112                IF (zdu < zH) THEN 
    113                   zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 
    114                   pu(ji,jj,jk) = (za * zf * zy * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 
    115                ELSE 
    116                   pu(ji,jj,jk) = 0._wp 
    117                ENDIF 
    118             END DO 
     104      DO_2D( 0, 0, 0, 0 ) 
     105         zx = glamu(ji,jj) * 1.e3 
     106         zy = gphiu(ji,jj) * 1.e3 
     107         DO jk=1, jpk 
     108            zdu = 0.5_wp * (pdept(ji  ,jj,jk) + pdept(ji+1,jj,jk)) 
     109            IF (zdu < zH) THEN 
     110               zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 
     111               pu(ji,jj,jk) = (za * zf * zy * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 
     112            ELSE 
     113               pu(ji,jj,jk) = 0._wp 
     114            ENDIF 
    119115         END DO 
    120       END DO 
     116      END_2D 
    121117      ! 
    122       DO ji=1, jpi 
    123          DO jj=1, jpjm1 
    124             zx = glamv(ji,jj) * 1.e3 
    125             zy = gphiv(ji,jj) * 1.e3 
    126             DO jk=1, jpk 
    127                zdv = 0.5_wp * (pdept(ji  ,jj,jk) + pdept(ji,jj+1,jk)) 
    128                IF (zdv < zH) THEN 
    129                   zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 
    130                   pv(ji,jj,jk) = -(za * zf * zx * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 
    131                ELSE 
    132                   pv(ji,jj,jk) = 0._wp 
    133                ENDIF 
    134             END DO 
     118      DO_2D( 0, 0, 0, 0 ) 
     119         zx = glamv(ji,jj) * 1.e3 
     120         zy = gphiv(ji,jj) * 1.e3 
     121         DO jk=1, jpk 
     122            zdv = 0.5_wp * (pdept(ji  ,jj,jk) + pdept(ji,jj+1,jk)) 
     123            IF (zdv < zH) THEN 
     124               zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 
     125               pv(ji,jj,jk) = -(za * zf * zx * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 
     126            ELSE 
     127               pv(ji,jj,jk) = 0._wp 
     128            ENDIF 
    135129         END DO 
    136       END DO 
    137  
    138       CALL lbc_lnk( 'usrdef_istate', pu, 'U', -1. ) 
    139       CALL lbc_lnk( 'usrdef_istate', pv, 'V', -1. ) 
     130      END_2D 
     131      ! 
     132      CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 
    140133      !    
    141134   END SUBROUTINE usr_def_istate 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/MY_SRC/usrdef_nam.F90

    r12377 r13710  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
     16   USE dom_oce 
    1717   USE par_oce        ! ocean space and time domain 
    1818   USE phycst         ! physical constants 
    … …  
    8484         kpi = NINT( 1800.e3  / rn_dx ) + 3   
    8585         kpj = NINT( 1800.e3  / rn_dy ) + 3  
    86       ELSE 
    87          kpi  = nbcellsx + 2 + 2*nbghostcells 
    88          kpj  = nbcellsy + 2 + 2*nbghostcells 
     86      ELSE                          ! Global Domain size: add nbghostcells + 1 "land" point on each side 
     87         kpi  = nbcellsx + 2 * ( nbghostcells + 1 ) 
     88         kpj  = nbcellsy + 2 * ( nbghostcells + 1 ) 
     89!!$         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
     90!!$         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
    8991      ENDIF 
    9092      kpk = NINT( 5000._wp / rn_dz ) + 1 
    … …  
    104106         WRITE(numout,*) '      horizontal resolution             rn_dy  = ', rn_dy, ' m' 
    105107         WRITE(numout,*) '      vertical resolution               rn_dz  = ', rn_dz, ' m' 
     108         WRITE(numout,*) '      resulting global domain size :    Ni0glo = ', kpi 
     109         WRITE(numout,*) '                                        Nj0glo = ', kpj 
     110         WRITE(numout,*) '                                        jpkglo = ', kpk 
    106111         WRITE(numout,*) '      VORTEX domain: ' 
    107112         WRITE(numout,*) '         LX [km]: ', zlx 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/MY_SRC/usrdef_zgr.F90

    r12377 r13710  
    192192      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
    193193      ! 
    194       k_bot(:,:) = INT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere 
     194      k_bot(:,:) = NINT( z2d(:,:) )          ! =jpkm1 over the ocean point, =0 elsewhere 
    195195      ! 
    196196      k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere 
Note: See TracChangeset for help on using the changeset viewer.