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 14053 – NEMO

Changeset 14053


Ignore:
Timestamp:
2020-12-03T14:48:38+01:00 (3 years ago)
Author:
techene
Message:

#2385 added to the trunk

Location:
NEMO/trunk
Files:
20 deleted
85 edited
6 copied

Legend:

Unmodified
Added
Removed

  • NEMO/trunk/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg

    r13558 r14053  
    299299!----------------------------------------------------------------------- 
    300300   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    301       nn_een_e3f = 0          ! =0   e3f = mean masked e3t divided by 4 
    302301/ 
    303302!----------------------------------------------------------------------- 

  • NEMO/trunk/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg

    r13558 r14053  
    300300!----------------------------------------------------------------------- 
    301301   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    302       nn_een_e3f = 0          ! =0   e3f = mean masked e3t divided by 4 
    303302/ 
    304303!----------------------------------------------------------------------- 

  • NEMO/trunk/cfgs/AMM12/EXPREF/namelist_cfg

    r13558 r14053  
    291291!----------------------------------------------------------------------- 
    292292   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    293       nn_een_e3f = 1             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
     293   nn_e3f_typ = 1          !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    294294/ 
    295295!----------------------------------------------------------------------- 

  • NEMO/trunk/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg

    r14007 r14053  
    334334!----------------------------------------------------------------------- 
    335335   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    336       nn_een_e3f = 0          ! =0   e3f = mean masked e3t divided by 4 
    337336/ 
    338337!----------------------------------------------------------------------- 
    … …  
    389388      !                       !                 = 3 as =2 with distinct dissipative an mixing length scale 
    390389      nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to NIWs 
    391                                !        = 0 none ; = 1 add a tke source below the ML 
    392                                !        = 2 add a tke source just at the base of the ML 
    393                                !        = 3 as = 1 applied on HF part of the stress           (ln_cpl=T) 
     390      !                       !        = 0 none ; = 1 add a tke source below the ML 
     391      !                       !        = 2 add a tke source just at the base of the ML 
     392      !                       !        = 3 as = 1 applied on HF part of the stress           (ln_cpl=T) 
    394393      ln_mxhsw    = .false.   !  surface mixing length scale = F(wave height) 
    395394/ 

  • NEMO/trunk/cfgs/SHARED/axis_def_nemo.xml

    r12377 r14053  
    1414      <axis id="depthv"  long_name="Vertical V levels" unit="m" positive="down" /> 
    1515      <axis id="depthw"  long_name="Vertical W levels" unit="m" positive="down" /> 
     16      <axis id="depthf"  long_name="Vertical F levels" unit="m" positive="down" /> 
    1617      <axis id="nfloat"  long_name="Float number"      unit="-"                 /> 
    1718      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               /> 

  • NEMO/trunk/cfgs/SHARED/domain_def_nemo.xml

    r12276 r14053  
    181181     <domain id="EqW" domain_ref="grid_W" > <zoom_domain id="EqW"/> </domain> 
    182182 
     183     <!--   F grid   --> 
     184     <domain id="grid_F" long_name="grid F"/> 
     185      
    183186              <!--   zonal mean grid   --> 
    184187     <domain_group id="gznl"> 

  • NEMO/trunk/cfgs/SHARED/field_def_nemo-oce.xml

    r14045 r14053  
    171171        <field id="tosmint_pot"  long_name="vertical integral of potential temperature times density"   standard_name="integral_wrt_depth_of_product_of_density_and_potential_temperature"  unit="(kg m2) degree_C" /> 
    172172 
    173  
     173        <field id="ht"           long_name="water column height at T point"                     standard_name="water_column_height_T"                      unit="m" /> 
    174174        <field id="ssh"          long_name="sea surface height"                                 standard_name="sea_surface_height_above_geoid"             unit="m" /> 
    175175        <field id="ssh2"         long_name="square of sea surface height"                       standard_name="square_of_sea_surface_height_above_geoid"   unit="m2" > ssh * ssh </field > 
    … …  
    190190 
    191191        <!-- Energy - horizontal divergence --> 
     192        <field id="sKE"          long_name="surface kinetic energy"  standard_name="specific_kinetic_energy_of_sea_water"   unit="m2/s2"  grid_ref="grid_T_2D" /> 
    192193        <field id="hdiv"         long_name="horizontal divergence"                                                          unit="s-1"    grid_ref="grid_T_3D" /> 
    193194 
    … …  
    556557 
    557558      <field_group id="grid_U"   grid_ref="grid_U_2D"> 
     559        <field id="hu"            long_name="water column height at U point"                         standard_name="water_column_height_U"       unit="m" /> 
    558560        <field id="e2u"           long_name="U-cell width in meridional direction"                   standard_name="cell_width"                  unit="m"                               /> 
    559561        <field id="e3u"           long_name="U-cell thickness"                                       standard_name="cell_thickness"              unit="m"          grid_ref="grid_U_3D" /> 
    … …  
    626628        <field id="e3v"          long_name="V-cell thickness"                                       standard_name="cell_thickness"              unit="m"          grid_ref="grid_V_3D" /> 
    627629        <field id="e3v_0"        long_name="Initial V-cell thickness"                               standard_name="ref_cell_thickness"          unit="m"          grid_ref="grid_V_3D" /> 
     630        <field id="hv"            long_name="water column height at V point"                        standard_name="water_column_height_V"       unit="m" /> 
    628631        <field id="vtau"         long_name="Wind Stress along j-axis"                               standard_name="surface_downward_y_stress"   unit="N/m2"                            /> 
    629632        <field id="voce"         long_name="ocean current along j-axis"                             standard_name="sea_water_y_velocity"        unit="m/s"        grid_ref="grid_V_3D" /> 
    … …  
    734737 
    735738      <!-- F grid --> 
     739      <field_group id="grid_F" grid_ref="grid_F_2D"> 
     740   <field id="e3f"          long_name="F-cell thickness"                    standard_name="cell_thickness"        unit="m"   grid_ref="grid_F_3D" /> 
     741   <field id="e3f_0"        long_name="F-cell thickness"                    standard_name="cell_thickness"        unit="m"   grid_ref="grid_F_3D" /> 
     742        <field id="hf"           long_name="water column height at F point"    standard_name="water_column_height_F"  unit="m"                     /> 
     743        <field id="sKEf"         long_name="surface kinetic energy at F point" standard_name="specific_kinetic_energy_of_sea_water"   unit="m2/s2" /> 
     744        <field id="relvor"       long_name="relative vorticity"                standard_name="relative_vorticity"     unit="1/s"                   /> 
     745        <field id="plavor"       long_name="planetary vorticity"               standard_name="planetary_vorticity"    unit="1/s"                   /> 
     746        <field id="relpotvor"    long_name="relative potential vorticity"      standard_name="relpot_vorticity"       unit="1/m.s"                 /> 
     747        <field id="abspotvor"    long_name="absolute potential vorticity"      standard_name="abspot_vorticity"       unit="1/m.s"                 /> 
     748        <field id="Ens"          long_name="enstrophy"                         standard_name="enstrophy"              unit="1/m2.s2"               /> 
     749      </field_group>  
     750  
    736751      <!-- AGRIF sponge --> 
    737752      <field id="agrif_spf"    long_name=" AGRIF f-sponge coefficient"   unit=" " /> 

  • NEMO/trunk/cfgs/SHARED/grid_def_nemo.xml

    r12377 r14053  
    5353         <domain domain_ref="grid_W" /> 
    5454         <axis axis_ref="depthw" /> 
     55       </grid> 
     56       <!--  --> 
     57       <grid id="grid_F_2D" > 
     58         <domain domain_ref="grid_F" /> 
     59       </grid> 
     60        <!--  --> 
     61       <grid id="grid_F_3D" > 
     62         <domain domain_ref="grid_F" /> 
     63         <axis axis_ref="depthf" /> 
    5564       </grid> 
    5665        <!--  --> 

  • NEMO/trunk/cfgs/SHARED/namelist_ref

    r14045 r14053  
    998998   ln_dynvor_eeT = .false. !  energy conserving scheme (een using e3t) 
    999999   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    1000       nn_een_e3f = 0          ! =0  e3f = mi(mj(e3t))/4 
    1001       !                       ! =1  e3f = mi(mj(e3t))/mi(mj( tmask)) 
     1000   ! 
    10021001   ln_dynvor_msk = .false. !  vorticity multiplied by fmask (=T)        ==>>> PLEASE DO NOT ACTIVATE 
    1003       !                    !  (f-point vorticity schemes only) 
     1002   !                       !  (f-point vorticity schemes only) 
     1003   ! 
     1004   nn_e3f_typ = 0          !  type of e3f (EEN, ENE, ENS, MIX only)  =0  e3f = mi(mj(e3t))/4 
     1005   !                       !                                         =1  e3f = mi(mj(e3t))/mi(mj( tmask)) 
    10041006/ 
    10051007!----------------------------------------------------------------------- 
    … …  
    10331035   !                       !  Type of the operator : 
    10341036   ln_dynldf_OFF = .false.     !  No operator (i.e. no explicit diffusion) 
     1037   nn_dynldf_typ = 0           !  =0 div-rot (default)   ;   =1 symmetric 
    10351038   ln_dynldf_lap = .false.     !    laplacian operator 
    10361039   ln_dynldf_blp = .false.     !  bilaplacian operator 
    … …  
    11631166   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F) 
    11641167      nn_mxlice    = 2        ! type of scaling under sea-ice 
    1165                               !    = 0 no scaling under sea-ice 
    1166                               !    = 1 scaling with constant sea-ice thickness 
    1167                               !    = 2 scaling with mean sea-ice thickness ( only with SI3 sea-ice model ) 
    1168                               !    = 3 scaling with maximum sea-ice thickness 
     1168      !                       !    = 0 no scaling under sea-ice 
     1169      !                       !    = 1 scaling with constant sea-ice thickness 
     1170      !                       !    = 2 scaling with mean sea-ice thickness ( only with SI3 sea-ice model ) 
     1171      !                       !    = 3 scaling with maximum sea-ice thickness 
    11691172      rn_mxlice   = 10.       ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 
    11701173   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value 
    … …  
    11731176      rn_lc       =   0.15    !  coef. associated to Langmuir cells 
    11741177   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to NIWs 
    1175                               !        = 0 none ; = 1 add a tke source below the ML 
    1176                               !        = 2 add a tke source just at the base of the ML 
    1177                               !        = 3 as = 1 applied on HF part of the stress           (ln_cpl=T) 
     1178   !                          !        = 0 none ; = 1 add a tke source below the ML 
     1179   !                          !        = 2 add a tke source just at the base of the ML 
     1180   !                          !        = 3 as = 1 applied on HF part of the stress           (ln_cpl=T) 
    11781181      rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2) 
    11791182      nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML 
    1180                               !        = 0  constant 10 m length scale 
    1181                               !        = 1  0.5m at the equator to 30m poleward of 40 degrees 
     1183      !                       !        = 0  constant 10 m length scale 
     1184      !                       !        = 1  0.5m at the equator to 30m poleward of 40 degrees 
    11821185   nn_eice     =   1       !  attenutaion of langmuir & surface wave breaking under ice 
    11831186   !                       !           = 0 no impact of ice cover on langmuir & surface wave breaking 

  • NEMO/trunk/src/ICE/iceistate.F90

    r14005 r14053  
    2121   USE sbc_ice , ONLY : tn_ice, snwice_mass, snwice_mass_b 
    2222   USE eosbn2         ! equation of state 
     23# if defined key_qco 
     24   USE domqco         ! Variable volume 
     25# else 
    2326   USE domvvl         ! Variable volume 
     27# endif 
    2428   USE ice            ! sea-ice: variables 
    2529   USE ice1D          ! sea-ice: thermodynamics variables 
    … …  
    434438         ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rho0 
    435439         ! 
     440#if defined key_qco 
     441         IF( .NOT.ln_linssh )   CALL dom_qco_zgr( Kbb, Kmm )        ! interpolation scale factor, depth and water column 
     442#else 
    436443         IF( .NOT.ln_linssh )   CALL dom_vvl_zgr( Kbb, Kmm, Kaa )   ! interpolation scale factor, depth and water column 
    437 ! !!st 
    438 !          IF( .NOT.ln_linssh ) THEN 
    439 !             ! 
    440 !             WHERE( ht_0(:,:) > 0 )   ;   z2d(:,:) = 1._wp + ssh(:,:,Kmm)*tmask(:,:,1) / ht_0(:,:) 
    441 !             ELSEWHERE                ;   z2d(:,:) = 1._wp   ;   END WHERE 
    442 !             ! 
    443 !             DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
    444 !                e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * z2d(:,:) 
    445 !                e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 
    446 !                e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kmm) 
    447 !             END DO 
    448 !             ! 
    449 !             ! Reconstruction of all vertical scale factors at now and before time-steps 
    450 !             ! ========================================================================= 
    451 !             ! Horizontal scale factor interpolations 
    452 !             ! -------------------------------------- 
    453 !             CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 
    454 !             CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 
    455 !             CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 
    456 !             CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 
    457 !             CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 
    458 !             ! Vertical scale factor interpolations 
    459 !             ! ------------------------------------ 
    460 !             CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  ) 
    461 !             CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 
    462 !             CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 
    463 !             CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 
    464 !             CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 
    465 !             ! t- and w- points depth 
    466 !             ! ---------------------- 
    467 !             !!gm not sure of that.... 
    468 !             gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 
    469 !             gdepw(:,:,1,Kmm) = 0.0_wp 
    470 !             gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
    471 !             DO jk = 2, jpk 
    472 !                gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk  ,Kmm) 
    473 !                gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 
    474 !                gde3w(:,:,jk) = gdept(:,:,jk  ,Kmm) - ssh (:,:,Kmm) 
    475 !             END DO 
    476 !          ENDIF 
     444#endif 
     445 
    477446      ENDIF 
    478447 

  • NEMO/trunk/src/NST/agrif_oce_interp.F90

    r13286 r14053  
    2828   USE agrif_oce 
    2929   USE phycst 
    30    USE dynspg_ts, ONLY: un_adv, vn_adv 
     30!!!   USE dynspg_ts, ONLY: un_adv, vn_adv 
    3131   ! 
    3232   USE in_out_manager 
    … …  
    5050   INTEGER ::   bdy_tinterp = 0 
    5151 
    52    !!---------------------------------------------------------------------- 
     52   !! * Substitutions 
     53#  include "domzgr_substitute.h90" 
    5354   !! NEMO/NST 4.0 , NEMO Consortium (2018) 
    5455   !! $Id$ 
    … …  
    11921193      !!----------------------------------------------------------------------   
    11931194      IF( before ) THEN 
    1194          IF ( ln_bt_fw ) THEN 
     1195!         IF ( ln_bt_fw ) THEN 
    11951196            ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2) 
    1196          ELSE 
    1197             ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * un_adv(i1:i2,j1:j2) 
    1198          ENDIF 
     1197!         ELSE 
     1198!            ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * un_adv(i1:i2,j1:j2) 
     1199!         ENDIF 
    11991200      ELSE 
    12001201         zrhot = Agrif_rhot() 
    … …  
    12281229      ! 
    12291230      IF( before ) THEN 
    1230          IF ( ln_bt_fw ) THEN 
     1231!         IF ( ln_bt_fw ) THEN 
    12311232            ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 
    1232          ELSE 
    1233             ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2) 
    1234          ENDIF 
     1233!         ELSE 
     1234!            ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2) 
     1235!         ENDIF 
    12351236      ELSE       
    12361237         zrhot = Agrif_rhot() 

  • NEMO/trunk/src/NST/agrif_oce_sponge.F90

    r13312 r14053  
    3232 
    3333   !! * Substitutions 
     34#  include "domzgr_substitute.h90" 
    3435#  include "do_loop_substitute.h90" 
    3536   !!---------------------------------------------------------------------- 

  • NEMO/trunk/src/NST/agrif_oce_update.F90

    r13286 r14053  
    2727   USE vremap         ! Vertical remapping 
    2828   USE lbclnk  
    29  
     29#if defined key_qco 
     30   USE domqco 
     31#endif 
    3032   IMPLICIT NONE 
    3133   PRIVATE 
    … …  
    3436   PUBLIC   Update_Scales 
    3537 
     38   !! * Substitutions 
     39#  include "domzgr_substitute.h90" 
    3640   !!---------------------------------------------------------------------- 
    3741   !! NEMO/NST 4.0 , NEMO Consortium (2018) 
    … …  
    191195   END SUBROUTINE Agrif_Update_Tke 
    192196 
    193  
    194197   SUBROUTINE Agrif_Update_vvl( ) 
    195198      !!--------------------------------------------- 
    … …  
    201204      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update e3 from grid Number',Agrif_Fixed(), 'Step', Agrif_Nb_Step() 
    202205      ! 
     206#if ! defined key_qco 
    203207      Agrif_UseSpecialValueInUpdate = .TRUE. 
    204208      Agrif_SpecialValueFineGrid = 0. 
    … …  
    213217      CALL dom_vvl_update_UVF 
    214218      CALL Agrif_ParentGrid_To_ChildGrid() 
     219#else 
     220      CALL Agrif_ChildGrid_To_ParentGrid() 
     221      CALL Agrif_Update_qco 
     222      CALL Agrif_ParentGrid_To_ChildGrid() 
     223#endif 
    215224      ! 
    216225   END SUBROUTINE Agrif_Update_vvl 
    217226 
     227 
     228#if defined key_qco 
     229   SUBROUTINE Agrif_Update_qco 
     230      !!--------------------------------------------- 
     231      !!       *** ROUTINE dom_Update_qco *** 
     232      !!--------------------------------------------- 
     233      ! 
     234      ! Save arrays prior update (needed for asselin correction) 
     235      r3t(:,:,Krhs_a) = r3t(:,:,Kmm_a) 
     236      r3u(:,:,Krhs_a) = r3u(:,:,Kmm_a) 
     237      r3v(:,:,Krhs_a) = r3v(:,:,Kmm_a) 
     238 
     239      ! Update r3x arrays from updated ssh 
     240      CALL dom_qco_zgr( Kbb_a, Kmm_a ) 
     241      ! 
     242   END SUBROUTINE Agrif_Update_qco 
     243#endif 
     244 
     245 
     246#if ! defined key_qco 
    218247   SUBROUTINE dom_vvl_update_UVF 
    219248      !!--------------------------------------------- 
    … …  
    224253      REAL(wp):: zcoef 
    225254      !!--------------------------------------------- 
    226  
    227255      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Finalize e3 on grid Number', & 
    228256                  & Agrif_Fixed(), 'Step', Agrif_Nb_Step() 
    … …  
    290318      ! 
    291319   END SUBROUTINE dom_vvl_update_UVF 
     320#endif 
    292321 
    293322#if defined key_vertical 
    … …  
    13321361   END SUBROUTINE updateAVM 
    13331362 
     1363#if ! defined key_qco 
    13341364   SUBROUTINE updatee3t(ptab_dum, i1, i2, j1, j2, k1, k2, before ) 
    13351365      !!--------------------------------------------- 
    … …  
    14431473      ! 
    14441474   END SUBROUTINE updatee3t 
     1475#endif 
    14451476 
    14461477#else 

  • NEMO/trunk/src/NST/agrif_user.F90

    r13546 r14053  
    288288         CALL Agrif_Init_Variable(sshini_id, procname=agrif_initssh) 
    289289         CALL lbc_lnk( 'Agrif_Init_Domain', ssh(:,:,Kbb), 'T', 1. ) 
     290#if ! defined key_qco 
    290291         DO jk = 1, jpk 
    291292               e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb)  ) & 
    … …  
    293294                        &              + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 
    294295         END DO 
     296#endif 
    295297      ENDIF 
    296298 

  • NEMO/trunk/src/OCE/DIA/diawri.F90

    r14045 r14053  
    1919   !!            3.7  ! 2014-01  (G. Madec) remove eddy induced velocity from no-IOM output 
    2020   !!                 !                     change name of output variables in dia_wri_state 
     21   !!            4.0  ! 2020-10  (A. Nasser, S. Techene) add diagnostic for SWE 
    2122   !!---------------------------------------------------------------------- 
    2223 
    … …  
    119120      INTEGER ::   ji, jj, jk       ! dummy loop indices 
    120121      INTEGER ::   ikbot            ! local integer 
    121       REAL(wp)::   ze3 
    122122      REAL(wp)::   zztmp , zztmpx   ! local scalar 
    123123      REAL(wp)::   zztmp2, zztmpy   !   -      - 
     124      REAL(wp)::   ze3 
    124125      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d   ! 2D workspace 
    125126      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   z3d   ! 3D workspace 
    … …  
    138139      CALL iom_put("e3u_0", e3u_0(:,:,:) ) 
    139140      CALL iom_put("e3v_0", e3v_0(:,:,:) ) 
     141      CALL iom_put("e3f_0", e3f_0(:,:,:) ) 
    140142      ! 
    141143      IF ( iom_use("e3t") .OR. iom_use("e3tdef") ) THEN  ! time-varying e3t 
    … …  
    164166         CALL iom_put( "e3w" , z3d(:,:,:) ) 
    165167      ENDIF 
     168      IF ( iom_use("e3f") ) THEN                         ! time-varying e3f caution here at Kaa 
     169          DO jk = 1, jpk 
     170            z3d(:,:,jk) =  e3f(:,:,jk) 
     171         END DO 
     172         CALL iom_put( "e3f" , z3d(:,:,:) ) 
     173      ENDIF 
    166174 
    167175      IF( ll_wd ) THEN                                   ! sea surface height (brought back to the reference used for wetting and drying) 
    168          CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) ) 
     176         CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*ssmask(:,:) ) 
    169177      ELSE 
    170178         CALL iom_put( "ssh" , ssh(:,:,Kmm) )              ! sea surface height 
    171179      ENDIF 
    172180 
    173       IF( iom_use("wetdep") )   &                  ! wet depth 
    174          CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) ) 
     181      IF( iom_use("wetdep") )    CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) )   ! wet depth 
     182          
     183#if defined key_qco 
     184      IF( iom_use("ht") )   CALL iom_put( "ht" , ht(:,:)     )   ! water column at t-point 
     185      IF( iom_use("hu") )   CALL iom_put( "hu" , hu(:,:,Kmm) )   ! water column at u-point 
     186      IF( iom_use("hv") )   CALL iom_put( "hv" , hv(:,:,Kmm) )   ! water column at v-point 
     187      IF( iom_use("hf") )   CALL iom_put( "hf" , hf_0(:,:)*( 1._wp + r3f(:,:) ) )   ! water column at f-point (caution here at Naa) 
     188#endif 
    175189       
    176190      CALL iom_put( "toce", ts(:,:,:,jp_tem,Kmm) )    ! 3D temperature 
    … …  
    326340      ENDIF 
    327341      ! 
     342      IF ( iom_use("sKE") ) THEN                        ! surface kinetic energy at T point 
     343         z2d(:,:) = 0._wp 
     344         DO_2D( 0, 0, 0, 0 ) 
     345            z2d(ji,jj) = 0.25_wp * ( uu(ji  ,jj,1,Kmm) * uu(ji  ,jj,1,Kmm) * e1e2u(ji  ,jj) * e3u(ji  ,jj,1,Kmm)  & 
     346               &                   + uu(ji-1,jj,1,Kmm) * uu(ji-1,jj,1,Kmm) * e1e2u(ji-1,jj) * e3u(ji-1,jj,1,Kmm)  & 
     347               &                   + vv(ji,jj  ,1,Kmm) * vv(ji,jj  ,1,Kmm) * e1e2v(ji,jj  ) * e3v(ji,jj  ,1,Kmm)  &  
     348               &                   + vv(ji,jj-1,1,Kmm) * vv(ji,jj-1,1,Kmm) * e1e2v(ji,jj-1) * e3v(ji,jj-1,1,Kmm)  )  & 
     349               &                 * r1_e1e2t(ji,jj) / e3t(ji,jj,1,Kmm) * ssmask(ji,jj) 
     350         END_2D 
     351         CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 
     352         IF ( iom_use("sKE" ) )  CALL iom_put( "sKE" , z2d )    
     353      ENDIF 
     354      !     
     355      IF ( iom_use("sKEf") ) THEN                        ! surface kinetic energy at F point 
     356         z2d(:,:) = 0._wp                                ! CAUTION : only valid in SWE, not with bathymetry 
     357         DO_2D( 0, 0, 0, 0 ) 
     358            z2d(ji,jj) = 0.25_wp * ( uu(ji,jj  ,1,Kmm) * uu(ji,jj  ,1,Kmm) * e1e2u(ji,jj  ) * e3u(ji,jj  ,1,Kmm)  & 
     359               &                   + uu(ji,jj+1,1,Kmm) * uu(ji,jj+1,1,Kmm) * e1e2u(ji,jj+1) * e3u(ji,jj+1,1,Kmm)  & 
     360               &                   + vv(ji  ,jj,1,Kmm) * vv(ji,jj  ,1,Kmm) * e1e2v(ji  ,jj) * e3v(ji  ,jj,1,Kmm)  &  
     361               &                   + vv(ji+1,jj,1,Kmm) * vv(ji+1,jj,1,Kmm) * e1e2v(ji+1,jj) * e3v(ji+1,jj,1,Kmm)  )  & 
     362               &                 * r1_e1e2f(ji,jj) / e3f(ji,jj,1) * ssfmask(ji,jj) 
     363         END_2D 
     364         CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     365         CALL iom_put( "sKEf", z2d )                      
     366      ENDIF 
     367      ! 
    328368      CALL iom_put( "hdiv", hdiv )                  ! Horizontal divergence 
    329369 
    … …  
    425465       
    426466      IF (ln_dia25h)   CALL dia_25h( kt, Kmm )        ! 25h averaging 
     467       
     468      ! Output of vorticity terms 
     469      IF ( iom_use("relvor")    .OR. iom_use("plavor")    .OR.   & 
     470         & iom_use("relpotvor") .OR. iom_use("abspotvor") .OR.   & 
     471         & iom_use("Ens")                                        ) THEN 
     472         ! 
     473         z2d(:,:) = 0._wp  
     474         ze3 = 0._wp  
     475         DO_2D( 1, 0, 1, 0 ) 
     476            z2d(ji,jj) = (   e2v(ji+1,jj  ) * vv(ji+1,jj  ,1,Kmm) - e2v(ji,jj) * vv(ji,jj,1,Kmm)    & 
     477            &              - e1u(ji  ,jj+1) * uu(ji  ,jj+1,1,Kmm) + e1u(ji,jj) * uu(ji,jj,1,Kmm)  ) * r1_e1e2f(ji,jj) 
     478         END_2D 
     479         CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     480         CALL iom_put( "relvor", z2d )                  ! relative vorticity ( zeta )  
     481         ! 
     482         CALL iom_put( "plavor", ff_f )                 ! planetary vorticity ( f ) 
     483         ! 
     484         DO_2D( 1, 0, 1, 0 )   
     485            ze3 = (  e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1)    & 
     486              &    + e3t(ji,jj  ,1,Kmm) * e1e2t(ji,jj  ) + e3t(ji+1,jj  ,1,Kmm) * e1e2t(ji+1,jj  )  ) * r1_e1e2f(ji,jj) 
     487            IF( ze3 /= 0._wp ) THEN   ;   ze3 = 4._wp / ze3 
     488            ELSE                      ;   ze3 = 0._wp 
     489            ENDIF 
     490            z2d(ji,jj) = ze3 * z2d(ji,jj)  
     491         END_2D 
     492         CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     493         CALL iom_put( "relpotvor", z2d )                  ! relative potential vorticity (zeta/h) 
     494         ! 
     495         DO_2D( 1, 0, 1, 0 ) 
     496            ze3 = (  e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1)    & 
     497              &    + e3t(ji,jj  ,1,Kmm) * e1e2t(ji,jj  ) + e3t(ji+1,jj  ,1,Kmm) * e1e2t(ji+1,jj  )  ) * r1_e1e2f(ji,jj) 
     498            IF( ze3 /= 0._wp ) THEN   ;   ze3 = 4._wp / ze3 
     499            ELSE                      ;   ze3 = 0._wp 
     500            ENDIF 
     501            z2d(ji,jj) = ze3 * ff_f(ji,jj) + z2d(ji,jj)  
     502         END_2D 
     503         CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     504         CALL iom_put( "abspotvor", z2d )                  ! absolute potential vorticity ( q ) 
     505         ! 
     506         DO_2D( 1, 0, 1, 0 )   
     507            z2d(ji,jj) = 0.5_wp * z2d(ji,jj)  * z2d(ji,jj)  
     508         END_2D 
     509         CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 
     510         CALL iom_put( "Ens", z2d )                        ! potential enstrophy ( 1/2*q2 ) 
     511         ! 
     512      ENDIF 
    427513 
    428514      IF( ln_timing )   CALL timing_stop('dia_wri') 
    … …  
    9981084      !! 
    9991085      INTEGER :: inum, jk 
    1000       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept      ! 3D workspace !!st patch to use substitution 
     1086      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept       ! 3D workspace for qco substitution 
    10011087      !!---------------------------------------------------------------------- 
    10021088      !  

  • NEMO/trunk/src/OCE/DOM/dom_oce.F90

    r13982 r14053  
    131131   ! 
    132132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point 
    133    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , e2_e1u, r1_e1e2u        !: associated metrics at u-point 
    134    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , e1_e2v, r1_e1e2v        !: associated metrics at v-point 
     133   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point 
     134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point 
    135135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point 
    136136   ! 
    … …  
    162162 
    163163   !                                                        !  reference depths of cells 
    164    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0  !: t- depth              [m] 
    165    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0  !: w- depth              [m] 
    166    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0  !: w- depth (sum of e3w) [m] 
     164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   gdept_0  !: t- depth              [m] 
     165   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   gdepw_0  !: w- depth              [m] 
     166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   gde3w_0  !: w- depth (sum of e3w) [m] 
    167167   !                                                        !  time-dependent depths of cells 
    168168   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdept, gdepw   
    … …  
    205205 
    206206   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)           ::   ssmask, ssumask, ssvmask, ssfmask   !: surface mask at T-,U-, V- and F-pts 
    207    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask   !: land/ocean mask at T-, U-, V-, W- and F-pts 
    208    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
    209  
     207   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET ::   tmask, umask, vmask, wmask, fmask   !: land/ocean mask at T-, U-, V-, W- and F-pts 
     208   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET ::   wumask, wvmask                      !: land/ocean mask at WU- and WV-pts 
     209#if defined key_qco    
     210   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET ::   fe3mask                             !: land/ocean mask at F-pts for qco 
     211#endif 
    210212   !!---------------------------------------------------------------------- 
    211213   !! calendar variables 
    … …  
    306308         &       e3w_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk)                      ,  STAT=ierr(ii) ) 
    307309         ! 
    308 #if ! defined key_qco 
     310#if defined key_qco 
     311      ii = ii+1 
     312      ALLOCATE( r3t  (jpi,jpj,jpt)   , r3u  (jpi,jpj,jpt)    , r3v  (jpi,jpj,jpt)    , r3f  (jpi,jpj) ,      & 
     313         &      r3t_f(jpi,jpj)       , r3u_f(jpi,jpj)        , r3v_f(jpi,jpj)                         ,  STAT=ierr(ii) )              
     314#else 
    309315      ii = ii+1 
    310316      ALLOCATE( e3t(jpi,jpj,jpk,jpt) , e3u (jpi,jpj,jpk,jpt) , e3v (jpi,jpj,jpk,jpt) , e3f(jpi,jpj,jpk) ,      & 
    … …  
    313319         ! 
    314320      ii = ii+1 
    315       ALLOCATE( r3t  (jpi,jpj,jpt)   , r3u  (jpi,jpj,jpt)    , r3v  (jpi,jpj,jpt)    , r3f  (jpi,jpj) ,  & 
    316          &      r3t_f(jpi,jpj)       , r3u_f(jpi,jpj)        , r3v_f(jpi,jpj)                         ,  STAT=ierr(ii) ) 
    317          ! 
    318       ii = ii+1 
    319321      ALLOCATE( ht_0(jpi,jpj) ,    hu_0(jpi,jpj)    ,    hv_0(jpi,jpj)     , hf_0(jpi,jpj) ,       & 
    320322         &   r1_ht_0(jpi,jpj) , r1_hu_0(jpi,jpj) ,    r1_hv_0(jpi,jpj),   r1_hf_0(jpi,jpj) ,   STAT=ierr(ii)  ) 
    … …  
    323325      ii = ii+1 
    324326      ALLOCATE( ht  (jpi,jpj) ,    hu  (jpi,jpj,jpt),    hv  (jpi,jpj,jpt)                 ,       & 
    325          &                      r1_hu  (jpi,jpj,jpt), r1_hv  (jpi,jpj,jpt)                 ,   STAT=ierr(ii)  ) 
    326 #else 
    327       ii = ii+1 
    328       ALLOCATE(                    hu  (jpi,jpj,jpt),    hv  (jpi,jpj,jpt)                 ,       & 
    329327         &                      r1_hu  (jpi,jpj,jpt), r1_hv  (jpi,jpj,jpt)                 ,   STAT=ierr(ii)  ) 
    330328#endif 
    … …  
    350348      ii = ii+1 
    351349      ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(ii) ) 
     350#if defined key_qco 
     351         ! 
     352      ii = ii+1 
     353      ALLOCATE( fe3mask(jpi,jpj,jpk) , STAT=ierr(ii) ) 
     354#endif 
    352355      ! 
    353356      dom_oce_alloc = MAXVAL(ierr) 

  • NEMO/trunk/src/OCE/DOM/domain.F90

    r13982 r14053  
    1515   !!            3.7  !  2015-11  (G. Madec, A. Coward)  time varying zgr by default 
    1616   !!            4.0  !  2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
    17    !!            4.x  ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
     17   !!            4.1  !  2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
    1818   !!---------------------------------------------------------------------- 
    1919    
    … …  
    2828   USE oce            ! ocean variables 
    2929   USE dom_oce        ! domain: ocean 
     30#if defined key_qco 
     31   USE domqco         ! quasi-eulerian 
     32#else 
     33   USE domvvl         ! variable volume 
     34#endif 
     35   USE sshwzv  , ONLY : ssh_init_rst   ! set initial ssh  
    3036   USE sbc_oce        ! surface boundary condition: ocean 
    3137   USE trc_oce        ! shared ocean & passive tracers variab 
    … …  
    3541   USE dommsk         ! domain: set the mask system 
    3642   USE domwri         ! domain: write the meshmask file 
    37 #if ! defined key_qco 
    38    USE domvvl         ! variable volume 
    39 #else 
    40    USE domqco          ! variable volume 
    41 #endif 
    4243   USE c1d            ! 1D configuration 
    4344   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine) 
    44    USE wet_dry, ONLY : ll_wd 
    45    USE closea , ONLY : dom_clo ! closed seas 
     45   USE wet_dry , ONLY : ll_wd     ! wet & drying flag 
     46   USE closea  , ONLY : dom_clo   ! closed seas routine 
    4647   ! 
    4748   USE prtctl         ! Print control (prt_ctl_info routine) 
    … …  
    5051   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    5152   USE lib_mpp        ! distributed memory computing library 
     53   USE restart        ! only for lrst_oce 
    5254 
    5355   IMPLICIT NONE 
    … …  
    5860   PUBLIC   dom_tile     ! called by step.F90 
    5961 
     62   !! * Substitutions 
     63#  include "do_loop_substitute.h90" 
    6064   !!------------------------------------------------------------------------- 
    6165   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8488      INTEGER ::   ji, jj, jk, jt   ! dummy loop indices 
    8589      INTEGER ::   iconf = 0    ! local integers 
     90      REAL(wp)::   zrdt 
    8691      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))"  
    8792      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level 
    … …  
    121126         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg 
    122127      ENDIF 
    123       nn_wxios = 0 
    124       ln_xios_read = .FALSE. 
     128       
    125129      ! 
    126130      !           !==  Reference coordinate system  ==! 
    … …  
    143147      hv_0(:,:) = 0._wp 
    144148      hf_0(:,:) = 0._wp 
    145       DO jk = 1, jpk 
     149      DO jk = 1, jpkm1 
    146150         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 
    147151         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) 
    148152         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk) 
    149          hf_0(:,:) = hf_0(:,:) + e3f_0(:,:,jk) * fmask(:,:,jk) 
    150153      END DO 
     154      ! 
     155      DO jk = 1, jpkm1 
     156         hf_0(1:jpim1,:) = hf_0(1:jpim1,:) + e3f_0(1:jpim1,:,jk)*vmask(1:jpim1,:,jk)*vmask(2:jpi,:,jk) 
     157      END DO 
     158      CALL lbc_lnk('domain', hf_0, 'F', 1._wp) 
     159      ! 
     160      IF( lk_SWE ) THEN      ! SWE case redefine hf_0 
     161         hf_0(:,:) = hf_0(:,:) + e3f_0(:,:,1) * ssfmask(:,:) 
     162      ENDIF 
    151163      ! 
    152164      r1_ht_0(:,:) = ssmask (:,:) / ( ht_0(:,:) + 1._wp -  ssmask (:,:) ) 
    … …  
    154166      r1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp -  ssvmask(:,:) ) 
    155167      r1_hf_0(:,:) = ssfmask(:,:) / ( hf_0(:,:) + 1._wp -  ssfmask(:,:) ) 
    156  
     168      ! 
     169      IF( ll_wd ) THEN       ! wet and drying (check ht_0 >= 0) 
     170         DO_2D( 1, 1, 1, 1 ) 
     171            IF( ht_0(ji,jj) < 0._wp .AND. ssmask(ji,jj) == 1._wp ) THEN 
     172               CALL ctl_stop( 'ssh_init_rst : ht_0 must be positive at potentially wet points' ) 
     173            ENDIF 
     174         END_2D 
     175      ENDIF 
     176      ! 
     177      !           !==  initialisation of time varying coordinate  ==! 
     178      ! 
     179      !                                 != ssh initialization 
     180      IF( .NOT.l_offline .AND. .NOT.l_SAS ) THEN 
     181         CALL ssh_init_rst( Kbb, Kmm, Kaa ) 
     182      ELSE 
     183         ssh(:,:,:) = 0._wp 
     184      ENDIF 
    157185      ! 
    158186#if defined key_qco 
    159       !           !==  initialisation of time varying coordinate  ==!  Quasi-Euerian coordinate case 
     187      !                                 != Quasi-Euerian coordinate case 
    160188      ! 
    161189      IF( .NOT.l_offline )   CALL dom_qco_init( Kbb, Kmm, Kaa ) 
    162       ! 
    163       IF( ln_linssh )        CALL ctl_stop('STOP','domain: key_qco and ln_linssh = T are incompatible') 
    164       ! 
    165190#else 
    166       !           !==  time varying part of coordinate system  ==! 
    167       ! 
    168       IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all 
     191      ! 
     192      IF( ln_linssh ) THEN              != Fix in time : set to the reference one for all 
    169193         ! 
    170194         DO jt = 1, jpt                         ! depth of t- and w-grid-points 
    … …  
    175199         ! 
    176200         DO jt = 1, jpt                         ! vertical scale factors 
    177             e3t(:,:,:,jt) =  e3t_0(:,:,:) 
    178             e3u(:,:,:,jt) =  e3u_0(:,:,:) 
    179             e3v(:,:,:,jt) =  e3v_0(:,:,:) 
    180             e3w(:,:,:,jt) =  e3w_0(:,:,:) 
     201            e3t (:,:,:,jt) =  e3t_0(:,:,:) 
     202            e3u (:,:,:,jt) =  e3u_0(:,:,:) 
     203            e3v (:,:,:,jt) =  e3v_0(:,:,:) 
     204            e3w (:,:,:,jt) =  e3w_0(:,:,:) 
    181205            e3uw(:,:,:,jt) = e3uw_0(:,:,:) 
    182206            e3vw(:,:,:,jt) = e3vw_0(:,:,:) 
    183207         END DO 
    184             e3f(:,:,:)    =  e3f_0(:,:,:) 
     208            e3f (:,:,:)    =  e3f_0(:,:,:) 
    185209         ! 
    186210         DO jt = 1, jpt                         ! water column thickness and its inverse 
    187             hu(:,:,jt)    =    hu_0(:,:) 
    188             hv(:,:,jt)    =    hv_0(:,:) 
     211               hu(:,:,jt) =    hu_0(:,:) 
     212               hv(:,:,jt) =    hv_0(:,:) 
    189213            r1_hu(:,:,jt) = r1_hu_0(:,:) 
    190214            r1_hv(:,:,jt) = r1_hv_0(:,:) 
    191215         END DO 
    192             ht(:,:) =    ht_0(:,:) 
    193          ! 
    194       ELSE                       != time varying : initialize before/now/after variables 
     216               ht   (:,:) =    ht_0(:,:) 
     217         ! 
     218      ELSE                              != Time varying : initialize before/now/after variables 
    195219         ! 
    196220         IF( .NOT.l_offline )   CALL dom_vvl_init( Kbb, Kmm, Kaa ) 
    … …  
    373397      USE ioipsl 
    374398      !! 
    375       INTEGER  ::   ios   ! Local integer 
     399      INTEGER ::   ios   ! Local integer 
     400      REAL(wp)::   zrdt 
     401      !!---------------------------------------------------------------------- 
    376402      ! 
    377403      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 & 
    … …  
    393419      ENDIF 
    394420      ! 
     421      !                       !=======================! 
     422      !                       !==  namelist namdom  ==! 
     423      !                       !=======================! 
     424      ! 
     425      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 
     426903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist' ) 
     427      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 
     428904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist' ) 
     429      IF(lwm) WRITE( numond, namdom ) 
     430      ! 
     431#if defined key_agrif 
     432      IF( .NOT. Agrif_Root() ) THEN    ! AGRIF child, subdivide the Parent timestep 
     433         rn_Dt = Agrif_Parent (rn_Dt ) / Agrif_Rhot() 
     434      ENDIF 
     435#endif 
     436      ! 
     437      IF(lwp) THEN 
     438         WRITE(numout,*) 
     439         WRITE(numout,*) '   Namelist : namdom   ---   space & time domain' 
     440         WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh 
     441         WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask 
     442         WRITE(numout,*) '      ocean time step                         rn_Dt       = ', rn_Dt 
     443         WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp 
     444         WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs 
     445      ENDIF 
     446      ! 
     447      ! set current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3 
     448      rDt   = 2._wp * rn_Dt 
     449      r1_Dt = 1._wp / rDt 
     450      ! 
     451      IF( l_SAS .AND. .NOT.ln_linssh ) THEN 
     452         CALL ctl_warn( 'SAS requires linear ssh : force ln_linssh = T' ) 
     453         ln_linssh = .TRUE. 
     454      ENDIF 
     455      ! 
     456#if defined key_qco 
     457      IF( ln_linssh )   CALL ctl_stop( 'STOP','domain: key_qco and ln_linssh = T are incompatible' ) 
     458#endif 
     459      ! 
     460      !                       !=======================! 
     461      !                       !==  namelist namrun  ==! 
     462      !                       !=======================! 
    395463      ! 
    396464      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 
    … …  
    452520      nleapy = nn_leapy 
    453521      ninist = nn_istate 
     522      ! 
     523      !                                        !==  Set parameters for restart reading using xIOS  ==! 
     524      ! 
     525      IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
     526         lrxios = ln_xios_read .AND. ln_rstart 
     527         IF( nn_wxios > 0 )   lwxios = .TRUE.           !* set output file type for XIOS based on NEMO namelist 
     528         nxioso = nn_wxios 
     529      ENDIF 
     530      !                                        !==  Check consistency between ln_rstart and ln_1st_euler  ==!   (i.e. set l_1st_euler) 
    454531      l_1st_euler = ln_1st_euler 
    455       IF( .NOT. l_1st_euler .AND. .NOT. ln_rstart ) THEN 
     532      ! 
     533      IF( ln_rstart ) THEN                              !*  Restart case 
     534         ! 
     535         IF(lwp) WRITE(numout,*) 
     536         IF(lwp) WRITE(numout,*) '   open the restart file' 
     537         CALL rst_read_open                                              !- Open the restart file 
     538         ! 
     539         IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 ) THEN     !- Check time-step consistency and force Euler restart if changed 
     540            CALL iom_get( numror, 'rdt', zrdt ) 
     541            IF( zrdt /= rn_Dt ) THEN 
     542               IF(lwp) WRITE( numout,*) 
     543               IF(lwp) WRITE( numout,*) '   rn_Dt = ', rn_Dt,' not equal to the READ one rdt = ', zrdt 
     544               IF(lwp) WRITE( numout,*) 
     545               IF(lwp) WRITE( numout,*) '      ==>>>   forced euler first time-step' 
     546               l_1st_euler =  .TRUE. 
     547            ENDIF 
     548         ENDIF 
     549         ! 
     550         IF( .NOT.l_SAS .AND. iom_varid( numror, 'sshb', ldstop = .FALSE. ) <= 0 ) THEN   !- Check absence of one of the Kbb field (here sshb) 
     551            !                                                                             !  (any Kbb field is missing ==> all Kbb fields are missing)  
     552            IF( .NOT.l_1st_euler ) THEN 
     553               CALL ctl_warn('dom_nam : ssh at Kbb not found in restart files ',   & 
     554                  &                        'l_1st_euler forced to .true. and ' ,   & 
     555                  &                        'ssh(Kbb) = ssh(Kmm) '                  ) 
     556               l_1st_euler = .TRUE. 
     557            ENDIF 
     558         ENDIF 
     559      ELSEIF( .NOT.l_1st_euler ) THEN                   !*  Initialization case 
    456560         IF(lwp) WRITE(numout,*)   
    457561         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)' 
    458562         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : l_1st_euler is forced to .true. '    
    459          l_1st_euler = .true. 
    460       ENDIF 
    461       !                             ! control of output frequency 
    462       IF( .NOT. ln_rst_list ) THEN     ! we use nn_stock 
     563         l_1st_euler = .TRUE. 
     564      ENDIF 
     565      ! 
     566      !                                        !==  control of output frequency  ==! 
     567      ! 
     568      IF( .NOT. ln_rst_list ) THEN   ! we use nn_stock 
    463569         IF( nn_stock == -1 )   CALL ctl_warn( 'nn_stock = -1 --> no restart will be done' ) 
    464570         IF( nn_stock == 0 .OR. nn_stock > nitend ) THEN 
    … …  
    479585      IF( Agrif_Root() ) THEN 
    480586         IF(lwp) WRITE(numout,*) 
    481          SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
     587         SELECT CASE ( nleapy )                !==  Choose calendar for IOIPSL  ==! 
    482588         CASE (  1 )  
    483589            CALL ioconf_calendar('gregorian') 
    … …  
    491597         END SELECT 
    492598      ENDIF 
    493  
    494       READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 
    495 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist' ) 
    496       READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 
    497 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist' ) 
    498       IF(lwm) WRITE( numond, namdom ) 
    499       ! 
    500 #if defined key_agrif 
    501       IF( .NOT. Agrif_Root() ) THEN 
    502             rn_Dt = Agrif_Parent(rn_Dt) / Agrif_Rhot() 
    503       ENDIF 
    504 #endif 
    505       ! 
    506       IF(lwp) THEN 
    507          WRITE(numout,*) 
    508          WRITE(numout,*) '   Namelist : namdom   ---   space & time domain' 
    509          WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh 
    510          WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask 
    511          WRITE(numout,*) '      ocean time step                         rn_Dt       = ', rn_Dt 
    512          WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp 
    513          WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs 
    514       ENDIF 
    515       ! 
    516       !! Initialise current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3 
    517       rDt  = 2._wp * rn_Dt 
    518       r1_Dt = 1._wp / rDt 
    519  
     599      ! 
     600      !                       !========================! 
     601      !                       !==  namelist namtile  ==! 
     602      !                       !========================! 
     603      ! 
    520604      READ  ( numnam_ref, namtile, IOSTAT = ios, ERR = 905 ) 
    521605905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtile in reference namelist' ) 
    … …  
    537621         ENDIF 
    538622      ENDIF 
    539  
    540       IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
    541          lrxios = ln_xios_read.AND.ln_rstart 
    542 !set output file type for XIOS based on NEMO namelist  
    543          IF (nn_wxios > 0) lwxios = .TRUE.  
    544          nxioso = nn_wxios 
    545       ENDIF 
    546  
     623      ! 
    547624#if defined key_netcdf4 
    548       !                             ! NetCDF 4 case   ("key_netcdf4" defined) 
     625      !                       !=======================! 
     626      !                       !==  namelist namnc4  ==!   NetCDF 4 case   ("key_netcdf4" defined) 
     627      !                       !=======================! 
     628      ! 
    549629      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 
    550630907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist' ) 
    … …  
    555635      IF(lwp) THEN                        ! control print 
    556636         WRITE(numout,*) 
    557          WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters' 
     637         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters ("key_netcdf4" defined)' 
    558638         WRITE(numout,*) '      number of chunks in i-dimension             nn_nchunks_i = ', nn_nchunks_i 
    559639         WRITE(numout,*) '      number of chunks in j-dimension             nn_nchunks_j = ', nn_nchunks_j 
    … …  
    618698   SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio ) 
    619699      !!---------------------------------------------------------------------- 
    620       !!                     ***  ROUTINE dom_nam  *** 
     700      !!                     ***  ROUTINE domain_cfg  *** 
    621701      !!                     
    622702      !! ** Purpose :   read the domain size in domain configuration file 

  • NEMO/trunk/src/OCE/DOM/dommsk.F90

    r13461 r14053  
    181181      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 ) 
    182182      ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 ) 
     183      IF( lk_SWE ) THEN      ! Shallow Water Eq. case : redefine ssfmask 
     184         DO_2D( 0,0 , 0,0 ) 
     185            ssfmask(ji,jj) = MAX(  ssmask(ji,jj+1), ssmask(ji+1,jj+1),  &  
     186               &                   ssmask(ji,jj  ), ssmask(ji+1,jj  )   ) 
     187         END_2D 
     188         CALL lbc_lnk( 'dommsk', ssfmask, 'F', 1.0_wp ) 
     189      ENDIF 
     190#if defined key_qco 
     191      fe3mask(:,:,:) = fmask(:,:,:) 
     192#endif 
    183193 
    184194      ! Interior domain mask  (used for global sum) 

  • NEMO/trunk/src/OCE/DOM/domqco.F90

    r13970 r14053  
    88   !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl: vvl option includes z_star and z_tilde coordinates 
    99   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
    10    !!            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) pure z* (quasi-eulerian) coordinate 
    12    !!---------------------------------------------------------------------- 
    13  
    14    !!---------------------------------------------------------------------- 
    15    !!   dom_qe_init   : define initial vertical scale factors, depths and column thickness 
    16    !!   dom_qe_r3c    : Compute ssh/h_0 ratioat t-, u-, v-, and optionally f-points 
    17    !!       qe_rst_read : read/write restart file 
    18    !!   dom_qe_ctl    : Check the vvl options 
     10   !!            4.1  !  2019-08  (A. Coward, D. Storkey) add time level indices for prognostic variables 
     11   !!             -   !  2020-02  (S. Techene, G. Madec) quasi-eulerian coordinate (z* or s*) 
     12   !!---------------------------------------------------------------------- 
     13 
     14   !!---------------------------------------------------------------------- 
     15   !!   dom_qco_init  : define initial vertical scale factors, depths and column thickness 
     16   !!   dom_qco_zgr   : Set ssh/h_0 ratio at t 
     17   !!   dom_qco_r3c   : Compute ssh/h_0 ratio at t-, u-, v-, and optionally f-points 
     18   !!       qco_ctl   : Check the vvl options 
    1919   !!---------------------------------------------------------------------- 
    2020   USE oce            ! ocean dynamics and tracers 
    … …  
    5555   LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE.                ! debug control prints 
    5656 
    57    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td                ! thickness diffusion transport 
    58  
    5957   !! * Substitutions 
    6058#  include "do_loop_substitute.h90" 
    … …  
    7977      !! 
    8078      !!---------------------------------------------------------------------- 
    81       INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 
     79      INTEGER, INTENT(in) ::   Kbb, Kmm, Kaa   ! time level indices 
     80      !!---------------------------------------------------------------------- 
    8281      ! 
    8382      IF(lwp) WRITE(numout,*) 
    … …  
    8584      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    8685      ! 
    87       CALL dom_qco_ctl     ! choose vertical coordinate (z_star, z_tilde or layer) 
    88       ! 
    89       !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 
    90       CALL qe_rst_read( nit000, Kbb, Kmm ) 
    91       ! 
    92       CALL dom_qco_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column 
     86      CALL qco_ctl                            ! choose vertical coordinate (z_star, z_tilde or layer) 
     87      ! 
     88      CALL dom_qco_zgr( Kbb, Kmm )            ! interpolation scale factor, depth and water column 
     89      ! 
     90#if defined key_agrif 
     91      ! We need to define r3[tuv](Kaa) for AGRIF initialisation (should not be a 
     92      ! problem for the restartability...) 
     93      r3t(:,:,Kaa) = r3t(:,:,Kmm) 
     94      r3u(:,:,Kaa) = r3u(:,:,Kmm) 
     95      r3v(:,:,Kaa) = r3v(:,:,Kmm) 
     96#endif 
    9397      ! 
    9498   END SUBROUTINE dom_qco_init 
    9599 
    96100 
    97    SUBROUTINE dom_qco_zgr(Kbb, Kmm, Kaa) 
     101   SUBROUTINE dom_qco_zgr( Kbb, Kmm ) 
    98102      !!---------------------------------------------------------------------- 
    99103      !!                ***  ROUTINE dom_qco_init  *** 
    100104      !! 
    101       !! ** Purpose :  Initialization of all ssh. to h._0 ratio 
    102       !! 
    103       !! ** Method  :  - interpolate scale factors 
    104       !! 
    105       !! ** Action  : - r3(t/u/v)_b 
    106       !!              - r3(t/u/v/f)_n 
    107       !! 
    108       !! Reference  : Leclair, M., and G. Madec, 2011, Ocean Modelling. 
    109       !!---------------------------------------------------------------------- 
    110       INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 
     105      !! ** Purpose :  Initialization of all r3. = ssh./h._0 ratios 
     106      !! 
     107      !! ** Method  :  Call domqco using Kbb and Kmm 
     108      !!               NB: dom_qco_zgr is called by dom_qco_init it uses ssh from ssh_init  
     109      !! 
     110      !! ** Action  : - r3(t/u/v)(Kbb) 
     111      !!              - r3(t/u/v/f)(Kmm) 
     112      !!---------------------------------------------------------------------- 
     113      INTEGER, INTENT(in) ::   Kbb, Kmm   ! time level indices 
    111114      !!---------------------------------------------------------------------- 
    112115      ! 
    113116      !                    !== Set of all other vertical scale factors  ==!  (now and before) 
    114117      !                                ! Horizontal interpolation of e3t 
    115       CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) ) 
     118      CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb)           ) 
    116119      CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 
    117120      ! 
    … …  
    143146      !                                      !==  ratio at u-,v-point  ==! 
    144147      ! 
    145       IF( ln_dynadv_vec ) THEN                     !- Vector Form   (thickness weighted averaging) 
     148!!st      IF( ln_dynadv_vec ) THEN                     !- Vector Form   (thickness weighted averaging) 
     149#if ! defined key_qcoTest_FluxForm 
     150      !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
    146151         DO_2D( 0, 0, 0, 0 ) 
    147152            pr3u(ji,jj) = 0.5_wp * (  e1e2t(ji  ,jj) * pssh(ji  ,jj)  & 
    … …  
    150155               &                    + e1e2t(ji,jj+1) * pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj) 
    151156         END_2D 
    152       ELSE                                         !- Flux Form   (simple averaging) 
     157!!st      ELSE                                         !- Flux Form   (simple averaging) 
     158#else 
    153159         DO_2D( 0, 0, 0, 0 ) 
    154             pr3u(ji,jj) = 0.5_wp * (  pssh(ji  ,jj) + pssh(ji+1,jj)  ) * r1_hu_0(ji,jj) 
    155             pr3v(ji,jj) = 0.5_wp * (  pssh(ji,jj  ) + pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) 
     160            pr3u(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji+1,jj  )  ) * r1_hu_0(ji,jj) 
     161            pr3v(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji  ,jj+1)  ) * r1_hv_0(ji,jj) 
    156162         END_2D 
    157       ENDIF 
     163!!st      ENDIF 
     164#endif          
    158165      ! 
    159166      IF( .NOT.PRESENT( pr3f ) ) THEN              !- lbc on ratio at u-, v-points only 
    … …  
    163170      ELSE                                   !==  ratio at f-point  ==! 
    164171         ! 
    165          IF( ln_dynadv_vec )   THEN                !- Vector Form   (thickness weighted averaging) 
    166             DO_2D( 1, 0, 1, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
     172!!st         IF( ln_dynadv_vec )   THEN                !- Vector Form   (thickness weighted averaging) 
     173#if ! defined key_qcoTest_FluxForm 
     174         !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
     175 
     176            DO_2D( 0, 0, 0, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
    167177               pr3f(ji,jj) = 0.25_wp * (  e1e2t(ji  ,jj  ) * pssh(ji  ,jj  )  & 
    168178                  &                     + e1e2t(ji+1,jj  ) * pssh(ji+1,jj  )  & 
    … …  
    170180                  &                     + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1)  ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj) 
    171181            END_2D 
    172          ELSE                                      !- Flux Form   (simple averaging) 
    173             DO_2D( 1, 0, 1, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
    174                pr3f(ji,jj) = 0.25_wp * (  pssh(ji  ,jj  ) + pssh(ji+1,jj  )  & 
    175                   &                     + pssh(ji  ,jj+1) + pssh(ji+1,jj+1)  ) * r1_hf_0(ji,jj) 
     182!!st         ELSE                                      !- Flux Form   (simple averaging) 
     183#else 
     184            DO_2D( 0, 0, 0, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
     185               pr3f(ji,jj) = 0.25_wp * (  pssh(ji,jj  ) + pssh(ji+1,jj  )  & 
     186                  &                     + pssh(ji,jj+1) + pssh(ji+1,jj+1)  ) * r1_hf_0(ji,jj) 
    176187            END_2D 
    177          ENDIF 
     188!!st         ENDIF 
     189#endif 
    178190         !                                                 ! lbc on ratio at u-,v-,f-points 
    179191         CALL lbc_lnk_multi( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 
    … …  
    184196 
    185197 
    186    SUBROUTINE qe_rst_read( kt, Kbb, Kmm ) 
     198   SUBROUTINE qco_ctl 
    187199      !!--------------------------------------------------------------------- 
    188       !!                   ***  ROUTINE qe_rst_read  *** 
    189       !! 
    190       !! ** Purpose :   Read ssh in restart file 
    191       !! 
    192       !! ** Method  :   use of IOM library 
    193       !!                if the restart does not contain ssh, 
    194       !!                it is set to the _0 values. 
    195       !!---------------------------------------------------------------------- 
    196       INTEGER         , INTENT(in) ::   kt        ! ocean time-step 
    197       INTEGER         , INTENT(in) ::   Kbb, Kmm  ! ocean time level indices 
    198       ! 
    199       INTEGER ::   ji, jj, jk 
    200       INTEGER ::   id1, id2     ! local integers 
    201       !!---------------------------------------------------------------------- 
    202       ! 
    203          IF( ln_rstart ) THEN                   !* Read the restart file 
    204             CALL rst_read_open                  !  open the restart file if necessary 
    205             ! 
    206             id1 = iom_varid( numror, 'sshb', ldstop = .FALSE. ) 
    207             id2 = iom_varid( numror, 'sshn', ldstop = .FALSE. ) 
    208             ! 
    209             !                             ! --------- ! 
    210             !                             ! all cases ! 
    211             !                             ! --------- ! 
    212             ! 
    213             IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    214                CALL iom_get( numror, jpdom_auto, 'sshb'   , ssh(:,:,Kbb)    ) 
    215                CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm)    ) 
    216                ! needed to restart if land processor not computed 
    217                IF(lwp) write(numout,*) 'qe_rst_read : ssh(:,:,Kbb) and ssh(:,:,Kmm) found in restart files' 
    218                WHERE ( ssmask(:,:) == 0.0_wp )   !!gm/st ==> sm should not be necessary on ssh when it was required on e3 
    219                   ssh(:,:,Kmm) = 0._wp 
    220                   ssh(:,:,Kbb) = 0._wp 
    221                END WHERE 
    222                IF( l_1st_euler ) THEN 
    223                   ssh(:,:,Kbb) = ssh(:,:,Kmm) 
    224                ENDIF 
    225             ELSE IF( id1 > 0 ) THEN 
    226                IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kmm) not found in restart files' 
    227                IF(lwp) write(numout,*) 'sshn set equal to sshb.' 
    228                IF(lwp) write(numout,*) 'neuler is forced to 0' 
    229                CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb) ) 
    230                ssh(:,:,Kmm) = ssh(:,:,Kbb) 
    231                l_1st_euler = .TRUE. 
    232             ELSE IF( id2 > 0 ) THEN 
    233                IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kbb) not found in restart files' 
    234                IF(lwp) write(numout,*) 'sshb set equal to sshn.' 
    235                IF(lwp) write(numout,*) 'neuler is forced to 0' 
    236                CALL iom_get( numror, jpdom_auto, 'sshn', ssh(:,:,Kmm) ) 
    237                ssh(:,:,Kbb) = ssh(:,:,Kmm) 
    238                l_1st_euler = .TRUE. 
    239             ELSE 
    240                IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kmm) not found in restart file' 
    241                IF(lwp) write(numout,*) 'ssh_b and ssh_n set to zero' 
    242                IF(lwp) write(numout,*) 'neuler is forced to 0' 
    243                ssh(:,:,:) = 0._wp 
    244                l_1st_euler = .TRUE. 
    245             ENDIF 
    246             ! 
    247          ELSE                                   !* Initialize at "rest" 
    248             ! 
    249             IF( ll_wd ) THEN   ! MJB ll_wd edits start here - these are essential 
    250                ! 
    251                IF( cn_cfg == 'wad' ) THEN            ! Wetting and drying test case 
    252                   CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  ) 
    253                   ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
    254                   ssh(:,:    ,Kmm) = ssh(:,:    ,Kbb) 
    255                   uu (:,:,:  ,Kmm) = uu (:,:,:  ,Kbb) 
    256                   vv (:,:,:  ,Kmm) = vv (:,:,:  ,Kbb) 
    257                ELSE                                  ! if not test case 
    258                   ssh(:,:,Kmm) = -ssh_ref 
    259                   ssh(:,:,Kbb) = -ssh_ref 
    260                   ! 
    261                   DO_2D( 1, 1, 1, 1 ) 
    262                      IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth 
    263                         ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 
    264                         ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 
    265                      ENDIF 
    266                   END_2D 
    267                ENDIF 
    268  
    269                DO ji = 1, jpi 
    270                   DO jj = 1, jpj 
    271                      IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
    272                        CALL ctl_stop( 'qe_rst_read: ht_0 must be positive at potentially wet points' ) 
    273                      ENDIF 
    274                   END DO 
    275                END DO 
    276                ! 
    277             ELSE 
    278                ! 
    279                ! Just to read set ssh in fact, called latter once vertical grid 
    280                ! is set up: 
    281 !               CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  ) 
    282 !               ! 
    283                 ssh(:,:,:) = 0._wp 
    284                ! 
    285             ENDIF           ! end of ll_wd edits 
    286             ! 
    287          ENDIF 
    288       ! 
    289    END SUBROUTINE qe_rst_read 
    290  
    291  
    292    SUBROUTINE dom_qco_ctl 
    293       !!--------------------------------------------------------------------- 
    294       !!                  ***  ROUTINE dom_qco_ctl  *** 
     200      !!                  ***  ROUTINE qco_ctl  *** 
    295201      !! 
    296202      !! ** Purpose :   Control the consistency between namelist options 
    … …  
    312218      IF(lwp) THEN                    ! Namelist print 
    313219         WRITE(numout,*) 
    314          WRITE(numout,*) 'dom_qco_ctl : choice/control of the variable vertical coordinate' 
    315          WRITE(numout,*) '~~~~~~~~~~~' 
     220         WRITE(numout,*) 'qco_ctl : choice/control of the variable vertical coordinate' 
     221         WRITE(numout,*) '~~~~~~~~' 
    316222         WRITE(numout,*) '   Namelist nam_vvl : chose a vertical coordinate' 
    317223         WRITE(numout,*) '      zstar                      ln_vvl_zstar   = ', ln_vvl_zstar 
    … …  
    357263#endif 
    358264      ! 
    359    END SUBROUTINE dom_qco_ctl 
     265   END SUBROUTINE qco_ctl 
    360266 
    361267   !!====================================================================== 

  • NEMO/trunk/src/OCE/DOM/domvvl.F90

    r13982 r14053  
    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 
     11   !!             -   ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio 
    1212   !!---------------------------------------------------------------------- 
    1313 
    … …  
    766766      !! ** Purpose :   Read or write VVL file in restart file 
    767767      !! 
    768       !! ** Method  :   use of IOM library 
    769       !!                if the restart does not contain vertical scale factors, 
    770       !!                they are set to the _0 values 
    771       !!                if the restart does not contain vertical scale factors increments (z_tilde), 
    772       !!                they are set to 0. 
     768      !! ** Method  : * restart comes from a linear ssh simulation : 
     769      !!                   an attempt to read e3t_n stops simulation 
     770      !!              * restart comes from a z-star, z-tilde, or layer : 
     771      !!                   read e3t_n and e3t_b 
     772      !!              * restart comes from a z-star : 
     773      !!                   set tilde_e3t_n, tilde_e3t_n, and hdiv_lf to 0 
     774      !!              * restart comes from layer : 
     775      !!                   read tilde_e3t_n and tilde_e3t_b 
     776      !!                   set hdiv_lf to 0 
     777      !!              * restart comes from a z-tilde: 
     778      !!                   read tilde_e3t_n, tilde_e3t_b, and hdiv_lf 
     779      !! 
     780      !!              NB: if l_1st_euler = T (ln_1st_euler or ssh_b not found) 
     781      !!                   Kbb fields set to Kmm ones 
    773782      !!---------------------------------------------------------------------- 
    774783      INTEGER         , INTENT(in) ::   kt        ! ocean time-step 
    … …  
    776785      CHARACTER(len=*), INTENT(in) ::   cdrw      ! "READ"/"WRITE" flag 
    777786      ! 
    778       INTEGER ::   ji, jj, jk 
    779       INTEGER ::   id1, id2, id3, id4, id5     ! local integers 
    780       !!---------------------------------------------------------------------- 
    781       ! 
    782       IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
    783          !                                   ! =============== 
    784          IF( ln_rstart ) THEN                   !* Read the restart file 
    785             CALL rst_read_open                  !  open the restart file if necessary 
    786             CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm)    ) 
     787      INTEGER ::   ji, jj, jk      ! dummy loop indices 
     788      INTEGER ::   id3, id4, id5   ! local integers 
     789      !!---------------------------------------------------------------------- 
     790      ! 
     791      !                                      !=====================! 
     792      IF( TRIM(cdrw) == 'READ' ) THEN        !  Read / initialise  ! 
     793         !                                   !=====================! 
     794         ! 
     795         IF( ln_rstart ) THEN                   !==  Read the restart file  ==! 
    787796            ! 
    788             id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    789             id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 
    790             id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 
     797            CALL rst_read_open                                          !*  open the restart file if necessary 
     798            !                                         ! --------- ! 
     799            !                                         ! all cases ! 
     800            !                                         ! --------- ! 
     801            ! 
     802            id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. )  !*  check presence 
    791803            id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 
    792             id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 
     804            id5 = iom_varid( numror, 'hdiv_lf'    , ldstop = .FALSE. ) 
    793805            ! 
    794             !                             ! --------- ! 
    795             !                             ! all cases ! 
    796             !                             ! --------- ! 
    797             ! 
    798             IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
     806            !                                                           !*  scale factors 
     807            IF(lwp) WRITE(numout,*)    '          Kmm scale factor read in the restart file' 
     808            CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
     809            WHERE ( tmask(:,:,:) == 0.0_wp )  
     810               e3t(:,:,:,Kmm) = e3t_0(:,:,:) 
     811            END WHERE 
     812            IF( l_1st_euler ) THEN                       ! euler 
     813               IF(lwp) WRITE(numout,*) '          Euler first time step : e3t(Kbb) = e3t(Kmm)' 
     814               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
     815            ELSE                                         ! leap frog 
     816               IF(lwp) WRITE(numout,*) '          Kbb scale factor read in the restart file' 
    799817               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
    800                CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    801                ! needed to restart if land processor not computed  
    802                IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    803818               WHERE ( tmask(:,:,:) == 0.0_wp )  
    804                   e3t(:,:,:,Kmm) = e3t_0(:,:,:) 
    805819                  e3t(:,:,:,Kbb) = e3t_0(:,:,:) 
    806820               END WHERE 
    807                IF( l_1st_euler ) THEN 
    808                   e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    809                ENDIF 
    810             ELSE IF( id1 > 0 ) THEN 
    811                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files' 
    812                IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    813                IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    814                CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
    815                e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    816                l_1st_euler = .true. 
    817             ELSE IF( id2 > 0 ) THEN 
    818                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files' 
    819                IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    820                IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    821                CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    822                e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    823                l_1st_euler = .true. 
    824             ELSE 
    825                IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file' 
    826                IF(lwp) write(numout,*) 'Compute scale factor from sshn' 
    827                IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    828                DO jk = 1, jpk 
    829                   e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 
    830                       &                          / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
    831                       &          + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk)) 
    832                END DO 
    833                e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    834                l_1st_euler = .true. 
    835821            ENDIF 
    836             !                             ! ----------- ! 
    837             IF( ln_vvl_zstar ) THEN       ! z_star case ! 
    838                !                          ! ----------- ! 
     822            !                                         ! ------------ ! 
     823            IF( ln_vvl_zstar ) THEN                   ! z_star case ! 
     824               !                                      ! ------------ ! 
    839825               IF( MIN( id3, id4 ) > 0 ) THEN 
    840826                  CALL ctl_stop( 'dom_vvl_rst: z_star cannot restart from a z_tilde or layer run' ) 
    841827               ENDIF 
    842                !                          ! ----------------------- ! 
    843             ELSE                          ! z_tilde and layer cases ! 
    844                !                          ! ----------------------- ! 
    845                IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    846                   CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
     828               !                                      ! ------------------------ ! 
     829            ELSE                                      !  z_tilde and layer cases ! 
     830               !                                      ! ------------------------ ! 
     831               ! 
     832               IF( id4 > 0 ) THEN                                       !*  scale factor increments 
     833                  IF(lwp) WRITE(numout,*)    '          Kmm scale factor increments read in the restart file' 
    847834                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 
    848                ELSE                            ! one at least array is missing 
     835                  IF( l_1st_euler ) THEN                 ! euler 
     836                     IF(lwp) WRITE(numout,*) '          Euler first time step : tilde_e3t(Kbb) = tilde_e3t(Kmm)' 
     837                     tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 
     838                  ELSE                                   ! leap frog 
     839                     IF(lwp) WRITE(numout,*) '          Kbb scale factor increments read in the restart file' 
     840                     CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
     841                  ENDIF 
     842               ELSE  
    849843                  tilde_e3t_b(:,:,:) = 0.0_wp 
    850844                  tilde_e3t_n(:,:,:) = 0.0_wp 
    851845               ENDIF 
    852                !                          ! ------------ ! 
    853                IF( ln_vvl_ztilde ) THEN   ! z_tilde case ! 
    854                   !                       ! ------------ ! 
     846               !                                      ! ------------ ! 
     847               IF( ln_vvl_ztilde ) THEN               ! z_tilde case ! 
     848                  !                                   ! ------------ ! 
    855849                  IF( id5 > 0 ) THEN  ! required array exists 
    856850                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 
    857851                  ELSE                ! array is missing 
    858                      hdiv_lf(:,:,:) = 0.0_wp 
     852                     hdiv_lf(:,:,:) = 0.0_wp  
    859853                  ENDIF 
    860854               ENDIF 
    861855            ENDIF 
    862856            ! 
    863          ELSE                                   !* Initialize at "rest" 
     857         ELSE                                   !==  Initialize at "rest" with ssh  ==! 
    864858            ! 
    865  
    866             IF( ll_wd ) THEN   ! MJB ll_wd edits start here - these are essential  
    867                ! 
    868                IF( cn_cfg == 'wad' ) THEN 
    869                   ! Wetting and drying test case 
    870                   CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  ) 
    871                   ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
    872                   ssh (:,:,Kmm)     = ssh(:,:,Kbb) 
    873                   uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    874                   vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
    875                ELSE 
    876                   ! if not test case 
    877                   ssh(:,:,Kmm) = -ssh_ref 
    878                   ssh(:,:,Kbb) = -ssh_ref 
    879  
    880                   DO_2D( 1, 1, 1, 1 ) 
    881                      IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN ! if total depth is less than min depth 
    882                         ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 
    883                         ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 
    884                      ENDIF 
    885                   END_2D 
    886                ENDIF !If test case else 
    887  
    888                ! Adjust vertical metrics for all wad 
    889                DO jk = 1, jpk 
    890                   e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm)  ) & 
    891                     &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
    892                     &            + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 
    893                END DO 
    894                e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    895  
    896                DO_2D( 1, 1, 1, 1 ) 
    897                   IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
    898                      CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
    899                   ENDIF 
    900                END_2D 
    901                ! 
    902             ELSE 
    903                ! 
    904                ! Just to read set ssh in fact, called latter once vertical grid 
    905                ! is set up: 
    906 !               CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  ) 
    907 !               ! 
    908 !               DO jk=1,jpk 
    909 !                  e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 
    910 !                     &            / ( ht_0(:,:) + 1._wp -ssmask(:,:) ) * tmask(:,:,jk) 
    911 !               END DO 
    912 !               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    913                 ssh(:,:,Kmm)=0._wp 
    914                 e3t(:,:,:,Kmm)=e3t_0(:,:,:) 
    915                 e3t(:,:,:,Kbb)=e3t_0(:,:,:) 
    916                ! 
    917             END IF           ! end of ll_wd edits 
    918  
     859            DO jk = 1, jpk 
     860               e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( 1._wp + ssh(:,:,Kmm) * r1_ht_0(:,:) * tmask(:,:,jk) ) 
     861            END DO 
     862            e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
     863            ! 
    919864            IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN 
    920865               tilde_e3t_b(:,:,:) = 0._wp 
    921866               tilde_e3t_n(:,:,:) = 0._wp 
    922867               IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0._wp 
    923             END IF 
     868            ENDIF 
    924869         ENDIF 
    925          ! 
    926       ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
    927          !                                   ! =================== 
     870         !                                       !=======================! 
     871      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN       !  Create restart file  ! 
     872         !                                       !=======================! 
     873         ! 
    928874         IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 
    929875         !                                           ! --------- ! 

  • NEMO/trunk/src/OCE/DOM/domzgr_substitute.h90

    r13237 r14053  
    1515#   define  e3u(i,j,k,t)   (e3u_0(i,j,k)*(1._wp+r3u(i,j,t)*umask(i,j,k))) 
    1616#   define  e3v(i,j,k,t)   (e3v_0(i,j,k)*(1._wp+r3v(i,j,t)*vmask(i,j,k))) 
    17 #   define  e3f(i,j,k)     (e3f_0(i,j,k)*(1._wp+r3f(i,j)*fmask(i,j,k))) 
     17#   define  e3f(i,j,k)     (e3f_0(i,j,k)*(1._wp+r3f(i,j)*fe3mask(i,j,k))) 
     18#   define  e3f_vor(i,j,k) (e3f_0vor(i,j,k)*(1._wp+r3f(i,j)*fe3mask(i,j,k))) 
    1819#   define  e3w(i,j,k,t)   (e3w_0(i,j,k)*(1._wp+r3t(i,j,t))) 
    1920#   define  e3uw(i,j,k,t)  (e3uw_0(i,j,k)*(1._wp+r3u(i,j,t))) 
    2021#   define  e3vw(i,j,k,t)  (e3vw_0(i,j,k)*(1._wp+r3v(i,j,t))) 
    21 #   define  ht(i,j)        (ht_0(i,j)+ssh(i,j,Kmm)) 
     22#   define  ht(i,j)        (ht_0(i,j)*(1._wp+r3t(i,j,Kmm))) 
    2223#   define  hu(i,j,t)      (hu_0(i,j)*(1._wp+r3u(i,j,t))) 
    2324#   define  hv(i,j,t)      (hv_0(i,j)*(1._wp+r3v(i,j,t))) 
    … …  
    2930#endif 
    3031!!---------------------------------------------------------------------- 
     32!!#   define  e3t_f(i,j,k)   (e3t_0(i,j,k)*(1._wp+r3t_f(i,j)*tmask(i,j,k))) 
     33!!#   define  e3u_f(i,j,k)   (e3u_0(i,j,k)*(1._wp+r3u_f(i,j)*umask(i,j,k))) 
     34!!#   define  e3v_f(i,j,k)   (e3v_0(i,j,k)*(1._wp+r3v_f(i,j)*vmask(i,j,k))) 

  • NEMO/trunk/src/OCE/DOM/istate.F90

    r13295 r14053  
    4242   PRIVATE 
    4343 
    44    PUBLIC   istate_init   ! routine called by step.F90 
     44   PUBLIC   istate_init   ! routine called by nemogcm.F90 
    4545 
    4646   !! * Substitutions 
    … …  
    5959      !!  
    6060      !! ** Purpose :   Initialization of the dynamics and tracer fields. 
     61      !! 
     62      !! ** Method  :    
    6163      !!---------------------------------------------------------------------- 
    6264      INTEGER, INTENT( in )  ::  Kbb, Kmm, Kaa   ! ocean time level indices 
    6365      ! 
    6466      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    65       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zgdept     ! 3D table  !!st patch to use gdept subtitute 
     67      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zgdept     ! 3D table for qco substitute 
    6668!!gm see comment further down 
    6769      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace 
    … …  
    7375      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    7476 
    75 !!gm  Why not include in the first call of dta_tsd ?   
    76 !!gm  probably associated with the use of internal damping... 
    7777       CALL dta_tsd_init        ! Initialisation of T & S input data 
    78 !!gm to be moved in usrdef of C1D case 
     78 
    7979!      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data 
    80 !!gm 
    8180 
    82       rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk 
    83       rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk 
    84       ts  (:,:,:,:,Kaa) = 0._wp                                   ! set one for all to 0 at level jpk 
    85       rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk 
     81      rhd  (:,:,:      ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk 
     82      rn2b (:,:,:      ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk 
     83      ts   (:,:,:,:,Kaa) = 0._wp                                   ! set one for all to 0 at level jpk 
     84      rab_b(:,:,:,:    ) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk 
    8685#if defined key_agrif 
    8786      uu   (:,:,:  ,Kaa) = 0._wp   ! used in agrif_oce_sponge at initialization 
    … …  
    9695         CALL agrif_istate( Kbb, Kmm, Kaa )   ! Interp from parent 
    9796         ! 
    98          ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)  
    99          ssh (:,:,Kmm)     = ssh(:,:,Kbb) 
    100          uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    101          vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
     97         ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) 
     98!!st 
     99!!st need for a recent agrif version to be displaced toward ssh_init_rst with agrif_istate_ssh 
     100         ssh(:,:,    Kmm) = ssh(:,:    ,Kbb) 
     101!!st end 
     102         uu (:,:,:  ,Kmm) = uu (:,:,:  ,Kbb) 
     103         vv (:,:,:  ,Kmm) = vv (:,:,:  ,Kbb) 
    102104      ELSE 
    103105#endif 
    … …  
    117119            CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) )       ! read 3D T and S data at nit000 
    118120            ! 
    119             ssh(:,:,Kbb)   = 0._wp               ! set the ocean at rest 
    120             uu  (:,:,:,Kbb) = 0._wp 
    121             vv  (:,:,:,Kbb) = 0._wp   
     121            uu (:,:,:,Kbb) = 0._wp 
     122            vv (:,:,:,Kbb) = 0._wp   
    122123            ! 
    123             IF( ll_wd ) THEN 
    124                ssh(:,:,Kbb) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD  
    125                ! 
    126                ! Apply minimum wetdepth criterion 
    127                ! 
    128                DO_2D( 1, 1, 1, 1 ) 
    129                   IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN 
    130                      ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
    131                   ENDIF 
    132                END_2D 
    133             ENDIF  
    134              ! 
    135124         ELSE                                 ! user defined initial T and S 
    136125            DO jk = 1, jpk 
    137126               zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 
    138127            END DO 
    139             CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )          
     128            CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb) ) 
    140129         ENDIF 
    141          ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
    142          ssh (:,:,Kmm)     = ssh(:,:,Kbb)    
    143          uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    144          vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
    145  
    146 !!gm POTENTIAL BUG : 
    147 !!gm  ISSUE :  if ssh(:,:,Kbb) /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed 
    148 !!             as well as gdept_ and gdepw_....   !!!!!  
    149 !!      ===>>>>   probably a call to domvvl initialisation here.... 
    150  
     130         ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
     131         uu (:,:,:  ,Kmm) = uu (:,:,:  ,Kbb) 
     132         vv (:,:,:  ,Kmm) = vv (:,:,:  ,Kbb) 
    151133 
    152134         ! 
    153 !!gm to be moved in usrdef of C1D case 
    154 !         IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000 
    155 !            ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 
    156 !            CALL dta_uvd( nit000, zuvd ) 
    157 !            uu(:,:,:,Kbb) = zuvd(:,:,:,1) ;  uu(:,:,:,Kmm) = uu(:,:,:,Kbb) 
    158 !            vv(:,:,:,Kbb) = zuvd(:,:,:,2) ;  vv(:,:,:,Kmm) = vv(:,:,:,Kbb) 
    159 !            DEALLOCATE( zuvd ) 
    160 !         ENDIF 
     135!!gm ==>>>  to be moved in usrdef_istate of C1D case  
     136         IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000 
     137            ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 
     138            CALL dta_uvd( nit000, Kbb, zuvd ) 
     139            uu(:,:,:,Kbb) = zuvd(:,:,:,1) ;  uu(:,:,:,Kmm) = uu(:,:,:,Kbb) 
     140            vv(:,:,:,Kbb) = zuvd(:,:,:,2) ;  vv(:,:,:,Kmm) = vv(:,:,:,Kbb) 
     141            DEALLOCATE( zuvd ) 
     142         ENDIF 
    161143         ! 
    162 !!gm This is to be changed !!!! 
    163 !         ! - ML - ssh(:,:,Kmm) could be modified by istate_eel, so that initialization of e3t(:,:,:,Kbb) is done here 
    164 !         IF( .NOT.ln_linssh ) THEN 
    165 !            DO jk = 1, jpk 
    166 !               e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 
    167 !            END DO 
    168 !         ENDIF 
    169 !!gm  
    170144         !  
    171145      ENDIF  

  • NEMO/trunk/src/OCE/DOM/phycst.F90

    r12489 r14053  
    6666   REAL(wp), PUBLIC ::   r1_rhos                     !: 1 / rhos 
    6767   REAL(wp), PUBLIC ::   r1_rcpi                     !: 1 / rcpi 
     68    
    6869   !!---------------------------------------------------------------------- 
    6970   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 

  • NEMO/trunk/src/OCE/DYN/dynadv.F90

    r12377 r14053  
    127127      IF( ioptio /= 1 )   CALL ctl_stop( 'choose ONE and only ONE advection scheme' ) 
    128128      IF( nn_dynkeg /= nkeg_C2 .AND. nn_dynkeg /= nkeg_HW )   CALL ctl_stop( 'KEG scheme wrong value of nn_dynkeg' ) 
    129  
     129#if defined key_qcoTest_FluxForm 
     130      IF( ln_dynadv_vec  ) THEN CALL ctl_stop( 'STOP', 'key_qcoTest_FluxForm requires flux form advection' ) 
     131#endif 
    130132 
    131133      IF(lwp) THEN                    ! Print the choice 

  • NEMO/trunk/src/OCE/DYN/dynatf_qco.F90

    r13295 r14053  
    1 MODULE dynatfqco 
     1MODULE dynatf_qco 
    22   !!========================================================================= 
    3    !!                       ***  MODULE  dynatfqco  *** 
     3   !!                       ***  MODULE  dynatf_qco  *** 
    44   !! Ocean dynamics: time filtering 
    55   !!========================================================================= 
    … …  
    5050   USE prtctl         ! Print control 
    5151   USE timing         ! Timing 
    52 #if defined key_agrif 
    53    USE agrif_oce_interp 
    54 #endif 
    5552 
    5653   IMPLICIT NONE 
    … …  
    199196      ! JC: Would be more clever to swap variables than to make a full vertical 
    200197      ! integration 
    201       ! 
     198      ! CAUTION : calculation need to be done in the same way than see GM   
    202199      uu_b(:,:,Kaa) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 
    203       uu_b(:,:,Kmm) = e3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 
     200      uu_b(:,:,Kmm) = (e3u_0(:,:,1) * ( 1._wp + r3u_f(:,:) * umask(:,:,1) )) * puu(:,:,1,Kmm) * umask(:,:,1) 
    204201      vv_b(:,:,Kaa) = e3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 
    205       vv_b(:,:,Kmm) = e3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 
     202      vv_b(:,:,Kmm) = (e3v_0(:,:,1) * ( 1._wp + r3v_f(:,:) * vmask(:,:,1))) * pvv(:,:,1,Kmm) * vmask(:,:,1) 
    206203      DO jk = 2, jpkm1 
    207204         uu_b(:,:,Kaa) = uu_b(:,:,Kaa) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 
    208          uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 
     205         uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + (e3u_0(:,:,jk) * ( 1._wp + r3u_f(:,:) * umask(:,:,jk) )) * puu(:,:,jk,Kmm) * umask(:,:,jk) 
    209206         vv_b(:,:,Kaa) = vv_b(:,:,Kaa) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 
    210          vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 
     207         vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + (e3v_0(:,:,jk) * ( 1._wp + r3v_f(:,:) * vmask(:,:,jk) )) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 
    211208      END DO 
    212209      uu_b(:,:,Kaa) = uu_b(:,:,Kaa) * r1_hu(:,:,Kaa) 
    213210      vv_b(:,:,Kaa) = vv_b(:,:,Kaa) * r1_hv(:,:,Kaa) 
    214       uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 
    215       vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm) 
     211      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * (r1_hu_0(:,:)/( 1._wp + r3u_f(:,:) )) 
     212      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * (r1_hv_0(:,:)/( 1._wp + r3v_f(:,:) )) 
    216213      ! 
    217214      IF( .NOT.ln_dynspg_ts ) THEN        ! output the barotropic currents 
    … …  
    235232 
    236233   !!========================================================================= 
    237 END MODULE dynatfqco 
     234END MODULE dynatf_qco 

  • NEMO/trunk/src/OCE/DYN/dynldf_lap_blp.F90

    r13497 r14053  
    55   !!====================================================================== 
    66   !! History : 3.7  ! 2014-01  (G. Madec, S. Masson)  Original code, re-entrant laplacian 
     7   !!           4.0  ! 2020-04  (A. Nasser, G. Madec)  Add symmetric mixing tensor  
    78   !!---------------------------------------------------------------------- 
    89 
    … …  
    1920   USE in_out_manager ! I/O manager 
    2021   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    21  
     22   USE lib_mpp 
     23    
    2224   IMPLICIT NONE 
    2325   PRIVATE 
    … …  
    4749      !! 
    4850      !! ** Action : - pu_rhs, pv_rhs increased by the harmonic operator applied on pu, pv. 
     51      !! 
     52      !! Reference : S.Griffies, R.Hallberg 2000 Mon.Wea.Rev., DOI:/  
    4953      !!---------------------------------------------------------------------- 
    5054      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
    … …  
    5761      REAL(wp) ::   zsign        ! local scalars 
    5862      REAL(wp) ::   zua, zva     ! local scalars 
    59       REAL(wp), DIMENSION(jpi,jpj) ::   zcur, zdiv 
     63      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zcur, zdiv 
     64      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zten, zshe   ! tension (diagonal) and shearing (anti-diagonal) terms 
    6065      !!---------------------------------------------------------------------- 
    6166      ! 
    … …  
    7075      ENDIF 
    7176      ! 
    72       !                                                ! =============== 
    73       DO jk = 1, jpkm1                                 ! Horizontal slab 
    74          !                                             ! =============== 
    75          DO_2D( 0, 1, 0, 1 ) 
    76             !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
    77             zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &   ! ahmf already * by fmask 
    78                &     * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  & 
    79                &        - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  ) 
    80             !                                      ! ahm * div        (computed from 2 to jpi/jpj) 
    81             zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)               &   ! ahmt already * by tmask 
    82                &     * (  e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  & 
    83                &        + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk)  ) 
    84          END_2D 
     77      SELECT CASE( nn_dynldf_typ )   
     78      !               
     79      CASE ( np_typ_rot )       !==  Vorticity-Divergence operator  ==! 
    8580         ! 
    86          DO_2D( 0, 0, 0, 0 )                       ! - curl( curl) + grad( div ) 
    87             pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use 
    88                &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   & 
    89                &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                      ) 
     81         ALLOCATE( zcur(jpi,jpj) , zdiv(jpi,jpj) ) 
     82         ! 
     83         DO jk = 1, jpkm1                                 ! Horizontal slab 
     84            ! 
     85            DO_2D( 0, 1, 0, 1 ) 
     86               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
     87               zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &   ! ahmf already * by fmask 
     88                  &     * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  & 
     89                  &        - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  ) 
     90               !                                      ! ahm * div        (computed from 2 to jpi/jpj) 
     91               zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)               &   ! ahmt already * by tmask 
     92                  &     * (  e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  & 
     93                  &        + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk)  ) 
     94            END_2D 
     95            ! 
     96            DO_2D( 0, 0, 0, 0 )                       ! - curl( curl) + grad( div ) 
     97               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use 
     98                  &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   & 
     99                  &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                      ) 
    90100               ! 
    91             pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * vmask(ji,jj,jk) * (    &    ! * by vmask is mandatory for dyn_ldf_blp use 
    92                &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm)   & 
    93                &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                      ) 
    94          END_2D 
    95          !                                             ! =============== 
    96       END DO                                           !   End of slab 
    97       !                                                ! =============== 
     101               pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * vmask(ji,jj,jk) * (    &    ! * by vmask is mandatory for dyn_ldf_blp use 
     102                  &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm)   & 
     103                  &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                      ) 
     104            END_2D 
     105            ! 
     106         END DO                                           !   End of slab 
     107         ! 
     108         DEALLOCATE( zcur , zdiv ) 
     109         ! 
     110      CASE ( np_typ_sym )       !==  Symmetric operator  ==! 
     111         ! 
     112         ALLOCATE( zten(jpi,jpj) , zshe(jpi,jpj) ) 
     113         ! 
     114         DO jk = 1, jpkm1                                 ! Horizontal slab 
     115            ! 
     116            DO_2D( 0, 1, 0, 1 ) 
     117               !                                      ! shearing stress component (F-point)   NB : ahmf has already been multiplied by fmask 
     118               zshe(ji-1,jj-1) = ahmf(ji-1,jj-1,jk)                                                              & 
     119                  &     * (    e1f(ji-1,jj-1)    * r1_e2f(ji-1,jj-1)                                             & 
     120                  &         * ( pu(ji-1,jj  ,jk) * r1_e1u(ji-1,jj  )  - pu(ji-1,jj-1,jk) * r1_e1u(ji-1,jj-1) )   & 
     121                  &         +  e2f(ji-1,jj-1)    * r1_e1f(ji-1,jj-1)                                             & 
     122                  &         * ( pv(ji  ,jj-1,jk) * r1_e2v(ji  ,jj-1)  - pv(ji-1,jj-1,jk) * r1_e2v(ji-1,jj-1) )   )  
     123               !                                      ! tension stress component (T-point)   NB : ahmt has already been multiplied by tmask 
     124               zten(ji,jj)    = ahmt(ji,jj,jk)                                                       & 
     125                  &     * (    e2t(ji,jj)    * r1_e1t(ji,jj)                                         & 
     126                  &         * ( pu(ji,jj,jk) * r1_e2u(ji,jj)  - pu(ji-1,jj,jk) * r1_e2u(ji-1,jj) )   & 
     127                  &         -  e1t(ji,jj)    * r1_e2t(ji,jj)                                         & 
     128                  &         * ( pv(ji,jj,jk) * r1_e1v(ji,jj)  - pv(ji,jj-1,jk) * r1_e1v(ji,jj-1) )   )    
     129            END_2D 
     130            ! 
     131            DO_2D( 0, 0, 0, 0 ) 
     132               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)                               & 
     133                  &    * (   (   zten(ji+1,jj  ) * e2t(ji+1,jj  )*e2t(ji+1,jj  ) * e3t(ji+1,jj  ,jk,Kmm)                       & 
     134                  &            - zten(ji  ,jj  ) * e2t(ji  ,jj  )*e2t(ji  ,jj  ) * e3t(ji  ,jj  ,jk,Kmm) ) * r1_e2u(ji,jj)     &                                                     
     135                  &        + (   zshe(ji  ,jj  ) * e1f(ji  ,jj  )*e1f(ji  ,jj  ) * e3f(ji  ,jj  ,jk)                           & 
     136                  &            - zshe(ji  ,jj-1) * e1f(ji  ,jj-1)*e1f(ji  ,jj-1) * e3f(ji  ,jj-1,jk)     ) * r1_e1u(ji,jj) )    
     137               ! 
     138               pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)                               & 
     139                  &    * (   (   zshe(ji  ,jj  ) * e2f(ji  ,jj  )*e2f(ji  ,jj  ) * e3f(ji  ,jj  ,jk)                           & 
     140                  &            - zshe(ji-1,jj  ) * e2f(ji-1,jj  )*e2f(ji-1,jj  ) * e3f(ji-1,jj  ,jk)     ) * r1_e2v(ji,jj)     & 
     141                  &        - (   zten(ji  ,jj+1) * e1t(ji  ,jj+1)*e1t(ji  ,jj+1) * e3t(ji  ,jj+1,jk,Kmm)                       & 
     142                  &            - zten(ji  ,jj  ) * e1t(ji  ,jj  )*e1t(ji  ,jj  ) * e3t(ji  ,jj  ,jk,Kmm) ) * r1_e1v(ji,jj) ) 
     143               ! 
     144            END_2D 
     145            ! 
     146         END DO 
     147         ! 
     148         DEALLOCATE( zten , zshe ) 
     149         ! 
     150      END SELECT 
    98151      ! 
    99152   END SUBROUTINE dyn_ldf_lap 

  • NEMO/trunk/src/OCE/DYN/dynspg_ts.F90

    r13970 r14053  
    306306      ENDIF 
    307307      ! 
    308       !                                   !=  Add atmospheric pressure forcing  =! 
    309       !                                   !  ----------------------------------  ! 
    310       IF( ln_bt_fw ) THEN                        ! Add wind forcing 
     308      !                                   !=  Add wind forcing  =! 
     309      !                                   !  ------------------  ! 
     310      IF( ln_bt_fw ) THEN 
    311311         DO_2D( 0, 0, 0, 0 ) 
    312312            zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rho0 * utau(ji,jj) * r1_hu(ji,jj,Kmm) 
    … …  
    386386      ! 
    387387      IF( ln_linssh ) THEN    ! mid-step ocean depth is fixed (hup2_e=hu_n=hu_0) 
    388          zhup2_e(:,:) = hu(:,:,Kmm) 
    389          zhvp2_e(:,:) = hv(:,:,Kmm) 
    390          zhtp2_e(:,:) = ht(:,:) 
    391       ENDIF 
    392       ! 
    393       IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                     
    394          sshn_e(:,:) =    pssh(:,:,Kmm)             
     388         zhup2_e(:,:) = hu_0(:,:) 
     389         zhvp2_e(:,:) = hv_0(:,:) 
     390         zhtp2_e(:,:) = ht_0(:,:) 
     391      ENDIF 
     392      ! 
     393      IF( ln_bt_fw ) THEN                 ! FORWARD integration: start from NOW fields                     
     394         sshn_e(:,:) =    pssh (:,:,Kmm)             
    395395         un_e  (:,:) =    puu_b(:,:,Kmm)             
    396396         vn_e  (:,:) =    pvv_b(:,:,Kmm) 
    … …  
    401401         hvr_e (:,:) = r1_hv(:,:,Kmm) 
    402402      ELSE                                ! CENTRED integration: start from BEFORE fields 
    403          sshn_e(:,:) =    pssh(:,:,Kbb) 
     403         sshn_e(:,:) =    pssh (:,:,Kbb) 
    404404         un_e  (:,:) =    puu_b(:,:,Kbb)          
    405405         vn_e  (:,:) =    pvv_b(:,:,Kbb) 
    … …  
    412412      ! 
    413413      ! Initialize sums: 
    414       puu_b  (:,:,Kaa) = 0._wp       ! After barotropic velocities (or transport if flux form)           
    415       pvv_b  (:,:,Kaa) = 0._wp 
     414      puu_b (:,:,Kaa) = 0._wp       ! After barotropic velocities (or transport if flux form)           
     415      pvv_b (:,:,Kaa) = 0._wp 
    416416      pssh  (:,:,Kaa) = 0._wp       ! Sum for after averaged sea level 
    417       un_adv(:,:) = 0._wp       ! Sum for now transport issued from ts loop 
    418       vn_adv(:,:) = 0._wp 
     417      un_adv(:,:)     = 0._wp       ! Sum for now transport issued from ts loop 
     418      vn_adv(:,:)     = 0._wp 
    419419      ! 
    420420      IF( ln_wd_dl ) THEN 
    … …  
    475475            ! 
    476476            !                          ! ocean u- and v-depth at mid-step   (separate DO-loops remove the need of a lbc_lnk) 
     477#if defined key_qcoTest_FluxForm 
     478            !                                ! 'key_qcoTest_FluxForm' : simple ssh average 
     479            DO_2D( 1, 1, 1, 0 )   ! not jpi-column 
     480               zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * (  zsshp2_e(ji,jj) + zsshp2_e(ji+1,jj  )  ) * ssumask(ji,jj) 
     481            END_2D 
     482            DO_2D( 1, 0, 1, 1 ) 
     483               zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * (  zsshp2_e(ji,jj) + zsshp2_e(ji  ,jj+1)  ) * ssvmask(ji,jj) 
     484            END_2D 
     485#else 
     486            !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
    477487            DO_2D( 1, 1, 1, 0 )   ! not jpi-column 
    478488               zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        & 
    … …  
    485495                    &                                 + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj) 
    486496            END_2D 
     497#endif                
    487498            ! 
    488499         ENDIF 
    … …  
    540551         !   
    541552         ! Sea Surface Height at u-,v-points (vvl case only) 
    542          IF( .NOT.ln_linssh ) THEN                                 
     553         IF( .NOT.ln_linssh ) THEN 
     554#if defined key_qcoTest_FluxForm 
     555            !                                ! 'key_qcoTest_FluxForm' : simple ssh average 
     556            DO_2D( 1, 1, 1, 0 ) 
     557               zsshu_a(ji,jj) = r1_2 * (  ssha_e(ji,jj) + ssha_e(ji+1,jj  )  ) * ssumask(ji,jj) 
     558            END_2D 
     559            DO_2D( 1, 0, 1, 1 ) 
     560               zsshv_a(ji,jj) = r1_2 * (  ssha_e(ji,jj) + ssha_e(ji  ,jj+1)  ) * ssvmask(ji,jj) 
     561            END_2D 
     562#else 
    543563            DO_2D( 0, 0, 0, 0 ) 
    544                zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    & 
    545                   &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
    546                   &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) ) 
    547                zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    & 
    548                   &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
    549                   &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) ) 
    550             END_2D 
    551          ENDIF    
     564               zsshu_a(ji,jj) = r1_2 * r1_e1e2u(ji,jj) * ( e1e2t(ji  ,jj  ) * ssha_e(ji  ,jj  )   & 
     565                  &                                      + e1e2t(ji+1,jj  ) * ssha_e(ji+1,jj  ) ) * ssumask(ji,jj) 
     566               zsshv_a(ji,jj) = r1_2 * r1_e1e2v(ji,jj) * ( e1e2t(ji  ,jj  ) * ssha_e(ji  ,jj  )   & 
     567                  &                                      + e1e2t(ji  ,jj+1) * ssha_e(ji  ,jj+1) ) * ssvmask(ji,jj) 
     568            END_2D 
     569#endif 
     570         ENDIF 
    552571         !          
    553572         ! Half-step back interpolation of SSH for surface pressure computation at step jit+1/2 
    … …  
    624643               !                    ! hu_e, hv_e hold depth at jn,  zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2 
    625644               !                    ! backward interpolated depth used in spg terms at jn+1/2 
     645#if defined key_qcoTest_FluxForm 
     646            !                                ! 'key_qcoTest_FluxForm' : simple ssh average 
     647               zhu_bck = hu_0(ji,jj) + r1_2 * (  zsshp2_e(ji,jj) + zsshp2_e(ji+1,jj  )  ) * ssumask(ji,jj) 
     648               zhv_bck = hv_0(ji,jj) + r1_2 * (  zsshp2_e(ji,jj) + zsshp2_e(ji  ,jj+1)  ) * ssvmask(ji,jj) 
     649#else 
    626650               zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)    & 
    627651                    &                                          + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj) 
    628652               zhv_bck = hv_0(ji,jj) + r1_2*r1_e1e2v(ji,jj) * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )    & 
    629653                    &                                          + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj) 
     654#endif 
    630655               !                    ! inverse depth at jn+1 
    631656               z1_hu = ssumask(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) ) 
    … …  
    646671         IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs 
    647672            DO_2D( 0, 0, 0, 0 ) 
    648                   ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rDt_e * zCdU_u(ji,jj) * hur_e(ji,jj)) 
    649                   va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rDt_e * zCdU_v(ji,jj) * hvr_e(ji,jj)) 
     673               ua_e(ji,jj) =  ua_e(ji,jj) / ( 1._wp - rDt_e * zCdU_u(ji,jj) * hur_e(ji,jj) ) 
     674               va_e(ji,jj) =  va_e(ji,jj) / ( 1._wp - rDt_e * zCdU_v(ji,jj) * hvr_e(ji,jj) ) 
    650675            END_2D 
    651676         ENDIF 
    652677        
    653678         IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 
    654             hu_e (2:jpim1,2:jpjm1) = hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1) 
    655             hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / ( hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1) ) 
    656             hv_e (2:jpim1,2:jpjm1) = hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1) 
    657             hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) ) 
     679            hu_e (2:jpim1,2:jpjm1) =    hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1) 
     680            hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / (  hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1) ) 
     681            hv_e (2:jpim1,2:jpjm1) =    hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1) 
     682            hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / (  hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) ) 
    658683         ENDIF 
    659684         ! 
    … …  
    743768      ELSE 
    744769         ! At this stage, pssh(:,:,:,Krhs) has been corrected: compute new depths at velocity points 
     770#if defined key_qcoTest_FluxForm 
     771         !                                ! 'key_qcoTest_FluxForm' : simple ssh average 
    745772         DO_2D( 1, 0, 1, 0 ) 
    746             zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj) & 
    747                &              * ( e1e2t(ji  ,jj) * pssh(ji  ,jj,Kaa)      & 
    748                &              +   e1e2t(ji+1,jj) * pssh(ji+1,jj,Kaa) ) 
    749             zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj) & 
    750                &              * ( e1e2t(ji,jj  ) * pssh(ji,jj  ,Kaa)      & 
    751                &              +   e1e2t(ji,jj+1) * pssh(ji,jj+1,Kaa) ) 
    752          END_2D 
     773            zsshu_a(ji,jj) = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji+1,jj  ,Kaa) ) * ssumask(ji,jj) 
     774            zsshv_a(ji,jj) = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji  ,jj+1,Kaa) ) * ssvmask(ji,jj) 
     775         END_2D 
     776#else 
     777         DO_2D( 1, 0, 1, 0 ) 
     778            zsshu_a(ji,jj) = r1_2 * r1_e1e2u(ji,jj) * ( e1e2t(ji  ,jj) * pssh(ji  ,jj,Kaa)   & 
     779               &                                      + e1e2t(ji+1,jj) * pssh(ji+1,jj,Kaa) ) * ssumask(ji,jj) 
     780            zsshv_a(ji,jj) = r1_2 * r1_e1e2v(ji,jj) * ( e1e2t(ji,jj  ) * pssh(ji,jj  ,Kaa)   & 
     781               &                                      + e1e2t(ji,jj+1) * pssh(ji,jj+1,Kaa) ) * ssvmask(ji,jj) 
     782         END_2D 
     783#endif    
    753784         CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 
    754785         ! 
    755786         DO jk=1,jpkm1 
    756             puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm) * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_Dt_b 
    757             pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm) * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_Dt_b 
     787            puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm)   & 
     788               &             * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_Dt_b 
     789            pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm)   & 
     790               &             * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_Dt_b 
    758791         END DO 
    759792         ! Save barotropic velocities not transport: 
    … …  
    899932      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
    900933         !                                   ! --------------- 
    901          IF( ln_rstart .AND. ln_bt_fw .AND. (.NOT.l_1st_euler) ) THEN    !* Read the restart file 
     934         IF( ln_rstart .AND. ln_bt_fw .AND. .NOT.l_1st_euler ) THEN    !* Read the restart file 
    902935            CALL iom_get( numror, jpdom_auto, 'ub2_b'  , ub2_b  (:,:), cd_type = 'U', psgn = -1._wp )    
    903936            CALL iom_get( numror, jpdom_auto, 'vb2_b'  , vb2_b  (:,:), cd_type = 'V', psgn = -1._wp )  
    … …  
    10601093      !! although they should be updated in the variable volume case. Not a big approximation. 
    10611094      !! To remove this approximation, copy lines below inside barotropic loop 
    1062       !! and update depths at T-F points (ht and zhf resp.) at each barotropic time step 
     1095      !! and update depths at T- points (ht) at each barotropic time step 
    10631096      !! 
    10641097      !! Compute zwz = f / ( height of the water colomn ) 
    … …  
    10671100      INTEGER  ::   ji ,jj, jk              ! dummy loop indices 
    10681101      REAL(wp) ::   z1_ht 
    1069       REAL(wp), DIMENSION(jpi,jpj) :: zhf 
    10701102      !!---------------------------------------------------------------------- 
    10711103      ! 
    10721104      SELECT CASE( nvor_scheme ) 
    1073       CASE( np_EEN )                != EEN scheme using e3f energy & enstrophy scheme 
    1074          SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point 
     1105      CASE( np_EEN, np_ENE, np_ENS , np_MIX )   !=  schemes using the same e3f definition 
     1106         SELECT CASE( nn_e3f_typ )                  !* ff_f/e3 at F-point 
    10751107         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    1076             DO_2D( 1, 0, 1, 0 ) 
    1077                zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                    & 
    1078                     &           ht(ji  ,jj  ) + ht(ji+1,jj  )  ) * 0.25_wp   
     1108            DO_2D( 0, 0, 0, 0 ) 
     1109               zwz(ji,jj) = ( ht(ji,jj+1) + ht(ji+1,jj+1)   & 
     1110                    &       + ht(ji,jj  ) + ht(ji+1,jj  ) ) * 0.25_wp   
    10791111               IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj) 
    10801112            END_2D 
    10811113         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
    1082             DO_2D( 1, 0, 1, 0 ) 
    1083                zwz(ji,jj) =             (  ht  (ji  ,jj+1) + ht  (ji+1,jj+1)      & 
    1084                     &                    + ht  (ji  ,jj  ) + ht  (ji+1,jj  )  )   & 
    1085                     &       / ( MAX( 1._wp,  ssmask(ji  ,jj+1) + ssmask(ji+1,jj+1)      & 
    1086                     &                      + ssmask(ji  ,jj  ) + ssmask(ji+1,jj  )  )   ) 
     1114            DO_2D( 0, 0, 0, 0 ) 
     1115               zwz(ji,jj) =     (    ht(ji,jj+1) +     ht(ji+1,jj+1)      & 
     1116                    &            +   ht(ji,jj  ) +     ht(ji+1,jj  )  )   & 
     1117                    &    / ( MAX(ssmask(ji,jj+1) + ssmask(ji+1,jj+1)      & 
     1118                    &          + ssmask(ji,jj  ) + ssmask(ji+1,jj  ) , 1._wp  )   ) 
    10871119               IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj) 
    10881120            END_2D 
    10891121         END SELECT 
    10901122         CALL lbc_lnk( 'dynspg_ts', zwz, 'F', 1._wp ) 
    1091          ! 
    1092          ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
     1123      END SELECT 
     1124      ! 
     1125      SELECT CASE( nvor_scheme ) 
     1126      CASE( np_EEN ) 
     1127         ! 
     1128         ftne(1,:) = 0._wp   ;   ftnw(1,:) = 0._wp   ;   ftse(1,:) = 0._wp   ;   ftsw(1,:) = 0._wp 
    10931129         DO_2D( 0, 1, 0, 1 ) 
    10941130            ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) 
    … …  
    10981134         END_2D 
    10991135         ! 
    1100       CASE( np_EET )                  != EEN scheme using e3t energy conserving scheme 
    1101          ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
     1136      CASE( np_EET )                            != EEN scheme using e3t energy conserving scheme 
     1137         ftne(1,:) = 0._wp   ;   ftnw(1,:) = 0._wp   ;   ftse(1,:) = 0._wp   ;  ftsw(1,:) = 0._wp 
    11021138         DO_2D( 0, 1, 0, 1 ) 
    11031139            z1_ht = ssmask(ji,jj) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) ) 
    … …  
    11081144         END_2D 
    11091145         ! 
    1110       CASE( np_ENE, np_ENS , np_MIX )  != all other schemes (ENE, ENS, MIX) except ENT ! 
    1111          ! 
    1112          zwz(:,:) = 0._wp 
    1113          zhf(:,:) = 0._wp 
    1114           
    1115          !!gm  assume 0 in both cases (which is almost surely WRONG ! ) as hvatf has been removed  
    1116 !!gm    A priori a better value should be something like : 
    1117 !!gm          zhf(i,j) = masked sum of  ht(i,j) , ht(i+1,j) , ht(i,j+1) , (i+1,j+1)  
    1118 !!gm                     divided by the sum of the corresponding mask  
    1119 !!gm  
    1120 !!             
    1121          IF( .NOT.ln_sco ) THEN 
    1122    
    1123    !!gm  agree the JC comment  : this should be done in a much clear way 
    1124    
    1125    ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case 
    1126    !     Set it to zero for the time being  
    1127    !              IF( rn_hmin < 0._wp ) THEN    ;   jk = - INT( rn_hmin )                                      ! from a nb of level 
    1128    !              ELSE                          ;   jk = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 )  ! from a depth 
    1129    !              ENDIF 
    1130    !              zhf(:,:) = gdepw_0(:,:,jk+1) 
    1131             ! 
    1132          ELSE 
    1133             ! 
    1134             !zhf(:,:) = hbatf(:,:) 
    1135             DO_2D( 1, 0, 1, 0 ) 
    1136                zhf(ji,jj) =    (   ht_0  (ji,jj  ) + ht_0  (ji+1,jj  )          & 
    1137                     &            + ht_0  (ji,jj+1) + ht_0  (ji+1,jj+1)   )      & 
    1138                     &     / MAX(   ssmask(ji,jj  ) + ssmask(ji+1,jj  )          & 
    1139                     &            + ssmask(ji,jj+1) + ssmask(ji+1,jj+1) , 1._wp  ) 
    1140             END_2D 
    1141          ENDIF 
    1142          ! 
    1143          DO jj = 1, jpjm1 
    1144             zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 
    1145          END DO 
    1146          ! 
    1147          DO jk = 1, jpkm1 
    1148             DO jj = 1, jpjm1 
    1149                zhf(:,jj) = zhf(:,jj) + e3f(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 
    1150             END DO 
    1151          END DO 
    1152          CALL lbc_lnk( 'dynspg_ts', zhf, 'F', 1._wp ) 
    1153          ! JC: TBC. hf should be greater than 0  
    1154          DO_2D( 1, 1, 1, 1 ) 
    1155             IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj) 
    1156          END_2D 
    1157          zwz(:,:) = ff_f(:,:) * zwz(:,:) 
    11581146      END SELECT 
    11591147       
    11601148   END SUBROUTINE dyn_cor_2d_init 
    1161  
    11621149 
    11631150 
    … …  
    13531340   END SUBROUTINE wad_spg 
    13541341      
    1355  
    13561342 
    13571343   SUBROUTINE dyn_drg_init( Kbb, Kmm, puu, pvv, puu_b ,pvv_b, pu_RHSi, pv_RHSi, pCdU_u, pCdU_v ) 

  • NEMO/trunk/src/OCE/DYN/dynvor.F90

    r14007 r14053  
    2121   !!             -   ! 2018-03  (G. Madec)  add two new schemes (ln_dynvor_enT and ln_dynvor_eet) 
    2222   !!             -   ! 2018-04  (G. Madec)  add pre-computed gradient for metric term calculation 
     23   !!            4.x  ! 2020-03  (G. Madec, A. Nasser)  make ln_dynvor_msk truly efficient on relative vorticity 
    2324   !!            4.2  ! 2020-12  (G. Madec, E. Clementi) add vortex force trends (ln_vortex_force=T) 
    2425   !!---------------------------------------------------------------------- 
    … …  
    2627   !!---------------------------------------------------------------------- 
    2728   !!   dyn_vor       : Update the momentum trend with the vorticity trend 
     29   !!       vor_enT   : energy conserving scheme at T-pt  (ln_dynvor_enT=T) 
     30   !!       vor_ene   : energy conserving scheme          (ln_dynvor_ene=T) 
    2831   !!       vor_ens   : enstrophy conserving scheme       (ln_dynvor_ens=T) 
    29    !!       vor_ene   : energy conserving scheme          (ln_dynvor_ene=T) 
    3032   !!       vor_een   : energy and enstrophy conserving   (ln_dynvor_een=T) 
     33   !!       vor_eeT   : energy conserving at T-pt         (ln_dynvor_eeT=T) 
    3134   !!   dyn_vor_init  : set and control of the different vorticity option 
    3235   !!---------------------------------------------------------------------- 
    … …  
    5861   LOGICAL, PUBLIC ::   ln_dynvor_eeT   !: t-point energy conserving scheme     (EET) 
    5962   LOGICAL, PUBLIC ::   ln_dynvor_een   !: energy & enstrophy conserving scheme (EEN) 
    60    INTEGER, PUBLIC ::      nn_een_e3f      !: e3f=masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    6163   LOGICAL, PUBLIC ::   ln_dynvor_mix   !: mixed scheme                         (MIX) 
    6264   LOGICAL, PUBLIC ::   ln_dynvor_msk   !: vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes) 
     65   INTEGER, PUBLIC ::   nn_e3f_typ      !: e3f=masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    6366 
    6467   INTEGER, PUBLIC ::   nvor_scheme     !: choice of the type of advection scheme 
    … …  
    8184   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2u_2        ! = di(e2u)/2          used in T-point metric term calculation 
    8285   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1v_2        ! = dj(e1v)/2           -        -      -       -  
    83    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2v_2e1e2f   ! = di(e2v)/(2*e1e2f)  used in F-point metric term calculation 
    84    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1u_2e1e2f   ! = dj(e1u)/(2*e1e2f)   -        -      -       -  
     86   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2v_2e1e2f   ! = di(e2u)/(2*e1e2f)  used in F-point metric term calculation 
     87   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1u_2e1e2f   ! = dj(e1v)/(2*e1e2f)   -        -      -       - 
     88   ! 
     89   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   e3f_0vor   ! e3f used in EEN, ENE and ENS cases (key_qco only) 
    8590    
    8691   REAL(wp) ::   r1_4  = 0.250_wp         ! =1/4 
    … …  
    235240      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    236241      REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars 
    237       REAL(wp), DIMENSION(jpi,jpj)       ::   zwx, zwy, zwt   ! 2D workspace 
    238       REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwz             ! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined 
     242      REAL(wp), DIMENSION(jpi,jpj)     ::   zwx, zwy, zwt   ! 2D workspace 
     243      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwz      ! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined 
    239244      !!---------------------------------------------------------------------- 
    240245      ! 
    … …  
    246251      ! 
    247252      ! 
    248       SELECT CASE( kvor )                 !==  volume weighted vorticity considered  ==! 
    249       CASE ( np_RVO )                           !* relative vorticity 
    250          DO jk = 1, jpkm1                                 ! Horizontal slab 
     253      SELECT CASE( kvor )                 !== relative vorticity considered  ==! 
     254      ! 
     255      CASE ( np_RVO , np_CRV )                  !* relative vorticity at f-point is used 
     256         ALLOCATE( zwz(jpi,jpj,jpk) ) 
     257         DO jk = 1, jpkm1                                ! Horizontal slab 
    251258            DO_2D( 1, 0, 1, 0 ) 
    252259               zwz(ji,jj,jk) = (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  & 
    253260                  &             - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    254261            END_2D 
    255             IF( ln_dynvor_msk ) THEN                     ! mask/unmask relative vorticity  
     262            IF( ln_dynvor_msk ) THEN                     ! mask relative vorticity  
    256263               DO_2D( 1, 0, 1, 0 ) 
    257264                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    … …  
    259266            ENDIF 
    260267         END DO 
    261  
    262268         CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    263  
    264       CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    265          DO jk = 1, jpkm1                                 ! Horizontal slab 
    266             DO_2D( 1, 0, 1, 0 )                          ! relative vorticity 
    267                zwz(ji,jj,jk) = (   e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)   & 
    268                   &              - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)   ) * r1_e1e2f(ji,jj) 
    269             END_2D 
    270             IF( ln_dynvor_msk ) THEN                     ! mask/unmask relative vorticity  
    271                DO_2D( 1, 0, 1, 0 ) 
    272                   zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    273                END_2D 
    274             ENDIF 
    275          END DO 
    276  
    277          CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    278  
     269         ! 
    279270      END SELECT 
    280271 
    281272      !                                                ! =============== 
    282273      DO jk = 1, jpkm1                                 ! Horizontal slab 
    283       !                                                ! =============== 
    284  
     274         !                                             ! =============== 
     275         ! 
    285276         SELECT CASE( kvor )                 !==  volume weighted vorticity considered  ==! 
     277         ! 
    286278         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    287279            zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t(:,:,jk,Kmm) 
    288280         CASE ( np_RVO )                           !* relative vorticity 
    289281            DO_2D( 0, 1, 0, 1 ) 
    290                zwt(ji,jj) = r1_4 * (   zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)   & 
    291                   &                  + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) & 
    292                   &                  * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 
     282               zwt(ji,jj) = r1_4 * (   zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)       & 
     283                  &                  + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk)   )  & 
     284                  &              * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 
    293285            END_2D 
    294286         CASE ( np_MET )                           !* metric term 
    295287            DO_2D( 0, 1, 0, 1 ) 
    296                zwt(ji,jj) = (   ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)   & 
    297                   &           - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)   ) & 
    298                   &             * e3t(ji,jj,jk,Kmm) 
     288               zwt(ji,jj) = (   ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)       & 
     289                  &           - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)   )   & 
     290                  &       * e3t(ji,jj,jk,Kmm) 
    299291            END_2D 
    300292         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    301293            DO_2D( 0, 1, 0, 1 ) 
    302                zwt(ji,jj) = (  ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)    & 
    303                   &                                 + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) )  ) & 
    304                   &                                 * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 
     294               zwt(ji,jj) = (  ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)        & 
     295                  &                                 + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) )  )   & 
     296                  &       * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 
    305297            END_2D 
    306298         CASE ( np_CME )                           !* Coriolis + metric 
    307299            DO_2D( 0, 1, 0, 1 ) 
    308                zwt(ji,jj) = (  ff_t(ji,jj) * e1e2t(ji,jj)                           & 
    309                     &        + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)  & 
    310                     &        - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)  ) & 
    311                     &          * e3t(ji,jj,jk,Kmm) 
     300               zwt(ji,jj) = (  ff_t(ji,jj) * e1e2t(ji,jj)                               & 
     301                    &        + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)      & 
     302                    &        - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)  )   & 
     303                    &     * e3t(ji,jj,jk,Kmm) 
    312304            END_2D 
    313305         CASE DEFAULT                                             ! error 
    314             CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  ) 
     306            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor') 
    315307         END SELECT 
    316308         ! 
    … …  
    328320      END DO                                           !   End of slab 
    329321      !                                                ! =============== 
     322      ! 
     323      SELECT CASE( kvor )        ! deallocate zwz if necessary 
     324      CASE ( np_RVO , np_CRV )   ;   DEALLOCATE( zwz ) 
     325      END SELECT 
     326      ! 
    330327   END SUBROUTINE vor_enT 
    331328 
    … …  
    358355      ! 
    359356      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    360       REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars 
     357      REAL(wp) ::   zx1, zy1, zx2, zy2, ze3f, zmsk   ! local scalars 
    361358      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz   ! 2D workspace 
    362359      !!---------------------------------------------------------------------- 
    … …  
    380377                  &          - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    381378            END_2D 
     379            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
     380               DO_2D( 1, 0, 1, 0 ) 
     381                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 
     382               END_2D 
     383            ENDIF 
    382384         CASE ( np_MET )                           !* metric term 
    383385            DO_2D( 1, 0, 1, 0 ) 
    … …  
    390392                  &                        - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    391393            END_2D 
     394            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity (NOT the Coriolis term) 
     395               DO_2D( 1, 0, 1, 0 ) 
     396                  zwz(ji,jj) = ( zwz(ji,jj) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 
     397               END_2D 
     398            ENDIF 
    392399         CASE ( np_CME )                           !* Coriolis + metric 
    393400            DO_2D( 1, 0, 1, 0 ) 
    … …  
    399406         END SELECT 
    400407         ! 
    401          IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==! 
    402             DO_2D( 1, 0, 1, 0 ) 
    403                zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 
    404             END_2D 
    405          ENDIF 
    406  
    407          IF( ln_sco ) THEN 
    408             zwz(:,:) = zwz(:,:) / e3f(:,:,jk) 
    409             zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    410             zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
    411          ELSE 
    412             zwx(:,:) = e2u(:,:) * pu(:,:,jk) 
    413             zwy(:,:) = e1v(:,:) * pv(:,:,jk) 
    414          ENDIF 
     408#if defined key_qco 
     409         DO_2D( 1, 0, 1, 0 )                 !==  potential vorticity  ==!   (key_qco) 
     410            zwz(ji,jj) = zwz(ji,jj) / e3f_vor(ji,jj,jk) 
     411         END_2D 
     412#else 
     413         SELECT CASE( nn_e3f_typ  )           !==  potential vorticity  ==! 
     414         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
     415            DO_2D( 1, 0, 1, 0 ) 
     416               ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   & 
     417                  &    + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   & 
     418                  &    + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   & 
     419                  &    + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  ) 
     420               IF( ze3f /= 0._wp ) THEN   ;   zwz(ji,jj) = zwz(ji,jj) * 4._wp / ze3f 
     421               ELSE                       ;   zwz(ji,jj) = 0._wp 
     422               ENDIF 
     423            END_2D 
     424         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
     425            DO_2D( 1, 0, 1, 0 ) 
     426               ze3f = (   e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   & 
     427                  &     + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   & 
     428                  &     + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   & 
     429                  &     + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)   ) 
     430               zmsk = (   tmask(ji,jj+1,jk)   + tmask(ji+1,jj+1,jk)   & 
     431                  &     + tmask(ji,jj  ,jk)   + tmask(ji+1,jj  ,jk)   ) 
     432               IF( ze3f /= 0._wp ) THEN   ;   zwz(ji,jj) = zwz(ji,jj) * zmsk / ze3f 
     433               ELSE                       ;   zwz(ji,jj) = 0._wp 
     434               ENDIF 
     435            END_2D 
     436         END SELECT 
     437#endif 
     438         !                                   !==  horizontal fluxes  ==! 
     439         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
     440         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
     441         ! 
    415442         !                                   !==  compute and add the vorticity term trend  =! 
    416443         DO_2D( 0, 0, 0, 0 ) 
    … …  
    455482      ! 
    456483      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    457       REAL(wp) ::   zuav, zvau   ! local scalars 
     484      REAL(wp) ::   zuav, zvau, ze3f, zmsk   ! local scalars 
    458485      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz, zww   ! 2D workspace 
    459486      !!---------------------------------------------------------------------- 
    … …  
    476503                  &          - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    477504            END_2D 
     505            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
     506               DO_2D( 1, 0, 1, 0 ) 
     507                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 
     508               END_2D 
     509            ENDIF 
    478510         CASE ( np_MET )                           !* metric term 
    479511            DO_2D( 1, 0, 1, 0 ) 
    … …  
    486518                  &                        - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    487519            END_2D 
     520            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity (NOT the Coriolis term) 
     521               DO_2D( 1, 0, 1, 0 ) 
     522                  zwz(ji,jj) = ( zwz(ji,jj) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 
     523               END_2D 
     524            ENDIF 
    488525         CASE ( np_CME )                           !* Coriolis + metric 
    489526            DO_2D( 1, 0, 1, 0 ) 
    … …  
    495532         END SELECT 
    496533         ! 
    497          IF( ln_dynvor_msk ) THEN           !==  mask/unmask vorticity ==! 
    498             DO_2D( 1, 0, 1, 0 ) 
    499                zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 
    500             END_2D 
    501          ENDIF 
    502          ! 
    503          IF( ln_sco ) THEN                   !==  horizontal fluxes  ==! 
    504             zwz(:,:) = zwz(:,:) / e3f(:,:,jk) 
    505             zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    506             zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
    507          ELSE 
    508             zwx(:,:) = e2u(:,:) * pu(:,:,jk) 
    509             zwy(:,:) = e1v(:,:) * pv(:,:,jk) 
    510          ENDIF 
     534         ! 
     535#if defined key_qco 
     536         DO_2D( 1, 0, 1, 0 )                 !==  potential vorticity  ==!   (key_qco) 
     537            zwz(ji,jj) = zwz(ji,jj) / e3f_vor(ji,jj,jk) 
     538         END_2D 
     539#else 
     540         SELECT CASE( nn_e3f_typ )           !==  potential vorticity  ==! 
     541         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
     542            DO_2D( 1, 0, 1, 0 ) 
     543               ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   & 
     544                  &    + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   & 
     545                  &    + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   & 
     546                  &    + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  ) 
     547               IF( ze3f /= 0._wp ) THEN   ;   zwz(ji,jj) = zwz(ji,jj) * 4._wp / ze3f 
     548               ELSE                       ;   zwz(ji,jj) = 0._wp 
     549               ENDIF 
     550            END_2D 
     551         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
     552            DO_2D( 1, 0, 1, 0 ) 
     553               ze3f = (   e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   & 
     554                  &     + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   & 
     555                  &     + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   & 
     556                  &     + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)   ) 
     557               zmsk = (   tmask(ji,jj+1,jk)   + tmask(ji+1,jj+1,jk)   & 
     558                  &     + tmask(ji,jj  ,jk)   + tmask(ji+1,jj  ,jk)   ) 
     559               IF( ze3f /= 0._wp ) THEN   ;   zwz(ji,jj) = zwz(ji,jj) * zmsk / ze3f 
     560               ELSE                       ;   zwz(ji,jj) = 0._wp 
     561               ENDIF 
     562            END_2D 
     563         END SELECT 
     564#endif 
     565         !                                   !==  horizontal fluxes  ==! 
     566         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
     567         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
     568         ! 
    511569         !                                   !==  compute and add the vorticity term trend  =! 
    512570         DO_2D( 0, 0, 0, 0 ) 
    … …  
    566624         !                                             ! =============== 
    567625         ! 
    568          SELECT CASE( nn_een_e3f )           ! == reciprocal of e3 at F-point 
     626#if defined key_qco 
     627         DO_2D( 1, 0, 1, 0 )                 ! == reciprocal of e3 at F-point (key_qco) 
     628            z1_e3f(ji,jj) = 1._wp / e3f_vor(ji,jj,jk) 
     629         END_2D 
     630#else 
     631         SELECT CASE( nn_e3f_typ )           ! == reciprocal of e3 at F-point 
    569632         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    570633            DO_2D( 1, 0, 1, 0 ) 
    … …  
    590653            END_2D 
    591654         END SELECT 
     655#endif 
    592656         ! 
    593657         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
     658         ! 
    594659         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    595660            DO_2D( 1, 0, 1, 0 ) 
    … …  
    601666                  &            - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj) 
    602667            END_2D 
     668            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
     669               DO_2D( 1, 0, 1, 0 ) 
     670                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
     671               END_2D 
     672            ENDIF 
    603673         CASE ( np_MET )                           !* metric term 
    604674            DO_2D( 1, 0, 1, 0 ) 
    … …  
    612682                  &                           * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
    613683            END_2D 
     684            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
     685               DO_2D( 1, 0, 1, 0 ) 
     686                  zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj)  
     687               END_2D 
     688            ENDIF 
    614689         CASE ( np_CME )                           !* Coriolis + metric 
    615690            DO_2D( 1, 0, 1, 0 ) 
    … …  
    620695            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  ) 
    621696         END SELECT 
    622          ! 
    623          IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==! 
    624             DO_2D( 1, 0, 1, 0 ) 
    625                zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    626             END_2D 
    627          ENDIF 
     697         !                                             ! =============== 
    628698      END DO                                           !   End of slab 
    629          ! 
     699      !                                                ! =============== 
     700      ! 
    630701      CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    631  
     702      ! 
     703      !                                                ! =============== 
    632704      DO jk = 1, jpkm1                                 ! Horizontal slab 
     705         !                                             ! =============== 
    633706         ! 
    634707         !                                   !==  horizontal fluxes  ==! 
    635708         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    636709         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
    637  
     710         ! 
    638711         !                                   !==  compute and add the vorticity term trend  =! 
    639          jj = 2 
    640          ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0 
    641          DO ji = 2, jpi          ! split in 2 parts due to vector opt. 
    642                ztne(ji,jj) = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) 
    643                ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) 
    644                ztse(ji,jj) = zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) 
    645                ztsw(ji,jj) = zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) 
    646          END DO 
    647          DO jj = 3, jpj 
    648             DO ji = 2, jpi   ! vector opt. ok because we start at jj = 3 
    649                ztne(ji,jj) = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) 
    650                ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) 
    651                ztse(ji,jj) = zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) 
    652                ztsw(ji,jj) = zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) 
    653             END DO 
    654          END DO 
     712         DO_2D( 0, 1, 0, 1 ) 
     713            ztne(ji,jj) = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) 
     714            ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) 
     715            ztse(ji,jj) = zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) 
     716            ztsw(ji,jj) = zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) 
     717         END_2D 
     718         ! 
    655719         DO_2D( 0, 0, 0, 0 ) 
    656720            zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   & 
    … …  
    667731 
    668732 
    669  
    670733   SUBROUTINE vor_eeT( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs ) 
    671734      !!---------------------------------------------------------------------- 
    … …  
    685748      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 
    686749      !!---------------------------------------------------------------------- 
    687       INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index 
     750      INTEGER                         , INTENT(in   ) ::   kt               ! ocean time-step index 
    688751      INTEGER                         , INTENT(in   ) ::   Kmm              ! ocean time level index 
    689       INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric 
    690       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities 
    691       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs    ! total v-trend 
     752      INTEGER                         , INTENT(in   ) ::   kvor             ! total, planetary, relative, or metric 
     753      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv           ! now velocities 
     754      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! total v-trend 
    692755      ! 
    693756      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
    … …  
    702765      IF( kt == nit000 ) THEN 
    703766         IF(lwp) WRITE(numout,*) 
    704          IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme' 
     767         IF(lwp) WRITE(numout,*) 'dyn:vor_eeT : vorticity term: energy and enstrophy conserving scheme' 
    705768         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    706769      ENDIF 
    … …  
    722785                  &          * r1_e1e2f(ji,jj) 
    723786            END_2D 
     787            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
     788               DO_2D( 1, 0, 1, 0 ) 
     789                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
     790               END_2D 
     791            ENDIF 
    724792         CASE ( np_MET )                           !* metric term 
    725793            DO_2D( 1, 0, 1, 0 ) 
    … …  
    733801                  &                         * r1_e1e2f(ji,jj)    ) 
    734802            END_2D 
     803            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
     804               DO_2D( 1, 0, 1, 0 ) 
     805                  zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj)  
     806               END_2D 
     807            ENDIF 
    735808         CASE ( np_CME )                           !* Coriolis + metric 
    736809            DO_2D( 1, 0, 1, 0 ) 
    … …  
    742815         END SELECT 
    743816         ! 
    744          IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==! 
    745             DO_2D( 1, 0, 1, 0 ) 
    746                zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    747             END_2D 
    748          ENDIF 
    749       END DO 
     817         !                                             ! =============== 
     818      END DO                                           !   End of slab 
     819      !                                                ! =============== 
    750820      ! 
    751821      CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    752822      ! 
     823      !                                                ! =============== 
    753824      DO jk = 1, jpkm1                                 ! Horizontal slab 
    754  
    755       !                                   !==  horizontal fluxes  ==! 
     825         !                                             ! =============== 
     826         ! 
     827         !                                   !==  horizontal fluxes  ==! 
    756828         zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    757829         zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
    758  
     830         ! 
    759831         !                                   !==  compute and add the vorticity term trend  =! 
    760          jj = 2 
    761          ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0 
    762          DO ji = 2, jpi          ! split in 2 parts due to vector opt. 
    763                z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 
    764                ztne(ji,jj) = ( zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) ) * z1_e3t 
    765                ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) ) * z1_e3t 
    766                ztse(ji,jj) = ( zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) ) * z1_e3t 
    767                ztsw(ji,jj) = ( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) ) * z1_e3t 
    768          END DO 
    769          DO jj = 3, jpj 
    770             DO ji = 2, jpi   ! vector opt. ok because we start at jj = 3 
    771                z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 
    772                ztne(ji,jj) = ( zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) ) * z1_e3t 
    773                ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) ) * z1_e3t 
    774                ztse(ji,jj) = ( zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) ) * z1_e3t 
    775                ztsw(ji,jj) = ( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) ) * z1_e3t 
    776             END DO 
    777          END DO 
     832         DO_2D( 0, 1, 0, 1 ) 
     833            z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 
     834            ztne(ji,jj) = ( zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) ) * z1_e3t 
     835            ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) ) * z1_e3t 
     836            ztse(ji,jj) = ( zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) ) * z1_e3t 
     837            ztsw(ji,jj) = ( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) ) * z1_e3t 
     838         END_2D 
     839         ! 
    778840         DO_2D( 0, 0, 0, 0 ) 
    779841            zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   & 
    … …  
    799861      INTEGER ::   ji, jj, jk    ! dummy loop indices 
    800862      INTEGER ::   ioptio, ios   ! local integer 
     863      REAL(wp) ::   zmsk    ! local scalars 
    801864      !! 
    802865      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_enT, ln_dynvor_eeT,   & 
    803          &                 ln_dynvor_een, nn_een_e3f   , ln_dynvor_mix, ln_dynvor_msk 
     866         &                 ln_dynvor_een, nn_e3f_typ   , ln_dynvor_mix, ln_dynvor_msk 
    804867      !!---------------------------------------------------------------------- 
    805868      ! 
    … …  
    823886         WRITE(numout,*) '      energy conserving scheme  (een using e3t)      ln_dynvor_eeT = ', ln_dynvor_eeT 
    824887         WRITE(numout,*) '      enstrophy and energy conserving scheme         ln_dynvor_een = ', ln_dynvor_een 
    825          WRITE(numout,*) '         e3f = averaging /4 (=0) or /sum(tmask) (=1)    nn_een_e3f = ', nn_een_e3f 
     888         WRITE(numout,*) '         e3f = averaging /4 (=0) or /sum(tmask) (=1)    nn_e3f_typ = ', nn_e3f_typ 
    826889         WRITE(numout,*) '      mixed enstrophy/energy conserving scheme       ln_dynvor_mix = ', ln_dynvor_mix 
    827890         WRITE(numout,*) '      masked (=T) or unmasked(=F) vorticity          ln_dynvor_msk = ', ln_dynvor_msk 
    828891      ENDIF 
    829  
    830       IF( ln_dynvor_msk )   CALL ctl_stop( 'dyn_vor_init:   masked vorticity is not currently not available') 
    831892 
    832893!!gm  this should be removed when choosing a unique strategy for fmask at the coast 
    … …  
    891952         ! 
    892953      END SELECT 
    893        
     954#if defined key_qco 
     955      SELECT CASE( nvor_scheme )    ! qco case: pre-computed a specific e3f_0 for some vorticity schemes 
     956      CASE( np_ENS , np_ENE , np_EEN , np_MIX ) 
     957         ! 
     958         ALLOCATE( e3f_0vor(jpi,jpj,jpk) ) 
     959         ! 
     960         SELECT CASE( nn_e3f_typ ) 
     961         CASE ( 0 )                        ! original formulation  (masked averaging of e3t divided by 4) 
     962            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     963               e3f_0vor(ji,jj,jk) = (   e3t_0(ji  ,jj+1,jk)*tmask(ji  ,jj+1,jk)   & 
     964                  &                   + e3t_0(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
     965                  &                   + e3t_0(ji  ,jj  ,jk)*tmask(ji  ,jj  ,jk)   & 
     966                  &                   + e3t_0(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)   ) * 0.25_wp 
     967            END_3D 
     968         CASE ( 1 )                        ! new formulation  (masked averaging of e3t divided by the sum of mask) 
     969            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     970               zmsk = (tmask(ji,jj+1,jk) +tmask(ji+1,jj+1,jk)   & 
     971                  &  + tmask(ji,jj  ,jk) +tmask(ji+1,jj  ,jk)  ) 
     972               ! 
     973               IF( zmsk /= 0._wp ) THEN  
     974                  e3f_0vor(ji,jj,jk) = (   e3t_0(ji  ,jj+1,jk)*tmask(ji  ,jj+1,jk)   & 
     975                     &                   + e3t_0(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
     976                     &                   + e3t_0(ji  ,jj  ,jk)*tmask(ji  ,jj  ,jk)   & 
     977                     &                   + e3t_0(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)   ) / zmsk 
     978               ENDIF 
     979            END_3D 
     980         END SELECT 
     981         ! 
     982         CALL lbc_lnk( 'dynvor', e3f_0vor, 'F', 1._wp ) 
     983         !                                 ! insure e3f_0vor /= 0 
     984         WHERE( e3f_0vor(:,:,:) == 0._wp )   e3f_0vor(:,:,:) = e3f_0(:,:,:) 
     985         ! 
     986      END SELECT 
     987      ! 
     988#endif 
    894989      IF(lwp) THEN                   ! Print the choice 
    895990         WRITE(numout,*) 
    … …  
    898993         CASE( np_ENE )   ;   WRITE(numout,*) '   ==>>>   energy conserving scheme (Coriolis at F-points) (ENE)' 
    899994         CASE( np_ENT )   ;   WRITE(numout,*) '   ==>>>   energy conserving scheme (Coriolis at T-points) (ENT)' 
     995                              IF( ln_dynadv_vec )   CALL ctl_warn('dyn_vor_init: ENT scheme may not work in vector form') 
    900996         CASE( np_EET )   ;   WRITE(numout,*) '   ==>>>   energy conserving scheme (EEN scheme using e3t) (EET)' 
    901997         CASE( np_EEN )   ;   WRITE(numout,*) '   ==>>>   energy and enstrophy conserving scheme (EEN)' 

  • NEMO/trunk/src/OCE/DYN/sshwzv.F90

    r13497 r14053  
    66   !! History :  3.1  !  2009-02  (G. Madec, M. Leclair)  Original code 
    77   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  modified LF-RA  
    8    !!             -   !  2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 
    9    !!             -   !  2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module 
    10    !!            3.3  !  2011-10  (M. Leclair) split former ssh_wzv routine and remove all vvl related work 
    11    !!            4.0  !  2018-12  (A. Coward) add mixed implicit/explicit advection 
    12    !!            4.1  !  2019-08  (A. Coward, D. Storkey) Rename ssh_nxt -> ssh_atf. Now only does time filtering. 
     8   !!             -   !  2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea)  Assimilation interface 
     9   !!             -   !  2010-09  (D.Storkey and E.O'Dea)  bug fixes for BDY module 
     10   !!            3.3  !  2011-10  (M. Leclair)  split former ssh_wzv routine and remove all vvl related work 
     11   !!            4.0  !  2018-12  (A. Coward)  add mixed implicit/explicit advection 
     12   !!            4.1  !  2019-08  (A. Coward, D. Storkey)  Rename ssh_nxt -> ssh_atf. Now only does time filtering. 
     13   !!             -   !  2020-08  (S. Techene, G. Madec)  add here ssh initiatlisation 
    1314   !!---------------------------------------------------------------------- 
    1415 
    … …  
    1718   !!   ssh_atf       : time filter the ssh arrays 
    1819   !!   wzv           : compute now vertical velocity 
     20   !!   ssh_init_rst  : ssh set from restart or domcfg.nc file or usr_def_istat_ssh 
    1921   !!---------------------------------------------------------------------- 
    2022   USE oce            ! ocean dynamics and tracers variables 
    … …  
    4042   USE timing         ! Timing 
    4143   USE wet_dry        ! Wetting/Drying flux limiting 
    42  
     44   USE usrdef_istate, ONLY : usr_def_istate_ssh   ! user defined ssh initial state  
     45    
    4346   IMPLICIT NONE 
    4447   PRIVATE 
    4548 
    46    PUBLIC   ssh_nxt    ! called by step.F90 
    47    PUBLIC   wzv        ! called by step.F90 
    48    PUBLIC   wAimp      ! called by step.F90 
    49    PUBLIC   ssh_atf    ! called by step.F90 
     49   PUBLIC   ssh_nxt        ! called by step.F90 
     50   PUBLIC   wzv            ! called by step.F90 
     51   PUBLIC   wAimp          ! called by step.F90 
     52   PUBLIC   ssh_atf        ! called by step.F90 
     53   PUBLIC   ssh_init_rst   ! called by domain.F90 
    5054 
    5155   !! * Substitutions 
    5256#  include "do_loop_substitute.h90" 
    5357#  include "domzgr_substitute.h90" 
    54  
    5558   !!---------------------------------------------------------------------- 
    5659   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    299302         !                                                  ! filtered "now" field 
    300303         pssh(:,:,Kmm) = pssh(:,:,Kmm) + rn_atfp * ( pssh(:,:,Kbb) - 2 * pssh(:,:,Kmm) + pssh(:,:,Kaa) ) 
     304         ! 
    301305         IF( .NOT.ln_linssh ) THEN                          ! "now" <-- with forcing removed 
    302306            zcoef = rn_atfp * rn_Dt * r1_rho0 
    … …  
    307311 
    308312            ! ice sheet coupling 
    309             IF ( ln_isf .AND. ln_isfcpl .AND. kt == nit000+1) pssh(:,:,Kbb) = pssh(:,:,Kbb) - rn_atfp * rn_Dt * ( risfcpl_ssh(:,:) - 0.0 ) * ssmask(:,:) 
     313            IF( ln_isf .AND. ln_isfcpl .AND. kt == nit000+1 )   & 
     314               &   pssh(:,:,Kbb) = pssh(:,:,Kbb) - rn_atfp * rn_Dt * ( risfcpl_ssh(:,:) - 0.0 ) * ssmask(:,:) 
    310315 
    311316         ENDIF 
    312317      ENDIF 
    313318      ! 
    314       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pssh(:,:,Kmm), clinfo1=' pssh(:,:,Kmm)  - : ', mask1=tmask ) 
     319      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pssh(:,:,Kmm), clinfo1=' atf  - pssh(:,:,Kmm): ', mask1=tmask ) 
    315320      ! 
    316321      IF( ln_timing )   CALL timing_stop('ssh_atf') 
    … …  
    431436      ! 
    432437   END SUBROUTINE wAimp 
     438 
     439 
     440   SUBROUTINE ssh_init_rst( Kbb, Kmm, Kaa ) 
     441      !!--------------------------------------------------------------------- 
     442      !!                   ***  ROUTINE ssh_init_rst  *** 
     443      !! 
     444      !! ** Purpose :   ssh initialization of the sea surface height (ssh) 
     445      !! 
     446      !! ** Method  :   set ssh from restart or read configuration, or user_def 
     447      !!              * ln_rstart = T 
     448      !!                   USE of IOM library to read ssh in the restart file 
     449      !!                   Leap-Frog: Kbb and Kmm are read except for l_1st_euler=T 
     450      !! 
     451      !!              * otherwise  
     452      !!                   call user defined ssh or 
     453      !!                   set to -ssh_ref in wet and drying case with domcfg.nc 
     454      !! 
     455      !!              NB: ssh_b/n are written by restart.F90 
     456      !!---------------------------------------------------------------------- 
     457      INTEGER, INTENT(in) ::   Kbb, Kmm, Kaa   ! ocean time level indices 
     458      ! 
     459      INTEGER ::   ji, jj, jk 
     460      !!---------------------------------------------------------------------- 
     461      ! 
     462      IF(lwp) THEN 
     463         WRITE(numout,*) 
     464         WRITE(numout,*) 'ssh_init_rst : ssh initialization' 
     465         WRITE(numout,*) '~~~~~~~~~~~~ ' 
     466      ENDIF 
     467      ! 
     468      !                            !=============================! 
     469      IF( ln_rstart ) THEN         !==  Read the restart file  ==! 
     470         !                         !=============================! 
     471         ! 
     472         !                                     !*  Read ssh at Kmm 
     473         IF(lwp) WRITE(numout,*) 
     474         IF(lwp) WRITE(numout,*)    '      Kmm sea surface height read in the restart file' 
     475         CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm) ) 
     476         ! 
     477         IF( l_1st_euler ) THEN                !* Euler at first time-step 
     478            IF(lwp) WRITE(numout,*) 
     479            IF(lwp) WRITE(numout,*) '      Euler first time step : ssh(Kbb) = ssh(Kmm)' 
     480            ssh(:,:,Kbb) = ssh(:,:,Kmm) 
     481            ! 
     482         ELSE                                  !* read ssh at Kbb 
     483            IF(lwp) WRITE(numout,*) 
     484            IF(lwp) WRITE(numout,*) '      Kbb sea surface height read in the restart file' 
     485            CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb) ) 
     486         ENDIF 
     487         !                         !============================! 
     488      ELSE                         !==  Initialize at "rest"  ==! 
     489         !                         !============================! 
     490         ! 
     491         IF(lwp) WRITE(numout,*) 
     492         IF(lwp) WRITE(numout,*)    '      initialization at rest' 
     493         ! 
     494         IF( ll_wd ) THEN                      !* wet and dry  
     495            ! 
     496            IF( ln_read_cfg  ) THEN                 ! read configuration : ssh_ref is read in domain_cfg file 
     497!!st  why ssh is not masked : i.e. ssh(:,:,Kmm) = -ssh_ref*ssmask(:,:), 
     498!!st  since at the 1st time step lbclnk will be applied on ssh at Kaa but not initially at Kbb and Kmm 
     499               ssh(:,:,Kbb) = -ssh_ref 
     500               ! 
     501               DO_2D( 1, 1, 1, 1 ) 
     502                  IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN   ! if total depth is less than min depth 
     503                     ssh(ji,jj,Kbb) = rn_wdmin1 - ht_0(ji,jj) 
     504                  ENDIF 
     505               END_2D 
     506            ELSE                                    ! user define configuration case   
     507               CALL usr_def_istate_ssh( tmask, ssh(:,:,Kbb) ) 
     508            ENDIF 
     509            ! 
     510         ELSE                                  !* user defined configuration 
     511            CALL usr_def_istate_ssh( tmask, ssh(:,:,Kbb) ) 
     512            ! 
     513         ENDIF 
     514         ! 
     515         ssh(:,:,Kmm) = ssh(:,:,Kbb)           !* set now values from to before ones 
     516         ssh(:,:,Kaa) = 0._wp  
     517      ENDIF 
     518      ! 
     519   END SUBROUTINE ssh_init_rst 
     520       
    433521   !!====================================================================== 
    434522END MODULE sshwzv 

  • NEMO/trunk/src/OCE/IOM/iom.F90

    r14039 r14053  
    174174         CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. ) 
    175175         CALL set_grid( "W", glamt, gphit, .FALSE., .FALSE. ) 
     176         CALL set_grid( "F", glamf, gphif, .FALSE., .FALSE. ) 
    176177         CALL set_grid_znl( gphit ) 
    177178         ! 
    … …  
    180181            CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp)) 
    181182            CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp)) 
    182             CALL iom_set_domain_attr("grid_W", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 
     183            CALL iom_set_domain_attr("grid_W", area = REAL( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 
     184            CALL iom_set_domain_attr("grid_F", area = real( e1e2f(Nis0:Nie0, Njs0:Nje0), dp)) 
    183185            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 
    184186            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 
    185187            CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv ) 
    186188            CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit ) 
     189            CALL set_grid_bounds( "F", glamt, gphit, glamf, gphif ) 
    187190         ENDIF 
    188191      ENDIF 
    … …  
    191194         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    192195         ! 
    193          CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE., .FALSE. )  
    194          CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE., .FALSE. )  
    195          CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE., .FALSE. )  
    196          CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE., .FALSE. )  
     196         CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 
     197         CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE., .FALSE. ) 
     198         CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE., .FALSE. ) 
     199         CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 
    197200         CALL set_grid_znl( gphit_crs ) 
    198201          ! 
    … …  
    217220         CALL iom_set_axis_attr(  "depthv", paxis = gdept_1d ) 
    218221         CALL iom_set_axis_attr(  "depthw", paxis = gdepw_1d ) 
     222          CALL iom_set_axis_attr(  "depthf", paxis = gdept_1d ) 
    219223 
    220224          ! ABL 
    … …  
    238242         CALL iom_set_axis_attr(  "depthv", bounds=zw_bnds ) 
    239243         CALL iom_set_axis_attr(  "depthw", bounds=zt_bnds ) 
     244          CALL iom_set_axis_attr(  "depthf", bounds=zw_bnds ) 
    240245 
    241246         ! ABL 

  • NEMO/trunk/src/OCE/IOM/restart.F90

    r13970 r14053  
    1111   !!            3.7  !  2014-01  (G. Madec) suppression of curl and hdiv from the restart 
    1212   !!             -   !  2014-12  (G. Madec) remove KPP scheme 
     13   !!            4.1  !  2020-11  (S. Techene, G. Madec)  move ssh initiatlisation in DYN/sshwzv:ssh_init_rst 
    1314   !!---------------------------------------------------------------------- 
    1415 
    … …  
    139140      !! ** Method  :   Write in numrow when kt == nitrst in NetCDF 
    140141      !!              file, save fields which are necessary for restart 
     142      !! 
     143      !!                NB: ssh is written here (rst_write) 
     144      !!                    but is read or set in DYN/sshwzv:shh_init_rst 
    141145      !!---------------------------------------------------------------------- 
    142146      INTEGER, INTENT(in) ::   kt         ! ocean time-step 
    … …  
    233237      !!                   ***  ROUTINE rst_read  *** 
    234238      !!  
    235       !! ** Purpose :   Read files for NetCDF restart 
    236       !!  
    237       !! ** Method  :   Read in restart.nc file fields which are necessary for restart 
     239      !! ** Purpose :   Read velocity and T-S fields in the restart file 
     240      !!  
     241      !! ** Method  :   Read in restart.nc fields which are necessary for restart 
     242      !! 
     243      !!                NB: restart file openned           in DOM/domain.F90:dom_init 
     244      !!                    before field in restart tested in DOM/domain.F90:dom_init 
     245      !!                    (sshb) 
     246      !! 
     247      !!                NB: ssh is read or set in DYN/sshwzv:shh_init_rst 
     248      !!                    but is written     in IOM/restart:rst_write 
    238249      !!---------------------------------------------------------------------- 
    239250      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    240       REAL(wp) ::   zrdt 
    241251      INTEGER  ::   jk 
    242252      REAL(wp), DIMENSION(jpi, jpj, jpk) :: w3d 
    243253      !!---------------------------------------------------------------------- 
    244  
    245       CALL rst_read_open           ! open restart for reading (if not already opened) 
    246  
    247       ! Check dynamics and tracer time-step consistency and force Euler restart if changed 
    248       IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 )   THEN 
    249          CALL iom_get( numror, 'rdt', zrdt ) 
    250          IF( zrdt /= rn_Dt ) THEN 
    251             IF(lwp) WRITE( numout,*) 
    252             IF(lwp) WRITE( numout,*) 'rst_read:  rdt not equal to the read one' 
    253             IF(lwp) WRITE( numout,*) 
    254             IF(lwp) WRITE( numout,*) '      ==>>>   forced euler first time-step' 
    255             l_1st_euler =  .TRUE. 
    256          ENDIF 
    257       ENDIF 
    258  
     254      ! 
    259255      IF(.NOT.lrxios ) CALL iom_delay_rst( 'READ', 'OCE', numror )   ! read only ocean delayed global communication variables 
    260        
    261       ! Diurnal DSST  
    262       IF( ln_diurnal ) CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst )  
     256      ! 
     257      !                             !*  Diurnal DSST  
     258      IF( ln_diurnal )   CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst )  
    263259      IF ( ln_diurnal_only ) THEN  
    264260         IF(lwp) WRITE( numout, * ) & 
    … …  
    269265         RETURN  
    270266      ENDIF   
    271  
    272       IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 
    273          ! before fields 
     267      ! 
     268      !                             !*  Read Kmm fields 
     269      IF(lwp) WRITE(numout,*)    '           Kmm u, v and T-S fields read in the restart file' 
     270      CALL iom_get( numror, jpdom_auto, 'un'     , uu(:,:,:       ,Kmm), cd_type = 'U', psgn = -1._wp ) 
     271      CALL iom_get( numror, jpdom_auto, 'vn'     , vv(:,:,:       ,Kmm), cd_type = 'V', psgn = -1._wp ) 
     272      CALL iom_get( numror, jpdom_auto, 'tn'     , ts(:,:,:,jp_tem,Kmm) ) 
     273      CALL iom_get( numror, jpdom_auto, 'sn'     , ts(:,:,:,jp_sal,Kmm) ) 
     274      ! 
     275      IF( l_1st_euler ) THEN        !*  Euler restart 
     276         IF(lwp) WRITE(numout,*) '           Kbb u, v and T-S fields set to Kmm values' 
     277         ts(:,:,:,:,Kbb) = ts(:,:,:,:,Kmm)         ! all before fields set to now values 
     278         uu(:,:,:  ,Kbb) = uu(:,:,:  ,Kmm) 
     279         vv(:,:,:  ,Kbb) = vv(:,:,:  ,Kmm) 
     280      ELSE                          !* Leap frog restart 
     281         IF(lwp) WRITE(numout,*) '           Kbb u, v and T-S fields read in the restart file' 
    274282         CALL iom_get( numror, jpdom_auto, 'ub'     , uu(:,:,:       ,Kbb), cd_type = 'U', psgn = -1._wp ) 
    275283         CALL iom_get( numror, jpdom_auto, 'vb'     , vv(:,:,:       ,Kbb), cd_type = 'V', psgn = -1._wp ) 
    276284         CALL iom_get( numror, jpdom_auto, 'tb'     , ts(:,:,:,jp_tem,Kbb) ) 
    277285         CALL iom_get( numror, jpdom_auto, 'sb'     , ts(:,:,:,jp_sal,Kbb) ) 
    278          CALL iom_get( numror, jpdom_auto, 'sshb'   ,ssh(:,:         ,Kbb) ) 
    279       ELSE 
    280          l_1st_euler =  .TRUE.      ! before field not found, forced euler 1st time-step 
    281       ENDIF 
    282       ! 
    283       ! now fields 
    284       CALL iom_get( numror, jpdom_auto, 'un'     , uu(:,:,:       ,Kmm), cd_type = 'U', psgn = -1._wp ) 
    285       CALL iom_get( numror, jpdom_auto, 'vn'     , vv(:,:,:       ,Kmm), cd_type = 'V', psgn = -1._wp ) 
    286       CALL iom_get( numror, jpdom_auto, 'tn'     , ts(:,:,:,jp_tem,Kmm) ) 
    287       CALL iom_get( numror, jpdom_auto, 'sn'     , ts(:,:,:,jp_sal,Kmm) ) 
    288       CALL iom_get( numror, jpdom_auto, 'sshn'   ,ssh(:,:         ,Kmm) ) 
     286      ENDIF 
     287      ! 
    289288      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 
    290289         CALL iom_get( numror, jpdom_auto, 'rhop'   , rhop )   ! now    potential density 
    … …  
    293292      ENDIF 
    294293      ! 
    295       IF( l_1st_euler ) THEN                                  ! Euler restart  
    296          ts   (:,:,:,:,Kbb) = ts   (:,:,:,:,Kmm)              ! all before fields set to now values 
    297          uu   (:,:,:  ,Kbb) = uu   (:,:,:  ,Kmm) 
    298          vv   (:,:,:  ,Kbb) = vv   (:,:,:  ,Kmm) 
    299          ssh  (:,:    ,Kbb) = ssh  (:,:    ,Kmm) 
    300       ENDIF 
    301       ! 
    302294   END SUBROUTINE rst_read 
    303295 

  • NEMO/trunk/src/OCE/ISF/isfcpl.F90

    r13970 r14053  
    1010 
    1111   !!---------------------------------------------------------------------- 
    12    !!   isfrst : read/write iceshelf variables in/from restart 
     12   !!   isfrst        : read/write iceshelf variables in/from restart 
    1313   !!---------------------------------------------------------------------- 
    14    USE isf_oce                          ! ice shelf variable 
     14   USE oce            ! ocean dynamics and tracers 
     15#if defined key_qco 
     16   USE domqco  , ONLY : dom_qco_zgr      ! vertical scale factor interpolation 
     17#else 
     18   USE domvvl  , ONLY : dom_vvl_zgr      ! vertical scale factor interpolation 
     19#endif 
     20   USE domutl  , ONLY : dom_ngb          ! find the closest grid point from a given lon/lat position 
     21   USE isf_oce        ! ice shelf variable 
    1522   USE isfutils, ONLY : debug 
    16    USE lib_mpp , ONLY: mpp_sum, mpp_max ! mpp routine 
    17 #if ! defined key_qco 
    18    USE domvvl  , ONLY: dom_vvl_zgr      ! vertical scale factor interpolation 
    19 #else 
    20    USE domqco   , ONLY: dom_qco_zgr      ! vertical scale factor interpolation 
    21 #endif 
    22    USE domutl  , ONLY: dom_ngb          ! find the closest grid point from a given lon/lat position 
    2323   ! 
    24    USE oce            ! ocean dynamics and tracers 
    2524   USE in_out_manager ! I/O manager 
    2625   USE iom            ! I/O library 
     26   USE lib_mpp , ONLY : mpp_sum, mpp_max ! mpp routine 
    2727   ! 
    2828   IMPLICIT NONE 
    … …  
    3434 
    3535   TYPE isfcons 
    36       INTEGER :: ii     ! i global 
    37       INTEGER :: jj     ! j global 
    38       INTEGER :: kk     ! k level 
    39       REAL(wp):: dvol   ! volume increment 
    40       REAL(wp):: dsal   ! salt increment 
    41       REAL(wp):: dtem   ! heat increment 
    42       REAL(wp):: lon    ! lon 
    43       REAL(wp):: lat    ! lat 
    44       INTEGER :: ngb    ! 0/1 (valid location or not (ie on halo or no neigbourg)) 
     36      INTEGER ::   ii     ! i global 
     37      INTEGER ::   jj     ! j global 
     38      INTEGER ::   kk     ! k level 
     39      REAL(wp)::   dvol   ! volume increment 
     40      REAL(wp)::   dsal   ! salt increment 
     41      REAL(wp)::   dtem   ! heat increment 
     42      REAL(wp)::   lon    ! lon 
     43      REAL(wp)::   lat    ! lat 
     44      INTEGER ::   ngb    ! 0/1 (valid location or not (ie on halo or no neigbourg)) 
    4545   END TYPE 
    4646   ! 
    … …  
    121121#endif  
    122122   END SUBROUTINE isfcpl_init 
    123    !  
    124    SUBROUTINE isfcpl_rst_write(kt, Kmm) 
     123 
     124    
     125   SUBROUTINE isfcpl_rst_write( kt, Kmm ) 
    125126      !!--------------------------------------------------------------------- 
    126127      !!                   ***  ROUTINE iscpl_rst_write  *** 
    … …  
    133134      !!---------------------------------------------------------------------- 
    134135      INTEGER :: jk                               ! loop index 
    135       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw  ! e3t , e3u, e3v !!st patch to use substitution 
     136      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw  ! for qco substitution 
    136137      !!---------------------------------------------------------------------- 
    137138      ! 
    … …  
    153154   END SUBROUTINE isfcpl_rst_write 
    154155 
     156    
    155157   SUBROUTINE isfcpl_ssh(Kbb, Kmm, Kaa) 
    156158      !!----------------------------------------------------------------------  
    … …  
    184186         zdssmask(:,:) = ssmask(:,:) - zssmask0(:,:) 
    185187         DO_2D( 0, 0, 0, 0 ) 
    186             jip1=ji+1; jim1=ji-1; 
    187             jjp1=jj+1; jjm1=jj-1; 
     188            jip1=ji+1   ;   jim1=ji-1 
     189            jjp1=jj+1   ;   jjm1=jj-1 
    188190            ! 
    189191            zsummsk = zssmask0(jip1,jj) + zssmask0(jim1,jj) + zssmask0(ji,jjp1) + zssmask0(ji,jjm1) 
    … …  
    191193            IF (zdssmask(ji,jj) == 1._wp .AND. zsummsk /= 0._wp) THEN 
    192194               ssh(ji,jj,Kmm)=( zssh(jip1,jj)*zssmask0(jip1,jj)     & 
    193                &           + zssh(jim1,jj)*zssmask0(jim1,jj)     & 
    194                &           + zssh(ji,jjp1)*zssmask0(ji,jjp1)     & 
    195                &           + zssh(ji,jjm1)*zssmask0(ji,jjm1)) / zsummsk 
     195                  &           + zssh(jim1,jj)*zssmask0(jim1,jj)     & 
     196                  &           + zssh(ji,jjp1)*zssmask0(ji,jjp1)     & 
     197                  &           + zssh(ji,jjm1)*zssmask0(ji,jjm1)) / zsummsk 
    196198               zssmask_b(ji,jj) = 1._wp 
    197199            ENDIF 
    … …  
    222224      CALL dom_vvl_zgr(Kbb, Kmm, Kaa) 
    223225#else 
    224       CALL dom_qco_zgr(Kbb, Kmm, Kaa) 
     226      CALL dom_qco_zgr(Kbb, Kmm) 
    225227#endif 
    226228      ! 
    227229   END SUBROUTINE isfcpl_ssh 
    228230 
     231    
    229232   SUBROUTINE isfcpl_tra(Kmm) 
    230233      !!----------------------------------------------------------------------  
    … …  
    375378      !  
    376379   END SUBROUTINE isfcpl_tra 
     380    
    377381 
    378382   SUBROUTINE isfcpl_vol(Kmm) 
    … …  
    466470         risfcpl_ssh(:,:) = risfcpl_ssh(:,:) + risfcpl_vol(:,:,jk) * r1_e1e2t(:,:) 
    467471      END DO 
    468  
     472      ! 
    469473   END SUBROUTINE isfcpl_vol 
    470474 
     475    
    471476   SUBROUTINE isfcpl_cons(Kmm) 
    472477      !!----------------------------------------------------------------------  

  • NEMO/trunk/src/OCE/ISF/isfdynatf.F90

    r13237 r14053  
    1515   USE phycst , ONLY: r1_rho0         ! physical constant 
    1616   USE dom_oce                        ! time and space domain 
    17    USE oce, ONLY : ssh                ! sea-surface height !!st needed for substitution 
     17   USE oce, ONLY : ssh                ! sea-surface height for qco substitution 
    1818 
    1919   USE in_out_manager 

  • NEMO/trunk/src/OCE/ISF/isfrst.F90

    r13970 r14053  
    2828   !!---------------------------------------------------------------------- 
    2929CONTAINS 
    30    !  
    31    SUBROUTINE isfrst_read(cdisf, ptsc, pfwf, ptsc_b, pfwf_b ) 
     30    
     31   SUBROUTINE isfrst_read( cdisf, ptsc, pfwf, ptsc_b, pfwf_b ) 
    3232      !!--------------------------------------------------------------------- 
    3333      !! 
    … …  
    5151      ! 
    5252      ! read restart 
    53       IF( iom_varid( numror, cfwf_b, ldstop = .FALSE. ) > 0 ) THEN 
     53      IF( .NOT.l_1st_euler ) THEN 
    5454         IF(lwp) WRITE(numout,*) '          nit000-1 isf tracer content forcing fields read in the restart file' 
    5555         CALL iom_get( numror, jpdom_auto, cfwf_b, pfwf_b(:,:)         )   ! before ice shelf melt 
    … …  
    6262      ! 
    6363   END SUBROUTINE isfrst_read 
    64    !  
    65    SUBROUTINE isfrst_write(kt, cdisf, ptsc, pfwf ) 
     64 
     65    
     66   SUBROUTINE isfrst_write( kt, cdisf, ptsc, pfwf ) 
    6667      !!--------------------------------------------------------------------- 
    6768      !! 
    … …  
    9495      ! 
    9596   END SUBROUTINE isfrst_write 
    96    ! 
     97    
     98   !!====================================================================== 
    9799END MODULE isfrst 

  • NEMO/trunk/src/OCE/LBC/mppini.F90

    r13982 r14053  
    217217      ! then we calculate them here now that we have our communicator size 
    218218      IF(lwp) THEN 
     219         WRITE(numout,*) 
    219220         WRITE(numout,*) 'mpp_init:' 
    220221         WRITE(numout,*) '~~~~~~~~ ' 
    221          WRITE(numout,*) 
    222222      ENDIF 
    223223      IF( jpni < 1 .OR. jpnj < 1 ) THEN 

  • NEMO/trunk/src/OCE/LDF/ldfdyn.F90

    r13497 r14053  
    3434   !                                    !!* Namelist namdyn_ldf : lateral mixing on momentum * 
    3535   LOGICAL , PUBLIC ::   ln_dynldf_OFF   !: No operator (i.e. no explicit diffusion) 
     36   INTEGER , PUBLIC ::   nn_dynldf_typ   !: operator type (0: div-rot ; 1: symmetric) 
    3637   LOGICAL , PUBLIC ::   ln_dynldf_lap   !: laplacian operator 
    3738   LOGICAL , PUBLIC ::   ln_dynldf_blp   !: bilaplacian operator 
    … …  
    5253 
    5354   !                                    !!* Parameter to control the type of lateral viscous operator 
    54    INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10                       !: error in setting the operator 
    55    INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00                       !: without operator (i.e. no lateral viscous trend) 
     55   INTEGER, PARAMETER, PUBLIC ::   np_ERROR   =-10                      !: error in setting the operator 
     56   INTEGER, PARAMETER, PUBLIC ::   np_no_ldf  = 00                      !: without operator (i.e. no lateral viscous trend) 
     57   ! 
     58   INTEGER, PARAMETER, PUBLIC ::   np_typ_rot = 0                       !: div-rot   operator 
     59   INTEGER, PARAMETER, PUBLIC ::   np_typ_sym = 1                       !: symmetric operator 
     60   ! 
    5661   !                          !!      laplacian     !    bilaplacian    ! 
    5762   INTEGER, PARAMETER, PUBLIC ::   np_lap    = 10   ,   np_blp    = 20  !: iso-level operator 
    … …  
    109114      CHARACTER(len=5) ::   cl_Units               ! units (m2/s or m4/s) 
    110115      !! 
    111       NAMELIST/namdyn_ldf/ ln_dynldf_OFF, ln_dynldf_lap, ln_dynldf_blp,   &   ! type of operator 
    112          &                 ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso,   &   ! acting direction of the operator 
    113          &                 nn_ahm_ijk_t , rn_Uv    , rn_Lv,   rn_ahm_b,   &   ! lateral eddy coefficient 
    114          &                 rn_csmc      , rn_minfac    , rn_maxfac            ! Smagorinsky settings 
     116      NAMELIST/namdyn_ldf/ ln_dynldf_OFF, nn_dynldf_typ, ln_dynldf_lap, ln_dynldf_blp,   &   ! type of operator 
     117         &                 ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso,                  &   ! acting direction of the operator 
     118         &                 nn_ahm_ijk_t , rn_Uv        , rn_Lv        ,   rn_ahm_b,      &   ! lateral eddy coefficient 
     119         &                 rn_csmc      , rn_minfac    , rn_maxfac                           ! Smagorinsky settings 
    115120      !!---------------------------------------------------------------------- 
    116121      ! 
    … …  
    130135         WRITE(numout,*) '      type :' 
    131136         WRITE(numout,*) '         no explicit diffusion                ln_dynldf_OFF = ', ln_dynldf_OFF 
     137         WRITE(numout,*) '         type of operator (div-rot or sym)    nn_dynldf_typ = ', nn_dynldf_typ 
    132138         WRITE(numout,*) '         laplacian operator                   ln_dynldf_lap = ', ln_dynldf_lap 
    133139         WRITE(numout,*) '         bilaplacian operator                 ln_dynldf_blp = ', ln_dynldf_blp 
    … …  
    147153         WRITE(numout,*) '         Smagorinsky coefficient              rn_csmc       = ', rn_csmc 
    148154         WRITE(numout,*) '         factor multiplier for eddy visc.' 
    149          WRITE(numout,*) '            lower limit (default 1.0)         rn_minfac    = ', rn_minfac 
    150          WRITE(numout,*) '            upper limit (default 1.0)         rn_maxfac    = ', rn_maxfac 
     155         WRITE(numout,*) '            lower limit (default 1.0)         rn_minfac     = ', rn_minfac 
     156         WRITE(numout,*) '            upper limit (default 1.0)         rn_maxfac     = ', rn_maxfac 
    151157      ENDIF 
    152158 
    … …  
    160166      IF( ln_dynldf_lap ) THEN   ;                              ioptio = ioptio + 1   ;   ENDIF 
    161167      IF( ln_dynldf_blp ) THEN   ;                              ioptio = ioptio + 1   ;   ENDIF 
    162       IF( ioptio /= 1   )   CALL ctl_stop( 'dyn_ldf_init: use ONE of the 3 operator options (NONE/lap/blp)' ) 
     168      IF( ioptio /= 1   )   CALL ctl_stop( 'ldf_dyn_init: use ONE of the 3 operator options (NONE/lap/blp)' ) 
    163169      ! 
    164170      IF(.NOT.ln_dynldf_OFF ) THEN     !==  direction ==>> type of operator  ==! 
     171         ! 
     172         SELECT CASE( nn_dynldf_typ )  ! div-rot or symmetric 
     173         CASE( np_typ_rot )   ;   IF(lwp)   WRITE(numout,*) '   ==>>>   use div-rot   operator ' 
     174         CASE( np_typ_sym )   ;   IF(lwp)   WRITE(numout,*) '   ==>>>   use symmetric operator ' 
     175         CASE DEFAULT                                     ! error 
     176            CALL ctl_stop('ldf_dyn_init: wrong value for nn_dynldf_typ (0 or 1)'  ) 
     177         END SELECT 
     178         ! 
    165179         ioptio = 0 
    166180         IF( ln_dynldf_lev )   ioptio = ioptio + 1 
    167181         IF( ln_dynldf_hor )   ioptio = ioptio + 1 
    168182         IF( ln_dynldf_iso )   ioptio = ioptio + 1 
    169          IF( ioptio /= 1   )   CALL ctl_stop( 'dyn_ldf_init: use ONE of the 3 direction options (level/hor/iso)' ) 
     183         IF( ioptio /= 1   )   CALL ctl_stop( 'ldf_dyn_init: use ONE of the 3 direction options (level/hor/iso)' ) 
    170184         ! 
    171185         !                             ! Set nldf_dyn, the type of lateral diffusion, from ln_dynldf_... logicals 

  • NEMO/trunk/src/OCE/SBC/sbcapr.F90

    r13970 r14053  
    148148         !                                      ! ---------------------------------------- ! 
    149149         !                                            !* Restart: read in restart file 
    150          IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN  
     150         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN  
    151151            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file' 
    152152            CALL iom_get( numror, jpdom_auto, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh 

  • NEMO/trunk/src/OCE/SBC/sbcice_cice.F90

    r13295 r14053  
    1212   USE oce             ! ocean dynamics and tracers 
    1313   USE dom_oce         ! ocean space and time domain 
    14 # if ! defined key_qco 
    15    USE domvvl 
     14# if defined key_qco 
     15   USE domqco         ! Variable volume 
    1616# else 
    17    USE domqco 
     17   USE domvvl         ! Variable volume 
    1818# endif 
    1919   USE phycst, only : rcp, rho0, r1_rho0, rhos, rhoi 
    … …  
    238238!!gm especially here it is assumed zstar coordinate, but it can be ztilde.... 
    239239#if defined key_qco 
    240             IF( .NOT.ln_linssh )   CALL dom_qco_zgr( Kbb, Kmm, Kaa )   ! interpolation scale factor, depth and water column 
     240            IF( .NOT.ln_linssh )   CALL dom_qco_zgr( Kbb, Kmm )   ! interpolation scale factor, depth and water column 
    241241#else 
    242242            IF( .NOT.ln_linssh ) THEN 

  • NEMO/trunk/src/OCE/SBC/sbcmod.F90

    r14030 r14053  
    523523      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
    524524         !                                             ! ---------------------------------------- ! 
    525          IF( ln_rstart .AND.    &                               !* Restart: read in restart file 
    526             & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 
    527             IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields red in the restart file' 
    528             CALL iom_get( numror, jpdom_auto, 'utau_b', utau_b )   ! before i-stress  (U-point) 
    529             CALL iom_get( numror, jpdom_auto, 'vtau_b', vtau_b )   ! before j-stress  (V-point) 
    530             CALL iom_get( numror, jpdom_auto,  'qns_b',  qns_b )   ! before non solar heat flux (T-point) 
    531             ! The 3D heat content due to qsr forcing is treated in traqsr 
    532             ! CALL iom_get( numror, jpdom_auto, 'qsr_b' , qsr_b  ) ! before     solar heat flux (T-point) 
    533             CALL iom_get( numror, jpdom_auto, 'emp_b', emp_b  )    ! before     freshwater flux (T-point) 
     525         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN            !* Restart: read in restart file 
     526            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields read in the restart file' 
     527            CALL iom_get( numror, jpdom_auto, 'utau_b', utau_b )   ! i-stress 
     528            CALL iom_get( numror, jpdom_auto, 'vtau_b', vtau_b )   ! j-stress 
     529            CALL iom_get( numror, jpdom_auto,  'qns_b',  qns_b )   ! non solar heat flux 
     530            CALL iom_get( numror, jpdom_auto,  'emp_b',  emp_b )   ! freshwater flux 
     531            ! NB: The 3D heat content due to qsr forcing (qsr_hc_b) is treated in traqsr 
    534532            ! To ensure restart capability with 3.3x/3.4 restart files    !! to be removed in v3.6 
    535533            IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN 
    … …  
    566564      !                                                ! ---------------------------------------- ! 
    567565      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    568          CALL iom_put( "empmr"  , emp    - rnf )                ! upward water flux 
    569          CALL iom_put( "empbmr" , emp_b  - rnf )                ! before upward water flux ( needed to recalculate the time evolution of ssh in offline ) 
    570          CALL iom_put( "saltflx", sfx  )                        ! downward salt flux (includes virtual salt flux beneath ice in linear free surface case) 
    571          CALL iom_put( "fmmflx", fmmflx  )                      ! Freezing-melting water flux 
    572          CALL iom_put( "qt"    , qns  + qsr )                   ! total heat flux 
    573          CALL iom_put( "qns"   , qns        )                   ! solar heat flux 
    574          CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux 
     566         CALL iom_put( "empmr"  , emp   - rnf )                ! upward water flux 
     567         CALL iom_put( "empbmr" , emp_b - rnf )                ! before upward water flux ( needed to recalculate the time evolution of ssh in offline ) 
     568         CALL iom_put( "saltflx", sfx         )                ! downward salt flux (includes virtual salt flux beneath ice in linear free surface case) 
     569         CALL iom_put( "fmmflx" , fmmflx      )                ! Freezing-melting water flux 
     570         CALL iom_put( "qt"     , qns + qsr   )                ! total heat flux 
     571         CALL iom_put( "qns"    , qns         )                ! solar heat flux 
     572         CALL iom_put( "qsr"    ,       qsr   )                ! solar heat flux 
    575573         IF( nn_ice > 0 .OR. ll_opa )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction 
    576          CALL iom_put( "taum"  , taum       )                   ! wind stress module 
    577          CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice 
    578          CALL iom_put( "qrp", qrp )                             ! heat flux damping 
    579          CALL iom_put( "erp", erp )                             ! freshwater flux damping 
     574         CALL iom_put( "taum"   , taum        )                ! wind stress module 
     575         CALL iom_put( "wspd"   , wndm        )                ! wind speed  module over free ocean or leads in presence of sea-ice 
     576         CALL iom_put( "qrp"    , qrp         )                ! heat flux damping 
     577         CALL iom_put( "erp"    , erp         )                ! freshwater flux damping 
    580578      ENDIF 
    581579      ! 
    582580      IF(sn_cfctl%l_prtctl) THEN     ! print mean trends (used for debugging) 
    583          CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i     - : ', mask1=tmask ) 
    584          CALL prt_ctl(tab2d_1=(emp-rnf)        , clinfo1=' emp-rnf  - : ', mask1=tmask ) 
    585          CALL prt_ctl(tab2d_1=(sfx-rnf)        , clinfo1=' sfx-rnf  - : ', mask1=tmask ) 
    586          CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask ) 
    587          CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask ) 
    588          CALL prt_ctl(tab3d_1=tmask            , clinfo1=' tmask    - : ', mask1=tmask, kdim=jpk ) 
     581         CALL prt_ctl(tab2d_1=fr_i                , clinfo1=' fr_i     - : ', mask1=tmask ) 
     582         CALL prt_ctl(tab2d_1=(emp-rnf)           , clinfo1=' emp-rnf  - : ', mask1=tmask ) 
     583         CALL prt_ctl(tab2d_1=(sfx-rnf)           , clinfo1=' sfx-rnf  - : ', mask1=tmask ) 
     584         CALL prt_ctl(tab2d_1=qns                 , clinfo1=' qns      - : ', mask1=tmask ) 
     585         CALL prt_ctl(tab2d_1=qsr                 , clinfo1=' qsr      - : ', mask1=tmask ) 
     586         CALL prt_ctl(tab3d_1=tmask               , clinfo1=' tmask    - : ', mask1=tmask, kdim=jpk ) 
    589587         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst      - : ', mask1=tmask, kdim=1   ) 
    590588         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss      - : ', mask1=tmask, kdim=1   ) 

  • NEMO/trunk/src/OCE/SBC/sbcrnf.F90

    r14032 r14053  
    157157      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
    158158         !                                             ! ---------------------------------------- ! 
    159          IF( ln_rstart .AND.    &                               !* Restart: read in restart file 
    160             & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN 
     159         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN         !* Restart: read in restart file 
    161160            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields red in the restart file', lrxios 
    162             CALL iom_get( numror, jpdom_auto, 'rnf_b', rnf_b )     ! before runoff 
     161            CALL iom_get( numror, jpdom_auto, 'rnf_b'   , rnf_b                 )   ! before runoff 
    163162            CALL iom_get( numror, jpdom_auto, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) )   ! before heat content of runoff 
    164163            CALL iom_get( numror, jpdom_auto, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) )   ! before salinity content of runoff 
    165          ELSE                                                   !* no restart: set from nit000 values 
     164         ELSE                                                !* no restart: set from nit000 values 
    166165            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000' 
    167166            rnf_b    (:,:  ) = rnf    (:,:  ) 
    … …  
    176175            &                    'at it= ', kt,' date= ', ndastp 
    177176         IF(lwp) WRITE(numout,*) '~~~~' 
    178          CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf ) 
     177         CALL iom_rstput( kt, nitrst, numrow, 'rnf_b'   , rnf                ) 
    179178         CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem) ) 
    180179         CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) ) 

  • NEMO/trunk/src/OCE/TRA/traatf_qco.F90

    r13982 r14053  
    1 MODULE traatfqco 
     1MODULE traatf_qco 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  traatfqco  *** 
     3   !!                       ***  MODULE  traatf_qco  *** 
    44   !! Ocean active tracers:  Asselin time filtering for temperature and salinity 
    55   !!====================================================================== 
    … …  
    4545   USE prtctl          ! Print control 
    4646   USE timing          ! Timing 
    47 #if defined key_agrif 
    48    USE agrif_oce_interp 
    49 #endif 
    5047 
    5148   IMPLICIT NONE 
    … …  
    149146         ENDIF 
    150147         ! 
    151          CALL lbc_lnk_multi( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1., pts(:,:,:,jp_sal,Kmm) , 'T', 1. ) 
    152  
     148         CALL lbc_lnk_multi( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp ) 
     149         ! 
    153150      ENDIF 
    154151      ! 
    … …  
    370367 
    371368   !!====================================================================== 
    372 END MODULE traatfqco 
     369END MODULE traatf_qco 

  • NEMO/trunk/src/OCE/TRA/traqsr.F90

    r13982 r14053  
    144144 
    145145      IF( kt == nit000 ) THEN          !==  1st time step  ==! 
    146          IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0  .AND. .NOT.l_1st_euler ) THEN    ! read in restart 
     146         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN    ! read in restart 
    147147            z1_2 = 0.5_wp 
    148148            IF( ntile == 0 .OR. ntile == 1 )  THEN                        ! Do only on the first tile 
    … …  
    150150               CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux 
    151151            ENDIF 
    152          ELSE                                           ! No restart or restart not found: Euler forward time stepping 
     152         ELSE                                           ! No restart or Euler forward at 1st time step 
    153153            z1_2 = 1._wp 
    154154            DO_3D( isj, iej, isi, iei, 1, jpk ) 

  • NEMO/trunk/src/OCE/TRA/trasbc.F90

    r13982 r14053  
    7272      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T) 
    7373      !!---------------------------------------------------------------------- 
    74       INTEGER,                                   INTENT(in   ) :: kt         ! ocean time-step index 
    75       INTEGER,                                   INTENT(in   ) :: Kmm, Krhs  ! time level indices 
    76       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation 
     74      INTEGER,                                   INTENT(in   ) ::   kt         ! ocean time-step index 
     75      INTEGER,                                   INTENT(in   ) ::   Kmm, Krhs  ! time level indices 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) ::   pts        ! active tracers and RHS of tracer Eq. 
    7777      ! 
    7878      INTEGER  ::   ji, jj, jk, jn               ! dummy loop indices 
    … …  
    117117      !                             !==  Set before sbc tracer content fields  ==! 
    118118      IF( kt == nit000 ) THEN             !* 1st time-step 
    119          IF( ln_rstart .AND.    &               ! Restart: read in restart file 
    120               & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN 
     119         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN      ! Restart: read in restart file 
    121120            zfact = 0.5_wp 
    122121            IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    … …  
    126125               CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend 
    127126            ENDIF 
    128          ELSE                                   ! No restart or restart not found: Euler forward time stepping 
     127         ELSE                                             ! No restart or restart not found: Euler forward time stepping 
    129128            zfact = 1._wp 
    130129            DO_2D( isj, iej, isi, iei ) 

  • NEMO/trunk/src/OCE/USR/usrdef_istate.F90

    r13497 r14053  
    77   !! User defined : set the initial state of a user configuration 
    88   !!====================================================================== 
    9    !! History :  4.0 ! 2016-03  (S. Flavoni) Original code 
     9   !! History :  4.0  ! 2016-03  (S. Flavoni) Original code 
     10   !!                 ! 2020-11  (S. Techene, G. Madec) separate tsuv from ssh 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    2223   PRIVATE 
    2324 
    24    PUBLIC   usr_def_istate   ! called in istate.F90 
     25   PUBLIC   usr_def_istate       ! called in istate.F90 
     26   PUBLIC   usr_def_istate_ssh   ! called by domqco.F90 
    2527 
    2628   !! * Substitutions 
    … …  
    3335CONTAINS 
    3436   
    35    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     37   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    3638      !!---------------------------------------------------------------------- 
    3739      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    4850      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    4951      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    50       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5152      ! 
    5253      INTEGER :: ji, jj, jk  ! dummy loop indices 
    … …  
    5960      pu  (:,:,:) = 0._wp           ! ocean at rest 
    6061      pv  (:,:,:) = 0._wp 
    61       pssh(:,:)   = 0._wp 
    6262      ! 
    6363      DO_3D( 1, 1, 1, 1, 1, jpk )   ! horizontally uniform T & S profiles 
    … …  
    8080   END SUBROUTINE usr_def_istate 
    8181 
     82    
     83   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     84      !!---------------------------------------------------------------------- 
     85      !!                   ***  ROUTINE usr_def_istate_ssh  *** 
     86      !!  
     87      !! ** Purpose :   Initialization of ssh 
     88      !! 
     89      !! ** Method  :   Set ssh as null, ptmask is required for test cases 
     90      !!---------------------------------------------------------------------- 
     91      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m] 
     92      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m] 
     93      !!---------------------------------------------------------------------- 
     94      ! 
     95      IF(lwp) WRITE(numout,*) 
     96      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : GYRE configuration, analytical definition of initial state' 
     97      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~   Ocean at rest, ssh is zero' 
     98      ! 
     99      ! Sea level: 
     100      pssh(:,:) = 0._wp 
     101      ! 
     102   END SUBROUTINE usr_def_istate_ssh 
     103 
    82104   !!====================================================================== 
    83105END MODULE usrdef_istate 

  • NEMO/trunk/src/OCE/ZDF/zdfddm.F90

    r13497 r14053  
    3131   !! * Substitutions 
    3232#  include "do_loop_substitute.h90" 
     33#  include "domzgr_substitute.h90" 
    3334   !!---------------------------------------------------------------------- 
    3435   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 

  • NEMO/trunk/src/OCE/nemogcm.F90

    r14032 r14053  
    4242   !!---------------------------------------------------------------------- 
    4343   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
     44   ! 
    4445   USE phycst         ! physical constant                  (par_cst routine) 
    4546   USE domain         ! domain initialization   (dom_init & dom_cfg routines) 
    46    USE closea         ! treatment of closed seas (for ln_closea) 
    47    USE usrdef_nam     ! user defined configuration 
    48    USE tide_mod, ONLY : tide_init ! tidal components initialization   (tide_init routine) 
    49    USE bdyini         ! open boundary cond. setting       (bdy_init routine) 
     47   USE wet_dry        ! Wetting and drying setting   (wad_init routine) 
     48   USE usrdef_nam     ! user defined configuration namelist 
     49   USE tide_mod, ONLY : tide_init   ! tidal components initialization   (tide_init routine) 
     50   USE bdyini  , ONLY : bdy_init    ! open boundary cond. setting       (bdy_init routine) 
    5051   USE istate         ! initial state setting          (istate_init routine) 
    51    USE ldfdyn         ! lateral viscosity setting      (ldfdyn_init routine) 
    52    USE ldftra         ! lateral diffusivity setting    (ldftra_init routine) 
    5352   USE trdini         ! dyn/tra trends initialization     (trd_init routine) 
    54    USE asminc         ! assimilation increments      
    55    USE asmbkg         ! writing out state trajectory 
    56    USE diadct         ! sections transports           (dia_dct_init routine) 
    57    USE diaobs         ! Observation diagnostics       (dia_obs_init routine) 
    58    USE diacfl         ! CFL diagnostics               (dia_cfl_init routine) 
    59    USE diamlr         ! IOM context management for multiple-linear-regression analysis 
     53   USE icbini         ! handle bergs, initialisation 
     54   USE icbstp  , ONLY : icb_end     ! handle bergs, close iceberg files 
     55   USE cpl_oasis3     ! OASIS3 coupling 
     56   USE dyndmp         ! Momentum damping (C1D only) 
     57   USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline) 
     58   USE crsini         ! initialise grid coarsening utility 
     59   USE dia25h  , ONLY : dia_25h_init   ! 25h mean output (initialisation) 
     60   USE c1d            ! 1D configuration 
     61   USE step_c1d       ! Time stepping loop for the 1D configuration 
     62#if defined key_top 
     63   USE trcini         ! passive tracer initialisation 
     64#endif 
     65#if defined key_nemocice_decomp 
     66   USE ice_domain_size, only: nx_global, ny_global 
     67#endif 
    6068#if defined key_qco 
    61    USE stepMLF        ! NEMO time-stepping               (stp_MLF   routine) 
     69   USE stpmlf         ! NEMO time-stepping               (stp_MLF   routine) 
    6270#else 
    6371   USE step           ! NEMO time-stepping                 (stp     routine) 
    6472#endif 
    65    USE isfstp         ! ice shelf                     (isf_stp_init routine) 
    66    USE icbini         ! handle bergs, initialisation 
    67    USE icbstp         ! handle bergs, calving, themodynamics and transport 
    68    USE cpl_oasis3     ! OASIS3 coupling 
    69    USE c1d            ! 1D configuration 
    70    USE step_c1d       ! Time stepping loop for the 1D configuration 
    71    USE dyndmp         ! Momentum damping 
    72    USE stopar         ! Stochastic param.: ??? 
    73    USE stopts         ! Stochastic param.: ??? 
    74    USE diu_layers     ! diurnal bulk SST and coolskin 
    75    USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline) 
    76    USE crsini         ! initialise grid coarsening utility 
    77    USE dia25h         ! 25h mean output 
    78    USE diadetide      ! Weights computation for daily detiding of model diagnostics 
    79    USE sbc_oce , ONLY : lk_oasis 
    80    USE wet_dry        ! Wetting and drying setting   (wad_init routine) 
    81 #if defined key_top 
    82    USE trcini         ! passive tracer initialisation 
    83 #endif 
    84 #if defined key_nemocice_decomp 
    85    USE ice_domain_size, only: nx_global, ny_global 
    86 #endif 
    8773   ! 
    88    USE prtctl         ! Print control 
    89    USE in_out_manager ! I/O manager 
    9074   USE lib_mpp        ! distributed memory computing 
    9175   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    9276   USE lbcnfd  , ONLY : isendto, nsndto  ! Setup of north fold exchanges  
    9377   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    94 #if defined key_iomput 
    95    USE xios           ! xIOserver 
    96 #endif 
    97 #if defined key_agrif 
    98    USE agrif_all_update   ! Master Agrif update 
    99 #endif 
    100    USE halo_mng 
     78   USE halo_mng       ! Halo manager 
    10179 
    10280   IMPLICIT NONE 
    … …  
    182160      ! 
    183161      DO WHILE( istp <= nitend .AND. nstop == 0 ) 
    184 #if defined key_qco 
     162#  if defined key_qco 
    185163         CALL stp_MLF 
    186 #else 
     164#  else 
    187165         CALL stp 
    188 #endif 
     166#  endif 
    189167         istp = istp + 1 
    190168      END DO 
    … …  
    195173         ! 
    196174         DO WHILE( istp <= nitend .AND. nstop == 0 ) 
    197  
     175            ! 
    198176            ncom_stp = istp 
    199177            IF( ln_timing ) THEN 
    … …  
    202180               IF ( istp ==         nitend ) elapsed_time = zstptiming - elapsed_time 
    203181            ENDIF 
    204              
    205 #if defined key_qco 
     182            ! 
     183#  if defined key_qco 
    206184            CALL stp_MLF      ( istp ) 
    207 #else 
     185#  else 
    208186            CALL stp        ( istp )  
    209 #endif 
     187#  endif 
    210188            istp = istp + 1 
    211  
     189            ! 
    212190            IF( lwp .AND. ln_timing )   WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming 
    213  
     191            ! 
    214192         END DO 
    215193         ! 
    … …  
    279257      INTEGER ::   ios, ilocal_comm   ! local integers 
    280258      !! 
    281       NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
    282          &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle             
     259      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, nn_isplt, nn_jsplt , nn_ictls,   & 
     260         &                                             nn_ictle, nn_jctls , nn_jctle 
    283261      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    284262      !!---------------------------------------------------------------------- 
    … …  
    350328      IF(lwp) THEN                      ! open listing units 
    351329         ! 
    352          IF( .NOT. lwm )   &            ! alreay opened for narea == 1 
     330         IF( .NOT.lwm )   &            ! alreay opened for narea == 1 
    353331            &            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 
    354332         ! 
    … …  
    357335         WRITE(numout,*) '                       NEMO team' 
    358336         WRITE(numout,*) '            Ocean General Circulation Model' 
    359          WRITE(numout,*) '                NEMO version 4.0  (2019) ' 
     337         WRITE(numout,*) '                NEMO version 4.0  (2020) ' 
    360338         WRITE(numout,*) 
    361339         WRITE(numout,*) "           ._      ._      ._      ._      ._    " 
    … …  
    373351         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
    374352         WRITE(numout,*) 
    375           
    376          ! Print the working precision to ocean.output 
    377          IF (wp == dp) THEN 
    378             WRITE(numout,*) "Working precision = double-precision" 
    379          ELSE 
    380             WRITE(numout,*) "Working precision = single-precision" 
     353         ! 
     354         WRITE(numout,cform_aaa)    ! Flag AAAAAAA 
     355         ! 
     356         !                          ! Control print of the working precision 
     357         WRITE(numout,*) 
     358         IF( wp == dp ) THEN   ;   WRITE(numout,*) "par_kind : wp = Working precision = dp = double-precision" 
     359         ELSE                  ;   WRITE(numout,*) "par_kind : wp = Working precision = sp = single-precision" 
    381360         ENDIF 
    382          WRITE(numout,*) 
    383          ! 
    384          WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
     361                                   WRITE(numout,*) "~~~~~~~~                                 ****************" 
     362                                   WRITE(numout,*) 
    385363         ! 
    386364      ENDIF 
    … …  
    415393 
    416394      ! Initialise time level indices 
    417       Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
     395      Nbb = 1   ;   Nnn = 2   ;   Naa = 3   ;  Nrhs = Naa 
    418396#if defined key_agrif 
    419       Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
     397      Kbb_a = Nbb   ;   Kmm_a = Nnn   ;  Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    420398#endif  
    421399      !                             !-------------------------------! 
    … …  
    423401      !                             !-------------------------------! 
    424402 
    425       CALL nemo_ctl                          ! Control prints 
     403      CALL nemo_ctl                          ! Control prints of namctl and namcfg 
    426404      ! 
    427405      !                                      ! General initialization 
    … …  
    437415     CALL Agrif_Declare_Var_ini   !  "      "   "   "      "  DOM 
    438416#endif 
    439                            CALL     dom_init( Nbb, Nnn, Naa ) ! Domain 
    440       IF( ln_crs       )   CALL     crs_init(      Nnn )       ! coarsened grid: domain initialization  
     417                           CALL     dom_init( Nbb, Nnn, Naa )   ! Domain 
     418      IF( ln_crs       )   CALL     crs_init(      Nnn      )   ! coarsened grid: domain initialization  
    441419      IF( sn_cfctl%l_prtctl )   & 
    442420         &                 CALL prt_ctl_init        ! Print control 

  • NEMO/trunk/src/OCE/oce.F90

    r13237 r14053  
    1616   PRIVATE 
    1717 
    18    PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90 
     18   PUBLIC oce_alloc       ! routine called by nemo_init in     nemogcm.F90 
     19   PUBLIC oce_SWE_alloc   ! routine called by nemo_init in SWE/nemogcm.F90 (Shallow Water Eq. case) 
    1920 
    2021   !! dynamics and tracer fields 
    … …  
    6869   INTEGER, PUBLIC, DIMENSION(2) :: noce_array                             !: unused array but seems to be needed to prevent agrif from creating an empty module 
    6970 
     71   !! Shallow Water Eq. case (SWE) 
     72   LOGICAL, PUBLIC ::   lk_SWE = .FALSE.                                   !: shallow water flag =T in SWE configurations only 
     73 
     74   !! Stand-Alone Surface module (SAS) 
     75   LOGICAL, PUBLIC ::   l_SAS = .FALSE.                                    !: SAS flag =T in SAS configurations only 
     76    
     77    
    7078   !!---------------------------------------------------------------------- 
    7179   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    115123   END FUNCTION oce_alloc 
    116124 
     125 
     126   INTEGER FUNCTION oce_SWE_alloc() 
     127      !!---------------------------------------------------------------------- 
     128      !!                   ***  FUNCTION oce_SWE_alloc  *** 
     129      !!---------------------------------------------------------------------- 
     130      INTEGER :: ierr(2) 
     131      !!---------------------------------------------------------------------- 
     132      ! 
     133      lk_SWE  = .TRUE.                   ! =T SWE case  
     134      ! 
     135      ierr(:) = 0  
     136      ALLOCATE( uu(jpi,jpj,jpk,jpt) , vv  (jpi,jpj,jpk,jpt) ,     &           
     137         &      ww(jpi,jpj,jpk)     , hdiv(jpi,jpj,jpk)     , ssh(jpi,jpj,jpt) , STAT=ierr(1) ) 
     138         ! 
     139      ALLOCATE(   ts(jpi,jpj,jpk,jpts,jpt) , fraqsr_1lev(jpi,jpj) ,  & 
     140         &      uu_b(jpi,jpj,jpt) , vv_b(jpi,jpj,jpt)       , rn2(jpi,jpj,jpk) , STAT=ierr(2) ) 
     141         ! 
     142      oce_SWE_alloc = MAXVAL( ierr ) 
     143      IF( oce_SWE_alloc /= 0 )   CALL ctl_stop( 'STOP', 'oce_SWE_alloc: failed to allocate arrays' ) 
     144      ! 
     145   END FUNCTION oce_SWE_alloc 
     146 
    117147   !!====================================================================== 
    118148END MODULE oce 

  • NEMO/trunk/src/OCE/step.F90

    r14010 r14053  
    4242   !!---------------------------------------------------------------------- 
    4343   USE step_oce         ! time stepping definition modules 
    44    ! 
    45    USE iom              ! xIOs server 
    4644 
    4745   IMPLICIT NONE 

  • NEMO/trunk/src/OCE/step_oce.F90

    r14010 r14053  
    33   !!                       ***  MODULE step_oce  *** 
    44   !! Ocean time-stepping : module used in both initialisation phase and time stepping 
     5   !!                                     (i.e. nemo_init and stp or stp_MLF routines) 
    56   !!====================================================================== 
    67   !! History :   3.3  !  2010-08  (C. Ethe)  Original code - reorganisation of the initial phase 
    … …  
    910   USE oce             ! ocean dynamics and tracers variables 
    1011   USE dom_oce         ! ocean space and time domain variables 
    11    USE domain, ONLY : dom_tile 
    12    USE zdf_oce         ! ocean vertical physics variables 
    13    USE zdfdrg  ,  ONLY : ln_drgimp   ! implicit top/bottom friction 
     12   USE domain  ,  ONLY : dom_tile 
    1413 
    1514   USE daymod          ! calendar                         (day     routine) 
    … …  
    2019   USE sbccpl          ! surface boundary condition: coupled formulation (call send at end of step) 
    2120   USE sbcapr          ! surface boundary condition: atmospheric pressure 
    22    USE tide_mod, ONLY : ln_tide, tide_update 
    2321   USE sbcwave         ! Wave intialisation 
     22   USE tide_mod        ! tides 
     23 
     24   USE bdy_oce  , ONLY : ln_bdy 
     25   USE bdydta          ! open boundary condition data     (bdy_dta routine) 
     26   USE bdytra          ! bdy cond. for tracers            (bdy_tra routine) 
     27   USE bdydyn3d        ! bdy cond. for baroclinic vel.  (bdy_dyn3d routine) 
    2428 
    2529   USE isf_oce         ! ice shelf boundary condition 
    2630   USE isfstp          ! ice shelf boundary condition     (isf_stp routine) 
     31 
     32   USE sshwzv          ! vertical velocity and ssh        (ssh_nxt routine) 
     33   !                                                      (ssh_swp routine) 
     34   !                                                      (wzv     routine) 
     35   USE domvvl          ! variable vertical scale factors  (dom_vvl_sf_nxt routine) 
     36   !                                                      (dom_vvl_sf_swp routine) 
     37    
     38   USE divhor          ! horizontal divergence            (div_hor routine) 
     39   USE dynadv          ! advection                        (dyn_adv routine) 
     40   USE dynvor          ! vorticity term                   (dyn_vor routine) 
     41   USE dynhpg          ! hydrostatic pressure grad.       (dyn_hpg routine) 
     42   USE dynldf          ! lateral momentum diffusion       (dyn_ldf routine) 
     43   USE dynzdf          ! vertical diffusion               (dyn_zdf routine) 
     44   USE dynspg          ! surface pressure gradient        (dyn_spg routine) 
     45   USE dynatf          ! time-filtering                   (dyn_atf routine) 
    2746 
    2847   USE traqsr          ! solar radiation penetration      (tra_qsr routine) 
    … …  
    4059   USE eosbn2          ! equation of state                (eos_bn2 routine) 
    4160 
    42    USE divhor          ! horizontal divergence            (div_hor routine) 
    43    USE dynadv          ! advection                        (dyn_adv routine) 
    44    USE dynvor          ! vorticity term                   (dyn_vor routine) 
    45    USE dynhpg          ! hydrostatic pressure grad.       (dyn_hpg routine) 
    46    USE dynldf          ! lateral momentum diffusion       (dyn_ldf routine) 
    47    USE dynzdf          ! vertical diffusion               (dyn_zdf routine) 
    48    USE dynspg          ! surface pressure gradient        (dyn_spg routine) 
    49  
    50    USE dynatf          ! time-filtering                   (dyn_atf routine) 
    51  
    5261   USE stopar          ! Stochastic parametrization       (sto_par routine) 
    5362   USE stopts  
    54  
    55    USE bdy_oce  , ONLY : ln_bdy 
    56    USE bdydta          ! open boundary condition data     (bdy_dta routine) 
    57    USE bdytra          ! bdy cond. for tracers            (bdy_tra routine) 
    58    USE bdydyn3d        ! bdy cond. for baroclinic vel.  (bdy_dyn3d routine) 
    59  
    60    USE sshwzv          ! vertical velocity and ssh        (ssh_nxt routine) 
    61    !                                                       (ssh_swp routine) 
    62    !                                                       (wzv     routine) 
    63    USE domvvl          ! variable vertical scale factors  (dom_vvl_sf_nxt routine) 
    64    !                                                       (dom_vvl_sf_swp routine) 
    6563 
    6664   USE ldfslp          ! iso-neutral slopes               (ldf_slp routine) 
    … …  
    6866   USE ldftra          ! lateral eddy diffusive coef.     (ldf_tra routine) 
    6967 
     68   USE zdf_oce         ! ocean vertical physics variables 
    7069   USE zdfphy          ! vertical physics manager      (zdf_phy_init routine) 
    71    USE zdfosm  , ONLY : osm_rst, dyn_osm, tra_osm      ! OSMOSIS routines used in step.F90 
     70   USE zdfdrg   , ONLY : ln_drgimp   ! implicit top/bottom friction 
     71   USE zdfosm   , ONLY : osm_rst, dyn_osm, tra_osm      ! OSMOSIS routines used in step.F90 
    7272   USE zdfmfc          ! Mass FLux Convection routine used in step.F90 
    7373 
    … …  
    8383   USE diahth          ! thermocline depth                (dia_hth routine) 
    8484   USE diahsb          ! heat, salt and volume budgets    (dia_hsb routine) 
    85    USE diacfl 
    86    USE diaobs          ! Observation operator 
     85   USE diacfl          ! CFL diagnostics                  (dia_cfl routine) 
     86   USE diaobs          ! Observation operator             (dia_obs routine) 
    8787   USE diadetide       ! Weights computation for daily detiding of model diagnostics 
    8888   USE diamlr          ! IOM context management for multiple-linear-regression analysis 
    … …  
    9494   USE asminc          ! assimilation increments      (tra_asm_inc routine) 
    9595   !                                                   (dyn_asm_inc routine) 
    96    USE asmbkg 
     96   USE asmbkg          ! writing out state trajectory 
    9797   USE stpctl          ! time stepping control            (stp_ctl routine) 
    9898   USE restart         ! ocean restart                    (rst_wri routine) 

  • NEMO/trunk/src/OCE/stpctl.F90

    r13616 r14053  
    2626   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2727   USE lib_mpp         ! distributed memory computing 
    28    ! 
    2928   USE netcdf          ! NetCDF library 
     29 
    3030   IMPLICIT NONE 
    3131   PRIVATE 
    … …  
    7171      CHARACTER(len=20)               ::   clname 
    7272      !!---------------------------------------------------------------------- 
     73      ! 
    7374      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
    7475      ! 
    … …  
    179180         END DO 
    180181         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid) 
    181       END IF 
     182      ENDIF 
    182183      !                                   !==               error handling               ==! 
    183184      !                                   !==  done by all processes at every time step  ==! 

  • NEMO/trunk/src/OFF/dtadyn.F90

    r13982 r14053  
    2323   USE c1d             ! 1D configuration: lk_c1d 
    2424   USE dom_oce         ! ocean domain: variables 
    25 #if ! defined key_qco  
    26    USE domvvl          ! variable volume 
     25#if defined key_qco  
     26   USE domqco          ! variable volume 
    2727#else 
    28    USE domqco 
     28   USE domvvl 
    2929#endif 
    3030   USE zdf_oce         ! ocean vertical physics: variables 
    … …  
    9797   !! * Substitutions 
    9898#  include "do_loop_substitute.h90" 
     99#  include "domzgr_substitute.h90" 
     100    
    99101   !!---------------------------------------------------------------------- 
    100102   !! NEMO/OFF 4.0 , NEMO Consortium (2018) 
    … …  
    388390        gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm) 
    389391        ! 
    390       ENDIF 
    391392#endif 
     393      ENDIF 
    392394      ! 
    393395      IF( ln_dynrnf .AND. ln_dynrnf_depth ) THEN       ! read depht over which runoffs are distributed 
    … …  
    412414            ENDIF 
    413415         END_2D 
     416         ! 
    414417         DO_2D( 1, 1, 1, 1 )                           ! set the associated depth 
    415418            h_rnf(ji,jj) = 0._wp 

  • NEMO/trunk/src/OFF/nemogcm.F90

    r13970 r14053  
    6464   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    6565   USE lbcnfd  , ONLY : isendto, nsndto   ! Setup of north fold exchanges 
    66    USE step, ONLY : Nbb, Nnn, Naa, Nrhs   ! time level indices 
     66#if defined key_qco 
     67   USE stpmlf , ONLY : Nbb, Nnn, Naa, Nrhs   ! time level indices 
     68#else 
     69   USE step    , ONLY : Nbb, Nnn, Naa, Nrhs   ! time level indices 
     70#endif 
    6771   USE halo_mng 
    6872 
    … …  
    143147                                CALL dta_dyn_atf( istp, Nbb, Nnn, Naa )       ! time filter of sea  surface height and vertical scale factors 
    144148# if defined key_qco 
    145                                 CALL dom_qco_r3c( ssh(:,:,Kmm), r3t_f, r3u_f, r3v_f ) 
     149                                CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f ) 
    146150# endif 
    147151         ENDIF 
    148152                                CALL trc_stp    ( istp, Nbb, Nnn, Nrhs, Naa ) ! time-stepping 
    149153# if defined key_qco 
    150                                 !r3t(:,:,Kmm) = r3t_f(:,:)                     ! update ssh to h0 ratio 
    151                                 !r3u(:,:,Kmm) = r3u_f(:,:) 
    152                                 !r3v(:,:,Kmm) = r3v_f(:,:) 
     154                                !r3t(:,:,Nnn) = r3t_f(:,:)                     ! update ssh to h0 ratio 
     155                                !r3u(:,:,Nnn) = r3u_f(:,:) 
     156                                !r3v(:,:,Nnn) = r3v_f(:,:) 
    153157# endif 
    154158#endif 
    … …  
    160164         ! 
    161165#if ! defined key_qco 
    162 #if ! defined key_sed_off 
     166# if ! defined key_sed_off 
    163167         IF( .NOT.ln_linssh )   CALL dta_dyn_sf_interp( istp, Nnn )  ! calculate now grid parameters 
    164 #endif 
     168# endif 
    165169#endif          
    166170         CALL stp_ctl    ( istp )             ! Time loop: control and print 

  • NEMO/trunk/src/SAS/nemogcm.F90

    r14030 r14053  
    216216      !!---------------------------------------------------------------------- 
    217217      ! 
    218       IF( lk_oasis ) THEN   ;   cxios_context = 'sas' 
    219       ELSE                  ;   cxios_context = 'nemo' 
     218      IF( lk_oasis ) THEN   ;   cxios_context = 'sas'    ! when coupling SAS to OCE 
     219      ELSE                  ;   cxios_context = 'nemo'   !  
    220220      ENDIF 
    221221      nn_hls = 1 
     222      ! 
     223      l_SAS = .TRUE.   ! used in domain:dom_nam 
    222224      ! 
    223225      !                             !-------------------------------------------------! 

  • NEMO/trunk/src/SWE/domzgr_substitute.h90

    r12983 r14053  
    1616#   define  e3v(i,j,k,t)   (e3v_0(i,j,k)*(1._wp+r3v(i,j,t))) 
    1717#   define  e3f(i,j,k)     (e3f_0(i,j,k)*(1._wp+r3f(i,j))) 
     18#   define  e3f_vor(i,j,k) (e3f_0vor(i,j,k)*(1._wp+r3f(i,j))) 
    1819#   define  e3w(i,j,k,t)   (e3w_0(i,j,k)*(1._wp+r3t(i,j,t))) 
    1920#   define  e3uw(i,j,k,t)  (e3uw_0(i,j,k)*(1._wp+r3u(i,j,t))) 

  • NEMO/trunk/src/SWE/nemogcm.F90

    r13970 r14053  
    44   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice) 
    55   !!====================================================================== 
    6    !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code 
    7    !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec) 
    8    !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
    9    !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1 
    10    !!             -   ! 1992-06  (L.Terray)  coupling implementation 
    11    !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice 
    12    !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
    13    !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0 
    14    !!            8.1  ! 1997-06  (M. Imbard, G. Madec) 
    15    !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  sea-ice model 
    16    !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP 
    17    !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER) 
    18    !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules 
    19    !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces 
    20    !!             -   ! 2004-08  (C. Talandier) New trends organization 
    21    !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility 
    22    !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization 
    23    !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation 
    24    !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization 
    25    !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY) 
    26    !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp 
    27    !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 
    28    !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    29    !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    30    !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE 
    31    !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening  
    32    !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla) 
    33    !!            4.0  ! 2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
     6   !! History :  4.0  !  2020-05  (A. Nasser, G. Madec)  Original code from 4.0.2 
     7   !!             -   !  2020-10  (S. Techene, G. Madec)  cleanning 
    348   !!---------------------------------------------------------------------- 
    359 
    … …  
    4216   !!---------------------------------------------------------------------- 
    4317   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
     18   ! 
    4419   USE phycst         ! physical constant                  (par_cst routine) 
    4520   USE domain         ! domain initialization   (dom_init & dom_cfg routines) 
    46    USE closea         ! treatment of closed seas (for ln_closea) 
    4721   USE usrdef_nam     ! user defined configuration 
    48    USE tide_mod, ONLY : tide_init ! tidal components initialization   (tide_init routine) 
    49    USE bdy_oce,  ONLY : ln_bdy 
    5022   USE bdyini         ! open boundary cond. setting       (bdy_init routine) 
    5123   USE istate         ! initial state setting          (istate_init routine) 
    52    USE ldfdyn         ! lateral viscosity setting      (ldfdyn_init routine) 
    53    USE ldftra         ! lateral diffusivity setting    (ldftra_init routine) 
    54    USE trdini         ! dyn/tra trends initialization     (trd_init routine) 
    55    USE asminc         ! assimilation increments      
    56    USE asmbkg         ! writing out state trajectory 
    57    USE diaptr         ! poleward transports           (dia_ptr_init routine) 
    58    USE diadct         ! sections transports           (dia_dct_init routine) 
    59    USE diaobs         ! Observation diagnostics       (dia_obs_init routine) 
    60    USE diacfl         ! CFL diagnostics               (dia_cfl_init routine) 
    61    USE diamlr         ! IOM context management for multiple-linear-regression analysis 
     24   USE trd_oce , ONLY : l_trddyn         ! dynamical trend logical 
    6225#if defined key_RK3 
    63    USE stpRK3 
    64 #elif defined key_qco 
    65    USE stpLF 
     26   USE stprk3         ! NEMO time-stepping               (stp_RK3   routine) 
    6627#else 
    67    USE step           ! NEMO time-stepping                 (stp     routine) 
    68 #endif 
    69    USE isfstp         ! ice shelf                     (isf_stp_init routine) 
    70    USE icbini         ! handle bergs, initialisation 
    71    USE icbstp         ! handle bergs, calving, themodynamics and transport 
    72    USE cpl_oasis3     ! OASIS3 coupling 
    73    USE c1d            ! 1D configuration 
    74    USE step_c1d       ! Time stepping loop for the 1D configuration 
    75    USE dyndmp         ! Momentum damping 
    76    USE stopar         ! Stochastic param.: ??? 
    77    USE stopts         ! Stochastic param.: ??? 
    78    USE diu_layers     ! diurnal bulk SST and coolskin 
    79    USE crsini         ! initialise grid coarsening utility 
    80    USE dia25h         ! 25h mean output 
    81    USE diadetide      ! Weights computation for daily detiding of model diagnostics 
    82    USE sbc_oce , ONLY : lk_oasis 
    83    USE wet_dry        ! Wetting and drying setting   (wad_init routine) 
    84 #if defined key_top 
    85    USE trcini         ! passive tracer initialisation 
    86 #endif 
    87 #if defined key_nemocice_decomp 
    88    USE ice_domain_size, only: nx_global, ny_global 
     28   USE stpmlf         ! NEMO time-stepping               (stp_MLF   routine) 
    8929#endif 
    9030   ! 
    9131   USE lib_mpp        ! distributed memory computing 
    9232   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    93    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges  
     33   USE lbcnfd  , ONLY : isendto, nsndto  ! Setup of north fold exchanges  
    9434   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    95 #if defined key_iomput 
    96    USE xios           ! xIOserver 
    97 #endif 
    98 #if defined key_agrif 
    99    USE agrif_all_update   ! Master Agrif update 
    100 #endif 
     35   USE halo_mng       ! Halo manager 
    10136 
    10237   IMPLICIT NONE 
    … …  
    13974      !!---------------------------------------------------------------------- 
    14075      ! 
    141 #if defined key_agrif 
    142       CALL Agrif_Init_Grids()      ! AGRIF: set the meshes 
    143 #endif 
    14476      !                            !-----------------------! 
    14577      CALL nemo_init               !==  Initialisations  ==! 
    14678      !                            !-----------------------! 
    147        
    148 #if defined key_agrif 
    149       Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    150       CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
    151       CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
    152 # if defined key_top 
    153       CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
    154 # endif 
    155 # if defined key_si3 
    156       CALL Agrif_Declare_Var_ice   !  "      "   "   "      "  Sea ice 
    157 # endif 
    158 #endif 
    15979      ! check that all process are still there... If some process have an error, 
    16080      ! they will never enter in step and other processes will wait until the end of the cpu time! 
     81      ! 
     82      !                                 ! SWE case: only with key_qco 
     83#if ! defined key_qco   
     84      CALL ctl_stop( 'nemo_gcm (SWE): shallow water model requires key_qco' ) 
     85#endif 
     86      ! 
    16187      CALL mpp_max( 'nemogcm', nstop ) 
    16288 
    … …  
    174100      ! 
    175101      DO WHILE( istp <= nitend .AND. nstop == 0 ) 
    176  
     102         ! 
    177103         ncom_stp = istp 
    178104         IF( ln_timing ) THEN 
    … …  
    181107            IF ( istp ==         nitend ) elapsed_time = zstptiming - elapsed_time 
    182108         ENDIF 
     109         !  
    183110#if defined key_RK3 
    184111         CALL stp_RK3    ( istp ) 
    185 #elif defined key_qco 
    186          CALL stp_LF     ( istp ) 
    187112#else 
    188          CALL stp        ( istp ) 
     113         CALL stp_MLF     ( istp ) 
    189114#endif 
    190115         istp = istp + 1 
    191  
     116         ! 
    192117         IF( lwp .AND. ln_timing )   WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming 
    193  
     118         ! 
    194119      END DO 
    195120      ! 
    … …  
    232157      INTEGER ::   ios, ilocal_comm   ! local integers 
    233158      !! 
    234       NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             & 
    235          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    236          &             ln_timing, ln_diacfl 
     159      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, nn_isplt, nn_jsplt , nn_ictls,   & 
     160         &                                             nn_ictle, nn_jctls , nn_jctle 
    237161      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    238162      !!---------------------------------------------------------------------- 
    … …  
    246170      ! 
    247171#if defined key_iomput 
    248       IF( Agrif_Root() ) THEN 
    249          IF( lk_oasis ) THEN 
    250             CALL cpl_init( "oceanx", ilocal_comm )                               ! nemo local communicator given by oasis 
    251             CALL xios_initialize( "not used"       , local_comm =ilocal_comm )   ! send nemo communicator to xios 
    252          ELSE 
    253             CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios 
    254          ENDIF 
    255       ENDIF 
     172      CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios 
    256173      CALL mpp_start( ilocal_comm ) 
    257174#else 
    258       IF( lk_oasis ) THEN 
    259          IF( Agrif_Root() ) THEN 
    260             CALL cpl_init( "oceanx", ilocal_comm )          ! nemo local communicator given by oasis 
    261          ENDIF 
    262          CALL mpp_start( ilocal_comm ) 
    263       ELSE 
    264          CALL mpp_start( ) 
    265       ENDIF 
     175      CALL mpp_start( ) 
    266176#endif 
    267177      ! 
    … …  
    292202      ! 
    293203      ! finalize the definition of namctl variables 
    294       IF( sn_cfctl%l_allon ) THEN 
    295          ! Turn on all options. 
    296          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    297          ! Ensure all processors are active 
    298          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    299       ELSEIF( sn_cfctl%l_config ) THEN 
    300          ! Activate finer control of report outputs 
    301          ! optionally switch off output from selected areas (note this only 
    302          ! applies to output which does not involve global communications) 
    303          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    304            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    305            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    306       ELSE 
    307          ! turn off all options. 
    308          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    309       ENDIF 
     204      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     205         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    310206      ! 
    311207      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
    … …  
    336232         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
    337233         WRITE(numout,*) 
     234          
     235         ! Print the working precision to ocean.output 
     236         IF (wp == dp) THEN 
     237            WRITE(numout,*) "Working precision = double-precision" 
     238         ELSE 
     239            WRITE(numout,*) "Working precision = single-precision" 
     240         ENDIF 
     241         WRITE(numout,*) 
    338242         ! 
    339243         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
    … …  
    353257      ! 
    354258      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    355          CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     259         CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    356260      ELSE                              ! user-defined namelist 
    357          CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     261         CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    358262      ENDIF 
    359263      ! 
    … …  
    365269      CALL mpp_init 
    366270 
     271      CALL halo_mng_init() 
    367272      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    368273      CALL nemo_alloc() 
    369274 
    370275      ! Initialise time level indices 
    371       Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
    372  
     276      Nbb = 1   ;   Nnn = 2   ;   Naa = 3   ;  Nrhs = Naa 
     277       
    373278      !                             !-------------------------------! 
    374279      !                             !  NEMO general initialization  ! 
    … …  
    382287      ! 
    383288                           CALL     phy_cst         ! Physical constants 
    384                             
     289      ! 
     290      !                                             ! SWE: Set rho0 and associated variables (eosbn2 not used) 
     291                           rho0        = 1026._wp                 !: volumic mass of reference     [kg/m3] 
     292                           rcp         = 3991.86795711963_wp      !: heat capacity     [J/K] 
     293                           rho0_rcp    = rho0 * rcp  
     294                           r1_rho0     = 1._wp / rho0 
     295                           r1_rcp      = 1._wp / rcp 
     296                           r1_rho0_rcp = 1._wp / rho0_rcp  
     297      ! 
    385298                           CALL     dom_init( Nbb, Nnn, Naa ) ! Domain 
    386299 
    … …  
    391304 
    392305      !                                      ! external forcing  
    393                            CALL    tide_init                     ! tidal harmonics 
    394  
    395306                           CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice) 
    396                             
    397307 
    398308      !                                      ! Ocean physics                                     
    … …  
    400310                           CALL ldf_dyn_init      ! Lateral ocean momentum physics 
    401311                            
    402                             
    403312      !                                      ! Dynamics 
    404313                           CALL dyn_adv_init         ! advection (vector or flux form) 
    405  
    406314                           CALL dyn_vor_init         ! vorticity term including Coriolis 
    407  
    408315                           CALL dyn_ldf_init         ! lateral mixing 
    409316 
    410                            CALL dyn_spg_init         ! surface pressure gradient 
    411  
    412317      !                                      ! Diagnostics 
    413                            CALL     flo_init( Nnn )    ! drifting Floats 
    414                             
    415318      IF( ln_diacfl    )   CALL dia_cfl_init    ! Initialise CFL diagnostics 
    416  
    417                            CALL     trd_init( Nnn )    ! Mixed-layer/Vorticity/Integral constraints trends 
    418  
     319      !                                         ! Trends diag: switched off 
     320                           l_trddyn = .FALSE.        ! No trend diagnostics 
    419321 
    420322      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA 
    … …  
    422324      IF( ln_timing    )   CALL timing_stop( 'nemo_init') 
    423325      ! 
    424  
    425326   END SUBROUTINE nemo_init 
    426327 
    … …  
    440341         WRITE(numout,*) '~~~~~~~~' 
    441342         WRITE(numout,*) '   Namelist namctl' 
    442          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    443          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    444          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    445343         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    446344         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
    … …  
    454352         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    455353         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    456          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    457          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    458          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    459          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    460          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    461          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    462          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    463354         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    464355         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    465356      ENDIF 
    466357      ! 
    467       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    468       nictls    = nn_ictls 
    469       nictle    = nn_ictle 
    470       njctls    = nn_jctls 
    471       njctle    = nn_jctle 
    472       isplt     = nn_isplt 
    473       jsplt     = nn_jsplt 
    474  
     358      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    475359      IF(lwp) THEN                  ! control print 
    476360         WRITE(numout,*) 
    … …  
    482366         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out) 
    483367         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    484       ENDIF 
    485       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    486       ! 
    487       !                             ! Parameter control 
    488       ! 
    489       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    490          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    491             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    492          ELSE 
    493             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    494                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    495                   &           ' - the print control will be done over the whole domain' ) 
    496             ENDIF 
    497             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    498          ENDIF 
    499          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    500          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    501          ! 
    502          !                              ! indices used for the SUM control 
    503          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    504             lsp_area = .FALSE. 
    505          ELSE                                             ! print control done over a specific  area 
    506             lsp_area = .TRUE. 
    507             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    508                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    509                nictls = 1 
    510             ENDIF 
    511             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    512                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    513                nictle = jpiglo 
    514             ENDIF 
    515             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    516                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    517                njctls = 1 
    518             ENDIF 
    519             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    520                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    521                njctle = jpjglo 
    522             ENDIF 
    523          ENDIF 
    524368      ENDIF 
    525369      ! 
    … …  
    571415      USE diawri    , ONLY : dia_wri_alloc 
    572416      USE dom_oce   , ONLY : dom_oce_alloc 
    573       USE trc_oce   , ONLY : trc_oce_alloc 
    574       USE bdy_oce   , ONLY : bdy_oce_alloc 
    575417      ! 
    576418      INTEGER :: ierr 
    577419      !!---------------------------------------------------------------------- 
    578420      ! 
    579       ierr =        oce_alloc    ()    ! ocean  
     421      ierr =        oce_SWE_alloc()    ! ocean  
    580422      ierr = ierr + dia_wri_alloc() 
    581423      ierr = ierr + dom_oce_alloc()    ! ocean domain 
    582424      ierr = ierr + zdf_oce_alloc()    ! ocean vertical physics 
    583       ierr = ierr + trc_oce_alloc()    ! shared TRC / TRA arrays 
    584       ierr = ierr + bdy_oce_alloc()    ! bdy masks (incl. initialization) 
    585425      ! 
    586426      CALL mpp_sum( 'nemogcm', ierr ) 
    … …  
    590430 
    591431    
    592    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     432   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    593433      !!---------------------------------------------------------------------- 
    594434      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    595435      !! 
    596436      !! ** Purpose :   Set elements of the output control structure to setto. 
    597       !!                for_all should be .false. unless all areas are to be 
    598       !!                treated identically. 
    599437      !! 
    600438      !! ** Method  :   Note this routine can be used to switch on/off some 
    601       !!                types of output for selected areas but any output types 
    602       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    603       !!                should be protected from selective switching by the 
    604       !!                for_all argument 
    605       !!---------------------------------------------------------------------- 
    606       LOGICAL :: setto, for_all 
    607       TYPE(sn_ctl) :: sn_cfctl 
    608       !!---------------------------------------------------------------------- 
    609       IF( for_all ) THEN 
    610          sn_cfctl%l_runstat = setto 
    611          sn_cfctl%l_trcstat = setto 
    612       ENDIF 
     439      !!                types of output for selected areas. 
     440      !!---------------------------------------------------------------------- 
     441      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     442      LOGICAL     , INTENT(in   ) :: setto 
     443      !!---------------------------------------------------------------------- 
     444      sn_cfctl%l_runstat = setto 
     445      sn_cfctl%l_trcstat = setto 
    613446      sn_cfctl%l_oceout  = setto 
    614447      sn_cfctl%l_layout  = setto 
    … …  
    620453   !!====================================================================== 
    621454END MODULE nemogcm 
    622  

  • NEMO/trunk/src/SWE/stpctl.F90

    r13458 r14053  
    33   !!                       ***  MODULE  stpctl  *** 
    44   !! Ocean run control :  gross check of the ocean time stepping 
     5   !!              *** Shallow Water Equation (SWE) case *** 
     6   !!               ( No test on temperature and salinity ) 
    57   !!====================================================================== 
    6    !! History :  OPA  ! 1991-03  (G. Madec) Original code 
    7    !!            6.0  ! 1992-06  (M. Imbard) 
    8    !!            8.0  ! 1997-06  (A.M. Treguier) 
    9    !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
    10    !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting 
    11    !!            3.7  ! 2016-09  (G. Madec)  Remove solver 
    12    !!            4.0  ! 2017-04  (G. Madec)  regroup global communications 
     8   !! History :  SWE  ! 2020-09  (A. Nasser, S. Techene ) OCE/stpctl adaptated to SWE 
    139   !!---------------------------------------------------------------------- 
    1410 
    … …  
    2117   USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables 
    2218   USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy 
    23    !   
     19   ! 
    2420   USE diawri          ! Standard run outputs       (dia_wri_state routine) 
    2521   USE in_out_manager  ! I/O manager 
    2622   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2723   USE lib_mpp         ! distributed memory computing 
    28    ! 
    2924   USE netcdf          ! NetCDF library 
     25 
    3026   IMPLICIT NONE 
    3127   PRIVATE 
    … …  
    3531   INTEGER                ::   nrunid   ! netcdf file id 
    3632   INTEGER, DIMENSION(2)  ::   nvarid   ! netcdf variable id 
     33 
     34#  include "domzgr_substitute.h90" 
    3735   !!---------------------------------------------------------------------- 
    3836   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    4947      !! 
    5048      !! ** Method  : - Save the time step in numstp 
     49      !!              - Print it each 50 time steps 
    5150      !!              - Stop the run IF problem encountered by setting nstop > 0 
    52       !!                Problems checked: negative sea surface height  
     51      !!                Problems checked: e3t0+ssh minimum smaller that 0 
    5352      !!                                  |U|   maximum larger than 10 m/s  
     53      !!                                  ( not for SWE : negative sea surface salinity ) 
    5454      !! 
    5555      !! ** Actions :   "time.step" file = last ocean time-step 
    … …  
    6363      INTEGER                         ::   idtime, istatus 
    6464      INTEGER , DIMENSION(3)          ::   iareasum, iareamin, iareamax 
    65       INTEGER , DIMENSION(3,2)        ::   iloc                                  ! min/max loc indices 
     65      INTEGER , DIMENSION(3,4)        ::   iloc                                  ! min/max loc indices 
    6666      REAL(wp)                        ::   zzz                                   ! local real  
    6767      REAL(wp), DIMENSION(3)          ::   zmax, zmaxlocal 
    … …  
    7070      CHARACTER(len=20)               ::   clname 
    7171      !!---------------------------------------------------------------------- 
     72      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
     73      ! 
    7274      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
    7375      ! 
    … …  
    109111      !                                   !==            test of local extrema           ==! 
    110112      !                                   !==  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       ! 
     113      zmax(1) = MINVAL( e3t_0(:,:,1)+ssh(:,:,Kmm)  )                              ! e3t_Kmm min 
     114      llmsk(:,:,:) = umask(:,:,:) == 1._wp 
     115      zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) ), mask = llmsk )                     ! velocity max (zonal only) 
     116      zmax(3) = REAL( nstop , wp )                                            ! stop indicator 
     117      !                                   !==               get global extrema             ==! 
     118      !                                   !==  done by all processes if writting run.stat  ==! 
    117119      llmsk(Nis0:Nie0,Njs0:Nje0,1) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp         ! define only the inner domain 
    118120      zmax(1) = MAXVAL(     -e3t(:,:,1,Kmm) ), mask = llmsk(:,:,1) )      ! ssh max 
    … …  
    131133      IF( ll_wrtruns ) THEN 
    132134         WRITE(numrun,9500) kt, zmax(1), zmax(2) 
    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         istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 
     136         istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 
    135137         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid) 
    136       END IF 
     138      ENDIF 
    137139      !                                   !==               error handling               ==! 
    138140      !                                   !==  done by all processes at every time step  ==! 
    139141      ! 
    140       IF(   zmax(1) >  0._wp           .OR.   &               ! negative sea surface height  
    141          &  zmax(2) > 10._wp           .OR.   &               ! too large velocity ( > 10 m/s) 
     142!!SWE specific : start 
     143      IF(   zmax(1) <=   0._wp .OR.           &               ! negative e3t_Kmm 
     144         &  zmax(2) >   10._wp .OR.           &               ! too large velocity ( > 10 m/s) 
    142145         &  ISNAN( zmax(1) + zmax(2) ) .OR.   &               ! NaN encounter in the tests 
    143146         &  ABS(   zmax(1) + zmax(2) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
    … …  
    148151            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
    149152            ! 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) ) 
     153            CALL mpp_minloc( 'stpctl', e3t_0(:,:,1) + ssh(:,:,Kmm), ssmask(:,:  ), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     154            CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:,Kmm))        ,  umask(:,:,:), zzz, iloc(1:3,2) ) 
    154155            ! find which subdomain has the max. 
    155156            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
    … …  
    164165         ELSE                    ! find local min and max locations: 
    165166            ! 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 
     167            iloc(1:2,1) = MINLOC( e3t_0(:,:,1) + ssh(:,:,Kmm), mask = ssmask(:,:  ) == 1._wp ) + (/ nimpp - 1, njmpp - 1    /) 
     168            iloc(1:3,2) = MAXLOC( ABS(  uu(:,:,:,       Kmm)), mask =  umask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    173169            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
    174170         ENDIF 
    175171         ! 
    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) ) 
     172         WRITE(ctmp1,*) ' stp_ctl:  e3t0+ssh < 0 m  or  |U| > 10 m/s  or  NaN encounter in the tests' 
     173         CALL wrt_line( ctmp2, kt, 'e3t0+ssh min',  zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
     174         CALL wrt_line( ctmp3, kt, '|U|   max'   ,  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
    179175         IF( Agrif_Root() ) THEN 
    180176            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files' 
    … …  
    194190         ! 
    195191      ENDIF 
     192!!SWE specific : end 
    196193      ! 
    197194      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
    … …  
    200197      ENDIF 
    201198      ! 
    202 9500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 
     1999500  FORMAT(' it :', i8, '      e3t_min: ', D23.16, ' |U|_max: ', D23.16) 
    203200      ! 
    204201   END SUBROUTINE stp_ctl 

  • NEMO/trunk/src/TOP/PISCES/SED/oce_sed.F90

    r13237 r14053  
    1313   USE dom_oce , ONLY :   glamt     =>   glamt          !: longitude of t-point (degre) 
    1414   USE dom_oce , ONLY :   gphit     =>   gphit          !: latitude  of t-point (degre) 
    15 !!st  
     15  
    1616#if ! defined key_qco 
    1717   USE dom_oce , ONLY :   e3t       =>   e3t            !: latitude  of t-point (degre) 

  • NEMO/trunk/src/TOP/TRP/trcatf.F90

    r13295 r14053  
    3232   USE trdtra 
    3333# if defined key_qco 
    34    USE traatfqco 
     34   USE traatf_qco 
    3535# else 
    3636   USE traatf 

  • NEMO/trunk/tests/BENCH/EXPREF/namelist_cfg_orca025_like

    r13461 r14053  
    178178!----------------------------------------------------------------------- 
    179179   ln_dynvor_een = .true. !  energy & enstrophy scheme 
    180       nn_een_e3f = 0          ! =0  e3f = mi(mj(e3t))/4  
    181       !                       ! =1  e3f = mi(mj(e3t))/mi(mj( tmask)) 
     180   nn_e3f_typ = 0         ! =0  e3f = mi(mj(e3t))/4  
     181   !                      ! =1  e3f = mi(mj(e3t))/mi(mj( tmask)) 
    182182/ 
    183183!----------------------------------------------------------------------- 

  • NEMO/trunk/tests/BENCH/EXPREF/namelist_cfg_orca12_like

    r13461 r14053  
    177177!----------------------------------------------------------------------- 
    178178   ln_dynvor_een = .true. !  energy & enstrophy scheme 
    179       nn_een_e3f = 0          ! =0  e3f = mi(mj(e3t))/4  
     179      nn_e3f_typ = 0          ! =0  e3f = mi(mj(e3t))/4  
    180180      !                       ! =1  e3f = mi(mj(e3t))/mi(mj( tmask)) 
    181181/ 

  • NEMO/trunk/tests/BENCH/MY_SRC/usrdef_istate.F90

    r13295 r14053  
    2626   PRIVATE 
    2727 
    28    PUBLIC   usr_def_istate   ! called by istate.F90 
     28   PUBLIC   usr_def_istate       ! called by istate.F90 
     29   PUBLIC   usr_def_istate_ssh   ! called by domqco.F90 
    2930 
    3031   !! * Substitutions 
    … …  
    3738CONTAINS 
    3839   
    39    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     40   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) !!st, pssh ) 
    4041      !!---------------------------------------------------------------------- 
    4142      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    5253      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    5354      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    54       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
     55!!st      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5556      ! 
    5657      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace 
    … …  
    7980      ! 
    8081      ! sea level: 
    81       pssh(:,:) = z2d(:,:)                                                ! +/- 0.05 m 
     82!!st      pssh(:,:) = z2d(:,:)                                                ! +/- 0.05 m 
    8283      ! 
    8384      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    … …  
    9596      pv( :,:,jpk  ) = 0._wp 
    9697      ! 
    97       CALL lbc_lnk('usrdef_istate', pssh, 'T',  1. )            ! apply boundary conditions 
     98!!st      CALL lbc_lnk('usrdef_istate', pssh, 'T',  1. )            ! apply boundary conditions 
    9899      CALL lbc_lnk('usrdef_istate',  pts, 'T',  1. )            ! apply boundary conditions 
    99100      CALL lbc_lnk('usrdef_istate',   pu, 'U', -1. )            ! apply boundary conditions 
    … …  
    102103   END SUBROUTINE usr_def_istate 
    103104 
     105 
     106   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     107      !!---------------------------------------------------------------------- 
     108      !!                   ***  ROUTINE usr_def_istate_ssh  *** 
     109      !!  
     110      !! ** Purpose :   Initialization of ssh 
     111      !!                Here BENCH configuration  
     112      !! 
     113      !! ** Method  :   Set ssh 
     114      !!---------------------------------------------------------------------- 
     115      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m] 
     116      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m] 
     117      ! 
     118      INTEGER  ::   ji, jj 
     119      INTEGER  ::   igloi, igloj   ! to be removed in the future, see usr_def_istate comment  
     120      !!---------------------------------------------------------------------- 
     121      ! 
     122      IF(lwp) WRITE(numout,*) 
     123      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : BENCH configuration, analytical definition of initial ssh' 
     124      ! 
     125      igloi = Ni0glo + 2 * COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 
     126      igloj = Nj0glo + 2 * COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) + 1 * COUNT( (/ jperio >= 4 .AND. jperio <= 6 /) ) 
     127      ! sea level:  +/- 0.05 m 
     128      DO_2D( 0, 0, 0, 0 ) 
     129         pssh(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * igloi, wp ) / REAL( igloi * igloj, wp ) ) 
     130      END_2D 
     131      ! 
     132      CALL lbc_lnk('usrdef_istate', pssh, 'T',  1. )            ! apply boundary conditions 
     133      ! 
     134   END SUBROUTINE usr_def_istate_ssh 
     135    
    104136   !!====================================================================== 
    105137END MODULE usrdef_istate 

  • NEMO/trunk/tests/CANAL/EXPREF/namelist_cfg

    r13558 r14053  
    235235   ln_dynvor_mix = .false.  !  mixed scheme 
    236236   ln_dynvor_een = .false.  !  energy & enstrophy scheme 
    237    ln_dynvor_enT = .false.  !  energy conserving scheme (T-point) 
     237r_enT = .false.  !  energy conserving scheme (T-point) 
    238238   ln_dynvor_eeT = .true.   !  energy conserving scheme (een using e3t) 
    239       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
     239      nn_e3f_typ = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    240240/ 
    241241!----------------------------------------------------------------------- 
    … …  
    319319!!   namdiu       Cool skin and warm layer models                       (default: OFF) 
    320320!!   namdiu       Cool skin and warm layer models                       (default: OFF) 
    321 <<<<<<< .working 
    322 !!   namflo       float parameters                                      (default: OFF) 
    323 !!   nam_diadct   transports through some sections                      (default: OFF) 
    324 ||||||| .merge-left.r13465 
    325 !!   namflo       float parameters                                      (default: OFF) 
    326 !!   nam_diaharm  Harmonic analysis of tidal constituents               (default: OFF) 
    327 !!   nam_diadct   transports through some sections                      (default: OFF) 
    328 ======= 
    329321!!   namflo       float parameters                                      ("key_float") 
    330322!!   nam_diaharm  Harmonic analysis of tidal constituents               ("key_diaharm") 
    331323!!   namdct       transports through some sections                      ("key_diadct") 
    332324!!   nam_diatmb   Top Middle Bottom Output                              (default: OFF) 
    333 >>>>>>> .merge-right.r13470 
    334325!!   nam_dia25h   25h Mean Output                                       (default: OFF) 
    335326!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4") 

  • NEMO/trunk/tests/CANAL/MY_SRC/usrdef_istate.F90

    r13472 r14053  
    2626   PRIVATE 
    2727 
    28    PUBLIC   usr_def_istate   ! called by istate.F90 
     28   PUBLIC   usr_def_istate       ! called by istate.F90 
     29   PUBLIC   usr_def_istate_ssh   ! called by sshwzv.F90 
    2930 
    3031   !! * Substitutions 
    … …  
    3738CONTAINS 
    3839   
    39    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     40   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    4041      !!---------------------------------------------------------------------- 
    4142      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    5253      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    5354      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    54       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5555      ! 
    5656      INTEGER  :: ji, jj, jk, jl  ! dummy loop indices 
    … …  
    8787 
    8888      CASE(0)    ! rest 
    89           
    90          ! sea level: 
    91          pssh(:,:) = 0. 
     89         ! 
    9290         ! temperature: 
    9391         pts(:,:,:,jp_tem) = 10._wp 
    … …  
    9997          
    10098      CASE(1)    ! geostrophic zonal jet from -zjety to +zjety 
    101  
    102          ! sea level: 
    103          SELECT CASE( nn_fcase ) 
    104          CASE(0)    ! f = f0 
    105             ! sea level: ssh = - fuy / g 
    106             WHERE( ABS(gphit) <= zjety ) 
    107                pssh(:,:) = - ff_t(:,:) * rn_uzonal * gphit(:,:) * 1.e3 / grav 
    108             ELSEWHERE 
    109                pssh(:,:) = - ff_t(:,:) * rn_uzonal * SIGN(zjety, gphit(:,:)) * 1.e3 / grav 
    110             END WHERE 
    111          CASE(1)    ! f = f0 + beta*y 
    112             ! sea level: ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 
    113             zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 
    114             WHERE( ABS(gphit) <= zjety ) 
    115                pssh(:,:) = - rn_uzonal / grav * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
    116             ELSEWHERE 
    117                pssh(:,:) = - rn_uzonal / grav * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3   & 
    118                   &                             + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
    119             END WHERE 
    120          END SELECT 
     99         ! 
    121100         ! temperature: 
    122101         pts(:,:,:,jp_tem) = 10._wp 
    … …  
    139118         !                   
    140119      CASE(2)    ! geostrophic zonal current shear 
    141        
    142          ! sea level: 
    143          SELECT CASE( nn_fcase ) 
    144          CASE(0)    ! f = f0 
    145             ! sea level: ssh = - fuy / g 
    146             WHERE( ABS(gphit) <= zjety ) 
    147                pssh(:,:) = - ff_t(:,:) * rn_uzonal * ABS(gphit(:,:)) * 1.e3 / grav 
    148             ELSEWHERE 
    149                pssh(:,:) = - ff_t(:,:) * rn_uzonal * zjety * 1.e3 / grav 
    150             END WHERE 
    151          CASE(1)    ! f = f0 + beta*y 
    152             ! sea level: ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 
    153             zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 
    154             WHERE( ABS(gphit) <= zjety ) 
    155                pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav   & 
    156                   &        * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
    157             ELSEWHERE 
    158                pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav   & 
    159                   &        * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
    160             END WHERE 
    161          END SELECT 
     120         ! 
    162121         ! temperature: 
    163122         pts(:,:,:,jp_tem) = 10._wp 
    … …  
    176135         !                   
    177136      CASE(3)    ! gaussian zonal currant 
    178  
     137         ! 
    179138         ! zonal current 
    180139         DO jk=1, jpkm1 
    … …  
    182141            pu(:,:,jk) = rn_uzonal * EXP( - 0.5 * gphit(:,:)**2 / rn_lambda**2 ) 
    183142         END DO 
    184           
    185          ! sea level: 
    186          pssh(:,1) = - ff_t(:,1) / grav * pu(:,1,1) * e2t(:,1) 
    187          DO jl=1, jpnj 
    188             DO_2D( 0, 0, 0, 0 ) 
    189                pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * pu(ji,jj,1) * e2t(ji,jj) 
    190             END_2D 
    191             CALL lbc_lnk( 'usrdef_istate', pssh, 'T',  1. ) 
    192          END DO 
    193           
    194143         ! temperature: 
    195144         pts(:,:,:,jp_tem) = 10._wp 
    … …  
    202151         !             
    203152      CASE(4)    ! geostrophic zonal pulse 
    204     
     153         ! 
    205154         DO_2D( 1, 1, 1, 1 ) 
    206155            IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN 
    … …  
    210159            ELSE 
    211160               zdu = 0. 
    212             END IF 
     161            ENDIF 
    213162            IF ( ABS(gphit(ji,jj)) <= zjety ) THEN 
    214                pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav 
    215163               pu(ji,jj,:) = zdu 
    216164               pts(ji,jj,:,jp_sal) = zdu / rn_uzonal + 1. 
    217165            ELSE 
    218                pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav  
    219166               pu(ji,jj,:) = 0. 
    220167               pts(ji,jj,:,jp_sal) = 1. 
    221             END IF 
    222          END_2D 
    223           
     168            ENDIF 
     169         END_2D 
     170         ! 
    224171         ! temperature: 
    225172         pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:)         
    226173         pv(:,:,:) = 0. 
    227           
    228        CASE(5)    ! vortex 
    229                   ! 
     174         ! 
     175      CASE(5)    ! vortex 
     176         ! 
    230177         zf0   = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 
    231          zumax = rn_vtxmax * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 
     178         zumax = rn_vtxmax * SIGN(1._wp, zf0)  ! Here Anticyclonic: set zumax=-1 for cyclonic 
    232179         zlambda = SQRT(2._wp)*rn_lambda*1.e3       ! Horizontal scale in meters  
    233180         zn2 = 3.e-3**2 
    … …  
    242189            ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y) 
    243190            zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy 
    244             ! Sea level: 
    245             pssh(ji,jj) = 0. 
    246             DO jl=1,5 
    247                zdt = pssh(ji,jj) 
    248                zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH))   ! F'(z) 
    249                zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav    ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 
    250                pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1)   ! ssh = Psurf / (Rho*g) 
    251             END DO 
    252191            ! temperature: 
    253192            DO jk=1,jpk 
    … …  
    299238         !             
    300239      END SELECT 
    301        
     240      ! 
     241      CALL lbc_lnk( 'usrdef_istate', pts , 'T',  1. ) 
     242      CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 
     243 
     244   END SUBROUTINE usr_def_istate 
     245 
     246   
     247   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     248      !!---------------------------------------------------------------------- 
     249      !!                   ***  ROUTINE usr_def_istate_ssh  *** 
     250      !!  
     251      !! ** Purpose :   Initialization of the dynamics and tracers 
     252      !!                Here CANAL configuration  
     253      !! 
     254      !! ** Method  :   Set ssh  
     255      !!---------------------------------------------------------------------- 
     256      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask             [m] 
     257      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
     258      ! 
     259      INTEGER  :: ji, jj, jk, jl  ! dummy loop indices 
     260      REAL(wp) :: zx, zy, zP0, zumax, zlambda, zr_lambda2, zn2, zf0, zH, zrho1, za, zf, zdzF 
     261      REAL(wp) :: zpsurf, zdyPs, zdxPs 
     262      REAL(wp) :: zdt, zdu, zdv 
     263      REAL(wp) :: zjetx, zjety, zbeta 
     264      REAL(wp), DIMENSION(jpi,jpj)  ::   zrandom 
     265      !!---------------------------------------------------------------------- 
     266      ! 
     267      IF(lwp) WRITE(numout,*) 
     268      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : CANAL configuration, analytical definition of initial state' 
     269      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   ' 
     270      ! 
     271      IF (ln_sshnoise) CALL RANDOM_NUMBER(zrandom) 
     272      zjetx = ABS(rn_ujetszx)/2. 
     273      zjety = ABS(rn_ujetszy)/2. 
     274      ! 
     275      SELECT CASE(nn_initcase) 
     276      CASE(0)                      !==   rest  ==! 
     277         ! 
     278         pssh(:,:) = 0. 
     279         ! 
     280      CASE(1)                      !==  geostrophic zonal jet from -zjety to +zjety  ==! 
     281         ! 
     282         SELECT CASE( nn_fcase ) 
     283         CASE(0)                          !* f = f0 : ssh = - fuy / g 
     284            WHERE( ABS(gphit) <= zjety ) 
     285               pssh(:,:) = - ff_t(:,:) * rn_uzonal * gphit(:,:) * 1.e3 / grav 
     286            ELSEWHERE 
     287               pssh(:,:) = - ff_t(:,:) * rn_uzonal * SIGN(zjety, gphit(:,:)) * 1.e3 / grav 
     288            END WHERE 
     289         CASE(1)                          !* f = f0 + beta*y : ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 
     290            zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 
     291            WHERE( ABS(gphit) <= zjety ) 
     292               pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
     293            ELSEWHERE 
     294               pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3   & 
     295                  &                             + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
     296            END WHERE 
     297         END SELECT 
     298         !                   
     299      CASE(2)                      !==  geostrophic zonal current shear  ==! 
     300         ! 
     301         SELECT CASE( nn_fcase ) 
     302         CASE(0)                          !* f = f0 : ssh = - fuy / g 
     303            WHERE( ABS(gphit) <= zjety ) 
     304               pssh(:,:) = - ff_t(:,:) * rn_uzonal * ABS(gphit(:,:)) * 1.e3 / grav 
     305            ELSEWHERE 
     306               pssh(:,:) = - ff_t(:,:) * rn_uzonal * zjety * 1.e3 / grav 
     307            END WHERE 
     308         CASE(1)                          !* f = f0 + beta*y : ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 
     309            zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 
     310            WHERE( ABS(gphit) <= zjety ) 
     311               pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav   & 
     312                  &        * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
     313            ELSEWHERE 
     314               pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav   & 
     315                  &        * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
     316            END WHERE 
     317         END SELECT 
     318         !                   
     319      CASE(3)                      !==  gaussian zonal currant  ==! 
     320         ! 
     321         pssh(:,1) = - ff_t(:,1) / grav * e2t(:,1) * rn_uzonal * EXP( - 0.5 * gphit(:,1)**2 / rn_lambda**2 ) 
     322         DO jl=1, jpnj 
     323            DO_2D( 0, 0, 0, 0 ) 
     324               pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * rn_uzonal * EXP( - 0.5 * gphit(ji,jj)**2 / rn_lambda**2 ) * e2t(ji,jj) 
     325            END_2D 
     326            CALL lbc_lnk( 'usrdef_istate_ssh', pssh, 'T',  1. ) 
     327         END DO 
     328         !             
     329      CASE(4)                      !==  geostrophic zonal pulse !!st need to implement a way to separate ssh properly  ==! 
     330         ! 
     331         DO_2D( 1, 1, 1, 1 ) 
     332            IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN 
     333               zdu = rn_uzonal 
     334            ELSEIF ( ABS(glamt(ji,jj)) <= zjetx + 100. ) THEN 
     335               zdu = rn_uzonal * ( ( zjetx-ABS(glamt(ji,jj)) )/100. + 1. ) 
     336            ELSE 
     337               zdu = 0. 
     338            ENDIF 
     339            IF ( ABS(gphit(ji,jj)) <= zjety ) THEN 
     340               pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav 
     341            ELSE 
     342               pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav  
     343            ENDIF 
     344         END_2D 
     345         ! 
     346      CASE(5)                    !==  vortex  ==! 
     347         ! 
     348         zf0   = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 
     349         zumax = rn_vtxmax * SIGN(1._wp, zf0)   ! Here Anticyclonic: set zumax=-1 for cyclonic 
     350         zlambda = SQRT(2._wp)*rn_lambda        ! Horizontal scale in meters  
     351         zn2 = 3.e-3**2 
     352         zH = 0.5_wp * 5000._wp 
     353         ! 
     354         zr_lambda2 = 1._wp / zlambda**2 
     355         zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 
     356         ! 
     357         DO_2D( 1, 1, 1, 1 ) 
     358            zx = glamt(ji,jj) * 1.e3 
     359            zy = gphit(ji,jj) * 1.e3 
     360            !                                   ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y) 
     361            zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy 
     362            pssh(ji,jj) = 0. 
     363            DO jl=1,5 
     364               zdt = pssh(ji,jj) 
     365               zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH))   ! F'(z) 
     366               zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav    ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 
     367               pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1)   ! ssh = Psurf / (Rho*g) 
     368            END DO 
     369         END_2D 
     370         !             
     371      END SELECT 
     372      !                          !==  add noise  ==! 
    302373      IF (ln_sshnoise) THEN 
    303374         CALL RANDOM_SEED() 
    304375         CALL RANDOM_NUMBER(zrandom) 
    305376         pssh(:,:) = pssh(:,:) + ( 0.1  * zrandom(:,:) - 0.05 ) 
    306       END IF 
    307       CALL lbc_lnk( 'usrdef_istate', pssh, 'T',  1. ) 
    308       CALL lbc_lnk( 'usrdef_istate', pts , 'T',  1. ) 
    309       CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 
    310  
    311    END SUBROUTINE usr_def_istate 
    312  
     377      ENDIF 
     378      CALL lbc_lnk( 'usrdef_istate_ssh', pssh, 'T',  1. ) 
     379      ! 
     380   END SUBROUTINE usr_def_istate_ssh 
     381    
    313382   !!====================================================================== 
    314383END MODULE usrdef_istate 

  • NEMO/trunk/tests/CPL_OASIS/EXPREF/namelist_cfg

    r13558 r14053  
    367367!----------------------------------------------------------------------- 
    368368   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    369       nn_een_e3f = 0          ! =0   e3f = mean masked e3t divided by 4 
    370369/ 
    371370!----------------------------------------------------------------------- 

  • NEMO/trunk/tests/ISOMIP+/MY_SRC/istate.F90

    r13583 r14053  
    117117            CALL dta_tsd( nit000, 'ini', ts(:,:,:,:,Kbb) )       ! read 3D T and S data at nit000 
    118118            ! 
    119             ssh(:,:,Kbb)   = 0._wp               ! set the ocean at rest 
    120             uu  (:,:,:,Kbb) = 0._wp 
    121             vv  (:,:,:,Kbb) = 0._wp   
     119            uu (:,:,:,Kbb) = 0._wp 
     120            vv (:,:,:,Kbb) = 0._wp 
    122121            ! 
    123             IF( ll_wd ) THEN 
    124                ssh(:,:,Kbb) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD  
    125                ! 
    126                ! Apply minimum wetdepth criterion 
    127                ! 
    128                DO_2D( 1, 1, 1, 1 ) 
    129                   IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN 
    130                      ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
    131                   ENDIF 
    132                END_2D 
    133             ENDIF  
    134              ! 
    135122         ELSE                                 ! user defined initial T and S 
    136123            DO jk = 1, jpk 
    137124               zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 
    138125            END DO 
    139             CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )          
     126            CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb)  )          
    140127         ENDIF 
    141128         ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
    142          ssh (:,:,Kmm)     = ssh(:,:,Kbb)    
    143129         uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    144130         vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 

  • NEMO/trunk/tests/ISOMIP/MY_SRC/usrdef_istate.F90

    r10074 r14053  
    99   !! History :  NEMO ! 2016-11 (S. Flavoni)             Original code 
    1010   !!                 ! 2017-02 (P. Mathiot, S. Flavoni) Adapt code to ISOMIP case 
     11   !!                 ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 
    1112   !!---------------------------------------------------------------------- 
    1213 
    … …  
    2425   PRIVATE 
    2526 
    26    PUBLIC   usr_def_istate   ! called by istate.F90 
     27   PUBLIC   usr_def_istate       ! called by istate.F90 
     28   PUBLIC   usr_def_istate_ssh   ! called by domqco.F90 
    2729 
    2830   !!---------------------------------------------------------------------- 
    … …  
    3335CONTAINS 
    3436   
    35    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     37   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    3638      !!---------------------------------------------------------------------- 
    3739      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    4850      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    4951      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    50       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    51       ! 
    52       INTEGER  ::   jk     ! dummy loop indices 
    5352      !!---------------------------------------------------------------------- 
    5453      ! 
    … …  
    5857      pu  (:,:,:) = 0._wp        ! ocean at rest 
    5958      pv  (:,:,:) = 0._wp 
    60       pssh(:,:)   = 0._wp 
    61       ! 
    6259      !                          ! T & S profiles 
    6360      pts(:,:,:,jp_tem) = - 1.9 * ptmask(:,:,:)          ! ISOMIP configuration : start from constant T+S fields 
    … …  
    6663   END SUBROUTINE usr_def_istate 
    6764 
     65 
     66   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     67      !!---------------------------------------------------------------------- 
     68      !!                   ***  ROUTINE usr_def_istate_ssh  *** 
     69      !!  
     70      !! ** Purpose :   Initialization of ssh 
     71      !!                Here ISOMIP configuration  
     72      !! 
     73      !! ** Method  :   set ssh to 0 
     74      !!---------------------------------------------------------------------- 
     75      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m] 
     76      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m] 
     77      !!---------------------------------------------------------------------- 
     78      ! 
     79      IF(lwp) WRITE(numout,*) 
     80      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : ISOMIP configuration, analytical definition of initial state' 
     81      ! 
     82      pssh(:,:)   = 0._wp 
     83      ! 
     84   END SUBROUTINE usr_def_istate_ssh 
     85 
    6886   !!====================================================================== 
    6987END MODULE usrdef_istate 

  • NEMO/trunk/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_ubs_cfg

    r13558 r14053  
    201201   ln_dynvor_mix = .false. !  mixed scheme 
    202202   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    203       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    204203/ 
    205204!----------------------------------------------------------------------- 

  • NEMO/trunk/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_ens_cfg

    r13476 r14053  
    129129   ln_dynvor_mix = .false. !  mixed scheme 
    130130   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    131       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    132131/ 
    133132!----------------------------------------------------------------------- 

  • NEMO/trunk/tests/LOCK_EXCHANGE/MY_SRC/usrdef_istate.F90

    r12489 r14053  
    88   !!====================================================================== 
    99   !! History :  NEMO ! 2016-03  (S. Flavoni, G. Madec) Original code 
     10   !!                 ! 2020-11  (S. Techene, G. Madec) separate tsuv from ssh 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    2324   PRIVATE 
    2425 
    25    PUBLIC   usr_def_istate   ! called by istate.F90 
     26   PUBLIC   usr_def_istate       ! called by istate.F90 
     27   PUBLIC   usr_def_istate_ssh   ! called by domqco.F90 
    2628 
    2729   !!---------------------------------------------------------------------- 
    … …  
    3234CONTAINS 
    3335   
    34    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     36   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    3537      !!---------------------------------------------------------------------- 
    3638      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    4749      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    4850      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    49       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5051      ! 
    5152      INTEGER  ::   jk     ! dummy loop indices 
    … …  
    6566      pu  (:,:,:) = 0._wp        ! ocean at rest 
    6667      pv  (:,:,:) = 0._wp 
    67       pssh(:,:)   = 0._wp 
    6868      ! 
    6969      !                          ! T & S profiles 
    … …  
    7878   END SUBROUTINE usr_def_istate 
    7979 
     80 
     81   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     82      !!---------------------------------------------------------------------- 
     83      !!                   ***  ROUTINE usr_def_istate_ssh  *** 
     84      !!  
     85      !! ** Purpose :   Initialization of ssh 
     86      !!                Here LOCK_EXCHANGE configuration  
     87      !! 
     88      !! ** Method  :   set ssh to 0 
     89      !!---------------------------------------------------------------------- 
     90      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m] 
     91      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m] 
     92      !!---------------------------------------------------------------------- 
     93      ! 
     94      IF(lwp) WRITE(numout,*) 
     95      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : LOCK_EXCHANGE configuration, analytical definition of initial state' 
     96      ! 
     97      pssh(:,:)   = 0._wp 
     98      ! 
     99   END SUBROUTINE usr_def_istate_ssh 
     100 
    80101   !!====================================================================== 
    81102END MODULE usrdef_istate 

  • NEMO/trunk/tests/OVERFLOW/EXPREF/namelist_sco_FCT2_flux_cen-ahm1000_cfg

    r13558 r14053  
    139139   ln_dynvor_mix = .false. !  mixed scheme 
    140140   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    141       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    142141/ 
    143142!----------------------------------------------------------------------- 

  • NEMO/trunk/tests/OVERFLOW/EXPREF/namelist_sco_FCT2_flux_ubs_cfg

    r13558 r14053  
    139139   ln_dynvor_mix = .false. !  mixed scheme 
    140140   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    141       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    142141/ 
    143142!----------------------------------------------------------------------- 

  • NEMO/trunk/tests/OVERFLOW/EXPREF/namelist_sco_FCT4_flux_cen-ahm1000_cfg

    r13558 r14053  
    139139   ln_dynvor_mix = .false. !  mixed scheme 
    140140   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    141       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    142141/ 
    143142!----------------------------------------------------------------------- 

  • NEMO/trunk/tests/OVERFLOW/EXPREF/namelist_sco_FCT4_flux_ubs_cfg

    r13558 r14053  
    139139   ln_dynvor_mix = .false. !  mixed scheme 
    140140   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    141       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    142141/ 
    143142!----------------------------------------------------------------------- 

  • NEMO/trunk/tests/OVERFLOW/EXPREF/namelist_zps_FCT2_flux_ubs_cfg

    r13558 r14053  
    139139   ln_dynvor_mix = .false. !  mixed scheme 
    140140   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    141       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    142141/ 
    143142!----------------------------------------------------------------------- 

  • NEMO/trunk/tests/OVERFLOW/EXPREF/namelist_zps_FCT4_flux_ubs_cfg

    r13558 r14053  
    201201   ln_dynvor_mix = .false. !  mixed scheme 
    202202   ln_dynvor_een = .false. !  energy & enstrophy scheme 
    203       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    204203/ 
    205204!----------------------------------------------------------------------- 

  • NEMO/trunk/tests/OVERFLOW/EXPREF/namelist_zps_FCT4_vect_een_cfg

    r13558 r14053  
    139139   ln_dynvor_mix = .false. !  mixed scheme 
    140140   ln_dynvor_een = .true. !  energy & enstrophy scheme 
    141       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    142141/ 
    143142!----------------------------------------------------------------------- 

  • NEMO/trunk/tests/OVERFLOW/MY_SRC/usrdef_istate.F90

    r12489 r14053  
    88   !!============================================================================== 
    99   !! History :  NEMO ! 2016-03  (S. Flavoni, G. Madec) Original code 
     10   !!                 ! 2020-11  (S. Techene, G. Madec) separate tsuv from ssh 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    2324   PRIVATE 
    2425 
    25    PUBLIC   usr_def_istate   ! called by istate.F90 
    26  
     26   PUBLIC   usr_def_istate       ! called by istate.F90 
     27   PUBLIC   usr_def_istate_ssh   ! called by domqco.F90 
     28    
    2729   !!---------------------------------------------------------------------- 
    2830   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    3234CONTAINS 
    3335   
    34    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     36   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    3537      !!---------------------------------------------------------------------- 
    3638      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    4749      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    4850      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    49       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5051      ! 
    5152      INTEGER  ::   jk     ! dummy loop indices 
    … …  
    6566      pu  (:,:,:) = 0._wp        ! ocean at rest 
    6667      pv  (:,:,:) = 0._wp 
    67       pssh(:,:)   = 0._wp 
    6868      ! 
    6969      !                          ! T & S profiles 
    … …  
    7878   END SUBROUTINE usr_def_istate 
    7979 
     80 
     81   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     82      !!---------------------------------------------------------------------- 
     83      !!                   ***  ROUTINE usr_def_istate_ssh  *** 
     84      !!  
     85      !! ** Purpose :   Initialization of the ssh 
     86      !!                Here  OVERFLOW configuration  
     87      !! 
     88      !! ** Method  :   set ssh to 0 
     89      !!---------------------------------------------------------------------- 
     90      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m] 
     91      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m] 
     92      !!---------------------------------------------------------------------- 
     93      ! 
     94      IF(lwp) WRITE(numout,*) 
     95      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : OVERFLOW configuration, analytical definition of initial state' 
     96      ! 
     97      pssh(:,:)   = 0._wp 
     98      ! 
     99   END SUBROUTINE usr_def_istate_ssh 
     100 
    80101   !!====================================================================== 
    81102END MODULE usrdef_istate 

  • NEMO/trunk/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90

    r13295 r14053  
    193193            pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 
    194194            pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)              ! = pe3t (ji,jj,ik  ) 
     195            pe3w (ji,jj,ik  ) = pdept(ji,jj,ik  ) - pdept(ji,jj,ik-1)            ! st caution ik > 1 
    195196         END_2D          
    196197         !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points 

  • NEMO/trunk/tests/VORTEX/EXPREF/1_namelist_cfg

    r13558 r14053  
    195195   ln_dynvor_mix = .false. !  mixed scheme 
    196196   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    197       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    198197/ 
    199198!----------------------------------------------------------------------- 

  • NEMO/trunk/tests/VORTEX/EXPREF/namelist_cfg

    r13558 r14053  
    188188   ln_dynvor_mix = .false. !  mixed scheme 
    189189   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    190       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    191190/ 
    192191!----------------------------------------------------------------------- 

  • NEMO/trunk/tests/VORTEX/MY_SRC/usrdef_istate.F90

    r13295 r14053  
    88   !!====================================================================== 
    99   !! History :  NEMO ! 2017-11  (J. Chanut) Original code 
     10   !!                 ! 2020-11  (S. Techene, G. Madec) separate tsuv from ssh 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    2627   PRIVATE 
    2728 
    28    PUBLIC   usr_def_istate   ! called by istate.F90 
     29   PUBLIC   usr_def_istate       ! called by istate.F90 
     30   PUBLIC   usr_def_istate_ssh   ! called by domqco.F90 
    2931 
    3032   !! * Substitutions 
    … …  
    3739CONTAINS 
    3840   
    39    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     41   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    4042      !!---------------------------------------------------------------------- 
    4143      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    5254      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    5355      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    54       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5556      ! 
    5657      INTEGER  :: ji, jj, jk  ! dummy loop indices 
    … …  
    6768      zf0   = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 
    6869      zumax = 1._wp * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 
    69       zlambda = SQRT(2._wp)*60.e3      ! Horizontal scale in meters  
     70      zlambda = SQRT(2._wp)*60.e3      ! Horizontal scale in meters 
    7071      zn2 = 3.e-3**2 
    7172      zH = 0.5_wp * 5000._wp 
    7273      ! 
    7374      zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 
    74       ! 
    75       ! Sea level: 
    76       za = -zP0 * (1._wp-EXP(-zH)) / (grav*(zH-1._wp + EXP(-zH))) 
    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 
    8375      ! 
    8476      ! temperature:          
    … …  
    134126   END SUBROUTINE usr_def_istate 
    135127 
     128 
     129   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     130      !!---------------------------------------------------------------------- 
     131      !!                   ***  ROUTINE usr_def_istate  *** 
     132      !!  
     133      !! ** Purpose :   Initialization of ssh 
     134      !!                Here VORTEX configuration  
     135      !! 
     136      !! ** Method  :   Set ssh according to a gaussian anomaly of pressure and associated 
     137      !!                geostrophic velocities 
     138      !!---------------------------------------------------------------------- 
     139      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m] 
     140      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m] 
     141      ! 
     142      INTEGER  :: ji, jj ! dummy loop indices 
     143      REAL(wp) :: zx, zy, zP0, zumax, zlambda, zf0, zH, zrho1, za 
     144      !!---------------------------------------------------------------------- 
     145      ! 
     146      IF(lwp) WRITE(numout,*) 
     147      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : VORTEX configuration, analytical definition of initial state' 
     148      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   ' 
     149      ! 
     150      ! 
     151      ! 
     152      zf0   = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 
     153      zumax = 1._wp * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 
     154      zlambda = SQRT(2._wp)*60.e3      ! Horizontal scale in meters  
     155      zH = 0.5_wp * 5000._wp 
     156      ! 
     157      zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 
     158      ! 
     159      ! Sea level: 
     160      za = -zP0 * (1._wp-EXP(-zH)) / (grav*(zH-1._wp + EXP(-zH))) 
     161      DO_2D( 1, 1, 1, 1 ) 
     162         zx = glamt(ji,jj) * 1.e3 
     163         zy = gphit(ji,jj) * 1.e3 
     164         zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2) 
     165         pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1) 
     166      END_2D 
     167       
     168   END SUBROUTINE usr_def_istate_ssh 
     169 
    136170   !!====================================================================== 
    137171END MODULE usrdef_istate 

  • NEMO/trunk/tests/VORTEX/cpp_VORTEX.fcm

    r12208 r14053  
    1  bld::tool::fppkeys key_iomput key_mpp_mpi key_agrif 
     1 bld::tool::fppkeys key_iomput key_mpp_mpi key_agrif  

  • NEMO/trunk/tests/WAD/EXPREF/namelist_cfg

    r13558 r14053  
    330330   ln_dynvor_mix = .false. !  mixed scheme 
    331331   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    332       nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    333332/ 
    334333!----------------------------------------------------------------------- 

  • NEMO/trunk/tests/WAD/MY_SRC/usrdef_istate.F90

    r13295 r14053  
    77   !! User defined : set the initial state of a user configuration 
    88   !!====================================================================== 
    9    !! History :  4.0 ! 2016-03  (S. Flavoni) Original code 
     9   !! History :  4.0  ! 2016-03  (S. Flavoni) Original code 
     10   !!                 ! 2020-11  (S. Techene, G. Madec) separate tsuv from ssh 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    2425   PRIVATE 
    2526 
    26    PUBLIC   usr_def_istate   ! called in istate.F90 
     27   PUBLIC   usr_def_istate       ! called in istate.F90 
     28   PUBLIC   usr_def_istate_ssh   ! called in sshwzv.F90 
    2729 
    2830   !! * Substitutions 
    … …  
    3436   !!---------------------------------------------------------------------- 
    3537CONTAINS 
    36    
    37    SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 
     38 
     39 
     40   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 
    3841      !!---------------------------------------------------------------------- 
    3942      !!                   ***  ROUTINE usr_def_istate  *** 
    … …  
    4245      !!                Here WAD_TEST_CASES configuration  
    4346      !! 
    44       !! ** Method  : - set temprature field 
     47q      !! ** Method  : - set temprature field 
    4548      !!              - set salinity   field 
    4649      !!---------------------------------------------------------------------- 
    … …  
    5053      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]  
    5154      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]  
    52       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
    5355      INTEGER  ::   ji, jj            ! dummy loop indices 
    5456      REAL(wp) ::   zi, zj 
    … …  
    6668      pu  (:,:,:) = 0._wp        ! ocean at rest 
    6769      pv  (:,:,:) = 0._wp 
    68       pssh(:,:)   = 0._wp 
    69       ! 
    7070      !                          ! T & S profiles 
    7171      pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:) 
    … …  
    8383         CASE ( 1 )                               ! WAD 1 configuration 
    8484            !                                     ! ==================== 
    85             ! 
    8685            IF(lwp) WRITE(numout,*) 
    8786            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Closed box with EW linear bottom slope' 
    8887            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    89             ! 
    90             do ji = 1,jpi 
    91              pssh(ji,:) = ( -5.5_wp + 7.4_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
    92             end do 
    9388            !                                     ! ==================== 
    9489         CASE ( 2, 8 )                            ! WAD 2 configuration 
    9590            !                                     ! ==================== 
    96             ! 
    9791            IF(lwp) WRITE(numout,*) 
    9892            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, mid-range initial ssh slope' 
    9993            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    100             ! 
    101             do ji = 1,jpi 
    102              pssh(ji,:) = ( -1.5_wp + 5.0_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
    103             end do 
    10494            !                                     ! ==================== 
    10595         CASE ( 3 )                               ! WAD 3 configuration 
    10696            !                                     ! ==================== 
    107             ! 
    10897            IF(lwp) WRITE(numout,*) 
    10998            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, extreme initial ssh slope'  
    11099            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    111             ! 
    112             do ji = 1,jpi 
    113              pssh(ji,:) = ( -4.5_wp + 6.8_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
    114             end do 
     100            !                                     ! ==================== 
     101         CASE ( 4 )                               ! WAD 4 configuration 
     102            !                                     ! ==================== 
     103            IF(lwp) WRITE(numout,*) 
     104            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic bowl, mid-range initial ssh slope'  
     105            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     106            !                                    ! =========================== 
     107         CASE ( 5, 7 )                           ! WAD 5 and 7 configurations 
     108            !                                    ! =========================== 
     109            IF(lwp) WRITE(numout,*) 
     110            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Double slope with shelf' 
     111            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     112            !                                     ! ==================== 
     113         CASE ( 6 )                               ! WAD 6 configuration 
     114            !                                     ! ==================== 
     115            IF(lwp) WRITE(numout,*) 
     116            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel with gaussian ridge'  
     117            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     118            ! 
     119            DO ji = mi0(jpiglo/2), mi0(jpiglo) 
     120               pts(ji,:,:,jp_sal) = 30._wp 
     121            END DO 
     122            ! 
     123            ! 
     124            !                                    ! =========================== 
     125         CASE DEFAULT                            ! NONE existing configuration 
     126            !                                    ! =========================== 
     127            WRITE(ctmp1,*) 'WAD test with a ', nn_cfg,' option is not coded' 
     128            ! 
     129            CALL ctl_stop( ctmp1 ) 
     130            ! 
     131      END SELECT 
     132      ! 
     133   END SUBROUTINE usr_def_istate 
     134 
     135      
     136   SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 
     137      !!---------------------------------------------------------------------- 
     138      !!                   ***  ROUTINE usr_def_istate_ssh  *** 
     139      !!  
     140      !! ** Purpose :   Initialization of the dynamics and tracers 
     141      !!                Here WAD_TEST_CASES configuration  
     142      !! 
     143      !! ** Method  : - set ssh 
     144      !!---------------------------------------------------------------------- 
     145      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask             [m] 
     146      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height 
     147      INTEGER  ::   ji, jj            ! dummy loop indices 
     148      REAL(wp) ::   zi, zj 
     149      ! 
     150      INTEGER  ::   jk     ! dummy loop indices 
     151      REAL(wp) ::   zdam   ! location of dam [Km] 
     152      !!---------------------------------------------------------------------- 
     153      ! 
     154      ! 
     155      SELECT CASE ( nn_cfg )  
     156         !                                        ! ==================== 
     157         CASE ( 1 )                               ! WAD 1 configuration 
     158            !                                     ! ==================== 
     159            ! 
     160            IF(lwp) WRITE(numout,*) 
     161            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Closed box with EW linear bottom slope' 
     162            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     163            ! 
     164            DO ji = 1,jpi 
     165               pssh(ji,:) = ( -5.5_wp + 7.4_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
     166            END DO 
     167            !                                     ! ==================== 
     168         CASE ( 2, 8 )                            ! WAD 2 configuration 
     169            !                                     ! ==================== 
     170            ! 
     171            IF(lwp) WRITE(numout,*) 
     172            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, mid-range initial ssh slope' 
     173            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     174            ! 
     175            DO ji = 1,jpi 
     176               pssh(ji,:) = ( -1.5_wp + 5.0_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
     177            END DO 
     178            !                                     ! ==================== 
     179         CASE ( 3 )                               ! WAD 3 configuration 
     180            !                                     ! ==================== 
     181            ! 
     182            IF(lwp) WRITE(numout,*) 
     183            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, extreme initial ssh slope'  
     184            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     185            ! 
     186            DO ji = 1,jpi 
     187               pssh(ji,:) = ( -4.5_wp + 6.8_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
     188            END DO 
    115189 
    116190            ! 
    … …  
    140214            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    141215            ! 
    142             do ji = 1,jpi 
    143              pssh(ji,:) = ( -2.5_wp + 5.5_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
    144             end do 
     216            DO ji = 1,jpi 
     217               pssh(ji,:) = ( -2.5_wp + 5.5_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 
     218            END DO 
    145219 
    146220            ! 
    … …  
    153227            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    154228            ! 
    155             do ji = 1,jpi 
    156              pssh(ji,:) = ( -2.5_wp + 5.5_wp*(50._wp-glamt(ji,1))/50._wp)*ptmask(ji,:,1) 
    157             end do 
    158             ! 
    159             do ji = mi0(jpiglo/2), mi0(jpiglo) 
    160              pts(ji,:,:,jp_sal) = 30._wp 
    161              pssh(ji,:) = -0.1*ptmask(ji,:,1) 
    162             end do 
     229            DO ji = 1,jpi 
     230               pssh(ji,:) = ( -2.5_wp + 5.5_wp*(50._wp-glamt(ji,1))/50._wp)*ptmask(ji,:,1) 
     231            END DO 
     232            ! 
     233            DO ji = mi0(jpiglo/2), mi0(jpiglo) 
     234               pssh(ji,:) = -0.1*ptmask(ji,:,1) 
     235            END DO 
    163236            ! 
    164237            ! 
    … …  
    182255      END_2D 
    183256      ! 
    184    END SUBROUTINE usr_def_istate 
     257   END SUBROUTINE usr_def_istate_ssh 
    185258 
    186259   !!====================================================================== 

  • NEMO/trunk/tests/demo_cfgs.txt

    r14010 r14053  
    1212STATION_ASF OCE 
    1313CPL_OASIS  OCE TOP ICE NST 
     14SWG OCE SWE 
    1415C1D_ASICS OCE 
    1516ICE_RHEO OCE SAS ICE 
Note: See TracChangeset for help on using the changeset viewer.